INIT TITLE 'HASP INITIALIZATION -- PROLOG' M0000500 *********************************************************************** M0001000 * * M0001500 * MODULE NAME = HASJES20 ( HASPINIT CSECT ) * M0002000 * * M0002500 * DESCRIPTIVE NAME = HASPINIT CSECT OF JES2 MAIN MODULE * M0003000 * * M0003500 * COPYRIGHT = NONE * M0004100 * * M0004700 * STATUS = OS/VS2 MVS -- SEE &VERSION (BELOW) FOR JES2 LEVEL * M0005000 * * M0005500 * FUNCTION = THE HASPINIT CSECT INITIALIZES THE JES2 SUBSYSTEM AND * M0006000 * SUBSYSTEM INTERFACES AND RETURNS CONTROL TO HASPNUC. * M0006500 * THE FUNCTIONS OF THIS MODULE ARE AS FOLLOWS -- * M0007000 * * M0007500 * 1. TO OBTAIN THE INITIALIZATION OPTIONS FROM THE * M0008000 * OPERATOR OR FROM THE PARM PARAMETER ON THE EXEC * M0008500 * CARD AND CONVERT THE OPTIONS SPECIFIED INTO STATUS * M0009000 * BITS. * M0009500 * * M0010000 * 2. TO READ AND PROCESS THE JES2 INITIALIZATION * M0010500 * PARAMETER DATA SET. * M0011000 * * M0011500 * 3. TO SCAN THE DIRECT ACCESS DEVICES AND TO IDENTIFY * M0012000 * AND ALLOCATE THE ELIGIBLE SPOOLING VOLUMES. * M0012500 * * M0013000 * 4. TO EXAMINE AND INITIALIZE THE SPOOLING VOLUMES * M0013500 * FOR JES2 PROCESSING. * M0014000 * * M0014500 * 5. TO CONSTRUCT AND INITIALIZE THE SUBSYSTEM INTER- * M0015000 * FACE CONTROL BLOCKS, SUCH AS THE SSCT AND SSVT. * M0015500 * * M0016000 * 6. TO SCAN THE UNIT RECORD DEVICES AND REMOTE JOB * M0016500 * ENTRY LINES, AND TO LOCATE AND ALLOCATE THE * M0017000 * ELIGIBLE AND/OR SPECIFIED DEVICES TO JES2. * M0017500 * * M0018000 * 7. TO ATTACH THE JES2 SUB-TASKS, AND TO LOCATE THE * M0018500 * EXIT ROUTINES. * M0019000 * * M0019500 * 8. TO INITIATE SMF PROCESSING BY GENERATING A TYPE 47 * M0020000 * SMF RECORD. * M0020500 * * M0021000 * 9. TO CREATE, OR OBTAIN FROM SPOOL, THE JES2 JOB * M0021500 * QUEUE AND JOB OUTPUT TABLE. * M0022000 * * M0022500 * 10. TO CONSTRUCT AND/OR INITIALIZE THE JES2 CONTROL * M0023000 * BLOCKS, SUCH AS THE HCT, THE DCT'S, THE DCB'S, THE * M0023500 * DEB'S, THE BUFFERS, ETC. * M0024000 * * M0024500 * * M0025000 * * M0025500 * * M0026000 * * M0026500 * * M0027000 * * M0027500 * NOTES = SEE BELOW * M0028000 * * M0028500 * DEPENDENCIES = EXCP ACCESS METHOD * M0029000 * DYNAMIC ALLOCATION * M0029500 * DIRECT-ACCESS DEVICE SPACE MANAGEMENT * M0030000 * MVS SUBSYSTEM INTERFACES * M0030500 * MISCELLANEOUS STANDARD SUPERVISOR SERVICES * M0031000 * * M0031500 * RESTRICTIONS = NONE * M0032000 * * M0032500 * REGISTER CONVENTIONS = R0 = WORK REGISTER * M0033000 * R1 = WORK REGISTER * M0033500 * R2 = WA = WORK REGISTER * M0034000 * R3 = WB = WORK REGISTER * M0034500 * R4 = WC = WORK REGISTER * M0035000 * R5 = WD = WORK REGISTER * M0035500 * R6 = WE = WORK REGISTER * M0036000 * R7 = WF = WORK REGISTER * M0036500 * R8 = BASE3 = BASE/WORK REGISTER * M0037000 * R9 = UNUSED * M0037500 * R10 = JCT = WORK REGISTER * M0038000 * R11 = BASE1 = ADDRESS OF HCT * M0038500 * R12 = BASE2 = LOCAL ADDRESSABILITY * M0039000 * R13 = SAVE = ADDRESS OF SAVE AREA * M0039500 * R14 = LINK = LINK REGISTER * M0040000 * R15 = WORK REGISTER * M0040500 * * M0041000 * PATCH LABEL = NONE * M0041500 * * M0042000 * MODULE TYPE = PROCEDURE, TABLE ( CSECT TYPE ) * M0042500 * * M0043000 * PROCESSOR = ASSEMBLER F * M0043500 * * M0044000 * MODULE SIZE = SEE $DLENGTH MACRO EXPANSION(S) AT END OF ASSEMBLY * M0044500 * * M0045000 * ATTRIBUTES = NOT REUSABLE * M0045500 * * M0046000 * ENTRY POINT = HASPINIT * M0046500 * * M0047000 * PURPOSE = SEE FUNCTION * M0047500 * * M0048000 * LINKAGE = STANDARD OS/VS PROGRAM LINKAGE * M0048500 * * M0049000 * INPUT = R1 = ADDRESS OF JCL EXEC CARD PARAMETER CONTROL BLOCK * M0049500 * R13 = ADDRESS OF SAVE AREA * M0050000 * R14 = RETURN ADDRESS * M0050500 * R15 = ADDRESS OF ENTRY POINT * M0051000 * * M0051500 * OUTPUT = SEE EXIT * M0052000 * * M0052500 * * M0053000 * * M0053500 * * M0054000 * * M0054500 * EXIT-NORMAL = RETURN TO CALLER (HASPNUC) * M0055000 * * M0055500 * EXIT-ERROR = TO SYSTEM VIA BACK CHAINING SAVE AREAS WITH ALL * M0056000 * REGISTERS RESTORED TO ORIGINAL ENTRY VALUES * M0056500 * EXCEPT R15 WHICH CONTAINS A COMPLETION CODE OF 20 * M0057000 * * M0057500 * EXTERNAL REFERENCES = SEE BELOW * M0058000 * * M0058500 * ROUTINES = EXCP, DYNAMIC ALLOCATE, OBTAIN, WTO/WTOR, GETMAIN, * M0059000 * MISCELLANEOUS JES2 SERVICE ROUTINES IN HASPNUC, AND * M0059500 * MISCELLANEOUS STANDARD SUPERVISOR SERVICE ROUTINES * M0060000 * * M0060500 * DATA AREAS = SEE $HASPCB MACRO EXPANSION * M0061000 * * M0061500 * CONTROL BLOCKS = SEE $HASPCB MACRO EXPANSION * M0062000 * * M0062500 * TABLES = NONE * M0063000 * * M0063500 * MACROS = SEE $HASPCB MACRO FOR CONTROL BLOCK MACROS USED * M0064000 * * M0064100 * CHANGE ACTIVITY * M0064200 * * M0064300 * RELEASE 4.0 = OZ00577,OZ02406,OZ03313,OZ03316,OZ04304,OZ04327, * M0064500 * OZ04328,OZ04336,OZ04987,OZ05760,OZ06759,OZ07455, * M0064600 * OZ09023,OZ09027,OZ09068 * M0064700 * * M0064800 * RELEASE 4.1 = OZ10378,OZ11752,OZ11782,OZ11798,OZ11799,OZ11802, * M0064900 * OZ12290,OZ12303,OZ13249,OZ14428,OZ14890,OZ14903, * M0065000 * OZ15293,OZ15839 * M0065100 * @G38ESBB M0065200 * EJE1103 = @G38ESBB 3800 PRINTER ENHANCEMENTS @G38ESBB M0065300 * * M0066500 *********************************************************************** M0067000 TITLE 'HASP INITIALIZATION -- CONTROL BLOCK GENERATION MACRO DCM0067500 EFINITIONS' M0068000 * M0068500 ***** $HASPCB ***** GENERATE HASP CONTROL BLOCKS M0069000 * M0069500 MACRO M0070000 $HASPCB &DOC=NO,&LIST=NO M0070500 GBLC &PRINT,&GEN,&DATA M0071000 PUSH PRINT M0071500 PRINT &PRINT M0072000 $PSA LIST=&LIST GENERATE OS PSA DSECT M0072500 $CVT LIST=&LIST GENERATE OS CVT DSECT M0073000 $JESCT LIST=&LIST GENERATE OS JESCT DSECT M0073500 $SSCT LIST=&LIST GENERATE OS SSCT DSECT M0074000 $SSIB LIST=&LIST GENERATE OS SSIB DSECT M0074500 $ASCB LIST=&LIST GENERATE OS ASCB DSECT M0075000 $ASVT LIST=&LIST GENERATE OS ASVT DSECT M0075500 $SRB LIST=&LIST GENERATE OS SRB DSECT M0076000 $TCB LIST=&LIST GENERATE OS TCB DSECT M0076500 $JSCB LIST=&LIST GENERATE OS JSCB DSECT M0077000 $DCB LIST=&LIST GENERATE OS DCB DSECT M0077500 $DEB LIST=&LIST GENERATE OS DEB DSECT M0078000 $IOSB LIST=&LIST GENERATE OS IOSB DSECT M0078500 $UCB LIST=&LIST GENERATE OS UCB DSECT M0079000 $NEL LIST=&LIST GENERATE OS NEL DSECT R4 M0079500 $UCM LIST=&LIST GENERATE OS UCM DSECT M0080000 $IOCM LIST=&LIST GENERATE OS IOCM DSECT M0080500 $ATB LIST=&LIST GENERATE OS ATB DSECT M0081000 $RPL LIST=&LIST GENERATE OS RPL DSECT R4 M0082000 $CPT DOC=&DOC GENERATE HASP CPT DSECT R41 M0082100 $SMCA LIST=&LIST GENERATE OS SMCA DSECT R4 M0083000 $TED DOC=&DOC GENERATE HASP TED DSECT M0083500 $TGB DOC=&DOC GENERATE HASP TGB DSECT M0084000 $TGM DOC=&DOC GENERATE HASP TGM DSECT M0084500 $TAB DOC=&DOC GENERATE HASP TAB DSECT R4 M0085000 $PCIE DOC=&DOC GENERATE HASP PCIE DSECT R4 M0085500 $SVT DOC=&DOC GENERATE HASP SSVT DSECT M0086000 $HCT DOC=&DOC GENERATE HASP HCT DSECT M0086500 $PCE DOC=&DOC GENERATE HASP PCE DSECT M0087000 $BUFFER DOC=&DOC GENERATE HASP BUFFER DSECT M0087500 $BPM DOC=&DOC GENERATE HASP BPM DSECT R4 M0088000 $CMB DOC=&DOC GENERATE HASP CMB DSECT M0088500 $CCW DOC=&DOC GENERATE HASP CCW DEFS @OZ27300 M0088700 $SMF DOC=&DOC GENERATE HASP SMF DSECT M0089000 $JQE DOC=&DOC GENERATE HASP JQE DSECT M0089500 $JOE DOC=&DOC GENERATE HASP JOE DSECT M0090000 $JOT DOC=&DOC GENERATE HASP JOT DSECT M0090500 $QSE DOC=&DOC GENERATE HASP QSE DSECT M0091000 $JQB DOC=&DOC GENERATE HASP JQB DSECT M0091500 $JCT DOC=&DOC GENERATE HASP JCT DSECT M0092000 $PDDB DOC=&DOC GENERATE HASP PDDB DSECT R4 M0092500 $IOT DOC=&DOC GENERATE HASP IOT DSECT R4 M0093000 $CAT DOC=&DOC GENERATE HASP CAT DSECT M0093500 $SCAT DOC=&DOC GENERATE HASP SCAT DSECT M0094000 $RAT DOC=&DOC GENERATE HASP RAT DSECT M0094500 $RDT DOC=&DOC GENERATE HASP RDT DSECT R4 M0095000 $DCT DOC=&DOC GENERATE HASP DCT DSECT M0095500 $TQE DOC=&DOC GENERATE HASP TQE DSECT R4 M0096000 $CCA DOC=&DOC GENERATE HASP CCA DSECT R4 M0096500 $HQR DOC=&DOC GENERATE HASP HQR DSECT R4 M0097000 $HQT DOC=&DOC GENERATE HASP HQT DSECT R4 M0097500 $PIT DOC=&DOC GENERATE HASP PIT DSECT M0098000 $CSA DOC=&DOC GENERATE HASP CSA DSECT R4 M0098500 $ACT DOC=&DOC GENERATE HASP ACT DSECT R4 M0099000 $FMH DOC=&DOC @OZ29180 M0099100 $ICE DOC=&DOC GENERATE HASP ICE DSECT R4 M0100000 $SPL DOC=&DOC GENERATE HASP SPL DSECT R4 M0104000 $PQH DOC=&DOC GENERATE HASP PQH DSECT @G38ESBB M0104100 $PQE DOC=&DOC GENERATE HASP PQE DSECT @G38ESBB M0104200 $RDRWORK DOC=&DOC GENERATE HASP RDRWORK DSECT R4 M0104500 $CNVWORK DOC=&DOC GENERATE HASP CNVWORK DSECT R4 M0105000 $OUTWORK DOC=&DOC GENERATE HASP OUTWORK DSECT R4 M0105500 $PPPWORK DOC=&DOC GENERATE HASP PPPWORK DSECT R4 M0106000 $COMWORK DOC=&DOC GENERATE HASP COMWORK DSECT M0106500 $MLMWORK DOC=&DOC GENERATE HASP MLMWORK DSECT R4 M0107000 $RCPWORK DOC=&DOC GENERATE HASP RCPWORK DSECT R4 M0107500 $CKPWORK DOC=&DOC GENERATE HASP CKPWORK DSECT R41 M0107600 $WARMWRK DOC=&DOC GENERATE HASP WARMWRK DSECT R4 M0108000 $COM DOC=&DOC,LIST=&LIST GENERATE HASP COM DSECT M0111500 $MODMAP DOC=&DOC GENERATE HASP MODMAP DSECT R4 M0112000 $PTE DOC=&DOC GENERATE HASP PTE DSECT R41 M0112500 POP PRINT R41 M0112600 PRINT &GEN,&DATA SET ASSEMBLY PRINT OPTIONS R41 M0112700 MEND R41 M0112800 EJECT R41 M0112900 * R41 M0113000 ***** $PTE ***** MAP PARAMETER TABLE ENTRY R41 M0113100 * R41 M0113200 * R41 M0113300 SPACE 1 R41 M0113400 MACRO R41 M0113500 $PTE &DOC=NO R41 M0113600 TITLE 'HASP PARAMETER TABLE ENTRY (PTE) DSECT' R41 M0113700 PTEDSECT DSECT PARAMETER TABLE ENTRY DSECT R41 M0113800 PTEKEY DS CL8 KEYWORD R41 M0113900 PTEKEYLN DS AL1 KEYWORD LENGTH R41 M0114000 PTEFLDLN DS AL1 FIELD LENGTH R41 M0114100 PTEDISPL DS Y FIELD DISPLACEMENT R41 M0114200 PTEFLG1 DS X ENTRY FLAGS R41 M0114300 PTEPRTN DS AL3 PROCESSING ROUTINE ADDRESS R41 M0114400 PTEFLG2 DS X RESERVED FOR FUTURE USE R41 M0114500 PTEDRTN DS AL3 DISPLAY ROUTINE ADDRESS R41 M0114600 PTELOVAL DS 0H LOWER LIMIT / MINIMUM LENGTH R41 M0114700 PTESWNO DS B BINARY SWITCH 'OFF' INFO R41 M0114800 PTESWYES DS B BINARY SWITCH 'ON' INFO R41 M0114900 DS H RESERVED FOR FUTURE USE R41 M0115000 PTEHIVAL DS F UPPER LIMIT / MAXIMUM LENGTH R41 M0115100 PTELENG EQU *-PTEDSECT PARAMETER TABLE ENTRY LENGTH R41 M0115200 &SYSECT CSECT END OF PTE DSECT R41 M0115300 SPACE 3 R41 M0115400 * R41 M0115500 * PTEFLG1 R41 M0115600 * R41 M0115700 SPACE 1 R41 M0115800 PTE1SHOW EQU X'80' FIELD VALUE IS DISPLAYABLE R41 M0115900 PTE1OPT EQU X'40' ENTRY DEFINES BINARY SWITCH R41 M0116000 PTE1NUM EQU X'20' FIELD VALUE IS NUMERIC R41 M0116100 PTE1CHAR EQU X'10' FIELD VALUE IS EBCDIC R41 M0116200 PTE1SUB EQU X'08' STATEMENT CONTAINS SUBPARAMETERS R41 M0116300 PTE1IMSG EQU X'04' WARNING MSG HAS BEEN ISSUED @OZ39639 M0116400 PTE1RSV6 EQU X'02' RESERVED FOR FUTURE USE R41 M0116500 PTE1RSV7 EQU X'01' RESERVED FOR FUTURE USE R41 M0116600 MEND R41 M0116700 TITLE 'HASP INITIALIZATION -- TABLE AND ELEMENT GENERATION MACCM0116800 RO DEFINITIONS' R41 M0116900 * M0117000 ***** $SCNTBL ***** GENERATE SCAN TABLE ENTRY M0117100 * M0117200 * M0117300 MACRO M0117400 &NAME $SCNTBL &CODE,&MASK,&DISP,&FLAGS,&RTN @OZ29180 M0117500 GBLC &PRINT,&SCNBASE M0118000 LCLC &KEY M0118500 AIF ('&RTN' NE '').EE @OZ29180 M0118600 AIF ('&MASK' NE '').B M0119000 AIF ('&NAME' EQ '').F M0119500 AIF ('&PRINT' NE 'OFF').A M0120000 PUSH PRINT M0120500 PRINT NOGEN M0121000 .A ANOP M0121500 &NAME DS 0F M0122000 &SCNBASE SETC '&CODE' SET OUTPUT TABLE BASE M0122500 MEXIT M0123000 .B AIF ('&NAME' EQ '').C M0123500 &NAME DS 0F M0124000 .C AIF ('&FLAGS' EQ '').D M0124500 &KEY SETC ' &CODE'(K'&CODE+1,8) M0125000 DC CL8'&KEY',AL1(&FLAGS,0),AL2(&DISP-&SCNBASE) @OZ29180 M0125500 DC AL1(&MASK),AL3(0),AL4(0) @OZ40627 M0125600 MEXIT M0126000 .D AIF ('&CODE(1)' EQ '').E M0126500 &KEY SETC ' &CODE(1)'(K'&CODE(1)+1,8) M0127000 DC CL8'&KEY',AL1(NSCFLMSK,0),AL2(&DISP-&SCNBASE) @OZ29180 M0127500 DC AL1(&MASK),AL3(0),AL4(0) @OZ40627 M0127600 .E AIF (N'&CODE LE 1).G M0128000 &KEY SETC ' &CODE(2)'(K'&CODE(2)+1,8) M0128500 DC CL8'&KEY',AL1(NSCFLCOM,0),AL2(&DISP-&SCNBASE) @OZ29180 M0129000 DC AL1(&MASK),AL3(0),AL4(0) @OZ40627 M0129100 MEXIT M0129500 .EE AIF ('&MASK' NE '').EEE @OZ40627 M0129600 &KEY SETC ' &CODE'(K'&CODE+1,8) @OZ29180 M0129700 DC CL8'&KEY',AL1(0,NSCFLRTN),AL3(0),AL3(&RTN),AL4(0) Z40627 M0129800 MEXIT @OZ29180 M0129900 .EEE ANOP @OZ40627 M0129910 &KEY SETC ' &CODE'(K'&CODE+1,8) @OZ40627 M0129920 DC CL8'&KEY',AL1(0,NSCFLRTN),AL2(&DISP-&SCNBASE) @OZ40627 M0129930 DC AL1(&MASK),AL3(&RTN),AL2(&FLAGS-&SCNBASE),AL2(0) Z40627 M0129940 MEXIT @OZ40627 M0129950 .F DC X'FF' INDICATE END OF SCAN TABLE M0130000 AIF ('&PRINT' NE 'OFF').G M0130500 POP PRINT M0131000 .G MEND M0131500 EJECT R41 M0131600 * R41 M0131700 ***** $PTENT ***** GENERATE PARAMETER TABLE ENTRY R41 M0131800 * R41 M0131900 * R41 M0132000 MACRO R41 M0132100 &NAME $PTENT &LNG,&KEY,&RTN,&FLGS,&FLN,&LOC,&RANGE,&FLAG=, R41CM0132200 &DISPLAY=0 R41 M0132300 GBLC &PRINT R41 M0132400 LCLA &A,&KL R41 M0132500 LCLC &C,&D,&FL,&FLX,&LOCN,&N,&O,&OPT,&R,&S,&SHOW R41 M0132600 &FL SETC '0' R41 M0132700 &LOCN SETC '0' R41 M0132800 AIF ('&KEY' EQ '').K MUST SUPPLY KEYWORD R41 M0132900 &KL SETA K'&KEY SET DEFAULT KEY LENGTH R41 M0133000 AIF ('&DISPLAY' EQ '0').A BR IF NO DISPLAY ROUTINE R41 M0133100 &D SETC '+PTE1SHOW' INDICATE DISPLAYABLE R41 M0133200 .A AIF ('&KEY'(1,2) NE '&&').B BR IF NOT &&... R41 M0133300 &KL SETA &KL-1 COUNT ONLY 1 & R41 M0133400 &D SETC '+PTE1SHOW' INDICATE DISPLAYABLE R41 M0133500 &N SETC '+PTE1NUM' INDICATE NUMERIC R41 M0133600 &R SETC 'NPLNUM' DEFAULT FOR NUMERIC R41 M0133700 &SHOW SETC 'NPLSHNUM' DEFAULT FOR NUMERIC DISPLAY R41 M0133800 .B AIF ('&LNG' EQ '').C BR IF LENGTH NOT SPECIFIED R41 M0133900 &KL SETA &LNG USE SUPPLIED KEY LENGTH R41 M0134000 .C AIF (&A EQ N'&FLGS).J BR IF ALL SUBPARMS PROCESSED R41 M0134100 &A SETA &A+1 COUNT TO NEXT SUBPARAMETER R41 M0134200 AIF ('&FLGS(&A)' NE 'SHOW').D R41 M0134300 &D SETC '+PTE1SHOW' INDICATE DISPLAYABLE R41 M0134400 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0134500 .D AIF ('&FLGS(&A)' NE 'NOSHOW').E R41 M0134600 &D SETC '' INDICATE NOT DISPLAYABLE R41 M0134700 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0134800 .E AIF ('&FLGS(&A)' NE 'EBCDIC').F R41 M0134900 &C SETC '+PTE1CHAR' INDICATE EBCDIC FIELD R41 M0135000 &N SETC '' INDICATE NOT NUMERIC R41 M0135100 &R SETC 'NPLCHAR' DEFAULT FOR EBCDIC R41 M0135200 &SHOW SETC 'NPLSHCH' DEFAULT FOR EBCDIC DISPLAY R41 M0135300 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0135400 .F AIF ('&FLGS(&A)' NE 'NUMERIC').G R41 M0135500 &N SETC '+PTE1NUM' INDICATE NUMERIC R41 M0135600 &C SETC '' INDICATE NOT EBCDIC R41 M0135700 &R SETC 'NPLNUM' DEFAULT FOR NUMERIC R41 M0135800 &SHOW SETC 'NPLSHNUM' DEFAULT FOR NUMERIC DISPLAY R41 M0135900 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0136000 .G AIF ('&FLGS(&A)' NE 'SWITCH').H R41 M0136100 &O SETC '+PTE1OPT' INDICATE BINARY SWITCH R41 M0136200 &N SETC '' INDICATE NOT NUMERIC R41 M0136300 &C SETC '' INDICATE NOT EBCDIC R41 M0136400 &R SETC 'NPLSWICH' DEFAULT FOR BINARY SWITCH R41 M0136500 &SHOW SETC 'NPLSHOPT' DEFAULT FOR BINARY SW DISPLAY R41 M0136600 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0136700 .H AIF ('&FLGS(&A)' NE 'SUBPARMS').I R41 M0136800 &C SETC '' INDICATE NOT EBCDIC R41 M0136900 &N SETC '' INDICATE NOT NUMERIC R41 M0137000 &O SETC '' INDICATE NOT SWITCH R41 M0137100 AGO .C BR TO TEST NEXT SUBPARAMETER R41 M0137200 .I MNOTE 8,'INVALID PARAMETER SPECIFICATION' R41 M0137300 MEXIT R41 M0137400 .J AIF ('&N' NE '').K BR IF NUMERIC R41 M0137500 AIF ('&C' EQ '').M BR IF NOT EBCDIC R41 M0137600 AIF ('&RANGE' EQ '').N BR IF DEFAULT LIMITS R41 M0137700 .K AIF (N'&RANGE EQ 2).N BR IF LOWER/UPPER LIMITS R41 M0137800 .L MNOTE 8,'MISSING (SUB)PARAMETER' R41 M0137900 MEXIT R41 M0138000 .M AIF ('&O' NE '').N BR IF BINARY SWITCH R41 M0138100 &S SETC '+PTE1SUB' INDICATE PARM HAS SUBPARAMETERS R41 M0138200 &SHOW SETC '0' DEFAULT FOR SUBPARAMETER DISPLAY R41 M0138300 AIF ('&RTN' EQ '').L PARM WITH SUBPARMS REQUIRES RTN R41 M0138400 .N AIF ('&RTN' EQ '').P BR IF RTN NOT SPECIFIED R41 M0138500 &R SETC '&RTN' USE SUPPLIED ROUTINE ADDRESS R41 M0138600 .P AIF ('&S' NE '').T BR IF SUBPARAMETERS R41 M0138700 AIF ('&LOC' EQ '0').T BR IF ADDR TO BE SET LATER R41 M0138800 &LOCN SETC '&KEY'(3,K'&KEY-2) STRIP OFF AMPERSANDS R41 M0138900 &LOCN SETC '$&LOCN' REPLACE WITH $ R41 M0139000 AIF ('&O' EQ '').R BR IF NOT BINARY SWITCH R41 M0139100 &OPT SETC '&LOCN' DEFAULT FOR SWITCH 'ON' R41 M0139200 AIF ('&FLAG' EQ '').Q BR IF FLAG NOT SPECIFIED R41 M0139300 &OPT SETC '&FLAG' USE SUPPLIED FLAG R41 M0139400 .Q AIF ('&LOC' EQ '').L MUST SPECIFY FIELD FOR SWITCH R41 M0139500 .R AIF ('&LOC' EQ '').S BR IF FIELD NOT SPECIFIED R41 M0139600 &LOCN SETC '&LOC' USE SUPPLIED FIELD NAME R41 M0139700 .S ANOP R41 M0139800 &FL SETC 'L''&LOCN' DEFAULT FIELD LENGTH R41 M0139900 &LOCN SETC '&LOCN.-HCTDSECT' CONVERT TO FIELD OFFSET IN HCT R41 M0140000 .T AIF ('&FLN' EQ '').U BR IF FLD LENGTH NOT SPECIFIED R41 M0140100 &FL SETC '&FLN' USE SUPPLIED FIELD LENGTH R41 M0140200 .U AIF ('&DISPLAY' EQ '0').V BR IF NO SPECIAL DISPLAY RTN R41 M0140300 &SHOW SETC '&DISPLAY' USE SUPPLIED DISPLAY RTN ADDR R41 M0140400 .V ANOP R41 M0140500 &NAME DC CL8'&KEY',AL1(&KL) R41 M0140600 DC AL1(&FL),Y(&LOCN) R41 M0140700 &FLX SETC '&D&O&N&C&S' R41 M0140800 &FLX SETC '&FLX'(2,K'&FLX-1) R41 M0140900 DC AL1(&FLX),AL3(&R) R41 M0141000 DC AL1(0),AL3(&SHOW) R41 M0141100 AIF ('&O' EQ '').X BR IF NOT BINARY SWITCH R41 M0141200 DC AL1(255-&OPT,&OPT),AL2(0),A(0) R41 M0141300 MEXIT R41 M0141400 .X AIF ('&S' NE '').Z BR IF SUBPARAMETERS R41 M0141500 AIF ('&C' EQ '' OR '&RANGE' NE '').Y R41 M0141600 DC AL2(&FL,0),A(&FL) R41 M0141700 MEXIT R41 M0141800 .Y ANOP R41 M0141900 DC AL2(&RANGE(1),0),A(&RANGE(2)) R41 M0142000 MEXIT R41 M0142100 .Z ANOP R41 M0142200 DC AL2(0,0),A(0) R41 M0142300 MEND R41 M0142400 TITLE 'HASP INITIALIZATION -- LOCAL EXECUTABLE MACRO DEFINITIONS' R4 M0142500 * R4 M0142600 ***** $$WTOR ***** ISSUE QUERY TO OPERATOR R4 M0142700 * R4 M0142800 * R4 M0142900 MACRO R4 M0143000 &NAME $$WTOR &MSG R4 M0143100 &NAME $$WTO &MSG USE $$WTO ROUTINE FOR $$WTOR'S R4 M0143200 MEND R4 M0143300 SPACE 5 R4 M0143400 * R4 M0143500 ***** $$WTO ***** ISSUE MESSAGE TO OPERATOR R4 M0143600 * R4 M0143700 * R4 M0143800 MACRO R4 M0143900 &NAME $$WTO &MSG R4 M0144000 LCLC &N R4 M0144100 AIF ('&MSG' EQ '(R1)').B R4 M0144200 AIF ('&MSG'(1,1) NE '(').A R4 M0144300 &NAME LR R1,&MSG(1) RELOAD MESSAGE ADDRESS R4 M0144400 AGO .C R4 M0144500 .A ANOP R4 M0144600 &NAME L R1,=A(&MSG) POINT TO MESSAGE R4 M0144700 AGO .C R4 M0144800 .B ANOP R4 M0144900 &N SETC '&NAME' R4 M0145000 .C ANOP R4 M0145100 &N L R15,=A(NWTORTN) POINT TO $$WTO/$$WTOR SETUP RTN R4 M0145500 BALR R14,R15 PROCESS $$WTO/$$WTOR REQUEST R4 M0146000 MEND R4 M0146500 EJECT R4 M0147000 * R4 M0147500 ***** $EXIT ***** EXIT ABNORMALLY FROM HASPINIT R4 M0148000 * R4 M0148500 * R4 M0149000 MACRO R4 M0149500 &NAME $EXIT &MSG R4 M0150000 LCLC &N R4 M0150500 AIF ('&MSG' EQ '(R1)').B R4 M0151000 AIF ('&MSG'(1,1) NE '(').A R4 M0151500 &NAME LR R1,&MSG(1) RELOAD MESSAGE ADDRESS R4 M0152000 AGO .C R4 M0152500 .A ANOP R4 M0153000 &NAME L R1,=A(&MSG) POINT TO MESSAGE R4 M0153500 AGO .C R4 M0154000 .B ANOP R4 M0154500 &N SETC '&NAME' R4 M0155000 .C ANOP R4 M0155500 &N L R15,=A(NERRORET) GET ERROR EXIT ROUTINE ADDRESS R4 M0156000 BR R15 AND BR TO EXIT R4 M0156500 MEND R4 M0157000 TITLE 'HASP INITIALIZATION' M0157500 SPACE 5 M0158000 HASPINIT START 0 HASP INITIALIZATION MODULE R4 M0158500 SPACE 5 M0159000 COPY $HASPGEN COPY HASPGEN PARAMETERS M0159500 TITLE 'HASP INITIALIZATION OPTIONS' M0160000 SPACE 5 M0160500 * M0161000 * STANDARD DEFAULT INITIALIZATION PARAMETERS M0161500 * M0162000 SPACE 3 M0162500 $OPTSTD EQU $OPTNFMT+$OPTWARM+$OPTREQ+$OPTLIST+$OPTLOG R41 M0162600 SPACE 5 R41 M0162700 * R41 M0162800 * AUXILLIARY REGISTER DEFINITIONS R41 M0162900 * R41 M0163000 SPACE 3 R41 M0163100 BASE4 EQU R10 PROCESSOR ADDRESSABILITY REGISTER M0163200 TITLE 'HASP CONTROL BLOCKS' M0163500 * M0164000 * DOCUMENTATION OPTIONS FOR THIS ASSEMBLY M0164500 * M0165000 SPACE 3 M0165500 $SYSPARM (OFF,GEN,NODATA,NO,NO) M0166000 SPACE 5 M0166500 * M0167000 * GENERATE HASP CONTROL BLOCKS M0167500 * M0168000 SPACE 3 M0168500 $HASPCB DOC=&DOC,LIST=&LIST GENERATE HASP CONTROL BLOCKS M0169000 TITLE 'HASP INITIALIZATION -- BASE1 ADDRESS TABLE' R4 M0169500 SPACE 5 R4 M0170000 *********************************************************************** M0170500 * * M0171000 * BASE1 (HCT) ADDRESS TABLE * M0171500 * * M0172000 *********************************************************************** M0172500 SPACE 3 R4 M0173000 HCTDSECT DSECT RE-OPEN HCT DSECT R4 M0173500 SPACE 1 R4 M0174000 ORG $EWQ1 REDEFINE PROCESSOR QUEUES R4 M0174500 SPACE 2 R4 M0175000 INITDBL DS D DOUBLE WORD WORK AREA R4 M0175500 TEDSTART DC A(*-*) ADDRESS OF TEMPORARY TEDS R4 M0176000 $RAT DC A(*-*) ADDRESS OF TEMPORARY RAT R4 M0176500 $RWT DC A(*-*) ADDRESS OF REMOTE WORK TABLE R4 M0177000 NCOMMTAB DC A(*-*) ADDRESS OF 1ST TEMP COMMAND AREA R4 M0177500 NTMPSTOR DC A(*-*) ADDRESS OF TEMPORARY STORAGE R4 M0178000 NDCTSTOR DC A(*-*) ADDR OF TEMPORARY DCT STORAGE R4 M0178500 * THIS CARD DELETED BY APAR @OZ20010 M0179000 $NDQ DS A ADDRESS OF FIRST NDQ R4 M0179500 NLOGLINE DC F'0' COUNT OF UNIT=SNA LINES R4 M0180500 SPACE 2 R4 M0181500 HASPINIT CSECT END OF BASE1 ADDRESS TABLE R4 M0182000 TITLE 'HASP INITIALIZATION -- INITIAL ENTRY POINT' M0182500 *********************************************************************** M0183000 * * M0183500 * HASPINIT -- INITIAL ENTRY POINT * M0184000 * * M0184500 *********************************************************************** M0185000 SPACE 1 R4 M0185500 HASPINIT $ENTRY CSECT=YES,BASE=R15 PROVIDE HASPINIT ENTRY POINT R4 M0186000 SPACE 1 R4 M0186500 DROP SAVE,R15 KILL INITIAL, PCE ADDRESSABILITY R4 M0187000 USING HASPINIT,BASE2 RE-ESTABLISH ADDRESSABILITY R4 M0187500 SPACE 1 R4 M0188000 STM R14,R12,12(R13) SAVE HASPNUC'S REGISTERS R4 M0188500 LR BASE2,R15 ESTABLISH BASE M0189000 LA R15,NSAVE POINT TO HASPINIT SAVE AREA R4 M0189500 ST R15,8(,R13) STORE FORWARD POINTER M0190000 ST R13,4(,R15) STORE BACKWARD POINTER M0190500 LR R13,R15 SWITCH TO NEW SAVE AREA M0191000 L WB,0(,R1) GET ADDRESS OF PARAMETER FIELD R4 M0191500 SPACE 1 R4 M0192000 PRINT OFF THIS SECTION DELETED BY @OZ55804 M0192500 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0193000 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0193500 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0194000 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0194500 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0195000 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0195500 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0196000 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0196500 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0197000 * THIS LINE DELETED BY APAR NUMBER @OZ55804 M0197500 PRINT ON @OZ55804 M0198000 MVC NOPTPJES+2(1),$CCOMCHR SET ID FOR 'PJES2' R4 M0198500 TITLE 'HASP INITIALIZATION -- OPTION REPLY SCAN' R4 M0199000 *********************************************************************** M0199500 * * M0200000 * SCAN EXEC CARD PARAMETER FIELD OR OPERATOR REPLY * M0200500 * * M0201000 *********************************************************************** M0201500 SPACE 1 R4 M0202000 LH R1,0(,WB) GET LENGTH OF PARAMETER FIELD R4 M0202500 LTR R1,R1 TEST M0203000 BZ NOPTWTOR BRANCH IF NO PARAMETER FIELD M0203500 CL R1,=A(L'NOPTAREA) CHECK LENGTH M0204000 BH NOPTSCN8 ERROR IF TOO LONG M0204500 BCTR R1,0 DECREMENT M0205000 STC R1,*+5 AND SET MOVE LENGTH M0205500 MVC NOPTAREA(*-*),2(WB) MOVE PARM FIELD TO REPLY AREA R4 M0206000 B NOPTSCAN SCAN PARAMETER LIST M0206500 SPACE 1 R4 M0207000 NOPTWTOR MVI NOPTECB,0 CLEAR REPLY ECB R4 M0207500 $$WTOR NOPTMSG1 ASK OPERATOR FOR RUN OPTIONS R4 M0208000 SPACE 1 R4 M0208500 NOPTWAIT WAIT ECB=NOPTECB WAIT FOR REPLY M0209000 SPACE 1 R4 M0209500 NOPTSCAN MVI $OPTSTAT,$OPTSTD SET STANDARD OPTIONS M0210000 LA WA,NOPTAREA-1 PREPARE TO SCAN REPLY M0210500 SPACE 1 R4 M0211000 NOPTSCN1 LM R0,R1,NOPTNULL SCAN NEXT PARAMETER M0211500 LA WB,L'NOPTNULL+1 MAXIMUM KEYWORD LENGTH + 1 R4 M0212000 SPACE 1 R4 M0212500 NOPTSCN2 LA WA,1(WA) ADVANCE TO NEXT CHARACTER M0213000 CLI 0(WA),C',' CHECK FOR COMMA M0213500 BE NOPTSCN3 BRANCH IF COMMA M0214000 CLI 0(WA),C'=' CHECK FOR EQUAL M0214500 BE NOPTSCN5 BRANCH IF EQUAL M0215000 CLI 0(WA),0 CHECK FOR END OF REPLY M0215500 BE NOPTSCN3 BRANCH IF END OF REPLY M0216000 CLI 0(WA),C' ' CHECK FOR BLANK M0216500 BE NOPTSCN2 BRANCH IF BLANK M0217000 OI 0(WA),X'40' CAPITALIZE M0217500 SLDL R0,8 MAKE ROOM IN REGISTERS M0218000 IC R1,0(WA) AND INSERT CHARACTER M0218500 BCT WB,NOPTSCN2 LOOP FOR MAX KEYWORD LENGTH + 1 R4 M0219000 B NOPTSCN8 SYNTAX ERROR - NOTIFY OPERATOR R4 M0219500 SPACE 1 R4 M0220000 NOPTSCN3 TM $OPTSTAT,$OPTPARM TEST FOR HASPPARM= VALUE M0220500 BO NOPTSCN6 BRANCH IF YES M0221000 STM R0,R1,NOPTPARM SAVE PARAMETER M0221500 CLC NOPTPARM,NOPTPJES TEST FOR 'PJES2' R4 M0222000 BE NOPTRET RETURN IMMEDIATELY IF '$PJES2' M0222500 LA WB,NOPTORG-10 PREPARE TO SEARCH OPTION TABLE M0223000 LA WC,(NOPTEND-NOPTORG)/10 WC = NUMBER OF ENTRIES M0223500 EJECT R4 M0224000 NOPTSCN4 LA WB,10(,WB) ADVANCE TO NEXT ENTRY M0224500 CLC 0(8,WB),NOPTPARM SEARCH FOR MATCHING ENTRY M0225000 BE NOPTSCN9 BRANCH IF MATCH FOUND M0225500 BCT WC,NOPTSCN4 SEARCH ENTIRE TABLE M0226000 B NOPTSCN8 NOT FOUND, NOTIFY OPERATOR M0226500 SPACE 1 R4 M0227000 NOPTSCN5 STM R0,R1,NOPTPARM SAVE PARAMETER M0227500 CLC NOPTPARM,=CL8'HASPPARM' CHECK FOR 'HASPPARM=' M0228000 BNE NOPTSCN8 ILLEGAL IF NOT M0228500 OI $OPTSTAT,$OPTPARM INDICATE HASPPARM= SCAN M0229000 B NOPTSCN1 SCAN HASPPARM= VALUE M0229500 SPACE 1 R4 M0230000 NOPTSCN6 CL R1,NOPTNULL CHECK FOR NULL VALUE M0230500 BE NOPTSCN8 ILLEGAL IF NULL M0231000 SPACE 1 R4 M0231500 NOPTSCN7 STM R0,R1,NOPTPARM SAVE VALUE M0232000 SLDL R0,8 LEFT M0232500 IC R1,NOPTNULL JUSTIFY M0233000 CLI NOPTPARM,C' ' ADDING M0233500 BE NOPTSCN7 TRAILING BLANKS M0234000 L R1,=A(HASPPARM) GET ADDRESS OF HASPPARM DCB M0234500 MVC DCBDDNAM-DCBDSECT(,R1),NOPTPARM SET NEW DDNAME M0235000 NI $OPTSTAT,255-$OPTPARM INDICATE PROCESSING COMPLETE M0235500 B NOPTSCNE PROCESS NEXT PARAMETER M0236000 SPACE 1 R4 M0236500 NOPTSCN8 XC NOPTAREA,NOPTAREA ERROR, CLEAR REPLY AREA M0237000 L R1,=A(HASPPARM) RESET HASPPARM DDNAME M0237500 MVC DCBDDNAM-DCBDSECT(,R1),=CL8'HASPPARM' M0238000 MVI NOPTECB,0 CLEAR ECB M0238500 $$WTOR NOPTMSG2 RE-QUERY OPERATOR R4 M0239000 B NOPTWAIT REPEAT PROCEDURE M0239500 SPACE 1 R4 M0240000 NOPTSCN9 OC $OPTSTAT,8(WB) SET OR M0240500 NC $OPTSTAT,9(WB) RESET STATUS BITS M0241000 SPACE 1 R4 M0241500 NOPTSCNE CLI 0(WA),0 TEST FOR END OF REPLY M0242000 BNE NOPTSCN1 BRANCH IF NOT END OF REPLY M0242500 B NCBINIT BR TO NEXT SECTION R4 M0243000 SPACE 1 R4 M0243500 *********************************************************************** M0244000 * * M0244500 * RETURN IMMEDIATELY IF '$PJES2' * M0245000 * * M0245500 *********************************************************************** M0246000 SPACE 1 R4 M0246500 NOPTRET L R13,4(,R13) POINT TO HASPNUC'S SAVE AREA R4 M0247000 L R13,4(,R13) POINT TO SYSTEM'S SAVE AREA R4 M0247500 LM R14,R12,12(R13) RESTORE REGISTERS M0248000 SR R15,R15 SET RETURN CODE M0248500 BR R14 AND RETURN M0249000 EJECT R4 M0249500 DS 0D BOUNDARY ALIGNMENT @OZ20010 M0249900 NSAVE DS 18F HASPINIT SAVE AREA R4 M0250000 NOPTECB DC F'0' ECB FOR WTOR M0250500 NOPTNULL DC 0D'0',CL8' ' NULL PARAMETER M0251000 NOPTPJES DC CL8' *PJES2' USED TO TEST FOR 'PJES2' R4 M0251500 NOPTPARM DS D PARAMETER STORAGE M0252000 SPACE 1 M0252500 NOPTAREA DC XL100'0',X'00' OPTION AREA M0253000 SPACE 1 M0253500 NOPTORG NULL OPTION TABLE M0254000 DC C' FORMAT',AL1($OPTFMT,255-$OPTNFMT) FORMAT M0254500 DC C' NOFMT',AL1($OPTNFMT,255-$OPTFMT) NOFMT M0255000 DC C' COLD',AL1($OPTCOLD,255-$OPTWARM) COLD M0255500 DC C' WARM',AL1($OPTWARM,255-$OPTCOLD) WARM M0256000 DC C' REQ',AL1($OPTREQ,255-$OPTNREQ) REQ M0256500 DC C' NOREQ',AL1($OPTNREQ,255-$OPTREQ) NOREQ M0257000 DC C' LIST',AL1($OPTLIST,255-$OPTNLST) LIST M0257500 DC C' NOLIST',AL1($OPTNLST,255-$OPTLIST) NOLIST M0258000 DC C' LOG',AL1($OPTLOG,255-$OPTNLOG) LOG R41 M0258100 DC C' NOLOG',AL1($OPTNLOG,255-$OPTLOG) NOLOG R41 M0258200 DC C' ALTCKPT',AL1($OPTALTC,FF-$OPTPRMC) ALTCKPT @OZ27300 M0258300 DC C' PRMCKPT',AL1($OPTPRMC,FF-$OPTALTC) PRMCKPT @OZ27300 M0258400 DC C' NONE',AL1(0,FF) NONE @OZ27300 M0258500 DC C' N',AL1(0,255) N M0259000 DC C' U',AL1(0,255) U M0259500 DC C' ',AL1(0,255) NULL M0260000 NOPTEND NULL END OF OPTION TABLE M0260500 TITLE 'HASP INITIALIZATION -- FIXED-LENGTH TABLE INITIALIZATION' R4 M0261000 *********************************************************************** M0261500 * * M0262000 * OBTAIN STORAGE FOR AND INITIALIZE FIXED-LENGTH TABLES * M0262500 * * M0263000 *********************************************************************** M0263500 SPACE 1 R4 M0264000 NCBINIT LA WB,16+40 PTF MAP, SET. TIME PRIO TBL LNS R4 M0264500 LA WB,CCALEN(,WB) CELL CONTROL AREA LENGTH R4 M0265000 LA WB,ACTLEN(,WB) AUTOMATIC COMMAND TABLE LENGTH R4 M0265500 LA WB,CATLEN*64(,WB) CLASS ATTRIBUTE TABLE LENGTH R4 M0266000 LA WB,CSALEN(,WB) CONSOLE SERVICE WORK AREA LENGTH R4 M0266500 LR R0,WB RELOAD FOR GETMAIN R4 M0267000 GETMAIN R,LV=(0) OBTAIN TABLE STORAGE R4 M0267500 LR WA,R1 CLEAR R4 M0268000 SLR WD,WD TABLE R4 M0268500 MVCL WA,WC STORAGE R4 M0269000 ST R1,$PTFMAP SET POINTER TO PTF MAP R4 M0269500 LA R1,16(,R1) STEP OVER PTF MAP R4 M0270000 ST R1,$RTIMTAB SET POINTER TO PRIORITY TABLE R4 M0270500 MVC 0(40,R1),NRTIMTAB INITIALIZE EST. TIME PRIORITY TBL R4 M0271000 LA R1,40(,R1) STEP OVER TABLE R4 M0271500 ST R1,$CCAREA SET POINTER TO CCA R4 M0272000 SPACE 1 R4 M0272500 USING CCADSECT,R1 PROVIDE CCA ADDRESSABILITY R4 M0273000 SPACE 1 R4 M0273500 LA R0,5*60 SET DELETE R4 M0274000 ST R0,CCADELT TIME INTERVAL R4 M0274500 LA R1,CCALEN(,R1) STEP OVER CCA R4 M0275000 SPACE 1 R4 M0275500 ST R1,$ACTABLE SET POINTER TO ACT R4 M0276000 SPACE 1 R4 M0276500 USING ACTDSECT,R1 PROVIDE ACT ADDRESSABILITY R4 M0277000 SPACE 1 R4 M0277500 MVI ACTTQE+IPOST,X'80' PRE-POST TQE R4 M0278000 LA R0,10*60 SET MAXIMUM R4 M0278500 ST R0,ACTMINTV TIME INTERVAL R4 M0279000 LA R0,5*60 SET MAXIMUM R4 M0279500 ST R0,ACTMDELI BACKLOG INTERVAL R4 M0280000 LA R1,ACTLEN(,R1) STEP OVER ACT R4 M0280500 ST R1,$CATABLE SET POINTER TO CAT R4 M0281000 EJECT R4 M0281500 USING CATDSECT,R1 PROVIDE CAT ADDRESSABILITY R4 M0282000 SPACE 1 R4 M0282500 LA R0,X'C9'-X'BF' INITIALIZE R4 M0283000 BAL WE,NONBATCH CAT ENTRIES R4 M0283500 BCT R0,NBATCH C0 - C9 R4 M0284000 SPACE 1 R4 M0284500 LA R0,X'CF'-X'C9' INITIALIZE R4 M0285000 BAL WE,NONBATCH CAT ENTRIES R4 M0285500 BCT R0,NONBATCH CA - CF R4 M0286000 SPACE 1 R4 M0286500 OI CATJOBFL,CATSTCJB INDICATE STARTED TASK CLASS R4 M0287000 BAL WE,NOCATSMF INITIALIZE STC CAT ENTRY D0 R4 M0287500 LA R0,X'D9'-X'D0' INITIALIZE R4 M0288000 BAL WE,NBATCH CAT ENTRIES R4 M0288500 BCT R0,NBATCH D1 - D9 R4 M0289000 SPACE 1 R4 M0289500 LA R0,X'DF'-X'D9' INITIALIZE R4 M0290000 BAL WE,NONBATCH CAT ENTRIES R4 M0290500 BCT R0,NONBATCH DA - DF R4 M0291000 SPACE 1 R4 M0291500 OI CATJOBFL,CATTSUJB INDICATE LOGON CLASS R4 M0292000 OI CATOPSWT,CATTSOP INDICATE TIME-SHARING USER R4 M0292500 BAL WE,NONBATCH INITIALIZE TSU CAT ENTRY E0 R4 M0293000 LA R0,X'E9'-X'E0' INITIALIZE R4 M0293500 BAL WE,NONBATCH CAT ENTRIES R4 M0294000 BCT R0,NBATCH E1 - E9 R4 M0294500 SPACE 1 R4 M0295000 LA R0,X'EF'-X'E9' INITIALIZE CAT R4 M0295500 BAL WE,NONBATCH CAT ENTRIES R4 M0296000 BCT R0,NONBATCH EA - EF R4 M0296500 SPACE 1 R4 M0297000 LA R0,X'F9'-X'EF' INITIALIZE R4 M0297500 BAL WE,NBATCH CAT ENTRIES R4 M0298000 BCT R0,NBATCH F0 - F9 R4 M0298500 SPACE 1 R4 M0299000 LA R0,X'FF'-X'F9' INITIALIZE R4 M0299500 BAL WE,NONBATCH CAT ENTRIES R4 M0300000 BCT R0,NONBATCH FA - FF R4 M0300500 SPACE 1 R4 M0301000 B NCSAINIT THEN BR TO CONTINUE R4 M0301500 SPACE 1 R4 M0302000 NBATCH OI CATJOBFL,CATBATCH INDICATE BATCH JOB CLASS R4 M0302500 SPACE 1 R4 M0303000 NONBATCH OI CATOPSWT,CATSMF INDICATE SMF PROCESSING R4 M0303500 SPACE 1 R4 M0304000 NOCATSMF MVC CATPROCN,=C'000' SET DEFAULT PROCEDURE NAME SUFFIX R4 M0304500 MVC CATPERFM,=C'000' SET DEFAULT PERFORMANCE GROUP R4 M0305000 LA R1,CATEND POINT TO NEXT CAT ENTRY R4 M0305500 BR WE AND RETURN R4 M0306000 EJECT R4 M0306500 NCSAINIT ST R1,$CSAREA SET POINTER TO CSA R4 M0307000 SPACE 1 R4 M0307500 USING CSADSECT,R1 PROVIDE CSA ADDRESSABILITY R4 M0308000 SPACE 1 R4 M0308500 MVI CSALAREA+1,1 SET NUMBER OF LINES R4 M0309000 MVI CSALEVEL+2,X'FF' $T CON SETTINGS FOR R4 M0309500 MVC CSALEVEL+3(7*2-1),CSALEVEL+2 LOGICAL CONSOLES R4 M0310000 B NSETPTF BR TO INITIALIZE PTF MAP R4 M0310500 SPACE 1 R4 M0311000 DROP R1 KILL CSA ADDRESSABILITY R4 M0311500 SPACE 3 R4 M0312000 NRTIMTAB DS 0F R4 M0312500 DC AL1(9),AL3(60*2) FIRST INTERVAL R4 M0313000 DC AL1(8),AL3(30*5) SECOND INTERVAL R4 M0313500 DC AL1(7),AL3(60*15) THIRD INTERVAL R4 M0314000 DC AL1(6),AL3(60*(X'FFFFFF'/60)) FOURTH INTERVAL R4 M0314500 DC AL1(5),AL3(60*(X'FFFFFF'/60)) FIFTH INTERVAL R4 M0315000 DC AL1(4),AL3(60*(X'FFFFFF'/60)) SIXTH INTERVAL R4 M0315500 DC AL1(3),AL3(60*(X'FFFFFF'/60)) SEVENTH INTERVAL R4 M0316000 DC AL1(2),AL3(60*(X'FFFFFF'/60)) EIGHTH INTERVAL R4 M0316500 DC AL1(1),AL3(60*(X'FFFFFF'/60)) NINTH INTERVAL R4 M0317000 DC AL4(X'FFFFFF') R4 M0317500 TITLE 'HASP INITIALIZATION -- MAINTENANCE RECORD INITIALIZATION' M0318000 *********************************************************************** M0318500 * * M0319000 * THE INSTRUCTIONS WHICH FOLLOW WILL BE CHANGED FROM 'CLI' * M0319500 * INSTRUCTIONS TO 'OI' INSTRUCTIONS AS PART OF THE PTF * M0320000 * FIXES WHICH ARE RECORDED AGAINST THIS VERSION OF JES2. * M0320500 * * M0321000 * THE BITS TURNED ON IN THE PTF MAP THUS REFLECT THE PTF * M0321500 * LEVEL OF THE LOAD MODULE. * M0322000 * * M0322500 *********************************************************************** M0323000 SPACE 1 R4 M0323500 NSETPTF L WA,$PTFMAP POINT TO HASP PTF MAP R4 M0324000 SPACE 1 R4 M0324500 CLI 0(WA),X'80' APAR NUMBER 1 R4 M0325000 CLI 0(WA),X'40' APAR NUMBER 2 R4 M0325500 CLI 0(WA),X'20' APAR NUMBER 3 R4 M0326000 CLI 0(WA),X'10' APAR NUMBER 4 R4 M0326500 CLI 0(WA),X'08' APAR NUMBER 5 R4 M0327000 CLI 0(WA),X'04' APAR NUMBER 6 R4 M0327500 CLI 0(WA),X'02' APAR NUMBER 7 R4 M0328000 CLI 0(WA),X'01' APAR NUMBER 8 R4 M0328500 CLI 1(WA),X'80' APAR NUMBER 9 R4 M0329000 CLI 1(WA),X'40' APAR NUMBER 10 R4 M0329500 CLI 1(WA),X'20' APAR NUMBER 11 R4 M0330000 CLI 1(WA),X'10' APAR NUMBER 12 R4 M0330500 CLI 1(WA),X'08' APAR NUMBER 13 R4 M0331000 CLI 1(WA),X'04' APAR NUMBER 14 R4 M0331500 CLI 1(WA),X'02' APAR NUMBER 15 R4 M0332000 CLI 1(WA),X'01' APAR NUMBER 16 R4 M0332500 CLI 2(WA),X'80' APAR NUMBER 17 R4 M0333000 CLI 2(WA),X'40' APAR NUMBER 18 R4 M0333500 CLI 2(WA),X'20' APAR NUMBER 19 R4 M0334000 CLI 2(WA),X'10' APAR NUMBER 20 R4 M0334500 CLI 2(WA),X'08' APAR NUMBER 21 R4 M0335000 CLI 2(WA),X'04' APAR NUMBER 22 R4 M0335500 CLI 2(WA),X'02' APAR NUMBER 23 R4 M0336000 CLI 2(WA),X'01' APAR NUMBER 24 R4 M0336500 CLI 3(WA),X'80' APAR NUMBER 25 R4 M0337000 CLI 3(WA),X'40' APAR NUMBER 26 R4 M0337500 CLI 3(WA),X'20' APAR NUMBER 27 R4 M0338000 CLI 3(WA),X'10' APAR NUMBER 28 R4 M0338500 CLI 3(WA),X'08' APAR NUMBER 29 R4 M0339000 CLI 3(WA),X'04' APAR NUMBER 30 R4 M0339500 CLI 3(WA),X'02' APAR NUMBER 31 R4 M0340000 CLI 3(WA),X'01' APAR NUMBER 32 R4 M0340500 EJECT R4 M0341000 CLI 4(WA),X'80' APAR NUMBER 33 R4 M0341500 CLI 4(WA),X'40' APAR NUMBER 34 R4 M0342000 CLI 4(WA),X'20' APAR NUMBER 35 R4 M0342500 CLI 4(WA),X'10' APAR NUMBER 36 R4 M0343000 CLI 4(WA),X'08' APAR NUMBER 37 R4 M0343500 CLI 4(WA),X'04' APAR NUMBER 38 R4 M0344000 CLI 4(WA),X'02' APAR NUMBER 39 R4 M0344500 CLI 4(WA),X'01' APAR NUMBER 40 R4 M0345000 CLI 5(WA),X'80' APAR NUMBER 41 R4 M0345500 CLI 5(WA),X'40' APAR NUMBER 42 R4 M0346000 CLI 5(WA),X'20' APAR NUMBER 43 R4 M0346500 CLI 5(WA),X'10' APAR NUMBER 44 R4 M0347000 CLI 5(WA),X'08' APAR NUMBER 45 R4 M0347500 CLI 5(WA),X'04' APAR NUMBER 46 R4 M0348000 CLI 5(WA),X'02' APAR NUMBER 47 R4 M0348500 CLI 5(WA),X'01' APAR NUMBER 48 R4 M0349000 CLI 6(WA),X'80' APAR NUMBER 49 R4 M0349500 CLI 6(WA),X'40' APAR NUMBER 50 R4 M0350000 CLI 6(WA),X'20' APAR NUMBER 51 R4 M0350500 CLI 6(WA),X'10' APAR NUMBER 52 R4 M0351000 CLI 6(WA),X'08' APAR NUMBER 53 R4 M0351500 CLI 6(WA),X'04' APAR NUMBER 54 R4 M0352000 CLI 6(WA),X'02' APAR NUMBER 55 R4 M0352500 CLI 6(WA),X'01' APAR NUMBER 56 R4 M0353000 CLI 7(WA),X'80' APAR NUMBER 57 R4 M0353500 CLI 7(WA),X'40' APAR NUMBER 58 R4 M0354000 CLI 7(WA),X'20' APAR NUMBER 59 R4 M0354500 CLI 7(WA),X'10' APAR NUMBER 60 R4 M0355000 CLI 7(WA),X'08' APAR NUMBER 61 R4 M0355500 CLI 7(WA),X'04' APAR NUMBER 62 R4 M0356000 CLI 7(WA),X'02' APAR NUMBER 63 R4 M0356500 CLI 7(WA),X'01' APAR NUMBER 64 R4 M0357000 CLI 8(WA),X'80' APAR NUMBER 65 R4 M0357500 CLI 8(WA),X'40' APAR NUMBER 66 R4 M0358000 CLI 8(WA),X'20' APAR NUMBER 67 R4 M0358500 CLI 8(WA),X'10' APAR NUMBER 68 R4 M0359000 CLI 8(WA),X'08' APAR NUMBER 69 R4 M0359500 CLI 8(WA),X'04' APAR NUMBER 70 R4 M0360000 CLI 8(WA),X'02' APAR NUMBER 71 R4 M0360500 CLI 8(WA),X'01' APAR NUMBER 72 R4 M0361000 CLI 9(WA),X'80' APAR NUMBER 73 R4 M0361500 CLI 9(WA),X'40' APAR NUMBER 74 R4 M0362000 CLI 9(WA),X'20' APAR NUMBER 75 R4 M0362500 CLI 9(WA),X'10' APAR NUMBER 76 R4 M0363000 CLI 9(WA),X'08' APAR NUMBER 77 R4 M0363500 CLI 9(WA),X'04' APAR NUMBER 78 R4 M0364000 CLI 9(WA),X'02' APAR NUMBER 79 R4 M0364500 CLI 9(WA),X'01' APAR NUMBER 80 R4 M0365000 EJECT R4 M0365500 CLI 10(WA),X'80' APAR NUMBER 81 R4 M0366000 CLI 10(WA),X'40' APAR NUMBER 82 R4 M0366500 CLI 10(WA),X'20' APAR NUMBER 83 R4 M0367000 CLI 10(WA),X'10' APAR NUMBER 84 R4 M0367500 CLI 10(WA),X'08' APAR NUMBER 85 R4 M0368000 CLI 10(WA),X'04' APAR NUMBER 86 R4 M0368500 CLI 10(WA),X'02' APAR NUMBER 87 R4 M0369000 CLI 10(WA),X'01' APAR NUMBER 88 R4 M0369500 CLI 11(WA),X'80' APAR NUMBER 89 R4 M0370000 CLI 11(WA),X'40' APAR NUMBER 90 R4 M0370500 CLI 11(WA),X'20' APAR NUMBER 91 R4 M0371000 CLI 11(WA),X'10' APAR NUMBER 92 R4 M0371500 CLI 11(WA),X'08' APAR NUMBER 93 R4 M0372000 CLI 11(WA),X'04' APAR NUMBER 94 R4 M0372500 CLI 11(WA),X'02' APAR NUMBER 95 R4 M0373000 CLI 11(WA),X'01' APAR NUMBER 96 R4 M0373500 CLI 12(WA),X'80' APAR NUMBER 97 R4 M0374000 CLI 12(WA),X'40' APAR NUMBER 98 R4 M0374500 CLI 12(WA),X'20' APAR NUMBER 99 R4 M0375000 CLI 12(WA),X'10' APAR NUMBER 100 R4 M0375500 CLI 12(WA),X'08' APAR NUMBER 101 R4 M0376000 CLI 12(WA),X'04' APAR NUMBER 102 R4 M0376500 CLI 12(WA),X'02' APAR NUMBER 103 R4 M0377000 CLI 12(WA),X'01' APAR NUMBER 104 R4 M0377500 CLI 13(WA),X'80' APAR NUMBER 105 R4 M0378000 CLI 13(WA),X'40' APAR NUMBER 106 R4 M0378500 CLI 13(WA),X'20' APAR NUMBER 107 R4 M0379000 CLI 13(WA),X'10' APAR NUMBER 108 R4 M0379500 CLI 13(WA),X'08' APAR NUMBER 109 R4 M0380000 CLI 13(WA),X'04' APAR NUMBER 110 R4 M0380500 CLI 13(WA),X'02' APAR NUMBER 111 R4 M0381000 CLI 13(WA),X'01' APAR NUMBER 112 R4 M0381500 CLI 14(WA),X'80' APAR NUMBER 113 R4 M0382000 CLI 14(WA),X'40' APAR NUMBER 114 R4 M0382500 CLI 14(WA),X'20' APAR NUMBER 115 R4 M0383000 CLI 14(WA),X'10' APAR NUMBER 116 R4 M0383500 CLI 14(WA),X'08' APAR NUMBER 117 R4 M0384000 CLI 14(WA),X'04' APAR NUMBER 118 R4 M0384500 CLI 14(WA),X'02' APAR NUMBER 119 R4 M0385000 CLI 14(WA),X'01' APAR NUMBER 120 R4 M0385500 CLI 15(WA),X'80' APAR NUMBER 121 R4 M0386000 CLI 15(WA),X'40' APAR NUMBER 122 R4 M0386500 CLI 15(WA),X'20' APAR NUMBER 123 R4 M0387000 CLI 15(WA),X'10' APAR NUMBER 124 R4 M0387500 CLI 15(WA),X'08' APAR NUMBER 125 R4 M0388000 CLI 15(WA),X'04' APAR NUMBER 126 R4 M0388500 CLI 15(WA),X'02' APAR NUMBER 127 R4 M0389000 CLI 15(WA),X'01' APAR NUMBER 128 R4 M0389500 TITLE 'HASP INITIALIZATION -- INITIAL CONTROL BLOCK INITIALIZACM0390000 TION' R4 M0390500 *********************************************************************** M0391000 * * M0391500 * LIMIT &MAXPART UPPER LIMIT TO MAXUSER - 3 * M0392000 * * M0392500 *********************************************************************** M0393000 SPACE 1 R4 M0393500 USING ASVT,WA PROVIDE ASVT ADDRESSABILITY R4 M0394000 USING CVTDSECT,WC PROVIDE CVT ADDRESSABILITY R4 M0394500 SPACE 1 R4 M0395000 L WC,CVTPTR POINT TO CVT R4 M0395500 L WA,CVTASVT POINT TO ASVT R4 M0396000 L R1,ASVTMAXU GET MAXIMUM ADDRESS SPACES R4 M0396500 SH R1,=H'3' LESS 3 FOR MSTR SCHED, ASM, JES2 R4 M0397000 L R15,=A(NMAXPART) POINT TO &MAXPART UPPER LIMIT R4 M0397500 C R1,0(,R15) ENSURE &MAXPART R41 M0398000 BNL SKIP10 NOT GREATER THAN R4 M0398500 ST R1,0(,R15) MAXUSER - 3 R41 M0399000 SPACE 2 R4 M0399500 *********************************************************************** M0400000 * * M0400500 * FIND OUR SUBSYSTEM CVT (SSCT) * M0401000 * * M0401500 *********************************************************************** M0402000 SPACE 1 R4 M0402500 SKIP10 L WA,$HASPTCB PICK UP HASP TCB ADDRESS R4 M0403000 L WA,TCBJSCB-TCB(,WA) POINT TO JSCB R4 M0403500 L WA,JSCBSSIB-JSCB(,WA) POINT TO SSIB R4 M0404000 SPACE 1 R4 M0404500 USING SSIB,WA PROVIDE SSIB ADDRESSABILITY R4 M0405000 SPACE 1 R4 M0405500 LA WD,CVTBRET POINT TO CVT BR 14 M0406000 L WC,CVTJESCT POINT TO JES CONTROL TABLE M0406500 SPACE 1 R4 M0407000 USING JESCT,WC PROVIDE JESCT ADDRESSABILITY R4 M0407500 SPACE 1 R4 M0408000 CLC JESPJESN,SSIBJBID CHECK FOR OUR NAME M0408500 BNE *+8 SKIP IF WE ARE NOT PRIMARY M0409000 OI ISVSTUS,$SVSTUSP SET PRIMARY INDICATOR M0409500 LA WC,JESSSCT-(SSCTSCTA-SSCT) POINT TO SSCT HEAD M0410000 SPACE 1 R4 M0410500 USING SSCT,WC PROVIDE SSCT ADDRESSABILITY R4 M0411000 SPACE 1 R4 M0411500 ISSCTL ICM WC,15,SSCTSCTA POINT TO NEXT SSCT M0412000 BZ INOSSCT IF END, EXIT M0412500 CLC SSCTSNAM,SSIBJBID IS THIS OUR CVT M0413000 BNE ISSCTL LOOP M0413500 EJECT R4 M0414000 *********************************************************************** M0414500 * * M0415000 * OBTAIN THE SSVT (NEW OR OLD) * M0415500 * * M0416000 *********************************************************************** M0416500 SPACE 1 R4 M0417000 USING SSVT,WA PROVIDE SSVT ADDRESSABILITY R4 M0417500 SPACE 1 R4 M0418000 ICM WA,15,SSCTSSVT IS OUR SSVT ALREADY IN M0418500 BNZ INSTART BR IF HASP IS OR HAS BEEN IN M0419000 LA WB,8+SSVTLEN STORAGE FOR SSVT AND PREFIX R4 M0419500 ICM WB,8,=AL1(241) USE CSA SUBPOOL @OZ35996 M0420000 LR R0,WB COPY SP/LENGTH @OZ35996 M0420500 GETMAIN R,LV=(0) GET SSVT AREA M0421000 ST WB,4(,R1) SAVE CURRENT SSVT LENGTH R4 M0421500 LA WA,8(,R1) POINT BEYOND SSVT PREFIX R4 M0422000 SH WB,=H'8' REDUCE LENGTH BY PREFIX LENGTH R4 M0422500 SLR R15,R15 SET COUNT AND PAD TO ZERO M0423000 MVCL WA,R14 ZERO SSVT (L IN WB) M0423500 LA WA,8(,R1) GET ADDRESS OF ACTUAL SSVT M0424000 MVC $SVSTUS,ISVSTUS COPY STATUS BYTE M0424500 B IHAVSSVT SKIP OVER SSVT CLAIM @OZ35278 M0425000 PRINT OFF - SECTION DELETED @OZ35278 M0425500 * THIS CARD DELETED BY APAR @OZ35278 M0426000 * THIS CARD DELETED BY APAR @OZ35278 M0426500 * THIS CARD DELETED BY APAR @OZ35278 M0427000 * THIS CARD DELETED BY APAR @OZ35278 M0427500 * THIS CARD DELETED BY APAR @OZ35278 M0428000 * THIS CARD DELETED BY APAR @OZ35278 M0428500 * THIS CARD DELETED BY APAR @OZ35278 M0429000 * THIS CARD DELETED BY APAR @OZ35278 M0429500 * THIS CARD DELETED BY APAR @OZ35278 M0430000 * THIS CARD DELETED BY APAR @OZ35278 M0430500 * THIS CARD DELETED BY APAR @OZ35278 M0431000 * THIS CARD DELETED BY APAR @OZ35278 M0431500 * THIS CARD DELETED BY APAR @OZ35278 M0432000 * THIS CARD DELETED BY APAR @OZ35278 M0432500 * THIS CARD DELETED BY APAR @OZ35278 M0433000 * THIS CARD DELETED BY APAR @OZ35278 M0433500 * THIS CARD DELETED BY APAR @OZ35278 M0434000 * THIS CARD DELETED BY APAR @OZ35278 M0434500 * THIS CARD DELETED BY APAR @OZ35278 M0435000 * THIS CARD DELETED BY APAR @OZ35278 M0435500 * THIS CARD DELETED BY APAR @OZ35278 M0436000 * THIS CARD DELETED BY APAR @OZ35278 M0436500 * THIS CARD DELETED BY APAR @OZ35278 M0437000 PRINT ON -- SECTION DELETED @OZ35278 M0437500 EJECT R4 M0438000 *********************************************************************** M0438500 * * M0439000 * DETERMINE WHETHER OR NOT HASP CAN COME UP * M0439500 * * M0440000 *********************************************************************** M0440500 SPACE 1 R4 M0441000 INSTART TM $SVSTUS,$SVSTUST CHECK FOR HASP TERMINATED M0441500 BZ INSTRTER EXIT WITH ERROR M0442000 ICM R1,15,$SVHASP TEST HASP CONDITION M0442500 BZ INSTRTER BRANCH IF ACTIVE M0443000 BP *+12 BRANCH IF NOT RESTART M0443500 TM $OPTSTAT,$OPTFMT+$OPTCOLD TEST OPTIONS M0444000 BNZ INSTRTER COLD OR FORMAT ILLEGAL IF RESTART M0444500 TM $SVSTUS,$SVSTRPL HOTSTART ALLOWED... @OZ35996 M0444600 BO INIPLER BR IF NO @OZ35996 M0444700 ICM R1,15,$SVPOSTE POINT TO MASTER HASP ECB R4 M0445000 BZ SKIP20 BR IF NONE YET R4 M0445500 TM $SVPOSTW(R1),X'80' MAY WE START... R4 M0446000 BZ INSTRTER BR IF NO R4 M0446500 SKIP20 L R1,SSVT+ICSWD PICK UP WORD M0447000 ST R1,ISVSTUS SET INTO WORK AREA M0447500 NI ISVSTUS+($SVSTUS-SSVT-ICSWD),255-$SVSTUST TURN OFF TERM M0448000 OI ISVSTUS+($SVSTUS-SSVT-ICSWD),$SVSTUSR SET RESTART FLAG M0448500 L R0,ISVSTUS PICK UP RESULT M0449000 CS R1,R0,SSVT+ICSWD ESTABLISH OWNERSHIP M0449500 BNZ INSTART LOOP IF NOT OWNER M0450000 SPACE 1 R4 M0450500 IHAVSSVT ST WA,$SSVT SET ADDRESS OF SSVT M0451000 L WG,$HASPMAP POINT TO HASP MODULE MAP R4 M0451500 ST WA,MAPSSVTA-MAPDSECT(,WG) SET ADDR FOR REPPING R4 M0452000 ST BASE1,$SVHCT SET ADDRESS OF HASP CONTROL TABLE R4 M0452500 ST WC,$SVSSCT SET ADDRESS OF SSCT R4 M0453000 MVC $SVSSNM,SSCTSNAM SET SUBSYSTEM NAME R4 M0453500 L R1,CVTPTR GET CVT ADDRESS R4 M0454000 SH R1,=H'4' POINT TO OS/VS2 RELEASE INFO R4 M0454500 MVC $RELSE(4),0(R1) MOVE RELEASE INFO TO HCT @OZ35278 M0455000 MVC $SVRELNO(4),0(R1) MOVE RELEASE INFO TO SSVT R4 M0455500 EJECT R4 M0456000 ICM R1,15,$SVPOSTE TEST FOR MASTER POST ELEMENT R4 M0456500 BNZ ISETECBA BR IF PRESENT R4 M0457000 SPACE 2 R4 M0457500 *********************************************************************** M0458000 * * M0458500 * OBTAIN FIXED GLOBAL STORAGE FOR HASP WAIT ECB * M0459000 * * M0459500 *********************************************************************** M0460000 SPACE 1 R4 M0460500 PUSH PRINT - SECTION @OZ35996 M0461000 PRINT OFF - DELETED @OZ35996 M0461500 * THIS LINE DELETED BY APAR @OZ35996 M0462000 * THIS LINE DELETED BY APAR @OZ35996 M0462500 * THIS LINE DELETED BY APAR @OZ35996 M0463000 * THIS LINE DELETED BY APAR @OZ35996 M0463500 * THIS LINE DELETED BY APAR @OZ35996 M0464000 * THIS LINE DELETED BY APAR @OZ35996 M0464500 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0464600 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0464700 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0464800 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0464900 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0465000 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0465100 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0465200 POP PRINT - SECTION DELETED @OZ35996 M0465300 GETMAIN R,LV=$SVFIXL+8,SP=228 GET FIXED CSA @OZ35996 M0465500 SPACE 1 @OZ35996 M0465550 * BYTES 00 THROUGH 03 HEX = $HASPECB @OZ32235 M0465600 * BYTES 04 THROUGH 07 HEX = $SVPOSTW @OZ32235 M0465650 * BYTES 08 THROUGH 37 HEX = BLANKS FOR 3525 @OZ32235 M0465700 SPACE 1 @OZ35996 M0465900 MVC 0(4,R1),=C'$ECB' SET EYE-CATCHER @OZ35996 M0466000 MVC 4(4,R1),=A($SVFIXL+8) AND SP/LENGTH @OZ35996 M0466100 MVI 4(R1),228 INTO PREFIX @OZ35996 M0466200 LA R1,8(,R1) POINT PAST PREFIX @OZ35996 M0466300 SPACE 1 @OZ35996 M0466400 ISETECBA ST R1,$HASPECB SET ECB ADDRESS IN HCT, R4 M0466500 ST R1,$SVQLOKP JOB SERVICES QUEUE ELEMENT, R4 M0467000 ST R1,$SVPOSTE AND MASTER HASP POST ELEMENT R4 M0467500 XC 0(4,R1),0(R1) INITIALIZE MASTER POST ELEMENT R4 M0468000 MVI $SVPOSTW(R1),X'FF' SET TO ALLOW JES2 RESTART R4 M0468500 MVI $SVBLANK(R1),X'40' SET GOTTEN AREA + 8 TO @OZ32235 M0468550 MVC $SVBLANK+1(47,R1),$SVBLANK(R1) BLANKS. @OZ32235 M0468600 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0468650 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0468700 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0468750 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0468800 * THIS LINE DELETED BY APAR NUMBER @OZ32235 M0468850 SPACE 1 R4 M0469000 DROP WA,WC KILL SSVT, SSCT ADDRESSABILITY R4 M0469500 SPACE 1 R4 M0470000 ICSWD EQU ($SVSTUS-SSVT)/4*4 OFFSET OF WORD CONTAINING $SVSTUS R4 M0470500 EJECT R4 M0471000 *********************************************************************** M0471500 * * M0472000 * LOCATE SUBSYSTEM SUPPORT MODULE -- HASPSSSM * M0472500 * * M0473000 *********************************************************************** M0473500 SPACE 1 R4 M0474000 L WA,=A(NPLSSSM) POINT TO HASPSSSM PROGRAM NAME R41 M0474400 LOAD EPLOC=(WA),ERRET=NESTAE LOCATE HASPSSSM R41 M0474500 L R3,CVTPTR GET CVT ADDRESS @OZ55871 M0474550 USING CVTDSECT,R3 @OZ55871 M0474600 CLM R0,7,CVTSHRVM+1 IS SSSM IN COMMON @OZ55871 M0474650 BH NSSSMOK YES, MAP @OZ55871 M0474700 CLM R0,7,CVTNUCB+1 IS SSSM IN COMMON @OZ55871 M0474750 BL NSSSMOK YES, MAP @OZ55871 M0474800 DROP R3 @OZ55871 M0474850 MVI MAPSSSM-MAPDSECT+7(WG),C'$' STOP REPS TO SSSM @OZ55871 M0474900 B NSSSMDEL DON'T MAP @OZ55871 M0474950 SPACE 1 @OZ55871 M0474975 NSSSMOK ST R0,MAPSSSMA-MAPDSECT(,WG) SET ADDR FOR REP @OZ55871 M0475000 SPACE 1 @OZ55871 M0475250 NSSSMDEL DELETE EPLOC=(WA) DELETE HASPSSSM @OZ55871 M0475500 SPACE 1 R4 M0476000 EJECT R4 M0476500 *********************************************************************** M0477000 * * M0477500 * ACTIVATE JES2 ESTAE ROUTINE * M0478000 * * M0478500 *********************************************************************** M0479000 SPACE 1 R4 M0479500 NESTAE L WA,MAPABNDA-MAPDSECT(,WG) GET HASP ESTAE EXIT ADDR R41 M0480000 ESTAE (WA),RECORD=YES,TERM=YES JES2 TASK ABEND EXIT @OZ46772 M0480500 B ISVTDONE BRANCH TO NEXT SECTION M0481000 EJECT M0481500 INOSSCT L R1,=A(ISTRTEM1) POINT TO ERROR MESSAGE R4 M0482000 MVC ISTRTSNM-ISTRTEM1(,R1),SSIBJBID-SSIB(WA) SUBSYS NAME R4 M0482500 $EXIT (R1) THEN ISSUE ERROR MSG AND QUIT R4 M0483000 SPACE 3 M0483500 INSTRTER $EXIT ISTRTEM2 ISSUE ERROR MSG AND QUIT R4 M0484000 SPACE 2 @OZ35996 M0484500 INIPLER $EXIT NIPLMSG ISSUE ERROR MSG AND QUIT @OZ35996 M0484600 SPACE 2 @OZ35996 M0484700 ISVSTUS DC A(*-*) SYSTEM STATUS WORK AREA R4 M0485000 SPACE 3 R4 M0485500 LTORG R4 M0486000 SPACE 5 R4 M0486500 ISVTDONE NULL R4 M0487000 TITLE 'HASP INITIALIZATION -- TEMPORARY DCT ALLOCATION' R4 M0487500 *********************************************************************** M0488000 * * M0488500 * OBTAIN TEMPORARY STORAGE FOR LOCAL U/R AND LINE DCTS * M0489000 * * M0489500 *********************************************************************** M0490000 SPACE 1 R4 M0490500 BALR BASE2,0 RE-ESTABLISH R4 M0491000 USING *,BASE2 LOCAL ADDRESSABILITY R4 M0491500 SPACE 1 R4 M0492000 LA WB,NDCTABLE PICK UP DCT BUILD TABLE ADDR R4 M0492500 SLR R0,R0 ZERO GETMAIN TOTAL VALUE R4 M0493000 SPACE 1 R4 M0493500 NDCTLOP1 LH WF,NDCTNUMB(,WB) PICK UP NO. OF DCTS TO BE GENED R4 M0494000 LTR WF,WF TEST FOR TABLE END R4 M0494500 BZ NDCTGETM YES, BRANCH - ISSUE GETMAIN R4 M0495000 MH WF,NDCTSIZE(,WB) MULTIPLY NO. BY SIZE R4 M0495500 ALR R0,WF ADD TO TOTAL STORAGE REQUIREMENT R4 M0496000 LA WB,NDCTBLEN(,WB) NEXT TABLE ENTRY R4 M0496500 B NDCTLOP1 LOOP, DO ALL DCT TYPES R4 M0497000 SPACE 2 R4 M0497500 NDCTGETM ICM R0,8,=AL1(229) INDICATE HI-CORE STORAGE R4 M0498000 LR WB,R0 SAVE STORAGE REQUIREMENT R4 M0498500 GETMAIN R,LV=(0) GET STORAGE FOR TEMPORARY DCTS R4 M0499000 LR R0,WB SAVE AREA LENGTH IN R0 R4 M0499500 ST R1,NDCTSTOR SAVE STORAGE ADDRESS R4 M0500000 LR WA,R1 COPY STORAGE ADDRESS FOR MVCL R4 M0500500 SLR WD,WD CLEAR OPERAND 2 LENGTH R4 M0501000 MVCL WA,WC USE MVCL TO CLEAR GOTTEN AREA R4 M0501500 ST R0,0(,R1) SAVE AREA LENGTH IN AREA R4 M0502000 LA R1,4(,R1) SKIP OVER LENGTH R4 M0502500 EJECT R4 M0503000 *********************************************************************** M0503500 * * M0504000 * INITIALIZE TEMPORARY LOCAL U/R AND LINE DCTS * M0504500 * * M0505000 *********************************************************************** M0505500 SPACE 1 R4 M0506000 USING DCTDSECT,R1 DCTS ADDRESSABLE IN GOTTEN AREA R4 M0506500 SPACE 1 R4 M0507000 LA WB,NDCTABLE PICK UP DCT BUILD TABLE ADDR R4 M0507500 LA WC,$DCTPOOL-(DCTCHAIN-DCTDSECT) PRIME OLD DCT PTR R4 M0508000 SPACE 1 R4 M0508500 NDCTLOP2 LH R0,NDCTNUMB(,WB) PICK UP NUMBER OF DCTS INITIALIZE R4 M0509000 LTR R0,R0 TEST FOR TABLE END R4 M0509500 BZ INDCTDON YES, BRANCH - NEXT PHASE OF INIT R4 M0510000 SPACE 1 R4 M0510500 LA WA,1 START WITH DCT NUMBER 1 R4 M0511000 L WE,NDCTOFST(,WB) PICK UP HCT OFFSET R4 M0511500 ST R1,HCTDSECT(WE) AND SAVE DCT ADDRESS IN HCT R4 M0512000 SPACE 1 R4 M0512500 L WE,NDCTRTNE(,WB) GET MODEL DCT INIT ROUTINE ADDR R4 M0513000 SPACE 1 R4 M0513500 NDCTLOP3 ST R1,DCTCHAIN-DCTDSECT(,WC) CHAIN ALL THE DCTS R4 M0514000 BR WE EXECUTE MODEL DCT INIT ROUTINE R4 M0514500 SPACE 1 R4 M0515000 NDCTRTN1 NULL RETURN FROM UR DCT INIT ROUTINES R4 M0515500 STC WA,DCTDEVID+1 STORE DEVICE NUMBER IN DCT R4 M0516000 SPACE 1 R4 M0516500 NDCTRTN2 NULL RETURN FROM LINE/LOGON DCT INIT R4 M0517000 CVD WA,INDBLWK CONVERT DEVICE NUMBER TO DECIMAL R4 M0517500 OI INDBLWK+7,X'0F' ADJUST SIGN R4 M0518000 UNPK INDIGITS+1(3),INDBLWK AND MAKE EBCDIC R4 M0518500 SPACE 1 R4 M0519000 SKIP30 MVC INDIGITS,INDIGITS+1 LEFT JUSTIFY R4 M0519500 CLI INDIGITS,C'0' REMOVING ALL R4 M0520000 BE SKIP30 LEADING ZEROS R4 M0520500 SPACE 1 R4 M0521000 LA WF,L'DCTDEVN-1 GET FIELD LENGTH R4 M0521500 SR WF,WD COMPUTE DIGIT POSITION R4 M0522000 LA WF,DCTDEVN(WF) AND ADDRESS FOR MVC R4 M0522500 EX WD,NDCTMVC MOVE IN DIGITS R4 M0523000 MVI DCTSTAT,DCTUNAL SHOW DEVICE NOT ALLOCATED R4 M0523500 LR WC,R1 SAVE OLD DCT ADDRESS FOR CHAINING R4 M0524000 AH R1,NDCTSIZE(,WB) ADVANCE TO NEXT DCT R4 M0524500 LA WA,1(,WA) INCREMENT DEVICE NUMBER R4 M0525000 BCT R0,NDCTLOP3 LOOP FOR ALL THIS TYPE DCTS R4 M0525500 SPACE 1 R4 M0526000 NDCTNXT LA WB,NDCTBLEN(,WB) ADVANCE TO NEXT DCT TYPE R4 M0526500 B NDCTLOP2 LOOP FOR ALL DCTS IN TABLE R4 M0527000 SPACE 1 R4 M0527500 NDCTMVC MVC 0(*-*,WF),INDIGITS *** EXECUTED *** R4 M0528000 EJECT R4 M0528500 SPACE 1 R4 M0529000 * READER MODEL DCT INITIALIZATION R4 M0529500 SPACE 1 R4 M0530000 NIDCTRDR MVI DCTDEVTP,DCTRDR SET READER DEVICE TYPE R4 M0530500 MVC DCTDEVN(8),=C'READER' AND NAME R4 M0531000 L WD,CVTPTR GET ADDRESS OF CVT R4 M0531500 L WD,CVTSMCA-CVT(,WD) GET ADDRESS OF SMCA R4 M0532000 MVC DCTINDC,SMCAOPT-SMCA(WD) SET BACKGROUND SMF OPTIONS R4 M0532500 MVI DCTDEVID,DCTRDRID SET READER DEVICE ID R4 M0533000 LA WD,2-1 SHOW POS. OF DEVICE NUMBER DIGITS R4 M0533500 MVI DCTSIAFF,QUESYSAF SET DEFAULT AFFINITY R4 M0534000 MVI DCTJCLAS,C'A' READER DEFAULT CLASS = A R4 M0534500 MVI DCTMCLAS,C'A' MSGCLASS = A R4 M0535000 MVI DCTPRLIM,15 DEFAULT PRIO IS MAX (15) R4 M0535500 B NDCTRTN1 RETURN TO LOOP R4 M0536000 SPACE 3 R4 M0536500 * PUNCH MODEL DCT INITIALIZATION R4 M0537000 SPACE 1 R4 M0537500 NIDCTPUN MVI DCTDEVTP,DCTPUN SET PUNCH DEVICE TYPE R4 M0538000 MVC DCTDEVN(8),=CL8'PUNCH' AND NAME R4 M0538500 MVI DCTDEVID,DCTPUNID SET PUNCH DEVICE ID R4 M0539000 MVC DCTCLASS(3),=C'BK ' SET DEFAULT R4 M0539500 MVC DCTCLASS+3(33),DCTCLASS+2 SYSOUT CLASSES R4 M0540000 MVC DCTCKPTL,=H'100' INITIALIZE CKPTLNS @OZ19494 M0540200 LA WD,3-1 SHOW POS. OF DEVICE NUMBER DIGITS R4 M0540500 B NIDCTPP COMPLETE COMMON PRINT/PUNCH R4CM0541000 INITIALIZTION R4 M0541500 EJECT R4 M0542000 * PRINTER MODEL DCT INITALIZTION R4 M0542500 SPACE 1 R4 M0543000 NIDCTPRT MVI DCTDEVTP,DCTPRT SET LOCAL PRINT DEVICE TYPE R4 M0543500 MVC DCTDEVN(8),=CL8'PRINTR' AND NAME R4 M0544000 MVI DCTDEVID,DCTPRTID SET PRINTER DEVICE ID R4 M0544500 MVC DCTCLASS(3),=C'AJ ' SET DEFAULT R4 M0545000 MVC DCTCLASS+3(33),DCTCLASS+2 SYSOUT CLASSES R4 M0545500 LA WD,2-1 SHOW POS. OF DEVICE NUMBER DIGITS R4 M0546000 SPACE 3 R4 M0546500 * PRINT/PUNCH MODEL DCT COMMON INITIALIZATION R4 M0547000 SPACE 1 R4 M0547500 NIDCTPP MVI DCTCHAR1,C'*' SET DEFAULT CHARACTER SETS , R4 M0548000 MVC DCTCKPTP,=H'1' INITIALIZE CKPTPGS @OZ19494 M0548100 MVC DCTCHAR1+1(DCTMODF+L'DCTMODF-DCTCHAR1-1),DCTCHAR1 R4CM0548500 FORMS OVERLAY & COPY MODFICATION R4CM0549000 NAME R4 M0549500 MVI DCTPPSW,DCTPPSWO+DCTPPSWC+DCTPPSWT ALLOW $T U R4 M0550000 OI DCTPPSW2,DCTNINIT FORCE DEVICE TO INITIALIZE @OZ46318 M0550100 MVC DCTLIMHI,=X'FFFFFFFF' SET DFLT UPPER RECORD LIM @OZ40627 M0550200 B NDCTRTN1 RETURN TO LOOP R4 M0550500 EJECT R4 M0551000 * LINE MODEL DCT INITIALIZTION R4 M0551500 SPACE 1 R4 M0552000 NIDCTLNE MVI DCTDEVTP,DCTLNE SET LINE DEVICE TYPE R4 M0552500 MVC DCTDEVN(8),=CL8'LINE' AND NAME R4 M0553000 LA WD,4-1 SHOW POS. OF DEVICE NUMBER DIGITS R4 M0553500 SPACE 3 R4 M0554000 * LINE/LOGON MODEL DCT COMMON INITIALIZATION R4 M0556000 SPACE 1 R4 M0557000 NIDCTPWD MVI MDCTPSWD,C' ' CLEAR PASSWORD R4 M0557500 MVC MDCTPSWD+1(L'MDCTPSWD-1),MDCTPSWD TO BLANKS R4 M0558000 B NDCTRTN2 RETURN TO LOOP R4 M0558500 SPACE 3 R4 M0559500 * LOGON MODEL DCT INITIALIZATION R4 M0560000 SPACE 1 R4 M0560500 NIDCTLOG MVI DCTDEVTP,DCTLOG SET LOGON DEVICE TYPE R4 M0561000 MVC DCTDEVN(8),=CL8'LOGON' AND NAME R4 M0561500 LA WD,3-1 SHOW POS. OF DEVICE NUMBER DIGITS R4 M0562000 MVI MDCTPWDL,8 ALWAYS USE PASSWORD LENGTH 8 R4 M0563000 MVI MDCTAPNL,8 AND APPLICATION NAME LENGTH 8 R4 M0563500 MVC MDCTAPPL(8),=CL8'JES2' DEFAULT APPLICATION NAME R4 M0564000 MVI MDCTTYPE,DCTPSNA SHOW SNA TYPE DCT R4 M0564500 B NIDCTPWD COMPLETE COMMON LINE DCT INIT R4 M0565000 EJECT R4 M0566000 * TEMPORARY DCT BUILD TABLE DEFINITIONS R4 M0566500 SPACE 1 R4 M0567000 NDCTNUMB EQU 0 MAXIMUM NO. OF TEMPRARY DCTS R4 M0567500 NDCTSIZE EQU 2 SIZE OF TEMPORARY DCT R4 M0568000 NDCTRTNE EQU 4 POINTER TO MODEL DCT INIT ROUTINE R4 M0568500 NDCTOFST EQU 8 OFFSET TO HCT FIELD FOR THIS TYPE R4 M0569000 NDCTBLEN EQU 12 SIZE OF TABLE ENTRY R4 M0569500 SPACE 3 R4 M0570000 NDCTABLE DS 0F TEMPORARY DCT BUILD TABLE R4 M0570500 SPACE 1 R4 M0571000 DC AL2(1),AL2(4),A(NDCTNXT),A($DCTPOOL-HCTDSECT) R4CM0571500 ENTRY FOR ENTIRE DCT POOL R4 M0572000 SPACE 1 R4 M0572500 DC AL2($MAXRDRS) LOCAL READER ENTRY R4 M0573000 DC AL2(DCTRDEND-DCTDSECT) R4 M0573500 DC A(NIDCTRDR) R4 M0574000 DC A($RDRDCT-HCTDSECT) R4 M0574500 SPACE 1 R4 M0575000 DC AL2($MAXPRTS) LOCAL PRINTER ENTRY R4 M0575500 DC AL2(((DCTPPEND-DCTDSECT+(36+1)+3)/4)*4) R4 M0576000 DC A(NIDCTPRT) R4 M0576500 DC A($PRTDCT-HCTDSECT) R4 M0577000 SPACE 1 R4 M0577500 DC AL2($MAXPUNS) LOCAL PUNCH ENTRY R4 M0578000 DC AL2(((DCTPPEND-DCTDSECT+(36+1)+3)/4)*4) R4 M0578500 DC A(NIDCTPUN) R4 M0579000 DC A($PUNDCT-HCTDSECT) R4 M0579500 SPACE 1 R4 M0580000 DC AL2($MAXLNES) TP LINE ENTRY R4 M0580500 DC AL2(MDCTLEND-DCTDSECT) R4 M0581000 DC A(NIDCTLNE) R4 M0581500 DC A($LNEDCT-HCTDSECT) R4 M0582000 SPACE 1 R4 M0582500 DC AL2($MAXLOGS) LOGON DCT ENTRY R4 M0583500 DC AL2(MDCTLGND-DCTDSECT) R4 M0584000 DC A(NIDCTLOG) R4 M0584500 DC A($LOGNDCT-HCTDSECT) R4 M0585000 SPACE 1 R4 M0585500 DC H'0' TABLE END R4 M0586500 DROP R1 DROP R1 / DCT ADDRESSABILITY R4 M0587000 SPACE 2 R4 M0587500 INDBLWK EQU INITDBL DOUBLE WORD WORK AREA R4 M0588000 INDIGITS DC CL4' ',C' ' DEVICE NUMBER WORK AREA R4 M0588500 SPACE 1 R4 M0589000 INDCTDON NULL R4 M0589500 EJECT R4 M0590000 *********************************************************************** M0590500 * * M0591000 * INITIALIZE INTERNAL READER MODEL DCT * M0591500 * * M0592000 *********************************************************************** M0592500 SPACE 1 R4 M0593000 L R4,=A(NINRDCT) GET ADDR OF MODEL INTRDR DCT R4 M0593500 USING DCTDSECT,R4 SHOW MODEL DCT ADDRESSABILITY R4 M0594000 SPACE 1 R4 M0594500 MVI DCTSTAT,DCTUNAL+DCTHOLD SHOW DCT AVAILABLE BUT HELD R4 M0595000 MVI DCTDEVTP,DCTINR SET DCT INTERNAL READER TYPE R4 M0595500 MVC DCTDEVN,=CL8'INTRDR' AND DEVICE NAME R4 M0596000 MVI DCTDEVID,DCTINRID SET DCT DEVICE ID R4 M0596500 MVC RIDJOBID,=C'JOB00000' SET INTERNAL READER JOB ID R4 M0597000 MVI DCTSIAFF,QUESYSAF SET DEFAULT AFFINITY R4 M0597500 MVI DCTJCLAS,C'A' INTRDR DEFAULT CLASS = A R4 M0598000 MVI DCTMCLAS,C'A' MSGCLASS = A R4 M0598500 MVI DCTPRLIM,15 DEFAULT PRIO IS MAX (15) R4 M0599000 L R7,$SSVT GET ADDRESS OF SSVT R4 M0599500 ST R7,RIDSSVT STORE IN DCT R4 M0600000 LA R5,$SVBR14-SSVT(,R7) INITIALIZE ADDRESS R4 M0600500 ST R5,RIDERRET OF ERROR ROUTINE IN DCT R4 M0601000 ST R5,RIDEOMER AND IN EOM ELEMENT @OZ37382 M0601100 L R5,CVTPTR GET ADDRESS OF CVT R4 M0601500 L R5,CVTSMCA-CVT(,R5) GET ADDRESS OF SMCA R4 M0602000 MVC DCTINDC,SMCAOPT-SMCA(R5) SET BACKGROUND SMF OPTIONS R4 M0602500 SPACE 2 R4 M0603000 DROP R4 RELEASE MODEL DCT ADDRESSABILITY R4 M0603500 TITLE 'HASP INITIALIZATION -- OBTAIN STORAGE FOR TEMPORARY CONCM0604000 TROL BLOCKS' R4 M0604500 *********************************************************************** M0605000 * * M0605500 * OBTAIN STORAGE FOR TEMPORARY PIT, RAT, RWT AND CPT * M0606500 * * M0608500 *********************************************************************** M0609000 SPACE 1 R4 M0609500 L R1,=A(NMAXPART) COMPUTE R4 M0610000 L WC,0(,R1) SIZE OF R41 M0610500 LA WB,PITLEN TEMPORARY R4 M0611000 MR WA,WC PIT R4 M0611500 AL WB,=A(4+$MAXRJE*(RATTLE+RWTLEN)) ADD RAT, RWT SIZE R4 M0612500 AL WB,=A(100*(CPTEND-CPTDSECT)) ADD CPT SIZE R41 M0614100 ICM WB,8,=AL1(229) INDICATE HI-CORE STORAGE R4 M0614500 LR R0,WB GET TEMPORARY R4 M0615000 GETMAIN R,LV=(0) STORAGE R4 M0615500 ST R1,NTMPSTOR SAVE STORAGE ADDRESS R4 M0616000 ST WB,0(,R1) SAVE STORAGE AMOUNT R4 M0616500 LA WB,0(,WB) CLEAR SUBPOOL NUMBER R4 M0617000 LA R1,4(,R1) POINT TO USABLE STORAGE R4 M0617500 SH WB,=H'4' ADJUST USABLE STORAGE LENGTH R4 M0618000 LR WA,R1 CLEAR R4 M0618500 SLR R15,R15 USABLE R4 M0619000 MVCL WA,R14 STORAGE R4 M0619500 TITLE 'HASP INITIALIZATION -- CREATE TEMPORARY PIT' R4 M0620000 *********************************************************************** M0620500 * * M0621000 * CREATE TEMPORARY PIT * M0621500 * * M0622000 *********************************************************************** M0622500 SPACE 1 R4 M0623000 ST R1,$PITABLE SET POINTER TO TEMPORARY PIT R4 M0623500 LA WA,NPITCLAS+35 STARTING DEFAULT CLASS LIST ADDR R4 M0624000 SLR WB,WB STARTING PIT NUMBER R4 M0624500 SPACE 1 R4 M0625000 USING PITDSECT,WD PROVIDE PIT ADDRESSABILITY R4 M0625500 SPACE 1 R4 M0626000 NPITNEXT LR WD,R1 POINT TO NEXT PIT R4 M0626500 LA R1,PITLEN(,R1) UPDATE PIT CHAIN ADDRESS R4 M0627000 ST R1,PITNEXT SET CHAIN ADDRESS IN PIT R4 M0627500 LA WB,1(,WB) BUMP PIT NUMBER R4 M0628000 CVD WB,INITDBL CREATE R4 M0628500 OI INITDBL+7,X'0F' INITIATOR R4 M0629000 UNPK PITPATID,INITDBL ID R4 M0629500 CLI PITPATID,C'0' FOR R4 M0630000 BNE SKIP40 NEW R4 M0630500 MVI PITPATID,C' ' PIT R4 M0631000 SKIP40 MVC PITCLASS(37),0(WA) PROVIDE DEFAULT JOB CLASS LIST R4 M0631500 CL WA,=A(NPITCLAS) TEST FOR CLASS LIST ORIGIN R4 M0632000 BE SKIP50 BR IF REACHED R4 M0632500 BCTR WA,0 ELSE UPDATE CLASS LIST POINTER R4 M0633000 SKIP50 BCT WC,NPITNEXT LOOP THRU ALL PITS R4 M0633500 SPACE 1 R4 M0634000 ST WC,PITNEXT ZERO LAST PIT CHAIN ADDRESS R4 M0634500 B NTEMPRAT AND BR TO NEXT SECTION R4 M0635000 SPACE 1 R4 M0635500 DROP WD KILL PIT ADDRESSABILITY R4 M0636000 SPACE 1 R4 M0636500 PITLEN EQU (PITCLASS+36+1+3-PITDSECT)/4*4 MAXIMUM PIT LENGTH R4 M0637000 NPITCLAS DC CL72'9876543210ZYXWVUTSRQPONMLKJIHGFEDCBA' JOB CLASS R4 M0639000 TITLE 'HASP INITIALIZATION -- RAT / RWT ALLOCATION' R4 M0639500 *********************************************************************** M0640000 * * M0640500 * CREATE TEMPORARY RAT * M0641000 * * M0641500 *********************************************************************** M0642000 SPACE 1 R4 M0642500 NTEMPRAT ST R1,$RAT SAVE RAT ADDRESS R4 M0643000 LA WA,$MAXRJE RAT ELEMENTS R4 M0643500 SLR WB,WB RAT COUNT R4 M0644000 SPACE 1 R4 M0644500 USING RATDSECT,R1 PROVIDE RAT ADDRESSABILITY R4 M0645000 SPACE 1 R4 M0645500 INITRAT LA WB,1(,WB) BUMP REMOTE NUMBER R4 M0646000 MVC RATNAME,=CL8'RMT' MOVE R4 M0646500 MVI RATTYPE,0 DEFAULT R4 M0647000 MVI RATFMT,DCTPBLK+DCTPVAR VALUES R4 M0647500 MVI RATNUMRD,1 TO R4 M0648000 MVI RATNUMPR,1 TEMPORARY R4 M0648500 MVI RATCONF,RATCONFT RAT R4 M0649000 MVC RATPSWD,=CL8' ' ENTRY R4 M0649500 CVD WB,INITDBL AND PREPARE TO R4 M0650000 OI INITDBL+7,X'0F' JUSTIFY DIGITS IN R4 M0650500 UNPK RATNAME+4(3),INITDBL REMOTE NAME R4 M0651000 SPACE 1 R4 M0651500 SKIP60 MVC RATNAME+3(4),RATNAME+4 LEFT JUSTIFY R4 M0652000 CLI RATNAME+3,C'0' DIGITS IN R4 M0652500 BE SKIP60 REMOTE NAME R4 M0653000 SPACE 1 R4 M0653500 STH WB,RATROUTE SET REMOTE ROUTE CODE R4 M0654000 STH WB,RATCONRT SET REMOTE CONSOLE ROUTE CODE R4 M0654500 MVI RATSYMB,C' ' CLEAR REMOTE LUNAME R4 M0655500 MVC RATSYMB+1(L'RATSYMB),RATSYMB TO BLANKS R4 M0656000 SLR WC,WC INIT BUFSIZE TO ZERO, LATER @OZ50955 M0656500 STH WC,RATBUFSZ CHANGED IN FINAL RJE INIT @OZ50955 M0657000 LA R1,RATEND POINT TO NEXT RAT R4 M0657500 BCT WA,INITRAT LOOP THRU ENTIRE RAT R4 M0658000 SPACE 1 R4 M0658500 DROP R1 KILL RAT ADDRESSABILITY R4 M0659000 EJECT R4 M0659500 *********************************************************************** M0659600 * * M0659700 * CREATE TEMPORARY CPT * M0659800 * * M0659900 *********************************************************************** M0660000 SPACE 1 R41 M0660100 NTEMPCPT ST R1,$CPTPOOL SAVE CPTPOOL ADDRESS R41 M0660200 LA WA,100 NUMBER OF CPT ELEMENTS R41 M0660300 LA WB,0 FIRST CPT NUMBER R41 M0660400 SPACE 1 R41 M0660500 USING CPTDSECT,R1 R41 M0660600 SPACE 1 R41 M0660700 INITCPT STC WB,CPTNUM INIT CPT NUMBER R41 M0660800 LA R1,CPTEND POINT TO NEXT CPT R41 M0660900 LA WB,1(,WB) INCREMENT CPT NUMBER R41 M0661000 BCT WA,INITCPT LOOP THROUGH CPT R41 M0661100 SPACE 1 R41 M0661200 DROP R1 R41 M0661300 EJECT R41 M0661400 *********************************************************************** M0661500 * * M0661600 * CREATE REMOTE WORK TABLE * M0661700 * * M0661800 *********************************************************************** M0662000 SPACE 1 R4 M0662500 ST R1,$RWT SAVE RWT ADDRESS R4 M0663000 LA WA,$MAXRJE RWT ELEMENTS R4 M0663500 SPACE 1 R4 M0664000 USING RWTDSECT,R1 PROVIDE RWT ADDRESSABILITY R4 M0664500 USING RWLDSECT,WD SHOW RWL ADDRESSABILITY @OZ29180 M0664600 SPACE 1 R4 M0665000 INITRWT LA WB,7 RWT READER ELEMENTS R4 M0665500 SLR WC,WC RWT READER ELEMENT COUNT R4 M0666000 L WD,=A($RWL) GET RWL ADDRESS @OZ29180 M0666100 SPACE 1 R4 M0666500 INRWTRD STC WC,RWTINDEX SET DEVICE INDEX R4 M0667000 MVC RWTSTAT(INRWTD1L),INRWTD1 SET REMAINING FIELDS R4 M0667500 MVC RWTSEL,RWLSEL SET STANDARD SELECT BYTE @OZ29180 M0667600 LA R1,RWTRDEND POINT TO NEXT READER ELEMENT R4 M0668000 LA WC,RWLEND-RWLDSECT(,WC) BUMP INDEX VALUE R4 M0668500 LA WD,RWLEND POINT TO NEXT RWL ENTRY @OZ29180 M0668600 BCT WB,INRWTRD LOOP THRU ALL RDR ELEMENTS R4 M0669000 SPACE 1 R4 M0669500 MVC INRWTCL,=C'AJ' SET R4 M0670000 XC INRWTCKL,INRWTCKL ALL 7 @OZ19494 M0670100 MVI INRWTLN,120 RWT R4 M0670500 LA WC,(RWLEND-RWLDSECT)*7 PRINT R4 M0671000 BAL WE,INRWTPP ELEMENTS R4 M0671500 MVC INRWTCL,=C'BK' SET R4 M0672000 MVC INRWTCKL,=H'100' ALL 7 @OZ19494 M0672100 MVI INRWTLN,80 RWT R4 M0672500 LA WC,((7+7)*(RWLEND-RWLDSECT)) PUNCH R4 M0673000 BAL WE,INRWTPP ELEMENTS R4 M0673500 LA R1,3(,R1) ROUND UP TO NEXT R4 M0674000 N R1,=F'-4' FULLWORD BOUNDARY R4 M0674500 BCT WA,INITRWT LOOP THRU ENTIRE RWT R4 M0675000 SPACE 1 R4 M0675500 B INRWTEND THEN BR TO NEXT SECTION R4 M0676000 SPACE 1 R4 M0676500 INRWTPP LA WB,7 SET ELEMENT COUNT R4 M0677000 SPACE 1 R4 M0677500 INRWTPP1 STC WC,RWTINDEX SET DEVICE INDEX R4 M0678000 MVC RWTSTAT(INRWTD2L),INRWTD2 SET REMAINING FIELDS R4 M0678500 MVC RWTSEL,RWLSEL SET STANDARD SELECT BYTE @OZ29180 M0678600 LA R1,RWTPPEND POINT TO NEXT ELEMENT R4 M0679000 LA WC,RWLEND-RWLDSECT(,WC) BUMP INDEX VALUE R4 M0679500 LA WD,RWLEND POINT TO NEXT RWL ENTRY @OZ29180 M0679600 BCT WB,INRWTPP1 LOOP THRU ALL ELEMENTS R4 M0680000 SPACE 1 R4 M0680500 BR WE THEN RETURN R4 M0681000 SPACE 1 R4 M0681500 DROP R1,WD KILL RWT AND RWL BASE @OZ29180 M0682000 EJECT R4 M0682500 SPACE 5 R4 M0683000 INRWTD1 DC AL1(DCTHOLD),X'8000' STATUS/ROUTE CODE @OZ29180 M0683500 DC AL1(80) CARD RECORD LENGTH @OZ29180 M0683600 DC AL1(0),X'FF',X'FF' SELECT/FEATURES @OZ29180 M0683700 DC AL1(0) RESERVED @OZ29180 M0683800 DC 4X'8000' R4 M0684000 DC C'AA',AL1(0,15,0) R4 M0684500 INRWTD1L EQU *-INRWTD1 R4 M0685000 SPACE 2 R4 M0685500 INRWTD2 DC AL1(DCTHOLD),X'8000' STATUS/ROUTE CODE @OZ29180 M0686000 INRWTLN DC AL1(*-*) RECORD LENGTH @OZ29180 M0686100 DC AL1(0),X'FF',X'FF' SELECT/FEATURES @OZ29180 M0686200 DC 3XL4'00' R4 M0686500 DC H'1' LOGICAL PAGES/CKPT @OZ19494 M0686600 INRWTCKL DC H'0' LINES/LOGICAL PAGE @OZ19494 M0686700 DC XL4'00' LOWER RECORD LIMIT @OZ40627 M0686800 DC XL4'FFFFFFFF' UPPER RECORD LIMIT @OZ40627 M0686900 DC AL1(DCTSUSPD,DCTPPSWF+DCTPPSWO) R4 M0687000 INRWTCL DC CL2' ',CL34' ' R4 M0687500 * THIS CARD DELETED BY APAR @OZ29180 M0688000 DC X'00' R4 M0688500 DC AL1(00,00) @OZ19494 M0689500 INRWTD2L EQU *-INRWTD2 R4 M0690500 SPACE 5 R4 M0691000 INRWTEND NULL R4 M0691500 TITLE 'HASP INITIALIZATION -- NDQ ALLOCATION' R4 M0708000 *********************************************************************** M0708500 * * M0709000 * CREATE FIRST DESTINATION QUEUE ELEMENT * M0709500 * * M0710000 *********************************************************************** M0710500 SPACE 1 R4 M0711000 USING NDQDSECT,R1 R4 M0711500 SPACE 1 R4 M0712000 INITNDQ LA R0,NDQSIZ GET STORAGE R4 M0712500 ICM R0,8,=AL1(229) FOR DESTINATION R4 M0713000 GETMAIN R,LV=(0) QUEUE ELEMENT R4 M0713500 XC NDQ,NDQ ZERO ELEMENT R4 M0714000 MVC NDQNAME,=CL8'LOCAL' SET NAME R4 M0714500 ST R1,$NDQ SET POINTER R4 M0715000 B NPLINIT BR TO NEXT SECTION R4 M0715500 SPACE 1 R4 M0716000 DROP R1 R4 M0716500 EJECT R4 M0717000 SPACE 5 R4 M0717500 LTORG R4 M0718000 TITLE 'HASP INITIALIZATION -- PARAMETER LIBRARY PROCESSING INICM0718500 TIALIZATION' R41 M0719000 *********************************************************************** M0719500 * * M0720000 * PARAMETER LIBRARY PROCESSING INITIALIZATION * M0720500 * * M0721000 *********************************************************************** M0721500 SPACE 1 R4 M0722000 NPLINIT BALR BASE2,0 RE-ESTABLISH R4 M0722500 USING *,BASE2,BASE3,BASE4 LOCAL ADDRESSABILITY R41 M0723000 SPACE 1 R4 M0723500 LA BASE3,2048(,BASE2) SET UP SECOND R4 M0724000 LA BASE3,2048(,BASE3) BASE REGISTER R4 M0724500 LA BASE4,2048(,BASE3) AND THIRD R41 M0724600 LA BASE4,2048(,BASE4) BASE REGISTER R41 M0724700 OPEN (HASPPARM,,HASPLIST,(OUTPUT)) OPEN PARMLIB DATA SETS R4 M0725000 L R1,=A(HASPPARM) POINT TO HASPPARM DCB R41 M0725100 TM DCBOFLGS-DCBDSECT(R1),DCBOFOPN TEST HASPPARM R41 M0725500 BO NPLOPEN1 BRANCH IF OPEN R4 M0726000 L R1,=A(NMSG450) POINT TO WARNING MESSAGE R4 M0726500 BAL WE,NPLWTOR ISSUE MSG, QUERY OPERATOR R4 M0727000 OI NPLFLAGS,NPLCONSL+NPLEOFSW SHOW CONSOLE MODE/EOF R41 M0727500 B NPLNEXT BR TO CONTINUE R41 M0727600 SPACE 3 R4 M0728000 NPLOPEN1 L R1,=A(HASPLIST) POINT TO HASPLIST DCB R41 M0728500 TM DCBOFLGS-DCBDSECT(R1),DCBOFOPN TEST HASPLIST R41 M0728600 BO NPLNEXT BR IF OPEN SUCCESSFUL R41 M0729000 NI $OPTSTAT,255-$OPTLIST ELSE FORCE NOLIST OPTION R4 M0729500 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT PROCESSING RCM0730000 OUTINE SELECTION' R41 M0730500 USING PTEDSECT,WB PROVIDE PTE ADDRESSABILITY R41 M0730600 SPACE 1 R41 M0730700 NPLNEXT NULL PROCESS NEXT STATEMENT M0731000 BAL LINK,NPLGET GET PARAMETER STATEMENT R41 M0731500 B NPLEND BR IF 'END'/END-OF-FILE R41 M0732000 SPACE 2 M0732500 MVC NERRCARD,NCARD SAVE MAJOR PARAMETER CARD @OZ44388 M0732700 LA R14,1 SET INCREMENT AND LIMIT R41 M0733000 LA R15,NCARD+70 FOR STATEMENT PROCESSING R41 M0733500 SPACE 2 M0736000 NPLNEXT1 L WC,=A(NPLTRT2) POINT TO PARAMETER XLATE TABLE R41 M0736500 MVI C'.'(WC),0 ALLOW PERIOD AS LEGAL CHARACTER R41 M0737000 MVI C'-'(WC),1 AND DISALLOW HYPHEN R41 M0737500 MVI C'/'(WC),1 AND SLASH R41 M0738000 L WB,=A(NPLPTBL) POINT TO PARAMETER TABLE R41 M0738500 LA R0,NPLPTENT GET NUMBER OF TABLE ENTRIES R41 M0739000 SPACE 1 M0739500 NPLNEXT2 IC R1,PTEKEYLN GET LENGTH OF KEYWORD R41 M0740000 BCTR R1,0 REDUCE FOR EXECUTE R41 M0740100 EX R1,NPLCLCLC EXECUTE COMPARE M0740500 BE NPLNEXT3 BR IF NAME MATCHES STATEMENT R41 M0741000 LA WB,PTELENG(,WB) GET NEXT TABLE ENTRY R41 M0741500 BCT R0,NPLNEXT2 TEST NEXT ENTRY R41 M0742000 B NPLSSERR ERROR IF NOT FOUND IN TABLE M0742500 SPACE 3 R4 M0743000 NPLNEXT3 ICM R1,7,PTEPRTN GET PROCESSING ROUTINE ADDRESS R41 M0743500 BNZR R1 BR IF PRESENT R41 M0743600 I01 $ERROR ELSE CRUMP R41 M0744000 SPACE 3 R41 M0744100 NPLEND TM NPLFLAGS,NPLCONSL ARE WE IN CONSOLE MODE... R41 M0744200 BZ NPLEND1 @OZ55871 M0744300 NI NPLFLAGS,255-NPLCONSL RESET CONSOLE INDICATOR R41 M0744400 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0744500 SPACE 1 @OZ55871 M0744510 NPLEND1 L R1,$HASPMAP GET HASP MODULE MAP @OZ55871 M0744520 CLI MAPSSSM-MAPDSECT+7(R1),C'M' IS SSSM IN LPA @OZ55871 M0744530 BE NPLCLOSE YES, INITIALIZATION OK @OZ55871 M0744540 OI NPLFLAGS,NPLCAN SET FOR CANCEL @OZ55871 M0744550 L R1,=A(NMSG869) GET ERROR MESSAGE @OZ55871 M0744560 MVC NLPAMDNM-NMSG869(,R1),NPLSSSM GET NAME OF SSSM @OZ55871 M0744570 $$WTO (R1) AND GO WRITE IT @OZ55871 M0744580 B NPLCLOSE GO TO CLOSE @OZ55871 M0744590 SPACE 3 R41 M0744600 NPLCLCLC CLC 0(*-*,WA),PTEKEY *** EXECUTE ONLY *** R41 M0745000 TITLE 'HASP INITIALIZATION -- INITIALIZATION VARIABLE STATEMENCM0745500 T PROCESSING ROUTINES' R41 M0746000 *********************************************************************** M0746500 * * M0747000 * NPLNUM -- ROUTINE TO PROCESS STATEMENTS SPECIFYING SPECIFIC * M0747500 * NUMERIC VALUE * M0748000 * * M0748500 *********************************************************************** M0749000 SPACE 1 R41 M0749500 NPLNUM BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0750000 SPACE 1 R41 M0750500 NPLSTORE LH WD,PTEDISPL GET FIELD DISPLACEMENT R41 M0751000 ALR WD,BASE1 ADD HCT ORIGIN R41 M0751500 SPACE 1 R41 M0752000 NPLSTORX STC R1,0(,WD) ASSUME 1-BYTE FIELD R41 M0752500 CLI PTEFLDLN,1 TEST ASSUMPTION R41 M0753000 BE NPLCOMNT BR IF VALID TO LIST/LOG STMNT R41 M0753500 STH R1,0(,WD) ASSUME 2-BYTE FIELD R41 M0754000 CLI PTEFLDLN,2 TEST ASSUMPTION R41 M0754500 BE NPLCOMNT BR IF VALID TO LIST/LOG STMNT R41 M0755000 STCM R1,7,0(WD) ASSUME 3-BYTE FIELD R41 M0755500 CLI PTEFLDLN,3 TEST ASSUMPTION R41 M0756000 BE NPLCOMNT BR IF VALID TO LIST/LOG STMNT R41 M0756500 ST R1,0(,WD) ASSUME 4-BYTE FIELD R41 M0757000 CLI PTEFLDLN,4 TEST ASSUMPTION R41 M0757500 BE NPLCOMNT BR IF VALID TO LIST/LOG STMNT R41 M0758000 I02 $ERROR ELSE CRUMP R41 M0758500 EJECT R41 M0759000 *********************************************************************** M0759500 * * M0760000 * NPLX2 -- ROUTINE TO PROCESS STATEMENTS SPECIFYING SPECIFIC * M0760500 * NUMERIC VALUE WHICH MUST BE ROUNDED TO MULTIPLE * M0761000 * OF TWO * M0761500 * * M0762000 *********************************************************************** M0762500 SPACE 1 R41 M0763000 NPLX2 BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0763500 LA R1,1(,R1) ENSURE MULTIPLE R41 M0764000 N R1,=F'-2' OF 2 BYTES R41 M0764500 B NPLSTORE BR TO STORE VALUE R41 M0765000 SPACE 3 R41 M0765500 *********************************************************************** M0766000 * * M0766500 * NPLX8 -- ROUTINE TO PROCESS STATEMENTS SPECIFYING SPECIFIC * M0767000 * NUMERIC VALUE WHICH MUST BE ROUNDED TO MULTIPLE * M0767500 * OF EIGHT * M0768000 * * M0768500 *********************************************************************** M0769000 SPACE 1 R41 M0769500 NPLX8 BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0770000 LA R1,7(,R1) ENSURE MULTIPLE R41 M0770500 N R1,=F'-8' OF 8 BYTES R41 M0771000 B NPLSTORE BR TO STORE VALUE R41 M0771500 SPACE 3 R41 M0772000 *********************************************************************** M0772500 * * M0773000 * NPLINVRT -- ROUTINE TO PROCESS STATEMENTS SPECIFYING * M0773500 * SPECIFIC NUMERIC VALUE WHOSE RECIPROCAL IS TO * M0774000 * BE STORED * M0774500 * * M0775000 *********************************************************************** M0775500 SPACE 1 R41 M0776000 NPLINVRT BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0776500 LNR R1,R1 MAKE NEGATIVE R41 M0777000 B NPLSTORE BR TO STORE VALUE R41 M0777500 EJECT R41 M0778000 *********************************************************************** M0778500 * * M0779000 * NPLSWICH -- ROUTINE TO PROCESS STATEMENTS SPECIFYING A * M0779500 * BINARY VALUE (YES/NO) * M0780000 * * M0780500 *********************************************************************** M0781000 SPACE 1 R41 M0781500 NPLSWICH BAL R1,NPLSETWA ADJUST WA FOR COMMON CODE R41 M0782000 CLI 8(WA),C'=' TEST NEXT CHARACTER R41 M0782500 BNE NPLSSERR INVALID IF NOT EQUAL SIGN R41 M0783000 LA WA,8(,WA) STEP OVER KEYWORD R41 M0783500 LA WE,1(,WA) SAVE FIELD ORIGIN ADDRESS R41 M0784000 SPACE 1 R41 M0784500 NPLSWTST BXH WA,R14,NPLSSERR LOCATE R41 M0785000 CLI 0(WA),C' ' END OF R41 M0785500 BNE NPLSWTST FIELD R41 M0786000 SPACE 1 R41 M0786500 LH WD,PTEDISPL GET FIELD DISPLACEMENT R41 M0787000 ALR WD,BASE1 ADD HCT ORIGIN R41 M0787500 CLC =C'Y ',0(WE) IF OPTION R41 M0788000 BE NPLYES BIT TO R41 M0788500 CLC =C'YES ',0(WE) BE SET, R41 M0789000 BE NPLYES BR TO SET IT R41 M0789500 CLC =C'N ',0(WE) IF OPTION BIT R41 M0790000 BE NPLNO NOT TO BE R41 M0790500 CLC =C'NO ',0(WE) RESET, R41 M0791000 BNE NPLSSERR BR TO ISSUE DIAGNOSTIC R41 M0791500 SPACE 1 R41 M0792000 NPLNO IC R1,PTESWNO GET RESET INFO R41 M0792500 EX R1,NPLRESET RESET SWITCH R41 M0793000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0793500 SPACE 1 R41 M0794000 NPLYES IC R1,PTESWYES GET SET INFO R41 M0794500 EX R1,NPLSET SET SWITCH R41 M0795000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0795500 SPACE 1 R41 M0796000 NPLSET OI 0(WD),*-* *** EXECUTE ONLY *** R41 M0796500 NPLRESET NI 0(WD),*-* *** EXECUTE ONLY *** R41 M0797000 EJECT R41 M0797500 *********************************************************************** M0798000 * * M0798500 * NPLCHAR -- ROUTINE TO PROCESS STATEMENTS SPECIFYING SPECIFIC * M0799000 * CHARACTER STRING * M0799500 * * M0800000 *********************************************************************** M0800500 SPACE 1 R41 M0801000 NPLCHAR BAL WC,NPLID EXTRACT AND CHECK CHAR STRING R41 M0801500 SPACE 1 R41 M0802000 NPLSTORC LH WD,PTEDISPL GET FIELD DISPLACEMENT R41 M0802500 ALR WD,BASE1 ADD HCT ORIGIN R41 M0803000 SPACE 1 R41 M0803500 NPLSTORO SLR WC,WC CLEAR FOR INSERT R41 M0804000 IC WC,PTEFLDLN GET FIELD LENGTH R41 M0804500 BCTR WC,0 REDUCE FOR EXECUTE R41 M0805000 EX WC,NPLMOVEC MOVE CHARACTER STRING TO FIELD R41 M0805500 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0806000 SPACE 1 R41 M0806500 NPLMOVEC MVC 0(*-*,WD),NPLWORK *** EXECUTE ONLY *** R41 M0807000 SPACE 3 R41 M0807500 *********************************************************************** M0808000 * * M0808500 * NPLJCL -- ROUTINE TO PROCESS STATEMENTS SPECIFYING SPECIFIC * M0809000 * CHARACTER STRING, LIMITING VALID CHARACTERS TO * M0809500 * THOSE ALLOWED IN JCL NAMES/KEYWORDS * M0810000 * * M0810500 *********************************************************************** M0811000 SPACE 1 R41 M0811500 NPLJCL MVI C'.'(WC),1 DISALLOW PERIOD AS LEGAL CHAR R41 M0812000 BAL WC,NPLID EXTRACT CHARACTER STRING R41 M0812500 CLI NPLWORK,C'0' TEST 1ST CHARACTER R41 M0813000 BNL NPLCHERR BR IF NUMBER TO ISSUE DIAGNOSTIC R41 M0813500 B NPLSTORC ELSE BR TO STORE VALUE R41 M0814000 EJECT R41 M0814500 NPLBACK NULL PARAMETER LIBRARY &BSPACE STATEMENT M0815000 LA WA,7(,WA) POINT TO 1ST HEX CHARACTER - 1 R41 M0815500 BAL WE,NREPHEX ENSURE 1ST HEX DIGIT VALID R41 M0816000 MVO NREPDATA(1),NREPCHAR SAVE ZONE NIBBLE R41 M0816500 BAL WE,NREPHEX ENSURE 2ND HEX DIGIT VALID R41 M0817000 CLI 1(WA),C' ' TEST TERMINATOR CHARACTER R41 M0817500 BNE NREPERR ILLEGAL IF NOT BLANK R41 M0818000 MVN NREPDATA(1),NREPCHAR SAVE NUMERIC NIBBLE R41 M0818500 MVC $BSPACE,NREPDATA UPDATE BACKSPACE CHARACTER R41 M0819000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0819500 SPACE 3 R41 M0820000 NPLCOMCH NULL , &CCOMCHR, &RCOMCHR STATEMENTS R41 M0820500 LA R1,NPLWORK POINT TO WORK AREA R41 M0821000 BAL WE,NPLCCOM1 EXTRACT CHARACTER R41 M0821500 L WE,=A(NPLTRT1) POINT TO TRANSLATE TABLE R41 M0822000 TRT NPLWORK(1),0(WE) TEST CHARACTER R41 M0822500 BNZ NPLCHERR BR IF ILLEGAL R41 M0823000 CLI NPLWORK,X'4A' RETEST CHARACTER R41 M0823500 BL NPLCHERR BR IF ILLEGAL R41 M0824000 CLI NPLWORK,X'7F' RETEST CHARACTER R41 M0824500 BH NPLCHERR R41 M0825000 B NPLSTORC ELSE BR TO STORE VALUE R41 M0825500 EJECT R41 M0826000 NPLCKSPL NULL , &CHKPT, &SPOOL STATEMENTS R41 M0826500 MVI C'-'(WC),0 ALLOW HYPHEN AS LEGAL CHARACTER R41 M0827000 MVI C'.'(WC),1 AND DISALLOW PERIOD R41 M0827500 B NPLCHAR BR TO COMMON PROCESSING R41 M0828000 SPACE 3 R41 M0828500 NPLDELAY NULL PARAMETER LIBRARY &DELAYTM STATEMENT M0829000 BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0829500 SLL R1,12 ADJUST VALUE R41 M0830000 B NPLSTORE BR TO STORE VALUE R41 M0830500 SPACE 3 R41 M0831000 NPLPRI NULL , &PRIHIGH, &PRILOW STATEMENTS R41 M0831500 BAL WC,NPLNUMBR EXTRACT AND CHECK NUMBER R41 M0832000 SLL R1,4 MULTIPLY BY 16 R41 M0832500 B NPLSTORE BR TO STORE VALUE R41 M0833000 EJECT R41 M0852000 NPLROPSL NULL PARAMETER LIBRARY &RDROPSL STATEMENT M0852500 L WD,=A(NRDROPSL) POINT TO LOGON 'RDR' PARMS R41 M0853000 B NPLRDROP BR TO CONTINUE R41 M0853500 SPACE 3 R41 M0854000 NPLROPST NULL PARAMETER LIBRARY &RDROPST STATEMENT M0854500 L WD,=A(NRDROPST) POINT TO STC 'RDR' PARMS R41 M0855000 B NPLRDROP BR TO CONTINUE R41 M0855500 SPACE 3 R41 M0856000 NPLROPSU NULL PARAMETER LIBRARY &RDROPSU STATEMENT M0856500 L WD,=A(NRDROPSU) POINT TO BATCH JOB 'RDR' PARMS R41 M0857000 SPACE 1 R41 M0857500 NPLRDROP BAL WC,NPLID EXTRACT 'RDR' PARM FIELD R41 M0858000 BAL WE,NPLRDVAL VALIDATE 'RDR' PARM FIELD R41 M0858500 B NPLCHERR BR IF ILLEGAL +0 R41 M0859000 B NPLSTORO BR TO SET VALUE +4 R41 M0859500 SPACE 3 R41 M0860000 NPLRPRI NULL PARAMETER LIBRARY &RPRI(N) STATEMENT M0860500 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M0861000 AL WD,$RTIMTAB ADD TABLE ORIGIN R41 M0861500 BAL WC,NPLNUMB EXTRACT AND CHECK NUMBER R41 M0862000 STC R1,0(,WD) STORE FIELD VALUE R41 M0862500 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0863000 SPACE 3 R41 M0863500 NPLRPRT NULL PARAMETER LIBRARY &RPRT(N) STATEMENT M0864000 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M0864500 AL WD,$RTIMTAB ADD TABLE OFFSET R41 M0865000 BAL WC,NPLNUMB EXTRACT AND CHECK NUMBER R41 M0865500 MH R1,=H'60' ADJUST NUMBER R41 M0866000 STCM R1,7,1(WD) STORE FIELD VALUE R41 M0866500 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0867000 EJECT R41 M0867500 NPLSID NULL PARAMETER LIBRARY &SID STATEMENT M0868000 MVI C'.'(WC),1 DISALLOW PERIOD AS LEGAL CHAR R41 M0868500 B NPLCHAR BR TO COMMON PROCESSING R41 M0869000 SPACE 3 R41 M0869500 NPLXLIN NULL PARAMETER LIBRARY &XLIN(N) STATEMENT M0870000 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M0870500 AL WD,=A(NXPRITAB) ADD TABLE ORIGIN R41 M0871000 BAL WC,NPLNUMB EXTRACT AND CHECK NUMBER R41 M0871500 STCM R1,7,1(WD) STORE FIELD VALUE R41 M0872000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0872500 SPACE 3 R41 M0873000 NPLXPRI NULL PARAMETER LIBRARY &XPRI(N) STATEMENT M0873500 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M0874000 AL WD,=A(NXPRITAB) ADD TABLE ORIGIN R41 M0874500 BAL WC,NPLNUMB EXTRACT AND CHECK NUMBER R41 M0875000 SLL R1,4 MULTIPLY BY 16 R41 M0875500 STC R1,0(,WD) STORE FIELD VALUE R41 M0876000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0876500 SPACE 3 R41 M0877000 NPLINDEX CLI 5(WA),C'(' WAS KEYWORD SUBSCRIPTED... R41 M0877500 BNE NPLSSERR BR TO ISSUE DIAGNOSTIC @OZ30738 M0878000 CLI 7(WA),C')' TEST FOR SUBSCRIPT TERMINATOR R41 M0878500 BNE NPLDXERR ILLEGAL IF NO R41 M0879000 CLI 6(WA),C'1' IF R41 M0879500 BL NPLDXERR SUBSCRIPT R41 M0880000 CLI 6(WA),C'9' INVALID, R41 M0880500 BH NPLDXERR BR TO ISSUE DIAGNOSTIC R41 M0881000 IC WD,6(,WA) WD = SUBSCRIPT R41 M0881500 N WD,=F'15' CONVERTED R41 M0882000 BCTR WD,0 TO TABLE R41 M0882500 SLL WD,2 OFFSET R41 M0883000 BR WE RETURN R41 M0883500 SPACE 1 R41 M0884000 NPLDXERR L R1,=A(NPLDXERM) POINT TO ILLEGAL SUBSCRIPT MSG R41 M0884500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R41 M0885000 EJECT R41 M0885500 *********************************************************************** M0886000 * * M0886500 * NPLNUMBR -- ROUTINE TO EXTRACT AND VALIDATE NUMERIC VALUE * M0887000 * * M0887500 *********************************************************************** M0888000 SPACE 1 R41 M0888500 NPLNUMBR BAL R1,NPLSETWA ADJUST WA FOR COMMON CODE R41 M0889000 SPACE 1 R41 M0889500 NPLNUMB BAL WE,NPLDCNVT EXTRACT NUMBER R41 M0890000 B NPLBADNO BR IF ILLEGAL NUMBER +0 R41 M0890500 CLI 0(WA),C' ' IF TERMINATOR IS A BLANK, +4 R41 M0891000 BE NRANGECK BR TO CHECK FOR WITHIN RANGE R41 M0891500 CLR WA,R15 IF NOT END OF CARD, R41 M0892000 BNH NPLDCERR BR TO ISSUE DIAGNOSTIC R41 M0892500 SPACE 1 R41 M0893000 NRANGECK CH R1,PTELOVAL IF R41 M0893500 BL NPLBADNO WITHIN R41 M0894000 C R1,PTEHIVAL VALID RANGE, R41 M0894500 BNHR WC RETURN R41 M0895000 SPACE 1 R41 M0895500 NPLBADNO LH LINK,PTELOVAL GET LOWER LIMIT R41 M0896000 L R0,PTEHIVAL GET UPPER LIMIT R41 M0896500 SPACE 1 R41 M0897000 NRANGERR L R1,=A(NRANGERM) POINT TO ILLEGAL RANGE MSG R41 M0897500 MVC 17(15,R1),=X'2021206B4020202020202020202120' R41 M0898000 CVD LINK,NPLLWORK FILL IN R41 M0898500 ED 16(4,R1),NPLLWORK+6 LOWER LIMIT R41 M0899000 CVD R0,NPLDBL FILL IN R41 M0899500 MVO NPLLWORK,NPLDBL UPPER R41 M0900000 ED 21(11,R1),NPLLWORK+2 LIMIT R41 M0900500 B NPLERMSG THEN BR TO ISSUE DIAGNOSTIC R41 M0901000 SPACE 3 R41 M0901500 *********************************************************************** M0902000 * * M0902500 * NPLSETWA -- SUBROUTINE TO ADJUST KEYWD ADDR FOR COMMON CODE * M0903000 * * M0903500 *********************************************************************** M0904000 SPACE 1 R41 M0904500 NPLSETWA LA R0,8 SET TO MAXIMUM KEYWORD LENGTH R41 M0905000 SPACE 1 R41 M0905500 NPLTSTWA CLM R0,1,PTEKEYLN TEST KEYWORD LENGTH R41 M0906000 BER R1 RETURN IF MATCH R41 M0906500 BCTR WA,0 BACK UP KEYWORD POINTER R41 M0907000 BCT R0,NPLTSTWA REDUCE LENGTH AND LOOP R41 M0907500 SPACE 1 R41 M0908000 I03 $ERROR ERROR IN PARAMETER TABLE R41 M0908500 EJECT R41 M0909000 *********************************************************************** M0909500 * * M0910000 * NPLID -- SUBROUTINE TO EXTRACT AND VALIDATE EBCDIC VALUE * M0910500 * * M0911000 *********************************************************************** M0911500 SPACE 1 R41 M0912000 NPLID BAL R1,NPLSETWA ADJUST WA FOR COMMON CODE R41 M0912500 CLI 8(WA),C'=' TEST NEXT CHARACTER R41 M0913000 BNE NPLSSERR INVALID IF NOT EQUAL SIGN R41 M0913500 LA WA,8(,WA) STEP OVER KEYWORD R41 M0914000 LA WE,1(,WA) SAVE FIELD ORIGIN ADDRESS R41 M0914500 SPACE 1 R41 M0915000 NPLIDEND BXH WA,R14,NPLSSERR LOCATE R41 M0915500 CLI 0(WA),C' ' END OF R41 M0916000 BNE NPLIDEND FIELD R41 M0916500 SPACE 1 R41 M0917000 SLR WA,WE COMPUTE FIELD LENGTH R41 M0917500 CH WA,PTELOVAL IF FIELD LENGTH R41 M0918000 BL NPLCHERR NOT WITHIN R41 M0918500 C WA,PTEHIVAL VALID RANGE, R41 M0919000 BH NPLCHERR BR TO ISSUE DIAGNOSTIC R41 M0919500 MVC NPLWORK,NPLBLNKS INITIALIZE FIELD TO BLANKS R41 M0920000 LTR WA,WA TEST FOR NULL VALUE R41 M0920500 BZR WC RETURN IF YES R41 M0921000 BCTR WA,0 LEFT JUSTIFY FIELD R41 M0921500 EX WA,NPLIDMV IN NPLWORK R41 M0922000 L WE,=A(NPLTRT2) POINT TO PARAMETER XLATE TABLE R41 M0922500 EX WA,NPLIDTRT SCAN FOR ILLEGAL CHARACTERS R41 M0923000 BZR WC RETURN IF NONE R41 M0923500 SPACE 1 R41 M0924000 NPLCHERR L R1,=A(NPLCHERM) POINT TO INVALID CHARACTER MSG R41 M0924500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R41 M0925000 SPACE 1 R41 M0925500 NPLIDMV MVC NPLWORK(*-*),0(WE) *** EXECUTE ONLY *** R41 M0926000 NPLIDTRT TRT NPLWORK(*-*),0(WE) *** EXECUTE ONLY *** R41 M0926500 TITLE 'HASP INITIALIZATION -- INITIALIZATION PARAMETER STATEMECM0927000 NT DISPLAY PROCESSING ROUTINES' R41 M0927500 NPLSHOW NULL PARAMETER LIBRARY DISPLAY STATEMENT M0928000 LA WA,1(,WA) SKIP R41 M0928500 CLI 0(WA),C' ' OVER R41 M0929000 BNE NPLSHOW KEYWORD R41 M0929500 SPACE 1 R41 M0930000 NPLSHKEY BXH WA,R14,NPLSSERR LOCATE NAME R41 M0930500 CLI 0(WA),C' ' OF FIELD TO BE R41 M0931000 BE NPLSHKEY DISPLAYED R41 M0931500 SPACE 1 R41 M0932000 CLI 0(WA),C'''' TEST FOR MESSAGE R41 M0932500 BE NPLSHMSG BR IF YES R41 M0933000 L WB,=A(NPLPTBL) POINT TO PARAMETER TABLE R41 M0933500 LA R0,NPLPTENT GET NUMBER OF TABLE ENTRIES R41 M0934000 SLR WC,WC CLEAR FOR INSERTS R41 M0934500 SPACE 1 R41 M0935000 NPLSHNX1 IC WC,PTEKEYLN GET LENGTH OF KEYWORD R41 M0935500 BCTR WC,0 REDUCE FOR EXECUTE R41 M0936000 EX WC,NPLCLCLC EXECUTE COMPARE R41 M0936500 BE NPLSHNX2 BR IF NAME MATCHES STATEMENT R41 M0937000 LA WB,PTELENG(,WB) GET NEXT TABLE ENTRY R41 M0937500 BCT R0,NPLSHNX1 TEST NEXT ENTRY R41 M0938000 SPACE 1 R41 M0938500 NPLSHER1 LA R1,NPLDSAVE FAKE CONTROL BLOCK ADDRESS @OZ30738 M0939000 B NPLDVERR AND BR TO ISSUE DIAGNOSTIC R41 M0939500 SPACE 1 R41 M0940000 NPLSHNX2 LR R1,WA RELOAD FIELD ADDRESS R41 M0940500 SPACE 1 R41 M0941000 NPLSHNX3 BXH R1,R14,NPLSSERR LOCATE R41 M0941500 CLI 0(R1),C' ' END OF R41 M0942000 BNE NPLSHNX3 FIELD R41 M0942500 SPACE 1 R41 M0943000 TM PTEFLG1,PTE1SHOW IS FIELD DISPLAYABLE... R41 M0943500 BZ NPLSHERR BR IF NO R41 M0944000 MVC NPLWORK,NPLBLNKS SET WORK AREA TO BLANKS R41 M0944500 LH WD,PTEDISPL GET FIELD DISPLACEMENT R41 M0945000 ALR WD,BASE1 ADD HCT ORIGIN R41 M0945500 ICM R1,7,PTEDRTN GET DISPLAY ROUTINE ADDRESS R41 M0946000 BNZR R1 BR IF PRESENT R41 M0946500 SPACE 1 R41 M0947000 NPLSHERR L R1,=A(NPLSHERM) POINT TO ERROR MESSAGE R41 M0947500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R41 M0948000 EJECT R41 M0948500 *********************************************************************** M0949000 * * M0949500 * NPLSHMSG -- ROUTINE TO DISPLAY MESSAGE TO OPERATOR * M0950000 * * M0950500 *********************************************************************** M0951000 SPACE 1 R41 M0951500 NPLSHMSG SLR WC,WC CLEAR MESSAGE LENGTH R41 M0952000 TM NPLFLAGS,NPLCONSL ARE WE IN CONSOLE MODE... R41 M0952500 BZ NPLSHQ BR IF NO R41 M0953000 AL WA,=A(NLOGTEXT-NCARD) ELSE USE R41 M0953500 AL R15,=A(NLOGTEXT-NCARD) NON-UPPER-CASE TEXT R41 M0954000 SPACE 1 R41 M0954500 NPLSHQ LR WD,WA SAVE ADDRESS OF START OF TEXT R41 M0955000 SPACE 1 R41 M0955500 NPLSHQ1 BXH WA,R14,NPLSSERR GET NEXT CHARACTER R41 M0956000 LA WC,1(,WC) BUMP LENGTH R41 M0956500 CLI 0(WA),C'''' TEST FOR CLOSING QUOTE R41 M0957000 BNE NPLSHQ1 LOOP IF NO R41 M0957500 CLI 1(WA),C'''' TEST FOR INTERNAL QUOTE R41 M0958000 BNE NPLSHQ2 BR IF NO TO DISPLAY MESSAGE R41 M0958500 LR R1,R15 OVERLAY R41 M0959000 SLR R1,WA INTERNAL R41 M0959500 EX R1,NPLSHQM1 QUOTE R41 M0960000 B NPLSHQ1 BR TO RESUME SCAN R41 M0960500 SPACE 1 R41 M0961000 NPLSHQ2 BCT WC,NPLSHQ3 BR IF NON-NULL MESSAGE R41 M0961500 B NPLCOMNT ELSE BR TO LIST/LOG STATEMENT R41 M0962000 SPACE 1 R41 M0962500 NPLSHQ3 L R1,=A(NLSTMSG) POINT TO DISPLAY MESSAGE R41 M0963000 MVC NLSTTXT-NLSTMSG(,R1),NPLBLNKS CLEAR MESSAGE AREA R41 M0963500 BCTR WC,0 REDUCE FOR EXECUTE R41 M0964000 EX WC,NPLSHQM2 MOVE MESSAGE INTO DISPLAY AREA R41 M0964500 $$WTO (R1) ISSUE MESSAGE TO OPERATOR R41 M0965000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M0965500 SPACE 1 R41 M0966000 NPLSHQM1 MVC 0(*-*,WA),1(WA) *** EXECUTE ONLY *** R41 M0966500 NPLSHQM2 MVC NLSTTXT-NLSTMSG(*-*,R1),1(WD) *** EXECUTE ONLY *** R41 M0967000 EJECT R41 M0967500 *********************************************************************** M0968000 * * M0968500 * NPLSHNUM -- ROUTINE TO DISPLAY NUMERIC VALUE TO OPERATOR * M0969000 * * M0969500 *********************************************************************** M0970000 SPACE 1 R41 M0970500 NPLSHNUM SLR R0,R0 CLEAR FOR INSERT R41 M0971000 IC R0,0(,WD) ASSUME 1-BYTE FIELD R41 M0971500 CLI PTEFLDLN,1 TEST ASSUMPTION R41 M0972000 BE NPLSHOWN BR IF VALID R41 M0972500 ICM R0,3,0(WD) ASSUME 2-BYTE FIELD R41 M0973000 CLI PTEFLDLN,2 TEST ASSUMPTION R41 M0973500 BE NPLSHOWN BR IF VALID R41 M0974000 ICM R0,7,0(WD) ASSUME 3-BYTE FIELD R41 M0974500 CLI PTEFLDLN,3 TEST ASSUMPTION R41 M0975000 BE NPLSHOWN BR IF VALID R41 M0975500 L R0,0(,WD) ASSUME 4-BYTE FIELD R41 M0976000 CLI PTEFLDLN,4 TEST ASSUMPTION R41 M0976500 BNE I02 BR IF INVALID (TABLE ERROR) R41 M0977000 LPR R0,R0 ENSURE NUMBER IS POSITIVE R41 M0977500 SPACE 1 R41 M0978000 NPLSHOWN BAL WE,NPLSHEDT EDIT VALUE INTO NPLWORK R41 M0978500 B NPLSHWTO BR TO DISPLAY VALUE R41 M0979000 SPACE 3 R41 M0979500 *********************************************************************** M0980000 * * M0980500 * NPLSHEDT -- SUBROUTINE TO EDIT NUMERIC VALUE INTO NPLWORK * M0981000 * * M0981500 *********************************************************************** M0982000 SPACE 1 R41 M0982500 NPLSHEDT LA R1,NPLWORK POINT TO WORK AREA R41 M0983000 SPACE 1 R41 M0983500 NPLSHED2 CVD R0,NPLDBL CONVERT VALUE TO DECIMAL R41 M0984000 UNPK 0(8,R1),NPLDBL UNPACK INTO WORK AREA R41 M0984500 OI 7(R1),C'0' MAKE DISPLAYABLE R41 M0985000 SPACE 1 R41 M0985500 NPLSHNXT CLI 1(R1),C' ' TEST FOR END OF FIELD R41 M0986000 BER WE RETURN IF YES R41 M0986500 CLI 0(R1),C'0' TEST FOR HIGH-ORDER ZERO R41 M0987000 BNER WE RETURN IF NO R41 M0987500 MVC 0(8,R1),1(R1) SHIFT OUT HIGH-ORDER ZERO R41 M0988000 B NPLSHNXT CONTINUE R41 M0988500 EJECT R41 M0989000 *********************************************************************** M0989500 * * M0990000 * NPLSHCH -- ROUTINE TO DISPLAY EBCDIC VALUE TO OPERATOR * M0990500 * * M0991000 *********************************************************************** M0991500 SPACE 1 R41 M0992000 NPLSHCH IC R1,PTEFLDLN GET FIELD LENGTH R41 M0992500 BCTR R1,0 REDUCE FOR EXECUTE R41 M0993000 EX R1,NPLSHMOV MOVE VALUE TO NPLWORK R41 M0993500 B NPLSHWTO BR TO DISPLAY VALUE R41 M0994000 SPACE 1 R41 M0994500 NPLSHMOV MVC NPLWORK(*-*),0(WD) *** EXECUTE ONLY *** R41 M0995000 SPACE 3 R41 M0995500 *********************************************************************** M0996000 * * M0996500 * NPLSHOPT -- ROUTINE TO DISPLAY OPTION VALUE TO OPERATOR * M0997000 * * M0997500 *********************************************************************** M0998000 SPACE 1 R41 M0998500 NPLSHOPT MVC NPLWORK(2),=C'NO ' ASSUME SWITCH NOT SET R41 M0999000 IC R1,PTESWYES GET 'ON' VALUE R41 M0999500 EX R1,NPLSHSWT IS SWITCH ON... R41 M1000000 BZ NPLSHWTO BR IF NO R41 M1000500 MVC NPLWORK(3),=C'YES ' ELSE SET 'YES' R41 M1001000 SPACE 1 R41 M1001500 NPLSHWTO L R1,=A(NLSTMSG) POINT TO DISPLAY MESSAGE R41 M1002000 MVC NLSTTXT-NLSTMSG(,R1),NPLBLNKS CLEAR MESSAGE AREA R41 M1002500 MVC NLSTKEY-NLSTMSG(,R1),PTEKEY MOVE IN KEYWORD R41 M1003000 LA WC,NLSTKEY+1-NLSTMSG(WC,R1) SKIP OVER KEYWORD R41 M1003500 SPACE 1 R41 M1004000 NPLSHMEQ MVI 0(WC),C'=' SET EQUAL SIGN R41 M1004500 MVC 1(L'NPLWORK,WC),NPLWORK MOVE IN FIELD VALUE R41 M1005000 $$WTO (R1) DISPLAY FIELD VALUE R41 M1005500 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M1006000 SPACE 1 R41 M1006500 NPLSHSWT TM 0(WD),*-* *** EXECUTE ONLY *** R41 M1007000 EJECT R41 M1021500 NPLDRPRI CLI 5(WA),C'(' TEST FOR SUBSCRIPT R41 M1022000 BNE NPLSHER1 BR TO ISSUE DIAGNOSTIC @OZ30738 M1022500 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M1023000 AL WD,$RTIMTAB ADD TABLE ORIGIN R41 M1023500 SLR R0,R0 CLEAR FOR INSERT R41 M1024000 IC R0,0(,WD) GET FIELD VALUE R41 M1024500 B NPLDNDX BR TO EDIT VALUE R41 M1025000 SPACE 3 R41 M1025500 NPLDRPRT CLI 5(WA),C'(' TEST FOR SUBSCRIPT R41 M1026000 BNE NPLSHER1 BR TO ISSUE DIAGNOSTIC @OZ30738 M1026500 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M1027000 AL WD,$RTIMTAB ADD TABLE ORIGIN R41 M1027500 SLR R1,R1 CLEAR FOR INSERT R41 M1028000 ICM R1,7,1(WD) GET FIELD VALUE R41 M1028500 SLR R0,R0 CLEAR FOR DIVIDE R41 M1029000 D R0,=F'60' DIVIDE BY 60 R41 M1029500 LR R0,R1 MOVE QUOTIENT TO R0 R41 M1030000 B NPLDNDX BR TO EDIT VALUE R41 M1030500 SPACE 3 R41 M1031000 NPLDXLIN CLI 5(WA),C'(' TEST FOR SUBSCRIPT R41 M1031500 BNE NPLSHER1 BR TO ISSUE DIAGNOSTIC @OZ30738 M1032000 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M1032500 AL WD,=A(NXPRITAB) ADD TABLE ORIGIN R41 M1033000 SLR R0,R0 CLEAR FOR INSERT R41 M1033500 ICM R0,7,1(WD) GET FIELD VALUE R41 M1034000 B NPLDNDX BR TO EDIT VALUE R41 M1034500 SPACE 3 R41 M1035000 NPLDXPRI CLI 5(WA),C'(' TEST FOR SUBSCRIPT R41 M1035500 BNE NPLSHER1 BR TO ISSUE DIAGNOSTIC @OZ30738 M1036000 BAL WE,NPLINDEX GET TABLE OFFSET IN WD R41 M1036500 AL WD,=A(NXPRITAB) ADD TABLE ORIGIN R41 M1037000 SLR R0,R0 CLEAR FOR INSERT R41 M1037500 IC R0,0(,WD) GET FIELD VALUE R41 M1038000 SRL R0,4 DIVIDE BY 16 R41 M1038500 SPACE 1 R41 M1039000 NPLDNDX BAL WE,NPLSHEDT EDIT VALUE INTO NPLWORK R41 M1039500 L R1,=A(NLSTMSG) POINT TO DISPLAY MESSAGE R41 M1040000 MVC NLSTTXT-NLSTMSG(,R1),NPLBLNKS CLEAR MESSAGE AREA R41 M1040500 MVC NLSTKEY-NLSTMSG(8,R1),0(WA) MOVE IN KEYWORD R41 M1041000 LA WC,NLSTKEY+8-NLSTMSG(,R1) SKIP OVER KEYWORD R41 M1041500 B NPLSHMEQ BR TO DISPLAY VALUE R41 M1042000 EJECT R41 M1042500 NPLDSSSM MVC NPLWORK(8),NPLSSSM MOVE SSSM NAME TO NPLWORK R41 M1043000 B NPLSHWTO BR TO DISPLAY IT R41 M1043500 SPACE 3 R41 M1044000 NPLDOPSL L WD,=A(NRDROPSL) POINT TO LOGON 'RDR' PARMS R41 M1044500 B NPLSHCH BR TO DISPLAY THEM R41 M1045000 SPACE 3 R41 M1045500 NPLDOPST L WD,=A(NRDROPST) POINT TO STC 'RDR' PARMS R41 M1046000 B NPLSHCH BR TO DISPLAY THEM R41 M1046500 SPACE 3 R41 M1047000 NPLDOPSU L WD,=A(NRDROPSU) POINT TO BATCH JOB 'RDR' PARMS R41 M1047500 B NPLSHCH BR TO DISPLAY THEM R41 M1048000 SPACE 3 R41 M1048500 NPLDDLAY L R0,0(,WD) GET FIELD VALUE R41 M1049000 SRL R0,12 UNADJUST VALUE R41 M1049500 B NPLSHOWN BR TO DISPLAY IT R41 M1050000 SPACE 3 M1050500 NPLDPRI SR R0,R0 CLEAR REG FOR INSERT R41 M1050600 IC R0,0(,WD) GET FIELD VALUE R41 M1050700 SRL R0,4 DIVIDE BY 16 R41 M1050800 B NPLSHOWN BR TO DISPLAY VALUE R41 M1050900 SPACE 1 R41 M1051000 DROP WB KILL PTE ADDRESSABILITY R41 M1051100 TITLE 'HASP INITIALIZATION -- OS/JES2 REP FACILITY PROCESSING CM1061500 ROUTINES' R41 M1062000 NPLBASE NULL PARAMETER LIBRARY BASE STATEMENT R4 M1062500 BAL WD,NREPLSCN SCAN LOCATION FIELDS R4 M1063000 ST WC,12(,WB) SET NEW BASE R4 M1063500 B NPLCOMNT PROCESS AS COMMENT STATEMENT R4 M1064000 SPACE 5 R4 M1064500 NPLVER NULL PARAMETER LIBRARY VERIFY STATEMENT M1065000 BAL WD,NREPLSCN SCAN LOCATION FIELDS M1065500 BAL WD,NREPDSCN SCAN DATA FIELD M1066000 MODESET EXTKEY=ZERO SET ZERO PROTECT KEY M1066500 EX R1,NREPCLC PERFORM VERIFICATION CHECK M1067000 MODESET EXTKEY=HASP RESET HASP PROTECT KEY M1067500 BE NPLCOMNT BRANCH IF DATA VERIFIES M1068000 L R1,=A(NVERERM) POINT TO VERIFICATION MSG R4 M1068500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1069000 SPACE 5 M1069500 NPLREP NULL PARAMETER LIBRARY REPLACE STATEMENT M1070000 BAL WD,NREPLSCN SCAN LOCATION FIELDS M1070500 CLC NREPMOD,=C'ABS ' REP TO ABSOLUTE LOCATION... R41 M1070600 BE NPLREPIT BR IF YES R41 M1070700 OC 8(4,WB),8(WB) IS MODULE LOCATABLE... R41 M1070800 BZ NREPERR ERROR IF NO R41 M1070900 SPACE 1 R41 M1071000 NPLREPIT BAL WD,NREPDSCN SCAN DATA FIELDS R41 M1071100 MODESET EXTKEY=ZERO SET ZERO PROTECT KEY M1071500 EX R1,NREPMVC MOVE DATA TO SPECIFIED LOCATION M1072000 MODESET EXTKEY=HASP RESET HASP PROTECT KEY M1072500 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1073000 EJECT M1073500 NPLNAME NULL PARAMETER LIBRARY NAME STATEMENT M1074000 BAL WE,NREPBSCN FIND START OF MEMBER NAME FIELD M1074500 BAL WE,NREPBSCN FIND START OF MODULE NAME FIELD M1075000 CLC 0(4,WA),=CL4'HASP' TEST FIRST FOUR CHARACTERS M1075500 BNE NREPERR ERROR IF NOT 'HASP....' M1076000 MVC NREPMOD,4(WA) SET LAST FOUR CHARACTERS OF NAME M1076500 BAL WE,NREPNSCN GET ADDRESS OF DIRECTORY ENTRY M1077000 MVC NREPZAP,8(WB) SAVE MODULE ADDRESS M1077500 XC NREPBASE,NREPBASE RESET MODULE BASE M1078000 OI NPLFLAGS,NPLZAPSW INDICATE SPZAP MODE M1078500 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1079000 SPACE 3 R41 M1079500 NPLENDZP NULL PARAMETER LIBRARY ENDZAP STATEMENT M1080000 NI NPLFLAGS,255-NPLZAPSW RESET SPZAP MODE M1080500 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1081000 SPACE 3 R41 M1081500 NREPLSCN NULL SCAN REP LOCATION FIELDS M1082000 BAL WE,NREPBSCN FIND START OF SECOND FIELD M1082500 LA WB,NREPZAP-8 ASSUME SPZAP MODE M1083000 TM NPLFLAGS,NPLZAPSW TEST REP MODE M1083500 BO NREPLSC1 BRANCH IF SPZAP MODE M1084000 L WB,NREPNAME POINT TO LAST DIRECTORY ENTRY R41 M1084100 CLC 0(2,WA),=CL2'* ' TEST MODULE NAME R41 M1084200 BE NREPLSC BR IF UNCHANGED R41 M1084300 MVC NREPMOD,0(WA) SET MODULE NAME M1084500 BAL WE,NREPNSCN GET ADDRESS OF DIRECTORY ENTRY M1085000 ST WB,NREPNAME AND SAVE M1085500 SPACE 1 R41 M1085600 NREPLSC BAL WE,NREPBSCN FIND START OF LOCATION FIELD R41 M1086000 L WC,NREPLOC ASSUME PREVIOUS LOCATION M1086500 CLC 0(2,WA),=CL2'* ' TEST LOCATION FIELD M1087000 BER WD RETURN IF '*' M1087500 SPACE 2 M1088000 NREPLSC1 SR WC,WC CLEAR LOCATION REGISTER M1088500 BCTR WA,0 BACK UP ONE CHARACTER M1089000 BAL WE,NREPHEX VALIDATE AND CONVERT CHARACTER M1089500 SLL WC,4 SHIFT TOTAL M1090000 O WC,NREPWORD ADD NEW VALUE M1090500 CL WC,=X'00FFFFFF' TEST TOTAL M1091000 BH NREPERR BRANCH IF LOCATION LIMIT EXCEEDED M1091500 CLI 1(WA),C' ' TEST NEXT CHARACTER M1092000 BNE NREPHEX CONVERT NEXT CHARACTER IF NOT BLANK M1092500 BR WD RETURN M1093000 EJECT M1093500 NREPDSCN NULL DATA SCAN SUBROUTINE M1094000 ST WC,NREPLOC SAVE CURRENT DISPLACEMENT M1094500 AL WC,8(,WB) ADD MODULE ADDRESS M1095000 SL WC,12(,WB) SUBTRACT ASSEMBLY BASE M1095500 BAL WE,NREPBSCN FIND START OF DATA FIELD M1096000 BCTR WA,0 BACK UP ONE CHARACTER M1096500 LA R1,NREPDATA GET ADDRESS OF PACKED DATA M1097000 SPACE 2 M1097500 NREPDSC1 LA R0,2 CONVERT TWO EBCDIC CHARACTERS M1098000 B NREPDSC3 TO ONE BYTE M1098500 SPACE 1 M1099000 NREPDSC2 MVO 0(1,R1),NREPCHAR SET ZONE NIBBLE M1099500 SPACE 1 M1100000 NREPDSC3 BAL WE,NREPHEX VALIDATE AND CONVERT CHARACTER M1100500 BCT R0,NREPDSC2 BRANCH IF FIRST CHARACTER M1101000 MVN 0(1,R1),NREPCHAR SET NUMERIC NIBBLE M1101500 LA R1,1(,R1) ADVANCE TO NEXT BYTE M1102000 SPACE 2 M1102500 CLI 1(WA),C'(' TEST NEXT CHARACTER M1103000 BNE NREPDSC4 BRANCH IF NOT LEFT PARENTHESIS M1103500 TM NPLFLAGS,NPLZAPSW TEST REP MODE M1104000 BO NREPERR ERROR IF SPZAP MODE M1104500 MVC NREPMOD,2(WA) SET MODULE NAME M1105000 MVI NREPMOD+4,C')' ADD TERMINATION CHARACTER M1105500 LA WB,NREPMOD SCAN M1106000 LA WB,1(,WB) FOR M1106500 CLI 0(WB),C')' RIGHT M1107000 BNE *-8 PARENTHESIS M1107500 MVI 0(WB),C' ' BLANK IT OUT M1108000 BAL WE,NREPNSCN GET ADDRESS OF DIRECTORY ENTRY M1108500 SL R1,=F'4' BACK UP REP DATA ADDRESS M1109000 L R0,0(,R1) GET REP DATA M1109500 AL R0,8(,WB) ADD MODULE ADDRESS M1110000 SL R0,12(,WB) SUBTRACT ASSEMBLY BASE M1110500 ST R0,0(,R1) UPDATE REP DATA M1111000 LA R1,4(,R1) RESTORE REP DATA ADDRESS M1111500 BXH WA,R14,NREPERR SCAN FOR M1112000 CLI 0(WA),C')' END OF M1112500 BNE *-8 MODULE NAME M1113000 SPACE 2 M1113500 NREPDSC4 CLI 1(WA),C',' TEST NEXT CHARACTER M1114000 BNE *+8 BRANCH IF NOT COMMA M1114500 BXH WA,R14,NREPERR STEP OVER COMMA M1115000 CLI 1(WA),C' ' TEST NEXT CHARACTER M1115500 BNE NREPDSC1 BRANCH IF NOT BLANK M1116000 SL R1,=A(NREPDATA+1) COMPUTE LENGTH OF DATA M1116500 L WB,NREPLOC GET DISPLACEMENT M1117000 LA WB,1(R1,WB) ADD DATA LENGTH M1117500 ST WB,NREPLOC UPDATE DISPLACEMENT M1118000 BR WD RETURN M1118500 EJECT M1119000 NREPBSCN NULL FIND START OF VARIABLE FIELD M1119500 BXH WA,R14,NREPERR SCAN FOR M1120000 CLI 0(WA),C' ' START OF M1120500 BNE *-8 BLANK FIELD M1121000 SPACE 1 M1121500 BXH WA,R14,NREPERR SCAN FOR M1122000 CLI 0(WA),C' ' START OF M1122500 BE *-8 NEXT FIELD M1123000 BR WE RETURN M1123500 SPACE 5 M1124000 NREPNSCN NULL FIND ADDRESS OF DIRECTORY ENTRY M1124500 L WB,$HASPMAP GET ADDRESS OF MODULE DIRECTORY M1127000 LA R0,MAPMODS GET ENTRIES IN MODULE DIRECTORY R4 M1127500 SPACE 2 M1128000 NREPNSC1 CLC NREPMOD,4(WB) CHECK LAST FOUR CHARACTERS OF NAME M1128500 BER WE RETURN IF MODULE FOUND M1129000 LA WB,16(,WB) GET ADDRESS OF NEXT ENTRY M1129500 BCT R0,NREPNSC1 CHECK NEXT ENTRY M1130000 B NREPERR ERROR, MODULE NAME NOT FOUND M1130500 SPACE 5 M1131000 NREPHEX NULL CONVERT HEX CHARACTER TO BINARY M1131500 BXH WA,R14,NREPERR GET NEXT CHARACTER M1132000 CLI 0(WA),X'C1' TEST M1132500 BL NREPERR ILLEGAL IF LESS THAN X'C1' M1133000 MVC NREPCHAR,0(WA) MOVE CHARACTER TO WORK AREA M1133500 TR NREPCHAR,NREPTTAB TRANSLATE TO BINARY VALUE M1134000 CLI NREPCHAR,X'0F' VALIDATE RESULT M1134500 BNHR WE RETURN IF VALID M1135000 SPACE 5 M1135500 NREPERR NULL REP CARD DATA OR FORMAT ERROR M1136000 L R1,=A(NREPERM) POINT TO ILLEGAL REP MSG R4 M1136500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1137000 EJECT M1137500 SPACE 5 M1138000 * M1138500 * REP CONSTANTS AND WORK AREAS M1139000 * M1139500 SPACE 3 M1140000 NREPCLC CLC 0(*-*,WC),NREPDATA ***** EXECUTE ONLY ***** M1140500 NREPMVC MVC 0(*-*,WC),NREPDATA ***** EXECUTE ONLY ***** M1141000 SPACE 2 M1141500 NREPNAME DC A(*-*) ADDRESS OF MODULE DIRECTORY ENTRY R4 M1142000 NREPLOC DC A(*-*) DATA DISPLACEMENT M1142500 NREPZAP DC A(*-*) SPZAP MODULE ADDRESS M1143000 NREPBASE DC A(*-*) SPZAP MODULE BASE M1143500 NREPWORD DC 0F'0',XL3'00' WORK WORD M1144000 NREPCHAR DC XL1'00' WORK BYTE (LAST BYTE OF NREPWORD) M1144500 NREPMOD DC 2F'0' MODULE NAME SCAN AREA M1145000 NREPDATA DC XL33'00' PACKED DATA WORK AREA M1145500 SPACE 2 M1146000 NREPTTAB EQU *-X'C1' EBCDIC HEX TO BINARY TRANSLATE TABLE M1146500 DC X'0A0B0C0D0E0F',41X'FF',X'00010203040506070809',6X'FF' M1147000 TITLE 'INIT HASP INITIALIZATION -- COMPACT PARAMETER PROCEXM1147100 SSING ROUTINE' R41 M1147200 NPLCMPCT NULL PARAMETER LIBRARY COMPACT STMNT R41 M1147300 CLI 7(WA),C'=' TEST NEXT CHARACTER R41 M1147400 BNE NPLSSERR BR IF NOT EQUAL SIGN R41 M1147500 L R1,$CPTPOOL POINT TO WORK CPT (CPT 0) R41 M1147600 USING CPTDSECT,R1 R41 M1147700 SPACE 1 R41 M1147800 LR WC,R1 CLEAR R41 M1147900 LA WD,CPTEND-CPTDSECT WORK R41 M1148000 XR WB,WB CPT R41 M1148100 MVCL WC,WA BEFORE USING R41 M1148200 LA WA,7(,WA) POINT PAST THE KEYWORD R41 M1148300 BAL WE,NPLASCAN GET COMPACTION TABLE NUMBER R41 M1148400 LTR R0,R0 IF NUMBER IS ZERO OR NEG R41 M1148500 BNP NPLDVERR GO ISSUE ERROR MSG R41 M1148600 CH R0,=H'99' IF NUMBER IS GREATER THAN 99 R41 M1148700 BH NPLDVERR GO ISSUE ERROR MSG R41 M1148800 STC R0,CPTNUM SAVE CPT NUMBER R41 M1148900 BAL WE,NPLASCAN GET NUMBER OF MASTER CHARS R41 M1149000 CH R0,=H'3' IF LESS THAN 3 R41 M1149100 BL NPLDVERR GO ISSUE ERROR MSG R41 M1149200 CH R0,=H'16' IF MORE THAN 16 R41 M1149300 BH NPLDVERR GO ISSUE ERROR MSG R41 M1149400 STC R0,CPTNMAST SAVE NUMBER OF MASTER CHARS R41 M1149500 LA WC,X'F0' INITIAL CPTDTT DISPLACEMENT R41 M1149600 LA WB,CPTMST INITIAL CPTCAT ATTRIBUTE R41 M1149700 SPACE 1 R41 M1149800 NPLALOOP BAL WE,NPLASCAN GET A MASTER/NONMASTER CHAR R41 M1149900 LTR WD,WD TEST CHARACTER R41 M1150000 BZ NPLCHERR ZERO IS INVALID CHARACTER R41 M1150100 LA WE,CPTCAT(WD) IF CHARACTER R41 M1150200 CLI 0(WE),CPTCHAR HAS ALREADY BEEN USED R41 M1150300 BNE NPLDVERR GO ISSUE ERROR MSG R41 M1150400 STC WB,CPTCAT(WD) INIT R41 M1150500 STC WC,CPTCTT(WD) CPT R41 M1150600 STC WD,CPTDTT(WC) TABLES R41 M1150700 B NPLDCALC GO CALCULATE NEXT DISPLACEMENT R41 M1150800 EJECT R41 M1150900 NPLAOUT IC WB,CPTCAT+C' ' INDICATE R41 M1151000 LA WB,CPTPCHAR(,WB) BLANK R41 M1151100 STC WB,CPTCAT+C' ' IS PRIME R41 M1151200 IC WC,CPTNUM POINT TO R41 M1151300 MH WC,=AL2(CPTEND-CPTDSECT) CPT R41 M1151400 LA WC,0(R1,WC) TO BE INITIALIZED R41 M1151500 CLI CPTNMAST-CPTDSECT(WC),X'00' IF CPT IS ALREADY INIT R41 M1151600 BNE NPLAMVE DONT INCREMENT COUNT R41 M1151700 LH WB,$NUMCPTS INCREMENT R41 M1151800 LA WB,1(,WB) NUMBER OF R41 M1151900 STH WB,$NUMCPTS CPTS INITIALIZED R41 M1152000 SPACE 1 R41 M1152100 NPLAMVE LR WA,R1 MOVE WORK CPT R41 M1152200 LA WB,CPTEND-CPTDSECT TO CPT BEING INITIALIZED R41 M1152300 LR WD,WB OVERLAYING ANY R41 M1152400 MVCL WC,WA PREVIOUSLY DEFINED CPT R41 M1152500 B NPLCOMNT NEXT PARAMETER R41 M1152600 SPACE 1 R41 M1152700 DROP R1 R41 M1152800 TITLE 'HASP INITIALIZATION -- OS/JES2 COMMAND STATEMENT PROCESCM1152900 SING ROUTINE' R41 M1153000 NPLCOMND NULL PARAMETER LIBRARY COMMAND STATEMENT M1153100 GETMAIN R,LV=80,SP=229 GET TEMPORARY COMMAND AREA R4 M1153200 LA WA,NCOMMTAB POINT TO ADDR OF 1ST TMP CMD AREA R4 M1153300 SPACE 1 R4 M1153400 SKIP130 LR WB,WA LOCATE LAST R4 M1153500 ICM WA,15,0(WA) TEMPORARY R4 M1153600 BNZ SKIP130 COMMAND AREA R4 M1153700 SPACE 1 R4 M1153800 ST R1,0(,WB) ADD NEW TEMPORARY R4 M1153900 ST WA,0(,R1) COMMAND AREA TO END OF CHAIN R4 M1154000 MVC 8(72,R1),NCARD MOVE COMMAND TO TEMP AREA R4 M1154100 B NPLCOMNT PROCESS COMMAND STMNT AS COMMENT R4 M1154200 TITLE 'HASP INITIALIZATION -- SYSTEM PARAMETER PROCESSING ROUTCM1154500 INE' M1155000 NPLSN NULL PARAMETER LIBRARY SN STATEMENT M1155500 BXH WA,R14,NPLSSERR GET NEXT CHARACTER M1156000 CLI 0(WA),X'F0' TEST M1156500 BL NPLSSERR INVALID IF NOT NUMERIC M1157000 BE NPLSNERR INVALID IF 0 R4 M1157500 BAL WE,NPLDCONV GET SYSTEM NUMBER M1158000 B NPLSNERR BR IF ILLEGAL NUMBER +0 R4 M1158500 CLI 0(WA),C' ' TEST TERMINATOR CHARACTER +4 R4 M1159000 BNE NPLSNERR INVALID IF NOT BLANK M1159500 BCTR R1,0 DECREMENT SYSTEM NUMBER M1160000 CL R1,=F'7' AND TEST M1160500 BNL NPLSNERR INVALID IF NOT LESS THAN 7 M1161000 MH R1,=AL2(L'NS1) COMPUTE TABLE ENTRY DISPLACEMENT M1161500 AL R1,=A(NS1) GET ADDRESS OF TABLE ELEMENT M1162000 L R0,=A(NPLSYSST) GET ADDRESS OF SCAN TABLE R4 M1162500 BAL WE,NPLSSCAN SCAN SUB-PARAMETERS M1163000 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1163500 SPACE 5 M1164000 NPLSNERR NULL INVALID SYSTEM NUMBER M1164500 L R1,=A(NPLSNERM) POINT TO INVALID SYSTEM MSG R4 M1165000 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1165500 TITLE 'HASP INITIALIZATION -- LOGICAL INITIATOR PARAMETER PROCCM1166000 ESSING ROUTINE' M1166500 NPLINNN NULL PARAMETER LIBRARY INNN STATEMENT M1167000 BXH WA,R14,NPLSSERR GET NEXT CHARACTER M1167500 CLI 0(WA),X'F0' TEST M1168000 BL NPLSSERR INVALID IF NOT NUMERIC M1168500 BAL WE,NPLDCONV GET INITIATOR NUMBER M1169000 B NPLINERR BR IF ILLEGAL NUMBER +0 R4 M1169500 CLI 0(WA),C' ' TEST TERMINATOR CHARACTER +4 R4 M1170000 BNE NPLINERR INVALID IF NOT BLANK M1170500 LTR R0,R1 TEST INITIATOR NUMBER M1171000 BZ NPLINERR INVALID IF ZERO M1171500 L R1,=A(NMAXPART) OR R41 M1171600 C R0,0(,R1) GREATER R41 M1172000 BH NPLINERR THAN MAX R41 M1172500 L R1,$PITABLE GET R4 M1173000 BAL WE,*+8 ADDRESS M1173500 LA R1,PITLEN(,R1) OF R4 M1174000 BCTR R0,WE NTH PIT M1174500 L R0,=A(NPLPITST) GET ADDRESS OF SCAN TABLE R4 M1175000 BAL WE,NPLSSCAN SCAN SUB-PARAMETERS M1175500 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1176000 SPACE 5 M1176500 NPLINERR NULL INVALID INITIATOR NUMBER M1177000 L R1,=A(NPLINERM) POINT TO INVALID INITIATOR MSG R4 M1177500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1178000 TITLE 'HASP INITIALIZATION -- CLASS ATTRIBUTE TABLE PARAMETER CM1178500 PROCESSING ROUTINE' M1179000 NPLSTC NULL PARAMETER LIBRARY &STC STATEMENT M1179500 LA R1,CATSTCCL GET STC JOB CLASS M1180000 B NPLCAT1 UTILIZE COMMON CODE M1180500 SPACE 3 M1181000 NPLTSU NULL PARAMETER LIBRARY &TSU STATEMENT M1181500 LA R1,CATTSUCL GET TSU JOB CLASS M1182000 B NPLCAT1 UTILIZE COMMON CODE M1182500 SPACE 3 M1183000 NPLCATX NULL PARAMETER LIBRARY &X STATEMENT M1183500 CLI 1(WA),C'A' TEST JOB CLASS M1184000 BL NPLSSERR ILLEGAL IF LESS THAN 'A' M1184500 CLI 2(WA),C' ' TEST NEXT CHARACTER M1185000 BNE NPLSSERR ILLEGAL IF NOT BLANK M1185500 IC R1,1(,WA) GET JOB CLASS M1186000 SPACE 2 M1186500 USING CATDSECT,R1 PRIVIDE CAT ADDRESSABILITY R4 M1187000 SPACE 1 R4 M1187500 NPLCAT1 N R1,=A(X'3F') CONVERT TO JOB CLASS INDEX M1188000 SLL R1,5 MULTIPLY BY 32 M1188500 AL R1,$CATABLE GET ADDRESS OF CAT ELEMENT M1189000 TM CATJOBFL,CATVALID TEST CAT FLAGS R4 M1189500 BZ NPLSSERR BRANCH IF INVALID CLASS M1190000 L R0,=A(NPLCATST) GET ADDRESS OF SCAN TABLE R4 M1190500 BAL WE,NPLSSCAN SCAN SUB-PARAMETERS M1191000 CLC CATPERFM,=C'255' TEST PERFORMANCE GROUP R4 M1191500 BH NPLDVERR BR IF ILLEGAL SPECIFICATION R4 M1192000 CLI CATCONVP,0 TEST FOR CONVERTER PARM FIELD R4 M1192500 BE NPLCOMNT BR IF NO R4 M1193000 MVC NPLWORK,CATCONVP ELSE MOVE IT TO WORK AREA R4 M1193500 BAL WE,NPLRDVAL VALIDATE 'RDR' PARM FIELD R41 M1194000 B NPLDVERR BR IF ILLEGAL +0 R4 M1194500 B NPLCOMNT PROCESS PARM CARD AS COMMENT +4 R4 M1195000 SPACE 1 R4 M1195500 DROP R1 KILL CAT ADDRESSABILITY R4 M1196000 TITLE 'HASP INITIALIZATION -- SYSOUT CLASS ATTRIBUTE TABLE PARCM1196500 AMETER PROCESSING ROUTINE' M1197000 NPL$$X NULL PARAMETER LIBRARY $$X STATEMENT M1197500 CLI 2(WA),C'A' TEST SYSOUT CLASS M1198000 BL NPLSSERR ILLEGAL IF LESS THAN 'A' M1198500 CLI 3(WA),C' ' TEST NEXT CHARACTER M1199000 BNE NPLSSERR ILLEGAL IF NOT BLANK M1199500 SR R1,R1 CLEAR REGISTER M1200000 IC R1,2(,WA) GET SYSOUT CLASS M1200500 AL R1,=A(NSCAT) GET ADDRESS OF SCAT ENTRY M1201000 TM SCATFLAG-SCADSECT(R1),SCATINVL TEST SCAT FLAG M1201500 BO NPLSSERR BRANCH IF INVALID CLASS M1202000 L R0,=A(NPLSCAST) GET ADDRESS OF SCAN TABLE R4 M1202500 BAL WE,NPLSSCAN SCAN SUB-PARAMETERS M1203000 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1203500 TITLE 'HASP INITIALIZATION -- CARD READER PARAMETER PROCESSINGCM1204000 ROUTINE' M1204500 NPLRDR NULL PARAMETER LIBRARY READERNN STATEMENT M1205000 L R0,=A(NPLRDRST) GET ADDRESS OF SCAN TABLE R4 M1205500 BAL WE,NPLDSCAN SCAN READER SUB-PARAMETERS M1206000 SPACE 1 R4 M1206500 USING DCTDSECT,R1 ESTABLISH DCT ADDRESSABILITY M1207000 SPACE 1 R4 M1207500 SKIP140 CLI DCTPRRTE,0 TEST FOR PRINT ROUTING R4 M1211000 BNE NPLRROUT BR IF YES R41 M1211500 NI DCTFLAGS,255-DCTPRLCL ELSE RESET SPECIAL ROUTING FLG R4 M1212000 NPLRROUT DS 0H R41 M1212200 SKIP160 CLI DCTPURTE,0 TEST FOR PUNCH ROUTING R4 M1215500 BNE SKIP170 BR IF YES R4 M1216000 NI DCTFLAGS,255-DCTPULCL ELSE RESET SPECIAL ROUTING FLG R4 M1216500 SKIP170 CLI DCTMCLAS,C'A' TEST DEFAULT MSGCLASS M1217000 BL NPLDVERR ILLEGAL IF LESS THAN 'A' M1217500 B NPLRDVER BR TO CONCLUDE PARM VALIDATION R4 M1218000 TITLE 'HASP INITIALIZATION -- PRINT/PUNCH PARAMETER PROCESSINGCM1218500 ROUTINE' M1219000 NPLPRINT NULL PARAMETER LIBRARY PRINTERN STATEMENT M1219500 MVC NPLSVAL(5),0(WA) CONVERT M1220000 MVC NPLSVAL+5(4),6(WA) PRINTERNN M1220500 LA WA,NPLSVAL TO PRINTRNN M1221000 SPACE 5 M1221500 NPLPUNCH NULL PARAMETER LIBRARY PUNCHNN STATEMENT M1222000 L R0,=A(NPLPPST) GET ADDRESS OF SCAN TABLE R4 M1222500 BAL WE,NPLDSCAN SCAN DEVICE SUB-PARAMETERS M1223000 CLC DCTCKPTP,NPLMAXCP TEST CKPTPGS VALUE @OZ19494 M1223100 BH NPLDVERR ILLEGAL IF GREATER THAN MAX @OZ19494 M1223200 CLC DCTCKPTP,=H'0' TEST CKPTPGS VALUE @OZ19494 M1223225 BE NPLDVERR ILLEGAL IF ZERO @OZ19494 M1223250 CLC DCTCKPTL,NPLMAXCL TEST CKPTLNS VALUE @OZ19494 M1223300 BH NPLDVERR ILLEGAL IF GREATER THAN MAX @OZ19494 M1223400 CLC DCTLIMLO,PRPULIM LOWER DEVICE LIMIT VALID @OZ40627 M1223410 BH NPLDVERR BRANCH IF NO @OZ40627 M1223420 CLC DCTLIMHI,=X'FFFFFFFF' UPPER DEVICE LIMIT VALID @OZ40627 M1223430 BE NPLCOMNT BRANCH IF VALID @OZ40627 M1223440 CLC DCTLIMHI,PRPULIM UPPER DEVICE LIMIT VALID @OZ40627 M1223450 BH NPLDVERR BRANCH IF NO @OZ40627 M1223460 TM DCTDEVTP,DCTPRT TEST DEVICE TYPE @OZ19494 M1223500 BO NPLCOMNT IF PRTR, TREAT AS COMMENT @OZ19494 M1223600 CLC DCTCKPTL,=H'0' TEST CKPTLNS FOR PUNCH @OZ19494 M1223700 BE NPLDVERR ILLEGAL IF 0 @OZ19494 M1223800 B NPLCOMNT PROCESS AS COMMENT CARD @OZ19494 M1223900 PRPULIM DC F'999999' MAXIMUM LIMIT VALUE @OZ40627 M1223910 TITLE 'HASP INITIALIZATION -- INTERNAL READER PARAMETER PROCESCM1224000 SING ROUTINE' M1224500 NPLINR NULL PARAMETER LIBRARY INTRDR STATEMENT M1225000 L R1,=A(NINRDCT) GET ADDRESS OF INTRDR DCT R4 M1225500 L R0,=A(NPLINRST) GET ADDRESS OF SCAN TABLE R4 M1226000 BAL WE,NPLSSCAN SCAN INTERNAL READER SUB-PARAMETERS M1226500 SPACE 1 R4 M1227000 NPLRDVER CLI DCTPRINC,15 TEST PRIORITY INCREMENT R4 M1227500 BH NPLDVERR ILLEGAL IF GREATHER THAN 15 M1228000 CLI DCTPRLIM,15 TEST PRIORITY LIMIT M1228500 BH NPLDVERR ILLEGAL IF GREATHER THAN 15 M1229000 CLI DCTJCLAS,C'A' TEST DEFAULT JOB CLASS M1229500 BL NPLDVERR ILLEGAL IF LESS THAN 'A' M1230000 CLI DCTRAUTH,7 TEST COMMAND AUTHORIZATION LEVEL M1230500 BH NPLDVERR ILLEGAL IF GREATHER THAN 7 M1231000 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1231500 PUSH PRINT - SECTION @OZ39639 M1231600 PRINT OFF - DELETED @OZ39639 M1231700 * THIS LINE DELETED BY APAR @OZ39639 M1231800 * THIS LINE DELETED BY APAR @OZ39639 M1231900 * THIS LINE DELETED BY APAR @OZ39639 M1232000 * THIS LINE DELETED BY APAR @OZ39639 M1232100 * THIS LINE DELETED BY APAR @OZ39639 M1232200 * THIS LINE DELETED BY APAR @OZ39639 M1232300 * THIS LINE DELETED BY APAR @OZ39639 M1232400 * THIS LINE DELETED BY APAR @OZ39639 M1232500 * THIS LINE DELETED BY APAR @OZ39639 M1232600 * THIS LINE DELETED BY APAR @OZ39639 M1232700 * THIS LINE DELETED BY APAR @OZ39639 M1232800 * THIS LINE DELETED BY APAR @OZ39639 M1232900 * THIS LINE DELETED BY APAR @OZ39639 M1233000 * THIS LINE DELETED BY APAR @OZ39639 M1233100 * THIS LINE DELETED BY APAR @OZ39639 M1233200 * THIS LINE DELETED BY APAR @OZ39639 M1233300 * THIS LINE DELETED BY APAR @OZ39639 M1233400 * THIS LINE DELETED BY APAR @OZ39639 M1233500 * THIS LINE DELETED BY APAR @OZ39639 M1233600 * THIS LINE DELETED BY APAR @OZ39639 M1233700 * THIS LINE DELETED BY APAR @OZ39639 M1233800 * THIS LINE DELETED BY APAR @OZ39639 M1233900 * THIS LINE DELETED BY APAR @OZ39639 M1234000 * THIS LINE DELETED BY APAR @OZ39639 M1234100 * THIS LINE DELETED BY APAR @OZ39639 M1234200 * THIS LINE DELETED BY APAR @OZ39639 M1234300 * THIS LINE DELETED BY APAR @OZ39639 M1234400 * THIS LINE DELETED BY APAR @OZ39639 M1234500 * THIS LINE DELETED BY APAR @OZ39639 M1234600 * THIS LINE DELETED BY APAR @OZ39639 M1234700 * THIS LINE DELETED BY APAR @OZ39639 M1234800 * THIS LINE DELETED BY APAR @OZ39639 M1234900 * THIS LINE DELETED BY APAR @OZ39639 M1235000 * THIS LINE DELETED BY APAR @OZ39639 M1235100 * THIS LINE DELETED BY APAR @OZ39639 M1235200 * THIS LINE DELETED BY APAR @OZ39639 M1235300 * THIS LINE DELETED BY APAR @OZ39639 M1235400 * THIS LINE DELETED BY APAR @OZ39639 M1235500 * THIS LINE DELETED BY APAR @OZ39639 M1235600 * THIS LINE DELETED BY APAR @OZ39639 M1235700 * THIS LINE DELETED BY APAR @OZ39639 M1235800 * THIS LINE DELETED BY APAR @OZ39639 M1235900 * THIS LINE DELETED BY APAR @OZ39639 M1236000 * THIS LINE DELETED BY APAR @OZ39639 M1236100 * THIS LINE DELETED BY APAR @OZ39639 M1236200 * THIS LINE DELETED BY APAR @OZ39639 M1236300 * THIS LINE DELETED BY APAR @OZ39639 M1236400 * THIS LINE DELETED BY APAR @OZ39639 M1236500 * THIS LINE DELETED BY APAR @OZ39639 M1236600 * THIS LINE DELETED BY APAR @OZ39639 M1236700 * THIS LINE DELETED BY APAR @OZ39639 M1236800 * THIS LINE DELETED BY APAR @OZ39639 M1236900 * THIS LINE DELETED BY APAR @OZ39639 M1237000 * THIS LINE DELETED BY APAR @OZ39639 M1237100 * THIS LINE DELETED BY APAR @OZ39639 M1237200 * THIS LINE DELETED BY APAR @OZ39639 M1237300 * THIS LINE DELETED BY APAR @OZ39639 M1237400 * THIS LINE DELETED BY APAR @OZ39639 M1237500 * THIS LINE DELETED BY APAR @OZ39639 M1237600 POP PRINT - SECTION DELETED @OZ39639 M1237700 TITLE 'HASP INITIALIZATION -- REMOTE JOB ENTRY LINE PARAMETER CM1237800 PROCESSING ROUTINE' R4 M1237900 NPLLINE NULL PARAMETER LIBRARY LINENN STMNT R4 M1238000 L R0,=A(NPLLINST) GET ADDRESS OF SCAN TABLE R4 M1238100 BAL WE,NPLDSCAN SCAN LINE SUB-PARAMETERS R4 M1238200 L WE,=X'FFFFFFFF' LOAD DUMMY UCB ADDRESS R41 M1238400 C WE,DCTBUFAD TEST FOR DUMMY UCB ADDR R41 M1238500 BE NPLINE1 BR IF ALREADY DUMMY R41 M1238600 NI MDCTTYPE,255-DCTPSNA RESET SNA INDICATOR R41 M1238700 CLC =C'SNA',DCTBUFAD TEST FOR SNA LINE R41 M1238800 BNE NPLINE1 BR IF NO R41 M1238900 ST WE,DCTBUFAD AVOID DEVICE ALLOCATION R4 M1239000 OI MDCTTYPE,DCTPSNA SHOW DCT IS LOGICAL LINE R4 M1239100 SPACE 1 R4 M1239300 NPLINE1 NULL R4 M1239400 B NPLCOMNT PROCESS AS COMMENT CARD R4 M1241500 SPACE 1 R4 M1242000 DROP R1 KILL DCT ADDRESSABILITY R4 M1242500 TITLE 'HASP INITIALIZATION -- LOGONNN PARAMETER PROCESSING ROUCM1243500 TINE' R4 M1244000 SPACE 1 R4 M1244500 NPLOGON NULL PARAMETER LIBRARY LOGONNN STMNT R4 M1245000 L R0,=A(NPLOGNST) GET ADDRESS OF SCAN TABLE R4 M1245500 BAL WE,NPLDSCAN SCAN LOGON SUB-PARAMETERS R4 M1246000 B NPLCOMNT PROCESS AS COMMENT CARD R4 M1246500 SPACE 2 R4 M1247000 SPACE 2 R4 M1312500 TITLE 'HASP INITIALIZATION -- REMOTE TERMINAL PARAMETER PROCESCM1313500 SING ROUTINE' M1314000 NPLRMTNN NULL PARAMETER LIBRARY RMTNNN STATEMENT M1314500 MVC NPLSVAL(8),0(WA) MOVE REMOTE NAME TO WORK AREA M1315000 MVI NPLSVAL+8,C' ' ADD TERMINATING BLANK M1315500 LA R1,NPLSVAL+2 SCAN M1316000 LA R1,1(,R1) FOR M1316500 CLI 0(R1),C' ' TERMINATING M1317000 BNE *-8 BLANK M1317500 MVC 1(4,R1),0(R1) BLANK OUT REST OF NAME M1318000 SPACE 1 R41 M1318500 LA R0,$MAXRJE GET MAX NUMBER OF RAT ENTRIES R4 M1319000 L R1,$RAT POINT TO 1ST RAT ELEMENT R4 M1319500 SPACE 1 R4 M1320000 USING RATDSECT,R1 ESTABLISH RAT ADDRESSABILITY M1320500 SPACE 1 R4 M1321000 NPLRMTN1 CLC RATNAME,NPLSVAL COMPARE REMOTE NAMES M1321500 BE NPLRMTN2 BRANCH IF NAMES MATCH M1322000 LA R1,RATEND GET ADDRESS OF NEXT RAT ELEMENT M1322500 BCT R0,NPLRMTN1 CHECK NEXT RAT ELEMENT M1323000 B NPLDNERR RAT ELEMENT NOT FOUND M1323500 SPACE 1 R41 M1324000 NPLRMTN2 MVC NPLRATTP(1),RATTYPE SAVE TERMINAL TYPE @OZ37429 M1324100 CLI NPLRATTP,0 IS DEFAULT TAKEN @OZ37429 M1324200 BNE NPLRMTN3 NO, SKIP DEFAULT SETTING @OZ37429 M1324300 MVI NPLRATTP,DCTP2770 SET TERMINAL TO DEFAULT @OZ37429 M1324400 NPLRMTN3 MVI RATTYPE,0 SET TERMINAL TYPE TO ZERO @OZ37429 M1324500 L R0,=A(NPLRMTST) GET ADDRESS OF SCAN TABLE @OZ37429 M1324600 BAL WE,NPLSSCAN SCAN REMOTE SUB-PARAMETERS M1325000 CLC RATBUFSZ(2),=H'0' TEST FOR BUFSIZE SPECIFIED @OZ50955 M1325100 BE SKIP185 NO, SKIP VALIDITY CHECK @OZ50955 M1325150 CLC RATBUFSZ(2),=H'128' VALIDITY @OZ50955 M1325200 BL NPLDBUFZ CHECK @OZ50955 M1325250 CLC RATBUFSZ(2),NPLBFSZ BUFSIZE ' @OZ50955 M1325300 BNH SKIP185 SPECIFIED @OZ50955 M1325350 NPLDBUFZ MVC RATBUFSZ,=H'0' SET FOR DEFAULT SIZE @OZ50955 M1325450 SKIP185 CLI RATTYPE,0 TEST FOR DEFAULT SPECIFIED @OZ50955 M1325500 BNE SKIP200 NO, SKIP DEFAULT SETTING R4 M1326000 MVC RATTYPE(1),NPLRATTP SET TO LAST TERMINAL TYPE @OZ37429 M1326500 SKIP200 CLC RATRDCT(2),=H'8160' TEST DISCONNECT INTERVAL R41 M1327000 BH NPLDVERR ILLEGAL IF GREATER THAN 8192 R4 M1327500 CLI RATNUMRD,7 TEST NUMBER OF READERS M1328000 BH NPLDVERR ILLEGAL IF GREATER THAN 7 M1328500 TM RATTYPE,DCTPLU1 IF NOT SNA REMOTE R41 M1328600 BNO NPLATPR GO TEST FOR MAX OF 7 R41 M1328700 TM RATCONF,RATCONFC IF NO CONSOLE R41 M1328800 BNO NPLATPR GO TEST FOR MAX OF 7 R41 M1328900 CLI RATNUMPR,6 IF MORE THAN 6 PRINTERS R41 M1329000 BH NPLDVERR GO ISSUE ERROR MSG R41 M1329100 SPACE 1 R41 M1329200 NPLATPR CLI RATNUMPR,7 TEST NUMBER OF PRINTERS R41 M1329300 BH NPLDVERR ILLEGAL IF GREATER THAN 7 M1329500 CLI RATNUMPU,7 TEST NUMBER OF PUNCHES M1330000 BH NPLDVERR ILLEGAL IF GREATER THAN 7 M1330500 TM RATTYPE,DCTPLU1 IF SNA REMOTE R41 M1330600 BO NPLATLU GO TEST FOR LUNAME R41 M1330700 IC R0,RATNUMPR GET NUMBER OF PRINTERS @OZ27119 M1331000 IC WE,RATNUMPU GET NUMBER OF PUNCHES @OZ27119 M1331500 AR WE,R0 COMPUTE SUM @OZ27119 M1332000 N WE,=A(X'3F') MASK @OZ27119 M1332500 C WE,=F'8' COMPARE @OZ27119 M1333000 BH NPLDVERR ILLEGAL IF SUM IS OVER 8 @OZ27119 M1333500 B NPLCOMNT GO PRINT STATEMEMT R41 M1333600 NPLATLU CLI RATSYMB,C' ' IF LUNAME NOT SPECIFIED R41 M1333700 BE NPLCOMNT GO PRINT STATEMENT R41 M1333800 OI RATFLAGS,RATPILUN IND LUNAME PERMANENTLY INIT R41 M1333900 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1334000 SPACE 1 R4 M1334500 DROP R1 DROP RAT ADDRESSABILITY M1335000 TITLE 'HASP INITIALIZATION -- REMOTE TERMINAL DEVICE PARAMETERCM1335500 PROCESSING ROUTINE' M1336000 NPLRNDVM NULL PARAMETER LIBRARY RNNN.DVM STATEMENT M1336500 BXH WA,R14,NPLSSERR GET NEXT CHARACTER M1337000 CLI 0(WA),X'F0' TEST M1337500 BL NPLSSERR INVALID IF NOT NUMERIC M1338000 BAL WE,NPLDCONV GET REMOTE NUMBER M1338500 B NPLRTERR BR IF ILLEGAL NUMBER +0 R4 M1339000 CLI 0(WA),C'.' TEST TERMINATOR CHARACTER +4 R4 M1339500 BNE NPLSSERR INVALID IF NOT PERIOD M1340000 BCTR R1,0 DECREMENT REMOTE NUMBER M1340500 CL R1,=A($MAXRJE) AND TEST R4 M1341000 BNL NPLDNERR INVALID IF GREATER THAN MAX R4 M1341500 MH R1,=AL2(RWTLEN) COMPUTE RWT ELEMENT DISPLACEMENT M1342000 AL R1,$RWT POINT TO 1ST RWT ELEMENT R4 M1342500 LA R0,21 GET NUMBER OF RWL ELEMENTS M1343000 L WE,=A($RWL) GET ADDRESS OF RWL M1343500 SPACE 2 M1344000 USING RWLDSECT,WE ESTABLISH RWL ADDRESSABILITY M1344500 SPACE 1 R4 M1345000 NPLRND1 CLC RWLNAME,1(WA) COMPARE RWL NAME WITH DEVICE NUMBER M1345500 BE NPLRND2 BRANCH IF RWL ELEMENT FOUND M1346000 LA WE,RWLEND GET ADDRESS OF NEXT RWL ELEMENT M1346500 BCT R0,NPLRND1 NO, TRY AGAIN M1347000 B NPLDNERR INVALID DEVICE NAME M1347500 SPACE 3 R4 M1348000 NPLRTERR L R1,=A(NPLRTERM) POINT TO REMOTE NUMBER ERROR MSG R4 M1348500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1349000 SPACE 3 M1349500 NPLRND2 AH R1,RWLDISP GET ADDRESS OF RWT ENTRY M1350000 CLI 1(WA),C'P' TEST DEVICE TYPE M1350500 BE NPLRNPXM BRANCH IF REMOTE PRINTER OR PUNCH M1351000 SPACE 1 R4 M1351500 DROP WE KILL RWL ADDRESSABILITY R4 M1352000 TITLE 'HASP INITIALIZATION -- REMOTE TERMINAL READER PARAMETERCM1352500 PROCESSING ROUTINE' M1353000 * PARAMETER LIBRARY RNNN.RDM STATEMENT M1353500 * M1354000 L R0,=A(NPLRNRST) GET ADDRESS OF SCAN TABLE R4 M1354500 BAL WE,NPLSSCAN SCAN REMOTE READER SUB-PARAMETERS M1355000 USING RWTDSECT,R1 ESTABLISH RWT ADDRESSABILITY M1355500 SPACE 1 R4 M1362000 NPLRNR2 ICM WE,1,RWTPRINT TEST FOR PRINT ROUTING R4 M1362500 BM NPLRNR3 BR IF INDIRECT ROUTING R4 M1363000 BNZ NPLDVERR ILLEGAL IF GREATER THAN 255 R4 M1363500 B NPLRNR6 BR TO TEST PUNCH ROUTING R4 M1364500 SPACE 1 R4 M1367000 NPLRNR3 NI RWTFLAGS,255-DCTPRLCL RESET SPECIAL LCL ROUTING FLAG R4 M1367500 SPACE 1 R4 M1374500 NPLRNR6 ICM WE,1,RWTPUNCH TEST FOR PUNCH ROUTING R4 M1375000 BM NPLRNR7 BR IF INDIRECT ROUTING R4 M1375500 BNZ NPLDVERR ILLEGAL IF GREATER THAN 255 R4 M1376000 B NPLRNR8 BR TO CONTINUE R4 M1376500 SPACE 1 R4 M1377000 NPLRNR7 NI RWTFLAGS,255-DCTPULCL RESET SPECIAL LCL ROUTING FLAG R4 M1377500 SPACE 1 R4 M1378000 NPLRNR8 CLI RWTPRINC,15 TEST PRIORITY INCREMENT R4 M1378500 BH NPLDVERR ILLEGAL IF GREATER THAN 15 M1379000 CLI RWTPRLIM,15 TEST PRIORITY LIMIT M1379500 BH NPLDVERR ILLEGAL IF GREATER THAN 15 M1380000 CLI RWTJCLAS,C'A' TEST DEFAULT JOB CLASS M1380500 BL NPLDVERR ILLEGAL IF LESS THAN 'A' M1381000 CLI RWTMCLAS,C'A' TEST DEFAULT MESSAGE CLASS M1381500 BL NPLDVERR ILLEGAL IF LESS THAN 'A' M1382000 B NPLCOMNT PROCESS AS COMMENT STATEMENT M1382500 TITLE 'HASP INITIALIZATION -- REMOTE TERMINAL PRINT/PUNCH PARACM1383000 METER PROCESSING ROUTINE' M1383500 NPLRNPXM NULL PARAMETER LIBRARY RNNN.PXN STATEMENT M1384000 L R0,=A(NPLRPRST) GET ADDRESS OF PRINT SCAN TABLE R4 M1384500 CLI 2(WA),C'R' TEST DEVICE TYPE M1385000 BE *+8 BRANCH IF REMOTE PRINTER M1385500 L R0,=A(NPLRPUST) GET ADDRESS OF PUNCH SCAN TABLE R4 M1386000 MVC NPLDEVTP,2(WA) SAVE DEVICE TYPE INDICATOR @OZ40627 M1386025 BAL WE,NPLSSCAN SCAN SUB-PARAMATERS @OZ40627 M1386050 CLC RWTLIMLO,PRPULIM LOWER DEVICE LIMIT VALID @OZ40627 M1386100 BH NPLDVERR BRANCH IF NO @OZ40627 M1386150 CLC RWTLIMHI,=X'FFFFFFFF' UPPER DEVICE LIMIT VALID @OZ40627 M1386200 BE NPLRNVLD BRANCH IF VALID @OZ40627 M1386300 CLC RWTLIMHI,PRPULIM UPPER DEVICE LIMIT VALID @OZ40627 M1386400 BH NPLDVERR BRANCH IF NO @OZ40627 M1386500 NPLRNVLD CLC RWTCKPTP,NPLMAXCP TEST CKPTPGS VALUE @OZ40627 M1386520 BH NPLDVERR ILLEGAL IF GREATER THAN MAX @OZ19494 M1386540 CLC RWTCKPTP,=H'0' TEST CKPTPGS VALUE @OZ19494 M1386550 BE NPLDVERR ILLEGAL IF ZERO @OZ19494 M1386555 CLC RWTCKPTL,NPLMAXCL TEST CKPTLNS VALUE @OZ19494 M1386560 BH NPLDVERR ILLEGAL IF GREATER THAN MAX @OZ19494 M1386580 CLI NPLDEVTP,C'R' TEST DEVICE TYPE @OZ19494 M1386600 BE NPLRNPX0 BRANCH IF PRINTER @OZ19494 M1386620 CLC RWTCKPTL,=H'0' TEST CKPTLNS FOR PUNCH @OZ19494 M1386640 BE NPLDVERR ILLEGAL IF 0 @OZ19494 M1386660 NPLRNPX0 CLI RWTDCPTN,99 TEST COMPACTION TABLE NO. @OZ19494 M1386680 BH NPLDVERR ILLEGAL IF GREATER THAN 99 R41 M1386700 CLI RWTLRECL,0 TEST FOR VALID LRECL @OZ29180 M1386800 BNH NPLDVERR ILLEGAL IF LESS THAN 1 @OZ29180 M1386900 TM RWTSFEAT,DCTPNDST TEST FOR BASIC EXCHANGE @OZ29180 M1387000 BO NPLRNPX1 BRANCH IF NOT @OZ29180 M1387100 CLI RWTLRECL,FMHBXMRL TEST VALID LRECL @OZ29180 M1387200 BH NPLDVERR ILLEGAL IF GREATER THAN MAX @OZ29180 M1387300 NPLRNPX1 ICM WE,1,RWTROUTE TEST ROUTE CODE @OZ29180 M1387400 BM NPLCOMNT BR IF INDIRECT ROUTING R4 M1387500 BNZ NPLDVERR ILLEGAL IF GREATER THAN 255 R4 M1388000 B NPLCOMNT PROCESS AS COMMENT STATEMENT@OZ40627 M1388100 DROP R1 DROP RWT ADDRESSABILITY @OZ40627 M1388200 EJECT @OZ40627 M1388300 *********************************************************************** M1388305 * * M1388310 * NPLLIMIT - CONVERT LIMITS TO BINARY * M1388315 * CALLED BY NPLSSCAN. * M1388320 * REGISTERS UPON ENTRY - * M1388325 * R2 - ADDRESS OF CURRENT CHARACTER * M1388330 * R3 - ADDRESS OF SCAN TABLE * M1388335 * R4 - ADDRESS OF OUTPUT TABLE * M1388340 * R7 - RETURN ADDRESS IN NPLSSCAN * M1388345 * * M1388355 *********************************************************************** M1388360 USING NSCANTBL,R3 PROVIDE SCAN TABLE ADDRESSAB@OZ40627 M1388365 NPLLIMIT CLI 0(R2),C'=' TEST CURRENT CHARACTER @OZ40627 M1388370 BNE NPLSVERR ILLEGAL IF NOT EQUAL SIGN @OZ40627 M1388375 BXH R2,R14,NPLSVERR POINT TO FIRST DIGIT @OZ40627 M1388377 BAL R5,NPLLIMNO SCAN LOWER LIMIT @OZ40627 M1388380 LR R1,R0 SAVE LOWER LIMIT @OZ40627 M1388385 LA R0,1 SET DEFAULT @OZ40627 M1388390 LNR R0,R0 UPPER LIMIT @OZ40627 M1388395 CLI 0(R2),C'-' UPPER LIMIT SPECIFIED ... @OZ40627 M1388400 BNE NPLLIMTS BRANCH IF NO @OZ40627 M1388405 BXH R2,R14,NPLSVERR POINT TO NEXT CHARACTER @OZ40627 M1388407 CLI 0(R2),C'*' DEFAULT UPPER LIM SPECIFIED @OZ40627 M1388410 BE NPLLDFLT BRANCH IF YES @OZ40627 M1388415 BAL R5,NPLLIMNO SCAN UPPER LIMIT @OZ40627 M1388420 B NPLLIMTS BR TO CHECK FOR VALID DELIM @OZ40627 M1388425 SPACE 1 @OZ40627 M1388430 NPLLDFLT BXH R2,R14,NPLSVERR POINT PAST '*' @OZ40627 M1388435 NPLLIMTS CLI 0(R2),C',' VALID DELIMITER ... @OZ40627 M1388440 BE NPLLIMVA BRANCH IF YES @OZ40627 M1388445 CLI 0(R2),C' ' VALID DELIMITER ... @OZ40627 M1388450 BNE NPLSVERR BRANCH IF NO @OZ40627 M1388455 NPLLIMVA CLR R1,R0 VALID LIMITS ... @OZ40627 M1388460 BNL NPLSVERR BRANCH IF NO @OZ40627 M1388465 LH R5,NSCANDSP GET LOWER LIMIT DISP.IN TABL@OZ40627 M1388470 ST R1,0(R5,R4) STORE LOWER LIMIT @OZ40627 M1388475 LH R5,NSCANDS2 GET UPPER LIMIT DISP.IN TABL@OZ40627 M1388480 ST R0,0(R5,R4) STORE UPPER LIMIT @OZ40627 M1388485 BCTR R2,0 RESET SCAN POINTER @OZ51987 M1388487 BR R7 RETURN @OZ40627 M1388490 SPACE 2 @OZ40627 M1388500 NPLLIMNO SLR R0,R0 ZERO OUT WORK REG @OZ40627 M1388505 ST R0,$DOUBLE ZERO OUT WORK AREA @OZ40627 M1388510 CLI 0(R2),C'0' FIRST DIGIT NUMERIC (F0-FF) @OZ40627 M1388520 BL NPLSVERR ERROR IF NO @OZ40627 M1388525 CLI 0(R2),C'9' NUMERIC VALUE (F0-FF) ... @OZ40627 M1388530 BH NPLSVERR ERROR IF NO @OZ40627 M1388532 NPLLIMLP CL R0,=F'214748365' GREATER THAN FULL WORD ... @OZ40627 M1388534 BH NPLSVERR BRANCH IF YES - ERROR @OZ40627 M1388536 MVN $DOUBLE+1(1),0(R2) GET A DIGIT @OZ40627 M1388538 MH R0,=H'10' SHIFT TOTAL @OZ40627 M1388540 AH R0,$DOUBLE ADD DIGIT TO TOTAL @OZ40627 M1388542 LTR R0,R0 GREATER THAN FULL WORD ... @OZ40627 M1388544 BM NPLSVERR BRANCH IF YES - ERROR @OZ40627 M1388545 BXH R2,R14,NPLSVERR POINT TO NEXT DIGIT @OZ40627 M1388546 CLI 0(R2),C'0' NUMERIC VALUE (F0-FF) ... @OZ40627 M1388548 BLR R5 RETURN IF NO @OZ40627 M1388550 CLI 0(R2),C'9' NUMERIC VALUE (F0-FF) ... @OZ40627 M1388552 BHR R5 RETURN IF NO @OZ40627 M1388554 B NPLLIMLP LOOP @OZ40627 M1388556 DROP R3 KILL SCAN TABLE ADDRESSABIL @OZ40627 M1388558 TITLE 'HASP INITIALIZATION -- SELECT SUBPARAMETER PROCESSING RCM1388560 OUITNE' @OZ29180 M1388570 ***************************************************************@OZ29180 M1388580 * @OZ29180 M1388590 * NPLSELCT - SCAN THE SELECT SUBPARAMETER OF THE REMOTE @OZ29180 M1388600 * PRINTER AND PUNCH INITIALIZATION STATEMENTS. @OZ29180 M1388610 * @OZ29180 M1388620 * CALLED BY NPLSSCAN @OZ29180 M1388630 * @OZ29180 M1388640 * REGISTERS UPON ENTRY: @OZ29180 M1388650 * @OZ29180 M1388660 * WC = R4 = ADDRESS OF RWT @OZ29180 M1388670 * WB = R3 = ADDRESS OF SCAN TABLE @OZ29180 M1388680 * WA = R2 = ADDRESS OF CURRENT CHARACTER @OZ29180 M1388690 * WE = R6 = RETURN ADDRESS FOR THE NPLSCAN ROUTINE @OZ29180 M1388700 * WF = R7 = RETURN ADDRESS IN NPLSSCAN @OZ29180 M1388710 * @OZ29180 M1388720 ***************************************************************@OZ29180 M1388730 SPACE 2 @OZ29180 M1388740 USING RWTDSECT,WC SHOW RWT ADDRESSABILITY @OZ29180 M1388750 SPACE 1 @OZ29180 M1388760 NPLSELCT CLI 0(WA),C'=' TEST CURRENT CHARACTER @OZ29180 M1388800 BNE NPLSVERR ILLEGAL IF NOT EQUAL SIGN @OZ29180 M1388850 BXH WA,R14,NPLSSERR SCAN TO NEXT CHARACTER @OZ29180 M1388900 CLC 0(2,WA),=C'X''' TEST NEXT 2 CHARACTERS @OZ29180 M1388950 BNE NPLSEL10 BRANCH IF NOT HEX @OZ29180 M1389000 BXH WA,R14,NPLSSERR SCAN PAST @OZ29180 M1389050 BXH WA,R14,NPLSSERR NEXT TWO CHARACTERS @OZ29180 M1389100 BAL WD,NPLHEXTR CONVERT TO HEX @OZ29180 M1389150 CLR WA,R15 TEST FOR END OF CARD @OZ29180 M1389200 BH NPLSSERR BRANCH IF PAST END @OZ29180 M1389250 CLI 0(WA),C'''' TEST FOR ENDING QUOTE @OZ29180 M1389300 BNE NPLSVERR ILLEGAL IF MISSING @OZ29180 M1389350 C R0,=F'255' INSURE ONLY 1 BYTE WORTH @OZ29180 M1389400 BH NPLSVERR ILLEGAL IF NOT @OZ29180 M1389450 STC R0,RWTSEL PUT MEDIA/SUBADDRESS IN RWT @OZ29180 M1389500 OI RWTSEL,DCTPOUTB MARK AS OUTBOUND DEVICE @OZ29180 M1389550 BR WF RETURN TO MAIN SCAN ROUTINE @OZ29180 M1389600 SPACE 2 @OZ29180 M1389650 USING NPLSLTAB,R1 SELECT TABLE ADDRESSABLITY @OZ29180 M1389700 SPACE 1 @OZ29180 M1389750 NPLSELEX CLC 0(*-*,WA),NPLSLMN **** EXECUTED **** @OZ29180 M1389800 SPACE 1 @OZ29180 M1389850 NPLSEL10 SLR WD,WD ZERO WORK REGISTER @OZ29180 M1389900 LA R1,NPLSELMT-NPLSLTLN-1 R1 TO INDEX TABLE @OZ29180 M1389950 NPLSEL20 LA R1,NPLSLTLN+1(R1,WD) POINT TO NEXT ENTRY @OZ29180 M1390000 CLI 0(R1),X'FF' TEST FOR END OF TABLE @OZ29180 M1390050 BE NPLSVERR ERROR IF NAME NOT IN TABLE @OZ29180 M1390100 IC WD,NPLSLLEN GET NAME LENGTH FOR COMPARE @OZ29180 M1390150 EX WD,NPLSELEX COMPARE FOR DEVICE NAME @OZ29180 M1390200 BNE NPLSEL20 CONTINUE IF NOT END @OZ29180 M1390250 EJECT @OZ29180 M1390300 NPLSEL30 LA WA,0(WD,WA) POINT TO LAST CHAR IN NAME @OZ29180 M1390350 CLR WA,R15 CHECK FOR END OF CARD @OZ29180 M1390400 BH NPLSSERR ERROR IF TOO FAR @OZ29180 M1390450 MVC RWTSEL,NPLSLMV MOVE MEDIA VALUE TO RWT @OZ29180 M1390500 OI RWTSFEAT,DCTPNDST ASSUME NOT BASIC/EXCHANGE @OZ29180 M1390550 TM NPLSLFLG,NPLSLBXC TEST FOR BASIC/EXCHANGE @OZ29180 M1390600 BZ NPLSEL33 BRANCH NOT BASIC/EXCHANGE @OZ29180 M1390650 NI RWTSFEAT,255-DCTPNDST INDICATE BASIC/EXCHANGE @OZ29180 M1390700 DROP R1 KILL MEDIA TABLE BASE @OZ29180 M1390750 SPACE 1 @OZ29180 M1390800 NPLSEL33 CLI 1(WA),C',' TEST NEXT CHARACTER @OZ29180 M1390850 BE NPLSEL35 BRANCH IF COMMA @OZ29180 M1390900 CLI 1(WA),C' ' TEST NEXT CHARACTER @OZ29180 M1390950 BNE NPLSEL40 BRANCH IF NOT BLANK @OZ29180 M1391000 NPLSEL35 OI RWTSEL,FMHLDANY SET SUBADDRESS TO ANY @OZ29180 M1391050 BR WF RETURN TO MAIN SCAN ROUTINE @OZ29180 M1391100 SPACE 1 @OZ29180 M1391150 NPLSEL40 BXH WA,R14,NPLSSERR SCAN TO NEXT CHARACTER @OZ29180 M1391200 LR WD,WE SAVE 1ST LEVEL RETURN ADDR @OZ29180 M1391250 BAL WE,NPLDCONV CONVERT DEV NO. TO BINARY @OZ29180 M1391300 B NPLSVERR +0 ILLEGAL VALUE @OZ29180 M1391350 LR WE,WD +4 RESTORE 1ST LEVEL RETURN @OZ29180 M1391400 LTR R1,R1 TEST DEVICE NUMBER @OZ29180 M1391450 BZ NPLSVERR ILLEGAL IF 0 @OZ29180 M1391500 CH R1,=H'15' TEST FOR MAX DEVICE NUMBER @OZ29180 M1391550 BH NPLSVERR ILLEGAL IF NOT LESS THAN 16 @OZ29180 M1391600 NPLSEL45 BCTR R1,0 GET SUBADDRESS @OZ29180 M1391650 IC R0,RWTSEL GET MEDIA VALUE @OZ29180 M1391700 OR R1,R0 INCLUDE SUBADDRESS @OZ29180 M1391750 STC R1,RWTSEL PUT MEDIA/SUBADDRESS IN RWT @OZ29180 M1391800 BCTR WA,0 BACK UP ONE CHARACTER @OZ29180 M1391850 BR WF RETURN TO MAIN SCAN ROUTINE @OZ29180 M1391900 SPACE 1 @OZ29180 M1392000 DROP WC DROP RWT ADDRESSIBILITY @OZ29180 M1392050 EJECT @OZ29180 M1392100 NPLSELMT DS 0F MEDIA SELECT TABLE @OZ29180 M1392150 DC AL1(4),AL1(DCTPOUTB+FMHPRINT),AL1(0),C'PRINT' @OZ29180 M1392200 DC AL1(4),AL1(DCTPOUTB+FMHCARD),AL1(0),C'PUNCH' @OZ29180 M1392250 DC AL1(3),AL1(DCTPOUTB+FMHEXCH),AL1(0),C'EXCH' @OZ29180 M1392300 DC AL1(4),AL1(DCTPOUTB+FMHEXCH),AL1(NPLSLBXC) @OZ29180 M1392350 DC C'BASIC' @OZ29180 M1392400 DC X'FF' END-OF-TABLE @OZ29180 M1392450 SPACE 5 @OZ29180 M1392500 NPLSLTAB DSECT MEDIA SELECT TABLE DSECT @OZ29180 M1392550 NPLSLLEN DS AL1 DEVICE NAME LENGTH-1 @OZ29180 M1392600 NPLSLMV DS AL1 MEDIA VALUE @OZ29180 M1392650 NPLSLFLG DS AL1 FLAG BYTE @OZ29180 M1392700 NPLSLTLN EQU *-NPLSLTAB LENGTH OF FIXED SECTION @OZ29180 M1392750 NPLSLMN EQU * MEDIA NAME VARIABLE LENGTH @OZ29180 M1392800 SPACE 1 @OZ29180 M1392850 * NPLSLFLG @OZ29180 M1392900 SPACE 1 @OZ29180 M1392950 NPLSLBXC EQU B'10000000' BASIC EXCHANGE MEDIA @OZ29180 M1393000 SPACE 1 @OZ29180 M1393050 HASPINIT CSECT @OZ29180 M1393100 TITLE 'HASP INITIALIZATION -- REMOTE DESTINATION PARAMETER PROCM1393150 CESSING ROUTINE' @OZ29180 M1393200 NPLDEST NULL PARAMETER LIBRARY DESTID @OZ29180 M1393250 LA WA,6(,WA) PT TO BLANK AFTER 'DESTID' @OZ29180 M1393300 BXH WA,R14,NPLSSERR POINT TO NEXT CHARACTER @OZ29180 M1393350 LA R1,NPLDSAVE USE SAVE AREA AS NDQ @OZ29180 M1393400 SPACE 1 @OZ29180 M1393450 USING NDQDSECT,R1 PROVIDE NDQ ADDRESSABILITY @OZ29180 M1393500 SPACE 1 @OZ29180 M1393550 XC NDQ,NDQ CLEAR NDQ AREA R4 M1394000 L R0,=A(NPLDESST) GET ADDRESS OF SCAN TABLE R4 M1394500 BAL WE,NPLSSCAN SCAN SUBPARAMETERS R4 M1395000 OC NDQNAME,NDQNAME TEST FOR NAME R4 M1395500 BZ NPLSSERR ILLEGAL IF NOT PROVIDED R4 M1396000 CLI NDQNAME,C'0' RETEST NAME R4 M1396500 BNL NPLDVERR ILLEGAL IF 1ST CHARACTER NUMERIC R4 M1397000 CLC NDQDEST,=CL8'LOCAL' TEST DESTINATION R4 M1397500 BE NPLDESS BR IF 'LOCAL' R4 M1398000 CLI NDQDEST,C'U' TEST FOR UNIT SPECIFICATION R4 M1398500 BE NPLDESD BR IF YES R4 M1399000 CLI NDQDEST,C'R' TEST FOR REMOTE SPECIFICATION R4 M1399500 BNE NPLDVERR BR IF ILLEGAL DEST R4 M1402000 SPACE 1 R4 M1402500 NPLDESD CLI NDQDEST+1,C'0' TEST 2ND CHARACTER R4 M1403500 BNH NPLDVERR ILLEGAL IF ALPHA OR LEADING ZERO R4 M1404000 MVC NPLLWORK,NDQDEST+2 MOVE REMAINING DEST TO WORK AREA R4 M1404500 LA R0,3 MAX REMAINING DIGITS @OZ18420 M1405000 SPACE 1 R4 M1405500 NPLDESN CLI NPLLWORK,C' ' TEST FOR END OF DEST R4 M1406000 BE NPLDESS BR IF YES R4 M1406500 CLI NPLLWORK,C'0' TEST FOR NUMERIC R4 M1407000 BL NPLDVERR ILLEGAL IF NO R4 M1407500 MVC NPLLWORK,NPLLWORK+1 SHIFT LEFT 1 CHARACTER R4 M1408000 BCT R0,NPLDESN BR TO TEST NEXT CHARACTER R4 M1408500 SPACE 1 R4 M1409000 B NPLDVERR ILLEGAL IF MORE THAN 3 DIGITS R4 M1409500 SPACE 1 R4 M1422000 DROP R1 KILL NDQ ADDRESSABILITY R4 M1422500 EJECT R4 M1423000 NPLDESS LA WB,$NDQ-(NDQNDQ-NDQ) PREPARE TO SCAN DEST'N ELEMENTS R4 M1423500 L WC,$NDQ POINT TO FIRST ELEMENT R4 M1424000 SPACE 1 R4 M1424500 USING NDQDSECT,WC PROVIDE NDQ ADDRESSABILITY R4 M1425000 SPACE 1 R4 M1425500 NPLDESC CLC NDQNAME,NDQNAME-NDQ+NPLDSAVE COMPARE NAMES R4 M1426000 BE NPLDESR BR IF EQUAL R4 M1426500 BH NPLDESI INSERT IF OLD IS HIGH R4 M1427000 LR WB,WC PULL HEADER UP ONE R4 M1427500 ICM WC,15,NDQNDQ POINT TO NEXT NDQ R4 M1428000 BNZ NPLDESC LOOP IF VALID ADDRESS R4 M1428500 SPACE 1 R4 M1429000 NPLDESI LA R0,NDQSIZ GET STORAGE R4 M1429500 ICM R0,8,=AL1(229) FOR DESTINATION R4 M1430000 GETMAIN R,LV=(0) QUEUE ELEMENT R4 M1430500 ST WC,NDQNDQ-NDQ(,R1) SET POINTER TO NEXT R4 M1431000 LR WC,R1 COPY ADDRESS R4 M1431500 SPACE 1 R4 M1432000 NPLDESR MVC NDQDATA,NDQDATA-NDQ+NPLDSAVE INSERT NEW DATA R4 M1432500 ST WC,NDQNDQ-NDQ(,WB) PLACE ON QUEUE R4 M1433000 B NPLCOMNT PROCESS PARM CARD AS COMMENT R4 M1433500 SPACE 1 R4 M1434000 DROP WC KILL NDQ ADDRESSABILITY R4 M1434500 SPACE 3 R4 M1435000 NDQDSECT DSECT DESTINATION QUEUE ELEMENT DSECT R4 M1435500 NDQNDQ DS A CHAIN FIELD R4 M1436000 NDQDATA DS 0CL16 DATA PORTION OF DESTINATION R4 M1436500 NDQNAME DS CL8 DESTINATION NAME R4 M1437000 NDQDEST DS CL8 NATIVE SPECIFICATION R4 M1437500 DS 0D ENSURE MULTIPLE OF 8 BYTES R4 M1438000 NDQSIZ EQU *-NDQDSECT LENGTH OF QUEUE ELEMENT R4 M1438500 NDQ EQU NDQDSECT,NDQSIZ ALTERNATE QUEUE ELEMENT NAME R4 M1439000 SPACE 1 R4 M1439500 HASPINIT CSECT END OF NDQ DSECT R4 M1440000 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT DEVICE LOOKUCM1523000 P SUBROUTINE' R41 M1523500 NPLDSCAN NULL DEVICE LOOKUP SUBROUTINE M1524000 MVC NPLSVAL(8),0(WA) MOVE DEVICE NAME TO WORK AREA M1524500 CLI NPLSVAL+5,C' ' TEST SIXTH CHARACTER M1525000 BNE *+8 BRANCH IF NOT BLANK M1525500 MVI NPLSVAL+6,C' ' YES, BLANK OUT SEVENTH CHARACTER M1526000 CLI NPLSVAL+6,C' ' TEST SEVENTH CHARACTER M1526500 BNE *+8 BRANCH IF NOT BLANK M1527000 MVI NPLSVAL+7,C' ' YES, BLANK OUT EIGHTH CHARACTER M1527500 CLI NPLSVAL+7,C' ' TEST EIGHTH CHARACTER M1528000 BE *+12 BRANCH IF BLANK M1528500 CLI 8(WA),C' ' TEST NEXT CHARACTER M1529000 BNE NPLDNERR INVALID IF NOT BLANK M1529500 SPACE 1 M1530000 LA R1,$DCTPOOL-(DCTCHAIN-DCTDSECT) FAKE FIRST DCT M1530500 SPACE 1 R4 M1531000 USING DCTDSECT,R1 ESTABLISH DCT ADDRESSABILITY M1531500 SPACE 1 R4 M1532000 NPLDSCN1 ICM R1,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT M1532500 BZ NPLDNERR ERROR IF DEVICE NOT FOUND M1533000 CLC DCTDEVN,NPLSVAL COMPARE DEVICE NAMES M1533500 BNE NPLDSCN1 BRANCH IF NAMES DO NOT MATCH M1534000 SPACE 1 M1534500 B NPLSSCAN SCAN DEVICE SUB-PARAMETERS M1535000 SPACE 1 R4 M1535500 DROP R1 DROP DCT ADDRESSABILITY M1536000 SPACE 5 M1536500 NPLDNERR NULL INVALID DEVICE NAME M1537000 L R1,=A(NPLDNERM) POINT TO INVALID DEV NAME MSG R4 M1537500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1538000 SPACE 5 M1538500 NPLDVERR NULL HASPPARM DEVICE VALUE ERROR M1539000 MVC 0(L'NPLDSAVE,R1),NPLDSAVE RESTORE CONTROL BLOCK M1539500 L R1,=A(NPLDVERM) POINT TO INVALID DEV VALUE MSG R4 M1540000 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC R4 M1540500 TITLE 'HASP INITIALIZATION -- MISCELLANEOUS INITIALIZATION PARCM1541000 AMETER PROCESSING ROUTINES' M1541500 NPLSTCMC NULL PARAMETER LIBRARY STCMCLAS STATEMENT M1542000 L R1,=A(NSTCMCLS) GET ADDRESS OF STC MSGCLASS M1542500 B NPLTSUM1 UTILIZE COMMON CODE M1543000 SPACE 3 R4 M1543500 NPLTSUMC NULL PARAMETER LIBRARY TSUMCLAS STATEMENT M1544000 L R1,=A(NTSUMCLS) GET ADDRESS OF TSU MSGCLASS M1544500 SPACE 2 M1545000 NPLTSUM1 CLI 9(WA),C'A' TEST MSGCLASS M1545500 BL NPLCHERR INVALID IF LESS THAN 'A' M1546000 BAL WE,NPLCCOM1 EXTRACT CHARACTER R41 M1546500 B NPLCOMNT THEN PROCESS AS COMMENT STATEMENT R4 M1547000 SPACE 2 R4 M1547500 NPLCCOM1 LA WA,8(,WA) STEP OVER NAME FIELD M1548000 CLI 0(WA),C'=' TEST NEXT CHARACTER M1548500 BNE NPLSSERR INVALID IF NOT EQUAL SIGN M1549000 BXH WA,R14,NPLSSERR ADVANCE TO NEXT CHARACTER M1549500 CLI 0(WA),C' ' TEST DATA CHARACTER M1550000 BE NPLCHERR INVALID IF BLANK M1550500 CLI 1(WA),C' ' TEST TERMINATOR CHARACTER R4 M1551000 BNE NPLCHERR ILLEGAL IF NOT BLANK R4 M1551500 MVC 0(1,R1),0(WA) SET PARAMETER CHARACTER M1552000 BR WE THEN RETURN R41 M1552500 EJECT R4 M1553000 NPLHSSSM NULL PARAMETER LIBRARY HASPSSSM STMNT R4 M1553500 MVI C'.'(WC),1 DISALLOW PERIOD AS LEGAL CHAR R41 M1554000 BAL WC,NPLID EXTRACT PROGRAM NAME R41 M1554500 CLI NPLWORK,C'0' TEST 1ST CHARACTER R41 M1555000 BNL NPLCHERR BR IF NUMBER TO ISSUE DIAGNOSTIC R41 M1555500 LOAD EPLOC=NPLWORK,ERRET=NPLHSERR LOCATE HASPSSSM R41 M1556000 MVC NPLSSSM,NPLWORK SAVE PROGRAM NAME R41 M1556500 L R1,$HASPMAP POINT TO HASP MODULE MAP R4 M1557000 L R3,CVTPTR GET CVT ADDRESS @OZ55871 M1557500 USING CVTDSECT,R3 @OZ55871 M1557550 CLM R0,7,CVTSHRVM+1 IS SSSM IN COMMON @OZ55871 M1557600 BH NPLSSMOK YES, MAP @OZ55871 M1557650 CLM R0,7,CVTNUCB+1 IS SSSM IN COMMON @OZ55871 M1557700 BL NPLSSMOK YES, MAP @OZ55871 M1557750 DROP R3 @OZ55871 M1557800 MVI MAPSSSM-MAPDSECT+7(R1),C'$' STOP REPS TO SSSM @OZ55871 M1557850 B NPLHSDEL GO TO DELETE MODULE @OZ55871 M1557900 SPACE 1 @OZ55871 M1557950 NPLSSMOK ST R0,MAPSSSMA-MAPDSECT(,R1) SET ADDRESS FOR REP @OZ55871 M1558000 MVI MAPSSSM-MAPDSECT+7(R1),C'M' ALLOW REPS TO SSSM @OZ55871 M1558100 SPACE 1 @OZ55871 M1558200 NPLHSDEL DELETE EPLOC=NPLSSSM DELETE HASPSSSM @OZ55871 M1558300 B NPLCOMNT PROCESS PARM CARD AS COMMENT R4 M1558500 SPACE 1 R41 M1558600 NPLHSERR L R1,=A(NPLHSERM) POINT TO DIAGNOSTIC R41 M1558700 MVC NPLHSNAM-NPLHSERM(,R1),NPLWORK SET PGM NAME R41 M1558800 B NPLERMSG BR TO ISSUE DIAGNOSTIC R41 M1558900 SPACE 1 R41 M1559000 NPLSSSM DC CL8'HASPSSSM' HASPSSSM PROGRAM NAME R41 M1559100 EJECT R41 M1559200 NPLCON NULL PARAMETER LIBRARY CONSOLE STATEMENT M1559300 OI NPLFLAGS,NPLCONSL INDICATE CONSOLE MODE R41 M1559400 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M1559500 SPACE 3 R41 M1559600 NPLLISTC NULL PARAMETER LIBRARY LIST STMNT R4 M1559700 NI NPLFLAGS,255-NPLNOLST RESET 'NOLIST' SPECIFICATION R4 M1560000 B NPLCOMNT PROCESS PARM CARD AS COMMENT R4 M1560500 SPACE 3 R4 M1561000 NPLNLIST NULL PARAMETER LIBRARY NOLIST STMNT R4 M1561500 OI NPLFLAGS,NPLNOLST SET 'NOLIST' SPECIFICATION R4 M1562000 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M1562100 SPACE 3 R41 M1562200 NPLLOGC NULL PARAMETER LIBRARY LOG STATEMENT M1562300 NI NPLFLAGS,255-NPLNOLOG RESET 'NOLOG' SPECIFICATION R41 M1562400 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M1562500 SPACE 3 R41 M1562600 NPLNLOG NULL PARAMETER LIBRARY NOLOG STATEMENT M1562700 OI NPLFLAGS,NPLNOLOG SET 'NOLOG' SPECIFICATION R41 M1562800 B NPLCOMNT BR TO LIST/LOG STATEMENT R41 M1562900 SPACE 5 R4 M1563000 NPLSSERR NULL PARAMETER LIBRARY SYNTAX ERROR R4 M1563500 L R1,=A(NPLSSERM) POINT TO INVALID STATEMENT MSG R4 M1564000 SPACE 1 R4 M1564500 NPLERMSG MVC NDIAG,0(R1) MOVE DIAGNOSTIC TO PARM CARD R41 M1565000 MVC NCARD,NERRCARD MOVE MAJOR PARM FOR MSG. @OZ44388 M1565050 TM NPLFLAGS,NPLCONSL ARE WE IN CONSOLE MODE... R41 M1565100 BO NPLCOMNT BR IF YES R41 M1565200 OI NPLFLAGS,NPLERROR INDICATE HASPPARM ERROR R41 M1565500 SPACE 1 R4 M1566000 NPLCOMNT BAL LINK,NPLLIST LIST CONTROL STATEMENT R4 M1566500 B NPLNEXT GET NEXT PARAMETER LIBRARY STMNT R4 M1567000 EJECT @OZ39639 M1568000 USING PTEDSECT,WB PROVIDE PTE ADDRESSABILITY @OZ39639 M1569000 SPACE 1 @OZ39639 M1570000 NPLIGNOR NULL , PARAMETER NOT SUPPORTED @OZ39639 M1571000 TM NPLFLAGS,NPLCONSL CONSOLE MODE... @OZ39639 M1572000 BO NPLIGMSG ALWAYS ISSUE MSG IF YES @OZ39639 M1573000 TM PTEFLG1,PTE1IMSG MESSAGE ALREADY ISSUED... @OZ39639 M1574000 BO NPLIGLST BR IF YES @OZ39639 M1575000 SPACE 1 @OZ39639 M1576000 NPLIGMSG L R1,=A(NOSUPMSG) POINT TO WARNING MESSAGE @OZ39639 M1577000 MVC NOSUPARM(,R1),PTEKEY INSERT PARAMETER NAME @OZ39639 M1578000 $$WTO (R1) WARN OPERATOR @OZ39639 M1579000 OI PTEFLG1,PTE1IMSG SHOW MESSAGE ISSUED ONCE @OZ39639 M1580000 SPACE 1 @OZ39639 M1581000 NPLIGLST L R1,=A(NPLNOSUP) ADD DIAGNOSTIC TO PARAMETER @OZ39639 M1582000 MVC NDIAG,0(R1) IMAGE (1ST COL. IS BLANK) @OZ39639 M1583000 SPACE 1 @OZ39639 M1584000 NPLIGLOO CLI NCARD+71,C' ' CONTINUATION EXPECTED... @OZ39639 M1585000 BE NPLCOMNT BR IF NO (TREAT AS COMMENT) @OZ39639 M1586000 BAL LINK,NPLLIST TREAT THIS CARD AS COMMENT @OZ39639 M1587000 BAL LINK,NPLGET GET CONTINUATION @OZ39639 M1588000 B NPLEND EOF, IGNORE ILLEGAL CONTIN. @OZ39639 M1589000 B NPLIGLOO ELSE LOOP TILL NOT CONTIN. @OZ39639 M1590000 SPACE 1 @OZ39639 M1591000 DROP WB KILL PTE ADDRESSABILITY @OZ39639 M1592000 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT DECIMAL CONVCM1660000 ERSION SUBROUTINE' R41 M1660500 *********************************************************************** M1661000 * * M1661500 * NPLDCONV -- EXTRACT NUMBER OF 8 DIGITS OR LESS * M1662000 * * M1662500 *********************************************************************** M1663000 SPACE 1 R4 M1663500 NPLDCNVT CLI 8(WA),C'=' TEST NEXT CHARACTER R4 M1666000 BNE NPLSSERR INVALID IF NOT EQUAL SIGN R4 M1666500 LA WA,9(,WA) STEP OVER KEYWORD R4 M1667000 SPACE 1 R4 M1667500 NPLDCONV CLR WA,R15 TEST CURRENT COLUMN R4 M1668000 BH NPLSSERR ILLEGAL IF MORE THAN COLUMN 71 M1668500 CLI 0(WA),X'F0' TEST FIRST CHARACTER M1669000 BL NPLDCERR ILLEGAL IF LESS THAN X'F0' M1669500 SR R0,R0 INITIALIZE M1670000 LR R1,R0 REGISTERS M1670500 SPACE 1 R4 M1671000 NPLDCON1 CLI 0(WA),X'F9' TEST NEXT CHARACTER M1671500 BH NPLDCERR ILLEGAL IF GREATER THAN X'F9' M1672000 LTR R0,R0 TEST NUMBER SO FAR R4 M1672500 BMR WE RETURN IF ALREADY 8 DIGITS TO +0 R4 M1673000 SLDL R0,8 SHIFT AND M1673500 IC R1,0(,WA) ADD CURRENT CHARACTER M1674000 BXH WA,R14,NPLDCON2 GET NEXT CHARACTER M1674500 CLI 0(WA),X'F0' TEST M1675000 BNL NPLDCON1 BRANCH IF NUMERIC M1675500 SPACE 1 R4 M1676000 NPLDCON2 STM R0,R1,NPLLWORK CONVERT M1676500 PACK NPLLWORK,NPLLWORK EBCDIC TO M1677000 CVB R1,NPLLWORK BINARY M1677500 B 4(,WE) AND RETURN TO +4 R4 M1678000 SPACE 2 R4 M1678500 NPLDCERR NULL ILLEGAL DECIMAL VALUE M1679000 L R1,=A(NPLDCERM) POINT TO ILLEGAL DEC VALUE MSG R4 M1679500 B NPLERMSG AND BR TO ISSUE DIAGNOSTIC @OZ29180 M1679550 TITLE 'HASP INITAILIZATION -- PARAMETER STATEMENT HEXIDECIMAL CM1679610 CONVERSION ROUTINE' @OZ29180 M1679620 ***************************************************************@OZ29180 M1679630 * @OZ29180 M1679640 * NPLHEXTR - EXTRACT HEX DIGITS (8 OR LESS) @OZ29180 M1679650 * @OZ29180 M1679660 * INPUT - WA = ADDRESS OF 1ST HEX DIGIT @OZ29180 M1679670 * @OZ29180 M1679690 * OUTPUT - R0 = HEXIDECIMAL NUMBER @OZ29180 M1679700 * @OZ29180 M1679720 ***************************************************************@OZ29180 M1679730 SPACE 2 @OZ29180 M1679740 NPLHEXTR CLR WA,R15 TEST FOR END OF CARD @OZ29180 M1679750 BH NPLSSERR BRANCH IF PAST END @OZ29180 M1679760 ST WD,NPLHEXSV SAVE RETURN REGISTER @OZ29180 M1679770 SLR R0,R0 R0 TO ACCUMULATE HEX DIGITS @OZ29180 M1679780 SLR R1,R1 CLEAR WORK REGISTER @OZ29180 M1679790 LA WD,8 TRANSLATE UPTO 8 HEX DIGITS @OZ29180 M1679800 SPACE 1 @OZ29180 M1679810 NPLHEX05 CLI 0(WA),C'A' TEST FOR VALID HEX @OZ29180 M1679820 BL NPLHEX10 BRANCH IF INVALID @OZ29180 M1679830 MVC NPLHEXCH,0(WA) MOVE CHAR TO WORK AREA @OZ29180 M1679840 TR NPLHEXCH,NREPTTAB TRANSLATE TO A HEX DIGIT @OZ29180 M1679850 CLI NPLHEXCH,X'0F' TEST FOR VALID HEX DIGIT @OZ29180 M1679860 BH NPLHEX10 BRANCH IF INVALID @OZ29180 M1679870 IC R1,NPLHEXCH GET HEX DIGIT IN WORK REG @OZ29180 M1679880 SLL R0,4 MAKE ROOM FOR DIGIT @OZ29180 M1679890 OR R0,R1 PLACE DIGIT IN R0 @OZ29180 M1679900 BXH WA,R14,NPLHEX15 SCAN TO NEXT CHARACTER @OZ29180 M1679910 BCT WD,NPLHEX05 TRANSLATE NEXT BYTE @OZ29180 M1679920 B NPLHEX15 8 BYTES TRANSLATED @OZ29180 M1679930 SPACE 1 @OZ29180 M1679940 NPLHEX10 C WD,=F'8' ANY VALID HEX DIGITS FOUND @OZ29180 M1679950 BNL NPLHXERR ERROR IF NONE FOUND @OZ29180 M1679960 NPLHEX15 L WD,NPLHEXSV RESTORE RETURN ADDRESS @OZ29180 M1679970 B 0(,WD) RETURN TO CALLER @OZ29180 M1679980 SPACE 2 @OZ29180 M1679990 NPLHXERR L R1,=A(NPLHXERM) GET INVALID HEX MESSAGE @OZ29180 M1680000 B NPLERMSG GO ISSUE MESSAGE @OZ29180 M1680050 TITLE 'INIT HASP INITIALIZATION -- COMPACTION STRING SCAN XM1680100 SUBROUTINES' R41 M1680200 *********************************************************************** M1680300 * * M1680400 * NPLASCAN -- SCAN AND CONVERT COMPACT= POSITIONAL PARMS * M1680500 * EXIT: WD=HEX CHAR, R0=BIN CHAR (NEG IF INVLD) * M1680600 * * M1680700 *********************************************************************** M1680800 SPACE 1 R41 M1680900 NPLASCAN CLC 0(2,WA),=CL3', ' IF NOT CONTINUATION R41 M1681000 BNE NPLA0 GO SCAN FIELD R41 M1681100 CLI 2(WA),C',' IF NOT SPECIAL CASE OF -, ,- R41 M1681200 BNE NPLACONT GO GET CONTINUATION CARD R41 M1681300 SPACE 1 R41 M1681400 NPLA0 LNR R0,WA SET R0 INVALID INITIALLY R41 M1681500 XR WD,WD CLEAR REG FOR CHAR R41 M1681600 CLI 2(WA),C',' IF 1 CHAR FIELD R41 M1681700 BE NPLA1 GO LOAD IT R41 M1681800 CLI 2(WA),C' ' IF NOT 1 CHAR FIELD R41 M1681900 BNE NPLA2 GO TEST FOR 2 CHAR FIELD R41 M1682000 B NPLALL1 LAST CHAR, GO TEST @OZ48588 M1682100 NPLA1 IC WD,1(,WA) LOAD HEX CHAR R41 M1682200 CLI 1(WA),C'0' IF FIELD R41 M1682300 BL NPLARTN IS NON NUMERIC R41 M1682400 CLI 1(WA),C'9' LEAVE R0 R41 M1682500 BH NPLARTN AS INVALID R41 M1682600 LR R0,WD GET R41 M1682700 SLL R0,28 BINARY R41 M1682800 SRL R0,28 CHAR R41 M1682900 SPACE 1 R41 M1683000 NPLARTN LA WA,2(,WA) POINT TO NEXT FIELD R41 M1683100 BR WE RETURN R41 M1683200 SPACE 1 R41 M1683300 NPLA2 CLI 3(WA),C',' IF 2 CHAR FIELD R41 M1683400 BE NPLAC2 GO CONVERT IT R41 M1683500 CLI 3(WA),C' ' IF NOT 2 CHAR FIELD R41 M1683600 BNE NPLDVERR GO ISSUE ERROR MSG R41 M1683700 B NPLALL2 LAST CHAR, GO TEST @OZ48588 M1683800 NPLAC2 CLI 1(WA),C'A' IF LESS THAN A R41 M1683900 BL NPLDVERR GO ISSUE ERROR MSG R41 M1684000 CLI 1(WA),C'F' IF MORE THAN F R41 M1684100 BH NPLAFOX1 GO TEST FOR 1-9 R41 M1684200 IC WD,1(,WA) PICK UP ALPHA CHAR R41 M1684300 LA WD,9(,WD) CHANGE RIGHTMOST 4 BITS TO A-F R41 M1684400 B NPLASHF1 GO POSITION 4-BIT FIELD R41 M1684500 EJECT R41 M1684600 NPLAFOX1 CLI 1(WA),C'0' IF LESS THAN 0 R41 M1684700 BL NPLDVERR GO ISSUE ERROR MSG R41 M1684800 CLI 1(WA),C'9' IF MORE THAN 9 R41 M1684900 BH NPLDVERR GO ISSUE ERROR MSG R41 M1685000 IC WD,1(,WA) PICK UP NUMERIC CHAR R41 M1685100 LR R0,WD GET COPY R41 M1685200 SLL R0,28 CONVERT R41 M1685300 SRL R0,28 TO R41 M1685400 MH R0,=H'10' BINARY R41 M1685500 SPACE 1 R41 M1685600 NPLASHF1 SLL WD,28 POSITION R41 M1685700 SRL WD,24 4-BIT FIELD R41 M1685800 CLI 2(WA),C'A' IF LESS THAN A R41 M1685900 BL NPLDVERR GO ISSUE ERROR MSG R41 M1686000 CLI 2(WA),C'F' IF MORE THAN F R41 M1686100 BH NPLAFOX2 GO TEST FOR 1-9 R41 M1686200 IC LINK,2(,WA) PICK UP ALPHA CHAR R41 M1686300 LA LINK,9(,LINK) CHANGE RIGHTMOST BITS TO A-F R41 M1686400 LNR R0,WA SET R0 INVALID R41 M1686500 B NPLASHF2 GO POSITION RIGHTMOST 4-BITS R41 M1686600 SPACE 1 R41 M1686700 NPLAFOX2 CLI 2(WA),C'0' IF LESS THAN 0 R41 M1686800 BL NPLDVERR GO ISSUE ERROR MSG R41 M1686900 CLI 2(WA),C'9' IF MORE THAN 9 R41 M1687000 BH NPLDVERR GO ISSUE ERROR MSG R41 M1687100 IC LINK,2(,WA) PICK UP NUMERIC CHAR R41 M1687200 SPACE 1 R41 M1687300 NPLASHF2 SLL LINK,28 COMBINE R41 M1687400 SRL LINK,28 TWO 4-BIT R41 M1687500 AR WD,LINK FIELDS R41 M1687600 LTR R0,R0 IF R0 IS INVALID R41 M1687700 BM NPLADD2 LEAVE IT INVALID R41 M1687800 AR R0,LINK R0 IS A BINARY CHAR R41 M1687900 SPACE 1 R41 M1688000 NPLADD2 LA WA,3(,WA) POINT TO NEXT FIELD R41 M1688100 BR WE RETURN R41 M1688200 SPACE 1 R41 M1688300 NPLACONT STM R1,R6,NPLASAVE SAVE STATUS R41 M1688400 BAL LINK,NPLLIST LIST CURRENT CARD R41 M1688500 BAL LINK,NPLGET GET NEXT CARD R41 M1688600 B NPLDVERR IF EOF, GO ISSUE ERROR MSG +0 R41 M1688700 LM R1,R6,NPLASAVE RESTORE STATUS +4 R41 M1688800 LA WA,NCARD-2 SEARCH R41 M1688900 LA R14,1 FOR R41 M1689000 LA R15,NCARD+70 START R41 M1689100 NPLASCNB BXH WA,R14,NPLDVERR OF R41 M1689200 CLI 1(WA),C' ' NEXT R41 M1689300 BE NPLASCNB FIELD R41 M1689400 B NPLA0 GO SCAN FIELD R41 M1689500 SPACE 1 R41 M1689600 NPLASAVE DS 6F SAVES STATUS REGS R41 M1689700 EJECT R41 M1689800 *********************************************************************** M1689900 * * M1690000 * NPLDCALC -- CALC DISPL AND ATTRIB OF NEXT COMPACTION CHAR * M1690100 * * M1690200 *********************************************************************** M1690300 SPACE 1 R41 M1690400 USING CPTDSECT,R1 R41 M1690500 SPACE 1 R41 M1690600 NPLDCALC CH WC,=X'000F' IF LAST VALID CHAR R41 M1690700 BE NPLDOUT GO TEST FOR END OF STRING R41 M1690800 CLI CPTNMAST,16 IF NOT SPECIAL 16 MASTERS CASE, R41 M1690900 BNE NPLDCAL1 GO CALC NEXT DISPLACEMENT R41 M1691000 CH WC,=X'00FF' IF LAST VALID CHAR R41 M1691100 BE NPLDOUT GO TEST FOR END OF STRING R41 M1691200 SPACE 1 R41 M1691300 NPLDCAL1 SRDL WC,4 SEPARATE OLD DISPLACEMENT R41 M1691400 SRL WD,28 INTO TWO 4-BIT DIGITS: ROW,COL R41 M1691500 LA WD,1(,WD) INCREMENT COLUMN DIGIT BY 1 R41 M1691600 CLM WD,1,CPTNMAST IF NOT PAST MASTER CHARS R41 M1691700 BL NPLDCAL2 LEAVE ATTRIBUTE AS IS R41 M1691800 LA WB,CPTNMST SWITCH TO NONMASTER ATTRIBUTE R41 M1691900 SPACE 1 R41 M1692000 NPLDCAL2 CH WD,=H'16' IF NOT TOO MANY COLUMNS R41 M1692100 BL NPLDCOMB GO FORM NEW DISPLACEMENT R41 M1692200 BCTR WC,0 NEXT ROW R41 M1692300 XR WD,WD FIRST COLUMN R41 M1692400 CLM WC,1,CPTNMAST IF ROW HIGHER THAN NUM MASTERS R41 M1692500 BNL NPLDCOMB LEAVE AT FIRST COLUMN R41 M1692600 IC WD,CPTNMAST SHIFT COLUMN PAST NUM MASTERS R41 M1692700 SPACE 1 R41 M1692800 NPLDCOMB SLL WC,4 COMBINE ROW AND R41 M1692900 AR WC,WD COLUMN IN 1 BYTE R41 M1693000 B NPLALOOP RETURN NORMALLY R41 M1693100 SPACE 1 R41 M1693200 NPLDOUT CLI 0(WA),C' ' IF MORE CHARS IN FIELD R41 M1693300 BNE NPLDVERR GO ISSUE ERROR MSG R41 M1693400 B NPLAOUT RETURN, CPT FINISHED R41 M1693500 SPACE 1 @OZ48588 M1693510 NPLALL1 CH WC,=X'000F' ALL CHARS THERE ... @OZ48588 M1693515 BE NPLA1 YES RETURN NORMAL @OZ48588 M1693520 CLI CPTNMAST,16 IF NOT SPECIAL 16 MASTER @OZ48588 M1693522 BNE NPLDVERR CASE, GO ISSUE ERROR MSG @OZ48588 M1693526 CH WC,=X'00FF' IF LESS THAN NO OF REQUIRED @OZ48588 M1693530 BNE NPLDVERR MASTER,GO ISSUE ERROR MSG @OZ48588 M1693534 B NPLA1 RETURN NORMAL @OZ48588 M1693540 NPLALL2 CH WC,=X'000F' ALL CHARS THERE ... @OZ48588 M1693560 BE NPLAC2 YES, RETURN NORMAL @OZ48588 M1693580 CLI CPTNMAST,16 IF NOT SPECIAL 16 MASTER @OZ48588 M1693585 BNE NPLDVERR CASE,GO ISSUE ERROR MSG @OZ48588 M1693589 CH WC,=X'00FF' IF LESS THAN NO OF REQUIRE @OZ48588 M1693593 BNE NPLDVERR MASTER,GO ISSUE ERROR MSG @OZ48588 M1693597 B NPLAC2 RETURN NORMAL @OZ48588 M1693600 DROP R1 R41 M1693700 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT SUB-PARAMETECM1693800 R SCAN SUBROUTINE' R41 M1693900 NPLSSCAN NULL SUB-PARAMETER SCAN SUBROUTINE M1694000 MVC NPLDSAVE,0(R1) SAVE CURRENT FIELD DATA R4 M1694100 STM R0,R1,NPLSCTAB SAVE REGISTERS M1694200 LA WA,NCARD-2 RESET CARD COLUMN M1694300 SPACE 1 R4 M1694400 BXH WA,R14,NPLSSERR SEARCH FOR M1694500 CLI 1(WA),C' ' START OF M1694600 BE *-8 NAME FIELD M1694700 SPACE 1 R4 M1694800 BXH WA,R14,NPLSSERR SEARCH FOR M1694900 CLI 1(WA),C' ' END OF M1695000 BNE *-8 NAME FIELD M1695100 SPACE 1 R4 M1695200 NPLSSC01 BXH WA,R14,NPLSSC25 SEARCH FOR M1695300 CLI 1(WA),C' ' START OF M1695400 BE *-8 SUB-PARAMETERS M1695500 SPACE 1 R4 M1695600 NPLSSC02 MVI NPLSFILL,C' ' PRESET VALUE FIELD M1695700 MVC NPLSVAL,NPLSFILL TO BLANKS M1695800 MVI NPLSSC22+1,X'F0' SET FOR ALPHAMERIC SCAN R4 M1695900 L R1,=A(NPLTRT2) POINT TO ALPHAMERIC XLATE TABLE R4 M1696000 MVI C'-'(R1),0 ALLOW HYPHEN AND SLASH R4 M1696100 MVI C'/'(R1),0 AS LEGAL CHARACTERS R4 M1696200 BAL WD,NPLSSC20 SCAN KEYWORD M1696300 B NPLSKERR BRANCH IF ILLEGAL KEYWORD M1696400 CLI NPLSNAME+7,C' ' TEST FOR NULL KEYWORD M1696500 BE NPLSSC20 IGNORE NULL KEYWORDS M1696600 CLI NPLSNAME-1,C' ' TEST FOR OVERFLOW M1696700 BNE NPLSKERR BRANCH IF MORE THAN 8 CHARACTERS M1696800 SPACE 1 R4 M1696900 L WB,NPLSCTAB GET ADDRESS OF SCAN TABLE M1697000 SPACE 1 R4 M1697100 USING NSCANTBL,WB ESTABLISH SCAN TABLE ADDRESSABILITY M1697500 SPACE 1 R4 M1698000 NPLSSC03 CLC NPLSNAME,NSCANAME COMPARE TABLE KEYWORD M1698500 BE NPLSSC04 BRANCH IF KEYWORD MATCHES M1699000 LA WB,NSCANEXT GET ADDRESS OF NEXT ENTRY M1699500 CLI 0(WB),X'FF' TEST FOR END OF SCAN TABLE M1700000 BNE NPLSSC03 CONTINUE IF NOT END OF TABLE M1700500 B NPLSKERR ERROR IF KEYWORD NOT FOUND M1701000 SPACE 1 R4 M1701500 NPLSSC04 L WC,NPLSOTAB GET ADDRESS OF OUTPUT TABLE M1702000 SPACE 1 @OZ29180 M1702050 TM NSCANFL2,NSCFLRTN TEST FOR SPECIAL ROUTINE @OZ29180 M1702100 BZ NPLSSCNR BRANCH IF NONE @OZ29180 M1702150 ICM R1,7,NSCANRTN GET ROUTINE ADDRESS @OZ29180 M1702200 BALR WF,R1 GOTO ROUTINE @OZ29180 M1702250 B NPLSSC02 GET NEXT SUBPARAMETER @OZ29180 M1702300 SPACE 1 @OZ29180 M1702350 NPLSSCNR AH WC,NSCANDSP ADD DISPLACEMENT FOR SUBPRM @OZ29180 M1702500 TM NSCANFLG,NSCFLMSK+NSCFLCOM TEST OPTION BYTE M1703000 BZ NPLSSC05 BRANCH IF VALUE REQUIRED M1703500 IC R1,NSCANMSK GET MASK FROM SCAN TABLE M1704000 LA WD,NPLSOI ASSUME 'OR' OPERATION M1704500 TM NSCANFLG,NSCFLCOM TEST OPTION BYTE M1705000 BZ *+12 BRANCH IF NO COMPLEMENTATION M1705500 LCR R1,R1 COMPLEMENT MASK M1706000 BCTR R1,0 CONVERT TO ONE'S COMPLEMENT M1706500 LA WD,NPLSNI GET 'AND OPERATION M1707000 EX R1,0(,WD) PERFORM INDICATED OPERATION M1707500 B NPLSSC02 GET NEXT SUB-FIELD M1708000 SPACE 2 M1708500 NPLSSC05 CLI 0(WA),C'=' TEST CURRENT CHARACTER M1709000 BNE NPLSVERR ILLEGAL IF NOT EQUAL SIGN M1709500 L R1,=A(NPLTRT2) POINT TO ALPHAMERIC XLATE TABLE R4 M1710000 MVI C'-'(R1),1 DISALLOW HYPHEN AND SLASH R4 M1710500 MVI C'/'(R1),1 AS LEGAL CHARACTERS R4 M1711000 MVC NPLSNAME,NPLSFILL BLANK OUT NAME FIELD M1711500 TM NSCANFLG,NSCFLBLK TEST OPTION BYTE M1712000 BO NPLSSC06 BRANCH IF BLANK-FILL INDICATED M1712500 MVI NPLSFILL,C'0' ASSUME EBCDIC-ZERO-FILL M1713000 TM NSCANFLG,NSCFLZER TEST OPTION BYTE M1713500 BO *+8 BRANCH IF EBCDIC-ZERO-FILL M1714000 MVI NPLSFILL,0 BINARY-ZERO-FILL M1714500 MVC NPLSVAL,NPLSFILL PRESET VALUE FIELD TO ZEROES M1715000 SPACE 2 M1715500 NPLSSC06 TM NSCANFLG,NSCFLNUM+NSCFLBIN TEST OPTION BYTE M1716000 BZ *+8 BRANCH IF ALPHAMERIC SCAN M1716500 MVI NPLSSC22+1,0 ELSE SET FOR NUMERIC SCAN R4 M1717000 BAL WD,NPLSSC20 SCAN NEXT VALUE M1717500 B NPLSVERR BRANCH IF ILLEGAL VALUE M1718000 TM NSCANFLG,NSCFLBIN TEST OPTION BYTE M1718500 BZ NPLSSC07 BRANCH IF NO BINARY CONVERSION M1719000 CLC NPLSVAL(56),NPLSFILL TEST FOR OVERFLOW M1719500 BNE NPLSVERR ERROR IF MORE THAN EIGHT CHARACTERS M1720000 OI NPLSNAME+7,X'F0' INSURE VALID ZONE M1720500 PACK NPLSNAME,NPLSNAME CONVERT M1721000 SR R0,R0 VALUE M1721500 CVB R1,NPLSNAME TO M1722000 STM R0,R1,NPLSNAME BINARY M1722500 SPACE 2 M1723000 NPLSSC07 SR R0,R0 GET M1723500 IC R0,NSCANLEN VALUE LENGTH M1724000 BCTR R0,0 DECREMENT FOR LATER USE M1724500 LA WD,62 COMPUTE LENGTH M1725000 SR WD,R0 OF UNUSED VALUE FIELD M1725500 BM NPLSSC08 BRANCH IF ZERO LENGTH M1726000 STC WD,*+5 SET COMPARE LENGTH M1726500 CLC NPLSVAL(*-*),NPLSFILL TEST FOR FIELD OVERFLOW M1727000 BNE NPLSVERR BRANCH IF VALUE OVERFLOWS FIELD M1727500 SPACE 2 M1728000 NPLSSC08 LA WD,NPLSVAL(WD) COMPUTE ADDRESS OF 1ST BYTE - 1 M1728500 TM NSCANFLG,NSCFLFIT TEST OPTION BYTE M1729000 BZ NPLSSC09 BRANCH IF EXACT FIT NOT REQUIRED M1729500 CLC NPLSFILL,1(WD) TEST FIRST BYTE OF VALUE M1730000 BNE NPLSSC12 BRANCH IF VALUE IS EXACT FIT M1730500 B NPLSVERR ERROR IF NOT EXACT FIT M1731000 SPACE 2 @OZ29180 M1731500 NPLSSC09 TM NSCANFLG,NSCFLEFT TEST OPTION BYTE M1732000 BZ NPLSSC12 BRANCH IF NO LEFT JUSTIFICATION M1732500 CLC NPLSVAL,NPLSFILL TEST VALUE M1733000 BE NPLSSC12 BRANCH IF NULL M1733500 STC R0,NPLSSC11+1 SET SHIFT LENGTH M1734000 NPLSSC10 CLC NPLSFILL,1(WD) TEST FIRST CHARACTER M1734500 BNE NPLSSC12 BRANCH IF NOT NULL VALUE M1735000 NPLSSC11 MVC 1(*-*,WD),2(WD) SHIFT LEFT ONE CHARACTER M1735500 MVC NPLSVAL+63(1),NPLSFILL ADD FILL CHARACTER M1736000 B NPLSSC10 TRY AGAIN M1736500 SPACE 2 M1737000 NPLSSC12 STC R0,*+5 SET MOVE LENGTH M1737500 MVC 0(*-*,WC),1(WD) SET OUTPUT VALUE M1738000 B NPLSSC02 GET NEXT SUB-PARAMETER M1738500 SPACE 2 R4 M1739000 NPLSKERR L R1,=A(NPLSKERM) POINT TO INVALID KEYWORD MSG R4 M1739500 MVC NPLSKERK-NPLSKERM(,R1),NPLSNAME KILL IN KEYWORD R4 M1740000 B NPLSERR PROCESS HASPPARM ERROR M1740500 SPACE 2 R4 M1741000 NPLSVERR L R1,=A(NPLSVERM) POINT TO INVALID VALUE MSG R4 M1741500 MVC NPLSVERK-NPLSVERM(,R1),NSCANAME FILL IN NAME R4 M1742000 B NPLSERR PROCESS HASPPARM ERROR M1742500 DROP WB DROP SCAN TABLE ADDRESSABILITY M1743000 EJECT @OZ29180 M1743500 NPLSSC20 NULL KEYWORD AND VALUE SCAN SUBROUTINE M1744000 LTR R15,R15 TEST FOR END OF CARD M1744500 BZ NPLSSC24 BRANCH IF END OF CARD M1745000 BXH WA,R14,NPLSSC23 GET NEXT CHARACTER M1745500 SPACE 2 M1746000 NPLSSC21 CLI 0(WA),C',' TEST NEXT CHARACTER M1746500 BE 4(,WD) RETURN IF COMMA M1747000 CLI 0(WA),C'=' * M1747500 BE 4(,WD) RETURN IF EQUAL SIGN M1748000 CLI 0(WA),C' ' * M1748500 BE NPLSSC23 BRANCH IF BLANK M1749000 L R1,=A(NPLTRT2) POINT TO TRANSLATE TABLE R4 M1749500 TRT 0(1,WA),0(R1) TEST FOR ILLEGAL ALPHAMERIC R4 M1750000 BNZR WD RETURN IF YES TO +0 R4 M1750500 NPLSSC22 NOP *+10 BR IF ALPHAMERIC SCAN R4 M1751000 CLI 0(WA),C'0' TEST FOR NUMERIC R4 M1751500 BLR WD RETURN IF NO TO +0 R4 M1752000 CLC NPLSFILL,NPLSVAL TEST HIGH-ORDER CHARACTER M1752500 BNER WD BRANCH IF OVERFLOW M1753000 MVC NPLSVAL(63),NPLSVAL+1 SHIFT PARAMETER M1753500 MVC NPLSVAL+63(1),0(WA) ADD CURRENT CHARACTER M1754000 BXLE WA,R14,NPLSSC21 GET NEXT CHARACTER M1754500 NPLSSC23 SLR R15,R15 INDICATE END OF CARD M1755000 B 4(,WD) INDICATE END-OF-FIELD M1755500 EJECT R4 M1756000 NPLSSC24 BCTR WA,0 BACK UP ONE CHARACTER M1756500 CLI 0(WA),C',' TEST LAST CHARACTER M1757000 BNE NPLSSC25 NO CONTINUATION IF NOT COMMA M1757500 BAL LINK,NPLLIST LIST CURRENT CARD M1758000 BAL LINK,NPLGET READ NEXT CARD M1758500 B NPLSCERR ILLEGAL IF END-OF-FILE M1759000 LA WA,NCARD-2 SET UP M1759500 LA R14,1 SCAN M1760000 LA R15,NCARD+70 REGISTERS M1760500 B NPLSSC01 SCAN CONTINUATION CARD M1761000 SPACE 2 M1761500 NPLSSC25 CLI NCARD+71,C' ' TEST COLUMN 72 M1762000 BE NPLSEXIT BRANCH IF NO CONTINUATION INDICATED M1762500 BAL LINK,NPLLIST LIST CURRENT CARD M1763000 BAL LINK,NPLGET READ NEXT CARD M1763500 B NPLSCERR ILLEGAL IF END-OF-FILE M1764000 B NPLSSC25 TREAT AS COMMENT M1764500 SPACE 5 M1765000 NPLSCERR L R1,=A(NPLSCERM) POINT TO INVALID CONTINUATION MSG R4 M1765500 NPLSERR OI NPLFLAGS,NPLERROR INDICATE HASPPARM ERROR M1766000 MVC NDIAG,0(R1) MOVE DIAGNOSTIC TO PARM CARD R4 M1766500 SPACE 2 M1767000 NPLSEXIT LM R0,R1,NPLSCTAB RESTORE REGISTERS M1767500 BR WE AND RETURN M1768000 SPACE 5 M1768500 NPLSOI OI 0(WC),*-* ***** EXECUTE ONLY ***** M1769000 NPLSNI NI 0(WC),*-* ***** EXECUTE ONLY ***** M1769500 SPACE 2 M1770000 NPLSCTAB DS F ADDRESS OF SCAN TABLE M1770500 NPLSOTAB DS F ADDRESS OF OUTPUT TABLE M1771000 SPACE 2 M1771500 ORG *-7 FORCE M1772000 DS 0D,7X BOUNDARY ALIGNMENT M1772500 NPLSFILL DS C FILLER CHARACTER M1773000 NPLSVAL DS 0CL64,CL56 VALUE FIELD M1773500 NPLSNAME DS CL8 NAME FIELD M1774000 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT SUB-PARAMETECM1774500 R SCAN TABLE DSECT' R41 M1775000 SPACE 5 M1775500 NSCANTBL DSECT SUB-PARAMETER SCAN TABLE M1776000 NSCANAME DS CL8 SUB-PARAMETER NAME M1776500 NSCANFLG DS B SUB-PARAMETER FLAGS M1777000 NSCANFL2 DS B SUB-PARAMETER FLAGS 2 @OZ29180 M1777100 NSCANDSP DS AL2 SUB-PARAMETER VALUE DISP. @OZ40627 M1777200 NSCANMSK DS 0X SUB-PARAMETER MASK @OZ40627 M1777300 NSCANLEN DS AL1 SUB-PARAMETER VALUE LENGTH @OZ40627 M1777500 NSCANRTN DS AL3 SUB-PARAMETER SCAN ROUTINE @OZ40627 M1778000 NSCANDS2 DS AL2 SUB-PARAMETER DISPLACEMENT2 @OZ40627 M1778100 DS AL2 RESERVED @OZ40627 M1778500 NSCANEXT DS 0F ADDRESS OF NEXT TABLE ENTRY M1779000 HASPINIT CSECT END OF SUB-PARAMETER SCAN TABLE M1779500 SPACE 5 M1780000 * NSCANFLG M1780500 SPACE 3 M1781000 NSCFLMSK EQU B'10000000' NSCANMSK CONTAINS MASK M1781500 NSCFLCOM EQU B'01000000' NSCANMSK CONTAINS COMPLEMENTED MASK M1782000 NSCFLNUM EQU B'00100000' VALUE MUST BE NUMERIC M1782500 NSCFLBIN EQU B'00010000' CONVERT VALUE TO BINARY M1783000 NSCFLEFT EQU B'00001000' LEFT-ADJUST VALUE M1783500 NSCFLFIT EQU B'00000100' NSCANLEN MUST EQUAL VALUE LENGTH M1784000 NSCFLBLK EQU B'00000010' BLANK-FILL VALUE M1784500 NSCFLZER EQU B'00000001' EBCDIC-ZERO-FILL VALUE M1785000 SPACE 5 @OZ29180 M1785100 * NSCANFL2 @OZ29180 M1785200 SPACE 3 @OZ29180 M1785300 NSCFLRTN EQU B'10000000' NSCANRTN CONTAINS RTN ADDR @OZ29180 M1785400 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT GET SUBROUTICM1785500 NE' R41 M1786000 NPLGET NULL PARAMETER LIBRARY GET SUBROUTINE M1786500 ST LINK,NPLGSAVE SAVE RETURN REGISTER M1787000 MVC NDIAG,NDIAG-1 CLEAR DIAGNOSTIC AREA M1787500 TM NPLFLAGS,NPLCONSL ARE WE IN CONSOLE MODE... R41 M1787600 BZ NPLGETCD BR IF NO R41 M1787700 MVI NPLECB,0 CLEAR ECB R41 M1787800 L R1,=A(NLOGMSG) POINT TO LOG MESSAGE R41 M1787900 MVC NLOGTEXT-NLOGMSG(,R1),NPLBLNKS CLEAR REPLY AREA R41 M1788000 $$WTOR NOPRMSG ISSUE CONSOLE QUERY R41 M1788100 WAIT ECB=NPLECB WAIT FOR RESPONSE R41 M1788200 L R1,=A(NLOGMSG) POINT TO LOG MESSAGE R41 M1788300 MVC NCARD,NLOGTEXT-NLOGMSG(R1) MOVE REPLY TO CARD AREA R41 M1788400 OC NCARD,NPLBLNKS FORCE UPPER CASE RESPONSE R41 M1788500 L LINK,NPLGSAVE RESTORE RETURN REGISTER R41 M1788600 CLC NCARD(4),=C'END ' TEST FOR 'END' R41 M1788700 BER LINK RETURN IF YES TO +0 R41 M1788800 CLC NCARD(7),=C'CANCEL ' TEST FOR CANCEL R41 M1788900 BNE NPLGETST BR IF NO TO TEST FOR COMMENT R41 M1789000 OI NPLFLAGS,NPLCAN INDICATE CANCEL R41 M1789100 B NPLGEOF1 BR TO END-OF-FILE EXIT R41 M1789200 EJECT R41 M1789300 NPLGETCD TM NPLFLAGS,NPLEOFSW TEST STATUS BYTE R41 M1789400 BO NPLGEOF BRANCH IF PREVIOUS EOF M1789500 L R1,=A(HASPPARM) POINT TO HASPPARM DCB R41 M1789600 GET (1) GET LOCATION OF NEXT CARD R41 M1789700 MVC NCARD,0(R1) MOVE CARD TO WORK AREA M1790000 CLC NCARD(2),=C'/*' TEST FOR /* CARD M1791000 BE NPLGEOF1 BR IF YES TO SIMULATE EOF R41 M1791100 SPACE 1 R41 M1791200 NPLGETST LA R0,NCARD POINT TO START OF STATEMENT R41 M1791300 LA R1,71 GET STATEMENT LENGTH R41 M1791400 SLR R15,R15 SET LENGTH FOR COMPARE R41 M1791500 ICM R15,8,NPLBLNKS GET PAD BYTE R41 M1791600 CLCL R0,R14 SCAN FOR 1ST NON-BLANK CHARACTER R41 M1791700 BE NPLGELST BR IF BLANK STATEMENT R41 M1791800 LR WA,R0 RELOAD FIELD ADDRESS R41 M1791900 CLI 0(WA),C'*' TEST FOR COMMENT R41 M1792000 BE NPLGELST BR IF YES TO LIST/LOG STATEMENT R41 M1792100 L LINK,NPLGSAVE RESTORE RETURN REGISTER R41 M1792200 B 4(,LINK) AND RETURN TO +4 R41 M1792300 SPACE 1 R41 M1792400 NPLGELST BAL LINK,NPLLIST LIST/LOG BLANK/COMMENT STATEMENT R41 M1792500 L LINK,NPLGSAVE RESTORE RETURN REGISTER R41 M1792600 B NPLGET BR TO GET NEXT STATEMENT R41 M1792700 SPACE 3 R41 M1792800 NPLGEOF NULL END-OF-FILE EXIT M1793000 MVC NCARD,NLINE BLANK OUT CARD IMAGE M1793500 NPLGEOF1 OI NPLFLAGS,NPLEOFSW SET EOF SWITCH M1794000 L LINK,NPLGSAVE RESTORE RETURN REGISTER M1794500 BR LINK TAKE END-OF-FILE RETURN M1795000 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT CONVERTER PACM1795500 RAMETER FIELD VALIDATION SUBROUTINE' R41 M1796000 *********************************************************************** M1796500 * * M1797000 * NPLRDVAL -- VALIDATE CONVERTER PARM FIELD * M1797500 * * M1798000 *********************************************************************** M1798500 SPACE 1 R4 M1799000 NPLRDVAL MVC NPLLWORK(1),NPLWORK+14 SAVE 'A---' R4 M1799500 MVI NPLWORK+14,C'0' MAKE 'A---' NUMERIC R4 M1800000 LA R0,20 GET PARM FIELD LENGTH R4 M1800500 LA WC,NPLWORK GET PARM FIELD ADDRESS R41 M1801000 SPACE 1 R4 M1801500 SKIP310 CLI 0(WC),C'0' ENSURE R41 M1802000 BLR WE ALL BUT R41 M1802500 LA WC,1(,WC) 'A---' R41 M1803000 BCT R0,SKIP310 NUMERIC R4 M1803500 SPACE 1 R4 M1804000 MVC NPLWORK+14(1),NPLLWORK RESTORE ORIGINAL 'A---' R4 M1804500 CLI NPLWORK,C'3' TEST 'B' R4 M1805000 BHR WE RETURN IF ILLEGAL TO +0 R41 M1805500 CLC =C'144000',NPLWORK+3 TEST 'MMMMSS' R4 M1806000 BLR WE RETURN IF ILLEGAL TO +0 R41 M1806500 CLC =C'60',NPLWORK+7 TEST 'SS' R4 M1807000 BNHR WE RETURN IF ILLEGAL TO +0 R41 M1807500 CLI NPLWORK+12,C'3' TEST 'R' R4 M1808000 BHR WE RETURN IF ILLEGAL TO +0 R41 M1808500 CLI NPLWORK+13,C'1' TEST 'L' R4 M1809000 BHR WE RETURN IF ILLEGAL TO +0 R41 M1809500 CLC NPLWORK+15(4),=C'0002' TEST '-AAA' AND 'E' R4 M1810000 BHR WE RETURN IF ILLEGAL TO +0 R41 M1810500 CLI NPLWORK+19,C'1' TEST 'F' R4 M1811000 BHR WE RETURN IF ILLEGAL TO +0 R41 M1811500 CLI NPLLWORK,C'E' TEST 'A---' R4 M1812000 BH NPLRDVLA BR IF PROBABLE NUMERIC R4 M1812500 TM NPLLWORK,1 TEST FOR LEGAL ALPHA R4 M1813000 BZR WE RETURN IF ILLEGAL TO +0 R41 M1813500 B 4(,WE) OK IF A, C, OR E R41 M1813600 SPACE 1 R41 M1813700 NPLRDVLA CLI NPLLWORK,C'0' TEST FOR NUMERIC R41 M1813800 BLR WE RETURN IF ILLEGAL ALPHA TO +0 R41 M1813900 TM NPLLWORK,1 TEST FOR LEGAL NUMERIC R41 M1814000 BLR WE RETURN IF ILLEGAL TO +0 R41 M1814100 B 4(,WE) OK IF 0, 2, 4, 6, OR 8 R41 M1814200 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT LIST SUBROUTCM1814300 INE' R41 M1814400 NPLLIST NULL PARAMETER STATEMENT LIST SUBROUTINE M1814500 ST LINK,NPLLSAVE SAVE RETURN REGISTER R41 M1814600 L R1,=A(NDIAGMSG) POINT TO DIAGNOSTIC MESSAGE R41 M1814700 MVC NDIAGTXT-NDIAGMSG(,R1),NDIAG SET DIAGNOSTIC R41 M1814800 L R1,=A(NLOGMSG) POINT TO LOG MESSAGE R41 M1814900 MVC NLOGTEXT-NLOGMSG(,R1),NCARD INSERT STATEMENT R41 M1815000 LA R0,78 SET LOOP TERMINATOR R41 M1815100 LA WA,NCARD+79 POINT TO LAST CHARACTER R41 M1815200 SPACE 1 R41 M1815300 NPLLOGLN CLI 0(WA),C' ' TEST NEXT CHARACTER R41 M1815400 BNE NPLLOGIT BR IF NON-BLANK R41 M1815500 BCTR WA,0 BACK UP 1 CHARACTER R41 M1815600 BCT R0,NPLLOGLN LOOP UNTIL 1ST NON-BLANK CHAR R41 M1815700 SPACE 1 R41 M1815800 NPLLOGIT SL WA,=A(NCARD) GET STATEMENT LENGTH - 1 R41 M1815900 LA WA,4+9+1(,WA) ALLOW FOR WTO, MSGID, + 1 R41 M1816000 STH WA,0(,R1) SET MESSAGE LENGTH R41 M1816100 CLI NDIAG,C' ' WAS STATEMENT FLAGGED... R41 M1816200 BE NPLOGTST BR IF NO R41 M1816300 TM NPLFLAGS,NPLCONSL ARE WE IN CONSOLE MODE... R41 M1816400 BO NPLDIAG BR IF YES R41 M1816500 $$WTO (R1) DISPLAY PARAMETER STATEMENT R41 M1816600 SPACE 1 R41 M1816700 NPLDIAG $$WTO NDIAGMSG DISPLAY PARAMETER DIAGNOSTIC R41 M1816800 OI NPLFLAGS,NPLCONSL ENTER CONSOLE MODE R41 M1816900 B NPLIST BR TO LIST PARAMETER STATEMENT R41 M1817000 SPACE 1 R41 M1817100 NPLOGTST TM $OPTSTAT,$OPTLOG TEST OPERATOR OPTIONS R41 M1817200 BZ NPLIST BR IF NOLOG SPECIFIED R41 M1817300 TM NPLFLAGS,NPLNOLOG TEST HASPPARM CONTROL STATUS R41 M1817400 BO NPLIST BR IF NOLOG IN EFFECT R41 M1817500 L WA,=A(NLOGMSG) POINT TO LOG MESSAGE R41 M1817600 OI 2(WA),X'02' INDICATE HARD COPY ONLY R41 M1817700 $$WTO (WA) LOG PARAMETER STATEMENT R41 M1817800 NI 2(WA),255-X'02' RESET HARD COPY INDICATOR R41 M1817900 EJECT R41 M1818000 NPLIST L LINK,NPLLSAVE RESTORE RETURN ADDRESS R41 M1818100 TM $OPTSTAT,$OPTLIST TEST OPERATOR OPTIONS M1819000 BZR LINK BRANCH IF NOLIST SPECIFIED M1819500 TM NPLFLAGS,NPLNOLST TEST HASPPARM CONTROL STATUS M1820000 BOR LINK BRANCH IF NOLIST IN EFFECT M1820500 L WA,=A(HASPLIST) POINT TO HASPLIST DCB R41 M1821000 LH R0,NPLLINCT GET LINE COUNT M1821500 BCT R0,NPLLIST1 BRANCH IF NOT END OF PAGE M1822000 LH R1,NPLLPGCT GET PAGE COUNT M1823000 LA R1,1(,R1) INCREMENT M1823500 STH R1,NPLLPGCT AND SAVE M1824000 CVD R1,NPLLWORK CONVERT TO PACKED DECIMAL M1824500 MVC NPLLPGNO,=X'40202120' SET EDIT MASK M1825000 ED NPLLPGNO,NPLLWORK+6 EDIT PAGE COUNT M1825500 PUT (WA),NPLLTTL1 WRITE TITLE R41 M1826000 PUT (WA),NPLLTTL2 WRITE SPACE R41 M1826500 LA R0,50 RESET LINE COUNT M1827000 SPACE 1 R41 M1827500 NPLLIST1 STH R0,NPLLINCT SAVE UPDATED LINE COUNT M1828000 PUT (WA),NLINE WRITE PARAMETER STATEMENT R41 M1828500 L LINK,NPLLSAVE RESTORE LINK REGISTER M1829000 BR LINK AND RETURN M1829500 TITLE 'HASP INITIALIZATION -- PARAMETER LIBRARY PROCESSING TERCM1830000 MINATION' R4 M1830500 NPLCLOSE NULL CLOSE PARAMETER LIBRARY DATA SETS R4 M1831000 L WA,=A(NPLCLIST) POINT TO DCB CLOSE LIST R41 M1831500 CLOSE MF=(E,(WA)) CLOSE FILES R41 M1832000 SPACE 1 R4 M1832500 NPLFREEP L R1,0(,WA) GET ADDRESS OF NEXT DCB R4 M1833000 TM DCBBUFCB+3-DCBDSECT(R1),1 TEST FOR BUFFER POOL R4 M1833500 BO NPLNPOOL BR IF NO R4 M1834000 FREEPOOL (1) ELSE FREE BUFFER POOL R4 M1834500 SPACE 1 R4 M1835000 NPLNPOOL TM 0(WA),X'80' TEST DCB LIST ENTRY R4 M1835500 LA WA,4(,WA) STEP TO NEXT ENTRY R4 M1836000 BZ NPLFREEP BR IF NOT LAST ENTRY R4 M1836500 EJECT R41 M1836600 TM NPLFLAGS,NPLCAN INITIALIZATION CANCELLED... R41 M1836700 BO NPLQUIT BR IF YES R41 M1836800 L WE,=A(NCATNIP) POINT TO NEXT SECTION R4 M1837000 TM NPLFLAGS,NPLERROR TEST FOR PARAMETER LIBRARY ERROR R4 M1837500 BZR WE BR IF NO TO NEXT SECTION R4 M1838000 L R1,=A(NMSG451) POINT TO WARNING MESSAGE R4 M1838500 SPACE 1 R4 M1839000 NPLWTOR $$WTO (R1) ISSUE WARNING MESSAGE TO OPERATOR R4 M1839500 SPACE 1 R4 M1840000 NPLQUERY MVI NPLECB,0 CLEAR ECB R4 M1840500 $$WTOR NMSG441 ASK OPERATOR ABOUT CONTINUING R4 M1841000 WAIT ECB=NPLECB WAIT FOR OPERATOR REPLY R4 M1841500 OI NPLREPLY,X'40' FORCE UPPER CASE REPLY R4 M1842000 CLI NPLREPLY,C'Y' TEST FOR CONTINUE R4 M1842500 BER WE BR IF YES R4 M1843000 CLI NPLREPLY,C'N' TEST FOR QUIT R4 M1843500 BNE NPLQUERY BR IF NO TO RE-ISSUE QUERY R4 M1844000 SPACE 1 R41 M1844100 NPLQUIT $EXIT NGQUITM ISSUE 'QUIT' MESSAGE AND QUIT R41 M1844500 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT DATA AREAS' M1857500 NPLDBL DS D DOUBLE WORD WORK AREA R4 M1858000 NPLLWORK EQU INITDBL DOUBLE WORD WORK AREA R4 M1858500 NPLHEXSV DS F HEX ROUTINE SAVE AREA @OZ29180 M1858600 NPLGSAVE DS F SAVE AREA R4 M1859000 NPLLSAVE DS F SAVE AREA R41 M1859500 NPLECB DS F WTOR ECB R41 M1860000 SPACE 1 R4 M1860500 NPLLINCT DC H'1' LINE COUNT R4 M1861000 NPLLPGCT DC H'0' PAGE COUNT R4 M1861500 NPLBFSZ DC AL2((4096+7-(TPBUFST-BUFDSECT))/8*8) MAXBUFSIZE @OZ50955 M1861700 SPACE 1 R4 M1862000 NPLMAXCP DC H'32767' MAXIMUM VALUE FOR CKPTPGS @OZ19494 M1862200 NPLMAXCL EQU NPLMAXCP MAXIMUM VALUE FOR CKPTLNS @OZ19494 M1862300 SPACE 1 @OZ19494 M1862400 NPLFLAGS DC AL1(NPLNOLOG) PARAMETER LIBRARY FLAGS R41 M1862500 NPLEOFSW EQU B'10000000' END-OF-FILE INDICATION R4 M1863000 NPLNOLST EQU B'01000000' NOLIST INDICATION R4 M1863500 NPLERROR EQU B'00100000' HASPPARM STMNT ERROR INDICATION R4 M1864000 NPLZAPSW EQU B'00010000' SUPERZAP MODE INDICATION R4 M1864500 NPLNOLOG EQU B'00001000' NOLOG INDICATOR R41 M1864600 NPLCONSL EQU B'00000100' CONSOLE MODE R41 M1864700 NPLCAN EQU B'00000010' INITIALIZATION ABORT SWITCH R41 M1864800 NPLREPLY DS C WTOR REPLY AREA R41 M1865000 SPACE 1 R4 M1865500 NPLDSAVE DS XL((DCTCLASS+36+1+3-DCTDSECT)/4*4) DCT/RAT SAVE AREA R4 M1866000 NPLWORK DS CL20 WORK AREA R4 M1866500 NPLHEXCH DS X HEX BYTE WORK AREA @OZ29180 M1866600 NPLDEVTP DS X DEVICE TYPE INDICATOR @OZ19494 M1866650 NPLRATTP DS X WORK AREA FOR TERMINAL TYP @OZ37429 M1866700 SPACE 3 R4 M1867000 NPLLTTL1 DC CL26'1',CL87'JES2 PARAMETER LIBRARY LISTING',C'PAGE' R4 M1867500 NPLLPGNO DC CL4' 1' EBCDIC PAGE NUMBER R4 M1868000 NPLLTTL2 DC CL121'0' DOUBLE SPACE R4 M1868500 NPLBLNKS EQU NPLLTTL2+1,120 BLANKS R4 M1869000 SPACE 3 R4 M1869500 NLINE DS 0CL121 LINE IMAGE R4 M1870000 DC CL1' ' CARRIAGE CONTROL R4 M1870500 NCARD DC CL80' ' CARD IMAGE R4 M1871000 DC CL2' ' R4 M1871500 NDIAG DC CL38' ' DIAGNOSTIC AREA R4 M1872000 SPACE 2 R41 M1872100 NERRCARD DC CL80' ' POTENTIAL ERROR SAVE AREA @OZ44388 M1872130 SPACE 2 @OZ44388 M1872160 DROP BASE2,BASE3,BASE4 KILL LOCAL ADDRESSABILITY R41 M1872200 EJECT R41 M1872500 LTORG R41 M1872600 TITLE 'HASP INITIALIZATION -- PARAMETER LIBRARY DATA CONTROL BCM1872700 LOCKS' R41 M1872800 AIF ('&PRINT' NE 'OFF').NCBB R41 M1872900 PUSH PRINT R41 M1873000 PRINT NOGEN R41 M1873100 .NCBB SPACE 2 R41 M1873200 NPLCLIST CLOSE (HASPPARM,FREE,HASPLIST,FREE),MF=L R41 M1873300 SPACE 3 R41 M1873400 HASPPARM DCB DSORG=PS,MACRF=(GL),DDNAME=HASPPARM,EODAD=NPLGEOF, R41CM1873500 LRECL=80,BUFNO=1,EROPT=SKP,RECFM=FB,EXLST=NPLEXLST R41 M1873600 SPACE 3 R41 M1873700 HASPLIST DCB DSORG=PS,MACRF=(PM),DDNAME=HASPLIST,RECFM=FBA, R41CM1873800 LRECL=121,EROPT=ACC,EXLST=NPLEXLST R41 M1873900 SPACE 2 R41 M1874000 AIF ('&PRINT' NE 'OFF').NCBE R41 M1874100 POP PRINT R41 M1874200 .NCBE SPACE 3 R41 M1874300 NPLEXLST DC 0F'0',X'85',AL3(NPLEXIT) DCB EXIT LIST R41 M1874400 SPACE 3 R41 M1874500 USING DCBDSECT,R1 PROVIDE DCB ADDRESSABILITY R41 M1874600 SPACE 1 R41 M1874700 NPLEXIT MVC DCBBUFL,DCBBLKSI SET BUFFER LENGTH R41 M1874800 OC DCBBLKSI,DCBBLKSI BLOCK SIZE PROVIDED... R41 M1874900 BNZR R14 RETURN IF YES R41 M1875000 MVC DCBBLKSI,DCBLRECL ELSE SET BLKSIZE=LRECL R41 M1875100 MVC DCBBUFL,DCBBLKSI AND RESET BUFFER LENGTH R41 M1875200 BR R14 THEN RETURN R41 M1875300 SPACE 1 R41 M1875400 DROP R1 KILL DCB ADDRESSABILITY R41 M1875500 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT SUB-PARAMETECM1875600 R SCAN TABLES' R41 M1875700 NPLPITST $SCNTBL PITDSECT LOGICAL INITIATOR SCAN TABLE R4 M1875800 $SCNTBL NAME,L'PITPATID,PITPATID,NSCFLBLK R4 M1875900 $SCNTBL CLASS,36,PITCLASS,NSCFLEFT+NSCFLBLK R4 M1876000 $SCNTBL (DRAIN,START),PITHOLD1,PITSTAT R4 M1876100 $SCNTBL END OF SCAN TABLE R4 M1876500 SPACE 5 R4 M1877000 NPLCATST $SCNTBL CATDSECT CAT SCAN TABLE R4 M1877500 $SCNTBL CONVPARM,L'CATCONVP,CATCONVP,NSCFLFIT R4 M1878000 $SCNTBL PERFORM,L'CATPERFM,CATPERFM,NSCFLNUM+NSCFLZER R4 M1878500 $SCNTBL PROCLIB,L'CATPROCN,CATPROCN,NSCFLNUM+NSCFLZER R4 M1879000 $SCNTBL (COPY,NOCOPY),CATTCOPY,CATJOBFL R4 M1879500 $SCNTBL (HOLD,NOHOLD),CATTHOLD,CATJBOPT R4 M1880000 $SCNTBL (NOJOURN,JOURNAL),CATNOJNL,CATJOBFL R4 M1880500 $SCNTBL (NOLOG,LOG),CATNOLOG,CATJBOPT R4 M1881000 $SCNTBL (NOOUTPUT,OUTPUT),CATNOUPT,CATJOBFL R4 M1881500 $SCNTBL (SCAN,NOSCAN),CATTSCAN,CATJOBFL R4 M1882000 $SCNTBL (XBATCH,NOXBATCH),CATXBACH,CATJBOPT R4 M1882500 $SCNTBL (NOUSO,IEFUSO),CATNOUSO,CATSMFLG R41 M1883000 $SCNTBL (NOTYPE6,TYPE6),CATNOTY6,CATSMFLG R4 M1883500 $SCNTBL (NOUJP,IEFUJP),CATNOUJP,CATSMFLG R4 M1884000 $SCNTBL (NOTYPE26,TYPE26),CATNOT26,CATSMFLG R4 M1884500 $SCNTBL (RESTART,NORESTRT),CATRSTRT,CATJOBFL R4 M1885000 $SCNTBL END OF SCAN TABLE R4 M1885500 SPACE 5 R4 M1886000 NPLSCAST $SCNTBL SCADSECT SCAT SCAN TABLE R4 M1886500 $SCNTBL (PUNCH,PRINT),SCATPNCH,SCATFLAG R4 M1887000 $SCNTBL (HOLD,NOHOLD),SCATHOLD,SCATFLAG R4 M1887500 $SCNTBL (DUMMY,SYSOUT),SCATDUMM,SCATFLAG R4 M1888000 $SCNTBL (TRKCEL,NOTRKCEL),SCATTCEL,SCATFLAG R4 M1888500 $SCNTBL END OF SCAN TABLE R4 M1889000 EJECT R4 M1889500 NPLRDRST $SCNTBL DCTDSECT LOCAL CARD READER SCAN TABLE R4 M1890000 $SCNTBL UNIT,3,DCTBUFAD,NSCFLZER R4 M1890500 $SCNTBL PRDEST,L'DCTPRRTE,DCTPRRTE,NSCFLBIN R4 M1891000 $SCNTBL PUDEST,L'DCTPURTE,DCTPURTE,NSCFLBIN R4 M1891500 $SCNTBL MSGCLASS,1,DCTMCLAS,NSCFLFIT R4 M1894500 $SCNTBL (PRLCL,PRRMT),DCTPRLCL,DCTFLAGS R4 M1895000 $SCNTBL (PULCL,PURMT),DCTPULCL,DCTFLAGS R4 M1895500 $SCNTBL (DRAIN,AUTO),DCTDRAIN,DCTSTAT R4 M1896000 SPACE 1 R4 M1896500 NPLINRST $SCNTBL PRIOINC,L'DCTPRINC,DCTPRINC,NSCFLBIN R4 M1897000 $SCNTBL PRIOLIM,L'DCTPRLIM,DCTPRLIM,NSCFLBIN R4 M1897500 $SCNTBL CLASS,1,DCTJCLAS,NSCFLFIT R4 M1898000 $SCNTBL AUTH,L'DCTRAUTH,DCTRAUTH,NSCFLBIN R4 M1898500 $SCNTBL (HOLD,NOHOLD),DCTHOLDJ,DCTFLAGS R4 M1899000 $SCNTBL END OF SCAN TABLE R4 M1899500 SPACE 5 R4 M1900000 NPLPPST $SCNTBL DCTDSECT LOCAL PRINT/PUNCH SCAN TABLE R4 M1900500 $SCNTBL UNIT,3,DCTBUFAD,NSCFLZER R4 M1901000 $SCNTBL ROUTECDE,L'DCTROUTE,DCTROUTE,NSCFLBIN R4 M1901500 $SCNTBL CLASS,36,DCTCLASS,NSCFLEFT+NSCFLBLK R4 M1902000 $SCNTBL FORMS,L'DCTFORMS,DCTFORMS,NSCFLEFT+NSCFLBLK R4 M1902500 $SCNTBL FCB,L'DCTFCB,DCTFCB,NSCFLEFT+NSCFLBLK R4 M1903000 $SCNTBL UCS,L'DCTUCS,DCTUCS,NSCFLEFT+NSCFLBLK R4 M1903500 $SCNTBL CKPTPGS,L'DCTCKPTP,DCTCKPTP,NSCFLBIN @OZ19494 M1903600 $SCNTBL CKPTLNS,L'DCTCKPTL,DCTCKPTL,NSCFLBIN @OZ19494 M1903700 $SCNTBL LIMIT,L'DCTLIMLO,DCTLIMLO,DCTLIMHI,NPLLIMIT @OZ40627 M1903800 $SCNTBL (BURST,NOBURST),DCTNIBRS,DCTPPSW2 R4 M1904000 $SCNTBL (MARK,NOMARK),DCTNIMRK,DCTPPSW2 R4 M1904500 $SCNTBL (OPERATOR,AUTO),DCTPPSWF,DCTPPSW R4 M1905000 $SCNTBL (NOSEP,SEP),DCTPPSWS,DCTPPSW R4 M1905500 $SCNTBL (SEPEXIST,SEPDEFLT),DCTSEPNL,DCTPPSW2 R41 M1905700 $SCNTBL (PAUSE,NOPAUSE),DCTPAUSE,DCTPPFL R4 M1906000 $SCNTBL (DRAIN,START),DCTDRAIN,DCTSTAT R4 M1906500 $SCNTBL (DSPLTCEL,DSPLSNGL),DCTTCEL,DCTPPFL R4 M1907000 $SCNTBL END OF SCAN TABLE R4 M1907500 EJECT R4 M1908000 NPLLINST $SCNTBL DCTDSECT RJE LINE SCAN TABLE R4 M1908500 $SCNTBL UNIT,3,DCTBUFAD,NSCFLZER R4 M1909000 $SCNTBL PASSWORD,L'MDCTPSWD,MDCTPSWD,NSCFLEFT+NSCFLBLK R4 M1909500 $SCNTBL (IFACEB,IFACEA),B'00100000',MDCTMODE R4 M1911500 $SCNTBL (FDUPLEX,HDUPLEX),DCTPFULL,MDCTLINE R4 M1912000 $SCNTBL (HISPEED,LOWSPEED),DCTPWIDE,MDCTLINE R4 M1912500 $SCNTBL (CODEB,CODEA),B'00001000',MDCTMODE R4 M1913000 $SCNTBL (USASCII,EBCDIC),DCTPASCI,MDCTLINE R4 M1913500 $SCNTBL (TRANSP,NOTRANSP),DCTPTRSP,MDCTLINE R4 M1914000 $SCNTBL (NOADISC,ADISCON),DCTPNADS,MDCTLINE R4 M1914500 $SCNTBL END OF SCAN TABLE R4 M1915000 SPACE 5 R4 M1916000 NPLOGNST $SCNTBL DCTDSECT LOGONNN SCAN TABLE R4 M1916500 $SCNTBL APPLID,L'MDCTAPPL,MDCTAPPL,NSCFLEFT+NSCFLBLK R4 M1917000 $SCNTBL PASSWORD,L'MDCTPSWD,MDCTPSWD,NSCFLEFT+NSCFLBLK R4 M1917500 $SCNTBL R4 M1918000 EJECT R4 M1919000 NPLRMTST $SCNTBL RATDSECT REMOTE TERMINAL SCAN TABLE R4 M1919500 $SCNTBL 2770,DCTP2770,RATTYPE R4 M1920000 $SCNTBL 2780,DCTP2780,RATTYPE R4 M1920500 $SCNTBL 3740,DCTP3740,RATTYPE R4 M1921000 $SCNTBL 3780,DCTP3780,RATTYPE R4 M1921500 $SCNTBL 3781,DCTP2770,RATTYPE R4 M1922000 $SCNTBL 2922,DCTP20S2,RATTYPE R4 M1922500 $SCNTBL M20-2,DCTP20S2,RATTYPE R4 M1923000 $SCNTBL M20-4,DCTP20S2,RATTYPE R4 M1923500 $SCNTBL M20-5,DCTP20S5,RATTYPE R4 M1924000 $SCNTBL M20-6,DCTP20S6,RATTYPE R4 M1924500 $SCNTBL S/360,DCTP360,RATTYPE R4 M1925000 $SCNTBL S360,DCTP360,RATTYPE R4 M1925500 $SCNTBL S/370,DCTP360,RATTYPE R4 M1926000 $SCNTBL S370,DCTP360,RATTYPE R4 M1926500 $SCNTBL 1130,DCTP1130,RATTYPE R4 M1927000 $SCNTBL SYSTEM/3,DCTPSYS3,RATTYPE R4 M1927500 $SCNTBL SYSTEM3,DCTPSYS3,RATTYPE R4 M1928000 $SCNTBL LUTYPE1,DCTPLU1,RATTYPE R4 M1929000 $SCNTBL DISCINTV,2,RATRDCT,NSCFLBIN R4 M1930000 $SCNTBL WAITIME,2,RATWTIME,NSCFLBIN R4 M1930500 $SCNTBL BUFSIZE,2,RATBUFSZ,NSCFLBIN R4 M1931000 $SCNTBL LINE,1,RATLDCT,NSCFLBIN R4 M1931500 $SCNTBL ROUTECDE,L'RATRTE,RATRTE,NSCFLBIN R4 M1932000 $SCNTBL CONDEST,L'RATCONRT,RATCONRT,NSCFLBIN R4 M1932500 $SCNTBL PASSWORD,L'RATPSWD,RATPSWD,NSCFLEFT+NSCFLBLK R4 M1933000 $SCNTBL LUNAME,L'RATSYMB,RATSYMB,NSCFLEFT+NSCFLBLK R4 M1934000 $SCNTBL NUMRD,L'RATNUMRD,RATNUMRD,NSCFLBIN R4 M1935000 $SCNTBL NUMPR,L'RATNUMPR,RATNUMPR,NSCFLBIN R4 M1935500 $SCNTBL NUMPU,L'RATNUMPU,RATNUMPU,NSCFLBIN R4 M1936000 $SCNTBL (CONSOLE,NOCON),RATCONFC+RATCONFO,RATCONF R4 M1936500 $SCNTBL (SETUPINF,SETUPACT),RATCONFI,RATCONF JN M1936800 $SCNTBL (MULTI,HARDWARE),DCTPROG,RATFMT R4 M1937000 $SCNTBL (TRANSP,NOTRANSP),DCTPTRSP,RATFEAT R4 M1937500 $SCNTBL (BUFEX,NOBUFEX),DCTPBEXP,RATFEAT R4 M1938000 $SCNTBL (ABUFEX,NOABUFEX),DCTPABEX,RATFEAT R4 M1938500 $SCNTBL (MRF,NOMRF),DCTPMRF,RATFEAT R4 M1939000 $SCNTBL (COMP,NOCOMP),DCTPPRES,RATFEAT R4 M1939500 $SCNTBL (CMPCT,NOCMPCT),DCTPCPCT,RATFEAT R41 M1939600 $SCNTBL (SETUPHDR,SETUPMSG),DCTPSHDR,RATFEAT R41 M1939700 $SCNTBL (TABS,NOTABS),DCTPTAB,RATFEAT R4 M1940000 $SCNTBL (VARIABLE,FIXED),DCTPVAR,RATFMT R4 M1940500 $SCNTBL (BLOCKED,UNBLOCK),DCTPBLK,RATFMT R4 M1941000 $SCNTBL END OF SCAN TABLE R4 M1941500 EJECT R4 M1942000 NPLRNRST $SCNTBL RWTDSECT REMOTE CARD READER SCAN TABLE R4 M1942500 $SCNTBL PRDEST,L'RWTPRINT,RWTPRINT,NSCFLBIN R4 M1943000 $SCNTBL PUDEST,L'RWTPUNCH,RWTPUNCH,NSCFLBIN R4 M1943500 $SCNTBL PRIOINC,L'RWTPRINC,RWTPRINC,NSCFLBIN R4 M1946500 $SCNTBL PRIOLIM,L'RWTPRLIM,RWTPRLIM,NSCFLBIN R4 M1947000 $SCNTBL CLASS,1,RWTJCLAS,NSCFLFIT R4 M1947500 $SCNTBL MSGCLASS,1,RWTMCLAS,NSCFLFIT R4 M1948000 $SCNTBL (PRLCL,PRRMT),DCTPRLCL,RWTFLAGS R4 M1948500 $SCNTBL (PULCL,PURMT),DCTPULCL,RWTFLAGS R4 M1949000 $SCNTBL (DRAIN,START),DCTDRAIN,RWTSTAT R4 M1949500 $SCNTBL (HOLD,NOHOLD),DCTHOLDJ,RWTFLAGS R4 M1950000 $SCNTBL END OF SCAN TABLE R4 M1950500 SPACE 5 R4 M1951000 NPLRPRST $SCNTBL RWTDSECT REMOTE PRINT/PUNCH SCAN TABLE R4 M1951500 $SCNTBL PRWIDTH,L'RWTLRECL,RWTLRECL,NSCFLBIN @OZ29180 M1952000 SPACE 1 R4 M1952500 NPLRPUST $SCNTBL ROUTECDE,L'RWTROUTE,RWTROUTE,NSCFLBIN R4 M1953000 $SCNTBL LRECL,L'RWTLRECL,RWTLRECL,NSCFLBIN @OZ29180 M1953100 $SCNTBL (COMP,NOCOMP),DCTPPRES,RWTFEAT @OZ29180 M1953200 $SCNTBL (CMPCT,NOCMPCT),DCTPCPCT,RWTSFEAT @OZ29180 M1953300 $SCNTBL SELECT,,,,NPLSELCT @OZ29180 M1953400 $SCNTBL (CCTL,NOCCTL),DCTPCCTL,RWTSFEAT @OZ29180 M1953500 $SCNTBL CLASS,L'RWTCLASS,RWTCLASS,NSCFLEFT+NSCFLBLK @OZ29180 M1953600 $SCNTBL COMPACT,1,RWTDCPTN,NSCFLBIN @OZ29180 M1953700 $SCNTBL FORMS,L'RWTFORMS,RWTFORMS,NSCFLEFT+NSCFLBLK R4 M1954000 $SCNTBL FCB,L'RWTFCB,RWTFCB,NSCFLEFT+NSCFLBLK R4 M1954500 $SCNTBL UCS,L'RWTUCS,RWTUCS,NSCFLEFT+NSCFLBLK R4 M1955000 $SCNTBL CKPTPGS,L'RWTCKPTP,RWTCKPTP,NSCFLBIN @OZ19494 M1956000 $SCNTBL CKPTLNS,L'RWTCKPTL,RWTCKPTL,NSCFLBIN @OZ19494 M1956100 $SCNTBL LIMIT,L'RWTLIMLO,RWTLIMLO,RWTLIMHI,NPLLIMIT @OZ40627 M1956500 $SCNTBL (FCBLOAD,NOFCBLOD),DCTRMFCB,RWTPPFL R4 M1957000 $SCNTBL (OPERATOR,AUTO),DCTPPSWF,RWTPPSW R4 M1957500 $SCNTBL (NOSEP,SEP),DCTPPSWS,RWTPPSW R4 M1958000 $SCNTBL (DRAIN,START),DCTDRAIN,RWTSTAT R4 M1958500 $SCNTBL (SUSPEND,NOSUSPND),DCTSUSPD,RWTPPFL R4 M1959000 $SCNTBL END OF SCAN TABLE R4 M1959500 EJECT R4 M1960000 NPLSYSST $SCNTBL 0 SYSTEM SCAN TABLE R4 M1960500 $SCNTBL SID,L'NS1,0,NSCFLFIT R4 M1961000 $SCNTBL END OF SCAN TABLE R4 M1961500 SPACE 5 R4 M1976000 NPLDESST $SCNTBL NDQDSECT DEST'N QUEUE ELEMENT SCAN TABLE R4 M1976500 $SCNTBL NAME,L'NDQNAME,NDQNAME,NSCFLBLK+NSCFLEFT R4 M1977000 $SCNTBL DEST,L'NDQDEST,NDQDEST,NSCFLBLK+NSCFLEFT R4 M1977500 $SCNTBL END OF SCAN TABLE R4 M1978000 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT DIAGNOSTICS' M1978500 SPACE 5 R4 M1979500 NVERERM DC CL38'***** VERIFICATION ERROR *****' R4 M1980000 NREPERM DC CL38'***** DATA OR FORMAT ERROR *****' R4 M1980500 NPLSHERM DC CL38'***** VALUE NOT DISPLAYABLE *****' R41 M1980600 NPLSNERM DC CL38'***** INVALID SYSTEM NUMBER *****' R4 M1981000 NPLINERM DC CL38'***** INVALID INITIATOR NUMBER *****' R4 M1981500 NPLDNERM DC CL38'***** INVALID DEVICE NAME *****' R4 M1982000 NPLDVERM DC CL38'***** INVALID PARAMETER VALUE *****' R4 M1982500 NPLCHERM DC CL38'***** INVALID CHARACTER VALUE *****' R4 M1983000 NPLDCERM DC CL38'***** ILLEGAL DECIMAL VALUE *****' R4 M1983500 NPLHXERM DC CL38'***** ILLEGAL HEX VALUE *****' @OZ29180 M1983600 NPLSSERM DC CL38'***** INVALID HASPPARM STATEMENT *****' R4 M1984000 NPLSCERM DC CL38'***** CONTINUATION CARD EXPECTED *****' R4 M1984500 NRANGERM DC CL38'***** LIMITS ARE NNN, NNNNNNNNNN *****' R4 M1985000 NPLRTERM DC CL38'***** INVALID REMOTE NUMBER *****' R4 M1985500 NPLDXERM DC CL38'***** ILLEGAL SUBSCRIPT *****' R4 M1986000 SPACE 1 R4 M1988000 NPLSKERM DC CL24'***** INVALID KEYWORD - ' R4 M1988500 NPLSKERK DC CL8'KEYWORD',CL6' *****' R4 M1989000 SPACE 1 R4 M1989500 NPLSVERM DC CL16'***** ILLEGAL ' R4 M1990000 NPLSVERK DC CL8'KEYWORD',CL14' VALUE *****' R4 M1990500 SPACE 1 R41 M1990600 NPLHSERM DC CL8'*****' R41 M1990700 NPLHSNAM DC CL8'HASPSSSM',CL22' NOT LOADABLE *****' R41 M1990800 NPLNOSUP DC CL38' **** NO LONGER SUPPORTED **** ' @OZ39639 M1990900 TITLE 'HASP INITIALIZATION -- PARAMETER STATEMENT PROCESSING RCM1991000 OUTINE TRANSLATE TABLES' R41 M1991500 NPLTRT1 EQU *-X'4A' R4 M1992000 DC 7AL1(0),9AL1(1),4AL1(0),AL1(1),3AL1(0) @OZ28199 M1992500 DC 10AL1(1),4AL1(0),10AL1(1),AL1(0,0,0,1,0,0) @OZ28199 M1993000 SPACE 5 R4 M1993500 NPLTRT2 DC 75AL1(1),AL1(0),15AL1(1),AL1(0),31AL1(1),2AL1(0) R4 M1994000 DC 68AL1(1),9AL1(0),7AL1(1),9AL1(0),8AL1(1) R4 M1994500 DC 8AL1(0),6AL1(1),10AL1(0),6AL1(1) R4 M1995000 TITLE 'HASP INITIALIZATION -- INITIALIZATION PARAMETER STATEMECM1995500 NT TABLE' R41 M1996000 NPLPTBL DS 0F PARAMETER STATEMENT TABLE R41 M1996500 AIF ('&PRINT' NE 'OFF').PTGO R41 M1996600 PUSH PRINT R41 M1996700 PRINT NOGEN R41 M1996800 .PTGO SPACE 1 R41 M1997000 $PTENT ,&&ADDSYNS,,SWITCH,,$RJEOPTS &ADDSYNS STATEMENT M1997500 $PTENT ,&&BSPACE,NPLBACK,EBCDIC &BSPACE STATEMENT M1998000 $PTENT ,&&BSPGCT,,,,,(1,255) &BSPGCT STATEMENT M1998500 $PTENT ,&&BSPNTE,,,,,(0,256/6) &BSPNTE STATEMENT M1999000 $PTENT ,&&BSVBOPT,,SWITCH,,$RJEOPTS &BSVBOPT STATEMENT M1999500 $PTENT ,&&BUFSIZE,NPLX8,,,, &BUFSIZE STATEMENTCM2000000 ((1024+7-(BUFSTART-BUFDSECT))/8*8,(4096+7-(BUFSTART-BUFDCM2000100 SECT))/8*8) R41 M2000200 $PTENT ,&&CCOMCHR,NPLCOMCH,EBCDIC &CCOMCHR STATEMENT M2000500 $PTENT ,&&CHKPT2,NPLCKSPL,EBCDIC,,,(0,L'$CHKPT2) @OZ27300 M2000800 $PTENT ,&&CHKPT,NPLCKSPL,EBCDIC,,,(0,L'$CHKPT) @OZ27300 M2001000 $PTENT ,&&CKPTIME,,,,,(10,5*60) &CKPTIME STATEMENT M2001500 $PTENT ,&&DEBUG,,SWITCH,,$RUNOPTS &DEBUG STATEMENT M2002000 $PTENT ,&&DELAYTM,NPLDELAY,,,,(1,9999), &DELAYTM STATEMENTCM2002500 DISPLAY=NPLDDLAY R41 M2002600 $PTENT ,&&DMNDSET,,SWITCH,,$PRTOPTS &DMNDSET STATEMENT M2003000 $PTENT ,&&DPXRATE,,,,,(1,9999) &DPXRATE @OZ27300 M2003200 $PTENT ,&&DSNPRFX,NPLJCL,EBCDIC,,, &DSNPRFX STATEMENTCM2003300 (1,L'$DSNPRFX) R41 M2003400 * THIS CARD DELETED BY APAR @OZ35278 M2003500 $PTENT ,&&ESTIME,,,,,(1,1440) &ESTIME STATEMENT M2004000 $PTENT ,&&ESTLNCT,,,,,(1,9999) &ESTLNCT STATEMENT M2004500 $PTENT ,&&ESTPUN,,,,,(0,9999999) &ESTPUN STATEMENT M2005000 $PTENT ,&&HTDIST,,,,,(2,144) &HTDIST STATEMENT M2005500 $PTENT ,&&JCOPYLM,,,,,(1,255) &JCOPYLM STATEMENT M2006000 $PTENT ,&&LINECT,,,,,(0,255) &LINECT STATEMENT M2008000 $PTENT ,&&LIRCT,,,,,(1,99) &LIRCT @OZ27300 M2008200 $PTENT ,&&MAXCLAS,,,,,(1,36) &MAXCLAS STATEMENT M2008500 $PTENT ,&&MAXCMCT,,,,,(1,255) &MAXCMCT STATEMENT M2009000 $PTENT ,&&MAXDORM,NPLINVRT,,,,(100,6000) &MAXDORM STATEMENT M2011000 $PTENT ,&&MAXJOBS,,,,,(10,$MAXJQES) &MAXJOBS STATEMENT M2011500 $PTENT ,&&MAXPART,,,,,(1,36*37) &MAXPART STATEMENT M2013500 NMAXPART EQU *-PTELENG+PTEHIVAL-PTEDSECT,4 UPPER LIMIT R41 M2013600 $PTENT ,&&MAXSESS,,,,,(1,9999) &MAXSESS @OZ57038 M2016000 $PTENT ,&&MINDORM,NPLINVRT,,,,(0,3000) &MINDORM STATEMENT M2017000 $PTENT ,&&MINHOLD,NPLINVRT,,,,(0,99999999) &MINHOLD STATEMENT M2017500 $PTENT ,&&MINJOES,,,,,(2,$MAXJOES-2) &MINJOES STATEMENT M2018000 $PTENT ,&&MLBFSIZ,NPLX2,,,, &MLBFSIZ STATEMENTCM2018500 (128,(4096+7-(TPBUFST-BUFDSECT))/8*8) R41 M2018600 $PTENT ,&&MSGID,,SWITCH,,$RUNOPTS &MSGID STATEMENT M2019000 $PTENT ,&&NIPFCB,,EBCDIC,,,(0,L'$NIPFCB) &NIPFCB STATEMENT M2021000 $PTENT ,&&NIPUCS,,EBCDIC,,,(1,L'$NIPUCS) &NIPUCS STATEMENT M2021500 $PTENT ,&&NOPRCCW,,,,,(1,240) @OZ41577 M2024000 $PTENT ,&&NOPUCCW,,,,,(1,240) @OZ41577 M2024500 $PTENT ,&&NUMACE,,,,,(2,9999) &NUMACE STATEMENT M2025000 $PTENT ,&&NUMBUF,,,,,(15,$MAXBUF) &NUMBUF STATEMENT M2025500 $PTENT ,&&NUMCLAS,,,,,(1,36) &NUMCLAS STATEMENT M2026000 $PTENT ,&&NUMCMBS,,,,,(3,999) &NUMCMBS STATEMENT M2026500 $PTENT ,&&NUMDA,,,,,(1,36) &NUMDA STATEMENT M2027000 $PTENT ,&&NUMINRS,,,,,(0,255) &NUMINRS STATEMENT M2027500 $PTENT ,&&NUMJOES,,,,,(10,$MAXJOES) &NUMJOES STATEMENT M2028000 $PTENT ,&&NUMLNES,,,,,(0,$MAXLNES) &NUMLNES STATEMENT M2028500 $PTENT ,&&NUMLOGS,,,,,(0,$MAXLOGS) &NUMLOGS STATEMENT M2029500 $PTENT ,&&NUMPRTS,,,,,(0,$MAXPRTS) &NUMPRTS STATEMENT M2035000 $PTENT ,&&NUMPUNS,,,,,(0,$MAXPUNS) &NUMPUNS STATEMENT M2035500 $PTENT ,&&NUMRDRS,,,,,(0,$MAXRDRS) &NUMRDRS STATEMENT M2036000 $PTENT ,&&NUMRJE,,,,,(0,$MAXRJE) &NUMRJE STATEMENT M2036500 $PTENT ,&&NUMSMFB,,,,,(0,255) &NUMSMFB STATEMENT M2037000 $PTENT ,&&NUMTGBE,,,,,(1,255) &NUMTGBE STATEMENT M2037500 $PTENT ,&&NUMTGV,,,,,(100,9999) &NUMTGV STATEMENT M2038000 $PTENT ,&&NUMTPBF,,,,,(0,$MAXTPBF) &NUMTPBF STATEMENT M2038500 $PTENT ,&&OUTPOPT,,,,,(0,2) &OUTPOPT STATEMENT M2039000 $PTENT ,&&OUTXS,,,,,(500,9999999) &OUTXS STATEMENT M2039500 $PTENT ,&&PRIDCT,,,,,(0,255) &PRIDCT STATEMENT M2041500 $PTENT ,&&PRIHIGH,NPLPRI,,,,(0,15), &PRIHIGH STATEMENTCM2042000 DISPLAY=NPLDPRI R41 M2042100 $PTENT ,&&PRILOW,NPLPRI,,,,(0,15), &PRILOW STATEMENTCM2042500 DISPLAY=NPLDPRI R41 M2042600 $PTENT ,&&PRIOOPT,,SWITCH,,$RUNOPTS &PRIOOPT STATEMENT M2043000 $PTENT ,&&PRIRATE,,,,,(0,1440) &PRIRATE STATEMENT M2043500 $PTENT ,&&PRTBOPT,,SWITCH,,$PRTOPTS &PRTBOPT STATEMENT M2044000 $PTENT ,&&PRTFCB,,EBCDIC,,,(1,L'$PRTFCB) &PRTFCB STATEMENT M2044500 $PTENT ,&&PRTRANS,,SWITCH,,$PRTOPTS &PRTRANS STATEMENT M2045000 $PTENT ,&&PRTUCS,,EBCDIC,,,(1,L'$PRTUCS) &PRTUCS STATEMENT M2045500 $PTENT ,&&PRTYOPT,,SWITCH,,$RUNOPTS &PRTYOPT STATEMENT M2046000 $PTENT ,&&PUNBOPT,,SWITCH,,$PRTOPTS &PUNBOPT STATEMENT M2046500 $PTENT ,&&RCOMCHR,NPLCOMCH,EBCDIC &RCOMCHR STATEMENT M2047000 $PTENT ,&&RDROPSL,NPLROPSL,EBCDIC, &RDROPSL STATEMENTCM2047500 L'CATCONVP,0,DISPLAY=NPLDOPSL R41 M2047600 $PTENT ,&&RDROPST,NPLROPST,EBCDIC, &RDROPST STATEMENTCM2048000 L'CATCONVP,0,DISPLAY=NPLDOPST R41 M2048100 $PTENT ,&&RDROPSU,NPLROPSU,EBCDIC, &RDROPSU STATEMENTCM2048500 L'CATCONVP,0,DISPLAY=NPLDOPSU R41 M2048600 $PTENT ,&&RECINCR,,,,,(1,8) &RECINCR STATEMENT M2049000 $PTENT ,&&RETRYCT,,,,,(1,99) &RETRYCT @OZ27300 M2049200 $PTENT ,&&RJOBOPT,,,,,(0,5) &RJOBOPT STATEMENT M2049500 $PTENT ,&&RPRBOPT,,SWITCH,,$PRTOPTS &RPRBOPT STATEMENT M2050000 $PTENT ,&&RPRI,NPLRPRI,,1,0,(0,15), &RPRI(N) STATEMENTCM2050500 DISPLAY=NPLDRPRI R41 M2050600 $PTENT ,&&RPRT,NPLRPRT,,3,0, &RPRT(N) STATEMENTCM2051000 (1,X'FFFFFF'/60),DISPLAY=NPLDRPRT R41 M2051100 $PTENT ,&&RPS,,SWITCH,,$RUNOPTS &RPS STATEMENT M2051500 $PTENT ,&&RPUBOPT,,SWITCH,,$PRTOPTS &RPUBOPT STATEMENT M2052000 $PTENT ,&&SID,NPLSID,EBCDIC &SID STATEMENT M2052500 $PTENT ,&&SPOLMSG,,,,,(0,254) &SPOLMSG STATEMENT M2053000 $PTENT ,&&SPOOL,NPLCKSPL,EBCDIC,,, &SPOOL STATEMENTCM2053500 (L'$SPOOL-1,L'$SPOOL) R41 M2053600 $PTENT ,&&STDFORM,,EBCDIC &STDFORM STATEMENT M2055500 $PTENT ,&&SYNCTOL,,,,,(0,5*60) &SYNCTOL STATEMENT M2056000 $PTENT ,&&TCELSIZ,,,,,(1,120) @OZ41577 M2056500 $PTENT ,&&TGWARN,,,,,(0,101) &TGWARN STATEMENT M2057000 $PTENT ,&&TIMEOPT,,SWITCH,,$RUNOPTS &TIMEOPT STATEMENT M2057500 $PTENT ,&&TIMEXS,,,,,(1,30) &TIMEXS STATEMENT M2058000 $PTENT ,&&TPBFSIZ,NPLX8,,,, &TPBFSIZ STATEMENTCM2058500 (128,(4096+7-(TPBUFST-BUFDSECT))/8*8) R41 M2058600 $PTENT ,&&TPIDCT,,,,,(0,255) &TPIDCT STATEMENT M2059000 $PTENT ,&&WAITIME,,,,,(1,30) &WAITIME STATEMENT M2061000 $PTENT ,&&WARNTIM,NPLINVRT,,,,(500,15000) &WARNTIM STATEMENT M2061500 $PTENT ,&&XBATCHN,NPLJCL,EBCDIC &XBATCHN STATEMENT M2062000 $PTENT ,&&XBATCH,,SWITCH,,$RUNOPTS &XBATCH STATEMENT M2062500 $PTENT ,&&XLIN,NPLXLIN,,3,0, &XLIN(N) STATEMENTCM2063000 (1,X'FFFFFF'),DISPLAY=NPLDXLIN R41 M2063100 $PTENT ,&&XPRI,NPLXPRI,,1,0,(0,15), &XPRI(N) STATEMENTCM2063500 DISPLAY=NPLDXPRI R41 M2063600 EJECT R4 M2064000 SPACE 5 R4 M2064500 $PTENT 8,CONSOLE,NPLCON CONSOLE STATEMENT M2066600 $PTENT 8,DISPLAY,NPLSHOW DISPLAY STATEMENT M2066700 $PTENT 8,HASPSSSM,NPLHSSSM,EBCDIC,8,0, HASPSSSM STATEMENTCM2067000 (1,8),DISPLAY=NPLDSSSM R41 M2067100 $PTENT 8,REPLACE,NPLREP REPLACE STATEMENT M2067500 $PTENT 8,STCMCLAS,NPLSTCMC STCMCLAS STATEMENT M2068000 $PTENT 8,TSUMCLAS,NPLTSUMC TSUMCLAS STATEMENT M2068500 $PTENT 7,COMPACT,NPLCMPCT COMPACT STATEMENT M2068600 $PTENT 7,DESTID,NPLDEST DESTID STATEMENT M2069000 $PTENT 7,ENDZAP,NPLENDZP ENDZAP STATEMENT M2069500 $PTENT 7,INTRDR,NPLINR INTRDR STATEMENT M2070000 $PTENT 7,NOLIST,NPLNLIST NOLIST STATEMENT M2070500 $PTENT 7,PRINTER,NPLPRINT PRINTERN STATEMENT M2071000 $PTENT 7,VERIFY,NPLVER VERIFY STATEMENT M2071500 $PTENT 6,NOLOG,NPLNLOG NOLOG STATEMENT M2071600 $PTENT 6,READER,NPLRDR READERNN STATEMENT M2072000 $PTENT 5,LOGON,NPLOGON LOGONNN STATEMENT M2073000 $PTENT 5,&&STC,NPLSTC,(SUBPARMS,NOSHOW) &STC STATEMENT M2074000 $PTENT 5,&&TSU,NPLTSU,(SUBPARMS,NOSHOW) &TSU STATEMENT M2074500 $PTENT 5,BASE,NPLBASE BASE STATEMENT M2075000 $PTENT 5,LIST,NPLLISTC LIST STATEMENT M2075500 $PTENT 5,NAME,NPLNAME NAME STATEMENT M2076000 $PTENT 5,NEWS,NPLIGNOR *** IGNORED *** NEWS @OZ39639 M2076200 $PTENT 5,PUNCH,NPLPUNCH PUNCHNN STATEMENT M2076500 $PTENT 4,LINE,NPLLINE LINENNN STATEMENT M2077000 $PTENT 4,LOG,NPLLOGC LOG STATEMENT M2077100 $PTENT 4,REP,NPLREP REPLACE STATEMENT M2077500 $PTENT 4,VER,NPLVER VERIFY STATEMENT M2078000 $PTENT 3,RMT,NPLRMTNN RMTNNN STATEMENT M2078500 $PTENT 2,$$,NPL$$X $$X STATEMENT M2079000 $PTENT 2,B,NPLBASE BASE STATEMENT M2079500 $PTENT 2,D,NPLSHOW DISPLAY STATEMENT M2079600 $PTENT 2,R,NPLREP REPLACE STATEMENT M2080000 $PTENT 2,V,NPLVER VERIFY STATEMENT M2080500 $PTENT 1,&&,NPLCATX,(SUBPARMS,NOSHOW) &X STATEMENT M2081000 $PTENT 1,$,NPLCOMND COMMAND STATEMENT M2081500 $PTENT 1,I,NPLINNN INNN STATEMENT M2082500 $PTENT 1,R,NPLRNDVM RNNN.DVM STATEMENT M2084500 $PTENT 1,S,NPLSN SN STATEMENT M2085000 SPACE 1 R4 M2085500 NPLPTEND DS 0F END OF PARAMETER TABLE R41 M2086000 NPLPTENT EQU (NPLPTEND-NPLPTBL)/PTELENG NUMBER OF TABLE ENTRIES R41 M2086100 AIF ('&PRINT' NE 'OFF').PTEND R41 M2086200 POP PRINT R41 M2086300 .PTEND TITLE 'HASP INITIALIZATION -- CATCONVP INITIALIZATION' R41 M2086500 *********************************************************************** M2087000 * * M2087500 * SUPPLY CATCONVP DEFAULTS, WHERE NECESSARY * M2088000 * * M2088500 *********************************************************************** M2089000 SPACE 1 R4 M2089500 NCATNIP BALR BASE2,0 RE-ESTABLISH R4 M2090000 USING *,BASE2 LOCAL ADDRESSABILITY R4 M2090500 SPACE 1 R4 M2091000 USING CATDSECT,R1 PROVIDE CAT ADDRESSABILITY R4 M2091500 SPACE 1 R4 M2092000 L R1,$CATABLE POINT TO 1ST CAT ENTRY R4 M2092500 LA R0,16 INITIALIZE R4 M2093000 BAL WE,NCATPRM1 CAT ENTRIES C0 - CF R4 M2093500 LA WA,NRDROPST INITIALIZE R4 M2094000 LA R0,1 STARTED TASK R4 M2094500 BAL WE,NCATPRM2 CAT ENTRY R4 M2095000 LA R0,15 INITIALIZE R4 M2095500 BAL WE,NCATPRM1 CAT ENTRIES D1 - DF R4 M2096000 LA WA,NRDROPSL INITIALIZE R4 M2096500 LA R0,1 LOGON R4 M2097000 BAL WE,NCATPRM2 CAT ENTRY R4 M2097500 LA R0,31 INITIALIZE R4 M2098000 BAL WE,NCATPRM1 CAT ENTRIES E1 - FF R4 M2098500 B NCKBSP THEN BR TO CONTINUE R4 M2099000 SPACE 1 R4 M2099500 NCATPRM1 LA WA,NRDROPSU BATCH JOB DEFAULTS R4 M2100000 SPACE 1 R4 M2100500 NCATPRM2 CLI CATCONVP,0 TEST CATCONVP R4 M2101000 BNE SKIP330 BR IF ALREADY PROVIDED R4 M2101500 MVC CATCONVP,0(WA) ELSE SUPPLY DEFAULT R4 M2102000 SKIP330 LA R1,CATEND POINT TO NEXT CAT ENTRY R4 M2102500 BCT R0,NCATPRM2 LOOP THRU REQUESTED ENTRIES R4 M2103000 SPACE 1 R4 M2103500 BR WE THEN RETURN R4 M2104000 SPACE 1 R4 M2104500 DROP R1 KILL CAT ADDRESSABILITY R4 M2105000 TITLE 'HASP INITIALIZATION -- SMF/RJE INITIALIZATION' R4 M2105500 *********************************************************************** M2106000 * * M2106500 * ENSURE VALID BACKSPACE CHARACTER * M2107000 * * M2107500 *********************************************************************** M2108000 SPACE 1 R4 M2108500 NCKBSP CLC $BSPACE,$CCOMCHR TEST BACKSPACE CHARACTER R4 M2109000 BNE NBSPOK BR IF VALID R4 M2109500 MVI $BSPACE,0 ELSE SET TO X'00' R4 M2110000 $$WTO NBSPMSG AND INFORM OPERATOR OF CHANGE R4 M2110500 SPACE 1 R4 M2111000 NBSPOK DS 0H R4 M2111500 SPACE 1 R4 M2112000 *********************************************************************** M2120000 * * M2120500 * DETERMINE SMF REQUIREMENT * M2121000 * * M2121500 *********************************************************************** M2122000 SPACE 1 R4 M2122500 NSMFTEST CLI $NUMSMFB,2 IF SMF TO BE SUPPORTED, R4 M2123000 BNL NINRTEST BR TO TEST INTERNAL READER REQ'T R4 M2123500 MVI $NUMSMFB,0 ELSE ZERO BUFFER COUNT R4 M2124000 MVC $GETSMFB(4),=X'1B1107FE' AND NO-OP SMF BUFFER R4 M2124500 MVC $QUESMFB(2),=X'07FE' GET/QUEUE ROUTINES R4 M2125000 SPACE 1 R4 M2125500 *********************************************************************** M2126000 * * M2126500 * ENSURE VALID INTERNAL READER SPECIFICATION * M2127000 * * M2127500 *********************************************************************** M2128000 SPACE 1 R4 M2128500 USING $SVDSECT,WG PROVIDE SSVT ADDRESSABILITY R4 M2129000 SPACE 1 R4 M2129500 NINRTEST L WG,$SSVT POINT TO SSVT R4 M2130000 ICM R1,15,$SVIRDRS TEST FOR EXISTING INR DCTS R4 M2130500 BZ NCMCTEST BR IF NO R4 M2131000 S R1,=F'8' BACK UP TO DCT STORAGE PREFIX R4 M2131500 CLC 0(4,R1),=CL4'IDCT' TEST PREFIX R4 M2132000 BE NINRSET BR IF VALID R4 M2132500 XC $SVIRDRS,$SVIRDRS ELSE RESET INR DCT POINTER R4 M2133000 B NCMCTEST AND BR TO CONTINUE R4 M2133500 SPACE 1 R4 M2134000 NINRSET TM $SVHASP,X'80' TEST FOR JES2 RESTART R4 M2134500 BZ NCMCTEST BR IF NO R4 M2135000 LH R1,$SVNINRS GET EXISTING INTRDR COUNT @OZ35996 M2135500 BCTR R1,0 LESS TWO FOR STC R4 M2136000 BCTR R1,0 AND TSU R4 M2136500 STC R1,$NUMINRS RESET JOB INTERNAL READER REQ'T R4 M2137000 SPACE 1 R4 M2137500 DROP WG KILL SSVT ADDRESSABILITY R4 M2138000 EJECT R4 M2138500 *********************************************************************** M2139000 * * M2139500 * SET MAXIMUM CONSOLE MESSAGE COUNT * M2140000 * * M2140500 *********************************************************************** M2141000 SPACE 1 R4 M2141500 NCMCTEST CLI $MAXCMCT,0 TEST COUNT R4 M2142000 BNE NRJETEST BR IF ALREADY PROVIDED R4 M2142500 LH R0,$NUMCMBS ELSE SET R4 M2143000 LA R1,255 EQUAL TO R4 M2143500 CLR R0,R1 LESSER R4 M2144000 BNH SKIP340 OF R4 M2144500 LR R0,R1 $NUMCMBS R4 M2145000 SKIP340 STC R0,$MAXCMCT OR 255 R4 M2145500 SPACE 1 R4 M2146000 *********************************************************************** M2146500 * * M2147000 * DETERMINE RJE ENVIRONMENT * M2147500 * * M2148000 *********************************************************************** M2148500 SPACE 1 R4 M2149000 NRJETEST LH R0,$NUMLNES GET NUMBER OF TP LINES R4 M2149500 OC $NUMRJE,$NUMRJE TEST TERMINAL REQUIREMENT R4 M2150000 BNZ SKIP350 BR IF REMOTES DEFINED R4 M2150500 STH R0,$NUMRJE ELSE SUPPLY DEFAULT R4 M2151000 SKIP350 OC $NUMTPBF,$NUMTPBF TEST TP BUFFER REQUIREMENT R4 M2151500 BNZ *+8 BR IF BUFFER COUNT PROVIDED R4 M2152000 STH R0,$NUMTPBF ELSE SUPPLY DEFAULT R4 M2152500 SKIP360 LTR R0,R0 TEST TP LINE REQUIREMENT R4 M2153300 BNZ NLOGLNES BR IF LINES DEFINED R4 M2154000 STH R0,$NUMRJE ELSE RESET TERMINAL COUNT, R4 M2156000 MVI $SPOLMSG,0 MESSAGE SPOOL BUFFER COUNT, R4 M2156500 STH R0,$NUMTPBF AND TP BUFFER COUNT R4 M2157000 ST R0,NLOGLINE ALSO CLEAR LOGICAL LINE COUNT R4 M2158000 ST R0,$MLLMPCE NEED NO LINE MANAGER PROCESSOR R4 M2159000 ST R0,$MCONPCE NEED NO REMOTE CONSOLE PROCESSOR R4 M2162000 B NSPOLMSG BR TO CONTINUE R4 M2162500 EJECT R41 M2163000 SPACE 1 R4 M2163500 NLOGLNES LA R1,$LNEDCT-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M2164000 SLR WA,WA CLEAR LOGICAL LINE COUNT R4 M2164500 SPACE 1 R4 M2165000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY R4 M2165500 SPACE 1 R4 M2166000 NXTLINE L R1,DCTCHAIN POINT TO NEXT LINE DCT R4 M2166500 TM MDCTTYPE,DCTPSNA TEST FOR LOGICAL LINE R4 M2167000 BZ SKIP370 BR IF NO R4 M2167500 LA WA,1(,WA) ELSE BUMP LOGICAL LINE COUNT R4 M2168000 SKIP370 BCT R0,NXTLINE BR IF ANOTHER LINE DCT R4 M2168500 SPACE 1 R4 M2169000 ST WA,NLOGLINE STORE COUNT OF LOGICAL LINES R4 M2169500 SPACE 1 R4 M2170000 DROP R1 KILL DCT ADDRESSABILITY R4 M2170500 EJECT R4 M2171500 *********************************************************************** M2172000 * * M2172500 * FINALIZE RAT -- OBTAIN RJE DEVICE COUNTS * M2173000 * * M2173500 * ENSURE TP BUFFER SIZE ADEQUATE FOR ALL SPECIFIED REMOTES * M2174000 * * M2174500 *********************************************************************** M2175000 SPACE 1 R4 M2175500 USING RATDSECT,WD PROVIDE RAT ADDRESSABILITY R4 M2176000 SPACE 1 R4 M2176500 INITRJE SLR R1,R1 CLEAR FOR INSERTS R4 M2177000 LR WA,R1 CLEAR R4 M2177500 LR WB,R1 WORK R4 M2178000 LR WC,R1 REGISTERS R4 M2178500 * THIS LINE DELETED BY APAR @OZ50955 M2179000 LH R0,$NUMRJE GET NUMBER OF REMOTES R4 M2179500 L WD,$RAT POINT TO 1ST RAT ELEMENT R4 M2180000 SPACE 1 R4 M2180800 NRJEDEVS LH WF,RATBUFSZ BUFSIZE FROM 'RMTNNN' PARM @OZ50955 M2181000 LH WE,RATRDCT GET DISCONNECT INTERVAL @OZ50955 M2181300 LA WE,31(,WE) ROUND UP R4 M2181500 SRL WE,5 DIVIDE BY 32 R4 M2182000 STC WE,RATDINTV SET DISCONNECT INTERVAL R4 M2182500 STC WE,RATIDINV SAVE INITIAL MAX DISC INTERVAL R41 M2182600 MVI RATSYS,1 SET SYSTEM ID R4 M2183500 CLI RATTYPE,DCTP2770 TEST TERMINAL TYPE R4 M2186000 BNE NOT2770 BR IF NOT 2770 R4 M2186500 TM RATFEAT,DCTPBEXP TEST FOR BUFFER EXPANSION R4 M2187000 BZ SKIP380 BR IF NO R4 M2187500 CH WF,*+10 ELSE ENSURE R4 M2188000 BNL SKIP380 MINIMUM R4 M2188500 LA WF,264 TP BUFFER SIZE R4 M2189000 SKIP380 TM RATFEAT,DCTPABEX TEST FOR ADD'L BUFFER EXPANSION R4 M2189500 BZ NOT2770 BR IF NO R4 M2190000 CH WF,*+10 ELSE ENSURE R4 M2190500 BNL NOT2770 MINIMUM R4 M2191000 LA WF,520 TP BUFFER SIZE R41 M2191500 SPACE 1 R4 M2192000 NOT2770 CLI RATTYPE,DCTP2780 TEST TERMINAL TYPE R4 M2192500 BNE SKIP390 BR IF NOT 2780 R4 M2193000 CH WF,*+10 ELSE ENSURE R4 M2193500 BNL SKIP390 MINIMUM R4 M2194000 LA WF,400 TP BUFFER SIZE R4 M2194500 SKIP390 CLI RATTYPE,DCTP3780 TEST TERMINAL TYPE R4 M2195000 BNE NRJETYPE BR IF NOT 3780 R4 M2195500 CH WF,*+10 ELSE ENSURE R4 M2196000 BNL SKIP400 MINIMUM R4 M2196500 LA WF,520 TP BUFFER SIZE R4 M2197000 SKIP400 OI RATFEAT,DCTPABEX FORCE ADDITIONAL BUFFERS R4 M2197500 CLI RATNUMPU,0 TEST PUNCH COUNT R4 M2198000 BE NRJEHDW BR IF ZERO R4 M2198500 MVI RATTYPE,DCTP2770 ELSE RE-DEFINE AS 2770 R4 M2199000 EJECT R4 M2199500 NRJETYPE TM RATTYPE,DCTPLU1 IF NOT SNA REMOTE R41 M2200000 BNO NRJEBSC GO TEST FOR BSC CPU TYPE R41 M2200100 CH WF,*+10 BUFSIZE SPECIFIED MUST @OZ50955 M2200110 BNL SKIP405 BE AT LEAST @OZ50955 M2200120 LA WF,256 256 FOR SNA REMOTE @OZ50955 M2200130 B SKIP404 NO NEED TO CONVERT @OZ50955 M2200140 SPACE 1 @OZ50955 M2200150 * CONVERT R.U. LENGTHS TO BIND FLOATING-POINT FORM @OZ50955 M2200160 SPACE 1 @OZ50955 M2200170 SKIP405 LR WE,WF COPY LENGTH TO WORK REG @OZ50955 M2200180 SLL WF,4 SHIFT INTO HI-ORDER @OZ50955 M2200190 SRA WE,4 TEST VALUE @OZ50955 M2200200 BZ SKIP404 DONE IF LESS THAN 16 @OZ50955 M2200210 SLR R10,R10 REG FOR CHARACTERISTIC @OZ50955 M2200220 SKIP403 LA R10,1(,R10) INCREASE BY 1 @OZ50955 M2200230 SRA WE,1 SHIFT OUT RIGHT-HAND BIT @OZ50955 M2200240 BNZ SKIP403 SHIFT ALL BITS OUT @OZ50955 M2200250 SRL WF,4(R10) FORM 4-BIT MANTISSA @OZ50955 M2200260 SLL WF,0(R10) SHIFT INTO HI-ORDER @OZ50955 M2200270 SPACE 1 @OZ50955 M2200290 SKIP404 TM RATCONF,RATCONFC IF NO CONSOLE @OZ50955 M2200295 BNO NRJECT GO COUNT DEVICES R41 M2200300 IC R1,RATNUMPR INCREMENT R41 M2200400 LA R1,1(,R1) NUMBER OF PRINTERS BY 1 R41 M2200500 STC R1,RATNUMPR TO ALLOW FOR CONSOLE DCT R41 M2200600 B NRJECT GO COUNT DEVICES R41 M2200700 SPACE 1 R41 M2200800 NRJEBSC TM RATTYPE,DCTPCPU TEST TERMINAL TYPE R41 M2200900 BZ NRJEHDW BR IF NOT CPU TERMINAL R4 M2201000 LTR WF,WF WAS BUFSIZE SPECIFIED @OZ50955 M2201040 BNZ SKIP409 IF NOT, SET DEFAULT @OZ50955 M2201060 LH WF,$MLBFSIZ FOR BSC REMOTE @OZ50955 M2201080 SKIP409 TM RATFMT,DCTPROG TEST FORMAT TYPE @OZ50955 M2201100 BZ NRJEHDW BR IF NOT PROGRAMMABLE R4 M2201500 NI RATFMT,DCTPROG ELSE RESET HARDWARE FORMATS R4 M2202000 NI RATFEAT,DCTPTRSP AND FEATURES R4 M2202500 CLI RATNUMRD,0 ENSURE R4 M2203000 BNE SKIP410 READER COUNT R4 M2203500 MVI RATNUMRD,1 AT LEAST 1 R4 M2204000 SKIP410 CLI RATNUMPR,0 ENSURE R4 M2204500 BNE NRJECT PRINTER COUNT R4 M2205000 MVI RATNUMPR,1 AT LEAST 1 R4 M2205500 B NRJECT THEN BR TO TALLY DEVICES R4 M2206000 SPACE 1 R4 M2206500 NRJEHDW LTR WF,WF WAS BUFSIZE SPECIFIED @OZ50955 M2207000 BNZ SKIP415 ON 'RMTNNN' STATEMENT @OZ50955 M2207150 LA WF,127 NO,SET MAX FOR BSC HDW @OZ50955 M2207300 SKIP415 MVI RATNUMRD,1 FORCE NUMBER OF READERS @OZ50955 M2207400 MVI RATNUMPR,1 AND PRINTERS TO 1 R4 M2207500 CLI RATNUMPU,0 ENSURE R4 M2208000 BE NRJECT NO MORE THAN R4 M2208500 MVI RATNUMPU,1 1 PUNCH R4 M2209000 SPACE 1 R4 M2209500 NRJECT IC R1,RATNUMRD COUNT NUMBER R4 M2210000 ALR WA,R1 OF READERS R4 M2210500 IC R1,RATNUMPR COUNT NUMBER R4 M2211000 ALR WB,R1 OF PRINTERS R4 M2211500 IC R1,RATNUMPU COUNT NUMBER R4 M2212000 ALR WC,R1 OF PUNCHES R4 M2212500 SPACE 1 @OZ50955 M2212550 STH WF,RATBUFSZ SET BUFFER SIZE IN RAT @OZ50955 M2213000 CH WF,$TPBFSIZ MUST BE LARGEST SPECIFIED @OZ50955 M2213100 BNH NRJSET ON 'RMTNNN' PARAMETER @OZ50955 M2213200 STH WF,$TPBFSIZ FOR ANY REMOTE @OZ50955 M2213300 * THIS LINE DELETED BY APAR @OZ50955 M2213350 SPACE 1 @OZ50955 M2213400 NRJSET LA WD,RATEND POINT TO NEXT RAT @OZ50955 M2213450 BCT R0,NRJEDEVS LOOP THRU ALL RATS R4 M2213500 SPACE 1 R4 M2214000 *********************************************************************** M2214500 * * M2215000 * SET REMOTE READER, PRINTER AND PUNCH COUNTS * M2215500 * * M2216000 *********************************************************************** M2216500 SPACE 1 R4 M2217000 STH WA,$NUMTPRD SET REMOTE READER COUNT R4 M2217500 STH WB,$NUMTPPR SET REMOTE PRINTER COUNT R4 M2218000 STH WC,$NUMTPPU SET REMOTE PUNCH COUNT R4 M2218500 * THIS LINE DELETED BY APAR @OZ50955 M2219000 EJECT R4 M2219500 *********************************************************************** M2220000 * * M2220500 * SET MESSAGE SPOOL BUFFER COUNT * M2221000 * * M2221500 *********************************************************************** M2222000 SPACE 1 R4 M2222500 NSPOLMSG LH R6,$BUFSIZE GET JES2 BUFFER SIZE R4 M2223000 CLI $SPOLMSG,2 IF MSG SPOOL BUFFER R41 M2223100 BNL SKIP420 COUNT LESS THAN 2, R41 M2223200 MVI $SPOLMSG,0 RESET IT TO 0 R41 M2223300 SKIP420 CLI $SPOLMSG,255 TEST MSG SPOOL BUFFER COUNT R4 M2223500 BNE NSPOLMOK BR IF NUMBER PROVIDED R4 M2224000 LA R1,2048 ELSE SET R4 M2224500 ALR R1,R1 DEFAULT R4 M2225000 SLR R0,R0 EQUAL TO R4 M2225500 DR R0,R6 4K DIVIDED R4 M2226000 MH R1,=H'6' BY $BUFSIZE R4 M2226500 STC R1,$SPOLMSG TIMES 6 R4 M2227000 SPACE 1 R4 M2227500 NSPOLMOK DS 0H R4 M2228000 TITLE 'HASP INITIALIZATION -- LOCAL/REMOTE DEVICE PCE/DCT GENECM2239000 RATION' R4 M2239500 *********************************************************************** M2240000 * * M2240500 * COMPUTE STORAGE FOR PRIMARY HASP PCES * M2241000 * * M2241500 *********************************************************************** M2242000 SPACE 1 R4 M2242500 NPCEGEN SLR WB,WB INITIALIZE STORAGE REQUIREMENT R4 M2243000 TM $RUNOPTS,$TIMEOPT TEST TIME EXCESSION OPTION R4 M2243500 BO SKIP450 BR IF SELECTED R4 M2244000 ST WB,$XTIMPCE ELSE INDICATE NO PCE R4 M2244500 SKIP450 OC $PRIRATE,$PRIRATE TEST FOR PRIORITY AGING R4 M2245000 BNZ SKIP460 BR IF SELECTED R4 M2245500 ST WB,$PRAGPCE ELSE INDICATE NO PCE R4 M2246000 SKIP460 OC $NUMRJE,$NUMRJE TEST RJE REQUIREMENT R4 M2246500 BZ SKIP470 BR IF NO REMOTES DEFINED R4 M2247000 LA WB,$MWORKSZ ELSE RESET STORAGE REQUIREMENT R4 M2247500 SKIP470 LA R0,NPCES GET PRIMARY PCE COUNT R4 M2248000 LA WD,NPCETBL-6 PREPARE TO SCAN PRIMARY PCE TABLE R4 M2248500 SPACE 1 R4 M2249000 NPCECORE LA WD,6(,WD) POINT TO NEXT TABLE ENTRY R4 M2249500 LH WC,0(,WD) GET OFFSET OF HCT ENTRY R4 M2250000 L WC,0(WC,BASE1) GET PROCESSOR ADDR FROM PCE ENTRY R4 M2250500 LTR WC,WC IF NO PCE REQUIRED, R4 M2251000 BZ SKIP480 BR TO AVOID ADDING STORAGE R4 M2251500 AH WB,4(,WD) ELSE ADD PCE REQUIREMENT R4 M2252000 SKIP480 BCT R0,NPCECORE LOOP THRU ALL PRIMARY PCES R4 M2252500 EJECT R4 M2253000 *********************************************************************** M2253500 * * M2254000 * COMPUTE VARIABLE PCE, DCT, ACE AND SMF BUFFER STORAGE * M2254500 * * M2255000 *********************************************************************** M2255500 SPACE 1 R4 M2256000 LH R1,$BUFSIZE CALCULATE DEFAULT VALUE R4 M2256500 D R0,=A(80) FOR &NOPRCCW AND &NOPUCCW R4 M2257000 CLI $NOPRCCW,0 TEST FOR PROVIDED VALUE R4 M2257500 BNE SKIP490 BR IF DEFAULT PROVIDED R4 M2258000 STC R1,$NOPRCCW ELSE USE CALCULATED VALUE R4 M2258500 SKIP490 CLI $NOPUCCW,0 TEST FOR PROVIDED VALUE R4 M2259000 BNE SKIP500 BR IF DEFAULT PROVIDED R4 M2259500 STC R1,$NOPUCCW ELSE USE CALCULATED VALUE R4 M2260000 SKIP500 SLR WD,WD GET NUMBER R4 M2260500 IC WD,$NUMRDRS OF LOCAL READERS R4 M2261000 M WC,=A(((PCEWORK-PCEDSECT+RDRPCEWS+3)/4*4+DCTRDEND+7-DCTDCM2261500 SECT)/8*8) PCE/DCT REQUIREMENT R4 M2262000 ALR WB,WD ADD TO STORAGE TOTAL R4 M2262500 SLR R10,R10 BACKSPACE R4 M2263000 IC R10,$BSPNTE TABLE R4 M2263500 MH R10,=H'7' SIZE R4 M2264000 STH R10,$BSPSIZ STORE IN HCT R4 M2264500 LA R10,3(,R10) ROUND TO R4 M2265000 N R10,=F'-4' NEXT FULLWORD R4 M2265500 ST R10,NBSPSIZ SAVE FOR LATER USE R4 M2266000 AH R10,=Y(NUMSAVE) ADD STORAGE FOR SAVE AREA @G38ESBB M2266200 SLR WA,WA GET TOTAL R4 M2266500 IC WA,$NUMPRTS NUMBER OF R4 M2267000 SLR WD,WD REQUIRED LOCAL R4 M2267500 IC WD,$NUMPUNS AND REMOTE R4 M2268000 ALR WA,WD PRINTERS R4 M2268500 AH WA,$NUMTPPR AND R4 M2269000 AH WA,$NUMTPPU PUNCHES R4 M2269500 LA R1,(PBSPTBL+3-PCEDSECT)/4*4(,R10) DCT OFFSET R4 M2270000 IC WD,$NUMCLAS COMPUTE LENGTH R4 M2270500 LA WD,DCTCLASS+1+7-DCTDSECT(R1,WD) OF INDIVIDUAL R4 M2271000 N WD,=F'-8' PCE/DCT PAIR R4 M2271500 MR WC,WA MULTIPLY BY TOTAL PRINT/PUNCH CT R4 M2272000 ALR WB,WD ADD TO STORAGE TOTAL R4 M2272500 IC WC,$NUMINRS GET NUMBER OF INTERNAL READERS R4 M2273000 LA WC,2(,WC) ADD 2 FOR TSU AND STC R4 M2273500 MH WC,=AL2(PCEWORK-PCEDSECT+(RDRPCEWS+7)/8*8) PCE REQ'T R4 M2274000 ALR WB,WC ADD TO STORAGE TOTAL R4 M2274500 LH WC,$NUMLNES ADD RJE R4 M2275000 S WC,NLOGLINE (- LOGICAL LINES) R4 M2276000 MH WC,=AL2((MDCTLEND+7-DCTDSECT)/8*8) LINE DCT R4 M2277000 ALR WB,WC STORAGE REQ'T R4 M2277500 L WC,NLOGLINE ADD LOGICAL LINES R4 M2278500 MH WC,=AL2((MDCTVLND+7-DCTDSECT)/8*8) DCT REQUIREMENT R4 M2279000 ALR WB,WC TO TOTAL STORAGE R4 M2279500 LH WA,$NUMTPRD GET REMOTE READER COUNT R4 M2280500 MH WA,=AL2(((PCEWORK-PCEDSECT+RJEPCEWS+3)/4*4+DCTRDEND+7-DCCM2281000 TDSECT)/8*8) PCE/DCT REQUIREMENT R4 M2281500 ALR WB,WA ADD TO STORAGE TOTAL R4 M2282000 LH WC,$NUMLOGS ADD LOGON R4 M2283000 MH WC,=AL2((MDCTLGND+7-DCTDSECT)/8*8) DCT REQUIREMENT R4 M2283500 ALR WB,WC TO TOTAL STORAGE R4 M2284000 LH WA,$NUMACE ADD STORAGE R4 M2296000 MH WA,=AL2(ACEL) FOR AUTOMATIC R4 M2296500 ALR WB,WA COMMAND ELEMENTS R4 M2297000 SLR WC,WC COMPUTE SMF R4 M2297500 IC WC,$NUMSMFB BUFFER STORAGE R4 M2298000 MH WC,=Y(SMFLNG) REQUIREMENT R4 M2298500 LA WB,4095(WB,WC) ROUND UP STORAGE REQUIREMENT R4 M2299000 N WB,=F'-4096' TO NEXT 4K R4 M2299500 B NVARGETM BR TO GET STORAGE R4 M2300000 EJECT R4 M2300500 *********************************************************************** M2301000 * * M2301500 * OBTAIN VARIABLE PCE, DCT, ACE AND SMF BUFFER STORAGE * M2302000 * * M2302500 *********************************************************************** M2303000 SPACE 1 R4 M2303500 NVARGETM LR R0,WB RELOAD STORAGE REQUIREMENT R4 M2304000 GETMAIN RU,LV=(0),BNDRY=PAGE REQUEST PERMANENT STORAGE R4 M2304500 LR WA,R1 CLEAR ACQUIRED R4 M2305000 MVCL WA,R14 STORAGE R4 M2305500 EJECT R4 M2306000 *********************************************************************** M2306500 * * M2307000 * FORMAT HASP PRIMARY PCES * M2307500 * * M2308000 *********************************************************************** M2308500 SPACE 1 R4 M2309000 USING MAPDSECT,WG PROVIDE MOD MAP ADDRESSABILITY R4 M2309500 SPACE 1 R4 M2310000 L WG,$HASPMAP POINT TO HASP MODULE MAP R4 M2310500 OC $NUMRJE,$NUMRJE TEST RJE REQUIREMENT R4 M2311000 BZ SKIP510 BR IF NO REMOTES DEFINED R4 M2311500 ST R1,$MWORK ELSE SET POINTER TO RTAM WORK SP R4 M2312000 LA R1,$MWORKSZ(,R1) AND SKIP OVER WORK SPACE R4 M2312500 SKIP510 LA R0,NPCES PREPARE R4 M2313000 LA WD,NPCETBL-6 TO FORMAT R4 M2313500 LA WA,$PCEORG-(PCENEXT-PCEDSECT) PRIMARY PCES R4 M2314000 SPACE 1 R4 M2314500 USING PCEDSECT,R1 PROVIDE PCE ADDRESSABILITY R4 M2315000 SPACE 1 R4 M2315500 NPCEPRIM LA WD,6(,WD) POINT TO NEXT TABLE ENTRY R4 M2316000 LH WE,0(,WD) GET OFFSET OF HCT ENTRY R4 M2316500 L WB,0(WE,BASE1) LOAD PROCESSOR ADDRESS R4 M2317000 LTR WB,WB TEST PROCESSOR ADDRESS R4 M2317500 BZ NPCENEXT BR IF NONE R4 M2318000 LH WC,2(,WD) ELSE GET PCE ID R4 M2318500 BAL LINK,INITPCE AND INITIALIZE PCE R4 M2319000 ST R1,0(WE,BASE1) SET PCE ADDRESS IN HCT R4 M2319500 AH R1,4(,WD) POINT TO NEXT PCE R4 M2320000 SPACE 1 R4 M2320500 NPCENEXT BCT R0,NPCEPRIM LOOP THRU ALL PRIMARY PCES R4 M2321000 SPACE 1 R4 M2321500 L WE,$PCEORG POINT TO 1ST PCE R4 M2322000 ST R0,PCEPREV-PCEDSECT(,WE) CLEAR ADDR OF PREVIOUS PCE R4 M2322500 ST R0,$DCTPOOL CLEAR TEMP DCT CHAIN ADDRESS R4 M2323000 LA WE,$DCTPOOL-(DCTCHAIN-DCTDSECT) INITIAL CHAIN ADDR R4 M2323500 SPACE 1 R4 M2324000 USING DCTDSECT,WE PROVIDE DCT ADDRESSABILITY R4 M2324500 SPACE 1 R4 M2325000 ICM R0,1,$NUMRDRS GET NUMBER OF READERS R4 M2325500 BZ INITPRTS BR IF NONE R4 M2326000 EJECT R4 M2326500 *********************************************************************** M2327000 * * M2327500 * FORMAT LOCAL READER PCES AND DCTS * M2328000 * * M2328500 *********************************************************************** M2329000 SPACE 1 R4 M2329500 L WB,MAPRDRA PROCESSOR ADDRESS R4 M2330000 LH WC,=AL2(256*PCELCLID+PCERDRID) PCE ID R4 M2330500 LA WD,$RDRDCT-(DCTCHAIN-DCTDSECT) TEMPORARY DCTS R4 M2331000 LA WF,DCTRDEND-1-DCTDSECT DCT MOVE LENGTH R4 M2331500 SPACE 1 R4 M2332000 NRDRLOOP BAL LINK,INITPCE INITIALIZE PCE R4 M2332500 LA R10,PCEWORK+(RDRPCEWS+3)/4*4 SET DCT ADDRESS R4 M2333000 ST R10,PCEDCT IN PCE @OZ32566 M2333500 LR R1,R10 RELOAD DCT ADDRESS R4 M2334000 BAL LINK,INITDCT INITIALIZE DCT R4 M2334500 MVC DCTPRSYS,$OWNSYS SET SYSTEM ID R4 M2340000 CLI DCTPRRTE,0 TEST FOR REMOTE/LOCAL ROUTING R4 M2341000 BE NRDPRRTE BR IF NO R4 M2341500 TM DCTFLAGS,DCTPRLCL TEST FOR SPECIAL LOCAL ROUTING R4 M2342000 BZ NRDPRRTE BR IF NO R4 M2342500 MVI DCTPRSYS,0 ELSE RESET SYSTEM ID R4 M2343500 SPACE 1 R4 M2347500 NRDPRRTE CLC DCTPRSYS,$OWNSYS TEST FOR ROUTE TO REMOTE R4 M2348000 BNE NRDNTOWN BR IF NO R41 M2349000 CLC DCTPRRTE,$NUMRJE+1 TEST FOR VALID REMOTE NUMBER R4 M2349500 BH NBADRTE BR IF NO R4 M2350000 NRDNTOWN DS 0H R41 M2350200 MVC DCTPUSYS,$OWNSYS SET SYSTEM ID R4 M2354500 CLI DCTPURTE,0 TEST FOR REMOTE/LOCAL ROUTING R4 M2355500 BE NRDPURTE BR IF NO R4 M2356000 TM DCTFLAGS,DCTPULCL TEST FOR SPECIAL LOCAL ROUTING R4 M2356500 BZ NRDPURTE BR IF NO R4 M2357000 MVI DCTPUSYS,0 ELSE RESET SYSTEM ID R4 M2358000 SPACE 1 R4 M2362000 NRDPURTE CLC DCTPUSYS,$OWNSYS TEST FOR ROUTE TO REMOTE R4 M2362500 BNE NRDNXT BR IF NO R4 M2363500 CLC DCTPURTE,$NUMRJE+1 TEST FOR VALID REMOTE NUMBER R4 M2364000 BH NBADRTE BR IF NO R4 M2364500 SPACE 1 R4 M2365000 NRDNXT NI DCTFLAGS,255-DCTPRLCL-DCTPULCL CLEAR ANY FLAGS R4 M2365500 BCT R0,NRDRLOOP LOOP THRU ALL READERS R4 M2366000 EJECT R4 M2366500 NRDRXIT B INITPRTS BR IF NO ROUTE CODE ERRORS R4 M2367000 $EXIT NGQUITM ELSE ISSUE 'QUIT' MSG AND QUIT R4 M2367500 SPACE 1 R4 M2368000 NBADRTE STM R0,R15,NBADSAV1 SAVE REGISTERS @OZ38672 M2368500 L R1,=A(NRTEMSG) POINT TO MESSAGE TEXT R4 M2369000 MVC NRTEDEV-NRTEMSG(,R1),DCTDEVN SET DEVICE NAME R4 M2369500 $$WTO (R1) ISSUE ERROR MESSAGE TO OPERATOR R4 M2370000 LM R0,R15,NBADSAV1 RESTORE REGISTERS @OZ38672 M2370500 MVI NRDRXIT+1,0 FORCE QUIT AFTER TESTING ALL RDRS R4 M2371000 B NRDNXT BR TO TEST NEXT READER R4 M2371500 SPACE 1 @OZ38672 M2371600 NBADSAV1 DS 16F LOCAL REGISTER SAVE AREA @OZ38672 M2371700 SPACE 1 R4 M2372000 INITPRTS SLR R15,R15 DCT R4 M2372500 IC R15,$NUMCLAS MOVE R4 M2373000 LA WF,DCTCLASS+1-1-DCTDSECT(,R15) LENGTH R4 M2373500 L WB,MAPPPI1A PROCESSOR ADDRESS R4 M2374000 ICM R0,1,$NUMPRTS GET NUMBER OF PRINTERS R4 M2374500 BZ INITPUNS BR IF NONE R4 M2375000 SPACE 1 R4 M2375500 *********************************************************************** M2376000 * * M2376500 * FORMAT LOCAL PRINTER PCES AND DCTS * M2377000 * * M2377500 *********************************************************************** M2378000 SPACE 1 R4 M2378500 LH WC,=AL2(256*(PCEPRSID+PCELCLID)+PCEPRTID) PCE ID R4 M2379000 LA WD,$PRTDCT-(DCTCHAIN-DCTDSECT) TEMPORARY DCTS R4 M2379500 SPACE 1 R4 M2380000 NPRTLOOP BAL LINK,INITPCE INITIALIZE PCE R4 M2380500 MVI PBUFOPT,2 ASSUME DOUBLE BUFFERING R4 M2381000 TM $PRTOPTS,$PRTBOPT TEST ASSUMPTION R4 M2381500 BO SKIP530 BR IF VALID R4 M2382000 MVI PBUFOPT,1 ELSE PROVIDE SINGLE BUFFERING R4 M2382500 SKIP530 BAL LINK,NPPDCT INITIALIZE PPPWORK AND DCT R4 M2383000 LA LINK,DCTCLASS(R15) POINT TO END OF CLASS LIST R4 M2383500 MVI 0(LINK),C' ' SET DCTCLASS TERMINATOR R4 M2384000 CLI $NUMPRTS,9 TEST PRINTER COUNT R4 M2384500 BH NPRTGT9 BR IF GREATER THAN 9 R41 M2385000 MVC DCTDEVN+7(1),DCTDEVN+6 ELSE ALTER R4 M2385500 MVC DCTDEVN+5(2),=C'ER' DEVICE NAME FORMAT R4 M2386000 NPRTGT9 CLI DCTROUTE,0 TEST FOR LOCAL ROUTING R41 M2386100 BE SKIP540 BR IF NO R41 M2386200 MVI DCTSYS,0 ELSE RESET SYSTEM ID R41 M2386400 SKIP540 BCT R0,NPRTLOOP LOOP THRU ALL PRINTERS R4 M2386800 EJECT R4 M2387000 INITPUNS ICM R0,1,$NUMPUNS GET NUMBER OF PUNCHES R4 M2387500 BZ INRPCES BR IF NONE R4 M2388000 SPACE 1 R4 M2388500 *********************************************************************** M2389000 * * M2389500 * FORMAT LOCAL PUNCH PCES AND DCTS * M2390000 * * M2390500 *********************************************************************** M2391000 SPACE 1 R4 M2391500 LH WC,=AL2(256*(PCEPUSID+PCELCLID)+PCEPUNID) PCE ID R4 M2392000 LA WD,$PUNDCT-(DCTCHAIN-DCTDSECT) TEMPORARY DCTS R4 M2392500 SPACE 1 R4 M2393000 NPUNLOOP BAL LINK,INITPCE INITIALIZE PCE R4 M2393500 MVI PBUFOPT,2 ASSUME DOUBLE BUFFERING R4 M2394000 TM $PRTOPTS,$PUNBOPT TEST ASSUMPTION R4 M2394500 BO SKIP550 BR IF VALID R4 M2395000 MVI PBUFOPT,1 ELSE PROVIDE SINGLE BUFFERING R4 M2395500 SKIP550 BAL LINK,NPPDCT INITIALIZE PPPWORK AND DCT R4 M2396000 LA LINK,DCTCLASS(R15) POINT TO END OF CLASS LIST R4 M2396500 MVI 0(LINK),C' ' SET DCTCLASS TERMINATOR R4 M2397000 CLI DCTROUTE,0 TEST FOR LOCAL ROUTING R41 M2397100 BE *+8 BR IF NO R41 M2397200 MVI DCTSYS,0 ELSE RESET SYSTEM ID R41 M2397400 BCT R0,NPUNLOOP LOOP THRU ALL PUNCHES R4 M2397800 EJECT R4 M2398000 INRPCES IC R0,$NUMINRS GET NUMBER OF INTERNAL READERS R4 M2398500 AH R0,=H'2' ADD 2 FOR TSU AND STC R4 M2399000 SPACE 1 R4 M2399500 *********************************************************************** M2400000 * * M2400500 * FORMAT INTERNAL READER PCES * M2401000 * * M2401500 *********************************************************************** M2402000 SPACE 1 R4 M2402500 L WB,MAPRDRA PROCESSOR ADDRESS R4 M2403000 LH WC,=AL2(256*PCEINRID+PCERDRID) PCE ID R4 M2403500 SPACE 1 R4 M2404000 BAL LINK,INITPCE INITIALIZE PCE R4 M2404500 LA R1,PCEWORK-PCEDSECT+(RDRPCEWS+7)/8*8(,R1) NEXT PCE R4 M2405000 BCT R0,INITPCE LOOP THRU ALL INTERNAL READERS R4 M2405500 SPACE 1 R4 M2406000 DROP WG KILL MOD MAP ADDRESSABILITY R4 M2406500 SPACE 1 R4 M2407000 ICM R0,15,NLOGLINE TEST NUMBER OF LOGICAL LINES R4 M2408000 BNZ SKIP560 NON ZERO, GO GENERATE LOGON DCTS R4 M2408500 STH R0,$NUMLOGS ZERO COUNT OF LOGON DCTS R4 M2409000 SKIP560 ICM R0,3,$NUMLOGS GET NUMBER OF LOGON DCTS R4 M2409500 BZ NITRJE BRANCH IF NONE R4 M2410000 SPACE 1 R4 M2410500 *********************************************************************** M2411000 * * M2411500 * FORMAT VTAM INTERFACE LOGON DCTS * M2412000 * * M2412500 *********************************************************************** M2413000 SPACE 1 R4 M2413500 LA WD,$LOGNDCT-(DCTCHAIN-DCTDSECT) TEMPORARY DCTS R4 M2414000 LA WF,MDCTLGND-1-DCTDSECT DCT MOVE LENGTH R4 M2414500 SPACE 1 R4 M2415000 BAL LINK,INITDCT INITIALIZE DCTS R4 M2415500 BCT R0,INITDCT LOOP THRU ALL LOGON DCTS R4 M2416000 EJECT R4 M2417000 NITRJE ICM R0,3,$NUMLNES GET NUMBER OF RJE LINES R4 M2417500 BZ INITACES BR IF NONE R4 M2418000 SPACE 1 R4 M2418500 *********************************************************************** M2419000 * * M2419500 * FORMAT RJE LINE DCTS AND REMOTE TERMINAL PCES AND DCTS * M2420000 * * M2420500 *********************************************************************** M2421000 SPACE 1 R4 M2421500 LA WD,$LNEDCT-(DCTCHAIN-DCTDSECT) TEMPORARY DCTS R4 M2422000 SPACE 1 R4 M2422500 NLNELOOP LA WF,MDCTLEND-1-DCTDSECT PICK UP LINE DCT SIZE R4 M2423000 L WB,DCTCHAIN-DCTDSECT(,WD) PICK UP TEMPORARY DCT ADDR R4 M2423500 TM MDCTTYPE-DCTDSECT(WB),DCTPSNA TEST FOR LOGICAL LINE R4 M2424500 BZ SKIP570 NO, SKIP - USE PRELOADED DCT SIZE R4 M2425000 LA WF,MDCTVLND-1-DCTDSECT USE LOGICAL LINE DCT SIZE R4 M2425500 SKIP570 BAL LINK,INITDCT INITIALIZE DCT R4 M2426500 BCT R0,NLNELOOP LOOP THRU ALL LINE DCTS R4 M2427000 SPACE 1 R4 M2427500 USING RATDSECT,R15 PROVIDE RAT ADDRESSABILITY R4 M2428000 SPACE 1 R4 M2428500 L R15,$RAT POINT TO 1ST RAT ELEMENT R4 M2429000 LH WG,$NUMRJE GET NUMBER OF REMOTES R4 M2429500 SPACE 1 R4 M2430000 NRMTDEV ICM R0,1,RATNUMRD GET NUMBER OF READERS R4 M2430500 BZ NRMTPRT BR IF NONE R4 M2431000 L WB,$HASPMAP POINT TO HASP MODULE MAP R4 M2431500 L WB,MAPRDRA-MAPDSECT(,WB) PROCESSOR ADDRESS R4 M2432000 LH WC,=AL2(256*PCERJEID+PCERDRID) PCE ID R4 M2432500 LA WF,DCTRDEND-1-DCTDSECT DCT MOVE LENGTH R4 M2433000 SPACE 1 R4 M2433500 NTPRDLUP BAL LINK,INITPCE INITIALIZE PCE R4 M2434000 LA R10,PCEWORK+(RJEPCEWS+3)/4*4 SET DCT ADDRESS R4 M2434500 ST R10,PCEDCT IN PCE @OZ32566 M2435000 LR R1,R10 RELOAD DCT ADDRESS R4 M2435500 BAL LINK,INITPDCT INITIALIZE DCT R4 M2436000 MVI DCTDEVTP,DCTRJR INDICATE REMOTE READER R4 M2436500 BCT R0,NTPRDLUP LOOP THRU ALL READERS R4 M2437000 EJECT R4 M2437500 NRMTPRT L WB,$HASPMAP POINT TO HASP MODULE MAP R4 M2438000 L WB,MAPPPI1A-MAPDSECT(,WB) PROCESSOR ADDRESS R4 M2438500 IC WF,$NUMCLAS DCT MOVE R4 M2439000 LA WF,DCTCLASS+1-1-DCTDSECT(,WF) LENGTH R4 M2439500 ICM R0,1,RATNUMPR GET NUMBER OF PRINTERS R4 M2440000 BZ NRMTPUN BR IF NONE R4 M2440500 LH WC,=AL2(256*(PCEPRSID+PCERJEID)+PCEPRTID) PCE ID R4 M2441000 SPACE 1 R4 M2441500 NTPPRLUP BAL LINK,INITPCE INITIALIZE PCE R4 M2442000 MVI PBUFOPT,2 ASSUME DOUBLE BUFFERING R4 M2442500 TM $PRTOPTS,$RPRBOPT TEST ASSUMPTION R4 M2443000 BO SKIP580 BR IF VALID R4 M2443500 MVI PBUFOPT,1 ELSE PROVIDE SINGLE BUFFERING R4 M2444000 SKIP580 BAL LINK,NTPPPDCT INITIALIZE PPPWORK AND DCT R4 M2444500 MVI DCTDEVTP,DCTRPR INDICATE REMOTE PRINTER R4 M2445000 BCT R0,NTPPRLUP LOOP THRU ALL PRINTERS R4 M2445500 SPACE 1 R4 M2446000 NRMTPUN ICM R0,1,RATNUMPU GET NUMBER OF PUNCHES R4 M2446500 BZ NRMTNEXT BR IF NONE R4 M2447000 LH WC,=AL2(256*(PCEPUSID+PCERJEID)+PCEPUNID) PCE ID R4 M2447500 SPACE 1 R4 M2448000 NTPPULUP BAL LINK,INITPCE INITIALIZE PCE R4 M2448500 MVI PBUFOPT,2 ASSUME DOUBLE BUFFERING R4 M2449000 TM $PRTOPTS,$RPUBOPT TEST ASSUMPTION R4 M2449500 BO SKIP590 BR IF VALID R4 M2450000 MVI PBUFOPT,1 ELSE PROVIDE SINGLE BUFFERING R4 M2450500 SKIP590 BAL LINK,NTPPPDCT INITIALIZE PPPWORK AND DCT R4 M2451000 MVI DCTDEVTP,DCTRPU INDICATE REMOTE PUNCH R4 M2451500 BCT R0,NTPPULUP LOOP THRU ALL PUNCHES R4 M2452000 SPACE 1 R4 M2452500 NRMTNEXT LA R15,RATEND POINT TO NEXT RAT R4 M2453000 BCT WG,NRMTDEV LOOP THRU ALL REMOTE TERMINALS R4 M2453500 SPACE 1 R4 M2454000 DROP WE,R15 KILL DCT, RAT ADDRESSABILITY R4 M2454500 TITLE 'HASP INITIALIZATION -- ACE/SMF BUFFER POOL CREATION' R4 M2523500 *********************************************************************** M2524000 * * M2524500 * CONTRUCT AUTOMATIC COMMAND ELEMENT CHAIN * M2525000 * * M2525500 *********************************************************************** M2526000 SPACE 1 R4 M2526500 INITACES ST WA,$PCELAST SAVE FINAL PCE ADDRESS @OZ36762 M2527000 L WA,$ACTABLE SET POINTER @OZ36762 M2527100 ST R1,ACTACEF-ACTDSECT(,WA) TO 1ST ACE R4 M2527500 LH R0,$NUMACE GET NUMBER OF ACES R4 M2528000 SPACE 1 R4 M2528500 NACELOOP LR WC,R1 RELOAD ACE ADDRESS R4 M2529000 LA R1,ACEL(,R1) POINT TO NEXT ACE R4 M2529500 ST R1,ACEACE-ACEDSECT(,WC) SET CHAIN ADDRESS R4 M2530000 BCT R0,NACELOOP LOOP THRU ALL ACES R4 M2530500 SPACE 1 R4 M2531000 ST R0,ACEACE-ACEDSECT(,WC) RESET LAST CHAIN ADDRESS R4 M2531500 SPACE 2 R4 M2532000 *********************************************************************** M2532500 * * M2533000 * INITIALIZE SMF BUFFER POOL * M2533500 * * M2534000 *********************************************************************** M2534500 SPACE 1 R4 M2535000 ICM R0,1,$NUMSMFB GET NUMBER OF SMF BUFFERS R4 M2535500 BZ NKORFREE BR IF NONE R4 M2536000 ST R1,$SMFFREE ELSE SET POINTER TO 1ST BUFFER R4 M2536500 SPACE 1 R4 M2537000 NSMFLOOP LR WC,R1 RELOAD BUFFER ADDRESS R4 M2537500 LA R1,SMFLNG(,R1) POINT TO NEXT BUFFER R4 M2538000 ST R1,0(,WC) SET CHAIN ADDRESS R4 M2538500 BCT R0,NSMFLOOP LOOP THRU ALL BUFFERS R4 M2539000 SPACE 1 R4 M2539500 ST R0,0(,WC) RESET LAST CHAIN ADDRESS R4 M2540000 SPACE 2 R4 M2540500 *********************************************************************** M2541000 * * M2541500 * FREE TEMPORARY DCT STORAGE * M2542000 * * M2542500 *********************************************************************** M2543000 SPACE 1 R4 M2543500 NKORFREE L R1,NDCTSTOR GET ADDRESS OF TEMPORARY STORAGE R4 M2544000 L R0,0(,R1) GET SIZE OF TEMPORARY STORAGE R4 M2544500 FREEMAIN R,LV=(0),A=(1) FREE TEMPORARY STORAGE R4 M2545000 TITLE 'HASP INITIALIZATION -- DCT POOL HEADER DETERMINATION' R4 M2545500 *********************************************************************** M2546000 * * M2546500 * SETUP HCT POINTER TO DCT CHAINS * M2547000 * * M2547500 *********************************************************************** M2548000 SPACE 1 R4 M2548500 LA WC,DCTRDR LOCATE R4 M2549000 LA R1,$RDRDCT FIRST R4 M2549500 BAL LINK,NDCT1LOC LOCAL READER DCT R4 M2550000 LA WC,DCTPRT LOCATE R4 M2550500 LA R1,$PRTDCT FIRST R4 M2551000 BAL LINK,NDCT1LOC LOCAL PRINTER DCT R4 M2551500 LA WC,DCTPUN LOCATE R4 M2552000 LA R1,$PUNDCT FIRST R4 M2552500 BAL LINK,NDCT1LOC LOCAL PUNCH DCT R4 M2553000 LA WC,DCTLNE LOCATE R4 M2553500 LA R1,$LNEDCT FIRST R4 M2554000 BAL LINK,NDCT1LOC RJE LINE DCT R4 M2554500 LA WC,DCTLOG LOCATE R4 M2555500 LA R1,$LOGNDCT FIRST R4 M2556000 BAL LINK,NDCT1LOC LOGON DCT R4 M2556500 B NDCBGEN THEN BR TO NEXT SECTION R4 M2557500 SPACE 2 R4 M2558000 NDCT1LOC LA WA,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M2558500 SPACE 1 R4 M2559000 SKIP630 ICM WA,7,DCTCHAIN+1-DCTDSECT(WA) LOCATE R4 M2559500 BZ SKIP620 1ST (IF ANY) R4 M2560000 CLM WC,1,DCTDEVTP-DCTDSECT(WA) MATCHING R4 M2560500 BNE SKIP630 DCT R4 M2561000 SPACE 1 R4 M2561500 SKIP620 ST WA,0(,R1) SET POINTER TO 1ST DCT (OR ZERO) R4 M2562000 BR LINK AND RETURN R4 M2562500 TITLE 'HASP INITIALIZATION -- PCE/DCT BUILD SUBROUTINES' R4 M2563000 *********************************************************************** M2563500 * * M2564000 * INITPCE -- PCE INITIALIZATION ROUTINE * M2564500 * * M2565000 * R1 - PCE ADDRESS * M2565500 * WA - ADDR OF PREVIOUS PCE, CURRENT PCE ADDR ON EXIT * M2566000 * WB - PROCESSOR ADDRESS * M2566500 * WC - PCE ID BYTES (LO-ORDER HALF-WORD) * M2567000 * R11 - HCT ADDRESS (BASE1) * M2567500 * R14 - RETURN ADDRESS * M2568000 * * M2568500 *********************************************************************** M2569000 SPACE 1 R4 M2569500 INITPCE ST R1,PCENEXT-PCEDSECT(,WA) SET 'NEXT' ADDR IN PREV PCE R4 M2570000 ST WA,PCEPREV SET POINTER TO PREVIOUS PCE R4 M2570500 ST WB,PCER15 SET ENTRY POINT ADDRESS R4 M2571000 ST BASE1,PCEBASE1 SET HCT ADDRESS R4 M2571500 ST WB,PCEBASE2 SET ENTRY POINT ADDRESS R4 M2572000 ST R1,PCEPCEA INDICATE R4 M2572500 ST R1,PCEPCEB NON-READY PCE R4 M2573000 STH WC,PCEID SET PCE ID FIELD R4 M2573500 ST R1,PCEIOEWF SET DA DCT POST ADDRESS R4 M2574000 MVI PCEDEVTP,PCEDAWR INDICATE WRITE IN DA DCT R4 M2574500 LR WA,R1 THIS PCE TO BE NEXT PREVIOUS PCE R4 M2575000 BR LINK RETURN TO CALLER R4 M2575500 EJECT R4 M2576000 *********************************************************************** M2576500 * * M2577000 * NTPPPDCT -- REMOTE PRINT/PUNCH DCT INITIALIZATION ROUTINE * M2577500 * * M2578000 * NPPDCT -- LOCAL PRINT/PUNCH DCT INITIALIZATION ROUTINE * M2578500 * * M2579000 * R1 - PCE ADDRESS, DCT ADDRESS ON EXIT * M2579500 * WD - ADDRESS OF PREVIOUS ADDRESS ON EXIT * M2580000 * WE - ADDRESS OF PREVIOUS TEMPORARY DCT (NPPDCT) * M2580500 * WF - LENGTH OF NEW DCT (-1) * M2581000 * R14 - RETURN ADDRESS * M2581500 * * M2582000 * NOTE - THESE ROUTINES EXIT TO THE INITDCT (NPPDCT) OR THE * M2582500 * INITPDCT (NTPPPDCT) ROUTINE TO COMPLETE DCT INIT- * M2583000 * IALIZATION * M2583500 * * M2584000 *********************************************************************** M2584500 SPACE 1 R4 M2585000 NTPPPDCT LA R10,(PBSPTBL+3-PCEDSECT)/4*4(,R1) SET POINTER R4 M2585500 AL R10,NBSPSIZ TO PRINT/PUNCH R4 M2586000 MVC PSAVAREA,$ZEROS SET SAVE AREA TO ZERO @G38ESBB M2586100 ST R10,PSAV1ST SET PTR TO FIRST SAVE AREA @G38ESBB M2586200 AH R10,=Y(NUMSAVE) POINT TO PRINT/PUNCH DCT @G38ESBB M2586300 ST R10,PCEDCT DCT @OZ32566 M2586500 LR R1,R10 RELOAD DCT ADDRESS R4 M2587000 B INITPDCT AND BR TO INITIALIZE DCT R4 M2587500 SPACE 1 R4 M2588000 NPPDCT LA R10,(PBSPTBL+3-PCEDSECT)/4*4(,R1) SET POINTER R4 M2588500 AL R10,NBSPSIZ TO PRINT/PUNCH R4 M2589000 MVC PSAVAREA,$ZEROS SET SAVE AREA TO ZERO @G38ESBB M2589100 ST R10,PSAV1ST SET PTR TO FIRST SAVE AREA @G38ESBB M2589200 AH R10,=Y(NUMSAVE) POINT TO PRINT/PUNCH DCT @G38ESBB M2589300 ST R10,PCEDCT DCT @OZ32566 M2589500 L R1,DCTCHAIN-DCTDSECT(,WD) POINT TO TEMPORARY DCT R4 M2590000 SPACE 1 R4 M2590500 DROP R1 KILL PCE ADDRESSABILITY R4 M2591000 USING DCTDSECT,R1 PROVIDE DCT ADDRESSABILITY R4 M2591500 SPACE 1 R4 M2592000 CLI DCTFORMS,0 TEST FOR FORMS ID R4 M2592500 BNE SKIP640 BR IF PRESENT R4 M2593000 MVC DCTFORMS,$STDFORM ELSE SUPPLY DEFAULT R4 M2593500 SKIP640 TM DCTDEVTP,DCTPRT LOCAL PRINTER R4 M2594000 BNO NPPDCT1 NO - SKIP COUNTING R4 M2594500 TM DCTPPFL,DCTTCEL WAS DSPLTCEL ON PRINTERN CARD R4 M2595000 BNO NPPDCT1 NO - SKIP COUNTING R4 M2595500 LH R1,NPRDTCEL PICK UP DESPOOL COUNTER R4 M2596000 LA R1,1(,R1) ADD 1 TO IT R4 M2596500 STH R1,NPRDTCEL SAVE NEW VALUE R4 M2597000 SPACE 1 R4 M2597500 NPPDCT1 LR R1,R10 RELOAD DCT ADDRESS R4 M2598000 EJECT R4 M2598500 *********************************************************************** M2599000 * * M2599500 * INITDCT -- DCT INITIALIZATION ROUTINE * M2600000 * * M2600500 * R1 - DCT ADDRESS, NEXT DOUBLE-WORD AFTER DCT ON EXIT * M2601000 * WD - ADDRESS OF PREVIOUS TEMPORARY DCT * M2601500 * WE - ADDR OF PREVIOUS NEW DCT, CURRENT DCT ADDR ON EXIT * M2602000 * WF - LENGTH FOR DCT MOVE * M2602500 * R14 - RETURN ADDRESS * M2603000 * * M2603500 *********************************************************************** M2604000 SPACE 1 R4 M2604500 INITDCT L WD,DCTCHAIN-DCTDSECT(,WD) POINT TO TEMPORARY DCT R4 M2605000 EX WF,NDCTMV CREATE NEW DCT FROM TEMPORARY R4 M2605500 XC DCTCHAIN+1(3),DCTCHAIN+1 CLEAR CHAIN ADDRESS R41 M2606000 SPACE 1 R4 M2606500 INITPDCT STCM R1,7,DCTCHAIN+1-DCTDSECT(WE) SET CHAIN ADDR IN PREV R4 M2607000 ST WA,DCTEWF SET $POST ADDRESS R4 M2607500 MVC DCTSYS,$OWNSYS SET SYSTEM ID R4 M2608500 LR WE,R1 THIS DCT TO BE NEXT PREVIOUS DCT R4 M2611000 LA R1,8(WF,R1) POINT TO 1ST DOUBLE-WORD R4 M2611500 N R1,=F'-8' BEYOND CURRENT DCT R4 M2612000 BR LINK THEN RETURN TO CALLER R4 M2612500 SPACE 1 R4 M2613000 NDCTMV MVC 0(*-*,R1),0(WD) *** EXECUTE ONLY *** R4 M2613500 SPACE 2 R4 M2614000 NPRDTCEL DC H'0' NBR OF PRINTERS SAYING DSPLTCEL R4 M2614500 SPACE 1 R4 M2615000 DROP R1 KILL DCT ADDRESSABILITY R4 M2615500 TITLE 'HASP INITIALIZATION -- TABLE OF PRIMARY PCES' R4 M2616000 NBSPSIZ DC A(*-*) SIZE OF PRINT/PUNCH BACKSPACE TBL R4 M2616500 SPACE 1 R4 M2617000 NRDROPSL DC C'00014400000030E00000' LOGON JOB DEFAULTS R4 M2617500 NRDROPST DC C'00000100000000E00000' STARTED TASK DEFAULTS R4 M2618000 NRDROPSU DC C'00000300012820E00001' BATCH USER JOB DEFAULTS R4 M2618500 SPACE 2 R4 M2619000 *********************************************************************** M2619500 * * M2620000 * TABLE OF PRIMARY HASP PCES * M2620500 * * M2621000 *********************************************************************** M2621500 SPACE 1 R4 M2622000 NPCETBL DS 0H R4 M2622500 DC AL2($ASYNCP-HCTDSECT,PCEASYID,PCEWORK-PCEDSECT) R4 M2623000 DC AL2($XTIMPCE-HCTDSECT,PCETIMID,PCEWORK+64-PCEDSECT) R4 M2623500 DC AL2($TIMEPCE-HCTDSECT,PCETIMID,PCEWORK-PCEDSECT) R4 M2624000 DC AL2($MLLMPCE-HCTDSECT,PCEMLMID) R4 M2624500 DC AL2((PCEWORK-PCEDSECT+MLMPCEWS+7)/8*8) R4 M2625000 DC AL2($MCONPCE-HCTDSECT,PCECONID) R4 M2625500 DC AL2((PCEWORK-PCEDSECT+RCPPCEWS+7)/8*8) R4 M2626000 DC AL2($JCLPCE-HCTDSECT,PCECNVID) R4 M2626500 DC AL2((PCEWORK-PCEDSECT+JCLPCEWS+7)/8*8) R4 M2627000 DC AL2($EXECPCE-HCTDSECT,PCEXEQID) R4 M2627500 DC AL2((PCEWORK-PCEDSECT+RDRPCEWS+7)/8*8) R4 M2628000 DC AL2($OUTPCE-HCTDSECT,PCEOUTID) R4 M2628500 DC AL2((PCEWORK-PCEDSECT+OUTWKSIZ+7)/8*8) R4 M2629000 DC AL2($HOLDPCE-HCTDSECT,PCEXEQID) R4 M2629500 DC AL2((PCEWORK-PCEDSECT+HQRLENG+7)/8*8) R4 M2630000 DC AL2($PSOPCE-HCTDSECT,PCEPSOID) R4 M2630500 DC AL2((PCEWORK-PCEDSECT+2*JOESIZE+7)/8*8) R4 M2631000 DC AL2($PRGPCE-HCTDSECT,PCEPRGID,PCEWORK-PCEDSECT) R4 M2631500 DC AL2($CKPTPCE-HCTDSECT,PCECKPID) R41 M2632000 DC AL2((PCEWORK-PCEDSECT+CKPPCEWS+7)/8*8) R41 M2632100 DC AL2($PRAGPCE-HCTDSECT,PCEGPRID,PCEWORK+16-PCEDSECT) R4 M2632500 DC AL2($COMMPCE-HCTDSECT,PCECONID) R4 M2635000 DC AL2((PCEWORK-PCEDSECT+COMPCEWS+7)/8*8) R4 M2635500 DC AL2($WARMPCE-HCTDSECT,PCEWRMID) R4 M2636000 DC AL2((PCEWORK-PCEDSECT+WRMPCEWS+7)/8*8) R4 M2636500 SPACE 1 R4 M2637000 NPCES EQU (*-NPCETBL)/6 NUMBER OF TABLE ENTRIES R4 M2637500 EJECT R4 M2638000 LTORG R4 M2638500 TITLE 'HASP INITIALIZATION -- DCB/DEB GENERATION' R4 M2639000 *********************************************************************** M2639500 * * M2640000 * OBTAIN DCB/DEB STORAGE FOR LINES, RDRS, PRTS, AND PUNS * M2640500 * * M2641000 *********************************************************************** M2641500 SPACE 1 R4 M2642000 NDCBGEN BALR BASE2,0 RE-ESTABLISH R4 M2642500 USING *,BASE2 LOCAL ADDRESSABILITY R4 M2643000 SPACE 1 R4 M2643500 LH R3,$NUMLNES COMPUTE R4 M2644000 LR R1,R3 MAIN R4 M2644500 IC R3,$NUMRDRS STORAGE R4 M2645000 ALR R1,R3 REQUIREMENT R4 M2645500 IC R3,$NUMPRTS FOR R4 M2646000 ALR R1,R3 NON-DA R4 M2646500 IC R3,$NUMPUNS DCBS R4 M2647000 ALR R1,R3 AND R4 M2647500 SL R1,NLOGLINE DEBS R4 M2648500 MH R1,=Y((4+9)*4) (4 WORD DCBS, 9 WORD DEBS) R4 M2650500 IC R3,$NUMDA ADD SIZE OF R4 M2651000 SLL R3,4 DIRECT ACCESS R4 M2651500 LA R0,4*(4*(2)+3+8)(R1,R3) DCB AND DEB @OZ27300 M2652000 LR R3,R0 SAVE STORAGE AMOUNT R4 M2652500 ICM R0,8,=AL1(229) REQUEST STORAGE R4 M2653000 GETMAIN R,LV=(0) FOR DCBS AND DEBS R4 M2653500 LR R2,R1 CLEAR R4 M2654000 SLR R15,R15 DCB/DEB R4 M2654500 MVCL R2,R14 STORAGE R4 M2655000 EJECT R4 M2655500 *********************************************************************** M2656000 * * M2656500 * INITIALIZE $SID, SET DCBS/DEBS FOR LOCAL U/R AND BSC LINES * M2657000 * * M2657500 *********************************************************************** M2658000 SPACE 1 R4 M2658500 USING IHADCB,R1 PROVIDE DCB ADDRESSABILITY R4 M2659000 USING DEBDSECT,R15 PROVIDE DEB ADDRESSABILITY R4 M2659500 USING DCTDSECT,WA PROVIDE DCT ADDRESSABILITY R4 M2660000 USING CVTDSECT,WB PROVIDE CVT ADDRESSABILITY R4 M2660500 SPACE 1 R4 M2661000 SH R1,=H'36' R1 = 1ST DCB ADDRESS R4 M2661500 LA R15,36+4*4(,R1) R15 = 1ST DEB ADDRESS R4 M2662000 L WB,CVTPTR WC = ADDRESS R4 M2662500 L WC,CVTSMCA OF SMCA R4 M2663000 CLI $SID,C' ' TEST FOR SUPPLIED SYSTEM ID R4 M2663500 BNE SKIP650 BR IF YES R4 M2664000 MVC $SID,SMCASID-SMCA(WC) ELSE USE SMF SYSTEM ID R4 M2664500 SKIP650 L WD,$HASPTCB GET ADDRESS OF HASP TCB R4 M2665000 SLR R0,R0 R0 = NUMBER R4 M2665500 IC R0,$NUMRDRS OF READERS R4 M2666000 L WA,$DCTPOOL WA = 1ST RDR DCT ADDRESS R4 M2666500 BAL R14,NDCBDEB BUILD READER DCBS AND DEBS R4 M2667000 IC R0,$NUMPRTS R0 = NUMBER OF PRINTERS R4 M2667500 BAL R14,NDCBDEB BUILD PRINTER DCBS AND DEBS R4 M2668000 IC R0,$NUMPUNS R0 = NUMBER OF PUNCHES R4 M2668500 BAL R14,NDCBDEB BUILD PUNCH DCBS AND DEBS R4 M2669000 LH R0,$NUMLNES R0 = NUMBER OF RJE LINES R4 M2669500 L WA,$LNEDCT WA = 1ST LINE DCT ADDRESS R4 M2670000 BAL R14,NDCBDEB BUILD LINE DCBS AND DEBS R4 M2670500 SH R1,=H'4' ADJUST DCB ADDRESS FOR DA R4 M2671000 SH R15,=H'4' ADJUST DEB ADDRESS FOR DA R4 M2671500 MVC DCBTIOT((3+8)*4),NDCDEDUM+4 DA DCB/DEB CONSTANTS R4 M2672000 ST R15,DCBDEBAD SET DEB ADDRESS IN DCB R4 M2672500 STCM WD,7,DEBTCBB SET TCB ADDRESS IN DEB R4 M2673000 STCM R1,7,DEBDCBB SET DCB ADDRESS IN DEB R4 M2673500 SLR WA,WA SET R4 M2674000 IC WA,$NUMDA NUMBER R4 M2674500 LA WA,2(,WA) OF @OZ27300 M2675000 STC WA,DEBNMEXT EXTENTS R4 M2675500 MVI DEBEXSCL,X'04' INDICATE DA DEB R4 M2676000 ST R1,$HASPDCB SET DCB ADDRESS IN HCT R4 M2676500 L R1,$HASPMAP POINT TO HASP MODULE MAP @OZ27300 M2676600 MVC DEBAPPB,MAPIOAPG+1-MAPDSECT(R1) USE JES2 APNDGS @OZ27300 M2677000 ST R15,$DADEBAD SET DEB ADDRESS IN HCT R4 M2677500 B NVALSYS THEN BR TO NEXT SECTION R4 M2678000 SPACE 1 R4 M2678500 DROP WB KILL CVT ADDRESSABILITY R4 M2679000 EJECT R4 M2679500 NDCBDEB LTR R0,R0 AT LEAST ONE DEVICE R4 M2680000 BZR R14 RETURN IF NO R4 M2680500 SPACE 1 R4 M2681000 NDCDE1 DS 0H R4 M2681500 CLI DCTDEVTP,DCTLNE TEST R4 M2682500 BNE SKIP660 FOR R4 M2683000 TM MDCTTYPE,DCTPSNA UNIT=VTAM LINE R4 M2683500 BO NDCTNEXT BR IF YES TO SKIP DCB/DEB BUILD R4 M2684000 SKIP660 MVC DCBEXLST((4+8)*4),NDCDEDUM U/R DCB AND DEB CONSTANTS R4 M2685000 STCM R1,7,DCTDCB+1 DCB ADDR INTO DCT R4 M2685500 ST R15,DCBDEBAD DEB ADDR INTO DCB R4 M2686000 STCM WD,7,DEBTCBB TCB ADDR INTO DEB R4 M2686500 STCM R1,7,DEBDCBB DCB ADDR INTO DEB R4 M2687000 L WE,$HASPMAP POINT TO HASP MODULE MAP R4 M2687500 MVC DEBAPPB,MAPIOAPG+1-MAPDSECT(WE) USE HASP I/O APPG'S R4 M2688000 CLI DCTDEVTP,DCTLNE TEST DEVICE TYPE R4 M2688500 BNE NDCDE2 BR IF NOT A LINE R4 M2689000 MVI DCBIFLGS,DCBIFIOE SET NO OS RECOVERY FLAGS R4 M2689500 SPACE 1 R4 M2690000 NDCDE2 LA R1,(4+9)*4(,R1) R1 = NEXT DCB ADDRESS R4 M2690500 LA R15,(4+9)*4(,R15) R15 = NEXT DEB ADDRESS R4 M2691000 SPACE 1 R4 M2691500 NDCTNEXT L WA,DCTCHAIN WA = NEXT DCT ADDRESS R4 M2692000 BCT R0,NDCDE1 LOOP IF MORE OF SAME DEVICE R4 M2692500 SPACE 1 R4 M2693000 BR R14 THEN RETURN R4 M2693500 SPACE 1 R4 M2694000 DROP R1,WA,R15 KILL DCB, DCT, DEB ADDRESSABILITY R4 M2694500 SPACE 2 R4 M2695000 NDCDEDUM DS 0F DCB/DEB SKELETONS R4 M2695500 DC A(0) DCBEXLST R4 M2696000 DC AL2(0),AL1(DCBMRECP+DCBMRAPG) DCBTIOT, DCBMACRF R4 M2696500 DC AL1(0),A(0),AL1(DCBOFOPN),AL3(0) DCBOFLGS R4 M2697000 DC A(0),AL1(4),AL3(0) DEBTCBAD, DEBAMLNG R4 M2697500 DC AL1(DEBDSMOD+DEBDCB),AL3(0) DEBOFLGS R4 M2698000 DC AL1(DEBINOUT),AL3(0) DEBINOUT R4 M2698500 DC AL1(1),AL3(0),A(0) DEBNMEXT R4 M2699000 DC AL1(1*16+15),AL3(0) DEBPROTG/DEBDEBID R4 M2699500 DC AL1(2),AL3(0) DEBEXSCL R4 M2700000 TITLE 'HASP INITIALIZATION -- SYSTEM PARAMETER VALIDATION' R4 M2700500 *********************************************************************** M2701000 * * M2701500 * VALIDATE SYSTEM PARAMETER TABLE * M2702000 * * M2702500 *********************************************************************** M2703000 SPACE 1 R4 M2703500 * R4 M2704000 *** DETERMINE IS THIS AN UNSHARED ENVIRONMENT R4 M2704500 * R4 M2705000 NVALSYS CLC NS1(L'NS1*7),=CL28' ' IS TABLE EMPTY... R4 M2705500 BNE NVAL050 BR IF NO R4 M2706000 MVC NS1,$SID SET SMF CPU ID FOR THIS SYSTEM M2706500 LA R3,1 INDICATE 1 MEMBER IN NODE R4 M2707000 B NVAL300 BR TO SET QSE INFO R4 M2707500 * M2708000 *** DETERMINE IF TABLE IS CONTIGUOUS M2708500 * M2709000 NVAL050 CLI NS1,C' ' SEE IF 1ST TABLE ENTRY IS BLANK R4 M2709500 BE NVALERR BR. IF YES TO DOCUMENT ERROR M2710000 LA R0,NS1A-1 POINT TO END OF TABLE ENTRIES M2710500 LA R1,NS1 POINT TO FIRST TABLE ENTRY M2711000 NVAL100 LA R1,L'NS1(,R1) STEP TO NEXT TABLE ELEMENT M2711500 CLI 0(R1),C' ' Q. IF TABLE ELEMENT IS BLANK M2712000 BNE NVAL100 BR. IF NO TO CONTINUE SEARCH M2712500 SR R0,R1 FIND LENGTH OF REMAINING TABLE M2713000 STC R0,*+L'*+1 STORE LENGTH INTO NEXT INSTR M2713500 CLC 0(*-*,R1),=CL28' ' Q. IF REMAINING TABLE IS BLANK M2714000 BNE NVALERR BR. IF NO TO DOCUMENT ERROR M2714500 * M2715000 *** DETERMINE IF TABLE CONTAINS DUPLICATE ENTRIES M2715500 * M2716000 SLR R3,R3 CLEAR MEMBER COUNT R4 M2716500 LA R1,NS1-L'NS1 SET POINTER BEFORE TABLE M2717000 NVAL210 LA R1,L'NS1(,R1) STEP TO NEXT TABLE ENTRY M2717500 LA R3,1(,R3) INCREMENT MEMBER COUNT R4 M2718000 CLI L'NS1(R1),C' ' Q. IF AT END OF TABLE M2718500 BE NVAL300 BR. IF YES M2719000 LR R2,R1 COPY CURRENT TABLE ELEMENT ADDR M2719500 NVAL220 LA R2,L'NS1(,R2) STEP TO NEXT TABLE ELEMENT M2720000 CLI 0(R2),C' ' Q. IF AT END OF TABLE M2720500 BE NVAL210 BR. IF YES TO STEP PRIMARY PTR. M2721000 CLC 0(L'NS1,R1),0(R2) Q. IF DUPLICATE ENTRY M2721500 BNE NVAL220 BR. IF NO TO CONTINUE SEARCH M2722000 B NVALERR BR. TO DOCUMENT ERROR M2722500 EJECT R4 M2723000 * R4 M2723500 *** SET $QSENO @OZ20010 M2724000 * R4 M2724500 NVAL300 STH R3,$QSENO SET COUNT OF MEMBERS IN NODE R4 M2725000 PRINT OFF - SECTION DELETED @OZ20010 M2725500 * THIS CARD DELETED BY APAR @OZ20010 M2726000 * THIS CARD DELETED BY APAR @OZ20010 M2726500 * THIS CARD DELETED BY APAR @OZ20010 M2727000 * THIS CARD DELETED BY APAR @OZ20010 M2727500 * THIS CARD DELETED BY APAR @OZ20010 M2728000 * THIS CARD DELETED BY APAR @OZ20010 M2728500 * THIS CARD DELETED BY APAR @OZ20010 M2729000 * THIS CARD DELETED BY APAR @OZ20010 M2729500 * THIS CARD DELETED BY APAR @OZ20010 M2730000 PRINT ON -- SECTION DELETED @OZ20010 M2730500 * M2731000 *** DETERMINE IF TABLE CONTAINS SMF CPU ID FOR THIS SYSTEM M2731500 * M2732000 LA R1,NS1 POINT TO 1ST TABLE ENTRY R4 M2732500 NVAL310 CLC $SID,0(R1) Q. IF SMF CPU ID M2733000 BE NSIDINFO BR IF YES @OZ27300 M2733500 LA R1,L'NS1(,R1) STEP TO NEXT TABLE ENTRY M2734000 CLI 0(R1),C' ' Q. IF AT END OF TABLE M2734500 BNE NVAL310 BR. IF NO TO CONTINUE SEARCH M2735000 * M2735500 *** DOCUMENT INVALID SYSTEM PARAMETER TABLE M2736000 * M2736500 NVALERR L R1,=A(NVALMSG) POINT TO ERROR MESSAGE R4 M2737000 B NAEXIT BR TO ISSUE MESSAGE AND QUIT R4 M2737500 SPACE 6 M2738000 * M2738500 *** SYSTEM PARAMETER TABLE M2739000 * M2739500 NS1 DC 8CL4' ' SMF ID(S) FOR CPU 1 THRU CPU 7 M2740000 NS1A DC X'01010000',X'02020000',X'03040000',X'04080000' M2740500 DC X'05100000',X'06200000',X'07400000' M2741000 SPACE 3 @OZ27300 M2741100 NSIDINFO MVC $SIDBUSY,NS1A-NS1(R1) SET BUSY AND AFFINITY @OZ27300 M2741200 MVC $SIDAFF,NS1A+1-NS1(R1) MASKS FOR THIS SYSTEM @OZ27300 M2741300 TITLE 'HASP INITIALIZATION -- TEMPORARY TED ALLOCATION' R4 M2741500 *********************************************************************** M2742000 * * M2742500 * OBTAIN STORAGE FOR TEMPORARY TEDS * M2743000 * * M2743500 *********************************************************************** M2744000 SPACE 1 R4 M2744500 NTEDINIT LH R3,$NUMTGV COMPUTE R4 M2745000 LA R3,7(,R3) AND R4 M2745500 SRL R3,3 STORE R4 M2746000 SLR R0,R0 LENGTH OF R4 M2746500 IC R0,$NUMDA TRACK R4 M2747000 MR R2,R0 GROUP R4 M2747500 ST R3,$CYLMAPL MAP R4 M2748000 LA R2,IOTTGMAP-IOTDSECT+TGMAP-TGMDSECT+3(,R3) R4 M2748500 N R2,=F'-4' COMPUTE AND STORE R4 M2749000 ST R2,$IOTPDDB OFFSET WITHIN IOT OF 1ST PDDB R4 M2749500 LA R3,IOTPDBOD-(BUFSTART-BUFDSECT)(,R2) MIN BUFFER SIZE R4 M2750000 CH R3,$BUFSIZE IF BUFFER SIZE ADEQUATE, R4 M2750500 BNH NGETTEDS BR TO GET TEMPORARY TEDS R4 M2751000 L R1,=A(NTGBFMSG) ELSE POINT TO ERROR MESSAGE R4 M2751500 SPACE 1 R4 M2752000 NAEXIT $$WTO (R1) ISSUE ERROR MESSAGE TO OPERATOR R4 M2752500 $EXIT NGQUITM THEN ISSUE 'QUIT' MSG AND QUIT R4 M2753000 SPACE 1 R4 M2753500 NGETTEDS LA R3,TEDSIZ REQUEST STORAGE R4 M2754000 MR R2,R0 FOR TEMPORARY R4 M2754500 LR R0,R3 TRACK EXTENT R4 M2755000 ICM R0,8,=AL1(229) DATA R4 M2755500 GETMAIN R,LV=(0) TABLES R4 M2756000 EJECT R4 M2756500 *********************************************************************** M2757000 * * M2757500 * FORMAT TEMPORARY TRACK EXTENT DATA TABLES * M2758000 * * M2758500 *********************************************************************** M2759000 SPACE 1 R4 M2759500 ST R1,TEDSTART SET POINTER TO TEMPORARY TEDS R4 M2760000 LR R2,R1 AND CLEAR R4 M2760500 MVCL R2,R14 TED STORAGE R4 M2761000 LH R2,$NUMTGV GET TRACK GROUPS PER EXTENT R4 M2761500 IC R15,$NUMDA AND NUMBER OF VOLUMES R4 M2762000 LA R4,7(,R2) GET SINGLE VOLUME R4 M2762500 SRL R4,3 MAP SIZE R4 M2763000 SLR R5,R5 INITIALIZE MAP OFFSET R4 M2763500 SPACE 1 R4 M2764000 USING TEDDSECT,R1 PROVIDE TED ADDRESSABILITY R4 M2764500 SPACE 1 R4 M2765000 INITTED STC R3,TNMD EXTENT NUMBER, SHIFTED LEFT 8 R4 M2765500 STH R2,TNGE NUMBER OF GROUPS PER EXTENT R4 M2766000 MVI TNTG+1,1 NUMBER OF TRACKS PER GROUP R4 M2766500 STH R5,TNMO OFFSET OF THIS MAP FROM 1ST MAP R4 M2767000 STH R4,TNMB NUMBER OF BYTES PER MAP R4 M2767500 LA R3,1(,R3) BUMP EXTENT NUMBER R4 M2768000 ALR R5,R4 BUMP MAP OFFSET R4 M2768500 LA R1,TEDSIZ(,R1) POINT TO NEXT TED R4 M2769000 BCT R15,INITTED LOOP THRU ALL TEDS R4 M2769500 SPACE 1 R4 M2770000 DROP R1 KILL TED ADDRESSABILITY R4 M2770500 TITLE 'HASP INITIALIZATION -- JOB QUEUE / JOT ALLOCATION' R4 M2771000 *********************************************************************** M2771500 * * M2772000 * COMPUTE ENTRIES IN RESIDENT JCT QUEUE * M2772500 * * M2773000 *********************************************************************** M2773500 SPACE 1 R4 M2774000 NALOCJQS SLR R1,R1 CLEAR FOR INSERTS R4 M2774500 LA R0,2 COMPUTE AND SAVE R4 M2775000 IC R1,$NUMPRTS NUMBER R4 M2775500 ALR R0,R1 OF R4 M2776000 IC R1,$NUMPUNS PRINT, R4 M2776500 ALR R0,R1 PUNCH, R4 M2777000 AH R0,$NUMTPPR REMOTE PRINT, R4 M2777500 AH R0,$NUMTPPU AND REMOTE PUNCH ENTRIES R4 M2778000 STH R0,$#JCTQCT PLUS 2 R4 M2778500 SPACE 1 R4 M2779000 *********************************************************************** M2779500 * * M2780000 * PROVIDE PRINT/PUNCH-RELATED PARAMETER DEFAULTS * M2780500 * * M2781000 *********************************************************************** M2781500 SPACE 1 R4 M2782000 SH R0,=H'2' REDUCE R0 TO PRINT/PUNCH COUNT R4 M2782500 LR R1,R0 MULTIPLY PRINT/PUNCH R4 M2783000 M R0,=F'10' COUNT BY 10 R4 M2783500 CH R1,=Y($MAXJOES) IMPOSE R4 M2784000 BNH SKIP670 &NUMJOES R4 M2784500 LH R1,=Y($MAXJOES) LIMIT R4 M2785000 SKIP670 OC $NUMJOES,$NUMJOES TEST $NUMJOES R4 M2785500 BNZ SKIP680 BR IF PROVIDED R4 M2786000 STH R1,$NUMJOES ELSE SUPPLY DEFAULT R4 M2786500 SKIP680 LH R1,$NUMJOES GET $NUMJOES R4 M2787000 D R0,=F'5' DIVIDED BY 5 R4 M2787500 LH WA,$MINJOES IF R4 M2788000 LTR WA,WA $MINJOES R4 M2788500 BNZ SKIP690 NOT PROVIDED, R4 M2789000 LR WA,R1 SUPPLY DEFAULT R4 M2789500 SKIP690 LH R0,$NUMJOES ENSURE R4 M2790000 BCTR R0,0 $MINJOES R4 M2790500 BCTR R0,0 AT R4 M2791000 CLR R0,WA LEAST R4 M2791500 BNL SKIP700 2 R4 M2792000 LR WA,R0 LESS THAN R4 M2792500 SKIP700 STH WA,$MINJOES $NUMJOES R4 M2793000 EJECT R4 M2793500 ***************************************************************@OZ20010 M2794000 * @OZ20010 M2794200 * COMPUTE SIZE OF JES2 JOB QUEUE @OZ20010 M2794400 * @OZ20010 M2794500 ***************************************************************@OZ20010 M2794700 SPACE 1 @OZ20010 M2794900 LH R1,$MAXJOBS GET JQE REQUIREMENT @OZ20010 M2795000 LA R1,1(,R1) PLUS 1 FOR EYE-CATCHER @OZ27300 M2795100 MH R1,=AL2(JQELNGTH) COMPUTE AND @OZ20010 M2795200 LA R1,4095(,R1) STORE NUMBER OF @OZ20010 M2795400 SRL R1,12 JOB QUEUE @OZ20010 M2795500 STH R1,$JOBRECN RECORDS @OZ20010 M2795700 SLL R1,12 COMPUTE AND STORE @OZ20010 M2795900 ST R1,$JOBQSIZ SIZE OF JOB QUEUE @OZ20010 M2796000 SPACE 1 @OZ20010 M2796200 ***************************************************************@OZ20010 M2796400 * @OZ20010 M2796500 * COMPUTE SIZE OF JES2 JOB OUTPUT TABLE (JOT) @OZ20010 M2796700 * @OZ20010 M2796900 ***************************************************************@OZ20010 M2797000 SPACE 1 @OZ20010 M2797200 LH R1,$NUMJOES GET REAL JOE REQUIREMENT @OZ20010 M2797400 LA R1,NJOTPRFX(,R1) COMPUTE STORAGE REQUIREMENT @OZ27300 M2797500 MH R1,=AL2(JOESIZE) PLUS PREFIX AND @OZ27300 M2797700 LA R1,4095(,R1) ROUNDING FACTOR @OZ20010 M2797900 SRL R1,12 COMPUTE AND STORE @OZ20010 M2798000 STH R1,$JOTRECN COUNT OF JOT RECORDS @OZ20010 M2798200 SLL R1,12 COMPUTE AND STORE @OZ20010 M2798400 ST R1,$JOTSIZE SIZE OF JOT @OZ20010 M2798500 PRINT OFF - SECTION DELETED @OZ27300 M2798700 * THIS CARD DELETED BY APAR @OZ27300 M2798900 * THIS CARD DELETED BY APAR @OZ27300 M2799000 * THIS CARD DELETED BY APAR @OZ27300 M2799200 * THIS CARD DELETED BY APAR @OZ27300 M2799400 * THIS CARD DELETED BY APAR @OZ27300 M2799500 * THIS CARD DELETED BY APAR @OZ27300 M2799700 * THIS CARD DELETED BY APAR @OZ27300 M2800000 * THIS CARD DELETED BY APAR @OZ27300 M2800500 * THIS CARD DELETED BY APAR @OZ27300 M2801000 PRINT ON -- SECTION DELETED @OZ27300 M2801400 EJECT @OZ27300 M2801500 ***************************************************************@OZ27300 M2801700 * @OZ27300 M2801900 * GET STORAGE FOR MASTER CHKPT RECORD AND ITS I/O AREA @OZ27300 M2802000 * @OZ27300 M2802200 ***************************************************************@OZ27300 M2802400 SPACE 1 @OZ27300 M2802500 LA R3,QSELEN R3 = SIZE OF QSES @OZ27300 M2802700 MH R3,$QSENO FOR ALL SYSTEMS @OZ27300 M2802900 LH R4,$JOBRECN R4 = SIZE OF CHECKPOINT @OZ27300 M2803000 AH R4,$JOTRECN I/O CONTROL BYTES @OZ27300 M2803200 SLR R10,R10 R10 = SIZE OF DA CKPT @OZ27300 M2803400 IC R10,$NUMDA INFO BLOCKS AT @OZ27300 M2803500 MH R10,=H'6' 6 BYTES PER BLOCK @OZ27300 M2803700 LH R5,$NUMRJE R5 = SIZE OF REMOTE @OZ27300 M2803900 LR R8,R5 MESSAGE SPOOL QUEUE @OZ27300 M2804000 LA R5,1(,R5) HEADS AT 3 BYTES @OZ20010 M2804200 MH R5,=H'3' PER QUEUE HEAD @OZ20010 M2804400 MH R8,=H'3' R8 = SIZE OF REMOTE SIGN-ON @OZ20010 M2804500 LA R8,7(,R8) TABLE AT 3 BITS PER @OZ20010 M2804700 SRL R8,3 RMT, SPANNING BYTES @OZ20010 M2804900 LA R7,$SAVELEN(R5,R10) ADD ABOVE SIZES @OZ27300 M2805000 ALR R7,R8 PLUS LENGTH OF @OZ27300 M2805200 ALR R7,R3 HCT VARIALBES AND, @OZ27300 M2805400 ALR R7,R4 MASTER TRACK GROUP MAP @OZ27300 M2805500 AL R7,$CYLMAPL STORING TOTAL AS SIZE @OZ27300 M2805700 ST R7,$MASTERL OF MASTER CKPT RECORD @OZ27300 M2805800 LA R7,4095(,R7) ROUND STORAGE REQUIREMENT @OZ20010 M2805900 N R7,=F'-4096' TO MULTIPLE OF 4K @OZ20010 M2806000 LA R0,0(R7,R7) GET STORAGE FOR MSTR CKPT @OZ27300 M2806200 SPACE 1 @OZ20010 M2806400 GETMAIN RU,LV=(0),BNDRY=PAGE RCD AND ITS READ-IN AREA@OZ20010 M2806500 EJECT @OZ20010 M2806700 ***************************************************************@OZ20010 M2806900 * @OZ20010 M2807000 * CLEAR AND PAGE-FIX MASTER CHECKPOINT RECORD @OZ27300 M2807200 * @OZ20010 M2807400 ***************************************************************@OZ20010 M2807500 SPACE 1 @OZ20010 M2807700 L R2,=A(NOPTECB) GET ECB ADDRESS FOR $PGSRVC @OZ20010 M2807900 $PGSRVC FIX,(R1),(R7),(R2) FIX RECORD AREA FOR EXCPVR @OZ20010 M2808000 SPACE 1 @OZ20010 M2808200 LR R6,R1 CLEAR STORAGE @OZ20010 M2808400 SLR R15,R15 FOR FIRST @OZ20010 M2808500 MVCL R6,R14 CKPT RECORD @OZ20010 M2808700 ST R1,$MASTER STORE PTR TO MASTER RECORD @OZ27300 M2808900 ST R6,$MASTERI STORE PTR TO CKPT-I/O AREA @OZ27300 M2809000 LA R6,$SAVELEN(R3,R6) AND THE READ IN AREA @OZ27300 M2809100 ST R6,$CTLBIO CHECKPOINT CONTROL BYTES @OZ27300 M2809200 LA R1,$SAVELEN(,R1) STORE POINTER TO @OZ27300 M2809300 ST R1,$QSE1 FIRST QSE @OZ27300 M2809400 ALR R1,R3 STORE POINTER TO @OZ27300 M2809500 ST R1,$CTLB CHECKPT I/O CONTROL BYTES @OZ27300 M2809600 ALR R1,R4 STORE POINTER TO @OZ27300 M2809700 ST R1,$DACKPT DA CKPT INFO BLOCKS @OZ27300 M2809800 ALR R1,R10 STORE POINTER TO @OZ27300 M2809900 ST R1,$MSPOOLQ RMT MSG SPOOL QUEUE HEADS @OZ27300 M2810000 ALR R1,R5 STORE POINTER TO @OZ27300 M2810200 ST R1,$RMTSON REMOTE SIGN-ON TABLE @OZ20010 M2810400 ALR R1,R8 STORE POINTER TO @OZ20010 M2810500 ST R1,$TGMAP MASTER TRACK GROUP MAP @OZ20010 M2810700 EJECT @OZ20010 M2810900 ***************************************************************@OZ20010 M2811000 * @OZ20010 M2811200 * GET STORAGE FOR JOB QUEUE, JOT AND THE READ-IN AREAS @OZ20010 M2811400 * @OZ20010 M2811500 ***************************************************************@OZ20010 M2811700 SPACE 1 @OZ20010 M2811900 L R7,$JOTSIZE GET SIZE OF JOT @OZ20010 M2812000 L R4,$JOBQSIZ GET SIZE OF JOB QUEUE @OZ20010 M2812200 LA R7,0(R4,R7) GET TOTAL STORAGE REQ'T @OZ20010 M2812400 LA R0,0(R7,R7) RELOAD TOTAL SIZE DOUBLED @OZ20010 M2812500 SPACE 1 @OZ20010 M2812700 GETMAIN RU,LV=(0),BNDRY=PAGE REQUEST STORAGE @OZ20010 M2812900 SPACE 1 @OZ20010 M2813000 ***************************************************************@OZ20010 M2813200 * @OZ20010 M2813400 * CLEAR AND FIX JOB QUEUE AND JOT PAGES @OZ20010 M2813500 * @OZ20010 M2813700 ***************************************************************@OZ20010 M2813900 SPACE 1 @OZ20010 M2814000 L R2,=A(NOPTECB) GET ECB ADDRESS FOR $PGSRVC @OZ20010 M2814200 $PGSRVC FIX,(R1),(R7),(R2) FIX JOB Q & JOT FOR EXCPVR @OZ20010 M2814400 SPACE 1 @OZ20010 M2814500 LA R0,0(R4,R7) STORE POINTER @OZ20010 M2814700 ALR R0,R1 TO JOT @OZ20010 M2814900 ST R0,$JOTIO I/O AREA @OZ27300 M2815000 LR R6,R1 CLEAR STORAGE @OZ20010 M2815200 SLR R15,R15 FOR JOB QUEUE @OZ20010 M2815400 MVCL R6,R14 AND JOT @OZ20010 M2815500 ST R1,$JOBQPTR STORE JOB QUEUE ORIGIN @OZ20010 M2815700 ST R6,$JOBQIO STORE JOB Q I/O AREA PTR @OZ27300 M2815900 ALR R4,R1 STORE POINTER TO @OZ20010 M2816000 ST R4,$JOTABLE JOB OUTPUT TABLE (JOT) @OZ20010 M2816200 EJECT @OZ20010 M2816400 ***************************************************************@OZ20010 M2816500 * @OZ20010 M2816700 * GET STORAGE FOR CHECKPOINT I/O BUFFER --(JQB)-- @OZ27300 M2816900 * @OZ20010 M2817000 ***************************************************************@OZ20010 M2817200 SPACE 1 @OZ20010 M2817400 USING JQBDSECT,R1 PROVIDE JQB ADDRESSABILITY @OZ20010 M2817500 LH R6,$JOBRECN R4 = SIZE OF CHECKPOINT @OZ27300 M2817700 AH R6,$JOTRECN CHANNEL PROGRAM @OZ27300 M2817900 * THIS CARD DELETED BY APAR @OZ27300 M2818000 * THIS CARD DELETED BY APAR @OZ27300 M2818200 MH R6,=AL2(L'JQBCCWEL) AREA, (Q RECORDS) @OZ27300 M2818400 LA R7,JQBCCWS-JQBDSECT(,R6) PLUS BASIC JQB @OZ27300 M2818500 LH R5,$#JCTQCT R5 = STORAGE FOR RESIDENT @OZ20010 M2818700 SLL R5,3 JCT QUEUE CTL BLOCKS @OZ20010 M2818900 LR R0,R7 R7 = TOTAL JQB @OZ27300 M2819000 * THIS CARD DELETED BY APAR @OZ27300 M2819200 AR R0,R5 STORAGE REQUIREMENT @OZ27300 M2819400 GETMAIN RU,LV=(0),BNDRY=PAGE GET JQB STORAGE @OZ20010 M2819500 L R2,=A(NOPTECB) GET ECB ADDRESS FOR $PGSRVC @OZ20010 M2819700 $PGSRVC FIX,(R1),(R7),(R2) LONG-TERM FIX THE JQB @OZ20010 M2819900 ST R1,$JQB STORE JQB ADDRESS IN HCT @OZ27300 M2820000 LR R14,R1 CLEAR ENTIRE @OZ41202 M2820100 LA R15,0(R5,R7) JQB AND @OZ41202 M2820200 SLR R1,R1 RESIDENT JCT QUEUE @OZ41202 M2820400 MVCL R14,R0 CONTROL BLOCK AREA @OZ41202 M2820500 L R1,$JQB GET JQB ADDRESS @OZ41202 M2820600 STH R7,JQBSIZE STORE LENGTH IN JQB @OZ41202 M2820700 * STATEMENT DELETED BY APAR @OZ41202 M2820900 LA R0,JQBCCWS(R6) STORE POINTER TO RESIDENT @OZ20010 M2821000 ST R0,$#JCTQ JCT QUEUE CONTROL BLOCKS @OZ20010 M2821200 PRINT OFF - SECTION DELETED @OZ27300 M2821400 * THIS CARD DELETED BY APAR @OZ27300 M2821500 * THIS CARD DELETED BY APAR @OZ27300 M2821700 PRINT ON -- SECTION DELETED @OZ27300 M2821900 MVC JQBECBP,=A(NGECB) STORE POINTER TO INIT'N ECB @OZ20010 M2822000 MVI JQBIOB,X'42' SET 'IOBFLAG1' IN JQB @OZ20010 M2822200 MVC JQBDCBP,$HASPDCB SET DA DCB ADDRESS IN JQC @OZ20010 M2822400 LA R0,JQBCCWS STORE POINTER TO @OZ20010 M2822500 ST R0,IOBSTART-BUFDSECT(,R1) START OF CHANNEL PGM @OZ20010 M2822700 PRINT OFF - SECTION DELETED @OZ20010 M2823000 * THIS CARD DELETED BY APAR @OZ20010 M2823500 * THIS CARD DELETED BY APAR @OZ20010 M2824000 * THIS CARD DELETED BY APAR @OZ20010 M2824500 * THIS CARD DELETED BY APAR @OZ20010 M2825000 * THIS CARD DELETED BY APAR @OZ20010 M2825500 * THIS CARD DELETED BY APAR @OZ20010 M2826000 * THIS CARD DELETED BY APAR @OZ20010 M2826500 * THIS CARD DELETED BY APAR @OZ20010 M2827000 * THIS CARD DELETED BY APAR @OZ20010 M2827500 * THIS CARD DELETED BY APAR @OZ20010 M2828000 * THIS CARD DELETED BY APAR @OZ20010 M2828500 * THIS CARD DELETED BY APAR @OZ20010 M2829000 * THIS CARD DELETED BY APAR @OZ20010 M2829500 * THIS CARD DELETED BY APAR @OZ20010 M2830000 * THIS CARD DELETED BY APAR @OZ20010 M2830500 * THIS CARD DELETED BY APAR @OZ20010 M2831000 * THIS CARD DELETED BY APAR @OZ20010 M2831500 * THIS CARD DELETED BY APAR @OZ20010 M2832000 * THIS CARD DELETED BY APAR @OZ20010 M2832500 * THIS CARD DELETED BY APAR @OZ20010 M2833000 * THIS CARD DELETED BY APAR @OZ20010 M2833500 * THIS CARD DELETED BY APAR @OZ20010 M2834000 * THIS CARD DELETED BY APAR @OZ20010 M2834500 * THIS CARD DELETED BY APAR @OZ20010 M2835000 * THIS CARD DELETED BY APAR @OZ20010 M2835500 * THIS CARD DELETED BY APAR @OZ20010 M2836000 * THIS CARD DELETED BY APAR @OZ20010 M2836500 * THIS CARD DELETED BY APAR @OZ20010 M2837000 * THIS CARD DELETED BY APAR @OZ20010 M2837500 * THIS CARD DELETED BY APAR @OZ20010 M2838000 * THIS CARD DELETED BY APAR @OZ20010 M2838500 * THIS CARD DELETED BY APAR @OZ20010 M2839000 * THIS CARD DELETED BY APAR @OZ20010 M2839500 * THIS CARD DELETED BY APAR @OZ20010 M2840000 * THIS CARD DELETED BY APAR @OZ20010 M2840500 * THIS CARD DELETED BY APAR @OZ20010 M2841000 * THIS CARD DELETED BY APAR @OZ20010 M2841500 * THIS CARD DELETED BY APAR @OZ20010 M2842000 * THIS CARD DELETED BY APAR @OZ20010 M2842500 * THIS CARD DELETED BY APAR @OZ20010 M2843000 * THIS CARD DELETED BY APAR @OZ20010 M2843500 * THIS CARD DELETED BY APAR @OZ20010 M2844000 * THIS CARD DELETED BY APAR @OZ20010 M2844500 * THIS CARD DELETED BY APAR @OZ20010 M2845000 * THIS CARD DELETED BY APAR @OZ20010 M2845500 * THIS CARD DELETED BY APAR @OZ20010 M2846000 * THIS CARD DELETED BY APAR @OZ20010 M2846500 * THIS CARD DELETED BY APAR @OZ20010 M2847000 * THIS CARD DELETED BY APAR @OZ20010 M2847500 * THIS CARD DELETED BY APAR @OZ20010 M2848000 * THIS CARD DELETED BY APAR @OZ20010 M2848500 * THIS CARD DELETED BY APAR @OZ20010 M2849000 * THIS CARD DELETED BY APAR @OZ20010 M2849500 * THIS CARD DELETED BY APAR @OZ20010 M2850000 * THIS CARD DELETED BY APAR @OZ20010 M2850500 * THIS CARD DELETED BY APAR @OZ20010 M2851000 * THIS CARD DELETED BY APAR @OZ20010 M2851500 PRINT ON -- SECTION DELETED @OZ20010 M2852000 B INITVAT THEN BR TO NEXT SECTION R4 M2852500 SPACE 1 R4 M2853000 DROP R1 KILL JQB ADDRESSABILITY R4 M2853500 EJECT R4 M2854000 NJOTPRFX EQU (JOTJOES-JOTDSECT)/JOESIZE R4 M2854500 * THIS CARD DELETED BY APAR @OZ20010 M2855000 * THIS CARD DELETED BY APAR @OZ20010 M2855500 SPACE 3 R4 M2856000 LTORG R4 M2856500 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION' R4 M2857000 *********************************************************************** M2857500 * * M2858000 * CREATE VOLUME ALLOCATION TABLE * M2858500 * * M2859000 *********************************************************************** M2859500 SPACE 1 R4 M2860000 INITVAT BALR BASE2,0 RE-ESTABLISH R4 M2860500 USING *,BASE2,BASE3 LOCAL ADDRESSABILITY R4 M2861000 SPACE 1 R4 M2861500 LA BASE3,2048(,BASE2) PROVIDE SECOND R4 M2862000 LA BASE3,2048(,BASE3) BASE REGISTER R4 M2862500 SLR R3,R3 OBTAIN R4 M2863000 IC R3,$NUMDA STORAGE R4 M2863500 LA R3,2(,R3) FOR @OZ27300 M2864000 MH R3,=Y(NVLTBLN) VOLUME R4 M2864500 LA R0,NVLTBLN(,R3) ALLOCATION R4 M2865000 GETMAIN R,LV=(0) TABLE R4 M2865500 ST R1,NVOLTABL SET POINTER TO ALLOC'N TABLE R4 M2866000 SLR R15,R15 CLEAR R4 M2866500 LR R2,R1 USABLE R4 M2867000 MVCL R2,R14 ENTRIES R4 M2867500 MVI NVLEND-NVLDSECT(R2),255 SET TERMINATOR R4 M2868000 SPACE 1 @OZ27300 M2868200 ***************************************************************@OZ27300 M2868400 * @OZ27300 M2868500 * ENSURE PRIMARY AND SECONDARY CHKPT VOLUMES UNIQUE @OZ27300 M2868700 * @OZ27300 M2868900 ***************************************************************@OZ27300 M2869000 SPACE 1 @OZ27300 M2869200 CLI $CHKPT,C' ' IF NO CHECKPOINT @OZ27300 M2869400 BNE NGCK2CHK VOLUME DEFINED, @OZ27300 M2869500 MVC $CHKPT,$SPOOL SUPPLY DEFAULT @OZ27300 M2869700 SPACE 1 @OZ27300 M2869900 NGCK2CHK OI $STATUS,$DUPLEX ASSUME &CHKPT2 SPECIFIED @OZ27300 M2870000 MVC $CKPTVOL(6),$CHKPT SET CKPT VOL ID FOR RESERVE @OZ35278 M2870100 CLC $CHKPT,$CHKPT2 CHECK FOR UNIQUE CHKPTS @OZ27300 M2870200 BE NGCK2ER BRANCH IF NOT -- ERROR @OZ27300 M2870400 CLI $CHKPT2,C' ' CHECK FOR &CKPT2 SPECIFIED @OZ27300 M2870500 BNE NGCKMSTL BRANCH IF YES, USE SETTING @OZ27300 M2870700 MVC $CHKPT2,$CHKPT ELSE SHOW NO DUPLEXING @OZ27300 M2870900 NI $STATUS,FF-$DUPLEX IN $CHKPT2 AND $STATUS @OZ27300 M2871000 B NGCKMSTL AND CONTINUE INITIALIZING @OZ27300 M2871100 SPACE 1 @OZ27300 M2871200 NGCK2ER L R1,=A(NMSGCK2R) ISSUE MSG '&CKPT2 INVALID' @OZ27300 M2871300 B NGKWIT AND TERMINATE @OZ27300 M2871400 EJECT @OZ27300 M2871500 ***************************************************************@OZ27300 M2871600 * @OZ27300 M2871700 * SET MASTER RECORD LENGTH IN TRACK 1 TABLE @OZ27300 M2871800 * @OZ27300 M2871900 ***************************************************************@OZ27300 M2872000 SPACE 1 @OZ27300 M2872100 NGCKMSTL L R0,$MASTERL STORE MASTER @OZ27300 M2872200 STH R0,NTR1CLEN-NTR1+NTR1MSTR RECORD LENGTH @OZ27300 M2872300 STH R0,NTR1RLEN-NTR1+NTR1MSTR IN TRACK 1 TABLE @OZ27300 M2872400 TM $STATUS,$DUPLEX ARE WE DUPLEXING... @OZ27300 M2872500 BZ NUCBSPL BR IF NO @OZ27300 M2872600 OI $CKPTFLG,$CKPDPX SHOW DUPLEXING BEING DONE @OZ27300 M2872700 SPACE 1 @OZ27300 M2872800 ***************************************************************@OZ27300 M2872900 * @OZ27300 M2873000 * LOCATE SPOOL/CHECKPOINT VOLUMES @OZ27300 M2873100 * @OZ27300 M2873200 ***************************************************************@OZ27300 M2873300 SPACE 1 @OZ27300 M2873400 NUCBSPL L WA,CVTPTR GET ADDRESS OF @OZ27300 M2873500 L WA,CVTILK2-CVT(,WA) UCB LOOK-UP TABLE R4 M2874000 SH WA,=H'2' (LESS 2) R4 M2874500 LA WC,3*NVLTBLN(,R1) 1ST SECONDARY SPOOL ENTRY @OZ27300 M2875000 SLR WB,WB CLEAR FOR INSERTS R4 M2875500 SPACE 1 R4 M2876000 USING UCBDSECT,WB PROVIDE UCB ADDRESSABILITY R4 M2876500 USING NVLDSECT,WD PROVIDE ALLOC TBL ADDRESSABILITY R4 M2877000 SPACE 1 R4 M2877500 NEXTUCB LA WA,2(,WA) GET NEXT LOOK-UP TABLE ENTRY R4 M2878000 ICM WB,3,0(WA) GET UCB ADDRESS R4 M2878500 BZ NEXTUCB IGNORE IF NULL ENTRY R4 M2879000 CL WB,=A(X'FFFF') TEST UCB ADDRESS R4 M2879500 BE NQSEMARK BR IF END OF UCBS @OZ27300 M2880000 CLI UCBTBYT3,UCB3DACC TEST DEVICE TYPE R4 M2880500 BNE NEXTUCB IGNORE IF NOT DIRECT ACCESS R4 M2881000 CLC $CHKPT,UCBVOLI TEST VOLUME SERIAL NUMBER R4 M2881500 BE NUCBGOT IGNORE IF NOT R41 M2882000 CLC $CHKPT2,UCBVOLI CHECKPOINT, @OZ27300 M2882200 BE NUCBGOT ALTERNATE CHECKPOINT, @OZ27300 M2882400 CLC $SPOOL(5),UCBVOLI OR @OZ27300 M2882500 BNE NEXTUCB SPOOL VOLUME @OZ27300 M2883000 EJECT R4 M2883500 *********************************************************************** M2884000 * * M2884500 * ENSURE SPOOL/CHECKPOINT VOLUME IS UNIQUE * M2885000 * * M2885500 *********************************************************************** M2886000 SPACE 1 R4 M2886500 NUCBGOT L R15,CVTPTR GET ADDRESS OF R41 M2887000 L R15,CVTILK2-CVT(,R15) UCB LOOK-UP TABLE R4 M2887500 SH R15,=H'2' (LESS 2) R4 M2888000 SLR R1,R1 CLEAR FOR INSERTS R4 M2888500 SPACE 1 R4 M2889000 NUCBNEXT LA R15,2(,R15) GET NEXT LOOK-UP TABLE ENTRY R4 M2889500 ICM R1,3,0(R15) GET UCB ADDRESS R4 M2890000 BZ NUCBNEXT IGNORE IF NULL ENTRY R4 M2890500 CLI UCBTBYT3-UCBDSECT(R1),UCB3DACC TEST DEVICE TYPE R4 M2891000 BNE NUCBNEXT IGNORE IF NOT DIRECT ACCESS R4 M2891500 CLC UCBVOLI,UCBVOLI-UCBDSECT(R1) TEST VOLUME SERIALS R4 M2892000 BNE NUCBNEXT IGNORE IF DIFFERENT R4 M2892500 CLR R1,WB TEST UCB ADDRESS R4 M2893000 BNE NDAERR1 QUIT IF NOT SAME (ERROR) @OZ35278 M2893500 PRINT OFF - SECTION DELETED @OZ35278 M2894000 * THIS CARD DELETED BY APAR @OZ35278 M2894500 * THIS CARD DELETED BY APAR @OZ35278 M2895000 PRINT ON -- SECTION DELETED @OZ35278 M2895500 CLR R15,WA TEST LOOKUP TABLE ADDRESSES @OZ35278 M2896000 BNE NEXTUCB DUPL CHANNEL PATH IF DIFFERENT R4 M2896500 EJECT R41 M2897000 *********************************************************************** M2897500 * * M2898000 * UPDATE SPOOL/CHECKPOINT VOLUME ALLOCATION TABLE * M2898500 * * M2899000 *********************************************************************** M2899500 SPACE 1 R4 M2900000 L WD,NVOLTABL POINT TO 1ST ALLOC TABLE ENTRY R4 M2900500 CLC $CHKPT,UCBVOLI TEST FOR CHECKPOINT VOLUME R4 M2901000 BNE NSPLCKP2 BR IF NO @OZ27300 M2901500 ST WB,NVLUCBPT ELSE SET UCB ADDRESS R41 M2901600 MVC NVLVOLID,UCBVOLI AND VOLUME SERIAL R41 M2901700 SPACE 1 @OZ27300 M2901800 NSPLCKP2 LA WD,NVLTBLN(,WD) LOCATE 2ND ALLOC TBL ENTRY @OZ27300 M2901900 CLC $CHKPT2,UCBVOLI TEST FOR 2NDARY CKPT VOLUME @OZ27300 M2902000 BNE NSPLUCB BR IF NO @OZ27300 M2902100 ST WB,NVLUCBPT ELSE SET UCB ADDRESS @OZ27300 M2902200 MVC NVLVOLID,UCBVOLI AND VOLUME SERIAL @OZ27300 M2902300 SPACE 1 @OZ27300 M2902400 NSPLUCB CLC $SPOOL(5),UCBVOLI IS VOLUME ALSO A SPOOL... @OZ27300 M2902500 BNE NEXTUCB BR IF NO @OZ27300 M2902600 SPACE 1 @OZ27300 M2902700 LA WD,NVLTBLN(,WD) LOCATE 3RD ALLOC TBL ENTRY @OZ27300 M2902800 CLC $SPOOL,UCBVOLI TEST FOR PRIMARY SPOOL VOL @OZ27300 M2902900 BE NDAVUPDT BR IF YES @OZ27300 M2903000 LR WD,WC POINT TO CURRENT TABLE ENTRY R4 M2903500 CLI NVLEND,255 ARE ENTRIES EXHAUSTED... R4 M2904000 BE NDAERR2 BR IF YES R4 M2904500 LA WC,NVLTBLN(,WC) ELSE REMEMBER NEXT ENTRY R4 M2905000 SPACE 1 R4 M2905500 NDAVUPDT ST WB,NVLUCBPT SET UCB ADDRESS R4 M2906000 MVC NVLVOLID,UCBVOLI SET VOLUME SERIAL NUMBER R4 M2906500 B NEXTUCB THEN BR TO TEST NEXT UCB R4 M2907000 SPACE 1 R4 M2907500 NDAERR1 L R1,=A(NDAEM1) POINT TO MESSAGE TEXT R4 M2908000 MVC NDAVOL-NDAEM1(,R1),UCBVOLI SET VOLUME SERIAL R4 M2908500 B NGKWIT BR TO ISSUE MESSAGE AND QUIT R4 M2909000 SPACE 1 @OZ27300 M2909100 DROP WB KILL UCB ADDRESSABILITY @OZ27300 M2909200 EJECT @OZ27300 M2909300 ***************************************************************@OZ27300 M2909400 * @OZ27300 M2909500 * LOCATE AND FLAG LAST DEFINED QSE @OZ27300 M2909600 * @OZ27300 M2909700 ***************************************************************@OZ27300 M2909800 SPACE 1 @OZ27300 M2909900 USING QSEDSECT,R2 PROVIDE QSE ADDRESSABILITY @OZ27300 M2910000 SPACE 1 @OZ27300 M2910100 NQSEMARK L R2,$QSE1 POINT TO 1ST QSE @OZ27300 M2910200 L R1,=A(NS1) POINT TO SYSTEM ID TABLE @OZ27300 M2910300 NQSENEXT CLI L'NS1(R1),C' ' IS THIS THE LAST ENTRY @OZ27300 M2910400 BE NQSELAST BR IF YES @OZ27300 M2910500 LA R2,QSELEN(,R2) POINT TO NEXT QSE @OZ27300 M2910600 LA R1,L'NS1(R1) POINT TO NEXT ENTRY @OZ27300 M2910700 B NQSENEXT TEST NEXT ENTRY @OZ27300 M2910800 NQSELAST OI QSEFLAGS,QSELAST MAKE QSE LAST @OZ27300 M2910900 SPACE 1 @OZ27300 M2911000 DROP R2 RELEASE QSE ADDRESSABILITY @OZ27300 M2911100 EJECT @OZ27300 M2911200 ***************************************************************@OZ27300 M2911300 * @OZ27300 M2911400 * ALLOCATE CHECKPOINT DATA SET (SYS1.HASPCKPT) @OZ27300 M2911500 * @OZ27300 M2911600 ***************************************************************@OZ27300 M2911700 SPACE 1 @OZ27300 M2911800 USING DEBDSECT,R2 PROVIDE DEB ADDRESSABILITY @OZ27300 M2911900 USING UCBDSECT,R3 PROVIDE UCB ADDRESSABILITY @OZ27300 M2912000 USING SPLDSECT,WC PROVIDE SPL ADDRESSABILITY @OZ27300 M2912100 SPACE 1 @OZ27300 M2912200 NDACKPT LA R0,=CL8'HOSPOOL' IDENTIFY @OZ27300 M2912300 L R1,$HASPMAP HOSPOOL @OZ27300 M2912400 L R1,MAPSPLA-MAPDSECT(,R1) SUBTASK @OZ27300 M2912500 IDENTIFY EPLOC=(0),ENTRY=(1) ENTRY POINT @OZ27300 M2912600 SPACE 1 @OZ27300 M2912700 NGCKDEB L R2,$DADEBAD GET POINTER TO DA DEB @OZ27300 M2912800 SLR R1,R1 POINT @OZ27300 M2912900 IC R1,$NUMDA TO @OZ27300 M2913000 SLL R1,4 CHECKPOINT @OZ27300 M2913100 LA R2,DEBBASND(R1) EXTENT @OZ27300 M2913200 SPACE 1 @OZ27300 M2913300 USING DEBDASD,R2 PROVIDE DEB EXTENT ADDR. @OZ27300 M2913400 SPACE 1 @OZ27300 M2913500 L WD,NVOLTABL LOCATE 1ST ALLOC TBL ENTRY @OZ27300 M2913600 SPACE 1 @OZ27300 M2913700 MVC NVLVOLID,$CHKPT ENSURE PRIMARY @OZ27300 M2913800 MVC NVLVOLID+NVLTBLN,$CHKPT2 SECONDARY AND @OZ27300 M2913900 MVC NVLVOLID+2*NVLTBLN,$SPOOL SPOOL VOLIDS PRESENT @OZ27300 M2914000 SPACE 1 @OZ27300 M2914100 NGCKALOC OI NVLFLAGS,SPL1CKPT+SPL1NFMT SET REQUEST FLAGS @OZ27300 M2914200 BAL WE,NGSPLGET OBTAIN CKPT DS ALLOC'N AREA @OZ27300 M2914300 BAL WE,NGALLOC ALLOCATE THE CHECKPOINT @OZ27300 M2914400 BAL WE,NGWAIT WAIT FOR COMPLETION @OZ27300 M2914500 BNZ NGCKBAD BR IF ANY ERRORS @OZ27300 M2914600 L R3,SPLUCBPT GET UCB ADDRESS @OZ27300 M2914700 ST R3,NVLUCBPT ENSURE IN ALLOC'N TABLE @OZ27300 M2914800 B NGCKDEBE GO CREATE CKPT DEB EXTENT @OZ27300 M2914900 SPACE 1 @OZ27300 M2915000 NGCKBAD BAL WE,NGDETACH DETACH HOSPOOL, FREE AREA @OZ27300 M2915100 B NGQUITT ISSUE MESSAGE AND QUIT @OZ27300 M2915200 EJECT @OZ27300 M2915300 ***************************************************************@OZ27300 M2915400 * @OZ27300 M2915500 * CONSTRUCT CHECKPOINT DATA SET DEB EXTENT @OZ27300 M2915600 * @OZ27300 M2915700 ***************************************************************@OZ27300 M2915800 SPACE 1 @OZ27300 M2915900 NGCKDEBE ST R3,DEBUCBAD SET UCB ADDRESS @OZ27300 M2916000 MVC DEBSTRCC(8),SPLSTRCC SET CKPT VOL EXTENT LIMITS @OZ27300 M2916100 MVC DEBNMTRK,SPLNMTRK SET NUMBER OF TRACKS IN DEB @OZ27300 M2916200 MVC NVLTNRT,SPLTNRT EXTENT AND VOL ALLOC TABLE @OZ27300 M2916300 BAL WE,NGDETACH DETACH HOSPOOL, FREE AREA @OZ27300 M2916400 SPACE 2 @OZ27300 M2916500 DROP WC RELEASE SPL ADDRESSABILITY @OZ27300 M2916600 EJECT @OZ27300 M2916700 ***************************************************************@OZ27300 M2916800 * @OZ27300 M2916900 * VERIFY CHECKPOINT DATA SET SPECIFICATIONS @OZ27300 M2917000 * @OZ27300 M2917100 ***************************************************************@OZ27300 M2917200 SPACE 1 @OZ27300 M2917300 * COMPUTE AND VALIDATE CHECKPOINT TRACK REQUIREMENT @OZ27300 M2917400 SPACE 1 @OZ27300 M2917500 LH WE,NVLTNRT GET NO. OF RECORDS / TRACK @OZ27300 M2917600 SLR R0,R0 COMPUTE @OZ27300 M2917700 LH R1,$JOBRECN TRACK @OZ27300 M2917800 AH R1,$JOTRECN REQUIREMENT @OZ27300 M2917900 ALR R1,WE FOR JOB QUEUE (ROUNDED @OZ27300 M2918000 BCTR R1,0 AND JOT UP) @OZ27300 M2918100 DR R0,WE RECORDS @OZ27300 M2918200 LA R1,1(,R1) PLUS TRACK 1 @OZ27300 M2918300 CH R1,DEBNMTRK TEST AGAINST CKPT EXTENTS @OZ27300 M2918400 BH NGCTRKER BR IF NOT ENOUGH TRACKS @OZ27300 M2918500 EJECT @OZ27300 M2918600 * DETERMINE MAXIMUM LENGTH OF CHECKPOINT RECORDS @OZ27300 M2918700 SPACE 1 @OZ27300 M2918800 NGCKDCT L R10,CVTPTR POINT TO DEVICE @OZ27300 M2918900 L R10,CVTZDTAB-CVT(,R10) CHARACTERISTICS TABLE @OZ27300 M2919000 SLR R6,R6 GET DEVICE TYPE @OZ27300 M2919100 IC R6,UCBTBYT4 FROM UCB @OZ27300 M2919200 SPACE 1 @OZ27300 M2919300 USING NGZ,R6 PROVIDE DEVTBL ADDR'ABILITY @OZ27300 M2919400 SPACE 1 @OZ27300 M2919500 IC R6,0(R6,R10) USE OFFSET TO LOCATE @OZ27300 M2919600 ALR R6,R10 DEVICE DESCRIPTION ENTRY @OZ27300 M2919700 SPACE 1 @OZ27300 M2919800 LA R10,NTR1REC1 PT TO 1ST TRK1 RCD TBL ENT @OZ27300 M2919900 LA R15,NTR1NMBR GET NUMBER OF RCDS ON TRK1 @OZ27300 M2920000 SLR R14,R14 ZERO USED SPACE ACCUMULATOR @OZ27300 M2920100 SPACE 1 @OZ27300 M2920200 USING NTR1,R10 PROVIDE TRK1 TBL ADDR'TY @OZ27300 M2920300 SPACE 1 @OZ27300 M2920400 NGNXTRCD SLR WC,WC CLEAR FOR INSERT @OZ27300 M2920500 IC WC,NTR1KEYL GET KEY LENGTH OF RECORD @OZ27300 M2920600 SLR R1,R1 ASSUME KEYED RECORD @OZ27300 M2920700 LTR WC,WC RECORD KEYED... @OZ27300 M2920800 BNZ *+8 BR IF YES @OZ27300 M2920900 IC R1,NGZU CREDIT FOR NON-KEYED RECORD @OZ27300 M2921000 AH WC,NTR1CLEN GET LENGTH OF KEY + DATA @OZ27300 M2921100 SLR R0,R0 CLEAR FOR INSERT @OZ27300 M2921200 IC R0,NGZL GET OVHD FOR LAST BLOCK @OZ27300 M2921300 CH R15,=Y(1) THIS THE LAST BLOCK... @OZ27300 M2921400 BE NGRECLEN BR IF YES @OZ27300 M2921500 IC R0,NGZNL GET OVHD FOR NOT-LAST-BLOCK @OZ27300 M2921600 TM NGZF,NGZFT APPLY TOLERANCE FACTOR... @OZ27300 M2921700 BZ NGRECLEN BR IF NO @OZ27300 M2921800 MH WC,NGZT APPLY TOLERANCE @OZ27300 M2921900 SRL WC,9 FACTOR @OZ27300 M2922000 SPACE 1 @OZ27300 M2922100 NGRECLEN TM NGZF,NGZF2305 THIS A 2305... @OZ27300 M2922200 BZ *+8 BR IF NO @OZ27300 M2922300 LH R0,NGZO GET 2305 BLOCK OVHD @OZ27300 M2922400 SR R0,R1 SUBTRACT ANY CREDIT @OZ27300 M2922500 AR WC,R0 GET TOTAL RECORD LENGTH @OZ27300 M2922600 AR R14,WC ADD TO TOTAL FOR TRACK @OZ27300 M2922700 LA R10,NTR1SIZE(,R10) POINT TO NEXT TABLE ENTRY @OZ27300 M2922800 BCT R15,NGNXTRCD LOOP THRU ALL RECORDS @OZ27300 M2922900 SPACE 1 @OZ27300 M2923000 DROP R10 KILL TRK1 TBL ADDR'TY @OZ27300 M2923100 EJECT @OZ27300 M2923200 * VERIFY TRACK SIZE ADEQUATE FOR CHKPT MASTER RECORD @OZ27300 M2923300 SPACE 1 @OZ27300 M2923400 SH R14,NGZR SUBTRACT TRACK CAPACITY @OZ27300 M2923500 BP NGCDSIZR BR IF TRK CAPACITY EXCEEDED @OZ27300 M2923600 LH R14,NGZH SAVE NUMBER OF TRACK / CYL @OZ27300 M2923700 STH R14,NVLMCYL IN VOLUME ALLOCATION TABLE @OZ27300 M2923800 SPACE 1 @OZ27300 M2923900 * ALLOCATE AND VERIFY BACKUP CHECKPOINT VOLUME, IF ANY @OZ27300 M2924000 SPACE 1 @OZ27300 M2924100 CLC NVLVOLID,$CHKPT2 EXIT IF 2NDARY CHECKPOINT @OZ27300 M2924200 BE NGCKCWI JUST ALLOC'D OR NOT SPEC'D @OZ27300 M2924300 SPACE 1 @OZ27300 M2924400 LA WD,NVLTBLN(,WD) LOCATE NEXT ALLOC TBL ENTRY @OZ27300 M2924500 LA R2,DEBEXLEN(,R2) AND NEXT DEB EXTENT @OZ27300 M2924600 SPACE 1 @OZ27300 M2924700 OI NVLFLAGS,SPL1CKP2 INDICATE 2NDARY CHECKPOINT @OZ27300 M2924800 SPACE 1 @OZ27300 M2924900 B NGCKALOC GO ALLOCATE AND VERIFY @OZ27300 M2925000 SPACE 2 @OZ27300 M2925100 * CHECKPOINT DATA SET SPECIFICATION ERRORS @OZ27300 M2925200 SPACE 1 @OZ27300 M2925300 NGCDSIZR CVD R14,NGWDBL CONVERT TRK REQUIREMENT @OZ27300 M2925400 L R1,=A(NMSG472) FIND MSG AND ADD @OZ27300 M2925500 MVC NBYTE472-NMSG472(,R1),NGCKDPAT TRACK SIZE @OZ27300 M2925600 ED NBYTE472-NMSG472(,R1),NGWDBL+5 REQUIREMENT @OZ27300 M2925700 MVC NMVOL472-NMSG472(,R1),NVLVOLID AND VOLSER @OZ27300 M2925800 B NGKWIT ISSUE MSG AND EXIT INIT @OZ27300 M2925900 SPACE 1 @OZ27300 M2926000 NGCTRKER CVD R1,NGWDBL CONVERT OVFLOW TO DECIMAL @OZ27300 M2926100 L R1,=A(NMSG478) FIND MSG AND ADD @OZ27300 M2926200 MVC NTRKS478-NMSG478(,R1),NGCKDPAT TRACK @OZ27300 M2926300 ED NTRKS478-NMSG478(,R1),NGWDBL+5 EXCESS AND @OZ27300 M2926400 MVC NMVOL478-NMSG478(,R1),NVLVOLID VOLSER @OZ27300 M2926500 B NGKWIT ISSUE MSG AND EXIT INIT @OZ27300 M2926600 SPACE 1 @OZ27300 M2926700 NGCKDPAT DC X'402020202120' EDIT PATTERN FOR MSG472,478 @OZ27300 M2926800 SPACE 1 @OZ35278 M2926900 ***************************************************************@OZ27300 M2927000 * @OZ27300 M2927100 * LOCATE CHECKPOINT DATA SET DEB EXTENTS @OZ35278 M2927200 * @OZ35278 M2927300 * @OZ27300 M2927400 ***************************************************************@OZ27300 M2927500 SPACE 2 @OZ27300 M2927600 NGCKCWI L WD,NVOLTABL RELOAD VOL ALLOC TABL PTR @OZ27300 M2927700 MVC $CKPTUCB,NVLUCBPT STORE CKPT UCB ADDR IN HCT @OZ35278 M2927750 CLC $CHKPT,$SPOOL TEST CKPT = PRIMARY SPOOL @OZ27300 M2927800 BNE NGCKCT1T BR IF NO @OZ35278 M2927900 MVC 2*NVLTBLN(NVLTBLN,WD),0(WD) COPY VOLUME ALLOC @OZ27300 M2928000 MVI 2*NVLTBLN+NVLFLAGS,0 AND RESET REQUEST FLAGS @OZ27300 M2928100 PRINT OFF - SECTION DELETED @OZ35278 M2928200 * THIS CARD DELETED BY APAR @OZ35278 M2928300 * THIS CARD DELETED BY APAR @OZ35278 M2928400 * THIS CARD DELETED BY APAR @OZ35278 M2928500 * THIS CARD DELETED BY APAR @OZ35278 M2928600 * THIS CARD DELETED BY APAR @OZ35278 M2928700 * THIS CARD DELETED BY APAR @OZ35278 M2928800 PRINT ON -- SECTION DELETED @OZ35278 M2928900 EJECT @OZ27300 M2929000 ***************************************************************@OZ27300 M2929100 * @OZ27300 M2929200 * INITIALIZE CHECKPOINT TRACK-1 TABLE @OZ27300 M2929300 * @OZ27300 M2929400 ***************************************************************@OZ27300 M2929500 SPACE 1 @OZ27300 M2929600 * ADDRESSABILITY --- @OZ27300 M2929700 USING UCBDSECT,R3 --- UCB @OZ27300 M2929800 USING NTR1,R4 --- TRACK-1 TABLE ENTRY @OZ27300 M2929900 USING JQBDSECT,R10 --- JQB @OZ27300 M2930000 SPACE 1 @OZ27300 M2930100 NGCKCT1T L R10,$JQB GET JQB ADDRESS @OZ35278 M2930200 SPACE 1 @OZ27300 M2930300 TM $RUNOPTS,$RPS SKIP SETTING TRACK-1 @OZ27300 M2930400 BNO NGCKNRPS SECTOR ADDRESS &RPS=NO @OZ27300 M2930500 SPACE 1 @OZ27300 M2930600 LA R4,NTR1REC1-NTR1SIZE POINT TO TRACK-1 TABLE @OZ27300 M2930700 SLR R0,R0 CLEAR RECORD BYTE TOTAL @OZ27300 M2930800 LA R7,NTR1NMBR LOOP FOR ALL TRK-1 RECS @OZ27300 M2930900 SPACE 1 @OZ27300 M2931000 NGCKNTRL LA R4,NTR1SIZE(,R4) LOCATE NEXT TRACK-1 TABLE @OZ27300 M2931100 L WD,NVOLTABL RELOAD VOL ALLOC TABLE PTR @OZ27300 M2931200 SLL R0,16 RELOAD RECORD BYTE TOTAL @OZ27300 M2931300 IC R0,NTR1REC AND RECORD NUMBER @OZ27300 M2931400 ICM R0,8,=XL1'80' SHOW VARIABLE SIZED RECORDS @OZ27300 M2931500 LA R2,NTR1SEC1 POINT TO SECTOR ADDR AREA @OZ27300 M2931600 SPACE 1 @OZ27300 M2931700 NGCKNTRS L R3,NVLUCBPT PICK UP DEVICE UCB AND @OZ27300 M2931800 TM UCBTBYT2,UCBRPS TEST FOR RPS FEATURE @OZ27300 M2931900 BNO NGCKNTRU BRANCH IF NOT AVAILABLE @OZ27300 M2932000 ICM R2,8,UCBTBYT4 LOAD UCB DEVICE TYPE @OZ27300 M2932100 SPACE 1 @OZ27300 M2932200 STM R14,R12,12(R13) SAVE THE REGISTERS @OZ27300 M2932300 L R15,CVTPTR AND CALL THE SECTOR @OZ27300 M2932400 L R15,CVT0SCR1-CVT(,R15) CONVERT ROUTINE @OZ27300 M2932500 BALR R14,R15 FOR THE PRIMARY @OZ27300 M2932600 LM R14,R12,12(R13) DATASET @OZ27300 M2932700 SPACE 1 @OZ27300 M2932800 NGCKNTRU CLC NVLVOLID,$CHKPT2 TEST FOR SECONDARY PRESENT @OZ27300 M2932900 BE NGCKNTRC BR IF NOT, SKIP ROUTINE @OZ27300 M2933000 LA WD,NVLTBLN(,WD) ELSE BUMP TO 2NDARY NVLTABL @OZ27300 M2933100 LA R2,NTR1SEC2-NTR1SEC1(,R2) PTR & SECTOR ADDRESS @OZ27300 M2933200 B NGCKNTRS AND RE-CALL ROUTINE @OZ27300 M2933300 SPACE 1 @OZ27300 M2933400 NGCKNTRC SRL R0,16 ACCUMULATE @OZ27300 M2933500 AH R0,NTR1RLEN PREVIOUS RECORD @OZ27300 M2933600 SLR R2,R2 DATA AND KEY @OZ27300 M2933700 IC R2,NTR1KEYL LENGTHS @OZ27300 M2933800 ALR R0,R2 ON TRACK @OZ27300 M2933900 BCT R7,NGCKNTRL LOOP TILL TRK-1 TABLE SET @OZ27300 M2934000 EJECT @OZ27300 M2934100 ***************************************************************@OZ27300 M2934200 * @OZ27300 M2934300 * INITIALIZE JQB TRACK-1 CCW SKELETONS @OZ27300 M2934400 * @OZ27300 M2934500 ***************************************************************@OZ27300 M2934600 SPACE 1 @OZ27300 M2934700 USING JQBCCWE,R1 CCW PACKET ADDRESSABILITY @OZ27300 M2934800 SPACE 2 @OZ27300 M2934900 NGCKNRPS L R2,$DADEBAD RE-COMPUTE @OZ27300 M2935000 SLR R14,R14 POINTER @OZ27300 M2935100 IC R14,$NUMDA TO @OZ27300 M2935200 SLL R14,4 CHECKPOINT DATA SET @OZ27300 M2935300 LA R2,DEBBASND-DEBDSECT(R2,R14) DEB EXTENT @OZ27300 M2935400 SPACE 2 @OZ27300 M2935500 * INITIALIZE TRK-1 CCW PACKET CCHHRS AND SECTOR ADDRS @OZ27300 M2935600 SPACE 1 @OZ27300 M2935700 L WD,NVOLTABL RELOAD NVOLTABL ADDRESS @OZ27300 M2935800 LA R1,JQBTRK1 SET LOOP TO INITIALIZE @OZ27300 M2935900 LA R6,JQBTRK1S ALL TRACK-1 CCW PACKETS @OZ27300 M2936000 LA R4,NTR1TABL POINT TO TRACK-1 TABLE @OZ27300 M2936100 SPACE 1 @OZ27300 M2936200 NGCKTR1 MVC JQBCCHHR(4),DEBSTRCC SET ACTUAL RECORD & REC0 @OZ27300 M2936300 MVC JQBCCHH0(4),DEBSTRCC TRACK ADDRESSES (CCHH) @OZ27300 M2936400 MVC JQBCOUNT+4(4),NTR1REC SET RECORD NUMBER, KEY, @OZ27300XM2936500 AND DATA LENGTHS @OZ27300 M2936600 TM $STATUS,$DUPLEX TEST FOR DUPLEX PRESENT @OZ27300 M2936700 BZ NGCKTR1L BR IF NOT, NO 2NDARY ADDR. @OZ27300 M2936800 MVC JQBCCHH2(4),DEBSTRCC+DEBEXLEN ELSE, SET 2NDARY @OZ27300 M2936900 MVC JQBCCHH2+4(1),NTR1REC TRACK RECORD ADDRESS @OZ27300 M2937000 SPACE 1 @OZ27300 M2937100 NGCKTR1L SLR R14,R14 SET PRIMARY AND @OZ27300 M2937200 IC R14,NTR1REC SECONDARY @OZ27300 M2937300 BCTR R14,0 CHECKPOINT @OZ27300 M2937400 MH R14,=AL2(NTR1SIZE) RECORD @OZ27300 M2937500 IC R15,NTR1REC1+NTR1SEC1-NTR1(R14) SECTOR @OZ27300 M2937600 STC R15,JQBCSEC1 ADDRESSES @OZ27300 M2937700 IC R15,NTR1REC1+NTR1SEC2-NTR1(R14) IN CCW @OZ27300 M2937800 STC R15,JQBCSEC2 PACKET @OZ27300 M2937900 SPACE 1 @OZ27300 M2938000 MVC JQBFRW(L'NCCWSKEL),NCCWSKEL SETUP R/W AND TIC @OZ27300 M2938100 MVC CCWLEN+JQBFRW,NTR1RLEN CCW PATTERN @OZ27300 M2938200 SPACE 1 @OZ27300 M2938300 LA R4,NTR1SIZE(,R4) BUMP TO NEXT TRK 1 TABLE @OZ27300 M2938400 LA R1,JQBCNEXT ENTRY AND CCW PACKET @OZ27300 M2938500 BCT R6,NGCKTR1 GO INITIALIZE NEXT PACKET @OZ27300 M2938600 SPACE 1 @OZ27300 M2938700 DROP R4 KILL TRK-1 TABLE BASE @OZ27300 M2938800 DROP R3 KILL UCB ADDRESSABILITY @OZ44388 M2938850 EJECT @OZ27300 M2938900 ***************************************************************@OZ27300 M2939000 * @OZ27300 M2939100 * COMPLETE TRACK-1 CCW PACKETS @OZ27300 M2939200 * @OZ27300 M2939300 ***************************************************************@OZ27300 M2939400 SPACE 1 @OZ27300 M2939500 * BUILD CHANNEL PROGRAM COMPLETION VERIFICATION CCWS @OZ27300 M2939600 SPACE 1 @OZ27300 M2939700 MVC JQBVERP(8*2),NCCWVERP COPY RD-CNT AND NOP CCWS @OZ27300 M2939800 LRA R2,JQBVERFY AND SET READ-COUNT @OZ27300 M2939900 STCM R2,7,JQBVERP+CCWADDR REAL DATA ADDRESS @OZ27300 M2940000 SPACE 1 @OZ27300 M2940100 * BUILD LOCK VERIFICATION PACKET @OZ27300 M2940200 SPACE 1 @OZ27300 M2940300 LA R1,JQBLOCKV LOCATE LOCK-VERIFICATION @OZ27300XM2940400 CCW PACKET @OZ27300 M2940500 SPACE 1 @OZ27300 M2940600 OC JQBLSET,NCCWSETS USE SET SECTOR CCW @OZ27300 M2940700 CLI JQBCSEC1,FF IF RPS FEATURE @OZ27300 M2940800 BNE *+8 AVAILABLE @OZ27300 M2940900 MVI JQBLSET+CCWOP,NOP OTHERWISE USE A NOP @OZ27300 M2941000 LRA R2,JQBCSEC1 INITIALIZE SECTOR @OZ27300 M2941100 STCM R2,7,JQBLSET+CCWADDR REAL ADDRESS @OZ27300 M2941200 OC JQBLSID(8*2),NCCWSID INITIALIZE @OZ27300 M2941300 LRA R2,JQBCCHHR SEARCH ID EQUAL @OZ27300 M2941400 STCM R2,7,JQBLSID+CCWADDR AND @OZ27300 M2941500 LRA R2,JQBLSID TIC *-8 @OZ27300 M2941600 STCM R2,7,JQBLTIC+CCWADDR CCWS @OZ27300 M2941700 MVC JQBLSKEY,NCCWSKEY INITIALIZE @OZ27300 M2941800 LRA R2,JQBKEY SEARCH KEY EQUAL @OZ27300 M2941900 STCM R2,7,JQBLSKEY+CCWADDR CCW @OZ27300 M2942000 MVC JQBLOST(5),NCCWTNXT INITIALIZE TIC @OZ27300 M2942100 LRA R2,JQBLOCKR+JQBCSET-JQBCCWE TO POINT TO @OZ27300 M2942200 STCM R2,7,JQBLOST+CCWADDR LOCK READ PACKET @OZ27300 M2942300 MVC JQBLTNXT(5),NCCWTNXT SET TIC @OZ27300 M2942400 LA R2,JQBLOCK+JQBCSET-JQBCCWE VIRTUAL ADDRESS @OZ27300 M2942500 STCM R2,7,JQBLTIC+5 TO POINT TO @OZ27300 M2942600 LRA R2,0(,R2) LOCK SET / RESET @OZ27300 M2942700 STCM R2,7,JQBLTNXT+CCWADDR CCW PACKET @OZ27300 M2942800 EJECT @OZ27300 M2942900 * COMPLETE FORMAT-WRITE PREFIX PACKETS @OZ27300 M2943000 SPACE 1 @OZ27300 M2943100 LA R1,JQBFMTW LOCATE 1ST FORMAT-WRITE @OZ27300XM2943200 PREFIX PACKET @OZ27300 M2943300 BAL R14,NGCKFMC2 USE FORMAT-WRT PACKET @OZ27300 M2943400 MVI JQBFMT+CCWOP,WRITE+CKD SET FMT-WRITE OPERATION @OZ27300 M2943500 MVI JQBFMT+CCWFLAG,DC WITH DATA CHAINING @OZ27300 M2943550 LRA R2,JQBCOUNT SET COUNT FEILD REAL @OZ27300 M2943600 STCM R2,7,JQBFMT+CCWADDR ADDRESS IN FMT-WRITE @OZ27300 M2943650 LRA R2,JQBCKVAL SET READ CHECK VALUE @OZ38924 M2943700 STCM R2,7,JQBFRW+CCWADDR REAL ADDRESS @OZ38924 M2943750 LA R2,JQBCNEXT+JQBFMT-JQBCCWE SET FIRST FMT-WRT @OZ27300 M2943800 STCM R2,7,JQBFTIC+5 PREFIX PACKET TIC @OZ27300 M2943850 LRA R2,0(,R2) TO POINT TO 2ND @OZ27300 M2943900 STCM R2,7,JQBFTNXT+CCWADDR FMT-WRT PACKET @OZ27300 M2943950 LRA R2,JQBCCHH0 POINT SEARCH-ID TO @OZ27300 M2944000 STCM R2,7,JQBFSID+CCWADDR RECORD ZERO-ID (CCHH0) @OZ27300 M2944050 SPACE 1 @OZ27300 M2944100 LA R1,JQBCNEXT LOCATE 2ND FORMAT-WRITE @OZ27300XM2944150 PREFIX PACKET @OZ27300 M2944200 BAL R14,NGCKFMC2 USE FORMAT-WRT PACKET @OZ27300 M2944250 MVI JQBFMT+CCWOP,WRITE+CKD SET FMT+WRITE OPERATION @OZ27300 M2944300 MVI JQBFMT+CCWFLAG,DC WITH DATA CHAINING @OZ27300 M2944350 LRA R2,JQBCOUNT SET WRITE C-K-D @OZ27300 M2944400 STCM R2,7,JQBFMT+CCWADDR REAL ADDRESS @OZ27300 M2944450 LRA R2,JQBLKEY POINT TO LOCK KEY @OZ27300 M2944500 STCM R2,7,JQBFRW+CCWADDR AND DATA @OZ27300 M2944550 LRA R2,JQBCCHH0 POINT SEARCH-ID TO @OZ27300 M2944600 STCM R2,7,JQBFSID+CCWADDR RECORD ZERO-ID (CCHH0) @OZ27300 M2944650 SPACE 1 @OZ27300 M2944700 LA R2,JQBMSTR+JQBFMT-JQBCCWEL SET TIC AND VIRTUAL @OZ27300 M2944800 STCM R2,7,JQBFTIC+5 ADDRESS TO POINT @OZ27300 M2944900 LRA R2,0(,R2) TO MASTER RECORD @OZ27300 M2945000 STCM R2,7,JQBFTNXT+CCWADDR WRITE C-K-D CCW @OZ27300 M2945100 SPACE 2 @OZ27300 M2945200 * COMPLETE LOCK-READ PACKET @OZ27300 M2945300 SPACE 1 @OZ27300 M2945400 LA R1,JQBLOCKR LOCATE LOCK READ PACKET @OZ27300 M2945500 SPACE 1 @OZ27300 M2945600 BAL R14,NGCKFMC1 SET UP STANDARD R/W PACKET @OZ27300 M2945700 SPACE 1 @OZ27300 M2945800 MVI JQBCRW+CCWOP,READ+KD SET READ KEY & DATA OP, @OZ27300 M2945900 LRA R2,JQBADKEY REAL DATA @OZ27300 M2946000 STCM R2,7,JQBCRW+CCWADDR ADDRESS, AND SURPRESS @OZ27300 M2946100 OI JQBCRW+CCWFLAG,SLI INCORRECT LENGTH @OZ27300 M2946200 LA R3,L'JQBLKEY GET KEY LENGTH @OZ55936 M2946220 STH R3,JQBCRW+CCWLEN SET CCW LENGTH FOR KEY @OZ55936 M2946240 SPACE 1 @OZ27300 M2946300 LA R2,JQBVERP SET TIC TO POINT TO @OZ27300 M2946400 STCM R2,7,JQBCTIC+5 CHANNEL PROGRAM @OZ27300 M2946500 LRA R2,0(,R2) COMPLETION @OZ27300 M2946600 STCM R2,7,JQBCTNXT+CCWADDR VERIFICATION CCWS @OZ27300 M2946700 EJECT @OZ27300 M2946800 * COMPLETE CHECK-RECORD-READ/WRITE PACKET @OZ27300 M2946900 SPACE 1 @OZ27300 M2947000 LA R1,JQBCHECK LOCATE CHECK-RECORD-RD/WRT @OZ27300XM2947100 CCW PACKET @OZ27300 M2947200 SPACE 1 @OZ27300 M2947300 BAL R14,NGCKFMC1 SET UP STANDARD R/W PACKET @OZ27300 M2947400 SPACE 1 @OZ27300 M2947500 LRA R2,JQBCKVAL SET READ CHECK VALUE @OZ27300 M2947600 STCM R2,7,JQBCRW+CCWADDR REAL ADDRESS @OZ27300 M2947700 OI JQBCRW+CCWFLAG,SLI AND SURPRESS LENGTH ERROR @OZ27300 M2947800 SPACE 1 @OZ27300 M2947900 LA R2,JQBVERP SET TIC @OZ27300 M2948000 STCM R2,7,JQBCTIC+5 TO POINT TO @OZ27300 M2948100 LRA R2,0(,R2) CHANNEL PROGRAM @OZ27300 M2948200 STCM R2,7,JQBCTNXT+CCWADDR VERIFICATION @OZ27300 M2948300 SPACE 2 @OZ27300 M2948400 * COMPLETE LOCK-SET/RESET PACKET @OZ27300 M2948500 SPACE 1 @OZ27300 M2948600 LA R1,JQBLOCK LOCATE LOCK READ PACKET @OZ27300 M2948700 SPACE 1 @OZ27300 M2948800 BAL R14,NGCKFMC1 SET UP STANDARD R/W PACKET @OZ27300 M2948900 SPACE 1 @OZ27300 M2949000 MVI JQBCRW+CCWOP,WRITE+KD SET WRITE KEY & DATA, @OZ27300 M2949100 LRA R2,JQBLKEY AND REAL DATA @OZ27300 M2949200 STCM R2,7,JQBCRW+CCWADDR ADDRESS @OZ27300 M2949300 SPACE 1 @OZ27300 M2949400 LA R2,JQBVERP SET TIC TO POINT TO @OZ27300 M2949500 STCM R2,7,JQBCTIC+5 CHANNEL PROGRAM @OZ27300 M2949600 LRA R2,0(,R2) COMPLETION @OZ27300 M2949700 STCM R2,7,JQBCTNXT+CCWADDR VERIFICATION CCWS @OZ27300 M2949800 SPACE 2 @OZ27300 M2949900 * BUILD R/W PACKET FOR MASTER CHECKPOINT RECORD @OZ27300 M2950000 SPACE 1 @OZ27300 M2950100 LA R1,JQBMSTR POINT TO MASTER CCW PACKET @OZ27300 M2950200 SPACE 1 @OZ27300 M2950300 BAL R14,NGCKFMC2 USE FMT-WRT CCW PACKET @OZ27300 M2950400 SPACE 1 @OZ27300 M2950500 LA R14,JQBCHECK+JQBCRW-JQBCCWE SET @OZ27300 M2950600 STCM R14,7,JQBFTIC+5 TIC CCW TO POINT @OZ27300 M2950700 LRA R14,0(,R14) TO CHECK RECORD @OZ27300 M2950800 STCM R14,7,JQBFTNXT+CCWADDR READ CCWS @OZ27300 M2950900 SPACE 2 @OZ27300 M2951000 DROP R10 KILL JQB ADDRESSABILITY @OZ27300 M2951100 EJECT @OZ27300 M2951200 ***************************************************************@OZ27300 M2951300 * @OZ27300 M2951400 * BUILD CCW PACKETS FOR JOB QUEUE AND JOT RECORDS @OZ27300 M2951500 * @OZ27300 M2951600 ***************************************************************@OZ27300 M2951700 SPACE 2 @OZ27300 M2951800 LA R15,JQBIDAWS-JQBDSECT(,R10) STORE @OZ27300 M2951900 LRA R14,0(,R15) REAL ADDRESS OF @OZ27300 M2952000 STCM R14,7,JQBFRW+CCWADDR IDAWS IN READ CCW @OZ27300 M2952100 OI JQBFRW+CCWFLAG,IDA & FLAG FOR IDA @OZ27300 M2952200 SPACE 1 @OZ27300 M2952300 L R10,$MASTER PICK UP MASTER RECORD AREA @OZ27300 M2952400 L R0,$MASTERL ADDRESS AND LENGTH @OZ27300 M2952500 NGCKCWIL LRA R14,0(,R10) GET REAL ADDRESS OF AREA @OZ27300 M2952600 ST R14,0(,R15) STORE IT IN IDAW @OZ27300 M2952700 LA R10,2048(,R10) BUMP TO NEXT @OZ27300 M2952800 SH R0,=H'2048' 2K BLOCK @OZ27300 M2952900 LA R15,4(,R15) AND NEW IDAW @OZ27300 M2953000 BP NGCKCWIL LOOP TILL ALL DATA ADDRESSD @OZ27300 M2953100 SPACE 2 @OZ27300 M2953200 * BUILD CCW PACKETS FOR JOB QUEUE AND JOT RECORDS @OZ27300 M2953300 SPACE 1 @OZ27300 M2953400 LH R7,$JOBRECN COMPUTE TOTAL CCW AREAS @OZ27300 M2953500 AH R7,$JOTRECN TO INITIALIZE @OZ27300 M2953600 L R10,$JOBQPTR PICK UP JOB QUEUE ADDRESS @OZ27300 M2953700 ICM R1,B'1000',=X'80' FORCE NEXT TRACK @OZ27300 M2953800 SPACE 1 @OZ27300 M2953900 NGCKCWIK LR WC,WD POINT TO NVOLTBL ENTRY @OZ27300 M2954000 L R3,NVLUCBPT AND UCB @OZ27300 M2954100 LA R15,JQBCCHHR USE PREVIOUS PRIMARY CCHHR @OZ27300 M2954200 BAL R14,NGCKNTRK TO CREATE NEW CCHHR @OZ27300 M2954300 SPACE 1 @OZ27300 M2954400 TM $STATUS,$DUPLEX TEST FOR $CHKPT2 ALLOCATED @OZ27300 M2954500 BZ NGCKCWI2 BRANCH IF NOT @OZ27300 M2954600 LA WC,NVLTBLN(,WC) POINT TO 2NDARY NVOL @OZ27300 M2954700 L R3,NVLUCBPT-NVLDSECT(,WC) ENTRY AND UCB @OZ27300 M2954800 LA R15,JQBCCHH2 USE PREVIOUS SECONDARY @OZ27300 M2954900 BAL R14,NGCKNTRK CCHHR TO CREATE NEW CCHHR @OZ27300 M2955000 EJECT @OZ27300 M2955100 NGCKCWI2 LA R1,JQBCNEXT BUMP TO NEXT CCW AREA AND @OZ27300XM2955200 RESET FORCE NXT TRK BIT @OZ27300 M2955300 BAL R14,NGCKFMC2 FORMAT CCW PACKET @OZ27300 M2955400 SPACE 1 @OZ27300 M2955500 LRA R14,0(,R10) STORE REAL ADDRESS OF @OZ27300 M2955600 STCM R14,7,JQBFRW+CCWADDR AREA IN READ CCW @OZ27300 M2955700 SPACE 1 @OZ27300 M2955800 LA R2,JQBCNEXT GET ADDR OF NEXT SEEK CCW @OZ27300 M2955900 CLC JQBCRECN,NVLTNRT+1 TEST RECORD POSITION @OZ27300 M2956000 BE NGCKCWI3 BR IF LAST RECORD ON TRK @OZ27300 M2956050 LA R2,JQBCNEXT+(JQBFRW-JQBCCWE) ELSE USE R/W ADDR @OZ27300 M2956100 SPACE 1 @OZ27300 M2956150 NGCKCWI3 STCM R2,7,JQBFTIC+5 STORE VIRTUAL AND @OZ27300 M2956200 LRA R2,0(,R2) REAL ADDRESSES @OZ27300 M2956300 STCM R2,7,JQBFTNXT+CCWADDR OF NEXT CCW PACKET @OZ27300 M2956400 SPACE 1 @OZ27300 M2956500 OC JQBFRW(L'NCCWSKEL),NCCWSKEL ADD CCW SKELETON @OZ27300 M2956600 MVC JQBCLEN,JQBFRW+CCWLEN COPY RCD LENGTH TO COUNT @OZ27300 M2956700 MVC JQBCCHH0(4),JQBCCHHR AND SET RECORD 0 ID @OZ27300 M2956800 SPACE 1 @OZ27300 M2956900 LA R10,2048(,R10) BUMP TO NEXT @OZ27300 M2957000 LA R10,2048(,R10) DATA AREA PAGE @OZ27300 M2957100 BCT R7,NGCKCWIK LOOP TILL ALL CCWS BUILT @OZ27300 M2957200 SPACE 2 @OZ27300 M2957300 L R10,$JQB RELOAD JQB POINTER AND @OZ27300 M2957400 USING JQBDSECT,R10 SHOW ADDRESSABILITY @OZ27300 M2957500 SPACE 1 @OZ27300 M2957600 LA R2,JQBVERP TERMINATE CHAIN @OZ27300 M2957700 STCM R2,7,JQBFTIC+5 BY POINTING LAST TIC CCW @OZ27300 M2957800 LRA R2,0(,R2) TO CHANNEL PGM COMPLETION @OZ27300 M2957900 STCM R2,7,JQBFTNXT+CCWADDR VERIFICATION CCWS @OZ27300 M2958000 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION ENVCM2958100 IRONMENT DETERMINATION' @OZ27300 M2958200 ***************************************************************@OZ27300 M2958300 * @OZ27300 M2958400 * E N V I R O N M E N T D E T E R M I N A T I O N @OZ27300 M2958500 * @OZ27300 M2958600 ***************************************************************@OZ27300 M2958700 SPACE 1 @OZ27300 M2958800 * RESERVE AND LOCK AGAINST THE PRIMARY CHECKPOINT @OZ27300 M2958900 SPACE 1 @OZ27300 M2959000 NVIRON L R3,NVLUCBPT LOAD POINTER TO PRMRY UCB @OZ27300 M2959100 SPACE 1 @OZ27300 M2959200 STCK $SIDTIME OBTAIN CURRENT TIME-OF-DAY @OZ27300 M2959300 SPACE 1 @OZ27300 M2959400 OI JQBLKEY,X'80' USE INITIALIZATION LOCK @OZ27300 M2959500 SPACE 1 @OZ27300 M2959600 LA R1,JQBLOCKV SET UP JQB @OZ27300 M2959700 ST R1,JQBSTART FOR LOCK SET EXCP @OZ27300 M2959800 MVI JQBFLAG1,JQB1PRIM+JQB1LOCK+JQB1INIT+JQB1FMT @OZ27300XM2959900 INITIALIZE JQB STATUS FLAG @OZ27300 M2960000 SPACE 1 @OZ27300 M2960100 LH R2,$RETRYCT PICK UP ERROR RETRY COUNT @OZ27300 M2960200 LA R2,1(,R2) INCREMENT BY 1 @OZ27300 M2960300 STH R2,JQBERRCT STORE IN JQB @OZ27300 M2960400 SPACE 1 @OZ27300 M2960500 TM $OPTSTAT,$OPTALTC ALTCKPT OPTION @OZ27300 M2960600 BZ NVIRONI IS INVALID @OZ27300 M2960700 TM $OPTSTAT,$OPTCOLD+$OPTFMT DURING A @OZ27300 M2960800 BZ NVIRONI COLD START @OZ27300 M2960900 L R1,=A(NMSGBALT) ISSUE @OZ27300 M2961000 MVC NM487STR-NMSGBALT(,R1),=CL4'COLD' MESSAGE AND @OZ27300 M2961100 B NGKWIT TERMINATE @OZ27300 M2961200 SPACE 1 @OZ27300 M2961300 NVIRONI LA R1,$RSVECB COMPLETE ECBLIST LIST @OZ35278 M2961400 STCM R1,7,$RSVECBA+1 FOR $RESERVE PROCESSING @OZ35278 M2961500 $RESERVE REQUEST CHECKPOINT RESERVE @OZ35278 M2961600 BZ NVRDCKP BR IF OBTAINED RESERVE @OZ35278 M2961700 WAIT 1,ECB=$RSVECB ELSE WAIT FOR IT @OZ35278 M2961800 PRINT OFF - SECTION DELETED @OZ35278 M2961900 * THIS CARD DELETED BY APAR @OZ35278 M2962000 PRINT ON -- SECTION DELETED @OZ35278 M2962100 SPACE 1 @OZ35278 M2962200 NVRDCKP L R1,$SSVT SHOW RESERVED @OZ35278 M2962300 OI $SVSTUS-SSVT(R1),$SVSTIRV BY INITIALIZATION @OZ35278 M2962400 EJECT @OZ27300 M2962500 LA R2,30 ALLOW 30 RETRIES (30 SECS) @OZ27300 M2962600 SLR WE,WE SET FIRST TIME SWITCH @OZ27300 M2962700 SPACE 1 @OZ27300 M2962800 NVIRESV BAL R14,NGEXCP ATTEMPT TO RESERVE AND LOCK @OZ27300XM2962900 PRIMARY CHECKPOINT @OZ27300 M2963000 BNZ NVIRNLOK BRANCH IF I/O ERROR @OZ27300 M2963100 SPACE 1 @OZ27300 M2963200 CLC JQBVERFY,NGCKFFFF TEST FOR EXCP COMPLETE @OZ27300 M2963300 BE NVIRWAIT BRANCH IF NOT @OZ27300 M2963400 SPACE 1 @OZ27300 M2963500 CLI JQBADKEY,FF TEST FOR CKPT LOCK OBTAINED @OZ27300 M2963600 BE NVIRGLOK BRANCH IF YES @OZ27300 M2963700 SPACE 1 @OZ27300 M2963710 L R1,$QSE1 BYPASS CKPT-WAIT @OZ27300 M2963720 TM QSEFLAGS-QSEDSECT(R1),QSELAST LOOP IF NOT @OZ27300 M2963730 BO NVIRNLKM MULTI-ACCESS @OZ27300 M2963740 CLC $SIDBUSY,JQBADKEY SPOOL, OR IF @OZ27300 M2963750 BE NVIRNLKM WE OWNED LOCK @OZ27300 M2963760 SPACE 1 @OZ27300 M2963800 NVIRWAIT LTR WE,WE FIRST TIME THRU HERE... @OZ27300 M2963900 BNZ NVIRTIME BR IF NO (MSG ISSUED) @OZ27300 M2964000 $$WTO NVLCKMSG WARN OPERATOR OF DELAY @OZ27300 M2964100 LA WE,1 RESET FIRST TIME SWITCH @OZ27300 M2964200 SPACE 1 @OZ27300 M2964300 NVIRTIME LA R1,100 WAIT (100/100) @OZ27300 M2964400 ST R1,NGWDBL = 1 SECOND @OZ27300 M2964500 STIMER WAIT,BINTVL=NGWDBL BEFORE EACH RETRY @OZ27300 M2964600 SPACE 1 @OZ27300 M2964700 BCT R2,NVIRESV RETRY LOCKING OPERATION @OZ27300 M2964800 SPACE 2 @OZ27300 M2964900 NVIRNLOK CLI NGECB,X'7F' BYPASS MESSAGE IF @OZ27300 M2965000 BE NVIRNLKM I/O ERROR AND @OZ27300 M2965100 TM $OPTSTAT,$OPTCOLD+$OPTFMT OPERATOR SPECIFIED @OZ27300 M2965200 BO NVIRGLOK COLD START @OZ27300 M2965300 SPACE 1 @OZ27300 M2965400 L WA,=A(NMSGNLOK) GET MSG AREA @OZ51129 M2965500 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965505 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965510 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965520 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965540 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965560 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965580 B NVIRNMSG ISSUE I/O ERROR MSG @OZ51129 M2965600 NVIRNLKM L WA,=A(NMSGNLOK) GET MSG AREA @OZ51129 M2965620 MVC NMSGLKID-NMSGNLOK(,WA),=CL4'SID=' BUILD @OZ51129 M2965640 MVC NMSGLSID-NMSGNLOK(,WA),JQBLRDIN $SID IN MSG @OZ55936 M2965660 CLI JQBADKEY,X'80' IS IT INITIALIZATION... @OZ55936 M2965680 BNE NVIRNMSG NO, ISSUE MESSAGE @OZ55936 M2965700 MVC NMSGINIT-NMSGNLOK(,WA),=CL14'INITIALIZATION' @OZ55936 M2965720 NVIRNMSG BAL WE,NGWTOR TELL OP UNABLE TO GET LOCK @OZ55936 M2965740 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965760 * THIS LINE DELETED BY APAR NUMBER @OZ51129 M2965780 BNE NGQUITT BRANCH IF REPLY 'N' - EXIT @OZ27300 M2965800 SPACE 1 @OZ27300 M2965900 * CONTINUE WITHOUT DASD LOCK IF OPERATOR REPLIES 'Y' @OZ27300 M2966000 SPACE 1 @OZ27300 M2966100 OI $CKPTFLG,$CKPLOKB SHOW OPERATOR BYPASSED LOCK @OZ27300 M2966200 EJECT @OZ27300 M2966300 ***************************************************************@OZ27300 M2966400 * @OZ27300 M2966500 * ATTEMPT TO READ CHECKPOINT SPECIFIED BY THE @OZ27300 M2966600 * OPERATOR (PRMCKPT/ALTCKPT) @OZ27300 M2966700 * @OZ27300 M2966800 ***************************************************************@OZ27300 M2966900 SPACE 1 @OZ27300 M2967000 NVIRGLOK OI JQBFLAG1,JQB1LOKD SHOW LOCK OBTAINED @OZ27300 M2967100 NI JQBFLAG1,FF-JQB1LOCK RESET LOCK OPERATION FLAG @OZ27300 M2967200 TM $OPTSTAT,$OPTALTC TEST OPERATOR SPECIFICATION @OZ27300 M2967300 BNO NVIRPRIM BRANCH IF NOT ALTCKPT @OZ27300 M2967400 TM $STATUS,$DUPLEX TEST FOR ALTERNATE CKPT @OZ27300 M2967500 BO NVIRALTC BRANCH IF AVAILABLE @OZ27300 M2967600 SPACE 1 @OZ27300 M2967700 L R1,=A(NMSGNALT) TELL OPERATOR '&CKHPT2 NOT @OZ27300 M2967800 B NGKWIT SPECIFIED' AND EXIT INIT @OZ27300 M2967900 SPACE 1 @OZ27300 M2968000 NVIRALTC LA WD,NVLTBLN(,WD) SWITCH TO ALTERNATE CKPT @OZ27300 M2968100 BAL R14,NGCKSWAP NVOLTBL ENTRY AND SWAP @OZ27300 M2968200 BAL R14,NGCKADJ AND ADJUST CCW CHAIN @OZ27300 M2968300 SPACE 1 @OZ27300 M2968400 * SET EXCP TO READ CHECK AND MASTER RECORDS @OZ27300 M2968500 SPACE 1 @OZ27300 M2968600 NVIRPRIM LA R1,JQBMSTR LOCATE MASTER RECORD PACKET @OZ27300 M2968700 SPACE 1 @OZ27300 M2968800 LA R2,QSELEN COMPUTE LENGTH MINIMUM @OZ27300 M2968900 MH R2,$QSENO TO READ MASTER @OZ27300 M2969000 LA R2,$SAVELEN(,R2) RECORD (HCT + QSES) AND @OZ27300 M2969100 STH R2,JQBFRW+CCWLEN STORE IN CCW @OZ27300 M2969200 OI JQBFRW+CCWFLAG,SLI LENGTH ERROR SURPRESSED @OZ27300 M2969300 SPACE 1 @OZ27300 M2969400 MVI JQBFMT+CCWOP,READ+CKD SET UP CCW TO READ @OZ27300 M2969500 LRA R2,JQBCOUNT MASTER RECORDS @OZ27300 M2969600 STCM R2,7,JQBFMT+CCWADDR COUNT, KEY, AND DATA @OZ27300 M2969800 SPACE 1 @OZ27300 M2970000 MVI JQBCRECN,2 LOCK RECORD 'R' IS USED BY THE @OZ27300XM2970500 SRCH-ID TO ALLOW READ C-K-D TO @OZ27300XM2971000 READ MASTER RECORD COUNT FEILD @OZ27300 M2971500 SPACE 1 @OZ27300 M2972000 LA R2,JQBCHECK+JQBCSET-JQBCCWE SET TIC TO POINT @OZ27300 M2972500 STCM R2,7,JQBFTIC+5 TO CHECK RECORD @OZ27300 M2973000 LRA R2,0(,R2) READ @OZ27300 M2973100 STCM R2,7,JQBFTNXT+CCWADDR CCWS @OZ27300 M2973200 SPACE 1 @OZ27300 M2973300 LA R2,JQBFSID SET EXCP TO BEGIN @OZ27300 M2973500 ST R2,JQBSTART WITH MASTER RECORD SRCH-ID @OZ27300 M2974000 OI JQBFLAG1,JQB1READ AND SHOW READ OPERATION @OZ27300 M2974500 EJECT @OZ27300 M2975000 BAL R14,NGEXCP PERFORM READ @OZ27300 M2975500 SPACE 1 @OZ27300 M2976000 SLR R3,R3 SAVE READ @OZ27300 M2976500 ICM R3,3,JQBCLEN RECORD SIZE @OZ27300 M2977000 SPACE 1 @OZ27300 M2977500 NI JQBFLAG1,FF-JQB1READ SHOW READ COMPLETE @OZ27300 M2978000 SPACE 1 @OZ27300 M2978500 L R2,$MASTERL RESTORE ACTUAL MASTER @OZ27300 M2979000 STH R2,JQBFRW+CCWLEN RECORD LENGTH AND @OZ27300 M2979500 NI JQBFRW+CCWFLAG,FF-SLI ALLOW LENGTH ERROR @OZ27300 M2980000 SPACE 1 @OZ27300 M2980500 * THIS CARD DELETED BY APAR @OZ35278 M2980600 MVC JQBCRECN(4),NTR1MSTR+NTR1REC-NTR1 RESTORE COUNT @OZ27300 M2981000 SPACE 1 @OZ27300 M2981500 LRA R2,JQBFRW RESET READ C-K-D @OZ27300 M2982000 STCM R2,7,JQBFMT+CCWADDR TO A TIC *+8 FOR @OZ27300 M2982500 MVI JQBFMT+CCWOP,TIC FURTHER READS @OZ27300 M2983000 SPACE 1 @OZ27300 M2983500 LA R2,JQBCCWS RECHAIN @OZ27300 M2984000 STCM R2,7,JQBFTIC+5 MASTER RECORD PACKET @OZ27300 M2984500 LRA R2,0(,R2) TO OTHER CHECKPOINT @OZ27300 M2985000 * THIS CARD DELETED BY APAR @OZ35278 M2985100 STCM R2,7,JQBFTNXT+CCWADDR RECORD PACKETS @OZ27300 M2985200 SPACE 1 @OZ27300 M2985500 CLI NGECB,X'7F' TEST I/O COMPLETION @OZ27300 M2986000 BNE NGTEST BRANCH IF I/O ERROR @OZ27300 M2986500 SPACE 1 @OZ27300 M2987000 CLC JQBVERFY,NGCKFFFF VERIFY I/O OPERATION @OZ27300 M2987100 BE NGTEST BRANCH IF INTERRUPTED @OZ27300 M2987200 SPACE 1 @OZ27300 M2987300 L R2,$MASTER COMPARE MASTER @OZ37386 M2987500 CLC JQBCKVAL,$WCHECK-$SAVEBEG(R2) AND CHECK RECORD @OZ37386XM2988000 WRT CHECK VALUES @OZ27300 M2988500 BE NGCKVOK BRANCH IF SAME @OZ27300 M2989000 SPACE 1 @OZ27300 M2989500 TM $OPTSTAT,$OPTCOLD+$OPTFMT TEST FOR COLD START @OZ27300 M2990000 BNZ NGCKVOK OR FORCE FMT, BR IF YES @OZ44167 M2990500 SPACE 1 @OZ27300 M2990700 L WA,=A(NMSGBADC) POINT TO MESSAGE @OZ27300 M2990900 MVC NMVOL486-NMSGBADC(,WA),NVLVOLID MOVE IN VOLSER @OZ27300 M2991000 BAL WE,NGWTOR ISSUE MESSAGE AND GET REPLY @OZ27300 M2991200 BNE NGQUITT BRANCH IF REPLY 'N' - EXIT @OZ27300 M2991400 SPACE 1 @OZ27300 M2991500 * IF OPERATOR REPLIES 'Y' CONTINUE WITH DAMAGED @OZ27300 M2992000 * CHECKPOINT DATA SET @OZ27300 M2992500 SPACE 2 @OZ27300 M2993000 OI $CKPTFLG,$CKPDAMG SHOW SYSTEM UP WITH A @OZ27300XM2993500 DAMAGED CHECKPOINT @OZ27300 M2993550 LA R1,JQBMSTR FIND MASTER RECORD PACKET @OZ37386 M2993560 SPACE 2 @OZ27300 M2993600 EJECT @OZ27300 M2993650 * @OZ27300 M2993700 * CONFIRM THAT SUFFICIENT DATA WAS READ TO POTENTIALLY @OZ27300 M2993750 * REPRESENT A HASP CHECKPOINT RECORD. @OZ27300 M2993800 * @OZ27300 M2993850 SPACE 1 @OZ27300 M2993900 NGCKVOK CH R3,JQBFRW+CCWLEN COMPARE ACTUAL RECORD SIZE @OZ27300XM2993950 WITH SIZE READ ATTEMPTED @OZ27300 M2994000 BL NGTEST BR IF RECORD TO SMALL @OZ27300 M2994050 PRINT OFF - SECTION DELETED @OZ27300 M2994500 * THIS CARD DELETED BY APAR @OZ27300 M2995000 * THIS CARD DELETED BY APAR @OZ27300 M2995500 * THIS CARD DELETED BY APAR @OZ27300 M2996000 * THIS CARD DELETED BY APAR @OZ27300 M2996500 * THIS CARD DELETED BY APAR @OZ27300 M2997000 * THIS CARD DELETED BY APAR @OZ27300 M2997500 PRINT ON -- SECTION DELETED @OZ27300 M2998000 * M2998500 * CONFIRM THE EXISTENCE OF A HASP CHECKPOINT RECORD @OZ20010 M2999000 * M2999500 L R1,$MASTER POINT TO HCT VARIABLES @OZ27300 M3000000 CLC $HASPID,$HASPID-$SAVEBEG(R1) Q. IF -JES2- R4 M3000500 BNE NGTEST BR. IF NO -- TEST START REQUEST M3001000 TM $CKPTFLG-$SAVEBEG(R1),$CKPNODL NODAL WARMSTART @OZ43161 M3001020 BO NFQSEONE BR IF NO @OZ35996 M3001040 SPACE 2 @OZ27300 M3001100 * @OZ20010 M3001200 * CHECK FOR OTHER ACTIVE SYSTEMS @OZ20010 M3001400 * @OZ20010 M3001500 SPACE 1 @OZ20010 M3001700 MVI $ESYSQSE,X'80' ASSUME SINGLE SYSTEM WARM START R4 M3002000 L R2,$SSVT POINT TO SSVT R41 M3002100 TM $SVHASP-SSVT(R2),X'80' TEST FOR JES2 RESTART R41 M3002200 BO NFSYSACT BR IF YES R41 M3002300 L R0,$SIDTIME LOAD FIRST WORD (SECONDS) M3002500 SL R0,$SYNCTOL MINUS SYNCHRONIZATION TOLERANCE R4 M3003000 L R1,$QSE1 LOCATE FIRST QSE R4 M3003500 LH R2,$QSENO PICK UP NUMBER OF SYSTEMS @OZ20010 M3003750 LA R3,QSELEN GET QSE LENGTH @OZ27300 M3004000 USING QSEDSECT,R1 M3004500 NFQSETST TM QSESTAT,QSEACTIV TEST FOR ACTIVE SYSTEM R4 M3005000 BZ SKIP750 BR IF NO R4 M3005500 CL R0,QSESITIM TEST AGE OF CHECKPOINT DATA R4 M3006000 BNH NFSYSACT BR. IF SYSTEM NOT DORMANT M3006500 SKIP750 TM QSEFLAGS,QSELAST Q. IF LAST QSE M3007000 BNZ NFQSENAC BR IF YES, VERIFY SYS RESET @OZ20010 M3007500 ALR R1,R3 STEP TO NEXT QSE @OZ20010 M3007600 BCT R2,NFQSETST CHECK ALL KNOWN SYSTEMS @OZ20010 M3007700 B NFSYSACT ASSUME UNKNOWN SYSTEM ACTIVE@OZ20010 M3008000 EJECT R4 M3008500 * M3009000 * NO SYSTEM SHARING THE CHECKPOINT FILE IS ACTIVE. M3009500 * M3010000 NFQSENAC L R1,$QSE1 LOCATE FIRST QSE @OZ20010 M3010500 TM QSEFLAGS,QSELAST Q. IF NO SHARED SYSTEM M3011000 BO NFQSEONE BR. IF YES - BYPASS CONFIRMATION M3011500 * M3012000 * FORCE THE OPERATOR TO CONFIRM THAT ALL SYSTEMS M3012500 * SHARING THE CHECKPOINT FILE ARE DORMANT. M3013000 * M3013500 L R2,=A(NMSG419) POINT TO WTOR MESSAGE TEXT M3016500 NFQSEMSG TM QSESTAT,QSEACTIV TEST FOR ACTIVE SYSTEM R4 M3017000 BZ NFQSENXT BR IF NO R4 M3017500 CLC QSESID,$SID TEST FOR THIS SYSTEM R4 M3018000 BE NFQSENXT BR IF YES R4 M3018500 MVC NMSG419A-NMSG419+1(,R2),QSESID PUT CPU ID IN MSG. M3019000 LA R2,5(,R2) STEP TO NEXT MESSAGE SLOT M3019500 NFQSENXT TM QSEFLAGS,QSELAST TEST FOR LAST QSE R4 M3020000 LA R1,0(R3,R1) STEP TO NEXT QSE R4 M3020500 BZ NFQSEMSG BR. IF NOT AT END OF QSE ELEMENTS M3021000 CL R2,=A(NMSG419) TEST FOR ACTIVE SYSTEM(S) R4 M3021500 BE NFQSEONE BR IF NO R4 M3022000 MVI NMSG419A-NMSG419(R2),C'.' SET PERIOD AT END OF MSG M3022500 L R1,=A(NMSG419) POINT TO WTOR MESSAGE TEXT M3023000 LA R2,NMSG419A-(NMSG419+7)(,R2) STEP TO END OF MESSAGE M3023500 SLR R2,R1 COMPUTE MESSAGE LENGTH M3024000 STH R2,8(,R1) STORE INTO WTOR MESSAGE HEADER M3024500 L WA,=A(NMSG419) POINT TO 'CONFIRM RESET' MSG R41 M3025000 BAL WE,NGWTOR QUERY OPERATOR R41 M3025500 BNE NFSYSACT BR IF REPLY 'NO' R41 M3026000 SPACE 1 R41 M3026500 NFQSEONE TM $OPTSTAT,$OPTCOLD+$OPTFMT Q. IF COLD OR FORMAT REQ. M3030000 BNZ NGCOLD BR. IF YES M3030500 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION FORCM3031000 WARM START' R4 M3031500 *********************************************************************** M3032000 * * M3032500 * W A R M S T A R T * M3033000 * * M3033500 *********************************************************************** M3034000 * * M3034500 * A WARM START AT THIS POINT IS A COMPLEX WARM START AND * M3035000 * WILL RESULT IN A TRACK GROUP BIT MAP RECONSTRUCTION. * M3035500 * * M3036000 MVI $ESYSQSE,X'00' NOTE COMPLEX WARM START M3036500 * M3037000 * ENTRY AT THIS POINT WILL WARM START A SINGLE SYSTEM WHILE M3037500 * OTHER ACTIVE SYSTEMS ARE SHARING THE CHECKPOINT FILE M3038000 * M3038500 NFSYSACT TM $OPTSTAT,$OPTCOLD+$OPTFMT COLD/FORMAT START... R41 M3039000 BNZ NGT040 BR IF YES R41 M3039500 L R1,$QSE1 LOCATE 1ST QSE R41 M3040000 LA R4,QSELEN GET QSE LENGTH @OZ27300 M3040500 L R2,=A(NS1) LOCATE SYSTEM PARAMETER TABLE R41 M3041000 SPACE 1 M3043500 NFSYSCHK CLC $SID,QSESID Q. IF QSE SID MATCHES SMF SID M3044000 BNE *+6 BR. IF NO M3044500 LR R3,R1 SAVE QSE ADDRESS FOR THIS SYSTEM M3045000 CLC QSESID,0(R2) Q. QSE MATCHES PARAMETER TABLE M3045500 BNE NFSYSERR BR. IF NO -- TELL OPERATOR M3046000 LA R2,L'NS1(,R2) STEP TO NEXT PARAMETER TABLE SLOT M3046500 TM QSEFLAGS,QSELAST Q. IF AT LAST QSE M3047000 LA R1,0(R4,R1) STEP TO NEXT QSE R4 M3047500 BZ NFSYSCHK CONTINUE TO CHECK IF NOT AT END M3048000 LR R1,R3 RESTORE QSE ADDR FOR THIS SYSTEM M3048500 CLI 0(R2),C' ' Q. IF AT END OF PARAMETER TABLE M3049000 BE NFSTARTM BR IF YES @OZ41702 M3049500 SPACE 1 @OZ41702 M3049550 NFSYSERR L R1,=A(NVALMSG) 'SYS PARAMETER TABLE ERROR' @OZ41702 M3049600 B NGKWIT BR TO TELL OPER AND QUIT @OZ41702 M3049650 SPACE 1 @OZ41947 M3049700 USING SSVT,R2 PROVIDE SSVT ADDRESSABILITY @OZ41702 M3049750 SPACE 1 @OZ41702 M3049800 NFSTARTM L R2,$SSVT POINT TO SSVT @OZ41702 M3049850 L WC,=A(NSTRTMSG) POINT TO TYPE-OF-START MSG @OZ41702 M3049900 MVC NSTRTSSN(,WC),$SVSSNM SET SUBSYSTEM NAME @OZ41702 M3049950 LA WC,NSTRTEXT(,WC) POINT TO MAIN MSG AREA @OZ41702 M3050000 LA R14,NSTRWARM ASSUME MSG @OZ41702 M3050050 LA R15,L'NSTRWARM-1 FOR WARM-START @OZ41702 M3050100 L WF,$QSE1 POINT TO 1ST QSE @OZ41702 M3050150 TM QSEFLAGS-QSEDSECT(WF),QSELAST MULT-ACC SPOOL.. @OZ41702 M3050200 BO NFSTTYPE BR IF NO @OZ41702 M3050250 TM $ESYSQSE,X'80' NODAL (ALL-SYS) WARMSTART...@OZ41702 M3050300 BO NFSTNNOD BR IF NO @OZ41702 M3050350 MVC 0(L'NSTRASYS,WC),NSTRASYS ELSE SET @OZ41702 M3050400 LA WC,L'NSTRASYS(,WC) 'ALL-SYSTEM' @OZ41702 M3050450 B NFSTMSG BR TO CONTINUE @OZ41702 M3050500 EJECT @OZ41947 M3050550 NFSTNNOD MVC NSTRSYSN,$SID SET SYSTEM ID @OZ41702 M3050600 MVC 0(L'NSTRSYS,WC),NSTRSYS INTO MESSAGE @OZ41702 M3050650 LA WC,L'NSTRSYS(,WC) BUMP PAST SYSTEM ID @OZ41702 M3050700 SPACE 1 @OZ41702 M3050750 NFSTTYPE TM $SVHASP,X'80' HOT-START... @OZ41702 M3050800 BZ NFSTCHKQ BR IF NO @OZ41702 M3050850 CLC $SID,$SVSID NEW SID MATCH OLD SID... @OZ41947 M3050870 BE NFSTHOTM BR IF YES @OZ41947 M3050890 $$WTO NOHOTMSG ELSE DENY HOT START @OZ41947 M3050900 B NGQUITT AND EXIT @OZ41947 M3050920 SPACE 1 @OZ41947 M3050930 NFSTHOTM LA R14,NSTRHOT REPLACE @OZ41947 M3050940 LA R15,L'NSTRHOT-1 WITH HOT-START MSG @OZ41702 M3050950 B NFSTMSG AND BR TO CONTINUE @OZ41702 M3051000 SPACE 1 @OZ41702 M3051050 NFSTCHKQ TM QSESTAT,QSEQUICK THIS SYS ALREADY WARM... @OZ41702 M3051100 BZ NFSTMSG BR IF NO @OZ41702 M3051150 LA R14,NSTRQUIK ELSE REPLACE @OZ41702 M3051200 LA R15,L'NSTRQUIK-1 WITH QUICK-START MSG @OZ41702 M3051250 SPACE 1 @OZ41702 M3051300 NFSTMSG EX R15,NFSTMOVE MOVE START-TYPE INTO MSG @OZ41702 M3051350 LA WC,1(R15,WC) BUMP PAST START-TYPE @OZ41702 M3051400 MVC 0(L'NSTRINP,WC),NSTRINP FINISH MESSAGE @OZ41702 M3051450 $$WTO NSTRTMSG INFORM OPERATOR @OZ41702 M3051500 LR R1,R3 RELOAD QSE ADDRESS @OZ41702 M3051550 B NFSYSQSE BR TO CONTINUE @OZ41702 M3051600 SPACE 2 @OZ41702 M3051650 NFSTMOVE MVC 0(*-*,WC),0(R14) *** EXECUTE ONLY *** @OZ41702 M3051700 SPACE 1 @OZ41702 M3051750 NSTRSYS DC C'SYSTEM-****' SPECIFIC-SYSTEM TEXT @OZ41702 M3051800 NSTRSYSN EQU *-4,4 SID INSERT @OZ41702 M3051850 NSTRASYS DC C' ALL-SYSTEM' NODAL-START TEXT @OZ41702 M3051900 NSTRQUIK DC C' QUICK-START' QUICK TEXT @OZ41702 M3051950 NSTRHOT DC C' HOT-START' HOT TEXT @OZ41702 M3052000 NSTRWARM DC C' WARM-START' WARM TEXT @OZ41702 M3052050 NSTRINP DC C' IS IN PROGRESS' ENDING TEXT @OZ41702 M3052100 EJECT @OZ41702 M3052200 NFSYSQSE STCK $SIDTIME OBTAIN CURRENT TIME OF DAY @OZ41702 M3052250 TM QSESTAT,QSEACTIV THIS SYSTEM MARKED ACTIVE...@OZ41702 M3052300 BO NFSYSUP BR IF YES @OZ35996 M3052500 TM $SVHASP,X'80' HOTSTARTING... @OZ35996 M3052600 BZ NFSYSQOK BR IF NO @OZ35996 M3052700 B NFSYSXIT ELSE QUIT @OZ35996 M3052800 SPACE 1 @OZ35996 M3052900 NFSYSUP L R0,$SIDTIME LOAD TIME IN SECONDS @OZ35996 M3053000 SL R0,$SYNCTOL MINUS SYNCHRONIZATION TOLERANCE R4 M3053500 CL R0,QSESITIM Q. IF THIS SYSTEM IS ACTIVE M3054000 BH NFSYSQOK BR. IF NO -- CONTINUE WARM START M3054500 L WC,$QSE1 LOCATE 1ST QSE @OZ35996 M3054600 TM QSEFLAGS-QSEDSECT(WC),QSELAST MAS... @OZ35996 M3054700 BO NFSYSQOK BR IF NO @OZ35996 M3054800 L WF,$MASTER GET MASTER RECORD @OZ43161 M3054850 TM $CKPTFLG-$SAVEBEG(WF),$CKPNODL NODAL WARMSTART @OZ43161 M3054900 BO NFSYSQOK BR IF NO @OZ35996 M3055000 IC WF,QSESTAT GET ID OF SYSTEM @OZ35996 M3055100 N WF,=A(QSERSTID) PERFORMING $ESYS @OZ35996 M3055200 BZ NFSYSNRS BR IF NONE @OZ35996 M3055300 BCTR WF,0 GET QSE ADDRESS @OZ35996 M3055400 MH WF,=Y(QSELEN) OF SYSTEM @OZ35996 M3055450 ALR WF,WC PERFORMING $ESYS @OZ35996 M3055500 L WC,=A(NRSTMSG) POINT TO 'RESTARTING' MSG @OZ35996 M3055550 MVC NRSTID-NRSTMSG(,WC),QSESID-QSEDSECT(WF) SET ID @OZ35996 M3055600 SPACE 1 @OZ35996 M3055700 NFSYSNRS TM $SVHASP,X'80' HOTSTARTING... @OZ35996 M3055800 BZ NFSYSNHT BR IF NO @OZ35996 M3055900 LTR WF,WF $ESYS IN PROGRESS... @OZ35996 M3055950 BZ NFSYSQOK BR IF NO @OZ35996 M3056000 $$WTO (WC) ISSUE 'RESTARTING' MSG @OZ35996 M3056050 SPACE 1 @OZ35996 M3056100 NFSYSXIT OI $SVSTUS,$SVSTRPL PREVENT HOTSTART @OZ35996 M3056150 $EXIT NIPLMSG WARN OPERATOR AND QUIT @OZ35996 M3056200 SPACE 1 @OZ35996 M3056250 DROP R2 KILL SSVT ADDRESSABILITY @OZ35996 M3056300 EJECT @OZ35996 M3056350 NFSYSNHT L R1,=A(NDORMMSG) POINT TO 'NOT DORMANT' MSG @OZ35996 M3056400 MVC NDORMTYP-NDORMMSG(,R1),=C'SYSTEM ' INDICATE SYSTEM R41 M3056500 $$WTO (R1) TELL OPERATOR SYSTEM NOT DORMANT R41 M3056600 LTR WF,WF $ESYS IN PROGRESS... @OZ35996 M3056620 BZ NFSYSCON BR IF NO @OZ35996 M3056640 $$WTO (WC) ISSUE 'RESTARTING' MSG @OZ35996 M3056660 SPACE 1 @OZ35996 M3056680 NFSYSCON L WA,=A(NRESUMSG) POINT TO 'CONTINUE' MSG @OZ35996 M3056700 MVC NRESUMST-NRESUMSG(,WA),=C'WARM' INDICATE WARM START R41 M3056800 BAL WE,NGWTOR QUERY OPERATOR R41 M3056900 BNE NGQUITT QUIT IF CANNOT WARM START @OZ27300 M3057000 SPACE 2 @OZ27300 M3057100 NFSYSQOK TM $ESYSQSE,X'80' TEST FOR COMPLEX WARM START @OZ27300 M3057300 BZ NFSYSCOX BRANCH IF YES @OZ27300 M3057500 SPACE 1 @OZ27300 M3057700 ST R3,$ESYSQSE SET QSE ADDR OF THIS SYSTEM @OZ35996 M3057800 TM $OPTSTAT,$OPTALTC TEST FOR ALTCKPT SPECIFIED @OZ27300 M3057900 BNO NFSYSCOK BRANCH IF NOT @OZ27300 M3058000 SPACE 1 @OZ27300 M3058200 L R1,=A(NMSGBALT) TELL OPERATOR, COMPLEX NOT @OZ27300 M3058400 B NGKWIT DORMANT, ALTCKPT DENIED @OZ27300 M3058500 SPACE 2 @OZ27300 M3058700 NFSYSCOX OI $CKPTFLG,$CKPNODL NOTE COMPLEX WARM START @OZ35996 M3058900 SPACE 1 @OZ27300 M3059000 NFSYSCOK ST R3,$AQSE SET QSE ADDR OF THIS SYSTEM @OZ35996 M3059200 SL R3,$MASTER STORE ADDR OF THIS @OZ27300 M3059400 AL R3,$MASTERI SYSTEM'S QSE IN THE @OZ27300 M3059500 ST R3,$RQSE CKPT READ-IN AREA @OZ27300 M3059600 * THIS CARD DELETED BY APAR @OZ50548 M3059700 * THIS CARD DELETED BY APAR @OZ27300 M3059800 * THIS CARD DELETED BY APAR @OZ27300 M3060000 L R2,$SSVT POINT TO SSVT. @OZ50548 M3060050 TM $SVHASP-SSVT(R2),X'80' HOTSTARTING... @OZ50548 M3060100 BZ NFSYSVOL NO, UPDATE SSVT. @OZ50548 M3060150 CLC $CHKPT,$SVCHKPT-SSVT(R2) CKPT VOL CHANGED... @OZ50548 M3060200 BE NFSYSPRM NO, CONTINUE VERIFICATION. @OZ50548 M3060250 L R1,=A(ISTRTEM3) TELL OP'TER SSVT DOESN'T.. @OZ50548 M3060300 B NGKWIT ...MATCH, HOTSTART DENIED. @OZ50548 M3060350 NFSYSVOL MVC $SVCHKPT-SSVT(,R2),$CHKPT SET CURRNT CKPT VOL. @OZ50548 M3060400 EJECT @OZ50548 M3060450 *********************************************************************** M3060500 * * M3061000 * ENSURE THAT CHECKPOINT VERIFICATION FIELDS ARE VALID * M3061500 * * M3062000 *********************************************************************** M3062500 SPACE 1 R4 M3063000 NFSYSPRM L WF,$MASTER POINT TO HCT VARIABLES @OZ27300 M3063500 * THIS CARD DELETED BY APAR @OZ20010 M3064000 CLC $PARMVER,$PARMVER-$SAVEBEG(WF) TEST NEW PARMS R4 M3064500 BE NFSYSPOK BR IF VALID PARAMETERS R4 M3065000 LA R1,NOLDPRMS POINT TO TBL OF REQD PARMS @OZ27300 M3065200 LA R2,NUMPARMS+1-3 SET INITIAL PARAMETER COUNT @OZ27300 M3065400 LA R3,2 SET CNT FOR REST OF LINE @OZ27300 M3065500 L R4,=A(NMSGPRMS) POINT TO PARM AREA OF MSG @OZ27300 M3065600 * THIS CARD DELETED BY APAR @OZ27300 M3066000 * THIS CARD DELETED BY APAR @OZ27300 M3066500 MVC 15(6,R4),$SPOOL-$SAVEBEG(WF) SET 1ST PARM IN 1ST LN R4 M3067000 CLC $SPOOL,15(R4) WAS PARM VALUE VALID... R4 M3067500 BE NEXTPARM BR IF YES R41 M3068000 MVI 21(R4),C'*' ELSE INDICATE INVALID R4 M3068500 SPACE 1 R4 M3069500 NEXTPARM LA R4,21(,R4) POINT TO NEXT PARM SLOT IN LINE R4 M3070000 MVC 4(8,R4),6(R1) SET PARM KEYWORD @OZ27300 M3070500 MVC 12(9,R4),NPARMASK SET MASK FOR PARM VALUE EDIT R4 M3071000 SLR R0,R0 CLEAR IN CASE OF INSERT @OZ27300 M3071500 MVI XVALLOAD,X'43' SET R4 M3072000 CLI 1(R1),1 UP @OZ27300 M3072500 BL SKIP770 APPROPRIATE R4 M3073000 MVI XVALLOAD,X'48' REGISTER R4 M3073500 BE SKIP770 LOAD R4 M3074000 MVI XVALLOAD,X'58' INSTRUCTION R4 M3074500 SKIP770 MVC XVALLOAD+2(2),4(R1) SET TARGET OF LOAD @OZ27300 M3075000 XVALLOAD IC R0,*-* GET PARM VALUE IN R0 @OZ27300 M3075500 CVD R0,NGWDBL SET PARM VALUE @OZ27300 M3076000 ED 15(6,R4),NGWDBL+5 IN MESSAGE R4 M3076500 EX R0,0(,R1) WAS PARM VALUE VALID... @OZ27300 M3077000 BE *+8 BR IF YES @OZ27300 M3077500 MVI 21(R4),C'*' ELSE INDICATE INVALID R4 M3078000 LA R1,14(,R1) POINT TO NEXT PARM IN TABLE @OZ27300 M3078500 BCT R3,NEXTPARM LOOP THRU LINE R4 M3079000 SPACE 1 R4 M3079500 LA R4,1(,R4) ADJUST FOR END OF LINE @OZ18405 M3079600 LA R3,3 SET FULL LINE PARM COUNT R4 M3080000 SR R2,R3 REDUCE COUNT OF PARMS REMAINING R4 M3080500 BNM NEXTPARM BR IF ENOUGH FOR FULL LINE R4 M3081000 AR R3,R2 GET SHORT LINE PARM COUNT R4 M3081500 BP NEXTPARM BR IF 1ST TIME THRU HERE R4 M3082000 L R1,=A(NPARAMSG) POINT TO MESSAGE TEXT R4 M3082500 B NGKWIT BR TO ISSUE MESSAGE AND QUIT R4 M3083000 EJECT @OZ27300 M3083100 ***************************************************************@OZ27300 M3083200 * @OZ27300 M3083300 * READ IN ENTIRE JOB QUEUE AND JOT @OZ27300 M3083400 * @OZ27300 M3083500 ***************************************************************@OZ27300 M3083600 SPACE 1 @OZ27300 M3083700 * ADDRESSABILITY -- @OZ27300 M3083800 USING JQBCCWE,R1 -- CCW PACKET @OZ27300 M3083900 SPACE 1 @OZ27300 M3084000 NFSYSPOK LA R1,JQBMSTR LOCATE MASTER RECORD PACKET @OZ27300 M3084100 SPACE 1 @OZ27300 M3084200 ST R1,JQBSTART SETUP FOR EXCP TO READ CKPT @OZ27300 M3084300 OI JQBFLAG1,JQB1READ AND SHOW READ ACTIVE @OZ27300 M3084400 SPACE 1 @OZ27300 M3084500 CLC $ESYSQSE,$ZEROS NODAL WARM START... @OZ27300 M3084600 BNE NFTCKPT2 BR IF NO, ELSE @OZ27300 M3084700 MVC $CKPTFLG-$SAVEBEG(,WF),$CKPTFLG USE NEW $CKPFLG @OZ27300 M3084800 B NFMVCKP2 BR TO MOVE IN HCT VARIABLES @OZ27300 M3084900 SPACE 1 @OZ27300 M3085000 NFTCKPT2 TM $STATUS,$DUPLEX ARE WE DUPLEXING... @OZ27300 M3085100 BZ NFMVHCT BR IF NO @OZ27300 M3085200 OI $CKPTFLG-$SAVEBEG(WF),$CKPDPX SHOW DUPLEXING @OZ27300 M3085300 CLC $CHKPT-$SAVEBEG(,WF),$CHKPT2-$SAVEBEG(WF) @OZ27300 M3085400 BE NFMVCKP2 BR IF NO-ONE ELSE DUPLEXING @OZ27300 M3085500 CLC $CHKPT2,$CHKPT2-$SAVEBEG(WF) TEST DUPLEX VOL @OZ27300 M3085600 BE NFMVHCT BR IF SAME @OZ27300 M3085700 L R1,=A(NMSGCK2R) ISSUE '&CKPT2 INVALID' MSG @OZ27300 M3085800 B NGKWIT AND TERMINATE @OZ27300 M3085900 SPACE 1 @OZ27300 M3086000 NFMVCKP2 MVC $CHKPT2-$SAVEBEG(,WF),$CHKPT2 USE NEW CHKPT2 @OZ27300 M3086100 SPACE 1 @OZ27300 M3086200 NFMVHCT MVC $SAVEBEG($SAVELEN),0(WF) SAVE HCT VARIABLES @OZ27300 M3086300 SPACE 1 @OZ27300 M3086400 BAL R14,NGEXCP ISSUE EXCP -- READ CKPT @OZ27300 M3086500 BNZ NGCKMSGR BRANCH IF I/O ERROR @OZ27300 M3086600 SPACE 2 @OZ27300 M3086700 NI JQBFLAG1,FF-JQB1READ SHOW READ COMPLETE @OZ27300 M3086800 SPACE 1 @OZ27300 M3086900 DROP WD KILL NVLTABL ADDRESSABILITY @OZ27300 M3087000 DROP R10 KILL JQB ADDRESSABILITY @OZ27300 M3087100 EJECT @OZ27300 M3087200 PRINT OFF - SECTION DELETED @OZ35996 M3087300 * THIS LINE DELETED BY APAR @OZ35996 M3087400 * THIS LINE DELETED BY APAR @OZ35996 M3087500 * THIS LINE DELETED BY APAR @OZ35996 M3087600 * THIS LINE DELETED BY APAR @OZ35996 M3087700 * THIS LINE DELETED BY APAR @OZ35996 M3087800 * THIS LINE DELETED BY APAR @OZ35996 M3087900 * THIS LINE DELETED BY APAR @OZ35996 M3088000 * THIS LINE DELETED BY APAR @OZ35996 M3088100 * THIS LINE DELETED BY APAR @OZ35996 M3088200 * THIS LINE DELETED BY APAR @OZ35996 M3088300 * THIS LINE DELETED BY APAR @OZ35996 M3088400 * THIS LINE DELETED BY APAR @OZ35996 M3088500 * THIS LINE DELETED BY APAR @OZ35996 M3088600 * THIS LINE DELETED BY APAR @OZ35996 M3088700 * THIS LINE DELETED BY APAR @OZ35996 M3088800 * THIS LINE DELETED BY APAR @OZ35996 M3088900 * THIS LINE DELETED BY APAR @OZ35996 M3089000 * THIS LINE DELETED BY APAR @OZ35996 M3089500 * THIS LINE DELETED BY APAR @OZ35996 M3090000 * THIS LINE DELETED BY APAR @OZ35996 M3090500 * THIS LINE DELETED BY APAR @OZ35996 M3091000 * THIS LINE DELETED BY APAR @OZ35996 M3091500 * THIS LINE DELETED BY APAR @OZ35996 M3091700 PRINT ON -- SECTION DELETED @OZ35996 M3092000 *********************************************************************** M3092500 * * M3093000 * ENSURE THAT ALL FORMERLY MOUNTED SPOOL VOLUMES ARE NOW * M3093500 * MOUNTED ON THE PROPER DEVICES AND THAT EACH HAS THE SAME * M3094000 * EXTENT LIMITS AS BEFORE * M3094500 * * M3095000 *********************************************************************** M3095500 SPACE 1 @OZ20010 M3095600 USING NVLDSECT,WD ALLOC TABLE ADDRESSABILITY @OZ20010 M3095700 USING SPLDSECT,WC SPOOL ALLOC ADDRESSABILITY @OZ20010 M3095800 SPACE 1 R4 M3096000 NGW020 SLR WF,WF INITIAL RELATIVE $DACKPT ENTRY R4 M3096500 SPACE 1 R4 M3097000 NGW040 L R1,$DACKPT GET NEXT R4 M3097500 LR WB,WF OLD R4 M3098000 MH WB,=H'6' DISK R4 M3098500 LH WB,0(WB,R1) DESCRIPTOR R4 M3099000 LTR WB,WB TEST ENTRY R4 M3099500 BZ NGW220 IGNORE IF NULL R4 M3100000 L WD,NVOLTABL ELSE, SCAN ALLOC TABLE @OZ27300 M3100500 LA WD,NVLTBLN(,WD) STARTING WITH 1ST SPOOL @OZ27300 M3100700 SPACE 1 R4 M3101000 NGW060 LA WD,NVLTBLN(,WD) POINT TO NEXT ALLOC TBL ENTRY R4 M3101500 CLM WB,1,NVLVOLID+5 TEST VOLUME SERIAL R4 M3102000 BE NGW080 BR IF MATCHING R4 M3102500 TM NVLEND,255 TEST FOR EMPTY/LAST ENTRY R4 M3103000 BM NGW060 LOOP IF NO R4 M3103500 SPACE 1 R4 M3104000 BO NDAERR2 BR IF ENTRIES EXHAUSTED R4 M3104500 MVC NVLVOLID,$SPOOL SET VOLUME R4 M3105000 STC WB,NVLVOLID+5 SERIAL NUMBER R4 M3105500 MVI NVLFLAGS,SPL1NFMT SET REQUEST FLAGS R4 M3106000 BAL WE,NGSPLGET OBTAIN SPOOL VOL ALLOC WORK AREA R4 M3106500 ICM WB,4,=AL1(UCB3DACC) INDICATE DIRECT ACCESS R4 M3107000 LOAD EP=DEVNAMET GET DEVICE NAME TABLE R4 M3107500 LR WE,R0 MAKE ADDRESSABLE R4 M3108000 L WA,0(,WE) GET ENTRIES IN TABLE R4 M3108500 LA WE,4(,WE) POINT TO 1ST TABLE ENTRY R4 M3109000 SPACE 1 R4 M3109500 SKIP790 CLM WB,6,10(WE) TEST FOR MATCH R4 M3110000 BE *+12 BR IF YES R4 M3110500 LA WE,12(,WE) ELSE POINT TO NEXT ENTRY R4 M3111000 BCT WA,SKIP790 AND BR TO TEST IT R4 M3111500 SPACE 1 R4 M3112000 DELETE EP=DEVNAMET DELETE DEVICE NAME TABLE R4 M3112500 LTR WA,WA TEST ENTRY COUNT R4 M3113000 BNZ NGW070 BR IF ENTRY LOCATED R4 M3113500 BAL WE,NGWUNAL ELSE ISSUE ERROR MESSAGE, R4 M3114000 OI NGQUIT+1,X'F0' SET QUIT SWITCH, R4 M3114500 B NGW220 AND BR TO CONTINUE R4 M3115000 SPACE 2 @OZ27300 M3115500 NGW070 MVC SPLUNIT(8),0(WE) SET DEVICE TYPE R4 M3116000 B NGW100 THEN BR TO ALLOCATE VOLUME R4 M3116500 SPACE 1 R4 M3117000 NGW080 MVI NVLFLAGS,SPL1NFMT SET REQUEST FLAGS R4 M3117500 BAL WE,NGSPLGET OBTAIN SPOOL VOL ALLOC WORK AREA R4 M3118000 SPACE 1 R4 M3118500 NGW100 BAL WE,NGALLOC ALLOCATE SPOOL VOLUME R4 M3119000 BAL WE,NGWAIT WAIT FOR ALLOCATION TO COMPLETE R4 M3119500 TM SPLFLG2,SPL2UNAL+SPL2OBT TEST ALLOCATE/OBTAIN R4 M3120000 BNZ NGW160 BR IF ERROR R4 M3120500 TM SPLFLG2,SPL2RDER IS VOLUME FORMATTED... R4 M3121000 BO NGW120 ERROR IF NO R4 M3121500 LR WB,WF POINT TO R4 M3122000 MH WB,=H'6' CHECKPOINT INFO R4 M3122500 AL WB,$DACKPT FOR THIS VOLUME R4 M3123000 CLC 2(4,WB),SPLOWTRK TEST EXTENT LIMITS R4 M3123500 BE NGW180 BR IF SAME (OK) R4 M3124000 L R1,=A(NXTNTMSG) POINT TO MESSAGE TEXT R4 M3124500 MVC NXTNTVOL-NXTNTMSG(,R1),SPLVOLID SET VOLUME SERIAL R4 M3125000 B NGW140 BR TO ISSUE ERROR MESSAGE R4 M3125500 SPACE 1 R4 M3126000 NGW120 L R1,=A(NRDERMSG) POINT TO MESSAGE TEXT R4 M3126500 MVC NRDERVOL-NRDERMSG(,R1),SPLVOLID SET VOLUME SERIAL R4 M3127000 SPACE 1 R4 M3127500 NGW140 $$WTO (R1) ISSUE ERROR MESSAGE TO OPERATOR R4 M3128000 SPACE 1 R4 M3128500 NGW160 OI NGQUIT+1,X'F0' SET QUIT SWITCH R4 M3129000 SPACE 1 R4 M3129500 NGW180 TM NGQUIT+1,X'F0' TEST QUIT SWITCH R4 M3130000 BO NGW200 BR IF SET R4 M3130500 BAL WE,NGDEBSET SET DEB EXTENT AND TED ENTRY R4 M3131000 OC $ESYSQSE,$ESYSQSE TEST FOR NODAL WARM START R4 M3131500 BNZ NGW200 BR IF NO R4 M3132000 BAL WE,NGBITMAP ADD OLD VOLUME BIT MAP TO MASTER R4 M3132500 SPACE 1 R4 M3133000 NGW200 BAL WE,NGDETACH DETACH HOSPOOL, FREE WORK AREA R4 M3133500 SPACE 1 R4 M3134000 NGW220 LA WF,1(,WF) BUMP $DACKPT RELATIVE ENTRY NO. R4 M3134500 CLM WF,1,$NUMDA TEST FOR END OF TABLE R4 M3135000 BL NGW040 BR IF NO R4 M3135500 EJECT R4 M3136000 *********************************************************************** M3136500 * * M3137000 * CHECK FOR NEW SPOOL VOLUMES. IF NODAL (COMPLEX) WARM * M3137500 * START, TREAT EACH ONE FOUND AS IN COLD START. IF JES2 * M3138000 * RESTART, OR SINGLE SYSTEM WARM START WITHIN MULTI-SYSTEM * M3138500 * NODE, DISALLOW USE OF NEW SPOOL VOLUME. * M3139000 * * M3139500 *********************************************************************** M3140000 SPACE 1 R4 M3140500 L WD,NVOLTABL POINT TO ALLOCATION TABLE R4 M3141000 LA WD,NVLTBLN(,WD) BUMP TO 1ST SPOOL ENTRY @OZ27300 M3141200 SPACE 1 R4 M3141500 NGW240 LA WD,NVLTBLN(,WD) GET NEXT TABLE ENTRY R4 M3142000 TM NVLEND,255 IF NO MORE ENTRIES, R4 M3142500 BNM NGW300 BR TO WAIT ON ALLOCATES (IF ANY) R4 M3143000 TM NVLFLAGS,SPL1NFMT IF PREVIOUSLY USED VOLUME, R4 M3143500 BO NGW240 BR TO CHECK NEXT R4 M3144000 OC $ESYSQSE,$ESYSQSE IF NODAL WARM START, R4 M3144500 BZ NGW260 BR TO ALLOCATE NEW VOLUME R4 M3145000 L R1,=A(NOUSEMSG) POINT TO MESSAGE TEXT R4 M3145500 MVC NOUSEVOL-NOUSEMSG(,R1),NVLVOLID SET VOLUME SERIAL R4 M3146000 $$WTO (R1) ISSUE WARNING MESSAGE TO OPERATOR R4 M3146500 B NGW240 THEN BR TO CONTINUE CHECKING R4 M3147000 SPACE 1 R4 M3147500 NGW260 BAL WE,NGSPLGET GET SPOOL VOL ALLOC WORK AREA R4 M3148000 L R1,NVOLWKSP L-I-F-O QUEUE R4 M3148500 ST WC,NVOLWKSP WORK AREA R4 M3149000 ST R1,SPLCHAIN TO NVOLWKSP R4 M3149500 BAL WE,NGALLOC ALLOCATE THE SPOOL VOLUME R4 M3150000 B NGW240 THEN BR TO CONTINUE CHECKING R4 M3150500 SPACE 1 R4 M3151000 NGW300 ICM WC,15,NVOLWKSP GET NEXT SPOOL VOL ALLOC WK AREA R4 M3151500 BZ NGEXIT BR IF NO MORE TO EXIT R4 M3152000 MVC NVOLWKSP,SPLCHAIN ELSE DE-CHAIN THE WORK AREA R4 M3152500 BAL WE,NGWAIT WAIT FOR ALLOCATION TO COMPLETE R4 M3153000 BNZ NGW320 BR IF ANY ERRORS R4 M3153500 BAL WE,NGCKPSET SET $DACKPT ENTRY R4 M3154000 BAL WE,NGDEBSET SET DEB EXTENT AND TED ENTRY R4 M3154500 BAL WE,NGBITMAP ADD NEW VOLUME BIT MAP TO MASTER R4 M3155000 SPACE 1 R4 M3155500 NGW320 BAL WE,NGDETACH DETACH HOSPOOL, FREE WORK AREA R4 M3156000 B NGW300 BR TO CHECK FOR ANOTHER NEW VOL R4 M3156500 EJECT R4 M3157000 *********************************************************************** M3157500 * * M3158000 * INVALID CHECKPOINT RECORD - WARM START NOT POSSIBLE * M3158500 * * M3159000 *********************************************************************** M3159500 SPACE 1 R4 M3160000 NGTEST TM $OPTSTAT,$OPTCOLD+$OPTFMT TEST FOR COLD/FORMAT START R4 M3160500 BNZ NGT060 BR IF YES R41 M3161000 SPACE 1 R4 M3161500 NGT020 L R1,=A(NMSG434) POINT TO MESSAGE TEXT R4 M3162000 B NGKWIT BR TO ISSUE MESSAGE AND QUIT R4 M3162500 SPACE 1 R4 M3163000 USING QSEDSECT,R1 PROVIDE QSE ADDRESSABILITY R41 M3163500 SPACE 1 R41 M3164000 NGT040 L R1,$QSE1 LOCATE 1ST QSE R41 M3164500 TM QSEFLAGS,QSELAST UNI-SYSTEM NODE... R41 M3164600 BO NGT060 BR IF YES R41 M3165000 $$WTO NDORMMSG TELL OP THAT COMPLEX NOT DORMANT R41 M3165500 L WA,=A(NRESUMSG) POINT TO 'CONTINUE' MSG R41 M3166000 BAL WE,NGWTOR QUERY OPERATOR R41 M3166500 BE NGCOLD BR IF OK TO COLD START R41 M3166600 B NGQUITT ELSE QUIT R41 M3166700 SPACE 1 R41 M3166800 DROP R1 KILL QSE ADDRESSABILITY R41 M3166900 SPACE 1 R41 M3167000 NGT060 L WA,=A(NMSG436) POINT TO 'CONFIRM CHANGE' MSG R41 M3167100 BAL WE,NGWTOR QUERY OPERATOR R41 M3167200 BE NGCOLD BR IF OK TO COLD START R41 M3167500 L R1,=A(NMSG434) POINT TO MESSAGE TEXT R4 M3168000 MVC NMSG434A-NMSG434(,R1),=C'COLD' CHANGE WARM TO COLD R4 M3168500 B NGKWIT BR TO ISSUE MESSAGE AND QUIT R4 M3169000 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION FORCM3169500 COLD START' R4 M3170000 *********************************************************************** M3170500 * * M3171000 * BUILD QSE(S) FROM SYSTEM PARAMETER TABLE * M3171500 * * M3172000 *********************************************************************** M3172500 SPACE 1 R4 M3173000 NGCOLD MVI $ESYSQSE,0 NOTE NODAL COLD START R4 M3173500 L R0,$TGMAP CLEAR R4 M3174000 L R1,$CYLMAPL MASTER R4 M3174500 SLR R15,R15 TRACK GROUP R4 M3175000 MVCL R0,R14 BIT MAP R4 M3175500 L R0,$QSE1 CLEAR R4 M3176000 LH R1,$QSENO ALL R4 M3176500 MH R1,=Y(QSELEN) ACTIVE @OZ27300 M3177000 MVCL R0,R14 QSES R4 M3177500 L R1,$QSE1 POINT TO 1ST QSE R4 M3178000 L R2,=A(NS1) POINT TO SYSTEM PARAMETER TABLE R4 M3178500 SPACE 1 R4 M3179000 USING QSEDSECT,R1 PROVIDE QSE ADDRESSABILITY R4 M3179500 SPACE 1 R4 M3180000 NGC020 MVC QSESID,0(R2) SET SYSTEM ID R4 M3180500 MVC QSESIBSY(2),NS1A-NS1(R2) SET BUSY AND AFFINITY R4 M3181000 CLC $SID,QSESID TEST FOR THIS SYSTEM R4 M3181500 BNE SKIP800 BR IF NO R4 M3182000 ST R1,$AQSE ELSE SAVE QSE ADDRESS R4 M3182500 LR R0,R1 STORE ADDRESS @OZ20010 M3182600 SL R0,$MASTER OF THIS SYSTEM'S QSE @OZ27300 M3182700 AL R0,$MASTERI IN THE CHECKPOINT @OZ27300 M3182800 ST R0,$RQSE READ-IN AREA @OZ20010 M3182900 SKIP800 LA R2,L'NS1(,R2) STEP TO NEXT TABLE ENTRY R4 M3183000 CLI 0(R2),C' ' TEST FOR END OF TABLE R4 M3183500 BE NGC040 BR IF YES R4 M3184000 LA R1,QSELEN(,R1) ELSE STEP TO NEXT QSE @OZ27300 M3184500 B NGC020 AND BR TO SET IT R4 M3185000 SPACE 1 R4 M3185500 NGC040 OI QSEFLAGS,QSELAST INDICATE LAST QSE R4 M3186000 SPACE 1 R4 M3186500 DROP R1 KILL QSE ADDRESSABILITY R4 M3187000 SPACE 2 @OZ41702 M3187100 L R1,=A(NSTRTMSG) POINT TO STARTUP MESSAGE @OZ41702 M3187200 L R2,$SSVT POINT TO SSVT @OZ41702 M3187300 MVC NSTRTSSN(,R1),$SVSSNM-SSVT(R2) SET SUBSYS NAME @OZ41702 M3187400 SPACE 1 @OZ41702 M3187500 $$WTO (R1) 'COLD-START IN PROGRESS' @OZ41702 M3187600 EJECT @OZ41702 M3187700 *********************************************************************** M3188000 * * M3188500 * ALLOCATE SPOOL VOLUMES FOR COLD/FORMAT START * M3189000 * * M3189500 *********************************************************************** M3190000 SPACE 1 R4 M3190500 L WD,NVOLTABL POINT TO ALLOCATION TABLE R4 M3191000 LA WD,NVLTBLN(WD) SPOOL ENTRIES @OZ27300 M3191200 SPACE 1 R4 M3191500 NGC060 LA WD,NVLTBLN(WD) GET NEXT TABLE ENTRY @OZ27300 M3192000 TM NVLEND,255 IF NO MORE ENTRIES, R4 M3192500 BNM NGC080 BR TO WAIT ON ALLOCATE(S) R4 M3193000 TM $OPTSTAT,$OPTFMT TEST FOR FORMAT START R4 M3193500 BZ SKIP810 BR IF NO R4 M3194000 OI NVLFLAGS,SPL1FMT ELSE FORCE VOLUME FORMAT R4 M3194500 SKIP810 BAL WE,NGSPLGET OBTAIN SPOOL VOL ALLOC WORK AREA R4 M3195000 L R1,NVOLWKSP L-I-F-O QUEUE R4 M3195500 ST WC,NVOLWKSP WORK AREA R4 M3196000 ST R1,SPLCHAIN TO NVOLWKSP R4 M3196500 BAL WE,NGALLOC ALLOCATE THE SPOOL VOLUME R4 M3197000 B NGC060 THEN BR TO CHECK NEXT ENTRY R4 M3197500 SPACE 1 R4 M3198000 NGC080 ICM WC,15,NVOLWKSP GET NEXT SPOOL VOL ALLOC WK AREA R4 M3198500 BZ NGC140 BR IF NO MORE R4 M3199000 MVC NVOLWKSP,SPLCHAIN ELSE DE-CHAIN THE WORK AREA R4 M3199500 BAL WE,NGWAIT WAIT FOR ALLOCATION TO COMPLETE R4 M3200000 BZ NGC100 BR IF OK TO ACCEPT VOLUME R4 M3200500 CLC $SPOOL,SPLVOLID TEST FOR PRIMARY SPOOL VOLUME R4 M3201000 BNE NGC120 BR IF NO TO IGNORE VOLUME R4 M3201500 OI NGQUIT+1,X'F0' ELSE SET QUIT SWITCH R4 M3202000 B NGC120 THEN BR TO CONTINUE R4 M3202500 SPACE 1 R4 M3203000 NGC100 BAL WE,NGCKPSET SET $DACKPT ENTRY R4 M3203500 BAL WE,NGDEBSET SET DEB EXTENT AND TED ENTRY R4 M3204000 BAL WE,NGBITMAP ADD NEW VOLUME BIT MAP TO MASTER R4 M3204500 SPACE 1 R4 M3205000 NGC120 BAL WE,NGDETACH DETACH HOSPOOL, FREE WORK AREA R4 M3205500 B NGC080 BR TO CHECK FOR ANOTHER VOLUME R4 M3206000 SPACE 1 R4 M3206500 NGC140 EX R0,NGQUIT QUIT IF ANY ERROR(S) R4 M3207000 L R2,$SSVT NO ERRORS - POINT TO SSVT. @OZ50548 M3207100 MVC $SVCHKPT-SSVT(,R2),$CHKPT SET CURRNT CKPT VOL. @OZ50548 M3207200 SPACE 1 R4 M3207500 DROP WC,WD KILL SPL/ALLOC TBL ADDRESSABILITY R4 M3208000 EJECT R4 M3208500 *********************************************************************** M3209000 * * M3209500 * FORMAT HASP JOB QUEUE * M3210000 * * M3210500 *********************************************************************** M3211000 SPACE 1 R4 M3211500 USING JQEDSECT,R2 JQE ADDRESSABILITY @OZ20010 M3211700 SPACE 2 @OZ20010 M3211900 L R2,$JOBQPTR PICK UP ADDRESS OF 0TH JQE @OZ20010 M3212000 MVC JQEDSECT(JQELNGTH),NGJQETXT SET EYE-CATCHER @OZ20010 M3212200 MVC NGJQESID(,R2),$SID MOVE $SID TO EYE-CATCHER @OZ20010 M3212400 TIME DEC GET 'READABLE' DATE/TIME @OZ20010 M3212500 STM R0,R1,NGJQEDTM(R2) STORE IN EYE-CATCHER @OZ20010 M3212700 LA R2,JQELNGTH(,R2) POINT TO ACTUAL 1ST JQE @OZ20010 M3212900 LH R3,$MAXJOBS NO. OF JQES TO INITIALIZE @OZ20010 M3213000 LA R1,$JQFREE PICK UP ADDRESS OF FREE Q @OZ20010 M3213200 SPACE 1 @OZ20010 M3213400 NGC200 LR R0,R2 COMPUTE @OZ20010 M3213500 SL R0,$JOBQPTR NEXT @OZ20010 M3213700 SRL R0,2 JQE OFFSET @OZ20010 M3213900 STH R0,0(,R1) STORE PREVIOUS JQE CHAIN @OZ20010 M3214000 MVI JQETYPE,$FREE SHOW JQE ON FREE QUEUE @OZ27300 M3214200 LA R1,JQECHAIN POINT TO CHAIN @OZ20010 M3214400 LA R2,JQELNGTH(,R2) BUMP TO NEXT JQE @OZ20010 M3214500 BCT R3,NGC200 LOOP TILL ALL JQES CHAINED @OZ20010 M3214700 SPACE 1 @OZ20010 M3214900 SLR R2,R2 CLEAR LAST JQE @OZ20010 M3215000 ST R2,0(,R1) CHAIN POINTER @OZ20010 M3215200 SPACE 1 @OZ20010 M3215400 PRINT OFF - SECTION DELETED @OZ20010 M3215500 * THIS CARD DELETED BY APAR @OZ20010 M3216000 * THIS CARD DELETED BY APAR @OZ20010 M3216500 * THIS CARD DELETED BY APAR @OZ20010 M3217000 * THIS CARD DELETED BY APAR @OZ20010 M3217500 * THIS CARD DELETED BY APAR @OZ20010 M3218000 * THIS CARD DELETED BY APAR @OZ20010 M3218500 * THIS CARD DELETED BY APAR @OZ20010 M3219000 * THIS CARD DELETED BY APAR @OZ20010 M3219100 * THIS CARD DELETED BY APAR @OZ20010 M3219500 * THIS CARD DELETED BY APAR @OZ20010 M3220000 PRINT ON -- SECTION DELETED @OZ20010 M3220500 STH R2,$JOBNO RESET JOB NUMBER @OZ20010 M3221000 L R6,=F'10000' RESET R4 M3221500 STH R6,$STCNO STARTED TASK NUMBER R4 M3222000 ALR R6,R6 RESET R4 M3222500 STH R6,$TSUNO TIME-SHARING USER NUMBER R4 M3223000 SPACE 2 @OZ20010 M3223200 DROP R2 RELEASE JQE ADDRESSABILITY @OZ20010 M3223400 EJECT R4 M3223500 *********************************************************************** M3224000 * * M3224500 * FORMAT HASP JOB OUTPUT TABLE * M3225000 * * M3225500 *********************************************************************** M3226000 SPACE 1 R4 M3226500 USING JOTDSECT,R2 PROVIDE JOT ADDRESSABILITY @OZ20010 M3227000 SPACE 1 @OZ20010 M3227200 L R2,$JOTABLE @OZ20010 M3227400 LH R3,$NUMJOES NO. OF JQES TO INITIALIZE @OZ20010 M3227500 STH R3,JOTFREC EQUAL NUMBER OF FREE JOES @0Z20010 M3227700 LA R1,JOTFREQ PICK UP ADDRESS OF FREE Q @OZ20010 M3227900 LA R2,JOTJOES PICK UP ADDRESS OF 1ST JOE @OZ20010 M3228000 USING JOEDSECT,R2 PROVIDE JOE ADDRESSABILITY @OZ20010 M3228200 SPACE 1 @OZ20010 M3228400 NGC202 LR R0,R2 COMPUTE @OZ20010 M3228500 SL R0,$JOTABLE OFFSET TO @OZ20010 M3228700 SRL R0,2 NEXT JOE @OZ20010 M3228900 STH R0,0(,R1) STORE PREVIOUS JOE CHAIN @OZ20010 M3229000 MVI JOETYPE,$JOEFREE SHOW JOE ON FREE QUEUE @OZ27300 M3229100 LA R1,JOENEXT POINT TO CHAIN @OZ20010 M3229200 LA R2,JOESIZE(,R2) BUMP TO NEXT JOE @OZ20010 M3229400 BCT R3,NGC202 LOOP TILL ALL JOES CHAINED @OZ20010 M3229500 SPACE 1 @OZ20010 M3229700 SLR R2,R2 CLEAR LAST JOE @OZ27300 M3229900 STH R2,JOENEXT-JOEDSECT(,R1) POINTER AND @OZ27300 M3230000 B NGEXIT BRANCH AROUND @OZ27300 M3230200 SPACE 1 @OZ20010 M3230400 PRINT OFF - SECTION DELETED @OZ20010 M3230500 * THIS CARD DELETED BY APAR @OZ20010 M3231000 * THIS CARD DELETED BY APAR @OZ20010 M3231500 * THIS CARD DELETED BY APAR @OZ20010 M3232000 * THIS CARD DELETED BY APAR @OZ20010 M3232500 * THIS CARD DELETED BY APAR @OZ20010 M3233000 * THIS CARD DELETED BY APAR @OZ20010 M3233500 * THIS CARD DELETED BY APAR @OZ20010 M3234000 * THIS CARD DELETED BY APAR @OZ20010 M3234500 * THIS CARD DELETED BY APAR @OZ20010 M3235000 * THIS CARD DELETED BY APAR @OZ20010 M3235500 * THIS CARD DELETED BY APAR @OZ20010 M3236000 PRINT ON -- SECTION DELETED @OZ20010 M3236500 DROP R2 KILL JOT ADDRESSABILITY @OZ20010 M3237000 SPACE 1 @OZ20010 M3237025 NGJQETXT DC CL(JQELNGTH)' ' EBDCIC TEXT FOR SPACE @0Z20010 M3237050 ORG NGJQETXT USED BY ZEROTH JQE ENTRY @0Z20010 M3237075 DC CL5'JES2 ' NAME OF JOB ENTRY SUBSYSTEM @0Z20010 M3237100 DC CL10'COLDSTART ' COLDSTART TIME STAMP FLAG @0Z20010 M3237200 NGJQESID EQU *-NGJQETXT,4 OFFSET, LEN FOR SMF SYSID @0Z20010 M3237225 DC CL5' ' SLOT FOR SMF SYSID @0Z20010 M3237250 NGJQEDTM EQU *-NGJQETXT,8 OFFSET, LEN FOR DATE/TIME @0Z20010 M3237275 DC CL8' ' SLOT FOR DATE/TIME (SVC 11) @0Z20010 M3237300 ORG , @0Z20010 M3237325 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION TERCM3237500 MINATION' R4 M3238000 *********************************************************************** M3238500 * * M3239000 * ALLOCATE TRACKS FOR MESSAGE SPOOLING * M3239500 * * M3240000 *********************************************************************** M3240500 SPACE 1 R4 M3241000 USING TEDDSECT,WA PROVIDE TED ADDRESSABILITY R4 M3241500 SPACE 1 R4 M3242000 CNOP 0,4 R4 M3242500 NGEXIT DS 0H USED LATER AS SAVE AREA R4 M3243000 SPACE 1 R4 M3243500 NGQUIT NOP NGQUITT QUIT IF ANY ERROR(S) SO FAR @OZ27300 M3244000 CLI $SPOLMSG,0 IF NO MSG BUFFERS REQUESTED, R4 M3244500 BE NGX000 DON'T ALLOCATE ANY TRACKS R4 M3245000 L WA,TEDSTART POINT TO PRIMARY SPOOL VOL TED R4 M3245500 L WC,$TGMAP POINT TO PRIMARY SPOOL VOL TGM R4 M3246000 L R1,$DACKPT GET START OF PRIMARY R4 M3246500 LH R1,2(,R1) SPOOL DATA SET R4 M3247000 LR R15,R1 SAVE FOR SETTING OF MTTR R4 M3247500 LH WD,TNTG GET TRACKS PER GROUP R4 M3248000 ALR R1,WD R1 = FIRST R4 M3248500 BCTR R1,0 AVAILABLE R4 M3249000 SLR R0,R0 TRACK R4 M3249500 DR R0,WD GROUP R4 M3250000 LR WE,R1 SAVE FOR LATER USE R4 M3250500 BCTR WE,0 GET GROUP IN FRONT R4 M3251000 LR WF,WE SAVE IT ALSO R4 M3251500 MR R0,WD GET TRACK NUMBER OF GROUP R4 M3252000 SR R1,R15 TRACKS LEFT IN DEAD SPACE R4 M3252500 BNZ SKIP840 SKIP IF DEAD SPACE TRACKS R4 M3253000 OI NMSGECLD+1,X'F0' SET TO PREVENT ALLOCATION R4 M3253500 SKIP840 LH R15,TNRT GET RECORDS PER TRACK R4 M3254000 MR R0,R15 R1 = NEGATIVE OF NUMBER R4 M3254500 LNR R1,R1 OF ALLOCATED RECORDS R4 M3255000 IC R0,$SPOLMSG R1 = NUMBER R4 M3255500 AR R1,R0 OF RECORDS R4 M3256000 MH R0,$NUMRJE LEFT R4 M3256500 AR R1,R0 AVAILABLE R4 M3257000 BNP NTESTART BR IF NONE REMAINING R4 M3257500 MR R14,WD R1 = NUMBER R4 M3258000 AR R1,R15 OF R4 M3258500 BCTR R1,0 TRACK R4 M3259000 SLR R0,R0 GROUPS R4 M3259500 DR R0,R15 REMAINING R4 M3260000 ALR WE,R1 END GROUP R4 M3260500 LNR R1,R1 NEGATIVE OF GROUPS REMAINING R4 M3261000 A R1,NGXTGS TOTAL - GROUPS = REMAINING R4 M3261500 BNP NMSGERR IF NOT POSITIVE, SERIOUS ERROR R4 M3262000 ST R1,NGXTGS SET NEW TOTAL R4 M3262500 EJECT @OZ27300 M3263000 NTESTART OC $ESYSQSE,$ESYSQSE TEST FOR NODAL WARM/COLD START R4 M3263500 BNZ NGX025 BR IF NO @OZ27300 M3264500 * THIS LINE DELETED BY APAR @OZ35996 M3265000 * THIS LINE DELETED BY APAR @OZ35996 M3265500 * THIS LINE DELETED BY APAR @OZ35996 M3266000 * THIS LINE DELETED BY APAR @OZ35996 M3266500 SPACE 1 @OZ27300 M3267000 NMSGLOOP LR R14,WE LOCATE BIT MAP BYTE AND BIT R4 M3267500 SRDL R14,3 SEPARATE BYTE AND BIT R4 M3268000 CH R14,TNMB MAKE SURE WITHIN PRIMARY VOLUME R4 M3268500 BH NMSGERR ERROR IF NOT R4 M3269000 LA R1,0(R14,WC) BYTE OF CYLINDER MAP R4 M3269500 SRL R15,32-3 ALIGN AT LOW END R4 M3270000 IC R15,NMSGBIT(R15) PICK UP BIT PATTERN R4 M3270500 CR WE,WF TEST FOR END R4 M3271000 BNH NMSGECLD EXIT IF SO R4 M3271500 EX R15,NMSGXI FLIP BIT TO OFF R4 M3272000 EX R15,NMSGTM TEST FOR BIT OFF R4 M3272500 BNZ NMSGERR ERROR IF NOT R4 M3273000 BCT WE,NMSGLOOP LOOP R4 M3273500 SPACE 1 R4 M3274000 NMSGECLD NOP NGX000 FALL THRU IF TRKS IN DEAD SPACE R4 M3274500 EX R15,NMSGOI TURN BIT ON R4 M3275000 EX R15,NMSGXI NOW TURN BIT OFF R4 M3275500 B NGX000 THEN BR TO CONTINUE R4 M3276000 SPACE 1 R4 M3276500 DROP WA KILL TED ADDRESSABILITY R4 M3277000 SPACE 2 R4 M3277500 NMSGERR L R1,=A(NMSGMSG) POINT TO MESSAGE TEXT R4 M3278000 B NGKWIT BR TO ISSUE MESSAGE AND QUIT R4 M3278500 SPACE 2 R4 M3279000 NMSGBIT DC X'8040201008040201' BIT PATTERNS FOR ALLOCATION R4 M3279500 SPACE 1 R4 M3280000 NMSGXI XI 0(R1),*-* *** EXECUTE ONLY *** R4 M3280500 NMSGTM TM 0(R1),*-* *** EXECUTE ONLY *** R4 M3281000 NMSGOI OI 0(R1),*-* *** EXECUTE ONLY *** R4 M3281500 EJECT @OZ27300 M3281600 ***************************************************************@OZ27300 M3281700 * @OZ27300 M3281800 * SYSTEM ENVIRONMENT RECORDING @OZ27300 M3281900 * @OZ27300 M3282000 ***************************************************************@OZ27300 M3282100 SPACE 1 @OZ27300 M3282200 NGX000 CLC $ESYSQSE,$ZEROS TEST START TYPE @OZ27300 M3282300 BNE NGX025 BR IF NOT COLD/NODAL WARM @OZ27300 M3282400 L R1,$QSE1 POINT TO 1ST QSE @OZ27300 M3282500 LH R0,$QSENO GET NUMBER OF MEMBERS @OZ27300 M3282600 SPACE 1 @OZ27300 M3282700 USING QSEDSECT,R1 PROVIDE QSE ADDRESSABILITY @OZ27300 M3282800 SPACE 1 @OZ27300 M3282900 NGX020 MVC QSESITIM,$ZEROS ZERO LAST CHECKPOINT TIME @OZ27300 M3283000 NI QSESTAT,FF-QSEACTIV-QSERSTID SHOW INACTIVE @OZ35996 M3283100 LA R1,QSELEN(,R1) STEP TO NEXT QSE @OZ27300 M3283200 BCT R0,NGX020 LOOP THRU ACTIVE QSES @OZ27300 M3283300 SPACE 1 @OZ27300 M3283400 * THIS CARD DELETED BY APAR @OZ27300 M3283500 NGX025 L R1,$MASTER MOVE HCT VARIABLES @OZ27300 M3283600 MVC 0($SAVELEN,R1),$SAVEBEG TO JOB QUEUE BUFFER @OZ27300 M3283700 SPACE 2 @OZ27300 M3283800 L R1,$AQSE POINT TO THIS SYSTEMS QSE @OZ27300 M3283900 MVC QSESITIM,$SIDTIME AND STORE CHKPT WRITE TIME @OZ27300 M3284000 OI QSESTAT,QSEACTIV INDICATE SYSTEM ACTIVE @OZ27300 M3284100 NI QSESTAT,FF-QSERSTID SHOW NOT IN $ESYS @OZ35996 M3284200 EJECT @OZ27300 M3284400 ***************************************************************@OZ27300 M3284500 * @OZ27300 M3284600 * ANALYZE JOB QUEUE CHAINS AND FIELDS @OZ27300 M3284700 * @OZ27300 M3284800 * THIS ANALYSIS CONSISTS OF VALIDATING ALL CHAIN FIELDS @OZ27300 M3284900 * AND OTHER JQE FIELDS WHICH ARE CAPABLE OF BEING @OZ27300 M3285000 * VALUE CHECKED. IT ALSO MUST ACCOUNT FOR ALL JQE'S, @OZ27300 M3285100 * INCLUDING THOSE ON THE FREE QUEUE. @OZ27300 M3285200 * @OZ27300 M3285300 ***************************************************************@OZ27300 M3285400 SPACE 1 @OZ27300 M3285500 USING JQEDSECT,R1 PROVIDE JQE ADDRESSABILITY @OZ27300 M3285600 SPACE 1 @OZ27300 M3285700 NGQANAL CLC $ESYSQSE,$ZEROS DO JOB QUEUE / JOT ANALYSIS @OZ35996 M3285800 BNE NGCKPT ONLY FOR NODAL WARM START @OZ27300 M3285900 SPACE 1 @OZ27300 M3286000 SLR WC,WC CLEAR ACCUMULATED JQE COUNT @OZ27300 M3286100 L R10,$JOBQPTR GET JOB QUEUE ORIGIN @OZ27300 M3286200 LA R1,$JQFREE-QUECHAIN PREPARE TO SCAN FREE QUEUE @OZ27300 M3286300 SPACE 1 @OZ27300 M3286400 CNOP 0,8 @OZ27300 M3286500 NGNJQE1 BAL WF,NGJQENXT GET ADDRESS OF NEXT JQE @OZ27300 M3286600 B NGCKJOBQ BR IF END OF CHAIN +0 @OZ27300 M3286700 CLI JQETYPE,$FREE TEST QUEUE TYPE +4 @OZ27300 M3286800 BE NGNJQE1 BR IF JQE REALLY FREE @OZ27300 M3286900 B NGBLDJBQ ELSE BR TO REBUILD JOB Q @OZ27300 M3287000 SPACE 1 @OZ27300 M3287100 CNOP 2,8 @OZ27300 M3287200 NGCKJOBQ SLR R14,R14 CLEAR FOR INSERTS IN LOOP @OZ27300 M3287300 LA R15,$JQTYPES*2 PREPARE TO SCAN JOB QUEUES @OZ27300 M3287400 L WD,$QINDEXA GET JOB Q HEADS INDEX ADDR @OZ27300 M3287500 SPACE 1 @OZ27300 M3287600 NGNEXTQ LA R1,$JQHEADS-2-QUECHAIN(R15) SET TO SCAN NEXT Q @OZ27300 M3287700 SPACE 1 @OZ27300 M3287800 NGNJQE2 BAL WF,NGJQENXT GET ADDRESS OF NEXT JQE @OZ27300 M3287900 B NGLOOP1 BR IF END OF CHAIN +0 @OZ27300 M3288000 IC R14,JQETYPE GET QUEUE TYPE +4 @OZ27300 M3288100 IC R14,0(WD,R14) GET QUEUE HEADER OFFSET @OZ27300 M3288200 CLR R14,R15 TEST QUEUE TYPE @OZ27300 M3288300 BE NGNJQE2 BR IF CORRECT @OZ27300 M3288400 B NGBLDJBQ ELSE BR TO REBUILD JOB Q @OZ27300 M3288500 SPACE 1 @OZ27300 M3288600 NGLOOP1 BCTR R15,0 BACK UP TO @OZ27300 M3288700 BCT R15,NGNEXTQ PRECEEDING QUEUE @OZ27300 M3288800 SPACE 1 @OZ27300 M3288900 CH WC,$MAXJOBS ALL JQE'S ACCOUNTED FOR... @OZ27300 M3289000 BE NGBLDJOT BR IF YES TO REBUILD JOT @OZ27300 M3289100 EJECT @OZ27300 M3289200 ***************************************************************@OZ27300 M3289300 * @OZ27300 M3289400 * A JOB QUEUE ERROR HAS BEEN DETECTED. JOB QUEUE CHAINS @OZ27300 M3289500 * WILL NOW BE REBUILT USING VALIDATED JQETYPE FIELDS. @OZ27300 M3289600 * INVALIDATED JQES ARE RETURNED TO THE FREE QUEUE. @OZ27300 M3289700 * @OZ27300 M3289800 * NOTE THAT VALIDATED JQES ARE REQUEUED BY JOB NUMBER @OZ27300 M3289900 * WITHIN PRIORITY. THIS IS DONE TO MINIMIZE THE RE- @OZ27300 M3290000 * SEQUENCING OF JQES WITHIN THEIR CHAINS. @OZ27300 M3290100 * @OZ27300 M3290200 ***************************************************************@OZ27300 M3290300 SPACE 1 @OZ27300 M3290400 NGBLDJBQ OI $CKPTFLG,$CKPERRQ INIDICATE JOB QUEUE ERROR @OZ27300 M3290500 SPACE 1 @OZ27300 M3290600 L WA,=A(NGJBQMSG) PT TO 'REQUEST REBUILD' MSG @OZ27300 M3290700 BAL WE,NGWTOR QUERY OPERATOR @OZ27300 M3290800 BZ NGJBQBLD BR IF REPLY IS 'Y' @OZ27300 M3290900 L WA,=A(NMSG441) PT TO 'REQUEST CONTINUE' MSG@OZ27300 M3291000 BAL WE,NGWTOR QUERY OPERATOR @OZ27300 M3291100 BZ NGBLDJOT BR IF REPLY IS 'Y' @OZ27300 M3291200 B NGQUITT ELSE BR TO QUIT @OZ27300 M3291300 SPACE 1 @OZ27300 M3291400 NGJBQBLD OI $CKPTFLG,$CKPBLDQ SHOW JOB QUEUE RE-BUILT @OZ27300 M3291500 SPACE 1 @OZ27300 M3291600 OI $OPTSTAT,$OPTREQ FORCE 'REQ' OPTION @OZ27300 M3291700 TIME DEC GET 'READABLE' DATE/TIME @OZ27300 M3291800 STM R0,R1,$DOUBLE SAVE IT @OZ27300 M3291900 LH R0,$MAXJOBS GET NUMBER OF JQES @OZ27300 M3292000 LR R1,R10 GET ADDRESS OF 1ST JQE @OZ27300 M3292100 MVC JQE,NGJQETXT SET EYE-CATCHER IN 1ST JQE @OZ27300 M3292200 MVC NGJQESID(,R1),$SID AND MOVE IN $SID AND @OZ27300 M3292300 MVC NGJQEDTM(,R1),$DOUBLE READABLE DATE/TIME @OZ27300 M3292400 SLR WB,WB CLEAR FOR INSERTS IN LOOP @OZ27300 M3292500 STH WB,$JQFREE CLEAR FREE QUEUE HEADER @OZ27300 M3292600 XC $JQHEADS($JQTYPES*2),$JQHEADS CLEAR JOB Q HDRS @OZ27300 M3292700 L WD,$QINDEXA GET JOB Q HEADS INDEX ADDR @OZ27300 M3292800 SPACE 1 @OZ27300 M3292900 NGNJQE3 LA R1,JQELNGTH(,R1) POINT TO NEXT JQE @OZ27300 M3293000 MVC JQEJOE,$ZEROS CLEAR WORK-JOE QUEUE HEAD @OZ27300 M3293100 LR WC,R1 RELOAD JQE ADDRESS @OZ27300 M3293200 SLR WC,R10 REDUCE JQE ADDRESS @OZ27300 M3293300 SRL WC,2 TO FULLWORD OFFSET @OZ27300 M3293400 CLC JQEJOBNO,$ZEROS TEST JOB NUMBER @OZ27300 M3293500 BE NGFREJQE BR IF INVALID @OZ27300 M3293600 CLI JQETYPE,$FREE TEST QUEUE TYPE @OZ27300 M3293700 BE NGFREJQE BR IF FREE JQE @OZ27300 M3293800 IC WB,JQETYPE GET QUEUE TYPE @OZ27300 M3293900 IC WB,0(WD,WB) GET JOB QUEUE HEADER OFFSET @OZ27300 M3294000 LTR WB,WB TEST QUEUE TYPE @OZ27300 M3294100 BNZ NGQUEJQE BR IF VALID TO QUEUE IT @OZ27300 M3294200 EJECT @OZ27300 M3294300 ***************************************************************@OZ27300 M3294400 * @OZ27300 M3294500 * ADD JQE TO FREE QUEUE IN ADDRESS SEQUENCE @OZ27300 M3294600 * @OZ27300 M3294700 ***************************************************************@OZ27300 M3294800 SPACE 1 @OZ27300 M3294900 NGFREJQE MVI JQETYPE,$FREE SHOW JQE ON FREE QUEUE @OZ27300 M3295000 LA WE,$JQFREE-QUECHAIN PREPARE TO SCAN FREE QUEUE @OZ27300 M3295100 SPACE 1 @OZ27300 M3295200 NGNJQE4 LR WF,WE RELOAD CHAIN ADDRESS @OZ27300 M3295300 LH WE,QUECHAIN(,WE) GET FULLWORD OFFSET @OZ27300 M3295400 N WE,=X'0000FFFF' OF NEXT JQE @OZ27300 M3295500 BZ NGADDJQE BR IF END OF CHAIN @OZ27300 M3295600 SLL WE,2 EXPAND TO BYTE OFFSET @OZ27300 M3295700 ALR WE,R10 ADD JOB QUEUE ORIGIN @OZ27300 M3295800 CLR R1,WE TEST ADDRESS OF CURRENT JQE @OZ27300 M3295900 BH NGNJQE4 BR IF STILL HIGHER @OZ27300 M3296000 B NGINSJQE ELSE BR TO INSERT JQE @OZ27300 M3296100 SPACE 1 @OZ27300 M3296200 ***************************************************************@OZ27300 M3296300 * @OZ27300 M3296400 * QUEUE JQE BY JOB NUMBER WITHIN PRIORITY WITHIN CLASS @OZ27300 M3296500 * @OZ27300 M3296600 ***************************************************************@OZ27300 M3296700 SPACE 1 @OZ27300 M3296800 NGQUEJQE LA WE,$JQHEADS-2-QUECHAIN(WB) PREPARE TO SCAN Q @OZ27300 M3296900 SPACE 1 @OZ27300 M3297000 NGNJQE5 LR WF,WE RELOAD CHAIN ADDRESS @OZ27300 M3297100 LH WE,QUECHAIN(,WE) GET FULLWORD OFFSET @OZ27300 M3297200 N WE,=X'0000FFFF' OF NEXT JQE @OZ27300 M3297300 BZ NGADDJQE BR IF END OF CHAIN @OZ27300 M3297400 SLL WE,2 EXPAND TO BYTE OFFSET @OZ27300 M3297500 ALR WE,R10 ADD JOB QUEUE ORIGIN @OZ27300 M3297600 CLC JQEPRIO,QUEPRIO(WE) TEST CURRENT PRIORITY @OZ27300 M3297700 BL NGNJQE5 BR IF LOWER @OZ27300 M3297800 BH NGINSJQE BR IF HIGHER @OZ27300 M3297900 CLC JQEJOBNO,QUEJOBNO(WE) TEST CURRENT JOB NUMBER @OZ27300 M3298000 BNL NGNJQE5 BR IF NOT LOWER @OZ27300 M3298100 SPACE 1 @OZ27300 M3298200 NGINSJQE SLR WE,R10 REDUCE ADDRESS @OZ27300 M3298300 SRL WE,2 TO FULLWORD OFFSET @OZ27300 M3298400 SPACE 1 @OZ27300 M3298500 NGADDJQE STH WC,QUECHAIN(,WF) INSERT JQE @OZ27300 M3298600 STH WE,JQECHAIN INTO CHAIN @OZ27300 M3298700 BCT R0,NGNJQE3 LOOP THRU ALL JQES @OZ27300 M3298800 SPACE 1 @OZ27300 M3298900 B NGBLDJOT BR TO REBUILD THE JOT @OZ27300 M3299000 EJECT @OZ27300 M3299100 ***************************************************************@OZ27300 M3299200 * @OZ27300 M3299300 * NGJQENXT -- SUBROUTINE TO GET ADDRESS OF NEXT JQE @OZ27300 M3299400 * @OZ27300 M3299500 * R1 - ADDRESS OF CURRENT JQE, UPDATED ON EXIT @OZ27300 M3299600 * WB - WORK @OZ27300 M3299700 * WC - JQE COUNT, INCREMENTED AS REQUIRED ON EXIT @OZ27300 M3299800 * WE - LINK REGISTER @OZ27300 M3299900 * WF - RETURN ADDRESS @OZ27300 M3300000 * R10 - JOB QUEUE ORIGIN @OZ27300 M3300100 * @OZ27300 M3300200 * RETURN TO +0 IF END OF CHAIN @OZ27300 M3300300 * RETURN TO +4 IF VALID JQE ADDRESS @OZ27300 M3300400 * EXIT TO NGBLDJBQ IF INVALID CHAIN FIELD @OZ27300 M3300500 * @OZ27300 M3300600 ***************************************************************@OZ27300 M3300700 SPACE 1 @OZ27300 M3300800 CNOP 0,8 @OZ27300 M3300900 NGJQENXT LH R1,JQECHAIN GET FULLWORD OFFSET @OZ27300 M3301000 N R1,=X'0000FFFF' OF NEXT JQE @OZ27300 M3301100 BZR WF RETURN IF NONE TO +0 @OZ27300 M3301200 SLL R1,2 EXPAND TO BYTE OFFSET @OZ27300 M3301300 LR WB,R1 RELOAD JQE OFFSET @OZ27300 M3301400 BAL WE,NGTJQECH TEST JQE CHAIN ADDRESS @OZ27300 M3301500 B NGBLDJBQ BR IF INVALID +0 @OZ27300 M3301600 LA WC,1(,WC) BUMP JQE ACCUMULATOR +4 @OZ27300 M3301700 CH WC,$MAXJOBS ARE WE LOOPING... @OZ27300 M3301800 BH NGBLDJBQ BR IF YES TO REBUILD JOB Q @OZ27300 M3301900 ALR R1,R10 ADD JOB QUEUE ORIGIN @OZ27300 M3302000 MVC JQEJOE,$ZEROS CLEAR WORK-JOE QUEUE HEAD @OZ27300 M3302100 B 4(,WF) AND RETURN TO +4 @OZ27300 M3302200 SPACE 1 @OZ27300 M3302300 ***************************************************************@OZ27300 M3302400 * @OZ27300 M3302500 * NGTJQECH -- SUBROUTINE TO VALIDATE JQE CHAIN FIELD @OZ27300 M3302600 * @OZ27300 M3302700 * WA - WORK @OZ27300 M3302800 * WB - JQE CHAIN FIELD BYTE OFFSET @OZ27300 M3302900 * WE - RETURN ADDRESS @OZ27300 M3303000 * @OZ27300 M3303100 * RETURN TO +0 IF CHAIN ADDRESS INVALID @OZ27300 M3303200 * RETURN TO +4 IF CHAIN ADDRESS VALID @OZ27300 M3303300 * @OZ27300 M3303400 ***************************************************************@OZ27300 M3303500 SPACE 1 @OZ27300 M3303600 CNOP 0,8 @OZ27300 M3303700 NGTJQECH SLR WA,WA CLEAR FOR DIVIDE @OZ27300 M3303800 D WA,=A(JQELNGTH) TEST JQE OFFSET FOR @OZ27300 M3303900 LTR WA,WA MULTIPLE OF JQE LENGTH @OZ27300 M3304000 BNZR WE RETURN IF NO TO +0 @OZ27300 M3304100 CH WB,$MAXJOBS TEST FOR WITHIN JOB QUEUE @OZ27300 M3304200 BNH 4(,WE) RETURN IF YES TO +4 @OZ27300 M3304300 BR WE ELSE RETURN TO +0 @OZ27300 M3304400 SPACE 1 @OZ27300 M3304500 DROP R1 KILL JQE ADDRESSABILITY @OZ27300 M3304600 EJECT @OZ27300 M3304700 ***************************************************************@OZ27300 M3304800 * @OZ27300 M3304900 * ***** REBUILD THE JOT ***** @OZ27300 M3305000 * @OZ27300 M3305100 * ALL JOE CHAINS WILL NOW BE REBUILT USING VALIDATED @OZ27300 M3305200 * JOE TYPES. INVALIDATED JOES WILL BE RETURNED TO THE @OZ27300 M3305300 * FREE QUEUE. @OZ27300 M3305400 * @OZ27300 M3305500 * CHAIN FIELDS WILL ALSO BE VALIDATED. AN INVALID JQE @OZ27300 M3305600 * POINTER OR CHAR-JOE POINTER WILL RESULT IN THE JOE @OZ27300 M3305700 * BEING FREED. AN INVALID CKPT-JOE POINTER WILL RESULT @OZ27300 M3305800 * IN THE POINTER BEING INVALIDATED. @OZ27300 M3305900 * @OZ27300 M3306000 * A SECOND PASS IS THEN MADE OF THE JOT. CHAR-JOE USE @OZ27300 M3306100 * COUNTS ARE THEN VALIDATED. IF ZERO, THE JOE IS FREED. @OZ27300 M3306200 * @OZ27300 M3306300 * A LAST PASS IS THEN MADE OF THE JOT. ANY CKPT-JOE @OZ27300 M3306400 * WHICH DOES NOT BACK-CHAIN TO ITS WORK-JOE IS FREED. @OZ27300 M3306500 * @OZ27300 M3306600 * FINALLY, IF ANY JOT ERRORS WHICH COULD NOT BE RELATED @OZ27300 M3306700 * TO A SPECIFIC JOB WERE ENCOUNTERED, A MESSAGE IS @OZ27300 M3306800 * ISSUED TO THE OPERATOR. @OZ27300 M3306900 * @OZ27300 M3307000 ***************************************************************@OZ27300 M3307100 SPACE 1 @OZ27300 M3307200 USING JOEDSECT,R1 PROVIDE JOE ADDRESSABILITY @OZ27300 M3307300 USING JOTDSECT,R10 PROVIDE JOT ADDRESSABILITY @OZ27300 M3307400 USING JQEDSECT,WD PROVIDE JQE ADDRESSABILITY @OZ27300 M3307500 SPACE 1 @OZ27300 M3307600 CNOP 4,8 @OZ27300 M3307700 NGBLDJOT L R10,$JOTABLE GET JOT ORIGIN @OZ27300 M3307800 MVC JOTFREC,$ZEROS CLEAR JOE FREE COUNT @OZ27300 M3307900 MVC JOTFREQ,$ZEROS CLEAR FREE QUEUE HEAD @OZ27300 M3308000 MVC JOTCHRQ,$ZEROS CLEAR CHAR-JOE QUEUE HEAD @OZ27300 M3308100 XC JOTRDYWQ,JOTRDYWQ CLEAR WORK-JOE HEADS @OZ27300 M3308200 LH R0,$NUMJOES GET COUNT OF JOES @OZ27300 M3308300 LA R1,JOTJOES-JOESIZE PREPARE TO SCAN JOES @OZ27300 M3308400 SPACE 1 @OZ27300 M3308500 NGNJOE1 LA R1,JOESIZE(,R1) POINT TO NEXT JOE @OZ27300 M3308600 LR WC,R1 RELOAD JOE ADDRESS @OZ27300 M3308700 SLR WC,R10 REDUCE JOE ADDRESS @OZ27300 M3308800 SLL WC,14 TO FULLWORD @OZ27300 M3308900 SRA WC,16 OFFSET @OZ27300 M3309000 CLI JOETYPE,$JOEFREE TEST JOE TYPE @OZ27300 M3309100 BE NGFRJOE4 BR IF FREE JOE @OZ27300 M3309200 CLI JOETYPE,$JOECKPT TEST JOE TYPE @OZ27300 M3309300 BE NGLOOP2 BR IF CKPT-JOE @OZ27300 M3309400 CLI JOETYPE,$JOECHAR TEST JOE TYPE @OZ27300 M3309500 BE NGQCHJOE BR IF CHAR-JOE @OZ27300 M3309600 CLI JOETYPE,$JOEWORK TEST JOE TYPE @OZ27300 M3309700 BNE NGFRJOE3 BR IF NOT WORK-JOE @OZ27300 M3309800 EJECT @OZ27300 M3309900 ***************************************************************@OZ27300 M3310000 * @OZ27300 M3310100 * WE HAVE A WORK JOE. TO BE VALID, THE JOE MUST HAVE A @OZ27300 M3310200 * POINTER TO A VALID JQE AND TO A VALID CHARACTERISTICS @OZ27300 M3310300 * JOE. IT MUST ALSO HAVE A VALID PDDB SYSOUT CLASS. AN @OZ27300 M3310400 * INVALID CHECKPOINT JOE WILL HAVE ITS POINTER IN THE @OZ27300 M3310500 * WORK JOE INVALIDATED. AN INVALID CURRENT SYSOUT CLASS @OZ27300 M3310600 * WILL BE REPLACED BY A VALIDATED PDDB SYSOUT CLASS. @OZ27300 M3310700 * @OZ27300 M3310800 ***************************************************************@OZ27300 M3310900 SPACE 1 @OZ27300 M3311000 LH WB,JOEJQE GET FULLWORD OFFSET @OZ27300 M3311100 N WB,=X'0000FFFF' OF JQE @OZ27300 M3311200 BZ NGFRJOE3 BR IF NONE @OZ27300 M3311300 SLL WB,2 EXPAND TO BYTE OFFSET @OZ27300 M3311400 LR WD,WB SAVE JQE OFFSET @OZ27300 M3311500 BAL WE,NGTJQECH TEST JQE CHAIN ADDRESS @OZ27300 M3311600 B NGFRJOE3 BRANCH IF INVALID +0 @OZ27300 M3311700 AL WD,$JOBQPTR ADD JOB QUEUE ORIGIN +4 @OZ27300 M3311800 CLI JQETYPE,$FREE TEST QUEUE TYPE @OZ27300 M3311900 BE NGFRJOE3 BR IF JQE FREE @OZ27300 M3312000 CLI JQETYPE,$PURGE TEST QUEUE TYPE @OZ27300 M3312100 BE NGFRJOE2 BR IF JOB QUEUED FOR PURGE @OZ27300 M3312200 IC WB,JOEPDBCL GET PDDB CLASS @OZ27300 M3312300 BAL WF,NGTJOECL TEST PDDB CLASS @OZ27300 M3312400 B NGFRJOE2 BR IF INVALID +0 @OZ27300 M3312500 IC WB,JOECURCL GET CURRENT CLASS +4 @OZ27300 M3312600 LR WE,WB SAVE CURRENT CLASS @OZ27300 M3312700 BAL WF,NGTJOECL TEST CLASS @OZ27300 M3312800 IC WE,JOEPDBCL GET PDDB CLASS +0 @OZ27300 M3312900 STC WE,JOECURCL SET CURRENT CLASS +4 @OZ27300 M3313000 LH WB,JOECHAR GET CHAR-JOE OFFSET @OZ27300 M3313100 BAL WE,NGTJOECH TEST CHAR-JOE ADDRESS @OZ27300 M3313200 B NGFRJOE2 BR IF INVALID +0 @OZ27300 M3313300 CLI JOETYPE-JOEDSECT(WF),$JOECHAR TEST JOE TYPE +4 @OZ27300 M3313400 BNE NGFRJOE2 BR IF NOT CHAR-JOE @OZ27300 M3313500 LH WB,JOECKPT GET CKPT-JOE OFFSET @OZ27300 M3313600 LTR WB,WB TEST FOR CKPT-JOE @OZ27300 M3313700 BNZ NGTSTCKP BR IF YES @OZ27300 M3313800 TM JOEFLAG,$JOECKV TEST CKPT-JOE VALID FLAG @OZ27300 M3313900 BZ NGQWKJOE BR IF FLAG VALID @OZ27300 M3314000 B NGFRJOE1 ELSE BR TO FREE CKPT-JOE @OZ27300 M3314100 EJECT @OZ27300 M3314200 NGTSTCKP BAL WE,NGTJOECH TEST CKPT-JOE ADDRESS @OZ27300 M3314300 B NGFRJOE1 BR IF INVALID +0 @OZ27300 M3314400 SPACE 1 @OZ27300 M3314500 USING JOEDSECT,WF ALTER JOE ADDRESSABILITY @OZ27300 M3314600 SPACE 1 @OZ27300 M3314700 CLI JOETYPE,$JOECKPT TEST JOE TYPE +4 @OZ27300 M3314800 BNE NGFRJOE1 BR IF NOT CKPT-JOE @OZ27300 M3314900 CH WC,JOEWORK TEST WORK-JOE OFFSET @OZ27300 M3314950 BE NGQWKJOE BR IF VALID @OZ27300 M3315000 SPACE 1 @OZ27300 M3315050 DROP WF RESTORE JOE ADDRESSABILITY @OZ27300 M3315100 SPACE 1 @OZ27300 M3315150 NGFRJOE1 NI JOEFLAG,FF-$JOECKV RESET JOE-VALID FLAG @OZ27300 M3315200 MVC JOECKPT,$ZEROS CLEAR CKPT-JOE POINTER @OZ27300 M3315300 BAL WF,NGJOTWTO WARN OPERATOR OF ERROR @OZ27300 M3315400 SPACE 1 @OZ27300 M3315500 NGQWKJOE SLR WB,WB CLEAR FOR INSERT @OZ27300 M3315600 IC WB,JOECURCL GET CURRENT CLASS @OZ27300 M3315700 IC WB,NGJOTCLS-C'A'(WB) GET CLASS QUEUE OFFSET @OZ27300 M3315800 LA WB,JOTCLSQ(WB) POINT TO PROPER CLASS QUEUE @OZ27300 M3315900 SPACE 1 @OZ27300 M3316000 NGADDJOE LH WE,0(,WB) L-I-F-O QUEUE @OZ27300 M3316100 STH WC,0(,WB) WORK-JOE @OZ27300 M3316200 STH WE,JOENEXT TO CLASS QUEUE @OZ27300 M3316300 LH WE,JQEJOE L-I-F-O QUEUE @OZ27300 M3316400 STH WC,JQEJOE WORK-JOE @OZ27300 M3316500 STH WE,JOEJOE TO JQE @OZ27300 M3316600 B NGLOOP2 BR TO PROCESS NEXT JOE @OZ27300 M3316700 SPACE 1 @OZ27300 M3316800 DROP WD KILL JQE ADDRESSABILITY @OZ27300 M3316900 SPACE 1 @OZ27300 M3317000 NGJOTCLS DC AL1(0,2,4,6,8,10,12,14,16),7AL1(0) A-I @OZ27300 M3317100 DC AL1(18,20,22,24,26,28,30,32,34),8AL1(0) J-R @OZ27300 M3317200 DC AL1(36,38,40,42,44,46,48,50),6AL1(0) S-Z @OZ27300 M3317300 DC AL1(52,54,56,58,60,62,64,66,68,70) 0-9 @OZ27300 M3317400 EJECT @OZ27300 M3317500 ***************************************************************@OZ27300 M3317600 * @OZ27300 M3317700 * CONSTRUCT CHAR-JOE CHAIN IN CHAR-FIELD SEQUENCE @OZ27300 M3317800 * @OZ27300 M3317900 ***************************************************************@OZ27300 M3318000 SPACE 1 @OZ27300 M3318100 CNOP 4,8 @OZ27300 M3318200 NGQCHJOE LA WE,JOTCHRQ-(JOENEXT-JOEDSECT) SET TO SCAN CHR Q @OZ27300 M3318300 SPACE 1 @OZ27300 M3318400 NGNJOE2 LR WF,WE RELOAD CHAIN ADDRESS @OZ27300 M3318500 LH WE,JOENEXT-JOEDSECT(,WE) GET FULLWORD OFFSET @OZ27300 M3318600 N WE,=X'0000FFFF' OF NEXT JOE @OZ27300 M3318700 BZ NGINSJOE BR IF END OF CHAIN @OZ27300 M3318800 SLL WE,2 EXPAND TO BYTE OFFSET @OZ27300 M3318900 ALR WE,R10 ADD JOT ORIGIN @OZ27300 M3319000 CLC JOESETUP,JOESETUP-JOEDSECT(WE) TEST SEQUENCE @OZ27300 M3319100 BH NGNJOE2 BR IF CURRENT JOE HIGHER @OZ27300 M3319200 SLR WE,R10 REDUCE JOE ADDRESS @OZ27300 M3319300 SRL WE,2 TO BYTE OFFSET @OZ27300 M3319400 SPACE 1 @OZ27300 M3319500 NGINSJOE STH WC,JOENEXT-JOEDSECT(,WF) INSERT JOE @OZ27300 M3319600 STH WE,JOENEXT INTO CHAIN @OZ27300 M3319700 B NGLOOP2 BR TO TEST NEXT JOE @OZ27300 M3319800 SPACE 1 @OZ27300 M3319900 NGFRJOE2 BAL WF,NGJOTWTO WARN OPERATOR OF ERROR @OZ27300 M3320000 B NGFRJOE4 BR TO CONTINUE @OZ27300 M3320100 SPACE 1 @OZ27300 M3320200 NGFRJOE3 MVI NGERRSW,1 SET JOT ERROR FLAG @OZ27300 M3320300 SPACE 1 @OZ27300 M3320400 NGFRJOE4 BAL WF,NGFREJOE ADD JOE TO FREE QUEUE @OZ27300 M3320500 SPACE 1 @OZ27300 M3320600 NGLOOP2 BCT R0,NGNJOE1 LOOP THRU ALL JOES @OZ27300 M3320700 EJECT @OZ27300 M3320800 ***************************************************************@OZ27300 M3320900 * @OZ27300 M3321000 * ENSURE CHAR-JOES AND WORK-JOES PROPERLY MATCHED @OZ27300 M3321100 * @OZ27300 M3321200 ***************************************************************@OZ27300 M3321300 SPACE 1 @OZ27300 M3321400 LA R1,JOTCHRQ-(JOENEXT-JOEDSECT) SET TO SCAN CHR Q @OZ27300 M3321500 SPACE 1 @OZ27300 M3321600 CNOP 0,8 @OZ27300 M3321700 NGNJOE3 LR WB,R1 SAVE LAST JOE ADDRESS @OZ27300 M3321800 LH R1,JOENEXT GET OFFSET OF NEXT JOE @OZ27300 M3321900 LR WE,R1 SAVE FOR WORK-JOE SCAN @OZ27300 M3322000 N R1,=X'0000FFFF' MASK OFF HI-ORDER BYTES @OZ27300 M3322100 BZ NGTCKJOE BR IF END OF CHAIN @OZ27300 M3322200 SLL R1,2 EXPAND TO BYTE OFFSET @OZ27300 M3322300 ALR R1,R10 ADD JOT ORIGIN @OZ27300 M3322400 LA WF,JOTJOES-JOESIZE PREPARE TO SCAN JOT @OZ27300 M3322500 LH R0,$NUMJOES GET NUMBER OF JOES @OZ27300 M3322600 SLR WD,WD CLEAR CHAR-JOE USE COUNT @OZ27300 M3322700 SPACE 1 @OZ27300 M3322800 USING JOEDSECT,WF ALTER JOE ADDRESSABILITY @OZ27300 M3322900 SPACE 1 @OZ27300 M3323000 CNOP 0,8 @OZ27300 M3323100 NGNJOE4 LA WF,JOESIZE(,WF) POINT TO NEXT JOE @OZ27300 M3323200 CLI JOETYPE,$JOEWORK TEST JOE TYPE @OZ27300 M3323300 BNE NGLOOP3 BR IF NOT WORK-JOE @OZ27300 M3323400 CH WE,JOECHAR POINT TO THIS CHAR-JOE... @OZ27300 M3323500 BNE NGLOOP3 BR IF NO @OZ27300 M3323600 LA WD,1(,WD) BUMP CHAR-JOE USE COUNT @OZ27300 M3323700 SPACE 1 @OZ27300 M3323800 DROP WF RESTORE JOE ADDRESSABILITY @OZ27300 M3323900 SPACE 1 @OZ27300 M3324000 NGLOOP3 BCT R0,NGNJOE4 LOOP THRU ENTIRE JOT @OZ27300 M3324100 SPACE 1 @OZ27300 M3324200 LTR WD,WD TEST JOE USE COUNT @OZ27300 M3324300 BZ *+12 BR IF ZERO @OZ27300 M3324400 CH WD,JOEUSE TEST JOE USE COUNT @OZ27300 M3324500 BE NGNJOE3 BR IF COUNT WAS CORRECT @OZ27300 M3324600 MVI NGERRSW,1 SET JOT ERROR FLAG @OZ27300 M3324700 STH WD,JOEUSE STORE NEW JOE USE COUNT @OZ27300 M3324800 LTR WD,WD TEST JOE USE COUNT @OZ27300 M3324900 BP NGNJOE3 BR IF NON-ZERO @OZ27300 M3325000 MVC JOENEXT-JOEDSECT(,WB),JOENEXT UN-CHAIN JOE @OZ27300 M3325100 BAL WF,NGFREJOE RETURN IT TO FREE QUEUE @OZ27300 M3325200 LR R1,WB POINT TO PREVIOUS JOE @OZ27300 M3325300 B NGNJOE3 BR TO CONTINUE @OZ27300 M3325400 EJECT @OZ27300 M3325500 ***************************************************************@OZ27300 M3325600 * @OZ27300 M3325700 * ENSURE CKPT-JOES AND WORK-JOES PROPERLY MATCHED @OZ27300 M3325800 * @OZ27300 M3325900 ***************************************************************@OZ27300 M3326000 SPACE 1 @OZ27300 M3326100 CNOP 0,8 @OZ27300 M3326200 NGTCKJOE LH R0,$NUMJOES GET NUMBER OF JOES @OZ27300 M3326300 LA R1,JOTJOES-JOESIZE PREPARE TO SCAN JOT @OZ27300 M3326400 SPACE 1 @OZ27300 M3326500 NGNJOE5 LA R1,JOESIZE(,R1) POINT TO NEXT JOE @OZ27300 M3326600 CLI JOETYPE,$JOECKPT TEST JOE TYPE @OZ27300 M3326700 BNE NGLOOP4 BR IF NOT CKPT-JOE @OZ27300 M3326800 LH WB,JOEWORK GET WORK-JOE OFFSET @OZ27300 M3326900 BAL WE,NGTJOECH TEST WORK-JOE ADDRESS @OZ27300 M3327000 B NGFRECKP BR IF INVALID +0 @OZ27300 M3327100 SPACE 1 @OZ27300 M3327200 USING JOEDSECT,WF ALTER JOE ADDRESSABILITY @OZ27300 M3327300 SPACE 1 @OZ27300 M3327400 CLI JOETYPE,$JOEWORK TEST JOE TYPE +4 @OZ27300 M3327500 BNE NGFRECKP BR IF NOT WORK-JOE @OZ27300 M3327600 LH WC,JOECKPT GET ADDRESS @OZ27300 M3327700 N WC,=X'0000FFFF' OF CKPT-JOE @OZ27300 M3327800 SLL WC,2 POINTED TO @OZ27300 M3327900 ALR WC,R10 BY WORK-JOE @OZ27300 M3328000 CLR WC,R1 POINT TO THIS CKPT-JOE... @OZ27300 M3328100 BE NGLOOP4 BR IF YES @OZ27300 M3328200 SPACE 1 @OZ27300 M3328300 DROP WF RESTORE JOE ADDRESSABILITY @OZ27300 M3328400 SPACE 1 @OZ27300 M3328500 NGFRECKP BAL WF,NGFREJOE RETURN CKPT-JOE TO FREE Q @OZ27300 M3328600 MVI NGERRSW,1 SET JOT ERROR FLAG @OZ27300 M3328700 SPACE 1 @OZ27300 M3328800 NGLOOP4 BCT R0,NGNJOE5 LOOP THRU ALL JOES @OZ27300 M3328900 SPACE 1 @OZ27300 M3329000 CLI NGERRSW,0 ANY ERRORS ENCOUNTERED... @OZ27300 M3329100 BE NGCKPT BR IF NO @OZ27300 M3329200 SPACE 1 @OZ27300 M3329300 OI $CKPTFLG,$CKPERRJ SHOW JOT ERROR DETECTED @OZ27300 M3329400 SPACE 1 @OZ27300 M3329500 $$WTO NGJOTMSG WARN OPERATOR OF JOT ERROR @OZ27300 M3329600 B NGCKPT BR TO CKPT JOB Q AND JOT @OZ27300 M3329700 EJECT @OZ27300 M3329800 ***************************************************************@OZ27300 M3329900 * @OZ27300 M3330000 * NGTJOECH -- SUBROUTINE TO VALIDATE JOE CHAIN FIELD @OZ27300 M3330100 * @OZ27300 M3330200 * WA - WORK @OZ27300 M3330300 * WB - JOE CHAIN FIELD BYTE OFFSET @OZ27300 M3330400 * WE - RETURN ADDRESS @OZ27300 M3330500 * WF - JOE ADDRESS, IF VALID, ON EXIT @OZ27300 M3330600 * @OZ27300 M3330700 * RETURN TO +0 IF CHAIN ADDRESS INVALID @OZ27300 M3330800 * RETURN TO +4 IF CHAIN ADDRESS VALID @OZ27300 M3330900 * @OZ27300 M3331000 ***************************************************************@OZ27300 M3331100 SPACE 1 @OZ27300 M3331200 CNOP 0,8 @OZ27300 M3331300 NGTJOECH N WB,=X'0000FFFF' MASK OFF HI-ORDER BYTES @OZ27300 M3331400 SLL WB,2 EXPAND TO BYTE OFFSET @OZ27300 M3331500 LA WF,0(R10,WB) SAVE JOE ADDRESS @OZ27300 M3331600 SH WB,=Y(JOTJOES-JOTDSECT) GET OFFSET FROM 1ST JOE @OZ27300 M3331700 BMR WE RETURN IF INVALID TO +0 @OZ27300 M3331800 SLR WA,WA CLEAR FOR DIVIDE @OZ27300 M3331900 D WA,=A(JOESIZE) GET RELATIVE JOE NUMBER @OZ27300 M3332000 LTR WA,WA TEST FOR VALID OFFSET @OZ27300 M3332100 BNZR WE RETURN IF NO TO +0 @OZ27300 M3332200 CH WB,$NUMJOES TEST FOR BEYOND JOT @OZ27300 M3332300 BL 4(,WE) RETURN IF NO TO +4 @OZ27300 M3332400 BR WE ELSE RETURN TO +0 @OZ27300 M3332500 SPACE 1 @OZ27300 M3332600 ***************************************************************@OZ27300 M3332700 * @OZ27300 M3332800 * NGTJOECL -- SUBROUTINE TO VALIDATE SYSOUT CLASS @OZ27300 M3332900 * @OZ27300 M3333000 * WB - SYSOUT CLASS @OZ27300 M3333100 * WF - RETURN ADDRESS @OZ27300 M3333200 * @OZ27300 M3333300 * RETURN TO +0 IF SYSOUT CLASS INVALID @OZ27300 M3333400 * RETURN TO +4 IF SYSOUT CLASS VALID @OZ27300 M3333500 * @OZ27300 M3333600 ***************************************************************@OZ27300 M3333700 SPACE 1 @OZ27300 M3333800 CNOP 0,8 @OZ27300 M3333900 NGTJOECL STC WB,NGWDBL SAVE SYSOUT CLASS @OZ27300 M3334000 LA WB,NGQCLIST-1 PREPARE TO SCAN CLASSES @OZ27300 M3334100 SPACE 1 @OZ27300 M3334200 NGTNXTCL LA WB,1(,WB) POINT TO NEXT CLASS @OZ27300 M3334300 CLI 0(WB),FF TEST FOR END OF LIST @OZ27300 M3334400 BER WF RETURN IF YES TO +0 @OZ27300 M3334500 CLC 0(1,WB),NGWDBL TEST FOR CLASS MATCH @OZ27300 M3334600 BE 4(,WF) RETURN IF YES TO +4 @OZ27300 M3334700 B NGTNXTCL ELSE BR TO CONTINUE SCAN @OZ27300 M3334800 SPACE 1 @OZ27300 M3334900 NGQCLIST DC C'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789',AL1(FF) @OZ27300 M3335000 NGERRSW DC X'00' JOT ERROR SWITCH @OZ27300 M3335100 EJECT @OZ27300 M3335200 ***************************************************************@OZ27300 M3335300 * @OZ27300 M3335400 * NGFREJOE -- SUBROUTINE TO ADD JOE TO FREE QUEUE @OZ27300 M3335500 * @OZ27300 M3335600 * R1 - JOE ADDRESS @OZ27300 M3335700 * WF - RETURN ADDRESS @OZ27300 M3335800 * R10 - JOT ORIGIN @OZ27300 M3335900 * R14 - WORK @OZ27300 M3336000 * R15 - WORK @OZ27300 M3336100 * @OZ27300 M3336200 ***************************************************************@OZ27300 M3336300 SPACE 1 @OZ27300 M3336400 CNOP 4,8 @OZ27300 M3336500 NGFREJOE MVI JOETYPE,$JOEFREE SHOW JOE ON FREE QUEUE @OZ27300 M3336600 LH R15,JOTFREC INCREMENT @OZ27300 M3336700 LA R15,1(,R15) FREE JOE @OZ27300 M3336800 STH R15,JOTFREC COUNT @OZ27300 M3336900 LA R15,JOTFREQ-(JOENEXT-JOEDSECT) SET TO SCAN JOES @OZ27300 M3337000 SPACE 1 @OZ27300 M3337100 NGNJOE6 LR R14,R15 SAVE CHAIN ADDRESS @OZ27300 M3337200 LH R15,JOENEXT-JOEDSECT(,R15) GET FULLWORD OFFSET @OZ27300 M3337300 N R15,=X'0000FFFF' OF NEXT JOE @OZ27300 M3337400 BZ NGJOEINS BR IF END OF CHAIN @OZ27300 M3337500 SLL R15,2 EXPAND TO BYTE OFFSET @OZ27300 M3337600 ALR R15,R10 ADD JOT ORIGIN @OZ27300 M3337700 CLR R1,R15 TEST ADDRESS OF CURRENT JOE @OZ27300 M3337800 BH NGNJOE6 BR IF STILL HIGHER @OZ27300 M3337900 SLR R15,R10 REDUCE ADDRESS @OZ27300 M3338000 SRL R15,2 TO FULLWORD OFFSET @OZ27300 M3338100 SPACE 1 @OZ27300 M3338200 NGJOEINS STH R15,JOENEXT INSERT @OZ27300 M3338300 LR R15,R1 CURRENT @OZ27300 M3338400 SLR R15,R10 JOE @OZ27300 M3338500 SRL R15,2 INTO @OZ27300 M3338600 STH R15,JOENEXT-JOEDSECT(,R14) FREE QUEUE @OZ27300 M3338700 BR WF RETURN TO CALLER @OZ27300 M3338800 EJECT @OZ27300 M3338900 ***************************************************************@OZ27300 M3339000 * @OZ27300 M3339100 * NGJOTWTO -- SUBROUTINE TO ISSUE JOB-RELATED JOT MSG @OZ27300 M3339200 * @OZ27300 M3339300 * WD - JQE ADDRESS @OZ27300 M3339500 * WF - RETURN ADDRESS @OZ27300 M3339600 * @OZ27300 M3339700 ***************************************************************@OZ27300 M3339800 SPACE 1 @OZ27300 M3339900 USING JQEDSECT,WD PROVIDE JQE ADDRESSABILITY @OZ27300 M3340000 * THIS CARD DELETED BY APAR @OZ35278 M3340010 SPACE 1 @OZ27300 M3340020 NGJOTWTO STM R0,R1,$DOUBLE SAVE REGISTERS @OZ27300 M3340040 L R1,=A(NGJOEMSG) GET ADDRESS OF MSG @OZ27300 M3340060 MVC NGJOBID-NGJOEMSG(,R1),=C'JOB' ASSUME BATCH JOB @OZ27300 M3340080 LH R0,JQEJOBNO GET JOB NUMBER @OZ27300 M3340100 CVD R0,$DWORK CONVERT TO DECIMAL @OZ27300 M3340120 CH R0,=H'10000' TEST FOR BATCH JOB @OZ27300 M3340140 BL NGWTOMVO BR IF YES @OZ27300 M3340160 MVC NGJOBID-NGJOEMSG(,R1),=C'STC' ASSUME STC JOB @OZ27300 M3340180 CH R0,=H'20000' TEST FOR STARTED TASK @OZ27300 M3340200 BL NGWTOMVO BR IF YES @OZ27300 M3340220 MVC NGJOBID-NGJOEMSG(,R1),=C'TSU' MUST BE LOGON @OZ27300 M3340240 SPACE 1 @OZ27300 M3340260 NGWTOMVO MVO $DWORK(4),$DWORK+4(4) OFFSET JOB NUMBER BY 1 @OZ27300 M3340280 MVC NGJOBNO-NGJOEMSG(,R1),=X'4020202021' MOVE MASK @OZ27300 M3340300 ED NGJOBNO-NGJOEMSG(,R1),$DWORK+1 EDIT JOB NUMBER @OZ27300 M3340320 $$WTO (R1) ISSUE MSG TO OPERATOR @OZ27300 M3340340 LM R0,R1,$DOUBLE RESTORE REGISTERS @OZ27300 M3340360 OI JQEFLAGS,QUEHOLD1 HOLD THE JOB @OZ27300 M3340380 BR WF AND RETURN TO CALLER @OZ27300 M3340400 SPACE 1 @OZ27300 M3340420 DROP WD KILL JQE ADDRESSABILITY @OZ27300 M3340440 DROP R1,R10 KILL JOE, JOT ADDRESSABILITY@OZ27300 M3340460 EJECT @OZ27300 M3340480 ***************************************************************@OZ27300 M3340500 * @OZ27300 M3340520 * ADJUST INITIALIZATION CCW CHAIN TO FORMAT-WRITE THE @OZ27300 M3340540 * CHECKPOINT @OZ27300 M3340560 * @OZ27300 M3340580 ***************************************************************@OZ27300 M3340600 SPACE 1 @OZ27300 M3340620 * ADDRESSABILITY -- @OZ27300 M3340640 USING JQBCCWE,R1 -- CCW PACKET @OZ27300 M3340660 USING NVLDSECT,WD -- NVOLTBL ENTRY @OZ27300 M3340680 USING JQBDSECT,R10 -- JQB @OZ27300 M3340700 SPACE 1 @OZ27300 M3340720 NGCKPT L R10,$JQB PICK UP JQB ADDRESS AND @OZ27300 M3340740 L WD,NVOLTABL PRIMARY NVOLTBL ENTRY @OZ27300 M3340760 SPACE 1 @OZ27300 M3340780 TM JQBFLAG1,JQB1PRIM TEST FOR PRIMARY CCW SETUP @OZ27300 M3340800 BZ NGCKPTSW SKIP IF SECONDARY ALREADY @OZ27300 M3340820 TM $STATUS,$DUPLEX TEST FOR THIS SYSTEM DPLXNG @OZ27300 M3340840 BZ NGCKPTFX SKIP IF NOT @OZ27300 M3340860 BAL R14,NGCKSWAP ELSE, SWAP CCW PACKETS @OZ27300 M3340880 SPACE 1 @OZ27300 M3340900 NGCKPTSW LA WD,NVLTBLN(,WD) USE SECONDARY NVOLTBL ENTRY @OZ27300 M3340920 SPACE 1 @OZ27300 M3340940 NGCKPTFX LA R1,JQBMSTR LOCATE MASTER CCW PACKET @OZ27300 M3340960 LH R7,$JOBRECN COMPUTE @OZ27300 M3340980 AH R7,$JOTRECN NUMBER OF @OZ27300 M3341000 LA R7,1(,R7) CCW PACKETS @OZ27300 M3341020 SPACE 1 @OZ27300 M3341040 NGCKPTLP MVI JQBFMT,WRITE+CKD SET CCW TO FORMAT WRITE @OZ27300 M3341060 LRA R2,JQBCOUNT SET REAL ADDRESS @OZ27300 M3341080 STCM R2,7,JQBFMT+CCWADDR OF COUNT INFORMATION @OZ27300 M3341100 SPACE 1 @OZ27300 M3341120 LRA R2,JQBCCHH0 SET SEARCH ID TO POINT @OZ27300 M3341140 STCM R2,7,JQBFSID+CCWADDR TO RECORD ZERO ID @OZ27300 M3341160 SPACE 1 @OZ27300 M3341180 LA R1,JQBCNEXT BUMP TO NEXT CCW PACKET @OZ27300 M3341200 BCT R7,NGCKPTLP LOOP TILL ALL CCWS ADJUSTED @OZ27300 M3341220 EJECT @OZ27300 M3341240 * RESET THIS SYSTEMS CHECKPOINT CONTROL BYTES @OZ27300 M3341260 SPACE 2 @OZ27300 M3341280 L R2,$CTLB LOCATE CONTROL BYTES @OZ27300 M3341300 LH R0,$JOBRECN COMPUTE OF @OZ27300 M3341320 AH R0,$JOTRECN CONTROL BYTES @OZ27300 M3341340 IC R1,$SIDAFF GET OUR SYSTEM ID @OZ27300 M3341440 TM $STATUS,$DUPLEX ARE WE DUPLEXING... @OZ27300 M3341500 BZ *+8 BR IF NO @OZ27300 M3341600 LA R1,X'80'(,R1) ELSE ADD DUPLEX BIT @OZ27300 M3341700 LCR R1,R1 COMPLEMENT FOR @OZ27300 M3341800 BCTR R1,0 RESET OPERATION @OZ27300 M3341900 SPACE 1 @OZ27300 M3342000 NGCKPTN EX R1,NGCKPTNI RESET OUR SYSTEM BIT + DPLX @OZ27300 M3342100 LA R2,1(,R2) BUMP TO NEXT BYTE @OZ27300 M3342200 BCT R0,NGCKPTN RESET ALL CONTROL BYTES @OZ27300 M3342300 EJECT @OZ27300 M3342400 ***************************************************************@OZ27300 M3342500 * @OZ27300 M3342600 * FORMAT WRITE JOB QUEUE AND JOT TO SECONDARY @OZ27300 M3342700 * (IF PRESENT) AND PRIMARY CHECKPOINT DATA SETS @OZ27300 M3342800 * @OZ27300 M3342900 ***************************************************************@OZ27300 M3343000 SPACE 1 @OZ27300 M3343100 LA R1,JQBFMTW+JQBFSID-JQBCCWE SETUP FOR @OZ27300 M3343200 ST R1,JQBSTART FMT-WRITE EXCP @OZ27300 M3343300 SPACE 1 @OZ27300 M3343400 LA R1,JQBMSTR LOCATE MASTER RECORD PACKET @OZ27300 M3343500 SPACE 1 @OZ27300 M3343600 L R2,$QSE1 PICK UP 1ST QSE @OZ27300 M3343700 SLR R14,R14 ASSUME SID = 0 @OZ27300 M3343800 TM QSEFLAGS-QSEDSECT(R2),QSELAST TEST FOR MAS @OZ44167 M3343900 BO *+8 BR IF NOT, ELSE @OZ44167 M3344000 IC R14,$SIDBUSY USE MAS $SID @OZ27300 M3344100 SPACE 1 @OZ27300 M3344200 STC R14,JQBLKEY SET LOCK RECORD @OZ27300 M3344300 MVC JQBLKEY+1(4),$SID KEY AND @OZ27300 M3344400 STC R14,JQBLDATA DATA FIELDS @OZ27300 M3344500 MVC JQBLDATA+1(4),$SID FOR FORMAT-WRITE @OZ27300 M3344600 MVI $WCHECK,130 SET CHECK VALUE @OZ27300 M3344700 MVI JQBCKVAL,130 IN HCT AND JQB @OZ27300 M3344800 L R1,$MASTER MOVE HCT VARIABLES @OZ40303 M3344900 MVC 0($SAVELEN,R1),$SAVEBEG TO JOB QUEUE BUFFER @OZ40303 M3344950 NGCKPTWR OI JQBFLAG1,JQB1WRT SHOW WRITE ACTIVE @OZ27300 M3345000 BAL R14,NGCKADJ AND ADJUST CCW CHAIN @OZ27300 M3345100 SPACE 1 @OZ27300 M3345200 BAL R14,NGEXCP WRITE JOB QUEUE AND JOT @OZ27300 M3345300 BNZ NGCKMSGW BR IF I/O ERROR @OZ27300 M3345400 SPACE 1 @OZ27300 M3345500 CLC JQBVERFY,NGCKFFFF TEST FOR I/O COMPLETE @OZ27300 M3345600 BE NGCKMSGW BRANCH IF NOT, ERROR @OZ27300 M3345700 SPACE 1 @OZ27300 M3345800 TM JQBFLAG1,JQB1PRIM TEST FOR PRIMARY WRITE @OZ27300 M3345900 BO NGCKPTXT BRANCH IF YES @OZ27300 M3346000 SPACE 1 @OZ27300 M3346100 L WD,NVOLTABL SET CCWS TO PRIMARY @OZ27300 M3346200 BAL R14,NGCKSWAP CHECKPOINT CCW CHAIN @OZ27300 M3346300 SPACE 1 @OZ27300 M3346400 B NGCKPTWR GO REPEAT WRITE FOR PRIMARY @OZ27300 M3346500 SPACE 1 @OZ27300 M3346600 NGCKPTNI NI 0(R2),*-* *** EXECUTE ONLY *** @OZ27300 M3346700 SPACE 1 @OZ27300 M3346800 DROP R1 KILL PACKET ADDRESSABILITY @OZ27300 M3346900 EJECT @OZ27300 M3347000 * RESET SSVT RESERVE BIT IF NOT NODAL WARM START @OZ27300 M3347100 SPACE 1 @OZ27300 M3347200 NGCKPTXT CLC $ESYSQSE,$ZEROS TEST FOR NODAL WARM START @OZ27300 M3347300 BE NGCKRLSE BR IF YES @OZ27300 M3347400 L R2,$SSVT ELSE, TELL WARM START TO @OZ27300 M3347500 NI $SVSTUS-SSVT(R2),FF-$SVSTIRV RELEASE CKPT @OZ27300 M3347600 SPACE 1 @OZ27300 M3347700 NGCKRLSE L R2,$QSE1 LOCATE FIRST QSE @OZ27300 M3347800 TM QSEFLAGS-QSEDSECT(R2),QSELAST SINGLE SYSTEM... @OZ27300 M3347900 BNO NGCKPTFR BRANCH IF NO @OZ27300 M3348000 SPACE 1 @OZ27300 M3348100 L R15,=A(NCKPRLSE) ELSE, RELEASE CHECKPOINT @OZ27300 M3348200 BALR R14,R15 LOCK FOR SINGLE SYSTEM @OZ35278 M3348250 $RELEASE RELEASE CHECKPOINT RESERVE @OZ35278 M3348300 SPACE 1 @OZ27300 M3348400 ***************************************************************@OZ27300 M3348500 * @OZ27300 M3349000 * FREE CHECKPOINT AREA PAGES AND RELEASE READ IN AREA @OZ27300 M3349500 * @OZ27300 M3350000 ***************************************************************@OZ27300 M3350500 SPACE 1 @OZ27300 M3351000 NGCKPTFR NI JQBFLAG1,FF-JQB1WRT-JQB1INIT SHOW WRITES AND @OZ27300XM3351500 D/A INIT COMPLETE @OZ27300 M3352000 SPACE 1 @OZ27300 M3352500 L R0,$MASTERL PICK UP LENGTH AND ADDRESS @OZ27300 M3353000 L R1,$MASTER OF MASTER CKPT RECORD AREA @OZ27300 M3353500 $PGSRVC FREE,(R1),(R0) AND FREE ITS PAGE FRAMES @OZ27300 M3354000 SPACE 1 @OZ27300 M3354500 L R1,$MASTERI PICK UP CKPT I/O AREA ADDR @OZ27300 M3355000 $PGSRVC RLSE,(R1),(R0) AND RELEASE ITS PAGES @OZ27300 M3355500 SPACE 1 @OZ27300 M3356000 L R0,$JOBQSIZ COMPUTE SIZE OF JOB QUEUE @OZ27300 M3356500 AL R0,$JOTSIZE AND JOT AREAS @OZ27300 M3357000 L R1,$JOBQPTR PICK UP AREA ADDRESS @OZ27300 M3357500 $PGSRVC FREE,(R1),(R0) AND FREE ITS PAGE FRAMES @OZ27300 M3358000 SPACE 1 @OZ27300 M3358500 L R1,$JOBQIO PICK UP I/O AREA ADDRESS @OZ27300 M3359000 $PGSRVC RLSE,(R1),(R0) AND RELEASE ITS PAGES @OZ27300 M3359500 EJECT @OZ27300 M3360000 ***************************************************************@OZ27300 M3360500 * @OZ27300 M3361000 * CREATE FINAL CHECKPOINT IOB VALUES @OZ27300 M3361500 * @OZ27300 M3362000 ***************************************************************@OZ27300 M3362500 SPACE 1 @OZ27300 M3363000 USING $SVDSECT,R2 PROVIDE SSVT ADDRESSABILITY @OZ27300 M3363500 SPACE 1 @OZ27300 M3364000 L R2,$SSVT POINT TO SSVT @OZ27300 M3364500 L R10,$HASPECB POINT TO ECB @OZ27300 M3365000 L R1,$JQB POINT TO CHECKPOINT JQB @OZ27300 M3365500 ST R10,JQBECBP-JQBDSECT(,R1) SET CHKPT IOB ECBP @OZ27300 M3366000 SPACE 2 @OZ27300 M3366500 TM $SVHASP,X'80' TEST FOR JES2 RESTART @OZ27300 M3367000 BO NGEXITND BR IF YES @OZ27300 M3367500 MVC $SVTGTOT,NGXTGS ELSE SET TOTAL AVAIL TRKS @OZ27300 M3368000 TM $RUNOPTS,$RPS TEST RPS OPTION @OZ27300 M3368500 BZ NGEXITND BR IF NOT SELECTED @OZ27300 M3369000 SPACE 1 @OZ27300 M3369500 DROP R2 KILL SSVT ADDRESSABILITY @OZ27300 M3370000 EJECT @OZ27300 M3370500 ***************************************************************@OZ27300 M3371000 * @OZ27300 M3371500 * CREATE ROTATIONAL POSITION SENSING TABLES @OZ27300 M3372000 * @OZ27300 M3372500 ***************************************************************@OZ27300 M3373000 SPACE 1 @OZ27300 M3373500 USING DEBDSECT,WB PROVIDE DEB ADDRESSABILITY @OZ27300 M3374000 USING TEDDSECT,WC PROVIDE TED ADDRESSABILITY @OZ27300 M3374500 USING UCBDSECT,WD PROVIDE UCB ADDRESSABILITY @OZ27300 M3375000 SPACE 1 @OZ27300 M3375500 ICM WD,15,NRPSTBLN GET SIZE OF RPS TABLE @OZ27300 M3376000 BZ NGEXITND EXIT IF NO RPS DEVICES @OZ27300 M3376500 AL WD,=AL1(231,0,0,8) ADD CSA SUBPOOL, PREFIX LEN @OZ35996 M3376600 LR R0,WD COPY SP/LENGTH @OZ35996 M3376700 GETMAIN R,LV=(0) GET CSA SPACE FOR SECTOR TBL@OZ35996 M3377000 MVC 0(4,R1),=C'$RPS' SET EYE-CATCHER IN PREFIX @OZ35996 M3377100 ST WD,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M3377200 L WB,$DADEBAD PREPARE TO SCAN @OZ27300 M3377500 LA WB,DEBBASND-16 DEB EXTENTS @OZ27300 M3378000 L WC,TEDSTART PREPARE TO SCAN @OZ27300 M3378500 SH WC,=Y(TEDSIZ) TED ENTRIES @OZ27300 M3379000 SLR WE,WE SET INITIAL EXTENT NUMBER @OZ27300 M3379500 LA WF,8(,R1) POINT PAST PREFIX @OZ35996 M3379550 L R1,$SSVT STORE ADDRESS OF RPS @OZ35996 M3379600 ST WF,$SVRPS-SSVT(,R1) TABLES INTO SSVT @OZ35996 M3379650 SPACE 1 @OZ27300 M3379700 USING DEBDASD,WB PROVIDE DEB EXTENT BASE @OZ27300 M3379800 SPACE 1 @OZ27300 M3379900 NEXTXTNT LA WB,16(,WB) POINT TO NEXT DEB EXTENT @OZ27300 M3380000 LA WC,TEDSIZ(,WC) POINT TO NEXT TED ENTRY @OZ27300 M3380100 CLM WE,1,$NUMDA TEST FOR END OF EXTENTS @OZ27300 M3380200 BNL NGEXITND EXIT IF YES @OZ27300 M3380300 LA WE,1(,WE) ELSE BUMP EXTENT NUMBER @OZ27300 M3380400 ICM WD,7,DEBUCBA GET UCB ADDRESS @OZ27300 M3380500 BZ NEXTXTNT BR IF NULL EXTENT @OZ27300 M3380600 TM UCBTBYT2,UCBRPS TEST DEVICE FOR RPS @OZ27300 M3380700 BZ NEXTXTNT BR IF NO @OZ27300 M3380800 ST WF,TRPS SET TED RPS TABLE ADDRESS @OZ27300 M3380900 SLR R0,R0 FOR IEC0SCR1, @OZ27300 M3381000 ICM R0,12,$BUFSIZE R0 = DDKR (DD = &BUFSIZE) @OZ27300 M3381100 LR R2,WF FOR IECOSCR1, @OZ27300 M3381200 ICM R2,8,UCBTBYT4 R2 = TAAA @OZ27300 M3381300 LH R10,TNRT GET RECORDS/TRK THIS EXTENT @OZ27300 M3381400 SPACE 1 @OZ27300 M3381500 NEXTRCD AL R0,=F'1' ADD 1 TO RECORD NUMBER @OZ27300 M3381600 AL R2,=F'1' ADD 1 TO SINK NUMBER @OZ27300 M3381700 STM R0,R15,NGEXIT SAVE OUR REGS @OZ27300 M3381800 L R15,CVTPTR GET ADDRESS OF @OZ27300 M3381900 L R15,CVT0SCR1-CVT(,R15) IEC0SCR1 @OZ27300 M3382000 BALR R14,R15 LINK TO IEC0SCR1 @OZ27300 M3382100 LM R0,R15,NGEXIT RESTORE OUR REGS @OZ27300 M3382200 BCT R10,NEXTRCD LOOP THRU ALL RECORDS @OZ27300 M3382300 SPACE 1 @OZ27300 M3382400 LA WF,1(,R2) SET DEV TBL REG FOR NEXT @OZ27300 M3382500 B NEXTXTNT BR TO TEST NEXT EXTENT @OZ27300 M3382600 EJECT @OZ27300 M3382700 ***************************************************************@OZ27300 M3382800 * @OZ27300 M3382900 * NORMAL EXIT FROM DIRECT ACCESS INITIALIZATION @OZ27300 M3383000 * @OZ27300 M3383100 ***************************************************************@OZ27300 M3383200 SPACE 1 @OZ27300 M3383300 NGEXITND SLR R1,R1 FREE @OZ27300 M3383400 IC R1,$NUMDA STORAGE @OZ27300 M3383500 LA R0,3(,R1) FOR @OZ27300 M3383600 MH R0,=Y(NVLTBLN) VOLUME @OZ27300 M3383700 L R1,NVOLTABL ALLOCATION @OZ27300 M3383800 FREEMAIN R,LV=(0),A=(1) TABLE @OZ27300 M3383900 L R15,=A(NCMBINIT) POINT TO NEXT SECTION @OZ27300 M3384000 BR R15 AND BR TO NEXT SECTION @OZ27300 M3384100 EJECT @OZ27300 M3384200 ***************************************************************@OZ27300 M3384300 * @OZ27300 M3384400 * ABNORMAL EXITS FROM DIRECT ACCESS INITIALIZATION @OZ27300 M3384500 * @OZ27300 M3384600 ***************************************************************@OZ27300 M3384700 SPACE 1 @OZ27300 M3384800 NDAERR2 L R1,=A(NDAEM2) POINT TO ERROR MESSAGE @OZ27300 M3384900 SLR R0,R0 SET @OZ27300 M3385000 IC R0,$NUMDA MAXIMUM @OZ27300 M3385100 CVD R0,NGWDBL SPOOL @OZ27300 M3385200 OI NGWDBL+7,X'0F' VOLUME @OZ27300 M3385300 UNPK NDAEM2A-NDAEM2(,R1),NGWDBL+6(2) COUNT @OZ27300 M3385400 CLI NDAEM2A-NDAEM2(R1),C'0' IN @OZ27300 M3385500 BNE NGKWIT ERROR @OZ40377 M3385600 MVI NDAEM2A-NDAEM2(R1),C' ' MESSAGE @OZ27300 M3385700 B NGKWIT BR TO ISSUE MSG & QUIT @OZ40377 M3385800 SPACE 1 @OZ27300 M3385900 NGCKMSGW L R1,=A(NGCKMSG) POINT TO MESSAGE TEXT @OZ27300 M3386000 MVC NGCKMSGZ-NGCKMSG(,R1),=C'WRIT' CHANGE TO WRITE @OZ27300 M3386500 SPACE 2 @OZ27300 M3387000 NGCKMSGR L R1,=A(NGCKMSG) POINT TO MESSAGE TEXT @OZ27300 M3387500 SPACE 1 @OZ27300 M3388000 MVC NM420VOL-NGCKMSG(,R1),NVLVOLID-NVLDSECT(WD) SET @OZ27300XM3388500 VOLUME SERIAL IN MSG @OZ27300 M3389000 SPACE 2 @OZ27300 M3389500 NGKWIT $$WTO (R1) ISSUE ERROR MESSAGE TO @OZ27300XM3390000 OPERATOR @OZ27300 M3390500 SPACE 2 @OZ27300 M3391000 * EXIT INITIALIZATION WITH FINAL MESSAGE @OZ27300 M3391500 SPACE 1 @OZ27300 M3392000 NGQUITT $EXIT NGQUITM ISSUE 'QUIT' MSG AND QUIT @OZ27300 M3392500 SPACE 1 @OZ27300 M3393000 DROP WB RELEASE DEB, @OZ27300 M3393500 DROP WC TED AND @OZ27300 M3394000 DROP WD UCB ADDRESSABILITY @OZ27300 M3394500 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION SUBCM3395000 ROUTINES' R4 M3395500 *********************************************************************** M3396000 * * M3396500 * NGSPLGET -- SUBROUTINE TO OBTAIN AND FORMAT DYNAMIC * M3397000 * SPOOL ALLOCATION WORK AREA * M3397500 * * M3398000 * WC - SPL ADDRESS ON EXIT * M3398500 * WD - VOLUME ALLOCATION TABLE ENTRY ADDRESS * M3399000 * WE - RETURN ADDRESS * M3399500 * * M3400000 *********************************************************************** M3400500 SPACE 1 R4 M3401000 USING UCBDSECT,R1 PROVIDE UCB ADDRESSABILITY R4 M3401500 USING SPLDSECT,WC PROVIDE SPL ADDRESSABILITY R4 M3402000 USING NVLDSECT,WD PROVIDE ALLOC TBL ADDRESSABILITY R4 M3402500 SPACE 1 R4 M3403000 NGSPLGET LH WC,$NUMTGV COMPUTE SIZE R4 M3403500 LA WC,7(,WC) OF TRACK GROUP MAP R4 M3404000 SRL WC,3 FOR SINGLE VOLUME R4 M3404500 LA R0,SPLTGM ADD REST OF WORK AREA R4 M3405000 STH R0,NGSPLLNG SAVE WORK AREA LENGTH R4 M3405500 ICM R0,8,=AL1(229) GET DYNAMIC SPOOL ALLOCATION R4 M3406000 GETMAIN R,LV=(0) WORK AREA FROM SUBPOOL 229 R4 M3406500 LR WC,R1 RELOAD SPL ADDRESS R4 M3407000 LR R0,R1 CLEAR R4 M3407500 LH R1,NGSPLLNG SPOOL R4 M3408000 SLR R15,R15 WORK R4 M3408500 MVCL R0,R14 AREA R4 M3409000 MVC SPLLENG,NGSPLLNG SET WORK AREA LENGTH R4 M3409500 MVC SPLFLG1,NVLFLAGS SET REQUEST FLAGS R4 M3410000 MVC SPLVOLID,NVLVOLID SET VOLUME SERIAL R4 M3410500 ICM R1,15,NVLUCBPT IF NO UCB YET, R4 M3411000 BZR WE RETURN R4 M3411500 ST R1,SPLUCBPT ELSE SET UCB ADDRESS R4 M3412000 MVC SPLUNIT,UCBNAME AND UNIT NAME R4 M3412500 BR WE THEN RETURN R4 M3413000 SPACE 1 R4 M3413500 NGSPLLNG DS H WORK AREA LENGTH R4 M3414000 SPACE 1 R4 M3414500 DROP R1,WD KILL UCB/ALLOC TBL ADDRESSABILITY R4 M3415000 EJECT R4 M3415500 *********************************************************************** M3416000 * * M3416500 * NGALLOC -- SUBROUTINE TO ATTACH HOSPOOL TO DYNAMICALLY * M3417000 * ALLOCATE AND, OPTIONALLY, FORMAT A SPOOL/ * M3417500 * CHECKPOINT VOLUME * M3418000 * * M3418500 * WC - SPL ADDRESS * M3419000 * WE - RETURN ADDRESS * M3419500 * * M3420000 *********************************************************************** M3420500 SPACE 1 R4 M3421000 NGALLOC OC SPLUCBPT,SPLUCBPT IF VOLUME MOUNTED, R4 M3421500 BNZ NGAL BR TO ALLOCATE IT R4 M3422000 L R1,=A(NGDMSG) POINT TO ERROR MESSAGE R4 M3422500 MVC NGDVOLID-NGDMSG(,R1),SPLVOLID SET VOLUME SERIAL R4 M3423000 B NGKWIT ISSUE 'NOT MOUNTED' MSG AND QUIT R4 M3423500 SPACE 1 R4 M3424000 NGAL LA R14,=CL8'HOSPOOL' HOSPOOL ENTRY POINT NAME R4 M3424500 LR R1,WC GIVE WORK AREA TO SUBTASK R4 M3425000 LA R0,SPLWTECB TERMINATION ECB ADDRESS R4 M3425500 ATTACH EPLOC=(R14),SM=SUPV,ECB=(R0) ATTACH HOSPOOL R4 M3426000 ST R1,SPLTCBPT SAVE TCB ADDRESS R4 M3426500 BR WE AND RETURN R4 M3427000 EJECT R4 M3427500 *********************************************************************** M3428000 * * M3428500 * NGWAIT -- SUBROUTINE TO WAIT ON RETURN FROM HOSPOOL * M3429000 * AND TEST FOR ANY ERRORS * M3429500 * * M3430000 * WC - SPL ADDRESS * M3430500 * WE - RETURN ADDRESS * M3431000 * * M3431500 * CONDITION CODE SET TO ZERO IF NO ERRORS, ELSE NON-ZERO * M3432000 * * M3432500 *********************************************************************** M3433000 SPACE 1 R4 M3433500 NGWAIT WAIT ECB=SPLWTECB WAIT FOR HOSPOOL TO RETURN R4 M3434000 TM SPLFLG2,X'FF' TEST FOR ERROR(S) R4 M3434500 BZR WE RETURN IF NO WITH CC = 0 R4 M3435000 SPACE 1 R4 M3435500 NGWUNAL L R1,=A(NUNALMSG) POINT TO MESSAGE TEXT R4 M3436000 MVC NUNALVOL-NUNALMSG(,R1),SPLVOLID SET VOLUME SERIAL R4 M3436500 $$WTO (R1) ISSUE MESSAGE TO OPERATOR R4 M3437000 LNR R15,R15 SET NON-ZERO CC @OZ48331 M3437500 BR WE AND RETURN R4 M3438000 EJECT R4 M3438500 *********************************************************************** M3439000 * * M3439500 * NGDETACH -- SUBROUTINE TO DETACH HOSPOOL AND TO FREE * M3440000 * DYNAMIC SPOOL ALLOCATION WORK AREA * M3440500 * * M3441000 * WC - SPL ADDRESS * M3441500 * WE - RETURN ADDRESS * M3442000 * * M3442500 *********************************************************************** M3443000 SPACE 1 R4 M3443500 NGDETACH DETACH SPLTCBPT DETACH HOSPOOL R4 M3444000 LH R0,SPLLENG GET WORK AREA LENGTH R4 M3444500 ICM R0,8,=AL1(229) AND SUBPOOL NUMBER R4 M3445000 LR R1,WC RELOAD WORK AREA ADDRESS R4 M3445500 FREEMAIN R,LV=(0),A=(1) FREE WORK AREA R4 M3446000 BR WE THEN RETURN R4 M3446500 EJECT R4 M3447000 *********************************************************************** M3447500 * * M3448000 * NGDEBSET -- SUBROUTINE TO CONSTRUCT JES2 DIRECT ACCESS * M3448500 * DEB EXTENT AND TRACK EXTENT DATA AREA (TED) * M3449000 * * M3449500 * WC - SPL ADDRESS * M3450000 * WE - RETURN ADDRESS * M3450500 * WF - RELATIVE EXTENT NUMBER * M3451000 * * M3451500 *********************************************************************** M3452000 SPACE 1 R4 M3452500 USING UCBDSECT,R1 PROVIDE UCB ADDRESSABILITY R4 M3453000 USING DEBDSECT,R14 PROVIDE DEB ADDRESSABILITY R4 M3453500 USING TEDDSECT,R15 PROVIDE TED ADDRESSABILITY R4 M3454000 SPACE 1 R4 M3454500 NGDEBSET L R14,$DADEBAD POINT R4 M3455000 LR R1,WF TO JES2 R4 M3455500 SLL R1,4 DIRECT ACCESS R4 M3456000 LA R14,DEBBASND(R1) DEB EXTENT R4 M3456500 SPACE 1 R4 M3457000 USING DEBDASD,R14 PROVIDE DEB EXTENT ADDRESSABILITY R4 M3457500 SPACE 1 R4 M3458000 L R1,SPLUCBPT GET UCB ADDRESS R4 M3458500 ST R1,DEBUCBAD SET UCB ADDRESS R4 M3459000 MVC DEBSTRCC(8),SPLSTRCC EXTENT LIMITS, R4 M3459500 MVC DEBNMTRK,SPLNMTRK AND NUMBER OF TRACKS R4 M3460000 LR R15,WF POINT R4 M3460500 MH R15,=Y(TEDSIZ) TO R4 M3461000 AL R15,TEDSTART TED ENTRY R4 M3461500 MVC TNRT,SPLTNRT SET RECORDS PER TRACK R4 M3462000 MVC TNTC,SPLTNTC SET NUMBER OF HEADS PER CYLINDER R4 M3462500 MVC TNTG,SPLTNTG SET NUMBER OF TRACKS PER GROUP R4 M3463000 L R0,$TGMAP SET ADDRESS OF R4 M3463500 AH R0,TNMO START OF THIS VOLUME'S R4 M3464000 ST R0,TNCH SEGMENT OF MASTER TRK GRP MAP R4 M3464500 L R0,SPLNUMTG UPDATE COUNT R4 M3465000 AL R0,NGXTGS OF AVAILABLE R4 M3465500 ST R0,NGXTGS TRACK GROUPS R4 M3466000 TM UCBTBYT2,UCBRPS TEST DEVICE FOR RPS R4 M3466500 BZ NGDEBCEL BR IF NO R4 M3467000 LH R1,TNRT ELSE R4 M3467500 LA R1,1(,R1) UPDATE R4 M3468000 AL R1,NRPSTBLN SIZE OF R4 M3468500 ST R1,NRPSTBLN RPS SECTOR TABLE R4 M3469000 SPACE 1 R4 M3469500 NGDEBCEL MVC TTCM,TNRT SET MINIMUM TRACK CELL SIZE R4 M3470000 CLC $TCELSIZ,TNRT+1 USE RECORDS/TRACK IF $TCELSIZ R4 M3470500 BHR WE IS GREATER THAN RECORDS/TRACK R4 M3471000 SLR R1,R1 ELSE, R4 M3471500 IC R1,$TCELSIZ USE R4 M3472000 LA R1,1(,R1) 50 PERCENT R4 M3472500 SRL R1,R1 OF R4 M3473000 STH R1,TTCM $TCELSIZ R4 M3473500 BR WE THEN RETURN R4 M3474000 DROP R1,R14,R15 KILL UCB, DEB, TED ADDRESSABILITY R4 M3474500 EJECT R4 M3475000 *********************************************************************** M3475500 * * M3476000 * NGBITMAP -- SUBROUTINE TO ADD BIT MAP FOR NEW VOLUME * M3476500 * TO MASTER TRACK GROUP BIT MAP * M3477000 * * M3477500 * WC - SPL ADDRESS * M3478000 * WE - RETURN ADDRESS * M3478500 * WF - RELATIVE EXTENT NUMBER * M3479000 * * M3479500 *********************************************************************** M3480000 SPACE 1 R4 M3480500 NGBITMAP LH R1,$NUMTGV ADD R4 M3481000 LA R1,7(,R1) BIT R4 M3481500 SRL R1,3 MAP R4 M3482000 LR R15,R1 FOR R4 M3482500 MR R0,WF NEW R4 M3483000 AL R1,$TGMAP VOLUME @OZ35996 M3483100 LR R0,R1 TO @OZ35996 M3483200 LR R1,R15 MASTER @OZ35996 M3483300 LA R14,SPLTGM BIT @OZ35996 M3483400 MVCL R0,R14 MAP @OZ35996 M3483500 * THIS LINE DELETED BY APAR @OZ35996 M3483600 * THIS LINE DELETED BY APAR @OZ35996 M3484000 * THIS LINE DELETED BY APAR @OZ35996 M3484500 * THIS LINE DELETED BY APAR @OZ35996 M3485000 * THIS LINE DELETED BY APAR @OZ35996 M3485500 BR WE THEN RETURN R4 M3486000 EJECT R4 M3486500 *********************************************************************** M3487000 * * M3487500 * NGCKPSET -- SUBROUTINE TO LOCATE AND SET NEW $DACKPT * M3488000 * ENTRY * M3488500 * * M3489000 * WC - SPL ADDRESS * M3489500 * WE - RETURN ADDRESS * M3490000 * WF - RELATIVE $DACKPT ENTRY ON EXIT * M3490500 * * M3491000 *********************************************************************** M3491500 SPACE 1 R4 M3492000 USING UCBDSECT,R15 PROVIDE UCB ADDRESSABILITY R4 M3492500 SPACE 1 R4 M3493000 NGCKPSET SLR WF,WF INITIAL ENTRY NUMBER R4 M3493500 L R1,$DACKPT GET SPOOL CHECKPOINT INFO ADDRESS R4 M3494000 CLC $SPOOL,SPLVOLID TEST FOR PRIMARY SPOOL VOLUME R4 M3494500 BE NGSETCKP BR IF YES R4 M3495000 SPACE 1 R4 M3495500 SKIP860 LA WF,1(,WF) BUMP ENTRY NUMBER R4 M3496000 LA R1,6(,R1) POINT TO NEXT ENTRY R4 M3496500 OC 0(2,R1),0(R1) TEST FOR NULL ENTRY R4 M3497000 BNZ SKIP860 LOOP IF NO R4 M3497500 SPACE 1 R4 M3498000 NGSETCKP L R15,SPLUCBPT GET UCB ADDRESS R4 M3498500 MVC 0(1,R1),UCBTBYT4 SET DEVICE TYPE R4 M3499000 MVC 1(1,R1),SPLVOLID+5 SET VOLUME SERIAL IDENTIFIER R4 M3499500 MVC 2(4,R1),SPLOWTRK SET VOLUME EXTENT LIMITS R4 M3500000 BR WE THEN RETURN R4 M3500500 SPACE 1 R4 M3501000 DROP WC KILL SPL AND @OZ27300 M3501200 DROP R15 UCB ADDRESSABILITY @OZ27300 M3501500 EJECT @OZ27300 M3501700 ***************************************************************@OZ27300 M3502000 * @OZ27300 M3502200 * NGCKFMC1 -- SUBROUTINE TO INITIALIZE CCW STANDARD @OZ27300 M3502500 * READ/WRITE CCW PATTERN @OZ27300 M3502700 * @OZ27300 M3503000 * REGISTER INPUT OUTPUT @OZ27300 M3503200 * @OZ27300 M3503500 * R1 CCW PACKET ADDRESS UNCHANGED @OZ27300 M3503700 * R14 RETURN ADDRESS UNCHANGED @OZ27300 M3504000 * @OZ27300 M3504200 ***************************************************************@OZ27300 M3504500 SPACE 1 @OZ27300 M3504700 * ADDRESSABLITY -- @OZ27300 M3505000 USING JQBCCWE,R1 -- CCW ELEMENT @OZ27300 M3505200 SPACE 2 @OZ27300 M3505500 NGCKFMC1 STM R14,R12,12(R13) SAVE REGISTERS @OZ27300 M3505700 SPACE 1 @OZ27300 M3506000 OC JQBCSEEK,NCCWSEEK COPY SEEK CCW @OZ27300 M3506200 OC JQBCSET,NCCWSETS COPY SET SECTOR CCW @OZ27300 M3506500 CLI JQBCSEC1,FF CHANGE SET SECTOR @OZ27300 M3506700 BNE *+8 CCW TO A NOP @OZ27300 M3507000 MVI JQBCSET+CCWOP,NOP IF RPS NOT AVAILABLE @OZ27300 M3507200 OC JQBCSID(8*2),NCCWSID COPY SEARCH-ID-EQ, & TIC @OZ27300 M3507500 SPACE 1 @OZ27300 M3507700 LRA R2,JQBCSEC1 POINT SET SECTOR CCW @OZ27300 M3508000 STCM R2,7,JQBCSET+CCWADDR TO SECTOR ADDRESS @OZ27300 M3508200 LRA R2,JQBCADDR PLACE ADDRESS OF 00CCHH @OZ27300 M3508500 STCM R2,7,JQBCSEEK+CCWADDR IN SEEK CCW @OZ27300 M3508700 LRA R2,JQBCCHHR PLACE ADDRESS OF CCHHR @OZ27300 M3509000 STCM R2,7,JQBCSID+CCWADDR IN SEARCH ID @OZ27300 M3509200 LRA R2,JQBCSID PLACE SEARCH ID EQ @OZ27300 M3509500 STCM R2,7,JQBCTIC+CCWADDR COMMAND ADDRESS IN TIC @OZ27300 M3509700 SPACE 1 @OZ27300 M3510000 LM R14,R12,12(R13) RESTORE REGISTERS @OZ27300 M3510200 BR R14 EXIT TO CALLER @OZ27300 M3510500 EJECT @OZ27300 M3510700 ***************************************************************@OZ27300 M3511000 * @OZ27300 M3511200 * NGCKFMC2 -- SUBROUTINE TO INITIALIZE CCW STANDARD @OZ27300 M3511500 * FORMAT WRITE CCW PATTERN @OZ27300 M3511700 * @OZ27300 M3512000 * REGISTER INPUT OUTPUT @OZ27300 M3512200 * @OZ27300 M3512500 * R1 CCW PACKET ADDRESS UNCHANGED @OZ27300 M3512700 * R14 RETURN ADDRESS UNCHANGED @OZ27300 M3513000 * @OZ27300 M3513200 ***************************************************************@OZ27300 M3513500 SPACE 2 @OZ27300 M3513700 NGCKFMC2 STM R14,R12,12(R13) SAVE REGISTERS @OZ27300 M3514000 OC JQBFSEEK(L'NCCWPTRN),NCCWPTRN MOVE IN CCW @OZ27300XM3514200 PATTERN @OZ27300 M3514500 LRA R2,JQBCADDR PLACE ADDRESS OF 00CCHH @OZ27300 M3514700 STCM R2,7,JQBFSEEK+CCWADDR IN SEEK CCW @OZ27300 M3515000 LRA R2,JQBCCHHR PLACE ADDRESS OF CCHHR @OZ27300 M3515200 STCM R2,7,JQBFSID+CCWADDR IN SEARCH ID @OZ27300 M3515500 LRA R2,JQBFSID PLACE SEARCH ID EQ R0 @OZ27300 M3515700 STCM R2,7,JQBFTIC+CCWADDR COMMAND ADDRESS IN TIC @OZ27300 M3516000 LRA R2,JQBFRW CREATE TIC *+8 FOR READ @OZ27300 M3516200 STCM R2,7,JQBFMT+CCWADDR FUNCTIONAL NOP, CHANGED @OZ27300XM3516500 TO WRITE C-K-D LATER @OZ27300 M3516700 SPACE 1 @OZ27300 M3517000 LM R14,R12,12(R13) RESTORE REGISTERS AND @OZ27300 M3517200 BR R14 EXIT TO CALLER @OZ27300 M3517500 EJECT @OZ27300 M3517700 ***************************************************************@OZ27300 M3518000 * @OZ27300 M3518200 * NGCKNTRK - SUBROUTINE TO CREATE NEXT CHECKPOINT @OZ27300 M3518500 * RECORD AND SECTOR ADDRESSES @OZ27300 M3518700 * @OZ27300 M3519000 * REGISTER INPUT OUTPUT @OZ27300 M3519200 * @OZ27300 M3519500 * R1 CCW PACKET UNCHANGED @OZ27300 M3519700 * (HIGH BIT ON MEANS @OZ27300 M3520000 * FORCE NEXT TRACK) @OZ27300 M3520200 * R3 UCB ADDRESS UNCHANGED @OZ27300 M3520500 * R4 NVOLTABL ENTRY UNCHANGED @OZ27300 M3520700 * R14 RETURN ADDRESS UNCHANGED @OZ27300 M3521000 * R15 ADDR. OF PREV. CCHHR UNCHANGED @OZ27300 M3521200 * @OZ27300 M3521500 ***************************************************************@OZ27300 M3521700 SPACE 1 @OZ27300 M3522000 * ADDRESSABILITY -- @OZ27300 M3522200 USING UCBDSECT,R3 -- UCB @OZ27300 M3522500 USING NVLDSECT,R4 -- VOL. ALLOC. TABLE ENTRY @OZ27300 M3522700 SPACE 2 @OZ27300 M3523000 NGCKNTRK STM R14,R12,12(R13) SAVE ENTRY REGSITERS @OZ27300 M3523200 SPACE 1 @OZ27300 M3523500 L R5,0(,R15) PICK UP CURRENT R5=(CCHH) @OZ27300 M3523700 SLR R6,R6 TRACK ADDRESS AND @OZ27300 M3524000 IC R6,4(,R15) RECORD NUMBER R6=(000R) @OZ27300 M3524200 SPACE 1 @OZ27300 M3524500 LTR R1,R1 TEST FOR SPECIAL ENTRY @OZ27300 M3524700 BM NGCKNSTR BR IF YES, FORCE NXT TRACK @OZ27300 M3525000 SPACE 1 @OZ27300 M3525200 LA R6,1(,R6) INCREMENT RECORD NUMBER @OZ27300 M3525500 CH R6,NVLTNRT TEST FOR STILL ON TRACK @OZ27300 M3525700 BNH NGCKNTR2 BRANCH IF YES @OZ27300 M3526000 SPACE 1 @OZ27300 M3526200 NGCKNSTR AL R5,=F'1' PICK UP ADDR OF NEXT HEAD @OZ27300 M3526500 CLM R5,B'0011',NVLMCYL TEST FOR CYLINDER BOUNDARY @OZ27300 M3526700 BL NGCKNTR1 BRANCH IF NOT @OZ37386 M3527000 LH R5,0(,R15) PICK UP CYLINDER NO. (00CC) @OZ27300 M3527200 LA R5,1(,R5) INCREMENT @OZ27300 M3527500 SLL R5,16 RESET HEAD (CC00) @OZ27300 M3527700 SPACE 1 @OZ27300 M3528000 NGCKNTR1 LA R6,1 RESET RECORD NUMBER @OZ27300 M3528200 SPACE 1 @OZ27300 M3528500 NGCKNTR2 ST R5,L'JQBCCWEL(,R15) STORE NEW TRACK ADDRESS @OZ27300 M3528700 STC R6,NGCKRECN(,R15) AND RECORD NUMBER @OZ27300 M3529000 EJECT @OZ27300 M3529200 * COMPUTE RECORD SECTOR ADDRESS FOR RPS DEVICES @OZ27300 M3529500 SPACE 1 @OZ27300 M3529700 MVI NGCKSEC(R15),FF SET NULL SECTOR ADDRESS @OZ27300 M3530000 TM $RUNOPTS,$RPS SEE IF RPS FEATURE SHOULD @OZ27300 M3530200 BZ NGCKNTRR BE USED, BR IF NOT DESIRED @OZ27300 M3530500 TM UCBTBYT2,UCBRPS TEST FOR RPS DEVICE @OZ27300 M3530700 BZ NGCKNTRR BRANCH IF NO RPS @OZ27300 M3531000 LA R2,NGCKSEC(,R15) POINT TO SECTOR ADDR AREA @OZ27300 M3531200 ICM R2,8,UCBTBYT4 GET UCB TYPE BYTE, @OZ27300 M3531500 LH R0,=H'4096' RECORD LENGTH, @OZ27300 M3531700 SLL R0,16 AND POSITION, @OZ27300 M3532000 IC R0,NGCKRECN(,R15) FOR ROUTINE. @OZ27300 M3532200 L R15,CVTPTR LOCATE AND @OZ27300 M3532500 L R15,CVT0SCR1-CVTDSECT(,R15) CALL THE SECTOR @OZ27300 M3532700 BALR R14,R15 CALC. ROUTINE @OZ27300 M3533000 SPACE 1 @OZ27300 M3533200 * OFFSETS FROM CCHHR TO... @OZ27300 M3533500 NGCKSEC EQU (JQBCSEC1-JQBCCHHR)+L'JQBCCWEL ...SECTOR AREA @OZ27300 M3533700 NGCKRECN EQU (JQBCRECN-JQBCCHHR)+L'JQBCCWEL ...RECORD NUMBER @OZ27300 M3534000 SPACE 1 @OZ27300 M3534200 NGCKNTRR LM R14,R12,12(R13) RELOAD CALLERS REGSITERS @OZ27300 M3534500 BR R14 AND RETURN @OZ27300 M3534700 SPACE 1 @OZ27300 M3535000 DROP R3,R4 KILL UCB, VAT ADDRESSABILITY@OZ27300 M3535200 EJECT @OZ27300 M3535500 ***************************************************************@OZ27300 M3535700 * @OZ27300 M3536000 * NGWTOR -- SUBROUTINE TO QUERY OPERATOR @OZ27300 M3536200 * @OZ27300 M3536500 * WA - ADDRESS OF OPERATOR MESSAGE @OZ27300 M3536700 * WE - RETURN ADDRESS @OZ27300 M3537000 * @OZ27300 M3537200 ***************************************************************@OZ27300 M3537500 SPACE 1 @OZ27300 M3537700 NGWTOR MVI NGWDBL,0 CLEAR REPLY AREA @OZ27300 M3538000 MVI NGECB,0 CLEAR ECB @OZ27300 M3538200 $$WTOR (WA) QUERY OPERATOR @OZ27300 M3538500 WAIT ECB=NGECB WAIT FOR RESPONSE @OZ27300 M3538700 OI NGWDBL,X'40' FORCE UPPER CASE RESPONSE @OZ27300 M3539000 CLI NGWDBL,C'Y' TEST REPLY @OZ27300 M3539200 BER WE RETURN IF 'Y' WITH CC = 0 @OZ27300 M3539500 CLI NGWDBL,C'N' TEST REPLY @OZ27300 M3539700 BNE NGWTOR BR IF NOT 'N' TO RE-QUERY @OZ27300 M3540000 SLR R1,R1 SET NON-ZERO CONDITION CODE @OZ27300 M3540200 BR WE AND RETURN @OZ27300 M3540500 SPACE 1 @OZ27300 M3540700 DROP BASE2,BASE3 KILL LOCAL ADDRESSABILITY @OZ27300 M3541000 EJECT @OZ27300 M3541200 ***************************************************************@OZ27300 M3541500 * @OZ27300 M3541700 * NGCKSWAP - SUBROUTINE TO SWAP PRIMARY - SECONDARY @OZ27300 M3542000 * CCW PACKET OPERATION @OZ27300 M3542200 * @OZ27300 M3542500 ***************************************************************@OZ27300 M3542700 SPACE 1 @OZ27300 M3543000 USING JQBDSECT,R10 JQB ADDRESSABILITY @OZ27300 M3543200 SPACE 1 @OZ27300 M3543500 NGCKSWAP STM R14,R12,12(R13) SAVE CALLERS REGISTERS @OZ27300 M3543700 SPACE 1 @OZ27300 M3544000 BALR BASE2,0 ESTABLISH SUBROUTINE @OZ27300 M3544200 USING *,BASE2 ADDRESSABILITY @OZ27300 M3544500 SPACE 1 @OZ27300 M3544700 L R10,$JQB LOCATE THE JQB @OZ27300 M3545000 SPACE 1 @OZ27300 M3545200 LA R1,JQBSTD LOCATE STANDARD CCW PACKETS @OZ27300 M3545500 LA R6,JQBSTDS AND COMPUTE @OZ27300 M3545700 AH R6,$JOBRECN TOTAL NUMBER OF @OZ27300 M3546000 AH R6,$JOTRECN PACKETS TO SWAP @OZ27300 M3546200 SPACE 1 @OZ27300 M3546500 NGCKSWPL XC JQBCCHHR,JQBCCHH2 SWAP @OZ27300 M3546700 XC JQBCCHH2,JQBCCHHR JQBCCHHR AND @OZ27300 M3547000 XC JQBCCHHR,JQBCCHH2 JQBCCHH2 @OZ27300 M3547200 MVC JQBCCHH0(4),JQBCCHHR THEN RESET JQBCCHH0 @OZ27300 M3547500 SPACE 1 @OZ27300 M3547700 LA R2,JQBLOCKR DON'T SWAP SECTOR @OZ27300 M3548000 CLR R1,R2 NUMBERS UNTIL @OZ27300 M3548200 BL NGCKSWPI JQBLOCKR PACKET @OZ27300 M3548500 LA R2,JQBCHECK OR AFTER @OZ27300 M3548700 CLR R1,R2 JQBCHECK @OZ27300 M3549000 BH NGCKSWPI PACKET @OZ27300 M3549200 SPACE 1 @OZ27300 M3549500 XC JQBCSEC1,JQBCSEC2 SWAP @OZ27300 M3549700 XC JQBCSEC2,JQBCSEC1 SECTOR @OZ27300 M3550000 XC JQBCSEC1,JQBCSEC2 NUMBERS @OZ27300 M3550200 SPACE 1 @OZ27300 M3550500 MVI JQBCSET+CCWOP,NOP SET JQBCSET TO @OZ27300 M3550700 CLI JQBCSEC1,FF A SET-SECTOR @OZ27300 M3551000 BE *+8 OR TO A NOP (IF @OZ27300 M3551200 MVI JQBCSET,SETSECTR SECTOR NUMBER IS FF) @OZ27300 M3551500 SPACE 1 @OZ27300 M3551700 NGCKSWPI LA R1,JQBCNEXT POINT TO NEXT CCW PACKET @OZ27300 M3552000 BCT R6,NGCKSWPL AND LOOP FOR ALL @OZ27300 M3552200 SPACE 1 @OZ27300 M3552500 XI JQBFLAG1,JQB1PRIM FLIP PRIMARY/SECONDARY BIT @OZ27300 M3552700 SPACE 1 @OZ27300 M3553000 LM R14,R12,12(R13) RESTORE CALLERS REGISTERS @OZ27300 M3553500 BR R14 AND RETURN TO CALLER @OZ27300 M3554000 SPACE 1 @OZ27300 M3554500 DROP BASE2 KILL ROUTINE ADDRESSABILITY @OZ27300 M3555000 EJECT @OZ27300 M3555500 ***************************************************************@OZ27300 M3556000 * @OZ27300 M3556500 * NGCKADJ - SUBROUTINE TO ADJUST CCW PACKET CHAINING @OZ27300 M3557000 * @OZ27300 M3557500 * REGISTER INPUT OUTPUT @OZ27300 M3558000 * @OZ27300 M3558500 * WD NVOLTABL ENTRY UNCHANGED @OZ27300 M3559000 * R14 RETURN ADDRESS UNCHANGED @OZ27300 M3559500 * @OZ27300 M3560000 ***************************************************************@OZ27300 M3560500 SPACE 1 @OZ27300 M3561000 USING NVLDSECT,WD NVOLTBL ADDRESSABILTIY @OZ27300 M3561500 SPACE 1 @OZ27300 M3562000 NGCKADJ STM R14,R12,12(R13) SAVE CALLERS REGISTERS @OZ27300 M3562500 SPACE 1 @OZ27300 M3563000 BALR BASE2,0 ESTABLISH SUBROUTINE @OZ27300 M3563500 USING *,BASE2 ADDRESSABILITY @OZ27300 M3564000 SPACE 1 @OZ27300 M3564500 L R10,$JQB PICK UP JQB ADDRESS @OZ27300 M3565000 SPACE 1 @OZ27300 M3565500 LA R1,JQBCCWS LOCATE CCW PACKETS @OZ27300 M3566000 LH R6,$JOBRECN COMPUTE TOTAL NUMBER @OZ27300 M3566500 AH R6,$JOTRECN OF PACKETS TO @OZ27300 M3567000 BCTR R6,0 RECHAIN @OZ27300 M3567500 SPACE 1 @OZ27300 M3568000 NGCKADJR LA R2,JQBCNEXT GET ADDR OF NEXT SEEK CCW @OZ27300 M3568500 CLC JQBCRECN,NVLTNRT+1 TEST RECORD POSITION @OZ27300 M3569000 BE NGCKADJC BR IF LAST RECORD ON TRK @OZ27300 M3569500 LA R2,JQBCNEXT+(JQBFMT-JQBCCWE) ELSE, USE EITHER @OZ27300 M3570000 TM JQBFLAG1,JQB1WRT FMT-WRITE OR READ @OZ27300 M3570500 BO NGCKADJC CCW DEPENDING ON @OZ27300 M3571000 LA R2,JQBCNEXT+(JQBFRW-JQBCCWE) JQB SETUP @OZ27300 M3571500 SPACE 1 @OZ27300 M3572000 NGCKADJC STCM R2,7,JQBFTIC+5 STORE VIRTUAL AND @OZ27300 M3572500 LRA R2,0(,R2) REAL ADDRESSES @OZ27300 M3573000 STCM R2,7,JQBFTNXT+CCWADDR OF NEXT CCW PACKET @OZ27300 M3573500 LA R1,JQBCNEXT POINT TO NEXT CCW PACKET @OZ27300 M3574000 BCT R6,NGCKADJR AND LOOP FOR ALL @OZ27300 M3574500 TM JQBFLAG1,JQB1FMT+JQB1WRT TEST FOR FORMAT-WRT @OZ27300 M3575000 BNO NGCKADJX BRANCH IF NOT, EXIT @OZ27300 M3575500 LA R2,JQBCHECK ELSE, CHAIN LAST @OZ27300 M3576000 STCM R2,7,JQBFTIC+5 QUEUE RECORD PACKET @OZ27300 M3576500 LRA R2,0(,R2) TO RE-WRITE @OZ27300 M3577000 STCM R2,7,JQBFTNXT+CCWADDR (FORMATTED ZERO) @OZ27300 M3577500 MVI JQBCHECK+JQBCRW-JQBCCWE,WRITE+DATA CHECK VALUE @OZ27300 M3578000 SPACE 1 @OZ27300 M3578500 NGCKADJX LM R14,R12,12(R13) RESTORE CALLERS REGISTERS @OZ27300 M3579000 BR R14 AND RETURN TO CALLER @OZ27300 M3579500 SPACE 1 @OZ27300 M3580000 DROP R1 KILL CCW PACKET @OZ27300 M3580500 DROP WD NVOLTBL ENTRY, @OZ27300 M3581000 DROP R10 JQB AND @OZ27300 M3581500 DROP BASE2 ROUTINE ADDRESSABILITY @OZ27300 M3582000 EJECT @OZ27300 M3582500 ***************************************************************@OZ27300 M3583000 * @OZ27300 M3583500 * NGEXCP -- SUBROUTINE TO PERFORM PRIMARY/ALTERNATE @OZ27300 M3584000 * CHECKPOINT I/O @OZ27300 M3584500 * @OZ27300 M3585000 * R14 - RETURN ADDRESS @OZ27300 M3585500 * @OZ27300 M3586000 * CONDITION CODE ZERO ON RETURN - I/O OK @OZ27300 M3586500 * CONDITION CODE NON-ZERO ON RETURN - I/O ERROR @OZ27300 M3587000 * @OZ27300 M3587500 ***************************************************************@OZ27300 M3588000 SPACE 1 @OZ27300 M3588500 USING JQBDSECT,R1 PROVIDE JQB ADDRESSABILITY @OZ27300 M3589000 SPACE 1 @OZ27300 M3589500 NGEXCP STM R14,R12,12(R13) SAVE CALLERS REGISTERS @OZ27300 M3590000 SPACE 1 @OZ27300 M3590500 BALR BASE2,0 ESTABLISH SUBROUTINE @OZ27300 M3591000 USING *,BASE2 ADDRESSABILITY @OZ27300 M3591500 SPACE 1 @OZ27300 M3592000 L R1,$JQB POINT TO CKPT JQB (IOB) @OZ27300 M3592500 SPACE 1 @OZ27300 M3593000 MVC JQBVERFY,NGCKFFFF PRESET VERIFICATION @OZ27300 M3593500 MVI JQBADKEY,FF VALUES BEFORE DOING I/O @OZ27300 M3594000 SPACE 1 @OZ27300 M3594500 IC R2,$NUMDA GET PRIMARY CKPT EXTENT 'M' @OZ27300 M3595000 TM JQBFLAG1,JQB1PRIM TEST JQB SETUP @OZ27300 M3595500 BO *+8 BRANCH IF PRIMARY @OZ27300 M3596000 LA R2,1(,R2) ELSE USE 2NDARY CKPT 'M' @OZ27300 M3596500 STC R2,JQBSEEK STORE EXTENT NUMBER IN JQB @OZ27300 M3597000 L R2,JQBSTART LOCATE BEGINIING OF @OZ27300 M3597500 N R2,=F'-64' FIRST CCW PACKET AND COPY @OZ27300 M3598000 MVC JQBSEEK+1(6),JQBCADDR-JQBCCWE(R2) CCHHR TO JQB @OZ27300 M3598500 SPACE 1 @OZ27300 M3599000 EXCPVR (1),SUBSYS INITIATE I/O OPERATION @OZ27300 M3599500 SPACE 1 @OZ27300 M3600000 WAIT ECB=NGECB WAIT FOR I/O TO COMPLETE @OZ27300 M3600500 SPACE 1 @OZ27300 M3600600 CLI NGECB,X'7F' TEST FOR I/O ERROR @OZ27300 M3600700 SPACE 1 @OZ27300 M3600800 LM R14,R12,12(R13) RESTORE CALLER REGSITERS @OZ27300 M3600900 BR R14 AND RETURN, CC = I/O STATE @OZ27300 M3601000 SPACE 1 @OZ27300 M3601100 DROP R1,BASE2 KILL LOCAL ADDRESSABILITY @OZ27300 M3601200 TITLE 'HASP INITIALIZATION -- DIRECT ACCESS INITIALIZATION ARECM3601300 AS, CONSTANTS AND LITERALS' @OZ27300 M3601400 * BASIC CCW PATTERNS FOR READING/WRITING CHECKPOINT @OZ27300 M3601500 SPACE 1 @OZ27300 M3601600 NCCWSEEK CCW SEEK,*-*,CC,6 SEEK CCW @OZ27300 M3601700 SPACE 1 @OZ27300 M3601800 NCCWSID CCW SRCH+ID+EQ,*-*,CC,5 SEARCH-ID EQUAL CCW @OZ27300 M3601900 NCCWTIC CCW TIC,*-8,0,0 TIC *-8 @OZ27300 M3602000 SPACE 1 @OZ27300 M3602100 NCCWFMT CCW TIC,*-*,DC,8 (TIC *+8) (WRITE C-K-D) @OZ27300 M3602200 SPACE 1 @OZ27300 M3602300 NCCWPTRN EQU NCCWSEEK,*-NCCWSEEK CCW PATTERN @OZ27300 M3602400 SPACE 1 @OZ27300 M3602500 NCCWRW CCW READ+DATA,*-*,CC,4096 READ / WRITE CCW @OZ27300 M3602600 NCCWTNXT CCW TIC,*-*,0,0 TIC TO NEXT CCW PACKET @OZ27300 M3602700 SPACE 1 @OZ27300 M3602800 NCCWSKEL EQU NCCWRW,*-NCCWRW-3 CCW SKELETON @OZ27300 M3602900 SPACE 2 @OZ27300 M3603000 NCCWSETS CCW SETSECTR,*-*,CC,1 SET SECTOR CCW @OZ27300 M3603100 SPACE 1 @OZ27300 M3603500 NCCWSKEY CCW SRCH+KEY+EQ,*-*,CC+SLI,1 SEARCH KEY EQUAL CCW @OZ27300 M3604000 SPACE 1 @OZ27300 M3604500 NCCWVERP CCW READ+CNT,*-*,CC,8 READ COUNT -- CHANNEL PGM @OZ27300 M3605000 CCW NOP,*-*,SLI,1 COMPLETION VERIFICATION @OZ27300 M3605500 SPACE 3 @OZ27300 M3606000 * CHECKPOINT DATA SET TRACK-1 TABLE @OZ27300 M3606500 * (DEPENDANT ON ORDER OF CCW PACKETS IN THE JQB) @OZ27300 M3606700 SPACE 1 @OZ27300 M3607000 NTR1TABL DC AL1(2),AL1(8),AL2(8),AL2(0),AL2(0) JQBLOCKV @OZ27300 M3607500 DC AL1(1),AL1(0),AL2(8),AL2(8),AL2(0) JQBFMTW1 @OZ27300 M3608000 DC AL1(2),AL1(8),AL2(8),AL2(16),AL2(0) JQBFMTW2 @OZ27300 M3608500 DC AL1(2),AL1(8),AL2(8),AL2(1),AL2(0) JQBLOCKR @OZ27300 M3609000 NTR1REC1 DC AL1(1),AL1(0),AL2(8),AL2(1),XL2'FFFF' JQBCHECK @OZ27300 M3609500 DC AL1(2),AL1(8),AL2(8),AL2(16),XL2'FFFF' JQBLOCK @OZ27300 M3610000 NTR1MSTR DC AL1(3),AL1(0),AL2(0),AL2(0),XL2'FFFF' JQBMSTR @OZ27300 M3610500 SPACE 1 @OZ27300 M3611000 NTR1NMBR EQU (*-NTR1REC1)/8 NUM OF RECORDS ON 1ST TRK @OZ27300 M3611050 SPACE 3 @OZ27300 M3611100 NGCKFFFF DC 8XL1'FF' COMPARE VALUE FOR JQBVERFY @OZ27300 M3611200 NGWDBL DC D'0' DOUBLE-WORD WORK AREA R4 M3611500 NGXTGS DC F'0' TOTAL NUMBER OF TRACK GROUPS R4 M3612000 NRPSTBLN DC F'0' SIZE OF RPS SECTOR TABLE R4 M3612500 NVOLWKSP DC A(*-*) SPOOL ALLOC WORK AREA CHAIN HDR R4 M3613000 NGECB DC F'0' EVENT CONTROL BLOCK R4 M3613500 NVOLTABL DS A VOLUME ALLOCATION TABLE ADDRESS R4 M3614000 * THIS CARD DELETED BY APAR @OZ27300 M3614200 * THIS CARD DELETED BY APAR @OZ27300 M3614400 EJECT R4 M3614500 *********************************************************************** M3615000 * * M3615500 * TABLE OF REQUIRED VALUES USED IN MESSAGE 442 * M3616000 * * M3616500 *********************************************************************** M3617000 SPACE 1 R4 M3617500 NOLDPRMS DS 0F R4 M3618000 CLC $BUFSIZE,$BUFSIZE-$SAVEBEG(WF) ENTRY FOR &BUFSIZE R4 M3618500 DC CL8'&&BUFSIZE' R4 M3619000 CLC $MAXJOBS,$MAXJOBS-$SAVEBEG(WF) ENTRY FOR &MAXJOBS R4 M3619500 DC CL8'&&MAXJOBS' R4 M3620000 CLC $NUMJOES,$NUMJOES-$SAVEBEG(WF) ENTRY FOR &NUMJOES R4 M3620500 DC CL8'&&NUMJOES' R4 M3621000 CLC $MINJOES,$MINJOES-$SAVEBEG(WF) ENTRY FOR &MINJOES R4 M3621500 DC CL8'&&MINJOES' R4 M3622000 CLC $SPOLMSG,$SPOLMSG-$SAVEBEG(WF) ENTRY FOR &SPOLMSG R4 M3622500 DC CL8'&&SPOLMSG' R4 M3623000 CLC $NUMRJE,$NUMRJE-$SAVEBEG(WF) ENTRY FOR &NUMRJE R4 M3623500 DC CL8'&&NUMRJE' R4 M3624000 CLC $NUMTGV,$NUMTGV-$SAVEBEG(WF) ENTRY FOR &NUMTGV R4 M3624500 DC CL8'&&NUMTGV' R4 M3625000 CLC $NUMDA,$NUMDA-$SAVEBEG(WF) ENTRY FOR &NUMDA R4 M3625500 DC CL8'&&NUMDA' R4 M3626000 CLC $TCELSIZ,$TCELSIZ-$SAVEBEG(WF) ENTRY FOR &TCELSIZ R4 M3626500 DC CL8'&&TCELSIZ' R4 M3627000 CLC $RECINCR,$RECINCR-$SAVEBEG(WF) ENTRY FOR &RECINCR R4 M3627500 DC CL8'&&RECINCR' R4 M3628000 NUMPARMS EQU (*-NOLDPRMS)/14 NUMBER OF TABLE ENTRIES R4 M3631500 NPARMLNS EQU (NUMPARMS+1+2)/3 LINES REQUIRED TO PRINT ENTRIES R4 M3632000 SPACE 1 R4 M3632500 NPARMASK DC C' = ',X'2020202120' PARM VALUE EDIT MASK R4 M3633000 EJECT R4 M3633500 *********************************************************************** M3634000 * * M3634500 * VOLUME ALLOCATION TABLE ENTRY DSECT * M3635000 * * M3635500 *********************************************************************** M3636000 SPACE 1 R4 M3636500 NVLDSECT DSECT ALLOCATION TABLE ENTRY DSECT R4 M3637000 NVLUCBPT DS A VOLUME UCB ADDRESS R4 M3637500 NVLEND DS 0X TERMINATION/EMPTY ENTRY INDICATOR R4 M3638000 NVLVOLID DS CL6 VOLUME SERIAL NUMBER R4 M3638500 NVLFLAGS DS X ALLOCATION REQUEST FLAGS R4 M3639000 NVLSTAT DS X STATUS FLAGS @OZ27300 M3639100 NVLTNRT DS H NUMBER OF RECORDS / TRACK @OZ27300 M3639200 NVLMCYL DS X NUMBER OF TRACKS / CYLINDER @OZ27300 M3639300 DS 0F R4 M3639500 NVLTBLN EQU *-NVLDSECT ALLOCATION TABLE ENTRY LENGTH R4 M3640000 SPACE 2 R4 M3640500 *********************************************************************** M3641000 * * M3641500 * DEVICE CHARACTERISTICS TABLE ENTRY DSECT * M3642000 * * M3642500 *********************************************************************** M3643000 SPACE 1 R4 M3643500 NGZ DSECT IECZDTAB DUMMY SECTION R4 M3644000 NGZC DS H NUMBER OF CYLINDERS PER VOLUME R4 M3644500 NGZH DS H NUMBER OF TRACKS PER CYLINDER R4 M3645000 NGZR DS H MAXIMUM TRACK LENGTH R4 M3645500 NGZO DS 0H BLOCK OVERHEAD -- 2305 R4 M3646000 NGZNL DS X BLOCK OVERHEAD -- KEYED R4 M3646500 NGZL DS X BLOCK OVERHEAD -- KEYED LAST R4 M3647000 NGZU DS X BLOCK OVERHEAD -- UNKEYED R4 M3647500 NGZF DS X FLAGS -- R4 M3648000 NGZFT EQU 1 APPLY TOLERANCE FACTOR R4 M3648500 NGZF2305 EQU 8 DEVICE IS 2305 R4 M3649000 NGZT DS H TOLERANCE FACTOR IF SPZFT @OZ27300 M3649100 NGZA DS H NUMBER OF ALTERNATE TRACKS @OZ27300 M3649200 SPACE 2 @OZ27300 M3649300 ***************************************************************@OZ27300 M3649400 * @OZ27300 M3649500 * CHECKPOINT DATA SET TRACK-1 TABLE DSECT @OZ27300 M3649600 * @OZ27300 M3649700 ***************************************************************@OZ27300 M3649800 SPACE 1 @OZ27300 M3649900 NTR1 DSECT TRACK-1 TABLE DSECT @OZ27300 M3650000 NTR1REC DS XL1 RECORD LENGTH @OZ27300 M3650100 NTR1KEYL DS XL1 KEY LENGTH @OZ27300 M3650200 NTR1CLEN DS XL2 DATA LENGTH @OZ27300 M3650300 NTR1RLEN DS XL2 READ/WRITE LENGTH @OZ27300 M3650400 NTR1SEC1 DS XL1 PRIMARY REC SECTOR ADDRESS @OZ27300 M3650500 NTR1SEC2 DS XL1 SECONDARY REC SECTOR ADDR @OZ27300 M3650600 SPACE 1 @OZ27300 M3650700 NTR1SIZE EQU *-NTR1 SIZE OF TRACK-1 TABLE ENTRY @OZ27300 M3650800 SPACE 3 @OZ27300 M3650900 HASPINIT CSECT @OZ27300 M3651000 SPACE 2 @OZ27300 M3651100 * THIS CARD DELETED BY APAR @OZ27300 M3651500 LTORG R4 M3652000 TITLE 'HASP INITIALIZATION -- HASPINIT MESSAGES' R4 M3652500 NMSG1 EQU * START OF HASPINIT MESSAGE AREA R4 M3653000 SPACE 2 R4 M3653500 $MID 401 SET MESSAGE NUMBER R4 M3654000 NXTNTMSG WTO '&MID.EXTENT ERROR ON ******',MF=L R4 M3654500 NXTNTVOL EQU *-6,6 VOLUME SERIAL R4 M3655000 SPACE 2 R4 M3655500 $MID 402 SET MESSAGE NUMBER R4 M3656000 NEWTOM WTO '&MID.XXXXXXXX ATTACH ERROR - ******',MF=L R4 M3656500 NEWTON EQU *-30,8 R4 M3657000 NEWTOV EQU *-6,6 R4 M3657500 DC C' ' SPACER R4 M3658000 SPACE 2 R4 M3658500 $MID 411 SET MESSAGE NUMBER R4 M3659000 NDAEM2 WTO '&MID.MAXIMUM OF NN SPOOL VOLUME(S) EXCEEDED',MF=L R4 M3659500 NDAEM2A EQU *-27,2 VOLUME COUNT R4 M3660000 SPACE 2 R4 M3660500 $MID 412 SET MESSAGE NUMBER R4 M3661000 NURWTO WTO '&MID.MAXIMUM OF *** ********** EXCEEDED',MF=L R41 M3661500 NURWTOM EQU *-23,14 NUMBER AND DEVICE NAME R41 M3662000 EJECT R4 M3662500 PRINT OFF - SECTION DELETED @OZ27300 M3663000 * THIS CARD DELETED BY APAR @OZ27300 M3663500 * THIS CARD DELETED BY APAR @OZ27300 M3664000 PRINT ON -- SECTION DELETED @OZ27300 M3664500 $MID 416 SET MESSAGE NUMBER R4 M3665000 NMSGMSG WTO '&MID.OPERATOR MESSAGE SPACE NOT AVAILABLE',MF=L R4 M3665500 SPACE 2 R4 M3666000 $MID 417 SET MESSAGE NUMBER R4 M3666500 NOUSEMSG WTO '&MID.VOLUME ****** NOT ADDED - COMPLEX NOT DORMANT', R4CM3667000 MF=L R4 M3667500 NOUSEVOL EQU *-38,6 VOLUME SERIAL R4 M3668000 EJECT R4 M3668500 $MID 419 SET MESSAGE NUMBER R4 M3669000 NMSG419 WTOR '&MID.REPLY Y OR N TO CONFIRM RESET ON SYSTEM(S) **** **CM3669500 ** **** **** **** ****.',NGWDBL,1,NGECB,MF=L R4 M3670000 NMSG419A EQU *-31,4 R4 M3670500 SPACE 2 R4 M3671000 $MID 420 SET MESSAGE NUMBER R4 M3671500 NGCKMSG WTO '&MID.PERM I/O ERROR READING JES2 CKPT ON XXXXXX', CM3672000 MF=L @OZ27300 M3672100 NGCKMSGZ EQU *-27,4 I/O TYPE @OZ27300 M3672500 NM420VOL EQU *-6,6 VOLUME SERIAL @OZ27300 M3672600 SPACE 2 R4 M3673000 $MID 421 SET MESSAGE NUMBER R4 M3673500 NRDERMSG WTO '&MID.PREVIOUSLY MOUNTED VOLUME ****** IS UNFORMATTED', CM3674000 MF=L R4 M3674500 NRDERVOL EQU *-21,6 VOLUME SERIAL R4 M3675000 SPACE 2 R4 M3675500 $MID 422 SET MESSAGE NUMBER R4 M3676000 NDAEM1 WTO '&MID.DUPLICATE SPOOLX VOLUMES',MF=L R4 M3676500 NDAVOL EQU *-14,6 VOLUME SERIAL R4 M3677000 EJECT R4 M3677500 $MID 424 SET MESSAGE NUMBER R4 M3678000 NGDMSG WTO '&MID.****** IS NOT MOUNTED',MF=L R4 M3678500 NGDVOLID EQU *-21,6 VOLUME SERIAL R4 M3679000 SPACE 2 R4 M3679500 $MID 425 SET MESSAGE NUMBER R4 M3680000 ISTRTEM2 WTO '&MID.SUBSYSTEM INTERFACE NOT DORMANT',MF=L R4 M3680500 SPACE 2 R4 M3681000 $MID 426 SET MESSAGE NUMBER R4 M3681500 NOPTMSG1 WTOR '&MID.SPECIFY OPTIONS - HASP-II, VERSION &VERSION', R4CM3682000 NOPTAREA,L'NOPTAREA,NOPTECB,MF=L R4 M3682500 SPACE 2 R4 M3683000 $MID 427 SET MESSAGE NUMBER R4 M3683500 NOPTMSG2 WTOR '&MID.PARAMETER OR SYNTAX ERROR - RESPECIFY OPTIONS', R4CM3684000 NOPTAREA,L'NOPTAREA,NOPTECB,MF=L R4 M3684500 EJECT R4 M3685000 $MID 428 SET MESSAGE NUMBER R4 M3685500 NGQUITM WTO '&MID.CORRECT THE ABOVE PROBLEMS AND RESTART JES2',MF=L M3686000 SPACE 2 R4 M3686500 $MID 429 SET MESSAGE NUMBER R4 M3687000 ISTRTEM1 WTO '&MID.SUBSYSTEM NAME NOT DEFINED',MF=L R4 M3687500 ISTRTSNM EQU *-16,4 SUBSYSTEM NAME R4 M3688000 SPACE 2 R4 M3688500 $MID 430 SET MESSAGE NUMBER R4 M3689000 ISTRTEM3 WTO '&MID.INCOMPATIBLE SUBSYSTEM INTERFACE',MF=L R4 M3689500 SPACE 2 R4 M3692000 $MID 432 SET MESSAGE NUMBER R4 M3692500 NBFMSG WTO '&MID.REQUESTED JES2 BUFFERS EXCEED AVAILABLE STORAGE', CM3693000 MF=L R4 M3693500 EJECT R4 M3694000 $MID 434 SET MESSAGE NUMBER R4 M3696000 NMSG434 WTO '&MID.WARM START DENIED -- INVALID CHECKPOINT RECORD', R4CM3696500 MF=L R4 M3697000 NMSG434A EQU *-46,4 LOCATE 'WARM' R4 M3697500 SPACE 2 R4 M3698000 $MID 435 SET MESSAGE NUMBER R4 M3698500 NVALMSG WTO '&MID.SYSTEM PARAMETER TABLE ERROR',MF=L R4 M3699000 SPACE 2 R4 M3699500 $MID 436 SET MESSAGE NUMBER R4 M3700000 NMSG436 WTOR '&MID.REPLY Y OR N TO CONFIRM CHECKPOINT RECORD CHANGE',CM3700500 NGWDBL,1,NGECB,MF=L R4 M3701000 EJECT R4 M3701500 $MID 439 SET MESSAGE NUMBER R4 M3705000 NCMBMSG WTO '&MID.CMBS EXHAUSTED - LAST NNN OPERATOR COMMANDS IGNORECM3705500 D',MF=L R4 M3706000 NCMBCT EQU *-30,4 COMMAND COUNT R4 M3706500 SPACE 2 R4 M3707000 $MID 440 SET MESSAGE NUMBER R4 M3707500 NTGBFMSG WTO '&MID.&&BUFSIZE TOO SMALL FOR &&NUMTGV AND/OR &&NUMDA', CM3708000 MF=L R4 M3708500 EJECT R4 M3709000 $MID 441 SET MESSAGE NUMBER R4 M3709500 NMSG441 WTOR '&MID.REPLY Y OR N TO CONTINUE INITIALIZATION', R4CM3710000 NPLREPLY,1,NPLECB,MF=L R4 M3710500 SPACE 2 R4 M3711000 $MID 442 SET MESSAGE NUMBER R4 M3711500 NPARAMSG WTO ('&MID.WARM START DENIED',C),(' ',L), R4CM3712000 ('REQUIRED INITIALIZATION PARAMETERS FOLLOW --',D), R4CM3712500 (' ',DE),ROUTCDE=(1,2),DESC=(4),MF=L R4 M3713000 ORG *-59 GO BACK AND R4 M3713500 DC AL1(4+NPARMLNS) RESET LINE COUNT R4 M3714000 ORG *+59-1-5 GO FORWARD TO ADD DATA LINES R4 M3714500 DC AL2(5),XL2'2000',C' ' R4 M3715000 NMSGPRMS DC (NPARMLNS)X'00402000404040404040404040404040404040404040CM3715500 40404040404040404040404040404040404040404040404040404040CM3716000 4040404040404040404040404040' @OZ18405 M3716500 DC AL2(5),XL2'3000',C' ' R4 M3717000 ORG NMSGPRMS+4 R4 M3717500 DC C'&&SPOOL =' R4 M3718000 ORG , R4 M3718500 NPARMSGL EQU *-NPARAMSG MESSAGE LENGTH R4 M3719000 EJECT R4 M3719500 $MID 443 SET MESSAGE NUMBER R4 M3720000 NUNALMSG WTO '&MID.XXXXXX NOT ALLOCATED',MF=L R4 M3720500 NUNALVOL EQU *-20,6 VOLUME SERIAL R4 M3721000 SPACE 2 R4 M3721500 $MID 444 SET MESSAGE NUMBER R4 M3722000 NRTEMSG WTO '&MID.DDDDDDDD PRINT/PUNCH ROUTE CODE INVALID',MF=L R4 M3722500 NRTEDEV EQU *-39,8 DEVICE NAME R4 M3723000 SPACE 2 R4 M3730000 $MID 448 SET MESSAGE NUMBER R4 M3730500 NBSPMSG WTO '&MID.ILLEGAL BACKSPACE CHARACTER -- RESET TO X''00''', CM3731000 MF=L R4 M3731500 EJECT R4 M3732000 $MID 450 SET MESSAGE NUMBER R4 M3732500 NMSG450 WTO '&MID.OPEN FAILED FOR JES2 PARAMETER LIBRARY',MF=L R4 M3733000 SPACE 2 R4 M3733500 $MID 451 SET MESSAGE NUMBER @OZ27300 M3733600 NMSG451 WTO '&MID.ERROR ON JES2 PARAMETER LIBRARY',MF=L @OZ27300 M3733700 SPACE 2 @OZ27300 M3733800 $MID 465 SET MESSAGE NUMBER @OZ27300 M3733900 NLNEMSG WTO '&MID.RMTNNN SPECIFIES INVALID LINE VALUE',MF=L @OZ27300 M3734000 NLNERMT EQU NLNEMSG+4+9+3,3 @OZ27300 M3734100 SPACE 2 @OZ27300 M3734200 $MID 466 SET MESSAGE NUMBER @OZ27300 M3734300 NLOGMSG WTL '&MID.THIS MESSAGE AREA IS TO CONTAIN A COPY OF THE INITCM3734400 IALIZATION STMNT TO BE LOGGED ',MF=L @OZ27300 M3734500 NLOGTEXT EQU *-80,80 MESSAGE TEXT AREA @OZ27300 M3734600 EJECT @OZ27300 M3734700 $MID 467 SET MESSAGE NUMBER @OZ27300 M3734800 NDIAGMSG WTL '&MID.DIAGNOSTIC MESSAGE FOR ABOVE STATEMENT', CM3734900 MF=L @OZ27300 M3734950 NDIAGTXT EQU *-38,38 STATEMENT DIAGNOSTIC @OZ27300 M3735000 SPACE 2 @OZ27300 M3735100 $MID 468 SET MESSAGE NUMBER @OZ27300 M3735200 NLSTMSG WTO '&MID.KEYWORD=VALUE DISPLAY LONG ENOUGH TO ALSO DISPLAY CM3735300 MESSAGES TO OPERATOR ',MF=L @OZ27300 M3735400 NLSTTXT EQU *-80,80 TOTAL TEXT AREA @OZ27300 M3735500 NLSTKEY EQU *-80,8 KEYWORD @OZ27300 M3735600 SPACE 2 @OZ27300 M3735700 $MID 469 SET MESSAGE NUMBER @OZ27300 M3735800 NOPRMSG WTOR '&MID.REPLY PARAMETER STATEMENT, CANCEL, OR END', CM3735900 NLOGTEXT,L'NLOGTEXT,NPLECB,MF=L @OZ27300 M3736000 SPACE 2 @OZ27300 M3736100 $MID 470 SER MESSAGE NUMBER @OZ27300 M3736200 NDORMMSG WTO '&MID.COMPLEX NOT DORMANT',MF=L @OZ27300 M3736300 NDORMTYP EQU *-19,7 LOCATE 'COMPLEX' @OZ27300 M3736400 EJECT @OZ27300 M3736500 $MID 471 SET MESSAGE NUMBER @OZ27300 M3736600 NRESUMSG WTOR '&MID.REPLY Y OR N TO CONTINUE COLD START', @OZ27300CM3736700 NGWDBL,1,NGECB,MF=L @OZ27300 M3736800 NRESUMST EQU *-10,4 LOCATE 'COLD' @OZ27300 M3736900 SPACE 2 @OZ27300 M3737000 $MID 472 @OZ27300 M3737100 NMSG472 WTO '&MID.VVVVVV CHECKPOINT DATA SET TRACK SIZE INSUFFICIENTCM3737200 -- EXCEEDED BY KKKKK BYTES',MF=L @OZ27300 M3737300 NBYTE472 EQU *-12,6 NUMBER OF BYTES @OZ27300 M3737400 NMVOL472 EQU *-77,6 VOLUME SERIAL @OZ27300 M3737500 SPACE 2 @OZ27300 M3737600 $MID 478 @OZ27300 M3737700 NMSG478 WTO '&MID.VVVVVV CHECKPOINT DATA SET SPACE INSUFFICIENT -- KCM3737800 KKKK TRACKS REQUIRED',MF=L @OZ27300 M3737900 NTRKS478 EQU *-22,6 NO. OF TRACKS REQUIRED @OZ27300 M3738000 NMVOL478 EQU *-70,6 VOLUME SERIAL @OZ27300 M3738100 EJECT @OZ27300 M3738200 $MID 479 @OZ27300 M3738300 NMSGNLOK WTOR '&MID.UNABLE TO OBTAIN CKPT DATA SET LOCK - IO ERROR XM3738400 - REPLY Y OR N TO CONTINUE',NGWDBL, @OZ55936XM3738425 1,NGECB,MF=L @OZ55936 M3738450 NMSGLKID EQU *-45,4 @OZ55936 M3738500 NMSGLSID EQU NMSGLKID+4,4 @OZ55936 M3738525 NMSGINIT EQU NMSGLSID,14 @OZ55936 M3738550 SPACE 2 @OZ27300 M3738600 $MID 481 @OZ27300 M3738700 NMSGNALT WTO '&MID.&&CHKPT2 - ALTERNATE DATA SET NOT SPECIFIED', CM3738800 MF=L @OZ27300 M3738850 SPACE 2 @OZ27300 M3738900 $MID 482 @OZ27300 M3739000 NMSGCK2R WTO '&MID.ALTERNATE CHECKPOINT DATA SET INVALID VOLUME', CM3739100 MF=L @OZ27300 M3739150 SPACE 2 @OZ27300 M3739200 $MID 483 @OZ27300 M3739300 NGJBQMSG WTOR '&MID.JOB QUEUE ERROR -- REPLY Y OR N TO REBUILD', CM3739400 NGWDBL,1,NGECB,MF=L @OZ27300 M3739420 EJECT @OZ27300 M3739440 $MID 484 @OZ27300 M3739460 NGJOTMSG WTO '&MID.JOT ERROR -- OUTPUT MAY BE LOST OR DUPLICATED', CM3739480 MF=L @OZ27300 M3739500 SPACE 2 @OZ27300 M3739600 $MID 485 @OZ27300 M3739700 NGJOEMSG WTO '&MID.JOB NNNN JOT ERROR -- OUTPUT MAY BE LOST OR DUPLICCM3739800 ATED',MF=L @OZ27300 M3739900 NGJOBID EQU *-54,3 JOB TYPE @OZ27300 M3740000 NGJOBNO EQU *-51,5 JOB NUMBER @OZ27300 M3740100 SPACE 2 @OZ27300 M3740200 $MID 486 @OZ27300 M3740300 NMSGBADC WTOR '&MID.VVVVVV DAMAGED CHECKPOINT DATA SET DETECTED -- REPCM3740400 LY Y OR N TO CONTINUE',NGWDBL,1,NGECB,MF=L @OZ27300 M3740500 NMVOL486 EQU *-71,6 VOLUME SERIAL @OZ27300 M3740600 SPACE 2 @OZ27300 M3740700 $MID 487 @OZ27300 M3740800 NMSGBALT WTO '&MID.ALTCKPT INVALID OPTION -- WARM START DENIED', CM3740900 MF=L @OZ27300 M3740950 SPACE 1 @OZ27300 M3741000 NM487STR EQU *-17,4 'WARM/COLD' INSERT @OZ27300 M3741100 EJECT @OZ27300 M3741200 $MID 488 @OZ27300 M3741300 NVLCKMSG WTO '&MID.WAITING FOR CHECKPOINT DATASET LOCK',MF=L @OZ27300 M3741400 SPACE 2 @OZ35996 M3741500 $MID 489 @OZ27300 M3741600 NLKSTMSG WTO '&MID.INITIALIZATION MAY NOT HAVE RELEASED CKPT DATA SETCM3741700 LOCK',MF=L @OZ27300 M3741800 SPACE 2 @OZ35996 M3741810 $MID 490 MESSAGE IDENTIFIER @OZ35996 M3741820 NIPLMSG WTO '&MID.HOTSTART DENIED -- RE-IPL REQUIRED',MF=L @OZ35996 M3741830 SPACE 2 @OZ35996 M3741840 $MID 491 MESSAGE IDENTIFIER @OZ35996 M3741850 NRSTMSG WTO '&MID.SYSTEM BEING RESTARTED ON XXXX',MF=L @OZ35996 M3741860 NRSTID EQU *-4,4 SYSTEM ID @OZ35996 M3741870 SPACE 2 @OZ39639 M3741900 $MID 492 MESSAGE IDENTIFIER @OZ39639 M3741920 NOSUPMSG WTO '&MID.******** PARAMETER IGNORED -- NO LONGER SUPPORTED',*M3741940 MF=L PARAMETR WARNING MESSAGE @OZ39639 M3741960 NOSUPARM EQU *-49-NOSUPMSG,8 PARAMETER INSERT @OZ39639 M3741980 SPACE 2 @OZ41702 M3741990 $MID 493 MESSAGE IDENTIFIER @OZ41702 M3742000 NSTRTMSG WTO '&MID.**** COLD-START IS IN PROGRESS ',MF=L M3742010 NSTRTSSN EQU *-43-NSTRTMSG,4 SUBSYSTEM NAME INSERT @OZ41702 M3742020 NSTRTEXT EQU *-38-NSTRTMSG,39 SYSTEM-ID/STARTUP-TYPE AREA @OZ41702 M3742030 SPACE 2 @OZ41947 M3742060 $MID 494 MESSAGE IDENTIFIER @OZ41947 M3742070 NOHOTMSG WTO '&MID.HOTSTART DENIED -- INVALID SYSTEM ID', @OZ41947*M3742080 MF=L @OZ41947 M3742090 $MID 495 SET MESSAGE NUMBER @OZ41577 M3742092 NMSG495 WTO '&MID.PP BUFFER SIZE EXCEEDS 4096',MF=L @OZ41577 M3742094 SPACE 2 @OZ55871 M3742095 $MID 869 SET MESSAGE NUMBER @OZ55871 M3742096 NMSG869 WTO '&MID.HASPSSSM NOT IN LPA',MF=L @OZ55871 M3742097 NLPAMDNM EQU NMSG869+4+9,8 @OZ55871 M3742098 TITLE 'HASP INITIALIZATION -- COMMON INTERFACE CONTROL BLOCK ICM3742100 NITIALIZATION' @OZ27300 M3742200 ***************************************************************@OZ27300 M3742300 * @OZ27300 M3742400 * CREATE CONSOLE MESSAGE BUFFERS @OZ27300 M3742500 * @OZ27300 M3742600 ***************************************************************@OZ27300 M3742700 SPACE 1 @OZ27300 M3742800 NCMBINIT BALR BASE2,0 RE-ESTABLISH @OZ27300 M3742900 USING *,BASE2 LOCAL ADDRESSABILITY @OZ27300 M3743000 SPACE 1 @OZ27300 M3743100 USING SSVT,WA ESTABLISH SSVT BASE ADDRESS @OZ27300 M3743200 * THIS CARD DELETED BY APAR @OZ27300 M3743500 SPACE 1 R4 M3744000 L WA,$SSVT POINT TO SSVT R4 M3744500 TM $SVSTUS,$SVSTUSR ARE WE RESTARTING M3745000 BZ ICMBNEW CREATE NEW CMBS IF NOT M3745500 ICM R1,15,$SVCMBAC IS THERE ANY ACTIVITY ON CMBS M3746000 BNZ INSTRTEE REFUSE TO START IF NOT ZERO M3746500 ICM R1,15,$SVCMBA POINT TO CMB AREA R4 M3747000 BZ ICMBNEW BR IF NO CMBS R4 M3747500 SH R1,=H'8' POINT TO CMB PREFIX @OZ35996 M3748000 L R0,4(,R1) GET SP/LENGTH @OZ35996 M3748500 FREEMAIN R,LV=(0),A=(1) FREE OLD CMB AREA M3749000 SLR R0,R0 CLEAR M3749500 ST R0,$SVCMBRQ RESERVE QUEUE M3750000 ST R0,$SVCOMMQ CLEAR COMMAND QUEUE PTR R4 M3750500 ST R0,$SVCMBA CLEAR CMB AREA @OZ45606 M3750600 SPACE 1 R4 M3751000 ICMBNEW LH WC,$NUMCMBS GET REQUESTED CMB COUNT R4 M3751500 ST WC,$SVCOMCT SET INTO SSVT M3752000 LA WC,2(0,WC) ADD TWO TO AVOID INTERLOCKS M3752500 MH WC,=Y(CMBL) GET LENGTH OF AREA M3753000 SPACE 1 @OZ35996 M3753500 AL WC,=AL1(231,0,0,8) ADD CSA SUBPOOL, PREFIX LEN @OZ35996 M3754000 LR R0,WC COPY SP/LENGTH @OZ35996 M3754500 GETMAIN R,LV=(0) GET CMB WORK AREA M3755000 MVC 0(4,R1),=C'$CMB' SET EYE-CATCHER IN PREFIX @OZ35996 M3755500 ST WC,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M3756000 LA WC,0(WC,R1) POINT PAST CMBS @OZ35996 M3756500 LA R1,8(,R1) POINT PAST PREFIX @OZ35996 M3757000 ST R1,$SVCMBA SET CMB POOL ADDRESS @OZ35996 M3757500 ST R1,$SVCMBFQ SET FREE QUEUE M3758000 SPACE 1 R4 M3758500 ICMBGENL LR R15,R1 BRING UP REAR M3759000 AH R1,=Y(CMBL) UP TO NEXT CMB M3759500 ST R1,CMBCMB-CMB(,R15) SET CHAIN R4 M3760000 CR R1,WC CHECK FOR END M3760500 BL ICMBGENL LOOP M3761000 XC CMBCMB-CMB(,R15),CMBCMB-CMB(R15) ZERO CHAIN R4 M3761500 EJECT M3762000 *********************************************************************** M3762500 * * M3763000 * QUEUE PARAMETER LIBRARY COMMANDS * M3763500 * * M3764000 *********************************************************************** M3764500 SPACE 1 R4 M3765000 ICM WC,15,NCOMMTAB POINT TO 1ST TEMP COMMAND AREA R4 M3765500 BZ IBLDSSVT BR IF NONE R4 M3766000 L WB,$SVCOMCT ELSE GET RESERVED CMB COUNT R4 M3766500 SLR WE,WE CLEAR FOR COUNT R4 M3767000 L R15,CVTPTR GET R41 M3767100 L R15,CVTCUCB-CVT(,R15) UCM ID R41 M3767200 SL R15,=F'4' OF CURRENT R41 M3767300 L R15,0(,R15) MASTER R41 M3767400 L R15,0(,R15) CONSOLE R41 M3767500 MVC CMBUCM-CMBFLAG+IQUECMBH,UCMID-UCMLIST(R15) R41 M3767600 SPACE 1 R4 M3767700 USING CMBDSECT,WD PROVIDE CMB ADDRESSABILITY R4 M3768000 SPACE 1 R4 M3768500 IQUECOMM L WD,$SVCMBFQ DE-CHAIN NEXT R4 M3769000 MVC $SVCMBFQ(4),CMBCMB CMB ON FREE CHAIN R4 M3769500 MVC CMBCMB,$SVCOMMQ LIFO QUEUE DE-CHAINED R4 M3770000 ST WD,$SVCOMMQ CMB ON $SVCOMMQ R4 M3770500 MVC CMBFLAG(14),IQUECMBH SET CMB HEADER R4 M3771000 MVC CMBFM,$SYSID RESPOND TO THIS SYSTEM R4 M3771500 MVC CMBMSG(71),8(WC) MOVE COMMAND TO CMB R4 M3772000 SPACE 1 R4 M3772500 ICMBFREE LR R1,WC RELOAD TEMP COMMAND AREA ADDRESS R4 M3773000 L WC,0(,WC) POINT TO NEXT TEMP CMD AREA R4 M3773500 FREEMAIN R,LV=80,A=(1),SP=229 FREE CURRENT TEMP CMD AREA R4 M3774000 LTR WC,WC TEST FOR ANOTHER COMMAND R4 M3774500 BZ ICMBXS BR IF NO R4 M3775000 BCT WB,IQUECOMM BR IF ANOTHER RESERVED CMB R4 M3775500 SPACE 1 R4 M3776000 LA WB,1 RESET RESERVED COUNT R4 M3776500 LA WE,1(,WE) BUMP 'IGNORED' COMMAND COUNT R4 M3777000 B ICMBFREE AND BR TO FREE TEMP MSG AREA R4 M3777500 EJECT R41 M3778000 ICMBXS LTR WE,WE TEST 'IGNORED' COMMAND COUNT R4 M3778500 BZ ICMBCT BR IF COUNT IS ZERO R4 M3779000 CVD WE,INITDBL CONVERT EXCESS TO PACKED DECIMAL R4 M3779500 L R1,=A(NCMBMSG) POINT TO WARNING MESSAGE R4 M3780000 MVC NCMBCT+1-NCMBMSG(3,R1),=X'202120' SET EDIT MASK R4 M3780500 ED NCMBCT-NCMBMSG(,R1),INITDBL+6 EDIT EXCESS INTO MSG R4 M3781000 $$WTO (R1) ISSUE WARNING MESSAGE TO OPERATOR R4 M3781500 SPACE 1 R4 M3782000 DROP WD KILL CMB ADDRESSABILITY R4 M3782500 SPACE 1 R4 M3783000 ICMBCT BCTR WB,0 DECREMENT RESERVED COUNT R4 M3783500 ST WB,$SVCOMCT SET RESERVED COUNT R4 M3784000 EJECT M3784500 *********************************************************************** M3785000 * * M3785500 * BEGIN INITIALIZATION OF SSVT * M3786000 * * M3786500 *********************************************************************** M3787000 SPACE 1 R4 M3787500 IBLDSSVT MVC $SVOUTXS,$OUTXS SET OUTPUT EXCESSION MSG INCRE R4 M3788000 MVC $SVOUTOP,$OUTPOPT SET OUTPUT EXCESSION OPTION R4 M3788500 NI $SVSTUS,255-$SVSTXST-$SVSTIDS RESET RUN OPTIONS R4 M3789000 TM $RUNOPTS,$TIMEOPT TEST TIME EXCESSION OPTION R4 M3789500 BZ SKIP870 BR IF NOT SELECTED R4 M3790000 OI $SVSTUS,$SVSTXST ELSE INDICATE OPTION IN SSVT R4 M3790500 SKIP870 TM $RUNOPTS,$MSGID TEST FOR FULL MESSAGE IDS R4 M3791000 BZ SKIP880 BR IF OPTION NOT SELECTED R4 M3791500 OI $SVSTUS,$SVSTIDS ELSE INDICATE OPTION IN SSVT R4 M3792000 SKIP880 MVC $SVROUT,$NUMRJE SET REMOTE TERMINAL COUNT R4 M3792500 MVC $SVTO,$SYSID SET THIS SYSTEM'S MESSAGE ROUTE R4 M3793000 MVC $SVCOMCH,$CCOMCHR SET HASP COMMAND CHARACTER R4 M3793500 MVC $SVCOMM(IPCESL),IPCES INSERT $$POST ELEMENTS R4 M3794000 L R1,PSAAOLD-PSA PICK UP ADDRESS OF OUR ASCB M3794500 ST R1,$HASCB SET IN HCT R4 M3795000 ST R1,$SVQLOKE+16 SET LOCK ELEMENT ASCB ADDRESS M3795500 ST R1,$SVPOSTE+4 SET POST ELEMENT ASCB ADDRESS M3796000 L R1,$HASPMAP POINT TO HASP MODULE MAP R4 M3796500 L R1,MAPSSSMA-MAPDSECT(,R1) POINT TO SSSM R4 M3797000 CLI 0(R1),$SVENTL CHECK LENGTH OF ADCON VECTOR R41 M3797100 BNE INOTCOMP BR IF NOT CORRECT R41 M3797200 L R1,0(,R1) POINT TO ADCON VECTOR R41 M3797300 LR R15,WA POINT TO M3797500 SL R15,=F'8' SSVT PREFIX M3798000 TM $SVSTUS,$SVSTUSR ARE WE RESTARTING M3798500 BO ICLCFUN IF SO INSURE SAME SSSM M3799000 MVC 0(4,R15),=C'SSVT' SET SSVT ID R4 M3799500 MVC SSVTFNUM,ISVTFNUM INSERT NUMBER OF FUNCTIONS M3800000 MVC SSVTFCOD(IFUNL),ISVTFUNS MOVE FUNCTION OFFSETS M3800500 MVC $SVSOUT($SVENTL),0(R1) COPY ENTRIES R41 M3801000 MVC $SVNTGBE,$NUMTGBE SET MAX TG'S PER TGB R4 M3801500 MVC $SVCENQ(IENQPL),IENQP SET CELL ENQ PATTERN M3802000 LA R1,$SVQNAM SET ADDRESS M3802500 ST R1,$SVCENQ+4 OF QNAME M3803000 LA R1,$SVCRNAM SET ADDRESS M3803500 ST R1,$SVCENQ+8 OF RNAME M3804000 MVC $SVQNAM(4),=CL4'SYSZ' SET FIRST PART OF QNAME M3804500 MVC $SVCRNAM,=CL4'CELL' SET RNAME FOR CELL CONTROL M3805000 MVI $SVCPOST,X'FF' INDICATE NO CELLS DESIRED M3805500 LA R1,$SVBR14 GET ADDRESS OF BR 14 M3806000 ST R1,$SVCPOST+8 SET M3806500 ST R1,$SVQLOKE+20 ERROR M3807000 ST R1,$SVPOSTE+8 RETURNS M3807500 MVC $SVQLOKE,$SVSSNM SET QUEUE LOCK ELEMENT HEADER M3808000 LA R1,$SVRETN GET ADDRESS OF RETURN ROUTINE M3808500 ST R1,$SVSMFSO SET DEFAULT M3809000 ST R1,$SVSMFJP SMF EXITS M3809500 MVC $SVRETN(4),=XL4'1FFF07FE' SET RETURN ROUTINE M3810000 EJECT M3810500 *********************************************************************** M3811000 * * M3811500 * BUILD HASP ADDRESS SPACE VECTOR TABLE * M3812000 * * M3812500 *********************************************************************** M3813000 SPACE 3 M3813500 L R1,CVTPTR GET ADDRESS OF CVT M3814000 L R1,CVTASVT-CVT(,R1) GET ADDRESS OF SYSTEM ASVT M3814500 L R1,ASVTMAXU-ASVT(,R1) GET MAXIMUM ADDRESS SPACES M3815000 ALR R1,R1 MULTIPLY BY FOUR M3815500 LA R3,4(R1,R1) AND ADD FOUR M3816000 AL R3,=AL1(241,0,0,8) ADD CSA SUBPOOL, PREFIX LEN @OZ35996 M3816100 LR R0,R3 GET SP/LENGTH @OZ35996 M3816200 GETMAIN R,LV=(0) GET CSA SPACE FOR HAVT @OZ35996 M3816500 LR R4,R1 CLEAR @OZ35996 M3817000 LR R5,R3 HAVT @OZ35996 M3817500 MVCL R4,R14 STORAGE @OZ35996 M3818000 ST R3,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M3818500 MVC 0(4,R1),=C'HAVT' SET EYE-CATCHER IN PREFIX @OZ35996 M3819000 LA R1,8(,R1) POINT PAST PREFIX @OZ35996 M3819500 ST R1,$SVHAVT SET ADDRESS OF THE HAVT M3820000 B ISVTSCAT COMPLETE SSVT INITIALIZATION M3820500 SPACE 3 M3821000 ICLCFUN CLC 0(4,R15),=C'SSVT' CHECK SSVT ID R4 M3821500 BNE INOTCOMP ERROR IF NOT SAME M3822000 CLC SSVTFNUM,ISVTFNUM DOES FUNCTION AREA MATCH M3822500 BNE INOTCOMP IF NOT ERROR EXIT M3823000 CLC SSVTFCOD(IFUNL),ISVTFUNS CHECK FUNCTION OFFSETS M3823500 BNE INOTCOMP ERROR IF NOT SAME M3824000 CLC $SVNTGBE,$NUMTGBE TEST MAX TG'S PER TGB R4 M3824500 BNE INOTCOMP ERROR IF NOT SAME R4 M3825000 CLC $SVSOUT($SVENTL),0(R1) CHECK SAME SSSM R41 M3825500 BE ISVTSCAT BRANCH IF SAME SSSM M3826000 SPACE 2 M3826500 INOTCOMP $EXIT ISTRTEM3 ISSUE ERROR MSG AND QUIT R4 M3827000 SPACE 2 M3827500 INSTRTEE $EXIT ISTRTEM2 ISSUE ERROR MSG AND QUIT R4 M3828000 EJECT M3828500 *********************************************************************** M3829000 * * M3829500 * COMPLETE INITIALIZATION OF SSVT * M3830000 * * M3830500 *********************************************************************** M3831000 SPACE 3 M3831500 ISVTSCAT NULL COMPLETE SSVT M3832000 LA R0,57 PREPARE TO SCAN R4 M3832500 L R1,=A(NSCAT+3*64) SYSOUT CLASS R4 M3833000 LR WB,R1 ATTRIBUTE TABLE R4 M3833500 SPACE 1 R4 M3834000 ISETSCAT LA R1,1(,R1) POINT TO NEXT SCAT ENTRY R4 M3834500 TM SCATFLAG-SCADSECT(R1),SCATPNCH+SCATPLOT+SCATINVL M3835000 BNZ *+8 BRANCH IF PUNCH OR INVALID M3835500 OI SCATFLAG-SCADSECT(R1),SCATPRNT SET PRINT INDICATION M3836000 BCT R0,ISETSCAT GET NEXT ENTRY M3836500 SPACE 1 R4 M3837000 MVC $SVSCAT+3*64(64),0(WB) MOVE SCAT TO SSVT M3837500 MVC $SVBAKSP,$BSPACE SET CONSOLE BACKSPACE CHARACTER R4 M3838000 MVC $SVBFSIZ,$BUFSIZE SET HASP BUFFER SIZE R4 M3838500 LH R1,$BUFSIZE COMPUTE R4 M3839000 SL R1,=A(HQTHQR-HQTSTART) AND R4 M3839500 D R0,=A(HQRLENG) SET R4 M3840000 ST R1,$SVHQRCT MAX HQRS IN HQT R4 M3840500 MVC $SVMAPL,$CYLMAPL SET DA ALLOCATION MAP LENGTH R4 M3841000 MVC $SVNUMDA,$NUMDA SET NO. OF DIRECT ACCESS VOLUMES R4 M3841500 MVC $SVPDDB1,$IOTPDDB SET OFFSET WITHIN IOT OF 1ST PDDB R4 M3842000 MVC $SVRINCR,$RECINCR SET RECORD ALTERNATION PARAMETER R4 M3842500 MVC $SVTKCEL,$TCELSIZ SET TRAKCELL SIZE R4 M3843000 L R1,=A(NXPRITAB) MOVE JOB OUTPUT R4 M3843500 MVC $SVXPRI(10*4),0(R1) PRIORITY TABLE TO SSVT R4 M3844000 MVC $SVNOSYS+1(1),$SYSID SET SYSTEM ID R4 M3845000 MVI $SVNOUNT+1,255 SET MAXIMUM LOCAL UNITS ROUTE R4 M3847500 MVC $SVSID,$SID SET SYSTEM ID @OZ18212 M3847600 EJECT R4 M3848000 *********************************************************************** M3848500 * * M3849000 * INITIALIZE PARTITION INFORMATION TABLES * M3849500 * * M3850000 *********************************************************************** M3850500 SPACE 3 M3851000 L WD,$PITABLE GET ADDRESS OF TEMPORARY PITS R4 M3851500 ICM R1,15,$SVPIT GET ADDRESS OF EXISTING PITS R4 M3852000 ST R1,$PITABLE STORE IN HCT M3852500 BZ NEWPITS BR IF NO EXISTING PITS R4 M3853000 * THIS LINE DELETED BY APAR @OZ35996 M3853500 * THIS LINE DELETED BY APAR @OZ35996 M3854000 * THIS LINE DELETED BY APAR @OZ35996 M3854500 MVC $MAXCLAS,$SVMAXCL USE EXISTING JOB CLASS CNT @OZ35996 M3855000 B NURALL THEN BR TO NEXT SECTION R4 M3855500 SPACE 1 R4 M3856000 NEWPITS SLR WB,WB ZERO R4 M3856500 * THIS LINE DELETED BY APAR @OZ35996 M3857000 IC WB,$MAXCLAS WC = INDIVIDUAL R4 M3857500 LA WC,PITCLASS+1+3-PITDSECT(,WB) PIT R4 M3858000 N WC,=F'-4' LENGTH R4 M3858500 LR WB,WC WB = TOTAL @OZ35996 M3859000 MH WB,$MAXPART PIT SIZE @OZ35996 M3859500 AL WB,=AL1(241,0,0,8) + SP/PREFIX @OZ35996 M3860000 PUSH PRINT - SECTION @OZ35996 M3860500 PRINT OFF - DELETED @OZ35996 M3861000 * THIS LINE DELETED BY APAR @OZ35996 M3861500 * THIS LINE DELETED BY APAR @OZ35996 M3862000 * THIS LINE DELETED BY APAR @OZ35996 M3862500 * THIS LINE DELETED BY APAR @OZ35996 M3863000 * THIS LINE DELETED BY APAR @OZ35996 M3863500 POP PRINT - SECTION DELETED @OZ35996 M3864000 LR R0,WB COPY SP/LENGTH @OZ35996 M3864500 GETMAIN R,LV=(0) GET CSA FOR PITS @OZ35996 M3865000 ST WB,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M3865500 MVC 0(4,R1),=C'$PIT' SET EYE-CATCHER @OZ35996 M3866000 MVC $SVMAXCL,$MAXCLAS COPY &MAXCLAS TO SSVT @OZ35996 M3866500 EJECT R4 M3867000 NMOVEPIT LA WF,8(,R1) POINT TO 1ST PIT ELEMENT R4 M3867500 ST WF,$SVPIT SET IN SSVT R4 M3868000 ST WF,$PITABLE AND IN HCT R4 M3868500 LR R1,WD SAVE POINTER TO TEMPORARY PITS R4 M3869000 LH R0,$MAXPART GET NUMBER OF PITS R4 M3869500 SLR WB,WB GET NUMBER R4 M3870000 IC WB,$MAXCLAS OF JOB CLASSES R4 M3870500 LA WE,PITCLASS-1-PITDSECT(,WB) SET LENGTH R4 M3871000 STC WE,NPITMOVE+1 OF PIT MOVE R4 M3871500 SPACE 1 R4 M3872000 USING PITDSECT,WE PROVIDE PIT ADDRESSABILITY R4 M3872500 SPACE 1 R4 M3873000 NEXTPIT LR WE,WF POINT TO NEXT PIT R4 M3873500 ALR WF,WC SUPPLY NEXT CHAIN POINTER R4 M3874000 SPACE 1 R4 M3874500 NPITMOVE MVC PITDSECT(*-*),0(WD) MOVE NEXT TEMPORARY PIT R4 M3875000 ST WF,PITNEXT SET CHAIN ADDRESS R4 M3875500 LA R15,PITCLASS(WB) SET JOB CLASS R4 M3876000 MVI 0(R15),C' ' TERMINATOR R4 M3876500 L WD,PITNEXT-PITDSECT(,WD) POINT TO NEXT TEMPORARY PIT R4 M3877000 BCT R0,NEXTPIT LOOP THRU ALL REQUESTED PITS R4 M3877500 SPACE 1 R4 M3878000 ST R0,PITNEXT ZERO LAST CHAIN ADDRESS R4 M3878500 B NURALL THEN BR TO NEXT SECTION R4 M3879000 SPACE 1 R4 M3879500 DROP WA,WE KILL SSVT, PIT ADDRESSABILITY R4 M3880000 EJECT R4 M3880500 ISVTFNUM DC Y(($SVRETID-$SVNULL)/4) NUMBER OF FUNCTIONS M3881000 ISVTFUNS $SVTC GENERATE FUNCTION OFFSETS M3881500 IFUNL EQU *-ISVTFUNS M3882000 SENTRIES EQU 16 ENTRY POINTER SECTION OF SSSM M3882500 SPACE 1 M3883000 IENQP ENQ (*-*,*-*,E,4,SYSTEM),MF=L CELL CONTROL ENQ PATTERN M3883500 IENQPL EQU *-IENQP LENGTH OF PATTERN M3884000 SPACE 1 R4 M3884500 IPCES EQU $COMMPCE 1ST $$POST ELEMENT R4 M3885000 IPCESL EQU $SVPCENO*4 ALL $$POST ELEMENTS R4 M3885500 IQUECMBH DC AL1(CMBFLAGC+CMBFLAGU,$ALWAYS+$HI,0,71),AL2(0,256,0,0,0) M3886000 EJECT M3886500 LTORG DEFINE LITERALS FOR SSVT SETUP M3887000 TITLE 'HASP INITIALIZATION -- UNIT RECORD DEVICE ALLOCATION' M3887500 IECITMOD EQU X'18' HASP ATTENTION INDEX M3888000 SPACE 1 R4 M3888500 NURALL BALR BASE2,0 RE-ESTABLISH R4 M3889000 USING *,BASE2 LOCAL ADDRESSABILITY M3889500 SPACE 1 R4 M3890000 SLR R0,R0 CLEAR FOR INSERTS R4 M3890500 IC R0,$NUMRDRS INITIALIZE R4 M3891000 LA R1,NURRDR READER ENTRY IN R4 M3891500 BAL WE,NURDEVS DEVICE ALLOCATION TABLE R4 M3892000 IC R0,$NUMPUNS INITIALIZE R4 M3892500 LA R1,NURPUN PUNCH ENTRY IN R4 M3893000 BAL WE,NURDEVS DEVICE ALLOCATION TABLE R4 M3893500 IC R0,$NUMPRTS INITIALIZE R4 M3894000 LA R1,NURPRT PRINTER ENTRY IN R4 M3894500 BAL WE,NURDEVS DEVICE ALLOCATION TABLE R4 M3895000 LH R0,$NUMLNES INITIALIZE R4 M3895500 LA R1,NURLNE LINE ENTRY IN R4 M3896000 LA WE,NURSSVT DEVICE ALLOCATION TABLE R4 M3896500 SPACE 1 R4 M3897000 NURDEVS CVD R0,INITDBL FORMAT R4 M3897500 OI INITDBL+7,X'0F' DEVICE R4 M3898000 UNPK 1(3,R1),INITDBL COUNT R41 M3898500 CLI 1(R1),C'0' IN R4 M3899000 BNER WE MESSAGE R4 M3899500 MVC 1(3,R1),2(R1) SEGMENT R41 M3900000 CLI 1(R1),C'0' OF R41 M3900100 BNER WE U/R R41 M3900200 MVC 1(3,R1),2(R1) DEVICE R41 M3900300 BR WE TABLE R41 M3900500 EJECT R41 M3901000 NURSSVT L R10,$SSVT GET ADDRESS OF SSVT R4 M3901500 USING SSVT,R10 ESTABLISH SSVT ADDRESSABILITY M3902000 TM $SVSTUS,$SVSTUSP TEST SUBSYSTEM STATUS M3902500 BZ NURAL01 BRANCH IF NOT PRIMARY SUBSYSTEM M3903000 L R1,PSAAOLD-PSA GET ADDRESS OF SUBSYSTEM ASCB M3903500 LH R0,ASCBASID-ASCB(,R1) GET SUBSYSTEM ASID M3904000 ICM R0,8,=AL1(ATBLLKR) INDICATE LOCAL LOCK REQUIRED M3904500 L R1,$HASPMAP POINT TO HASP MODULE MAP R4 M3905000 L R1,MAPATTNA-MAPDSECT(,R1) POINT TO ATTENTION ROUTINE R4 M3905500 L WA,CVTPTR GET ADDRESS OF CVT M3906000 L WA,CVTIXAVL-CVT(,WA) GET ADDRESS OF IOCOM M3906500 L WA,IOCATTBL-IOCOM(,WA) GET ADDRESS OF ATTENTION TABLE M3907000 MODESET EXTKEY=ZERO SET ZERO PROTECT KEY M3907500 STM R0,R1,ATBFLA+2*IECITMOD-ATB(WA) SET ATTN TABLE ENTRY M3908000 MODESET EXTKEY=HASP RESET HASP PROTECT KEY M3908500 SPACE 1 R4 M3909000 NURAL01 MVC NURDEB+1(3),$HASPTCB+1 SET TCB ADDRESS IN DEB M3909500 XC PPL(10),PPL CLEAR PURGE PARM LIST @OZ43916 M3909510 LA WA,NURDEB GET DEB POINTER @OZ43916 M3909520 ST WA,PPL PLACE DEB ADDRESS IN PPL @OZ43916 M3909530 MVI PPLOPT1,PPLDS+PPLPOST+PPLHIO PURGE WITH HIO @OZ43916 M3909540 L WA,CVTPTR GET ADDRESS OF CVT M3910000 L WA,CVTILK2-CVT(,WA) GET START OF UCB LOOK-UP TABLE M3910500 SH WA,=H'2' LESS 2 R4 M3911000 SR WB,WB ZERO UCB ADDR REG M3911500 EJECT R4 M3912000 NXTENTRY LA WA,2(,WA) STEP TO NEXT LOOKUP TABLE ENTRY R4 M3912500 ICM WB,3,0(WA) GET ADDRESS OF NEXT UCB M3913000 BZ NXTENTRY IGNORE IF NULL R4 M3913500 CL WB,=F'65535' TEST FOR X'FFFF' M3914000 BE NURAL10 EXIT IF ALL UCB'S PROCESSED M3914500 USING UCBDSECT,WB ESTABLISH UCB ADDRESSABILITY M3915000 LA WC,NURTAB GET ADDRESS OF DEVICE TYPE TABLE M3915500 LA R0,(NURTABE-NURTAB)/4 GET NUMBER OF ENTRIES M3916000 SPACE 1 R4 M3916500 NURAL02 CLC 0(2,WC),UCBTBYT3 COMPARE DEVICE TYPE WITH UCB TYPE M3917000 BE NURAL03 BRANCH IF DEVICE TYPE FOUND M3917500 LA WC,4(,WC) STEP TO NEXT ENTRY M3918000 BCT R0,NURAL02 TRY NEXT ENTRY M3918500 B NXTENTRY DEVICE TYPE NOT FOUND, LOOP R4 M3919000 SPACE 1 R4 M3919500 NURAL03 L R15,CVTPTR GET ADDRESS OF CVT M3920000 L R15,CVTILK2-CVT(,R15) GET START OF UCB LOOK-UP TABLE M3920500 SH R15,=H'2' LESS 2 R4 M3921000 SR R1,R1 ZERO REG FOR UCB ADDRESS M3921500 SPACE 1 R4 M3922000 NEXTDEV LA R15,2(,R15) STEP TO NEXT LOOKUP TABLE ENTRY R4 M3922500 ICM R1,3,0(R15) GET ADDRESS OF NEXT UCB M3923000 CLR R1,WB COMPARE UCB ADDRESS WITH CURRENT M3923500 BNE NEXTDEV TRY AGAIN IF NO MATCH R4 M3924000 CLR WA,R15 COMPARE LOOK-UP TABLE ADDRESSES M3924500 BNE NXTENTRY DUPLICATE CHN PATH IF DIFFERENT R4 M3925000 SPACE 1 R4 M3925500 MVI NURCSW+4,X'02' INITIALIZE IOB FIELDS M3926000 MVI NURSIOCC,X'30' TO SIMULATE SIO FAILURE M3926500 LH R1,2(,WC) GET ALLOCATION TABLE OFFSET R4 M3927000 LA R1,NURDEVTB(R1) GET ALLOCATION ENTRY FOR THIS UCB R4 M3927500 CLI 0(R1),X'FF' TEST ALLOCATION TYPE R4 M3928000 BE NURAL04 BRANCH IF DESIGNATED UCB REQUIRED R4 M3928500 TM UCBSTAT,UCBONLI+UCBCHGS TEST UCB STATUS M3929000 BNM NURAL04 BRANCH IF NOT ONLINE M3929500 MVI NURSIOCC,0 RESET SIO CONDITION CODE M3930000 TM UCBSTAT,UCBALOC TEST UCB STATUS M3930500 BO NURAL04 BRANCH IF DEVICE IS ALLOCATED M3931000 TM UCBFL1,X'FE' TEST UCB FLAGS M3931500 BNZ NURAL04 BRANCH IF DEVICE IS NOT AVAILABLE M3932000 XC NURECB,NURECB CLEAR ECB M3932500 MVI NURIOB,X'02' PRESET IOBFLAG1 M3933000 STCM WB,7,NURUCB+1 SET ADDRESS OF UCB IN DEB M3933500 EXCP NURIOB INITIATE I/O M3934000 STIMER REAL,NUREXIT,BINTVL=NURINTVL @OZ43916 M3934100 WAIT ECB=NURECB WAIT FOR I/O TO COMPLETE M3934500 TTIMER CANCEL @OZ43916 M3934600 EJECT R4 M3935000 NURAL04 NI NURALSW+1,X'0F' INDICATE DEVICE NOT ASSIGNED M3935500 LA WD,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M3936000 B NURAL06 GO DO IT R4 M3936500 SPACE 1 R4 M3937000 USING DCTDSECT,WD ESTABLISH DCT ADDRESSABILITY M3937500 SPACE 1 R4 M3938000 NURAL05 CLC UCBNAME,DCTBUFAD TEST DCT DESIGNATION R4 M3938500 BNE NURAL06 BRANCH IF THIS UCB NOT DESIGNATED M3939000 BAL WE,NURALLOC ATTEMPT TO ALLOCATE DEVICE M3939500 OI NURALSW+1,X'F0' INDICATE DEVICE ASSIGNED M3940000 SPACE 1 R4 M3940500 NURAL06 ICM WD,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT M3941000 BNZ NURAL05 PROCESS NEXT DCT M3941500 SPACE 1 R4 M3942000 NURALSW NOP NXTENTRY BR IF DEVICE ASSIGNED R4 M3942500 TM NURSIOCC,X'30' TEST SIO CONDTION CODE M3943000 BO NXTENTRY IGNORE DEVICE IF NOT AVAILABLE R4 M3943500 LH R1,2(,WC) GET DEVICE TYPE TABLE OFFSET M3944000 LA WC,NURDEVTB(R1) GET APPROPRIATE ENTRY FOR THIS UCB M3944500 LA WD,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M3945000 B NURAL08 GO DO IT R4 M3945500 SPACE 1 R4 M3946000 NURAL07 CLI DCTBUFAD+2,0 TEST DCT ALLOCATION STATUS R4 M3946500 BNE NURAL08 BRANCH IF DCT IS NOT AVAILABLE M3947000 CLC DCTDEVTP,0(WC) TEST DCT DEVICE TYPE M3947500 BNE NURAL08 BRANCH IF NOT CORRECT DEVICE TYPE M3948000 BAL WE,NURALLOC ATTEMPT TO ALLOCATE DEVICE M3948500 MVI DCTBUFAD+2,1 INDICATE DEVICE ALLOCATED R4 M3949000 B NXTENTRY GET NEXT UCB R4 M3949500 SPACE 1 R4 M3950000 NURAL08 ICM WD,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT M3950500 BNZ NURAL07 PROCESS NEXT DCT M3951000 CLI 1(WC),X'FF' TEST MESSAGE SWITCH M3951500 BE NXTENTRY BR IF MESSAGE HAS BEEN ISSUED R4 M3952000 L R1,=A(NURWTO) POINT TO ERROR MESSAGE R4 M3952500 MVC NURWTOM-NURWTO(,R1),1(WC) SET UP MESSAGE R4 M3953000 $$WTO (R1) ISSUE DEVICES EXCEEDED MESSAGE R4 M3953500 MVI 1(WC),X'FF' INDICATE MESSAGE ISSUED M3954000 B NXTENTRY GET NEXT UCB R4 M3954500 SPACE 1 R4 M3955000 NURAL10 LA WD,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M3955500 B NURAL12 GO DO IT R4 M3956000 SPACE 1 R4 M3956500 NURAL11 ICM R1,7,DCTDCB+1 GET ADDRESS OF DCB (IF PRESENT) R4 M3957000 BZ SKIP890 NOT PRESENT, BR - DRAIN DEVICE R4 M3957500 L R1,DCBDEBAD-DCBDSECT(,R1) GET ADDRESS OF DEB M3958000 ICM R1,7,DEBSUCBB-DEBDSECT(R1) GET ADDRESS OF UCB M3958500 BNZ *+8 BRANCH IF DEVICE IS ALLOCATED M3959000 SKIP890 OI DCTSTAT,DCTDRAIN NO, INDICATE DEVICE DRAINED M3959500 SPACE 1 R4 M3960000 NURAL12 ICM WD,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT R4 M3960500 BNZ NURAL11 PROCESS NEXT DCT M3961000 B NUREND EXIT IF ALL DCT'S PROCESSED M3961500 SPACE 5 M3962000 NURALLOC NULL UNIT RECORD DEVICE ALLOCATION M3962500 L R1,DCTDCB GET ADDRESS OF DCB M3963000 L R1,DCBDEBAD-DCBDSECT(,R1) GET ADDRESS OF DEB M3963500 STCM WB,7,DEBSUCBB-DEBDSECT(R1) SET UCB ADDRESS IN DEB M3964000 LA WC,$IMAGTCB IMPACT IMAGE-LOADER TCB ADR @G38ESBB M3964200 TM DCTDEVTP,DCTPRPU TEST DEVICE TYPE R4 M3964500 BZ NURAL13C BR IF NOT LOC PRINT/PUNCH @OZ26939 M3965000 L R1,DCTEWF ELSE SET UCB ADDR R4 M3965500 STCM WB,7,PRPUUCB+1-PCEDSECT(R1) AND DEVICE TYPE R4 M3966000 MVC PDEVTYPE+1-PCEDSECT(3,R1),UCBTYP+1 IN PPPWORK R4 M3966500 CLI UCBTBYT4,UCB3800 TEST FOR LOCAL 3800 PRINTER R4 M3967000 BNE NURAL13A BR IF NO TO USE REGULAR VALUES R4 M3967500 OI DCTPPSW2,DCTNIPRT ELSE SHOW NON-IMPACT PRINTER R4 M3968000 LH R15,NBR3800 GENERATE TOTAL R4 M3968500 LA R15,1(,R15) COUNT OF R4 M3969000 STH R15,NBR3800 3800 PRINTERS R4 M3969500 CLI DCTFCB,0 FCB SPECIFIED ON PRINTERN CARD... R4 M3970000 BNE SKIP900 BR IF YES TO USE AS DEFAULT R4 M3970500 MVC DCTFCB,$NIPFCB ELSE USE &NIPFCB AS DEFAULT R4 M3971000 SKIP900 CLC DCTFCB,=C' ' TEST FOR HARDWARE (3800) DEFAULT R4 M3971500 BNE SKIP910 BR IF NO R4 M3972000 MVC DCTFCB,=C'****' ELSE, INDICATE IN DCT R4 M3972500 SKIP910 MVC PRDFCB-PCEDSECT(4,R1),DCTFCB SET UP 3800 DEFAULT FCB R4 M3973000 GETMAIN RU,LV=16 STORAGE FOR DTE @OZ26939 M3973200 LR WC,R1 NON-IMPACT LOADER TCB ADDR @G38ESBB M3973300 XC 0(16,R1),0(R1) INITIALIZE DTE @OZ26939 M3973400 SPACE 1 @G38ESBB M3973420 ***************************************************************@G38ESBB M3973440 * @G38ESBB M3973460 * INITIALIZE 3800 PENDING PAGE QUEUE @G38ESBB M3973480 * @G38ESBB M3973500 ***************************************************************@G38ESBB M3973520 SPACE 1 @G38ESBB M3973540 LH R1,=Y(PQHLENG+NUMPQE*PQELENG) GET SPACE FOR @G38ESBB M3973560 GETMAIN R,LV=(R1) PQH AND PQE'S @G38ESBB M3973580 L R15,DCTEWF GET PCE ADDRESS @G38ESBB M3973600 ST R1,PQHADR-PCEDSECT(,R15) SAVE PQH ADDR IN PCE @G38ESBB M3973620 USING PQHDSECT,R1 PQH ADDRESSABILITY @G38ESBB M3973640 XC PQHDSECT(PQHLENG),PQHDSECT ZERO PPQ HEADER @G38ESBB M3973660 LA R15,PQHEND GET ADDR OF START OF PQE'S @G38ESBB M3973680 USING PQEDSECT,R15 PQE ADDRESSABILITY @G38ESBB M3973700 ST R15,PQHFREE ADDR START OF FREE QUEUE @G38ESBB M3973720 LA R14,PQHFIRST-(PQENEXT-PQEDSECT) INITIALIZE @G38ESBB M3973740 ST R14,PQHFIRST SET ACTIVE QUEUE HEAD, @G38ESBB M3973760 ST R14,PQHLAST END OF ACTIVE QUEUE, @G38ESBB M3973780 ST R14,PQHPIDE AND PQE PENDING TO PQE0 @G38ESBB M3973800 MVI PQHPQECT,NUMPQE SET AVAILABLE PQE @OZ48003 M3973805 MVI PQHPQELM,NUMPQE COUNT AND LIMIT @OZ48003 M3973810 LA R0,NUMPQE GET NUMBER OF PQE'S TO INIT @G38ESBB M3973820 BCTR R0,0 DECREMENT NUMBER OF PQE'S @G38ESBB M3973840 SPACE 1 @G38ESBB M3973860 DROP R1 SUSPEND PQH ADDRESSABILITY @G38ESBB M3973880 NFREINIT LA R1,PQEEND POINT TO NEXT PQE @G38ESBB M3973900 ST R1,PQENEXT CHAIN FREE PPQ ENTRIES @G38ESBB M3973920 ST R14,PQEHDR SET PQE HEADER ADDRESS @OZ48003 M3973930 LR R15,R1 BUMP TO NEXT PQE @G38ESBB M3973940 BCT R0,NFREINIT DECREMENT NUMBER OF PQE'S @G38ESBB M3973960 ST R14,PQENEXT LAST FREE PQE POINT TO PQE0 @G38ESBB M3973970 ST R14,PQEHDR SET PQE HEADER ADDRESS @OZ48003 M3973975 DROP R15 SUSPEND PQE ADDRESSABILITY @G38ESBB M3973980 CLI DCTUCS,0 UCS SPECIFIED ON PRTN CARD @G38ESBB M3973990 BNE NURAL13B BR IF YES TO USE AS DEFAULT R4 M3974000 MVC DCTUCS,$NIPUCS ELSE USE &NIPUCS AS DEFAULT R4 M3974500 B NURAL13B CLEAR SAVE FIELDS R4 M3975000 SPACE 1 R4 M3975500 NURAL13A CLI DCTFCB,0 FCB SPECIFIED ON PRINTERN CARD... R4 M3976000 BNE SKIP920 BR IF YES TO USE AS DEFAULT R4 M3976500 MVC DCTFCB,$PRTFCB ELSE USE &PRTFCB AS DEFAULT R4 M3977000 SKIP920 CLI DCTUCS,0 UCS SPECIFIED ON PRINTERN CARD... R4 M3977500 BNE NURAL13B BR IF YES TO USE AS DEFAULT R4 M3978000 MVC DCTUCS,$PRTUCS ELSE USE &PRTUCS AS DEFAULT R4 M3978500 SPACE 2 R4 M3979000 NURAL13B L R1,DCTEWF STORE ADDR OF HASPIMAG @OZ26939 M3979500 ST WC,PRIMGDTE-PCEDSECT(,R1) SUBTASK DTE INTO PCE @G38ESBB M3979600 NURAL13C CLI DCTDEVTP,DCTLNE TEST DEVICE TYPE @OZ26939 M3979700 BE NURALL4 BRANCH IF RJE LINE M3980000 TM $SVSTUS,$SVSTUSP TEST SUBSYSTEM STATUS M3980500 BZ NURALL2 BRANCH IF NOT PRIMARY SUBSYSTEM M3981000 CLI DCTDEVTP,DCTRDR TEST DEVICE TYPE M3981500 BNE NURALL1 SET ATTN INDICATION IF NOT READER M3982000 TM DCTSTAT,DCTDRAIN TEST DEVICE STATUS M3982500 BOR WE RETURN IF READER IS DRAINED M3983000 EJECT R4 M3983500 NURALL1 OI DCTSTAT,DCTATTN SET FOR ATTENTION PROCESSING M3984000 SPACE 1 R4 M3984500 NURALL2 TM DCTSTAT,DCTDRAIN TEST DEVICE STATUS M3985000 BOR WE RETURN IF DEVICE IS DRAINED M3985500 TM NURSIOCC,X'30' TEST SIO CONDITION CODE M3986000 BO NURALL5 BRANCH IF DEVICE IS NOT AVAILABLE M3986500 CLI DCTDEVTP,DCTRDR TEST DEVICE TYPE M3987000 BNE NURALL3 BRANCH IF NOT READER M3987500 $ALLOC (WD),NURALL5 ATTEMPT TO ALLOCATE DEVICE M3988000 TM NURCSW+4,X'02' TEST CHANNEL STATUS WORD M3988500 BZR WE RETURN IF READER IS READY M3989000 OI DCTSTAT,DCTHOLD PLACE READER IN HOLD STATUS M3989500 BR WE AND RETURN M3990000 SPACE 1 R4 M3990500 NURALL3 TM NURCSW+4,X'02' TEST CHANNEL STATUS WORD M3991000 BO NURALL5 BRANCH IF UNIT CHECK M3991500 $ALLOC (WD) ATTEMPT TO ALLOCATE DEVICE M3992000 BNZR WE RETURN IF SUCCESSFUL M3992500 B NURALL5 NO, DRAIN DEVICE M3993000 SPACE 1 R4 M3993500 NURALL4 CLI UCBTBYT3,UCB3CTC TEST DEVICE TYPE R4 M3994000 BNE SKIP930 SKIP IF NOT CTCA R4 M3994500 OI MDCTLINE,DCTPCTC+DCTPTRSP SET CTC AND TRANSPARENCY R4 M3995000 B NURALL5 GO DRAIN DEVICE R4 M3995500 SKIP930 OI MDCTMODE,X'04' SET INTERRUPT MODE R4 M3996000 CLI UCBTBYT4,UCBBSCA TEST DEVICE TYPE R4 M3996500 BNE NURALL5 BRANCH IF NOT 2703 M3997000 MVI MDCTMODE,0 2703, RESET MODE BYTE M3997500 OI MDCTLINE,DCTPTRSP AND FORCE TRANSPARENCY M3998000 SPACE 1 R4 M3998500 NURALL5 OI DCTSTAT,DCTDRAIN INDICATE DEVICE DRAINED M3999000 BR WE AND RETURN M3999500 DROP WB,WD,R10 DROP CONTROL BLOCK ADDRESSABILITY M4000000 NUREXIT DS 0H @OZ43916 M4000100 USING NUREXIT,R12 @OZ43916 M4000200 STM R14,R12,12(R13) STORE CALLER'S REGS. @OZ43916 M4000300 LR R12,R15 SET BASE REG @OZ43916 M4000400 LA R1,PPL POINT TO PURGE PARM LIST @OZ43916 M4000500 PURGE (R1) PURGE OUTSTANDING I/O @OZ43916 M4000600 MVI NURSIOCC,X'30' MARK DEVICE UNAVAILABLE @OZ43916 M4000700 LM R14,R12,12(R13) RESTORE REGS. @OZ43916 M4000800 BR R14 RETURN @OZ43916 M4000900 IECDPPL DSECT=NO DEFINE PURGE PARM LIST @OZ43916 M4000910 NURINTVL DC F'500' @OZ43916 M4000920 LTORG R4 M4001000 EJECT R4 M4001500 NURECB DC F'0' I/O EVENT CONTROL BLOCK M4002000 NURIOB DS 0D INPUT/OUTPUT BLOCK M4002500 DC A(0,NURECB) M4003000 NURCSW DC D'0' M4003500 NURSIOCC DC A(NURCCW,NURDCB,0,0,0,0) M4004000 NURCCW CCW X'03',0,X'20',1 NOP CCW M4004500 NURDCB EQU *-40 DATA CONTROL BLOCK M4005000 DC X'0000A0000C',AL3(NURDEB),X'10000000' M4005500 NURDEB DS 0F DATA EXTENT BLOCK M4006000 DC A(*-*),AL1(4,0,0,0,136,0,0,0,3,0,0,0,1,0,0,0) M4006500 DC A(0),AL1(31),AL3(NURDCB),AL1(2),AL3(NURAPPEN) M4007000 NURUCB DC A(*-*) ADDRESS OF UNIT CONTROL BLOCK M4007500 NURAPPEN DC 5A(NURRET) I/O APPENDAGE VECTOR TABLE M4008000 NURRET BR R14 NOP APPENDAGE M4008500 SPACE 3 M4009000 NURTAB DS 0F UNIT RECORD DEVICE TYPE TABLE M4009500 DC AL1(UCB3UREC,UCB2540R),AL2(NURRDR-NURDEVTB) 2540R M4010000 DC AL1(UCB3UREC,UCB2501),AL2(NURRDR-NURDEVTB) 2501 M4010500 DC AL1(UCB3UREC,UCB3505),AL2(NURRDR-NURDEVTB) 3505 M4011000 DC AL1(UCB3UREC,UCB2540P),AL2(NURPUN-NURDEVTB) 2540P M4011500 DC AL1(UCB3UREC,UCB2520),AL2(NURPUN-NURDEVTB) 2520 M4012000 DC AL1(UCB3UREC,UCB3525),AL2(NURPUN-NURDEVTB) 3525 M4012500 DC AL1(UCB3UREC,UCB1403),AL2(NURPRT-NURDEVTB) 1403 M4013000 DC AL1(UCB3UREC,UCB3203),AL2(NURPRT-NURDEVTB) 3203@OZ40627 M4013100 DC AL1(UCB3UREC,UCB3211),AL2(NURPRT-NURDEVTB) 3211 M4013500 DC AL1(UCB3UREC,UCB3800),AL2(NURPRT-NURDEVTB) 3800 R4 M4014000 DC AL1(UCB3COMM,UCBSDAII),AL2(NURLNE-NURDEVTB) 2701 M4014500 DC AL1(UCB3COMM,UCBBSCA),AL2(NURLNE-NURDEVTB) 2703 M4015000 DC AL1(UCB3CTC,0),AL2(NURNONE-NURDEVTB) CTCA R4 M4015500 NURTABE DS 0F END OF DEVICE TYPE TABLE M4016000 SPACE 3 M4016500 NURDEVTB DS 0F DEVICE ALLOCATION TABLE M4017000 NURRDR DC AL1(DCTRDR),CL14' READER(S)' R41 M4017500 NURPUN DC AL1(DCTPUN),CL14' PUNCH(ES)' R41 M4018000 NURPRT DC AL1(DCTPRT),CL14' PRINTER(S)' R41 M4018500 NURLNE DC AL1(DCTLNE),CL14' LINE(S)' R41 M4019000 NURNONE DC X'FFFF' PREVENTS NON-DESIGNATED UCB ALLOC R4 M4019500 SPACE 3 M4020000 NBR3800 DC H'0' NBR OF 3800 PRINTERS R4 M4020500 NUMPQE EQU 150 NUMBER OF 3800 PQE'S @G38ESBB M4020600 NUMSAVE EQU 10*68 SPACE FOR PRPU SAVE AREA @G38ESBB M4020700 SPACE 3 R4 M4021000 NUREND NULL END OF UNIT RECORD INITIALIZATION M4021500 TITLE 'HASP INITIALIZATION -- FINAL RJE INITIALIZATION' R4 M4137000 *********************************************************************** M4137500 * * M4138000 * COMPLETE RJE INITIALIZATION * M4138500 * * M4139000 *********************************************************************** M4139500 SPACE 1 R4 M4140000 NRJEINIT BALR BASE2,0 RE-ESTABLISH R4 M4140500 USING *,BASE2 LOCAL ADDRESSABILITY R4 M4141000 USING SSVT,WG PROVIDE SSVT ADDRESSABILITY R4 M4141500 SPACE 1 R4 M4142000 L WG,$SSVT GET SSVT ADDRESS R4 M4142500 LH R0,$SVROUT GET NUMBER OF REMOTES R4 M4143000 LTR R0,R0 IF NO REMOTES DEFINED, R4 M4143500 BZ NTPRAT BR TO FREE TEMPORARY STORAGE R4 M4144000 L R1,$MLLMPCE POINT TO LINE MANAGER PCE R4 M4144500 MVI PCEEWF-PCEDSECT(R1),$EWFWORK ENSURE PCE HELD R4 M4145000 LA WA,$PCEORG-(PCENEXT-PCEDSECT) PREPARE TO SCAN PCES R4 M4145500 SPACE 1 R4 M4146000 USING PCEDSECT,WA PROVIDE PCE ADDRESSABILITY R4 M4146500 SPACE 1 R4 M4147000 SKIP1000 ICM WA,15,PCENEXT LOCATE R4 M4147500 BZ NTPRAT FIRST R4 M4148000 TM PCEID,PCERJEID REMOTE TERMINAL R4 M4148500 BZ SKIP1000 PCE R4 M4149000 SPACE 1 R4 M4149500 L R1,PCEDCT ASSUME REMOTE READER @OZ32566 M4150000 CLI PCEID+1,PCERDRID TEST ASSUMPTION R4 M4150500 BE SKIP1010 BR IF VALID R4 M4151000 L R1,PCEDCT ELSE GET PRT/PNCH DCT ADDR @OZ32566 M4151500 SPACE 1 R4 M4152000 DROP WA KILL PCE ADDRESSABILITY R4 M4152500 SPACE 1 R4 M4153000 SKIP1010 SLR WF,WF GET MAXIMUM R4 M4153500 IC WF,$NUMCLAS SYSOUT CLASSES R4 M4154000 STC WF,NCRDCTCL+1 SET CLASS MOVE LENGTH R4 M4154500 SLR WA,WA CLEAR FOR SCAN M4155000 L R14,$RWT POINT TO 1ST RWT ELEMENT R4 M4155500 USING RWTDSECT,R14 ESTABLISH RWT ADDRESSABILITY M4156000 L R15,$RAT POINT TO 1ST RAT ELEMENT R4 M4156500 USING RATDSECT,R15 ESTABLISH RAT ADDRESSABILITY M4157000 SPACE 2 M4157500 NRDBUILD ST R1,RATRDCT STORE ADDRESS OF REMOTE DCT IN RAT M4158000 PRINT OFF PRINT OFF-SECTION DELETED @OZ50955 M4158500 * THIS LINE DELETED BY APAR **@OZ50955 M4158510 * THIS LINE DELETED BY APAR @OZ50955 M4158520 * THIS LINE DELETED BY APAR @OZ50955 M4158530 * THIS LINE DELETED BY APAR @OZ50955 M4158540 * THIS LINE DELETED BY APAR **@OZ50955 M4158550 * THIS LINE DELETED BY APAR @OZ50955 M4158560 * THIS LINE DELETED BY APAR @OZ50955 M4158570 * THIS LINE DELETED BY APAR @OZ50955 M4158580 * THIS LINE DELETED BY APAR @OZ50955 M4158590 * THIS LINE DELETED BY APAR @OZ50955 M4158600 * THIS LINE DELETED BY APAR @OZ50955 M4158610 * THIS LINE DELETED BY APAR @OZ50955 M4158620 * THIS LINE DELETED BY APAR @OZ50955 M4158630 * THIS LINE DELETED BY APAR @OZ50955 M4158640 * THIS LINE DELETED BY APAR @OZ50955 M4158650 PRINT ON PRINT ON - SECTION DELETED @OZ50955 M4158660 ICM WA,1,RATLDCT GET LINE NUMBER @OZ50955 M4158670 BZ NRDBLD3 NON-DEDICATED LINE IF ZERO M4159000 CH WA,$NUMLNES CHECK LINE SPECIFICATION VALIDITY R4 M4159500 BH NLNERROR BRANCH IF INVALID R4 M4160000 L WB,$LNEDCT POINT TO 1ST LINE DCT R4 M4160500 USING DCTDSECT,WB ESTABLISH DCT ADDRESSABILITY M4161000 B *+8 BYPASS FIRST TIME M4161500 L WB,DCTCHAIN GET ADDRESS OF M4162000 BCT WA,*-4 NTH LINE DCT M4162500 TM RATTYPE,DCTPSNA TEST FOR SNA TYPE REMOTE R4 M4163500 BNO SKIP1020 NO, BR -- GO INSURE BSC LINE R4 M4164000 TM MDCTTYPE,DCTPSNA ELSE CHECK FOR LOGICAL LINE TYPE R4 M4164500 BNO NLNERROR NO, BR -- INCOMPATIBLE LINE R4 M4165000 B SKIP1030 SKIP AROUND BSC LINE CHECK R4 M4165500 SKIP1020 TM MDCTTYPE,DCTPSNA INSURE BSC RMTS USE BSC LINES R4 M4166000 BO NLNERROR BRANCH IF SNA LINE R4 M4166500 SKIP1030 ST WB,RATLDCT STORE ADDRESS OF LINE DCT IN RAT M4167500 OI MDCTSTAT,DCTLEASE INDICATE DEDICATED LINE M4168000 ST R15,MDCTRAT STORE RAT ADDRESS IN LINE DCT R4 M4168500 TM RATTYPE,DCTPSNA TEST FOR SNA TYPE RMT R4 M4169500 BO SKIP1040 YES, BR--HANDLE AS SEMI-LEASED R4 M4170000 TM MDCTSTAT,DCTSHARE CHECK IF SHARED @OZ37767 M4170100 BO SKIP1040 IF YES, ZERO MDCTDCT @OZ37767 M4170200 OC MDCTDCT,MDCTDCT TEST FOR ALREADY LEASED R4 M4170500 BZ NRDBLD2 NO, SKIP--LEASE LINE TO FIRST RMT R4 M4171000 SKIP1040 OI MDCTSTAT,DCTSHARE INDICATE SHARED LINE R4 M4171500 LA R1,0 PREPARE TO ZERO LINE DCT RMT PTR R4 M4172000 XC MDCTRAT,MDCTRAT CLEAR RAT ADDRESS FROM LINE DCT R4 M4172500 NRDBLD2 ST R1,MDCTDCT STORE RMT DCT ADDRESS IN LINE DCT R4 M4173500 L R1,RATRDCT RESTORE RMT DCT ADDRESSABILITY R4 M4174000 B NRDBLD3 CONTINUE RMT INITIALIZTION R4 M4174500 DROP WB DROP DCT ADDRESSABILITY M4175000 SPACE 2 R4 M4175500 NLNERROR STM R0,R15,NBADSAV2 SAVE REGISTERS @OZ38672 M4176000 L WB,=A(NLNEMSG) POINT TO MESSAGE TEXT R4 M4176500 MVC NLNERMT-NLNEMSG(3,WB),RATNAME+3 MOVE RMT NUMBR TO MSG R4 M4177000 $$WTO (WB) ISSUE ERROR MESSAGE TO OPERATOR R4 M4177500 LM R0,R15,NBADSAV2 RESTORE REGISTERS @OZ38672 M4178000 XC RATLDCT,RATLDCT CLEAR RMT LINE SPECIFICATION R4 M4178500 MVI NRJEXIT+1,0 FORCE QUIT AFTER TESTING ALL RJE R4 M4179000 EJECT R4 M4179500 NRDBLD3 SLR R10,R10 INDICATE NO PREVIOUS DCT M4180000 IC WA,RATNUMRD GET NUMBER OF READERS M4180500 LA WB,RWTRDR1 GET ADDRESS OF 1ST RDR RWT ELEMENT M4181000 BAL WE,NCRMTDCT BUILD REMOTE READER DCT'S M4181500 SPACE 1 M4182000 IC WA,RATNUMPR GET NUMBER OF PRINTERS M4182500 LA WB,RWTPRT1 GET ADDRESS OF 1ST PRT RWT ELEMENT M4183000 BAL WE,NCRMTDCT BUILD REMOTE PRINTER DCT'S M4183500 SPACE 1 M4184000 IC WA,RATNUMPU GET NUMBER OF PUNCHES M4184500 LA WB,RWTPUN1 GET ADDRESS OF 1ST PUN RWT ELEMENT M4185000 BAL WE,NCRMTDCT BUILD REMOTE PUNCH DCT'S M4185500 MVC RATCONRT(1),$OWNSYS SET SYS ID @OZ26276 M4185550 SPACE 1 R41 M4185600 TM RATTYPE,DCTPLU1 IF NOT SNA REMOTE R41 M4185700 BNO NCONOUT SKIP CONSOLE CONVERSION R41 M4185800 TM RATCONF,RATCONFC IF NO CONSOLE ON REMOTE R41 M4185900 BNO NCONOUT SKIP CONSOLE CONVERSION R41 M4186000 L WE,RATRDCT POINT TO FIRST REMOTE DCT R41 M4186100 IC WA,RATNUMRD NUMBER OF READERS R41 M4186200 XR WB,WB ADDED TO R41 M4186300 IC WB,RATNUMPR NUMBER OF PRINTERS R41 M4186400 AR WB,WA LOCATES LAST PRINTER DCT R41 M4186500 BCT WB,NXTSTRT IF TOP OF RMT DCT CHAIN ALREADY R41 M4186600 B NMAKCON GO CONVERT TO A CONSOLE DCT R41 M4186700 SPACE 1 R41 M4186800 NXTTLST L WE,MDCTDCT-DCTDSECT(,WE) POINT TO NEXT-TO-LAST R41 M4186900 NXTSTRT BCT WB,NXTTLST PRINTER DCT R41 M4187000 L WB,MDCTDCT-DCTDSECT(,WE) POINT TO LAST PRINTER DCT R41 M4187100 MVC MDCTDCT-DCTDSECT(4,WE),MDCTDCT-DCTDSECT(WB) MOV LAST R41 M4187200 MVC MDCTDCT-DCTDSECT(4,WB),RATRDCT PRINTER DCT TO R41 M4187300 ST WB,RATRDCT TOP OF RMT DCT CHAIN R41 M4187400 NMAKCON L WE,RATRDCT POINT TO CONSOLE DCT TO BE R41 M4187500 MVI DCTDEVTP-DCTDSECT(WE),DCTRCON MAKE DEV TYPE CONSOLE R41 M4187600 MVI MDCTSEL-DCTDSECT(WE),X'80' SHOW OUTBND CONS. SELECT R41 M4187700 LA WB,DCTDEVN-DCTDSECT(,WE) CHANGE R41 M4187800 NAMESCN LA WB,1(,WB) DEVICE NAME R41 M4187900 CLI 0(WB),C'.' TO R41 M4188000 BNE NAMESCN READ R41 M4188100 MVC 1(3,WB),=C'CON' RNNN.CON R41 M4188200 NCONOUT DS 0H R41 M4188300 SPACE 1 M4188400 LA R14,RWTEND GET ADDRESS OF NEXT WORK TABLE M4188500 LA R15,RATEND GET ADDRESS OF NEXT RAT ELEMENT M4188600 BCT R0,NRDBUILD BUILD DCT'S FOR NEXT REMOTE M4188700 SPACE 1 R4 M4188800 DROP R14 KILL RWT ADDRESSABILITY R4 M4188900 SPACE 1 R4 M4189000 NRJEXIT B NRDBUFS BR IF NO ROUTE CODE ERRORS R4 M4189500 $EXIT NGQUITM ELSE ISSUE 'QUIT' MSG AND QUIT R4 M4190000 SPACE 1 R4 M4190500 NRDBUFS LH R1,$TPBFSIZ GET TP BUFFER SIZE R4 M4191000 CH R1,$MLBFSIZ TEST AGAINST ML BUFFER SIZE R4 M4191500 BNL SKIP1050 BR IF AT LEAST AS LARGE R4 M4192000 LH R1,$MLBFSIZ ELSE FORCE R4 M4192500 LA R1,7(,R1) &TPBFSIZ = &MLBFSIZ R4 M4193000 N R1,=F'-8' ROUNDED UP TO R4 M4193500 STH R1,$TPBFSIZ MULTIPLE OF 8 BYTES R4 M4194000 SKIP1050 LH WE,=AL2(BUFDSECT-TPBUFST) LOAD BSC TP BUFR PREFIX SZ R4 M4194500 LH WF,=AL2(RPLDSECT-RPLBUFST) LOAD SNA TP BFR PREFIX SZ R4 M4195500 LCR R0,WF ASSUME SNA TP BUFFER LARGER R4 M4196000 CLR WE,WF TEST ASSUMPTION R4 M4196500 BNL SKIP1060 BRANCH IF VALID R4 M4197000 LCR R0,WE ELSE-- USE BSC TP BFR SZ R4 M4197500 SKIP1060 AR R1,R0 COMPUTE ACTUAL TP BUFFER SIZE R4 M4198500 LA R1,7(,R1) ROUND UP TO A R41 M4198600 N R1,=F'-8' DOUBLE WORD BOUNDARY R41 M4198700 CH R1,=H'4096' IF BUFFER SIZE LARGER THAN @OZ20669 M4198800 BNH SKIP1065 ONE PAGE, ROUND DOWN TO @OZ20669 M4198850 LH R1,=H'4096' ONE PAGE @OZ20669 M4198900 SKIP1065 DS 0H @OZ20669 M4198950 AR WE,R1 COMPUTE BSC BUFFER USABLE SIZE R4 M4199000 STH WE,$BFSZBSC AND STORE VALUE IN HCT R4 M4199500 AR WF,R1 COMPUTE SNA BUFFER USABLE SIZE R4 M4200500 STH WF,$BFSZSNA AND STORE VALUE IN HCT R4 M4201000 LH R0,$NUMTPBF GET RJE BUFFER REQUEST R4 M4202000 L WF,=A(NBFBUILD) POINT TO BUFFER BUILD ROUTINE R4 M4202500 BALR WE,WF AND GO DO IT R4 M4203000 MVI BPMBFTYP-BPMDSECT(R1),BUFTP SET BUFFER TYPE R4 M4203500 STH R0,$NUMTPBF STORE BUFFERS ALLOCATED R4 M4204000 ST R1,$TPBFMAP AND BUFFER POOL MAP ADDRESS R4 M4204500 EJECT R4 M4205000 *********************************************************************** M4205600 * * M4205700 * OBTAIN PERMANENT CPT, AND INITIALIZE * M4205800 * * M4205900 *********************************************************************** M4206000 SPACE 1 R41 M4206100 LH WB,$NUMCPTS GET NUMBER OF CPTS R41 M4206200 LTR WB,WB IF NOT ZERO R41 M4206300 BNZ NGETCPT GO GET SPACE R41 M4206400 ST WB,$CPTPOOL IF NO CPTS, ZERO CPTPOOL ADDRESS R41 M4206500 B NCPTDONE GO ON TO NEXT PHASE OF INIT R41 M4206600 SPACE 1 R41 M4206700 NGETCPT MH WB,=AL2(CPTEND-CPTDSECT) CALCULATE TOTAL LENGTH REQD R41 M4206800 GETMAIN R,LV=(WB) GET SPACE FOR CPT R41 M4206900 SPACE 1 R41 M4207000 L WA,$CPTPOOL POINT TO TEMP CPT POOL R41 M4207100 USING CPTDSECT,WA R41 M4207200 L WF,$MLLMPCE GET LINE MANAGER WORK R41 M4207300 USING PCEDSECT,WF AREA ADDRESSABILITY R41 M4207400 LA WE,1 INDEX PERM CPTS FROM 1 R41 M4207500 SPACE 1 R41 M4207600 LA WA,CPTDSECT POINT TO ZERO CPT R41 M4207700 ST R1,$CPTPOOL SAVE ADDR OF PERM CPTS R41 M4207800 LR WC,R1 POINT TO PERM CPT R41 M4207900 LA R1,CPTEND-CPTDSECT SET INCREMENT REG R41 M4208000 LH R0,$NUMCPTS SET LOOP COUNT R41 M4208100 SLR WD,WD CLEAR WORK REG FOR INDEXED 'STC' R41 M4208200 SPACE 1 R41 M4208300 NEXTCPT ALR WA,R1 POINT TO NEXT TEMP CPT R41 M4208400 SPACE 1 R41 M4208500 NMOVECPT CLI CPTNMAST,X'00' IF TEMP CPT NOT INIT R41 M4208600 BE NEXTCPT GO POINT TO NEXT CPT R41 M4208700 IC WD,CPTNUM PICK UP NOMINAL TABLE NUMBER R41 M4208800 STC WE,MCPTMAP-PCEDSECT(WD,WF) USE AS OFFSET INTO QUICK R41CM4208900 LOCATORS & SAVE OFFSET R41 M4209000 LR WB,R1 GET TWO COPIES OF LENGTH R41 M4209100 LR WD,R1 OF CPT FOR LONG MOVE R41 M4209200 MVCL WC,WA MOVE TEMP CPT TO PERM STORAGE R41 M4209300 LA WE,1(,WE) ADVANCE PERM CPT INDEX R41 M4209400 BCT R0,NMOVECPT REPEAT 'TIL ALL VALID CPTS MOVED R41 M4209500 SPACE 1 R41 M4209600 NCPTDONE EQU * R41 M4209700 SPACE 1 R41 M4209800 DROP WA,WF DISCARD TEMP ADDRESSABILITY R41 M4209900 EJECT R41 M4210000 *********************************************************************** M4210100 * * M4210200 * OBTAIN AND INITIALIZE STORAGE FOR ICES * M4210300 * * M4210400 *********************************************************************** M4210500 SPACE 3 R4 M4210600 ICM WD,15,NLOGLINE IF NO SNA R4 M4210700 BNZ SKIP1070 LOGICAL LINES, R4 M4210800 STH WD,$MAXSESS SET SESSION COUNT TO ZERO R4 M4210900 SKIP1070 LH R0,$MAXSESS IF SESSIONS R4 M4211000 LTR R0,R0 SPECIFIED, R4 M4211100 BNM SKIP1080 BR TO TEST SPECIFICATION R4 M4211500 LTR R0,WD ELSE SET EQUAL TO COUNT R4 M4212000 STH R0,$MAXSESS OF LOGICAL LINES R4 M4212500 SKIP1080 BZ NTPRAT BR IF SESSION COUNT ZERO R4 M4213000 MH R0,=AL2((ICESIZE+7)/8*8) COMPUTE STORAGE NEEDED R41 M4213500 LR WB,R0 SAVE STORAGE SIZE FOR MVCL R4 M4214000 SPACE 1 R4 M4214500 GETMAIN R,LV=(0) GET ICES IN TRAY R4 M4215000 SPACE 1 R4 M4215500 LR WA,R1 WA = START OF ICETRAY R4 M4216000 SLR WD,WD WD = ZERO R4 M4216500 MVCL WA,WC CLEAR ICETRAY R4 M4217000 SPACE 1 R4 M4217500 LA WA,$ICETRAY-(ICEAPCHN-ICEDSECT) FAKE ICEAPCHN R4 M4218000 LH WB,$MAXSESS PICK UP COUNT OF ICES R4 M4218500 SPACE 1 R4 M4219000 USING ICEDSECT,WA SHOW ICE ADDRESSABILITY R4 M4219500 SPACE 1 R4 M4220000 NBLDICE ST R1,ICEAPCHN CHAIN NEW ICE TO OLD R4 M4220500 LR WA,R1 SAVE OLD ICE ADDRESS FOR CHAINING R4 M4221000 LA R1,((ICESIZE+7)/8*8)(,R1) BUMP TO NEXT ICE R41 M4221500 BCT WB,NBLDICE LOOP FOR ALL ICES R4 M4222000 SPACE 1 R4 M4222500 DROP WA RELEASE ICE ADDRESSABILITY R4 M4223000 EJECT R4 M4223500 *********************************************************************** M4224500 * * M4225000 * OBTAIN PERMANENT RAT * M4225500 * * M4226000 *********************************************************************** M4226500 SPACE 1 R4 M4227000 NTPRAT LH WB,$SVROUT GET LENGTH R4 M4227500 MH WB,=AL2(RATTLE) OF RAT R4 M4228000 LTR R1,WB IF NO REMOTES DEFINED, R4 M4228500 BZ NRDFRAT BR TO FREE TEMPORARY STORAGE R4 M4229000 LA WB,8(,WB) ELSE GET R4 M4229500 LR R0,WB PERMANENT R4 M4230000 GETMAIN R,LV=(0) RAT STORAGE R4 M4230500 MVC 0(4,R1),=CL4'RAT' SET RAT ID M4231000 ST WB,4(,R1) AND LENGTH M4231500 SPACE 2 M4232000 NMOVERAT LA R1,8(,R1) GET ADDRESS OF FIRST RAT ELEMENT M4232500 SL WB,=F'8' GET LENGTH OF RAT ELEMENTS M4233000 LR WA,R1 WA = NEW ADDRESS OF RAT M4233500 L WC,$RAT WC = CURRENT RAT ADDRESS R4 M4234000 LR WD,WB WD = WB = LENGTH OF RAT M4234500 MVCL WA,WC MOVE TEMP RAT TO FINAL LOCATION R4 M4235000 EJECT R4 M4235500 *********************************************************************** M4236000 * * M4236500 * FREE TEMPORARY RAT, CORRECT DCT RAT ADDRESSES * M4237000 * * M4237500 *********************************************************************** M4238000 SPACE 1 R4 M4238500 NRDFRAT ST R1,$RATABLE SET RAT ADDRESS IN HCT R4 M4239000 L R1,NTMPSTOR FREE R4 M4239500 L R0,0(,R1) TEMPORARY R4 M4240000 FREEMAIN R,LV=(0),A=(1) STORAGE R4 M4240500 SLR R0,R0 CLEAR REGISTER R4 M4241000 ICM R0,3,$NUMLNES GET NUMBER OF RJE LINES R4 M4241500 BZ NRDT BR IF NONE DEFINED R4 M4242000 L R1,$RAT GET DIFFERENCE BETWEEN R4 M4242500 SL R1,$RATABLE CURRENT AND TEMPORARY RAT R4 M4243000 L WB,$LNEDCT POINT TO 1ST LINE DCT R4 M4243500 SPACE 1 R4 M4244000 USING DCTDSECT,WB PROVIDE DCT ADDRESSABILITY R4 M4244500 SPACE 1 R4 M4245000 NEXTLINE TM MDCTSTAT,DCTLEASE TEST FOR LEASED LINE R4 M4245500 BZ SKIP1090 BR IF NO R4 M4246500 OC MDCTRAT,MDCTRAT TEST FOR SHARED LINE R4 M4247000 BZ SKIP1090 BR IF NO R4 M4248000 L R15,MDCTRAT ELSE R4 M4248500 SLR R15,R1 ADJUST R4 M4249000 ST R15,MDCTRAT RAT ADDRESS R4 M4249500 SKIP1090 L WB,DCTCHAIN POINT TO NEXT LINE DCT R4 M4250000 BCT R0,NEXTLINE LOOP THRU ALL LINE DCTS R4 M4250500 SPACE 1 R4 M4251000 B NRDT EXIT TO NEXT SECTION R4 M4251500 SPACE 1 R4 M4252000 DROP WB KILL DCT ADDRESSABILITY R4 M4252500 EJECT R4 M4253000 NCRMTDCT NULL BUILD REMOTE DEVICE DCT M4253500 USING DCTDSECT,R1 ESTABLISH DCT M4254000 USING RWTDSECT,WB AND RWT ADDRESSABILITY M4254500 LTR WA,WA TEST NUMBER OF DCT'S M4255000 BZR WE EXIT IF ZERO M4255500 LTR R10,R10 TEST FOR PREVIOUS DCT M4256000 BZ NCRDCT2 BRANCH IF NO PREVIOUS DCT M4256500 SPACE 2 M4257000 NCRDCT1 ST R1,MDCTDCT-DCTDSECT(,R10) SET REMOTE DEVICE CHAIN R4 M4257500 SPACE 1 R4 M4258000 NCRDCT2 LR R10,R1 UPDATE PREVIOUS DCT TO CURRENT M4258500 SLR WC,WC CLEAR REGISTERS M4259000 IC WC,RWTINDEX GET LOOK-UP TABLE INDEX M4259500 AL WC,=A($RWL) GET ADDRESS OF LOOK-UP TABLE ELEMENT M4260000 USING RWLDSECT,WC ESTABLISH RWL ADDRESSABILITY M4260500 SPACE 1 M4261000 MVC DCTSTAT,RWTSTAT SET DCT STATUS M4261500 MVC DCTNO,RATROUTE SET REMOTE ROUTE CODE M4262000 CLC RWTROUTE,=X'8000' TEST REMOTE DEVICE ROUTE CODE M4262500 BE *+10 BRANCH IF DEFAULT M4263000 MVC DCTROUTE,RWTROUTE+1 ELSE USE DEVICE ROUTE CODE R4 M4263500 MVC DCTDEVN,RATNAME SET UP REMOTE NAME M4264000 MVC DCTDEVN+1(5),DCTDEVN+3 SHIFT REMOTE NUMBER M4264500 LA WD,DCTDEVN+1 SEARCH M4265000 LA WD,1(,WD) FOR M4265500 CLI 0(WD),C' ' FIRST M4266000 BNE *-8 BLANK M4266500 MVI 0(WD),C'.' ADD PERIOD M4267000 MVC 1(3,WD),RWLNAME ADD DEVICE NAME M4267500 MVC MDCTTYPE,RATTYPE SET TERMINAL TYPE M4268000 LH WD,RATBUFSZ PICK UP REMOTE BUFSIZE @OZ50955 M4268300 SH WD,=H'5' REDUCE TO FILL SIZE @OZ50955 M4268400 STH WD,MDCTBFSZ SET SIZE FOR MULTI-LEAVING @OZ50955 M4268500 L WD,RATLDCT GET ADDRESS OF LINE DCT M4268700 LTR WD,WD TEST M4269000 BZ NCRDCT3 BRANCH IF NON-DEDICATED LINE M4269500 TM MDCTSTAT-DCTDSECT(WD),DCTSHARE TEST FOR SHARED LINE R4 M4270500 BO NCRDCT3 YES, BR--TREAT AS UNLEASED R4 M4271000 OI MDCTSTAT,DCTSINON INDICATE DCT ATTACHED TO LINE DCT M4272000 STCM WD,7,DCTDCB+1 SET ADDRESS OF LINE DCT IN RMT DCT M4272500 MVC MDCTLINE,MDCTLINE-DCTDSECT(WD) SET LINE CHARACTERISTICS M4273000 TM RATFEAT,DCTPTRSP TEST TERMINAL FEATURES M4273500 BO NCRDCT3 BR IF TERMINAL HAS TRANSPARENCY R4 M4274000 NI MDCTLINE,255-DCTPTRSP NO, RESET POSSIBLE INDICATION M4274500 EJECT R4 M4275000 NCRDCT3 DS 0H R4 M4275500 TM MDCTTYPE,DCTPSNA TEST FOR SNA TYPE TERMINAL R4 M4276500 BZ NCRDCT30 NO, BRANCH - GO INIT FCS/RCB R4 M4277000 MVC MDCTSEL,RWTSEL SET MEDIA/SUBADDRESS @OZ29180 M4277500 CLI MDCTSEL,DCTPOUTB+FMHCARD TEST FOR @OZ29180 M4277600 BL NCRDCTNC CARD MEDIA @OZ29180 M4277700 CLI MDCTSEL,DCTPOUTB+FMHCARD+FMHLDANY BRANCH @OZ29180 M4277800 BH NCRDCTNC IF NOT @OZ29180 M4277900 OI RATFLAGS,RATCARD SET CARD INDICATOR @OZ29180 M4278000 NCRDCTNC CLI MDCTSEL,DCTPOUTB+FMHEXCH TEST FOR @OZ29180 M4278100 BL NCRDCTNE EXCHANGE MEDIA @OZ29180 M4278200 CLI MDCTSEL,DCTPOUTB+FMHEXCH+FMHLDANY BRANCH @OZ29180 M4278300 BH NCRDCTNE IF NOT @OZ29180 M4278400 OI RATFLAGS,RATEXCH SET EXCHANGE INDICATOR @OZ29180 M4278500 NCRDCTNE MVC MDCTBFSZ,RATBUFSZ MOVE BUFR (RU) SIZE TO DCT @OZ29180 M4278600 CLI RWLNAME,C'P' TEST REMOTE DEVICE TYPE R4 M4279000 BNE NCRDCT31 BRANCH IF NOT PRINT OR PUNCH R4 M4279500 * THIS LINE DELETED BY APAR @OZ19494 M4280000 MVC MDCTCHLM,RWTCHLM SET CHAIN LIMIT VALUE @OZ19494 M4280500 LH WD,$NUMCPTS GET NUMBER OF COMPACTION TABLES R41 M4280600 LTR WD,WD ANY COMPACTION TABLES R41 M4280700 BNZ NCRDCT34 YES, CONTINUE RJE INITIALIZATION R41 M4280800 NI RATFEAT,255-DCTPCPCT NO, COMPACTION NOT ALLOWED R41 M4280900 B NCRDCT31 GO INITIALIZE REST OF RJE VALUES R41 M4281000 SPACE 1 R41 M4281100 NCRDCT34 TM RATFEAT,DCTPCPCT IS COMPACTION ALLOWED R41 M4281200 BZ NCRDCT31 NO, CONTINUE RJE INITIALIZATION R41 M4281300 OI RATFEAT,DCTPPRES YES, ASSURE COMPRESSION R41 M4281400 B NCRDCT31 GO INITIALIZE REST OF RJE VALUES R4 M4281500 SPACE 1 R4 M4282000 NCRDCT30 DS 0H R4 M4282500 MVC MDCTFCS,RWLFCS SET DEVICE FUNCTION CONTROL SEQ R41 M4283500 MVC MDCTRCB,RWLRCB SET DEVICE RECORD CONTROL BYTE M4284000 SPACE 1 R4 M4284500 NCRDCT31 MVC MDCTFMT,RATFMT SET TERMINAL FORMAT R4 M4285000 MVC MDCTFEAT,RATFEAT SET TERMINAL FEATURES M4285500 NC MDCTFEAT,RWTFEAT SET COMMON BSC/SNA FEATURES @OZ29180 M4285600 MVC DCTLRECL,RWTLRECL SET DEFAULT RECORD LENGTH @OZ29180 M4285700 MVC MDCTRECL,DCTLRECL SET RECORD LENGTH @OZ29180 M4285800 TM MDCTTYPE,DCTPSNA TEST FOR SNA TERMINAL @OZ29180 M4285900 BZ NCRDCTNS BRANCH IF NOT SNA @OZ29180 M4286000 OI MDCTFEAT,DCTPNDST+DCTPCCTL ASSUME CARRIAGE CNT @OZ29180 M4286100 * AND NOT BASIC/EXCHANGE @OZ29180 M4286200 NC MDCTFEAT,RWTSFEAT INCLUDE SNA ONLY FEATURES @OZ29180 M4286250 TM MDCTFEAT,DCTPCCTL ARE CARRIAGE CNTRLS ALLOWED @OZ29180 M4286300 BO NCRDCTCC YES, CONTINUE @OZ29180 M4286325 NI MDCTFEAT,255-DCTPCPCT-DCTPPRES NO, FORCE NO @OZ29180 M4286350 B NCRDCTNS COMPRESSION NO COMPACTION @OZ29180 M4286375 NCRDCTCC TM MDCTFEAT,DCTPCPCT IS COMPACTION ALLOWED @OZ29180 M4286400 BZ NCRDCTNS NO, CONTINUE @OZ29180 M4286500 OI MDCTFEAT,DCTPPRES YES, FORCE COMPRESSION @OZ29180 M4286600 NCRDCTNS LH WD,$SVROUT COMPUTE @OZ29180 M4286700 LA WD,1(,WD) REMOTE @OZ29180 M4286800 SLR WD,R0 NUMBER R4 M4287000 STH WD,DCTDEVID SET REMOTE NUMBER M4287500 MVN DCTDEVID(1),RWLNAME+2 AND DEVICE NUMBER IN DEVICE ID M4288000 CLI RWLNAME,C'P' TEST DEVICE TYPE M4288500 BE NCRDCT4 BRANCH IF REMOTE PRINTER OR PUNCH M4289000 MVC DCTFLAGS,RWTFLAGS SET OPERATOR COMMANDS M4289500 * THIS CARD DELETED BY APAR @OZ29180 M4290000 OI DCTDEVID,DCTRMTID+DCTRDRID SET REMOTE READER ID M4290500 MVC DCTPRINT,RATROUTE SET PRINT DESTINATION M4291000 CLI RWTPRINT,X'80' TEST PRINT ROUTE CODE R4 M4291500 BE NCRDCT32 BR IF INDIRECT ROUTING R41 M4292000 MVC DCTPRRTE,RWTPRINT+1 ELSE OVERRIDE ROUTE CODE R4 M4292500 NCRDCT32 DS 0H R41 M4292600 * THIS CARD DELETED BY APAR @OZ29180 M4298500 NCRDCT3A CLI DCTPRRTE,0 TEST FOR REMOTE/LOCAL ROUTING R4 M4299000 BE NCRDCT3B BR IF NO R4 M4299500 TM DCTFLAGS,DCTPRLCL TEST FOR SPECIAL LOCAL ROUTING R4 M4300000 BZ NCRDCT3B BR IF NO R4 M4300500 MVI DCTPRSYS,0 ELSE RESET SYSTEM ID R4 M4301500 SPACE 1 R4 M4305500 NCRDCT3B CLC DCTPRSYS,$OWNSYS TEST FOR ROUTE TO REMOTE R4 M4306000 BNE SKIP1110 BR IF NO R4 M4307000 CLC DCTPRRTE,$NUMRJE+1 TEST FOR VALID REMOTE NUMBER R4 M4307500 BH NRTEBAD BR IF NO R4 M4308000 SKIP1110 MVC DCTPUNCH,RATROUTE SET PUNCH DESTINATION R4 M4308500 CLI RWTPUNCH,X'80' TEST PUNCH ROUTE CODE R4 M4309000 BE NCRDCT33 BR IF INDIRECT ROUTING R41 M4309500 MVC DCTPURTE,RWTPUNCH+1 ELSE OVERRIDE ROUTE CODE R4 M4310000 NCRDCT33 DS 0H R41 M4310200 EJECT R4 M4314500 NCRDCT3C CLI DCTPURTE,0 TEST FOR REMOTE/LOCAL ROUTING R4 M4315000 BE NCRDCT3D BR IF NO R4 M4315500 TM DCTFLAGS,DCTPULCL TEST FOR SPECIAL LOCAL ROUTING R4 M4316000 BZ NCRDCT3D BR IF NO R4 M4316500 MVI DCTPUSYS,0 ELSE RESET SYSTEM ID R4 M4317500 SPACE 1 R4 M4321500 NCRDCT3D CLC DCTPUSYS,$OWNSYS TEST FOR ROUTE TO REMOTE R4 M4322000 BNE NCRDCT3E BR IF NO R4 M4323000 CLC DCTPURTE,$NUMRJE+1 TEST FOR VALID REMOTE NUMBER R4 M4323500 BH NRTEBAD BR IF NO R4 M4324000 SPACE 1 R4 M4324500 NCRDCT3E NI DCTFLAGS,255-DCTPRLCL-DCTPULCL CLEAR ANY FLAGS R4 M4325000 MVI DCTSIAFF,QUESYSAF SET GLOBAL SYSTEM AFFINITY M4325500 MVI DCTRAUTH,DCTREJRM SET REMOTE COMMAND AUTHORITY M4326000 MVC DCTJCLAS(4),RWTJCLAS SET CLASSES AND PRIORITY VALUES M4326500 L WD,CVTPTR GET ADDRESS OF CVT M4327000 L WD,CVTSMCA-CVTDSECT(,WD) GET ADDRESS OF SMCA M4327500 MVC DCTINDC,SMCAOPT-SMCA(WD) SET BACKGROUND SMF OPTIONS R4 M4328000 ICM R1,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT R4 M4328500 LA WB,RWTRDEND GET ADDRESS OF NEXT RWT ELEMENT M4329000 BCT WA,NCRDCT1 BUILD ADDITIONAL READER DCT'S M4329500 BR WE AND RETURN WHEN DONE M4330000 SPACE 1 R4 M4330500 NRTEBAD STM R0,R15,NBADSAV2 SAVE REGISTERS @OZ38672 M4331000 L R15,=A(NRTEMSG) POINT TO MESSAGE TEXT @OZ38672 M4331500 MVC NRTEDEV-NRTEMSG(,R15),DCTDEVN SET DEVICE NAME @OZ38672 M4332000 $$WTO (R15) ISSUE ERROR MESSAGE TO OPERATOR @OZ38672 M4332500 LM R0,R15,NBADSAV2 RESTORE REGISTERS @OZ38672 M4333000 MVI NRJEXIT+1,0 FORCE QUIT AFTER TESTING ALL RDRS R4 M4333500 B NCRDCT3E BR TO TEST NEXT READER R4 M4334000 SPACE 1 @OZ38672 M4334100 NBADSAV2 DS 16F LOCAL REGISTER SAVE AREA @OZ38672 M4334200 EJECT R4 M4334500 NCRDCT4 OI DCTDEVID,DCTRMTID+DCTPRTID SET REMOTE PRINTER ID R4 M4335000 CLI RWLNAME+1,C'R' TEST DEVICE TYPE M4335500 BNE NCRDCT4A BR IF NOT REMOTE PRINTER R4 M4336000 L WC,DCTEWF POINT TO PCE R4 M4336500 LA WD,$IMAGTCB STORE ADDR OF HASPIMAG @OZ26939 M4336700 ST WD,PRIMGDTE-PCEDSECT(,WC) SUBTASK DTE INTO PCE @OZ26939 M4336900 MVI PDEVTYPE+3-PCEDSECT(WC),X'08' PSEUDO 1403 WITHOUT UCS R4 M4337000 TM RWTPPFL,DCTRMFCB TEST FOR 3211 R4 M4337500 BZ NCRDCT5 BR IF NO R4 M4338000 MVI PDEVTYPE+3-PCEDSECT(WC),X'09' PSEUDO 3211 WITHOUT UCS R4 M4338500 B NCRDCT5 BR TO CONTINUE R4 M4339000 SPACE 1 R4 M4339500 NCRDCT4A NI DCTDEVID,255-DCTPRTID CONVERT REMOTE PRINTER ID R4 M4340000 OI DCTDEVID,DCTPUNID TO REMOTE PUNCH ID M4340500 SPACE 1 R4 M4341000 * THIS CARD DELETED BY APAR @OZ29180 M4341500 NCRDCT5 MVC DCTFORMS(12),RWTFORMS SET FORMS, FCB, AND UCS @OZ29180 M4342000 MVC DCTDCPTN(1),RWTDCPTN SET DEFAULT CPT NUMBER R41 M4342100 MVC DCTCKPTL,RWTCKPTL MOVE CKPTLNS VALUE TO DCT @OZ19494 M4342200 MVC DCTCKPTP,RWTCKPTP MOVE CKPTPGS VALUE TO DCT @OZ19494 M4342300 MVC DCTLIMLO,RWTLIMLO SET DEVICE LOWER LIMIT @OZ40627 M4342400 MVC DCTLIMHI,RWTLIMHI SET DEVICE UPPER LIMIT @OZ40627 M4342450 CLI DCTFORMS,0 TEST FOR FORMS ID R4 M4342500 BNE SKIP1130 BR IF PRESENT R4 M4343000 MVC DCTFORMS,$STDFORM ELSE SUPPLY DEFAULT R4 M4343500 SKIP1130 CLI DCTFCB,0 TEST FOR FCB ID R4 M4344000 BNE SKIP1140 BR IF PRESENT R4 M4344500 MVC DCTFCB,$PRTFCB ELSE SUPPLY DEFAULT R4 M4345000 SKIP1140 CLI DCTUCS,0 TEST FOR UCS ID R4 M4345500 BNE NCRDCT5A BR IF PRESENT @OZ19494 M4346000 MVC DCTUCS,$PRTUCS ELSE SUPPLY DEFAULT R4 M4346500 NCRDCT5A MVC DCTPPFL,RWTPPFL SET FLAGS @OZ19494 M4347000 MVC DCTPPSW,RWTPPSW AND @OZ19494 M4347100 SPACE 1 R4 M4347500 NCRDCTCL MVC DCTCLASS(*-*),RWTCLASS SET OUTPUT CLASSES R4 M4348000 LA WC,DCTCLASS(WF) SET CLASS LIST R4 M4348500 MVI 0(WC),C' ' TERMINATOR R4 M4349000 ICM R1,7,DCTCHAIN+1 GET ADDRESS OF NEXT DCT R4 M4349500 LA WB,RWTPPEND GET ADDRESS OF NEXT RWT ELEMENT M4350000 BCT WA,NCRDCT1 BUILD ADDITIONAL PRINT/PUNCH DCT'S M4350500 BR WE AND RETURN WHEN DONE M4351000 SPACE 1 R4 M4351500 DROP R1,WB,WC,WG,R15 KILL ADDRESSABILITY R4 M4352000 TITLE 'HASP INITIALIZATION -- REMOTE DESTINATION TABLE INITIALCM4352500 IZATION' R4 M4353000 *********************************************************************** M4353500 * * M4354000 * COMPLETE REMOTE DESTINATION TABLE INITIALIZATION * M4354500 * * M4355000 * NOTE REGISTER WB DESTROYED BY DESTINATION VERIFICATION ROUTINE * M4355500 * * M4356000 *********************************************************************** M4356500 SPACE 1 R4 M4357000 USING $SVDSECT,WG PROVIDE SSVT ADDRESSABILITY R4 M4357500 SPACE 1 R4 M4358000 NRDT L WG,$SSVT GET SSVT ADDRESS R4 M4358500 LA R1,$SVROUTM+$MAXRJE POINT TO REMOTE MASK TABLE END R4 M4359000 LA R0,$MAXRJE SET NUMBER R4 M4359500 SPACE 1 R4 M4360000 SKIP1160 STC R0,0(,R1) SET REMOTE NUMBER R4 M4360500 BCTR R1,0 REDUCE BY 1 R4 M4361000 BCT R0,SKIP1160 LOOP R4 M4361500 SPACE 1 R4 M4362000 ICM R1,15,$SVRDT POINT TO START OF OLD RDT R4 M4362500 BZ NGETRDT BR IF NONE R4 M4363000 SL R1,=F'8' ELSE BACK UP TO EYE CATCHER R4 M4363500 L R0,4(,R1) FREE R4 M4364000 * THIS LINE DELETED BY APAR @OZ35996 M4364500 FREEMAIN R,LV=(0),A=(1) RDT R4 M4365000 SPACE 1 R4 M4365500 NGETRDT LA WC,$NDQ-(NDQNDQ-NDQ) PREPARE TO SCAN NDQS R4 M4366000 SLR WD,WD ZERO COUNTER R4 M4366500 SPACE 1 R4 M4367000 USING RDTDSECT,WF PROVIDE RDT ADDRESSABILITY R4 M4367500 USING NDQDSECT,WC PROVIDE NDQ ADDRESSABILITY R4 M4368000 SPACE 1 R4 M4368500 NGETRDTL ICM WC,15,NDQNDQ POINT TO NEXT NDQ R4 M4369000 BZ NGETRDTS EXIT IF END R4 M4369500 LA WD,1(,WD) INCREMENT COUNTER R4 M4370000 B NGETRDTL LOOP R4 M4370500 SPACE 1 R4 M4371000 NGETRDTS MH WD,=Y(RDTSIZ) CALCULATE SIZE R4 M4371500 AL WD,=AL1(241,0,0,8) OF RDT. USE CSA SUBPOOL @OZ35996 M4372000 LR R0,WD OBTAIN R4 M4372500 * THIS LINE DELETED BY APAR @OZ35996 M4373000 GETMAIN R,LV=(0) RDT R4 M4373500 MVC 0(4,R1),=CL4'RDT' SET EYE CATCHER R4 M4374000 ST WD,4(,R1) SAVE RDT LENGTH R4 M4374500 ALR WD,R1 POINT TO RDT END R4 M4375000 LA WE,8(,R1) POINT TO RDT R4 M4375500 LR WF,WE COPY R4 M4376000 SH WF,=Y(RDTSIZ) BACK UP ONE R4 M4376500 STM WE,WF,$SVRDT SET START AND END VALUES R4 M4377000 EJECT R4 M4377500 NSETRDT ICM WC,15,$NDQ POINT TO NEXT NDQ R4 M4378000 BZ NFINRDT BR IF NO MORE R4 M4378500 LA WF,RDTSIZ(,WF) POINT TO NEXT RDT R4 M4379000 MVC RDTNAME,NDQNAME COPY NAME R4 M4379500 MVI RDTFLAG,0 ZERO FLAGS R4 M4380000 LA R1,NDQDEST POINT TO NAME R4 M4380500 SLR WA,WA ZERO ANSWER REGISTER R4 M4381000 IC WA,$SVTOSYS GET SYSTEM ID R4 M4382000 LR R11,WG RELOAD SSVT ADDRESS R4 M4384500 L R15,$SVDEST POINT TO DESTINATION VERIFY RTN R4 M4385000 BALR LINK,R15 ENTER IT R4 M4385500 B NFNDQRDT LEAVE DEFAULT ROUTING IF ERR +0 R4 M4386000 STC WA,RDTRMTNO SET REMOTE/UNIT NUMBER +4 R4 M4387000 CLI NDQDEST,C'U' DID USER SAY UNIT... R4 M4392500 BNE NRMTRDT BR IF NO R4 M4393000 MVI RDTFLAG,RDTFLAGU SET TO LOAD NODE ZERO AND UNIT R4 M4393500 B NFNDQRDT FREE THE NDQ R4 M4394000 SPACE 1 R4 M4394500 NRMTRDT CLI RDTRMTNO,0 TEST FOR REMOTE R4 M4395000 BE NFNDQRDT BR IF NO R4 M4395500 OI RDTFLAG,RDTFLAGR SET TO LOAD REMOTE R4 M4396000 SPACE 1 R4 M4396500 NFNDQRDT L BASE1,$SVHCT RESTORE HCT ADDRESS IN BASE1 R4 M4397000 MVC $NDQ,NDQNDQ DE-CHAIN NDQ R4 M4397500 LA R0,NDQSIZ FREE DESTINATION R4 M4398000 ICM R0,8,=AL1(229) QUEUE ELEMENT R4 M4398500 FREEMAIN R,LV=(0),A=(WC) STORAGE R4 M4399000 B NSETRDT LOOP R4 M4399500 SPACE 1 R4 M4400000 NFINRDT ST WF,$SVRDTE SET END OF RDT R4 M4400500 LA R1,$SVROUTM+1 POINT TO REMOTE 1 MASK BYTE R4 M4401000 LH R0,$SVROUT GET NUMBER OF REMOTES R4 M4401500 XC $SVROUTM,$SVROUTM CLEAR REMOTE MASK BYTES R4 M4402000 LTR R0,R0 TEST NUMBER OF REMOTES R4 M4402500 BZ NRJEEND BR OF NONE DEFINED R4 M4404500 L WA,$RATABLE POINT TO 1ST RAT ELEMENT R4 M4405500 SPACE 1 R4 M4406000 NRDTMASK MVC 0(1,R1),RATROUTE+1-RATDSECT(WA) MOVE RAT'S ROUTE CODER4 M4406500 LA WA,RATTLE(,WA) POINT TO NEXT RAT R4 M4407000 LA R1,1(,R1) POINT TO NEXT MASK BYTE R4 M4407500 BCT R0,NRDTMASK LOOP THRU ALL REMOTES R4 M4408000 SPACE 1 R4 M4409000 B NRJEEND EXIT TO NEXT SECTION R4 M4409500 SPACE 1 R4 M4410500 DROP WC,WF KILL NDQ, RDT ADDRESSABILITY R4 M4411000 DROP WG KILL SSVT ADDRESSABILITY R4 M4434500 EJECT R4 M4435000 LTORG DEFINE LITERALS FOR RJE INIT M4435500 SPACE 3 M4436000 NRJEEND NULL END OF RJE INITIALIZATION M4436500 TITLE 'HASP INITIALIZATION -- MISCELLANEOUS INITIALIZATION' M4513500 NWRAPUP BALR BASE2,0 RE-ESTABLISH R4 M4514000 USING *,BASE2 LOCAL ADDRESSABILITY M4514500 SPACE 1 R4 M4515000 *********************************************************************** M4515500 * * M4516000 * INITIALIZE COMMAND PROCESSOR EXTENDED AREA * M4516500 * * M4517000 *********************************************************************** M4517500 SPACE 1 R4 M4518000 L WA,CVTPTR POINT TO CVT M4518500 L WA,CVTCUCB-CVT(,WA) THEN TO UCM M4519000 LM WD,WF,UCMVEA-UCM(WA) PICK UP FIRST, LENGTH, LAST UCME M4519500 LR R1,WF COPY LAST M4520000 ALR R1,WE UP TO BEYOND M4520500 SLR R0,R0 ZERO HIGH PART M4521000 SLR R1,WD GET LENGTH OF ALL UCMES M4521500 DR R0,WE GET NUMBER OF OS CONSOLES M4522000 LR WD,R1 COPY FOR BUILDER M4522500 MH R1,=Y(COMCONL) GET LENGTH OF REDIRECTION ELEMENTS M4523000 LA R0,COMRESP-COMDSECT(0,R1) SET LENGTH OF AREA M4523500 LR WF,R0 COPY FOR BUILDER M4524000 GETMAIN R,LV=(0) GET STORAGE FOR EXTENDED AREA M4524500 LR WE,R1 COPY M4525000 LR R0,R1 COPY ORG M4525500 LR R1,WF COPY LENGTH M4526000 SLR WB,WB ZERO SOURCE LENGTH M4526500 MVCL R0,WA CLEAR WORK AREA M4527000 L R1,$COMMPCE POINT TO COMMAND PROCESSOR PCE R4 M4527500 ST WE,COMEXTEN-PCEDSECT(,R1) SET POINTER M4528000 STH WD,COMCONNO-PCEDSECT(,R1) SET NUMBER OF CONSOLES M4528500 USING COMDSECT,WE M4529000 STH WD,COMOCON SET NUMBER OF CONSOLES M4529500 MVC COMLCON,=Y(COMCONL) SET LENGTH OF GROUP OF ELEMENTS M4530000 LA R1,1 SET FIRST CONSOLE ID M4530500 LA WA,COMRESP POINT TO FIRST ELEMENT M4531000 SPACE 1 R4 M4531500 ICOMXL LA R0,COMCONL/2 SET NUMBER OF ELEMENTS/GROUP M4532000 SPACE 1 R4 M4532500 ICOMXLA STC R1,COMCON(,WA) STORE CONSOLE IN ELEMENT M4533000 LA WA,2(,WA) UP TO NEXT ELEMENT M4533500 BCT R0,ICOMXLA LOOP FOR ALL ELEMENTS IN GROUP M4534000 SPACE 1 R4 M4534500 LA R1,1(,R1) UP TO NEXT CONSOLE M4535000 BCT WD,ICOMXL LOOP FOR ALL CONSOLES M4535500 SPACE 1 R4 M4536000 L WG,$HASPMAP POINT TO HASP MODULE MAP R4 M4536500 SPACE 1 R4 M4537000 USING MAPDSECT,WG PROVIDE MOD MAP ADDRESSABILITY R4 M4537500 EJECT R4 M4538000 LOAD EP=IEE7603D LOCATE VERIFICATION MODULE M4538500 ST R0,COMVERIF SET ENTRY TO VERIFICATION ROUTINE M4539000 DROP WE M4539500 DELETE EP=IEE7603D DELETE VERIFICATION MODULE R4 M4540000 LA WA,$WTOPECB POINT TO TERMINATION ECB M4540500 LA WD,NHASPBR1 ADDRESS OF DUMMY TASK M4541000 L WE,MAPWTOA POINT TO $HASPWTO ENTRY POINT R4 M4541500 BAL WF,NATTACH ATTACH WTO SUBTASK R4 M4542000 ST WE,$WTOTCBA SET TCB ADDRESS FOR WITHDRAW R4 M4542500 * LOAD HASP SMF USER EXITS INTO MEMORY, IF THEY EXIST M4543000 L WF,$SSVT ADDRESS OF SSVT M4543500 USING SSVT,WF SSVT ADDRESSABILITY M4544000 LOAD EP=IEFUSO,ERRET=NUSOBAD LOAD USO IF IT EXISTS M4544500 ST R0,$SVSMFSO PUT ADDR. INTO SSVT SLOT M4545000 DELETE EP=IEFUSO DELETE USO R4 M4545500 SPACE 1 R4 M4546000 NUSOBAD CLI $NUMSMFB,2 TEST SMF OPTION R4 M4546500 BL NOSMF BR IF NOT SELECTED R4 M4547000 LOAD EP=IEFUJP,ERRET=NUJPEXIT LOAD UJP IF POSSIBLE M4547500 ST R0,$SVSMFJP PUT ADDR. INTO SSVT SLOT M4548000 DELETE EP=IEFUJP DELETE UJP R4 M4548500 EJECT R4 M4549000 NUJPEXIT NULL M4549500 LA WD,NSMFNAM POINT TO HASPSMF NAME M4550000 L WE,MAPACCTA POINT TO HASPSMF ENTRY POINT R4 M4550500 LA WA,$PSMFECB POINT TO TERMINATION ECB R4 M4551000 BAL WF,NATTACH ATTACH ACCOUNTING SUBTASK R4 M4551500 ST WE,$SMFTCBA SET TCB ADDRESS FOR WITHDRAW R4 M4552000 USING SMFDSECT,R1 M4552500 $GETSMFB WAIT=YES GET SMF BUFFER FOR RECORD TYPE 43 M4553000 MVI SMFRDW+1,SMF43END-SMFRDW LENGTH OF START HASP SMF M4553500 MVI SMFHDRTY,SMFSSSTP START HASP SUBSYSTEM SMF RECORD TYPE M4554000 MVC SMFSSID,NSMFHASP PUT HASP SUBSYSTEM ID IN RECORD 4 M4554500 MVI SMFSSLEN+1,SMF43END-SMF43RV1 LENGTH OF SUBSYSTEM PART M4555000 MVC SMF43OPT,$OPTSTAT HASP OPTIONS M4555500 $QUESMFB WRITE RECORD TYPE 43 M4556000 DROP R1,WF KILL SMF, SSVT ADDRESSABILITY R4 M4556500 SPACE 1 R4 M4557000 NOSMF NULL R4 M4557500 LA WD,NIMGNAM POINT TO HASPIMAG NAME M4558000 L WE,MAPIMAGA POINT TO HASPIMAG ENTRY POINT R4 M4558500 LA WA,$PIMGECB POINT TO TERMINATION ECB R4 M4559000 BAL WF,NATTACH ATTACH IMAGE LOADER SUBTASK R4 M4559500 STCM WE,7,$IMAGTCB+1 SET TCB ADDR FOR WITHDRAW @OZ39950 M4560000 TM $IMAGTCB,X'40' DID SYS1.IMAGELIB OPEN... @OZ53418 M4560010 BO NTOPEN BR IF NO @OZ53418 M4560020 SPACE 1 @OZ20685 M4560100 NIMAGE NI $IMAGTCB,FF-X'40' RESET ERROR INDICATOR @OZ53418 M4560150 LA WD,NALOCNAM PT TO HOSALLOC NAME @OZ20685 M4560200 L WE,MAPALOCA PT TO HOSALLOC E. P. @OZ20685 M4560300 LA WA,$PDYNECB PT TO TERMINATION ECB @OZ20685 M4560400 BAL WF,NATTACH ATTACH ALLOCATION TASK @OZ20685 M4560500 ST WE,$DYNTCBA SET TCB ADDRESS @OZ20685 M4560600 SPACE 3 R4 M4561000 L WD,NLOGLINE PICK UP NO. OF VTAM LOGICAL LINES R4 M4561500 LTR WD,WD TEST FOR NONE SPECIFIED R4 M4562000 BZ NIRBUILD BR IF NONE TO NEXT SECTION R4 M4562500 LA WA,$PSNAECB GET ADDR OF TERMINATION ECB R4 M4563000 LA WD,NVTAMNAM PICK UP VTAM SUBTASK NAME TO BE R4 M4563500 L WE,MAPVTAMA ASSOC. WITH ENTRY POINT ADDR R4 M4564000 BAL WF,NATTACH ATTACH VTAM API SUBTASK R4 M4564500 ST WE,$SNATCBA SET TCB ADDRESS FOR WITHDRAW R4 M4565000 B NIRBUILD THEN BR TO NEXT SECTION R4 M4566000 SPACE 1 @OZ53418 M4566025 DROP WG DROP MOD MAP ADDRESSABILITY @OZ53418 M4566050 EJECT @OZ53418 M4566075 ************************************************************* @OZ53418 M4566100 * * @OZ53418 M4566125 * SYS1.IMAGELIB FAILED TO OPEN WHEN SUBTASK WAS ATTACHED * @OZ53418 M4566150 * * @OZ53418 M4566175 * QUERY OPERATOR AS TO WHAT ACTION SHOULD BE TAKEN: * @OZ53418 M4566200 * Y = CONTINUE TO BRING UP JES2 - PRINTERS FAIL * @OZ53418 M4566225 * N = END INITIALIZATION - MUST RESTART JES2 * @OZ53418 M4566250 * R = RE-TRY ATTACH TO SEE IF OPEN IS SUCCESSFUL * @OZ53418 M4566275 * * @OZ53418 M4566300 ************************************************************* @OZ53418 M4566325 SPACE 1 @OZ53418 M4566350 NTOPEN $$WTO NOPNMSG ISSUE WARNING MESSAGE @OZ53418 M4566375 SPACE 1 @OZ53418 M4566400 NQREPT MVI NOPNWK,0 CLEAR REPLY AREA @OZ53418 M4566425 MVI NOPNECB,0 CLEAR ECB @OZ53418 M4566450 $$WTOR NQUERY QUERY OPERATOR @OZ53418 M4566475 WAIT ECB=NOPNECB WAIT FOR RESPONSE @OZ53418 M4566500 OI NOPNWK,X'40' FORCE UPPER CASE RESPONSE @OZ53418 M4566525 CLI NOPNWK,C'Y' TEST REPLY @OZ53418 M4566550 BE NIMAGE BR IF 'Y' (CONTINUE JES2) @OZ53418 M4566575 CLI NOPNWK,C'R' TEST REPLY @OZ53418 M4566600 BE NQRETRY BR IF 'R' (RETRY OPEN) @OZ53418 M4566625 CLI NOPNWK,C'N' TEST REPLY @OZ53418 M4566650 BNE NQREPT BR TO RE-QUERY @OZ53418 M4566675 $EXIT NGQUITM EXIT JES2 IF REPLY IS 'N' @OZ53418 M4566700 SPACE 1 @OZ53418 M4566725 NQRETRY POST $IMAGECB POST FOR WORK (WILL TERM.) @OZ53418 M4566750 SPACE 1 @OZ53418 M4566775 WAIT ECB=$PIMGECB WAIT FOR IMAGE TO TERM. @OZ53418 M4566800 EJECT @OZ53418 M4566825 DETACH $IMAGTCB DETACH IMAGE SUBTASK @OZ53418 M4566850 SPACE 1 @OZ53418 M4566875 XC $IMAGTCB(12),$IMAGTCB CLEAR IMAGE TASK DTE @OZ53418 M4566900 B NOSMF RETRY OPEN OF IMAGELIB @OZ53418 M4566925 SPACE 3 @OZ53418 M4566950 $MID 871 SET MESSAGE NUMBER @OZ53418 M4566975 NOPNMSG WTO '&MID.WARNING - SYS1.IMAGELIB FAILED TO OPEN', @OZ53418*M4567000 MF=L @OZ53418 M4567025 SPACE 2 @OZ53418 M4567050 $MID 872 SET MESSAGE NUMBER @OZ53418 M4567075 NQUERY WTOR '&MID.REPLY Y OR N OR R TO CONTINUE JES2', @OZ53418*M4567100 NOPNWK,1,NOPNECB,MF=L @OZ53418 M4567125 SPACE 2 @OZ53418 M4567150 NOPNWK DC D'0' @OZ53418 M4567175 NOPNECB DC F'0' @OZ53418 M4567200 EJECT @OZ53418 M4567500 NATTACH IDENTIFY EPLOC=(WD),ENTRY=(WE) IDENTIFY SUBTASK CODE R4 M4568000 LR R1,BASE1 GIVE HCT ADDRESS TO SUBTASK R4 M4568500 CLC NIMGNAM,0(WD) CHECK FOR HASPIMAG ATTACH @OZ26939 M4568600 BNE *+8 BR IF NO, BYPASS DTE LOAD @OZ26939 M4568700 LA R1,$IMAGTCB LOAD ADDRESS OF IMAGE TCB @OZ26939 M4568800 ATTACH EPLOC=(WD),SM=SUPV,ECB=(WA) ATTACH SUBTASK R4 M4569000 LR WE,R1 SAVE TCB ADDRESS R4 M4569500 WAIT ECB=(WA) WAIT FOR SUBTASK TO ENTER R4 M4570000 OC 1(3,WA),1(WA) TEST ATTACH R4 M4570500 BNZ NEWTO BR IF UNSUCCESSFUL R4 M4571000 MVI 0(WA),0 ELSE RESET TERMINATION ECB R4 M4571500 BR WF AND RETURN R4 M4572000 SPACE 1 R4 M4572500 NEWTO L R1,=A(NEWTOM) POINT TO MESSAGE R4 M4573000 UNPK NEWTOV-NEWTOM(7,R1),1(4,WA) SPREAD DIGITS R4 M4573500 TR NEWTOV-NEWTOM(,R1),NEWTOT MAKE PRINTABLE R4 M4574000 MVC NEWTON-NEWTOM(,R1),0(WD) SET MODULE NAME R4 M4574500 $$WTO (R1) ISSUE WARNING MESSAGE TO OPERATOR R4 M4575000 BR WF THEN RETURN R4 M4575500 EJECT R4 M4576000 NEWTOT EQU *-C'0' M4576500 DC C'0123456789ABCDEF' M4577000 NHASPBR1 DC CL8'HASPWTO' HASP WTO TASK NAME M4577500 NSMFNAM DC CL8'HASPACCT' HASPACCT MODULE NAME M4578000 NIMGNAM DC CL8'HASPIMAG' MODULE NAME FOR HASPIMAG M4578500 NVTAMNAM DC CL8'HASPVTAM' HASP VTAM API SUBTASK NAME R4 M4579500 NALOCNAM DC CL8'HOSALLOC' ALLOCATION MODULE NAME @OZ20685 M4580000 NSMFHASP DC AL2(SMFHSPID) SMF SUBSYSTEM ID FOR HASP M4580500 SPACE 3 M4581000 LTORG DEFINE LITERALS FOR MISC INIT M4581500 TITLE 'HASP INITIALIZATION -- INTERNAL READER BUILD' M4582000 *********************************************************************** M4582500 * * M4583000 * (RE-)INITIALIZE INTERNAL READER DCTS * M4583500 * * M4584000 *********************************************************************** M4584500 SPACE 1 R4 M4585000 NIRBUILD BALR BASE2,0 RE-ESTABLISH M4585500 USING *,BASE2 LOCAL ADDRESSABILITY. M4586000 USING $SVDSECT,R7 PROVIDE SSVT ADDRESSABILITY R4 M4586500 SPACE 1 R4 M4587000 L R7,$SSVT POINT TO SSVT R4 M4587500 SLR R3,R3 GET COUNT OF JOB R4 M4588000 IC R3,$NUMINRS INTERNAL READERS R4 M4588500 L R2,$SVIRDRS TEST FOR EXISTING @OZ35996 M4589000 LTR R2,R2 INTERNAL READERS @OZ35996 M4589500 BZ NIRSETUP BR IF NO @OZ35996 M4590000 SPACE 1 R4 M4590500 PUSH PRINT - SECTION @OZ35996 M4591000 PRINT OFF - DELETED @OZ35996 M4591500 * THIS LINE DELETED BY APAR @OZ35996 M4592000 * THIS LINE DELETED BY APAR @OZ35996 M4592500 * THIS LINE DELETED BY APAR @OZ35996 M4593000 * THIS LINE DELETED BY APAR @OZ35996 M4593500 * THIS LINE DELETED BY APAR @OZ35996 M4594000 * THIS LINE DELETED BY APAR @OZ35996 M4594500 * THIS LINE DELETED BY APAR @OZ35996 M4595000 * THIS LINE DELETED BY APAR @OZ35996 M4595500 * THIS LINE DELETED BY APAR @OZ35996 M4596000 POP PRINT - SECTION DELETED @OZ35996 M4596500 *********************************************************************** M4597000 * * M4597500 * JES2 RESTART -- RE-USE EXISTING INTERNAL READER DCTS * M4598000 * * M4598500 *********************************************************************** M4599000 SPACE 1 R4 M4599500 BAL WE,NIRREGS SET UP REGS FOR DCT RESET R4 M4600000 STCM R2,7,DCTCHAIN+1-DCTDSECT(R3) ADD INR DCTS TO DCT CHN R4 M4600500 SPACE 1 R4 M4601000 USING DCTDSECT,R2 PROVIDE DCT ADDRESSABILITY R4 M4601500 SPACE 1 R4 M4602000 NIRRESET LR R3,R2 SAVE CURRENT DCT ADDRESS R4 M4602500 ST R2,PCEDCT-PCEDSECT(,R4) SET DCT ADDR IN PCE @OZ32566 M4603000 ST R4,DCTEWF SET PCE ADDRESS IN DCT R4 M4603500 NI DCTSTAT,255-DCTINUSE RESET DCT IN-USE STATUS R4 M4604000 ICM R2,7,DCTCHAIN+1 POINT TO NEXT DCT R4 M4604500 L R4,PCENEXT-PCEDSECT(,R4) POINT TO NEXT PCE R4 M4605000 BCT R0,NIRRESET LOOP THRU ALL INTERNAL RDR DCTS R4 M4605500 SPACE 1 R4 M4606000 STCM R0,7,DCTCHAIN+1-DCTDSECT(R3) TERMINATE DCT CHAIN R4 M4606500 B NXEQDCT BR TO SET REQUEST-JOB-ID DCT R4 M4607000 PUSH PRINT - SECTION @OZ35996 M4607500 PRINT OFF - DELETED @OZ35996 M4608000 * THIS LINE DELETED BY APAR @OZ35996 M4608500 * THIS LINE DELETED BY APAR @OZ35996 M4609000 * THIS LINE DELETED BY APAR @OZ35996 M4609500 * THIS LINE DELETED BY APAR @OZ35996 M4610000 * THIS LINE DELETED BY APAR @OZ35996 M4610500 * THIS LINE DELETED BY APAR @OZ35996 M4611000 * THIS LINE DELETED BY APAR @OZ35996 M4611500 * THIS LINE DELETED BY APAR @OZ35996 M4612000 * THIS LINE DELETED BY APAR @OZ35996 M4612500 * THIS LINE DELETED BY APAR @OZ35996 M4613000 * THIS LINE DELETED BY APAR @OZ35996 M4613500 * THIS LINE DELETED BY APAR @OZ35996 M4614000 * THIS LINE DELETED BY APAR @OZ35996 M4614500 * THIS LINE DELETED BY APAR @OZ35996 M4615000 * THIS LINE DELETED BY APAR @OZ35996 M4615500 * THIS LINE DELETED BY APAR @OZ35996 M4616000 * THIS LINE DELETED BY APAR @OZ35996 M4616500 * THIS LINE DELETED BY APAR @OZ35996 M4617000 * THIS LINE DELETED BY APAR @OZ35996 M4617500 * THIS LINE DELETED BY APAR @OZ35996 M4618000 * THIS LINE DELETED BY APAR @OZ35996 M4618500 * THIS LINE DELETED BY APAR @OZ35996 M4619000 * THIS LINE DELETED BY APAR @OZ35996 M4619500 * THIS LINE DELETED BY APAR @OZ35996 M4620000 * THIS LINE DELETED BY APAR @OZ35996 M4620500 * THIS LINE DELETED BY APAR @OZ35996 M4621000 * THIS LINE DELETED BY APAR @OZ35996 M4621500 * THIS LINE DELETED BY APAR @OZ35996 M4622000 * THIS LINE DELETED BY APAR @OZ35996 M4622500 * THIS LINE DELETED BY APAR @OZ35996 M4623000 * THIS LINE DELETED BY APAR @OZ35996 M4623500 POP PRINT - SECTION DELETED @OZ35996 M4624000 EJECT @OZ35996 M4624500 NIRSETUP LA R0,2(,R3) GET JOB+STC+TSU INTRDR CNT @OZ35996 M4625000 MH R0,=Y(RIDCTEND-DCTDSECT) INR DCT STORAGE REQ'T @OZ35996 M4625500 AL R0,NINRMASK ADD PREFIX SP/LENGTH @OZ35996 M4626000 LR R2,R0 SAVE SP/LENGTH @OZ35996 M4626500 GETMAIN R,LV=(0) GET CSA FOR INTRDR DCTS @OZ35996 M4627000 MVC 0(4,R1),=C'IDCT' SET EYE-CATCHER IN PREFIX @OZ35996 M4627500 ST R2,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M4628000 LA R2,8(,R1) POINT PAST PREFIX @OZ35996 M4628500 BAL WE,NIRREGS SET UP REGS FOR DCT BUILD @OZ35996 M4629000 SPACE 1 @OZ35996 M4629500 NIRINIT MVC 0(RIDCTEND-DCTDSECT,R2),NINRDCT BUILD BASE DCT @OZ35996 M4630000 BAL LINK,NINRINIT COMPLETE DCT INITIALIZATION @OZ35996 M4630500 B NIRINIT LOOP THRU ALL DCTS, EXIT @OZ35996CM4631000 WILL BE FROM NINRINIT @OZ35996 M4631500 EJECT @OZ35996 M4632000 ***************************************************************@OZ35996 M4632500 * @OZ35996 M4633000 * NIRREGS -- SET UP REGISTERS FOR INTRDR DCT (RE)BUILD @OZ35996 M4633500 * @OZ35996 M4634000 * INPUT R2 - ADDRESS OF 1ST INTERNAL READER DCT @OZ35996 M4634500 * R3 - COUNT OF JOB INTERNAL READERS @OZ35996 M4635000 * @OZ35996 M4635500 * OUTPUT R0 - COUNT OF TOTAL INTERNAL READERS @OZ35996 M4636000 * R3 - ADDRESS OF LAST DCT ON CURRENT DCT CHAIN @OZ35996 M4636500 * R4 - ADDRESS OF 1ST INTERNAL READER PCE @OZ35996 M4637000 * WE - RETURN ADDRESS @OZ35996 M4637500 * @OZ35996 M4638000 ***************************************************************@OZ35996 M4638500 SPACE 1 R4 M4639000 NIRREGS LA R3,1(,R3) SAVE COUNT R4 M4639500 ST R3,NINRDCTS OF DCTS + 1 R4 M4640000 LA R0,1(,R3) SET NEW DCT COUNT R4 M4640500 STH R0,$SVNINRS SAVE &NUMINRS+2 IN SSVT @OZ35996 M4641000 * THIS LINE DELETED BY APAR @OZ35996 M4641500 ST R2,$SVIRDRS SET POINTER IN SSVT R4 M4642000 ST R2,$INRDCT AND IN HCT R4 M4642500 LA R4,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M4643000 SPACE 1 R4 M4643500 SKIP1250 LR R3,R4 LOCATE END R4 M4644000 ICM R4,7,DCTCHAIN+1-DCTDSECT(R4) OF CURRENT R4 M4644500 BNZ SKIP1250 DCT CHAIN R4 M4645000 SPACE 1 R4 M4645500 LA R4,$PCEORG-(PCENEXT-PCEDSECT) PREPARE TO SCAN PCES R4 M4646000 SPACE 1 R4 M4646500 SKIP1260 L R4,PCENEXT-PCEDSECT(,R4) LOCATE 1ST R4 M4647000 CLI PCEID-PCEDSECT(R4),PCEINRID INTERNAL R4 M4647500 BNE SKIP1260 RDR PCE R4 M4648000 SPACE 1 R4 M4648500 BR WE RETURN TO CALLER R4 M4649000 EJECT R4 M4649500 *********************************************************************** M4650000 * * M4650500 * NINRINIT -- FINISH BUILDING A DCT * M4651000 * * M4651500 * R0 - COUNT OF REMAINING DCTS, DECREMENTED ON RETURN * M4652000 * R2 - ADDR OF CURRENT DCT, UPDATED ON RETURN * M4652500 * R3 - ADDR OF PREVIOUS DCT, UPDATED ON RETURN * M4653000 * R4 - ADDR OF CURRENT PCE, UPDATED ON RETURN * M4653500 * LINK - RETURN ADDRESS * M4654000 * * M4654500 *********************************************************************** M4655000 SPACE 1 R4 M4655500 NINRINIT STCM R2,7,DCTCHAIN+1-DCTDSECT(R3) SET DCT CHAIN ADDRESS R4 M4656000 ST R2,PCEDCT-PCEDSECT(,R4) SET DCT ADDRESS IN PCE @OZ32566 M4656500 ST R4,DCTEWF SET $POST ADDRESS R4 M4657000 LA R5,RIDECB SET ADDRESS OF M4657500 ST R5,RIDECBP INTERNAL READER ECB M4658000 LA R5,RIDEOME SET ADDRESS OF @OZ37382 M4658100 ST R5,RIDEOMP EOM ECB @OZ37382 M4658200 MVC DCTSYS,$OWNSYS SET SYSTEM ID R4 M4659000 CL R0,NINRDCTS TEST R4 M4661000 BL NIRINIT2 BRANCH IF NORMAL INTERNAL READER M4661500 MVC DCTROUTE(2),=XL4'00' RESET ROUTE CODE/OPERATOR FLGS R41 M4662000 MVC DCTDEVN,=CL8'STCINRDR' SET STC INRDR DEVICE NAME M4662500 MVC DCTSIAFF,$SIDAFF FORCE INPUT CPU AFFINITY M4663000 MVC DCTPRINT(4),=XL4'00' RESET PRINT AND PUNCH DESTINATIONS M4663500 MVC DCTPRSYS,$OWNSYS TO LOCAL PRINTERS R4 M4664500 MVC DCTPUSYS,$OWNSYS AND PUNCHES R4 M4665000 MVC DCTPRINC(2),=XL2'0F0F' SET PRIORITY FIELDS M4668000 MVI DCTRAUTH,0 RESET COMMAND AUTHORIZATION M4668500 BE NIRINIT1 BRANCH IF LOGON INTERNAL READER M4669000 MVI DCTJCLAS,CATSTCCL SET STC JOB CLASS M4669500 NSTCMCLS EQU *+1,1 STC MSGCLASS M4670000 MVI DCTMCLAS,C'A' SET STC MSGCLASS M4670500 MVC RIDJOBID(3),DCTDEVN RESET JOBID HEADER M4671000 B NIRINIT2 GET NEXT INTERNAL READER M4671500 SPACE 1 R4 M4672000 NIRINIT1 MVC DCTDEVN(3),=CL3'TSO' RESET DEVICE NAME HEADER M4672500 MVI DCTJCLAS,CATTSUCL SET TSU JOB CLASS M4673000 NTSUMCLS EQU *+1,1 TSU MSGCLASS M4673500 MVI DCTMCLAS,C'A' SET TSU MSGCLASS M4674000 L R5,CVTPTR GET ADDRESS OF CVT R4 M4674500 L R5,CVTSMCA-CVT(,R5) GET ADDRESS OF SMCA R4 M4675000 MVC DCTINDC,SMCAFOPT-SMCA(R5) SET FOREGROUND SMF OPTIONS R4 M4675500 MVC RIDJOBID(3),=CL3'TSU' RESET JOBID HEADER M4676000 SPACE 1 R4 M4676500 NIRINIT2 LR R3,R2 SAVE DCT ADDRESS M4677000 LA R2,RIDCTEND GET ADDRESS OF NEXT INTRDR DCT M4677500 L R4,PCENEXT-PCEDSECT(,R4) AND OF NEXT INTRDR PCE R4 M4678000 BCTR R0,LINK RETURN IF ANOTHER DCT R4 M4678500 SPACE 1 R4 M4679000 STCM R0,7,DCTCHAIN+1-DCTDSECT(R3) TERMINATE DCT CHAIN M4679500 TITLE 'HASP INITIALIZATION -- REQUEST JOB DCT INITIALIZATION' M4680000 SPACE 1 R4 M4680500 *********************************************************************** M4681000 * * M4681500 * CREATE REQUEST-JOB-ID DCT * M4682000 * * M4682500 *********************************************************************** M4683000 SPACE 1 R4 M4683500 NXEQDCT LA WB,DCTRDEND-DCTDSECT SPACE NEEDED FOR RDR DCT R4 M4684000 SPACE 1 R4 M4684500 GETMAIN R,LV=(WB) GET STORAGE FOR DCT R4 M4685000 SPACE 1 R4 M4685500 SLR R5,R5 SETUP R4 M4686000 LR R2,R1 FOR MVCL R4 M4686500 MVCL R2,R4 TO CLEAR AREA R4 M4687000 SPACE 1 R4 M4687500 ST R1,$XEQDCT STORE DCT ADDRESS IN HCT R4 M4688000 LR R2,R1 RELOAD DCT BASE REGISTER R4 M4688500 SPACE 1 R4 M4689000 MVI DCTDEVTP,DCTRDR USE READER DEVICE TYPE R4 M4689500 MVC DCTDEVN,=CL8'STCJOBID' SET DEVICE NAME IN DCT R4 M4690000 MVI DCTDEVID,DCTRDRID SET READER DEVICE ID R4 M4690500 MVC DCTSIAFF,$SIDAFF SET AFFINITY FOR THIS SYSTEM R4 M4691000 MVI DCTJCLAS,CATSTCCL USE STC CLASS FOR REQUEST JOBID R4 M4691500 MVI DCTMCLAS,C'A' AND MSGCLASS = A R4 M4692000 MVI DCTPRLIM,15 LIMIT PRIORITY IS 15 R4 M4692500 L WC,CVTPTR GET CVT ADDRESS R4 M4693000 L WC,CVTSMCA-CVTDSECT(,WC) GET SMCA ADDRESS FROM CVT R4 M4693500 MVC DCTINDC,SMCAOPT-SMCA(WC) SET BACKGROUND SMF OPTIONS R4 M4694000 MVC DCTPRSYS,$OWNSYS SET PRINT AND PUNCH R4 M4695000 MVC DCTPUSYS,$OWNSYS ROUTING DESTINATIONS R4 M4695500 B NINEXT PROCEED TO NEXT FUNCTION M4699500 SPACE 1 R4 M4700000 DROP R2 KILL DCT ADDRESSABILITY R4 M4700500 SPACE 5 R4 M4701000 NINRDCTS DS F DCTS + 1 R4 M4701500 NINRMASK DC 0F'0',AL1(241),AL3(8) SUBPOOL AND PREFIX R4 M4702000 SPACE 2 R4 M4702500 NINRDCT DC (RIDCTEND-DCTDSECT)X'00' INTERNAL READER MODEL DCT R4 M4703000 TITLE 'HASP INITIALIZATION -- FINAL SECTION' M4703500 * THIS LINE DELETED BY APAR @OZ35996 M4704000 * THIS LINE DELETED BY APAR @OZ35996 M4704500 NINEXT TM $SVHASP,X'80' TEST JES2 STATUS @OZ35996 M4705000 BO NPCEADDR BR IF RESTARTING R4 M4705500 SPACE 1 R4 M4706000 *********************************************************************** M4706500 * * M4707000 * MOVE DIRECT ACCESS DCB TO SSVT * M4707500 * * M4708000 *********************************************************************** M4708500 SPACE 1 R4 M4709000 LA R2,$SVDCB+40 POINT TO $SVDCB + PREFIX @OZ35996 M4709500 LA R3,12 MOVE R4 M4710000 L R4,$HASPDCB DA R4 M4710500 LR R5,R3 DCB R4 M4711000 LA R4,40(,R4) TO R4 M4711500 MVCL R2,R4 SSVT R4 M4712000 PUSH PRINT - SECTION @OZ35996 M4712500 PRINT OFF - DELETED @OZ35996 M4713000 * THIS LINE DELETED BY APAR @OZ35996 M4713500 * THIS LINE DELETED BY APAR @OZ35996 M4714000 * THIS LINE DELETED BY APAR @OZ35996 M4714500 * THIS LINE DELETED BY APAR @OZ35996 M4715000 * THIS LINE DELETED BY APAR @OZ35996 M4715500 POP PRINT - SECTION DELETED @OZ35996 M4716000 SPACE 1 @OZ35996 M4716500 *********************************************************************** M4717000 * * M4717500 * OBTAIN CSA STORAGE FOR DA DEB, TEDS, AND TGBS * M4718000 * * M4718500 *********************************************************************** M4719000 SPACE 1 R4 M4719500 IC R3,$NUMDA GET @OZ35996 M4720000 LA R3,2(,R3) LENGTH @OZ27300 M4720500 SLL R3,4 OF R4 M4721000 LA R3,32(,R3) DEB R4 M4721500 IC R5,$NUMDA ADD R4 M4722000 MH R5,=Y(TEDSIZ) TED R4 M4722500 LA R5,7(R3,R5) STORAGE R4 M4723000 N R5,=F'-8' AND ROUND TO DOUBLE-WORD R4 M4723500 SLR R3,R3 ADD R4 M4724000 IC R3,$NUMTGBE STORAGE R4 M4724500 MH R3,=Y(TGBSIZE) FOR R4 M4725000 LA R5,8(R3,R5) TGBS AND PREFIX R4 M4725500 ICM R5,8,=AL1(241) USE CSA SUBPOOL @OZ35996 M4726000 LR R0,R5 COPY SP/LENGTH @OZ35996 M4726500 GETMAIN R,LV=(0) GET STORAGE IN CSA R4 M4727000 LR R2,R1 CLEAR R4 M4727500 LA R3,0(,R5) STORAGE @OZ35996 M4728000 SLR R15,R15 FOR DEB, R4 M4728500 MVCL R2,R14 TEDS, AND TGBS R4 M4729000 MVC 0(4,R1),=C'$DEB' SET EYE-CATCHER IN PREFIX @OZ35996 M4729200 ST R5,4(,R1) SET SP/LENGTH IN PREFIX @OZ35996 M4729500 LA R2,8(,R1) STEP OVER PREFIX R4 M4730000 ST R2,$SVDEB SET POINTER TO DA DEB R4 M4730500 EJECT R4 M4731000 *********************************************************************** M4731500 * * M4732000 * MOVE DIRECT ACCESS DEB TO CSA * M4732500 * * M4733000 *********************************************************************** M4733500 SPACE 1 R4 M4734000 IC R3,$NUMDA GET R4 M4734500 LA R3,2(,R3) LENGTH @OZ27300 M4735000 SLL R3,4 OF R4 M4735500 LA R3,32(,R3) DEB R4 M4736000 L R4,$DADEBAD MOVE R4 M4736500 LR R5,R3 DA DEB R4 M4737000 MVCL R2,R4 TO CSA R4 M4737500 SPACE 1 R4 M4738000 *********************************************************************** M4738500 * * M4739000 * MOVE TED TO CSA, SET TGB POINTERS * M4739500 * * M4740000 *********************************************************************** M4740500 SPACE 1 R4 M4741000 ST R2,$SVTED SET POINTER TO FINAL TEDS R4 M4741500 ST R2,$SVTFRST SET POINTER TO FIRST TED R4 M4742000 ST R2,$SVTNEXT SET POINTER TO NEXT TED R4 M4742500 LA R1,TEDSIZ GET SIZE OF INDIVIDUAL TED R4 M4743000 IC R5,$NUMDA MOVE R4 M4743500 MR R4,R1 HASP R4 M4744000 L R4,TEDSTART TED R4 M4744500 LR R3,R5 TO R4 M4745000 MVCL R2,R4 CSA R4 M4745500 SLR R2,R1 SET POINTER TO R4 M4746000 ST R2,$SVTLAST LAST TED R4 M4746500 LA R2,7(R1,R2) SET POINTER R4 M4747000 N R2,=F'-8' TO FIRST R4 M4747500 ST R2,$SVTTGBA TRACK GROUP BLOCK R4 M4748000 LA R1,TGBSIZE SET SIZE R4 M4748500 ST R1,$SVTTGBA+4 OF TRACK GROUP BLOCK R4 M4749000 IC R5,$NUMTGBE SET R4 M4749500 BCTR R5,0 POINTER R4 M4750000 MR R4,R1 TO R4 M4750500 ALR R2,R5 LAST R4 M4751000 ST R2,$SVTTGBA+8 TGB R4 M4751500 EJECT R4 M4752000 *********************************************************************** M4752500 * * M4753000 * SET PCE ADDRESS IN ALL DCTS * M4753500 * * M4754000 *********************************************************************** M4754500 SPACE 1 R4 M4755000 NPCEADDR LA WA,$DCTPOOL-(DCTCHAIN-DCTDSECT) PREPARE TO SCAN DCTS R4 M4755500 SPACE 1 R4 M4756000 USING DCTDSECT,WA PROVIDE DCT ADDRESSABILITY R4 M4756500 SPACE 1 R4 M4757000 NEXTDCT ICM WA,7,DCTCHAIN+1 POINT TO NEXT DCT R4 M4757500 BZ NDECHAIN BR IF NO MORE DCTS R4 M4758000 MVC DCTPCE+1(3),DCTEWF+1 ELSE PROVIDE PCE ADDRESS R4 M4758500 XC DCTBUFAD,DCTBUFAD CLEAR OUT EBCDIC DEVICE NAME R4 M4759000 CLI DCTDEVTP,DCTLOG TEST DEVICE TYPE R4 M4760000 BE NPCELOG HANDLE IF LOGON DCT R4 M4760500 SKIP1280 CLI DCTDEVTP,DCTLNE TEST DEVICE TYPE R4 M4764500 BNE NEXTDCT LOOP IF NOT LINE R4 M4765000 XC MDCTOBUF,MDCTOBUF ELSE CLEAR BUFFER ADDRESS R4 M4765500 SPACE 1 R4 M4766000 NPCELOG MVC DCTPCE+1(3),$MLLMPCE+1 AND RESET PCE ADDRESS R4 M4766500 B NEXTDCT LOOP THRU ALL DCTS R4 M4767000 SPACE 1 R4 M4767500 *********************************************************************** M4768000 * * M4768500 * DECHAIN REMOTE TERMINAL DCTS (IF ANY) * M4769000 * * M4769500 *********************************************************************** M4770000 SPACE 1 R4 M4770500 NDECHAIN SLR R0,R0 GET NUMBER R4 M4771000 ICM R0,3,$NUMLNES OF RJE LINES R4 M4771500 BZ NFREEKOR BR IF NONE DEFINED R4 M4772000 LA WA,$LNEDCT-(DCTCHAIN-DCTDSECT) PREPARE TO RUN DCTS R4 M4772500 SPACE 1 R4 M4773000 SKIP1290 L WA,DCTCHAIN LOCATE LAST R4 M4773500 BCT R0,SKIP1290 LINE DCT R4 M4774000 SPACE 1 R4 M4774500 MVC DCTCHAIN,$INRDCT UNCHAIN REMOTE TERMINAL DCTS R4 M4775000 SPACE 1 R4 M4775500 DROP WA KILL DCT ADDRESSABILITY R4 M4776000 SPACE 1 R4 M4776500 NFREEKOR IC R0,$NUMDA FREE R4 M4777000 MH R0,=Y(TEDSIZ) STORAGE R4 M4777500 ICM R0,8,=AL1(229) USED R4 M4778000 L R1,TEDSTART FOR R4 M4778500 FREEMAIN R,LV=(0),A=(1) TEMPORARY TEDS R4 M4779000 EJECT R4 M4779500 *********************************************************************** M4780000 * * M4780500 * INITIALIZE PROCESSOR WAIT QUEUES * M4781000 * * M4781500 *********************************************************************** M4782000 SPACE 1 R4 M4782500 LA R1,$EWQ1-(PCEPCEA-PCEDSECT) POINT TO 1ST PCE ZERO R4 M4783000 LA R2,8 SET INCREMENT R4 M4783500 LA R3,$READY-(PCEPCEA-PCEDSECT) POINT TO LAST PCE ZERO R4 M4784000 SPACE 1 R4 M4784500 SKIP1300 ST R1,PCEPCEA-PCEDSECT(,R1) STORE 1ST PCE POINTER R4 M4785000 ST R1,PCEPCEB-PCEDSECT(,R1) STORE LAST PCE POINTER R4 M4785500 BXLE R1,R2,SKIP1300 LOOP UNTIL ALL ARE SET R4 M4786000 SPACE 1 R4 M4786500 *********************************************************************** M4787000 * * M4787500 * SET CAT OVERRIDES FOR STARTED TASKS AND LOGONS * M4788000 * * M4788500 *********************************************************************** M4789000 SPACE 1 R4 M4789500 USING CATDSECT,R1 PROVIDE CAT ADDRESSABILITY R4 M4790000 SPACE 1 R4 M4790500 L WA,$CATABLE GET STC R4 M4791000 LA R1,CATLEN*(CATSTCCL-X'C0')(,WA) CAT ENTRY R4 M4791500 OI CATJOBFL,CATNOJNL FORCE NO JOURNAL R4 M4792000 NI CATJOBFL,255-CATRSTRT FORCE NO RESTART R4 M4792500 MVI CATCONVP,C'0' DON'T REQUIRE ACCT'G/PGM'R NAME R4 M4793000 OI CATSMFLG,CATNOUSO+CATNOTY6+CATNOUJP+CATNOT26 NO SMF R4 M4793500 LA R1,CATLEN*(CATTSUCL-X'C0')(,WA) GET TSU CAT ENTRY R4 M4794000 OI CATJOBFL,CATNOJNL FORCE NO JOURNAL R4 M4794500 NI CATJOBFL,255-CATRSTRT FORCE NO RESTART R4 M4795000 MVI CATCONVP,C'0' DON'T REQUIRE ACCT'G/PGM'R NAME R4 M4795500 SPACE 1 R4 M4796000 DROP R1 KILL CAT ADDRESSABILITY R4 M4796500 EJECT R4 M4797000 *********************************************************************** M4797500 * * M4798000 * $POST THE TIME EXCESSION, $TIMER, WARM START AND * M4798500 * CHECKPOINT PROCESSORS. HOLD ALL OTHERS. * M4799000 * * M4799500 *********************************************************************** M4800000 SPACE 1 R4 M4800500 MVC $VERSION,NVERSION SET CURRENT VERSION IN HCT R4 M4801000 SPACE 1 R4 M4801500 LA R1,$PCEORG-(PCENEXT-PCEDSECT) PREPARE TO SCAN PCES R4 M4802000 SPACE 1 R4 M4802500 USING PCEDSECT,R1 PROVIDE PCE ADDRESSABILITY R4 M4803000 SPACE 1 R4 M4803500 NXTPCE ICM R1,15,PCENEXT SKIP TO NEXT PCE ON CHAIN M4804000 BZ NBUFBLD BRANCH IF AT END OF CHAIN M4804500 CLI PCEID+1,PCETIMID Q. IF $TIMER OR TIME EXCESSION M4805000 BE NPCEPST BR. IF YES M4805500 CLI PCEID+1,PCECKPID Q. IF CHECKPOINT PCE M4806000 BE NPCEPST BR. IF YES M4806500 CLI PCEID+1,PCEWRMID Q. IF WARM START PCE M4807000 BE NPCEPST BR. IF YES M4807500 OI PCEEWF,$EWFHOLD TURN ON PCE HOLD BIT M4808000 B NXTPCE REITERATE LOOP M4808500 SPACE 1 M4809000 NPCEPST $POST (R1),POST PLACE PCE ON ACTIVE QUEUE M4809500 B NXTPCE REITERATE LOOP M4810000 SPACE 1 R4 M4810500 NVERSION DC CL8'&VERSION' HASP VERSION NUMBER R4 M4811000 SPACE 1 R4 M4811500 DROP R1 KILL PCE ADDRESSABILITY R4 M4812000 SPACE 1 R4 M4812500 TITLE 'HASP INITIALIZATION -- BUFFER POOL GENERATION' R4 M4813000 *********************************************************************** M4813500 * * M4814000 * CALCULATE DEFAULT HASP BUFFER COUNT * M4814500 * * M4815000 * DEFAULT = 20 + 4*&NUMRDRS + (&NUMPRTS-N1)*N2 * M4815500 * + N1*N2*&TCELSIZ + &NUMPUNS*N3 * M4816000 * + &NUMLNES*(3+N4+N5) * M4816500 * WHERE * M4817000 * N1 = NUMBER OF PRINTERS SPECIFYING DSPLTCEL * M4817500 * N2 = 2 IF &PRTBOPT=YES, ELSE 1 * M4818000 * N3 = 2 IF &PUNBOPT=YES, ELSE 1 * M4818500 * N4 = 2 IF &RPRBOPT=YES, ELSE 1 * M4819000 * N5 = 2 IF &RPUBOPT=YES, ELSE 1 * M4819500 * * M4820000 *********************************************************************** M4820500 SPACE 1 R4 M4821000 NBUFBLD LH R0,$NUMBUF USE &NUMBUF R4 M4821500 LTR R0,R0 VALUE IF R4 M4822000 BNZ NBBLDBGN SPECIFIED R4 M4822500 SLR WA,WA GET NUMBER OF R4 M4823000 IC WA,$NUMRDRS LOCAL READERS R4 M4823500 SLL WA,2 TIMES 4 R4 M4824000 SLR WB,WB ADD NUMBER R4 M4824500 IC WB,$NUMPRTS OF R4 M4825000 L WC,=A(NPRDTCEL) (LOCAL-DSPLTCEL) R4 M4825500 SH WB,0(,WC) PRINTERS R4 M4826000 TM $PRTOPTS,$PRTBOPT TIMES R4 M4826500 BZ SKIP1310 BUFFERS PER R4 M4827000 SLL WB,1 PRINTER R4 M4827500 SKIP1310 LA R0,20(WA,WB) ADD 20 TO ABOVE TOTAL R4 M4828000 LH WA,0(,WC) ADD NUMBER OF R4 M4828500 IC WB,$TCELSIZ OF DSPLTCEL R4 M4829000 MR WA,WA PRINTERS R4 M4829500 TM $PRTOPTS,$PRTBOPT TIMES TRACK- R4 M4830000 BZ SKIP1320 CELL SIZE R4 M4830500 ALR R0,WB TIMES BUFFERS R4 M4831000 SKIP1320 ALR R0,WB PER PRINTER R4 M4831500 IC WA,$NUMPUNS ADD R4 M4832000 TM $PRTOPTS,$PUNBOPT NUMBER R4 M4832500 BZ SKIP1330 OF PUNCHES R4 M4833000 ALR R0,WA TIMES BUFFERS R4 M4833500 SKIP1330 ALR R0,WA PER PUNCH R4 M4834000 LA WA,3+1+1 ADD 3 TO R4 M4834500 TM $PRTOPTS,$RPRBOPT+$RPUBOPT BUFFERS PER R4 M4835000 BM SKIP1340 REMOTE PRINTER R4 M4835500 BZ SKIP1350 AND BUFFERS R4 M4836000 LA WA,1(,WA) PER REMOTE R4 M4836500 SKIP1340 LA WA,1(,WA) PUNCH R4 M4837000 SKIP1350 MH WA,$NUMLNES ADD BUFFERS R4 M4837500 ALR R0,WA PER LINE R4 M4838000 CH R0,*+10 IMPOSE R4 M4838500 BNH NBBLDBGN &NUMBUF R4 M4839000 LA R0,$MAXBUF LIMIT R4 M4839500 EJECT R4 M4840000 *********************************************************************** M4840500 * * M4841000 * GENERATE JES2 GENERAL BUFFER POOL * M4841500 * * M4842000 *********************************************************************** M4842500 SPACE 1 R4 M4843000 NBBLDBGN LH R1,$BUFSIZE GET SPOOL BUFFER SIZE R4 M4843500 LA R1,BUFSTART-BUFDSECT(,R1) COMPUTE STORAGE BFR SIZE R4 M4844000 STH R1,$BUFLENG SAVE STORAGE BUFFER SIZE R4 M4844500 LA WF,NBFBUILD POINT TO BUFFER BUILD ROUTINE R4 M4845000 BALR WE,WF AND GO DO IT R4 M4845500 MVI BPMBFTYP-BPMDSECT(R1),BUFHASP SET BUFFER TYPE R4 M4846000 STH R0,$NUMBUF STORE BUFFERS ALLOCATED R4 M4846500 ST R1,$BFRMAP AND BUFFER POOL MAP ADDRESS R4 M4847000 SPACE 3 R4 M4847500 *********************************************************************** M4848000 * * M4848500 * GENERATE JES2 PP (PRINT/PUNCH PROCESSOR) BUFFERS * M4849000 * * M4849500 * THE NUMBER OF BUFFERS REQUIRED = $NUMPUNS + NPRDTCEL + * M4850000 * ($NUMPRTS - NBR3800) * M4850500 * * M4851000 * THE SIZE OF A BUFFER = 2X + (BUFFER PREFIX AREA) * M4851500 * * M4852000 * WHERE X = MAX ($NOPRCCW*8+PCIESIZE+((JOESIZE+7)/8)*8, * M4852500 * $NOPUCCW*8+PCIESIZE+((JOESIZE+7)/8)*8, * M4853000 * ($TCELSIZ*4-3)*4) * M4853500 * * M4854000 *********************************************************************** M4854500 SPACE 1 R4 M4855000 NBBLDPP SLR WE,WE CLEAR WORK REGISTER R4 M4855500 IC WE,$NOPRCCW PICK UP $NOPRCCW R4 M4856000 SLL WE,3 MULTIPLY BY 8 R4 M4856500 LA WE,PCIESIZE(,WE) ADD LENGTH OF PCIE R4 M4857000 LA WE,(JOESIZE+7)/8*8(,WE) ADD ROUNDED JOE SIZE R4 M4857500 LR R1,WE SAVE AS FIRST MAX VALUE R4 M4858000 SLR WE,WE CLEAR WORK REG R4 M4858500 IC WE,$NOPUCCW PICK UP $NOPUCCW R4 M4859000 SLL WE,3 MULTIPLY BY 8 R4 M4859500 LA WE,PCIESIZE(,WE) ADD LENGTH OF PCIE R4 M4860000 LA WE,(JOESIZE+7)/8*8(,WE) ADD ROUNDED JOE SIZE R4 M4860500 CR R1,WE DO WE HAVE A NEW MAX VALUE... R4 M4861000 BNL SKIP1360 BR IF NO R4 M4861500 LR R1,WE ELSE USE NEW MAX VALUE R4 M4862000 SKIP1360 SLR R2,R2 CLEAR WORK REG R4 M4862500 IC R2,$TCELSIZ PICK UP $TCELSIZ R4 M4863000 SLL R2,2 MULTIPLY BY 4 R4 M4863500 EJECT R4 M4864000 BCTR R2,0 SUB- R4 M4864500 BCTR R2,0 TRACT R4 M4865000 BCTR R2,0 3 R4 M4865500 SLL R2,2 MULTIPLY BY 4 R4 M4866000 CR R1,R2 DO WE HAVE A NEW MAX VALUE... R4 M4866500 BNL SKIP1370 BR IF NO R4 M4867000 LR R1,R2 ELSE USE NEW MAX VALUE R4 M4867500 SKIP1370 SLL R1,1 MULTIPLY X BY 2 R4 M4868000 LA R1,BUFSTART-BUFDSECT(,R1) ADD BUFER PREFIX SIZE R4 M4868500 CH R1,=H'4096' BUFSIZE EXCEED ONE PAGE... @OZ41577 M4868600 BNH SKIP1075 IF NOT, CONTINUE @OZ41577 M4868650 L R1,=A(NMSG495) POINT TO MESSAGE TEXT @OZ41577 M4868700 $$WTO (R1) ISSUE BUFSIZE TOO BIG MSG @OZ41577 M4868750 $EXIT NGQUITM ISSUE 'QUIT' MSG AND QUIT @OZ41577 M4868800 SKIP1075 DS 0H @OZ41577 M4868900 SLR R0,R0 CLEAR WORK REG R4 M4869000 SLR R2,R2 CLEAR WORK REG R4 M4869500 IC R0,$NUMPRTS GET TOTAL NBR OF PRINTERS R4 M4870000 L WE,=A(NBR3800) GET A(NBR3800) R4 M4870500 L WF,=A(NPRDTCEL) GET A(NPRDTCEL) R4 M4871000 SH R0,0(,WE) SUBTRACT NBR OF 3800 PRINTERS R4 M4871500 AH R0,0(,WF) ADD NBR OF TRAKCELL PRINTERS R4 M4872000 IC R2,$NUMPUNS NBR OF PUNCHES R4 M4872500 ALR R0,R2 TOTAL NBR OF BUFFERS REQUIRED R4 M4873000 LA WF,NBFBUILD POINT TO BUFFER BUILD RTN R4 M4873500 BALR WE,WF BUILD THEM R4 M4874000 MVI BPMBFTYP-BPMDSECT(R1),BUFPP SET BUFFER TYPE R4 M4874500 ST R1,$PPBFMAP SAVE BUFFER POOL MAP ADDRESS R4 M4875000 SPACE 3 R4 M4875500 *********************************************************************** M4876000 * * M4876500 * GENERATE JES2 PAGE BUFFERS * M4877000 * * M4877500 * THE SIZE OF A BUFFER = 4096 BYTES (ONE PAGE) * M4878000 * * M4878500 * THE NUMBER OF BUFFERS = NBR OF 3800 PRINTERS * M4879000 * * M4879500 *********************************************************************** M4880000 SPACE 1 R4 M4880500 NBBLDPG L WE,=A(NBR3800) GET NUMBER R4 M4881000 LH R0,0(,WE) OF 3800 PRINTERS R4 M4881500 LTR R0,R0 IN SYSTEM R4 M4882000 BZ NBBLDEND AREN'T ANY, DON'T GET BUFFERS R4 M4882500 LA R1,4095 SIZE OF A R4 M4883000 LA R1,1(,R1) BUFFER R4 M4883500 LA WF,NBFBUILD POINT TO BUFFER BUILD RTN R4 M4884000 BALR WE,WF DO IT R4 M4884500 MVI BPMBFTYP-BPMDSECT(R1),BUFPAGE SET BUFFER TYPE R4 M4885000 ST R1,$PGBFMAP SAVE BUFFER POOL MAP ADDRESS R4 M4885500 EJECT R4 M4886000 *********************************************************************** M4886500 * * M4887000 * END OF BASIC INITIALIZATION -- RETURN TO HASPNUC * M4887500 * * M4888000 *********************************************************************** M4888500 SPACE 1 R4 M4889000 NBBLDEND L R7,$SSVT RESTORE SSVT ADDRESS R4 M4889500 MVC $VFL,$SVVFL MOVE VFL RTN ADDR TO HCT R4 M4890000 L R0,$SVTED SET HCT POINTER R4 M4890500 ST R0,$TEDADDR TO FIRST TED R4 M4891000 L WA,$SVSSCT POINT TO THE SSCT R4 M4891500 MODESET EXTKEY=ZERO SET ZERO PROTECT KEY R4 M4892000 OI SSCTFLG1-SSCT(WA),SSCTSFOR SERIALIZE PROCESS SYSOUT R4 M4892500 ST R7,SSCTSSVT-SSCT(,WA) CONNECT SSVT TO SSCT R4 M4893000 MODESET EXTKEY=HASP RESTORE JES2 PROTECT KEY R4 M4893500 SPACE 1 R4 M4894000 L R13,4(,R13) RESTORE SAVE AREA POINTER R4 M4894500 LM LINK,R12,12(R13) RESTORE CALLER'S REGISTERS R4 M4895000 SLR R15,R15 SET NORMAL RETURN CODE @OZ35996 M4895100 BR LINK AND RETURN TO HASPNUC R4 M4895500 SPACE 1 R4 M4896000 DROP R7 KILL SSVT ADDRESSABILITY R4 M4896500 TITLE 'HASP INITIALIZATION -- BUFFER POOL GENERATION SUBROUTINE' R4 M4897000 *********************************************************************** M4897500 * * M4898000 * NBFBUILD - GENERATE JES2 BUFFER POOL * M4898500 * * M4899000 * R0 - BUFFERS REQUESTED, BUFFERS ALLOCATED ON EXIT * M4899500 * R1 - BUFFER SIZE, BUFFER POOL MAP ADDR ON EXIT * M4900000 * WE - RETURN ADDRESS * M4900500 * WF - ENTRY POINT ADDRESS * M4901000 * R11 - HCT ADDRESS (BASE1) * M4901500 * R13 - 18 WORD SAVE AREA ADDRESS * M4902000 * * M4902500 * REGISTERS WA,WB,WC,WD DESTROYED BY THIS ROUTINE * M4903000 * * M4903500 *********************************************************************** M4904000 SPACE 1 R4 M4904500 USING BPMDSECT,R1 PROVIDE BFR MAP ADDRESSABILITY R4 M4905000 USING NBFBUILD,WF PROVIDE LOCAL ADDRESSABILITY R4 M4905500 SPACE 1 R4 M4906000 NBFBUILD LH WD,=H'4096' WD = NUMBER R4 M4906500 SLR WC,WC OF R4 M4907000 DR WC,R1 JES2 R4 M4907500 CH WD,=H'8' BUFFERS R4 M4908000 BNH SKIP1380 PER R4 M4908500 LH WD,=H'8' PAGE R4 M4909000 SKIP1380 SLR WA,WA WC = NUMBER OF R4 M4909500 LA WB,BPMEND-1 BUFFERS RESERVED R4 M4910000 DR WA,R1 IN BUFFER R4 M4910500 LR WC,WB BIT MAP R4 M4911000 ALR WB,R0 WB = NUMBER R4 M4911500 SLR WA,WA OF BUFFERS, R4 M4912000 DR WA,WD NOT TO R4 M4912500 LTR WA,WA EXCEED 2048, R4 M4913000 MR WA,WD FILLING R4 M4913500 BZ SKIP1390 COMPLETELY R4 M4914000 ALR WB,WD THE R4 M4914500 SKIP1390 CH WB,=H'2048' PAGES R4 M4915000 BNH NBFGMAIN TO R4 M4915500 SLR WB,WD BE R4 M4916000 B SKIP1390 ALLOCATED R4 M4916500 EJECT R4 M4917000 NBFGMAIN DR WA,WD WB = STORAGE REQUIRED FOR R4 M4917500 SLL WB,12 REQUESTED BUFFERS R4 M4918000 LR WA,R1 SAVE BUFFER SIZE R4 M4918500 LR R0,WB RELOAD STORAGE REQUIREMENT R4 M4919000 GETMAIN RC,LV=(0),BNDRY=PAGE OBTAIN BUFFER STORAGE R4 M4919500 LTR R15,R15 IF STORAGE NOT AVAILABLE, R4 M4920000 BNZ NBFPIG BR TO ISSUE MSG AND ABORT R4 M4920500 MVC BPMID,=CL4'BPM' SET BUFFER POOL MAP ID R4 M4921000 STH WA,BPMBFSIZ STORE BUFFER SIZE R4 M4921500 LR WA,R1 SAVE MAP ADDRESS R4 M4922000 ST WB,BPMSIZE SAVE STORAGE REQUIREMENT R4 M4922500 LA R0,BPMMAP STORE ADDRESS R4 M4923000 ST R0,BPMAPADR OF BUFFER ALLOCATION MAP R4 M4923500 ST WD,BPMPGBFS STORE NO. OF BUFFERS PER PAGE R4 M4924000 L R0,=X'0000FF00' SET MASK R4 M4924500 SRL R0,0(WD) FOR DETERMINING R4 M4925000 STC R0,BPMMASK RELEASABLE PAGE R4 M4925500 LR R0,WB PAGE RELEASE R4 M4926000 SH R0,=H'4096' ALL BUFFER STORAGE R4 M4926500 BZ NBFMAP EXCEPT R4 M4927000 AH R1,=H'4096' FOR R4 M4927500 $PGSRVC RLSE,(R1),(R0) 1ST PAGE R4 M4928000 LR R1,WA RESTORE MAP ADDRESS R4 M4928500 EJECT R4 M4929000 NBFMAP XC BPMMAP,BPMMAP 'ALLOCATE' ALL BUFFERS R4 M4929500 L R14,=X'0000FFFF' FREE 1ST 16 BUFFERS, R4 M4930000 SRL R14,0(WC) EXCEPT FOR THOSE R4 M4930500 STH R14,BPMMAP PERMANENTLY RESERVED R4 M4931000 SRL WB,12 IF MORE R4 M4931500 MR WA,WD THAN R4 M4932000 LR R0,WB SIXTEEN R4 M4932500 SLR R0,WC BUFFERS R4 M4933000 SH WB,=H'16' DEFINED, R4 M4933500 BP NBFFREE BR TO FREE THE REST R4 M4934000 LCR WB,WB ELSE 'RE-ALLOCATE' R4 M4934500 SRL R14,0(WB) ANY UNDEFINED R4 M4935000 SLL R14,0(WB) BUFFERS AMONG R4 M4935500 STH R14,BPMMAP FIRST SIXTEEN R4 M4936000 SPACE 1 R4 M4936500 NBFRANGE LR WB,WC COMPUTE R4 M4937000 MH WB,BPMBFSIZ AND R4 M4937500 CLR WC,WD STORE R4 M4938000 BL SKIP1400 ADDRESS R4 M4938500 LH WB,=H'4096' OF R4 M4939000 SKIP1400 ALR WB,R1 1ST R4 M4939500 ST WB,BPMBFR1 BUFFER R4 M4940000 LR WB,WC GET RELATIVE R4 M4940500 ALR WB,R0 BUFFER NUMBER R4 M4941000 BCTR WB,0 OF LAST BUFFER R4 M4941500 SLR WA,WA COMPUTE R4 M4942000 DR WA,WD AND R4 M4942500 SLL WB,12 STORE R4 M4943000 MH WA,BPMBFSIZ ADDRESS R4 M4943500 ALR WB,WA OF R4 M4944000 ALR WB,R1 LAST R4 M4944500 ST WB,BPMLAST BUFFER R4 M4945000 STH R0,BPMBUFCT STORE NBR AVAIL BUFFERS AND R4 M4945500 BR WE THEN RETURN TO CALLER R4 M4946000 SPACE 1 R4 M4946500 NBFFREE LR WA,WB SAVE REMAINING BUFFER COUNT R4 M4947000 SRL WB,3 FREE REMAINING R4 M4947500 STC WB,*+5 DEFINED R4 M4948000 MVC BPMMAP+2(*-*),BPMMAP+1 BUFFERS R4 M4948500 N WA,=F'7' 'RE-ALLOCATE' ANY R4 M4949000 L R14,=X'0000FF00' UNDEFINED BUFFERS R4 M4949500 SRL R14,0(WA) AMONG LAST R4 M4950000 STC R14,BPMMAP+2(WB) 8 'ALLOCATED' R4 M4950500 B NBFRANGE THEN BR TO SET BFR RANGE ADDRS R4 M4951000 SPACE 1 R4 M4951500 NBFPIG $$WTO NBFMSG ISSUE ERROR MESSAGE TO OPERATOR R4 M4952000 L R1,=A(NGQUITM) POINT TO QUIT MESSAGE R4 M4952500 L R15,=A(NERRORET) GET ADDRESS OF ERROR EXIT R4 M4953000 BR R15 AND EXIT R4 M4953500 SPACE 1 R4 M4954000 DROP R1,WF KILL LOCAL ADDRESSABILITY R4 M4954500 EJECT R4 M4955000 LTORG R4 M4955500 TITLE 'HASP INITIALIZATION -- ERROR RETURN ROUTINE' R4 M4956000 *********************************************************************** M4956500 * * M4957000 * ERROR RETURN TO SYSTEM * M4957500 * * M4958000 *********************************************************************** M4958500 SPACE 1 R4 M4959000 * THIS CARD DELETED BY APAR @OZ27300 M4959500 USING $SVDSECT,R2 PROVIDE SSVT ADDRESSABILITY R4 M4960000 * THIS CARD DELETED BY APAR @OZ27300 M4960500 SPACE 1 R4 M4961000 NERRORET BALR BASE2,0 RE-ESTABLISH R4 M4961500 USING *,BASE2 LOCAL ADDRESSABILITY R4 M4962000 SPACE 1 R4 M4962500 $$WTO (R1) ISSUE ERROR MESSAGE TO OPERATOR R4 M4963000 SPACE 1 @OZ27300 M4963200 L R2,=A(NPLCLIST) ENSURE ALL DCB'S @OZ53200 M4963400 CLOSE MF=(E,(R2)) ARE CLOSED @OZ53200 M4963450 ICM R2,15,$SSVT GET SSVT ADDRESS R4 M4963500 BZ NEREXIT EXIT IF NO SSVT @OZ35996 M4964000 SPACE 1 @OZ27300 M4964500 ICM R10,15,$JQB LOCATE THE JQB @OZ27300 M4965000 BZ NERCONT BR IF NOT YET CREATED @OZ27300 M4965500 SPACE 1 @OZ27300 M4966000 USING JQBDSECT,R10 PROVIDE JQB ADDRESSABILITY @OZ27300 M4966500 SPACE 1 @OZ27300 M4967000 L WD,=A(NVOLTABL) LOCATE THE VOLUME @OZ27300 M4967500 L WD,0(,WD) ALLOCATION TABLE @OZ27300 M4968000 TM JQBFLAG1,JQB1PRIM TEST FOR PRIMARY CCWS SET @OZ27300 M4968500 BO NERELSE BRANCH IF YES, GO RELEASE @OZ27300 M4969000 L R15,=A(NGCKSWAP) SWAP BACK TO PRIMARY @OZ27300 M4969500 * THIS CARD DELETED BY APAR @OZ35278 M4969600 BALR R14,R15 CCW SETUP @OZ27300 M4970000 L R15,=A(NGCKADJ) AND ADJUST @OZ27300 M4970500 BALR R14,R15 CCW CHAINING @OZ27300 M4971000 SPACE 1 @OZ27300 M4971500 NERELSE L R15,=A(NCKPRLSE) RELEASE THE @OZ27300 M4972000 BALR R14,R15 CHECKPOINT DASD @OZ27300 M4972500 EJECT @OZ35996 M4973000 NERCONT LA R15,16 ASSUME NO JES2 HOTSTART @OZ35996 M4973500 TM $SVSTUS,$SVSTUSR WAS THIS A HOTSTART... @OZ35996 M4974000 BZ NERRETN BR IF NO TO FREE CSA @OZ35996 M4974500 XI $SVSTUS,$SVSTUSR+$SVSTUST SHOW TERMINATED @OZ35996 M4975000 SPACE 1 @OZ35996 M4975500 NEREXIT LA R15,20 EXIT WITHOUT CSA FREE @OZ35996 M4976000 SPACE 1 @OZ35996 M4976500 NERRETN L R13,4(,R13) LOAD LAST SAVE AREA ADDRESS @OZ35996 M4977000 L R14,12(,R13) LOAD RETURN ADDRESS @OZ35996 M4977500 * THIS CARD DELETED BY APAR @OZ35278 M4977600 LM R0,R12,20(R13) LOAD OTHER REGISTERS @OZ35996 M4978000 BR R14 RETURN TO HASPNUC @OZ35996 M4978500 PUSH PRINT - SECTION @OZ35996 M4979000 PRINT OFF - DELETED @OZ35996 M4979500 * THIS LINE DELETED BY APAR @OZ35996 M4980000 * THIS LINE DELETED BY APAR @OZ35996 M4980500 * THIS LINE DELETED BY APAR @OZ35996 M4981000 * THIS LINE DELETED BY APAR @OZ35996 M4981500 * THIS LINE DELETED BY APAR @OZ35996 M4982000 * THIS LINE DELETED BY APAR @OZ35996 M4982500 * THIS LINE DELETED BY APAR @OZ35996 M4983000 * THIS LINE DELETED BY APAR @OZ35996 M4983500 * THIS LINE DELETED BY APAR @OZ35996 M4984000 * THIS LINE DELETED BY APAR @OZ35996 M4984500 * THIS LINE DELETED BY APAR @OZ35996 M4985000 * THIS LINE DELETED BY APAR @OZ35996 M4985500 * THIS LINE DELETED BY APAR @OZ35996 M4985550 * THIS LINE DELETED BY APAR @OZ35996 M4985600 * THIS LINE DELETED BY APAR @OZ35996 M4985650 * THIS LINE DELETED BY APAR @OZ35996 M4985700 * THIS LINE DELETED BY APAR @OZ35996 M4985750 * THIS LINE DELETED BY APAR @OZ35996 M4985800 * THIS LINE DELETED BY APAR @OZ35996 M4985850 * THIS LINE DELETED BY APAR @OZ35996 M4985900 POP PRINT - SECTION DELETED @OZ35996 M4985950 SPACE 1 @OZ27300 M4986000 DROP R2 RELEASE SSVT ADDRESSABILITY @OZ27300 M4986050 TITLE 'HASP INITIALIZATION -- DASD RELEASE ROUTINE' @OZ27300 M4986100 ***************************************************************@OZ27300 M4986150 * @OZ27300 M4986200 * SUBROUTINE TO RELEASE DASD RESERVE AND CKPT LOCK @OZ27300 M4986250 * @OZ27300 M4986300 ***************************************************************@OZ27300 M4986350 SPACE 1 @OZ27300 M4986400 USING NCKPRLSE,R15 PROVIDE LOCAL ADDRESSABILITY@OZ27300 M4986450 SPACE 1 @OZ27300 M4986500 NCKPRLSE STM R14,R12,NCKPSAVE SAVE REGISTERS @OZ27300 M4986550 LR BASE2,R15 RELOAD BASE REGISTER @OZ27300 M4986600 SPACE 1 @OZ27300 M4986650 DROP R15 RE-ESTABLISH @OZ27300 M4986700 USING NCKPRLSE,BASE2 LOCAL ADDRESSABILITY @OZ27300 M4986750 SPACE 1 @OZ27300 M4986800 L R10,$JQB RE-ESTABLISH JQB @OZ27300 M4986850 USING JQBDSECT,R10 ADDRESSABILITY @OZ27300 M4986900 SPACE 1 @OZ27300 M4986950 TM JQBFLAG1,JQB1LOKD TEST FOR CHECKPOINT LOCKED @OZ27300 M4987000 BZ NCKPDECR BRANCH IF NOT @OZ27300 M4987050 SPACE 1 @OZ27300 M4987100 ***************************************************************@OZ27300 M4987150 * @OZ27300 M4987200 * RELEASE CHECKPOINT DATA SET LOCK @OZ27300 M4987250 * @OZ27300 M4987300 ***************************************************************@OZ27300 M4987350 SPACE 1 @OZ27300 M4987400 MVC JQBLKEY,$ZEROS CLEAR CHECKPOINT LOCK @OZ27300 M4987450 MVC JQBLDATA,$ZEROS (KEY AND DATA) @OZ27300 M4987500 SPACE 1 @OZ27300 M4987550 LA R1,JQBLOCK SET EXCP TO BEGIN @OZ27300 M4987600 ST R1,JQBSTART WITH LOCK RESET PACKET @OZ27300 M4987650 L R15,=A(NGEXCP) POINT TO EXCP ROUTINE @OZ27300 M4987700 BALR R14,R15 RESET THE LOCK @OZ27300 M4987750 BNE NCKPDECR BRANCH IF I/O ERROR @OZ27300 M4987800 SPACE 1 @OZ27300 M4987850 CLC JQBVERFY,=8XL1'FF' TEST FOR I/O COMPLETE @OZ27300 M4987900 BE NCKPDECR BRANCH IF NO @OZ27300 M4987950 NI JQBFLAG1,FF-JQB1LOKD TURN OF LOCKED INDICATOR @OZ27300 M4988000 EJECT @OZ35278 M4988050 PRINT OFF - SECTION DELETED @OZ35278 M4988100 * THIS CARD DELETED BY APAR @OZ35278 M4988150 * THIS CARD DELETED BY APAR @OZ35278 M4988200 * THIS CARD DELETED BY APAR @OZ35278 M4988250 * THIS CARD DELETED BY APAR @OZ35278 M4988300 * THIS CARD DELETED BY APAR @OZ35278 M4988350 * THIS CARD DELETED BY APAR @OZ35278 M4988400 * THIS CARD DELETED BY APAR @OZ35278 M4988450 * THIS CARD DELETED BY APAR @OZ35278 M4988500 * THIS CARD DELETED BY APAR @OZ35278 M4988550 * THIS CARD DELETED BY APAR @OZ35278 M4988600 * THIS CARD DELETED BY APAR @OZ35278 M4988650 * THIS CARD DELETED BY APAR @OZ35278 M4988700 * THIS CARD DELETED BY APAR @OZ35278 M4988750 * THIS CARD DELETED BY APAR @OZ35278 M4988800 * THIS CARD DELETED BY APAR @OZ35278 M4988850 * THIS CARD DELETED BY APAR @OZ35278 M4988900 * THIS CARD DELETED BY APAR @OZ35278 M4988950 * THIS CARD DELETED BY APAR @OZ35278 M4989000 * THIS CARD DELETED BY APAR @OZ35278 M4989050 * THIS CARD DELETED BY APAR @OZ35278 M4989100 * THIS CARD DELETED BY APAR @OZ35278 M4989150 * THIS CARD DELETED BY APAR @OZ35278 M4989200 * THIS CARD DELETED BY APAR @OZ35278 M4989250 * THIS CARD DELETED BY APAR @OZ35278 M4989300 * THIS CARD DELETED BY APAR @OZ35278 M4989350 * THIS CARD DELETED BY APAR @OZ35278 M4989400 * THIS CARD DELETED BY APAR @OZ35278 M4989450 * THIS CARD DELETED BY APAR @OZ35278 M4989500 * THIS CARD DELETED BY APAR @OZ35278 M4989550 * THIS CARD DELETED BY APAR @OZ35278 M4989600 * THIS CARD DELETED BY APAR @OZ35278 M4989650 * THIS CARD DELETED BY APAR @OZ35278 M4989700 * THIS CARD DELETED BY APAR @OZ35278 M4989750 * THIS CARD DELETED BY APAR @OZ35278 M4989800 * THIS CARD DELETED BY APAR @OZ35278 M4989850 * THIS CARD DELETED BY APAR @OZ35278 M4989900 * THIS CARD DELETED BY APAR @OZ35278 M4989950 * THIS CARD DELETED BY APAR @OZ35278 M4990000 * THIS CARD DELETED BY APAR @OZ35278 M4990050 * THIS CARD DELETED BY APAR D @OZ35278 M4990100 PRINT ON -- SECTION DELETED @OZ35278 M4990150 NCKPDECR TM JQBFLAG1,JQB1LOKD TEST FOR CHECKPOINT LOCKED @OZ35278 M4990200 BZ NCKPEXIT BRANCH IF NOT @OZ27300 M4990250 $$WTO NLKSTMSG ISSUE ERROR MESSAGE @OZ27300 M4990300 SPACE 1 @OZ27300 M4990350 NCKPEXIT LM R14,R12,NCKPSAVE RESTORE REGISTERS @OZ27300 M4990400 BR R14 AND RETURN TO CALLER @OZ27300 M4990450 SPACE 1 @OZ27300 M4990500 DROP R10,BASE2 KILL LOCAL ADDRESSABILITY @OZ35278 M4990550 SPACE 1 @OZ27300 M4990600 NCKPSAVE DS 18F LOCAL REGISTER SAVE AREA @OZ27300 M4990650 SPACE 1 @OZ27300 M4990700 LTORG , DEFINE LITERALS @OZ27300 M4990750 TITLE 'HASP INITIALIZATION -- $$WTO/$$WTOR PROCESSING ROUTINE' M4990800 ***************************************************************@OZ27300 M4990850 * @OZ27300 M4990900 * SETUP WTO/WTOR MESSAGE AND ENTER $$WTO ROUTINE @OZ27300 M4990950 * @OZ27300 M4991000 ***************************************************************@OZ27300 M4991050 SPACE 1 @OZ27300 M4991100 USING NWTORTN,R15 PROVIDE LOCAL ADDRESSABILITY@OZ27300 M4991150 PRINT OFF - SECTION DELETED @OZ27300 M4991500 * THIS CARD DELETED BY APAR @OZ27300 M4992000 * THIS CARD DELETED BY APAR @OZ27300 M4992500 * THIS CARD DELETED BY APAR @OZ27300 M4993000 * THIS CARD DELETED BY APAR @OZ27300 M4993500 * THIS CARD DELETED BY APAR @OZ27300 M4994000 * THIS CARD DELETED BY APAR @OZ27300 M4994500 * THIS CARD DELETED BY APAR @OZ27300 M4995000 * THIS CARD DELETED BY APAR @OZ27300 M4995500 PRINT ON -- SECTION DELETED @OZ27300 M4996000 SPACE 1 R4 M4996500 NWTORTN STM R14,R3,12(R13) SAVE REGISTERS R4 M4997000 SPACE 1 @OZ27300 M4997100 LR R0,R1 MOVE @OZ27300 M4997500 LA R1,NPARMSGL MESSAGE R4 M4998000 LR R3,R1 TO R4 M4998500 LA R2,NWTOWORK WORK R4 M4999000 MVCL R2,R0 AREA R4 M4999500 LM R14,R3,12(R13) RESTORE REGISTERS R4 M5000000 LA R1,NWTOWORK POINT TO WORK AREA R4 M5000500 L R15,$$WTO POINT TO $$WTO/$$WTOR ROUTINE R4 M5001000 BR R15 AND ENTER IT R4 M5001500 SPACE 1 R4 M5002000 DROP R15 KILL LOCAL ADDRESSABILITY R4 M5002500 SPACE 1 R4 M5003000 DS 0F R4 M5003500 NWTOWORK DS (NPARMSGL)C MESSAGE WORK AREA R4 M5004000 SPACE 1 R4 M5004500 LTORG R4 M5005000 TITLE 'HASP INITIALIZATION -- OUTPUT PRIORITY TABLE' R4 M5005500 SPACE 5 R4 M5006000 NXPRITAB DS 0F R4 M5006500 DC AL1(16*9),AL3(2000) FIRST INTERVAL R4 M5007000 DC AL1(16*8),AL3(5000) SECOND INTERVAL R4 M5007500 DC AL1(16*7),AL3(15000) THIRD INTERVAL R4 M5008000 DC AL1(16*6),AL3(X'FFFFFF') FOURTH INTERVAL R4 M5008500 DC AL1(16*5),AL3(X'FFFFFF') FIFTH INTERVAL R4 M5009000 DC AL1(16*4),AL3(X'FFFFFF') SIXTH INTERVAL R4 M5009500 DC AL1(16*3),AL3(X'FFFFFF') SEVENTH INTERVAL R4 M5010000 DC AL1(16*2),AL3(X'FFFFFF') EIGHTH INTERVAL R4 M5010500 DC AL1(16*1),AL3(X'FFFFFF') NINTH INTERVAL R4 M5011000 DC AL4(X'FFFFFF') R4 M5011500 TITLE 'HASP INITIALIZATION -- SYSOUT CLASS CHARACTERISTICS TABCM5012000 LE' M5012500 SPACE 5 M5013000 ORG *-3*64 ORG OVER UNUSED SPACE M5013500 NSCAT DS 0D SYSOUT CLASS ATTRIBUTE TABLE M5014000 ORG *+3*64 INVALID CLASSES M5014500 SPACE 1 M5015000 DC 01AL1(SCATDUMM+SCATINVL) INVALID CLASS M5015500 DC 01AL1(0) CLASS A M5016000 DC 01AL1(SCATPNCH) CLASS B M5016500 DC 07AL1(0) CLASSES C-I M5017000 DC 07AL1(SCATDUMM+SCATINVL) INVALID CLASSES M5017500 DC 01AL1(0) CLASS J M5018000 DC 01AL1(SCATPNCH) CLASS K M5018500 DC 07AL1(0) CLASSES L-R M5019000 DC 08AL1(SCATDUMM+SCATINVL) INVALID CLASSES M5019500 DC 08AL1(0) CLASSES S-Z M5020000 DC 06AL1(SCATDUMM+SCATINVL) INVALID CLASSES M5020500 DC 10AL1(0) CLASSES 0-9 M5021000 DC 06AL1(SCATDUMM+SCATINVL) INVALID CLASSES M5021500 TITLE 'HASP INITIALIZATION -- REMOTE WORK TABLE (RWT) DSECT' M5022000 RWTDSECT DSECT REMOTE WORK TABLE DSECT M5022500 RWTINDEX DS X REMOTE DEVICE INDEX R4 M5023000 RWTSTAT DS BL1 REMOTE DEVICE STATUS M5023500 RWTROUTE DS AL2 REMOTE DEVICE ROUTE CODE M5024000 RWTLRECL DS X REMOTE DEVICE LRECL @OZ29180 M5024100 RWTSEL DS X RMT SNA DEVICE SELECT BYTE @OZ29180 M5024200 RWTFEAT DS X COMMOM SNA/BSC FEATURES @OZ29180 M5024300 RWTSFEAT DS X SNA FEATURES ONLY @OZ29180 M5024400 RWTCSEND EQU * END OF COMMON SECTION M5024500 DS AL1 RESERVED R4 M5025500 RWTPRSYS DS AL2 SYSTEM ID R4 M5026000 RWTPRINT DS AL2 DEFAULT PRINT ROUTE CODE M5029000 RWTPUSYS DS AL2 SYSTEM ID R4 M5030000 RWTPUNCH DS AL2 DEFAULT PUNCH ROUTE CODE M5032500 RWTJCLAS DS C DEFAULT JOB CLASS M5033000 RWTMCLAS DS C DEFAULT MSGCLASS M5033500 RWTPRINC DS X PRIORITY INCREMENT M5034000 RWTPRLIM DS X PRIORITY LIMIT M5034500 RWTFLAGS DS BL1 OPERATOR COMMAND FLAGS M5035000 RWTRDEND EQU * END OF REMOTE READER ELEMENT M5035500 ORG RWTCSEND M5036000 RWTFORMS DS CL4 REMOTE PRINT/PUNCH FORMS ID M5036500 RWTFCB DS CL4 REMOTE PRINT CARRIAGE TAPE ID M5037000 RWTUCS DS CL4 REMOTE PRINT CHARACTER SET ID M5037500 RWTCKPTP DS H NO. OF LOGICAL PAGES/CKPT @OZ19494 M5037600 RWTCKPTL DS H NO. OF LINES/LOGICAL PAGE @OZ19494 M5037700 RWTLIMLO DS F REMOTE PRINT/PUNCH LOWER LIM@OZ40627 M5037800 RWTLIMHI DS F REMOTE PRINT/PUNCH UPPER LIM@OZ40627 M5037900 RWTPPFL DS BL1 REMOTE PRINT PUNCH FLAGS M5038000 RWTPPSW DS BL1 REMOTE PRINT/PUNCH SWITCHES M5038500 RWTCLASS DS CL36 REMOTE PRINT/PUNCH CLASS LIST R4 M5039000 * THIS CARD DELETED BY APAR @OZ29180 M5039500 RWTDCPTN DS X DEFAULT CPT NUMBER R41 M5040000 RWTCHLM DS X SNA REMOTE CHAIN LIMIT R4 M5041000 DS X RESERVED @OZ19494 M5041500 RWTPPEND EQU * END OF REMOTE PRINT/PUNCH ELEMENT M5042500 SPACE 3 M5043000 ORG RWTDSECT M5043500 RWTRDR1 DS XL(RWTRDEND-RWTDSECT) RNNN.RD1 WORK TABLE ELEMENT M5044000 RWTRDR2 DS XL(RWTRDEND-RWTDSECT) RNNN.RD2 WORK TABLE ELEMENT M5044500 RWTRDR3 DS XL(RWTRDEND-RWTDSECT) RNNN.RD3 WORK TABLE ELEMENT M5045000 RWTRDR4 DS XL(RWTRDEND-RWTDSECT) RNNN.RD4 WORK TABLE ELEMENT M5045500 RWTRDR5 DS XL(RWTRDEND-RWTDSECT) RNNN.RD5 WORK TABLE ELEMENT M5046000 RWTRDR6 DS XL(RWTRDEND-RWTDSECT) RNNN.RD6 WORK TABLE ELEMENT M5046500 RWTRDR7 DS XL(RWTRDEND-RWTDSECT) RNNN.RD7 WORK TABLE ELEMENT M5047000 RWTPRT1 DS XL(RWTPPEND-RWTDSECT) RNNN.PR1 WORK TABLE ELEMENT M5047500 RWTPRT2 DS XL(RWTPPEND-RWTDSECT) RNNN.PR2 WORK TABLE ELEMENT M5048000 RWTPRT3 DS XL(RWTPPEND-RWTDSECT) RNNN.PR3 WORK TABLE ELEMENT M5048500 RWTPRT4 DS XL(RWTPPEND-RWTDSECT) RNNN.PR4 WORK TABLE ELEMENT M5049000 RWTPRT5 DS XL(RWTPPEND-RWTDSECT) RNNN.PR5 WORK TABLE ELEMENT M5049500 RWTPRT6 DS XL(RWTPPEND-RWTDSECT) RNNN.PR6 WORK TABLE ELEMENT M5050000 RWTPRT7 DS XL(RWTPPEND-RWTDSECT) RNNN.PR7 WORK TABLE ELEMENT M5050500 RWTPUN1 DS XL(RWTPPEND-RWTDSECT) RNNN.PU1 WORK TABLE ELEMENT M5051000 RWTPUN2 DS XL(RWTPPEND-RWTDSECT) RNNN.PU2 WORK TABLE ELEMENT M5051500 RWTPUN3 DS XL(RWTPPEND-RWTDSECT) RNNN.PU3 WORK TABLE ELEMENT M5052000 RWTPUN4 DS XL(RWTPPEND-RWTDSECT) RNNN.PU4 WORK TABLE ELEMENT M5052500 RWTPUN5 DS XL(RWTPPEND-RWTDSECT) RNNN.PU5 WORK TABLE ELEMENT M5053000 RWTPUN6 DS XL(RWTPPEND-RWTDSECT) RNNN.PU6 WORK TABLE ELEMENT M5053500 RWTPUN7 DS XL(RWTPPEND-RWTDSECT) RNNN.PU7 WORK TABLE ELEMENT M5054000 RWTEND DS 0F END OF REMOTE WORK TABLE ELEMENT M5054500 RWTLEN EQU RWTEND-RWTDSECT LENGTH OF REMOTE WORK TABLE ELEMENT M5055000 HASPINIT CSECT END OF REMOTE WORK TABLE DSECT M5055500 TITLE 'HASP INITIALIZATION -- REMOTE WORK LOOK-UP (RWL) TABLE CM5056000 DSECT' M5056500 SPACE 5 M5057000 RWLDSECT DSECT REMOTE WORK LOOK-UP TABLE DSECT M5057500 RWLNAME DS CL3 REMOTE DEVICE NAME M5058000 RWLRCB DS X REMOTE DEVICE RECORD CONTROL BYTE M5058500 RWLFCS DS BL2 REMOTE DEVICE FUNCTION CONTROL SEQ M5059000 RWLDISP DS AL2 REMOTE WORK TABLE ENTRY DISPLACEMENT M5059500 DS X RESERVED R4 M5060500 RWLSEL DS X REMOTE DEVICE SNA SELECT BYTE R4 M5061000 RWLEND DS 0H END OF REMOTE LOOK-UP TABLE ELEMENT M5062000 HASPINIT CSECT END OF RMT LOOK-UP TABLE DSECT M5062500 TITLE 'HASP INITIALIZATION -- REMOTE WORK LOOK-UP TABLE' M5063000 SPACE 5 M5063500 $RWL DS 0D M5064000 DC CL3'RD1',X'93',X'0800',AL2(RWTRDR1-RWTDSECT),XL2'20' R4 M5065000 DC CL3'RD2',X'A3',X'0400',AL2(RWTRDR2-RWTDSECT),XL2'21' R4 M5065500 DC CL3'RD3',X'B3',X'0200',AL2(RWTRDR3-RWTDSECT),XL2'22' R4 M5066000 DC CL3'RD4',X'C3',X'0100',AL2(RWTRDR4-RWTDSECT),XL2'23' R4 M5066500 DC CL3'RD5',X'D3',X'0008',AL2(RWTRDR5-RWTDSECT),XL2'24' R4 M5067000 DC CL3'RD6',X'E3',X'0004',AL2(RWTRDR6-RWTDSECT),XL2'25' R4 M5067500 DC CL3'RD7',X'F3',X'0002',AL2(RWTRDR7-RWTDSECT),XL2'26' R4 M5068000 DC CL3'PR1',X'94',X'0800',AL2(RWTPRT1-RWTDSECT),XL2'B0' R4 M5068500 DC CL3'PR2',X'A4',X'0400',AL2(RWTPRT2-RWTDSECT),XL2'B1' R4 M5069000 DC CL3'PR3',X'B4',X'0200',AL2(RWTPRT3-RWTDSECT),XL2'B2' R4 M5069500 DC CL3'PR4',X'C4',X'0100',AL2(RWTPRT4-RWTDSECT),XL2'B3' R4 M5070000 DC CL3'PR5',X'D4',X'0008',AL2(RWTPRT5-RWTDSECT),XL2'B4' R4 M5070500 DC CL3'PR6',X'E4',X'0004',AL2(RWTPRT6-RWTDSECT),XL2'B5' R4 M5071000 DC CL3'PR7',X'F4',X'0002',AL2(RWTPRT7-RWTDSECT),XL2'B6' R4 M5071500 DC CL3'PU1',X'95',X'0001',AL2(RWTPUN1-RWTDSECT),XL2'A0' R4 M5072000 DC CL3'PU2',X'A5',X'0002',AL2(RWTPUN2-RWTDSECT),XL2'A1' R4 M5072500 DC CL3'PU3',X'B5',X'0004',AL2(RWTPUN3-RWTDSECT),XL2'A2' R4 M5073000 DC CL3'PU4',X'C5',X'0008',AL2(RWTPUN4-RWTDSECT),XL2'A3' R4 M5073500 DC CL3'PU5',X'D5',X'0100',AL2(RWTPUN5-RWTDSECT),XL2'A4' R4 M5074000 DC CL3'PU6',X'E5',X'0200',AL2(RWTPUN6-RWTDSECT),XL2'A5' R4 M5074500 DC CL3'PU7',X'F5',X'0400',AL2(RWTPUN7-RWTDSECT),XL2'A6' R4 M5075000 SPACE 5 M5087000 $INITLEN $DLENGTH HEADER=I COMPUTE CONTROL SECTION LENGTH M5087500 APARNUM DC CL5'53418' APAR NUMBER M5087998 END M5088000