8104 TITLE ' IGG08104 - LOAD FCB, VERIFY FCB, FREE AREAS' Y02072 00100003 IGG08104 CSECT M0191 00102021 * /* START OF SPECIFICATIONS**** @Z40MSAP 00102410 *01* PROCESSOR = ASSEMXF: 00102810 **** END OF SPECIFICATIONS ** @Z40MSAP*/ 00103210 * 00104002 *MODULE-NAME = IGG08104 00154002 * 00204002 *DESCRIPTIVE-NAME = SETPRT FCB LOAD AND VERIFY 00254002 * 00256002 *COPYRIGHT = NONE 00258002 * 00258402 *STATUS = LEVEL 001 00258803 * 00260021 *FUNCTION = EXECUTE LOADING OF FORMS CONTROL BUFFER (FCB) 00300002 * - WHEN VERIFY SPECIFIED PRINT OUT FCB IMAGE FOR VISUAL 00400002 * VERIFICATION AND HAVE OPERATOR VERIFY FORMS ALIGNMENT 00500002 * - WHEN ALIGN SPECIFIED, HAVE OPERATOR VERIFY FORMS ALIGNMENT 00600002 * - UPDATE UCB TO SHOW STATUS OF FCB 00700002 * - DELETE FCB IMAGE LOADED 00800002 * - FREE SETPRT MESSAGE/WORK AREA 00900002 * - FREE BLDL PARAMETER LIST YM5703 00950002 * 01000020 *NOTES = 01050002 * DEPENDENCIES = BLANK IS USED--CORRECTABLE BY REASSEMBLY. 01100002 * THE FOLLOWING CHARACTER STRINGS ARE USED IN 01150002 * TESTING OPERATOR REPLIES: 01200002 * 'V', 'R', 'C', 'RETRY', 'VERIFY', 'CANCEL' 01250002 * THESE STRINGS ARE CONSIDERED TO BE OPERATING SYSTEM KEYWORDS 01300002 * RATHER THAN LANGUAGE DEPENDENT PHRASES. 01350002 * 01400002 * BLANKS ARE OR'ED TO ALL REPLIES TO CONVERT THEM TO UPPER CASE 01450002 * 01500002 * RESTRICTIONS = NONE 01550002 * 01600002 * REGISTER-CONVENTIONS = ALL REGISTER NAMES BEGIN WITH R 01650002 * SEE EQUATES IMMEDIATELY FOLLOWING PROLOG 01700002 * 01750002 * PATCH-LABEL = PATCH, AN AREA ASSEMBLED AS BINARY 0 01800002 * 01850002 *MODULE-TYPE = 01900002 * PROCESSOR = OS/VS ASSEMBLER 01950002 * 02000002 * MODULE-SIZE = 1100 DECIMAL BYTES 02050002 * 02100002 * ATTRIBUTES = REENTRANT, ENABLED, PRIVELEGED, 02150002 * EXECUTES IN SETPRT INVOKER KEY 02200002 * CODE AT ENTRY POINT WTOR IS NON-PRIVELEGED 02250002 * 02300002 *ENTRY POINT = IGG08104 02350002 * PURPOSE = SEE FUNCTION 02400002 * 02450002 * LINKAGE = BRANCH FROM IGG08103 02500010 * 02550002 *INPUT = 02600002 * REGISTER 4(RSPW) = WORK AREA ADDRESS 02650002 * REGISTER R5/BYTE 0(RPAR) = UCS RETURN CODE 02700002 * REGISTER R5/BYTES 1-3(RPAR) = PARAMETER LIST ADDRESS 02750002 * REGISTER 6(RSVR) = SVRB EXTENDED SAVE AREA ADDRESS 02800002 * REGISTER 8(RWK4) = ADDR OF IMAGE TO BE LOADED 02850002 * REGISTER 9(RIOB) = IOB ADDRESS 02900002 * 02950002 *OUTPUT = 03000002 * REGISTER 15(R15) = RETURN CODE (SEE EXITS) 03050002 * 03100002 * MESSAGES = RETRIEVED FROM IGGMSG01 03150002 * 'IEC125A ERROR - REPEAT REPLY' 03200002 * 'IEC128D V XXXX,VERIFY FORMS ALIGNMENT' 03250002 * 'LINE NN CHANNEL NN FCB ID=XXXX SPACING=N LPI' - FCB HEADING VER 03300002 * 'CHANNEL' - INSERT FOR FCB VERIFICATION 03350002 * 'LINE NN CHANNEL NN' - FCB PRINT LINE FOR VERIFICATION 03400002 * 'LINE NN CHANNEL NN END' - FCB FINAL PRINT LINE FOR VERIFICATION 03450002 * 03500002 * UCB = UPDATED TO REFLECT NEW FCB IMAGE 03550002 * 03600002 * PRINTER = FORMS CONTROL BUFFER IS LOADED 03650002 * 03700002 *EXITS = 03750002 * NORMAL = RETURN TO SUPERVISOR WITH RETURN CODE = 0 IN BITS 15-31 03800002 * OF REGISTER 15 FOR SUCCESSFUL FCB OPERATION 03850002 * = REGISTER 15 BITS 0-15 WITH UCS RETURN CODE 03860002 * 03900002 * ERROR = RETURN TO SUPERVISOR WITH RETURN CODE IN BITS 15-31 OF 03950002 * REGISTER 15 FOR UNSUCCESSFUL FCB OPERATION = 04000002 * X'0C' - PERMANENT I/O ERROR DURING FCB LOAD 04050002 * X'10' - PERMAINENT I/O ERROR DURING FCB IMAGE VERIFY 04100002 * X'14' - OPERATOR CANCELED REPLY TO IEC128D 04150002 * 04200002 *EXTERNAL REFERENCES = 04250002 * ROUTINES = EXCP (SVC 0) 04300002 * WAIT (SVC 1) 04350002 * DELETE (SVC 9) 04400002 * IMGLIB (SVC 105) 04450002 * FREEMAIN (SVC 10) 04500002 * SYNCH (SVC 12) 04550002 * WTOR (SVC 35) 04560002 * SETLOCK (BALR 14,13) 04570002 * DEBCHK (BALR 14,15) 04580002 * 04590002 * DATA-AREAS = SPP - SETPRT PARM LIST 04600002 * SPW5 - BLDL PARM LIST @Z40MSAP 04610010 * SPW - SETPRT WORK AREA 04650002 * FCBIMAGE - FORMS CONTROL BUFFER IMAGE 04700002 * MSG CSECT - IGGMSG01 04750002 * SPRBXSV - SVRB EXTENDED SAVE AREA 04800002 * 04850002 * CONTROL-BLOCKS = DCB, IOB, UCB, ECB, DEB 04900002 * 04950002 * MACROS-ACTION = EXCP, WAIT, DELETE, IMGLIB, FREEMAIN, SYNCH, WTOR, 05000002 * SETLOCK (OBTAIN AND RELEASE), MODESET 05050002 * 05052002 * MACROS-MAPPING = IGGSPW, IHASPP, IHAFCBIM, IEZIOB, IEFUCBOB, 05060002 * IHAECB, IEZDEB, IHADCB 05070002 * 05100020 *CHANGE ACTIVITY = AS FOLLOWS 05110002 * 05120002 *NOTE = THIS MODULE WAS BROUGHT UP TO STANDARDS FOR VS2-2 05130002 * WHICH CAUSED ALL PREVIOUS RELEASE SEQUENCE NUMBER DELETIONS TO 05140002 * BECOME INVALID. 05142002 * 05144002 * VS2 RELEASE 4 CHANGES 05144410 * @Z40MSMI 05144810 * 05145210 * VS2 RELEASE 3 CHANGES 05146010 *A195700-196200,202500,419100-419120,419900,478100-478200, ZA02199 05146403 *A479520,503500-504000,510500 ZA02199 05146803 *A420000 @ZA07594 05148010 *C405000,459000,461000 @ZA07594 05148610 *D318000-322500 @ZA07594 05149210 *A348010 @ZA10220 05149610 * VS2 RELEASE 3.7 CHANGES @ZA10228 05149710 *C074900,463000,465000,476000 @ZA10228 05149810 *C162150,162200,516123,517367,517375 @ZA19734 05149910 *C162150,162180 @ZA20901 05150310 *A146900,176500-178500 @ZA20901 05150710 *C162150-162180 @ZA25004 05151048 *A450500,515481-515482 @ZA25004 05151248 *A178500,178700 @ZA28402 05151448 *C162150,162180,177500 @ZA28905 05151648 *A517320,517325 @ZA30716 05151748 *A188500 @ZA32079 05151848 * VS2 RELEASE 2 DELETIONS 05152248 *THE FOLLOWING DEVELOPMENT CODE WAS FOR VS2-2 - Y02072 05153348 * YM4640 05153748 * YM5703 05154102 * YM5919 05156102 * YA3018 05158102 * 05160002 * VS1 RELEASE 2 DELETIONS 05162002 *THE FOLLOWING PTM'S WERE FIXED IN THIS RELEASE - 2963 05164002 * 05166002 * RELEASE 21 DELETIONS 05170002 *THE FOLLOWING PTMS WERE FIXED IN THIS RELEASE - 0092, 0191, 1759 05180002 *THE FOLLOWING APARS WERE FIXED IN THIS RELEASE - 52367, 50699 05190002 *THE FOLLOWING DEVELOPMENT CODE WAS FOR 2245 SUPPORT - S21092 05192002 EJECT 05200002 * 05300020 * REGISTER CONVENTIONS USED THROUGH OUT ALL SETPRT EXECUTORS 05400020 * 05500020 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 USER'S DCB ADDR 06000020 RIMAGSAV EQU RDCB REG TO SAVE ADDR OF FCB Y02072 06050002 * IMAGE Y02072 06060002 RBASE EQU 3 BASE REG 06100020 RCORE EQU 4 WORK AREA/MESSAGE ADDRESS 06200020 RPAR EQU 5 PARAMETER LIST ADDRESS 06300020 RSVR EQU 6 SVRB EXTENDED SAVE AREA 06400002 RRET EQU 7 WORK REGISTER 06500002 RWK4 EQU 8 WORK REGISTER 06600002 RIOB EQU 9 ADDRESS OF LAST IOB USED 06700020 R10 EQU 10 LIMIT FOR STM RANGE Y02072 06750002 * AND DEBCHK INPUT REG Y02072 06760002 RUCB EQU 10 UCB ADDRESS 06800020 RDEB EQU 11 DEB ADDRESS 06900020 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 07460002 * 07470002 OKCOMP EQU X'00' RETURN CODE - SUCCESSFUL COMP 07480002 OPRCANCL EQU X'14' RETURN CODE - OPER CAN @ZA10228 07490010 PERMIOER EQU X'0C' RETURN CODE - PERM I/O ERR 07492002 * LOADING FCB IMAGE 07494002 PERMIOEV EQU X'10' RETURN CODE - PERM I/O ERR 07496002 * VERIFYING FCB IMAGE 07498002 RCNOPEN EQU X'18' DCB NOT OPEN Y02072 07498102 * 07498402 *********************************************************************** 07498802 * MESSAGE NUMBERS IN IGGMSG01 07499202 * ALL MESSAGE NUMBERS HAVE BEEN DOUBLED IN THESE EQUATES 07499602 * TO PROVIDE OFFSETS INTO THE MESSAGE CSECT. 07499702 * THIS IS DEPENDENT ON L'MSGINDOF BEING 2. 07499802 * 07499902 MSG128 EQU 14*2 IEC128D--VERIFY FORMS Y02072 07533202 MSG125 EQU 8*2 IEC125A--ERROR - REPEAT Y02072 07543202 MSGFHEAD EQU 20*2 LINE--FCB ID--SPACING Y02072 07553202 MSGFCHAN EQU 19*2 'CHANNEL' FILL IN Y02072 07563202 MSGFLINE EQU 21*2 LINE MESSAGE Y02072 07565202 MSGFFOOT EQU 22*2 LAST LINE MESSAGE Y02072 07565602 * 07615602 *********************************************************************** 07665602 * OTHER EQUATES 07675602 * 07700020 CMDRETRY EQU X'80' MASK FOR COMMAND RETRY ON 13600020 * IN IOB SENSE BYTE 1 Y02072 13650002 MASKSIGN EQU X'F0' MASK TO REMOVE SIGN 13700020 BLANK EQU X'40' CONSTANT=C' ' 14200020 PRT2245 EQU X'0B' CODE IN UCBTBYT4 FOR Y02072 14650002 * 2245 PRINTER Y02072 14660002 NOFCBLD EQU X'40' NO FCB LOAD REQUIRED @ZA20901 14690010 EJECT 14720002 * 14900020 * INITIALIZE REGISTERS 15000002 * 15300020 BALR RBASE,0 15400020 FCBLD000 EQU * 15450002 USING FCBLD000,RBASE 15500020 USING SPW,RCORE 15700002 USING SPRBXSV,RSVR 15750002 USING SPPARM,RPAR 16150002 SPACE 2 16200002 B BEGIN BRANCH AROUND MODULE ID YM4640 16205002 DC C'IGG08104' MODULE NAME @ZA20901 16210048 DC C'@ZA32079' LAST MODULE CHANGE @ZA32079 16215048 DC C'04/26/78' LAST SHIP DATE @ZA32079 16218048 BEGIN DS 0H END OF MODULE ID YM4640 16225002 L RDCB,SPPDCBA LOAD DCB ADDRESS 16300002 USING IHADCB,RDCB 16350002 L RDEB,DCBDEBAD LOAD DEB ADDRESS 16400020 USING DEBBASIC,RDEB 16450002 L RUCB,DEBSUCBA LOAD UCB ADDRESS 16500002 USING UCBOB,RUCB 16550002 MVI SPWFLG8,0 CLEAR FLAG FOR USE HERE Y02072 16600002 USING IOBQSAMN,RIOB 17550002 MVI IOBFLAG1,IOBCMDCH+IOBUNREL SET IOBFLAG=CMD CHAINING/UNRL 17600002 L RWK2,UCBXTADR LOAD UCB EXTENSION ADD @ZA20901 17650010 USING UCBUCS,RWK2 @ZA20901 17700010 TM SPWFLG1,NOFCBLD LOAD FCB IMAGE ? @ZA28905 17750048 BO FCBLD020 NO- GO CHECK OPTIONS @ZA20901 17800010 MODESET EXTKEY=SUPR GET INTO SUPERVISOR KEY@ZA28402 17850048 NI UCBFCBOP,X'FE' TURN OFF PARITY ERROR @ZA20901 17860048 MODESET KEYADDR=SPRKEY,WORKREG=2 RESUME NORMAL KEY @ZA28402 17870048 * 17900020 * FORM CCW TO LOAD FCB 18000002 * 18100020 USING FCBIMBEG,RWK4 18150002 LR RIMAGSAV,RWK4 SAVE IMAGE ADDR FOR Y02072 18200002 * RE-VERIFICATION Y02072 18250002 LA RWK1,FCBLINE1 GET ADDR OF FCB IMAGE 18300002 ST RWK1,SPWADD1A STORE FCB ADDR IN CCW 18400002 SR RWK1,RWK1 ZERO OUT REGISTER 18500002 IC RWK1,FCBLENTH GET LENGTH OF FCB IMAGE 18600002 ST RWK1,SPWCCWF1 STORE LENGTH OF FCB IMG IN CCW 18700002 MVI SPWOPCD1,SPWFCBLD MOVE IN LOAD FCB COMMAND 18800002 MVI SPWCCWF1,SPWSILI SET SILI ON @ZA32079 18850048 * 18900020 * ISSUE EXCP AND WAIT TO LOAD FCB 19000002 * 19100020 FCBLD010 EQU * 19400020 BAL RRET,SETUCB MOVE SPWFCB2H TO UCB Y02072 19520002 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 19570003 * PROCESSING REQUIRED ZA02199 19620003 EXCP IOBSTDRD EXCP FOR FCB LOAD 19800002 * 19900020 L R1,IOBECBPT GET ADDRESS OF ECB 19950002 WAIT ECB=(1) WAIT FOR COMPLETION OF FCB LD 20200002 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 20250003 * 20300020 L RWK2,IOBECBPT GET ADDR OF ECB 20400002 USING ECBCC,RWK2 20450002 CLI ECBCC,ECBNORM CK FOR SUCCESSFUL FCB LOAD 20500002 BE FCBLD020 YES GO CK FCB OPTIONS 20600020 * 21400020 * WHEN A PERMANENT I/O ERROR IS DETECTED DURING AN FCB LOAD, UPDATE 21500002 * THE UCB WITH X'00', DELETE THE FCB IMAGE LOADED AND GIVE CONTROL 21600002 * BACK TO THE PROBLEM PROGRAM WITH RETURN CODE=0C IN BITS 16-23 21700002 * OF REGISTER 15 21800002 * 22100020 LA RWK5,PERMIOER LOAD RETURN CODE =X'0C' 22200002 FCBLD015 EQU * 22400020 L RWK1,SPWFCB2H SAVE ID OF IMAGE LOADED Y02072 22450002 SR RWK2,RWK2 CLEAR FCB ID Y02072 22600002 ST RWK2,SPWFCB2H Y02072 22650002 BAL RRET,SETUCB CLEAR ID IN UCB Y02072 22700002 ST RWK1,SPWFCB2H RESTORE NAME FOR DELETE Y02072 22750002 B FCBLD040 GO TO HOUSE CLEANING ROUTINE 22800020 * 23100020 * TEST FCB OPTION BITS FOR VERIFY OR ALIGN 23200002 * 23300020 FCBLD020 EQU * 23600020 TM SPWFLG1,SPWVRFCB TEST IF VERIFY FCB SPECIFIED 23800002 BO FCBLD070 YES GO PRINT LINES OF VERIFICAT 23900002 TM SPWFLG1,SPWALIGN TEST IF ALIGN FORMS SPECIFIED 24000002 BO FCBLD120 YES GO ISSUE ALIGN FORMS MSG 24100020 LA RWK5,OKCOMP SET RETURN CODE=00 24200002 * NO FALL THROUGH TO EXIT RTN 24300002 * 24600020 * EXIT ROUTINE - UPDATE FCB FIELDS OF UCB FOR SUCCESSFUL FCB LOAD 24700002 * - DELETE FCB IMAGE IF ONE WAS LOADED 24800002 * - DELETE MESSAGE CSECT 24850002 * - FREE MESSAGE/WORK AREA 24900002 * - FREE BLDL PARAMETER LIST YM5703 24950002 * - SET RETURN CODE IN BITS 16-23 REG.15 25000002 * - RETURN TO INVOKER 25100002 * 25400020 FCBLD030 EQU * 25500020 OI SPWFLG8,SPWFCBOP REQUEST OPTION UPDATE Y02072 25700002 BAL RRET,SETUCB PUT OPTIONS & ID IN UCB Y02072 25750002 NI SPWFLG8,X'FF'-SPWFCBOP RESET OPTIONS REQUEST Y02072 25800002 * 26000020 * DETERMINE IF AN FCB IMAGE WAS LOADED 26100002 * 26200020 FCBLD040 EQU * 26300020 TM SPWFLG5,SPWFCBDE DID USER SUPPLY IMAG VIA Y02072 26350002 * DCB EXIT LIST Y02072 26400002 BZ FCBLD050 YES, DO NOT ISSUE DELETE Y02072 26450002 * 26800020 * DELETE FCB IMAGE 26900002 * 26950002 DELETE EPLOC=SPWFCBIM DELETE THE FCB IMAGE LOADED 27300002 NI SPWFLG5,X'FF'-SPWFCBDE INDICATE IMAGE DELETED Y02072 27310002 FCBLD050 SR RWK6,RWK6 Y02072 27350002 ST RWK6,SPWFCB2H CLEAR IMAGE NAME Y02072 27360002 * 27400020 * DELETE MESSAGE CSECT 27500002 * 27600020 DELETE EP=IGGMSG01 DELETE MSG CSECT Y02072 27750002 SPACE 2 27760002 MODESET EXTKEY=SUPR PREPARE TO MODIFY SVRB Y02072 27800002 SPACE 27850002 ST RWK6,SPRMSG INDICATE MSGS DELETED Y02072 27852002 * 27860020 * CLOSE SYS1.IMAGELIB 27870002 * 27880002 IMGLIB CLOSE,SPRIDCBA CLOSE SYS1.IMGLIB Y02072 27890002 * 27920020 ST RWK6,SPRIDCBA INDICATE IMGLIB DELETED Y02072 27950002 ST RWK6,SPRIOBSV INDICATE IOB RESTORED Y02072 27952002 MODESET KEYADDR=SPRKEY,WORKREG=1 RESUME NORMAL KEY Y02072 27960002 * 27960402 * RESTORE IOB TO ORIGIONAL STATUS Y02072 27960802 * 27961202 MVC IOBFLAG1(4),SPWFLGSV RESTORE IOB FLAGS Y02072 27962002 MVC IOBSTART,SPWSTRSV RESTORE IOB START ADDR Y02072 27964002 * 27970002 * FREEMAIN SETPRT WORKAREA AND BLDL PARAMETER LIST YM5703 28020002 * 28070002 FREEMAIN R,LV=SPWLNGTH,A=(RCORE),SP=SPWPOOL Y02072 28200002 SPACE 28250002 MODESET EXTKEY=DATAMGT KEY OF BLDL LIST YM5703 28260002 SPACE 28270002 L RWK2,SPRBLDLA ADDR OF BLDL PARM LIST YM5703 28272002 USING SPW5,RWK2 @Z40MSAP 28274010 ST RWK6,SPWWKADR INDIC WORKAREA FREED YM5703 28280002 SPACE 28282002 FREEMAIN R,LV=SPW5LNTH,A=(RWK2),SP=SPW5POOL @Z40MSAP 28290010 SPACE 28290402 MODESET EXTKEY=SUPR KEY TO RETURN IN Y02072 28292002 SPACE 28294002 ST RWK6,SPRBLDLA INDIC BLDL LIST FREED YM5703 28296002 * 28300020 * RESET REGISTERS AND IOB TO RETURN TO PROBLEM PROGRAM 28400002 * 28500020 L RDCB,SPPDCBA GET DCB ADDRESS 28600002 L RDEB,DCBDEBAD GET DEB ADDRESS 28700002 * 29700020 * RETURN TO PROBLEM PROGRAM 29800002 * 29900020 SLL RWK5,8 SHIFT RETURN CODE TO BITS 16-23 30200002 LR R15,RWK5 30300002 SRL RPAR,24 MOVE UCS RTN CODE TO BYTE 3 30400002 OR R15,RPAR OR IN UCS PART OF RTN CODE 30500002 * 30600020 L R14,SPREXIT GET EXIT ADDRESS Y02072 30700002 BR R14 RETURN TO EXIT PROLOG Y02072 30750002 EJECT 30800002 * 31100020 * VERIFICATION ROUTINE TO DISPLAY THE FCB IMAGE 31200002 * 31520020 FCBLD070 EQU * 31600020 CLI UCBTBYT4,PRT2245 CHECK FOR 2245 PRINTER S21092 31680002 BE FCBLD120 IF VERIFY SPECIFIED GO TO M0191 31700002 * ALIGN S21092 31720002 * 33400020 * INITIALIZE REGISTERS FOR VERIFICATION 33500002 * -RWK5 CONTAINS LINE NUMBER 33700002 * -RWK7 POINTER TO ENTRIES IN FCB IMAGE 33800002 * 33900020 LA RWK5,1 SET LINE COUNTER TO 1 34000002 LA RWK7,FCBLINE1 SET FCB IMG PTR TO START OF IM 34100002 TM FCBINDEX,FCBLFTIN+FCBRGTIN IS INDEXING SPECIFIED XM2963 34150002 BZ FCBLD072 NO, RWK7 HAS RIGHT ADDR XM2963 34160002 LA RWK7,FCBLNPN1 ADDR IF USING INDEXING XM2963 34170002 FCBLD072 EQU * XM2963 34180002 * 34200020 * FORM CCW TO PRINT LINES OF VERIFICATION 34300002 * 34400020 LA RWK6,SPWMSGTX GET ADDR OF PRINT LINE 34600002 ST RWK6,SPWADD1A SET ADDR OF PRT LINE 34700002 MVI SPWOPCD1,SPWWRTSP SET COMMAND CODE TO PRINT+SKP1 34800002 MVI SPWCCWF1,SPWSILI SET SILI ON @ZA10220 34850010 * 34900020 * INITIALIZE PRINT LINE 35000002 * 35100020 LA RWK2,MSGFHEAD REQUEST FCB HEADER Y02072 35200002 BAL RRET,GETMSG GO GET IT Y02072 35250002 LR RWK6,RWK8 KEEP PTR TO MSG ENTRY Y02072 35300002 USING MSGENTRY,RWK6 Y02072 35350002 SR RWK2,RWK2 CLEAR REG FOR INSERTS Y02072 35360002 IC RWK2,MSGLNG GET LENGTH-1 FOR CCW Y02072 35370002 LA RWK2,1(RWK2) ADD TO GET REAL LENGTH Y02072 35372002 STH RWK2,SPWBYTE1 PUT LEN IN THE CCW Y02072 35380002 IC RWK2,MSGOFF5 OFFSET TO FCB ID Y02072 35390002 L RWK8,SPWFCB2H PICK UP FCB ID Y02072 35392002 ST RWK8,SPWMSGTX(RWK2) STORE IT AT ITS OFFSET Y02072 35394002 IC RWK2,MSGOFF6 OFFSET TO LINES/INCH Y02072 35396002 LA RWK8,SPWMSGTX(RWK2) PTR TO LINES/INCH Y02072 35398002 DROP RWK4 35398402 USING FCBLINE,RWK7 35398802 MVI 0(RWK8),SPW6LINE INIT AT 6 INES/INCH Y02072 35400002 TM FCBLINE,FCB8LINE CK IF LINE/INCH = 8 35500002 BNO FCBLD075 NO CONTINUE WITH 1ST PRINT LINE 35600020 MVI 0(RWK8),SPW8LINE YES SET TO 8 LINES/INCH Y02072 35700002 FCBLD075 EQU * 35900020 * 36200020 * INSERT LINE NUMBER INTO PRINT LINE 36300002 * 36400020 FCBLD080 EQU * 36500020 CVD RWK5,SPWUNPKA CONVERT LINE NO TO DECIMAL 36700002 UNPK SPWUNPKA,SPWLNENO UNPACK LINE NO. 36800002 OI SPWZONE,MASKSIGN INSERT ZONE IN LOW ORDER DIGIT 36900002 SR RWK2,RWK2 Y02072 36950002 IC RWK2,MSGOFF1 OFFSET TO LINE NUMBER Y02072 36960002 LA RWK8,SPWMSGTX(RWK2) PTR TO LINE NUMBER Y02072 36970002 MVC 0(L'SPWWKAR,RWK8),SPWWKAR+1 MOVE LINE NO TO PRINT Y02072 37000002 * 37100020 * TRANSLATE CHANNEL CODE TO CHARACTER FORM AND ADD TO PRINT LINE 37200002 * 37300020 LA RWK8,FCBCHAN PICK UP CHANNEL MASK Y02072 37350002 IC RWK2,FCBLINE GET CHANNEL CODE Y02072 37400002 NR RWK2,RWK8 IF CHANNEL CODE IS 00 Y02072 37500002 BZ FCBLD100 BYPASS TRANSLATION Y02072 37600002 SLL RWK2,1 MUTIPLY CODE BY 2 Y02072 38300002 LH RWK8,TRANSTAB(RWK2) GET EBCDIC CHANNEL CODE Y02072 38400002 IC RWK2,MSGOFF3 OFFSET TO CHANNEL CODE Y02072 38500002 STH RWK8,SPWMSGTX(RWK2) STORE CODE IN MSG Y02072 38550002 LA RWK2,MSGFCHAN REQUEST 'CHANNEL' MSG Y02072 38600002 OI SPWFLG8,SPWNOMOV SUPPRESS SUBR MOVE Y02072 38650002 BAL RRET,GETMSG GET THE MESSAGE Y02072 38660002 USING MSGTXT,RWK2 Y02072 38670002 USING MSGENTRY,RWK8 Y02072 38680002 NI SPWFLG8,X'FF'-SPWNOMOV RESTORE NORMAL MODE Y02072 38682002 IC RWK8,MSGLNG GET LENGTH OF 'CHANNEL' Y02072 38690002 DROP RWK8 Y02072 38690402 USING MSGENTRY,RWK6 RETURN TO MAIN MESSAGE Y02072 38692002 SR RWK4,RWK4 Y02072 38694002 IC RWK4,MSGOFF2 OFFSET TO 'CHANNEL Y02072 38696002 LA RWK4,SPWMSGTX(RWK4) PTR TO 'CHANNEL' IN Y02072 38698002 * WORK AREA Y02072 38698402 EX RWK8,MVCHAN MOVE WORD INTO MSG Y02072 38698802 DROP RWK2 Y02072 38699202 FCBLD100 EQU * 38700020 BAL RRET,EXCP PRINT A VERIF LINE Y02072 39300002 TM SPWFLG8,SPWVREND IF THIS WAS LAST LINE Y02072 40400002 BO FCBLD120 GO TO MSG 'IEC128D' @ZA07594 40500010 * 40600020 * SET REGISTERS AND MESSAGE TO PRINT NEXT LINE OF VERIFICATION 40700002 * 40800020 LA RWK5,1(RWK5) INCREMENT LINE COUNTER 40900002 LA RWK7,1(RWK7) INCREMENT POINTER TO NEXT 41100002 * POSITION OF FCB IMAGE 41200002 LA RWK2,MSGFLINE REQUEST LINE MSG Y02072 41300002 TM FCBLINE,FCBLAST CK FOR END OF IMAGE FLAG 41400002 BNO FCBLD105 NO - FORM NEXT LINE Y02072 41500002 * YES SET FOR LAST LINE OF VFY 41600002 LA RWK2,MSGFFOOT REQUEST LAST LINE MSG Y02072 41700002 OI SPWFLG8,SPWVREND SET LAST LINE FLAG Y02072 41750002 FCBLD105 EQU * Y02072 41800002 BAL RRET,GETMSG GET REQUESTED MESSAGE Y02072 41802002 LR RWK6,RWK8 SAVE ITS ENTRY PTR Y02072 41804002 SR RWK2,RWK2 Y02072 41806002 IC RWK2,MSGLNG GET LENGTH-1 OF MSG Y02072 41808002 LA RWK2,1(RWK2) ADD TO GET REAL LENGTH Y02072 41808102 STH RWK2,SPWBYTE1 AND UPDATE CCW Y02072 41808402 B FCBLD075 GO PUT LINE NUM IN Y02072 41810002 * IN PRINT LINE Y02072 41810402 DROP RWK6 Y02072 41812002 * Y02072 41814002 * FOLLOWING INSTRUCTION EXECUTED FROM FCBLD080 ABOVE Y02072 41816002 * Y02072 41818002 MVCHAN MVC 0(0,RWK4),0(RWK2) MOVE 'CHANNEL' INTO MSG Y02072 41818402 * 41820020 * ISSUE SKIP TO CHANNEL 1 41830002 * 41840020 FCBLD110 EQU * 41850020 XC SPWCCW1,SPWCCW1 RESET CCW 41870002 MVI SPWBYTE1+1,1 SET DATA LENGTH =1 41880002 MVI SPWCCWF1,SPWSILI SET SILI ON 41890002 MVI SPWOPCD1,SPWSKIP MOVE SKIP COMMAND CD 41900002 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 41910003 * PROCESSING REQUIRED ZA02199 41912003 EXCP IOBSTDRD ISSUE SKIP TO CH 1 41920002 * 41922002 L R1,IOBECBPT GET ADDRESS OF ECB 41932002 WAIT ECB=(1) WAIT FOR SKIP TO COMPLETE 41940002 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 41990003 B FCBLD030 RETURN TO PROBLEM PROG @ZA07594 42000010 * WTOR TO REQUEST OPERATOR TO VERIFY FORMS ALIGNMENT 42300002 * 'IEC128D V XXX,VERIFY FORMS ALIGNMENT' 42400002 * 42700020 FCBLD120 EQU * 42800020 LA RWK2,MSG128 REQUEST 'VERIFY' MSG Y02072 42900002 BAL RRET,GETMSG GET IT IN WORK AREA Y02072 42950002 USING MSGENTRY,RWK8 Y02072 43000002 SR RWK2,RWK2 Y02072 43050002 IC RWK2,MSGOFF1 OFFSET TO UNIT ADDRESS Y02072 43100002 LA RWK2,SPWMSGTX(RWK2) POINT TO VAR IN WORKAREA Y02072 43150002 MVC 0(L'UCBNAME,RWK2),UCBNAME MOVE IN UCBNAME Y02072 43200002 DROP RWK8 43250002 * 43600020 * CLEAR REPLY AREA 43700002 * 43800020 FCBLD130 EQU * 43830020 MVI SPWREPLY,BLANK MOVE BLANK TO 1ST POSITION 44000002 MVC SPWREPC1,SPWREPLY CLEAR REPLY AREA 44100002 MVI SPWRPECB,0 SET REPLY ECB NOT COMPLETE 44300002 LA RWK5,OKCOMP SET RETURN CODE =00 44400002 TM SPRKEY,SPRUSKEY TEST KEY FOR SYS FUNCT Y02072 44450002 BZ FCBLD131 YES, DO NOT SYNCH Y02072 44460002 SYNCH WTOR GO ISSUE WTOR IN Y02072*44500002 USER KEY, PROBLEM STATE Y02072 44550002 B FCBLD132 GO ISSUE WAIT Y02072 44600002 FCBLD131 BAL R14,WTOR GO ISSUE WTOR IN SYS KEY Y02072 44650002 * 44900020 FCBLD132 WAIT ECB=SPWRPECB,LONG=YES WAIT FOR OPERATOR REPLY Y02072 45000002 XC SPWMSGID(4),SPWMSGID CLEAR MSG ID @ZA25004 45050048 * 45300020 * ANALYSIS OF REPLY 45400002 * 45700020 OC SPWREPLY(L'LOWCASE),LOWCASE SET FOR LOWER CASE 45750002 CLC SPWREPLY(L'VERIFY01),VERIFY01 TEST REPLY='VERIFIED' 45800002 BE FCBLD110 YES ISSUE SKIP CHANN 1 @ZA07594 45900010 CLC SPWREPLY(L'VERIFY02),VERIFY02 TEST REPLY='V' 46000010 BE FCBLD110 YES ISSUE SKIP CHANN 1 @ZA07594 46100010 CLC SPWREPLY(L'CANCEL01),CANCEL01 TEST REPLY='CANCEL' 46200002 BE FCBLD135 YES-SET RETURN CODE=14 @ZA10228 46300010 CLC SPWREPLY(L'CANCEL02),CANCEL02 TEST IF REPLY='C' 46370010 BE FCBLD135 YES-SET RETURN CODE=14 @ZA10228 46440010 CLC SPWREPLY(L'RETRY01),RETRY01 TST IF REPLY=RETRY 46510002 BE FCBLD133 YES GO CK IF VERIFY OR 46520020 * ALIGN SPECIFIED 46530002 CLC SPWREPLY(L'RETRY02),RETRY02 TST IF REPLY = RETRY 46540002 BE FCBLD133 YES GO CK IF VERIFY OR ALIGN 46550002 * SPECIFIED, NO ISSUE REPEAT 46560002 * REPLY MSG 46600002 * ERROR IN REPLY - ISSUE 'IEC125I ERROR - REPEAT REPLY' 46800002 * 46900020 LA RWK2,MSG125 REQUEST ERROR MSG Y02072 47000002 BAL RRET,GETMSG GET IT IN WORK AREA Y02072 47050002 B FCBLD130 GO CLEAR REPLY AREA AND 47100020 * ISSUE MESSAGE 47200002 FCBLD133 EQU * 47220020 TM SPWFLG1,SPWALIGN TST IF ALIGN MSG RETRY Y02072 47240002 BO FCBLD120 YES, GO REPEAT ALIGN MSG Y02072 47242002 NI SPWFLG8,X'FF'-SPWVREND NO, RESET END INDICATOR Y02072 47244002 LR RWK4,RIMAGSAV GET ADDR OF FCB IMAGE Y02072 47244402 B FCBLD070 GO RE-VERIFY IMAGE Y02072 47246002 FCBLD135 EQU * 47400020 LA RWK5,OPRCANCL SET RETURN CODE =14 @ZA10228 47600010 B FCBLD015 GO RETURN TO PROB PROG 47700020 EJECT 47710002 EXCP EQU * 47712002 *********************************************************************** 47720002 * SUBROUTINE TO EXCP AND TEST RESULTS 47750002 * INPUT: IOB AND CHANNEL PROGRAM ARE READY FOR EXCP 47752002 * ADDRESSIBILITY REQUIRED: 47754002 * IOB 47756002 * SETPRT WORK AREA 47758002 * OUTPUT:ECB IS POSTED COMPLETE, EXCP COMPLETED NORMALLY 47758402 * OUTPUT, ERROR: SKIP TO 0 CCW IS EXECUTED, RETURN CODE 16 SET 47758802 * THIS ROUTINE NORMALLY RETURNS ON REGISTER RRET 47759602 * ON UNCORRECTABLE ERRORS IT BRANCHES TO EXIT FUNCTION 47759702 * ALL REGISTERS EXCEPT R15,R0,R1 (AND RWK2=R1) ARE TRANSPARENT 47759802 *********************************************************************** 47760002 * 47800002 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 47810003 * PROCESSING REQUIRED ZA02199 47820003 EXCP IOBSTDRD ISSUE REQUESTED EXCP 47850002 * 47900002 L R1,IOBECBPT GET ADDRESS OF ECB 47910002 WAIT ECB=(1) WAIT FOR COMPLETION 47950002 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 47952003 * 47960002 L RWK2,IOBECBPT GET ADDR OF ECB 47970002 USING ECB,RWK2 47980002 CLI ECBCC,ECBNORM CK IF SKIP TO CH 1 SUCCESSFUL 47990002 BNE FCBLD140 NO GO TO ERROR RTN 47992002 NI SPWFLG8,X'FF'-SPWRETRY YES, CLEAR ERROR BIT Y02072 47994002 BR RRET AND RETURN TO CALLER Y02072 47996002 * 48000020 * ERROR ROUTINE - FOR ERRORS OCCURING WHILE PRINTING OUT THE FCB IMG 48100002 * 48400020 FCBLD140 EQU * 48500020 TM CSWSTAT1,CSWUNCHK IF NOT UNIT CHECK Y02072 48550002 BNO FCBLD160 DON'T CONSIDER RETRY Y02072 48600002 TM IOBSENS1,CMDRETRY CK IF COMMAND RETRY ON 48700002 BNO FCBLD160 NO GO SET RETURN CODE FOR 48800020 * PERM I/O ERROR DURING VERIFY 48900002 * TEST IF PRINT LINE SHOULD BE RETRIED 49100002 * 49200020 TM SPWFLG8,SPWRETRY ARE WE ALREADY RETRYING Y02072 49300002 BNZ FCBLD150 YES GO RESET CONTROL UNIT 49700020 OI SPWFLG8,SPWRETRY NO, INDICATE WE WILL Y02072 49800002 B FCBLD100 GO RETRY PRINT LINE 49900020 FCBLD150 EQU * 50100020 MVC SPWCCW1,SKP0CCW REPLACE 1ST CCW Y02072 50300002 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 50350003 * PROCESSING REQUIRED ZA02199 50400003 EXCP IOBSTDRD ISSUE RESET FOR CONTROL UNIT 50700002 * 50950002 L R1,IOBECBPT GET ADDRESS OF ECB 50960002 WAIT ECB=(1) ISSUE WAIT FOR SKIP TO 0 51000020 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 51050003 * 51100020 FCBLD160 EQU * 51200020 LA RWK5,PERMIOEV SET RETURN CODE=10 51400002 B FCBLD030 GO TO EXIT ROUTINE 51500020 SPACE 6 51510002 * 51512002 * THE FOLLOWING WTOR IS EXECUTED IN PROBLEM STATE, SINCE THE 51520002 * MESSAGE AREA IS IN CORE (THE SETPRT WORK AREA) ACCESSIBLE 51530002 * TO THE USER. THIS CAUSES WTOR TO MARK THE MESSAGE AS A 51540002 * USER REQUEST (LEADING + ADDED), AND ALERTS THE OPERATOR 51542002 * THAT NO CRITICAL FUNCTION IS BEING REQUESTED. 51544002 * 51546002 WTOR WTOR MF=(E,SPWRPLYA) ISSUE MESSAGE WITH REPLY Y02072 51548002 ST R1,SPWMSGID SAVE MSG ID FOR DOM @ZA25004 51548148 OI SPWMSGID,X'80' SET HIGH ORDER BIT @ZA25004 51548248 BR R14 RETURN TO SYNCH Y02072 51548402 EJECT 51550402 *********************************************************************** 51552002 * THIS SUBROUTINE FINDS A MESSAGE IN THE MESSAGE CSECT 51554002 * AND (UNLESS SUPPRESSED) MOVES IT INTO THE SETPRINT WORK AREA 51556002 * INPUT: RWK2 CONTAINS AN INDEX OFFSET (MSG NUMBER * 2) 51558002 * SPRMSG CONTAINS THE ADDRESS OF THE MESSAGE CSECT 51558402 * SPWNOMOV IS ON IF MOVE SHOULD BE SUPPRESSED 51558502 * ADDRESSIBILITY REQUIRED: 51558802 * SVRB EXTENDED SAVE AREA 51559202 * SETPRT WORK AREA 51559602 * OUTPUT:RWK2 POINTS TO MESSAGE TEXT IN MSG CSECT 51559702 * RWK8 POINTS TO THE MSG ENTRY IN MSG CSECT 51559802 * SPWMSGTX CONTAINS A COPY OF THE MESSAGE TEXT 51559902 * (UNLESS MOVE SUPPRESSED BY SPWNOMOV) 51562002 * THIS ROUTINE RETURNS ON REGISTER RRET 51563202 * ALL REGISTERS EXCEPT RWK2 AND RWK8 ARE TRANSPARENT 51565202 *********************************************************************** 51565602 GETMSG L RWK8,SPRMSG PICK UP MSG CSECT ADDR Y02072 51566002 USING MSGINDEX,RWK8 Y02072 51566402 AH RWK8,MSGINDOF(RWK2) ADD ENTRY OFFSET Y02072 51566502 USING MSGENTRY,RWK8 Y02072 51566602 SR RWK2,RWK2 Y02072 51569902 IC RWK2,MSGOFF PICK UP TEXT OFFSET Y02072 51571902 AR RWK2,RWK8 GET PTR TO TEXT Y02072 51572302 USING MSGTXT,RWK2 Y02072 51572702 TM SPWFLG8,SPWNOMOV IF MOVE SHOULD BE Y02072 51572802 BOR RRET BYPASSED, RETURN Y02072 51572902 MVC SPWMSGTX,MSGTXT MOVE TEXT INTO WORK AREA Y02072 51573102 BR RRET RETURN TO CALLER Y02072 51573202 DROP RWK2,RWK8 Y02072 51573302 DROP RDEB,RUCB Y02072 51575302 EJECT 51575702 SETUCB EQU * Y02072 51577302 *********************************************************************** 51577702 * THIS ROUTINE UPDATES THE UCB 51578102 * TO PERFORM THIS FUNCTION IT MUST VALIDATE THAT: 51578502 * 1. A PROTECTED CHAIN LEADS TO THE UCB 51579002 * 2. THE UCB IS ALLOCATED TO THE JOB REQUESTING SETPRT 51579402 * BOTH OF THESE ARE SATISFIED BY DEBCHK, SO LONG AS THERE 51579802 * IS NO TIME OF CHECK TO TIME OF USE EXPOSURE. 51579902 * THAT EXPOSURE IS COVERED BY RUNNING WITH THE LOCAL LOCK. 51589902 * INPUT: SPWFCB2H CONTAINS THE FCB ID TO PLACE IN THE UCB 51599902 * SPWFCBOP IN FLG8 IS ON IF OPTIONS SHOULD BE UPDATED 51609902 * IF ON, FCBDEFLT CONTAINS THE OPTIONS 51611902 * IF ON, RWK4 MUST POINT TO FCBIMAGE @ZA19734 51612310 * ADDRESSIBILITY REQUIRED: 51615202 * SVRB EXTENDED SAVE AREA 51615602 * SETPRT WORK AREA 51615702 * OUTPUT:UCBFCBID AND (OPTIONALLY) UCBFCBOP ARE UPDATED (NORMAL) 51616002 * THE SAVE AREA SPRSAVE IN SVRB IS USED 51616402 * IF DEB NOT VALID, DOES NOT RETURN TO SUBROUTINE CALLER, 51616502 * INSTEAD SETS RETURN CODE AND EXITS 51616602 * THIS ROUTINE RETURNS ON REGISTER RRET 51619902 * ALL REGISTERS EXCEPT R15 AND R1 (= RWK2) ARE TRANSPARENT 51621902 *********************************************************************** 51622302 MODESET EXTKEY=ZERO CHANGE TO KEY FOR BR ENT Y02072 51622702 SPACE 51623102 STM R10,R14,SPRSAVE SAVE VOLATILE REGS Y02072 51623202 LOCK SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, Y02072*51623302 RELATED=(DEB/UCB,UNLOCK) GET THE LOCAL LOCK Y02072 51626602 L R10,CVTPTR FIND CVT Y02072 51628602 USING CVT,R10 Y02072 51629002 L R15,CVTEXT2 FIND CVT EXTENSION Y02072 51629402 USING CVTXTNT2,R15 Y02072 51629802 L R15,CVTDEBVR GET PTR TO DEBCHK Y02072 51629902 L R14,SPPDCBA GET DCB ADDR YM5919 51631902 USING IHADCB,R14 TEMP USING YM5919 51633902 L R1,DCBDEBAD GET DEB ADDRESS YM5703 51634302 LA R1,0(R1) CLEAR HI-BYTE YM5703 51634702 DROP R14,R15 YM5919 51634802 USING PSA,0 Y02072 51644902 L R10,PSATOLD FIND CURRENT TCB Y02072 51649902 DROP R10 Y02072 51654902 BALR R14,R15 CALL DEBCHK Y02072 51659902 * 51661902 * DEBCHK RETURNS ON REGISTER 14 PLUS THE CONTENTS OF REG 15 YM5703 51663902 * REG 15 : 0 - DEB VALID YM5703 51665902 * 4 - DEB INVALID YM5703 51667902 * REGARDLESS OF DEBCHK RETURN, THE LOCAL LOCK MUST BE RELEASED YM5703 51668302 * AS SVC'S CANNOT BE ISSUED WHILE HOLDING THE LOCK. YM5703 51668702 * 51669102 B DEBOK DEB VALID--PTR IN R1 Y02072 51669902 B UNLOCK INVALID--GET OUT YM5703 51674902 DEBOK EQU * Y02072 51679902 USING DEBDASD-(DEBBASND-DEBBASIC),R1 Y02072 51684902 L RWK2,DEBUCBAD FIND UCB Y02072 51689902 DROP R1 Y02072 51699902 USING SRT,RWK2 Y02072 51709902 L RWK2,UCBXTADR FIND UCS EXTENSION Y02072 51719902 USING UCBUCS,RWK2 Y02072 51729902 LM R10,R14,SPRSAVE RESTORE VOLATILE REGS Y02072 51731902 TM SPWFLG1,NOFCBLD FCB LOADED? @ZA30716 51732548 BO UNLOCK NO-DONT UPDATE FCB @ZA30716 51733148 MVC UCBFCBID,SPWFCB2H STORE FCB ID Y02072 51733902 TM SPWFLG8,SPWFCBOP IF NO OPTIONS REQUEST, Y02072 51735902 BZ UNLOCK BYPASS OPTIONS STORE Y02072 51736302 USING FCBIMBEG,RWK4 @ZA19734 51736710 MVC UCBFCBOP,FCBDEFLT MOVE IN FCB OPTION Y02072 51737010 DROP RWK4 @ZA19734 51737310 UNLOCK SETLOCK RELEASE,TYPE=LOCAL,RELATED=(DEB/UCB,LOCK) Y02072 51737902 LM R10,R14,SPRSAVE RESTORE VOLATILE REGS Y02072 51738302 SPACE 51738402 MODESET KEYADDR=SPRKEY,WORKREG=1 RESUME NORMAL KEY Y02072 51738702 SPACE 51738802 LTR R15,R15 WAS DEB VALID YM5703 51739102 BZR RRET YES, CONTINUE YM5703 51739202 * 51739502 NOTOPEN ICM RPAR,B'1000',=AL1(RCNOPEN) SET DCB NOT OPEN Y02072 51739602 * AS UCS ERROR CODE Y02072 51749602 SR RWK5,RWK5 NO FCB ERROR CODE Y02072 51762102 B FCBLD040 GO GET OUT Y02072 51764902 EJECT 51777402 * 51789902 * CONSTANTS 51839902 * 51889902 SKP0CCW CCW SPWSKIP0,0,SPWSILI,1 SKIP TO CHANNEL 0 CCW 51939902 LOWCASE DC CL10' ' TO ALLOW LOWER CASE REPLYS 52350002 BLANKFLD EQU LOWCASE TO BLANK A FIELD 52360002 VERIFY01 DC C'VERIFIED' REPLY=VERIFIED 52400020 VERIFY02 DC C'V ' REPLY='V' 52500020 CANCEL01 DC C'CANCEL' REPLY=CANCEL 52600020 CANCEL02 DC C'C ' REPLY='C' 52700020 RETRY01 DC C'R ' CONST FOR RETRY 52730020 RETRY02 DC C'RETRY' RETRY CONST 52760020 DS 0H SET ON HALF WORD BDY 52810048 TRANSTAB DC C'00010203040506070809101112' 53000020 * 54000020 * PATCH AREA 54100002 * 54200020 PATCH DC 25H'0' PATCH AREA YM4640 54210002 END EQU * END OF MODULE Y02072 54212002 TITLE 'IGG08104 - SYSTEM DESECTS' YM4640 54270002 CVT DSECT=YES Y02072 54320002 EJECT 54330002 DCBD DSORG=PS 56800020 EJECT 56850002 IEZDEB 56900002 EJECT 56950002 IHAECB 57000002 EJECT 57910002 IHAFCBIM 57920002 EJECT 57950002 IEZIOB 58000002 EJECT 58050002 ORG IOBCSW-1 58100002 IHACSW DSECT=NO 58150002 EJECT 58200002 IGGMSG Y02072 58202002 EJECT 58204002 IHAPSA Y02072 58204402 EJECT 58206002 IHASPP 58208002 EJECT 58208402 IGGSPW 58208802 EJECT 58210002 SRT DSECT 58250002 IEFUCBOB LIST=YES 58300002 END 58800020