TITLE 'AKJLKL02 - PROMPTER CONTROL MODULE' 00010000 LCLA &T,&SPN 0001 00020000 .@001 ANOP 0001 00030000 AKJLKL02 CSECT , 0001 00040000 ST @E,12(0,@D) 0001 00050000 STM @0,@C,20(@D) 0001 00060000 BALR @B,0 0001 00070000 @PSTART DS 0H 0001 00080000 USING @PSTART+00000,@B 0001 00090000 L @0,@SIZ001 0001 00100000 GETMAIN R,LV=(0) 0001 00110000 LR @C,@1 0001 00120000 USING @DATD+00000,@C 0001 00130000 LM @0,@1,20(@D) 0001 00140000 XC @TEMPS(@L),@TEMPS 0001 00150000 ST @D,@SAV001+4 0001 00160000 LA @F,@SAV001 0001 00170000 ST @F,8(0,@D) 0001 00180000 LR @D,@F 0001 00190000 * PARMPTR=R1; /* GET ADDR.OF INCOMING PARMS * 00200000 ST @1,PARMPTR 0031 00210000 * PTR1=ADDR(VALREG); /* SET POINTER TO SAVE PARM * 00220000 LA @F,VALREG 0032 00230000 ST @F,PTR1 0032 00240000 * PTR1->BASEREG=R11; /* SAVE BASE REG. * 00250000 LR @8,@F 0033 00260000 ST @B,0(0,@8) 0033 00270000 * PTR1->DATAREG=R12; /* SAVE DATAREG * 00280000 ST @C,4(0,@8) 0034 00290000 * EXADD=ADDR(ABEX); /* SET ADDRESS OF EXIT * 00300000 LA @F,ABEX 0035 00310000 ST @F,STAEL 0035 00320000 * PRMADD=ADDR(VALREG); /* SET PTR. TO SAVE PARMS * 00330000 LA @F,VALREG 0036 00340000 ST @F,STAEL+4 0036 00350000 * GEN(ESTAE MF=(E,STAEL)); /* CREATE STAE BLOCK ZM02759 * 00360000 ESTAE MF=(E,STAEL) 00370000 DS 0H 00380000 * PT=ADDR(FINIS); /* SET RETURN ADDR ZM00615 * 00390000 LA @F,FINIS 0038 00400000 ST @F,PT 0038 00410000 * ECTPTR=CPPLECT; /* SET POINTER TO ECT * 00420000 L @9,PARMPTR 0039 00430000 L @9,4(0,@9) PARMS 0039 00440000 MVC ECTPTR(4),12(@9) 0039 00450000 * IF LKLD=' ' /* NO BRANCH NECESSARY? * 00460000 * THEN DO; 00470000 L @6,PARMPTR 0040 00480000 CLC 0(4,@6),@C1 0040 00490000 BC 07,@9FF 0040 00500000 * /* ************************************************ * 00510000 * /* ERROR IN PROCESSING - DELETE THE STACK * 00520000 * /* ************************************************ * 00530000 * STPLPTR=ADDR(STLST); /* SET STACK LIST POINTER * 00540000 LA @F,STLST 0042 00550000 ST @F,STPLPTR 0042 00560000 * STPLUPT=CPPLUPT; /* SET UPT POINTER * 00570000 LR @7,@F 0043 00580000 MVC 0(4,@7),4(@9) 0043 00590000 * STPLECT=CPPLECT; /* SET ECT POINTER * 00600000 MVC 4(4,@7),12(@9) 0044 00610000 * STPLECB=ADDR(CPECB); /* SET ECB POINTER * 00620000 LA @F,CPECB 0045 00630000 ST @F,8(0,@7) 0045 00640000 * STPLSTPB=ADDR(STPB); /* SET STACK BLOCK POINTER * 00650000 LA @F,STPB 0046 00660000 ST @F,12(0,@7) 0046 00670000 * GEN(STACK DELETE=ALL,MF=(E,STLST)); /* NO STACK * 00680000 STACK DELETE=ALL,MF=(E,STLST) 00690000 DS 0H 00700000 * GEN(TCLEARQ INPUT); /* GET RID OF INPUT LINES * 00710000 TCLEARQ INPUT 00720000 DS 0H 00730000 * RCODE=12; /* SET ERROR RETURN CODE * 00740000 LA @F,12 0049 00750000 ST @F,RCODE 0049 00760000 * GO TO DECONC; /* DECONCATENATE IF NECESSARY * 00770000 BC 15,DECONC 0050 00780000 * END; 00790000 * GEN(FREEMAIN R,SP=1); /* FREE PARSE WORKAREA M1814 * 00800000 @9FF EQU * 0052 00810000 FREEMAIN R,SP=1 00820000 DS 0H 00830000 * IF LKLD='LINK' /* LINK. EDIT. TO BE INVOKED? * 00840000 * THEN DO; /* YES - LINK TO IT * 00850000 L @8,PARMPTR 0053 00860000 CLC 0(4,@8),@C2 0053 00870000 BC 07,@9FE 0053 00880000 * R1=ADDR(OPTPTR); /* SET PARM. POINTER * 00890000 LA @1,12(0,@8) 0055 00900000 * GEN(LINK EP=HEWL); /* GO TO L. E. M2119 * 00910000 LINK EP=HEWL 00920000 DS 0H 00930000 BC 15,@9FD 0058 00940000 * END; 00950000 * ELSE DO; /* NO - LINK TO LOADER * 00960000 * R1=ADDR(OPTPTR); /* SET PARM. POINTER * 00970000 @9FE L @8,PARMPTR 0059 00980000 LA @1,12(0,@8) 0059 00990000 * GEN(LINK EP=LOADER); /* GO TO LOADER * 01000000 LINK EP=LOADER 01010000 DS 0H 01020000 * END; 01030000 * RCODE=R15; /* GET CODE FROM L.E. OR LOAD.* 01040000 @9FD ST @F,RCODE 0062 01050000 * DECONC: ; 01060000 * /* ******************************************************** * 01070000 * /* DECONCATENATE INPUT AND LIBRARY DDNAMES IF NECESSARY * 01080000 * /* ******************************************************** * 01090000 * DAPB1PTR=ADDR(DAIR10); /* SET BLOCK POINTER * 01100000 DECONC LA @F,DAIR10 0064 01110000 ST @F,DAPB1PTR 0064 01120000 * GEN(XC DAIR10(16),DAIR10); /* ZERO OUT BLOCK * 01130000 XC DAIR10(16),DAIR10 01140000 DS 0H 01150000 * DA10CD='0010'X; /* SET CODE * 01160000 L @8,DAPB1PTR 0066 01170000 MVC 0(2,@8),@X3 0066 01180000 * DAPLPTR=ADDR(DAIRL); /* SET UP LIST POINTER * 01190000 LA @F,DAIRL 0067 01200000 ST @F,DAPLPTR 0067 01210000 * DAPLUPT=CPPLUPT; /* SET UPT POINTER * 01220000 L @9,PARMPTR 0068 01230000 L @9,4(0,@9) PARMS 0068 01240000 LR @6,@F 0068 01250000 MVC 0(4,@6),4(@9) 0068 01260000 * DAPLECT=CPPLECT; /* SET ECT POINTER * 01270000 MVC 4(4,@6),12(@9) 0069 01280000 * DAPLECB=ADDR(CPECB); /* SET ECB POINTER * 01290000 LA @F,CPECB 0070 01300000 ST @F,8(0,@6) 0070 01310000 * DAPLPSCB=CPPLPSCB; /* SET PSCB POINTER * 01320000 MVC 12(4,@6),8(@9) 0071 01330000 * DAPLDAPB=DAPB1PTR; /* SET DAIR PARM BLOCK POINTER* 01340000 MVC 16(4,@6),DAPB1PTR 0072 01350000 * DO I=1 TO 2; /* LOOP ON DDNAMES * 01360000 LA @F,1 0073 01370000 ST @F,I 0073 01380000 * IF DDNAME(I)=' ' /* IS DDNAME BLANK? * 01390000 * THEN GO TO EL1; /* YES - DONT DECONCATENATE * 01400000 @DO9FC L @8,I 0074 01410000 BCTR @8,0 0074 01420000 SLA @8,3 0074 01430000 L @9,PARMPTR 0074 01440000 L @9,8(0,@9) PARMS 0074 01450000 LA @A,0(@8,@9) 0074 01460000 CLC 0(8,@A),@C4 0074 01470000 BC 08,EL1 0075 01480000 * DA10DDN=DDNAME(I); /* SET DDNAME IN PARM BLOCK * 01490000 LA @E,0(@8,@9) 0076 01500000 L @6,DAPB1PTR 0076 01510000 MVC 8(8,@6),0(@E) 0076 01520000 * R1=DAPLPTR; /* SET LIST POINTER * 01530000 L @1,DAPLPTR 0077 01540000 * GEN(LINK EP=IKJDAIR); /* GO TO DAIR * 01550000 LINK EP=IKJDAIR 01560000 DS 0H 01570000 * EL1: END; /* END OF LOOP ON DDNAMES * 01580000 * GO TO ENDPROC; /* RETURN ZM00615 * 01590000 EL1 L @F,I 0079 01600000 AH @F,@D1 0079 01610000 @DO9FB ST @F,I 0079 01620000 CH @F,@D2 0079 01630000 BC 12,@DO9FC 0079 01640000 L @8,PT 0080 01650000 BCR 15,@8 0080 01660000 * FINIS: RETURN CODE(RCODE); /* PASS RET CD BACK ZM02759 * 01670000 FINIS L @D,4(0,@D) 0081 01680000 L @F,RCODE 0081 01690000 ST @F,16(0,@D) 0081 01700000 LR @1,@C 0081 01710000 L @0,@SIZ001 0081 01720000 FREEMAIN R,LV=(0),A=(1) 0081 01730000 LM @E,@C,12(@D) 0081 01740000 BCR 15,@E 0081 01750000 * /******************************************************************** 01760000 * /* * 01770000 * /* THIS ROUTINE RECEIVES CONTROL WHEN AN ABEND OCCURS. THE ABEND * 01780000 * /* CODE IS STORED IN THE ECT AND THE ABEND FLAG IN THE ECT IS SET. * 01790000 * /* ANY CONCATENATED DATA SETS ARE DECONCATENATED. A RETURN CODE OF * 01800000 * /* 0 IS PLACED IN REGISTER 15. A RETURN IS ISSUED AND CONTROL GOES * 01810000 * /* BACK TO ABEND PROCESSING. * 01820000 * /* * 01830000 * /******************************************************************** 01840000 * ABEX: PROC OPTIONS(NOSAVEAREA,DONTSAVE); 01850000 @EL01 L @D,4(0,@D) 0082 01860000 LR @1,@C 0082 01870000 L @0,@SIZ001 0082 01880000 FREEMAIN R,LV=(0),A=(1) 0082 01890000 L @E,12(0,@D) 0082 01900000 LM @0,@C,20(@D) 0082 01910000 BCR 15,@E 0082 01920000 ABEX EQU * 0082 01930000 * DCL 1 WORKAREA BASED(R1), /* STAE WORK AREA * 01940000 * 2 PARMSREG PTR, /* POINTER TO BASE,DYNAM. REGS* 01950000 * 2 ABCODE FIXED(31); /* ABEND CODE * 01960000 * DCL R13 REG(13) PTR(31); /* FORWARD POINTER REGISTER * 01970000 * DCL SAVEAR2(18) FIXED(31), /* INTERNAL SAVE AREA * 01980000 * FPTR2 PTR BASED(R13+8); /* FORWARD POINTER * 01990000 * DCL R0 REG(0) FIXED(31); /* WHERE ABEND CODE IS * 02000000 * RESTRICT(1); /* DONT DESTROY REG1 @ZA18262* 02010000 * GEN; /* @ZA31176* 02020000 DROP R11 /* ESTABLISH @ZA31176*/ 02030000 USING ABEX,R15 /* BASE REGISTER @ZA31176*/ 02040000 DS 0H 02050000 * IF R0=12 THEN /* RETURN TO RTM IF @ZA31176* 02060000 CH @0,@D3 0089 02070000 * GO TO ENDAB1; /* NO SDWA IS PRESENT @ZA31176* 02080000 BC 08,ENDAB1 0090 02090000 * GEN; /* @ZA31176* 02100000 DROP R15 /* SDWA IS PRESENT - @ZA31176*/ 02110000 USING @PSTART,R11 /* RESET BASE REG AND @ZA31176*/ 02120000 ST @E,12(0,@D) /* SAVE REGISTERS. @ZA31176*/ 02130000 STM @0,@C,20(@D) /* @ZA31176*/ 02140000 DS 0H 02150000 * R11=PARMSREG->BASEREG; /* RESTORE SEC. BASE REG. * 02160000 L @8,0(0,@1) 0092 02170000 L @B,0(0,@8) 0092 02180000 * R12=PARMSREG->DATAREG; /* RESTORE DATA REG. * 02190000 L @C,4(0,@8) 0093 02200000 * SAVEAR2(2)=R13; /* SET SAVE AREA PTR. * 02210000 ST @D,SAVEAR2+4 0094 02220000 * FPTR2=ADDR(SAVEAR2); /* SET FORWARD POINTER * 02230000 LA @F,SAVEAR2 0095 02240000 ST @F,8(0,@D) 0095 02250000 * R13=FPTR2; /* POINT REG 13 TO SAVE AREA * 02260000 L @D,8(0,@D) 0096 02270000 * ECTRTCD=ABCODE; /* GET ABEND CODE @ZA31176* 02280000 L @9,ECTPTR 0097 02290000 MVC 1(3,@9),5(@1) 0097 02300000 * /* FROM STAE WORK AREA. * 02310000 * ECTRCDF='80'X; /* SET ABEND CODE FLAG * 02320000 MVI 0(@9),X'80' 0098 02330000 * PT=ADDR(ENDAB); /* SET RETURN ADDR ZM00615 * 02340000 LA @F,ENDAB 0099 02350000 ST @F,PT 0099 02360000 * GO TO DECONC; /* DECONCATENATE ZM00615 * 02370000 BC 15,DECONC 0100 02380000 * ENDAB: R13=SAVEAR2(2); /* RESTORE REG. 13 * 02390000 ENDAB L @D,SAVEAR2+4 0101 02400000 * GEN; /* @ZA31176* 02410000 L @E,12(0,@D) /* RESTORE REGS @ZA31176*/ 02420000 LM @0,@C,20(@D) /* @ZA31176*/ 02430000 DS 0H 02440000 * ENDAB1: R15=0; /* CONTINUE ABEND @ZA31176* 02450000 ENDAB1 SR @F,@F 0103 02460000 * END ABEX; 02470000 @EL02 BCR 15,@E 0104 02480000 * END AKJLKL02 02490000 * /* THE FOLLOWING INCLUDE STATEMENTS WERE FOUND IN THIS PROGRAM. 02500000 * /*%INCLUDE SYSLIB (IKJECT ) 02510000 * /*%INCLUDE SYSLIB (IKJCPPL ) 02520000 * /*%INCLUDE SYSLIB (IKJDAPL ) 02530000 * /*%INCLUDE SYSLIB (IKJDAP10) 02540000 * /*%INCLUDE SYSLIB (IKJSTPL ) 02550000 * ; 02560000 @DATA1 EQU * 02570000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 02580000 @1 EQU 01 02590000 @2 EQU 02 02600000 @3 EQU 03 02610000 @4 EQU 04 02620000 @5 EQU 05 02630000 @6 EQU 06 02640000 @7 EQU 07 02650000 @8 EQU 08 02660000 @9 EQU 09 02670000 @A EQU 10 02680000 @B EQU 11 02690000 @C EQU 12 02700000 @D EQU 13 02710000 @E EQU 14 02720000 @F EQU 15 02730000 @D1 DC H'1' 02740000 @D2 DC H'2' 02750000 @D3 DC H'12' 02760000 DS 0F 02770000 @SIZ001 DC AL1(&SPN) 02780000 DC AL3(@DATEND-@DATD) 02790000 DS 0F 02800000 @C1 DC C' ' 02810000 @C2 DC C'LINK' 02820000 @C4 DC C' ' 02830000 @X3 DC X'0010' 02840000 DS 0D 02850000 @DATA EQU * 02860000 DUMMY EQU 00000000 FULLWORD INTEGER 02870000 PARMS EQU 00000000 20 BYTE(S) ON WORD 02880000 LKLD EQU PARMS+00000000 4 BYTE(S) 02890000 CPPLPTR EQU PARMS+00000004 FULLWORD POINTER 02900000 CONCAT EQU PARMS+00000008 FULLWORD POINTER 02910000 OPTPTR EQU PARMS+00000012 FULLWORD POINTER 02920000 DDPTR EQU PARMS+00000016 FULLWORD POINTER 02930000 ECT EQU 00000000 56 BYTE(S) ON WORD 02940000 ECTRCDF EQU ECT+00000000 1 BYTE(S) 02950000 ECTRTCD EQU ECT+00000001 3 BYTE POINTER ON WORD+1 02960000 ECTIOWA EQU ECT+00000004 FULLWORD POINTER 02970000 ECTMSGF EQU ECT+00000008 1 BYTE(S) 02980000 ECTSMSG EQU ECT+00000009 3 BYTE POINTER 02990000 ECTPCMD EQU ECT+00000012 8 BYTE(S) 03000000 ECTSCMD EQU ECT+00000020 8 BYTE(S) 03010000 ECTSWS EQU ECT+00000028 1 BYTE(S) 03020000 ECTNOPD EQU ECT+00000028 1 BIT(S) 03030000 A00000 EQU ECT+00000028 1 BIT(S) 03040000 ECTATRM EQU ECT+00000028 1 BIT(S) 03050000 ECTLOGF EQU ECT+00000028 1 BIT(S) 03060000 ECTNMAL EQU ECT+00000028 1 BIT(S) 03070000 ECTNNOT EQU ECT+00000028 1 BIT(S) 03080000 ECTBKGRD EQU ECT+00000028 1 BIT(S) 03090000 ECTATTN EQU ECT+00000028 1 BIT(S) 03100000 ECTDDNUM EQU ECT+00000029 3 BYTE POINTER ON WORD+1 03110000 ECTUSER EQU ECT+00000032 FULLWORD POINTER 03120000 ECTBKPB EQU ECT+00000036 FULLWORD POINTER 03130000 ECTSWS2 EQU ECT+00000040 4 BYTE(S) ON WORD 03140000 ECTSWS21 EQU ECT+00000040 8 BIT(S) 03150000 ECTDEFCS EQU ECT+00000040 1 BIT(S) 03160000 ECTTABND EQU ECT+00000040 1 BIT(S) 03170000 A00001 EQU ECT+00000040 6 BIT(S) 03180000 A00002 EQU ECT+00000041 3 BYTE(S) 03190000 A00003 EQU ECT+00000044 FULLWORD POINTER 03200000 A00004 EQU ECT+00000048 FULLWORD POINTER 03210000 A00005 EQU ECT+00000052 FULLWORD POINTER 03220000 CPPL EQU 00000000 16 BYTE(S) ON WORD 03230000 CPPLCBUF EQU CPPL+00000000 FULLWORD POINTER 03240000 CPPLUPT EQU CPPL+00000004 FULLWORD POINTER 03250000 CPPLPSCB EQU CPPL+00000008 FULLWORD POINTER 03260000 CPPLECT EQU CPPL+00000012 FULLWORD POINTER 03270000 DAPL EQU 00000000 20 BYTE(S) ON WORD 03280000 DAPLUPT EQU DAPL+00000000 FULLWORD POINTER 03290000 DAPLECT EQU DAPL+00000004 FULLWORD POINTER 03300000 DAPLECB EQU DAPL+00000008 FULLWORD POINTER 03310000 DAPLPSCB EQU DAPL+00000012 FULLWORD POINTER 03320000 DAPLDAPB EQU DAPL+00000016 FULLWORD POINTER 03330000 DAPB10 EQU 00000000 16 BYTE(S) ON WORD 03340000 DA10CD EQU DAPB10+00000000 2 BYTE(S) 03350000 DA10FLG EQU DAPB10+00000002 2 BYTE(S) 03360000 DA10DARC EQU DAPB10+00000004 HALFWORD INTEGER 03370000 A00006 EQU DAPB10+00000006 2 BYTE(S) 03380000 DA10DDN EQU DAPB10+00000008 8 BYTE(S) 03390000 STPL EQU 00000000 16 BYTE(S) ON WORD 03400000 STPLUPT EQU STPL+00000000 FULLWORD POINTER 03410000 STPLECT EQU STPL+00000004 FULLWORD POINTER 03420000 STPLECB EQU STPL+00000008 FULLWORD POINTER 03430000 STPLSTPB EQU STPL+00000012 FULLWORD POINTER 03440000 DDNAME EQU 00000000 2*8 BYTE(S) 03450000 R1 EQU 00000001 FULLWORD POINTER REGISTER 03460000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 03470000 SAVEPRM EQU 00000000 8 BYTE(S) ON WORD 03480000 BASEREG EQU SAVEPRM+00000000 FULLWORD INTEGER 03490000 DATAREG EQU SAVEPRM+00000004 FULLWORD INTEGER 03500000 R11 EQU 00000011 FULLWORD INTEGER REGISTER 03510000 R12 EQU 00000012 FULLWORD INTEGER REGISTER 03520000 PATCH EQU @DATA+00000000 32 BYTE(S) 03530000 WORKAREA EQU 00000000 8 BYTE(S) ON WORD 03540000 PARMSREG EQU WORKAREA+00000000 FULLWORD POINTER 03550000 ABCODE EQU WORKAREA+00000004 FULLWORD INTEGER 03560000 R13 EQU 00000013 FULLWORD POINTER REGISTER 03570000 FPTR2 EQU 00000008 FULLWORD POINTER 03580000 R0 EQU 00000000 FULLWORD INTEGER REGISTER 03590000 DS 00000032C 03600000 @L EQU 1 03610000 @DATD DSECT 03620000 @SAV001 EQU @DATD+00000000 72 BYTE(S) ON WORD 03630000 PARMPTR EQU @DATD+00000072 FULLWORD POINTER 03640000 DAPB1PTR EQU @DATD+00000076 FULLWORD POINTER 03650000 DAPLPTR EQU @DATD+00000080 FULLWORD POINTER 03660000 STPLPTR EQU @DATD+00000084 FULLWORD POINTER 03670000 ECTPTR EQU @DATD+00000088 FULLWORD POINTER 03680000 DAIR10 EQU @DATD+00000092 16 BYTE(S) ON WORD 03690000 DAIRL EQU @DATD+00000108 20 BYTE(S) ON WORD 03700000 CPECB EQU @DATD+00000128 FULLWORD INTEGER 03710000 I EQU @DATD+00000132 FULLWORD INTEGER 03720000 STAEL EQU @DATD+00000136 16 BYTE(S) ON WORD 03730000 EXADD EQU STAEL+00000000 FULLWORD POINTER 03740000 PRMADD EQU STAEL+00000004 FULLWORD POINTER 03750000 A00007 EQU STAEL+00000008 FULLWORD POINTER 03760000 A00008 EQU STAEL+00000012 FULLWORD POINTER 03770000 PT EQU @DATD+00000152 FULLWORD POINTER 03780000 PTR1 EQU @DATD+00000156 FULLWORD POINTER 03790000 VALREG EQU @DATD+00000160 8 BYTE(S) ON WORD 03800000 STPB EQU @DATD+00000168 8 BYTE(S) 03810000 STLST EQU @DATD+00000176 16 BYTE(S) 03820000 RCODE EQU @DATD+00000192 FULLWORD INTEGER 03830000 SAVEAR2 EQU @DATD+00000196 18*FULLWORD INTEGER 03840000 DS 00000268C 03850000 @TEMPS DS 0F 03860000 DS C 03870000 @DATEND EQU * 03880000 AKJLKL02 CSECT , 03890000 END AKJLKL02,(C'PL/S',1400,78209) 03900000