TITLE 'IEE2903D - DISPLAY REQUESTS ROUTINE' 00450040 IEE2903D CSECT 00500002 * C142000,C256000,C662500 A45338 00580002 * /* START OF SPECIFICATIONS **** 00630002 * 00680002 *01* MODULE-NAME = IEE2903D 00730002 * 00880002 *02* CSECT-NAME = IEE2903D 00930002 * 01030002 *01* DESCRIPTIVE-NAME = DISPLAY REQUESTS ROUTINE 01080002 * 01180002 *01* COPYRIGHT = NONE 01230002 * 01280002 *01* STATUS = OS/VS2 REL 4 @ZD04020 01480040 * 01580002 *01* FUNCTION = TO DISPLAY ON THE ISSUER'S CONSOLE THE ID OF EACH WTOR 01630002 * TYPE MESSAGE THAT HAS NOT BEEN REPLIED TO, THE UNIT NUMBER OF 01680040 * EACH DEVICE FOR WHICH A MOUNT INSTRUCTION HAS BEEN ISSUED BUT NOT 01690002 * COMPLIED WITH AND THE UNIT NUMBER OF EACH DEVICE ON WHICH 01700002 * OPERATOR INTERVENTION IS REQUIRED. 01710002 * 01730002 *02* OPERATION = A TEST IS MADE TO DETERMINE IF THERE ARE ANY 01780002 * OPERATOR REPLY ELEMENTS (ORE) ON THE CHAIN. IF THERE ARE, EACH 01790002 * ORE IS TESTED FURTHER TO DETERMINE IF IT IS OUTSTANDING. IF 01800002 * THE ORE HAS BEEN MARKED DELETED (DOM ISSUED), OR IF IT HAS 01810002 * BEEN MARKED PARTIALLY PROCESSED (TEMPORARY BUFFER EXIST), OR 01820002 * IF IT HAS BEEN MARKED SUSPENDED (HASP SUSPEND) ,OR IF THERE IS 01822002 * NO WQE ASSOCIATED WITH THIS ORE, THE ORE IS CONSIDERED TO BE 01824002 * NOT OUTSTANDING AND THE NEXT ORE ON THE CHAIN IS TESTED. FOR 01826002 * EACH OUTSTANDING ORE FOUND ON THE CHAIN, THE ASSOCIATED 01826402 * ID IS MOVED TO A MESSAGE AREA. IF 'LIST' WAS SPECIFIED AS AN 01828002 * OPERAND ON THE DISPLAY COMMAND, THE FIRST 64 CHARACTERS OF THE 01828440 * WTOR MESSAGE WILL ALSO BE MOVED TO THE MESSAGE AREA. 01833402 * 01837802 * AFTER ALL OF THE ORES HAVE BEEN PROCESSED, THE UCBS IN THE 01840002 * SYSTEM ARE EXEMINED. EVERY TAPE OR DIRECT ACCESS UCB THAT HAS 01850002 * A MOUNT MESSAGE PENDING AND IS CURRENTLY ALLOCATED AND (FOR 01860002 * TAPE DEVICES ONLY) IS MARKED NOT READY IS CONSIDERED TO BE IN 01870002 * A NOT READY STATE. ALL DIRECT ACCESS UCBS WITH NO MOUNT 01872002 * MESSAGES PENDING ARE TESTED TO DETERMINE IF DAVV IS WAITING TO 01874002 * VERIFY A MOUNT CONDITION. THE UNIT NUMBER OF EACH UCB THAT IS 01876002 * CONSIDERED NOT READY IS MOVED TO THE MESSAGE AREA. 01878002 * 01880002 * AFTER PROCESSING THE 'READY UNITS' PORTION OF THE MESSAGE, ALL 01890002 * THE UCBS ARE RE-EXAMINED. THE UNIT NUMBER FOR ALL UCBS THAT 01900002 * INDICATE THAT IOS HAS ISSUED AN INTERVENTION REQUIRED MESSAGE 01910002 * WILL BE MOVED TO THE MESSAGE AREA. 01920002 * 01930002 * AT THE END OF EACH OF THE ABOVE THREE FUNCTIONAL @ZD04020 01931040 * AREAS, A SUBROUTINE IS CALLED FOR THE PURPOSE OF @ZD04020 01931840 * PUTTING THE COUNT OF EACH AREA'S OUTPUT INTO THE @ZD04020 01932640 * LABEL LINE ALONG WITH ITS ASSOCIATED LABEL. @ZD04020 01933440 * 01935040 * THE ISSUER OF THE DISPLAY REQUEST COMMAND WILL BE NOTIFIED OF 01940002 * ALL OUTSTANDING REQUEST CONDITIONS VIA A MULTI-LINE WTO. IF 01950002 * THE ISSUER IS A TSO USER, TPUTS WILL BE ISSUED. 01960002 * 01980002 *01* NOTES = THIS MODULE WAS RE-STRUCTURED INTO FOUR MAJOR LOGICAL 02030002 * FUNCTIONS CONSISTING OF (1) ORE PROCESSING (2) READY UNITS 02040002 * PROCESSING (3) INTERVENTION REQUIRED PROCESSING AND (4) 02050002 * MULTI-LINE WTO PROCESSING. 02060002 * 02080002 *02* DEPENDENCIES = NO LOCKS OR ENQ RESOURCES ARE REQUIRED UPON 02130002 * ENTRY TO THIS MODULE. 02140002 * 02380002 *03* CHARACTER-CODE-DEPENDENCIES = THIS MODULE IS DEPENDENT ON 02430002 * THE FOLLOWING EBCIDIC CHARACTERS: BLANK, COMMA 02480002 * 02580002 *02* RESTRICTIONS = NONE 02630002 * 02680002 *02* REGISTER-CONVENTIONS = REFER TO REGISTER DECLARATIONS. 02780002 * 02980002 *02* PATCH-LABEL = PATCHAR (RESERVED FOR FUTURE USE). 03030002 * 03180002 *01* MODULE-TYPE = PROCEDURE 03230002 * 03330002 *02* PROCESSOR = ASSEMBLER 03380002 * 03730002 *02* MODULE-SIZE = X'A6E' @ZD04020 03780040 * 03930002 *02* ATTRIBUTES = PAGED-LPA ,ZERO PROTECT KEY ,REENTERABLE , 03980002 * SUPERVISOR MODE 03990002 * 04230002 *01* ENTRY-POINT = IEE2903D 04280002 * 04530002 *02* PURPOSE = BRANCHED TO BY SVC 34 PROCESSOR (IEE3503D) TO 04580002 * PROCESS DISPLAY REQUEST COMMANDS. 04590002 * 04680002 *02* LINKAGE = UPON ENTRY REGISTER 2 CONTAINS THE ADDRESS OF AN XSA 04730002 * CREATED FOR SVC 34 PROCESSORS. REGISTER 14 CONTAINS THE RETURN 04780002 * ADDRESS. 04790002 * 04930002 *02* INPUT = THE FOLLOWING FIELDS IN THE XSA ARE REQUIRED UPON 04980002 * ENTRY: 04990002 * XAR INPUT BUFFER POINTER 05040002 * XAL POINTER TO OPERAND FIELD 05090002 * XAA ASID ENTRY INDICATOR 05140002 * XASCID CONSOLE ID 05190002 * XASDID DISPLAY AREA ID 05200002 * 05230002 *02* OUTPUT = NONE 05280002 * 05330002 *02* REGISTERS-SAVED = REGISTER 14 IS SAVED UPON ENTRY TO THIS 05430002 * MODULE. 05480002 * 05530002 *02* REGISTER-USAGE = REFER TO REGISTER DECLARATIONS. 05580002 * 05680002 *02* REGISTERS-RESTORED = REGISTER 14 IS RESTORED BEFORE EXIT FROM 05730002 * THIS MODULE. 05780002 * 05830002 *01* EXIT-NORMAL = (MLWTOEND) -RETURN TO CALLER AFTER MULTI-LINE WTO 05880002 * OUTPUT. (WTONEXIT) -RETURN TO CALLER AFTER NORMAL WTO OUTPUT. 05930002 * 06080002 *02* CONDITIONS = (MLWTOEND) -THIS EXIT IS TAKEN AFTER PROCESSING 06130002 * ALL OUTSTANDING REQUEST. (WTONEXIT) -THIS EXIT IS TAKEN IF 06180002 * THERE ARE NO OUTSTANDING REQUEST. 06190002 * 06230002 *02* OUTPUT = THE FOLLOWING MLWTO MESSAGE IS ISSUED IF THERE ARE 06280002 * OUTSTANDING REQUEST (MLWTOEND): @YM7246P 06330002 * IEE110I HH.MM.SS PENDING REQUEST @ZD04020 06340040 * -- OR -- @ZD04020 06346040 * IEE110I HH.MM.SS PENDING REQUESTS @YM7246P 06360002 * SUMMARY: N REPLY IDS N READY UNITS N INTERVENTIONS REQUIRED 06390040 * WHERE 'N' IS A ONE TO FOUR DIGIT DECIMAL NUMBER @ZD04020 06395040 * GREATER THAN ZERO. IF THERE IS A COUNT OF ONE @ZD04020 06405040 * ON ANY OF THE ABOVE LABELS, THE LABEL WILL BE @ZD04020 06415040 * CORRECTED TO THE SINGULAR FORM AS THE CASE MAY @ZD04020 06425040 * BE. 'N' IN REPLY IDS IS A MAXIMUM OF 2 DIGITS. @ZD04020 06435040 * ID ID ID .. (IF D R SPECIFIED) @ZD04020 06445040 * ID,TEXT (IF D R,LIST OR D R,L SPECIFIED) @ZD04020 06455040 * ID,TEXT @ZD04020 06465040 * ID,TEXT @ZD04020 06475040 * ....... @ZD04020 06485040 * READY UNITS: UUU UUU UUU ... @ZD04020 06495040 * -- OR -- @ZD04020 06505040 * READY UNIT: UUU @ZD04020 06515040 * INTERVENTIONS REQUIRED: UUU UUU UUU ... @ZD04020 06525040 * -- OR -- @ZD04020 06535040 * INTERVENTION REQUIRED: UUU @ZD04020 06545040 * 06570002 * THE FOLLOWING MESSAGE IS ISSUED IF THERE ARE NO OUTSTANDING 06572002 * REQUESTS (WTONEXIT): 06574002 * IEE111I NO OUTSTANDING REQUESTS 06576002 * 06578002 *02* RETURN-CODES = NONE 06580002 * 06630002 *01* EXIT-ERROR = OPERR -BRANCH TO MESSAGE MODULE (IEE0503D) TO ISSUE 06830002 * OPERAND ERROR MESSAGE. 06880002 * 07030002 *02* CONDITIONS = THIS EXIT IS TAKEN IF AN ERROR IS DETECTED IN THE 07080002 * OPERAND FIELD OF THE DISPLAY COMMAND. 07130002 * 07180002 *02* OUTPUT = AN ERROR CODE INDICATOR IS PASSED TO THE MESSAGE 07230002 * MODULE (IEE0503D) INDICATING THE MESSAGE TO BE ISSUED. 07280002 * 07480002 *02* RETURN-CODES = NONE 07530002 * 07580002 *01* EXTERNAL-REFERENCES = THE FOLLOWING REFERENCES ARE MADE WITHIN 07780002 * THIS MODULE: 07790002 * 07930002 *02* ROUTINES = BRANCH TO SVC 34 MESSAGE MODULE (IEE0503D) TO ISSUE 07980002 * OPERAND ERROR MESSAGE. 07990002 * 08130002 *02* DATA-AREAS = THE FOLLOWING DATA AREAS ARE REFERENCED BY THIS 08180002 * MODULE: 08190002 * USER PARM LIST POINTED TO OUT OF THE XSA (XAR FIELD) 08200002 * XAR POINTS TO THE USER SUPPLIED PARAMETER 08210002 * LIST PASSED TO SVC 34. 08220002 * 08230002 *02* CONTROL-BLOCKS = THIS MODULE REFERS TO THE FOLLOWING CONTROL 08480002 * BLOCKS: 08530002 * CVT (R) 08580002 * ORE (R) 08630002 * PSA (R) 08680002 * WQE (R) 08690002 * UCB (R) 08700002 * XSA (R,W) 08710002 * 08730002 *01* TABLES = THE FOLLOWING TABLES AND WORKAREAS ARE DEFINED WITHIN 08780002 * THIS MODULE: 08790002 * WPL WTO PARM LIST FOR MLWTO MESSAGES 08840002 * NOREQMSG WTO PARM LIST FOR NORMAL WTO MESSAGES 08890002 * XASAVLOC RETURN REGISTER SAVE AREA 08900002 * XASAVSTD 72 BYTE SAVE AREA WHERE: 08910002 * +0 = ADDR OF FIRST MLWTO MESSAGE GROUP 08920002 * (MAX OF 10 LINES PER GROUP) 08922002 * +4 = ADDR OF LAST MLWTO MESSAGE GROUP 08924002 * +8 = TIME OF DAY FROM TIME SVC 08926002 * +12 = ADDR OF NUMBER OF LINES FIELD IN CURRENT MESSAGE 08928002 * GROUP 08928402 * +16 = GENERAL SAVE AREA 08928802 * +20 = GENERAL SAVE AREA 08929202 * +24 = GENERAL SAVE AREA @YM3468P 08929602 * +28 = GENERAL SAVE AREA @YM3468P 08930002 * +32 = RETURN CODE FROM MLWTO @YM3468P 08940002 * +36 = AVAILABLE FOR FUTURE USE @ZD04020 08941040 * +40 = COUNT CONVERSION WORKAREA (OFFSET40) @ZD04020 08943040 * +44 = COUNT CONVERSION WORKAREA (OFFSET44) @ZD04020 08945040 * 08950002 *01* MACROS = THIS MODULE USES THE FOLLOWING SYSTEM MACROS: 08980002 * GETMAIN/FREEMAIN (BRANCH ENTRY),SETLOCK,TIME, 09030002 * TPUT,WTO 09080002 * 09130002 *02* SERIALIZATION = THE LOCAL AND CMS LOCKS ARE USED BY THIS 09180002 * MODULE. 09190002 * 09330002 *01* CHANGE-ACTIVITY = Y02756, Y02893, Y02751, ZD04020 @ZD04020 09380040 * 09530002 *01* MESSAGES = REFER TO EXIT-NORMAL AND ERROR. 09580002 * 09830002 *01* ABEND-CODES = NONE 09880002 **** END OF SPECIFICATIONS ***/ 10080002 EJECT 15600018 WORK1 EQU 0 15800018 WORK2 EQU 1 16000018 WQEREG EQU 1 M2196 16050001 XSAREG EQU 2 REG 2 HAS PTR TO XSA WHEN 2903D GETS CONTROL 16200018 UCBLSREG EQU 3 16400018 LISTIND EQU 3 LIST OPERAND SPECIFIED Y02756 16401002 SW1REG EQU 4 16600018 SW2REG EQU 5 16800018 MSGREG EQU 6 USED AS PTR TO NEXT AVAILABLE SPACE IN MSG AREA 17000018 WORK3 EQU 7 17200018 MSGAD1 EQU 7 PT TO PREVIOUS LINE Y02756 17201002 OREREG EQU 8 PTR TO OPERATOR REPLY ELEMENT (ORE) YM2304 17400001 UCBREG EQU 8 17600018 BASEREG EQU 9 17800018 MSGAD EQU 10 HOLDS PTR TO BEGINNING OF MESSAGE AREA 18000018 SW3REG EQU 11 18200018 WORK4 EQU 12 18600018 WORK5 EQU 13 18800018 EXITREG EQU 14 19000018 EREXITRG EQU 15 ERROR EXIT REGISTER Y02756 19201002 DATALIND EQU 15 DATA LINE INDICATOR Y02756 19202002 RCODEREG EQU 15 RETURN CODE FROM MLWTO @YM3468P 19212002 SPACE 19240018 D0 EQU 0 USED FOR OFFSETS,LENGTHS,ETC. 19280018 D1 EQU 1 OFFSET VALUE Y02756 19281002 D22 EQU 22 OFFSET VALUE Y02756 19286002 D3 EQU 3 * Y02893 19290002 D4 EQU 4 * 19320018 D9 EQU 9 * Y02893 19322002 D24 EQU 24 * Y02893 19326002 D16 EQU 16 OFFSET VALUE Y2756 19328202 D20 EQU 20 OFFSET VALUE Y2756 19328402 L6 EQU 6 LENGTH OF MOVE Y02756 19329002 HALFWORD EQU 16 USED TO SHIFT TJID IN M2047 19330020 DATALLIT EQU 10 DATA LINE LIMIT Y02756 19331002 L2 EQU 2 LENGTH OF MOVE Y02756 19332002 L3 EQU 3 LENGTH OF MOVE Y02756 19333002 L64 EQU 64 CONSTANT VALUE @ZD04020 19334040 D8 EQU 8 OFFSET VALUE Y02756 19335002 D12 EQU 12 OFFSET VALUE Y02756 19336002 SPACE 19360018 * THIS ROUTINE USES TWO REGISTERS AS SWITCHES: THE REGISTERS AND THE 19400002 * MEANING OF THEIR VALUES ARE AS FOLLOWS: 19600018 * 19800018 * SW1REG 0 - NO CONTROL LINE CREATED Y02893 20000002 * 1 - CONTROL LINE CREATED Y02893 20200002 * 20800018 * SW2REG FREE SPACE POINTER OF LABEL LINE Y02893 21000002 * 21800018 MIDMSG EQU 1 23200018 ERRCDE EQU X'05' ERROR CODE Y02756 23201002 EJECT 23241040 ************************************************************** @ZD04020 23281040 * * @ZD04020 23311040 * THE FOLLOWING EQUATES ARE USED IN BUILDING THE LABEL LINE. * @ZD04020 23341040 * * @ZD04020 23371040 ************************************************************** @ZD04020 23401040 SPACE 23481040 D10 EQU 10 CONSTANT OF 10 @ZD04020 23561040 D17 EQU 17 CONSTANT OF 17 @ZD04020 23601040 D23 EQU 23 CONSTANT OF 23 @ZD04020 23641040 D36 EQU 36 CONSTANT OF 36 @ZD04020 23681040 D40 EQU 40 CONSTANT OF 40 @ZD04020 23721040 D41 EQU 41 CONSTANT OF 41 @ZD04020 23761040 D42 EQU 42 CONSTANT OF 42 @ZD04020 23801040 D43 EQU 43 CONSTANT OF 43 @ZD04020 23841040 D44 EQU 44 CONSTANT OF 44 @ZD04020 23881040 D45 EQU 45 CONSTANT OF 45 @ZD04020 23921040 D47 EQU 47 CONSTANT OF 47 @ZD04020 23961040 D99 EQU 99 CONSTANT OF 99 @ZD04020 24001040 D999 EQU 999 CONSTANT OF 999 @ZD04020 24041040 R6 EQU 6 REGISTER 6 @ZD04020 24081040 R7 EQU 7 REGISTER 7 @ZD04020 24121040 R8 EQU 8 REGISTER 8 @ZD04020 24161040 R10 EQU 10 REGISTER 10 @ZD04020 24201040 MINUSA EQU 7 REGISTER 7 @ZD04020 24241040 MINUSB EQU 8 REGISTER 8 @ZD04020 24281040 FOX EQU X'0F' USED FOR SIGN BIT ADJUSTING @ZD04020 24321040 BITTEST EQU X'80' USED FOR PLURAL INDICATOR @ZD04020 24361040 ESS EQU C'S' 'S' CHARACTER @ZD04020 24401040 FOXFOX EQU X'FF' 'S' INSERTION INDICATOR @ZD04020 24441040 MGLTH EQU 748 LENGTH OF GETMAIN @ZD04020 24481040 LL EQU 70 LENGTH OF LABEL TEXT @ZD04020 24521040 LABLEN EQU 74 LABEL LINE LENGTH @ZD04020 24561040 L69 EQU 69 LABEL LINE BLANKING LENGTH @ZD04020 24601040 EJECT 24800018 BALR BASEREG,0 25000018 USING *,BASEREG ESTABLISH ADDRESSABILITY 25200018 MODID BRANCH=YES Y01886 25250001 USING XSA,XSAREG BASE FOR XSA XMCS 25400018 USING PSA,0 BASE FOR PSA Y02756 25400202 SPACE 25401002 *****************************************************************Y02893 25402002 * SETLOCK SEGMENT Y02893 25403002 * Y02893 25404002 * IN ORDER TO SERIALIZE THE USE OF RESOURCES ACROSS DISPLAY Y02893 25405002 * REQUEST PROCESSING, THE FOLLOWING CODE ISSUES SETLOCKS FOR THE Y02893 25406002 * LOCAL AND CMS LOCKS. BEFORE THE LOCKS ARE OBTAINED, THE Y02893 25407002 * OPERAND PORTION OF THE DISPLAY COMMAND IS VALIDITY CHECKED. Y02893 25408002 * IF THE R OPERAND IS NOT FOLLOWED IMMEDIATELY BY A BLANK OR @ZD04020 25409040 * ',LIST ', THE COMMAND IS INVALID AND AN ERROR MESSAGE WILL @ZD04020 25409740 * BE ISSUED. @ZD04020 25410440 * Y02893 25412002 * INPUT: Y02893 25413002 * XSA,PSA Y02893 25414002 * Y02893 25415002 * OUTPUT: Y02893 25416002 * NORMAL - LOCAL AND CMS LOCKS OBTAINED Y02893 25417002 * Y02893 25418002 * ERROR - MESSAGE 'IEE305I COMMAND INVALID' ISSUED BY IEE0503DY02893 25419002 * Y02893 25420002 *****************************************************************Y02893 25421002 SR LISTIND,LISTIND INDICATE NORMAL REQUEST Y02756 25422002 L WORK4,XAL ADDR OF OPERAND FIELD Y02756 25422202 CLI D1(WORK4),BLANK BLANK AFTER OPERAND ? Y02756 25423002 BE NRMRQ YES, ISSUE SETLOCKS Y02756 25424002 CLC D1(L6,WORK4),LISTOP LIST OP SPECIFIED ? Y02756 25425002 BE INDLSOP YES,IND.LIST SPECIFIED Y02756 25463002 CLC D1(L3,WORK4),LISTCH LIST OP ABBREV. ? Y02756 25473002 BNE OPERR NO, OPERAND ERROR Y02756 25502002 INDLSOP LA LISTIND,MIDMSG INDICATE LIST OP SPECIFIED Y02756 25538602 B NRMRQ ISSUE SETLOCKS Y02756 25575202 SPACE 25611802 * IF THE OPERAND FIELD IS INVALID, A BRANCH IS MADE TO THE Y02756 25648402 * MESSAGE MODULE 'IEE0503D' WHERE AN ERROR MESSAGE IS ISSUED Y02756 25685002 SPACE 25721602 OPERR EQU * ERROR PROCESSING Y02756 25758202 MVI XAE,ERRCDE SET ERROR INDICATOR Y02756 25794802 L EREXITRG,ERRTN GET ADDRESS OF ERROR RTN Y02756 25831402 BR EREXITRG BRANCH TO ISSUE MESSAGE Y02756 25868002 *****************************************************************Y02893 25904602 * BRANCH TO MESSAGE MODULE TO ISSUE INVALID COMMAND MESSAGE Y02893 25941202 *****************************************************************Y02893 25977802 SPACE 26014402 NRMRQ EQU * SETLOCK CODE Y02751 26051002 XC XASAVSTD(72),XASAVSTD ZERO SAVE AREA Y02756 26087602 TIME DEC ISSUE TIME Y02756 26124202 ST WORK1,XASAVSTD+D8 SAVE TIME Y02756 26160802 ST EXITREG,XASAVLOC SAVE RETURN ADDRESS Y02751 26197402 SETLOCAL SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, X26234002 RELATED=(ORE,IEE2903D(FRELOCAL)) GET LOCAL LOCK Y02751 26270602 SPACE 26307202 SETCMS SETLOCK OBTAIN,TYPE=CMS,MODE=UNCOND, X26343802 RELATED=(ORE,IEE2903D(FRECMS)) GET CMS LOCK Y02751 26380402 EJECT 26390440 *****************************************************************Y02893 26453602 * START OF ORE SEARCH SEGMENT TO SCAN FOR OUTSTANDING REPLY IDS.Y02893 26490202 *****************************************************************Y02893 26526802 SPACE 26563440 *********************************************************************** 26600018 * REPLY ID SEGMENT Y02893 26601002 * Y02893 26602002 * THE FOLLOEING CODE WILL SCAN THE ORE CHAIN FOR OUTSTANDING Y02893 26603002 * REPLY IDS. IF THE 'LIST' OPERAND IS SPECIFIED, THE OUTSTANDING Y02893 26604002 * REPLY IDS AND THE FIRST 64 BYTES OF THE WTO TEXT WILL BE MOVED Y02893 26605040 * TO THE MESSAGE AREA. IF THE 'LIST' OPERAND IS NOT SPECIFIED, Y02893 26606002 * ONLY THE REPLY IDS WILL BE MOVED. Y02893 26607002 * Y02893 26608002 * INPUT: Y02893 26609002 * ORE,WQE,UCM,XSA,CVT Y02893 26610002 * Y02893 26611002 * OUTPUT: - MSGAD- CONTAINS THE ADDRESS OF THE BEGINNING OF THE Y02893 26612002 * MESSAGE AREA. Y02893 26613002 * Y02893 26614002 * - MSGAD1- CONTAINS THE ADDRESS OF THE PREVIOUS MESSAGE.Y02893 26615002 * Y02893 26616002 * - MSGREG- CONTAINS THE ADDRESS OF THE NEXT AVAILABLE Y02893 26617002 * SPACE IN THE MESSAGE AREA. Y02893 26618002 * Y02893 26619002 *****************************************************************Y02893 26620002 SPACE 2 28200018 SR SW1REG,SW1REG SWITCH ONE IS 0: NO MSG.AT THIS PT. 28400018 SR DATALIND,DATALIND NO DATA LINE CREATED Y02756 28401002 L WORK4,CVTPTR GET PTR TO CVT 29500018 USING CVT,WORK4 ADDRESS CVT 29600018 L WORK4,CVTCUCB GET PTR TO UCM 29700018 DROP WORK4 SET NEW BASE 29800018 USING DRUCM,WORK4 ADDRESSING UCM 29900018 L OREREG,UCMRPYQ GET ORE PTR YM2304 30000001 XC OFFSET40(D4),OFFSET40 ZERO OUT COUNTER @ZD04020 30020040 RPIDTEST EQU * TEST ORE PTR Y02893 30050002 LTR OREREG,OREREG ANY OPERATOR REPLY ELMTS YM2304 30100001 BZ RPIDENDW NO. GO SEARCH UCBS Y02756 30200002 USING OREF,OREREG ADDRESS ORE YM2304 30300001 DROP WORK4 NO ADDRESSABILITY FOR UCM Y02756 30301002 L WORK4,OREOPBUF OBTAIN PTR TO TEMP. BUFFER Y02756 30302002 LTR WORK4,WORK4 REPLY PARIALLY PROCESSED ? Y02756 30303002 BNZ RPIDNEXT YES, GET NEXT ORE Y02756 30304002 TM OREXC,OREBUFC DOM ISSUED FOR ORE ? Y02756 30305002 BO RPIDNEXT YES, GET NEXT ORE Y02756 30306002 L WQEREG,OREWQE GET THE ASSOCIATED WQE YM2304 30350001 USING WQE,WQEREG ADDRESS WQE YM2304 30354001 LTR WQEREG,WQEREG WQE ON CHAIN ? Y02756 30370002 BZ RPIDNEXT NO, GET NEXT ORE Y02756 30380002 TM WQEXA,WQESUSP PROCESSING SUSPENDED ? Y02756 30381002 BO RPIDNEXT YES, GET NEXT ORE Y02756 30382002 LTR SW1REG,SW1REG INITIAL PART OF MSG IN 30900018 BNE RPIDDATL YES. SKIP MOVE OF MSG HDRY02756 31000002 BAL EXITREG,CONTLSEG CREATE CONTROL LINE Y02756 31001002 *****************************************************************Y02893 31002002 * BRANCH TO CONTROL LINE SEGMENT TO CREATE A CONTROL LINE. Y02893 31003002 *****************************************************************Y02893 31004002 RPIDDATL EQU * CHECK DATA LINE INDICATOR Y02756 31005002 LA WORK4,DATALLIT MAX DATA LINES IN MSG GROUP Y02756 31006002 CR DATALIND,WORK4 MAX DATA LINES REACHED ? Y02756 31007002 BL RPIDMOVA NO, MOVE IN REPLY ID Y02756 31008002 BAL EXITREG,NEWMGSEG CREATE NEW MESSAGE GROUP Y02756 31009002 *****************************************************************Y02893 31010002 * BRANCH TO CREATE NEW MESSAGE GROUP. (MAX OF 10 DATA LINES) Y02893 31011002 *****************************************************************Y02893 31012002 RPIDMOVA EQU * FIRST ENTRY ON DATA LINE Y02756 31013002 CR MSGAD,MSGREG FREE SPACE POINTER AND Y02756 31014002 * START OF MSG POINTER EQ ? Y02756 31015002 BNE RPIDMOVE NO, MOVE IN REPLY ID Y02756 31016002 LA MSGREG,D4(MSGREG) ALLOW FOR CONTROL DATA Y02756 31017002 MVC D0(L3,MSGREG),BLANKS START MSG TEXT WITH BLANKS Y02756 31018002 LA MSGREG,D3(MSGREG) ADJUST FREE SPACE PTR Y02756 31019002 RPIDMOVE EQU * MOVE REPLY ID Y02756 31020002 L WORK4,OFFSET40 OBTAIN CURRENT COUNT @ZD04020 31020240 LA WORK4,D1(WORK4) INCREMENT COUNT BY ONE @ZD04020 31020440 ST WORK4,OFFSET40 STORE NEW COUNT @ZD04020 31020640 MVC D0(L2,MSGREG),OREID PUT REPLY ID IN MSG Y02756 31021002 LA MSGREG,D2(MSGREG) ADJUST FREE SPACE PTR Y02756 31022002 LTR LISTIND,LISTIND LIST OPERAND SPECIFIED ? Y02756 31023002 BNZ RPIDLIST YES, PROCESS LIST FUNCTION Y02756 31024002 SR MSGREG,MSGAD DETERMINE NO. OF BYTES USED Y02756 31027002 CH MSGREG,NOROOMID ROOM FOR ANOTHER ID ? Y02756 31028002 BNH RPIDRMLF YES, GET NEXT ORE @ZD04020 31029040 AR MSGREG,MSGAD RESET FREE SPACE POINTER Y02756 31029402 BAL EXITREG,NEWDLSEG GET NEW DATA LINE Y02756 31030002 *****************************************************************Y02893 31031002 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE. Y02893 31032002 *****************************************************************Y02893 31033002 B RPIDNEXT GET NEXT ORE Y02756 31034002 RPIDRMLF EQU * RESTORE FREE SPACE POINTER Y02756 31035002 AR MSGREG,MSGAD RESET POINTER Y02756 31036002 MVC D0(L2,MSGREG),BLANKS FOLLOW ID BY BLANKS @ZD04020 31036340 LA MSGREG,D2(MSGREG) ADJUST FREE SPACE PTR @ZD04020 31036540 RPIDNEXT EQU * GET NEXT ORE ON CHAIN Y02756 31037002 L OREREG,ORELKP POINTER TO NEXT ORE Y02756 31038002 B RPIDTEST GO TEST ORE POINTER Y02756 31039002 RPIDLIST EQU * PROCESS LIST FUNCTION Y02756 31040002 MVI D0(MSGREG),COMMA FOLLOW ID BY COMMA Y02756 31041002 LA MSGREG,D1(MSGREG) ADJUST FREE SPACE PTR Y02756 31042002 L WORK5,WQENBR GET LENGTH OF WTO TEXT Y02756 31044002 LA WORK4,D4 INDEX FOR FIRST TEXT CHAR Y02756 31045002 SR WORK5,WORK4 PTR TO FIRST TEXT CHARACTER Y02756 31046002 LA WORK4,L64 MAX LENGTH OF WTO TEXT @ZD04020 31046440 CR WORK5,WORK4 TEXT LENGTH GREATER THAN MAX Y02756 31047002 BH RPIDTXLG YES, MOVE ONLY 64 CHAR Y02756 31048040 BCTR WORK5,0 PREPARE TO MOVE TEXT Y02756 31049002 EX WORK5,RPIDMVTX MOVE ALL OF TEXT Y02756 31050002 LA WORK5,D1(WORK5) RESET LENGTH VALUE Y02756 31051002 AR MSGREG,WORK5 RESTORE FREE SPACE POINTER Y02756 31052002 B RPIDNEWL GET NEW DATA LINE Y02756 31053002 RPIDTXLG EQU * TEXT LENGTH GREATER THAN 64 Y02756 31054040 LA WORK5,WQETXT+D4 GET ADDR OF START OF TEXT Y02756 31054402 LR WORK4,WORK5 SAVE TEXT POINTER Y02756 31054802 LA WORK4,L64(WORK4) GET ADDR OF 65TH CHARACTER @ZD04020 31054940 CLI D0(WORK4),X'40' 65TH CHARACTER A BLANK Y02756 31055140 BE RPIDMALL MOVE 64 CHARACTERS Y02756 31055340 BCTR WORK4,0 PT TO PREVIOUS CHARACTER Y02756 31055902 RPIDCCHA EQU * CHECK FOR BLANK Y02756 31056302 CLI D0(WORK4),X'40' THIS CHARACTER A BLANK ? Y02756 31056602 BE RPIDCLTH CALCULATE LENGTH Y02756 31057002 BCTR WORK4,0 PT TO PREVIOUS CHARACTER Y02756 31057302 CR WORK4,WORK5 ALL TEXT CHARACTERS CHECKED Y02756 31057702 BH RPIDCCHA NO, CHECK NEXT CHARACTER Y02756 31057802 RPIDMALL EQU * MOVE 64 CHARACTERS Y02756 31057940 LA WORK4,L64 SET LENGTH OF MOVE @ZD04020 31058240 B RPIDCONT EXECUTE MOVE Y02756 31058740 RPIDCLTH EQU * CALCULATE LENGTH OF MOVE Y02756 31058840 SR WORK4,WORK5 SET LENGTH OF MOVE Y02756 31059040 RPIDCONT BCTR WORK4,0 PREPARE TO MOVE TEXT Y02756 31059140 EX WORK4,RPIDMVTX MOVE ONLY UP TO 64 CHARACTERS Y02756 31059240 LA WORK4,D1(WORK4) RESET LENGTH VALUE Y02756 31059540 AR MSGREG,WORK4 RESTORE FREE SPACE POINTER Y02756 31059640 RPIDNEWL EQU * NEW DATA LINE Y02756 31059702 BAL EXITREG,NEWDLSEG GET NEW DATA LINE Y02756 31060002 *****************************************************************Y02893 31061002 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE. Y02893 31062002 *****************************************************************Y02893 31063002 B RPIDNEXT GET NEXT ORE Y02756 31064002 RPIDENDW EQU * @ZD04020 31264040 BAL EXITREG,SUBRTNE GO TO INSERTION SUBROUTINE @ZD04020 31314040 LTR R6,R6 IS COUNT ZERO? @ZD04020 31364040 BZ DONE1 YES, AVOID LABEL INSERTION @ZD04020 31414040 BAL R8,TESTESS TEST FOR 'S' INSERTION @ZD04020 31464040 MVC D0(D8,SW2REG),REPLYID NO, MOVE IN LABEL @ZD04020 31514040 LA SW2REG,D8(SW2REG) INDEX BUFFER PAST LABEL @ZD04020 31564040 LA R7,D1 SET A COMPRAND OF 1 @ZD04020 31614040 CR R6,R7 IS COUNT EQUAL TO 1? @ZD04020 31664040 BE DONE1 YES, AVOID 'S' INSERTION @ZD04020 31714040 MVI D0(SW2REG),ESS NO, MOVE IN A 'S' @ZD04020 31764040 LA SW2REG,D1(SW2REG) INDEX BUFFER PAST 'S' @ZD04020 31814040 BAL R8,MOVEIN PLURALIZE 'REQUEST' @ZD04020 31864040 DONE1 EQU * @ZD04020 31914040 LM R6,R8,XASAVLOC+D4 RESTORE REGISTERS @ZD04020 31964040 LTR SW1REG,SW1REG ANY MSGS ISSUED OR BEING PROCESSED? 35000040 BZ RPIDEXIT YES, BR TO UCB SEARCH Y02756 35200002 CR MSGREG,MSGAD NEW DATA LINE ? Y02756 35201002 BE RPIDEXIT YES, BRANCH TO UCB SEARCH Y02756 35202002 BAL EXITREG,NEWDLSEG GET NEW DATA LINE Y02756 35203002 *****************************************************************Y02893 35204002 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE. Y02893 35205002 *****************************************************************Y02893 35206002 EJECT 35207240 RPIDEXIT EQU * @ZD04020 35707240 *****************************************************************Y02893 36209040 * START OF READY UNITS SEGMENT TO SCAN UCB CHAIN. Y02893 36409040 *****************************************************************Y02893 36609040 SPACE 37009040 *****************************************************************Y02893 37451002 * READY UNITS SEGMENT Y02893 37452002 * Y02893 37453002 * THE FOLLOWING CODE SCANS THE UCB CHAIN LOOKING FOR UCBS WHICH Y02893 37454002 * INDICATE A NOT READY STATE. FOR THOSE UCBS WHICH ARE IN A NOT Y02893 37455002 * READY STATE, A READY UNITS MESSAGE WILL BE ISSUED. BEFORE THE Y02893 37456002 * UNIT NAME IS MOVED INTO THE MESSAGE AREA, A BRANCH IS MADE TO Y02893 37457002 * TEST FOR TWO CHANNEL SWITCH TO ELIMINATE DUPLICATE NAMES. Y02893 37458002 * Y02893 37459002 * INPUT: Y02893 37460002 * CVT,UCB LOOKUP TABLE,UCB Y02893 37461002 * Y02893 37462002 * OUTPUT: CONTINUE NORMAL PROCESSING Y02893 37463002 * Y02893 37464002 *****************************************************************Y02893 37465002 XC OFFSET40(D4),OFFSET40 ZERO OUT COUNTER @ZD04020 37525040 RDUTSRCH SR SW3REG,SW3REG SWITCH 3 IS 0:NO UNIT MSGS YETY02756 37600002 L WORK4,CVTPTR GET CVT ADDRESS 37700018 USING CVT,WORK4 ADDRESS CVT Y02756 37705002 L UCBLSREG,CVTILK2 ADDR OF 2-BYTE UCB PTRS Y02756 38000002 DROP WORK4 38005002 DUMYTEST CLC 0(2,UCBLSREG),ZERO IS THIS A DUMMY UCB? 38200018 BE NEXTUCB IF YES,SKIP AND GET NEXT ONE 38400018 LH UCBREG,0(UCBLSREG) GET UCB ADDRESS 38600018 N UCBREG,ZEROFOX ZERO OUT PROPAGATED BITS 38800018 C UCBREG,ZEROFOX END OF LIST 39000018 BE RDUTUEND GO CHECK FOR INT REQ IF YES Y02756 39200002 *****************************************************************Y02893 39201002 * BRANCH TO THE INTERVENTION REQUIRED SEGMENT TO SCAN UCBS FOR Y02893 39202002 * INTERVENTION REQUIRED MESSAGES. Y02893 39203002 *****************************************************************Y02893 39204002 USING UCB,UCBREG 39400018 TM UCBTBYT3,UCB3TAPE+UCB3DACC TAPE OR DIRECT ACCESS 40000002 BZ NEXTUCB NO. SKIP IT. GET NEXT ONE. 40200002 TM UCBDMCT,UCBMOUNT MOUNT MSG. PENDING? 40400002 BZ DAVV NO, TEST DAVV ISSUED 40600002 TM UCBSTAT,UCBALOC IS UNIT CURRENTLY ALLOCATED 22909 40650002 BZ DAVV NO, TEST DAVV ISSUED 22909 40700002 TM UCBTBYT3,UCB3DACC IS DEVICE DA 40800002 BO TSTSWICH BRANCH TO SET UP MESSAGE IF IT IS 41000002 TM UCBFL1,UCBNRY IS DEVICE READY? 41200002 BZ NEXTUCB GET NEXT UCB IF IT ISN'T 41400018 TSTSWICH LTR SW3REG,SW3REG IS SWITCH THREE 0 41600002 BZ SETUPUM SET UP UNIT MESSAGE IF ZERO 41800018 SETSWIH2 EQU * CHECK DATA LINE INDICATOR Y02756 41805002 LA WORK4,DATALLIT MAX DATA LINES IN MSG GROUP Y02756 41810002 CR DATALIND,WORK4 MAX DATA LINES REACHED ? Y02756 41815002 BL RDUTTSFT NO, TEST FIRST ENTRY Y02756 41820002 BAL EXITREG,NEWMGSEG CREATE NEW MESSAGE GROUP Y02756 41825002 *****************************************************************Y02893 41830002 * BRANCH TO CREATE NEW MESSAGE GROUP. (MAX OF 10 LINES) Y02893 41835002 *****************************************************************Y02893 41840002 RDUTTSFT EQU * FIRST ENTRY ON DATA LINE Y02756 41845002 CR MSGAD,MSGREG FREE SPACE POINTER AND Y02756 41850002 * START OF MSG POINTER EQ ? Y02756 41855002 BNE RDUTTSTW NO, TEST FOR TWO CHANNEL SW Y02756 41860002 LA MSGREG,D4(MSGREG) ALLOW FOR CONTROL DATA Y02756 41865002 MVI D0(MSGREG),X'40' START MSG TEXT WITH BLANK Y02756 41870002 LA MSGREG,D1(MSGREG) ADJUST FREE SPACE POINTER Y02756 41875002 MVC D0(D12,MSGREG),RDYUNITS MOVE IN UNIT HEADER Y02756 41880002 LA MSGREG,D12(MSGREG) ADJUST FREE SPACE POINTER Y02756 41885002 MVC D0(L2,MSGREG),BLANKS FOLLOW HEADER WITH BLANKS Y02756 41890002 LA MSGREG,D2(MSGREG) ADJUST FREE SPACE POINTER Y02756 41895002 RDUTTSTW EQU * TWO CHANNEL SWITCH PROCESSING Y02756 41900002 BAL EXITREG,TWOCHSW TEST FOR TWO CHANNEL SWITCH Y02893 42050002 *****************************************************************Y02893 42051002 * BRANCH TO THE TWO CHANNEL SWITCH SEGMENT TO CHECK FOR Y02893 42052002 * DUPLICATE UNIT NAMES. Y02893 42053002 *****************************************************************Y02893 42054002 SR MSGREG,MSGAD DETERMINE NO. OF BYTES USED Y02756 42054202 CH MSGREG,NOROOMUN ROOM FOR ANOTHER UNITNAME ? Y02756 42054402 BNH RDUTRMLF YES, GET NEXT UCB @ZD04020 42054640 AR MSGREG,MSGAD RESET FREE SPACE PTR Y02756 42054802 BAL EXITREG,NEWDLSEG GET NEW DATA LINE Y02756 42054902 *****************************************************************Y02893 42059902 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE. Y02893 42060902 *****************************************************************Y02893 42061902 B NEXTUCB GET NEXT UCB Y02756 42062902 RDUTRMLF EQU * RESET POINTER Y02756 42063902 AR MSGREG,MSGAD RESET FREE SPACE POINTER Y02756 42064740 MVC 0(2,MSGREG),BLANKS FOLLOW UNIT # BY BLANKS @ZD04020 42072740 LA MSGREG,2(MSGREG) POINT TO NEXT FREE SPACE @ZD04020 42078740 B NEXTUCB GET NEXT UCB Y02893 42092040 DAVV TM UCBTBYT3,UCB3DACC IS DEVICE DA A39479 42100002 BZ NEXTUCB NO- GET NEXT UCB A39479 42150002 TM UCBFL4,UCBWDAV DAVV WAITING FOR MOUNT Y02893 42160002 BO TSTSWICH YES- PUT OUT READY UNIT MSG Y02893 42170002 NEXTUCB LA UCBLSREG,2(UCBLSREG) PT TO NEXT ENTRY IN UCB LIST A39479 42180002 B DUMYTEST BRANCH TO HANDLE IT 42190002 SETUPUM LTR SW1REG,SW1REG INITIAL PART IN MESSAGE 42192002 BC 7,RDUTINIA BRANCH IF YES 42194002 BAL EXITREG,CONTLSEG CREATE CONTROL LINE Y02756 42195002 *****************************************************************Y02893 42195202 * BRANCH TO CONTROL LINE SEGMENT TO CREATE A CONTROL LINE. Y02893 42195402 *****************************************************************Y02893 42195602 RDUTINIA EQU * SET LABEL POINTER Y02756 42196602 LA SW3REG,MIDMSG INDICATE UNIT HEADER SET Y02756 42203202 B SETSWIH2 GO SET SW2 THAT MSG BEING PROCESSED 42237202 RDUTUEND EQU * END UNIT PROCESSING Y02756 42238202 BAL EXITREG,SUBRTNE GO TO INSERTION SUBROUTINE @ZD04020 42240240 LTR R6,R6 IS COUNT ZERO? @ZD04020 42240940 BZ DONE2 YES, AVOID LABEL INSERTION @ZD04020 42241640 BAL R8,TESTESS TEST FOR 'S' INSERTION @ZD04020 42242340 MVC D0(D10,SW2REG),RDYUNITS NO, MOVE IN LABEL @ZD04020 42243040 LA SW2REG,D10(SW2REG) INDEX BUFFER PAST LABEL @ZD04020 42243740 LA R7,D1 SET A COMPRAND OF 1 @ZD04020 42244440 CR R6,R7 IS COUNT EQUAL TO 1? @ZD04020 42245140 BE ONE YES, AVOID 'S' INSERTION @ZD04020 42245840 MVI D0(SW2REG),ESS NO, MOVE IN A 'S' @ZD04020 42246540 LA SW2REG,D1(SW2REG) INDEX BUFFER PAST 'S' @ZD04020 42247240 BAL R8,MOVEIN PLURALIZE 'REQUEST' @ZD04020 42247940 DONE2 EQU * @ZD04020 42248640 LM R6,R8,XASAVLOC+D4 RESTORE REGISTERS @ZD04020 42249340 B FINISHED TEST FOR CONTROL LINE @ZD04020 42250040 SPACE 42252240 ONE EQU * @ZD04020 42254740 L MSGREG,XASAVLOC+D4 RESTORE REGISTER @ZD04020 42255740 LA R8,D8 OBTAIN CONSTANT OF 8 @ZD04020 42256740 LR MINUSA,MSGREG PREPARE FOR NEXT INSTR. @ZD04020 42257740 SR MINUSA,R8 SET MINUS 8 OFFSET @ZD04020 42258740 LR MINUSB,MINUSA PREPARE FOR NEXT INSTR. @ZD04020 42259740 BCTR MINUSB,0 SET MINUS 9 OFFSET @ZD04020 42260740 MVC D0(D8,MINUSB),D0(MINUSA) REMOVE THE 'S' FROM THE *42268740 'READY UNITS' LABEL ON THE DATA LINE @ZD04020 42270740 BCTR MSGREG,0 RESET FREE SPACE POINTER @ZD04020 42272740 LM R7,R8,XASAVLOC+D8 RESTORE REGISTERS @ZD04020 42274740 FINISHED EQU * @ZD04020 42276740 LTR SW1REG,SW1REG CONTROL LINE CREATED? @ZD04020 42278740 BZ IRTEST YES, TEST FOR I.R. @ZD04020 42280740 CR MSGREG,MSGAD NEW DATA LINE? @ZD04020 42282740 BE IRTEST YES, TEST FOR I.R. @ZD04020 42284740 BAL EXITREG,NEWDLSEG GET NEW DATA LINE @ZD04020 42286740 ***************************************************************@ZD04020 42288740 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE @ZD04020 42290740 ***************************************************************@ZD04020 42292740 B IRTEST TEST FOR I.R. @ZD04020 42294740 EJECT 42307240 *****************************************************************Y02893 42317240 * TWO CHANNEL SWITCH SEGMENT Y02893 42327240 * Y02893 42337240 * THE FOLLOWING SEGMENT CHECKS FOR DUPLICATE UNIT NAMES IN CASE Y02893 42347240 * OF A TWO CHANNEL SWITCH. THE UCB LOOKUP TABLE IS RESCANNED Y02893 42357240 * LOOKING FOR DUPLICATE UCB ADDRESSES. IF DUPLICATE ADDRESSES AREY02893 42367240 * FOUND, OMLY ONE ENTRY IS MADE FOR THAT UCB. Y02893 42377240 * Y02893 42387240 * INPUT: Y02893 42397240 * CVT,UCB LOOKUP TABLE,UCB Y02893 42407240 * Y02893 42417240 * OUTPUT: RETURN TO CALLING SEGMENT Y02893 42427240 * Y02893 42437240 *****************************************************************Y02893 42447240 TWOCHSW L WORK4,CVTPTR GET CVT ADDR 42500002 USING CVT,WORK4 42505002 L WORK4,CVTILK2 GET UCB LIST ADDR 42800002 DROP WORK4 42805002 CHKZERO CLC 0(2,WORK4),ZERO IS IT A DUMMY UCB 43000002 BE GETNEXT IF SO, SKIP IT 43200018 LH WORK1,0(WORK4) GET UCB ADDR 43400002 N WORK1,ZEROFOX ZERO OUT PROPAGATED BITS 43500018 C WORK1,ZEROFOX END OF LIST 43505002 BE MOVENAME NO DUPE NAMES...MOVE IN UCB NUMBER 43510002 CR WORK1,UCBREG DO UCB ADDRESSES MATCH 43600018 BE MATCH IF SO, GO CHECK LIST ADDRESSES 43800018 GETNEXT LA WORK4,2(WORK4) POINT TO NEXT LIST ENTRY 44000002 B CHKZERO AND GO CHECK FOR DUMMY UCB 44200018 MATCH CR WORK4,UCBLSREG COMPARE LIST ADDRESSES 44400002 BNE RTPTR RETURN TO CALLER Y02893 44500002 MOVENAME MVC 0(3,MSGREG),UCBNAME MOVE IN UNIT NUMBER 44600018 LA MSGREG,3(MSGREG) INCREMENT FREE SPACE PTR. 44800018 L WORK4,OFFSET40 OBTAIN CURRENT COUNT @ZD04020 47000240 LA WORK4,D1(WORK4) INCREMENT COUNT BY ONE @ZD04020 47000440 ST WORK4,OFFSET40 STORE NEW COUNT @ZD04020 47000640 RTPTR BR EXITREG BR TO HANDLE UCB Y02893 47001002 *****************************************************************Y02893 47002002 * RETURN TO CALLING SEGMENT TO PROCESS THE NEXT UCB. Y02893 47003002 *****************************************************************Y02893 47004002 EJECT 47250002 ***************************************************************@ZD04020 49250040 * START OF INTERVENTION REQUIRED SEGMENT TO SCAN UCB CHAIN @ZD04020 49300040 ***************************************************************@ZD04020 49350040 SPACE 55250040 **************************************************************** Y02893 59300002 * INTERVENTION REQUIRED SEGMENT Y02893 59350002 * Y02893 59352002 * THIS MAINLINE ROUTINE PROCESSES THE INTERVENTION Y02893 59360002 * REQUIRED PORTION OF MESSAGE IEE110I Y02893 59370002 * Y02893 59390002 * THE CONTENTS OF SW3REG MUST BE PRESERVED ACROSS Y02893 59392002 * THIS ROUTINE. Y02893 59394002 * Y02893 59396002 **************************************************************** Y02893 59398002 SPACE 2 59398402 IRTEST EQU * Y02893 59398802 * Y02893 59563202 * THIS SECTION SCANS THE UCB'S FOR THOSE CORRESPONDING Y02893 59565202 * UNITS WITH INTERVENTION REQUIRED Y02893 59565602 * Y02893 59566002 SR SW3REG,SW3REG SWITCH 3 TO 0: NO I R MSG YET Y02893 59566502 L WORK4,CVTPTR CVT... Y02893 59577602 USING CVT,WORK4 59582602 L UCBLSREG,CVTILK2 ADR OF 2-BYTE UCB PTRS Y02756 59588002 DROP WORK4 59588202 XC OFFSET40(D4),OFFSET40 ZERO OUT COUNTER @ZD04020 59588340 DUMTEST EQU * Y02893 59588740 OC D0(D2,UCBLSREG),D0(UCBLSREG) IS THIS A DUMMY UCB Y02893 59588802 LH UCBREG,D0(UCBLSREG) GETADDR OF THIS UCB Y02893 59592502 BZ NXTUCB IF A DUMMY, IGNORE, GET NEXT Y02893 59594502 N UCBREG,ZEROFOX ZERO OUT PROPAGATED BITS Y02893 59594902 C UCBREG,ZEROFOX END OF LIST? Y02893 59595302 BE INRQIEND YES, GO ISSUE MLWTO 59595702 USING UCB,UCBREG UCB ADDRESSABILITY Y02893 59596102 SPACE 59596202 * CHECK FOR INTERVENTION REQUIRED ON UNIT Y02893 59646202 SPACE 59688202 TM UCBFLC,UCBIVRS INT. REQ. MESSAGE ISSUED Y02756 59693202 BNO NXTUCB NO, DOESN'T NEED I R MESSAGE Y02893 59694602 LTR SW3REG,SW3REG I R MESSAGE IN PROCESS Y02893 59695402 BNZ SETSW2IR NO, GO INDICATE I R MESSAGE Y02893 59695802 SETIRM EQU * Y02893 59699202 LTR SW1REG,SW1REG IS MESSAGE ID IN BUFFER Y02893 59701202 BNZ INRQIDNA YES, JUST ADD INTERVENTION Y02893 59701602 * REQUIRED TO THE BUFFER Y02893 59702002 BAL EXITREG,CONTLSEG CREATE CONTROL LINE Y02756 59702202 *****************************************************************Y02893 59702302 * BRANCH TO CONTROL LINE SEGMENT TO CREATE CONTROL LINE. Y02893 59703102 *****************************************************************Y02893 59704102 INRQIDNA EQU * SET LABEL POINTER Y02756 59705202 LA SW3REG,MIDMSG INDICATE UNIT HEADER SET Y02756 59706302 SETSW2IR EQU * Y02893 59712802 LA WORK4,DATALLIT MAX DATA LINES IN MSG GROUP Y02756 59713802 CR DATALIND,WORK4 MAX DATA LINES REACHED ? Y02756 59714602 BL INRQTSFT NO, TEST FIRST ENTRY Y02756 59714802 BAL EXITREG,NEWMGSEG CREATE NEW MESSAGE GROUP Y02756 59715002 *****************************************************************Y02893 59715202 * BRANCH TO CREATE NEW MESSAGE GROUP. (MAX OF 10 LINES) Y02893 59715302 *****************************************************************Y02893 59716302 INRQTSFT EQU * FIRST ENTRY OF DATA LINE Y02756 59717302 CR MSGAD,MSGREG FREE SPACE POINTER AND Y02756 59717402 * START OF MSG POINTER EQ ? Y02756 59718402 BNE INRQTSTW NO, TEST FOR TWO CHANNEL SW Y02756 59719402 LA MSGREG,D4(MSGREG) ALLOW FOR CONTROL DATA Y02756 59719602 MVI D0(MSGREG),X'40' START MSG TEXT WITH BLANK Y02756 59719702 LA MSGREG,D1(MSGREG) ADJUST FREE SPACE POINTER Y02756 59720502 MVC D0(D23,MSGREG),INTREQ MOVE IN INT. REQ. HEADER @ZD04020 59721540 LA MSGREG,D23(MSGREG) ADJUST FREE SPACE POINTER @ZD04020 59721640 MVC D0(L2,MSGREG),BLANKS FOLLOW HEADER WITH BLANKS Y02756 59721840 LA MSGREG,D2(MSGREG) ADJUST FREE SPACE PTR Y02756 59721902 INRQTSTW EQU * TWO CHANNEL SWITCH PROCESSING Y02756 59722102 BAL EXITREG,TWOCHSW TEST FOR TWO CHANNEL SWITCH Y02893 59722602 SPACE 59722802 * THIS UNIT HAS AN INTERVENTION REQUIRED OUTSTANDING; Y02893 59723202 * ADD IT TO THE MESSAGE, AFTER CHECKING FOR THE TWO Y02893 59724002 * CHANNEL SWITCH Y02893 59724802 * Y02893 59726802 SR MSGREG,MSGAD DETERMINE NO. OF BYTES USED Y02756 59727002 CH MSGREG,NOROOMIR ROOM FOR ANOTHER UNITNAME Y02756 59727202 BNH INRQRMLF YES, GET NEXT UCB @ZD04020 59727440 AR MSGREG,MSGAD RESET PTR Y02756 59727602 BAL EXITREG,NEWDLSEG GET NEW DATA LINE Y02756 59727702 B NXTUCB GET NEXT UCB Y02756 59727802 INRQRMLF EQU * ROOM FOR ANOTHER UNITNAME Y02756 59728002 AR MSGREG,MSGAD RESET FREE SPACE POINTER Y02756 59728440 MVC 0(2,MSGREG),BLANKS FOLLOW UNIT # BY BLANKS @ZD04020 59729240 LA MSGREG,2(MSGREG) POINT TO NEXT FREE SPACE @ZD04020 59729940 NXTUCB EQU * GET NEXT UCB Y02893 59731340 LA UCBLSREG,D2(UCBLSREG) GET ADDR OF NEXT UCB Y02893 59732140 B DUMTEST GO EXAMINE THAT UCB Y02893 59732940 INRQIEND EQU * END IR PROCESSING Y02756 59733740 BAL EXITREG,SUBRTNE GO TO INSERTION SUBROUTINE @ZD04020 59734540 LTR R6,R6 IS COUNT ZERO? @ZD04020 59784540 BZ DONE3 YES, AVOID LABEL INSERTION @ZD04020 59834540 BAL R8,TESTESS TEST FOR 'S' INSERTION @ZD04020 59884540 MVC D0(D22,SW2REG),INTREQ NO, MOVE IN LABEL @ZD04020 59934540 LA SW2REG,D22(SW2REG) INDEX BUFFER PAST LABEL @ZD04020 59984540 LA R7,D1 SET A COMPRAND OF 1 @ZD04020 60034540 CR R6,R7 IS COUNT EQUAL TO 1? @ZD04020 60084540 BNE DONE3A NO, DO NOT MAKE IT SINGULAR @ZD04020 60134540 L MSGREG,XASAVLOC+D4 YES, RESTORE REGISTER @ZD04020 60184540 LA R8,D17 OBTAIN CONSTANT OF 17 @ZD04020 60234540 LR MINUSA,MSGREG PREPARE FOR NEXT INSTR. @ZD04020 60284540 SR MINUSA,R8 SET MINUS 17 OFFSET @ZD04020 60334540 LR MINUSB,MINUSA PREPARE FOR NEXT INSTR. @ZD04020 60384540 BCTR MINUSB,0 SET MINUS 18 OFFSET @ZD04020 60434540 MVC D0(D17,MINUSB),D0(MINUSA) REMOVE THE 'S' FROM THE *61374640 'INTERVENTIONS REQUIRED' LABEL ON THE DATA LINE @ZD04020 61414640 BCTR MSGREG,0 RESET FREE SPACE POINTER @ZD04020 61444640 LA R8,D9 OBTAIN CONSTANT OF 9 @ZD04020 61474640 LR MINUSA,SW2REG PREPARE FOR NEXT INSTR. @ZD04020 61504640 SR MINUSA,R8 SET MINUS 9 OFFSET @ZD04020 61534640 LR MINUSB,MINUSA PREPARE FOR NEXT INSTR. @ZD04020 61564640 BCTR MINUSB,0 SET MINUS 10 OFFSET @ZD04020 61594640 MVC D0(D9,MINUSB),D0(MINUSA) REMOVE THE 'S' FROM THE *61694640 'INTERVENTIONS REQUIRED' LABEL ON THE LABEL LINE@ZD04020 61734640 BCTR SW2REG,0 RESET FREE SPACE POINTER @ZD04020 61784640 MVI D0(SW2REG),BLANK BLANK OUT THE TRAILING 'D' @ZD04020 61834640 LM R7,R8,XASAVLOC+D8 RESTORE REGISTERS @ZD04020 61884640 B ALLDONE @ZD04020 61934640 DONE3A EQU * @ZD04020 61984640 BAL R8,MOVEIN PLURALIZE 'REQUEST' @ZD04020 62034640 DONE3 EQU * @ZD04020 62084640 LM R6,R8,XASAVLOC+D4 RESTORE REGISTERS @ZD04020 62134640 ALLDONE EQU * @ZD04020 62184640 LTR SW1REG,SW1REG CONTROL LINE CREATED? @ZD04020 62234640 BZ MLWTOSEG YES, ISSUE MLWTO @ZD04020 62284640 CR MSGREG,MSGAD NEW DATA LINE? @ZD04020 62334640 BE MLWTOSEG YES, ISSUE MLWTO @ZD04020 62384640 BAL EXITREG,NEWDLSEG GET NEW DATA LINE @ZD04020 62434640 ***************************************************************@ZD04020 62484640 * BRANCH TO DATA LINE SEGMENT TO CREATE NEW DATA LINE @ZD04020 62534640 ***************************************************************@ZD04020 62584640 B MLWTOSEG ISSUE MLWTO @ZD04020 62634640 EJECT 65734640 *****************************************************************Y02893 67251002 * CONTROL LINE SEGMENT Y02893 67252002 * Y02893 67253002 * THE FOLLOWING ROUTINE WILL CREATE A CONTROL LINE OR HEADER Y02893 67255002 * LINE FOR A DISPLAY REQUEST. THIS CONTROL LINE WILL BE THE FIRSTY02893 67257002 * LINE IN A MULTI-LINE GROUP. ONLY ONE CONTROL LINE WILL BE Y02893 67259002 * CREATED PER DISPLAY REQUEST. THIS LINE HAS THE FOLLOWING Y02893 67261002 * FORMAT: -A NULL LABEL LINE WILL ALSO BE CREATED.- 67263002 * Y02893 67265002 * IEE110I HH.MM.SS PENDING REQUESTS Y02893 67267040 * Y02893 67269002 * HH.MM.SS = TIME STAMP Y02893 67271040 * Y02893 67273002 * INPUT: Y02893 67275002 * XSA,CVT,WPL Y02893 67277002 * Y02893 67279002 * OUTPUT: NONE Y02893 67281002 * Y02893 67283002 *****************************************************************Y02893 67285002 CONTLSEG EQU * CREATE CONTROL LINE Y02756 67287002 ST WQEREG,XASAVLOC+D4 SAVE WQE POINTER Y02756 67289002 ST SW1REG,XASAVLOC+D8 SAVE LINE IND REG Y02756 67291002 ST WORK3,XASAVLOC+D12 SAVE WORK REG Y02756 67293002 ST LISTIND,XAP SAVE LIST INDICATOR Y02756 67295002 ST EXITREG,XAD SAVE RETURN REG Y02756 67297002 L SW1REG,PSATOLD GET ADDR OF TCB Y02756 67299002 L WORK3,PSAAOLD GET ADDR OF ASCB Y02756 67301002 SR WORK2,WORK2 GETMAIN INTERFACE Y02756 67303002 LA MSGREG,MGLTH LENGTH OF GETMAIN Y02756 67305002 GETMAIN RU,LV=(MSGREG),SP=229,BRANCH=YES GET CORE Y02756 67307002 LR MSGAD,WORK2 SAVE ADDR OF CORE Y02756 67309002 LR WORK1,MSGAD SET TO LOCATION Y02756 67309202 LA WORK2,MGLTH SET LENGTH OF TO LOC Y02756 67309402 LR SW1REG,MSGAD SET FROM LOCATION Y02756 67309602 SR SW2REG,SW2REG CLEAR REGISTER Y02756 67309802 MVCL WORK1,SW1REG CLEAR MSG AREA Y02756 67310002 L WQEREG,XASAVLOC+D4 RESTORE WQE REG Y02756 67311002 L SW1REG,XASAVLOC+D8 RESTORE LINE IND REG Y02756 67313002 L WORK3,XASAVLOC+D12 RESTORE WORK REG Y02756 67315002 L LISTIND,XAP RESTORE LIST INDICATOR Y02756 67317002 LA SW1REG,MIDMSG INDICATE CONTROL LINE CREATED Y02756 67319002 ST MSGAD,XASAVSTD STORE ADDR OF MSG GROUP Y02756 67321002 ST MSGAD,XASAVSTD+D4 STORE ADDR OF MSG GROUP Y02756 67321502 SR WORK4,WORK4 ZERO WORK REGISTER Y02756 67322002 ST WORK4,D0(MSGAD) ZERO LINK POINTER Y02756 67322502 LA MSGAD,D4(MSGAD) START LINE AFTER LINK PTR Y02756 67322602 LA DATALIND,D1(DATALIND) INDICATE DATA LINE CREATED Y02756 67323002 USING WPLRF,MSGAD ADDRESSABILITY FOR WPL COMMON Y02756 67325002 LA WORK4,37 LENGTH OF CONTROL LINE PLUS 4 Y02756 67327002 STH WORK4,WPLLGH STORE LENGTH IN WPL Y02756 67329002 OI WPLMCSF1,WPLMCSFA+WPLMCSFB SET MCS FLAGS Y02756 67331002 OI WPLMCSF2,WPLMCSFJ INDICATE MLWTO Y02756 67333002 LA MSGREG,WPLTXT ADDRESS OF TEXT FIELD Y02756 67335002 MVC D0(D8,MSGREG),MSG1CODD MOVE IN MSG ID Y02756 67336002 LA MSGREG,D8(MSGREG) ADJUST FREE SPACE PTR Y02756 67337002 UNPK XASAVSTD+D24(7),XASAVSTD+D8(4) UNPACK AND MOVE Y02756 67339002 MVC D0(L2,MSGREG),XASAVSTD+D24 MOVE 2 BYTES OF TIME Y02756 67340002 MVI D2(MSGREG),X'4B' INSERT PERIOD Y02756 67340202 MVC D3(L2,MSGREG),XASAVSTD+26 MOVE 2 BYTES OF TIME Y02756 67340402 MVI 5(MSGREG),X'4B' INSERT PERIOD Y02756 67340602 MVC L6(L2,MSGREG),XASAVSTD+28 MOVE 2 BYTES OF TIME Y02756 67340802 MVI D8(MSGREG),X'40' INSERT BLANK Y02756 67341002 LA MSGREG,D9(MSGREG) ADJUST FREE SPACE POINTER Y02756 67343002 MVC D0(HDLTH,MSGREG),MSG1CODE MOVE IN HEADER Y02756 67345002 LA MSGREG,HDLTH(MSGREG) ADJUST FREE SPACE POINTER Y02756 67347002 LR R10,MSGREG OBTAIN CONTROL LINE END @ZD04020 67347540 BCTR R10,0 BACK UP TO THE BLANK SPACE @ZD04020 67347840 ST R10,OFFSET36 SAVE FOR LATER FILL-IN @ZD04020 67348140 DROP MSGAD Y02756 67349002 USING WPLRF,MSGREG WPL ROUT AND DESC CODES Y02756 67351002 OI WPLDESC1,WPLDESCE+WPLDESCH SET DESC CODES Y02756 67353002 OI WPLDESC2,WPLDESCI DESC CODE 9 Y02756 67355002 MVC WPLROUT(L2),ZEROS ZERO ROUT CODES Y02756 67357002 LA MSGREG,D4(MSGREG) ADJUST FREE SPACE POINTER Y02756 67359002 * MLWTO EXTENSION Y02756 67361002 OI WPLLTF1,WPLLTFA INDICATE CONTROL LINE Y02756 67363002 OI WPLLTF2,X'00' ZERO SECOND BYTE Y02756 67365002 MVC WPLAREA(D1),XASDID INSERT AREA ID Y02756 67367002 LA WORK4,WPLLINES SAVE ADDRESS OF LINE IND Y02756 67369002 ST WORK4,XASAVSTD+D12 SAVE IN XSA Y02756 67370002 OI WPLLINES,X'0A' INDICATE TEN LINES IN MLWTO Y02756 67371002 LA MSGREG,D4(MSGREG) ADJUCT FREE SPACE POINTER Y02756 67373002 * START OF LABEL LINE Y02756 67375002 LA WORK4,LABLEN MAX LENGTH OF LABEL LINE @YM7246P 67377002 STH WORK4,WPLML0 STORE LENGTH IN WPL Y02756 67379002 OI WPLMLLT1,WPLMLLTB INDICATE LABEL LINE Y02756 67381002 OI WPLMLLT2,X'00' ZERO SECOND BYTE Y02756 67383002 LA MSGREG,D4(MSGREG) ADJUST FREE SPACE POINTER Y02756 67385002 MVI D0(MSGREG),BLANK BLANK OUT LABEL LINE TEXT Y02756 67387002 MVC D1(L69,MSGREG),D0(MSGREG) BLANK FIELD @ZD04020 67389040 MVC D0(D8,MSGREG),SUMMARY MOVE 'SUMMARY:' IN @ZD04020 67389540 LA SW2REG,D8(MSGREG) ADJUST FREE SPACE POINTER @ZD04020 67390040 LA DATALIND,D1(DATALIND) IND ANOTHER LINE CREATED Y02756 67391002 LA MSGREG,LL(MSGREG) PT TO DATA LINE Y02756 67397002 LR MSGAD,MSGREG SAVE START OF DATA LINE Y02756 67400002 L EXITREG,XAD RESTORE RETURN REG Y02756 67402002 BR EXITREG RETURN TO CALLER Y02756 67404002 EJECT 67404240 ************************************************************** @ZD04020 67404340 * * @ZD04020 67405340 * THIS SUBROUTINE IS ENTERED TO PROCESS THE COUNT AND INSERT * @ZD04020 67406340 * SUCH COUNT INTO THE LABEL LINE BUFFER BEFORE THE INSERTION * @ZD04020 67407340 * OF ITS ASSOCIATED LABEL. * @ZD04020 67408340 * * @ZD04020 67409340 ************************************************************** @ZD04020 67410340 SPACE 67413040 SUBRTNE EQU * @ZD04020 67414040 STM R6,R8,XASAVLOC+D4 SAVE REGISTERS @ZD04020 67415040 L R6,OFFSET40 OBTAIN COUNT VALUE @ZD04020 67416040 LTR R6,R6 IS THERE A COUNT? @ZD04020 67417040 BZ RETURN NO, EXIT @ZD04020 67418040 XC OFFSET40(D8),OFFSET40 ZERO OUT WORK STORAGE @ZD04020 67419040 CVD R6,OFFSET40 CONVERT COUNT TO DECIMAL @ZD04020 67420040 OI OFFSET47,FOX SET SIGN BIT FOR UNPACK @ZD04020 67421040 UNPK OFFSET40(D4),OFFSET45(D3) UNPACK THE COUNT @ZD04020 67422040 TR OFFSET40(D4),TABLE ASSURE CORRECT CHARACTERS @ZD04020 67423040 MVC OFFSET44(D1),OFFSET43 SET UP ONE DIGIT @ZD04020 67424040 SR R7,R7 SET DIGIT COUNT @ZD04020 67425040 LA R8,D9 OBTAIN '9' COMPRAND @ZD04020 67426040 CR R6,R8 LESS THAN '10'? @ZD04020 67427040 BNH COUNTSET YES, INDICATE 1 DIGIT @ZD04020 67428040 LA R7,D1(R7) NO, INDICATE NOT 1 DIGIT @ZD04020 67429040 MVC OFFSET44(D2),OFFSET42 SET UP TWO DIGITS @ZD04020 67430040 LA R8,D99 OBTAIN '99' COMPRAND @ZD04020 67431040 CR R6,R8 LESS THAN '100'? @ZD04020 67432040 BNH COUNTSET YES, INDICATE 2 DIGITS @ZD04020 67433040 LA R7,D1(R7) NO, INDICATE NOT 2 DIGITS @ZD04020 67434040 MVC OFFSET44(D3),OFFSET41 SET UP THREE DIGITS @ZD04020 67435040 LA R8,D999 OBTAIN '999' COMPRAND @ZD04020 67436040 CR R6,R8 LESS THAN '1000'? @ZD04020 67437040 BNH COUNTSET YES, INDICATE 3 DIGITS @ZD04020 67438040 LA R7,D1(R7) NO, INDICATE 4 DIGITS @ZD04020 67439040 MVC OFFSET44(D4),OFFSET40 SET UP FOUR DIGITS @ZD04020 67440040 COUNTSET EQU * @ZD04020 67441040 LA SW2REG,D2(SW2REG) ADJUST FREE SPACE POINTER @ZD04020 67442040 EX R7,MOVECHAR MOVE VALUE INTO BUFFER @ZD04020 67443040 LA SW2REG,D2(R7,SW2REG) INDEX BUFFER PAST VALUE @ZD04020 67444040 RETURN EQU * @ZD04020 67445040 BR EXITREG RETURN TO IN-LINE CODE @ZD04020 67446040 EJECT 67456240 ************************************************************** @ZD04020 67456440 * * @ZD04020 67456540 * THIS SUBROUTINE IS ENTERED TO DETERMINE IF THE WORD * @ZD04020 67456640 * 'REQUEST' IN THE CONTROL LINE SHOULD BE PLURALIZED OR NOT. * @ZD04020 67456740 * * @ZD04020 67456840 ************************************************************** @ZD04020 67456940 SPACE 67457640 TESTESS EQU * @ZD04020 67460040 TM OFFSET36,BITTEST A PREVIOUS INDICATOR SET? @ZD04020 67461040 BO MOVEIN YES, INSERT THE 'S' @ZD04020 67462040 OI OFFSET36,BITTEST NO, INDICATE FOR NEXT PASS @ZD04020 67463040 BR R8 RETURN TO CALLER @ZD04020 67464040 MOVEIN EQU * @ZD04020 67465040 TM OFFSET36,FOXFOX 'S' ALREADY INSERTED? @ZD04020 67466040 BNO MOVEINA NO, PROCEED FOR INSERTION @ZD04020 67467040 BR R8 YES, RETURN TO CALLER @ZD04020 67468040 MOVEINA EQU * @ZD04020 67469040 L R7,OFFSET36 OBTAIN CONTROL LINE POINTER @ZD04020 67470040 LA R7,D0(R7) CLEAR HIGH ORDER BYTE @ZD04020 67471040 MVI D0(R7),ESS MOVE IN THE 'S' CHARACTER @ZD04020 67472040 MVI OFFSET36,FOXFOX INDICATE 'S' INSERTED @ZD04020 67473040 BR R8 RETURN TO CALLER @ZD04020 67474040 EJECT 67485540 *****************************************************************Y02893 67486040 * NEW DATA LINE SEGMENT Y02893 67487040 * Y02893 67488040 * THE FOLLOWING SEGMENT WILL CREATE A NEW DATA LINE AND SET Y02893 67490040 * THE MLWTO CONTROL DATA IN THE CURRENT DATA LINE. THE LENGTH Y02893 67492040 * OF THE TEXT AREA WILL BE CALCULATED AND STORED AND A POINTER Y02893 67494540 * TO THE CURRENT DATA LINE WILL BE SAVED (MSGAD1). Y02893 67496540 * Y02893 67498540 *****************************************************************Y02893 67500540 NEWDLSEG EQU * CREATE NEW DATA LINE Y02756 67502540 ST EXITREG,XAD SAVE RETURN REGISTER Y02756 67506540 LR WORK4,MSGREG PTR TO LAST TEXT CHAR Y02756 67508540 SR WORK4,MSGAD CALCULATE LENGTH OF LINE Y02756 67509540 LTR DATALIND,DATALIND FIRST DATA LINE OF A Y02756 67512540 * CONNECTING MLWTO ? Y02756 67514540 BNZ NEWDNOCN NO, PROCESS REGULAR DATA LINE Y02756 67515540 DROP MSGREG GET TO WPL COMMON Y02756 67518540 USING WPLRF,MSGAD WPL MCS FIELDS Y02756 67519540 STH WORK4,WPLLGH STORE LENGTH OF LINE Y02756 67522540 OI WPLMCSF1,X'00' ZERO BYTE OF MCS FIELD Y02756 67523540 OI WPLMCSF2,WPLMCSFJ INDICATE MLWTO Y02756 67526540 DROP MSGAD GET TO WPL MLWTO EXTENSION Y02756 67528540 USING WPLRF,MSGREG WPL LINE TYPE FIELD Y02756 67530540 OI WPLLTF1,WPLLTFC INDICATE DATA LINE Y02756 67532540 MVC WPLLTF2(L2),ZEROS ZERO SECOND BYTE OF LINE TYPE Y02756 67534540 * AND AREA ID FIELD Y02756 67536540 LA WORK4,WPLLINES SAVE ADDR OF LINE INDICATOR Y02756 67538540 ST WORK4,XASAVSTD+D12 SAVE IN XSA Y02756 67540540 OI WPLLINES,X'0A' INDICATE TEN LINES IN MLWTO Y02756 67542540 LA MSGREG,D4(MSGREG) ADJUST FREE SPACE POINTER Y02756 67544540 * START OF DATA LINE Y02756 67548540 B NEWDEXIT BR TO RESET POINTERS Y02756 67550540 NEWDNOCN EQU * PROCESS REGULAR DATA LINE Y02756 67551540 DROP MSGREG GET TO WPL COMMON Y02756 67554540 USING WPLRF,MSGAD WPL MCS FIELDS Y02756 67556540 STH WORK4,WPLML0 STORE LENGTH OF LINE Y02756 67557540 OI WPLMLLT1,WPLMLLTC INDICATE DATA LINE Y02756 67559540 OI WPLMLLT2,X'00' ZERO SECOND BYTE Y02756 67562540 DROP MSGAD GET TO ADDITIONAL MLWTO LINE Y02756 67564540 USING WPLRF,MSGREG ADDRESS LENGTH FIELD Y02756 67565540 NEWDEXIT EQU * RESET POINTER Y02756 67568540 LR MSGAD1,MSGAD SET ADDR OF PREVIOUS LINE Y02756 67570540 LR MSGAD,MSGREG SET ADDR OF CURRENT LINE Y02756 67572540 LA DATALIND,D1(DATALIND) INDICATE DATA LINE CREATED Y02756 67574540 L EXITREG,XAD RESTORE RETURN REGISTER Y02756 67576540 BR EXITREG RETURN TO CALLER Y02756 67578540 EJECT 67580540 *****************************************************************Y02893 67582540 * NEW MESSAGE GROUP SEGMENT Y02893 67585540 * Y02893 67586540 * THE FOLLOWING SEGMENT WILL CREATE A MESSAGE GROUP (ANOTHER Y02893 67590540 * MULTI-LINE WHICH CONNECTS WITH THE FIRST MULTI-LINE). THE Y02893 67591540 * ADDRESS OF THE FIRST AND LAST MLWTO WILL BE SAVED IN THE XSA. Y02893 67593540 * THE FIRST 4 BYTES OF EACH MLWTO MESSAGE GROUP CONTAINS A Y02893 67595540 * POINTER TO THE NEXT MESSAGE GROUP ON THE CHAIN OR ZERO. Y02893 67597540 * Y02893 67600040 * INPUT: Y02893 67602040 * XSA,PSA Y02893 67604040 * Y02893 67606040 * OUTPUT: NEW MLWTO MESSAGE GROUP CREATED. Y02893 67608040 * Y02893 67610040 *****************************************************************Y02893 67612040 NEWMGSEG EQU * CREATE NEW MESSAGE GROUP Y02893 67614040 ST WQEREG,XASAVLOC+D4 SAVE WQE POINTER Y02756 67616040 ST SW1REG,XASAVLOC+D8 SAVE LINE IND REG Y02756 67618040 ST WORK3,XASAVLOC+D12 SAVE WORK REG Y02756 67620040 ST LISTIND,XAP SAVE LIST INDICATOR Y02756 67624040 ST EXITREG,XAD SAVE RETURN REGISTER Y02756 67626040 L SW1REG,PSATOLD GET ADDR OF TCB Y02756 67628040 L WORK3,PSAAOLD GET ADDR OF ASCB Y02756 67630040 SR WORK2,WORK2 GETMAIN INTERFACE Y02756 67632040 LA MSGREG,MGLTH LENGTH OF GETMAIN Y02756 67634040 GETMAIN RU,LV=(MSGREG),SP=229,BRANCH=YES GET CORE Y02756 67636040 LR MSGAD,WORK2 SAVE ADDR OF CORR Y02756 67638040 ST WORK1,XASAVSTD+D16 SAVE WORK REG Y02756 67640040 ST SW2REG,XASAVSTD+D20 SAVE LABEL LINE PTR Y02756 67642040 LR WORK1,MSGAD SET TO LOCATION Y02756 67644040 LA WORK2,MGLTH SET LENGTH OF TO LOC Y02756 67646040 LR SW1REG,MSGAD SET FROM LOCATION Y02756 67648040 SR SW2REG,SW2REG CLEAR REFISTER Y02756 67649640 MVCL WORK1,SW1REG ZERO MSG AREA Y02756 67652040 L WORK1,XASAVSTD+D16 RESTORE WORK REG Y02756 67654040 L SW2REG,XASAVSTD+D20 RESTORE LABEL LINE PTR Y02756 67656040 L WQEREG,XASAVLOC+D4 RESTORE BLOCK POINTER Y02756 67658040 L SW1REG,XASAVLOC+D8 RESTORE LINE IND REG Y02756 67660040 L WORK3,XASAVLOC+D12 RESTORE WORK REG Y02756 67662040 L LISTIND,XAP RESTORE LIST INDICATOR Y02756 67666040 L WORK4,XASAVSTD+D4 GET ADDR OF LAST MLWTO Y02756 67668040 ST MSGAD,D0(WORK4) STORE ADDR NEW MLWTO IN LINKPTY02756 67670040 ST MSGAD,XASAVSTD+D4 STORE ADDR NEW MLWTO IN LASTPTY02756 67672040 SR WORK4,WORK4 ZERO WORK REGISTER Y02756 67674040 ST WORK4,D0(MSGAD) ZERO NEW MLWTO LINK PTR Y02756 67676040 LA MSGAD,D4(MSGAD) START LINE AFTER LINK PTR Y02756 67678040 SR DATALIND,DATALIND IND CONNECTING DATA LINE Y02756 67680040 LR MSGREG,MSGAD SET START OF DATA LINE Y02756 67682040 L EXITREG,XAD RESTORE RETURN REGISTER Y02756 67684040 BR EXITREG RETURN TO CALLER Y02756 67686040 EJECT 67688040 *****************************************************************Y02893 67690040 * FREE LOCK SEGMENT Y02893 67692040 * Y02893 67694040 * THE FOLLOWING SEGMENT ISSUES SETLOCKS TO RELEASE THE CMS AND Y02893 67696040 * LOCAL LOCKS. Y02893 67698040 * Y02893 67700040 * INPUT: Y02893 67702040 * XSA,PSA Y02893 67706040 * Y02893 67708040 * OUTPUT: - LOCAL AND CMS LOCKS RELEASED Y02893 67710040 * Y02893 67712040 *****************************************************************Y02893 67714040 FRELOCK EQU * FREE LOCK SEGMENT Y02893 67716040 ST EXITREG,XAD SAVE RETURN REGISTER Y02756 67718040 ST SW3REG,XASAVLOC+D4 SAVE REGISTER 11 Y02756 67720040 ST WORK4,XASAVLOC+D8 SAVE REGISTER 12 Y02756 67722040 ST WORK5,XASAVLOC+D12 SAVE REGISTER 13 Y02756 67724040 FRECMS SETLOCK RELEASE,TYPE=CMS, Y02751X67726040 RELATED=(ORE,IEE2903D(SETCMS)) RELEASE CMS LOCK Y02751 67728040 FRELOCAL SETLOCK RELEASE,TYPE=LOCAL, Y02751X67730040 RELATED=(ORE,IEE2903D(SETLOCAL)) RELEASE LOCAL LOCY02751 67732040 L WORK5,XASAVLOC+D12 RESTORE REG 13 Y02756 67734040 L WORK4,XASAVLOC+D8 RESTORE REG 12 Y02756 67736040 L SW3REG,XASAVLOC+D4 RESTORE REG 11 Y02756 67738040 L EXITREG,XAD RESTORE RETURN REG Y02756 67740040 BR EXITREG RETURN TO CALLER Y02756 67742040 EJECT 67744040 ***************************************************************@ZD04020 67746040 * START OF MLWTO SEGMENT TO ISSUE MULTI-LINES @ZD04020 67748040 ***************************************************************@ZD04020 67750040 SPACE 67754040 *****************************************************************Y02893 67756040 * MULTI-LINE SEGMENT Y02893 67758040 * Y02893 67760040 * THE FOLLOWING SEGMENT WILL ISSUE MLWTOS FOR EACH MESSAGE GROUP Y02893 67761040 * CREATED. IF THERE ARE NO OUTSTANDING REQUEST,A NORMAL WTO WILL Y02893 67764040 * BE ISSUED INDICATING THAT THERE ARE NO OUTSTANDING REQUEST. Y02893 67766040 * IF THE DISPLAY REQUEST WAS ISSUED BY A TSO TERMINAL, THE Y02893 67768040 * OUTSTANDING REQUEST WILL BE ROUTED TO THE TSO TERMINAL VIA Y02893 67770040 * TPUTS. WHEN ALL THE ASSOCIATED MESSAGES HAVE BEEN ISSUED, Y02893 67771340 * ALL GOTTEN CORE WILL BE FREED AND CONTROL RETURNED TO THE Y02893 67774040 * CALLER. Y02893 67776040 * Y02893 67778040 * INPUT: Y02893 67780040 * XSA,PSA,CVT,WPL Y02893 67782040 * - MSGAD1 - POINTER TO THE PREVIOUS MESSAGE LINE Y02893 67784040 * Y02893 67786040 * OUTPUT: - MLWTO OR TPUT ISSUED FOR ALL OUTSTANDING REQUESTS. Y02893 67790040 * Y02893 67792040 *****************************************************************Y02893 67794040 MLWTOSEG EQU * START OF MLWTO SEGMENT Y02756 67796040 L SW3REG,XASAVSTD+D12 GET ADDR OF # OF LINES Y02756 67797040 LTR SW1REG,SW1REG CONTROL LINE CREATED ? Y02756 67800040 BNZ MLWTNRMR YES, MLWTO PROCESSING Y02756 67802040 BAL EXITREG,WTONORMR PROCESS NORMAL WTO Y02893 67804040 *****************************************************************Y02893 67806040 * BRANCH TO WTO NORMAL SEGMENT TO ISSUE 'NO OUTSTANDING Y02893 67808040 * REQUESTS' MESSAGE. Y02893 67809040 *****************************************************************Y02893 67812040 B MLWTOEND END WTO PROCESSING Y02756 67814040 MLWTNRMR EQU * PROCESS MULTI-LINE Y02756 67816040 STC DATALIND,D0(SW3REG) STORE # OF LINES IN MSG AREA Y02756 67818040 LA WORK4,MIDMSG ONE DATA LINE EQ CONNECTOR LINY02756 67820040 CR DATALIND,WORK4 CONNECTING DATA LINE ? Y02756 67822040 BE MLWTCONL YES, PROCESS CONNECTOR Y02756 67824040 LR MSGREG,MSGAD1 GET ADDR OF PREVIOUS LINE Y02756 67826040 OI WPLMLLT1,WPLMLLTD INDICATE DATA END LINE Y02756 67828040 B MLWTLCRL RELEASE ALL LOCKS Y02756 67832040 MLWTCONL EQU * PROCESS CONNECTING DATA LINE Y02756 67834040 LR MSGREG,SW3REG GET ADDR OF # LINES FIELD Y02756 67836040 LA WORK4,L3 ADDR LINE TYPE LIELD Y02756 67838040 SR MSGREG,WORK4 PT TO LINE TYPE FIELD Y02756 67840040 OI WPLLTF1,WPLLTFD INDICATE DATA END LINE Y02756 67842040 MLWTLCRL EQU * RELEASE LOCKS Y02756 67844040 BAL EXITREG,FRELOCK RELEASE LOCAL AND CMS LOCKS Y02756 67846040 *****************************************************************Y02756 67848040 * BRANCH TO FREE LOCK SEGMENT TO RELEASE THE LOCAL AND CMS LOCKS Y02893 67850040 *****************************************************************Y02893 67853040 CLC XAA(D2),ZEROS TSO TERMINAL REQUEST ? Y02756 67853240 BNZ MLWTTSOT YES, PUT MSG TO TERMINAL Y02756 67856040 L MSGAD1,XASAVSTD GET ADDR OF FIRST MSG GROUP Y02756 67858040 LA MSGAD,D4(MSGAD1) POINT TO START OF MESSAGE Y02756 67860040 SR WORK1,WORK1 CLEAR REG0 FOR CONSOLE ID Y02756 67862040 IC WORK1,XASCID SET CONSOLE ID IN REG Y02756 67864040 WTO MF=(E,(MSGAD)) ISSUE WTO Y02756 67866040 LR WORK4,WORK2 SAVE MLID FOR CONNECTOR Y02756 67868040 SLL WORK4,D8 MLID TO 3 RIGHT MOST BYTES Y02756 67870040 MLWTNEXT EQU * PREPARE TO FREE AREA Y02756 67872040 STH RCODEREG,XASAVSTD+32 SAVE RCODE FROM MLWTO @YM3468P 67874040 L MSGREG,D0(MSGAD1) SAVE ADDR OF NEXT GROUP Y02756 67876040 LA WORK5,MGLTH LENGTH OF FREEMAIN Y02756 67878040 FREEMAIN RU,LV=(WORK5),A=(MSGAD1),SP=229 FREE AREA Y02756 67880040 LTR MSGREG,MSGREG LAST MESSAGE GROUP ? Y02756 67882040 BZ MLWTOEND END WTO PROCESSING Y02756 67884040 CLC ZEROS(2),XASAVSTD+32 RCODE FROM MLWTO 0? @YM3468P 67886040 BNE MLWTOEND NO - TERMINATE @YM3468P 67888040 LR MSGAD1,MSGREG GET ADDR OF NEXT MSG GROUP Y02756 67890040 LA MSGAD,D4(MSGAD1) POINT TO START OF MESSAGE Y02756 67892040 LR WORK1,WORK4 MOVE MLID TO REG 0 Y02756 67894040 IC WORK1,XASCID SET CONSOLE ID IN REG Y02756 67896040 WTO MF=(E,(MSGAD)) ISSUE WTO Y02756 67898040 B MLWTNEXT GO ISSUE FREEMAIN Y02756 67900040 MLWTTSOT EQU * TERMINAL REQUEST Y02756 67902040 L MSGAD1,XASAVSTD GET ADDR OF FIRST MSG GRUOP Y02756 67904040 LA MSGAD,D4(MSGAD1) POINT TO START OF MESSAGE Y02756 67906040 LH WORK4,D0(MSGAD) GET LENGTH OF TEXT Y02756 67908040 LA SW3REG,D4(MSGAD) GET ADDR OF TEXT Y02756 67910040 AR SW3REG,WORK4 POINT TO END OF TEXT Y02756 67912040 MLWTTSOB EQU * BYPASS LINK FIELD Y02756 67914040 LA SW3REG,D3(SW3REG) PT TO NO. OF LINES IN GROUP Y02756 67916040 LA SW1REG,D1(SW3REG) SAVE POINTER TO NEXT LINE Y02756 67918040 SR WORK5,WORK5 CLRAR WORK REG Y02756 67920040 IC WORK5,D0(SW3REG) GET # OF LINES IN GROUP Y02756 67922040 LR SW3REG,WORK5 SAVE # OF LINES IN GROUP Y02756 67924040 MLWTTSOA EQU * PREPARE TO ISSUE TPUT Y02756 67926040 LH WORK1,XAA GET TERMINAL ID Y02756 67928040 SLL WORK1,HALFWORD TERMINAL ID IN LEFT MOST BYTESY02756 67930040 LA WORK5,D4 SET TRUE LENGTH Y02756 67932040 SR WORK4,WORK5 SUBTRACT 4 FROM LENGTH Y02756 67934040 OR WORK1,WORK4 SET TERMINAL ID AND LENGTH Y02756 67936040 LA WORK2,D4(MSGAD) POINT TO START OF TEXT Y02756 67938040 TPUT (WORK2),(WORK1),R PUT MESSAGE TO TERMINAL Y02756 67940040 BCTR SW3REG,0 SUBTRACT ONE FROM # OF LINES Y02756 67942040 LTR SW3REG,SW3REG ANY MORE LINES ? Y02756 67944040 BZ MLWTTSOD PREPARE TO FREE AREA Y02756 67946040 LR MSGAD,SW1REG GET ADDR OF NEXT LINE Y02756 67948040 LH WORK4,D0(SW1REG) GET LENGTH OF NEXT LINE Y02756 67950040 AR SW1REG,WORK4 RESET POINTER TO NEXT LINE Y02756 67952040 B MLWTTSOA PREPARE TO ISSUE TPUT Y02756 67954040 MLWTTSOD EQU * PREPARE TO FREE AREA Y02756 67956040 L MSGREG,D0(MSGAD1) SAVE ADDR OF NEXT GROUP Y02756 67958040 LA WORK5,MGLTH LENGTH OF FREEMAIN Y02756 67960040 FREEMAIN RU,LV=(WORK5),A=(MSGAD1),SP=229 FREE AREA Y02756 67962040 LTR MSGREG,MSGREG LAST MESSAGE GROUP ? Y02756 67964040 BZ MLWTOEND END WTO PROCESSING Y02756 67966040 LR MSGAD1,MSGREG GET ADDR OF NEXT GROUP Y02756 67968040 LA MSGAD,D4(MSGAD1) POINT TO START OF MSG Y02756 67970040 LH WORK4,D0(MSGAD) GET LENGTH OF TEXT Y02756 67972040 LA SW3REG,D4(MSGAD) GET ADDR OF TEXT Y02756 67974040 AR SW3REG,WORK4 POINT TO END OF TEXT Y02756 67976040 LA WORK5,D4 ALLOW FOR CONTROL DATA Y02756 67978040 SR SW3REG,WORK5 TRUE END OF TEXT Y02756 67980040 B MLWTTSOB PROCESS NEXT MSG GROUP Y02756 67982040 MLWTOEND EQU * END WTO PROCESSING Y02756 67984040 L EXITREG,XASAVLOC RESTORE RETURN REGISTER Y02756 67986040 BR EXITREG RETURN TO CALLER Y02756 67988040 EJECT 67990040 *****************************************************************Y02893 68000002 * WTO NORMAL SEGMENT Y02893 68002002 * Y02893 68004002 * THE FOLLOWING SEGMENT WILL PROCESS A NORMAL WTO INDICATING THATY02893 68006002 * THERE ARE NO OUTSTANDING REQUEST. ALL LOCKS OBTAINED WILL BE Y02893 68008002 * FREED. IF THE REQUEST IS FROM A TSO TERMINAL, A TPUT WILL BE Y02893 68010002 * ISSUED TO PUT THE MESSAGE TO THE TERMINAL. Y02893 68012002 * Y02893 68014002 * INPUT: Y02893 68016002 * XSA,WPL Y02893 68018002 * Y02893 68020002 * OUTPUT: MESSAGE -IEE111I NO OUTSTANDING REQUESTS - Y02893 68022002 * Y02893 68024002 *****************************************************************Y02893 68026002 WTONORMR EQU * PROCESS NORMAL WTO Y02756 68028002 ST EXITREG,XAD SAVE RETURN REGISTER Y02756 68030002 BAL EXITREG,FRELOCK RELEASE LOCAL AND CMS LOCKS Y02756 68032002 *****************************************************************Y02756 68034002 * BRANCH TO FREE LOCL SEGMENT TO RELEASE THE LOCAL AND CMS LOCKS Y02756 68036002 *****************************************************************Y02756 68038002 GETMAIN RU,LV=40,SP=0 GET CORE FOR MESSAGE Y02756 68040002 LR MSGAD,WORK2 POINT TO START OF AREA Y02756 68042002 MVC D0(LN,MSGAD),NOREQMSG MOVE MESSAGE TO AREA Y02756 68044002 CLC XAA(D2),ZEROS TSO TERMINAL REQUEST ? Y02756 68046002 BNZ WTONTSOT YES,PUT MESSAGE TO TERMINAL Y02756 68048002 SR WORK1,WORK1 CLEAR REG0 FOR CONSOLE ID Y02756 68050002 IC WORK1,XAU SET CONSOLE ID IN REG 0 Y02756 68052002 WTO MF=(E,(MSGAD)) ISSUE WTO Y02756 68054002 B WTONEXIT END NORMAL WTO Y02756 68056002 WTONTSOT EQU * TERMINAL REQUEST Y02756 68058002 LH MSGREG,D0(MSGAD) GET LENGTH OF MESSAGE Y02756 68060002 LA WORK2,D4 DECREASE LENGTH OF MESSAGE BY Y02756 68062002 SR MSGREG,WORK2 FOUR FOR WTO HEADER Y02756 68064002 LR WORK1,MSGREG SET LENGTH IN PARM REG Y02756 68066002 LA WORK2,D4(MSGAD) GET ADDR OF MSG TEXT Y02756 68068002 LH MSGREG,XAA GET TERMINAL ID Y02756 68070002 SLL MSGREG,HALFWORD TERM ID IN LEFT MOST BYTES Y02756 68072002 OR WORK1,MSGREG SET ID IN PARM REG Y02756 68074002 TPUT (WORK2),(WORK1),R ISSUE TPUT Y02756 68076002 WTONEXIT EQU * PREPARE TO FREE CORE Y02756 68078002 LR WORK2,MSGAD GET ADDR OF CORE Y02756 68080002 FREEMAIN RU,LV=40,A=(WORK2),SP=0 FREE CORE Y02756 68082002 L EXITREG,XASAVLOC RESTORE RETURN REG Y02756 68084002 BR EXITREG RETURN TO CALLER Y02756 68086002 EJECT 68088002 ********************************************************************** 68200018 D2 EQU 2 69945020 ZEROS DC X'0000' 69970020 COMMA EQU C',' COMMA CHARACTER Y02756 69986002 LISTOP DC C',LIST ' LIST OPERAND Y02756 69987002 LISTCH DC C',L ' LIST OPERAND Y02756 69987902 BLANK EQU C' ' BLANK CHARACTER Y02756 69988002 ERRTN DC V(IEE0503D) ERROR ROUTINE Y02756 69989002 SPACE 5 70000018 NOROOMID DC H'70' Y02756 70600002 NOROOMUN DC H'68' @ZD04020 71200040 NOROOMIR DC H'69' IF 69 BYTES USED IN BUFFER, Y02893 71250002 * THERE IS NO SPACE TO ADD Y02893 71300002 * ANOTHER UNIT NAME Y02893 71350002 RPIDMVTX MVC D0(0,MSGREG),WQETXT+D4 MOVE WTO TEXT Y02756 71801002 DS 0F 71802002 ZERO EQU * 71900018 ZEROFOX DC X'0000FFFF' 72000018 BLANKS DC 3X'40' Y02756 72200002 * THE FOLLOWING TWO LINES MUST REMAIN TOGETHER Y02893 72650002 MSG1CODD DC C'IEE110I ' 72800002 MSG1CODE DC C'PENDING REQUEST ' HEADER TEXT @ZD04020 72801040 HDLTH EQU *-MSG1CODE LENGTH OF MESSAGE Y02756 72802002 SUMMARY DC C'SUMMARY:' IN LABEL LINE @ZD04020 72892040 REPLYID DC C'REPLY ID' @ZD04020 72942040 RDYUNITS DC C'READY UNITS:' 73200002 INTREQ DC C'INTERVENTIONS REQUIRED:' MESSAGE HEADER @ZD04020 73450040 NOREQMSG WTO 'IEE111I NO OUTSTANDING REQUESTS',MF=L,DESC=(5), *73600002 MCSFLAG=(REG0,RESP) XMCS 73800018 LN EQU *-NOREQMSG TOTAL MSG BUFFER LENGTH 73900018 MOVECHAR MVC D0(D0,SW2REG),OFFSET44 @ZD04020 73900140 TABLE EQU *-240 @ZD04020 73905140 DC C'0123456789ABCDEF' @ZD04020 73910140 DS 0F 73920240 PATCHAR DC 150X'40' PATCH AREA Y02756 73930240 EJECT 73940240 IHAPSA DSECT=YES 73950240 EJECT 73960240 CVT DSECT 74000018 CVT LIST=YES 74200002 UCB DSECT 74600018 IEFUCBOB LIST=YES 74800002 EJECT 74820018 DRUCM DSECT 74840018 IEECUCM 74860018 EJECT 74880018 IHAORE YM2304 74930001 EJECT 75000018 IEZWPL DSECT=YES Y02756 75001002 EJECT 75002002 IHAWQE DSECT=YES YM2304 75050001 EJECT 75100001 XSAMAP DSECT 75200018 IEEXSA 75400018 OFFSET36 EQU XASAVSTD+D36 WORKING STORAGE OFFSET 36 @ZD04020 75410040 OFFSET40 EQU XASAVSTD+D40 WORKING STORAGE OFFSET 40 @ZD04020 75430040 OFFSET41 EQU XASAVSTD+D41 WORKING STORAGE OFFSET 41 @ZD04020 75450040 OFFSET42 EQU XASAVSTD+D42 WORKING STORAGE OFFSET 42 @ZD04020 75470040 OFFSET43 EQU XASAVSTD+D43 WORKING STORAGE OFFSET 43 @ZD04020 75490040 OFFSET44 EQU XASAVSTD+D44 WORKING STORAGE OFFSET 44 @ZD04020 75510040 OFFSET45 EQU XASAVSTD+D45 WORKING STORAGE OFFSET 45 @ZD04020 75530040 OFFSET47 EQU XASAVSTD+D47 WORKING STORAGE OFFSET 47 @ZD04020 75550040 END 75600018