* /* START OF SPECIFICATIONS **** 00050002 *01* PROCESSOR = ASSEMXF-370R 00100002 **** END OF SPECIFICATIONS ***/ 00150002 IGG019VI CSECT ENTRY POINT FOR RDLNE MODULE 00300019 TITLE 'IGG019VI RDLNE MODULE---(OCR)---QSAM' 00600019 *********************************************************************** 01200019 *MODULE-NAME @YM00638 01250002 * IGG019VI @YM00638 01300002 * @YM00638 01350002 *DESCRIPTIVE-NAME @YM00638 01400002 * OCR READ A LINE MODULE @YM00638 01450002 * @YM00638 01500002 *COPYRIGHT @YM00638 01550002 * NONE @YM00638 01600002 * @YM00638 01650002 *CHANGE-ACTIVITY @YM00638 01700002 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 01800001 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 02400001 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 03000001 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 03600001 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 04200001 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 04800001 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 05400001 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 06000001 * RELEASE 28 ADDITIONS/CHANGES/DELETIONS 06600001 * * 07200019 *STATUS - RELEASE 20 CHANGE LEVEL 000 * 07800001 * * 08400019 *FUNCTION/OPERATION - READ A JOURNAL TAPE LINE WITH ON-LINE CORRECTION* 09000019 * * 09600019 *ENTRY POINTS - IGG019VI CSECT CALLING SEQUENCE - * 10200019 * LOAD DCB ADDRESS IN REGISTER 1 * 10800019 * L 15,12(1) GET ADDRESS OF RDLNE * 11400019 * MODULE * 12000019 * BALR 14,15 LINK TO RDLNE MODULE * 12600019 * * 13200019 *INPUT - IOB * 13800019 * IOB+CSW-1 - ADDRESS OF FAILING CCW * 14400019 * DCB * 15000019 * DCBIOBA - IOB ADDRESS * 15600019 * * 16200019 *OUTPUT - COMPLETION CODE IN REGISTER 15 * 16800019 * UPDATED IOB ERROR COUNTERS * 17400019 * IF UNIT EXCEPTION OCCURS, EOF(X'40') IS POSTED IN DCBORBYT * 18000019 * IF ANY PERMANENT ERRORS OCCUR, THE EIB IS UPDATED * 18600019 * * 19200019 *EXTERNAL ROUTINES - IOS VIA EXCP * 19800019 * ERROR COUNTER UPDATE IN SYNCH ROUTINE * 20400019 * EIB UPDATE ROUTINE IN SYNCH ROUTINE * 21000019 * COMPLETION CODE ROUTINE IN SYNCH ROUTINE * 21600019 * * 22200019 *EXITS/NORMAL - RETURN TO CALLER - BR 14 * 22800019 * * 23400019 *EXITS/ERROR - NONE * 24000019 * * 24600019 *TABLES/WORK AREAS - USER SAVE AREA POINTED AT BY REGISTER 13 * 25200019 * * 25800019 *ATRIBUTES - REENTRANT,REUSABLE,PROBLEM PROGRAM MODE * 26400019 * * 27000019 *NOTES - N/A * 27600019 * * 28200019 *********************************************************************** 28800019 *********************************************************************** 29200019 * * 29600019 * REGISTER EQUATES * 30000019 * * 30400019 *********************************************************************** 30800019 REG1 EQU 1 REGISTER 1 31200019 DCBR EQU 2 POINTER TO DCB 31600019 IOBR EQU 3 POINTER TO IOB 32000019 CCWADR EQU 4 ADDRESS OF CCW IN QUESTION 32400019 WKREG1 EQU 5 WORK REGISTER 32800019 WKREG2 EQU 6 WORK REGISTER 33200019 REG8 EQU 8 REGISTER 8 33600019 BASR EQU 9 BASE REGISTER 34000019 REG9 EQU 9 REGISTER 9 34400019 SAVR EQU 13 ADDRESS OF SAVE AREA 34800019 RETURN EQU 14 CONTAINS RETURN ADDRESS 35200019 RETCODE EQU 15 USED TO PASS RETURN CODE 35600019 *********************************************************************** 36000019 * * 36400019 * IOB EQUATES * 36800019 * * 37200019 *********************************************************************** 37600019 ECBCODE EQU 4 DISPLACEMENT TO ECB CODE IN THE IOB 38000019 CSW EQU 17 DISPLACEMENT TO CSW IN IOB 38400019 UNEXCP EQU 20 DISP TO CSW STATUS IN IOB @YA00412 38800002 IOBSTADR EQU 25 DISPLACEMENT TO START ADDRESS IN IOB 39200019 OFFSET EQU 40 OFFSET TO CCW IN IOB 39600019 CCWFLAG EQU 44 DISPLACEMENT TO CCW FLAGS IN IOB 40000019 BYTECNT EQU 46 DISPLACEMENT TO CCW BYTE COUNT IN IOB 40400019 OFFSET1 EQU 48 CCW OFFSET IN DCB 40800019 UNEXCPON EQU X'01' TEST FOR UNIT EXCEPTION 41200019 PERMERR EQU X'41' TEST FOR PERMANENT ERRORS 41600019 CHAINOFF EQU X'BF' TURN OFF COMMAND CHAINING BIT 42000019 *********************************************************************** 42400019 * * 42800019 * DCB EQUATES * 43200019 * * 43600019 *********************************************************************** 44000019 EOFON EQU X'40' SET EOF IN DCBORBYT 44400019 ERRFLOFF EQU X'CF' SET ERROR FLAGS IN DCB OFF 44800019 *********************************************************************** 45200019 * * 45600019 * SAVE AREA EQUATES * 46000019 * * 46400019 *********************************************************************** 46800019 RETSAVE EQU 12 DISPLACEMENT TO START OF USER SAVE 47200019 SAV12 EQU 12 POINTER FOR SAVING REGISTERS 47600019 NORMSAVE EQU 24 POINT TO REGS 2-9 IN SAVE AREA 48000019 *********************************************************************** 48400019 * * 48800019 * MISCELLANEOUS EQUATES * 49200019 * * 49600019 *********************************************************************** 50000019 RBOCOP EQU X'4C' RBOC COMMAND CODE 50400019 MOVECCW EQU 8 LENGTH OF CCW TO MOVE 50800019 ACTIOB EQU 8 USED TO POINT TO ACTUAL IOB 51200019 ERRCNT EQU 24 DISPLACEMENT TO ADDRESS OF ERROR C51600019 COUNT UPDATE ROUTINE 52000019 EIBUPDAT EQU 8 DISPLACEMENT TO ADDRESS OF EIB UPDATEC52400019 ROUTINE 52800019 RETCD EQU 16 DISPLACEMENT TO ADDRESS OF RETURN C53200019 CODE POSTING ROUTINE 53600019 USING IGG019VI,RETCODE ESTABLISH ADDRESSIBILITY 56400019 USING IHADCB,DCBR POINTER TO DCB 57000019 STM RETURN,SAV12,RETSAVE(SAVR) SAVE USER REGISTERS 57600019 LR BASR,RETCODE GET BASE ADDRESS 58200019 DROP RETCODE DROP BASE REGISTER 58800019 USING IGG019VI,BASR ESTABLISH ADDRESSIBILITY 59400019 LR DCBR,REG1 GET DCB ADDRESS 60000019 L IOBR,DCBIOBA GET IOB ADDRESS FOM DCB 60600019 *********************************************************************** 60700019 * PREPARE TO ISSUE RBOC COMMAND * 60800019 *********************************************************************** 60900019 L CCWADR,CSW-1(IOBR) GET CCW ADDRESS 61200019 LA CCWADR,0(CCWADR) CLEAR HIGH ORDER BYTE 61800019 SH CCWADR,EIGHT BACK UP ONE CCW 62400019 MVC OFFSET(MOVECCW,IOBR),0(CCWADR) MOVE CCW TO IOB+40 63000019 NI CCWFLAG(IOBR),CHAINOFF TURN CHAINING BIT OFF 63600019 L REG8,CSW-1(IOBR) SAVE ADDRESS OF FAILING CCW 64200019 MVI DCBOFFSR,OFFSET MOVE CCW OFFSET TO DCB 64800019 LA WKREG1,OFFSET(IOBR) GET CCW OFFSET 65400019 ST WKREG1,IOBSTADR-1(IOBR) PUT CCW ADDR IN IOB START ADDR 66000019 MVI OFFSET(IOBR),RBOCOP SET CCW COMMAND CODE TO RBOC 66600019 L WKREG1,OFFSET(IOBR) GET DATA ADDRESSS 67200019 LH WKREG2,BYTECNT(IOBR) GET CCW BYTE COUNT 67800019 BCTR WKREG2,0 SUBTRACT ONE 68400019 SR WKREG1,WKREG2 DECREMENT DATA ADDR BY BYTE COUNT 69000019 EX WKREG2,CLEAR1 CLEAR INPUT AREA 69600019 LA REG1,ACTIOB(IOBR) POINT TO ACTUAL IOB 70200019 *********************************************************************** 70300019 * EXCP AND WAIT * 70400019 *********************************************************************** 70500019 EXCP (REG1) ISSUE RBOC 70800019 WAIT ECB=4(IOBR) WAIT FOR COMPLETION 71400019 ST REG8,CSW-1(IOBR) RESTORE POINTER TO FAILING CCW 72000019 MVI DCBOFFSR,OFFSET1 RESTORE DCB OFFSET 72600019 LA WKREG1,OFFSET1(IOBR) GET ORIGINAL CCW OFFSET 73200019 ST WKREG1,IOBSTADR-1(IOBR) PUT CCW ADDR IN IOB START ADDR 73800019 *********************************************************************** 73900019 * LINK TO COUNTER UPDATE ROUTINE IN SYNCH MODULE 74000019 *********************************************************************** 74100019 L RETCODE,DCBGERR LOAD ADDRESS OF GERR ROUTINE 74400019 BAL RETURN,ERRCNT(RETCODE) LINK TO COUNTER UPDATE ROUTINE 75000019 NOCOUNT CLI ECBCODE(IOBR),PERMERR DID ANY PERMANENT ERRORS OCCUR 75600019 BE ERRORS YES TO ERROR PROCESSOR 76200019 SR RETCODE,RETCODE SET RETURN CODE TO ZERO 78000019 DONE LM REG1,REG9,NORMSAVE(SAVR) RESTORE USER REGISTERS 78600019 L RETURN,RETSAVE(SAVR) RESTORE RETURN ADDRESS 79200019 BR RETURN RETURN TO CALLER 79800019 *********************************************************************** 79900019 * LINK TO SET EIB ROUTINE IN SYNCH MODULE * 80000019 *********************************************************************** 80100019 ERRORS L RETCODE,DCBGERR GET ADDRESS OF EIB ROUTINE - 8 80400019 BAL RETURN,EIBUPDAT(RETCODE) LINK TO EIB ROUTINE 81000019 *********************************************************************** 81100019 * LINK TO COMPLETION CODE ROUTINE IN SYNCH MODULE * 81200019 *********************************************************************** 81300019 L RETCODE,DCBGERR GET ADDRESS OF RETURN CODE ROUTINE-16 81600019 BAL RETURN,RETCD(RETCODE) LINK TO RETURN CODE ROUTINE 82200019 TM UNEXCP(IOBR),UNEXCPON DID UNIT EXCEPTION OCCUR 82800019 BZ NOUNEXCP NO BYPASS EOF SET 83400019 OI DCBORBYT,EOFON SET EOF BIT ON 84000019 NOUNEXCP NI DCBIFLGS,ERRFLOFF SET ERROR FLAGS OFF 84600019 B DONE RETURN TO USER 85200019 EIGHT DC H'8' CONSTANT OF EIGHT 85800019 CLEAR1 XC 0(1,WKREG1),0(WKREG1) EXECUTED INSTRUCTION TO CLEAR AREA 86400019 IHADCB DCBD DSORG=PS,DEVD=OR DCB DSECT @YM00635 87000002 END IGG019VI 87600019