8102 TITLE 'IGG08102 - SETPRT LOAD 3 - UCS BUFFER LOAD AND VERIFY' 00100000 IGG08102 CSECT 00300000 * /* START OF SPECIFICATIONS**** @Z40MSAP 00310048 *01* PROCESSOR = ASSEMXF: 00320048 **** END OF SPECIFICATIONS ** @Z40MSAP*/ 00330048 *********************************************************************** 00350002 * 00400002 * MODULE-NAME = IGG08102 00450002 * 00500002 * DESCRIPTIVE-NAME = SETPRT UCS BUFFER LOAD AND VERIFY 00510002 * 00512002 * COPYRIGHT = NONE 00514002 * 00516002 * STATUS = LEVEL 001 00518003 * 00520021 * FUNCTION = LOAD UCS BUFFER 00700003 * WHEN VERIFICATION OF IMAGE IS SPECIFIED, PRINT THE IMAGE 00800002 * FOR VISUAL VERIFICATION 00900002 * UPDATE UCB TO INDICATE THE STATUS OF UCS BUFFER 00950002 * DELETE UCS IMAGE 01000002 * REQUEST OPERATOR VERIFICATION AND ANALYZE REPLY 01050002 * 01300000 * 01350002 * NOTES = 01400002 * DEPENDENCIES = BLANK IS USED--CORRECTABLE BY REASSEMBLY. 01450002 * THE FOLLOWING CHARACTER STRINGS ARE USED IN 01500002 * TESTING OPERATOR REPLIES: 01550002 * 'V', 'R', 'C', 'RETRY', 'VERIFY', 'CANCEL' 01600002 * THESE STRINGS ARE CONSIDERED TO BE OPERATING SYSTEM KEYWORDS 01650002 * RATHER THAN LANGUAGE DEPENDENT PHRASES. 01700002 * 01750002 * BLANKS ARE OR'ED TO ALL REPLIES TO CONVERT THEM TO UPPER CASE 01800002 * 01850002 * RESTRICTIONS = NONE 01900002 * 01950002 * REGISTER-CONVENTIONS = ALL REGISTER NAMES BEGIN WITH R 02000002 * SEE EQUATES IMMEDIATELY FOLLOWING PROLOG 02050002 * 02060002 * PATCH-LABEL = PATCH, AN AREA ASSEMBLED AS BINARY 0 02070002 * 02080002 * MODULE-TYPE = 02090002 * PROCESSOR = OS/VS ASSEMBLER 02092002 * 02092402 * MODULE-SIZE = 1066 DECIMAL BYTES 02092802 * 02094002 * ATTRIBUTES = REENTRANT, ENABLED, PRIVELEGED, 02096002 * EXECUTES IN SETPRT INVOKER KEY 02098002 * CODE AT ENTRY POINT WTOR IS NON-PRIVELEGED 02098402 * 02098802 * ENTRY POINT = IGG08102 02099202 * PURPOSE = SEE FUNCTION 02099602 * 02099702 * LINKAGE = BRANCH FROM IGG08101 02099848 * 02099902 * INPUT = REGISTER 4(RSPW) = WORK AREA ADDRESS 02166002 * REGISTER 5(RPAR) = PARAMETER LIST ADDR 02166402 * REGISTER 6(RSVR) = SVRB EXTENDED SAVE AREA ADDRESS 02166502 * REGISTER 8(RIMAG) = ADDR OF IMAGE TO BE LOADED 02166602 * REGISTER 9(RIOB) = ADDRESS OF IOB 02166702 * 02177702 * OUTPUT = 02187702 * REGISTERS = TO INVOKER 02188102 * R0 = UNDEFINED 02188502 * R1 = UNDEFINED 02188602 * R2-R14 = UNCHANGED 02188702 * R15 = RETURN CODE (SEE EXIT-ERROR) 02188802 * 02242102 * REGISTERS = TO IGG08103 02244102 * R0-R3 = UNDEFINED 02246102 * R4-R6 = AS FOR INPUT 02248102 * R7-R8 = UNDEFINED 02256702 * R9 = AS FOR INPUT 02258702 * R10-R14 = UNDEFINED 02260748 * R15 = RESERVED FOR BRANCH INTERFACE 02262748 * 02264702 * MESSAGES = RETRIEVED FROM IGGMSG01 02265102 * 'IEC121D V XXX,YYYY(,FOLD)' 02265202 * 'IEC125A ERROR - REPEAT REPLY' 02265402 * 02265502 * UCB = IMAGE ID AND OPTIONS 02274102 * PRINTER = UCS BUFFER IS LOADED 02300002 * LISTING OF THE IMAGE WHEN VERIFICATION SPECIFIED 02400002 * 02900000 * EXIT-NORMAL = WHEN AN FCB IMAGE IS TO BE LOADED, BRANCH TO SETPRT 02960048 * MODULE IGG08103 03020002 * - WHEN NO FCB IMAGE IS TO BE LOADED, 03080002 * EXIT TO THE PROBLEM PROGRAM. RETURN CODE=00 03140002 * 03200000 * EXIT-ERROR = WHEN PERMANENT I/O ERROR OCCURED DURING UCS LOAD, 03300002 * SET RETURN CODE=0C 03400002 * - WHEN PERMANENT I/O ERROR OCCURED DURING VERIFICATION, 03600000 * SET RETURN CODE=10 03800002 * - WHEN AN OPERATOR ISSUED CANCEL FOR IEC121, 03900002 * SET RETURN CODE=14 04100002 * - IF AN FCB IMAGE IS TO BE LOADED THE RETURN CODE IS 04120020 * SAVED AND BRANCH IS MADE TO SETPRT MODULE IGG08103, 04140048 * OTHERWISE RETURN TO THE SETPRT INVOKER. 04160002 * - IF DEB IS NOT VALIDLY ASSOCIATED WITH USER'S DCB, 04170002 * EXIT TO SETPRT INVOKER WITH RETURN CODE=18 04180002 * 04182002 * ENTRY-POINT = WTOR (INTERNAL ENTRY) 04184002 * PURPOSE = ISSUE WTOR SVC IN PROBLEM STATE TO AVOID INTEGRITY 04186002 * EXPOSURE FROM NON-PROTECTED MESSAGE 04188002 * 04188402 * LINKAGE = SYNCH FROM WITHIN THIS MODULE 04188802 * 04189202 * INPUT = 04189602 * REGISTER 4(RSPW) = WORK AREA ADDRESS 04189702 * REGISTER 14(R14) = RETURN ADDRESS 04189802 * 04189902 * OUTPUT = 04191802 * REGISTERS = TO INVOKER 04192202 * R0 = UNDEFINED 04192602 * R1 = UNDEFINED 04193002 * R2-R14 = UNCHANGED 04193402 * R15 = UNDEFINED 04193502 * 04193602 * EXTERNAL REFERENCES = 04193802 * ROUTINES = DEBCHK (BRANCH ENTRY) 04195702 * DELETE (SVC 9) 04197602 * EXCP (SVC 0) 04199502 * FREEMAIN(SVC 10) 04201402 * IGG08103(SETPRT LOAD 4) 04203302 * IMGLIB (SVC105) 04205202 * SETLOCK (BRANCH ENTRY) 04207102 * SYNCH (SVC 12) 04209002 * WAIT (SVC 1) 04210902 * WTOR (SVC 35) 04212802 * 04216602 * DATA-AREAS = SPP -- SETPRT PARAMETER LIST 04226602 * SPW -- SETPRT WORK AREA 04228602 * SPRBXSV -- RB EXTENDED SAVE AREA 04230602 * MSG -- MESSAGE CSECT 04232602 * CONTROL-BLOCKS = 04233002 * CVT -- COMMUNICATIONS VECTOR TABLE 04233102 * DCB -- DATA CONTROL BLOCK 04233202 * DEB -- DATA EXTENT BLOCK 04233302 * ECB -- EVENT CONTROL BLOCK 04238802 * IOB -- INPUT/OUTPUT BLOCK 04240802 * PSA -- PREFIXED SAVE AREA 04241202 * UCB -- UNIT CONTROL BLOCK 04242802 * 04243202 * MACROS = DELETE, EXCP, FREEMAIN, IMGLIB, MODESET, SETLOCK, 04243602 * SYNCH, WAIT, WTOR, 04243748 * CVT, DCBD, IEFUCBOB, IEZDEB, IEZIOB, IGGMSG, IGGSPW, 04244002 * IHAECB, IHAPSA, IHASPP 04244102 * 04244402 * CHANGE-ACTIVITY = AS FOLLOWS 04246402 * 04246502 * NOTE = THIS MODULE WAS BROUGHT UP TO STANDARDS FOR VS2-2 04246802 * WHICH CAUSED ALL PREVIOUS RELEASE SEQUENCE NUMBER DELETIONS TO 04247202 * BECOME INVALID. 04247602 * 04248402 * RELEASE 20 DELETIONS 04270002 *THE FOLLOWING PTMS WERE FIXED IN THIS RELEASE - 5149, 5143 04280002 *THE FOLLOWING APAR WAS FIXED IN THIS RELEASE - 34950 04290002 *THE FOLLOWING DEVELOPMENT CODE WAS FOR 3211 SUPPORT - S20202 04292002 * 04294002 * RELEASE 21 DELETIONS 04298802 *THE FOLLOWING PTMS WERE FIXED IN THIS RELEASE - 0092, 1759 04299202 *THE FOLLOWING APAR WAS FIXED IN THIS RELEASE - 50699 04299602 * 04299702 * VS2 RELEASE 2 DELETIONS 04299803 *THE FOLLOWING DEVELOPMENT CODE WAS FOR VS2-2 - Y02072 04349802 * YM3920 04449802 * YM5703 04499802 * YM5919 04549802 * 04599803 * VS2 RELEASE 3 CHANGES 04649803 *A199700-199800,203500,619078-619098,619283 ZA02199 04699803 * 04749848 * VS2 RELEASE 3.7 CHANGES 04757848 * 04765848 *C146000-146300 @ZA25004 04773848 *A459500,618758-618761 @ZA25004 04781848 * 04789848 * VS2 RELEASE 4 CHANGES 04799848 * @Z40MSMI 04849848 * 04899848 * 05300000 *********************************************************************** 05400000 EJECT 05600000 *********************************************************************** 05800000 * 05900000 * REGISTER CONVENTIONS USED THROUGH OUT ALL SETPRT MODULES 06000002 * 06100000 *********************************************************************** 06200000 * 06300000 R0 EQU 0 PARAMETER REG 06400002 RWRK1 EQU 0 WORK REGISTER 06450002 R1 EQU 1 PARAMETER REG 06500002 RWRK2 EQU 1 WORK REGISTER 06550002 RDCB EQU 2 ADDR OF USER'S DCB 06600000 RWRK9 EQU 2 WORK REGISTER 06650002 RBASE EQU 3 BASE REG. 06700000 RSPW EQU 4 ADDR OF MESSAGE/WORKAREA 06800002 RPAR EQU 5 PARM LIST ADDR 06900000 RSVR EQU 6 SVRB EXTENDED SAVE AREA 07000002 RRET EQU 7 SUBROUTINE RETURN 07100002 RIMAG EQU 8 ADDRESS OF IMAGE LOADED 07250002 RIOB EQU 9 ADDR OF LAST IOB USED 07300000 R10 EQU 10 LIMIT FOR STM Y02072 07350002 RUCB EQU 10 UCB ADDR 07400000 RDEB EQU 11 DEB ADDR 07500000 RWRK10 EQU 11 WORK REGISTER 07550002 RWRK5 EQU 12 WORK REG. 07600002 RWRK6 EQU 13 WORK REG. 07700002 R14 EQU 14 LINK REG. 07800002 RWRK7 EQU 14 WORK REGISTER 07850002 R15 EQU 15 LINK RETURN CODE REG. 07900002 RWRK8 EQU 15 WORK REGISTER 07950002 * 08000000 *********************************************************************** 08100000 * 08200000 * RETURN CODES 08900002 * 09000000 RCNORM EQU X'00' NORMAL RETURN 09100002 RCLOADIO EQU X'0C' I/O ERROR DURING LOAD 09200002 RCVERIO EQU X'10' I/0 ERROR DURING VERIF 09300002 RCOPVER EQU X'14' OPER CANCEL IN VERIF 09400002 RCNOPEN EQU X'18' DCB NOT OPEN Y02072 09450002 * 09500000 *********************************************************************** 09510002 * MESSAGE NUMBERS IN IGGMSG01 09520002 * ALL MESSAGE NUMBERS HAVE BEEN DOUBLED IN THESE EQUATES 09530002 * TO PROVIDE OFFSETS INTO THE MESSAGE CSECT. 09540002 * THIS IS DEPENDENT ON L'MSGINDOF BEING 2. 09542002 * 09544002 MSG121 EQU 16*2 IEC121D, NO FOLD Y02072 09550002 MSG121F EQU 12*2 IEC121D, FOLD Y02072 09600002 MSG125 EQU 8*2 IEC125I Y02072 09610002 HEADING EQU 13*2 UCS HEADING, NO FOLD Y02072 09620002 HEADINGF EQU 18*2 UCS HEADING, FOLD Y02072 09630002 * 09632002 *********************************************************************** 09634002 * OTHER EQUATES 09636002 * 09638002 UCB43211 EQU X'09' MASK FOR 3211 PRINTER M5149 10265002 BLANK EQU C' ' A BLANK FOR AN MVI OPERAND 10315002 UCSLNGTH EQU X'F0' UCS IMAGE LENGTH 10415002 EJECT 10465002 USING SPW,RSPW 10515002 USING SPPARM,RPAR 10565002 USING IOBQSAMN,RIOB 10615002 USING IMAGE,RIMAG 10665002 USING SPRBXSV,RSVR 10715002 * 12800000 *********************************************************************** 12900000 * 13000000 * INITIALIZE REGISTERS 13100000 * 13200000 *********************************************************************** 13300000 * 13400000 BALR RBASE,0 ESTABLISH BASE 13500002 START EQU * 14400000 USING START,RBASE 14450002 SPACE 14460002 B BEGIN BR AROUND CONSTANTS Y02072 14500002 DC C'IGG08102' MODULE NAME Y02072 14550002 DC C'@ZA25004' LAST SHIP CODE @ZA25004 14600048 DC C'&SYSDATE' LAST DATE MODIFIED @ZA25004 14630048 BEGIN DS 0H Y02072 14700002 SPACE 14750002 L RDCB,SPPDCBA LOAD DCB ADDR 14800002 USING IHADCB,RDCB 14850002 L RDEB,DCBDEBAD LOAD DEB ADDR 14900000 USING DEBDASD-(DEBBASND-DEBBASIC),RDEB 14950002 L RUCB,DEBUCBAD LOAD UCB ADDR 15000000 USING UCBOB,RUCB 15050002 USING DEBBASIC,RDEB 15060002 * 15100000 *********************************************************************** 15200000 * 15300000 * SET CCW FOR EXCP 15400002 * 15500000 *********************************************************************** 15600000 * 15700000 MVI IOBFLAG1,IOBCMDCH+IOBUNREL SET IOBFLAG=C.C/UNRL 15800002 * 16600000 *********************************************************************** 16700000 * 16800000 * EXCP TO LOAD IMAGE INTO UCS BUFFER 16900000 * 17000000 *********************************************************************** 17100000 * 17200000 * CONSTRUCT CCW'S TO LOAD UCS IMAGE 17500020 * 17600000 XC SPWCCW1(L'SPWCCW1+L'SPWCCW2),SPWCCW1 RESET CCWS 17700002 SR RWRK8,RWRK8 RESET REGISTER S20202 17702002 IC RWRK8,IMANOLN INSERT NO. OF S20202 17704002 * VERIFICATION LIN S20202 17706020 LA RWRK5,IMALEN1 LOAD IMAGE LOAD ADDR + 2 S20202 17708002 * = X S20202 17710020 AR RWRK5,RWRK8 DISPLACE BY NO. OF LINES S20202 17712002 CLI UCBTBYT4,UCB43211 CK FOR 3211 DCB M5149 17714002 BNE BLDCCW2 NO BUILD 1403 UCS LOAD S20202 17716020 * CCW'S S20202 17718020 * 17720020 * YES BUILDS CCW TO LOAD UCS 3211 - LOAD CCW FOLLOWED BY FOLD CCW 17722002 * 17724020 ST RWRK5,SPWCCW1 STORE ADDR OF UCS IN CCW S20202 17726002 MVI SPWOPCD1,SPWLDUCS SET COMMAND CODE=LOAD S20202 17728002 * UCS. S20202 17730020 LA RWRK8,IMA3211L GET LENGTH OF UCS IMAGE S20202 17732002 ST RWRK8,SPWCCWF1 STORE LENGTH OF UCS IN S20202 17736002 * CCW S20202 17738020 TM SPWPARM1,SPWFOLD TEST IF FOLD MODE Y02072 17740002 * SPECIFIED S20202 17742020 BNO EXCPLOAD NO GO TO ISSUE EXCP S20202 17744002 * YES CHAIN AND BUILD FOLD CCW 17746020 MVI SPWCCWF1,SPWCC SET CC ON IN LOAD CCW S20202 17748002 MVI SPWOPCD2,SPWFLDCD SET COMMAND CODE=FOLD S20202 17750002 MVI SPWCCWF2,SPWSILI SET SILI BIT ON S20202 17752002 MVI SPWBYTE2+1,1 SET COUNT EQ 1 S20202 17754002 B EXCPLOAD GO ISSUE EXCP TO S20202 17756002 * LOAD&FOLD UCS S20202 17758020 * 17760020 * BUILD CCW TO LOAD UCS 1403 - GATE LOAD CCW FOLLOWED BY A 17762020 * LOAD UCS OR LOAD AND FOLD CCW. 17764020 * 17766020 BLDCCW2 EQU * S20202 17768020 * 17770020 MVI SPWOPCD1,SPWCNTRL SET CONTROL CCW 17800002 MVI SPWCCWF1,SPWSILI+SPWCC SET FLAGS 17900002 MVI SPWBYTE1+1,1 SET COUNT = 1 18000002 * 18100000 MVI SPWBYTE2+1,IMA1403L SET COUNT TO IMAGE LENGTH 18300002 * 18400000 ST RWRK5,SPWCCW2 STORE DATA ADDR IN CCW 18900002 * 19000000 MVI SPWOPCD2,SPWLDUCS COMMAND CODE = LOAD NO FOLD 19100002 TM SPWPARM1,SPWFOLD IF FOLD IS NOT SPECIFIED Y02072 19200002 BNO EXCPLOAD THEN GO TO EXCP 19300002 * 19400000 MVI SPWOPCD2,SPWLDFLD IF YES,COMMAND CODE = LOAD FOLD 19500002 * 19600000 EXCPLOAD EQU * 19700002 * 19800000 L RWRK2,UCBXTADR LOAD UCB EXTENSION ADDR M0092 19820002 USING UCBUCS,RWRK2 19830002 IC RWRK1,UCBUCSOP PASS OP UNCHANGED Y02072 19832002 DROP RWRK2 19910002 BAL RRET,SETUCB STORE UCSID AND UCSOP Y02072 19960002 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 19970000 * PROCESSING REQUIRED ZA02199 19980003 EXCP IOBSTDRD EXCP 20000002 * 20100000 L R1,IOBECBPT LOAD ECB ADDR 20200002 WAIT ECB=(1) WAIT ON EXCP 20300000 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 20350003 * 20400000 L RWRK2,IOBECBPT LOAD ECB ADDR 20500002 USING ECB,RWRK2 20550002 CLI ECBCC,ECBNORM TEST IF I/O COMPLETE 20600002 DROP RWRK2 20650002 BE UCSVRFY IF YES,GOTO TEST IF VERIFY SPEC 20700002 * 21200000 *********************************************************************** 21300000 * 21400000 * WHEN I/O ERROR WAS DETECTED DURING LOAD UCS 21500000 * UPDATE UCB WITH X'00',DELETE IMAGE LOADED AND GIVE CONTROL BACK 21600000 * TO USER'S PROGRAM WITH RETURN CODE = X'0C' IN REG.15 21700000 * RUN THE C.E. DIAGNOSTICS FOR THE UCS FEATURE 21800000 * 21900000 *********************************************************************** 22000000 * 22100000 LA RWRK5,RCLOADIO LOAD RETURN CODE 22200002 * 22500000 NULLUCB EQU * 22600000 * 22900000 * SET UCB TO INDICATE THE IMAGE IN THE BUFFER IS NOT USABLE 23000000 * 23100000 SR RWRK1,RWRK1 UCSOP = 0 Y02072 23350002 SR RWRK6,RWRK6 UCSID = 0 Y02072 23400002 BAL RRET,SETUCB PUT VALUES IN UCB Y02072 23450002 B IMAGDEL GO DELETE IMAGE 23600002 EJECT 23700002 UCSVRFY EQU * 24000000 * 24100000 *********************************************************************** 24200000 * 24300000 * TEST IF VERIFICATION IS REQUIRED BY EITHER THE USER OR THE A34950 24360020 * OPERATOR. A34950 24420020 * - YES: VERIFY IMAGE A34950 24480020 * - NO : UPDATE UCB & EXIT A34950 24540020 * 24600000 *********************************************************************** 24700000 * 24800000 TM SPWPARM1,SPWVERIF IF VERIFICATION REQUIRD Y02072 24900002 BO VRFY2 YES, VERIFY (USER OPTION) A34950 24930002 TM SPWFLG1,SPWRPVER IF OPERATOR SPEC VERIFY Y02072 24960002 BNO SETNORM IF NOT,GOTO EXIT ROUTINE 25000002 SPACE 3 25100002 VRFY2 EQU * 25400002 * 25500000 *********************************************************************** 25600000 * 25700000 * INITIALIZE REGISTERS FOR VERIFICATION 25800000 * RWRK5 - NUMBER OF LINES REMAINING TO PRINT 25850002 * RWRK7 - POINTER TO CURRENT LINE 25860002 * RWRK9 - CURRENT ENTRY IN TABLE OF LINE LENGTHS 25870002 * RWRK10- NUMBER OF CHARACTERS IN CURRENT LINE 25880002 * 25900000 *********************************************************************** 26000000 DROP RDEB,RDCB 26050002 * 26100000 SR RWRK5,RWRK5 RESET REGISTER 26200002 IC RWRK5,IMANOLN INSERT NO. OF LINES 26300002 * 26400000 LTR RWRK5,RWRK5 TEST IF NO VERIFICATION 26500002 BZ SETNORM IF NOT,GOTO EXIT ROUTINE 26600002 * 26700000 SR RWRK10,RWRK10 RESET RDEB REG. 26800002 LA RWRK9,IMALEN1 OBTAIN 1ST NO. OF CHAR/LINE 26900002 IC RWRK10,0(RWRK9) INSERT NO. OF CHAR/LINE 27000002 LR RWRK7,RWRK9 OBTAIN UCS IMAGE POSITION 27100002 AR RWRK7,RWRK5 ADD NO. OF LINES TO POSITION 27200002 * 27300000 * 27400000 *********************************************************************** 27500000 * 27600000 * EXCP ON PRINTER TO PRINT VERIFICATION LINES 27700000 * 27800000 *********************************************************************** 27900000 * 28000000 * 28100000 * CONSTRUCT CCW TO SKIP TO NEW PAGE AND PRINT HEADING 28200000 * 28300000 XC SPWCCW1(L'SPWCCW1+L'SPWCCW2),SPWCCW1 RESET CCWS 28400002 MVI SPWBYTE1+1,1 DATA LENGTH=X'01' 28500002 MVI SPWCCWF1,SPWSILI+SPWCC SET C.C.AND SILI 28600002 MVI SPWOPCD1,SPWSKIP SET COMMAND CODE = SKIP TO CH1 28700002 * 28800000 MVI SPWCCWF2,SPWSILI SET SILI FLAG 29000002 * 29100000 LA RWRK1,SPWMSGTX PRINT AREA ADDR Y02072 29200002 ST RWRK1,SPWCCW2 STORE DATA ADDR 29300002 MVI SPWOPCD2,SPWWRITE SET COMMAND CODE = WRITE 29400002 * 29500000 * MOVE UCS HEADING,UCS IMAGE ID AND LOAD MODE 29600000 * 29700000 LA RWRK2,HEADING ASSUME NO FOLD Y02072 29750002 TM SPWPARM1,SPWFOLD TEST IF LOAD MODE = FOLD Y02072 29760002 BNO GETHEAD IF NOT,GOTO GET HEADING Y02072 29770002 LA RWRK2,HEADINGF IF SO, INDICATE FOLD Y02072 29800002 GETHEAD BAL RRET,GETMSG GET THE MESSAGE Y02072 29850002 USING MSGENTRY,RWRK8 Y02072 29900002 * 29910002 * FILL IN CCW LENGTH 29950002 * 29960002 SR RWRK2,RWRK2 Y02072 30000002 IC RWRK2,MSGLNG GET MESSAGE LENGTH Y02072 30050002 LA RWRK2,1(RWRK2) CHANGE LEN-1 TO LEN Y02072 30060002 STH RWRK2,SPWBYTE2 SET LENGTH IN CCW Y02072 30070002 * 30070402 * FILL IN IMAGE ID 30072002 * 30074002 IC RWRK2,MSGOFF1 PICK UP OFFSET TO ID Y02072 30080002 LA RWRK2,SPWMSGTX(RWRK2) INDEX INTO MESSAGE Y02072 30090002 ST RWRK6,0(RWRK2) STORE IMAGE ID Y02072 30100002 DROP RWRK8 Y02072 30200002 BAL RRET,WRITEGO GO ISSUE EXCP Y02072 30250002 * 36000000 VRFYEXCP EQU * 36100000 * 36200000 *********************************************************************** 36300000 * 36400000 * EXCP FOR VERIFICATION LINES 36500000 * 36600000 *********************************************************************** 36700000 * 36800000 ST RWRK7,SPWCCW1 STORE DATA ADDR IN CCW 36900002 ST RWRK10,SPWCCWF1 STORE DATA LENGTH IN CCW 37000002 MVI SPWCCWF1,SPWSILI SET SILI FLAG 37100002 MVI SPWOPCD1,SPWWRITE SET COMMAND CODE = WRITE 37200002 BAL RRET,WRITEGO GO EXCP,WAIT AND TST S20202 37700002 * COMP CODE S20202 38200020 * 38700000 * REPEAT EXCP WHEN NO I/O ERROR 38800000 * 38900000 AR RWRK7,RWRK10 MODIFY IMAGE POSITION 39000002 LA RWRK9,1(RWRK9) INCREMENT REG. BY '1' 39100002 IC RWRK10,0(RWRK9) INSERT NO. OF CHAR/LINE 39200002 * 39300000 BCT RWRK5,VRFYEXCP REPEAT EXCP 39400002 * 39500000 *********************************************************************** 39600000 * 39700000 * SKIP TO NEW PAGE 39800000 * 39900000 *********************************************************************** 40000000 * 40100000 MVI SPWBYTE1+1,1 MOVE DATA LENGTH=1 40200002 MVI SPWOPCD1,SPWSKIP SET COMMAND CODE=SKIP 40300002 BAL RRET,WRITEGO GO EXCP,WAIT AND TST S20202 40800002 * COMP CODE S20202 41300020 * 41800000 *********************************************************************** 41810002 * 41850002 * WTOR 'IEC121D V XXX,YYYY,FOLD' TO REQUEST OPERATOR'S REPLY 41900002 * 41950002 *********************************************************************** 41960002 * 42000002 LA RWRK2,MSG121 ASSUME NO FOLD Y02072 44350002 TM SPWPARM1,SPWFOLD IF LOAD MODE NOT = FOLD Y02072 44400002 BNO GET121 THEN GO GET NOFOLD MSG Y02072 44500002 LA RWRK2,MSG121F ELSE SET FOR FOLD MSG Y02072 44550002 * 44600002 GET121 BAL RRET,GETMSG GET THE MESSAGE Y02072 44650002 ST RWRK6,SPWREPID STORE UCS IMAGE ID 44700002 BAL RRET,FILLFLDS FILL IN UNIT & IMAGE ID Y02072 44750002 MESSAGO EQU * DM0Q 45050018 MVC SPWREPLY,BLANKS CLEAR REPLY AREA TO BLANKS 45300002 MVI SPWRPECB,0 RESET REPLY ECB 45400002 * 45500000 TM SPRKEY,SPRUSKEY IF CALLED AS SYS FUNCT Y02072 45510002 BZ MESSAGO2 DO NOT SYNCH TO WTOR Y02072 45520002 SYNCH WTOR ISSUE WTOR IN PROB STATE Y02072 45550002 B WAIT THEN WAIT FOR COMPLETION Y02072 45600002 MESSAGO2 EQU * SYS WTOR Y02072 45650002 BAL R14,WTOR ISSUE WTOR IN SUP STATE Y02072 45660002 * 45700000 WAIT EQU * WAIT FOR OPERATOR REPLY Y02072 45750002 WAIT ECB=SPWRPECB,LONG=YES Y02072 45900002 XC SPWMSGID(4),SPWMSGID CLEAR MSG ID FOR DOM @ZA25004 45950048 * 46000000 *********************************************************************** 46100000 * 46200000 * REPLY ANALYSIS 46300000 * 46400000 *********************************************************************** 46500000 * 46600000 OC SPWREPLY,LOWER OR TO ALLOW LOWER CASE REPLY 46700002 CLC SPWREPLY(L'RETRYCN),RETRYCN TEST IF REPLY='RETRY' 46800002 BE VRFY2 IF YES GO RE-VERIFY S20202 46900002 * 47000000 CLC SPWREPLY(L'CANCELCN),CANCELCN TEST IF REPLY='CANCEL' 47100002 BNE TESTOK IF NOT,GOTO CONTINUE TEST 47200002 * 47500000 CANCELGO EQU * 47600000 * 47700000 *********************************************************************** 47800000 * 47900000 * AN OPERATOR CANCELLED THE JOB STEP BECAUSE SPECIFIED CHAIN IS NOT 48000000 * AVAILABLE. RETURN CODE = X'14' IN REG.15 48100000 * RERUN THE JOB WITH CORRECT CHAIN/TRAIN 48200000 * 48300000 *********************************************************************** 48400000 * 48500000 LA RWRK5,RCOPVER LOAD RETURN CODE 48600002 B NULLUCB GOTO UPDATE UCB AND EXIT RTN 48700002 * 49000000 TESTOK EQU * 49100000 * 49300000 CLC SPWREPLY(L'OKCN),OKCN TEST IF REPLY = 'VERIFIED' 49400002 BE SETNORM IF YES,GOTO EXIT ROUTINE 49500002 CLC SPWREPLY(L'VBLANK),VBLANK TEST IF REPLY = 'V' 49600002 BE SETNORM IF YES,GOTO EXIT ROUTINE 49700002 * 49800000 CLC SPWREPLY(L'RBLANK),RBLANK TEST IF REPLY = 'R' 49900002 BE VRFY2 IF YES GO RE-VERIFY S20202 50000002 * 50100000 CLC SPWREPLY(L'CBLANK),CBLANK TEST IF REPLY = 'C' 50200002 BE CANCELGO IF YES,GOTO CANCEL ROUTINE 50300002 * 50400000 * 50500000 *********************************************************************** 50600000 * 50700000 * REPLY ERROR 'IEC125I ERROR - REPEAT REPLY' 50800000 * 50900000 *********************************************************************** 51000000 * 51100000 LA RWRK2,MSG125 REQUEST ERROR MSG Y02072 51150002 BAL RRET,GETMSG GO GET THE MESSAGE Y02072 51200002 B MESSAGO GO BACK TO WTORX21 ROUTINE DM0Q 51400018 EJECT 53800002 SETNORM EQU * 54400002 * 54500000 *********************************************************************** 54600000 * 54700000 * SET RETURN CODE = X'00' (SUCCESSFUL) 54800000 * AND UPDATE UCB WITH NEW IMAGE IN THE UCS BUFFER 54850002 * 54900000 *********************************************************************** 55000000 * 55100000 LA RWRK5,RCNORM LOAD RETURN CODE 55200002 IC RWRK1,SPWPARM1 GET UCS OPTION BITS Y02072 56170002 LA RWRK2,X'FF'-(SPWOVLAP+SPWVERIF) Y02072 56220002 NR RWRK1,RWRK2 RESET TWO FLAGS Y02072 56270002 IC RWRK2,IMAFLAG GET DEFAULTS Y02072 56320002 OR RWRK1,RWRK2 OR THEM IN Y02072 56370002 BAL RRET,SETUCB PUT IN UCSOP AND UCSID Y02072 56420002 * 56600000 * 56800000 IMAGDEL EQU * 56900002 * 57000000 *********************************************************************** 57100000 * 57200000 * DELETE IMAGE LOADED, RESTORE REGISTERS, AND TEST FOR FCB. 57300002 * 57700000 *********************************************************************** 57800000 * 57900000 DELETE EPLOC=SPWUCSIM DELETE THE IMAGE LOADED 58300002 * 58400000 SR RWRK6,RWRK6 CLEAR IMAGE ID Y02072 58402002 ST RWRK6,SPWUCS2H Y02072 58402402 * 58404020 * RESET REG'S WITH DCB AND DEB ADDRESSES 58408020 * 58412020 CH RWRK5,ERRCODE IF RET CODE = X'18' YM3920 58414002 * CANNOT GO TO NEXT LOAD YM3920 58414402 BE FREEMAIN YES, DEBCHK MUST HAVE YM3920 58414802 * FAILED YM3920 58415202 L RDCB,SPPDCBA GET DCB ADDR S20202 58416002 USING IHADCB,RDCB 58418002 L RDEB,DCBDEBAD GET DEB ADDR S20202 58420020 USING DEBBASIC,RDEB 58422002 CLI UCBTBYT4,UCB43211 CK FOR 3211 DCB M5149 58424002 BNE FREEMAIN NO GO FREE S20202 58428020 * MESSAGE/WORKAREA S20202 58432020 * 58448020 ********************************************************************** 58452020 * 58456020 * FCB LOAD REQUIRED-BRANCH TO SETPRT MODULE IGG08103 58460048 * 58464020 ********************************************************************** 58468020 * 58472020 L R15,ID3 ADDR. OF MOD. IGG08103 @Z40MSMI 58496048 BR R15 GO TO NEXT MODULE @Z40MSMI 58498048 * 58500048 FREEMAIN EQU * 58600000 * 58610020 *********************************************************************** 58612002 * 58614002 * EXIT TO ENTRY POINT. (1) CLOSE IMAGELIB 58616002 * (2) DELETE MESSAGE CSECT 58616402 * (3) FREEMAIN WORK AREA 58618002 * (4) FREEMAIN BLDL PARAMETER LIST YM5703 58618102 * (5) RESTORE IOB 58618402 * (6) EXIT WITH RETURN CODE IN REG.15 58618802 * 58619202 *********************************************************************** 58619602 * 58620002 MODESET EXTKEY=ZERO SWITCH TO SVRB KEY Y02072 58622002 * 58624002 L RWRK1,SPRIDCBA PICK UP IMAGELIB DCB Y02072 58626002 ST RWRK6,SPRIDCBA INDIC IMAGELIB CLOSED YM5703 58628402 * 58650002 IMGLIB CLOSE,(RWRK1) GO DELETE IMAGELIB DCB Y02072 58660002 * 58666002 ST RWRK6,SPRMSG Y02072 58670002 * 58672002 DELETE EP=IGGMSG01 DELETE MSG CSECT Y02072 58680002 * 58690002 ST RWRK6,SPRIOBSV INDICATE IOB RESTORED Y02072 58710102 * 58710402 MODESET KEYADDR=SPRKEY,WORKREG=1 RESUME NORMAL KEY Y02072 58712002 SPACE 58720002 MVC IOBFLAG1(4),SPWFLGSV RESTORE FLAGS Y02072 58770002 MVC IOBSTART,SPWSTRSV RESTORE IOB START Y02072 58820002 * 58830002 * ISSUE FREEMAINS FOR SETPRT WORKAREA AND BLDL PARAMETER LIST. YM5703 58840002 * 58870002 FREEMAIN R,LV=SPWLNGTH,A=(RSPW),SP=SPWPOOL Y02072 59000002 * 59700000 SPACE 59750002 MODESET EXTKEY=DATAMGT KEY OF BLDL PARA LIST YM5703 59800002 SPACE 59850002 L RWRK2,SPRBLDLA ADDR OF BLDL LIST YM5703 59860002 USING SPW5,RWRK2 @Z40MSAP 59870048 ST RWRK6,SPWWKADR INDIC WORKAREA FREED YM5703 59900002 * 59950002 FREEMAIN R,LV=SPW5LNTH,A=(RWRK2),SP=SPW5POOL @Z40MSAP 60000048 SPACE 60050002 MODESET EXTKEY=SUPR KEY OF SVRB YM5703 60060002 SPACE 60070002 DROP RWRK2 YM5703 60100002 ST RWRK6,SPRBLDLA INDIC BLDL LIST FREED YM5703 60150002 LR R15,RWRK5 LOAD RETURN CODE 61600002 L R14,SPREXIT GET EXIT PROLOG ADDR Y02072 61700002 BR R14 AND RETURN TO IT Y02072 61710002 EJECT 61712002 DROP RDEB,RUCB Y02072 61712102 SETUCB EQU * Y02072 61712502 *********************************************************************** 61712702 * THIS ROUTINE UPDATES THE UCB 61712902 * TO PERFORM THIS FUNCTION IT MUST VALIDATE THAT: 61713002 * 1. A PROTECTED CHAIN LEADS TO THE UCB 61713102 * 2. THE UCB IS ALLOCATED TO THE JOB REQUESTING SETPRT 61713302 * BOTH OF THESE ARE SATISFIED BY DEBCHK, SO LONG AS THERE 61713402 * IS NO TIME OF CHECK TO TIME OF USE EXPOSURE. 61713602 * THAT EXPOSURE IS COVERED BY RUNNING WITH THE LOCAL LOCK. 61713702 * INPUT: RWRK6 CONTAINS THE UCS ID TO PLACE IN THE UCB 61713802 * RWRK1 CONTAINS (LOW BYTE) THE UCS OPTIONS TO SET 61714002 * ADDRESSIBILITY REQUIRED: 61714202 * SVRB EXTENDED SAVE AREA 61714302 * OUTPUT:UCBUCSOP AND UCBUCSID ARE UPDATED (NORMAL) 61714402 * THE SAVE AREA SPRSAVE IN SVRB IS USED 61714502 * IF DEB NOT VALID, DOES NOT RETURN TO SUBROUTINE CALLER, 61714602 * INSTEAD SETS RETURN CODE AND EXITS 61714702 * THIS ROUTINE RETURNS ON REGISTER RRET 61714902 * ALL REGISTERS EXCEPT R15 AND R1 (= RWRK2) ARE TRANSPARENT 61715002 *********************************************************************** 61715102 MODESET EXTKEY=ZERO CHANGE TO KEY FOR BR ENT Y02072 61715302 STM R10,R14,SPRSAVE SAVE VOLATILE REGS Y02072 61715502 LOCK SETLOCK OBTAIN,TYPE=LOCAL,MODE=UNCOND, Y02072*61715602 RELATED=(DEB/UCB,UNLOCK) GET THE LOCAL LOCK Y02072 61715702 L R10,CVTPTR FIND CVT Y02072 61715802 USING CVT,R10 Y02072 61715902 L R15,CVTEXT2 FIND CVT EXTENSION Y02072 61716002 USING CVTXTNT2,R15 Y02072 61716502 L R15,CVTDEBVR GET PTR TO DEBCHK Y02072 61717002 DROP R15 Y02072 61717502 USING PSA,0 Y02072 61719502 L R10,PSATOLD GET CURRENT TCB ADDR Y02072 61720202 L R14,SPPDCBA GET DCB ADDRESS YM5919 61720602 USING IHADCB,R14 TEMP USING YM5919 61721002 L R1,DCBDEBAD GET DEB ADDRESS YM5703 61722202 DROP R14 YM5919 61722302 LA R1,0(R1) CLEAR HI-BYTE YM5703 61722402 BALR R14,R15 CALL DEBCHK Y02072 61722502 * 61722902 * DEBCHK RETURNS ON REGISTER 14 PLUS THE CONTENTS OF REG 15 YM5703 61723302 * REG 15 : 0 - DEB OK YM5703 61723702 * 4 - DEB INVALID YM5703 61723802 * REGARDLESS OF DEBCHK RETURN, THE LOCAL LOCK MUST BE RELEASED YM5703 61724202 * AS SVC'S CANNOT BE ISSUED WHILE HOLDING THE LOCK. YM5703 61724602 * 61724802 B DEBOK DEB VALID--PTR IN R1 YM5703 61726802 B UNLOCK INVALID--REL LOCK YM5703 61728802 DEBOK EQU * Y02072 61730602 USING DEBDASD-(DEBBASND-DEBBASIC),R1 Y02072 61731602 L RWRK2,DEBUCBAD FIND UCB Y02072 61732602 DROP R1 Y02072 61733602 USING SRT,RWRK2 Y02072 61734602 L RWRK2,UCBXTADR FIND UCS EXTENSION Y02072 61735602 USING UCBUCS,RWRK2 Y02072 61736602 LM R10,R14,SPRSAVE RESTORE VOLATILE REGS Y02072 61737602 ST RWRK6,UCBUCSID UPDATE ID IN UCB Y02072 61738602 STC RWRK1,UCBUCSOP UPDATE OPTIONS IN UCB Y02072 61739602 UNLOCK SETLOCK RELEASE,TYPE=LOCAL,RELATED=(DEB/UCB,LOCK) Y02072 61740602 LM R10,R14,SPRSAVE RESTORE VOLATILE REGS Y02072 61741602 SPACE 61742002 MODESET KEYADDR=SPRKEY,WORKREG=1 RESUME NORMAL KEY Y02072 61742602 SPACE 61743002 LTR R15,R15 WAS DEB VALID YM5703 61743402 BZR RRET YES, CONTINUE YM5703 61743502 * 61744602 NOTOPEN DS 0H YM5703 61745702 LA RWRK5,RCNOPEN DCB NOT VALIDLY OPEN YM5703 61746402 B IMAGDEL GO DELETE IMAGE Y02072 61746602 SPACE 3 61747602 GETMSG EQU * Y02072 61748602 *********************************************************************** 61749602 * THIS SUBROUTINE FINDS A MESSAGE IN THE MESSAGE CSECT 61750602 * AND MOVES IT INTO THE SETPRT WORK AREA 61751602 * INPUT: RWRK2 CONTAINS AN INDEX OFFSET (MSG NUMBER * 2) 61752602 * SPRMSG CONTAINS THE ADDRESS OF THE MESSAGE CSECT 61753602 * ADDRESSIBILITY REQUIRED: 61754602 * SVRB EXTENDED SAVE AREA 61755602 * SETPRT WORK AREA 61756602 * OUTPUT:RWRK2 POINTS TO MESSAGE TEXT IN MSG CSECT 61757602 * RWRK8 POINTS TO THE MSG ENTRY IN MSG CSECT 61758602 * SPWMSGTX CONTAINS A COPY OF THE MESSAGE TEXT 61759602 * THIS ROUTINE RETURNS ON REGISTER RRET 61760602 * ALL REGISTERS EXCEPT RWRK2 AND RWRK8 ARE TRANSPARENT 61761602 *********************************************************************** 61762602 L RWRK8,SPRMSG PICK UP MSG CSECT ADDR Y02072 61763602 USING MSGINDEX,RWRK8 Y02072 61764602 AH RWRK8,MSGINDOF(RWRK2) ADD ENTRY OFFSET Y02072 61765602 USING MSGENTRY,RWRK8 Y02072 61766602 SR RWRK2,RWRK2 Y02072 61776602 IC RWRK2,MSGOFF PICK UP TEXT OFFSET Y02072 61778602 AR RWRK2,RWRK8 GET PTR TO TEXT Y02072 61780602 USING MSGTXT,RWRK2 Y02072 61782602 MVC SPWMSGTX,MSGTXT MOVE IT INTO WORK AREA Y02072 61783002 BR RRET RETURN TO CALLER Y02072 61783102 DROP RWRK2,RWRK8 Y02072 61783202 SPACE 3 61785202 FILLFLDS EQU * Y02072 61787202 USING UCBOB,RUCB Y02072 61787602 *********************************************************************** 61788802 * THIS ROUTINE FILLS IN THE UNIT NAME AND IMAGE ID 61790802 * IN MESSAGES WHICH HAVE ALREADY BEEN MOVED TO THE WORK AREA 61792802 * INPUT: RWRK8 POINTS TO THE MESSAGE ENTRY IN MSG CSECT 61793202 * SPWREPID CONTAINS THE IMAGE ID TO FILL IN 61793602 * ADDRESSIBILITY REQUIRED: 61794002 * UCB 61794102 * SETPRT WORK AREA 61795202 * OUTPUT:SPWREPID AND UCBNAME HAVE MEEN MOVED TO THE 61797802 * APPROPRIATE OFFSETS FROM SPWMSGTX 61798902 * RWRK8 IS UNCHANGED FROM INPUT 61800002 * THIS ROUTINE RETURNS ON REGISTER RRET 61830702 * ALL REGISTERS ARE TRANSPARENT EXCEPT RWRK2 61832702 *********************************************************************** 61840702 USING MSGENTRY,RWRK8 Y02072 61844702 SR RWRK2,RWRK2 Y02072 61846702 IC RWRK2,MSGOFF1 PICK UP FIRST OFFSET Y02072 61847102 LA RWRK2,SPWMSGTX(RWRK2) POINT TO VAR IN WORKAREA Y02072 61855902 MVC 0(L'UCBNAME,RWRK2),UCBNAME MOVE IN UCBNAME Y02072 61857902 SR RWRK2,RWRK2 Y02072 61859902 IC RWRK2,MSGOFF2 PICK UP SECOND OFFSET Y02072 61861902 LA RWRK2,SPWMSGTX(RWRK2) POINT TO VAR IN WORKAREA Y02072 61863902 MVC 0(L'SPWREPID,RWRK2),SPWREPID MOVE IN IMAGE ID Y02072 61864302 BR RRET Y02072 61864702 DROP RWRK8 Y02072 61873502 SPACE 3 61874502 WTOR EQU * Y02072 61874602 *********************************************************************** 61874902 WTOR MF=(E,SPWRPLYA) ISSUE WTOR IN PROB STATE Y02072 61875502 ST R1,SPWMSGID SAVE MSG ID FOR DOM @ZA25004 61875848 OI SPWMSGID,X'80' SET HIGH ORDER BIT @ZA25004 61876148 BR R14 RETURN TO SYNCH Y02072 61876502 *********************************************************************** 61876902 EJECT 61877302 WRITEGO EQU * 61878502 * 61880502 **********************************************************************< 61880902 * 61881302 * EXCP/WAIT. NO I/O ERROR - CONTINUE THE PROCESS 61881702 * ANY I/O ERROR - EXIT WITH RETURN CODE = X'10' 61882102 * 61882202 *********************************************************************** 61882302 * 61905802 OI IOBFLAG1,IOBSPSVC IND NO SAM APPENDAGE ZA02199 61907800 * PROCESSING REQUIRED ZA02199 61909803 EXCP IOBSTDRD EXCP 61915802 * 61925802 L R1,IOBECBPT LOAD ECB ADDR 61927802 WAIT ECB=(1) WAIT 61928202 NI IOBFLAG1,X'FF'-IOBSPSVC RESET IOB FLAG ZA02199 61928303 * 61928602 * TEST COMPLETION CODE 61929002 * 61929402 L RWRK2,IOBECBPT LOAD ECB ADDR 61937202 USING ECB,RWRK2 61939202 TM ECBCC,ECBNORM TEST IF I/O COMPLETE 61941202 DROP RWRK2 61943202 BOR RRET RETURN FROM S20202 61943602 * EXCP,WAIT,COMP TES S20202 61944002 * 61944402 ********************************************************************* 61944802 * 61944902 * CHECK IF THE DEVICE IS A 3211 PRINTER AND THE ERROR IS RETRYABLE 61945002 * -NO GO SET RETURN CODE FOR PERM I/O ERROR DURING UCS VERIFICATION 61945102 * -YES GO REISSUE PRINT LINE ONCE. IF ERROR PERSIST ISSUE SKIP TO 61952902 * CHANNEL 0 AND SET RETURN CODE FOR PERM I/O ERROR UCS VERIFICATION 61954902 * 61956902 *********************************************************************** 61958902 * 61959302 CLI UCBTBYT4,UCB43211 CK FOR 3211 DCB M5149 61959702 BNE GOSTRTCD NO GO SET RETURN CODE S20202 61960102 TM IOBSENS1,IOBS1B0 TEST FOR COMMAND RETRY S20202 61960502 BNO GOSTRTCD NO GO SET RETURN CODE S20202 61960602 LTR RWRK9,RWRK9 TEST IF ERROR HAS BEEN S20202 61960702 * RETRIED ONCE 61960802 BL ISSUSKP0 YES GO RESET 3811 S20202 61968602 LA RWRK1,1 GET RETRY FLG S20202 61970602 SLL RWRK1,31 SHIFT FLG TO BIT 0 S20202 61972602 OR RWRK9,RWRK1 SET FLAG ON S20202 61974602 B WRITEGO GO EXCP TO CCW THAT S20202 61975002 * FAILED S20202 61975402 * 61975802 * FORM SKIP TO CHANNEL 0 CCW TO RESET CONTROL UNIT 61976202 * 61976302 ISSUSKP0 EQU * S20202 61976402 * 61976502 L RWRK2,IOBSTART GET ADDR OF CHANNEL PGM Y02072 61997002 MVC 0(L'SKP0CCW,RWRK2),SKP0CCW REPLACE CCW Y02072 62007002 BAL RRET,WRITEGO GO EXCP,WAIT AND TST S20202 62017002 * COMP S20202 62017402 * 62017802 GOSTRTCD EQU * S20202 62017902 * 62024702 *********************************************************************** 62026702 * 62028702 * WHEN THERE IS AN PERMANENT I/O ERROR DURING VERIFICATION, 62030702 * SET UCB TO INDICATE THE IMAGE IN THE BUFFER IS NOT USABLE 62031102 * GIVE CONTROL BACK TO ENTRY POINT. RETURN CODE = X'10' IN REG.15 62031502 * IF THE I/O ERROR PERSITS,RUN C.E. DIAGNOSTICS FOR THE PRINTER 62031602 * 62038402 *********************************************************************** 62040402 * 62042402 LA RWRK5,RCVERIO LOAD RETURN CODE 62044402 B NULLUCB GOTO UPDATE UCB AND EXIT RTN 62044802 EJECT 62045402 * 62052202 *********************************************************************** 62059002 * 62079502 * CONSTANTS 62100000 * 62200000 *********************************************************************** 62300000 * 62400000 * REPLY CONSTANT 63400000 * 63500000 ERRCODE DC H'24' ERROR RETURN CODE YM3920 63550002 RETRYCN DC C'RETRY' REPLY='RETRY' 63600000 CANCELCN DC C'CANCEL' REPLY='CANCEL' 63700000 OKCN DC C'VERIFIED' REPLY='VERIFIED' 63800000 CBLANK DC C'C ' REPLY = 'C' 63900000 RBLANK DC C'R ' REPLY = 'R' 64000000 VBLANK DC C'V ' REPLY = 'V' 64100000 BLANKS DC CL16' ' BLANKS 64200002 LOWER EQU BLANKS MASK TO ALLOW LOWER CASE REPLY 64250002 * 64300000 UCSCONST DC C'UCS1' UCS IMAGE ID FOR 1403 64400000 * 64430020 * CCW'S 64460020 * 64490020 SKP0CCW CCW SPWSKIP0,0,SPWSILI,1 SKIP TO 0 CCW S20202 64520002 * 64550020 * BRANCH TABLE 64970048 * 65000020 ID3 DC V(IGG08103) FIRST FCB LOAD @Z40MSMI 65200048 * 65250002 PATCH DC 0H'0',52X'00' PATCH AREA Y02072 65250402 END EQU * END OF MODULE Y02072 65262002 EJECT 65300002 * 65350002 * THIS DSECT IS USED TO MOVE THROUGH THE IMAGE PASSED FROM 65400002 * IGGO8101 65450002 * 65500002 IMAGE DSECT 65550002 IMAFLAG DS B FLAG BYTE 65600002 IMAFLDEF EQU X'80' THIS IS A DEFAULT IMAGE 65650002 IMANOLN DS AL1 NUMBER OF LINES IN THIS IMAGE 65700002 IMALEN1 DS AL1 LENGTH OF FIRST LINE 65750002 IMA3211L EQU 512 LENGTH OF 3211 UCS BUFFER 65800002 IMA1403L EQU 240 LEN OF 1403 UCS BUFFER Y02072 65802002 TITLE 'IGG08102 - SETPRT - SYSTEM DSECTS' 65842002 CVT DSECT=YES Y02072 65844002 EJECT 65846002 DCBD DSORG=PS 68800000 EJECT 70100002 IEZDEB 70150002 EJECT 70300002 IHAECB 70350002 EJECT 70352002 IEZIOB 70354002 EJECT 70404002 IGGMSG Y02072 70454002 EJECT 70464002 IHAPSA Y02072 70474002 EJECT 70500002 IHASPP 70550002 EJECT 70560002 IGGSPW 70570002 EJECT 70600002 SRT DSECT 70650002 * 70700002 IEFUCBOB 70750002 END 75000000