//SY20ZR13 JOB 1,THAS810,MSGLEVEL=(1,1), // CLASS=A,MSGCLASS=A,REGION=768K //* //* PROBLEM DESCRIPTION(S): //* THAS810 - //* Add HASP WTO exit 2 hook to MVT MCS SVC 35 //* (version for non-ASP system) //* //* COMPONENT: 360S-CI505-EBB2218 //* //* APARS FIXED: THAS810 //* //* SPECIAL CONDITIONS: //* //* COMMENTS: //* LAST CHANGE: 2006/10/18 //* //* THE FOLLOWING MODULES AND/OR MACROS ARE AFFECTED BY THIS USERMOD: //* //* MODULES //* IGC0003E (SOURCE NAME: IEEMVWTO) //* //* NOTE: This version of THAS810 is incompatible //* with ASP because it makes source changes to //* IEEMVWTO (which ASP also modifies). If you //* are installing THAS810 on a system that also //* has ASP insatlled, use the ASP version of THAS810: //* http://kleonard.home.att.net/mvt/thas810-asp.jcl //* //ASM EXEC PGM=IEUASM,PARM=(LOAD,NODECK),REGION=256K //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB,DCB=BLKSIZE=12320 // DD DISP=SHR,DSN=SYS1.MODGEN //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(1700,(600,100)) //SYSUT2 DD DSN=&&SYSUT2,UNIT=SYSDA,SPACE=(1700,(600,100)) //SYSUT3 DD DSN=&&SYSUT3,UNIT=SYSDA,SPACE=(1700,(600,100)) //SYSGO DD DSN=&&OBJSET,UNIT=SYSDA,SPACE=(1700,(600,100)), // DISP=(NEW,PASS),DCB=(RECFM=FB,LRECL=80,BLKSIZE=80) //SYSPRINT DD SYSOUT=A //SYSIN DD * TITLE 'IEEMVWTO (IGC0003E) MVT/MCS WTO' 00200021 IGC0003E CSECT 00400021 * THIS MODULE CREATED FOR RELEASE 21 OF OS/360 00600021 *********************************************************************** 00800021 * 01000021 * STATUS - 01200021 * CHANGE LEVEL=0 01400021 * 01600021 * FUNCTION - 01800021 * THE WTO SVC ROUTINE (SVC 35) PROCESSES REQUESTS 02000021 * FOR MESSAGES TO THE OPERATOR. 02200021 * IT IS CALLED BY THE WTO OR THE WTOR MACRO 02400021 * 02600021 * MODULE NAME - 02800021 * IEEMVWTO 03000021 * 03200021 * ENTRY POINT - 03400021 * IGC0003E 03600021 * 03800021 * INPUT - 04000021 * 1. REGISTER 1 INPUT PARAMETER LIST ADDRESS 04200021 * 2. REGISTER 3 CVT ADDRESS 04400021 * 3. REGISTER 4 CURRENT TCB ADDRESS 04600021 * 4. REGISTER 5 CURRENT SVRB ADDRESS 04800021 * 5. REGISTER 14 RETURN ADDRESS 05000021 * 6. REGISTER 0 POSSIBLE UCM ID 05200021 * 05400021 * OUTPUT - 05600021 * A COMPLETED WQE QUEUED TO THE SYSTEM OUTPUT QUEUE 05800021 * 06000021 * EXITS,NORMAL - 06200021 * RETURN TO THE REQUESTOR 06400021 * TO IEECVML3 TO HANDLE MLWTO REQUESTS 06600021 * TO SECOND LOAD FOR WTOR REQUESTS 06800021 * TO IEFWTP00 FOR WTP REQUESTS BG A47887 06850021 * 07000021 * EXITS,ERROR - 07200021 * TO ABEND IF THE ADDRESS IN REGISTER 1 IS NOT ON A 07400021 * FULLWORD BOUNDARY 07600021 * 07800021 * ATTRIBUTES - 08000021 * NON-RESIDENT, PARTIALLY ENABLED, PRIVILEGED 08200021 * 08400021 * OPERATION - 08600021 * UPON ENTRY A TEST IS MADE TO SEE IF ENTRY IS 08800021 * DUE TO A RETURN FROM ANOTHER LOAD. IF SO 09000021 * CONTROL IS PASSED TO A ROUTINE WHICH WILL ACQUIRE 09200021 * A WTO BUFFER 09400021 * IF IT IS AN INITIAL ENTRY AND A REQUEST FOR A 09600021 * WTOR TRANSFER IS MADE TO THE SECOND LOAD VIA 09800021 * XCTL. 10000021 * IF IT IS INITIAL ENTRY AND A REQUEST FOR AN MLWTO, 10200021 * TRANSFER IS MADE TO IEECVML3 VIA XCTL 10400021 * OTHERWISE A CHECK ON THE MESSAGE LENGTH IS MADE 10600021 * IF IT IS LESS THAN ZERO RETURN TO THE CALLER IS 10800021 * MADE. IF IT IS GREATER THAN 126 11000021 * IT IS TRUNCATED TO THE APPROPRIATE LENGTH. 11200021 * NEXT AN ATTEMPT TO OBTAIN A BUFFER IS MADE. IF 11400021 * THE BUFFER LIMIT HAS BEEN REACHED AND THE CALLER 11600021 * IS NOT THE COMMUNICATIONS TASK, THE LOG OR AN SIRB, AN 11800021 * ENQ IS PERFORMED ON A RESOURCE WHICH REPRESENTS 12000021 * AN ECB (UCMWQECB) POSTED WHEN A BUFFER IS MADE 12200021 * AVAILABLE. WHEN EXCLUSIVE CONTROL OF THIS RESOURCE 12400021 * IS OBTAINED, A WAIT ON THAT ECB IS TAKEN. UPON 12600021 * RETURN FROM THE WAIT A DOUBLE CHECK IS MADE TO 12800021 * INSURE A BUFFER REALLY IS AVAILABLE. IF NOT, 13000021 * THE WAIT IS AGAIN ISSUED. 13200021 * WHEN A BUFFER IS AVAILABLE, THE BUFFER COUNT IS 13400021 * INCREMENTED. IF THE MODE IS FIXED A BUFFER IS 13600021 * OBTAINED FROM THAT FIXED AREA, OTHERWISE A 13800021 * GETMAIN FOR THE APPROPRIATE SIZE BUFFER (168) 14000021 * IS MADE. 14200021 * AT THIS POINT THE TEXT IS MOVED TO THE WQE 14400021 * AND PRECEEDED BY 14600021 * THE REPLY ID IF A WTOR. NEXT THE WQE IS LINKED 14800021 * ONTO THE WTO QUEUE. THE 15000021 * MCS DEPENDENT FIELDS ARE FILLED IN (ROUTING 15200021 * CODES, DESCRIPTOR CODES AND MESSAGE TYPE FLAGS) 15400021 * FINALLY THE WTO ECB IN THE UCM IS POSTED,AND 15600021 * RETURN IS MADE TO THE CALLER 15800021 * 16000021 * TABLES AND CONTROL BLOCKS - 16200021 * CVT COMMUNICATION VECTOR TABLE 16400021 * UCM UNIT CONTROL MODULE 16600021 * EIL EVENT INDICATION LIST 16800021 * WQE CONSOLE OUTPUT QUEUE ELEMENT 17000021 * RQE CONSOLE REPLY QUEUE ELEMENT 17200021 * 17400021 * NOTES - 17600021 * NONE 17800021 * 18000021 *********************************************************************** 18200021 EJECT 18400021 ********** 18600021 * 18800021 * GENERAL REGISTER EQUATES 19000021 * 19200021 ********** 19400021 SPACE 1 19600021 R0 EQU 0 19800021 R1 EQU 1 20000021 R2 EQU 2 20200021 R3 EQU 3 20400021 R4 EQU 4 20600021 R5 EQU 5 20800021 R6 EQU 6 21000021 R7 EQU 7 21200021 R8 EQU 8 21400021 R9 EQU 9 21600021 R10 EQU 10 21800021 R11 EQU 11 22000021 R12 EQU 12 22200021 R13 EQU 13 22400021 R14 EQU 14 22600021 R15 EQU 15 22800021 RBASE EQU 11 23000021 SPACE 2 23200021 ********** 23400021 * 23600021 * EQUATES 23800021 * 24000021 ********** 24200021 SPACE 2 24400021 FOURTEEN EQU 14 24600021 D112 EQU 112 BE A51715 24650021 EIGHT EQU 8 24800021 ONE EQU 1 25000021 ZERO EQU 0 25200021 ZEROBYTE EQU X'00' 25400021 F2 EQU 2 25600021 F4 EQU 4 25800021 HEX20 EQU X'20' 26000021 HEX02 EQU X'02' 26200021 HEX80 EQU X'80' 26400021 HEX03 EQU 3 26600021 D104 EQU 104 26800021 NTAVGET EQU X'50' 27000021 XRTCDEX EQU X'80' 27200021 MCSFEX EQU X'10' 27400021 ISSRPK EQU 17 27600021 PROBKEY EQU X'F0' 27800021 RBLINK EQU 28 28000021 CNOR EQU X'F1' 28200021 ASTER EQU X'5C' 28400021 BLANK EQU X'40' 28600021 FOUR4 EQU 4 28800021 DESCCODE EQU X'80' 29000021 ACTION EQU X'C0' 29200021 N3 EQU 3 DISPLACEMENT 29400021 N108 EQU 108 DISPLACEMENT 29600021 MLWTO EQU 64 MCSFLAG BIT FOR MLWTO 29800021 MLRTN EQU C'6' MLWTO RTN MODIFIER 30000021 TCBDAR EQU 172 DAR FLAGS IN TCB 30200021 DARFLAG EQU X'C0' IF EITHER BIT ON THEN 30400021 * DAR IN CONTROL 30600021 TCBTSFLG EQU X'94' TSO FLAG FIELD IN TCB 30800021 TCBTSTSK EQU X'80' TSO TASK 31000021 TCBJSCB EQU X'B4' JSCB ADDR IN TCB 31200021 TCBOTC EQU X'84' TCB MOTHER PTR BE 21472 31300021 ERRTCB EQU X'74' @ OF ERROR TCB IN SCVT BG A62165 31350021 SECCVT EQU X'C8' ADDRESS OF SCVT BG A62165 31370021 EJECT 31400021 BALR RBASE,0 31600021 USING *,RBASE 31800021 USING UCM,R10 32000021 USING CVTDSECT,R12 32200021 ENABLE EQU * 32400021 DC X'80FF' ENABLE SYSTEM MASK 32600021 DC S(*-1) 32800021 LR R13,R0 UCMID WILL BE KEPT IN REG BE M1432 32850021 * 13, BUT WILL BE PUT INTO BE M1432 32900021 * REG 0 ON AN XCTL BE M1432 32950021 MVC D104(8,R5),WTPNAME SET UP EXIT NAMES 33000021 LTR R3,R3 BACK FROM WTOR OR WTP 33200021 BZ WTO 33400021 BC F4,WTORTEST YES-BACK FROM WTP-BRANCH 33600021 OVER EQU * 33800021 LR R12,R3 LOAD CVT POINTER 34000021 L R10,CVTCUCB PTR TO UCM 34200021 ST R14,124(R5) SAVE RETURN ADDR IN 8TH WORD OF SVRB XSA 34400021 LR R6,R1 SAVE PARAMETER LIST ADDR 34600021 USING WQE,R1 34800021 USING WPLF,R6 35000021 WTPTEST EQU * 35200021 LA R3,ONE CHECK PARAMETER LIST FOR BG A42813 35240021 NR R3,R1 HALFWORD BOUNDARY. ABTERM BG A42813 35280021 BC 4,INVALID REQUESTOR IF WTO PARAMETER BG A42813 35320021 * NOT ON HALFWORD BOUNDARY BG A42813 35360021 LR R7,R6 35400021 CLI WPLLGH,ZEROBYTE IS THIS A WTOR 35600021 BE RCCHECK NO-PARM LIST POINTER OK 35800021 LA R7,EIGHT(R7) PUT POINTER PAST WTOR PREFIX 36000021 B NOTMLWTO LET MLWTOR DEFAULT TO WTOR 21002 36100000 RCCHECK EQU * 36200021 *** TEST MCSFLAGS FIELD IN USER PARAMETER LIST FOR MULTIPLE 21002 36220021 *** LINE WRITE TO OPERATOR(MLWTO) 21002 36240021 TM N3(R7),MLWTO Q. IS THIS AN MLWTO 21002 36260000 BNO NOTMLWTO NO NORMAL WTO 21002 36280000 MVI N108(R5),MLRTN YES. SET XCTL NAME TO MLWTO 21002 36300000 B WTP GO TO EXIT ROUTINE 21002 36320000 NOTMLWTO EQU * 21002 36340000 TM F2(R7),HEX80 DO ROUT AND DESC EXIST 36400021 BZ WTORTEST NO-DON'T GO TO WTP 36600021 AH R7,ZERO(R7) ADD MSG LENGTH TO POINTER 36800021 TM HEX03(R7),HEX20 IS THERE ROUTING CODE 11 37000021 BNZ WTP 37200021 WTORTEST EQU * 37400021 CLI WPLLGH,X'00' IS THIS A WTOR 37600021 BNE WTOR YES 37800021 SR R7,R7 39000021 IC R7,WPLLGH+1 LOAD LENTGH OF OUTPUT MSG 39200021 SH R7,FOUR LENGTH IN WQE (FOR CCW) 39400021 LTR R7,R7 IS LENGTH GREATER THAN ZERO 39600021 BC 12,RESTORE *RETURN IF NOT 39800021 LA R7,1(R7) ADD ONE BYTE FOR'ACTION'SYMBOL 40000021 WTO EQU * 40200021 LA R9,126 MVT LIMIT 40400021 SSM *+1 DISABLE 40800021 CR R7,R9 DOES LENGTH EXCEED LIMIT 41000021 BNH TESTWQE B TO TEST LIMIT 41200021 LR R7,R9 TRUNCATE TO LIMIT 41600021 TESTWQE EQU * 41650021 LA R8,POSTWTO IN CASE NO WQE ENQ NEEDED BE A51715 41700021 ST R8,D112(R5) STORE WHERE-TO-GO IN XSA BE A51715 41750021 CLC UCMWQNR(2),UCMWQLM BUFFER LIMIT REACHED YET 41800021 BL GETWQE NO 42000021 LA R4,0(R4) 42200021 C R4,UCMPXA CAN'T ENQ COMM TASK BE A51715 42600021 BE GETWQE DO NOT ENQ BE A51715 43000021 TM TCBDAR(R4),DARFLAG IS DAR IN CONTROL 43200021 BNZ GETWQE YES, DO NOT ENQ REQUESTOR BE M0549 43400021 LR R15,R10 PUT UCM PTR IN REG 43600021 LA R3,FOUR4 43800021 SR R15,R3 GET MCS PREFIX PTR 44000021 L R15,0(R15) 44200021 USING MCSUCM,R15 44400021 C R4,UCMLOGAD IS THE ISSUER THE LOG 44600021 BE GETWQE DYNAMICALLY OBTAIN WQE BE 21472 44800021 L R15,CVTPTR GET POINTER TO CVT BG A62165 45000021 L R15,SECCVT(R15) GET POINTER TO SCVT BG A62165 45200021 L R15,ERRTCB(R15) GET POINTER TO ERROR TCB BG A62165 45400021 CR R15,R4 CURRENT TCB ERROR TCB BG A62165 45600021 BE GETWQE YES, GETMAIN A BUFFER BG A62165 45800021 QUP EQU * 46000021 LA R8,DEQUE1 WHERE-TO- GO REG IN XSA BE A51715 46050021 ST R8,D112(R5) BE A51715 46100021 LA R9,MAJORNAM PTRS TO MAJOR AND MINOR 46400021 LA R8,MINORNM1 NAMES FOR ENQ 46600021 LA R1,96(R5) PTR TO EXTENDED SAVE AREA- SVRB 46800021 XC 0(4,1),0(1) CLEAR OPTION & RETURN CODE BYTE 47000021 OI 0(1),X'FF' INDICATE LAST QUEUE ELEMENT 47200021 ENQ ((9),(8),E,6,SYSTEM),MF=(E,(1)),RET=HAVE BG A59890 47600021 LTR R15,R15 IS RETURN CODE = TO ZERO BG A59890 47601021 BZ TSTCOUNT YES ENQUED ON RESOURCE BG A59890 47602021 LA R8,POSTWTO IN CASE OF NO ENQ BG A59890 47603021 ST R8,D112(R5) STORE WHERE-TO-GO IN XSA BG A59890 47604021 B GETWQE GET ANOTHER BUFFER BG A59890 47605021 TSTCOUNT EQU * BE A51715 47610021 CLC UCMWQNR(2),UCMWQLM TEST COUNT VS. LIMIT AGAIN 47650021 BL GETWQE GET AVAILABLE BUFFER BE A51715 47700021 LR R9,R10 GET POINTER TO UCM 47800021 SH R9,EIGHT8 GET TO UCM EXTENSION POINTER 48000021 L R9,ZERO(R9) GET UCM2 POINTER 48200021 USING UCM2,R9 48400021 XC UCM2WID(2),UCM2WID CLEAR WQE TJID FIELD BE M1432 48600021 XC UCMWQECB,UCMWQECB CLEAR WAIT IN ECB BE M1432 48700021 TM TCBTSFLG(R4),TCBTSTSK TSO USER 49400021 BNO WAIT NO, SO NO TJID 49600021 L R3,TCBJSCB(R4) POINTER TO JSCB 49800021 USING IEZJSCB,R3 50000021 MVC UCM2WID,JSCBTJID SET TJID IN UCM EXT 50200021 DROP R3 50400021 WAIT EQU * 50600021 LA R1,UCMWQECB WQE ECB POINTER 50800021 WAIT ECB=(1) 51600021 SSM *+1 DISABLE 51800021 DROP R9 52000021 B TSTCOUNT BE A51715 52050021 GETWQE EQU * 53400021 LH R1,UCMWQNR LOAD WQE COUNT 53600021 LA R1,1(R1) INCREMENT 53800021 STH R1,UCMWQNR STORE 54000021 LA R0,WQESIZE SIZE OF WQE - MCS IN SYSTEM 54600021 O R0,MASK245 SUBPOOL 245 54800021 SR R15,R15 ZERO GETMAIN RETURN REG CODE 55000021 GETMAIN R,LV=(0) 55200021 * FOLLOWING TEST IS ONLY WHERE CONTROL COULD COME BACK 55400021 * DURING ABEND EVEN IF GETMAIN FAILS. 55600021 CH R15,FOUR DID GETMAIN FAIL 55800021 BE GETFAIL 56000021 LA R3,NTAVGET MARK BUFFER IN USE & GETMAINED 56400021 XC WQELKP(WQESIZE),WQELKP ZERO OUT WQE 56600021 STC R3,WQEAVAIL 56800021 ST R7,WQENBR STORE LENGTH IN WQE FOR CCW 57200021 BCTR R7,0 57400021 CLI WPLLGH,X'00' IS THIS A WTOR 57600021 BNE EX2 YES 57800021 BCTR R7,0 SUBT 1 MORE FOR'ACTION'SYM 58000021 MVI WQETXT,BLANK MOVE IN BLANK 58200021 TM WPLX,DESCCODE DO ROUTE OR DESCCODES EXIST 58400021 BZ PARTCHK NO,INSERT'BLANK'AND CONTINUE 58600021 SR R15,R15 CLEAR A REGISTER 58800021 IC R15,WPLLGH+1 LOAD LNGTH OF OUTPUT MSG 59000021 SH R15,FOUR ADJUST TO LNGTH OF TEXT 59200021 LA R15,WPLTXT(R15) BUMP TO DESC CODE FIELD 59400021 TM 0(R15),ACTION DOES WTO HAVE DESCCODE 1/2 59600021 BZ PARTCHK NO,GO INSERT'BLANK' 59800021 MVI WQETXT,ASTER INDICATE ACTION REQUIRED 60000021 PARTCHK EQU * 60200021 EX R7,MOVEWTO 60800021 LINKWQE EQU * 62200021 L R15,UCMWQEND LOAD PTR TO LAST WQE ON CHAIN 62400021 LTR R15,R15 ZERO POINTER 62600021 BC 7,STORE NO 62800021 LA R15,UCMWTOQ ADDR OF BASE OF CHAIN 63000021 STORE EQU * 63200021 ST R1,UCMWQEND CURRENT BECOMES END OF CHAIN 63400021 DROP R1 63600021 USING WQE,R15 63800021 MVC WQELKP+ONE(R3),UCMWQEND+ONE LINK WQE ONTO QUEUE 64000021 DROP R15 64200021 USING WQE,R1 64400021 LR R15,R10 GET UCM POINTER 64600021 SH R15,FOUR POINT TO PREFIX FOR MCS 64800021 L R15,ZERO(R15) GET TO MCS PREFIX 65000021 USING UCMMCENT,R15 65200021 L R3,UCMCMID GET NEXT WQE ID NO. 65400021 ST R3,WQERTCT STORE ID INTO WQE 65600021 LA R3,ONE(R3) INCREMENT FOR NEXT WQE 65800021 ST R3,UCMCMID REPLACE ID NO IN UCM 66000021 DROP R15 66200021 STC R13,WQEUCMID PLACE UCMID IN WQE BE M1432 66400021 CLI WPLLGH,ZEROBYTE IS THIS A WTOR 66600021 BE WTOMCSFM NO 66800021 DROP R6 67000021 USING WPLRF,R6 67200021 MVC WQEMCSF(F2),WPLX MOVE MCS FLAGS TO WQE WTOR 67400021 DROP R6 67600021 USING WPLF,R6 67800021 LA R6,EIGHT(R6) ACCOUNT FOR 8 BYTE HEADER 68000021 B MOVEMCS DON'T DO WTO MCSFLGS MOVE 68200021 WTOMCSFM EQU * 68400021 MVC WQEMCSF(F2),WPLX MOVE MCS FLAGS TO WQE 68600021 MOVEMCS EQU * 68800021 AH R6,WPLLGH ADD OUTPUT MESSAGE LENGTH 69000021 TM WQEMCSF,XRTCDEX Q.- DO ROUTCDES AND DESC EXIST 69200021 BNO TSTMSGF NO - TEST FOR MSGTYPE FLAGS 69400021 MVC WQEROUT(F2),F2(R6) MOVE ROUTING CODES TO WQE 69600021 MVC WQEDESCD(F2),ZERO(R6) MOVE DESCRIPTOR CODES TO WQEMCS 69800021 TSTMSGF EQU * 70000021 TM WQEMCSF,MCSFEX DO MSGTYPE FLAGS EXIST 70200021 BNO XNRTCD NO - DON'T MOVE JUNK 70400021 MVC WQEMSGTP(F2),F4(R6) MOVE MSG TYPE FLAGS TO WQE 70600021 XNRTCD EQU * 70800021 L R9,RBLINK(R5) GET ISSUER RB 71000021 * TEST ISSUER AND ONLY HONOR -BYPASS HC- IF RB KEY=0 71200021 TM ISSRPK(R9),PROBKEY IS ISSUER NONZERO PROTECT KEY 71400021 BZ TESTWTOR NO, LET SYSTEM BYPASS HC 71600021 NI WQEMCSF+ONE,X'FF'-WQEMCSN YES,NO HC BYPASS 71800021 TESTWTOR EQU * TEST FOR WTOR FOR DEFAULT DC 72000021 TM WQEXA,HEX20 DO WE HAVE A RQE (WTOR) 72200021 BNO MOVEPKE NO THIS IS A WTO 72400021 OI WQEDESCD,HEX02 GIVE ALL WTORS A DESC CD=7 72600021 MOVEPKE EQU * 72800021 MVI WQEPKE,X'00' ZERO OUT PROTECT KEY FIELD 73000021 MVZ WQEPKE(1),ISSRPK(R9) MOVE PROTEST KEY TO WQE 73200021 * Start of call to HASP WTO exit 2 ($WTOSVC2) @THAS810 73200100 L R15,CVTUSER Point to HCT @THAS810 73200200 LTR R15,R15 Is HASP present? @THAS810 73200300 BZ NOHASP Skip exit call if not @THAS810 73200400 L R15,X'10'(,R15) Get $WTOSVC2 address @THAS810 73200500 LTR R15,R15 Ensure good address @THAS810 73200600 BZ NOHASP Skip $WTOSVC2 call if not @THAS810 73200700 SSM *-1 Ensure disabled @THAS810 73200800 LR R0,R1 Point R0 to WQE @THAS810 73200900 BALR R14,R15 Link to $WTOSVC2 HASP exit @THAS810 73201000 NOHASP DS 0H Here to skip $WTOSVC2 call @THAS810 73201100 * End of call to HASP WTO exit 2 ($WTOSVC2) @THAS810 73201200 L R8,D112(R5) LOAD WHERE-TO-GO BE A51715 73250021 BR R8 GO BE A51715 73300021 SPACE 2 73600021 USING RQE,R2 73800021 EX2 EQU * 74000021 ST R1,RQEXB YES,STORE WQE PTR IN RQE 74200021 OI WQEXA,X'28' INDICATE RQE EXISTS FOR THIS 74400021 * THIS BIT IS SET FOR GRAPHICS AND NEVER TURNED OFF 74600021 MVI WQETXT,ASTER MOVE * TO INDICATE'ACTION' 74800021 MVC WQETXT+1(2),RQEID MOVE ID FROM RQE TO WQE 75000021 MVI WQETXT+3,BLANK MOVE BLANK AFTER ID 75200021 SH R7,FOUR 75800021 EX R7,MOVEWTOR 76000021 B LINKWQE 76200021 DEQUE1 EQU * BE A51715 76210021 LA R9,MAJORNAM MAJOR AND MINOR NAMES 76250021 LA R8,MINORNM1 FOR DEQ BE M1432 76300021 LA R1,96(R5) PTR TO XSA OF SVRB 76350021 DEQ ((9),(8),6,SYSTEM),MF=(E,(1)) BE M1432 76400021 POSTWTO EQU * POST WTO ECB IN UCM 77600021 POST UCMOECB 77800021 RESTORE EQU * 78000021 LR R1,R3 GET CURRENT ID NUMBER 78200021 BCTR R1,R0 RETURN LAST ASSIGNED TO USERMCS 78400021 GETFAIL EQU * 78600021 L R14,124(R5) RELOAD RETURN ADDRESS 78800021 BR R14 * RETURN TO CALLER 79000021 INVALID L R1,ABENDCOD LOAD ABEND COMPLETION CODE BG A42813 79060021 ABEND (1) BG A42813 79120021 WTOR EQU * 79200021 MVI 108(R5),CNOR 79400021 WTP EQU * 79600021 LR R0,R13 RESTORE UCMID TO REG 0 BE M1432 79700021 XC 100(4,R5),100(R5) 79800021 LA R15,104(R5) 80000021 ST R15,96(R5) STORE ADDR OF ENTRY PT 80200021 LA R15,96(R5) LOAD INTO R15 XCTL PARA LIST 80400021 XCTL SF=(E,(15)) BRING IN SECOND LOAD 80600021 EJECT 80800021 ********** 81000021 * 81200021 * EXECUTED INSTRUCTIONS 81400021 * 81600021 ********** 81800021 DS 0H EXECUTE SUBJECT INSTRUCTIONS 82000021 MOVEWTO MVC WQETXT+1(1),WPLTXT MOVE USER'S TEXT TO WQE 82200021 DROP R6 82400021 USING WPLRF,R6 82600021 MOVEWTOR MVC WQETXT+4(1),WPLTXT WTOR MOVE OF USER'S TEXT 82800021 SPACE 2 83000021 ********** 83200021 * 83400021 * CONSTANTS 83600021 * 83800021 ********** 84000021 SPACE 2 84200021 MAJORNAM DC CL8'SYSIEECT' MAJOR NAME FOR ENQ, DEQ 84400021 MINORNM1 DC CL6'IEEWQE' WQE MINOR NAME FOR ENQ, DEQ 84600021 * ID AND BLANK 84800021 EIGHT8 DC H'8' 85000021 FOUR DC H'4' 85200021 DS 0F 85400021 MASK245 DC X'F5000000' 85600021 ABENDCOD DC X'80D23000' INVALID PARAMETER ADDRESS BG A42813 85700021 WTPNAME DC C'IGC0203E' 85800021 EJECT 86000021 ********** 86200021 * 86400021 * DSECTS 86600021 * 86800021 ********** 87000021 SPACE 3 87200021 WQE DSECT 87400021 IEECVMUG WQE 87600021 EJECT 87800021 RQE DSECT 88000021 IEECVMUG RQE 88200021 EJECT 88400021 WPL DSECT 88600021 IEECVMUG WPL 88800021 EJECT 89000021 UCM DSECT 89200021 IEECUCM 89400021 EJECT 89600021 CVTDSECT DSECT 89800021 CVT 90000021 EJECT 90200021 IEZJSCB 90400021 END 90600021 /* //LKED EXEC PGM=IEWL,COND=(4,LT),REGION=200K, // PARM='NCAL,LIST,XREF,LET,RENT' //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(5,5)) //SYSPRINT DD SPACE=(121,(850,100),RLSE), // DCB=(RECFM=FB,LRECL=121,BLKSIZE=605), // SYSOUT=A //SYSLMOD DD DISP=OLD,DSNAME=SYS1.SVCLIB(IGC0003E) //SYSLIN DD DSN=&&OBJSET,DISP=(OLD,DELETE) /* //IOSUP EXEC PGM=IEHIOSUP,PARM=TSO,COND=(4,LT) //SYSPRINT DD SYSOUT=A //SYSUT1 DD DSNAME=SYS1.SVCLIB,DISP=OLD //