TITLE 'AMAPTF01 - PTF APPLICATION FUNCTION SERVICE PROGRAM' 00010000 * GENERATE (EJECT); 00020000 EJECT 00030000 * 00040000 * AMAPTF01: 00050000 * PROC; 00060000 LCLA &T,&SPN 0002 00070000 .@001 ANOP 0002 00080000 AMAPTF01 CSECT , 0002 00090000 STM @E,@C,12(@D) 0002 00100000 BALR @B,0 0002 00110000 @PSTART DS 0H 0002 00120000 USING @PSTART+00000,@B 0002 00130000 ST @D,@SAV001+4 0002 00140000 LA @F,@SAV001 0002 00150000 ST @F,8(0,@D) 0002 00160000 LR @D,@F 0002 00170000 * DECLARE 00180000 * AMASPUT2 LABEL; 00190000 * DECLARE 00200000 * AMARDOBJ LABEL GENERATED; 00210000 * DECLARE 00220000 * SYSUTDCB LABEL GENERATED; 00230000 * DECLARE 00240000 * AMACLOSE LABEL GENERATED; 00250000 * DECLARE 00260000 * AMAIDCHK LABEL; /* S21016 * 00270000 * DECLARE 00280000 * AMAIDBL LABEL; /* S21016 * 00290000 * DECLARE 00300000 * OPENREG REGISTER(3) PTR(31); /* DCB ADDRESS REGISTER * 00310000 * DECLARE 00320000 * OPENBIT BIT(1) INIT('0'B); /* FIRST TIME ENTRY FLAG * 00330000 * DECLARE 00340000 * RETCODE REGISTER(15); 00350000 * DECLARE 00360000 * LSTPTR REGISTER(1) PTR(31); /* PARAMETER LIST REGISTER * 00370000 * DECLARE 00380000 * LSTPTRSV REGISTER(5) PTR(31); /* PARAMETER LIST POINTER 00390000 * M3990 * 00400000 * DECLARE 00410000 * I REGISTER(6) PTR(31); /* COLUMN COUNTER S21995 * 00420000 * RESTRICT (LSTPTR,OPENREG,LSTPTRSV,I); /* S21995 * 00430000 * DECLARE 00440000 * 1 PRMLST BASED(LSTPTRSV), /* PTFLE PARAMETER LIST M3990 * 00450000 * 2 BRFIELD PTR(8), /* INDEX FOR FUNCTIONAL BRANCH * 00460000 * 2 IDENTCON PTR(8), /* IDENTIFY CONT. SWITCH M0861 * 00470000 * 2 RETCDE PTR(8), /* RETURN CODE SAVE AREA A48711* 00480000 * 2 COMSW PTR(8), /* SWITCHES Y01045* 00490000 * 2 MODSTORE PTR(31), /* ADDRESS OF MATCHED MOD NAME * 00500000 * 2 OVTABADR PTR(31), /* ADDRESS OF OVERLAY TABLE * 00510000 * 2 PTF01 PTR(31), /* ENTRY POINT OF AMAPTF01 * 00520000 * 2 PTF02 PTR(31), /* ENTRY POINT OF AMAPTF02 * 00530000 * 2 PCHAREA PTR(31), /* STAGE 1 INPUT BUFFER * 00540000 * 2 MODAREA PTR(31), /* CONTROL STMNT INPUT BUFFER * 00550000 * 2 OUTFDCB PTR(31), /* ADDR OF OUTFDCB * 00560000 * 2 SYNADEXT PTR(31), /* ADDR OF AMAPTFLE SYNAD RTN * 00570000 * 2 MSGAREA PTR(31), /* ADDR OF ERROR MESSAGE BUFFER * 00580000 * 2 PRINTDCB PTR(31), /* ADDR OF PRINTDCB IN AMAPTFLE * 00590000 * 2 SELNAME PTR(31), /* ADDR OF SYSTEM MODULE NAME * 00600000 * /* ON THE SELECT STATEMENT * 00610000 * 2 SSISAVE PTR(31), /* ADDR OF MATCHED MODULE * 00620000 * /* IN MODULE NAME TABLE * 00630000 * 2 MESSAGE2 PTR(31), /* ADDR OF MESSAGE WRITE RTN * 00640000 * 2 MODTBL PTR(31), /* ADDR OF MODULE NAME TABLE * 00650000 * 2 SSITABLE PTR(31), /* ADDR OF SSI TABLE * 00660000 * 2 PARMPTR PTR(31), /* ADDR OF EXEC PARM FIELD * 00670000 * 2 FILCLOSE PTR(31); /* ADDR OF FILCLOSE RTN * 00680000 * DECLARE 00690000 * AMAPTF02 ENTRY BASED(PTF02); 00700000 * DECLARE 00710000 * DDMSGOUT CHAR(4) INIT('OUTF'); /* OUTF DDNAME * 00720000 * DECLARE 00730000 * DDMSG CHAR(6) INIT('SYSUT2'); /* SYSUT2 DDNAME * 00740000 * DECLARE 00750000 * DDSYSL CHAR(7) INIT('SYSLMOD'); /* SYSLMOD DDNAME M4012 * 00760000 * DECLARE 00770000 * MODSTRBF CHAR(8) BASED(MODSTORE); /* MODULE NAME SAVE * 00780000 * /* FOR TABLE COMPARE * 00790000 * DECLARE 00800000 * NAMMATCH PTR(8) INIT(0); /* MODULE NAME MATCH FOR SYSUT2 * 00810000 * 00820000 * /******************************************************************** 00830000 * /* THE FOLLOWING IS A BRANCH TABLE CONSISTING OF SIX SUBROUTINE * 00840000 * /* ADDRESSES. ONE OF THESE ADDRESSES INDEXED BY BRFIELD CAUSES * 00850000 * /* ENTRY INTO THAT SUBROUTINE. * 00860000 * 00870000 * DECLARE 00880000 * BRTABLE(6) PTR(31) 00890000 * INIT(ADDR(AMAOPEN),ADDR(AMASPOBJ), 00900000 * ADDR(AMALINK),ADDR(AMACLOSE),ADDR(AMASPS), 00910000 * ADDR(AMALEPRM)); /* Y01045* 00920000 * DECLARE 00930000 * MSGBUF CHAR(121); /* A MESSAGE BUFFER * 00940000 * DECLARE 00950000 * UT2OUT CHAR(80); /* INPUT BUFFER FOR SYSUT2 * 00960000 * DECLARE 00970000 * DUMFIELD CHAR(80) BASED(MODAREA); /* MODAREA BUFF IN PTFLE * 00980000 * DECLARE 00990000 * TTRZ CHAR(4) INIT(' ') BDY(WORD); /* NOTE ADDRESS * 01000000 * DECLARE 01010000 * ENDPARM CHAR(1); /* END OF EXEC CARD PARAMETERS 01020000 * M4011 * 01030000 * DECLARE 01040000 * BLDLFLD CHAR(72) BDY(HWORD) INIT(' '); /* BLDL PARAMETER 01050000 * LIST * 01060000 * /* FOR PTF02 AND OPT LIST FOR 01070000 * L.E. M3999 * 01080000 * DECLARE 01090000 * PTF02ADR PTR(31); /* ADDR OF AMAPTF02 * 01100000 * 01110000 * /******************************************************************** 01120000 * /* THE FOLLOWING IS A NAME CARD THAT AMAPTF01 MUST GENERATE * 01130000 * /* TO BUILD A SYSLIN DATA SET FOR A MODULE THAT WAS * 01140000 * /* ORIGINALLY COPIED INTO THE SYSTEM AT SYSGEN TIME. * 01150000 * 01160000 * DECLARE 01170000 * 1 NAMECARD, 01180000 * 2 NME CHAR(10) INIT(' NAME '), 01190000 * 2 MDN CHAR(11); /* MODULE NAME WILL BE MOVED IN 01200000 * M4000 * 01210000 * DECLARE 01220000 * REP CHAR(3) INIT('(R)'); /* M4000 * 01230000 * DECLARE 01240000 * NEWNAME CHAR(1) INIT('00'X); /* MODULE NAME SWITCH M4014 * 01250000 * DECLARE 01260000 * IDFOUND CHAR(1) INIT('80'X); /* IDENTIFY FOUND SW S21016 * 01270000 * DECLARE 01280000 * 1 ALIASCD, /* ALIAS CARD FOR M4014 * 01290000 * 2 * CHAR(7) INIT(' ALIAS '), /* COPIED AT SYSGEN M4014 * 01300000 * 2 ALIASNM CHAR(8); /* WITH ALIASES M4014 * 01310000 * DECLARE 01320000 * 1 SSICARD, 01330000 * 2 SETSSI CHAR(12) INIT(' SETSSI '), 01340000 * 2 SSIINFO CHAR(8); /* SETSSI CARD FOR COPIED MODULES* 01350000 * DECLARE 01360000 * SELBUF CHAR(8) BASED(SELNAME); /* MOD NAME ON SELECT 01370000 * STATEMNT * 01380000 * DECLARE 01390000 * 1 PRMFIELD BASED(PARMPTR), 01400000 * 2 PARMLEN PTR(16), /* LENGTH OF PARAMETER LIST * 01410000 * 2 PARM CHAR(100); /* TEXT OF PARAMETER * 01420000 * DECLARE 01430000 * LKEDNAME CHAR(8) INIT(' '); /* NAME OF LINKAGE EDITOR * 01440000 * 01450000 * /******************************************************************** 01460000 * /* THE FOLLOWING IS MESSAGE AMA005I * 01470000 * /******************************************************************** 01480000 * 01490000 * DECLARE 01500000 * AMA005I CHAR(54) INIT 01510000 * ('AMA005I INVALID PARAMETER SPECIFIED ON EXEC STATEMENT'); 01520000 * 01530000 * /******************************************************************** 01540000 * /* THE FOLLOWING IS MESSAGE AMA006I * 01550000 * /******************************************************************** 01560000 * 01570000 * DECLARE 01580000 * 1 AMA006I, 01590000 * 2 * CHAR(21) INIT('AMA006I LOAD MODULE '), 01600000 * 2 CCCCCCCC CHAR(8), /* MOD NAME * 01610000 * 2 * CHAR(24) INIT(' NOT UPDATED WITH PTF - '), 01620000 * 2 NN CHAR(2); /* REASON CODE * 01630000 * 01640000 * /******************************************************************** 01650000 * /* THE FOLLOWING MESSAGE IS AMA007I * 01660000 * /******************************************************************** 01670000 * 01680000 * DECLARE 01690000 * 1 AMA007I, 01700000 * 2 * CHAR(21) INIT('AMA007I LOAD MODULE '), 01710000 * 2 LLLLLLLL CHAR(8), /* MOD NAME * 01720000 * 2 * CHAR(31) INIT(' UPDATED WITH PTF - NEW SSI IS '), /* 01730000 * M3999 * 01740000 * 2 SSI CHAR(8); /* NEW SSI * 01750000 * 01760000 * /******************************************************************** 01770000 * /* THE FOLLOWING MESSAGE IS AMA010I * 01780000 * /******************************************************************** 01790000 * 01800000 * DECLARE 01810000 * 1 AMA010I, /* S21016 * 01820000 * 2 * CHAR(29) INIT('AMA010I AMAPTFLE TERMINATED,'), /* 01830000 * S21016 * 01840000 * 2 * CHAR(33) INIT(' AN IDENTIFY STATEMENT IS MISSING'); 01850000 * /* S21016 * 01860000 * /* S21016* 01870000 * 01880000 * /******************************************************************** 01890000 * /* THE FOLLOWING MESSAGE IS AMA013I * 01900000 * /******************************************************************** 01910000 * 01920000 * DECLARE 01930000 * 1 AMA013I, /* S21016 * 01940000 * 2 * CHAR(26) INIT('AMA013I THE FOLLOWING IS '), /* 01950000 * S21016 * 01960000 * 2 * CHAR(32) INIT('IDENTIFY INFORMATION FOR MODULE '), /* 01970000 * S21016 * 01980000 * 2 AMA013NM CHAR(8) INIT(' '); /* S21016 * 01990000 * /* S21016* 02000000 * 02010000 * /******************************************************************** 02020000 * /* THE FOLLOWING MESSAGE IS AMA016I Y01045* 02030000 * /******************************************************************** 02040000 * 02050000 * DECLARE 02060000 * 1 AMA016I, /* Y01045* 02070000 * 2 * CHAR(29) INIT('AMA016I AMAPTFLE TERMINATED,'), 02080000 * /* Y01045* 02090000 * 2 * CHAR(32) INIT(' PARMLIB DD STATEMENT IS MISSING'); 02100000 * /* Y01045* 02110000 * /* DIFF IS THE DIFFERENCE BETWEEN THE BEGINNING ADDRESS OF THE * 02120000 * /* MODULE NAME TABLE AND AN ADDRESS OF A NAME IN THE TABLE * 02130000 * DECLARE 02140000 * DIFF FIXED(31); 02150000 * /* QUOTIENT IS DIFF DIVIDED BY 9 * 02160000 * DECLARE 02170000 * QUOTIENT FIXED(31); 02180000 * /* THE ADDFACTR IS THE QUOTIENT MULTIPLIED BY 8. WHEN ADDFACTR * 02190000 * /* IS ADDED TO SSITABLE, THE RESULTANT WILL BE A POINTER TO AN * 02200000 * /* ENTRY IN THE SSI TABLE FOR THE UPDATED MODULE. * 02210000 * DECLARE 02220000 * ADDFACTR FIXED(31); 02230000 * DECLARE 02240000 * CORRSSI PTR(31); /* POINTS TO SSI FOR NEW MOD * 02250000 * DECLARE 02260000 * SSIDATA CHAR(8) BASED(CORRSSI); /* SSI FOR NEW MODULE * 02270000 * DECLARE 02280000 * RETCDSAV FIXED(31); /* SAVE FOR L.E. RET CODE * 02290000 * DECLARE 02300000 * 1 DDNMELST BDY (HWORD), /* DDNAME PARM LIST FOR * 02310000 * 2 * PTR(16) INIT(64), /* LINKAGE EDITOR * 02320000 * 2 * CHAR(8) INIT('OUTF '), 02330000 * 2 * CHAR(8) INIT('0000000000000000'X), 02340000 * 2 * CHAR(8) INIT('SYSLMOD '), 02350000 * 2 * CHAR(8) INIT('0000000000000000'X), 02360000 * 2 * CHAR(8) INIT('0000000000000000'X), 02370000 * 2 * CHAR(8) INIT('SYSPRINT'), 02380000 * 2 * CHAR(8) INIT('0000000000000000'X), 02390000 * 2 * CHAR(8) INIT('SYSUT1 '); 02400000 * DECLARE 02410000 * PARMCONT BIT(1) INIT('0'B); /* USED TO INDICATE THAT * 02420000 * /* PARM IS CONTINUED * 02430000 * DECLARE 02440000 * PCHBUFFR CHAR(80) BASED(PCHAREA); /* STAGE 1 INPUT BUFFER * 02450000 * DECLARE 02460000 * PRMNUMBR PTR(16) INIT('0000'X); /* NUMBER OF L.E. PARMS * 02470000 * DECLARE 02480000 * PARMEQUL CHAR(5) INIT('PARM='); /* USED FOR SEARCH OF * 02490000 * /* PARM KEYWORD ON EXEC * 02500000 * /* STATEMENT * 02510000 * DECLARE 02520000 * B PTR(16); /* INDEX INTO BLDLFLD * 02530000 * DECLARE 02540000 * DSSDNME CHAR(8) INIT('PARMLIB '); /* DDNAME FOR DSS Y01045* 02550000 * DECLARE 02560000 * DEVDATA CHAR(8) BDY(WORD); /* DATA AREA FOR DEVTYPE * 02570000 * /* MACRO Y01045* 02580000 * DECLARE 02590000 * PATCH(50) CHAR(2) BDY(HWORD) INIT((50)'0000'X); 02600000 * /* PATCH AREA Y01983* 02610000 * 02620000 * GENERATE; 02630000 IHADCB DCBD 02640000 AMAPTF01 CSECT 02650000 DS 0H 02660000 * LSTPTRSV = LSTPTR; /* SAVE ADDR OF PARM LIST M3990 * 02670000 LR @5,@1 0062 02680000 * GO TO BRTABLE(BRFIELD); /* BRANCH TO SUBROUTINE A46805* 02690000 SR @2,@2 0063 02700000 IC @2,0(0,@5) 0063 02710000 SLA @2,2 0063 02720000 L @F,BRTABLE-4(@2) 0063 02730000 BCR 15,@F 0063 02740000 * AMAOPEN: 02750000 * IF OPENBIT = '1'B /* IS IT FIRST ENTRY TO PTF01? * 02760000 * THEN 02770000 AMAOPEN TM OPENBIT,B'10000000' 0064 02780000 * GO TO AMASPUT2; /* NO - SPOOL CARD A46805* 02790000 BC 01,AMASPUT2 0065 02800000 * OPENBIT='1'B; /* SET FIRST ENTRY * 02810000 OI OPENBIT,B'10000000' 0066 02820000 * /* TO PTF01 M4004 * 02830000 * GENERATE; 02840000 OPENFLG EQU X'10' 02850000 OPEN (SYSUTDCB,(OUTPUT)) OPEN WORKFILE DCB M4005 02860000 LA OPENREG,SYSUTDCB 02870000 USING IHADCB,OPENREG 02880000 TM DCBOFLGS,OPENFLG DID DCB OPEN 02890000 BZ AMADDMSG NO-WRITE ERROR MESSAGE 02900000 DS 0H 02910000 * IF PARMLEN > 8 /* IS PARM IN ERROR? * 02920000 * THEN 02930000 LA @F,8 0068 02940000 L @2,64(0,@5) 0068 02950000 MVC @TEMP2+2(2),0(@2) 0068 02960000 C @F,@TEMP2 0068 02970000 * GO TO AMA0001; /* YES-WRITE ERROR MSG * 02980000 BC 04,AMA0001 0069 02990000 * BLDLFLD(1) = '0000'X; /* INDICATE TO PTF02 * 03000000 MVC BLDLFLD(1),@X2 0070 03010000 * /* THAT BLDL IS FOR * 03020000 * /* LINKAGE EDITOR * 03030000 * BLDLFLD(5:PARMLEN+4) = PARM; /* PUT NAME IN BLDL LIST M4003 * 03040000 LA @E,2(0,@2) 0071 03050000 LA @4,4 0071 03060000 MVC @TEMP2+2(2),0(@2) 0071 03070000 A @4,@TEMP2 0071 03080000 SH @4,@D1 0071 03090000 LA @A,BLDLFLD+4 0071 03100000 EX @4,@MVC 0071 03110000 * LSTPTR = ADDR(BLDLFLD); /* POINT TO BLDL LIST M3990 * 03120000 LA @1,BLDLFLD 0072 03130000 * CALL AMAPTF02; /* GO TO PTF02 * 03140000 L @4,16(0,@5) 0073 03150000 LR @F,@4 0073 03160000 BALR @E,@F 0073 03170000 * IF BLDLFLD(1:2) = '0000'X /* WAS BLDL O.K.? * 03180000 * THEN 03190000 CLC BLDLFLD(2),@X2 0074 03200000 BC 07,@9FF 0074 03210000 * DO; 03220000 * /* IF THE BLDL WAS NOT GOOD, THEN INITIALIZE THE MESSAGE * 03230000 * /* BUFFER WITH THE ERROR MESSAGE AND GO TO AMAERMSG TO WRITE * 03240000 * /* THE ERROR MESSAGE. UPON RETURN FROM AMAERMSG, RETURN TO * 03250000 * /* FILCLOSE IN AMAPTFLE TO CLOSE ALL DCBS. * 03260000 * 03270000 * AMA0001: 03280000 * MSGBUF = ' '; 03290000 AMA0001 MVI MSGBUF,C' ' 0076 03300000 MVC MSGBUF+1(120),MSGBUF 0076 03310000 * MSGBUF(1:54) = AMA005I; 03320000 MVC MSGBUF(54),AMA005I 0077 03330000 * RETCDE='10'X; /*SET UP 16 RETURN CODE A48711* 03340000 MVI 2(@5),X'10' 0078 03350000 * 03360000 * AMACALL: 03370000 * CALL AMAERMSG; 03380000 AMACALL L @F,@V1 ADDRESS OF AMAERMSG 0079 03390000 BALR @E,@F 0079 03400000 * BRFIELD='00'X; /* ZERO BRFIELD Y01045* 03410000 MVI 0(@5),X'00' 0080 03420000 * RETURN TO FILCLOSE; 03430000 L @D,4(0,@D) 0081 03440000 L @E,68(0,@5) 0081 03450000 LM @F,@C,16(@D) 0081 03460000 BCR 15,@E 0081 03470000 * END; 03480000 * ELSE 03490000 * DO; 03500000 * IF BLDLFLD(1) = 'FF'X /* SYSLMOD OPEN FAIL M4012 * 03510000 * THEN 03520000 @9FF CLI BLDLFLD,X'FF' 0084 03530000 * GO TO AMADDSYS; /* YES-GO WRITE ERROR MESSAGE * 03540000 BC 08,AMADDSYS 0085 03550000 * /* IF THE BLDL AND OPEN WERE GOOD, THEN SAVE THE LINKAGE * 03560000 * /* EDITOR NAME AND SPOOL FIRST CONTROL STATEMENT. * 03570000 * LKEDNAME(1:PARMLEN) = PARM; 03580000 L @2,64(0,@5) 0086 03590000 LA @E,2(0,@2) 0086 03600000 MVC @TEMP2+2(2),0(@2) 0086 03610000 L @4,@TEMP2 0086 03620000 BCTR @4,0 0086 03630000 LA @A,LKEDNAME 0086 03640000 EX @4,@MVC 0086 03650000 * END; 03660000 * 03670000 * /******************************************************************** 03680000 * /* AMASPUT2 IS A SUBROUTINE THAT IS USED FOR SPOOLING ALL CONTROL* 03690000 * /* STATEMENTS TO THE SYSUT2 WORK FILE. THIS ROUTINE IS ENTERED * 03700000 * /* WHEN AMAPTFLE IS READING THE CONTROL STATEMENTS. * 03710000 * /******************************************************************** 03720000 * 03730000 * 03740000 * AMASPUT2: 03750000 * UT2OUT = DUMFIELD; /* MOVE STMNT IN UT2OUT * 03760000 @9FE EQU * 0088 03770000 AMASPUT2 L @2,24(0,@5) 0088 03780000 MVC UT2OUT(80),0(@2) 0088 03790000 * OPENREG = ADDR(SYSUTDCB); /* SET OPENREG TO SYSUTDCB ADDR * 03800000 LA @3,SYSUTDCB 0089 03810000 * GENERATE; 03820000 WRITE SYSUDECB,SF,(OPENREG),UT2OUT 03830000 CHECK SYSUDECB 03840000 DS 0H 03850000 * IF DUMFIELD(1) = '02'X /* IS THIS AN OBJECT STMNT M4014 * 03860000 * THEN 03870000 CLI 0(@2),X'02' 0091 03880000 BC 07,@9FD 0091 03890000 * NEWNAME = '00'X; /* YES-TURN OFF MODULE NAME SW * 03900000 MVI NEWNAME,X'00' 0092 03910000 BC 15,@9FC 0093 03920000 * ELSE 03930000 * DO; /* M4014 * 03940000 * IF DUMFIELD(1) = ' ' /* IS IDENTIFY CARD S21016 * 03950000 * THEN 03960000 @9FD L @2,24(0,@5) 0094 03970000 CLI 0(@2),C' ' 0094 03980000 BC 07,@9FB 0094 03990000 * DO; /* S21016 * 04000000 * IDFOUND = '80'X; /* SET IDENT FOUND SW * 04010000 MVI IDFOUND,X'80' 0096 04020000 * IDENTCON = '00'X; /* RESET SW M0861 * 04030000 MVI 1(@5),X'00' 0097 04040000 * IF DUMFIELD(72) ^= ' ' /* IDENT CONTIN M0861 * 04050000 * THEN 04060000 L @2,24(0,@5) 0098 04070000 CLI 71(@2),C' ' 0098 04080000 BC 08,@9FA 0098 04090000 * IDENTCON = '08'X; /* SET IDENT CONT SW * 04100000 MVI 1(@5),X'08' 0099 04110000 * /* M0861 * 04120000 * GO TO AMARET1; /* RETURN TO AMAPTFLE * 04130000 BC 15,AMARET1 0100 04140000 * END; /* S21016 * 04150000 * IF NEWNAME = '00'X /* MODULE NAME SWITCH SET M4014 * 04160000 * THEN 04170000 @9FB CLI NEWNAME,X'00' 0102 04180000 BC 07,@9F9 0102 04190000 * DO; /* S21016 * 04200000 * IF IDFOUND = '80'X /* IDENT FOUND SW SET * 04210000 * THEN 04220000 CLI IDFOUND,X'80' 0104 04230000 BC 07,@9F8 0104 04240000 * DO; /* S21016 * 04250000 * IDFOUND = '00'X; /* RESET IDENTIFY SW * 04260000 MVI IDFOUND,X'00' 0106 04270000 * NEWNAME = '80'X; /* SET SWITCH M4014 * 04280000 MVI NEWNAME,X'80' 0107 04290000 * END; /* S21016 * 04300000 * ELSE 04310000 * GO TO AMANOID; /* WRITE MSG S21016 * 04320000 * END; /* S21016 * 04330000 BC 15,@9F6 0111 04340000 * ELSE 04350000 * DUMFIELD(1) = '02'X; /* INDICATE NAME NOT TO BE M4014 * 04360000 @9F9 L @2,24(0,@5) 0111 04370000 MVI 0(@2),X'02' 0111 04380000 * /* PUT IN MODULE NAME TABLE * 04390000 * END; /* M4014 * 04400000 * GO TO AMARET1; /* RETURN TO AMAPTFLE * 04410000 BC 15,AMARET1 0113 04420000 * 04430000 * /******************************************************************** 04440000 * /******************************************************************** 04450000 * /* AMASPS IS ENTERED FORM PART 2(IEBCOPY) OF AMAPTFLE. * 04460000 * /* BRFIELD IS SET TO ZERO SO THAT AFTER THE OBJ IS SPOOLED TO * 04470000 * /* THE OUTF (SYSLIN) DATA SET, A NAME CARD IS GENERATED AND A * 04480000 * /* LINK IS MADE TO THE LINKAGE EDITOR. * 04490000 * /******************************************************************** 04500000 * 04510000 * 04520000 * AMASPS: 04530000 * BRFIELD = '00'X; /* ENTERED FROM IEBCOPY * 04540000 AMASPS MVI 0(@5),X'00' 0114 04550000 * 04560000 * /******************************************************************** 04570000 * /******************************************************************** 04580000 * /* AMASPOBJ IS ENTERED FROM PART 1(IEWL) OF AMAPTFLE. * 04590000 * /* THIS SUBROUTINE READS THE OBJ FOR THE APPROPRIATE MODULE * 04600000 * /* FROM THE SYSUT2 WORK FILE AND SPOOLS IT TO THE OUTF(SYSLIN) * 04610000 * /* DATA SET. * 04620000 * /******************************************************************** 04630000 * 04640000 * 04650000 * AMASPOBJ: 04660000 * NEWNAME = '00'X; /* TURN OFF MODULE NAME SW M4014 * 04670000 AMASPOBJ MVI NEWNAME,X'00' 0115 04680000 * IDFOUND = '00'X; /* S21016 * 04690000 MVI IDFOUND,X'00' 0116 04700000 * IF TTRZ(1) = ' ' THEN 04710000 CLI TTRZ,C' ' 0117 04720000 BC 07,@9F5 0117 04730000 * DO; /* M4005 * 04740000 * GENERATE; 04750000 CLOSE (SYSUTDCB) M4005 04760000 OPEN (SYSUTDCB,(INPUT)) M4005 04770000 READ SYSTDECB,SF,SYSUTDCB,UT2OUT M4005 04780000 CHECK SYSTDECB M4005 04790000 NOTE SYSUTDCB M4005 04800000 ST LSTPTR,TTRZ M4005 04810000 DS 0H 04820000 * GO TO CHKNAME; /* M4005 * 04830000 BC 15,CHKNAME 0120 04840000 * END; 04850000 * GENERATE; 04860000 @9F5 EQU * 0122 04870000 POINT SYSUTDCB,TTRZ LOCATE BEGINNING OF WORK FILE M4005 04880000 AMARDOBJ READ SYSRDECB,SF,SYSUTDCB,UT2OUT 04890000 CHECK SYSRDECB M4004 04900000 DS 0H 04910000 * 04920000 * CHKNAME: 04930000 * IF NAMMATCH = 1 THEN /* HAS APPROPRIATE OBJ BEEN 04940000 * FOUND? * 04950000 CHKNAME CLI NAMMATCH,1 0123 04960000 * GO TO AMACKOBJ; /* YES-CHECK FOR OBJ CARD M4005 * 04970000 BC 08,AMACKOBJ 0124 04980000 * ELSE 04990000 * /* IF THE APPROPRIATE OBJ HAS NOT BEEN LOCATED, THEN ATTEMPT TO * 05000000 * /* LOCATE IT BY CHECKING THE STATEMENT READ FROM SYSUT2 TO THE * 05010000 * /* MODULE NAME IN THE MODSTRBF BUFFER. * 05020000 * IF UT2OUT(1:8) ^= MODSTRBF THEN 05030000 L @2,4(0,@5) 0125 05040000 CLC UT2OUT(8),0(@2) 0125 05050000 * GO TO AMARDOBJ; /* NO MATCH- READ ANOTHER RECORD * 05060000 BC 07,AMARDOBJ 0126 05070000 * ELSE 05080000 * DO; 05090000 * NAMMATCH = 1; /* MATCH-INDICATE A MATCH * 05100000 MVI NAMMATCH,1 0128 05110000 * NEWNAME = '80'X; /* SET MODULE NAME SWITCH M4014 * 05120000 MVI NEWNAME,X'80' 0129 05130000 * GO TO AMARDOBJ; /* AND READ ANOTHER OBJ RECORD * 05140000 BC 15,AMARDOBJ 0130 05150000 * END; 05160000 * 05170000 * AMACKOBJ: 05180000 * IF UT2OUT(1) = '02'X /* IS THE RECORD OBJECT STMNT? * 05190000 * THEN 05200000 AMACKOBJ CLI UT2OUT,X'02' 0132 05210000 BC 07,@9F4 0132 05220000 * DO; 05230000 * NEWNAME = '00'X; /* TURN OFF MODULE NAME SW M4014 * 05240000 MVI NEWNAME,X'00' 0134 05250000 * 05260000 * OUTFWTE: 05270000 * OPENREG = OUTFDCB; /* YES-GET THE OUTFDCB ADDRESS 05280000 * M4014 * 05290000 OUTFWTE L @3,28(0,@5) 0135 05300000 * GENERATE; 05310000 WRITE OUTFDECB,SF,(OPENREG),UT2OUT 05320000 CHECK OUTFDECB 05330000 DS 0H 05340000 * GO TO AMARDOBJ; /* READ ANOTHER SYSUT2 RECORD * 05350000 BC 15,AMARDOBJ 0137 05360000 * END; 05370000 * ELSE 05380000 * IF NEWNAME = '80'X /* MODULE NAME ALREADY * 05390000 * /* READ IN M4014 * 05400000 * THEN 05410000 @9F4 CLI NEWNAME,X'80' 0139 05420000 BC 07,@9F2 0139 05430000 * DO; /* YES-BUILD ALIAS CARDS * 05440000 * IF BRFIELD ^= '00'X /* MODULE COPIED AT M4014 * 05450000 * /* SYSGEN (BRFIELD=0) * 05460000 * THEN 05470000 CLI 0(@5),X'00' 0141 05480000 * GO TO AMARDOBJ; /* NO-IGNORE ALIAS M4014 * 05490000 BC 07,AMARDOBJ 0142 05500000 * ALIASNM = UT2OUT(1:8); /* MOVE ALIAS NAME M4014 * 05510000 MVC ALIASCD+7(8),UT2OUT 0143 05520000 * /* TO ALIAS CARD M4014 * 05530000 * UT2OUT = ' '; /* BLANK OUTPUT BUFFER * 05540000 MVI UT2OUT,C' ' 0144 05550000 MVC UT2OUT+1(79),UT2OUT 0144 05560000 * UT2OUT(1:15) = ALIASCD; /* MOVE ALIAS CARD TO * 05570000 MVC UT2OUT(15),ALIASCD 0145 05580000 * /* OUTPUT BUFFER M4014 * 05590000 * GO TO OUTFWTE; /* WRITE ALIAS CARD M4014 * 05600000 BC 15,OUTFWTE 0146 05610000 * END; /* M4014 * 05620000 * IF UT2OUT(1) = ' ' /* IDENTIFY CARD S21016 * 05630000 * THEN 05640000 @9F2 EQU * 0148 05650000 @9F3 CLI UT2OUT,C' ' 0148 05660000 BC 07,@9F1 0148 05670000 * DO; /* YES-SET IDENTIFY FOUND S21016 * 05680000 * IDFOUND = '80'X; /* SWITCH S21016 * 05690000 MVI IDFOUND,X'80' 0150 05700000 * GO TO OUTFWTE; /* WRITE IDENTIFY CARD S21016 * 05710000 BC 15,OUTFWTE 0151 05720000 * END; /* S21016 * 05730000 * 05740000 * /******************************************************************** 05750000 * /* AMAEODAD IS ENTERED UPON EOF OR WHEN THE OBJ HAS BEEN SPOOLED * 05760000 * /******************************************************************** 05770000 * 05780000 * 05790000 * AMAEODAD: 05800000 * NAMMATCH = 0; /* RESET NAME FOUND SWITCH M4000 * 05810000 @9F1 EQU * 0153 05820000 AMAEODAD MVI NAMMATCH,0 0153 05830000 * IF IDFOUND = '00'X /* IDENTIFY CARD MISSING S21016 * 05840000 * THEN 05850000 CLI IDFOUND,X'00' 0154 05860000 * GO TO AMANOID; /* YES-WRITE MESSAGE S21016 * 05870000 BC 08,AMANOID 0155 05880000 * IDFOUND = '00'X; /* TURN OFF IDENTIFY FOUND SWITCH* 05890000 MVI IDFOUND,X'00' 0156 05900000 * SSIINFO = '0'; /* NO SETSSI CARD NEEDED M4000 * 05910000 MVI SSICARD+12,C'0' 0157 05920000 MVI SSICARD+13,C' ' 0157 05930000 MVC SSICARD+14(6),SSICARD+13 0157 05940000 * IF BRFIELD ^= 0 THEN /* DOES A NAME STMNT HAVE TO BE * 05950000 CLI 0(@5),0 0158 05960000 * /* WRITTEN BECAUSE OF ENTRY FROM * 05970000 * /* PART 2(IEBCOPY) OF AMAPTFLE? * 05980000 * /* M4000 * 05990000 * GO TO AMARET2; /* NO-RETURN TO AMAPTFLE * 06000000 BC 07,AMARET2 0159 06010000 * UT2OUT = ' '; /* YES-CLEAR THE BUFFER M4003 * 06020000 MVI UT2OUT,C' ' 0160 06030000 MVC UT2OUT+1(79),UT2OUT 0160 06040000 * MDN = ' '; /* BLANK MOD NAME BUFFER M4003 * 06050000 MVI NAMECARD+10,C' ' 0161 06060000 MVC NAMECARD+11(10),NAMECARD+10 0161 06070000 * DO I = 1 TO 8; /* MOVE MODULE NAME INTO BUFFER * 06080000 LA @6,1 0162 06090000 * IF SELBUF(I) = ',' | SELBUF(I) = ')' | SELBUF(I) = ' ' THEN 06100000 @DO9F0 LR @2,@6 0163 06110000 L @4,44(0,@5) 0163 06120000 LA @A,0(@2,@4) 0163 06130000 BCTR @A,0 0163 06140000 CLI 0(@A),C',' 0163 06150000 BC 08,@9EC 0163 06160000 CLI 0(@A),C')' 0163 06170000 BC 08,@9EB 0163 06180000 CLI 0(@A),C' ' 0163 06190000 BC 07,@9EA 0163 06200000 * GO TO MOVEREP; /* REACHED END OF NAME M4011 * 06210000 BC 08,MOVEREP 0164 06220000 * MDN(I) = SELBUF(I); /* MOVE CHAR TO BUFFER * 06230000 @9EA LR @2,@6 0165 06240000 L @4,44(0,@5) 0165 06250000 LA @E,0(@2,@4) 0165 06260000 BCTR @E,0 0165 06270000 LA @A,NAMECARD+9(@2) 0165 06280000 MVC 0(1,@A),0(@E) 0165 06290000 * END; /* M4003 * 06300000 * 06310000 * MOVEREP: 06320000 * MDN(I:I+2) = REP; /* MOVE (R) TO NAME CARD * 06330000 AH @6,@D2 0166 06340000 @DO9EF CH @6,@D3 0166 06350000 BC 12,@DO9F0 0166 06360000 MOVEREP LR @2,@6 0167 06370000 LA @A,NAMECARD+9(@2) 0167 06380000 MVC 0(3,@A),REP 0167 06390000 * SSIINFO = ' '; /* BLANK SETSSI FIELD M4000 * 06400000 MVI SSICARD+12,C' ' 0168 06410000 MVC SSICARD+13(7),SSICARD+12 0168 06420000 * GO TO SSIGEN; /* GET SSI INFORMATION M4000 * 06430000 BC 15,SSIGEN 0169 06440000 * 06450000 * MOVESSI: 06460000 * SSIINFO = SSIDATA; /* MOVE SSI TO SETSSI CARD * 06470000 MOVESSI L @2,CORRSSI 0170 06480000 MVC SSICARD+12(8),0(@2) 0170 06490000 * UT2OUT = SSICARD; /* MOVE CARD TO BUFFER M4000 * 06500000 MVC UT2OUT(20),SSICARD 0171 06510000 MVI UT2OUT+20,C' ' 0171 06520000 MVC UT2OUT+21(59),UT2OUT+20 0171 06530000 * OPENREG = OUTFDCB; /* M4000 * 06540000 L @3,28(0,@5) 0172 06550000 * GENERATE; 06560000 WRITE OUTFSSI,SF,(OPENREG),UT2OUT WRITE SETSSI CARD M4000 06570000 CHECK OUTFSSI M4000 06580000 DS 0H 06590000 * UT2OUT = ' '; 06600000 MVI UT2OUT,C' ' 0174 06610000 MVC UT2OUT+1(79),UT2OUT 0174 06620000 * UT2OUT = NAMECARD; /* MOVE NAME CARD INTO BUFFER * 06630000 MVC UT2OUT(21),NAMECARD 0175 06640000 MVI UT2OUT+21,C' ' 0175 06650000 MVC UT2OUT+22(58),UT2OUT+21 0175 06660000 * OPENREG = OUTFDCB; /* GET THE OUTFDCB ADDRESS * 06670000 L @3,28(0,@5) 0176 06680000 * GENERATE; 06690000 WRITE OUTFNAME,SF,(OPENREG),UT2OUT 06700000 CHECK OUTFNAME 06710000 DS 0H 06720000 * 06730000 * /******************************************************************** 06740000 * /* THE AMALINK SUBROUTINE IS ENTERED WHEN A LINK TO THE * 06750000 * /* LINKAGE EDITOR IS REQUIRED TO LINKEDIT A MODULE FOR THE PTF. * 06760000 * /* IF AMALINK IS ENTERED TO LINKEDIT A MODULE THAT WAS COPIED * 06770000 * /* INTO THE SYSTEM AT SYSGEN, THEN A BRANCH IS MADE TO AMAPTF02 * 06780000 * /* TO RETRIEVE THE LINKEDIT ATTRIBUTES OF THE MODULE BEFORE THE * 06790000 * /* LINKEDIT IS DONE. OTHERWISE, THE ATTRIBUTES HAVE ALREADY BEEN* 06800000 * /* RETRIEVED FROM THE EXEC STATEMENT AND NO BRANCH TO AMAPTF02 * 06810000 * /* IS DONE. IN EITHER CASE, THE OVERLAY RECORD TABLE IN * 06820000 * /* AMAPTFLE IS FREED SO THAT THE LINKAGE EDITOR CAN BE BROUGHT * 06830000 * /* INTO CORE. ALSO BEFORE THE LINK IS DONE, THE OUTFDCB IS * 06840000 * /* CLOSED BECAUSE THE LINKAGE EDITOR WILL RE-OPEN IT AS THE * 06850000 * /* SYSLIN DATA SET. UPON RETURN FROM THE EDITOR, THE OUTFDCB IS * 06860000 * /* RE-OPENED AND TESTED FOR A SUCCESSFUL OPEN. LINKAGE EDITOR * 06870000 * /* RETURN CODES ARE CHECKED, AND A DISPOSITION MESSAGE IS ISSUED.* 06880000 * /* A RETURN IS MADE TO AMAPTFLE. * 06890000 * /******************************************************************** 06900000 * 06910000 * 06920000 * AMALINK: 06930000 * IF BRFIELD = 0 /* NAME MATCH ON SELECT STMNT? 06940000 * M4000 * 06950000 * THEN 06960000 AMALINK CLI 0(@5),0 0178 06970000 BC 07,@9E9 0178 06980000 * DO; 06990000 * BLDLFLD = ' '; /* YES-CLEAR PTF02'S PARM LIST * 07000000 MVI BLDLFLD,C' ' 0180 07010000 MVC BLDLFLD+1(71),BLDLFLD 0180 07020000 * BLDLFLD(5:5+I-2) = MDN; /* MOVE IN NAME * 07030000 LA @E,NAMECARD+10 0181 07040000 LH @2,@D4 0181 07050000 AR @2,@6 0181 07060000 AH @2,@D1 0181 07070000 SH @2,@D1 0181 07080000 LA @A,BLDLFLD+4 0181 07090000 EX @2,@MVC 0181 07100000 * /* M4003 * 07110000 * GO TO AMATABAD; /* GO FREE OVERLAY TABLE * 07120000 BC 15,AMATABAD 0182 07130000 * END; 07140000 * CCCCCCCC = MODSTRBF; /* NO-MOVE MOD NAME INTO MESSAGE * 07150000 @9E9 L @2,4(0,@5) 0184 07160000 MVC AMA006I+21(8),0(@2) 0184 07170000 * GO TO AMANOBLD; /* NO BLDL NEEDED M4003 * 07180000 BC 15,AMANOBLD 0185 07190000 * 07200000 * /******************************************************************** 07210000 * /* YES - AMAPTF02 IS NEEDED BECAUSE MODULE WAS ORIGINALLY COPIED * 07220000 * /* INTO THE SYSTEM. MOVE MODULE NAME INTO DISPOSITION MESSAGE * 07230000 * /* AND THEN GO TO AMAPTF02 TO RETRIEVE LINKEDIT ATTRIBUTES. * 07240000 * /******************************************************************** 07250000 * 07260000 * 07270000 * AMATABAD: 07280000 * CCCCCCCC = BLDLFLD(5:12); /* MOVE NAME M4000 * 07290000 AMATABAD MVC AMA006I+21(8),BLDLFLD+4 0186 07300000 * LSTPTR = ADDR(BLDLFLD); /* GET ADDR OF PTF02'S PARM LIST * 07310000 LA @1,BLDLFLD 0187 07320000 * CALL AMAPTF02; /* GO TO AMAPTF02 * 07330000 L @2,16(0,@5) 0188 07340000 LR @F,@2 0188 07350000 BALR @E,@F 0188 07360000 * MSGBUF = ' '; /* CLEAR MESSAGE BUFFER * 07370000 MVI MSGBUF,C' ' 0189 07380000 MVC MSGBUF+1(120),MSGBUF 0189 07390000 * IF BLDLFLD(1:2) = '0000'X | /* BLDL SUCCESSFUL? * 07400000 * BLDLFLD(1:2) = '0001'X THEN 07410000 CLC BLDLFLD(2),@X2 0190 07420000 BC 08,@9E8 0190 07430000 CLC BLDLFLD(2),@X12 0190 07440000 BC 07,@9E7 0190 07450000 * GO TO AMA6IB; /* NO-GO WRITE ERROR MESSAGE * 07460000 BC 08,AMA6IB 0191 07470000 * IF BLDLFLD(1) = 'FF'X /* SYSLMOD OPEN FAIL M4012 * 07480000 * THEN 07490000 @9E7 CLI BLDLFLD,X'FF' 0192 07500000 * GO TO AMADDSYS; /* YES-GO WRITE ERROR MESSAGE * 07510000 BC 08,AMADDSYS 0193 07520000 * 07530000 * AMANOBLD: 07540000 * OPENREG = OUTFDCB; /* GET OUTFDCB ADDRESS * 07550000 AMANOBLD L @3,28(0,@5) 0194 07560000 * GENERATE; 07570000 CLOSE ((OPENREG),) CLOSE THE OUTFDCB 07580000 DS 0H 07590000 * 07600000 * /******************************************************************** 07610000 * /* CHECK IF UPDATING THE NUCLEUS Y01045* 07620000 * /******************************************************************** 07630000 * 07640000 * IF COMSW = '80'X THEN /* UPDATING THE NUCLEUS Y01045* 07650000 CLI 3(@5),X'80' 0196 07660000 BC 07,@9E6 0196 07670000 * DO; /* YES Y01045* 07680000 * GENERATE; 07690000 DEVTYPE DSSDNME,DEVDATA PARMLIB DD PRESENT Y01045 07700000 DS 0H 07710000 * IF RETCODE ^= 0 THEN /* RETURN CODE ZERO Y01045* 07720000 LTR @F,@F 0199 07730000 BC 08,@9E5 0199 07740000 * DO; /* NO - DD STATEMENT MISSING * 07750000 * /* Y01045* 07760000 * MSGBUF=AMA016I; /* MOVE MSG TO BUFFER Y01045* 07770000 MVC MSGBUF(61),AMA016I 0201 07780000 MVI MSGBUF+61,C' ' 0201 07790000 MVC MSGBUF+62(59),MSGBUF+61 0201 07800000 * RETCDE='10'X; /* SET RETURN CODE Y01045* 07810000 MVI 2(@5),X'10' 0202 07820000 * GOTO AMACALL; /* WRITE MESSAGE AND Y01045* 07830000 BC 15,AMACALL 0203 07840000 * /* RETURN TO FILCLOSE Y01045* 07850000 * END; /* END DO GROUP Y01045* 07860000 * END; /* END CHECK FOR NUCLEUS Y01045* 07870000 @9E5 EQU * 0205 07880000 * /* UPDATE Y01045* 07890000 * 07900000 * LSTPTR = OVTABADR; /* GET OVERLAY TABLE ADDRESS 07910000 * M4000 * 07920000 @9E6 L @1,8(0,@5) 0206 07930000 * GENERATE; 07940000 FREEMAIN R,LV=26800,A=(LSTPTR) FREE THE OVERLAY TABLE S21016 07950000 LINK EPLOC=LKEDNAME,PARAM=(BLDLFLD,DDNMELST),VL=1 07960000 DS 0H 07970000 * RETCDSAV = RETCODE; /* SAVE L.E. RETURN CODE * 07980000 ST @F,RETCDSAV 0208 07990000 * OPENREG = ADDR(OVTABADR); /* GET OVERLAY TABLE ADDR M4000 * 08000000 LA @3,8(0,@5) 0209 08010000 * 08020000 * /******************************************************************** 08030000 * /* GETMAIN TO RE-INITIALIZE THE OVERLAY TABLE IN AMAPTFLE * 08040000 * /******************************************************************** 08050000 * 08060000 * GENERATE(GETMAIN EU,LV=26800,A=(OPENREG)); /* S21016 * 08070000 GETMAIN EU,LV=26800,A=(OPENREG) 08080000 DS 0H 08090000 * 08100000 * /******************************************************************** 08110000 * 08120000 * RETCODE = RETCDSAV; /* RESTORE RETURN CODE M0867* 08130000 L @F,RETCDSAV 0211 08140000 * IF RETCODE = 12|RETCODE = 16 THEN /* SUCCESSFUL L.E.? M0867* 08150000 CH @F,@D5 0212 08160000 BC 08,@9E4 0212 08170000 CH @F,@D6 0212 08180000 BC 07,@9E3 0212 08190000 * GO TO AMA6II; /* NO-GO WRITE ERROR MSG M0867* 08200000 BC 08,AMA6II 0213 08210000 * OPENREG = OUTFDCB; /* GET OUTFDCB ADDRESS * 08220000 @9E3 L @3,28(0,@5) 0214 08230000 * 08240000 * /******************************************************************** 08250000 * /* RE-OPEN THE OUTFDCB TO BUILD ANOTHER SYSLIN DATA SET IF NEEDED* 08260000 * /******************************************************************** 08270000 * 08280000 * GENERATE (OPEN ((OPENREG),INPUT)); /* S21016 * 08290000 OPEN ((OPENREG),INPUT) 08300000 DS 0H 08310000 * 08320000 * /******************************************************************** 08330000 * 08340000 * OPENREG = OUTFDCB; /* GET THE OUTFDCB ADDR * 08350000 L @3,28(0,@5) 0216 08360000 * GENERATE; 08370000 USING IHADCB,OPENREG 08380000 TM DCBOFLGS,OPENFLG DCB OPEN OKAY? 08390000 BZ AMADDOUT NO-GO WRITE ERROR MESSAGE 08400000 DS 0H 08410000 * LLLLLLLL = CCCCCCCC; /* MOVE MODULE NAME INTO * 08420000 MVC AMA007I+21(8),AMA006I+21 0218 08430000 * /* DISPOSITION MESSAGE * 08440000 * 08450000 * /******************************************************************** 08460000 * /* LOCATE THE SSI IN THE SSI TABLE FOR INCLUSION IN MESSAGE * 08470000 * /******************************************************************** 08480000 * 08490000 * 08500000 * SSIGEN: 08510000 * DIFF = SSISAVE - MODTBL; /* FIND NAME DISPLACEMENT * 08520000 SSIGEN L @F,56(0,@5) 0219 08530000 LCR @F,@F 0219 08540000 A @F,48(0,@5) 0219 08550000 ST @F,DIFF 0219 08560000 * /* IN MOD NAME TABLE M4000 * 08570000 * QUOTIENT = DIFF/10; /* DIVIDE BY ENTRY LNGTH YA00891 * 08580000 LR @E,@F 0220 08590000 SRDA @E,32 0220 08600000 LA @0,10 0220 08610000 DR @E,@0 0220 08620000 ST @F,QUOTIENT 0220 08630000 * ADDFACTR = QUOTIENT * 8; /* MULTIPLY BY SSI ENTRY * 08640000 SLA @F,3 0221 08650000 ST @F,ADDFACTR 0221 08660000 * /* LENGTH TO LOCATE THE * 08670000 * /* MODULE'S SSI IN TABLE * 08680000 * CORRSSI = SSITABLE + ADDFACTR; /* GET SSI ADDRESS * 08690000 A @F,60(0,@5) 0222 08700000 ST @F,CORRSSI 0222 08710000 * SSI = SSIDATA; /* MOVE SSI INTO MSG * 08720000 LR @2,@F 0223 08730000 MVC AMA007I+60(8),0(@2) 0223 08740000 * IF SSIINFO = ' ' THEN 08750000 CLC SSICARD+12(8),@C13 0224 08760000 * GO TO MOVESSI; /* NEED SETSSI CARD * 08770000 BC 08,MOVESSI 0225 08780000 * MSGBUF = AMA007I; /* MOVE MSG INTO BUFFER * 08790000 MVC MSGBUF(68),AMA007I 0226 08800000 MVI MSGBUF+68,C' ' 0226 08810000 MVC MSGBUF+69(52),MSGBUF+68 0226 08820000 * CALL AMAERMSG; /* WRITE MESSAGE S21016 * 08830000 L @F,@V1 ADDRESS OF AMAERMSG 0227 08840000 BALR @E,@F 0227 08850000 * 08860000 * /******************************************************************** 08870000 * 08880000 * AMA013NM = LLLLLLLL; /* MOVE MODULE NAME TO MSG * 08890000 MVC AMA013I+58(8),AMA007I+21 0228 08900000 * /* S21016 * 08910000 * MSGBUF = AMA013I; /* MOVE MSG INTO BUFFER * 08920000 MVC MSGBUF(66),AMA013I 0229 08930000 MVI MSGBUF+66,C' ' 0229 08940000 MVC MSGBUF+67(54),MSGBUF+66 0229 08950000 * /* S21016 * 08960000 * CALL AMAERMSG; /* WRITE MESSAGE S21016 * 08970000 L @F,@V1 ADDRESS OF AMAERMSG 0230 08980000 BALR @E,@F 0230 08990000 * 09000000 * PREPRD: 09010000 * OPENREG = OUTFDCB; /* S21016 * 09020000 PREPRD L @3,28(0,@5) 0231 09030000 * GENERATE; /* S21016 * 09040000 READ OUTFDECA,SF,(OPENREG),UT2OUT READ IDENTIFY CARDS S21016 09050000 CHECK OUTFDECA S21016 09060000 DS 0H 09070000 * IF UT2OUT(1) ^= ' ' /* CONTROL CARD S21016 * 09080000 * THEN 09090000 CLI UT2OUT,C' ' 0233 09100000 * GO TO PREPRD; /* NO-GET NEXT CARD S21016 * 09110000 BC 07,PREPRD 0234 09120000 * I = 1; /* INITIALIZE COUNT S21016 * 09130000 LA @6,1 0235 09140000 * IF IDENTCON = '08'X THEN 09150000 CLI 1(@5),X'08' 0236 09160000 BC 07,@9E2 0236 09170000 * DO; /* CONTINUATION S21016 * 09180000 * IDENTCON = '00'X; /* YES-TURN OFF SW S21016 * 09190000 MVI 1(@5),X'00' 0238 09200000 * GO TO AMAIDST; /* WRITE INFO S21016 * 09210000 BC 15,AMAIDST 0239 09220000 * END; /* S21016 * 09230000 * OPENREG = ADDR(AMAIDCHK); /* SET RETURN ADDR S21016 * 09240000 @9E2 LA @3,AMAIDCHK 0241 09250000 * GO TO CHKSPACE; /* FIND OPERAND S21016 * 09260000 BC 15,CHKSPACE 0242 09270000 * 09280000 * AMAIDCHK: /* S21016 * 09290000 * IF UT2OUT(I:I+3) = 'NAME' /* NAME CARD S21016 * 09300000 * THEN 09310000 AMAIDCHK LR @2,@6 0243 09320000 LA @A,UT2OUT-1(@2) 0243 09330000 CLC 0(4,@A),@C14 0243 09340000 * GO TO OUTFEOF; /* YES-EXIT S21016 * 09350000 BC 08,OUTFEOF 0244 09360000 * IF UT2OUT(I:I+7) ^= 'IDENTIFY' /* IDENTIFY CARD S21016 * 09370000 * THEN 09380000 CLC 0(8,@A),@C15 0245 09390000 * GO TO PREPRD; /* NO-READ NEW CARD S21016 * 09400000 BC 07,PREPRD 0246 09410000 * 09420000 * AMAIDST: 09430000 * OPENREG = ADDR(AMAIDBL); /* SET RETURN ADDR S21016 * 09440000 AMAIDST LA @3,AMAIDBL 0247 09450000 * IF UT2OUT(72) ^= ' ' /* CONTINUATION M0861 * 09460000 * THEN 09470000 CLI UT2OUT+71,C' ' 0248 09480000 BC 08,@9E1 0248 09490000 * IDENTCON = '08'X; /* YES-INDICATE SO M0861 * 09500000 MVI 1(@5),X'08' 0249 09510000 * GO TO CHKSPACE; /* FIND IDR INFO S21016 * 09520000 BC 15,CHKSPACE 0250 09530000 * 09540000 * AMAIDBL: 09550000 * MSGBUF = ' '; /* BLANK BUFFER S21016 * 09560000 AMAIDBL MVI MSGBUF,C' ' 0251 09570000 MVC MSGBUF+1(120),MSGBUF 0251 09580000 * MSGBUF(20:82) = UT2OUT(I:72); /* MOVE TO BUFFER S21016 * 09590000 LA @2,72 0252 09600000 LR @4,@6 0252 09610000 SR @2,@4 0252 09620000 LA @E,UT2OUT-1(@4) 0252 09630000 LA @A,MSGBUF+19 0252 09640000 MVI 0(@A),C' ' 0252 09650000 MVC 1(062,@A),0(@A) 0252 09660000 EX @2,@MVC 0252 09670000 * CALL AMAERMSG; /* IDENTIFY INFO S21016 * 09680000 L @F,@V1 ADDRESS OF AMAERMSG 0253 09690000 BALR @E,@F 0253 09700000 * GO TO PREPRD; /* READ NEXT CARD S21016 * 09710000 BC 15,PREPRD 0254 09720000 * 09730000 * OUTFEOF: 09740000 * OPENREG = OUTFDCB; /* S21016 * 09750000 OUTFEOF L @3,28(0,@5) 0255 09760000 * GENERATE (CLOSE ((OPENREG))); /* S21016 * 09770000 CLOSE ((OPENREG)) 09780000 DS 0H 09790000 * OPENOUTF: /* M0867 * 09800000 * OPENREG = OUTFDCB; /* S21016 * 09810000 OPENOUTF L @3,28(0,@5) 0257 09820000 * GENERATE (OPEN ((OPENREG),OUTPUT)); /* OPEN OUTF S21016 * 09830000 OPEN ((OPENREG),OUTPUT) 09840000 DS 0H 09850000 * OPENREG = OUTFDCB; /* GET THE OUTFDCB ADDR S21016 * 09860000 L @3,28(0,@5) 0259 09870000 * GENERATE; 09880000 USING IHADCB,OPENREG S21016 09890000 TM DCBOFLGS,OPENFLG DCB OPEN OKAY? S21016 09900000 BZ AMADDOUT NO-GO WRITE ERROR MESSAGE S21016 09910000 DS 0H 09920000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 09930000 BC 15,AMARET2 0261 09940000 * 09950000 * CHKSPACE: 09960000 * DO I = I TO 71; /* GET NEXT OPERAND S21016 * 09970000 * IF UT2OUT(I) = ' ' /* REACHED NON BLANK S21016 * 09980000 * THEN 09990000 @DO9E0 LR @2,@6 0263 10000000 LA @A,UT2OUT-1(@2) 0263 10010000 CLI 0(@A),C' ' 0263 10020000 * GO TO CHKSP2; /* NO CONTINUE TO SCAN S21016 * 10030000 BC 08,CHKSP2 0264 10040000 * END; 10050000 * 10060000 * CHKSP2: 10070000 * DO I = I TO 71; 10080000 AH @6,@D2 0265 10090000 @DO9DF CH @6,@D7 0265 10100000 BC 12,@DO9E0 0265 10110000 BC 15,@DO9DB 0266 10120000 * IF UT2OUT(I) ^= ' ' /* REACHED NON BLANK S21016 * 10130000 * THEN 10140000 @DO9DC LR @2,@6 0267 10150000 LA @A,UT2OUT-1(@2) 0267 10160000 CLI 0(@A),C' ' 0267 10170000 BC 08,@9D8 0267 10180000 * GENERATE; 10190000 BR 3 RETURN TO CALLER S21016 10200000 DS 0H 10210000 * END; /* S21016 * 10220000 * 10230000 * /******************************************************************** 10240000 * /******************************************************************** 10250000 * /* AMALEPRM IS A SUBROUTINE THAT IS USED TO RETRIEVE THE * 10260000 * /* LINKEDIT ATTRIBUTES OF THE MODULE FROM THE EXEC STATEMENT * 10270000 * /* IF THE MODULE WAS LINKEDITED INTO THE SYSTEM AT SYSGEN TIME. * 10280000 * /******************************************************************** 10290000 * 10300000 * 10310000 * AMALEPRM: 10320000 * I = 3; /* SET INDEX PAST SLASHES * 10330000 @9D8 AH @6,@D2 0269 10340000 @DO9DB CH @6,@D7 0269 10350000 BC 12,@DO9DC 0269 10360000 AMALEPRM LA @6,3 0270 10370000 * IF PARMCONT = '1'B THEN /* CONTINUATION STATEMENT? * 10380000 TM PARMCONT,B'10000000' 0271 10390000 * GO TO AMABLANK; /* YES-FIND FIRST KEYWORD * 10400000 BC 01,AMABLANK 0272 10410000 * PRMNUMBR = 0; /* RESET LKED PARM LENGTH M4003 * 10420000 SR @F,@F 0273 10430000 STH @F,PRMNUMBR 0273 10440000 * 10450000 * AMACOLCK: 10460000 * IF I >= 72 THEN /* SCAN COMPLETE * 10470000 AMACOLCK CH @6,@D8 0274 10480000 * 10490000 * AMACONT: 10500000 * GO TO AMARET2; /* YES-RETURN TO AMAPTFLE * 10510000 BC 11,AMARET2 0275 10520000 * 10530000 * AMABLANK: 10540000 * IF PCHBUFFR(I) = ' ' /* KEYWORD FOUND? * 10550000 * THEN 10560000 @9D7 EQU * 0276 10570000 AMABLANK LR @2,@6 0276 10580000 L @4,20(0,@5) 0276 10590000 LA @A,0(@2,@4) 0276 10600000 BCTR @A,0 0276 10610000 CLI 0(@A),C' ' 0276 10620000 BC 07,@9D6 0276 10630000 * DO; /* YES * 10640000 * 10650000 * AMABUMPI: 10660000 * I = I+1; /* BUMP INDEX INTO BUFFER * 10670000 AMABUMPI AH @6,@D2 0278 10680000 * GO TO AMACOLCK; /* CHECK FOR END OF STMNT * 10690000 BC 15,AMACOLCK 0279 10700000 * END; 10710000 * ELSE /* NO * 10720000 * IF PARMCONT = '1'B THEN /* A CONTINUAION STMNT? * 10730000 @9D6 TM PARMCONT,B'10000000' 0281 10740000 * GO TO AMAPRM2; /* YES-CONSTRUCT PARM LIST * 10750000 BC 01,AMAPRM2 0282 10760000 * ELSE 10770000 * /* NO - THEN CHECK TO SEE IF PARMS HAVE BEEN FOUND * 10780000 * IF PCHBUFFR(I:I+4) = PARMEQUL THEN /* FOUND? * 10790000 LR @2,@6 0283 10800000 L @4,20(0,@5) 0283 10810000 LA @A,0(@2,@4) 0283 10820000 BCTR @A,0 0283 10830000 CLC 0(5,@A),PARMEQUL 0283 10840000 * GO TO AMAMVPRM; /* YES-SET UP PARM LIST * 10850000 * ELSE 10860000 * GO TO AMABUMPI; /* NO-CHECK NEXT CHAR * 10870000 BC 07,AMABUMPI 0285 10880000 * 10890000 * AMAMVPRM: 10900000 * ENDPARM = '7D'X; /* SET PARM END TO ' M4011 * 10910000 @9D5 EQU * 0286 10920000 AMAMVPRM MVI ENDPARM,X'7D' 0286 10930000 * IF PCHBUFFR(I+5) = '(' /* IF PARM BEGIN IS M4011 * 10940000 * THEN 10950000 LA @2,5 0287 10960000 AR @2,@6 0287 10970000 L @4,20(0,@5) 0287 10980000 LA @A,0(@2,@4) 0287 10990000 BCTR @A,0 0287 11000000 CLI 0(@A),C'(' 0287 11010000 BC 07,@9D4 0287 11020000 * ENDPARM = ')'; /* (,SET END TO ) M4011 * 11030000 MVI ENDPARM,C')' 0288 11040000 * I = I+6; /* BUMP PAST 'PARM=' * 11050000 @9D4 AH @6,@D9 0289 11060000 * IF I >= 72 /* AT END OF STMNT? * 11070000 * THEN 11080000 CH @6,@D8 0290 11090000 BC 04,@9D3 0290 11100000 * DO; /* YES * 11110000 * PARMCONT = '1'B; /* INDICATE CONTINUATION * 11120000 OI PARMCONT,B'10000000' 0292 11130000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 11140000 BC 15,AMARET2 0293 11150000 * END; 11160000 * 11170000 * AMAPRM1: 11180000 * B = 3; /* INDEX INTO BLDLFLD * 11190000 @9D3 EQU * 0295 11200000 AMAPRM1 LA @F,3 0295 11210000 STH @F,B 0295 11220000 * 11230000 * /******************************************************************** 11240000 * /* MOVE THE PARAMETERS, ONE CHARACTER AT A TIME, INTO BLDLFLD * 11250000 * /******************************************************************** 11260000 * 11270000 * 11280000 * AMAPRM2: 11290000 * BLDLFLD(B) = PCHBUFFR(I); /* MOVE A CHARACTER * 11300000 AMAPRM2 LR @2,@6 0296 11310000 L @4,20(0,@5) 0296 11320000 LA @E,0(@2,@4) 0296 11330000 BCTR @E,0 0296 11340000 MVC @TEMP2+2(2),B 0296 11350000 L @7,@TEMP2 0296 11360000 LA @A,BLDLFLD-1(@7) 0296 11370000 MVC 0(1,@A),0(@E) 0296 11380000 * B = B+1; /* BUMP BLDLFLD INDEX * 11390000 LA @F,1 0297 11400000 MVC @TEMP2+2(2),B 0297 11410000 A @F,@TEMP2 0297 11420000 STH @F,B 0297 11430000 * I = I+1; /* BUMP PCHBUFFR INDEX * 11440000 AH @6,@D2 0298 11450000 * PRMNUMBR = PRMNUMBR+1; /* BUMP NUMBER OF PARMS * 11460000 LA @F,1 0299 11470000 MVC @TEMP2+2(2),PRMNUMBR 0299 11480000 A @F,@TEMP2 0299 11490000 STH @F,PRMNUMBR 0299 11500000 * IF I >= 72 /* END OF STATEMENT? * 11510000 * THEN 11520000 CH @6,@D8 0300 11530000 BC 04,@9D2 0300 11540000 * DO; /* YES * 11550000 * PARMCONT = '1'B; /* INDICATE PARM CONTINUED * 11560000 OI PARMCONT,B'10000000' 0302 11570000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 11580000 BC 15,AMARET2 0303 11590000 * END; 11600000 * ELSE 11610000 * IF PCHBUFFR(I) = ENDPARM /* END OF PARAMETERS M4011 * 11620000 * THEN 11630000 @9D2 LR @2,@6 0305 11640000 L @4,20(0,@5) 0305 11650000 LA @A,0(@2,@4) 0305 11660000 BCTR @A,0 0305 11670000 CLC 0(1,@A),ENDPARM 0305 11680000 BC 07,@9D0 0305 11690000 * DO; /* YES * 11700000 * B = 0; /* RE-INIT BLDLFLD INDEX * 11710000 SR @F,@F 0307 11720000 STH @F,B 0307 11730000 * PARMCONT = '0'B; /* SET NO CONTINUATION * 11740000 NI PARMCONT,B'01111111' 0308 11750000 * BLDLFLD(1:2) = PRMNUMBR; /* MOVE PARM LENGTH * 11760000 MVC BLDLFLD(2),PRMNUMBR 0309 11770000 * /* M4003 * 11780000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 11790000 BC 15,AMARET2 0310 11800000 * END; 11810000 * ELSE /* NOT END OF PARMS * 11820000 * GO TO AMAPRM2; /* MOVE ANOTHER PARM * 11830000 * 11840000 * /******************************************************************** 11850000 * /******************************************************************** 11860000 * /* AMACLOSE IS ENTERED FROM AMAPTFLE WHEN ALL OF THE DCBS * 11870000 * /* MUST BE CLOSED BEFORE TERMINATION. * 11880000 * /******************************************************************** 11890000 * 11900000 * GENERATE; 11910000 @9CF EQU * 0313 11920000 @9D1 EQU * 0313 11930000 AMACLOSE CLOSE (SYSUTDCB) CLOSE THE SYSUTDCB 11940000 DS 0H 11950000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 11960000 BC 15,AMARET2 0314 11970000 * 11980000 * /******************************************************************** 11990000 * /******************************************************************** 12000000 * /******************************************************************** 12010000 * /* SET UP FOR MESSAGE AMA0006I * 12020000 * /******************************************************************** 12030000 * 12040000 * 12050000 * AMA6IB: 12060000 * NN = '01'; /* SET UNSUCCESSFUL * 12070000 AMA6IB MVC AMA006I+53(2),@C19 0315 12080000 * /* BLDL CODE IN MSG * 12090000 * GO TO AMAMV6I; /* MOVE REMAINDER OF MSG * 12100000 BC 15,AMAMV6I 0316 12110000 * 12120000 * AMA6II: 12130000 * NN = '02'; /* SET UNSUCCESSFUL * 12140000 AMA6II MVC AMA006I+53(2),@C20 0317 12150000 * /* L.E. CODE IN MSG * 12160000 * 12170000 * AMAMV6I: 12180000 * MSGBUF = AMA006I; /* MOVE MSG INTO BUFFER * 12190000 AMAMV6I MVC MSGBUF(55),AMA006I 0318 12200000 MVI MSGBUF+55,C' ' 0318 12210000 MVC MSGBUF+56(65),MSGBUF+55 0318 12220000 * IF RETCDE < '08'X THEN /* CODE < 8 A48711* 12230000 CLI 2(@5),X'08' 0319 12240000 BC 10,@9CE 0319 12250000 * RETCDE='08'X; /* YES. CHANGE TO 8 A48711* 12260000 MVI 2(@5),X'08' 0320 12270000 * CALL AMAERMSG; /* WRITE MESSAGE * 12280000 @9CE L @F,@V1 ADDRESS OF AMAERMSG 0321 12290000 BALR @E,@F 0321 12300000 * IF NN = '02' THEN /*BAD LINK EDIT M0867* 12310000 CLC AMA006I+53(2),@C20 0322 12320000 * GO TO OPENOUTF; /*YES-OPEN OUTF M0867* 12330000 BC 08,OPENOUTF 0323 12340000 * OPENREG=OUTFDCB; /* GET DCB ADDRESS A53522* 12350000 L @3,28(0,@5) 0324 12360000 * GENERATE; /* POSITION DATA SET A53522* 12370000 CLOSE ((OPENREG),REREAD),TYPE=T 12380000 DS 0H 12390000 * GO TO AMARET2; /* RETURN TO AMAPTFLE * 12400000 BC 15,AMARET2 0326 12410000 * 12420000 * AMANOID: /* NO IDENTIFY CARD S21016 * 12430000 * MSGBUF = AMA010I; /* MOVE MSG TO BUFF S21016 * 12440000 AMANOID MVC MSGBUF(62),AMA010I 0327 12450000 MVI MSGBUF+62,C' ' 0327 12460000 MVC MSGBUF+63(58),MSGBUF+62 0327 12470000 * RETCDE='10'X; /* SET 16 RETURN CODE A48711* 12480000 MVI 2(@5),X'10' 0328 12490000 * GO TO AMACALL; /* WRITE MESSAGE AND * 12500000 BC 15,AMACALL 0329 12510000 * /* RETURN TO FILCLOSE * 12520000 * 12530000 * /******************************************************************** 12540000 * /******************************************************************** 12550000 * /* AMASYNAD IS THE SYNAD IN CASE OF AN I/O ERROR. * 12560000 * /* RETURN IS TO THE SYNADAF ROUTINE IN AMAPTFLE * 12570000 * /******************************************************************** 12580000 * 12590000 * 12600000 * AMASYNAD: 12610000 * GENERATE; /* M4013 * 12620000 AMASYNAD EQU * 0330 12630000 L 13,4(0,13) M4013 12640000 L 14,32(0,5) M4013 12650000 LM 2,12,28(13) DO NOT RESTORE REGISTERS 0 OR 1 M4013 12660000 BCR 15,14 M4013 12670000 DS 0H 12680000 * 12690000 * /******************************************************************** 12700000 * /******************************************************************** 12710000 * 12720000 * RESPECIFY DUMFIELD BASED(MSGAREA); 12730000 * 12740000 * /******************************************************************** 12750000 * /* AMADDMSG INITIALIZES THE ERROR MESSAGE FOR AN * 12760000 * /* UNSUCCESSFUL OPEN OF THE DCBS. * 12770000 * /******************************************************************** 12780000 * 12790000 * 12800000 * AMADDSYS: 12810000 * DUMFIELD(41:47) = DDSYSL; /* MOVE IN DDNAME M4012 * 12820000 AMADDSYS L @2,36(0,@5) 0332 12830000 MVC 40(7,@2),DDSYSL 0332 12840000 * GO TO AMADDRET; /* RETURN TO AMAPTFLE * 12850000 BC 15,AMADDRET 0333 12860000 * 12870000 * AMADDMSG: 12880000 * DUMFIELD(41:46) = DDMSG; /* MOVE IN DDNAME * 12890000 AMADDMSG L @2,36(0,@5) 0334 12900000 MVC 40(6,@2),DDMSG 0334 12910000 * GO TO AMADDRET; /* RETURN TO AMAPTFLE M4000 * 12920000 BC 15,AMADDRET 0335 12930000 * 12940000 * AMADDOUT: 12950000 * DUMFIELD(41:44) = DDMSGOUT; /* MOVE IN DDNAME * 12960000 AMADDOUT L @2,36(0,@5) 0336 12970000 MVC 40(4,@2),DDMSGOUT 0336 12980000 * 12990000 * AMADDRET: 13000000 * RETURN TO MESSAGE2; /* RETURN TO AMAPTFLE * 13010000 AMADDRET L @D,4(0,@D) 0337 13020000 L @E,52(0,@5) 0337 13030000 LM @F,@C,16(@D) 0337 13040000 BCR 15,@E 0337 13050000 * /* TO WRITE ERROR MESSAGE * 13060000 * 13070000 * AMARET2: 13080000 * BRFIELD = 0; /* CLEAR BRANCH TAB INDEX * 13090000 AMARET2 MVI 0(@5),0 0338 13100000 * 13110000 * AMARET1: 13120000 * RETURN; /* RETURN TO AMAPTFLE * 13130000 BC 15,@EL01 0339 13140000 * 13150000 * /******************************************************************** 13160000 * /******************************************************************** 13170000 * /* AMAERMSG IS AN INTERNAL SUBROUTINE THAT IS CALLED TO * 13180000 * /* WRITE MESSAGES. * 13190000 * /******************************************************************** 13200000 * 13210000 * 13220000 * AMAERMSG: 13230000 * PROC; 13240000 @EL01 L @D,4(0,@D) 0340 13250000 LM @E,@C,12(@D) 0340 13260000 BCR 15,@E 0340 13270000 AMAERMSG STM @E,@C,12(@D) 0340 13280000 ST @D,@SAV002+4 0340 13290000 LA @F,@SAV002 0340 13300000 ST @F,8(0,@D) 0340 13310000 LR @D,@F 0340 13320000 * OPENREG = PRINTDCB; /* GET DCB ADDRESS * 13330000 L @3,40(0,@5) 0341 13340000 * GENERATE; 13350000 WRITE ERRDECB,SF,(OPENREG),MSGBUF WRITE THE MESSAGE 13360000 CHECK ERRDECB 13370000 DS 0H 13380000 * RETURN; /* RETURN TO MSG CALLER * 13390000 BC 15,@EL01 0343 13400000 * 13410000 * /******************************************************************** 13420000 * /******************************************************************** 13430000 * 13440000 * GENERATE; 13450000 SYSUTDCB DCB DDNAME=SYSUT2,DSORG=PS,MACRF=(RP,W),LRECL=80,BLKSIZE=80,C13460000 SYNAD=AMASYNAD,EODAD=AMAEODAD,RECFM=F M4005 13470000 DS 0H 13480000 * 13490000 * /******************************************************************** 13500000 * 13510000 * END AMAERMSG; 13520000 BC 15,@EL01 0345 13530000 * END AMAPTF01; 13540000 @DATA1 EQU * 13550000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 13560000 @1 EQU 01 13570000 @2 EQU 02 13580000 @3 EQU 03 13590000 @4 EQU 04 13600000 @5 EQU 05 13610000 @6 EQU 06 13620000 @7 EQU 07 13630000 @8 EQU 08 13640000 @9 EQU 09 13650000 @A EQU 10 13660000 @B EQU 11 13670000 @C EQU 12 13680000 @D EQU 13 13690000 @E EQU 14 13700000 @F EQU 15 13710000 @D1 DC H'5' 13720000 @D2 DC H'1' 13730000 @D3 DC H'8' 13740000 @D4 DC H'-2' 13750000 @D5 DC H'12' 13760000 @D6 DC H'16' 13770000 @D7 DC H'71' 13780000 @D8 DC H'72' 13790000 @D9 DC H'6' 13800000 @MVC MVC 0(1,@A),0(@E) 13810000 @V1 DC A(AMAERMSG) 13820000 DS 0F 13830000 @C13 DC C' ' 13840000 @C14 DC C'NAME' 13850000 @C15 DC C'IDENTIFY' 13860000 @X2 DC X'0000' 13870000 @X12 DC X'0001' 13880000 @C19 DC C'01' 13890000 @C20 DC C'02' 13900000 DS 0D 13910000 @DATA EQU * 13920000 @SAV001 EQU @DATA+00000000 72 BYTE(S) ON WORD 13930000 OPENREG EQU 00000003 FULLWORD POINTER REGISTER 13940000 ORG @DATA+00000072 13950000 OPENBIT EQU * 1 BIT(S) ON BYTE 13960000 DC B'00000000' 13970000 RETCODE EQU 00000015 FULLWORD INTEGER REGISTER 13980000 LSTPTR EQU 00000001 FULLWORD POINTER REGISTER 13990000 LSTPTRSV EQU 00000005 FULLWORD POINTER REGISTER 14000000 I EQU 00000006 FULLWORD POINTER REGISTER 14010000 PRMLST EQU 00000000 72 BYTE(S) ON WORD 14020000 BRFIELD EQU PRMLST+00000000 1 BYTE POINTER 14030000 IDENTCON EQU PRMLST+00000001 1 BYTE POINTER 14040000 RETCDE EQU PRMLST+00000002 1 BYTE POINTER 14050000 COMSW EQU PRMLST+00000003 1 BYTE POINTER 14060000 MODSTORE EQU PRMLST+00000004 FULLWORD POINTER 14070000 OVTABADR EQU PRMLST+00000008 FULLWORD POINTER 14080000 PTF01 EQU PRMLST+00000012 FULLWORD POINTER 14090000 PTF02 EQU PRMLST+00000016 FULLWORD POINTER 14100000 PCHAREA EQU PRMLST+00000020 FULLWORD POINTER 14110000 MODAREA EQU PRMLST+00000024 FULLWORD POINTER 14120000 OUTFDCB EQU PRMLST+00000028 FULLWORD POINTER 14130000 SYNADEXT EQU PRMLST+00000032 FULLWORD POINTER 14140000 MSGAREA EQU PRMLST+00000036 FULLWORD POINTER 14150000 PRINTDCB EQU PRMLST+00000040 FULLWORD POINTER 14160000 SELNAME EQU PRMLST+00000044 FULLWORD POINTER 14170000 SSISAVE EQU PRMLST+00000048 FULLWORD POINTER 14180000 MESSAGE2 EQU PRMLST+00000052 FULLWORD POINTER 14190000 MODTBL EQU PRMLST+00000056 FULLWORD POINTER 14200000 SSITABLE EQU PRMLST+00000060 FULLWORD POINTER 14210000 PARMPTR EQU PRMLST+00000064 FULLWORD POINTER 14220000 FILCLOSE EQU PRMLST+00000068 FULLWORD POINTER 14230000 DDMSGOUT EQU * 4 BYTE(S) 14240000 DC C'OUTF' 14250000 DDMSG EQU * 6 BYTE(S) 14260000 DC C'SYSUT2' 14270000 DDSYSL EQU * 7 BYTE(S) 14280000 DC C'SYSLMOD' 14290000 MODSTRBF EQU 00000000 8 BYTE(S) 14300000 NAMMATCH EQU * 1 BYTE POINTER 14310000 DC AL1(0) 14320000 ORG @DATA+00000092 14330000 BRTABLE EQU * 6*FULLWORD POINTER 14340000 DC AL4(AMAOPEN) 14350000 DC AL4(AMASPOBJ) 14360000 DC AL4(AMALINK) 14370000 DC AL4(AMACLOSE) 14380000 DC AL4(AMASPS) 14390000 DC AL4(AMALEPRM) 14400000 MSGBUF EQU @DATA+00000116 121 BYTE(S) 14410000 UT2OUT EQU @DATA+00000237 80 BYTE(S) 14420000 DUMFIELD EQU 00000000 80 BYTE(S) 14430000 ORG @DATA+00000320 14440000 TTRZ EQU * 4 BYTE(S) ON WORD 14450000 DC C' ' 14460000 DC 00003C' ' 14470000 ENDPARM EQU @DATA+00000324 1 BYTE(S) 14480000 ORG @DATA+00000326 14490000 BLDLFLD EQU * 72 BYTE(S) ON HWORD 14500000 DC C' ' 14510000 DC 00071C' ' 14520000 PTF02ADR EQU @DATA+00000400 FULLWORD POINTER 14530000 NAMECARD EQU @DATA+00000404 21 BYTE(S) ON WORD 14540000 ORG NAMECARD+00000000 14550000 NME EQU * 10 BYTE(S) 14560000 DC C' NAME ' 14570000 MDN EQU NAMECARD+00000010 11 BYTE(S) 14580000 ORG @DATA+00000425 14590000 REP EQU * 3 BYTE(S) 14600000 DC C'(R)' 14610000 NEWNAME EQU * 1 BYTE(S) 14620000 DC X'00' 14630000 IDFOUND EQU * 1 BYTE(S) 14640000 DC X'80' 14650000 ALIASCD EQU @DATA+00000432 15 BYTE(S) ON WORD 14660000 ORG ALIASCD+00000000 14670000 A00000 EQU * 7 BYTE(S) 14680000 DC C' ALIAS ' 14690000 ALIASNM EQU ALIASCD+00000007 8 BYTE(S) 14700000 SSICARD EQU @DATA+00000448 20 BYTE(S) ON WORD 14710000 ORG SSICARD+00000000 14720000 SETSSI EQU * 12 BYTE(S) 14730000 DC C' SETSSI ' 14740000 SSIINFO EQU SSICARD+00000012 8 BYTE(S) 14750000 SELBUF EQU 00000000 8 BYTE(S) 14760000 PRMFIELD EQU 00000000 102 BYTE(S) ON WORD 14770000 PARMLEN EQU PRMFIELD+00000000 HALFWORD POINTER 14780000 PARM EQU PRMFIELD+00000002 100 BYTE(S) 14790000 ORG @DATA+00000468 14800000 LKEDNAME EQU * 8 BYTE(S) 14810000 DC C' ' 14820000 DC 00007C' ' 14830000 AMA005I EQU * 54 BYTE(S) 14840000 DC C'AMA005I INVALID PARAMETER SPECIFIED ON EX' 14850000 DC C'EC STATEMENT' 14860000 AMA006I EQU @DATA+00000532 55 BYTE(S) ON WORD 14870000 ORG AMA006I+00000000 14880000 A00001 EQU * 21 BYTE(S) 14890000 DC C'AMA006I LOAD MODULE ' 14900000 CCCCCCCC EQU AMA006I+00000021 8 BYTE(S) 14910000 ORG AMA006I+00000029 14920000 A00002 EQU * 24 BYTE(S) 14930000 DC C' NOT UPDATED WITH PTF - ' 14940000 NN EQU AMA006I+00000053 2 BYTE(S) 14950000 AMA007I EQU @DATA+00000588 68 BYTE(S) ON WORD 14960000 ORG AMA007I+00000000 14970000 A00003 EQU * 21 BYTE(S) 14980000 DC C'AMA007I LOAD MODULE ' 14990000 LLLLLLLL EQU AMA007I+00000021 8 BYTE(S) 15000000 ORG AMA007I+00000029 15010000 A00004 EQU * 31 BYTE(S) 15020000 DC C' UPDATED WITH PTF - NEW SSI IS ' 15030000 SSI EQU AMA007I+00000060 8 BYTE(S) 15040000 AMA010I EQU @DATA+00000656 62 BYTE(S) ON WORD 15050000 ORG AMA010I+00000000 15060000 A00005 EQU * 29 BYTE(S) 15070000 DC C'AMA010I AMAPTFLE TERMINATED,' 15080000 A00006 EQU * 33 BYTE(S) 15090000 DC C' AN IDENTIFY STATEMENT IS MISSING' 15100000 AMA013I EQU @DATA+00000720 66 BYTE(S) ON WORD 15110000 ORG AMA013I+00000000 15120000 A00007 EQU * 26 BYTE(S) 15130000 DC C'AMA013I THE FOLLOWING IS ' 15140000 A00008 EQU * 32 BYTE(S) 15150000 DC C'IDENTIFY INFORMATION FOR MODULE ' 15160000 AMA013NM EQU * 8 BYTE(S) 15170000 DC C' ' 15180000 AMA016I EQU @DATA+00000788 61 BYTE(S) ON WORD 15190000 ORG AMA016I+00000000 15200000 A00009 EQU * 29 BYTE(S) 15210000 DC C'AMA016I AMAPTFLE TERMINATED,' 15220000 A00010 EQU * 32 BYTE(S) 15230000 DC C' PARMLIB DD STATEMENT IS MISSING' 15240000 DIFF EQU @DATA+00000852 FULLWORD INTEGER 15250000 QUOTIENT EQU @DATA+00000856 FULLWORD INTEGER 15260000 ADDFACTR EQU @DATA+00000860 FULLWORD INTEGER 15270000 CORRSSI EQU @DATA+00000864 FULLWORD POINTER 15280000 SSIDATA EQU 00000000 8 BYTE(S) 15290000 RETCDSAV EQU @DATA+00000868 FULLWORD INTEGER 15300000 DDNMELST EQU @DATA+00000872 66 BYTE(S) ON HWORD 15310000 ORG DDNMELST+00000000 15320000 A00011 EQU * HALFWORD POINTER 15330000 DC AL2(64) 15340000 A00012 EQU * 8 BYTE(S) 15350000 DC C'OUTF ' 15360000 A00013 EQU * 8 BYTE(S) 15370000 DC X'0000000000000000' 15380000 A00014 EQU * 8 BYTE(S) 15390000 DC C'SYSLMOD ' 15400000 A00015 EQU * 8 BYTE(S) 15410000 DC X'0000000000000000' 15420000 A00016 EQU * 8 BYTE(S) 15430000 DC X'0000000000000000' 15440000 A00017 EQU * 8 BYTE(S) 15450000 DC C'SYSPRINT' 15460000 A00018 EQU * 8 BYTE(S) 15470000 DC X'0000000000000000' 15480000 A00019 EQU * 8 BYTE(S) 15490000 DC C'SYSUT1 ' 15500000 PARMCONT EQU * 1 BIT(S) ON BYTE 15510000 DC B'00000000' 15520000 PCHBUFFR EQU 00000000 80 BYTE(S) 15530000 ORG @DATA+00000940 15540000 PRMNUMBR EQU * HALFWORD POINTER 15550000 DC XL2'0000' 15560000 PARMEQUL EQU * 5 BYTE(S) 15570000 DC C'PARM=' 15580000 B EQU @DATA+00000948 HALFWORD POINTER 15590000 ORG @DATA+00000950 15600000 DSSDNME EQU * 8 BYTE(S) 15610000 DC C'PARMLIB ' 15620000 DEVDATA EQU @DATA+00000960 8 BYTE(S) ON WORD 15630000 ORG @DATA+00000968 15640000 PATCH EQU * 50*2 BYTE(S) ON HWORD 15650000 DC 00050X'0000' 15660000 @SAV002 EQU @DATA+00001068 72 BYTE(S) ON WORD 15670000 ORG @DATA 15680000 DS 00001140C 15690000 @TEMPS DS 0F 15700000 @TEMP2 DC F'0' 15710000 @DATEND EQU * 15720000 @9F8 EQU AMANOID 15730000 @9EC EQU MOVEREP 15740000 @9EB EQU MOVEREP 15750000 @9E8 EQU AMA6IB 15760000 @9E4 EQU AMA6II 15770000 CHKSPACE EQU @DO9DF 15780000 CHKSP2 EQU @DO9DB 15790000 AMACONT EQU AMARET2 15800000 @9D0 EQU AMAPRM2 15810000 AMARET1 EQU @EL01 15820000 @EL02 EQU @EL01 15830000 @9FA EQU AMARET1 15840000 @9FC EQU AMARET1 15850000 @9F6 EQU AMARET1 15860000 @9E1 EQU CHKSPACE 15870000 @9F7 EQU @9F6 15880000 END AMAPTF01 15890000