TITLE 'AKJLKL01 - LINK/LOADGO PROMPTER' 00010000 LCLA &T,&SPN 0001 00020000 .@001 ANOP 0001 00030000 AKJLKL01 CSECT , 0001 00040000 STM @E,@C,12(@D) 0001 00050000 BALR @8,0 0001 00060000 @PSTART DS 0H 0001 00070000 USING @PSTART+00000,@8 0001 00080000 LA @9,4095(0,@8) 0001 00090000 USING @PSTART+04095,@9 0001 00100000 LA @B,4095(0,@9) 0001 00110000 USING @PSTART+08190,@B 0001 00120000 L @0,@SIZ001 0001 00130000 GETMAIN R,LV=(0) 0001 00140000 LR @C,@1 0001 00150000 USING @DATD+00000,@C 0001 00160000 LM @0,@1,20(@D) 0001 00170000 XC @TEMPS(@L),@TEMPS 0001 00180000 ST @D,@SAV001+4 0001 00190000 LA @F,@SAV001 0001 00200000 ST @F,8(0,@D) 0001 00210000 LR @D,@F 0001 00220000 L @1,4(@D) 00230000 L @1,24(@1) 00240000 DS 0H 00250000 * CPPLPTR = R1; 00260000 ST @1,MSGPARM+104 0067 00270000 * GENERATE; 00280000 GETMAIN R,LV=296,SP=0 STORAGE FOR PASSED PARMS Y01018 00290000 DS 0H 00300000 * BASE=R1; 00310000 ST @1,BASE 0069 00320000 * PTR1=ADDR(VALREG); 00330000 LA @F,VALREG 0070 00340000 ST @F,MSGPARM+96 0070 00350000 * PTR1->BASEREG(1)=R8; /* SAVE 1ST BASE REG. ZA02180* 00360000 LR @1,@F MSGPARM 0071 00370000 ST @8,0(0,@1) 0071 00380000 * PTR1->BASEREG(2)=R9; /* SAVE 2ND BASE REG. ZA02180* 00390000 ST @9,4(0,@1) 0072 00400000 * PTR1->BASEREG(3)=R11; /* SAVE 3RD BASE REG. ZA02180* 00410000 ST @B,8(0,@1) 0073 00420000 * PTR1->DATAREG=R12; /* SAVE DATA BASE REGISTER. * 00430000 ST @C,12(0,@1) 0074 00440000 * DDNMS(1)='00'X; /* ZERO DDNAMES * 00450000 L @3,BASE 0075 00460000 MVI 18(@3),X'00' 0075 00470000 * DDNMS(2:96)=DDNMS(1:95); /* ZERO DDNAMES * 00480000 MVC 19(95,@3),18(@3) 0076 00490000 * DDPTR=ADDR(DDLEN); /* SET POINTER TO DDNAMELIST * 00500000 LA @F,16(0,@3) 0077 00510000 ST @F,292(0,@3) 0077 00520000 * DDLEN=96; /* SET LENGTH OF DDNAMELIST * 00530000 LA @F,96 0078 00540000 STH @F,16(0,@3) 0078 00550000 * ENDBIT='1'B; /* SET END INDICATOR * 00560000 OI 292(@3),B'10000000' 0079 00570000 * OPTPTR=ADDR(OPLEN); /* SET POINTER TO OPTIONLIST * 00580000 LA @F,114(0,@3) 0080 00590000 ST @F,288(0,@3) 0080 00600000 * OPLIST=' '; /* INIT. OPTION LIST * 00610000 MVI 116(@3),C' ' 0081 00620000 MVC 117(159,@3),116(@3) 0081 00630000 * CONCAT=ADDR(DSCONC); /* SET POINTER TO CONCAT.LIST * 00640000 ST @3,284(0,@3) 0082 00650000 * INPT=BLANKS; /* INIT.INPUT DDNAME TO BLANK * 00660000 MVC 0(8,@3),BLANKS 0083 00670000 * LIBY=BLANKS; /* INIT. LIB DDNAME TO BLANK * 00680000 MVC 8(8,@3),BLANKS 0084 00690000 * LKLD='LINK'; /* SET CODE FOR LINK. EDITOR * 00700000 MVC 276(4,@3),@C4 0085 00710000 * IF CODEBYT='FF'X /* WAS LOADGO ENTERED? * 00720000 * THEN DO; /* YES - RESET CODE * 00730000 CLI MSGPARM+104,X'FF' 0086 00740000 BC 07,@9FF 0086 00750000 * LKLD='LOAD'; /* SET CODE FOR LOADER * 00760000 MVC 276(4,@3),@C6 0088 00770000 * CODEBYT='00'X; /* ZERO OUT HIGH BYTE * 00780000 MVI MSGPARM+104,X'00' 0089 00790000 * END; 00800000 * CPECB=0; 00810000 @9FF SR @F,@F 0091 00820000 ST @F,MSGPARM+100 0091 00830000 * DOT='.'; /* SET PERIOD IN QUALIFIER * 00840000 MVI A00001,C'.' 0092 00850000 * TMPPTR=CPPLPTR; /* SET POINTER FROM TMP * 00860000 L @1,BASE 0093 00870000 MVC 280(4,@1),MSGPARM+104 0093 00880000 * DEFNME=' '; /* INIT. DEFAULT DSNAME * 00890000 MVI DEFAULT+2,C' ' 0094 00900000 MVC DEFAULT+3(43),DEFAULT+2 0094 00910000 * DEFLEN=0; /* INIT. DEFAULT A43146 00920000 * DSNAME LENGTH * 00930000 SR @F,@F 0095 00940000 STH @F,DEFAULT 0095 00950000 * DEFMEM=' '; /* INIT. DEFAULT A43146 00960000 * MEMBER NAME * 00970000 MVI DEFAULT+46,C' ' 0096 00980000 MVC DEFAULT+47(7),DEFAULT+46 0096 00990000 * LSTPTR=ADDR(MSGPARM); /* SET PARM. LIST POINTER * 01000000 LA @F,MSGPARM 0097 01010000 ST @F,LSTPTR 0097 01020000 * CSNAME='&CS0'; /* SET L.E. CON. NAME * 01030000 MVC CSNAME(4),@C8 0098 01040000 * EXADD=ADDR(ABEX); /* SET ADDRESS OF EXIT * 01050000 LA @F,ABEX 0099 01060000 ST @F,STAEL 0099 01070000 * PRMADD=ADDR(VALREG); /* SET PTR. TO SAVE PARMS * 01080000 LA @F,VALREG 0100 01090000 ST @F,STAEL+4 0100 01100000 * GEN(ESTAE MF=(E,STAEL)); /* CREATE STAE BLOCK ZM02759 * 01110000 ESTAE MF=(E,STAEL) 01120000 DS 0H 01130000 * /* ******************************************************** * 01140000 * /* SET UP STANDARD DAIR PARAMETERS * 01150000 * /* ******************************************************** * 01160000 * DAPLPTR=ADDR(DAIRL); /* SET LIST POINTER * 01170000 LA @F,DAIRL 0102 01180000 ST @F,DAPLPTR 0102 01190000 * DAPLUPT=CPPLUPT; /* SET UPT POINTER IN LIST * 01200000 L @1,MSGPARM+104 MSGPARM 0103 01210000 LR @3,@F 0103 01220000 MVC 0(4,@3),4(@1) 0103 01230000 * DAPLECT=CPPLECT; /* SET ECT POINTER IN LIST * 01240000 MVC 4(4,@3),12(@1) 0104 01250000 * DAPLECB=ADDR(CPECB); /* SET ECB POINTER IN LIST * 01260000 LA @F,MSGPARM+100 0105 01270000 ST @F,8(0,@3) 0105 01280000 * DAPLPSCB=CPPLPSCB; /* SET POINTER TO PSCB * 01290000 MVC 12(4,@3),8(@1) 0106 01300000 * DAPB0PTR=ADDR(DAIR08); /* SET POINTER TO X'08' BLOCK * 01310000 LA @F,DAIR08 0107 01320000 ST @F,MSGPARM 0107 01330000 * DA08CD='0008'X; /* SET X'08' CODE - ALLOCATION* 01340000 LR @6,@F 0108 01350000 MVC 0(2,@6),@X9 0108 01360000 * DAPB0PTR=ADDR(DAIR0C); /* SET POINTER TO X'0C' BLOCK * 01370000 LA @F,DAIR0C 0109 01380000 ST @F,MSGPARM 0109 01390000 * GEN(XC DAIR0C(212),DAIR0C); /* ZERO OUT BLOCK * 01400000 XC DAIR0C(212),DAIR0C 01410000 DS 0H 01420000 * DA0CCD='000C'X; /* SET X'0C' CODE - CONCAT. * 01430000 L @1,MSGPARM 0111 01440000 MVC 0(2,@1),@X10 0111 01450000 * DAPB1PTR=ADDR(DAIR1C); /* SET POINTER TO X'1C' BLOCK * 01460000 LA @F,DAIR1C 0112 01470000 ST @F,DAPB1PTR 0112 01480000 * GEN(XC DAIR1C(24),DAIR1C); /* ZERO OUT BLOCK OY00691 * 01490000 XC DAIR1C(24),DAIR1C 01500000 DS 0H 01510000 * DA1CCD='001C'X; /* SET X'1C' CODE - TERM. ALL.* 01520000 L @1,DAPB1PTR 0114 01530000 MVC 0(2,@1),@X11 0114 01540000 * DA1CDDN=BLANKS; /* BLANK OUT DDNAME * 01550000 MVC 8(8,@1),BLANKS 0115 01560000 * DA1CALN=BLANKS; /*BLNK OUT ATTR NAME OY00691 * 01570000 MVC 16(8,@1),BLANKS 0116 01580000 * DAPB0PTR=ADDR(DAIR04); /* SET POINTER TO X'04' BLOCK * 01590000 LA @F,DAIR04 0117 01600000 ST @F,MSGPARM 0117 01610000 * DA04CD='0004'X; /* SET X'04' CODE - SEARCH DSE* 01620000 LR @6,@F 0118 01630000 MVC 0(2,@6),@X12 0118 01640000 * DAPB1PTR=ADDR(DAIR18); /* SET POINTER TO X'18' BLOCK * 01650000 LA @F,DAIR18 0119 01660000 ST @F,DAPB1PTR 0119 01670000 * DA18CD='0018'X; /* SET X'18' CODE - UNALLOC. * 01680000 LR @1,@F 0120 01690000 MVC 0(2,@1),@X13 0120 01700000 * DAPB2PTR=ADDR(DAIR28); /* PTR TO X'28' BLK OY00691 * 01710000 LA @F,DAIR28 0121 01720000 ST @F,DAPB2PTR 0121 01730000 * GEN(XC DAIR28(16),DAIR28); /* CLEAR BLOCK OY00691 * 01740000 XC DAIR28(16),DAIR28 01750000 DS 0H 01760000 * DA28CD='0028'X; /* SET X'28' CODE OY00691 * 01770000 L @1,DAPB2PTR 0123 01780000 MVC 0(2,@1),@X14 0123 01790000 * /* - MULTIPLE OPS OY00691 * 01800000 * DA28NOP='0002'X; /* SET 2 OPS OY00691 * 01810000 MVC 2(2,@1),@X15+2 0124 01820000 * DA28OPTR(1)=ADDR(DAIR34); /* PT TO X'34' BLOCK OY00691 * 01830000 LA @F,DAIR34 0125 01840000 ST @F,8(0,@1) 0125 01850000 * DA28OPTR(2)=ADDR(DAIR1C); /* PT TO X'1C' BLOCK OY00691 * 01860000 LA @F,DAIR1C 0126 01870000 ST @F,12(0,@1) 0126 01880000 * DAPB3PTR=ADDR(DAIR34); /* PTR TO X'34' BLK OY00691 * 01890000 LA @F,DAIR34 0127 01900000 ST @F,DAPB3PTR 0127 01910000 * GEN(XC DAIR34(20),DAIR34); /* CLEAR BLOCK OY00691 * 01920000 XC DAIR34(20),DAIR34 01930000 DS 0H 01940000 * DA34CD='0034'X; /* SET X'34' CODE OY00691 * 01950000 L @1,DAPB3PTR 0129 01960000 MVC 0(2,@1),@X16 0129 01970000 * /* - ASSIGN ATTRS OY00691 * 01980000 * DA34CHN='1'B; /* INDICATE ASSIGN OY00691 * 01990000 OI 6(@1),B'01000000' 0130 02000000 * DA34NAME='LKLDATTR'; /* SET ATTR NAME OY00691 * 02010000 MVC 8(8,@1),@C17 0131 02020000 * DA34ADDR=ADDR(DAIRATCB); /* PT TO ATTR BLK OY00691 * 02030000 LA @F,DAIRATCB 0132 02040000 ST @F,16(0,@1) 0132 02050000 * DACBPTR=ADDR(DAIRATCB); /* PTR TO ATTR BLK OY00691 * 02060000 LA @F,DAIRATCB 0133 02070000 ST @F,DACBPTR 0133 02080000 * GEN(XC DAIRATCB(47),DAIRATCB); /* CLEAR BLOCK OY00691 * 02090000 XC DAIRATCB(47),DAIRATCB 02100000 DS 0H 02110000 * DAIBUFNO='02'X; /* 2 BUFFERS OY00691 * 02120000 L @1,DACBPTR 0135 02130000 MVI 24(@1),X'02' 0135 02140000 * DAIBUFL=81; /* 81 BYTE BUFFERS OY00691 * 02150000 LA @F,81 0136 02160000 STH @F,26(0,@1) 0136 02170000 * DAIRECFM='9C'X; /* REC FORMAT FBSA OY00691 * 02180000 MVI 36(@1),X'9C' 0137 02190000 * DAIBLKSI=81; /* 81 BYTE BLOCKS OY00691 * 02200000 LA @F,81 0138 02210000 STH @F,38(0,@1) 0138 02220000 * DAILRECL=81; /* 81 BYTE RECORDS OY00691 * 02230000 STH @F,40(0,@1) 0139 02240000 * DAINCP='02'X; /* 2 CHAN PGMS OY00691 * 02250000 MVI 42(@1),X'02' 0140 02260000 * /* ******************************************************** * 02270000 * /* SET UP PARSE PARAMETERS AND GO TO PARSE. * 02280000 * /* ******************************************************** * 02290000 * PPLPTR = ADDR(PARSEL); 02300000 LA @F,PARSEL 0141 02310000 ST @F,PPLPTR 0141 02320000 * PPLUPT = CPPLUPT; 02330000 L @7,MSGPARM+104 MSGPARM 0142 02340000 LR @4,@F 0142 02350000 MVC 0(4,@4),4(@7) 0142 02360000 * PPLECT= CPPLECT; 02370000 MVC 4(4,@4),12(@7) 0143 02380000 * PPLCBUF = CPPLCBUF; 02390000 MVC 20(4,@4),0(@7) 0144 02400000 * PPLECB = ADDR(CPECB); 02410000 LA @F,MSGPARM+100 0145 02420000 ST @F,8(0,@4) 0145 02430000 * PPLUWA = ADDR(VALREG); 02440000 LA @F,VALREG 0146 02450000 ST @F,24(0,@4) 0146 02460000 * IF LKLD='LINK' /* LINK INVOKED OY00686 * 02470000 * THEN PPLPCL=LKADCON; /* SET UP FOR LINK OY00686 * 02480000 L @5,BASE 0147 02490000 CLC 276(4,@5),@C4 0147 02500000 BC 07,@9FE 0147 02510000 MVC 12(4,@4),LKADCON 0148 02520000 BC 15,@9FD 0149 02530000 * ELSE PPLPCL=LDADCON; /* SET UP FOR LOAD OY00686 * 02540000 @9FE MVC 12(4,@4),LDADCON 0149 02550000 * PPLANS=ADDR(PDLPTR); 02560000 @9FD LA @F,PDLPTR 0150 02570000 ST @F,16(0,@4) 0150 02580000 * GEN(LOAD EP=IKJDAIR); /* LOAD THE DAIR ALLOCATION * 02590000 LOAD EP=IKJDAIR 02600000 DS 0H 02610000 * /* ROUTINE * 02620000 * R1 = PPLPTR; 02630000 L @1,PPLPTR 0152 02640000 * PROMPTM=1; /* SET INDICATOR TO PROMPT * 02650000 LA @F,1 0153 02660000 STH @F,MSGPARM+4 0153 02670000 * /* MODE * 02680000 * GEN(LINK EP=IKJPARS); /* GO TO PARSE * 02690000 LINK EP=IKJPARS 02700000 DS 0H 02710000 * RCODE=R15; /* SET RETURN CODE * 02720000 STH @F,MSGPARM+6 0155 02730000 * IF RCODE ^= 0 /* RETURN CODE =0 ? * 02740000 * THEN DO; 02750000 SR @F,@F 0156 02760000 CH @F,MSGPARM+6 0156 02770000 BC 08,@9FC 0156 02780000 * ERRCODE=2; /* SET TERMINAL ERROR CODE * 02790000 LA @F,2 0158 02800000 STH @F,MSGPARM+8 0158 02810000 * GO TO FINIS; /* TERMINATE * 02820000 BC 15,FINIS 0159 02830000 * END; 02840000 * PROMPTM=0; /* SET PRMPT MODE EQUAL TO NO * 02850000 @9FC SR @F,@F 0161 02860000 STH @F,MSGPARM+4 0161 02870000 * R2=PDLPTR; 02880000 L @2,PDLPTR 0162 02890000 * /* PROCESS LOADGO PDL * 02900000 * IF LKLD='LOAD' THEN DO; /* LOADGO INVOKED * 02910000 L @1,BASE 0163 02920000 CLC 276(4,@1),@C6 0163 02930000 BC 07,@9FB 0163 02940000 * /* PROCESS LOADGO PRINT OPTION/DATA SET OY00686 * 02950000 * IF LDPRINT=2 /* IF NOPRINT OY00686 * 02960000 * THEN LDMAP=0; /* NOMAP ALSO OY00686 * 02970000 L @3,PDLPTR 0165 02980000 CLC 64(2,@3),@D1 0165 02990000 BC 07,@9FA 0165 03000000 MVC 66(2,@3),@D2 0166 03010000 * IF LDPRINT=0 /* IF NOT SPEC'D OY00686 * 03020000 * THEN IF LDMAP^=1 /*AND NOMAP OY00686 * 03030000 @9FA CLC 64(2,@3),@D2 0167 03040000 BC 07,@9F9 0167 03050000 * THEN LDPRINT=2; 03060000 CLC 66(2,@3),@D3 0168 03070000 BC 08,@9F8 0168 03080000 MVC 64(2,@3),@D1 0169 03090000 * /* SAME AS NOPRINT OY00686 * 03100000 * IF LDPRINT=1 /* IF PRINT OY00686 * 03110000 * THEN DO; /* EXAMINE PDE OY00686 * 03120000 @9F8 EQU * 0170 03130000 @9F9 L @1,PDLPTR 0170 03140000 CLC 64(2,@1),@D3 0170 03150000 BC 07,@9F7 0170 03160000 * PTR1=ADDR(LDPRNTDS); 03170000 LA @F,76(0,@1) 0172 03180000 ST @F,MSGPARM+96 0172 03190000 * /* GET TO DSN PDE OY00686 * 03200000 * IF DSF(1)='0'B & 03210000 * /* IF NO NAME OY00686 * 03220000 * MEMF(1)='0'B 03230000 * /* AND NO MEMBER OY00686 * 03240000 * THEN LDPRINT=0; 03250000 LR @3,@F MSGPARM 0173 03260000 TM 6(@3),B'10000000' 0173 03270000 BC 05,@9F6 0173 03280000 TM 14(@3),B'10000000' 0173 03290000 BC 05,@9F5 0173 03300000 MVC 64(2,@1),@D2 0174 03310000 * /* SAME AS NOPRINT OY00686 * 03320000 * END; /* OY00686 * 03330000 @9F5 EQU * 0175 03340000 @9F6 EQU * 0175 03350000 * PRINT=LDPRINT; /* SET GBL PRINT OY00686 * 03360000 @9F7 L @1,PDLPTR 0176 03370000 MVC PRINT(2),64(@1) 0176 03380000 * /* PROCESS LOADGO LIBRARY OPTION/DATA SET OY00686 * 03390000 * IF LDLIB=1 /* IF LIB OY00686 * 03400000 * THEN DO; /* EXAMINE PDE OY00686 * 03410000 CLC 44(2,@1),@D3 0177 03420000 BC 07,@9F4 0177 03430000 * PTR1=ADDR(LDLIBRDS); 03440000 LA @F,100(0,@1) 0179 03450000 ST @F,MSGPARM+96 0179 03460000 * /* GET TO DSN PDE OY00686 * 03470000 * IF DSF(1)='0'B 03480000 * /* IF NO NAME OY00686 * 03490000 * THEN LDLIB=0; 03500000 LR @3,@F MSGPARM 0180 03510000 TM 6(@3),B'10000000' 0180 03520000 BC 05,@9F3 0180 03530000 MVC 44(2,@1),@D2 0181 03540000 * /* SAME AS NOLIB OY00686 * 03550000 * END; /* OY00686 * 03560000 @9F3 EQU * 0182 03570000 * LIB=LDLIB; /* SET GBL LIB OY00686 * 03580000 @9F4 L @1,PDLPTR 0183 03590000 MVC LIB(2),44(@1) 0183 03600000 * /* PROCESS LOADGO TERM OPTION OY00686 * 03610000 * TERM=LDTERM; /* SET GBL TERM OY00686 * 03620000 MVC TERM(2),70(@1) 0184 03630000 BC 15,@9F2 0186 03640000 * END; 03650000 * /* PROCESS LINK PDL OY00686 * 03660000 * ELSE DO; /* LINK INVOKED OY00686 * 03670000 * /* PROCESS LINK PRINT OPTION/DATA SET OY00686 * 03680000 * IF LKPRINT=2 /* IF NOPRINT OY00686 * 03690000 * THEN DO; /* RESET ALL PRINT OY00686 * 03700000 @9FB L @1,PDLPTR 0187 03710000 CLC 58(2,@1),@D1 0187 03720000 BC 07,@9F1 0187 03730000 * LKMAP=0; /* NOMAP OY00686 * 03740000 MVC 60(2,@1),@D2 0189 03750000 * LKXREF=0; /* NOXREF OY00686 * 03760000 MVC 62(2,@1),@D2 0190 03770000 * LKLIST=0; /* NOLIST OY00686 * 03780000 MVC 64(2,@1),@D2 0191 03790000 * END; /* OY00686 * 03800000 * IF LKPRINT=0 /* IF NOT SPEC'D OY00686 * 03810000 * THEN IF LKMAP^=1 & 03820000 @9F1 L @1,PDLPTR 0193 03830000 CLC 58(2,@1),@D2 0193 03840000 BC 07,@9F0 0193 03850000 * /* AND NOMAP OY00686 * 03860000 * LKXREF^=1 & 03870000 * /* AND NOXREF OY00686 * 03880000 * LKLIST^=1 03890000 * /* AND NOLIST OY00686 * 03900000 * THEN LKPRINT=2; 03910000 CLC 60(2,@1),@D3 0194 03920000 BC 08,@9EF 0194 03930000 CLC 62(2,@1),@D3 0194 03940000 BC 08,@9EE 0194 03950000 CLC 64(2,@1),@D3 0194 03960000 BC 08,@9ED 0194 03970000 MVC 58(2,@1),@D1 0195 03980000 * /* SAME AS NOPRINT OY00686 * 03990000 * IF LKPRINT=1 /* IF PRINT OY00686 * 04000000 * THEN DO; /* EXAMINE PDE OY00686 * 04010000 @9ED EQU * 0196 04020000 @9EE EQU * 0196 04030000 @9EF EQU * 0196 04040000 @9F0 L @1,PDLPTR 0196 04050000 CLC 58(2,@1),@D3 0196 04060000 BC 07,@9EC 0196 04070000 * PTR1=ADDR(LKPRNTDS); 04080000 LA @F,120(0,@1) 0198 04090000 ST @F,MSGPARM+96 0198 04100000 * /* GET TO DSN PDE OY00686 * 04110000 * IF DSF(1)='0'B & 04120000 * /* IF NO NAME OY00686 * 04130000 * MEMF(1)='0'B 04140000 * /* AND NO MEMBER OY00686 * 04150000 * THEN LKPRINT=0; 04160000 LR @3,@F MSGPARM 0199 04170000 TM 6(@3),B'10000000' 0199 04180000 BC 05,@9EB 0199 04190000 TM 14(@3),B'10000000' 0199 04200000 BC 05,@9EA 0199 04210000 MVC 58(2,@1),@D2 0200 04220000 * /* SAME AS NOPRINT OY00686 * 04230000 * END; /* OY00686 * 04240000 @9EA EQU * 0201 04250000 @9EB EQU * 0201 04260000 * PRINT=LKPRINT; /* SET GBL PRINT OY00686 * 04270000 @9EC L @1,PDLPTR 0202 04280000 MVC PRINT(2),58(@1) 0202 04290000 * LKPRINT=0; /* RESET LINK PRINT OY00686 * 04300000 MVC 58(2,@1),@D2 0203 04310000 * /* PROCESS LINK LIBRARY OPTION/DATA SET OY00686 * 04320000 * IF LKLIB=1 /* IF LIB OY00686 * 04330000 * THEN DO; /* EXAMINE PDE OY00686 * 04340000 CLC 38(2,@1),@D3 0204 04350000 BC 07,@9E9 0204 04360000 * PTR1=ADDR(LKLIBRDS); 04370000 LA @F,144(0,@1) 0206 04380000 ST @F,MSGPARM+96 0206 04390000 * /* GET TO DSN PDE OY00686 * 04400000 * IF DSF(1)='0'B 04410000 * /* IF NO NAME OY00686 * 04420000 * THEN LKLIB=0; 04430000 LR @3,@F MSGPARM 0207 04440000 TM 6(@3),B'10000000' 0207 04450000 BC 05,@9E8 0207 04460000 MVC 38(2,@1),@D2 0208 04470000 * /* SAME AS NOLIB OY00686 * 04480000 * END; /* OY00686 * 04490000 @9E8 EQU * 0209 04500000 * LIB=LKLIB; /* SET GBL LIB OY00686 * 04510000 @9E9 L @1,PDLPTR 0210 04520000 MVC LIB(2),38(@1) 0210 04530000 * /* PROCESS LINK LOAD OPTION/DATA SET OY00686 * 04540000 * IF LKLOAD=1 /* IF LOAD OY00686 * 04550000 * THEN DO; /* EXAMINE PDE OY00686 * 04560000 CLC 36(2,@1),@D3 0211 04570000 BC 07,@9E7 0211 04580000 * PTR1=ADDR(LKLOADDS); 04590000 LA @F,96(0,@1) 0213 04600000 ST @F,MSGPARM+96 0213 04610000 * /* GET TO DSN PDE OY00686 * 04620000 * IF DSF(1)='0'B & 04630000 * /* IF NO NAME OY00686 * 04640000 * MEMF(1)='0'B 04650000 * /* AND NO MEMBER OY00686 * 04660000 * THEN LKLOAD=0; 04670000 LR @3,@F MSGPARM 0214 04680000 TM 6(@3),B'10000000' 0214 04690000 BC 05,@9E6 0214 04700000 TM 14(@3),B'10000000' 0214 04710000 BC 05,@9E5 0214 04720000 MVC 36(2,@1),@D2 0215 04730000 * /* SAME AS NOLOAD OY00686 * 04740000 * END; /* OY00686 * 04750000 @9E5 EQU * 0216 04760000 @9E6 EQU * 0216 04770000 * /* PROCESS LINK DCBS OPTION OY00686 * 04780000 * IF LKDCBS=1 /* IF DCBS OY00686 * 04790000 * THEN DO; /* EXAMINE PDE OY00686 * 04800000 @9E7 L @1,PDLPTR 0217 04810000 CLC 56(2,@1),@D3 0217 04820000 BC 07,@9E4 0217 04830000 * PTR1=ADDR(LKDCBSSF); 04840000 LA @F,184(0,@1) 0219 04850000 ST @F,MSGPARM+96 0219 04860000 * /* GET TO IDT PDE OY00686 * 04870000 * BEG=6-STRL; 04880000 LR @3,@F MSGPARM 0220 04890000 LH @F,4(0,@3) 0220 04900000 LCR @F,@F 0220 04910000 AH @F,@D4 0220 04920000 STH @F,BEG 0220 04930000 * /* GET NO. OF CHARS. * 04940000 * BLK1=0; 04950000 MVC BLK1(4),@D5 0221 04960000 MVI BLK1+4,C' ' 0221 04970000 * /* INIT. TO ZEROS * 04980000 * BLK1(BEG:5)=STR->CHARST(1:STRL); 04990000 L @6,MSGPARM+96 MSGPARM 0222 05000000 L @6,0(0,@6) STRING 0222 05010000 LR @E,@6 0222 05020000 LA @7,5 0222 05030000 LH @4,BEG 0222 05040000 SR @7,@4 0222 05050000 LA @A,BLK1-1(@4) 0222 05060000 EX @7,@MVC 0222 05070000 * /* MOVE IN * 05080000 * GENERATE; /* GET BLOCKSIZE IN BINARY FOR* 05090000 PACK BLK2(8),BLK1(5) 05100000 CVB @1,BLK2 GET IN BINARY FORM 05110000 ST @1,DCBSBLK 05120000 DS 0H 05130000 * END; 05140000 * /* PROCESS LINK TERM OPTION OY00686 * 05150000 * TERM=LKTERM; /* SET GBL TERM OY00686 * 05160000 @9E4 L @1,PDLPTR 0225 05170000 MVC TERM(2),90(@1) 0225 05180000 * END; /* OY00686 * 05190000 * /* ******************************************************** * 05200000 * /* ALLOCATE ALL DATA SETS * 05210000 * /* ******************************************************** * 05220000 * /* IF NECESSARY, CONCATENATE INPUT DATA SETS. * 05230000 * /* ******************************************************** * 05240000 * DAPB0PTR=ADDR(DAIR0C); /* GET ADDRESS OF 0C BLOCK * 05250000 @9F2 LA @F,DAIR0C 0227 05260000 ST @F,MSGPARM 0227 05270000 * IF DA0CNUMB > 1 THEN DO; 05280000 LA @F,1 0228 05290000 L @1,MSGPARM 0228 05300000 CH @F,8(0,@1) 0228 05310000 BC 10,@9E3 0228 05320000 * DAPLDAPB=DAPB0PTR; 05330000 L @3,DAPLPTR 0230 05340000 MVC 16(4,@3),MSGPARM 0230 05350000 * R1=DAPLPTR; 05360000 L @1,DAPLPTR 0231 05370000 * GEN(LINK EP=IKJDAIR); 05380000 LINK EP=IKJDAIR 05390000 DS 0H 05400000 * RCODE=R15; 05410000 STH @F,MSGPARM+6 0233 05420000 * IF RCODE^=0 /* ERROR OCCURRED? * 05430000 * THEN DO; /* ERROR IN CONCAT'ING * 05440000 SR @F,@F 0234 05450000 CH @F,MSGPARM+6 0234 05460000 BC 08,@9E2 0234 05470000 * CALL AKJLKMSG(LSTPTR,25); 05480000 LA @F,LSTPTR 0236 05490000 ST @F,@PL001 0236 05500000 LA @F,@D6 0236 05510000 ST @F,@PL001+4 0236 05520000 L @F,@V1 ADDRESS OF AKJLKMSG 0236 05530000 LA @1,@PL001 0236 05540000 BALR @E,@F 0236 05550000 * GO TO FINIS; 05560000 BC 15,FINIS 0237 05570000 * END; 05580000 * INPT=DA0CDDN(1); 05590000 @9E2 L @1,BASE 0239 05600000 MVC 0(8,@1),DAIR0C+12 0239 05610000 * END; 05620000 * /* ******************************************************** * 05630000 * /* MOVE IN SYSLIN DDNAME. * 05640000 * /* ******************************************************** * 05650000 * SYSLIN=DA0CDDN(1); 05660000 @9E3 L @1,BASE 0241 05670000 MVC 18(8,@1),DAIR0C+12 0241 05680000 * GEN(XC DAIR0C+2(210),DAIR0C+2); /* ZERO OUT CONCAT. BLOCK * 05690000 XC DAIR0C+2(210),DAIR0C+2 05700000 DS 0H 05710000 * /* ******************************************************** * 05720000 * /* CHECK FOR PRINT DATA SET (SYSPRINT) * 05730000 * /* ******************************************************** * 05740000 * PRNTCH: IF PRINT=2 THEN DO; /* NOPRINT SPECIFIED * 05750000 PRNTCH LA @F,2 0243 05760000 CH @F,PRINT 0243 05770000 BC 07,@9DF 0243 05780000 * IF LKLD='LOAD' /* GOING TO LOADER? * 05790000 * THEN GO TO LDCH; /* YES - SKIP SYSPRINT * 05800000 L @1,BASE 0245 05810000 CLC 276(4,@1),@C6 0245 05820000 BC 08,LDCH 0246 05830000 * /* **************************************** * 05840000 * /* ALLOCATE DUMMY DATA SET FOR SYSPRINT * 05850000 * /* **************************************** * 05860000 * DAPB0PTR=ADDR(DAIR08); 05870000 LA @F,DAIR08 0247 05880000 ST @F,MSGPARM 0247 05890000 * DAPLDAPB=DAPB0PTR; 05900000 L @3,DAPLPTR 0248 05910000 MVC 16(4,@3),MSGPARM 0248 05920000 * GEN(XC DAIR08+2(74),DAIR08+2); 05930000 XC DAIR08+2(74),DAIR08+2 05940000 DS 0H 05950000 * DA08DDN=BLANKS; /* SET DDNAME TO BLANKS* 05960000 L @1,MSGPARM 0250 05970000 MVC 12(8,@1),BLANKS 0250 05980000 * DA08SER=BLANKS; /* SET SER TO BLANKS * 05990000 MVC 28(8,@1),BLANKS 0251 06000000 * DA08UNIT=BLANKS; /* SET UNIT TO BLANKS * 06010000 MVC 20(8,@1),BLANKS 0252 06020000 * DA08PSWD=BLANKS; 06030000 MVC 60(8,@1),BLANKS 0253 06040000 * DA08MNM=BLANKS; /* BLANK MEMBER NAME YM4355 * 06050000 MVC 52(8,@1),BLANKS 0254 06060000 * DA08DMMY='1'B; /* GET DUMMY DATA SET * 06070000 OI 71(@1),B'00000100' 0255 06080000 * DA08NEW='1'B; /* ALLOCATE AS NEW, * 06090000 OI 68(@1),B'00000100' 0256 06100000 * DA08DEL='1'B; /* DELETE, * 06110000 OI 69(@1),B'00000100' 0257 06120000 * DA08DELE='1'B; /* DELETE. * 06130000 OI 70(@1),B'00000100' 0258 06140000 * R1=DAPLPTR; /* SET PARM. LIST PTR * 06150000 L @1,DAPLPTR 0259 06160000 * GEN(LINK EP=IKJDAIR); /* GO TO DAIR * 06170000 LINK EP=IKJDAIR 06180000 DS 0H 06190000 * IF R15^=0 /* CHECK RTN CDE ZM02759 * 06200000 * THEN DO; /* FOR ALLOC FAILURE ZM02759 * 06210000 LTR @F,@F 0261 06220000 BC 08,@9DE 0261 06230000 * MSG34: RCODE=R15; 06240000 MSG34 STH @F,MSGPARM+6 0263 06250000 * /* SAVE RTN CDE ZM02759 * 06260000 * CALL AKJLKMSG(LSTPTR,34); 06270000 LA @F,LSTPTR 0264 06280000 ST @F,@PL001 0264 06290000 LA @F,@D7 0264 06300000 ST @F,@PL001+4 0264 06310000 L @F,@V1 ADDRESS OF AKJLKMSG 0264 06320000 LA @1,@PL001 0264 06330000 BALR @E,@F 0264 06340000 * /* LOG MSG ON ERROR ZM02759 * 06350000 * GO TO FINIS; 06360000 BC 15,FINIS 0265 06370000 * /* THEN TERMINATE ZM02759 * 06380000 * END; /* ZM02759 * 06390000 * SYSPRNT=DA08DDN; /* MOVE IN SYSPRINT * 06400000 @9DE L @1,MSGPARM 0267 06410000 L @3,BASE 0267 06420000 MVC 58(8,@3),12(@1) 0267 06430000 * GO TO LDCH; 06440000 BC 15,LDCH 0268 06450000 * END; 06460000 * LQUAL=8; 06470000 @9DF LA @F,8 0270 06480000 STH @F,LQUAL 0270 06490000 * IF LKLD='LOAD' THEN QUAL='LOADLIST'; /* SET LOADER NAME * 06500000 L @1,BASE 0271 06510000 CLC 276(4,@1),@C6 0271 06520000 BC 07,@9DB 0271 06530000 MVC A00001+1(8),@C21 0272 06540000 BC 15,@9DA 0273 06550000 * ELSE QUAL='LINKLIST'; /* SET L. E. NAME * 06560000 @9DB MVC A00001+1(8),@C22 0273 06570000 * IF PRINT=0 06580000 * /* ***************************************************** * 06590000 * /* ALLOCATE DEFAULT PRINT DATA SET NAME * 06600000 * /* ***************************************************** * 06610000 * THEN CALL ALLOCDS('PRNT','DEFL'); 06620000 @9DA SR @F,@F 0274 06630000 CH @F,PRINT 0274 06640000 BC 07,@9D9 0274 06650000 LA @F,@C23 0275 06660000 ST @F,@PL001 0275 06670000 LA @F,@C24 0275 06680000 ST @F,@PL001+4 0275 06690000 LA @1,@PL001 0275 06700000 BAL @E,ALLOCDS 0275 06710000 * IF PRINT=1 THEN DO; 06720000 @9D9 LA @F,1 0276 06730000 CH @F,PRINT 0276 06740000 BC 07,@9D6 0276 06750000 * /* **************************************** * 06760000 * /* PRINT DATA SET WAS SPECIFIED * 06770000 * /* **************************************** * 06780000 * IF LKLD='LOAD' /* LOADGO INVOKED OY00686 * 06790000 * THEN PTR1=ADDR(LDPRNTDS); 06800000 L @1,BASE 0278 06810000 CLC 276(4,@1),@C6 0278 06820000 BC 07,@9D5 0278 06830000 L @3,PDLPTR 0279 06840000 LA @F,76(0,@3) 0279 06850000 ST @F,MSGPARM+96 0279 06860000 BC 15,@9D4 0280 06870000 * /* GET TO LOADGO PDE OY00686 * 06880000 * ELSE PTR1=ADDR(LKPRNTDS); 06890000 @9D5 L @3,PDLPTR 0280 06900000 LA @F,120(0,@3) 0280 06910000 ST @F,MSGPARM+96 0280 06920000 * /* GET TO LINK PDE OY00686 * 06930000 * IF DSN>0 & DSN->CHARST(1)='*' 06940000 * THEN DO; 06950000 @9D4 SR @F,@F 0281 06960000 L @6,MSGPARM+96 MSGPARM 0281 06970000 C @F,0(0,@6) 0281 06980000 BC 10,@9D3 0281 06990000 L @7,MSGPARM+96 MSGPARM 0281 07000000 L @7,0(0,@7) DATASET 0281 07010000 CLI 0(@7),C'*' 0281 07020000 BC 07,@9D2 0281 07030000 * /* ******************************** * 07040000 * /* ALLOCATE SYSPRINT TO TERMINAL * 07050000 * /* ******************************** * 07060000 * DAPB1PTR=ADDR(DAIR1C); /* SET PTR * 07070000 LA @F,DAIR1C 0283 07080000 ST @F,DAPB1PTR 0283 07090000 * DA1CALN='LKLDATTR'; /* OY00691 * 07100000 LR @4,@F 0284 07110000 MVC 16(8,@4),@C17 0284 07120000 * /* ASSIGN ATTR NAME OY00691 * 07130000 * DA1CATRL='1'B; /* INDIC ATTR LIST * 07140000 OI 7(@4),B'00000010' 0285 07150000 * /* PRESENT OY00691 * 07160000 * DAPLDAPB=ADDR(DAIR28); /* OY00691 * 07170000 LA @F,DAIR28 0286 07180000 L @5,DAPLPTR 0286 07190000 ST @F,16(0,@5) 0286 07200000 * /* SET DAIR POINTER OY00691 * 07210000 * R1=DAPLPTR; /* LIST PTR * 07220000 L @1,DAPLPTR 0287 07230000 * GEN(LINK EP=IKJDAIR); /*GO TO DAIR* 07240000 LINK EP=IKJDAIR 07250000 DS 0H 07260000 * IF R15^=0 /* IF ALLOC FAILS ZM02759 * 07270000 * THEN GO TO MSG34; 07280000 LTR @F,@F 0289 07290000 BC 07,MSG34 0290 07300000 * /* GO LOG MSG ZM02759 * 07310000 * DAPB3PTR=ADDR(DAIR34); /* OY00691 * 07320000 LA @F,DAIR34 0291 07330000 ST @F,DAPB3PTR 0291 07340000 * /* PT TO X'34' BLK OY00691 * 07350000 * DA34UNCH='1'B; /* OY00691 * 07360000 LR @1,@F 0292 07370000 OI 6(@1),B'00100000' 0292 07380000 * /* INDICATE UNASSIGN OY00691 * 07390000 * DA34CHN='0'B; /* OY00691 * 07400000 NI 6(@1),B'10111111' 0293 07410000 * /* DEINDICATE ASSIGN OY00691 * 07420000 * DAPLDAPB=ADDR(DAIR34); /* OY00691 * 07430000 LA @F,DAIR34 0294 07440000 ST @F,16(0,@5) 0294 07450000 * /* SET DAIR PTR OY00691 * 07460000 * R1=DAPLPTR; /* OY00691 * 07470000 L @1,DAPLPTR 0295 07480000 * /* SET PARAM REG OY00691 * 07490000 * GEN(LINK EP=IKJDAIR); /* OY00691 * 07500000 LINK EP=IKJDAIR 07510000 DS 0H 07520000 * /* CALL DAIR OY00691 * 07530000 * SYSPRNT=DA1CDDN; /* SYSPRINT * 07540000 L @1,BASE 0297 07550000 MVC 58(8,@1),8(@4) 0297 07560000 * /* CANCEL TERM OPTION IF OY00686 * 07570000 * /* SYSPRINT IS TERMINAL OY00686 * 07580000 * TERM=0; /* ZM00619 * 07590000 SR @F,@F 0298 07600000 STH @F,TERM 0298 07610000 * IF LKLD='LOAD' /* IF LOADGO OY00686 * 07620000 * THEN LDTERM=0; 07630000 CLC 276(4,@1),@C6 0299 07640000 BC 07,@9D1 0299 07650000 MVC 70(2,@3),@D2 0300 07660000 BC 15,@9D0 0301 07670000 * /* RESET LOADGO OPT OY00686 * 07680000 * ELSE LKTERM=0; 07690000 @9D1 MVC 90(2,@3),@D2 0301 07700000 * /* RESET LINK OPT OY00686 * 07710000 * GO TO LDCH; /* NEXT DS. * 07720000 BC 15,LDCH 0302 07730000 * END; 07740000 * /* **************************************** * 07750000 * /* ALLOCATE SPECIFIED PRINT DATA SET. * 07760000 * /* **************************************** * 07770000 * CALL ALLOCDS('PRNT','NODF'); 07780000 @9D2 EQU * 0304 07790000 @9D3 LA @F,@C23 0304 07800000 ST @F,@PL001 0304 07810000 LA @F,@C26 0304 07820000 ST @F,@PL001+4 0304 07830000 LA @1,@PL001 0304 07840000 BAL @E,ALLOCDS 0304 07850000 * END; 07860000 * /* ******************************************************** * 07870000 * /* MOVE IN SYSPRINT DDNAME * 07880000 * /* ******************************************************** * 07890000 * SYSPRNT=DA08DDN; 07900000 @9D6 L @1,MSGPARM 0306 07910000 L @3,BASE 0306 07920000 MVC 58(8,@3),12(@1) 0306 07930000 * /* ******************************************************** * 07940000 * /* CHECK FOR LOAD DATA SET ( SYSLMOD) * 07950000 * /* ******************************************************** * 07960000 * LDCH: QUAL='LOAD '; /* SET LOAD MODULE QULIFIER * 07970000 LDCH MVC A00001+1(8),@C27 0307 07980000 * LQUAL=4; /* SET LENGTH OF QUALIFIER * 07990000 LA @F,4 0308 08000000 STH @F,LQUAL 0308 08010000 * IF LKLD='LOAD' /* GOING TO LOADER? * 08020000 * THEN GO TO LIBCH; /* YES - GO DO LIBRARY DS. * 08030000 L @1,BASE 0309 08040000 CLC 276(4,@1),@C6 0309 08050000 BC 08,LIBCH 0310 08060000 * IF LKLOAD=1 THEN DO; /* OY00686 * 08070000 L @3,PDLPTR 0311 08080000 CLC 36(2,@3),@D3 0311 08090000 BC 07,@9CD 0311 08100000 * /* ***************************************** * 08110000 * /* ALLOCATE SPECIFIED LOAD DATA SET * 08120000 * /* ***************************************** * 08130000 * PTR1=ADDR(LKLOADDS); /* OY00686 * 08140000 LA @F,96(0,@3) 0313 08150000 ST @F,MSGPARM+96 0313 08160000 * CALL ALLOCDS('LOAD','NODF'); 08170000 LA @F,@C6 0314 08180000 ST @F,@PL001 0314 08190000 LA @F,@C26 0314 08200000 ST @F,@PL001+4 0314 08210000 LA @1,@PL001 0314 08220000 BAL @E,ALLOCDS 0314 08230000 * END; 08240000 * IF LKLOAD=0 /* OY00686 * 08250000 * /* ***************************************** * 08260000 * /* DEFAULT NAME FOR SYSLMOD REQUIRED. * 08270000 * /* ***************************************** * 08280000 * /* SET DSNAME, DSLENGTH,MEMBERNAME FOR ALLOC * 08290000 * /* * 08300000 * THEN DO; /* SET UP DEFAULT SYSLMOD NAME * 08310000 @9CD L @1,PDLPTR 0316 08320000 CLC 36(2,@1),@D2 0316 08330000 BC 07,@9CA 0316 08340000 * PTR1=ADDR(LKLOADDS); /* NULL PDE ENTRY ADDR * 08350000 LA @F,96(0,@1) 0318 08360000 ST @F,MSGPARM+96 0318 08370000 * /* OY00686,SA50095 * 08380000 * CALL ALLOCDS('LOAD','DEFL'); 08390000 LA @F,@C6 0319 08400000 ST @F,@PL001 0319 08410000 LA @F,@C24 0319 08420000 ST @F,@PL001+4 0319 08430000 LA @1,@PL001 0319 08440000 BAL @E,ALLOCDS 0319 08450000 * END; 08460000 * /* ******************************************************** * 08470000 * /* MOVE IN SYSLMOD DDNAME AND MEMBER NAME * 08480000 * /* ******************************************************** * 08490000 * SYSLMOD=DA08DDN; 08500000 @9CA L @1,MSGPARM 0321 08510000 L @3,BASE 0321 08520000 MVC 34(8,@3),12(@1) 0321 08530000 * MEMBER=DA08MNM; 08540000 MVC 26(8,@3),52(@1) 0322 08550000 * /* ******************************************************** * 08560000 * /* ALLOCATE SYSUT1 AND MOVE IN DDNAME * 08570000 * /* ******************************************************** * 08580000 * SYSUT: DSNLNGTH=7; /* SET DATA SET LENGTH * 08590000 SYSUT LA @F,7 0323 08600000 L @1,MSGPARM+92 MSGPARM 0323 08610000 STH @F,0(0,@1) 0323 08620000 * DSNM=' '; 08630000 MVI 2(@1),C' ' 0324 08640000 MVC 3(43,@1),2(@1) 0324 08650000 * DSNM(1:7)='&SYSUT1'; 08660000 MVC 2(7,@1),@C28 0325 08670000 * CALL ALLOCDS('UTIL','UTIL'); /* GO ALLOCATE DATA SET * 08680000 LA @F,@C29 0326 08690000 ST @F,@PL001 0326 08700000 ST @F,@PL001+4 0326 08710000 LA @1,@PL001 0326 08720000 BAL @E,ALLOCDS 0326 08730000 * SYSUT1=DA08DDN; /* MOVE IN UTILITY DATA SET * 08740000 L @1,MSGPARM 0327 08750000 L @3,BASE 0327 08760000 MVC 74(8,@3),12(@1) 0327 08770000 * /* ******************************************************** * 08780000 * /* CHECK FOR LIBRARY DATA SETS (SYSLIB) * 08790000 * /* ******************************************************** * 08800000 * LIBCH: DAPB0PTR=ADDR(DAIR0C); 08810000 LIBCH LA @F,DAIR0C 0328 08820000 ST @F,MSGPARM 0328 08830000 * IF LIB=1 THEN DO; 08840000 LA @F,1 0329 08850000 CH @F,LIB 0329 08860000 BC 07,@9C5 0329 08870000 * /* ****************************************** * 08880000 * /* LIBRARY DATA SET(S) SPECIFIED. * 08890000 * /* ****************************************** * 08900000 * IF LKLD='LOAD' /* IF LOADGO OY00686 * 08910000 * THEN PTR1=ADDR(LDLIBRDS); 08920000 L @1,BASE 0331 08930000 CLC 276(4,@1),@C6 0331 08940000 BC 07,@9C4 0331 08950000 L @3,PDLPTR 0332 08960000 LA @F,100(0,@3) 0332 08970000 ST @F,MSGPARM+96 0332 08980000 BC 15,@9C3 0333 08990000 * /* GET TO LOADGO PDE OY00686 * 09000000 * ELSE PTR1=ADDR(LKLIBRDS); 09010000 @9C4 L @3,PDLPTR 0333 09020000 LA @F,144(0,@3) 0333 09030000 ST @F,MSGPARM+96 0333 09040000 * /* GET TO LINK PDE OY00686 * 09050000 * NXT: CALL ALLOCDS('LIBR','NODF'); 09060000 @9C3 EQU * 0334 09070000 NXT LA @F,@C30 0334 09080000 ST @F,@PL001 0334 09090000 LA @F,@C26 0334 09100000 ST @F,@PL001+4 0334 09110000 LA @1,@PL001 0334 09120000 BAL @E,ALLOCDS 0334 09130000 * PTR1=NEXT; 09140000 L @1,MSGPARM+96 MSGPARM 0335 09150000 MVC MSGPARM+96(4),24(@1) 0335 09160000 * IF PTR1^='FF000000'X THEN GO TO NXT; 09170000 L @F,@X31 0336 09180000 C @F,MSGPARM+96 0336 09190000 BC 07,NXT 0337 09200000 * END; 09210000 * /* ******************************************************** * 09220000 * /* ALLOCATE SYSTEM LIBRARIES * 09230000 * /* ******************************************************** * 09240000 * IF LKLD='LOAD' /* LOADGO INVOKED OY00686 * 09250000 * THEN DO; /* SET UP LOAD PARMS OY00686 * 09260000 @9C5 L @1,BASE 0339 09270000 CLC 276(4,@1),@C6 0339 09280000 BC 07,@9C0 0339 09290000 * PTR1=ADDR(LDLIBRDS); /* PT TO DUMMY PDE OY00686 * 09300000 L @3,PDLPTR 0341 09310000 LA @F,100(0,@3) 0341 09320000 ST @F,MSGPARM+96 0341 09330000 * PTR3=ADDR(LDPLI); /* GET TO LOADGO PDE OY00686 * 09340000 LA @F,46(0,@3) 0342 09350000 ST @F,PTR3 0342 09360000 BC 15,@9BF 0344 09370000 * END; /* OY00686 * 09380000 * ELSE DO; /* SET UP LINK PARMS OY00686 * 09390000 * PTR1=ADDR(LKLIBRDS); /* PT TO DUMMY PDE OY00686 * 09400000 @9C0 L @1,PDLPTR 0345 09410000 LA @F,144(0,@1) 0345 09420000 ST @F,MSGPARM+96 0345 09430000 * PTR3=ADDR(LKPLI); /* GET TO LINK PDE OY00686 * 09440000 LA @F,40(0,@1) 0346 09450000 ST @F,PTR3 0346 09460000 * END; /* OY00686 * 09470000 * DSF(2)='0'B; /* SET NOT QUALIFIED FLAG * 09480000 @9BF L @1,MSGPARM+96 MSGPARM 0348 09490000 NI 6(@1),B'10111111' 0348 09500000 * DO I=1 TO 6; /* CHECK FOR EACH LIB OY00686 * 09510000 LA @F,1 0349 09520000 STH @F,I 0349 09530000 * IF LIBS(I)=1 /* I-TH LIBRARY SPEC.? * 09540000 * THEN DO; /* YES - ALLOCATE IT * 09550000 @DO9BE LA @F,1 0350 09560000 LH @1,I 0350 09570000 BCTR @1,0 0350 09580000 SLA @1,1 0350 09590000 L @3,PTR3 0350 09600000 CH @F,0(@1,@3) 0350 09610000 BC 07,@9BA 0350 09620000 * IF I=1 | I=3 | I=6 /* PL1LIB OR COBLIB? OY00686 * 09630000 * THEN DSNLNGTH=11; /* YES - SET LENGTH * 09640000 CH @F,I 0352 09650000 BC 08,@9B9 0352 09660000 LA @F,3 0352 09670000 CH @F,I 0352 09680000 BC 08,@9B8 0352 09690000 LA @F,6 0352 09700000 CH @F,I 0352 09710000 BC 07,@9B7 0352 09720000 @9B8 EQU * 0353 09730000 @9B9 LA @F,11 0353 09740000 L @1,MSGPARM+92 MSGPARM 0353 09750000 STH @F,0(0,@1) 0353 09760000 BC 15,@9B6 0354 09770000 * ELSE DSNLNGTH=12; /* NO - SET LENGTH * 09780000 @9B7 LA @F,12 0354 09790000 L @1,MSGPARM+92 MSGPARM 0354 09800000 STH @F,0(0,@1) 0354 09810000 * DSNM=' '; 09820000 @9B6 L @1,MSGPARM+92 MSGPARM 0355 09830000 MVI 2(@1),C' ' 0355 09840000 MVC 3(43,@1),2(@1) 0355 09850000 * DSNM(1:5)='SYS1.'; /* SET FIRST PART OF NAME * 09860000 MVC 2(5,@1),@C32 0356 09870000 * DSNM(6:12)=LIBNMS(I); /* SET LAST PART OF NAME * 09880000 LH @3,I 0357 09890000 MH @3,@D8 0357 09900000 LA @E,LIBNMS-7(@3) 0357 09910000 MVC 7(7,@1),0(@E) 0357 09920000 * CALL ALLOCDS('LIBR','SYSL'); /* ALLOCATE LIBRARY * 09930000 LA @F,@C30 0358 09940000 ST @F,@PL001 0358 09950000 LA @F,@C33 0358 09960000 ST @F,@PL001+4 0358 09970000 LA @1,@PL001 0358 09980000 BAL @E,ALLOCDS 0358 09990000 * END; 10000000 * END; /* END OF LOOP * 10010000 * DAPB0PTR=ADDR(DAIR0C); 10020000 @9BA LH @F,I 0360 10030000 AH @F,@D3 0360 10040000 @DO9BD STH @F,I 0360 10050000 CH @F,@D4 0360 10060000 BC 12,@DO9BE 0360 10070000 LA @F,DAIR0C 0361 10080000 ST @F,MSGPARM 0361 10090000 * IF DA0CNUMB>1 THEN DO; 10100000 LA @F,1 0362 10110000 L @1,MSGPARM 0362 10120000 CH @F,8(0,@1) 0362 10130000 BC 10,@9B3 0362 10140000 * /* ************************************* * 10150000 * /* CONCATENATE LIBRARY DATA SETS * 10160000 * /* ************************************* * 10170000 * DAPLDAPB=DAPB0PTR; 10180000 L @3,DAPLPTR 0364 10190000 MVC 16(4,@3),MSGPARM 0364 10200000 * R1=DAPLPTR; 10210000 L @1,DAPLPTR 0365 10220000 * GEN(LINK EP=IKJDAIR); 10230000 LINK EP=IKJDAIR 10240000 DS 0H 10250000 * RCODE=R15; 10260000 STH @F,MSGPARM+6 0367 10270000 * IF RCODE > 0 10280000 * THEN DO; /* ERROR IN CONCAT'ING * 10290000 SR @F,@F 0368 10300000 CH @F,MSGPARM+6 0368 10310000 BC 10,@9B2 0368 10320000 * CALL AKJLKMSG(LSTPTR,26); 10330000 LA @F,LSTPTR 0370 10340000 ST @F,@PL001 0370 10350000 LA @F,@D9 0370 10360000 ST @F,@PL001+4 0370 10370000 L @F,@V1 ADDRESS OF AKJLKMSG 0370 10380000 LA @1,@PL001 0370 10390000 BALR @E,@F 0370 10400000 * GO TO FINIS; 10410000 BC 15,FINIS 0371 10420000 * END; 10430000 * LIBY=DA0CDDN(1); 10440000 @9B2 L @1,BASE 0373 10450000 MVC 8(8,@1),DAIR0C+12 0373 10460000 * END; 10470000 * /* ******************************************************** * 10480000 * /* MOVE IN DDNAME FOR SYSLIB IF ANY LIBRARY DATA SETS * 10490000 * /* WERE SPECIFIED. * 10500000 * /* ******************************************************** * 10510000 * IF DA0CNUMB^=0 THEN SYSLIB=DA0CDDN(1); 10520000 @9B3 SR @F,@F 0375 10530000 L @1,MSGPARM 0375 10540000 CH @F,8(0,@1) 0375 10550000 BC 08,@9AF 0375 10560000 L @3,BASE 0376 10570000 MVC 42(8,@3),DAIR0C+12 0376 10580000 * /* ******************************************************** * 10590000 * /* ALLOCATE SYSTERM IF TERM WAS SPECIFIED * 10600000 * /* ******************************************************** * 10610000 * IF TERM=1 /* TERM SPECIFIED? * 10620000 * THEN DO; /* YES - ALLOC. SYSTERM * 10630000 @9AF LA @F,1 0377 10640000 CH @F,TERM 0377 10650000 BC 07,@9AE 0377 10660000 * DAPB1PTR=ADDR(DAIR1C); /* SET PARM. BLOCK POINTER * 10670000 LA @F,DAIR1C 0379 10680000 ST @F,DAPB1PTR 0379 10690000 * DAPLDAPB=ADDR(DAIR1C); /* SET PARM. BLOCK POINTER * 10700000 LA @F,DAIR1C 0380 10710000 L @3,DAPLPTR 0380 10720000 ST @F,16(0,@3) 0380 10730000 * R1=DAPLPTR; /* SET PARM. LIST POINTER * 10740000 L @1,DAPLPTR 0381 10750000 * GEN(LINK EP=IKJDAIR); /* GO TO DAIR * 10760000 LINK EP=IKJDAIR 10770000 DS 0H 10780000 * IF R15^=0 /* IF ALLOC FAILURE ZM02759 * 10790000 * THEN GO TO MSG34; /* GO LOG MSG ZM02759 * 10800000 LTR @F,@F 0383 10810000 BC 07,MSG34 0384 10820000 * SYSTERM=DA1CDDN; 10830000 L @1,DAPB1PTR 0385 10840000 L @6,BASE 0385 10850000 MVC 106(8,@6),8(@1) 0385 10860000 * END; 10870000 * /* ******************************************************** * 10880000 * /* GATHER OPTIONS * 10890000 * /* ******************************************************** * 10900000 * BEG=1; /* SET BEGINNING OF STRING * 10910000 @9AE LA @F,1 0387 10920000 STH @F,BEG 0387 10930000 * IF LKLD='LOAD' /* LOADGO INVOKED OY00686 * 10940000 * THEN DO; /* SET FOR LOADGO OY00686 * 10950000 L @1,BASE 0388 10960000 CLC 276(4,@1),@C6 0388 10970000 BC 07,@9AD 0388 10980000 * K=9; /* PARAM COUNT OY00686 * 10990000 LA @F,9 0390 11000000 STH @F,K 0390 11010000 * PTR3=ADDR(LDSIZE); /* PDE PARAM ARRAY OY00686 * 11020000 L @3,PDLPTR 0391 11030000 LA @F,58(0,@3) 0391 11040000 ST @F,PTR3 0391 11050000 BC 15,@9AC 0393 11060000 * END; /* OY00686 * 11070000 * ELSE DO; /* SET FOR LINK OY00686 * 11080000 * K=22; /* PARAM COUNT OY00686 * 11090000 @9AD LA @F,22 0394 11100000 STH @F,K 0394 11110000 * PTR3=ADDR(LKSIZE); /* PDE PARAM ARRAY OY00686 * 11120000 L @1,PDLPTR 0395 11130000 LA @F,52(0,@1) 0395 11140000 ST @F,PTR3 0395 11150000 * END; /* OY00686 * 11160000 * DO J=1 TO K; /* LOOK AT OPTIONS OY00686 * 11170000 @9AC LA @F,1 0397 11180000 BC 15,@DO9AA 0397 11190000 * I=J; /* GET OPTION INDEX * 11200000 @DO9AB MVC I(2),J 0398 11210000 * IF PARMS(I)=0 /* IS OPTION SPECIFIED? * 11220000 * THEN GO TO EL1; /* NO - CONTINUE LOOP * 11230000 SR @F,@F 0399 11240000 LH @1,I 0399 11250000 BCTR @1,0 0399 11260000 SLA @1,1 0399 11270000 L @3,PTR3 0399 11280000 CH @F,0(@1,@3) 0399 11290000 BC 08,EL1 0400 11300000 * IF PARMS(I)=2 /* OBVERSE OPTION SPEC.? * 11310000 * THEN DO; /* YES * 11320000 LA @F,2 0401 11330000 CH @F,0(@1,@3) 0401 11340000 BC 07,@9A7 0401 11350000 * IF LKLD='LINK' /* LINK. ED. SPEC.? * 11360000 * THEN GO TO EL1; /* YES - CONTINUE LOOP * 11370000 L @6,BASE 0403 11380000 CLC 276(4,@6),@C4 0403 11390000 BC 08,EL1 0404 11400000 * OPLIST(BEG:BEG+1)='NO'; /* ADD NO TO LIST * 11410000 LH @7,BEG 0405 11420000 LA @A,115(@7,@6) 0405 11430000 MVC 0(2,@A),@C26 0405 11440000 * BEG=BEG+2; /* RESET BEGINNING OF STRING * 11450000 LA @F,2 0406 11460000 AH @F,BEG 0406 11470000 STH @F,BEG 0406 11480000 * END; 11490000 * MOPT: IF LKLD='LOAD' /* LOADGO INVOKED OY00686 * 11500000 * THEN DO; /* SET FOR LOADGO OY00686 * 11510000 @9A7 EQU * 0408 11520000 MOPT L @1,BASE 0408 11530000 CLC 276(4,@1),@C6 0408 11540000 BC 07,@9A6 0408 11550000 * OPTSTPTR=ADDR(LDOPTS(I)); /* PT TO CHARS OY00686 * 11560000 LH @3,I 0410 11570000 MH @3,@D10 0410 11580000 LA @F,LDOPTS-5(@3) 0410 11590000 ST @F,OPTSTPTR 0410 11600000 * N=LDLNGTHO(I); /* GET OPTION LENGTH * 11610000 LH @6,I 0411 11620000 SLA @6,1 0411 11630000 LH @F,LDLNGTHO-2(@6) 0411 11640000 STH @F,N 0411 11650000 BC 15,@9A5 0413 11660000 * /* OY00691,OY00686 * 11670000 * END; /* OY00686 * 11680000 * ELSE DO; /* SET FOR LINK OY00686 * 11690000 * OPTSTPTR=ADDR(LKOPTS(I)); /* PT TO CHARS OY00686 * 11700000 @9A6 LH @1,I 0414 11710000 MH @1,@D4 0414 11720000 LA @F,LKOPTS-6(@1) 0414 11730000 ST @F,OPTSTPTR 0414 11740000 * N=LKLNGTHO(I); /* GET OPTION LENGTH * 11750000 LH @3,I 0415 11760000 SLA @3,1 0415 11770000 LH @F,LKLNGTHO-2(@3) 0415 11780000 STH @F,N 0415 11790000 * /* OY00691,OY00686 * 11800000 * END; /* OY00686 * 11810000 * ENDD=BEG+N-1; /* GET END OF STRING * 11820000 @9A5 LH @F,@D11 0417 11830000 AH @F,N 0417 11840000 AH @F,BEG 0417 11850000 STH @F,ENDD 0417 11860000 * OPLIST(BEG:ENDD)=OPTSTPTR->CHARST(1:N); 11870000 L @1,OPTSTPTR 0418 11880000 LR @E,@1 0418 11890000 LR @3,@F 0418 11900000 LH @6,BEG 0418 11910000 SR @3,@6 0418 11920000 L @7,BASE 0418 11930000 LA @A,115(@6,@7) 0418 11940000 EX @3,@MVC 0418 11950000 * /* MOVE IN OPTION OY00686 * 11960000 * BEG=ENDD+1; /* RESET BEGINNING OF STRING * 11970000 LA @F,1 0419 11980000 AH @F,ENDD 0419 11990000 STH @F,BEG 0419 12000000 * IF I > 3 /* PARAMETER NEEDED? * 12010000 * THEN GO TO COMM; /* NO - ADD COMMA & CONTINUE * 12020000 LA @F,3 0420 12030000 CH @F,I 0420 12040000 BC 04,COMM 0421 12050000 * IF I=1 /* SIZE OPTION? * 12060000 * THEN DO; /* YES - ADD PARAMETER * 12070000 LA @F,1 0422 12080000 CH @F,I 0422 12090000 BC 07,@9A4 0422 12100000 * IF LKLD='LINK' /* LINK. ED. SPECIFIED? * 12110000 * THEN DO; /* YES - ADD PAREN. * 12120000 CLC 276(4,@7),@C4 0424 12130000 BC 07,@9A3 0424 12140000 * PTR1=ADDR(LKSIZESF); 12150000 L @3,PDLPTR 0426 12160000 LA @F,172(0,@3) 0426 12170000 ST @F,MSGPARM+96 0426 12180000 * /* GET ADDRESS OF PDE OY00686 * 12190000 * OPLIST(BEG)='('; 12200000 LH @6,BEG 0427 12210000 LA @A,115(@6,@7) 0427 12220000 MVI 0(@A),C'(' 0427 12230000 * BEG=BEG+1; /* RESET BEGINNING OF STRING * 12240000 LA @F,1 0428 12250000 AH @F,BEG 0428 12260000 STH @F,BEG 0428 12270000 BC 15,@9A2 0430 12280000 * END; 12290000 * ELSE PTR1=ADDR(LDSIZESF); 12300000 @9A3 L @1,PDLPTR 0430 12310000 LA @F,128(0,@1) 0430 12320000 ST @F,MSGPARM+96 0430 12330000 * /* GET ADDRESS OF PDE OY00686 * 12340000 * END; 12350000 @9A2 EQU * 0431 12360000 * IF I=2 /* EP SPECIFIED? OY00686 * 12370000 * THEN IF LKLD='LOAD' /* AC SPECIFIED? Y01018 * 12380000 @9A4 LA @F,2 0432 12390000 CH @F,I 0432 12400000 BC 07,@9A1 0432 12410000 * THEN PTR1=ADDR(LDEPSF); 12420000 L @1,BASE 0433 12430000 CLC 276(4,@1),@C6 0433 12440000 BC 07,@9A0 0433 12450000 L @3,PDLPTR 0434 12460000 LA @F,136(0,@3) 0434 12470000 ST @F,MSGPARM+96 0434 12480000 BC 15,@99F 0435 12490000 * /* GET ADDR OF STR OY00686 * 12500000 * ELSE PTR1=ADDR(LKACSF); 12510000 @9A0 L @3,PDLPTR 0435 12520000 LA @F,192(0,@3) 0435 12530000 ST @F,MSGPARM+96 0435 12540000 * /* GET ADDR OF STR Y01018 * 12550000 * ELSE; 12560000 @9A1 EQU * 0436 12570000 * IF I=3 /* NAME OR DCBS SPECIFIED? OY00686,OZ01255 * 12580000 * THEN IF LKLD='LOAD' /* SEPARATE BY CMD OZ01255 * 12590000 @99E LA @F,3 0437 12600000 CH @F,I 0437 12610000 BC 07,@99D 0437 12620000 * THEN PTR1=ADDR(LDNAMESF); /* GET ADDR OF STR OY00686 * 12630000 L @1,BASE 0438 12640000 CLC 276(4,@1),@C6 0438 12650000 BC 07,@99C 0438 12660000 L @3,PDLPTR 0439 12670000 LA @F,144(0,@3) 0439 12680000 ST @F,MSGPARM+96 0439 12690000 * ELSE GO TO COMM; /* TAKE DCBS OZ01255,OZ02521 * 12700000 * INS: ENDD=BEG+STRL-1; /* GET END OF STRING * 12710000 @99B EQU * 0441 12720000 @99D EQU * 0441 12730000 INS LH @F,@D11 0441 12740000 L @1,MSGPARM+96 MSGPARM 0441 12750000 AH @F,4(0,@1) 0441 12760000 AH @F,BEG 0441 12770000 STH @F,ENDD 0441 12780000 * OPLIST(BEG:ENDD)=STR->CHARST(1:STRL); /* MOVE PARAMETER * 12790000 L @3,MSGPARM+96 MSGPARM 0442 12800000 L @3,0(0,@3) STRING 0442 12810000 LR @E,@3 0442 12820000 LR @6,@F 0442 12830000 LH @7,BEG 0442 12840000 SR @6,@7 0442 12850000 L @4,BASE 0442 12860000 LA @A,115(@7,@4) 0442 12870000 EX @6,@MVC 0442 12880000 * BEG=ENDD+1; /* RESET BEGINNING OF STRING * 12890000 LA @F,1 0443 12900000 AH @F,ENDD 0443 12910000 STH @F,BEG 0443 12920000 * IF I=1 & LKLD='LINK' /* SIZE FOR LINK. ED.? * 12930000 * THEN DO; /* YES - ADD PAREN. * 12940000 LA @F,1 0444 12950000 CH @F,I 0444 12960000 BC 07,@99A 0444 12970000 CLC 276(4,@4),@C4 0444 12980000 BC 07,@999 0444 12990000 * IF NSTRNG^='FF000000'X /* ANOTHER ITEM? * 13000000 * THEN DO; 13010000 L @F,@X31 0446 13020000 C @F,8(0,@1) 0446 13030000 BC 08,@998 0446 13040000 * OPLIST(BEG)=','; /* ADD COMMA * 13050000 LH @5,BEG 0448 13060000 LA @A,115(@5,@4) 0448 13070000 MVI 0(@A),C',' 0448 13080000 * BEG=BEG+1; 13090000 LA @F,1 0449 13100000 AH @F,BEG 0449 13110000 STH @F,BEG 0449 13120000 * PTR1=NSTRNG; 13130000 MVC MSGPARM+96(4),8(@1) 0450 13140000 * GO TO INS; 13150000 BC 15,INS 0451 13160000 * END; 13170000 * OPLIST(BEG)=')'; 13180000 @998 LH @1,BEG 0453 13190000 L @3,BASE 0453 13200000 LA @A,115(@1,@3) 0453 13210000 MVI 0(@A),C')' 0453 13220000 * BEG=BEG+1; /* RESET BEGINNING OF STRING * 13230000 LA @F,1 0454 13240000 AH @F,BEG 0454 13250000 STH @F,BEG 0454 13260000 * END; 13270000 * COMM: OPLIST(BEG)=','; /* ADD COMMA AFTER OPTION * 13280000 @999 EQU * 0456 13290000 @99A EQU * 0456 13300000 COMM LH @1,BEG 0456 13310000 L @3,BASE 0456 13320000 LA @A,115(@1,@3) 0456 13330000 MVI 0(@A),C',' 0456 13340000 * BEG=BEG+1; 13350000 LA @F,1 0457 13360000 AH @F,BEG 0457 13370000 STH @F,BEG 0457 13380000 * EL1: END; /* END OF OPTION LOOP * 13390000 * IF LKLD='LOAD' /* LOADER TO BE INVOKED? * 13400000 * THEN DO; /* YES - SEE IF PROG. PARMS. * 13410000 EL1 LH @F,J 0458 13420000 AH @F,@D3 0458 13430000 @DO9AA STH @F,J 0458 13440000 CH @F,K 0458 13450000 BC 12,@DO9AB 0458 13460000 L @1,BASE 0459 13470000 CLC 276(4,@1),@C6 0459 13480000 BC 07,@997 0459 13490000 * PTR1=ADDR(LDPARAM); /* GET ADDR OF PARAM OY00686 * 13500000 L @3,PDLPTR 0461 13510000 LA @F,36(0,@3) 0461 13520000 ST @F,MSGPARM+96 0461 13530000 * IF STRF(1)='0'B | /* PARM PRESENT OR ZA01419 * 13540000 * STRL=0 /* PARM NULL ZA01419 * 13550000 * THEN GO TO EL2; /* NO - CONTINUE * 13560000 LR @6,@F MSGPARM 0462 13570000 TM 6(@6),B'10000000' 0462 13580000 BC 08,@996 0462 13590000 SR @F,@F 0462 13600000 CH @F,4(0,@6) 0462 13610000 BC 08,EL2 0463 13620000 * BEG=BEG-1; /* REMOVE COMMA * 13630000 @995 LH @F,BEG 0464 13640000 BCTR @F,0 0464 13650000 STH @F,BEG 0464 13660000 * OPLIST(BEG)='/'; /* ADD SLASH BEFORE PARMS. * 13670000 LR @1,@F 0465 13680000 L @3,BASE 0465 13690000 LA @A,115(@1,@3) 0465 13700000 MVI 0(@A),C'/' 0465 13710000 * IF STRL>100 /* IS PARM FIELD > 100? * 13720000 * THEN DO; /* YES - * 13730000 LA @F,100 0466 13740000 L @6,MSGPARM+96 MSGPARM 0466 13750000 CH @F,4(0,@6) 0466 13760000 BC 10,@994 0466 13770000 * STRL=100; /* TRUNCATE PARM FIELD TO 100 * 13780000 STH @F,4(0,@6) 0468 13790000 * CALL AKJLKMSG(LSTPTR,33); /* TO GIVE WARNING 13800000 * MESSAGE * 13810000 LA @F,LSTPTR 0469 13820000 ST @F,@PL001 0469 13830000 LA @F,@D12 0469 13840000 ST @F,@PL001+4 0469 13850000 L @F,@V1 ADDRESS OF AKJLKMSG 0469 13860000 LA @1,@PL001 0469 13870000 BALR @E,@F 0469 13880000 * END; 13890000 * ENDD=BEG+STRL; /* GET END OF STRING * 13900000 @994 L @1,MSGPARM+96 MSGPARM 0471 13910000 LH @F,4(0,@1) 0471 13920000 AH @F,BEG 0471 13930000 STH @F,ENDD 0471 13940000 * OPLIST(BEG+1:ENDD)=STR->CHARST(1:STRL); /* MOVE IN * 13950000 L @3,MSGPARM+96 MSGPARM 0472 13960000 L @3,0(0,@3) STRING 0472 13970000 LR @E,@3 0472 13980000 LR @6,@F 0472 13990000 LA @7,1 0472 14000000 AH @7,BEG 0472 14010000 SR @6,@7 0472 14020000 L @4,BASE 0472 14030000 LA @A,115(@7,@4) 0472 14040000 EX @6,@MVC 0472 14050000 * BEG=ENDD+2; /* RESET BEGINNING OF STRING * 14060000 LA @F,2 0473 14070000 AH @F,ENDD 0473 14080000 STH @F,BEG 0473 14090000 * END; 14100000 * EL2: OPLEN=BEG-2; /* SET LENGTH OF OPTION LIST * 14110000 @997 EQU * 0475 14120000 EL2 LH @F,BEG 0475 14130000 SH @F,@D1 0475 14140000 L @1,BASE 0475 14150000 STH @F,114(0,@1) 0475 14160000 * IF BEG=1 /* NO PARAMETERS? * 14170000 * THEN OPLEN=0; 14180000 LA @F,1 0476 14190000 CH @F,BEG 0476 14200000 BC 07,@991 0476 14210000 SR @F,@F 0477 14220000 STH @F,114(0,@1) 0477 14230000 * OPLIST(OPLEN+1)=' '; /* REMOVE TRAILING COMMA * 14240000 @991 LA @3,1 0478 14250000 AH @3,114(0,@1) 0478 14260000 LA @A,115(@3,@1) 0478 14270000 MVI 0(@A),C' ' 0478 14280000 * FINIS: GEN(DELETE EP=IKJDAIR); /* DELETE DAIR * 14290000 FINIS DELETE EP=IKJDAIR 14300000 DS 0H 14310000 * /* ******************************************************** * 14320000 * /* XCTL TO MODULE IKJLKL02 * 14330000 * /* ******************************************************** * 14340000 * IF ERRCODE > 0 /* ERROR DETECTED? * 14350000 * THEN LKLD=' '; /* YES - SET NO LINK REQUIRED * 14360000 SR @F,@F 0480 14370000 CH @F,MSGPARM+8 0480 14380000 BC 10,@990 0480 14390000 L @1,BASE 0481 14400000 MVC 276(4,@1),@C38 0481 14410000 * RESTRICT (3); /* OY00691 * 14420000 * R3=ADDR(OUTPARM); /* SAVE PARM. ADDRESS FOR XCTL* 14430000 @990 L @1,BASE 0483 14440000 LA @3,276(0,@1) 0483 14450000 * GEN; /* FREE DYNAMIC AREA AND XCTL * 14460000 L @D,4(@D) RESTORE SAVE AREA PTR. 14470000 LR @1,@C GET ADDRESS OF DYN. AREA 14480000 L @0,@SIZ001 GET LENGTH OF AREA 14490000 FREEMAIN R,LV=(0),A=(1) 14500000 LR @1,@3 RESTORE PARM. PTR. TO REG. 1 14510000 XCTL (2,12),EP=AKJLKL02,MF=(E,(1)) 14520000 DS 0H 14530000 * GENERATE; 14540000 LKPARSE IKJPARM DSECT=LKPARMD 14550000 LK1 IKJPOSIT DSTHING,LIST,PROMPT='INPUT DATA SET(S)',VALIDCK=INCHK 14560000 LK2 IKJKEYWD 14570000 IKJNAME 'LOAD',SUBFLD=LKSFLOAD 14580000 LK3 IKJKEYWD 14590000 IKJNAME 'LIB',SUBFLD=LKSFLIBR 14600000 LK4 IKJKEYWD 14610000 IKJNAME 'PLILIB' 14620000 LK5 IKJKEYWD 14630000 IKJNAME 'FORTLIB' 14640000 LK6 IKJKEYWD 14650000 IKJNAME 'COBLIB' 14660000 LK7 IKJKEYWD 14670000 IKJNAME 'PLIBASE' 14680000 LK8 IKJKEYWD 14690000 IKJNAME 'PLICMIX' 14700000 LK9 IKJKEYWD 14710000 IKJNAME 'PL1LIB' 14720000 LK10 IKJKEYWD 14730000 IKJNAME 'SIZE',SUBFLD=LKSFSIZE 14740000 LK101 IKJKEYWD 14750000 IKJNAME 'AC',SUBFLD=LKSFAC Y01018 14760000 LK11 IKJKEYWD 14770000 IKJNAME 'DCBS',SUBFLD=LKSFDCBS 14780000 LK12 IKJKEYWD 14790000 IKJNAME 'PRINT',SUBFLD=LKSFPRNT 14800000 IKJNAME 'NOPRINT' 14810000 LK13 IKJKEYWD 14820000 IKJNAME 'MAP' 14830000 IKJNAME 'NOMAP' 14840000 LK14 IKJKEYWD 14850000 IKJNAME 'XREF' 14860000 IKJNAME 'NOXREF' 14870000 LK15 IKJKEYWD 14880000 IKJNAME 'LIST' 14890000 IKJNAME 'NOLIST' 14900000 LK16 IKJKEYWD 14910000 IKJNAME 'LET' 14920000 IKJNAME 'NOLET' 14930000 LK17 IKJKEYWD 14940000 IKJNAME 'XCAL' 14950000 IKJNAME 'NOXCAL' 14960000 LK18 IKJKEYWD 14970000 IKJNAME 'SCTR' 14980000 IKJNAME 'NOSCTR' 14990000 LK19 IKJKEYWD 15000000 IKJNAME 'OVLY' 15010000 IKJNAME 'NOOVLY' 15020000 LK20 IKJKEYWD 15030000 IKJNAME 'RENT' 15040000 IKJNAME 'NORENT' 15050000 LK21 IKJKEYWD 15060000 IKJNAME 'REUS' 15070000 IKJNAME 'NOREUS' 15080000 LK22 IKJKEYWD 15090000 IKJNAME 'REFR' 15100000 IKJNAME 'NOREFR' 15110000 LK23 IKJKEYWD 15120000 IKJNAME 'NE' 15130000 IKJNAME 'NONE' 15140000 LK24 IKJKEYWD 15150000 IKJNAME 'OL' 15160000 IKJNAME 'NOOL' 15170000 LK25 IKJKEYWD 15180000 IKJNAME 'DC' 15190000 IKJNAME 'NODC' 15200000 LK26 IKJKEYWD 15210000 IKJNAME 'TEST' 15220000 IKJNAME 'NOTEST' 15230000 LK27 IKJKEYWD 15240000 IKJNAME 'HIAR' 15250000 IKJNAME 'NOHIAR' 15260000 LK28 IKJKEYWD DEFAULT='TERM' 15270000 IKJNAME 'TERM' 15280000 IKJNAME 'NOTERM' 15290000 LK29 IKJKEYWD 15300000 IKJNAME 'NCAL' 15310000 IKJNAME 'NONCAL' 15320000 LK291 IKJKEYWD 15330000 IKJNAME 'ALIGN2' Y01018 15340000 IKJNAME 'NOALIGN2' Y01018 15350000 LKSFLOAD IKJSUBF 15360000 LK30 IKJPOSIT DSNAME 15370000 LKSFPRNT IKJSUBF 15380000 LK31 IKJPOSIT DSTHING 15390000 LKSFLIBR IKJSUBF 15400000 LK32 IKJPOSIT DSNAME,LIST 15410000 LKSFSIZE IKJSUBF 15420000 LK33 IKJIDENT 'SIZE PARAMETER',LIST,FIRST=NUMERIC, X15430000 OTHER=ALPHANUM,PROMPT='SIZE PARAMETER' 15440000 LKSFDCBS IKJSUBF 15450000 LK34 IKJIDENT 'BLOCKSIZE',FIRST=NUMERIC,OTHER=NUMERIC,MAXLNTH=5, X15460000 PROMPT='LOAD MODULE BLOCKSIZE' 15470000 LKSFAC IKJSUBF 15480000 LK35 IKJIDENT 'APF CODE',FIRST=NUMERIC,OTHER=NUMERIC, Y01018 X15490000 PROMPT='AUTHORIZATION CODE',MAXLNTH=3 Y01018 15500000 IKJENDP 15510000 LDPARSE IKJPARM DSECT=LDPARMD 15520000 LD1 IKJPOSIT DSTHING,LIST,PROMPT='INPUT DATA SET(S)',VALIDCK=INCHK 15530000 LD2 IKJPOSIT QSTRING 15540000 LD3 IKJKEYWD 15550000 IKJNAME 'LIB',SUBFLD=LDSFLIBR 15560000 LD4 IKJKEYWD 15570000 IKJNAME 'PLILIB' 15580000 LD5 IKJKEYWD 15590000 IKJNAME 'FORTLIB' 15600000 LD6 IKJKEYWD 15610000 IKJNAME 'COBLIB' 15620000 LD7 IKJKEYWD 15630000 IKJNAME 'PLIBASE' 15640000 LD8 IKJKEYWD 15650000 IKJNAME 'PLICMIX' 15660000 LD9 IKJKEYWD 15670000 IKJNAME 'PL1LIB' 15680000 LD10 IKJKEYWD 15690000 IKJNAME 'SIZE',SUBFLD=LDSFSIZE 15700000 LD11 IKJKEYWD 15710000 IKJNAME 'EP',SUBFLD=LDSFEP 15720000 LD12 IKJKEYWD 15730000 IKJNAME 'NAME',SUBFLD=LDSFNAME 15740000 LD13 IKJKEYWD 15750000 IKJNAME 'PRINT',SUBFLD=LDSFPRNT 15760000 IKJNAME 'NOPRINT' 15770000 LD14 IKJKEYWD DEFAULT='NOMAP' 15780000 IKJNAME 'MAP' 15790000 IKJNAME 'NOMAP' 15800000 LD15 IKJKEYWD DEFAULT='NOLET' 15810000 IKJNAME 'LET' 15820000 IKJNAME 'NOLET' 15830000 LD16 IKJKEYWD DEFAULT='TERM' 15840000 IKJNAME 'TERM' 15850000 IKJNAME 'NOTERM' 15860000 LD17 IKJKEYWD DEFAULT='RES' 15870000 IKJNAME 'RES' 15880000 IKJNAME 'NORES' 15890000 LD18 IKJKEYWD DEFAULT='CALL' 15900000 IKJNAME 'CALL' 15910000 IKJNAME 'NOCALL' 15920000 LDSFPRNT IKJSUBF 15930000 LD19 IKJPOSIT DSTHING 15940000 LDSFLIBR IKJSUBF 15950000 LD20 IKJPOSIT DSNAME,LIST 15960000 LDSFSIZE IKJSUBF 15970000 LD21 IKJIDENT 'SIZE PARAMETER',FIRST=NUMERIC, X15980000 OTHER=ALPHANUM,PROMPT='SIZE PARAMETER' 15990000 LDSFEP IKJSUBF 16000000 LD22 IKJIDENT 'ENTRY POINT NAME',FIRST=ALPHA,OTHER=ALPHANUM, X16010000 PROMPT='ENTRY POINT NAME',MAXLNTH=8 16020000 LDSFNAME IKJSUBF 16030000 LD23 IKJIDENT 'PROGRAM NAME',FIRST=ALPHA,OTHER=ALPHANUM, X16040000 PROMPT='PROGRAM NAME',MAXLNTH=8 16050000 IKJENDP 16060000 DS 0H 16070000 * /* **************************************************************** * 16080000 * /* * 16090000 * /* THIS PROCEDURE IS ENTERED FROM PARSE ONE TIME FOR EACH INPUT * 16100000 * /* DATA SET. ON ENTRY, REGISTER 1 POINTS TO THE STRUCTURE DEFINED * 16110000 * /* BY PARML. THE DATA SET BEING PROCESSED IS DESCRIBED BY THE * 16120000 * /* STRUCTURE NAMED DATASET. IF THE DATA SET NAME IS '*', THIS * 16130000 * /* ROUTINE WILL CREATE A DATA SET FOR LINKAGE EDITOR CONTROL * 16140000 * /* STATEMENTS WHICH THE USER ENTERS FROM THE TERMINAL. ON RETURN * 16150000 * /* TO PARSE REGISTER 15 WILL CONTAIN 0 IF NO ERROR OCCURRED, 8 IF * 16160000 * /* AN ERROR OCCURRED AND THE USER CAN REENTER THE DATA SET NAME, OR * 16170000 * /* 12 IF AN UNRECOVERABLE ERROR OCCURRED. * 16180000 * /* * 16190000 * /* **************************************************************** * 16200000 * INCHK: PROC OPTIONS(NOSAVEAREA,DONTSAVE(15)); 16210000 @EL01 L @D,4(0,@D) 0486 16220000 LR @1,@C 0486 16230000 L @0,@SIZ001 0486 16240000 FREEMAIN R,LV=(0),A=(1) 0486 16250000 LM @E,@C,12(@D) 0486 16260000 BCR 15,@E 0486 16270000 INCHK ST @E,12(0,@D) 0486 16280000 STM @0,@C,20(@D) 0486 16290000 * /* ******************************************************** * 16300000 * /* MAPS * 16310000 * /* ******************************************************** * 16320000 * DCL 1 PARML BASED(R1), 16330000 * 2 PDE PTR, /* PTR. TO DESCPT. OF DATA SET* 16340000 * 2 USERAREA PTR; /* PTR. TO BASE & DATA REG. * 16350000 * /* CONTENTS * 16360000 * DCL FPTR POINTER BASED(R13+8); 16370000 * /* ******************************************************** * 16380000 * /* DATA IN GETMAIN SPACE * 16390000 * /* ******************************************************** * 16400000 * DCL SAVEAR(18) FIXED(31); /* LOCAL SAVE AREA * 16410000 * DCL Q04(2) FIXED(15); /* CODE FOR QUALIFIERS * 16420000 * RESTRICT(1,2,3); 16430000 * /* ******************************************************** * 16440000 * /* ESTABLISH ADDRESSABILITY * 16450000 * /* ******************************************************** * 16460000 * R8=USERAREA->BASEREG(1); /* RESTORE 1ST BASE REG. ZA02180* 16470000 L @6,4(0,@1) 0492 16480000 L @8,0(0,@6) 0492 16490000 * R9=USERAREA->BASEREG(2); /* RESTORE 2ND BASE REG. ZA02180* 16500000 L @9,4(0,@6) 0493 16510000 * R11=USERAREA->BASEREG(3); /* RESTORE 3RD BASE REG. ZA02180* 16520000 L @B,8(0,@6) 0494 16530000 * R12=USERAREA->DATAREG; 16540000 L @C,12(0,@6) 0495 16550000 * /* ******************************************************** * 16560000 * /* DO SAVE AREA CHAINING * 16570000 * /* ******************************************************** * 16580000 * SAVEAR(2)=R13; /* SAVE BACKWARD POINTER * 16590000 ST @D,SAVEAR+4 0496 16600000 * FPTR=ADDR(SAVEAR); /* SAVE FORWARD POINTER IN * 16610000 LA @F,SAVEAR 0497 16620000 ST @F,8(0,@D) 0497 16630000 * /* CALLING ROUTINE * 16640000 * R13=ADDR(SAVEAR); /* PUT SAVEAREA ADD.IN REG.13 * 16650000 LA @D,SAVEAR 0498 16660000 * PTR1=PDE; /* SET POINTER TO DESCRIPTOR * 16670000 MVC MSGPARM+96(4),0(@1) 0499 16680000 * /* ELEMENT * 16690000 * IF DSL=1 & DSN->CHARST(1)='*' /* CONTROL STMTS. REQUESTED * 16700000 * THEN DO; 16710000 LA @F,1 0500 16720000 L @7,MSGPARM+96 MSGPARM 0500 16730000 CH @F,4(0,@7) 0500 16740000 BC 07,@98F 0500 16750000 L @4,MSGPARM+96 MSGPARM 0500 16760000 L @4,0(0,@4) DATASET 0500 16770000 CLI 0(@4),C'*' 0500 16780000 BC 07,@98E 0500 16790000 * /* ************************************************ * 16800000 * /* CREATE DATA SET WITH L.E. CONTROL STATEMENTS * 16810000 * /* ************************************************ * 16820000 * DSPTR=ADDR(NM(1)); /* SET POINTER TO DSNAME * 16830000 LA @F,NM 0502 16840000 ST @F,MSGPARM+92 0502 16850000 * DSNM=CSNAME; /* SET DATA SET NAME * 16860000 LR @5,@F MSGPARM 0503 16870000 MVC 2(4,@5),CSNAME 0503 16880000 MVI 6(@5),C' ' 0503 16890000 MVC 7(39,@5),6(@5) 0503 16900000 * CSNAME=CSNAME+1; /* PREPARE NEXT L.E. CON. NAME* 16910000 LA @F,1 0504 16920000 A @F,CSNAME 0504 16930000 ST @F,CSNAME 0504 16940000 * DSNLNGTH=7; /* SET LENGTH OF NAME * 16950000 LA @F,7 0505 16960000 STH @F,0(0,@5) 0505 16970000 * CALL ALLOCDS('INPT','UTIL'); /* ALLOCATE DATA SET * 16980000 LA @F,@C39 0506 16990000 ST @F,@PL002 0506 17000000 LA @F,@C29 0506 17010000 ST @F,@PL002+4 0506 17020000 LA @1,@PL002 0506 17030000 BAL @E,ALLOCDS 0506 17040000 * IF ERRCODE > 0 /* ERROR IN ALLOCATION? * 17050000 * THEN GO TO ERR; /* YES - CHECK WHAT KIND * 17060000 SR @F,@F 0507 17070000 CH @F,MSGPARM+8 0507 17080000 BC 04,ERR 0508 17090000 * R3=ADDR(INDCB); /* SET REG. FOR DCBD * 17100000 LA @3,INDCB 0509 17110000 * GEN; 17120000 USING IHADCB,R3 17130000 MVC IHADCB(DCBSIZ2),CST /* MOVE IN DCB INFO. */ 17140000 DS 0H 17150000 * DAPB0PTR=ADDR(DAIR08); 17160000 LA @F,DAIR08 0511 17170000 ST @F,MSGPARM 0511 17180000 * DCBDDNAM=DA08DDN; /* MOVE IN DDNAME * 17190000 LR @6,@F 0512 17200000 MVC DCBDDNAM(8),12(@6) 0512 17210000 * OPTBYT='8F'X; /* SET OUTPUT FLAG * 17220000 MVI DMLIST,X'8F' 0513 17230000 * R1=ADDR(DMLIST); /* SET PTR. TO REMOTE LIST * 17240000 LA @1,DMLIST 0514 17250000 * GEN; /* OPEN AND TEST FOR SUCCESS * 17260000 OPEN ((3)),MF=(E,(1)) 17270000 TM DCBOFLGS,X'10' CORRECT OPEN? 17280000 BO GETS YES - GO GET INPUT 17290000 DS 0H 17300000 * CALL AKJLKMSG(LSTPTR,12); /* OPEN ERROR * 17310000 LA @F,LSTPTR 0516 17320000 ST @F,@PL002 0516 17330000 LA @F,@D13 0516 17340000 ST @F,@PL002+4 0516 17350000 L @F,@V1 ADDRESS OF AKJLKMSG 0516 17360000 LA @1,@PL002 0516 17370000 BALR @E,@F 0516 17380000 * GO TO ERR; /* RETURN TO PARSE * 17390000 BC 15,ERR 0517 17400000 * GETS: 17410000 * CALL AKJLKMSG(LSTPTR,13);/* ENTER CONTROL STATMENTS * 17420000 GETS LA @F,LSTPTR 0518 17430000 ST @F,@PL002 0518 17440000 LA @F,@D14 0518 17450000 ST @F,@PL002+4 0518 17460000 L @F,@V1 ADDRESS OF AKJLKMSG 0518 17470000 LA @1,@PL002 0518 17480000 BALR @E,@F 0518 17490000 * LP1: IF ERRCODE > 0 | BUFLN=0 /* ERROR OR NO INPUT? * 17500000 * THEN GO TO CLS; /* CLOSE DARA SET AND END * 17510000 LP1 SR @F,@F 0519 17520000 CH @F,MSGPARM+8 0519 17530000 BC 04,@987 0519 17540000 CH @F,MSGPARM+10 0519 17550000 BC 08,CLS 0520 17560000 * IF BUFLN > 70 /* CHECK FOR MAX OF 70 * 17570000 * /* CHARS/LINE * 17580000 * THEN DO; 17590000 @986 LA @F,70 0521 17600000 CH @F,MSGPARM+10 0521 17610000 BC 10,@985 0521 17620000 * CALL AKJLKMSG(LSTPTR,14); /* PRINT ERROR MSG* 17630000 LA @F,LSTPTR 0523 17640000 ST @F,@PL002 0523 17650000 LA @F,@D15 0523 17660000 ST @F,@PL002+4 0523 17670000 L @F,@V1 ADDRESS OF AKJLKMSG 0523 17680000 LA @1,@PL002 0523 17690000 BALR @E,@F 0523 17700000 * /* TO CHECK * 17710000 * GO TO LP1; /* SYNTAX OF CORRECTED * 17720000 BC 15,LP1 0524 17730000 * /* CONTROL STATEMENT * 17740000 * END; 17750000 * DO I = 2 TO BUFLN; /* FIND FIRST NON-BLANK CHAR * 17760000 @985 LA @F,2 0526 17770000 BC 15,@DO981 0526 17780000 * IF INBUF(I) ^= BLANKS(1) /* IF FIND NON-BLANK * 17790000 * THEN GO TO CNTRLCK; /* BRANCH TO CHECK FOR * 17800000 @DO982 LH @6,I 0527 17810000 LA @A,MSGPARM+11(@6) 0527 17820000 CLC 0(1,@A),BLANKS 0527 17830000 BC 07,CNTRLCK 0528 17840000 * /* VALID CONTROL STATEMENT * 17850000 * END; 17860000 * GO TO NXTGET; /* ALL BLANKS, GET NEXT STMT * 17870000 LH @F,I 0529 17880000 AH @F,@D3 0529 17890000 @DO981 STH @F,I 0529 17900000 CH @F,MSGPARM+10 0529 17910000 BC 12,@DO982 0529 17920000 BC 15,NXTGET 0530 17930000 * CNTRLCK: DO J=1 TO 15; /* CHECK FOR VALID S21016 17940000 * CONTROL STATEMENT * 17950000 CNTRLCK LA @F,1 0531 17960000 STH @F,J 0531 17970000 * CHAREND = NCHAR(J); /*LNGTH OF CNTRL STMT IN ARRAY* 17980000 @DO97E LH @6,J 0532 17990000 SLA @6,1 0532 18000000 LH @F,NCHAR-2(@6) 0532 18010000 STH @F,CHAREND 0532 18020000 * IF INBUF(I:I+CHAREND-1) = CARDS(J,1:CHAREND) 18030000 * THEN GO TO RITEDAT; /* MATCH - CONTINUE * 18040000 LH @7,J 0533 18050000 MH @7,@D16 0533 18060000 LA @E,CARDS-9(@7) 0533 18070000 LH @4,@D11 0533 18080000 AH @4,CHAREND 0533 18090000 AH @4,I 0533 18100000 LH @5,I 0533 18110000 SR @4,@5 0533 18120000 LA @A,MSGPARM+11(@5) 0533 18130000 EX @4,@CLC 0533 18140000 BC 08,RITEDAT 0534 18150000 * END; 18160000 * CALL AKJLKMSG(LSTPTR,15); /* PRINT ERROR MESSAGE: * 18170000 LH @F,J 0535 18180000 AH @F,@D3 0535 18190000 @DO97D STH @F,J 0535 18200000 CH @F,@D17 0535 18210000 BC 12,@DO97E 0535 18220000 LA @F,LSTPTR 0536 18230000 ST @F,@PL002 0536 18240000 LA @F,@D18 0536 18250000 ST @F,@PL002+4 0536 18260000 L @F,@V1 ADDRESS OF AKJLKMSG 0536 18270000 LA @1,@PL002 0536 18280000 BALR @E,@F 0536 18290000 * GO TO LP1; /* RETURN TO CHECK CORRECTED * 18300000 BC 15,LP1 0537 18310000 * /* CONTROL STATEMENT * 18320000 * RITEDAT: GEN(PUT INDCB,INBUF); /* WRITE TO DATA SET * 18330000 RITEDAT PUT INDCB,INBUF 18340000 DS 0H 18350000 * NXTGET: CALL AKJLKMSG(LSTPTR,0); /* GET NEXT STATEMENT * 18360000 NXTGET LA @F,LSTPTR 0539 18370000 ST @F,@PL002 0539 18380000 LA @F,@D5 0539 18390000 ST @F,@PL002+4 0539 18400000 L @F,@V1 ADDRESS OF AKJLKMSG 0539 18410000 LA @1,@PL002 0539 18420000 BALR @E,@F 0539 18430000 * GO TO LP1; /* CONTINUE * 18440000 BC 15,LP1 0540 18450000 * SYNADD: CALL AKJLKMSG(LSTPTR,11); /* I/O ERROR * 18460000 SYNADD LA @F,LSTPTR 0541 18470000 ST @F,@PL002 0541 18480000 LA @F,@D19 0541 18490000 ST @F,@PL002+4 0541 18500000 L @F,@V1 ADDRESS OF AKJLKMSG 0541 18510000 LA @1,@PL002 0541 18520000 BALR @E,@F 0541 18530000 * CLS: 18540000 * R1=ADDR(DMLIST); /* SET PTR TO REMOTE LIST * 18550000 CLS LA @1,DMLIST 0542 18560000 * GEN(CLOSE ((3)),MF=(E,(1))); /* CLOSE DATA SET * 18570000 CLOSE ((3)),MF=(E,(1)) 18580000 DS 0H 18590000 * IF BUFLN=0 18600000 * THEN CALL AKJLKMSG(LSTPTR,17); /* END OF STMTS. * 18610000 SR @F,@F 0544 18620000 CH @F,MSGPARM+10 0544 18630000 BC 07,@974 0544 18640000 LA @F,LSTPTR 0545 18650000 ST @F,@PL002 0545 18660000 LA @F,@D20 0545 18670000 ST @F,@PL002+4 0545 18680000 L @F,@V1 ADDRESS OF AKJLKMSG 0545 18690000 LA @1,@PL002 0545 18700000 BALR @E,@F 0545 18710000 * GO TO ERR; /* RETURN TO PARSE * 18720000 BC 15,ERR 0546 18730000 * GEN; 18740000 CST DCB DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80,RECFM=F, X18750000 SYNAD=SYNADD 18760000 DCBSIZ2 EQU *-CST 18770000 DS 0H 18780000 * END; 18790000 * DAPLDAPB=ADDR(DAIR04); /* SET PARM. BLOCK POINTER * 18800000 @98E EQU * 0549 18810000 @98F LA @F,DAIR04 0549 18820000 L @6,DAPLPTR 0549 18830000 ST @F,16(0,@6) 0549 18840000 * DAPB0PTR=ADDR(DAIR04); /* SET DSECT POINTER * 18850000 LA @F,DAIR04 0550 18860000 ST @F,MSGPARM 0550 18870000 * /* ******************************************************** * 18880000 * /* IF NOT FULLY QUALIFIED, THE INPUT DATA SET MAY HAVE ONE * 18890000 * /* OF TWO QUALIFIERS. CHECK TO SEE IF USER HAS SPECIFIED * 18900000 * /* WHICH ONE HE WANTS. IF NOT, CHECK TO SEE IF BOTH DATA * 18910000 * /* SETS EXIST. IF SO, PROMPT USER FOR CORRECT QUALIFIER. * 18920000 * /* IF BOTH DO NOT EXIST, USE ONE WHICH DOES. * 18930000 * /* ******************************************************** * 18940000 * DO I=1 TO 2; /* CHECK EACH QUALIFIER * 18950000 LA @F,1 0551 18960000 STH @F,I 0551 18970000 * DSPTR=ADDR(NM(I)); /* SET DSNAME PTR. TO I-TH NM * 18980000 @DO971 LH @6,I 0552 18990000 MH @6,@D21 0552 19000000 LA @F,NM-46(@6) 0552 19010000 ST @F,MSGPARM+92 0552 19020000 * DSNLNGTH=DSL; /* INIT. DATA SET LENGTH * 19030000 L @7,MSGPARM+96 MSGPARM 0553 19040000 LR @4,@F MSGPARM 0553 19050000 MVC 0(2,@4),4(@7) 0553 19060000 * IF DSN^=0 /* DATA SET NAME SPECIFIED. * 19070000 * THEN DSNM(1:DSL)=DSN->CHARST(1:DSL); /* MOVE IN NAME * 19080000 SR @F,@F 0554 19090000 C @F,0(0,@7) 0554 19100000 BC 08,@96D 0554 19110000 L @5,MSGPARM+96 MSGPARM 0555 19120000 L @5,0(0,@5) DATASET 0555 19130000 LR @E,@5 0555 19140000 LH @6,4(0,@7) 0555 19150000 BCTR @6,0 0555 19160000 LA @A,2(0,@4) 0555 19170000 EX @6,@MVC 0555 19180000 * IF DSF(2)='1'B /* DATA SET FULLY QUALIFIED? * 19190000 * THEN GO TO ALLOC3; /* YES - GO ALLOCATE NAME * 19200000 @96D L @6,MSGPARM+96 MSGPARM 0556 19210000 TM 6(@6),B'01000000' 0556 19220000 BC 01,ALLOC3 0557 19230000 * GEN(XC DAIR04+2(14),DAIR04+2); /* ZERO X'04' BLOCK * 19240000 XC DAIR04+2(14),DAIR04+2 19250000 DS 0H 19260000 * DA04UID='1'B; /* PREFIX USERID * 19270000 L @7,MSGPARM 0559 19280000 OI 12(@7),B'00100000' 0559 19290000 * Q04(I)=0; /* SET QUAL. I NOT SPECIFIED * 19300000 SR @F,@F 0560 19310000 LH @4,I 0560 19320000 SLA @4,1 0560 19330000 STH @F,Q04-2(@4) 0560 19340000 * IF I=1 /*FIRST DEF. QUAL. TO BE TRIED* 19350000 * THEN DO; /* YES - USE OBJ * 19360000 LA @F,1 0561 19370000 CH @F,I 0561 19380000 BC 07,@96C 0561 19390000 * LQUAL=3; /* SET LENGTH OF QUAL. * 19400000 LA @F,3 0563 19410000 STH @F,LQUAL 0563 19420000 * QUAL='OBJ '; /* SET QUALIFIER * 19430000 MVC A00001+1(8),@C41 0564 19440000 BC 15,@96B 0566 19450000 * END; 19460000 * ELSE DO; /* NO - USE LOAD OR DATA * 19470000 * LQUAL=4; /* SET LENGTH OF QUALIFIER * 19480000 @96C LA @F,4 0567 19490000 STH @F,LQUAL 0567 19500000 * QUAL='DATA '; /* SET QUAL.=DATA FOR LINK. ED* 19510000 MVC A00001+1(8),@C42 0568 19520000 * IF LKLD='LOAD' /* GOING TO LOADER? * 19530000 * THEN QUAL='LOAD '; /* YES - CHANGE QUALIFIER * 19540000 L @6,BASE 0569 19550000 CLC 276(4,@6),@C6 0569 19560000 BC 07,@96A 0569 19570000 MVC A00001+1(8),@C27 0570 19580000 * END; 19590000 @96A EQU * 0571 19600000 * CALL QCHECK('CADD'); /* SEE IF QUAL. ALREADY IN * 19610000 @96B LA @F,@C43 0572 19620000 ST @F,@PL002 0572 19630000 LA @1,@PL002 0572 19640000 BAL @E,QCHECK 0572 19650000 * /* NAME. IF NOT, ADD QUAL. * 19660000 * IF RCODE=1 /* QUALIFIER SPEC. BY USER? * 19670000 * THEN GO TO ALLOC3; /* YES - GO ALLOCATE DATA SET * 19680000 LA @F,1 0573 19690000 CH @F,MSGPARM+6 0573 19700000 BC 08,ALLOC3 0574 19710000 * DA04PDSN=DSPTR; /* SET POINTER TO DSNAME * 19720000 L @6,MSGPARM 0575 19730000 MVC 8(4,@6),MSGPARM+92 0575 19740000 * R1=DAPLPTR; /* NO - SEE IF DATA SET EXISTS* 19750000 L @1,DAPLPTR 0576 19760000 * GEN(LINK EP=IKJDAIR); /* DAIR CHECKS CAT. AND DSE * 19770000 LINK EP=IKJDAIR 19780000 DS 0H 19790000 * IF DA04CAT='1'B | /* NAME IN CATALOG? * 19800000 * DA04DSE='1'B /* NAME IN DSE? * 19810000 * THEN Q04(I)=1; /* SET - SET QUAL. PRESENT * 19820000 TM 2(@6),B'00000100' 0578 19830000 BC 01,@967 0578 19840000 TM 2(@6),B'00000010' 0578 19850000 BC 12,@966 0578 19860000 @967 LA @F,1 0579 19870000 LH @6,I 0579 19880000 SLA @6,1 0579 19890000 STH @F,Q04-2(@6) 0579 19900000 * END; 19910000 * IF Q04(1)=1 & /* FIRST DATA SET EXISTS? * 19920000 * Q04(2)=1 /* AND SEC. DATA SET EXISTS? * 19930000 * THEN DO; /* YES - SEE WHICH ONE IS OK * 19940000 @966 LH @F,I 0580 19950000 AH @F,@D3 0580 19960000 @DO970 STH @F,I 0580 19970000 CH @F,@D1 0580 19980000 BC 12,@DO971 0580 19990000 LA @F,1 0581 20000000 CH @F,Q04 0581 20010000 BC 07,@965 0581 20020000 CH @F,Q04+2 0581 20030000 BC 07,@964 0581 20040000 * ERR4: IF LKLD='LINK' 20050000 * THEN MES=22; /* GIVE L.E. MESSAGE * 20060000 ERR4 L @6,BASE 0583 20070000 CLC 276(4,@6),@C4 0583 20080000 BC 07,@963 0583 20090000 LA @F,22 0584 20100000 ST @F,MES 0584 20110000 BC 15,@962 0585 20120000 * ELSE MES=27; /* GIVE LOADER MESSAGE * 20130000 @963 LA @F,27 0585 20140000 ST @F,MES 0585 20150000 * DSNLNGTH=DSL; /* GET ORIG. LNG. FOR MESSAGE * 20160000 @962 L @7,MSGPARM+96 MSGPARM 0586 20170000 L @4,MSGPARM+92 MSGPARM 0586 20180000 MVC 0(2,@4),4(@7) 0586 20190000 * DSNM(DSNLNGTH+1)=' '; /* BLANK OUT '.' * 20200000 LA @5,1 0587 20210000 AH @5,0(0,@4) 0587 20220000 LA @A,1(@5,@4) 0587 20230000 MVI 0(@A),C' ' 0587 20240000 * CALL AKJLKMSG(LSTPTR,MES); /* ISSUE MESSAGE * 20250000 LA @F,LSTPTR 0588 20260000 ST @F,@PL002 0588 20270000 LA @F,MES 0588 20280000 ST @F,@PL002+4 0588 20290000 L @F,@V1 ADDRESS OF AKJLKMSG 0588 20300000 LA @1,@PL002 0588 20310000 BALR @E,@F 0588 20320000 * CALL AKJLKMSG(LSTPTR,23); /* PROMPT FOR REPLY * 20330000 LA @F,LSTPTR 0589 20340000 ST @F,@PL002 0589 20350000 LA @F,@D22 0589 20360000 ST @F,@PL002+4 0589 20370000 L @F,@V1 ADDRESS OF AKJLKMSG 0589 20380000 LA @1,@PL002 0589 20390000 BALR @E,@F 0589 20400000 * IF ERRCODE > 0 /* NO RETURN FROM PUT-GET? * 20410000 * THEN GOTO ERR; 20420000 SR @F,@F 0590 20430000 CH @F,MSGPARM+8 0590 20440000 BC 04,ERR 0591 20450000 * IF INBUF(2:4)='OBJ' /* RESPONSE WAS OBJ? * 20460000 * THEN GO TO ALLOC3A; /* YES - ALLOCATE IT * 20470000 CLC MSGPARM+13(3),@C41 0592 20480000 BC 08,ALLOC3A 0593 20490000 * IF INBUF(2:5)=QUAL(1:4) /* RESPONSE LOAD OR DATA? * 20500000 * THEN GO TO ALLOC3; /* YES - GO ALLOCATE IT. * 20510000 CLC MSGPARM+13(4),A00001+1 0594 20520000 BC 08,ALLOC3 0595 20530000 * GO TO ERR4; /* ANS. NO GOOD - ASK AGAIN. * 20540000 BC 15,ERR4 0596 20550000 * END; 20560000 * IF Q04(2)=1 /* LOAD OR DATA DSNAME NEEDED?* 20570000 * THEN GO TO ALLOC3; /* YES - GO ALLOCATE IT. * 20580000 @964 EQU * 0598 20590000 @965 LA @F,1 0598 20600000 CH @F,Q04+2 0598 20610000 BC 08,ALLOC3 0599 20620000 * ALLOC3A: DSPTR=ADDR(NM(1)); /* SET PTR. TO NAME WITH OBJ. * 20630000 ALLOC3A LA @F,NM 0600 20640000 ST @F,MSGPARM+92 0600 20650000 * LQUAL=3; /* RESET LENGTH OF QUAL. * 20660000 LA @F,3 0601 20670000 STH @F,LQUAL 0601 20680000 * QUAL='OBJ '; /* RESET QUALIFIER * 20690000 MVC A00001+1(8),@C41 0602 20700000 * ALLOC3: CALL ALLOCDS('INPT','NODF'); /* ALLOCATE DATA SET - NO DEF.* 20710000 ALLOC3 LA @F,@C39 0603 20720000 ST @F,@PL002 0603 20730000 LA @F,@C26 0603 20740000 ST @F,@PL002+4 0603 20750000 LA @1,@PL002 0603 20760000 BAL @E,ALLOCDS 0603 20770000 * ERR: IF ERRCODE=0 /* NO ERROR? * 20780000 * THEN R15=0; /* YES - PARSE WILL CONTINUE * 20790000 ERR SR @F,@F 0604 20800000 CH @F,MSGPARM+8 0604 20810000 BC 08,@95A 0606 20820000 * ELSE IF ERRCODE=1 /* NO - PROMTP MESSAGE? * 20830000 * THEN R15=8; /* YES - PARSE PROMPTS * 20840000 @95B LA @F,1 0606 20850000 CH @F,MSGPARM+8 0606 20860000 BC 07,@959 0606 20870000 LA @F,8 0607 20880000 BC 15,@958 0608 20890000 * ELSE R15=12; /* NO - PARSE ENDS * 20900000 @959 LA @F,12 0608 20910000 * R13=SAVEAR(2); /* GET SAVE AREA OF CALLER * 20920000 @958 EQU * 0609 20930000 @95A L @D,SAVEAR+4 0609 20940000 * END INCHK; 20950000 @EL02 L @E,12(0,@D) 0610 20960000 LM @0,@C,20(@D) 0610 20970000 BCR 15,@E 0610 20980000 * /* **************************************************************** * 20990000 * /* * 21000000 * /* THIS ROUTINE IS USED TO CHECK THE DESCRIPTIVE QUALIFIER FOR A * 21010000 * /* DATA SET. IT MAY ALSO ADD OR REMOVE THIS QUALIFIER. ON ENTRY, * 21020000 * /* THE PARAMETER 'TYPE' TELLS WHETHER TO ADD THE QUALIFIER IF NOT * 21030000 * /* ALREADY PRESENT, UNCONDITIONALLY ADD THE QUALIFIER, OR REMOVE THE* 21040000 * /* QUALIFIER IF PRESENT. ALSO ON ENTRY, THE FOLLOWING DATA ITEMS * 21050000 * /* MUST BE SET: * 21060000 * /* DSPTR - POINTS TO THE DATA SET NAME. * 21070000 * /* QUAL - CONTAINS DESCRIPTIVE QUALIFIER. * 21080000 * /* LQUAL - CONTAINS THE LENGTH OF THE QUALIFIER. * 21090000 * /* BEFORE EXIT, THE DATA ITEM RCODE IS SET TO 0 IF THE DATA SET * 21100000 * /* NAME DID NOT CONTAIN THE QUALIFIER, AND IT IS SET TO 1 IF THE * 21110000 * /* DATA SET NAME DID CONTAIN THE QUALIFIER. * 21120000 * /* * 21130000 * /* **************************************************************** * 21140000 * QCHECK: PROC(TYPE) OPTIONS(NOSAVEAREA); 21150000 QCHECK STM @E,@C,12(@D) 0611 21160000 * /* ******************************************************** * 21170000 * /* DATA IN GETMAIN SPACE * 21180000 * /* ******************************************************** * 21190000 * DCL TYPE CHAR(4), /* TELLS WHETHER TO COND. ADD * 21200000 * /* QUALIFIER(CADD), UNCOND. * 21210000 * /* ADD QUALIFIER(UADD), OR * 21220000 * /* REMOVE QUALIFIER FOR * 21230000 * /* DEFAULT DSNAME(SUBT). * 21240000 * LNG FIXED(15), /* LENGTH OF ADDED QUAL. * 21250000 * PTR POINTER; /* PTR. TO BEG. OF ADDED QUAL.* 21260000 * RCODE=0; 21270000 SR @F,@F 0613 21280000 STH @F,MSGPARM+6 0613 21290000 * LNG=LQUAL+1; /* ADD ONE TO LENGTH FOR '.' * 21300000 LA @F,1 0614 21310000 AH @F,LQUAL 0614 21320000 STH @F,LNG 0614 21330000 * PTR=ADDR(DOT); /* SET POINTER * 21340000 LA @F,A00001 0615 21350000 ST @F,PTR 0615 21360000 * IF TYPE='UADD' /* UNCONDITIONALLY ADD QUAL? * 21370000 * THEN GO TO ADD; /* YES - DO IT * 21380000 L @6,0(0,@1) ADDRESS OF TYPE 0616 21390000 CLC 0(4,@6),@C44 0616 21400000 BC 08,ADD 0617 21410000 * N=DSNLNGTH-LNG+1; /* CALC. BEGINNING OF QUAL. * 21420000 LA @F,1 0618 21430000 SH @F,LNG 0618 21440000 L @7,MSGPARM+92 MSGPARM 0618 21450000 AH @F,0(0,@7) 0618 21460000 STH @F,N 0618 21470000 * IF N>1 /* CAN THERE BE A QUAL.? * 21480000 * THEN IF DSNM(N:DSNLNGTH)=PTR->CHARST(1:LNG) /* PRESENT? * 21490000 LA @F,1 0619 21500000 CH @F,N 0619 21510000 BC 10,@957 0619 21520000 * THEN RCODE=1; /* YES - SET CODE * 21530000 L @4,PTR 0620 21540000 LR @E,@4 0620 21550000 LH @5,0(0,@7) 0620 21560000 LH @2,N 0620 21570000 SR @5,@2 0620 21580000 LA @A,1(@2,@7) 0620 21590000 EX @5,@CLC 0620 21600000 BC 07,@956 0620 21610000 LA @F,1 0621 21620000 STH @F,MSGPARM+6 0621 21630000 * IF RCODE=1 /* QUAL. PART OF DSNAME? * 21640000 * THEN DO; /* YES * 21650000 @956 EQU * 0622 21660000 @957 LA @F,1 0622 21670000 CH @F,MSGPARM+6 0622 21680000 BC 07,@955 0622 21690000 * IF TYPE='SUBT' /* NEED TO BE REMOVED? * 21700000 * THEN DSNLNGTH=N-1; /* YES - ADJUST LENGTH * 21710000 L @6,0(0,@1) ADDRESS OF TYPE 0624 21720000 CLC 0(4,@6),@C45 0624 21730000 BC 07,@954 0624 21740000 LH @F,N 0625 21750000 BCTR @F,0 0625 21760000 L @7,MSGPARM+92 MSGPARM 0625 21770000 STH @F,0(0,@7) 0625 21780000 * GO TO EQCH; /* FINISHED * 21790000 BC 15,EQCH 0626 21800000 * END; 21810000 * ADD: IF DSNLNGTH=0 /* NO DATA SET NAME GIVEN? * 21820000 * THEN DO; /* DONT USE '.' * 21830000 @955 EQU * 0628 21840000 ADD SR @F,@F 0628 21850000 L @6,MSGPARM+92 MSGPARM 0628 21860000 CH @F,0(0,@6) 0628 21870000 BC 07,@953 0628 21880000 * LNG=LQUAL; /* RESET LENGTH * 21890000 MVC LNG(2),LQUAL 0630 21900000 * PTR=ADDR(QUAL); 21910000 LA @F,A00001+1 0631 21920000 ST @F,PTR 0631 21930000 * END; 21940000 * N=DSNLNGTH+LNG; /* CALC. NEW LENGTH * 21950000 @953 LH @F,LNG 0633 21960000 L @6,MSGPARM+92 MSGPARM 0633 21970000 AH @F,0(0,@6) 0633 21980000 STH @F,N 0633 21990000 * DSNM(DSNLNGTH+1:N)=PTR->CHARST(1:LNG); /* MOVE IN QUAL. * 22000000 L @7,PTR 0634 22010000 LR @E,@7 0634 22020000 LR @4,@F 0634 22030000 LA @5,1 0634 22040000 AH @5,0(0,@6) 0634 22050000 SR @4,@5 0634 22060000 LA @A,1(@5,@6) 0634 22070000 EX @4,@MVC 0634 22080000 * DSNLNGTH=N; /* RESET LENGTH * 22090000 MVC 0(2,@6),N 0635 22100000 * EQCH: END QCHECK; 22110000 EQCH EQU * 0636 22120000 @EL03 LM @E,@C,12(@D) 0636 22130000 BCR 15,@E 0636 22140000 * ALLOCDS: PROC; 22150000 ALLOCDS STM @E,@C,12(@D) 0637 22160000 ST @D,@SAV004+4 0637 22170000 LA @F,@SAV004 0637 22180000 ST @F,8(0,@D) 0637 22190000 LR @D,@F 0637 22200000 * /* ******************************************************** * 22210000 * /* THIS PROCEDURE ALLOCATES THE PRINT, LOAD, LIB, INPUT, AND* 22220000 * /* UTILITY DATA SETS. ALL DATA SETS EXCEPT THE UTILITY ONE * 22230000 * /* ARE FIRST ALLOCATED AS OLD. IF THE DATA SET DOES NOT * 22240000 * /* EXIST, THE PRINT AND LOAD DATA SETS ARE RE-ALLOCATED AS * 22250000 * /* NEW. TWO ARGUMENTS ARE PASSED TO THIS PROC. AND ARE * 22260000 * /* MOVED INTO LOCAL STORAGE FOR ITS USE. * 22270000 * /* TYPE1 (FIRST ARGUMENT) HAS THE VALUE 'INPT','LOAD', * 22280000 * /* 'PRNT', 'LIBR', OR 'UTIL' TO INDICATE WHICH DATA SET IS * 22290000 * /* BEING ALLOCATED. * 22300000 * /* TYPE2 (SEC. ARGUMENT) HAS THE FOLLOWING VALUES TO * 22310000 * /* INDICATE WHAT NAME IS TO BE USED: * 22320000 * /* 'DEFL' - USE THE DEFAULT DSNAME. * 22330000 * /* 'NODF' - DO NOT USE THE DEFAULT NAME. * 22340000 * /* 'UTIL' - USE THE TEMPORARY DSNAME SINCE IT IS A * 22350000 * /* UTILITY DATA SET. * 22360000 * /* 'SYSL' - USE THE SYSTEM LIBRARY NAME. * 22370000 * /* IF A LIBRARY OR INPUT DATA SET IS ALLOCATED, THE DDNAME * 22380000 * /* IS ADDED TO THE LIST OF DDNAMES TO BE CONCATENATED. * 22390000 * /* ******************************************************** * 22400000 * /* ******************************************************** * 22410000 * /* DATA IN GETMAIN SPACE * 22420000 * /* ******************************************************** * 22430000 * DCL PARMPTR POINTER; /* POINTER TO PARMS. * 22440000 * DCL (TYPE1, /* LOCAL VARIABLE FOR 1ST ARG.* 22450000 * TYPE2) CHAR(4); /* LOCAL VARIABLE FOR 2ND ARG.* 22460000 * DCL TADD CHAR(4); /* USED TO TELL WHETHER TO * 22470000 * /* CONDITIONALLY OR UNCOND. * 22480000 * /* ADD A DEFAULT QUALIFIER. * 22490000 * DCL PTR2 PTR; /* INTERMEDIATE POINTER * 22500000 * DECLARE 22510000 * 1 BLDLST, /* BUILD L LIST * 22520000 * 2 FF FIXED(15), /* NUMBER OF ENTRIES * 22530000 * 2 LLL FIXED(15), /* LENGTH OF ENTRIES * 22540000 * 2 NAME1 CHAR(8), /* MEMBER NAME TO SEARCH FOR * 22550000 * 2 * CHAR(2), 22560000 * 2 R CHAR(1), /* TRACK ADD. OF FOUND MEMBER * 22570000 * 2 * CHAR(3); 22580000 * /* ******************************************************** * 22590000 * /* MAPS * 22600000 * /* ******************************************************** * 22610000 * DCL 1 PARMA BASED(PARMPTR), /* INCOMING PARMS * 22620000 * 2 P1 POINTER, /* POINTER TO FIRST PARM. * 22630000 * 2 P2 POINTER; /* POINTER TO SEC. PARM. * 22640000 * RESTRICT(2,3); 22650000 * PARMPTR=R1; /* SET POINTER TO PARMS. * 22660000 ST @1,PARMPTR 0645 22670000 * TYPE1=P1->CHARST(1:4); /* GET FIRST PARM. * 22680000 L @1,PARMPTR 0646 22690000 L @1,0(0,@1) PARMA 0646 22700000 MVC TYPE1(4),0(@1) 0646 22710000 * TYPE2=P2->CHARST(1:4); /* GET SECOND PARM. * 22720000 L @6,PARMPTR 0647 22730000 L @6,4(0,@6) PARMA 0647 22740000 MVC TYPE2(4),0(@6) 0647 22750000 * ERRCODE=0; /* INIT. ERROR CODE * 22760000 SR @F,@F 0648 22770000 STH @F,MSGPARM+8 0648 22780000 * DAPB0PTR=ADDR(DAIR08); /* SET ADDRESS OF CODE 08 * 22790000 LA @F,DAIR08 0649 22800000 ST @F,MSGPARM 0649 22810000 * GEN(XC DAIR08+2(74),DAIR08+2); /* ZERO OUT X'08' BLOCK * 22820000 XC DAIR08+2(74),DAIR08+2 22830000 DS 0H 22840000 * DA08MNM=BLANKS; /* INIT. MEMBER NAME * 22850000 L @1,MSGPARM 0651 22860000 MVC 52(8,@1),BLANKS 0651 22870000 * DA08PSWD=BLANKS; /* INIT. PASSWORD * 22880000 MVC 60(8,@1),BLANKS 0652 22890000 * DA08UNIT=BLANKS; /* INIT. UNIT FIELD * 22900000 MVC 20(8,@1),BLANKS 0653 22910000 * DA08SER=BLANKS; /* INIT. VOL.-SER. FIELD * 22920000 MVC 28(8,@1),BLANKS 0654 22930000 * IF TYPE2='UTIL' /* UTILITY DATA SET? * 22940000 * THEN DO; /* YES * 22950000 CLC TYPE2(4),@C29 0655 22960000 BC 07,@952 0655 22970000 * DA08NEW='1'B; /* ALLOCATE AS (NEW, * 22980000 OI 68(@1),B'00000100' 0657 22990000 * DA08DEL='1'B; /* DELETE, * 23000000 OI 69(@1),B'00000100' 0658 23010000 * DA08DELE='1'B; /* DELETE) * 23020000 OI 70(@1),B'00000100' 0659 23030000 * GO TO ALLOC2; /* ALLOCATE DATA SET * 23040000 BC 15,ALLOC2 0660 23050000 * END; 23060000 * IF TYPE1='INPT' | /* SYSLIN (READ ONLY) OY00595 * 23070000 * TYPE1='LIBR' | /* SYSLIB/LIB (READ ONLY) OY00595 * 23080000 * TYPE1='LOAD' /* SYSLMOD (ENQ'D BY LE ) OY00595 * 23090000 * THEN DA08SHR='1'B; /* YES - ALLOC. AS SHR * 23100000 @952 CLC TYPE1(4),@C39 0662 23110000 BC 08,@951 0662 23120000 CLC TYPE1(4),@C30 0662 23130000 BC 08,@950 0662 23140000 CLC TYPE1(4),@C6 0662 23150000 BC 07,@94F 0662 23160000 @950 EQU * 0663 23170000 @951 L @1,MSGPARM 0663 23180000 OI 68(@1),B'00001000' 0663 23190000 BC 15,@94E 0664 23200000 * ELSE DA08OLD='1'B; /* NO - ALLOC. AS OLD * 23210000 @94F L @1,MSGPARM 0664 23220000 OI 68(@1),B'00000001' 0664 23230000 * DA08KEEP='1'B; /* KEEP, * 23240000 @94E L @1,MSGPARM 0665 23250000 OI 69(@1),B'00001000' 0665 23260000 * DA08KEP='1'B; /* KEEP) * 23270000 OI 70(@1),B'00001000' 0666 23280000 * TADD='CADD'; /* SET CODE TO COND. ADD * 23290000 MVC TADD(4),@C43 0667 23300000 * IF TYPE2='SYSL' /* IS DATA SET A SYSLIB D.SET * 23310000 * THEN DO; 23320000 CLC TYPE2(4),@C33 0668 23330000 BC 07,@94D 0668 23340000 * /* ************************************************ * 23350000 * /* A SYSTEM LIBRARY (SYS1.FORTLIB,ETC.) IS TO BE * 23360000 * /* ALLOCATED. NAME IS ALREADY SET UP FOR ALLOCATION* 23370000 * /* ************************************************ * 23380000 * DA08UID='0'B; /* DONT PREFIX USERID * 23390000 NI 71(@1),B'11011111' 0670 23400000 * GO TO ALLOC; 23410000 BC 15,ALLOC 0671 23420000 * END; 23430000 * IF TYPE2='DEFL' /* USE DEFAULT NAME? * 23440000 * THEN DO; 23450000 @94D CLC TYPE2(4),@C24 0673 23460000 BC 07,@94C 0673 23470000 * /* ************************************************ * 23480000 * /* USE DEFAULT DATA SET NAME. * 23490000 * /* ************************************************ * 23500000 * DSNLNGTH=DEFLEN; /* GET LENGTH * 23510000 L @1,MSGPARM+92 MSGPARM 0675 23520000 MVC 0(2,@1),DEFAULT 0675 23530000 * DSNM=' '; 23540000 MVI 2(@1),C' ' 0676 23550000 MVC 3(43,@1),2(@1) 0676 23560000 * IF DEFLEN^=0 /* IS LENGTH NON-ZERO? * 23570000 * /* GET DATA SET NAME. * 23580000 * THEN DSNM(1:DEFLEN)=DEFNME(1:DEFLEN); 23590000 SR @F,@F 0677 23600000 CH @F,DEFAULT 0677 23610000 BC 08,@94B 0677 23620000 LA @E,DEFAULT+2 0678 23630000 LH @6,DEFAULT 0678 23640000 BCTR @6,0 0678 23650000 LA @A,2(0,@1) 0678 23660000 EX @6,@MVC 0678 23670000 * DA08MNM=DEFMEM; /* GET DEFAULT MEMBER NAME * 23680000 @94B L @1,MSGPARM 0679 23690000 MVC 52(8,@1),DEFAULT+46 0679 23700000 * TADD='UADD'; /* SET CODE TO UNCOND. ADD * 23710000 MVC TADD(4),@C44 0680 23720000 * GO TO ADDQ; /* GO ADD QUALIFIER * 23730000 BC 15,ADDQ 0681 23740000 * END; 23750000 * ELSE DO; 23760000 * /* ************************************************ * 23770000 * /* USE DATA SET NAME FROM PDE - NO DEFAULTS. * 23780000 * /* ************************************************ * 23790000 * DSNLNGTH=DSL; /* GET LENGTH * 23800000 @94C L @1,MSGPARM+96 MSGPARM 0684 23810000 L @6,MSGPARM+92 MSGPARM 0684 23820000 MVC 0(2,@6),4(@1) 0684 23830000 * DSNM=' '; 23840000 MVI 2(@6),C' ' 0685 23850000 MVC 3(43,@6),2(@6) 0685 23860000 * /* IF DS. LENGTH NOT ZERO, MOVE IN DATA SET NAME. * 23870000 * IF DSN^=0 THEN DSNM(1:DSL)=DSN->CHARST(1:DSL); 23880000 SR @F,@F 0686 23890000 C @F,0(0,@1) 0686 23900000 BC 08,@949 0686 23910000 L @7,MSGPARM+96 MSGPARM 0687 23920000 L @7,0(0,@7) DATASET 0687 23930000 LR @E,@7 0687 23940000 LH @4,4(0,@1) 0687 23950000 BCTR @4,0 0687 23960000 LA @A,2(0,@6) 0687 23970000 EX @4,@MVC 0687 23980000 * /* IF MEMBER SPECIFIED, MOVE IN MEMBER NAME * 23990000 * IF MEM^=0 THEN DA08MNM=MEM->CHARST(1:MEML); 24000000 @949 SR @F,@F 0688 24010000 L @1,MSGPARM+96 MSGPARM 0688 24020000 C @F,8(0,@1) 0688 24030000 BC 08,@948 0688 24040000 LH @6,12(0,@1) 0689 24050000 BCTR @6,0 0689 24060000 L @7,MSGPARM+96 MSGPARM 0689 24070000 L @7,8(0,@7) DATASET 0689 24080000 LR @E,@7 0689 24090000 L @4,MSGPARM 0689 24100000 LA @A,52(0,@4) 0689 24110000 MVI 0(@A),C' ' 0689 24120000 MVC 1(007,@A),0(@A) 0689 24130000 EX @6,@MVC 0689 24140000 * /* IF PASSWORD SPECIFIED, MOVE IN PASSWORD * 24150000 * IF PASS^=0 THEN DA08PSWD=PASS->CHARST(1:PASSL); 24160000 @948 SR @F,@F 0690 24170000 L @1,MSGPARM+96 MSGPARM 0690 24180000 C @F,16(0,@1) 0690 24190000 BC 08,@947 0690 24200000 LH @6,20(0,@1) 0691 24210000 BCTR @6,0 0691 24220000 L @7,MSGPARM+96 MSGPARM 0691 24230000 L @7,16(0,@7) DATASET 0691 24240000 LR @E,@7 0691 24250000 L @4,MSGPARM 0691 24260000 LA @A,60(0,@4) 0691 24270000 MVI 0(@A),C' ' 0691 24280000 MVC 1(007,@A),0(@A) 0691 24290000 EX @6,@MVC 0691 24300000 * IF DSF(2)='1'B /* DATA SET FULLY QUALIFIED? * 24310000 * THEN DO; 24320000 @947 L @1,MSGPARM+96 MSGPARM 0692 24330000 TM 6(@1),B'01000000' 0692 24340000 BC 12,@946 0692 24350000 * /* **************************************** * 24360000 * /* DATA SET FULLY QUALIFIED * 24370000 * /* **************************************** * 24380000 * DA08UID='0'B; /* DON'T ADD USERID * 24390000 L @6,MSGPARM 0694 24400000 NI 71(@6),B'11011111' 0694 24410000 * GO TO ALLOC; /* GO ALLOCATE DATA SET * 24420000 BC 15,ALLOC 0695 24430000 * END; 24440000 * END; 24450000 @946 EQU * 0697 24460000 * /* ******************************************************** * 24470000 * /* ADD DESCRIPTIVE QUALIFIER AND SET USERID BIT. * 24480000 * /* ******************************************************** * 24490000 * ADDQ: CALL QCHECK(TADD); /* ADD QUALIFIER TO DSNAME * 24500000 @94A EQU * 0698 24510000 ADDQ LA @F,TADD 0698 24520000 ST @F,@PL004 0698 24530000 LA @1,@PL004 0698 24540000 BAL @E,QCHECK 0698 24550000 * DA08UID='1'B; /* ADD USERID TO NAME * 24560000 L @1,MSGPARM 0699 24570000 OI 71(@1),B'00100000' 0699 24580000 * /* ******************************************************** * 24590000 * /* ALLOCAT%E DATA SETS VIA DAIR. * 24600000 * /* ******************************************************** * 24610000 * ALLOC: IF TYPE1='LOAD' /* LOAD MODULE BEING ALLOC.? * 24620000 * THEN DO; /* YES * 24630000 ALLOC CLC TYPE1(4),@C6 0700 24640000 BC 07,@943 0700 24650000 * IF DA08MNM=BLANKS /* MEMBER NAME GIVEN? * 24660000 * THEN DA08MNM='TEMPNAME'; /* NO - USE TEMPNAME * 24670000 L @1,MSGPARM 0702 24680000 CLC 52(8,@1),BLANKS 0702 24690000 BC 07,@942 0702 24700000 MVC 52(8,@1),@C46 0703 24710000 * IF LKDCBS=1 /* DCBS SPECIFIED? OY00686 * 24720000 * THEN DA08BLK=DCBSBLK; /* YES - USE BLOCKSIZE * 24730000 @942 L @6,PDLPTR 0704 24740000 CLC 56(2,@6),@D3 0704 24750000 BC 07,@941 0704 24760000 MVC 36(4,@1),DCBSBLK 0705 24770000 * END; 24780000 @941 EQU * 0706 24790000 * IF TYPE1='LIBR' THEN DA08MNM=BLANKS; /* LIB DATA SET HAS * 24800000 @943 CLC TYPE1(4),@C30 0707 24810000 BC 07,@940 0707 24820000 L @1,MSGPARM 0708 24830000 MVC 52(8,@1),BLANKS 0708 24840000 * /* NO MEMBER NAME * 24850000 * IF TYPE1='INPT' THEN DO; 24860000 @940 CLC TYPE1(4),@C39 0709 24870000 BC 07,@93F 0709 24880000 * /* INPUT DATA SETS MUST BE ALLOCATED * 24890000 * /* FIRST WITH NO MEMBER NAME. * 24900000 * NAME1=DA08MNM; /* SAVE MEMBER NAME * 24910000 L @1,MSGPARM 0711 24920000 MVC BLDLST+4(8),52(@1) 0711 24930000 * DA08MNM=BLANKS; /* BLANK OUT MEMBER * 24940000 MVC 52(8,@1),BLANKS 0712 24950000 * END; 24960000 * ALLOC2: DA08PDSN=ADDR(DSNAME); /* SET DSNAME POINTER * 24970000 @93F EQU * 0714 24980000 ALLOC2 L @1,MSGPARM+92 MSGPARM 0714 24990000 L @6,MSGPARM 0714 25000000 ST @1,8(0,@6) 0714 25010000 * LNK: DAPLDAPB=ADDR(DAIR08); /* SET POINTER TO BLOCK * 25020000 LNK LA @F,DAIR08 0715 25030000 L @1,DAPLPTR 0715 25040000 ST @F,16(0,@1) 0715 25050000 * DA08DDN=BLANKS; /* BLANK OUT DDNAME. * 25060000 L @6,MSGPARM 0716 25070000 MVC 12(8,@6),BLANKS 0716 25080000 * DA08FLG=0; /* ZERO OUT FLAGS ZA00136 * 25090000 MVC 2(2,@6),@D2 0717 25100000 * DA08DARC=0; /* ZERO OUT DYN. ALL. RETURN * 25110000 SR @F,@F 0718 25120000 STH @F,4(0,@6) 0718 25130000 * DA08CTRC=0; /* ZERO OUT CATLG. RETURN CD. * 25140000 STH @F,6(0,@6) 0719 25150000 * DA08DSO='00'X; /* ZERO OUT DSORG FIELD * 25160000 MVI 75(@6),X'00' 0720 25170000 * R1=DAPLPTR; /* SET PTR. TO DAIR PARM-LIST * 25180000 L @1,DAPLPTR 0721 25190000 * GEN(LINK EP=IKJDAIR); /* GO TO DAIR * 25200000 LINK EP=IKJDAIR 25210000 DS 0H 25220000 * RCODE=R15; 25230000 STH @F,MSGPARM+6 0723 25240000 * IF RCODE=0 & TYPE1='LIBR' /* LIBRARY DATA SET * 25250000 * THEN IF DA08DSO='02'X /* A PDS? * 25260000 SR @F,@F 0724 25270000 CH @F,MSGPARM+6 0724 25280000 BC 07,@93E 0724 25290000 CLC TYPE1(4),@C30 0724 25300000 BC 07,@93D 0724 25310000 * THEN GO TO LST; /* YES - ADD DDNAME TO LIST * 25320000 CLI 75(@6),X'02' 0725 25330000 BC 08,LST 0726 25340000 * ELSE DO; 25350000 * MES=20; /* LIBRARY NOT A PDS * 25360000 LA @F,20 0728 25370000 ST @F,MES 0728 25380000 * GO TO PRNTM; /* PRINT MESSAGE * 25390000 BC 15,PRNTM 0729 25400000 * END; 25410000 * IF RCODE=0 & DA08DSO='02'X /* DATA SET A PDS? * 25420000 * THEN IF DA08MNM=BLANKS /* NO MEMBER NAME GIVEN * 25430000 @93D EQU * 0731 25440000 @93E SR @F,@F 0731 25450000 CH @F,MSGPARM+6 0731 25460000 BC 07,@93C 0731 25470000 L @1,MSGPARM 0731 25480000 CLI 75(@1),X'02' 0731 25490000 BC 07,@93B 0731 25500000 * THEN IF TYPE1='INPT' /* INPUT DATA SET? * 25510000 CLC 52(8,@1),BLANKS 0732 25520000 BC 07,@93A 0732 25530000 * THEN GO TO INP; /* SEE IF MEMBER EXISTS.* 25540000 CLC TYPE1(4),@C39 0733 25550000 BC 08,INP 0734 25560000 * ELSE DO; 25570000 * /* ******************************** * 25580000 * /* ALLOCATE WITH MEMBER 'TEMPNAME' * 25590000 * /* ******************************** * 25600000 * DA08MNM='TEMPNAME'; 25610000 MVC 52(8,@1),@C46 0736 25620000 * UNALLOC: DAPB1PTR=ADDR(DAIR18); 25630000 UNALLOC LA @F,DAIR18 0737 25640000 ST @F,DAPB1PTR 0737 25650000 * GEN(XC DAIR18+2(38),DAIR18+2); 25660000 XC DAIR18+2(38),DAIR18+2 25670000 DS 0H 25680000 * IF DA08UID='1'B /*ADD USERID? * 25690000 * THEN DA18UID='1'B; /* YES * 25700000 L @1,MSGPARM 0739 25710000 TM 71(@1),B'00100000' 0739 25720000 BC 12,@939 0739 25730000 L @6,DAPB1PTR 0740 25740000 OI 31(@6),B'00100000' 0740 25750000 * DA18DDN=DA08DDN; /* SET DDNAME * 25760000 @939 L @6,DAPB1PTR 0741 25770000 MVC 12(8,@6),12(@1) 0741 25780000 * DA18MNM=BLANKS; /* CLEAR ZA00136 * 25790000 MVC 20(8,@6),BLANKS 0742 25800000 * /* MEMBER NAME TO BLANKS ZA00136 * 25810000 * DA18SCLS=BLANKS; /* CLEAR ZA00136 * 25820000 MVC 28(2,@6),BLANKS 0743 25830000 * /* SYSOUT CLASSS TO BLANKS ZA00136 * 25840000 * DAPLDAPB=ADDR(DAIR18); /* SET POINTER* 25850000 LA @F,DAIR18 0744 25860000 L @7,DAPLPTR 0744 25870000 ST @F,16(0,@7) 0744 25880000 * R1=DAPLPTR; /* SET LIST POINTER * 25890000 L @1,DAPLPTR 0745 25900000 * GEN(LINK EP=IKJDAIR); /* GO UNALLO.* 25910000 LINK EP=IKJDAIR 25920000 DS 0H 25930000 * GO TO LNK; 25940000 BC 15,LNK 0747 25950000 * END; 25960000 * ELSE IF TYPE1='INPT' /* INPUT DATA SET? * 25970000 * THEN GO TO LST; /* YES - ADD TO LIST * 25980000 @93A CLC TYPE1(4),@C39 0749 25990000 BC 08,LST 0750 26000000 * ELSE GO TO ENDAL; /* NO - FINISHED * 26010000 BC 15,ENDAL 0751 26020000 * IF RCODE=0 /* RETURN CODE = 0 ? * 26030000 * THEN IF TYPE1='INPT' /* INPUT DATA SET? * 26040000 @938 EQU * 0752 26050000 @93B EQU * 0752 26060000 @93C SR @F,@F 0752 26070000 CH @F,MSGPARM+6 0752 26080000 BC 07,@937 0752 26090000 * THEN GO TO LST; /* YES - ADD TO INPUT LIST * 26100000 CLC TYPE1(4),@C39 0753 26110000 BC 08,LST 0754 26120000 * ELSE GO TO ENDAL; /* NO - FINISHED * 26130000 BC 15,ENDAL 0755 26140000 * MES=0; /* INITIALIZE MESSAGE NUMBER * 26150000 @937 SR @F,@F 0756 26160000 ST @F,MES 0756 26170000 * IF RCODE=4 /* NAME GT. 44 CHARACTERS? * 26180000 * THEN DO; /* YES * 26190000 LA @F,4 0757 26200000 CH @F,MSGPARM+6 0757 26210000 BC 07,@936 0757 26220000 * MES=18; /* SET MESSAGE CODE * 26230000 LA @F,18 0759 26240000 ST @F,MES 0759 26250000 * GO TO PRNTM; /* PRINT MESSAGE * 26260000 BC 15,PRNTM 0760 26270000 * END; 26280000 * IF RCODE=8 /* CATALOG ERROR? * 26290000 * THEN DO; /* YES - WHICH ONE * 26300000 @936 LA @F,8 0762 26310000 CH @F,MSGPARM+6 0762 26320000 BC 07,@935 0762 26330000 * IF DA08CTRC=4 26340000 * THEN MES=5; /* VOLUME NOT MOUNTED * 26350000 LA @F,4 0764 26360000 L @1,MSGPARM 0764 26370000 CH @F,6(0,@1) 0764 26380000 BC 07,@934 0764 26390000 LA @F,5 0765 26400000 ST @F,MES 0765 26410000 * IF DA08CTRC=8 /* DATA SET NOT FOUND OY00595 * 26420000 * THEN IF TYPE1='PRNT' & /* ALLOCATE PRINT OY00595 * 26430000 @934 LA @F,8 0766 26440000 CH @F,6(0,@1) 0766 26450000 BC 07,@933 0766 26460000 * DA08OLD='1'B /* DATA SET NEW OY00595 * 26470000 * THEN GO TO NW; 26480000 CLC TYPE1(4),@C23 0767 26490000 BC 07,@932 0767 26500000 TM 68(@1),B'00000001' 0767 26510000 BC 03,NW 0768 26520000 * ELSE IF TYPE1='LOAD' & 26530000 * /* ALLOC LOAD OY00595 * 26540000 * DA08SHR='1'B 26550000 * /* DATA SET NEW OY00595 * 26560000 * THEN GO TO NW; 26570000 @931 EQU * 0769 26580000 @932 CLC TYPE1(4),@C6 0769 26590000 BC 07,@930 0769 26600000 L @1,MSGPARM 0769 26610000 TM 68(@1),B'00001000' 0769 26620000 BC 03,NW 0770 26630000 * ELSE MES=1; /* NOT IN CATALOG * 26640000 @92F EQU * 0771 26650000 @930 LA @F,1 0771 26660000 ST @F,MES 0771 26670000 * IF DA08CTRC=12 | 26680000 * DA08CTRC=16 | /* 8, 12 OR 16 MEANS INVALID * 26690000 * DA08CTRC=8 26700000 * THEN IF TYPE1='PRNT' | 26710000 @933 LA @F,12 0772 26720000 L @1,MSGPARM 0772 26730000 CH @F,6(0,@1) 0772 26740000 BC 08,@92E 0772 26750000 LA @F,16 0772 26760000 CH @F,6(0,@1) 0772 26770000 BC 08,@92D 0772 26780000 LA @F,8 0772 26790000 CH @F,6(0,@1) 0772 26800000 BC 07,@92C 0772 26810000 * TYPE1='LOAD' 26820000 * THEN MES=31; /* CATALOG STRUCTURE * 26830000 @92D EQU * 0773 26840000 @92E CLC TYPE1(4),@C23 0773 26850000 BC 08,@92B 0773 26860000 CLC TYPE1(4),@C6 0773 26870000 BC 07,@92A 0773 26880000 @92B LA @F,31 0774 26890000 ST @F,MES 0774 26900000 BC 15,@929 0775 26910000 * ELSE MES=1; 26920000 @92A LA @F,1 0775 26930000 ST @F,MES 0775 26940000 * IF DA08CTRC=28 26950000 * THEN MES=9; /* CATALOG I/O ERROR * 26960000 @929 EQU * 0776 26970000 @92C LA @F,28 0776 26980000 L @1,MSGPARM 0776 26990000 CH @F,6(0,@1) 0776 27000000 BC 07,@928 0776 27010000 LA @F,9 0777 27020000 ST @F,MES 0777 27030000 * IF MES=0 /* NO ERROR FOUND * 27040000 * THEN MES=7; /* GIVE CATALOG RETURN CODE * 27050000 @928 SR @F,@F 0778 27060000 C @F,MES 0778 27070000 BC 07,@927 0778 27080000 LA @F,7 0779 27090000 ST @F,MES 0779 27100000 * END; 27110000 @927 EQU * 0780 27120000 * IF RCODE=12 /* RETURN CODE IS 12? * 27130000 * THEN DO; /* YES - FIND WHAT IS WRONG * 27140000 @935 LA @F,12 0781 27150000 CH @F,MSGPARM+6 0781 27160000 BC 07,@926 0781 27170000 * IF DA08DARC='6708'X 27180000 * THEN MES=4; /* DATA SET NOT ON VOLUME * 27190000 L @F,@X47 0783 27200000 L @1,MSGPARM 0783 27210000 CH @F,4(0,@1) 0783 27220000 BC 07,@925 0783 27230000 LA @F,4 0784 27240000 ST @F,MES 0784 27250000 * IF DA08DARC='0218'X 27260000 * THEN MES=5; /* VOLUME NOT MOUNTED * 27270000 @925 L @F,@X48 0785 27280000 CH @F,4(0,@1) 0785 27290000 BC 07,@924 0785 27300000 LA @F,5 0786 27310000 ST @F,MES 0786 27320000 * IF DA08DARC='0210'X 27330000 * THEN MES=10; /* DATA SET IN USE * 27340000 @924 L @F,@X49 0787 27350000 CH @F,4(0,@1) 0787 27360000 BC 07,@923 0787 27370000 LA @F,10 0788 27380000 ST @F,MES 0788 27390000 * IF DA08DARC='0330'X /* MEMBER GIVEN FOR NON-PDS * 27400000 * THEN IF TYPE1='LOAD' /* LOAD MOD. DATA SET? * 27410000 @923 L @F,@X50 0789 27420000 CH @F,4(0,@1) 0789 27430000 BC 07,@922 0789 27440000 * THEN MES=19; /* LOAD MODULE NOT PARTITIONED* 27450000 CLC TYPE1(4),@C6 0790 27460000 BC 07,@921 0790 27470000 LA @F,19 0791 27480000 ST @F,MES 0791 27490000 BC 15,@920 0792 27500000 * ELSE MES=24; /* MEMBER FOR SEQ. DATA SET * 27510000 @921 LA @F,24 0792 27520000 ST @F,MES 0792 27530000 * IF DA08DARC>'4700'X & /* DADSM ERROR? * 27540000 * DA08DARC<='47FF'X 27550000 * THEN DO; /* YES - SEE WHICH * 27560000 @920 EQU * 0793 27570000 @922 L @F,@X51 0793 27580000 L @1,MSGPARM 0793 27590000 CH @F,4(0,@1) 0793 27600000 BC 10,@91F 0793 27610000 L @F,@X52 0793 27620000 CH @F,4(0,@1) 0793 27630000 BC 04,@91E 0793 27640000 * IF TYPE2='UTIL' 27650000 * THEN MES=29; /* DADSM ON UTILITY * 27660000 CLC TYPE2(4),@C29 0795 27670000 BC 07,@91D 0795 27680000 LA @F,29 0796 27690000 ST @F,MES 0796 27700000 BC 15,@91C 0797 27710000 * ELSE MES=28; /* DADSM ON DATA SET * 27720000 @91D LA @F,28 0797 27730000 ST @F,MES 0797 27740000 * IF DA08DARC='4714'X 27750000 * THEN MES=32; /* NOT ENOUGH SPACE * 27760000 @91C L @F,@X53 0798 27770000 CH @F,4(0,@1) 0798 27780000 BC 07,@91B 0798 27790000 LA @F,32 0799 27800000 ST @F,MES 0799 27810000 * END; 27820000 @91B EQU * 0800 27830000 * IF MES=0 /* NONE OF THESE ERRORS? * 27840000 * THEN DO; /* NO - DYNAMIC ALLOC. ERROR * 27850000 @91E EQU * 0801 27860000 @91F SR @F,@F 0801 27870000 C @F,MES 0801 27880000 BC 07,@91A 0801 27890000 * IF TYPE2='UTIL' /* UTILITY DATA SET? * 27900000 * THEN MES=8;/* YES * 27910000 CLC TYPE2(4),@C29 0803 27920000 BC 07,@919 0803 27930000 LA @F,8 0804 27940000 ST @F,MES 0804 27950000 BC 15,@918 0805 27960000 * ELSE MES=6;/* NO * 27970000 @919 LA @F,6 0805 27980000 ST @F,MES 0805 27990000 * END; 28000000 @918 EQU * 0806 28010000 * END; 28020000 @91A EQU * 0807 28030000 * IF RCODE=16 /* NO MORE ROOM IN TABLES * 28040000 * THEN IF TYPE2='UTIL' /* UTILITY DATA SET? * 28050000 @926 LA @F,16 0808 28060000 CH @F,MSGPARM+6 0808 28070000 BC 07,@917 0808 28080000 * THEN MES=3; /* YES * 28090000 CLC TYPE2(4),@C29 0809 28100000 BC 07,@916 0809 28110000 LA @F,3 0810 28120000 ST @F,MES 0810 28130000 BC 15,@915 0811 28140000 * ELSE MES=2; /* NO * 28150000 @916 LA @F,2 0811 28160000 ST @F,MES 0811 28170000 * IF MES=0 /* MESSAGE STILL UNDEFINED? * 28180000 * THEN MES=30; /* GIVE COMMAND SYSTEM ERROR * 28190000 @915 EQU * 0812 28200000 @917 SR @F,@F 0812 28210000 C @F,MES 0812 28220000 BC 07,@914 0812 28230000 LA @F,30 0813 28240000 ST @F,MES 0813 28250000 * GO TO PRNTM; /* PRINT MESSAGE * 28260000 BC 15,PRNTM 0814 28270000 * /* ******************************************************** * 28280000 * /* ALLOCATE A NEW DATA SET. * 28290000 * /* ******************************************************** * 28300000 * NW: DA08DSP1='00'X; DA08NEW='1'B; /* ALLOCATE AS (NEW, * 28310000 NW L @1,MSGPARM 0815 28320000 MVI 68(@1),X'00' 0815 28330000 OI 68(@1),B'00000100' 0816 28340000 * DA08DPS2='00'X; DA08CAT='1'B; /* CATL, * 28350000 MVI 69(@1),X'00' 0817 28360000 OI 69(@1),B'00000010' 0818 28370000 * DA08DPS3='00'X; DA08CATL='1'B;/* CATL) * 28380000 MVI 70(@1),X'00' 0819 28390000 OI 70(@1),B'00000010' 0820 28400000 * IF DA08MNM=BLANKS THEN DA08DQTY=0; /* ALLOC. SEQUENTIAL * 28410000 CLC 52(8,@1),BLANKS 0821 28420000 BC 07,@913 0821 28430000 MVC 48(4,@1),@D5 0822 28440000 BC 15,@912 0823 28450000 * ELSE DA08DQTY=2; /* ALLOC. A PDS * 28460000 @913 MVC 48(4,@1),@D23 0823 28470000 * GO TO LNK; /* GO TO ALLOCATE THE D. SET * 28480000 BC 15,LNK 0824 28490000 * /* ******************************************************** * 28500000 * /* SEE IF INPUT DATA SET MEMBER EXISTS. * 28510000 * /* ******************************************************** * 28520000 * INP: FF=1; /* ONE BLDL ENTRY * 28530000 INP LA @F,1 0825 28540000 STH @F,BLDLST 0825 28550000 * LLL=14; /* 14 BYTE ENTRIES * 28560000 LA @F,14 0826 28570000 STH @F,BLDLST+2 0826 28580000 * IF NAME1=BLANKS /* MEMBER NAME GIVEN? * 28590000 * THEN NAME1='TEMPNAME'; /* NO - USE TEMPNAME * 28600000 CLC BLDLST+4(8),BLANKS 0827 28610000 BC 07,@911 0827 28620000 MVC BLDLST+4(8),@C46 0828 28630000 * R3=ADDR(INDCB); 28640000 @911 LA @3,INDCB 0829 28650000 * GENERATE; 28660000 USING IHADCB,R3 USE REG. 3 FOR DSECT BASE 28670000 MVC IHADCB(DCBSIZE),INSET MOVE DCB INFO INTO DYN. STORAGE 28680000 DS 0H 28690000 * DCBDDNAM=DA08DDN; /* MOVE DDNAME TO DCB * 28700000 L @1,MSGPARM 0831 28710000 MVC DCBDDNAM(8),12(@1) 0831 28720000 * OPTBYT='80'X; /* SET INPUT FLAG * 28730000 MVI DMLIST,X'80' 0832 28740000 * R1=ADDR(DMLIST); /* SET DATA MAN. LIST ADDR. * 28750000 LA @1,DMLIST 0833 28760000 * GENERATE; /* LOOK FOR SPEC. MEMBER * 28770000 OPEN ((3)),MF=(E,(1)) 28780000 BLDL INDCB,BLDLST 28790000 DS 0H 28800000 * RCODE=R15; /* SAVE BLDL RETURN CODE * 28810000 STH @F,MSGPARM+6 0835 28820000 * R1=ADDR(DMLIST); /* GET ADDR. OF DATA MAN. LST.* 28830000 LA @1,DMLIST 0836 28840000 * GEN(CLOSE ((3)),MF=(E,(1))); 28850000 CLOSE ((3)),MF=(E,(1)) 28860000 DS 0H 28870000 * DA08MNM=NAME1; /* SET DAIR MEMBER NAME * 28880000 L @1,MSGPARM 0838 28890000 MVC 52(8,@1),BLDLST+4 0838 28900000 * IF RCODE=0 /* MEMBER NAME FOUND? * 28910000 * THEN GO TO UNALLOC; /* YES - UNALLOCATE * 28920000 SR @F,@F 0839 28930000 CH @F,MSGPARM+6 0839 28940000 BC 08,UNALLOC 0840 28950000 * ELSE DO; /* NO - GIVE MESSAGE * 28960000 * MES=21; /* MEMBER NOT FOUND * 28970000 LA @F,21 0842 28980000 ST @F,MES 0842 28990000 * GO TO PRNTM; /* GO PRINT * 29000000 BC 15,PRNTM 0843 29010000 * END; 29020000 * GO TO ENDAL; 29030000 * /* ******************************************************** * 29040000 * /* ADD DDNAME TO LIST OF DATA SETS TO BE CONCATENATED * 29050000 * /* ******************************************************** * 29060000 * LST: DAPB0PTR=ADDR(DAIR0C); /* GET ADDRESS OF BLOCK * 29070000 LST LA @F,DAIR0C 0846 29080000 ST @F,MSGPARM 0846 29090000 * IF DA0CNUMB=25 /* CHECK FOR LIMIT OY00686 * 29100000 * THEN DO; /* DIAGNOSE ERROR OY00686 * 29110000 LA @F,25 0847 29120000 L @1,MSGPARM 0847 29130000 CH @F,8(0,@1) 0847 29140000 BC 07,@910 0847 29150000 * IF TYPE1='INPT' /* INPUT DATA SET OY00686 * 29160000 * THEN CALL AKJLKMSG(LSTPTR,25); 29170000 CLC TYPE1(4),@C39 0849 29180000 BC 07,@90F 0849 29190000 LA @F,LSTPTR 0850 29200000 ST @F,@PL004 0850 29210000 LA @F,@D6 0850 29220000 ST @F,@PL004+4 0850 29230000 L @F,@V1 ADDRESS OF AKJLKMSG 0850 29240000 LA @1,@PL004 0850 29250000 BALR @E,@F 0850 29260000 BC 15,@90C 0851 29270000 * /* LOG INPUT MSG OY00686 * 29280000 * ELSE CALL AKJLKMSG(LSTPTR,26); 29290000 @90F LA @F,LSTPTR 0851 29300000 ST @F,@PL004 0851 29310000 LA @F,@D9 0851 29320000 ST @F,@PL004+4 0851 29330000 L @F,@V1 ADDRESS OF AKJLKMSG 0851 29340000 LA @1,@PL004 0851 29350000 BALR @E,@F 0851 29360000 * /* LOG LIBRARY MSG OY00686 * 29370000 * GO TO ENDAL; /* CANCEL CONCATEN OY00686 * 29380000 BC 15,ENDAL 0852 29390000 * END; /* OY00686 * 29400000 * DA0CNUMB=DA0CNUMB+1; /* ADD TO COUNT OF DDNAMES * 29410000 @910 LA @F,1 0854 29420000 L @1,MSGPARM 0854 29430000 AH @F,8(0,@1) 0854 29440000 STH @F,8(0,@1) 0854 29450000 * IF DEFNME(1)=' ' & TYPE1='INPT' /* FIRST INPUT DATA SET * 29460000 * & TYPE2 ^= 'UTIL' /* NOT UTILITY DATA SET * 29470000 * THEN DO; /* YES - GET NAME FOR DEFAULTS* 29480000 CLI DEFAULT+2,C' ' 0855 29490000 BC 07,@909 0855 29500000 CLC TYPE1(4),@C39 0855 29510000 BC 07,@908 0855 29520000 CLC TYPE2(4),@C29 0855 29530000 BC 08,@907 0855 29540000 * IF DSF(2)='1'B /* DSNAME IN QUOTES @ZA28304 * 29550000 * THEN GO TO LST1; /* NO QUAL @ZA28304 * 29560000 L @6,MSGPARM+96 MSGPARM 0857 29570000 TM 6(@6),B'01000000' 0857 29580000 BC 01,LST1 0858 29590000 * ELSE DO; /* @ZA28304 * 29600000 * IF DSNLNGTH<5 /* CAN THERE BE QUAL @ZA28304 * 29610000 * THEN DO; /* @ZA28304 * 29620000 LA @F,5 0860 29630000 L @7,MSGPARM+92 MSGPARM 0860 29640000 CH @F,0(0,@7) 0860 29650000 BC 12,@906 0860 29660000 * DEFLEN=0; /*ZERO LENGTH @ZA28304* 29670000 SR @F,@F 0862 29680000 STH @F,DEFAULT 0862 29690000 * DEFNME=' '; /*BLANK NAME @ZA28304* 29700000 MVI DEFAULT+2,C' ' 0863 29710000 MVC DEFAULT+3(43),DEFAULT+2 0863 29720000 BC 15,@905 0865 29730000 * END; /* @ZA28304 * 29740000 * ELSE DO; /*REMOVE QUAL /* @ZA28304 * 29750000 * CALL QCHECK('SUBT'); /* @ZA28304 * 29760000 @906 LA @F,@C45 0866 29770000 ST @F,@PL004 0866 29780000 LA @1,@PL004 0866 29790000 BAL @E,QCHECK 0866 29800000 * DEFLEN=DSNLNGTH; /* @ZA28304 * 29810000 L @1,MSGPARM+92 MSGPARM 0867 29820000 MVC DEFAULT(2),0(@1) 0867 29830000 * DEFNME(1:DEFLEN)=DSNM(1:DEFLEN); 29840000 LA @E,2(0,@1) 0868 29850000 LH @6,DEFAULT 0868 29860000 BCTR @6,0 0868 29870000 LA @A,DEFAULT+2 0868 29880000 EX @6,@MVC 0868 29890000 * END; /* @ZA28304 * 29900000 * END; /* @ZA28304 * 29910000 * IF MEMF(1)='1'B /* MEMBER NAME GIVEN? * 29920000 * THEN DEFMEM=MEM->CHARST(1:MEML); /* MOVE IN * 29930000 @905 L @1,MSGPARM+96 MSGPARM 0871 29940000 TM 14(@1),B'10000000' 0871 29950000 BC 12,@902 0871 29960000 LH @6,12(0,@1) 0872 29970000 BCTR @6,0 0872 29980000 L @7,MSGPARM+96 MSGPARM 0872 29990000 L @7,8(0,@7) DATASET 0872 30000000 LR @E,@7 0872 30010000 LA @A,DEFAULT+46 0872 30020000 MVI 0(@A),C' ' 0872 30030000 MVC 1(007,@A),0(@A) 0872 30040000 EX @6,@MVC 0872 30050000 * END; 30060000 @902 EQU * 0873 30070000 * LST1: /* ZA03672 * 30080000 * PTR2=ADDR(DAIR08); /* GET POINTER TO 08 BLOCK * 30090000 @907 EQU * 0874 30100000 @908 EQU * 0874 30110000 @909 EQU * 0874 30120000 LST1 LA @F,DAIR08 0874 30130000 ST @F,PTR2 0874 30140000 * DA0CDDN(DA0CNUMB)=PTR2->DA08DDN; /* MOVE DDNAME TO LIST * 30150000 LR @1,@F 0875 30160000 L @7,MSGPARM 0875 30170000 LH @6,8(0,@7) 0875 30180000 SLA @6,3 0875 30190000 LA @A,DAIR0C+4(@6) 0875 30200000 MVC 0(8,@A),12(@1) 0875 30210000 * GO TO ENDAL; 30220000 BC 15,ENDAL 0876 30230000 * GENERATE; 30240000 INSET DCB DSORG=PO,MACRF=(R) 30250000 DCBSIZE EQU *-INSET 30260000 DCBD DSORG=PO 30270000 AKJLKL01 CSECT 30280000 DS 0H 30290000 * PRNTM: CALL AKJLKMSG(LSTPTR,MES); /* GO TO MESSAGE PROCESSOR * 30300000 PRNTM LA @F,LSTPTR 0878 30310000 ST @F,@PL004 0878 30320000 LA @F,MES 0878 30330000 ST @F,@PL004+4 0878 30340000 L @F,@V1 ADDRESS OF AKJLKMSG 0878 30350000 LA @1,@PL004 0878 30360000 BALR @E,@F 0878 30370000 * IF PROMPTM=0 /* NOT PROMPTING? * 30380000 * THEN RETURN TO FINIS; /* TERMINATE PROCESSING * 30390000 SR @F,@F 0879 30400000 CH @F,MSGPARM+4 0879 30410000 BC 07,@8FF 0879 30420000 L @D,4(0,@D) 0880 30430000 LA @E,FINIS 0880 30440000 LM @F,@C,16(@D) 0880 30450000 BCR 15,@E 0880 30460000 * ENDAL: END ALLOCDS; 30470000 @8FF EQU * 0881 30480000 ENDAL EQU * 0881 30490000 @EL04 L @D,4(0,@D) 0881 30500000 LM @E,@C,12(@D) 0881 30510000 BCR 15,@E 0881 30520000 * /* **************************************************************** * 30530000 * /* * 30540000 * /* THIS ROUTINE RECEIVES CONTROL WHEN AN ABEND OCCURS. THE ABEND * 30550000 * /* CODE IS STORED IN THE ECT AND THE ABEND FLAG IN THE ECT IS SET. * 30560000 * /* ANY CONCATENATED DATA SETS ARE DECONCATENATED. A RETURN CODE OF * 30570000 * /* 0 IS PLACED IN REGISTER 15. A RETURN IS ISSUED AND CONTROL GOES * 30580000 * /* BACK TO ABEND PROCESSING. * 30590000 * /* * 30600000 * /* **************************************************************** * 30610000 * ABEX: PROC OPTIONS(NOSAVEAREA,DONTSAVE); 30620000 ABEX EQU * 0882 30630000 * /* ******************************************************** * 30640000 * /* MAPS * 30650000 * /* ******************************************************** * 30660000 * DCL 1 WORKAREA BASED(R1), /* STAE WORK AREA * 30670000 * 2 PARMSREG PTR, /* POINTER TO BASE,DYNAM. REGS* 30680000 * 2 ABCODE FIXED(31); /* ABEND CODE * 30690000 * DCL 1 ECTBLK BASED(PTR1), /* STRUCTURE FOR ECT * 30700000 * 2 ECTRTCD FIXED(31), /* ABEND CODE * 30710000 * 3 ECTRCDF BIT(1); /* FLAGS * 30720000 * DCL FPTR2 PTR BASED(R13+8); /* FORWARD POINTER * 30730000 * /* ******************************************************** * 30740000 * /* DATA IN GETMAIN SPACE * 30750000 * /* ******************************************************** * 30760000 * DCL SAVEAR2(18) FIXED(31); /* INTERNAL SAVE AREA * 30770000 * DCL DAIR10 CHAR(16) BDY(WORD); /* DAIR DECONC BLK ZM00614 * 30780000 * /* ******************************************************** * 30790000 * /* MISCELLANEOUS * 30800000 * /* ******************************************************** * 30810000 * DCL R0 REG(0) FIXED(31); /* INDICATES WHERE ABEND CODE * 30820000 * /* IS. * 30830000 * RESTRICT(1); /* DONT DESTROY REG 1 @ZA18262* 30840000 * GEN; /* @ZA31176* 30850000 DROP R8,R9,R11 /* ESTABLISH @ZA31176*/ 30860000 USING ABEX,R15 /* BASE REGISTER @ZA31176*/ 30870000 DS 0H 30880000 * IF R0=12 THEN /* RETURN TO RTM IF @ZA31176* 30890000 C @0,@D13 0891 30900000 * GO TO ENDAB1; /* NO SDWA IS PRESENT @ZA31176* 30910000 BC 08,ENDAB1 0892 30920000 * GEN; /* @ZA31176* 30930000 DROP R15 /* SDWA IS PRESENT - @ZA31176*/ 30940000 USING @PSTART,@8 /* RESET BASE REGS AND @ZA31176*/ 30950000 USING @PSTART+4095,@9 /* SAVE RTM REGISTERS. @ZA31176*/ 30960000 USING @PSTART+8190,@B /* @ZA31176*/ 30970000 ST @E,12(0,@D) /* @ZA31176*/ 30980000 STM @0,@C,20(@D) /* @ZA31176*/ 30990000 DS 0H 31000000 * R8=PARMSREG->BASEREG(1); /* RESTORE 1ST BASE REG. ZA02180* 31010000 L @6,0(0,@1) 0894 31020000 L @8,0(0,@6) 0894 31030000 * R9=PARMSREG->BASEREG(2); /* RESTORE 2ND BASE REG. ZA02180* 31040000 L @9,4(0,@6) 0895 31050000 * R11=PARMSREG->BASEREG(3); /* RESTORE 3RD BASE REG. ZA02180* 31060000 L @B,8(0,@6) 0896 31070000 * R12=PARMSREG->DATAREG; /* RESTORE DATA REG. * 31080000 L @C,12(0,@6) 0897 31090000 * SAVEAR2(2)=R13; /* SET SAVE AREA PTR. * 31100000 ST @D,SAVEAR2+4 0898 31110000 * FPTR2=ADDR(SAVEAR2); /* SET FORWARD POINTER. * 31120000 LA @F,SAVEAR2 0899 31130000 ST @F,8(0,@D) 0899 31140000 * R13=FPTR2; /* POINT REG. 13 TO SAVE AREA * 31150000 L @D,8(0,@D) 0900 31160000 * PTR1=CPPLECT; /* SET POINTER TO ECT * 31170000 L @7,MSGPARM+104 MSGPARM 0901 31180000 MVC MSGPARM+96(4),12(@7) 0901 31190000 * ECTRTCD=ABCODE; /* GET ABEND CODE @ZA31176* 31200000 L @4,MSGPARM+96 MSGPARM 0902 31210000 MVC 0(4,@4),4(@1) 0902 31220000 * /* FROM STAE WORKAREA. * 31230000 * ECTRCDF='1'B; /* SET ABEND FLAG * 31240000 OI 0(@4),B'10000000' 0903 31250000 * /* ******************************************************** * 31260000 * /* DECONCATENATE INPUT AND LIBRARY DDNAMES IF NECESSARY * 31270000 * /* ******************************************************** * 31280000 * DAPB1PTR=ADDR(DAIR10); /* SET BLK PTR ZM00614 * 31290000 LA @F,DAIR10 0904 31300000 ST @F,DAPB1PTR 0904 31310000 * GEN(XC DAIR10(16),DAIR10); /* ZERO BLK ZM00614 * 31320000 XC DAIR10(16),DAIR10 31330000 DS 0H 31340000 * DA10CD='0010'X; /* SET FUNC CDE ZM00614 * 31350000 L @5,DAPB1PTR 0906 31360000 MVC 0(2,@5),@X55 0906 31370000 * DAPLPTR=ADDR(DAIRL); /* SET LIST PTR ZM00614 * 31380000 LA @F,DAIRL 0907 31390000 ST @F,DAPLPTR 0907 31400000 * DAPLUPT=CPPLUPT; /* SET UPT PTR ZM00614 * 31410000 LR @2,@F 0908 31420000 MVC 0(4,@2),4(@7) 0908 31430000 * DAPLECT=CPPLECT; /* SET ECT PTR ZM00614 * 31440000 MVC 4(4,@2),12(@7) 0909 31450000 * DAPLECB=ADDR(CPECB); /* SET ECB PTR ZM00614 * 31460000 LA @F,MSGPARM+100 0910 31470000 ST @F,8(0,@2) 0910 31480000 * DAPLPSCB=CPPLPSCB; /* SET PSCB PTR ZM00614 * 31490000 MVC 12(4,@2),8(@7) 0911 31500000 * DAPLDAPB=DAPB1PTR; /* SET DAIR BLK PTR ZM00614 * 31510000 MVC 16(4,@2),DAPB1PTR 0912 31520000 * DO I=1 TO 2; /* LOOP ON DDNAMES * 31530000 LA @F,1 0913 31540000 STH @F,I 0913 31550000 * IF DDNAME(I)=' ' /* IS DDNAME BLANK? * 31560000 * THEN GO TO EL3; /* YES - DONT DECONCATENATE * 31570000 @DO8FE LH @6,I 0914 31580000 BCTR @6,0 0914 31590000 SLA @6,3 0914 31600000 L @7,BASE 0914 31610000 L @7,284(0,@7) DYNAM 0914 31620000 LA @A,0(@6,@7) 0914 31630000 CLC 0(8,@A),@C56 0914 31640000 BC 08,EL3 0915 31650000 * DA10DDN=DDNAME(I); /* SET DDNAME IN BLK ZM00614 * 31660000 LA @E,0(@6,@7) 0916 31670000 L @4,DAPB1PTR 0916 31680000 MVC 8(8,@4),0(@E) 0916 31690000 * R1=DAPLPTR; /* SET LIST PTR ZM00614 * 31700000 L @1,DAPLPTR 0917 31710000 * GEN(LINK EP=IKJDAIR); /* GO DECONCATENATE ZM00614 * 31720000 LINK EP=IKJDAIR 31730000 DS 0H 31740000 * EL3: END; /* END OF LOOP ON DDNAMES * 31750000 * R13=SAVEAR2(2); /* RESTORE REG. 13 * 31760000 EL3 LH @F,I 0919 31770000 AH @F,@D3 0919 31780000 @DO8FD STH @F,I 0919 31790000 CH @F,@D1 0919 31800000 BC 12,@DO8FE 0919 31810000 L @D,SAVEAR2+4 0920 31820000 * GEN; /* @ZA31176* 31830000 L @E,12(0,@D) /* RESTORE REGS @ZA31176*/ 31840000 LM @0,@C,20(@D) /* @ZA31176*/ 31850000 DS 0H 31860000 * ENDAB1: R15=0; /* CONTINUE ABEND @ZA31176* 31870000 ENDAB1 SR @F,@F 0922 31880000 * END ABEX; 31890000 @EL05 BCR 15,@E 0923 31900000 * FNL: END AKJLKL01 31910000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 31920000 * /*%INCLUDE SYSLIB (IKJPPL ) 31930000 * /*%INCLUDE SYSLIB (IKJDAPL ) 31940000 * /*%INCLUDE SYSLIB (IKJCPPL ) 31950000 * /*%INCLUDE SYSLIB (IKJDAP04) 31960000 * /*%INCLUDE SYSLIB (IKJDAP08) 31970000 * /*%INCLUDE SYSLIB (IKJDAP0C) 31980000 * /*%INCLUDE SYSLIB (IKJDAP10) 31990000 * /*%INCLUDE SYSLIB (IKJDAP18) 32000000 * /*%INCLUDE SYSLIB (IKJDAP1C) 32010000 * /*%INCLUDE SYSLIB (IKJDAP28) 32020000 * /*%INCLUDE SYSLIB (IKJDAP34) 32030000 * /*%INCLUDE SYSLIB (IKJDACB ) 32040000 * ; 32050000 BC 15,@EL01 0924 32060000 @DATA1 EQU * 32070000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 32080000 @1 EQU 01 32090000 @2 EQU 02 32100000 @3 EQU 03 32110000 @4 EQU 04 32120000 @5 EQU 05 32130000 @6 EQU 06 32140000 @7 EQU 07 32150000 @8 EQU 08 32160000 @9 EQU 09 32170000 @A EQU 10 32180000 @B EQU 11 32190000 @C EQU 12 32200000 @D EQU 13 32210000 @E EQU 14 32220000 @F EQU 15 32230000 @D5 DC F'0' 32240000 @D6 DC F'25' 32250000 @D7 DC F'34' 32260000 @D9 DC F'26' 32270000 @D12 DC F'33' 32280000 @D13 DC F'12' 32290000 @D14 DC F'13' 32300000 @D15 DC F'14' 32310000 @D18 DC F'15' 32320000 @D19 DC F'11' 32330000 @D20 DC F'17' 32340000 @D22 DC F'23' 32350000 @D23 DC F'2' 32360000 @D1 DC H'2' 32370000 @D2 DC H'0' 32380000 @D3 DC H'1' 32390000 @D4 DC H'6' 32400000 @D8 DC H'7' 32410000 @D10 DC H'5' 32420000 @D11 DC H'-1' 32430000 @D16 DC H'9' 32440000 @D17 DC H'15' 32450000 @D21 DC H'46' 32460000 @CLC CLC 0(1,@A),0(@E) 32470000 @MVC MVC 0(1,@A),0(@E) 32480000 @V1 DC V(AKJLKMSG) 32490000 DS 0F 32500000 @SIZ001 DC AL1(&SPN) 32510000 DC AL3(@DATEND-@DATD) 32520000 DS 0F 32530000 @C4 DC C'LINK' 32540000 @C6 DC C'LOAD' 32550000 @C8 DC C'&&CS0' 32560000 @X15 DC X'00000002' 32570000 @C17 DC C'LKLDATTR' 32580000 @C21 DC C'LOADLIST' 32590000 @C22 DC C'LINKLIST' 32600000 @C23 DC C'PRNT' 32610000 @C24 DC C'DEFL' 32620000 @C26 DC C'NODF' 32630000 @C27 DC C'LOAD ' 32640000 @C29 DC C'UTIL' 32650000 @C30 DC C'LIBR' 32660000 @X31 DC X'FF000000' 32670000 @C33 DC C'SYSL' 32680000 @C38 DC C' ' 32690000 @C39 DC C'INPT' 32700000 @C41 DC C'OBJ ' 32710000 @C42 DC C'DATA ' 32720000 @C43 DC C'CADD' 32730000 @C44 DC C'UADD' 32740000 @C45 DC C'SUBT' 32750000 @C46 DC C'TEMPNAME' 32760000 @X47 DC X'00006708' 32770000 @X48 DC X'00000218' 32780000 @X49 DC X'00000210' 32790000 @X50 DC X'00000330' 32800000 @X51 DC X'00004700' 32810000 @X52 DC X'000047FF' 32820000 @X53 DC X'00004714' 32830000 @C56 DC C' ' 32840000 @X9 DC X'0008' 32850000 @X10 DC X'000C' 32860000 @X11 DC X'001C' 32870000 @X12 DC X'0004' 32880000 @X13 DC X'0018' 32890000 @X14 DC X'0028' 32900000 @X16 DC X'0034' 32910000 @X55 DC X'0010' 32920000 @C28 DC C'&&SYSUT1' 32930000 @C32 DC C'SYS1.' 32940000 DS 0D 32950000 @DATA EQU * 32960000 BLANKS EQU * 8 BYTE(S) 32970000 DC C' ' 32980000 DC 00007C' ' 32990000 LKADCON EQU * FULLWORD POINTER 33000000 DC AL4(LKPARSE) 33010000 LDADCON EQU * FULLWORD POINTER 33020000 DC AL4(LDPARSE) 33030000 LDLNGTHO EQU * 9*HALFWORD INTEGER 33040000 DC FL2'5' 33050000 DC FL2'3' 33060000 DC 00002FL2'5' 33070000 DC 00002FL2'3' 33080000 DC FL2'4' 33090000 DC FL2'3' 33100000 DC FL2'4' 33110000 NCHAR EQU * 15*HALFWORD INTEGER 33120000 DC FL2'6' 33130000 DC FL2'7' 33140000 DC FL2'6' 33150000 DC FL2'8' 33160000 DC FL2'7' 33170000 DC FL2'8' 33180000 DC FL2'5' 33190000 DC FL2'8' 33200000 DC FL2'8' 33210000 DC FL2'7' 33220000 DC FL2'9' 33230000 DC FL2'5' 33240000 DC FL2'6' 33250000 DC FL2'8' 33260000 DC FL2'7' 33270000 LIBNMS EQU * 6*7 BYTE(S) 33280000 DC C'PL1LIB' 33290000 DC 00001C' ' 33300000 DC C'FORTLIB' 33310000 DC C'COBLIB' 33320000 DC 00001C' ' 33330000 DC C'PLIBASE' 33340000 DC C'PLICMIX' 33350000 DC C'PL1LIB' 33360000 DC 00001C' ' 33370000 LDOPTS EQU * 9*5 BYTE(S) 33380000 DC C'SIZE=' 33390000 DC C'EP=' 33400000 DC 00002C' ' 33410000 DC C'NAME=' 33420000 DC C'PRINT' 33430000 DC C'MAP' 33440000 DC 00002C' ' 33450000 DC C'LET' 33460000 DC 00002C' ' 33470000 DC C'TERM' 33480000 DC 00001C' ' 33490000 DC C'RES' 33500000 DC 00002C' ' 33510000 DC C'CALL' 33520000 DC 00001C' ' 33530000 ORG @DATA+00000152 33540000 LKLNGTHO EQU * 22*HALFWORD INTEGER 33550000 DC FL2'5' 33560000 DC FL2'3' 33570000 DC FL2'4' 33580000 DC FL2'5' 33590000 DC FL2'3' 33600000 DC 00002FL2'4' 33610000 DC FL2'3' 33620000 DC 00006FL2'4' 33630000 DC 00003FL2'2' 33640000 DC 00004FL2'4' 33650000 DC FL2'6' 33660000 LKOPTS EQU * 22*6 BYTE(S) 33670000 DC C'SIZE=' 33680000 DC 00001C' ' 33690000 DC C'AC=' 33700000 DC 00003C' ' 33710000 DC C'DCBS' 33720000 DC 00002C' ' 33730000 DC C'PRINT' 33740000 DC 00001C' ' 33750000 DC C'MAP' 33760000 DC 00003C' ' 33770000 DC C'XREF' 33780000 DC 00002C' ' 33790000 DC C'LIST' 33800000 DC 00002C' ' 33810000 DC C'LET' 33820000 DC 00003C' ' 33830000 DC C'XCAL' 33840000 DC 00002C' ' 33850000 DC C'SCTR' 33860000 DC 00002C' ' 33870000 DC C'OVLY' 33880000 DC 00002C' ' 33890000 DC C'RENT' 33900000 DC 00002C' ' 33910000 DC C'REUS' 33920000 DC 00002C' ' 33930000 DC C'REFR' 33940000 DC 00002C' ' 33950000 DC C'NE' 33960000 DC 00004C' ' 33970000 DC C'OL' 33980000 DC 00004C' ' 33990000 DC C'DC' 34000000 DC 00004C' ' 34010000 DC C'TEST' 34020000 DC 00002C' ' 34030000 DC C'HIAR' 34040000 DC 00002C' ' 34050000 DC C'TERM' 34060000 DC 00002C' ' 34070000 DC C'NCAL' 34080000 DC 00002C' ' 34090000 DC C'ALIGN2' 34100000 CARDS EQU * 15*9 BYTE(S) 34110000 DC C'ALIAS' 34120000 DC 00004C' ' 34130000 DC C'CHANGE' 34140000 DC 00003C' ' 34150000 DC C'ENTRY' 34160000 DC 00004C' ' 34170000 DC C'INCLUDE' 34180000 DC 00002C' ' 34190000 DC C'INSERT' 34200000 DC 00003C' ' 34210000 DC C'LIBRARY' 34220000 DC 00002C' ' 34230000 DC C'NAME' 34240000 DC 00005C' ' 34250000 DC C'OVERLAY' 34260000 DC 00002C' ' 34270000 DC C'REPLACE' 34280000 DC 00002C' ' 34290000 DC C'SETSSI' 34300000 DC 00003C' ' 34310000 DC C'IDENTIFY' 34320000 DC 00001C' ' 34330000 DC C'PAGE' 34340000 DC 00005C' ' 34350000 DC C'ORDER' 34360000 DC 00004C' ' 34370000 DC C'SETCODE' 34380000 DC 00002C' ' 34390000 DC C'EXPAND' 34400000 DC 00003C' ' 34410000 PATCH EQU @DATA+00000463 500 BYTE(S) 34420000 LKPDL EQU 00000000 200 BYTE(S) ON WORD 34430000 A00004 EQU LKPDL+00000000 8 BYTE(S) 34440000 LKINPUT EQU LKPDL+00000008 28 BYTE(S) 34450000 LKLOAD EQU LKPDL+00000036 2 BYTE(S) 34460000 LKLIB EQU LKPDL+00000038 2 BYTE(S) 34470000 LKPLI EQU LKPDL+00000040 2 BYTE(S) 34480000 LKFORT EQU LKPDL+00000042 2 BYTE(S) 34490000 LKCOB EQU LKPDL+00000044 2 BYTE(S) 34500000 LKPLIB EQU LKPDL+00000046 2 BYTE(S) 34510000 LKPLIC EQU LKPDL+00000048 2 BYTE(S) 34520000 LKPL1 EQU LKPDL+00000050 2 BYTE(S) 34530000 LKSIZE EQU LKPDL+00000052 2 BYTE(S) 34540000 LKAC EQU LKPDL+00000054 2 BYTE(S) 34550000 LKDCBS EQU LKPDL+00000056 2 BYTE(S) 34560000 LKPRINT EQU LKPDL+00000058 2 BYTE(S) 34570000 LKMAP EQU LKPDL+00000060 2 BYTE(S) 34580000 LKXREF EQU LKPDL+00000062 2 BYTE(S) 34590000 LKLIST EQU LKPDL+00000064 2 BYTE(S) 34600000 LKLET EQU LKPDL+00000066 2 BYTE(S) 34610000 LKXCAL EQU LKPDL+00000068 2 BYTE(S) 34620000 LKSCTR EQU LKPDL+00000070 2 BYTE(S) 34630000 LKOVLY EQU LKPDL+00000072 2 BYTE(S) 34640000 LKRENT EQU LKPDL+00000074 2 BYTE(S) 34650000 LKREUS EQU LKPDL+00000076 2 BYTE(S) 34660000 LKREFR EQU LKPDL+00000078 2 BYTE(S) 34670000 LKNE EQU LKPDL+00000080 2 BYTE(S) 34680000 LKOL EQU LKPDL+00000082 2 BYTE(S) 34690000 LKDC EQU LKPDL+00000084 2 BYTE(S) 34700000 LKTEST EQU LKPDL+00000086 2 BYTE(S) 34710000 LKHIAR EQU LKPDL+00000088 2 BYTE(S) 34720000 LKTERM EQU LKPDL+00000090 2 BYTE(S) 34730000 LKNCAL EQU LKPDL+00000092 2 BYTE(S) 34740000 LKALIGN2 EQU LKPDL+00000094 2 BYTE(S) 34750000 LKLOADDS EQU LKPDL+00000096 24 BYTE(S) 34760000 LKPRNTDS EQU LKPDL+00000120 24 BYTE(S) 34770000 LKLIBRDS EQU LKPDL+00000144 28 BYTE(S) 34780000 LKSIZESF EQU LKPDL+00000172 12 BYTE(S) 34790000 LKDCBSSF EQU LKPDL+00000184 8 BYTE(S) 34800000 LKACSF EQU LKPDL+00000192 8 BYTE(S) 34810000 LDPDL EQU 00000000 152 BYTE(S) ON WORD 34820000 A00005 EQU LDPDL+00000000 8 BYTE(S) 34830000 LDINPUT EQU LDPDL+00000008 28 BYTE(S) 34840000 LDPARAM EQU LDPDL+00000036 8 BYTE(S) 34850000 LDLIB EQU LDPDL+00000044 2 BYTE(S) 34860000 LDPLI EQU LDPDL+00000046 2 BYTE(S) 34870000 LDFORT EQU LDPDL+00000048 2 BYTE(S) 34880000 LDCOB EQU LDPDL+00000050 2 BYTE(S) 34890000 LDPLIB EQU LDPDL+00000052 2 BYTE(S) 34900000 LDPLIC EQU LDPDL+00000054 2 BYTE(S) 34910000 LDPL1 EQU LDPDL+00000056 2 BYTE(S) 34920000 LDSIZE EQU LDPDL+00000058 2 BYTE(S) 34930000 LDEP EQU LDPDL+00000060 2 BYTE(S) 34940000 LDNAME EQU LDPDL+00000062 2 BYTE(S) 34950000 LDPRINT EQU LDPDL+00000064 2 BYTE(S) 34960000 LDMAP EQU LDPDL+00000066 2 BYTE(S) 34970000 LDLET EQU LDPDL+00000068 2 BYTE(S) 34980000 LDTERM EQU LDPDL+00000070 2 BYTE(S) 34990000 LDRES EQU LDPDL+00000072 2 BYTE(S) 35000000 LDCALL EQU LDPDL+00000074 2 BYTE(S) 35010000 LDPRNTDS EQU LDPDL+00000076 24 BYTE(S) 35020000 LDLIBRDS EQU LDPDL+00000100 28 BYTE(S) 35030000 LDSIZESF EQU LDPDL+00000128 8 BYTE(S) 35040000 LDEPSF EQU LDPDL+00000136 8 BYTE(S) 35050000 LDNAMESF EQU LDPDL+00000144 8 BYTE(S) 35060000 LIBS EQU 00000000 6*HALFWORD INTEGER 35070000 PARMS EQU 00000000 22*HALFWORD INTEGER 35080000 PPL EQU 00000000 28 BYTE(S) ON WORD 35090000 PPLUPT EQU PPL+00000000 FULLWORD POINTER 35100000 PPLECT EQU PPL+00000004 FULLWORD POINTER 35110000 PPLECB EQU PPL+00000008 FULLWORD POINTER 35120000 PPLPCL EQU PPL+00000012 FULLWORD POINTER 35130000 PPLANS EQU PPL+00000016 FULLWORD POINTER 35140000 PPLCBUF EQU PPL+00000020 FULLWORD POINTER 35150000 PPLUWA EQU PPL+00000024 FULLWORD POINTER 35160000 DAPL EQU 00000000 20 BYTE(S) ON WORD 35170000 DAPLUPT EQU DAPL+00000000 FULLWORD POINTER 35180000 DAPLECT EQU DAPL+00000004 FULLWORD POINTER 35190000 DAPLECB EQU DAPL+00000008 FULLWORD POINTER 35200000 DAPLPSCB EQU DAPL+00000012 FULLWORD POINTER 35210000 DAPLDAPB EQU DAPL+00000016 FULLWORD POINTER 35220000 CPPL EQU 00000000 16 BYTE(S) ON WORD 35230000 CPPLCBUF EQU CPPL+00000000 FULLWORD POINTER 35240000 CPPLUPT EQU CPPL+00000004 FULLWORD POINTER 35250000 CPPLPSCB EQU CPPL+00000008 FULLWORD POINTER 35260000 CPPLECT EQU CPPL+00000012 FULLWORD POINTER 35270000 DAPB04 EQU 00000000 16 BYTE(S) ON WORD 35280000 DA04CD EQU DAPB04+00000000 2 BYTE(S) 35290000 DA04FLG EQU DAPB04+00000002 2 BYTE(S) 35300000 A00006 EQU DAPB04+00000002 1 BIT(S) 35310000 A00007 EQU DAPB04+00000002 1 BIT(S) 35320000 A00008 EQU DAPB04+00000002 1 BIT(S) 35330000 A00009 EQU DAPB04+00000002 1 BIT(S) 35340000 A00010 EQU DAPB04+00000002 1 BIT(S) 35350000 DA04CAT EQU DAPB04+00000002 1 BIT(S) 35360000 DA04DSE EQU DAPB04+00000002 1 BIT(S) 35370000 A00011 EQU DAPB04+00000002 1 BIT(S) 35380000 A00012 EQU DAPB04+00000004 2 BYTE(S) 35390000 DA04CTRC EQU DAPB04+00000006 HALFWORD INTEGER 35400000 DA04PDSN EQU DAPB04+00000008 FULLWORD POINTER 35410000 DA04CTL EQU DAPB04+00000012 1 BYTE(S) 35420000 A00013 EQU DAPB04+00000012 1 BIT(S) 35430000 A00014 EQU DAPB04+00000012 1 BIT(S) 35440000 DA04UID EQU DAPB04+00000012 1 BIT(S) 35450000 A00015 EQU DAPB04+00000012 1 BIT(S) 35460000 A00016 EQU DAPB04+00000012 1 BIT(S) 35470000 A00017 EQU DAPB04+00000012 1 BIT(S) 35480000 A00018 EQU DAPB04+00000012 1 BIT(S) 35490000 A00019 EQU DAPB04+00000012 1 BIT(S) 35500000 A00020 EQU DAPB04+00000013 2 BYTE(S) 35510000 DA04DSO EQU DAPB04+00000015 1 BYTE(S) 35520000 DAPB08 EQU 00000000 84 BYTE(S) ON WORD 35530000 DA08CD EQU DAPB08+00000000 2 BYTE(S) 35540000 DA08FLG EQU DAPB08+00000002 2 BYTE(S) 35550000 DA08FPE EQU DAPB08+00000002 1 BIT(S) 35560000 A00021 EQU DAPB08+00000002 1 BIT(S) 35570000 A00022 EQU DAPB08+00000002 1 BIT(S) 35580000 A00023 EQU DAPB08+00000002 1 BIT(S) 35590000 A00024 EQU DAPB08+00000002 1 BIT(S) 35600000 A00025 EQU DAPB08+00000002 1 BIT(S) 35610000 A00026 EQU DAPB08+00000002 1 BIT(S) 35620000 A00027 EQU DAPB08+00000002 1 BIT(S) 35630000 DA08DARC EQU DAPB08+00000004 HALFWORD INTEGER 35640000 DA08CTRC EQU DAPB08+00000006 HALFWORD INTEGER 35650000 DA08PDSN EQU DAPB08+00000008 FULLWORD POINTER 35660000 DA08DDN EQU DAPB08+00000012 8 BYTE(S) 35670000 DA08UNIT EQU DAPB08+00000020 8 BYTE(S) 35680000 DA08SER EQU DAPB08+00000028 8 BYTE(S) 35690000 DA08BLK EQU DAPB08+00000036 4 BYTE(S) 35700000 DA08PQTY EQU DAPB08+00000040 4 BYTE(S) 35710000 DA08SQTY EQU DAPB08+00000044 4 BYTE(S) 35720000 DA08DQTY EQU DAPB08+00000048 4 BYTE(S) 35730000 DA08MNM EQU DAPB08+00000052 8 BYTE(S) 35740000 DA08PSWD EQU DAPB08+00000060 8 BYTE(S) 35750000 DA08DSP1 EQU DAPB08+00000068 1 BYTE(S) 35760000 A00028 EQU DAPB08+00000068 1 BIT(S) 35770000 A00029 EQU DAPB08+00000068 1 BIT(S) 35780000 A00030 EQU DAPB08+00000068 1 BIT(S) 35790000 A00031 EQU DAPB08+00000068 1 BIT(S) 35800000 DA08SHR EQU DAPB08+00000068 1 BIT(S) 35810000 DA08NEW EQU DAPB08+00000068 1 BIT(S) 35820000 DA08MOD EQU DAPB08+00000068 1 BIT(S) 35830000 DA08OLD EQU DAPB08+00000068 1 BIT(S) 35840000 DA08DPS2 EQU DAPB08+00000069 1 BYTE(S) 35850000 A00032 EQU DAPB08+00000069 1 BIT(S) 35860000 A00033 EQU DAPB08+00000069 1 BIT(S) 35870000 A00034 EQU DAPB08+00000069 1 BIT(S) 35880000 A00035 EQU DAPB08+00000069 1 BIT(S) 35890000 DA08KEEP EQU DAPB08+00000069 1 BIT(S) 35900000 DA08DEL EQU DAPB08+00000069 1 BIT(S) 35910000 DA08CAT EQU DAPB08+00000069 1 BIT(S) 35920000 DA08UCAT EQU DAPB08+00000069 1 BIT(S) 35930000 DA08DPS3 EQU DAPB08+00000070 1 BYTE(S) 35940000 A00036 EQU DAPB08+00000070 1 BIT(S) 35950000 A00037 EQU DAPB08+00000070 1 BIT(S) 35960000 A00038 EQU DAPB08+00000070 1 BIT(S) 35970000 A00039 EQU DAPB08+00000070 1 BIT(S) 35980000 DA08KEP EQU DAPB08+00000070 1 BIT(S) 35990000 DA08DELE EQU DAPB08+00000070 1 BIT(S) 36000000 DA08CATL EQU DAPB08+00000070 1 BIT(S) 36010000 DA08UNCT EQU DAPB08+00000070 1 BIT(S) 36020000 DA08CTL EQU DAPB08+00000071 1 BYTE(S) 36030000 DA08TRKS EQU DAPB08+00000071 1 BIT(S) 36040000 DA08ABKL EQU DAPB08+00000071 1 BIT(S) 36050000 DA08UID EQU DAPB08+00000071 1 BIT(S) 36060000 DA08RLSE EQU DAPB08+00000071 1 BIT(S) 36070000 DA08PERM EQU DAPB08+00000071 1 BIT(S) 36080000 DA08DMMY EQU DAPB08+00000071 1 BIT(S) 36090000 DA08ATRL EQU DAPB08+00000071 1 BIT(S) 36100000 A00040 EQU DAPB08+00000071 1 BIT(S) 36110000 A00041 EQU DAPB08+00000072 3 BYTE(S) 36120000 DA08DSO EQU DAPB08+00000075 1 BYTE(S) 36130000 DA08ALN EQU DAPB08+00000076 8 BYTE(S) 36140000 DAPB0C EQU 00000000 12 BYTE(S) ON WORD 36150000 DA0CCD EQU DAPB0C+00000000 2 BYTE(S) 36160000 DA0CFLG EQU DAPB0C+00000002 2 BYTE(S) 36170000 DA0CDARC EQU DAPB0C+00000004 HALFWORD INTEGER 36180000 A00042 EQU DAPB0C+00000006 2 BYTE(S) 36190000 DA0CNUMB EQU DAPB0C+00000008 HALFWORD INTEGER 36200000 A00043 EQU DAPB0C+00000010 2 BYTE(S) 36210000 DAPB10 EQU 00000000 16 BYTE(S) ON WORD 36220000 DA10CD EQU DAPB10+00000000 2 BYTE(S) 36230000 DA10FLG EQU DAPB10+00000002 2 BYTE(S) 36240000 DA10DARC EQU DAPB10+00000004 HALFWORD INTEGER 36250000 A00044 EQU DAPB10+00000006 2 BYTE(S) 36260000 DA10DDN EQU DAPB10+00000008 8 BYTE(S) 36270000 DAPB18 EQU 00000000 40 BYTE(S) ON WORD 36280000 DA18CD EQU DAPB18+00000000 2 BYTE(S) 36290000 DA18FLG EQU DAPB18+00000002 2 BYTE(S) 36300000 DA18FPE EQU DAPB18+00000002 1 BIT(S) 36310000 A00045 EQU DAPB18+00000002 1 BIT(S) 36320000 A00046 EQU DAPB18+00000002 1 BIT(S) 36330000 A00047 EQU DAPB18+00000002 1 BIT(S) 36340000 A00048 EQU DAPB18+00000002 1 BIT(S) 36350000 A00049 EQU DAPB18+00000002 1 BIT(S) 36360000 A00050 EQU DAPB18+00000002 1 BIT(S) 36370000 A00051 EQU DAPB18+00000002 1 BIT(S) 36380000 DA18DARC EQU DAPB18+00000004 HALFWORD INTEGER 36390000 DA18CTRC EQU DAPB18+00000006 HALFWORD INTEGER 36400000 DA18PDSN EQU DAPB18+00000008 FULLWORD POINTER 36410000 DA18DDN EQU DAPB18+00000012 8 BYTE(S) 36420000 DA18MNM EQU DAPB18+00000020 8 BYTE(S) 36430000 DA18SCLS EQU DAPB18+00000028 2 BYTE(S) 36440000 DA18DPS2 EQU DAPB18+00000030 1 BYTE(S) 36450000 A00052 EQU DAPB18+00000030 1 BIT(S) 36460000 A00053 EQU DAPB18+00000030 1 BIT(S) 36470000 A00054 EQU DAPB18+00000030 1 BIT(S) 36480000 A00055 EQU DAPB18+00000030 1 BIT(S) 36490000 DA18KEEP EQU DAPB18+00000030 1 BIT(S) 36500000 DA18DEL EQU DAPB18+00000030 1 BIT(S) 36510000 DA18CAT EQU DAPB18+00000030 1 BIT(S) 36520000 DA18UCAT EQU DAPB18+00000030 1 BIT(S) 36530000 DA18CTL EQU DAPB18+00000031 1 BYTE(S) 36540000 A00056 EQU DAPB18+00000031 1 BIT(S) 36550000 A00057 EQU DAPB18+00000031 1 BIT(S) 36560000 DA18UID EQU DAPB18+00000031 1 BIT(S) 36570000 DA18PERM EQU DAPB18+00000031 1 BIT(S) 36580000 A00058 EQU DAPB18+00000031 1 BIT(S) 36590000 A00059 EQU DAPB18+00000031 1 BIT(S) 36600000 A00060 EQU DAPB18+00000031 1 BIT(S) 36610000 A00061 EQU DAPB18+00000031 1 BIT(S) 36620000 DA18JBNM EQU DAPB18+00000032 8 BYTE(S) 36630000 DAPB1C EQU 00000000 24 BYTE(S) ON WORD 36640000 DA1CCD EQU DAPB1C+00000000 2 BYTE(S) 36650000 DA1CFLG EQU DAPB1C+00000002 2 BYTE(S) 36660000 DA1CDARC EQU DAPB1C+00000004 HALFWORD INTEGER 36670000 A00062 EQU DAPB1C+00000006 1 BYTE(S) 36680000 DA1CCTL EQU DAPB1C+00000007 1 BYTE(S) 36690000 A00063 EQU DAPB1C+00000007 4 BIT(S) 36700000 DA1CPERM EQU DAPB1C+00000007 1 BIT(S) 36710000 A00064 EQU DAPB1C+00000007 1 BIT(S) 36720000 DA1CATRL EQU DAPB1C+00000007 1 BIT(S) 36730000 A00065 EQU DAPB1C+00000007 1 BIT(S) 36740000 DA1CDDN EQU DAPB1C+00000008 8 BYTE(S) 36750000 DA1CALN EQU DAPB1C+00000016 8 BYTE(S) 36760000 DAPB28 EQU 00000000 8 BYTE(S) ON WORD 36770000 DA28CD EQU DAPB28+00000000 2 BYTE(S) 36780000 DA28NOP EQU DAPB28+00000002 HALFWORD INTEGER 36790000 DA28PFOP EQU DAPB28+00000004 FULLWORD POINTER 36800000 DA28OPTR EQU 00000008 2*FULLWORD POINTER 36810000 DAPB34 EQU 00000000 20 BYTE(S) ON WORD 36820000 DA34CD EQU DAPB34+00000000 2 BYTE(S) 36830000 DA34FLG EQU DAPB34+00000002 2 BYTE(S) 36840000 DA34FIND EQU DAPB34+00000002 1 BIT(S) 36850000 DA34DARC EQU DAPB34+00000004 HALFWORD INTEGER 36860000 DA34CTRL EQU DAPB34+00000006 1 BYTE(S) 36870000 DA34SRCH EQU DAPB34+00000006 1 BIT(S) 36880000 DA34CHN EQU DAPB34+00000006 1 BIT(S) 36890000 DA34UNCH EQU DAPB34+00000006 1 BIT(S) 36900000 A00066 EQU DAPB34+00000007 1 BYTE(S) 36910000 DA34NAME EQU DAPB34+00000008 8 BYTE(S) 36920000 DA34ADDR EQU DAPB34+00000016 FULLWORD POINTER 36930000 DAIRACB EQU 00000000 47 BYTE(S) ON WORD 36940000 A00067 EQU DAIRACB+00000000 8 BYTE(S) 36950000 DAIMASK EQU DAIRACB+00000008 8 BYTE(S) 36960000 A00068 EQU DAIRACB+00000008 6 BYTE(S) 36970000 DAILABEL EQU DAIRACB+00000014 1 BYTE(S) 36980000 DAIINOUT EQU DAIRACB+00000014 1 BIT(S) 36990000 DAIOUTIN EQU DAIRACB+00000014 1 BIT(S) 37000000 A00069 EQU DAIRACB+00000015 1 BYTE(S) 37010000 A00070 EQU DAIRACB+00000016 3 BYTE(S) 37020000 DAIEXPDT EQU DAIRACB+00000019 3 BYTE(S) 37030000 DAIYEAR EQU DAIRACB+00000019 1 BYTE POINTER 37040000 DAIDAY EQU DAIRACB+00000020 2 BYTE INTEGER 37050000 A00071 EQU DAIRACB+00000022 2 BYTE(S) 37060000 DAIBUFNO EQU DAIRACB+00000024 1 BYTE(S) 37070000 DAIBFTEK EQU DAIRACB+00000025 1 BYTE(S) 37080000 DAIBFALN EQU DAIRACB+00000025 1 BYTE(S) 37090000 A00072 EQU DAIRACB+00000025 1 BIT(S) 37100000 DAIAUTO EQU DAIRACB+00000025 2 BIT(S) 37110000 DAISIMPL EQU DAIRACB+00000025 1 BIT(S) 37120000 DAIRECRD EQU DAIRACB+00000025 1 BIT(S) 37130000 DAIEXC EQU DAIRACB+00000025 1 BIT(S) 37140000 A00073 EQU DAIRACB+00000025 2 BIT(S) 37150000 DAIDOUBL EQU DAIRACB+00000025 1 BIT(S) 37160000 DAIFULL EQU DAIRACB+00000025 1 BIT(S) 37170000 DAIBUFL EQU DAIRACB+00000026 HALFWORD INTEGER 37180000 DAIEROPT EQU DAIRACB+00000028 1 BYTE(S) 37190000 DAIACEPT EQU DAIRACB+00000028 1 BIT(S) 37200000 DAISKIP EQU DAIRACB+00000028 1 BIT(S) 37210000 DAIABNOR EQU DAIRACB+00000028 1 BIT(S) 37220000 DAIKEYLE EQU DAIRACB+00000029 1 BYTE(S) 37230000 A00074 EQU DAIRACB+00000030 6 BYTE(S) 37240000 DAIRECFM EQU DAIRACB+00000036 1 BYTE(S) 37250000 DAIUNDEF EQU DAIRACB+00000036 2 BIT(S) 37260000 DAIFIXED EQU DAIRACB+00000036 1 BIT(S) 37270000 DAIVARIB EQU DAIRACB+00000036 1 BIT(S) 37280000 DAITRKOV EQU DAIRACB+00000036 1 BIT(S) 37290000 DAIBLOCK EQU DAIRACB+00000036 1 BIT(S) 37300000 DAISTAND EQU DAIRACB+00000036 1 BIT(S) 37310000 DAIASA EQU DAIRACB+00000036 1 BIT(S) 37320000 DAIMACH EQU DAIRACB+00000036 1 BIT(S) 37330000 DAIOPTCD EQU DAIRACB+00000037 1 BYTE(S) 37340000 DAIWRTCK EQU DAIRACB+00000037 1 BIT(S) 37350000 A00075 EQU DAIRACB+00000037 1 BIT(S) 37360000 DAISCHED EQU DAIRACB+00000037 1 BIT(S) 37370000 A00076 EQU DAIRACB+00000037 1 BIT(S) 37380000 DAIANSI EQU DAIRACB+00000037 1 BIT(S) 37390000 A00077 EQU DAIRACB+00000037 1 BIT(S) 37400000 DAIUSERT EQU DAIRACB+00000037 1 BIT(S) 37410000 DAIBLKSI EQU DAIRACB+00000038 HALFWORD INTEGER 37420000 DAILRECL EQU DAIRACB+00000040 HALFWORD INTEGER 37430000 DAINCP EQU DAIRACB+00000042 1 BYTE(S) 37440000 A00078 EQU DAIRACB+00000043 4 BYTE(S) 37450000 DSNAME EQU 00000000 46 BYTE(S) ON WORD 37460000 DSNLNGTH EQU DSNAME+00000000 HALFWORD INTEGER 37470000 DSNM EQU DSNAME+00000002 44 BYTE(S) 37480000 DATASET EQU 00000000 28 BYTE(S) ON WORD 37490000 DSN EQU DATASET+00000000 FULLWORD POINTER 37500000 DSL EQU DATASET+00000004 HALFWORD INTEGER 37510000 DSF EQU DATASET+00000006 16 BIT(S) 37520000 MEM EQU DATASET+00000008 FULLWORD POINTER 37530000 MEML EQU DATASET+00000012 HALFWORD INTEGER 37540000 MEMF EQU DATASET+00000014 16 BIT(S) 37550000 PASS EQU DATASET+00000016 FULLWORD POINTER 37560000 PASSL EQU DATASET+00000020 HALFWORD INTEGER 37570000 PASSF EQU DATASET+00000022 16 BIT(S) 37580000 NEXT EQU DATASET+00000024 FULLWORD POINTER 37590000 CBUF EQU 00000000 5 BYTE(S) ON WORD 37600000 CBUGLNG EQU CBUF+00000000 HALFWORD POINTER 37610000 CBUFOFF EQU CBUF+00000002 HALFWORD POINTER 37620000 CBUFDATA EQU CBUF+00000004 1 BYTE(S) 37630000 SAVEPRM EQU 00000000 16 BYTE(S) ON WORD 37640000 BASEREG EQU SAVEPRM+00000000 3*FULLWORD INTEGER 37650000 DATAREG EQU SAVEPRM+00000012 FULLWORD INTEGER 37660000 CHARST EQU 00000000 80 BYTE(S) 37670000 STRING EQU 00000000 12 BYTE(S) ON WORD 37680000 STR EQU STRING+00000000 FULLWORD POINTER 37690000 STRL EQU STRING+00000004 HALFWORD INTEGER 37700000 STRF EQU STRING+00000006 16 BIT(S) 37710000 NSTRNG EQU STRING+00000008 FULLWORD POINTER 37720000 DYNAM EQU 00000000 296 BYTE(S) ON WORD 37730000 DSCONC EQU DYNAM+00000000 16 BYTE(S) ON WORD 37740000 INPT EQU DYNAM+00000000 8 BYTE(S) 37750000 LIBY EQU DYNAM+00000008 8 BYTE(S) 37760000 DDLEN EQU DYNAM+00000016 HALFWORD INTEGER 37770000 DDNMS EQU DYNAM+00000018 96 BYTE(S) 37780000 SYSLIN EQU DYNAM+00000018 8 BYTE(S) 37790000 MEMBER EQU DYNAM+00000026 8 BYTE(S) 37800000 SYSLMOD EQU DYNAM+00000034 8 BYTE(S) 37810000 SYSLIB EQU DYNAM+00000042 8 BYTE(S) 37820000 A00079 EQU DYNAM+00000050 8 BYTE(S) 37830000 SYSPRNT EQU DYNAM+00000058 8 BYTE(S) 37840000 A00080 EQU DYNAM+00000066 8 BYTE(S) 37850000 SYSUT1 EQU DYNAM+00000074 8 BYTE(S) 37860000 A00081 EQU DYNAM+00000082 8 BYTE(S) 37870000 A00082 EQU DYNAM+00000090 8 BYTE(S) 37880000 A00083 EQU DYNAM+00000098 8 BYTE(S) 37890000 SYSTERM EQU DYNAM+00000106 8 BYTE(S) 37900000 OPLEN EQU DYNAM+00000114 HALFWORD INTEGER 37910000 OPLIST EQU DYNAM+00000116 160 BYTE(S) 37920000 OUTPARM EQU DYNAM+00000276 20 BYTE(S) ON WORD 37930000 LKLD EQU DYNAM+00000276 4 BYTE(S) 37940000 TMPPTR EQU DYNAM+00000280 FULLWORD POINTER 37950000 CONCAT EQU DYNAM+00000284 FULLWORD POINTER 37960000 OPTPTR EQU DYNAM+00000288 FULLWORD POINTER 37970000 DDPTR EQU DYNAM+00000292 FULLWORD POINTER 37980000 ENDBIT EQU DYNAM+00000292 1 BIT(S) 37990000 DDNAME EQU 00000000 2*8 BYTE(S) 38000000 R9 EQU 00000009 FULLWORD POINTER REGISTER 38010000 R8 EQU 00000008 FULLWORD POINTER REGISTER 38020000 R11 EQU 00000011 FULLWORD POINTER REGISTER 38030000 R1 EQU 00000001 FULLWORD POINTER REGISTER 38040000 R2 EQU 00000002 FULLWORD POINTER REGISTER 38050000 R3 EQU 00000003 FULLWORD POINTER REGISTER 38060000 R12 EQU 00000012 FULLWORD POINTER REGISTER 38070000 R13 EQU 00000013 FULLWORD POINTER REGISTER 38080000 R14 EQU 00000014 FULLWORD POINTER REGISTER 38090000 R15 EQU 00000015 FULLWORD POINTER REGISTER 38100000 PARML EQU 00000000 8 BYTE(S) ON WORD 38110000 PDE EQU PARML+00000000 FULLWORD POINTER 38120000 USERAREA EQU PARML+00000004 FULLWORD POINTER 38130000 FPTR EQU 00000008 FULLWORD POINTER 38140000 TYPE EQU 00000000 4 BYTE(S) 38150000 PARMA EQU 00000000 8 BYTE(S) ON WORD 38160000 P1 EQU PARMA+00000000 FULLWORD POINTER 38170000 P2 EQU PARMA+00000004 FULLWORD POINTER 38180000 WORKAREA EQU 00000000 8 BYTE(S) ON WORD 38190000 PARMSREG EQU WORKAREA+00000000 FULLWORD POINTER 38200000 ABCODE EQU WORKAREA+00000004 FULLWORD INTEGER 38210000 ECTBLK EQU 00000000 4 BYTE(S) ON WORD 38220000 ECTRTCD EQU ECTBLK+00000000 FULLWORD INTEGER 38230000 ECTRCDF EQU ECTBLK+00000000 1 BIT(S) 38240000 FPTR2 EQU 00000008 FULLWORD POINTER 38250000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 38260000 ORG @DATA 38270000 DS 00000963C 38280000 @L EQU 1 38290000 @DATD DSECT 38300000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 38310000 DAPB1PTR EQU @DATD+00000072 FULLWORD POINTER 38320000 DAPB2PTR EQU @DATD+00000076 FULLWORD POINTER 38330000 DAPB3PTR EQU @DATD+00000080 FULLWORD POINTER 38340000 DACBPTR EQU @DATD+00000084 FULLWORD POINTER 38350000 PPLPTR EQU @DATD+00000088 FULLWORD POINTER 38360000 DAPLPTR EQU @DATD+00000092 FULLWORD POINTER 38370000 CBUFPTR EQU @DATD+00000096 FULLWORD POINTER 38380000 PRINT EQU @DATD+00000100 HALFWORD INTEGER 38390000 LIB EQU @DATD+00000102 HALFWORD INTEGER 38400000 TERM EQU @DATD+00000104 HALFWORD INTEGER 38410000 MSGPARM EQU @DATD+00000108 108 BYTE(S) ON WORD 38420000 DAPB0PTR EQU MSGPARM+00000000 FULLWORD POINTER 38430000 PROMPTM EQU MSGPARM+00000004 HALFWORD INTEGER 38440000 RCODE EQU MSGPARM+00000006 HALFWORD INTEGER 38450000 ERRCODE EQU MSGPARM+00000008 HALFWORD INTEGER 38460000 BUFLN EQU MSGPARM+00000010 HALFWORD INTEGER 38470000 INBUF EQU MSGPARM+00000012 80 BYTE(S) 38480000 DSPTR EQU MSGPARM+00000092 FULLWORD POINTER 38490000 PTR1 EQU MSGPARM+00000096 FULLWORD POINTER 38500000 CPECB EQU MSGPARM+00000100 FULLWORD INTEGER 38510000 CPPLPTR EQU MSGPARM+00000104 FULLWORD POINTER 38520000 CODEBYT EQU MSGPARM+00000104 1 BYTE(S) 38530000 DAIR04 EQU @DATD+00000216 16 BYTE(S) ON WORD 38540000 DAIR08 EQU @DATD+00000232 84 BYTE(S) ON WORD 38550000 DAIR18 EQU @DATD+00000316 40 BYTE(S) ON WORD 38560000 DAIR1C EQU @DATD+00000356 24 BYTE(S) ON WORD 38570000 DAIR28 EQU @DATD+00000380 16 BYTE(S) ON WORD 38580000 DAIR34 EQU @DATD+00000396 20 BYTE(S) ON WORD 38590000 DAIRATCB EQU @DATD+00000416 47 BYTE(S) ON WORD 38600000 DAIR0C EQU @DATD+00000464 212 BYTE(S) ON WORD 38610000 A00000 EQU DAIR0C+00000000 12 BYTE(S) 38620000 DA0CDDN EQU DAIR0C+00000012 25*8 BYTE(S) 38630000 DAIRL EQU @DATD+00000676 20 BYTE(S) ON WORD 38640000 PARSEL EQU @DATD+00000696 28 BYTE(S) ON WORD 38650000 NM EQU @DATD+00000724 2*46 BYTE(S) ON HWORD 38660000 DEFAULT EQU @DATD+00000816 54 BYTE(S) ON WORD 38670000 DEFLEN EQU DEFAULT+00000000 HALFWORD INTEGER 38680000 DEFNME EQU DEFAULT+00000002 44 BYTE(S) 38690000 DEFMEM EQU DEFAULT+00000046 8 BYTE(S) 38700000 A00001 EQU @DATD+00000872 9 BYTE(S) ON WORD 38710000 DOT EQU A00001+00000000 1 BYTE(S) 38720000 QUAL EQU A00001+00000001 8 BYTE(S) 38730000 LQUAL EQU @DATD+00000882 HALFWORD INTEGER 38740000 MES EQU @DATD+00000884 FULLWORD INTEGER 38750000 LSTPTR EQU @DATD+00000888 FULLWORD POINTER 38760000 INDCB EQU @DATD+00000892 100 BYTE(S) ON WORD 38770000 BASE EQU @DATD+00000992 FULLWORD POINTER 38780000 BEG EQU @DATD+00000996 HALFWORD INTEGER 38790000 ENDD EQU @DATD+00000998 HALFWORD INTEGER 38800000 I EQU @DATD+00001000 HALFWORD INTEGER 38810000 K EQU @DATD+00001002 HALFWORD INTEGER 38820000 J EQU @DATD+00001004 HALFWORD INTEGER 38830000 N EQU @DATD+00001006 HALFWORD INTEGER 38840000 VALREG EQU @DATD+00001008 16 BYTE(S) ON WORD 38850000 OPTSTPTR EQU @DATD+00001024 FULLWORD POINTER 38860000 PTR3 EQU @DATD+00001028 FULLWORD POINTER 38870000 PDLPTR EQU @DATD+00001032 FULLWORD POINTER 38880000 DMLIST EQU @DATD+00001036 4 BYTE(S) ON WORD 38890000 OPTBYT EQU DMLIST+00000000 1 BYTE(S) 38900000 DCBADDR EQU DMLIST+00000001 3 BYTE POINTER ON WORD+1 38910000 BLK1 EQU @DATD+00001040 5 BYTE(S) 38920000 BLK2 EQU @DATD+00001048 4 BYTE INTEGER ON DWORD 38930000 DCBSBLK EQU @DATD+00001052 FULLWORD INTEGER 38940000 CSNAME EQU @DATD+00001056 FULLWORD INTEGER 38950000 CHAREND EQU @DATD+00001060 HALFWORD INTEGER 38960000 STAEL EQU @DATD+00001064 16 BYTE(S) ON WORD 38970000 EXADD EQU STAEL+00000000 FULLWORD POINTER 38980000 PRMADD EQU STAEL+00000004 FULLWORD POINTER 38990000 A00002 EQU STAEL+00000008 FULLWORD POINTER 39000000 A00003 EQU STAEL+00000012 FULLWORD POINTER 39010000 SAVEAR EQU @DATD+00001080 18*FULLWORD INTEGER 39020000 Q04 EQU @DATD+00001152 2*HALFWORD INTEGER 39030000 LNG EQU @DATD+00001156 HALFWORD INTEGER 39040000 PTR EQU @DATD+00001160 FULLWORD POINTER 39050000 @SAV004 EQU @DATD+00001164 72 BYTE(S) ON WORD 39060000 PARMPTR EQU @DATD+00001236 FULLWORD POINTER 39070000 TYPE1 EQU @DATD+00001240 4 BYTE(S) 39080000 TYPE2 EQU @DATD+00001244 4 BYTE(S) 39090000 TADD EQU @DATD+00001248 4 BYTE(S) 39100000 PTR2 EQU @DATD+00001252 FULLWORD POINTER 39110000 BLDLST EQU @DATD+00001256 18 BYTE(S) ON WORD 39120000 FF EQU BLDLST+00000000 HALFWORD INTEGER 39130000 LLL EQU BLDLST+00000002 HALFWORD INTEGER 39140000 NAME1 EQU BLDLST+00000004 8 BYTE(S) 39150000 A00084 EQU BLDLST+00000012 2 BYTE(S) 39160000 R EQU BLDLST+00000014 1 BYTE(S) 39170000 A00085 EQU BLDLST+00000015 3 BYTE(S) 39180000 SAVEAR2 EQU @DATD+00001276 18*FULLWORD INTEGER 39190000 DAIR10 EQU @DATD+00001348 16 BYTE(S) ON WORD 39200000 DS 00001364C 39210000 @TEMPS DS 0F 39220000 DS C 39230000 @PL001 DS 02F 39240000 @PL002 DS 02F 39250000 @PL004 DS 02F 39260000 STAKBLK STACK MF=L 39270000 AKJLKL01 CSECT 39280000 @DATD DSECT 39290000 @DATEND EQU * 39300000 AKJLKL01 CSECT , 39310000 @9D0 EQU LDCH 39320000 @99F EQU @99E 39330000 @99C EQU COMM 39340000 @996 EQU EL2 39350000 @987 EQU CLS 39360000 @974 EQU ERR 39370000 @954 EQU EQCH 39380000 @914 EQU PRNTM 39390000 @912 EQU LNK 39400000 @90C EQU ENDAL 39410000 FNL EQU @EL01 39420000 END AKJLKL01,(C'PL/S',1400,78207) 39430000