TITLE 'IKJEFE15 - WHEN MESSAGE PROCESSOR MODULE' 00010000 * GEN( TITLE 'IKJEFE15 - WHEN MESSAGE PROCESSOR MODULE'); 00020000 TITLE 'IKJEFE15 - WHEN MESSAGE PROCESSOR MODULE' 00030000 * /******************************************************************** 00040000 * /* * 00050000 * /* WHEN COMMAND MESSAGE PROCESSOR MODULE (IKJEFE15) * 00060000 * /* * 00070000 * /******************************************************************** 00080000 * /* * 00090000 * /* STATUS: CHANGE LEVEL 000 * 00100000 * /* * 00110000 * /* FUNCTION: * 00120000 * /* ISSUE DIAGNOSTICS TO THE USER VIA THE PUTLINE SERVICE ROUTINE. * 00130000 * /* AN INDEX TO THE CORRECT FIRST LEVEL MESSAGE IS PASSED TO THIS * 00140000 * /* ROUTINE FROM IKJEFE11 IN THE 'WHMSG' FIELD OF THE PROCESSOR * 00150000 * /* WORK AREA. THE SECOND LEVEL MESSAGE OFFSET IS PASSED IN THE * 00160000 * /* 'WHMSG2' FIELD OF THE PROCESSOR WORK AREA. THE COMMAND NAME, * 00170000 * /* WHICH IS PASSED IN 'WHCMD' FIELD OF THE PROCESSOR WORK AREA, * 00180000 * /* IS INSERTED IN THE BEGINNING OF EVERY FIRST LEVEL MESSAGE. * 00190000 * /* THE RETURN CODE WHICH IS PASSED IN THE 'WHRCODE' FIELD OF THE * 00200000 * /* PROCESSOR WORK AREA IS INSERTED IN THE END OF EVERY SECOND * 00210000 * /* LEVEL MESSAGE. * 00220000 * /* * 00230000 * /* ENTRY POINTS: * 00240000 * /* IKJEFE15 * 00250000 * /* * 00260000 * /* INPUT: * 00270000 * /* R1 POINTS TO THE PROCESSOR WORKAREA (MAPPED BY IKJWHEN) * 00280000 * /* R13 POINTS TO A REGISTER SAVE AREA * 00290000 * /* R14 CONTAINS THE RETURN ADDRESS * 00300000 * /* * 00310000 * /* OUTPUT: * 00320000 * /* NONE * 00330000 * /* * 00340000 * /* EXTERNAL REFERENCES: * 00350000 * /* GETMAIN * 00360000 * /* FREEMAIN * 00370000 * /* PUTLINE * 00380000 * /* * 00390000 * /* EXITS - NORMAL: * 00400000 * /* RETURN * 00410000 * /* * 00420000 * /* EXITS - ERROR: * 00430000 * /* RETURN * 00440000 * /* * 00450000 * /* TABLES/WORKAREAS: * 00460000 * /* IKJWHEN INTERNAL WORK AREA * 00470000 * /* IKJIOPL PUTLINE PARAMETER LIST * 00480000 * /* IKJPTPB PUTLINE PARAMETER BLOCK * 00490000 * /* * 00500000 * /* ATTRIBUTES: * 00510000 * /* REENTRANT * 00520000 * /* REFRESHABLE * 00530000 * /* * 00540000 * /* NOTES: * 00550000 * /* '+' FOLLOWING MESSAGE INDICATES A SECOND LEVEL MESSAGE IS * 00560000 * /* AVAILABLE FOR THIS FIRST LEVEL MESSAGE. * 00570000 * /* REG 9 IS RESERVED FOR ADDRESSIBILITY TO THE MESSAGE CSECT. * 00580000 * /* CHARACTER CODE DEPENDENCY - EBCDIC CHARACTER SET USED IN * 00590000 * /* ASSEMBLING, MODULE MUST BE MODIFIED IF A DIFFERENT CHARACTER * 00600000 * /* SET IS TO BE USED DURING EXECUTION. * 00610000 * /* * 00620000 * /******************************************************************** 00630000 * 00640000 * /******************************************************************** 00650000 **/*IKJEFE15: CHART DETAIL OF WHEN MESSAGE MODULE*/ 00660000 **/* HEADER 00670000 **/* DETAIL FLOW OF WHEN/END MESSAGE MODULE - 7/6/70*/ 00680000 **/*IKJEFE15: E ENTRY FROM IKJEFE11*/ 00690000 * /******************************************************************** 00700000 * 00710000 * IKJEFE15: PROC(WHENPARM) OPTIONS(REENTRANT); 00720000 LCLA &T,&SPN 0002 00730000 .@001 ANOP 0002 00740000 IKJEFE15 CSECT , 0002 00750000 STM @E,@C,12(@D) 0002 00760000 BALR @B,0 0002 00770000 @PSTART DS 0H 0002 00780000 USING @PSTART+00000,@B 0002 00790000 L @0,@SIZ001 0002 00800000 GETMAIN R,LV=(0) 0002 00810000 LR @C,@1 0002 00820000 USING @DATD+00000,@C 0002 00830000 LM @0,@1,20(@D) 0002 00840000 XC @TEMPS(@L),@TEMPS 0002 00850000 ST @D,@SAV001+4 0002 00860000 LA @F,@SAV001 0002 00870000 ST @F,8(0,@D) 0002 00880000 LR @D,@F 0002 00890000 * GENERATE; 00900000 &SPN SETA 1 00910000 B PASSLAB BYPASS DUMP LABEL 00920000 DC C'IKJEFE15 004071' 00930000 PASSLAB EQU * 00940000 DS 0H 00950000 * RESTRICT (9); /* REG 9 POINTS TO MESSAGE CSECT* 00960000 * 00970000 * /************************************************************ 00980000 * /* REGISTER DECLARATIONS * 00990000 * /************************************************************ 01000000 * DCL R0 REG(0) PTR(31); 01010000 * DCL R1 REG(1) PTR(31); 01020000 * DCL R2 REG(2) PTR(31); 01030000 * DCL R3 REG(3) PTR(31); 01040000 * DCL R4 REG(4) PTR(31); 01050000 * DCL R5 REG(5) PTR(31); 01060000 * DCL R6 REG(6) PTR(31); 01070000 * DCL R7 REG(7) PTR(31); 01080000 * DCL R8 REG(8) PTR(31); 01090000 * DCL R9 REG(9) PTR(31); 01100000 * DCL R10 REG(10) PTR(31); 01110000 * DCL R11 REG(11) PTR(31); 01120000 * DCL R12 REG(12) PTR(31); 01130000 * DCL R13 REG(13) PTR(31); 01140000 * DCL R14 REG(14) PTR(31); 01150000 * DCL R15 REG(15) PTR(31); 01160000 * DCL PTPBPTR PTR(31); /* PUTLINE PARAMETER BLOCK * 01170000 * DCL IOPLPTR PTR(31); /* SERV RTN GENERAL PARM LIST * 01180000 * DCL WHENPARM FIXED(15); /* DUMMY TO ACCESS WORK AREA * 01190000 * DCL WAPTR PTR(31); /* PTR TO WHEN WORK AREA * 01200000 * DCL 1 WORK CHAR(16) BDY(DWORD), 01210000 * 2 WORK1 PTR(31), /* SCRATCH PAD AREA * 01220000 * 2 WORK2 PTR(31), 01230000 * 2 WORK3 PTR(31), 01240000 * 2 WORK4 PTR(31); /* CONTAINS RC FOR MESSAGE * 01250000 * DCL ALPHA CHAR(16) INIT('0123456789ABCDEF'); 01260000 * DCL PARMEND PTR(32) INIT('FF000000'X); 01270000 * /* INDIC END OF PARM * 01280000 * 01290000 * /******************************************************************** 01300000 * /* THE FOLLOWING EQUATES ARE USED FOR CONVERTING THE SERVICE ROUTINE* 01310000 * /* RETURN CODE TO PRINTABLE FORMAT FOR THE SECOND LEVEL MESSAGE * 01320000 * /******************************************************************** 01330000 * GENERATE; 01340000 RET3 EQU 3 MAXIMUM LENGTH OF RETURN CODE 01350000 RET4 EQU 4 LENGTH OF UNPACKED RET COD VALUE 01360000 OFF3 EQU 3 OFFSET TO SIGN VALUE OF RET CODE 01370000 DS 0H 01380000 * /******************************************************************** 01390000 * /* THE WHEN WORK AREA IS USED ONLY BY THE WHEN COMMAND. IT CONTAINS * 01400000 * /* A REGISTER SAVE AREA AND OTHER MISCELLANEOUS INFORMATION USED BY * 01410000 * /* A WHEN PROCESSORS AND MESSAGE MODULE * 01420000 * /******************************************************************** 01430000 * DCL 1 IKJWHEN BASED(WAPTR), 01440000 * 2 WHPL CHAR(28), /* GENERAL PARM LIST * 01450000 * 2 WHPBLOCK CHAR(20), /* GENERAL PARM BLOCK * 01460000 * 2 WHPARANS PTR(31), /* PTR TO PARSE DESCRIP LIST * 01470000 * 2 WHATTECB CHAR(4), /* SERV RTN ATTN RTN ECB * 01480000 * 2 WHMSG PTR(16), /* MESSAGE OFFSETS * 01490000 * 3 WHMSG1 PTR(8), /* OFFSET FOR MESSAGE MODULE * 01500000 * 3 WHMSG2 PTR(8), /* SECONDARY MESSAGE INDEX * 01510000 * 2 WHSWI BIT(8), /* STATUS BYTE * 01520000 * 3 WHEND BIT(1), /* END COMMAND IN CONTROL * 01530000 * 3 WHRET BIT(1), /* SET TMP RET CODE TO ERROR * 01540000 * 2 WHCHAR CHAR(1), /* FIRST CHARACTER OF NEXT * 01550000 * /* COMMAND IN CASE DELIMETER * 01560000 * /* WAS OMMITTED * 01570000 * 2 WHENWAS PTR(31), /* NOT USED * 01580000 * 2 WHRCODE PTR(31), /* SERV RTN RETURN CODE * 01590000 * 2 WHCOMM PTR(31), /* POINTER TO COMMAND TO BE * 01600000 * /* ADDED TO INPUT STACK * 01610000 * 2 WHCMD CHAR(8), /*NAME OF COMMAND FOR * 01620000 * /* MESSAGE MODULE * 01630000 * 2 WHGETM PTR(31), /* GETMAIN SIZE AND SUBPOOL * 01640000 * 3 WHSUBP PTR(8), /* SUBPOOL * 01650000 * 3 WHFILL PTR(8), /* FILLER * 01660000 * 3 WHLEN PTR(15), /* LENGTH * 01670000 * 2 WHWASIZ PTR(31); /* WORK AREA SP AND SIZE * 01680000 ** DECLARE 01690000 ** 1 PTPB BASED(PTPBPTR), 01700000 ** /* *************************************************************** * 01710000 ** /* THE PUTLINE PARAMETER BLOCK (PTPB) IS POINTED TO BY THE PARAM. * 01720000 ** /* LIST PASSED TO PUTLINE. IT IS USED TO RETURN PERTINENT INFO. * 01730000 ** /* AS WELL AS CONTROL PUTLINE FUNCTIONS * 01740000 ** /* *************************************************************** * 01750000 ** 01760000 ** 01770000 ** 01780000 ** 01790000 ** 01800000 ** 01810000 ** 01820000 ** 01830000 ** 01840000 ** 01850000 ** 01860000 ** 2 * CHAR(4) BDY(WORD), 01870000 ** /* INTERNAL PUTLINE USAGE * 01880000 ** 2 PTPBOPUT PTR(31), /* ADDRESS OF OUTPUT LINE 01890000 * DESCRIPTOR OR DATA LINE * 01900000 ** 2 PTPBFLN PTR(31); /* PTR TO FORMATTED LINE 01910000 ** RETURNED WHEN OUTPUT= 01920000 ** ADDR,FORMAT) IS SPECIFIED * 01930000 ** 01940000 ** DECLARE 01950000 ** 1 IOPL BASED(IOPLPTR), 01960000 ** /* *************************************************************** * 01970000 ** /* THE I/O SERVICE ROUTINE PARAMETER LIST (IOPL) IS A LIST OF * 01980000 ** /* FULLWORD ADDRESSES PASSED BY THE INVOKER OF ANY I/O SERVICE * 01990000 ** /* ROUTINE TO THE APPROPRIATE SERVICE ROUTINE VIA REGISTER ONE. * 02000000 ** /* *************************************************************** * 02010000 ** 02020000 ** 02030000 ** 02040000 ** 02050000 ** 02060000 ** 02070000 ** 02080000 ** 02090000 ** 02100000 ** 02110000 ** 2 IOPLUPT PTR(31), /* PTR TO UPT * 02120000 ** 2 IOPLECT PTR(31), /* PTR TO ECT * 02130000 ** 2 IOPLECB PTR(31), /* PTR TO USER'S ECB * 02140000 ** 2 IOPLIOPB PTR(31); /* PTR TO THE I/O SERVICE RTN PARM BLOCK * 02150000 ** 02160000 * DCL IKJEFE16 ENTRY; /* ENTRY TO MESSAGES * 02170000 * DCL MSGPTR PTR(31); /* POINTER TO MSG * 02180000 * DCL 1 MSGP BASED(WORK1), /* POINTER TO MSG POINTER * 02190000 * 2 * PTR(31); 02200000 * DCL 1 MSG BASED(MSGPTR) /* FORMAT OF MESSAGE * 02210000 * BDY(WORD), 02220000 * 2 LENDUMMY CHAR(4) /* DUMMY HEADER FOR BSL * 02230000 * BDY(HWORD), 02240000 * 3 MSGLEN PTR(16), /* MESSAGE LENGTH FIELD * 02250000 * 3 * PTR(16), 02260000 * 2 MSGTEXT CHAR(80); /* MESSAGE TEXT * 02270000 * DCL 1 MSG1DES BASED(WORK1), /* PUTLINE DESCRIP LIST * 02280000 * 2 SEGCHAIN PTR(31), /* POINTER TO NEXT ELEMENT * 02290000 * 2 SEGNUM PTR(31), /* NUMBER OF FIRST MSG SEGMNT * 02300000 * 2 SEGPTR PTR(31), /*POINTER TO FIRST MSG SEGMENT* 02310000 * 2 MSGHDR CHAR(4); /* MESSAGE HEADER (LL FIELD) * 02320000 * DCL 1 MSGBUF CHAR(102) BASED(SEGPTR) 02330000 * BDY(HWORD), /* MESSAGE FORMAT * 02340000 * 2 MSGBUFL PTR(16), /* MESSAGE LENGTH FIELD * 02350000 * 2 * CHAR(11), /* FILLER TO GET AT CMD NAME * 02360000 * 2 MSGCMD CHAR(1), /* BLANK IN MESSAGE * 02370000 * 2 MSGCMD2 CHAR(8), /* COMMAND NAME IN MSG * 02380000 * 2 MSGBTXT CHAR(80); /* MESSAGE TEXT * 02390000 * DCL 1 MSG1DES2 BASED(R2), /* DUMMY DESCRIPTOR LIST * 02400000 * /* TO UPDATE INFO FOR 2ND * 02410000 * /* LEVEL MESSAGE * 02420000 * 2 MSG1NEXT PTR(31), /* DUMMY FOR INSERTING PTR * 02430000 * /* TO NEXT MESSAGE * 02440000 * 2 * CHAR(12), /* FILLER * 02450000 * 2 MSG1ID CHAR(9); /* MESSAGE IDENTIFIER * 02460000 * DCL 1 SAVBUFL CHAR(8) BDY(WORD), 02470000 * 2 SAVGETL PTR(31), /* AREA FOR BUFFER AND DES * 02480000 * 3 SAVSP PTR(8), /* FOR FREEMAIN IN CASE OF I/O* 02490000 * 3 * CHAR(1), /* FILLER * 02500000 * 3 SAVLEN PTR(16), /* ERROR ON PUTLINE * 02510000 * 2 SAVAREA PTR(31); /*LOCATION OF BUFFER AND DESCR* 02520000 * DCL RCPTR PTR(31); /* POINTER TO SERVICE ROUTINE * 02530000 * /* RETURN CODE IN SECOND LEVEL* 02540000 * /* MESSAGE * 02550000 * DCL 1 RC BASED(RCPTR) CHAR(4); /*DUMMY TO INSERT RC IN MSG* 02560000 * 02570000 * /******************************************************************** 02580000 **/* P SAVE POINTER TO WORK AREA CONTAINING MESSAGE OFFSET*/ 02590000 **/* P SET UP POINTER TO MESSAGE CSECT*/ 02600000 * /******************************************************************** 02610000 * R9=ADDR(IKJEFE16); /* POINTER TO MESSAGE CSECT * 02620000 L @8,@V1 ADDRESS OF IKJEFE16 0042 02630000 LR @9,@8 0042 02640000 * WAPTR=R1; /* SET UP ADDRESSABILITY TO WA* 02650000 ST @1,WAPTR 0043 02660000 * 02670000 * /******************************************************************** 02680000 **/* P SET UP ADDRESS TO PUTLINE PARAMETER BLOCK*/ 02690000 * /******************************************************************** 02700000 * PTPBPTR=ADDR(WHPBLOCK); /* SET UP ADDR TO PARM BLOCK * 02710000 L @6,WAPTR 0044 02720000 LA @F,28(0,@6) 0044 02730000 ST @F,PTPBPTR 0044 02740000 * IOPLPTR=ADDR(WHPL); /* POINTER TO GENERAL PARM * 02750000 ST @6,IOPLPTR 0045 02760000 * /* LIST USED BY PUTLINE * 02770000 * 02780000 * /******************************************************************** 02790000 **/* P FIND CORRECT MESSAGE AND SAVE MESSAGE LENGTH FOR BUFFER*/ 02800000 * /******************************************************************** 02810000 * WORK1=R9+WHMSG1; /* ADDRESS OF MESSAGE LIST * 02820000 SR @F,@F 0046 02830000 IC @F,56(0,@6) 0046 02840000 AR @F,@9 0046 02850000 ST @F,WORK 0046 02860000 * MSGPTR=MSGP; /* POINTER TO ACTURAL MESSAGE * 02870000 LR @7,@F 0047 02880000 MVC MSGPTR(4),0(@7) 0047 02890000 * 02900000 * /******************************************************************** 02910000 **/* P ADD SOURCE DESCRIPTOR LENGTH TO BUFFER LENGTH*/ 02920000 * /******************************************************************** 02930000 * SAVGETL=SAVGETL && SAVGETL; /* ZERO OUT AREA FOR SAVING * 02940000 XC SAVBUFL(4),SAVBUFL 0048 02950000 * /* MESSAGE SIZE AND PTR TO MSG* 02960000 * SAVLEN=MSGLEN+12; /*MESSAGE LENGTH + DESCRIPTOR * 02970000 LA @F,12 0049 02980000 L @4,MSGPTR 0049 02990000 MVC @TEMP2+2(2),0(@4) 0049 03000000 A @F,@TEMP2 0049 03010000 STH @F,SAVBUFL+2 0049 03020000 * SAVSP=1; /* SUBPOOL 1 FOR PUTLINE * 03030000 MVI SAVBUFL,1 0050 03040000 * R0=SAVGETL; /* INIT R0 FOR GETMAIN * 03050000 L @0,SAVBUFL 0051 03060000 * 03070000 * /******************************************************************** 03080000 **/* P GET BUFFER AND DESCRIPTOR*/ 03090000 * /******************************************************************** 03100000 * GENERATE (GETMAIN R,LV=(0)); 03110000 GETMAIN R,LV=(0) 03120000 DS 0H 03130000 * WORK1=R1; /* SAVE PTR FOR BASED BUFFER * 03140000 ST @1,WORK 0053 03150000 * SAVAREA=R1; /* SAVE AREA PTR IN CASE * 03160000 ST @1,SAVBUFL+4 0054 03170000 * /* THERE IS A PUTLINE ERROR * 03180000 * RESTRICT (2,3,4); 03190000 * R2=R1; /* SAVE BUFFER POINTER * 03200000 LR @2,@1 0056 03210000 * 03220000 * /******************************************************************** 03230000 **/* P INIT DESCRIPTOR TO POINT TO MESSAGE AND MOVE MESSAGE TO BUFFER*/ 03240000 * /******************************************************************** 03250000 * SEGCHAIN=PARMEND; /* INSERT END OF LIST INDIC * 03260000 L @5,WORK 0057 03270000 MVC 0(4,@5),PARMEND 0057 03280000 * SEGNUM=1; /* INDICATE FIRST SEGMENT NUM * 03290000 LA @F,1 0058 03300000 ST @F,4(0,@5) 0058 03310000 * SEGPTR=ADDR(MSGHDR); /* POINT TO MESSAGE * 03320000 LA @F,12(0,@5) 0059 03330000 ST @F,8(0,@5) 0059 03340000 * MSGBUF(1:MSGLEN)=MSGPTR->MSG; /* PUT MSG IN SP 1 * 03350000 L @7,MSGPTR 0060 03360000 LR @E,@7 0060 03370000 MVC @TEMP2+2(2),0(@7) 0060 03380000 L @8,@TEMP2 0060 03390000 BCTR @8,0 0060 03400000 L @6,WORK 0060 03410000 L @6,8(0,@6) MSG1DES 0060 03420000 LR @A,@6 0060 03430000 EX @8,@MVC 0060 03440000 * MSGCMD2=WHCMD; /* INSERT COMMAND NAME IN MSG * 03450000 L @8,WAPTR 0061 03460000 MVC 14(8,@6),72(@8) 0061 03470000 * R3=PTPBPTR; /* PARM BLOCK PTR * 03480000 L @3,PTPBPTR 0062 03490000 * PTPB=PTPB && PTPB; /* CLEAR PARAMETER BLOCK * 03500000 L @5,PTPBPTR 0063 03510000 XC 0(12,@5),0(@5) 0063 03520000 * 03530000 * /******************************************************************** 03540000 **/* D (YES,,NO,PUTMSG) IS THERE A SECOND LEVEL MESSAGE ? */ 03550000 * /******************************************************************** 03560000 * IF WHMSG2=0 /* TEST FOR SECOND LEVEL MSG * 03570000 * THEN 03580000 CLI 57(@8),0 0064 03590000 * GOTO PUTMSG; /* BRANCH IF NO SECOND LEVEL * 03600000 BC 08,PUTMSG 0065 03610000 * IF WHMSG1 =16 /* DID PREV CP ABEND * 03620000 * THEN 03630000 CLI 56(@8),16 0066 03640000 BC 07,@9FF 0066 03650000 * DO; 03660000 * WORK1 = WHRCODE; /*SET WORK4 AREA TO ABEND CODE* 03670000 MVC WORK(4),64(@8) 0068 03680000 * GENERATE; 03690000 UNPK WORK3(5),WORK1(5) INSERT ZONES FOR OU 03700000 TR WORK3(4),ALPHA-240 03710000 DS 0H 03720000 * GO TO SEND; /* NO NEED TO CVT TO DEC * 03730000 BC 15,SEND 0070 03740000 * END; 03750000 * 03760000 * /******************************************************************** 03770000 **/* P CONVERT ABEND OR RETURN CODE TO PRINTABLE CHARACTERS*/ 03780000 * /******************************************************************** 03790000 * R4=WHRCODE; /* GET SERV RTN RETURN CODE * 03800000 @9FF L @5,WAPTR 0072 03810000 L @4,64(0,@5) 0072 03820000 * WORK=WORK && WORK; /* CLEAR CONVERT WORK AREA * 03830000 XC WORK(16),WORK 0073 03840000 * GENERATE; 03850000 CVD R4,WORK1 CONVERT RETURN CODE TO DECIMAL 03860000 UNPK WORK3(RET4),WORK2+1(RET3) INSERT ZONES FOR OUTPUT 03870000 OI WORK3+OFF3,C'0' INSERT NUMERIC ZONE FOR SIGN 03880000 DS 0H 03890000 * 03900000 * /******************************************************************** 03910000 **/*%A: P FIND CORRECT SECOND LEVEL MESSAGE AND MESSAGE LENGTH*/ 03920000 * /******************************************************************** 03930000 * SEND: ; 03940000 * WORK1=R9+WHMSG2; /* PTR TO MSG ADDRESS TABLE * 03950000 SEND L @5,WAPTR 0076 03960000 SR @F,@F 0076 03970000 IC @F,57(0,@5) 0076 03980000 AR @F,@9 0076 03990000 ST @F,WORK 0076 04000000 * MSGPTR=MSGP; /* POINT TO ACTUAL MESSAGE * 04010000 LR @8,@F 0077 04020000 MVC MSGPTR(4),0(@8) 0077 04030000 * 04040000 * /******************************************************************** 04050000 **/* P GET A SECOND BUFFER AND DESCRIPTOR FOR SECOND LEVEL MESSAGE*/ 04060000 * /******************************************************************** 04070000 * WHLEN=MSGLEN+12+9+4; /* MESSAGE LENGTH INCLUDES: * 04080000 LA @F,4 0078 04090000 AH @F,@D1 0078 04100000 AH @F,@D2 0078 04110000 L @6,MSGPTR 0078 04120000 MVC @TEMP2+2(2),0(@6) 0078 04130000 A @F,@TEMP2 0078 04140000 STH @F,82(0,@5) 0078 04150000 * /* TEXT-RETURN CODE-MSG ID * 04160000 * /* AND MESSAGE DESCRIPTOR * 04170000 * WHSUBP=1; /* USE SUBPOOL 1 FOR PUTLINE * 04180000 MVI 80(@5),1 0079 04190000 * R0=WHGETM; /*INIT FOR GETMAIN * 04200000 L @0,80(0,@5) 0080 04210000 * GENERATE (GETMAIN R,LV=(0)); 04220000 GETMAIN R,LV=(0) 04230000 DS 0H 04240000 * 04250000 * /******************************************************************** 04260000 **/* P SET UP DESCRIPTOR AND MOVE SECOND LEVEL MESSAGE TO BUFFER*/ 04270000 * /******************************************************************** 04280000 * MSG1NEXT=R1; /* SAVE POINTER TO SECOND LIST* 04290000 ST @1,0(0,@2) 0082 04300000 * WORK1=R1; /* SAVE PTR TO MESSAGE BUFFER * 04310000 ST @1,WORK 0083 04320000 * SEGCHAIN=PARMEND; /* INDICATE END OF LIST * 04330000 L @7,WORK 0084 04340000 MVC 0(4,@7),PARMEND 0084 04350000 * SEGNUM=1; /* INDICATE FIRST SEGMENT * 04360000 LA @F,1 0085 04370000 ST @F,4(0,@7) 0085 04380000 * SEGPTR=ADDR(MSGHDR); /* POINTER TO MESSAGE * 04390000 LA @F,12(0,@7) 0086 04400000 ST @F,8(0,@7) 0086 04410000 * MSGBUF(1:4)=MSGPTR->LENDUMMY(1:4); /* INSERT MSG LENGTH * 04420000 L @8,WORK 0087 04430000 L @8,8(0,@8) MSG1DES 0087 04440000 MVC 0(4,@8),0(@6) 0087 04450000 * MSGBUFL=MSGBUFL+9+4; /* INCLUDE MESSAGE ID * 04460000 LA @F,4 0088 04470000 AH @F,@D1 0088 04480000 MVC @TEMP2+2(2),0(@8) 0088 04490000 A @F,@TEMP2 0088 04500000 STH @F,0(0,@8) 0088 04510000 * MSGBUF(5:13)=R2->MSG1ID(1:9); /* INSERT MESSAGE ID OF FIRST * 04520000 MVC 4(9,@8),16(@2) 0089 04530000 * /* LEVEL MESSAGE * 04540000 * MSGCMD(1:MSGLEN-4)=MSGPTR->MSGTEXT; /* PUT MSG INTO SP 1 * 04550000 LA @E,4(0,@6) 0090 04560000 LH @5,@D3 0090 04570000 MVC @TEMP2+2(2),0(@6) 0090 04580000 A @5,@TEMP2 0090 04590000 BCTR @5,0 0090 04600000 LA @A,13(0,@8) 0090 04610000 EX @5,@MVC 0090 04620000 * RCPTR=SEGPTR+MSGLEN+9; /* POINT TO RETURN CODE FIELD * 04630000 LA @F,9 0091 04640000 MVC @TEMP2+2(2),0(@6) 0091 04650000 A @F,@TEMP2 0091 04660000 A @F,8(0,@7) 0091 04670000 ST @F,RCPTR 0091 04680000 * RC=WORK3; /* INSERT RET CODE IN MESSAGE * 04690000 LR @5,@F 0092 04700000 MVC 0(4,@5),WORK+8 0092 04710000 * 04720000 * /******************************************************************** 04730000 **/*PUTMSG: L ISSUE MESSAGE TO USER*/ 04740000 * /******************************************************************** 04750000 * PUTMSG: ; 04760000 * R1=IOPLPTR; /* PARM LIST PTR * 04770000 PUTMSG L @1,IOPLPTR 0094 04780000 * GENERATE (PUTLINE PARM=(3),OUTPUT=((2),MULTLVL),MF=(E,(1))); 04790000 PUTLINE PARM=(3),OUTPUT=((2),MULTLVL),MF=(E,(1)) 04800000 DS 0H 04810000 * IF R15=0 /* CHECK FOR BAD PUTLINE * 04820000 * THEN 04830000 LTR @F,@F 0096 04840000 * GOTO DONE; /* IF GOOD RETURN * 04850000 BC 08,DONE 0097 04860000 * WHRET='1'B; /* IKJEFE11 WILL FLUSH STACK * 04870000 L @5,WAPTR 0098 04880000 OI 58(@5),B'01000000' 0098 04890000 * R0=WHGETM; /* FREE MESSAGE BUFFERS * 04900000 L @0,80(0,@5) 0099 04910000 * R1=WORK1; 04920000 L @1,WORK 0100 04930000 * GENERATE (FREEMAIN R,LV=(0),A=(1)); 04940000 FREEMAIN R,LV=(0),A=(1) 04950000 DS 0H 04960000 * R0=SAVGETL; 04970000 L @0,SAVBUFL 0102 04980000 * R1=SAVAREA; 04990000 L @1,SAVBUFL+4 0103 05000000 * GENERATE (FREEMAIN R,LV=(0),A=(1)); 05010000 FREEMAIN R,LV=(0),A=(1) 05020000 DS 0H 05030000 * 05040000 * /******************************************************************** 05050000 **/* R RETURN TO IKJEFE11*/ 05060000 **/*IKJEFE15: END*/ 05070000 * /******************************************************************** 05080000 * DONE: ; 05090000 * RETURN; 05100000 BC 15,@EL01 0106 05110000 * END IKJEFE15 05120000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 05130000 * /*%INCLUDE SYSLIB (IKJWHEN ) 05140000 * /*%INCLUDE SYSLIB (IKJPTPB ) 05150000 * /*%INCLUDE SYSLIB (IKJIOPL ) 05160000 * ; 05170000 @EL01 L @D,4(0,@D) 0107 05180000 LR @1,@C 0107 05190000 L @0,@SIZ001 0107 05200000 FREEMAIN R,LV=(0),A=(1) 0107 05210000 LM @E,@C,12(@D) 0107 05220000 BCR 15,@E 0107 05230000 @DATA1 EQU * 05240000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 05250000 @1 EQU 01 05260000 @2 EQU 02 05270000 @3 EQU 03 05280000 @4 EQU 04 05290000 @5 EQU 05 05300000 @6 EQU 06 05310000 @7 EQU 07 05320000 @8 EQU 08 05330000 @9 EQU 09 05340000 @A EQU 10 05350000 @B EQU 11 05360000 @C EQU 12 05370000 @D EQU 13 05380000 @E EQU 14 05390000 @F EQU 15 05400000 @D1 DC H'9' 05410000 @D2 DC H'12' 05420000 @D3 DC H'-4' 05430000 @MVC MVC 0(1,@A),0(@E) 05440000 @V1 DC V(IKJEFE16) 05450000 DS 0F 05460000 @SIZ001 DC AL1(&SPN) 05470000 DC AL3(@DATEND-@DATD) 05480000 DS 0F 05490000 DS 0D 05500000 @DATA EQU * 05510000 R0 EQU 00000000 FULLWORD POINTER REGISTER 05520000 R1 EQU 00000001 FULLWORD POINTER REGISTER 05530000 R2 EQU 00000002 FULLWORD POINTER REGISTER 05540000 R3 EQU 00000003 FULLWORD POINTER REGISTER 05550000 R4 EQU 00000004 FULLWORD POINTER REGISTER 05560000 R5 EQU 00000005 FULLWORD POINTER REGISTER 05570000 R6 EQU 00000006 FULLWORD POINTER REGISTER 05580000 R7 EQU 00000007 FULLWORD POINTER REGISTER 05590000 R8 EQU 00000008 FULLWORD POINTER REGISTER 05600000 R9 EQU 00000009 FULLWORD POINTER REGISTER 05610000 R10 EQU 00000010 FULLWORD POINTER REGISTER 05620000 R11 EQU 00000011 FULLWORD POINTER REGISTER 05630000 R12 EQU 00000012 FULLWORD POINTER REGISTER 05640000 R13 EQU 00000013 FULLWORD POINTER REGISTER 05650000 R14 EQU 00000014 FULLWORD POINTER REGISTER 05660000 R15 EQU 00000015 FULLWORD POINTER REGISTER 05670000 WHENPARM EQU 00000000 HALFWORD INTEGER 05680000 ALPHA EQU * 16 BYTE(S) 05690000 DC C'0123456789ABCDEF' 05700000 PARMEND EQU * FULLWORD POINTER 05710000 DC XL4'FF000000' 05720000 IKJWHEN EQU 00000000 88 BYTE(S) ON WORD 05730000 WHPL EQU IKJWHEN+00000000 28 BYTE(S) 05740000 WHPBLOCK EQU IKJWHEN+00000028 20 BYTE(S) 05750000 WHPARANS EQU IKJWHEN+00000048 FULLWORD POINTER 05760000 WHATTECB EQU IKJWHEN+00000052 4 BYTE(S) 05770000 WHMSG EQU IKJWHEN+00000056 HALFWORD POINTER 05780000 WHMSG1 EQU IKJWHEN+00000056 1 BYTE POINTER 05790000 WHMSG2 EQU IKJWHEN+00000057 1 BYTE POINTER 05800000 WHSWI EQU IKJWHEN+00000058 8 BIT(S) 05810000 WHEND EQU IKJWHEN+00000058 1 BIT(S) 05820000 WHRET EQU IKJWHEN+00000058 1 BIT(S) 05830000 WHCHAR EQU IKJWHEN+00000059 1 BYTE(S) 05840000 WHENWAS EQU IKJWHEN+00000060 FULLWORD POINTER 05850000 WHRCODE EQU IKJWHEN+00000064 FULLWORD POINTER 05860000 WHCOMM EQU IKJWHEN+00000068 FULLWORD POINTER 05870000 WHCMD EQU IKJWHEN+00000072 8 BYTE(S) 05880000 WHGETM EQU IKJWHEN+00000080 FULLWORD POINTER 05890000 WHSUBP EQU IKJWHEN+00000080 1 BYTE POINTER 05900000 WHFILL EQU IKJWHEN+00000081 1 BYTE POINTER 05910000 WHLEN EQU IKJWHEN+00000082 HALFWORD POINTER 05920000 WHWASIZ EQU IKJWHEN+00000084 FULLWORD POINTER 05930000 PTPB EQU 00000000 12 BYTE(S) ON WORD 05940000 A00000 EQU PTPB+00000000 4 BYTE(S) ON WORD 05950000 PTPBOPUT EQU PTPB+00000004 FULLWORD POINTER 05960000 PTPBFLN EQU PTPB+00000008 FULLWORD POINTER 05970000 IOPL EQU 00000000 16 BYTE(S) ON WORD 05980000 IOPLUPT EQU IOPL+00000000 FULLWORD POINTER 05990000 IOPLECT EQU IOPL+00000004 FULLWORD POINTER 06000000 IOPLECB EQU IOPL+00000008 FULLWORD POINTER 06010000 IOPLIOPB EQU IOPL+00000012 FULLWORD POINTER 06020000 MSGP EQU 00000000 4 BYTE(S) ON WORD 06030000 A00001 EQU MSGP+00000000 FULLWORD POINTER 06040000 MSG EQU 00000000 84 BYTE(S) ON WORD 06050000 LENDUMMY EQU MSG+00000000 4 BYTE(S) ON HWORD 06060000 MSGLEN EQU MSG+00000000 HALFWORD POINTER 06070000 A00002 EQU MSG+00000002 HALFWORD POINTER 06080000 MSGTEXT EQU MSG+00000004 80 BYTE(S) 06090000 MSG1DES EQU 00000000 16 BYTE(S) ON WORD 06100000 SEGCHAIN EQU MSG1DES+00000000 FULLWORD POINTER 06110000 SEGNUM EQU MSG1DES+00000004 FULLWORD POINTER 06120000 SEGPTR EQU MSG1DES+00000008 FULLWORD POINTER 06130000 MSGHDR EQU MSG1DES+00000012 4 BYTE(S) 06140000 MSGBUF EQU 00000000 102 BYTE(S) ON HWORD 06150000 MSGBUFL EQU MSGBUF+00000000 HALFWORD POINTER 06160000 A00003 EQU MSGBUF+00000002 11 BYTE(S) 06170000 MSGCMD EQU MSGBUF+00000013 1 BYTE(S) 06180000 MSGCMD2 EQU MSGBUF+00000014 8 BYTE(S) 06190000 MSGBTXT EQU MSGBUF+00000022 80 BYTE(S) 06200000 MSG1DES2 EQU 00000000 25 BYTE(S) ON WORD 06210000 MSG1NEXT EQU MSG1DES2+00000000 FULLWORD POINTER 06220000 A00004 EQU MSG1DES2+00000004 12 BYTE(S) 06230000 MSG1ID EQU MSG1DES2+00000016 9 BYTE(S) 06240000 RC EQU 00000000 4 BYTE(S) 06250000 ORG @DATA 06260000 DS 00000020C 06270000 @L EQU 2 06280000 @DATD DSECT 06290000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 06300000 PTPBPTR EQU @DATD+00000072 FULLWORD POINTER 06310000 IOPLPTR EQU @DATD+00000076 FULLWORD POINTER 06320000 WAPTR EQU @DATD+00000080 FULLWORD POINTER 06330000 WORK EQU @DATD+00000088 16 BYTE(S) ON DWORD 06340000 WORK1 EQU WORK+00000000 FULLWORD POINTER 06350000 WORK2 EQU WORK+00000004 FULLWORD POINTER 06360000 WORK3 EQU WORK+00000008 FULLWORD POINTER 06370000 WORK4 EQU WORK+00000012 FULLWORD POINTER 06380000 MSGPTR EQU @DATD+00000104 FULLWORD POINTER 06390000 SAVBUFL EQU @DATD+00000108 8 BYTE(S) ON WORD 06400000 SAVGETL EQU SAVBUFL+00000000 FULLWORD POINTER 06410000 SAVSP EQU SAVBUFL+00000000 1 BYTE POINTER 06420000 A00005 EQU SAVBUFL+00000001 1 BYTE(S) 06430000 SAVLEN EQU SAVBUFL+00000002 HALFWORD POINTER 06440000 SAVAREA EQU SAVBUFL+00000004 FULLWORD POINTER 06450000 RCPTR EQU @DATD+00000116 FULLWORD POINTER 06460000 DS 00000120C 06470000 @TEMPS DS 0F 06480000 @TEMP2 DC F'0' 06490000 @DATEND EQU * 06500000 IKJEFE15 CSECT , 06510000 DONE EQU @EL01 06520000 END IKJEFE15 06530000