* /* START OF SPECIFICATIONS **** 00050002 *01* PROCESSOR = ASSEMXF-370R 00060002 **** END OF SPECIFICATIONS ***/ 00070002 IGG019VJ CSECT ENTRY POINT FOR DSPLY MODULE 00100019 TITLE 'IGG019VJ---DSPLY ROUTINE(OCR)' 00300019 *********************************************************************** 00600019 *MODULE-NAME @YM00638 00650002 * IGG019VJ @YM00638 00700002 * @YM00638 00750002 *DESCRIPTIVE-NAME @YM00638 00800002 * OCR DISPLAY MODULE @YM00638 00850002 * @YM00638 00860002 *COPYRIGHT @YM00638 00870002 * NONE @YM00638 00880002 * @YM00638 00890002 *CHANGE-ACTIVITY @YM00638 00892002 * RELEASE 20 ADDITIONS/CHANGES/DELETIONS 00900001 * RELEASE 21 ADDITIONS/CHANGES/DELETIONS 01200001 * RELEASE 22 ADDITIONS/CHANGES/DELETIONS 01500001 * RELEASE 23 ADDITIONS/CHANGES/DELETIONS 01800001 * RELEASE 24 ADDITIONS/CHANGES/DELETIONS 02100001 * RELEASE 25 ADDITIONS/CHANGES/DELETIONS 02400001 * RELEASE 26 ADDITIONS/CHANGES/DELETIONS 02700001 * RELEASE 27 ADDITIONS/CHANGES/DELETIONS 03000001 * RELEASE 28 ADDITIONS/CHANGES/DELETIONS 03300001 * * 03600019 *STATUS - RELEASE 20 CHANGE LEVEL 000 * 03900001 * * 04200019 *FUNCTION/OPERATION - TO DISPLAY A FIELD IN ERROR ON THE CRT * 04500019 * * 04800019 *ENTRY POINTS - IGG019VJ CSECT CALLING SEQUENCE - * 05100019 * LOAD DCB ADDRESS IN REGISTER 1 * 05400019 * IF ISSUED OUTSIDE THE SYNAD ROUTINE* 05700019 * THE FOLLOWING INSTRUCTIOS ARE * 06000019 * REQUIRED - * 06300019 * L 15,68(1) GET IOB ADDRESS * 06600019 * MVC 48(16,15),0(R1) MOVE TWO LOAD * 06900019 * FORMAT CCW'S TO* 07200019 * IOB+48 * 07500019 * MVC 40(8,15),0(R2) MOVE READ CCW * 07800019 * TO IOB+40 * 08100019 * THE FOLLOWING INSTRUCTIONS ARE * 08400019 * ALWAYS REQUIRED - * 08700019 * L 15,8(1) GET ADDRESS OF DSPLY * 09000019 * MODULE * 09300019 * BALR 14,15 LINK TO DSPLY MODULE * 09600019 * * 09900019 *INPUT - IOB * 10200019 * IOBCSW - ADDRESS OF FAILING CCW IF IN SYNAD ROUTINE * 10500019 * DCB * 10800019 * DCBIOBA - ADDRESS OF THE IOB * 11100019 * DCBSYNAD - ADDRESS OF THE SYNAD ROUTINE * 11400019 * * 11700019 *OUTPUT - COMPLETION CODE IN REGISTER 15 * 12000019 * UPDATED IOB ERROR COUNTERS * 12300019 * IF UNIT EXCEPTION OCCURS, EOF(X'40') IS POSTED IN DCBORBYT * 12600019 * IF ANY PERMANENT ERRORS OCCUR, THE EIB IS UPDATED * 12900019 * * 13200019 *EXTERNAL ROUTINES - IOS VIA EXCP * 13500019 * ERROR COUNTER UPDATE IN SYNCH ROUTINE * 13800019 * EIB UPDATE ROUTINE IN SYNCH ROUTINE * 14100019 * COMPLETION CODE ROUTINE IN SYNCH ROUTINE * 14400019 * USER SYNAD ROUTINE * 14700019 * * 15000019 *EXITS/NORMAL - RETURN TO CALLER - BR 14 * 15300019 * * 15600019 *EXITS/ERROR - ABEND, CODE 001 EOV 0(REG1) * 15900019 * * 16200019 *TABLES/WORK AREAS - USER SAVE AREA POINTED AT BY REGISTER 13 * 16500019 * * 16800019 *ATRIBUTES - REENTRANT,REUSABLE,PROBLEM PROGRAM MODE * 17100019 * * 17400019 *NOTES - N/A * 17700019 * * 18000019 *********************************************************************** 18300019 *********************************************************************** 18500019 * * 18700019 * REGISTER EQUATES * 18900019 * * 19100019 *********************************************************************** 19300019 REG0 EQU 0 GENERAL REGISTER 0 19500019 REG1 EQU 1 GENERAL REGISTER 1 19700019 DCBR EQU 2 ADDRESS OF THE DCB 19900019 REG2 EQU 2 GENERAL REGISTER 2 20100019 IOBR EQU 3 ADDRESS OF THE IOB 20300019 REG3 EQU 3 REGISTER 3 20500019 CCWR EQU 4 CCW POINTER 20700019 WKREG1 EQU 5 WORK REGISTER 20900019 WKREG2 EQU 6 WORK REGISTER 21100019 WKREG3 EQU 7 WORK REGISTER 21300019 REG8 EQU 8 WORK REGISTER 21500019 REG9 EQU 9 GENERAL REGISTER 9 21700019 BASER EQU 9 BASE REGISTER 21900019 SAVR EQU 13 ADDRESS OF SAVE AREA 22100019 BACK EQU 14 USER RETURN ADDRESS 22300019 RETCODE EQU 15 USED TO PASS RETURN CODE 22500019 *********************************************************************** 22700019 * * 22900019 * IOB EQUATES * 23100019 * * 23300019 *********************************************************************** 23500019 IOBSTUS EQU 3 DISPLACEMENT TO IOB STATUS 23700019 IOBFLGS EQU 8 OFFSET TO IOBFLGS IN THE IOB 23900019 ECBADR EQU 12 OFFSET OF ECB ADDRESS IN IOB 24100019 IOBCSW EQU 17 DISPLACEMENT TO CSW IN IOB 24300019 DATADR EQU 0 DATA ADDRESS OFFSET IN CSW 24500019 STRTADR EQU 24 DISPLACEMENT TO IOB START ADDRESS 24700019 OFFSET1 EQU 40 OFFSET OF FIRST CCW 24900019 OFFSET2 EQU 48 OFFSET OF SECOND CCW 25100019 OFFSET3 EQU 56 OFFSET OF THIRD CCW 25300019 UNEXCP EQU X'01' TEST UNIT EXCEPTION BIT 25500019 PERR EQU X'41' TEST FOR PERM ERROR IN ECB 25700019 CCFLGON EQU X'40' SET COMM CHAIN BIT ON IN IOBFLGS 25900019 CCFLGOFF EQU X'BF' SET COMM CHAIN BIT OFF IN IOBFLGS 26100019 *********************************************************************** 26300019 * * 26500019 * DCB EQUATES * 26700019 * * 26900019 *********************************************************************** 27100019 SNBITOFF EQU X'7F' SET SYNAD IN PROCESS BIT OFF 27300019 SYNADBIT EQU X'80' SET SYNAD IN PROCESS BIT OF 27500019 PSYNAD EQU 1 TEST FOR PRESENCE OF SYNAD ROUTINE 27700019 HEOPTCD EQU X'10' TEST FOR HOPPER EMPTY EXIT REQUEST 27900019 HPREMPTY EQU X'02' TEST HOPPER EMPTY IN EIB 28100019 ERROFF EQU X'3F' TURN ERROR FLAGS OFF IN DCBIFLGS 28300019 EOF EQU X'40' SET EOF BIT IN DCBORBYT 28500019 *********************************************************************** 28700019 * * 28900019 * DECB EQUATES * 29100019 * * 29300019 *********************************************************************** 29500019 XDECB EQU 48 OFFSET OF DECB 29700019 XLNGTYP EQU 52 OFFSET OF LENGTH AND TYPE 29900019 XDCBADR EQU 56 OFFSET OF DCB ADDRESS 30100019 XCCWADR EQU 60 OFFSET OF CCW ADDRESS 30300019 XIOBADR EQU 64 OFFSET OF IOB ADDRESS 30500019 *********************************************************************** 30700019 * * 30900019 * CCW EQUATES * 31100019 * * 31300019 *********************************************************************** 31500019 CCWFLAGS EQU 4 DISPLACEMENT TO FLAGS IN CCW 31700019 COUNT EQU 6 OFFSET OF COUNT FIELD IN A CCW 31900019 RDFWDCC EQU X'02' READ FORWARD COMMAND CODE 32100019 CCON EQU X'40' SET COMMAND CHAINING BIT ON 32300019 CCOFF EQU X'BF' SET COMMAND CHAINING BIT OFF 32500019 RBCOMM EQU X'0C' READ BACKWARD COMMAND 32700019 *********************************************************************** 32900019 * * 33100019 * SAVE AREA EQUATES * 33300019 * * 33500019 *********************************************************************** 33700019 USERSAVE EQU 12 DISPLACEMENT IN SAVE AREA FOR REGS 33900019 SAVE39 EQU 16 SAVE AREA POINTER FOR REGISTERS 3-9 34100019 RETSAVE EQU 44 DISPLACEMENT TO RETURN ADDRESS SAVE 34300019 SAVE9 EQU 68 SAVE AREA POINTER FOR REGISTER 9 34500019 DCBSAVE EQU 68 DISPLACEMENT TO DCB ADDRESS SAVE AREA 34700019 *********************************************************************** 34900019 * * 35100019 * MISCELLANEOUS EQUATES * 35300019 * * 35500019 *********************************************************************** 35700019 ECBLEN EQU 4 LENGTH OF ECB TO MOVE 35900019 CCRTN EQU 16 DISPLACEMENT TO COMP CODE RTN 36100019 EIBRTN EQU 8 DISPLACEMENT TO ADDR OF EIB UPDATE 36300019 UPERRCT EQU 24 DISPLACEMENT TO ADDR OF ERROR COUNT 36500019 ACTIOB EQU 8 POINT TO ACTUAL IOB 36700019 CNTRLB EQU X'20' SET CNTRL BIT FOR SYNAD REGISTER 36900019 ZERO EQU 0 ZERO A BYTE 37100019 SHIFTHI EQU 24 SHIFT COUNT 37300019 LNTYPLEN EQU 4 LENGTH OF LENGTH AND TYPE TO MOVE 37500019 CCWMOVE EQU 8 LENGTH OF CCW TO MOVE 37700019 TWELVE EQU 12 SHIFT COUNT TO SET ABEND COMP CODE 37900019 ONE EQU 1 ABEND COMPLETION CODE 38100019 USING IGG019VJ,RETCODE ESTABLISH TEMP BASE REG 40200019 USING IHADCB,DCBR ESTABLISH DCB REG 40500019 STM REG2,REG9,USERSAVE(SAVR) SAVE USER REGISTERS 40800019 ST BACK,RETSAVE(SAVR) SAVE RETURN ADDRESS 41100019 LR BASER,RETCODE LOAD NEW BASE REGISTER 41400019 DROP RETCODE 41700019 USING IGG019VJ,BASER ESTABLISH PERM BASE REG 42000019 LR DCBR,REG1 LOAD DCB REGISTER 42300019 L IOBR,DCBIOBA LOAD IOB ADDRESS 42600019 TM DCBORBYT,SYNADBIT TEST IF IN SYNAD ROUTINE 42900019 BZ NOTINSYN BRANCH IF NOT IN SYNAD 43200019 *********************************************************************** 43500019 * 43800019 * THIS CODE EXECUTED IF DSPLY IS ISSUED IN THE SYNAD ROUTINE 44100019 * 44400019 *********************************************************************** 44700019 L CCWR,IOBCSW-1(IOBR) GET CCW ADDRESS 45000019 LA CCWR,0(CCWR) CLEAR HIGH ORDER BYTE 45300019 SH CCWR,EIGHT BACK UP BY 8 45600019 MVC OFFSET1(CCWMOVE,IOBR),0(CCWR) MOVE CCW TO IOB+40 45900019 NI OFFSET1+CCWFLAGS(IOBR),CCOFF TURN COMMAND CHAINING OFF 46200019 LA CCWR,OFFSET1(IOBR) LOAD ADDRESS OF READ COMMAND 46500019 NI IOBFLGS(IOBR),CCFLGOFF TURN COMM CHAIN BIT OF IN IOBFLGS 46800019 B RDREADY GO GET READY TO READ 47100019 *********************************************************************** 47400019 * 47700019 * THIS CODE EXECUTED IF DSPLY IS NOT ISSUED IN THE SYNAD ROUTINE 48000019 * 48300019 *********************************************************************** 48600019 NOTINSYN OI OFFSET1+CCWFLAGS(IOBR),CCON SET COMMAND CHAINING IN CCW1 48900019 OI OFFSET2+CCWFLAGS(IOBR),CCON SET COMMAND CHAINING IN CCW2 49200019 NI OFFSET3+CCWFLAGS(IOBR),CCOFF COMMAND CHAIN OFF IN CCW 3 49500019 LA CCWR,OFFSET3(IOBR) LOAD ADDRESS OF READ COMMAND 49800019 *********************************************************************** 50100019 * 50400019 * THIS CODE EXECUTED WHENEVER DSPLY IS ISSUED 50700019 * 51000019 *********************************************************************** 51300019 RDREADY L WKREG1,DATADR(CCWR) GET DATA ADDRESS 51600019 LA WKREG1,0(WKREG1) CLEAR HIGH ORDER BYTE 51900019 LH WKREG2,COUNT(CCWR) LOAD COUNT FROM CCW 52200019 BCTR WKREG2,0 DECREMENT COUNT BY 1 52500019 TM 0(CCWR),RBCOMM IS COMMAND A READ BACKWARD 52800019 BNO RDFWD NO DON'T ADJUST I/O AREA ADDRESS 53100019 SR WKREG1,WKREG2 ADJUST I/O AREA ADDRESS 53400019 ST WKREG1,DATADR(CCWR) SET CORRECT ADDRESS IN CCW 53700019 RDFWD EX WKREG2,CLEAR CLEAR I/O AREA 54000019 L WKREG3,STRTADR(IOBR) SAVE IOB START ADDRESS 54300019 LA WKREG2,OFFSET1(IOBR) LOAD CHANNEL PROG START ADDR 54600019 ST WKREG2,STRTADR(IOBR) SET NEW IOB START ADDRESS 54900019 MVI 0(CCWR),RDFWDCC SET READ FORWARD COMMAND 55200019 NI DCBIFLGS,ERROFF TURN ERROR FLAGS OFF 55500019 L REG8,IOBCSW-1(IOBR) SAVE FAILING CCW ADDRESS 55800019 *********************************************************************** 56100019 * 56400019 * EXECUTE CHANNEL PROGRAM AND WAIT 56700019 * 57000019 *********************************************************************** 57300019 EXCP ACTIOB(IOBR) EXECUTE THE CHANNEL PROGRAM 57600019 L REG1,ECBADR(IOBR) LOAD ECB ADDRESS 57900019 WAIT ECB=(REG1) WAIT FOR EVENT TO COMPLETE 58200019 ST REG8,IOBCSW-1(IOBR) RESTORE FAILING CCW ADDRESS 58500019 ST WKREG3,STRTADR(IOBR) RESTORE START ADDRESS 58800019 OI IOBFLGS(IOBR),CCFLGON TURN COMM CHAIN BIT ON IN IOBFLGS 59100019 *********************************************************************** 59400019 * 59700019 * BRANCH AND LINK TO ERROR COUNTER ROUTINE 60000019 * 60300019 *********************************************************************** 60600019 L RETCODE,DCBCHECK LOAD ADDRESS OF CHECK ROUTINE 60900019 BAL BACK,UPERRCT(RETCODE) LINK TO UPDATE ROUTINT 61200019 *********************************************************************** 61500019 SR RETCODE,RETCODE SET RETURN CODE TO ZERO 61800019 L REG1,ECBADR(IOBR) LOAD ECB ADDRESS 62100019 CLI 0(REG1),PERR DID ANY PERMANENT ERRORS OCCUR 62400019 BNE NOERRORS NO RETURN TO USER 63300019 *********************************************************************** 64200019 * 64500019 * BRANCH AND LINK TO SET ERROR INDICATOR BYTE ROUTINE 64800019 * 65100019 *********************************************************************** 65400019 ERRORS L RETCODE,DCBCHECK LOAD ADDRESS OF CHECK ROUTINE 65700019 BAL BACK,EIBRTN(RETCODE) LINK TO EIB ROUTINE 66000019 *********************************************************************** 66300019 * 66600019 * BRANCH AND LINK TO SET COMPLETION CODE ROUTINE 66900019 * 67200019 *********************************************************************** 67500019 L RETCODE,DCBCHECK LOAD ADDRESS OF THE CHECK ROUTINE 67800019 BAL BACK,CCRTN(RETCODE) LINK TO CONDITION CODE ROUTINE 68100019 *********************************************************************** 68400019 TM IOBCSW+IOBSTUS(IOBR),UNEXCP DID UNIT EXCEPTION OCCUR 68700019 BO DONE YES RETURN TO USER 69000019 SYNADCK TM DCBORBYT,SYNADBIT IS SYNAD ROUTINE IN CONTROL 69300019 BO NOERRORS YES RETURN TO USER 69600019 TM DCBSYNAD+3,PSYNAD SYNAD ROUTINE PRESENT 69900019 BZ SYNPROC YES PROCESS FOR SYNAD 70200019 LA REG0,ONE SET COMPLETION CODE TO 1 70400019 SLL REG0,TWELVE ADJUST FOR EOV 70600019 LR REG1,DCBR SET REG1 TO DCB ADDRESS 70800019 EOV 0(REG1) GO TO EOV TO ABEND 71100019 *********************************************************************** 71400019 * 71700019 * RETURN TO THE USER 72000019 * 72300019 *********************************************************************** 72600019 DONE OI DCBORBYT,EOF POST EOF IN DCB 72900019 NOERRORS NI DCBIFLGS,ERROFF SET DCB ERROR FLAGS OFF 73200019 LM REG2,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 73500019 L BACK,RETSAVE(SAVR) RESTORE RETURN ADDRESS 73800019 BR BACK RETURN TO USER 74100019 SYNPROC TM DCBEIB,HPREMPTY HOPPER EMPTY PRESENT 74400019 BZ HPRFULL NO 74700019 TM DCBOPTCD,HEOPTCD HOPPER EMPTY EXIT SPECIFIED 75000019 BZ NOERRORS NO RETURN TO USER 75300019 *********************************************************************** 75600019 * 75900019 * GO TO THE USER'S SYNAD ROUTINE 76200019 * 76500019 *********************************************************************** 76800019 HPRFULL L WKREG1,ECBADR(IOBR) LOAD ECB ADDRESS 77100019 MVC XDECB(ECBLEN,SAVR),0(WKREG1) MOVE ECB TO DECB 77400019 STC RETCODE,DCBEIB+1 SAVE RETURN CODE 77700019 MVC XLNGTYP(LNTYPLEN,SAVR),LNGTYP MOVE LENGTH & TYPE TO DECB 78000019 LA WKREG2,OFFSET1(IOBR) LOAD ADDRESS OF CHANNEL PROGRAM 78300019 ST WKREG2,XCCWADR(SAVR) STORE CCW ADDRESS TO DECB 78600019 ST DCBR,XDCBADR(SAVR) STORE DCB ADDRESS TO DECB 78900019 ST IOBR,XIOBADR(SAVR) STORE IOB ADDRESS TO DECB 79200019 LA REG0,XDECB(SAVR) GET DECB ADDRESS IN REG0 79500019 LA REG1,CNTRLB SET CNTRL BIT ON IN REG1 79800019 SLL REG1,SHIFTHI SHIFT BIT TI HIGH ORDER BYTE 80100019 OR REG1,DCBR DCB ADDRESS TO REG1 80400019 NI DCBIFLGS,ERROFF TURN ERROR FLAGS OFF 80700019 OI DCBORBYT,SYNADBIT TURN SYNAD BIT ON 81000019 L RETCODE,DCBSYNAD LOAD ADDRESS OF SYNAD ROUTINE 81300019 ST REG9,SAVE9(SAVR) SAVE REGISTER 9 81600019 LM REG2,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 81900019 ST REG1,USERSAVE(SAVR) SAVE DCB ADDRESS 82200019 BALR BACK,RETCODE BRANCH AND LINK TO USER SYNAD RTN 82500019 STM REG3,REG9,SAVE39(SAVR) SAVE USER REGISTERS 82800019 L REG9,SAVE9(SAVR) RESTORE REGISTER 9 83100019 L REG3,USERSAVE(SAVR) GEF DCB ADDRESS 83400019 ST REG2,USERSAVE(SAVR) SAVE USER REGISTER 2 83700019 LR DCBR,REG3 RESTORE DCB POINTER 84000019 NI DCBIFLGS,ERROFF TURN OFF ERROR FLAGS 84300019 NI DCBORBYT,SNBITOFF TURN OFF SYNAD BIT 84600019 LTR RETCODE,RETCODE TEST IF ADDRESS IS SPECIFIED 84900019 BZ LODRETCD RESTORE RETURN CODE IF ZERO 85200019 NI DCBORBYT,ZERO RESET OCR FLAGS 85500019 LM REG2,REG9,USERSAVE(SAVR) RESTORE USER REGISTERS 85800019 BR RETCODE BRANCH TO SPECIFIED ADDRESS 86100019 LODRETCD IC RETCODE,DCBEIB+1 RESTORE RETURN CODE 86400019 MVI DCBEIB+1,ZERO CLEAR RETURN CODE SAVE AREA 86700019 B NOERRORS RETURN TO USER 87000019 CLEAR XC 0(1,WKREG1),0(WKREG1) EXECUTED INSTRUCTION TO CLEAR AREA 87300019 EIGHT DC H'8' HALF WORD CONSTANT 87600019 LNGTYP DC X'00008000' LENGTH AND TYPE 87900019 IHADCB DCBD DSORG=PS,DEVD=OR DCB DSECT @YM00635 88200002 END 88500019