MACRO 00001000
&NAME SYSIR &R,&ITEM,&FG 00002000
GBLB &IJBFG 00003000
GBLB &IJBSID(63) 00004000
GBLB &IJBSINO 00005000
LCLA &A1,&A2,&A3,&PPTASK 00006000
LCLB &LUBPR 00007000
LCLC &BASE,&DNM,&WKC 00008000
AIF (N'&R LT 2 AND '&R' NE 'DSECT' AND '&FG' NE 'INNER' AND X00009000
'&FG' NE 'INNERP').NON 00010000
AIF ('&FG' EQ 'INNER' OR '&FG' EQ 'INNERP').NAME 00011000
MNOTE *,'CONTROL-PROGRAM-ONLY EXPANSION' 00012000
.NAME ANOP 00013000
AIF (T'&NAME EQ 'O').FG 00014000
&NAME DC 0H'0' 00015000
.FG ANOP 00016000
AIF (T'&FG EQ 'O' OR '&FG' EQ 'BG' OR '&FG' EQ 'FG' OR '&FG'X00017000
EQ 'INNER' OR '&FG' EQ 'INNERP').FG1 00018000
MNOTE 1,'INVALID FG OPERAND' 00019000
.FG1 ANOP 00020000
&IJBFG SETB ('&FG' EQ 'FG' OR &IJBFG) 00021000
AIF (T'&R EQ 'O').ERROR 00022000
AIF ('&R' EQ 'DSECT').DSECT 00023000
AIF ('&R(N'&R)'(1,7) NE 'SYSCOM(' OR K'&R(N'&R) LT 9).ITEM 00024000
&A1 SETA K'&R(N'&R)-8 00025000
&BASE SETC '&R(N'&R)'(8,&A1) 00026000
.ITEM ANOP 00027000
AIF (T'&ITEM EQ 'O').ERROI 00028000
AIF ('&ITEM' NE 'SYSCOM').ITEM1 00029000
&DNM SETC 'SYSCOM' 00030000
&A1 SETA 1 00031000
L &R(1),20 . COMM REGN ADDR 00032000
SVC 33 . * 00033000
AGO .EXIT 00034000
.ITEM1 ANOP 00035000
AIF (N'&R LT 2).ERRNUM 00036000
AIF ('&BASE' NE '').SYSC1 00037000
&BASE SETC '&R(N'&R)' 00038000
L &BASE,20 . COMM REGN ADDR 00039000
SVC 33 . * 00040000
.SYSC1 ANOP 00041000
AIF ('&ITEM(1)' NE 'SYSCOM' OR N'&ITEM NE 2).PIBTBL 00042000
&DNM SETC 'SYSCOM' 00043000
&A1 SETA 1 00044000
L &R(1),128 SETUP SYSCOM POINTER 00045000
PACK *+7(1),45(1,&R(1)) HIGHEST PARTITION *16 00046000
CLI IJBT&SYSNDX+1,0 IS THIS HIGHEST PARTITION KEY 00047000
BNL &ITEM(2) . HIGH PART. PROCESSED, EXIT 00048000
LA &R(1),0 . LAST KEY PROCESSED 00049000
IJBT&SYSNDX EQU *-2 . DISPLACEMENT MODIFIED 00050000
LA &R(1),X'10'(&R(1)) .INCREMENT TO NEXT KEY 00051000
STH &R(1),IJBT&SYSNDX . SAVE KEY FOR NEXT EXECUTION 00052000
AH &R(1),124(&BASE) . ADD PIB TBL ADDR 00053000
LH &R(1),0(&R(1)) . PARTITION COMM REGN ADDR 00054000
AGO .EXIT 00055000
.PIBTBL ANOP 00056000
AIF ('&ITEM' NE 'PIBTBL' AND '&ITEM' NE 'PIB' AND '&ITEM' NEX00057000
'PIBTSK').LUB 00058000
AIF ('&ITEM' EQ 'PIBTSK').PMB1 00059000
&DNM SETC '&ITEM' 00060000
&A1 SETA 3-K'&ITEM/4 00061000
.PIB1 ANOP 00062000
LH &R(1),90(&BASE) . PROG-INFOR-BLOCK TBL ADDR 00063000
AIF ('&ITEM' EQ 'PIBTBL').EXIT 00064000
AH &R(1),46(&BASE) . ADD CURR PROG KEY 00065000
AGO .EXIT 00066000
.PMB1 ANOP 00067000
&DNM SETC 'PIB' 00068000
&A1 SETA 3 00069000
LH &R(1),46(&BASE) . GET PROGRAM KEY 00070000
TM 53(&BASE),X'02' . IS AP SUPPORTED 00071000
BZ *+16 . NO BYPASS AP CALCULATION 00072000
LH &R(1),132(&BASE) . MAP INTO BG COMREG 00073000
L &R(1),136(&R(1)) . GET BG COMREG EXT ADDR 00074000
LH &R(1),18(&R(1)) . GET ID OF TASK RUNNING 00075000
AH &R(1),90(&BASE) . GET PAR/TASK PIB ADDRESS 00076000
AGO .EXIT 00077000
.LUB ANOP 00078000
AIF ('&ITEM' NE 'LUB' AND (K'&ITEM LT 9 OR '&ITEM'(1,7) NE 'X00079000
LUBXXX(')).SYS 00080000
&DNM SETC '&ITEM'(1,6) 00081000
&A1 SETA 4+K'&ITEM/9 00082000
AIF (N'&R LT 3 AND ('&DNM' EQ 'LUBXXX' OR &IJBFG)).ERRNUM 00083000
AIF ('&DNM' EQ 'LUBXXX').LUB2 00084000
AIF ('&FG' EQ 'INNERP').LUBP 00085000
AIF (&IJBFG).LUB1 00086000
AIF ('&FG' EQ 'INNER').LUBS 00087000
AIF (N'&R LT 3).ERRNUM 00088000
LH &R(1),74(&BASE) . ADDRESS OF NICL 00089000
SR &R(2),&R(2) . ZERO REGISTER 00090000
IC &R(2),0(&R(1)) . NUMBER OF SYSTEM LUBS 00091000
AR &R(2),&R(2) . MULTIPLY BY LENGTH OF A LUB 00092000
LH &R(1),76(&BASE) . LUB TABLE ADDRESS 00093000
AR &R(2),&R(1) . ADD LUB TABLE ADDRESS 00094000
&LUBPR SETB (1) 00095000
AGO .EXIT 00096000
.LUBS ANOP 00097000
LH &R(1),76(&BASE) . LUB TABLE ADDR 00098000
AGO .EXIT1 00099000
.LUB1 ANOP 00100000
LH &R(2),124(&BASE) . ADDRESS OF PIB EXTENSION 00101000
AH &R(2),46(&BASE) . ADD PIK 00102000
LH &R(1),2(&R(2)) . SYSTEM LUB INDEX 00103000
AR &R(1),&R(1) . MULTIPLY BY LENGTH OF A LUB 00104000
AH &R(1),76(&BASE) . ADD LUB TABLE ADDRESS 00105000
AIF ('&FG' EQ 'INNER').EXIT1 00106000
AIF (N'&R LT 3).ERRNUM 00107000
LH &R(2),74(&BASE) . ADDRESS OF NICL 00108000
ICM &R(2),2,0(&R(2)) . INSERT NR OF SYSTEM LUBS 00109000
SRL &R(2),8 . SHIFT 8 BITS 00110000
AR &R(2),&R(2) . MULTIPLY BY LENGTH OF A LUB 00111000
AR &R(2),&R(1) . ADD ADDRESS OF SYSTEM LUBS 00112000
&LUBPR SETB (1) 00113000
AGO .EXIT 00114000
.LUBP ANOP 00115000
LH &R(2),90(&BASE) . PIB TABLE ADDRESS 00116000
AH &R(2),46(&BASE) . PARTITION PIB 00117000
SR &R(1),&R(1) . ZERO REG 00118000
IC &R(1),13(&R(2)) . GET USER LUB INDEX 00119000
AR &R(1),&R(1) . MULTIPLY BY LENGTH OF A LUB 00120000
AH &R(1),76(&BASE) . ADD LUB TABLE ADDRESS 00121000
AGO .EXIT1 00122000
.LUB2 ANOP 00123000
AIF (NOT &IJBFG).LUB3 00124000
LH &R(1),124(&BASE) . 2ND PIB 00125000
LH &R(2),46(&BASE) . PROG KEY 00126000
LH &R(2),2(&R(2),&R(1)) .SYS CLASS FICL 00127000
.LUB3 ANOP 00128000
&A2 SETA K'&ITEM-8 00129000
&WKC SETC '&ITEM'(8,&A2) 00130000
LH &R(1),74(&BASE) . ADDRESS OF NICL 00131000
MVC IJBV&SYSNDX+3(1),0(&R(1)) NUMBER OF SYSTEM LUBS 00132000
SR &R(1),&R(1) 00133000
IC &R(1),7(&WKC) . LOGIC UNIT NUMBER WITHIN CLAS 00134000
TM 6(&WKC),X'01' . IS BIT FOR PROGR.CLASS ON 00135000
BNO IJBW&SYSNDX . BR, IF SYSTEM CLASS 00136000
IJBV&SYSNDX EQU * 00137000
LA &R(1),0(&R(1)) . INCR BY NO. OF SYS LUBS 00138000
IJBW&SYSNDX EQU * 00139000
AIF (NOT &IJBFG).LUB4 00140000
AR &R(1),&R(2) . ADD SYS CLASS FICL 00141000
.LUB4 ANOP 00142000
AR &R(1),&R(1) . MULT BY LNG OF LUB ENTRY 00143000
AH &R(1),76(&BASE) . ADD LUB TBL ADDR 00144000
AGO .EXIT 00145000
.SYS ANOP 00146000
AIF ('&ITEM'(1,3) NE 'SYS' OR K'&ITEM LT 6).ERROI 00147000
&DNM SETC '&ITEM'(1,6) 00148000
&A2 SETA 0-1 00149000
.SYS1 ANOP 00150000
AIF (&A2 GE 19).SYSPRG 00151000
&A2 SETA &A2+1 00152000
AIF ('RDRIPTPCHLSTLOGLNKRESSLBRLBUSERECCLBVISCATZZZZZZZZZZZZX00153000
ZZZZZZ'(3*&A2+1,3) NE '&ITEM'(4,3)).SYS1 00154000
AGO .SECT 00155000
.SYSPRG ANOP 00156000
AIF (&A2 GE 35).ERROI 00157000
&A2 SETA &A2+1 00158000
AIF ('000001002003004005006007008009010011012013014XXX'(3*(&X00159000
A2-20)+1,3) NE '&ITEM'(4,3)).SYS1 00160000
.SECT ANOP 00161000
&A1 SETA 20+&A2 00162000
.LAB ANOP 00163000
AIF (N'&R LT 3).ERRNUM 00164000
AIF ('&DNM' EQ 'SYSXXX').SYS2 00165000
AIF ('&DNM' EQ 'SYSZZZ').ERROI 00166000
AIF (&A2 GT 19).PRG 00167000
AIF (&IJBFG).THREGS 00168000
SYSIR (&R(2),SYSCOM(&BASE)),LUB,INNER 00169000
AGO .FNDLUB 00170000
.THREGS ANOP 00171000
SYSIR (&R(2),&R(1),SYSCOM(&BASE)),LUB,INNER 00172000
.FNDLUB ANOP 00173000
SR &R(1),&R(1) 00174000
IC &R(1),&A2*2(&R(2)) .PUB NO. FROM LUB 00175000
AGO .SYS3 00176000
.PRG ANOP 00177000
&A2 SETA &A2-20 00178000
SYSIR (&R(2),&R(1),SYSCOM(&BASE)),LUB,INNERP 00179000
AGO .FNDLUB 00180000
.SYS2 ANOP 00181000
&A1 SETA 55 00182000
AIF (K'&ITEM LT 9).ERROI 00183000
&A2 SETA K'&ITEM-8 00184000
&WKC SETC '&ITEM'(8,&A2) 00185000
SYSIR (&R(2),&R(1),SYSCOM(&BASE)),LUBXXX(&WKC),INNER 00186000
SR &R(1),&R(1) . CLEAR REGISTER 00187000
IC &R(1),0(&R(2)) . PUB NO. FROM LUB 00188000
.SYS3 ANOP 00189000
SLL &R(1),3 . MULT BY LENGTH OF PUB 00190000
AH &R(1),64(&BASE) . ADD PUB TABLE ADDRESS 00191000
.EXIT ANOP 00192000
AIF ('&FG' EQ 'INNER' OR '&DNM' EQ '' OR '&FG' EQ 'INNERP').X00193000
EXIT1 00194000
SPACE 1 00195000
USING &DNM,&R(1) 00196000
SPACE 1 00197000
AIF (NOT &LUBPR).EXITA 00198000
USING LUBPR,&R(2) 00199000
SPACE 1 00200000
.EXITA ANOP 00201000
&IJBSID(&A1) SETB (1) 00202000
.EXIT1 ANOP 00203000
MEXIT 00204000
.NON ANOP 00205000
MNOTE *,'IBM COMPONENT EXPANSION' 00206000
AIF ('&FG' EQ 'BG' OR '&FG' EQ 'FG' OR T'&FG EQ 'O' OR &IJBSX00207000
INO).NFG1 00208000
MNOTE 1,'INVALID FG OPERAND' 00209000
.NFG1 ANOP 00210000
&IJBFG SETB ('&FG' EQ 'FG' OR &IJBFG) 00211000
&IJBSINO SETB (1) 00212000
CNOP 0,4 00213000
&NAME STM 2,5,*+8 . SAVE REGS 00214000
B *+20 00215000
IJBU&SYSNDX DC 4F'0' . SAVE AREA 00216000
AIF (T'&R EQ 'O').ERROR 00217000
AIF ('&R'(1,1) EQ '(').NA1 00218000
L 5,=A(&R) . AREA ADDRESS 00219000
AGO .NA2 00220000
.NA1 ANOP 00221000
AIF ('&R(1)' EQ '5').NA2 00222000
LR 5,&R(1) . AREA ADDRESS 00223000
.NA2 ANOP 00224000
L 4,20 . COMMUNICATION REGION ADDRESS 00225000
SVC 33 * 00226000
AIF (T'&ITEM EQ 'O').ERROI 00227000
&A1 SETA 1 00228000
.NLUB ANOP 00229000
AIF (K'&ITEM(&A1) LT 9 OR '&ITEM(&A1)'(1,7) NE 'LUBXXX(').NSX00230000
YS 00231000
SYSIR (2,3,SYSCOM(4)),&ITEM(&A1),INNER 00232000
MVC &A2.(2,5),0(2) . MOVE LOGICAL UNIT BLOCK TO AREA 00233000
&A2 SETA &A2+2 00234000
AGO .NITEM1 00235000
.NSYS ANOP 00236000
AIF ('&ITEM(&A1)'(1,3) NE 'SYS' OR K'&ITEM(&A1) LT 6).ERROI 00237000
&A3 SETA 0-2 00238000
.ZY ANOP 00239000
AIF (&A3 GE 3*13).A3B 00240000
&A3 SETA &A3+3 00241000
AIF ('RDRIPTPCHLSTLOGLNKRESSLBRLBUSERECCLBVISCAT'(&A3,3) NE X00242000
'&ITEM(&A1)'(4,3)).ZY 00243000
AGO .A3C 00244000
.A3B ANOP 00245000
&A3 SETA 0-2 00246000
.A3D ANOP 00247000
AIF (&A3 GE 3*15).ERROI 00248000
&A3 SETA &A3+3 00249000
AIF ('000001002003004005006007008009010011012013014XXX'(&A3,X00250000
3) NE '&ITEM(&A1)'(4,3)).A3D 00251000
.A3C ANOP 00252000
SYSIR (2,3,SYSCOM(4)),&ITEM(&A1),INNER 00253000
MVC &A2.(8,5),0(2) . MOVE PHYSICAL UNIT BLOCK 00254000
&A2 SETA &A2+8 00255000
.NITEM1 ANOP 00256000
&A1 SETA &A1+1 00257000
AIF (&A1 LE N'&ITEM).NLUB 00258000
LM 2,5,IJBU&SYSNDX . RESTORE REGISTERS 00259000
MEXIT 00260000
.DSECT ANOP 00261000
AIF (NOT &IJBSID(1)).DSE2 00262000
&IJBSID(1) SETB (0) 00263000
SYSCOM DSECT , PARTITION COMMUNICATION REGION 00264000
COMJDATE DS CL8 000 JOB DATE 00265000
COMBGAD DS H 008 RESERVED 00266000
COMSAD DS H 010 RESERVED 00267000
COMPPARA DS CL11 012 PROB PROG SCRATCH AREA 00268000
COMUPSI DS X 023 UPSI FLAGS 00269000
COMJNAM DS CL8 024 JOB NAME 00270000
COMHIPAR DS F 032 END OF PARTITION CORE 00271000
COMHIPHS DS F 036 END OF LAST PROB PROG PHAS LOAD 00272000
COMHIPRG DS F 040 END OF LONGEST PROB PROG PHAS 00273000
COMLBLL DS H 044 LNG OF LBL AREA IN PROB PROG 00274000
COMPIK DS H 046 PROGRAM INTERRUPT KEY 00275000
COMHICOR DS F 048 END OF VIRTUAL STORAGE 00276000
COMCONFG DS X 052 MACHINE CONFIGURATION 00277000
COMSP EQU X'80' STORAGE PROTECTION 00278000
COMDEC EQU X'40' DECIMAL ARITHMETIC 00279000
COMFP EQU X'20' FLOATING POINT 00280000
COMTIMER EQU X'08' TIMER 00281000
COMCHSW EQU X'04' CHANNEL SWITCHABLE DEVICE SUPPORT 00282000
COMBMPX EQU X'02' BURST/MULTIPLEX DEVICE SUPPORT 00283000
COMFOPT DS X 053 FUNCTIONAL OPTIONS 00284000
COMDMY EQU X'80' DATE CONFIGURATION IS DD/MM/YY 00285000
COMMPS EQU X'40' MULTIPROGRAMMING SUPPORT 00286000
COMDASDF EQU X'20' DASD FILE PROTECTION 00287000
COMDASDS EQU X'10' DASD SYSTEM INPUT/OUTPUT FILES 00288000
COMTP EQU X'08' TELEPROCESSING SUPPORT 00289000
COMBJF EQU X'04' BATCH JOB FOREGROUND SUPPORT 00290000
COMSTDJC DS XL2 054 STD JOB CONTROL SWITCHES 00291000
COMJCSW0 DS X 056 JOB CONTROL SWITCHES 1ST BYTE 00292000
COMJCSW1 DS X 057 JOB CONTROL SWITCHES 2ND BYTE 00293000
COMJCSW2 DS X 058 JOB CONTROL SWITCHES 3RD BYTE 00294000
COMJCSW3 DS X 059 JOB CONTROL SWITCHES 4TH BYTE 00295000
COMLBLCY DS XL2 060 DISK ADDR OF LBL CARD CYLINDER 00296000
COMFOCL DS H 062 ADDR OF FIRST-ON-CHANNEL-LIST 00297000
COMPUB DS H 064 ADDR OF PHYSICAL-UNIT-BLK TBL 00298000
COMFAVP DS H 066 ADDR OF JIB FREE LIST POINTER 00299000
COMJIB DS H 068 ADDR OF JOB-INFORMATION-BLK TBL 00300000
COMTEB DS H 070 ADDR OF TAPE-ERROR-BLK TBL 00301000
COMFICL DS H 072 ADDR OF FIRST-IN-CLASS-LIST TBL 00302000
COMNICL DS H 074 ADDR OF NO.-IN-CLASS-LIST TBL 00303000
COMLUB DS H 076 ADDR OF LOGICAL-UNIT-BLK TBL 00304000
COMLINE DS X 078 SYSLST LINE COUNT 00305000
COMSDATE DS CL9 079 SYSTEM DATE 00306000
COMLIOCS DS XL2 088 LOGICAL IOCS SWITCHES 00307000
COMPIB DS H 090 ADDR OF PROGRAM-INFORMATION-BLK 00308000
COMCKPT DS H 092 CHECK POINT SERIAL NUMBER 00309000
COMZONE DS H 094 JOB ZONE IN MINUTES 00310000
COMDIB DS H 096 ADDR OF DISK-INFORMATION-BLK TB 00311000
DS H 098 RESERVED 00312000
COMPC DS H 100 ADDR OF PROG CK SET EXIT TBL 00313000
COMIT DS H 102 ADDR OF INTEVAL TIMER SET EXIT 00314000
COMOC DS H 104 ADDR OF OPERATOR COMM SET EXIT 00315000
COMTKEY DS H 106 KEY OF INTERVAL TIMER PROG 00316000
DS H 108 RESERVED 00317000
COMLTK DS H 110 LOGICAL TRANSIENT KEY 00318000
COMPARM DS F 112 ADDRESS OF SYSPARM FIELD 00319000
COMACCT DS F 116 POINTER TO JA PART TABLE 00320000
COMTOD DS F 120 ADDR OF TOD CLOCK COMM AREA 00321000
COMPIB2 DS H 124 ADDR OF 2ND PART OF PIB TBL 00322000
COMMICR DS H 126 ADDR OF MICR DTF TBL 00323000
COMQTAM DS F 128 ADDR OF QTAM VECTOR TBL 00324000
COMBG DS H 132 ADDR OF BG COMM REGION 00325000
COMOPT DS X 134 OPTION INDICATOR BYTE 00326000
COMRMSR DS X 135 SYSTEM CONFIG B 2/RMSR OPEN 00327000
DS F 136 RESERVED 00328000
COMSTND DS X 140 STANDARD OPTIONS 00329000
COMTEMP DS X 141 TEMPORARY OPTIONS 00330000
COMDISK DS X 142 DISK CONFIG BYTE 00331000
SPACE 2 00332000
.DSE2 ANOP 00333000
AIF (NOT &IJBSID(2)).DSE3 00334000
&IJBSID(2) SETB (0) 00335000
PIBTBL DSECT , PROGRAM-INFORMATION-BLOCK TABLE 00336000
SPACE 1 00337000
PIBTFLG EQU 0 * DISPLACEMENT TO TASK SELECT FLG 00338000
PIBTRSV EQU X'80' FLAG ALWAYS ON 00339000
PIBTQ EQU X'08' QTAM TASK INHIBIT FLAG 00340000
PIBTPRIV EQU X'04' PRIVILEGED SELECT FLAG (SUPVR/SEIZE) 00341000
PIBTNOT2 EQU X'02' NOT SVC 2 BOUND FLAG 00342000
PIBTNOT7 EQU X'01' NOT SVC 7 BOUND FLAG 00343000
PIBTCAN EQU 1 * DISPLACEMENT TO CANCEL FLAGS 00344000
PIBTID EQU 2 * DISPLACEMENT TO SYSLOG ID 00345000
PIBTINST EQU 4 * DISPLACEMENT TO SAVE AREA ADDR 00346000
PIBTRID EQU 8 * ROUTINE IDENT.FOR GATING 00347000
PIBTSAV2 EQU 9 * SYSTEM SAVE AREA 00348000
PIBTAFLG EQU 12 * DISPLACEMENT TO AUXILIARY FLAGS 00349000
PIBTRES EQU X'80' ALLOW WRITE ON SYSRES FLAG 00350000
PIBTCHAP EQU X'40' ALLOW CHANNEL APPENDAGE FLAG 00351000
PIBTPFIC EQU 13 * DSPLCMT TO PROB PROG LUB FICL 00352000
PIBTPNIC EQU 14 * DSPLCMT TO PROB PROG LUB NICL 00353000
PIBTBFLG EQU 15 * DSPLCMT TO 2ND AUXILIARY FLAGS 00354000
PIBTBJF EQU X'80' BATCH-JOB-FOREGROUND IN OPERATION 00355000
SPACE 2 00356000
.DSE3 ANOP 00357000
AIF (NOT &IJBSID(3)).DSE4 00358000
&IJBSID(3) SETB (0) 00359000
PIB DSECT , PROGRAM INFORMATION BLOCK 00360000
PIBFLG DS X 0 TASK SELECTION FLAGS 00361000
PIBRSV EQU X'80' FLAG ALWAYS ON 00362000
PIBQ EQU X'08' QTAM TASK INHIBIT FLAG 00363000
PIBPRIV EQU X'04' PRIVILEGED SELECT FLAG (SUPVR/SEIZE) 00364000
PIBNOT2 EQU X'02' NOT SVC 2 BOUND FLAG 00365000
PIBNOT7 EQU X'01' NOT SVC 7 BOUND FLAG 00366000
PIBCAN DS X 1 CANCEL FLAGS 00367000
PIBID DS XL2 2 SYSLOG ID 00368000
PIBINST DS F 4 SAVE AREA ADDR 00369000
PIBRID DS X 8 IDENTIFIER FOR GATING 00370000
PIBSAV2 DS XL3 9 SYSTEM SAVE AREA ADDRESS 00371000
PIBAFLG DS X 12 AUXILIARY FLAGS 00372000
PIBRES EQU X'80' ALLOW WRITE ON SYSRES FLAG 00373000
PIBCHAP EQU X'40' ALLOW CHANNEL APPENDAGE FLAG 00374000
PIBPFICL DS X 13 PROB PROG LUB CLASS FICL 00375000
PIBPNICL DS X 14 PROD PROG LUB CLASS NICL 00376000
PIBBFLG DS X 15 2ND AUXILIARY FLAGS 00377000
PIBBJF EQU X'80' BATCH-JOB-FOREGROUND IN OPERATION 00378000
SPACE 2 00379000
.DSE4 ANOP 00380000
AIF (NOT &IJBSID(4)).DSE5 00381000
&IJBSID(4) SETB (0) 00382000
LUB DSECT , SYSTEM LUBS FOR PARTITION 00383000
SPACE 1 00384000
LUBRDR DS XL2 . LUB FOR SYSRDR 00385000
LUBIPT DS XL2 . LUB FOR SYSIPT 00386000
LUBPCH DS XL2 . LUB FOR SYSPCH 00387000
LUBLST DS XL2 . LUB FOR SYSLST 00388000
LUBLOG DS XL2 . LUB FOR SYSLOG 00389000
LUBLNK DS XL2 . LUB FOR SYSLNK 00390000
LUBRES DS XL2 . LUB FOR SYSRES 00391000
LUBSLB DS XL2 . LUB FOR SYSSLB 00392000
LUBRLB DS XL2 . LUB FOR SYSRLB 00393000
LUBUSE DS XL2 . LUB FOR SYSUSE 00394000
LUBREC DS XL2 . LUB FOR SYSREC 00395000
LUBCLB DS XL2 . LUB FOR SYSCLB 00396000
LUBVIS DS XL2 . LUB FOR SYSVIS 00397000
LUBCAT DS XL2 . LUB FOR SYSCAT 00398000
SPACE 2 00399000
LUBPR DSECT , PROGRAMMER LUBS FOR PART 00400000
SPACE 1 00401000
&A2 SETA 0-1 00402000
.DSE42 ANOP 00403000
&A2 SETA &A2+1 00404000
&DNM SETC 'LUB'.'000001002003004005006007008009010011012013014'(3*X00405000
&A2+1,3) 00406000
&DNM DS XL2 00407000
AIF (&A2 LT 14).DSE42 00408000
SPACE 1 00409000
LUBP EQU 0 . DSPLCMT TO PUB POINTER 00410000
LUBJ EQU 1 . DSPLCMT TO JIB POINTER 00411000
LUBL EQU *-LUB014 . LUB LENGTH 00412000
SPACE 2 00413000
.DSE5 ANOP 00414000
AIF (NOT &IJBSID(5)).DSE20 00415000
&IJBSID(5) SETB (0) 00416000
LUBXXX DSECT , LOGICAL UNIT BLOCK 00417000
LUBXXXP DS X . PUB POINTER 00418000
LUBXXXJ DS X . JIB POINTER 00419000
LUBXXXL EQU *-LUBXXX . LNG OF LUB 00420000
SPACE 2 00421000
.DSE20 ANOP 00422000
&A2 SETA 0-1 00423000
.DSE201 ANOP 00424000
AIF (&A2 GE 19).SYSOUT 00425000
&A2 SETA &A2+1 00426000
&DNM SETC 'SYS'.'RDRIPTPCHLSTLOGLNKRESSLBRLBUSERECCLBVISCATZZZZZZZX00427000
ZZZZZZZZZZZ'(3*&A2+1,3) 00428000
AGO .RESET 00429000
.SYSOUT ANOP 00430000
AIF (&A2 GE 35).DSEOUT 00431000
&A2 SETA &A2+1 00432000
&DNM SETC 'SYS'.'000001002003004005006007008009010011012013014XXX'X00433000
(3*(&A2-20)+1,3) 00434000
.RESET ANOP 00435000
AIF (NOT &IJBSID(&A2+20)).DSE201 00436000
&IJBSID(&A2+20) SETB (0) 00437000
&DNM DSECT , PUB FOR SPECIFIED LOGICAL UNIT 00438000
&DNM.A DS H . DEVICE ADDRESS -- X'CUU' 00439000
&DNM.Q DS X . CHANN QUEUE POINTER 00440000
&DNM.E DS X . RETRY COUNTER OR TEB POINTER 00441000
&DNM.T DS X . DEVICE TYPE 00442000
&DNM.O DS X . DEVICE OPTIONS (TAPE MODE) 00443000
&DNM.C DS X . CHANN SCHED FLAGS 00444000
&DNM.J DS X . JOB CONTROL FLAGS 00445000
&DNM.L EQU *-&DNM LNG OF PHYSICAL UNIT BLK 00446000
SPACE 2 00447000
AGO .DSE201 00448000
.DSEOUT ANOP 00449000
&SYSECT CSECT 00450000
MEXIT 00451000
.ERRNUM ANOP 00452000
MNOTE 3,'NOT ENOUGH REGISTERS' 00453000
MEXIT 00454000
.ERROI ANOP 00455000
MNOTE 3,'INVALID ITEM OPERAND' 00456000
MEXIT 00457000
.ERROR ANOP 00458000
MNOTE 3,'INVALID FIRST OPERAND' 00459000
MEXIT 00460000
.END ANOP 00461000
MEND 00462000