PRPU TITLE 'HASP PRINT/PUNCH SERVICE PROLOG' Q0001000 *********************************************************************** Q0002000 * * Q0003000 * MODULE NAME = HASJES20 ( HASPPRPU CSECT ) * Q0004000 * * Q0005000 * DESCRIPTIVE NAME = JES2 PRINT/PUNCH PROCESSOR * Q0006000 * * Q0007000 * COPYRIGHT = NONE * Q0008100 * * Q0009000 * STATUS = OS/VS2 MVS -- SEE &VERSION (BELOW) FOR JES2 LEVEL * Q0010000 * * Q0011000 * FUNCTION = THE HASPPRPU CSECT PROVIDES SELECTIVE PROCESSING OF * Q0012000 * JOB SYSOUT OUTPUT WITH INTERFACES TO THE CONSOLE * Q0013000 * OPERATOR FOR DIRECTION. * Q0014000 * * Q0015000 * NOTES = SEE BELOW * Q0016000 * * Q0017000 * DEPENDENCES = IF A 3211 PRINTER IS TO BE USED AS AN OUTPUT * Q0018000 * DEVICE, THE PRINT POSITION INDEXING FEATURE * Q0019000 * MUST BE INSTALLED. * Q0020000 * * Q0021000 * THE SYSTEM LIBRARY SYS1.IMAGELIB MUST CONTAIN * Q0022000 * ANY UCS OR FCB IMAGES SPECIFIED BY USER JCL. * Q0023000 * IF NOT, THE OPERATOR WILL GET A DIAGNOSTIC * Q0024000 * MESSAGE AND BE REQUIRED TO SPECIFY AN IMAGE * Q0025000 * NAME WHICH IS IN SYS1.IMAGELIB. * Q0026000 * * Q0027000 * ALL FCB IMAGES OR CARRIAGE TAPES USED WITH JES2 * Q0028000 * MUST CONTAIN A CHANNEL 1 PUNCH IN LINE POSITION * Q0029000 * 1 FOR PROPER FORMS ALLIGNMENT. * Q0030000 * * Q0031000 * 3525 PRINT CCW'S DIRECTED TO A 3525 WITHOUT THE * Q0032000 * PRINT FEATURE WILL BE CONVERTED TO PUNCH CCW'S. * Q0033000 * * Q0034000 * A REQUEST TO INTERPRET CARDS ON A 3525 PUNCH * Q0035000 * WILL BE IGNORED IF THE PRINT FEATURE IS NOT * Q0036000 * INSTALLED. * Q0037000 * * Q0038000 * RESTRICTIONS = IF THE FUNC=I INTERPRET FEATURE IS TO BE USED * Q0039000 * WITH A 3525 PUNCH, THE JES2 INITIALIZATION * Q0040000 * PARAMETER &NOPUCCW MUST BE AT LEAST 2. * Q0041000 * * Q0042000 * ALL DATA AREAS PRINTED/PUNCHED-FROM MUST BE * Q0043000 * PAGE-FIXED FOR EXCPVR PROCESSING. * Q0044000 * * Q0045000 * REGISTER CONVENTIONS = R0 = = PARAMETER REGISTER * Q0046000 * R1 = = PARAMETER REGISTER * Q0047000 * R2 = PW = WORK REGISTER * Q0048000 * R3 = PBUF = BUFFER ADDRESSABILITY * Q0049000 * R4 = PC1 = CCW WORK REGISTER 1 * Q0050000 * R5 = PC2 = CCW WORK REGISTER 2 * Q0051000 * R6 = BASE4 = PROCESSOR ADDRESSABILITY * Q0052000 * R7 = PL = SECONDARY LINK REGISTER * Q0053000 * R8 = BASE3 = PROCESSOR ADDRESSABILITY * Q0054000 * R9 = = RESERVED * Q0055000 * R10 = JCT = JCT ADDRESSABILITY * Q0056000 * R11 = BASE1 = HCT ADDRESSABILITY * Q0057000 * R12 = BASE2 = PROCESSOR ADDRESSABILITY * Q0058000 * R13 = SAVE = PCE ADDRESSABILITY * Q0059000 * R14 = LINK = PRIMARY LINK REGISTER * Q0060000 * R15 = = RETURN REGISTER * Q0061000 * SEE ENTRY POINT DESCRIPTIONS FOR * Q0062000 * EXCEPTIONS. * Q0063000 * * Q0064000 * PATCH LABEL = NONE * Q0065000 * * Q0066000 * MODULE TYPE = PROCEDURE, TABLE ( CSECT TYPE ) * Q0067000 * * Q0068000 * PROCESSOR = OS/VS ASSEMBLER * Q0069000 * * Q0070000 * MODULE SIZE = SEE $DLENGTH MACRO EXPANSION(S) AT END OF ASSEMBLY * Q0071000 * * Q0072000 * ATTRIBUTES = READ ONLY, EXCEPT WHEN DEBUG OPTION SELECTED, AND * Q0073000 * HASP REENTRANT * Q0074000 * * Q0075000 * ENTRY POINT = HASPIMAG * Q0076000 * * Q0077000 * PURPOSE = THIS ENTRY IS IDENTIFIED AND ATTACHED BY MODULE * Q0078000 * HASPINIT. ITS FUNCTION IS TO LOAD FCB AND UCS IMAGES * Q0079000 * FROM SYS1.IMAGELIB WITHOUT CAUSING THE MAIN JES2 TASK * Q0080000 * TO WAIT. * Q0081000 * * Q0082000 * LINKAGE = THIS SUBTASK IS ACTIVATED WHEN NEEDED BY A JES2 PRINT * Q0083000 * PUNCH PROCESSOR BY A OS/VS POST WITH A BUFFER ADDRESS * Q0084000 * AS THE POST CODE. THIS BUFFER CONTAINS A BLDL LIST * Q0085000 * FOR THE REQUIRED IMAGE. WHEN THE IMAGE IS LOADED, * Q0086000 * THE SUBTASK MOVES IT TO THE BUFFER AND USES $$POST * Q0087000 * TO ALERT THE WAITING PRINT/PUNCH PROCESSOR. THE * Q0088000 * LOADED IMAGE IS THEN DELETED AND THE SUBTASK WAITS. * Q0089000 * * Q0090000 * ENTRY POINT = HASPHOPE * Q0091000 * * Q0092000 * PURPOSE = THIS IS THE ENTRY POINT TO THE JES2 OUTPUT PROCESSOR. * Q0093000 * THE OUTPUT PROCESSOR CONVERTS THE OUTPUT REQUIREMENTS * Q0094000 * FOR A JOB DESCRIBED BY THE PDDB'S IN THE JOB'S OUTPUT * Q0095000 * IOT(S) TO JOE(S). AS EACH JOE IS ADDED TO THE JOT, IT * Q0096000 * IMMEDIATELY BECOMES AVAILABLE FOR SELECTION BY A * Q0097000 * PRINT/PUNCH PROCESSOR. IF ANY SPIN DATA SET IOT'S * Q0098000 * ARE ON THE $UNSPUNQ, THEIR REQUIREMENTS ARE ADDED TO * Q0099000 * THE JOT IF SPACE IS AVAILABLE. * Q0100000 * * Q0101000 * LINKAGE = VIA $WAIT AND $POST OBEYING JES2 CONVENTIONS. * Q0102000 * * Q0103000 * ENTRY POINT = HASPPPI1 * Q0104000 * * Q0105000 * PURPOSE = THIS IS THE ENTRY POINT TO THE JES2 PRINT/PUNCH * Q0106000 * PROCESSOR. THIS PROCESSOR AQUIRES OUTPUT WORK FROM * Q0107000 * THE JOT USING ITS DCT AS A PARAMETER LIST. THE DATA * Q0108000 * SETS REPRESENTED ARE READ FORM THE SPOOL VOLUME, * Q0109000 * DEBLOCKED, AND PRINTED/PUNCHED TO THE USER * Q0110000 * SPECIFICATIONS. WHEN ALL OUTPUT WORK FOR A JOB HAS * Q0111000 * BEEN COMPLETED, THE JOB IS MOVED TO THE PURGE QUEUE. * Q0112000 * * Q0113000 * LINKAGE = VIA $WAIT AND $POST OBEYING JES2 CONVENTIONS. * Q0114000 * * Q0115000 * INPUT = SEE ENTRY POINT DESCRIPTION * Q0116000 * * Q0117000 * OUTPUT = SEE ENTRY POINT DESCRIPTION * Q0118000 * * Q0119000 * EXIT NORMAL = SEE ENTRY POINT DESCRIPTION * Q0120000 * * Q0121000 * EXIT ERROR = USES JES2 MACRO $DISTERR TO INFORM THE OPERATOR * Q0122000 * * Q0123000 * EXTERNAL REFERENCES = SEE BELOW * Q0124000 * * Q0125000 * ROUTINES = SEE MACROS FOR SERVICES USED * Q0126000 * * Q0127000 * DATA AREAS = SEE $HASPCB MACRO EXPANSION * Q0128000 * * Q0129000 * CONTROL BLOCKS - SEE $OUTWORK MACRO EXPANSION FOR PCE WORK * Q0130000 * AREA EXTENSION FOR ENTRY POINT HASPHOPE * Q0131000 * * Q0132000 * SEE $PPPWORK MACRO EXPANSION FOR PCE WORK * Q0133000 * AREA EXTENSION FOR ENTRY POINT HASPPPI1 * Q0134000 * * Q0135000 * TABLES - NONE * Q0136000 * * Q0137000 * MACROS = JES2 - $$POST, $#ADD, $#BLD, $#CKPT, $#GET, $#JCT, * Q0138000 * $#PUT, $#REM, $DISTERR, $DOM, $EXCP, $EXTP, * Q0139000 * $FREEBUF, $FREUNIT, $GETBUF, $GETSMFB, $GETUNIT, * Q0140000 * $IOERROR, $PGSRVC, $POST, $PURGE, $QGET, $QLOC, * Q0141000 * $QPUT, $QUESMFB, $TIME, $WAIT, $WTO * Q0142000 * * Q0143000 * MACROS = SYSTEM - BLDL, DELETE, ESTAE, IMGLIB, LOAD, POST, RETURN, * Q0144000 * SAVE, SETPRT, SETRP, TIME, WAIT * Q0145000 * * Q0146000 * CHANGE ACTIVITY * Q0146100 * * Q0146200 * RELEASE 4.0 = OZ02418,OZ02421,OZ02422,OZ02442,OZ02443,OZ02444, * Q0146400 * OZ03343,OZ04338,OZ04340,OZ04967,OZ04969,OZ05777, * Q0146500 * OZ05780,OZ06730,OZ06740,OZ06748,OZ07433,OZ07447, * Q0146600 * OZ08187,OZ08230,OZ09020,OZ09042,OZ09064,OZ09079, * Q0146700 * OZ09082,OZ10324 * Q0146800 * * Q0146900 * RELEASE 4.1 = OZ09073,OZ10376,OZ10377,OZ11743,OZ11760,OZ11775, * Q0147000 * OZ11790,OZ12298,OZ12301,OZ12302,OZ13254,OZ14412, * Q0147100 * OZ14424,OZ14447,OZ14914,OZ15250,OZ15275,OZ16691 * Q0147200 * @G38ESBB Q0147300 * EJE1103 = @G38ESBB 3800 PRINTER ENHANCEMENTS @G38ESBB Q0147400 * * Q0152000 *********************************************************************** Q0153000 TITLE 'HASP CONTROL BLOCK GENERATION MACRO' Q0154000 SPACE 5 Q0155000 * Q0156000 * $HASPCB GENERATE HASP CONTROL BLOCK Q0157000 * Q0158000 SPACE 1 Q0159000 MACRO Q0160000 $HASPCB &DOC=NO,&LIST=NO Q0161000 GBLC &PRINT,&GEN,&DATA Q0162000 PUSH PRINT Q0163000 PRINT &PRINT Q0164000 $CVT LIST=&LIST GENERATE OS CVT DSECT R4 Q0165000 $DCB LIST=&LIST GENERATE OS DCB DSECT Q0166000 $DEB LIST=&LIST GENERATE OS DEB DSECT Q0167000 $UCB LIST=&LIST GENERATE OS UCB DSECT Q0168000 $SDWA LIST=&LIST GENERATE OS SDWA DSECT R4 Q0169000 $SETPRT LIST=&LIST GENERATE OS SPPARM DSECT R4 Q0170000 $TED DOC=&DOC GENERATE HASP TED DSECT Q0171000 $TAB DOC=&DOC GENERATE HASP TAB DSECT R4 Q0172000 $PCIE DOC=&DOC GENERATE HASP PCIE DSECT R4 Q0173000 $SVT DOC=&DOC GENERATE HASP SSVT DSECT Q0174000 $SJB DOC=&DOC GENERATE HASP SJB DSECT Q0175000 $HCT DOC=&DOC GENERATE HASP HCT DSECT Q0176000 $PCE DOC=&DOC GENERATE HASP PCE DSECT Q0177000 $LRC DOC=&DOC GENERATE HASP LRC DSECT Q0178000 $BUFFER DOC=&DOC GENERATE HASP BUFFER DSECT Q0179000 $SMF DOC=&DOC GENERATE HASP SMF DSECT Q0180000 $JQE DOC=&DOC GENERATE HASP JQE DSECT Q0181000 $JOE DOC=&DOC GENERATE HASP JOE DSECT Q0182000 $JOT DOC=&DOC GENERATE HASP JOT DSECT Q0183000 $QSE DOC=&DOC GENERATE HASP QSE DSECT Q0184000 $JCT DOC=&DOC GENERATE HASP JCT DSECT Q0185000 $CAT DOC=&DOC GENERATE HASP CAT DSECT Q0186000 $PDDB DOC=&DOC GENERATE HASP PDDB DSECT Q0187000 $IOT DOC=&DOC GENERATE HASP IOT DSECT Q0188000 $RAT DOC=&DOC GENERATE HASP RAT DSECT Q0189000 $DCT DOC=&DOC GENERATE HASP DCT DSECT Q0190000 $FMH DOC=&DOC GENERATE SNA FM HEADER DSECT R4 Q0195000 $BFW DOC=&DOC GENERATE HASP BFW DSECT @G38ESBB Q0196000 $PQH DOC=&DOC GENERATE HASP PQH DSECT @G38ESBB Q0196200 $PQE DOC=&DOC GENERATE HASP PQE DSECT @G38ESBB Q0196400 $OUTWORK DOC=&DOC GENERATE HASP OUTWORK DSECT Q0197000 $PPPWORK DOC=&DOC GENERATE HASP PPPWORK DSECT Q0198000 $DTE DOC=&DOC GENERATE HASP DTE DSECT @OZ38805 Q0198500 SPACE 1 Q0199000 POP PRINT Q0200000 PRINT &GEN,&DATA SET ASSEMBLY PRINT OPTIONS Q0201000 MEND Q0202000 TITLE 'HASPPRPU REGISTER SAVE/RETURN (PSAVE/PRETURN) MACROS' @G38ESBB Q0202020 * @G38ESBB Q0202040 ***** PSAVE REGISTER SAVE MACRO @G38ESBB Q0202060 ***** @G38ESBB Q0202080 MACRO @G38ESBB Q0202100 &NAME PSAVE &ALL @G38ESBB Q0202120 &NAME STM R14,R1,$CSAVREG SAVE WORK REGS @G38ESBB Q0202140 LA R15,PSAVE ADDRESS PSAVE ROUTINE @G38ESBB Q0202160 AIF ('&ALL' EQ 'ALL').PSVALL @G38ESBB Q0202180 BALR R14,R15 *** SAVE BASE2 AND PL *** @G38ESBB Q0202200 AGO .PSAVX @G38ESBB Q0202220 .PSVALL BAL R14,0(,R15) *** SAVE ALL REGISTERS *** @G38ESBB Q0202240 .PSAVX LM R14,R1,$CSAVREG RESTORE WORK REGS @G38ESBB Q0202260 MEND @G38ESBB Q0202280 SPACE 2 @G38ESBB Q0202300 * @G38ESBB Q0202320 ***** PRETURN REGISTER RESTORE/RETURN @G38ESBB Q0202340 ***** MACRO @G38ESBB Q0202360 MACRO @G38ESBB Q0202380 &NAME PRETURN , @G38ESBB Q0202400 &NAME STM R14,R1,$CSAVREG SAVE WORK REGISTERS @G38ESBB Q0202420 LA R15,PRETURN POINT TO PRETURN RTN @G38ESBB Q0202440 BALR R14,R15 *** RESTORE SAVED REGS *** @G38ESBB Q0202460 MEND @G38ESBB Q0202480 TITLE 'HASPPRPU MESSAGE (PMSG) MACRO' @G38ESBB Q0202500 * @G38ESBB Q0202520 ***** PMSG $WTO MSG TEXT CREATE MACRO @G38ESBB Q0202540 ***** @G38ESBB Q0202560 MACRO @G38ESBB Q0202580 PMSG &AREA,&LENGTH,&TEXT MACRO PARAMETERS @G38ESBB Q0202590 LCLA &CT DECLARE @G38ESBB Q0202600 LCLA &AL LOCAL @G38ESBB Q0202610 LCLA &ALSUM @G38ESBB Q0202620 LCLC &CL VARIABLES @G38ESBB Q0202630 LCLC &CLSUM @G38ESBB Q0202640 &CT SETA 1 INITIALIZE LOCAL @G38ESBB Q0202650 .A AIF (&CT EQ N'&TEXT+1).Y DETERMINE TYPE @G38ESBB Q0202660 &AL SETA 0 @G38ESBB Q0202670 &CL SETC '' @G38ESBB Q0202680 AIF ('&TEXT(&CT)'(1,2) NE 'C''').B OF TEXT STRING @G38ESBB Q0202690 &AL SETA K'&TEXT(&CT)-3 IN ORDER TO @G38ESBB Q0202700 AGO .C COMPUTE @G38ESBB Q0202710 .B AIF ('&TEXT(&CT)'(1,2) NE 'X''').F CORRECT @G38ESBB Q0202720 &AL SETA (K'&TEXT(&CT)-3)/2 LENGTH @G38ESBB Q0202730 .C AIF ('&CLSUM' EQ '').D @G38ESBB Q0202740 MVC &AREA+&CLSUM+&ALSUM.(&AL),=&TEXT(&CT) @G38ESBB Q0202750 AGO .E @G38ESBB Q0202760 .D MVC &AREA+&ALSUM.(&AL),=&TEXT(&CT) MESSAGE TEXT @G38ESBB Q0202770 .E ANOP @G38ESBB Q0202780 &ALSUM SETA &ALSUM+&AL OFFSET AND @G38ESBB Q0202790 AGO .X @G38ESBB Q0202800 .F ANOP @G38ESBB Q0202810 &CL SETC 'L''&TEXT(&CT)' IF NOT TEXT STRING USE @G38ESBB Q0202820 AIF ('&CLSUM' EQ '').G @G38ESBB Q0202830 MVC &AREA+&CLSUM+&ALSUM.(&CL),&TEXT(&CT) @G38ESBB Q0202840 AGO .H @G38ESBB Q0202850 .G MVC &AREA+&ALSUM.(&CL),&TEXT(&CT) IMPLICIT LENGTH @G38ESBB Q0202860 .H AIF ('&CLSUM' EQ '').I @G38ESBB Q0202870 &CLSUM SETC '&CLSUM+&CL' @G38ESBB Q0202880 AGO .X @G38ESBB Q0202890 .I ANOP @G38ESBB Q0202900 &CLSUM SETC '&CL' @G38ESBB Q0202910 .X ANOP @G38ESBB Q0202920 &CT SETA &CT+1 BUMP COUNTER AND @G38ESBB Q0202930 AGO .A CONTINUE LOOP @G38ESBB Q0202940 .Y AIF (K'&LENGTH EQ 0).Z @G38ESBB Q0202960 &LENGTH EQU &CLSUM+&ALSUM MESSAGE TEXT LENGTH @G38ESBB Q0202980 .Z MEND @G38ESBB Q0202990 TITLE 'HASP OUTPUT PROCESSOR EXECUTIVE' Q0203000 ****** $DTE ****** DEFINE DAUGHTER TASK ELEME @OZ38805 Q0203010 MACRO @OZ38805 Q0203050 $DTE &DOC=NO @OZ38805 Q0203100 TITLE 'HASP DAUGHTER TASK ELEMENT (DTE) DSECT' @OZ38805 Q0203150 SPACE 5 @OZ38805 Q0203200 DTEDSECT DSECT @OZ38805 Q0203250 DTETCB DS A SUB-TASK TCB ADDRESS @OZ38805 Q0203300 DTETECB DS F SUB-TASK TERMINATION ECB @OZ38805 Q0203350 DTEWECB DS F SUB-TASK WORK ECB @OZ38805 Q0203400 &SYSECT CSECT END OF DTE DSECT @OZ38805 Q0203450 MEND @OZ38805 Q0203500 SPACE 5 Q0204000 HASPPRPU START 0 HASP PRINT/PUNCH SERVICE Q0205000 SPACE 5 Q0206000 COPY $HASPGEN COPY HASPGEN PARAMETERS Q0207000 TITLE 'HASP CONTROL BLOCKS' Q0208000 SPACE 5 Q0209000 HASPPRPU $ENTRY BASE=,CSECT=YES PROVIDE PROCESSOR IDENTIFICATION Q0210000 SPACE 5 Q0211000 * Q0212000 * DOCUMENTATION OPTIONS FOR THIS ASSEMBLY Q0213000 * Q0214000 SPACE 3 Q0215000 $SYSPARM (OFF,GEN,NODATA,NO,NO) Q0216000 SPACE 5 Q0217000 * Q0218000 * GENERATE HASP CONTROL BLOCKS Q0219000 * Q0220000 SPACE 3 Q0221000 $HASPCB DOC=&DOC,LIST=&LIST GENERATE HASP CONTROL BLOCKS Q0222000 TITLE 'HASP OUTPUT PROCESSOR -- MAIN ENTRY' R4 Q0223000 *********************************************************************** Q0224000 * * Q0225000 * HOPE REGISTER DEFINITIONS * Q0226000 * * Q0227000 *********************************************************************** Q0228000 SPACE 1 R4 Q0229000 SPACE 3 Q0230000 JOE EQU 6 JOB OUTPUT ELEMENT BASE Q0231000 RNP EQU 7 NON-PROCESS RETURN REGISTER Q0232000 JOT EQU 8 JOB OUTPUT TABLE BASE Q0233000 SPACE 15 R4 Q0234000 *********************************************************************** Q0235000 * * Q0236000 * HASP OUTPUT PROCESSOR -- MAIN ENTRY POINT * Q0237000 * * Q0238000 *********************************************************************** Q0239000 SPACE 1 R4 Q0240000 HASPHOPE $ENTRY BASE=BASE2 HOPE MAIN ENTRY R4 Q0241000 TITLE 'HASP OUTPUT PROCESSOR -- SPIN DATA SET PROCESSING' R4 Q0242000 *********************************************************************** Q0243000 * * Q0244000 * ADD ANY STACKED SPIN DATA SETS TO THE JOT IF POSSIBLE * Q0245000 * * Q0246000 *********************************************************************** Q0247000 SPACE 1 R4 Q0248000 OPINIT L JOT,$AQSE LOAD QSE BASE ADDRESS @OZ27300 Q0249000 USING QSEDSECT,JOT ACTIVATE QSE ADDRESSABILITY Q0250000 MVC PCEJQE,$ZEROS CLEAR JQE ADDRESS @OZ32566 Q0250500 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0251000 OC $UNSPUNQ,$UNSPUNQ ANY QUEUED SPIN IOTS Q0252000 BZ OPSPIN3 BRANCH IF NO Q0253000 L R1,$JOTABLE ADDRESS JOB OUTPUT TABLE Q0254000 USING JOTDSECT,R1 ACTIVATE JOT ADDRESSABILITY Q0255000 LH R2,JOTFREC NUMBER OF AVAILABLE JOES Q0256000 BCTR R2,R0 JOE FOR A CHAR-JOE Q0257000 BCTR R2,R0 JOE FOR A WORK-JOE Q0258000 CH R2,$MINJOES BELOW MINIMUM FREE LIMIT... R4 Q0259000 BL OPSPIN3 BRANCH IF YES Q0260000 DROP R1 SUSPEND JOT ADDRESSABILITY Q0261000 SPACE 1 R4 Q0262000 *********************************************************************** Q0263000 * * Q0264000 * GET A BUFFER FOR THE SPIN IOT IF ONE NOT OWNED * Q0265000 * * Q0266000 *********************************************************************** Q0267000 SPACE 1 R4 Q0268000 ICM R1,15,OPIOTBUF IOT BUFFER ALREADY GOTTEN Q0269000 BNZ OPSPIN1 BRANCH IF YES Q0270000 $GETBUF , GET A BUFFER FOR THE IOT Q0271000 ST R1,OPIOTBUF SAVE BUFFER ADDRESS Q0272000 BNZ OPSPIN1 BRANCH IF BUFFER AVAILABLE Q0273000 $WAIT BUF WAIT FOR A FREE BUFFER Q0274000 B HASPHOPE GO TRY AGAIN Q0275000 EJECT R4 Q0276000 *********************************************************************** Q0277000 * * Q0278000 * READ FIRST SPIN IOT FROM THE UNSPUN QUEUE * Q0279000 * * Q0280000 *********************************************************************** Q0281000 SPACE 1 R4 Q0282000 OPSPIN1 DS 0H Q0283000 L R0,$UNSPUNQ GET IOT TRACK ADDRESS Q0284000 MVI PCEDEVTP,PCEDARD SET DCT FOR READ Q0285000 BAL RNP,OPIOCK READ AND CHECK IOT Q0286000 BZ OPSPIN2 BRANCH IF READ GOOD Q0287000 OPSPNIOT $DISTERR INDICATE CONTROL BLOCK ERROR Q0288000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0289000 XC $UNSPUNQ,$UNSPUNQ CLEAR SPIN IOT QUEUE Q0290000 B OPSPIN3 EXIT FROM SPIN LOOP Q0291000 SPACE 1 R4 Q0292000 *********************************************************************** Q0293000 * * Q0294000 * IF UNSPUN QUEUE HAS CHANGED - START OVER * Q0295000 * * Q0296000 *********************************************************************** Q0297000 SPACE 1 R4 Q0298000 OPSPIN2 DS 0H Q0299000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0300000 L R1,OPIOTBUF ADDRESS IOT BUFFER Q0301000 USING IOTDSECT,R1 ACTIVATE IOT ADDRESSABILITY Q0302000 CLC $UNSPUNQ,PCESEEK HAS SPIN QUEUE CHANGED R4 Q0303000 BNE HASPHOPE BRANCH IF YES Q0304000 CLC PCESEEK,IOTTRACK VALIDATE IOT R4 Q0305000 BNE OPSPNIOT BRANCH IF IOT BAD R4 Q0306000 L R2,$IOTPDDB POINT TO R4 Q0307000 ALR R2,R1 1ST PDDB IN IOT R4 Q0308000 USING PDBDSECT,R2 ACTIVATE PDDB ADDRESSABILITY Q0309000 MVC OPCLASS,PDBCLASS SAVE SYSOUT CLASS OF PDDB Q0310000 L R3,IOTJQOFF HOLD JQE OFFSET Q0311000 LR JCT,R3 COPY JQE OFFSET Q0312000 AL JCT,$JOBQPTR ADD JOB QUEUE BASE Q0313000 USING JQEDSECT,JCT ACTIVATE JQE ADDRESSABILITY Q0314000 TM JQEFLAGS,QUEPURGE HAS $CJOB BEEN ISSUED Q0315000 BO OPSPNCJ BRANCH IF YES Q0316000 DROP R1,R2 SUSPEND IOT,PDDB ADDRESSABILITY Q0317000 EJECT R4 Q0318000 *********************************************************************** Q0319000 * * Q0320000 * BUILD A PROTOTYPE JOE PAIR FROM THE PDDB IN THE SPIN IOT * Q0321000 * * Q0322000 *********************************************************************** Q0323000 SPACE 1 R4 Q0324000 $#BLD JOES=OPWORK,PDDB=(R2),JQE=(R3) CONVERT PDDB TO JOES R4 Q0325000 LA JOE,OPWORK ADDRESS WORK-JOE Q0326000 USING JOEDSECT,JOE ACTIVATE JOE ADDRESSABILITY Q0327000 L R1,OPIOTBUF ADDRESS SPIN IOT Q0328000 USING IOTDSECT,R1 ACTIVATE IOT ADDRESSABILITY Q0329000 MVC JOEIOTTR,IOTTRACK SET SPIN IOT TRACK ADDRESS Q0330000 MVI JOEFLAG,$JOESPIN SET SPIN FLAG IN WORK-JOE Q0331000 DROP R1,JOE SUSPEND IOT,JOE ADDRESSABILITY Q0332000 SPACE 1 R4 Q0333000 *********************************************************************** Q0334000 * * Q0335000 * ATTEMPT TO ADD THE PROTOTYPE JOE PAIR TO THE JOT * Q0336000 * * Q0337000 *********************************************************************** Q0338000 SPACE 1 R4 Q0339000 LA R0,OPWORK ADDRESS WORK-JOE PROTOTYPE Q0340000 LA R1,OPCHAR ADDRESS CHAR-JOE PROTOTYPE Q0341000 $#ADD WORK=(R0),CHAR=(R1) ADD TO THE JOT R4 Q0342000 BNZ OPSPIN3 BRANCH IF JOT FULL Q0343000 EJECT R4 Q0344000 *********************************************************************** Q0345000 * * Q0346000 * DE-QUEUE IOT FROM $UNSPUNQ -- RE-QUEUE JOB FOR $PURGE * Q0347000 * * Q0348000 *********************************************************************** Q0349000 SPACE 1 R4 Q0350000 OPSPNCJ DS 0H Q0351000 L R1,OPIOTBUF ADDRESS IOT Q0352000 USING IOTDSECT,R1 ACTIVATE IOT ADDRESSABILITY Q0353000 MVC $UNSPUNQ,IOTSPIOT DEQUEUE SPIN IOT FROM CHAIN Q0354000 L R2,$IOTPDDB POINT TO R4 Q0355000 ALR R2,R1 1ST PDDB IN IOT R4 Q0356000 USING PDBDSECT,R2 ACTIVATE PDDB ADDRESSABILITY Q0357000 NI PDBFLAG1,255-PDB1HOLD TURN OFF HOLD FLAG Q0358000 TM JQEFLAGS,QUEPURGE HAS $CJOB BEEN ISSUED... @OZ27300 Q0358200 BO *+8 BR IF YES @OZ27300 Q0358400 OI PDBFLAG1,PDB1PSO TURN ON PSO FLAG Q0359000 DROP R1,R2 SUSPEND IOT,PDDB ADDRESSABILITY Q0360000 MVI PCEDEVTP,PCEDAWR SET DCT FOR WRITE Q0361000 L R0,PCESEEK GET IOT MTTR Q0362000 BAL RNP,OPIOCK WRITE AND CHECK IOT Q0363000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0364000 LH R1,JQEHLDCT DECREMENT @OZ27300 Q0365000 SL R1,=A(X'10') JOB HELD @OZ27300 Q0365500 STH R1,JQEHLDCT DATASET COUNT @OZ27300 Q0366000 SRA R1,4 ANY MORE NON-HELD OUTPUT... @OZ27300 Q0366500 BNZ *+8 BR IF YES @OZ27300 Q0367000 NI JQEHLDCT+1,FF-JQEHLDDS RESET 3540-HOLD FLAG @OZ27300 Q0367500 $QCKPT (JCT) CHECKPOINT THE JQE @OZ20010 Q0368000 TM JQEFLAGS,QUEPURGE HAS $CJOB BEEN ISSUED Q0369000 BNO HASPHOPE BRANCH IF NO Q0370000 * THIS CARD DELETED BY APAR @OZ27300 Q0370100 CLC JQEJOE,$ZEROS ANY NON-HELD OUTPUT... @OZ27300 Q0371000 BNE OPINIT BR IF YES @OZ27300 Q0371500 CLC JQEHLDCT,$ZEROS ANY MORE HELD OUTPUT... @OZ27300 Q0372000 BNE OPINIT BR IF YES @OZ27300 Q0372500 CLI JQETYPE,$HARDCPY IS JOB IN THE $HARDCPY QUEUE Q0373000 BNE HASPHOPE BRANCH IF NO Q0374000 $QPUT (JCT),$PURGE MOVE THE JOB TO $PURGE Q0375000 B HASPHOPE GO TO NEXT SPIN DATA SET Q0376000 DROP JCT SUSPEND JQE ADDRESSABILITY Q0377000 TITLE 'HASP OUTPUT PROCESSOR -- MAIN PROCESSOR' R4 Q0378000 *********************************************************************** Q0379000 * * Q0380000 * *** MAIN PROCESSOR *** LOCATE A JOB * Q0381000 * * Q0382000 * FREE THE SPIN IOT BUFFER AND ATTEMPT TO GET A JOB * Q0383000 * * Q0384000 *********************************************************************** Q0385000 OPSPIN3 DS 0H Q0386000 ICM R1,15,OPIOTBUF IS THERE AN IOT BUFFER TO FREE Q0387000 BZ OPQLOC BRANCH IF NO Q0388000 $FREEBUF (R1) FREE IOT BUFFER Q0389000 XC OPIOTBUF,OPIOTBUF ZERO IOT BUFFER POINTER Q0390000 OPQLOC DS 0H Q0391000 OC QSEOPCKP,QSEOPCKP IS THIS A RESTART Q0392000 BZ OPQGET BRANCH IF NO Q0393000 $QLOC QSEOPJNO LOCATE JOB QUEUE ELEMENT Q0394000 BZ OPQGET BRANCH IF JOB NOT FOUND Q0395000 USING JQEDSECT,R1 ACTIVATE JQE ADDRESSABILITY Q0396000 OC JQEFLAGS,$SIDBUSY SET JOB QUEUE ELEMENT BUSY Q0397000 DROP R1 SUSPEND JQE ADDRESSABILITY Q0398000 $QCKPT (R1) CHECKPOINT THE JQE @OZ20010 Q0399000 B OPJOB GO PROCESS PARTIAL JOB Q0400000 OPQGET DS 0H Q0401000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY Q0402000 $QGET $OUTPUT ATTEMPT TO GET A JOB Q0403000 BNZ OPSETUP BRANCH IF NEW JOB FOUND Q0404000 * Q0405000 * $QGET NON-PROCESS EXIT ROUTINE Q0406000 * Q0407000 $WAIT JOB,INHIBIT=NO $WAIT FOR JOB TO BE QUEUED Q0408000 B HASPHOPE TRY AGAIN Q0409000 EJECT R4 Q0410000 *********************************************************************** Q0411000 * * Q0412000 * SETUP TO PROCESS NEW JOB * Q0413000 * * Q0414000 *********************************************************************** Q0415000 SPACE 1 R4 Q0416000 OPSETUP DS 0H Q0417000 SLR R0,R0 CLEAR REGISTER Q0418000 STH R0,QSEOPCKP SET PARTIAL JOE COUNT ZERO Q0419000 OPJOB DS 0H Q0420000 $ACTIVE R=R14 INDICATE PROCESSOR ACTIVE Q0421000 ST R1,PCEJQE STORE JQE ADDRESS @OZ32566 Q0422000 USING JQEDSECT,R1 ACTIVATE JQE ADDRESSABILITY Q0423000 MVC QSEOPJNO,JQEJOBNO SET JOB NUMBER FOR WARM START Q0424000 DROP R1 SUSPEND JQE ADDRESSABILITY Q0425000 LR R2,R1 HOLD A(JOB QUEUE ELEMENT) Q0426000 $TIME GET SIGN-ON TIME/DATE Q0427000 STM R0,R1,OPTIMEON SAVE IN PCE FOR JCT UPDATE Q0428000 SPACE 1 R4 Q0429000 *********************************************************************** Q0430000 * * Q0431000 * GET ADDRESS OF JCT IN BUFFER FROM JCT MANAGER * Q0432000 * * Q0433000 *********************************************************************** Q0434000 SPACE 1 R4 Q0435000 SLR JOE,JOE CLEAR JOE REG IN CASE OF JCT ERR R4 Q0436000 LR JCT,R2 SET JCT = A(JOB QUEUE ELEMENT) Q0438000 $#JCT READ,REFRESH=YES GET ADDR OF UPDATED JCT BUFF R41 Q0439000 ST JCT,OPJCTBUF SAVE JCT BUFFER ADDRESS Q0440000 BZ OPNOJCT BRANCH IF READ WAS IN ERROR Q0441000 SPACE 1 R4 Q0442000 *********************************************************************** Q0443000 * * Q0444000 * JCT VALID - DETERMINE IF THIS JOB HAD THE NOTIFY OPTION * Q0445000 * * Q0446000 *********************************************************************** Q0447000 SPACE 1 R4 Q0448000 JCTOK DS 0H Q0449000 OC QSEOPCKP,QSEOPCKP IS THIS A RESTART Q0450000 BNZ OPNOTX BRANCH IF YES - SKIP NOTIFY Q0451000 TM JCTTSUID,255-C' ' WAS NOTIFY REQUESTED... R4 Q0452000 BZ OPNOTX BR IF NO TO SKIP NOTIFY R4 Q0453000 EJECT R4 Q0459000 *********************************************************************** Q0460000 * * Q0461000 * SCAN JOB QUEUE FOR TS USER TO NOTIFY * Q0462000 * * Q0463000 *********************************************************************** Q0464000 SPACE 1 R4 Q0465000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0470000 L R1,=V($QINDEX) LOCATE Q0471000 LA R2,CATTSUCL-(255-QUECLASS) HEAD Q0472000 IC R2,0(R1,R2) OF THE TSU Q0473000 LA R2,$JQHEADS-2-QUECHAIN(R2) EXECUTION QUEUE Q0474000 EJECT R4 Q0475000 SPACE 1 R4 Q0476000 OPJQELP LH R2,QUECHAIN(,R2) GET NEXT JQE OFFSET R4 Q0477000 N R2,=F'65535' CLEAR LEFT HALFWORD Q0478000 BZ OPENDQ BRANCH IF END OF JQES Q0479000 SLL R2,2 EXPAND TO FULL ADDRESS OFFSET Q0480000 AL R2,$JOBQPTR ADD JOB QUEUE BASE Q0481000 USING JQEDSECT,R2 ACTIVATE JQE ADDRESSABILITY Q0482000 TM JQEFLAGS,QUEBUSY IS THIS USER ACTIVE Q0483000 BZ OPJQELP BRANCH IF NO - SKIP Q0484000 CLC JQEJNAME(7),JCTTSUID IS THIS THE RIGHT USER Q0485000 BNE OPJQELP BRANCH IF NO - SKIP Q0486000 MVC PCEWA(1),JQEFLAGS COPY JQE BUSY FLAGS Q0487000 NI PCEWA,QUEBUSY ISOLATE BUSY FLAGS Q0488000 CLC PCEWA(1),$SIDBUSY IS THE JOB BUSY ON THIS SYSTEM Q0489000 BE OPTSWTO BRANCH IF YES Q0490000 SPACE 1 R4 Q0491000 DROP R2 SUSPEND JQE ADDRESSABILITY Q0492000 SLR R2,R2 CLEAR REGISTER 2 Q0493000 IC R2,PCEWA COPY BUSY FLAGS Q0494000 BCTR R2,0 DECREMENT BY 1 Q0495000 LA R3,1 SETUP FOR BUSY TO AFFINITY SHIFT Q0496000 SLL R3,0(R2) CREATE AFFINITY BIT Q0497000 OPTSAFF L R1,PCEJQE ADDR OF CURRENT JOB'S JQE @OZ32566 Q0498000 USING JQEDSECT,R1 ACTIVATE JQE ADDRESSABILITY Q0499000 NI JQEFLAG2,255-QUESYSAF RESET CURRENT AFFINITY Q0500000 STC R3,PCEWA STORE NEW AFFINITY Q0501000 OC JQEFLAG2,PCEWA MOVE IN NEW AFFINITY Q0502000 $QPUT (R1),$OUTPUT REQUEUE JQE TO $OUTPUT Q0503000 $#JCT FREE RELEASE JCT BUFFER Q0504000 $DORMANT INDICATE PROCESSOR INACTIVE Q0505000 B HASPHOPE TRY TO SELECT OTHER WORK Q0506000 DROP R1 SUSPEND JQE ADDRESSABILITY Q0507000 SPACE 1 R4 Q0508000 OPENDQ DS 0H Q0509000 CLI JCTTSUAF,0 SEE IF TSO SOURCE AFFINITY R41 Q0509200 BE OPTSWTO PRESENT, BRANCH IF NOT R41 Q0509400 CLC JCTTSUAF,$SIDAFF SOURCE AFFINITY FOR THIS SYSTEM Q0510000 BE OPTSWTO BRANCH IF YES Q0511000 IC R3,JCTTSUAF SELECT SOURCE AFFINITY Q0512000 B OPTSAFF ALTER AFFINITY AND $QPUT Q0513000 EJECT R4 Q0514000 * Q0516000 * TS USER BUSY ON THIS SYSTEM - USE $WTO TO NOTIFY Q0517000 * Q0518000 OPTSWTO DS 0H Q0519000 MVC M165LOC,MSG165 SET BASIC MESSAGE FORMAT R4 Q0520000 MVC M165JNAM,JCTJNAME INSERT JOBNAME R4 Q0521000 MVC M165JBID,JCTJOBID AND JOB NUMBER R4 Q0522000 LA R1,M165JNAM-1 SET PTR TO JOBNAME - 1 R4 Q0523000 OPSCNJ DS 0H Q0524000 LA R1,1(,R1) INCREMENT POINTER R4 Q0525000 CLI 0(R1),C' ' IS THIS CHARACTER BLANK Q0526000 BNE OPSCNJ IF NOT TRY AGAIN Q0527000 TM JCTJTFLG,JCTJTJF+JCTJTCF ENDED BY CC SET Q0528000 BNO OPENDMSG IF NOT BRANCH TO END MESG Q0529000 CLI JCTPSN1,C' ' IS STEPNAME BLANK Q0530000 BE OPSCNJS2 IF YES SKIP STEPNAME R4 Q0531000 MVC 1(8,R1),JCTPSN1 INSERT STEPNAME Q0532000 OPSCNJS1 DS 0H Q0533000 LA R1,1(,R1) INCREMENT POINTER R4 Q0534000 CLI 0(R1),C' ' IS THIS CHARACTER BLANK Q0535000 BNE OPSCNJS1 IF NOT TRY AGAIN Q0536000 OPSCNJS2 DS 0H R4 Q0537000 CLI JCTPSN2,C' ' IS STEP NAME BLANK... R4 Q0538000 BE OPSCNJS4 IF YES SKIP STEPNAME R4 Q0539000 MVC 1(8,R1),JCTPSN2 INSERT STEPNAME Q0540000 OPSCNJS3 DS 0H R4 Q0541000 LA R1,1(,R1) INCREMENT POINTER R4 Q0542000 CLI 0(R1),C' ' IS THIS CHARACTER BLANK Q0543000 BNE OPSCNJS3 IF NOT TRY AGAIN R4 Q0544000 OPSCNJS4 DS 0H R4 Q0545000 MVC 1(9,R1),=C'ENDED CC=' SET REASON R4 Q0546000 LA R1,10(,R1) SET PTR TO CONDITION CODE R4 Q0547000 LH R2,JCTJTCC GET CONDITION CODE Q0548000 CVD R2,0(,R1) CONVERT TO DECIMAL R4 Q0549000 UNPK 0(4,R1),0(8,R1) UNPACK FOUR LOW DIGITS Q0550000 OI 3(R1),X'F0' SET ZONE TO X'F' Q0551000 LA R1,4(,R1) SET POINTER TO NEXT FIELD R4 Q0552000 B OPLOUSM2 SET LOGON USERID MESSAGE R4 Q0553000 EJECT R4 Q0554000 OPENDMSG DS 0H Q0555000 MVC 1(5,R1),=C'ENDED' SET ENDED MESSAGE Q0556000 LA R1,6(,R1) SET PTR TO NEXT FIELD R4 Q0557000 **************************************************************** * INSERTED BY GP **************************************************************** COPY SYZYGY1B SYZYG1 Q0557050 **************************************************************** * INSERTED BY GP **************************************************************** CLI JCTJTFLG,JCTJTJF IS IT JCL ERROR Q0558000 BE *+14 IF YES SET JCL MESSAGE Q0559000 OC JCTCNVRC,JCTCNVRC IS IT JCL ERROR Q0560000 BZ *+14 IF NOT TRY OTHER Q0561000 MVC 0(11,R1),=C'- JCL ERROR' SET REASON Q0562000 B OPLOUSM SET LOGON USERID MSG Q0563000 L R2,PCEJQE ADDRESS CURRENT JOB @OZ32566 Q0564000 USING JQEDSECT,R2 ESTABLISH JQE ADDRESSABILITY Q0565000 TM JQEFLAGS,QUEOPCAN WAS JOB CANCELLED Q0566000 BNO *+14 BRANCH IF NO Q0567000 MVC 0(11,R1),=C'- CANCELLED' SET REASON Q0568000 B OPLOUSM SET LOGON USERID Q0569000 TM JCTJTFLG,JCTJTABD WAS JOB ABENDED Q0570000 BZ OPLOUSM2 NO, SET LOGON USERID MESSAGE R4 Q0571000 MVC 0(11,R1),=C'- ABENDED ' SET REASON Q0572000 OPLOUSM DS 0H R4 Q0573000 LA R1,11(,R1) INCREMENT PTR TO NEXT FIELD R4 Q0574000 OPLOUSM2 DS 0H R4 Q0575000 MVC 0(14,R1),=C''',LOGON,USER=(' SET USER ID R4 Q0576000 LA R1,14(,R1) INCREMENT POINTER R4 Q0577000 MVC 0(7,R1),JCTTSUID SET USERID Q0578000 OPSCNUID DS 0H Q0579000 LA R1,1(,R1) INCREMENT POINTER R4 Q0580000 CLI 0(R1),C' ' WAS THIS CHARACTER A BLANK Q0581000 BNE OPSCNUID IF NOT TRY NEXT Q0582000 MVI 0(R1),C')' TERMINATE USERID WITH ')' Q0583000 $WTO M165LOC,L'MSG165,JOB=NO,TYPE=SVC34 ISSUE 'SEND' CMD R4 Q0584000 EJECT R4 Q0585000 *********************************************************************** Q0663000 * * Q0664000 * INITIALIZE PRIMARY PDDB TO JOE CONVERSION LOOP * Q0665000 * * Q0666000 *********************************************************************** Q0667000 SPACE 1 R4 Q0668000 OPNOTX DS 0H Q0669000 MVC OPJOBCPY,JCTCPYCT JOB LEVEL COPY COUNT Q0670000 CLI OPJOBCPY,X'00' IS THE JOB COPY COUNT ZERO Q0671000 BNE *+8 BRANCH IF NO Q0672000 MVI OPJOBCPY,X'01' FORCE COUNT TO ONE Q0673000 CLC OPJOBCPY,$JCOPYLM TOO MANY JOB COPIES REQUESTED R4 Q0674000 BNH SKIP70 BR IF NO R4 Q0675000 MVC OPJOBCPY,$JCOPYLM USE MAXIMUM R4 Q0676000 SKIP70 MVC OPMSGCLS,JCTMCLAS JOB MESSAGE CLASS Q0677000 MVC OPJBKEY,JCTJBKEY HOLD JOB KEY FOR VALIDITY CHECK Q0678000 * Q0679000 * READ CHAIN OF IOT'S Q0680000 * Q0681000 SLR R3,R3 CLEAR PREVIOUS BUFFER POINTER Q0682000 $GETBUF WAIT=YES GET BUFFER FOR IOT R4 Q0683000 ST R1,OPIOTBUF SAVE IOT BUFFER ADDRESS R4 Q0684000 LA R2,1(0,0) START COUNT OF IOT'S @OZ56154 Q0684500 L R0,JCTIOT GET ADDRESS OF 1ST REGULAR IOT Q0685000 OPIOTRD LR JCT,R1 LOAD BASE FOR IOT R4 Q0686000 USING IOTDSECT,JCT ACTIVATE IOT ADDRESSABILITY Q0687000 MVI PCEDEVTP,PCEDARD INDICATE READ OPERATION Q0688000 BAL RNP,OPIOCK CALL I/O AND CHECK ROUTINE Q0689000 BZ *+10 BRANCH IF GOOD READ Q0690000 XC IOTJBKEY,IOTJBKEY ZERO IOT JOB KEY Q0691000 CLC IOTJBKEY,OPJBKEY IS THIS IOT VALID Q0692000 BE IOTOK BRANCH IF YES Q0693000 * Q0694000 * IOT JOB KEY DOES NOT MATCH JCT JOB KEY Q0695000 * Q0696000 OPIOTER $DISTERR INDICATE CONTROL BLOCK ERROR Q0697000 $FREEBUF (JCT) FREE BUFFER OF INVALID IOT Q0698000 LTR JCT,R3 IS AT LEAST 1 IOT VALID Q0699000 BNZ PDBSCAN PROCESS WHAT IS LEFT Q0700000 ST R3,OPIOTBUF SET BUFFER ADDRESS TO ZERO Q0701000 B OPQPUT TERMINATE Q0702000 EJECT R4 Q0703000 *********************************************************************** Q0704000 * * Q0705000 * IOT JOB KEY MATCHES JCT JOB KEY * Q0706000 * * Q0707000 *********************************************************************** Q0708000 SPACE 1 R4 Q0709000 IOTOK DS 0H Q0710000 ICM R3,15,IOTIOTTR LOAD AND TEST NEXT IOT TRACK R4 Q0711000 BZ PDBSCAN BRANCH IF NO MORE IOT'S Q0712000 XC IOTIOT,IOTIOT MARK AS LAST INCORE IOT @OZ56154 Q0712500 $GETBUF PDDNOBUF GET BUFFER FOR IOT @OZ56154 Q0713000 LA R2,1(,R2) INCREMENT COUNT OF IOT'S @OZ56154 Q0713500 ST R1,IOTIOT CHAIN TO PREVIOUS IOT Q0714000 LR R0,R3 TTR FOR OPIOCK R4 Q0715000 LR R3,JCT HOLD PREVIOUS IOT BASE Q0716000 B OPIOTRD CONTINUE READING IOT'S Q0717000 SPACE 1 @OZ56154 Q0717025 ************************************************************* @OZ56154 Q0717050 * * @OZ56154 Q0717075 * NO BUFFERS AVAILABLE - NOTIFY OPERATOR AND HOLD JOB * @OZ56154 Q0717100 * * @OZ56154 Q0717125 ************************************************************* @OZ56154 Q0717150 SPACE 1 @OZ56154 Q0717175 PDDNOBUF LR R1,R10 RESTORE POINTER TO IOT @OZ56154 Q0717200 ICM R0,15,IOTIOTTR GET TTR OF NEXT IOT @OZ56154 Q0717225 BZ PDDNBMSG BRANCH IF ALL READ @OZ56154 Q0717250 LA R2,1(,R2) ADD THIS IOT TO COUNT @OZ56154 Q0717275 MVI PCEDEVTP,PCEDARD REQUEST READ OPERATION @OZ56154 Q0717300 BAL R7,OPIOCK CALL FOR I/O AND CHECK @OZ56154 Q0717325 BZ *+10 BRANCH IF GOOD READ @OZ56154 Q0717350 XC IOTJBKEY,IOTJBKEY ZERO KEY FIELD @OZ56154 Q0717375 CLC IOTJBKEY,OPJBKEY IS IOT VALID @OZ56154 Q0717400 BE PDDNOBUF BRANCH IF SO @OZ56154 Q0717425 SPACE 1 @OZ56154 Q0717450 PDDRDERR $DISTERR INDICATE ERROR @OZ56154 Q0717475 SPACE 1 @OZ56154 Q0717500 PDDNBMSG L R10,OPJCTBUF POINT TO JCT @OZ56154 Q0717525 PUSH USING SAVE CURRENT USING @OZ56154 Q0717550 USING JCTDSECT,R10 @OZ56154 Q0717575 LA R1,JCTWORK POINT TO JCTWORK @OZ56154 Q0717600 USING JCTWORK,R1 @OZ56154 Q0717625 MVC JCTWORK,MSG183 MOVE MESSAGE @OZ56154 Q0717650 CVD R2,$DOUBLE READY COUNT FOR PRINT @OZ56154 Q0717675 UNPK $DOUBLE(5),$DOUBLE+5(3) UNPACK BUFFER COUNT @OZ56154 Q0717700 OI $DOUBLE+4,X'F0' MAKE PRINTABLE @OZ56154 Q0717725 MVC BUFREQ-MSG183(,R1),$DOUBLE+1 INSERT IN MESSAGE @OZ56154 Q0717750 LH R2,$NUMBUF GET NUMBER OF BUFFERS @OZ56154 Q0717775 CVD R2,$DOUBLE READY COUNT FOR PRINT @OZ56154 Q0717800 UNPK $DOUBLE(5),$DOUBLE+5(3) UNPACK BUFFER COUNT @OZ56154 Q0717825 OI $DOUBLE+4,X'F0' MAKE PRINTABLE @OZ56154 Q0717850 MVC BUFDEF-MSG183(,R1),$DOUBLE+1 INSERT IN MESSAGE @OZ56154 Q0717875 SPACE 1 @OZ56154 Q0717900 $WTO JCTWORK,L'MSG183,JOB=YES,ROUTE=$MAIN+$LOG, @OZ56154XQ0717925 CLASS=$ACTION @OZ56154 Q0717950 SPACE 1 @OZ56154 Q0717975 $#JCT FREE RELEASE JCT BUFFER @OZ56154 Q0718000 SPACE 1 @OZ56154 Q0718025 $QSUSE ENQUEUE ON SHARED RESOURCE @OZ56154 Q0718050 L R1,PCEJQE ADDRESS JQE @OZ56154 Q0718075 OI JQEFLAGS-JQEDSECT(R1),QUEHOLD1 MARK JOB HELD @OZ56154 Q0718100 NI JQEFLAGS-JQEDSECT(R1),FF-QUEBUSY & NOT BUSY @OZ56154 Q0718125 SPACE 1 @OZ56154 Q0718150 $QCKPT (R1) REQUEST CHECKPOINT @OZ56154 Q0718175 B OPTERM GO TO RELEASE IOT'S @OZ56154 Q0718200 POP USING @OZ56154 Q0718225 EJECT @OZ56154 Q0718250 *********************************************************************** Q0719000 * * Q0720000 * ALL VALID IOTS HAVE BEEN READ - START PDDB SCAN * Q0721000 * * Q0722000 *********************************************************************** Q0723000 SPACE 1 R4 Q0724000 PDBSCAN DS 0H Q0725000 XC IOTIOT,IOTIOT ZERO CHAIN POINTER OF LAST IOT Q0726000 XC OPCKPT,OPCKPT ZERO CHECKPOINT JOE INDEX Q0727000 L JCT,OPIOTBUF ADDRESS IOT BUFFER Q0728000 PDBIOT DS 0H Q0729000 L R2,$IOTPDDB POINT TO R4 Q0730000 ALR R2,JCT 1ST PDDB IN IOT R4 Q0731000 USING PDBDSECT,R2 ACTIVATE PDDB ADDRESSABILITY Q0732000 L R3,IOTPDDBP OFFSET AFTER LAST PDDB Q0733000 AR R3,JCT ADD CURRENT BUFFER ORIGIN Q0734000 ST R3,OPDBEND SAVE IN PCE Q0735000 PDBNEXT DS 0H Q0736000 XC OPDDB,OPDDB CLEAR RESTART POINTER Q0737000 C R2,OPDBEND END OF PDDBS ID THIS IOT Q0738000 BNE PDBPDB BRANCH IF NO Q0739000 ICM JCT,15,IOTIOT LOAD AND TEST IOT CHAIN Q0740000 BZ OPQPUT BRANCH IF NO MORE IOTS Q0741000 B PDBIOT SETUP NEW IOT ADDRESSES Q0742000 PDBPDB DS 0H Q0743000 TM PDBFLAG1,PDB1NULL+PDB1NSOT IS PDDB NULL/NOT SYSOUT Q0744000 BZ PDBJOE BRANCH IF NO - BUILD JOES Q0745000 LA R2,PDBLENG(,R2) STEP TO THE NEXT PDDB Q0746000 B PDBNEXT CONTINUE SCAN Q0747000 EJECT R4 Q0748000 *********************************************************************** Q0749000 * * Q0750000 * BUILD CHAR-JOE AND WORK-JOE FROM PDDB * Q0751000 * * Q0752000 *********************************************************************** Q0755000 SPACE 1 R4 Q0756000 PDBJOE MVC OPCLASS,PDBCLASS GET SYSOUT CLASS FROM PDDB R4 Q0757000 USING JOEDSECT,JOE ACTIVATE JOE ADDRESSABILITY Q0758000 L R3,PCEJQE ADDRESS OF JQE @OZ32566 Q0759000 SL R3,$JOBQPTR MINUS JOB QUEUE ORIGIN Q0760000 LA JOE,OPCHAR ADDRESS CHAR-JOE Q0761000 $#BLD JOES=OPWORK,PDDB=(R2),JQE=(R3) CONVERT PDDB TO JOES R4 Q0762000 SPACE 1 R4 Q0763000 OI PDBFLAG1,PDB1NULL SHOW 1ST PDDB PROCESSED R41 Q0764000 SPACE 1 R4 Q0798000 *********************************************************************** Q0799000 * * Q0800000 * SCAN REMAINING PDDB'S FOR A CHARACTERISTICS MATCH * Q0801000 * * Q0802000 *********************************************************************** Q0803000 SPACE 1 R4 Q0804000 DDBNEXT DS 0H Q0805000 LA R2,PDBLENG(,R2) STEP TO THE NEXT PDDB Q0806000 DDBIOT DS 0H Q0807000 CL R2,OPDBEND END OF PDDB'S IN THIS IOT Q0808000 BNE DDBPDB BRANCH IF NO Q0809000 ICM JCT,15,IOTIOT LOAD AND TEST IOT CHAIN Q0810000 BZ DDBEND BRANCH IF NO MORE IOTS Q0811000 L R2,$IOTPDDB POINT TO R4 Q0812000 ALR R2,JCT 1ST PDDB IN IOT R4 Q0813000 L R3,IOTPDDBP OFFSET AFTER LAST PDDB Q0814000 ALR R3,JCT ADD BUFFER ORIGIN Q0815000 ST R3,OPDBEND SAVE IN PCE Q0816000 B DDBIOT PROCESS PDDBS IN THIS IOT Q0817000 DDBPDB DS 0H Q0818000 TM PDBFLAG1,PDB1NULL+PDB1NSOT IS PDDB NULL/NOT SYSOUT Q0819000 BNZ DDBNEXT BRANCH IF YES Q0820000 * Q0821000 * CHECK SYSOUT CLASS Q0822000 * Q0823000 CLC PDBCLASS,OPCLASS DOES SYSOUT CLASS MATCH Q0824000 BNE DDBSTEP BRANCH IF NO Q0825000 EJECT R41 Q0825500 * Q0826000 * CHECK REMAINING CHARACTERISTICS Q0827000 * Q0828000 LA JOE,OPWORK ADDRESS WORK JOE R4 Q0829000 TM JOEFLAG2,$JOEDMND TEST FOR DEMAND-SETUP OPTION R4 Q0830000 LA JOE,OPCHAR ADDRESS CHAR-JOE Q0831000 BZ SKIP80 SKIP CLASS TEST IF NOT CHOSEN R4 Q0832000 CLC PDBCLASS,OPMSGCLS DOES SYSOUT CLASS = MSGCLASS Q0833000 BE OPDEMAND BRANCH IF YES - DEMAND SETUP Q0834000 SKIP80 CLC JOEFORM(12),PDBFORMS CHECK FORMS, FCB, UCS Q0835000 BNE DDBSTEP BRANCH IF NOT MATCHING Q0836000 CLC JOEFLASH,PDBFLASH CHECK FLASH FRAME ID R4 Q0837000 BNE DDBSTEP BRANCH IF NOT MATCHING R4 Q0838000 TM PDBFLAG2,PDB2BRST VERIFY R4 Q0839000 BZ SKIP90 THAT R4 Q0840000 TM JOECFLAG,$JOEBRST PDDB R4 Q0841000 BZ DDBSTEP BURSTER R4 Q0842000 B OPDEMAND SPECIFICATION R4 Q0843000 SKIP90 TM JOECFLAG,$JOEBRST MATCHES R4 Q0844000 BO DDBSTEP CHAR-JOE R4 Q0845000 SPACE 1 R41 Q0846000 OPDEMAND CLC JOEWTRID,PDBWTRID CHECK EXTERNAL WRITER NAME R41 Q0848000 BNE DDBSTEP BRANCH IF NOT MATCHING Q0849000 LA JOE,OPWORK ADDRESS WORK-JOE Q0850000 CLC JOEDEST,PDBDEST CHECK DESTINATION Q0851000 BNE DDBSTEP BRANCH IF NOT MATCHING Q0852000 SPACE 1 R41 Q0853000 OPMATCH SLR R0,R0 CLEAR WORK REGISTER R41 Q0853100 SLR R1,R1 CLEAR COPY-GROUPS SUM R41 Q0853200 LA R5,8 SET MAX COPY-GROUPS R41 Q0853300 SPACE 1 R41 Q0853400 OPCOPLUP IC R0,PDBCOPYG-1(R5) COMPUTE TOTAL R41 Q0853500 ALR R1,R0 COPY COUNT OF R41 Q0853600 BCT R5,OPCOPLUP 3800 COPY-GROUPS R41 Q0853700 CLM R1,1,PDBCOPYS USE NORMAL R41 Q0853800 BNL OPRECCT COPY COUNT R41 Q0853900 IC R1,PDBCOPYS IF LARGER R41 Q0854000 SPACE 1 R41 Q0854100 OPRECCT L R0,PDBRECCT ADD LINE/CARD R41 Q0854200 MR R0,R0 COUNT OF PDDB R41 Q0854300 AL R1,JOERECCT TO WORK-JOE R41 Q0854400 ST R1,JOERECCT TOTAL R41 Q0854500 OI PDBFLAG1,PDB1NULL SET PDDB PROCESSED BIT Q0854600 B DDBNEXT GO PROCESS NEXT PDDB Q0855000 SPACE 1 R41 Q0856000 *********************************************************************** Q0857000 * * Q0858000 * CHARACTERISTICS DO NOT MATCH -- CHECK NEXT PDDB * Q0859000 * * Q0860000 *********************************************************************** Q0861000 SPACE 1 R4 Q0862000 DDBSTEP OC OPDDB,OPDDB RESTART POINT SELECTED... R41 Q0864000 BNZ DDBNEXT BRANCH IF YES Q0865000 ST R2,OPDDB SET PDDB AS RESTART POINT Q0866000 ST JCT,OPIOT AND SAVE IOT BUFFER ADDRESS Q0867000 B DDBNEXT CONTINUE SCAN OF PDDB'S Q0868000 EJECT R41 Q0869000 *********************************************************************** Q0870000 * * Q0871000 * ALL MATCHING PDDB'S HAVE BEEN PROCESSED * Q0872000 * * Q0872200 * ADD A WORK-JOE FOR EACH JOB COPY * Q0872400 * * Q0873000 *********************************************************************** Q0874000 SPACE 1 R4 Q0875000 DDBEND SLR RNP,RNP GET JOB LEVEL R41 Q0876000 IC RNP,OPJOBCPY COPY COUNT R41 Q0876100 SPACE 1 R41 Q0876200 OPJCOPY LH R5,OPCKPT GET INDEX OF LAST JOE ADDED R41 Q0876300 LA R5,1(,R5) INCR FOR THIS JOE R41 Q0876400 CH R5,QSEOPCKP WAS THIS JOE ALREADY ADDED... R41 Q0876500 BNH OPSKIP BR IF YES R41 Q0876600 SPACE 1 R41 Q0876700 USING JQEDSECT,R1 PROVIDE JQE ADDRESSABILITY R41 Q0876800 SPACE 1 R41 Q0876900 OPJOTADD L R1,PCEJQE ADDRESS OF JQE @OZ32566 Q0877000 TM JQEFLAGS,QUEPURGE HAS $CJOB BEEN ISSUED... R41 Q0877100 BO OPQPUT BR IF YES R41 Q0877200 SPACE 1 R41 Q0877300 DROP R1 DROP JQE ADDRESSABILITY R41 Q0877400 SPACE 1 R41 Q0877500 LA R0,OPWORK PROTOTYPE WORK-JOE R41 Q0877600 LA R1,OPCHAR PROTOTYPE CHAR-JOE R41 Q0877700 $#ADD WORK=(R0),CHAR=(R1) ADD WORK TO JOT R41 Q0877800 BZ OPADOK BR IF ADD SUCCESSFUL R41 Q0877900 $DORMANT ALLOW $PJES2 WHILE $WAITING R41 Q0878000 $WAIT JOT WAIT FOR JOT SERVICE R41 Q0878100 $ACTIVE SHOW HASPHOPE ACTIVE AGAIN R41 Q0878200 B OPJOTADD TRY AGAIN R41 Q0878300 SPACE 1 R41 Q0878400 OPADOK STH R5,QSEOPCKP SAVE COUNT FOR WARM START R41 Q0878500 SPACE 1 R41 Q0878600 OPSKIP STH R5,OPCKPT SAVE COUNT IN PCE R41 Q0878700 BCT RNP,OPJCOPY ADD A JOE FOR ALL JOB COPIES R41 Q0878800 EJECT R41 Q0878900 *********************************************************************** Q0879000 * * Q0879100 * SELECT PDDB WITH NEW CHARACTERISTICS * Q0879200 * * Q0879300 *********************************************************************** Q0879400 SPACE 1 R41 Q0879500 ICM R2,15,OPDDB IS RESTART ADDRESS 0 Q0879600 BZ OPQPUT BRANCH IF YES Q0879700 L JCT,OPIOT RESTART IOT BASE Q0879800 L R3,IOTPDDBP OFFSET AFTER LAST PDDB Q0880000 ALR R3,JCT ADD BUFFER ORIGIN Q0881000 ST R3,OPDBEND SAVE IN PCE Q0882000 B PDBNEXT CONTINUE PDDB SCAN Q0883000 SPACE 3 R41 Q0884000 *********************************************************************** Q0885000 * * Q0886000 * ALL PDDBS HAVE BEEN PROCESSED - MAKE JOB AVAILABLE * Q0887000 * * Q0888000 *********************************************************************** Q0889000 SPACE 1 R4 Q0890000 OPQPUT DS 0H Q0891000 L JCT,OPJCTBUF ADDRESS JCT IN BUFFER Q0892000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY Q0893000 MVC JCTOUTON(8),OPTIMEON HOPE SIGN-ON TIME/DATE Q0894000 $TIME SIGN-OFF TIME/DATE Q0895000 STM R0,R1,JCTOUTOF HOPE SIGN-OFF TIME/DATE Q0896000 MVC JCTOTSID,$SID SET SID FOR TYPE 26 SMF RECORD Q0897000 $#JCT WRITE COPY JCT TO SPOOL Q0901000 $#JCT FREE RELEASE JCT BUFFER Q0902000 EJECT R41 Q0903000 *********************************************************************** Q0904000 * * Q0905000 * IF NO JOES OR HQRS MOVE JOB TO $PURGE, ELSE $HARDCPY * Q0906000 * * Q0907000 *********************************************************************** Q0908000 SPACE 1 R4 Q0909000 OPNOJCT DS 0H Q0910000 L R1,PCEJQE ADDRESS OF JQE @OZ32566 Q0911000 LA R0,$PURGE SET NEXT QUEUE AS $PURGE Q0912000 USING JQEDSECT,R1 ACTIVATE JQE ADDRESSABILITY Q0913000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q0914000 CLC JQEJOE,$ZEROS ANY NON-HELD OUTPUT... @OZ27300 Q0915000 BNE *+14 BR IF YES @OZ27300 Q0916000 CLC JQEHLDCT,$ZEROS ANY HELD OUTPUT... @OZ27300 Q0916500 DROP R1 SUSPEND JQE ADDRESSABILITY Q0917000 BE *+8 BR IF NO @OZ27300 Q0918000 LA R0,$HARDCPY SET NEXT QUEUE AS $HARDCPY Q0919000 $QPUT (R1),(R0) MOVE JOB TO NEXT QUEUE Q0920000 MVC PCEJQE,$ZEROS CLEAR JQE ADDRESS @OZ32566 Q0920500 EJECT R4 Q0921000 SPACE 3 R4 Q0943000 *********************************************************************** Q0944000 * * Q0945000 * FREE CHAIN OF IOT BUFFERS USED DURING JOE CREATION * Q0946000 * * Q0947000 *********************************************************************** Q0948000 SPACE 1 R4 Q0949000 OPTERM DS 0H Q0950000 USING IOTDSECT,JCT ACTIVATE IOT ADDRESSABILITY Q0951000 ICM JCT,15,OPIOTBUF LOAD AND TEST BUFFER POINTER Q0952000 BZ OPPURGE BRANCH IF ZERO Q0953000 MVC OPIOTBUF,IOTIOT COPY NEXT BUFFER POINTER Q0954000 $FREEBUF (JCT) FREE IOT BUFFER CHAIN Q0955000 B OPTERM CYCLE THROUGH ALL IOT BUFFERS Q0956000 OPPURGE DS 0H Q0957000 SLR R0,R0 CLEAR REGISTER Q0958000 STH R0,QSEOPJNO CLEAR JOB NUMBER Q0959000 STH R0,QSEOPCKP CLEAR PARTIAL JOE COUNT Q0960000 $DORMANT INDICATE PROCESSOR DORMANT Q0961000 B HASPHOPE TRY TO GET ANOTHER JOB Q0962000 DROP JOE SUSPEND JOE ADDRESSABILITY Q0963000 TITLE 'HASP OUTPUT PROCESSOR -- BUFFER READ/WRITE AND CHECK SUCQ0964000 BROUTINE' R4 Q0965000 *********************************************************************** Q0966000 * * Q0967000 * BUFFER READ/WRITE AND CHECK SUBROUTINE * Q0968000 * * Q0969000 *********************************************************************** Q0970000 SPACE 1 R4 Q0971000 OPIOCK DS 0H Q0972000 USING BUFDSECT,R1 ACTIVATE BUFFER ADDRESSABILITY Q0973000 LA R15,IOBCCW1 RESET IOBSTART Q0974000 ST R15,IOBSTART TO FIRST CCW IN CHAIN Q0975000 DROP R1 SUSPEND BUFFER ADDRESSABILITY Q0976000 ST R1,PCEBUFAD STORE BUFFER ADDRESS IN DCT Q0977000 ST R0,PCESEEK STORE TRACK ADDRESS IN DCT Q0978000 LA R1,PCEDADCT SETUP DCT ADDRESS FOR $EXCP Q0979000 $EXCP (R1),WAIT=YES INITIATE I/O AND WAIT R4 Q0980000 BMR RNP RETURN IF ERROR WITH NON-ZERO CC R4 Q0981000 SR R15,R15 SET GOOD RETURN CODE Q0982000 BR RNP RETURN TO CALLER Q0983000 DROP BASE2 SUSPEND LOCAL ADDRESSABILITY Q0984000 TITLE 'HASP OUTPUT PROCESSOR -- LITERAL POOL AND CONSTANTS' R4 Q0985000 LTORG Q0986000 SPACE 2 R4 Q0987000 $MID 165 GENERATE MESSAGE ID Q0989000 MSG165 DC CL87'IDSE ''&MID.JOBNNNNN JOBNAMES' @OZ49921 Q0990000 ORG MSG165 Q0991000 DC X'165F' MESSAGE ID Q0992000 ORG , Q0993000 SPACE 1 R4 Q0994000 M165LOC EQU JCTWORK,L'MSG165 LOCATION FOR MESSAGE R4 Q0995000 M165JNAM EQU M165LOC+25,8 LOCATION FOR JOB NAME R4 Q0996000 M165JBID EQU M165LOC+15,8 LOCATION FOR JOBID R4 Q0997000 SPACE 2 @OZ56154 Q0997100 MSG183 $MSG 183,' HELD -- INSUFFICIENT BUFFERS -- NNNN REQUIRED, NNNNQ0997200 N DEFINED' @OZ56154 Q0997300 SPACE 1 @OZ56154 Q0997400 BUFREQ EQU MSG183+35,4 @OZ56154 Q0997500 BUFDEF EQU MSG183+50,4 @OZ56154 Q0997600 TITLE 'HASP PRINT/PUNCH SERVICE PROCESSOR' Q1017000 *********************************************************************** Q1018000 * * Q1019000 * PRINT/PUNCH REGISTER DEFINITIONS * Q1020000 * * Q1021000 *********************************************************************** Q1022000 SPACE 3 Q1023000 PW EQU WA WORK REGISTER Q1024000 PBUF EQU WB BUFFER POINTER Q1025000 PC1 EQU WC CCW REGISTER 1 R4 Q1026000 PC2 EQU WD CCW REGISTER 2 Q1027000 BASE4 EQU WE PRPU THIRD LOCAL BASE REGISTER R4 Q1028000 PL EQU WF INTERNAL LINKAGE REGISTER Q1029000 SPACE 5 Q1030000 *********************************************************************** Q1031000 * * Q1032000 * PPFLAG SWITCH DEFINITIONS * Q1033000 * * Q1034000 *********************************************************************** Q1035000 SPACE 3 Q1036000 PPWSW EQU X'80' PRINT/PUNCH WRITE SWITCH Q1037000 PPDELSW EQU X'40' PRINT/PUNCH SUSPEND SWITCH Q1038000 PPDALOC EQU X'20' PRINT/PUNCH ALLOCATION IOT Q1039000 PRDELSW EQU X'10' PRINT/PUNCH TERMINATION SWITCH Q1040000 PPFUNCI EQU X'08' PUNCH INTERPRET REQUESTED Q1041000 PPRDERR EQU X'04' PRINT/PUNCH DATA READ ERROR Q1042000 PPJCTIOT EQU X'02' PRINT/PUNCH JCT/IOT READ ERROR Q1043000 PPNEWS EQU X'01' PRINT JES2-NEWS PROCESS SWITCH R41 Q1043500 EJECT @OZ19494 Q1044000 *********************************************************************** Q1045000 * * Q1046000 * PPFLAG2 SWITCH DEFINITIONS * Q1047000 * * Q1048000 *********************************************************************** Q1049000 SPACE 2 R4 Q1050000 PPTCEL EQU X'80' TRACK-CELL DE-SPOOLING SWITCH R4 Q1051000 PPRSW EQU X'40' PRINT/PUNCH READ SWITCH R4 Q1052000 PPCKPT EQU X'20' PRINT/PUNCH CKPT-NEEDED SWITCH R4 Q1053000 PPCKPTA EQU X'10' PRINT/PUNCH CKPT-ALLOWED SWITCH R4 Q1054000 PPCIWAIT EQU X'08' PRINT/PUNCH PCI WAIT SWITCH R4 Q1055000 PPOPTJ EQU X'04' PRINTER OPTCD=J SWITCH R4 Q1056000 PPFDS EQU X'02' FIRST SYSOUT DATA SET SWITCH R4 Q1057000 PSMFDSER EQU X'01' DATA BUFFER ERROR FLAG FOR SMF R4 Q1058000 SPACE 2 @OZ19494 Q1058100 ************************************************************** @OZ19494 Q1058120 * * @OZ19494 Q1058140 * PPFLAG3 SWITCH DEFINITIONS * @OZ19494 Q1058160 * * @OZ19494 Q1058180 ************************************************************** @OZ19494 Q1058200 SPACE 2 @OZ19494 Q1058300 PPTRUNC EQU X'80' TRUNCATE OUTPUT @OZ19494 Q1058400 PPDVNAVL EQU X'20' DEVICE NO LONGER AVAILABLE @OZ51930 Q1058500 PP38CKPT EQU X'10' 3800 CHECKPOINT FLAG @OZ51592 Q1058550 PP3800S EQU X'08' 3800 REPOSITION BIT @OZ51592 Q1058600 PPQSPND EQU X'04' 3800 PPQ SUSPEND BIT @OZ48003 Q1058700 PP3800R EQU X'02' 3800 RESTART BIT @G38ESBB Q1058800 PPINIT EQU X'01' FIRST USE BIT @OZ34384 Q1058900 TITLE 'HASP PRINT/PUNCH SERVICE -- PROCESSOR INITIALIZATION' Q1059000 *********************************************************************** Q1060000 * * Q1061000 * HASP PRINT/PUNCH PROCESSOR -- MAIN ENTRY POINT * Q1062000 * * Q1063000 *********************************************************************** Q1064000 SPACE 1 R4 Q1065000 HASPPPI1 $ENTRY BASE=(BASE2,BASE3,BASE4) PRINT/PUNCH MAIN ENTRY R4 Q1066000 SPACE 3 R4 Q1067000 USING BUFDSECT,PBUF ACTIVATE BUFFER ADDRESSABILITY Q1068000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY Q1069000 USING DCTDSECT,R1 ACTIVATE DCT ADDRESSABILITY Q1070000 SPACE 3 R4 Q1071000 LA BASE3,2048(,BASE2) SETUP SECOND LOCAL Q1072000 LA BASE3,2048(,BASE3) BASE REGISTER Q1073000 LA BASE4,2048(,BASE3) SETUP THIRD LOCAL R4 Q1074000 LA BASE4,2048(,BASE4) BASE REGISTER R4 Q1075000 SPACE 1 @OZ19494 Q1075100 L R1,$HASPECB INITIALIZE @OZ19494 Q1075200 LA R1,$SVBLANK(,R1) CCWS REQUIRING @OZ19494 Q1075300 STCM R1,7,PUCCWBL+1 BLANKS IN @OZ19494 Q1075400 STCM R1,7,PUSPACCW+1 FIXED-STORAGE @OZ19494 Q1075500 SPACE 3 @OZ19494 Q1075600 PRPUINIT DS 0H @OZ19494 Q1076000 XC PBUFADDR,PBUFADDR CLEAR PRIMARY BUFFER ADDRESS R41 Q1076500 XC PDDBSKIP,PDDBSKIP CLEAR REPOSITIONING COUNTERS FOR R4 Q1077000 XC PBUFSKIP,PBUFSKIP CARDS/LINES AND BUFFER R4 Q1078000 XC PCKPT,PCKPT CLEAR CHECKPOINT DATA AREA R4 Q1079000 XC PPCKPTR,PPCKPTR CLEAR CHECKPOINT DATA POINTER R4 Q1080000 SPACE 1 R4 Q1081000 MVC PCEJQE,$ZEROS CLEAR JQE ADDRESS @OZ32566 Q1082000 SPACE 1 @OZ19494 Q1082100 PRINT OFF - SECTION DELETED @OZ19494 Q1082200 * THIS CARD DELETED BY APAR @OZ19494 Q1082300 PRINT ON -- SECTION DELETED @OZ19494 Q1082400 MVI PSMFDCI,0 CLEAR SMF FLAGS @OZ32566 Q1082500 EJECT R4 Q1083000 *********************************************************************** Q1084000 * * Q1085000 * TRY TO GET AN IDLE PRINTER OR PUNCH * Q1086000 * * Q1087000 *********************************************************************** Q1088000 SPACE 1 R4 Q1089000 PGETUNIT $GETUNIT PCEDCT ATTEMPT ACQUIRE PRT/PUN DCT @OZ32566 Q1090000 BNZ PGOTUNIT BR IF DEVICE AVAILABLE R4 Q1091000 SPACE 1 R4 Q1092000 *********************************************************************** Q1093000 * * Q1094000 * DEVICE NOT AVAILABLE -- ISSUE $WAIT * Q1095000 * * Q1096000 *********************************************************************** Q1097000 SPACE 1 R4 Q1098000 TM PCEID,PCERJEID TEST FOR REMOTE TERMINAL R4 Q1099000 BO PRJEDEV BR IF SO R4 Q1100000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q1100100 BNE PWTUNIT BR IF NOT @G38ESBB Q1100200 L R1,PCEDCT GET DCT ADDRESS @G38ESBB Q1100300 TM DCTSTAT-DCTDSECT(R1),DCTDRAIN TEST FOR $P DEV @G38ESBB Q1100400 BZ PWTUNIT BR IF NOT @G38ESBB Q1100500 SPACE 1 @OZ49145 Q1100600 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @OZ49145 Q1100700 L PW,PQHADR GET PQH ADDRESS @OZ49145 Q1100800 OI PQHFLAG,PQHDRAIN INDICATE PPQ DRAIN @OZ49145 Q1100900 L R15,=A(PPQMGR) CALL PPQMGR FOR TOTAL @OZ49145 Q1101000 BALR PL,R15 PURGE OF PPQ @OZ49145 Q1101100 DROP PW SUSPEND PQH ADDRESSABILITY @OZ49145 Q1101110 SPACE 1 @G38ESBB Q1101200 PWTUNIT $WAIT UNIT,INHIBIT=NO WAIT FOR U/R DEVICE @G38ESBB Q1101300 B PGETUNIT THEN BR TO TRY AGAIN R4 Q1102000 SPACE 1 R4 Q1103000 PRJEDEV $WAIT WORK $WAIT FOR RJE DEVICE R4 Q1104000 B PGETUNIT THEN BR TO TRY AGAIN R4 Q1105000 SPACE 1 R4 Q1106000 *********************************************************************** Q1107000 * * Q1108000 * GOT A PRINTER OR PUNCH -- SHOW PROCESSOR ACTIVE * Q1109000 * * Q1110000 *********************************************************************** Q1111000 SPACE 1 R4 Q1112000 PGOTUNIT MVI PPFLAG,0 CLEAR PRINT/PUNCH FLAGS R41 Q1114000 MVI PPFLAG2,0 CLEAR PRINT/PUNCH FLAGS R4 Q1115000 NI PPFLAG3,PPINIT CLEAR ALL BUT PPINIT @OZ41128 Q1115100 CLI DCTDEVTP,DCTPUN IF DEVICE R4 Q1116000 BNE SKIP100 IS LOCAL PUNCH, R4 Q1117000 XC PULMTTR(7),PULMTTR CLEAR PUNCH RESTART POINTER R4 Q1118000 SPACE 1 R4 Q1119000 SKIP100 MVI DCTFLAGS,0 RESET OPERATOR COMMANDS Q1120000 $ACTIVE R=PW INDICATE PROCESSOR ACTIVE Q1121000 B PTSTINIT GO TEST FIRST USE OF UNIT @OZ34870 Q1121500 EJECT R4 Q1122000 *********************************************************************** Q1123000 * * Q1124000 * FOR REMOTE PRINTERS -- PRINT ANY SPOOLED MESSAGES * Q1125000 * * Q1126000 *********************************************************************** Q1127000 SPACE 1 R4 Q1128000 PTSTRMT DS 0H * @OZ34870 Q1128500 TM PCEID,PCELCLID+PCEPUSID TEST PROCESSOR TYPE Q1129000 BNZ PGETJOB BR IF NOT REMOTE PRINTER @OZ34870 Q1130000 TM DCTPPSW,DCTPPSWS SUPPRESS SEP PAGE Q1131000 BO PGETJOB BRANCH IF YES Q1132000 CLI $SPOLMSG,0 IF NO MSG SPOOL BUFFERS, R4 Q1133000 BE PGETJOB BR TO GET A JOB R4 Q1134000 CLI DCTDEVTP,DCTRCON IF NOT A CONSOLE DCT @OZ26040 Q1134500 BNE PSNACHK GO CHECK FOR SNA REMOTE @OZ26040 Q1134600 PGETRAT DS 0H @OZ26040 Q1134610 ICM R1,7,DCTDCB+1 REMOTE STILL SIGNED ON... @OZ31782 Q1134620 BZ PNOJOB NO, FREE UP RESOURCES @OZ31782 Q1134625 L R1,MDCTRAT TO RAT @OZ26040 Q1134630 B PMSGS GO CHECK FOR MESSAGES @OZ26040 Q1134640 PSNACHK DS 0H @OZ26040 Q1134650 TM MDCTTYPE,DCTPLU1 IF NOT AN SNA REMOTE R41 Q1134700 BNO PGETRAT GET RAT ADDRESSABLILITY @OZ26040 Q1134800 ICM R1,7,DCTDCB+1 REMOTE STILL SIGNED ON... @OZ31782 Q1134900 BZ PNOJOB NO, FREE UP RESOURCES @OZ31782 Q1134950 L R1,MDCTRAT TO RAT R41 Q1135000 USING RATDSECT,R1 EST. RAT ADDRESSABILITY @OZ26040 Q1135100 TM RATCONF,RATCONFC IF RMT HAS A CONSOLE, @OZ33415 Q1135200 BO PGETJOB GO GET A JOB @OZ26040 Q1135300 PMSGS DS 0H R41 Q1135400 $QSUSE REQUEST ACCESS TO SHARED Q @OZ26040 Q1135500 SLR R14,R14 GET NUMBER OF REMOTE @OZ26040 Q1135600 IC R14,RATCONRT+1 WITH CONSOLE @OZ26040 Q1135700 BCTR R14,0 LESS 1 FOR OFFSET @OZ26040 Q1135800 LR R15,R14 SAVE REMOTE NUMBER (-1) @OZ26040 Q1135900 MH R15,=Y(RATTLE) CALCULATE RAT DISPLACEMENT @OZ26040 Q1136000 A R15,$RATABLE GET ADDRESS OF RAT ENTRY @OZ26040 Q1136100 CLR R15,R1 IF CONSOLE AND PRINTER ARE @OZ26040 Q1136200 BE PMSGDSP SAME RMT, DE-SPOOL MSGS @OZ26040 Q1136300 L R15,RATLDCT-RATDSECT(,R15) IF CONSOLE'S REMOTE @OZ26040 Q1136400 LTR R15,R15 SIGNED ON THIS SYSTEM, @OZ26040 Q1136500 BNZ PGETJOB DON'T PRINT MESSAGES @OZ26040 Q1136600 * THIS LINE DELETED BY APAR NUMBER @OZ45379 Q1136700 LR R15,R14 THREE TIMES @OZ26040 Q1136800 ALR R15,R14 REMOTE NUMBER @OZ26040 Q1136900 ALR R15,R14 MINUS ONE @OZ26040 Q1137000 SLR R14,R14 COMPUTE BIT AND @OZ26040 Q1137100 D R14,=F'8' BYTE OFFSET @OZ26040 Q1137200 AL R15,$RMTSON TO REMOTE SIGNON BITS @OZ26040 Q1137300 ICM R15,12,0(R15) PICK UP BITS @OZ26040 Q1137400 SLL R15,0(R14) ISOLATE BITS FOR @OZ26040 Q1137500 SRL R15,29 THIS REMOTE @OZ26040 Q1137600 LTR R15,R15 IF RMT SIGNED ON ANY SYSTM @OZ26040 Q1137700 BNZ PGETJOB THEN DON'T PRINT MESSAGES @OZ26040 Q1137800 PMSGDSP DS 0H @OZ26040 Q1137900 SLR PBUF,PBUF SET NO BUFFER INDICATION @OZ26040 Q1138000 SLR JCT,JCT SET NO JOB INDICATION @OZ26040 Q1138100 MVC PPKEY,=C'MSPOOL' SET SPECIAL JOB/DATA KEY @OZ26040 Q1138200 SLR PW,PW INITIALIZE @OZ26040 Q1138300 BCTR PW,0 LINE COUNT Q1139000 ST PW,PRLINECT LIMIT Q1140000 PRSMTEST DS 0H Q1141000 * THIS LINE DELETED BY APAR NUMBER @OZ26040 Q1142000 * THIS LINE DELETED BY APAR NUMBER @OZ45379 Q1143000 SLR R15,R15 MULTIPLY R4 Q1144000 IC R15,RATCONRT+1 REMOTE @OZ45379 Q1145000 LA PW,0(R15,R15) NUMBER R4 Q1146000 ALR PW,R15 BY THREE R4 Q1147000 USING DCTDSECT,R1 RESTORE DCT ADDRESSIBILITY @OZ45379 Q1147100 AL PW,$MSPOOLQ ADD MESSAGE QUEUE BASE ADDRESS R4 Q1148000 CLC 0(1,PW),1(PW) PRINTED VERSUS WRITTEN QUEUES Q1149000 BE PRMDONE BRANCH IF NO SPOOL MESSAGES Q1150000 $GETBUF WAIT=YES GET A DATA BUFFER R4 Q1151000 ST R1,PBUFSAVE SAVE BUFFER ADDRESS Q1152000 ST R1,PBUFADDR SAVE BUFFER ADDRESS R4 Q1153000 LR PBUF,R1 ESTABLISH BUFFER ADDRESSABILITY Q1154000 ST PBUF,PINIOB INITIALIZE INPUT IOB ADDRESS R4 Q1155000 MVI PBUFOPT,1 FORCE SINGLE BUFFERING R4 Q1156000 EJECT R4 Q1157000 L R1,PCEDCT RELOAD PRINTER DCT ADDRESS @OZ32566 Q1158000 TM MDCTTYPE,DCTPSNA TEST FOR SNA REMOTES R4 Q1160000 BNO *+14 NO, SKIP--- R4 Q1161000 MVC PRMTSSEL,MDCTSEL SAVE RMT SELECT BYTE IN WORK AREA R4 Q1162000 MVI MDCTSEL,FMHCNSLE+DCTPOUTB USE OUTBOUND CONSOLE SELECT R4 Q1163000 $EXTP OPEN,(R1) OPEN REMOTE FOR SPOOL MESSAGES R4 Q1165000 BZ PRMFINI OPEN FAILED, BR -- TERMINATE R4 Q1166000 SPACE 2 R4 Q1167000 PRFNDMSG DS 0H R4 Q1168000 $QSUSE REQUEST ACCESS TO SHARED QUEUES R4 Q1169000 L R1,PCEDCT LOAD DCT ADDR IN CASE DESTR @OZ32566 Q1170000 ICM R1,B'0111',DCTDCB+1 GET LINE DCT ADDRESS @OZ45379 Q1170100 BZ PRMDONE BRANCH IF NOT SIGNED ON @OZ45379 Q1170200 L R1,MDCTRAT GET RAT ADDRESS @OZ45379 Q1170300 SLR R15,R15 MULTIPLY R4 Q1171000 IC R15,RATCONRT+1-RATDSECT(,R1) REMOTE @OZ45379 Q1172000 LA PW,0(R15,R15) NUMBER R4 Q1173000 ALR PW,R15 BY THREE R4 Q1174000 AL PW,$MSPOOLQ ADD MESSAGE QUEUE BASE R4 Q1175000 CLC 0(1,PW),1(PW) CHECK PRINTED VS. WRITTEN QUEUES R4 Q1176000 BE PRMDONE BRANCH IF NO MESSAGES TO PRINT R4 Q1177000 MVC PJCTBUF(2),0(PW) SAVE POINTERS TO PRINTED/WRITTEN R4 Q1178000 MVC 0(1,PW),1(PW) SHOW ALL PRINTED R4 Q1179000 $POST $HASPECF,CKPW POST CHECKPOINT PROCESSOR R4 Q1180000 EJECT R4 Q1181000 *********************************************************************** Q1182000 * * Q1183000 * INITIALIZE PROCESSOR TO PRINT A SINGLE SPOOL MESSAGE BUFFER * Q1184000 * * Q1185000 *********************************************************************** Q1186000 SPACE 1 R4 Q1187000 PRMTMSG DS 0H * Q1188000 MVI PBFAVAIL,1 SHOW ONLY 1 DATA BUFFER AVAILABLE R4 Q1189000 SLR PW,PW CLEAR WORK REGISTER Q1190000 IC PW,PJCTBUF GET PRINTED RECORD NUMBER Q1191000 LA PW,1(,PW) ADD ONE FOR NEXT VALID BUFFER Q1192000 STC PW,PJCTBUF STORE FOR LATER Q1193000 SLR R15,R15 IS RECORD R4 Q1194000 IC R15,$SPOLMSG NUMBER R4 Q1195000 LA PW,1(,PW) GREATER THAN R4 Q1196000 SR PW,R15 &SPOLMSG - 1 R4 Q1197000 BNP *+8 BRANCH IF NO Q1198000 MVI PJCTBUF,0 SET RECORD NUMBER TO ZERO Q1199000 SPACE 1 R4 Q1200000 *********************************************************************** Q1201000 * * Q1202000 * COMPUTE MTTR FROM RECORD NUMBER * Q1203000 * * Q1204000 *********************************************************************** Q1205000 SPACE 1 R4 Q1206000 L R1,PCEDCT ADDRESS PRINTER DCT @OZ32566 Q1207000 ICM R1,B'0111',DCTDCB+1 GET LINE DCT ADDRESS @OZ45379 Q1207100 BZ PRMDONE BRANCH IF NOT SIGNED ON @OZ45379 Q1207200 L R1,MDCTRAT GET RAT ADDRESS @OZ45379 Q1207300 SLR PW,PW MULTIPLY R4 Q1208000 IC PW,RATCONRT+1-RATDSECT(,R1) &SPOLMSG @OZ45379 Q1209000 SLR R14,R14 BY REMOTE R4 Q1210000 MR R14,PW NUMBER R4 Q1211000 IC R14,PJCTBUF GET RELATIVE RECORD NUMBER Q1212000 ALR R15,R14 ADD TO REMOTE SPACE BASE Q1213000 L PW,$TEDADDR ADDRESS FIRST TRACK EXTENT DATA Q1214000 LH PW,TNRT-TEDDSECT(,PW) GET NUMBER OF TRACKS/RECORD Q1215000 SLR R14,R14 CLEAR WORK REGISTER Q1216000 DR R14,PW DIVIDE RECORD # BY RECS/TRACK Q1217000 SLL R15,8 MOVE TO TT IN MTTR Q1218000 LA R14,1(,R14) STEP PAST RECORD ZERO Q1219000 ALR R15,R14 ADD REMAINING RECORD NUMBER Q1220000 L R14,$DACKPT GET BASE MTTR R4 Q1221000 LH R14,2(,R14) FOR SPOOL MESSAGES R4 Q1222000 SLL R14,8 MOVE TO TT IN MTTR Q1223000 ALR R15,R14 ADD TO CURRENT RECORD OFFSET Q1224000 BAL PL,PRDBUF INITIATE READ OF NEXT DATA BLOCK Q1225000 BAL PL,PRDCHK CHECK READ Q1226000 CLI BUFECBCC,X'7F' TEST COMPLETION CODE Q1227000 BNE PRSMBEOB BRANCH IF IN ERROR Q1228000 XC HDBNXTRK,HDBNXTRK CLEAR CHAIN TRACK Q1229000 MVC PCEEJRCB,PCCW+2 SET 1ST RCB DISPLACEMENT @OZ19494 Q1229100 B P1STBLK PRINT DATA BLOCK @OZ19494 Q1230000 EJECT R4 Q1231000 *********************************************************************** Q1232000 * * Q1233000 * END OF, OR ERROR IN SPOOLED MESSAGE BUFFER * Q1234000 * * Q1235000 *********************************************************************** Q1236000 SPACE 1 R4 Q1237000 PRSMBEOB DS 0H Q1238000 MVI PPFLAG,0 RESET ANY ERROR INDICATIONS Q1239000 CLC PJCTBUF(1),PJCTBUF+1 END OF CURRENT SERIES Q1240000 BNE PRMTMSG BRANCH IF NO Q1241000 B PRFNDMSG CHECK FOR ADDITIONAL MESSAGES R4 Q1242000 SPACE 1 R4 Q1243000 *********************************************************************** Q1244000 * * Q1245000 * END OF ALL SPOOLED MESSAGE BUFFERS FOR THIS REMOTE * Q1246000 * * Q1247000 *********************************************************************** Q1248000 SPACE 1 R4 Q1249000 PRMDONE DS 0H Q1250000 LTR PBUF,PBUF WERE ANY SPOOLED MESSAGES PRINTED Q1251000 BZ PGETJOB BRANCH IF NO Q1252000 LM PC1,PC2,PRCCWSP LOAD 3 SPACE CCW Q1253000 BAL PL,PPPUT ADD CCW TO CHAIN Q1254000 BAL PL,PPPUT ADD CCW TO CHAIN Q1255000 BAL PL,PPPUT ADD CCW TO CHAIN Q1256000 BAL PL,PPPUT ADD CCW TO CHAIN Q1257000 L R1,PCEDCT GET ADDRESS OF REMOTE DCT @OZ32566 Q1258000 TM DCTFLAGS,DCTRSTRT DID RTAM FIND AN ERROR.... @OZ47583 Q1258010 BNO PRMCLOSE NO, CLOSE NORMALLY @OZ47583 Q1258020 NI DCTFLAGS,255-DCTRSTRT RESET ERROR INDICATION @OZ47583 Q1258030 $EXTP NCLOSE,(R1) TERMINATE WITH ERROR @OZ47583 Q1258040 B PRMFINI FINISH CONSOLE CLEANUP @OZ47583 Q1258050 PRMCLOSE DS 0H @OZ47583 Q1258060 $EXTP CLOSE,(R1) CLOSE REMOTE DCT R4 Q1259000 PRMFINI TM MDCTTYPE,DCTPSNA TEST FOR SNA REMOTES R4 Q1261000 BNO *+10 NO, SKIP NEXT R4 Q1262000 MVC MDCTSEL,PRMTSSEL RESTORE ORIG. SNA DEVICE SELECT R4 Q1263000 $FREEBUF (PBUF) FREE HASP BUFFER R4 Q1264000 TM $PRTOPTS,$RPRBOPT TEST REMOTE PRT BUFFERING OPTION R4 Q1265000 BZ PNOJOB BR IF SINGLE BUFFERING R4 Q1266000 MVI PBUFOPT,2 ELSE FORCE DOUBLE BUFFERING R4 Q1267000 B PNOJOB THEN BR TO FREE THE UNIT R4 Q1268000 SPACE 1 R4 Q1269000 PTSTINIT DS 0H @OZ34384 Q1269100 TM PCEID,PCEPUSID IS DEVICE A PUNCH... @OZ34384 Q1269150 BO PGETJOB BR IF YES, GET A JOB @OZ34384 Q1269200 CLI PDEVTYPE+3,UCB3800 NON-IMPACT PRINTER... @OZ34384 Q1269250 BE PTSTRMT BR IF YES, CONTINUE INIT @OZ34870 Q1269300 TM PPFLAG3,PPINIT FIRST USE OF UNIT... @OZ34384 Q1269350 BO PTSTRMT BR IF NO, CONTINUE INIT @OZ34870 Q1269400 OI PPFLAG3,PPINIT TURN ON FIRST-USE FLAG @OZ34384 Q1269450 L R15,=A(PINITSU) CALL IMAGE @OZ34384 Q1269500 BALR PL,R15 READ ROUTINE @OZ34384 Q1269550 B PTSTRMT FINISHED, CONTINUE INIT @OZ34870 Q1269600 DROP R1 SUSPEND DCT ADDRESSABILITY Q1270000 EJECT Q1271000 *********************************************************************** Q1272000 * * Q1273000 * ATTEMPT TO GET WORK FROM THE JOB OUTPUT TABLE (JOT) * Q1274000 * * Q1275000 *********************************************************************** Q1276000 SPACE 1 R4 Q1277000 PGETJOB DS 0H Q1278000 L R1,PCEDCT GET PRINTER/PUNCH @OZ32566 Q1278100 LA R1,0(,R1) DCT ADDRESS @OZ26040 Q1279000 CLI DCTDEVTP-DCTDSECT(R1),DCTRCON IF A CONSOLE DCT R41 Q1279500 BE PNOJOB DONT LOOK FOR JOB R41 Q1279600 $#GET DCT=(R1) IS THERE WORK Q1280000 BNZ PGOTJOB BRANCH IF WORK FOUND Q1281000 SPACE 1 R4 Q1282000 *********************************************************************** Q1283000 * * Q1284000 * NO WORK IS CURRENTLY AVAILABLE - FREE RESOURCES * Q1285000 * * Q1286000 *********************************************************************** Q1287000 SPACE 1 R4 Q1288000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q1288100 BNE PNOJOB BR IF NOT @G38ESBB Q1288200 L R15,=A(PALLOC) CALL RESOURCE ALLOCATION @G38ESBB Q1288300 BALR PL,R15 BEFORE CLEARPRINT I/O @G38ESBB Q1288400 L PBUF,PBUFADDR ADDRESS BUFFER @G38ESBB Q1288500 MVC PWKJOE,$ZEROS SHOW ZERO WORK JOE FOR I/O @G38ESBB Q1288600 LA JCT,JCT SHOW NON-ZERO JCT FOR I/O @G38ESBB Q1288700 LM PC1,PC2,PCCWCP LOAD CLEAR PRINT CCW @G38ESBB Q1288800 BAL PL,PPPUT ADD CCW TO AREA @G38ESBB Q1288900 BAL PL,PPWRITE WRITE CCW AREA @G38ESBB Q1289000 BAL PL,PPCHECK WAIT FOR I/O TO COMPLETE @G38ESBB Q1289100 L R15,=A(PDEALLOC) DEALLOCATE RESOURCES @OZ46470 Q1289150 BALR PL,R15 FOR CLEARPRINT I/O @OZ46470 Q1289200 L R1,PCEDCT GET PRINT/PUNCH @OZ46470 Q1289250 LA R1,0(,R1) DCT ADDRESS @OZ46470 Q1289300 $#GET DCT=(R1) WORK ADDED DURING CLRPRT.. @OZ46470 Q1289350 BNZ PGOTJOB BRANCH IF WORK FOUND @OZ46470 Q1289400 EJECT @OZ46470 Q1289500 PNOJOB L PW,PCEDCT GET ADDR OF PRINT/PUNCH DCT @G38ESBB Q1289600 SPACE 1 R4 Q1290000 USING DCTDSECT,PW ESTABLISH DCT ADDRESSABILITY Q1291000 SPACE 1 R4 Q1292000 OI DCTSTAT,DCTHOLD SET DEVICE UNAVAILABLE R4 Q1293000 $FREUNIT (PW) FREE DEVICE Q1294000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q1294200 BE PINACTIV BR IF YES, BYPASS DORMANT @OZ46470 Q1294400 $DORMANT INDICATE PROCESSOR INACTIVE Q1295000 TM PCEID,PCERJEID TEST PROCESSOR TYPE Q1296000 BO PRPUINIT START ALL OVER IF REMOTE @OZ19494 Q1297000 * THIS LINE DELETED BY APAR NUMBER @OZ46470 Q1297200 SPACE 1 @G38ESBB Q1297400 * THIS LINE DELETED BY APAR NUMBER @OZ46470 Q1297600 * THIS LINE DELETED BY APAR NUMBER @OZ46470 Q1297800 EJECT R4 Q1298000 *********************************************************************** Q1299000 * * Q1300000 * ISSUE DEVICE INACTIVE MESSAGE TO THE OPERATOR * Q1301000 * * Q1302000 *********************************************************************** Q1303000 SPACE 1 R4 Q1304000 PINACTIV TM DCTPPSW,DCTPPSWI INACTIVE MESSAGE ISSUED @G38ESBB Q1305000 BO PJOTWAIT BRANCH IF YES Q1306000 OI DCTPPSW,DCTPPSWI SET INACTIVE MESSAGE ISSUED Q1307000 $MID 160 R4 Q1308000 MVC PMESSAGE(2),=X'160F' INACTIVE MESSAGE ID Q1309000 MVC PMESSAGE+2(8),DCTDEVN GET DEVICE NAME Q1310000 MVC PMESSAGE+10(18),=CL18' INACTIVE - CLASS=' Q1311000 SLR R15,R15 SET R4 Q1312000 IC R15,$NUMCLAS CLASS R4 Q1313000 BCTR R15,0 FROM R4 Q1314000 EX R15,PMOVMSG Q= R4 Q1315000 LA R0,29(,R15) GET TOTAL MESSAGE SIZE R4 Q1316000 $WTO PMESSAGE,(R0),JOB=NO, ISSUE MESSAGE R4CQ1317000 ROUTE=$LOG+$UR,CLASS=$TRIVIA,PRI=$ST Q1318000 SPACE 3 R4 Q1319000 *********************************************************************** Q1320000 * * Q1321000 * WAIT FOR WORK TO BE ADDED TO THE JOB OUTPUT TABLE * Q1322000 * * Q1323000 *********************************************************************** Q1324000 SPACE 1 R4 Q1325000 PJOTWAIT DS 0H Q1326000 $WAIT JOT,INHIBIT=NO WAIT FOR WORK OR DRAIN @G38ESBB Q1327000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q1327200 BNE PRESETH BR IF NOT @G38ESBB Q1327400 $DORMANT INDICATE PROCESSOR INACTIVE @G38ESBB Q1327600 SPACE 1 @G38ESBB Q1327800 PRESETH NI DCTSTAT,FF-DCTHOLD RELEASE DCT @G38ESBB Q1328000 B PRPUINIT BR TO TRY AGAIN @OZ19494 Q1329000 SPACE 1 R4 Q1330000 PMOVMSG MVC PMESSAGE+28(*-*),DCTCLASS *** EXECUTE ONLY *** R4 Q1331000 SPACE 1 R4 Q1332000 DROP PW DROP DCT ADDRESSABILITY Q1333000 EJECT Q1334000 *********************************************************************** Q1335000 * * Q1336000 * A JOB HAS BEEN GOTTEN FROM THE JOB OUTPUT TABLE * Q1337000 * * Q1338000 *********************************************************************** Q1339000 SPACE 1 R4 Q1340000 PGOTJOB DS 0H Q1341000 ST R0,PCHJOE SAVE CHAR-JOE ADDRESS Q1342000 ST R1,PCEJQE STORE JQE ADDRESS @OZ32566 Q1343000 ST R15,PWKJOE SAVE WORK-JOE ADDRESS Q1344000 LR JCT,R1 SET JCT = A(JOB QUEUE ELEMENT) Q1345000 $TIME , GET TIME OF DAY Q1346000 STM R0,R1,PTIMEON PRPU SIGN-ON TIME/DATE Q1347000 MVI PDCTFLAG,0 CLEAR PRPU COPY OF DCTFLAGS R4 Q1348000 OI PPFLAG2,PPFDS SHOW 1ST DATA SET BEING PROCESSED R4 Q1349000 SPACE 1 R4 Q1350000 *********************************************************************** Q1351000 * * Q1352000 * IF NOT LOCAL -- INITIALIZE REMOTE PRINTER OR PUNCH * Q1353000 * * Q1354000 *********************************************************************** Q1355000 SPACE 1 R4 Q1356000 TM PCEID,PCELCLID TEST PROCESSOR TYPE Q1357000 BO PLOCAL BRANCH IF LOCAL Q1358000 $EXTP OPEN,PCEDCT OPEN REMOTE FOR PRT OR PNCH @OZ32566 Q1359000 BNZ PGOTJB1 OPEN SUCCEEDED @OZ25817 Q1361000 L R1,PCEDCT GET ADDRESS TO THE DCT @OZ19494 Q1361005 OI DCTSTAT-DCTDSECT(R1),DCTHOLD TURN ON DCT HOLD @OZ19494 Q1361010 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY @OZ25817 Q1361020 L R1,PWKJOE MAKE WORKJOE ADDRESSABLE @OZ25817 Q1361050 TM JOEFLAG,$JOECKV IS CHKPT-JOE DATA VALID? @OZ25817 Q1361100 BZ PJOEPUT NO, BR TO REQUEUE WK-JOE @OZ25817 Q1361200 LH R15,JOECKPT HALF-WD OFFSET OF CKPT-JOE @OZ25817 Q1361300 N R15,=F'65535' CLEAR LEFT HALFWORD @OZ25817 Q1361400 SLL R15,2 EXPANDTO BYTE OFFSET @OZ25817 Q1361500 AL R15,$JOTABLE ADD JOB OUTPUT TABLE ORG. @OZ25817 Q1361600 ST R15,PCKJOE SAVE CKPT-JOE @ IN PCE @OZ25817 Q1361700 MVC PCKJOE(1),JOEFLAG SAVE WK-JOE FLAGS IN PCE @OZ25817 Q1361800 B PJPUTI RETURN TO JOT WITH CKPT @OZ25817 Q1361900 DROP R1 @OZ25817 Q1361950 EJECT @G38ESBB Q1362000 ************************************************************* @OZ25817 Q1362100 * @OZ25817 Q1362200 * OPEN SUCCEEDED @OZ25817 Q1362300 * @OZ25817 Q1362400 ************************************************************* @OZ25817 Q1362500 PGOTJB1 DS 0H @OZ25817 Q1362600 $GETBUF WAIT=YES GET A DATA BUFFER R4 Q1363000 ST R1,PBUFSAVE SAVE BUFFER ADDRESS R4 Q1364000 CLI PBUFOPT,2 TEST FOR DOUBLE BUFFERING R4 Q1365000 BNE PRMTNOSB BR IF NOT R4 Q1366000 $GETBUF WAIT=YES GET SECOND DATA BUFFER R4 Q1367000 SPACE 1 R4 Q1368000 PRMTNOSB LR PBUF,R1 ACTIVATE BUFFER ADDRESSABILITY R4 Q1369000 ST PBUF,PBUFADDR SAVE BUFFER ADDRESS R4 Q1370000 ST PBUF,PINIOB INITIALIZE INPUT IOB POINTER R4 Q1371000 B PLOCJOE BR AROUND LOCAL DEV INIT @G38ESBB Q1372000 EJECT R4 Q1373000 *********************************************************************** Q1374000 * * Q1375000 * LOCAL DEVICE INITIALIZATION * Q1376000 * * Q1377000 *********************************************************************** Q1378000 SPACE 1 R4 Q1379000 PLOCAL DS 0H Q1380000 L PW,PCEDCT GET ADDRESS OF PRT/PNCH DCT @OZ32566 Q1381000 SPACE 1 R4 Q1382000 USING DCTDSECT,PW ESTABLISH DCT ADDRESSABILITY Q1383000 SPACE 1 R4 Q1384000 NI DCTPPSW,255-DCTPPSWI RESET INACTIVE MESSAGE SWITCH Q1385000 SPACE 1 R4 Q1386000 *********************************************************************** Q1387000 * * Q1388000 * DETERMINE DE-SPOOLING METHOD (SINGLE OR TRACK-CELL) * Q1389000 * * Q1390000 *********************************************************************** Q1391000 SPACE 1 R4 Q1392000 LA PC2,1 INITIALIZE TRACK-CELL SIZE TO 1 R4 Q1393000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE R4 Q1394000 BZ PGETBUFS FORCE SINGLE IF NOT LOCAL PRINTER R4 Q1395000 TM DCTPPFL,DCTTCEL TEST FOR DESPOOL=TRKCEL SPECIFIED R4 Q1396000 BZ PGETBUFS BRANCH IF NO R4 Q1397000 CLI $TCELSIZ,1 IF TRACK-CELL SIZE IS NOT GT 1 R4 Q1398000 BNH PGETBUFS THEN FORCE DESPOOL=SINGLE R4 Q1399000 L R15,PWKJOE PICK UP WORK-JOE ADDRESS R4 Q1400000 SPACE 1 R4 Q1401000 USING JOEDSECT,R15 ACTIVATE JOE ADDRESSABILITY R4 Q1402000 SPACE 1 R4 Q1403000 TM JOEFLAG2,$JOETCEL WAS DATA SET TRACK-CELL'ED ... R4 Q1404000 BZ PGETBUFS FORCE DESPOOL=SINGLE IF NOT R4 Q1405000 OI PPFLAG2,PPTCEL INDICATE TRACK-CELL DESPOOLING R4 Q1406000 * DELETED @G38ESBB Q1407000 SPACE 1 R4 Q1408000 DROP R15,PW SUSPEND JOE/DCT ADDRESSABILITY R4 Q1409000 EJECT R4 Q1410000 ***************************************************************@G38ESBB Q1411000 * @G38ESBB Q1412000 * CALL SUBROUTINE TO ALLOCATE PRINT/PUNCH RESOURCES @G38ESBB Q1413000 * @G38ESBB Q1414000 ***************************************************************@G38ESBB Q1415000 SPACE 1 @G38ESBB Q1416000 PGETBUFS L R15,=A(PALLOC) CALL SUBROUTINE TO @G38ESBB Q1417000 BALR PL,R15 ALLOCATE RESOURCE @G38ESBB Q1418000 L PBUF,PBUFADDR ADDRESS BUFFER @G38ESBB Q1419000 SPACE 1 @G38ESBB Q1420000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q1421000 * DELETED @G38ESBB Q1422000 * DELETED @G38ESBB Q1423000 * DELETED @G38ESBB Q1424000 * DELETED @G38ESBB Q1425000 * DELETED @G38ESBB Q1426000 * DELETED @G38ESBB Q1427000 * DELETED @G38ESBB Q1428000 * DELETED @G38ESBB Q1429000 * DELETED @G38ESBB Q1430000 * DELETED @G38ESBB Q1431000 * DELETED @G38ESBB Q1432000 * DELETED @G38ESBB Q1433000 * DELETED @G38ESBB Q1434000 * DELETED @G38ESBB Q1435000 * DELETED @G38ESBB Q1436000 * DELETED @G38ESBB Q1437000 * DELETED @G38ESBB Q1438000 * DELETED @G38ESBB Q1439000 * DELETED @G38ESBB Q1440000 * DELETED @G38ESBB Q1441000 * DELETED @G38ESBB Q1442000 * DELETED @G38ESBB Q1443000 * DELETED @G38ESBB Q1444000 * DELETED @G38ESBB Q1445000 * DELETED @G38ESBB Q1446000 * DELETED @G38ESBB Q1447000 * DELETED @G38ESBB Q1448000 * DELETED @G38ESBB Q1449000 * DELETED @G38ESBB Q1450000 * DELETED @G38ESBB Q1451000 * DELETED @G38ESBB Q1452000 * DELETED @G38ESBB Q1453000 * DELETED @G38ESBB Q1454000 * DELETED @G38ESBB Q1455000 * DELETED @G38ESBB Q1456000 * DELETED @G38ESBB Q1457000 * DELETED @G38ESBB Q1458000 * DELETED @G38ESBB Q1459000 * DELETED @G38ESBB Q1460000 * DELETED @G38ESBB Q1461000 * DELETED @G38ESBB Q1462000 * DELETED @G38ESBB Q1462100 * DELETED @G38ESBB Q1462200 * DELETED @G38ESBB Q1462300 * DELETED @G38ESBB Q1462400 * DELETED @G38ESBB Q1462500 * DELETED @G38ESBB Q1463000 * DELETED @G38ESBB Q1464000 * DELETED @G38ESBB Q1465000 * DELETED @G38ESBB Q1466000 * DELETED @G38ESBB Q1467000 * DELETED @G38ESBB Q1468000 * DELETED @G38ESBB Q1469000 * DELETED @G38ESBB Q1470000 * DELETED @G38ESBB Q1471000 * DELETED @G38ESBB Q1472000 * DELETED @G38ESBB Q1473000 * DELETED @G38ESBB Q1474000 * DELETED @G38ESBB Q1475000 * DELETED @G38ESBB Q1476000 * DELETED @G38ESBB Q1477000 * DELETED @G38ESBB Q1478000 * DELETED @G38ESBB Q1479000 * DELETED @G38ESBB Q1480000 * DELETED @G38ESBB Q1481000 * DELETED @G38ESBB Q1482000 * DELETED @G38ESBB Q1483000 * DELETED @G38ESBB Q1483400 * DELETED @G38ESBB Q1483500 * DELETED @G38ESBB Q1484000 * DELETED @G38ESBB Q1485000 * DELETED @G38ESBB Q1486000 * DELETED @G38ESBB Q1487000 * DELETED @G38ESBB Q1488000 * DELETED @G38ESBB Q1489000 * DELETED @G38ESBB Q1490000 * DELETED @G38ESBB Q1491000 * DELETED @G38ESBB Q1492000 * DELETED @G38ESBB Q1493000 * DELETED @G38ESBB Q1494000 * DELETED @G38ESBB Q1495000 * DELETED @G38ESBB Q1496000 * DELETED @G38ESBB Q1497000 * DELETED @G38ESBB Q1498000 * DELETED @G38ESBB Q1499000 * DELETED @G38ESBB Q1500000 * DELETED @G38ESBB Q1501000 * DELETED @G38ESBB Q1502000 * DELETED @G38ESBB Q1503000 * DELETED @G38ESBB Q1504000 * DELETED @G38ESBB Q1505000 * DELETED @G38ESBB Q1506000 * DELETED @G38ESBB Q1507000 * DELETED @G38ESBB Q1508000 * DELETED @G38ESBB Q1509000 * DELETED @G38ESBB Q1510000 * DELETED @G38ESBB Q1511000 * DELETED @G38ESBB Q1512000 * DELETED @G38ESBB Q1513000 * DELETED @G38ESBB Q1514000 * DELETED @G38ESBB Q1515000 * DELETED @G38ESBB Q1516000 * DELETED @G38ESBB Q1517000 * DELETED @G38ESBB Q1518000 * DELETED @G38ESBB Q1519000 * DELETED @G38ESBB Q1521000 * DELETED @G38ESBB Q1522000 * DELETED @G38ESBB Q1523000 * DELETED @G38ESBB Q1524000 * DELETED @G38ESBB Q1525000 * DELETED @G38ESBB Q1526000 * DELETED @G38ESBB Q1527000 * DELETED @G38ESBB Q1528000 * DELETED @G38ESBB Q1540000 * DELETED @G38ESBB Q1541000 * DELETED @G38ESBB Q1542000 * DELETED @G38ESBB Q1543000 * DELETED @G38ESBB Q1544000 * DELETED @G38ESBB Q1545000 * DELETED @G38ESBB Q1546000 * DELETED @G38ESBB Q1547000 * DELETED @G38ESBB Q1548000 * DELETED @G38ESBB Q1549000 * DELETED @G38ESBB Q1550000 * DELETED @G38ESBB Q1551000 * DELETED @G38ESBB Q1552000 * DELETED @G38ESBB Q1553100 * DELETED @G38ESBB Q1553200 * DELETED @G38ESBB Q1553300 * DELETED @G38ESBB Q1553400 * DELETED @G38ESBB Q1553500 * DELETED @G38ESBB Q1553600 * DELETED @G38ESBB Q1553700 * DELETED @G38ESBB Q1553800 * DELETED @G38ESBB Q1553900 * DELETED @G38ESBB Q1554000 * DELETED @G38ESBB Q1554100 * DELETED @G38ESBB Q1554200 * DELETED @G38ESBB Q1554300 * DELETED @G38ESBB Q1554400 * DELETED @G38ESBB Q1554500 * DELETED @G38ESBB Q1554600 * DELETED @G38ESBB Q1554700 * DELETED @G38ESBB Q1554800 * DELETED @G38ESBB Q1554900 * DELETED @G38ESBB Q1555000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q1555100 EJECT R4 Q1556000 *********************************************************************** Q1557000 * * Q1558000 * LOCATE CHECKPOINT-JOE * Q1559000 * * Q1560000 *********************************************************************** Q1561000 SPACE 1 R41 Q1562000 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY R41 Q1563000 SPACE 1 R41 Q1564000 PLOCJOE L R1,PWKJOE ADDRESS WORK JOE @G38ESBB Q1565000 LH R14,JOECKPT HALFWORD OFFSET OF CKPT-JOE Q1584000 N R14,=F'65535' CLEAR LEFT HALFWORD Q1585000 SLL R14,2 EXPAND TO BYTE OFFSET R4 Q1586000 AL R14,$JOTABLE ADD JOB OUTPUT TABLE ORIGIN Q1587000 ST R14,PCKJOE SAVE A(CKPT-JOE) IN PCE Q1588000 MVC PCKJOE(1),JOEFLAG COPY WORK-JOE FLAGS Q1589000 SPACE 3 R41 Q1590000 *********************************************************************** Q1590100 * * Q1590200 * GET ADDRESS OF JCT IN BUFFER FROM JCT MANAGER * Q1590300 * * Q1590400 *********************************************************************** Q1590500 SPACE 1 R41 Q1590600 $#JCT READ GET ADDR OF JCT BUFFER R41 Q1590700 ST JCT,PJCTBUF SAVE JCT BUFFER ADDRESS R41 Q1590800 BNZ PATIMAGE BRANCH IF SUCCESSFUL @OZ57316 Q1590810 OI PDCTFLAG,DCTDELET ELSE, SET DELETE FLAG @OZ57316 Q1590820 B PRPUEXIT GO TO EXIT - BAD JCT @OZ57316 Q1590900 EJECT @OZ26939 Q1600000 ***************************************************************@OZ26939 Q1600100 * @OZ26939 Q1600200 * ATTACH HASPIMAG SUBTASK FOR PRINTERS @OZ26939 Q1600300 * @OZ26939 Q1600400 ***************************************************************@OZ26939 Q1600500 SPACE 1 @OZ26939 Q1600600 PATIMAGE TM PCEID,PCEPUSID TEST PROCESSOR TYPE @OZ57316 Q1600700 BO PCLDSTRT BR IF PUNCH @OZ26939 Q1600800 L R1,PRIMGDTE ELSE GET HASPIMAG DTE ADDR @OZ26939 Q1600900 OC 0(4,R1),0(R1) SUBTASK ALREADY ACTIVE... @OZ26939 Q1601000 BNZ PCLDSTRT BR IF YES @OZ26939 Q1601100 L R15,=A(PIMAGLST) ELSE MOVE ATTACH PARMS @OZ26939 Q1601200 MVC $CSAVREG(PIMAGLL),0(R15) TO WORK AREA @OZ26939 Q1601300 LR PW,R1 SAVE DTE ADDRESS @OZ26939 Q1601400 ATTACH ECB=4(,R1),MF=(E,(1)),SF=(E,$CSAVREG) @OZ26939 Q1601500 STCM R1,7,1(PW) STORE TCB ADDRESS INTO DTE @OZ36651 Q1601600 SPACE 1 @OZ26939 Q1601700 PATWAIT $WAIT IMAG WAIT FOR SUBTASK TO INIT @OZ26939 Q1601800 TM 0(PW),X'80' HASPIMAG INITIALIZED... @OZ26939 Q1601900 BNO PATWAIT BR IF NOT YET @OZ26939 Q1602000 SPACE 1 @OZ26939 Q1602100 EJECT R4 Q1604000 EJECT @G38ESBB Q1613000 ***************************************************************@G38ESBB Q1614000 * @G38ESBB Q1615000 * CALL SUBROUTINE TO SETUP PRINT/PUNCH HEADER @G38ESBB Q1616000 * @G38ESBB Q1617000 ***************************************************************@G38ESBB Q1618000 SPACE 1 @G38ESBB Q1619000 PCLDSTRT L R15,=A(PHEADER) CALL SUBROUTINE TO @G38ESBB Q1620000 BALR PL,R15 SETUP PRINT HEADER @G38ESBB Q1621000 BM PPDSEND ENTER DATA SET TERMINATION @G38ESBB Q1621500 BP PPABORT ENTER PROCESSOR ABORT @G38ESBB Q1622000 SPACE 1 @G38ESBB Q1623000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q1624000 * DELETED @G38ESBB Q1629000 * DELETED @G38ESBB Q1630000 * DELETED @G38ESBB Q1631000 * DELETED @G38ESBB Q1632000 * DELETED @G38ESBB Q1633000 * DELETED @G38ESBB Q1634000 * DELETED @G38ESBB Q1635000 * DELETED @G38ESBB Q1636000 * DELETED @G38ESBB Q1638000 * DELETED @G38ESBB Q1638500 * DELETED @G38ESBB Q1639000 * DELETED @G38ESBB Q1640000 * DELETED @G38ESBB Q1640500 * DELETED @G38ESBB Q1641000 * DELETED @G38ESBB Q1641500 * DELETED @G38ESBB Q1642000 * DELETED @G38ESBB Q1643000 * DELETED @G38ESBB Q1644000 * DELETED @G38ESBB Q1645000 * DELETED @G38ESBB Q1646000 * DELETED @G38ESBB Q1647000 * DELETED @G38ESBB Q1648000 * DELETED @G38ESBB Q1648100 * DELETED @G38ESBB Q1648200 * DELETED @G38ESBB Q1648300 * DELETED @G38ESBB Q1648400 * DELETED @G38ESBB Q1648500 * DELETED @G38ESBB Q1648600 * DELETED @G38ESBB Q1648700 * DELETED @G38ESBB Q1648800 * DELETED @G38ESBB Q1648900 * DELETED @G38ESBB Q1649000 * DELETED @G38ESBB Q1649100 * DELETED @G38ESBB Q1649200 * DELETED @G38ESBB Q1649300 * DELETED @G38ESBB Q1649400 * DELETED @G38ESBB Q1649500 * DELETED @G38ESBB Q1650000 * DELETED @G38ESBB Q1651000 * DELETED @G38ESBB Q1652000 * DELETED @G38ESBB Q1653000 * DELETED @G38ESBB Q1654000 * DELETED @G38ESBB Q1655500 * DELETED @G38ESBB Q1656000 * DELETED @G38ESBB Q1657000 * DELETED @G38ESBB Q1658000 * DELETED @G38ESBB Q1659000 * DELETED @G38ESBB Q1659200 * DELETED @G38ESBB Q1659400 * DELETED @G38ESBB Q1660000 * DELETED @G38ESBB Q1661000 * DELETED @G38ESBB Q1662000 * DELETED @G38ESBB Q1663000 * DELETED @G38ESBB Q1664000 * DELETED @G38ESBB Q1665000 * DELETED @G38ESBB Q1666000 * DELETED @G38ESBB Q1667000 * DELETED @G38ESBB Q1667100 * DELETED @G38ESBB Q1667300 * DELETED @G38ESBB Q1667500 * DELETED @G38ESBB Q1667600 * DELETED @G38ESBB Q1667700 * DELETED @G38ESBB Q1667800 * DELETED @G38ESBB Q1667900 * DELETED @G38ESBB Q1668000 * DELETED @G38ESBB Q1668100 * DELETED @G38ESBB Q1668200 * DELETED @G38ESBB Q1668300 * DELETED @G38ESBB Q1668400 * DELETED @G38ESBB Q1669000 * DELETED @G38ESBB Q1670000 * DELETED @G38ESBB Q1671000 * DELETED @G38ESBB Q1672000 * DELETED @G38ESBB Q1673000 * DELETED @G38ESBB Q1674000 * DELETED @G38ESBB Q1675000 * DELETED @G38ESBB Q1676000 * DELETED @G38ESBB Q1677000 * DELETED @G38ESBB Q1678000 * DELETED @G38ESBB Q1679000 * DELETED @G38ESBB Q1680000 * DELETED @G38ESBB Q1681000 * DELETED @G38ESBB Q1682000 * DELETED @G38ESBB Q1683000 * DELETED @G38ESBB Q1684000 * DELETED @G38ESBB Q1685000 * DELETED @G38ESBB Q1686000 * DELETED @G38ESBB Q1687000 * DELETED @G38ESBB Q1688000 * DELETED @G38ESBB Q1689000 * DELETED @G38ESBB Q1690000 * DELETED @G38ESBB Q1691000 * DELETED @G38ESBB Q1692000 * DELETED @G38ESBB Q1693000 * DELETED @G38ESBB Q1694000 * DELETED @G38ESBB Q1695000 * DELETED @G38ESBB Q1696000 EJECT R4 Q1697000 * DELETED @G38ESBB Q1717000 * DELETED @G38ESBB Q1718000 * DELETED @G38ESBB Q1719000 * DELETED @G38ESBB Q1719200 * DELETED @G38ESBB Q1719400 * DELETED @G38ESBB Q1720000 * DELETED @G38ESBB Q1721000 * DELETED @G38ESBB Q1722000 * DELETED @G38ESBB Q1723000 * DELETED @G38ESBB Q1723100 * DELETED @G38ESBB Q1723200 * DELETED @G38ESBB Q1723300 * DELETED @G38ESBB Q1723400 * DELETED @G38ESBB Q1723500 * DELETED @G38ESBB Q1723600 * DELETED @G38ESBB Q1723700 * DELETED @G38ESBB Q1723800 * DELETED @G38ESBB Q1723900 * DELETED @G38ESBB Q1724000 * DELETED @G38ESBB Q1724100 * DELETED @G38ESBB Q1724200 * DELETED @G38ESBB Q1724300 PRINT ON THIS SECTION DELETED BY @G38ESBB Q1724400 SPACE 1 @G38ESBB Q1724410 TM PPFLAG,PPDELSW+PRDELSW TEST FOR DELETION @OZ41172 Q1724420 BO PCKPTNIT YES, BYPASS NEWS @OZ41172 Q1724430 TM PPFLAG,PPNEWS NEWS DATA SET... @G38ESBB Q1724500 BZ PCKPTNIT BR IF NO @G38ESBB Q1724600 B PNEWSGO ELSE GO PRINT NEWS @G38ESBB Q1724700 SPACE 1 @G38ESBB Q1724800 PENDNEWS DS 0H * RETURN HERE AFTER NEWS * @OZ45008 Q1724900 BAL PL,PRDTCHK CHECK FOR READ COMPLETE @OZ45008 Q1724925 LM PC1,PC2,PRCCWEJ LOAD EJECT CCW @OZ45008 Q1724950 BAL PL,PPPUT SKIP @G38ESBB Q1725000 BAL PL,PPWRITE TO TOP @G38ESBB Q1725100 BAL PL,PPCHECK OF PAGE @G38ESBB Q1725200 NI PPFLAG,FF-PPNEWS-PPRDERR RESET NEWS AND ER FLGS @G38ESBB Q1725300 EJECT R41 Q1725400 *********************************************************************** Q1725500 * * Q1725600 * INITIALIZE PRPU CHECKPOINT DATA AREA * Q1725700 * * Q1725800 * COPY CKPT-JOE TO PRPU CHECKPOINT DATA AREA ON WARM START * Q1725900 * * Q1726000 *********************************************************************** Q1726100 SPACE 1 R41 Q1726200 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY R41 Q1726300 SPACE 1 R41 Q1726400 PCKPTNIT MVC PPJOBKEY,JCTJBKEY SET JOB KEY R41 Q1726500 TM PCKJOE,$JOECKV WARM START... R41 Q1726600 BO PWARMNIT BR IF YES R41 Q1726700 XC PCKPT,PCKPT CLEAR PRPU CKPT DATA AREA R41 Q1726800 L PW,$IOTPDDB SET INITIAL R41 Q1726900 STH PW,PDDBDISP PDDB DISPLACEMENT R41 Q1727000 MVC PCEIOTTR,JCTIOT SET IOT MTTR R41 Q1727100 SPACE 1 R41 Q1727200 L R1,PWKJOE ADDRESS WORK-JOE R41 Q1727300 TM JOEFLAG,$JOESPIN SPIN JOE... R41 Q1727400 BZ PPAGSIZE BR IF NO R41 Q1727500 MVC PCEIOTTR,JOEIOTTR ELSE SET SPIN-IOT MTTR R41 Q1727600 OI PSMFDCI,SMFSPIN SET SPIN SMF FLAG R41 Q1727700 B PPAGSIZE CONTINUE R41 Q1727800 SPACE 1 R41 Q1727900 PWARMNIT L R1,PCKJOE ADDRESS CKPT-JOE R41 Q1728000 MVC PCKPT,JOECKPP REFRESH PRPU CKPT DATA AREA @OZ27300 Q1728100 MVC PBUFSKIP,PCEJBOFF SET BUFFER OFFSET FOR RESTART R41 Q1728200 OI PSMFDCI,SMFINTRC SET WARM-START SMF FLAG R41 Q1728300 SPACE 1 R41 Q1728400 DROP R1 SUSPEND JOE ADDRESSABILITY R41 Q1728500 SPACE 1 R41 Q1728600 *********************************************************************** Q1728700 * * Q1728800 * SETUP MAXIMUM PHYSICAL PAGE SIZE FOR PRINTERS @OZ19494 Q1728900 * * Q1729000 *********************************************************************** Q1729100 SPACE 1 R41 Q1729200 PPAGSIZE SLR PW,PW GET JOB'S R41 Q1729300 IC PW,JCTLINCT PAGE SIZE (LINE COUNT) R41 Q1729400 BCTR PW,0 SET PHYSICAL PAGE SIZE @OZ19494 Q1729500 ST PW,PRLINECT FOR PRINTERS. PUNCH @OZ19494 Q1729600 * PAGE SIZE SET FROM @OZ19494 Q1729700 * CKPTLNS IN PGOTPDDB @OZ19494 Q1729800 * ROUTINE. @OZ19494 Q1729900 * THIS LINE DELETED BY APAR @OZ19494 Q1730000 SPACE 1 R41 Q1730100 TM PPFLAG,PPDELSW DELETION DURING PRPU INIT... R41 Q1730200 BZ PENDINIT BRANCH IF NO @OZ37777 Q1730300 TM PPFLAG,PRDELSW TEST FOR TERMINATION @OZ37777 Q1730350 BO PPDONE BRANCH IF SO TO TERMINATE @OZ37777 Q1730400 NI PPFLAG,255-PPDELSW ELSE IGNORE $B, $F @OZ37777 Q1730450 TITLE 'HASP PRINT/PUNCH SERVICE -- DATA SET SELECTION' OZ39705 Q1730460 *********************************************************************** Q1730500 * * Q1731000 * PROCESSOR INITIALIZATION COMPLETE - READ/CHECK/VERIFY IOT * Q1732000 * * Q1733000 *********************************************************************** Q1734000 SPACE 1 R4 Q1735000 PENDINIT DS 0H Q1736000 L R15,PCEIOTTR GET IOT MTTR Q1737000 BAL PL,PRDBUF INITIATE READ OF IOT Q1738000 BAL PL,PRDCHK CHECK READ Q1739000 LR JCT,PBUF ADDRESS IOT IN BUFFER Q1740000 USING IOTDSECT,JCT ACTIVATE IOT ADDRESSABILITY Q1741000 TM PPFLAG,PPRDERR TEST FOR I/O ERROR ON READ Q1742000 BO PIOTPRE BR IF YES R4 Q1743000 CLC IOTJBKEY,PPJOBKEY IS THIS IOT VALID Q1744000 BE PPIOTOK BRANCH IF YES Q1745000 PIOTPRE $DISTERR INDICATE CONTROL BLOCK ERROR Q1746000 OI PPFLAG,PPJCTIOT+PRDELSW REASON FOR TERMINATION Q1747000 B PPDONE ABORT JOB Q1748000 PPIOTOK DS 0H Q1749000 TM IOTFLAG1,IOT1SPIN SPIN DATA SET... R4 Q1750000 BNO *+8 BRANCH IF NO - NO $PURGE AT EOJ Q1751000 OI PPFLAG,PPDALOC SET $PURGE REQUIRED FLAG Q1752000 LH PC1,PDDBDISP GET NEXT PDDB DISPLACEMENT Q1753000 SPACE 3 R4 Q1754000 *********************************************************************** Q1755000 * * Q1756000 * SELECT NEW PDDB -- GO READ NEXT IOT IF NONE LEFT * Q1757000 * * Q1758000 *********************************************************************** Q1759000 SPACE 1 R4 Q1760000 USING JCTDSECT,R15 PROVIDE JCT ADDRESSABILITY R4 Q1761000 USING PDBDSECT,PC2 PROVIDE PDDB ADDRESSABILITY R4 Q1762000 SPACE 1 R4 Q1763000 PDDBNEXT DS 0H Q1764000 L R15,PJCTBUF ADDRESS JCT IN BUFFER Q1765000 LA PC2,0(PC1,JCT) GENERATE ABSOLUTE ADDRESS Q1766000 CL PC1,IOTPDDBP END OF PDDB'S IN THIS IOT Q1767000 BNE PPPDB BRANCH IF NO Q1768000 TM IOTFLAG1,IOT1SPIN IS THIS A SPIN/HOLD IOT Q1769000 BO PPDONE BRANCH IF YES Q1770000 ICM R15,15,IOTIOTTR LOAD AND TEST NEXT TRACK Q1771000 BZ PPDONE BRANCH IF NO MORE IOTS Q1772000 ST R15,PCEIOTTR SAVE NEW TRACK IN PCE Q1773000 L R14,$IOTPDDB SET INITIAL PDDB OFFSET R4 Q1774000 STH R14,PDDBDISP IN CKPT AREA OF PCE Q1775000 B PENDINIT READ NEXT IOT Q1776000 EJECT R4 Q1777000 *********************************************************************** Q1778000 * * Q1779000 * VERIFY THAT PDDB MATCHES WORK/CHAR-JOE -- ELSE SKIP IT * Q1780000 * * Q1781000 *********************************************************************** Q1782000 SPACE 1 R4 Q1783000 PPPDB DS 0H Q1784000 TM PDBFLAG1,PDB1NULL+PDB1NSOT IS PDDB NULL/NOT SYSOUT Q1785000 BNZ PDDBSRCH BRANCH IF YES Q1786000 * Q1787000 * CHECK SYSOUT CLASS Q1788000 * Q1789000 L PW,PWKJOE ADDRESS WORK JOE R4 Q1790000 USING JOEDSECT,PW ACTIVATE JOE ADDRESSABILITY R4 Q1791000 CLC PDBCLASS,JOEPDBCL DOES CLASS MATCH JOE R4 Q1792000 BNE PDDBSRCH BRANCH IF NO Q1793000 * Q1794000 * CHECK REMAINING CHARACTERISTICS Q1795000 * Q1796000 TM JOEFLAG2,$JOEDMND TEST FOR DEMAND-SETUP OPTION R4 Q1797000 L PW,PCHJOE ADDRESS CHAR-JOE Q1798000 BZ SKIP130 SKIP CLASS TEST IF NOT CHOSEN R4 Q1799000 CLC PDBCLASS,JCTMCLAS DOES SYSOUT CLASS = MSGCLASS Q1800000 BE PPDEMAND BRANCH IF YES - DEMAND SETUP Q1801000 SKIP130 CLC JOEFORM(12),PDBFORMS CHECK FORMS, FCB, UCS Q1802000 BNE PDDBSRCH BRANCH IF NOT MATCHING Q1803000 CLC JOEFLASH,PDBFLASH CHECK OVERLAY-FRAME R4 Q1804000 BNE PDDBSRCH IF NOT MATCHING, BRANCH R4 Q1805000 TM PDBFLAG2,PDB2BRST VERIFY R4 Q1806000 BZ SKIP140 THAT R4 Q1807000 TM JOECFLAG,$JOEBRST PDDB R4 Q1808000 BZ PDDBSRCH BURSTER R4 Q1809000 B PPDEMAND SPECIFICATION R4 Q1810000 SKIP140 TM JOECFLAG,$JOEBRST MATCHES R4 Q1811000 BO PDDBSRCH CHAR-JOE R4 Q1812000 PPDEMAND CLC JOEWTRID,PDBWTRID CHECK EXTERNAL WRITER NAME R4 Q1813000 BNE PDDBSRCH BRANCH IF NOT MATCHING Q1814000 L PW,PWKJOE ADDRESS WORK-JOE Q1815000 CLC JOEDEST,PDBDEST CHECK DESTINATION Q1816000 BE PGOTPDDB BR IF SAME -- DATA SET SELECTED R4 Q1817000 SPACE 1 R4 Q1818000 *********************************************************************** Q1819000 * * Q1820000 * PDDB DOES NOT MATCH WORK/CHAR-JOE -- STEP TO NEXT * Q1821000 * * Q1822000 *********************************************************************** Q1823000 SPACE 1 R4 Q1824000 PDDBSRCH DS 0H R4 Q1825000 LH PC1,PDDBDISP GET CURRENT PDDB OFFSET R4 Q1826000 LA PC1,PDBLENG(,PC1) STEP TO NEXT PDDB R4 Q1827000 STH PC1,PDDBDISP SAVE NEW PDDB OFFSET IN CKPT AREA R4 Q1828000 B PDDBNEXT GO TEST NEW PDDB R4 Q1829000 SPACE 1 R4 Q1830000 DROP PW,R15 SUSPEND JOE/JCT ADDRESSABILITY R4 Q1831000 EJECT R4 Q1832000 *********************************************************************** Q1833000 * * Q1834000 * PDDB MATCHES -- SETUP PRPU WORK AREA FOR DATA SET * Q1835000 * * Q1836000 *********************************************************************** Q1837000 SPACE 1 R4 Q1838000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @OZ19494 Q1838100 SPACE 1 @OZ19494 Q1838200 PGOTPDDB DS 0H R4 Q1839000 MVC PMESSAGE(12),PDBFORMS SAVE SETUP Q1840000 MVC PRINDEX,PDBINDEX SAVE 3211 INDEX VALUE Q1841000 * THIS LINE DELETED BY APAR NUMBER @OZ33895 Q1842000 MVC PPDSKEY,PDBDSKEY SAVE DATA SET KEY Q1843000 L R15,PCEDCT ADDRESS PRINTER DCT @OZ32566 Q1843500 MVC DCTACPTN,DCTDCPTN SET DEFAULT CPT NUMBER @OZ19494 Q1843600 CLI PDBCPTN,X'FF' IF PDDB CPT NUMBER NOT SPECIFIED R41 Q1843700 BE PCKPTPL USE DEFAULT @OZ19494 Q1843720 MVC DCTACPTN,PDBCPTN USE CPT NUMBER IN PDDB @OZ19494 Q1843740 SPACE 1 @OZ19494 Q1843760 PCKPTPL MVC PCKPTPSV,DCTCKPTP INITIALIZE CKPTPGS SAVE @OZ19494 Q1843780 MVC PCKPTP,DCTCKPTP AREA AND COUNTER FROM DCT @OZ19494 Q1843800 MVC PCKPTLSV,DCTCKPTL INITIALIZE CKPTLNS SAVE @OZ19494 Q1843820 MVC PCKPTL,DCTCKPTL AREA AND COUNTER FROM DCT @OZ19494 Q1843840 CLC PDBCKPTP,=X'FFFF' TEST PDDB CKPTPGS VALUE @OZ19494 Q1843860 BE PCKPTLNS BRANCH IF NOT SPECIFIED @OZ19494 Q1843880 MVC PCKPTPSV,PDBCKPTP INITIALIZE CKPTPGS SAVE @OZ19494 Q1843900 MVC PCKPTP,PDBCKPTP AREA AND COUNTER FROM PDDB @OZ19494 Q1844000 PCKPTLNS CLC PDBCKPTL,=X'FFFF' TEST PDDB CKPTLNS VALUE @OZ19494 Q1844020 BE PUNLPAGE BRANCH IF NOT SPECIFIED @OZ19494 Q1844040 TM PCEID,PCEPRSID TEST PROCESSOR TYPE @OZ19494 Q1844060 BO PCKPTL1 BRANCH IF PRINT PROCESSOR @OZ19494 Q1844080 CLC PDBCKPTL,=H'0' TEST CKPTLNS FOR A PUNCH @OZ19494 Q1844100 BE PUNLPAG1 ILLEGAL IF 0, USE DCT VALUE @OZ19494 Q1844120 PCKPTL1 MVC PCKPTLSV,PDBCKPTL INITIALIZE CKPTLNS SAVE @OZ19494 Q1844140 MVC PCKPTL,PDBCKPTL AREA AND COUNTER FROM PDDB @OZ19494 Q1844160 PUNLPAGE TM PCEID,PCEPRSID TEST PROCESSOR TYPE @OZ19494 Q1844180 BO PSYSOUT BRANCH IF PRINTER @OZ19494 Q1844200 PUNLPAG1 LH R1,PCKPTL FOR PUNCHES, LOGICAL @OZ19494 Q1844220 BCTR R1,0 PAGE SIZE (CKPTLNS) @OZ19494 Q1844240 ST R1,PRLINECT EQUALS PHYSICAL PAGE SIZE @OZ19494 Q1844260 SPACE 1 @OZ19494 Q1844270 DROP R15 SUSPEND DCT ADDRESSABILITY @OZ19494 Q1844460 EJECT @OZ19494 Q1844480 PSYSOUT MVI PPDIRID,X'00' INDICATE SYSOUT PDIR @OZ19494 Q1844500 MVC PPDSRCT(4),PDBRECCT SAVE PDDB DATASET REC COUNT @OZ19494 Q1844600 TM PCKJOE,$JOECKV SAVE 1ST MTTR @OZ19494 Q1844700 BO PSAVMTTR OF DATA SET IF @G38ESBB Q1845000 MVC PCEJMTTR,PDBMTTR COLD START - ELSE USE CKPT JOE R4 Q1846000 SPACE 1 R4 Q1847000 PSAVMTTR MVC PPLC,PDBMTTR SAVE BEGIN DATA SET MTTR @G38ESBB Q1848000 TM PDBFLAG2,PDB2TCEL PDDB SPECIFY TRACK-CELL... @G38ESBB Q1848500 BO PTSTNIPR BR IF YES R4 Q1849000 TM PPFLAG2,PPTCEL TEST FOR PREVIOUS TRACK-CELL'ING R4 Q1850000 BZ PTSTNIPR BR IF NO R4 Q1851000 * R4 Q1852000 * NON-TRACK-CELL'ED PDDB DETECTED IN TRACK-CELL'ED JOE R4 Q1853000 * R4 Q1854000 $FREEBUF PINIOB FREE-UP INPUT CCW BUFFER R4 Q1855000 NI PPFLAG2,255-PPTCEL RESET DESPOOLING METHOD TO SINGLE R4 Q1856000 ST PBUF,PINIOB USE IOB IN DATA BUFFER R4 Q1857000 SPACE 1 R4 Q1858000 CLI PBUFOPT,2 TEST BUFFER OPTION R4 Q1859000 BL PNOTCEL1 BR IF NOT DOUBLE R4 Q1860000 L R1,PBUFSAVE ADDRESS SECONDARY BUFFER CHAIN R4 Q1861000 L R1,BUFCHAIN-BUFDSECT(,R1) FREE ALL BUT 1ST R4 Q1862000 $FREEBUF (R1),MULTIPLE BUFFER IN CHAIN R4 Q1863000 SPACE 1 R4 Q1864000 PNOTCEL1 L R1,PBUFADDR ADDRESS PRIMARY BUFFER CHAIN R4 Q1865000 L R1,BUFCHAIN-BUFDSECT(,R1) FREE ALL BUT 1ST R4 Q1866000 $FREEBUF (R1),MULTIPLE BUFFER IN CHAIN R4 Q1867000 SPACE 1 R4 Q1868000 EJECT R4 Q1869000 *********************************************************************** Q1870000 * * Q1871000 * SETUP FOR 3800 PRINTERS * Q1872000 * * Q1873000 *********************************************************************** Q1874000 SPACE 1 R4 Q1875000 PTSTNIPR DS 0H R4 Q1876000 B PSMFTST CHECK IF SMF6 NEEDED @OZ33895 Q1877000 PSETNIPR DS 0H @OZ33895 Q1878000 MVC PFLASHC,PDBFLSHC MOVE FLASH COUNT TO WORK AREA R4 Q1879000 XC PCOPYGRP,PCOPYGRP ZERO COPY GROUPS IN WORK AREA R4 Q1880000 MVI SPFLAG,0 CLEAR SETUP FLAGS R4 Q1883000 TM PDBFLAG2,PDB2BRST TEST FOR BURSTING R4 Q1884000 BZ PNOBURST BR IF NO R4 Q1885000 OI SPFLAG,SPBURST SET BURST SETUP FLAG R4 Q1886000 PNOBURST DS 0H R4 Q1887000 MVC SPFORMS(2*4),PDBFORMS FORMS/FCB R4 Q1888000 MVC SPCHAR1(6*4+2*1),PDBCHAR1 CHAR1-4/FLSH/MODF/FLSHC/TRC R4 Q1889000 CLI PDBCOPYG,0 TST FOR NULL COPY GROUPS R4 Q1890000 BE PNIPSET1 BR IF YES R4 Q1891000 SLR R0,R0 CLEAR R4 Q1892000 SLR R1,R1 WORK R4 Q1893000 SLR PW,PW REGISTERS R4 Q1894000 LA PL,8 MAX COPY GROUPS R4 Q1895000 SPACE 1 R4 Q1896000 PCGROUPS IC R0,PDBCOPYG(R1) INITIALIZE R4 Q1897000 ALR PW,R0 COPY-GROUPS R4 Q1898000 CH PW,=H'255' ENSURING THAT R4 Q1899000 BH PCGT255 TOTAL R4 Q1900000 STC R0,PCOPYGRP(R1) DOES NOT R4 Q1901000 LA R1,1(,R1) EXCEED R4 Q1902000 BCT PL,PCGROUPS 255 R4 Q1903000 STC PW,PPDSCPY DATA SET R4 Q1904000 B PNIPSET1 COPIES R4 Q1905000 SPACE 1 R4 Q1906000 PCGT255 SH PW,=H'255' IF EXCESSION, R4 Q1907000 SLR R0,PW AJUST FOR R4 Q1908000 STC R0,PCOPYGRP(R1) ONLY 255 R4 Q1909000 MVI PPDSCPY,255 COPIES R4 Q1910000 SPACE 1 R4 Q1911000 EJECT R4 Q1912000 PNIPSET1 DS 0H R4 Q1913000 SLR R1,R1 DETERMINE R4 Q1914000 LA R0,3 MAXIMUM R4 Q1915000 LA PL,PDBCHAR2 VALUE R4 Q1916000 PCNTRC CLC =C'****',0(PL) ALLOWED R4 Q1917000 BE SKIP160 FOR ( OPTCD=J ) R4 Q1918000 LA R1,1(,R1) IMBEDDED R4 Q1919000 LA PL,4(,PL) TABLE- R4 Q1920000 BCT R0,PCNTRC REFERENCE- R4 Q1921000 SKIP160 STC R1,PRMAXTRC CHARACTERS (TRC) R4 Q1922000 SPACE 1 R4 Q1923000 TM PCKJOE,$JOECKV TEST FOR WARM START R4 Q1924000 BO PNIPWARM BR IF YES R4 Q1925000 MVI SPCOPYS,1 ELSE, INIT STARTING COPY NUMBER R4 Q1926000 MVI SPCOPYN,1 ASSUME 1 COPY R4 Q1927000 CLI PCOPYGRP,0 TEST FOR COPY GROUPS SPECIFIED R4 Q1928000 BE SKIP170 BR IF NOT--ASSUMPTION OK R4 Q1929000 MVC SPCOPYN,PCOPYGRP ELSE, USE 1ST TRANSMISSION COUNT R4 Q1930000 SKIP170 MVI PDDBCPYG,0 RESET COPY GROUP OFFSET R4 Q1931000 B PPDBSETF GO SET PPFLAGS @OZ33895 Q1932000 SPACE 3 R4 Q1933000 *********************************************************************** Q1934000 * * Q1935000 * SETUP FOR 3800 DATA SET WARM START * Q1936000 * * Q1937000 *********************************************************************** Q1938000 SPACE 1 R4 Q1939000 PNIPWARM DS 0H R4 Q1940000 LA R1,1 ASSUME 1 COPY THIS TRANSMISSION R4 Q1941000 CLI PCOPYGRP,0 TEST FOR COPY GROUPS SPECIFIED R4 Q1942000 BE SKIP180 BR IF NOT - ASSUMPTION OK R4 Q1943000 IC R1,PDDBCPYG ELSE, PICK UP OFFSET TO R4 Q1944000 IC R1,PCOPYGRP(R1) COPY GROUP AND GET COUNT R4 Q1945000 SKIP180 STC R1,SPCOPYN MOVE NO. COPIES TO SETUP LIST R4 Q1946000 MVI SPFLASHC,0 ASSUME NO FLASHING R4 Q1947000 IC R1,PPRCPYCT GET TOTAL COPIES ALREADY PRINTED R4 Q1948000 SLR R0,R0 COMPUTE NUMBER R4 Q1949000 IC R0,PFLASHC OF COPIES LEFT TO R4 Q1950000 SR R0,R1 BE FLASHED R4 Q1951000 BP PSETFLC BR IF MORE FLASHING @OZ38238 Q1952000 OI SPFLAG,SPNOFLSH ELSE TURN OFF FLASHING @OZ38238 Q1952200 B PSETCPYN BR TO CONTINUE @OZ38238 Q1952400 SPACE 1 @OZ38238 Q1952600 PSETFLC STC R0,SPFLASHC MOVE REMAINING FLASH COUNT @OZ38238 Q1953000 SPACE 1 @OZ38238 Q1953500 PSETCPYN LA R1,1(,R1) INDICATE STARTING @OZ38238 Q1954000 STC R1,SPCOPYS COPY NUMBER R4 Q1955000 B PPDBSETF GO SET PPFLAGS @OZ33895 Q1955500 SPACE 1 R4 Q1956000 EJECT R4 Q1957000 *********************************************************************** Q1958000 * * Q1959000 * WRITE A NEW TYPE 6 SMF RECORD IF PERTINENT DATA HAS CHANGED * Q1960000 * * Q1961000 *********************************************************************** Q1962000 SPACE 1 R4 Q1963000 PSMFTST CLI $NUMSMFB,2 TEST SMF BUFFER COUNT R4 Q1964000 BL PPDBFLGS BR IF SMF NOT SUPPORTED R4 Q1965000 SPACE 1 R4 Q1966000 L PW,PCEDCT PROVIDE DCT @OZ32566 Q1967000 USING DCTDSECT,PW ADDRESSABILITY R4 Q1968000 SPACE 1 R4 Q1969000 TM PCKJOE,$JOECKV TEST FOR WARM START R4 Q1970000 BO PPDBFLGS BR IF YES R4 Q1971000 TM PPFLAG2,PPFDS TEST FOR 1ST DATA SET R4 Q1972000 BO PPDBFLGS BR IF YES R4 Q1973000 SPACE 1 R4 Q1974000 TM PSMFDCI,SMFINTRC+SMFOPCC WARM-START/CARR. OVERRIDE... R4 Q1975000 BNZ PNEW6 SMF6 IF EITHER R4 Q1976000 TM PPFLAG2,PSMFDSER DATA BUFFER ERROR... R4 Q1977000 BO PNEW6 SMF6 IF YES R4 Q1978000 SPACE 1 R4 Q1979000 CLC DCTFORMS,PDBFORMS FORMS MATCH... R4 Q1980000 BNE PNEW6 SMF6 IF NOT R4 Q1981000 SPACE 1 R4 Q1982000 CLC DCTFCB,PDBFCB FCB MATCH... R4 Q1983000 BE PSMFTPUN BR IF YES R41 Q1984000 CLC PDBFCB,=CL4'****' TEST FOR DEFAULT R4 Q1985000 BNE PNEW6 SMF6 IF NOT R4 Q1986000 TM DCTPPSW,DCTPPSWB IS DEVICE FCB STANDARD... R4 Q1987000 BNZ PNEW6 SMF6 IF NOT R4 Q1988000 SPACE 1 R4 Q1996000 PSMFTPUN CLI PDEVTYPE+3,UCB3525 TEST FOR 3525 PUNCH R4 Q1997000 BNE PSMFTUCS BR IF NOT R41 Q1998000 TM PDEVTYPE+1,X'30' ARE PRINT FEATURES AVAIL.. @OZ45069 Q1999000 BZ PSMFTUCS BR IF NOT R41 Q2000000 LA R1,PBFUNCI COMPARE FUNC=I R4 Q2001000 BAL PL,PBITSAME SPECIFICATIONS R4 Q2002000 SPACE 1 R41 Q2003000 PSMFTUCS CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R41 Q2003200 BE PSMFNIP BR IF YES R41 Q2003400 CLC DCTUCS,PDBUCS UCS MATCH... R41 Q2003600 BE PPDBFLGS BR IF YES R41 Q2003800 CLC PDBUCS,=C'****' TEST FOR DEFAULT R41 Q2004000 BNE PNEW6 SMF6 IF NOT R41 Q2004200 TM DCTPPSW,DCTPPSWU IS DEVICE UCS STANDARD... @OZ28771 Q2004400 BNZ PNEW6 SMF6 IF NOT R41 Q2004600 B PPDBFLGS NEW SMF TYPE 6 NOT NEEDED R41 Q2004800 EJECT R41 Q2005000 PSMFNIP CLC =C'****',PDBCHAR1 IF CHAR1 NOT SPECIFIED, @OZ31424 Q2005200 BNE *+10 THEN UPDATE IN-STORAGE @OZ31424 Q2005400 MVC PDBCHAR1,DCTUCS PDDB WITH PRINTER DEFAULT @OZ31424 Q2005600 LA R0,4 CHECK 4 PDDB CHAR FIELDS @OZ31424 Q2005800 LA R15,4 WITH 4 DCT CHAR FIELDS @OZ31424 Q2006000 LA R1,PDBCHAR1 R1 = POINTER TO PDDB CHARS @OZ31424 Q2006200 SPACE 1 @OZ31424 Q2006400 PSCHLUP1 LA PL,DCTCHAR1 PL = POINTER TO DCT CHARS @OZ31424 Q2006600 SPACE 1 @OZ31424 Q2006800 PSCHLUP2 CLC 0(4,PL),0(R1) DOES THIS @OZ31424 Q2007000 BE PSCHNEXT PDDB CHAR @OZ31424 Q2007200 LA PL,4(,PL) MATCH ANY @OZ31424 Q2007400 BCT R0,PSCHLUP2 DCT CHAR FIELD... @OZ31424 Q2007600 B PNEW6 NEW SMF6 IF NOT @OZ31424 Q2007800 SPACE 1 @OZ31424 Q2008000 PSCHNEXT LA R1,4(,R1) LOOP, CHECKING @OZ31424 Q2008200 CLC =C'****',0(R1) ALL SPECIFIED @OZ31424 Q2008400 BE *+8 PDDB CHAR FIELDS. @OZ31424 Q2008600 BCT R15,PSCHLUP1 FALL THROUGH IF ALL MATCH @OZ31424 Q2008800 CLC DCTFLASH(2*4),PDBFLASH FLASH, MODIFY MATCH... @OZ31424 Q2009000 BNE PNEW6 SMF6 IF NOT @OZ31424 Q2009200 CLC PCOPYGRP,PDBCOPYG COPY GROUPS MATCH... R4 Q2010000 BNE PNEW6 SMF6 IF NOT R4 Q2011000 CLC PFLASHC,PDBFLSHC FLASH COUNTS MATCH... R4 Q2012000 BNE PNEW6 SMF6 IF NOT R4 Q2013000 SPACE 1 R4 Q2014000 LA R1,PBOPTJ COMPARE OPTCD=J R4 Q2015000 BAL PL,PBITSAME SPECIFICATIONS R4 Q2016000 LA R1,PBBURST COMPARE BURSTER R4 Q2017000 BAL PL,PBITSAME SPECIFICATIONS R4 Q2018000 SPACE 1 R4 Q2019000 B PPDBFLGS BR IF NEW TYPE 6 NOT NEEDED R4 Q2020000 SPACE 5 Q2021000 PBFUNCI TM PDBFUNC,X'80' FUNC=I *** EXECUTE *** R4 Q2022000 TM PPFLAG,PPFUNCI *** ONLY *** R4 Q2023000 SPACE 1 R4 Q2024000 PBOPTJ TM PDBFLAG2,PDB2OPTJ DCB=OPTCD=J *** EXECUTE *** R4 Q2025000 TM PPFLAG2,PPOPTJ *** ONLY *** R4 Q2026000 SPACE 1 R4 Q2027000 PBBURST TM PDBFLAG2,PDB2BRST BURST=Y/N *** EXECUTE *** R4 Q2028000 TM DCTPPSW2,DCTNIBRS *** ONLY *** R4 Q2029000 SPACE 2 R4 Q2030000 * R4 Q2031000 * PBITSAME -- RETURNS TO CALLER IF FLAGS MATCH R4 Q2032000 * R4 Q2033000 SPACE 1 R4 Q2034000 PBITSAME EX 0,0(,R1) TEST R4 Q2035000 BZ SKIP200 IF R4 Q2036000 EX 0,4(,R1) BOTH R4 Q2037000 BZ PNEW6 FLAG R4 Q2038000 BR PL BITS R4 Q2039000 SKIP200 EX 0,4(,R1) MATCH R4 Q2040000 BZR PL RETURN -- BITS MATCH. ELSE, R4 Q2041000 EJECT Q2042000 *********************************************************************** Q2043000 * * Q2044000 * NEW TYPE 6 NEEDED -- CALL PPSMF6 AND RESET DATA * Q2045000 * * Q2046000 *********************************************************************** Q2047000 SPACE 1 R4 Q2048000 PNEW6 L R15,=A(PPSMF6) GENERATE NEW @OZ32776 Q2049000 BALR PL,R15 TYPE-6 SMF RECORD @OZ32776 Q2049500 SPACE 1 R4 Q2050000 $TIME , GET CURRENT TIME/DATE R4 Q2051000 STM R0,R1,PTIMEON RESET PRPU START TIME/DATE R4 Q2052000 XC PPLNCDCT,PPLNCDCT CURRENT RECORD COUNT R4 Q2053000 XC PRPAGECT,PRPAGECT CURRENT PAGE COUNT R4 Q2054000 XC PPJNDS,PPJNDS CURRENT DATA SET COUNT R4 Q2055000 XC PSMFDCI,PSMFDCI DATA SET CONTROL INDICATORS R4 Q2056000 NI PPFLAG2,255-PSMFDSER DATA BUFFER ERROR FLAG R4 Q2057000 SPACE 1 @OZ33895 Q2057100 PPDBFLGS MVC PPDSCPY,PDBCOPYS SAVE DATA SET COUNT @OZ33895 Q2057200 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER @OZ33895 Q2057300 BE PSETNIPR IF SO, SET UP WORK AREA @OZ33895 Q2057400 EJECT R4 Q2058000 *********************************************************************** Q2059000 * * Q2060000 * SET FUNC=I AND OPTCD=J FLAGS * Q2061000 * * Q2062000 *********************************************************************** Q2063000 SPACE 1 R4 Q2064000 PPDBSETF NI PPFLAG,255-PPFUNCI SET 3525 @OZ33895 Q2065000 TM PDBFUNC,X'80' PUNCH-INTERPRET R4 Q2066000 BZ SKIP210 FLAG IF R4 Q2067000 OI PPFLAG,PPFUNCI REQUESTED R4 Q2068000 SKIP210 NI PPFLAG2,255-PPOPTJ SET 3800 R4 Q2069000 TM PDBFLAG2,PDB2OPTJ DCB=OPTCD=J R4 Q2070000 BZ PDDBFCHK FLAG IF R4 Q2071000 OI PPFLAG2,PPOPTJ REQUESTED R4 Q2072000 SPACE 1 R4 Q2073000 DROP PC2 SUSPEND PDDB ADDRESSABILITY R4 Q2074000 SPACE 3 R4 Q2075000 *********************************************************************** Q2076000 * * Q2077000 * SETUP DEVICE BY PDDB SPECIFICATIONS * Q2078000 * * Q2079000 *********************************************************************** Q2080000 SPACE 1 R4 Q2081000 PDDBFCHK DS 0H R4 Q2082000 LA R1,PMESSAGE ADDRESS NEW SETUP SPECIFICATION Q2083000 L R15,=A(PRPUDSV) CALL DEVICE R4 Q2084000 BALR PL,R15 SETUP VERIFICATION R4 Q2085000 TM PPFLAG,PRDELSW COMMAND DURING DSV... @G38ESBB Q2085100 BO PPDONE YES, GO TERMINATE @G38ESBB Q2085200 L PL,PCEDCT GET DCT ADDRESS @G38ESBB Q2085300 TM DCTPPSW2-DCTDSECT(PL),DCTCKJAM 3800 PJAM/CKEY @G38ESBB Q2085400 BZ PTESTFDS BR IF NOT @G38ESBB Q2085500 L R15,=A(PLOCATE) CALL LOCATE ROUTINE @G38ESBB Q2085600 BALR PL,R15 TO GET ORIGIN PQE @G38ESBB Q2085700 B PPDSEND PROCESS PAPERJAM/CANCEL KEY @G38ESBB Q2085800 SPACE 1 R4 Q2086000 *********************************************************************** Q2087100 * * Q2088000 * OFFSET-STACK 3800 BURSTER DATA SETS * Q2089000 * * Q2090000 *********************************************************************** Q2091000 SPACE 1 R4 Q2092000 PTESTFDS TM PPFLAG2,PPFDS TEST FOR FIRST DATA SET @G38ESBB Q2093000 BO PWARMTST BR IF YES R4 Q2094000 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R4 Q2095000 BNE PWARMTST BR IF NOT R4 Q2096000 CLC PPDSKEY,=AL2(IOTPDBOD/PDBLENG) SYSTEM PDDB... R41 Q2096200 BNH PWARMTST SKIP OFFSET-STACK IF YES R41 Q2096400 LM PC1,PC2,PCCWOFST SELECT OFFSET-STACK CCW R4 Q2100000 BAL PL,PPPUT2 ADD TO CHAIN @OZ51441 Q2101000 SPACE 1 R4 Q2102000 PWARMTST DS 0H R4 Q2103000 TM PCKJOE,$JOECKV IS THIS A DATASET WARM START Q2104000 BO PFASTRT BRANCH IF YES Q2105000 EJECT R4 Q2106000 *********************************************************************** Q2107000 * * Q2108000 * RESTART POINT FOR DATA SET COPIES * Q2109000 * * Q2110000 *********************************************************************** Q2111000 SPACE 1 R4 Q2112000 PNXTCPY DS 0H Q2113000 IC PL,PPJNDS GET DATA SET COUNTER Q2114000 LA PL,1(,PL) INCREMENT BY ONE Q2115000 STC PL,PPJNDS STORE NEW COUNTER VALUE Q2116000 SPACE 1 R4 Q2117000 *********************************************************************** Q2118000 * * Q2119000 * IF FIRST DATA SET -- INITIALIZE CHECKPOINT-JOE * Q2120000 * * Q2121000 *********************************************************************** Q2122000 SPACE 1 R4 Q2123000 PCKINIT DS 0H Q2124000 MVC PCEEJRCB,PCCW+2 1ST RCB DISPLACEMENT Q2125000 XC PDDBPGCT,PDDBPGCT CLEAR DATASET PAGE COUNT Q2126000 TM PPFLAG2,PPFDS TEST FOR 1ST DATA SET R4 Q2127000 BZ PFASTRT BR IF NOT R4 Q2128000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q2128200 BE PFASTRT1 YES, BYPASS CKPT JOE INIT @G38ESBB Q2128400 SPACE 1 R4 Q2129000 $QSUSE REQUEST ACCESS TO CHECKPOINT DATA Q2130000 SPACE 1 R4 Q2131000 *********************************************************************** Q2132000 * * Q2133000 * INITIALIZE AND CHECKPOINT THE CKPT-JOE * Q2134000 * * Q2135000 *********************************************************************** Q2136000 SPACE 1 R4 Q2137000 USING JOEDSECT,PL PROVIDE JOE ADDRESSABILITY R4 Q2138000 SPACE 1 R4 Q2139000 L PL,PCKJOE ADDRESS CKPT-JOE R4 Q2140000 MVC JOECKPP,PCKPT AND INITIALIZE IT @OZ27300 Q2141000 SPACE 1 R4 Q2142000 $#CKPT JOE=0(,PL),TYPE=A CKPT THE CKPT-JOE R4 Q2143000 EJECT R4 Q2144000 *********************************************************************** Q2145000 * * Q2146000 * SHOW CKPT-JOE IS VALID -- CHECKPOINT THE WORK-JOE * Q2147000 * * Q2148000 *********************************************************************** Q2149000 SPACE 1 R4 Q2150000 L PL,PWKJOE ADDRESS WORK-JOE Q2151000 OI JOEFLAG,$JOECKV SET CKPT-JOE VALID FLAG Q2152000 $#CKPT JOE=0(,PL),TYPE=A CKPT THE WORK-JOE R4 Q2153000 SPACE 1 R4 Q2154000 DROP PL SUSPEND JOE ADDRESSABILITY Q2155000 SPACE 1 @G38ESBB Q2155050 ***************************************************************@G38ESBB Q2155100 * @G38ESBB Q2155150 * FOR 3800 PRINTER, ASSIGN DATA SET PQE (PQED) @G38ESBB Q2155200 * @G38ESBB Q2155250 ***************************************************************@G38ESBB Q2155300 SPACE 1 @G38ESBB Q2155350 PFASTRT CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q2155400 BNE PFASTRT3 NO, BRANCH @G38ESBB Q2155450 SPACE 1 @G38ESBB Q2155500 PFASTRT1 TM PPFLAG3,PP3800R+PP3800S REPOSITIONING... @OZ51592 Q2155550 BNZ PFASTRT2 YES, BYPASS PQE ALLOC @OZ51592 Q2155600 L R15,=A(PQEDINIT) CALL PQEDINIT TO ACQUIRE @G38ESBB Q2155650 BALR PL,R15 AND INIT DATA SET PQE @G38ESBB Q2155700 BZ PPDONE BRANCH IF NOT SUCCESSFUL @OZ48003 Q2155750 PFASTRT2 NI PCKJOE,FF-$JOECKV RESET WARMSTART BIT @G38ESBB Q2155800 NI PPFLAG3,FF-PP3800S RESET REPOSITION FLAG @OZ51592 Q2155825 B PBSFSGO GO REJOIN COMMON CODE @G38ESBB Q2155850 SPACE 1 @G38ESBB Q2155900 SPACE 1 R4 Q2156000 *********************************************************************** Q2157000 * * Q2158000 * RESET WARM START INDICATION IN WORK AREA * Q2159000 * * Q2160000 * MOVE A COPY OF THE CKPT-JOE TO THE PP BUFFER * Q2161000 * * Q2162000 *********************************************************************** Q2163000 SPACE 1 R4 Q2164000 PFASTRT3 DS 0H @G38ESBB Q2165000 NI PCKJOE,255-$JOECKV RESET WARM START BIT R4 Q2166000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q2167000 BO PRMTPDIR BR IF REMOTE R41 Q2168000 LM PC1,PC2,POUTCCWA INITIALIZE R4 Q2169000 AH PC1,PCCWLAST PPBUF R4 Q2170000 AH PC2,PCCWLAST COPIES R4 Q2171000 MVC PCIESIZE(L'PCKPT,PC1),PCKPT OF R4 Q2172000 MVC PCIESIZE(L'PCKPT,PC2),PCKPT CKPT-JOE R4 Q2173000 B PBSPINIT BR TO CONTINUE R41 Q2173100 EJECT R41 Q2173200 *********************************************************************** Q2173300 * * Q2173400 * CALL PPDIR SUBROUTINE IF REMOTE SETUP HEADER IS NEEDED * Q2173500 * * Q2173600 *********************************************************************** Q2173700 SPACE 1 R41 Q2173800 USING DCTDSECT,PW PROVIDE DCT ADDRESSABILITY R41 Q2173900 SPACE 1 R41 Q2174000 PRMTPDIR L PW,PCEDCT ADDRESS OF REMOTE DCT @OZ32566 Q2174100 TM MDCTFEAT,DCTPSHDR NEED SETUP HEADER... R41 Q2174200 BZ PBSPINIT BR IF NO R41 Q2174300 L R15,=A(PPDIR) ELSE CALL PDIR R41 Q2174400 BALR PL,R15 SUBROUTINE R41 Q2174500 SPACE 1 R41 Q2174600 DROP PW SUSPEND DCT ADDRESSABILITY R41 Q2174700 SPACE 2 R4 Q2174800 *********************************************************************** Q2175000 * * Q2176000 * INITIALIZE BACKSPACE TABLE * Q2177000 * * Q2178000 *********************************************************************** Q2179000 SPACE 1 R4 Q2180000 PBSPINIT DS 0H R4 Q2181000 LH R15,$BSPSIZ IF NO BSP R4 Q2182000 LTR R15,R15 TABLE ENTRIES, R4 Q2183000 BZ PBSFSGO BR TO PRIME THE BUFFERS R4 Q2184000 L PW,PDDBPGCT SET FIRST Q2185000 LA PW,1(,PW) BACKSPACE Q2186000 ST PW,PBSPGCT FRAME PAGE Q2187000 SH R15,=H'7' RESET R4 Q2188000 LA R15,PBSPTBL(R15) LAST R4 Q2189000 XC 0(7,R15),0(R15) ENTRY R4 Q2190000 TITLE 'HASP PRINT/PUNCH SERVICE -- MAIN PROCESSOR' R4 Q2191000 *********************************************************************** Q2192000 * * Q2193000 * MAIN PRINT/PUNCH LOOP INITIALIZATION * Q2194000 * * Q2195000 * RESTART POINT FOR $F/$B PROCESSING * Q2196000 * * Q2197000 *********************************************************************** Q2198000 SPACE 1 R4 Q2199000 PBSFSGO DS 0H $F/$B RESTART POINT Q2200000 LA R1,PCKPT INITIALIZE CHECKPOINT R4 Q2201000 ST R1,PPCKPTR DATA POINTER R4 Q2202000 STCK $DOUBLE SET START TIME FOR @G38ESBB Q2203000 MVC PCECLOCK,$DOUBLE CHECKPOINT INTERVAL @G38ESBB Q2203500 OI PPFLAG2,PPCKPTA AND ALLOW CHECKPOINTS R4 Q2204000 MVI PUNLINE,X'FD' SET FOR HIGHEST PRINT LINE CCW Q2205000 MVI PRTRCCW,255 RESET TRC SET MEMORY @OZ40326 Q2206000 TM PPFLAG3,PP3800R ARE WE REPOSITIONING... @G38ESBB Q2206200 BO PDSPLTST YES,BYPASS LINE COUNT RESET @G38ESBB Q2206400 SPACE 1 R41 Q2207000 PNEWSGO XC PPLC,PPLC CLEAR PAGE LINE COUNTER R41 Q2207200 EJECT , @OZ27703 Q2207220 ************************************************************** @OZ27703 Q2207240 * INITIALIZE PBUFSKIP TO PROPER VALUE IF THIS IS TRACKCELLED * @OZ27703 Q2207260 * PROCESSOR. THIS IS DONE BY CALCULATING ALL RECORDS IN A * @OZ27703 Q2207280 * TRACK CELL IN TURN AND CHECKING FOR A MATCH ON THE INPUT * @OZ27703 Q2207300 * MTTR VALUE. WHEN THIS MATCH OCCURS, THE PBUFSKIP VALUE * @OZ27703 Q2207320 * WILL BE SET TO THE CORRECT VALUE. * @OZ27703 Q2207340 * * @OZ27703 Q2207360 * REGISTER USAGE - - - - - - - - * @OZ27703 Q2207380 * R15 - - WORK AND COUNTER FOR RECORDS IN THE CELL * @OZ27703 Q2207400 * R14 - - SUB PERMUTATION NUMBER * @OZ27703 Q2207420 * PL - - WORKING R VALUE * @OZ27703 Q2207440 * R0 - - RECORDS PER TRACK THIS SPOOL DEVICE * @OZ27703 Q2207460 * R1 - - RECORD INCREMENT VALUE * @OZ27703 Q2207480 ************************************************************** @OZ27703 Q2207500 SPACE 2 @OZ27703 Q2207520 PDSPLTST TM PPFLAG2,PPTCEL TEST DE-SPOOLING METHOD @G38ESBB Q2207540 BZ PGO100 DON'T CALCULATE PBUFSKIP @OZ27703 Q2207560 SPACE 1 @OZ27703 Q2207580 * LOOP INITIALIZATION @OZ27703 Q2207600 XR R15,R15 CLEAR WORK REG TO ZERO @OZ27703 Q2207620 LR R1,R15 CLEAR RECINCR REG TO ZERO @OZ27703 Q2207640 LA PL,1 SET INITIAL R TO 1 @OZ27703 Q2207660 LR R14,PL SET INITIAL SPN TO 1 @OZ27703 Q2207680 IC R15,PCEJMTTR FROM M VALUE @OZ27703 Q2207700 MH R15,=AL2(TEDSIZ) POINT TO @OZ27703 Q2207720 AL R15,$TEDADDR PROPER TED @OZ27703 Q2207740 LH R0,TNRT-TEDDSECT(,R15) GET RECORDS PER TRACK @OZ27703 Q2207760 LR R15,R1 CLEAR COUNT TO ZERO @OZ27703 Q2207780 IC R1,$RECINCR GET RECORD INCREMENT VALUE @OZ27703 Q2207800 SPACE 1 @OZ27703 Q2207820 PGO001 CLM PL,1,PCEJMTTR+3 DOES R MATCH @OZ27703 Q2207840 BE PGO099 BR IF YES, EXIT @OZ27703 Q2207860 SPACE 1 @OZ27703 Q2207880 LA R15,1(,R15) BUMP COUNT BY 1 @OZ27703 Q2207900 CLM R15,1,$TCELSIZ IS FULL CELL ACCOUNTED FOR @OZ27703 Q2207920 BL PGO002 BR IF NO, KEEP ON COUNTING @OZ27703 Q2207940 XR R15,R15 RESET COUNT TO ZERO @OZ27703 Q2207960 PGO002 AR PL,R1 BUMP R BY RECINCR @OZ27703 Q2207980 CR PL,R0 CHECK IF R FITS ON TRACK @OZ27703 Q2208000 BNH PGO001 BR IF YES, LOOP BACK @OZ27703 Q2208020 SPACE 1 @OZ27703 Q2208040 LA R14,1(,R14) BUMP SPN @OZ27703 Q2208060 LR PL,R14 AND USE AS NEW R @OZ27703 Q2208080 B PGO001 GO CHECK R @OZ27703 Q2208100 SPACE 1 @OZ27703 Q2208120 PGO099 STC R15,PBUFSKIP SET SKIP VALUE @OZ27703 Q2208140 PGO100 DS 0H RESUME @OZ27703 Q2208160 EJECT , @OZ27703 Q2208180 *********************************************************************** Q2209000 * * Q2210000 * DE-SPOOL INITIAL BUFFER OR TRACK-CELL * Q2211000 * * Q2212000 *********************************************************************** Q2213000 SPACE 1 R4 Q2214000 L R15,PCEJMTTR 1ST TRACK OF DATA SET R4 Q2215000 IC R1,PBUFOPT INITIALIZE AVAILABLE INPUT R4 Q2216000 STC R1,PBFAVAIL BUFFER COUNT TO BUFFERING OPTION R4 Q2217000 BAL PL,PRDTCEL READ FIRST DATA BLOCK(S) R4 Q2218000 SPACE 1 R4 Q2219000 TM PPFLAG,PPDELSW TEST FOR DELETION R4 Q2220000 BO PPDSEND BR IF YES R4 Q2221000 BAL PL,PRDTCHK ELSE, WAIT FOR I/O TO COMPLETE R4 Q2222000 B P1STBLK AND GO PROCESS 1ST DATA BUFFER R4 Q2223000 SPACE 1 R4 Q2224000 *********************************************************************** Q2225000 * * Q2226000 * WAIT FOR SPOOL INPUT TO COMPLETE * Q2227000 * * Q2228000 *********************************************************************** Q2229000 SPACE 1 R4 Q2230000 PCHKNBLK DS 0H R4 Q2231000 TM PPFLAG,PPDELSW TEST FOR SUSPENSION/TERMINATION R4 Q2232000 BO PPDSEND BR IF YES R4 Q2233000 BAL PL,PRDTCHK ELSE, CHECK INPUT I/O R4 Q2234000 EJECT R4 Q2235000 *********************************************************************** Q2236000 * * Q2237000 * PROCESS NEW DATA SET BUFFER * Q2238000 * * Q2239000 *********************************************************************** Q2240000 SPACE 1 R4 Q2241000 * THIS LINE DELETED BY APAR @OZ19494 Q2242000 * THIS LINE DELETED BY APAR @OZ19494 Q2243000 SPACE 1 R4 Q2244000 P1STBLK DS 0H R4 Q2245000 TM PPFLAG2,PPTCEL TEST DE-SPOOLING METHOD R4 Q2246000 BZ SKIP220 BRANCH IF SINGLE R4 Q2247000 OC PPFLAG,BUFECBCC COPY STATUS OF NEW BUFFER R4 Q2248000 B PVALCHK AND GO CHECK IT R4 Q2249000 SKIP220 CLC HDBKEY,PPKEY IS THIS DATA BUFFER VALID R4 Q2250000 BE PVALCHK BR IF YES R4 Q2251000 OI PPFLAG,PPRDERR SET DATA BUFFER VALIDITY ERROR R4 Q2252000 SPACE 1 R4 Q2253000 *********************************************************************** Q2254000 * * Q2255000 * EXIT IF BUFFER READ/VALIDITY ERROR OR SUSPENSION * Q2256000 * * Q2257000 *********************************************************************** Q2258000 SPACE 1 R4 Q2259000 PVALCHK DS 0H R4 Q2260000 TM PPFLAG,PPRDERR+PPDELSW SUSPEND OR READ ERROR Q2261000 BNZ PPDSEND BRANCH IF YES Q2262000 LM PC1,PC2,PCCW SETUP CCW IN PC1 AND PC2 Q2263000 ICM PC1,3,PCEEJRCB GET RCB DISPLACEMENT Q2264000 ALR PC1,PBUF ADJUST FOR THIS BUFFER Q2265000 LH R1,PCEEJRCB GET CURRENT RCB DISPL Q2266000 SPACE 1 R4 Q2267000 *********************************************************************** Q2268000 * * Q2269000 * PROCESS NEW LOGICAL RECORD -- TEST FOR END-OF-BLOCK * Q2270000 * * Q2271000 * IF DATA BUFFER IS AVAILABLE -- BEGIN TO DE-SPOOL INTO IT * Q2272000 * * Q2273000 *********************************************************************** Q2274000 SPACE 1 R4 Q2275000 PNXTCCW DS 0H Q2276000 STH R1,PCEEJRCB SAVE EJECT RCB DISPL Q2277000 CLI PBFAVAIL,0 TEST FOR AVAILABLE INPUT BUFFER R4 Q2278000 BE PALLACTV SKIP IF ALL ARE ACTIVE R4 Q2279000 $COUNT R=PW ********************************* R4 Q2280000 BAL PL,PRDTCNXT BEGIN INPUT OF NEXT DATA BLOCK(S) R4 Q2281000 PALLACTV DS 0H R4 Q2282000 TM 0(PC1),X'FF' TEST RECORD CONTROL BYTE Q2283000 BO PCPEND BRANCH IF END OF BLOCK Q2284000 EJECT R4 Q2285000 ICM PC2,2,=X'00' ENSURE LENGTH RESET R4 Q2286000 IC PC2,0(,PC1) SET TEXT LENGTH R4 Q2287000 LR PW,PC1 COPY LRC ADDRESS R4 Q2288000 SPACE 1 R4 Q2289000 USING LRCDSECT,PW PROVIDE LRC ADDRESSABILITY R4 Q2290000 SPACE 1 R4 Q2291000 TM LRCFLAG1,LRC1SPAN TEST FOR SPANNED RECORD R4 Q2292000 BZ PNOSPAN BR IF NO R4 Q2293000 SPACE 1 R4 Q2294000 *********************************************************************** Q2295000 * * Q2296000 * SPANNED RECORD -- PRINT/PUNCH ONLY FIRST SEGMENT * Q2297000 * * Q2298000 *********************************************************************** Q2299000 SPACE 1 R4 Q2300000 ICM PC2,3,LRCSEGL GET SEGMENT LENGTH R4 Q2301000 LA PC1,LRCSTEXT ASSUME NOT 1ST SEGMENT R4 Q2302000 TM LRCFLAG1,LRC1SBGN TEST ASSUMPTION R4 Q2303000 BZ PNXTRCB BR IF VALID TO SKIP SEGMENT R4 Q2304000 LA PC1,LRCSFTXT POINT TO START OF 1ST-SEG TEXT R4 Q2305000 STM PC1,PC2,PCCWORK SAVE CCW FOR ANALYSIS R4 Q2306000 B PFSPCK AND BR TO ANALYZE R4 Q2307000 SPACE 1 R4 Q2308000 DROP PW KILL LRC ADDRESSABILITY R4 Q2309000 SPACE 1 R4 Q2310000 *********************************************************************** Q2311000 * * Q2312000 * PICK UP USER CARRIAGE CONTROL (IF ANY) -- TEST FOR ASA * Q2313000 * * Q2314000 *********************************************************************** Q2315000 SPACE 1 R4 Q2316000 PNOSPAN DS 0H * R4 Q2317000 LA PC1,3(,PC1) TEXT ADDRESS (NO CC) Q2318000 TM 1(PW),LRC1CCTL IS USER CC SPECIFIED Q2319000 BNO *+8 <*** BRANCH IF NO Q2320000 LA PC1,1(,PC1) * STEP OVER CC Q2321000 STM PC1,PC2,PCCWORK * STORE CCW FOR ANALYSIS Q2322000 BNO *+10 <*** BRANCH IF NO CC Q2323000 MVC PCCWORK(1),3(PW) MOVE IN USER CC Q2324000 TM 1(PW),LRC1ONUL IS NOT SYSOUT BIT SET Q2325000 BO PNXTRCB BRANCH IF YES Q2326000 TM 1(PW),LRC1CCTL+LRC1TASA IS CC ASA Q2327000 BNO PFSPCK BRANCH IF NO - START ANALYSIS Q2328000 EJECT R4 Q2329000 *********************************************************************** Q2330000 * * Q2331000 * CONVERT ASA CARRIAGE CONTROL TO PROPER IMMEDIATE CCW * Q2332000 * * Q2333000 *********************************************************************** Q2334000 SPACE 1 R4 Q2335000 PASA001 LA PW,PASANUM NUMBER OF ASA TABLE ENTRIES @OZ32776 Q2336000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525 PUNCH... @OZ28353 Q2336100 BE PASA005 BR. YES...USE 3525 TABLE @OZ28353 Q2336200 L PC2,=A(PASAMCH) ASA TO MCH CONVERSION TABLE @OZ32776 Q2337000 SPACE 1 @OZ32776 Q2338000 PASA002 DS 0H * Q2339000 CLC PCCWORK(1),0(PC2) DOES USER CC MATCH ASA ENTRY Q2340000 BE PASA004 BRANCH IF YES R4 Q2341000 LA PC2,2(,PC2) STEP TO NEXT TABLE ENTRY Q2342000 BCT PW,PASA002 CYCLE THROUGH TABLE Q2343000 L PC2,PCCWORK+4 RESTORE 2ND HALF OF CCW R4 Q2344000 OC PCCWORK+6(2),PCCWORK+6 CC NOT FOUND -- CHECK DATA LEN R4 Q2345000 BZ PNXTRCB IGNORE REC IF BAD CC & NO DATA R4 Q2346000 TM PCEID,PCEPRSID CHECK PROCESSOR TYPE R4 Q2347000 BO PASA003 BRANCH IF PRINT R4 Q2348000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525 PUNCH... @OZ33253 Q2348100 BE PASA006 BRANCH IF YES @OZ33253 Q2348200 MVI PCCWORK,X'41' DEFAULT PUNCH CC = STACKER 1 R4 Q2349000 B PNIMDCMD BRANCH TO COUNT RECORDS R4 Q2350000 PASA005 DS 0H * @OZ28353 Q2350100 L PC2,=A(PASAMCH2) 3525 ASA TO MCH TABLE @OZ32776 Q2350200 * THIS LINE DELETED BY APAR @OZ32776 Q2350300 B PASA002 CONTINUE CONVERSION @OZ28353 Q2350400 PASA006 DS 0H @OZ33253 Q2350500 MVI PCCWORK,X'01' DEFAULT 3525 CC = STACK 1 @OZ33253 Q2350600 B PNIMDCMD BRANCH TO COUNT RECORDS @OZ33253 Q2350700 PASA003 DS 0H * R4 Q2351000 L PC2,=A(PASAMCH) DEFAULT TO SINGLE SPACE @OZ32776 Q2352000 PASA004 DS 0H * R4 Q2353000 MVC PCCWORK(1),1(PC2) SELECT MCH CC VALUE Q2354000 L PC2,PCCWORK+4 RESTORE SECOND PART OF CCW Q2355000 TM PCEID,PCEPUSID CHECK PROCESSOR TYPE R4 Q2356000 BO PNIMDCMD NO ASA IMMEDIATE CMDS FOR PUNCH R4 Q2357000 PFSPCK DS 0H * Q2358000 TM PCCWORK,X'02' TEST COMMAND TYPE Q2359000 BZ PNIMDCMD BRANCH IF NOT IMMEDIATE Q2360000 L PC2,PCCW+4 SET COUNT TO ZERO Q2361000 B PNOCOUNT CONTINUE ANALYSIS Q2362000 EJECT R4 Q2363000 *********************************************************************** Q2364000 * * Q2365000 * UPDATE TOTAL LINE OR CARD COUNT FOR THIS JOE * Q2366000 * * Q2367000 *********************************************************************** Q2368000 SPACE 1 R4 Q2369000 PNIMDCMD DS 0H CMND IS NOT IMMEDIATE Q2370000 CLC PDDBSKIP,PDDBPGCT SKIP COUNT VS PAGE COUNT Q2371000 BH PNOCOUNT DON'T COUNT IF HIGH Q2372000 SLR PW,PW ZERO WORK REGISTER @OZ35930 Q2373000 IC PW,PREVCPYN UPDATE RECORD COUNT @OZ35930 Q2374000 AL PW,PPLNCDCT BY NUMBER OF COPIES @OZ35930 Q2374500 ST PW,PPLNCDCT THIS TRANSMISSION @OZ35930 Q2375000 SPACE 1 R4 Q2376000 *********************************************************************** Q2377000 * * Q2378000 * IF PUNCH -- UPDATE DATA SET CARD COUNT * Q2379000 * * Q2380000 *********************************************************************** Q2381000 SPACE 1 R4 Q2382000 PNOCOUNT DS 0H * Q2383000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE Q2384000 BO PRINT BRANCH IF PRINT Q2385000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525... @OZ28353 Q2385100 BNE PUSTKR1 BR. NO...DONT TEST @OZ28353 Q2385200 CLI PCCWORK,X'01' IS CC STACKER ONE... @OZ28353 Q2385300 BE PUSTKR2 BR. YES...CONTINUE TESTS @OZ28353 Q2385400 PUSTKR1 DS 0H * @OZ28353 Q2385500 CLI PCCWORK,X'41' IS CC PUNCH STACKER 2 Q2386000 BE *+12 BRANCH IF YES Q2387000 CLI PCCWORK,X'81' IS CC PUNCH STACKER 3 Q2388000 BNE PUNPRT BRANCH IF NO Q2389000 PUSTKR2 DS 0H * @OZ28353 Q2389100 MVI PUNLINE,X'05' RESET PUNCH-PRINT LINE NO. Q2390000 TM PPFLAG,PPDELSW CHECK FOR SUSPENSION @OZ29138 Q2390100 BO PPDSEND BRANCH IF YES @OZ29138 Q2390200 L PW,PDDBPGCT UPDATE Q2391000 LA PW,1(,PW) PUNCH Q2392000 ST PW,PDDBPGCT CARD COUNT Q2393000 L PW,PPLC UPDATE R4 Q2394000 LA PW,1(,PW) LOGICAL R4 Q2395000 ST PW,PPLC PAGE COUNT R4 Q2396000 B PUPDTBSP GO UPDATE BSP TABLE R4 Q2397000 SPACE 1 R4 Q2398000 *********************************************************************** Q2399000 * * Q2400000 * CC IS NOT A PUNCH COMMAND - CHECK FOR 3525 PRINT * Q2401000 * * Q2402000 *********************************************************************** Q2403000 SPACE 1 R4 Q2404000 PUNPRT DS 0H Q2405000 TM PCCWORK,X'05' IS CC A 3525 PRINT-LINE Q2406000 BNO PUBADCC BRANCH IF NO Q2407000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525 Q2408000 BNE PNXTRCB BRANCH IF NO @OZ40272 Q2409000 TM PPFLAG,PPFUNCI WAS INTERPRET REQUESTED Q2410000 BO PRNOPRNT BRANCH IF YES - SKIP PRINT CCW Q2411000 TM PDEVTYPE+1,X'30' IS EITHER PRINT FEATURE IN Q2412000 BZ PUBADCC BRANCH IF NO Q2413000 EJECT R4 Q2414000 *********************************************************************** Q2415000 * * Q2416000 * CHECK FOR VALID 3525 PRINT-LINE COMMAND * Q2417000 * * Q2418000 *********************************************************************** Q2419000 SPACE 1 R4 Q2420000 CLC PCCWORK(1),PUNLINE IS LINE NUMBER IN SEQUENCE Q2421000 BNH PUBADCC BRANCH IF NO Q2422000 SLR PW,PW CLEAR REG PW Q2423000 IC PW,PCCWORK GET PRINT COMMAND Q2424000 SRL PW,3 CONVERT TO PRINT LINE NUMBER Q2425000 CLM PW,1,=X'03' DOES LINE REQUIRE ML PRINT Q2426000 BNH *+12 BRANCH IF NO Q2427000 TM PDEVTYPE+1,X'10' IS ML PRINT FEATURE INSTALLED Q2428000 BZ PUBADCC BRANCH IF NO Q2429000 MVC PUNLINE,PCCWORK SET NEW LINE NUMBER Q2430000 B PUPDTBSP GO UPDATE BSP TABLE R4 Q2431000 SPACE 1 R4 Q2432000 *********************************************************************** Q2433000 * * Q2434000 * FOR NO USER CC, BAD USER CC, BAD PRINT LINE - USE CC=41 * Q2435000 * * Q2436000 *********************************************************************** Q2437000 SPACE 1 R4 Q2438000 PUBADCC DS 0H * Q2439000 CLI PDEVTYPE+3,X'0C' IS DEV A 3525 PUNCH @OZ45115 Q2439200 BE PUBADCC2 BR IF YES,DEFAULT STACK 1 @OZ45115 Q2439400 MVI PCCWORK,X'41' SET CC PUNCH STACKER 2 Q2440000 B PNOCOUNT UPDATE CARD COUNTERS Q2441000 PUBADCC2 MVI PCCWORK,X'01' DEFAULT 3525 CC=STACK 1 @OZ45115 Q2441200 B PNOCOUNT UPDATE CARD COUNTERS @OZ45115 Q2441400 EJECT R4 Q2442000 *********************************************************************** Q2443000 * * Q2444000 * CHECK VALIDITY OF PRINTER CCW COMMAND * Q2445000 * * Q2446000 *********************************************************************** Q2447000 SPACE 1 R4 Q2448000 PRINT DS 0H Q2449000 TM PDCTFLAG,DCTSPACE TEST FOR FORCE SINGLE SPACE Q2450000 BZ PRNSPACE BRANCH IF NOT SINGLE SPACING Q2451000 TM PSMFDCI,SMFOPCC TEST CARRIAGE OVERRIDE @OZ55801 Q2451100 BO PRLOOP BR. YES...NOT FIRST TIME @OZ55801 Q2451200 TM PPFLAG3,PP3800R TEST FOR 3800 RESTART @G38ESBB Q2451220 BO PRLOOP BRANCH IF YES @G38ESBB Q2451240 LM PC1,PC2,PRCCWSP1 LOAD IMMEDIATE SPACE CCW @OZ55801 Q2451300 BAL PL,PPPUT ADD CCW TO CHAIN @OZ55801 Q2451400 LM PC1,PC2,PCCWORK RELOAD CURRENT COMMAND CCW @OZ55801 Q2451450 PRINT OFF THESE LINES DELETED BY APAR NUMBER @OZ55801 Q2451600 * THIS LINE DELETED BY APAR NUMBER @OZ55801 Q2451700 PRINT ON THESE LINES DELETED BY APAR NUMBER @OZ55801 Q2451800 PRLOOP DS 0H @OZ55801 Q2451900 OI PSMFDCI,SMFOPCC SET OPERATOR CARRIAGE OVERRIDE Q2452000 TM PCCWORK,X'02' TEST FOR IMMEDIATE COMMAND Q2453000 BO PRNOPRNT BRANCH IF YES Q2454000 IC PL,PDCTFLAG GET SPACE CONTROL BITS Q2455000 SLL PL,3 POSITION FOR WRITE/SPACE Q2456000 STC PL,PCCWORK STORE INTO CCW Q2457000 OI PCCWORK,X'01' SET WRITE BIT Q2458000 NI PCCWORK,X'19' TURN OFF ALL EXTRAS Q2459000 B PRGOODCC CONTINUE PROCESSING Q2460000 SPACE 1 R4 Q2461000 PRNSPACE TM PCCWORK,X'01' TEST LOW ORDER BIT OF COMMAND Q2462000 BZ PRBADCC BIT MUST BE ONE OR COMMAND IS BAD Q2463000 TM PCCWORK,X'84' TEST BITS 0 AND 5 Q2464000 BM PRSKIP BRANCH IF EJECT OR INVALID Q2465000 TM PCCWORK,X'64' NO, TEST BITS 1, 2, AND 5 Q2466000 BZ PRGOODCC BITS MUST BE ZERO OR COMMAND IS BAD Q2467000 CLI PCCWORK,X'73' TEST FOR BLOCK DATA CHECK COMMAND Q2468000 BE PRNOPRNT IGNORE IF BLOCK DATA CHECK Q2469000 SPACE 1 R4 Q2470000 PRBADCC NI PCCWORK,X'02' BAD COMMAND Q2471000 OI PCCWORK,X'09' CONVERT TO SINGLE SPACE Q2472000 LH PW,PCEEJRCB GET LRC OFFSET IN BUFFER Q2473000 ALR PW,PBUF ADD BUFFER ORIGIN Q2474000 NI 1(PW),255-LRC1TASA RESET ASA BIT Q2475000 SPACE 1 R4 Q2476000 PRGOODCC SLR PL,PL CLEAR REGISTER Q2477000 IC PL,PCCWORK PICK UP COMMAND Q2478000 SRL PL,3 SHIFT OUT LOW-ORDER BITS Q2479000 AL PL,PPLC INCREMENT LINE R4 Q2480000 ST PL,PPLC COUNT BY SPACE VALUE R4 Q2481000 CL PL,PRLINECT COMPARE LINE COUNT WITH MAXIMUM R4 Q2482000 BNH PPCKLNS BRANCH IF NOT HIGH @OZ19494 Q2483000 NI PCCWORK,X'02' CONVERT COMMAND Q2484000 OI PCCWORK,X'89' TO EJECT Q2485000 SPACE 1 R4 Q2486000 PRSKIP DS 0H Q2487000 CLI PCCWORK,X'89' TEST COMMAND VALIDITY Q2488000 BL PRBADCC BRANCH IF INVALID (LOW) Q2489000 BH PRN8940 BRANCH IF NOT EJECT Q2490000 LH PW,PCEEJRCB GET RCB OFFSET Q2491000 ALR PW,PBUF ADD BUFFER ORIGIN Q2492000 CLC 0(2,PW),=X'01A0' CHECK FOR PRINT Q2493000 BNE PRN8940 BRANCH IF NO Q2494000 CLC 3(2,PW),=X'8940' AND SKIP TO CHNL 1 Q2495000 BNE PRN8940 BRANCH IF NO Q2496000 OI PCCWORK,X'02' CONVERT TO 8B Q2497000 EJECT R4 Q2498000 *********************************************************************** Q2499000 * * Q2500000 * UPDATE DATA SET PAGE COUNT * Q2501000 * * Q2502000 *********************************************************************** Q2503000 SPACE 1 R4 Q2504000 PRN8940 DS 0H Q2505000 CLI PCCWORK,X'E3' TEST COMMAND VALIDITY Q2506000 BH PRBADCC BRANCH IF INVALID (HIGH) Q2507000 XC PPLC,PPLC CLEAR PAGE LINE COUNTER R4 Q2508000 TM PPFLAG,PPDELSW CHECK FOR SUSPENSION @OZ29138 Q2508100 BO PPDSEND BRANCH IF YES @OZ29138 Q2508200 CLI PCCWORK,X'8B' TEST FOR IMM SKIP TO CHAN 1 @OZ19494 Q2508300 BNE PRNPGCT BRANCH IF NOT @OZ19494 Q2508400 L R1,PCEDCT GET DCT ADDRESS @OZ19494 Q2508500 TM DCTPPFL-DCTDSECT(R1),DCTEJECT IF ALREADY AT @OZ19494 Q2508600 BO PRNOPRNT TOP OF PAGE, DO NOT UPDATE @OZ19494 Q2508700 PRNPGCT L PW,PDDBPGCT UPDATE @OZ19494 Q2509000 LA PW,1(,PW) DATASET Q2510000 ST PW,PDDBPGCT PAGE COUNT Q2511000 SPACE 1 R4 Q2512000 *********************************************************************** Q2513000 * * Q2514000 * PUSH DOWN BACKSPACE TABLE -- ADD NEW ENTRY * Q2515000 * * Q2516000 *********************************************************************** Q2517000 SPACE 1 R4 Q2518000 PUPDTBSP DS 0H R4 Q2519000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q2519200 BE PSKPBSP YES, BYPASS BSP TABLE CODE @G38ESBB Q2519400 LH R15,$BSPSIZ IF NO BSP R4 Q2520000 LTR R15,R15 TABLE ENTRIES, R4 Q2521000 BZ PSKPBSP BR TO CHECK SKIP COUNT R4 Q2522000 CLC PDDBPGCT,PBSPGCT IS THIS A FRAME PAGE Q2523000 BNE PSKPBSP BRANCH IF NO Q2524000 SLR PW,PW STEP TO R4 Q2525000 IC PW,$BSPGCT NEXT R4 Q2526000 AL PW,PBSPGCT PAGE FRAME R4 Q2527000 ST PW,PBSPGCT SAVE FOR LATER Q2528000 LA PW,PBSPTBL POINT TO BACKSPACE TABLE R4 Q2529000 SH R15,=H'8' TABLE LENGTH - 1, LESS 1 ENTRY R4 Q2530000 BM SKIP230 BR IF 1-ENTRY TABLE R4 Q2531000 EX R15,PPBSPUSH ELSE PUSH DOWN TABLE ENTRIES R4 Q2532000 SKIP230 ALR PW,R15 POINT TO LAST ENTRY - 1 R4 Q2533000 MVC 1(4,PW),PCEJMTTR SAVE BUFFER MTTR R4 Q2534000 MVC 5(2,PW),PCEEJRCB SAVE LINE RCB R4 Q2535000 MVC 7(1,PW),PCEJBOFF SAVE BUFFER OFFSET R4 Q2536000 B PSKPBSP THEN BR TO CHECK SKIP COUNT R4 Q2537000 SPACE 1 R4 Q2538000 PPBSPUSH MVC 0(*-*,PW),7(PW) *** EXECUTE ONLY *** R4 Q2539000 EJECT @OZ19494 Q2540000 PSKPBSP CLC PDDBSKIP,PDDBPGCT COMPARE SKIP COUNT WITH PG COUNT R4 Q2541000 BNL PSETEJ BRANCH IF REPOSITIONING @OZ19494 Q2542000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE Q2543000 BO PPCHKPT BRANCH IF PRINT Q2544000 L R1,PCEDCT GET ADDR OF RMT PRT/PCH DCT @OZ32566 Q2545000 NI DCTPPFL-DCTDSECT(R1),255-DCTEJECT CLR PCH LOGCL EJECT R4 Q2546000 L PW,PPLC TEST FOR END OF R4 Q2547000 CL PW,PRLINECT PUNCH LOGICAL PAGE R4 Q2548000 BNH PRZCL BRANCH IF NO Q2549000 XC PPLC,PPLC CLEAR PUNCH LOGICAL PAGE COUNT R4 Q2550000 OI DCTPPFL-DCTDSECT(R1),DCTEJECT SET PUNCH LOGICAL EJECT R4 Q2551000 B PPCHKPT GO UPDATE SMF PAGE COUNT @OZ19494 Q2551100 SPACE 1 @OZ19494 Q2551200 PSETEJ CLI PCCWORK,X'8B' TEST FOR IMM SKIP TO CHAN 1 @OZ19494 Q2551300 BE *+12 BRANCH IF YES @OZ19494 Q2551400 CLI PCCWORK,X'89' TEST FOR SKIP TO CHAN 1 @OZ19494 Q2551500 BNE PRNOPRNT BRANCH IF NOT @OZ19494 Q2551600 L R1,PCEDCT GET DCT ADDRESS @OZ19494 Q2551700 OI DCTPPFL-DCTDSECT(R1),DCTEJECT AT TOP OF PAGE @OZ19494 Q2551800 B PRNOPRNT CONTINUE @OZ19494 Q2551900 EJECT R4 Q2552000 *********************************************************************** Q2553000 * * Q2554000 * NEW PAGE -- UPDATE TOTAL PAGE COUNT FOR THIS JOE * Q2555000 * * Q2556000 *********************************************************************** Q2557000 SPACE 1 R4 Q2558000 * THIS LINE DELETED BY APAR @OZ19494 Q2559000 * THIS LINE DELETED BY APAR @OZ19494 Q2559100 * THIS LINE DELETED BY APAR @OZ19494 Q2559200 * THIS LINE DELETED BY APAR @OZ19494 Q2559300 PPCHKPT DS 0H @OZ19494 Q2559600 SLR PW,PW @OZ19494 Q2560000 IC PW,PREVCPYN UPDATE PAGE COUNT @OZ35930 Q2561000 AL PW,PRPAGECT WITH NUMBER OF COPIES @OZ35930 Q2561500 ST PW,PRPAGECT THIS TRANSMISSION @OZ35930 Q2562000 * THIS LINE DELETED BY APAR @OZ29138 Q2562500 * THIS LINE DELETED BY APAR @OZ29138 Q2562600 B PPCKPGS EXAMINE CKPTPGS @OZ19494 Q2562700 SPACE 1 R4 Q2563000 ************************************************************** @OZ19494 Q2564000 * * @OZ19494 Q2564100 * EXAMINE CKPTLNS -- TEST FOR END OF LOGICAL PAGE * @OZ19494 Q2564200 * * @OZ19494 Q2564300 * NOTE: ROUTINE USED ONLY FOR PRINTERS. * @OZ19494 Q2564400 * CKPTLNS=PRLINECT FOR PUNCHES * @OZ19494 Q2564500 * * @OZ19494 Q2564600 ************************************************************** @OZ19494 Q2564700 SPACE 1 @OZ19494 Q2564800 PPCKLNS DS 0H @OZ19494 Q2564900 LTR JCT,JCT IS THIS A SPOOLED MESSAGE @OZ19494 Q2565000 BZ PRNOVFL YES, NO TRUNCS OR CKPTS @OZ19494 Q2565100 LH PW,PCKPTL IF CKPTLNS=0, THEN LOG PAGE @OZ19494 Q2565200 LTR PW,PW SIZE IS DETERMINED BY CHAN @OZ19494 Q2565300 BZ PRNOVFL SKIPS AND LINE COUNT @OZ19494 Q2565400 SLR PL,PL CLEAR WORK REGISTER @OZ19494 Q2565500 IC PL,PCCWORK PICK UP COMMAND @OZ19494 Q2565600 SRL PL,3 GET SPACE BITS, DECREMENT @OZ19494 Q2565700 SR PW,PL CKPTLNS BY NO. OF SPACES @OZ19494 Q2565800 STH PW,PCKPTL STORE NEW VALUE @OZ19494 Q2565900 BP PRNOVFL BR IF NOT AT LOG PAGE BNDRY @OZ19494 Q2565950 CLC PDDBSKIP,PDDBPGCT COMPARE SKIP WITH PG COUNT @OZ19494 Q2565975 BH PPCKPGS2 BRANCH IF REPOSITIONING @OZ19494 Q2566000 EJECT @OZ19494 Q2566020 ************************************************************** @OZ19494 Q2566040 * * @OZ19494 Q2566060 * EXAMINE CKPTPGS * @OZ19494 Q2566080 * * @OZ19494 Q2566100 * FOR REMOTES -- TRUNCATE BUFFERS AND SCHEDULE CKPT * @OZ19494 Q2566200 * AT EACH CKPTPGS BOUNDARY * @OZ19494 Q2566300 * * @OZ19494 Q2566400 * FOR LOCALS -- TRUNCATE CCW BUFFER, UPDATE COPY OF * @OZ19494 Q2566500 * CKPT-JOE, AND SCHEDULE CHECKPOINT AT * @OZ19494 Q2566600 * EACH CKPTPGS BOUNDARY. * @OZ19494 Q2566700 * FOR 3800, CREATE PQEC FOR CHECKPOINT * @G38ESBB Q2566720 * INFORMATION * @G38ESBB Q2566740 * * @OZ19494 Q2566800 * NOTE: FOR LOCAL DEVICES, IF CKPTS ARE NOT FORCED * @OZ19494 Q2566900 * THEN THE CCW BUFFER WILL NOT BE TRUNCATED. * @OZ19494 Q2567000 * * @OZ19494 Q2567100 ************************************************************** @OZ19494 Q2567200 SPACE 1 @OZ19494 Q2568000 PPCKPGS DS 0H @OZ19494 Q2569000 LH PW,PCKPTP GET CKPTPGS COUNTER @OZ19494 Q2570000 BCTR PW,0 DECREMENT COUNTER @OZ19494 Q2571000 STH PW,PCKPTP STORE NEW VALUE @OZ19494 Q2571500 LTR PW,PW TEST COUNTER AND BRANCH @OZ19494 Q2572000 BNZ PPCKPGS2 IF NOT AT CKPTPGS BOUNDARY @OZ19494 Q2573000 MVC PCKPTP,PCKPTPSV RESET CKPTPGS COUNTER @OZ19494 Q2574000 TM PCEID,PCELCLID TEST PROCESSOR TYPE @OZ19494 Q2575000 BO PLCLCKPT DO NOT TRUNCATE IF LOCAL @OZ19494 Q2576000 OI PPFLAG3,PPTRUNC SET TRUNC REQUIRED FLAG @OZ19494 Q2577000 TM PCEID,PCERJEID TEST PROCESSOR TYPE @OZ19494 Q2578000 BO PPCKPGS2 BRANCH IF REMOTE @OZ19494 Q2579000 * THIS LINE DELETED BY APAR NUMBER @OZ19494 Q2580000 * THIS LINE DELETED BY APAR NUMBER @OZ19494 Q2581000 SPACE 1 R4 Q2582000 PLCLCKPT DS 0H R4 Q2583000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q2583100 BNE PLCKPT1 NO, BRANCH @G38ESBB Q2583200 TM PPFLAG,PPNEWS NEWS DATA SET @G38ESBB Q2583300 BO PPCKPGS2 YES, BYPASS PQEC ALLOCATION @G38ESBB Q2583400 OI PPFLAG3,PP38CKPT SET FLAG FOR PQEC ALLOC @OZ51592 Q2583405 B PPCKPGS2 AND CONTINUE @OZ51592 Q2583410 SPACE 1 @OZ51592 Q2583415 USING PQHDSECT,PW SET PQH ADDRESSABILITY @OZ48003 Q2583425 PCKP3800 NI PPFLAG3,FF-PP38CKPT RESET CHECKPOINT FLAG @OZ51592 Q2583430 L PW,PQHADR ADDRESS PQH @OZ48003 Q2583450 OI PQHAFLAG,PQHALOC SET ALLOCATION FLAG @OZ48003 Q2583475 L R15,=A(PQECINIT) CALL PQECINIT TO @G38ESBB Q2583500 BALR PL,R15 ALLOCATE PQEC @G38ESBB Q2583600 BZ PPDONE BRANCH IF NOT SUCCESSFUL @OZ48003 Q2583630 DROP PW SUSPEND PQH ADDRESSABILITY @OZ48003 Q2583660 SPACE 1 @OZ48003 Q2583690 L R15,=A(PPGIDIO) CALL PPGIDIO TO SOLICIT @G38ESBB Q2583700 BALR PL,R15 ID FOR PQEC @G38ESBB Q2583800 B PRNOPRNT GO REJOIN COMMON CODE @OZ51592 Q2583900 EJECT @OZ48003 Q2584000 PLCKPT1 L R1,POUTCCWA GET POINTER @G38ESBB Q2584500 AH R1,PCCWLAST TO CKPT-JOE MINUS PCIESIZE R4 Q2585000 OI PCISGNAL-PCIDSECT(R1),PCICKPT SHOW NEW CKPT PRESENT R4 Q2586000 MVC PCIESIZE(L'PCKPT,R1),PCKPT UPDATE COPY OF CKPT-JOE R4 Q2587000 SPACE 1 @OZ19494 Q2587100 PPCKPGS2 MVC PCKPTL,PCKPTLSV RESET CKPTLNS COUNTER @OZ19494 Q2587200 EJECT R4 Q2588000 *********************************************************************** Q2589000 * * Q2590000 * IF &PRTRANS=YES -- TRANSLATE ALL UNPRINTABLES TO BLANKS * Q2591000 * * Q2592000 *********************************************************************** Q2593000 SPACE 1 R4 Q2594000 PRNOVFL CLC PDDBSKIP,PDDBPGCT COMPARE SKIP COUNT WITH PAGE COUNT Q2595000 BNH PRNTRANS DON'T PRINT IF HIGH @OZ19494 Q2596000 L R1,PCEDCT GET DCT ADDRESS @OZ19494 Q2596100 NI DCTPPFL-DCTDSECT(R1),255-DCTEJECT RESET CH 1 SW @OZ19494 Q2596200 B PRNOPRNT CONTINUE @OZ19494 Q2596300 SPACE 1 @OZ19494 Q2596400 PRNTRANS TM $PRTOPTS,$PRTRANS TEST FOR PRINT TRANSLATE @OZ19494 Q2597000 BZ PRZCL BR IF NO R4 Q2598000 TM PCEID,PCEPUSID TEST PROCESSOR TYPE Q2599000 BO PRZCL BRANCH IF PUNCH Q2600000 CLC PDEVTYPE+2(2),=AL1(UCB3UREC,UCB3211) LOCAL 3211... R4 Q2601000 BE PRZCL BRANCH IF YES Q2602000 CLC PDEVTYPE+2(2),=AL1(UCB3UREC,UCB3800) 3800 PRINTER... R4 Q2603000 BE PRZCL BRANCH IF YES R4 Q2604000 CLC PDEVBYT2(2),=AL1(UCB3UREC,UCB3203) LOCAL 3203 @OZ40627 Q2604100 BE PRZCL BRANCH IF A 3203 @OZ40627 Q2604150 CLM PC2,2,=X'00' LENGTH EXCEED MAXIMUM... @OZ35113 Q2604200 BNE *+12 BR IF YES @OZ35113 Q2604400 CLM PC2,1,=X'00' IS THE COUNT ZERO Q2605000 BE PRZCL BRANCH IF YES - SKIP TRANSLATE Q2606000 LA R1,0(PC1,PC2) R1 = ADDRESS OF NEXT RCB Q2607000 SLR R1,PBUF GENERATE OFFSET OF RCB Q2608000 CH R1,$BUFLENG TEST FOR END OF BUFFER R4 Q2609000 BNL PRZCL BRANCH IF OUT OF BUFFER Q2610000 LA R1,X'FF'(PC2) R1 = COMMAND BYTE COUNT - 1 Q2611000 L R15,=A(PTRTBL) TRANSLATE UNPRINTABLES @OZ32776 Q2611500 CLM PC2,2,=X'00' LENGTH EXCEED MAXIMUM... @OZ35113 Q2611600 BE *+8 BR IF NO @OZ35113 Q2611700 ICM R1,3,=X'00FE' SET LENGTH TO MAXIMUM @OZ35113 Q2611800 EX R1,PRXTR TO BLANKS @OZ32776 Q2612000 EJECT R4 Q2613000 *********************************************************************** Q2614000 * * Q2615000 * IF OPTCD=J -- SELECT APPROPRIATE 3800 TRANSLATE TABLE * Q2616000 * * Q2617000 *********************************************************************** Q2618000 SPACE 1 R4 Q2619000 PRZCL L PC1,PCCWORK PICK UP MODIFIED COMMAND R4 Q2620000 TM PPFLAG2,PPOPTJ TEST FOR OPTCD=J SPECIFIED R4 Q2621000 BZ PRCHAIN BRANCH IF NO R4 Q2622000 CL PC2,PCCW+4 BYPASS IF FIRST PASS FOR R41 Q2625000 BE PRCHAIN ASA CC (OR INVALID) R41 Q2626000 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R41 Q2626400 BNE PRZCL2 BR IF OPTCD=J NOT SUPPORTED R41 Q2626800 NI 0(PC1),X'0F' USE BINARY PART OF TRC R4 Q2627000 SLR R1,R1 PICK-UP R41 Q2628000 CLC PRMAXTRC,0(PC1) TABLE REF CHAR R41 Q2629000 BL PRCHKTRC OR USE ZERO R41 Q2630000 IC R1,0(PC1) IF INVALID R41 Q2631000 SPACE 1 R41 Q2631500 PRCHKTRC LA R1,PXTABCCW(R1) ADDR OF SELECT CCW OP CODE R41 Q2632000 CLC PRTRCCW,0(R1) TABLE ALREADY SELECTED... R41 Q2633000 BE PRZCL2 SKIP UNNECESSARY CCW IF YES R41 Q2634000 STM PC1,PC2,PBLKWORK SAVE 'DATA' CCW R41 Q2635000 LM PC1,PC2,PRCCWEJ CONSTRUCT SELECT- R41 Q2636000 ICM PC1,8,0(R1) TRANSLATE-TABLE CCW R41 Q2637000 BAL PL,PPPUT2 ADD CCW TO CHAIN @OZ51441 Q2638000 STCM PC1,8,PRTRCCW SAVE NEW SELECT CCW OP CODE R41 Q2639000 LM PC1,PC2,PBLKWORK RESTORE 'DATA' CCW R41 Q2640000 SPACE 1 R41 Q2640500 PRZCL2 AL PC1,=F'1' ACCOUNT FOR TABLE ID R4 Q2641000 SL PC2,=F'1' ACCOUNT FOR TABLE ID R4 Q2642000 SPACE 1 R41 Q2642100 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642200 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642300 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642400 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642500 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642600 * THIS LINE DELETED BY APAR NUMBER @OZ25297 Q2642700 EJECT @OZ19494 Q2643000 *********************************************************************** Q2644000 * * Q2645000 * ADD NEW PRINT/PUNCH COMMAND TO CCW CHAIN * Q2646000 * * Q2647000 *********************************************************************** Q2648000 SPACE 1 R4 Q2649000 PRCHAIN DS 0H R4 Q2650000 BAL PL,PPPUT ADD CCW TO CHAIN Q2651000 TM PPFLAG3,PP38CKPT 3800 PQEC NEEDED... @OZ51592 Q2651025 BO PCKP3800 BRANCH IF YES @OZ51592 Q2651050 TM PPFLAG3,PPTRUNC BUFFER TRUNC REQUIRED @OZ19494 Q2651100 BZ PPPFUNCI BRANCH IF NO @OZ19494 Q2651200 TM PCEID,PCELCLID TEST PROCESSOR TYPE @OZ19494 Q2651300 BO PRCHAINL BRANCH IF LOCAL @OZ19494 Q2651400 OI PPFLAG2,PPCKPT SET CKPT NEEDED FLAG @OZ19494 Q2651500 LA R1,PCKPT POINT TO CHECKPOINT DATA @OZ19494 Q2651600 ST R1,PPCKPTR SAVE FOR PPPCKPT @OZ19494 Q2651700 ICM PC1,8,=X'FF' BUFFER TRUNC COMMAND @OZ19494 Q2651800 BAL PL,PPPUT2 FORCE RTAM TO FLUSH BUFFERS @OZ19494 Q2651900 * AND WAIT FOR RESPONSE @OZ19494 Q2652000 NI PPFLAG3,255-PPTRUNC RESET TRUNC REQUIRED FLAG @OZ19494 Q2652100 B PRNOPRNT CONTINUE @OZ19494 Q2652200 SPACE 1 @OZ19494 Q2652300 PRCHAINL BAL PL,PPWRITE SCHEDULE CCW BUFR FOR I/O @OZ19494 Q2652400 NI PPFLAG3,255-PPTRUNC RESET TRUNC REQUIRED FLAG @OZ19494 Q2652500 EJECT @OZ19494 Q2652600 *********************************************************************** Q2653000 * * Q2654000 * IF FUNC=I -- PRODUCE APPROPRIATE 3525 PRINT-LINE CCW'S * Q2655000 * * Q2656000 * LINE 1 -- CARD COLS. 1-64 -- STARTING IN PRINT POSITION 1 * Q2657000 * LINE 3 -- CARD COLS. 65-80 -- STARTING IN PRINT POSITION 49 * Q2658000 * * Q2659000 *********************************************************************** Q2660000 SPACE 1 R4 Q2661000 PPPFUNCI DS 0H @OZ19494 Q2661100 TM PPFLAG,PPFUNCI INTERPRET REQUESTED Q2662000 BNO PRNOPRNT BRANCH IF NO Q2663000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525 Q2664000 BNE PRNOPRNT BRANCH IF NO Q2665000 TM PDEVTYPE+1,X'30' IS EITHER PRINT FEATURE IN Q2666000 BZ PRNOPRNT BRANCH IF NO Q2667000 SPACE 1 R4 Q2668000 OI PSMFDCI,SMFPUPRT SET 3525 INTERPRET SMF FLAG R4 Q2669000 SPACE 1 R4 Q2670000 STM PC1,PC2,PCCWORK SAVE ORIGINAL PUNCH CCW Q2671000 ICM PC1,8,=X'0D' CONVERT CCW TO PRINT LINE 1 Q2672000 BAL PL,PPPUT ADD CCW TO CHAIN Q2673000 CLC PCCWORK+6(2),=H'64' IS TEXT OVER 64 CHARACTERS... R4 Q2674000 BNH PRNOPRNT BR IF NOT R4 Q2675000 L PL,PCCWPT PICK UP CURRENT CCW POINTER Q2676000 LA PL,2*8(,PL) VALUE AFTER 2 CCW'S ADDED R4 Q2677000 SL PL,POUTCCWA CONVERT TO CCW CHAIN OFFSET R4 Q2678000 CH PL,PCCWLAST IS THERE ROOM IN CHAIN R4 Q2679000 BL *+8 BRANCH IF YES Q2680000 BAL PL,PPWRITE FORCE CCW CHAIN TO BE CLEARED Q2681000 LM PC1,PC2,PUSPACCW LOAD DATA CHAIN PRINT LINE 3 Q2682000 BAL PL,PPPUT ADD CCW TO CHAIN Q2683000 LM PC1,PC2,PCCWORK RESTORE ORIGINAL PUNCH CCW Q2684000 LA PC1,0(,PC1) CLEAR CCW COMMAND Q2685000 SH PC2,=H'64' COMPUTE RESIDUAL COUNT OVER 64 Q2686000 AH PC1,=H'64' COMPUTE NEW STARTING ADDRESS Q2687000 ICM PC1,8,=X'1D' CONVERT CCW TO PRINT LINE 3 Q2688000 BAL PL,PPPUT ADD CCW TO CHAIN Q2689000 LM PC1,PC2,PCCWORK RESTORE ORIGINAL PUNCH CCW Q2690000 EJECT R4 Q2691000 *********************************************************************** Q2692000 * * Q2693000 * RE-CYCLE RECORD IF CARRIAGE CONTROL WAS ASA * Q2694000 * * Q2695000 *********************************************************************** Q2696000 SPACE 1 R4 Q2697000 PRNOPRNT TM PPFLAG3,PP3800R TEST FOR 3800 RESTART @G38ESBB Q2698000 BZ PRECYCLE BR IF NOT @G38ESBB Q2698200 L R15,=A(PMAPFCB) ADDRESS MAP FCB ROUTINE @G38ESBB Q2698400 BALR PL,R15 CALL 3800 FCB MAPPING RTN @G38ESBB Q2698600 BNZ PPDONE BR TO TERMINATE @G38ESBB Q2698800 SPACE 1 @G38ESBB Q2699000 PRECYCLE TM PCEID,PCEPUSID IS THIS A PUNCH PROCESSOR @G38ESBB Q2699500 BO PNXTRCB BRANCH IF YES Q2700000 LH PW,PCEEJRCB GET LRC DISPLACEMENT Q2701000 ALR PW,PBUF ADD BUFFER ORIGIN Q2702000 MVI PCCWORK,X'01' SET CC TO WRITE NO-SPACE Q2703000 LM PC1,PC2,PCCWORK RESTORE CCW REGISTERS Q2704000 TM 1(PW),LRC1CCTL+LRC1TASA ASA CARRIAGE CONTROL Q2705000 BNO PNXTRCB BRANCH IF NO Q2706000 NI 1(PW),255-LRC1TASA RESET ASA BIT Q2707000 B PFSPCK START CCW ANALYSIS Q2708000 SPACE 1 R4 Q2709000 *********************************************************************** Q2710000 * * Q2711000 * STEP TO NEXT LOGICAL RECORD CONTROL BLOCK * Q2712000 * * Q2713000 *********************************************************************** Q2714000 SPACE 1 R4 Q2715000 PNXTRCB LA PC1,0(PC1,PC2) TEXT ADDRESS + TEXT LENGTH R4 Q2716000 LR R1,PC1 COPY NEXT RCB ADDRESS Q2717000 SLR R1,PBUF GENERATE OFFSET OF RCB Q2718000 CH R1,$BUFLENG TEST FOR END OF BUFFER R4 Q2719000 BL PNXTCCW BRANCH IF RCB IS IN BUFFER Q2720000 EJECT @OZ46351 Q2721000 *********************************************************************** Q2722000 * * Q2723000 * END OF DATA BUFFER * Q2724000 * * Q2725000 *********************************************************************** Q2726000 SPACE 1 R4 Q2727000 PCPEND ICM R15,15,HDBNXTRK LOAD AND TEST CHAIN TRACK R4 Q2728000 BNZ PSAVCHN BRANCH IF NOT END OF DS @G38ESBB Q2729000 TM PPFLAG3,PP3800R TEST FOR 3800 REPOSITIONING @G38ESBB Q2729100 BZ PPDSEND BR IF NOT TO TERMINATE @G38ESBB Q2729150 L PW,PQHADR GET PQH ADDRESS @G38ESBB Q2729200 L R0,PQHMAPV-PQHDSECT(,PW) GET FCB MAPPING VALUE @OZ53047 Q2729250 LTR R0,R0 TEST MAPPING VALUE @OZ51936 Q2729275 BNM PCALLRCP BR IF NOT $F,D @G38ESBB Q2729300 AH R0,=H'2' ADD 1 FOR MSG PAGE, AND @G38ESBBCQ2729350 ADD 1 FOR -1 MAPPING ORIGIN @G38ESBB Q2729400 SPACE 1 @G38ESBB Q2729450 PCALLRCP L R15,=A(PRECOMP) CALL RECOMPUTE ROUTINE @G38ESBB Q2729500 BALR PL,R15 TO ADJUST FOR COMMAND @G38ESBB Q2729600 MVC PQHMAPV-PQHDSECT(,PW),$ZEROS ZERO MAPPING CNT @OZ51936 Q2729610 ICM R1,15,PQHFCB-PQHDSECT(PW) GET FCB BUFFER ADDR @OZ51936 Q2729620 BZ PNOFCBUF BRANCH IF NONE @OZ51936 Q2729630 $FREEBUF (R1) FREE FCB BUFFER @OZ51936 Q2729640 MVC PQHFCB-PQHDSECT(,PW),$ZEROS CLEAR BUFFER ADDR @OZ51936 Q2729650 PNOFCBUF NI PPFLAG3,FF-PP3800R RESET 3800 REPRO INDICATOR @OZ51936 Q2729700 L R1,PQHLAST-PQHDSECT(,PW) GET LAST PQE @OZ46351 Q2729710 CR R1,PW TEST FOR EMPTY PPQ @OZ46351 Q2729720 BE PRSTSKP BRANCH IF YES @OZ46351 Q2729730 USING PQEDSECT,R1 SET PQE ADDRESSABILITY @OZ46351 Q2729740 TM PQECFLAG,PQECLPG TEST FOR LAST PAGE PQEC @OZ46351 Q2729750 BZ PPDSEND BRANCH IF NOT @OZ46351 Q2729760 L R1,PQECPQED POINT TO PQED @OZ46351 Q2729770 TM PQEDFLAG,PQEDLAST TEST FOR LAST DATASET @OZ46351 Q2729780 BZ PPDSEND BRANCH IF NOT @OZ46351 Q2729785 DROP R1 SUSPEND PQE ADDRESSABILITY @OZ46351 Q2729790 PRSTSKP XC PDDBSKIP,PDDBSKIP ZERO SKIP COUNT @OZ46351 Q2729795 B PPDONE BRANCH TO TERMINATE @OZ46351 Q2729800 SPACE 1 @G38ESBB Q2729900 PSAVCHN ST R15,PCEJMTTR SAVE CHAIN TRACK FOR CKPT @G38ESBB Q2730000 MVC PCEEJRCB,PCCW+2 SET 1ST RCB DISPLACEMENT @OZ19494 Q2730100 TM PPFLAG2,PPTCEL TEST DE-SPOOLING METHOD R4 Q2731000 BZ PENDTCEL BRANCH IF SINGLE R4 Q2732000 SLR PL,PL INCREMENT R4 Q2733000 IC PL,PCEJBOFF BUFFER OFFSET R4 Q2734000 LA PL,1(,PL) WITHIN THIS R4 Q2735000 STC PL,PCEJBOFF TRACK-CELL R4 Q2736000 L R1,PBUFADDR ADDR OF FIRST BUFFER IN CHAIN R4 Q2737000 CH PL,BUFCHNCT-BUFDSECT(,R1) TEST FOR END OF TRACK-CELL R4 Q2738000 BNL PENDTCEL BRANCH IF YES R4 Q2739000 L PBUF,BUFCHAIN ESTABLISH ADDRESSABILITY ON R4 Q2740000 B P1STBLK NEXT BUFFER AND GO PROCESS @OZ19494 Q2741000 EJECT R4 Q2742000 *********************************************************************** Q2743000 * * Q2744000 * PROCESSING COMPLETE FOR CURRENT BUFFER OR TRACK-CELL * Q2745000 * * Q2746000 * SETUP TO DE-SPOOL NEXT DATA BUFFER(S) * Q2747000 * * Q2748000 *********************************************************************** Q2749000 SPACE 1 R4 Q2750000 PENDTCEL DS 0H R4 Q2751000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q2752000 BO SKIP250 BR IF REMOTE R4 Q2753000 CLC PDDBSKIP,PDDBPGCT COMPARE SKIP AND PAGE COUNTERS R4 Q2754000 BNH PNOTSKIP BR IF SKIP COUNT NOT HIGH R4 Q2755000 SKIP250 IC R1,PBFAVAIL INCREMENT NUMBER R4 Q2756000 LA R1,1(,R1) OF AVAILABLE R4 Q2757000 STC R1,PBFAVAIL INPUT BUFFERS R4 Q2758000 B PCHREAD GO FOR NEXT INPUT BUFFER R4 Q2759000 SPACE 1 R4 Q2760000 *********************************************************************** Q2761000 * * Q2762000 * INDICATE IN PCIE THAT THE FINAL BUFFER HAS BEEN PROCESSED * Q2763000 * * Q2764000 * NOTE - WHEN THE OUTPUT FOR THIS BUFFER IS COMPLETE, PPCHECK WILL * Q2765000 * INCREMENT THE AVAILABLE BUFFER COUNT (PBFAVAIL) * Q2766000 * * Q2767000 *********************************************************************** Q2768000 SPACE 1 R4 Q2769000 PNOTSKIP DS 0H R4 Q2770000 L R1,POUTCCWA IF CCW AREA IS EMPTY, R4 Q2771000 CL R1,PCCWPT INSERT A NOP R4 Q2772000 BNH PSETFINL TO ASSURE R4 Q2773000 LM PC1,PC2,PCCWNOP INDICATION IS R4 Q2774000 ICM PC2,B'1000',=X'60' SEEN BY R4 Q2775000 BAL PL,PPPUT PPCHECK R4 Q2776000 L R1,POUTCCWA RELOAD CCW AREA ADDRESS R4 Q2777000 SPACE 1 R4 Q2778000 USING PCIDSECT,R1 INDICATE THAT EXECUTION R4 Q2779000 PSETFINL AH R1,PCCWLAST OF THIS CCW AREA R4 Q2780000 OI PCISGNAL,PCIFNLBF WILL CAUSE A DATA R4 Q2781000 DROP R1 BUFFER TO BECOME AVAILABLE R4 Q2782000 SPACE 1 R4 Q2783000 BAL PL,PPWRITE FORCE CCW AREA SWAP R4 Q2784000 SPACE 1 R4 Q2785000 *********************************************************************** Q2786000 * * Q2787000 * IF READ HAS ALREADY BEEN STAGED -- GO WAIT FOR COMPLETION * Q2788000 * * Q2789000 *********************************************************************** Q2790000 SPACE 1 R4 Q2791000 PCHREAD TM PPFLAG2,PPRSW TEST FOR READ IN PROGRESS R4 Q2792000 BO PCHKNBLK BRANCH IF YES R4 Q2793000 EJECT R4 Q2794000 *********************************************************************** Q2795000 * * Q2796000 * IF ANY BUFFERS ARE AVAILABLE -- STAGE NEXT READ * Q2797000 * ELSE -- WAIT FOR PPCHECK TO MAKE A BUFFER AVAILABLE * Q2798000 * * Q2799000 *********************************************************************** Q2800000 SPACE 1 R4 Q2801000 PCHAVAIL CLI PBFAVAIL,0 TEST FOR AVAILABLE INPUT BUFFER R4 Q2802000 BH PSTGREAD STAGE NEXT READ IF YES R4 Q2803000 TM PPFLAG,PPWSW TEST FOR WRITE IN PROGRESS R4 Q2804000 BZ PLOSTINT BRANCH IF NO R4 Q2805000 BAL PL,PCIWAIT WAIT FOR OUTPUT I/O R4 Q2806000 B PCHAVAIL AND TRY AGAIN R4 Q2807000 SPACE 1 R4 Q2808000 PLOSTINT IC R1,PBUFOPT RESET AVAILABLE INPUT BUFFER R4 Q2809000 STC R1,PBFAVAIL COUNT TO BUFFERING OPTION R4 Q2810000 $COUNT * RECORD USAGE * R4 Q2811000 SPACE 1 R4 Q2812000 *********************************************************************** Q2813000 * * Q2814000 * BEGIN THE NEXT DE-SPOOLING OPERATION -- GO WAIT COMPLETION * Q2815000 * * Q2816000 *********************************************************************** Q2817000 SPACE 1 R4 Q2818000 PSTGREAD BAL PL,PRDTCNXT STAGE READ FOR NEXT BUFFER(S) R4 Q2819000 $COUNT ******************************** R4 Q2820000 B PCHKNBLK GO CHECK AND PROCESS IT R4 Q2821000 TITLE 'HASP PRINT/PUNCH SERVICE -- DATA SET TERMINATION' Q2822000 *********************************************************************** Q2823000 * * Q2824000 * *** DATA SET TERMINATION *** * Q2825000 * * Q2825100 * SPECIAL TERMINATION FOR RMT SPOOLED MESSAGES AND JES2-NEWS * Q2825200 * @G38ESBB Q2825300 * DETERMINE IF 3800 COMMAND ISSUED AND CALL COMMAND @G38ESBB Q2825400 * ROUTINE TO PROCESS ACCORDINGLY. @G38ESBB Q2825500 * * Q2826000 *********************************************************************** Q2827000 SPACE 1 @G38ESBB Q2827050 PPDSEND CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q2827100 BNE PPDSEND1 BR IF NOT @G38ESBB Q2827150 CLC PSAVAREA,$ZEROS SAVE AREA = LEVEL 0... @G38ESBB Q2827200 BE PPCHKNEW YES, BRANCH @G38ESBB Q2827250 MVC PSAVAREA,PSAV1ST RESTORE FIRST LEVEL SAVE @G38ESBB Q2827300 L R1,PSAVAREA ADDRESS FIRST SAVE AREA @G38ESBB Q2827350 CLI 0(R1),PSAVEALL SAVE ALL SPECIFIED... @G38ESBB Q2827400 BE PRETLNG YES, BRANCH @G38ESBB Q2827450 MVC 2*4(4,R1),=A(PPCHKNEW) RETURN TO HERE @G38ESBB Q2827500 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q2827550 SPACE 1 @G38ESBB Q2827600 PRETLNG MVC 4+PL*4(4,R1),=A(PPCHKNEW) RETURN TO HERE @G38ESBB Q2827650 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q2827700 SPACE 1 @G38ESBB Q2827750 PPCHKNEW TM PPFLAG,PPNEWS NEWS DATA SET... @G38ESBB Q2827800 BO PPDSEND1 YES, BYPASS PQE PROCESSING @G38ESBB Q2827850 TM PPFLAG3,PP3800R 3800 COMMAND PROCESSING @G38ESBB Q2827900 BZ PPDSEND0 BR IF NOT @G38ESBB Q2827950 L R15,=A(P3800CMD) CALL 3800 COMMAND @G38ESBB Q2828000 BALR PL,R15 PROCESSING @G38ESBB Q2828050 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q2828100 TM PPFLAG,PRDELSW WAS CMD FOR TERMINATION @G38ESBB Q2828150 BZ PTSTFD BR IF NOT @G38ESBB Q2828200 L PW,PQHADR ADDRESS PQH @G38ESBB Q2828250 NI PPFLAG,FF-PRDELSW RESET TERMINATION INDIC @G38ESBB Q2828300 CLC PQHMAPV,$ZEROS MAPPING NEEDED... @G38ESBB Q2828350 BE PPDETERM NO,GO DETERMINE TERM ACTION @G38ESBB Q2828400 B PENDINIT BR TO RESTART POINT @G38ESBB Q2828450 SPACE 1 @G38ESBB Q2828500 PPDETERM TM PQHFLAG,PQH2CMD TEST FOR DOUBLE COMMAND @G38ESBB Q2828550 BO PPABORT ABORT JOB IF YES @G38ESBB Q2828600 B PPDONE OTHERWISE, GO TERMINATE @G38ESBB Q2828650 SPACE 1 @G38ESBB Q2828700 PPDSEND2 NI PCKJOE,FF-$JOECKV RESET WARMSTART BIT @OZ51866 Q2828710 B PPDSEND1 CONTINUE D.S. TERMINATION @OZ51866 Q2828720 EJECT @OZ51866 Q2828730 PTSTFD L PW,PQHADR GET PQH ADDRESS @G38ESBB Q2828750 CLC PQHMAPV,PFDSET NEED TO GET NEW DS @G38ESBB Q2828800 BNE PENDINIT BR IF NOT TO RESTART @G38ESBB Q2828850 XC PQHMAPV,PQHMAPV ELSE, CLEAR MAPPING VALUE @OZ56969 Q2828900 B PENDINIT BRANCH TO RESTART DATASET @OZ56969 Q2828950 EJECT @OZ48003 Q2829000 PPDSEND0 L R15,=A(PQECINIT) CREATE PQEC FOR @G38ESBB Q2829050 BALR PL,R15 END OF DATA SET @G38ESBB Q2829100 BZ PPDONE BRANCH IF NOT SUCCESSFUL @OZ48003 Q2829150 L R15,=A(PPGIDIO) CALL PPGIDIO TO SOLICIT @G38ESBB Q2829200 BALR PL,R15 ID FOR PQE @G38ESBB Q2829300 L PW,PQHADR ADDRESS PQH @G38ESBB Q2829400 L R1,PQHLAST ADDRESS LPG PQEC @G38ESBB Q2829500 OI PQECFLAG-PQEDSECT(R1),PQECLPG SET END OF DS @G38ESBB Q2829600 SPACE 1 @G38ESBB Q2829700 DROP PW DROP PQH ADDRESSABILITY @G38ESBB Q2829800 SPACE 1 @G38ESBB Q2829900 PPDSEND1 BAL PL,PPWRITE FORCE EXEC OF LAST CCW AREA @G38ESBB Q2830000 LTR JCT,JCT IS THIS A SPOOL MESSAGE PRINTER Q2831000 BZ PRSMBEOB BRANCH IF YES Q2832000 TM PPFLAG,PPNEWS WAS THIS JES2-NEWS DATA SET... R41 Q2832200 BO PENDNEWS RETURN TO MAIN LINE IF YES R41 Q2832400 SPACE 1 R4 Q2833000 *********************************************************************** Q2834000 * * Q2835000 * WRITE PROGRAMMER MESSAGE IF DATA SET I/O OR VALIDITY ERROR * Q2836000 * * Q2837000 *********************************************************************** Q2838000 SPACE 1 R4 Q2839000 NI PPFLAG2,255-PPCKPTA SUSPEND CHECKPOINTS R4 Q2840000 TM PPFLAG,PPRDERR DATA BUFFER READ ERROR Q2841000 BNO PPIOTCK BRANCH IF NO Q2842000 $MID 185 R4 Q2843000 LA R1,=C'$HASP185 ' MESSAGE ID R4 Q2844000 LA R14,=C' TERMINATED ' MESSAGE TEXT @OZ48259 Q2845000 L R15,=A(PRMSG) ISSUE MSG TO OPERATOR @OZ19494 Q2846000 BALR PL,R15 AND ADD IT TO OUTPUT @OZ48259 Q2846100 SPACE 1 R4 Q2847000 OI PPFLAG2,PSMFDSER SET DATA SET ERROR FLAG FOR SMF R4 Q2848000 SPACE 1 R4 Q2849000 *********************************************************************** Q2850000 * * Q2851000 * RE-READ IOT * Q2852000 * * Q2853000 * SEE IF IOT IS ALREADY BEING DE-SPOOLED * Q2854000 * * Q2855000 *********************************************************************** Q2856000 SPACE 1 R4 Q2857000 PPIOTCK DS 0H R4 Q2858000 NI PPFLAG,255-PPRDERR CLEAR ERROR CONDITION, IF ANY R4 Q2859000 TM PPFLAG2,PPRSW TEST FOR READ IN PROGRESS R4 Q2860000 BZ PPIOTCK1 BR IF NOT R4 Q2861000 CLC PCESEEK(4),PCEIOTTR TEST FOR IOT READ IN PROGRESS R4 Q2862000 BE PPIOTCK3 BR IF YES R4 Q2863000 BAL PL,PRDTCHK ELSE, CLEAR INPUT I/O R4 Q2864000 EJECT R4 Q2866000 *********************************************************************** Q2867000 * * Q2868000 * SEE IF ANY BUFFERS ARE AVAILABLE FOR DE-SPOOLING THE IOT * Q2869000 * * Q2870000 * NOTE - IF NONE AVAILABLE -- WAIT FOR PPCHECK TO FREE ONE * Q2871000 * * Q2872000 *********************************************************************** Q2873000 SPACE 1 R4 Q2874000 PPIOTCK1 CLI PBFAVAIL,0 TEST FOR AVAILABLE INPUT BUFFER R4 Q2875000 BH PPIOTCK2 BRANCH IF YES R4 Q2876000 TM PPFLAG,PPWSW TEST FOR WRITE OUTSTANDING R4 Q2877000 BZ PPIOTCK2 BRANCH IF NO R4 Q2878000 BAL PL,PCIWAIT WAIT FOR AVAILABLE INPUT BUFFER R4 Q2879000 B PPIOTCK1 AND TRY AGAIN R4 Q2880000 SPACE 1 R4 Q2881000 *********************************************************************** Q2882000 * * Q2883000 * BUFFER AVAILABLE -- READ AND VERIFY THE IOT * Q2884000 * * Q2885000 *********************************************************************** Q2886000 SPACE 1 R4 Q2887000 PPIOTCK2 L R15,PCEIOTTR GET IOT TRACK ADDRESS R4 Q2888000 BAL PL,PRDBUF INITIATE READ OF IOT R4 Q2889000 PPIOTCK3 BAL PL,PRDCHK CHECK READ R4 Q2890000 TM PPFLAG,PRDELSW TEST FOR TERMINATION Q2891000 BO PPDONE BRANCH IF YES Q2892000 LR JCT,PBUF ADDRESS IOT IN BUFFER Q2893000 TM PPFLAG,PPRDERR TEST FOR I/O ERROR ON READ Q2894000 BO PIOTPOST BR IF YES R4 Q2895000 CLC IOTJBKEY,PPJOBKEY IS THIS IOT VALID Q2896000 BE PRSUSTST BRANCH IF YES Q2897000 SPACE 1 R4 Q2898000 *********************************************************************** Q2899000 * * Q2900000 * IF INPUT OR VALIDITY ERROR -- TELL OPERATOR AND KILL OUTPUT * Q2901000 * * Q2902000 *********************************************************************** Q2903000 SPACE 1 R4 Q2904000 PIOTPOST $DISTERR INDICATE CONTROL BLOCK ERROR Q2905000 OI PPFLAG,PPJCTIOT+PRDELSW REASON FOR TERMINATION Q2906000 B PPDONE ABORT JOB Q2907000 EJECT Q2908000 *********************************************************************** Q2909000 * * Q2910000 * IF $F OR $B COMMAND -- INFORM OPERATOR AND PROGRAMMER * Q2911000 * * Q2912000 *********************************************************************** Q2913000 SPACE 1 R4 Q2914000 PRSUSTST BAL PL,PPCHECK FINAL I/O. CHK OPER CMDS @OZ29138 Q2916000 TM PPFLAG,PRDELSW CHECK FOR TERMINATION @OZ49577 Q2916100 BO PPDONE BRANCH IF YES @OZ49577 Q2916200 TM PPFLAG,PPDELSW CHECK FOR SUSPENSION @OZ29138 Q2916500 BZ PRLOGCK BRANCH IF NO Q2917000 NI PPFLAG,255-PPDELSW RESET SUSPEND FLAG Q2918000 MVC PCKPTP,PCKPTPSV RESET CKPTPGS COUNTER @OZ19494 Q2918010 MVC PCKPTL,PCKPTLSV RESET CKPTLNS COUNTER @OZ19494 Q2918020 MVC PCEFORM(4),PDDBPGCT SAVE CURRENT PAGE COUNT @OZ19494 Q2918030 USING DCTDSECT,R1 DCT ADDRESSABILITY @OZ19494 Q2918080 L R1,PCEDCT GET DCT ADDRESS @OZ19494 Q2918090 TM DCTPPSW2,DCTBFCKP REPOSITION FROM LAST CKPT @OZ19494 Q2918100 BZ PPADJUST BRANCH IF NO @OZ19494 Q2918200 NI DCTPPSW2,255-DCTBFCKP RESET $B/$F CKPT FLAG @OZ19494 Q2918210 DROP R1 SUSPEND DCT ADDRESSABILITY @OZ19494 Q2918220 SPACE 1 @OZ19494 Q2918230 USING JOEDSECT,R1 CKPT-JOE ADDRESSABILITY @OZ19494 Q2918240 L R1,PCKJOE GET CKPT-JOE ADDRESS @OZ19494 Q2918250 CLC PDDBDISP,JOEPDDB INSURE THAT @OZ19494 Q2918260 BNE PRSUSTS1 AT LEAST ONE CHECKPOINT @OZ19494 Q2918270 CLC PCEIOTTR,JOEIOTTR HAS BEEN TAKEN FOR @OZ19494 Q2918290 BNE PRSUSTS1 THE CURRENT DATASET @OZ19494 Q2918300 CLC PDDBPGCT,JOEPPCT COMPARE CURRENT PAGE COUNT @OZ19494 Q2918310 BNL PRSUSTS2 WITH CKPT BR NOT LESS @OZ19494 Q2918320 PRSUSTS1 L PL,PMAXPAGE IF NO CKPT FOR THE DATASET @OZ19494 Q2918330 LNR PL,PL OR THE CURRENT PAGE COUNT @OZ19494 Q2918340 ST PL,PFSBSCT IS LESS THAN THE CKPT @OZ19494 Q2918350 B PPADJUST PAGE COUNT THEN $B DSET @OZ19494 Q2918360 SPACE 1 @OZ19494 Q2918400 PRSUSTS2 MVC PCEJMTTR,JOEMTTR REFRESH @OZ19494 Q2918500 MVC PCEEJRCB,JOEJRCB PPWORK FIELDS FROM @OZ19494 Q2918600 MVC PDDBPGCT,JOEPPCT LAST CKECKPOINT @OZ19494 Q2918650 DROP R1 SUSPEND JOE ADDRESSABILITY @OZ19494 Q2918675 EJECT @OZ19494 Q2918700 PPADJUST L R1,PDDBPGCT GET CURRENT PAGE COUNT @OZ19494 Q2918750 L R15,PFSBSCT GET $B/$F PAGES @OZ19494 Q2918800 LTR R15,R15 DETERMINE IF $B OR $F @OZ19494 Q2918850 BP PPFWD BRANCH IF $F @OZ19494 Q2918900 LA R14,=C' BACKSPACED ' SET UP FOR $B MESSAGE @OZ48259 Q2918950 AR R1,R15 BACKUP PAGE COUNT @OZ19494 Q2919000 BNM PSETPAGE BRANCH IF VALID PAGE COUNT @OZ19494 Q2919100 SLR R1,R1 SETUP FOR $B,D @OZ19494 Q2919200 B PSETPAGE CONTINUE @OZ19494 Q2919300 SPACE 1 @OZ19494 Q2919400 PPFWD LA R14,=C' FWD-SPACED ' SET UP FOR $F MESSAGE @OZ48259 Q2919500 AR R1,R15 ADD IN PAGE COUNT @OZ19494 Q2919600 SPACE 1 @OZ19494 Q2920000 PSETPAGE ST R1,PDDBSKIP SAVE NEW SKIP COUNT @OZ19494 Q2921000 SPACE 1 @OZ19494 Q2922000 $MID 170 @OZ19494 Q2923000 LA R1,=C'$HASP170 ' POINT TO MESSAGE ID @OZ19494 Q2924000 L R15,=A(PRMSG) ISSUE MSG TO OPERATOR @OZ19494 Q2925000 BALR PL,R15 @OZ48259 Q2925100 SPACE 1 @OZ19494 Q2926000 *********************************************************************** Q2927000 * * Q2928000 * GO TERMINATE DATA SET IF $F DEVICE,DSET WAS REQUESTED * Q2929000 * * Q2930000 * CAUSED BY OPERATOR COMMAND OR PRINTER 'CANCEL' BUTTON * Q2931000 * * Q2932000 *********************************************************************** Q2933000 SPACE 1 R4 Q2934000 CLC PDDBSKIP,PMAXPAGE TEST SKIP COUNT @OZ19494 Q2935000 BNL PRLOGCK BRANCH IF $F DATASET @OZ19494 Q2936000 SPACE 1 R4 Q2937000 *********************************************************************** Q2938000 * * Q2939000 * SKIP TO NEW PAGE, OR ADD A BLANK CARD -- THEN RE-POSITION * Q2940000 * * Q2941000 *********************************************************************** Q2942000 SPACE 1 R4 Q2943000 LM PC1,PC2,PRCCWEJ SELECT PAGE-EJECT CCW R4 Q2944000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE Q2945000 BO *+8 BRANCH IF PRINT Q2946000 LM PC1,PC2,PUCCWBL SELECT BLANK CARD CCW Q2947000 BAL PL,PPPUT ADD CCW TO CHAIN Q2948000 BAL PL,PPWRITE INITIATE WRITE Q2949000 BAL PL,PPCHECK AND CHECK Q2950000 XC PULMTTR(7),PULMTTR CLEAR PUNCH RESTART POINTER R4 Q2951000 CLC PDDBSKIP,PCEFORM SKIP COUNT VS. PAGE COUNT @OZ19494 Q2952000 BH PBSFSGO $F DEVICE,N Q2953000 LH R15,$BSPSIZ IF NO BSP R4 Q2954000 LTR R15,R15 TABLE ENTRIES, R4 Q2955000 BZ PBSPBEG BR TO RESTART DS R41 Q2956000 EJECT Q2957000 *********************************************************************** Q2958000 * * Q2959000 * $B COMMAND - SEARCH BACKSPACE TABLE FOR RESTART POINT * Q2960000 * * Q2961000 *********************************************************************** Q2962000 SPACE 1 R4 Q2963000 SH R15,=H'8' TABLE LENGTH - 1, LESS 1 ENTRY R4 Q2964000 LA R1,PBSPTBL POINT TO 1ST TABLE ENTRY R4 Q2965000 SPACE 1 R4 Q2966000 PBSPSRCH ALR R1,R15 POINT TO LAST TABLE ENTRY - 1 R4 Q2967000 SLR PL,PL GET R4 Q2968000 IC PL,$BSPGCT PAGE FRAME R4 Q2969000 LNR PL,PL FOR LAST R4 Q2970000 A PL,PBSPGCT ENTRY R4 Q2971000 BNP PBSPBEG BR IF START OF DATA SET R4 Q2972000 OC 5(2,R1),5(R1) TEST FOR VALID ENTRY R4 Q2973000 BZ PBSPBEG BR IF NO -- RESTART DS R4 Q2974000 ST PL,PBSPGCT SAVE FOR LATER Q2975000 * THIS LINE DELETED BY APAR @OZ19494 Q2976000 * THIS LINE DELETED BY APAR @OZ19494 Q2977000 MVC PCEFORM(7),1(R1) SAVE BACKSPACE TABLE ENTRY @OZ19494 Q2978000 LA R1,PBSPTBL POINT TO 1ST TABLE ENTRY R4 Q2979000 LTR R15,R15 IF SINGLE-ENTRY TABLE, R4 Q2980000 BM PBSPINVL DON'T POP UP TABLE ENTRIES R41 Q2981000 EX R15,PPOP1 POP UP BSP TABLE R41 Q2982000 EX R15,PPOP2 TO PREVIOUS ENTRY R41 Q2983000 SPACE 1 R41 Q2983500 PBSPINVL DS 0H @OZ29138 Q2984000 CL PL,PDDBSKIP IS PAGE BEFORE BSP POINT Q2985000 BNH PBSPFND BR IF CORRECT PAGE FRAME @OZ29138 Q2986000 XC 0(7,R1),0(R1) INVALIDATE UNUSED ENTRY @OZ29138 Q2986100 B PBSPSRCH GO CHECK NEXT FRAME @OZ29138 Q2986200 PBSPFND DS 0H @OZ29138 Q2986300 MVC PCEJMTTR,PCEFORM SET BUFFER MTTR @OZ19494 Q2986400 MVC PCEEJRCB,PCEFORM+4 SET LINE RCB @OZ19494 Q2986500 MVC PBUFSKIP,PCEFORM+6 SET BUFFER OFFSET @OZ19494 Q2986600 ST PL,PDDBPGCT SET AS NEW PAGE COUNTER Q2987000 SLR PL,PL GET @OZ29138 Q2987010 IC PL,$BSPGCT PAGE FRAME AND BUMP @OZ29138 Q2987020 A PL,PDDBPGCT BY FRAME SIZE @OZ29138 Q2987040 ST PL,PBSPGCT SAVE FOR NEXT TABLE UPDATE @OZ29138 Q2987200 LTR R15,R15 IF SINGLE ENTRY, NO NEED @OZ19494 Q2987210 BM PBSFSGO TO RESTORE TABLE @OZ19494 Q2987220 EX R15,PPOP3 RESTORE BACKSPACE TABLE @OZ19494 Q2987230 LA PL,0(R15,R1) POINT TO LAST ENTRY-1 @OZ19494 Q2987240 MVC 1(7,PL),PCEFORM RESTORE LAST TABLE ENTRY @OZ19494 Q2987250 B PBSFSGO GO TO RESTART PROCESS Q2988000 SPACE 1 R4 Q2989000 PPOP1 MVC BUFSTART(*-*),0(R1) *** EXECUTE ONLY *** R41 Q2990000 PPOP2 MVC 7(*-*,R1),BUFSTART *** EXECUTE ONLY *** R41 Q2991000 PPOP3 MVC 0(*-*,R1),BUFSTART *** EXECUTE ONLY *** @OZ19494 Q2991100 SPACE 1 @OZ19494 Q2992000 PBSPBEG CLC PDDBPGCT,PDDBSKIP COMPARE PAGE AND SKIP COUNT @OZ19494 Q2993000 BNE PBSPBEG1 START FROM TOP IF NOT EQUAL @OZ19494 Q2993100 ICM PL,15,PFSBSCT IF $F/$B PAGE COUNT ZERO @OZ19494 Q2993120 BZ PBSFSGO RESTART POSITION SET @OZ19494 Q2993160 PBSPBEG1 LH PC1,PDDBDISP GET PDDB OFFSET @OZ19494 Q2993200 LA PC2,0(PC1,JCT) GET PDDB ADDRESS R4 Q2994000 MVC PCEJMTTR,PDBMTTR-PDBDSECT(PC2) RESET 1ST MTTR R4 Q2995000 MVI PBUFSKIP,0 RESET TRACK-CELL BUFFER OFFSET R4 Q2996000 B PCKINIT BACKSPACE TO START OF DATA SET R4 Q2997000 EJECT Q2998000 *********************************************************************** Q2999000 * * Q3000000 * PRINT HASP JOB STATISTICS AFTER LOG DATA SET * Q3001000 * * Q3002000 *********************************************************************** Q3003000 SPACE 1 R4 Q3004000 PRLOGCK SLR R0,R0 RESET PAGE COUNT @OZ28599 Q3005000 ST R0,PDDBPGCT AND SAVE IT @OZ28599 Q3005500 TM PCEID,PCEPUSID IS THIS A PUNCH PROCESSOR Q3006000 BO PNEXTDDB BRANCH IF YES Q3007000 LH PC1,PDDBDISP GET PDDB OFFSET INTO THE IOT Q3008000 LA PC2,0(PC1,JCT) ADD IOT BASE Q3009000 TM PDBFLAG1-PDBDSECT(PC2),PDB1LOG IS THIS THE LOG PDDB Q3010000 BNO PNEXTDDB BRANCH IF NO Q3011000 L JCT,PJCTBUF ADDRESS JCT BUFFER Q3012000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY Q3013000 ICM R1,15,JCTXEQOF JCT COMPLETE... @OZ43026 Q3013050 BNZ PRNUJCT BR IF YES, NO REFRESH @OZ43026 Q3013100 L JCT,PCEJQE GET JQE ADDRESS @OZ43026 Q3013150 $#JCT READ,REFRESH=YES GET JCT BUFFER ADDRESS @OZ43026 Q3013200 BZ PRERJCT BR IF ERROR, USE OLD JCT @OZ43026 Q3013250 ST JCT,PJCTBUF SAVE REFRESHED JCT BUF ADD @OZ43026 Q3013300 $#JCT FREE FREE JCT (REDUCE USE COUNT) @OZ43026 Q3013350 B PRNUJCT JCT REFRESHED, CONTINUE @OZ43026 Q3013400 PRERJCT DS 0H @OZ43026 Q3013450 L JCT,PJCTBUF RESTORE JCT ADDRESS @OZ43026 Q3013500 PRNUJCT DS 0H @OZ43026 Q3013550 MVC PMESSAGE,PJOBSTAT SETUP STATISTICS TITLE Q3014000 L R15,=A(PCOMMENT) WRITE STATISTICS HEADER @OZ19494 Q3014500 BALR PL,R15 ----------------------- @G38ESBB Q3015000 ICM R1,15,JCTXDTON OBTAIN EXECUTION DATE R41 Q3015100 BZ PRNODATE BR IF NONE R41 Q3015200 L R15,=A(PPDATE) ELSE CONVERT DATE @OZ19494 Q3015210 BALR R14,R15 TO ' DD MMM YY' @OZ19494 Q3015300 MVC PMESSAGE+10(L'PXEQDATE),PXEQDATE FORMAT MESSAGE R41 Q3015400 L R15,=A(PCOMMENT) WRITE EXECUTION DATE @OZ19494 Q3015500 BALR PL,R15 -------------------- @G38ESBB Q3015550 PRNODATE DS 0H R41 Q3015600 MVC PMESSAGE,PRDRSTAT SETUP CARDS READ Q3016000 L R1,JCTCARDS GET INPUT CARD COUNT Q3017000 CVD R1,PCCWORK CONVERT TO DECIMAL Q3018000 ED PMESSAGE(10),PCCWORK+4 EDIT INPUT CARD COUNT R4 Q3019000 L R15,=A(PCOMMENT) WRITE CARDS READ @OZ19494 Q3020000 BALR PL,R15 ---------------- @G38ESBB Q3020500 MVC PMESSAGE,PPRTSTAT SETUP SYSOUT PRINT Q3021000 L R1,JCTLINES GET SYSOUT LINE COUNT Q3022000 CVD R1,PCCWORK CONVERT TO DECIMAL Q3023000 ED PMESSAGE(10),PCCWORK+4 EDIT SYSOUT RECORD COUNT R4 Q3024000 L R15,=A(PCOMMENT) WRITE PRINT RECORD COUNT @OZ19494 Q3025000 BALR PL,R15 ------------------------ @G38ESBB Q3025500 MVC PMESSAGE,PPUNSTAT SETUP SYSOUT PUNCH Q3026000 L R1,JCTPUNCH GET SYSOUT PUNCH COUNT Q3027000 CVD R1,PCCWORK CONVERT TO DECIMAL Q3028000 ED PMESSAGE(10),PCCWORK+4 EDIT SYSOUT RECORD COUNT R4 Q3029000 L R15,=A(PCOMMENT) WRITE PUNCH RECORD COUNT @OZ19494 Q3030000 BALR PL,R15 ------------------------ @G38ESBB Q3030500 MVC PMESSAGE,PXEQSTAT SETUP EXECUTION TIME Q3031000 SLR R0,R0 ZERO TIME ACCUMULATOR R4 Q3032000 SLR R1,R1 ZERO TIME ACCUMULATOR R4 Q3033000 CLC JCTXDTON,JCTXDTOF COMPARE START AND STOP DATES R4 Q3034000 BE PRDATEQ BRANCH IF SAME DAY R4 Q3035000 BL PRDATELO BRANCH IF SPANNED AT LEAST 1 DAY R4 Q3036000 PRDATEHI DS 0H R4 Q3037000 MVC PMESSAGE+1(9),=C'(UNKNOWN)' JOB STOPPED BEFORE START R4 Q3038000 B PRXTIME BRANCH TO PRINT MESSAGE R4 Q3039000 EJECT R4 Q3040000 PRDATELO DS 0H R4 Q3041000 TM JCTXDTON+3,X'0F' VALIDATE START DATE (00YYDDDF) R4 Q3042000 BNO PRDATEHI ERR MSG IF DATE NOT STORED R4 Q3043000 TM JCTXDTOF+3,X'0F' VALIDATE STOP DATE R4 Q3044000 BNO PRDATEHI ERR MSG IF DATE NOT STORED R4 Q3045000 CLC JCTXDTON(2),JCTXDTOF COMPARE YEAR PORTIONS ONLY R4 Q3046000 BE PRYEAREQ BRANCH IF SAME YEAR R4 Q3047000 BH PRDATEHI ERR MSG IF YEARS BACKWARD R4 Q3048000 ZAP PCCWORK,JCTXDTON ISOLATE START YEAR R4 Q3049000 SRP PCCWORK,64-3,0 AS PACKED DECIMAL NUMBER R4 Q3050000 CVB PL,PCCWORK CONVERT START YEAR TO BINARY, R4 Q3051000 N PL,=F'3' TEST FOR LEAP YEAR @OZ40773 Q3052000 BNZ SKIP270 SKIP IF NOT LEAP YEAR R4 Q3053000 LA R1,1 ALLOW FOR 366-DAY YEAR R4 Q3054000 SKIP270 LA R1,365(,R1) ADD 365 DAYS FOR YEAR CHANGE R4 Q3055000 PRYEAREQ DS 0H R4 Q3056000 ZAP PCCWORK,JCTXDTOF+2(2) COMPUTE DIFFERENCE R4 Q3057000 SP PCCWORK,JCTXDTON+2(2) BETWEEN JOB START R4 Q3058000 CVB PL,PCCWORK DAY AND JOB STOP DAY R4 Q3059000 AR R1,PL ADD TO ADJUSTMENT FOR YEAR CHANGE R4 Q3060000 M R0,=A(24*60*60*100) CONVERT DAYS TO HUNDREDTHS OF SEC R4 Q3061000 PRDATEQ DS 0H R4 Q3062000 AL R1,JCTXEQOF ADD STOP TIME R4 Q3063000 BC 12,SKIP280 SKIP IF NO CARRY R4 Q3064000 AL R0,=F'1' ADJUST HIGH END R4 Q3065000 SKIP280 SL R1,JCTXEQON SUBTRACT START TIME R4 Q3066000 BC 3,SKIP290 SKIP IF CARRY R4 Q3067000 BCTR R0,0 ADJUST HIGH END R4 Q3068000 SKIP290 LTR R0,R0 CHECK HIGH END R4 Q3069000 BM PRDATEHI ERR MSG IF TOTAL TIME NEGATIVE R4 Q3070000 BP PRBIGMIN BRANCH IF TOO LARGE FOR EDIT R4 Q3071000 CL R1,=A(9999999*60) CHECK LOW END R4 Q3072000 BH PRBIGMIN BRANCH IF TOO LARGE FOR EDIT R4 Q3073000 D R0,=F'60' CONVERT TO HUNDREDTHS OF MINUTES R4 Q3074000 B PRTIMCVD BRANCH TO CVD AND EDIT R4 Q3075000 PRBIGMIN DS 0H R4 Q3076000 D R0,=A(60*100) CONVERT TIME TO WHOLE MINUTES R4 Q3077000 MVC PMESSAGE(10),PRDRSTAT REPLACE EDIT PATTERN R4 Q3078000 PRTIMCVD DS 0H R4 Q3079000 CVD R1,PCCWORK CONVERT TO DECIMAL R4 Q3080000 ED PMESSAGE(10),PCCWORK+4 EDIT EXECUTION TIME R4 Q3081000 PRXTIME DS 0H R4 Q3082000 L R15,=A(PCOMMENT) WRITE EXECUTION TIME @OZ19494 Q3083000 BALR PL,R15 -------------------- @G38ESBB Q3083500 DROP JCT SUSPEND JCT ADDRESSABILITY Q3084000 LR JCT,PBUF RESTORE IOT BASE ADDRESS Q3085000 EJECT Q3086000 *********************************************************************** Q3087000 * * Q3088000 * PREPARE FOR SELECTION OF THE NEXT DATA SET * Q3089000 * * Q3090000 *********************************************************************** Q3091000 SPACE 1 R4 Q3092000 PNEXTDDB DS 0H Q3093000 XC PDDBSKIP,PDDBSKIP CLEAR SKIP COUNT Q3094000 L R1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ32566 Q3095000 USING DCTDSECT,R1 ACTIVATE DCT ADDRESSABILITY Q3096000 NI DCTFLAGS,255-DCTSPACE RESET SPACE CONTROL SWITCHES Q3097000 DROP R1 SUSPEND DCT ADDRESSABILITY Q3098000 NI PDCTFLAG,255-DCTSPACE RESET SPACE CONTROL SWITCHES Q3099000 LM PC1,PC2,PRCCWEJ SELECT SKIP TO CH 1 CCW Q3100000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE Q3101000 BO *+8 BRANCH IF PRINT Q3102000 LM PC1,PC2,PUCCWBL SELECT BLANK CARD CCW Q3103000 BAL PL,PPPUT PUT CCW ONTO CHAIN Q3104000 BAL PL,PPWRITE SEND CHAIN TO DEVICE Q3105000 BAL PL,PPCHECK CHECK WRITE Q3106000 L PW,PRPAGECT UPDATE R41 Q3107000 LA PW,1(,PW) TOTAL R41 Q3108000 ST PW,PRPAGECT PAGE COUNT R41 Q3109000 XC PULMTTR(7),PULMTTR CLEAR PUNCH RESTART POINTER R4 Q3110000 SPACE 1 R4 Q3111000 *********************************************************************** Q3112000 * * Q3113000 * RE-CYCLE SAME DATA SET UNTIL DS COPIES IS SATISFIED * Q3114000 * * Q3115000 *********************************************************************** Q3116000 SPACE 1 R4 Q3117000 USING PDBDSECT,PC1 PROVIDE PDDB ADDRESSABILITY R4 Q3118000 SPACE 1 R4 Q3119000 PRCPYTST DS 0H Q3120000 SPACE 1 R4 Q3121000 NI PPFLAG2,255-PPFDS RESET 1ST DATA SET SWITCH R4 Q3122000 SPACE 1 R4 Q3123000 LH PC1,PDDBDISP PDDB OFFSET INTO THE IOT R4 Q3124000 LA PC1,0(PC1,PBUF) ADD IOT BASE R4 Q3125000 MVC PCEJMTTR,PDBMTTR RESET 1ST MTTR OF DATA SET R4 Q3126000 SPACE 1 R4 Q3127000 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R4 Q3128000 BE PRCPYGRP HANDLE COPY GROUPS IF YES R4 Q3129000 SPACE 1 R4 Q3130000 IC PW,PPRCPYCT INCREMENT Q3131000 LA PW,1(,PW) COPY Q3132000 STC PW,PPRCPYCT COUNT Q3133000 CLC PPDSCPY,PPRCPYCT ENOUGH COPIES OF DATA SET Q3134000 BH PNXTCPY BR IF ANOTHER COPY NEEDED R4 Q3135000 SPACE 1 R4 Q3136000 PRCPYEND DS 0H R4 Q3137000 MVI PPRCPYCT,X'00' SET COPY COUNT TO ZERO Q3138000 B PDDBSRCH FIND NEXT MATCHING PDDB Q3139000 EJECT R4 Q3140000 *********************************************************************** Q3141000 * * Q3142000 * HANDLE COPIES (COPY GROUPS) AND FLASH COUNTS FOR 3800 * Q3143000 * * Q3144000 *********************************************************************** Q3145000 SPACE 1 R4 Q3146000 PRCPYGRP DS 0H R4 Q3147000 SLR PW,PW CLEAR WORK REGISTER R4 Q3148000 LA R1,1 ASSUME 1 COPY JUST PRINTED R4 Q3149000 CLI PCOPYGRP,0 TEST FOR COPY GROUPS R4 Q3150000 BE SKIP300 BR IF NOT - ASSUMPTION CORRECT R4 Q3151000 IC R1,PDDBCPYG ELSE, USE COUNT R4 Q3152000 IC R1,PCOPYGRP(R1) OF COPIES JUST PRINTED R4 Q3153000 SKIP300 IC PW,PPRCPYCT UPDATE TOTAL R4 Q3154000 LA PW,0(R1,PW) NUMBER OF R4 Q3155000 STC PW,PPRCPYCT COPIES PRINTED R4 Q3156000 CLM PW,1,PPDSCPY TEST FOR ALL COPIES PRINTED R4 Q3157000 BNL PRCPYEND BR IF YES R4 Q3158000 LA R1,1(,PW) PLACE NEW STARTING R4 Q3159000 STC R1,SPCOPYS COPY NO. INTO SETUP LIST R4 Q3160000 MVI SPFLASHC,0 ASSUME NO MORE FLASHING R4 Q3161000 CLI PDBFLASH,C'*' FLASHING... @OZ18407 Q3161200 BE PRCPYN BR IF NO @OZ18407 Q3161400 IC R1,PDBFLSHC GET NO. COPIES NEEDING FLASH R4 Q3162000 SR R1,PW SUBTRACT NUMBER ALREADY FLASHED R4 Q3163000 BNP PRCPYN BR IF DONE FLASHING @OZ18407 Q3164000 STC R1,SPFLASHC ELSE SET REMAINING COUNT @OZ18407 Q3165000 SPACE 1 @OZ18407 Q3165500 PRCPYN MVI SPCOPYN,1 ASSUME 1 COPY THIS XMISSION @OZ18407 Q3166000 CLI PCOPYGRP,0 TEST FOR COPY GROUPS R4 Q3167000 BE PTSTRXMT BR IF NO R41 Q3168000 SLR PW,PW ELSE, UPDATE R4 Q3169000 IC PW,PDDBCPYG COPY GROUP OFFSET R4 Q3170000 LA PW,1(,PW) IN CKPT-AREA AND R4 Q3171000 STC PW,PDDBCPYG PLACE NUMBER R4 Q3172000 IC PW,PCOPYGRP(PW) OF COPIES INTO R4 Q3173000 STC PW,SPCOPYN SETUP LIST R4 Q3174000 B PSETRXMT BR TO SETUP FOR RE-XMIT R41 Q3174500 SPACE 1 R41 Q3175500 PTSTRXMT CLI PDBMODF,C'*' USING COPY-MOD... R41 Q3176500 BNE PSETRXMT BR IF YES R41 Q3177500 CLI PDBFLASH,C'*' FLASHING... R41 Q3178500 BE PRCPYOFS BR IF NO R41 Q3179500 CLC PDBFLSHC,PPRCPYCT TURN-OFF FLASHING... @OZ18407 Q3179600 BNE PRCPYOFS BR IF NO @OZ18407 Q3179700 SPACE 1 R41 Q3180500 PSETRXMT MVI SPFLAG,SPREXMIT SET RETRANSMISSION INDICATION R41 Q3181500 L R15,=A(P3800DSV) CALL 3800 R4 Q3187000 BALR PL,R15 DEVICE SETUP VERIFICATION R4 Q3188000 L PL,PCEDCT GET DCT ADDRESS @G38ESBB Q3188100 TM DCTPPSW2-DCTDSECT(PL),DCTCKJAM 3800 PJAM/CKEY @G38ESBB Q3188200 BZ PRCPYOFS BR IF NOT @G38ESBB Q3188300 L R15,=A(PLOCATE) CALL THE LOCATE ROUTINE @G38ESBB Q3188400 BALR PL,R15 TO GET ORIGIN PQE @G38ESBB Q3188500 B PPDSEND PROCESS PAPERJAM/CANCEL KEY @G38ESBB Q3188600 SPACE 1 R4 Q3189000 PRCPYOFS TM PPFLAG,PRDELSW COMMAND DURING DSV... @G38ESBB Q3189200 BO PPDONE YES, GO TERMINATE @G38ESBB Q3189400 LM PC1,PC2,PCCWOFST ADD OFFSET-STACKER @G38ESBB Q3189600 BAL PL,PPPUT2 CCW TO CHAIN @OZ51441 Q3189800 ICM PC1,8,PXTABCCW SELECT @OZ24675 Q3189900 BAL PL,PPPUT2 CHAR1 @OZ51441 Q3189950 B PNXTCPY BR FOR NEXT COPY (COPIES) R4 Q3190000 SPACE 1 R4 Q3191000 DROP PC1 SUSPEND PDDB ADDRESSABILITY R4 Q3192000 TITLE 'HASP PRINT/PUNCH SERVICE -- PPPUT SUBROUTINE' R4 Q3193000 *********************************************************************** Q3194000 * * Q3195000 * PPPUT -- SUBROUTINE TO ADD A NEW PRINT OR PUNCH COMMAND TO * Q3196000 * THE CURRENT CCW AREA * Q3197000 * * Q3198000 * PC1,PC2 - 8 BYTE CHANNEL COMMAND WORD * Q3199000 * PL - RETURN ADDRESS * Q3200000 * * Q3201000 *********************************************************************** Q3202000 SPACE 1 R4 Q3203000 *********************************************************************** Q3204000 * * Q3205000 * ELIMINATE EXTRANEOUS PAGE EJECTS * Q3206000 * * Q3207000 *********************************************************************** Q3208000 SPACE 1 R4 Q3209000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY R4 Q3210000 SPACE 1 R4 Q3211000 PPPUT TM PCEID,PCEPRSID TEST PROCESSOR TYPE R4 Q3212000 BNO PPPUT2 BRANCH IF NOT PRINTER R4 Q3213000 L R1,PCEDCT LOAD ADDRESS OF PRINTER DCT @OZ32566 Q3214000 CLM PC1,8,=X'89' TEST CHANNEL COMMAND CODE Q3215000 BL PPPUT1 BR IF NOT POSSIBLE EJECT Q3216000 BE PCHAN1 BR IF PRINT, SKIP TO CHANNEL 1 R4 Q3217000 CLM PC1,8,=X'8B' TEST CHANNEL COMMAND CODE Q3218000 BNE PPPUT1 BRANCH IF NOT IMED SKP CHNL 1 Q3219000 TM DCTPPFL,DCTEJECT CHECK IF ALREADY AT CHANNEL 1 R4 Q3220000 BOR PL RETURN IF YES R4 Q3221000 SPACE 1 R4 Q3222000 PCHAN1 OI DCTPPFL,DCTEJECT SHOW PRINTER EJECTED Q3223000 B PPPUT2 AND CONTINUE Q3224000 PPPUT1 NI DCTPPFL,255-DCTEJECT RESET CHANNEL 1 SWITCH Q3225000 SPACE 1 R4 Q3226000 *********************************************************************** Q3229000 * * Q3230000 * ALTERNATE PPPUT ENTRY POINT * Q3231000 * * Q3232000 * IF REMOTE -- SEND CCW TO LINE MANAGER * Q3233000 * * Q3234000 *********************************************************************** Q3235000 SPACE 1 R4 Q3236000 PPPUT2 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q3237000 BZ PTESTCHN BR IF NOT REMOTE TERMINAL R4 Q3238000 STM PC1,PC2,POUTCCWA PASS CCW TO R4 Q3239000 L R1,PCEDCT GET PRINT/PUNCH DCT ADDRESS @OZ32566 Q3240000 LA R0,POUTCCWA LOAD ADDRESS OF CCW R4 Q3241000 * THIS LINE DELETED BY APAR @OZ19494 Q3243000 $EXTP PUT,(R1),(R0) PASS REQUEST TO RTAM @OZ19494 Q3244000 BNZ PPCHECK BRANCH IF SUCCESSFUL @OZ19494 Q3245000 NI PPFLAG2,255-PPCKPTA DON'T ALLOW CHECKPOINTS @OZ19494 Q3247000 B PPCHECK CHECK OPERATOR COMMANDS R4 Q3248000 EJECT R4 Q3249000 *********************************************************************** Q3250000 * * Q3251000 * SEE IF OK TO ADD NEW CCW TO THIS CCW AREA * Q3252000 * * Q3253000 *********************************************************************** Q3254000 SPACE 1 R4 Q3255000 USING PCIDSECT,PW PROVIDE PCIE ADDRESSABILITY R4 Q3256000 SPACE 1 R4 Q3257000 PTESTCHN LH PW,PCCWLAST GET OFFSET TO PCIE R4 Q3258000 AL PW,POUTCCWA ADD BASE TO OBTAIN TRUE ADDRESS R4 Q3259000 SPACE 1 R4 Q3260000 TM PCISGNAL,PCIACTIV USE IS OK IF THIS R4 Q3261000 BZ PPCHAIN CCW AREA IS NOT ACTIVE, R4 Q3262000 TM PPFLAG,PPWSW OR IF A WRITE R4 Q3263000 BZ PPCHAIN IS NOT IN PROGRESS R4 Q3264000 SPACE 1 R4 Q3265000 ST PL,PLSAVE ELSE, WAIT R4 Q3266000 BAL PL,PCIWAIT FOR A PCI R4 Q3267000 L PL,PLSAVE AND R4 Q3268000 B PTESTCHN TRY AGAIN R4 Q3269000 SPACE 1 R4 Q3270000 DROP R1,PW SUSPEND DCT/PCIE ADDRESSABILITY R41 Q3271000 SPACE 1 R4 Q3272000 *********************************************************************** Q3273000 * * Q3274000 * TRANSLATE VIRTUAL DATA ADDRESS TO REAL AND ADD CCW TO CHAIN * Q3275000 * * Q3276000 *********************************************************************** Q3277000 SPACE 1 R4 Q3278000 PPCHAIN DS 0H Q3279000 L PW,PCCWPT PICK UP CURRENT CCW POINTER R4 Q3280000 LA PW,8(,PW) BUMP CCW POINTER Q3281000 STM PC1,PC2,0(PW) ADD CCW TO CHAIN Q3282000 LRA R1,0(,PC1) CONVERT VIRT DATA ADDRESS TO REAL R4 Q3283000 STCM R1,7,1(PW) AND UPDATE IN CHAIN R4 Q3284000 SPACE 1 R4 Q3285000 *********************************************************************** Q3286000 * * Q3287000 * MERGE IMMEDIATE CCW WITH PREVIOUS PRINT, NO SPACE CCW * Q3288000 * * Q3289000 *********************************************************************** Q3290000 SPACE 1 R4 Q3291000 OC 6(2,PW),6(PW) TEST BYTE COUNT Q3292000 BNZ PPENDCHK BRANCH IF NOT ZERO Q3293000 TM 0(PW),X'02' IS THIS AN IMMED CMD... @OZ25297 Q3293125 BO PPCHAIN1 YES, CHK IF COMBINE @OZ25297 Q3293250 MVI 5(PW),C' ' SET BLANK SOURCE @OZ25297 Q3293375 LRA R1,5(,PW) GET REAL ADDRESS OF BLANK @OZ25297 Q3293500 STCM R1,7,1(PW) IN CCW @OZ25297 Q3293625 B PPNOMERG AND SET LENGTH TO 1 @OZ25297 Q3293750 PPCHAIN1 DS 0H @OZ25297 Q3293875 L R1,POUTCCWA ADDRESS 1ST CCW IN CHAIN R4 Q3294000 CLR PW,R1 IS CURRENT CCW AFTER 1ST Q3295000 BNH PPNOMERG BR IF NOT R4 Q3296000 L R1,PCCWPT R1 = ADDRESS OF LAST CCW Q3297000 CLI 0(R1),X'01' TEST LAST COMMAND Q3298000 BNE PPNOMERG BR IF NOT PRINT, NO SPACE R4 Q3299000 NI 0(PW),X'FD' REMOVE IMMEDIATE BIT R4 Q3300000 MVC 0(1,R1),0(PW) MOVE COMMAND TO PREVIOUS CCW R4 Q3301000 BR PL RETURN -- NO CCW ADDED R4 Q3302000 SPACE 1 R4 Q3303000 PPNOMERG MVI 7(PW),X'01' FORCE BYTE COUNT NON-ZERO Q3304000 EJECT R4 Q3305000 *********************************************************************** Q3306000 * * Q3307000 * UPDATE CCW POINTER AND PUNCH RESTART POINTERS * Q3308000 * * Q3309000 *********************************************************************** Q3310000 SPACE 1 R4 Q3311000 PPENDCHK ST PW,PCCWPT SAVE CCW POINTER Q3312000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE Q3313000 BO PNOTPUN BRANCH IF PRINT Q3314000 TM 0(PW),X'05' IS CCW A 3525 PRINT-LINE Q3315000 BO PNOTPUN BRANCH IF YES - DON'T CKPT Q3316000 L R1,POUTIOB ADDRESS OF OUTPUT IOB R4 Q3317000 MVC PPBNMTTR-BUFDSECT(4,R1),PCEJMTTR UPDATE PUNCH R4 Q3318000 MVC PPBNRCB-BUFDSECT(2,R1),PCEEJRCB RESTART R4 Q3319000 MVC PPBNBOFF-BUFDSECT(1,R1),PCEJBOFF POINTERS R4 Q3320000 SPACE 1 R4 Q3321000 *********************************************************************** Q3322000 * * Q3323000 * USE PPWRITE IF CCW AREA IS FULL * Q3324000 * * Q3325000 *********************************************************************** Q3326000 SPACE 1 R4 Q3327000 PNOTPUN DS 0H Q3328000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q3328200 BNE *+8 NO, BRANCH @G38ESBB Q3328400 LA PW,RPISIBSZ+L'PCCWNOP(,PW) INCLUDE RPI,SIB,NOP @G38ESBB Q3328600 LA PW,8(,PW) COMPUTE OFFSET OF NEXT R4 Q3329000 SL PW,POUTCCWA SLOT IN CCW CHAIN R4 Q3330000 CH PW,PCCWLAST TEST FOR END OF CCW CHAIN R4 Q3331000 BLR PL RETURN IF NOT R4 Q3332000 TITLE 'HASP PRINT/PUNCH SERVICE -- PPWRITE SUBROUTINE' R4 Q3333000 *********************************************************************** Q3334000 * * Q3335000 * PPWRITE -- SUBROUTINE TO SCHEDULE A NEW CCW AREA FOR OUTPUT * Q3336000 * * Q3337000 * PL - RETURN ADDRESS * Q3338000 * * Q3339000 *********************************************************************** Q3340000 SPACE 1 R4 Q3341000 DROP PBUF ACTIVATE LOCAL ADDRESSABILITY ON R4 Q3342000 USING BUFDSECT,R15 OUTPUT IOB (BUFFER PREFIX) R4 Q3343000 SPACE 1 R4 Q3344000 CNOP 0,8 R4 Q3345000 PPWRITE ST PL,PLSAVE SAVE RETURN ADDRESS R4 Q3346000 SPACE 1 R4 Q3347000 *********************************************************************** Q3348000 * * Q3349000 * RETURN IF REMOTE OR IF CCW AREA IS EMPTY * Q3350000 * * Q3351000 *********************************************************************** Q3352000 SPACE 1 R4 Q3353000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q3354000 BOR PL RETURN IF REMOTE R4 Q3355000 L PW,PCCWPT PICK UP CCW POINTER R4 Q3356000 L R1,POUTCCWA ADDR OF CCW AREA R4 Q3357000 CLR PW,R1 RETURN IF R4 Q3358000 BLR PL NO CCW'S R4 Q3359000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q3359030 BE PSETPCI YES, BRANCH @G38ESBB Q3359060 L R15,POUTCCWN GET NEW CCW CHAIN ADDRESS @OZ29138 Q3359100 AH R15,PCCWLAST POINT TO THE PCIE, @OZ29138 Q3359200 LA R15,PCIESIZE(,R15) AND THE CCW CHKPT AREA. @OZ29138 Q3359300 MVC JOEPPCT-JOECKPP(,R15),PDDBPGCT UPDATE PAGE CNT @OZ27300 Q3359400 SPACE 1 R4 Q3360000 *********************************************************************** Q3361000 * * Q3362000 * SET PCI AND INITIALIZE PCIE AT END OF NEW CCW AREA * Q3363000 * * Q3364000 *********************************************************************** Q3365000 SPACE 1 R4 Q3366000 USING PCIDSECT,R1 PROVIDE PCIE ADDRESSABILITY R4 Q3367000 SPACE 1 R4 Q3368000 PSETPCI L R15,POUTIOB ADDRESS OUTPUT IOB @G38ESBB Q3369000 OI 4(R1),X'08' SET PCI AT TOP OF NEW AREA R4 Q3370000 AH R1,PCCWLAST COMPUTE ADDR OF PCIE R4 Q3371000 LR R0,R1 SAVE PCIE ADDR @OZ47150 Q3371100 OI PCISGNAL,PCIACTIV+PCIBUSY SHOW PCIE ACTIVE AND BUSY R4 Q3372000 NI PCI1FLGS,255-X'40' TURN OFF COMMAND CHAINING R4 Q3373000 ST PW,PPBLVCCN SAVE POINTER TO LAST VALID CCW R4 Q3374000 EJECT @OZ47150 Q3375000 *********************************************************************** Q3376000 * * Q3377000 * IF CCW AREA IS NOT FULL -- ADD A TIC TO THE PCIE * Q3378000 * * Q3379000 *********************************************************************** Q3380000 SPACE 1 R4 Q3381000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q3381200 BNE PNXTSLOT NO, BRANCH @G38ESBB Q3381400 SH R1,=Y(L'PCCWSIB) POINT TO SIB CCW @G38ESBB Q3381600 ST R1,PPBLVCCN SET LAST VALID CCW TO SIB @G38ESBB Q3381800 SH R1,=Y(L'PCCWXORD) ADDRESS THE RPI @G38ESBB Q3382000 LR R0,R1 SAVE RPI ADDR @OZ47150 Q3382100 SH R0,=Y(L'PCCWNOP) POINT TO NOP CCW @OZ47150 Q3382200 SPACE 1 @OZ47150 Q3382300 PNXTSLOT LA PW,8(,PW) ADDR OF NEXT SLOT IN CHAIN @G38ESBB Q3382400 CLR PW,R0 COMPARE WITH END @OZ47150 Q3383000 BE PPWSWAP BRANCH IF EQUAL (FLUSH WITH PCIE) R4 Q3384000 LRA R1,0(,R1) CONVERT VIRT PCIE ADDRESS TO REAL R4 Q3385000 MVC 0(8,PW),PCNOPTIC+8 ADD A TIC ON THE CHAIN R4 Q3386000 STCM R1,7,1(PW) AND POINT IT TO THE PCIE R4 Q3387000 EJECT R4 Q3388000 *********************************************************************** Q3389000 * * Q3390000 * SWAP CCW AREA POINTERS * Q3391000 * * Q3392000 *********************************************************************** Q3393000 SPACE 1 R4 Q3394000 PPWSWAP DS 0H R4 Q3395000 $COUNT ******* RECORD USAGE ******* R4 Q3396000 LM R0,R1,POUTCCWA SWAP R4 Q3397000 ST R0,POUTCCWN CCW AREA R4 Q3398000 ST R1,POUTCCWA POINTERS R4 Q3399000 ST R0,PPBCCWNX NEW CHAIN ADDR INTO BUFFER PREFIX R4 Q3400000 LR PW,R1 RESET POINTER R4 Q3401000 SH PW,=H'8' TO FIRST CCW R4 Q3402000 ST PW,PCCWPT IN NEXT AREA R4 Q3403000 SPACE 1 R4 Q3404000 *********************************************************************** Q3405000 * * Q3406000 * IF WRITE IN PROGRESS -- PREPARE TO CHAIN NEW CCW AREA ON * Q3407000 * * Q3408000 *********************************************************************** Q3409000 SPACE 1 R4 Q3410000 TM PPFLAG,PPWSW TEST FOR WRITE IN PROGRESS R4 Q3411000 BZ PWEXCPVR IF NOT - GO START ONE R4 Q3412000 AH R1,PCCWLAST ADDRESS OF PCIE ON ACTIVE CHAIN R4 Q3413000 L R0,PCI1CCW+4 RIGHT HALF OF PCIE NOP CCW R4 Q3414000 N R0,=A(X'FFFFFFFF'-PCIABORT) ABORT OFF FOR COMP @G38ESBB Q3414500 O R0,=A(PCIBUSY) SET BUSY FLAG FOR COMPARE R4 Q3415000 LR PW,R0 COPY AND BUILD A R4 Q3416000 ICM PW,8,=X'60' CHAINED NOP (CC+SLI) R4 Q3417000 EJECT R4 Q3418000 *********************************************************************** Q3419000 * * Q3420000 * ATTEMPT TO SET THE COMMAND-CHAINING BIT IN THE PCIE AT * Q3421000 * THE END OF THE CURRENTLY ACTIVE CHAIN * Q3422000 * * Q3423000 * IF SUCCESSFUL, THE TIC WILL PASS CONTROL TO THE NEW CHAIN * Q3424000 * IF NOT, WAIT FOR THE CHE AND RE-ISSUE I/O * Q3425000 * * Q3426000 *********************************************************************** Q3427000 SPACE 1 R4 Q3428000 CS R0,PW,PCI1CCW+4 APPEND NEW CHAIN TO ACTIVE CHAIN R4 Q3429000 BE PPWRETRN BR IF SUCCESSFUL R4 Q3430000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 @G38ESBB Q3430200 BNE PWAITCE BR IF NOT @G38ESBB Q3430400 NI PCISGNAL,FF-PCIABORT RESET ABORT IT @G38ESBB Q3430600 SPACE 1 @G38ESBB Q3430800 PWAITCE BAL PL,PPCHECK WAIT FOR CHANNEL-END @G38ESBB Q3431000 SPACE 1 R4 Q3432000 DROP R1 SUSPEND PCIE ADDRESSABILITY R4 Q3433000 SPACE 1 R4 Q3434000 *********************************************************************** Q3435000 * * Q3436000 * SETUP FOR OUTPUT I/O AND CALL $EXCP (VR) * Q3437000 * * Q3438000 *********************************************************************** Q3439000 SPACE 1 R4 Q3440000 PWEXCPVR DS 0H R4 Q3441000 L R15,POUTIOB RE-ESTABLISH IOB ADDRESSABILITY R4 Q3442000 L R1,POUTCCWN ADDRESS OF NEW CHANNEL PROGRAM R4 Q3443000 ST R1,IOBSTART PLACE INTO IOB FOR IOS R4 Q3444000 NI 4(R1),255-X'08' RESET PCI FLAG R4 Q3445000 TM PCEID,PCERJEID+PCEPRSID TEST PROCESSOR TYPE @OZ32288 Q3445100 BNZ PRTNOTPU BRANCH IF NOT LOCAL PUNCH @OZ32288 Q3445200 LR R14,R1 PRESET @OZ32288 Q3445300 SH R14,=H'8' ERROR @OZ32288 Q3445400 ST R14,PUERRPT POINTER @OZ32288 Q3445500 PRTNOTPU AH R1,PCCWLAST OBTAIN PCIE ADDRESS @OZ32288 Q3446000 ST R1,PPBPCIE PLACE INTO IOB FOR APPENDAGE R4 Q3447000 MVC PPBLVCCC,PPBLVCCN LAST VALID CCW ADDR INTO IOB R4 Q3448000 MVC PPBCMTTR(7),PPBNMTTR UPDATE PUNCH RESTART POINTERS R4 Q3449000 MVI PPBFLAG1,X'00' CLEAR CSW SAVE @OZ29106 Q3449500 L R1,PCEDCT PICK UP DCT ADDRESS @OZ32566 Q3450000 $EXCP (R1),TYPE=VR INITIATE WRITE (EXCPVR) R4 Q3451000 $COUNT ******* RECORD USAGE ******* R4 Q3452000 SPACE 1 R4 Q3453000 OI PPFLAG,PPWSW INDICATE WRITE HAS BEEN STAGED R4 Q3454000 SPACE 2 R4 Q3455000 PPWRETRN DS 0H R4 Q3456000 L PL,PLSAVE RESTORE LINK REGISTER R4 Q3457000 BR PL AND RETURN R4 Q3458000 SPACE 1 @G38ESBB Q3459000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q3460000 * DELETED @G38ESBB Q3461000 * DELETED @G38ESBB Q3462000 * DELETED @G38ESBB Q3463000 * DELETED @G38ESBB Q3464000 * DELETED @G38ESBB Q3465000 * DELETED @G38ESBB Q3466000 * DELETED @G38ESBB Q3467000 * DELETED @G38ESBB Q3468000 * DELETED @G38ESBB Q3469000 * DELETED @G38ESBB Q3470000 * DELETED @G38ESBB Q3471000 * DELETED @G38ESBB Q3472000 * DELETED @G38ESBB Q3473000 * DELETED @G38ESBB Q3474000 * DELETED @G38ESBB Q3475000 * DELETED @G38ESBB Q3476000 * DELETED @G38ESBB Q3477000 * DELETED @G38ESBB Q3478000 * DELETED @G38ESBB Q3478200 * DELETED @G38ESBB Q3478400 * DELETED @G38ESBB Q3478800 * DELETED @G38ESBB Q3479000 * DELETED @G38ESBB Q3480000 * DELETED @G38ESBB Q3480200 * DELETED @G38ESBB Q3480400 * DELETED @G38ESBB Q3480600 * DELETED @G38ESBB Q3480800 * DELETED @G38ESBB Q3481000 * DELETED @G38ESBB Q3482000 * DELETED @G38ESBB Q3483000 * DELETED @G38ESBB Q3484000 * DELETED @G38ESBB Q3485000 * DELETED @G38ESBB Q3486000 * DELETED @G38ESBB Q3487000 * DELETED @G38ESBB Q3488000 * DELETED @G38ESBB Q3489000 * DELETED @G38ESBB Q3490000 * DELETED @G38ESBB Q3491000 * DELETED @G38ESBB Q3492000 * DELETED @G38ESBB Q3493000 * DELETED @G38ESBB Q3494000 * DELETED @G38ESBB Q3495000 * DELETED @G38ESBB Q3496000 * DELETED @G38ESBB Q3497000 * DELETED @G38ESBB Q3498000 * DELETED @G38ESBB Q3499000 * DELETED @G38ESBB Q3500000 * DELETED @G38ESBB Q3501000 * DELETED @G38ESBB Q3502000 * DELETED @G38ESBB Q3503000 * DELETED @G38ESBB Q3504000 * DELETED @G38ESBB Q3505000 * DELETED @G38ESBB Q3506000 * DELETED @G38ESBB Q3507000 * DELETED @G38ESBB Q3508000 * DELETED @G38ESBB Q3509000 * DELETED @G38ESBB Q3510000 * DELETED @G38ESBB Q3510500 * DELETED @G38ESBB Q3510750 * DELETED @G38ESBB Q3511000 * DELETED @G38ESBB Q3512000 * DELETED @G38ESBB Q3513000 * DELETED @G38ESBB Q3514000 * DELETED @G38ESBB Q3515000 * DELETED @G38ESBB Q3516000 * DELETED @G38ESBB Q3517000 * DELETED @G38ESBB Q3518000 * DELETED @G38ESBB Q3518200 * DELETED @G38ESBB Q3518400 * DELETED @G38ESBB Q3518600 * DELETED @G38ESBB Q3518800 * DELETED @G38ESBB Q3519000 * DELETED @G38ESBB Q3519200 * DELETED @G38ESBB Q3519400 * DELETED @G38ESBB Q3519600 * DELETED @G38ESBB Q3519800 * DELETED @G38ESBB Q3520000 * DELETED @G38ESBB Q3521000 * DELETED @G38ESBB Q3522000 * DELETED @G38ESBB Q3523000 * DELETED @G38ESBB Q3524000 * DELETED @G38ESBB Q3525000 * DELETED @G38ESBB Q3526000 * DELETED @G38ESBB Q3527000 * DELETED @G38ESBB Q3528000 * DELETED @G38ESBB Q3529000 * DELETED @G38ESBB Q3530000 * DELETED @G38ESBB Q3531000 * DELETED @G38ESBB Q3532000 * DELETED @G38ESBB Q3533000 * DELETED @G38ESBB Q3534000 * DELETED @G38ESBB Q3534500 * DELETED @G38ESBB Q3535000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q3536000 TITLE 'HASP PRINT/PUNCH SERVICE -- PUNCH ERROR RECOVERY' R4 Q3537000 *********************************************************************** Q3538000 * * Q3539000 * *** PUNCH ERROR RECOVERY AND RESTART *** * Q3540000 * * Q3541000 *********************************************************************** Q3542000 SPACE 1 R4 Q3543000 PUNCHERR DS 0H Q3544000 L R14,PPBPCIE GET CURRENT PCIE POINTER @OZ45731 Q3545000 CR PW,R14 IS CCW ADDRESS ABOVE... @OZ45731 Q3546000 BH PCISIMUL YES, GO SIMULATE PCI @OZ45731 Q3546500 SH R14,PCCWLAST GET FIRST CCW ADDRESS @OZ45731 Q3547000 CR PW,R14 IS CCW WITHIN CURRENT AREA @OZ45731 Q3547500 BL PCISIMUL NO, GO SIMULATE PCI. @OZ45731 Q3548000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3549000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3550000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3551000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3552000 SPACE 1 R4 Q3553000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3554000 L R1,PPBPCIE ADDRESS 1ST POSSIBLE R4 Q3555000 USING PCIDSECT,R1 GAIN ADDRESSABILITY @OZ45731 Q3555400 NI PCISGNAL,255-PCIFNLBF TURN OFF FINAL BUFFER @OZ45731 Q3555500 DROP R1 DROP PCIE ADDRESSABILITY @OZ45731 Q3555600 SH R1,PCCWLAST CCW IN CHAIN R4 Q3556000 SL PW,=F'16' DECREMENT RESTART ADDRESS Q3557000 CLI PDEVTYPE+3,X'02' TEST PUNCH DEVICE TYPE Q3558000 BE PURANGE BRANCH IF 2540P Q3559000 LA PW,8(,PW) INCR RESTART ADDRESS BY 8 @OZ40462 Q3559500 CLI PDEVTYPE+3,X'0C' TEST PUNCH DEVICE TYPE Q3560000 BE PU3525 BRANCH IF 3525 Q3561000 * THIS LINE DELETED BY APAR @OZ40462 Q3562000 B PURANGE BRANCH TO CHECK RESTART ADDRESS Q3563000 PU3525 DS 0H Q3564000 CR PW,R1 IS RESTART ADDRESS BEFORE CCW'S R4 Q3565000 BL PUBACKUP BRANCH IF YES Q3566000 TM 0(PW),X'05' IS CCW A PUNCH CCW Q3567000 BM PURANGE BRANCH IF YES Q3568000 SL PW,=F'8' DECREMENT RESTART ADDRESS Q3569000 B PU3525 CONTINUE BACKWARD SCAN Q3570000 PUBACKUP DS 0H Q3571000 OC PULMTTR(6),PULMTTR IS RESTART POINTER ZERO Q3572000 BNZ PURSTRT BRANCH IF RESTART POINTER NOT ZERO Q3573000 LR PW,R1 SET RESTART ADDRESS TO 1ST CCW Q3574000 B PURANGE GO RANGE CHECK ADDRESS Q3575000 PURSTRT DS 0H Q3576000 MVC PCEJMTTR,PULMTTR SET RESTART BUFFER MTTR Q3577000 MVC PCEEJRCB,PULRCB SET RESTART RCB OFFSET Q3578000 MVC PBUFSKIP,PULBOFF SET RESTART BUFFER OFFSET R4 Q3579000 TM PPFLAG2,PPRSW READ IN PROGRESS ..... @OZ45731 Q3579100 BZ *+8 NO, RESTART.. @OZ45731 Q3579200 BAL PL,PRDTCHK WAIT FOR COMPLETION. @OZ45731 Q3579300 LA PL,PBSFSGO SETUP RESTART LOCATION Q3580000 CLI PDEVTYPE+3,X'0C' TEST PUNCH DEVICE TYPE @OZ38034 Q3580100 BNE PPWINIT BRANCH IF NOT 3525 @OZ38034 Q3580200 L R1,PRPUUCB ADDRESS 3525 UCB @OZ38034 Q3580300 MODESET EXTKEY=ZERO SET ZERO KEY TO ALTER UCB @OZ38034 Q3580400 OI UCBFL1-UCBDSECT(R1),UCBNOTRD SET NOT READY @OZ38034 Q3580500 MODESET EXTKEY=HASP RETURN TO NORMAL KEY @OZ38034 Q3580600 B PPWINIT EXIT TO COMPLETE RESTART R4 Q3581000 SPACE 1 R4 Q3582000 PURANGE DS 0H Q3583000 CR PW,R1 IS RESTART ADDRESS BEFORE CCW'S R4 Q3584000 BL PUBACKUP BRANCH IF YES Q3585000 CL PW,PUERRPT IS RESTART ADDRESS BEFORE LAST Q3586000 BNH PURETRY BRANCH IF YES Q3587000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587100 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587200 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587300 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587400 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587500 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587600 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587700 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587800 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3587900 ST PW,PUERRPT NEW ERROR -- SAVE CCW FOR TEST Q3588000 TITLE 'HASP PRINT/PUNCH SERVICE -- CHANNEL PROGRAM RESTART' R4 Q3589000 *********************************************************************** Q3590000 * * Q3591000 * RESTART PRINT/PUNCH CHANNEL PROGRAM AFTER ERROR * Q3592000 * * Q3593000 *********************************************************************** Q3594000 SPACE 1 R4 Q3595000 PRESTRT TM PCEID,PCEPRSID IS THIS A PRINTER PCE... @OZ35391 Q3595050 BO PPRTHALT YES..ISSUE MSG AND STOP. @OZ35391 Q3595100 TM IOBCSW+4,X'3F' TEST FOR CHANNEL FAILURES @OZ35391 Q3595150 BZ PUREST CONTINUE IF NONE. @OZ35391 Q3595300 PPRTHALT L R1,PCEDCT GET DCT ADDR. @OZ35391 Q3595450 LR R0,JCT SAVE JCT REG ACROSS $WTO @OZ35391 Q3595600 OI DCTFLAGS-DCTDSECT(R1),DCTSTOP STOP THE DEVICE @OZ35391 Q3595750 L JCT,PJCTBUF LOAD JCT FOR $WTO @OZ35391 Q3595900 SPACE 1 @OZ35391 Q3595950 $MID 191 @OZ35391 Q3596000 MVC PMESSAGE(2),=X'191F' MOVE MSG ID @OZ35391 Q3596200 MVC PMESSAGE+2(8),DCTDEVN-DCTDSECT(R1) MOVE DEVICE @OZ35391 Q3596350 MVC PMESSAGE+10(29),PURMSG MOVE MSG TEXT @OZ35391 Q3596500 $WTO PMESSAGE,39,JOB=YES, ISSUE PRINTER HALTED MSG @OZ35391*Q3596650 ROUTE=$LOG+$UR,CLASS=$DOMACT,PRI=$ST @OZ35391 Q3596800 LR JCT,R0 RESTORE JCT REG CONTENTS @OZ35391 Q3596900 LR R0,R1 SAVE ADDR FOR $DOM @OZ35391 Q3596910 SPACE 1 @OZ35391 Q3596925 PUREIFC L R1,PCEDCT LOAD DCT ADDRESS @OZ35391 Q3596950 USING DCTDSECT,R1 ESTABLISH DCT ADDRESS @OZ35391 Q3596960 * THIS LINE DELETED BY APAR ===> @OZ35391 Q3596975 TM DCTFLAGS,DCTSTOP TEST FOR $S DEVICE @OZ35391 Q3597000 BZ PRESTDOM BRANCH IF TRUE START @OZ35391 Q3597100 NI DCTFLAGS,255-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ35391 Q3597250 DROP R1 @OZ35391 Q3597300 $WAIT IO WAIT FOR POST FROM COMM @OZ35391 Q3597400 B PUREIFC TEST FOR $S DEVICE @OZ35391 Q3597550 SPACE 1 @OZ35391 Q3597600 PRESTDOM $DOM CMB=(R0) DELETE OPERATOR MESSAGE @OZ35391 Q3597700 ST PL,PPSAVE2+4 SAVE RETURN ADDRESS @OZ51011 Q3597710 L R15,=A(PPCMDCK) CALL SUBROUTINE TO PROCESS @OZ51011 Q3597720 BALR PL,R15 SYNCHRONOUS OPERATOR CMDS @OZ51011 Q3597730 L PL,PPSAVE2+4 RESTORE RETURN ADDRESS @OZ51011 Q3597740 L R15,POUTIOB PICK UP OUTPUT IOB ADDR @OZ35391 Q3597750 SPACE 1 @OZ35391 Q3597800 PUREST ST PW,IOBSTART RESTART CCW LIST @OZ35391 Q3597850 EJECT @OZ35391 Q3597900 *********************************************************************** Q3598000 * * Q3599000 * RESTART PRINT/PUNCH CHANNEL PROGRAM AT IOBSTART * Q3600000 * * Q3601000 * FOR 3525 PUNCH -- MAKE DEVICE 'NOT-READY' * Q3602000 * * Q3603000 *********************************************************************** Q3604000 SPACE 1 R4 Q3605000 PURETRY DS 0H Q3606000 CLI PDEVTYPE+3,X'0C' TEST DEVICE TYPE Q3607000 BNE PUREXCP BRANCH IF NOT A 3525 PUNCH Q3608000 L R1,PRPUUCB ADDRESS 3525 UCB R41 Q3609000 MODESET EXTKEY=ZERO GET ZERO KEY TO CHANGE THE UCB Q3610000 OI UCBFL1-UCBDSECT(R1),UCBNOTRD SET NOT-READY R41 Q3611000 MODESET EXTKEY=HASP RETURN TO NORMAL HASP KEY Q3612000 SPACE 1 R4 Q3613000 *********************************************************************** Q3614000 * * Q3615000 * RESET PCI FLAG (IF ANY) IN RESTART CCW * Q3616000 * * Q3617000 * RE-ISSUE $EXCP (VR) AND RE-CHECK COMPLETION * Q3618000 * * Q3619000 *********************************************************************** Q3620000 SPACE 1 R4 Q3621000 PUREXCP L R1,IOBSTART RESET PCI FLAG R4 Q3622000 MVI PPBFLAG1,X'00' CLEAR CSW SAVE @OZ29106 Q3622500 NI 4(R1),255-X'08' IN RESTART CCW R4 Q3623000 SPACE 1 R4 Q3624000 L R1,PCEDCT ADDRESS PRINTER/PUNCH DCT @OZ32566 Q3625000 $EXCP (R1),TYPE=VR RESTART I/O R4 Q3626000 B PPPWAIT GO WAIT FOR I/O COMPLETION R4 Q3627000 PURMSG DC CL29' HALTED/POSSIBLE DATA LOST ' @OZ35391 Q3627500 TITLE 'HASP PRINT/PUNCH SERVICE -- ERROR DETECTION AND CORRECTCQ3628000 ION' R4 Q3629000 *********************************************************************** Q3630000 * * Q3631000 * PPCHECK SUBROUTINE -- DETECT PRINT/PUNCH ERRORS AND RECOVER * Q3632000 * * Q3633000 * PL - RETURN ADDRESS * Q3634000 * * Q3635000 *********************************************************************** Q3636000 SPACE 2 R4 Q3637000 *********************************************************************** Q3638000 * * Q3639000 * ENTRY POINT FOR PCI WAITS * Q3640000 * * Q3641000 *********************************************************************** Q3642000 SPACE 1 R4 Q3643000 PCIWAIT DS 0H ENTRY FOR PCI WAITS R4 Q3644000 L R15,POUTIOB PICK UP OUTPUT IOB ADDRESSABILITY R4 Q3645000 TM PPFLAG,PPWSW TEST FOR WRITE IN PROGRESS R4 Q3646000 BZ PPCHECK BR IF NOT R4 Q3647000 TM BUFECBCC,X'7F' HAS I/O COMPLETED... R4 Q3648000 BNZ PPCHECK BR IF YES R4 Q3649000 OI PPFLAG2,PPCIWAIT INDICATE WAIT FOR PCI R4 Q3650000 L R14,PPBPCIE PICK UP ACTIVE PCIE ADDRESS R4 Q3651000 USING PCIDSECT,R14 ESTABLISH PCIE ADDRESSABILITY R4 Q3652000 TM PCISGNAL,PCIACTIV IS PCIE ON ACTIVE CHAIN... R4 Q3653000 BZ PPPWAIT WAIT IF NOT R4 Q3654000 TM PCISGNAL,PCIBUSY HAS PCIE EXECUTED... R4 Q3655000 BZ PPCHECK BR IF YES R4 Q3656000 DROP R14 SUSPEND PCIE ADDRESSABILITY R4 Q3657000 SPACE 1 R4 Q3658000 *********************************************************************** Q3659000 * * Q3660000 * $WAIT PRINT/PUNCH PROCESSOR FOR AN I/O POST * Q3661000 * * Q3662000 *********************************************************************** Q3663000 SPACE 1 R4 Q3664000 PPPWAIT DS 0H Q3665000 $WAIT IO WAIT FOR IO POST Q3666000 SPACE 1 R4 Q3667000 *********************************************************************** Q3668000 * * Q3669000 * MAIN PPCHECK ENTRY POINT * Q3670000 * * Q3671000 *********************************************************************** Q3672000 SPACE 1 R4 Q3673000 PPCHECK DS 0H Q3674000 LTR JCT,JCT IS THIS A SPOOL MESSAGE PRINTER Q3675000 BZR PL BRANCH IF YES Q3676000 TM PCEID,PCERJEID TEST PROCESSOR TYPE Q3677000 BO PCOMTEST BRANCH IF REMOTE Q3678000 TM PPFLAG,PPWSW TEST FOR WRITE INITIATED Q3679000 BO PCOMTEST BR IF YES @G38ESBB Q3679500 TM PPFLAG3,PP3800R 3800 REPOSITIONING... @G38ESBB Q3680000 BOR PL RETURN IF YES,NOTHING TO DO @G38ESBB Q3680400 B PPPCKPT BRANCH AROUND COMMANDS @G38ESBB Q3680700 EJECT R4 Q3681000 *********************************************************************** Q3682000 * * Q3683000 * FIRST -- CHECK FOR OPERATOR CONSOLE ACTION * Q3684000 * * Q3685000 *********************************************************************** Q3686000 SPACE 1 R4 Q3687000 PCOMTEST DS 0H Q3688000 L PW,PCEDCT GET ADDRESS OF PRT/PNCH DCT @OZ32566 Q3689000 USING DCTDSECT,PW ESTABLISH DCT ADDRESSABILITY Q3690000 TM PPFLAG3,PP3800R 3800 REPOSITIONING... @G38ESBB Q3690100 BZ PCOMTST1 NO, BRANCH @G38ESBB Q3690200 TM DCTFLAGS,DCTDELET+DCTRSTRT+DCTRPT+DCTBKSP CMD @G38ESBB Q3690300 BZ PPIOTST BR IF NOT RECURSIVE COMMAND @G38ESBB Q3690400 $MID 152 @G38ESBB Q3690500 PMSG PMESSAGE,M152L,(X'152F',DCTDEVN,C' COMMAND REJECTED') CQ3690600 MOVE MESSAGE TEXT @G38ESBB Q3690700 $WTO PMESSAGE,M152L,JOB=NO, INFORM OPERATOR @G38ESBBCQ3690900 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI+$ST @G38ESBB Q3691000 B PPIOTEST BR TO PROCESS PCIE @G38ESBB Q3691100 SPACE 1 @G38ESBB Q3691200 PCOMTST1 NI PDCTFLAG,FF-DCTSPACE RESET OP CARRIAGE CONTROL @G38ESBB Q3691300 OC PDCTFLAG,DCTFLAGS STACK OPERATOR FLAGS Q3692000 * Q3693000 * $C/$E/$I DEVICE R4 Q3694000 * Q3695000 TM DCTFLAGS,DCTDELET+DCTRSTRT NEW $C, $E, OR $I Q3696000 BZ POPCANJ BRANCH IF NO Q3697000 TM PPFLAG,PRDELSW PREVIOUS $C, $E, OR $I Q3698000 BZ PRDEL BR IF NO, SET TERM FLAG @G38ESBB Q3699000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q3699200 BNE PPABORT NO, GO TERMINATE @G38ESBB Q3699400 B PPIOTEST PROHIBIT DOUBLE COMMANDS @OZ46351 Q3699600 * THIS LINE DELETED BY APAR NUMBER @OZ46351 Q3699800 * THIS LINE DELETED BY APAR NUMBER @OZ46351 Q3700000 EJECT @G38ESBB Q3700500 * Q3701000 * $CJOB,PURGE (WHEN ISSUED ON ANOTHER SYSTEM) R4 Q3702000 * Q3703000 POPCANJ DS 0H Q3704000 L R1,PCEJQE ADDRESS OF JQE @OZ32566 Q3705000 LTR R1,R1 NO JOB IF TRAILING DATA... @G38ESBB Q3705200 BZ POPSPACE BR IF SO @G38ESBB Q3705400 USING JQEDSECT,R1 ACTIVATE JQE ADDRESSABILITY Q3706000 TM JQEFLAGS,QUEOPCAN+QUEPURGE $CJOB,PURGE ISSUED Q3707000 BNO POPSPACE BRANCH IF NO Q3708000 DROP R1 SUSPEND JQE ADDRESSABILITY Q3709000 OI PDCTFLAG,DCTDELET SET TERMINATION REASON Q3710000 B PRDEL GO COMPLETE TERMINATION Q3711000 * Q3712000 * $B/$F DEVICE,PAGES OR ,DSET R4 Q3713000 * Q3714000 POPSPACE DS 0H Q3715000 TM DCTFLAGS,DCTBKSP BSP/FSP Q3716000 BZ POPRPT BRANCH IF NO Q3717000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q3717200 BE PPDEL BR IF YES @G38ESBB Q3717400 NI PDCTFLAG,255-DCTBKSP RESET FS/BS FLAG Q3718000 TM PPFLAG,PPNEWS IGNORE $B/$F IF R41 Q3718200 BO POPRPT PRINTING JES2-NEWS R41 Q3718400 NI DCTPPFL,255-DCTEJECT RESET TOP-OF-PAGE FLAG R4 Q3719000 TM PCEID,PCERJEID+PCEPUSID RJE DEVICE OR PUNCH... @OZ29138 Q3719100 BNZ PPDEL BR IF YES @OZ29138 Q3719110 CLC DCTCSW,=F'0' DID INT. REQUIRED OCCUR @OZ29138 Q3719120 BE PPDEL BR IF NO, SET SUSPEND FLAG @OZ29138 Q3719130 ST PL,PMESSAGE SAVE LINKAGE REGISTER @OZ29138 Q3719140 L R15,=A(PPCNTPGE) GET PAGE COUNT ROUTINE ADDR @OZ29138 Q3719150 BALR PL,R15 GO AND COUNT PAGES @OZ29138 Q3719160 L PL,PMESSAGE RESTORE LINKAGE REGISTER @OZ29138 Q3719170 B PPDEL SET SUSPEND FLAG Q3720000 EJECT Q3721000 * Q3722000 * $N DEVICE Q3723000 * Q3724000 POPRPT DS 0H Q3725000 TM PDCTFLAG,DCTRPT TEST FOR $N Q3726000 BNO PPIOTEST BRANCH IF NO Q3727000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q3727030 BE PPDEL BR IF YES @G38ESBB Q3727060 TM PPFLAG,PRDELSW PREVIOUS $C, $E, $I @OZ29256 Q3727100 BO PPIOTST BRANCH IF YES @OZ29256 Q3727200 L R1,PWKJOE ADDRESS WORK-JOE Q3728000 USING JOEDSECT,R1 ACTIVATE JOE ADDRESSABILITY Q3729000 TM JOEFLAG,$JOESPIN IS THIS A SPIN JOE Q3730000 BNO PREPADD BRANCH IF NO Q3731000 $QSUSE REQ ACCESS TO CKPT DATA @OZ38851 Q3731500 IC R15,JOENCNT GET $N COUNT @OZ38851 Q3732000 LA R15,1(,R15) ADD ONE TO @OZ38851 Q3733000 STC R15,JOENCNT REPEAT COUNT @OZ38851 Q3734000 $#CKPT JOE=0(,R1),TYPE=A CKPT THE WORK-JOE @OZ38851 Q3734500 DROP R1 SUSPEND JOE ADDRESSABILITY @OZ38851 Q3735000 B PREPWTO GO TELL THE OPERATOR Q3736000 * Q3737000 * ADD A COPY OF THE WORK-JOE TO THE JOB OUTPUT TABLE Q3738000 * Q3739000 PREPADD DS 0H Q3740000 $#ADD WORK=PWKJOE,CHAR=PCHJOE COPY JOE BACK INTO QUEUE R4 Q3741000 BNZ PPIOTEST BRANCH IF $#ADD FAILED Q3742000 * Q3743000 * WRITE OPERATOR MESSAGE IF ADD SUCCESSFUL Q3744000 * Q3745000 PREPWTO DS 0H Q3746000 NI PDCTFLAG,255-DCTRPT RESET $N FLAG Q3747000 $MID 170 R4 Q3748000 MVC PMESSAGE(2),=X'170F' MESSAGE NUMBER Q3749000 MVC PMESSAGE+2(8),DCTDEVN DEVICE NAME Q3750000 MVC PMESSAGE+10(12),=CL12' REPEATED' OPERATOR MESSAGE Q3751000 $WTO PMESSAGE,22, INFORM THE OPERATOR CQ3752000 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST,JOB=NO Q3753000 B PPIOTEST CHECK THE IO STATUS Q3754000 SPACE 1 R4 Q3755000 *********************************************************************** Q3756000 * * Q3757000 * INDICATE PROCESSOR SUSPENSION AND/OR TERMINATION * Q3758000 * * Q3759000 *********************************************************************** Q3760000 SPACE 1 R4 Q3761000 PRDEL OI PPFLAG,PRDELSW TERMINATION - $C, $E, $I Q3762000 PPDEL OI PPFLAG,PPDELSW SUSPENSION - $B, $F Q3763000 NI PPFLAG2,255-PPCKPTA DON'T ALLOW CHECKPOINTS @OZ19494 Q3763100 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER... @G38ESBB Q3763200 BNE PPIOTEST BR IF NOT @G38ESBB Q3763400 L R1,PQHADR ADDRESS PQH @G38ESBB Q3763600 OI PQHFLAG-PQHDSECT(R1),PQHXFER SET XFER COMMAND @G38ESBB Q3763800 EJECT Q3764000 *********************************************************************** Q3765000 * * Q3766000 * CHECK FOR ACTIVE PCIE EXECUTION * Q3767000 * * Q3768000 *********************************************************************** Q3769000 SPACE 1 R4 Q3770000 USING PCIDSECT,R14 PROVIDE PCIE ADDRESSABILITY R4 Q3771000 PPIOTEST DS 0H R4 Q3772000 NI DCTFLAGS,255-DCTDELET-DCTRSTRT-DCTRPT-DCTBKSP RESET R4 Q3773000 PPIOTST DS 0H @OZ29256 Q3773100 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q3774000 BO PPZTEST BR IF REMOTE R4 Q3775000 SPACE 1 R4 Q3776000 L R15,POUTIOB PICK UP OUTPUT IOB ADDRESSABILITY R4 Q3777000 L R14,PPBPCIE PICK UP ACTIVE PCIE ADDRESS R4 Q3778000 SPACE 1 R4 Q3779000 PPCICHK DS 0H R4 Q3780000 CLI BUFECBCC,X'41' LAST ELEMENT IN ERROR... @OZ45731 Q3780100 BE PPZTEST DO NOT UPDATE CHECKPOINT @OZ45731 Q3780200 TM PCISGNAL,PCIBUSY HAS PCI ELEMENT EXECUTED... R4 Q3781000 BO PPZTEST BR IF STILL BUSY R4 Q3782000 CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q3782030 BE PPCIUPDT BR IF YES @G38ESBB Q3782060 XC DCTCSW(4),DCTCSW CLEAR INT. REQUIRED INDIC @OZ29138 Q3782100 SPACE 1 R4 Q3783000 *********************************************************************** Q3784000 * * Q3785000 * PCIE HAS BEEN EXECUTED -- UPDATE BUFFER AVAILABLE COUNT * Q3786000 * * Q3787000 *********************************************************************** Q3788000 SPACE 1 R4 Q3789000 PPCIUPDT DS 0H R4 Q3790000 CLC DCTCSW,$ZEROS TEST FOR INTV REQD @OZ54610 Q3790100 BNE PPCUPJOE BRANCH IF YES @OZ54610 Q3790200 NI PCISGNAL,255-PCIACTIV FLAG PCIE OFF ACTIVE CHAIN R4 Q3791000 TM PCISGNAL,PCIFNLBF TEST IF DATA BUFFER(S) FINISHED R4 Q3792000 BZ PPCUPJOE BR IF NOT R4 Q3793000 IC R1,PBFAVAIL INCREMENT NUMBER OF R4 Q3794000 LA R1,1(,R1) BUFFERS AVAILABLE FOR R4 Q3795000 STC R1,PBFAVAIL DE-SPOOLING (TO FORCE READ) R4 Q3796000 NI PCISGNAL,255-PCIFNLBF RESET FLAG R4 Q3797000 EJECT @G38ESBB Q3797050 ***************************************************************@G38ESBB Q3797100 * @G38ESBB Q3797150 * FOR 3800 PRINTER, CALL PQECOMP SUBROUTINE TO @G38ESBB Q3797200 * COMPLETE ANY PQE'S ASSIGNED DURING THIS CCW AREA @G38ESBB Q3797250 * @G38ESBB Q3797300 ***************************************************************@G38ESBB Q3797350 SPACE 1 @G38ESBB Q3797400 PPCUPJOE CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q3797450 BNE PPCKPTCH NO, BRANCH @G38ESBB Q3797500 SLR R0,R0 CLEAR REGISTER @G38ESBB Q3797550 IC R0,BFWPQECT-BFWDSECT+PCIESIZE(,R14) GET COUNT @G38ESBBCQ3797600 OF ID'S SOLICITED IN AREA @G38ESBB Q3797650 L PW,PQHADR ADDRESS PQH @G38ESBB Q3797700 ST PL,PQHSAVE1-PQHDSECT(,PW) SAVE RETURN ADDRESS @G38ESBB Q3797750 L R15,=A(PQECOMP) CALL SUBROUTINE TO COMPLETE @G38ESBB Q3797800 BALR PL,R15 PQE'S ASSIGNED IN CCW AREA @G38ESBB Q3797850 L R15,POUTIOB RESTORE IOB ADDRESS @G38ESBB Q3797900 L R14,PPBPCIE RESTORE PCIE ADDRESS @G38ESBB Q3797920 L PL,PQHSAVE1-PQHDSECT(,PW) RESTORE RETURN ADR @G38ESBB Q3797940 L PW,PCEDCT RESTORE DCT ADDRESS @G38ESBB Q3797960 SPACE 1 R4 Q3798000 *********************************************************************** Q3799000 * * Q3800000 * SHOW CHECKPOINT NEEDED * Q3801000 * * Q3802000 *********************************************************************** Q3803000 SPACE 1 R4 Q3804000 PPCKPTCH DS 0H CHECK IF CKPT NEEDED @G38ESBB Q3805000 TM PPFLAG2,PPCKPTA ARE CHECKPOINTS ALLOWED R4 Q3806000 BZ PPCNCKPT BR IF NO R4 Q3807000 TM PCISGNAL,PCICKPT IS NEW CKPT DATA PRESENT... R4 Q3808000 BZ PPCNCKPT BR IF NO R4 Q3809000 NI PCISGNAL,255-PCICKPT RESET NEW CKPT FLAG R4 Q3810000 LA R1,PCIESIZE(,R14) POINT TO CHECKPOINT DATA R4 Q3811000 ST R1,PPCKPTR SAVE FOR PPPCKPT R4 Q3812000 OI PPFLAG2,PPCKPT INDICATE CKPT-DATA NEEDS UPDATE R4 Q3813000 EJECT R4 Q3814000 *********************************************************************** Q3815000 * * Q3816000 * IF PCIE NOT LAST ON CHAIN -- UPDATE CCW-AREAS INFORMATION * Q3817000 * * Q3818000 *********************************************************************** Q3819000 SPACE 2 R4 Q3820000 PPCNCKPT TM PCEID,PCERJEID+PCEPRSID TEST PROCESSOR TYPE @OZ30757 Q3821000 BNZ PPCHKCC BR IF NOT LOCAL PUNCH @OZ30757 Q3822000 L R1,PPBCCWNX PRESET @OZ30757 Q3823000 SH R1,=H'8' PUNCH @OZ30757 Q3824000 ST R1,PUERRPT ERROR POINTER @OZ30757 Q3825000 MVC PULMTTR(7),PPBCMTTR AND MTTR @OZ30757 Q3826000 SPACE 1 @OZ30757 Q3826500 PPCHKCC TM PCI1FLGS,X'40' CHECK NEXT CCW AREA READY @OZ30757 Q3827000 BZ PPZTEST BR IF COMMAND-CHAIN NOT ON @OZ30757 Q3828000 L R1,PPBCCWNX UPDATE IOBSTART TO REFLECT @OZ30757 Q3829000 ST R1,IOBSTART EXECUTION IN NEXT AREA @OZ30757 Q3830000 AH R1,PCCWLAST COMPUTE NEW PCIE ADDR AND @OZ30757 Q3831000 ST R1,PPBPCIE UPDATE PPBPCIE TO SHOW IT @OZ30757 Q3832000 L R1,PPBLVCCN UPDATE PTR TO LAST VALID @OZ30757 Q3833000 ST R1,PPBLVCCC CHAN CMND IN CURRENT AREA @OZ30757 Q3834000 MVC PPBCMTTR(7),PPBNMTTR UPDATE RESTART POINTER @OZ30757 Q3835000 EJECT R4 Q3836000 *********************************************************************** Q3837000 * * Q3838000 * IF $Z DEVICE -- $WAIT FOR OPERATOR ACTION * Q3839000 * * Q3840000 * CHECK FOR LOCAL PRINT/PUNCH I/O COMPLETION * Q3841000 * * Q3842000 *********************************************************************** Q3843000 SPACE 1 R4 Q3844000 PPZTEST TM DCTFLAGS,DCTSTOP TEST FOR OPERATOR $Z R4 Q3845000 BO PPPWAIT BRANCH IF YES Q3846000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q3847000 BO PPWINIT BR IF REMOTE R4 Q3848000 SPACE 1 R4 Q3849000 TM BUFECBCC,X'7F' TEST I/O COMPLETION CODE Q3850000 BZ PCITEST BRANCH IF NOT CHANNEL END R4 Q3851000 BO PPCGOOD BRANCH IF NO ERRORS R4 Q3852000 SPACE 1 R4 Q3853000 *********************************************************************** Q3854000 * * Q3855000 * ERROR DETECTED -- START ANALYSIS * Q3856000 * * Q3857000 *********************************************************************** Q3858000 SPACE 1 R4 Q3859000 L R1,PRPUUCB ADDRESS DEVICE UCB Q3860000 TM UCBFLB-UCBDSECT(R1),UCBIORST TEST UCB DEVICE STATUS Q3861000 BZ PDEVOK BRANCH IF M/P HAS NOT ABORTED Q3862000 CLC $RELSE,=C'02' TEST OS/VS2 RELEASE NUMBER @OZ35278 Q3863000 BE PPIODRN BR IF RELEASE 2 R4 Q3864000 L R1,CVTPTR GET ADDRESS OF CVT R4 Q3865000 CLC CVTCRCA-CVT(,R1),=XL4'0' TEST RECOVERY MODE R4 Q3866000 BNE PDEVOK BR IF DEVICE STILL ACCESSIBLE R4 Q3867000 PPIODRN DS 0H R4 Q3868000 L R15,=A(PDEVABRT) CALL ABORT ROUTINE TO @OZ51930 Q3869000 BALR PL,R15 CLEAN UP CONTROL BLKS @OZ51930 Q3870000 B PPABORT SUSPEND USE OF THE DEVICE Q3871000 SPACE 1 R4 Q3872000 PDEVOK DS 0H Q3873000 $COUNT ********************************* R4 Q3874000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @OZ51011 Q3875000 BNE PDEVOKA BRANCH IF NOT @OZ51011 Q3876000 TM DCTPPSW2,DCTCKJAM PAPER JAM OR CANCEL KEY... @OZ51011 Q3876100 BZ PDEVOKA BRANCH IF NOT @OZ51011 Q3876200 NI PPFLAG,FF-PRDELSW RESET TERMINATION SWITCH @OZ51011 Q3876300 OI PPFLAG,PPDELSW SET SUSPENSION SWITCH @OZ51011 Q3876400 B P3800LOC LOCATE ORIGIN PQE @OZ51011 Q3876500 EJECT @OZ51011 Q3876600 PDEVOKA DS 0H @OZ51011 Q3877000 TM PPFLAG,PPDELSW TEST FOR OPERATOR ACTION @OZ51011 Q3878000 BZ SKIP330 BRANCH IF NONE @OZ51011 Q3879000 TM PCEID,PCEPUSID TEST FOR PUNCH DEVICE @OZ51011 Q3880000 BZ PPWINIT BRANCH IF NOT @OZ51011 Q3881000 TM PPFLAG,PRDELSW TEST FOR TERMINATION @OZ51011 Q3881200 BO PPWINIT BRANCH IF YES @OZ51011 Q3881400 SPACE 1 R4 Q3882000 DROP PW SUSPEND DCT ADDRESSABILITY Q3883000 EJECT R4 Q3884000 *********************************************************************** Q3885000 * * Q3886000 * FOR PRINTERS - IF INVALID CSW -- RETRY USING IOBSTART * Q3887000 * IF VALID CSW -- RESTART AT CCW AFTER ERROR * Q3888000 * IF IN PCIE -- SIMULATE PCI INTERRUPTION * Q3889000 * * Q3890000 *********************************************************************** Q3891000 SKIP330 DS 0H @OZ40165 Q3891200 TM IOBCSW+4,X'3F' CHANNEL ERRORS ? .... @OZ40165 Q3891300 BZ SKIP331 ..NO CONTINUE @OZ40165 Q3891500 L PW,IOBSTART GET VALID RESTART ADDR @OZ40165 Q3891800 LA PW,0(,PW) CLEAR HIGH-ORDER BYTE @OZ40165 Q3892000 TM PCEID,PCEPUSID TEST PROCESSOR TYPE @OZ40165 Q3892200 BO PUNCHERR BR IF PUNCH @OZ40165 Q3892500 B PPRTHALT BR IF PRINTER @OZ40165 Q3892800 SKIP331 DS 0H @OZ40165 Q3892900 L PW,IOBCSW-1 GET COMMAND ADDR FROM CSW @OZ40165 Q3893000 LA PW,0(,PW) CLEAR HIGH-ORDER BYTE Q3894000 CLM PW,7,IOBSTART+1 IS CSW VALID... @OZ53086 Q3894100 BNL PPDEVTYP YES, GO TEST FOR PUNCH @OZ53086 Q3894200 ICM PW,7,IOBSTART+1 ELSE USE IOBSTART @OZ53086 Q3894300 PPDEVTYP DS 0H @OZ53086 Q3894400 TM PCEID,PCEPUSID TEST PROCESSOR TYPE R4 Q3895000 BO PUNCHERR BR IF PUNCH R4 Q3896000 SPACE 1 R4 Q3897000 CLC IOBCSW(3),IOBSTART+1 COMPARE CSW WITH FIRST CCW R4 Q3898000 BNH PPIOMSG BR IF ZERO OR INVALID. @OZ44279 Q3899000 CL PW,PPBLVCCC COMP RESTART CCW WITH END OF AREA R4 Q3900000 BH PCHKPCIE BRANCH IF CSW BELOW AREA @G38ESBB Q3901000 SPACE 1 @G38ESBB Q3901100 CLI 0(PW),PTICCMD RESTART ON TIC... @G38ESBB Q3901200 BNE PRESTRT NO, GO RESTART CHANNEL PGM @G38ESBB Q3901300 L PW,0(,PW) ALTER RESTART CSW @G38ESBB Q3901400 N PW,PCVTREAL TO POINT TO CCW @G38ESBB Q3901500 AL PW,POUTIOB POINTED TO BY TIC @G38ESBB Q3901600 B PRESTRT GO RESTART CHANNEL PROGRAM @G38ESBB Q3901700 SPACE 1 R4 Q3902000 PCHKPCIE L R14,PPBPCIE ADDRESS THE PCIE @G38ESBB Q3903000 LA R1,PCIESIZE(,R14) IF RESTART CCW IS R4 Q3904000 CLR PW,R1 OUT OF ACTIVE AREA, R4 Q3905000 BNL PPIOMSG RESTART AT IOBSTART. @OZ44279 Q3906000 XC IOBCSW(3),IOBCSW CLEAR CSW TO FORCE RETRY @OZ45731 Q3906100 SPACE 1 R4 Q3907000 PCISIMUL DS 0H @OZ44279 Q3908000 TM PCEID,PCEPRSID IS THIS A PRINTER... @OZ44279 Q3908100 BZ SKIP332 BRANCH IF NOT. @OZ44279 Q3908200 S PW,=F'8' BACK UP RESTART ADDRESS. @OZ44279 Q3908300 MVI 0(PW),NOP NOP LAST COMMAND. @OZ44279 Q3908400 B PRESTRT BRANCH TO HALT PRINTER. @OZ44279 Q3908500 SKIP332 DS 0H @OZ44279 Q3908600 L PW,PCEDCT RESTORE DCT POINTER. @OZ44279 Q3908700 NI PCISGNAL,255-PCIBUSY SIMULATE PCI INTERRUPTION R4 Q3909000 * THIS LINE DELETED BY APAR OZ45731 @OZ45731 Q3910000 TM PCI1FLGS,X'40' SEE IF NEXT CCW AREA IS READY R4 Q3911000 BO PPCIUPDT BR IF YES -- RECYCLE R4 Q3912000 B PPWINIT ELSE GO TO CLEAN UP R4 Q3913000 SPACE 1 @OZ44279 Q3913100 PPIOMSG DS 0H @OZ44279 Q3913200 L PW,IOBSTART SET REGISTER FOR RESTART. @OZ44279 Q3913300 B PRESTRT BR TO HALT PRINTER @OZ44279 Q3913400 NOP EQU 3 @OZ44279 Q3913420 EJECT R4 Q3914000 *********************************************************************** Q3915000 * * Q3916000 * NORMAL I/O COMPLETION * Q3917000 * * Q3918000 * IF CHE NOT ON EXPECTED PCIE -- HANDLE LOST INTERRUPTS * Q3919000 * * Q3920000 *********************************************************************** Q3921000 SPACE 1 R4 Q3922000 PPCGOOD DS 0H R4 Q3923000 CL R14,PPBPCIE TEST FOR PCIE SWAP R4 Q3924000 BE PPWINIT BR IF ALL I/O COMPLETE R4 Q3925000 L R14,PPBPCIE ELSE, ADDRESS NEW PCIE R4 Q3926000 TM PCISGNAL,PCIBUSY HAS THIS NEW PCIE EXECUTED... R4 Q3927000 BO PUREXCP RESTART AT IOBSTART IF NOT R4 Q3928000 B PPCIUPDT ELSE, PROCESS NEW PCIE R4 Q3929000 SPACE 1 R4 Q3930000 DROP R14 SUSPEND PCIE ADDRESSABILITY R4 Q3931000 SPACE 2 R4 Q3932000 ***************************************************************@G38ESBB Q3932050 * @G38ESBB Q3932100 * FOR 3800 PRINTERS, SEE IF INTERVENTION REQUIRED @G38ESBB Q3932150 * DETERMINE COMMAND PROCESSING OR RESTART I/O IF NOT @G38ESBB Q3932200 * @G38ESBB Q3932250 ***************************************************************@G38ESBB Q3932300 SPACE 1 @G38ESBB Q3932350 PPWINIT CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q3932400 BNE PPWINIT2 BR IF NOT @G38ESBB Q3932450 TM PPFLAG3,PP3800R COMMAND IN PROGRESS... @G38ESBB Q3932500 BO PTSTRST YES, BYPASS LOCATE @OZ46290 Q3932550 L R15,PQHADR ADDRESS PQH @G38ESBB Q3932600 TM PQHFLAG-PQHDSECT(R15),PQHXFER XFER COMMAND... @G38ESBB Q3932650 BZ PTSTRST BR IF NOT @G38ESBB Q3932700 SPACE 1 @G38ESBB Q3932750 P3800LOC L R15,PQHADR ADDRESS PQH @G38ESBB Q3932800 NI PQHFLAG-PQHDSECT(R15),FF-PQHXFER RESET CMD FLAG @G38ESBB Q3932850 ST PL,PQHSAVE1-PQHDSECT(,R15) SAVE RETURN ADDRESS @G38ESBB Q3932900 L R15,=A(PLOCATE) FIND PAGE ID AND PQE ON @G38ESBB Q3932950 BALR PL,R15 3800 PAPER LINE @G38ESBB Q3933000 L PL,PQHADR ADDRESS PQH @G38ESBB Q3933050 L PL,PQHSAVE1-PQHDSECT(,PL) RESTORE RETURN ADR @G38ESBB Q3933100 TM PPFLAG3,PP3800R IS THE COMMAND PROCESSABLE @G38ESBB Q3933150 BZ PTSTRST BR IF NOT @G38ESBB Q3933200 NI PPFLAG,FF-PPWSW INDICATE WRITE COMPLETED @G38ESBB Q3933250 B PPDSEND GO PROCESS COMMAND @G38ESBB Q3933300 SPACE 1 @G38ESBB Q3933350 PTSTRST L PW,PQHADR ADDRESS PQH @G38ESBB Q3933400 TM PQHFLAG-PQHDSECT(PW),PQH2CMD DOUBLE COMMAND... @G38ESBB Q3933450 BO PPABORT YES, GO ABORT JOB @G38ESBB Q3933500 L R15,POUTIOB RESTORE OUTPUT BUFFER ADDR @G38ESBB Q3933550 L PW,PCEDCT RESTORE DCT @G38ESBB Q3933600 USING DCTDSECT,PW ADDRESSABILITY @G38ESBB Q3933650 CLC DCTCSW,$ZEROS INTERVENTION REQUIRED... @G38ESBB Q3933700 BE PPWCKIO BRANCH IF NOT @OZ48114 Q3933750 L R14,PPBPCIE ELSE SETUP TO RESTART I/O @G38ESBB Q3933800 USING PCIDSECT,R14 PCI ADDRESSABILITY @G38ESBB Q3933850 OI PCISGNAL,PCIBUSY+PCIACTIV IND AREA BUSY/ACTIVE @G38ESBB Q3933900 L R1,PQHADR GET PQH ADDRESS @G38ESBB Q3933950 OC PCI1FLGS,PQHPCICH-PQHDSECT(R1) RESET CHAINING @G38ESBB Q3934000 NI PCISGNAL,FF-PCIABORT RESET ABORT FLAG @OZ46290 Q3934050 L R1,DCTCSW GET RESTART CSW @G38ESBB Q3934100 LA R1,0(,R1) CLEAR HIGH ORDER BYTE @G38ESBB Q3934150 SH R1,PCCWLENG BACK UP TO PREVIOUS CCW @G38ESBB Q3934200 CLI 0(R1),PTICCMD IS RESTART CCW A TIC... @G38ESBB Q3934250 BNE PZEROCSW NO, GO RESTART FROM DCTCSW @G38ESBB Q3934300 SH R1,PCCWLENG BACKUP BEFORE TIC CCW @G38ESBB Q3934350 SPACE 1 @G38ESBB Q3934400 PZEROCSW ST R1,IOBSTART SET UP RESTART ADDRESS @G38ESBB Q3934450 XC DCTCSW,DCTCSW ZERO INT REQ INDICATOR @G38ESBB Q3934500 B PURETRY GO RESTART I/O @G38ESBB Q3934600 DROP PW DROP DCT ADDRESSABILITY @G38ESBB Q3934700 SPACE 1 @G38ESBB Q3934800 PPWCKIO TM BUFECBCC,X'7F' IS ERROR RCVY REQD... @OZ48114 Q3934825 BM SKIP330 BRANCH IF YES @OZ48114 Q3934850 SPACE 1 @OZ48114 Q3934875 PPWINIT2 NI PPFLAG,FF-PPWSW INDICATE WRITE COMPLETED @G38ESBB Q3934900 B PPPCKPT GO TO CHECKPOINT ROUTINE R4 Q3935000 SPACE 1 R4 Q3936000 PCITEST CLI PDEVTYP3,UCB3800 TEST FOR 3800 @G38ESBB Q3937000 BNE PCITEST1 BR IF NOT @G38ESBB Q3937200 TM PPFLAG,PPDELSW TEST FOR COMMAND @G38ESBB Q3937400 BZ PCITEST1 BR IF NOT @G38ESBB Q3937600 NI PPFLAG2,FF-PPCIWAIT INDIC WAIT FOR CE @G38ESBB Q3937800 SPACE 1 @G38ESBB Q3938000 PCITEST1 TM PPFLAG2,PPCIWAIT PCI-WAIT INDICATION @G38ESBB Q3938500 BZ PPPWAIT BR IF NO R4 Q3939000 SPACE 1 @G38ESBB Q3940000 * DELETED @G38ESBB Q3941000 * DELETED @G38ESBB Q3942000 TITLE 'HASP PRINT/PUNCH SERVICE -- PROCESSOR CHECKPOINT' R4 Q3943000 *********************************************************************** Q3944000 * * Q3945000 * FOR IMPACT PRINTER, PERFORM CHECKPOINT @G38ESBB Q3946000 * * Q3947000 *********************************************************************** Q3948000 SPACE 1 R4 Q3949000 PPPCKPT NI PPFLAG2,255-PPCIWAIT RESET PCI-WAIT INDICATION R4 Q3950000 TM PPFLAG2,PPCKPT CKPT DATA NEED UPDATING... R41 Q3951000 BZR PL RETURN IF NOT R41 Q3952000 NI PPFLAG2,255-PPCKPT RESET CKPT-NEEDED FLAG R4 Q3953000 SPACE 1 R41 Q3953500 PPPCKPT1 TM PPFLAG2,PPCKPTA CHECKPOINTS ALLOWED... R41 Q3954000 BZR PL RETURN IF NOT R41 Q3954500 SPACE 1 @G38ESBB Q3955000 LR R1,PL SAVE RETURN REGISTER @G38ESBB Q3956000 L R15,=A(PGETQS) CALL CKPT @G38ESBB Q3957000 BALR PL,R15 ACCESS ROUTINE @G38ESBB Q3958000 LR PL,R1 RESTORE RETURN REGISTER @G38ESBB Q3959000 BNZR PL Q'S NOT OWNED, RETURN @G38ESBB Q3960000 SPACE 1 @G38ESBB Q3961000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q3962000 * DELETED @G38ESBB Q3963000 * DELETED @G38ESBB Q3964000 * DELETED @G38ESBB Q3965000 * DELETED @G38ESBB Q3966000 * DELETED @G38ESBB Q3967000 * DELETED @G38ESBB Q3968000 * DELETED @G38ESBB Q3969000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q3970000 SPACE 1 @G38ESBB Q3971000 L R1,PCKJOE ADDRESS OF CKPT-JOE R4 Q3972000 USING JOEDSECT,R1 ACTIVATE JOE ADDRESSABILITY R4 Q3973000 L PW,PPCKPTR PICK-UP CKPT DATA POINTER R4 Q3974000 MVC JOECKPP,0(PW) AND UPDATE CKPT-JOE @OZ27300 Q3975000 DROP R1 SUSPEND JOE ADDRESSABILITY R4 Q3976000 $#CKPT JOE=0(,R1),TYPE=A SCHEDULE CKPT-JOE FOR CHECKPOINT R4 Q3977000 BR PL AND RETURN R4 Q3978000 SPACE 1 @G38ESBB Q3978200 DROP R15 DROP BUF ADR @G38ESBB Q3978400 USING BUFDSECT,PBUF RE-ESTABLISH BUF ADR @G38ESBB Q3978600 TITLE 'HASP PRINT/PUNCH SERVICE -- TRACK-CELL READ ROUTINES' Q3979000 *********************************************************************** Q3980000 * * Q3981000 * PRDTCNXT - READ NEXT TRACK-CELL OR IOT * Q3982000 * * Q3983000 *********************************************************************** Q3984000 SPACE 1 R4 Q3985000 PRDTCNXT DS 0H R4 Q3986000 TM PPFLAG2,PPTCEL TEST DESPOOLING METHOD R4 Q3987000 BZ PRDNXTB BRANCH IF SINGLE R4 Q3988000 ICM R15,15,PCENXTRK TEST FOR ZERO CHAIN R4 Q3989000 BZ SKIP340 BRANCH IF LAST BLOCK READ R4 Q3990000 TM PPFLAG,PPDELSW+PPRDERR TEST FOR SUSPEND OR READ ERROR R4 Q3991000 BZ PRDTCEL BRANCH IF NO R4 Q3992000 SKIP340 TM PPFLAG,PPNEWS RETURN IF END OF @OZ25573 Q3993000 BOR PL JES2-NEWS DATA SET @OZ25573 Q3993250 L R15,PCEIOTTR GET IOT MTTR @OZ25573 Q3993500 B PRDBUF GO TO SINGLE BUFFER READ ROUTINE R4 Q3994000 SPACE 2 R4 Q3995000 *********************************************************************** Q3996000 * * Q3997000 * PRDTCEL - READ ENTIRE TRACK-CELL * Q3998000 * * Q3999000 *********************************************************************** Q4000000 SPACE 1 R4 Q4001000 PRDTCEL DS 0H R4 Q4002000 TM PPFLAG2,PPTCEL TEST DESPOOLING METHOD R4 Q4003000 BZ PRDBUF BRANCH IF SINGLE R4 Q4004000 ST PL,PLSAVE SAVE RETURN REGISTER R4 Q4005000 STM PW,PBUF,PCEWA SAVE WORKING REGISTERS R4 Q4006000 L PBUF,PINIOB ACTIVATE INPUT IOB ADDRESSABILITY R4 Q4007000 ST R15,PCESEEK SAVE BUFFER MTTR R4 Q4008000 STCM R15,8,IOBXTENT SET IOB EXTENT FIELD TO (M) R4 Q4009000 SLR PL,PL EXPAND $RECINCR R4 Q4010000 IC PL,$RECINCR TO A FULLWORD R4 Q4011000 SLR R0,R0 COMPUTE R4 Q4012000 SLR R1,R1 SUB- R4 Q4013000 IC R1,PCESEEK+3 PERMUTATION R4 Q4014000 DR R0,PL NUMBER R0 = 000P R4 Q4015000 LTR R0,R0 OF R4 Q4016000 BNZ SKIP350 INITIAL R4 Q4017000 IC R0,$RECINCR BUFFER R4 Q4018000 SKIP350 STC R0,PCESEEK REPLACE MTTR WITH PTTR R4 Q4019000 LR R0,R15 R0 = MTTR . MTTR R4 Q4020000 SRL R15,24 COMPUTE ADDRESS . 000M R4 Q4021000 MH R15,=AL2(TEDSIZ) OF TED FOR THIS . M * TEDSIZ R4 Q4022000 AL R15,$TEDADDR EXTENT . TED ENTRY R4 Q4023000 USING TEDDSECT,R15 ACTIVATE TED ADDRESSABILITY R4 Q4024000 SPACE 1 R4 Q4025000 SLR PW,PW CLEAR TRACK-CELL BUFFER COUNT R4 Q4026000 IC PW,PBUFSKIP PICK UP RESTART POINT (IF ANY) R4 Q4027000 SPACE 1 R4 Q4028000 L R14,PBUFSAVE GET INPUT BUFFER-HEAD R4 Q4029000 L R1,PINMTTRT GET ADDR OF MTTR/BFR-ADDR TBL R4 Q4030000 EJECT R4 Q4031000 * R4 Q4032000 * BUILD TABLE OF MTTR'S AND CORRESPONDING BUFFER ADDRS R4 Q4033000 * R4 Q4034000 PRDINSRT ST R0,0(,R1) PLACE MTTR AND BUFFER- R4 Q4035000 ST R14,4(,R1) ADDRESS INTO THIS ENTRY R4 Q4036000 MVI BUFECBCC-BUFDSECT(R14),0 RESET ANY ERROR CONDITIONS R4 Q4037000 LA PW,1(,PW) INCREMENT BUFFER COUNT R4 Q4038000 CLM PW,1,$TCELSIZ TEST FOR END OF TRACK-CELL R4 Q4039000 BNL PRDTSORT BR IF YES -- TABLE BUILT R4 Q4040000 ALR R0,PL R0 = MTTR + $RECINCR R4 Q4041000 PRECHECK CLM R0,1,TNRT+1 TEST RECORD NUMBER R4 Q4042000 BNH PRDINCR BRANCH IF STILL ON TRACK R4 Q4043000 CLC PCESEEK(1),$RECINCR IF RECORD WAS LAST ON TRACK, R4 Q4044000 BNL PRDTSORT THEN HANDLE -STUNTED- TRACK-CELL R4 Q4045000 IC R0,PCESEEK GET BEGINNING RECORD NUMBER, R4 Q4046000 AL R0,=F'1' UP IT BY 1, AND SAVE NEW R4 Q4047000 STC R0,PCESEEK BEGINNING RECORD NUMBER R4 Q4048000 B PRECHECK RE-CHECK NEW MTTR R4 Q4049000 PRDINCR LA R1,2*4(,R1) INCR TO NEXT TABLE EnTRY, AND R4 Q4050000 L R14,BUFCHAIN-BUFDSECT(,R14) STEP TO NEXT BUFFER R4 Q4051000 B PRDINSRT LOOP UNTIL TABLE BUILT R4 Q4052000 DROP R15 SUSPEND TED ADDRESSABILITY R4 Q4053000 * R4 Q4054000 * MTTR/BUFAD TABLE COMPLETE -- SORT IT R4 Q4055000 * R4 Q4056000 PRDTSORT DS 0H R4 Q4057000 L R14,PBUFSAVE ADDRESS OF FIRST BUFFER IN CHAIN R4 Q4058000 SLR R15,R15 OBTAIN RESTART R4 Q4059000 IC R15,PBUFSKIP BUFFER OFFSET R4 Q4060000 SLR PW,R15 COMPUTE ACTUAL NUMBER OF BUFFERS R4 Q4061000 STC R15,BUFCHOFF-BUFDSECT(,R14) SAVE OFFSET OF 1ST BUFFER R4 Q4062000 STH PW,BUFCHNCT-BUFDSECT(,R14) INSERT BUFFER CHAIN COUNT R4 Q4063000 MVI PBUFSKIP,0 RESET RESTART BUFFER OFFSET R4 Q4064000 LR R15,PW DECREMENT BUFFER R4 Q4065000 BCT R15,SKIP360 COUNT BY 1 AND SKIP R4 Q4066000 B PRDBCCWS THE SORT IF ONLY 1 R4 Q4067000 SPACE 1 R4 Q4068000 SKIP360 L R1,PINMTTRT ADDRESS OF MTTR/BUFAD TABLE R4 Q4069000 LA R14,8 SET BXLE INCREMENT VALUE R4 Q4070000 SLL R15,3 SET BXLE LIMIT VALUE R4 Q4071000 ALR R15,R1 = R1 + 8*(COUNT-1). (LAST ENTRY) R4 Q4072000 SPACE 1 R4 Q4073000 PRLOOP1 CLR R1,R15 IF END OF TABLE, R4 Q4074000 BE PRDBCCWS BYPASS LAST COMPARE R4 Q4075000 PRLOOP1R LA PL,8(,R1) SET/RESET COMPARE POINTER R4 Q4076000 PRLOOP2 CLC 3(1,R1),3(PL) TEST CURRENT REC NBR WITH NEXT R4 Q4077000 BH PRSWAP BR IF HIGH R4 Q4078000 BXLE PL,R14,PRLOOP2 INCR AND LOOP FOR COMPARE R4 Q4079000 BXLE R1,R14,PRLOOP1 INCR AND LOOP FOR ENTIRE TABLE R4 Q4080000 SPACE 1 R4 Q4081000 PRSWAP XC 0(8,R1),0(PL) SWAP POSITIONS OF MTTRS R4 Q4082000 XC 0(8,PL),0(R1) AND BUFFER ADDRESSES WHICH R4 Q4083000 XC 0(8,R1),0(PL) WERE OUT OF ORDER R4 Q4084000 B PRLOOP1R RESTART CURRENT COMPARE R4 Q4085000 EJECT R4 Q4086000 * R4 Q4087000 * BUILD SET-SECTOR CCW AT IOBCCW1 (IF SUPPORTED) R4 Q4088000 * R4 Q4089000 * BUILD INPUT CCW'S STARTING AT IOBCCW2 R4 Q4090000 * R4 Q4091000 PRDBCCWS DS 0H R4 Q4092000 SLR R15,R15 OBTAIN R4 Q4093000 IC R15,0(,R1) POINTER R4 Q4094000 MH R15,=AL2(TEDSIZ) TO R4 Q4095000 AL R15,$TEDADDR TRACK-EXTENT-DATA R4 Q4096000 USING TEDDSECT,R15 ACTIVATE TED ADDRESSABILITY R4 Q4097000 MVC PCEWC,TNTC SAVE NUMBER OF TRACKS/CYLINDER R4 Q4098000 SPACE 1 R4 Q4099000 PRDSECTR DS 0H R4 Q4100000 L R1,PINMTTRT POINT TO MTTR/BUFAD TABLE R4 Q4101000 TM $RUNOPTS,$RPS TEST FOR RPS IN SYSTEM R4 Q4102000 BZ PRDBUILD BR IF NOT R4 Q4103000 L PL,TRPS GET ADDRESS OF RPS TABLE R4 Q4104000 MVI IOBCCW1,X'03' SET FIRST CHANNEL COMMAND TO NOP R4 Q4105000 LTR PL,PL TEST IF EXTENT SUPPORTS RPS R4 Q4106000 BZ PRDBUILD BR IF NO -- SKIP RPS COMPUTATION R4 Q4107000 MVI IOBCCW1,X'23' SET CHANNEL COMMAND TO SET SECTOR R4 Q4108000 SLR R14,R14 CLEAR REGISTER FOR IC R4 Q4109000 IC R14,3(,R1) GET RECORD NUMBER R4 Q4110000 IC R14,0(R14,PL) GET CORRESPONDING SECTOR NUMBER R4 Q4111000 STC R14,IOBCCW1+5 PUT SECTOR NUMBER IN SET-SECTOR R4 Q4112000 DROP R15 SUSPEND TED ADDRESSABILITY R4 Q4113000 SPACE 1 R4 Q4114000 PRDBUILD DS 0H R4 Q4115000 LA PL,IOBCCW2 POINT TO CCW-BUILD AREA R4 Q4116000 MVI IOBCCW4,6 SET OP-CODE TO READ-DATA R41 Q4116500 OI IOBCCW4+4,X'40' SET COMMAND-CHAIN BIT IN SKELETON R4 Q4117000 B SKIP370 FIRST SET OF CCWS ARE BUILT R4 Q4118000 SPACE 1 R4 Q4119000 PRDSKEL LA PL,3*8(,PL) POINT TO NEXT CCW-BUILD AREA R4 Q4120000 MVC 0(3*8,PL),IOBCCW2 SRCH/TIC/READ CCW SKELETON R4 Q4121000 SKIP370 L R14,4(,R1) ADDRESS OF DATA R4 Q4122000 LA R14,BUFSTART-BUFDSECT(,R14) PORTION OF BUFFER R4 Q4123000 LA R0,3(,R1) POINT TO CCHHR R4 Q4124000 STCM R0,7,0*8+1(PL) SRCH TARGET (CCHHR) R4 Q4125000 STCM PL,7,1*8+1(PL) TIC TARGET (SRCH CCW) R4 Q4126000 STCM R14,7,2*8+1(PL) READ TARGET (BUF ADDR) R4 Q4127000 SPACE 1 R4 Q4128000 L R14,0(,R1) R14 = MTTR R4 Q4129000 LA R14,0(,R14) R14 = 0TTR R4 Q4130000 SPACE 1 R4 Q4131000 * MBBCCHHR FROM MTTR CONVERSION R4 Q4132000 STC R14,7(,R1) -------R R4 Q4133000 SRDL R14,40 ISOLATE TT IN R14/R15 R4 Q4134000 D R14,PCEWC COMPUTE CYLINDER AND HEAD R4 Q4135000 STCM R14,3,5(R1) -----HHR HEAD R4 Q4136000 STCM R15,3,3(R1) ---CCHHR CYLINDER R4 Q4137000 XC 0(3,R1),0(R1) 000CCHHR MBB R4 Q4138000 LA R1,8(,R1) POINT TO NEXT ENTRY R4 Q4139000 BCT PW,PRDSKEL LOOP FOR ENTIRE TABLE R4 Q4140000 EJECT R4 Q4141000 * R4 Q4142000 * ISSUE EXCP FOR THIS TRACK-CELL R4 Q4143000 * R4 Q4144000 NI 2*8+4(PL),255-X'40' ZERO COMMAND-CHAIN IN LAST CCW R4 Q4145000 ST PBUF,PCEBUFAD IOB ADDRESS TO DA DCT R4 Q4146000 LA R0,IOBCCW1 RESET IOBSTART R4 Q4147000 ST R0,IOBSTART FOR READ R4 Q4148000 L R1,PINMTTRT SET IOBSEEK TO 1ST BUFFER'S R4 Q4149000 MVC IOBSEEK(7),1(R1) TRACK ADDRESS R4 Q4150000 MVC PCESEEK,$HASPDCB SET UP DA DCT SO THAT $EXCP R4 Q4151000 MVI PCEDEVTP,DCTINT WILL NOT CONVERT PCESEEK R4 Q4152000 LA R1,PCEDADCT POINT TO IOB R4 Q4153000 $EXCP (R1) ISSUE READ FOR TRACK-CELL R4 Q4154000 OI PPFLAG2,PPRSW INDICATE READ IN PROGRESS R4 Q4155000 IC PL,PBFAVAIL DECREMENT NUMBER R4 Q4156000 BCTR PL,0 OF AVAILABLE R4 Q4157000 STC PL,PBFAVAIL INPUT BUFFERS R4 Q4158000 LM PW,PBUF,PCEWA RESTORE WORKING REGISTERS R4 Q4159000 L PL,PLSAVE RESTORE RETURN REGISTER R4 Q4160000 BR PL AND RETURN R4 Q4161000 EJECT R4 Q4162000 *********************************************************************** Q4163000 * * Q4164000 * PRDTCHK - WAIT FOR, AND CHECK COMPLETION OF TRACK-CELL READ * Q4165000 * * Q4166000 *********************************************************************** Q4167000 SPACE 1 R4 Q4168000 PRDTCHK DS 0H R4 Q4169000 TM PPFLAG2,PPTCEL TEST DESPOOLING METHOD R4 Q4170000 BZ PRDCHK BR IF SINGLE R4 Q4171000 ST PL,PLSAVE SAVE RETURN REGISTER R4 Q4172000 L PBUF,PINIOB ACTIVATE INPUT IOB ADDRESSABILITY R4 Q4173000 L R1,PBUFSAVE SWAP R4 Q4174000 MVC PBUFSAVE,PBUFADDR TRACK-CELL R4 Q4175000 ST R1,PBUFADDR BUFFER POINTERS R4 Q4176000 NI IOBCCW4+4,255-X'40' TURN OFF COMMAND CHAINING BIT R4 Q4177000 PRDTCIO DS 0H R4 Q4178000 TM BUFECBCC,X'7F' TEST I/O COMPLETION R4 Q4179000 BO PRDTSCAN BRANCH IF NO ERRORS R4 Q4180000 BNZ PRDTCERR BRANCH IF ERROR R4 Q4181000 $WAIT IO WAIT FOR CHANNEL END R4 Q4182000 B PRDTCIO AND CHECK AGAIN R4 Q4183000 SPACE 1 R4 Q4184000 PRDTCERR DS 0H R4 Q4185000 L PL,IOBCSW-1 OBTAIN POINTER R4 Q4186000 LA PL,0(,PL) TO FAILING R4 Q4187000 SH PL,=H'8' CHANNEL COMMAND R4 Q4188000 LA R15,3*8 ADDRESS OF R4 Q4189000 MH R15,BUFCHNCT-BUFDSECT(,R1) LAST POSSIBLE R4 Q4190000 LA R15,IOBCCW1-BUFDSECT(R15,PBUF) READ COMMAND R4 Q4191000 CLM PL,7,IOBSTART+1 VALIDATE CSW R4 Q4192000 BL SKIP380 CONTENTS AND R4 Q4193000 CLR PL,R15 USE IOBSTART R4 Q4194000 BNH SKIP390 IF CSW IS @OZ39281 Q4195000 SKIP380 L PL,IOBSTART OUT OF RANGE R4 Q4196000 LA PL,0(,PL) CLEAR SIO CONDITION CODE @OZ39281 Q4196500 SKIP390 LA R14,8 BXLE INCREMENT VALUE R4 Q4197000 PRDTLOCR CLI 0(PL),6 LOCATE READ R4 Q4198000 BE SKIP400 CCW FOR BUFFER R4 Q4199000 BXLE PL,R14,PRDTLOCR IN ERROR R4 Q4200000 SPACE 1 R4 Q4201000 SKIP400 L R1,0(,PL) EXTRACT BUFFER ADDRESS R4 Q4202000 SL R1,=A(BUFSTART-BUFDSECT) ADJUST TO START OF BUFFER R4 Q4203000 OI BUFECBCC-BUFDSECT(R1),PPRDERR SET READ ERROR FLAG R4 Q4204000 CLR PL,R15 WAS ERROR BUFFER LAST IN CHAIN R4 Q4205000 BNE *+6 BR IF NOT R4 Q4206000 SLR PL,PL ELSE CLEAR RESTART ADDRESS R4 Q4207000 $IOERROR (PBUF) RECORD THE BAD NEWS R4 Q4208000 LTR PL,PL TEST FOR POSSIBLE RESTART R4 Q4209000 BZ PRDTSCAN BR IF NO -- ALL BUFFERS READ R4 Q4210000 LA PL,8(,PL) GET RESTART CCW ADDRESS R4 Q4211000 ST PL,IOBSTART AND PLACE IN IOB R4 Q4212000 L R1,0(,PL) GET POINTER TO SEARCH TARGET R4 Q4213000 MVC IOBSEEK+2(5),0(R1) MOVE CCHHR INTO IOB R4 Q4214000 LA R1,PCEDADCT PICK UP DA DCT ADDRESS R4 Q4215000 $EXCP (R1) RESTART CHANNEL PROGRAM R4 Q4216000 L R1,PBUFADDR PICK UP BUFFER CHAIN HEAD ADDRESS R4 Q4217000 B PRDTCIO AND GO CHECK ON I/O R4 Q4218000 SPACE 3 R4 Q4219000 * R4 Q4220000 * ALL BUFFERS HAVE BEEN READ (OR SKIPPED) R4 Q4221000 * R4 Q4222000 * VALIDATE CHAIN AND OBTAIN MTTR OF NEXT TRACK-CELL R4 Q4223000 * R4 Q4224000 PRDTSCAN DS 0H R4 Q4225000 L PBUF,PBUFADDR ADDRESSABILITY ON 1ST BUFFER R4 Q4226000 LH R15,BUFCHNCT NUMBER OF BUFFERS IN THIS CHAIN R4 Q4227000 LA PBUF,PBUFADDR-(BUFCHAIN-BUFDSECT) INITIAL POSITIONING R4 Q4228000 PRDTSCN1 L PBUF,BUFCHAIN ADDRESSABILITY ON NEXT BUFFER R4 Q4229000 CLC HDBKEY,PPKEY DO DATA AND JOB KEYS MATCH R4 Q4230000 BNE PRDTRDER BR IF NOT R4 Q4231000 TM BUFECBCC,PPRDERR DID READ FOR THIS BUFFER FAIL R4 Q4232000 BO PRDTUPDT BR IF YES R4 Q4233000 OC HDBNXTRK,HDBNXTRK TEST FOR LAST BUFFER IN DATA SET R4 Q4234000 BZ PRDTUPDT BR IF YES R4 Q4235000 BCT R15,PRDTSCN1 CHECK ALL BUFFERS IN CHAIN R4 Q4236000 MVC PCENXTRK,HDBNXTRK MTTR OF NEXT TRACK-CELL R4 Q4237000 L PBUF,PBUFADDR ESTAB. DATA BUFFER ADDRESSABILITY R4 Q4238000 LH R1,BUFCHNCT OBTAIN BUFFER COUNT R4 Q4239000 B PRDTCRET AND RETURN R4 Q4240000 SPACE 1 R4 Q4241000 * R4 Q4242000 * BUFFER IN CHAIN IS NOT VALID -- UPDATE CHAIN COUNT R4 Q4243000 * R4 Q4244000 PRDTRDER OI BUFECBCC,PPRDERR INDICATE BUFFER VALIDITY ERROR R4 Q4245000 PRDTUPDT XC PCENXTRK,PCENXTRK FORCE END OF R4 Q4246000 XC HDBNXTRK,HDBNXTRK BUFFER CHAIN R4 Q4247000 L PBUF,PBUFADDR ESTAB. DATA BUFFER ADDRESSABILITY R4 Q4248000 LH R1,BUFCHNCT COUNT OF BUFFERS IN CHAIN R4 Q4249000 BCTR R15,0 COMPUTE NUMBER OF R4 Q4250000 SLR R1,R15 VALID BUFFERS IN CHAIN R4 Q4251000 SPACE 1 R4 Q4252000 PRDTCRET IC R15,BUFCHOFF UPDATE BUFFER CHAIN COUNT R4 Q4253000 ALR R1,R15 TO REFLECT RESTART R4 Q4254000 STH R1,BUFCHNCT OFFSET R4 Q4255000 STC R15,PCEJBOFF INIT TRACK-CELL BUFFER OFFSET R4 Q4256000 NI PPFLAG2,255-PPRSW INDICATE READ COMPLETED R4 Q4257000 L PL,PLSAVE RESTORE RETURN REGISTER R4 Q4258000 BR PL AND RETURN TO CALLER R4 Q4259000 TITLE 'HASP PRINT/PUNCH SERVICE -- SINGLE DATA BUFFER READ ROUCQ4260000 TINES' R4 Q4261000 *********************************************************************** Q4262000 * * Q4263000 * SINGLE BUFFER READ ROUTINES -- PRDNXTB -- PRDBUF -- PRDCHK * Q4264000 * * Q4265000 *********************************************************************** Q4266000 SPACE 1 R4 Q4267000 * Q4268000 * READ NEXT DATA BLOCK - IOT IF CHAIN TRACK IS ZERO Q4269000 * Q4270000 PRDNXTB ICM R15,15,HDBNXTRK IS CHAIN TRACK ZERO Q4271000 BZ *+12 BRANCH IF LAST BLOCK Q4272000 TM PPFLAG,PPDELSW+PPRDERR SUSPEND OR READ ERROR Q4273000 BZ PRDBUF BRANCH IF NO Q4274000 TM PPFLAG,PPNEWS RETURN IF END OF R41 Q4274200 BOR PL JES2-NEWS DATA SET R41 Q4274400 L R15,PCEIOTTR GET IOT TRACK ADDRESS Q4275000 DROP PBUF KILL BUFFER ADDRESSABILITY Q4276000 * Q4277000 * READ DATA BUFFER FROM SPOOL PACK Q4278000 * Q4279000 PRDBUF L R1,PINIOB PICK UP INPUT IOB ADDRESS R4 Q4280000 L LINK,PBUFSAVE PICK UP DATA BUFFER ADDRESS R4 Q4281000 ST R1,PCEBUFAD IOB ADDRESS TO DA DCT R4 Q4282000 USING BUFDSECT,R1 ESTABLISH BUFFER ADDRESSABILITY Q4283000 LA LINK,BUFSTART-BUFDSECT(,LINK) START OF DATA AREA R4 Q4284000 STCM LINK,7,IOBCCW4+1 PLACE INTO READ CCW R4 Q4285000 LA LINK,IOBSEEK+2 PLACE SEEK TARGET ADDRESS R4 Q4286000 STCM LINK,7,IOBCCW2+1 INTO SEARCH CCW R4 Q4287000 LA R0,IOBCCW1 RESET IOBSTART Q4288000 ST R0,IOBSTART FOR READ Q4289000 MVI PCEDEVTP,PCEDARD SET DA DCT TO READ R4 Q4290000 LA R1,PCEDADCT SETUP DCT ADDRESS FOR $EXCP Q4291000 ST R15,PCESEEK STORE TRACK ADDRESS IN DCT Q4292000 $EXCP (R1) INITIATE READ Q4293000 OI PPFLAG2,PPRSW INDICATE READ IN PROGRESS R4 Q4294000 IC R1,PBFAVAIL DECREMENT NUMBER R4 Q4295000 BCTR R1,0 OF AVAILABLE R4 Q4296000 STC R1,PBFAVAIL INPUT BUFFERS R4 Q4297000 BR PL RETURN Q4298000 EJECT R4 Q4299000 * Q4300000 * WAIT/CHECK SPOOL READ COMPLETION R4 Q4301000 * Q4302000 PRDCHK DS 0H * Q4303000 L PBUF,PBUFSAVE SWAP PRIMARY R4 Q4304000 MVC PBUFSAVE,PBUFADDR AND SECONDARY R4 Q4305000 ST PBUF,PBUFADDR BUFFER POINTERS R4 Q4306000 L R1,PINIOB PICK UP INPUT IOB ADDRESSABILITY R4 Q4307000 PRDRECHK TM BUFECBCC,X'7F' TEST FOR I/O COMPLETE Q4308000 BO PRDRETRN BRANCH IF READ SUCCESSFUL R4 Q4309000 BNZ PRDERROR BRANCH IF ERROR DETECTED Q4310000 $WAIT IO WAIT FOR I/O POST Q4311000 B PRDRECHK GO BACK AND TRY AGAIN Q4312000 PRDERROR DS 0H Q4313000 OI PPFLAG,PPRDERR READ ERROR, SET FLAG Q4314000 $IOERROR PINIOB LOG I/O ERROR R4 Q4315000 SPACE 1 R4 Q4316000 PRDRETRN DS 0H R4 Q4317000 NI PPFLAG2,255-PPRSW INDICATE READ COMPLETED R4 Q4318000 BR PL AND RETURN Q4319000 DROP R1 KILL LOCAL BUFFER ADDRESSABILITY R4 Q4320000 USING BUFDSECT,PBUF ESTAB. DATA BUFFER ADDRESSABILITY R4 Q4321000 TITLE 'HASP PRINT/PUNCH SERVICE -- PROCESSOR TERMINATION' Q4322000 *********************************************************************** Q4323000 * * Q4324000 * CHECK TERMINATION REASON - PUNCH BLANK TO FLUSH PUNCH * Q4325000 * * Q4326000 *********************************************************************** Q4327000 SPACE 1 R4 Q4328000 PPDONE DS 0H Q4329000 NI PPFLAG,255-PPDELSW RESET DELETE FLAG Q4330000 TM PPFLAG,PRDELSW IS THIS A NORMAL TERMINATION Q4331000 BZ PRTRAILR BRANCH IF YES Q4332000 TM PCEID,PCEPRSID IS THIS A PRINT PROCESSOR Q4333000 BO PRABEOJ BRANCH IF YES Q4334000 LM PC1,PC2,PUCCWBL LOAD BLANK CARD CCW Q4335000 BAL PL,PPPUT ADD CCW TO CHAIN Q4336000 BAL PL,PPWRITE INITIATE WRITE Q4337000 BAL PL,PPCHECK AND CHECK Q4338000 SPACE 1 R4 Q4339000 *********************************************************************** Q4340000 * * Q4341000 * PROVIDE REASON FOR TERMINATION ON PROGRAMMERS LISTING * Q4342000 * * Q4343000 *********************************************************************** Q4344000 SPACE 1 R4 Q4345000 PRABEOJ DS 0H * Q4346000 $MID 170 R4 Q4347000 LA R1,=C'$HASP170 ' MESSAGE ID R4 Q4348000 TM PDCTFLAG,DCTRSTRT+DCTBKSP $I - (INTERRUPT) Q4349000 BNO PGMRST BRANCH IF NO Q4350000 LA R14,=C' INTERRUPTED' MESSAGE TEXT @OZ48259 Q4351000 OI PSMFDCI,SMFINTRP SET SMF FLAG Q4352000 B PGMRMSG GO WRITE MESSAGE Q4353000 SPACE 1 R4 Q4354000 PGMRST DS 0H Q4355000 TM PDCTFLAG,DCTRSTRT $E - (RESTART) Q4356000 BNO PGMDEL BRANCH IF NO Q4357000 LA R14,=C' RESTARTED ' MESSAGE TEXT @OZ48259 Q4358000 OI PSMFDCI,SMFRESTR SET SMF FLAG Q4359000 B PGMRMSG GO WRITE MESSAGE Q4360000 SPACE 1 R4 Q4361000 PGMDEL DS 0H Q4362000 TM PDCTFLAG,DCTDELET $C - (CANCEL) Q4363000 BNO PGMTRM BRANCH IF NO Q4364000 LA R14,=C' DELETED ' MESSAGE TEXT @OZ48259 Q4365000 OI PSMFDCI,SMFOPSTP SET SMF FLAG Q4366000 B PGMRMSG GO WRITE MESSAGE Q4367000 SPACE 1 R4 Q4368000 PGMTRM DS 0H Q4369000 $MID 185 R4 Q4370000 LA R1,=C'$HASP185 ' MESSAGE ID R4 Q4371000 LA R14,=C' TERMINATED ' MESSAGE TEXT @OZ48259 Q4372000 SPACE 1 @OZ19494 Q4372100 PGMRMSG L R15,=A(PRMSG) ISSUE MSG TO OPERATOR @OZ19494 Q4373000 BALR PL,R15 AND ADD IT TO OUTPUT @OZ48259 Q4374000 EJECT Q4375000 *********************************************************************** Q4376000 * * Q4377000 * SETUP DEVICE BY CHAR-JOE AND PRINT TRAILER PAGE * Q4378000 * * Q4379000 *********************************************************************** Q4380000 SPACE 1 R4 Q4381000 USING JOEDSECT,R1 PROVIDE CHAR-JOE ADDRESSABILITY R4 Q4382000 SPACE 1 R4 Q4383000 PRTRAILR DS 0H Q4384000 L R15,=A(PPSMF6) GENERATE FINAL @OZ32776 Q4384500 BAL PL,0(,R15) TYPE-6 SMF RCD (IN BUFFER) @OZ34616 Q4384600 L R1,PCHJOE ADDRESS CHAR-JOE Q4385000 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R4 Q4386000 BNE PTSETUP BR IF NOT R4 Q4387000 MVC SPFORMS(2*4),JOEFORM USE JOE FORMS AND FCB ID R4 Q4388000 MVC SPFLASH,JOEFLASH SET FLASH (SEP WON'T FLASH) R41 Q4393000 MVC SPMODF,=C'****' RESET COPY MODIFICATION R4 Q4394000 MVI SPCOPYN,1 FORCE ONLY 1 COPY OF TRAILER R4 Q4395000 MVI SPCOPYS,1 INDICATE STARTING COPY NUMBER R4 Q4396000 MVI SPFLAG,SPSEP INIT FLAGS FOR SEP PAGE R41 Q4397000 TM JOECFLAG,$JOEBRST SET FOR R4 Q4398000 BZ PTRSETUP NOBURST OR R41 Q4399000 OI SPFLAG,SPBURST BURST R4 Q4400000 B PTRSETUP ENTER COMMON SETUP R4 Q4402000 SPACE 1 R4 Q4403000 PTSETUP LA R1,JOEFORM ADDRESS IMPACT PRINTER SETUP DATA R4 Q4404000 MVI PRINDEX,X'81' RESET 3211 INDEX TO 1 Q4405000 B PTRSTUP SKIP NON-IMPACT READ CHECK @OZ46202 Q4405500 SPACE 1 R4 Q4406000 PTRSETUP TM PPFLAG2,PPRSW IF A READ IS @G38ESBB Q4407000 BZ PTRSTUP OUTSTANDING, CLEAR @G38ESBB Q4407050 BAL PL,PRDTCHK ALL INPUT I/O @G38ESBB Q4407100 SPACE 1 @G38ESBB Q4407150 PTRSTUP L R15,=A(PRPUDSV) CALL DEVICE @G38ESBB Q4407200 BALR PL,R15 SETUP VERIFICATION @G38ESBB Q4407250 L PL,PCEDCT GET DCT ADDRESS @G38ESBB Q4408100 TM DCTPPSW2-DCTDSECT(PL),DCTCKJAM 3800 PJAM/CKEY @G38ESBB Q4408200 BZ PRINTTR BR IF NOT @G38ESBB Q4408300 L R15,=A(PLOCATE) CALL THE LOCATE ROUTINE @G38ESBB Q4408400 BALR PL,R15 TO GET ORIGIN PQE @G38ESBB Q4408500 B PPDSEND PROCESS PAPERJAM/CANCEL KEY @G38ESBB Q4408600 SPACE 1 R4 Q4409000 DROP R1 SUSPEND JOE ADDRESSABILITY R4 Q4410000 SPACE 1 R4 Q4411000 *********************************************************************** Q4412000 * * Q4413000 * PRODUCE PRINT TRAILER PAGE * Q4414000 * * Q4415000 *********************************************************************** Q4416000 SPACE 1 R4 Q4417000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY R4 Q4418000 SPACE 1 R4 Q4419000 PRINTTR TM PCEID,PCEPUSID IS THIS A PUNCH PROCESSOR @G38ESBB Q4420000 BO PFINLSMF BR IF YES @OZ34616 Q4421000 L R1,PCEDCT ADDRESS PRINT DCT @OZ32566 Q4422000 MVI DCTACPTN,0 DISABLE COMPACTION FOR SEP R41 Q4422500 TM DCTPPSW,DCTPPSWS SUPPRESS SEPARATOR PAGE... R4 Q4423000 BO PEDGMARK BR IF YES R41 Q4424000 LA R1,=CL5' END' TRAILER PAGE ID Q4425000 L R15,=A(PRINTID) PRODUCE PRINTER @OZ19494 Q4426000 BALR PL,R15 TRAILER PAGE @G38ESBB Q4426100 EJECT R4 Q4427000 *********************************************************************** Q4428000 * * Q4429000 * ADD 3800 EDGE-MARK CCW IF REQUESTED BY DEVICE * Q4430000 * * Q4431000 *********************************************************************** Q4432000 SPACE 1 R4 Q4433000 PEDGMARK CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R41 Q4434000 BNE PFINLSMF BR IF NOT @OZ34616 Q4435000 L R1,PCEDCT ADDRESS PRINTER DCT @OZ32566 Q4436000 TM DCTPPSW2,DCTNIMRK TEST FOR EDGE-MARKING R4 Q4437000 BZ PSETPQED BRANCH IF NOT @OZ46315 Q4438000 LM PC1,PC2,PCCWEM LOAD EDGE-MARK CCW R4 Q4439000 BAL PL,PPPUT2 PLACE ON CHAIN @OZ51441 Q4440000 SLR PC1,PC1 WRITE ONE @OZ46315 Q4440100 ICM PC1,8,=X'89' BLANK PAGE @OZ46315 Q4440200 L PC2,PCCW+4 FOR EDGE MARKING @OZ46315 Q4440300 BAL PL,PPPUT PLACE ON CHAIN @OZ46315 Q4440400 SPACE 1 @G38ESBB Q4441000 *********************************************************************** Q4442000 * @G38ESBB Q4443000 * INDICATE END OF JOE IN PAGE QUEUE @G38ESBB Q4444000 * @G38ESBB Q4445000 *********************************************************************** Q4446000 SPACE 1 @G38ESBB Q4446200 BAL PL,PPWRITE INITIATE OUTPUT @G38ESBB Q4446400 BAL PL,PPCHECK WAIT FOR OUTPUT @G38ESBB Q4446600 PSETPQED L PW,PQHADR ADDRESS THE PQH @OZ46315 Q4446800 TM PQHFLAG-PQHDSECT(PW),PQHDSVC RESET NEEDED... @OZ44633 Q4446825 BZ PGETLAST BRANCH IF NOT @OZ44633 Q4446850 NI PQHFLAG-PQHDSECT(PW),FF-PQHDSVC RESET CMD @OZ44633 Q4446875 NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP FLAGS @OZ44633 Q4446900 PGETLAST L R1,PQHLAST-PQHDSECT(,PW) ADDRESS LAST PQE @OZ44633 Q4447000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT)-PQHDSECT(,PW) @G38ESBBCQ4447200 GET PQE0 @G38ESBB Q4447400 SPACE 1 @G38ESBB Q4447600 PTSTLAST CLR R1,R15 END OF PPQ... @G38ESBB Q4447800 BE PSETDEL YES, SET DELETE FLAG @OZ57316 Q4448000 CLI PQETYPE-PQEDSECT(R1),PQEC IS THIS A LAST PG PQE @G38ESBB Q4448200 BE PQEDONE BR IF YES, IND LAST DS @G38ESBB Q4448400 L R1,PQEPREV-PQEDSECT(,R1) GET PREVIOUS PQE @G38ESBB Q4448600 B PTSTLAST BR TO TEST FOR PQEC @G38ESBB Q4448800 EJECT @OZ57316 Q4449000 PQEDONE L R1,PQECPQED-PQEDSECT(,R1) ADDRESS PQED @G38ESBB Q4449200 OI PQEDFLAG-PQEDSECT(R1),PQEDLAST LAST DS OF JOE @G38ESBB Q4449400 CLC PQEDWJOE-PQEDSECT(,R1),PWKJOE TEST JOE ADDR @OZ57316 Q4449410 BE PTSTRPT BRANCH IF CURRENT JOE @OZ57316 Q4449420 PSETDEL OI PDCTFLAG,DCTDELET ELSE, SET DELETE FLAG @OZ57316 Q4449430 B PFINLSMF GO WRITE SMF 6 RECORD @OZ57316 Q4449440 SPACE 1 @OZ57316 Q4449450 PTSTRPT TM PDCTFLAG,DCTRPT NEED TO DEFER $N CMD... @OZ57316 Q4449600 BZ PFINLSMF NO, BRANCH @G38ESBB Q4449800 NI PDCTFLAG,FF-DCTRPT RESET COMMAND FLAG @G38ESBB Q4450000 OI PQEDFLAG-PQEDSECT(R1),PQEDRPT SET DEFERRED $N @G38ESBB Q4450200 IC R1,PQHCMDCT-PQHDSECT(,PW) GET DEFERRED CMD CT @G38ESBB Q4450400 LA R1,1(,R1) INCREMENT DEFERRED CMD CT @G38ESBB Q4450600 STC R1,PQHCMDCT-PQHDSECT(,PW) SAVE NEW COUNT @G38ESBB Q4450800 * THIS LINE DELETED BY APAR @OZ46142 Q4451000 SPACE 1 @OZ57316 Q4451100 PFINLSMF L R1,PPSMFBUF OBTAIN FINAL TYPE-6 @OZ34616 Q4451200 LTR R1,R1 SMF RECORD BUFFER @OZ34616 Q4451300 BZ PRPUEXIT BR IF NO RECORD AVAILABLE @OZ46610 Q4451400 $QUESMFB ELSE QUEUE THE RECORD @OZ34616 Q4451500 MVC PPSMFBUF,$ZEROS CLEAR SMF BUFFER POINTER @OZ34616 Q4451600 B PRPUEXIT AND BRANCH TO CONTINUE @OZ46610 Q4451700 SPACE 1 R4 Q4452000 DROP R1 SUSPEND DCT ADDRESSABILITY R4 Q4453000 EJECT R4 Q4454000 *********************************************************************** Q4455000 * * Q4456000 * CALL PPSMF6 TO BUILD AND WRITE FINAL TYPE 6 SMF RECORD * Q4457000 * * Q4458000 *********************************************************************** Q4459000 SPACE 1 R4 Q4460000 PPABORT CLC PSAVAREA,$ZEROS SAVE AREA = LEVEL 0... @G38ESBB Q4460100 BE PTRMSMF6 YES, BRANCH @G38ESBB Q4460200 MVC PSAVAREA,PSAV1ST RESTORE FIRST LEVEL SAVE @G38ESBB Q4460300 L R1,PSAVAREA ADDRESS FIRST SAVE AREA @G38ESBB Q4460400 CLI 0(R1),PSAVEALL SAVE ALL SPECIFIED... @G38ESBB Q4460500 BE PLNGRET YES, BRANCH @G38ESBB Q4460600 MVC 2*4(4,R1),=A(PTRMSMF6) ALTER RET ADR TO HERE @G38ESBB Q4460700 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q4460800 SPACE 1 @G38ESBB Q4460900 PLNGRET MVC 4+PL*4(4,R1),=A(PTRMSMF6) ALTER RET ADR TO HERE @G38ESBB Q4461000 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q4461200 SPACE 1 @G38ESBB Q4461400 PTRMSMF6 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @OZ45081 Q4462000 BNE PTRMSMF NO, BRANCH @OZ45081 Q4462100 TM PDCTFLAG,DCTDELET+DCTRSTRT+DCTBKSP 3800 CMD... @OZ45081 Q4462200 BNZ PTRMRSET YES, BYPASS SMF RECORD @OZ45081 Q4462300 TM PPFLAG3,PPDVNAVL IS DEVICE AVAILABLE... @OZ51930 Q4462310 BO PTRMRSET BRANCH IF NOT @OZ51930 Q4462320 SPACE 1 @OZ45081 Q4462400 PTRMSMF L R15,=A(PPSMF6) GENERATE TYPE 6 @OZ45081 Q4462450 BALR PL,R15 SMF RECORD @OZ32776 Q4462500 CLI PDEVTYP3,UCB3800 TEST FOR 3800E PRINTER @G38ESBB Q4462600 BNE PRPUEXIT NO, BRANCH @OZ46610 Q4462700 SPACE 1 @OZ45081 Q4462750 PTRMRSET L PW,PQHADR ADDRESS PQH @OZ45081 Q4462800 NI PQHFLAG-PQHDSECT(PW),FF-PQH2CMD RESET CMD FLAG @G38ESBB Q4462900 SPACE 2 R4 Q4463000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4464000 PRINT OFF @OZ46610 Q4465000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4466000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4467000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4468000 SPACE 1 R4 Q4469000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY R4 Q4470000 SPACE 1 R4 Q4471000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4472000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4473000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4474000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4475000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476010 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476020 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476050 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476100 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476150 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476300 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476450 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476600 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4476750 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4477000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4478000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4479000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4480000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4481000 * THIS LINE DELETED BY APAR OZ46610 @OZ46610 Q4482000 SPACE 1 @G38ESBB Q4483000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q4484000 * DELETED @G38ESBB Q4485000 * DELETED @G38ESBB Q4486000 * DELETED @G38ESBB Q4487000 * DELETED @G38ESBB Q4488000 * DELETED @G38ESBB Q4489000 * DELETED @G38ESBB Q4490000 * DELETED @G38ESBB Q4491000 * DELETED @G38ESBB Q4492000 * DELETED @G38ESBB Q4493000 * DELETED @G38ESBB Q4494000 * DELETED @G38ESBB Q4495000 * DELETED @G38ESBB Q4496000 * DELETED @G38ESBB Q4497000 * DELETED @G38ESBB Q4498000 * DELETED @G38ESBB Q4499000 * DELETED @G38ESBB Q4500000 * DELETED @G38ESBB Q4501000 * DELETED @G38ESBB Q4502000 * DELETED @G38ESBB Q4503000 * DELETED @G38ESBB Q4504000 * DELETED @G38ESBB Q4505000 * DELETED @G38ESBB Q4506000 * DELETED @G38ESBB Q4507000 * DELETED @G38ESBB Q4508000 * DELETED @G38ESBB Q4509000 * DELETED @G38ESBB Q4510000 * DELETED @G38ESBB Q4511000 * DELETED @G38ESBB Q4512000 * DELETED @G38ESBB Q4513000 * DELETED @G38ESBB Q4514000 * DELETED @G38ESBB Q4515000 * DELETED @G38ESBB Q4516000 * DELETED @G38ESBB Q4517000 * DELETED @G38ESBB Q4518000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q4519000 EJECT Q4520000 ************************************************************** @OZ19494 Q4520020 * * @OZ19494 Q4520040 * ISSUE $EXTP CLOSE FOR REMOTE PROCESSOR * @OZ19494 Q4520060 * * @OZ19494 Q4520080 ************************************************************** @OZ19494 Q4520100 SPACE 1 @OZ19494 Q4520200 PRPUEXIT TM PCEID,PCELCLID TEST FOR LOCAL PROCESSOR @OZ19494 Q4520300 BO PJCTFREE BRANCH IF YES @OZ19494 Q4520400 L R1,PCEDCT ADDRESS REMOTE DCT @OZ19494 Q4520500 USING DCTDSECT,R1 ACTIVATE DCT ADDRESSABILITY @OZ19494 Q4520600 OI DCTSTAT,DCTHOLD SET DEVICE UNAVAILABLE @OZ19494 Q4520700 TM PDCTFLAG,DCTDELET+DCTRSTRT CHECK FOR $C OR $E @OZ19494 Q4520800 BZ PPCLOSE BR IF NO, DO NORMAL CLOSE @OZ19494 Q4520900 TM PDCTFLAG,DCTRSTRT+DCTBKSP CHECK FOR $I @OZ19494 Q4521000 BNO PPNCLOSE BR IF NO, USE NEG. CLOSE @OZ19494 Q4521100 PPCLOSE ICM PC1,8,=X'FF' TRUNCATE LAST BUFFER, @OZ19494 Q4521120 NI PPFLAG,255-PRDELSW RESET TERMINATION FLAG @OZ19494 Q4521130 BAL PL,PPPUT2 AND CHECK OPERATOR CMDS @OZ19494 Q4521140 L R1,PCEDCT RESTORE DCT PTR FOR CLOSE @OZ19494 Q4521160 $EXTP CLOSE,(R1) CLOSE REMOTE DEVICE @OZ19494 Q4521200 B PPCLSCK CONTINUE @OZ19494 Q4521300 SPACE 1 @OZ19494 Q4521400 PPNCLOSE $EXTP NCLOSE,(R1) NEGATIVE CLOSE RMT DEVICE @OZ19494 Q4521500 NI DCTFLAGS,255-DCTSTOP RESET STOP @OZ43394 Q4521600 PPCLSCK NI PPFLAG,255-PRDELSW RESET TERMINATION FLAG @OZ19494 Q4521700 BAL PL,PPCHECK CHECK FOR OPERATOR COMMANDS @OZ19494 Q4521750 SPACE 1 @OZ19494 Q4521800 DROP R1 SUSPEND DCT ADDRESSABILITY @OZ19494 Q4521900 EJECT @OZ19494 Q4522000 ************************************************************** @OZ19494 Q4522100 * * @OZ19494 Q4522200 * RELEASE JCT AND DISPOSE OF JOB OUTPUT ELEMENT * @OZ19494 Q4523000 * * @OZ19494 Q4524000 ************************************************************** @OZ19494 Q4525000 SPACE 1 @OZ19494 Q4526000 PJCTFREE L JCT,PJCTBUF ADDRESS JCT BUFFER @OZ19494 Q4527000 $#JCT FREE RELEASE JCT BUFFER Q4528000 XC PJCTBUF,PJCTBUF INDICATE NO JCT @G38ESBB Q4528500 SPACE 1 R4 Q4529000 *********************************************************************** Q4530000 * * Q4531000 * IF THERE IS A $N STACKED - REQUEUE JOE (NO CKPT DATA) * Q4532000 * * Q4533000 *********************************************************************** Q4534000 SPACE 1 R4 Q4535000 PJOEOPN TM PDCTFLAG,DCTRPT $N - (REPEAT) R4 Q4536000 BZ PJOEOPI BRANCH IF NO Q4537000 PJOEPUT $#PUT WORK=PWKJOE RETURN TO JOT - NO CHECKPOINT R4 Q4538000 B PPNOJOE BRANCH TO CONTINUE R4 Q4539000 SPACE 1 R4 Q4540000 *********************************************************************** Q4541000 * * Q4542000 * TERMINATION FOR $I - REQUEUE JOE (CKPT DATA) * Q4543000 * * Q4544000 *********************************************************************** Q4545000 SPACE 1 R4 Q4546000 PJOEOPI TM PDCTFLAG,DCTRSTRT+DCTBKSP $I - (INTERRUPT) R4 Q4547000 BNO PJOEOPE BRANCH IF NO Q4548000 TM PCEID,PCELCLID LOCAL DEVICE... @OZ47402 Q4552000 BNO PJPUTI BRANCH IF NOT. @OZ47402 Q4553000 CLI PDEVTYP3,UCB3800 IS THIS A D/T3800.... @OZ46954 Q4554000 BE PJPUTI DO NOT UPDATE JOE @OZ46954 Q4554100 $QSUSE REQUEST ACCESS TO CHKPT @OZ46954 Q4554200 L R14,PCKJOE GET CHKPT JOE POINTER @OZ46954 Q4554300 USING JOEDSECT,R14 @OZ46954 Q4554400 ICM R15,15,PPCKPTR GET CURRENT CHKPT DATA @OZ46954 Q4554500 BZ PJPUTI BRANCH IF NONE AVAILABLE. @OZ46954 Q4554550 MVC JOECKPP,0(R15) UPDATE CHKPT JOE @OZ46954 Q4554600 PJPUTI DS 0H @OZ46954 Q4554700 $#PUT WORK=PWKJOE,PRC=PCKJOE RETURN CHKPT JOE TO JOT @OZ46954 Q4554800 DROP R14 @OZ46954 Q4554900 B PPNOJOE BRANCH TO CONTINUE R4 Q4555000 EJECT R4 Q4556000 *********************************************************************** Q4557000 * * Q4558000 * TERMINATION FOR $E - REQUEUE JOE (NO CKPT DATA) * Q4559000 * * Q4560000 *********************************************************************** Q4561000 SPACE 1 R4 Q4562000 PJOEOPE TM PDCTFLAG,DCTRSTRT $E - (RESTART) R4 Q4563000 BO PJOEPUT BRANCH IF YES R4 Q4564000 TM PDCTFLAG,DCTDELET IS COMMAND $C... @G38ESBB Q4564200 BO PJOEIOE YES, GO REMOVE JOE @G38ESBB Q4564400 CLI PDEVTYP3,UCB3800 ELSE, BYPASS JOE REMOVAL @G38ESBB Q4564600 BE PPNOJOE IF 3800 PRINTER @G38ESBB Q4564800 SPACE 1 R4 Q4565000 ************************************************************* @OZ38851 Q4565050 * * @OZ38851 Q4565100 * TERMINATION FOR QUEUED $N - REQUEUE JOE (NO CKPT) * @OZ38851 Q4565150 * * @OZ38851 Q4565200 ************************************************************* @OZ38851 Q4565250 SPACE 1 @OZ38851 Q4565300 L R1,PWKJOE ADDRESS THE WORK-JOE @OZ38851 Q4565350 USING JOEDSECT,R1 MAKE JOE ADDRESSABLE @OZ38851 Q4565400 TM JOEFLAG,$JOESPIN IS THIS A SPIN JOE? @OZ38851 Q4565450 BNO PJOEIO2 BRANCH IF NO @OZ46610 Q4565500 $QSUSE REQ ACCESS TO CKPT DATA @OZ38851 Q4565550 SLR R15,R15 CLEAR R15 @OZ38851 Q4565600 ICM R15,1,JOENCNT GET $N COUNT @OZ38851 Q4565650 BZ PJOEIOE BRANCH IF NONE @OZ38851 Q4565700 BCTR R15,0 DECREMENT COUNT @OZ38851 Q4565750 STCM R15,1,JOENCNT SET NEW COUNT @OZ38851 Q4565800 B PJOEPUT REQUEUE THE JOE @OZ38851 Q4565850 DROP R1 SUSPEND JOE ADDRESSABILITY @OZ38851 Q4565900 SPACE 1 @OZ38851 Q4565950 SPACE 1 @OZ46610 Q4566000 ************************************************************ @OZ46610 Q4566100 * RESET SPIN IOT ALLOCATION BIT AND PURGE DATA * @OZ46610 Q4566200 * SET TRACKS * @OZ46610 Q4566300 ************************************************************ @OZ46610 Q4566400 SPACE 1 @OZ46610 Q4566500 PJOEIOE DS 0H @OZ46610 Q4566600 TM PPFLAG,PPDALOC IS THIS AN ALLOCATION IOT @OZ44633 Q4566700 BZ PJOEIO2 BRANCH IF NOT @OZ44633 Q4566800 L R1,PCEDCT LOAD PR/PU DCT BASE @OZ46610 Q4566900 USING DCTDSECT,R1 @OZ46610 Q4567000 CLI DCTBUFCT,0 IS UNIT RECORD I/O HUNG @OZ46610 Q4567100 BNE PJOEIO2 YES, CAN'T PURGE. @OZ46610 Q4567200 DROP R1 @OZ46610 Q4567300 L R0,PCEIOTTR ADDRESS IOT FOR SUBROUTINE @OZ46610 Q4567400 L R15,=A(PURSPDS) CALL SUBROUTINE TO PURGE @OZ46610 Q4567500 BALR PL,R15 SPIN DATA SET SPOOL SPACE @OZ46610 Q4567600 PJOEIO2 DS 0H @OZ46610 Q4568000 SPACE 1 @OZ46610 Q4569000 ************************************************************ @OZ46610 Q4569500 * TERMINATION FOR $C - DELETE JOE * @OZ46610 Q4570000 * TERMINATION FOR I/O ERROR READING DATA OR * @OZ46610 Q4570500 * CONTROL BLOCKS * @OZ46610 Q4571000 ************************************************************ @OZ46610 Q4572000 SPACE 1 @OZ46610 Q4573000 $#REM WORK=PWKJOE REMOVE WORK-JOE FROM JOT @OZ46610 Q4574000 SPACE 1 R4 Q4575000 PPNOJOE MVC PCEJQE,$ZEROS CLEAR JQE ADDRESS @OZ32566 Q4576000 TM PCEID,PCERJEID TEST PROCESSOR TYPE @OZ19494 Q4577000 BO PFRESRCE IF REMOTE, FREE RESOURCES @OZ19494 Q4578000 SPACE 1 @OZ19494 Q4579000 PRINT OFF THIS SECTION DELETED BY @OZ19494 Q4580000 * THIS CARD DELETED BY APAR @OZ19494 Q4580100 * THIS CARD DELETED BY APAR @OZ19494 Q4580200 * THIS CARD DELETED BY APAR @OZ19494 Q4580300 * THIS CARD DELETED BY APAR @OZ19494 Q4580400 * THIS CARD DELETED BY APAR @OZ19494 Q4580500 * THIS CARD DELETED BY APAR @OZ19494 Q4582000 * THIS CARD DELETED BY APAR @OZ19494 Q4584000 * THIS CARD DELETED BY APAR @OZ19494 Q4584100 * THIS CARD DELETED BY APAR @OZ19494 Q4584200 * THIS CARD DELETED BY APAR @OZ19494 Q4584300 * THIS CARD DELETED BY APAR @OZ19494 Q4584400 PRINT ON THIS SECTION DELETED BY @OZ19494 Q4584500 SPACE 1 @G38ESBB Q4585000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q4586000 * DELETED @G38ESBB Q4587000 * DELETED @G38ESBB Q4588000 * DELETED @G38ESBB Q4589000 * DELETED @G38ESBB Q4590000 * DELETED @G38ESBB Q4591000 * DELETED @G38ESBB Q4592000 * DELETED @G38ESBB Q4593000 * DELETED @G38ESBB Q4594000 * DELETED @G38ESBB Q4595000 * DELETED @G38ESBB Q4596000 * DELETED @G38ESBB Q4597000 * DELETED @G38ESBB Q4598000 * DELETED @G38ESBB Q4599000 * DELETED @G38ESBB Q4600000 * DELETED @G38ESBB Q4601000 * DELETED @G38ESBB Q4602000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q4603000 EJECT R4 Q4604000 *********************************************************************** Q4605000 * * Q4606000 * CLEAR ALL INPUT I/O @G38ESBB Q4607000 * * Q4608000 * COMPLETE ALL OUTPUT I/O @G38ESBB Q4609000 * * Q4610000 *********************************************************************** Q4611000 SPACE 1 R4 Q4612000 PFRESRCE DS 0H R4 Q4613000 TM PPFLAG2,PPRSW IF A READ IS R4 Q4614000 BZ PCLRIO OUTSTANDING, CLEAR @G38ESBB Q4615000 BAL PL,PRDTCHK ALL INPUT I/O R4 Q4616000 SPACE 1 R4 Q4617000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY @G38ESBB Q4618000 SPACE 1 @G38ESBB Q4619000 PCLRIO TM PCEID,PCERJEID TEST PROCESSOR TYPE @G38ESBB Q4620000 BO PFREUNIT BR IF REMOTE @G38ESBB Q4621000 L R1,PCEDCT ADDRESS PRINT/PUNCH DCT @G38ESBB Q4622000 CLI DCTBUFCT,0 HAS ALL OUTPUT COMPLETED... @G38ESBB Q4623000 BE PTDRAIN BR IF YES @G38ESBB Q4624000 $WAIT IO ELSE,WAIT FOR I/O TO FINISH @G38ESBB Q4625000 B PCLRIO AND TRY AGAIN @G38ESBB Q4626000 SPACE 1 @G38ESBB Q4627000 PTDRAIN CLI PDEVTYP3,UCB3800 IS DEVICE A 3800 PRINTER @G38ESBB Q4628000 BNE PDRMSG BR IF NOT @G38ESBB Q4629000 TM PPFLAG3,PPQSPND SHOULD DEVICE DRAIN... @OZ48003 Q4630000 BZ PTDRNFLG BRANCH IF NOT @OZ48003 Q4630100 OI DCTSTAT,DCTDRAIN SET DRAIN FLAG @OZ48003 Q4630200 SPACE 1 @OZ48003 Q4630300 PTDRNFLG TM DCTSTAT,DCTDRAIN DRAIN DETECTED... @OZ48003 Q4631000 BO PDRAINCP BRANCH IF YES @OZ48003 Q4632000 TM DCTPPFL,DCTPAUSE OPERATOR REQUESTED PAUSE @G38ESBB Q4632500 BZ PFREUNIT BR IF NO @G38ESBB Q4633000 SPACE 1 @G38ESBB Q4633500 PDRAINCP LA JCT,JCT SHOW NON-ZERO JCT FOR I/O @G38ESBB Q4634000 MVC PWKJOE,$ZEROS SHOW ZERO WORK JOE FOR I/O @G38ESBB Q4635000 TM PPFLAG3,PPDVNAVL IS DEVICE AVAILABLE... @OZ51930 Q4635100 BO PFREUNIT BRANCH IF NOT @OZ51930 Q4635200 LM PC1,PC2,PCCWCP LOAD CLEAR PRINT CCW @G38ESBB Q4636000 BAL PL,PPPUT ADD CCW TO AREA @G38ESBB Q4637000 BAL PL,PPWRITE WRITE CCW TO AREA @G38ESBB Q4638000 BAL PL,PPCHECK WAIT FOR I/O TO COMPLETE @G38ESBB Q4639000 TM PPFLAG3,PPQSPND TEST IF PPQ SUSPENDED @OZ51930 Q4639100 BO PFREUNIT BRANCH IF YES @OZ51930 Q4639200 L R1,PCEDCT GET DCT ADDRESS @G38ESBB Q4640000 SPACE 1 @G38ESBB Q4641000 PDRMSG TM DCTPPFL,DCTPAUSE PAUSE ISSUED @G38ESBB Q4642000 BZ PFREUNIT BR IF NO @G38ESBB Q4643000 OI DCTSTAT,DCTPAUSE PAUSE THE DEVICE @G38ESBB Q4644000 $MID 175 MESSAGE IDENTIFIER @G38ESBB Q4645000 PMSG PMESSAGE,M175L,(X'175F',DCTDEVN,C' PAUSED') @G38ESBBCQ4646000 MOVE MESSAGE TEXT @G38ESBB Q4647000 $WTO PMESSAGE,M175L, INFORM OPERATOR @G38ESBBCQ4648000 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST,JOB=NO @G38ESBB Q4649000 SPACE 1 @G38ESBB Q4650000 DROP R1 SUSPEND DCT @G38ESBB Q4651000 SPACE 1 @G38ESBB Q4652000 ***************************************************************@G38ESBB Q4653000 * @G38ESBB Q4654000 * FREE PRINT/PUNCH/REMOTE DCT @G38ESBB Q4655000 * @G38ESBB Q4656000 ***************************************************************@G38ESBB Q4657000 SPACE 1 @G38ESBB Q4658000 PFREUNIT $FREUNIT PCEDCT FREE PRINT/PUNCH DCT @G38ESBB Q4659000 SPACE 1 @G38ESBB Q4660000 ***************************************************************@G38ESBB Q4661000 * @G38ESBB Q4662000 * CALL RESOURCE DEALLOCATION ROUTINE @G38ESBB Q4663000 * @G38ESBB Q4664000 ***************************************************************@G38ESBB Q4665000 SPACE 1 @G38ESBB Q4666000 L R15,=A(PDEALLOC) CALL RESOURCE @G38ESBB Q4667000 BALR PL,R15 DEALLOCATION ROUTINE @G38ESBB Q4668000 SPACE 1 @G38ESBB Q4669000 ***************************************************************@G38ESBB Q4670000 * @G38ESBB Q4671000 * INDICATE THAT THE PRINT/PUNCH PROCESSOR IS DORMANT @G38ESBB Q4672000 * @G38ESBB Q4673000 ***************************************************************@G38ESBB Q4674000 SPACE 1 @G38ESBB Q4675000 PDORMANT DS 0H @G38ESBB Q4676000 $DORMANT INIDCATE PROCESSOR INACTIVE @G38ESBB Q4677000 B PRPUINIT BR TO RESTART PROCESSOR @G38ESBB Q4678000 SPACE 1 @OZ48003 Q4679000 PRINT OFF THIS SECTION DELETED BY @OZ48003 Q4679100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4679900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4680900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4681900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4682900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4683900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4684900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685100 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685200 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685300 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685400 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685500 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685600 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685700 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685800 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4685900 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4686000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4687000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4688000 * THIS LINE DELETED BY APAR NUMBER @OZ48003 Q4689000 PRINT ON THIS SECTION DELETED BY @OZ48003 Q4690000 TITLE 'HASP PRINT/PUNCH SERVICE -- SMF BUFFER FREE ROUTINE' @G38ESBB Q4691000 ***************************************************************@G38ESBB Q4692000 * @G38ESBB Q4692100 * RETURN SMF BUFFER TO THE SMF BUFFER FREE QUEUE @G38ESBB Q4692200 * @G38ESBB Q4692300 ***************************************************************@G38ESBB Q4692400 SPACE 1 @G38ESBB Q4692500 PFRESMFB L R0,$SMFFREE GET SMF BUF QUEUE HEAD @G38ESBB Q4692600 ST R0,0(,R1) ADD PASSED SMF @G38ESBB Q4692700 CS R0,R1,$SMFFREE BUFFER TO @G38ESBB Q4692800 BNE PFRESMFB QUEUE HEAD @G38ESBB Q4692900 $POST $HASPECF,SMF NOTIFY RESOURCE AVAILABLE @G38ESBB Q4693000 BR LINK RETURN @G38ESBB Q4693100 TITLE 'HASPPRPU REGISTER SAVE/RETURN ROUTINES' @G38ESBB Q4693200 ***************************************************************@G38ESBB Q4693300 * @G38ESBB Q4693400 * PSAVE -- OBTAIN NEW AREA AND SAVE REGISTERS @G38ESBB Q4694000 * @G38ESBB Q4694050 * R0,R1 WORK REGISTERS @G38ESBB Q4694100 * R14 - RETURN ADR (HI-BIT OFF = ONLY SAVE BASE2,PL) @G38ESBB Q4694150 * R15 - ENTRY ADDRESS @G38ESBB Q4694200 * @G38ESBB Q4694250 * NOTE - REGS R14 THRU R1 ARE SAVED AND RESTORED BY THE @G38ESBB Q4694300 * PSAVE MACRO EXPANSION USING $CSAVREG @G38ESBB Q4694350 * @G38ESBB Q4694400 ***************************************************************@G38ESBB Q4694450 SPACE 1 @G38ESBB Q4694500 PSAVE L R0,PSAVAREA POINT TO PREVIOUS SAVE AREA @G38ESBB Q4694550 LTR R0,R0 IS THIS FIRST SAVE LEVEL... @G38ESBB Q4694600 BNZ PSAVNOT1 BR IF NO @G38ESBB Q4694650 L R1,PSAV1ST ELSE POINT TO 1ST SAVE AREA @G38ESBB Q4694700 B PSAVCOMN AND BR TO CONTINUE @G38ESBB Q4694750 SPACE 1 @G38ESBB Q4694800 PSAVNOT1 LR R1,R0 POINT @G38ESBB Q4694850 L R1,0(,R1) PAST @G38ESBB Q4694900 SRL R1,24 PREVIOUS @G38ESBB Q4694950 ALR R1,R0 SAVE AREA @G38ESBB Q4695000 SPACE 1 @G38ESBB Q4695050 PSAVCOMN ST R1,PSAVAREA UPDATE SAVE AREA POINTER @G38ESBB Q4695100 ST R0,0(,R1) BACK-CHAIN PREVIOUS AREA @G38ESBB Q4695150 LTR R14,R14 SAVE ALL REGISTERS... @G38ESBB Q4695200 BNM PSAVSHOR BR IF NO @G38ESBB Q4695250 MVI 0(R1),(1+16)*4 ELSE SHOW ALL REGS SAVED @G38ESBB Q4695300 MVC 4+(R0*4)(2*4,R1),$CSAVREG+2*4 SAVE R0,R1 @G38ESBB Q4695350 STM R2,R13,4+(R2*4)(R1) SAVE R2-R13 @G38ESBB Q4695400 MVC 4+(R14*4)(2*4,R1),$CSAVREG SAVE R14,R15 @G38ESBB Q4695450 BR R14 RETURN TO CALLER @G38ESBB Q4695500 SPACE 1 @G38ESBB Q4695550 PSAVSHOR MVI 0(R1),(1+2)*4 SHOW 2 REGISTERS SAVED @G38ESBB Q4695600 ST BASE2,4(,R1) SAVE BASE2 @G38ESBB Q4695650 ST PL,2*4(,R1) SAVE PL @G38ESBB Q4695700 BR R14 RETURN TO CALLER @G38ESBB Q4695750 EJECT @G38ESBB Q4695800 ***************************************************************@G38ESBB Q4695850 * @G38ESBB Q4695900 * PRETURN - RESTORE REGS AND RETURN TO PREVIOUS LEVEL @G38ESBB Q4695950 * @G38ESBB Q4696000 * R14 - RETURN ADR (HI-BYTE CONTAINS CC SET BY BALR) @G38ESBB Q4696050 * R15 - ENTRY ADDRESS @G38ESBB Q4696100 * @G38ESBB Q4696150 * NOTE - CONDITION CODE ON ENTRY IS RESTORED BEFORE RETURNING @G38ESBB Q4696200 * @G38ESBB Q4696250 ***************************************************************@G38ESBB Q4696300 SPACE 1 @G38ESBB Q4696350 PRETURN L R1,PSAVAREA POINT TO CURRENT SAVE AREA @G38ESBB Q4696400 MVC PSAVAREA+1(3),1(R1) UPDATE SAVE AREA POINTER @G38ESBB Q4696450 CLI 0(R1),PSAVEALL ALL REGISTERS SAVED... @G38ESBB Q4696500 BE PRETALL BR IF YES @G38ESBB Q4696550 SPM R14 RESTORE CC @G38ESBB Q4696600 L BASE2,4(,R1) RETORE BASE2 @G38ESBB Q4696650 L PL,8(,R1) RESTORE PL @G38ESBB Q4696700 BR PL RETURN TO PREVIOUS LEVEL @G38ESBB Q4696750 SPACE 1 @G38ESBB Q4696800 PRETALL SPM R14 RESTORE CC @G38ESBB Q4696850 LM R0,R15,4+(R0*4)(R1) RESTORE R0 THRU R15 @G38ESBB Q4696900 BR PL RETURN TO PREVIOUS LEVEL @G38ESBB Q4696950 TITLE 'HASP PRINT/PUNCH SERVICE -- VARIABLE STORAGE' @G38ESBB Q4697000 * MISCELLANEOUS CONSTANTS @OZ19494 Q4698000 SPACE 1 @OZ19494 Q4699000 PJOBSTAT DC CL39'------ JES2 JOB STATISTICS ------' @OZ19494 Q4700000 BFWSKEL DC XL7'F10000F200F300' BFW SKELETON @G38ESBB Q4700100 PFDSET DC X'7FFFFFFF' END OF DS PQE INDICATOR @OZ53047 Q4700200 PCLRHALF DC F'65535' CLEAR LEFT HALFWORD @G38ESBB Q4700300 PCVTREAL DC XL4'00000FFF' CONVERT TO REAL ADDRESS @G38ESBB Q4700350 PQELIMIT DC XL4'00000FFF' ISOLATE 3800 PAGE IDS @G38ESBB Q4700400 PCCWLENG DC H'08' CCW LENGTH @G38ESBB Q4700500 PH6LPI DC H'03' LINES IN HALF INCH AT 6 LPI @G38ESBB Q4700600 PFCBTOP DC H'01' TOP OF FCB @G38ESBB Q4700700 PFSPDSET DC X'FFFFFFFF' $FPRTN,D @OZ53047 Q4700800 PMAXSKIP DC XL4'7FFFFFFF' INDICATE NO PRINTING @G38ESBB Q4700900 PXEQDATE DC CL29' JOB EXECUTION DATE' @OZ19494 Q4701000 PRDRSTAT DC X'40206B2020206B202120',CL29' CARDS READ' @OZ19494 Q4702000 PPRTSTAT DC X'40206B2020206B202120',CL29' SYSOUT PRINT RECORDS' R4 Q4703000 PPUNSTAT DC X'40206B2020206B202120',CL29' SYSOUT PUNCH RECORDS' R4 Q4704000 PXEQSTAT DC X'4020206B2021204B2020',CL29' MINUTES EXECUTION TIME' R4 Q4705000 SPACE 1 @OZ19494 Q4706000 * CCW SKELETONS @OZ19494 Q4707000 SPACE 1 @OZ19494 Q4708000 PDIRCCW CCW X'FE',BUFSTART-BUFDSECT,X'60',68 PDIR CCW @OZ19494 Q4709000 PCCWSIB CCW X'14',0,X'60',12 SENSE INT BUF CCW @G38ESBB Q4709200 PCCWXORD CCW X'33',0,X'60',2 EXECUTE ORDER CCW @G38ESBB Q4709400 PRCCWEJ CCW X'8B',0,X'60',1 @OZ19494 Q4710000 PRCCWID CCW X'09',*-*,X'60',132 @OZ19494 Q4711000 PUCCW CCW X'41',*-*,X'60',80 @OZ19494 Q4712000 PCCW CCW *-*,HDBSTART-BUFDSECT,X'60',*-* @OZ19494 Q4713000 PUCCWBL CCW X'01',*-*,X'60',1 BLANK SPACER CCW. @OZ19494 Q4714000 PRCCWSP CCW X'1B',0,X'60',1 @OZ19494 Q4715000 PRCCWSP1 CCW X'0B',0,X'60',1 SPACE-1-IMMEDIATE @OZ19494 Q4716000 PRCCWCOM CCW X'09',*-*,X'60',L'PMESSAGE @OZ19494 Q4717000 PCCWNOP CCW X'03',0,X'20',64 COUNT USED AS A BLANK @OZ19494 Q4718000 PUNFOLD CCW X'23',0,X'60',1 3211 UNFOLD CONTROL CCW @OZ19494 Q4719000 PUCSGATE CCW X'EB',0,X'60',1 1403 UCS GATE CONTROL CCW @OZ19494 Q4720000 PUCSBDC CCW X'73',0,X'60',1 BLOCK DATA CHECK CCW @OZ19494 Q4721000 PUCSLOAD CCW X'FB',BUFSTART+1-BUFDSECT,X'60',240 LOAD UCS CCW@OZ19494 Q4722000 PFCBLOAD CCW X'63',BUFSTART+2-BUFDSECT,X'60',0 LOAD FCB CCW @OZ19494 Q4723000 PUSPACCW CCW X'1D',*-*,X'A0',48 BLANK SPACER CCW. @OZ19494 Q4724000 PCCWEM CCW X'17',0,X'60',1 EDGE MARK CCW @OZ19494 Q4725000 PCCWCP CCW X'87',0,X'60',1 CLEAR PRINT CCW @OZ19494 Q4726000 PCCWOFST CCW X'07',0,X'60',1 OFFSET-STACK (EOT) @OZ19494 Q4727000 SPACE 1 @OZ19494 Q4728000 PCNOPTIC DC X'03',AL3(*-*),X'20',AL1(0,PCIEPRPU,0) PCIE @OZ19494 Q4729000 DC X'08',AL3(*-*),A(*-*) TEMPLATE @OZ19494 Q4730000 SPACE 1 @OZ19494 Q4731000 PRXTR TR 0(*-*,PC1),0(R15) *** EXECUTED *** &PRTRANS @OZ19494 Q4732000 PMAXPAGE DC A(X'3FFFFFFF') $F DATASET PAGE COUNT @OZ19494 Q4732100 SPACE 1 @G38ESBB Q4732550 * MISCELLANEOUS EQUATES @G38ESBB Q4732600 SPACE 1 @G38ESBB Q4732700 RPISIBSZ EQU L'PCCWXORD+L'PCCWSIB LENGTH OF RPI/SIB CCW'S @G38ESBB Q4732800 PTICCMD EQU X'08' TIC COMMAND @G38ESBB Q4732820 PVALCMD EQU X'10' VALID FCB MAPPING COMMAND @G38ESBB Q4732840 PSKIPCMD EQU X'20' CHANNEL SKIP COMMAND @G38ESBB Q4732860 PSAVBITS EQU X'0F' ISOLATE SPACE/SKIP BITS @G38ESBB Q4732880 PDEVTYP3 EQU PDEVTYPE+UCBTBYT4-UCBTYP UCB DEVICE TYPE @G38ESBB Q4732900 PWRTNOSP EQU X'00' WRITE NO SPACE COMMAND @G38ESBB Q4732920 PCONVIMM EQU X'02' CONVERT TO IMMEDIATE CMD @G38ESBB Q4732940 PSAVEALL EQU 68 SAVE ALL REGISTERS @G38ESBB Q4732960 EJECT @OZ19494 Q4733000 ***************************************************************@OZ19494 Q4734000 * @OZ19494 Q4735000 * PRINT/PUNCH PROCESSOR LITERAL POOL @OZ19494 Q4736000 * @OZ19494 Q4737000 ***************************************************************@OZ19494 Q4738000 SPACE 1 @OZ19494 Q4739000 DS 0D @OZ19494 Q4740000 LTORG @OZ19494 Q4741000 SPACE 3 @OZ19494 Q4742000 * * * * * * * * * END OF ADDRESSABILITY * * * * * * * * * @OZ19494 Q4743000 SPACE 2 @OZ19494 Q4744000 PRINT OFF - SECTION DELETED @OZ19494 Q4745000 * THIS LINE DELETED BY APAR @OZ32776 Q4746000 * THIS LINE DELETED BY APAR @OZ32776 Q4747000 * THIS LINE DELETED BY APAR @OZ32776 Q4748000 * THIS LINE DELETED BY APAR @OZ32776 Q4749000 * THIS LINE DELETED BY APAR @OZ32776 Q4750000 * THIS LINE DELETED BY APAR @OZ32776 Q4751000 * THIS LINE DELETED BY APAR @OZ32776 Q4752000 * THIS LINE DELETED BY APAR @OZ32776 Q4753000 * THIS LINE DELETED BY APAR @OZ32776 Q4754000 * THIS LINE DELETED BY APAR @OZ32776 Q4755000 * THIS LINE DELETED BY APAR @OZ32776 Q4756000 * THIS LINE DELETED BY APAR @OZ32776 Q4757000 * THIS LINE DELETED BY APAR @OZ32776 Q4758000 * THIS LINE DELETED BY APAR @OZ32776 Q4759000 * THIS LINE DELETED BY APAR @OZ32776 Q4760000 * THIS LINE DELETED BY APAR @OZ32776 Q4761000 * THIS LINE DELETED BY APAR @OZ32776 Q4762000 * THIS LINE DELETED BY APAR @OZ32776 Q4763000 * THIS LINE DELETED BY APAR @OZ32776 Q4764000 * THIS LINE DELETED BY APAR @OZ32776 Q4765000 * THIS LINE DELETED BY APAR @OZ32776 Q4766000 * THIS LINE DELETED BY APAR @OZ32776 Q4767000 * THIS LINE DELETED BY APAR @OZ32776 Q4768000 * THIS LINE DELETED BY APAR @OZ32776 Q4769000 * THIS LINE DELETED BY APAR @OZ32776 Q4770000 * THIS LINE DELETED BY APAR @OZ32776 Q4771000 * THIS LINE DELETED BY APAR @OZ32776 Q4772000 * THIS LINE DELETED BY APAR @OZ32776 Q4773000 * THIS LINE DELETED BY APAR @OZ32776 Q4774000 * THIS LINE DELETED BY APAR @OZ32776 Q4775000 * THIS LINE DELETED BY APAR @OZ32776 Q4776200 * THIS LINE DELETED BY APAR @OZ32776 Q4776500 * THIS LINE DELETED BY APAR @OZ32776 Q4776800 * THIS LINE DELETED BY APAR @OZ32776 Q4777000 * THIS LINE DELETED BY APAR @OZ32776 Q4777200 * THIS LINE DELETED BY APAR @OZ32776 Q4777300 * THIS LINE DELETED BY APAR @OZ32776 Q4777500 * THIS LINE DELETED BY APAR @OZ32776 Q4777800 * THIS LINE DELETED BY APAR @OZ32776 Q4777900 * THIS LINE DELETED BY APAR @OZ32776 Q4778000 * THIS LINE DELETED BY APAR @OZ32776 Q4778100 * THIS LINE DELETED BY APAR @OZ32776 Q4778200 * THIS LINE DELETED BY APAR @OZ32776 Q4779000 * THIS LINE DELETED BY APAR @OZ32776 Q4780000 * THIS LINE DELETED BY APAR @OZ32776 Q4781000 * THIS LINE DELETED BY APAR @OZ32776 Q4782000 * THIS LINE DELETED BY APAR @OZ32776 Q4783000 * THIS LINE DELETED BY APAR @OZ32776 Q4784000 * THIS LINE DELETED BY APAR @OZ32776 Q4785000 * THIS LINE DELETED BY APAR @OZ32776 Q4786000 * THIS LINE DELETED BY APAR @OZ32776 Q4787000 * THIS LINE DELETED BY APAR @OZ32776 Q4788000 * THIS LINE DELETED BY APAR @OZ32776 Q4789000 * THIS LINE DELETED BY APAR @OZ32776 Q4790000 * THIS LINE DELETED BY APAR @OZ32776 Q4791000 * THIS LINE DELETED BY APAR @OZ32776 Q4792000 * THIS LINE DELETED BY APAR @OZ32776 Q4793000 * THIS LINE DELETED BY APAR @OZ32776 Q4794000 * THIS LINE DELETED BY APAR @OZ32776 Q4795000 * THIS LINE DELETED BY APAR @OZ32776 Q4796000 * THIS LINE DELETED BY APAR @OZ32776 Q4797000 * THIS LINE DELETED BY APAR @OZ32776 Q4798000 * THIS LINE DELETED BY APAR @OZ32776 Q4799000 * THIS LINE DELETED BY APAR @OZ32776 Q4800000 * THIS LINE DELETED BY APAR @OZ32776 Q4801000 * THIS LINE DELETED BY APAR @OZ32776 Q4802000 * THIS LINE DELETED BY APAR @OZ32776 Q4803000 * THIS LINE DELETED BY APAR @OZ32776 Q4804000 * THIS LINE DELETED BY APAR @OZ32776 Q4805000 * THIS LINE DELETED BY APAR @OZ32776 Q4806000 * THIS LINE DELETED BY APAR @OZ32776 Q4807000 PRINT ON THIS SECTION DELETED BY @OZ32776 Q4808000 TITLE 'HASP PRINT/PUNCH SERVICE -- SEPARATOR PAGE ROUTINE' Q4809000 *********************************************************************** Q4810000 * * Q4811000 * SEPARATOR PAGE ROUTINE * Q4812000 * * Q4813000 *********************************************************************** Q4814000 SPACE 1 R4 Q4815000 USING PRINTID,BASE2 PROVIDE LOCAL ADDRESSABILITY@OZ19494 Q4815100 SPACE 1 @OZ19494 Q4815200 PRINTID PSAVE , SAVE LINKAGE AND BASE REGS @G38ESBB Q4816000 * DELETED @G38ESBB Q4816500 LR BASE2,R15 LOAD BASE REGISTER @OZ19494 Q4817000 L JCT,PJCTBUF PICK UP JCT ADDRESS R4 Q4818000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY Q4819000 ST R1,PCEFORM SAVE ADDRESS OF ID TYPE Q4820000 NI PPFLAG,255-PPDELSW RESET SUSPEND SWITCH Q4821000 CLI PDEVTYPE+3,UCB3800 TEST FOR 3800 PRINTER R4 Q4822000 BNE BLKLCNT BR IF NOT R4 Q4823000 CLI $PRIDCT,0 TEST FOR ZERO LINE COUNT R4 Q4824000 BE PRNOID BR IF YES R4 Q4825000 LM PC1,PC2,PCCWEM SELECT R4 Q4826000 ICM PC1,8,PXTABCCW DEFAULT CHARACTER SET R41 Q4827000 BAL PL,PPPUT2 FOR ID PAGES @OZ51441 Q4828000 BLKLCNT DS 0H R4 Q4829000 SLR PL,PL REMOTE SEPARATOR R4 Q4830000 IC PL,$TPIDCT LINE COUNT R4 Q4831000 TM PCEID,PCELCLID TEST FOR LOCAL PRINTER Q4832000 BZ BLKRMT BRANCH IF NOT LOCAL Q4833000 IC PL,$PRIDCT LOCAL SEPARATOR LINE COUNT R4 Q4834000 BLKRMT DS 0H Q4835000 LTR PL,PL IS LINE COUNT ZERO Q4836000 BZ PRNOID BRANCH IF YES Q4837000 SPACE 1 R41 Q4837100 TM PCEID,PCERJEID TEST PROCESSOR TYPE R41 Q4837300 BZ PBLKTST BR IF NOT REMOTE R41 Q4837500 L R1,PCEDCT ADDRESS PRINTER DCT @OZ32566 Q4837600 TM MDCTFEAT-DCTDSECT(R1),DCTPSHDR IF PTR DOES NOT REQ R41 Q4837700 BNO PBLKTST SETUP HDR, SKIP PDIR R41 Q4837800 MVI PPDIRID,X'01' INDICATE SEPARATOR PDIR R41 Q4837900 ST PL,PPDSRCT USE SEPARATOR LINE CNT FROM HCT R41 Q4838000 LM PC1,PC2,PRCCWEJ LOAD EJECT CCW @OZ58883 Q4838025 BAL PL,PPPUT AND ADD TO CHAIN @OZ58883 Q4838050 L R15,=A(PPDIR) POINT TO SEPARATOR ROUTINE R41 Q4838100 BALR PL,R15 PUT SEPARATOR PDIR R41 Q4838200 L PL,PPDSRCT RESTORE SEPARATOR LINE COUNT R41 Q4838300 EJECT @OZ58883 Q4838350 PBLKTST DS 0H R41 Q4838400 LA R1,BUFSTART-BUFDSECT STARTING LINE DISPLACEMENT R4 Q4838500 CLM PL,1,=AL1(30) AT LEAST 30 LINES REQUESTED Q4839000 BL BLKSKIP BRANCH IF NO Q4840000 MVC PCCWORK,JCTJNAME JOB NAME FROM JOB CARD R4 Q4841000 LA PL,BLKPRT POINT TO BLOCK LETTER ROUTINE R41 Q4845000 BALR PL,PL TO PRINT JOBNAME NON-SLANTED, R41 Q4845100 NOPR 0 CHANGE 'BALR' AND 'NOPR' R41CQ4845200 TO 'BAL PL,0(,PL)' R41 Q4845300 SPACE 1 @OZ58883 Q4846000 LM PC1,PC2,PRCCWSP LOAD SPACE CCW Q4850000 BAL PL,PPPUT ADD CCW TO CHAIN Q4851000 XC PCCWORK,PCCWORK CLEAR WORK AREA Q4852000 MVC PCCWORK(1),JCTJOBID GET JOB TYPE Q4853000 MVC PCCWORK+1(4),JCTJOBID+4 AND JOB NUMBER Q4854000 SKIP490 CLI PCCWORK+1,C' ' LEFT- R4 Q4855000 BNE SKIP480 JUSTIFY R4 Q4856000 MVC PCCWORK+1(4),PCCWORK+2 JOB R4 Q4857000 B SKIP490 NUMBER R4 Q4858000 SKIP480 L PL,PWKJOE ADDRESS WORK-JOE R4 Q4859000 USING JOEDSECT,PL ACTIVATE JOE ADDRESSABILITY R4 Q4860000 MVC PCCWORK+6(1),JOECURCL GET SYSOUT CLASS R4 Q4861000 MVI PCCWORK+7,C' ' SET TRAILING BLANK R4 Q4862000 L R1,PLNDISPL GET NEW LINE DISPLACEMENT R4 Q4863000 LA PL,BLKPRT POINT TO BLOCK LETTER ROUTINE R41 Q4864000 BAL PL,0(,PL) TO PRINT JOBID/CLASS SLANTED, R41CQ4864100 CHANGE 'BAL' TO 'BALR PL,PL' R41CQ4864200 AND 'NOPR 0' R41 Q4864300 SPACE 1 R41 Q4865000 LM PC1,PC2,PRCCWSP LOAD SPACE CCW Q4866000 ICM PC1,8,=X'13' SET CCW TO DOUBLE SPACE Q4867000 BAL PL,PPPUT ADD CCW TO CHAIN Q4868000 L R1,PLNDISPL GET NEW LINE DISPLACEMENT R4 Q4869000 EJECT @OZ58883 Q4869500 BLKSKIP DS 0H Q4870000 LA PC1,0(R1,PBUF) GET NEW LINE BUFFER ADDRESS R4 Q4871000 L R1,PCEFORM ID PAGE TYPE Q4872000 MVC 0(6,PC1),=C'***** ' PP001 FRAME CHARACTERS R4 Q4873000 MVC 6(121,PC1),5(PC1) BLANK MIDDLE OF LINE R4 Q4874000 MVC 128(4,PC1),0(PC1) PP129 FRAME CHARACTERS R4 Q4875000 L PL,PWKJOE ADDRESS WORK-JOE R4 Q4876000 MVC 4(1,PC1),JOECURCL PP005 SYSOUT CLASS R4 Q4877000 MVC 127(1,PC1),JOECURCL PP128 SYSOUT CLASS R4 Q4878000 DROP PL DROP JOE ADDRESSABILITY R4 Q4879000 MVC 7(5,PC1),0(R1) PP008 START/END/CONT R4 Q4880000 MVC 120(5,PC1),0(R1) PP121 START/END/CONT R4 Q4881000 MVC 14(8,PC1),JCTJOBID PP015 JOB NUMBER R4 Q4882000 MVC 110(8,PC1),JCTJOBID PP111 JOB NUMBER R4 Q4883000 MVC 24(8,PC1),JCTJNAME PP025 JOB NAME R4 Q4884000 MVC 100(3,PC1),=C'SYS' PP101 SYS R4 Q4885000 MVC 104(4,PC1),$SID PP105 SYSTEM ID R4 Q4886000 MVC 34(20,PC1),JCTPNAME PP035 PROGRAMMER NAME R4 Q4887000 MVC 56(4,PC1),=C'ROOM' PP057 ROOM R4 Q4888000 MVC 61(4,PC1),JCTROOMN PP062 ROOM NUMBER R4 Q4889000 TIME DEC GET TIME AND DATE Q4890000 L R15,=A(PTIMASK) MOVE EDIT MASK @OZ32776 Q4891000 MVC 67(11,PC1),0(R15) FOR TIME @OZ32776 Q4891500 CL R0,=X'12000000' TEST TIME Q4892000 BL PMORNING BRANCH IF AM Q4893000 MVI 76(PC1),C'P' CHANGE FROM AM TO PM R4 Q4894000 SL R0,=X'12000000' SUBTRACT TWELVE HOURS Q4895000 EJECT R41 Q4895500 PMORNING ST R0,PCCWORK STORE ADJUSTED TIME Q4896000 CLI PCCWORK,X'00' TEST FOR ZERO HOURS Q4897000 BNE *+8 BRANCH IF NOT Q4898000 MVI PCCWORK,X'12' CONVERT ZERO TO TWELVE Q4899000 TM PCCWORK,X'08' TEST FOR ADJUSTMENT ERROR Q4900000 BZ *+8 BRANCH IF NO ERROR Q4901000 NI PCCWORK,X'09' CORRECT FOR BINARY SUBTRACT ERROR Q4902000 ED 66(9,PC1),PCCWORK PP068 HH.MM.SS R4 Q4903000 LA R15,PPDATE CONVERT DATE @OZ19494 Q4904000 BALR R14,R15 TO ' DD MMM YY' @OZ19494 Q4904010 MVC 67+11(10,PC1),PMESSAGE PP080 DAY MONTH YEAR R41 Q4904100 L PL,PCEDCT ADDRESS PRINT DCT @OZ32566 Q4926000 USING DCTDSECT,PL ACTIVATE DCT ADDRESSABILITY Q4927000 MVC 90(8,PC1),DCTDEVN PP091 DEVICE NAME R4 Q4928000 DROP PL SUSPEND DCT ADDRESSABILITY Q4929000 PRIDOUT DS 0H END OF SETUP Q4930000 TM $PRTOPTS,$PRTRANS IF TRANSLATION NOT REQ'D, R4 Q4931000 BZ PRIDNOTR DON'T DO IT @OZ32776 Q4932000 CLC PDEVTYPE+2(2),=AL1(UCB3UREC,UCB3211) LOCAL 3211... R4 Q4933000 BE PRIDNOTR BR IF YES @OZ32776 Q4934000 CLC PDEVTYPE+2(2),=AL1(UCB3UREC,UCB3800) 3800 PRINTER... R4 Q4935000 BE PRIDNOTR BR IF YES @OZ32776 Q4936000 CLC PDEVBYT2(2),=AL1(UCB3UREC,UCB3203) LOCAL 3203 @OZ40627 Q4936100 BE PRIDNOTR BR IF A 3203 @OZ40627 Q4936200 L R15,=A(PTRTBL) TRANSLATE UNPRINTABLES @OZ32776 Q4936500 TR 0(132,PC1),0(R15) TO BLANKS @OZ32776 Q4937000 PRIDNOTR DS 0H @OZ32776 Q4938000 SLR JCT,JCT INITIALIZE LINE COUNT @OZ32776 Q4938500 IC JCT,$TPIDCT FOR REMOTE SEPARATOR R4 Q4939000 TM PCEID,PCELCLID TEST FOR LOCAL PRINT Q4940000 BZ PRIEJECT BRANCH IF NOT LOCAL Q4941000 IC JCT,$PRIDCT LOCAL SEPARATOR LINE COUNT R4 Q4942000 PRIEJECT DS 0H Q4943000 CLM JCT,1,=AL1(30) TEST FOR BLOCK LETTERS USED R4 Q4944000 BL *+8 BRANCH IF NO Q4945000 SH JCT,=H'29' ACCOUNT FOR BLOCK LETTER LINES R4 Q4946000 AL PC1,PRCCWID CONSTRUCT R4 Q4947000 L PC2,PRCCWID+4 PRINT CCW R4 Q4948000 BAL PL,PPPUT ADD CCW TO CHAIN Q4949000 BCT JCT,PPPUT GENERATE SEPARATOR PAGE R4 Q4950000 L JCT,PJCTBUF RELOAD JCT ADDRESS R4 Q4951000 TM PPFLAG,PPNEWS JES2-NEWS AVAILABLE... R41 Q4951200 BO PRNOID SKIP EJECT IF YES R41 Q4951400 LM PC1,PC2,PRCCWEJ LOAD EJECT CCW Q4952000 BAL PL,PPPUT ADD CCW TO CHAIN Q4953000 PRNOID BAL PL,PPWRITE INITIATE WRITE Q4954000 BAL PL,PPCHECK AND CHECK Q4955000 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q4956000 * DELETED @G38ESBB Q4957000 * DELETED @G38ESBB Q4957500 TITLE 'HASP PRINT/PUNCH SERVICE -- BLOCK LETTER ROUTINE' Q4958000 BLKPRT ST PL,PCEFORM+4 SAVE RETURN REGISTER R4 Q4959000 MVC PBLKWORK,PCCWORK SAVE TEXT R4 Q4960000 OC PCCWORK(8),=8X'C0' SHIFT ALL TO 4TH QUADRANT Q4961000 TR PCCWORK(8),BLOCKTR-192 TRANSLATE TO INDEX VALUE Q4962000 SLR R4,R4 LINE 0 OF 12 Q4963000 BLKBLD STH R4,PCEFORM+8 SAVE LINE COUNTER R4 Q4964000 ST R1,PLNDISPL SAVE NEW LINE DISPLACEMENT R4 Q4965000 ALR R1,PBUF GET NEW LINE BUFFER ADDRESS R4 Q4966000 MVI 0(R1),C' ' FILL LINE R4 Q4976000 MVC 1(131,R1),0(R1) WITH BLANKS R4 Q4977000 LA R7,7 SCAN FOR R4 Q4978000 BLKCENTR LA R15,PBLKWORK(R7) LAST R4 Q4979000 CLI 0(R15),C' ' NON- R4 Q4980000 BNE SKIP510 BLANK R4 Q4981000 BCT R7,BLKCENTR CHARACTER R4 Q4982000 SKIP510 LA R7,1(,R7) COMPUTE R4 Q4983000 MH R7,=H'7' BEGINNING R4 Q4984000 SH R7,=H'67' PRINT POSITION R4 Q4985000 LCR R7,R7 TO CENTER R4 Q4986000 LA R5,0(R7,R1) BLOCK LETTERS R4 Q4987000 TM PCEFORM+4,X'80' TEST FOR SLANTING OPTION R4 Q4988000 BO SKIP520 BR IF NO R4 Q4989000 LA R5,6(,R5) ELSE, SLANT R4 Q4990000 SRL R4,1 BLOCK R4 Q4991000 SLR R5,R4 LETTERS R4 Q4992000 SKIP520 SLR R4,R4 SET FOR A LETTER INDEX OF 0 R4 Q4993000 BLKLUP IC R7,PBLKWORK(R4) USE RELATIVE TEXT LETTER R4 Q4994000 STC R7,$POSTSAV TO FORM BLOCK TEXT R4 Q4995000 LA R7,PCCWORK(R4) CURRENT LETTER INDEX Q4996000 SLR R15,R15 CLEAR REGISTER Q4997000 ICM R15,1,0(R7) GET TRANSLATED LETTER INDEX Q4998000 BZ BLKSTOR BRANCH IF INDEX ZERO Q4999000 BCTR R15,0 DECREMENT BY ONE Q5000000 MH R15,=H'24' CONVERT TO DISPLACEMENT Q5001000 AH R15,PCEFORM+8 SELECT FOR LINE WITHIN LETTER Q5002000 LA R15,BLOCKA(R15) LETTER MASK ADDRESS Q5003000 ICM R15,12,0(R15) LETTER MASK BITS Q5004000 BLKSTOR LA R7,12 BLOCK WIDTH OF 12 R4 Q5005000 BLKLOOP ALR R15,R15 SHIFT LEFT AND TEST HIGH BIT R4 Q5006000 BC 12,SKIP530 BRANCH IF OFF R4 Q5007000 MVC 0(1,R5),$POSTSAV OVERSTORE BLANK TO FORM BLOCK R4 Q5008000 SKIP530 LA R5,1(,R5) INCREMENT COL NUMBER Q5009000 BCT R7,BLKLOOP BRANCH TO FILL 12 COL'S Q5010000 LA R5,2(,R5) 2 BLANKS BETWEEN BLOCKS Q5011000 LA R4,1(,R4) STEP TO NEXT LETTER INDEX Q5012000 CL R4,=F'8' HAVE WE DONE 8 BLOCKS Q5013000 BL BLKLUP BRANCH IF NO Q5014000 LM PC1,PC2,PRCCWID GET PRINT CCW Q5018000 ALR PC1,PBUF ADD BUFFER ORIGIN Q5019000 AL PC1,PLNDISPL AND LINE DISPLACEMENT R4 Q5020000 BAL PL,PPPUT ADD CCW TO CHAIN Q5021000 L R1,PLNDISPL GET NEW R4 Q5022000 LA R1,132(,R1) LINE DISPLACEMENT R4 Q5023000 LA R4,132(,R1) CHECK FOR ROOM R4 Q5024000 CH R4,$BUFLENG IN BUFFER R4 Q5025000 BNH SKIP540 BR IF YES R4 Q5026000 BAL PL,PPWRITE FORCE WRITE Q5027000 BAL PL,PPCHECK CHECK WRITE Q5028000 LA R1,BUFSTART-BUFDSECT SET STARTING LINE DISPLACEMENT R4 Q5029000 SKIP540 LH R4,PCEFORM+8 GET LINE COUNTER Q5030000 LA R4,2(,R4) STEP TO NEXT LINE Q5039000 CH R4,=H'24' LAST LINE FINISHED Q5040000 BL BLKBLD BRANCH IF NO Q5044000 ST R1,PLNDISPL SAVE NEW LINE DISPLACEMENT R4 Q5045000 L PL,PCEFORM+4 LOAD RETURN REGISTER Q5046000 BR PL RETURN TO CALLER Q5047000 TITLE 'HASP PRINT/PUNCH SERVICE -- DATE SUBROUTINE' R41 Q5047100 *********************************************************************** Q5047200 * * Q5047300 * PPDATE - SUBROUTINE TO FORMAT THE DATE * Q5047400 * * Q5047500 * INPUT R1 - DATE IN THE FORM 00YYDDDC * Q5047600 * R14 - RETURN ADDRESS @OZ19494 Q5047700 * R15 - ENTRY ADDRESS @OZ19494 Q5047710 * * Q5047800 * OUTPUT @OZ19494 Q5047900 * PMESSAGE - FORMATTED DATE IN THE FORM ' DD MMM YY' * Q5048000 * * Q5048100 *********************************************************************** Q5048200 SPACE 1 R41 Q5048300 USING PPDATE,BASE2 PROVIDE LOCAL ADDRESSABILITY@OZ19494 Q5048350 SPACE 1 @OZ19494 Q5048360 PPDATE LTR R1,R1 VALID DATE... @OZ19494 Q5048400 BZR R14 RETURN IF NO @OZ19494 Q5048500 ST BASE2,PPSAVE2 SAVE PREVIOUS BASE REG @OZ19494 Q5048510 LR BASE2,R15 LOAD BASE REGISTER @OZ19494 Q5048520 ST R1,PCCWORK+4 STORE DATE R41 Q5048600 L PW,=A(PYEARTAB) COPY DATE CONVERSION TABLE @OZ32776 Q5048700 MVC PMONTHS,0(PW) FOR POSSIBLE UPDATE @OZ32776 Q5048750 TM PCCWORK+5,X'01' AJUST R41 Q5048800 BO PTDEDYR TABLE R41 Q5048900 TM PCCWORK+5,X'12' ON R41 Q5049000 BM PTDEDYR LEAP R41 Q5049100 MVI PFEB,29 YEARS R41 Q5049200 SPACE 1 R41 Q5049300 PTDEDYR MVC PMESSAGE+7(3),=X'402120' GET PATTERN R41 Q5049400 ED PMESSAGE+7(3),PCCWORK+5 AND EDIT THE YEAR (YY) R41 Q5049500 XC PCCWORK(6),PCCWORK CLEAR ALL BUT JULIAN DAY R41 Q5049600 SLR R0,R0 CLEAR FOR IC R41 Q5049700 CVB R1,PCCWORK CONVERT TO BINARY DAY R41 Q5049800 LA PW,PMONTHS-4 ADDR OF DATE CONVERSION TABLE R41 Q5049900 SPACE 1 R41 Q5050000 PTDATLUP SLR R1,R0 CONVERT R41 Q5050100 LA PW,4(,PW) JULIAN DAY R41 Q5050200 IC R0,0(,PW) TO R41 Q5050300 CLR R0,R1 STANDARD DAY R41 Q5050400 BL PTDATLUP * (R1) R41 Q5050500 SPACE 1 R41 Q5050600 CVD R1,PCCWORK CONVERT TO DECIMAL DAY R41 Q5050700 MVI PMESSAGE,C' ' CLEAR 1ST BYTE OF AREA R41 Q5050800 UNPK PMESSAGE+1(2),PCCWORK+6(2) PLACE DAY (DD) R41 Q5050900 OI PMESSAGE+2,X'F0' INTO PMESSAGE R41 Q5051000 MVI PMESSAGE+3,C' ' INSERT DELIMITER R41 Q5051100 MVC PMESSAGE+4(3),1(PW) MOVE EBCDIC MONTH (MMM) R41 Q5051200 L BASE2,PPSAVE2 RESTORE PREVIOUS BASE REG @OZ19494 Q5051300 BR R14 AND RETURN TO CALLER @OZ19494 Q5051350 TITLE 'HASP PRINT/PUNCH SERVICE -- MESSAGE AND COMMENT SUBROUTCQ5051400 INES' R4 Q5051500 *********************************************************************** Q5051600 * * Q5051700 * PRMSG/PCOMMENT -- ADD MSG TO OUTPUT AND SEND TO OPER @OZ19494 Q5052000 * * Q5053000 * ENTRY R1 - POINTER TO MSG-ID @OZ19494 Q5053100 * PL - RETURN ADDRESS @OZ48259 Q5053200 * R14 - POINTER TO 12-BYTE MESSAGE TEXT @OZ48259 Q5053300 * R15 - ENTRY ADDRESS @OZ19494 Q5053400 * @OZ19494 Q5053500 *********************************************************************** Q5054000 SPACE 1 R4 Q5055000 USING PRMSG,BASE2 PROVIDE LOCAL ADDRESSABILITY@OZ19494 Q5055100 SPACE 1 @OZ19494 Q5055200 PRMSG DS 0H @OZ48259 Q5055500 PSAVE , SAVE LINK & BASE REGS @OZ48259 Q5056000 LR BASE2,R15 LOAD BASE REGISTER @OZ19494 Q5056100 MVI PMESSAGE,C' ' BLANK OUT R4 Q5057000 MVC PMESSAGE+1(L'PMESSAGE-1),PMESSAGE MESSAGE AREA R4 Q5058000 MVC PMESSAGE(9),0(R1) MOVE IN MESSAGE ID R4 Q5059000 PACK PMSGNO,5(3,R1) SAVE ID IN PACKED FORM R4 Q5060000 L R1,PCEDCT GET DCT ADDRESS @OZ32566 Q5061000 MVC PMESSAGE+9(8),DCTDEVN-DCTDSECT(R1) FILL IN DEV NAME R4 Q5062000 MVC PMESSAGE+17(12),0(R14) MOVE IN MESSAGE TEXT @OZ48259 Q5063000 TM $RUNOPTS,$MSGID IF MESSAGE IDS REQUESTED, R4 Q5064000 BO PRMOUT BR TO INCLUDE MSG ID @OZ19494 Q5065000 MVC PMESSAGE+1(29),PMESSAGE+8 ELSE OVERLAY MSG ID R41 Q5066000 PRMOUT LA R15,PCOMMENT ADD MESSAGE @OZ19494 Q5067000 BALR PL,R15 TO OUTPUT @G38ESBB Q5067100 LA R1,PMESSAGE+7 POINT TO MESSAGE TEXT - 2 R4 Q5068000 TM $RUNOPTS,$MSGID IF MESSAGE IDS REQUESTED, R4 Q5069000 BO SKIP560 BR TO INSERT MESSAGE NUMBER R4 Q5070000 LA R1,PMESSAGE ELSE FIRST UPDATE TEXT ADDRESS R4 Q5071000 SKIP560 MVC 0(2,R1),PMSGNO MOVE PACKED MSG NUMBER TO MSG R4 Q5072000 $WTO (R1),22,ROUTE=$LOG+$UR, INFORM OPERATOR R4CQ5073000 CLASS=$NORMAL,PRI=$ST,JOB=NO R4 Q5074000 PRETURN , RESTORE REGS & RETURN @OZ48259 Q5075000 * THIS LINE DELETED BY APAR OZ48259 @OZ48259 Q5075500 * THIS LINE DELETED BY APAR OZ48259 @OZ48259 Q5076000 EJECT R41 Q5077000 *********************************************************************** Q5077100 * * Q5077200 * PCOMMENT -- ADD MSG TO OUTPUT ONLY @OZ19494 Q5077300 * * Q5077400 * ENTRY PL - RETURN ADDRESS @G38ESBB Q5077410 * R15 - ENTRY ADDRESS @OZ19494 Q5077420 * @OZ19494 Q5077430 *********************************************************************** Q5077500 SPACE 1 R41 Q5077600 USING PCOMMENT,BASE2 PROVIDE LOCAL ADDRESSABILITY@OZ19494 Q5077700 SPACE 1 @OZ19494 Q5077800 PCOMMENT TM PCEID,PCEPUSID TEST PROCESSOR TYPE @OZ19494 Q5078000 BOR PL RETURN IF PUNCH @G38ESBB Q5079000 * DELETED @G38ESBB Q5079500 PSAVE , SAVE LINKAGE AND BASE REGS @G38ESBB Q5080000 LR BASE2,R15 LOAD BASE REGISTER @OZ19494 Q5080500 LM PC1,PC2,PRCCWSP LOAD SPACE CCW Q5081000 ICM PC1,8,=X'13' FORCE DOUBLE SPACING R41 Q5081500 L PW,PPLC INCREMENT R4 Q5082000 LA PW,4(,PW) PAGE R4 Q5083000 ST PW,PPLC LINE COUNT R4 Q5084000 CL PW,PRLINECT COMPARE WITH MAXIMUM R4 Q5085000 BNH PRCOMSP BRANCH IF NOT HIGH Q5086000 LA PW,1 RESET PAGE R4 Q5087000 ST PW,PPLC LINE COUNTER R4 Q5088000 LM PC1,PC2,PRCCWEJ LOAD EJECT CCW Q5089000 SPACE 1 R41 Q5089500 PRCOMSP MVC PBUFSAVA,BUFSTART SAVE BUFFER DATA @OZ42418 Q5090000 MVC BUFSTART(L'PMESSAGE),PMESSAGE MOVE MSG TO BUF @OZ42418 Q5091000 * THIS LINE DELETED BY APAR @OZ42418 Q5092000 BAL PL,PPPUT ADD CCW TO CHAIN @G38ESBB Q5093000 SPACE 1 @G38ESBB Q5093500 LA R1,BUFSTART FIXED-STORAGE PRINT AREA @G38ESBB Q5093700 LM PC1,PC2,PRCCWCOM LOAD PRINT CCW Q5094000 OR PC1,R1 UPDATE DATA-ADDRESS R4 Q5095000 BAL PL,PPPUT ADD CCW TO CHAIN Q5096000 BAL PL,PPWRITE INITIATE WRITE Q5097000 BAL PL,PPCHECK AND CHECK Q5098000 SPACE 1 R41 Q5098300 MVC PMESSAGE,BUFSTART RESTORE MESSAGE @OZ42418 Q5098500 MVC BUFSTART(L'PBUFSAVA),PBUFSAVA RESTORE BUFFER @OZ42418 Q5098700 * THIS LINE DELETED BY APAR @OZ42418 Q5098800 SPACE 1 R41 Q5098900 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q5099000 * DELETED @G38ESBB Q5099500 * DELETED @G38ESBB Q5100000 EJECT @OZ19494 Q5101000 PRINT OFF - SECTION DELETED @OZ19494 Q5102000 * THIS LINE DELETED BY APAR @OZ19494 Q5103000 PRINT ON -- SECTION DELETED @OZ19494 Q5104000 PRINT OFF THIS SECTION DELETED BY @OZ32776 Q5105000 * THIS LINE DELETED BY APAR @OZ32776 Q5106000 * THIS LINE DELETED BY APAR @OZ32776 Q5107000 * THIS LINE DELETED BY APAR @OZ32776 Q5108000 * THIS LINE DELETED BY APAR @OZ32776 Q5109000 * THIS LINE DELETED BY APAR @OZ32776 Q5110000 * THIS LINE DELETED BY APAR @OZ32776 Q5111000 * THIS LINE DELETED BY APAR @OZ32776 Q5112000 * THIS LINE DELETED BY APAR @OZ32776 Q5113000 * THIS LINE DELETED BY APAR @OZ32776 Q5114000 * THIS LINE DELETED BY APAR @OZ32776 Q5115000 * THIS LINE DELETED BY APAR @OZ32776 Q5116000 * THIS LINE DELETED BY APAR @OZ32776 Q5117000 * THIS LINE DELETED BY APAR @OZ32776 Q5117200 * THIS LINE DELETED BY APAR @OZ32776 Q5117400 * THIS LINE DELETED BY APAR @OZ32776 Q5117600 * THIS LINE DELETED BY APAR @OZ32776 Q5117800 * THIS LINE DELETED BY APAR @OZ32776 Q5118000 * THIS LINE DELETED BY APAR @OZ32776 Q5119000 * THIS LINE DELETED BY APAR @OZ32776 Q5120000 PRINT ON THIS SECTION DELETED BY @OZ32776 Q5120100 SPACE 1 @OZ28353 Q5120200 PRINT OFF - SECTION DELETED @OZ19494 Q5122000 * THIS LINE DELETED BY APAR @OZ19494 Q5123000 * THIS LINE DELETED BY APAR @OZ19494 Q5123500 * THIS LINE DELETED BY APAR @OZ19494 Q5124000 * THIS LINE DELETED BY APAR @OZ19494 Q5125000 * THIS LINE DELETED BY APAR @OZ19494 Q5126000 * THIS LINE DELETED BY APAR @OZ19494 Q5127000 * THIS LINE DELETED BY APAR @OZ19494 Q5128000 * THIS LINE DELETED BY APAR @OZ19494 Q5129000 * THIS LINE DELETED BY APAR @OZ19494 Q5130000 * THIS LINE DELETED BY APAR @OZ19494 Q5130500 * THIS LINE DELETED BY APAR @OZ19494 Q5131000 * THIS LINE DELETED BY APAR @OZ19494 Q5132000 * THIS LINE DELETED BY APAR @OZ19494 Q5133000 * THIS LINE DELETED BY APAR @OZ19494 Q5134000 * THIS LINE DELETED BY APAR @OZ19494 Q5134800 * THIS LINE DELETED BY APAR @OZ19494 Q5134900 * THIS LINE DELETED BY APAR @OZ19494 Q5135000 * THIS LINE DELETED BY APAR @OZ19494 Q5136000 * THIS LINE DELETED BY APAR @OZ19494 Q5136100 * THIS LINE DELETED BY APAR @OZ19494 Q5137000 * THIS LINE DELETED BY APAR @OZ19494 Q5138000 * THIS LINE DELETED BY APAR @OZ19494 Q5139000 * THIS LINE DELETED BY APAR @OZ19494 Q5140000 * THIS LINE DELETED BY APAR @OZ19494 Q5141000 * THIS LINE DELETED BY APAR @OZ19494 Q5142000 * THIS LINE DELETED BY APAR @OZ19494 Q5143000 * THIS LINE DELETED BY APAR @OZ19494 Q5143500 * THIS LINE DELETED BY APAR @OZ19494 Q5143600 * THIS LINE DELETED BY APAR @OZ19494 Q5144000 * THIS LINE DELETED BY APAR @OZ19494 Q5145000 * THIS LINE DELETED BY APAR @OZ19494 Q5146000 * THIS LINE DELETED BY APAR @OZ19494 Q5147000 * THIS LINE DELETED BY APAR @OZ19494 Q5148000 * THIS LINE DELETED BY APAR @OZ19494 Q5149000 * THIS LINE DELETED BY APAR @OZ19494 Q5150000 * THIS LINE DELETED BY APAR @OZ19494 Q5150100 * THIS LINE DELETED BY APAR @OZ19494 Q5150150 * THIS LINE DELETED BY APAR @OZ19494 Q5150200 * THIS LINE DELETED BY APAR @OZ19494 Q5151000 * THIS LINE DELETED BY APAR @OZ19494 Q5152000 * THIS LINE DELETED BY APAR @OZ19494 Q5153000 * THIS LINE DELETED BY APAR @OZ19494 Q5154000 * THIS LINE DELETED BY APAR @OZ19494 Q5155000 * THIS LINE DELETED BY APAR @OZ19494 Q5156000 * THIS LINE DELETED BY APAR @OZ19494 Q5157000 * THIS LINE DELETED BY APAR @OZ19494 Q5158000 * THIS LINE DELETED BY APAR @OZ19494 Q5159000 PRINT ON -- SECTION DELETED @OZ19494 Q5160000 PRINT OFF THIS SECTION DELETED BY @OZ32776 Q5161000 * THIS LINE DELETED BY APAR @OZ32776 Q5162000 * THIS LINE DELETED BY APAR @OZ32776 Q5163000 * THIS LINE DELETED BY APAR @OZ32776 Q5164000 * THIS LINE DELETED BY APAR @OZ32776 Q5165000 * THIS LINE DELETED BY APAR @OZ32776 Q5166000 * THIS LINE DELETED BY APAR @OZ32776 Q5167000 * THIS LINE DELETED BY APAR @OZ32776 Q5168000 * THIS LINE DELETED BY APAR @OZ32776 Q5169000 * THIS LINE DELETED BY APAR @OZ32776 Q5170000 * THIS LINE DELETED BY APAR @OZ32776 Q5171000 * THIS LINE DELETED BY APAR @OZ32776 Q5172000 * THIS LINE DELETED BY APAR @OZ32776 Q5173000 * THIS LINE DELETED BY APAR @OZ32776 Q5174000 * THIS LINE DELETED BY APAR @OZ32776 Q5175000 * THIS LINE DELETED BY APAR @OZ32776 Q5176000 * THIS LINE DELETED BY APAR @OZ32776 Q5177000 * THIS LINE DELETED BY APAR @OZ32776 Q5178000 PRINT ON THIS SECTION DELETED BY @OZ32776 Q5179000 TITLE 'HASP PRINT/PUNCH SERVICE -- MISCELLANEOUS TABLES' @OZ19494 Q5179100 *********************************************************************** Q5180000 * * Q5181000 * BLOCK LETTER TABLE * Q5182000 * * Q5183000 *********************************************************************** Q5184000 SPACE 1 R4 Q5185000 BLOCKTR DC X'0001020304050607080900000000000000' Q5186000 DC X'0A0B0C0D0E0F1011120013000000000000' Q5187000 DC X'1415161718191A1B000000000000' Q5188000 DC X'1C1D1E1F202122232425002627000000' Q5189000 SPACE 2 R4 Q5190000 BLOCKA DC X'7FE0FFF0C030C030C030FFF0FFF0C030C030C030C030C030' Q5191000 BLOCKB DC X'FFE0FFF0C030C030C060FFC0FFC0C060C030C030FFF0FFE0' Q5192000 BLOCKC DC X'7FE0FFF0C030C000C000C000C000C000C000C030FFF07FE0' Q5193000 BLOCKD DC X'FF80FFC0C060C030C030C030C030C030C030C060FFC0FF80' Q5194000 BLOCKE DC X'FFF0FFF0C000C000C000FF00FF00C000C000C000FFF0FFF0' Q5195000 BLOCKF DC X'FFF0FFF0C000C000C000FF00FF00C000C000C000C000C000' Q5196000 BLOCKG DC X'7FE0FFF0C030C000C000C000C1F0C1F0C030C030FFF07FE0' Q5197000 BLOCKH DC X'C030C030C030C030C030FFF0FFF0C030C030C030C030C030' Q5198000 BKOCKI DC X'7FE07FE0060006000600060006000600060006007FE07FE0' Q5199000 BLOCKJ DC X'3FF03FF0030003000300030003000300C300C300FF007E00' Q5200000 BLOCKK DC X'C030C060C0C0C180C300FE00FE00C300C180C0C0C060C030' Q5201000 BLOCKL DC X'C000C000C000C000C000C000C000C000C000C000FFF0FFF0' Q5202000 BLOCKM DC X'C030E070F0F0D9B0CF30C630C030C030C030C030C030C030' Q5203000 BLOCKN DC X'C030E030F030D830CC30C630C330C1B0C0F0C070C030C010' Q5204000 BLOCKO DC X'FFF0FFF0C030C030C030C030C030C030C030C030FFF0FFF0' Q5205000 BLOCKP DC X'FFE0FFF0C030C030C030FFF0FFE0C000C000C000C000C000' Q5206000 BLOCKQ DC X'7FE0FFF0C030C030C030C030C030C330C1B0C0F0FFE07FB0' Q5207000 BLOCKR DC X'FFE0FFF0C030C030C030FFF0FFE0C300C180C0C0C060C030' Q5208000 BLOCK$ DC X'06007FE0FFF0C630E6007FC03FE00670C630FFF07FE00600' Q5209000 BLOCKS DC X'7FE0FFF0C030C000E0007FC03FE000700030C030FFF07FE0' Q5210000 BLOCKT DC X'FFF0FFF00600060006000600060006000600060006000600' Q5211000 BLOCKU DC X'C030C030C030C030C030C030C030C030C030C030FFF07FE0' Q5212000 BLOCKV DC X'C030C030C030C030C030C030C030606030C019800F000600' Q5213000 BLOCKW DC X'C030C030C030C030C030C030C630CF30D9B0F0F0E070C030' Q5214000 BLOCKX DC X'C030C030606030C019800F000F00198030C06060C030C030' Q5215000 BLOCKY DC X'C030C030606030C019800F00060006000600060006000600' Q5216000 BLOCKZ DC X'FFF0FFF0006000C001801FC01FC00C00180030007FF0FFF0' Q5217000 BLOCK0 DC X'3FC07FE0C0F0C1B0C330C630CC30D830F030E0307FE03FC0' Q5218000 BLOCK1 DC X'06000E001E0006000600060006000600060006007FE07FE0' Q5219000 BLOCK2 DC X'7FE0FFF0C0300030003000600180060018006000FFF0FFF0' Q5220000 BLOCK3 DC X'7FE0FFF0C0300030003001E001E000300030C030FFF07FE0' Q5221000 BLOCK4 DC X'038007800D80198031807FF0FFF001800180018001800180' Q5222000 BLOCK5 DC X'FFF0FFF0C000C000C000FF80FFC0006000300030FFF0FFE0' Q5223000 BLOCK6 DC X'7FE0FFF0C030C000C000FFE0FFF0C030C030C030FFF07FE0' Q5224000 BLOCK7 DC X'FFF0FFE0C0C0018003000600060006000600060006000600' Q5225000 BLOCK8 DC X'7FE0FFF0C030C03060603FC03FC06060C030C030FFF07FE0' Q5226000 BLOCK9 DC X'7FE0FFF0C030C030C030FFF0FFF000300030C030FFF07FE0' Q5227000 BLOCK# DC X'30C030C0FFF0FFF030C030C030C030C0FFF0FFF030C030C0' Q5228000 BLOCK@ DC X'3FC07FE0C030003000301E303F306330C330C3307FE03FC0' Q5229000 EJECT @OZ32776 Q5229010 ***************************************************************@OZ32776 Q5229020 * @OZ32776 Q5229030 * &PRTRANS TRANSLATE TABLE @OZ32776 Q5229040 * @OZ32776 Q5229050 * TRANSLATE LOWER-CASE TO UPPER-CASE @OZ32776 Q5229060 * TRANSLATE INVALID PN-TRAIN CHARACTERS TO BLANKS @OZ32776 Q5229070 * @OZ32776 Q5229080 ***************************************************************@OZ32776 Q5229090 SPACE 1 @OZ32776 Q5229095 PTRTBL DC C' ' TRANSLATE @OZ32776 Q5229100 DC C' ' TABLE @OZ32776 Q5229110 DC C' .<(+|&& $*);^' USED TO @OZ32776 Q5229120 DC C'-/ ,%_>? :#@''="' TRANSLATE @OZ32776 Q5229130 DC C' ABCDEFGHI JKLMNOPQR ' ALL @OZ32776 Q5229140 DC C' STUVWXYZ 0123456789 ' ILLEGAL @OZ32776 Q5229150 DC C' ABCDEFGHI JKLMNOPQR ' CHARACTERS @OZ32776 Q5229160 DC C' STUVWXYZ 0123456789 ' TO BLANKS @OZ32776 Q5229170 SPACE 5 @OZ32776 Q5229180 ***************************************************************@OZ32776 Q5229190 * @OZ32776 Q5229200 * MISCELLANEOUS CONSTANTS NOT DIRECTLY ADDRESSABLE @OZ32776 Q5229210 * @OZ32776 Q5229220 ***************************************************************@OZ32776 Q5229230 SPACE 1 @OZ32776 Q5229240 PTIMASK DC X'21204B20204B202040C1D4' TIME MASK @OZ32776 Q5229250 PYEARTAB DC AL1(31),C'JAN',AL1(28),C'FEB' JULIAN @OZ32776 Q5229260 DC AL1(31),C'MAR',AL1(30),C'APR' TO DAY @OZ32776 Q5229270 DC AL1(31),C'MAY',AL1(30),C'JUN' AND @OZ32776 Q5229280 DC AL1(31),C'JUL',AL1(31),C'AUG' MONTH @OZ32776 Q5229290 DC AL1(30),C'SEP',AL1(31),C'OCT' CONVERSION @OZ32776 Q5229300 DC AL1(30),C'NOV',AL1(255),C'DEC' TABLE @OZ32776 Q5229310 SPACE 1 @OZ32776 Q5229320 PMONTHS EQU $CSAVREG,12*4 AREA FOR COPY OF ABOVE TABLE@OZ32776 Q5229330 PFEB EQU PMONTHS+4 ENTRY FOR FEBRUARY @OZ32776 Q5229340 SPACE 1 @OZ32776 Q5229350 PASAMCH DC X'400BF18BF013601BF293F39BF4A3F5ABF6B3F7BBF8C3F9CBC1D3C2CQ5229360 DBC3E34E03E541E681000B' ASA TO MACHINE CNVRT @OZ33326 Q5229370 PASANUM EQU (*-PASAMCH)/2 @OZ32776 Q5229380 SPACE 1 @OZ32776 Q5229390 PASAMCH2 DC X'400BF18BF013601BF293F39BF4A3F5ABF6B3F7BBF8C3F9CBC1D3C2CQ5229400 DBC3E34E03E501E641000B' 3525 ASA TO MCH CNVRT @OZ33326 Q5229410 TITLE 'HASP PRINT SERVICE -- PAGE COUNT ROUTINE' @OZ29138 Q5230000 ****************************************************************OZ29138 Q5230010 * *OZ29138 Q5230020 * CALCULATE WHERE THE INTERVENTION REQURIED (PAPER JAM, *OZ29138 Q5230030 * FORMS CHECK, ETC.) OCCURED FOR DATA SET REPOSITIONING *OZ29138 Q5230040 * *OZ29138 Q5230050 ****************************************************************OZ29138 Q5230060 SPACE 3 @OZ29138 Q5230070 PPCNTPGE DS 0H @OZ29138 Q5230080 LR R14,R15 GET SUBROUTINE ENTRY ADDR @OZ29138 Q5230100 SPACE 1 @OZ29138 Q5230110 USING PPCNTPGE,R14 ESTAB. SUBROUTINE BASE @OZ29138 Q5230120 USING DCTDSECT,PW ESTAB. DCT ADDRESSABILITY @OZ29138 Q5230130 SPACE 1 @OZ29138 Q5230140 PPCKIO L R15,POUTIOB GET OUTPUT CCW IOB ADDR @OZ29138 Q5230150 TM BUFECBCC-BUFDSECT(R15),X'7F' I/O COMPLETE... @OZ29138 Q5230160 BNZ PPCKCSW BR IF YES @OZ29138 Q5230170 $WAIT IO WAIT FOR I/O POST @OZ29138 Q5230180 B PPCKIO ENSURE I/O HAS STOPPED @OZ29138 Q5230190 SPACE 1 @OZ29138 Q5230200 * FIND OUT WHICH CCW CHAIN THE CSW BELONGS TO @OZ29138 Q5230210 SPACE 1 @OZ29138 Q5230220 PPCKCSW CLC DCTCSW+1(3),POUTCCWA+1 IS CSW IN ACTIVE AREA... @OZ29138 Q5230230 BNH PNXTCHN BR IF NO, CHECK OTHER @OZ29138 Q5230240 L R1,POUTCCWA GET ACTIVE AREA POINTER @OZ29138 Q5230250 AH R1,PCCWLAST POINT TO THE PCIE, @OZ29138 Q5230260 LA R1,PCIESIZE(,R1) AND THE CCW CHKPT AREA. @OZ29138 Q5230270 CLM R1,7,DCTCSW+1 IS CSW IN ACTIVE AREA... @OZ29138 Q5230280 BNH PNXTCHN BR IF CSW ADDR IS BEYOND END@OZ29138 Q5230290 L R1,POUTCCWA GET START OF CCW CHAIN ADDR @OZ29138 Q5230300 B PFNDEND FIND END OF CCW AREA @OZ29138 Q5230310 PNXTCHN DS 0H @OZ29138 Q5230320 CLC DCTCSW+1(3),POUTCCWN+1 IS IT IN THIS AREA... @OZ29138 Q5230330 BNH PPGERET BR IF NOT THIS AREA EITHER @OZ29138 Q5230340 L R1,POUTCCWN GET NEXT AREA POINTER @OZ29138 Q5230350 AH R1,PCCWLAST POINT TO THE PCIE, @OZ29138 Q5230360 LA R1,PCIESIZE(,R1) AND THE CCW CHKPT AREA. @OZ29138 Q5230370 CLM R1,7,DCTCSW+1 IS CSW IN THIS AREA... @OZ29138 Q5230380 BNH PPGERET BR IF CSW ADDR IS BEYOND END@OZ29138 Q5230390 L R1,POUTCCWN GET START OF CCW CHAIN ADDR @OZ29138 Q5230400 SPACE 1 @OZ29138 Q5230410 * CSW IS VALID, FIND THE END OF THE CCW CHAIN. @OZ29138 Q5230420 SPACE 1 @OZ29138 Q5230430 PFNDEND DS 0H @OZ29138 Q5230440 L R0,DCTCSW GET CSW ADDRESS AND @OZ29138 Q5230450 SH R0,=H'8' DECREMENT BY 8 @OZ29138 Q5230460 LR R15,R1 GET START OF CCW CHAIN @OZ29138 Q5230470 AH R15,PCCWLAST POINT TO THE LAST CCW+8 @OZ29138 Q5230480 LR R2,R1 GET START OF CCW CHAIN @OZ29138 Q5230490 PINCR8 LA R2,8(,R2) INCREMENT BY ONE CCW @OZ29138 Q5230500 CR R15,R2 END OF CHAIN... @OZ29138 Q5230510 BE PFULLCHN BR IF NOT A SHORT CHAIN @OZ29138 Q5230520 CLI 0(R2),X'08' IS CCW A TIC (SHORT CHAIN) @OZ29138 Q5230530 BNE PINCR8 BR IF NO, CHECK NEXT CCW @OZ29138 Q5230540 PFULLCHN DS 0H @OZ29138 Q5230550 SPACE 1 @OZ29138 Q5230560 * COUNT PAGES FROM END OF CCW CHAIN TO THE CSW @OZ29138 Q5230570 SPACE 1 @OZ29138 Q5230580 SLR R15,R15 CLEAR REGISTER FOR COUNT @OZ29138 Q5230590 PCNTPGE DS 0H @OZ29138 Q5230600 CR R2,R0 CCW EQUAL TO INT REQ CCW... @OZ29138 Q5230610 BNH PCHNEND BR IF TOP CONTINUE COUNTING @OZ29138 Q5230620 CLI 0(R2),X'89' IS CCW A CARRIAGE SKIP... @OZ29138 Q5230630 BL *+8 BR IF NO, NOT A PAGE @OZ29138 Q5230640 LA R15,1(,R15) ADD PAGE TO ACCUMULATOR @OZ29138 Q5230650 SH R2,=H'8' DECREMENT TO THE NEXT CCW @OZ29138 Q5230660 B PCNTPGE GO CHECK THE NEXT CCW @OZ29138 Q5230670 SPACE 1 @OZ29138 Q5230680 * END OF PAGE COUNTING, NOW UPDATE PAGE COUNT IN PCE. @OZ29138 Q5230690 SPACE 1 @OZ29138 Q5230700 PCHNEND DS 0H @OZ29138 Q5230710 LNR R15,R15 COMPLEMENT FOR SUBTRACT @OZ29138 Q5230720 AH R1,PCCWLAST POINT TO THE PCIE, @OZ29138 Q5230730 LA R1,PCIESIZE(,R1) AND THE CCW CHKPT AREA. @OZ29138 Q5230740 A R15,JOEPPCT-JOECKPP(,R1) UPDATE FROM JOE CNT @OZ27300 Q5230750 ST R15,PDDBPGCT UPDATE CURRENT PAGE COUNT @OZ29138 Q5230760 SPACE 1 @OZ29138 Q5230770 SLR R1,R1 DOES A @OZ29138 Q5230780 LH R1,$BSPSIZ BACKSPACE @OZ29138 Q5230790 LTR R1,R1 TABLE EXIST... @OZ29138 Q5230800 BZ PPGERET BR IF NO, RETURN @OZ29138 Q5230810 SH R1,=H'7' DECREMENT BY ONE ENTRY @OZ29138 Q5230820 LA R1,PBSPTBL(R1) GET ADDRESS OF LAST ENTRY @OZ29138 Q5230830 XC 0(7,R1),0(R1) INVALIDATE BACKSPACE TABLE @OZ29138 Q5230840 SPACE 1 @OZ29138 Q5230850 PPGERET DS 0H @OZ29138 Q5230860 L PW,PCEDCT REFRESH DCT POINTER @OZ29138 Q5230870 BR PL RETURN TO CALLER @OZ29138 Q5230880 SPACE 1 @OZ29138 Q5230890 DROP PW,R14 @OZ29138 Q5230900 TITLE 'HASP PRINT/PUNCH SERVICE -- TYPE 6 SMF RECORD' @OZ32776 Q5240000 ***************************************************************@OZ32776 Q5240010 * @OZ32776 Q5240020 * PPSMF6 -- SUBROUTINE TO GENERATE TYPE 6 SMF RECORD @OZ32776 Q5240030 * @OZ32776 Q5240040 * PL - RETURN ADDRESS (HI-BIT ON MEANS DON'T $QUESMFB) @OZ34616 Q5240050 * R15 - ENTRY ADDRESS @OZ32776 Q5240060 * @OZ32776 Q5240070 ***************************************************************@OZ32776 Q5240080 SPACE 1 @OZ32776 Q5240090 USING SMFDSECT,R1 PROVIDE SMF ADDRESSABILITY @OZ32776 Q5240400 USING JCTDSECT,JCT PROVIDE JCT ADDRESSABILITY @OZ32776 Q5240600 USING PPSMF6,BASE2 PROVIDE LOCAL ADDR'BILITY @OZ32776 Q5240800 SPACE 1 @OZ32776 Q5241000 PPSMF6 DS 0H @OZ32776 Q5241200 PSAVE ALL SAVE CALLER'S REGISTERS @OZ53654 Q5241400 * DELETED @G38ESBB Q5241600 LR BASE2,R15 LOAD BASE REGISTER @OZ32776 Q5241800 L R1,PPSMFBUF OBTAIN FINAL TYPE 6 @OZ34616 Q5241850 LTR R1,R1 SMF RECORD BUFFER @OZ34616 Q5241900 BNZ PPSMF6Q BR IF NO RECORD AVAILABLE @OZ34616 Q5241950 CLI $NUMSMFB,2 TEST SMF BUFFER COUNT @OZ32776 Q5242000 BL PPSMFRET RETURN IF SMF NOT SUPPORTED @OZ32776 Q5242200 L JCT,PJCTBUF ADDRESS JCT BUFFER @OZ32776 Q5242400 TM JCTSMFLG,JCTNOTY6 SHOULD TYPE 6 BE BYPASSED...@OZ32776 Q5242600 BO PPSMFRET RETURN IF YES @OZ32776 Q5242800 SPACE 1 @OZ32776 Q5243000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q5243020 BNE PPSMFGT NO, GO GET WITH WAIT=YES @G38ESBB Q5243040 $GETSMFB WAIT=NO GET AN SMF BUFFER @G38ESBB Q5243060 BNZ PPSMFBLD BRANCH IF SUCCESSFUL @G38ESBB Q5243080 LM PC1,PC2,PCCWCP ISSUE CLEARPRINT CCW @G38ESBB Q5243100 BAL PL,PPPUT TO TRY TO FORCE @G38ESBB Q5243120 BAL PL,PPWRITE FREEING OF AN @G38ESBB Q5243140 BAL PL,PPCHECK SMF BUFFER @G38ESBB Q5243160 SPACE 1 @G38ESBB Q5243180 PPSMFGT $GETSMFB WAIT=YES GET AN SMF BUFFER @G38ESBB Q5243200 ST R1,PPSMFBUF SAVE SMF BUFFER ADDRESS @OZ34616 Q5243250 SPACE 1 @OZ32776 Q5243400 ***************************************************************@OZ32776 Q5243600 * @OZ32776 Q5243800 * BUILD BASE SECTION @OZ32776 Q5244000 * @OZ32776 Q5244200 ***************************************************************@OZ32776 Q5244400 SPACE 1 @G38ESBB Q5244500 PPSMFBLD XC SMFRDW+2(SMF6END1-SMFRDW-2),SMFRDW+2 CLEAR REC @G38ESBB Q5244600 MVC SMF6JBN,JCTJMRJN JOBNAME -JBN @OZ32776 Q5244800 MVC SMF6RST(8),JCTRDRON RDR START TIME/DATE -RST/D@OZ32776 Q5245000 MVC SMF6UIF,JCTUSEID USER ID -UIF @OZ32776 Q5245200 MVC SMF6JNM,JCTJOBID+4 JOB NUMBER -JNM @OZ32776 Q5245400 SPACE 1 @OZ32776 Q5245600 L PW,PWKJOE CURRENT @OZ32776 Q5245800 USING JOEDSECT,PW SYSOUT @OZ32776 Q5246000 MVC SMF6OWC,JOECURCL CLASS -OWC @OZ32776 Q5246200 SPACE 1 @OZ32776 Q5246400 L PW,PCEDCT PROVIDE DCT @OZ32566 Q5246600 USING DCTDSECT,PW ADDRESSABILITY @OZ32776 Q5246800 MVC SMF6FMN,DCTFORMS FORMS ID -FMN @OZ32776 Q5247000 MVC SMF6OUT,DCTDEVN OUTPUT DEVICE NAME -OUT @OZ32776 Q5247200 MVC SMF6FCB,DCTFCB FCB ID -FCB @OZ32776 Q5247400 MVC SMF6UCS,DCTUCS UCS ID -UCS @OZ32776 Q5247600 SPACE 1 @OZ32776 Q5247800 MVC SMF6WST(8),PTIMEON PRPU START TIME/DATE -WST/D@OZ32776 Q5248000 MVC SMF6NLR,PPLNCDCT TOTAL RECORD COUNT -NLR @OZ32776 Q5248200 MVC SMF6PGE,PRPAGECT TOTAL PAGE COUNT -PGE @OZ32776 Q5248400 MVC SMF6NDS,PPJNDS DATA SET COUNT -NDS @OZ32776 Q5248600 MVC SMF6DCI(1),PSMFDCI CONTROL INDICATORS -DCI @OZ32776 Q5248800 TM PPFLAG2,PSMFDSER IF DATA @OZ32776 Q5249000 BZ SKIP440 BUFFER ERROR... @OZ32776 Q5249200 OI SMF6IOE,SMFDSER SET SMF IOE FLAG -DSER @OZ32776 Q5249400 SKIP440 TM PPFLAG,PPJCTIOT IF CONTROL @OZ32776 Q5249600 BNO SKIP450 BUFFER ERROR... @OZ32776 Q5249800 OI SMF6IOE,SMFCBER SET SMF IOE FLAG -CBER @OZ32776 Q5250000 EJECT @OZ32776 Q5250200 ***************************************************************@OZ32776 Q5250400 * @OZ32776 Q5250600 * BUILD JES2-ONLY SECTION @OZ32776 Q5250800 * @OZ32776 Q5251000 ***************************************************************@OZ32776 Q5251200 SPACE 1 @OZ32776 Q5251400 SKIP450 MVC SMF6RTE,DCTNO DEVICE ROUTE CODE -RTE @OZ32776 Q5251600 SPACE 1 @OZ32776 Q5251800 LA PC1,SMF6END1-SMF6LN1 LENGTH OF BASE @OZ32776 Q5252000 STH PC1,SMF6LN1 AND JES2-ONLY SECT. -LN1 @OZ32776 Q5252200 LA LINK,SMF6END1-SMFRDW TOTAL LENGTH, SO FAR @OZ32776 Q5252400 SPACE 1 @OZ32776 Q5252600 ***************************************************************@OZ32776 Q5252800 * @OZ32776 Q5253000 * BUILD NON-IMPACT (3800) PRINTER SECTION @OZ32776 Q5253200 * @OZ32776 Q5253400 ***************************************************************@OZ32776 Q5253600 SPACE 1 @OZ32776 Q5253800 CLI PDEVTYPE+3,UCB3800 NON-IMPACT PRINTER... @OZ32776 Q5254000 BNE PPSMF6A BR IF NOT @OZ32776 Q5254200 SPACE 1 @OZ32776 Q5254400 LA PC1,SMF6LN1(PC1) PROVIDE NON-IMPACT PRINTER @OZ32776 Q5254600 USING SMF6NIPX,PC1 SECTION ADDRESSABILITY @OZ32776 Q5254800 SPACE 1 @OZ32776 Q5255000 MVC SMF6CPS,PCOPYGRP COPY GROUPS -CPS @OZ32776 Q5255200 MVC SMF6CHR(4*4),DCTCHAR1 MOVE CHARS, -CHR @OZ32776 Q5255400 MVC SMF6MID,DCTMODF MODIFY, AND -MID @OZ32776 Q5255600 MVC SMF6FLI,DCTFLASH FLASH TO TYPE 6 -FLI @OZ32776 Q5255800 LA R15,SMF6CHR POINT TO SMF FIELDS @OZ32776 Q5256000 LA R0,4+1+1 CHAR1,2,3,4, MODIFY, FLASH @OZ32776 Q5256200 SPACE 1 @OZ32776 Q5256400 PPSMFLUP CLC 0(4,R15),=C'****' TEST FOR NULL @OZ32776 Q5256600 BNE *+10 LEAVE VALUE IF NO @OZ32776 Q5256800 MVC 0(4,R15),=C' ' ELSE MOVE IN BLANKS @OZ32776 Q5257000 LA R15,4(,R15) INCR SMF FIELD ADDR @OZ32776 Q5257200 BCT R0,PPSMFLUP CHECK ALL VALUES @OZ32776 Q5257400 * THIS LINE DELETED BY APAR NUMBER @OZ32776 Q5257600 CLC SMF6FLI,=C' ' IF NOT FLASHING @OZ33895 Q5257700 BE PPSMFBST DON'T SET FLASH COUNT @OZ33895 Q5257750 MVC SMF6FLC,PFLASHC COPY FLASH COUNT -FLC @OZ32776 Q5257800 CLC PFLASHC,PPDSCPY IF FLASH COUNT IS GREATER @OZ33895 Q5257850 BNH PPSMFBST THAN COPY COUNT, @OZ33895 Q5257900 MVC SMF6FLC,PPDSCPY SET IT EQUAL TO COPIES @OZ33895 Q5257950 PPSMFBST DS 0H @OZ33895 Q5257975 TM DCTPPSW2,DCTNIBRS SET @OZ32776 Q5258000 BZ SKIP460 BURST OR @OZ32776 Q5258200 OI SMF6BID,SMF6BTS NOBURST -BTS @OZ32776 Q5258400 SKIP460 TM PPFLAG2,PPOPTJ SET @OZ32776 Q5258600 BZ SKIP470 DCB=OPTCD=J @OZ32776 Q5258800 OI SMF6BID,SMF6OPJ SPECIFICATION -OPJ @OZ32776 Q5259000 SPACE 1 @OZ32776 Q5259200 SKIP470 LA R0,SMF6END2-SMF6LN2 LENGTH OF NON- @OZ32776 Q5259400 STH R0,SMF6LN2 IMPACT PRINTER SECT. -LN2 @OZ32776 Q5259600 OI SMF6IND,SMF6FEXT SHOW SECTION EXISTS -IND @OZ32776 Q5259800 LA LINK,SMF6END1-SMFRDW+SMF6END2-SMF6NIPX NEW LEN @OZ32776 Q5260000 SPACE 1 @OZ32776 Q5260200 DROP PC1 SUSPEND EXTENSION ADDRESSABILITY @OZ32776 Q5260400 EJECT @OZ32776 Q5260600 ***************************************************************@OZ32776 Q5260800 * @OZ32776 Q5261000 * SET HEADER INFORMATION AND QUEUE SMF BUFFER FOR WRITE @OZ32776 Q5261200 * @OZ32776 Q5261400 ***************************************************************@OZ32776 Q5261600 SPACE 1 @OZ32776 Q5261800 PPSMF6A DS 0H @OZ32776 Q5262000 STH LINK,SMFRDW TOTAL RECORD LENGTH -RDW @OZ32776 Q5262200 MVI SMF6SBS+1,2 JES2 SUBSYSTEM ID -SBS @OZ32776 Q5262400 MVI SMFHDRTY,SMFOUTTP SET RECORD ID TO 6 -HDRTY@OZ32776 Q5262600 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q5262620 BE PPSMFNIP YES, BYPASS WRITING RECORD @G38ESBB Q5262640 L PL,PPLSAVE SHOULD THIS SUBROUTINE @OZ34616 Q5262650 LTR PL,PL QUEUE THE RECORD... @OZ34616 Q5262700 BM PPSMFRET BR IF NO @OZ34616 Q5262750 SPACE 1 @G38ESBB Q5262780 PPSMF6Q MVC PPSMFBUF,$ZEROS ELSE CLEAR BUFFER POINTER @OZ34616 Q5262800 $QUESMFB QUEUE TYPE 6 FOR WRITE @OZ32776 Q5263000 SPACE 1 @G38ESBB Q5263200 PPSMFRET PRETURN RESTORE REGS AND RETURN @G38ESBB Q5263400 BR PL AND RETURN TO CALLER @OZ32776 Q5263600 SPACE 1 @OZ32776 Q5263800 PPSMFNIP ST R1,PPSMFBUF SAVE SMF BUFFER ADDRESS @G38ESBB Q5263810 SPACE 1 @OZ46856 Q5263820 PGETPQES L PW,PQHADR ADDRESS PQH @OZ46856 Q5263830 NI PQHAFLAG-PQHDSECT(PW),FF-PQHALOC RESET FLAG @OZ48003 Q5263835 L R15,=A(PADDPQE) CALL SUBROUTINE TO @OZ48003 Q5263840 BALR PL,R15 ALLOCATE A PQE @OZ48003 Q5263845 BNZ PGOTPQES BRANCH IF SUCCESSFUL @G38ESBB Q5263850 SPACE 1 @OZ48003 Q5263860 L R1,PPSMFBUF ADDRESS SMF BUFFER @OZ48003 Q5263870 MVC PPSMFBUF,$ZEROS CLEAR BUFFER ADDRESS @OZ48003 Q5263880 BAL LINK,PFRESMFB FREE SMF BUFFER @OZ48003 Q5263890 B PPSMFRET AND RETURN @OZ48003 Q5263900 SPACE 1 @G38ESBB Q5263910 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q5263920 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q5263930 SPACE 1 @G38ESBB Q5263940 PGOTPQES MVC PQESBUF,PPSMFBUF SAVE SMF BUF ADR IN PQE @G38ESBB Q5263950 MVC PPSMFBUF,$ZEROS CLEAR SMF BUFFER ADDRESS @G38ESBB Q5263960 MVI PQETYPE,PQES INDICATE SMF TYPE 6 PQE @G38ESBB Q5263970 L PC1,PQEPREV GET PREVIOUS PQEC @G38ESBB Q5263980 MVC PQECPGID(L'PQECPGID+L'PQERPGID+L'PQEFCBLN),PQECPGID-PQEDCQ5263985 SECT(PC1) SET ID'S FROM LAST PAGE PQE @G38ESBB Q5263990 B PPSMFRET GO RETURN @G38ESBB Q5263995 DROP PW,R1 DROP PQH,PQE ADDRESSABILITY @G38ESBB Q5264000 TITLE 'HASP PRINT/PUNCH SERVICE -- PDIR SUBROUTINE' R41 Q5268500 *********************************************************************** Q5268600 * * Q5268700 * BUILD AND TPPUT A REMOTE SETUP HEADER (PDIR) * Q5268800 * * Q5268900 *********************************************************************** Q5269000 SPACE 1 R41 Q5269100 PPDIR DS 0H REMOTE SETUP HEADER R41 Q5269200 USING PPDIR,BASE2 ESTABLISH ADDRESSABILITY R41 Q5269300 ST BASE2,PDSVSAVE SAVE OLD BASE2 R41 Q5269400 ST PL,PPLSAVE SAVE RETURN R41 Q5269500 LR BASE2,R15 LOAD BASE REGISTER R41 Q5269600 USING FMHDSECT-(BUFSTART-BUFDSECT),PBUF ADDRESSABILITY R41 Q5269700 MVI FMHLNGTH,FMHPDLPP LENGTH OF PDIR TO BE SENT R41 Q5269800 MVI FMHBYTE1,FMHTYPE2 SET PDIR TYPE INDICATOR R41 Q5269900 MVI FMHSEL,1 SET SELECTION INDICATOR R41 Q5270000 MVC FMHPDRID,PPDIRID SET PDIR IDENTIFIER R41 Q5270100 SPACE 1 R41 Q5270200 PPDDATE MVC FMHPDATE,=C'00/00/00' SET DEFAULT DATE R41 Q5270300 LA LINK,PTIMEON POINT TO PRINT TIME AND DATE R41 Q5270400 PPDEXDA UNPK FMHPDATE+6(3),5(2,LINK) PUT YEAR IN PDIR R41 Q5270500 ZAP PCCWORK(8),4(4,LINK) CONVERT R41 Q5270600 SRP PCCWORK,64-3,0 YEAR R41 Q5270700 CVB R1,PCCWORK TO BINARY R41 Q5270800 L PW,=A(PYEARTAB) COPY DATA CONVERSION TABLE @OZ32776 Q5270900 MVC PMONTHS,0(PW) FOR POSSIBLE UPDATE @OZ32776 Q5270950 SLR R0,R0 CLEAR REGISTER R41 Q5271000 LA R0,3 PREPARE TEST FOR LEAP YEAR R41 Q5271100 NR R0,R1 IF NOT LEAP YEAR R41 Q5271200 BNZ PPDCONV USE TABLE AS IS R41 Q5271300 MVI PFEB,29 SET TABLE FOR LEAP YEAR R41 Q5271400 PPDCONV ZAP PCCWORK(8),6(2,LINK) CONVERT MONTH AND R41 Q5271500 CVB R1,PCCWORK DAY TO BINARY R41 Q5271600 SLR R0,R0 CLEAR REGISTER R41 Q5271700 LA PW,PMONTHS-4 PREPARE TO SCAN CONVERSION TABLE R41 Q5271800 LA PC1,0 START WITH MONTH 0 R41 Q5271900 PPDDTLP LA PC1,1(,PC1) INCREMENT MONTH R41 Q5272000 SR R1,R0 CONVERT R41 Q5272100 LA PW,4(,PW) FROM JULIAN R41 Q5272200 IC R0,0(,PW) DATE TO R41 Q5272300 CLR R0,R1 MONTH R41 Q5272400 BL PPDDTLP AND DAY R41 Q5272500 CVD PC1,PCCWORK PREPARE MONTH R41 Q5272600 UNPK FMHPDATE(2),PCCWORK+6(2) PUT MONTH IN PDIR R41 Q5272700 OI FMHPDATE+1,X'F0' MAKE LAST CHARACTER PRINTABLE R41 Q5272800 CVD R1,PCCWORK PREPARE DAY R41 Q5272900 UNPK FMHPDATE+3(2),PCCWORK+6(2) PUT DAY IN PDIR R41 Q5273000 OI FMHPDATE+4,X'F0' MAKE LAST CHARACTER PRINTABLE R41 Q5273100 SPACE 1 R41 Q5273200 PPDTIME MVC FMHPDTIM,=C'00.00.00' SET DEFAULT TIME R41 Q5273300 L PC2,0(,LINK) PREPARE TIME R41 Q5273400 SLR PC1,PC1 FOR DIVISION R41 Q5273500 D PC1,=A(60*60*100) CALCULATE HOURS R41 Q5273600 CVD PC2,PCCWORK PREPARE HOURS R41 Q5273700 UNPK FMHPDTIM(2),PCCWORK+6(2) PUT HOURS IN PDIR R41 Q5273800 OI FMHPDTIM+1,X'F0' MAKE UNITS DIGIT PRINTABLE R41 Q5273900 SRDL PC1,32 PREPARE REMAINDER FOR DIVISION R41 Q5274000 D PC1,=A(60*100) CALCULATE MINUTES R41 Q5274100 CVD PC2,PCCWORK PREPARE MINUTES R41 Q5274200 UNPK FMHPDTIM+3(2),PCCWORK+6(2) PUT MINUTES IN PDIR R41 Q5274300 OI FMHPDTIM+4,X'F0' MAKE UNITS DIGIT PRINTABLE R41 Q5274400 CVD PC1,PCCWORK PREPARE SECONDS R41 Q5274500 UNPK FMHPDTIM+6(4),PCCWORK+5(3) PUT SECONDS IN PDIR R41 Q5274600 SPACE 1 R41 Q5274700 PPDFROMS MVI FMHPDFRM,C' ' CLEAR REST OF PDIR R41 Q5274800 MVC FMHPDFRM+1(FMHPDEND-FMHPDFRM-1),FMHPDFRM R41 Q5274900 L R1,PCEDCT ADDRESS PRINTER DCT @OZ32566 Q5275000 USING DCTDSECT,R1 R41 Q5275100 MVC FMHPDFRM(4),DCTFORMS PUT FORMS IN PDIR R41 Q5275200 SPACE 1 R41 Q5275300 PPDFCB MVC FMHPDFCB(4),DCTFCB PUT FCB NAME IN PDIR R41 Q5275400 SPACE 1 R41 Q5275500 PPDTRAIN MVC FMHPDUCS(4),DCTUCS PUT UCS NAME IN PDIR R41 Q5275600 SPACE 1 R41 Q5275700 DROP R1 R41 Q5275800 SPACE 1 R41 Q5275900 L R1,PPDSRCT CONVERT RECORD COUNT R41 Q5276000 CVD R1,PCCWORK TO DECIMAL R41 Q5276100 MVC FMHPDCNT,=X'4020202020202120' AND EDIT R41 Q5276200 ED FMHPDCNT,PCCWORK+4 INTO PDIR R41 Q5276300 SPACE 1 R41 Q5276400 L JCT,PJCTBUF ASSURE JCT ADDRESSABILITY @OZ56508 Q5276450 MVC FMHPDJOB,JCTJNAME SET JOBNAME IN PDIR R41 Q5276500 SPACE 1 R41 Q5276600 SLR PW,PW COMPUTE R41 Q5276700 SLR R1,R1 NUMBER R41 Q5276800 CLI PPDIRID,X'01' OF R41 Q5276900 BE PPDCOPY REMAINING R41 Q5277000 IC PW,PPDSCPY COPIES R41 Q5277100 IC R1,PPRCPYCT MINUS R41 Q5277200 SLR PW,R1 ONE R41 Q5277300 BCTR PW,0 = ADDTIONAL COPIES R41 Q5277400 SPACE 1 R41 Q5277500 PPDCOPY CVD PW,PCCWORK CONVERT COPY COUNT TO DECIMAL R41 Q5277600 MVC FMHPDCPY+2(6),=X'402020202120' SET EDIT PATTERN R41 Q5277700 ED FMHPDCPY+2(6),PCCWORK+5 EDIT COUNT INTO PDIR R41 Q5277800 SPACE 1 R41 Q5277900 PPDPUT LM PC1,PC2,PDIRCCW INITIALIZE R41 Q5278000 ALR PC1,PBUF OUTPUT R41 Q5278100 STM PC1,PC2,POUTCCWA CCW R41 Q5278200 LA R0,POUTCCWA PICK UP ADDRESS OF CCW R41 Q5278300 L R1,PCEDCT PICK UP DCT ADDRESS @OZ32566 Q5278400 $EXTP PUT,(R1),(R0) PASS CCW TO RTAM R41 Q5278500 BNM PPDEXIT BR IF PDIR ACCEPTED R41 Q5278600 SPACE 1 R41 Q5278700 LA PW,0 ELIMINATE PDIR ADDITIONAL COPIES R41 Q5278800 B PPDCOPY AND RESEND PDIR R41 Q5278900 SPACE 1 R41 Q5279000 SPACE 1 R41 Q5279100 PPDEXIT SLR R1,R1 DECREMENT R41 Q5279200 IC R1,PPDSCPY REMAINING R41 Q5279300 SLR R1,PW NUMBER R41 Q5279400 STC R1,PPDSCPY OF COPIES R41 Q5279500 L BASE2,PDSVSAVE RESTORE BASE2 R41 Q5279600 L PL,PPLSAVE RESET RETURN REGISTER R41 Q5279700 BR PL RETURN R41 Q5279800 SPACE 3 R41 Q5279900 FMHPDLPP EQU FMHPDSTP-FMHDSECT LENGTH OF PDIR SENT BY HASPPRPU R41 Q5280000 SPACE 3 R41 Q5280100 USING BUFDSECT,PBUF RE-ESTABLISH ADDRESSABILITY R41 Q5280200 EJECT R41 Q5280300 LTORG SETUP HEADER LITERAL POOL R41 Q5280400 TITLE 'HASP PRINT/PUNCH SERVICE -- DEVICE SETUP VERIFICATION' Q5280500 *********************************************************************** Q5280600 * * Q5280700 * DEVICE SETUP/VERIFICATION FOR PUNCHES AND IMPACT PRINTERS * Q5280800 * * Q5280900 * PL - RETURN ADDRESS * Q5281000 * * Q5281100 *********************************************************************** Q5281200 SPACE 1 R4 Q5281300 PRPUDSV DS 0H R4 Q5281400 PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q5281500 LR BASE2,R15 SETUP LOCAL R4 Q5281600 USING PRPUDSV,BASE2 ADDRESSABILITY R4 Q5281700 CLI PDEVTYPE+3,UCB3800 TEST FOR NON-IMPACT PRINTER R4 Q5282000 BNE DSVJCT BRANCH IF NOT @G38ESBB Q5283000 L R15,=A(P3800DSV) ELSE, GO TO 3800 R4 Q5284000 B P3800DS DEVICE SETUP VERIFICATION R4 Q5285000 SPACE 1 R4 Q5286000 *********************************************************************** Q5287000 * * Q5288000 * DETERMINE IF AN OPERATOR MESSAGE IS NECESSARY * Q5289000 * * Q5290000 *********************************************************************** Q5291000 SPACE 1 R4 Q5292000 DSVJCT DS 0H @G38ESBB Q5293000 L JCT,PJCTBUF ADDRESS JCT BUFFER R4 Q5294000 USING JCTDSECT,JCT ACTIVATE JCT ADDRESSABILITY R4 Q5295000 LR PL,R1 COPY PARAMETER REGISTER R4 Q5296000 L PC1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ32566 Q5297000 STCM PC1,7,BUFDCT+1 ENSURE CORRECT DCT ADDR IN BUFFER R4 Q5298000 USING DCTDSECT,PC1 ACTIVATE DCT ADDRESSABILITY R4 Q5299000 NI DCTPPSW,255-DCTPPSWO RESET OPERATOR $T ALLOWED R4 Q5300000 MVC PCEFORM(12),DCTFORMS SAVE CURRENT DEVICE SETUP R4 Q5301000 TM DCTPPSW2,DCTNINIT IF DEVICE DOES NOT NEED @OZ32311 Q5301100 BZ DSVFORM INITIALIZATION, BRANCH @OZ32311 Q5301200 NI DCTPPSW2,255-DCTNINIT RESET INITIALIZ. FLAG @OZ32311 Q5301300 TM DCTPPSW,DCTPPSWF OPERATOR FORM MODE ? @OZ40515 Q5301310 BO DSVOPMD YES..NO OPERATOR ACTION @OZ40515 Q5301320 OI DCTPPSW,DCTPPSWC+DCTPPSWT+DCTPPSWO SETUP FLAGS @OZ32311 Q5301400 DSVOPMD OI DCTPPSW,DCTPPSWC+DCTPPSWT SETUP FLAGS @OZ40515 Q5301410 SPACE 1 R4 Q5302000 *********************************************************************** Q5303000 * * Q5304000 * CHECK FORMS * Q5305000 * * Q5306000 *********************************************************************** Q5307000 SPACE 1 R4 Q5308000 DSVFORM DS 0H R4 Q5309000 CLC DCTFORMS,0(PL) FORMS CHANGE R4 Q5310000 BE DSVFCB BRANCH IF NO R4 Q5311000 OI DCTPPSW,DCTPPSWO SET OPERATOR $T ALLOWED R4 Q5312000 MVC DCTFORMS,0(PL) NEW FORMS ID TO DCT R4 Q5313000 EJECT @G38ESBB Q5314000 *********************************************************************** Q5315000 * * Q5316000 * CHECK FCB AND INDEX * Q5317000 * * Q5318000 *********************************************************************** Q5319000 SPACE 1 R4 Q5320000 DSVFCB DS 0H R4 Q5321000 TM PCEID,PCEPUSID IS THIS A PUNCH PROCESSOR R4 Q5322000 BO DSVMSG BRANCH IF YES R4 Q5323000 TM PRINDEX,X'C0' WAS AN INDEX VALUE SUPPLIED R4 Q5324000 BZ SKIP580 BRANCH IF NO - AVOID RELOAD R4 Q5325000 CLC PRINDEX,DCTINDEX DOES NEW INDEX = OLD R4 Q5326000 SKIP580 BE *+8 BRANCH IF YES - AVOID RELOAD R4 Q5327000 OI DCTPPSW,DCTPPSWC SET FCB LOAD REQUIRED SW R4 Q5328000 CLC DCTFCB,4(PL) FCB CHANGE R4 Q5329000 BE DSVUCSB BRANCH IF NO R4 Q5330000 CLC 4(4,PL),=CL4'****' IS STANDARD FCB REQUESTED R4 Q5331000 BNE DSVFCB05 BRANCH IF NO R4 Q5332000 TM DCTPPSW,DCTPPSWB IS DEVICE FCB STANDARD R4 Q5333000 BZ DSVUCSB BRANCH IF YES R4 Q5334000 CLC DCTFCB,$PRTFCB IF INSTALLATION DEFAULT IS R4 Q5335000 BNE DSVFCB05 CURRENTLY LOADED, R4 Q5336000 NI DCTPPSW,X'FF'-DCTPPSWB RESET 'NON-STD' BIT R4 Q5337000 B DSVUCSB AND BRANCH TO TEST UCS R4 Q5338000 SPACE 1 R4 Q5339000 DSVFCB05 DS 0H R4 Q5340000 OI DCTPPSW,DCTPPSWB+DCTPPSWC NON-STD+CARRIAGE LOAD R4 Q5341000 L R0,4(,PL) PICK UP REQUESTED FCB R4 Q5342000 CL R0,=CL4'****' CHECK FOR DEFAULT SPECIFICATION R4 Q5343000 BNE SKIP590 SKIP IF NOT R4 Q5344000 L R0,$PRTFCB REPLACE WITH DEFAULT NAME R4 Q5345000 NI DCTPPSW,X'FF'-DCTPPSWB RESET 'NON-STANDARD' BIT R4 Q5346000 SKIP590 ST R0,DCTFCB STORE FCB ID IN DCT R4 Q5347000 CLI PDEVBYT3,UCB1403 IS DEVICE 1403 @OZ40627 Q5348000 BNE DSVUCSB BRANCH IF NOT A 1403 @OZ40627 Q5349000 OI DCTPPSW,DCTPPSWO SET OPERATOR $T ALLOWED R4 Q5350000 SPACE 1 R4 Q5351000 *********************************************************************** Q5352000 * * Q5353000 * CHECK UCS * Q5354000 * * Q5355000 *********************************************************************** Q5356000 SPACE 1 R4 Q5357000 DSVUCSB DS 0H R4 Q5358000 CLC DCTUCS,8(PL) UCSB CHANGE R4 Q5359000 BE DSVMSG BRANCH IF NO R4 Q5360000 CLC 8(4,PL),=CL4'****' IS STANDARD UCS REQUESTED R4 Q5361000 BNE DSVUCSB5 BRANCH IF NO R4 Q5362000 TM DCTPPSW,DCTPPSWU IS DEVICE UCS STANDARD R4 Q5363000 BZ DSVMSG BRANCH IF YES R4 Q5364000 CLC DCTUCS,$PRTUCS IF INSTALLATION DEFAULT IS R4 Q5365000 BNE DSVUCSB5 CURRENTLY LOADED, R4 Q5366000 NI DCTPPSW,X'FF'-DCTPPSWU RESET 'NON-STD' BIT R4 Q5367000 B DSVMSG AND BRANCH TO ISSUE MESSAGE R4 Q5368000 DSVUCSB5 DS 0H R4 Q5369000 OI DCTPPSW,DCTPPSWO+DCTPPSWT+DCTPPSWU MSG+NONSTD+TRAIN R4 Q5370000 L R0,8(,PL) PICK UP REQUESTED UCS R4 Q5371000 CL R0,=CL4'****' CHECK FOR DEFAULT SPECIFICATION R4 Q5372000 BNE SKIP600 SKIP IF NOT R4 Q5373000 L R0,$PRTUCS REPLACE WITH DEFAULT NAME R4 Q5374000 SKIP600 ST R0,DCTUCS STORE UCS ID IN DCT R4 Q5375000 EJECT R4 Q5376000 *********************************************************************** Q5377000 * * Q5378000 * ISSUE LOCAL OPERATOR SETUP MESSAGE * Q5379000 * * Q5380000 *********************************************************************** Q5381000 SPACE 1 R4 Q5382000 DSVMSG DS 0H R4 Q5383000 * THIS LINE DELETED BY APAR NUMBER @OZ18398 Q5384000 * THIS LINE DELETED BY APAR NUMBER @OZ18398 Q5385000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R41 Q5385200 BZ DSVMSG1 BR IF NOT REMOTE R41 Q5385400 TM MDCTFEAT,DCTPSHDR IF A SETUP HEADER WILL BE SENT R41 Q5385500 BO DSVEXIT EXIT IF YES @OZ18398 Q5385600 * THIS LINE DELETED BY APAR @OZ53538 Q5385610 * THIS LINE DELETED BY APAR @OZ53538 Q5385620 * THIS LINE DELETED BY APAR @OZ53538 Q5385630 * THIS LINE DELETED BY APAR @OZ53538 Q5385640 * THIS LINE DELETED BY APAR @OZ53538 Q5385650 * THIS LINE DELETED BY APAR @OZ53538 Q5385660 DSVMSG1 TM DCTPPSW,DCTPPSWO SETUP MESSAGE REQUIRED... @OZ18398 Q5385700 BZ DSVLUCSB BRANCH IF NO @OZ18398 Q5385800 SPACE 1 R4 Q5386000 $MID 190 R4 Q5387000 * THIS LINE DELETED BY APAR @OZ53538 Q5387010 SPACE 1 R41 Q5387500 MVC BUFSTART+7(2),=X'190E' MOVE MESSAGE ID @OZ18398 Q5388000 MVC BUFSTART+9(8),JCTJOBID MOVE JOB NUMBER R4 Q5389000 MVI BUFSTART+17,C' ' SPACE BEFORE JOB NAME R4 Q5390000 MVC BUFSTART+18(8),JCTJNAME MOVE JOB NAME R4 Q5391000 MVC BUFSTART+26(54),=CL54' SETUP -- PRINTER1 -- F = FORM -- CQ5392000 C = FCBI -- T = UCSI' MOVE SETUP MESSAGE R4 Q5393000 MVC BUFSTART+36(8),DCTDEVN MOVE DEVICE NAME R4 Q5394000 MVC BUFSTART+52(4),DCTFORMS MOVE FORMS ID R4 Q5395000 MVC BUFSTART+64(4),DCTFCB MOVE FCB ID R4 Q5396000 MVC BUFSTART+76(4),DCTUCS MOVE UCS ID R4 Q5397000 LA R0,73 LENGTH FOR PRINTER MESSAGE R4 Q5398000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE R4 Q5399000 BO *+8 BRANCH IF PRINT R4 Q5400000 LA R0,49 LENGTH FOR PUNCH MESSAGE R4 Q5401000 LA R15,DSVWTOA POINT TO REG. $DOMACT $WTO LIST JN Q5403200 TM PCEID,PCERJEID IF THIS IS A LOCAL DEVICE, JN Q5403300 BZ DSVWTO GO ISSUE $WTO JN Q5403400 ICM R1,7,DCTDCB+1 REMOTE STILL CONNECTED.... @OZ47975 Q5403500 BZ DSVNODOM NO, GO CHECK FOR $ COMMAND @OZ47975 Q5403550 L R1,MDCTRAT-DCTDSECT(,R1) FOR THIS REMOTE JN Q5403600 TM RATCONF-RATDSECT(R1),RATCONFI IF 'INFO' SETUP JN Q5403700 BZ DSVWTO NOT REQUESTED, GO ISSUE $WTO JN Q5403800 LA R15,DSVWTOI POINT TO 'INFO' $DOMACT $WTO LIST JN Q5403900 SPACE 1 JN Q5404000 DSVWTO $WTO BUFSTART+7,(R0),MF=(E,0(,R15)) ISSUE LOCAL SETUP JN Q5404100 TM PCEID,PCERJEID IS THIS A REMOTE TERMINAL R4 Q5404200 BZ DSVSTOP BR IF NOT R4 Q5405000 TM MDCTSTAT,DCTABORT TEST RJE STATUS R4 Q5406000 BO DSVSTART BR IF ABORTING R4 Q5407000 EJECT R4 Q5408000 *********************************************************************** Q5409000 * * Q5410000 * ISSUE REMOTE TERMINAL OPERATOR SETUP MESSAGE * Q5411000 * * Q5412000 *********************************************************************** Q5413000 SPACE 1 R4 Q5414000 ST R1,PPLC SAVE $DOM CMB ADDRESS R4 Q5415000 LA R0,73 LENGTH FOR PRINTER MESSAGE R4 Q5416000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE R4 Q5417000 BO SKIP610 BRANCH IF PRINT R4 Q5418000 LA R0,49 LENGTH FOR PUNCH MESSAGE R4 Q5419000 SKIP610 L R1,DCTDCB ADDRESS LINE DCT R4 Q5420000 L R1,MDCTRAT-DCTDSECT(,R1) ADDRESS REMOTE CONSOLE R4 Q5421000 ICM R0,2,RATCONRT+1-RATDSECT(R1) GET CONSOLE ROUTE CODE R4 Q5422000 $WTO BUFSTART+7,(R0),JOB=NO, ISSUE REMOTE SETUP R4CQ5423000 RMT=YES,CLASS=$ACTION,PRI=$ST R4 Q5424000 TM PCEID,PCEPUSID TEST PROCESSOR TYPE R4 Q5425000 BO DSVBFLSH BRANCH IF REMOTE PUNCH R4 Q5426000 LM PC1,PC2,PRCCWEJ LOAD EJECT CCW R4 Q5427000 BAL PL,PPPUT SEND CCW TO REMOTE R4 Q5428000 MVC BUFSTART(9),=C'$HASP190 ' MOVE MESSAGE ID R4 Q5429000 LA PC1,BUFSTART SET MESSAGE ADDRESS R4 Q5430000 LA PC2,80 AND LENGTH R4 Q5431000 TM $RUNOPTS,$MSGID IF MESSAGE IDS REQUIRED, R4 Q5432000 BO SKIP620 BR TO SET COMMAND TYPE R4 Q5433000 MVI BUFSTART+7,C'$' ELSE RESET MESSAGE ID, R4 Q5434000 LA PC1,BUFSTART+7 MESSAGE ADDRESS, R4 Q5435000 LA PC2,73 AND MESSAGE LENGTH R4 Q5436000 SKIP620 ICM PC1,8,=X'71' SET COMMAND TYPE R4 Q5437000 BAL PL,PPPUT2 SEND CCW TO REMOTE R4 Q5438000 SPACE 1 R4 Q5439000 *********************************************************************** Q5440000 * * Q5441000 * ENSURE THAT REMOTE TERMINAL BUFFER IS FLUSHED * Q5442000 * * Q5443000 *********************************************************************** Q5444000 SPACE 1 R4 Q5445000 DSVBFLSH DS 0H R4 Q5446000 ICM PC1,8,=X'FF' BUFFER FLUSH COMMAND R4 Q5447000 BAL PL,PPPUT2 SEND CCW TO REMOTE R4 Q5448000 L R1,PPLC RESTORE $DOM CMB ADDRESS R4 Q5449000 L PC1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ32566 Q5450000 EJECT R4 Q5451000 *********************************************************************** Q5452000 * * Q5453000 * WAIT FOR OPERATOR ACTION * Q5454000 * * Q5455000 *********************************************************************** Q5456000 SPACE 1 R4 Q5457000 DSVSTOP OI DCTFLAGS,DCTSTOP STOP THE DEVICE R4 Q5458000 SPACE 1 R4 Q5459000 DSVWAIT TM DCTFLAGS,DCTSTOP TEST FOR $S DEVICE R4 Q5460000 BZ DSVSTART BRANCH IF TRUE START R4 Q5461000 NI DCTFLAGS,255-DCTDELET-DCTRSTRT-DCTBKSP RESET Q5462000 $WAIT IO WAIT FOR A POST FROM COMM R4 Q5463000 B DSVWAIT TEST FOR $S DEVICE R4 Q5464000 DSVSTART DS 0H R4 Q5465000 LTR R1,R1 BRANCH AROUND IF R4 Q5466000 BZ DSVNODOM NOTHING TO $DOM R4 Q5467000 $DOM CMB=(R1) DELETE THE MESSAGE R4 Q5468000 DSVNODOM DS 0H R4 Q5469000 TM DCTFLAGS,DCTDELET+DCTRSTRT $C OR $E OR $I R4 Q5470000 BNZ DSVTERM TERMINATE DATA SET IF SO @OZ31651 Q5471000 TM PCEID,PCERJEID TEST FOR REMOTE @OZ31651 Q5471100 BZ DSVLUCSB NO PROBLEM IF LOCAL @OZ31651 Q5471200 TM MDCTSTAT,DCTABORT IF REMOTE NOT DISCONNECTED @OZ31651 Q5471300 BZ DSVLUCSB ...THIS POST WAS VALID @OZ31651 Q5471400 MVC DCTFORMS(12),PCEFORM ELSE REVERT TO OLD FORMS @OZ31651 Q5471500 B DSVEXIT ALL ELSE HAS BEEN SET UP. @OZ31651 Q5471600 DSVTERM DS 0H @OZ31651 Q5471700 OI PPFLAG,PPDELSW+PRDELSW CAUSE DATA SET TERMINATION R4 Q5472000 OC PDCTFLAG,DCTFLAGS PROVIDE REASON FOR TERMINATION R4 Q5473000 NI DCTFLAGS,255-DCTDELET-DCTRSTRT-DCTBKSP RESET DCT R4 Q5474000 MVC DCTFORMS(12),PCEFORM REVERT TO PREVIOUS SETUP R4 Q5475000 TM PCEID,PCERJEID TEST FOR REMOTE R4 Q5476000 BZ DSVLUCSB BR IF NOT R4 Q5477000 TM MDCTSTAT,DCTABORT TEST FOR REMOTE ABORTING R4 Q5478000 BO DSVEXIT EXIT IF YES R4 Q5479000 EJECT R4 Q5480000 *********************************************************************** Q5481000 * * Q5482000 * LOAD UCSB IF SUPPORTED BY DEVICE * Q5483000 * * Q5484000 *********************************************************************** Q5485000 SPACE 1 R4 Q5486000 DSVLUCSB DS 0H R4 Q5487000 NI DCTPPSW,255-DCTPPSWO $T NOT ALLOWED R4 Q5488000 TM PCEID,PCEPUSID TEST PROCESSOR ID R4 Q5489000 BO DSVEXIT BRANCH IF PUNCH R4 Q5490000 LM PC1,PC2,PRCCWEJ GET EJECT CCW R4 Q5491000 BAL PL,PPPUT ADD TO CHAIN R4 Q5492000 BAL PL,PPWRITE STAGE WRITE R4 Q5493000 BAL PL,PPCHECK CHECK WRITE R4 Q5494000 L PC1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ32566 Q5495000 TM PDEVTYPE+1,X'80' TEST UCSB OPTION FIELD R4 Q5496000 BZ DSVLFCB BRANCH IF NOT SUPPORTED R4 Q5497000 TM DCTPPSW,DCTPPSWT UCSB LOAD REQUIRED R4 Q5498000 BZ DSVLFCB BRANCH IF NO R4 Q5499000 NI DCTPPSW,255-DCTPPSWT RESET TRAIN LOAD BIT R4 Q5500000 CLC DCTUCS,=C'0 ' IS UCS = 0 REQUESTED R4 Q5501000 BE DSVLFCB BRANCH IF YES - SKIP UCS LOAD R4 Q5502000 MVC BUFSTART(4),=X'0001003A' BLDL PARAMETER LIST R4 Q5503000 MVC BUFSTART+4(4),=C'UCS1' IMAGE PREFIX FOR 1403 UCS R4 Q5504000 MVC BUFSTART+8(4),DCTUCS USER UCS IMAGE ID R4 Q5505000 CLI PDEVBYT3,UCB1403 IS THIS A 1403 @OZ40627 Q5506000 BE DSVUCS01 BRANCH IF YES R4 Q5507000 MVI BUFBYT7,C'3' SET FOR 3203 IMAGE @OZ40627 Q5508000 CLI PDEVBYT3,UCB3203 IS THIS A 3203 @OZ40627 Q5508100 BE DSVUCS01 SET CORRECTLY FOR IMAGE TASK@OZ40627 Q5508200 MVI BUFBYT7,C'2' IMAGE PREFIX FOR 3211 UCS @OZ40627 Q5508300 * @OZ40627 Q5508400 * JES2 ONLY INITS 3 TYPES OF IMPACT PRTS GO ON AS 3211 @OZ40627 Q5508500 * @OZ40627 Q5508600 DSVUCS01 DS 0H * R4 Q5509000 TM $IMAGECB,X'40' IS IMAGE LOADER TASK BUSY R4 Q5510000 BNO DSVUCS02 BRANCH IF NO R4 Q5511000 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST R4 Q5512000 B DSVUCS01 TRY AGAIN R4 Q5513000 DSVUCS02 DS 0H * R4 Q5514000 MVI BUFECBCC,X'80' SET BUFFER ECB AS WAITING R4 Q5515000 POST $IMAGECB,(R3) POST WITH BUFFER ADDRESS R4 Q5516000 DSVUCS03 DS 0H * R4 Q5517000 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST R4 Q5518000 TM BUFECBCC,X'7F' TEST STATUS OF LOAD REQUEST R4 Q5519000 BZ DSVUCS03 BRANCH IF NOT COMPLETE R4 Q5520000 BM DSVUCSNO BRANCH IF IMAGE NOT FOUND R4 Q5521000 L R15,PRPUUCB ADDRESS PRINTER UCB R4 Q5522000 USING UCBDSECT,R15 ACTIVATE UCB ADDRESSABILITY R4 Q5523000 L R15,UCBXTADR ADDRESS UCB EXTENSION R4 Q5524000 USING UCBUCS,R15 UCB EXTENSION ADDRESSABILITY R4 Q5525000 MODESET EXTKEY=ZERO GET ZERO KEY TO CHANGE THE UCB R4 Q5526000 OI UCBUCSOP,UCBUCSO1+UCBUCSO2 SET DEFAULT UCS AND FOLD R41 Q5527000 NI DCTPPSW,255-DCTPPSWU RESET NON-STANDARD UCS FLAG R4 Q5528000 TM BUFSTART,X'80' STANDARD UCS IMAGE... R41 Q5529000 BO DSVSETU BR IF YES R41 Q5530000 OI DCTPPSW,DCTPPSWU SET NON-STANDARD UCS FLAG R4 Q5531000 NI UCBUCSOP,255-UCBUCSO1 RESET DEFAULT UCS IMAGE FLAG R4 Q5532000 DSVSETU MVC UCBUCSID,DCTUCS SET UCS IMAGE ID IN UCB R41 Q5533000 TM BUFSTART,X'40' FOLD THE UCS IMAGE... R41 Q5533200 BO DSVKEY BR IF YES R41 Q5533300 NI UCBUCSOP,255-UCBUCSO2 ELSE, RESET UCS FOLD BIT R41 Q5533400 DSVKEY MODESET EXTKEY=HASP RETURN TO NORMAL HASP KEY R41 Q5534000 DROP R15 SUSPEND UCB EXTENSION BASE R4 Q5535000 LM PC1,PC2,PUNFOLD 3211 UNFOLD CONTROL CCW R4 Q5536000 TM BUFSTART,X'40' FOLD THE UCS IMAGE... R41 Q5536100 BZ DSVC3211 BR IF NO R41 Q5536200 ICM PC1,8,=X'43' ELSE REPLACE CC WITH 3211 FOLD R41 Q5536300 DSVC3211 CLI PDEVBYT3,UCB1403 IS DEVICE A 1403 @OZ40627 Q5537000 BNE DSVUCS04 IF 1403 SKIP GATE CCW @OZ40627 Q5538000 LM PC1,PC2,PUCSGATE 1403 UCS GATE CCW R4 Q5539000 SPACE 1 R41 Q5539500 DSVUCS04 BAL PL,PPPUT2 ADD CCW TO CHAIN R41 Q5540000 SPACE 1 R41 Q5541000 LM PC1,PC2,PUCSBDC BLOCK DATA CHECK CCW R4 Q5542000 BAL PL,PPPUT2 ADD CCW TO CHAIN R4 Q5543000 LM PC1,PC2,PUCSLOAD LOAD UCSB CCW R4 Q5544000 ALR PC1,PBUF ADJUST DATA ADDRESS R4 Q5545000 CLI PDEVTYPE+3,UCB1403 TEST DEVICE TYPE R4 Q5546000 BE DSVC1403 BR IF 1403 R41 Q5547000 ICM PC2,3,UCSL3203 UCSB LENGTH FOR 3203 @OZ40627 Q5548000 CLI PDEVBYT3,UCB3203 TEST FOR 3203 @OZ40627 Q5548100 BE DSVUCPUT BR IF IT IS A 3203 @OZ40627 Q5548200 ICM PC2,3,UCSL3211 SET FOR 3211 UCS LEN @OZ40627 Q5548300 * @OZ40627 Q5548400 * JES2 ONLY INITS 3 TYPES OF IMPACT PRTS GO ON AS 3211 @OZ40627 Q5548500 * @OZ40627 Q5548600 B DSVUCPUT GO ON AS 3211 @OZ40627 Q5548700 UCSL3203 DC H'304' 3203 UCS LENGTH @OZ40627 Q5548800 UCSL3211 DC H'512' 3211 UCS LENGTH @OZ40627 Q5548900 SPACE 1 R41 Q5549000 DSVC1403 TM BUFSTART,X'40' FOLD THE UCS IMAGE... R41 Q5549100 BZ DSVUCPUT BR IF NO R41 Q5549200 ICM PC1,8,=X'F3' ELSE REPLACE CC WITH 1403 FOLD R41 Q5549300 SPACE 1 R41 Q5549400 DSVUCPUT BAL PL,PPPUT2 ADD CCW TO CHAIN R41 Q5549500 BAL PL,PPWRITE INITIATE WRITE R4 Q5550000 BAL PL,PPCHECK AND CHECK R4 Q5551000 L PC1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ32566 Q5552000 B DSVLFCB GO LOAD FCB IMAGE R4 Q5553000 DSVUCSNO DS 0H * R4 Q5554000 $MID 180 R4 Q5555000 MVC BUFSTART(2),=X'180F' MOVE MESSAGE NUMBER R4 Q5556000 MVC BUFSTART+2(8),DCTDEVN MOVE DEVICE NAME R4 Q5557000 MVC BUFSTART+10(26),=CL26' FCB IMAGE XXXX NOT FOUND' R4 Q5558000 MVC BUFSTART+11(4),=C'UCSB' MOVE BUFFER ID R4 Q5559000 MVC BUFSTART+22(4),DCTUCS MOVE UCS ID R4 Q5560000 $WTO BUFSTART,36,JOB=YES, ISSUE BUFFER LOAD FAIL MSG R4CQ5561000 ROUTE=$LOG+$UR,CLASS=$ACTION,PRI=$ST R4 Q5562000 OI DCTPPSW,DCTPPSWT+DCTPPSWO LOAD UCS + MSG R4 Q5563000 B DSVMSG GO PRINT SETUP MESSAGE R4 Q5564000 EJECT R4 Q5565000 *********************************************************************** Q5566000 * * Q5567000 * LOAD FCB IF SUPPORTED BY DEVICE * Q5568000 * * Q5569000 *********************************************************************** Q5570000 SPACE 1 R4 Q5571000 DSVLFCB DS 0H R4 Q5572000 TM DCTPPSW,DCTPPSWC FCB LOAD REQUIRED R4 Q5573000 BZ DSVEXIT BRANCH IF NO R4 Q5574000 NI DCTPPSW,255-DCTPPSWC RESET CARRIAGE LOAD BIT R4 Q5575000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R41 Q5575200 BZ DSVFCB00 BR IF NOT REMOTE R41 Q5575400 ICM PC1,8,=X'FF' SEND BUFFER FLUSH @OZ53538 Q5575500 BAL PL,PPPUT2 COMMAND TO RTAM @OZ53538 Q5575600 L PC1,PCEDCT RESTORE DCT @OZ53538 Q5575700 SPACE 1 R41 Q5575800 DSVFCB00 CLI PDEVTYPE+3,UCB1403 TEST DEVICE TYPE R41 Q5576000 BE DSVEXIT BRANCH IF 1403 R4 Q5577000 MVC BUFSTART(4),=X'0001003A' BLDL PARAMETER LIST R4 Q5578000 MVC BUFSTART+4(4),=C'FCB2' IMAGE PREFIX FOR 3211 FCB R4 Q5579000 MVC BUFSTART+8(4),DCTFCB USER FCB IMAGE ID R4 Q5580000 DSVFCB01 DS 0H * R4 Q5581000 TM $IMAGECB,X'40' IS IMAGE LOADER TASK BUSY R4 Q5582000 BNO DSVFCB02 BRANCH IF NO R4 Q5583000 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST R4 Q5584000 B DSVFCB01 TRY AGAIN R4 Q5585000 DSVFCB02 DS 0H * R4 Q5586000 MVI BUFECBCC,X'80' SET BUFFER ECB AS WAITING R4 Q5587000 POST $IMAGECB,(R3) POST WITH BUFFER ADDRESS R4 Q5588000 DSVFCB03 DS 0H * R4 Q5589000 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST R4 Q5590000 TM BUFECBCC,X'7F' TEST STATUS OF LOAD REQUEST R4 Q5591000 BZ DSVFCB03 BRANCH IF NOT COMPLETE R4 Q5592000 BM DSVFCBNO BRANCH IF IMAGE NOT FOUND R4 Q5593000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q5594000 BO DSVFCBRJ BRANCH IF REMOTE R4 Q5595000 L R15,PRPUUCB ADDRESS PRINTER UCB R4 Q5596000 USING UCBDSECT,R15 ACTIVATE UCB ADDRESSABILITY R4 Q5597000 L R15,UCBXTADR ADDRESS UCB EXTENSION R4 Q5598000 USING UCBUCS,R15 UCB EXTENSION ADDRESSABILITY R4 Q5599000 MODESET EXTKEY=ZERO GET ZERO KEY TO CHANGE THE UCB R4 Q5600000 OI UCBFCBOP,UCBFCBO1 SET DEFAULT FCB IMAGE FLAG R4 Q5601000 TM BUFSTART,X'80' IS THIS A STANDARD FCB IMAGE R4 Q5602000 BO SKIP660 BRANCH IF YES R4 Q5603000 NI UCBFCBOP,255-UCBFCBO1 RESET DEFAULT FCB IMAGE FLAG R4 Q5604000 SKIP660 MVC UCBFCBID,DCTFCB COPY FCB IMAGE ID TO THE UCB R4 Q5605000 MODESET EXTKEY=HASP RETURN TO NORMAL HASP KEY R4 Q5606000 DROP R15 SUSPEND UCB EXTENSION BASE R4 Q5607000 DSVFCBRJ DS 0H R4 Q5608000 NI DCTPPSW,255-DCTPPSWB RESET NON-STANDARD FCB FLAG R4 Q5609000 TM BUFSTART,X'80' IS THIS A STANDARD FCB IMAGE R4 Q5610000 BO SKIP670 BRANCH IF YES R4 Q5611000 OI DCTPPSW,DCTPPSWB SET NON-STANDARD FCB FLAG R4 Q5612000 SKIP670 TM PRINDEX,X'C0' SPECIFIC INDEX REQUESTED R4 Q5613000 BZ DSVFCB04 BRANCH IF NO R4 Q5614000 CLC PRINDEX,BUFSTART+2 IS IMAGE INDEX BEING CHANGED R4 Q5615000 BE DSVFCB04 BRANCH IF NO R4 Q5616000 OI DCTPPSW,DCTPPSWC SET LOAD FCB FLAG R4 Q5617000 MVC BUFSTART+2(1),PRINDEX SET 3211 INDEX VALUE R4 Q5618000 DSVFCB04 DS 0H * R4 Q5619000 MVC DCTINDEX,BUFSTART+2 SAVE NEW INDEX VALUE R4 Q5620000 LM PC1,PC2,PFCBLOAD LOAD FCB CCW R4 Q5621000 ALR PC1,PBUF ADJUST DATA ADDRESS R4 Q5622000 IC PC2,BUFSTART+1 GET LENGTH OF FCB IMAGE R4 Q5623000 TM PCEID,PCERJEID TEST PROCESSOR TYPE R4 Q5624000 BZ SKIP680 BRANCH IF LOCAL R4 Q5625000 ICM PC1,8,=X'61' SET SPECIAL RJE FCB CC R4 Q5626000 SKIP680 BAL PL,PPPUT2 ADD CCW TO CHAIN R4 Q5627000 BAL PL,PPWRITE INITIATE WRITE R4 Q5628000 BAL PL,PPCHECK AND CHECK R4 Q5629000 B DSVEXIT RETURN TO CALLER R4 Q5630000 DSVFCBNO DS 0H * R4 Q5631000 $MID 180 R4 Q5632000 MVC BUFSTART(2),=X'180F' MOVE MESSAGE NUMBER R4 Q5633000 MVC BUFSTART+2(8),DCTDEVN MOVE DEVICE NAME R4 Q5634000 MVC BUFSTART+10(26),=CL26' FCB IMAGE XXXX NOT FOUND' R4 Q5635000 MVC BUFSTART+22(4),DCTFCB MOVE FCB ID R4 Q5636000 $WTO BUFSTART,36,JOB=YES, ISSUE BUFFER LOAD FAIL MSG R4CQ5637000 ROUTE=$LOG+$UR,CLASS=$ACTION,PRI=$ST R4 Q5638000 OI DCTPPSW,DCTPPSWC+DCTPPSWO SET LOAD AND MSG REQD R4 Q5639000 B DSVMSG GO PRINT SETUP MESSAGE R4 Q5640000 SPACE 2 R4 Q5641000 DSVEXIT DS 0H R4 Q5642000 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q5643000 * DELETED @G38ESBB Q5644000 SPACE 1 @G38ESBB Q5645000 DROP PC1 SUSPEND DCT ADDRESSABILITY R4 Q5646000 EJECT JN Q5646200 * PARM LISTS FOR LOCAL SETUP $WTO'S R41 Q5646300 SPACE 4 R41 Q5646400 DS 0F R41 Q5646500 DSVWTOA $WTO JOB=NO, ACTION-TYPE MESSAGE, R41CQ5646600 ROUTE=$LOG+$UR, DISPLAYABLE VIA '$DO' R41CQ5646700 CLASS=$DOMACT, R41CQ5646800 PRI=$ST, R41CQ5646900 MF=L R41 Q5647000 SPACE 3 R41 Q5647100 DSVWTOI $WTO JOB=NO, INFO-TYPE MESSAGE, R41CQ5647200 ROUTE=$LOG+$UR, DISPLAYABLE VIA '$DO' R41CQ5647300 CLASS=$DOMACT+$NORMAL, R41CQ5647400 PRI=$ST, R41CQ5647500 MF=L R41 Q5647600 TITLE ' HASP PRINT/PUNCH SERVICE -- 3800 DEVICE SETUP' R4 Q5647700 P3800DSV DS 0H ENTRY TO 3800 DEVICE SETUP R4 Q5648000 PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q5649000 SPACE 1 R4 Q5650000 USING SPPARM-(BUFSTART-BUFDSECT),PBUF SPPARM ADDRESSABILITY R4 Q5651000 SPACE 1 R4 Q5652000 P3800DS DS 0H @G38ESBB Q5653000 LR BASE2,R15 ESTABLISH LOCAL R4 Q5654000 USING P3800DSV,BASE2 ADDRESSABILITY R4 Q5655000 USING DCTDSECT,PC1 ESTABLISH DCT ADDRESSABILITY R4 Q5656000 L PC1,PCEDCT ADDRESS 3800 DCT @OZ32566 Q5657000 STCM PC1,7,BUFDCT+1-BUFDSECT(PBUF) PLACE DCT ADDR IN BUF R4 Q5658000 USING UCB3800X,PC2 ESTABLISH 3800 UCB R4 Q5659000 L PC2,PRPUUCB EXTENSION R4 Q5660000 L PC2,UCBXTADR-UCBDSECT(,PC2) ADDRESSABILITY R4 Q5661000 L JCT,PJCTBUF ESTABLISH JCT R4 Q5662000 LTR JCT,JCT JCT READ... @G38ESBB Q5662200 BNZ *+8 YES, BRANCH @G38ESBB Q5662400 LA JCT,JCT SHOW NON-ZERO JCT FOR I/O @G38ESBB Q5662600 USING JCTDSECT,JCT ADDRESSABILITY R4 Q5663000 * R4 Q5664000 * CLEAR SETPRT PARMLIST AND WORKAREA - SAVE DCT STATUS R4 Q5665000 * R4 Q5666000 XC SPPARM(SPWSAVE1-SPPARM),SPPARM INITIALIZE AREA R4 Q5667000 TM DCTPPSW2,DCTNINIT DOES 3800 NEED INITIALIZATION... R4 Q5668000 BZ SPRXMIT BR IF NO R4 Q5669000 OI SPWFLAG,SPWINIT+SPWSETP TELL SETPRT R4 Q5670000 NI DCTPPSW2,255-DCTNINIT RESET UNTIL $DRAINED R4 Q5671000 MVC DCTCHAR1,DCTUCS PRESET R41 Q5672000 MVI DCTCHAR2,C'*' DCT FIELDS R41 Q5672500 MVC DCTCHAR2+1(5*4-1),DCTCHAR2 (CHARS,FLASH,MODIFY) R41 Q5673000 XC PREVCPYS(2),PREVCPYS AND PREV. START AND # OF COPIES R4 Q5674000 SPACE 1 R4 Q5675000 SPRXMIT DS 0H R4 Q5676000 TM SPFLAG,SPREXMIT TEST FOR RE-TRANSMISSION R4 Q5677000 BO SPRRXMIT BR IF YES R4 Q5678000 MVC SPWFORMS(3*4),DCTFORMS SAVE FORMS, FCB, DEFAULT CHAR1 R4 Q5679000 MVC SPWCHAR1(4*4),DCTCHAR1 SAVE CHAR1,2,3,4 VALUES R4 Q5680000 TM DCTPPSW2,DCTNIBRS SAVE DCT R4 Q5681000 BZ SKIP690 BURSTER R4 Q5682000 OI SPWFLAG,SPWDCTB STATUS R4 Q5683000 SPACE 3 R4 Q5684000 SKIP690 CLC DCTFORMS,SPFORMS TEST FOR FORMS CHANGE R4 Q5685000 BE SPRFCB BR IF NO R4 Q5686000 OI SPWFLAG,SPWWTO INDICATE SETUP MSG NEEDED R4 Q5687000 MVC DCTFORMS,SPFORMS MOVE IN NEW FORMS ID R4 Q5688000 SPACE 1 R4 Q5689000 SPRFCB DS 0H R4 Q5690000 CLI SPFCB,C'*' TEST FOR DEFAULT REQUEST R4 Q5691000 BNE SKIP700 BR IF NO R4 Q5692000 MVC SPFCB,PRDFCB ELSE, USE INSTALLATION DEFAULT R4 Q5693000 SKIP700 CLC DCTFCB,SPFCB TEST FOR FCB CHANGE R4 Q5694000 BE SPRCHARS BR IF NO R4 Q5695000 MVC DCTFCB,SPFCB MOVE IN NEW FCB IMAGE ID R4 Q5696000 EJECT R4 Q5697000 * SETUP CHARACTER SETS (CHARS) REQUEST R41 Q5697100 * R41 Q5697200 * THIS SECTION BUILDS THE CHAR SET REQUEST USING THE R41 Q5697300 * SETUP PARMLIST (SPCHAR1-4.) IF ROOM PERMITS, THE DE- R41 Q5697400 * FAULT CHAR (DCTUCS) IS ADDED TO THE LIST. FOR EACH R41 Q5697500 * CHAR, DCTCHAR'S FIELDS ARE SEARCHED TO DETERMINE IF IT R41 Q5697600 * IS ALREADY LOADED. IF NOT, THE NEW REQUESTS REPLACE R41 Q5697700 * THE OLD SETUP. IF ALREADY LOADED, THE CCW OP-CODE TO R41 Q5697800 * SELECT THE CORRESPONDING TANSLATE TABLE IS RECORDED R41 Q5697900 * IN THE 'PXTABCCW' TABLE ENTRY FOR THAT CHAR. R41 Q5698000 * THE FINAL TABLE REPRESENTS A MAPPING OF THE REQUESTED R41 Q5698100 * CHARACTER SETS TO THEIR ACTUAL POSITIONS IN THE 3800, R41 Q5698200 * ELIMINATING UNNECESSARY RE-LOADS DUE TO CHARACTER R41 Q5698300 * SET POSITIONS. R41 Q5698400 SPACE 1 R41 Q5698500 SPRCHARS MVC PXTABCCW,SPRXCCWS INITIALIZE CCW OP-CODE TABLE R41 Q5699000 TM SPFLAG,SPSEP SETUP FOR SEPARATORS... R41 Q5699100 BZ SPRCNSEP BR IF NOT R41 Q5699200 MVI PRMAXTRC,0 ONLY USE 1 CHAR SET R41 Q5699300 BAL PL,SPRTDFLT DEFAULT CHAR SET LOADED... R41 Q5699400 BNZ SPRCNDEF BR IF NOT R41 Q5699500 MVC PXTABCCW(1),0(PW) ELSE SET CCW FOR DEFAULT R41 Q5699600 B SPRFLASH AND BR TO CONTINUE R41 Q5699700 SPACE 1 R41 Q5699800 SPRCNDEF TM DCTPPSW2,DCTSEPNL MUST LOAD DEFAULT FOR SEP... R41 Q5699900 BZ SPRCHDEF BR IF YES R41 Q5700000 B SPRFLASH ELSE USE 1ST CHAR SET R41 Q5700100 SPACE 1 R41 Q5700200 SPRCNSEP CLI SPCHAR1,C'*' WAS CHARS SPECIFIED... R41 Q5700300 BNE SPRCH1 BR IF YES R41 Q5700400 SPACE 1 R41 Q5700500 SPRCHDEF MVC SPCHAR1,DCTUCS USE JES2 PRINTER DEFAULT R41 Q5700600 MVC SPCHAR2,=C'****' CLEAR CHAR2 @OZ28970 Q5700640 MVC SPCHAR3(2*4),SPCHAR2 CHAR3 AND CHAR4 @OZ28970 Q5700680 SPACE 1 R41 Q5700700 SPRCH1 SLR R1,R1 ONLY BUILD R41 Q5700800 IC R1,PRMAXTRC ENTRIES FOR R41 Q5701800 LA R1,1(,R1) REQUESTED CHARS R41 Q5702000 LA PL,PXTABCCW ADDR OF CCW TABLE R41 Q5702200 LA R14,SPCHAR1 ADDR OF CHARS REQUEST R41 Q5702400 SPACE 1 R41 Q5702600 SPRCH2 LA R15,DCTCHAR1 ADDR OF CURRENT CHARS LOADED R41 Q5702800 LA R0,4 SET LOOP COUNTER R41 Q5703000 SPACE 1 R41 Q5703200 SPRCH3 CLC 0(4,R14),0(R15) THIS CHAR ALREADY LOADED... R41 Q5703400 BE SPRCH4 BR IF YES R41 Q5703600 LA R15,4(,R15) ELSE CHECK WITH NEXT R41 Q5703800 BCT R0,SPRCH3 CHAR ALREADY LOADED R41 Q5704000 SPACE 1 R41 Q5704200 MVC PXTABCCW,SPRXCCWS NOT LOADED ALREADY -- SET TO R41 Q5704400 MVC DCTCHAR1(4*4),SPCHAR1 LOAD ALL REQUESTED CHARS R41 Q5704600 B SPRCH5 AND BR TO CONTINUE R41 Q5704800 EJECT R41 Q5705000 SPRCH4 LNR R15,R0 LOADED ALREADY -- DETERMINE R41 Q5705200 LA R15,SPRXCCWS+4(R15) ACTUAL POSITION OF CHAR AND R41 Q5705400 MVC 0(1,PL),0(R15) INSERT CORRECT CCW OP-CODE R41 Q5705600 LA R14,4(,R14) INCR TO NEXT REQUESTED R41 Q5706000 LA PL,1(,PL) CHAR AND GO DETERMINE R41 Q5706200 BCT R1,SPRCH2 IF IT IS ALREADY LOADED R41 Q5706400 SPACE 1 R41 Q5706600 SPRCH5 IC R1,PRMAXTRC GET NUMBER OF CHARACTER R41 Q5706700 LA R1,1(,R1) SETS REQUESTED R41 Q5706800 CLM R1,1,UCBCGMNO POTENTIAL WCGM'S LEFT... R41 Q5706900 BNL SPRFLASH BR IF NO R41 Q5707000 BAL PL,SPRTDFLT DEFAULT CHAR SET LOADED... R41 Q5707200 BZ SPRFLASH BR IF YES. ELSE, R41 Q5707400 SLL R1,2 ADD DEFAULT R41 Q5707700 LA R1,DCTCHAR1(R1) TO LIST R41 Q5707800 MVC 0(4,R1),DCTUCS OF CHARS R41 Q5707900 OI SPWFLAG,SPWDEFLT SET INDICATION R41 Q5708000 OI SPPFLAG1,SPPBOMSG SETPRT BYPASS WCGM MSG @G38ESBB Q5708100 SPACE 1 @G38ESBB Q5708150 SPRFLASH DS 0H R4 Q5708200 LH PW,PCCWLAST GET OFFSET TO PCIE @OZ45078 Q5708300 AL PW,POUTCCWA ADD CCW AREA BASE @OZ45078 Q5708400 LA PW,PCIESIZE(,PW) ADDRESS BFW @OZ45078 Q5708500 USING BFWDSECT,PW PROVIDE BFW ADDRESSABILITY @OZ45078 Q5708600 SPACE 1 @OZ45078 Q5708700 SLR R15,R15 CLEAR WORK REGISTER @OZ45078 Q5708750 TM SPWFLAG,SPWWTO CHANGE IN FORMS... @OZ45078 Q5708800 BZ *+8 NO, BYPASS SETTING @OZ45078 Q5708850 LA R15,BFWCCM INDICATE CHECK CONSOLE MSG @OZ45078 Q5708900 SPACE 1 @OZ45078 Q5708950 CLI SPFLASH,C'*' TEST FOR FLASH SPECIFIED R4 Q5709000 BNE SPRF1 BR IF YES R4 Q5710000 CLI DCTFLASH,C'*' TEST FOR FLASH CURRENTLY ACTIVE R4 Q5711000 BE SPRBURST BR IF NO R4 Q5712000 B SPRF2 ELSE, GO TO RESET DCT R4 Q5713000 SPRF1 CLC DCTFLASH,SPFLASH TEST FOR CHANGE R4 Q5714000 BE SPRBURST BR IF NO R4 Q5715000 OI SPWFLAG,SPWWTO INDICATE SETUP MSG NEEDED R4 Q5716000 LTR R15,R15 CHANGE IN FORMS ALSO... @OZ45078 Q5716200 BNZ *+8 YES, BYPASS FLASH SETTING @OZ45078 Q5716400 LA R15,BFWFLASH INDICATE FLASH CHANGE @OZ45078 Q5716600 SPACE 1 @OZ45078 Q5716800 SPRF2 MVC DCTFLASH,SPFLASH UPDATE DCT WITH NEW REQUEST R4 Q5717000 SPACE 1 R4 Q5718000 SPRBURST DS 0H R4 Q5719000 SPACE 1 @OZ45078 Q5719100 * DELETED @OZ45078 Q5719200 * DELETED @OZ45078 Q5719300 * DELETED @OZ45078 Q5719400 * DELETED @OZ45078 Q5719500 * DELETED @OZ45078 Q5719600 * DELETED @OZ45078 Q5719700 * DELETED @OZ45078 Q5719800 * DELETED @OZ45078 Q5719900 SPACE 1 @G38ESBB Q5719950 TM SPFLAG,SPBURST TEST FOR BURST=YES SPECIFIED R4 Q5720000 BZ SPRB1 BR IF NOT - BURSTER NOT WANTED R4 Q5721000 TM DCTPPSW2,DCTNIBRS TEST FOR DEVICE ALREADY BURSTING R4 Q5722000 BO SPRMODFY BR IF YES R4 Q5723000 OI DCTPPSW2,DCTNIBRS ELSE, MOVE IN B=Y STATUS R4 Q5724000 LTR R15,R15 CHANGE IN FORMS OR FLASH... @G38ESBB Q5724100 LA R15,BFWCCM CHECK CONSOLE MESSAGE @OZ45078 Q5724150 BNZ SPRB2 YES, BYPASS BURSTER SETTING @G38ESBB Q5724200 LA R15,BFWNBB INDICATE NON-BURST TO BURST @G38ESBB Q5724300 TM UCBOPTNS,UCBBRSTR BURSTER INSTALLED... @G38ESBB Q5724400 BO SPRB2 YES, BYPASS RESETTING @G38ESBB Q5724500 LA R15,BFWCCM NO, RESET TO CHECK CON MSG @G38ESBB Q5724600 B SPRB2 AND GO FLAG FOR WTO R4 Q5725000 SPRB1 TM DCTPPSW2,DCTNIBRS TEST BURST STATUS R4 Q5726000 BZ SPRMODFY BR IF NOT ACTIVE R4 Q5727000 NI DCTPPSW2,255-DCTNIBRS ELSE, MOVE IN B=N STATUS R4 Q5728000 LTR R15,R15 CHANGE IN FORMS OR FLASH... @G38ESBB Q5728100 LA R15,BFWCCM CHECK CONSOLE MESSAGE @OZ45078 Q5728150 BNZ SPRB2 YES, BYPASS BURSTER SETTING @G38ESBB Q5728200 LA R15,BFWBNB INDICATE BURST TO NON-BURST @G38ESBB Q5728300 TM UCBOPTNS,UCBBRSTR BURSTER INSTALLED... @G38ESBB Q5728400 BO SPRB2 YES, BYPASS RESETTING @G38ESBB Q5728500 LA R15,BFWCCM NO, RESET TO CHECK CON MSG @G38ESBB Q5728600 SPRB2 OI SPWFLAG,SPWWTO INDICATE SETUP MSG NEEDED R4 Q5729000 SPACE 1 R4 Q5730000 SPRMODFY DS 0H R4 Q5731000 STC R15,BFWSTCD SET DISPLAY STATUS CODE @G38ESBB Q5731500 CLI SPMODF,C'*' TEST FOR COPY MOD SPECIFIED R4 Q5732000 BNE SPRM1 BR IF YES R4 Q5733000 CLI DCTMODF,C'*' TEST FOR COPY MOD ALREADY ACTIVE R4 Q5734000 BE SPRMSG BR IF NO R4 Q5735000 OI SPWFLAG,SPWCLRM INDICATE COPY MOD MUST BE CLEARED R4 Q5736000 SPRM1 MVC DCTMODF,SPMODF MOVE IN NEW COPY MODIFICATION ID R4 Q5737000 SPACE 1 @G38ESBB Q5737200 DROP PW DROP BFW ADDRESSABILITY @G38ESBB Q5737500 EJECT R4 Q5738000 * R4 Q5739000 * ISSUE OPERATOR SETUP MSG FOR FORMS(F) - FLASH(O) - BURST(B) R4 Q5740000 * R4 Q5741000 SPACE 1 R4 Q5742000 SPRMSG DS 0H R4 Q5743000 TM SPWFLAG,SPWWTO TEST FOR SETUP MSG NEEDED R4 Q5744000 BZ SPRLFCB BR IF NO R4 Q5745000 LM PC1,PC2,PCCWCP ISSUE @G38ESBB Q5745100 BAL PL,PPPUT CLEARPRINT CCW @G38ESBB Q5745200 BAL PL,PPWRITE TO EMPTY PAGE BUFFER @G38ESBB Q5745300 BAL PL,PPCHECK BEFORE STATUS CODE @G38ESBB Q5745400 LM PC1,PC2,PCCWXORD GET EXECUTE ORDER CCW @G38ESBB Q5745500 IC PC2,=AL1(L'BFWDSC) CHANGE LENGTH FROM 2 TO 3 @G38ESBB Q5745600 LH R1,PCCWLAST RESTORE @G38ESBB Q5745700 AL R1,POUTCCWN BFW @G38ESBB Q5745800 LA R1,PCIESIZE(,R1) ADDRESS @G38ESBB Q5745900 LA R1,BFWDSC-BFWDSECT(,R1) INDICATE DISPLAY @G38ESBB Q5746000 ALR PC1,R1 STATUS CODE ORDER @G38ESBB Q5746100 BAL PL,PPPUT CALL PPPUT TO ADD CCW @G38ESBB Q5746200 BAL PL,PPWRITE SCHEDULE I/O @G38ESBB Q5746300 L PC1,PCEDCT RESTORE DCT ADDRESS @G38ESBB Q5746400 L PC2,PRPUUCB RESTORE UCB @G38ESBB Q5746500 L PC2,UCBXTADR-UCBDSECT(,PC2) EXTENSION ADR @G38ESBB Q5746600 SPACE 1 @G38ESBB Q5746700 SPRMSG1 DS 0H R4 Q5747000 $MID 190 R4 Q5748000 MVC SPWMSG+7(2),=X'190E' MOVE MESSAGE NUMBER R4 Q5749000 MVC SPWMSG+9(8),JCTJOBID MOVE JOB NUMBER R4 Q5750000 MVI SPWMSG+17,C' ' MOVE SPACE BEFORE JOBNAME R4 Q5751000 MVC SPWMSG+18(8),JCTJNAME MOVE JOBNAME R4 Q5752000 MVC SPWMSG+26(52),=CL52' SETUP -- PRINTERN -- F = FORM -- O CQ5753000 = FLSH -- B = N' MOVE SETUP MESSAGE R4 Q5754000 MVC SPWMSG+36(8),DCTDEVN MOVE DEVICE NAME R4 Q5755000 MVC SPWMSG+52(4),DCTFORMS MOVE FORMS ID R4 Q5756000 MVC SPWMSG+64(4),DCTFLASH MOVE FLASH-FRAME ID R4 Q5757000 TM DCTPPSW2,DCTNIBRS TEST FOR B=N R4 Q5758000 BZ *+8 BR IF YES R4 Q5759000 MVI SPWMSG+76,C'Y' MOVE IN B=Y R4 Q5760000 DROP JCT SUSPEND JCT ADDRESSABILITY R4 Q5761000 SPACE 1 R4 Q5762000 $WTO SPWMSG+7,72,JOB=NO, ISSUE PRINTER SETUP MESSAGE R4CQ5763000 ROUTE=$LOG+$UR,CLASS=$DOMACT,PRI=$ST R4 Q5764000 NI SPWFLAG,255-SPWWTO RESET WTO FLAG R4 Q5765000 SPACE 1 R4 Q5766000 SPRSTOP OI DCTFLAGS,DCTSTOP STOP ($Z) THE PRINTER R4 Q5767000 EJECT R4 Q5768000 * R4 Q5769000 * WAIT FOR $S COMMAND FROM OPERATOR R4 Q5770000 * R4 Q5771000 SPRWAIT DS 0H R4 Q5772000 TM DCTFLAGS,DCTSTOP TEST FOR $S PRINTER R4 Q5773000 BZ SPRSTART BR IF START COMMAND ISSUED R4 Q5774000 NI DCTFLAGS,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET FLG @G38ESBB Q5775000 $WAIT IO WAIT FOR A POST FROM COMM R4 Q5776000 B SPRWAIT GO CHECK FOR $S R4 Q5777000 SPACE 1 R4 Q5778000 SPRSTART DS 0H R4 Q5779000 $DOM CMB=(R1) DELETE SETUP MESSAGE R4 Q5780000 L R1,PCEJQE ADDRESS OF JQE @OZ32566 Q5780200 TM JQEFLAGS-JQEDSECT(R1),QUEOPCAN+QUEPURGE $CJ,P... R41 Q5780400 BNO SPROPTST BR IF NOT $CJ,P R41 Q5780600 OI DCTFLAGS,DCTDELET ELSE SIMULATE $C PRT R41 Q5780800 SPACE 1 R41 Q5780900 SPROPTST TM DCTFLAGS,DCTDELET+DCTRSTRT $C, $E OR $I... R41 Q5781000 BZ SPRLFCB BR IF NO R4 Q5782000 TM JQEFLAGS-JQEDSECT(R1),QUEOPCAN+QUEPURGE $CJ,P...@OZ40469 Q5782025 BNO SPRNTCJP BR IF NOT, TERMINATE @OZ40469 Q5782050 TM PPFLAG,PPDELSW+PRDELSW ALREADY TERMINATING... @OZ40469 Q5782075 BO SPRLFCB BR IF YES, ALLOW OVERRIDE @OZ40469 Q5782100 SPRNTCJP DS 0H @OZ40469 Q5782125 OI PPFLAG,PPDELSW+PRDELSW ELSE CAUSE TERMINATION R41 Q5782200 OC PDCTFLAG,DCTFLAGS PROVIDE TERMINATION REASON R41 Q5782400 NI DCTFLAGS,255-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ18409 Q5782600 OI PPFLAG3,PP3800R SET REPO IN PROGRESS INDIC @OZ45081 Q5782605 L PW,PQHADR ADDRESS PQH @G38ESBB Q5782610 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q5782620 LA R1,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @G38ESBB Q5782630 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q5782640 LR R15,R1 ADDRESS PQE0 @G38ESBB Q5782650 SPACE 1 @G38ESBB Q5782660 SPRPREV L R1,PQEPREV GET PREVIOUS PQE @G38ESBB Q5782670 CLR R1,R15 END OF PPQ... @G38ESBB Q5782680 BE SPREVERT YES, BRANCH @G38ESBB Q5782690 CLI PQETYPE,PQEC CHECKPOINT PQE... @G38ESBB Q5782700 BNE SPRPREV NO, LOOP BACK @G38ESBB Q5782710 L PL,PQECPQED ADDRESS DATA SET PQE @G38ESBB Q5782720 CLC PQEDWJOE-PQEDSECT(,PL),PWKJOE DOES JOB HAVE ANY @G38ESBB Q5782730 BNE SPREVERT PQE'S..NO,BRANCH @G38ESBB Q5782740 OI PQECFLAG,PQECLPG SET LAST PAGE OF DATA SET @G38ESBB Q5782750 OI PQEDFLAG-PQEDSECT(PL),PQEDLAST LAST DS OF JOE @G38ESBB Q5782760 TM PDCTFLAG,DCTDELET IS COMMAND $C... @G38ESBB Q5782770 BZ SPRCHKIN NO, GO CHECK $I $E @G38ESBB Q5782780 OI PQEDFLAG-PQEDSECT(PL),PQEDCAN SET DS CANCELLED @G38ESBB Q5782790 B SPRESET GO RESET COMMAND FLAG @G38ESBB Q5782800 SPACE 1 @G38ESBB Q5782810 SPRCHKIN TM PDCTFLAG,DCTBKSP IS COMMAND $I... @G38ESBB Q5782820 BZ SPRECMD NO, GO PROCESS $E @G38ESBB Q5782830 OI PQEDFLAG-PQEDSECT(PL),PQEDINT SET DS INTERRUPT @G38ESBB Q5782840 IC R14,PQHCMDCT INCREMENT @G38ESBB Q5782850 LA R14,1(,R14) COUNT OF DEFERRED @G38ESBB Q5782860 STC R14,PQHCMDCT $I COMMANDS @G38ESBB Q5782870 B SPRESET GO RESET COMMAND FLAG @G38ESBB Q5782880 SPACE 1 @G38ESBB Q5782890 SPRECMD $#ADD WORK=PWKJOE,CHAR=PCHJOE REQUEUE JOE FOR $E @G38ESBB Q5782900 BZ SPRESET BRANCH IF SUCCESSFUL @G38ESBB Q5782910 OI PQEDFLAG-PQEDSECT(PL),PQEDRST DEFER $E CMD @G38ESBB Q5782920 IC R14,PQHCMDCT INCREMENT @G38ESBB Q5782930 LA R14,1(,R14) DEFERRED @G38ESBB Q5782940 STC R14,PQHCMDCT COMMAND COUNT @G38ESBB Q5782950 SPACE 1 @G38ESBB Q5782960 SPRESET OI PQHFLAG,PQHDSVC INDICATE RESET NEEDED @OZ45081 Q5782970 DROP R1,PW DROP PQE,PQH ADDRESSABILITY @G38ESBB Q5782980 SPACE 1 @G38ESBB Q5782990 * R4 Q5783000 * IF PRINTER CANCELLED -- REVERT TO PREVIOUS SETUP R41 Q5784000 * R4 Q5785000 SPACE 1 @G38ESBB Q5785500 SPREVERT MVC DCTFORMS(3*4),SPWFORMS RESET FORMS-FCB-DEF CHAR @G38ESBB Q5786000 MVC DCTCHAR1(4*4),SPWCHAR1 RESET CHAR1,2,3,4 VALUES R4 Q5787000 MVC DCTFLASH,=C'****' CLEAR FLASH AND R4 Q5788000 MVC DCTMODF,=C'****' COPY MODIFICATION R4 Q5789000 OI SPWFLAG,SPWCLRM CLEAR COPYMOD @OZ50544 Q5789100 NI DCTPPSW2,255-DCTNIBRS RESET R4 Q5790000 TM SPWFLAG,SPWDCTB THE R4 Q5791000 BZ SPRLFCB BURSTER R4 Q5792000 OI DCTPPSW2,DCTNIBRS STATUS R4 Q5793000 EJECT R4 Q5794000 * R4 Q5795000 * DETERMINE IF A CALL TO SETPRT (SVC 81) IS NECESSARY R4 Q5796000 * R4 Q5797000 SPACE 1 @G38ESBB Q5797500 SPRLFCB TM PPFLAG3,PP3800R TEST FOR COMMAND REPOSITION @G38ESBB Q5798000 BZ SPRLTSTF BR IF NOT @G38ESBB Q5798020 L PW,PQHADR GET PENDING PAGE QUEUE ADDR @G38ESBB Q5798040 USING PQHDSECT,PW PQH ADDRESSABILITY @G38ESBB Q5798060 CLC PQHMAPV,$ZEROS TEST FOR MAPPING NEEDED @G38ESBB Q5798080 BE SPRLTSTF BR IF NOT @G38ESBB Q5798100 SPACE 1 @G38ESBB Q5798120 ***************************************************************@G38ESBB Q5798140 * @G38ESBB Q5798160 * FCB LOAD IS NEEDED FOR COMMAND REPOSITIONING @G38ESBB Q5798180 * @G38ESBB Q5798200 ***************************************************************@G38ESBB Q5798220 SPACE 1 @G38ESBB Q5798240 $GETBUF WAIT=YES GET BUFFER FOR FCB LOAD @G38ESBB Q5798260 ST R1,PQHFCB SAVE BUFFER ADDR IN PQH @G38ESBB Q5798280 USING BUFDSECT,R1 FCB BUFFER ADDRESSABILITY @G38ESBB Q5798300 ST R4,BUFDCT INIT BUFDCT @G38ESBB Q5798320 CLI DCTFCB,C'*' TEST FOR FCB SPECIFIED @G38ESBB Q5798340 BE PFCBBLD GO BUILD DEFAULT FCB IF NOT @G38ESBB Q5798360 MVC BUFSTART(4),=X'0001003A' CREATE BLDL LIST @G38ESBB Q5798380 MVC BUFSTART+4(4),=C'FCB3' FCB PREFIX @G38ESBB Q5798400 MVC BUFSTART+8(4),DCTFCB FCB NAME @G38ESBB Q5798420 SPACE 1 @G38ESBB Q5798440 PIMGBUSY TM $IMAGECB,X'40' IS IMAGE LOADER TASK BUSY @G38ESBB Q5798460 BNO PIMGPOST BR IF NOT @G38ESBB Q5798480 $WAIT IMAG WAIT FOR IMAGE TASK $$POST @G38ESBB Q5798500 B PIMGBUSY TRY AGAIN @G38ESBB Q5798520 SPACE 1 @G38ESBB Q5798540 PIMGPOST L R1,PQHFCB ADDRESS BUFFER FOR FCB @G38ESBB Q5798560 MVI BUFECBCC,X'80' SET BUFFER ECB AS WAITING @G38ESBB Q5798580 POST $IMAGECB,(R1) POST WITH BUFFER ADDRESS @G38ESBB Q5798600 SPACE 1 @G38ESBB Q5798620 PIMGWT $WAIT IMAG WAIT FOR IMAGE TASK $$POST @G38ESBB Q5798640 L R1,PQHFCB RESTORE FCB BUFFER ADDRESS @G38ESBB Q5798660 TM BUFECBCC,X'7F' TEST STATUS OF LOAD REQUEST @G38ESBB Q5798680 BZ PIMGWT BR IF NOT COMPLETE @G38ESBB Q5798700 BO SPRLINIT BR IF SUCCESSFUL @G38ESBB Q5798720 $MID 180 FCB LOAD FAILED @G38ESBB Q5798740 PMSG BUFSTART,M180L,(X'180F',DCTDEVN,C' FCB IMAGE ',DCTFCB,C'CQ5798760 NOT FOUND') MOVE MESSAGE TEXT @G38ESBB Q5798780 $WTO BUFSTART,M180L,JOB=YES, ISSUE BUF LOAD FAIL MSG @G38ESBBCQ5798800 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST @G38ESBB Q5798820 MVC PQHMAPV,$ZEROS RESTART FROM LAST CHECKPT @G38ESBB Q5798840 XC PDDBSKIP,PDDBSKIP INDICATE PRINTING TO START @G38ESBB Q5798860 $FREEBUF PQHFCB FREE FCB BUFFER @G38ESBB Q5798880 XC PQHFCB,PQHFCB ZERO FCB ADDRESS @G38ESBB Q5798900 B SPRLINIT BR TO FINISH SETUP @G38ESBB Q5798920 EJECT @G38ESBB Q5798940 ***************************************************************@G38ESBB Q5798960 * @G38ESBB Q5798980 * BUILD A DEFAULT FCB WHEN NO IMAGE NAME IS AVAILABLE @G38ESBB Q5799000 * @G38ESBB Q5799020 ***************************************************************@G38ESBB Q5799040 SPACE 1 @G38ESBB Q5799060 PFCBBLD LM PC1,PC2,PCCWNOP LOAD CCW TO GET RPI/SIB @G38ESBB Q5799080 ICM PC2,B'1000',=X'60' SET CHAINING ON IN AREA @G38ESBB Q5799100 BAL PL,PPPUT ADD CCW TO AREA @G38ESBB Q5799120 BAL PL,PPWRITE WRITE CCW AREA @G38ESBB Q5799140 BAL PL,PPCHECK COMPLETE I/O @G38ESBB Q5799160 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q5799180 L R1,PQHFCB RESTORE FCB BUFFER ADDRESS @G38ESBB Q5799200 LA R1,BUFSTART GET FCB ADDRESS @G38ESBB Q5799220 USING PFCB,R1 FCB BUFFER ADDRESSABILITY @G38ESBB Q5799240 L PC1,PCEDCT RESTORE DCT ADDRESS @G38ESBB Q5799260 L PC2,PRPUUCB RESTORE UCB @G38ESBB Q5799280 L PC2,UCBXTADR-UCBDSECT(,PC2) EXTENSION ADDRESS @G38ESBB Q5799300 DROP PW SUSPEND PQH ADDRESSABILITY @G38ESBB Q5799320 SPACE 1 @G38ESBB Q5799340 ***************************************************************@G38ESBB Q5799360 * @G38ESBB Q5799380 * DETERMINE FCB LENGTH FROM FORMS LENGTH IN HALF INCHES @G38ESBB Q5799400 * @G38ESBB Q5799420 ***************************************************************@G38ESBB Q5799440 SPACE 1 @G38ESBB Q5799460 LH PW,PCCWLAST GET OFFSET TO PCIE @G38ESBB Q5799480 AL PW,POUTCCWN ADD CCW AREA BASE @G38ESBB Q5799500 LA PW,PCIESIZE(,PW) GET TO BUFFER WORK AREA @G38ESBB Q5799520 SLR PL,PL CLEAR FOR INSERT @G38ESBB Q5799540 IC PL,BFWFLENG-BFWDSECT(,PW) GET FORMS LENGTH @G38ESBB Q5799560 BCTR PL,0 SUBTRACT TOP 1/2 INCH @G38ESBB Q5799580 BCTR PL,0 SUBTRACT BOTTOM 1/2 INCH @G38ESBB Q5799600 MH PL,PH6LPI GET # OF LINES IN 6 LPI FCB @G38ESBB Q5799620 STH PL,PFCBLENG SAVE FCB LENGTH @G38ESBB Q5799650 MVI PFCBSTRT,X'01' SET CHAN 1 IN FIRST BYTE @G38ESBB Q5799700 BCTR PL,0 DECREMENT FOR CHANNEL 1 @G38ESBB Q5799750 BCTR PL,0 DECREMENT FOR EXECUTE @G38ESBB Q5799800 EX PL,PFCBCLR SET REMAINING FCB TO ZERO @G38ESBB Q5799850 SPACE 1 @G38ESBB Q5799900 SPRLTSTF CLI DCTFCB,C'*' TEST FOR FCB SPECIFIED @G38ESBB Q5799950 BNE SPRLINIT BR IF YES @G38ESBB Q5800000 CLI UCBFCBNM,X'40' TEST FOR HDWR DEFAULT LOADED R41 Q5801000 BE SPRLCHRS BR IF YES R4 Q5802000 OI SPWFLAG,SPWINIT+SPWSETP INIT-PRT SETS HDWR DEFAULT R41 Q5803000 B SPRLCHRS BR TO CONTINUE R41 Q5804000 SPACE 1 @G38ESBB Q5804100 PFCBCLR XC PFCBSTRT+1(*-*),PFCBSTRT+1 EXECUTE ONLY @G38ESBB Q5804200 SPACE 1 @G38ESBB Q5804300 DROP R1 SUSPEND FCB BUFFER @G38ESBB Q5804400 EJECT @G38ESBB Q5804500 SPRLINIT TM SPWFLAG,SPWINIT INITIALIZE PRINTER... @G38ESBB Q5805000 BO SPRLFCBN FORCE FCB UPDATE IF YES @G38ESBB Q5805200 CLC DCTFCB,UCBFCBNM FCB MATCH PRINTER FCB... R41 Q5805400 BE SPRLCHRS BR IF YES R41 Q5805600 SPACE 1 R41 Q5805800 SPRLFCBN MVC SPPFCB,DCTFCB SHOW SETPRT CALL NEEDED @G38ESBB Q5805900 OI SPWFLAG,SPWSETP TO LOAD FCB R41 Q5806000 SPACE 1 R4 Q5807000 SPRLCHRS DS 0H R4 Q5808000 TM SPWFLAG,SPWINIT IF INIT BIT IS SET, R4 Q5809000 BO SPRLC2 THEN FORCE UPDATE R4 Q5810000 LA R1,DCTCHAR1 IF ANY R4 Q5811000 LA R15,UCBCHAR1 CHARS VALUES R4 Q5812000 LA R0,4 DIFFER R4 Q5813000 SPRLC1 CLI 0(R1),C'*' FROM R4 Q5814000 BE SPRLFLSH UCB, R4 Q5815000 CLC 0(4,R1),0(R15) THEN R4 Q5816000 BNE SPRLC2 BRANCH R4 Q5817000 LA R1,4(,R1) TO R4 Q5818000 LA R15,4(,R15) LOAD R4 Q5819000 BCT R0,SPRLC1 ALL SPECIFIED R4 Q5820000 B SPRLFLSH ELSE, DON'T CALL SETPRT R4 Q5821000 SPACE 1 R4 Q5822000 SPRLC2 CLI DCTCHAR1,C'*' UNTIL R4 Q5823000 BE SPRLFLSH END R4 Q5824000 MVC SPPXLAT1,DCTCHAR1 OF R4 Q5825000 OI SPWFLAG,SPWSETP CHARS R4 Q5826000 CLI DCTCHAR2,C'*' VALUES R4 Q5827000 BE SPRLFLSH IS R4 Q5828000 MVC SPPXLAT2,DCTCHAR2 REACHED, R4 Q5829000 CLI DCTCHAR3,C'*' UPDATE R4 Q5830000 BE SPRLFLSH PARAMETER R4 Q5831000 MVC SPPXLAT3,DCTCHAR3 LIST R4 Q5832000 CLI DCTCHAR4,C'*' AND INDICATE R4 Q5833000 BE SPRLFLSH SETPRT R4 Q5834000 MVC SPPXLAT4,DCTCHAR4 CALL NEEDED R4 Q5835000 EJECT @OZ18414 Q5836000 SPRLFLSH CLI DCTFLASH,C'*' FLASH SPECIFIED... @OZ18414 Q5836500 BNE SPRLF1 BR IF YES @OZ18414 Q5837000 CLI UCBIMAGE,X'40' FLASH ACTIVE... @OZ18414 Q5837500 BE SPRLBRST BR IF NO @OZ18414 Q5838000 MVC SPPIMAGE,=X'40000000' ELSE RESET FLASH ID @OZ18414 Q5838500 B SPRLF2 BR TO CONTINUE @OZ18414 Q5839000 SPACE 1 @OZ18414 Q5839500 SPRLF1 MVC SPPIMAGE,DCTFLASH SET FLASH ID @OZ18414 Q5840000 TM SPFLAG,SPSEP+SPNOFLSH INHIBIT FLASHING... @OZ38238 Q5840500 BNZ SPRLF2 SET ZERO COUNT IF YES @OZ38238 Q5841000 ICM PW,1,SPFLASHC GET FLASH-COPY COUNT @OZ18414 Q5841500 BNZ *+8 USE IT IF NOT ZERO @OZ18414 Q5842000 LA PW,255 ELSE USE MAX COPY COUNT @OZ18414 Q5842500 STC PW,SPPFRMNR SET FLASH COUNT @OZ18414 Q5843000 TM SPWFLAG,SPWINIT INITIALIZE PRINTER... @OZ18414 Q5843500 BO SPRLBRST BR IF YES @OZ18414 Q5844000 CLC DCTFLASH,UCBIMAGE THIS FLASH LOADED... @OZ18414 Q5845000 BNE SPRLF2 BR IF NO @OZ18414 Q5846000 CLM PW,1,PREVFLCT FLASH COUNT LOADED... @OZ18414 Q5847000 BE SPRLBRST SKIP SETPRT IF YES @OZ18414 Q5848000 SPACE 1 @OZ18414 Q5849000 SPRLF2 OI SPWFLAG,SPWSETP INDICATE SETPRT NEEDED @OZ18414 Q5850000 SPACE 1 R4 Q5851000 SPRLBRST DS 0H R4 Q5852000 TM UCBOPTNS,UCBBRSTR TEST FOR 3800 BURSTER FEATURE R4 Q5853000 BZ SPRLMODF BR IF NO R4 Q5854000 TM DCTPPSW2,DCTNIBRS TEST FOR BURSTER WANTED R4 Q5855000 BZ SPRLB1 BR IF NO R4 Q5856000 TM UCBACTIV,UCBBRSTA TEST FOR BURSTER ACTIVE R4 Q5857000 BO SPRLMODF BR IF YES R4 Q5858000 OI SPPFLAG1,SPPBURST INDICATE BURST=YES R4 Q5859000 B SKIP740 GO TO INDICATE SETPRT NEEDED R4 Q5860000 SPRLB1 TM UCBACTIV,UCBBRSTA TEST FOR BURSTER ACTIVE R4 Q5861000 BZ SPRLMODF BR IF NO R4 Q5862000 SKIP740 OI SPWFLAG,SPWSETP INDICATE SETPRT NEEDED R4 Q5863000 SPACE 1 R4 Q5864000 SPRLMODF DS 0H R4 Q5865000 CLI DCTMODF,C'*' TEST FOR MODIFY SPECIFIED R4 Q5866000 BNE SPRLM1 BR IF YES R4 Q5867000 TM SPWFLAG,SPWCLRM TEST FOR COPY MOD RESET NEEDED R4 Q5868000 BZ SPRPCOPY BR IF NO R4 Q5869000 LA R1,SPRNULLM ADDR OF NULL COPY MOD R4 Q5870000 ST R1,SPPMDPTA INTO SETPRT LIST R4 Q5871000 OI SPPFLAG2,SPPMODI INDICATE IN-CORE COPY MOD R4 Q5872000 B SPRLM2 GO INDICATE SETPRT NEEDED R4 Q5873000 SPRLM1 MVC SPPMODPT,DCTMODF MOVE COPY MOD ID INTO LIST R4 Q5874000 SLR PW,PW ASSUME MODIFY-TRC=0 @OZ18410 Q5875000 CLC SPMODFT,PRMAXTRC IS MODIFY-TRC VALID... @OZ18410 Q5875500 BH *+8 BR IF NOT TO USE TRC=0 @OZ18410 Q5876000 IC PW,SPMODFT ELSE USE SUPPLIED MOD-TRC @OZ18410 Q5876500 IC PW,PXTABCCW(PW) DETERMINE @OZ18410 Q5877000 SLL PW,26 ACTUAL @OZ18410 Q5877500 SRL PW,30 CHARACTER SET @OZ18410 Q5878000 STC PW,SPPTRC POSITION @OZ18410 Q5878500 SPRLM2 OI SPWFLAG,SPWSETP INDICATE SETPRT NEEDED R4 Q5879000 SPACE 1 R4 Q5880000 SPRPCOPY DS 0H R4 Q5881000 CLC PREVCPYS(2),SPCOPYS TEST IF COUNTS MATCH PREVIOUS R4 Q5882000 BE SPRSETP BR IF YES R4 Q5883000 OI SPWFLAG,SPWSETP ELSE, FORCE A CALL TO SETPRT R4 Q5884000 EJECT R4 Q5885000 * R4 Q5886000 * CALL SETPRT (SVC 81) VIA JES2 IMAGE LOADER SUB-TASK R4 Q5887000 * R4 Q5888000 SPRSETP DS 0H R4 Q5889000 TM SPWFLAG,SPWSETP TEST FOR SETPRT NEEDED R4 Q5890000 BZ SPREXIT BR IF NO R4 Q5891000 SPACE 1 R4 Q5892000 TM SPWFLAG,SPWINIT TEST FOR INIT NEEDED R4 Q5893000 BZ SKIP750 BR IF NO R4 Q5894000 OI SPPFLAG1,SPPINIT ELSE, TELL SETPRT R4 Q5895000 SKIP750 B SPRSETP1 GO CALL SETPRT R4 Q5896000 SPACE 1 R4 Q5897000 SPRRXMIT DS 0H R4 Q5898000 MVC SPPFRMNR,SPFLASHC MOVE IN FLASH COUNT R4 Q5899000 OI SPPFLAG1,SPPREX INDICATE RE-XMISSION TO SETPRT R4 Q5900000 NI SPFLAG,255-SPREXMIT RESET PRPU FLAG INDICATION R4 Q5901000 SPACE 1 R4 Q5902000 SPRSETP1 DS 0H R4 Q5903000 L R1,DCTDCB ADDRESS 3800 DCB R4 Q5904000 NI DCBIFLGS-DCBDSECT(R1),253-DCBIFEC RESET @OZ46952CQ5905000 DCBIFEC AND DCBIFLDT @OZ46952 Q5905010 ST R1,SPPDCBA SET DCB ADDR IN PARMLIST R4 Q5906000 MVI SPPFDUNF,SPPFBLK+SPPEXTL BLK DATA CK + EXTENDED LIST R4 Q5907000 OI SPPFLAG1,SPPBFREQ+SPPBTREQ BYPASS ALL POSSIBLE WTOR'S R4 Q5908000 MVC SPPCPYNR(1),SPCOPYN MOVE IN NUMBER OF COPIES R4 Q5909000 MVC SPPSTCNR(1),SPCOPYS MOVE IN STARTING COPY NUMBER R4 Q5910000 MVC PREVCPYS(2),SPCOPYS SAVE COPY COUNTS R4 Q5911000 MVC PREVFLCT,SPPFRMNR SAVE FLASH COUNT @OZ18414 Q5911500 XC SPWMSG,SPWMSG CLEAR SETPRT MESSAGE AREA @G38ESBB Q5912000 LA R1,L'SPWMSG-M151L+(SPPTXT-SPPMCOMA) MSG LENGTH @G38ESBB Q5913000 LA R15,SPWMSG GET MESSAGE FEEDBACK AREA @G38ESBB Q5914000 STH R1,M151L-(SPPTXT-SPPMCOMA)(,R15) STORE MSG LNG @G38ESBB Q5915000 LA R15,M151L-(SPPTXT-SPPMCOMA)(,R15) GET MSG ADDR @G38ESBB Q5916000 ST R15,SPPEMSGA PASS ADDRESS FOR SETPRT USE @G38ESBB Q5917000 MVI SPPLEN+1,SPPEND-SPPARM SET SETPRT PARM LENGTH @G38ESBB Q5917500 L R1,PRIMGDTE ADDR OF HASPIMAG DTE @OZ26939 Q5918000 LA R1,8(,R1) ADDR OF HASPIMAG WORK-ECB @OZ26939 Q5919000 MVI BUFECBCC-BUFDSECT(PBUF),X'80' SET ECB AS WAITING R4 Q5920000 POST (1),(PBUF) POST (PASSING BUFFER ADDR) @OZ26939 Q5921000 SPACE 1 R4 Q5922000 SPRWIM2 DS 0H R4 Q5923000 $WAIT IMAG WAIT FOR POST FROM SUB-TASK R4 Q5924000 TM BUFECBCC-BUFDSECT(PBUF),X'7F' TEST STATUS OF SETPRT R4 Q5925000 BZ SPRWIM2 BR IF NOT COMPLETE R4 Q5926000 BO SPREXIT BR IF SUCCESSFUL R4 Q5927000 EJECT R4 Q5928000 * R4 Q5929000 * SETPRT ERROR DETECTED - ATTEMPT RECOVERY R4 Q5930000 * R4 Q5931000 SPACE 1 R4 Q5932000 SPRERR DS 0H R4 Q5933000 CLI SPWRTCDE,0 TEST RETURN CODE R4 Q5934000 BE SPREXIT EXIT IF ALL IS OK R4 Q5935000 CLI SPWRTCDE,SPPLDATA PAPER JAM OR CANCEL KEY @G38ESBB Q5935010 BE SPRCKJAM DURING SETPRT @G38ESBB Q5935020 * THIS LINE DELETED BY APAR NUMBER @OZ45281 Q5935025 LA R1,SPWMSG GET SETPRT MSG AREA @G38ESBB Q5935030 LA R1,M151L-(SPPTXT-SPPMCOMA)(,R1) OFFSET TO MSG @G38ESBB Q5935040 USING SPPMCOMA,R1 MSG AREA ADDRESSABILITY @G38ESBB Q5935050 TM SPWFLAG,SPWDEFLT ATTEMPT TO ADD DEFAULT... @OZ39479 Q5935100 BZ SPERR1 BR IF NO @OZ39479 Q5935175 CLI SPWRTCDE,X'30' ELSE BRANCH TO @OZ39479 Q5935250 BE SPREMOVE REMOVE THE @OZ39479 Q5935325 CLI SPWRSCDE,X'04' DEFAULT CHARACTER @OZ39479 Q5935400 BE SPREMOVE SET FROM THE @OZ39479 Q5935475 CLI SPWRSCDE,X'10' REQUEST IF THE @OZ39479 Q5935550 BE SPREMOVE ERROR MIGHT HAVE @OZ39479 Q5935625 CLI SPWRSCDE,X'1C' BEEN CAUSED BY THE @OZ39479 Q5935700 BE SPREMOVE ATTEMPT TO LOAD IT @OZ39479 Q5935775 SPACE 1 @OZ39479 Q5935900 SPERR1 OI SPWFLAG,SPWSETP+SPWINIT CAN'T TRUST SETUP @OZ45281 Q5936000 CLC SPPTXTL,$ZEROS DID SETPRT PROVIDE MSG... @OZ45281 Q5936500 BE SPRNOMSG BR IF NO @G38ESBB Q5937000 CLI SPWRSCDE,SPPCPMOD COPYMOD ERROR @G38ESBB Q5938000 BNE SPREFLSH BR IF NOT @G38ESBB Q5939000 OI SPWFLAG,SPWCLRM INDICATE CLEAR IF OP RESETS @G38ESBB Q5940000 B SPRRMSG BR TO WRITE MSG @G38ESBB Q5941000 SPACE 1 @G38ESBB Q5942000 SPREFLSH CLI SPWRSCDE,SPPFOSEQ FLASH ERROR @G38ESBB Q5943000 BE SPRWTON BR IF YES @G38ESBB Q5944000 CLI SPWRSCDE,X'00' UNKNOWN ERROR @G38ESBB Q5945000 BNE SPRRMSG BR IF NOT @G38ESBB Q5946000 SPACE 1 @G38ESBB Q5947000 SPRWTON OI SPWFLAG,SPWWTO SHOW SETUP MSG NEEDED @G38ESBB Q5948000 B SPRRMSG @G38ESBB Q5949000 SPACE 1 @G38ESBB Q5950000 SPRCKJAM OI DCTPPSW2,DCTCKJAM+DCTNINIT LOST DATA + INIT PRT @G38ESBB Q5951000 MVC DCTLDPID,UCBPGID GET ORIGIN PAGE ID @G38ESBB Q5952000 OI PPFLAG,PPDELSW INDIC SUSPENSION @G38ESBB Q5953000 MVC PFSBSCT,$ZEROS DEFAULT TO PAPER JAM @G38ESBB Q5954000 CLI SPWRSCDE,SPPCNCLK CANCEL KEY... @G38ESBB Q5955000 BNE SPREXIT2 BR IF NOT @G38ESBB Q5956000 MVC PFSBSCT,PMAXPAGE INDICATE $F PRTN,D @G38ESBB Q5956500 B SPREXIT2 BR TO RETURN @G38ESBB Q5957000 SPACE 1 @G38ESBB Q5957500 * THIS LINE DELETED BY APAR @OZ39479 Q5958000 * THIS LINE DELETED BY APAR @OZ39479 Q5958100 SPREMOVE SLR R1,R1 REMOVE @OZ39479 Q5958200 IC R1,PRMAXTRC DEFAULT R41 Q5958300 SLL R1,2 CHAR (DCTUCS) R41 Q5958400 LA PW,DCTCHAR1+4(R1) FROM R41 Q5958500 MVC 0(4,PW),=C'****' REQUEST R41 Q5958600 NI SPWFLAG,255-SPWDEFLT RESET DEFAULT-ATTEMPT FLAG R41 Q5958700 LA PW,SPPXLAT1+4(R1) REMOVE REQUEST FROM R41 Q5958800 XC 0(4,PW),0(PW) SETPRT PARMLIST R41 Q5958900 NI SPPFLAG1,FF-SPPBOMSG TURN OFF BYPASS WCGM MSG @G38ESBB Q5958950 B SPRSETP BR TO RETRY SETPRT REQUEST @G38ESBB Q5959000 SPACE 1 R41 Q5959100 SETRTCD EQU SPWSAVE1,2*L'SPWRTCDE WORK AREA FOR RETURN CODE @G38ESBB Q5959120 SPACE 1 @G38ESBB Q5959140 SPRNOMSG UNPK SETRTCD(L'SETRTCD+1),SPWRTCDE(L'SPWRTCDE+1) @G38ESBBCQ5959200 GET RETURN CODE AND @G38ESBB Q5959500 TR SETRTCD,$HEXTRAN TRANSLATE TO EBCDIC @G38ESBB Q5960000 $MID 157 SETPRT ERROR, NO MESSAGE @G38ESBB Q5960500 PMSG SPWMSG,M157L,(X'157F',DCTDEVN,C' SETPRT ERROR, RETURN COCQ5961000 DE=',SETRTCD) MOVE MESSAGE TEXT @G38ESBB Q5961500 MVI SPPRSV08+1,M157L-M151L SET MESSAGE LENGTH @OZ45079 Q5962000 B SPRWTO GO ISSUE MESSAGE @G38ESBB Q5962500 SPACE 1 @G38ESBB Q5963000 ***************************************************************@G38ESBB Q5963200 * @G38ESBB Q5963400 * WRITE SETPRT ERROR MESSAGE TO THE CONSOLE @G38ESBB Q5963600 * @G38ESBB Q5963800 ***************************************************************@G38ESBB Q5964000 SPACE 1 @G38ESBB Q5964200 SPRRMSG DS 0H ISSUE SETPRT ERROR MESSAGE @G38ESBB Q5964400 IC R15,SPPTXTL+1 SAVE MESSAGE LENGTH @OZ45079 Q5964500 $MID 151 SETPRT ERROR MESSAGE @G38ESBB Q5964600 PMSG SPWMSG,M151L,(X'151F',DCTDEVN,C' ') @G38ESBBCQ5964800 MOVE MESSAGE TEXT @G38ESBB Q5965000 STC R15,SPPRSV08+1 SAVE MESSAGE LENGTH @OZ45079 Q5965100 SPACE 1 @G38ESBB Q5965200 SPRWTO LM PC1,PC2,PCCWCP LOAD CLEAR PRINT CCW @G38ESBB Q5965400 BAL PL,PPPUT ADD CCW TO AREA @G38ESBB Q5965600 BAL PL,PPWRITE WRITE CCW AREA @G38ESBB Q5965800 BAL PL,PPCHECK WAIT FOR I/O TO FINISH @G38ESBB Q5966000 L PC1,PCEDCT ADDRESS 3800 DCT @G38ESBB Q5966200 L PC2,PRPUUCB ADDRESS UCB @G38ESBB Q5966400 L PC2,UCBXTADR-UCBDSECT(,PC2) ADR UCB EXTENSION @G38ESBB Q5966600 LA R1,SPWMSG RESTORE MESSAGE AREA ADR @G38ESBB Q5966800 LA R1,M151L-(SPPTXT-SPPMCOMA)(,R1) GET MSG ADDR @G38ESBB Q5967000 SLR R15,R15 CLEAR WORK REGISTER @OZ45079 Q5967500 IC R15,SPPRSV08+1 GET MESSAGE LENGTH @OZ45079 Q5967600 MVI SPPRSV08+1,C' ' RESTORE BLANK TEXT @OZ45079 Q5967700 LA R15,M151L(,R15) ACCOUNT FOR MSG PREFIX LGTH @G38ESBB Q5968000 $WTO SPWMSG,(R15),JOB=YES, TELL OPERATOR @G38ESBBCQ5968500 ROUTE=$LOG+$UR,CLASS=$DOMACT,PRI=$ST @G38ESBB Q5969000 ST R1,SPWSAVE1 SAVE CMB ADDRESS @G38ESBB Q5969200 USING BUFDSECT,R1 RESTORE FCB BUFFER ADR @G38ESBB Q5969400 USING JCTDSECT,JCT JCT ADDRESSABILITY @G38ESBB Q5969600 EJECT @G38ESBB Q5969800 ***************************************************************@G38ESBB Q5970000 * @G38ESBB Q5970500 * WRITE SETPRT ERROR MESSAGE TO THE PROGRAMMER @G38ESBB Q5971000 * @G38ESBB Q5971500 ***************************************************************@G38ESBB Q5972000 SPACE 1 @G38ESBB Q5972500 $MID 154 SETPRT ERROR MSG TO PRINTER @G38ESBB Q5972800 PMSG SPWMSG,M154L,(C'$HASP154 SETPRT ERROR DEVICE=',DCTDEVN,CCQ5973000 ' JOB=',JCTJNAME,C' ID=',JCTJOBID,C' ROOM=',JCTROOMN) CQ5974000 MOVE MESSAGE TEXT @G38ESBB Q5975000 LA R1,SPWMSG GET ADDR OF MSG AREA @G38ESBB Q5976000 LM PC1,PC2,PRCCWCOM LOAD PRINT CCW @G38ESBB Q5977000 ALR PC1,R1 UPDATE DATA ADDRESS @G38ESBB Q5978000 IC PC2,=AL1(M154L) GET LENGTH OF MESSAGE @G38ESBB Q5979000 BAL PL,PPPUT ADD CCW TO AREA @G38ESBB Q5980000 BAL PL,PPWRITE WRITE MESSAGE TO PRINTER @G38ESBB Q5981000 BAL PL,PPCHECK CHECK MSG IO COMPLETION @G38ESBB Q5982000 SPACE 1 @G38ESBB Q5983000 DROP JCT SUSPEND JCT @G38ESBB Q5984000 SPACE 1 @G38ESBB Q5985000 * DELETED @G38ESBB Q5986000 SPACE 1 @G38ESBB Q5987000 ***************************************************************@G38ESBB Q5988000 * @G38ESBB Q5989000 * RESTORE 3800 DEVICE SETUP CONTROL BLOCKS @G38ESBB Q5990000 * @G38ESBB Q5991000 ***************************************************************@G38ESBB Q5992000 SPACE 1 @G38ESBB Q5993000 L PC1,PCEDCT ADDRESS 3800 DCT @G38ESBB Q5994000 L PC2,PRPUUCB EXTENSION @G38ESBB Q5995000 L PC2,UCBXTADR-UCBDSECT(,PC2) ADDRESSABILITY @G38ESBB Q5996000 * DELETED @G38ESBB Q5997000 * DELETED @G38ESBB Q5998000 * DELETED @G38ESBB Q5999000 OI SPWFLAG,SPWSETP FORCE CALL TO SETPRT R4 Q6000000 XC SPPARM(SPWFORMS-SPPARM),SPPARM RESET PARMLIST R4 Q6001000 L R1,SPWSAVE1 RESTORE CMB ADDRESS @G38ESBB Q6001400 TM SPWFLAG,SPWWTO TEST FOR SETUP MSG NEEDED R4 Q6002000 BZ SPRSTOP BR IF NOT -- WAIT FOR OPERATOR R4 Q6003000 $DOM CMB=(R1) DELETE ERROR MESSAGE @G38ESBB Q6003500 B SPRMSG1 GO ISSUE SETUP MESSAGE R41 Q6004000 SPACE 1 R41 Q6005000 SPREXIT TM UCBOPTNS,UCBBRSTR DON'T VALIDATE STACKER IF R41 Q6007000 BZ SPREXIT1 BTSS NOT INSTALLED R4 Q6008000 TM DCTPPSW2,DCTNIBRS TEST WANTED-STACKER R4 Q6009000 BZ SPRXCFS BR IF CFS R4 Q6010000 TM UCBACTIV,UCBBRSTA TEST ACTUAL-STACKER R4 Q6011000 BZ SPRMSG1 ERROR IF NOT BTSS R4 Q6012000 B SPREXIT1 OK IF CFS R4 Q6013000 SPRXCFS TM UCBACTIV,UCBBRSTA TEST ACTUAL-STACKER R4 Q6014000 BO SPRMSG1 ERROR IF BTSS R4 Q6015000 EJECT R41 Q6016000 SPREXIT1 DS 0H ISSUE EJECT CCW @G38ESBB Q6018000 NI DCTPPFL,FF-DCTEJECT RESET CHAN 1 SWITCH @OZ57092 Q6018100 LM PC1,PC2,PRCCWEJ SKIP TO R41 Q6018200 BAL PL,PPPUT TOP R41 Q6018400 ICM PC1,8,PXTABCCW SELECT @OZ24675 Q6018500 BAL PL,PPPUT2 CHAR1 @OZ51441 Q6018550 BAL PL,PPWRITE OF R41 Q6018600 BAL PL,PPCHECK PAGE R41 Q6018800 SPACE 1 @G38ESBB Q6018850 SPREXIT2 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q6018900 * DELETED @G38ESBB Q6019000 * DELETED @G38ESBB Q6020000 SPACE 4 R41 Q6020100 * R41 Q6020200 * SPRTDFLT -- SUBR TO TEST IF DEFAULT CHAR IS LOADED R41 Q6020300 * R41 Q6020400 * OUTPUT CC = ZERO - DEFAULT ALREADY LOADED R41 Q6020500 * CC = NON-ZERO - DEFAULT NOT LOADED R41 Q6020600 * PW = ADDR OF CCW TO SELECT DEFAULT (IF CC=ZERO) R41 Q6020700 * R41 Q6020800 SPACE 1 R41 Q6020900 SPRTDFLT LA R0,4 COUNT OF CHARS R41 Q6021000 LA R15,DCTCHAR1 ADDR OF CHARS R41 Q6021100 LA PW,SPRXCCWS ADDR OF SELECT CCW TABLE R41 Q6021200 SPACE 1 R41 Q6021300 SPRTDLUP CLC DCTUCS,0(R15) IS THIS THE DEFAULT... R41 Q6021400 BER PL RETURN IF YES (CC=ZERO) R41 Q6021500 LA R15,4(,R15) ADDR OF NEXT CHAR VALUE R41 Q6021600 LA PW,1(,PW) AND ITS SELECT CCW R41 Q6021700 BCT R0,SPRTDLUP LOOP FOR ALL CHARS R41 Q6021800 BR PL RETURN NOT FOUND (CC=N-ZERO) R41 Q6021900 EJECT R41 Q6022000 * R4 Q6022100 * DELETED @G38ESBB Q6023000 SPACE 1 @G38ESBB Q6024000 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q6025000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6026000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6027000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6028000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6029000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6030000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6031000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6032000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6033000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6034000 * THIS LINE DELETED BY PSETPRT @G38ESBB Q6035000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q6036000 SPACE 3 R4 Q6037000 * R4 Q6038000 * NULL IN-CORE COPY MODIFICATION RECORD TO RESET 3800 WITHOUT R4 Q6039000 * ISSUING AN INITIALIZE-PRT R4 Q6040000 * R4 Q6041000 SPACE 2 R4 Q6042000 SPRNULLM DS 0F R4 Q6043000 SPACE 1 R4 Q6044000 DC CL4'****' COPY MOD IDENTIFICATION R4 Q6045000 DC XL2'0' RESERVED R4 Q6046000 DC XL2'7' LENGTH OF COPY MOD RECORD R4 Q6047000 DC XL1'0' STARTING COPY NUMBER R4 Q6048000 DC XL1'1' NUMBER OF COPIES R4 Q6049000 DC XL1'1' STARTING LINE NUMBER R4 Q6050000 DC XL1'1' NUMBER OF LINES R4 Q6051000 DC XL1'1' STARTING POSITION R4 Q6052000 DC XL1'1' NUMBER OF CHARACTERS R4 Q6053000 DC CL1' ' MODIFICATION TEXT R4 Q6054000 SPACE 4 R4 Q6055000 SPRXCCWS DS 0XL4 3800 TABLE-SELECT CCW OPS R41 Q6055100 DC X'47' SELECT TRANSLATE TABLE 0 R41 Q6055200 DC X'57' SELECT TRANSLATE TABLE 1 R41 Q6055300 DC X'67' SELECT TRANSLATE TABLE 2 R41 Q6055400 DC X'77' SELECT TRANSLATE TABLE 3 R41 Q6055500 EJECT R41 Q6055600 LTORG R4 Q6056000 SPACE 2 R4 Q6057000 TITLE 'HASP PRINT/PUNCH SERVICE-- FCB/UCS IMAGE READ' @OZ34384 Q6058000 ************************************************************** @OZ34384 Q6058010 * * @OZ34384 Q6058020 * ENTER FROM HASPPRPU INITIALIZATION. READ UCS/FCB IMAGE. * @OZ34384 Q6058030 * ENTERED FOR THE FIRST USE OF UNIT ONLY. MUST READ IMAGE * @OZ34384 Q6058040 * TO DETERMINE IF UCS OR FCB IS A NON-STANDARD IMAGE. * @OZ34384 Q6058050 * * @OZ34384 Q6058060 ************************************************************** @OZ34384 Q6058070 SPACE 1 @OZ34384 Q6058080 PINITSU DS 0H @OZ34384 Q6058090 ST BASE2,PDSVSAVE SAVE BASE REGISTER @OZ34384 Q6058100 LR BASE2,R15 SET UP @OZ34384 Q6058110 USING PINITSU,BASE2 LOCAL ADDRESSABILITY @OZ34384 Q6058120 ST PL,PCERETN SAVE RETURN REGISTER @OZ34384 Q6058130 L R1,PRIMGDTE GET HASPIMAGE DTE ADDRESS @OZ34384 Q6058140 OC 0(4,R1),0(R1) SUBTASK ALREADY ACTIVE... @OZ34384 Q6058150 BNZ PGOTIMAG BR IF YES @OZ34384 Q6058160 SPACE 1 @OZ34384 Q6058170 L R15,=A(PIMAGLST) ELSE MOVE ATTACH PARMS @OZ34384 Q6058180 MVC $CSAVREG(PIMAGLL),0(R15) TO WORK AREA @OZ34384 Q6058190 LR PW,R1 SAVE DTE ADDRESS @OZ34384 Q6058200 ATTACH ECB=4(,R1),MF=(E,(1)),SF=(E,$CSAVREG) @OZ34384 Q6058210 STCM R1,7,1(PW) STORE TCB ADDRESS IN DTE @OZ40222 Q6058220 SPACE 1 @OZ34384 Q6058230 PIMGATCH DS 0H @OZ34384 Q6058240 $WAIT IMAG WAIT FOR SUBTASK TO INIT @OZ34384 Q6058250 TM 0(PW),X'80' HASPIMAGE INITIALIZED... @OZ34384 Q6058260 BZ PIMGATCH BR IF NOT, TRY AGAIN @OZ34384 Q6058270 SPACE 1 @OZ34384 Q6058280 PGOTIMAG DS 0H @OZ34384 Q6058290 L PC1,PCEDCT ESTABLISH DCT @OZ34384 Q6058300 USING DCTDSECT,PC1 ADDRESSABILITY @OZ34384 Q6058310 NI DCTPPSW,255-DCTPPSWU RESET NON-STD SWITCH @OZ34384 Q6058320 TM PDEVTYPE+1,X'80' UCS ALLOWED... @OZ34384 Q6058330 BZ PFCBLD BR IF NOT SUPPORTED @OZ34384 Q6058340 CLC DCTUCS,=C'0 ' IS UCS = 0 REQUESTED... @OZ34384 Q6058350 BE PFCBLD BR IF YES, CHECK FCB @OZ34384 Q6058360 SPACE 1 @OZ34384 Q6058370 $GETBUF PNOBUF GET BUFFER FOR UCS READ @OZ34384 Q6058380 LR WB,R1 LOAD BUFFER INTO R3 @OZ34384 Q6058390 USING BUFDSECT,WB SET BUFFER ADDRESSABILITY @OZ34384 Q6058400 MVC BUFSTART(4),=X'0001003A' BLDL PARAMETER LIST @OZ34384 Q6058410 MVC BUFSTART+4(4),=C'UCS1' IMAGE PREFIX-1403 USC @OZ34384 Q6058420 MVC BUFSTART+8(4),DCTUCS USER UCS IMAGE ID @OZ34384 Q6058430 STCM PC1,7,BUFDCT+1 ENSURE CORRECT DCT ADDR @OZ34384 Q6058440 CLI PDEVBYT3,UCB1403 IS DEVICE A 1403... @OZ40627 Q6058450 BE PUCS01 BR IF YES, SKIP NEXT @OZ34384 Q6058460 MVI BUFBYT7,C'3' SET TO 3203 IMAGE @OZ40627 Q6058470 CLI PDEVBYT3,UCB3203 IS IT A 3203 @OZ40627 Q6058475 BE PUCS01 IF YES SKIP TO IMAGE TASK @OZ40627 Q6058480 MVI BUFBYT7,C'2' IMAGE PREFIX FOR 3211 @OZ40627 Q6058485 * JES2 ONLY INITS 3 PRINTERS GO ON AS 3211 @OZ40627 Q6058488 PUCS01 DS 0H @OZ34384 Q6058490 TM $IMAGECB,X'40' IS IMAGE LOADER TASK BUSY...@OZ34384 Q6058500 BZ PUCS02 BR IF NO, CONTINUE @OZ34384 Q6058510 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST @OZ34384 Q6058520 B PUCS01 TRY AGAIN @OZ34384 Q6058530 SPACE 1 @OZ34384 Q6058540 PUCS02 DS 0H @OZ34384 Q6058550 MVI BUFECBCC,X'80' SET BUFFER ECB AS WAITING @OZ34384 Q6058560 POST $IMAGECB,(R3) POST WITH BUFFER ADDRESS @OZ34384 Q6058570 SPACE 1 @OZ34384 Q6058580 PUCS03 DS 0H @OZ34384 Q6058590 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST @OZ34384 Q6058600 TM BUFECBCC,X'7F' IS LOAD REQUEST COMPLETE... @OZ34384 Q6058610 BZ PUCS03 BR IF NOT, TRY AGAIN @OZ34384 Q6058620 BM PUCSMS BR TO 'NOT FOUND' MSG @OZ34384 Q6058630 TM BUFSTART,X'80' IS IT A STD UCS IMAGE... @OZ34384 Q6058640 BO PUCSEX BR IF YES @OZ34384 Q6058650 OI DCTPPSW,DCTPPSWU TURN ON NON-STD SWITCH @OZ34384 Q6058660 DROP WB DROP BUFFER ADDRESSIBILITY @OZ34384 Q6058670 SPACE 1 @OZ34384 Q6058680 PUCSEX $FREEBUF (WB) FREE BUFFER @OZ34384 Q6058690 SPACE 1 @OZ34384 Q6058700 PFCBLD DS 0H @OZ34384 Q6058710 NI DCTPPSW,255-DCTPPSWB TURN OFF NON-STAND SWITCH @OZ34384 Q6058720 CLI PDEVBYT3,UCB1403 IS DEVICE A 1403... @OZ40627 Q6058730 BNE PGTBUF BR IF NOT A 1403 @OZ34384 Q6058740 CLC $PRTFCB,DCTFCB IS IT STD FCB... @OZ34384 Q6058750 BE PSUPEX BR IF YES, RETURN TO INIT @OZ34384 Q6058760 OI DCTPPSW,DCTPPSWB TURN ON NON-STD SWITCH @OZ34384 Q6058770 B PSUPEX FINSHED, RETURN TO INIT @OZ34384 Q6058780 SPACE 1 @OZ34384 Q6058790 PGTBUF $GETBUF PNOBUF GET BUFFER FOR FCB READ @OZ34384 Q6058800 LR WB,R1 LOAD R3 WITH BUFF ADDRESS @OZ34384 Q6058810 USING BUFDSECT,WB SET BUFFER ADDRESSABILITY @OZ34384 Q6058820 MVC BUFSTART(4),=X'0001003A' BLDL PARAMETER LIST @OZ34384 Q6058830 MVC BUFSTART+4(4),=C'FCB2' IMAGE PREFIX-3211 FCB @OZ34384 Q6058840 MVC BUFSTART+8(4),DCTFCB USER FCB IMAGE ID @OZ34384 Q6058850 STCM PC1,7,BUFDCT+1 ENSURE CORRECT DCT ADDR @OZ34384 Q6058860 SPACE 1 @OZ34384 Q6058870 PFCB01 DS 0H @OZ34384 Q6058880 TM $IMAGECB,X'40' IS IMAGE TASK BUSY... @OZ34384 Q6058890 BZ PFCB02 BR IF NO, CONTINUE @OZ34384 Q6058900 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST @OZ34384 Q6058910 B PFCB01 TRY AGAIN @OZ34384 Q6058920 SPACE 1 @OZ34384 Q6058930 PFCB02 DS 0H @OZ34384 Q6058940 MVI BUFECBCC,X'80' SET BUFFER ECB AS WAITING @OZ34384 Q6058950 POST $IMAGECB,(R3) POST WITH BUFFER ADDRESS @OZ34384 Q6058960 SPACE 1 @OZ34384 Q6058970 PFCB03 DS 0H @OZ34384 Q6058980 $WAIT IMAG WAIT FOR IMAGE TASK TO $$POST @OZ34384 Q6058990 TM BUFECBCC,X'7F' LOAD REQUEST FINISHED... @OZ34384 Q6059000 BZ PFCB03 BR IF NOT, TRY AGAIN @OZ34384 Q6059010 BM PFCBMS BR TO 'NOT FOUND' MSG @OZ34384 Q6059020 TM BUFSTART,X'80' TEST FOR STD IMAGE... @OZ34384 Q6059030 BO PFCBEX BR IF YES, SKIP NEXT @OZ34384 Q6059040 OI DCTPPSW,DCTPPSWB TURN ON NON-STD SWITCH @OZ34384 Q6059050 DROP WB DROP BUFFER ADDRESSABILITY @OZ34384 Q6059060 SPACE 1 @OZ34384 Q6059070 PFCBEX $FREEBUF (WB) FREE BUFFER @OZ34384 Q6059080 B PSUPEX FINSHED, GET A JOB @OZ34384 Q6059090 SPACE 1 @OZ34384 Q6059100 PUCSMS DS 0H @OZ34384 Q6059110 USING BUFDSECT,WB GET BUFFER ADDRESSABILITY @OZ34384 Q6059120 MVC BUFSTART(2),=X'000F' MOVE MESSAGE NUMBER @OZ34384 Q6059130 MVC BUFSTART+2(8),DCTDEVN MOVE DEVICE NAME @OZ34384 Q6059140 MVC BUFSTART+10(26),=CL26' UCS IMAGE XXXX NOT FOUND' Z34384 Q6059150 MVC BUFSTART+22(4),DCTUCS MOVE UCS ID @OZ34384 Q6059160 $WTO BUFSTART,36,JOB=NO, ISSUE BUFFER LOAD FAIL MSG @OZ34384*Q6059170 ROUTE=$LOG+$UR,CLASS=$ACTION,PRI=$ST @OZ34384 Q6059180 B PUCSEX FINISHED UCS, FREE BUFFER @OZ34384 Q6059190 SPACE 1 @OZ34384 Q6059200 PFCBMS DS 0H @OZ34384 Q6059210 USING BUFDSECT,WB GET BUFFER ADDRESSABILITY @OZ34384 Q6059220 MVC BUFSTART(2),=X'000F' MOVE MSG ID @OZ34384 Q6059230 MVC BUFSTART+2(8),DCTDEVN MOVE DEVICE NAME @OZ34384 Q6059240 MVC BUFSTART+10(26),=CL26' FCB IMAGE XXXX NOT FOUND' Z34384 Q6059250 MVC BUFSTART+22(4),DCTFCB MOVE FCB ID @OZ34384 Q6059260 $WTO BUFSTART,36,JOB=NO, ISSUE BUFFER LOAD FAIL MSG @OZ34384*Q6059270 ROUTE=$LOG+$UR,CLASS=$ACTION,PRI=$ST @OZ34384 Q6059280 B PFCBEX FINISHED FCB, FREE BUFFER @OZ34384 Q6059290 SPACE 1 @OZ34384 Q6059300 PNOBUF $WTO PNBUFF,PMSGL,JOB=NO, BUFFER SHORTAGE MSG @OZ34384*Q6059310 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST @OZ34384 Q6059320 B PSUPEX NO BUFFERS, GET A JOB @OZ34384 Q6059330 SPACE 1 @OZ34384 Q6059340 PNBUFF $MSG 000,'NO BUFFERS TO DETERMINE IF STD UCS/FCB' @OZ34384 Q6059350 PMSGL EQU *-PNBUFF @OZ34384 Q6059360 SPACE 1 @OZ34384 Q6059370 PSUPEX DS 0H @OZ34384 Q6059380 L R1,PCEDCT GET DCT ADDRESS FOR RETURN @OZ34384 Q6059390 L PL,PCERETN RESTORE RETURN REGISTER @OZ34384 Q6059400 L BASE2,PDSVSAVE RESTORE BASE REGISTER @OZ34384 Q6059410 BR PL RETURN TO INITIALIZATION @OZ34384 Q6059420 SPACE 1 @OZ34384 Q6059430 LTORG @OZ34384 Q6059440 SPACE 1 @G38ESBB Q6059450 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PQE DEALLOCATION' @OZ48003 Q6059460 ***************************************************************@OZ48003 Q6059500 * @OZ48003 Q6059600 * PDELPQE -- RETURN A PQE TO THE FREE QUEUE OF ITS @OZ48003 Q6059700 * ASSOCIATED PPQ EXTENT. @OZ48003 Q6059800 * DECHAIN AND FREEMAIN SECONDARY PPQ @OZ48003 Q6059900 * EXTENTS IF EMPTY. @OZ48003 Q6060000 * @OZ48003 Q6060100 * R0 - ON ENTRY, COUNT OF PQE'S TO RETURN @OZ48003 Q6060200 * R1 - ON ENTRY, ADDRESS OF FIRST PQE TO FREE @OZ48003 Q6060300 * PW - ADDRESS OF THE PQH @OZ48003 Q6060400 * @OZ48003 Q6060500 * NOTE - ON ENTRY, R0 = ZERO WILL DECHAIN TO THE @OZ48003 Q6060600 * END OF THE PENDING PAGE QUEUE. @OZ48003 Q6060700 * ON EXIT, R1 = ADDRESS OF THE PREVIOUS PQE @OZ48003 Q6060800 * ON THE ACTIVE QUEUE. @OZ48003 Q6060900 * @OZ48003 Q6061000 ***************************************************************@OZ48003 Q6061100 SPACE 1 @OZ48003 Q6061200 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @OZ48003 Q6061300 USING PQEDSECT,R5 PROVIDE PQE ADDRESSABILITY @OZ48003 Q6061400 SPACE 1 @OZ48003 Q6061500 PDELPQE PSAVE ALL SAVE CALLER'S REGISTERS @OZ48003 Q6061600 LR BASE2,R15 ESTABLISH LOCAL ADDR @OZ48003 Q6061700 USING PDELPQE,BASE2 PROVIDE LOCAL ADDR @OZ48003 Q6061800 LR R4,R0 SAVE PQE COUNT @OZ48003 Q6061900 LR R5,R1 SAVE FIRST PQE ADDR @OZ48003 Q6062000 B PQEFREE ENTER ROUTINE @OZ48003 Q6062100 SPACE 1 @OZ48003 Q6062200 PFRECHK LA R15,PQHFIRST-(PQENEXT-PQEDSECT) POINT TO PQE0 @OZ48003 Q6062300 CLR R15,R5 MORE PQE'S TO FREE... @OZ48003 Q6062400 BE PFRERETN BRANCH IF NONE @OZ48003 Q6062500 SPACE 1 @OZ48003 Q6062600 PQEFREE L R15,PQEPREV DECHAIN PQE @OZ48003 Q6062700 MVC PQENEXT-PQEDSECT(,R15),PQENEXT FROM THE @OZ48003 Q6062800 L R15,PQENEXT ACTIVE @OZ48003 Q6062900 MVC PQEPREV-PQEDSECT(,R15),PQEPREV QUEUE @OZ48003 Q6063000 L R3,PQEHDR POINT TO EXTENT HEADER @OZ48003 Q6063100 MVC PQENEXT,PQHFREE-PQHDSECT(R3) ADD PQE TO THE @OZ48003 Q6063200 ST R5,PQHFREE-PQHDSECT(,R3) FREE CHAIN @OZ48003 Q6063300 LR R5,R15 POINT TO NEXT PQE @OZ48003 Q6063400 IC R1,PQHPQECT-PQHDSECT(,R3) INCREMENT PQE @OZ48003 Q6063500 LA R1,1(,R1) AVAILABLE @OZ48003 Q6063600 STC R1,PQHPQECT-PQHDSECT(,R3) COUNT @OZ48003 Q6063700 BCT R4,PFRECHK LOOP THRU CHAIN @OZ48003 Q6063800 EJECT @OZ48003 Q6063900 PFRERETN L R1,PQEPREV GET PREVIOUS PQE ADDR @OZ48003 Q6064000 L R15,PSAVAREA GET SAVE AREA ADDRESS @OZ48003 Q6064050 ST R1,4+(R1*4)(,R15) SAVE PQE ADDR FOR CALLER @OZ48003 Q6064100 SPACE 1 @OZ48003 Q6064200 SLR R0,R0 CHECK IF NUMBER OF @OZ48003 Q6064300 IC R0,PQHPQELM AVAILABLE PQE'S IN @OZ48003 Q6064400 SRL R0,1 PRIMARY EXTENT EXCEED @OZ48003 Q6064500 CLM R0,1,PQHPQECT ONE HALF OF MAXIMUM @OZ48003 Q6064600 BH PFRERET BRANCH IF NOT @OZ48003 Q6064700 LR R3,PW POINT R3 TO PQH @OZ48003 Q6064800 SPACE 1 @OZ48003 Q6064900 PFRETST ICM R3,15,PQHFCHN-PQHDSECT(R3) GET NEXT PPQ EXTENT @OZ48003 Q6065000 BZ PFRERET BRANCH IF NONE @OZ48003 Q6065100 CLI PQHPQECT-PQHDSECT(R3),PNUMPQE TEST PQE COUNT @OZ48003 Q6065200 BL PFRETST BRANCH IF NOT EMPTY @OZ48003 Q6065300 SPACE 1 @OZ48003 Q6065400 ***************************************************************@OZ48003 Q6065500 * @OZ48003 Q6065600 * DECHAIN AND FREEMAIN PPQ EXTENT @OZ48003 Q6065700 * @OZ48003 Q6065800 ***************************************************************@OZ48003 Q6065900 SPACE 1 @OZ48003 Q6066000 PFREPPQX L R0,PQHFCHN-PQHDSECT(,R3) GET FWD CHAIN ADDR @OZ48003 Q6066100 L R4,PQHBCHN-PQHDSECT(,R3) GET BACK CHAIN ADDR @OZ48003 Q6066200 ST R0,PQHFCHN-PQHDSECT(,R4) DECHAIN PPQX @OZ48003 Q6066300 LTR R15,R0 TEST FWD CHAIN ADDRESS @OZ48003 Q6066400 BZ *+8 BRANCH IF NONE @OZ48003 Q6066500 ST R4,PQHBCHN-PQHDSECT(,R15) SET BACK CHAIN ADDR @OZ48003 Q6066600 IC R15,PQHPCNT DECREMENT @OZ48003 Q6066700 BCTR R15,0 COUNT OF @OZ48003 Q6066800 STC R15,PQHPCNT PPQ EXTENTS @OZ48003 Q6066900 LH R0,=Y(PQHLENG+PNUMPQE*PQELENG) SET EXT LENGTH @OZ48003 Q6067000 LR R1,R3 SET EXTENT ADDRESS @OZ48003 Q6067100 FREEMAIN R,LV=(R0),A=(R1) FREE STORAGE @OZ48003 Q6067200 LR R3,R4 SET PREVIOUS EXTENT ADDR @OZ48003 Q6067300 B PFRETST CHECK FOR MORE EXTENTS @OZ48003 Q6067400 SPACE 1 @OZ48003 Q6067500 PFRERET PRETURN , RETURN TO CALLER @OZ48003 Q6067600 SPACE 1 @OZ48003 Q6067700 DROP PW,R5 SUSPEND ADDRESSABILITY @OZ48003 Q6067800 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PQE ALLOCATION' @OZ48003 Q6067900 ***************************************************************@OZ48003 Q6068000 * @OZ48003 Q6068100 * PADDPQE -- OBTAIN NEW PAGE QUEUE ENTRY @OZ48003 Q6068200 * @OZ48003 Q6068300 * R1 - PQE ADDRESS ON EXIT @OZ48003 Q6068400 * PW - ADDRESS OF PQH ON ENTRY @OZ48003 Q6068500 * @OZ48003 Q6068600 * CC = ZERO PQE ALLOCATION UNSUCCESSFUL @OZ48003 Q6068700 * CC = NON-ZERO PQE ALLOCATION SUCCESSFUL @OZ48003 Q6068800 * @OZ48003 Q6068900 ***************************************************************@OZ48003 Q6069000 SPACE 1 @OZ48003 Q6069100 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @OZ48003 Q6069200 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @OZ48003 Q6069300 SPACE 1 @OZ48003 Q6069400 PADDPQE PSAVE ALL SAVE CALLER'S REGISTERS @OZ48003 Q6069500 LR BASE2,R15 ESTABLISH LOCAL ADDR @OZ48003 Q6069600 USING PADDPQE,BASE2 PROVIDE LOCAL ADDR @OZ48003 Q6069700 NI PQHAFLAG,FF-PQHCPIO RESET CLEARPRINT FLAG @OZ48003 Q6069800 LR PL,PW POINT TO PQH @OZ48003 Q6069900 SPACE 1 @OZ48003 Q6070000 PCKABORT TM PQHAFLAG,PQHABORT TEST FOR PPQ ERROR @OZ49145 Q6070010 BZ PCKAVAIL BRANCH IF NOT @OZ49145 Q6070020 LA R14,=C'12' POINT TO REASON CODE @OZ49145 Q6070030 SLR PL,PL CLEAR EXTENT ADDRESS @OZ49145 Q6070040 B PPQWTO BR TO INFORM OPERATOR @OZ49145 Q6070050 SPACE 1 @OZ49145 Q6070060 PCKAVAIL L R1,PQHFREE-PQHDSECT(,PL) GET NEXT FREE PQE @OZ48003 Q6070100 LA R15,PQHFIRST-PQHDSECT(,PL) CHECK FOR @OZ48003 Q6070200 CR R1,R15 EMPTY QUEUE @OZ48003 Q6070300 BNE PADDINIT BRANCH IF NOT @OZ48003 Q6070400 ICM R0,15,PQHFCHN-PQHDSECT(PL) GET NEXT EXTENT @OZ48003 Q6070500 BZ PPQALOCC BRANCH IF NONE @OZ48003 Q6070600 LR PL,R0 POINT TO NEXT EXTENT @OZ48003 Q6070700 B PCKAVAIL CHECK NEXT EXTENT @OZ48003 Q6070800 SPACE 1 @OZ48003 Q6070900 PPQALOCC TM PQHAFLAG,PQHALOC TEST ALLOCATION FLAG @OZ48003 Q6071000 BO PPQSETRC BR IF CLRPRT SUPPRESSED @OZ48003 Q6071100 TM PQHAFLAG,PQHCPIO CLEARPRINT I/O COMPLETE... @OZ48003 Q6071200 BO PPQSETRC BRANCH IF YES @OZ48003 Q6071300 EJECT @OZ48003 Q6071400 PPQCPIO LM PC1,PC2,PCCWCP ISSUE CLEARPRINT @OZ48003 Q6071500 BAL PL,PPPUT CCW TO PRINT @OZ48003 Q6071600 BAL PL,PPWRITE PAGE BUFFER @OZ48003 Q6071700 BAL PL,PPCHECK AND FREE PQE'S @OZ48003 Q6071800 L PW,PQHADR RESTORE PQH ADDRESS @OZ48003 Q6071900 TM PQHAFLAG,PQHPBUF0 IS PAGE BUFFER EMPTY... @OZ48003 Q6072000 BZ PPQCPIO BRANCH IF NOT @OZ48003 Q6072100 OI PQHAFLAG,PQHCPIO IND CLEARPRINT COMPLETE @OZ48003 Q6072200 LR PL,PW POINT TO PQH @OZ48003 Q6072300 B PCKABORT RETRY PQE ALLOCATION @OZ49145 Q6072400 SPACE 1 @OZ48003 Q6072500 PADDINIT IC R15,PQHPQECT-PQHDSECT(,PL) DECREMENT @OZ48003 Q6072600 BCTR R15,0 AVAILABLE @OZ48003 Q6072700 STC R15,PQHPQECT-PQHDSECT(,PL) PQE COUNT @OZ48003 Q6072800 XC PQEDATA,PQEDATA CLEAR THE PQE @OZ48003 Q6072900 MVC PQHFREE-PQHDSECT(,PL),PQENEXT DECHAIN PQE @OZ48003 Q6073000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) POINT TO PQH @OZ48003 Q6073100 ST R15,PQENEXT CHAIN PQE TO PQH @OZ48003 Q6073200 CL R15,PQHPIDE INITIALIZE PQE @OZ48003 Q6073300 BNE *+8 PENDING ID @OZ48003 Q6073400 ST R1,PQHPIDE IF NECESSARY @OZ48003 Q6073500 L R15,PQHLAST INSERT NEW @OZ48003 Q6073600 ST R15,PQEPREV PQE TO THE @OZ48003 Q6073700 ST R1,PQENEXT-PQEDSECT(,R15) END OF THE @OZ48003 Q6073800 ST R1,PQHLAST ACTIVE QUEUE @OZ48003 Q6073900 SPACE 1 @OZ48003 Q6074000 PADDRET L R15,PSAVAREA GET SAVE AREA ADDRESS @OZ48003 Q6074050 ST R1,4+(R1*4)(,R15) SAVE PQE ADDR FOR CALLER @OZ48003 Q6074100 LTR R1,R1 SET COND CODE FOR CALLER @OZ48003 Q6074200 PRETURN , RETURN TO CALLER @OZ48003 Q6074300 SPACE 1 @OZ48003 Q6074400 DROP R1 SUSPEND PQE ADDRESSABILITY @OZ48003 Q6074500 EJECT @OZ48003 Q6074600 ***************************************************************@OZ48003 Q6074700 * @OZ48003 Q6074800 * PPQALLOC -- OBTAIN, FORMAT, AND CHAIN A NEW @OZ48003 Q6074900 * PENDING PAGE QUEUE EXTENT @OZ48003 Q6075000 * @OZ48003 Q6075100 ***************************************************************@OZ48003 Q6075200 SPACE 1 @OZ48003 Q6075300 PPQALLOC LH R1,=Y(PQHLENG+PNUMPQE*PQELENG) SET EXTENT SIZE @OZ48003 Q6075400 GETMAIN RC,LV=(R1) ATTEMPT GETMAIN @OZ48003 Q6075500 LTR R15,R15 TEST RETURN CODE @OZ48003 Q6075600 BZ PPQAGET1 BRANCH IF GOTTEN @OZ48003 Q6075700 SLR PL,PL CLEAR EXTENT ADDRESS @OZ48003 Q6075800 LA R14,=C'8 ' POINT TO REASON CODE @OZ48003 Q6075850 B PPQWTO INFORM OPERATOR @OZ48003 Q6075900 SPACE 1 @OZ48003 Q6076000 PPQAGET1 XC 0(PQHLENG,R1),0(R1) CLEAR EXTENT HEADER @OZ48003 Q6076100 ST R1,PQHFCHN-PQHDSECT(,PL) ADD NEW EXTENT @OZ48003 Q6076200 ST PL,PQHBCHN-PQHDSECT(,R1) IN THE CHAIN @OZ48003 Q6076300 MVI PQHPQECT-PQHDSECT(R1),PNUMPQE SET AVAIL CNT @OZ48003 Q6076400 MVI PQHPQELM-PQHDSECT(R1),PNUMPQE AND LIMIT @OZ48003 Q6076500 LA R15,PQHEND-PQHDSECT(,R1) POINT TO FIRST PQE @OZ48003 Q6076600 ST R15,PQHFREE-PQHDSECT(,R1) SET FREE CHN POINTER @OZ48003 Q6076700 SPACE 1 @OZ48003 Q6076800 USING PQEDSECT,R15 PROVIDE PQE ADDRESSABILITY @OZ48003 Q6076900 LA R0,PNUMPQE SET PQE COUNT @OZ48003 Q6077000 BCTR R0,0 DECREMENT COUNT OF PQE'S @OZ48003 Q6077100 PPQINIT LA R14,PQEEND POINT TO NEXT PQE @OZ48003 Q6077200 ST R14,PQENEXT SET FORWARD CHAIN @OZ48003 Q6077300 ST R1,PQEHDR SET EXTENT HEADER ADDR @OZ48003 Q6077400 LR R15,R14 BUMP TO NEXT PQE @OZ48003 Q6077500 BCT R0,PPQINIT LOOP THRU ALL PQE'S @OZ48003 Q6077600 ST R1,PQENEXT POINT LAST PQE TO HEADER @OZ48003 Q6077700 ST R1,PQEHDR SET EXTENT HEADER ADDR @OZ48003 Q6077800 DROP R15 SUSPEND PQE ADDRESSABILITY @OZ48003 Q6077900 IC R15,PQHPCNT INCREMENT @OZ48003 Q6078000 LA R15,1(,R15) COUNT OF @OZ48003 Q6078100 STC R15,PQHPCNT PQE EXTENTS @OZ48003 Q6078200 LR PL,R1 POINT TO NEW EXTENT @OZ48003 Q6078300 B PCKAVAIL RETRY PQE ALLOCATON @OZ48003 Q6078400 EJECT @OZ48003 Q6078500 PPQSETRC LA R14,=C'4 ' POINT TO REASON CODE @OZ48003 Q6078600 TM PPFLAG3,PPQSPND ALLOC RCVY SUSPENDED... @OZ48003 Q6078700 BO PPQCKEND BRANCH IF YES @OZ48003 Q6078800 SPACE 1 @OZ48003 Q6078900 USING DCTDSECT,R4 PROVIDE DCT ADDRESSABILITY @OZ48003 Q6079000 PPQWTO L R4,PCEDCT SET DCT ADDRESS @OZ48003 Q6079100 L JCT,PJCTBUF SET JCT ADDRESS @OZ48003 Q6079200 SPACE 1 @OZ48003 Q6079300 $MID 158 @OZ48003 Q6079400 MVC PMESSAGE(2),=X'158F' MOVE MSG ID @OZ48003 Q6079500 MVC PMESSAGE+2(8),DCTDEVN MOVE DEVICE NAME @OZ48003 Q6079600 MVC PMESSAGE+10(29),PPQAMSG MOVE MSG TEXT @OZ48003 Q6079700 MVC PMESSAGE+33(2),0(R14) SET REASON CODE @OZ48003 Q6079800 SPACE 1 @OZ48003 Q6079900 LTR PL,PL TEST CURRENT EXTENT @OZ48003 Q6080000 BZ PPQWTO1 BRANCH IF NONE @OZ48003 Q6080100 OI DCTFLAGS,DCTSTOP HALT THE DEVICE @OZ48003 Q6080200 $WTO PMESSAGE,39,JOB=YES, INFORM OPERATOR @OZ48003CQ6080300 ROUTE=$LOG+$UR,CLASS=$DOMACT,PRI=$ST @OZ48003 Q6080400 SPACE 1 @OZ48003 Q6080500 PPQAWAIT TM DCTFLAGS,DCTSTOP TEST FOR $S DEVICE @OZ48003 Q6080600 BZ PPQADOM BRANCH IF YES @OZ48003 Q6080700 NI DCTFLAGS,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ48003 Q6080800 $WAIT IO WAIT FOR POST FROM COMM @OZ48003 Q6080900 B PPQAWAIT BRANCH TO TEST FLAGS @OZ48003 Q6081000 SPACE 1 @OZ48003 Q6081100 PPQADOM $DOM CMB=(R1) DELETE OPERATOR MESSAGE @OZ48003 Q6081200 B PPQCMDCK BR TO CHECK FOR CMDS @OZ48003 Q6081300 SPACE 1 @OZ48003 Q6081400 PPQWTO1 $WTO PMESSAGE,39,JOB=YES, INFORM OPERATOR @OZ48003CQ6081500 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST @OZ48003 Q6081600 SPACE 1 @OZ49145 Q6081625 TM PQHAFLAG,PQHABORT TEST FOR PPQ ERROR @OZ49145 Q6081650 BO PPQTERM BRANCH IF YES @OZ49145 Q6081675 NI DCTFLAGS,FF-DCTDELET RESET DELETE FLAG @OZ48003 Q6081700 OI DCTFLAGS,DCTRSTRT+DCTBKSP IND INTERRUPTED @OZ48003 Q6081800 EJECT @OZ48003 Q6081900 PPQCMDCK TM DCTFLAGS,DCTDELET+DCTRSTRT TERMINATION CMD... @OZ48003 Q6082000 BZ PPQALLOC BRANCH IF NOT @OZ48003 Q6082100 OI PPFLAG,PPDELSW+PRDELSW CAUSE TERMINATION @OZ48003 Q6082200 OC PDCTFLAG,DCTFLAGS PROVIDE TERMINATION REASON @OZ48003 Q6082300 NI DCTFLAGS,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ48003 Q6082400 OI PPFLAG3,PP3800R+PPQSPND SET CMD FLAGS @OZ48003 Q6082500 L R1,PQHLAST POINT TO LAST PQE @OZ48003 Q6082600 SPACE 1 @OZ48003 Q6082700 USING PQEDSECT,R1 SET PQE ADDRESSABILITY @OZ48003 Q6082800 PPQCHK CR R1,PW CHECK FOR END OF PPQ @OZ48003 Q6082900 BE PPQCKEND BRANCH IF YES @OZ48003 Q6083000 CLI PQETYPE,PQEC TEST FOR PQEC @OZ48003 Q6083100 BNE PPQCHK1 BRANCH IF NOT @OZ48003 Q6083200 L PL,PQECPQED GET PQED ADDRESS @OZ48003 Q6083300 CLC PQEDWJOE-PQEDSECT(,PL),PWKJOE TEST JOE ADDR @OZ48003 Q6083400 BNE PPQCKEND BRANCH IF NOT CURRENT @OZ48003 Q6083500 OI PQEDFLAG-PQEDSECT(PL),PQEDLAST IND LAST DS @OZ48003 Q6083600 OI PQECFLAG,PQECLPG IND LAST PAGE OF DATASET @OZ48003 Q6083700 OI PQHFLAG,PQHDSVC IND RESET NEEDED @OZ48003 Q6083800 TM PDCTFLAG,DCTDELET TEST FOR $C CMD @OZ48003 Q6083900 BZ PPQCKINT BRANCH IF NOT @OZ48003 Q6084000 OI PQEDFLAG-PQEDSECT(PL),PQEDCAN SET DS CANCELLED @OZ48003 Q6084100 B PPQCKEND BRANCH TO RETURN @OZ48003 Q6084200 SPACE 1 @OZ48003 Q6084300 PPQCKINT TM PDCTFLAG,DCTBKSP TEST FOR $I CMD @OZ48003 Q6084400 BZ PPQRSTRT BR IF NOT, PROCESS $E CMD @OZ48003 Q6084500 OI PQEDFLAG-PQEDSECT(PL),PQEDINT SET DS INTERRUPT @OZ48003 Q6084600 B PPQSETCT BRANCH TO SET COUNT @OZ48003 Q6084700 SPACE 1 @OZ48003 Q6084800 PPQRSTRT $#ADD WORK=PWKJOE,CHAR=PCHJOE REQUEUE THE JOE @OZ48003 Q6084900 BZ PPQCKEND BRANCH IF SUCCESSFUL @OZ48003 Q6085000 OI PQEDFLAG-PQEDSECT(PL),PQEDRST DEFER REQUEUE @OZ48003 Q6085100 PPQSETCT IC R15,PQHCMDCT INCREMENT COUNT @OZ48003 Q6085200 LA R15,1(,R15) OF DEFERRED @OZ48003 Q6085300 STC R15,PQHCMDCT COMMANDS @OZ48003 Q6085400 B PPQCKEND BRANCH TO RETURN @OZ48003 Q6085500 EJECT @OZ48003 Q6085600 PPQCHK1 CLI PQETYPE,PQED TEST FOR PQED @OZ48003 Q6085700 BE PPQCHK2 BRANCH IF YES @OZ48003 Q6085800 L R1,PQEPREV GET PREVIOUS PQE ADDRESS @OZ48003 Q6085900 B PPQCHK BR TO CHECK PREVIOUS PQE @OZ48003 Q6086000 SPACE 1 @OZ48003 Q6086100 PPQCHK2 LA R0,1 SET PQE COUNT @OZ48003 Q6086200 L R15,=A(PDELPQE) CALL SUBROUTINE TO @OZ48003 Q6086300 BALR PL,R15 DELETE PQED @OZ48003 Q6086400 B PPQCHK BR TO CHECK PREVIOUS PQE @OZ48003 Q6086500 SPACE 1 @OZ48003 Q6086600 PPQCKEND SLR R1,R1 SHOW NO PQE ALLOCATED @OZ48003 Q6086700 B PADDRET RETURN @OZ48003 Q6086800 SPACE 1 @OZ49145 Q6086810 PPQTERM OI PPFLAG3,PP3800R SET COMMAND FLAG @OZ49145 Q6086820 OI PQHFLAG,PQHIPPQM+PQHRSTRT SET RESTART FLAGS @OZ49145 Q6086830 LM PC1,PC2,PCCWCP ISSUE CLEARPRINT @OZ49145 Q6086840 BAL PL,PPPUT TO PRINT PAGE BUFFER @OZ49145 Q6086850 BAL PL,PPWRITE AND WAIT FOR ALL @OZ49145 Q6086860 BAL PL,PPCHECK I/O TO COMPLETE @OZ49145 Q6086870 L R4,PCEDCT RELOAD DCT ADDRESS @OZ49145 Q6086880 XC DCTCSW,DCTCSW CLEAR RESTART CSW @OZ49145 Q6086890 NI PPFLAG,FF-PPNEWS RESET NEWS FLAG @OZ49145 Q6086900 B PPDSEND BR TO RETURN SAVE AREAS @OZ49145 Q6086910 SPACE 1 @OZ49145 Q6086920 PPQAMSG DC CL29' PPQ SHORTAGE - CODE = X ' @OZ48003 Q6087000 SPACE 1 @OZ48003 Q6087100 PNUMPQE EQU 150 NUMBER OF PQE'S IN EXTENT @OZ48003 Q6087200 SPACE 1 @OZ48003 Q6087300 DROP R1,PW,R4 SUSPEND ADDRESSABILITY @OZ48003 Q6087400 SPACE 1 @OZ48003 Q6087500 PRINT OFF THIS SECTION DELETED BY @OZ48003 Q6087600 * DELETED @G38ESBB Q6088000 * DELETED @G38ESBB Q6089000 * DELETED @G38ESBB Q6090000 * DELETED @G38ESBB Q6091000 * DELETED @G38ESBB Q6092000 * DELETED @G38ESBB Q6093000 * DELETED @G38ESBB Q6094000 * DELETED @G38ESBB Q6095000 * DELETED @G38ESBB Q6095200 * DELETED @G38ESBB Q6095275 * DELETED @G38ESBB Q6095350 * DELETED @G38ESBB Q6095400 * DELETED @G38ESBB Q6096000 * DELETED @G38ESBB Q6097000 * DELETED @G38ESBB Q6098000 * DELETED @G38ESBB Q6099000 * DELETED @G38ESBB Q6100000 * DELETED @G38ESBB Q6101000 * DELETED @G38ESBB Q6102000 * DELETED @G38ESBB Q6103000 * DELETED @G38ESBB Q6104000 * DELETED @G38ESBB Q6105000 * DELETED @G38ESBB Q6105050 * DELETED @G38ESBB Q6105100 * DELETED @G38ESBB Q6105200 * DELETED @G38ESBB Q6105300 * DELETED @G38ESBB Q6105400 * DELETED @G38ESBB Q6105500 * DELETED @G38ESBB Q6106000 * DELETED @G38ESBB Q6107000 * DELETED @G38ESBB Q6108000 * DELETED @G38ESBB Q6109000 * DELETED @G38ESBB Q6110000 * DELETED @G38ESBB Q6111000 * DELETED @G38ESBB Q6112000 * DELETED @G38ESBB Q6113000 * DELETED @G38ESBB Q6114000 * DELETED @G38ESBB Q6115000 * DELETED @G38ESBB Q6116000 * DELETED @G38ESBB Q6116100 * DELETED @G38ESBB Q6116200 * DELETED @G38ESBB Q6117000 * DELETED @G38ESBB Q6117500 * DELETED @G38ESBB Q6118000 * DELETED @G38ESBB Q6119000 * DELETED @G38ESBB Q6120000 * DELETED @G38ESBB Q6121000 * DELETED @G38ESBB Q6122000 * DELETED @G38ESBB Q6123000 * DELETED @G38ESBB Q6124000 * DELETED @G38ESBB Q6125000 * DELETED @G38ESBB Q6125200 * DELETED @G38ESBB Q6125400 * DELETED @G38ESBB Q6125600 * DELETED @G38ESBB Q6126000 SPACE 1 @OZ26939 Q6126500 * DELETED @G38ESBB Q6127000 * DELETED @G38ESBB Q6128000 PRINT ON THIS SECTION DELETED BY @G38ESBB Q6129000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PQEC INITIALIZATION' @G38ESBB Q6130000 ***************************************************************@G38ESBB Q6131000 * @G38ESBB Q6132000 * ACQUIRE AND INITIALIZE 3800 CHECKPOINT @G38ESBB Q6133000 * PAGE QUEUE ENTRY (PQEC) @G38ESBB Q6134000 * @G38ESBB Q6135000 * R1 - ADDRESS OF PQED (ON EXIT) @G38ESBB Q6135200 * PW - ADDRESS OF PENDING PAGE QUEUE HEADER @G38ESBB Q6135400 * @G38ESBB Q6136000 ***************************************************************@G38ESBB Q6137000 SPACE 1 @G38ESBB Q6138000 USING PQECINIT,BASE2 PROVIDE LOCAL ADR @G38ESBB Q6139000 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q6140000 SPACE 1 @G38ESBB Q6141000 PQECINIT PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q6142000 LR BASE2,R15 ESTABLISH LOCAL ADR @G38ESBB Q6143000 SPACE 1 @G38ESBB Q6144000 PGETPQEC L PW,PQHADR ADDRESS PQH @G38ESBB Q6145000 L R15,=A(PADDPQE) CALL SUBROUTINE TO @OZ48003 Q6146000 BALR PL,R15 ALLOCATE A PQE @OZ48003 Q6147000 BNZ PGOTPQEC BRANCH IF SUCCESSFUL @OZ48003 Q6148000 SPACE 1 @OZ48003 Q6149000 NI PQHAFLAG,FF-PQHALOC RESET ALLOCATION FLAG @OZ48003 Q6150000 SLR R1,R1 SHOW NO PQE ALLOCATED @OZ48003 Q6151000 B PQECRETN AND RETURN @OZ48003 Q6152000 SPACE 1 @G38ESBB Q6153000 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q6154000 PGOTPQEC MVI PQETYPE,PQEC INDICATE CKPT PQE @G38ESBB Q6155000 L R15,PQEPREV POINT PQEC TO @G38ESBB Q6156000 MVC PQECPQED,PQECPQED-PQEDSECT(R15) PQED @G38ESBB Q6157000 MVC PQECJRCB,PCEEJRCB SET INIT BUFFER OFFSET @G38ESBB Q6158000 MVC PQECPPCT,PDDBPGCT SET PDDB LOGICAL PAGE COUNT @G38ESBB Q6159000 MVC PQECTLNC,PPLNCDCT SET TOTAL JOE LINE COUNT @G38ESBB Q6160000 MVC PQECTPCT,PRPAGECT SET TOTAL JOE PAGE COUNT @G38ESBB Q6161000 MVC PQECMTTR,PCEJMTTR SET MTTR OF SPOOL DATA @G38ESBB Q6162000 NI PQHAFLAG,FF-PQHALOC RESET ALLOCATION FLAG @OZ48003 Q6162100 SPACE 1 @OZ48003 Q6162200 PQECRETN LTR R1,R1 SET CONDITION CODE @OZ48003 Q6162300 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q6163000 SPACE 1 @G38ESBB Q6164000 DROP PW,R1 DROP PQH, PQE ADDR @G38ESBB Q6165000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PQED INITIALIZATION' @G38ESBB Q6165010 ***************************************************************@G38ESBB Q6165020 * @G38ESBB Q6165030 * ACQUIRE AND INITIALIZE 3800 DATA SET @G38ESBB Q6165040 * PAGE QUEUE ENTRY (PQED) @G38ESBB Q6165050 * @G38ESBB Q6165060 ***************************************************************@G38ESBB Q6165070 SPACE 1 @G38ESBB Q6165080 USING PQEDINIT,BASE2 PROVIDE LOCAL ADR @G38ESBB Q6165090 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q6165100 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q6165110 SPACE 1 @G38ESBB Q6165120 PQEDINIT PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q6165130 LR BASE2,R15 ESTABLISH LOCAL ADR @G38ESBB Q6165140 SPACE 1 @G38ESBB Q6165150 PGETPQED L PW,PQHADR ADDRESS PQH FOR SUB @G38ESBB Q6165160 NI PQHAFLAG,FF-PQHALOC RESET ALLOCATION FLAG @OZ48003 Q6165170 L R15,=A(PADDPQE) CALL SUBROUTINE TO @OZ48003 Q6165180 BALR PL,R15 ALLOCATE A PQE @OZ48003 Q6165190 BNZ PGOTPQED BRANCH IF SUCCESSFUL @OZ48003 Q6165200 SPACE 1 @OZ48003 Q6165210 SR R1,R1 SHOW NO PQE ALLOCATED @OZ48003 Q6165220 B PQEDRET AND RETURN @OZ48003 Q6165230 SPACE 1 @G38ESBB Q6165240 PGOTPQED MVI PQETYPE,PQED INDICATE DATA SET PQE @G38ESBB Q6165250 MVC PQEDCOPY,PPRCPYCT SET COPY NUMBER @G38ESBB Q6165260 SLR PL,PL ZERO INDEX REGISTER @G38ESBB Q6165270 IC PL,PDDBCPYG GET OFFSET INTO COPY GROUP @G38ESBB Q6165280 IC PL,PCOPYGRP(PL) GET COPY GROUP NUMBER @G38ESBB Q6165290 LTR PL,PL IF NO COPYGROUPING @G38ESBB Q6165300 BNZ *+8 SPECIFIED, SET @G38ESBB Q6165310 LA PL,1 COPYGROUP COUNT TO 1 @G38ESBB Q6165320 STC PL,PQEDCGCT SET COPYGROUP COUNT @G38ESBB Q6165330 MVC PQEDCPYG,PDDBCPYG SET OFFSET INTO COPY GROUP @G38ESBB Q6165340 MVC PQEDTNDS,PPJNDS SET TOTAL JOE DATA SET CNT @G38ESBB Q6165350 MVC PQEDWJOE,PWKJOE SET JOE ADDRESS @G38ESBB Q6165360 MVC PQEDIOTR,PCEIOTTR SET CURRENT IOT TRACK ADR @G38ESBB Q6165370 MVC PQEDJKEY,PPJOBKEY SET JOB IDENTIFIER KEY @G38ESBB Q6165380 MVC PQEDPDDB,PDDBDISP SET DISP OF PDDB INTO IOT @G38ESBB Q6165390 MVC PQEDCGRP,PCOPYGRP SET DATASET COPY GROUPS @OZ49282 Q6165392 MVC PQEDSCPY,PPDSCPY SET DATASET COPY COUNT @OZ49282 Q6165394 MVC PQEDSKEY,PPDSKEY SET DATASET KEY @OZ49282 Q6165396 TM PPFLAG,PPDALOC ALLOCATION IOT... @G38ESBB Q6165400 BZ *+8 NO, BYPASS ALOC FLAG @G38ESBB Q6165410 OI PQEDFLAG,PQEDALOC INDICATE ALLOCATION IOT @G38ESBB Q6165420 EJECT @OZ49282 Q6165430 ***************************************************************@G38ESBB Q6165440 * @G38ESBB Q6165450 * ACQUIRE PAGE QUEUE ENTRY FOR BEGINNING OF DATA SET @G38ESBB Q6165460 * @G38ESBB Q6165470 ***************************************************************@G38ESBB Q6165480 SPACE 1 @G38ESBB Q6165490 L R15,=A(PQECINIT) CALL PQECINIT TO ACQUIRE @G38ESBB Q6165500 BALR PL,R15 AND INIT FIRST PAGE PQEC @G38ESBB Q6165510 BZ PQEDRET BRANCH IF NOT SUCCESSFUL @OZ48003 Q6165515 L R15,=A(PPGIDIO) CALL PPGIDIO TO SOLICIT @G38ESBB Q6165520 BALR PL,R15 ID FOR FPG PQEC @G38ESBB Q6165530 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6165540 L R1,PQHLAST ADDRESS PQEC @G38ESBB Q6165550 L R15,PQEPREV ADDRESS PQED @G38ESBB Q6165560 ST R15,PQECPQED POINT PQEC TO PQED @G38ESBB Q6165570 OI PQECFLAG,PQECFPG SET BEGIN DATA SET @G38ESBB Q6165580 TM PCKJOE,$JOECKV DATA SET WARMSTART @G38ESBB Q6165590 BZ PQEDRETC NO, RETURN TO CALLER @OZ48003 Q6165600 BAL PL,PPWRITE SCHEDULE I/O TO SOLICIT ID @G38ESBB Q6165610 BAL PL,PPCHECK CHECK I/O COMPLETION @G38ESBB Q6165620 SPACE 1 @G38ESBB Q6165630 ***************************************************************@G38ESBB Q6165640 * @G38ESBB Q6165650 * ACQUIRE AND INITIALIZE WARMSTART PQE @G38ESBB Q6165660 * @G38ESBB Q6165670 ***************************************************************@G38ESBB Q6165680 SPACE 1 @G38ESBB Q6165690 L R0,PDDBPGCT GET WARMSTART PAGE COUNT @G38ESBB Q6165700 LCR R0,R0 COMPLEMENT FOR RECOMPUTE @G38ESBB Q6165710 L R15,=A(PRECOMP) CALL RECOMPUTE TO SHOW PAGE @G38ESBB Q6165720 BALR PL,R15 DELTA TO WARMSTART POINT @G38ESBB Q6165730 SPACE 1 @G38ESBB Q6165740 PGETPQEW L PW,PQHADR ADDRESS THE PQH @G38ESBB Q6165750 NI PQHAFLAG,FF-PQHALOC RESET ALLOCATION FLAG @OZ48003 Q6165760 L R15,=A(PADDPQE) CALL SUBROUTINE TO @OZ48003 Q6165770 BALR PL,R15 ALLOCATE A PQE @OZ48003 Q6165780 BNZ PGOTPQEW BRANCH IF SUCCESSFUL @OZ48003 Q6165790 SPACE 1 @OZ48003 Q6165800 SR R1,R1 SHOW NO PQE ALLOCATED @OZ48003 Q6165810 B PQEDRET AND RETURN @OZ48003 Q6165820 SPACE 1 @G38ESBB Q6165830 PGOTPQEW MVC PQHPIDE,PQENEXT SET PQE PENDING ID TO PQE0 @G38ESBB Q6165840 L R15,PQEPREV ADDRESS FPG PQEC @G38ESBB Q6165850 MVC PQETYPE(PQEEND-PQETYPE),PQETYPE-PQEDSECT(R15) @G38ESBBCQ6165860 MOVE FPG PQEC TO WRMST PQEC @G38ESBB Q6165870 NI PQECFLAG,FF-PQECFPG RESET FPG IN WARMST PQEC @G38ESBB Q6165880 MVC PQERPGID,PQECPGID SHOW PAGE NUMBER OF WARMST @G38ESBB Q6165890 MVC PQECMTTR-PQEDSECT(,R15),PPLC SET BEGIN DS MTTR @G38ESBB Q6165900 MVC PQECPPCT-PQEDSECT(,R15),$ZEROS CLEAR PAGE COUNT @G38ESBB Q6165910 MVC PQECJRCB-PQEDSECT(,R15),PCCW+2 SET INIT BUF OFF @G38ESBB Q6165920 EJECT @OZ49282 Q6165930 PQEDRETC LTR R1,R1 SET CONDITION CODE @OZ48003 Q6165935 PQEDRET PRETURN , RESTORE REGS AND RETURN @G38ESBB Q6165940 DROP PW,R1 DROP PQH, PQE ADDR @G38ESBB Q6165950 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PAGE ID I/O ROUTINE' @G38ESBB Q6166000 ***************************************************************@G38ESBB Q6167000 * @G38ESBB Q6168000 * ISSUE I/O TO SENSE HARDWARE PAGE ID AND FCB LINE @G38ESBB Q6169000 * POSITION FOR PQE @G38ESBB Q6170000 * @G38ESBB Q6171000 ***************************************************************@G38ESBB Q6172000 SPACE 1 @G38ESBB Q6173000 PPGIDIO PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q6174000 LR BASE2,R15 ESTABLISH LOCAL ADR @G38ESBB Q6175000 USING PPGIDIO,BASE2 PROVIDE LOCAL ADR @G38ESBB Q6175500 SPACE 1 @G38ESBB Q6175600 PPGIOCK LH PW,PCCWLAST GET OFFSET TO PCIE @OZ46856 Q6175700 AL PW,POUTCCWA ADD CCW AREA BASE @OZ46856 Q6175800 TM PCISGNAL-PCIDSECT(PW),PCIACTIV TEST CCW AREA @OZ46856 Q6175900 BZ PPGCCWCK BRANCH IF NOT ACTIVE @OZ46856 Q6176000 TM PPFLAG,PPWSW TEST IF WRITE IN PROGRESS @OZ46856 Q6176100 BZ PPGCCWCK BRANCH IF NOT @OZ46856 Q6176200 BAL PL,PCIWAIT ELSE, WAIT FOR I/O @OZ46856 Q6176300 B PPGIOCK CHECK NEW CCW AREA @OZ46856 Q6176400 SPACE 1 @OZ46856 Q6176500 PPGCCWCK LA PW,PCIESIZE(,PW) ADDRESS BFW @OZ46856 Q6176600 L PC1,PCCWPT ADDRESS LAST CCW IN AREA @OZ46856 Q6176700 LA PC1,4*8+RPISIBSZ+PCIESIZE(,PC1) CAN TIC,RPI, @OZ46856 Q6176800 CR PC1,PW AND SIB FIT IN AREA... @OZ46856 Q6176900 BL PPGBRPI YES, GO BUILD RPI CCW @OZ46856 Q6177000 BAL PL,PPWRITE NO, WRITE THIS AREA @OZ46856 Q6177200 B PPGIOCK CHECK NEW CCW AREA @OZ46856 Q6177400 SPACE 1 @G38ESBB Q6178000 PPGBRPI IC R1,BFWPQECT-BFWDSECT(,PW) INCREMENT COUNT @G38ESBB Q6179000 LA R1,1(,R1) OF ID'S SOLICITED @G38ESBB Q6180000 STC R1,BFWPQECT-BFWDSECT(,PW) IN THIS AREA @G38ESBB Q6181000 * THIS LINE DELETED BY APAR @OZ46142 Q6182000 LM PC1,PC2,PCCWXORD CALL @G38ESBB Q6182600 LH PW,PCCWLAST PPPUT @G38ESBB Q6182700 AL PW,POUTCCWA TO ISSUE @G38ESBB Q6182800 LA PW,PCIESIZE(,PW) THE REQUEST @G38ESBB Q6182900 LA PW,BFWRPI-BFWDSECT(,PW) PRINTER INFORMATION @G38ESBB Q6182950 ALR PC1,PW ORDER OF THE @G38ESBB Q6183000 BAL PL,PPPUT2 EXECUTE ORDER CCW @OZ51441 Q6184000 SPACE 1 @G38ESBB Q6185000 L PC1,PCCWPT ADDRESS CURRENT CCW @G38ESBB Q6186000 LA PW,12(,PC1) ADDRESS RIGHT HALF OF TIC @G38ESBB Q6187000 L R1,PQHADR ADDRESS PQH @G38ESBB Q6188000 L R1,PQHLAST-PQHDSECT(,R1) ADDRESS CURRENT PQE @G38ESBB Q6189000 ST PW,PQECSENS-PQEDSECT(,R1) SET PTR TO SENSE INFO @G38ESBB Q6190000 LA PC1,16(,PC1) BUILD DUMMY @G38ESBB Q6191000 AL PC1,PCNOPTIC+8 TIC CCW @G38ESBB Q6192000 SLR PC2,PC2 INITIALIZE SENSE @G38ESBB Q6193000 BCTR PC2,0 AREA TO FF'S @G38ESBB Q6194000 BAL PL,PPPUT2 ADD DUMMY TIC CCW @OZ51441 Q6194500 SPACE 1 @G38ESBB Q6195000 LM PC1,PC2,PCCWSIB GET SENSE INT BUF CCW @G38ESBB Q6195200 L PW,PCCWPT ADDRESS TIC CCW @G38ESBB Q6195400 LA PW,4(,PW) ADDRESS RIGHT HALF OF TIC @G38ESBB Q6196000 ALR PC1,PW POINT CCW TO TIC + 4 @G38ESBB Q6196500 IC PC2,=X'04' CHANGE LENGTH TO 4 @G38ESBB Q6197000 BAL PL,PPPUT2 ADD SENSE INT BUF CCW @OZ51441 Q6197500 SPACE 1 @G38ESBB Q6198000 PRETURN , RESTORE REGS AND RETURN @G38ESBB Q6199000 TITLE 'HASP PRINT/PUNCH SERVICE -- PPQ MANAGEMENT ROUTINE' @G38ESBB Q6200000 ***************************************************************@G38ESBB Q6200500 * @G38ESBB Q6201000 * 3800 PRINTER PENDING PAGE QUEUE MANAGEMENT ROUTINE @G38ESBB Q6201500 * @G38ESBB Q6202000 * R0 - STACKED PAGE ID @G38ESBB Q6202100 * PW - PQH ADDRESS @G38ESBB Q6202200 * R3 - PQE ADDRESS @G38ESBB Q6202300 * R4 - STACKED PAGE ID @G38ESBB Q6202400 * R5 - PQE COUNT @G38ESBB Q6202500 * R10 - ADDRESS OF PQE TO CHECKPOINT @G38ESBB Q6202600 * @G38ESBB Q6203000 ***************************************************************@G38ESBB Q6203500 SPACE 1 @G38ESBB Q6204000 USING PPQMGR,BASE2 PROVIDE LOCAL ADR @G38ESBB Q6204500 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q6205000 USING PQEDSECT,R3 PROVIDE PQE ADDRESSABILITY @G38ESBB Q6205500 SPACE 1 @G38ESBB Q6206000 PPQMGR PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q6207000 LR BASE2,R15 SET UP LOCAL BASE @G38ESBB Q6207500 L PW,PQHADR ADDRESS THE PQH @G38ESBB Q6208000 TM PQHFLAG,PQHIPPQM TEST IF INHIBITED @OZ46674 Q6208100 BO PPQRET BRANCH IF YES @OZ46674 Q6208200 LR R4,R0 SAVE STACKER PAGE ID @G38ESBB Q6208500 SLR R5,R5 INITIALIZE PQE COUNT TO 0 @G38ESBB Q6209000 SLR R10,R10 INIT ADR OF PQE FOR CKPT @G38ESBB Q6209500 LA R3,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @G38ESBB Q6210000 * DELETED @G38ESBB Q6210100 * DELETED @G38ESBB Q6210200 SPACE 1 @G38ESBB Q6210500 PNXTPQE L R3,PQENEXT ADDRESS NEXT PQE @G38ESBB Q6211000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q6211500 CR R3,R15 END OF PPQ... @G38ESBB Q6212000 BE PPQENDQ YES, DONE, BRANCH @G38ESBB Q6212500 TM PQHFLAG,PQHDRAIN TEST IF DRAINING @OZ49145 Q6212600 BO PNXTPQE1 BRANCH IF YES @OZ49145 Q6212700 C R3,PQHPIDE ID PENDING FOR THIS PQE... @G38ESBB Q6213000 BE PPQENDQ YES, DONE, BRANCH @G38ESBB Q6213500 PNXTPQE1 LA R5,1(,R5) INCREMENT PQE COUNT @OZ49145 Q6214000 CLI PQETYPE,PQED IS PQE A DATA SET PQE... @G38ESBB Q6214500 BE PNXTPQE YES, GO GET NEXT PQE @G38ESBB Q6215000 CLI PQETYPE,PQEC IS PQE A CHECKPOINT PQE... @G38ESBB Q6215500 BE PSTKCHK YES, GO CHECK IF STACKED @G38ESBB Q6215600 EJECT @OZ48003 Q6215700 ***************************************************************@G38ESBB Q6215800 * @G38ESBB Q6215900 * QUEUE SMF6 BUFFER FOR PQES AT STACKER @G38ESBB Q6216000 * @G38ESBB Q6216100 ***************************************************************@G38ESBB Q6216200 SPACE 1 @G38ESBB Q6216300 * DELETED @G38ESBB Q6216400 * DELETED @G38ESBB Q6216500 CLI PQETYPE,PQES IS PQE AN SMF PQE... @G38ESBB Q6216600 BNE PNXTPQE NO, PQEJ, GO GET NEXT PQE @G38ESBB Q6217000 L R1,PQESBUF ADDRESS SMF BUFFER @G38ESBB Q6217500 $QUESMFB QUEUE TYPE 6 FOR WRITE @G38ESBB Q6218000 SPACE 1 @G38ESBB Q6218500 LR R1,R3 ADDRESS PQE TO DELETE @G38ESBB Q6219000 LA R0,1 SET PQE DELETE COUNT TO 1 @G38ESBB Q6219500 L R15,=A(PDELPQE) CALL PDELPQE @OZ48003 Q6219750 BALR PL,R15 TO DELETE PQE @OZ48003 Q6220000 LR R3,R1 ADR PREVIOUS PQE SO THAT @G38ESBBCQ6220500 PNXTPQE WILL ADR NEXT PQE @G38ESBB Q6221000 BCTR R5,0 DECREMENT PQE COUNT @G38ESBB Q6221500 B PNXTPQE GO GET NEXT PQE @G38ESBB Q6222000 SPACE 1 @G38ESBB Q6222100 ***************************************************************@G38ESBB Q6222200 * @G38ESBB Q6222300 * PROCESS STACKED PQEC'S @G38ESBB Q6222400 * @G38ESBB Q6222500 ***************************************************************@G38ESBB Q6222600 SPACE 1 @G38ESBB Q6222700 PSTKCHK TM PQECFLAG,PQECBSP IS PQE ALREADY STACKED... @G38ESBB Q6223000 BO PNXTPQE YES, GO GET NEXT PQE @G38ESBB Q6223500 TM PQHFLAG,PQHDRAIN TEST IF DRAINING @OZ49145 Q6223600 BO PSTKCHK1 BRANCH IF YES @OZ49145 Q6223700 LH R15,PQECPGID GET PQE ID @G38ESBB Q6224000 LR R0,R4 GET STACKER PAGE ID @G38ESBB Q6224500 SR R0,R15 COMPARE @G38ESBB Q6225000 N R0,PCLRHALF PQE ID WITH @G38ESBB Q6225500 C R0,PQELIMIT STACKER PAGE ID @G38ESBB Q6226000 BH PCKPGID BRANCH IF PQE NOT STACKED @OZ49145 Q6226500 PSTKCHK1 TM PQECFLAG,PQECLPG END OF DATASET... @OZ49145 Q6227000 BO PPQEODS YES, BRANCH @G38ESBB Q6227500 LR R10,R3 SAVE PQE ADR FOR CHECKPOINT @G38ESBB Q6228000 TM PQECFLAG,PQECFPG BEGINNING OF DATA SET... @G38ESBB Q6228500 BZ PQEDPREV NO,GO DELETE PREVIOUS PQEC @G38ESBB Q6229000 OI PQECFLAG,PQECBSP IND BEGIN DS PQEC STACKED @G38ESBB Q6229500 B PNXTPQE GO GET NEXT PQE @G38ESBB Q6229600 EJECT @OZ48003 Q6229700 ***************************************************************@G38ESBB Q6229800 * @G38ESBB Q6229900 * LAST PAGE OF DATA SET @G38ESBB Q6230000 * @G38ESBB Q6230100 * IF LAST DATA SET OF JOE, PROCESS ANY DEFERRED CMDS @G38ESBB Q6230200 * @G38ESBB Q6230300 ***************************************************************@G38ESBB Q6230400 SPACE 1 @G38ESBB Q6230500 PPQEODS SLR R10,R10 INDICATE NO PQE FOR CKPT @G38ESBB Q6231000 L PL,PQECPQED ADDRESS DATA SET PQE @G38ESBB Q6231500 TM PQEDFLAG-PQEDSECT(PL),PQEDLAST LAST DATA SET... @G38ESBB Q6232000 BZ PDELDS NO, GO DELETE PQE'S FOR DS @G38ESBB Q6232500 CLC PCEJQE,$ZEROS TEST IF CURRENT JOB @OZ48530 Q6232600 BE PPQEODS1 BRANCH IF NONE @OZ48530 Q6232700 CLC PQEDWJOE-PQEDSECT(,PL),PWKJOE TEST JOE ADDR @OZ48530 Q6232800 BE PPQENDQ BRANCH IF NOT COMPLETED @OZ48530 Q6232900 PPQEODS1 TM PQEDFLAG-PQEDSECT(PL),PQEDINT+PQEDRST+PQEDRPT @OZ48530CQ6233000 DEFERRED $I, $E, $N... @G38ESBB Q6233500 BZ PPQSPUR NO,GO CHECK FOR SPIN DS @G38ESBB Q6234000 IC R15,PQHCMDCT DECREMENT @G38ESBB Q6234500 BCTR R15,0 COUNT OF DEFERRED @G38ESBB Q6235000 STC R15,PQHCMDCT $I COMMANDS @G38ESBB Q6235500 TM PQEDFLAG-PQEDSECT(PL),PQEDINT IS CMD $I @G38ESBB Q6236000 BZ PPQENPUT BR IF NOT @G38ESBB Q6236500 SPACE 1 @G38ESBB Q6237000 PPQGETQ BAL PL,PCKPTNI CHECKPOINT CKPT JOE FOR $I @G38ESBB Q6237500 BZ PPQGOTQ BRANCH IF QUEUES OWNED @G38ESBB Q6238000 $QSUSE ACQUIRE ACCESS TO CKPT DATA @G38ESBB Q6238500 B PPQGETQ GO RETRY SUB CALL @G38ESBB Q6239000 SPACE 1 @G38ESBB Q6239500 PPQGOTQ L PL,PQECPQED RESTORE PQED ADDRESS @G38ESBB Q6239700 L PW,PQEDWJOE-PQEDSECT(,PL) ADDRESS WORK JOE @G38ESBB Q6240000 * NOTE: CHECKPOINT JOE ADDRESS SET IN R1 FROM PCKPTNI @G38ESBB Q6240500 $#PUT WORK=(PW),PRC=(R1) RETURN TO JOT WITH CKPT @G38ESBB Q6241000 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6241500 B PDELDS GO DELETE PQE'S FOR DS @G38ESBB Q6242000 SPACE 1 @G38ESBB Q6242500 PPQENPUT L PW,PQEDWJOE-PQEDSECT(,PL) ADDRESS WORK JOE @G38ESBB Q6243000 $#PUT WORK=(PW) RETURN TO JOT, NO CKPT @G38ESBB Q6243500 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6244000 B PDELDS GO DELETE PQE'S FOR DS @G38ESBB Q6244100 EJECT @OZ48003 Q6244200 ***************************************************************@G38ESBB Q6244300 * @G38ESBB Q6244400 * PROCESS SPIN DATA SETS @G38ESBB Q6244500 * @G38ESBB Q6244600 ***************************************************************@G38ESBB Q6244700 SPACE 1 @G38ESBB Q6245000 PPQSPUR TM PQEDFLAG-PQEDSECT(PL),PQEDALOC ALLOC IOT... @G38ESBB Q6245500 BZ PREMJOE NO, BYPASS SPIN DS PURGE @G38ESBB Q6246000 $QSUSE ACQUIRE ACCESS TO CKPT DATA @G38ESBB Q6246500 L R1,PQEDWJOE-PQEDSECT(,PL) ADDRESS WORK JOE @G38ESBB Q6247000 LH R1,JOEJQE-JOEDSECT(,R1) GET JQE OFFSET @G38ESBB Q6247500 N R1,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6248000 SLL R1,2 EXPAND TO BYTE OFFSET @G38ESBB Q6248500 AL R1,$JOBQPTR ADD JOB QUEUE ORIGIN @G38ESBB Q6249000 LH R1,JQEJOE-JQEDSECT(,R1) ADDRESS FIRST JOE @G38ESBB Q6249500 B PPQJOCH1 GO CHECK FIRST JOE @G38ESBB Q6250000 SPACE 1 @G38ESBB Q6250500 PPQJOECH LH R1,JOEJOE-JOEDSECT(,R1) GET NEXT JOE IN CHAIN @G38ESBB Q6251000 LTR R1,R1 END OF CHAIN... @G38ESBB Q6251500 BZ PPQGTIOT YES, BRANCH, PURGE OK @G38ESBB Q6252000 SPACE 1 @G38ESBB Q6252500 PPQJOCH1 N R1,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6253000 SLL R1,2 EXPAND TO BYTE OFFSET @G38ESBB Q6253500 AL R1,$JOTABLE ADD JOB OUTPUT TABLE ORIGIN @G38ESBB Q6254000 CLC JOEIOTTR-JOEDSECT(,R1),PQEDIOTR-PQEDSECT(PL) @G38ESBBCQ6254500 SAME IOT... @G38ESBB Q6255000 BNE PPQJOECH NO, GO GET NEXT JOE @G38ESBB Q6255500 CL R1,PQEDWJOE-PQEDSECT(,PL) SAME JOE... @G38ESBB Q6256000 BE PPQJOECH YES, GO GET NEXT JOE @G38ESBB Q6256500 B PREMJOE BYPASS PURGE @G38ESBB Q6257000 EJECT @OZ48003 Q6257500 PPQGTIOT DS 0H PURGE SPIN DS SPOOL SPACE @G38ESBB Q6258000 $GETBUF WAIT=YES,FIX=YES GET TEMP BUFFER FOR IOT I/O @G38ESBB Q6258500 MVC PQHSAVE2,PBUFSAVE SAVE SECONDARY BUFFER ADR @G38ESBB Q6259000 ST R1,PBUFSAVE SET BUFFER ADR FOR PRDBUF @G38ESBB Q6259500 L PW,PINIOB SAVE INPUT IOB ADDRESS @G38ESBB Q6259600 MVC PINIOB,PPJOBKEY MOVE JOB KEY TO TEMP FULLWD @G38ESBB Q6259700 L R14,PINIOB SAVE CHANNEL JOB JOB KEY @G38ESBB Q6259800 ST R1,PINIOB TEMP BUFFER IS IOB FOR READ @G38ESBB Q6259900 ICM R1,3,PPFLAG SAVE CHANNEL JOB FLAGS @OZ47265 Q6259910 ICM R1,4,PBFAVAIL AND BUFFER COUNT @OZ47265 Q6259920 NI PPFLAG,FF-PPRDERR RESET ERROR FOR PURSPDS @OZ51839 Q6259930 MVC PPJOBKEY,PQEDJKEY-PQEDSECT(PL) STACKER JOB KEY @G38ESBB Q6259950 L R0,PQEDIOTR-PQEDSECT(,PL) ADDRESS THE IOT @G38ESBB Q6260000 L R15,=A(PURSPDS) CALL SUBROUTINE TO PURGE @G38ESBB Q6260100 BALR PL,R15 SPIN DATA SET SPOOL SPACE @G38ESBB Q6260200 ST R14,PINIOB MOVE JOB KEY TO TEMP FULLWD @G38ESBB Q6260300 MVC PPJOBKEY,PINIOB RESTORE CHANNEL JOB JOB KEY @G38ESBB Q6260400 ST PW,PINIOB RESTORE INPUT IOB ADDRESS @G38ESBB Q6260500 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6260600 STCM R1,3,PPFLAG RESTORE CHANNEL JOB FLAGS @OZ47265 Q6260700 STCM R1,4,PBFAVAIL AND BUFFER COUNT @OZ47265 Q6260800 $FREEBUF PBUFADDR FREE TEMP BUFFER @G38ESBB Q6261000 MVC PBUFADDR,PBUFSAVE RESTORE PRIMARY BUFFER ADR @G38ESBB Q6261100 MVC PBUFSAVE,PQHSAVE2 RESTORE SECONDARY BUF ADR @G38ESBB Q6261200 L PL,PQECPQED RESTORE PQED ADDRESS @G38ESBB Q6261300 EJECT @OZ47265 Q6261400 ***************************************************************@G38ESBB Q6261500 * @G38ESBB Q6261600 * REMOVE STACKED JOE'S FROM JOT @G38ESBB Q6261700 * @G38ESBB Q6261800 ***************************************************************@G38ESBB Q6261900 SPACE 1 @G38ESBB Q6262000 PREMJOE L R1,PQEDWJOE-PQEDSECT(,PL) ADDRESS THE WORK JOE @G38ESBB Q6262500 $#REM WORK=(R1) REMOVE WORK JOE FROM JOT @G38ESBB Q6263000 SPACE 1 @G38ESBB Q6263100 PJQECHK L R3,PQENEXT SEE IF ANY MORE @OZ46484 Q6263110 CR R3,PW JOBS ARE IN THE PPQ @OZ46484 Q6263120 BE PCLRJQE BRANCH IF NONE @OZ46484 Q6263130 CLI PQETYPE,PQES TEST PQE TYPE @OZ46484 Q6263140 BE PJQECHK IGNORE SMF PQE @OZ46484 Q6263150 B PDELDS CONTINUE, MORE JOBS FOUND @OZ46484 Q6263160 SPACE 1 @OZ46484 Q6263170 PCLRJQE MVC PQHXJQE,$ZEROS CLEAR JQE POINTER @OZ46484 Q6263180 EJECT @OZ46484 Q6263190 ***************************************************************@G38ESBB Q6263200 * @G38ESBB Q6263300 * REMOVE STACKED DATA SET PQE'S FROM PAGE QUEUE @G38ESBB Q6263400 * @G38ESBB Q6263500 ***************************************************************@G38ESBB Q6263600 SPACE 1 @G38ESBB Q6263700 PDELDS LR R0,R5 SET PQE COUNT FOR DELETE @G38ESBB Q6264000 L R1,PQHFIRST ADDRESS PQED @G38ESBB Q6264500 L R15,=A(PDELPQE) CALL PDELPQE TO @OZ48003 Q6264750 BALR PL,R15 DELETE DATASET PQE'S @OZ48003 Q6265000 LR R3,R1 ADDRESS PQE0 @G38ESBB Q6265500 SLR R5,R5 CLEAR PQE COUNT @G38ESBB Q6266000 B PNXTPQE GO PROCESS NEXT PQE @G38ESBB Q6266100 SPACE 1 @OZ46484 Q6266200 ***************************************************************@G38ESBB Q6266300 * @G38ESBB Q6266400 * DELETE PREVIOUS CHECKPOINT PQE IF NOT BACKSPACE PQE @G38ESBB Q6266500 * @G38ESBB Q6266600 ***************************************************************@G38ESBB Q6266700 SPACE 1 @G38ESBB Q6267000 PQEDPREV L R15,PQEPREV ADDRESS PREVIOUS PQE @G38ESBB Q6267500 TM PQECFLAG-PQEDSECT(R15),PQECBSP PQEC FOR CKPT... @G38ESBB Q6268000 BO PBSPCHK NO,GO PROCESS BACKSP PQE'S @G38ESBB Q6268500 LA R0,1 SET PQE DELETE COUNT TO 1 @G38ESBB Q6269000 LR R1,R15 ADDRESS PQE TO DELETE @G38ESBB Q6269500 L R15,=A(PDELPQE) CALL PDELPQE TO DELETE @OZ48003 Q6269750 BALR PL,R15 PREVIOUS CKPT PQEC @OZ48003 Q6270000 BCTR R5,0 DECREMENT PQE COUNT @G38ESBB Q6270500 L R15,PQEPREV GET PREVIOUS BACKSPACE PQE @G38ESBB Q6271000 EJECT @OZ48003 Q6271100 ***************************************************************@G38ESBB Q6271200 * @G38ESBB Q6271300 * DETERMINE IF PQE SHOULD BE KEPT AS BACKSPACE ENTRY @G38ESBB Q6271400 * @G38ESBB Q6271500 ***************************************************************@G38ESBB Q6271600 SPACE 1 @G38ESBB Q6271700 PBSPCHK LH R14,PQERPGID DETERMINE IF PQE IS @G38ESBB Q6271800 SH R14,PQERPGID-PQEDSECT(,R15) GREATER THAN @G38ESBB Q6272000 N R14,PCLRHALF $BSPGCT AWAY @G38ESBB Q6272500 SLR R15,R15 FROM PREVIOUS @G38ESBB Q6273000 IC R15,$BSPGCT BACKSPACE @G38ESBB Q6273500 CR R14,R15 PQE @G38ESBB Q6274000 BL PNXTPQE NO, GO PROCESS NEXT PQE @G38ESBB Q6274500 OI PQECFLAG,PQECBSP INDICATE PQE STACKED @G38ESBB Q6275000 IC R15,$BSPNTE HAS NUMBER OF @G38ESBB Q6275500 LA R15,2(,R15) BACKSPACE PQE'S @G38ESBB Q6276000 CR R5,R15 REACHED MAXIMUM... @G38ESBB Q6276500 BNH PNXTPQE NO,GO PROCESS NEXT PQE @G38ESBB Q6277000 LA R0,1 SET PQE DELETE COUNT TO 1 @G38ESBB Q6277500 L R1,PQHFIRST ADDRESS PQED @G38ESBB Q6278000 L R1,PQENEXT-PQEDSECT(,R1) ADDRESS PQECFPG @G38ESBB Q6278500 L R1,PQENEXT-PQEDSECT(,R1) ADDRESS OLDEST BS PQEC @G38ESBB Q6279000 L R15,=A(PDELPQE) CALL PDELPQE TO DELETE @OZ48003 Q6279250 BALR PL,R15 OLDEST BACKSPACE PQE @OZ48003 Q6279500 BCTR R5,0 DECREMENT PQE COUNT @OZ47048 Q6279600 B PNXTPQE GO PROCESS NEXT PQE @G38ESBB Q6280000 EJECT @OZ49145 Q6280100 ***************************************************************@G38ESBB Q6280200 * @G38ESBB Q6280300 * VALIDATE 3800 PAGE ID'S @OZ49145 Q6280350 * CHECKPOINT LAST PQE STACKED, IF ANY @G38ESBB Q6280400 * @G38ESBB Q6280500 ***************************************************************@G38ESBB Q6280600 SPACE 1 @OZ49145 Q6280625 PCKPGID LH R0,PQHCPG SET CHANNEL PAGE ID @OZ49145 Q6280650 LR R1,R0 IN REG0 AND REG1 @OZ49145 Q6280675 SR R0,R4 COMPUTE MAX PAGE DELTA @OZ49145 Q6280700 SR R1,R15 COMPUTE PQE PAGE DELTA @OZ49145 Q6280725 N R0,PCLRHALF CLEAR LEFT HALF WORD @OZ49145 Q6280750 N R1,PCLRHALF CLEAR LEFT HALF WORD @OZ49145 Q6280775 CR R1,R0 COMPARE WITH MAXIMUM @OZ49145 Q6280800 BNH PPQENDQ BRANCH IF VALID @OZ49145 Q6280825 OI PQHAFLAG,PQHABORT ELSE, SET ABORT FLAG @OZ49145 Q6280850 SPACE 1 @OZ49145 Q6280875 PPQENDQ LTR R10,R10 ANY PQE TO CHECKPOINT... @G38ESBB Q6281000 BZ PPQRET NO, GO RETURN @G38ESBB Q6281500 LR R3,R10 INDICATE PQE TO CHECKPOINT @G38ESBB Q6281600 BAL PL,PCKPTNI PERFORM CKPT JOE CHECKPOINT @G38ESBB Q6282000 TM PQECFLAG-PQEDSECT(R10),PQECBSP BACKSPACE PQE... @G38ESBB Q6282500 BO PPQRET YES, GO RETURN @G38ESBB Q6283000 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6283500 LA R0,1 SET PQE COUNT @OZ48003 Q6284000 LR R1,R10 SET PQE ADDRESS @OZ48003 Q6284500 L R15,=A(PDELPQE) CALL PDELPQE TO @OZ48003 Q6284750 BALR PL,R15 DELETE CHECKPOINT PQE @OZ48003 Q6285000 SPACE 1 @OZ49145 Q6285100 PPQRET TM PQHFLAG,PQHDRAIN TEST IF DRAINING @OZ49145 Q6285200 BZ PPQRETN BRANCH IF NOT @OZ49145 Q6285300 NI PQHFLAG,FF-PQHDRAIN RESET DRAIN FLAG @OZ49145 Q6285400 NI PQHAFLAG,FF-PQHABORT RESET ABORT FLAG @OZ49145 Q6285500 ST PW,PQHPIDE SHOW NO IDS PENDING @OZ49145 Q6285600 XC PQHXJQE,PQHXJQE SHOW NO JOB ON PRINTER @OZ49145 Q6285700 XC PQHPQEJ,PQHPQEJ SHOW NO JOBS PENDING @OZ49145 Q6285800 SPACE 1 @OZ49145 Q6285900 PPQRETN PRETURN RESTORE REGS AND RETURN @OZ49145 Q6286000 DROP PW,R3 DROP PQH,PQE ADR @G38ESBB Q6286500 USING BUFDSECT,PBUF RESTORE BUFFER ADDRESS @G38ESBB Q6286700 EJECT @G38ESBB Q6287000 *********************************************************************** Q6288000 * @G38ESBB Q6289000 * ACQUIRE ACCESS TO CHECKPOINT DATA, THEN UPDATE AND @G38ESBB Q6290000 * CHECKPOINT THE CHECKPOINT JOE. IF NECESSARY, INDICATE @G38ESBB Q6291000 * CKECKPOINT JOE IS VALID. @G38ESBB Q6292000 * @G38ESBB Q6293000 * R1 - ADDRESS OF CHECKPOINT JOE @G38ESBB Q6293200 * R3 - PQE TO CHECKPOINT @G38ESBB Q6293400 * R15 - ADDRESS OF WORK JOE @G38ESBB Q6293600 * @G38ESBB Q6293800 * ON EXIT CONDITION CODE IS SET @G38ESBB Q6294000 * CC=ZERO - CHECKPOINT ACCESS ACQUIRED @G38ESBB Q6295000 * CC=NON-ZERO - CHECKPOINT ACCESS FAILED @G38ESBB Q6296000 * @G38ESBB Q6297000 ***************************************************************@G38ESBB Q6298000 SPACE 1 @G38ESBB Q6299000 PCKPTNI LR R1,PL SAVE RETURN REG @G38ESBB Q6299500 L R15,=A(PGETQS) CALL CKPT @G38ESBB Q6300000 BALR PL,R15 ACCESS ROUTINE @G38ESBB Q6301000 LR PL,R1 RESTORE RETURN REG @G38ESBB Q6301100 BNZR PL Q'S NOT OWNED, RETURN @G38ESBB Q6301200 SPACE 1 @G38ESBB Q6301300 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q6301400 * DELETED @G38ESBB Q6301500 PRINT ON THIS SECTION DELETED BY @G38ESBB Q6302000 SPACE 1 @G383SBB Q6303000 ***************************************************************@G38ESBB Q6304000 * @G38ESBB Q6304500 * ACCESS TO CKPT DATA HAS BEEN ACQUIRED. @G38ESBB Q6305000 * UPDATE THE CKPT JOE FROM INFO IN PQEC AND PQED. @G38ESBB Q6306000 * @G38ESBB Q6306500 ***************************************************************@G38ESBB Q6307000 SPACE 1 @G38ESBB Q6308000 USING PQEDSECT,R3 PROVIDE PQE ADDRESSABILITY @G38ESBB Q6309000 SPACE 1 @G38ESBB Q6309100 PRINT OFF THIS SECTION DELETED BY @G38ESBB Q6309200 * DELETED @G38ESBB Q6309300 * DELETED @G38ESBB Q6309400 * DELETED @G38ESBB Q6309500 * DELETED @G38ESBB Q6309600 * DELETED @G38ESBB Q6309650 * DELETED @G38ESBB Q6309700 PRINT ON THIS SECTION DELETED BY @G38ESBB Q6309800 SPACE 1 @G38ESBB Q6309900 L R15,PQECPQED ADDRESS THE PQED @G38ESBB Q6310000 L R1,PQEDWJOE-PQEDSECT(,R15) ADDRESS WORK JOE @G38ESBB Q6311000 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY @G38ESBB Q6312000 LH R1,JOECKPT GET CKPT JOE OFFSET/4 @G38ESBB Q6312100 N R1,PCLRHALF ZERO LEFT HALFWORD @G38ESBB Q6312200 SLL R1,2 COMPUTE BYTE OFFSET @G38ESBB Q6312300 AL R1,$JOTABLE ADD BASE @G38ESBB Q6312400 MVC JOEJRCB,PQECJRCB MOVE DISP INTO EJECT BUFFER @G38ESBB Q6313000 MVC JOEPDDB,PQEDPDDB-PQEDSECT(R15) PDDB OFFSET @G38ESBB Q6314000 MVC JOEPPCT,PQECPPCT MOVE PDDB LOGICAL PAGE CT @G38ESBB Q6315000 MVC JOETLNC,PQECTLNC MOVE TOTAL JOE LINE COUNT @G38ESBB Q6316000 MVC JOETPCT,PQECTPCT MOVE TOTAL JOE PAGE COUNT @G38ESBB Q6317000 MVC JOEMTTR,PQECMTTR MOVE MTTR OF SPOOL DATA @G38ESBB Q6318000 MVC JOEIOTTR,PQEDIOTR-PQEDSECT(R15) IOT TRACK ADR @G38ESBB Q6319000 MVC JOECOPY,PQEDCOPY-PQEDSECT(R15) COPY IN PROGRESS @G38ESBB Q6320000 MVC JOECPYG,PQEDCPYG-PQEDSECT(R15) COPY GROUP OFFST @G38ESBB Q6321000 MVC JOETNDS,PQEDTNDS-PQEDSECT(R15) NUMBER OF DS'S @G38ESBB Q6322000 $#CKPT JOE=0(,R1),TYPE=A SCHEDULE CKPT JOE FOR CKPT @G38ESBB Q6323000 SPACE 1 @G38ESBB Q6324000 DROP R1 DROP CKPT JOE ADR @G38ESBB Q6325000 USING JOEDSECT,R15 PROVIDE WORK JOE ADR @G38ESBB Q6326000 SPACE 1 @G38ESBB Q6327000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q6327500 L R15,PQEDWJOE-PQEDSECT(,R15) ADDRESS WORK JOE @G38ESBB Q6328000 * DELETED @G38ESBB Q6328500 TM JOEFLAG,$JOECKV CKPT JOE ALREADY VALID... @G38ESBB Q6329000 BO PCKNIEND YES, GO EXIT @G38ESBB Q6330000 OI JOEFLAG,$JOECKV SET CKPT VALID FLAG @G38ESBB Q6331000 $#CKPT JOE=0(,R15),TYPE=A CKPT THE WORK JOE @G38ESBB Q6331500 * DELETED @G38ESBB Q6331600 SPACE 1 @G38ESBB Q6332000 PCKNIEND SR R15,R15 SET ZERO CC @G38ESBB Q6333000 BR PL RETURN @G38ESBB Q6334000 DROP R3,R15 DROP PQE,JOE ADR @G38ESBB Q6335000 USING BUFDSECT,PBUF RESTORE BUFFER ADDRESS @G38ESBB Q6336000 SPACE 3 @G38ESBB Q6337000 LTORG @G38ESBB Q6337998 TITLE 'HASPPRPU -- LOCATE 3800 TRANSFER STATION' @G38ESBB Q6338000 ***************************************************************@G38ESBB Q6339000 * @G38ESBB Q6340000 * THE LOCATE FUNCTION DETERMINES WHICH PHYSICAL PAGE @G38ESBB Q6341000 * IS AT THE TRANSFER STATION OR, IF PAPER JAM, THE @G38ESBB Q6342000 * FUSER STATION. IT DOES THIS BY USING THE REQUEST @G38ESBB Q6343000 * PRINTER INFORMATION DATA IN THE BUFFER WORK AREA. @G38ESBB Q6344000 * IN ADDITION, PP3800R IS SET IF THE COMMAND ENTERED @G38ESBB Q6345000 * IF PROCESSABLE FOR THE TRANSFER PAGE. @G38ESBB Q6346000 * @G38ESBB Q6347000 * NON-PROCESSABLE COMMANDS OCCUR WHEN @G38ESBB Q6348000 * @G38ESBB Q6349000 * - THE TRANSFER STATION IS AT A JOE BOUNDARY @G38ESBB Q6350000 * AND THE COMMAND IS $N, $C, $E, $I OR $F @G38ESBB Q6351000 * - THE TRANSFER STATION IS AT A DATA SET BOUNDARY @G38ESBB Q6352000 * AND $F WAS SPECIFIED @G38ESBB Q6353000 * - THE JOE AT THE TRANSFER STATION WAS PREVIOUSLY @G38ESBB Q6354000 * CANCELLED @G38ESBB Q6355000 * @G38ESBB Q6356000 * R1 - ADDRESS OF THE PQE @G38ESBB Q6357000 * PW - ADDRESS OF THE PQH @G38ESBB Q6358000 * @G38ESBB Q6359000 ***************************************************************@G38ESBB Q6360000 SPACE 1 @G38ESBB Q6361000 PLOCATE PSAVE ALL SAVE ALL REGISTERS @G38ESBB Q6362000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q6363000 USING PLOCATE,BASE2 ADDRESSABILITY @G38ESBB Q6364000 L PW,PQHADR ESTABLISH PQH @G38ESBB Q6365000 USING PQHDSECT,PW ADDRESSABILITY @G38ESBB Q6366000 L R15,PCEDCT TEST FOR PAPER JAM OR @G38ESBB Q6367000 TM DCTPPSW2-DCTDSECT(R15),DCTCKJAM CANCEL KEY... @G38ESBB Q6368000 BZ PLOCTPQE BR IF NOT @G38ESBB Q6369000 MVC PQHOPG,DCTLDPID-DCTDSECT(R15) GET ORG PG IN DCT @G38ESBB Q6370000 SPACE 1 @G38ESBB Q6371000 PLOCTPQE L R1,PQHPIDE GET ID TO BE COMPLETED @G38ESBB Q6372000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q6373000 CR R1,R15 ANY ID'S PENDING... @G38ESBB Q6374000 BNE PLOCPREV YES, BRANCH @G38ESBB Q6375000 CL R15,PQHLAST ANY PQE'S... @G38ESBB Q6376000 BE PTSTCJP BRANCH IF NOT @OZ44633 Q6377000 LR R1,R15 ADDRESS PQE0 @G38ESBB Q6378000 USING PQEDSECT,R1 PQE ADDRESSABILITY @G38ESBB Q6379000 SPACE 1 @G38ESBB Q6380000 PLOCPREV L R1,PQEPREV GET LAST COMPLETED PQE @G38ESBB Q6381000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q6382000 CR R1,R15 END OF PQE... @G38ESBB Q6383000 BE PTSTCJP BRANCH IF YES @OZ44633 Q6384000 CLI PQETYPE,PQEC VALID CKPT ENTRY... @G38ESBB Q6385000 BNE PLOCPREV GET PREVIOUS PQE IF NOT @G38ESBB Q6386000 LH R15,PQHOPG TEST IF THIS PQE IS BEYOND @G38ESBB Q6387000 SH R15,PQERPGID THE ORIGIN PAGE @G38ESBB Q6388000 N R15,PCLRHALF (ORIGIN PAGE LESS @G38ESBB Q6389000 C R15,PQELIMIT THAN RPGID) @G38ESBB Q6390000 BH PLOCPREV KEEP SCANNING IF NOT @G38ESBB Q6391000 CLC PQHOPG,PQERPGID IS ORIGIN PAGE AT A PQEC @G38ESBB Q6392000 BNE PSAVOPQE BR IF NOT, OPQE FOUND @G38ESBB Q6393000 CLC PQEFCBLN,=H'1' MUST BE AT TOP OF FCB @G38ESBB Q6394000 BNE PLOCPREV TO BE USED AS OPQE @G38ESBB Q6395000 SPACE 1 @G38ESBB Q6396000 PSAVOPQE ST R1,PQHOPQE SAVE PQE CLOSEST TO OPG @G38ESBB Q6397000 SPACE 1 @G38ESBB Q6398000 ***************************************************************@G38ESBB Q6399000 * @G38ESBB Q6400000 * DETERMINE WHETHER COMMAND IS PROCESSABLE @G38ESBB Q6401000 * @G38ESBB Q6402000 ***************************************************************@G38ESBB Q6403000 SPACE 1 @G38ESBB Q6404000 L R15,PCEDCT TEST FOR PAPERJAM OR @G38ESBB Q6405000 TM DCTPPSW2-DCTDSECT(R15),DCTCKJAM CANCEL KEY @G38ESBB Q6406000 BO PLOCEND BR IF YES, ALWAYS PROCESSED @G38ESBB Q6407000 TM PQHFLAG,PQH2CMD DOUBLE COMMAND... @G38ESBB Q6408000 BO PLOCEND YES,BRANCH,CMD PROCESSABLE @G38ESBB Q6409000 L R14,PQECPQED GET DATA SET PQE FOR OPQE @G38ESBB Q6410000 TM PQEDFLAG-PQEDSECT(R14),PQEDCAN IS JOE CANCELLED @G38ESBB Q6411000 BO PTSTCJP BR IF YES, NOT PROCESSABLE @OZ44633 Q6412000 TM PQECFLAG,PQECLPG TEST FOR LAST PAGE OF DS @G38ESBB Q6413000 BZ PTESTCJP BR IF NOT @G38ESBB Q6414000 SPACE 1 @G38ESBB Q6415000 ***************************************************************@G38ESBB Q6416000 * @G38ESBB Q6417000 * LAST PAGE OF DATA SET IS AT TRANSFER STATION @G38ESBB Q6418000 * @G38ESBB Q6419000 ***************************************************************@G38ESBB Q6420000 SPACE 1 @G38ESBB Q6421000 TM PDCTFLAG,DCTDELET+DCTRSTRT+DCTRPT $C,$E,$I,$N.. @G38ESBB Q6422000 BNZ PJOEEND YES, BR TO TEST END OF JOE @G38ESBB Q6423000 L R15,PFSBSCT GET BACKSPACE AMOUNT @G38ESBB Q6424000 LTR R15,R15 TEST FOR $B OR $F @G38ESBB Q6425000 BNL PROCNOP BR IF $F @G38ESBB Q6426000 LPR R15,R15 GET POSITIVE BACKSPACE CT @G38ESBB Q6427000 CLC PFSBSCT,PMAXPAGE TO TEST $BPRTN,D @G38ESBB Q6428000 BE PROCNOP BR IF YES @G38ESBB Q6429000 TM PQEDFLAG-PQEDSECT(R14),PQEDLAST LAST DS OF JOE. @G38ESBB Q6430000 BZ PLOCEND NO,BRANCH,CMD PROCESSABLE @G38ESBB Q6431000 L PL,PCEDCT ADDRESS PRPU DCT @G38ESBB Q6432000 TM DCTPPSW2-DCTDSECT(PL),DCTBFCKP TEST $B,C @G38ESBB Q6433000 BO PLOCEND YES,BRANCH,CMD PROCESSABLE @G38ESBB Q6434000 LH PL,PQHOPG IF TARGET PAGE @G38ESBB Q6435000 SH PL,PQERPGID NOT WITHIN SPOOL @G38ESBB Q6436000 CR PL,R15 DATA, THEN COMMAND @G38ESBB Q6437000 BNL PROCNOP IS NOT PROCESSABLE @G38ESBB Q6438000 B PLOCEND CMD IS $B, PROCESSABLE @G38ESBB Q6439000 EJECT @OZ46351 Q6440000 PJOEEND TM PDCTFLAG,DCTRPT TEST FOR $N COMMAND @OZ46351 Q6441000 BZ PTSTCJP BRANCH IF NOT @OZ46351 Q6441100 TM PQEDFLAG-PQEDSECT(R14),PQEDLAST CK FOR LAST DS @OZ46351 Q6441200 BZ PTESTCJP BR IF NOT @G38ESBB Q6442000 SPACE 1 @G38ESBB Q6443000 PTSTCJP ICM R15,15,PCEJQE ADDRESS CHANNEL JOB'S JQE @OZ44633 Q6444000 BZ PROCNOP BRANCH IF NONE @OZ44633 Q6445000 TM JQEFLAGS-JQEDSECT(R15),QUEOPCAN+QUEPURGE $CJ,P @OZ44633 Q6446000 BNO PROCNOP BRANCH IF NOT @OZ44633 Q6447000 L R1,PQHLAST ADDRESS LAST PQE @OZ44633 Q6447100 B PTSTCJP1 LOCATE PQED @OZ44633 Q6447200 SPACE 1 @OZ44633 Q6448000 PTESTCJP ICM R15,15,PCEJQE ADDRESS CHANNEL JOB'S JQE @OZ44633 Q6448300 BZ PTESTRPT BRANCH IF NONE @OZ44633 Q6448600 TM JQEFLAGS-JQEDSECT(R15),QUEOPCAN+QUEPURGE $CJ,P @OZ44633 Q6449000 BNO PTESTRPT BRANCH IF NOT @OZ44633 Q6449300 L R15,PQEDWJOE-PQEDSECT(,R14) GET OPQE WORK JOE @OZ44633 Q6449600 LH R15,JOEJQE-JOEDSECT(,R15) GET OPQE JQE OFFSET @OZ44633 Q6450000 N R15,PCLRHALF CLEAR LEFT HALFWORD @OZ44633 Q6451000 SLL R15,2 EXPAND TO BYTE OFFSET @OZ44633 Q6452000 AL R15,$JOBQPTR ADD JOB QUEUE ORIGIN @OZ44633 Q6453000 CL R15,PCEJQE CANCELLED JQE EQ OPQE JQE @OZ44633 Q6454000 BE PLOCEND CANCEL OPQE JOE IF YES @OZ44633 Q6455000 L R1,PQHLAST ADDRESS LAST PQE @OZ44633 Q6455100 SPACE 1 @OZ44633 Q6455200 PTSTCJP1 CR R1,PW CHECK FOR END OF PPQ @OZ44633 Q6456000 BE PROCNOP1 BRANCH IF YES @OZ44633 Q6457000 CLI PQETYPE,PQEC TEST FOR PQEC @OZ44633 Q6458000 BE PTSTCJP2 BRANCH IF YES @OZ44633 Q6459000 L R1,PQEPREV GET PREVIOUS PQE @OZ44633 Q6460000 B PTSTCJP1 TEST PREVIOUS PQE @OZ44633 Q6460500 SPACE 1 @OZ44633 Q6461000 PTSTCJP2 L R1,PQECPQED ADDRESS PQED @OZ44633 Q6461500 CLC PQEDWJOE,PWKJOE CHECK JOE ADDRESS @OZ44633 Q6462000 BNE PLOCRET BRANCH IF NOT CURRENT @OZ44633 Q6462500 TM PQEDFLAG,PQEDCAN+PQEDCJP ALREADY CANCELLED... @OZ44633 Q6463000 BM PROCNOP1 BRANCH IF YES @OZ44633 Q6463500 OI PQEDFLAG,PQEDCAN+PQEDCJP INDICATE CANCELLED @OZ44633 Q6464000 OI PQHFLAG,PQHDSVC INDICATE RESET NEEDED @OZ44633 Q6464500 B PLOCRET CHANNEL ORIENTED @OZ44633 Q6465000 SPACE 1 @G38ESBB Q6466000 PTESTRPT TM PDCTFLAG,DCTRPT $N COMMAND... @G38ESBB Q6467000 BZ PLOCEND COMMAND PROCESSABLE IF NOT @G38ESBB Q6468000 NI PDCTFLAG,FF-DCTRPT RESET REPEAT FLAG @G38ESBB Q6469000 L R15,PQEDWJOE-PQEDSECT(,R14) GET OPQE WORK JOE @G38ESBB Q6470000 LH R1,JOECHAR-JOEDSECT(,R15) GET CHAR JOE OFFSET @G38ESBB Q6471000 N R1,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6472000 SLL R1,2 EXPAND TO BYTE OFFSET @G38ESBB Q6473000 AL R1,$JOTABLE ADD JOB OUTPUT TABLE ORIGIN @G38ESBB Q6474000 LR R0,R15 SAVE WORK JOE ADDR FOR ADD @G38ESBB Q6475000 $#ADD WORK=(R0),CHAR=(R1) COPY JOE BACK INTO QUEUE @G38ESBB Q6476000 BZ PNMSG BR IF ADD SUCCESSFUL @G38ESBB Q6477000 L R1,PQHOPQE ADDRESS ORIGIN PQE @G38ESBB Q6478000 L R1,PQECPQED GET DATA SET PQE AT ORIGIN @G38ESBB Q6479000 TM PQEDFLAG,PQEDLAST LAST DS OF JOE... @G38ESBB Q6480000 BO PDEFRPT YES, GO DEFER COMMAND @G38ESBB Q6481000 OI PDCTFLAG,DCTRPT ELSE, RESET COMMAND FLAG @G38ESBB Q6482000 B PNMSG BRANCH, DEFER AT PPDONE @G38ESBB Q6483000 SPACE 1 @G38ESBB Q6484000 PDEFRPT OI PQEDFLAG,PQEDRPT INDICATE DEFERRED $N @G38ESBB Q6485000 IC R14,PQHCMDCT GET DEFERRED CMD COUNT @G38ESBB Q6486000 LA R14,1(,R14) INCREMENT DEFERRED COUNT @G38ESBB Q6487000 STC R14,PQHCMDCT SAVE NEW COUNT @G38ESBB Q6488000 SPACE 1 @G38ESBB Q6489000 PNMSG L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6490000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @G38ESBB Q6490500 $MID 170 MESSAGE IDENTIFIER @G38ESBB Q6491000 PMSG PMESSAGE,M170L,(X'170F',DCTDEVN,C' REPEATED') @G38ESBBCQ6492000 MOVE MESSAGE TEXT @G38ESBB Q6493000 DROP R15 DROP DCT ADDRESSABILITY @G38ESBB Q6493500 $WTO PMESSAGE,M170L, INFORM THE OPERATOR @G38ESBBCQ6494000 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST,JOB=NO @G38ESBB Q6495000 B PROCNOP1 BR TO CLEAR FLAG SETTINGS @G38ESBB Q6496000 SPACE 1 @G38ESBB Q6497000 ***************************************************************@G38ESBB Q6498000 * @G38ESBB Q6499000 * COMMAND NOT PROCESSABLE, WRITE REJECT MESSAGE AND @G38ESBB Q6500000 * RESET FLAGS @G38ESBB Q6501000 * @G38ESBB Q6502000 ***************************************************************@G38ESBB Q6503000 SPACE 1 @G38ESBB Q6504000 PROCNOP L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6505000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @G38ESBB Q6505500 TM DCTPPSW2,DCTCKJAM PAPER JAM... @G38ESBB Q6506000 BZ PNOPMSG NO, GO ISSUE MESSAGE @G38ESBB Q6507000 LA R1,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @G38ESBB Q6508000 SPACE 1 @OZ47595 Q6508250 PNOPLOOP LR R0,R1 SAVE PREVIOUS PQE ADDR @OZ47595 Q6508500 L R1,PQENEXT GET NEXT PQE @OZ47595 Q6509000 CR R1,PW CHECK FOR END OF PPQ @OZ47595 Q6509500 BE PNOPRSET BRANCH IF YES @OZ47595 Q6510000 CLI PQETYPE,PQES CHECK FOR PQES @OZ47595 Q6510500 BE PNOPLOOP BRANCH IF YES @OZ47595 Q6511000 PNOPSET ST R0,PQHOPQE SET PQE ADDRESS @OZ47595 Q6511500 OI PQHFLAG,PQHRSTRT INDICATE PPQ RESTART @OZ47595 Q6512000 B PLOCEND CONTINUE @OZ47595 Q6512500 SPACE 1 @OZ47595 Q6513000 PNOPRSET CLC PCEJQE,$ZEROS TEST FOR CURRENT JOB @OZ47595 Q6513500 BNE PNOPSET BRANCH IF YES @OZ47595 Q6514000 NI DCTPPSW2,FF-DCTCKJAM RESET CK/JAM SWITCH @OZ47595 Q6514500 B PROCNOP1 BRANCH TO RESET FLAGS @OZ47595 Q6515000 SPACE 1 @G38ESBB Q6516000 PNOPMSG DS 0H @G38ESBB Q6517000 $MID 152 GET MESSAGE IDENTIFIER @G38ESBB Q6518000 PMSG PMESSAGE,M152L2,(X'152F',DCTDEVN,C' COMMAND REJECTED') CQ6519000 MOVE MESSAGE TEXT @G38ESBB Q6520000 $WTO PMESSAGE,M152L2,JOB=NO, INFORM OPERATOR @G38ESBBCQ6521000 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST @G38ESBB Q6522000 SPACE 1 @G38ESBB Q6523000 PROCNOP1 NI PDCTFLAG,FF-DCTSPACE-DCTDELET-DCTRSTRT-DCTBKSP @G38ESBB Q6524000 NI PDCTFLAG,FF-DCTRPT RESET REPEAT FLAG ($N) @OZ46352 Q6524100 NI PPFLAG,FF-PPDELSW-PRDELSW RESET COMMAND FLAGS @G38ESBB Q6525000 B PLOCRET BR TO RETURN @G38ESBB Q6526000 SPACE 1 @G38ESBB Q6527000 PLOCEND OI PPFLAG3,PP3800R INDICATE CMD PROCESSABLE @G38ESBB Q6528000 NI PPFLAG3,FF-PP3800S-PP38CKPT RESET FLAGS @OZ51592 Q6528050 MVC PQHLPG,PQHOPG SET LOCATED XFER STN PGID @OZ46351 Q6528100 OI PQHFLAG,PQHIPPQM SET INHIBIT FLAG @OZ46674 Q6528200 NI PPFLAG,FF-PPNEWS RESET NEWS FLAG @OZ50141 Q6528300 L R15,PCEDCT ADDRESS DCT @G38ESBB Q6529000 MVC DCTCSW,$ZEROS CLEAR RESTART CSW @G38ESBB Q6530000 SPACE 1 @G38ESBB Q6531000 TM DCTPPSW2,DCTCKJAM PJAM/CKEY... @OZ48003 Q6531100 BZ PLOCRET BRANCH IF NOT @OZ48003 Q6531200 NI PPFLAG3,FF-PPQSPND RESET PPQ SUSPEND FLAG @OZ48003 Q6531300 NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ48003 Q6531400 SPACE 1 @OZ48003 Q6531500 PLOCRET PRETURN RESTORE REGS AND RETURN @G38ESBB Q6532000 DROP PW,R1,R15 SUSPEND PQH, PQE, DCT @G38ESBB Q6533000 LTORG @OZ51011 Q6533010 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 COMMAND PROCESSING' @OZ51011 Q6533020 ***************************************************************@OZ51011 Q6533030 * @OZ51011 Q6533040 * PROCESS SYNCHRONOUS OPERATOR COMMANDS AFTER AN I/O ERROR @OZ51011 Q6533050 * @OZ51011 Q6533060 ***************************************************************@OZ51011 Q6533070 SPACE 1 @OZ51011 Q6533080 USING PPCMDCK,BASE2 LOCAL ADDRESSABILITY @OZ51011 Q6533090 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @OZ51011 Q6533100 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @OZ51011 Q6533110 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @OZ51011 Q6533120 USING BFWDSECT,R4 PROVIDE BFW ADDRESSABILITY @OZ51011 Q6533130 SPACE 1 @OZ51011 Q6533140 PPCMDCK PSAVE ALL SAVE REGISTERS @OZ51011 Q6533150 LR BASE2,R15 SET LOCAL BASE REGISTER @OZ51011 Q6533175 CLI PDEVTYP3,UCB3800 TEST FOR 3800 @OZ51011 Q6533200 BNE PPCMDRTN BRANCH IF NOT @OZ51011 Q6533225 TM PPFLAG3,PP3800R 3800 REPOSITIONING... @OZ51011 Q6533250 BO PPCMDRTN BRANCH IF YES @OZ51011 Q6533275 L R15,PCEDCT GET DCT ADDRESS @OZ51011 Q6533300 L PW,PQHADR GET PQH ADDRESS @OZ51011 Q6533325 SPACE 1 @OZ51011 Q6533350 ICM R1,15,PCEJQE GET JQE ADDRESS @OZ51011 Q6533375 BZ PPCMDRTN BRANCH IF NONE @OZ51011 Q6533400 TM JQEFLAGS-JQEDSECT(R1),QUEOPCAN+QUEPURGE TEST @OZ51011 Q6533425 BNO PPCKTRM BRANCH IF NOT $CJP @OZ51011 Q6533450 OI DCTFLAGS,DCTDELET ELSE, SIMULATE $CPRT @OZ51011 Q6533475 SPACE 1 @OZ51011 Q6533500 PPCKTRM TM DCTFLAGS,DCTDELET+DCTRSTRT TERMINATION CMD... @OZ51011 Q6533525 BZ PPCMDRTN BRANCH IF NOT @OZ51011 Q6533550 OC PDCTFLAG,DCTFLAGS PROVIDE TERMINATION REASON @OZ51011 Q6533575 NI DCTFLAGS,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ51011 Q6533600 OI PPFLAG,PRDELSW+PPDELSW SET TERMINATION FLGS @OZ51011 Q6533625 OI PPFLAG3,PP3800R SET CMD FLAG @OZ51011 Q6533650 NI PPFLAG,FF-PPWSW INDICATE I/O COMPLETE @OZ51011 Q6533675 XC DCTCSW,DCTCSW CLEAR INTV REQD ADDR @OZ51011 Q6533700 DROP R15 SUSPEND DCT ADDRESSABILITY @OZ51011 Q6533725 SPACE 1 @OZ51011 Q6533750 OI PQHFLAG,PQHCHCMD SET SYNC CMD FLAG @OZ51011 Q6533775 SLR R0,R0 SET COUNT FOR @OZ51011 Q6533800 BCTR R0,0 PQECOMP ROUTINE @OZ51011 Q6533825 L R15,=A(PQECOMP) CALL PQECOMP TO @OZ51011 Q6533850 BALR PL,R15 PROCESS COMPLETED PQE'S @OZ51011 Q6533875 NI PQHFLAG,FF-PQHCHCMD RESET SYNC CMD FLAG @OZ51011 Q6533900 EJECT @OZ51011 Q6533925 LH R4,PCCWLAST GET PCIE OFFSET @OZ51011 Q6533950 AL R4,POUTCCWN ADD CCW AREA BASE @OZ51011 Q6533975 LA R4,PCIESIZE(,R4) POINT TO BFW @OZ51011 Q6534000 MVI BFWPQECT,0 ZERO PQE COUNT IN AREA @OZ51011 Q6534025 LH R4,PCCWLAST GET PCIE OFFSET @OZ51011 Q6534050 AL R4,POUTCCWA ADD CCW AREA BASE @OZ51011 Q6534075 LA R4,PCIESIZE(,R4) POINT TO BFW @OZ51011 Q6534100 MVI BFWPQECT,0 ZERO PQE COUNT IN AREA @OZ51011 Q6534125 L R1,PQHPIDE ADDR FIRST INCOMPLETE PQE @OZ51011 Q6534150 LR R5,R1 SAVE PQE ADDRESS @OZ51011 Q6534175 DROP R4 SUSPEND BFW ADDRESSABILITY @OZ51011 Q6534200 SPACE 1 @OZ51011 Q6534225 PPCHKPQE L R1,PQEPREV GET PREVIOUS PQE @OZ51011 Q6534250 CLR R1,PW TEST FOR END OF PPQ @OZ51011 Q6534275 BE PPRGPQEJ BRANCH IF YES @OZ51011 Q6534300 CLI PQETYPE,PQED TEST FOR PQED @OZ51011 Q6534325 BNE PPCHKCS BRANCH IF NOT @OZ51011 Q6534350 LR R5,R1 SAVE PQE ADDRESS @OZ51011 Q6534375 B PPCHKPQE GET NEXT PQE @OZ51011 Q6534400 SPACE 1 @OZ51011 Q6534425 PPCHKCS CLI PQETYPE,PQEC TEST FOR PQEC @OZ51011 Q6534450 BNE PPCHKPQE BRANCH IF NOT @OZ51011 Q6534475 L R4,PQECPQED ADDRESS PQED @OZ51011 Q6534500 CLC PQEDWJOE-PQEDSECT(,R4),PWKJOE TEST JOE ADDR @OZ51011 Q6534525 BNE PPRGPQEJ BRANCH IF NOT CURRENT @OZ51011 Q6534550 OI PQEDFLAG-PQEDSECT(R4),PQEDLAST SET LAST D.S. @OZ51011 Q6534575 OI PQECFLAG,PQECLPG SET LAST PAGE OF DATASET @OZ51011 Q6534600 NI PQECFLAG,FF-PQECBSP RESET STACKED INDICATOR @OZ51011 Q6534610 TM PDCTFLAG,DCTDELET TEST FOR $C CMD @OZ51011 Q6534625 BZ PPTSTINT BRANCH IF NOT @OZ51011 Q6534650 OI PQEDFLAG-PQEDSECT(R4),PQEDCAN SET DS CANCELLED @OZ51011 Q6534675 OI PSMFDCI,SMFOPSTP SET SMF FLAG @OZ51011 Q6534700 B PRSTFLGS BRANCH TO RESET FLAGS @OZ51011 Q6534725 SPACE 1 @OZ51011 Q6534750 PPTSTINT TM PDCTFLAG,DCTBKSP TEST FOR $I CMD @OZ51011 Q6534775 BZ PPTSTRST BRANCH IF NOT @OZ51011 Q6534800 OI PQEDFLAG-PQEDSECT(R4),PQEDINT SET DS INTERRUPT @OZ51011 Q6534825 OI PSMFDCI,SMFINTRP SET SMF FLAG @OZ51011 Q6534850 B PPSETCNT BRANCH TO SET CMD COUNT @OZ51011 Q6534875 EJECT @OZ51011 Q6534900 PPTSTRST OI PSMFDCI,SMFRESTR SET SMF FLAG @OZ51011 Q6534925 $#ADD WORK=PWKJOE,CHAR=PCHJOE REQUEUE JOE FOR $E CMD @OZ51011 Q6534950 BZ PRSTFLGS BRANCH IF SUCCESSFUL @OZ51011 Q6534975 OI PQEDFLAG-PQEDSECT(R4),PQEDRST DEFER REQUEUE @OZ51011 Q6535000 SPACE 1 @OZ51011 Q6535025 PPSETCNT IC R15,PQHCMDCT INCREMENT COUNT @OZ51011 Q6535050 LA R15,1(,R15) OF DEFERRED @OZ51011 Q6535075 STC R15,PQHCMDCT COMMANDS @OZ51011 Q6535100 SPACE 1 @OZ51011 Q6535125 PRSTFLGS NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ51011 Q6535150 B PPREMPQE BR TO REMOVE INC PQE'S @OZ51011 Q6535175 SPACE 1 @OZ51011 Q6535200 PPRGPQEJ LA R4,PQHPQEJ-(PQEJNEXT-PQEDSECT) POINT TO PQEJ0 @OZ51011 Q6535225 SPACE 1 @OZ51011 Q6535250 PPCKJQUE ICM R1,15,PQEJNEXT-PQEDSECT(R4) GET NEXT PQEJ @OZ51011 Q6535275 BZ PPREMPQE BRANCH IF NONE @OZ51011 Q6535300 CLC PQEJWJOE,PWKJOE TEST WORK JOE ADDRESS @OZ51011 Q6535325 BE PDELPQEJ BRANCH IF CURRENT @OZ51011 Q6535350 LR R4,R1 SAVE PREVIOUS PQEJ ADDR @OZ51011 Q6535375 B PPCKJQUE BR TO TEST NEXT PQEJ @OZ51011 Q6535400 SPACE 1 @OZ51011 Q6535425 PDELPQEJ MVC PQEJNEXT-PQEDSECT(,R4),PQEJNEXT DECHAIN PQEJ @OZ51011 Q6535450 LA R0,1 SET PQE COUNT @OZ51011 Q6535475 L R15,=A(PDELPQE) CALL PDELPQE @OZ51011 Q6535500 BALR PL,R15 TO DELETE PQEJ @OZ51011 Q6535525 SPACE 1 @OZ51011 Q6535550 PPREMPQE ST PW,PQHPIDE SHOW NO IDS PENDING @OZ51011 Q6535575 LR R1,R5 POINT TO PQE FOR PURGE @OZ51011 Q6535600 CLR R1,PW ANY PQES TO PURGE... @OZ51011 Q6535625 BE PPABORT BRANCH IF NOT @OZ51011 Q6535650 SLR R0,R0 CALL PDELPQE @OZ51011 Q6535675 L R15,=A(PDELPQE) TO DELETE ALL @OZ51011 Q6535700 BALR PL,R15 INCOMPLETE PQE'S @OZ51011 Q6535725 B PPABORT BRANCH TO PROC TERMINATION @OZ51011 Q6535750 SPACE 1 @OZ51011 Q6535775 PPCMDRTN PRETURN , RESTORE REGS AND RETURN @OZ51011 Q6535800 DROP R1,PW SUSPEND ADDRESSABILITY @OZ51011 Q6535825 EJECT @OZ51011 Q6535850 ***************************************************************@G38ESBB Q6536000 * @G38ESBB Q6537000 * 3800 COMMAND PROCESSING CONSISTS OF PURGING THE PAGE @G38ESBB Q6538000 * BUFFER, DETERMINING THE PPQ RESTART PAGE, UPDATING @G38ESBB Q6539000 * THE PPQ, AND SYNCHRONIZING THE DEVICE FOR THE @G38ESBB Q6540000 * RESTART PAGE. @G38ESBB Q6541000 * @G38ESBB Q6542000 * R1 - ADDRESS OF PENDING PAGE QUEUE ENTRY @G38ESBB Q6543000 * PW - ADDRESS OF PENDING PAGE QUEUE HEADER @G38ESBB Q6544000 * @G38ESBB Q6545000 ***************************************************************@G38ESBB Q6546000 SPACE 1 @G38ESBB Q6547000 P3800CMD PSAVE , SAVE LINKAGE AND BASE @G38ESBB Q6548000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q6549000 USING P3800CMD,BASE2 ADDRESSABILITY @G38ESBB Q6550000 L JCT,PJCTBUF ADDRESS JCT IF READ @G38ESBB Q6550200 LTR JCT,JCT JCT READ... @G38ESBB Q6550400 BNZ *+8 YES, BRANCH @G38ESBB Q6550600 LA JCT,JCT SHOW NON-ZERO JCT FOR I/O @G38ESBB Q6550800 LH PL,PCCWLAST GET PCIE OFFSET @OZ46290 Q6551000 AL PL,POUTCCWN ADD CCW AREA BASE @OZ46290 Q6552000 LA PL,PCIESIZE(,PL) POINT TO BUFFER WORK AREA @OZ46290 Q6553000 MVI BFWPQECT-BFWDSECT(PL),0 ZERO COUNT @OZ46290 Q6554000 LH PL,PCCWLAST GET PCIE OFFSET @OZ46290 Q6555000 AL PL,POUTCCWA ADD CCW AREA BASE @OZ46290 Q6556000 LA PL,PCIESIZE(,PL) POINT TO BUFFER WORK AREA @OZ46290 Q6557000 MVI BFWPQECT-BFWDSECT(PL),0 ZERO COUNT @OZ46290 Q6558000 L PW,PQHADR GET PQH ADDRESS @OZ46290 Q6559000 TM PQHFLAG-PQHDSECT(PW),PQH2CMD TEST DOUBLE CMD @OZ46290 Q6559100 BO PDETCMD BRANCH IF YES @OZ46290 Q6560000 L PW,PCEDCT GET DCT ADDRESS @OZ46290 Q6561000 TM DCTPPSW2-DCTDSECT(PW),DCTCKJAM JAM/CKEY... @OZ46290 Q6561100 BO PCMDSET YES, BR, ALREADY PURGED @OZ46290 Q6561200 LM PC1,PC2,PCCWXORD LOAD EXEC ORDER CCW @OZ46290 Q6561300 LA R1,BFWPPB-BFWDSECT(,PL) LOAD ADDR PURGE PG BUF @OZ46290 Q6561400 ALR PC1,R1 PLACE ORDER CODE ADR IN CCW @G38ESBB Q6562000 BAL PL,PPPUT2 ADD CCW TO AREA @OZ51441 Q6563000 BAL PL,PPWRITE WRITE CCW AREA @G38ESBB Q6564000 BAL PL,PPCHECK COMPLETE I/O @G38ESBB Q6565000 SPACE 1 @G38ESBB Q6565100 PCMDSET TM PPFLAG2,PPRSW IF A READ IS @G38ESBB Q6565200 BZ PCMDDSV OUTSTANDING, CLEAR @G38ESBB Q6565220 BAL PL,PRDTCHK ALL INPUT I/O @G38ESBB Q6565240 EJECT @OZ46290 Q6565260 PCMDDSV L R15,PCHJOE ADDRESS CHARACTERISTICS JOE @G38ESBB Q6565280 MVC SPFORMS(2*4),JOEFORM-JOEDSECT(R15) FORMS,FCB @G38ESBB Q6565300 MVC SPFLASH,JOEFLASH-JOEDSECT(R15) MSG WON'T FLASH @G38ESBB Q6565400 MVC SPMODF,=C'****' RESET COPY MODIFICATION @G38ESBB Q6565500 MVI SPCOPYN,1 FORCE ONLY 1 COPY OF MSG @G38ESBB Q6565600 MVI SPCOPYS,1 INDICATE STARTING COPY NUM @G38ESBB Q6565700 MVI SPFLAG,SPSEP INIT FLAGS FOR MSG SETUP @G38ESBB Q6565800 TM JOECFLAG-JOEDSECT(R15),$JOEBRST B=Y REQUEST... @OZ47910 Q6565820 BZ *+8 BR IF NOT @OZ47910 Q6565840 OI SPFLAG,SPBURST SET B=Y (BURSTING REQD) @OZ47910 Q6565860 L R15,=A(PRPUDSV) CALL DEVICE @G38ESBB Q6565900 BALR PL,R15 SETUP VERIFICATION @G38ESBB Q6565950 SPACE 1 @G38ESBB Q6566000 ***************************************************************@G38ESBB Q6567000 * @G38ESBB Q6568000 * DETERMINE SPECIFIC COMMAND @G38ESBB Q6569000 * @G38ESBB Q6570000 ***************************************************************@G38ESBB Q6571000 SPACE 1 @G38ESBB Q6572000 PDETCMD L PW,PQHADR ADDRESS PQH @OZ47595 Q6573000 TM PQHFLAG-PQHDSECT(PW),PQHRSTRT PPQ RESTART... @OZ47595 Q6573250 BO PQRSTRT BRANCH IF YES @OZ47595 Q6573500 TM PDCTFLAG,DCTDELET+DCTRSTRT TERMINATION COMMAND @OZ47595 Q6573750 BNZ P3800CEI BR IF YES @G38ESBB Q6574000 L R0,PFSBSCT TEST FOR $B @G38ESBB Q6575000 LTR R0,R0 OR $F @G38ESBB Q6576000 BH PFSPACE GO PROCESS $F OR CANCEL KEY @G38ESBB Q6577000 B PBSPACE GO PROCESS $B OR PAPER JAM @G38ESBB Q6578000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 $C,$E,$I ROUTINE' @G38ESBB Q6579000 ***************************************************************@G38ESBB Q6580000 * @G38ESBB Q6581000 * 3800 $C,$E,$I ROUTINE @G38ESBB Q6582000 * @G38ESBB Q6583000 ***************************************************************@G38ESBB Q6584000 SPACE 1 @G38ESBB Q6585000 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q6586000 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q6587000 SPACE 1 @G38ESBB Q6588000 P3800CEI L PW,PQHADR ADDRESS PQH @G38ESBB Q6589000 MVI PQHFLAG2,PCMDCEI SET COMMAND FLAG @OZ47787 Q6589100 L R1,PQHOPQE SET @G38ESBB Q6590000 ST R1,PQHTPQE PQHTPQE @G38ESBB Q6591000 MVC PQHTPG,PQHLPG SET TARGET PAGE ID @OZ53047 Q6592000 NI PQECFLAG,FF-PQECBSP RESET STACKED INDICATOR @OZ46674 Q6592100 OI PQECFLAG,PQECLPG SET LAST PAGE OF DATA SET @G38ESBB Q6593000 L R1,PQECPQED ADDRESS PQED @G38ESBB Q6594000 OI PQEDFLAG,PQEDLAST SET LAST DATA SET OF JOE @G38ESBB Q6595000 SPACE 1 @G38ESBB Q6596000 TM PDCTFLAG,DCTDELET IS COMMAND $C... @G38ESBB Q6597000 BZ PCHKIN NO, GO CHECK FOR $I $E @G38ESBB Q6598000 OI PQEDFLAG,PQEDCAN SET DATA SET CANCELLED @G38ESBB Q6599000 LA PL,=C' DELETED ' SET UP MESSAGE TEXT @G38ESBB Q6600000 B PCEIMSG GO WRITE TERMINATION MSG @G38ESBB Q6601000 SPACE 1 @G38ESBB Q6602000 PCHKIN TM PDCTFLAG,DCTBKSP IS COMMAND $I... @G38ESBB Q6603000 BZ PECMD NO, GO PROCESS $E @G38ESBB Q6604000 OI PQEDFLAG,PQEDINT SET DATA SET INTERRUPTED @G38ESBB Q6605000 IC R15,PQHCMDCT INCREMENT @G38ESBB Q6606000 LA R15,1(,R15) COUNT OF DEFERRED @G38ESBB Q6607000 STC R15,PQHCMDCT COMMANDS @G38ESBB Q6608000 LA PL,=C' INTERRUPTED' SET UP MESSAGE TEXT @G38ESBB Q6609000 B PCEIMSG GO WRITE TERMINATION MSG @G38ESBB Q6610000 SPACE 1 @G38ESBB Q6611000 PECMD LA PL,=C' RESTARTED ' SET UP MESSAGE TEXT @G38ESBB Q6612000 L R15,PQEDWJOE GET TPQE WORK JOE @G38ESBB Q6613000 LR R0,R15 PLACE WORK JOE ADDR IN R0 @G38ESBB Q6614000 LH R1,JOECHAR-JOEDSECT(,R15) GET CHAR JOE OFFSET @G38ESBB Q6615000 N R1,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6616000 SLL R1,2 EXPAND TO BYTE OFFSET @G38ESBB Q6617000 AL R1,$JOTABLE ADD JOB OUTPUT TABLE ORIGIN @G38ESBB Q6618000 $#ADD WORK=(R0),CHAR=(R1) COPY JOE BACK INTO QUEUE @G38ESBB Q6619000 BZ PCEIMSG ADD SUCCESSFUL, WRITE MSG @G38ESBB Q6620000 L R1,PQHOPQE ADDRESS ORIGIN PQE @G38ESBB Q6621000 L R1,PQECPQED ADDRESS DATA SET PQE AT ORG @G38ESBB Q6622000 OI PQEDFLAG,PQEDRST DEFER $E COMMAND @G38ESBB Q6623000 IC R14,PQHCMDCT INCREMENT @G38ESBB Q6624000 LA R14,1(,R14) DEFERRED @G38ESBB Q6625000 STC R14,PQHCMDCT COMMAND COUNT @G38ESBB Q6626000 SPACE 1 @G38ESBB Q6627000 PCEIMSG TM PQHFLAG,PQH2CMD DOUBLE COMMAND... @G38ESBB Q6628000 BZ PRMSGCEI NO, GO WRITE MSG TO PRINTER @G38ESBB Q6629000 L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6630000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @G38ESBB Q6631000 $MID 170 @G38ESBB Q6632000 PMSG PMESSAGE,M170L2,(X'170F',DCTDEVN) @G38ESBBCQ6632500 MOVE MESSAGE TEXT @G38ESBB Q6633000 MVC PMESSAGE+M170L2(12),0(PL) MOVE MESSAGE TEXT @G38ESBB Q6634000 DROP R15 DROP DCT ADDRESSABILITY @G38ESBB Q6634500 $WTO PMESSAGE,M170L2+12,ROUTE=$LOG+$UR, SEND MSG @G38ESBBCQ6635000 CLASS=$NORMAL,PRI=$ST,JOB=NO TO OPERATOR @G38ESBB Q6636000 B PGETMAPV GO DETERMINE FCB MAP VALUE @G38ESBB Q6637000 SPACE 1 @G38ESBB Q6638000 PRMSGCEI DS 0H @OZ48259 Q6639000 LR R14,PL GET MESSAGE TEXT @OZ48259 Q6639200 LA R1,=C'$HASP170 ' SET UP MESSAGE ID @OZ48259 Q6639400 L R15,=A(PRMSG) ISSUE MESSAGE TO OPERATOR @G38ESBB Q6640000 BALR PL,R15 AND ADD IT TO OUTPUT @OZ48259 Q6641000 B PGETMAPV GO DETERMINE FCB MAP VALUE @G38ESBB Q6642000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 BACKSPACE ROUTINE' @G38ESBB Q6643000 ***************************************************************@G38ESBB Q6644000 * @G38ESBB Q6645000 * 3800 BACKSPACE ROUTINE @G38ESBB Q6646000 * @G38ESBB Q6647000 ***************************************************************@G38ESBB Q6648000 SPACE 1 @G38ESBB Q6649000 SPACE 1 @G38ESBB Q6650000 PBSPACE L R0,PFSBSCT GET BACKSPACE NUMBER @G38ESBB Q6651000 LPR R0,R0 MAKE BACKSPACE CT POSITIVE @G38ESBB Q6652000 ST R0,PFSBSCT SAVE POSITIVE BACKSPACE CT @G38ESBB Q6653000 SPACE 1 @G38ESBB Q6654000 PBSTART L PW,PQHADR ADDRESS PQH @G38ESBB Q6655000 MVI PQHFLAG2,PCMDBKSP SET COMMAND FLAG @OZ47787 Q6655100 L R1,PQHOPQE GET ORIGIN PQE @G38ESBB Q6656000 ST R1,PQHTPQE SET TARGET PQE TO ORIG PQE @G38ESBB Q6657000 LH R14,PQHLPG GET LOCATED XFER STN PGID @OZ46351 Q6658000 L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6659000 TM DCTPPSW2-DCTDSECT(R15),DCTBFCKP TEST $BPRTN,C @G38ESBB Q6660000 BZ PTESTBD BR IF NOT @G38ESBB Q6661000 NI DCTPPSW2-DCTDSECT(R15),FF-DCTBFCKP RESET C FLAG @G38ESBB Q6662000 LH R14,PQERPGID STARTING PG IS PQE PAGE @G38ESBB Q6663000 CLC PQEFCBLN,=H'1' PQEC AT TOP OF PAGE... @G38ESBB Q6664000 BE PTESTBD YES, BYPASS INCREMENT @G38ESBB Q6665000 LA R14,1(,R14) INCR FOR TOP OF NEXT PAGE @G38ESBB Q6666000 SPACE 1 @G38ESBB Q6667000 PTESTBD CLC PFSBSCT,PMAXPAGE $B DATA SET... @G38ESBB Q6668000 BNE PCOPYG BR IF NOT @G38ESBB Q6669000 TM PQECFLAG,PQECFPG FIRST PAGE OF DATASET... @G38ESBB Q6670000 BZ PGETPREV BR IF NOT @G38ESBB Q6671000 SPACE 1 @G38ESBB Q6672000 PSETPG MVC PQHTPG,PQERPGID SET TARGET PAGE ID @OZ53047 Q6673000 B PBSPEXIT BR TO RETURN @G38ESBB Q6674000 SPACE 1 @G38ESBB Q6675000 PCOPYG LA R0,1 DEFAULT COPY GROUP TO ONE @G38ESBB Q6676000 TM PQECFLAG,PQECLPG TEST FOR DATA SET BOUNDARY @G38ESBB Q6677000 BO PDECRCT BR IF YES @G38ESBB Q6678000 L R15,PQECPQED DETERMINE DATA SET @G38ESBB Q6679000 IC R0,PQEDCGCT-PQEDSECT(,R15) COPYGROUPING @G38ESBB Q6680000 ***************************************************************@G38ESBB Q6681000 * @G38ESBB Q6682000 * MODIFY BACKSPACE AMOUNT BY COPY GROUP FACTOR @G38ESBB Q6683000 * @G38ESBB Q6684000 ***************************************************************@G38ESBB Q6685000 SPACE 1 @G38ESBB Q6686000 PDECRCT LR PC2,R14 GET LARGER PAGE ID @G38ESBB Q6687000 SH PC2,PQERPGID GET PAGE DIFFERENCE @G38ESBB Q6688000 N PC2,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6689000 MR PC1,R0 MULTIPLY BY COPY GROUP @G38ESBB Q6690000 L PC1,PFSBSCT TO GET PHYSICAL PAGES @G38ESBB Q6691000 SR PC1,PC2 DECREMENT B'SPACE AMT @G38ESBB Q6692000 ST PC1,PFSBSCT BY # OF PHYSICAL PAGES @G38ESBB Q6693000 LTR PC1,PC1 BACKSPACING DONE @G38ESBB Q6694000 BP PPQETEST BR IF NO @G38ESBB Q6695000 LPR PC1,PC1 MAKE COUNT POSITIVE @G38ESBB Q6696000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q6697000 CLM PC1,1,PQEDCGCT-PQEDSECT(R15) IS TPQE IS ON SAME @G38ESBBCQ6698000 LOGICAL PAGE AS TARGET... @G38ESBB Q6699000 BNL PBSDONE NO,TPQE PRIOR,DONE,BRANCH @G38ESBB Q6700000 CLC PQEFCBLN,=H'1' YES, MUST BE AT TOP OF FCB @G38ESBB Q6701000 BE PBSDONE TO BE DONE BACKSPACING @G38ESBB Q6702000 EJECT @G38ESBB Q6703000 ***************************************************************@G38ESBB Q6704000 * @G38ESBB Q6705000 * TEST FOR END OF PPQ @G38ESBB Q6706000 * @G38ESBB Q6707000 ***************************************************************@G38ESBB Q6708000 SPACE 1 @G38ESBB Q6709000 PPQETEST TM PQECFLAG,PQECFPG+PQECBSP DS BOUND IN STACKER @G38ESBB Q6710000 BO PSETPG BR IF YES, TPG FOUND @G38ESBB Q6711000 LH R14,PQERPGID UPDATE LARGER PAGE ID @G38ESBB Q6712000 SPACE 1 @G38ESBB Q6713000 PGETPREV LR R0,R1 SAVE PQEC ADDRESS @G38ESBB Q6714000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @G38ESBB Q6715000 SPACE 1 @G38ESBB Q6716000 PGTPRVLP L R1,PQEPREV GET PREVIOUS PQE @G38ESBB Q6717000 CR R1,R15 END OF PPQ... @G38ESBB Q6718000 BNE PGTPQEC NO, GO CHECK FOR PQEC @G38ESBB Q6719000 LR R1,R0 RESTORE SAVED FPG PQEC @G38ESBB Q6720000 B PSETPG DONE, BRANCH @G38ESBB Q6721000 SPACE 1 @G38ESBB Q6722000 PGTPQEC CLI PQETYPE,PQEC IS THIS PQE A CHECKPT PQE @G38ESBB Q6723000 BNE PGTPRVLP BR IF NOT @G38ESBB Q6724000 TM PQECFLAG,PQECLPG END OF DATA SET... @G38ESBB Q6725000 BZ PTESTBD NO, BRANCH TO CONTINUE SCAN @G38ESBB Q6726000 L R15,PQECPQED ADDRESS DATA SET PQE @G38ESBB Q6727000 TM PQEDFLAG-PQEDSECT(R15),PQEDLAST JOE BOUNDARY... @G38ESBB Q6728000 BZ PTESTBD NO, BRANCH TO CONTINUE SCAN @G38ESBB Q6729000 OI PQHFLAG,PQHHDR INDICATE HEADER NEEDED @G38ESBB Q6730000 TM PQEDFLAG-PQEDSECT(R15),PQEDRPT+PQEDINT+PQEDRST+PQEDCAN CQ6731000 DEFERRED COMMAND... @G38ESBB Q6732000 BZ PTESTBD BRANCH IF NO @G38ESBB Q6733000 B PLOCPQEC RESUME AT NEXT PQE @G38ESBB Q6734000 SPACE 1 @G38ESBB Q6735000 PBSDONE TM PQECFLAG,PQECLPG DATA SET BOUNDARY @G38ESBB Q6736000 BZ PSETTPG BR IF NOT @G38ESBB Q6737000 L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6738000 TM DCTPPSW2-DCTDSECT(R15),DCTCKJAM PAPER JAM... @OZ46952 Q6739000 BZ PLOCPQEC BR IF NOT @G38ESBB Q6740000 L R15,PQECPQED GET DATA SET PQE @G38ESBB Q6741000 TM PQEDFLAG-PQEDSECT(R15),PQEDLAST JOE BOUNDARY @G38ESBB Q6742000 BZ PLOCPQEC BR IF NOT @G38ESBB Q6743000 OI PQHFLAG,PQHHDR TURN ON HEADER NEEDED INDIC @G38ESBB Q6744000 SPACE 1 @G38ESBB Q6745000 PLOCPQEC L R1,PQENEXT GET NEXT PQE AS RESTART @G38ESBB Q6746000 CLI PQETYPE,PQEC IS THIS A CHECKPT PQE @G38ESBB Q6747000 BNE PLOCPQEC BR IF NOT @G38ESBB Q6748000 B PSETPG GO SET TARGET PAGE @G38ESBB Q6749000 SPACE 1 @G38ESBB Q6750000 PSETTPG SLR PC1,PC1 CLEAR WORK REGISTER @G38ESBB Q6751000 L PC2,PFSBSCT GET BACKSPACE AMOUNT @G38ESBB Q6752000 LPR PC2,PC2 GET POSITIVE BKSP AMOUNT @G38ESBB Q6753000 DR PC1,R0 DIVIDE BY COPY GROUP @G38ESBB Q6754000 LH PC1,PQERPGID GET TARGET PAGE ID @G38ESBB Q6755000 AR PC1,PC2 ADD LOGICAL BACKSPACE AMT @G38ESBB Q6756000 STH PC1,PQHTPG SET TARGET PAGE ID @OZ53047 Q6757000 EJECT @G38ESBB Q6758000 ***************************************************************@G38ESBB Q6759000 * @G38ESBB Q6760000 * WRITE OUT BACKSPACE OR PAPER JAM MESSAGE @G38ESBB Q6761000 * @G38ESBB Q6762000 ***************************************************************@G38ESBB Q6763000 SPACE 1 @G38ESBB Q6764000 PBSPEXIT ST R1,PQHTPQE SET TARGET PQE ADDRESS @G38ESBB Q6765000 SPACE 1 @OZ51592 Q6765100 CLC PQHTPG,PQERPGID ANY MAPPING NEEDED... @OZ53047 Q6765200 BNE PBSPXIT BRANCH IF YES @OZ51592 Q6765300 OI PPFLAG3,PP3800S IND REPOSITIONING @OZ51592 Q6765400 SPACE 1 @OZ51592 Q6765500 PBSPXIT L R15,PCEDCT GET DCT ADDRESS @OZ47734 Q6766000 L R1,PQECPQED GET PQED ADDRESS @OZ56978 Q6766100 NI PQEDFLAG,FF-PQEDLAST RESET LAST DATASET IND @OZ56978 Q6766200 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @G38ESBB Q6766500 TM DCTPPSW2,DCTCKJAM PAPERJAM... @G38ESBB Q6767000 BZ PBWRITE BR IF NOT @G38ESBB Q6768000 $MID 153 PAPER JAM MESSAGE @G38ESBB Q6768500 PMSG PMESSAGE,,(C'$HASP153 ',DCTDEVN,C' JAMMED, FUSER RESTARTCQ6769000 ') MOVE MESSAGE TEXT @G38ESBB Q6770000 L R15,=A(PCOMMENT) ADD MESSAGE @G38ESBB Q6771000 BALR PL,R15 TO OUTPUT @G38ESBB Q6772000 L R15,PCEDCT ADDRESS PRPU DCT @G38ESBB Q6773000 PMSG PMESSAGE,M153L,(X'153F',DCTDEVN,C' JAMMED, FUSER RESTARTCQ6774000 ') MOVE MESSAGE TEXT @G38ESBB Q6775000 DROP R15 DROP DCT ADDRESSABILITY @G38ESBB Q6775500 $WTO PMESSAGE,M153L,ROUTE=$LOG+$UR, INFORM OPERATOR @G38ESBBCQ6776000 CLASS=$NORMAL,PRI=$ST,JOB=NO OF PAPER JAM @G38ESBB Q6777000 B PGETMAPV GO DETERMINE MAPPING VALUE @G38ESBB Q6778000 SPACE 1 @G38ESBB Q6779000 PBWRITE LA R14,=C' BACKSPACED ' SET FOR $B MESSAGE @OZ48259 Q6780000 $MID 170 MESSAGE IDENTIFIER @G38ESBB Q6781000 LA R1,=C'$HASP170 ' POINT TO MESSAGE ID @G38ESBB Q6782000 L R15,=A(PRMSG) ISSUE MSG TO OPERATOR @G38ESBB Q6782500 BALR PL,R15 ADD MSG TO OUTPUT @OZ48259 Q6783000 B PGETMAPV GO DETERMINE FCB MAPPING @G38ESBB Q6784000 TITLE 'HASPPRPU -- 3800 FORWARD SPACE ROUTINE' @G38ESBB Q6785000 ***************************************************************@G38ESBB Q6786000 * @G38ESBB Q6787000 * 3800 FORWARD SPACE @G38ESBB Q6788000 * @G38ESBB Q6789000 ***************************************************************@G38ESBB Q6790000 SPACE 1 @G38ESBB Q6791000 PFSPACE L PW,PQHADR SET PQH ADDRESS @G38ESBB Q6792000 MVI PQHFLAG2,PCMDFWSP SET COMMAND FLAG @OZ47787 Q6792100 L R1,PQHOPQE GET ORIGIN PQE @G38ESBB Q6793000 ST R1,PQHTPQE SET INITIAL TARGET PQE @G38ESBB Q6794000 L R15,PQECPQED GET DATA SET PQE @G38ESBB Q6795000 SLR R0,R0 CLEAR COPY GROUP REG @G38ESBB Q6796000 IC R0,PQEDCGCT-PQEDSECT(R15) LOAD COPY GROUP VALUE @G38ESBB Q6797000 SPACE 1 @G38ESBB Q6798000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @OZ51866 Q6798100 PFDETCT L R15,PCEDCT GET DCT ADDRESS @G38ESBB Q6799000 TM DCTPPSW2,DCTCKJAM CANCEL KEY... @OZ51866 Q6799050 BZ PFNCKEY BRANCH IF NOT @OZ51866 Q6799100 TM PQECFLAG,PQECLPG TEST FOR END OF DATASET @OZ51866 Q6799150 BZ PFNCKEY BRANCH IF NOT @OZ51866 Q6799200 $MID 152 @OZ51866 Q6799250 PMSG PMESSAGE,M152L3,(X'152F',DCTDEVN, SET MESSAGE @OZ51866CQ6799300 C' COMMAND REJECTED') TEXT @OZ51866 Q6799350 $WTO PMESSAGE,M152L3,JOB=NO, @OZ51866CQ6799400 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST @OZ51866 Q6799450 LA R14,PPDSEND2 ALTER @OZ56978 Q6799500 L R1,PQHTPQE RETURN @OZ56978 Q6799525 L R1,PQECPQED ADDRESS @OZ56978 Q6799550 TM PQEDFLAG,PQEDLAST TO BYPASS @OZ56978 Q6799575 BZ *+8 LAST @OZ56978 Q6799600 LA R14,PPABORT PAGE @OZ56978 Q6799610 L R15,PSAVAREA PQEC @OZ56978 Q6799620 ST R14,2*4(,R15) CREATION @OZ56978 Q6799630 XC PQHMAPV,PQHMAPV CLEAR MAPPING VALUE @OZ51866 Q6799650 LH R0,PQHOPG GET ORIGIN PAGE @OZ51866 Q6799700 SH R0,PQERPGID FIND RECOMPUTE VALUE @OZ51866 Q6799750 N R0,PCLRHALF CLEAR LEFT HALFWORD @OZ51866 Q6799800 L R15,=A(PRECOMP) CALL RECOMPUTE TO @OZ51866 Q6799850 BALR PL,R15 UPDATE PPQ RPGIDS @OZ51866 Q6799900 B PFREJCT BYPASS TARGET SET @OZ51866 Q6799950 EJECT @OZ51866 Q6799975 PFNCKEY LH R14,PQHLPG GET LOCATED XFER STN PGID @OZ51866 Q6800000 TM DCTPPSW2,DCTBFCKP $FPRTN,C... @OZ51866 Q6801000 BZ PGETTPG BR IF NOT @G38ESBB Q6802000 NI DCTPPSW2,FF-DCTBFCKP RESET CKPT FLAG @OZ51866 Q6803000 LH R14,PQERPGID TPQE HAS SMALLER ID @G38ESBB Q6804000 CLC PQEFCBLN,PFCBTOP PQEC AT TOP OF PAGE... @G38ESBB Q6805000 BE PGETTPG YES, BYPASS INCREMENT @G38ESBB Q6806000 LA R14,1(,R14) INCR TO TOP OF NEXT PAGE @G38ESBB Q6807000 DROP R15 SUSPEND DCT ADDRESSABILITY @OZ51866 Q6807100 SPACE 1 @G38ESBB Q6808000 PGETTPG CLC PFSBSCT,PMAXPAGE $F TO END OF DATA SET... @G38ESBB Q6809000 BE PNEXTPQE BR IF YES @G38ESBB Q6810000 L PC2,PFSBSCT GET FORWARD SPACE AMOUNT @G38ESBB Q6811000 SLR PC1,PC1 CLEAR DIVIDE REGISTER @G38ESBB Q6812000 DR PC1,R0 DIVIDE BY COPY GROUPING @G38ESBB Q6813000 AR R14,PC2 ADD TO ORIGIN PAGE TO @G38ESBB Q6814000 STH R14,PQHTPG GET TARGET PAGE ID @OZ53047 Q6815000 SPACE 1 @G38ESBB Q6816000 PNEXTPQE L R1,PQENEXT GET NEXT PQE @G38ESBB Q6817000 LA R14,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q6818000 CR R1,R14 END OF PQE... @G38ESBB Q6819000 BE PPQEND BR IF YES @G38ESBB Q6820000 CL R1,PQHPIDE IS PQE COMPLETE... @G38ESBB Q6821000 BE PPQEND NO, BRANCH @G38ESBB Q6822000 CLI PQETYPE,PQEC IS THIS A CHECKPT PQE @G38ESBB Q6823000 BNE PNEXTPQE BR IF NOT @G38ESBB Q6824000 CLC PFSBSCT,PMAXPAGE $F PRTN,D... @G38ESBB Q6825000 BE PUPDTPQE BR IF YES @G38ESBB Q6826000 LH R14,PQHTPG GET TARGET PAGE ID @OZ53047 Q6827000 SH R14,PQERPGID DETERMINE IF TARGET @G38ESBB Q6828000 LTR R14,R14 PAGE AT TPQE @G38ESBB Q6829000 BNZ PTSTFEND NO, BRANCH @G38ESBB Q6830000 CLC PQEFCBLN,PFCBTOP YES, TPQE GOOD IF AT TOP @G38ESBB Q6831000 BE PUPDTPQE OF PAGE, BRANCH @G38ESBB Q6832000 B PFSPDONE NO,DONE,PREVIOUS TPQE GOOD @G38ESBB Q6833000 SPACE 1 @G38ESBB Q6834000 PTSTFEND N R14,PCLRHALF ELSE, SEE IF PAGE ID HAS @G38ESBB Q6835000 C R14,PQELIMIT REACHED TARGET PAGE @G38ESBB Q6836000 BH PFSPDONE BR IF YES @G38ESBB Q6837000 EJECT @OZ51866 Q6838000 PUPDTPQE ST R1,PQHTPQE SAVE NEW TARGET PQE @G38ESBB Q6839000 TM PQECFLAG,PQECLPG TEST FOR END OF DATA SET @G38ESBB Q6840000 BZ PNEXTPQE CONTINUE SCAN IF NOT @G38ESBB Q6841000 MVC PQHMAPV,PFDSET INDIC END OF DATA SET @G38ESBB Q6842000 LH R0,PQHOPG GET ORIGIN PAGE @G38ESBB Q6843000 SH R0,PQERPGID FIND RECOMPUTE VALUE @G38ESBB Q6844000 AH R0,=H'1' ADD 1 FOR MESSAGE PAGE @G38ESBB Q6845000 N R0,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6846000 L R15,=A(PRECOMP) CALL RECOMPUTE ROUTINE @G38ESBB Q6847000 BALR PL,R15 TO UPDATE PPQ RPGIDS @G38ESBB Q6848000 LA PL,PFREJCT SET BR TO BYPASS TGT SET @OZ48259 Q6849000 B PFSPEXIT BR TO WRITE MSG @G38ESBB Q6850000 SPACE 1 @G38ESBB Q6851000 PPQEND CLC PFSBSCT,PMAXPAGE $F PRTN,D... @G38ESBB Q6852000 BNE PFSPDONE BR IF NOT @G38ESBB Q6853000 MVC PQHMAPV,PFSPDSET INDICATE $FPRTN,D @G38ESBB Q6854000 LA PL,PFREJCT SET BR TO BYPASS TGT SET @OZ48259 Q6855000 B PFSPEXIT BR IF YES @G38ESBB Q6856000 SPACE 1 @G38ESBB Q6857000 PFSPDONE LA PL,PGETMAPV SET BR TO SET TGT PAGE @OZ48259 Q6858000 L R1,PQHTPQE GET TARGET PQE ADDR @OZ51592 Q6858100 CLC PQHTPG,PQERPGID ANY MAPPING NEEDED @OZ53047 Q6858200 BNE PFSPEXIT BRANCH IF YES @OZ51592 Q6858300 OI PPFLAG3,PP3800S IND REPOSITIONING @OZ51592 Q6858400 SPACE 1 @G38ESBB Q6859000 PFSPEXIT LA R14,=C' FWD-SPACED ' SET FOR $F MESSAGE @OZ48259 Q6860000 $MID 170 MESSAGE IDENTIFIER @G38ESBB Q6861000 LA R1,=C'$HASP170 ' POINT TO MSG ID @G38ESBB Q6862000 L R15,=A(PRMSG) SEND MSG TO OPERATOR @G38ESBB Q6863000 BR R15 ADD MESSAGE TO OUTPUT @OZ48259 Q6864000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 RESCHEDULE ROUTINE' @OZ47595 Q6864500 ***************************************************************@OZ47595 Q6864510 * @OZ47595 Q6864520 * 3800 PENDING PAGE QUEUE RESTART ROUTINE @OZ47595 Q6864530 * @OZ47595 Q6864540 ***************************************************************@OZ47595 Q6864550 SPACE 1 @OZ47595 Q6864560 USING DCTDSECT,R15 @OZ51930 Q6864570 SPACE 1 @OZ51930 Q6864580 PQRSTRT DS 0H @OZ47595 Q6864600 $MID 170 @OZ51930 Q6864610 L PW,PQHADR GET PQH ADDRESS @OZ51930 Q6864620 L R15,PCEDCT GET DCT ADDRESS @OZ51930 Q6864630 TM PQHFLAG,PQH2CMD TEST FOR INHIBIT I/O @OZ51930 Q6864640 BZ PQRMSG BRANCH IF NOT @OZ51930 Q6864650 NI PQHFLAG,FF-PQH2CMD RESET INHIBIT I/O FLAG @OZ51930 Q6864660 PMSG PMESSAGE,M170L3,(X'170F',DCTDEVN,C' RESTARTED') @OZ51930CQ6864670 MOVE MESSAGE TEXT @OZ51930 Q6864675 $WTO PMESSAGE,M170L3, INFORM OPERATOR @OZ51930CQ6864680 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST,JOB=NO @OZ51930 Q6864685 B PQRSET CONTINUE @OZ51930 Q6864690 SPACE 1 @OZ51930 Q6864695 PQRMSG LA R14,=C' RESTARTED ' SET UP MESSAGE TEXT @OZ51930 Q6864700 LA R1,=C'$HASP170 ' SET UP MESSAGE ID @OZ47595 Q6864800 L R15,=A(PRMSG) ADDRESS MESSAGE ROUTINE @OZ47595 Q6864900 BALR PL,R15 ISSUE MESSAGE @OZ47595 Q6865000 L PW,PQHADR SET PQH ADDRESS @OZ47595 Q6865100 SPACE 1 @OZ51930 Q6865110 PQRSET NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP-DCTRPT @OZ51930 Q6865200 NI PPFLAG,FF-PPDELSW-PRDELSW RESET ALL FLAGS @OZ47595 Q6865300 L R15,PCEDCT RESTORE DCT ADDRESS @OZ51930 Q6865330 NI DCTPPSW2,FF-DCTCKJAM RESET CKEY/JAM FLAG @OZ51930 Q6865360 XC PQHMAPV,PQHMAPV CLEAR MAPPING VALUE @OZ47595 Q6865400 TM PQHAFLAG,PQHABORT TEST FOR PPQ ERROR @OZ49145 Q6865410 BZ PQRSTRT1 BRANCH IF NOT @OZ49145 Q6865420 ST PW,PQHOPQE SET ORIGIN TO PQE0 @OZ49145 Q6865430 OI DCTSTAT,DCTDRAIN SET DRAIN FLAG @OZ51930 Q6865440 SPACE 1 @OZ49145 Q6865450 PQRSTRT1 L R1,PQHOPQE GET PQE ADDRESS @OZ49145 Q6865500 SLR R0,R0 CLEAR WORK JOE ADDR @OZ47595 Q6865600 LA PL,PRSCHDLP RESCHEDULE JOE'S @OZ47595 Q6865700 BR PL IN 3800 PIPELINE @OZ47595 Q6865800 SPACE 1 @OZ51930 Q6865810 DROP R15 SUSPEND DCT ADDRESSABILITY @OZ51930 Q6865820 EJECT @OZ47595 Q6865900 ***************************************************************@G38ESBB Q6866000 * @G38ESBB Q6867000 * FIRST DETERMINE FCB MAPPING REQUIREMENTS, @G38ESBB Q6868000 * THEN RESCHEDULE JOES IN 3800 PIPELINE @G38ESBB Q6869000 * @G38ESBB Q6870000 ***************************************************************@G38ESBB Q6871000 SPACE 1 @G38ESBB Q6872000 PGETMAPV L PW,PQHADR ADDRESS PQH @G38ESBB Q6873000 LH R0,PQHOPG GET ORIGIN PAGE ID @G38ESBB Q6874000 LH R15,PQHTPG GET TARGET PAGE ID @OZ53047 Q6875000 SR R0,R15 DISTANCE FROM TARGET PAGE @G38ESBB Q6876000 TM PQHFLAG,PQH2CMD DOUBLE COMMAND... @G38ESBB Q6877000 BZ PSETMAPV NO, GO DETERMINE MAP VALUE @G38ESBB Q6878000 XC PQHMAPV,PQHMAPV NO MAPPING FOR DOUBLE CMD @G38ESBB Q6879000 B PCALRCMP BYPASS FCB MAPPING CODE @G38ESBB Q6880000 SPACE 1 @G38ESBB Q6881000 PSETMAPV AH R0,=H'1' ADD 1 FOR MSG PAGE @G38ESBB Q6882000 L R1,PQHTPQE GET MAPPING ORIGIN @G38ESBB Q6883000 SH R15,PQERPGID COMPUTE FCB @G38ESBB Q6884000 ST R15,PQHMAPV MAPPING VALUE @OZ53047 Q6885000 MVC PQHFCBLN,PQEFCBLN SET INITIAL FCB MAP INDEX @G38ESBB Q6886000 SLR R15,R15 INITIALIZE LINE COUNT TO 0 @G38ESBB Q6887000 TM PQECFLAG,PQECFPG RESTART AT BEGIN DATA SET.. @G38ESBB Q6888000 BO *+6 YES, BYPASS COUNT ADJUST @G38ESBB Q6889000 BCTR R15,0 ADJUST COUNT TO BEFORE 0 @G38ESBB Q6890000 ST R15,PPLC SET LINE COUNT @G38ESBB Q6891000 SPACE 1 @G38ESBB Q6892000 PCALRCMP L R15,=A(PRECOMP) CALL RECOMPUTE ROUTINE TO @G38ESBB Q6893000 BALR PL,R15 ADJUST PPQ FOR COMMAND @G38ESBB Q6894000 EJECT @G38ESBB Q6895000 ***************************************************************@G38ESBB Q6896000 * @G38ESBB Q6897000 * FREE THE JCT FOR THE JOB AT THE CHANNEL @G38ESBB Q6898000 * @G38ESBB Q6899000 ***************************************************************@G38ESBB Q6900000 SPACE 1 @G38ESBB Q6901000 PFREJCT L JCT,PJCTBUF ADDRESS JCT IF READ @G38ESBB Q6902000 LTR JCT,JCT JCT READ... @G38ESBB Q6903000 BZ PRESCHED NO, GO RESCHEDULE JOES @G38ESBB Q6904000 $#JCT FREE RELEASE JCT BUFFER @G38ESBB Q6905000 SPACE 1 @G38ESBB Q6906000 PRESCHED L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q6907000 L R1,PQHTPQE ADDRESS TARGET PQE @G38ESBB Q6908000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q6909000 L R0,PQEDWJOE-PQEDSECT(,R15) ADDRESS WORK JOE @G38ESBB Q6910000 LA PL,PRSCHDLP SET RETURN ADDRESS @OZ48323 Q6910100 SPACE 1 @G38ESBB Q6911000 ***************************************************************@G38ESBB Q6912000 * @G38ESBB Q6913000 * RESCHEDULE JOE'S IN 3800 PIPELINE @G38ESBB Q6914000 * @G38ESBB Q6915000 ***************************************************************@G38ESBB Q6916000 SPACE 1 @G38ESBB Q6917000 PRSCHDLP L R1,PQENEXT GET NEXT PQE @G38ESBB Q6918000 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q6919000 CR R1,R15 END OF PPQ... @G38ESBB Q6920000 BE PRSCHLST BRANCH IF YES @OZ48323 Q6921000 CLI PQETYPE,PQES IS PQE FOR SMF TYPE 6... @G38ESBB Q6922000 BNE PQECHECK NO, GO CHECK FOR PQEC @G38ESBB Q6923000 CLC PPSMFBUF,$ZEROS HAS SMF UPDATE OCCURRED... @G38ESBB Q6924000 BNE PFREPQES YES, BYPASS UPDATE @G38ESBB Q6925000 L R15,PQESBUF ADDRESS SMF BUFFER @G38ESBB Q6926000 USING SMFDSECT,R15 PROVIDE SMF ADDRESSABILITY @G38ESBB Q6927000 ST R15,PPSMFBUF INDICATE UPDATE OCCURRED @G38ESBB Q6928000 MVC PTIMEON,SMF6WST UPDATE WRITER START TIME @G38ESBB Q6929000 * DELETED @G38ESBB Q6930000 TM SMF6IOE,PPJCTIOT RESTORE @G38ESBB Q6930050 BZ *+8 PPJCTIOT @G38ESBB Q6930100 OI PPFLAG,PPJCTIOT FLAG @G38ESBB Q6930150 * DELETED @G38ESBB Q6930200 MVC PSMFDCI,SMF6DCI UPDATE DS CNTL INDICATOR @G38ESBB Q6935000 DROP R15 DROP SMF ADDRESSABILITY @G38ESBB Q6936000 SPACE 1 @G38ESBB Q6937000 PFREPQES STM R0,R1,PQHSAVE1 SAVE REGS ACROSS SUB CALL @G38ESBB Q6938000 L R1,PQESBUF ADDRESS SMF BUF FOR SUB @G38ESBB Q6939000 BAL LINK,PFRESMFB FREE SMF TYPE 6 BUFFER @G38ESBB Q6940000 LM R0,R1,PQHSAVE1 RESTORE REGS @G38ESBB Q6941000 BR PL LOOP BACK FOR NEXT PQE @OZ48323 Q6942000 EJECT @G38ESBB Q6943000 ***************************************************************@G38ESBB Q6944000 * @G38ESBB Q6945000 * PROCESS PQEC'S @G38ESBB Q6946000 * @G38ESBB Q6947000 ***************************************************************@G38ESBB Q6948000 SPACE 1 @G38ESBB Q6949000 PQECHECK CLI PQETYPE,PQEC IS PQE A PQEC... @G38ESBB Q6950000 BNER PL NO, LOOP BACK FOR NEXT PQE @OZ48323 Q6951000 TM PQECFLAG,PQECFPG FIRST PAGE OF DATA SET... @G38ESBB Q6952000 BZR PL NO, LOOP BACK FOR NEXT PQE @OZ48323 Q6953000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q6954000 TM PQEDFLAG-PQEDSECT(R15),PQEDINT $I DATA SET... @G38ESBB Q6955000 BZ PJOECHK NO, GO CHECK FOR NEW JOE @G38ESBB Q6956000 IC R14,PQHCMDCT DECREMENT @G38ESBB Q6957000 BCTR R14,0 COUNT OF @G38ESBB Q6958000 STC R14,PQHCMDCT DEFERRED COMMANDS @G38ESBB Q6959000 SPACE 1 @G38ESBB Q6960000 PJOECHK CL R0,PQEDWJOE-PQEDSECT(,R15) NEW JOE... @G38ESBB Q6961000 BER PL NO, LOOP BACK FOR NEXT PQE @OZ48323 Q6962000 L R0,PQEDWJOE-PQEDSECT(,R15) UPDATE WORK JOE ADR @G38ESBB Q6963000 PJOECHK1 LR R15,R0 ADDRESS WORK JOE @OZ48323 Q6964000 LH R15,JOEJQE-JOEDSECT(,R15) GET JQE OFFSET @G38ESBB Q6965000 N R15,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6966000 SLL R15,2 EXPAND TO BYTE OFFSET @G38ESBB Q6967000 AL R15,$JOBQPTR ADD JOB QUEUE ORIGIN @G38ESBB Q6968000 TM JQEFLAGS-JQEDSECT(R15),QUEOPCAN+QUEPURGE $CJ... @G38ESBB Q6969000 BNO PMSGCHK NO, GO CHECK FOR REQ MSG @G38ESBB Q6970000 STM R0,R1,PQHSAVE1 SAVE REGS ACROSS CALL @G38ESBB Q6971000 LR R1,R0 ADDRESS WORK JOE @G38ESBB Q6972000 $#REM WORK=(R1) REMOVE WORK JOE FROM JOT @G38ESBB Q6973000 LM R0,R1,PQHSAVE1 RESTORE REGS @G38ESBB Q6974000 BR PL LOOP BACK FOR NEXT PQE @OZ48323 Q6975000 SPACE 1 @G38ESBB Q6976000 ***************************************************************@G38ESBB Q6977000 * @G38ESBB Q6978000 * SEND REQUEUED MESSAGE IF JOB ON DEVICE MESSAGE SENT @G38ESBB Q6979000 * @G38ESBB Q6980000 ***************************************************************@G38ESBB Q6981000 SPACE 1 @G38ESBB Q6982000 PMSGCHK CR R1,PW CHECK FOR END OF PPQ @OZ48323 Q6983000 BE PRSCHJOE BRANCH IF YES @OZ48323 Q6983100 L R10,PQECPQED ADDRESS PQED @OZ48323 Q6983200 L R10,PQEDWJOE-PQEDSECT(,R10) ADDRESS WORK JOE @G38ESBB Q6984000 L R15,PQHPQEJ GET JOB MSG QUEUE HEAD @G38ESBB Q6985000 SPACE 1 @G38ESBB Q6986000 PREQCHK LTR R15,R15 END OF JOD QUEUE... @G38ESBB Q6987000 BZ PREQMSG BR IF YES @G38ESBB Q6988000 CL R10,PQEJWJOE-PQEDSECT(,R15) JOB MSG QUEUED... @G38ESBB Q6989000 BE PRSCHJOE BR IF YES, NO REQUEUED MSG @G38ESBB Q6990000 L R15,PQEJNEXT-PQEDSECT(,R15) GET NEXT JOD PQE @G38ESBB Q6991000 B PREQCHK BR TO TEST IF QUEUED @G38ESBB Q6992000 SPACE 1 @G38ESBB Q6993000 PREQMSG LH R10,JOEJQE-JOEDSECT(,R10) GET JQE OFFSET @G38ESBB Q6994000 N R10,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q6995000 SLL R10,2 COMPUTE BYTE OFFSET @G38ESBB Q6996000 AL R10,$JOBQPTR ADD JOB QUEUE ORIGIN @G38ESBB Q6997000 L R15,PCEDCT ADDRESS DCT @G38ESBB Q6998000 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @G38ESBB Q6998500 $MID 156 MESSAGE IDENTIFIER @G38ESBB Q6999000 PMSG PMESSAGE,M156L,(X'156F',DCTDEVN,C' JOB REQUEUED') CQ7000000 MOVE MESSAGE TEXT @G38ESBB Q7001000 DROP R15 DROP DCT ADDRESSABILITY @G38ESBB Q7001500 STM R0,R1,PQHSAVE1 SAVE REGS ACROSS MACRO CALL @G38ESBB Q7002000 $WTO PMESSAGE,M156L, INFORM THE OPERATOR @G38ESBBCQ7003000 ROUTE=$LOG+$UR,CLASS=$NORMAL,PRI=$ST,JOB=YES @G38ESBB Q7004000 LM R0,R1,PQHSAVE1 RESTORE REGS @G38ESBB Q7005000 SPACE 1 @G38ESBB Q7006000 PRSCHJOE STM R0,R1,PQHSAVE1 SAVE REGS @G38ESBB Q7007000 LR R1,R0 ADDRESS WORK JOE @G38ESBB Q7008000 TM JOEFLAG-JOEDSECT(R1),$JOECKV CKPT JOE VALID... @G38ESBB Q7009000 BZ PUTNOCK NO,GO $#PUT WITHOUT CKPT @G38ESBB Q7010000 LH R0,JOECKPT-JOEDSECT(,R1) GET CKPT JOE OFFSET @G38ESBB Q7011000 N R0,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q7012000 SLL R0,2 EXPAND TO BYTE OFFSET @G38ESBB Q7013000 AL R0,$JOTABLE ADD JOT ORIGIN @G38ESBB Q7014000 $#PUT WORK=(R1),PRC=(R0) RETURN TO JOT WITH CKPT @G38ESBB Q7015000 LM R0,R1,PQHSAVE1 RESTORE REGS @G38ESBB Q7016000 BR PL LOOP BACK FOR NEXT PQE @OZ48323 Q7017000 SPACE 1 @G38ESBB Q7018000 PUTNOCK $#PUT WORK=(R1) RETURN TO JOT - NO CKPT @G38ESBB Q7019000 LM R0,R1,PQHSAVE1 RESTORE REGS @G38ESBB Q7020000 BR PL LOOP BACK FOR NEXT PQE @OZ48323 Q7021000 SPACE 1 @G38ESBB Q7022000 PRSCHLST LA PL,PRSCHEND SET RETURN ADDRESS @OZ48323 Q7022100 CLC PCEJQE,$ZEROS TEST CURRENT JOB @OZ48323 Q7022200 BER PL BRANCH IF NONE @OZ48323 Q7022300 CL R0,PWKJOE TEST CURRENT JOE @OZ48323 Q7022400 BER PL BRANCH IF PROCESSED @OZ48323 Q7022500 L R0,PWKJOE GET CURRENT JOE ADDRESS @OZ48323 Q7022600 B PJOECHK1 PROCESS CURRENT JOE @OZ48323 Q7022700 EJECT @OZ47595 Q7022800 PRSCHEND MVC PPSMFBUF,$ZEROS CLEAR SMF UPDATE INDICATOR @G38ESBB Q7023000 TM PQHFLAG,PQHRSTRT PPQ RESTART... @OZ47595 Q7023100 BZ PRSCHDAL BRANCH IF NOT @OZ47595 Q7023200 NI PQHFLAG,FF-PQHRSTRT RESET RESTART FLAG @OZ47595 Q7023300 NI PQHAFLAG,FF-PQHABORT RESET ABORT FLAG @OZ49145 Q7023350 LA R14,PJCTFREE ALTER RETURN @OZ47595 Q7023400 L R15,PSAVAREA ADDRESS TO ENTER @OZ47595 Q7023500 ST R14,2*4(,R15) PROCESSOR TERMINATION @OZ47595 Q7023600 L R1,PQHOPQE GET ORIGIN PQE ADDR @OZ47595 Q7023700 B PPQTRUNC BR TO TRUNCATE PPQ @OZ47595 Q7023800 SPACE 1 @OZ47595 Q7023900 PRSCHDAL L R15,=A(PDEALLOC) DEALLOCATE JES @OZ47595 Q7024000 BALR PL,R15 JOE'S RESOURCES @G38ESBB Q7025000 SPACE 1 @G38ESBB Q7026000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 JOB SETUP ROUTINE' @G38ESBB Q7027000 ***************************************************************@G38ESBB Q7028000 * @G38ESBB Q7029000 * SET UP TO RESUME WITH COMMAND TARGET JOB @G38ESBB Q7030000 * @G38ESBB Q7031000 ***************************************************************@G38ESBB Q7032000 SPACE 1 @G38ESBB Q7033000 USING JOEDSECT,R14 PROVIDE JOE ADDRESSABILITY @G38ESBB Q7034000 USING JCTDSECT,JCT PROVIDE JCT ADDRESSABILITY @G38ESBB Q7035000 SPACE 1 @G38ESBB Q7036000 PJOSETUP L R1,PQHTPQE ADDRESS TARGET PQE @G38ESBB Q7037000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q7038000 L R14,PQEDWJOE-PQEDSECT(,R15) ADDRESS WORK JOE @G38ESBB Q7039000 ST R14,PWKJOE SET UP WORK JOE ADDRESS @G38ESBB Q7040000 SPACE 1 @G38ESBB Q7041000 LH R0,JOECHAR GET CHAR JOE OFFSET @G38ESBB Q7042000 N R0,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q7043000 SLL R0,2 EXPAND TO BYTE OFFSET @G38ESBB Q7044000 AL R0,$JOTABLE ADD JOT ORIGIN @G38ESBB Q7045000 ST R0,PCHJOE SET UP CHAR JOE ADDRESS @G38ESBB Q7046000 SPACE 1 @G38ESBB Q7047000 LH R0,JOECKPT GET CKPT JOE OFFSET @G38ESBB Q7048000 N R0,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q7049000 SLL R0,2 EXPAND TO BYTE OFFSET @G38ESBB Q7050000 AL R0,$JOTABLE ADD JOT ORIGIN @G38ESBB Q7051000 ST R0,PCKJOE SET UP CKPT JOE ADDRESS @G38ESBB Q7052000 SPACE 1 @G38ESBB Q7053000 LH JCT,JOEJQE GET JQE OFFSET @G38ESBB Q7054000 N JCT,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q7055000 SLL JCT,2 EXPAND TO BYTE OFFSET @G38ESBB Q7056000 AL JCT,$JOBQPTR ADD JOB QUEUE ORIGIN @G38ESBB Q7057000 ST JCT,PCEJQE SET UP JQE ADDRESS @G38ESBB Q7058000 SPACE 1 @G38ESBB Q7059000 ST R14,PQHSAVE1 SAVE WORK JOE ADDRESS @G38ESBB Q7060000 ST R1,PQHSAVE2 SAVE TARGET PQE ADDRESS @G38ESBB Q7061000 $#JCT READ READ JCT (REG JCT=JQE ADR) @G38ESBB Q7062000 L R14,PQHSAVE1 RESTORE WORK JOE ADDRESS @G38ESBB Q7063000 L R1,PQHSAVE2 RESTORE TARGET PQE ADDRESS @G38ESBB Q7064000 ST JCT,PJCTBUF SET UP JCT BUFFER ADDRESS @G38ESBB Q7065000 L R15,PCEDCT ADDRESS DCT @G38ESBB Q7066000 TM DCTPPFL-DCTDSECT(R15),DCTTCEL TRK-CELLING... @G38ESBB Q7067000 BZ PSETWJOF NO, BYPASS TRK-CELL SETTING @G38ESBB Q7068000 CLI $TCELSIZ,1 IF TRK-CELL SIZE IS NOT GT @G38ESBB Q7069000 BNH PSETWJOF 1, FORCE DESPOOL=SINGLE @G38ESBB Q7070000 TM JOEFLAG2,$JOETCEL DATA SET TRACK-CELLED... @G38ESBB Q7071000 BZ PSETWJOF NO,BYPASS FLAG @G38ESBB Q7072000 OI PPFLAG2,PPTCEL INDICATE TRACK-CELL DESPOOL @G38ESBB Q7073000 SPACE 1 @G38ESBB Q7074000 PSETWJOF MVC PCKJOE(L'JOEFLAG),JOEFLAG SET UP WORK JOE FLAG @G38ESBB Q7075000 L R15,=A(PALLOC) CALL PALLOC TO ALLOCATE @G38ESBB Q7076000 BALR PL,R15 JOB'S RESOURCES @G38ESBB Q7077000 L PBUF,PBUFADDR ADDRESS BUFFER @G38ESBB Q7078000 DROP R14 DROP JOE ADDRESSABILITY @G38ESBB Q7079000 EJECT @G38ESBB Q7080000 ***************************************************************@G38ESBB Q7081000 * @G38ESBB Q7082000 * SET UP PCE CHECKPOINT DATA AREA FROM TARGET PQE @G38ESBB Q7083000 * @G38ESBB Q7084000 ***************************************************************@G38ESBB Q7085000 SPACE 1 @G38ESBB Q7086000 L R15,PQECPQED ADDRESS PQED @G38ESBB Q7087000 MVC PCEEJRCB,PQECJRCB MOVE DISP INTO EJECT BUFFER @G38ESBB Q7088000 MVC PDDBDISP,PQEDPDDB-PQEDSECT(R15) DISP OF PDDB @G38ESBB Q7089000 MVC PDDBPGCT,PQECPPCT MOVE PDDB LOGICAL PAGE CNT @G38ESBB Q7090000 MVC PPLNCDCT,PQECTLNC MOVE TOTAL JOE LINE COUNT @G38ESBB Q7091000 MVC PRPAGECT,PQECTPCT MOVE TOTAL JOE PAGE COUNT @G38ESBB Q7092000 MVC PCEJMTTR,PQECMTTR MOVE MTTR OF SPOOL DATA @G38ESBB Q7093000 MVC PCEIOTTR,PQEDIOTR-PQEDSECT(R15) IOT TRACK ADR @G38ESBB Q7094000 MVC PPRCPYCT,PQEDCOPY-PQEDSECT(R15) COPY NO IN PROG @G38ESBB Q7095000 MVC PDDBCPYG,PQEDCPYG-PQEDSECT(R15) COPY GRP OFFSET @G38ESBB Q7096000 MVC PCOPYGRP,PQEDCGRP-PQEDSECT(R15) COPY GROUPS @OZ49282 Q7096100 MVC PPDSCPY,PQEDSCPY-PQEDSECT(R15) COPY COUNT @OZ49282 Q7096200 MVC PPDSKEY,PQEDSKEY-PQEDSECT(R15) DATASET KEY @OZ49282 Q7096300 MVC PPJNDS,PQEDTNDS-PQEDSECT(R15) JOE DATA SET CNT @G38ESBB Q7097000 MVC PPJOBKEY,JCTJBKEY SET JOB KEY @G38ESBB Q7098000 SLR R0,R0 SET LOGICAL @G38ESBB Q7099000 IC R0,JCTLINCT PAGE SIZE @G38ESBB Q7100000 BCTR R0,0 FROM JOB'S @G38ESBB Q7101000 ST R0,PRLINECT PAGE SIZE @G38ESBB Q7102000 L R14,PQHOPQE ADDRESS ORIGIN PQEC @G38ESBB Q7103000 L R14,PQECPQED-PQEDSECT(,R14) ADDRESS ORIGIN PQED @G38ESBB Q7104000 OI PCKJOE,$JOECKV SET WARM START INDICATION @G38ESBB Q7105000 L PL,PCEDCT ADDRESS PRPU DCT @G38ESBB Q7106000 TM DCTPPSW2-DCTDSECT(PL),DCTCKJAM PAPER JAM... @G38ESBB Q7107000 BZ PTSTHDR NO,GO TEST IF HEADER NEEDED @G38ESBB Q7108000 NI DCTPPSW2-DCTDSECT(PL),FF-DCTCKJAM RESET FLAG @G38ESBB Q7109000 L R15,PQEDWJOE-PQEDSECT(,R15) ADDRESS WORK JOE @G38ESBB Q7110000 TM JOEFLAG-JOEDSECT(R15),$JOECKV WARM START JOE... @G38ESBB Q7111000 BO *+8 YES, ALREADY SET FOR CONT @G38ESBB Q7112000 NI PCKJOE,FF-$JOECKV NO, SET FOR START HEADER @G38ESBB Q7113000 SPACE 1 @G38ESBB Q7114000 PTSTHDR TM PQHFLAG,PQHHDR HEADER NEEDED... @G38ESBB Q7115000 BZ PSETEND NO, BYPASS HEADER @G38ESBB Q7116000 NI PPFLAG,FF-PRDELSW RESET DEL FOR PHEADER @OZ45081 Q7116500 NI PQHFLAG,FF-PQHHDR RESET HEADER NEEDED FLAG @G38ESBB Q7117000 NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ53889 Q7117100 L R15,=A(PHEADER) CALL PHEADER TO @G38ESBB Q7118000 BALR PL,R15 PRINT JOB HEADER @G38ESBB Q7119000 BM PPDSEND BR TO PROCESS PJAM/CKEY @OZ53889 Q7120000 BP PTSTCEI BR TO PROCESS COMMAND @OZ53889 Q7121000 OI PPFLAG2,PPFDS NO OFFSET STACK AFTER HDR @G38ESBB Q7122000 EJECT @OZ49282 Q7123000 PSETEND OI PCKJOE,$JOECKV SET WARM START INDICATOR @G38ESBB Q7124000 TM PDCTFLAG,DCTDELET WAS COMMAND $C... @G38ESBB Q7125000 BZ *+12 NO, GO CHECK $I $E @G38ESBB Q7126000 OI PSMFDCI,SMFOPSTP SET SMF FLAG @G38ESBB Q7127000 B PRESETAL GO RESET FLAGS @G38ESBB Q7128000 TM PDCTFLAG,DCTRSTRT+DCTBKSP WAS COMMAND $I... @G38ESBB Q7129000 BNO *+12 NO, GO CHECK $E @G38ESBB Q7130000 OI PSMFDCI,SMFINTRP SET SMF FLAG @G38ESBB Q7131000 B PRESETAL GO RESET FLAGS @G38ESBB Q7132000 TM PDCTFLAG,DCTRSTRT WAS COMMAND $E... @G38ESBB Q7133000 BZ PRESETAL NO, GO RESET FLAGS @G38ESBB Q7134000 OI PSMFDCI,SMFRESTR SET SMF FLAG @G38ESBB Q7135000 B PRESETAL GO RESET FLAGS @OZ53889 Q7135050 SPACE 1 @OZ53889 Q7135100 PTSTCEI XC PQHMAPV,PQHMAPV CLEAR MAPPING VALUE @OZ53889 Q7135150 L R1,PQHTPQE GET TARGET PQE ADDR @OZ53889 Q7135200 OI PQECFLAG,PQECLPG SET LAST PAGE OF DATASET @OZ53889 Q7135250 NI PQECFLAG,FF-PQECBSP RESET STACKED INDICATOR @OZ53889 Q7135300 LA R14,PJCTFREE SET RETURN @OZ53889 Q7135350 L R15,PSAVAREA ADDRESS TO ENTER @OZ53889 Q7135400 ST R14,2*8(,R15) PROCESSOR TERMINATION @OZ53889 Q7135450 L R1,PQECPQED GET PQED ADDRESS @OZ53889 Q7135500 OI PQEDFLAG,PQEDLAST SET LAST DATASET OF JOE @OZ53889 Q7135550 TM PDCTFLAG,DCTDELET TEST FOR $CPRT @OZ53889 Q7135600 BZ PTSTCEI3 BRANCH IF NOT @OZ53889 Q7135650 OI PQEDFLAG,PQEDCAN SET CANCEL FLAG @OZ53889 Q7135700 B PRESETAL BRANCH TO RESET FLAGS @OZ53889 Q7135750 SPACE 1 @OZ53889 Q7135800 PTSTCEI3 TM PDCTFLAG,DCTBKSP TEST FOR $IPRT @OZ53889 Q7135850 BZ PTSTCEI6 BRANCH IF NOT @OZ53889 Q7135900 OI PQEDFLAG,PQEDINT SET INTERRUPT FLAG @OZ53889 Q7135950 B PTSTINC BRANCH TO RESET FLAGS @OZ53889 Q7136000 SPACE 1 @OZ53889 Q7136050 PTSTCEI6 L R15,PQEDWJOE GET WORK JOE ADDRESS @OZ53889 Q7136100 LR R0,R15 SAVE JOE ADDRESS @OZ53889 Q7136150 LH R1,JOECHAR-JOEDSECT(,R15) GET CHAR JOE OFFSET @OZ53889 Q7136200 N R1,PCLRHALF CLEAR LEFT HALFWORD @OZ53889 Q7136250 SLL R1,2 EXPAND TO BYTE OFFSET @OZ53889 Q7136300 AL R1,$JOTABLE ADD JOT ORIGIN @OZ53889 Q7136350 $#ADD WORK=(R0),CHAR=(R1) COPY JOE BACK INTO QUEUE @OZ53889 Q7136400 BZ PRESETAL BRANCH IF SUCCESSFUL @OZ53889 Q7136450 L R1,PQHTPQE GET PQEC ADDRESS @OZ53889 Q7136500 L R1,PQECPQED GET PQED ADDRESS @OZ53889 Q7136550 OI PQEDFLAG,PQEDRST SET RESTART FLAG @OZ53889 Q7136600 SPACE 1 @OZ53889 Q7136650 PTSTINC IC R14,PQHCMDCT INCREMENT @OZ53889 Q7136700 LA R14,1(,R14) DEFFERED @OZ53889 Q7136750 STC R14,PQHCMDCT CMD COUNT @OZ53889 Q7136800 SPACE 1 @OZ53889 Q7136850 PRESETAL NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET ALL @G38ESBB Q7137000 NI PPFLAG,FF-PPDELSW RESET SUSPENSION SWITCH @G38ESBB Q7138000 MVC PDDBSKIP,PMAXSKIP SET SKIP FOR MAPPING @G38ESBB Q7139000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 PPQ TRUNCATION' @G38ESBB Q7140000 ***************************************************************@G38ESBB Q7141000 * @G38ESBB Q7142000 * TRUNCATE THE PENDING PAGE QUEUE TO REFLECT THE PAGE @G38ESBB Q7143000 * BUFFER PURGE AND RESOLUTION @G38ESBB Q7144000 * @G38ESBB Q7145000 ***************************************************************@G38ESBB Q7146000 SPACE 1 @G38ESBB Q7147000 L R1,PQHOPQE GET ORIGIN PQE ADDRESS @OZ47787 Q7148000 TM PQHFLAG2,PCMDBKSP TEST FOR BACKSPACE CMD @OZ47787 Q7149000 BZ PPQTRUNC BRANCH IF NOT @OZ47787 Q7150000 L R1,PQHTPQE GET TARGET PQE ADDRESS @OZ47787 Q7151000 * THIS LINE DELETED BY APAR NUMBER @OZ51592 Q7152000 * THIS LINE DELETED BY APAR NUMBER @OZ51592 Q7153000 * THIS LINE DELETED BY APAR NUMBER @OZ51592 Q7154000 * THIS LINE DELETED BY APAR NUMBER @OZ51592 Q7155000 SPACE 1 @OZ47734 Q7155100 PPQTRUNC L R1,PQENEXT ADDRESS FIRST PQE TO TRUNC @OZ47787 Q7156000 SPACE 1 @OZ47734 Q7156100 PPQCHECK LA R0,PQHFIRST-(PQENEXT-PQEDSECT) ARE THERE ANY @OZ47734 Q7157000 CR R1,R0 PQE'S TO TRUNC. @G38ESBB Q7158000 BE PSETPIDE NO, BYPASS TRUNCATION @G38ESBB Q7159000 SLR R0,R0 DELETE TO END OF PPQ @G38ESBB Q7160000 L R15,=A(PDELPQE) CALL PDELPQE TO @OZ48003 Q7160500 BALR PL,R15 TRUNCATE THE PPQ @OZ48003 Q7161000 LA R0,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @G38ESBB Q7162000 SPACE 1 @G38ESBB Q7163000 PSETPIDE ST R0,PQHPIDE SET PENDING ID PTR TO PQE0 @G38ESBB Q7164000 NI PQHFLAG,FF-PQHIPPQM RESET INHIBIT FLAG @OZ46674 Q7164100 MVI PQHFLAG2,0 RESET COMMAND FLAGS @OZ47734 Q7164200 MVC PQHPQEJ,$ZEROS CLEAR PQEJ QUEUE HEAD @G38ESBB Q7165000 CLC PQHMAPV,$ZEROS IS MAPPING NEEDED... @G38ESBB Q7166000 BNE PCMDEXIT YES, GO RETURN @G38ESBB Q7167000 MVC PDDBSKIP,$ZEROS INDICATE NO MAPPING NEEDED @G38ESBB Q7168000 NI PPFLAG3,FF-PP3800R INDICATE REPOSITIONING DONE @G38ESBB Q7169000 SPACE 1 @G38ESBB Q7170000 PCMDEXIT PRETURN RESTORE REGS AND RETURN @G38ESBB Q7171000 SPACE 1 @G38ESBB Q7172000 DROP R1,PW,JCT DROP PQE,PQH,JCT ADR @G38ESBB Q7173000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 COMMAND PROCESSING' @G38ESBB Q7174000 LTORG @G38ESBB Q7175000 TITLE 'HASP PRINT/PUNCH SERVICE -- DEVICE ABORT ROUTINE' @OZ51930 Q7175010 ***************************************************************@OZ51930 Q7175020 * @OZ51930 Q7175030 * FOR 3800 PRINTERS SETUP FOR PPQ RESTART ROUTINE @OZ51930 Q7175040 * @OZ51930 Q7175050 ***************************************************************@OZ51930 Q7175060 SPACE 1 @OZ51930 Q7175070 USING PDEVABRT,BASE2 LOCAL ADDRESSABILITY @OZ51930 Q7175080 USING DCTDSECT,R15 PROVIDE DCT ADDRESSABILITY @OZ51930 Q7175090 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @OZ51930 Q7175100 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @OZ51930 Q7175110 SPACE 1 @OZ51930 Q7175120 PDEVABRT PSAVE ALL SAVE CALLERS REGISTERS @OZ51930 Q7175150 LR BASE2,R15 SET BASE ADDRESS @OZ51930 Q7175175 L R15,PCEDCT GET DCT ADDRESS @OZ51930 Q7175200 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @OZ51930 Q7175225 BE PAB3800 BRANCH IF YES @OZ51930 Q7175250 OI DCTSTAT,DCTDRAIN FORCE DRAIN OF THE DEVICE @OZ51930 Q7175275 OI PDCTFLAG,DCTRSTRT+DCTBKSP FORCE AN INTERRUPT @OZ51930 Q7175300 B PABRETN BRANCH TO RETURN @OZ51930 Q7175325 SPACE 1 @OZ51930 Q7175350 PAB3800 L PW,PQHADR GET PQH ADDRESS @OZ51930 Q7175375 OI PQHFLAG,PQH2CMD SET INHIBIT I/O FLAG @OZ51930 Q7175400 OI DCTSTAT,DCTDRAIN SET DRAIN FLAG @OZ51930 Q7175425 OI PPFLAG3,PPDVNAVL SET DEVICE NOT AVAILABLE @OZ51930 Q7175450 LA R1,PQHFIRST-(PQENEXT-PQEDSECT) ADDRESS PQE0 @OZ51930 Q7175475 SPACE 1 @OZ51930 Q7175500 PABLOOP LR R0,R1 SAVE PREVIOUS PQE ADDR @OZ51930 Q7175525 L R1,PQENEXT GET NEXT PQE @OZ51930 Q7175550 CR R1,PW TEST FOR END OF PPQ @OZ51930 Q7175575 BE PABCHK BRANCH IF YES @OZ51930 Q7175600 CLI PQETYPE,PQES TEST FOR PQES @OZ51930 Q7175625 BE PABLOOP BRANCH IF YES @OZ51930 Q7175650 SPACE 1 @OZ51930 Q7175675 PABSET ST R0,PQHOPQE SET PQE ADDRESS @OZ51930 Q7175700 OI PPFLAG3,PP3800R SET COMMAND FLAG @OZ51930 Q7175725 NI PPFLAG,FF-PPNEWS RESET NEWS FLAG @OZ51930 Q7175750 OI PQHFLAG,PQHRSTRT+PQHIPPQM SET RESTART FLAGS @OZ51930 Q7175775 XC DCTCSW,DCTCSW CLEAR CSW @OZ51930 Q7175800 B PPDSEND BR TO RETURN SAVE AREAS @OZ51930 Q7175825 SPACE 1 @OZ51930 Q7175850 PABCHK CLC PCEJQE,$ZEROS TEST FOR CURRENT JOB @OZ51930 Q7175875 BNE PABSET BRANCH IF YES @OZ51930 Q7175900 NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET @OZ51930 Q7175925 SPACE 1 @OZ51930 Q7175950 PABRETN PRETURN , RESTORE REGS AND RETURN @OZ51930 Q7175975 SPACE 1 @OZ51930 Q7175980 DROP R1,PW,R15 @OZ51930 Q7175985 TITLE 'HASP PRINT/PUNCH SERVICE -- RESOURCE ALLOCATION' @G38ESBB Q7176000 ***************************************************************@G38ESBB Q7177000 * @G38ESBB Q7178000 * GET DATA BUFFERS FROM THE MAIN HASP BUFFER POOL @G38ESBB Q7179000 * @G38ESBB Q7180000 * PBUF - PRIMARY DATA BUFFER ADDRESS (ON EXIT) @G38ESBB Q7181000 * MUST BE RE-INITIALIZED IN MAINLINE @G38ESBB Q7182000 * PC1 - WORK REG FOR PCIE @G38ESBB Q7183000 * PC2 - WORK REG FOR BUFFER WORK AREA @G38ESBB Q7184000 * @G38ESBB Q7185000 ***************************************************************@G38ESBB Q7186000 SPACE 1 @G38ESBB Q7187000 PALLOC PSAVE ALL SAVE ALL REGISTERS @G38ESBB Q7188000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7189000 USING PALLOC,BASE2 ADDRESSABILITY @G38ESBB Q7190000 LA PC2,1 DETERMINE NUMBER OF @G38ESBB Q7191000 TM PPFLAG2,PPTCEL BUFFERS NEEDED @G38ESBB Q7192000 BZ *+8 BASED ON @G38ESBB Q7193000 IC PC2,$TCELSIZ TRK-CELL/NON-TRK-CELL @G38ESBB Q7194000 $GETBUF WAIT=YES,NUM=(PC2),FIX=YES GET FIRST BUF(S) @G38ESBB Q7195000 ST R1,PBUFSAVE SAVE ADDR OF 1ST BUFFER @G38ESBBCQ7196000 (CHAIN) @G38ESBB Q7197000 CLI PBUFOPT,2 TEST BUFFERING OPTION @G38ESBB Q7198000 BNE PNOSECBF BRANCH IF NOT DBL BUFFERING @G38ESBB Q7199000 $GETBUF WAIT=YES,NUM=(PC2),FIX=YES GET SECOND BUF(S) @G38ESBB Q7200000 SPACE 1 @G38ESBB Q7201000 PNOSECBF DS 0H ACTIVATE DATA @G38ESBB Q7202000 LR PBUF,R1 BUFFER ADDRESSABILITY @G38ESBB Q7203000 ST PBUF,PBUFADDR SAVE PRIMARY DATA BUF ADR @G38ESBB Q7204000 EJECT @G38ESBB Q7205000 ***************************************************************@G38ESBB Q7206000 * @G38ESBB Q7207000 * GET BUFFER FOR OUTPUT CCW'S @G38ESBB Q7208000 * @G38ESBB Q7209000 ***************************************************************@G38ESBB Q7210000 SPACE 1 @G38ESBB Q7211000 * @G38ESBB Q7212000 * FOR 3800 PRINTERS, GET A PAGE BUFFER @G38ESBB Q7213000 * @G38ESBB Q7214000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q7215000 BNE PNOT3800 BR IF NOT @G38ESBB Q7216000 $GETBUF WAIT=YES,TYPE=PAGE,FIX=YES GET OUTPUT CCW BUFF @G38ESBB Q7217000 LA PW,(4096-(BUFSTART-BUFDSECT)-2*((BFWSIZE+7)/8*8)-2*PCIESCQ7218000 IZE)/16*16/2 COMPUTE OFFSET TO PCIE @G38ESBB Q7219000 LA R14,BUFSTART-BUFDSECT+PCIESIZE+(BFWSIZE+7)/8*8(PW,R1) CQ7220000 ADDRESS OF SECOND CCW AREA @G38ESBB Q7221000 B PGBFINIT GO TO INITIALIZE BUFFER @G38ESBBCQ7222000 VARIABLES @G38ESBB Q7223000 * @G38ESBB Q7224000 * FOR NON - 3800 DEVICES, GET A PP BUFFER @G38ESBB Q7225000 * @G38ESBB Q7226000 SPACE 1 @G38ESBB Q7227000 PNOT3800 DS 0H @G38ESBB Q7228000 $GETBUF WAIT=YES,TYPE=PP,FIX=YES GET OUTPUT CCW BUF @G38ESBB Q7229000 SLR PW,PW CLEAR WORK REGISTER FOR IC @G38ESBB Q7230000 IC PW,$NOPRCCW PICK UP PRINT CCW COUNT @G38ESBB Q7231000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE @G38ESBB Q7232000 BO PRINIT BRANCH IF PRINTER @G38ESBB Q7233000 IC PW,$NOPUCCW ELSE PICK UP PUNCH CCW CNT @G38ESBB Q7234000 PRINIT SLL PW,3 MAXIMUM OUTPUT CCW CHAIN @G38ESBBCQ7235000 LENGTH @G38ESBB Q7236000 LA R14,BUFSTART-BUFDSECT+PCIESIZE+(JOESIZE+7)/8*8(PW,R1) CQ7237000 ADDRESS OF SECOND CCW AREA @G38ESBB Q7238000 PGBFINIT DS 0H @G38ESBB Q7239000 ST R1,POUTIOB SAVE OUTPUT IOB ADDRESS @G38ESBB Q7240000 L PL,PCEDCT AND SAVE @G38ESBB Q7241000 ST R1,DCTBUFAD-DCTDSECT(,PL) IN DCT @G38ESBB Q7242000 LA R1,BUFSTART-BUFDSECT(,R1) ADDRESS OF FIRST @G38ESBB Q7243000 ST R1,POUTCCWA CCW AREA @G38ESBB Q7244000 ST R14,POUTCCWN SECOND CCW AREA ADDRESS @G38ESBB Q7245000 STH PW,PCCWLAST OFFSET TO PCIE @G38ESBBCQ7246000 (CCW AREA LENGTH) @G38ESBB Q7247000 L R15,POUTIOB GET IOB ADDRESS @G38ESBB Q7248000 LR PL,R14 COPY 2ND CCW ADDRESS @G38ESBB Q7249000 SLR PL,R15 COMPUTE OFFSET INTO IOB @G38ESBB Q7250000 SRL PL,3 DIVIDE BY 8 @G38ESBB Q7251000 STH PL,PPBDISPL-BUFDSECT(R15) SAVE OFFSET/8 @G38ESBB Q7252000 EJECT @G38ESBB Q7253000 ***************************************************************@G38ESBB Q7254000 * @G38ESBB Q7255000 * INITIALIZE PCIE AT END OF EACH CCW AREA @G38ESBB Q7256000 * FOR 3800, ALSO INITIALIZE RPI/SIB CCW'S AND BFW AT @G38ESBB Q7257000 * THE END OF EACH CCW AREA @G38ESBB Q7258000 * @G38ESBB Q7259000 ***************************************************************@G38ESBB Q7260000 SPACE 1 @G38ESBB Q7261000 LR R0,R1 INITIALIZE @G38ESBB Q7262000 SH R0,PCCWLENG CURRENT @G38ESBB Q7263000 ST R0,PCCWPT CCW POINTER @G38ESBB Q7264000 TM PCEID,PCERJEID+PCEPRSID TEST PROCESSOR TYPE @G38ESBB Q7265000 BNZ *+8 BRANCH IF NOT LOCAL PUNCH @G38ESBB Q7266000 ST R0,PUERRPT SET PUNCH ERROR CUTOFF @G38ESBB Q7267000 SPACE 1 @G38ESBB Q7268000 LRA R0,0(,R14) REAL ADR OF 2ND CCW AREA @G38ESBB Q7269000 BAL PL,PINITCCW INITIALIZE 1ST CCW AREA @G38ESBB Q7270000 LRA R0,0(,R1) REAL ADR OF 1ST CCW AREA @G38ESBB Q7271000 LR R1,R14 ADDRESS 2ND CCW AREA @G38ESBB Q7272000 BAL PL,PINITCCW INITIALIZE 2ND CCW AREA @G38ESBB Q7273000 B PTDSPLM BRANCH TO CONTINUE @G38ESBB Q7274000 SPACE 1 @G38ESBB Q7275000 USING PCIDSECT,PC1 PROVIDE PCIE ADDRESSABILITY @G38ESBB Q7276000 USING BFWDSECT,PC2 PROVIDE BFW ADDRESSABILITY @G38ESBB Q7277000 SPACE 1 @G38ESBB Q7278000 PINITCCW LA PC1,0(PW,R1) ADDRESS PCIE @G38ESBB Q7279000 MVC PCI1CCW(PCIESIZE),PCNOPTIC MOVE PCIE SKELETON @G38ESBB Q7280000 STCM R0,7,PCI2DADR SET TIC TARGET ADDRESS @G38ESBB Q7281000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q7282000 BNER PL RETURN IF NOT @G38ESBB Q7283000 LA PC2,PCIESIZE(,PC1) ADDRESS BFW @G38ESBB Q7284000 SH PC1,=Y(RPISIBSZ+L'PCCWNOP) ADR NOP,RPI,SIB CCWS @G38ESBB Q7285000 MVC BFWDSC(L'BFWDSC+L'BFWPPB+L'BFWRPI),BFWSKEL @G38ESBBCQ7286000 INITIALIZE THE BFW @G38ESBB Q7287000 MVC 0(L'PCCWNOP,PC1),PCCWNOP MOVE NOP CCW @G38ESBB Q7288000 OI 4(PC1),X'40' CHAIN NOP CCW TO RPI @G38ESBB Q7289000 MVC 8(L'PCCWXORD,PC1),PCCWXORD MOVE THE REQUEST @G38ESBB Q7290000 LRA R0,BFWRPI PRINTER INFO ORDER @G38ESBB Q7291000 STCM R0,7,9(PC1) OF EXEC ORDER CCW @G38ESBB Q7292000 MVC 16(L'PCCWSIB,PC1),PCCWSIB MOVE IN THE @G38ESBB Q7293000 LRA R0,BFWSENS SENSE INTERMEDIATE @G38ESBB Q7294000 STCM R0,7,17(PC1) BUFFER CCW @G38ESBB Q7295000 BR PL RETURN TO CALLER @G38ESBB Q7296000 SPACE 1 @G38ESBB Q7297000 DROP PC1,PC2 DROP PCI,BFW ADR @G38ESBB Q7298000 EJECT @G38ESBB Q7299000 ***************************************************************@G38ESBB Q7300000 * @G38ESBB Q7301000 * INITIALIZE BUFFER INFORMATION FOR INPUT CCW'S @G38ESBB Q7302000 * @G38ESBB Q7303000 ***************************************************************@G38ESBB Q7304000 SPACE 1 @G38ESBB Q7305000 PTDSPLM TM PPFLAG2,PPTCEL TEST DESPOOLING METHOD @G38ESBB Q7306000 BO PGETPPIN BR IF TRACK-CELL @G38ESBB Q7307000 ST PBUF,PINIOB ELSE USE DATA BUF FOR IOB @G38ESBB Q7308000 B PFIXDEB GO FIX DEB @G38ESBB Q7309000 SPACE 1 @G38ESBB Q7310000 ***************************************************************@G38ESBB Q7311000 * @G38ESBB Q7312000 * ACQUIRE A PP BUFFER FOR TRACK-CELL INPUT CCW'S @G38ESBB Q7313000 * @G38ESBB Q7314000 ***************************************************************@G38ESBB Q7315000 SPACE 1 @G38ESBB Q7316000 PGETPPIN DS 0H @G38ESBB Q7317000 $GETBUF WAIT=YES,TYPE=PP GET PP BUFFER @G38ESBB Q7318000 ST R1,PINIOB SAVE PP BUFFER'S IOB ADR @G38ESBB Q7319000 SLR PW,PW CLEAR PW FOR PINMTTRT @G38ESBBCQ7320000 CALCULATION @G38ESBB Q7321000 IC PW,$TCELSIZ ADDRESS OF MTTR/BUFFER ADDR @G38ESBBCQ7322000 TABLE @G38ESBB Q7323000 LA R0,1(PW,PW) =&TCELSIZ*3 (SRCH/TIC/READ) @G38ESBB Q7324000 ALR PW,R0 +1 (SET SECTOR) @G38ESBB Q7325000 SLL PW,3 *8 @G38ESBB Q7326000 LA PW,IOBCCW1-BUFDSECT(PW,R1) PLUS IOBCCW1 @G38ESBB Q7327000 ST PW,PINMTTRT SAVE TABLE ADDRESS @G38ESBB Q7328000 EJECT @G38ESBB Q7329000 ***************************************************************@G38ESBB Q7330000 * @G38ESBB Q7331000 * PAGE FIX PRINT/PUNCH DEB FOR DURATION OF THIS OUTPUT @G38ESBB Q7332000 * @G38ESBB Q7333000 ***************************************************************@G38ESBB Q7334000 SPACE 1 @G38ESBB Q7335000 PFIXDEB L R1,PCEDCT ADDRESS LOCAL PRT/PNCH DCT @G38ESBB Q7336000 USING DCTDSECT,R1 PICK-UP DCB ADDRESS @G38ESBB Q7337000 L R1,DCTDCB FROM DCT @G38ESBB Q7338000 USING DCBDSECT,R1 PICK-UP DEB ADDRESS @G38ESBB Q7339000 L R1,DCBDEBAD FROM DCB @G38ESBB Q7340000 LA R0,DEBBASND-DEBDSECT SIZE OF JES2 DEB @G38ESBB Q7341000 LA R2,PPLSAVE ADDRESS OF A PSEUDO-ECB @G38ESBB Q7342000 $PGSRVC FIX,(R1),(R0),(R2) FIX PRINTER/PUNCH DEB @G38ESBB Q7343000 SPACE 1 @G38ESBB Q7344000 PRETURN RESTORE REGS AND RETURN @G38ESBB Q7345000 SPACE 1 @G38ESBB Q7346000 DROP BASE2,R1 SUSPEND DCB @G38ESBB Q7347000 TITLE 'HASP PRINT/PUNCH SERVICE -- DEALLOCATE RESOURCES' @G38ESBB Q7348000 ***************************************************************@G38ESBB Q7349000 * @G38ESBB Q7350000 * FREE ALL PRINT/PUNCH RESOURCES @G38ESBB Q7351000 * @G38ESBB Q7352000 ***************************************************************@G38ESBB Q7353000 SPACE 1 @G38ESBB Q7354000 PDEALLOC PSAVE ALL SAVE ALL REGISTERS @G38ESBB Q7355000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7356000 USING PDEALLOC,BASE2 ADDRESSABILITY @G38ESBB Q7357000 TM PPFLAG2,PPRSW IF A READ IS @G38ESBB Q7358000 BZ PIOCLEAR OUTSTANDING, CLEAR @G38ESBB Q7358050 BAL PL,PRDTCHK ALL INPUT I/O @G38ESBB Q7358100 SPACE 1 @G38ESBB Q7358150 PIOCLEAR TM PCEID,PCERJEID TEST PROCESSOR TYPE @G38ESBB Q7358200 BO PFREEBFS BRANCH IF REMOTE @G38ESBB Q7358250 L R1,PCEDCT ADDRESS PRINT/PUNCH DCT @G38ESBB Q7358300 CLI DCTBUFCT-DCTDSECT(R1),0 ALL OUTPUT COMPLETED... @G38ESBB Q7358350 BE PFREEBFS BRANCH IF YES @G38ESBB Q7358400 $WAIT IO ELSE, WAIT FOR IO TO FINISH @G38ESBB Q7358450 B PIOCLEAR GO TRY AGAIN @G38ESBB Q7358500 SPACE 1 @G38ESBB Q7358550 PFREEBFS TM PPFLAG2,PPTCEL FREE IOB BUFFER @G38ESBB Q7358600 BZ PFROUT USED FOR DE-SPOOLING @G38ESBB Q7359000 $FREEBUF PINIOB TRACK-CELL'S @G38ESBB Q7360000 SPACE 1 @G38ESBB Q7361000 ***************************************************************@G38ESBB Q7362000 * @G38ESBB Q7363000 * FOR LOCAL DEVICES -- FREE OUTPUT IOB BUFFER @G38ESBB Q7364000 * @G38ESBB Q7365000 ***************************************************************@G38ESBB Q7366000 SPACE 1 @G38ESBB Q7367000 PFROUT TM PCEID,PCERJEID TEST PROCESSOR TYPE @G38ESBB Q7368000 BO PFRBUFS BR IF REMOTE @G38ESBB Q7369000 SPACE 1 @G38ESBB Q7370000 PFROIOB $FREEBUF POUTIOB FREE OUTPUT IOB BUFFER @G38ESBB Q7371000 SPACE 1 @G38ESBB Q7372000 ***************************************************************@G38ESBB Q7373000 * @G38ESBB Q7374000 * FREE ALL DATA BUFFERS @G38ESBB Q7375000 * @G38ESBB Q7376000 ***************************************************************@G38ESBB Q7377000 SPACE 1 @G38ESBB Q7378000 PFRBUFS L PC1,PBUFADDR OBTAIN PRIMARY AND @G38ESBB Q7379000 L PC2,PBUFSAVE SECONDARY DATA BUFFER ADR @G38ESBB Q7380000 LTR PC1,PC1 ANY BUFFERS PRESENT... @G38ESBB Q7381000 BZ PDEBFREE BR IF NOT @G38ESBB Q7382000 TM PPFLAG2,PPTCEL TEST DE-SPOOLING METHOD @G38ESBB Q7383000 BO PFRBUF1 BR IF TRACK-CELL @G38ESBB Q7384000 XC BUFCHAIN-BUFDSECT(,PC1),BUFCHAIN-BUFDSECT(PC1) @G38ESBB Q7385000 XC BUFCHAIN-BUFDSECT(,PC2),BUFCHAIN-BUFDSECT(PC2) @G38ESBB Q7386000 PFRBUF1 CLI PBUFOPT,1 TEST FOR SINGLE BUFFERING @G38ESBB Q7387000 BE PFRBUF2 BR IF YES @G38ESBB Q7388000 $FREEBUF (PC1),MULTIPLE FREE PRIMARY DATA BUFFER(S) @G38ESBB Q7389000 SPACE 1 @G38ESBB Q7390000 PFRBUF2 $FREEBUF (PC2),MULTIPLE FREE SECONDARY DATA BUFFERS @G38ESBB Q7391000 SPACE 1 @G38ESBB Q7392000 ***************************************************************@G38ESBB Q7393000 * @G38ESBB Q7394000 * PAGE-FREE LOCAL PRINT/PUNCH DATA-EXTENT-BLOCK (DEB) @G38ESBB Q7395000 * @G38ESBB Q7396000 ***************************************************************@G38ESBB Q7397000 SPACE 1 @G38ESBB Q7398000 PDEBFREE TM PCEID,PCERJEID TEST PROCESSOR TYPE @G38ESBB Q7399000 BNO PPGFDEB BR IF NOT A REMOTE @OZ43428 Q7400000 NI MHASPECF+$EWBJOT,255-$EWFJOT SHOW UNIT TO MLLM @OZ43428 Q7400200 B PDALCEND BYPASS DEB FREE FOR REMOTE @OZ43428 Q7400400 SPACE 1 @OZ43428 Q7400600 PPGFDEB L R1,PCEDCT ADDRESS PRINT/PUNCH DCT @OZ43428 Q7401000 L R1,DCTDCB-DCTDSECT(,R1) GET DCB ADDR FROM DCT @G38ESBB Q7402000 USING DCBDSECT,R1 PICK-UP DEB ADDRESS @G38ESBB Q7403000 L R1,DCBDEBAD FROM DCB @G38ESBB Q7404000 LA R0,DEBBASND-DEBDSECT SIZE OF JES2 DEB @G38ESBB Q7405000 $PGSRVC FREE,(R1),(R0) PAGE-FREE THE DEB @G38ESBB Q7406000 SPACE 1 @G38ESBB Q7407000 PDALCEND PRETURN RESTORE REGS AND RETURN @G38ESBB Q7408000 SPACE 1 @G38ESBB Q7409000 DROP BASE2,R1 SUSPEND LOCAL ADR,DCB @G38ESBB Q7410000 TITLE 'HASP PRINT SERVICE -- RECOMPUTE 3800 PAGE ID' @G38ESBB Q7411000 ***************************************************************@G38ESBB Q7412000 * @G38ESBB Q7413000 * THIS ROUTINE ADJUSTS PQERPGID FOR ALL PQE'S BY @G38ESBB Q7414000 * ADDING TO IT THE VALUE SPECIFIED IN REGISTER 0. @G38ESBB Q7415000 * THIS IS DONE TO SHOW GAPS IN SPOOL DATA NOT REFLECTED @G38ESBB Q7416000 * BY THE PAPER LINE. @G38ESBB Q7417000 * @G38ESBB Q7418000 * R0 - RECOMPUTE VALUE (ON ENTRY) @G38ESBB Q7419000 * R1 - ADDRESS OF PENDING PAGE QUEUE ENTRY @G38ESBB Q7420000 * PW - ADDRESS OF PENDING PAGE QUEUE HEADER @G38ESBB Q7421000 * @G38ESBB Q7422000 ***************************************************************@G38ESBB Q7423000 SPACE 1 @G38ESBB Q7424000 PRECOMP PSAVE , SAVE LINKAGE AND BASE @G38ESBB Q7425000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7426000 USING PRECOMP,BASE2 ADDRESSABILITY @G38ESBB Q7427000 L PW,PQHADR ESTABLISH PQH @G38ESBB Q7428000 USING PQHDSECT,PW ADDRESSABILITY @G38ESBB Q7429000 L R1,PQHFIRST GET START OF PPQ @G38ESBB Q7430000 USING PQEDSECT,R1 PQE ADDRESSABILITY @G38ESBB Q7431000 PRECOM1 LA R15,PQHFIRST-(PQENEXT-PQEDSECT) GET PQE0 @G38ESBB Q7432000 CR R1,R15 END OF PQE... @G38ESBB Q7433000 BE PCOMPEND BR IF YES @G38ESBB Q7434000 CLI PQETYPE,PQED DATA SET PQE... @G38ESBB Q7435000 BE PSCANPQE BR IF YES @G38ESBB Q7436000 LH R15,PQERPGID GET REPO PAGE ID @G38ESBB Q7437000 ALR R15,R0 ADD RECOMPUTE VALUE @G38ESBB Q7438000 STH R15,PQERPGID SAVE RECOMPUTED PAGE ID @G38ESBB Q7439000 SPACE 1 @G38ESBB Q7440000 PSCANPQE L R1,PQENEXT POINT TO NEXT ENTRY @G38ESBB Q7441000 B PRECOM1 BR TO CONTINUE UPDATE @G38ESBB Q7442000 SPACE 1 @G38ESBB Q7443000 PCOMPEND PRETURN RESTORE REGS AND RETURN @G38ESBB Q7444000 DROP PW,R1 SUSPEND PQH,PQE @G38ESBB Q7445000 TITLE 'HASP PRINT SERVICE -- MAP 3800 FCB' @G38ESBB Q7446000 ***************************************************************@G38ESBB Q7447000 * @G38ESBB Q7448000 * MAPFCB USES AS INPUT THE PRINTER COMMAND OF THE LINE @G38ESBB Q7449000 * BEING OPERATED ON AND DETERMINES THAT LINE'S PAGE @G38ESBB Q7450000 * LOCATION WITHIN THE FCB. @G38ESBB Q7451000 * @G38ESBB Q7452000 * PW - ADDRESS OF PENDING PAGE QUEUE HEADER @G38ESBB Q7453000 * PC1 - COMMAND CODE SAVE REGISTER @G38ESBB Q7454000 * R14 - ADDRESS OF FCB BUFFER FOR MAPPING @G38ESBB Q7455000 * @G38ESBB Q7456000 * CC = ZERO - NON-TERMINATION, CONTINUE PROCESSING @G38ESBB Q7457000 * NON-ZERO - TERMINATION, BRANCH PPDONE @G38ESBB Q7458000 * @G38ESBB Q7459000 ***************************************************************@G38ESBB Q7460000 SPACE 1 @G38ESBB Q7461000 PMAPFCB PSAVE , SAVE LINKAGE AND BASE @G38ESBB Q7462000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7463000 USING PMAPFCB,BASE2 ADDRESSABILITY @G38ESBB Q7464000 SPACE 1 @G38ESBB Q7465000 USING PQHDSECT,PW PQH ADDRESSABILITY @G38ESBB Q7466000 SPACE 1 @G38ESBB Q7467000 L PW,PQHADR GET PQH ADDRESS @G38ESBB Q7468000 L PC1,PCCWORK GET COMMAND CODE @G38ESBB Q7469000 TR PCCWORK(1),PCCTABLE TRANSLATE CONTROL COMMAND @G38ESBB Q7470000 TM PCCWORK,PVALCMD TEST FOR VALID FCB MAP @G38ESBB Q7471000 BO PCOMPMAP BR IF YES @G38ESBB Q7472000 ST PC1,PCCWORK RESTORE COMMAND CODE @G38ESBB Q7473000 B PMAPEND BR TO RETURN @G38ESBB Q7474000 SPACE 1 @G38ESBB Q7475000 PCOMPMAP L R14,PQHFCB ADDRESS FCB BUFFER @G38ESBB Q7476000 LA R14,BUFSTART-BUFDSECT(,R14) ADDRESS FCB @G38ESBB Q7477000 USING PFCB,R14 FCB ADDRESSABILITY @G38ESBB Q7478000 TM PCCWORK,PSKIPCMD TEST FOR CHANNEL SKIP @G38ESBB Q7479000 BO PSKIP BR IF YES @G38ESBB Q7480000 SPACE 1 @G38ESBB Q7481000 ***************************************************************@G38ESBB Q7482000 * @G38ESBB Q7483000 * PROCESS FCB MAPPING FOR SPACE IMMEDIATE OR @G38ESBB Q7484000 * WRITE AND SPACE @G38ESBB Q7485000 * @G38ESBB Q7486000 ***************************************************************@G38ESBB Q7487000 SPACE 1 @G38ESBB Q7488000 PSPACE NI PCCWORK,PSAVBITS RESERVE LOWER FOUR BITS @G38ESBB Q7489000 SLR R15,R15 ZERO WORK AREA @G38ESBB Q7490000 IC R15,PCCWORK SET CONVERTED LINE SPACING @G38ESBB Q7491000 AH R15,PQHFCBLN ADD CURRENT FCB LINE POS @G38ESBB Q7492000 STH R15,PQHFCBLN SAVE NEW FCB LINE POSITION @G38ESBB Q7493000 CLC PQHFCBLN,PFCBLENG PASSED BOTTOM OF PAGE... @G38ESBB Q7494000 BNH PNOSPACE BR IF NOT @G38ESBB Q7495000 L R15,PQHMAPV GET MAPPING PAGES @OZ53047 Q7496000 BCTR R15,0 DECREMENT PAGES @G38ESBB Q7497000 ST R15,PQHMAPV SAVE NEW MAP PAGE COUNT @OZ53047 Q7498000 MVC PQHFCBLN,PFCBTOP POINT FCB TO TOP OF PAGE @G38ESBB Q7499000 PNOSPACE NI PFCBFLG1,FF-PFCBNOSP RESET WRT-NO-SPACE IND @G38ESBB Q7500000 CLI PCCWORK,PWRTNOSP TEST FOR WRITE-NO-SPACE @G38ESBB Q7501000 BNE PTSTDONE BR IF NO @G38ESBB Q7502000 OI PFCBFLG1,PFCBNOSP TURN ON WRITE-NO-SPACE IND @G38ESBB Q7503000 B PTSTDONE BR TO RETURN @G38ESBB Q7504000 SPACE 1 @G38ESBB Q7505000 ***************************************************************@G38ESBB Q7506000 * @G38ESBB Q7507000 * PROCESS FCB MAPPING FOR SKIP TO CHANNEL @G38ESBB Q7508000 * @G38ESBB Q7509000 ***************************************************************@G38ESBB Q7510000 SPACE 1 @G38ESBB Q7511000 PSKIP NI PCCWORK,PSAVBITS RESERVE LOWER 4 BITS @G38ESBB Q7512000 SLR R15,R15 ZERO WORK REGISTER @G38ESBB Q7513000 IC R15,PCCWORK GET CHANNEL CODE @G38ESBB Q7514000 L R0,PQHMAPV GET MAPPING PAGES @OZ53047 Q7515000 LA R1,PFCBSTRT GET ADDRESS OF FCB @G38ESBB Q7516000 LH PL,PQHFCBLN GET CURRENT FCB LINE @G38ESBB Q7517000 ALR R1,PL ADD FCB LINE TO FCB ADDRESS @G38ESBB Q7518000 BCTR R1,0 MAKE ZERO OFFSET @G38ESBB Q7519000 CLM R15,1,0(R1) ARE WE AT CHANNEL @G38ESBB Q7520000 BNE PFCBSCAN BR IF NOT @G38ESBB Q7521000 TM PFCBFLG1,PFCBNOSP PREVIOUS WRITE-NO-SPACE @G38ESBB Q7522000 BZ PTSTDONE BR IF NOT @G38ESBB Q7523000 SPACE 1 @G38ESBB Q7524000 ***************************************************************@G38ESBB Q7525000 * @G38ESBB Q7526000 * SCAN FCB FOR MATCH ON CHANNEL COMMAND @G38ESBB Q7527000 * @G38ESBB Q7528000 ***************************************************************@G38ESBB Q7529000 SPACE 1 @G38ESBB Q7530000 PFCBSCAN LA PL,1(PL) INCREMENT FCB INDEX @G38ESBB Q7531000 LA R1,1(R1) POINT TO NEXT BYTE IN FCB @G38ESBB Q7532000 CH PL,PFCBLENG PAST END OF FCB... @G38ESBB Q7533000 BNH PFCB2 BR IF NOT @G38ESBB Q7534000 LA R1,PFCBSTRT RESET TO TOP OF FCB @G38ESBB Q7535000 LA PL,1 RESET FCB LINE COUNT @G38ESBB Q7536000 BCTR R0,0 INDIC PAGE DECREMENT @G38ESBB Q7537000 SPACE 1 @G38ESBB Q7538000 PFCB2 CLM R15,1,0(R1) CHANNEL REACHED... @G38ESBB Q7539000 BE PFCBMTCH BR IF YES @G38ESBB Q7540000 CH PL,PQHFCBLN ENTIRE FCB SCANNED... @G38ESBB Q7541000 BNE PFCBSCAN BR IF NOT @G38ESBB Q7542000 LA PL,1(,PL) INCREMENT LINE POSITION @G38ESBB Q7543000 A R0,=F'1' NO PAGE DECREMENT @OZ53047 Q7544000 CH PL,PFCBLENG END OF PAGE REACHED @G38ESBB Q7545000 BNH PFCBMTCH BR IF NO @G38ESBB Q7546000 LA PL,1 RESET FCB LINE COUNT @G38ESBB Q7547000 BCTR R0,0 NEED PAGE DECREMENT @G38ESBB Q7548000 SPACE 1 @G38ESBB Q7549000 PFCBMTCH STH PL,PQHFCBLN SAVE NEW FCB INDEX @G38ESBB Q7550000 ST R0,PQHMAPV SAVE NEW MAP PAGE COUNT @OZ53047 Q7551000 EJECT @G38ESBB Q7552000 ***************************************************************@G38ESBB Q7553000 * @G38ESBB Q7554000 * IF RESTART POINT REACHED, RESET INDICATORS TO RESUME @G38ESBB Q7555000 * PRINTING. @G38ESBB Q7556000 * IF TERMINATION COMMAND, SET CONDITION CODE FOR @G38ESBB Q7557000 * MAINLINE BRANCH TO PROCESSOR TERMINIATION. @G38ESBB Q7558000 * @G38ESBB Q7559000 ***************************************************************@G38ESBB Q7560000 SPACE 1 @G38ESBB Q7561000 PTSTDONE ST PC1,PCCWORK RESTORE COMMAND CODE @G38ESBB Q7562000 DROP R14 SUSPEND BUFFER ADDRESS @G38ESBB Q7563000 CLC PQHMAPV,$ZEROS MAPPING DONE @G38ESBB Q7564000 BNE PMAPEND BR IF NO @G38ESBB Q7565000 L R1,PQHLAST GET LAST PQE @G38ESBB Q7566000 CR R1,PW TEST FOR EMPTY PPQ @OZ46351 Q7566100 BE PMAPRST BRANCH IF YES @OZ46351 Q7566200 USING PQEDSECT,R1 PQE ADDRESSABILITY @G38ESBB Q7567000 TM PQECFLAG,PQECLPG LAST PAGE OF DATA SET @G38ESBB Q7568000 BZ PCHKFCB BR IF NOT @G38ESBB Q7569000 L R1,PQECPQED GET DATA SET PQE @G38ESBB Q7570000 TM PQEDFLAG,PQEDLAST LAST DATA SET OF JOE @G38ESBB Q7571000 BZ PCHKFCB BR IF NOT . @G38ESBB Q7572000 PMAPRST DS 0H @OZ46351 Q7572010 NI PPFLAG3,FF-PP3800R RESET 3800 REPOSITION INDIC @G38ESBB Q7572050 XC PDDBSKIP,PDDBSKIP RESET TO RESUME PRINTING @G38ESBB Q7572100 ICM R1,15,PQHFCB GET FCB BUFFER ADDR @OZ51936 Q7572200 BZ PMAPRET BRANCH IF NONE @OZ51936 Q7572300 $FREEBUF (R1) FREE FCB BUFFER @OZ51936 Q7572400 MVC PQHFCB,$ZEROS CLEAR BUFFER ADDR @OZ51936 Q7572500 PMAPRET LA R15,8 SET CONDITION CODE @OZ51936 Q7573000 LTR R15,R15 SET NON-ZERO CONDITION CODE @G38ESBB Q7574000 PRETURN RETURN TO MAINLINE @G38ESBB Q7575000 EJECT @OZ51936 Q7576000 PCHKFCB CLC PQHFCBLN,PFCBTOP ARE WE AT TOP OF FCB... @G38ESBB Q7577000 BE PSTARTPR YES,GO SET FOR START PRINT @G38ESBB Q7578000 OI PCCWORK,PCONVIMM ELSE,CONVERT CCW TO @G38ESBB Q7579000 LM PC1,PC2,PCCWORK IMMEDIATE AND PUT INTO @G38ESBB Q7580000 BAL PL,PPPUT CHANNEL PROGRAM @G38ESBB Q7581000 L PW,PQHADR RESTORE PQH ADDRESS @G38ESBB Q7582000 SPACE 1 @G38ESBB Q7583000 PSTARTPR NI PPFLAG3,FF-PP3800R RESET 3800 REPO INDIC @G38ESBB Q7584000 OI PPFLAG3,PP38CKPT CREATE PQEC FOR RESUME @OZ52713 Q7584100 XC PDDBSKIP,PDDBSKIP RESET PRINTING INDIC @G38ESBB Q7585000 L R1,PQHFCB GET FCB ADDRESS @G38ESBB Q7586000 LTR R1,R1 FCB LOADED.... @G38ESBB Q7587000 BZ PMAPEND BR IF NOT @G38ESBB Q7588000 $FREEBUF (R1) RELEASE THE FCB @G38ESBB Q7589000 MVC PQHFCB,$ZEROS RESET FCB ADDRESS @G38ESBB Q7590000 SPACE 1 @G38ESBB Q7591000 PMAPEND SR R15,R15 SET ZERO CONDITION CODE @G38ESBB Q7592000 PRETURN RESTORE REGS AND RETURN @G38ESBB Q7593000 DROP BASE2,PW,R1 SUSPEND BASE,PQH,PQE @G38ESBB Q7594000 EJECT @G38ESBB Q7595000 ***************************************************************@G38ESBB Q7596000 * @G38ESBB Q7597000 * A TRANSLATE TABLE WILL BE USED TO CONVERT THE CONTROL @G38ESBB Q7598000 * CHARACTERS TO A FORMAT MORE EASILY USED. @G38ESBB Q7599000 * THE BITS IN EACH BYTE HAVE THE FOLLOWING FORMAT - @G38ESBB Q7600000 * @G38ESBB Q7601000 * 0 - RESERVED @G38ESBB Q7602000 * @G38ESBB Q7603000 * 1 - 0 = DATA TRANSFER @G38ESBB Q7604000 * 1 = NO DATA TRANSFER (AN IMMEDIATE COMMAND) @G38ESBB Q7605000 * @G38ESBB Q7606000 * 2 - 0 = LOW ORDER BITS ARE # OF LINES TO SPACE @G38ESBB Q7607000 * 1 = LOW ORDER BITS ARE # OF CHANNEL TO SKIP TO @G38ESBB Q7608000 * @G38ESBB Q7609000 * 3 - 0 = NOT VALID FCB MAPPING COMMAND, IGNORE @G38ESBB Q7610000 * 1 = VALID FCB MAPPING COMMAND @G38ESBB Q7611000 * @G38ESBB Q7612000 * 4-7 = # OF LINES TO SPACE OR CHANNEL TO SKIP TO @G38ESBB Q7613000 * @G38ESBB Q7614000 ***************************************************************@G38ESBB Q7615000 SPACE 1 @G38ESBB Q7616000 PCCTABLE DC X'00100000000000000011005100000000' @G38ESBB Q7617000 DC X'00120052000000000013005300000000' @G38ESBB Q7618000 DC X'00000000000000000000000000000000' @G38ESBB Q7619000 DC X'00000000000000000000000000000000' @G38ESBB Q7620000 DC X'00000000000000000000000000000000' @G38ESBB Q7621000 DC X'00000000000000000000000000000000' @G38ESBB Q7622000 DC X'00000000000000000000000000000000' @G38ESBB Q7623000 DC X'00000000000000000000000000000000' @G38ESBB Q7624000 DC X'00000000000000000031007100000000' @G38ESBB Q7625000 DC X'00320072000000000033007300000000' @G38ESBB Q7626000 DC X'00340074000000000035007500000000' @G38ESBB Q7627000 DC X'00360076000000000037007700000000' @G38ESBB Q7628000 DC X'00380078000000000039007900000000' @G38ESBB Q7629000 DC X'003A007A00000000003B007B00000000' @G38ESBB Q7630000 DC X'003C007C000000000000000000000000' @G38ESBB Q7631000 TITLE 'HASP PRINT/PUNCH SERVICES -- PRODUCE JOB HEADER' @G38ESBB Q7632000 ***************************************************************@G38ESBB Q7633000 * @G38ESBB Q7634000 * SETUP PRINT/PUNCH DEVICE BY CHAR-JOE AND PRINT @G38ESBB Q7635000 * SEPARATORS. @G38ESBB Q7636000 * @G38ESBB Q7637000 * R1 - ADDRESS CHARACTERISTICS JOE @G38ESBB Q7638000 * JCT - ADDRESS JCT @G38ESBB Q7639000 * @G38ESBB Q7640000 * CC = 0 - NORMAL RETURN @G38ESBB Q7641000 * < 0 - PAPER JAM OR CANCEL KEY DURING DEVICE SETUP @G38ESBB Q7642000 * > 0 - TERMINATION COMMAND DETECTED DURING DSV @G38ESBB Q7643000 * @G38ESBB Q7644000 ***************************************************************@G38ESBB Q7645000 SPACE 1 @G38ESBB Q7646000 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY @G38ESBB Q7647000 USING JCTDSECT,JCT PROVIDE JCT ADDRESSABILITY @G38ESBB Q7648000 SPACE 1 @G38ESBB Q7649000 PHEADER PSAVE ALL SAVE ALL REGISTERS @G38ESBB Q7650000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7651000 USING PHEADER,BASE2 ADDRESSABILITY @G38ESBB Q7652000 TM PPFLAG3,PP3800R 3800 RESTART... @G38ESBB Q7653000 BO PSIGNON BR IF YES @G38ESBB Q7654000 CLI PDEVTYP3,UCB3800 3800 PRINTER.... @G38ESBB Q7655000 BE PCOLDST BR IF YES @G38ESBB Q7656000 SPACE 1 @G38ESBB Q7657000 PSIGNON L R0,PWKJOE GET WORK JOE PARAMETER @G38ESBB Q7658000 L R15,=A(PJODMSG) CALL JOB ON DEVICE @G38ESBB Q7659000 BALR PL,R15 MESSAGE ROUTINE @G38ESBB Q7660000 SPACE 1 @G38ESBB Q7661000 PCOLDST L R1,PCHJOE ADDRESS CHAR-JOE @G38ESBB Q7662000 L PL,PCEDCT ADDRESS PRINTER DCT @G38ESBB Q7663000 CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q7664000 BNE PSETUPST BR IF NOT - SETUP IMPACT PR @G38ESBB Q7665000 MVC SPFORMS(2*4),JOEFORM USE JOE FORMS AND FCB ID @G38ESBB Q7666000 MVC SPFLASH,JOEFLASH SET FLASH (SEP WON'T FLASH) @G38ESBB Q7667000 MVC SPMODF,=C'****' RESET COPY MODIFICATION @G38ESBB Q7668000 MVI SPCOPYN,1 FORCE ONLY 1 COPY OF HEADER @G38ESBB Q7669000 MVI SPCOPYS,1 INDICATE STARTING COPY NUM @G38ESBB Q7670000 MVI SPFLAG,SPSEP INIT FLAGS FOR SEP PAGE @G38ESBB Q7671000 TM JOECFLAG,$JOEBRST SET FOR @G38ESBB Q7672000 BZ PSETUP NOBURST OR @G38ESBB Q7673000 OI SPFLAG,SPBURST BURST @G38ESBB Q7674000 B PSETUP ENTER COMMON SETUP @G38ESBB Q7675000 SPACE 1 @G38ESBB Q7676000 PSETUPST DS 0H SETUP STANDARD PRINT/PUNCH @G38ESBB Q7677000 LA R1,JOEFORM ADDRESS SETUP PORTION @G38ESBB Q7678000 MVI DCTACPTN-DCTDSECT(PL),X'00' DISABLE COMPACT FOR @G38ESBB Q7679000 MVI PRINDEX,X'81' SET 3211 INDEX TO 1 @G38ESBB Q7680000 MVI PREVCPYN,1 SET NON 3800 COPY COUNT @G38ESBB Q7681000 SPACE 1 @G38ESBB Q7682000 PSETUP DS 0H @G38ESBB Q7683000 L R15,=A(PRPUDSV) CALL DEVICE @G38ESBB Q7684000 BALR PL,R15 SETUP VERIFICATION @G38ESBB Q7685000 L PL,PCEDCT GET DCT ADDRESS @G38ESBB Q7686000 TM DCTPPSW2-DCTDSECT(PL),DCTCKJAM 3800 PJAM/CKEY @G38ESBB Q7687000 BZ PTABORT BR IF NOT @G38ESBB Q7688000 L R15,=A(PLOCATE) CALL THE LOCATE ROUTINE @G38ESBB Q7689000 BALR PL,R15 TO GET ORIGIN PQE @G38ESBB Q7690000 LA R15,8 SET RETURN CODE @G38ESBB Q7691000 LNR R15,R15 SET NEGATIVE CONDITION CODE @G38ESBB Q7692000 PRETURN , RETURN TO CALLER, CC NEG @G38ESBB Q7693000 SPACE 1 @G38ESBB Q7694000 PTABORT TM PPFLAG3,PP3800R 3800 RESTART @G38ESBB Q7695000 BZ POFFSTK NO, BRANCH @OZ45081 Q7696000 TM PPFLAG,PRDELSW IS JOB ABORTED @G38ESBB Q7697000 BZ POFFSTK NO, GO ISSUE OFFSET STACK @G38ESBB Q7698000 $MID 170 @OZ45081 Q7698050 LA R1,=C'$HASP170 ' MESSAGE ID @OZ45081 Q7698100 TM PDCTFLAG,DCTRSTRT+DCTBKSP $I - (INTERRUPT)... @OZ45081 Q7698150 BNO PTESTE ON, GO TEST $E @OZ45081 Q7698200 LA R14,=C' INTERRUPTED' MESSAGE TEXT @OZ48259 Q7698250 OI PSMFDCI,SMFINTRP SET SMF FLAG @OZ45081 Q7698300 B PDOMSG GO ISSUE MESSAGE @OZ45081 Q7698350 SPACE 1 @OZ45081 Q7698400 PTESTE TM PDCTFLAG,DCTRSTRT $E - (RESTART)... @OZ45081 Q7698450 BNO PTESTC NO, BRANCH @OZ45081 Q7698500 LA R14,=C' RESTARTED ' MESSAGE TEXT @OZ48259 Q7698550 OI PSMFDCI,SMFRESTR SET SMF FLAG @OZ45081 Q7698600 B PDOMSG GO ISSUE MESSAGE @OZ45081 Q7698650 SPACE 1 @OZ45081 Q7698700 PTESTC TM PDCTFLAG,DCTDELET $C - (CANCEL)... @OZ45081 Q7698750 BNO PTRM NO, BRANCH @OZ45081 Q7698800 LA R14,=C' DELETED ' MESSAGE TEXT @OZ48259 Q7698850 OI PSMFDCI,SMFOPSTP SET SMF FLAG @OZ45081 Q7698900 B PDOMSG GO ISSUE MESSAGE @OZ45081 Q7698950 SPACE 1 @OZ45081 Q7699000 PTRM DS 0H @OZ45081 Q7699050 $MID 185 @OZ45081 Q7699100 LA R1,=C'$HASP185 ' MESSAGE ID @OZ45081 Q7699150 LA R14,=C' TERMINATED ' MESSAGE TEXT @OZ48259 Q7699200 SPACE 1 @OZ45081 Q7699250 PDOMSG L R15,=A(PRMSG) ISSUE MESSAGE TO OPERATOR @OZ45081 Q7699300 BALR PL,R15 AND ADD IT TO OUTPUT @OZ48259 Q7699350 L PW,PQHADR ADDRESS 3800 PQH @OZ45081 Q7699400 TM PQHFLAG-PQHDSECT(PW),PQHDSVC RESET NEEDED... @OZ45081 Q7699450 BZ *+12 NO, BYPASS RESET @OZ45081 Q7699500 NI PQHFLAG-PQHDSECT(PW),FF-PQHDSVC RESET INDICATOR @OZ45081 Q7699550 NI PDCTFLAG,FF-DCTDELET-DCTRSTRT-DCTBKSP RESET CMD @OZ45081 Q7699600 LA R15,8 SET RETURN CODE @OZ45081 Q7699650 LPR R15,R15 SET POSITIVE CONDITION CODE @G38ESBB Q7700000 PRETURN , RETURN TO CALLER @G38ESBB Q7701000 EJECT @G38ESBB Q7702000 ***************************************************************@G38ESBB Q7703000 * @G38ESBB Q7704000 * OFFSET-STACK 3800 BURSTER JOBS @G38ESBB Q7705000 * @G38ESBB Q7706000 ***************************************************************@G38ESBB Q7707000 SPACE 1 @G38ESBB Q7708000 POFFSTK CLI PDEVTYP3,UCB3800 TEST DEVICE TYPE @G38ESBB Q7709000 BNE PTESTSEP BR IF NOT 3800 PRINTER @G38ESBB Q7710000 LM PC1,PC2,PCCWOFST ISSUE AN OFFSET- @G38ESBB Q7711000 BAL PL,PPPUT2 STACK COMMAND @OZ51441 Q7712000 TM PPFLAG3,PP3800R 3800 RESTART @G38ESBB Q7713000 BO PTESTSEP BR IF YES @G38ESBB Q7714000 SPACE 1 @G38ESBB Q7715000 PGETPQEJ L PW,PQHADR ADDRESS PQH @G38ESBB Q7716000 USING PQHDSECT,PW SET PQH ADDRESSABILITY @OZ48003 Q7717000 NI PQHAFLAG,FF-PQHALOC RESET ALLOCATION FLAG @OZ48003 Q7718000 L R15,=A(PADDPQE) CALL SUBROUTINE TO @OZ48003 Q7719000 BALR PL,R15 ALLOCATE A PQE @OZ48003 Q7720000 BNZ PGOTPQEJ BRANCH IF SUCCESSFUL @OZ48003 Q7721000 B PTABORT ELSE, ABORT @OZ48003 Q7722000 DROP PW SUSPEND PQH ADDRESSABILITY @OZ48003 Q7723000 SPACE 1 @G38ESBB Q7724000 USING PQEDSECT,R1 PQE ADDRESSABILITY @G38ESBB Q7725000 PGOTPQEJ MVI PQETYPE,PQEJ INDICATE JOB START PQE @G38ESBB Q7726000 MVC PQEJWJOE,PWKJOE GET WORK JOE FOR PQEJ @G38ESBB Q7727000 L R15,=A(PPGIDIO) ISSUE I/O TO @G38ESBB Q7728000 BALR PL,R15 COMPLETE PQE @G38ESBB Q7729000 SPACE 2 @G38ESBB Q7730000 ***************************************************************@G38ESBB Q7731000 * @G38ESBB Q7732000 * SEE IF OUTPUT SEPARATORS ARE WANTED @G38ESBB Q7733000 * @G38ESBB Q7734000 ***************************************************************@G38ESBB Q7735000 SPACE 1 @G38ESBB Q7736000 USING DCTDSECT,R1 DCT ADDRESSABILITY @G38ESBB Q7737000 SPACE 1 @G38ESBB Q7738000 PTESTSEP L R1,PCEDCT ADDR OF DCT @G38ESBB Q7739000 TM DCTPPSW,DCTPPSWS SUPPRESS SEPARATORS... @G38ESBB Q7740000 BO PHDREND BR IF YES @G38ESBB Q7741000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE @G38ESBB Q7742000 BO PRINTSEP BRANCH IF PRINT @G38ESBB Q7743000 SPACE 1 @G38ESBB Q7744000 DROP R1 SUSPEND DCT ADDRESSABILITY @G38ESBB Q7745000 EJECT @G38ESBB Q7746000 ***************************************************************@G38ESBB Q7747000 * @G38ESBB Q7748000 * PRODUCE PUNCH SEPARATOR LACE CARD @G38ESBB Q7749000 * @G38ESBB Q7750000 ***************************************************************@G38ESBB Q7751000 SPACE 1 @G38ESBB Q7752000 PUNCHSEP DS 0H @G38ESBB Q7753000 SPACE 1 @G38ESBB Q7754000 TM PCEID,PCERJEID TEST PROCESSOR TYPE @G38ESBB Q7755000 BZ PUNCHRM BR IF NOT REMOTE @G38ESBB Q7756000 TM MDCTFEAT-DCTDSECT(R1),DCTPSHDR IF NO SETUP HDR @G38ESBB Q7757000 BNO PUNCHRM FOR PUNCH, SKIP PDIR @G38ESBB Q7758000 MVI PPDIRID,X'01' INDICATE SEPARATOR PDIR @G38ESBB Q7759000 LA PL,2 USE A RECORD COUNT OF 2 @G38ESBB Q7760000 ST PL,PPDSRCT FOR PUNCH @G38ESBB Q7761000 L R15,=A(PPDIR) POINT TO SEPARATOR ROUTINE @G38ESBB Q7762000 BALR PL,R15 PUT SEPARATOR PDIR @G38ESBB Q7763000 SPACE 1 @G38ESBB Q7764000 PUNCHRM MVC PCCWORK(4),JCTROOMN SET UP ROOM NUMBER @G38ESBB Q7765000 MVC PCCWORK+4(4),JCTJOBID+4 AND JOB NUMBER @G38ESBB Q7766000 LA R1,BUFSTART ADDR BUFFER AS A WORK AREA @G38ESBB Q7767000 SLR PW,PW PREPARE FOR SCAN @G38ESBB Q7768000 PUCHGEN MVI 0(R1),X'6A' START FIELD WITH 12-11 PNCH @G38ESBB Q7769000 IC R0,PCCWORK(PW) MOVE NEXT CHARACTER @G38ESBB Q7770000 STC R0,1(,R1) TO IMAGE @G38ESBB Q7771000 OI 1(R1),X'30' CONVERT @G38ESBB Q7772000 CLI 1(R1),X'F0' EACH @G38ESBB Q7773000 BH PUCHARD CHARACTER @G38ESBB Q7774000 BE PUCHAR0 FROM @G38ESBB Q7775000 MVI 1(R1),X'EA' EBCDIC @G38ESBB Q7776000 SPACE 1 @G38ESBB Q7777000 PUCHAR0 XI 1(R1),X'E0' TO @G38ESBB Q7778000 SPACE 1 @G38ESBB Q7779000 PUCHARD XI 1(R1),X'60' 12-11-X PUNCH @G38ESBB Q7780000 MVC 2(7,R1),1(R1) PROPAGATE CHARACTER @G38ESBB Q7781000 MVI 9(R1),X'6A' TERM FIELD WITH 12-11 PUNCH @G38ESBB Q7782000 LA R1,10(,R1) STEP TO NEXT FIELD @G38ESBB Q7783000 LA PW,1(,PW) STEP TO NEXT CHARACTER @G38ESBB Q7784000 CL PW,=F'8' TEST @G38ESBB Q7785000 BL PUCHGEN BRANCH IF NOT LAST CHAR @G38ESBB Q7786000 LA PC1,BUFSTART SETUP PUNCH CCW @G38ESBB Q7787000 AL PC1,PUCCW ADD LEFT HALF OF CCW @G38ESBB Q7788000 CLI PDEVTYPE+3,X'0C' IS DEV A 3525 PUNCH @OZ45115 Q7788100 BNE PUCHARD2 BR IF NO TO 2540 DEFAULT @OZ45115 Q7788200 ICM PC1,8,=X'01' SET STACKER 1 DEFAULT @OZ45115 Q7788300 PUCHARD2 DS 0H @OZ45115 Q7788400 L PC2,PUCCW+4 AND RIGHT HALF OF CCW @G38ESBB Q7789000 BAL PL,PPPUT ADD CCW TO CHAIN @G38ESBB Q7790000 CLI PDEVTYPE+3,X'0C' IS DEVICE A 3525.... @OZ49531 Q7790100 BE PUCHARD3 BR IF YES, DON'T PUNCH BLNK @OZ49531 Q7790200 LM PC1,PC2,PUCCWBL LOAD BLANK CARD CCW @G38ESBB Q7791000 BAL PL,PPPUT ADD CCW TO CHAIN @G38ESBB Q7792000 PUCHARD3 DS 0H @OZ49531 Q7792100 BAL PL,PPWRITE INITIATE WRITE @G38ESBB Q7793000 BAL PL,PPCHECK AND CHECK @G38ESBB Q7794000 B PHDREND CONTINUE @G38ESBB Q7795000 EJECT @G38ESBB Q7796000 ***************************************************************@G38ESBB Q7797000 * @G38ESBB Q7798000 * PRODUCE PRINT SEPARATOR PAGE @G38ESBB Q7799000 * @G38ESBB Q7800000 ***************************************************************@G38ESBB Q7801000 SPACE 1 @G38ESBB Q7802000 SPACE 1 @G38ESBB Q7803000 PRINTSEP L R1,$NEWSTTR GET JES2-NEWS MTTR @G38ESBB Q7804000 LTR R1,R1 NEWS AVAILABLE... @G38ESBB Q7805000 BZ PHEADER1 BR IF NOT @G38ESBB Q7806000 TM PPFLAG3,PP3800R ARE WE REPOSITIONING... @G38ESBB Q7807000 BO PHEADER1 YES, NO NEWS AFTER REPO @G38ESBB Q7808000 OI PPFLAG,PPNEWS ELSE SET NEWS FLAG @G38ESBB Q7809000 ST R1,PCEJMTTR SET NEWS MTTR @G38ESBB Q7810000 MVC PCEEJRCB,PCCW+2 SET INITIAL RCB OFFSET @G38ESBB Q7811000 MVC PPKEY,=C'$$NEWS' SET SPECIAL JOB/DS KEY @G38ESBB Q7812000 MVC PRLINECT,=F'-1' SET LARGE PAGE SIZE @G38ESBB Q7813000 SPACE 1 @G38ESBB Q7814000 PHEADER1 LA R1,=C'START' ASSUME COLD START @G38ESBB Q7815000 TM PCKJOE,$JOECKV 'START' OR 'CONT'... @G38ESBB Q7816000 BZ PHEADER2 BR IF COLD START @G38ESBB Q7817000 LA R1,=C'CONT ' ELSE SET FOR CONTINUATION @G38ESBB Q7818000 SPACE 1 @G38ESBB Q7819000 PHEADER2 L R15,=A(PRINTID) PRODUCE PRINT @G38ESBB Q7820000 BALR PL,R15 SEPARATOR PAGE @G38ESBB Q7821000 SPACE 1 @G38ESBB Q7822000 PHDREND SR R15,R15 SET ZERO CONDITION CODE @G38ESBB Q7823000 PRETURN , RETURN TO CALLER @G38ESBB Q7824000 SPACE 1 @G38ESBB Q7825000 DROP JCT SUSPEND JCT @G38ESBB Q7826000 SPACE 3 @G38ESBB Q7827000 LTORG @G38ESBB Q7828000 TITLE 'HASP PRINT/PUNCH SERVICE -- CHECKPOINT ACCESS ROUTINE' @G38ESBB Q7829000 ***************************************************************@G38ESBB Q7830000 * @G38ESBB Q7831000 * CHECKPOINT ACCESS ROUTINE @G38ESBB Q7832000 * @G38ESBB Q7833000 * ON EXIT - @G38ESBB Q7834000 * CONDITION CODE SET @G38ESBB Q7835000 * ZERO - CHECKPOINT ACCESS SUCCESSFULLY ACQUIRED @G38ESBB Q7836000 * NON-ZERO - CHECKPOINT ACCESS NOT ACQUIRED @G38ESBB Q7837000 * @G38ESBB Q7838000 ***************************************************************@G38ESBB Q7839000 SPACE 1 @G38ESBB Q7840000 PGETQS PSAVE ALL SAVE CALLER'S REGS @G38ESBB Q7841000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7842000 USING PGETQS,BASE2 ADDRESSABILITY @G38ESBB Q7843000 SPACE 1 @G38ESBB Q7844000 $QSUSE TYPE=TEST THIS CPU OWN THE CKPT DATA @G38ESBB Q7845000 BZ PGOTQS BR IF YES @G38ESBB Q7846000 SPACE 1 @G38ESBB Q7847000 ***************************************************************@G38ESBB Q7848000 * @G38ESBB Q7849000 * FORCE CKPT IF $CKPTIME INTERVAL HAS EXPIRED @G38ESBB Q7850000 * @G38ESBB Q7851000 ***************************************************************@G38ESBB Q7852000 SPACE 1 @G38ESBB Q7853000 STCK PCER1 GET CURRENT TIME @G38ESBB Q7854000 L PW,PCER1 UPPER WORD ALMOST SECONDS @G38ESBB Q7855000 SL PW,PCECLOCK IF NOT LONGER @G38ESBB Q7856000 C PW,$CKPTIME THAN LIMIT, @G38ESBB Q7857000 BL PQSEND RETURN WITH CC SET LOW @G38ESBB Q7858000 SPACE 1 @G38ESBB Q7859000 PGETQS1 DS 0H FORCE QUEUE OWNERSHIP @G38ESBB Q7860000 $QSUSE REQUEST ACCESS TO CKPT DATA @G38ESBB Q7861000 SPACE 1 @G38ESBB Q7862000 PGOTQS DS 0H NOW OWN ACCESS TO CKPT DATA @G38ESBB Q7863000 STCK $DOUBLE RESET START TIME FOR @G38ESBB Q7864000 MVC PCECLOCK,$DOUBLE CHECKPOINT INTERVAL @G38ESBB Q7864500 SR R15,R15 SET CONDITION CODE @G38ESBB Q7865000 SPACE 1 @G38ESBB Q7866000 PQSEND PRETURN RETURN WITH CC SET @G38ESBB Q7867000 SPACE 1 @G38ESBB Q7868000 DROP BASE2 DROP LOCAL ADDRESSAVILITY @G38ESBB Q7869000 TITLE 'HASP PRINT/PUNCH SERVICE -- JOB ON DEVICE MSG ROUTINE' @G38ESBB Q7870000 ***************************************************************@G38ESBB Q7871000 * @G38ESBB Q7872000 * ISSUE PRINT/PUNCH JOB SIGN ON MESSAGE TO THE OPERATOR @G38ESBB Q7873000 * @G38ESBB Q7874000 * REGISTERS ON ENTRY @G38ESBB Q7875000 * R0 = ADDRESS OF WORK JOE @G38ESBB Q7876000 * R10 = ADDRESS OF JQE @G38ESBB Q7877000 * @G38ESBB Q7878000 ***************************************************************@G38ESBB Q7879000 SPACE 1 @G38ESBB Q7880000 PJODMSG PSAVE ALL SAVE ALL REGISTERS @G38ESBB Q7881000 LR BASE2,R15 SETUP LOCAL @G38ESBB Q7882000 USING PJODMSG,BASE2 ADDRESSABILITY @G38ESBB Q7883000 L R1,PCEDCT GET ADDRESS OF PRT/PU DCT @G38ESBB Q7884000 USING DCTDSECT,R1 ESTABLISH DCT ADR @G38ESBB Q7885000 $MID 150 @G38ESBB Q7886000 PMSG PMESSAGE,M150L,(X'150F',C'ON ',DCTDEVN) @G38ESBB Q7887000 LR R2,R0 ADDRESS WORK-JOE @G38ESBB Q7888000 USING JOEDSECT,R2 PROVIDE JOE ADDRESSABILITY @G38ESBB Q7889000 L R2,JOERECCT GET SYSOUT RECORD COUNT @G38ESBB Q7890000 DROP R2 DROP JOE ADDRESSABILITY @G38ESBB Q7891000 LA R0,M150L SHORT MESSAGE LENGTH @G38ESBB Q7892000 LTR R2,R2 TEST RECORD COUNT @G38ESBB Q7893000 BZ PONWTO BR IF NONE @G38ESBB Q7894000 CVD R2,$DOUBLE MAKE RECORD COUNT DECIMAL @OZ46142 Q7895000 MVC PMESSAGE+M150L(L'PPRTSTAT),PPRTSTAT MAKE REC CT @G38ESBB Q7896000 ED PMESSAGE+M150L(L'PPRTSTAT),$DOUBLE+4 READABLE @OZ46142 Q7897000 PMSG PMESSAGE+M150L+L'PPRTSTAT,M150L2,(C' LINES') @G38ESBB Q7898000 TM PCEID,PCEPRSID TEST PROCESSOR TYPE @G38ESBB Q7899000 BO PONPRTR BR IF PRINTER @G38ESBB Q7900000 PMSG PMESSAGE+M150L+L'PPRTSTAT,,(C' CARDS') @G38ESBB Q7901000 SPACE 1 @G38ESBB Q7902000 PONPRTR LA R0,M150L+L'PPRTSTAT+M150L2 ASSUME MULTIPLE REC @G38ESBB Q7903000 BCT R2,PONWTO BR IF PLURAL @G38ESBB Q7904000 BCTR R0,0 ELSE DROP THE 'S' @G38ESBB Q7905000 SPACE 1 @G38ESBB Q7906000 PONWTO $WTO PMESSAGE,(R0), 'JOB ON PRINTER/PUNCH' MSG @G38ESBBCQ7907000 ROUTE=$LOG+$UR,JOB=YES, (NOTE: R10=ADR OF JQE) @G38ESBBCQ7908000 CLASS=$TRIVIA,PRI=$ST @G38ESBB Q7909000 SPACE 1 @G38ESBB Q7910000 PRETURN RESTORE REGS AND RETURN @G38ESBB Q7911000 TITLE 'HASP PRINT/PUNCH SERVICE -- PURGE SPIN DATA SET SPACE' @G38ESBB Q7912000 ***************************************************************@G38ESBB Q7913000 * @G38ESBB Q7914000 * PURGE SPIN DATA SETS TRACKS FROM THE SPOOL PACKS @G38ESBB Q7915000 * @G38ESBB Q7916000 * R0 - IOT TRACK ADDRESS (ON ENTRY) @G38ESBB Q7917000 * @G38ESBB Q7918000 ***************************************************************@G38ESBB Q7919000 SPACE 1 @G38ESBB Q7920000 USING PURSPDS,BASE2 PROVIDE LOCAL ADR @G38ESBB Q7921000 USING IOTDSECT,JCT ACTIVATE IOT ADDRESSABILITY @G38ESBB Q7922000 SPACE 1 @G38ESBB Q7923000 PURSPDS PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q7924000 LR BASE2,R15 PROVIDE LOCAL ADR @G38ESBB Q7925000 LR R15,R0 IOT ADDRESS FOR READ @G38ESBB Q7926000 BAL PL,PRDBUF READ IOT INTO A BUFFER @G38ESBB Q7927000 BAL PL,PRDCHK CHECK READ @G38ESBB Q7928000 LR JCT,PBUF ADDRESS IOT IN BUFFER @G38ESBB Q7929000 TM PPFLAG,PPRDERR TEST FOR I/O ERROR ON READ @G38ESBB Q7930000 BO PSPNIOTR BR IF YES @G38ESBB Q7931000 CLC IOTJBKEY,PPJOBKEY IS THE IOT VALID @G38ESBB Q7932000 BE PSPNIOT1 BRANCH IF YES @G38ESBB Q7933000 SPACE 1 @G38ESBB Q7934000 PSPNIOTR $DISTERR INDICATE CONTROL BLOCK ERR @G38ESBB Q7935000 OI PPFLAG,PPJCTIOT+PRDELSW SET REASON FOR TERM @G38ESBB Q7936000 B PURSPEND SKIP REMAINDER OF IOT PURGE @G38ESBB Q7937000 SPACE 1 @G38ESBB Q7938000 ***************************************************************@G38ESBB Q7939000 * @G38ESBB Q7940000 * RESET SPIN IOT ALLOC BIT AND PURGE DATA SET TRACKS @G38ESBB Q7941000 * @G38ESBB Q7942000 ***************************************************************@G38ESBB Q7943000 SPACE 1 @G38ESBB Q7944000 PSPNIOT1 DS 0H @G38ESBB Q7945000 L PL,$IOTPDDB POINT TO @G38ESBB Q7946000 ALR PL,JCT 1ST (AND ONLY) PDDB IN IOT @G38ESBB Q7947000 NI PDBFLAG1-PDBDSECT(PL),FF-PDB1PSO RESET PSO BIT @G38ESBB Q7948000 TM IOTFLAG1,IOT1ALOC ALLOCATION IOT @G38ESBB Q7949000 BZ PSPNIOT4 NO, SKIP $PURGE @G38ESBB Q7950000 NI IOTFLAG1,FF-IOT1ALOC RESET ALLOCATION IOT BIT @G38ESBB Q7951000 SPACE 1 @G38ESBB Q7952000 $PURGE IOTTGMAP PURGE TRACKS USED FOR DS @G38ESBB Q7953000 SPACE 1 @G38ESBB Q7954000 PSPNIOT4 MVC PCESEEK,IOTTRACK SET IOT TRACK INTO DA DCT @G38ESBB Q7955000 MVI PCEDEVTP,PCEDAWR SET DA DCT TO WRITE @G38ESBB Q7956000 ST JCT,PCEBUFAD SET ADDRESS OF IOT BUFFER @G38ESBB Q7957000 LA R1,PCEDADCT ADDRESS DA DCT @G38ESBB Q7958000 L PL,BUFCHAIN SAVE BUFCHAIN VALUE @G38ESBB Q7959000 $EXCP (R1),WAIT=YES WRITE IOT TO SPOOL @G38ESBB Q7960000 ST PL,BUFCHAIN REPLACE BUFCHAIN VALUE @G38ESBB Q7961000 BO PURSPEND BR IF I/O GOOD @G38ESBB Q7962000 SPACE 1 @G38ESBB Q7963000 PSPNIOTW $DISTERR INDICATE CONTROL BLOCK ERR @G38ESBB Q7964000 SPACE 1 @G38ESBB Q7965000 PURSPEND CLI PDEVTYP3,UCB3800 TEST FOR 3800 PRINTER @G38ESBB Q7966000 BE PURSPRET YES, BYPASS PBUF ALTERATION @G38ESBB Q7967000 L R1,PSAVAREA ADDRESS OUR SAVE AREA @G38ESBB Q7968000 ST PBUF,4+(PBUF*4)(,R1) UPDATE PBUF IN SAVE AREA @G38ESBB Q7969000 SPACE 1 @G38ESBB Q7970000 PURSPRET PRETURN RESTORE REGS AND RETURN @G38ESBB Q7971000 DROP JCT DROP IOT ADDRESSABILITY @G38ESBB Q7972000 TITLE 'HASP PRINT/PUNCH SERVICE -- PQE COMPLETION ROUTINE' @G38ESBB Q7973000 ***************************************************************@G38ESBB Q7974000 * @G38ESBB Q7975000 * FOR 3800 PRINTER, @G38ESBB Q7976000 * COMPLETE ANY PQE'S ASSIGNED DURING THIS CCW AREA @G38ESBB Q7977000 * @G38ESBB Q7978000 * R0 - CT OF ID'S SOLICITED FOR THIS CCW AREA (ENTRY) @G38ESBB Q7979000 * R1 - ADDRESS PENDING PAGE QUEUE ENTRY @G38ESBB Q7980000 * PW - ADDRESS PENDING PAGE QUEUE HEADER @G38ESBB Q7981000 * @G38ESBB Q7982000 ***************************************************************@G38ESBB Q7983000 SPACE 1 @G38ESBB Q7984000 USING PQECOMP,BASE2 PROVIDE LOCAL ADR @G38ESBB Q7985000 USING PQHDSECT,PW PROVIDE PQH ADDRESSABILITY @G38ESBB Q7986000 USING PQEDSECT,R1 PROVIDE PQE ADDRESSABILITY @G38ESBB Q7987000 SPACE 1 @G38ESBB Q7988000 PQECOMP PSAVE ALL SAVE CALLER'S REGISTERS @G38ESBB Q7989000 LR BASE2,R15 ESTABLISH LOCAL ADR @G38ESBB Q7990000 L PW,PQHADR ADDRESS PQH @G38ESBB Q7991000 L R1,PQHPIDE GET OLDEST NON-COMPLETE PQE @G38ESBB Q7992000 LTR R0,R0 ANY ID'S TO COMPLETE... @G38ESBB Q7993000 BZ PCMPEND NO, BRANCH @G38ESBB Q7994000 SPACE 1 @G38ESBB Q7995000 PCMPCE CLR R1,PW TEST FOR END OF PPQ @OZ51011 Q7996000 BE PCMPEND BRANCH IF YES @OZ51011 Q7996100 TM PQETYPE,PQED+PQES DATASET OR SMF PQE... @OZ51011 Q7996200 BNZ PCMPCNT1 YES, BYPASS PQE COMPLETION @G38ESBB Q7997000 LTR R0,R0 ANY MORE ID'S @G38ESBB Q7998000 BZ PCMPEND NO, DONE, BRANCH @G38ESBB Q7999000 SPACE 1 @G38ESBB Q8000000 L R14,PQECSENS ADDRESS SENSED INFO @G38ESBB Q8001000 CLI 2(R14),X'FF' AREA ABORT BEFORE SENSE... @G38ESBB Q8002000 BE PCMPEND YES, BRANCH @G38ESBB Q8003000 MVC PQEFCBLN,L'PQERPGID(R14) MOVE FCB LINE INDEX @G38ESBB Q8004000 LH R14,0(,R14) GET SENSED PAGE ID @G38ESBB Q8005000 N R14,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q8006000 LA R14,1(,R14) COMPENSATE FOR HARDWARE @G38ESBB Q8007000 STH R14,PQERPGID SET REPO PAGE ID IN PQE @G38ESBB Q8008000 STH R14,PQECPGID CHANNEL ID = REPOSITION ID @G38ESBB Q8009000 SPACE 1 @G38ESBB Q8010000 CLI PQETYPE,PQEJ IS PQE FOR JOB START... @G38ESBB Q8011000 BNE PCMPCNT NO, GO DECREMENT ID COUNT @G38ESBB Q8012000 L R14,PQHPQEJ GET PQEJ QUEUE HEAD @G38ESBB Q8013000 LTR R14,R14 IS QUEUE EMPTY... @G38ESBB Q8014000 BNZ PCMPSCHQ NO, GO SEARCH FOR QUEUE END @G38ESBB Q8015000 ST R14,PQEJNEXT SET NEW PQEJ'S PTR TO 0 @G38ESBB Q8016000 ST R1,PQHPQEJ NEW PQEJ IS ONLY IN QUEUE @G38ESBB Q8017000 B PCMPCNT GO DECREMENT ID COUNT @G38ESBB Q8018000 SPACE 1 @G38ESBB Q8019000 PCMPSCHQ L R15,PQEJNEXT-PQEDSECT(,R14) GET NEXT PQEJ IN Q @G38ESBB Q8020000 LTR R15,R15 END OF QUEUE REACHED... @G38ESBB Q8021000 BZ PCMPQEND YES, BRANCH @G38ESBB Q8022000 LR R14,R15 NO, GET NEXT CKPE @G38ESBB Q8023000 B PCMPSCHQ LOOP BACK @G38ESBB Q8024000 SPACE 1 @G38ESBB Q8025000 PCMPQEND ST R15,PQEJNEXT SET NEW PQEJ'S PTR TO 0 @G38ESBB Q8026000 ST R1,PQEJNEXT-PQEDSECT(,R14) ADD NEW PQEJ TO Q @G38ESBB Q8027000 SPACE 1 @G38ESBB Q8028000 PCMPCNT BCTR R0,0 DECREMENT COUNT OF ID'S @G38ESBB Q8029000 SPACE 1 @G38ESBB Q8030000 PCMPCNT1 L R1,PQENEXT GET NEXT PQE @G38ESBB Q8031000 B PCMPCE LP BACK TO PROCESS NEXT ID @G38ESBB Q8032000 EJECT @G38ESBB Q8033000 ***************************************************************@G38ESBB Q8034000 * @G38ESBB Q8035000 * PQE'S COMPLETED FOR THIS CCW AREA @G38ESBB Q8036000 * @G38ESBB Q8037000 ***************************************************************@G38ESBB Q8038000 SPACE 1 @G38ESBB Q8039000 PCMPEND L R15,POUTIOB RESTORE IOB ADR @G38ESBB Q8040000 L R14,PPBPCIE-BUFDSECT(,R15) RESTORE PCIE ADDRESS @G38ESBB Q8041000 ST R1,PQHPIDE SET OLDEST NON-COMP PQE ADR @G38ESBB Q8042000 TM PQHFLAG,PQHCHCMD TEST FOR SYNC CMD @OZ51011 Q8042100 BO PCMPRTN BRANCH IF YES @OZ51011 Q8042200 USING BFWDSECT,R15 PROVIDE BFW ADDRESSABILITY @OZ48003 Q8042500 LA R15,PCIESIZE(,R14) ADDRESS BFW @OZ48003 Q8043000 STC R0,BFWPQECT UPDATE PQE CNT IN CCW AREA @OZ48003 Q8043500 SLR R1,R1 CLEAR R1 @OZ48003 Q8044000 ICM R1,3,BFWXPGID SET ORIGIN PAGE TO POINT @OZ48003 Q8044500 LA R1,1(,R1) TO TOP OF NEW PAGE @OZ48003 Q8045000 STCM R1,3,PQHOPG AT TRANSFER STATION @OZ48003 Q8045500 ICM R1,3,BFWCPGID SET CHANNEL @OZ49145 Q8045600 LA R1,1(,R1) PAGE ID @OZ49145 Q8045700 STCM R1,3,PQHCPG FOR PPQMGR @OZ49145 Q8045800 NI PQHAFLAG,FF-PQHPBUF0 ASSUME BUFFER NOT EMPTY @OZ48003 Q8046000 CLC BFWXPGID,BFWCPGID CHECK IF @OZ48003 Q8046500 BNE PCKJQUE 3800 PAGE @OZ48003 Q8047000 CLC BFWFCBLN,PFCBTOP BUFFER IS @OZ48003 Q8047500 BNE PCKJQUE EMPTY @OZ48003 Q8048000 OI PQHAFLAG,PQHPBUF0 IND PAGE BUFFER IS EMPTY @OZ48003 Q8048500 DROP R15 SUSPEND BFW ADDRESSABILITY @OZ48003 Q8049000 SPACE 1 @OZ48003 Q8049500 ***************************************************************@G38ESBB Q8050000 * @G38ESBB Q8051000 * PROCESS JOB ON DEVICE MESSAGE IF NEEDED @G38ESBB Q8052000 * @G38ESBB Q8053000 ***************************************************************@G38ESBB Q8054000 SPACE 1 @G38ESBB Q8055000 PCKJQUE L R1,PQHPQEJ GET FIRST PQEJ IN PQEJ Q @OZ48003 Q8056000 SPACE 1 @G38ESBB Q8057000 PJSLOCX LTR R1,R1 ARE ANY JOB STARTS PENDING @G38ESBB Q8058000 BZ PCALLMGR NO, GO PROCESS STACKER ID'S @G38ESBB Q8059000 LH R0,BFWXPGID-BFWDSECT+PCIESIZE(,R14) DETERMINE @G38ESBB Q8060000 SH R0,PQECPGID IF THE JOB @G38ESBB Q8061000 N R0,PCLRHALF HAS CROSSED THE @G38ESBB Q8062000 C R0,PQELIMIT TRANSFER STATION @G38ESBB Q8063000 BH PCALLMGR NO, GO CALL PPQMGR @G38ESBB Q8064000 ST JCT,PQHSAVE2 SAVE JCT REGISTER @G38ESBB Q8065000 L R1,PQEJWJOE WORK JOE ADR FOR PJODMSG @G38ESBB Q8066000 LH JCT,JOEJQE-JOEDSECT(,R1) GET JQE OFFSET @G38ESBB Q8067000 N JCT,PCLRHALF CLEAR LEFT HALFWORD @G38ESBB Q8068000 SLL JCT,2 EXPAND TO BYTE OFFSET @G38ESBB Q8069000 AL JCT,$JOBQPTR ADD JOB QUEUE ORIGIN @G38ESBB Q8070000 ST JCT,PQHXJQE SET JQE OF XFER STATION JOB @G38ESBB Q8071000 LR R0,R1 ADR WORK JOE FOR PJODMSG @G38ESBB Q8072000 L R15,=A(PJODMSG) CALL SUBROUTINE TO @G38ESBB Q8073000 BALR PL,R15 WRITE JOB ON DEVICE MSG @G38ESBB Q8074000 L JCT,PQHSAVE2 RESTORE JCT REGISTER @G38ESBB Q8075000 L R1,PQHPQEJ RESTORE PQEJ ADDRESS @G38ESBB Q8076000 L R4,PQEJNEXT GET NEXT JOB @OZ48003 Q8077000 ST R14,PQHSAVE2 SAVE PCIE ADDRESS @G38ESBB Q8078000 LA R0,1 DELETE ONE PQE @G38ESBB Q8079000 L R15,=A(PDELPQE) CALL PDELPQE TO @OZ48003 Q8079500 BALR PL,R15 DELETE PQEJ @OZ48003 Q8080000 L R14,PQHSAVE2 RESTORE PCIE ADDRESS @G38ESBB Q8081000 LR R1,R4 ADDRESS NEXT PQEJ @OZ48003 Q8082000 ST R1,PQHPQEJ UPDATE PQEJ QUEUE @G38ESBB Q8083000 B PJSLOCX LOOP BACK FOR NEXT JOB @G38ESBB Q8084000 SPACE 1 @G38ESBB Q8085000 PCALLMGR LH R0,BFWSPGID-BFWDSECT+PCIESIZE(,R14) STACKER ID @G38ESBB Q8086000 L R15,=A(PPQMGR) CALL PPQ MANAGEMENT @G38ESBB Q8087000 BALR PL,R15 ROUTINE, R0 CONTAINS ID @G38ESBB Q8088000 SPACE 1 @OZ51011 Q8088100 PCMPRTN PRETURN , RESTORE REGS AND RETURN @OZ51011 Q8089000 DROP PW,R1 DROP PQH,PQE ADR @G38ESBB Q8090000 TITLE 'HASP PRINT PUNCH SERVICE -- IMAGE LOADER TASK' @G38ESBB Q8400000 ***************************************************************@G38ESBB Q8401000 * @G38ESBB Q8402000 * HASP IMAGE LOADER SUBTASK @G38ESBB Q8403000 * @G38ESBB Q8404000 ***************************************************************@G38ESBB Q8405000 SPACE 1 @G38ESBB Q8406000 HASPIMAG $ENTRY BASE=R15 IMAGE LOADER MAIN ENTRY @G38ESBB Q8407000 DROP R15 SUSPEND LOCAL ADR @G38ESBB Q8408000 SAVE (14,12) SAVE CALLER'S REGISTERS @G38ESBB Q8409000 LR BASE2,R15 ESTABLISH BASE REGISTER @G38ESBB Q8410000 USING HASPIMAG,BASE2 PROVIDE LOCAL ADR @G38ESBB Q8411000 L BASE1,=V(HASP) SET HCT ADDRESS @G38ESBB Q8412000 USING HCTDSECT,BASE1 PROVIDE HCT ADDRESSABILITY @G38ESBB Q8413000 LR R3,R1 SAVE DTE ADDR PASSED @G38ESBB Q8414000 GETMAIN R,LV=IMGSWLEN GETMAIN SAVE/WORK AREA @G38ESBB Q8415000 ST R13,4(,R1) STORE BACKWARD POINTER @G38ESBB Q8416000 LR R4,R13 HOLD CALLER'S SAVE ADDRESS @G38ESBB Q8417000 LR R13,R1 ADDRESS MY SAVE AREA @G38ESBB Q8418000 USING IMGDSECT,R13 PROVIDE SAVE AREA ADR @G38ESBB Q8419000 ST R13,8(,R4) STORE FWD POINTER @G38ESBB Q8420000 ST R3,IMGDTE STORE DTE ADDRESS @G38ESBB Q8421000 XC IMGDCB,IMGDCB CLEAR SYS1.IMAGLIB DCB ADDR @G38ESBB Q8422000 SPACE 3 @G38ESBB Q8423000 ***************************************************************@G38ESBB Q8424000 * @G38ESBB Q8425000 * ESTABLISH ESTAE EXIT FOR ABNORMAL TERMINATIONS @G38ESBB Q8426000 * @G38ESBB Q8427000 ***************************************************************@G38ESBB Q8428000 SPACE 1 @G38ESBB Q8429000 LA R1,12(,SAVE) ESTAE PARAMETER LIST AREA @G38ESBB Q8430000 MVC 0(IMGABNDL,R1),IMGABND MOVE-IN ESTAE PARMLIST @G38ESBB Q8431000 ESTAE PARAM=(13),MF=(E,(1)) ESTABLISH IMGESTAE EXIT @G38ESBB Q8432000 EJECT @G38ESBB Q8433000 ***************************************************************@G38ESBB Q8434000 * @G38ESBB Q8435000 * OPEN SYS1.IMAGELIB FOR IMAGE LOADING @G38ESBB Q8436000 * @G38ESBB Q8437000 ***************************************************************@G38ESBB Q8438000 SPACE 1 @G38ESBB Q8439000 LA R0,$IMAGTCB LOAD PRINTER DTE . . . @G38ESBB Q8440000 LA R3,0(R3) CLEAR HI-ORDER BYTE @G38ESBB Q8441000 CLR R0,R3 IMPACT PRINTER DTE. . . @G38ESBB Q8442000 BNE IMGACTIV BR IF NO @G38ESBB Q8443000 IMGLIB OPEN OPEN IMAGE LIBRARY @G38ESBB Q8444000 ST R1,IMGDCB SAVE IMAGELIB DCB ADDRESS @G38ESBB Q8445000 SPACE 1 @G38ESBB Q8446000 ***************************************************************@G38ESBB Q8447000 * @G38ESBB Q8448000 * SIGNAL ATTACHER THAT IMAGE LOADER TASK IS ACTIVE @G38ESBB Q8449000 * @G38ESBB Q8450000 ***************************************************************@G38ESBB Q8451000 SPACE 1 @G38ESBB Q8452000 IMGACTIV OI 0(R3),X'80' SHOW HASPIMAG INITIALIZED @G38ESBB Q8453000 SPACE 1 @G38ESBB Q8453500 IMGNACTV LA R0,$IMAGTCB LOAD PRINTER DTE @G38ESBB Q8454000 CLR R0,R3 IS IT IMPACT PRINTER... @G38ESBB Q8455000 BNE IMG$$P IF 3800, $$POST @G38ESBB Q8456000 LTR R1,R1 DID SYS1.IMAGELIB OPEN... @OZ53418 Q8456100 BNZ IMGOPN BR IF YES, @OZ53418 Q8456200 OI 0(R3),X'40' ELSE SHOW ERROR IN DTE @OZ53418 Q8456300 IMGOPN DS 0H @OZ53418 Q8456400 POST $PIMGECB POST HASPINIT @G38ESBB Q8457000 B IMGWAIT BR TO WAIT @G38ESBB Q8458000 IMG$$P $$POST TYPE=IMAG,R11=HCT POST ATTACHOR @G38ESBB Q8459000 EJECT @G38ESBB Q8460000 ***************************************************************@G38ESBB Q8461000 * @G38ESBB Q8462000 * WAIT FOR WORK POST OR $PHASP POST @G38ESBB Q8463000 * @G38ESBB Q8464000 ***************************************************************@G38ESBB Q8465000 SPACE 1 @G38ESBB Q8466000 IMGWAIT L R3,IMGDTE ADDR OF HASPIMAG DTE @G38ESBB Q8467000 LA R1,8(,R3) ADDR OF HASPIMAG WORK-ECB @G38ESBB Q8468000 WAIT ECB=(1) WAIT FOR WORK OR $PJES2 @G38ESBB Q8469000 TM 0(R3),X'80' SUBTASK INITIALIZED... @G38ESBB Q8469500 BZ IMGDOWN BR IF NO TO SHUTDOWN @G38ESBB Q8470000 LR R1,R3 SAVE REG 3 @G38ESBB Q8470500 ICM R3,7,8+1(R3) IS THERE NEW WORK... @G38ESBB Q8471000 MVI 8(R1),X'00' RESET WORK ECB @G38ESBB Q8471500 BNZ IMGBLDL BR IF NEW WORK,ELSE SHUTDWN @G38ESBB Q8472000 SPACE 1 @G38ESBB Q8473000 ***************************************************************@G38ESBB Q8474000 * @G38ESBB Q8475000 * SHUTDOWN ASSUMED - CLOSE SYS1.IMAGELIB @G38ESBB Q8476000 * @G38ESBB Q8477000 ***************************************************************@G38ESBB Q8478000 SPACE 1 @G38ESBB Q8479000 IMGDOWN L R1,IMGDCB GET IMAGELIB DCB ADDR @G38ESBB Q8480000 LTR R1,R1 WAS IMAGELIB OPENED... @G38ESBB Q8481000 BZ IMGEXIT BR IF NO @G38ESBB Q8482000 IMGLIB CLOSE,(1) CLOSE IMAGELIB @G38ESBB Q8483000 SPACE 1 @G38ESBB Q8484000 IMGEXIT L R13,IMGSAV+4 RESTORE CALLER'S R13 @G38ESBB Q8485000 RETURN (14,12),RC=0 RETURN WITH ZERO COMP CODE @G38ESBB Q8486000 EJECT @G38ESBB Q8487000 ***************************************************************@G38ESBB Q8488000 * @G38ESBB Q8489000 * BLDL AGAINST SYS1.IMAGELIB TO PROVIDE PARM LIST FOR @G38ESBB Q8490000 * LOAD @G38ESBB Q8491000 * @G38ESBB Q8492000 ***************************************************************@G38ESBB Q8493000 SPACE 1 @G38ESBB Q8494000 IMGBLDL DS 0H * @G38ESBB Q8495000 USING BUFDSECT,R3 ACTIVATE BUFFER ADR @G38ESBB Q8496000 SPACE 1 @G38ESBB Q8497000 ST R3,IMGBUFAD SAVE BUFFER ADR FOR ESTAE @G38ESBB Q8498000 NI IMGFLAG1,FF-IMGABEND INITIALIZE ABEND FLAG OFF @G38ESBB Q8499000 IMGBLDL2 LA R0,$IMAGTCB LOAD PRINTER DTE @G38ESBB Q8500000 CL R0,IMGDTE IMAGE LOAD FUNCTION... @G38ESBB Q8501000 BNE IMGSTPRT BR IF FOR 3800 SETUP @G38ESBB Q8502000 L R1,IMGDCB ADDR IMAGELIB DCB FOR BLDL @G38ESBB Q8503000 BLDL (R1),BUFSTART CONSTRUCT LIST FOR LOAD @G38ESBB Q8504000 SPACE 1 @G38ESBB Q8505000 ***************************************************************@G38ESBB Q8506000 * @G38ESBB Q8507000 * POST BUFFER WITH ERROR IF BLDL FAILED @G38ESBB Q8508000 * @G38ESBB Q8509000 ***************************************************************@G38ESBB Q8510000 SPACE 1 @G38ESBB Q8511000 LTR R15,R15 WAS BLDL SUCCESSFUL @G38ESBB Q8512000 BZ IMGLOAD BRANCH IF YES @G38ESBB Q8513000 MVI BUFECBCC,X'41' POST BUFFER WITH PERM ERROR @G38ESBB Q8514000 B IMGRETN GO TO POST PRPU @G38ESBB Q8515000 SPACE 1 @G38ESBB Q8516000 ***************************************************************@G38ESBB Q8517000 * @G38ESBB Q8518000 * LOAD IMAGE FROM IMAGELIB USING BLDL LIST @G38ESBB Q8519000 * @G38ESBB Q8520000 ***************************************************************@G38ESBB Q8521000 SPACE 1 @G38ESBB Q8522000 IMGLOAD DS 0H * @G38ESBB Q8523000 LM R6,R7,BUFSTART+4 SAVE NAME OF LOADED IMAGE @G38ESBB Q8524000 STM R6,R7,IMGNAME FOR DELETE LATER @G38ESBB Q8525000 LA R0,BUFSTART+4 ADDRESS DESCRIPTOR LIST @G38ESBB Q8526000 L R1,IMGDCB ADDRESS DCB FOR IMAGELIB @G38ESBB Q8527000 LOAD DE=(0),DCB=(1) LOAD REQUESTED IMAGE @G38ESBB Q8528000 LR R2,R0 COPY IMAGE BASE @G38ESBB Q8529000 CLI IMGNAME,C'F' IS THIS AN FCB IMAGE @G38ESBB Q8530000 BNE IMGUCS BRANCH IF NO @G38ESBB Q8531000 EJECT @G38ESBB Q8532000 ***************************************************************@G38ESBB Q8533000 * @G38ESBB Q8534000 * COPY FCB IMAGE FROM LOAD MODULE TO CALLER'S BUFFER @G38ESBB Q8535000 * @G38ESBB Q8536000 ***************************************************************@G38ESBB Q8537000 SPACE 1 @G38ESBB Q8538000 IMGFCB CLC IMGNAME(4),=C'FCB3' 3800 FCB IMAGE... @G38ESBB Q8539000 BE IMGF3800 BR IF YES @G38ESBB Q8540000 MVC BUFSTART(2),0(R2) MOVE FLAG BYTE AND LENGTH @G38ESBB Q8541000 LA R4,BUFSTART+2 START OF IMAGE IN BUFFER @G38ESBB Q8542000 SLR R5,R5 CLEAR REGISTER @G38ESBB Q8543000 IC R5,1(,R2) GET IMAGE LENGTH @G38ESBB Q8544000 LA R6,2(,R2) START OF IMAGE IN LOAD MOD @G38ESBB Q8545000 LR R7,R5 COPY IMAGE LENGTH @G38ESBB Q8546000 TM 2(R2),X'C0' FIRST BYTE DEFINE INDEX... @G38ESBB Q8547000 BNZ IMGFCBI BRANCH IF YES @G38ESBB Q8548000 SPACE 1 @G38ESBB Q8549000 ***************************************************************@G38ESBB Q8550000 * @G38ESBB Q8551000 * NO INDEX BYTE SUPPLIED - DEFAULT TO X'81' @G38ESBB Q8552000 * @G38ESBB Q8553000 ***************************************************************@G38ESBB Q8554000 SPACE 1 @G38ESBB Q8555000 MVI BUFSTART+2,X'81' SET INDEX VALUE OF X'81' @G38ESBB Q8556000 LA R4,1(,R4) INCREMENT BUFFER START ADR @G38ESBB Q8557000 LA R5,1(,R5) GET NEW IMAGE LENGTH @G38ESBB Q8558000 STC R5,BUFSTART+1 STORE INTO BUFFER @G38ESBB Q8559000 IMGFCBI DS 0H * @G38ESBB Q8560000 MVCL R4,R6 MOVE IMAGE TO BUFFER @G38ESBB Q8561000 B IMGDELET GO DELETE LOADED MODULE @G38ESBB Q8562000 SPACE 1 @G38ESBB Q8563000 ***************************************************************@G38ESBB Q8564000 * @G38ESBB Q8565000 * COPY 3800 FCB IMAGE TO CALLER'S BUFFER FOR @G38ESBB Q8566000 * MAPPING PURPOSES @G38ESBB Q8567000 * @G38ESBB Q8568000 ***************************************************************@G38ESBB Q8569000 SPACE 1 @G38ESBB Q8570000 USING PFCB,R7 FCB BUFFER ADDRESSABILITY @G38ESBB Q8571000 SPACE 1 @G38ESBB Q8572000 IMGF3800 LA R7,BUFSTART GET FCB BUFFER ADDRESS @G38ESBB Q8573000 LH R5,6(,R2) GET LENGTH OF FCB @G38ESBB Q8574000 LA R4,7(R5,R2) POINT TO LAST BYTE OF FCB @G38ESBB Q8575000 LA R6,1 INDICATE TO SCAN BACKWARDS @G38ESBB Q8576000 BAL R14,IMGSTRIP STRIP OFF BOTTOM 1/2 INCH @G38ESBB Q8577000 LA R4,8(,R2) POINT TO 1ST USEABLE BYTE @G38ESBB Q8578000 LCR R6,R6 INDICATE TO SCAN FORWARD @G38ESBB Q8579000 BAL R14,IMGSTRIP STRIP OFF TOP 1/2 INCH @G38ESBB Q8580000 STH R5,PFCBLENG SAVE USEABLE FCB LENGTH @G38ESBB Q8581000 LA R1,PFCBSTRT POINT TO USER BUFFER @G38ESBB Q8582000 SPACE 1 @G38ESBB Q8583000 IMGMOVE MVC 0(1,R1),0(R4) MOVE FCB BYTE TO BUFFER @G38ESBB Q8584000 NI 0(R1),PSAVBITS ISOLATE CHANNEL ID @G38ESBB Q8585000 LA R1,1(,R1) POINT TO NEXT BYTE IN BUF @G38ESBB Q8586000 LA R4,1(,R4) POINT TO NEXT BYTE IN FCB @G38ESBB Q8587000 BCT R5,IMGMOVE CONTINUE TO MOVE FCB @G38ESBB Q8588000 B IMGDELET GO DELETE LOAD MODULE @G38ESBB Q8589000 SPACE 1 @G38ESBB Q8590000 ***************************************************************@G38ESBB Q8591000 * @G38ESBB Q8592000 * COPY UCS IMAGE FROM LOAD MODULE TO CALLER'S BUFFER @G38ESBB Q8593000 * @G38ESBB Q8594000 ***************************************************************@G38ESBB Q8595000 SPACE 1 @G38ESBB Q8596000 IMGUCS DS 0H * @G38ESBB Q8597000 IMGL3203 EQU 304 LENGTH OF 3203 IMAGE @G38ESBB Q8597100 IMGL3211 EQU 512 LENGTH OF 3211 IMAGE @G38ESBB Q8597200 MVC BUFSTART(1),0(R2) MOVE FLAG BYTE @G38ESBB Q8598000 LA R4,BUFSTART+1 START OF IMAGE IN BUFFER @G38ESBB Q8599000 LA R5,IMGL3203 SET TO 3203 IMAGE LEN @GZ40627 Q8600000 CLI IMGBYT3,C'3' TEST FOR 3203 IMAGE @G38ESBB Q8601000 BE IMGUCS1 BRANCH IF YES @G38ESBB Q8602000 LA R5,240 SET 1403 IMAGE LENGTH @G38ESBB Q8603000 CLI IMGBYT3,C'1' IS IT SET CORRECTLY @G38ESBB Q8603100 BE IMGUCS1 YES SET OK @G38ESBB Q8603200 LA R5,IMGL3211 SET FOR 3211 @G38ESBB Q8603300 * @G38ESBB Q8603400 * JES2 ONLY INITS 3 TYPES OF IMPACT PRTS GO ON AS 3211 @G38ESBB Q8603500 * @G38ESBB Q8603600 IMGUCS1 SLR R6,R6 CLEAR REGISTER @G38ESBB Q8604000 IC R6,1(,R2) NUMBER OF VERIFY LINES @G38ESBB Q8605000 LA R6,2(R6,R2) START OF IMAGE IN LOAD MOD @G38ESBB Q8606000 LR R7,R5 COPY MODULE LENGTH @G38ESBB Q8607000 MVCL R4,R6 COPY IMAGE TO BUFFER @G38ESBB Q8608000 EJECT @G38ESBB Q8609000 ***************************************************************@G38ESBB Q8610000 * @G38ESBB Q8611000 * DELETE THE LOADED IMAGE MODULE @G38ESBB Q8612000 * @G38ESBB Q8613000 ***************************************************************@G38ESBB Q8614000 SPACE 1 @G38ESBB Q8615000 IMGDELET DS 0H * @G38ESBB Q8616000 DELETE EPLOC=IMGNAME REMOVE MOD FORM LOAD LIST @G38ESBB Q8617000 MVI BUFECBCC,X'7F' POST BUFFER WITH GOOD CC @G38ESBB Q8618000 IMGRETN DS 0H @G38ESBB Q8619000 $$POST TYPE=IMAG,R11=HCT POST HASP PRINT PROCESSOR @G38ESBB Q8620000 B IMGWAIT GO WAIT FOR WORK OR DRAIN @G38ESBB Q8621000 SPACE 1 @G38ESBB Q8622000 ***************************************************************@G38ESBB Q8623000 * @G38ESBB Q8624000 * INTERFACE TO SETPRT (SVC 81) FOR 3800 PRINTERS @G38ESBB Q8625000 * @G38ESBB Q8626000 ***************************************************************@G38ESBB Q8627000 SPACE 1 @G38ESBB Q8628000 IMGSTPRT DS 0H @G38ESBB Q8629000 USING SPPARM-(BUFSTART-BUFDSECT),PBUF SPPARM ADR @G38ESBB Q8630000 MVI SPWRSCDE,0 ASSUME UNKNOWN @OZ46887 Q8630200 MVI SPWRTCDE,4 IMAGE NOT FOUND @OZ46887 Q8630400 SETPRT MF=(E,SPPARM) INVOKE SETPRT SVC @G38ESBB Q8631000 SLR R6,R6 CLEAR REG FOR INSERT @G38ESBB Q8632000 * THIS LINE DELETED BY APAR NUMBER @OZ46887 Q8633000 ICM R6,8,=X'7F' ASSUME NO ERROR @G38ESBB Q8634000 LTR R15,R15 NORMAL RETURN @G38ESBB Q8635000 BZ IMGRETNJ BRANCH IF YES @G38ESBB Q8636000 ICM R6,8,=X'41' SET ERROR POST CODE @G38ESBB Q8637000 SPACE 1 @G38ESBB Q8638000 * FIND LEFT-MOST NON-ZERO BYTE AS THE RETURN CODE @G38ESBB Q8639000 SPACE 1 @G38ESBB Q8640000 IMGSPTRC STCM R15,1,SPWRTCDE SAVE RIGHT-MOST BYTE @G38ESBB Q8641000 SRL R15,8 SHIFT OUT SAVED BYTE @G38ESBB Q8642000 LTR R15,R15 ALL ZEROES LEFT @G38ESBB Q8643000 BNZ IMGSPTRC IF NOT, REPEAT PROCESS @G38ESBB Q8644000 STC R0,SPWRSCDE SAVE REASON CODE @G38ESBB Q8645000 SPACE 1 @G38ESBB Q8646000 IMGRETNJ DS 0H @G38ESBB Q8647000 STCM R6,8,BUFECBCC-BUFDSECT(R3) SET POST CODE @G38ESBB Q8648000 B IMGRETN GO POST PRINT PROC @G38ESBB Q8649000 TITLE 'HASP PRINT/PUNCH SERVICE -- 3800 FCB LOAD' @G38ESBB Q8650000 ***************************************************************@G38ESBB Q8651000 * @G38ESBB Q8652000 * ROUTINE TO SCAN OFF A HALF INCH OF THE FCB IMAGE @G38ESBB Q8653000 * @G38ESBB Q8654000 ***************************************************************@G38ESBB Q8655000 SPACE 1 @G38ESBB Q8656000 IMGSTRIP LA R0,12 GET 24THS IN HALF INCH @G38ESBB Q8657000 SPACE 1 @G38ESBB Q8658000 IMGSTRP2 IC R1,0(,R4) GET AN FCB CODE BYTE @G38ESBB Q8659000 SLL R1,26 ELIMINATE ALL BUT @G38ESBB Q8660000 SRL R1,30 LPI CODE @G38ESBB Q8661000 SLL R1,1 DOUBLE THE VALUE FOR INDEX @G38ESBB Q8662000 SR R4,R6 POINT TO NEXT BYTE TO SCAN @G38ESBB Q8663000 BCTR R5,0 DECREMENT FCB LENGTH @G38ESBB Q8664000 SH R0,LPITABLE(R1) DECR AMT LEFT IN 1/2 INCH @G38ESBB Q8665000 BP IMGSTRP2 LOOP IN HALF INCH NOT DONE @G38ESBB Q8666000 BR R14 RETURN @G38ESBB Q8667000 SPACE 1 @G38ESBB Q8668000 ***************************************************************@G38ESBB Q8669000 * @G38ESBB Q8670000 * THE FOLLOWING TABL IS TO CONVERT THE TWO-BIT LPI CODE @G38ESBB Q8671000 * (LINES-PER-INCH) TO THE NUMBER OF TWENTY-FOURTHS @G38ESBB Q8672000 * OF AN INCH THAT THE LINE WILL TAKE. @G38ESBB Q8673000 * @G38ESBB Q8674000 ***************************************************************@G38ESBB Q8675000 SPACE 1 @G38ESBB Q8676000 LPITABLE DC Y(4,3,4,2) 00=6, 01=8, 10=6, 11=12 @G38ESBB Q8677000 TITLE 'HASP PRINT/PUNCH SERVICE -- ESTAE EXIT ROUTINE' @G38ESBB Q8678000 ***************************************************************@G38ESBB Q8679000 * @G38ESBB Q8680000 * ESTAE EXIT ROUTINE -- REINSTATE SUB-TASK @G38ESBB Q8681000 * @G38ESBB Q8682000 ***************************************************************@G38ESBB Q8683000 SPACE 1 @G38ESBB Q8684000 USING IMGESTAE,R15 PROVIDE LOCAL ADR @G38ESBB Q8685000 USING SDWA,R1 PROVIDE SDWA ADDRESSABILITY @G38ESBB Q8686000 SPACE 1 @G38ESBB Q8687000 IMGESTAE LR R3,R1 ASSUME NO SDWA,GET CMP CODE @G38ESBB Q8688000 LA R4,12 TEST FOR @G38ESBB Q8689000 CLR R0,R4 SDWA PRESENT @G38ESBB Q8690000 BE SKIP760 BR IF NONE -- INFO IN REGS @G38ESBB Q8691000 L R3,SDWAABCC OBTAIN COMPLETION CODE @G38ESBB Q8692000 L R2,SDWAPARM HASPIMAG SAVE AREA ADDRESS @G38ESBB Q8693000 SKIP760 ST R3,IMGABCC-IMGDSECT(,R2) SAVE CC FOR RETRY @G38ESBB Q8694000 CLR R0,R4 WAS AN SDWA PROVIDED... @G38ESBB Q8695000 BE IMGESTA1 BR IF NO @G38ESBB Q8696000 SETRP RC=4,RETADDR=IMGRETRY,FRESDWA=YES FOR RETRY @G38ESBB Q8697000 BR R14 SCHEDULE RETRY ROUTINE @G38ESBB Q8698000 SPACE 1 @G38ESBB Q8699000 IMGESTA1 LA R15,4 INDICATE RETRY ROUTINE PROC @G38ESBB Q8700000 BALR R0,R14 RETURN,R0=RETRY ROUTINE ADR @G38ESBB Q8701000 EJECT @G38ESBB Q8702000 ***************************************************************@G38ESBB Q8703000 * @G38ESBB Q8704000 * ESTAE RETRY ROUTINE -- FOR IMAGE LIBRARY LOADERS, @G38ESBB Q8705000 * CLOSE AND RE-OPEN SYS1.IMAGELIB, AND RETRY FAILING @G38ESBB Q8706000 * LOAD IN CASE OF EXTENDED SYS1.IMAGELIB @G38ESBB Q8707000 * OTHERWISE, INFORM OPERATOR OF ABEND @G38ESBB Q8708000 * RE-ESTABLISH ENVIRONMENT (SAVE, BASE1, BASE2, R3) @G38ESBB Q8709000 * @G38ESBB Q8710000 ***************************************************************@G38ESBB Q8711000 SPACE 1 @G38ESBB Q8712000 USING IMGRETRY,R15 PROVIDE LOCAL ADR @G38ESBB Q8713000 USING BUFDSECT,R3 PROVIDE BUFFER ADR @G38ESBB Q8714000 SPACE 1 @G38ESBB Q8715000 IMGRETRY LR SAVE,R1 HASPIMAG SAVE AREA ADDR @G38ESBB Q8716000 L BASE1,=V(HASP) RESTORE BASE1 @G38ESBB Q8717000 L BASE2,=A(HASPIMAG) RESTORE BASE2 @G38ESBB Q8718000 DROP R15 PICK-UP ADR ON BASE2 @G38ESBB Q8719000 L R15,IMGDTE GET DTE ADDR @G38ESBB Q8719100 USING DTEDSECT,R15 @G38ESBB Q8719200 ICM R15,7,DTEWECB+1 ARE WE POSTED TO END... @G38ESBB Q8719300 BZ IMGDET YES, DON'T ISSUE MESSAGE @G38ESBB Q8719400 DROP R15 @G38ESBB Q8719500 L R3,IMGBUFAD RESTORE BUFFER ADDRESS @G38ESBB Q8720000 LA R1,$IMAGTCB ARE WE AN IMAGE @G38ESBB Q8721000 CL R1,IMGDTE LIBRARY LOADER... @G38ESBB Q8722000 BNE IMGWMSG NO, BRANCH @G38ESBB Q8723000 TM IMGFLAG1,IMGABEND IS THIS SECOND ABEND... @G38ESBB Q8724000 BO IMGWMSG YES, GO WRITE MESSAGE @G38ESBB Q8725000 SPACE 1 @G38ESBB Q8726000 OI IMGFLAG1,IMGABEND INDICATE FIRST ABEND @G38ESBB Q8727000 L R1,IMGDCB GET IMGLIB DCB ADDRESS @G38ESBB Q8728000 LTR R1,R1 WAS IMAGELIB OPENED... @G38ESBB Q8729000 BZ IMGWMSG NO, GO WRITE MESSAGE @G38ESBB Q8730000 SPACE 1 @G38ESBB Q8731000 IMGLIB CLOSE,(1) CLOSE IMAGELIB @G38ESBB Q8732000 MVC IMGDCB,$ZEROS CLEAR DCB ADDRESS @G38ESBB Q8733000 SPACE 1 @G38ESBB Q8734000 IMGLIB OPEN RE-OPEN IMAGELIB @G38ESBB Q8735000 SPACE 1 @G38ESBB Q8736000 ST R1,IMGDCB SAVE IMAGELIB DCB ADDRESS @G38ESBB Q8737000 B IMGBLDL2 GO RE-TRY FAILING LOAD @G38ESBB Q8738000 SPACE 1 @G38ESBB Q8739000 IMGWMSG LA R1,IMGMSG POINT TO MESSAGE AREA @OZ46887 Q8740000 MVC 0(IMGAMSGL,R1),IMGAMSG MOVE IN MESSAGE @OZ46887 Q8740200 UNPK IMGAMCC(,R1),IMGABCC+1(2) INSERT ABEND @G38ESBB Q8740500 OI IMGAMCC+2(R1),X'F0' COMPLETION @G38ESBB Q8741000 TR IMGAMCC(,R1),IMGTRTAB-X'F0' CODE @G38ESBB Q8741500 L R3,IMGDTE ADDRESS DTE @G38ESBB Q8742000 TM 0(R3),X'80' WAS SUBTASK INITIALIZED... @G38ESBB Q8742500 BO IMGRDCT YES, BRANCH @G38ESBB Q8743000 MVC IMGAMDN(8,R1),=CL8'INITIAL' SET SPECIAL DEVNAME @G38ESBB Q8743500 $$WTO (R1) WRITE MESSAGE @G38ESBB Q8744000 B IMGNACTV BRANCH TO POST ATTACHER @G38ESBB Q8744500 SPACE 1 @G38ESBB Q8745000 IMGRDCT L R3,IMGBUFAD RESTORE BUFFER ADDRESS @G38ESBB Q8745500 L R2,BUFDCT ADDRESS DCT @G38ESBB Q8746000 MVC IMGAMDN(8,R1),DCTDEVN-DCTDSECT(R2) MOVE DEVNAME @G38ESBB Q8746500 $$WTO (R1) INFORM OPER OF REINSTATE @G38ESBB Q8747000 IMGDET MVI BUFECBCC,X'40' SET ERROR CODE @G38ESBB Q8748000 B IMGRETN GO TO POST PRPU @G38ESBB Q8749000 EJECT @G38ESBB Q8750000 SPACE 5 @G38ESBB Q8751000 PIMAGLST ATTACH EP=HASPIMAG,SM=SUPV,SF=L HASPIMAG ATTACH LIST @G38ESBB Q8752000 PIMAGLL EQU *-PIMAGLST LENGTH OF ATTACH LIST @G38ESBB Q8753000 EJECT @G38ESBB Q8754000 IMGTRTAB DC C'0123456789ABCDEF' HEX TO EBCDIC TRAN TABLE @G38ESBB Q8755000 SPACE 2 @G38ESBB Q8756000 $MID 179 MESSAGE IDENTIFIER @G38ESBB Q8757000 IMGAMSG WTO '&MID.******** IMAGE LOADER SUB-TASK REINSTATED AFTER ABCQ8758000 END (***)',ROUTCDE=(7),DESC=(4),MF=L @G38ESBB Q8759000 IMGAMSGL EQU *-IMGAMSG LENGTH OF ABOVE MESSAGE @G38ESBB Q8760000 IMGAMDN EQU IMGAMSGL-4-59,L'DCTDEVN DEVICE NAME INSERT @G38ESBB Q8761000 IMGAMCC EQU IMGAMSGL-4-4,3 ABEND COMP CODE INSERT @G38ESBB Q8762000 SPACE 3 @G38ESBB Q8763000 IMGABND ESTAE IMGESTAE,RECORD=YES,MF=L ESTAE PARAMETER LIST @G38ESBB Q8764000 IMGABNDL EQU *-IMGABND LENGTH OF ABOVE @G38ESBB Q8765000 SPACE 2 @G38ESBB Q8766000 IMGDSECT DSECT SAVE AREA DSECT @G38ESBB Q8767000 IMGSAV DS 18F IMAGE LOADER SAVE AREA @G38ESBB Q8768000 IMGNAME DS 2F NAME OF LOADED MODULE @G38ESBB Q8769000 IMGBYT3 EQU IMGNAME+3 IMAGE NAME PREFIX BYTE @G38ESBB Q8769500 IMGDCB DS F ADDRESS OF IMAGELIB DCB @G38ESBB Q8770000 IMGBUFAD DS F BUFFER ADDRESS FOR ESTAE @G38ESBB Q8771000 IMGABCC DS F ABEND COMP CODE FOR RETRY @G38ESBB Q8772000 IMGDTE DS F ADDRESS OF OUR DTE @G38ESBB Q8773000 IMGMSG DS CL80 MESSAGE AREA @G38ESBB Q8773500 IMGFLAG1 DS X IMAGE LOADER FLAG BYTE @G38ESBB Q8774000 IMGABEND EQU B'10000000' IMAGE LOADER ABEND FLAG @G38ESBB Q8775000 IMGSWLEN EQU *-IMGDSECT LENGTH OF SAVE/WORK AREA @G38ESBB Q8776000 SPACE 1 @G38ESBB Q8777000 HASPPRPU CSECT END OF SAVE AREA DSECT @G38ESBB Q8778000 ***************************************************************@G38ESBB Q8779000 * @G38ESBB Q8780000 * FCB FORMAT @G38ESBB Q8781000 * @G38ESBB Q8782000 ***************************************************************@G38ESBB Q8783000 SPACE 1 @G38ESBB Q8784000 PFCB DSECT FCB MAPPING DSECT @G38ESBB Q8785000 PFCBLENG DS H LENGTH OF FCB @G38ESBB Q8786000 PFCBFLG1 DS X FLAG BYTE @G38ESBB Q8787000 SPACE 1 @G38ESBB Q8788000 PFCBNOSP EQU B'10000000' WRITE-NO-SPACE INDICATOR @G38ESBB Q8789000 SPACE 1 @G38ESBB Q8790000 PFCBFLG2 DS X FLAG BYTE @G38ESBB Q8791000 PFCBSTRT DS 0F START OF FCB BYTES @G38ESBB Q8792000 SPACE 1 @G38ESBB Q8793000 HASPPRPU CSECT END OF FCB MAPPING DSECT @G38ESBB Q8794000 LTORG IMAGE LOADER LITERAL POOL @G38ESBB Q8795000 SPACE 5 @G38ESBB Q8796000 $DLENGTH $DLENGTH COMPUTE CONTROL SECT LENGTH @G38ESBB Q8797000 APARNUM DC CL5'58883' APAR NUMBER Q8797998 END , @G38ESBB Q8798000