8103 TITLE 'IGG08103 - GET FCB IMAGE- ANAL. REPLIES' M0191 00100010 IGG08103 CSECT M0191 00102021 * /* START OF SPECIFICATIONS**** @Z40MSAP 00102110 *01* PROCESSOR = ASSEMXF: 00102210 **** END OF SPECIFICATIONS ** @Z40MSAP*/ 00102310 * 00102402 * MODULE-NAME = IGG08103 00152402 * 00162402 * DESCRIPTIVE-NAME = LOAD FCB 00172402 * 00182402 * COPYRIGHT = NONE 00192402 * 00194402 * STATUS = VS2-2, LEVEL 0 00196402 * 00200020 * FUNCTION = USE BLDL MACRO TO LOCATE FCB IMAGE IN SYS1.IMAGELIB 00300002 * USE LOAD MACRO TO LOAD THE FCB IMAGE INTO CPU STORAGE 00400002 * FROM SYS1.IMAGELIB 00500020 * WHEN THE FCB IMAGE IS NOT FOUND, ISSUE A WTOR MESSAGE 00600002 * IEC127D REQUESTING THE OPERATOR TO SPECIFY AN ALTERNATE 00700020 * FCB IMAGE 00800020 * ANALYZE OPERATOR REPLYS AND ISSUE WTOR MESSAGE IEC125I 00900002 * IF IT IS INVALID 00950002 * 01100020 * NOTES = 01150002 * DEPENDENCIES = BLANK AND COMMA ARE USED--CORRECTABLE BY 01200002 * REASSEMBLY. THE FOLLOWING CHARACTER STRINGS ARE USED IN 01250002 * TESTING OPERATOR REPLIES: 01300002 * 'A', 'V', 'U', 'C', 'ALIGN', 'VERIFY', 'CANCEL' 01350002 * THESE STRINGS ARE CONSIDERED TO BE OPERATING SYSTEM KEYWORDS 01400002 * RATHER THAN LANGUAGE DEPENDENT PHRASES. 01450002 * 01500002 * BLANKS ARE OR'ED TO ALL REPLIES TO CONVERT THEM TO UPPER CASE 01550002 * 01600002 * RESTRICTIONS = NONE 01650002 * 01700002 * REGISTER-CONVENTIONS = ALL REGISTER NAMES BEGIN WITH R 01750002 * SEE EQUATES IMMEDIATELY FOLLOWING PROLOG 01800002 * 01810002 * PATCH-LABEL = PATCH, AN AREA ASSEMBLED AS BINARY 0 01820002 * 01830002 * MODULE-TYPE = 01840002 * PROCESSOR = OS/VS ASSEMBLER 01842002 * 01844002 * MODULE-SIZE = 690 DECIMAL BYTES 01846002 * 01848002 * ATTRIBUTES = REENTRANT, ENABLED, PRIVELEGED, 01848402 * EXECUTES IN SETPRT INVOKER KEY 01848802 * CODE AT ENTRY POINT WTOR IS NON-PRIVELEGED 01849202 * 01849602 * ENTRY POINT = IGG08103 01849702 * PURPOSE = SEE FUNCTION 01849802 * 01849902 * LINKAGE = BRANCH FROM IGC0008A,IGG08101, OR IGG08102 01866610 * 01876602 * INPUT = 02043202 * REGISTER 4(RSPW) = WORK AREA ADDRESS 02043602 * REGISTER 5(RPAR) = PARAMETER LIST ADDR 02044002 * REGISTER 6(RSVR) = SVRB EXTENDED SAVE AREA ADDRESS 02044402 * REGISTER 12(RWK5) = RETURN CODE FOR USER FROM UCS LOADS 02045202 * 02053002 * OUTPUT = 02103002 * REGISTERS = TO INVOKER 02153002 * R0 = UNDEFINED 02203002 * R1 = UNDEFINED 02253002 * R2-R14 = UNCHANGED 02303002 * R15 = RETURN CODE (SEE EXIT-ERROR) 02353002 * 02363002 * REGISTERS = TO IGG08104 02373002 * R0-R3 = UNDEFINED 02383002 * R4(RSPW) = AS FOR INPUT 02393002 * R5/BYTE 0(RPAR) = UCS RETURN CODE 02393102 * R5/BYTES 1-3(RPAR) = PARAMETER LIST ADDRESS 02393402 * R6(RSVR) = AS FOR INPUT 02393802 * R7 = UNDEFINED 02395002 * R8(RWK4) = ADDR OF IMAGE TO BE LOADED 02397002 * R9(RIOB) = AS FOR INPUT 02399002 * R10-R14 = UNDEFINED 02399410 * R15 = RESERVED FOR BRANCH INTERFACE 02399810 * 02399902 * MESSAGES = RETRIEVED FROM IGGMSG01 02442802 * 'IEC127D XXX,YYYY FCB IMAGE NOT FOUND' 02444402 * 'IEC125I ERROR - REPEAT REPLY' 02460002 * 02500020 * EXITS-NORMAL = BRANCH TO IGG08104 TO LOAD THE FCB 02550010 * 03300020 * EXITS-ERROR = WHEN OPERATOR CANCELS, RETURN CONTROL TO CALLER 03400002 * WITH RETURN CODE = 04 03500002 * WHEN PERMANENT I/O ERRORS OCCUR DURING BLDL, 03600002 * RETURN CONTROL TO CALLER WITH RETURN CODE = 08. 03700002 * 03710002 * ENTRY-POINT = WTOR (INTERNAL ENTRY) 03750002 * PURPOSE = ISSUE WTOR SVC IN PROBLEM STATE TO AVOID INTEGRITY 03800002 * EXPOSURE FROM NON-PROTECTED MESSAGE 03850002 * 03860002 * LINKAGE = SYNCH FROM WITHIN THIS MODULE 03870002 * 03880002 * INPUT = 03890002 * REGISTER 4(RSPW) = WORK AREA ADDRESS 03892002 * REGISTER 14(R14) = RETURN ADDRESS 03894002 * 03896002 * OUTPUT = 03898002 * REGISTERS = TO INVOKER 03898402 * R0 = UNDEFINED 03898802 * R1 = UNDEFINED 03899202 * R2-R14 = UNCHANGED 03899602 * R15 = UNDEFINED 03899702 * 03899802 * EXTERNAL REFERENCES = 03899902 * ROUTINES = BLDL (SVC 18) 03933202 * DELETE (SVC 9) 03943202 * FREEMAIN(SVC 10) 03953202 * IGG08104(SETPRT LOAD 5) 03965202 * IMGLIB (SVC105) 03965602 * LOAD (SVC 8) 03966002 * SYNCH (SVC 12) 03966402 * WAIT (SVC 1) 03966502 * WTOR (SVC 35) 03966602 * 03987702 * DATA-AREAS = SPP -- SETPRT PARAMETER LIST 03988102 * SPW5 -- BLDL PARAMETER LIST @Z40MSAP 03988210 * SPW -- SETPRT WORK AREA 03988502 * SPRBXSV -- RB EXTENDED SAVE AREA 03988602 * FCBIM -- FCB IMAGE 03988702 * MSG -- MESSAGE CSECT 03988802 * CONTROL-BLOCKS = 03988902 * DCB -- DATA CONTROL BLOCK 03992502 * DEB -- DATA EXTENT BLOCK 03994502 * ECB -- EVENT CONTROL BLOCK 03994902 * EXLST -- DCB EXIT LIST 03995002 * IOB -- INPUT/OUTPUT BLOCK 03995302 * UCB -- UNIT CONTROL BLOCK 03995702 * 03996302 * MACROS = BLDL,DELETE,FREEMAIN,IMGLIB,LOAD,SYNCH,WAIT,WTOR, 04046310 * IEFUCBOB, IEZDEB, IEZIOB, IGGMSG IGGSPW, 04250002 * IHADCB, IHAEXLST, IHAFCBIM, IHASPP, 04250402 * 04252402 * CHANGE ACTIVITY = AS FOLLOWS 04260402 * 04270402 * NOTE = THIS MODULE WAS BROUGHT UP TO STANDARDS FOR VS2-2 04280402 * WHICH CAUSED ALL PREVIOUS RELEASE SEQUENCE NUMBER DELETIONS TO 04290402 * BECOME INVALID. 04292402 * 04294402 * RELEASE 21 DELETIONS 04550402 *THE FOLLOWING PTMS WERE FIXED IN THIS RELEASE = 0151, 0084, 0191, 1759 04600402 *THE FOLLOWING APARS WERE FIXED IN THIS RELEASE - 52346, 50699 04650402 *THE FOLLOWING DEVELOPMENT CODE WAS FOR 2245 SUPPORT - S21092 04700402 * 04750402 * VS2 RELEASE 2 DELETIONS 04800402 *THE FOLLOWING DEVELOPMENT CODE WAS FOR VS2-2 - Y02072 04850402 * YM3920 04900402 * YM5703 04950402 * 04950910 * VS2 RELEASE 4 DELETIONS 04951410 * @Z40MSMI 04951910 * VS2 037 CHANGES 04960410 *C147300,147400 @ZA20901 04970410 *A132910-132950,158500-164500 @ZA20901 04980410 *C147330-147340 @ZA25004 04985448 *A322500,465630-465660 @ZA25004 04990448 *C147300,147340,161500,162500,163000 @ZA28905 04992448 * 04995448 * VS2 RELEASE 4.0 CHANGES/DELETIONS 05000410 *ASSEMBLED WITH NEW VERSION OF BLDL MACRO ZA02250 05050410 * 05100410 EJECT 05150002 *********************************************************************** 05200002 * 05250002 * REGISTER CONVENTIONS USED THROUGH OUT ALL SETPRT MODULES 05300002 * 05350002 *********************************************************************** 05400002 R0 EQU 0 PARAMETER REGISTER 05800002 RWK1 EQU R0 WORK REGISTER 05850002 R1 EQU 1 PARAMETER REGISTER 05900002 RWK2 EQU R1 WORK REGISTER 05950002 RDCB EQU 2 DCB REGOSTER 06000002 RBASE EQU 3 BASE REGISTER 06100002 RCORE EQU 4 ADDRESS OF MESSAGE/WORK AREA 06200020 RPAR EQU 5 PARAMETER LIST ADDRESS 06300020 RSVR EQU 6 SVRB EXTENDED SAVE AREA 06400002 RRET EQU 7 SUBROUTINE RETURN 06500002 RWK4 EQU 8 WORK REGISTER 06600002 RIOB EQU 9 IOB REGISTER 06700002 RUCB EQU 10 UCB REGISTER 06800002 RDEB EQU 11 DEB REGISTER 06900002 RBLDL EQU RDEB BLDL PARAMETER LIST YM5703 06950002 RWK5 EQU 12 WORK REGISTER 07000002 RWK6 EQU 13 WORK REGISTER 07100002 R14 EQU 14 PARAMETER REGISTER 07200002 RWK7 EQU R14 WORK REGISTER 07250002 R15 EQU 15 PARAMETER REGISTER 07300002 RWK8 EQU R15 WORK REGISTER 07350002 EJECT 07400002 *********************************************************************** 07450002 * RETURN CODES 07500002 * 07800020 NOERR EQU X'00' RETURN CODE FOR SUCCESSFUL 09500002 * COMPLETION 09550002 NOTINCOR EQU X'04' RETURN CODE FOR FCB IMAGE NOT 09600002 * FOUND 09650002 PERMIOER EQU X'08' RETURN CODE FOR PERM I/O ERROR 09700002 * 09750002 *********************************************************************** 09800002 * MESSAGE NUMBERS IN IGGMSG01 09850002 * ALL MESSAGE NUMBERS HAVE BEEN DOUBLED IN THESE EQUATES 09900002 * TO PROVIDE OFFSETS INTO THE MESSAGE CSECT. 09950002 * THIS IS DEPENDENT ON L'MSGINDOF BEING 2. 10000002 * 10050002 MSG127 EQU 11*2 IEC127D Y02072 10100002 MSG125 EQU 8*2 IEC125A Y02072 10150002 * 10200002 *********************************************************************** 10250002 * OTHER EQUATES 10300002 * 10350002 BLANK EQU X'40' CONSTANT=' ' 10500020 COMMA EQU C',' CONSTANT=',' 10600020 PRT2245 EQU X'0B' MASK FOR 2245 PRINTER S21092 13206021 F2245ID EQU C'K' CNST FOR 2245 ID'S M0191 13212002 ERRCODE EQU 4 FOR TESTING RETURN CODE FROM 13280002 * BLDL 13290010 NOFCBLD EQU X'40' FCB NOT TO BE LOADED @ZA20901 13291010 ALIGNMSK EQU X'01' ALIGN FCB @ZA20901 13292010 VERFYMSK EQU X'80' VERIFY FCB @ZA20901 13293010 FCBOFSET EQU X'08' OFFSET TO FCBID IN UCB @ZA20901 13294010 RTNCD00 EQU X'00' RETUN CODE OF X'00' @ZA20901 13295010 EJECT 13300002 * 13500020 * INITIALIZE REGISTERS 13600002 * 13900020 USING SPRBXSV,RSVR LOADED ON ENTRY Y02072 13950002 BALR RBASE,0 INIT BASE REG 14000002 USING FCBFN000,RBASE 14100020 FCBFN000 EQU * 14700020 SPACE 14702002 B BEGIN BR AROUND CONSTANTS Y02072 14710002 DC C'IGG08103' MODULE NAME Y02072 14720002 DC C'@ZA28905' LAST SHIP CODE @ZA28905 14730048 DC C'12/21/77' LAST DATE MODIFIED @ZA28905 14734048 BEGIN DS 0H Y02072 14742002 SPACE 14744002 USING SPPARM,RPAR 14750002 L RDCB,SPPDCBA LOAD USER DCB ADDRESS 14900002 USING IHADCB,RDCB 14950002 L RDEB,DCBDEBAD LOAD DEB ADDRESS 15000020 USING DEBBASIC,RDEB 15050002 L RUCB,DEBSUCBA LOAD UCB ADDRESS 15100002 DROP RDEB 15110002 L RBLDL,SPRBLDLA GET ADDR OF BLDL LIST YM5703 15120002 USING SPW5,RBLDL @Z40MSAP 15130010 USING UCBOB,RUCB 15150002 USING SPW,RCORE 15160002 L RWK8,UCBXTADR GET UCB EXTEN ADDR Y02072 15170002 USING UCBUCS,RWK8 Y02072 15180002 MVC SPWFCB2H,UCBFCBID ASSUME USER DID NOT SPEC Y02072 15182002 * AN FCB IMAGE Y02072 15184002 MVI SPWFLG1,0 NO OPTIONS IF USER DID Y02072 15186002 * NOT SPEC IMAGE Y02072 15188002 CLI SPPFCB,0 DID USER SPEC AN IMAGE Y02072 15190002 BE FCBFN001 NO, USE CURRENT IMAGE Y02072 15200002 MVC SPWFCB2H,SPPFCB MOVE FCB IMAGE TO WORKA Y02072 15210002 MVC SPWFLG1,SPPVERAL MOVE FCB OPT BITS TO WORKA 15300002 FCBFN001 EQU * Y02072 15350002 * 15400020 * SAVE RETURN CODE FOR EXIT ROUTINE 15500002 * 15600020 LA RPAR,0(RPAR) CLEAR 0 BYTE 15650002 SLL RWK5,24 SHIFT RETURN CODE TO 0 BYTE 15700002 OR RPAR,RWK5 SAVE UCS RTN CODE IN PARM REG 15800002 TM UCBFCBOP,X'01' PARITY ERROR ON FCB ? @ZA20901 15850010 BO FCBFN005 YES-RELOAD FCB IMAGE @ZA20901 15900010 CLC SPWFCB2H,FCBOFSET(RWK8) SPECIFIED FCB = TO FCB @ZA20901 15950010 * ID IN UCB? @ZA20901 16000010 BNE FCBFN005 NO- GO LOAD FCB IMAGE @ZA20901 16050010 OI SPWFLG1,NOFCBLD SET NO LOAD FCB IMAGE @ZA28905 16150048 TM SPWFLG1,VERFYMSK VERIFY FCB ? @ZA28905 16180048 BO FCBFN005 YES-LOAD FCB TO VERIFY @ZA20901 16210048 TM SPWFLG1,ALIGNMSK ALIGN FCB ? @ZA28905 16240048 BO FCBFN050 YES-EXIT TO NEXT MODUL @ZA20901 16350010 LA RWK5,RTNCD00 NO-SET RET CODE X'00' @ZA20901 16400010 B FCBFN150 RETURN TO PROB PROGRAM @ZA20901 16450010 * 17700020 * CORE TRANSFER ROUTINE 17800002 * CHECK IF THE FCB IMAGE TO BE LOADED IS SPECIFIED IN THE DCBEXLST 17900002 * IF YES, LOAD THE FCB WITH THE IMAGE SPECIFIED BY THE USER'S DCB 18000002 * IF NO, GO TO BLDL ROUTINE TO LOCATE FCB IMAGE IN SYS1.IMAGELIB 18100002 * 18400020 FCBFN005 EQU * 18500002 TM DCBMACF1,DCBMRECP IS THIS AN EXCP DCB YM3920 18550002 BZ FCBFN007 NO, DCB HAS FOUND EXTN YM3920 18600002 TM DCBMACF1,DCBMRFE IS FOUNDATION EXTN PRES YM3920 18650002 BZ FCBFN030 NO, BYPASS LOOKING FOR YM3920 18660002 * EXIT LIST YM3920 18670002 FCBFN007 EQU * YM3920 18680002 L RWK4,DCBEXLST GET ADDRESS OF DCB EXIT LIST 18700002 LA RWK4,0(RWK4) CLEAR RECFM FROM BYTE 0 18800002 LTR RWK4,RWK4 TEST IF DCBEXLST SPECIFIED 18900002 BZ FCBFN030 NO GO TO BLDL ROUTINE 19000020 * 19100020 * FIND FCB IMAGE ADDRESS IN DCB EXIT LIST 19200002 * 19300020 FCBFN010 EQU * 19400020 USING EXLST,RWK4 19450002 CLI EXLCODES,EXLFCBIM CK FOR ENTRY WITH FCB IM ADDR 19600002 BE FCBFN020 YES GO CK IF FCB ID'S EQUAL 19700020 CLI EXLCODES,EXLLASTE+EXLFCBIM TST IF LAST ENTRY IN EXLST 19730002 * IS AND FCB IMAGE 19760002 BE FCBFN020 YES GO CK FCB ID'S 19790020 FCBFN015 EQU * 19850002 TM EXLCODES,EXLLASTE TEST FOR END OF EXLST 19910002 BO FCBFN030 YES GO TO BLDL RTN 19940020 LA RWK4,EXLLENTH(RWK4) INCREMENT POINTER TO NEXT ENTRY 20500002 B FCBFN010 GO CK IF THIS ENTRY FCB IM ADDR 20600020 * 20700020 * FCB IMAGE SPECIFIED IN DCBEXLST -CK IF IT IS IMAGE TO BE LOADED 20800002 * 20900020 FCBFN020 EQU * 21000020 L RWK2,EXLENTRA GET ADDR OF FCB FROM EXLST 21200002 USING FCBIMAGE,RWK2 21250002 LA RWK2,0(RWK2) CLEAR 0 BYTE 21300002 CLC SPWFCB2H,FCBIMGID TST IF FCB ID'S EQUAL 21400002 BNE FCBFN015 NO CONTINUE SEARCHING EXITLST 21500020 LA RWK4,FCBIMBEG GET BEGINNING ADDR OF FCB 21560002 B FCBFN050 GO TO BRANCH TO NEXT EXECUTOR 21700010 DROP RWK2 21750002 * 22000020 * BLDL ROUTINE TO LOCATE FCB IMAGE IN SYS1.IMAGELIB 22100002 * 22200020 FCBFN030 EQU * 22500020 L RWK2,SPWFCB2H GET FCB ID IN USER KEY Y02072 22510002 SPACE 22550002 MODESET EXTKEY=DATAMGT YM5703 22600002 SPACE 22650002 MVC SPWBLDLC,BLDLCNST BLDLIST TO WORK AREA 22700002 MVC SPWFCBMB,FCBCONST MOVE PREFIC FOR FCBID 22800002 ST RWK2,SPWBLFCB FCB ID TO BLDL LIST Y02072 22850002 CLI UCBTBYT4,PRT2245 CHECK FOR 2245 PRINTER S21092 22920002 BNE FCBFN035 IF NOT 2245 SKIP NEXT S21092 22940002 * INSTR S21092 22960002 MVI SPWFCB2,F2245ID MOVE 'K' INTO 4TH BYTE M0191 22980002 * OF IMAGE ID (FCBK) M0191 23090002 FCBFN035 EQU * S21092 23420021 L R1,SPRIDCBA GET SYS1.IMAGELIB DCB ADDRESS 23660002 BLDL (1),SPWBLDLC BLDL TO FIND FCB IMAGE 23800002 SPACE 23850002 MODESET KEYADDR=SPRKEY,WORKREG=14 YM5703 23860002 SPACE 23870002 * 23900020 * TEST RETURN CODE FROM BLDL 24000002 * -X'00' - FOUND 24100002 * -X'04' - NOT FOUND 24200002 * -X'08' - PERM I/O ERROR 24300002 * 24400020 LA RWK7,ERRCODE SET REG TO TEST RETURN CODE 24500002 CLR R15,RWK7 TEST RETURN CODE FROM BLDL 24600002 BL FCBFN040 FCB IMAGE FOUND-GO LOAD FCB IM 24700020 BE FCBFN055 FCB IMG NOT FOUND GO ISSUE WTOR 24800002 * 25200020 * PERMANENT I/O ERROR DURING BLDL - RETURN TO PROBLEM PROG WITH 25300002 * RETURN CODE X'08' IN BITS 16-23 OF REG 15. 25400002 * IF I/O ERROR PERSIST, RUN C.E. DIAGNOSTICS FOR SYSTEM RESIDENT DASD 25500002 * 25600020 LA RWK5,PERMIOER SET RETURN CODE =X'08' 25900002 B FCBFN150 GO TO FREE MESSAGE/WORK AREA 26000020 * 26300020 * WHEN FCB IMAGE IS FOUND IN SYS1.IMAGELIB LOAD FCB IMAGE 26400002 * 26700020 FCBFN040 EQU * 26800020 L RWK6,SPWBLFCB SAVE FCB IMGID 27000002 MVC SPWFCBIM,SPWFCBMB MOVE FCB IMGID 27100002 L R1,SPRIDCBA GET ADDR OF SYS1.IMAGELIB DCB 27300002 SPACE 27350002 MODESET EXTKEY=DATAMGT YM5703 27360002 * 27400020 LOAD DE=SPWFCBMB,DCB=(1) LOAD FCB FROM SYS1.IMAGELIB 27500002 SPACE 27550002 MODESET KEYADDR=SPRKEY,WORKREG=8 YM5703 27560002 * 27600020 OI SPWFLG5,SPWFCBDE INDIC TO 8104 THAT IMAGE Y02072 27650002 * MUST BE DELETED Y02072 27660002 LR RWK4,R0 GET ADDR OF FCB LOADED 27700002 * 28000020 * BRANCH ROUTINE 28100010 * 28400020 FCBFN050 EQU * 28500020 L R15,ID4 ADDRESS OF 0GG08104 @Z40MSMI 29200010 BR R15 BRANCH TO NEXT MODULE @Z40MSMI 29250010 * 29500020 * WTOR 'IEC127D XXX,YYYY FCB IMAGE NOT FOUND' REQUEST OPERATOR 29600002 * TO SPECIFY AN ALTERNATE FCB IMAGE OR CANCEL ATTEMPT TO LOAD FCB 29700002 * 30000020 FCBFN055 EQU * 30030020 MVC SPWREPID,SPWBLFCB SAVE FCB ID FOR MESSAGE 30100002 LA RWK2,MSG127 INDICATE MSG WANTED Y02072 30200002 BAL RRET,GETMSG GO GET MESSAGE Y02072 30250002 BAL RRET,FILLFLDS FILL IN ID AND UNIT Y02072 30300002 * 30600020 * CLEAR REPLY AREA AND FCB ID SAVE AREA / ISSUE WTOR AND WAIT 30700002 * 30800020 FCBFN060 EQU * 30900020 MVC SPWREPLY,CLEARFLD CLEAR REPLY AREA 31200002 MVC SPWREPID,CLEARFLD CLEAR REPLY NAME 31400002 MVI SPWRPECB,0 RESET REPLY ECB 31500002 TM SPRKEY,SPRUSKEY IF CALLED AS SYS FUNCT Y02072 31550002 BZ FCBFN065 DO NOT SYNCH TO WTOR Y02072 31600002 SYNCH WTOR ISSUE WTOR IN PROB STATE Y02072 31650002 B WAIT THEN WAIT FOR COMPLETION Y02072 31700002 FCBFN065 EQU * SYS WTOR Y02072 31750002 BAL R14,WTOR ISSUE WTOR IN SUP STATE Y02072 31800002 WAIT EQU * Y02072 31850002 WAIT ECB=SPWRPECB,LONG=YES ISSUE WAIT FOR REPLY Y02072 32200002 XC SPWMSGID(4),SPWMSGID CLEAR MSG ID @ZA25004 32250048 * 32500020 * TEST OPERATOR REPLY FOR ONE OF THE FOLLOWING 32600002 * (1) 'U'- USE CURRENT FCB IMAGE - RETURN PROB PROG- RETURN CODE=00 32700002 * (2) 'C'- CANCEL RETURN TO PROBLEM PROGRAM RETURN CODE =X'04' 32800002 * (3) FCB IMAGE REPLIED - ANALIZE FCB IMAGE 32900002 * 33200020 OC SPWREPLY,LOWERCSE SET FOR LOWER CASE REPLY 33300002 LA RWK5,NOERR LOAD RETURN CODE=X'00' 33400002 CLC SPWREPLY(L'USECON),USECON CK IF REPLY='U' USE 33500002 BE FCBFN075 YES, USE CURRENT IMAGE Y02072 33600002 CLC SPWREPLY(L'CANCEL01),CANCEL01 CK IF REPLY='CANCEL' 33700002 BE FCBFN070 YES GO SET RET CODE =X'04' 33800020 CLC SPWREPLY(L'CANCEL02),CANCEL02 CK IF REPLY='C ' CANCEL 33900002 BNE FCBFN080 NO GO TO ANALIZE REPLY 34000020 * 34100020 * OPERATOR CANCELED FCB LOAD BECAUSE SPECIFIED FCB IMAGE WAS NOT 34200002 * IN CORE OR IN SYS1.IMAGELIB, RETURN CODE =X'04' AND RETURN TO 34320002 * PROBLEM PROGRAM 34400002 * 34500020 FCBFN070 EQU * 34600020 LA RWK5,NOTINCOR SET RETURN CODE =X'04' 34800002 B FCBFN150 GO EXIT TO PROBLEM PROGRAM 34900020 * 34950002 * OPERATOR REPLIED 'U'. DO FCB LOAD USING CURRENT IMAGE. Y02072 35000002 * 35050002 FCBFN075 EQU * Y02072 35100002 MVC SPWFCB2H,UCBFCBID FCB IMAGE ID TO WORKA Y02072 35150002 MVI SPWFLG1,0 NO OPTIONS Y02072 35160002 B FCBFN030 GO DO BLDL FOR IMAGE, DO Y02072 35170002 * NOT LOOK FOR IMAGE IN Y02072 35180002 * AN EXIT LIST Y02072 35190002 * 35200020 * ANALYSIS OF FCB IMAGE ID SPECIFIED BY OPERATOR 35300002 * 35600020 FCBFN080 EQU * 35700020 LA RWK7,SPWREPLY GET ADDRESS OF REPLY 35900002 LA RWK8,L'SPWFCB2H SET LOOP COUNTER TO TEST 36000002 * FOR INVALID FCB LENGTH 36100002 DROP RCORE 36150002 USING SPWREPLY,RWK7 36160002 CLI SPWREPLY,COMMA CK FOR , IN FIRST POSITION 36200002 BE FCBFN170 YES GO TO REPEAT REPLY MSG 36300020 CLI SPWREPLY,BLANK CK FOR BLANK IN 1ST POSITION 36400002 BE FCBFN170 YES GO TO REPEAT REPLY MSG 36500020 * 36600020 * SEPERATE FCB IMAGE ID FROM REPLY 36700002 * 36800020 FCBFN090 EQU * 36900020 MVC SPWFCB2H(1),SPWREPLY MOVE ONE CHAR OF FCB ID TO 37100002 * FCB IMAGE ID AREA 37200002 LA RWK7,1(RWK7) IMCREMENT REPLY POINTER BY ONE 37300002 CLI SPWREPLY,BLANK CK FOR BLANK (END OF FCB ID) 37400002 BE FCBFN130 YES GO CK IF BLDL REQUIRED 37500020 CLI SPWREPLY,COMMA CK IF THIS CHAR IS A COMMA 37600002 BE FCBFN100 YES GO CK FOR VERIFY OR ALIGN 37700020 BCT RWK8,FCBFN090 GO MOVE NXT CHAR TO FCB SAVE 37800002 B FCBFN170 IF REPLY ID GT 4 GO ISSUE 37900020 * REPEAT REPLY MESSAGE 38000002 * 38100020 * TEST IF THE FCB IMAGE IS TO BE VERIFIED OR FORMS ALIGNED 38200002 * 38300020 FCBFN100 EQU * 38400020 CLC SPWFCBOR(L'VERIFY01),VERIFY01 CK IF VERIFY SPECIFIED 38600002 BE FCBFN120 YES GO SET VERIFY BIT ON 38700020 CLC SPWFCBOR(L'VERIFY02),VERIFY02 CK IF 'V' VERIFY 38800002 * SPECIFIED 38850002 BE FCBFN120 YES GO SET VERIFY BIT ON 38900020 CLC SPWFCBOR(L'ALIGN01),ALIGN01 CK IF ALIGN SPECIFIED 39000002 BE FCBFN110 YES GO SET ALIGN FORMS BIT 39100020 CLC SPWFCBOR(L'ALIGN02),ALIGN02 CK IF 'A' ALIGN SPECIFIED 39200002 BNE FCBFN170 NO GO TO ISSUE REPEAT REPLY MSG 39300020 DROP RWK7 39350002 USING SPW,RCORE 39400002 FCBFN110 EQU * 39500020 MVI SPWFLG1,SPWALIGN SET ALIGN FORMS BIT FOR FCB 39700002 B FCBFN005 GO TO CK IF BLDL REQUIRED 39800020 FCBFN120 EQU * 40000020 MVI SPWFLG1,SPWVRFCB SET VERIFY FCB BIT ON 40200002 B FCBFN005 GO TO CK IF BLDL REQUIRED 40300020 FCBFN130 EQU * 40500020 MVI SPWFLG1,0 RESET FCB OPTION BITS 40700002 B FCBFN005 GO CK IF BLDL REQUIRED 40800020 EJECT 40810002 * 40850002 * CLEAN UP AND RETURN TO USER WITH RETURN CODE IN BITS 16-23 YM5703 40900002 * OF REGISTER 15. YM5703 40950002 * 41000002 FCBFN150 EQU * 41700020 * 41872102 * RESTORE IOB TO ORIGIONAL STATUS Y02072 41872202 * 41872302 USING IOBQSAMN,RIOB 41872402 MVC IOBFLAG1(4),SPWFLGSV RESTORE IOB FLAGS Y02072 41872502 MVC IOBSTART,SPWSTRSV RESTORE IOB START ADDR Y02072 41872602 DROP RIOB 41872702 SPACE 41872802 MODESET EXTKEY=SUPR KEY OF SVRB Y02072 41872902 SPACE 41873002 SR RWK6,RWK6 PREPARE TO ZERO FIELDS Y02072 41873502 ST RWK6,SPRIOBSV INDIC IOB'S RESTORED Y02072 41873902 SPACE 41874302 IMGLIB CLOSE,SPRIDCBA ISSUE SVC TO CLOSE IMAGELIB 41874702 SPACE 41876702 ST RWK6,SPRIDCBA INDICATE IMGLIB CLOSED Y02072 41878902 ST RWK6,SPRMSG INDICATE MSG CSECT DELTD Y02072 41889202 DELETE EP=IGGMSG01 DELETE MESSAGE CSECT Y02072 42029202 * 42079202 * FREEMAIN SETPRT WORKAREA AND BLDL PARAMETER LIST. YM5703 42129202 * 42179202 MODESET KEYADDR=SPRKEY,WORKREG=1 KEY OF CORE TO FREE Y02072 42189202 SPACE 42199202 FREEMAIN R,LV=SPWLNGTH,A=(RCORE),SP=SPWPOOL Y02072 42200002 SPACE 42250002 MODESET EXTKEY=DATAMGT KEY OF BLDL LIST YM5703 42300002 SPACE 42350002 ST RWK6,SPWWKADR INDIC WORKAREA FREED YM5703 42400002 SPACE 42450002 FREEMAIN R,LV=SPW5LNTH,A=(RBLDL),SP=SPW5POOL @Z40MSAP 42500010 SPACE 42550002 * 43900002 * SET RETURN CODE IN REGISTER 15 AND RETURN 44100002 * 44400020 FCBFN160 EQU * 44500020 MODESET EXTKEY=SUPR KEY TO RETURN IN Y02072 44550002 SPACE 44600002 ST RWK6,SPRBLDLA INDIC BLDL LIST FREED YM5703 44650002 SLL RWK5,8 SHIFT RETURN CODE TO BITS 16-23 44700002 LR R15,RWK5 PUT RETURN CODE IN REG 15 44800002 SRL RPAR,24 MOVE RETURN CODE TO BYTE 3 44900002 OR R15,RPAR INSERT THE RTN CODE M0084 45000002 L R14,SPREXIT GET SAVED EXIT ADDR Y02072 45100002 BR R14 RETURN TO EXIT PROLOG Y02072 45150002 EJECT 45200002 * 45300020 * FORM REPEAT REPLY MESSAGE 'IEC125I ERROR - REPEAT REPLY' 45700002 * 46000020 FCBFN170 EQU * 46100020 LA RWK2,MSG125 INDICATE MSG WANTED Y02072 46300002 BAL RRET,GETMSG GO GET MESSAGE Y02072 46350002 B FCBFN060 GO TO CLEAR REPLY AREA 46500020 SPACE 4 46550002 WTOR WTOR MF=(E,SPWRPLYA) WRITE MESSAGE Y02072 46560002 ST R1,SPWMSGID SAVE MSG ID FOR DOM @ZA25004 46563048 OI SPWMSGID,X'80' SET HIGH ORDER BIT @ZA25004 46566048 BR R14 RETURN TO SYNCH Y02072 46570002 SPACE 3 46580002 GETMSG EQU * Y02072 46590002 *********************************************************************** 46600002 * THIS SUBROUTINE FINDS A MESSAGE IN THE MESSAGE CSECT 46650002 * AND MOVES IT INTO THE SETPRT WORK AREA 46700002 * INPUT: RWK2 CONTAINS AN INDEX OFFSET (MSG NUMBER * 2) 46750002 * SPRMSG CONTAINS THE ADDRESS OF THE MESSAGE CSECT 46760002 * ADDRESSIBILITY REQUIRED: 46770002 * SVRB EXTENDED SAVE AREA 46780002 * SETPRT WORK AREA 46790002 * OUTPUT:RWK2 POINTS TO MESSAGE TEXT IN MSG CSECT 46792002 * RWK8 POINTS TO THE MSG ENTRY IN MSG CSECT 46794002 * SPWMSGTX CONTAINS A COPY OF THE MESSAGE TEXT 46796002 * THIS ROUTINE RETURNS ON REGISTER RRET 46798002 * ALL REGISTERS EXCEPT RWK2 AND RWK8 ARE TRANSPARENT 46798402 *********************************************************************** 46798802 L RWK8,SPRMSG PICK UP MSG CSECT ADDR Y02072 46799202 USING MSGINDEX,RWK8 Y02072 46799602 AH RWK8,MSGINDOF(RWK2) ADD ENTRY OFFSET Y02072 46799702 USING MSGENTRY,RWK8 Y02072 46799802 SR RWK2,RWK2 Y02072 46799902 IC RWK2,MSGOFF PICK UP TEXT OFFSET Y02072 46833202 AR RWK2,RWK8 GET PTR TO TEXT Y02072 46843202 USING MSGTXT,RWK2 Y02072 46853202 MVC SPWMSGTX,MSGTXT MOVE IT INTO WORK AREA Y02072 46863202 BR RRET RETURN TO CALLER Y02072 46865202 DROP RWK2,RWK8 Y02072 46865602 SPACE 3 46865702 FILLFLDS EQU * Y02072 46865802 *********************************************************************** 46866002 * THIS ROUTINE FILLS IN THE UNIT NAME AND IMAGE ID 46866402 * IN MESSAGES WHICH HAVE ALREADY BEEN MOVED TO THE WORK AREA 46866502 * INPUT: RWK8 POINTS TO THE MESSAGE ENTRY IN MSG CSECT 46866602 * SPWREPID CONTAINS THE IMAGE ID TO FILL IN 46877702 * ADDRESSIBILITY REQUIRED: 46887702 * UCB 46888102 * SETPRT WORK AREA 46888502 * OUTPUT:SPWREPID AND UCBNAME HAVE MEEN MOVED TO THE 46888602 * APPROPRIATE OFFSETS FROM SPWMSGTX 46888702 * RWK8 IS UNCHANGED FROM INPUT 46888802 * THIS ROUTINE RETURNS ON REGISTER RRET 46892502 * ALL REGISTERS EXCEPT RWK2 ARE TRANSPARENT 46894502 *********************************************************************** 46894902 USING MSGENTRY,RWK8 Y02072 46895702 SR RWK2,RWK2 Y02072 46896102 IC RWK2,MSGOFF1 PICK UP FIRST OFFSET Y02072 46896202 LA RWK2,SPWMSGTX(RWK2) POINT TO VAR IN WORKAREA Y02072 46946202 MVC 0(L'UCBNAME,RWK2),UCBNAME MOVE IN UCBNAME Y02072 46956202 SR RWK2,RWK2 Y02072 46966202 IC RWK2,MSGOFF2 PICK UP SECOND OFFSET Y02072 46976202 LA RWK2,SPWMSGTX(RWK2) POINT TO VAR IN WORKAREA Y02072 46986202 MVC 0(L'SPWREPID,RWK2),SPWREPID MOVE IN IMAGE ID Y02072 46988202 BR RRET Y02072 46990202 DROP RWK8 Y02072 46992202 EJECT 46994202 * 46996202 * CONSTANTS 47046202 * 47200020 DS 0F ALIGN ON WORD BD 47230020 BLDLCNST DC AL2(1,SPWBLDLN) BLDL LIST 47300002 FCBCONST DC C'FCB2' PREFIX FOR FCB IMG ID 47400020 USECON DC C'U ' OPERATOR REPLY=USE 47500020 CANCEL01 DC C'CANCEL' OPERATOR REPLY=CANCEL 47600020 CANCEL02 DC C'C ' OPERATOR REPLY=C 47700020 ALIGN01 DC C'ALIGN' OPERATOR REPLY=ALIGN 47800020 ALIGN02 DC C'A ' OPERATOR REPLY=A 47900020 VERIFY01 DC C'VERIFY' OPERATOR REPLY=VERIFY 48000020 VERIFY02 DC C'V ' OPERATOR REPLY=V 48100020 LOWERCSE DC CL16' ' LOWER CASE MASK 48200002 CLEARFLD EQU LOWERCSE USED TO CLEAR FIELDS IN 48250002 * WORK AREA 48260002 * 50500020 * BRANCH TABLE 50600010 * 50700020 ID4 DC V(IGG08104) NEXT MODULE EXECUTED @Z40MSMI 50710010 * 50720002 PATCH DC 25H'0' PATCH AREA Y02072 50720402 END EQU * END OF MODULE Y02072 50724002 TITLE 'IGG08103--DCB DSECT' 50800002 IHADCB DSORG=PS,DEVD=PR 54100002 TITLE 'IGG08103--DEB DSECT' 54900002 IEZDEB 54950002 TITLE 'IGG08103--DCB EXLST DSECT' 55300002 IHAEXLST 55350002 TITLE 'IGG08103--FCB IMAGE DSECT' 55360002 IHAFCBIM 55370002 TITLE 'IGG08103--IOB DSECT' 55400002 IEZIOB 55400402 TITLE 'IGG08103--DSECT FOR MESSAGE CSECT' 55400802 IGGMSG Y02072 55401202 TITLE 'IGG08103--SETPRT PARAMETER LIST DSECT' 55402002 IHASPP 55404002 TITLE 'IGG08103--SETPRT WORKAREA DSECT' 55410002 IGGSPW 55420002 TITLE 'IGG08103--UCB DSECT' 55430002 SRT DSECT 55440002 IEFUCBOB 55442002 END 55600020