* /* START OF SPECIFICATIONS **** 00000102 *01* PROCESSOR = ASSEMXF-370R 00000202 **** END OF SPECIFICATIONS ***/ 00000802 IGG019VH CSECT ENTRY POINT FOR CNTRL MODULE 00006002 *********************************************************************** 00006602 *MODULE-NAME @YM00638 00007002 * IGG019VH @YM00638 00007102 * @YM00638 00007302 *DESCRIPTIVE-NAME @YM00638 00007402 * OCR CONTROL MODULE @YM00638 00007502 * @YM00638 00007602 *COPYRIGHT @YM00638 00007802 * NONE @YM00638 00008202 * @YM00638 00008302 *CHANGE-ACTIVITY @YM00638 00008402 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 00008502 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 00008702 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 00008902 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 00009102 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 00009602 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 00010202 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 00010802 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 00011402 * RELEASE 28 ADDITIONS/CHANGES/DELETIONS 00012002 * * 00012602 *STATUS - RELEASE 20 CHANGE LEVEL 000 * 00013202 * * 00013802 *FUNCTION/OPERATION - TO PROVIDE THE CAPABILITY TO PERFORM VARIOUS * 00014402 * FUNCTIONS TO THE USER. THESE FUNCTIONS ARE * 00015002 * 1 ESD - EJECT AND STACKER SELECT A DOCUMENT * 00015602 * 2 RKB - READ A FIELD IN THE ON-LINE * 00016202 * CORRECTION MODE * 00016802 * 3 HDR - READ A LINE OF HEADER INFORMATION * 00017402 * 4 MKL - MARK A JOURNAL TAPE LINE IN ERROR * 00018002 * 5 INC - INCREMENT A DOCUMENT TO THE NEXT STOP * 00018602 * 6 EJD - EJECT A DOCUMENT * 00019202 * 7 SSD - STACKER SELECT A DOCUMENT * 00019802 * * 00020402 *ENTRY POINTS - IGG019VH CSECT CALLING SEQUENCE - * 00021002 * LOAD DCB ADDRESS IN REGISTER 1 * 00021602 * NEXT AN INSTRUCTION SEQUENCE OF * 00022202 * BAL 0,*+8 * 00022802 * DC AL1(N1) INDICATE FUNCTION WANTED* 00023402 * DC AL3(N2) INFORMATION * 00024002 * IS GENERATED. CONTENTS OF THE TWO * 00024602 * DC INSTRUCTIONS IS * 00025202 * FUNCTION DC AL1 DC AL3 * 00025802 * ESD 4 1-4 STACKER DESIRED * 00026402 * RKB 8 N/A * 00027002 * HDR 12 INPUT AREA ADDRESS * 00027602 * MKL 16 N/A * 00028202 * INC 20 N/A * 00028802 * EJD 24 N/A * 00029402 * SSD 28 1-4 STACKER DESIRED * 00030002 * * 00030602 * L 15,84(1,0) POINT TO CNTRL * 00031202 * BALR 14,15 LINK TO CNTRL * 00031802 * * 00032402 *INPUT - IOB * 00033002 * IOBCSW - ADDRESS OF FAILING CCW IF IN SYNAD ROUTINE * 00033602 * DCB * 00034202 * DCBIOBA - ADDRESS OF THE IOB * 00034802 * DCBCIND2 - QSAM OR BSAM DETERMINATION * 00035402 * DCBSYNAD - ADDRESS OF THE SYNAD ROUTINE * 00036002 * * 00036602 *OUTPUT - COMPLETION CODE IN REGISTER 15 * 00037202 * UPDATED IOB ERROR COUNTERS * 00037802 * IF UNIT EXCEPTION OCCURS, EOF(X'40') IS POSTED IN DCBORBYT * 00038402 * IF ANY PERMANENT ERRORS OCCUR, THE EIB IS UPDATED * 00039002 * * 00039602 *EXTERNAL ROUTINES - IOS VIA EXCP * 00040202 * ERROR COUNTER UPDATE IN SYNCH ROUTINE * 00040802 * EIB UPDATE ROUTINE IN SYNCH ROUTINE * 00041402 * COMPLETION CODE ROUTINE IN SYNCH ROUTINE * 00042019 * USER SYNAD ROUTINE * 00042719 * * 00043419 *EXITS/NORMAL - RETURN TO CALLER - BR 14 * 00044119 * * 00044819 *EXITS/ERROR - ABEND, CODE 001 EOV 0(REG1) * 00045519 * * 00046219 *TABLES/WORK AREAS - USER SAVE AREA POINTED AT BY REGISTER 13 * 00046919 * * 00047619 *ATRIBUTES - REENTRANT,REUSABLE,PROBLEM PROGRAM MODE * 00048319 * * 00049019 *NOTES - N/A * 00049719 * * 00050419 *********************************************************************** 00051119 TITLE 'IGG019VH CNTRL MODULE FOR OCR' 00051819 *********************************************************************** 00052319 * * 00052819 * REGISTER EQUATES * 00053319 * * 00053819 *********************************************************************** 00054319 REG0 EQU 0 PARAMETER PASSER 00054819 REG1 EQU 1 GENERAL REGISTER 1 00055319 DCBR EQU 2 POINTER TO DCB 00055819 SREG1 EQU 2 POINTER TO FIRST SAVED USER REGISTER 00056319 IOBR EQU 3 POINTER TO IOB 00056819 REG3 EQU 3 GENERAL REGISTER 3 00057319 WORK1 EQU 4 WORK REGISTER 00057819 WORK2 EQU 5 WORK REGISTER 00058319 CCWREG EQU 6 ADDRESS OF CCW 00058819 PARM1 EQU 7 POINTS TO PASSED PARAMETER 00059402 REG8 EQU 8 USED AS LINK TO EIB 00060002 WORK3 EQU 8 WORK REGISTER 00060602 REG9 EQU 9 GENERAL REGISTER 9 00061202 BASER EQU 9 BASE REGISTER 00061802 SAVR EQU 13 POINTER TO SAVE AREA 00062402 BACK EQU 14 RETURN TO USER 00063002 RETCODE EQU 15 USED TO PASS RETURN CODE 00063602 *********************************************************************** 00064202 * * 00064802 * IOB EQUATES * 00065402 * * 00066002 *********************************************************************** 00066602 IOBSTUS EQU 4 DISPLACEMENT TO IOB STATUS 00067202 IOBFL1 EQU 8 DISPLACEMENT TO IOBFLAG1 00067802 ECBADR EQU 12 OFFSET OF ECB ADDRESS IN IOB 00068402 IOBCSW EQU 16 DISPLACEMENT TO CSW IN IOB 00069002 IOBSTADR EQU 25 DISPLACEMENT TO IOB START ADDRESS 00069602 OFFSET EQU 40 CCCW OFFSET IN IOB 00070202 OFFSET1 EQU 48 POINTER TO NORMAL IOB CCW 00070802 IOBCCOFF EQU X'BF' SET IOB COMMAND CHAINING BIT OFF 00071402 IOBCCON EQU X'40' SET IOB COMMAND CHAINING BIT ON 00072002 UETEST EQU X'01' TEST FOR UNIT EXCEPTION 00072602 PERR EQU X'41' CHECK FOR PERMANENT ERROR IN ECB 00073202 *********************************************************************** 00073802 * * 00074402 * CCW EQUATES * 00075002 * * 00075602 *********************************************************************** 00076202 CCWFLAG EQU 4 DISPLACEMENT TO FLAG IN CCW 00076802 CCWFLAGS EQU 4 DISPLACEMENT TO CCW FLAG BYTE 00077402 CCWCOUNT EQU 6 DISPLACEMENT TO COUNT FIELD IN CCW 00078002 CCWLENG EQU 8 LENGTH OF CCW TO MOVE 00078602 CCOFF EQU X'BF' TURN OFF COMMAND CHAINING BIT IN CCW 00079202 SLION EQU X'20' SET SLI FLAG IN CCW ON 00079802 RFOP EQU X'02' FR COMMAND CODE 00080402 MKLOP EQU X'0B' MKL COMMAND CODE 00081002 INCOP EQU X'4B' INC COMMAND CODE 00081602 EJDOP EQU X'43' EJD COMMAND CODE 00082202 TEST1OR3 EQU X'01' TEST FOR STACKER 1 OR 3 00082802 SETSTK34 EQU X'70' SET STACKER 3 OR 4 FOR ESD 00083402 TEST1OR2 EQU 3 TEST FOR STACKER 1 OR 2 00084002 SET1OR2 EQU X'20' SET FOR SSD STACKER 1 OR 2 00084602 SETSTK12 EQU X'60' SET FOR ESD STACKER 1 OR 2 00085202 SET3OR4 EQU X'30' SET SSD STACKER 3 OR 4 00085802 SET13 EQU X'03' SET STACKER 1 OR 3 00086402 SET24 EQU X'0B' SET STACKER 2 OR 4 00087002 *********************************************************************** 00087602 * * 00088202 * DCB EQUATES * 00088802 * * 00089402 *********************************************************************** 00090002 ERROFF EQU X'3F' CLEAR DCB ERROR FLAGS 00090602 SYNOFF EQU X'7F' SET SYNAD IN CONTROL OFF 00091202 SYNADPRS EQU X'01' TEST FOR SYNAD PRESENT 00091802 HE EQU X'02' TEST FOR HOPPER EMPTY 00092402 EXITSPEC EQU X'10' TEST FOR HOPPER EMPTY SPECIFIED 00093002 QSAMTEST EQU X'01' TEST FOR QSAM 00093602 SYNTEST EQU X'80' TEST FOR IN SYNAD 00094202 EOF EQU X'40' POST EOF 00094802 *********************************************************************** 00095402 * * 00096002 * DECB EQUATES * 00096602 * * 00097202 *********************************************************************** 00097802 DECBADDR EQU 48 DISPLACEMENT TO DECB BUILD AREA 00098402 DECBLT EQU 52 DISPLACEMENT TO DECB LENGTH & TYPE 00099002 DECBDCB EQU 56 DISPLACEMENT TO DECB DCB ADDRESS 00099602 DECBCCW EQU 60 DISPLACEMENT TO DECB CCW ADDRESS 00100202 DECBIOB EQU 64 DISPLACEMENT TO DECB IOB ADDRESS 00100802 LNGTYP EQU X'80' DECB LENGTH AND TYPE 00101402 *********************************************************************** 00102002 * * 00102602 * SAVE AREA EQUATES * 00103202 * * 00103802 *********************************************************************** 00104402 USERSAVE EQU 12 DISPLACEMENT TO REGISTER SAVE AREA 00105002 SAVE39 EQU 16 DISPLACEMENT TO SAVE AREA 00105602 RETSAVE EQU 44 RETURN ADDRESS SAVE AREA POINTER 00106202 XDECB EQU 48 ECB OFFSET IN SAVE AREA DECB 00106802 SAVE9 EQU 68 REGISTER 9 SAVE AREA DISPLACEMENT 00107402 *********************************************************************** 00108002 * * 00108602 * MISCELLANEOUS EQUATES * 00109202 * * 00109802 *********************************************************************** 00110402 MKLCNT EQU 24 DISPLACEMENT TO MKL ERROR BUCKET 00111002 PARMDISP EQU 3 DISPLACEMENT TO STACKER PARAMETER 00111602 INITCONT EQU 1 INITIALIZE CCW COUNT 00112202 BUFLENG EQU X'1E' ASSUMED BUFFER LENGTH 00112802 MOVEBYTE EQU 1 LENGTH TO MOVE ONE BYTE OF DATA 00113402 HDRTEST EQU X'0C' TEST FOR HDR 00114002 LENGTH4 EQU 4 MOVE FOUR BYTES 00114602 ZERO EQU X'00' SET A BYTE TO ZERO 00115202 CNTRLERR EQU X'20' CONTROL ERROR BIT 00115802 SHIFTHI EQU 24 SHIFT COUNT FOR HIGH ORDER BYTE SHIFT 00116402 RKBTEST EQU X'08' TEST FOR RKB 00117002 RETCDRTN EQU 16 DISPLACEMENT TO RETURN CODE ROUTINE 00117602 EIBRTN EQU 8 DISPLACEMENT TO EIB ROUTINE ADDRESS 00118202 CNTRUPRT EQU 24 DISPLACEMENT TO ADDR OF CNTR UPDATE 00118802 ACTIOB EQU 8 POINTER TO ACTUAL IOB 00119402 CLEARLEN EQU 8 LENGTH OF CCW AREA TO CLEAR 00120002 ONE EQU 1 ABEND COMPLETION CODE 00120602 TWELVE EQU 12 SHIFT COUNT TO SET ABEND COMP CODE 00121202 USING IGG019VH,RETCODE ESTABLISH BASE REGISTER 00121819 USING IHADCB,DCBR ESTABLISH DCB ADDRESSIBILITY 00122519 STM SREG1,REG9,USERSAVE(SAVR) SAVE USER REGISTERS 00123219 ST BACK,RETSAVE(SAVR) SAVE RETURN ADDRESSS 00123919 LR BASER,RETCODE GET BASE REGISTER SET UP 00124619 DROP RETCODE DROP BASE REGISTER 00125319 USING IGG019VH,BASER ESTABLISH ADDRESSIBILITY 00126019 LR DCBR,REG1 GET DCB ADDRESS 00126719 L IOBR,DCBIOBA GET IOB ADDRESS 00127419 LR PARM1,REG0 GET DESIRED OPERATION 00128119 NI IOBFL1(IOBR),IOBCCOFF SET COMMAND CHAINING BIT OFF 00128819 XC OFFSET(CLEARLEN,IOBR),OFFSET(IOBR) CLEAR CCW AREA 00129519 MVI CCWCOUNT+OFFSET+1(IOBR),INITCONT SET COUNT TO 1 00130219 DETOP SR WORK1,WORK1 CLEAR WORK REGISTER 00130919 IC WORK1,0(PARM1) GET BRANCH TABLE OFFSET 00131619 B BRTAB(WORK1) GO TO DESIRED ROUTINE 00132319 *********************************************************************** 00132419 * BRANCH TABLE FOR OPERATUN DETERMINATION * 00132519 *********************************************************************** 00132619 BRTAB EQU *-4 ESTABLISH BRANCH TABLE ADDRESSABILITY 00133019 B ESD ESD DESIRED 00133719 B RKB RKB DESIRED 00134419 B SETHDR GO SET UP HDR CCW 00135119 B MKL MKL DESIRED 00135819 B INC INC DESIRED 00136519 B EJD EJD DESIRED 00137219 B SSD SSD DESIRED 00137919 * SET FOR ESD 00138219 ESD CLI PARMDISP(PARM1),TEST1OR2 IS STACKER 1 OR 2 WANTED 00138619 BL SET1 NO MUST BE 3 OR 4 00139319 OI OFFSET(IOBR),SETSTK34 SET FOR STACKER 3 OR 4 00140019 SET1 OI OFFSET(IOBR),SETSTK12 SET FOR STACKER 1 OR 2 00140719 SETFINAL TM PARMDISP(PARM1),TEST1OR3 IS OT STACKER 1 OR 3 00141419 BO SET2 YES SET A 3 00142119 OI OFFSET(IOBR),SET24 SET STACKER 2 OR 4 00142819 SET2 OI OFFSET(IOBR),SET13 SET STACKER 1 OR 3 00143519 B ISSUE GO ISSUE COMMAND 00144219 * SET FOR SSD 00144519 SSD OI CCWFLAG+OFFSET(IOBR),SLION SET SLI FLAG ON 00144919 CLI PARMDISP(PARM1),TEST1OR2 IS IT STACKER 1 OR 2 00145619 BL SET3 YES SET FOR 1 OR 2 00146319 OI OFFSET(IOBR),SET3OR4 SET FOR STACKER 3 OR 4 00147019 SET3 OI OFFSET(IOBR),SET1OR2 SET FOR STACKER 1 OR 2 00147719 B SETFINAL GO SET UP 2ND 4 BITS OF COMMAND CODE 00148419 * SET FOR MKL 00148719 MKL MVI OFFSET(IOBR),MKLOP SET MKL OP CODE 00149119 B ISSUE GO ISSUE COMMAND 00149819 * SET FOR INC 00150119 INC MVI OFFSET(IOBR),INCOP SET INC OP CODE 00150519 B ISSUE GO ISSUE COMMAND 00151219 * SET FOR EJD 00151519 EJD MVI OFFSET(IOBR),EJDOP SET EJD OP CODE 00151919 B ISSUE GO ISSUE COMMAND 00152619 * START SETTING FOR RKB 00152919 RKB L CCWREG,IOBCSW(IOBR) GET CCW ADDRESS 00153319 B SETRF GO READ 00154019 *********************************************************************** 00154119 * SET TO ISSUE MKL,EJD,ESD,SSD, OR INC COMMAND * 00154219 *********************************************************************** 00154319 ISSUE EQU * PREPARE TO ISSUE COMMAND 00154719 NI DCBIFLGS,ERROFF CLEAR ERROR FLAGS 00155419 L REG8,IOBCSW(IOBR) SAVE ADDRESS OF FAILINC CCW 00156119 MVI DCBOFFSR,OFFSET POINT TO CNTRL CCW IN IOB 00156819 LA WORK1,OFFSET(IOBR) GET CCW ADDRESS 00157519 L WORK2,IOBSTADR-1(IOBR) SAVE START ADDRESS 00158219 ST WORK1,IOBSTADR-1(IOBR) SET START ADDRESS 00158919 *********************************************************************** 00159019 * EXCP AND WAIT 00159119 *********************************************************************** 00159219 EXCP ACTIOB(IOBR) EXECUTE CHALLEL PROGRAM 00159619 L REG1,ECBADR(IOBR) LOAD ECB ADDRESS 00160319 WAIT ECB=(REG1) WAIT FOR EVENT TO COMPLETE 00161019 OI IOBFL1(IOBR),IOBCCON SET COMMAND CHAINING BIT ON 00161719 MVI DCBOFFSR,OFFSET1 RESTORE CCW OFFSCT IN DCB 00162419 ST REG8,IOBCSW(IOBR) RESTORE POINTER TO FAILING CCW 00163119 ST WORK2,IOBSTADR-1(IOBR) RESTORE START ADDRESS 00163819 *********************************************************************** 00163919 * LINK TP COUNTER UPDATE ROUTINE IN SYNCH OR CHECK MODULE * 00164019 *********************************************************************** 00164119 COUNTERS L RETCODE,DCBGERR GET ADDR OF CNTR UPDATE RTN - 24 00164519 BAL BACK,CNTRUPRT(RETCODE) LINK TL COUNTER UPDATE ROUTINE 00165219 LTR REG1,REG1 COUNTERS SPECIFIED 00165919 BZ NOCOUNT NO CONTINUE 00166619 CLI OFFSET(IOBR),MKLOP IS IT MKL 00167319 BNE NOCOUNT NO BYPASS MKL COUNTER UPDATE 00168019 L WORK2,MKLCNT(REG1) GET MKL ERROR BUCKET 00168719 LA WORK2,1(WORK2) BUMP ERROR COUNTER 00169419 ST WORK2,MKLCNT(REG1) UPDATE ERROR BUCKET 00170119 * 00170819 NOCOUNT SR RETCODE,RETCODE SET RETURN CODE TO ZEROS 00171519 L REG1,ECBADR(IOBR) LOAD ECB ADDRESS 00173619 CLI 0(REG1),PERR DID ANY PERMANENT ERRORS OCCUR 00174319 BNE NOERROR NO RETURN TO USER 00175019 *********************************************************************** 00175119 * LINJ TO SET EIB ROUTINE IN SYNCH OR CHECK MODULE * 00175219 *********************************************************************** 00175319 ERROR EQU * ERROR PROCESSING ROUTINE 00175719 L RETCODE,DCBGERR GET ADDRESS OF EIB ROUTINE-8 00176419 BAL BACK,EIBRTN(RETCODE) LINK TO EIB ROUTINE 00176619 *********************************************************************** 00176819 * LINK TO COMPLETION CODE ROUTINE IN SYNCH OR CHECK MODULE * 00177019 *********************************************************************** 00177219 L RETCODE,DCBGERR GET ADDRESS OF RETURN CODE ROUTINE-16 00177419 BAL BACK,RETCDRTN(RETCODE) LINK TO RETURN CODE ROUTINE 00177619 *001918 00177819 *********************************************************************** 00178019 * LINK TO USER SYNAD ROUTINE * 00178219 *********************************************************************** 00178419 TM IOBCSW+IOBSTUS(IOBR),UETEST DID UNIT EXCAPTION OCCUR 00179219 BZ NOTDONE NO CONTINUE 00179919 OI DCBORBYT,EOF POST EOF IN DCBORBYT 00180619 DONE EQU * RETURN TO USER 00181319 NI DCBIFLGS,ERROFF SET DCB ERROR FLAGS OFF 00182019 NOERROR LM SREG1,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 00182719 L BACK,RETSAVE(SAVR) RESTORE RETURN ADDRESS 00183419 BR BACK RETURN TO USER 00184119 NOTDONE CLI OFFSET(IOBR),MKLOP IS IT MKL 00184819 BE DONE YES QUIT 00185519 CLI 0(PARM1),RKBTEST IS IT RKB 00186219 BE DONE YES QUIT 00186919 TM DCBORBYT,SYNTEST IN SYNAD ROUTINE 00187619 BO DONE YES QUIT 00188319 TM DCBCIND2,QSAMTEST IS IT QSAM 00189019 BZ BSAMROUT NO BSAM 00189719 LA REG0,OFFSET GET CCW OFFSET 00190419 SLL REG0,SHIFTHI SHIFT TO HIGH ORDER BYTE 00191119 OR REG0,IOBR POT IOB ADDRESS IN REG 0 00191819 TRY EQU * LINK TO SYNAD ROUTINE IF PRESENT 00192519 LA REG1,CNTRLERR SET CONTROL ERROR BIT 00193219 SLL REG1,SHIFTHI SHIFT TO HIGH ORDER BYTE 00193919 OR REG1,DCBR GET DCB ADDRESS 00194619 NI DCBIFLGS,ERROFF TURN OFF ERROR FLAGS 00195319 OI DCBORBYT,SYNTEST TURN ON SYNAD BIT IN DCB 00196019 L RETCODE,DCBSYNAD GET ADDRESS OF SYNAD ROUTINE 00196719 ST REG9,SAVE9(SAVR) SAVE REGISTER 9 00197419 LM SREG1,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 00198119 ST REG1,USERSAVE(SAVR) SAVE DCB ADDRESS 00198819 BALR BACK,RETCODE LINK TO SYNAD ROUTINE 00199519 STM REG3,REG9,SAVE39(SAVR) SAVE USER REGISTERS 00200219 L REG9,SAVE9(SAVR) RESTORE REGISTER 9 00200919 L REG3,USERSAVE(SAVR) GET DCB ADDRESS 00201619 ST SREG1,USERSAVE(SAVR) SAVE USER REGISTER 2 00202319 LR DCBR,REG3 RESTORE DCB REGISTER 00203019 NI DCBIFLGS,ERROFF SET DCB ERROR FLAGS OFF 00203719 NI DCBORBYT,SYNOFF SET SYNAD IN CONTROL BIT OFF 00204419 LTR RETCODE,RETCODE USER EXIT ADDRESS SPECIFIED 00205119 BZ DONE NO RETURN TO USER 00205819 NI DCBORBYT,ZERO CLEAR DCBORBYT 00206519 TM DCBCIND2,QSAMTEST IS IT QSAM 00207219 BZ LOAD NO 00207919 MVC DCBRECAD(LENGTH4),DCBEOBAD SET EOB CONDITION 00208619 LOAD LM SREG1,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 00209319 BR RETCODE EXIT TO USER ROUTINE 00210019 BSAMROUT TM DCBSYNAD+3,SYNADPRS IS A SYNAD ROUTINE PRESENT 00210719 BZ SYNPRES YES PROCESS FOR SYNAD 00211419 *********************************************************************** 00211519 * ABEND * 00211619 *********************************************************************** 00211719 LA REG0,ONE SET COMPLETION CODE TO 1 00212019 SLL REG0,TWELVE ADJUST FOR EOV 00212319 LR REG1,DCBR PUT DCB ADDRESS IN REG 1 00212819 EOV (REG1) ABORT 00213519 SYNPRES TM DCBEIB,HE HOPPER EMPTY PRESENT 00214219 BZ HPRFULL NO 00214919 TM DCBOPTCD,EXITSPEC HOPPER EMPTY EXIT SPECIFIED 00215619 BZ DONE NO RETURN TO USER 00216319 HPRFULL L WORK1,ECBADR(IOBR) LOAD ECB ADDRESS 00217019 MVC XDECB(LENGTH4,SAVR),0(WORK1) MOVE ECB TO DECB 00217719 LA WORK2,LNGTYP GET LENGTH AND TYPE 00218419 ST WORK2,DECBLT(SAVR) PUT IN DECB 00219119 LA WORK2,OFFSET(IOBR) GET CCW ADDRESS 00219819 ST WORK2,DECBCCW(SAVR) PUT IN DECB 00220519 LA WORK1,ACTIOB(IOBR) GET IOB ADDRESS 00221219 ST WORK1,DECBIOB(SAVR) PUT IN DECB 00221919 ST DCBR,DECBDCB(SAVR) PUT DCB ADDRESS IN DECB 00222619 LA REG0,DECBADDR(SAVR) PUT DECB ADDRESS IN REGISTER 0 00223319 B TRY CONTINUE 00224019 * SET FOR RKB 00224319 SETRF LA CCWREG,0(CCWREG) CLEAR HIGH ORDER BYTE 00224719 SH CCWREG,EIGHT DECREMENT BY EIGHT 00225419 MVC OFFSET(CCWLENG,IOBR),0(CCWREG) MOVE CCW TO IOB + 40 00226119 * THIS CODE SETS UP TO ISSUE HDR OR RKB COMMAND 00226419 NOBUF LA CCWREG,OFFSET(IOBR) LOAD ADDRESS OF CHANNEL PROG START 00226819 NI CCWFLAGS(CCWREG),CCOFF TURN OFF COMMAND CHAINING BIT 00227519 NI DCBIFLGS,ERROFF TURN OFF DCB ERROR FLAGS 00228219 L WORK1,0(CCWREG) GET DATA ADDRESS 00228919 LA WORK1,0(WORK1) CLEAR HIGH ORDER BYTE 00229619 LH WORK2,CCWCOUNT(CCWREG) GET BYTE COUNT 00230319 BCTR WORK2,0 SUBTRACT 1 00231019 CLI 0(PARM1),HDRTEST IS IT HDR 00231719 BE NOCLEAR YES DO NOT CLEAR INPUT AREA 00232419 SR WORK1,WORK2 GET START OF I/O AREA 00233119 ST WORK1,OFFSET(IOBR) SET CORRECT DATA ADDRESS IN CCW 00233819 CLEAR EX WORK2,CLEAREX 00234519 NOCLEAR EQU * PREPARE TO ISSUE COMMAND 00235219 MVI 0(CCWREG),RFOP SET RF OP CODE 00235919 L REG8,IOBCSW(IOBR) SAVE ADDRESS OF FAILINC CCW 00236619 MVI DCBOFFSR,OFFSET POINT TO CNTRL CCW IN IOB 00237319 L WORK1,IOBSTADR-1(IOBR) SAVE START ADDRESS 00238019 ST CCWREG,IOBSTADR-1(IOBR) SET START ADDRESS 00238719 *********************************************************************** 00238819 * EXCP AND WAIT * 00238919 *********************************************************************** 00239019 EXCP ACTIOB(IOBR) EXECUTE CHANNEL PROGRAM 00239419 L REG1,ECBADR(IOBR) LOAD ECB ADDRESS 00240119 WAIT ECB=(REG1) WAIT FOR EVENT TO COMPLETE 00240819 MVI DCBOFFSR,OFFSET1 RESTORE CCW OFFSCT IN DCB 00241519 OI IOBFL1(IOBR),IOBCCON SET COMMAND CHAINING BIT ON IN IOB 00242219 ST REG8,IOBCSW(IOBR) RESTORE POINTER TO FAILING CCW 00242919 ST WORK1,IOBSTADR-1(IOBR) RESTORE START ADDRESS 00243619 CLI 0(PARM1),RKBTEST IS IT RKB 00244319 BNE COUNTERS NO QUIT 00245019 *********************************************************************** 00245119 * ROUTINE TO RIGHT ADJUST DATA FOR RKB * 00245219 *********************************************************************** 00245319 SR WORK1,WORK1 CLEAR WORK 00245719 LH WORK1,CCWCOUNT(CCWREG) GET BYTE COUNT 00246419 L WORK3,0(CCWREG) GET BUFFER ADDRESS 00247119 LA WORK3,0(WORK3) CLEAR HIGH ORDER BYTE 00247819 AR WORK3,WORK2 POINT TO END OF BUFFER 00248519 LR CCWREG,WORK3 SAVE BUFFER ADDRESS 00249219 SR WORK2,WORK2 REGISTERS 00249919 TEST CLI 0(WORK3),ZERO IS BYTE 00 00250619 BNE MOVEDATA NO ADJUST DATA 00251319 BCT WORK1,TRYAGAIN IF MORE DATA TRY AGAIN 00252019 B COUNTERS QUIT 00252719 TRYAGAIN BCTR WORK3,0 DECREMENT BUFFER ADDRESS 00253419 LA WORK2,1(WORK2) INCREMENT ZERO BYTE COUNTER 00254119 B TEST TRY ANOTHER BYTE 00254819 MOVEDATA EQU * MOVE ROUTINE TO RIGHT ADJUST DATA 00255519 MOVE MVC 0(MOVEBYTE,CCWREG),0(WORK3) MOVE A BYTE 00256219 BCTR CCWREG,0 DECREMENT END OF BUFFER POINTER 00256919 BCTR WORK3,0 DECREMENT END OF DATA POINTER 00257619 BCT WORK1,MOVE IF MORE DATA,MOVE IT 00258319 LTR WORK2,WORK2 ANY ZERO BYTES 00259019 BZ COUNTERS NO ALL DONE 00259719 LA WORK3,1(WORK3) POINT TO START OF BUFFER 00260419 BCTR WORK2,0 SUBTRACT 2 FROM COUNT 00261119 EX WORK2,CLEAREX1 CLEAR INPUT AREA 00261819 B COUNTERS QUIT 00262519 * SET FOR HDR 00262819 SETHDR L WORK1,0(PARM1) GET INPUT ADDRESS 00263219 ST WORK1,OFFSET(IOBR) PUT IN CCW 00263919 MVI OFFSET+CCWFLAGS(IOBR),SLION SET SLI FLAG ON 00264619 MVI OFFSET+CCWCOUNT+1(IOBR),BUFLENG SET TO ASSUMED LENGTH 00265319 LH WORK1,DCBBUFL GET BUFFER LENGTH 00266019 LTR WORK1,WORK1 LENGTH SPECIFIED 00266719 BZ NOBUF NO USE ASSUMED VALUE 00267419 STH WORK1,OFFSET+CCWCOUNT(IOBR) SET COUNT 00268119 B NOBUF GO READ HEADER 00268819 CLEAREX XC 0(1,WORK1),0(WORK1) EXECUTED INSTRUCTION TO CLEAR AEEA 00269519 CLEAREX1 XC 0(1,WORK3),0(WORK3) EXECUTED INSTRUCTION TO CLEAR AEEA 00270219 EIGHT DC H'08' CONSTANT OF 8 00270919 IHADCB DCBD DSORG=PS DCB DSECT 00271619 END IGG019VH 00272319 TITLE 'IGG019VH CNTRL MODULE FOR OCR' 00300019 OFFSET EQU 40 CCCW OFFSET IN IOB 00600019 OFFSET1 EQU 48 POINTER TO NORMAL IOB CCW 00900019 RETCODE EQU 15 USED TO PASS RETURN CODE 01200019 REG1 EQU 1 GENERAL REGISTER 1 01500019 REG9 EQU 9 GENERAL REGISTER 9 01800019 BASER EQU 9 BASE REGISTER 02100019 DCBR EQU 2 POINTER TO DCB 02400019 IOBR EQU 3 POINTER TO IOB 02700019 IOBFL1 EQU 8 DISPLACEMENT TO IOBFLAG1 03000019 IOBECBCC EQU 4 DISPLACEMENT TO ECB CONDITION CODE 03300019 WORK1 EQU 4 WORK REGISTER 03600019 PARM1 EQU 7 POINTS TO PASSED PARAMETER 03900019 REG0 EQU 0 PARAMETER PASSER 04200019 MKLCNT EQU 24 DISPLACEMENT TO MKL ERROR BUCKET 04500019 SREG1 EQU 2 POINTER TO FIRST SAVED USER REGISTER 04800019 IOBSNS EQU 11 POINTER TO IOB SENSE BYTE 05100019 MKLOP EQU X'0B' MKL COMMAND CODE 05400019 INCOP EQU X'4B' INC COMMAND CODE 05700019 EJDOP EQU X'43' EJD COMMAND CODE 06000019 SET1OR2 EQU X'20' SET FOR SSD STACKER 1 OR 2 06300019 SETSTK12 EQU X'60' SET FOR ESD STACKER 1 OR 2 06600019 SET3OR4 EQU X'30' SET SSD STACKER 3 OR 4 06900019 SLION EQU X'20' SET SLI FLAG IN CCW ON 07200019 CCWFLAG EQU 4 DISPLACEMENT TO FLAG IN CCW 07500019 SET13 EQU X'03' SET STACKER 1 OR 3 07800019 SET24 EQU X'0B' SET STACKER 2 OR 4 08100019 TEST1OR3 EQU X'01' TEST FOR STACKER 1 OR 3 08400019 SETSTK34 EQU X'70' SET STACKER 3 OR 4 FOR ESD 08700019 TEST1OR2 EQU 3 TEST FOR STACKER 1 OR 2 09000019 PARMDISP EQU 3 DISPLACEMENT TO STACKER PARAMETER 09300019 INITCONT EQU 1 INITIALIZE CCW COUNT 09600019 CCWCOUNT EQU 6 DISPLACEMENT TO COUNT FIELD IN CCW 09900019 STACK1 EQU X'63' STACKER 1 ESD 10200019 STACK2 EQU X'6B' STACKER 2 ESD 10500019 STACK3 EQU X'73' STACKER 3 ESD 10800019 STCK1 EQU X'23' STACKER 1 SSD 11100019 STCK2 EQU X'2B' STACKER 2 SSD 11400019 STCK3 EQU X'33' STACKER 3 SSD 11700019 IOBCSW EQU 16 DISPLACEMENT TO CSW IN IOB 12000019 LNGTYP EQU X'80' DECB LENGTH AND TYPE 12300019 CCWREG EQU 6 ADDRESS OF CCW 12600019 WORK2 EQU 5 WORK REGISTER 12900019 INCAM EQU 36 DISPLACEMENT TO IOB DATA CHECK COUNT 13200019 DATCK EQU 20 DISPACEMENT TO UCB DATA CHECK COUNT 13500019 ILCNT EQU 8 DISPLACEMENT TO UCB IL COUNT 13800019 EQCNT EQU 0 DISPLACEMENT TO UCB EQUIPMENT CHK CNT 14100019 ECBCODE EQU 4 DISPLACEMENT TO ECB CODE IN IOB 14400019 IOBSTADR EQU 25 DISPLACEMENT TO IOB START ADDRESS 14700019 REG8 EQU 8 USED AS LINK TO EIB 15000019 RET1 EQU 7 RETURN ADDRESS REGISTER 15300019 BACK EQU 14 RETURN TO USER 15600019 SAVR EQU 13 POINTER TO SAVE AREA 15900019 SAV12 EQU 12 USER SAVE REGISTER 16200019 WORK3 EQU 8 WORK REGISTER 16500019 RE2 EQU 2 USER SAVE REGISTER 16800019 IGG019VH CSECT ENTRY POINT FOR CONTROL MODULE 17100019 USING IGG019VH,RETCODE ESTABLISH BASE REGISTER 17400019 USING IHADCB,DCBR ESTABLISH DCB ADDRESSIBILITY 17700019 STM SREG1,REG9,12(SAVR) SAVE USER REGISTERS 18000019 ST BACK,44(SAVR) SAVE RETURN ADDRESS 18300019 LR BASER,RETCODE GET BASE REGISTER SET UP 18600019 DROP RETCODE DROP BASE REGISTER 18900019 USING IGG019VH,BASER ESTABLISH ADDRESSIBILITY 19200019 LR DCBR,REG1 GET DCB ADDRESS 19500019 L IOBR,DCBIOBA GET IOB ADDRESS 19800019 LR PARM1,REG0 GET DESIRED OPERATION 20100019 NI IOBFL1(IOBR),X'BF' SET COMMAND CHAINING BIT OFF 20400019 XC OFFSET(8,IOBR),OFFSET(IOBR) CLEAR CCW AREA 20700019 MVI CCWCOUNT+OFFSET+1(IOBR),INITCONT SET COUNT TO 1 21000019 DETOP SR WORK1,WORK1 CLEAR WORK REGISTER 21300019 IC WORK1,0(PARM1) GET BRANCH TABLE OFFSET 21600019 B BRTAB(WORK1) GO TO DESIRED ROUTINE 21900019 BRTAB EQU *-4 22200019 B ESD ESD DESIRED 22500019 B RKB RKB DESIRED 22800019 B SETHDR GO SET UP HDR CCW 23100019 B MKL MKL DESIRED 23400019 B INC INC DESIRED 23700019 B EJD EJD DESIRED 24000019 B SSD SSD DESIRED 24300019 ESD CLI PARMDISP(PARM1),TEST1OR2 IS STACKER 1 OR 2 WANTED 24600019 BL SET1 NO MUST BE 3 OR 4 24900019 OI OFFSET(IOBR),SETSTK34 SET FOR STACKER 3 OR 4 25200019 SET1 OI OFFSET(IOBR),SETSTK12 SET FOR STACKER 1 OR 2 25500019 SETFINAL TM PARMDISP(PARM1),TEST1OR3 IS OT STACKER 1 OR 3 25800019 BO SET2 YES SET A 3 26100019 OI OFFSET(IOBR),SET24 SET STACKER 2 OR 4 26400019 SET2 OI OFFSET(IOBR),SET13 SET STACKER 1 OR 3 26700019 B ISSUE GO ISSUE COMMAND 27000019 SSD OI CCWFLAG+OFFSET(IOBR),SLION SET SLI FLAG ON 27300019 CLI PARMDISP(PARM1),TEST1OR2 IS IT STACKER 1 OR 2 27600019 BL SET3 YES SET FOR 1 OR 2 27900019 OI OFFSET(IOBR),SET3OR4 SET FOR STACKER 3 OR 4 28200019 SET3 OI OFFSET(IOBR),SET1OR2 SET FOR STACKER 1 OR 2 28500019 B SETFINAL GO SET UP 2ND 4 BITS OF COMMAND CODE 28800019 MKL MVI OFFSET(IOBR),MKLOP SET MKL OP CODE 29100019 B ISSUE GO ISSUE COMMAND 29400019 INC MVI OFFSET(IOBR),INCOP SET INC OP CODE 29700019 B ISSUE GO ISSUE COMMAND 30000019 EJD MVI OFFSET(IOBR),EJDOP SET EJD OP CODE 30300019 B ISSUE GO ISSUE COMMAND 30600019 RKB L CCWREG,IOBCSW(IOBR) GET CCW ADDRESS 30900019 B SETRF GO READ 31200019 ISSUE EQU * 31500019 NI DCBIFLGS,X'3F' CLEAR E-ROR FLAGS 31800019 L REG8,IOBCSW(IOBR) SAVE ADDRESS OF FAILINC CCW 32100019 MVI DCBOFFSR,OFFSET POINT TO CNTRL CCW IN IOB 32400019 LA WORK1,OFFSET(IOBR) GET CCW ADDRESS 32700019 L WORK2,IOBSTADR-1(IOBR) SAVE START ADDRESS 33000019 ST WORK1,IOBSTADR-1(IOBR) SET START ADDRESS 33300019 EXCP 8(IOBR) 33600019 WAIT ECB=4(IOBR) WAIT FOR COMPLETION 33900019 OI IOBFL1(IOBR),X'40' SET COMMAND CHAINING BIT ON 34200019 MVI DCBOFFSR,OFFSET1 RESTORE CCW OFFSCT IN DCB 34500019 ST REG8,IOBCSW(IOBR) RESTORE POINTER TO FAILING CCW 34800019 ST WORK2,IOBSTADR-1(IOBR) RESTORE START ADDRESS 35100019 COUNTERS L RETCODE,DCBGERR GET ADDR OF CNTR UPDATE RTN - 24 35400019 BAL BACK,24(RETCODE) LINK TO CNTR UPDATE ROUTINE 35700019 LTR REG1,REG1 COUNTERS SPECIFIED 36000019 BZ NOCOUNT NO CONTINUE 36300019 CLI 40(IOBR),X'0B' IS IT MKL 36600019 BNE NOCOUNT 36900019 L WORK2,MKLCNT(REG1) GET MKL ERROR BUCKET 37200019 LA WORK2,1(WORK2) BUMP ERROR COUNTER 37500019 ST WORK2,MKLCNT(REG1) UPDATE ERROR BUCKET 37800019 * 38100019 NOCOUNT SR RETCODE,RETCODE SET RETURN CODE TO ZEROS 38400019 TM IOBSNS(IOBR),X'10' IS IT KEYBOARD CORRECTION 38700019 BO ERROR YES PROCESS IT 39000019 CLI ECBCODE(IOBR),X'41' DID ANY PERMANENT ERRORS OCCUR 39300019 BNE NOERROR NO RETURN TO USER 39600019 ERROR EQU * 39900019 L RETCODE,DCBGERR GET ADDRESS OF EIB ROUTINE-8 40200019 BAL BACK,8(RETCODE) LINK TO EIB ROUTINR 40500019 L RETCODE,DCBGERR GET ADDRESS OF RETURN CODE ROUTINE-16 40800019 BAL BACK,16(RETCODE) LINK TO RETURN CODE ROUTINE 41100019 TM IOBCSW+4(IOBR),X'01' DID UNIT EXCEPTION OCCUR 41400019 BZ NOTDONE NO CONTINUE 41700019 OI DCBORBYT,X'40' POST EOF IN DCB 42000019 DONE EQU * 42300019 NI DCBIFLGS,X'3F' SET DCB ERROR FLAGS OFF 42600019 NOERROR LM SREG1,REG9,12(SAVR) RESTORE USER REGISTERS 42900019 L BACK,44(SAVR) RESTORE RETURN ADDRESS 43200019 BR BACK RETURN TO USER 43500019 NOTDONE CLI 40(IOBR),X'0B' IS IT MKL 43800019 BE DONE YES QUIT 44100019 CLI 0(PARM1),X'08' IS IT RKB 44400019 BE DONE YES QUIT 44700019 TM DCBORBYT,X'80' IN SYNAD ROUTINE 45000019 BO DONE YES QUIT 45300019 TM DCBCIND2,X'01' IS IT QSAM 45600019 BZ BSAMROUT NO BSAM 45900019 LA REG0,OFFSET GET CCW OFFSET 46200019 SLL REG0,24 SHOFT TO HIGH ORDER BYTE 46500019 OR REG0,IOBR POT IOB ADDRESS IN REG 0 46800019 TRY EQU * 47100019 LA REG1,X'20' SET CONTROL ERROR BI7 47400019 SLL REG1,24 SHIFT TO HIGH ORDER BYTE 47700019 OR REG1,DCBR GET DCB ADDRESS 48000019 NI DCBIFLGS,X'3F' 1 TURN OFF ERROR FLAGS 48300019 OI DCBORBYT,X'80' TURN ON SYNAD BIT IN DCB 48600019 L RETCODE,DCBSYNAD GET ADDRESS OF SYNAD ROUTINE 48900019 ST DCBR,68(SAVR) SAVE DCB POINTER 49200019 LM SREG1,REG9,12(SAVR) RESTORE USER REGISTERS 49500019 BALR BACK,RETCODE LINK TO SYNAD ROUTINE 49800019 STM SREG1,REG9,12(SAVR) SAVE USER REGISTERS 50100019 L DCBR,68(SAVR) RESTORE DCB POINTER 50400019 NI DCBIFLGS,X'3F' SET DCB ERROR FLAGS OFF 50700019 NI DCBORBYT,X'7F' SET SYNAD IN CONTROL BIT OFF 51000019 LTR RETCODE,RETCODE USER EXIT ADDRESS SPECIFIED 51300019 BZ DONE NO RETURN TO USER 51600019 NI DCBORBYT,X'00' RESET DCBORBYT 51900019 TM DCBCIND2,X'01' IS IT QSAM 52200019 BZ LOAD NO 52500019 MVC DCBRECAD(4),DCBEOBAD SET EOB CONDITION 52800019 LOAD LM SREG1,REG9,12(SAVR) RESTORE USER REGISTERS 53100019 BR RETCODE EXIT TO USER ROUTINE 53400019 BSAMROUT TM DCBSYNAD+3,X'01' IS A SYNAD ROUTINE PRESENT 53700019 BZ SYNPRES YES PROCESS FOR SYNAD 54000019 LR REG0,IOBR PUT IOB ADDRESS IN REG 0 54300019 LR REG1,DCBR PUT DCB ADDRESS IN REG 1 54600019 EOV (REG1) ABORT 54900019 SYNPRES TM DCBEIB,X'02' HOPPER EMPTY PRESENT 55200019 BZ HPRFULL NO 55500019 TM DCBOPTCD,X'10' HOPPER EMPTY EXIT SPECIFIED 55800019 BZ DONE NO RETURN TO USER 56100019 HPRFULL L WORK1,ECBCODE(IOBR) GET ECB ADDRESS 56400019 LA WORK1,0(WORK1) CLEAR HIGH ORDER BYTE 56700019 L WORK2,0(WORK1) GET ECB 57000019 ST WORK2,48(SAVR) PUT IN DECB 57300019 LA WORK2,LNGTYP GET LENGTH AND TYPE 57600019 ST WORK2,52(SAVR) PUT IN DECB 57900019 LA WORK2,40(IOBR) GET CCW ADDRESS 58200019 ST WORK2,60(SAVR) PUT IN DECB 58500019 LA WORK1,8(IOBR) GET IOB ADDRESS 58800019 ST WORK1,64(SAVR) PUT IN DECB 59100019 ST DCBR,56(SAVR) PUT IN DECB 59400019 LA REG0,48(SAVR) PUT DECB ADDRESS IN REG 0 59700019 B TRY CONTINUE 60000019 SETRF LA CCWREG,0(CCWREG) CLEAR HIGH ORDER BYTE 60300019 SH CCWREG,EIGHT DECREMENT BY EIGHT 60600019 MVC OFFSET(8,IOBR),0(CCWREG) MOVE CCW TO IOB+40 60900019 NOBUF LA CCWREG,OFFSET(IOBR) LOAD ADDRESS OF CHANNEL PROG START 61200019 NI 4(CCWREG),X'BF' TURN OFF COMMAND CHAINING 61500019 NI DCBIFLGS,X'3F' CLEAR ERROR FLAGS 61800019 L WORK1,0(CCWREG) GET DATA ADDRESS 62100019 LA WORK1,0(WORK1) CLEAR HIGH ORDER BYTE 62400019 LH WORK2,6(CCWREG) GET BYTE COUNT 62700019 BCTR WORK2,0 SUBTRACT 1 63000019 CLI 0(PARM1),X'0C' IS IT HDR 63300019 BE NOCLEAR YES DO NOT CLEAR INPUT AREA 63600019 SR WORK1,WORK2 GET START OF I/O AREA 63900019 ST WORK1,OFFSET(IOBR) SET CORRECT DATA ADDRESS IN CCW 64200019 CLEAR EX WORK2,CLEAREX 64500019 NOCLEAR EQU * 64800019 MVI 0(CCWREG),X'02' SET RF OP CODE 65100019 L REG8,IOBCSW(IOBR) SAVE ADDRESS OF FAILINC CCW 65400019 MVI DCBOFFSR,OFFSET POINT TO CNTRL CCW IN IOB 65700019 L WORK1,IOBSTADR-1(IOBR) SAVE START ADDRESS 66000019 ST CCWREG,IOBSTADR-1(IOBR) SET START ADDRESS 66300019 EXCP 8(IOBR) ISSUE COMMAND 66600019 WAIT ECB=4(IOBR) WAIT FOR COMPLETION 66900019 MVI DCBOFFSR,OFFSET1 RESTORE CCW OFFSCT IN DCB 67200019 OI IOBFL1(IOBR),X'40' SET COMMAND CHAINING BIT ON 67500019 ST REG8,IOBCSW(IOBR) RESTORE POINTER TO FAILING CCW 67800019 ST WORK1,IOBSTADR-1(IOBR) RESTORE START ADDRESS 68100019 CLI 0(PARM1),X'08' IS IT RKB 68400019 BNE COUNTERS NO QUIT 68700019 SR WORK1,WORK1 CLEAR WORK 69000019 LH WORK1,6(CCWREG) GET COUNT 69300019 L WORK3,0(CCWREG) GET BUFFER ADDRESS 69600019 LA WORK3,0(WORK3) CLEAR HIGH ORDER BYTE 69900019 AR WORK3,WORK2 POINT TO END OF BUFFER 70200019 LR CCWREG,WORK3 SAVE BUFFER ADDRESS 70500019 SR WORK2,WORK2 REGISTERS 70800019 TEST CLI 0(WORK3),X'00' BYTE 00 71100019 BNE MOVEDATA NO ADJUST DATA 71400019 BCT WORK1,TRYAGAIN IF MORE DATA TRY AGAIN 71700019 B COUNTERS QUIT 72000019 TRYAGAIN BCTR WORK3,0 DECREMENT BUFFER ADDRESS 72300019 LA WORK2,1(WORK2) INCREMENT ZERO BYTE COUNTER 72600019 B TEST TRY ANOTHER BYTE 72900019 MOVEDATA EQU * 73200019 MOVE MVC 0(1,CCWREG),0(WORK3) MOVE A BYTE 73500019 BCTR CCWREG,0 DECREMENT END OF BUFFER POINTER 73800019 BCTR WORK3,0 DECREMENT END OF DATA POINTER 74100019 BCT WORK1,MOVE IF MORE DATA,MOVE IT 74400019 LTR WORK2,WORK2 ANY ZERO BYTES 74700019 BZ COUNTERS NO ALL DONE 75000019 LA WORK3,1(WORK3) POINT TO START OF BUFFER 75300019 BCTR WORK2,0 SUBTRACT 2 FROM COUNT 75600019 EX WORK2,CLEAREX1 CLEAR INPUT AREA 75900019 B COUNTERS QUIT 76200019 SETHDR L WORK1,0(PARM1) GET INPUT ADDRESS 76500019 ST WORK1,40(IOBR) PUT IN CCW 76800019 MVI 44(IOBR),X'20' SET SLI FLAG ON 77100019 MVI OFFSET+7(IOBR),X'1E' SET TO ASSUMED LENGTH 77400019 LH WORK1,DCBBUFL GET BUFFER LENGTH 77700019 LTR WORK1,WORK1 LENGTH SPECIFIED 78000019 BZ NOBUF NO USE ASSUMED VALUE 78300019 STH WORK1,46(IOBR) SET COUNT 78600019 B NOBUF GO READ HEADER 78900019 CLEAREX XC 0(1,WORK1),0(WORK1) 79200019 CLEAREX1 XC 0(1,WORK3),0(WORK3) 79500019 EIGHT DC H'08' 79800019 IHADCB DCBD DSORG=PS,DEVD=OR DCB DSECT @YM00635 80100002 DCBEIB EQU IHADCB+18 80400019 ERCTAR EQU IHADCB+4 POINTER TO DCB ERROR COUNTERS 80700019 DCBORBYT EQU IHADCB+16 81000019 END IGG019VH 81300019