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