TITLE ' IGC0F06F - 3270 LOCAL/REMOTE EBCDIC TEST MODULE ' 00300002 IGC0F06F CSECT 00600002 SPACE 3 00610002 *********************************************************************** 00650002 * * 00700002 * MAINTENANCE ACTIVITY * 00750002 * * 00800002 * ZA02332 (11/20/74) * 00850003 * * 00860002 *********************************************************************** 00870002 EJECT 00880002 */*IGC0F06F: CHART*/ 00900002 */* E IGC0F06F*/ 01200002 */* D (YES,,NO,SETERR) IS BUFFER LONG ENOUGH (300 BYTES)*/ 01500002 */* D (YES,,NO,SETERR) IS TEST NUMBER VALID (26 OR 27)*/ 01800002 */* P GET MESSAGE LENGTH AND ADDRESS*/ 02100002 */*TESTLCL: D (YES,LOCAL,NO,REMOTE) IS DEVICE A LOCAL 3270*/ 02400002 */*LOCAL: D (NO,,YES,ISSUENOP) IS ERROR FLAG ON*/ 02700002 */* P POINT MESSAGE ADDRESS PAST STX, ESC, AND CMD CODE*/ 03000002 */* P STORE ADDR OF START OF RFT IN CCW*/ 03300002 */* P (,MOVEIN) GET ADDRESS OF START OF CCW*/ 03600002 */*REMOTE: D (NO,,YES,REMOTERR) IS ERROR FLAG ON*/ 03900002 */* P OVERLAY TRANSPARENT CCW*/ 04200002 */* P GET ADDR OF CCW*/ 04500002 */* P STORE ADDR OF START OF RFT IN CCW*/ 04800002 */*MOVEIN: P (,STARTEST) MOVE MESSAGE INTO USER'S BUFFER*/ 05100002 */*SETERR: M (,TESTLCL) TURN ON ERROR FLAG*/ 05400002 */*ISSUENOP: P SET COUNT TO ONE*/ 05700002 */* P (,STARTEST) MOVE NOP COMMAND INTO CCW*/ 06000002 */*REMOTERR: P SET COUNT TO ONE*/ 06300002 */*STARTEST: P STORE COUNT IN CCW*/ 06600002 */* P SAVE THE ECB*/ 06900002 */* L SVC 0*/ 07200002 */* P RESTORE THE ECB*/ 07500002 */* R SVC 3*/ 07800002 */*IGC0F06F: END*/ 08100002 SPACE 2 08400002 * ESTABLISH ADDRESSABILITY 08700002 SPACE 09000002 BALR BASEREG,0 SET UP BASE REG 09300002 USING *,BASEREG 09600002 USING IECTIOB,IOBREG IOB DSECT 09900002 USING IECTDECB,DECBREG DECB DSECT 10200002 USING IHADCB,DCBREG DCB DSECT 10500002 USING IECTDEB,DEBREG DEB DSECT 10800002 USING UCBDSECT,UCBREG UCB DSECT 11100002 B SETUP BRANCH AROUND ID USED TO 11400002 DC C'IGC0F06F' FIND MODULE IN DUMP 11700002 DC C' 4322' DATE LAST CHANGE LD @ZA02332 11750000 DC C'&SYSDATE' DATE LAST ASSEMBLY LD @ZA02332 11800003 DS 0H LD @ZA02332 11850003 PATCH DC 48X'00' PATCH AREA LD @ZA02332 11900003 DS 0H LD @ZA02332 11950003 SETUP EQU * 12000002 L DECBREG,IOBECBPT GET DECB ADDR 12300002 L DCBREG,IOBDCBPT GET DCB ADDR 12600002 L DEBREG,DCBDEBAD GET DEB ADDR 12900002 L DEBREG,28(DEBREG) GO PAST PREFIX 13200002 L RFTREG,IOBERINF GET ADDR OF RFT 13300002 SPACE 2 13500002 * VALIDITY CHECK BUFFER LENGTH AND TEST NUMBER. IF 13800002 * INVALID, SET UP NOP CCW AND TURN ON ERROR FLAG. 14100002 SPACE 14400002 CLC DECLNGTH(2),MINBUF IS BUFFER LONG ENOUGH ? 14700002 BL SETERR NO, SET UP FOR ERROR 15000002 C TESTREG,TEST26 IS IT TEST # 26 ? 15300002 BE GETINFO YES, GET MSG ADDR & COUNT 15600002 C TESTREG,TEST27 IS IT TEST # 27 ? 15900002 BNE SETERR NO, SET UP FOR ERROR 16200002 SPACE 2 16500002 * GET TEST MESSAGE ADDRESS AND LENGTH 16800002 SPACE 17100002 GETINFO LR WORKREG1,TESTREG GET TEST # 17400002 S WORKREG1,TEST26 SUBTRACT 26 TO GET INDEX 17700002 * (26 IS LOWEST TEST NUMBER 18000002 * THIS MODULE WILL HANDLE) 18300002 SLL WORKREG1,2 MULTIPLY BY 4 18600002 L COUNTREG,COUNTAB(WORKREG1) GET MSG LENGTH 18900002 B ADDRTAB(WORKREG1) GET MSG ADDR 19200002 SPACE 2 19500002 * MESSAGE ADDRESS AND LENGTH TABLES - (TEST MESSAGE 19800002 * NUMBER - 26) X 4 = THE ARGUMENT USED TO OBTAIN VALUES 20100002 * FROM THE TABLE. 20400002 SPACE 20700002 DS 0F 21000002 COUNTAB EQU * MESSAGE LENGTH IN BYTES 21300002 DC A(TST26SZ) TEST 26 21600002 DC A(TST27SZ) TEST 27 21900002 SPACE 2 22200002 ADDRTAB EQU * ADDRESS OF TEST MESSAGE 22500002 B TEST26AD 00 GET TEST 26 ADDR 22800002 B TEST27AD 04 GET TEST 27 ADDR 23100002 TEST26AD LA ADDREG,IJLBOT26 GET ADDR 23400002 B TESTLCL CONTINUE 23700002 TEST27AD LA ADDREG,IJLBOT27 GET ADDR 24000002 SPACE 2 24300002 * TEST FOR LOCAL OR REMOTE 24600002 SPACE 24900002 TESTLCL EQU * 25200002 SR UCBREG,UCBREG CLEAR REG FOR IC 25500002 IC UCBREG,IOBUCBX GET INDEX TO UCB 25800002 SLL UCBREG,2 MULTIPLY BY FOUR 26100002 L UCBREG,DEBUCBAD(UCBREG) GET ADDR OF UCB 26400002 CLI DVCLASS,GRAPHIC IS DVC A GRAPHIC ? 26700002 BNE REMOTE NO, SET UP FOR REMOTE 27000002 CLI UNITYPE,A3277 IS DVC A 3277 ? 27300002 BE LOCAL YES, SET UP FOR LOCAL 27600002 CLI UNITYPE,A3284 IS DVC A 3284 ? 27900002 BE LOCAL YES, SET UP FOR LOCAL 28200002 CLI UNITYPE,A3286 IS DVC A 3286 ? 28500002 BNE REMOTE NO, SET UP FOR REMOTE 28800002 * FOR LOCAL DEVICES, STRIP OFF STX, ESC, CMD CODE, AND 29100002 * ETX OF MESSAGE 29400002 SPACE 29700002 LOCAL EQU * 30000002 LA CCWREG,IOBCPA GET ADDR OF CCW 30100002 TM IOBINCAM,ERFLAG IS ERROR FLAG ON ? 30300002 BO ISSUENOP YES, GO ISSUE NOP 30600002 LA WORKREG2,4 SUBTRACT 4 FROM LENGTH 30900002 SR COUNTREG,WORKREG2 OF MESSAGE 31200002 LA ADDREG,3(ADDREG) POINT MESSAGE ADDRESS PAST 31500002 * STX, ESC, CMD CODE 31800002 LA RFTREG,10(RFTREG) ADJUST PTR PAST RFT 32700002 B MOVEIN GO SET UP MSG 33000002 SPACE 2 33300002 * FOR REMOTE, LEAVE MSG ADDRESS AND LENGTH ALONE 33600002 SPACE 33900002 REMOTE EQU * 34200002 LA WORKREG2,IOBCPA GET ADDR OF IOBCPA S99245 34250002 ST WORKREG2,IOBSTART AND STORE IN IOBSTART S99245 34260002 LA CCWREG,IOBCPA+40 GET ADDR OF CCW 34300002 TM IOBINCAM,ERFLAG IS ERROR FLAG ON ? 34500002 BO REMOTERR YES, ISSUE CCW 34800002 MVC IOBCPA+48(8),IOBCPA+56 OVERLAY TRANS CCW 35100002 CLI NVALUE(RFTREG),NOADDR IS THIS A DIAL RFT? S99245 35150002 BNE BSC3RFT NO,FOLLOW BSC3 PROCEDURE S99245 35200002 LA RFTREG,CHARS7(RFTREG) ADJUST PTR PAST RFT S99245 35250002 B MOVEIN GO SET UP MSG S99245 35300002 BSC3RFT EQU * S99245 35350002 LA RFTREG,11(RFTREG) ADJUST PTR PAST RFT 35400002 SPACE 2 36300002 * MOVE TEST MSG INTO USER'S BUFFER 36600002 SPACE 36900002 MOVEIN EQU * 37200002 SR WORKREG2,WORKREG2 CLEAR REG 37800002 C COUNTREG,MAXLNGTH IS MSG LNGTH OVER 256 ? 38100002 BNH LNGTHOK NO, BRANCH 38400002 LR WORKREG2,COUNTREG GET EXCESS OVER 256 38700002 S WORKREG2,MAXLNGTH 39000002 L COUNTREG,MAXLNGTH SET COUNT TO 256 39300002 LNGTHOK EQU * 39600002 BCTR COUNTREG,0 SUBTRACT 1 FROM LNGTH FOR 39900002 * EXECUTE 40200002 EX COUNTREG,MSGMOVE MOVE TEST MSG INTO USER'S 40500002 * BUFFER 40800002 LTR WORKREG2,WORKREG2 ANY MORE TO MOVE ? 41100002 BZ STARTEST NO, BRANCH 41400002 A RFTREG,MAXLNGTH BUMP ADDRESS PAST 256 41700002 A ADDREG,MAXLNGTH CHARS JUST MOVED 42000002 AR COUNTREG,WORKREG2 ADD LENGTH TO COUNTREG YA01228 42050002 BCTR WORKREG2,0 SUBTRACT 1 FOR EXECUTE 42300002 EX WORKREG2,MSGMOVE MOVE REMAINDER OF TEXT 42600002 B STARTEST BRANCH AROUND EXECUTE 42900002 MSGMOVE MVC 0(0,RFTREG),0(ADDREG) MOVE TEST MSG TO 43200002 * USER'S BUFFER, USING LENGTH 43500002 * SPECIFIED IN COUNTREG 43800002 SETERR EQU * 44100002 OI IOBINCAM,ERFLAG TURN ON ERROR FLAG 44400002 B TESTLCL GO SEE IF LOCAL 44700002 ISSUENOP EQU * 45000002 LA COUNTREG,1 SET COUNT TO ONE 45300002 MVI 0(CCWREG),NOP MOVE IN NOP COMMAND 45600002 B STARTEST GO ISSUE NOP 45900002 REMOTERR EQU * 46200002 LA COUNTREG,1 SET COUNT TO ONE 46500002 B STARTEST DO TEST 46800002 SPACE 2 47100002 * MOVE COUNT INTO CCW AND START TEST 47400002 SPACE 47700002 STARTEST EQU * 48000002 LA COUNTREG,1(COUNTREG) RESTORE COUNT AFTER EX 48300002 STH COUNTREG,6(CCWREG) STORE COUNT IN CCW 48600002 * 48650002 * 3 LINES DELETED FOR -----> LD @ZA02332 48700003 * 48750002 LR WORKREG1,IOBREG SAVE IOB ADDR LD @ZA02332 48800003 L PARMREG,GETPARM SET FOR GETMAIN LD @ZA02332 48850003 GETMAIN R,LV=(0) GETMAIN FOR ECB LD @ZA02332 48900003 LR WORKREG2,IOBREG SAVE ECB ADDR LD @ZA02332 48950003 ST DECBREG,DISP4(WORKREG2) SAVE DECB ADDR LD @ZA02332 49000003 MVI DISP4(WORKREG2),FOXFOX FLAG AS DUMMY ECB LD @ZA02332 49050003 LR IOBREG,WORKREG1 RESTORE IOB REG LD @ZA02332 49100003 STCM WORKREG2,MASK,IOBECBPT+DISP1 POINT IOB... LD @ZA02332 49150003 * ...TO DUMMY ECB LD @ZA02332 49160003 SVC ZERO EXCP LD @ZA02332 49200003 STCM DECBREG,MASK,IOBECBPT+DISP1 REPOINT IOB... LD @ZA02332 49250003 * ...TO DECB LD @ZA02332 49300003 L PARMREG,GETPARM SET UP FOR FREEMAIN LD @ZA02332 49350003 FREEMAIN R,LV=(0),A=(WORKREG2) FREE DUMMY ECB LD @ZA02332 49400003 SVC 3 RETURN 49800002 SPACE 2 50100002 * IF AN ERROR WAS FOUND, TURN ON ERROR FLAG, GET CCW 50400002 * ADDR, AND ISSUE NOP CCW 50700002 SPACE 51000002 SPACE 2 51300002 * REGISTER EQUATES 51600002 SPACE 51900002 PARMREG EQU 0 PARAMETER REGISTER LD @ZA02332 51950003 IOBREG EQU 1 ADDR OF IOB 52200002 DECBREG EQU 2 ADDR OF DECB 52500002 DCBREG EQU 3 ADDR OF DCB 52800002 TESTREG EQU 4 TEST # 53100002 WORKREG1 EQU 5 WORK REG 53400002 WORKREG2 EQU 6 WORK REG 53700002 DEBREG EQU 7 ADDR OF DEB 54000002 UCBREG EQU 8 ADDR OF UCB 54300002 ADDREG EQU 9 TEST MSG ADDRESS 54600002 COUNTREG EQU 10 TEST MSG LENGTH 54900002 CCWREG EQU 11 ADDR OF CCW TO WRITE TEST MSG 55200002 BASEREG EQU 12 55500002 RFTREG EQU 13 ADDR OF RFT 55800002 SPACE 2 56100002 * MISCELLANEOUS EQUATES 56400002 SPACE 56700002 A3286 EQU X'0B' 3286 DEVICE TYPE 57000002 A3284 EQU X'0A' 3284 DEVICE TYPE 57300002 A3277 EQU X'09' 3277 DEVICE TYPE 57600002 GRAPHIC EQU X'10' GRAPHICS DEVICE TYPE 57900002 NOP EQU X'03' NOP COMMAND CODE 58200002 ERFLAG EQU X'02' ERROR FLAG 58500002 NVALUE EQU 6 DISP INTO RFT OF N VALUE S99245 58550002 NOADDR EQU X'00' IF N=0, IT IS A DIAL RFT S99245 58600002 CHARS7 EQU 7 LENGTH OF STANDARD DIAL RFT S99245 58650002 FOXFOX EQU X'FF' BYTE OF ALL ONES LD @ZA02332 58700003 MASK EQU 7 MASK FOR STCM LD @ZA02332 58750003 DISP1 EQU 1 DISPLACEMENT LD @ZA02332 58760003 DISP4 EQU 4 DISPLACEMENT LD @ZA02332 58770003 ZERO EQU 0 LD @ZA02332 58780003 SPACE 2 58800002 * STORAGE 59100002 SPACE 59400002 DS 0F FULLWORD BOUNDARY LD @ZA02332 59450003 GETPARM DC X'FA000008' SUBPOOL # AND LENGTH LD @ZA02332 59500003 MINBUF DC X'012C' MINIMUM BUFFER LENGTH 59700002 TEST26 DC F'26' ACCEPTABLE TEST NUMBER 60000002 TEST27 DC F'27' ACCEPTABLE TEST NUMBER 60300002 MAXLNGTH DC F'256' MAX # OF CHARS FOR MVC 60600002 IJLBOT26 EQU * 60900002 DC X'0227F5' STX-ESC-EWRT 61200002 DC X'6F' WCC START PRINT/64 CHARS PER LINE/ 61500002 * SOUND ALARM/RESTORE KEYBOARD 61800002 DC X'1D60' SF/NORMAL INT/PROTECTED 62100002 DC C'FOR CLUSTERED PRINTERS DATA SHOULD' 62400002 DC C' START NEXT LINE HERE ------>' NEW LINE AT CHAR 65 62700002 DC C'CHECKING PROGRAM TAB/ERASE UNPROT. TO ' 63000002 DC C'ADDR/DUP/FIELD MARK ORDERS' 63300002 DC X'11C3F0' SBA 240 63600002 DC X'13' INSERT CURSOR 63900002 DC X'1DF8' AUTOSKIP,PROTECTED,HIGH INTENSITY 64200002 DC X'3CC540F1' RA 320 (1'S) 64500002 DC X'1DC8' UNPROTECTED,HIGH INTENSITY 64800002 DC X'3CC650' RA 400 (A'S) 65100002 DC C'A' REPEATED CHAR 65400002 DC X'1D60' PROTECTED,NORMAL INTENSITY 65700002 DC X'3CC75F' RA 479 (B'S) 66000002 DC C'B' REPEATED CHAR 66300002 DC X'11C4D7F1' SBA 279,1 66600002 DC X'05' PROGRAM TAB 66900002 DC X'11C5E8' SBA 360 67200002 DC X'12C650' EUA 400 67500002 DC X'11C64A' SBA 394 67800002 DC X'1C1E1519' DUP/FIELD MARK/NEW LINE/EOM 68100002 DC X'03' ETX 68400002 TST26SZ EQU *-IJLBOT26 LENGTH OF TEST 26 68500002 IJLBOT27 EQU * 68700002 DC X'0227F5' STX-ESC-EWRT 69000002 * UNIVERSAL 3270 TEST PATTERN (RFT MESSAGE) 69300002 DC X'4F' WCC SOUND ALARM/RESTORE KEYBOARD/ 69600002 * START PRINT/132 CHARCTRS PER LINE 69900002 DC X'8182838485868788898A8C8D8E8F' 70200002 DC X'909192939495969798999A9D9E9F' 70500002 DC X'1140E7' SBA 39 70800002 DC X'1D60' SF 60 71100002 DC X'A2A3A4A5A6A7A8A9AAACADAEAF' 71400002 DC X'BABBBCBDBEBF808B9B9CA0A1AB' 71700002 DC X'B0B1B2B3B475B6B7B879' 72000002 DC X'11C14F' SBA 79 72300002 DC X'1D40' SF 40 72600002 DC X'414243444546474849' 72900002 DC X'515253545556575859' 73200002 DC X'6263646566676869' 73500002 DC X'70717273747576777879' 73800002 DC X'11C1F7' SBA 119 74100002 DC X'1D60' SF 60 74400002 DC X'C1C2C3C4C5C6C7C8C9' 74700002 DC X'D1D2D3D4D5D6D7D8D9' 75000002 DC X'E2E3E4E5E6E7E8E9' 75300002 DC X'F0F1F2F3F4F5F6F7F8F9' 75600002 DC X'11C25F' SBA 159 75900002 DC X'1D40' SF 40 76200002 DC X'40506061C0D0E0E1' 76500002 DC X'11C3C7' SBA 199 76800002 DC X'1D60' SF 60 77100002 DC X'4A4B4C4D4E4F' 77400002 DC X'5A5B5C5D5E5F' 77700002 DC X'6A6B6C6D6E6F' 78000002 DC X'7A7B7C7D7E7F' 78300002 DC X'11C36F' SBA 239 78600002 DC X'1D40' SF 40 78900002 DC X'CACBCCCDCECF' 79200002 DC X'DADBDCDDDEDF' 79500002 DC X'EAEBECEDEEEF' 79800002 DC X'FAFBFCFDFEFF' 80100002 DC X'11C4D7' SBA 279 80400002 DC X'1D60' SF 60 80700002 DC C'N/L CHECK' 81000002 DC X'15B515B515' 5 NEW LINE MESSAGES 81300002 DC X'11C540' SBA 320 81600002 DC C'EOM CHECK' 81900002 DC X'B919' END OF MESSAGE (ALT. CODES) 82200002 DC X'11C64F' SBA 399 82500002 DC X'1D40' SF 40 82800002 DC X'13' INC 83100002 DC X'03' ETX 83400002 TST27SZ EQU *-IJLBOT27 LENGTH OF TEST 27 83500002 EJECT 83700002 * DSECTS 84000002 SPACE 84300002 IECTIOBX 84600002 EJECT 84900002 IECTDECB 85200002 EJECT 85500002 DCBD DSORG=BX,DEVD=BS 85800002 EJECT 86100002 IECTDEBX 86400002 EJECT 86450002 UCBDSECT DSECT 86700002 DS 0F 87000002 ORG UCBDSECT+13 87300002 CHARADDR DS CL3 UNIT ADDR (EBCDIC) 87600002 ORG UCBDSECT+18 87900002 DVCLASS DS CL1 DEVICE CLASS 88200002 UNITYPE DS CL1 UNIT TYPE 88500002 ORG UCBDSECT+36 88800002 RLN DS CL1 RELATIVE LINE NUMBER 89100002 END 89400002