TITLE ' IGC1306F - 3270 LOCAL/REMOTE EBCDIC TEST MODULE ' 00400002 IGC1306F CSECT 00800002 *********************************************************************** 00806002 * 3270 LOCAL/REMOTE EBCDIC TEST MODULE * 00812002 *********************************************************************** 00818002 * * 00824002 * STATUS: * 00830002 * * 00842002 * ZA02332 (11/20/74) * 00844003 * * 00846002 *********************************************************************** 00846402 * * 00846802 * FUNCTION: * 00848002 * THIS MODULE BUILDS PREDEFINED EBCDIC ON-LINE TEST MESSAGES * 00854002 * FOR THE 3270 DISPLAY SYSTEM - LOCAL OR REMOTE. * 00860002 * * 00866002 * ENTRY: * 00872002 * ENTRY IS TO THE FIRST EXECUTABLE INSTRUCTION VIA XCTL * 00878002 * FROM IGC0D06F(REMOTE) OR IGC1206F(LOCAL). * 00884002 * * 00890002 * INPUT: * 00896002 * REG 1 - ADDRESS OF THE IOB * 00902002 * REG 4 - TEST TYPE XX VALUE * 00908002 * IOBERINF - ADDRESS OF THE RFT * 00914002 * ON-LINE TEST CHANNEL PROGRAM IN IOB, BUILT BY IGC0D06F * 00920002 * (REMOTE) OR IGC1206F (LOCAL). * 00926002 * * 00932002 * OUTPUT: * 00938002 * LOCAL-- * 00944002 * * 00950002 * TEST MESSAGE (MINUS LINE CONTROL) BUILT IN USER'S AREA. * 00956002 * COUNT INSERTED IN ERASE/WRITE CCW. * 00962002 * IF THE USER'S BUFFER IS NOT LONG ENOUGH (300) BYTES OR * 00968002 * THE TEST MESSAGE NUMBER IS INVALID, AN ERROR FLAG (IOBINCAM, * 00974002 * BYTE 0, BIT 6) IS TURNED ON, AND A NOP REPLACES THE ERASE/ * 00980002 * WRITE CCW. THIS WILL CAUSE IGG019PI TO CANCEL THE TEST BY * 00986002 * RE-ISSUING THE USER'S READ INITIAL. * 00992002 * * 00998002 * REMOTE-- * 01004002 * * 01010002 * TEST MESSAGE BUILT IN USER'S AREA. * 01016002 * COUNT IN WRITE TEXT CCW. * 01022002 * IF AN ERROR IS FOUND, THE ERROR FLAG (SEE LOCAL) IS TURNED * 01028002 * ON TO CAUSE IGG019MR TO CANCEL THE TEST. * 01034002 * * 01040002 * TESTS BUILT BY THIS MODULE: * 01046002 * * 01052002 * TEST 28 - 3270 NL/EOM PRINTER EBCDIC 01058002 * * 01064002 * EXTERNAL REFERENCES: * 01070002 * SVC 0 - EXECUTE CHANNEL PROGRAM * 01076002 * * 01082002 * EXITS, NORMAL: * 01088002 * SVC 3 - RETURN TO IOS * 01094002 * * 01100002 * EXITS, ERROR: * 01106002 * NONE * 01112002 * * 01118002 * TABLES/WORK AREAS: * 01124002 * NONE * 01130002 * * 01136002 * ATTRIBUTES: * 01142002 * RE-ENTRANT * 01148002 * * 01154002 * CHARACTER CODE DEPENDENCY: * 01160002 * NONE * 01166002 * * 01172002 *********************************************************************** 01178002 EJECT 01184002 */*IGC1306F: CHART*/ 01200002 */* E IGC1306F*/ 01600002 */* D (YES,,NO,SETERR) IS BUFFER LONG ENOUGH (300 BYTES)*/ 02000002 */* D (YES,,NO,SETERR) IS TEST NUMBER VALID (28)*/ 02400002 */* P GET MESSAGE LENGTH AND ADDRESS*/ 02800002 */*TESTLCL: D (YES,LOCAL,NO,REMOTE) IS DEVICE A LOCAL 3270*/ 03200002 */*LOCAL: D (NO,,YES,ISSUENOP) IS ERROR FLAG ON*/ 03600002 */* P POINT MESSAGE ADDRESS PAST STX, ESC, AND CMD CODE*/ 04000002 */* P STORE ADDR OF START OF RFT IN CCW*/ 04400002 */* P (,MOVEIN) GET ADDRESS OF START OF CCW*/ 04800002 */*REMOTE: D (NO,,YES,REMOTERR) IS ERROR FLAG ON*/ 05200002 */* P OVERLAY TRANSPARENT CCW*/ 05600002 */* P GET ADDR OF CCW*/ 06000002 */* P STORE ADDR OF START OF RFT IN CCW*/ 06400002 */*MOVEIN: P (,STARTEST) MOVE MESSAGE INTO USER'S BUFFER*/ 06800002 */*SETERR: M (,TESTLCL) TURN ON ERROR FLAG*/ 07200002 */*ISSUENOP: P SET COUNT TO ONE*/ 07600002 */* P (,STARTEST) MOVE NOP COMMAND INTO CCW*/ 08000002 */*REMOTERR: P SET COUNT TO ONE*/ 08400002 */*STARTEST: P STORE COUNT IN CCW*/ 08800002 */* P SAVE THE ECB*/ 09200002 */* L SVC 0*/ 09600002 */* P RESTORE THE ECB*/ 10000002 */* R SVC 3*/ 10400002 */*IGC1306F: END*/ 10800002 EJECT 11000002 SPACE 2 11200002 * ESTABLISH ADDRESSABILITY 11600002 SPACE 12000002 BALR BASEREG,0 SET UP BASE REG 12400002 USING *,BASEREG 12800002 USING IECTIOB,IOBREG IOB DSECT 13200002 USING IECTDECB,DECBREG DECB DSECT 13600002 USING IHADCB,DCBREG DCB DSECT 14000002 USING IECTDEB,DEBREG DEB DSECT 14400002 USING UCBDSECT,UCBREG UCB DSECT 14800002 B SETUP BRANCH AROUND ID USED TO 15200002 DC C'IGC1306F' FIND MODULE IN DUMP 15600002 DC C' 4322' DATE LAST CHANGE LD @ZA02332 15650003 DC C'&SYSDATE' DATE LAST ASSEMBLY LD @ZA02332 15700003 DS 0H LD @ZA02332 15750003 PATCH DC 48X'00' PATCH AREA LD @ZA02332 15800003 DS 0H LD @ZA02332 15850003 SETUP EQU * 16000002 L DECBREG,IOBECBPT GET DECB ADDR 16400002 L DCBREG,IOBDCBPT GET DCB ADDR 16800002 L DEBREG,DCBDEBAD GET DEB ADDR 17200002 L DEBREG,28(DEBREG) GO PAST PREFIX 17600002 L RFTREG,IOBERINF GET ADDR OF RFT 17800002 SPACE 2 18000002 * VALIDITY CHECK BUFFER LENGTH AND TEST NUMBER. IF 18400002 * INVALID, SET UP NOP CCW AND TURN ON ERROR FLAG. 18800002 SPACE 19200002 CLC DECLNGTH(2),MINBUF IS BUFFER LONG ENOUGH ? 19600002 BL SETERR NO, SET UP FOR ERROR 20000002 C TESTREG,TEST28 IS IT TEST # 28 ? 20400002 BNE SETERR NO, SET UP FOR ERROR 20800002 SPACE 2 21200002 * GET TEST MESSAGE ADDRESS AND LENGTH 21600002 SPACE 22000002 GETINFO LR WORKREG1,TESTREG GET TEST # 22400002 S WORKREG1,TEST28 SUBTRACT 28 TO GET INDEX 22800002 * (28 IS LOWEST TEST NUMBER 23200002 * THIS MODULE WILL HANDLE) 23600002 SLL WORKREG1,2 MULTIPLY BY 4 24000002 L COUNTREG,COUNTAB(WORKREG1) GET MSG LENGTH 24400002 B ADDRTAB(WORKREG1) GET MSG ADDR 24800002 B TESTLCL 25200002 SPACE 2 25600002 * MESSAGE ADDRESS AND LENGTH TABLES - (TEST MESSAGE 26000002 * NUMBER - 28) X 4 = THE ARGUMENT USED TO OBTAIN VALUES 26400002 * FROM THE TABLE. 26800002 SPACE 27200002 DS 0F 27600002 COUNTAB EQU * MESSAGE LENGTH IN BYTES 28000002 DC A(TST28SZ) TEST 28 28400002 SPACE 2 28800002 ADDRTAB EQU * ADDRESS OF TEST MESSAGE 29200002 B TEST28AD 00 GET TEST 28 ADDR 29600002 TEST28AD LA ADDREG,IJLBOT28 GET ADDR 30000002 SPACE 2 30400002 * TEST FOR LOCAL OR REMOTE 30800002 SPACE 31200002 TESTLCL EQU * 31600002 SR UCBREG,UCBREG CLEAR REG FOR IC 32000002 IC UCBREG,IOBUCBX GET INDEX TO UCB 32400002 SLL UCBREG,2 MULTIPLY BY FOUR 32800002 L UCBREG,DEBUCBAD(UCBREG) GET ADDR OF UCB 33200002 CLI DVCLASS,GRAPHIC IS DVC A GRAPHIC ? 33600002 BNE REMOTE NO, SET UP FOR REMOTE 34000002 CLI UNITYPE,A3277 IS DVC A 3277 ? 34400002 BE LOCAL YES, SET UP FOR LOCAL 34800002 CLI UNITYPE,A3284 IS DVC A 3284 ? 35200002 BE LOCAL YES, SET UP FOR LOCAL 35600002 CLI UNITYPE,A3286 IS DVC A 3286 ? 36000002 BNE REMOTE NO, SET UP FOR REMOTE 36400002 * FOR LOCAL DEVICES, STRIP OFF STX, ESC, CMD CODE, AND 36800002 * ETX OF MESSAGE 37200002 SPACE 37600002 LOCAL EQU * 38000002 LA CCWREG,IOBCPA GET ADDR OF CCW 38200002 TM IOBINCAM,ERFLAG IS ERROR FLAG ON ? 38400002 BO ISSUENOP YES, GO ISSUE NOP 38800002 LA WORKREG2,4 SUBTRACT 4 FROM LENGTH 39200002 SR COUNTREG,WORKREG2 OF MESSAGE 39600002 LA ADDREG,3(ADDREG) POINT MESSAGE ADDRESS PAST 40000002 * STX, ESC, CMD CODE 40400002 LA RFTREG,10(RFTREG) ADJUST PTR PAST RFT 41200002 B MOVEIN GO SET UP MSG 42000002 SPACE 2 42400002 * FOR REMOTE, LEAVE MSG ADDRESS AND LENGTH ALONE 42800002 SPACE 43200002 REMOTE EQU * 43600002 LA WORKREG2,IOBCPA GET ADDR OF IOBCPA S99245 43650002 ST WORKREG2,IOBSTART AND STORE IN IOBSTART S99245 43700002 LA CCWREG,IOBCPA+40 GET ADDR OF CCW 43800002 TM IOBINCAM,ERFLAG IS ERROR FLAG ON ? 44000002 BO REMOTERR YES, ISSUE CCW 44400002 MVC IOBCPA+48(8),IOBCPA+56 OVERLAY TRANS CCW 44800002 CLI NVALUE(RFTREG),NOADDR IS THIS A DIAL RFT? S99245 44850002 BNE BSC3RFT NO,FOLLOW BSC3 PROCEDURE S99245 44900002 LA RFTREG,CHARS7(RFTREG) ADJUST PTR PAST RFT S99245 44950002 B MOVEIN GO SET UP MSG S99245 45000002 BSC3RFT EQU * S99245 45050002 LA RFTREG,11(RFTREG) ADJUST PTR PAST RFT 45600002 SPACE 2 46400002 * MOVE TEST MSG INTO USER'S BUFFER 46800002 SPACE 47200002 MOVEIN EQU * 47600002 SR WORKREG2,WORKREG2 CLEAR REG 48400002 C COUNTREG,MAXLNGTH IS MSG LNGTH OVER 256 ? 48800002 BNH LNGTHOK NO, BRANCH 49200002 LR WORKREG2,COUNTREG GET EXCESS OVER 256 49600002 S WORKREG2,MAXLNGTH 50000002 L COUNTREG,MAXLNGTH SET COUNT TO 256 50400002 LNGTHOK EQU * 50800002 BCTR COUNTREG,0 SUBTRACT 1 FROM LNGTH FOR 51200002 * EXECUTE 51600002 EX COUNTREG,MSGMOVE MOVE TEST MSG INTO USER'S 52000002 * BUFFER 52400002 LTR WORKREG2,WORKREG2 ANY MORE TO MOVE ? 52800002 BZ STARTEST NO, BRANCH 53200002 A RFTREG,MAXLNGTH BUMP ADDRESS PAST 256 53600002 A ADDREG,MAXLNGTH CHARS JUST MOVED 54000002 BCTR WORKREG2,0 SUBTRACT 1 FOR EXECUTE 54400002 EX WORKREG2,MSGMOVE MOVE REMAINDER OF TEXT 54800002 B STARTEST BRANCH AROUND EXECUTE 55200002 MSGMOVE MVC 0(0,RFTREG),0(ADDREG) MOVE TEST MSG TO 55600002 * USER'S BUFFER, USING LENGTH 56000002 * SPECIFIED IN COUNTREG 56400002 SPACE 2 56480002 * IF AN ERROR WAS FOUND, TURN ON ERROR FLAG AND GO GET 56560002 * ADDRESS OF CCW. 56640002 SPACE 56720002 SETERR EQU * 56800002 OI IOBINCAM,ERFLAG TURN ON ERROR FLAG 57200002 B TESTLCL GO SEE IF LOCAL 57600002 SPACE 2 57700002 * FOR ERROR IN LOCAL, SET UP A NOP CCW 57800002 SPACE 57900002 ISSUENOP EQU * 58000002 LA COUNTREG,1 SET COUNT TO ONE 58400002 MVI 0(CCWREG),NOP MOVE IN NOP COMMAND 58800002 B STARTEST GO ISSUE NOP 59200002 SPACE 2 59300002 * FOR REMOTE ERROR, SET COUNT IN WRITE TEXT CCW TO ONE 59400002 SPACE 59500002 REMOTERR EQU * 59600002 LA COUNTREG,1 SET COUNT TO ONE 60000002 B STARTEST DO TEST 60400002 SPACE 2 60800002 * MOVE COUNT INTO CCW AND START TEST 61200002 SPACE 61600002 STARTEST EQU * 62000002 LA COUNTREG,1(COUNTREG) RESTORE COUNT AFTER EX 62400002 STH COUNTREG,6(CCWREG) STORE COUNT IN CCW 62800002 * 62850002 * 1 LINE DELETED FOR -----> LD @ZA02332 62900003 * 62950002 LR WORKREG1,IOBREG SAVE IOB ADDR LD @ZA02332 63000003 L PARMREG,GETPARM SET UP FOR GETMAIN LD @ZA02332 63050003 GETMAIN R,LV=(0) GETMAIN FOR ECB LD @ZA02332 63100003 LR WORKREG2,IOBREG SAVE ECB ADDR LD @ZA02332 63150003 ST DECBREG,DISP4(WORKREG2) SAVE DECB ADDR LD @ZA02332 63200003 MVI DISP4(WORKREG2),FOXFOX FLAG AS DUMMY ECB LD @ZA02332 63250003 LR IOBREG,WORKREG1 RESTORE IOB REG LD @ZA02332 63300003 STCM WORKREG2,MASK,IOBECBPT+DISP1 POINT IOB... LD @ZA02332 63350003 * ...TO DUMMY LD @ZA02332 63400003 SVC 0 DO TEST 63600002 * 63650002 * 1 LINE DELETED FOR -----> LD @ZA02332 63700003 * 63750002 STCM DECBREG,MASK,IOBECBPT+DISP1 REPOINT IOB... LD @ZA02332 63800003 * ...TO DECB LD @ZA02332 63850003 L PARMREG,GETPARM SET UP FOR FREEMAIN LD @ZA02332 63900003 FREEMAIN R,LV=(0),A=(WORKREG2) FREE DUMMY ECB LD @ZA02332 63950003 SVC 3 RETURN 64400002 SPACE 2 64800002 SPACE 66000002 SPACE 2 66400002 * REGISTER EQUATES 66800002 SPACE 67200002 PARMREG EQU 0 PARAMETER REGISTER LD @ZA02332 67250003 IOBREG EQU 1 ADDR OF IOB 67600002 DECBREG EQU 2 ADDR OF DECB 68000002 DCBREG EQU 3 ADDR OF DCB 68400002 TESTREG EQU 4 TEST # 68800002 WORKREG1 EQU 5 WORK REG 69200002 WORKREG2 EQU 6 WORK REG 69600002 DEBREG EQU 7 ADDR OF DEB 70000002 UCBREG EQU 8 ADDR OF UCB 70400002 ADDREG EQU 9 TEST MSG ADDRESS 70800002 COUNTREG EQU 10 TEST MSG LENGTH 71200002 CCWREG EQU 11 ADDR OF CCW TO WRITE TEST MSG 71600002 BASEREG EQU 12 72000002 RFTREG EQU 13 ADDR OF RFT 72400002 SPACE 2 72800002 * MISCELLANEOUS EQUATES 73200002 SPACE 73600002 A3286 EQU X'0B' 3286 DEVICE TYPE 74000002 A3284 EQU X'0A' 3284 DEVICE TYPE 74400002 A3277 EQU X'09' 3277 DEVICE TYPE 74800002 GRAPHIC EQU X'10' GRAPHICS DEVICE TYPE 75200002 NOP EQU X'03' NOP COMMAND CODE 75600002 ERFLAG EQU X'02' ERROR FLAG 76000002 NVALUE EQU 6 DISP INTO RFT OF N VALUE S99245 76050002 NOADDR EQU X'00' IF N=0, IT IS A DIAL RFT S99245 76100002 CHARS7 EQU 7 LENGTH OF STANDARD DIAL RFT S99245 76150002 FOXFOX EQU X'FF' BYTE OF ALL ONES LD @ZA02332 76200003 MASK EQU 7 MASK FOR STCM LD @ZA02332 76250003 DISP1 EQU 1 DISPLACEMENT LD @ZA02332 76300003 DISP4 EQU 4 DISPLACEMENT LD @ZA02332 76350003 SPACE 2 76400002 * STORAGE 76800002 SPACE 77200002 DS 0H LD @ZA02332 77260000 GETPARM DC X'FA000008' SUBPOOL # AND LENGTH LD @ZA02332 77300003 MINBUF DC X'012C' MINIMUM BUFFER LENGTH 77600002 TEST28 DC F'28' ACCEPTABLE TEST NUMBER 78000002 MAXLNGTH DC F'256' MAX # OF CHARS FOR MVC 78400002 IJLBOT28 EQU * 78800002 DC X'0227F5' STX-ESC-EWRT 79200002 DC X'4F' WCC- RSTRE KYBRD/SND ALRM/STRT PRNT 79600002 DC C'NEW LINE FUNCTION CHECK' DS LINE 1 80000002 DC X'15' NEW LINE 80400002 DC C'NEW LINE FUNCTION' DS LINE 2 80800002 DC X'15' NEW LINE 81200002 DC C'NEW LINE' DS LINE 3 81600002 DC X'15' NEW LINE 82000002 DC C'NEW' DS LINE 4 82400002 DC X'15' NEW LINE 82800002 DC C'NEW LINE' DS LINE 5 83200002 DC X'15' NEW LINE 83600002 DC C'NEW LINE FUNCTION' DS LINE 6 84000002 DC X'15' NEW LINE 84400002 DC C'NEW LINE FUNCTION CHECK' DS LINE 7 84800002 DC X'15' NEW LINE 85200002 DC X'1D4C' NON DISPLAY,NON PRINT,NON DETECTABLE 85600002 DC C'THIS DATA NOT VISIBLE/EOM AND N/L IGNORED' 86000002 DC X'1519' NEW LINE EOM (IGNORED) 86400002 DC X'1D40' SF/NORMAL INT/ UNPROTECTED 86800002 DC C'END-OF-MESSAGE-TERMINATES PRINT' 87200002 DC X'19' END OF MESSAGE 87600002 DC X'15' NEW LINE DS LINE 8 88000002 DC C'2ND EOM LINE NOT ON PRINTER OUTPUT' 88400002 DC X'19' END OF MESSAGE 88800002 DC X'03' ETX 89200002 TST28SZ EQU *-IJLBOT28 LENGTH OF TEST 28 89400002 SPACE 2 89600002 * DSECTS 90000002 SPACE 90400002 IECTIOBX 90800002 EJECT 91200002 IECTDECB 91600002 EJECT 92000002 DCBD DSORG=BX,DEVD=BS 92400002 EJECT 92800002 IECTDEBX 93200002 UCBDSECT DSECT 93600002 DS 0F 94000002 ORG UCBDSECT+13 94400002 CHARADDR DS CL3 UNIT ADDR (EBCDIC) 94800002 ORG UCBDSECT+18 95200002 DVCLASS DS CL1 DEVICE CLASS 95600002 UNITYPE DS CL1 UNIT TYPE 96000002 ORG UCBDSECT+36 96400002 RLN DS CL1 RELATIVE LINE NUMBER 96800002 END 97200002