TITLE 'IGG08101 - SETPRT LOAD 2 - UCS IMAGE RETRIEVAL' 00100002 IGG08101 CSECT 00200018 * /* START OF SPECIFICATIONS**** @Z40MSAP 00202048 *01* PROCESSOR = ASSEMXF: 00204048 **** END OF SPECIFICATIONS ** @Z40MSAP*/ 00204448 *********************************************************************** 00205002 * 00250002 * MODULE-NAME = IGG08101 00300002 * 00350002 * DESCRIPTIVE-NAME = SETPRT UCS IMAGE RETRIEVAL 00400002 * 00405002 * COPYRIGHT = NONE 00415002 * 00800021 * STATUS = VS2-4, LEVEL 1 01200048 * 01250021 * FUNCTION = USE BLDL MACRO TO LOCATE THE UCS IMAGE IN SYS1.IMAGELIB 01300002 * USE LOAD MACRO TO RETRIEVE THE UCS IMAGE FROM IMAGELIB 01500002 * WHEN IMAGE IS FOUND,ISSUE WTOR IEC120 TO REQUEST 01766702 * AN OPERATOR MOUNT CHAIN/TRAIN. 01800018 * WHEN IMAGE IS NOT FOUND,ISSUE WTOR AND IEC122 TO 01900002 * REQUEST AN OPERATOR SPECIFY AN ALTERNATE CHAIN. 02000018 * ANALYZE OPERATOR REPLY 02100002 * 02105002 * NOTES = 02110002 * DEPENDENCIES = BLANK AND COMMA ARE USED--CORRECTABLE BY 02115002 * REASSEMBLY. THE FOLLOWING CHARACTER STRINGS ARE USED IN 02120002 * TESTING OPERATOR REPLIES: 02125002 * 'F', 'V', 'U', 'C', 'FOLD', 'VERIFY', 'CANCEL' 02130002 * THESE STRINGS ARE CONSIDERED TO BE OPERATING SYSTEM KEYWORDS 02135002 * RATHER THAN LANGUAGE DEPENDENT PHRASES. 02140002 * 02145002 * BLANKS ARE OR'ED TO ALL REPLIES TO CONVERT THEM TO UPPER CASE 02150002 * 02151002 * RESTRICTIONS = NONE 02155002 * 02156002 * REGISTER-CONVENTIONS = ALL REGISTER NAMES BEGIN WITH R 02160002 * SEE EQUATES IMMEDIATELY FOLLOWING PROLOG 02165002 * 02170002 * PATCH-LABEL = PATCH, AN AREA ASSEMBLED AS BINARY 0 02175002 * 02180002 * MODULE-TYPE = 02185002 * PROCESSOR = OS/VS ASSEMBLER 02190002 * 02192002 * MODULE-SIZE = 900 DECIMAL BYTES 02194002 * 02195002 * ATTRIBUTES = REENTRANT, ENABLED, PRIVELEGED, 02196002 * EXECUTES IN SETPRT INVOKER KEY 02196402 * CODE AT ENTRY POINT WTOR IS NON-PRIVELEGED 02197002 * 02200018 * ENTRY POINT = IGG08101 02300002 * PURPOSE = SEE FUNCTION 02350002 * 02360002 * LINKAGE = BRANCH FROM IGC0008A 02370048 * 02380002 * INPUT = 02430002 * REGISTER 4(RSPW) = WORK AREA ADDRESS 02500002 * REGISTER 5(RPAR) = PARAMETER LIST ADDR 02600002 * REGISTER 6(RSVR) = SVRB EXTENDED SAVE AREA ADDRESS 02650002 * REGISTER 9(RIOB) = ADDRESS OF IOB 02800002 * 02900018 * OUTPUT = 02950002 * REGISTERS = TO INVOKER 02960002 * R0 = UNDEFINED 02962002 * R1 = UNDEFINED 02964002 * R2-R14 = UNCHANGED 02970002 * R15 = RETURN CODE (SEE EXIT-ERROR) 02980002 * 02982002 * REGISTERS = TO IGG08102 02990002 * R0-R3 = UNDEFINED 02990402 * R4-R6 = AS FOR INPUT 02992002 * R7 = UNDEFINED 02992102 * R8 (RIMAG) = ADDR OF IMAGE TO BE LOADED 02992402 * R9 = AS FOR INPUT 02994002 * R10-R14 = UNDEFINED 02996048 * R15 = RESERVED FOR BRANCH INTERFACE 02998048 * 02998402 * REGISTERS = TO IGG08103 02998802 * R0-R3 = UNDEFINED 02999202 * R4-R6 = AS FOR INPUT 02999602 * R7-R8 = UNDEFINED 02999702 * R9 = AS FOR INPUT 02999902 * R10-R11 = UNDEFINED 03033202 * R12 = UCS RETURN CODE 03035202 * R13-R14 = UNDEFINED 03037248 * R15 = RESERVED FOR BRANCH INTERFACE 03043248 * 03053202 * MESSAGES = RETRIEVED FROM IGGMSG01 03066702 * 'IEC120A M XXX,YYYY(,FOLD)(,VERIFY)' 03300002 * 'IEC122D XXX,YYYY UCS IMAGE NOT FOUND' 03400002 * 'IEC125A ERROR - REPEAT REPLY' 03550002 * 03600018 * EXIT-NORMAL = WHEN THE IMAGE IS TO BE LOADED, BRANCH TO IGG08102 03900048 * IF AN FCB IMAGE IS TO BE LOADED, BRANCH TO IGG08103, 04200048 * OTHERWISE RETURN TO SETPRT INVOKER 04250002 * 04400018 * EXIT-ERROR = WHEN AN OPERATOR ISSUED CANCEL FOR IEC120/IEC122, 04500002 * SET RETURN CODE=04. 04700002 * WHEN PERMANENT I/O ERROR OCCURED DURING BLDL, 04800002 * SET RETURN CODE=08. 05000002 * IF AN FCB IMAGE IS TO BE LOADED, SAVE THE RETURN CODE 05200002 * AND BRANCH TO SETPRT LOAD IGG08103, OTHERWISE RETURN TO USER 05205048 * 05215002 * ENTRY-POINT = WTOR (INTERNAL ENTRY) 05217002 * PURPOSE = ISSUE WTOR SVC IN PROBLEM STATE TO AVOID INTEGRITY 05219002 * EXPOSURE FROM NON-PROTECTED MESSAGE 05219402 * 05219802 * LINKAGE = SYNCH FROM WITHIN THIS MODULE 05219902 * 05225402 * INPUT = 05225802 * REGISTER 4(RSPW) = WORK AREA ADDRESS 05225902 * REGISTER 14(R14) = RETURN ADDRESS 05226002 * 05226102 * OUTPUT = 05237402 * REGISTERS = TO INVOKER 05237802 * R0 = UNDEFINED 05238202 * R1 = UNDEFINED 05238602 * R2-R14 = UNCHANGED 05238702 * R15 = UNDEFINED 05238802 * 05238902 * EXTERNAL REFERENCES = 05239002 * ROUTINES = BLDL (SVC 18) 05245002 * DELETE (SVC 9) 05251202 * FREEMAIN(SVC 10) 05257402 * IGG08102(SETPRT LOAD 3) 05263602 * IGG08103(SETPRT LOAD 4) 05269802 * IMGLIB (SVC105) 05276002 * LOAD (SVC 8) 05282202 * SYNCH (SVC 12) 05288402 * WAIT (SVC 1) 05294602 * WTOR (SVC 35) 05300802 * 05313202 * DATA-AREAS = SPP -- SETPRT PARAMETER LIST 05319402 * SPW5 -- BLDL PARAMETER LIST @Z40MSAP 05321448 * SPW -- SETPRT WORK AREA 05325602 * SPRBXSV -- RB EXTENDED SAVE AREA 05331802 * MSG -- MESSAGE CSECT 05338002 * CONTROL-BLOCKS = 05344202 * DCB -- DATA CONTROL BLOCK 05350402 * DEB -- DATA EXTENT BLOCK 05356602 * ECB -- EVENT CONTROL BLOCK 05362802 * IOB -- INPUT/OUTPUT BLOCK 05369002 * UCB -- UNIT CONTROL BLOCK 05375202 * 05381402 * MACROS = BLDL,DELETE,FREEMAIN,IMGLIB,LOAD,SYNCH,WAIT,WTOR, 05387648 * DCBD, IEFUCBOB, IEZDEB, IEZIOB, IGGMSG, IGGSPW, 05393802 * IHAECB, IHASPP 05400002 * 06300018 * CHANGE ACTIVITY = AS FOLLOWS 06310002 * 06312002 * NOTE = THIS MODULE WAS BROUGHT UP TO STANDARDS FOR VS2-2 06320002 * WHICH CAUSED ALL PREVIOUS RELEASE SEQUENCE NUMBER DELETIONS TO 06330002 * BECOME INVALID. 06340002 * 06342002 * RELEASE 19 DELETIONS 06350002 *THE FOLLOWING PTM WAS FIXED IN THIS RELEASE - M2923 06352002 * 06362002 * RELEASE 20 DELETIONS 06370002 *THE FOLLOWING PTMS WERE FIXED IN THIS RELEASE - 5881, 5149, 5143 06380002 *THE FOLLOWING APARS WERE FIXED IN THIS RELEASE - 34011, 33699 06390002 *THE FOLLOWING DEVELOPMENT CODE WAS FOR 3211 SUPPORT - S20202 06392002 * 06394002 * RELEASE 21 DELETIONS 06399702 *THE FOLLOWING PTM WAS FIXED IN THIS RELEASE - 1759 06401702 *THE FOLLOWING APAR WAS FIXED IN THIS RELEASE - 50699 06403702 * 06404102 * VS2 RELEASE 2 DELETIONS 06404902 *THE FOLLOWING DEVELOPMENT CODE WAS FOR VS2 RELEASE 2 - Y02072 06406902 * YM5703 06408902 * VS2 RELEASE 3.7 CHANGES 06409348 * 06429348 *C165500-165800 @ZA25004 06449348 *A348000,655673-655679 @ZA25004 06469348 *A169507-169584 @ZA32077 06479348 * 06489348 * VS2 RELEASE 4 DELETIONS 06509348 * @Z40MSMI 06529348 *********************************************************************** 06549348 EJECT 06600018 *********************************************************************** 06800018 * 06900018 * REGISTER CONVENTIONS USED THROUGH OUT ALL SETPRT MODULES 07000002 * 07100018 *********************************************************************** 07200018 * 07300018 RWRK1 EQU 0 WORK/PARAMETER REG. 07400002 R0 EQU 0 INPUT REGISTER 07450002 RWRK2 EQU 1 WORK/PARAMETER REG. 07500002 R1 EQU 1 INPUT REGISTER 07550002 RDCB EQU 2 ADDR OF USER'S DCB 07600018 RBASE EQU 3 BASE REG. 07700018 RSPW EQU 4 ADDR OF MESSAGE/WORK AREA 07800002 RPAR EQU 5 PARAMETER LIST ADDR 07900018 RSVR EQU 6 SVRB EXTENDED SAVE AREA 08000002 RRET EQU 7 SUBROUTINE RETURN REG Y02072 08050002 RIMAG EQU 8 ADDR OF UCS IMAGE LOADED 08250002 RIOB EQU 9 ADDR OF LAST IOB USED 08300018 RUCB EQU 10 UCB ADDR 08400018 RDEB EQU 11 DEB ADDR 08500018 RBLDL EQU RDEB BLDL PARM LIST REG YM5703 08550002 RWRK5 EQU 12 WORK REG. 08600002 RWRK6 EQU 13 WORK REG. 08700002 R14 EQU 14 LINK REGISTER 08750002 RWRK7 EQU 14 WORK/PARAMETER REG. 08800002 R15 EQU 15 LINK/RETURN CODE REGISTER 08850002 RWRK8 EQU 15 WORK/PARAMETER REG. 08900002 * 09000018 * 09100018 *********************************************************************** 09200018 * 09300018 * RETURN CODES 10800002 * 10900018 RCNORM EQU X'00' NORMAL RETURN 11000002 RCOPIMG EQU X'04' OPERATOR CANCEL--INVAL IMAGE 11100002 RCBLDIO EQU X'08' I/O ERROR IN BLDL 11200002 * 11300018 *********************************************************************** 11350002 * MESSAGE NUMBERS IN IGGMSG01 11400002 * ALL MESSAGE NUMBERS HAVE BEEN DOUBLED IN THESE EQUATES 11410002 * TO PROVIDE OFFSETS INTO THE MESSAGE CSECT. 11420002 * THIS IS DEPENDENT ON L'MSGINDOF BEING 2. 11430002 * 11450002 MSG120 EQU 3*2 IEC120A, NO FOLD,VERIFY Y02072 11500002 MSG120F EQU 6*2 IEC120A, FOLD ONLY Y02072 11550002 MSG120FV EQU 5*2 IEC120A, FOLD&VERIFY Y02072 11600002 MSG120V EQU 4*2 IEC120A, VERIFY ONLY Y02072 11650002 MSG122 EQU 7*2 IEC122D Y02072 11700002 MSG125 EQU 8*2 IEC125A Y02072 11750002 * 11800002 *********************************************************************** 11850002 * OTHER EQUATES 11900002 * 11950002 MAXRPLN EQU 5 USED FOR LOOP CONTROL IN 12050002 * ANALYZING THE REPLY 12100002 UCB43211 EQU X'09' MASK FOR 3211 PRINTER M5149 12120002 UCB41403 EQU X'08' MASK FOR 1403 PRINTER Y02072 12170002 EJECT 13250002 USING SPW,RSPW 13300002 USING SPPARM,RPAR 13350002 USING SPRBXSV,RSVR 13400002 USING IOBQSAMN,RIOB 13450002 * 14700018 *********************************************************************** 14800018 * 14900018 * INITIALIZE REGISTERS 15000018 * 15100018 *********************************************************************** 15200018 * 15300018 BALR RBASE,0 ESTABLISH BASE FOR CODE 15400002 START EQU * 16300018 USING START,RBASE 16350002 SPACE 16400002 B BEGIN BR AROUND CONSTANTS Y02072 16450002 DC C'IGG08101' MODULE NAME Y02072 16500002 DC C'@ZA32077' LAST SHIP CODE @ZA32077 16550048 DC C'07/28/78' LAST DATE MODIFIED @ZA32077 16580048 BEGIN DS 0H Y02072 16660002 SPACE 16670002 L RDCB,SPPDCBA LOAD DCB ADDR 16700002 USING IHADCB,RDCB 16750002 L RDEB,DCBDEBAD LOAD DEB ADDR 16800018 USING DEBDASD-(DEBBASND-DEBBASIC),RDEB 16850002 L RUCB,DEBUCBAD LOAD UCB ADDR 16900018 DROP RDEB 16910002 USING UCBOB,RUCB 16950002 L RDEB,UCBXTADR LOAD UCB EXTENSION @ZA32077 16950748 TM 4(RDEB),X'01' PARITY ERROR @ZA32077 16951448 BO MOVEID YES-LOAD UCS @ZA32077 16952148 CLC SPPUCS,0(RDEB) SPECIF UCS=LOADED UCS @ZA32077 16952848 BNE MOVEID NO-LOAD UCS @ZA32077 16953548 TM SPWPARM1,SPWVERIF VERIFY @ZA32077 16954248 BO MOVEID YES-LOAD UCS @ZA32077 16954948 TM SPWFLG1,SPWRPVER OPER REQUEST VERIFY @ZA32077 16955648 BO MOVEID YES-LOAD UCS @ZA32077 16956348 LA RDEB,RCNORM LOAD RETURN CODE @ZA32077 16957048 B CKFORFCB RETURN TO PROB PROG @ZA32077 16957748 MOVEID EQU * @ZA32077 16958448 L RBLDL,SPRBLDLA GET BLDL PARM LIST ADDR YM5703 16960002 USING SPW5,RBLDL @Z40MSAP 16970048 * 17000018 *********************************************************************** 17100018 * 17200018 * SET UP REQUESTED UCS IMAGE ID 17300002 * 17400018 *********************************************************************** 17500018 * 17600018 L RWRK6,SPWBLUCS GET UCS IMAGE ID Y02072 17650002 ST RWRK6,SPWREPID MAKE IT CURRENT ID Y02072 17800002 * 18000018 BLDLRTN EQU * 18100018 * 18200018 *********************************************************************** 18300018 * 18400018 * BLDL TO LOCATE UCS IMAGE IN SYS1.IMAGELIB 18500020 * 18600018 *********************************************************************** 18700018 * 18800018 MODESET EXTKEY=DATAMGT KEY 5 FOR BLDL LIST YM5703 18850002 SPACE 18860002 MVC SPWBLDLC,BLDLCNST MOVE BLDL LIST TO BLDL AREA 18900002 MVC SPWUCSMB,UCSCONST MOVE UCS IMAGE MEMBER NAME 19000002 CLI UCBTBYT4,UCB43211 CK FOR 3211 DCB M5149 19010002 * PRINTER S20202 19020020 BNE CONTBLDL NO, CONTINUE W/ BLDL M5881 19030002 MVI SPWUCS2,SPWUCS2C UCS PREFIX=UCS2 S20202 19040002 * 19050020 CONTBLDL EQU * S20202 19060020 SPACE 19062002 MODESET KEYADDR=SPRKEY,WORKREG=1 RESUME USER KEY YM5703 19064002 SPACE 19066002 MVC SPWUCSIM(L'SPWUCSMB),SPWUCSMB SAVE FOR LATER Y02072 19070002 * LOAD AND WTOR 19080002 MODESET EXTKEY=DATAMGT KEY OF BLDL LIST YM5703 19090002 SPACE 19092002 * 19100018 * GET ADDRESS OF SYS1.IMAGELIB DCB 19200002 * 19300020 L R1,SPRIDCBA GET SYS1.IMAGELIB DCB Y02072 19400002 * ADDRESS S20202 19500020 BLDL (1),SPWBLDLC BLDL TO LOCATE THE IMAGE 20000002 SPACE 20050002 MODESET KEYADDR=SPRKEY,WORKREG=1 YM5703 20060002 SPACE 20070002 * 20100018 * TEST RETURN CODE FROM BLDL 20200018 * X'00' - FOUND 20300018 * X'04' - NOT FOUND 20400018 * X'08' - PERMANENT I/O ERROR 20500018 * 20600018 B BLDLRET(R15) TEST RETURN CODE Y02072 20800002 BLDLRET EQU * Y02072 20900002 B LOADUCS 0 - GOTO LOAD IMAGE RTN Y02072 21000002 B WTOR122 4 - NOT FOUND MSG RTN Y02072 21100002 * 8 - I/O ERROR Y02072 21200002 * 21600018 *********************************************************************** 21700018 * 21800018 * PERMANENT I/O ERROR DURING BLDL - GIVE CONTROL BACK TO ENTRY POINT 21900018 * RETURN CODE = X'08' IN REG.15 22000018 * IF I/O ERROR PERSISTS,RUN C.E. DIAGNOSTICS FOR SYSTEM RESIDENT 22100018 * DASD. 22200018 * 22300018 *********************************************************************** 22400018 * 22500018 LA RWRK5,RCBLDIO LOAD RETURN CODE 22600002 B CKFORFCB GO TO CK IF FCB S20202 22650020 * SPECIFIED IN S20202 22700020 * SETPRT PARAMETER LIST 22750020 EJECT 22800002 LOADUCS EQU * 23100018 * 23200018 *********************************************************************** 23300018 * 23400018 * WHEN UCS IMAGE IS FOUND IN SYS1.IMAGELIB LOAD THE UCS IMAGE 23500020 * 23600018 *********************************************************************** 23700018 * 23800018 TM SPWFLG3,SPW120RQ TEST IF IEC120 IS REQUIRED 24100002 BO WTOR120 IF YES, GOTO DISPLAY MSG Y02072 24200002 * BEFORE LOADING IMAGE 24250002 BAL RRET,LOAD IF NO, GO AHEAD & LOAD Y02072 24260002 B XCTLRTN THEN BRANCH TO NEXT MODULE 24270048 SPACE 3 24300002 LOAD EQU * 24400018 *********************************************************************** 24450002 * THIS SUBROUTINE LOADS THE IMAGE (ID IN SPWREPID) FROM IMAGELIB 24460002 * IT RETURNS ON REGISTER RRET, WITH THE IMAGE ADDRESS IN RIMAG 24470002 *********************************************************************** 24480002 * 24500018 MVC SPWUCS2H,SPWREPID SET UP PARM FOR LOAD Y02072 24550002 L R1,SPRIDCBA GET SYS1.IMAGELIB DCB Y02072 24660002 * ADDRESS S20202 24720020 * 24800018 MODESET EXTKEY=DATAMGT YM5703 24850002 SPACE 24860002 LOAD DE=SPWUCSMB,DCB=(1) LOAD THE IMAGE YM5703 24900002 SPACE 24950002 MODESET KEYADDR=SPRKEY,WORKREG=8 YM5703 24960002 SPACE 24970002 LR RIMAG,R0 RETAIN ADDR OF IMAGE LOADED 25000002 BR RRET RETURN TO SUBR CALLER Y02072 25100002 SPACE 3 26100002 WTOR122 EQU * 26500018 * 26600018 *********************************************************************** 26700018 * 26800018 * WTOR 'IEC122D XXX,YYYY UCS IMAGE NOT FOUND' TO REQUEST AN 26900020 * ALTERNATE USC IMAGE TO BE USED. 27000020 * 27100018 *********************************************************************** 27200018 * 27300018 LA RWRK2,MSG122 SPECIFY INDEX TO MESSAGE Y02072 27450002 BAL RRET,GETMSG GO GET THE MESSAGE Y02072 27500002 BAL RRET,FILLFLDS THEN FILL IN UNIT, ID Y02072 27550002 SR RWRK6,RWRK6 CLEAR REG S20202 27800002 SR RIMAG,RIMAG INDICATE NO IMAGE LOADED 27900002 MESSAGO EQU * 28000002 TM SPRKEY,SPRUSKEY IF CALLED AS SYS FUNCT Y02072 28010002 BZ MESSAGO2 DO NOT SYNCH TO WTOR Y02072 28020002 SYNCH WTOR ISSUE WTOR IN PROB STATE Y02072 28050002 B WAIT THEN WAIT FOR COMPLETION Y02072 28100002 MESSAGO2 EQU * SYS WTOR Y02072 28110002 BAL R14,WTOR ISSUE WTOR IN SUP STATE Y02072 28120002 B WAIT THEN WAIT FOR COMPLETION Y02072 28130002 SPACE 3 28150002 WTOR120 EQU * 28400018 * 28500018 *********************************************************************** 28600018 * 28700018 * BEFORE UCS IMAGE IS RETRIEVED,WTOR THE FOLLOWING MESSAGE 28800002 * 'IEC120I M XXX,YYYY,FOLD,VERIFY' 28900002 * THEN RETRIEVE THE IMAGE BEFORE WAITING FOR REPLY. 28950002 * 29000018 *********************************************************************** 29100018 * 29800018 LA RWRK2,MSG120FV ASSUME FOLD&VERIFY MSG Y02072 29850002 TM SPWPARM1,SPWFOLD+SPWRPVER IF FOLD AND VERIFY Y02072 29900002 BO GET120 GO SELECT MSG120FV Y02072 30000002 LA RWRK2,MSG120 ASSUME NEITHER Y02072 30100002 BZ GET120 IF NEITHER GET MESSAGE Y02072 30150002 LA RWRK2,MSG120V ASSUME VERIFY MSG Y02072 30200002 TM SPWPARM1,SPWVERIF TEST IF VERIFY IS SPECIFIED 31700002 BO GET120 IF SO, GO GET MESSAGE Y02072 31800002 LA RWRK2,MSG120F SELECT FOLD MESSAGE Y02072 32000002 * 32150002 GET120 EQU * Y02072 32160002 BAL RRET,GETMSG GET WHICHEVER MSG RQSTD Y02072 32170002 BAL RRET,FILLFLDS FILL IN UNIT AND ID Y02072 32190002 TM SPRKEY,SPRUSKEY IF CALLED AS SYS FUNCT Y02072 32192002 BZ GET120A DO NOT SYNCH TO WTOR Y02072 32194002 * 32200018 SYNCH WTOR ISSUE WTOR IN PROB STATE Y02072 33900002 BAL RRET,LOAD LOAD IMAGE WHILE WAITING Y02072 34200002 B WAIT THEN WAIT FOR COMPLETION Y02072 34250002 GET120A EQU * SYS WTOR Y02072 34260002 BAL R14,WTOR ISSUE WTOR IN SUP STATE Y02072 34270002 BAL RRET,LOAD LOAD IMAGE WHILE WAITING Y02072 34280002 * 34300018 WAIT EQU * 34400002 * 34500018 WAIT ECB=SPWRPECB,LONG=YES WAIT ON REPLY Y02072 34700002 NI SPWFLG3,X'FF'-SPW120RQ SET NO IEC120 REQ'D Y02072 34750002 XC SPWMSGID(4),SPWMSGID CLEAR MSG ID @ZA25004 34800048 * 35300018 *********************************************************************** 35400018 * 35500018 * AFTER DISPLAYING MESSAGES,TEST REPLY. 35600018 * 'U' - GO CHECK FOR FCB PARAMETERS 35700020 * 'CANCEL' - GOTO CANCEL ROUTINE AND EXIT TO ENTRY POINT 35800018 * 'YYYY' - GOTO LOAD UCS BUFFER ROUTINE (IGG08102) 35900018 * 'ZZZZ' - GOTO BLDL AND LOAD ROUTINE 36000018 * 36100018 *********************************************************************** 36200018 * 36300018 OC SPWREPLY,LOWER OR TO ALLOW LOWER CASE REPLY 36400002 * 36600018 LA RWRK5,RCNORM LOAD NORMAL RETURN CODE 36700002 CLC SPWREPLY(L'UBLANK),UBLANK TEST IF REPLY = 'U' 36800002 BE RPLYUSE IF YES,GOTO EXIT ROUTINE Y02072 36900002 * 37000018 CLC SPWREPLY(L'CANCELCN),CANCELCN TEST IF REPLY='CANCEL' 37100002 BE CANCELGO IF YES,GOTO CANCEL RTN 37200002 * 37300018 CLC SPWREPLY(L'CBLANK),CBLANK TEST IF REPLY = 'C' 37400002 BNE TSTUCSID IF NOT,GOTO UCS ID TEST 37500002 * 37800018 CANCELGO EQU * 37900018 * 38000018 *********************************************************************** 38100018 * 38200018 * AN OPERATOR CANCELLED THE JOB STEP BECAUSE THE SPECIFIED CHAIN IS 38300018 * NOT AVAILABLE. RETURN CODE = X'04' IN REG.15 38400018 * CHECK IF THE IMAGE-ID WAS SPECIFIED CORRECTLY,OR ADD THE IMAGE 38500018 * TO SYS1.IMAGELIB 38600020 * 38700018 *********************************************************************** 38800018 * 38900018 LA RWRK5,RCOPIMG LOAD RETURN CODE 39000002 B EXITRTN GOTO EXIT ROUTINE 39100002 * 39110002 *********************************************************************** 39150002 * 39160002 * OPERATOR REPLIED 'U'. SET UP PARM LIST WITH UCB UCS ID Y02072 39170002 * AND THEN BO BLDL. Y02072 39172002 * 39180002 *********************************************************************** 39190002 * 39192002 RPLYUSE EQU * Y02072 39242002 L RWRK6,UCBXTADR GET UCB UCS EXTENSION Y02072 39292002 USING UCBUCS,RWRK6 Y02072 39342002 L RWRK6,UCBUCSID UCS ID TO LOAD Y02072 39392002 DROP RWRK6 Y02072 39442002 SPACE 39452002 MODESET EXTKEY=DATAMGT YM5703 39462002 SPACE 39472002 ST RWRK6,SPWBLUCS UCS ID TO BLDL PARM LST Y02072 39492002 SPACE 39492402 MODESET KEYADDR=SPRKEY,WORKREG=8 YM5703 39492802 SPACE 39493202 ST RWRK6,SPWREPID SAVE UCS ID FOR COMPARE Y02072 39494002 B ISSUEDEL GO DELETE IMAGE LOADED Y02072 39494402 SPACE 2 39498002 * 39600018 *********************************************************************** 39700018 * 39800018 * REPLY ANALYSIS ROUTINE 39900018 * 40000018 *********************************************************************** 40100018 * 40200018 TSTUCSID EQU * 40210002 L RWRK6,SPWREPID SAVE PREVIOUS ID Y02072 40250002 MVC SPWREPID,BLANKS BLANK FIELD FOR NEW ID Y02072 40260002 LA RWRK7,SPWREPLY LOAD REPLY ADDR 40300002 USING CHAR,RWRK7 40350002 MVI SPWRPECB,BLANK ENSURE BLANK AFTER REPLY Y02072 40362002 * 40370002 LA RWRK8,L'SPWREPID+1 SET LIMIT ON ID SCAN Y02072 40400002 BAL RRET,SCAN GET LENGTH OF ID FIELD Y02072 40450002 BZ REPNULL NULL REPLY IF ZERO Y02072 40500002 EX RWRK8,MVCREP MOVE ID TO SPWREPID Y02072 40550002 * 40600002 * PROCESS FOLD OPTION 40610002 * 40620002 BAL RRET,DELIM CHECK FOR COMMA AFTER ID Y02072 40650002 * IF COMMA PRESENT, 40652002 * OPERATOR HAS SET OPTIONS 40654002 MVI SPWFLG1,0 RESET USER OPTIONS Y02072 40660002 LA RWRK8,L'FOLDCN+1 SET LIMIT ON 'FOLD' SCAN Y02072 40700002 BAL RRET,SCAN GET LENGTH OF FOLD OPT Y02072 40750002 BZ VTEST OMITTED--TEST FOR VERIFY Y02072 40800002 EX RWRK8,CLCFOLD CHECK CONTENTS OF OPTION Y02072 40850002 BNE ERRORTN ERROR IF NO MATCH Y02072 40900002 OI SPWFLG1,SPWFOLD TURN ON FOLD OPTION Y02072 40950002 * 41000002 * PROCESS VERIFY OPTION 41050002 * 41100002 VTEST EQU * Y02072 41150002 BAL RRET,DELIM COMMA AFTER FOLD? Y02072 41200002 LA RWRK8,L'VERIFYCN+1 SET 'VERIFY' SCAN LIMIT Y02072 41250002 BAL RRET,SCAN GET LENGTH OF OPTION Y02072 41300002 BZ ERRORTN ERROR IF FIELD OMITTED Y02072 41350002 EX RWRK8,CLCVER VERIFY CONTENTS OF OPT Y02072 41400002 BNE ERRORTN ERROR IF NO MATCH Y02072 41450002 OI SPWFLG1,SPWVERIF TURN ON VERIFY OPTION Y02072 41460002 * 41500002 * BE SURE NO MORE FIELDS ARE PRESENT 41550002 * 41600002 BAL RRET,DELIM NORM WILL NOT RETURN Y02072 41650002 B ERRORTN IS AN ERROR IF DOES Y02072 41700002 * 41800002 * EXECUTED INSTRUCTIONS DURING SCAN 41850002 * 41900002 MVCREP MVC SPWREPID(0),CHAR MOVE ID Y02072 41950002 CLCFOLD CLC FOLDCN(0),CHAR VERIFY FOLD OPTION Y02072 42000002 CLCVER CLC VERIFYCN(0),CHAR CHECK VERIFY OPTION Y02072 42050002 CLCBLNK CLC CHAR1(0),CHAR2 CHECK FOR ALL BLANK Y02072 42060002 * 42100002 * SUBROUTINES USED DURING SCAN 42150002 * 42200002 SCAN EQU * Y02072 42250002 *********************************************************************** 42300002 * INPUT IS MAX DATA LENGTH+1 IN RWRK8 AND POSITION IN RWRK7 42350002 * NORMAL OUTPUT IS DATALENGTH-1 IN RWRK8 42400002 * IF DATALENGTH IS ZERO, RETURNS WITH CONDITION CODE ZERO 42450002 * IF LIMIT EXCEEDED, GOES TO ERRORTN 42500002 * THIS SUBROUTINE USES RWRK1 AND RWRK2, AND RETURNS ON RRET 42550002 *********************************************************************** 42600002 LR RWRK2,RWRK8 SAVE LIMIT LENGTH Y02072 42650002 SCAN2 CLI CHAR1,COMMA IF A COMMA IS FOUND Y02072 42700002 BE SCAN4 STOP THE SCAN Y02072 42750002 CLI CHAR1,BLANK OR A BLANK IS FOUND Y02072 42800002 BE SCAN4 STOP THE SCAN Y02072 42850002 LA RWRK7,1(RWRK7) ELSE SCAN TO NEXT BYTE Y02072 42900002 BCT RWRK8,SCAN2 LOOP IF LIMIT OK Y02072 42950002 B ERRORTN OTHERWISE IS AN ERROR Y02072 43000002 SCAN4 SR RWRK2,RWRK8 DATA LENGTH Y02072 43050002 SR RWRK7,RWRK2 RESET TO FIELD START Y02072 43060002 LTR RWRK8,RWRK2 PUT LENGTH IN PASSBACK Y02072 43070002 * IF NO DATA, SETS CC=0 43100002 * ELSE SETS CC=2 (POSITIVE) 43110002 BCTR RWRK8,0 DECREMENT TO LEN-1 Y02072 43150002 BR RRET AND RETURN WITH CONDCODE Y02072 43200002 * 43250002 DELIM EQU * Y02072 43300002 *********************************************************************** 43350002 * INPUT IS PREV DATA LENGTH-1 IN RWRK8, DATA POS IN RWRK7 43400002 * NORMAL OUTPUT IS NEXT DATA FIELD POS IN RWRK7 43450002 * (IF NEXT FIELD IS OMITTED, WILL POINT TO ITS DELIMITER) 43500002 * IF DELIMITER FOR PREVIOUS FIELD IS BLANK,ROUTINE DOES 43550002 * NOT RETURN, BUT VERIFIES THAT REMAINDER OF REPLY AREA IS 43600002 * BLANK, THEN CONTINUES WITH NEXT FUNCTION. 43650002 * IF INVALID DELIMITOR SITUATION IS FOUND, GOES TO ERRORTN 43700002 * THIS SUBROUTINE USES RWRK2 AND RETURNS ON RRET 43750002 *********************************************************************** 43800002 LA RWRK7,1(RWRK7,RWRK8) INCR PAST DATA FIELD Y02072 43850002 CLI CHAR1,BLANK IF BLANK DELIMITER Y02072 43900002 BE SWEEP THEN GO CHECK REMAIN Y02072 43950002 LA RWRK7,CHAR2 POINT PAST DELIMITER Y02072 44000002 CLI CHAR1,BLANK CHECK FOR COMMA-BLANK Y02072 44050002 BE ERRORTN WHICH IS AN ERROR Y02072 44100002 BR RRET OTHERWISE RETURN Y02072 44150002 * 44160002 * CLEAN UP AFTER SCAN 44170002 * 44180002 * IF OPERATOR REPLIED WITH A NULL MESSAGE, TREAT IT AS IF 44182002 * HE REPLIED WITH THE PREVIOUS UCS ID 44184002 * 44186002 REPNULL ST RWRK6,SPWREPID KEEP PREVIOUS ID Y02072 44190002 * 44192002 SWEEP LA RWRK2,SPWREPLY+L'SPWREPLY-1 FIND END OF AREA Y02072 44200002 SR RWRK2,RWRK7 LENGTH-1 OF AREA LEFT Y02072 44250002 BNH TSTNAME END OF AREA--IS OK Y02072 44300002 BCTR RWRK2,0 DECR TO BLANKS-2 Y02072 44350002 EX RWRK2,CLCBLNK IF FIRST N-1 BYTES DON'T Y02072 44400002 * MATCH LAST N-1 BYTES Y02072 44450002 BNE ERRORTN THEN SOME BYTE NON-BLANK Y02072 44500002 * ELSE CONTINUE Y02072 44550002 DROP RWRK7 47650002 * 47900018 TSTNAME EQU * 48000018 * 48100018 *********************************************************************** 48200018 * 48300018 * TEST REPLY ID = SPECIFIED ID 48400018 * NO - GO BACK REPEAT BLDL/LOAD TO LOAD REPLIED IMAGE 48500018 * YES - BRANCH TO MODULE IGG08102 48600048 * 48700018 *********************************************************************** 48800018 * 48900018 C RWRK6,SPWREPID TEST IF SAME AS PREV. ID Y02072 49100002 BE XCTLRTN IF YES,GOTO NEXT MODULE 49200002 * 49500018 FINDUCS EQU * 49600018 * 49700018 *********************************************************************** 49800018 * 49900018 * WHEN AN ALTERNATE IMAGE IS SPECIFIED. 50000018 * TEST IF THE REPLIED UCS IMAGE IS TO BE LOADED. 50100018 * 50200018 *********************************************************************** 50300018 * 50400018 L RWRK6,SPWREPID LOAD REPLIED UCS ID Y02072 50450002 SPACE 50500002 MODESET EXTKEY=DATAMGT YM5703 50550002 SPACE 50560002 ST RWRK6,SPWBLUCS STORE IT FOR BLDL Y02072 50600002 SPACE 50650002 MODESET KEYADDR=SPRKEY,WORKREG=12 YM5703 50660002 SPACE 50670002 MVC SPWPARM1,SPWFLG1 MOVE REPLIED OPTION Y02072 50700002 * 50800018 L RWRK5,UCBXTADR GET ADDR OF UCB PTR EXT S20202 50850002 USING UCBUCS,RWRK5 50860002 C RWRK6,UCBUCSID ARE UCS ID'S EQUAL? S20202 50900002 BNE DELETE IF NOT,GOTO DELETE ROUTINE 51000002 NI SPWFLG3,X'FF'-SPW120RQ SET NO IEC120 REQ'D Y02072 51050002 * 51100018 * WHEN IDS ARE EQUAL,TEST LOAD MODES ARE EQUAL 51200018 * 51300018 MVC SPWFLG8,UCBUCSOP MOVE UCS OPT BITS FROM S20202 51360002 * UCB S20202 51420020 XC SPWFLG8,SPWPARM1 XLUSIVE OR THE REPLY BITS 51500002 * 51600018 TM SPWFLG8,SPWFOLD TEST IF LOAD MODES ARE SAME 51700002 BO DELETE IF NOT,GOTO DLETE ROUTINE 51800002 * 52300018 *********************************************************************** 52400018 * 52500018 * TEST IF VERIFY IS SPECIFIED. 52600018 * YES - SET SWITCH AND GO DELETE Y02072 52700002 * NO - GO DELETE Y02072 52800002 * 52900018 *********************************************************************** 53000018 * 53100018 TM SPWPARM1,SPWVERIF TEST IF VERIFY IS SPECIFIED 53200002 DROP RWRK5 53250002 BNO DELETE IF NOT, DELETE PREVIOUS Y02072 53400002 * IMAGE Y02072 53450002 OI SPWFLG2,SPWENTVR SET SWITCH FOR VERIFY Y02072 53600002 * 53900018 DELETE EQU * 54000018 * 54100018 *********************************************************************** 54200018 * 54300018 * TEST IF THE IMAGE HAS BEEN LOADED 54400018 * 54500018 *********************************************************************** 54600018 * 54700018 LTR RIMAG,RIMAG TEST IF THE IMAGE BEEN LOADED 54800002 BZ BLDLRTN IF NOT GOTO BLDL ROUTINE Y02072 54900002 * 55000018 *********************************************************************** 55100018 * 55200018 * DELETE THE IMAGE LOADED AND GO BACK TO BLDL ROUTINE TO LOCATE 55300018 * NEW IMAGE 55400018 * 55500018 *********************************************************************** 55600018 * 55700018 ISSUEDEL EQU * Y02072 55750002 DELETE EPLOC=SPWUCSIM DELETE THE LOADED IMAGE 56100002 SR RIMAG,RIMAG INDICATE NOTHING LOADED Y02072 56150002 ST RIMAG,SPWUCS2H Y02072 56160002 B BLDLRTN GOTO BLDL ROUTINE 56600002 SPACE 3 56700002 ERRORTN EQU * 57300018 * 57400018 *********************************************************************** 57500018 * 57600018 * WTO 'IEC125 ERROR - REPEAT REPLY' AND GO BACK TO REPLY ANALYSIS 57700018 * 57800018 *********************************************************************** 57900018 * 58000018 LA RWRK2,MSG125 SPECIFY ERROR MESSAGE Y02072 58050002 BAL RRET,GETMSG GO GET MESSAGE Y02072 58100002 B MESSAGO GO TO ISSUE MSG ROUTINE DM0Q 58300018 EJECT 58400002 EXITRTN EQU * 58700018 * 58800018 *********************************************************************** 58900018 * 59000018 * DELETE IMAGE IF IT HAS BEEN LOADED 59100002 * 59200018 *********************************************************************** 59300018 * 59400018 LTR RIMAG,RIMAG TEST IF IMAGE BEEN LOADED 59500002 BE CKFORFCB IF NOT GO CK FOR FCB S20202 59560020 * PARAMETER S20202 59620020 * 60500018 DELETE EPLOC=SPWUCSIM DELETE THE IMAGE LOADED Y02072 60900002 * 60900402 SR RIMAG,RIMAG INDICATE NOTHING LOADED Y02072 60902002 ST RIMAG,SPWUCS2H Y02072 60904002 * 60906020 CKFORFCB EQU * S20202 60912020 * 60912402 *********************************************************************** 60914002 * IF DEVICE HAS AN FCB, BRANCH TO ROUTINE TO PROCESS IT 60916048 * OTHERWISE GO CLEAN UP AND EXIT 60916402 *********************************************************************** 60916802 * 60918020 CLI UCBTBYT4,UCB41403 CK IF DEVICE IS A 1403 Y02072 60920002 BE FREEMAIN YES GO FREE MESSAGE/WORK Y02072 60930002 * AREA S20202 60936020 * 60942020 * GO BRANCH TO IGG08103 TO LOAD FCB 60948048 * 60954020 L R15,ID3 ADDR. OF IGG08103 @Z40MSMI 60960048 BR R15 BRANCH TO MODULE @Z40MSMI 60970048 * 61000018 FREEMAIN EQU * 61100018 * 61150002 *********************************************************************** 61160002 * 61170002 * EXIT ROUTINE - (1) CLOSE IMAGELIB DCB 61180002 * (2) DELETE MESSAGE CSECT 61190002 * (3) FREEMAIN MESSAGE/WORK AREA 61192002 * (4) FREEMAIN BLDL PARAMETER LIST YM5703 61192402 * (5) RESTORE IOB AND EXIT TO ENTRY POINT 61194002 * 61196002 *********************************************************************** 61198002 * 61200018 L RWRK1,SPRIDCBA GET SYS1.IMAGELIB DCB Y02072 61230002 * ADDRESS S20202 61260020 MODESET EXTKEY=ZERO SWITCH TO SVRB KEY Y02072 61292002 * 61292402 SR RWRK6,RWRK6 INDICATE NO IMAGELIB DCB Y02072 61294002 ST RWRK6,SPRIDCBA Y02072 61296002 * 61298102 IMGLIB CLOSE,(RWRK1) CLOSE IMAGELIB DCB S20202 61298402 * 61352002 ST RWRK6,SPRMSG NO LONGER LOADED Y02072 61370002 * 61370402 DELETE EP=IGGMSG01 DELETE MESSAGE CSECT Y02072 61372002 * 61374002 ST RWRK6,SPRIOBSV INDICATE IOB RESTORED Y02027 61570402 MODESET KEYADDR=SPRKEY,WORKREG=1 Y02072 61580002 * 61590002 * RESTORE IOB TO ORIGIONAL STATUS Y02072 61590102 * 61590202 MVC IOBFLAG1(4),SPWFLGSV RESTORE FLAGS Y02072 61590402 MVC IOBSTART,SPWSTRSV RESTORE IOB START Y02072 61590802 * 61591202 * ISSUE FREEMAINS FOR SETPRT WORK AREA AND BLDL PARM LIST YM5703 61591602 * 61591702 FREEMAIN R,LV=SPWLNGTH,A=(RSPW),SP=SPWPOOL @Z40MSAP 61592048 * 61600018 SPACE 61650002 MODESET EXTKEY=DATAMGT KEY OF BLDL PARM LIST YM5703 61700002 SPACE 61750002 ST RWRK6,SPWWKADR INDIC WORK AREA FREED YM5703 61800002 FREEMAIN R,LV=SPW5LNTH,A=(RBLDL),SP=SPW5POOL YM5703 61850048 SPACE 61950002 MODESET EXTKEY=SUPR YM5703 62000002 SPACE 62050002 ST RWRK6,SPRBLDLA INDIC BLDL LIST FREED YM5703 62100002 LR R15,RWRK5 LOAD RETURN CODE 64100002 L R14,SPREXIT GET EXIT PROLOG ADDR Y02072 64200002 BR R14 EXIT Y02072 64250002 * 64700018 *********************************************************************** 64800018 * 64900018 * BRANCH TO IGG08102 65000048 * 65100018 *********************************************************************** 65200018 * 65300018 XCTLRTN EQU * 65350002 L R15,ID2 ADDR. OF IGG08102 @Z40MSMI 65500048 BR R15 BRANCH TO MODULE @Z40MSMI 65510048 EJECT 65550048 WTOR EQU * Y02072 65552002 *********************************************************************** 65554002 * 65556002 * CLEAR REPLY AREA AND REPLY UCS ID SAVE AREA 65558002 * THEN ISSUE WTOR IN PROBLEM STATE 65558402 * 65558802 *********************************************************************** 65559202 * 65559602 MVC SPWREPLY,BLANKS CLEAR REPLY AREA 65559702 MVI SPWRPECB,0 RESET REPLY ECB 65559902 * 65563202 WTOR MF=(E,SPWRPLYA) ISSUE WTOR IN PROB STATE Y02072 65566702 ST R1,SPWMSGID SAVE MSG ID FOR DOM @ZA25004 65567348 OI SPWMSGID,X'80' SET FLAG FOR ONE MSG @ZA25004 65567948 * 65568702 BR R14 RETURN TO SYNCH Y02072 65570002 SPACE 3 65580002 *********************************************************************** 65600002 * THIS SUBROUTINE FINDS A MESSAGE IN THE MESSAGE CSECT 65650002 * AND MOVES IT INTO THE SETPRINT WORK AREA 65700002 * INPUT: RWRK2 CONTAINS AN INDEX OFFSET (MSG NUMBER * 2) 65750002 * SPRMSG CONTAINS THE ADDRESS OF THE MESSAGE CSECT 65800002 * ADDRESSIBILITY REQUIRED: 65810002 * SVRB EXTENDED SAVE AREA 65820002 * SETPRT WORK AREA 65830002 * OUTPUT:RWRK2 POINTS TO MESSAGE TEXT IN MSG CSECT 65850002 * RWRK8 POINTS TO THE MSG ENTRY IN MSG CSECT 65900002 * SPWMSGTX CONTAINS A COPY OF THE MESSAGE TEXT 65950002 * THIS ROUTINE RETURNS ON REGISTER RRET 66000002 * ALL REGISTERS EXCEPT RWRK2 AND RWRK8 ARE TRANSPARENT 66010002 *********************************************************************** 66020002 GETMSG L RWRK8,SPRMSG PICK UP MSG CSECT ADDR Y02072 66050002 USING MSGINDEX,RWRK8 Y02072 66100002 AH RWRK8,MSGINDOF(RWRK2) ADD ENTRY OFFSET Y02072 66150002 USING MSGENTRY,RWRK8 Y02072 66200002 SR RWRK2,RWRK2 Y02072 66250002 IC RWRK2,MSGOFF PICK UP TEXT OFFSET Y02072 66300002 AR RWRK2,RWRK8 GET PTR TO TEXT Y02072 66350002 USING MSGTXT,RWRK2 Y02072 66360002 MVC SPWMSGTX,MSGTXT MOVE IT INTO WORK AREA Y02072 66370002 BR RRET RETURN TO CALLER Y02072 66380002 DROP RWRK2,RWRK8 Y02072 66390002 SPACE 2 66392002 *********************************************************************** 66400018 * THIS ROUTINE FILLS IN THE UNIT NAME AND IMAGE ID 66500002 * IN MESSAGES WHICH HAVE ALREADY BEEN MOVED TO THE WORK AREA 66550002 * INPUT: RWRK8 POINTS TO THE MESSAGE ENTRY IN MSG CSECT 66560002 * SPWREPID CONTAINS THE IMAGE ID TO FILL IN 66570002 * ADDRESSIBILITY REQUIRED: 66580002 * UCB 66582002 * SETPRT WORK AREA 66584002 * OUTPUT:SPWREPID AND UCBNAME HAVE MEEN MOVED TO THE 66590002 * APPROPRIATE OFFSETS FROM SPWMSGTX 66592002 * RWRK8 IS UNCHANGED FROM INPUT 66592402 * THIS ROUTINE RETURNS ON REGISTER RRET 66593202 * ALL REGISTERS EXCEPT RWRK2 ARE TRANSPARENT 66593602 *********************************************************************** 66594002 FILLFLDS EQU * Y02072 66596002 USING MSGENTRY,RWRK8 Y02072 66598002 SR RWRK2,RWRK2 Y02072 66598402 IC RWRK2,MSGOFF1 PICK UP FIRST OFFSET Y02072 66598802 LA RWRK2,SPWMSGTX(RWRK2) POINT TO VAR IN WORKAREA Y02072 66599202 MVC 0(L'UCBNAME,RWRK2),UCBNAME MOVE IN UCBNAME Y02072 66599602 SR RWRK2,RWRK2 Y02072 66649602 IC RWRK2,MSGOFF2 PICK UP SECOND OFFSET Y02072 66699602 LA RWRK2,SPWMSGTX(RWRK2) POINT TO VAR IN WORKAREA Y02072 66699702 MVC 0(L'SPWREPID,RWRK2),SPWREPID MOVE IN IMAGE ID Y02072 66699802 BR RRET Y02072 66699902 DROP RWRK8 Y02072 66733202 EJECT 66766702 *********************************************************************** 66800018 * CONSTANTS 66850002 *********************************************************************** 66860002 * 66900018 FULLWORD DS 0F FORCE TO FULLWORD M5143 66920020 * BOUNDARY M5143 66940020 BLDLCNST DC AL2(1,SPWBLDLN) BLDL LIST HEADER Y02072 67000002 UCSCONST DC C'UCS1' UCS IMAGE MEMBER NAME 67100018 FOLDCN DC C'FOLD' MESSAGE 'FOLD' 67200018 VERIFYCN DC C'VERIFY' MESSAGE 'VERIFY' 67300018 CANCELCN DC C'CANCEL' MESSAGE 'CANCEL' 67400018 UBLANK DC C'U ' REPLY = 'U' 67500018 CBLANK DC C'C ' REPLY = 'C' 67600018 VBLANK DC C'V ' REPLY = 'V' 67700018 BLANKS DC CL16' ' CONSTANT =BLANKS S20202 67850002 LOWER EQU BLANKS MASK TO ALLOW LOWER CASE ALPHAS 67860002 * 67900018 * BRANCH TABLE 70200048 * 70300018 ID2 DC V(IGG08102) UCS IMAGE LOAD @Z40MSMI 70350048 ID3 DC V(IGG08103) FCB IMAGE LOAD @Z40MSMI 70400048 * 70450002 * PATCH AREA 70500002 * 70550002 PATCH DC 25H'0' PATCH AREA YM5703 70552002 END EQU * END OF MODULE Y02072 70610002 TITLE 'IGG08101 - SETPRT LOAD 2 - DSECTS' 70650002 DCBD DSORG=PS 74300018 EJECT 74400002 SRT DSECT 75200018 * 75300018 IEFUCBOB 75400018 EJECT 75750002 IEZDEB 75800002 EJECT 75850002 IEZIOB 75900002 EJECT 75950002 IHAECB 76000002 EJECT 76050002 IGGSPW 76100002 EJECT 76102002 CHAR DSECT 76104002 * 76106002 *********************************************************************** 76108002 * 76110002 * THIS DSECT IS USED TO SCAN THE REPLY FROM THE OPERATOR 76112002 * IT REDEFINES SPWREPLY AND SPWREPID 76112402 * 76114002 *********************************************************************** 76116002 * 76118002 CHAR1 DS C FIRST CHARACTER 76120002 CHAR2 DS C SECOND CHARACTER 76122002 CHAR3 DS C THIRD CHARACTER 76124002 ORG CHAR1+(SPWREPID-SPWREPLY) Y02072 76126002 CHARSAV DS C USED TO SAVE REPLY 76128002 * IN SPWREPID 76130002 * THE FOLLOWING EQUATES ARE USED IN THE SCAN 76132002 BLANK EQU C' ' A BLANK 76134002 COMMA EQU C',' A COMMA 76136002 ALPHAV EQU C'V' V 76138002 ALPHAF EQU C'F' F 76140002 ALPHA EQU X'C0' USED TO CHECK IF CHAR ALPHA 76142002 EJECT 76150002 IHASPP 76200002 EJECT 76250002 IGGMSG Y02072 76300002 END 80200018