./ ADD SSI=02013244,NAME=IECKBRKF,SOURCE=0 TITLE 'BREAKOFF ROUTINE (BREAKOFF)' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKBRKF QTAM BREAKOFF ROUTINE (BREAKOFF). * 03000013 * * 03600013 *STATUS- CHANGE LEVEL= 17 JANUARY 1971 * 04200021 * * 04800013 *FUNCTION- * 05400013 * IECKBRKF WILL KEEP TRACK OF THE TOTAL LENGTH OF A MESSAGE * 06000013 * AND TERMINATE THE MESSAGE IF IT EXCEEDS THE MAXIMUM LENGTH * 06600013 * SPECIFIED AS AN OPERAND OF THE BREAKOFF MACRO9 THE MESSAGE WILL * 07200013 * ALSO BE TERMINATED IF ALL THE CHARACTERS ARE IDENTICAL. * 07800013 * WHEN A SEGMENT IS RECEIVED. A TEST IS MADE TO SEE IF IT IS * 08400013 * A TEXT SEGMENT. IF IT IS NOT A TEXT SEGMENT, THE LENGTH OF THE * 09000013 * PREFIX AND EXPANSION FIELDS ARE SUMMED. THIS VALUE IS ADDED TO * 09600013 * THE ADDRESS OF THE BUFFER TO GIVE THE ADDRESS OF THE SECOND BYTE * 10200013 * OF THE HEADER. IF THE SEGMENT WAS A TEXT SEGMENT, THEN THIS * 10800013 * ADDRESS WOULD ALREADY BE AVAILABLE. * 11400013 * THE ADDRESS OF THE SECOND BYTE OF THE HEADER IS SUBTRACTED * 12000013 * FROM THE END OF SEGMENT ADDRESS TO YIELD THE LENGTH OF THE DATA * 12600013 * FIELD - 2 IN THIS SEGMENT9 IF THE RESULTING LENGTH IS NEGATIVE, * 13200013 * THE RECEIVE BIT AT LCBSTATE ( LCB + 0) IS SET. * 13800013 * IF THE LENGTH WAS NON-NEGATIVE, THE CHARACTERS ARE COMPARED. * 14400013 * IF THE CHARACTERS ARE ALL IDENTICAL, THE RECEIVE BIT AT LCBSTATE * 15000013 * IS TURNED OFF UNLESS A PROGRAM CHECK OCCURED. IF A CHANNEL * 15300021 * PROGRAM CHECK OCCURED BECAUSE OF INSUFFICIENT BUFFERS, RETURN IS * 15600021 * MADE TO USER. * 15900021 * IF THE CHARACTERS WERE NOT IDENTICAL, THE LENGTH OF THIS * 16200013 * SEGMENT IS ADDED TO THE MESSAGE SUBTOTAL AT LCBERRCT (LCB + 78). * 16800013 * THIS NEW SUBTOTAL IS COMPARED AGAINST THE MAXIMUM MESSAGE LENGTH * 17400013 * SUPPLIED BY THE USER. IF THIS MESSAGE IS LONGER THAN THIS * 18000013 * MAXIMUM, THE RECEIVE BIT IS TURNED OFF. * 18600013 * A TEST IS MADE FOR END OF MESSAGE CHARACTER. IF IT HAS NOT * 19200013 * BEEN RECEIVED, CONTROL RETURNS TO THE CALLING ROUTINE. THIS * 19800013 * PORTION OF THE MODULE IS REPEATED UNTIL THE END OF MESSAGE * 20400013 * CHARACTER IS FOUND. * 21000013 * ONCE END OF MESSAGE IS FOUND, A TEST WILL BE MADE TO SEE * 21600013 * IF A PROGRAM CHECK HAS OCCURRED. THIS WILL ARISE FROM HAVING * 22200013 * THE RECEIVE BIT OFF, THUS NOT ALLOWING A BUFFER TO BE ASSIGNED. * 22800013 * A PROGRAM CHECK WILL NOT OCCUR IF THE MESSAGE IS ACCEPTABLE. IF * 23400013 * THE MESSAGE IS ACCEPTABLE, CONTROL RETURNS TO THE NEXT LPS * 24000013 * INSTRUCTION. * 24600013 * IF A PROGRAM CHECK HAS OCCURRED, HOUSEKEEPING IS PERFORMED * 25200013 * TO SET UP FOR THE WRITING OF BREAKOFF CHARACTERS. THE * 25800013 * UCB IS OBTAINED TO CHECK FOR 2848/2701. A READ SKIP/WRITE BREAK * 25900021 * IS SET UP FOR 2848/2701. FOR DIAL LINES A WRITE BREAK/DISABLE * 26000021 * IS SET UP IN THE CCWS IN THE BREAK OFF ROUTINE. THE * 26100021 * CHARACTERS ARE WRITTEN AND CONTROL IS PASSED TO THE LPS CONTROL * 26400013 * ROUTINE. * 27000013 * * 27600013 *ENTRY POINTS- * 28200013 * IECKBRKF - CONTROL IS PASSED HERE BY THE CODE GENERATED BY THE * 28800013 * EXPANSION OF THE BREAKOFF MACRO. REGISTER 15 HOLDS THE * 29400013 * ADDRESS OF THIS ENTRY POINT, AND REGISTER 14 HOLDS THE * 30000013 * RETURN ADDRESS. * 30600013 * * 31200013 *INPUT- * 31800013 * REGISTER 11- ADDRESS OF END OF SEGMENT. * 32400013 * REGISTER 14- RETURN ADDRESS REGISTER. * 33000013 * REGISTER 14 SERVES AS THE PARAMETER REGISTER, POINTING TO THE * 33600013 * HALFWORD CONTAINING THE MAXIMUM MESSAGE LENGTH SPECIFIED IN * 34200013 * THE BREAKOFF MACRO. * 34800013 * REGISTER 15- ENTRY POINT REGISTER. * 35400013 * * 36000013 *OUTPUT- * 36600013 * IF THE END OF MESSAGE HAS BEEN ENCOUNTERED, THE LCBERRCT FIELD * 37200013 * (LCB + 78) WILL HOLD THE TOTAL LENGTH OF THE MESSAGE. IF * 37800013 * END OF MESSAGE HAS NOT BEEN FOUND, THIS FIELD WILL HOLD * 38400013 * THE SUBTOTAL. * 39000013 * IF THE MESSAGE IS LONGER THAN THE MAXIMUM ALLOWABLE, OR IF * 39600013 * ALL CHARACTERS IN THAT SEGMENT ARE IDENTICAL, THE RECEIVE * 40200013 * BIT IN THE LCBSTATE FIELD WILL BE SET TO OFF. * 40800013 * OTHERWISE IT IS ON. * 41400013 * * 42000013 *EXTERNAL ROUTINES- * 42600013 * EXCP (SVC 0). * 43200013 * * 43800013 *EXITS- * 44400013 * NORMAL - RETURN IS TO THE NEXT LPS INSTRUCTION BY BRANCHING ON * 45000013 * REGISTER 14 AROUND THE MACRO GENERATED CONSTANT. * 45600013 * ERROR - CONTROL IS PASSED TO THE LPS CONTROL ROUTINE AFTER * 46200013 * BREAKOFF CHARACTERS ARE WRITTEN IF THE SEGMENT CONTAINS ALL * 46800013 * IDENTICAL CHARACTERS,OR IF THE TOTAL MESSAGE LENGTH IS * 47400013 * GREATER THAN THE MAXIMUM ALLOWABLE. * 48000013 * * 48600013 *TABLES/WORK AREAS- * 49200013 * NONE. * 49800013 * * 50400013 *ATTRIBUTES- * 51000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 51600013 * * 52200013 *NOTES- * 52800013 * REGISTER 4- BASE REGISTER FOR LCB. * 53400013 * REGISTER 9- WORK REGISTER. ADDRESS OF BEGINNING OF SEGMENT. * 54000013 * REGISTER 10- LENGTH OF TEXT IN SEGMENT - 2. * 54600013 * * 55200013 *********************************************************************** 55800013 IECKBRKF START 56400013 *1171783000-792000 00PS 56700016 *2540614000-616000,876700-880900,931000-934000 7766 56800017 *0300881100-881700,934400-935600 00PS 56900017 *A042000,153000-159000,259000-261000 S21016 56950021 SPACE 57000013 LCBREG EQU 4 57600013 MSREG EQU 6 58200013 WREG1 EQU 9 58800013 WREG2 EQU 10 59400013 EOSREG EQU 11 60000013 RREG1 EQU 14 60600013 SREG EQU 15 61200013 DCBDEBAD EQU 44 7766 61400017 DEBUCBAD EQU 32 7766 61600017 SPACE 61800013 USING IECKLCB0,LCBREG 62400013 USING IECKPREF,MSREG 63000013 USING *,SREG 63600013 SPACE 64200013 LA WREG1,TXSTRT+1 SET REGISTER TO START OF TEXT PLUS 1 64800013 TM MSTATUS,1 IS THIS A TEXT SEGMENT 65400013 BNZ TEXT BRANCH IF YES 66000013 LH WREG1,LCBTRST GET PREFIX SIZE PLUS ANY EXPANSION 66600013 * FOR TIME AND DATE STAMP 67200013 LA WREG1,MSEGSZE+1(WREG1) USING BASE OF MSREG GET ADDRESS 67800013 * OF 2ND BYTE IN HEADER FOLLOWING 68400013 * PREFIX AND ANY EXPANSION 69000013 TEXT LR WREG2,EOSREG GET END OF SEGMENT ADDRESS 69600013 SR WREG2,WREG1 COMPUTE LENGTH OF DATA MINUS TWO 70200013 BM TESTLNG IF NEGATIVE DONT COMPARE 70800013 BCTR WREG1,0 SET TO START OF DATA AFTER PREFIX 71400013 EX WREG2,COMPARE COMPARE EACH CHARACTER WITH PRECEDNG 72000013 BE ERROR BRANCH IF ALL CHARACTERS ARE EQUAL 72600013 SPACE 73200013 TESTLNG LA WREG2,2(WREG2) BUMP BY 2 TO GET DATA LENGTH 73800013 AH WREG2,LCBERCCW+6 ADD IN PREVIOUS MESSAGE COUNT 74400013 STH WREG2,LCBERCCW+6 TO ACCUMULATIVE LENGTH AND RESTORE 75000013 LH WREG1,0(0,RREG1) GET MAXIMUM LENGTH FROM THE USER 75600013 N WREG1,MASK IF MAXIMUM IS ZERO DO NOT COMPARE 76200013 BZ TESTPRCK BRANCH IF PASSED LENGTH IS ZERO 76800013 CLR WREG2,WREG1 HAS MAXIMUM LENGTH BEEN EXCEEDED 77400013 BNH TESTPRCK BRANCH IF NOT EXCEEDED 78000013 ERROR TM LCBSTART+2,1 HAS PROGRAM CHECK OCCURED DUE OOPS 78300016 BO 2(0,RREG1) TO INSUF BUFFERS. IF SO,RETURN OOPS 78600016 NI LCBSTATE,247 TURN OFF RECEIVE BIT TO STOP OOPS 78900016 * FURTHER BUFFER ASSIGNMENTS OOPS 79200016 * RELATED TO TEST FOR SEND IN LPSTART TO FORCE REENTRY TO BREAKOFF 79800013 SPACE 80400013 TESTPRCK TM MSTATUS,2 IS THIS END OF MESSAGE 81000013 BZ 2(0,RREG1) RETURN TO USER IF NO 81600013 TM LCBCSW+5,X'20' HAS INVALID TIC ADDRESS AS THE 82200013 * RESULT OF NO BUFFER CAUSED A 82800013 * PROGRAM CHECK 83400013 BZ 2(0,RREG1) RETURN TO USER IF NO 84000013 * CONTINUE TO RETURN TO USER UNTIL PROGRAM CHECK OCCURS 84600013 MVI LCBCECB,0 CLEAR READ INITIAL OP CODE 85200013 OI LCBERRST+1,X'20' SET BREAKOFF ERROR BIT 85800013 OI MSTATUS,32 SET EOB NOT LAST CHARACTER IN BUFFER 86400013 MVC LCBTRST,MSEGSZE GET MESSAGE SIZE TO EOB FOR TEXT 87000013 MVC LCBSTART,CCW+1 SET BREAK CCW ADDRESS INTO LCBSTART 87600013 L WREG1,LCBDCBPT OBTAIN DCB ADDRESS 7766 87670017 L WREG1,DCBDEBAD(WREG1) OBTAIN DEB ADDRESS 7766 87740017 L WREG1,DEBUCBAD(WREG1) GET UCB ADDR FOR LINE GROUP 7766 87810017 CLI 19(WREG1),X'82' IS THIS A 2848/2701 7766 87880017 BNE EXCP NO,CHANNEL PROGRAM OK 7766 87950017 MVC LCBSTART,CCW28+1 INDICATE SPECIAL BREAK FOR 7766 88020017 EXCP EQU * INTERRUPT HANDLING 7766 88090017 TM 17(WREG1),X'90' IS THIS A DIAL LINE 00PS 88110017 BZ SVC0 NO, CHANNEL PROGRAM OK 00PS 88130017 MVC LCBSTART,CCWTWX+1 ELSE DO WRITE BREAK, DISABLE 00PS 88150017 SVC0 EQU * 00PS 88170017 LA 1,LCBFLAG1 SET IOB ADDRESS IN REGISTER 1 88200013 SVC 0 EXCP TO CAUSE BREAKOFF CHARACTERS 88800013 * TO BE WRITTEN 89400013 L WREG1,0(0,13) GET ADDRESS OF LPS QUEUE IN IGG019NG 90000013 B 232(0,WREG1) BRANCH TO LPS CONTROL ROUTINE 90600013 SPACE 91200013 COMPARE CLC 0(1,WREG1),1(WREG1) COMPARE SUCCESSIVE CHARACTERS 91800013 MASK DC A(65535) 92400013 CCW CCW 13,CCW,0,21 CCW TO WRITE BREAK CHARACTERS 93000013 CCW28 DC X'42' 7766 93100017 DC AL3(CCW28) 7766 93200017 DC X'700003C0' READ SKIP FOR 2848 7766 93300017 DC X'41000001200003E8' WRITE BREAK FOR 2848 7766 93400017 CCWTWX DC X'0D' 00PS 93440017 DC AL3(CCWTWX) 00PS 93480017 DC X'40000015' 00PS 93520017 DC X'2F00000020000002' 00PS 93560017 EJECT 93600013 LCBD QTAM=3 94200013 EJECT 94800013 PREFIXD 95400013 END 96000013 ./ ADD SSI=01011610,NAME=IECKCHGT,SOURCE=0 TITLE 'IECKCHGT QTAM CHANGE TERMINAL TABLE (CHNGT)' 00400013 *********************************************************************** 00800013 * * 01200013 *NAME- * 01600013 * IECKCHGT QTAM CHANGE TERMINAL TABLE (CHNGT) * 02000013 * * 02400013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 02800013 * * 03200013 *FUNCTION- * 03600013 * IECHCHGT WILL REPLACE A TERMINAL TABLE ENTRY WITH A NEW * 04000013 * ENTRY SUPPLIED BY THE CALLING ROUTINE. * 04400013 * AFTER THE REGISTERS ARE SAVED, THE ADDRESS OF THE TERMINAL * 04800013 * TABLE IS LOADED INTO A WORK REGISTER. THE ADDRESS OF THE END * 05200013 * OF THE TABLE IS LOADED INTO ANOTHER WORK REGISTER, AND THE * 05600013 * ADDRESS OF THE FIRST ENTRY IN ANOTHER WORK REGISTER. THE TERMINAL* 06000013 * TABLE IS SEARCHED FOR THE PROPER TERMINAL ENTRY. IF THE ENTRY * 06400013 * IS NOT FOUND, A CODE OF X'20' IS SET IN REGISTER 15 AND CONTROL * 06800013 * RETURNS TO THE NEXT MESSAGE PROCESSING PROGRAM INSTRUCTION. * 07200013 * IF THE ENTRY IS FOUND, THE LENGTH OF THE NEW INFORMATION * 07600013 * IS COMPARED WITH THAT TABLE ENTRY. IF NOT EQUAL, A CODE OF X'10' * 08000013 * IS PASSED BACK TO THE CALLING ROUTINE. * 08400013 * IF THE QCB FOR THE TERMINAL TABLE IS NOT A DESTINATION * 08800013 * QUEUE, OR A STOPLN HAS BEEN ISSUED, THE CROSS PARTITION MOVE IS * 09200013 * EXECUTED TO ENTER THE NEW INFORMATION IN THE TERMINAL TABLE. * 09600013 * IF THE QCB IS A DESTINATION QUEUE, AND A STOPLN HAS NOT * 10000013 * BEEN ISSUED, THE MOVE IS MADE IN TWO OPERATIONS, PRESERVING THE * 10400013 * SEQUENCE NUMBER. * 10800013 * * 11200013 *ENTRY POINTS- * 11600013 * IECKCHGT - EXPANSION OF THE CHNGT MACRO GENERATES A BALR TO THIS * 12000013 * POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER, AND * 12400013 * REGISTER 14 AS THE RETURN ADDRESS REGISTER. * 12800013 * * 13200013 *INPUT- * 13600013 * REGISTER 0- CONTAINS THE ADDRESS OF THE CALLING ROUTINE'S WORK * 14000013 * AREA CONTAINING THE NEW TERMINAL TABLE ENTRY. * 14400013 * REGISTER 1- CONTAINS THE ADDRESS OF THE NAME OF THE TERMINAL * 14800013 * TABLE ENTRY TO BE CHANGED. * 15200013 * REGISTER 14- RETURN ADDRESS. * 15600013 * REGISTER 15- ENTRY POINT ADDRESS. * 16000013 * * 16400013 *OUTPUT- * 16800013 * IF NO ERRORS OCCUR, THE NEW ENTRY WILL BE IN THE TERMINAL * 17200013 * TABLE. * 17600013 * * 18000013 * * 18400013 *EXTERNAL ROUTINES- * 18800013 * QPOST (IGG067 IN MODULE IECKQQ01). * 19200013 * CROSS PARTITION MOVE (QMOVER + 6 IN MODULE IGG019NG). * 19600013 * * 20000013 *EXITS- * 20400013 * NORMAL - RETURN IS TO THE NEXT PROCESSING PROGRAM INSTRUCTION, * 20800013 * WITH RETURN CODE OF X'00' IN LOW ORDER BYTE OF REGISTER 15. * 21200013 * ERROR - SAME AS ABOVE, BUT WITH ONE OF THE FOLLOWING ERROR CODES * 21600013 * IN REGISTER 15: * 22000013 * X'10'- INVALID COUNT SPECIFIED * 22400013 * X'20'- INVALID TERMINAL TABLE ENTRY SPECIFIED. * 22800013 * * 23200013 *TABLES/WORK AREAS- * 23600013 * NONE. * 24000013 * * 24400013 *ATTRIBUTES- * 24800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 25200013 * * 25600013 *NOTES- * 26000013 * REGISTER 0- WORK REGISTER. WILL CONTAIN THE ADDRESS OF THE END * 26400013 * OF THE TERMINAL TABLE. * 26800013 * REGISTER 1- WORK REGISTER. WILL CONTAIN THE ADDRESS OF QMOVER. * 27200013 * REGISTER 2- WORK REGISTER. WILL CONTAIN THE ADDRESS OF THE * 27600013 * CALLING ROUTINE'S NEW ENTRY. * 28000013 * REGISTER 3- WORK REGISTER. WILL CONTAIN THE SIZE OF THE TERMINAL* 28400013 * TABLE ENTRY. * 28800013 * REGISTER 4- WORK REGISTER. WILL CONTAIN THE LENGTH OF THE TERMID* 29200013 * FIELD. * 29600013 * REGISTER 5- WORK REGISTER. WILL HOLD THE ADDRESS OF THE * 30000013 * COMMUNICATIONS VECTOR TABLE. * 30400013 * REGISTER 6- WORK REGISTER. WILL HOLD THE ADDRESS OF THE * 30800013 * TERMINAL TABLE. * 31200013 * REGISTER 7- WORK REGISTER. WILL HOLD THE ADDRESS OF IGG019NG. * 31600013 * REGISTER 8- WORK REGISTER. WILL HOLD THE ERROR FLAG. * 32000013 * * 32400013 *********************************************************************** 32800013 IECKCHGT START 33200013 R0 EQU 0 33600013 PLREG EQU 1 34000013 WORKREG EQU 2 34400013 XREG EQU 3 34800013 WREG EQU 4 35200013 RD EQU 5 35600013 TERMREG EQU 6 36000013 NGQUE EQU 7 36400013 FLAG EQU 8 36800013 MREG EQU 9 37200013 LCBREG EQU 9 37600013 DCBREG EQU 10 38000013 RLNR EQU 11 38400013 QCBREG EQU 12 38800013 RETURN EQU 14 39200013 SREG EQU 15 39600013 QPOST EQU 67 40000013 USING IECKTERM,TERMREG 40400013 USING QBLOCK,QCBREG 40800013 USING IHADCB,DCBREG 41200013 USING LCB,LCBREG 41600013 USING *,SREG 42000013 SAVE (14,12) 42400013 SR XREG,XREG CLEAR WORKING REGISTER 42800013 SR FLAG,FLAG CLEAR ERROR INDICATOR 43200013 L RD,CVTABLE(0,0) GET ADDRESS OF THE COMMUNICATIONS 43600013 * VECTOR TABLE (CVT) 44000013 L TERMREG,CVTTRMTB(0,RD) GET TERMTBL ADDRESS FROM CVT 44400013 LR WORKREG,R0 GET THE WORKAREA ADDRESS 44800013 L R0,0(0,TERMREG) GET END OF TABLE ADDRESS 45200013 IC WREG,4(0,TERMREG) GET LENGTH OF TERMID FIELD 45600013 L NGQUE,4(TERMREG) LOAD ADDRESS OF IGG019NG 46000013 L NGQUE,0(NGQUE) ADDRESS OF QUEUES 46400013 LA TERMREG,8(0,TERMREG) BUMP TO 1ST ENTRY IN TERMTBL 46800013 BCTR WREG,0 DECREMENT BY ONE FOR EXECUTE 47200013 LOOKUP EX WREG,COMPID CAUSE TERMNAME TO BE COMPARED 47600013 IC XREG,TNTRYSZE GET SIZE OF TERMTBL ENTRY 48000013 BNE LAST IF NOT EQUAL BRANCH 48400013 CLC 0(1,WORKREG),TNTRYSZE COMPARE ENTRY SIZES 48800013 BE LNGTHOK BRANCH IF NEW LENGTH EQUAL TO OLD 49200013 LA FLAG,X'10' ELSE SET ERROR FLAG 49600013 B RET AND RETURN TO USER 50000013 SPACE 50400013 COMPID CLC 0(1,PLREG),TERMID COMPARE TERMNAME TO TABLE TERMID 50800013 LAST CR TERMREG,R0 IS IT LAST ENTRY 51200013 BE INVALID BRANCH IF YES 51600013 CLI TNTRYSZE,0 IS SIZE EQUAL ZERO 52000013 BE INVALID BRANCH IF YES 52400013 LA TERMREG,0(XREG,TERMREG) ELSE BUMP TO NEXT ENTRY 52800013 B LOOKUP RELOOP TO LOOK AT NEXT ENTRY 53200013 SPACE 53600013 LNGTHOK LR WREG,TERMREG SET THE ADDRESS TO BE ALTERED 54000013 LR RD,WORKREG SET THE WORKAREA ADDRESS 54400013 L PLREG,284(NGQUE) LOAD ADDRESS OF QMOVE 54800013 LA PLREG,0(PLREG) CLEAR THE HIGH ORDER BYTE 55200013 LR WORKREG,PLREG LOAD QCB ADDRESS 55600013 L QCBREG,TQCBADDR-1 GET ADDRESS OF DESTINATION QUEUE QCB 56000013 CLI 8(QCBREG),X'68' IS THIS A DESTINATION QUEUE 56400013 * (MAY BE PROCESS QUEUE OR MESSAGE 56800013 * RESPONSE TRANSFER QUEUE) 57200013 BNE INACTIVE BRANCH IF NOT TERMINAL DESTINATION QUEUE 57600013 L DCBREG,QRLN GET RELATIVE LINE NUMBER (RLN) AND 58000013 * DCB ADDRESS FROM QCB 58400013 LR RLNR,DCBREG LOAD RLN REGISTER 58800013 SRL RLNR,24 AND SHIFT RLN TO LOW ORDER BYTE 59200013 SR MREG,MREG CLEAR WORK REGISTER 59600013 IC MREG,DCBEIOBX GET LCB/IOB SIZE FROM DCB 60000013 MR FLAG,RLNR GET LCB/IOB SIZE TIMES RLN 60400013 L FLAG,DCBLCBAD GET THE LCB ADDRESS 60800013 LA LCBREG,0(FLAG,MREG) ADD IN START OF LCB'S 61200013 SR FLAG,FLAG RESTORE ERROR REGISTER 61600013 CLI LCBSTATE,0 IS THE LINE ACTIVE 62000013 * IF STOPLINE HAS BEEN ISSUED FOR THIS LINE THEN THE MESSAGE 62400013 * SEQUENCE NUMBERS IN THE TERMTBL ENTRY WILL NOT HAVE BEEN 62800013 * INCREMENTED SINCE THE ENTRY WAS COPIED INTO THE WORKAREA. 63200013 * THEREFORE THE ENTIRE ENTRY CAN BE CHANGED WITH ONE MOVE. IF 63600013 * STOPLINE HAS NOT BEEN ISSUED THE SEQUENCE NUMBERS MAY HAVE 64000013 * BEEN INCREMENTED SINCE THE ENTRY WAS COPIED INTO THE WORKAREA, 64400013 * SO THE MOVE MUST NOT DESTROY THE NEW SEQUENCE NUMBERS. THEREFORE 64800013 * THE CHANGE IS MADE IN 2 MOVES LEAVING THE SEQUENCE NUMBERS INTACT. 65200013 BE INACTIVE BRANCH IF LINE NOT ACTIVE 65600013 LA XREG,2 GET LENGTH-2 FOR EXECUTE MOVE 66000013 * (THE LENGTH BYTE IS NOT MOVED 66400013 * THEREFORE THE FOLLOWING RESULTS 66800013 * IN TQCBADDR BEING CHANGED) 67200013 SVC QPOST POST QCB TO ITSELF RESULTING IN MOVE 67600013 LA RD,7(RD) BYPASS SEQUENCE NUMBERS IN WORKAREA 68000013 LA WREG,7(WREG) BYPASS SEQUENCE NUMBERS IN ENTRY 68400013 IC XREG,TNTRYSZE GET SIZE OF TABLE ENTRY 68800013 LA XREG,256+TNTRYSZE-TERMID(XREG) SUBTRACT 9 FOR REMAINDER 69200013 SVC QPOST POST QCB TO ITSELF RESULTING IN MOVE 69600013 B RET RETURN TO USER 70000013 INACTIVE IC XREG,TNTRYSZE GET ENTRY SIZE 70400013 BCTR XREG,0 DECREMENT LENGTH FOR EXECUTE MOVE 70800013 BCTR XREG,0 DECREMENT SO THAT TNTRYSZE (LENGTH) 71200013 * IS NOT DISTURBED 71600013 SVC QPOST POST QCB TO ITSELF RESULTING IN MOVE 72000013 B RET RETURN TO USER 72400013 SPACE 72800013 INVALID LA FLAG,X'20' SET ERROR FOR INVALID TERMINAL 73200013 * TABLE ENTRY 73600013 RET LR SREG,FLAG SET USER'S ERROR INDICATOR 74000013 RETURN (0,12) AND RETURN TO THE USER 74400013 SPACE 74800013 CVTABLE EQU 16 75200013 CVTTRMTB EQU 156 75600013 SPACE 2 76000013 * THE FOLLOWING ERROR INDICATORS ARE SET FOR THE USER IN THIS ROUTINE 76400013 * AND ARE RIGHT ADJUSTED IN REGISTER 15 76800013 * X'00' NO ERRORS 77200013 * X'10' INVALID COUNT SPECIFIED IN WORKAREA 77600013 * X'20' INVALID TERMINAL TABLE ENTRY SPECIFIED 78000013 EJECT 78400013 TERMTBLD 78800013 EJECT 79200013 QCBD 79600013 EJECT 80000013 DCBD DSORG=(QX) 80400013 EJECT 80800013 LCBD 81200013 END 81600013 ./ ADD SSI=01011610,NAME=IECKCHPL,SOURCE=0 TITLE 'IECKCHPL QTAM CHANGE POLLING LIST (CHNGP)' 00500013 *********************************************************************** 01000013 * * 01500013 * * 02000013 *NAME- * 02500013 * IECKCHPL QTAM CHANGE POLLING LIST (CHNGP) * 03000013 * * 03500013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04000013 * * 04500013 *FUNCTION- * 05000013 * IECKCHPL WILL PLACE A NEW POLLING LIST INTO THE POLLING LIST * 05500013 * AREA SPECIFIED FOR THE LINE OR CHANGES THE LINE STATUS WITH * 06000013 * REGARD TO POLLING. * 06500013 * THE ADDRESS OF THE SPECIFIED DCB IS USED AS A BASE * 07000013 * REGISTER TO ALLOW SYMBOLIC REFERENCE TO FIELDS IN THAT DCB. * 07500013 * A TEST IS MADE TO SEE IF THAT DCB IS OPEN. IF IT IS NOT OPEN, * 08000013 * AN ERROR INDICATOR OF X'01' IS RETURNED TO THE CALLING ROUTINE * 08500013 * IN REGISTER 15. CONTROL IS PASSED TO THE NEXT MESAGE PROCESSING * 09000013 * PROGRAM INSTRUCTION. * 09500013 * IF THE DCB IS OPEN, THE SPECIFIED RLN (RELATIVE LINE * 10000013 * NUMBER) IS CHECKED AGAINST THE HIGHEST RLN FOR THAT DCB TO * 10500013 * BE SURE THAT THE LINE EXISTS. IF THE SPECIFIED RLN IS TOO HIGH, * 11000013 * AN ERROR INDICATION OF X'08' IS RETURNED IN REGISTER 15. CONTROL * 11500013 * IS PASSED TO THE NEXT MESSAGE PROCESSING PROGRAM INSTRUCTION. * 12000013 * IF THE RLN IS VALID, THE ADDRESS OF THE DCB IS SHIFTED OUT * 12500013 * OF THE WORK REGISTER. RLN IS MULTIPLIED BY 4 AND ADDED TO THE * 13000013 * DCB BASE REGISTER , THUS HAVING THE DCB BASE REGISTER POINT TO * 13500013 * THE NAME OF THE POLLING LIST. * 14000013 * A TEST IS MADE TO SEE IF ONLY THE STATUS BYTES ARE TO BE * 14500013 * CHANGED. IF THE CALLING ROUTINE WANTS A NEW POLLING LIST, THE 15000013 * LENGTH OF THE NEW LIST IS COMPARED WITH THE LENGTH OF THE OLD. * 15500013 * IF THEY ARE NOT EQUAL, AN ERROR INDICATION OF X'10' IS PASSED BACK* 16000013 * IN THE LOW ORDER BYTE OF REGISTER 15. CONTROL PASSES TO THE * 16500013 * NEXT MESSAGE PROCESSING PROGRAM INSTRUCTION. * 17000013 * IF THE LENGTHS ARE EQUAL, OR IF MERELY THE STATUS CHARACTERS * 17500013 * ARE TO BE MODIFIED, CONTROL IS SET UP FOR THE CROSS PARTITION * 18000013 * MOVE NECESSARY TO GET THE INFORMATION FROM THE MESSAGE PROCESSING * 18500013 * PARTITION TO THE MESSAGE CONTROL. * 19000013 * AFTER THE MOVE IS COMPLETED, CONTROL IS RETURNED TO THE NEXT * 19500013 * MESSAGE PROCESSING PROGRAM INSTRUCTION. * 20000013 * * 20500013 * * 21000013 *ENTRY POINTS- * 21500013 * IECKCHPL - CONTROL IS PASSED HERE BY A BALR IN THE EXPANSION OF * 22000013 * THE CHNGP MACRO. REGISTER 15 IS THE ENTRY POINT REGISTER * 22500013 * AND REGISTER 14 IS THE RETURN POINT REGISTER. * 23000013 * * 23500013 *INPUT- * 24000013 * REGISTER 0- WILL CONTAIN THE ADDRESS OF THE DCB FOR THIS LINE * 24500013 * GROUP IN THE LOW ORDER THREE BYTES, AND THE RLN IN THE HIGH * 25000013 * ORDER BYTE. * 25500013 * REGISTER 1- WILL POINT TO EITHER THE NEW POLLING LIST, IF THE * 26000013 * ENTIRE POLLING LIST IS TO BE CHANGED, OR TO THE NEW STATUS * 26500013 * BYTE WHICH IS TO BE INSERTED IN THE PRESENT POLLING LIST. * 27000013 * REGISTER 14- RETURN ADDRESS. * 27500013 * REGISTER 15- ENTRY POINT ADDRESS. * 28000013 * * 28500013 *OUTPUT- * 29000013 * THE POLLING LIST FOR THE LINE SPECIFIED WILL BE MODIFIED AS * 29500013 * HAS BEEN SPECIFIED. * 30000013 * IF ERRORS RESULT FROM IMPROPER INFORMATION, ONE OF THE * 30500013 * FOLLOWING ERROR FLAGS WILL BE SET IN THE LOW ORDER * 31000013 * BYTE OF REGISTER 15. * 31500013 * X'01'- DCB HAS NOT BEEN OPENED * 32000013 * X'08'- INVALID RLN SPECIFIED * 32500013 * X'10'- INVALID LENGTH SPECIFIED * 33000013 * IF THERE WERE NO ERRORS, A CODE OF X'00' IS RETURNED. * 33500013 * * 34000013 *EXTERNAL ROUTINES- * 34500013 * QPOST (IGG067 IN MODULE IECKQQ01). * 35000013 * CROSS PARTITION MOVE (QMOVER+6 IN MODULE IGG019NG). * 35500013 * * 36000013 *EXITS- * 36500013 * NORMAL - RETURN IS TO THE NEXT MESSAGE PROCESSING PROGRAM * 37000013 * INSTRUCTION WITH A X'00' IN REGISTER 15. RETURN IS MADE VIA * 37500013 * A RETURN MACRO. * 38000013 * ERROR - SAME AS ABOVE, BUT WITH ERROR INDICATION IN REGISTER 15. * 38500013 * * 39000013 *TABLES/WORK AREAS- * 39500013 * NONE. * 40000013 * * 40500013 *ATTRIBUTES- * 41000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 41500013 * * 42000013 *NOTES- * 42500013 * REGISTER 1- USED TO GET ADDRESS OF QMOVER. * 43000013 * REGISTER 3- WORK REGISTER. WILL CONTAIN NUMBER OF CHARACTERS * 43500013 * TO BE MOVED. * 44000013 * REGISTER 4- WORK REGISTER. WILL HOLD THE ADDRESS OF THE POLLING * 44500013 * LIST TO BE MODIFIED. * 45000013 * REGISTER 5- WORK REGISTER. WILL POINT TO NEW POLLING LIST OR * 45500013 * NEW STATUS CHARACTERS. * 46000013 * REGISTER 6- BASE REGISTER FOR DCB. * 46500013 * REGISTER 7- WORK REGISTER. WILL HOLD THE CONDITION CODE FLAG. * 47000013 * * 47500013 *********************************************************************** 48000013 IECKCHPL START 48500013 R0 EQU 0 49000013 R1 EQU 1 49500013 WREG EQU 3 50000013 POLLREG EQU 4 50500013 FROMREG EQU 5 51000013 DCBREG EQU 6 51500013 FLAG EQU 7 52000013 RETURN EQU 14 52500013 SREG EQU 15 53000013 DEBEXT EQU 16 53500013 QPOST EQU 67 54000013 CVTTRMTB EQU 156 54500013 USING IHADCB,DCBREG 55000013 USING POLLIST,POLLREG 55500013 USING *,SREG 56000013 SAVE (14,12) 56500013 LR DCBREG,0 REGISTER 0 HAS THE DCB ADDRESS WITH 57000013 * THE RELATIVE LINE NUMBER (RLN) IN 57500013 * THE HIGH ORDER BYTE 58000013 LA FLAG,X'01' LOAD USER'S NOT OPEN ERROR FLAG 58500013 TM DCBOFLGS,X'10' HAS THE DCB BEEN OPENED 59000013 BNO RET BRANCH IF NO 59500013 * RETURN SINCE NO DEB AVAILABLE 60000013 SR FLAG,FLAG CLEAR ERROR INDICATOR 60500013 OPND L WREG,DCBDEBAD GET DEB ADDRESS FROM THE DCB 61000013 CLC 20(1,13),DEBEXT(WREG) IS PASSED RLN TOO HIGH 61500013 BNH NORLNERR BRANCH IF NO 62000013 LA FLAG,X'08' SET INVALID RLN ERROR FLAG 62500013 B RET RETURN TO USER 63000013 * RLN IS IN HIGH ORDER BYTE OF R0 63500013 NORLNERR SRL R0,24 SHIFT OUT DCB ADDRESS 64000013 SLL R0,2 R0 HAS 4(RLN) 64500013 AR DCBREG,R0 GET DCB+4(RLN) IN DCBREG 65000013 L POLLREG,DCBCPOLL-4 GET THE ADDRESS OF THE POLLING LIST 65500013 * FROM THE DCB USING DCBREG AS THE 66000013 * BASE FOR DCBCPOLL 66500013 SR WREG,WREG CLEAR WORKING REGISTER 67000013 TM 0(R1),X'F0' TEST FOR CHANGE STATUS ONLY 67500013 * IF CHANGE STATUS INDICATED, R1 68000013 * POINTS TO THE STATUS BYTE 68500013 BO GO BRANCH IF STATUS CHANGE 69000013 SPACE 69500013 * IF NOT STATUS CHANGE, R1 POINTS 70000013 * TO SIZE OF NEW LIST 70500013 CHANGE CLC POLLSZE,0(R1) IS NEW LIST LENGTH EQUAL TO OLD 71000013 BNE ERR BRANCH IF NO 71500013 IC WREG,0(R1) ELSE GET SIZE OF LIST FOR MOVE 72000013 * (THE LENGTH BYTE WILL NOT BE DISTURBED IN THE MOVE) 72500013 BCTR WREG,0 DECREMENT FOR EXECUTE 73000013 BCTR WREG,0 DECREMENT TO START IN 2ND POSITION 73500013 GO LR FROMREG,R1 SET THE FROM ADDRESS FOR MOVE 74000013 L R1,16 LOAD COMM. VECTOR TABLE ADDRESS 74500013 L R1,CVTTRMTB(R1) ADDRESS OF TERM TABLE 75000013 L R1,4(R1) ADDRESS OF IGG019NG 75500013 L R1,0(R1) ADDRESS OF QUEUES IN NG 76000013 L R1,284(R1) ADDRESS OF QMOVE 76500013 LA R1,0(R1) CLEAR HIGH ORDER 77000013 LR 2,R1 SET MOVE DATA QCB ADDRESS 77500013 SVC QPOST POST QMOVER QCB TO ITSELF THUS 78000013 * CAUSING MOVE TO BE EXECUTED 78500013 B RET RETURN TO USER 79000013 SPACE 79500013 ERR LA FLAG,X'10'(FLAG) INDICATE INVALID LENGTH 80000013 RET LR 15,FLAG LOAD ERROR INDICATOR 80500013 RETURN (0,12) RETURN TO USER 81000013 SPACE 2 81500013 * THE FOLLOWING ERROR INDICATORS ARE SET FOR THE USER IN THIS ROUTINE 82000013 * AND ARE RIGHT ADJUSTED IN REGISTER 15 82500013 * X'00' NO ERRORS 83000013 * X'01' DCB HAS NOT BEEN OPENED 83500013 * X'08' PASSED RELATIVE LINE NUMBER TOO HIGH 84000013 * X'10' INVALID LENGTH SPECIFIED 84500013 EJECT 85000013 DCBD DSORG=(QX) 85500013 EJECT 86000013 POLLIST DSECT 86500013 POLLSZE DS FL1 INDICATES POLLING LIST LENGTH 87000013 POLLSTAT DS FL1 INDICATES STATUS OF POLLING LIST 87500013 END 88000013 ./ ADD SSI=00011670,NAME=IECKCKRQ,SOURCE=0 TITLE ' IECKCKRQ - QTAM CHECK POINT REQUEST ROUTINE ' 01000013 IECKCKRQ START 02000013 * 03000013 * REGISTER EQUATES 04000013 * 05000013 R0 EQU 0 06000013 FREG EQU 1 07000013 TREG EQU 2 08000013 CPREG EQU 4 09000013 WK EQU 5 10000013 BASE EQU 12 11000013 RET EQU 14 12000013 CODE EQU 15 13000013 EJECT 14000013 * 15000013 * EQUATED OFFSETS 16000013 * 17000013 LPS EQU 0 18000013 CVTTCB EQU 0 19000013 WAIT EQU 1 20000013 CURTCB EQU 4 21000013 ERRCD1 EQU 1 RETURN CODE FOR DIRECT ACCESS DEVICE NOT OPEN 22000013 ERRCD2 EQU 2 RETURN CODE FOR CHECK POINT INTERVAL SPECIFIED 23000013 ERRCD4 EQU 4 RETURN CODE FOR CHECK POINT DEVICE NOT OPENED 24000013 NGAD EQU 4 25000013 TCB EQU 8 26000013 CVT EQU 16 27000013 CKQPT EQU 28 28000013 QPOST EQU 67 29000013 TERM EQU 156 30000013 CPFLAG EQU 304 31000013 EJECT 32000013 USING *,BASE 33000013 SAVE (0,12) 34000013 LR BASE,CODE LOAD BASE REGISTER 35000013 * 36000013 * STORE TCB ADDRESS IN THE PARAMETER LIST 37000013 * 38000013 L WK,CVT ADDRESS OF THE CVT 39000013 L CODE,CVTTCB(WK) ADDRESS OF THE TCB LIST 40000013 L CODE,CURTCB(CODE) ADDRESS OF THE CURRENT TCB 41000013 ST CODE,TCB(FREG) TCB ADDRESS TO THE PARAMETER LIST 42000013 * 43000013 * RETURN WITH ERROR CODE IF QTAM DIRECT ACCESS DEVICE NOT OPEN 44000013 * 45000013 L WK,TERM(WK) ADDRESS OF THE TERM TABLE 46000013 LA CODE,ERRCD1 ERROR CODE DIRECT ACCESS NOT OPEN 47000013 LR R0,CODE SET WAIT COUNT FOR LATER USE 48000013 LTR WK,WK WAS TERM TABLE ADDRESS IN THE CVT 49000013 BZ RETURN BRANCH IF NO 50000013 * 51000013 * RETURN WITH ERROR CODE IF CHECK POINT INTERVAL BEING USED 52000013 * 53000013 LA CODE,ERRCD2 ERROR CODE INTERVAL BEING USED 54000013 SH WK,CON4 BACK UP TO TERM TABLE MINUS FOUR 55000013 TM 0(WK),128 CHECK REQUEST ALLOWED FLAG 56000013 BZ RETURN BRANCH NOT SET (INTERVAL BEING USED) 57000013 * 58000013 * RETURN WITH ERROR CODE IF CHECK POINT DEVICE NOT OPEN 59000013 * 60000013 LA CODE,ERRCD4 ERROR CODE CHECK POINT DEVICE NOT OPN 61000013 L WK,NGAD+4(WK) ADDRESS OF IGG019NG 62000013 L WK,LPS(WK) ADDRESS OF LPS QUEUE IN IGG019NG 63000013 L WK,CPFLAG(WK) ADDRESS OF THE CHECK POINT ROUTINE 64000013 LA WK,0(WK) CLEAR THE HIGH ORDER BYTE 65000013 LTR WK,WK IS ADDRESS ZERO 66000013 BZ RETURN BRANCH IF YES (CHECK POINT NOT OPEN) 67000013 * 68000013 * POST REQUEST FOR CHECK POINT 69000013 * 70000013 L TREG,CKQPT(WK) ADDRESS OF THE REQUEST CK-PT QUEUE 71000013 LA FREG,0(FREG) CLEAR THE HIGH ORDER BYTE 72000013 ST FREG,0(FREG) ZERO ECB FOR WAIT ROUTINE 73000013 SVC QPOST 74000013 * 75000013 * NOW WAIT FOR THE CHECK POINT TO COMPLETE 76000013 * 77000013 SVC WAIT 78000013 * 79000013 * RETURN TO THE CALLER 80000013 * 81000013 SR CODE,CODE ZERO THE RETURN CODE 82000013 RETURN RETURN (0,12) 83000013 CON4 DC H'4' 84000013 END 85000013 ./ ADD SSI=02013160,NAME=IECKCLOS,SOURCE=0 TITLE 'QTAM CLOSE ROUTINE (CLOSEMC)' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKCLOS QTAM CLOSE ROUTINE (CLOSEMC) * 03000013 * * 03600013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04200013 * * 04800013 *FUNCTION- * 05400013 * IECKCLOS WILL CLOSE DOWN THE SYSTEM FOR INCOMING MESSAGES, * 06000013 * AND ALLOW THE REMAINING MESSAGES TO BE SENT. * 06600013 * THE ADDRESS OF THE LPS ROUTINE IS OBTAINED THROUGH THE * 07200013 * COMMUNICATIONS VECTOR TABLE, TERMINAL TABLE, AND THE * 07800013 * IMPLEMENTATION MODULE. THE ADDRESS OF THE MASTER RECEIVE SWITCH * 08400013 * IS GAINED FROM THE FIXED LOCATION PART OF IGG019NG. THE QMOVE * 09000013 * ROUTINE IS USED TO TURN OFF THE MASTER RECEIVE SWITCH BY MOVING * 09600013 * A MASK INTO THE SWITCH. THE SYSTEM WILL NOW ACCEPT NO MORE * 10200013 * INCOMING TRANSMISSIONS. * 10800013 * THE TCB FOR MESSAGE CONTROL IS USED TO OBTAIN THE ADDRESS * 11400013 * OF THE DEB CHAIN. FOR EACH DEB ON THE CHAIN. THE ASSOCIATED DCB * 12000013 * IS REFERENCED. IF THE DCB IS NOT FOR A COMMUNICATION LINE, IT * 12600013 * IS IGNORED AND THE NEXT IS OBTAINED FROM THE CHAIN. * 13200013 * IF THE DEB IS FOR A LINE, EACH LCB IS ACCESSED. IF THE LINE * 13800013 * FOR THE LCB IS ACTIVE, THE ROUTINE ISSUES A STOPLN MACRO TO * 14400013 * STOP THE LINE. THEN A STARTLN MACRO IS ISSUED TO PUT OUT ALL * 15000013 * MESSAGES FOR THAT LINE. ONLY THE LINES FOR OUTPUT WILL BE * 15600013 * STARTED, AS THE MASTER RECEIVE SWITCH HAS BEEN TURNED OFF. * 16200013 * IF THE LINE IS NOT ACTIVE. THE NEXT LCB IS ACCESSED. * 16800013 * WHEN THE END OF THE DEB CHAIN IS REACHED, THE ROUTINE * 17400013 * RETURNS CONTROL TO THE NEXT MESSAGE PROCESSING PROGRAM INSTRUCT- * 18000013 * ION. * 18600013 * * 19200013 *ENTRY POINTS- * 19800013 * IECKCLOS - THE EXPANSION OF THE CLOSEMC MACRO GENERATES A BLAR * 20400013 * TO THIS POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER * 21000013 * AND REGISTER 14 AS THE RETURN ADDRESS. * 21600013 * * 22200013 *INPUT- * 22800013 * REGISTER 14- RETURN ADDRESS. * 23400013 * REGISTER 15- ENTRY POINT ADDRESS. * 24000013 * * 24600013 *OUTPUT- * 25200013 * NONE. * 25800013 * * 26400013 *EXTERNAL ROUTINES- * 27000013 * QPOST (IGG067 IN MODULE IECKQQ01). * 27600013 * LINE CHANGE ( IN MODULE IECKLNCH). * 28200013 * CROSS PARTITION MOVE (QMOVER + 6 IN MODULE IGG019NG). * 28800013 * * 29400013 *EXITS- * 30000013 * NORMAL - CONTROL RETURNS TO THE CALLING ROUTINE THRU THE ISSUING * 30600013 * OF A RETURN MACRO. * 31200013 * ERROR - NONE. * 31800013 * * 32400013 *TABLES/WORK AREAS- * 33000013 * AREA - 18 WORD SAVE AREA. * 33600013 * * 34200013 *ATTRIBUTES- * 34800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 35400013 * * 36000013 *NOTES- * 36600013 * REGISTER 1- ADDRESS OF QMOVER. * 37200013 * REGISTER 2- ADDRESS OF THE TERMINAL TABLE. * 37800013 * REGISTER 3- SIZE OF AN LCB. * 38400013 * REGISTER 4- ADDRESS OF MASTER RECEIVE SWITCH. * 39000013 * REGISTER 5- ADDRESS OF MASK TO TURN SWITCH OFF. * 39600013 * REGISTER 6- COUNT OF CHARACTERS TO BE MOVED. * 40200013 * REGISTER 7- BASE FOR DCB. * 40800013 * REGISTER 8- BASE FOR DEB. * 41400013 * REGISTER 12- BASE FOR THIS ROUTINE. * 42000013 * REGISTER 13- POINTER TO THIS ROUTINES SAVE AREA. * 42600013 * * 43200013 *********************************************************************** 43800013 IECKCLOS START 44400013 *3160810000 000A 44700018 FREG EQU 1 45000013 TREG EQU 2 45600013 RD EQU 3 46200013 RB EQU 4 46800013 RC EQU 5 47400013 RA EQU 6 48000013 RDCB EQU 7 48600013 RDEB EQU 8 49200013 RBASE EQU 12 49800013 RSAVE EQU 13 50400013 QPOST EQU 67 51000013 CVTABLE EQU 16 51600013 CVTTRMTB EQU 156 52200013 TTQUES EQU 4 52800013 USING IHADCB,RDCB 53400013 USING IECTDEB+36,RDEB 54000013 SAVE (14,12) 54600013 BALR RBASE,0 55200013 USING *,RBASE 55800013 ST RSAVE,AREA+4 SAVE REGISTER 13 56400013 LA RSAVE,AREA FOR THIS ROUTINE 57000013 L TREG,CVTABLE ACCESS CVT 57600013 L TREG,CVTTRMTB(0,TREG) ACCESS QTAM TERMINAL TABLE 58200013 L RA,TTQUES(0,TREG) ACCESS IMPLEMENTATION MODULE 58800013 L RA,0(0,RA) ACCESS FIXED AREA 59400013 * THE FOLLOWING CODE CAUSES THE QMOVE STCB TO TURN OFF THE 60000013 * MASTER RECEIVE SWITCH 60600013 L TREG,284(0,RA) SET UP QMOVE AS A QCB 61200013 LR FREG,TREG SET UP QMOVE AS AN ELEMENT 61800013 LA RB,287(0,RA) SET ADDRESS OF MASTER RECEIVE 62400013 * SWITCH-1 AS PARAMETER IN REG4 63000013 BAL RC,*+6 LOAD ADDRESS OF MASK TO CHANGE 63600013 * SWITCH IN REG 5 64200013 DC X'0000' MASK USES BITS 4-7 ONLY 64800013 SR RD,RD COUNT=0 INDICATES HALF-BYTE CHNG 65400013 SVC QPOST POST QMOVE TO ITSELF 66000013 * AT THIS POINT NO NEW RECEIVE OPERATIONS CAN BE STARTED 66600013 * THE FOLLOWING CODE ISSUES A STOPLN MACRO AND THEN STRTLN MACRO TO 67200013 * EACH ACTIVE COMMUNICATION LINE 67800013 USING IECKLCB0,RC 68400013 L RDEB,288(0,RA) ACCESS TCB FOR MESSAGE CONTROL 69000013 LA RDEB,4(0,RDEB) INITIALIZE FOR FIRST DEB 69600013 NEXTDEB EQU * 70200013 L RDEB,4(0,RDEB) ACCESS DEB 70800013 LA RDEB,0(RDEB) CLEAR THE HIGH ORDER BYTE 71400013 LTR RDEB,RDEB END OF DEB CHAIN 72000013 BZ CXEOL YES 72600013 L RDCB,DEBDCBAD-1 NO,ACCESS RELATED DCB 73200013 TM DCBDSORG,X'10' IS DATASET ORG FOR COMMUNICATION-73800013 LINE 74400013 BZ NEXTDEB NO 75000013 MVI EXTCOMP,0 SET COUNT OF EXTENTS = 0 75600013 L RC,DCBLCBAD START OF LCB AREA-SIZE OF LCB 76200013 NEXTEXT EQU * 76800013 IC RD,DCBEIOBX SIZE OF AN LCB 77400013 LA RC,0(RD,RC) START OF LCB AREA 78000013 IC RD,EXTCOMP INCREMENT THE COUNT 78600013 LA RD,1(0,RD) OF EXTENTS (LCB'S) 79200013 STC RD,EXTCOMP FOR THIS DEB 79800013 CLI LCBSTATE,0 IS LINE ACTIVE 80400013 BE BYPASS BRANCH IF NO 000A 80700018 TM LCBSTATE,X'04' IS LINE SENDING 000A 81000018 BO BYPASS BRANCH IF YES 000A 81300018 STOPLN (RDCB),(RD) STOP THE LINE TRANSMISSION 81600013 * AT THIS POINT BOTH INPUT AND OUTPUT OPERATIONS WILL BE STOPPED 82200013 STARTLN (RDCB),(RD) RESTART THE LINE TRANSMISSION 82800013 * ONLY OUTPUT OPERATIONS WILL BE RESTARTED 83400013 BYPASS EQU * 84000013 CLC EXTCOMP(1),DEBNMEXT IS THIS THE LAST EXTENT 84600013 BE NEXTDEB YES 85200013 B NEXTEXT NO 85800013 CXEOL EQU * 86400013 L RSAVE,AREA+4 RESTORE REGISTER 13 87000013 RETURN (14,12) 87600013 EXTCOMP DC X'00' 88200013 AREA DS 18F 88800013 EJECT 89400013 DCBD DSORG=CX 90000013 EJECT 90600013 IECTDEBX 91200013 EJECT 91800013 LCBD 92400013 END 93000013 ./ ADD SSI=03013244,NAME=IECKCNCL,SOURCE=0 TITLE 'IECKCNCL QTAM CANCEL MESSAGE (CANCELM)' 00800013 *********************************************************************** 01600013 * * 02400013 *NAME- * 03200013 *STATUS- CHANGE LEVEL= 19 JANUARY 1971 * 04000021 * * 04800013 *FUNCTION- * 05600013 * CAUSES A MESSAGE TO BE CANCELLED WHEN ANY OF THE ERROR * 06400013 * CONDITIONS SPECIFIED IN THE CALLING ROUTINES ERROR MASK IS * 07200013 * INDICATED IN THE ERROR HALF WORD AT LCBERRST (LCB+40), OR IF THE * 08000013 * MASK IS ZERO. IF THE MASK IS NOT ZERO AND NONE OF THE ERROR * 08800013 * CONDITIONS SPECIFIED BY THE MASK ARE INDICATED, RETURN IS TO THE * 09600013 * NEXT LPS INSTRUCTION. * 10400013 * IF THE ERROR MASK WAS ZERO, OR ANY OF THE SPECIFIED ERRORS * 11200013 * WERE DETECTED, AND IF THERE WAS NOT A DESTINATION ERROR CODE SET * 12000013 * IN LCBERRST, THEN LINKAGE IS MADE TO THE RECALL ROUTINE TO OBTAIN * 12800013 * THE HEADER. THEN THE CANCEL BIT IS SET TO A ONE IN THE MSTATUS * 13600013 * FIELD OF THE HEADER PREFIX (PREFIX + 12 IS OR'ED WITH A X'80'). * 14400013 * IF THE INVALID DESTINATION BIT IS ON IN THE ERROR HALFWORD, THE * 14500021 * CANCEL BIT IS NOT SET BUT THE SERVICE BIT IS SET (X'10 IN * 14600021 * MSTATUS). * 14700021 * IF THE SERVICE BIT IS SET IN MSTATUS, QSIZE IS NOT ADJUSTED. * 14800021 * OTHERWISE, THE QCB ADDRESS IS OBTAINED FROM THE TERMINAL TABLE * 14900021 * ENTRY SPECIFIED IN TTDKEY. QSIZE IN THE QCB IS DECREMENTED BY * 15000021 * ONE. * 15100021 * AFTER THE CANCEL BIT IS SET OR IF THERE WAS A DESTINATION * 15200013 * ERROR, THE PREVIOUS SEQUENCE NUMBER IS OBTAINED FROM MSNUMIN * 16000021 * (BUFFER + 28) AND IS STORED IN THE TSEQUIN FIELD OF * 16800021 * THE TERMINAL TABLE AT THE TABLE ENTRY + 4 UNLESS IT IS ZERO. * 17600013 * THE LCBMPLRT FIELD AT LCB + 32 IS MADE ZERO TO CANCEL THE * 18400013 * MULTIPLE ROUTING OPTION AND THE CONVERSATIONAL MODE BIT IN THE * 19200013 * LCB IS SET TO ZERO (LCBSTATE AT LCB + 0 IS AND'ED WITH A X'DF') * 20000013 * BEFORE RETURNING TO THE NEXT LPS INSTRUCTION. * 20800013 * * 21600013 *ENTRY POINTS- * 22400013 * IECKCNCL - EXPANSION OF THE CANCELM MACRO GENERATES A BALR TO * 23200013 * THIS POINT USING REGISTER 15 AS THE ENTRY POINT * 24000013 * REGISTER AND REGISTER 14 AS THE RETURN REGISTER. * 24800013 * * 25600013 *INPUT- * 26400013 * REGISTER 4- ADDRESS OF THE LCB. * 27200013 * REGISTER 6- BUFFER ADDRESS. * 28000013 * REGISTER 8- TERMINAL TABLE SOURCE ENTRY. * 28800013 * REGISTER 14- RETURN ADDRESS. * 29600013 * REGISTER 14 ALSO SERVES AS A PARAMETER LIST REGISTER. * 30400013 * THE PARAMETER LIST CONSISTS OF A HALF WORD ERROR MASK * 31200013 * SPECIFIED AS AN OPERAND IN THE CANCELM MACRO. * 32000013 * REGISTER 15- ENTRY POINT. * 32800013 * * 33600013 *OUTPUT- * 34400013 * THE CANCEL BIT IN THE PREFIX WILL BE SET TO A ONE UNLESS THERE * 35200013 * WAS A DESTINATION ERROR. THE SEQUENCE NUMBER WILL BE * 36000013 * STORED IN THE TSEQUIN FIELD OF THE TERMINAL TABLE ENTRY* 36800013 * UNLESS IT IS ZERO. THE MULTIPLE ROUTING BYTE WILL BE * 37600013 * SET TO ZERO IN THE LCB. THE CONVERSATIONAL MODE FLAG * 38400013 * OF THE LCB WILL BE SET TO ZERO. * 39200013 * * 40000013 *EXTERNAL ROUTINES- * 40800013 * IECKRC - RECALL ROUTINE OF IGG019NG TO OBTAIN THE HEADER. * 41600013 * * 42400013 *EXITS- * 43200013 * NORMAL- RETURN IS TO THE NEXT LPS INSTRUCTION VIA A BRANCH ON * 44000013 * REGISTER 14. * 44800013 * ERROR- NONE. * 45600013 * * 46400013 *TABLES/WORK AREAS- * 47200013 * NONE. * 48000013 * * 48800013 *ATTRIBUTES- * 49600013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 50400013 * * 51200013 *NOTES- * 52000013 * REGISTER 3- SECOND LEVEL RETURN REGISTER TO RECALL ROUTINE. * 52800013 * REGISTER 9- SECOND LEVEL ENTRY POINT REGISTER TO THE RECALL * 53600013 * ROUTINE AND WORK REGISTER. * 54400013 * * 55200013 *********************************************************************** 56000013 IECKCNCL START 56800013 *1210760700-767000,912000 00PS 57200016 *90381704000-728000,800000,810000 57400017 * 612000,739000-757000 A28764 57500019 *A040000,145000-151000,157000-168000 S21016 57550021 RREG2 EQU 3 57600013 LCBREG EQU 4 58400013 MSREG EQU 6 59200013 TCREG EQU 8 60000013 WREG1 EQU 9 60800013 WREG2 EQU 10 61200019 RREG1 EQU 14 61600013 SREG EQU 15 62400013 USING *,SREG 63200013 USING IECKPREF,MSREG 64000013 USING IECKLCB0,LCBREG 64800013 USING IECKTERM,TCREG 65600013 LH WREG1,0(0,RREG1) LOAD ERROR HALF WORD FROM USER 66400013 SLA WREG1,16 SHIFT TO HIGH ORDER PART OF REGISTER 67200013 BC 8,ERRACT BRANCH IF MASK IS ZERO 68000013 N WREG1,LCBERRST TEST FOR DESIGNATED ERRORS 68800013 BC 8,2(0,RREG1) RETURN IF NO ERRORS 69600013 ERRACT MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 73600013 L WREG2,0(0,13) GET LPS QUE ADDR FROM IGG019NG A28764 73900019 BAL RREG2,240(0,WREG2) BRANCH TO RECALL SUBR FOR HEADER28764 74200019 LTR WREG1,WREG1 IS INVALID DESTINATION BIT ON A28764 74500019 BNM CANCEL BRANCH IF NO A28764 74800019 OI MSTATUS,X'10' SET SERVICED BIT A28764 75100019 B ERRRET BYPASS CANCEL BIT A28764 75400019 CANCEL OI MSTATUS,X'80' TURN ON CANCEL BIT IN PREFIX A28764 75700019 TM MSTATUS,X'10' IS MESSAGE SERVICED 00PS 76070016 BO ERRRET BRANCH IS YES 00PS 76140016 LH WREG1,TTDKEY GET DESTINATION OFFSET 00PS 76210016 LTR WREG1,WREG1 IS OFFSET VALID 00PS 76280016 BZ ERRRET BRANCH IF NO 00PS 76350016 A WREG1,=V(TERMTBL) ADD IN TERMTBL ADDRESS 00PS 76420016 L WREG1,TQCBADDR-1-IECKTERM(WREG1) LOAD DEST QCB ADDR00PS 76490016 LH RREG2,QSIZE-QBLOCK(WREG1) LOAD CURRENT SIZE 00PS 76560016 BCTR RREG2,0 DECREMENT FOR CANCELED MESSAGE 00PS 76630016 STH RREG2,QSIZE-QBLOCK(WREG1) AND RESTORE 00PS 76700016 ERRRET LA TCREG,0(TCREG) CLEAR THE HIGH ORDER BYTE 76800013 L WREG1,16 ADDRESS OF THE CVT 77600013 C TCREG,156(WREG1) IS TCREG EQUAL TERM TABLE START 78400013 BE NOUPDATE BRANCH YES 79200013 LH WREG1,MSNUMIN GET SEQUENCE NO. OF LAST MESSAGE00PS 80000017 LTR WREG1,WREG1 IS IT ZERO 80800013 BE NOUPDATE BRANCH IF YES 00PS 81000017 STH WREG1,TSEQUIN ELSE RESET SEQUENCE NUMBER 82400013 NOUPDATE EQU * 83200013 MVI LCBMPLRT,X'00' AND ZERO MULTIPLE ROUTE BYTE IN LCB 84000013 XC LCBDLPTR(2),LCBDLPTR ZERO DISTRIBUTION LIST BYTE 84800013 NI LCBSTATE,X'DF' CLEAR CONVERSATIONAL MODE FLAG 85600013 B 2(0,RREG1) RETURN TO USER 86400013 EJECT 87200013 PREFIXD 88000013 EJECT 88800013 LCBD 89600013 EJECT 90400013 TERMTBLD 91200013 QCBD 91600016 END 92000013 ./ ADD SSI=01011610,NAME=IECKCPPL,SOURCE=0 TITLE 'IECKCPPL QTAM COPY POLLING LIST (COPYP)' 00800013 *********************************************************************** 01600013 * * 02400013 *NAME- * 03200013 * IECKCPPL COPY POLLING LIST (COPYP) * 04000013 * * 04800013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 05600013 * * 06400013 *FUNCTION- * 07200013 * IECKCPPL IS USED TO COPY A POLLING LIST INTO A WORK AREA * 08000013 * IN THE CALLING ROUTINE. THE REGISTERS ARE SAVED AND A TEST IS * 08800013 * MADE TO DETERMINE IF THE DCB IS OPEN. IF IT IS NOT, AN ERROR CODE* 09600013 * OF X'01' IS PLACED INTO REGISTER 15, REGISTERS ARE RESTORED, * 10400013 * AND CONTROL IS RETURNED TO THE LOCATION IN REGISTER 14. * 11200013 * IF THE DCB IS OPEN, THE RELATIVE LINE NUMBER GIVEN BY THE * 12000013 * CALLING ROUTINE IS COMPARED WITH THE MAXIMUM RLN FOR THIS DCB. * 12800013 * IF THE SPECIFIED RLN IS TOO HIGH, INDICATING A LINE THAT DOES NOT * 13600013 * EXIST IN THIS DCB, AN ERROR CODE OF X'08' IS RETURNED IN REG 15. * 14400013 * IF THE RLN IS VALID, THE PROPER POLLING LIST IS SELECTED * 15200013 * AND THE POLLING LIST SIZE IS RETRIEVED FROM THE FIRST BYTE OF * 16000013 * THE POLLING LIST. THIS NUMBER OF BYTES IS MOVED FROM THE POLLING * 16800013 * LIST TO THE SPECIFIED WORK AREA. IN THIS CASE, A X'00', * 17600013 * INDICATING NO ERRORS, IS RETURNED IN REGISTER 15. THE REGISTERS * 18400013 * ARE RESTORED AND CONTROL IS RETURNED TO THE MESSAGE PROCESSING * 19200013 * PROGRAM. * 20000013 * * 20800013 *ENTRY POINTS- * 21600013 * IECKCPPL - EXPANSION OF THE COPYP MACRO GENERATES A BALR TO THIS * 22400013 * POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER, AND * 23200013 * REGISTER 14 AS THE RETURN ADDRESS REGISTER. * 24000013 * * 24800013 *INPUT- * 25600013 * REGISTER 0- WILL CONTAIN THE ADDRESS OF THE DCB SPECIFIED IN * 26400013 * THE MACRO. THE RELATIVE LINE NUMBER WILL BE IN THE HIGH * 27200013 * ORDER BYTE. * 28000013 * REGISTER 1- CONTAINS THE ADDRESS OF THE WORK AREA INTO * 28800013 * WHICH THE POLLING LIST IS TO BE COPIED. * 29600013 * REGISTER 13- ADDRESS OF THE SAVE AREA. * 30400013 * REGISTER 14- RETURN ADDRESS. * 31200013 * REGISTER 15- ENTRY POINT REGISTER. * 32000013 * * 32800013 *OUTPUT- * 33600013 * REGISTER 15- ONE OF THE FOLLOWING CODES WILL BE RETURNED, * 34400013 * RIGHT ADJUSTED, IN THIS REGISTER. * 35200013 * X'00' NO ERRORS. * 36000013 * X'01' THE DCB HAS NOT BEEN OPENED. * 36800013 * X'08' THE PASSED RELATIVE LINE NUMBER IS TOO HIGH. * 37600013 * * 38400013 *EXTERNAL ROUTINES- * 39200013 * NONE. * 40000013 * * 40800013 *EXITS- * 41600013 * NORMAL-RETURN IS TO THE NEXT MESSAGE CONTROL PROGRAM INSTRUCTION * 42400013 * BY ISSUING RETURN MACRO. * 43200013 * ERROR- ERROR RETURN CODE IS PLACED IN REGISTER 15, AND RETURN IS * 44000013 * AS ABOVE. * 44800013 * * 45600013 *TABLES/WORK AREAS- * 46400013 * NONE. * 47200013 * * 48000013 *ATTRIBUTES- * 48800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 49600013 * * 50400013 *NOTES- * 51200013 * REGISTER 5- WORK REGISTER. * 52000013 * REGISTER 7- WORK REGISTER. * 52800013 * REGISTER 3- BASE REGISTER FOR IHADCB. * 53600013 * REGISTER 6- BASE REGISTER FOR POLLIST. * 54400013 * * 55200013 *********************************************************************** 56000013 IECKCPPL START 56800013 R0 EQU 0 57600013 R1 EQU 1 58400013 DCBREG EQU 3 59200013 R5 EQU 5 60000013 POLLREG EQU 6 60800013 FLAG EQU 7 61600013 RETURN EQU 14 62400013 SREG EQU 15 63200013 DEBEXT EQU 16 64000013 USING IHADCB,DCBREG 64800013 USING POLLIST,POLLREG 65600013 USING *,SREG 66400013 SAVE (14,12) 67200013 LR DCBREG,R0 REGISTER 0 HAS THE DCB ADDRESS WITH 68000013 * THE RELATIVE LINE NUMBER (RLN) IN 68800013 * THE HIGH ORDER BYTE 69600013 LA FLAG,X'01' LOAD USER'S ERROR FLAG 70400013 TM DCBOFLGS,X'10' HAS THE DCB BEEN OPENED 71200013 BNO RET BRANCH IF NO 72000013 * RETURN SINCE NO DEB AVAILABLE 72800013 SR FLAG,FLAG CLEAR ERROR INDICATOR 73600013 OPND L R5,DCBDEBAD GET DEB ADDRESS FROM THE DCB 74400013 CLC 20(1,13),DEBEXT(R5) IS PASSED RLN TOO HIGH 75200013 BNH NORLNERR BRANCH IF NO 76000013 LA FLAG,X'08' SET INVALID RLN ERROR FLAG 76800013 B RET AND RETURN 77600013 NORLNERR SRL R0,24 SHIFT OUT DCB ADDRESS 78400013 SLL R0,2 R0 HAS 4(RLN) 79200013 AR DCBREG,R0 GET DCB+4(RLN) IN DCBREG 80000013 L POLLREG,DCBCPOLL-4 GET THE ADDRESS OF THE POLLING LIST 80800013 * FROM THE DCB USING DCBREG AS THE 81600013 * BASE FOR DCBCPOLL 82400013 SR R5,R5 CLEAR WORKING REGISTER 83200013 IC R5,POLLSZE INSERT POLLING LIST SIZE 84000013 BCTR R5,0 DECREMENT FOR EXECUTE 84800013 EX R5,MOVPL COPY POLLING LIST 85600013 RET LR 15,FLAG LOAD ERROR FLAG FOR USER 86400013 RETURN (0,12) RESTORE AND RETURN TO USER 87200013 SPACE 88000013 MOVPL MVC 0(1,R1),POLLIST COPY POLLIST INTO WORKAREA 88800013 SPACE 2 89600013 * THE FOLLOWING ERROR INDICATORS ARE SET FOR THE USER IN THIS ROUTINE 90400013 * AND ARE RIGHT ADJUSTED IN REGISTER 15 91200013 * X'00' NO ERRORS 92000013 * X'01' THE DCB HAS NOT BEEN OPENED 92800013 * X'08' PASSED RELATIVE LINE NUMBER TOO HIGH 93600013 EJECT 94400013 DCBD DSORG=QX 95200013 EJECT 96000013 POLLIST DSECT 96800013 POLLSZE DS FL1 INDICATES POLLING LIST LENGTH 97600013 END 98400013 ./ ADD SSI=01011610,NAME=IECKCPYQ,SOURCE=0 TITLE 'IECKCPYQ QTAM COPY QUEUE STATUS (COPYQ)' 00800013 *********************************************************************** 01600013 * * 02400013 *NAME- * 03200013 * IECKCPYQ QTAM COPY QUEUE STATUS (COPYQ) * 04000013 * * 04800013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 05600013 * * 06400013 *FUNCTION- * 07200013 * IECKCPYQ PLACES INFORMATION CONCERNING THE STATUS OF A * 08000013 * SPECIFIED MESSAGE QUEUE INTO THE CALLING ROUTINE'S WORK AREA. * 08800013 * THE ADDRESS OF THE TERMINAL TABLE IS RETRIEVED FROM THE * 09600013 * COMMUNICATIONS VECTOR TABLE. THE TERMINAL TABLE IS SCANNED * 10400013 * TO FIND THE DESIRED ENTRY. IF THE DESTINATION CODE IS NOT * 11200013 * FOUND, AN ERROR CODE OF X'20' IS RETURNED TO THE CALLING ROUTINE. * 12000013 * CONTROL PASSES BACK TO THE CALLING ROUTINE. * 12800013 * IF THE TERMINAL ENTRY IS FOUND, THE CONTENTS OF THE QCB * 13600013 * IS MOVED TO THE WORK AREA. CONTROL RETURNS TO THE NEXT * 14400013 * LPS INSTRUCTION BY ISSUING A RETURN MACRO. * 15200013 * * 16000013 *ENTRY POINTS- * 16800013 * IECKCPYQ - EXPANSION OF THE COPYQ MACRO GENERATES A BALR TO THIS * 17600013 * POINT, WITH REGISTER 15 AS THE ENTRY POINT REGISTER, AND * 18400013 * REGISTER 14 AS THE RETURN REGISTER. * 19200013 * * 20000013 *INPUT- * 20800013 * REGISTER 0 - ADDRESS OF THE CALLING ROUTINE'S WORK AREA * 21600013 * REGISTER 1 - ADDRESS OF THE LOCATION WHICH POINTS TO THE * 22400013 * TERMINAL NAME. * 23200013 * REGISTER 14- RETURN ADDRESS REGISTER. * 24000013 * REGISTER 15- ENTRY POINT REGISTER. * 24800013 * * 25600013 *OUTPUT- * 26400013 * REGISTER 15- RETURN CODE * 27200013 * X'00' NO ERRORS * 28000013 * X'20' TERMINAL TABLE ENTRY NOT FOUND. * 28800013 * * 29600013 *EXTERNAL ROUTINES- * 30400013 * NONE. * 31200013 * * 32000013 *EXITS- * 32800013 * NORMAL - RETURN IS TO THE NEXT MESSAGE PROCESSING PROGRAM * 33600013 * INSTRUCTION, ACCOMPLISHED BY EXECUTING A RETURN MACRO. * 34400013 * RETURN CODE IN REGISTER 15 IS X'00'. * 35200013 * ERROR - SAME AS ABOVE BUT WITH ERROR CODE OF X'20', TERMINAL * 36000013 * TABLE ENTRY NOT FOUND. * 36800013 * * 37600013 *TABLES/WORK AREAS- * 38400013 * NONE. * 39200013 * * 40000013 *ATTRIBUTES- * 40800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 41600013 * * 42400013 *NOTES- * 43200013 * REGISTER 0- ADDRESS OF END OF TERMINAL TABLE. * 44000013 * REGISTER 2- ADDRESS OF CALLING ROUTINE'S WORK AREA. * 44800013 * REGISTER 3- INCREMENT VALUE OF 8. * 45600013 * REGISTER 4- SIZE OF TERMID -1. * 46400013 * REGISTER 5- ADDRESS OF COMMUNICATIONS VECTOR TABLE. * 47200013 * REGISTER 6- BASE REGISTER FOR TERMINAL TABLE. * 48000013 * REGISTER 7- BASE REGISTER FOR QUEUE CONTROL BLOCK. * 48800013 * REGISTER 8- WILL HOLD THE ERROR FLAGS UNTIL RETURN. * 49600013 * * 50400013 *********************************************************************** 51200013 IECKCPYQ START 52000013 R0 EQU 0 52800013 PLREG EQU 1 53600013 WORKREG EQU 2 54400013 XREG EQU 3 55200013 WREG EQU 4 WORKREG 56000013 RD EQU 5 56800013 TERMREG EQU 6 57600013 QREG EQU 7 58400013 FLAG EQU 8 59200013 RETURN EQU 14 60000013 SREG EQU 15 60800013 USING IECKTERM,TERMREG 61600013 USING QBLOCK,QREG 62400013 USING *,SREG 63200013 SAVE (14,12) 64000013 SR FLAG,FLAG CLEAR ERROR INDICATOR 64800013 LR WORKREG,R0 GET WORKAREA ADDRESS FOR MOVE 65600013 L RD,CVTABLE(0,0) GET ADDRESS OF THE COMMUNICATIONS 66400013 * VECTOR TABLE (CVT) 67200013 L TERMREG,CVTTRMTB(0,RD) GET TERMTBL ADDRESS FROM CVT 68000013 L R0,0(0,TERMREG) GET END OF TABLE ADDRESS 68800013 SR WREG,WREG CLEAR WORKING REGISTER 69600013 IC WREG,4(0,TERMREG) GET TERMID SIZE 70400013 BCTR WREG,0 DECREMENT SIZE FOR COMPARE 71200013 LA XREG,8 INITIALIZE FOR LATER ADDITION 72000013 LAST CR TERMREG,R0 IS THIS LAST ENTRY 72800013 BE ERROR BRANCH IF YES 73600013 AR TERMREG,XREG ELSE ACCESS NEXT ENTRY 74400013 IC XREG,TNTRYSZE INSERT SIZE OF TERMINAL ENTRY 75200013 EX WREG,COMPID IS THIS SPECIFIED ENTRY 76000013 BNE LAST BRANCH IF NO 76800013 L QREG,TNTRYSZE ELSE LOAD QCBADDR FROM TERMTBL 77600013 * THE QCB SIZE IS 32 BYTES FOR BOTH 78400013 * PROCESS AND DESTINATION QUEUES 79200013 * WHICH ARE ON THE DASD 80000013 MVC 0(32,WORKREG),COREQ MOVE QCB TO WORKAREA 80800013 B RET RETURN TO USER 81600013 ERROR LA FLAG,X'20' INDICATE TERMINAL NAME NOT FOUND 82400013 RET LR SREG,FLAG LOAD USER'S ERROR INDICATOR 83200013 RETURN (0,12) AND RETURN TO USER 84000013 SPACE 84800013 COMPID CLC 0(1,PLREG),TERMID COMPARE TERMINAL NAME TO TABLE ENTRY 85600013 SPACE 86400013 CVTABLE EQU 16 87200013 CVTTRMTB EQU 156 88000013 * THE FOLLOWING ERROR FLAGS ARE PASSED TO THE USER IN THIS ROUTINE 88800013 * X'00' NO ERRORS 89600013 * X'20' INVALID TERMINAL TABLE ENTRY 90400013 EJECT 91200013 TERMTBLD 92000013 EJECT 92800013 * DEFINE QCB 93600013 QBLOCK DSECT 94400013 COREQ DS 0F QCB ADDRESS FOR DASD QUEUES 95200013 END 96000013 ./ ADD SSI=01011610,NAME=IECKCPYT,SOURCE=0 TITLE 'IECKCPYT QTAM COPY TERMINAL TABLE (COPYT)' 00700013 *********************************************************************** 01400013 * * 02100013 *NAME- * 02800013 * IECKCPYT QTAM COPY TERMINAL TABLE (COPYT) * 03500013 * * 04200013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04900013 * * 05600013 *FUNCTION- * 06300013 * IECKCPYT WILL COPY AN ENTRY FROM THE TERMINAL TABLE INTO A * 07000013 * SPECIFIED WORK AREA. * 07700013 * THE ROUTINE WILL GET THE ADDRESS OF THE COMMUNICATIONS * 08400013 * VECTOR TABLE, AND FROM THIS TABLE WILL GET THE ADDRESS OF THE * 09100013 * TERMINAL TABLE. THE ADDRESS OF THE END OF THE TABLE IS RETRIEVED * 09800013 * FROM THE FIRST ENTRY IN THE TABLE, AND THE MAXIMUM SIZE OF ANY * 10500013 * TERMID IS GAINED FROM THE SECOND ENTRY IN THE TERMINAL TABLE. * 11200013 * THE TERMINAL TABLE TERMID'S ARE SCANNED FOR THE DESTINATION * 11900013 * NAME WHICH MATCHES THE REQUESTED ENTRY NAME. IF THE PROPER * 12600013 * ENTRY IS FOUND, IT IS COPIED INTO THE WORK AREA. A NORMAL * 13300013 * COMPLETION CODE OF X'00' IS PLACED, RIGHT ADJUSTED, INTO * 14000013 * REGISTER 15. * 14700013 * IF AN ENTRY IS FOUND WITH LENGTH ZERO, OR IF NO ENTRY OF * 15400013 * THE SPECIFIED LENGTH IS FOUND, AN ERROR CODE OF X'20' IS PLACED, * 16100013 * RIGHT ADJUSTED, IN REGISTER 15. * 16800013 * RETURN IS TO THE NEXT PROCESSING PROGRAM INSTRUCTION. * 17500013 * * 18200013 *ENTRY POINTS- * 18900013 * IECKCPYT - EXPANSION OF THE COPYT MACRO GENERATES A BALR TO THIS * 19600013 * POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER, AND * 20300013 * REGISTER 14 AS THE RETURN ADDRESS REGISTER. * 21000013 * * 21700013 *INPUT- * 22400013 * REGISTER 0- PARAMETER REGISTER. POINTS TO THE WORK AREA INTO * 23100013 * WHICH THE TERMINAL TABLE ENTRY IS TO BE COPIED. * 23800013 * REGISTER 1- CONTAINS A POINTER TO THE NAME OF THE TERMINAL * 24500013 * TABLE ENTRY TO BE COPIED. * 25200013 * REGISTER 13- ADDRESS OF THE SAVE AREA. * 25900013 * REGISTER 14- RETURN ADDRESS * 26600013 * REGISTER 15- ENTRY POINT ADDRESS. * 27300013 * * 28000013 *OUTPUT- * 28700013 * REGISTER 15- WILL RETURN ONE OF THE FOLLOWING CONDITION CODES, * 29400013 * RIGHT ADJUSTED: * 30100013 * X'00' INDICATES NO ERRORS * 30800013 * X'20' INDICATES EITHER INVALID TERMINAL TABLE ENTRY * 31500013 * SPECIFIED, OR AN ENTRY OF LENGTH ZERO. * 32200013 * IF THERE WERE NO ERRORS, A COPY OF THE DESIRED TERMINAL TABLE * 32900013 * ENTRY WILL BE IN THE CALLING ROUTINE'S WORK AREA. * 33600013 * * 34300013 *EXTERNAL ROUTINES- * 35000013 * NONE. * 35700013 * * 36400013 *EXITS- * 37100013 * NORMAL- REGISTERS ARE RESTORED AND CONTROL RETURNS TO THE * 37800013 * LOCATION HELD IN REGISTER 14. * 38500013 * ERROR- SAME AS ABOVE. * 39200013 * * 39900013 *TABLES/WORK AREAS- * 40600013 * NONE. * 41300013 * * 42000013 *ATTRIBUTES- * 42700013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 43400013 * * 44100013 *NOTES- * 44800013 * REGISTER 0- WILL HOLD THE END OF TABLE ADDRESS DURING SCANNING * 45500013 * OF TERMINAL TABLE. * 46200013 * REGISTER 2- WORK REGISTER. WILL HOLD THE ADDRESS OF THE * 46900013 * WORK AREA. * 47600013 * REGISTER 3- WORK REGISTER. WILL HOLD THE SIZE OF THIS TERMINAL * 48300013 * TABLE ENTRY DURING SCANNING OF TABLE. * 49000013 * REGISTER 4- WORK REGISTER. WILL HOLD THE LENGTH OF THE TERMID. * 49700013 * REGISTER 5- WORK REGISTER. WILL HOLD THE ADDRESS OF THE * 50400013 * COMMUNICATIONS VECTOR TABLE. * 51100013 * REGISTER 6- WORK REGISTER. WILL HOLD THE POINTER TO THE CURRENT * 51800013 * POSITION IN THE TERMINAL TABLE. * 52500013 * * 53200013 *********************************************************************** 53900013 IECKCPYT START 54600013 R0 EQU 0 55300013 PLREG EQU 1 56000013 WORKREG EQU 2 56700013 XREG EQU 3 57400013 WREG EQU 4 WORKREG 58100013 RD EQU 5 58800013 TERMREG EQU 6 59500013 FLAG EQU 7 60200013 RETURN EQU 14 60900013 SREG EQU 15 61600013 USING IECKTERM,TERMREG 62300013 USING *,SREG 63000013 SAVE (14,12) 63700013 SR XREG,XREG CLEAR WORKING REGISTER 64400013 SR WREG,WREG CLEAR WORKING REGISTER 65100013 SR FLAG,FLAG CLEAR ERROR FIELD 65800013 L RD,CVTABLE(0,0) GET THE ADDRESS OF THE 66500013 * COMMUNICATIONS VECTOR TABLE (CVT) 67200013 L TERMREG,CVTTRMTB(0,RD) GET TERMTBL ADDRESS FROM CVT 67900013 LR WORKREG,R0 LOAD WORKAREA ADDRESS IN WORKREG 68600013 L R0,0(0,TERMREG) GET END OF TABLE ADDRESS 69300013 IC WREG,4(0,TERMREG) GET LENGTH OF TERMID FIELD 70000013 BCTR WREG,0 DECREMENT BY ONE FOR EXECUTE 70700013 LA TERMREG,8(0,TERMREG) BUMP TO FIRST ENTRY IN TABLE 71400013 LOOKUP EX WREG,COMPID CAUSE COMPARE FOR TABLE ENTRY 72100013 BNE LAST BRANCH IF NOT EQUAL 72800013 IC XREG,TNTRYSZE GET SIZE OF ENTRY FROM ENTRY 73500013 BCTR XREG,0 DECREMENT FOR EXECUTE 74200013 EX XREG,MOVTERM CAUSE ENTRY TO BE COPIED IN WORKAREA 74900013 B RET AND RETURN TO USER 75600013 COMPID CLC 0(1,PLREG),TERMID COMPARE TERMNAME TO TERMID 76300013 LAST CR TERMREG,R0 IS IT LAST ENTRY 77000013 BNL INVALID BRANCH IF YES - ERROR 77700013 CLI TNTRYSZE,0 IS LENGTH OF ENTRY EQUAL ZERO 78400013 BE INVALID BRANCH IF YES 79100013 IC XREG,TNTRYSZE ELSE GET LENGTH 79800013 LA TERMREG,0(XREG,TERMREG) AND BUMP TO NEXT ENTRY 80500013 B LOOKUP RELOOP TO LOOK AT NEXT ENTRY 81200013 INVALID LA FLAG,X'20' SET ERROR INDICATOR FOR USER 81900013 RET LR SREG,FLAG LOAD USER'S ERROR INDICATOR 82600013 RETURN (0,12) RETURN TO USER 83300013 MOVTERM MVC 0(1,WORKREG),TNTRYSZE COPY TABLE ENTRY INTO 1ST BYTE 84000013 * OF WORKAREA 84700013 CVTABLE EQU 16 85400013 CVTTRMTB EQU 156 86100013 * THE FOLLOWING ERROR FLAGS ARE PASSED TO THE USER IN REGISTER 15 86800013 * X'00' NO ERRORS 87500013 * X'20' INVALID TERMINAL TABLE ENTRY SPECIFIED 88200013 EJECT 88900013 TERMTBLD 89600013 END 90300013 ./ ADD SSI=02013244,NAME=IECKCVRS,SOURCE=0 TITLE 'IECKCVRS QTAM CONVERSATIONAL MODE (MODE)' 00400013 *********************************************************************** 00800013 * * 01200013 *NAME- * 01600013 * IECKCVRS QTAM CONVERSATIONAL MODE * 02000013 * * 02400013 *STATUS- CHANGE LEVEL= 20 JANUARY 1971 * 02800021 * * 03200013 *FUNCTION- * 03600013 * THE CONVERSE BIT IS SET IN THE LCBSTATE FIELD OF THE LCB * 04000013 * (LCBSTATE AT LCB + 0 IS OR'ED WITH A X'20'). IF THIS IS THE * 04400013 * FIRST TIME THE MACRO IS USED IN THE LPS, THEN THE ROUTINE BRANCHES* 04800013 * AND LINKS TO ENDINSRT (END INSERT ROUTINE OF IGG019NG). IF THE * 05200013 * IECKCVRS ROUTINE HAS BEEN ENTERED BEFORE, RETURN IS TO THE NEXT * 05600013 * LPS INSTRUCTION. * 06000013 * THE ENDINSRT ROUTINE PLACES THE ADDRESS OF A SPECIAL ENTRY * 06400013 * POINT OF THE CONVERSE ROUTINE (WHICH THE CLEANUP ROUTINE WILL * 06800013 * PROCESS FOR IECKCVRS) INTO A CHAIN OF ADDRESSES ACCORDING TO THE * 07200013 * PRIORITY SPECIFIED IN THE CODE. ENDINSRT REPLACES THE SECOND * 07600013 * OPERAND OF THE BAL INSTRUCTION OF ENDINSRT WITH THE ADDRESS OF * 08000013 * THE NEXT LPS INSTRUCTION, WHICH CAUSES A BRANCH TO THE NEXT LPS * 08400013 * INSTRUCTION INSTEAD OF TO ENDINSRT ON SUBSEQUENT PASSES THROUGH * 08800013 * IECKCVRS. ENDINSRT RETURNS VIA THE RETURN REGISTER (3) MINUS * 09200013 * FOUR, WHICH RETURNS TO THE SAME BAL INSTRUCTION AFTER IT HAS BEEN * 09600013 * CHANGED. THE CODE FOLLOWING THIS BAL INSTRUCTION IS ENTERED FROM * 10000013 * THE CLEANUP ROUTINE BY A BRANCH TO THE NEXT ROUTINE IN THE ADDRESS* 10400013 * CHAIN MENTIONED ABOVE. * 10800013 * IF CONVERSATIONAL MODE HAS NOT BEEN INDICATED, THERE IS AN * 11200013 * ERROR MESSAGE TO BE PROCESSED, OR A POLLING OR ADDRESSING ERROR * 11600013 * HAS OCCURRED, THEN RETURN IS TO THE NEXT ROUTINE IN THE CHAIN. * 12000013 * THE CONVERSATIONAL MODE MUST BE FOR PROCESSING; THEREFORE, IF THE * 12400013 * QUEUE IS NOT A PROCESSING QUEUE, RETURN IS TO THE NEXT ROUTINE * 12800013 * IN THE CHAIN. IF THE LINE IS RECEIVING, THEN THE ROUTINE BRANCHES* 13200013 * TO THE LPS CONTROL ROUTINE TO WAIT FOR COMPLETION OF PROCESSING * 13600013 * THE INCOMING MESSAGE. IF A CLOSEDOWN IS IN PROGRESS, RETURN IS * 13800021 * MADE TO CLEANUP. IF THE LINE IS SENDING, THE LINE IS TURNED * 14000021 * AROUND TO RECEIVE BY SETTING THE HIGHEST PRIORITY, THE CONVERSE * 14400013 * AND RECEIVE BITS AT LCBSTATE (A X'28' IS PLACED IN LCB + 40), AND * 14800013 * A READ OPERATION CODE AT LCBCEBC (LCB + 4). IF THE END OF THE * 15200013 * POLLING LIST HAS BEEN REACHED, THE START OF THE POLLING LIST IS * 15600013 * STORED IN THE LCBPOLPT FIELD AT LCB + 85. THE FUNCTIONS USUALLY * 15700021 * DONE BY BRB RING ROUTINE OF CLEARING LCBERRST AND LCBDLPTR AND * 15800021 * REMOVING THE INVALID ADDRESS FROM LCBSTART ARE DONE BY CONVERSE * 15900021 * TO TURN THE LINE AROUND AND RESTART POLLING. THE LCBCLCCW FIELD AT* 16000021 * LCB + 36 IS RESET WITH THE BRB ADDRESS FOR INITIALIZATION OF THE * 16400013 * ACTIVATE LINE ROUTINE. THE ROUTINE THEN ISSUES A POST (SVC 67) * 16800013 * TO INSERT BRB INTO THE READY QUEUE. THE ROUTINE BRANCHES TO THE * 17200013 * LPS CONTROL ROUTINE TO WAIT FOR THE MESSAGE TO BE RECEIVED. THE * 17600013 * LPS CONTROL ROUTINE THEN RETURNS TO THE CODE IN THE CONVERSE * 18000013 * ROUTINE. THE SERVICE BIT IS SET IN THE PREFIX OF THE MESSAGE * 18400013 * (MSTATUS AT PREFIX + 12 IS OR'ED WITH A X'10') AND THE CONVERSE * 18800013 * BIT IS CLEARED IN THE LCBSTATE FIELD OF THE LCB. * 19200013 * IF THE SOURCE TERMINAL WAS NOT IDENTIFIED, THEN RETURN IS TO * 19600013 * THE START OF THE CLEANUP ROUTINE. THE CHAIN, POINTED TO BY THE * 20000013 * QCB FOR A SOURCE TERMINAL, IS SEARCHED FOR A DEB TO SEE IF THE * 20400013 * PROCESS QUEUE CONTAINS A REPLY. IF THE CHAIN HAS BEEN SEARCHED * 20800013 * COMPLETELY, RETURN IS TO THE START OF THE CLEANUP ROUTINE. IF * 21200013 * THERE IS A REPLY, LCBENDOP IS SET TO POINT TO THE LCB IN THE DEB * 21400021 * SO DISK END WILL NOT READ AHEAD,AND THE * 21600021 * WRITE OPERATION CODE IS SET IN THE LCBCECB FIELD OF THE LCB. THE * 22000013 * ROUTINE POSTS THE ORIGINAL MESSAGE TO THE EMPTY BUFFER QUEUE. * 22400013 * THE LCB IS RESTORED WITH THE DISK ADDRESS OF THE REPLY. THE * 22800013 * RELATIVE ADDRESS OF THE EOB IS SET IN THE LCBTRST FIELD OF THE * 23200013 * LCB AT LCB + 82. THE ROUTINE THEN DOES A POST TO THE DISK I/O * 23600013 * QUEUE AND BRANCHES TO THE LPS CONTROL ROUTINE TO WAIT FOR THE * 24000013 * MESSAGE TO BE RECIVED. * 24400013 * * 24800013 *ENTRY POINTS- * 25200013 * IECKCVRS - EXPANSION OF THE MODE MACRO WITH CONVERSE AS THE FIRST * 25600013 * OPERAND AND NO CHARACTER SPECIFIED AS THE SECOND * 26000013 * OPERAND GENERATES A BALR TO THIS POINT USING REGISTER * 26400013 * 1 AS THE BRANCH ADDRESS REGISTER AND REGISTER 14 AS * 26800013 * THE RETURN REGISTER. IF THERE IS A CHARACTER SPECIFIED* 27200013 * IN THE SECOND OPERAND, THEN THE ADDRESS OF THE CONVERSE* 27600013 * ROUTINE IS PLACED IN THE PARAMETER REGISTER 1, AND THE * 28000013 * ROUTINE IS ENTERED BY A BRANCH FROM THE MESSAGE MODE * 28400013 * ROUTINE. * 28800013 * * 29200013 *INPUT- * 29600013 * REGISTER 1- ADDRESS OF THIS ROUTINE WHEN ENTERED FORM MODE MACRO * 30000013 * EXPANSION. * 30400013 * REGISTER 4- ADDRESS OF THE LCB. * 30800013 * REGISTER 6- BUFFER ADDRESS. * 31200013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 31600013 * REGISTER 8- TERMINAL TABLE SOURCE ENTRY. * 32000013 * REGISTER 14- RETURN ADDRESS. * 32400013 * REGISTER 15- ADDRESS OF A SECTION OF THIS ROUTINE WHEN ENTERED * 32800013 * FROM CLEANUP ROUTINE. * 33200013 * * 33600013 *OUTPUT- * 34000013 * THE BRB IS INSERTED TO THE READY QUEUE AND POSTED TO THE DISK * 34400013 * I/O DEVICE. * 34800013 * * 35200013 *EXTERNAL ROUTINES- * 35600013 * ENDINSRT - END INSERT ROUTINE IN MODULE IGG019NG TO SET UP THE * 36000013 * ADDRESS CHAIN FOR THE CLEANUP ROUTINE. * 36400013 * LPS CONTROL PROGRAM - STARTUP MODULE IN IGG019NG TO WAIT FOR THE * 36800013 * MESSAGE TO BE RECEIVED. * 37200013 * QPOST - SVC 67 (MODULE IGG067 IN MODULE IECKQQ01) INSERT THE BRB * 37600013 * INTO THE READY QUEUE AND POST TO THE DISK I/O QUEUE. * 38000013 * * 38400013 *EXITS- * 38800013 * NORMAL- RETURN FROM FIRST TIME THROUGH IS TO THE NEXT LPS * 39200013 * INSTRUCTION. ON SUCCEEDING ENTRIES FROM CLEANUP, * 39600013 * RETURN IS TO STARTUP MODULE IN IGG019NG. * 40000013 * ERROR-NONE. * 40400013 * * 40800013 *TABLES/WORK AREAS- * 41200013 * NONE. * 41600013 * * 42000013 *ATTRIBUTES- * 42400013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 42800013 * * 43200013 *NOTES- * 43600013 * REGISTER 1- BASE REGISTER FOR FIRST SECTION OF THIS ROUTINE WHEN * 44000013 * ENTERED FROM MACRO EXPANSION. USED AS A WORK REGISTER * 44400013 * WHEN ENTERED FROM CLEANUP. * 44800013 * REGISTER 2- WORK REGISTER. * 45200013 * REGISTER 3- SECOND LEVEL RETURN REGISTER FROM END INSERT AND WORK* 45600013 * REGISTER. * 46000013 * REGISTER 9- BASE REGISTER FOR THE QCB DESECT (QCBD MACRO * 46400013 * EXPANSION). * 46800013 * REGISTER 15- BASE REGISTER WHEN THIS ROUTINE IS ENTERED FROM * 47200013 * CLEANUP. * 47600013 * * 48000013 *********************************************************************** 48400013 IECKCVRS START 48800013 *0300724000 00PS 49000017 * 721000-724000,785000-790000,876800-879200 A29201 49100019 * 672000,722000 A31036 49150020 *A028000,138000-140000,157000-160000,214000-216000 S21016 49170021 QWAIT EQU 65 49200013 QPOST EQU 67 49600013 DREG1 EQU 1 50000013 FREG EQU 1 50400013 TREG EQU 2 50800013 Y EQU 3 51200013 LCBREG EQU 4 51600013 X EQU 6 52000013 LGREG EQU 7 52400013 TCREG EQU 8 52800013 QREG EQU 9 53200013 TCBREG EQU 10 53600013 BREG EQU 12 54000013 RREG1 EQU 14 54400013 USING IECKLCB0,LCBREG 54800013 USING *,DREG1 55200013 OI LCBSTATE,X'20' SET CONVERSE BIT IN LCB 55600013 CNOP 0,4 56000013 L 3,0(13) ADDRESS OF LPS SECTION OF NG 56400013 BAL 3,300(0,3) TO ROUTINE ENDINSRT IN NG. 56800013 * THIS IS A FIRST TIME SWITCH WITH THE 57200013 * BRANCH ADDRESS BEING CHANGED IN 57600013 * ENDINSRT CAUSING THE INSTRUCTION 58000013 * TO BECOME AS FOLLOWS: 58400013 * BAL 3,4(0,14) 58800013 * THE ADDRESS IS OVERLAID WITH LAST 59200013 * TWO BYTES OF THE FOLLOWING CONSTANT 59600013 USING IECKPREF,FREG 60000013 USING QBLOCK,QREG 60400013 USING *,15 60800013 DC X'4000E004' USED IN IGG019NG TO MODIFY ABOVE BRANCH 61200013 * AND OVERLAID BY ENDINSRT TO BECOME 61600013 * THE ADDRESS OF THE NEXT ROUTINE IN 62000013 * THE QUEUE FOR THE CLEANUP ROUTINE. 62400013 * 62800013 * THIS IS THE CLEANUP ROUTINE ENTRY POINT 63200013 TM LCBSTATE,X'A0' IS THIS CONVERSATIONAL MODE AND IS THE 63600013 * ORIGINAL MESSAGE THRU PROCESSING 64000013 BCR 14,14 NOT CONVERSATIONAL MODE OR ERROR 64400013 * MESSAGE MUST BE PROCESSED - RETURN 64800013 * TO THE CLEANUP ROUTINE 65200013 TM LCBERRST+1,8 IS THERE A POLLING OR ADDRESSING ERROR 65600013 BCR 1,14 RETURN IF ERROR TO CLEANUP 66000013 L FREG,LCBDESTQ-1 LOAD REG WITH MESSAGE DESTINATION ADDRES 66400013 CLI 4(FREG),1 IS THIS A PROCESS OR DESTINATION QUEUE 66800013 BCR 7,14 NOT PROCESS QUEUE - RETURN 67200013 LR 1,14 SAVE RETURN ADDRESS A31036 67400020 L 14,0(0,13) GET ADDRESS OF LPS QUEUE 67600013 TM LCBSTATE,X'08' IS LINE RECEIVING 68000013 BZ RECV IF NOT: BRANCH TO TURN LINE TO RECEIVE 68400013 LA 3,CVRET SET RETURN AFTER MESSAGE IS PROCESSED 68800013 STM 14,3,LCBCPA SAVE RETURN REGS IN CHANNEL PROGRAM AREA 69200013 TM LCBSTATE,X'10' HAS MESASAGE BEEN PROCESSED 69600013 BNZ 232(0,14) BRANCH TO STARTUP IF NOT PROCESSED YET 70000013 * FOR COMPLETION OF PROCESSING FOR 70400013 * INCOMING MESSAGE - REENTER AT CVRET 70800013 MVI LCBSTATE,X'E6' SET SEND AND 71200013 B RESUMEX BRANCH TO TEST FOR REPLY IN QUEUE 71600013 * LINE IS NOT RECEIVING - FOLLOWING TURNS THE LINE AROUND TO RECEIVE 72000013 RECV TM 288(RREG1),X'0F' IS CLOSEDOWN IN PROGRESS A29201 72100019 BCR 14,1 BRANCH YES TO CLEANUP TO A31036 72200020 * AVOID RE-POLL A29201 72300019 MVI LCBSTATE,8 SET RECEIVE IN LCBSTATE A29201 72400019 MVI LCBCECB,1 SET READ INITIAL OP FOR BTAM IN DECB 72800013 L QREG,LCBPOLPT-1 GET ADDRESS OF POLLING CHARACTERS 73200013 OC 0(2,QREG),0(QREG) IS THIS THE END OF THE POLLING LIST 73600013 BNZ RESUMEX NO - USEABLE POLLING CHARACTERS 74000013 * THE FOLLOWING FINDS THE START OF THE POLLING LIST 74400013 L QREG,LCBUCBX GET UCB INDEX FROM THE LCB 74800013 SRL QREG,24 ALIGN INDEX 75200013 SLL QREG,2 75600013 A QREG,LCBDCBPT ADD DCB POINTER TO INDEX 76000013 L QREG,DCBCPOLL-IHADCB(0,QREG) INCREMENT BY DCB SIZE 76400013 LA QREG,2(0,QREG) FINAL ADJUSTMENT 76800013 ST QREG,LCBPOLPT-1 RESTORE LCB POLL POINTER 77200013 RESUMEX L FREG,LCBCLPCI-1 GET ADDR OF CURRENT BUFFER REQUEST BLOCK 77600013 MVI FPRI,X'EC' SET UP HIGHEST PRIORITY 78000013 LA TREG,12(0,14) GET ADDR OF ACTIVE BUFFER REQUEST QUEUE 78400013 RESUME SR QREG,QREG CLEAR REGISTER A29201 78500019 STH QREG,LCBERRST CLEAR ERROR HALF WORD A29201 78600019 STH QREG,LCBDLPTR CLEAR DISTRIBUTION LIST POINTER29201 78700019 NI LCBSTART+2,X'FC' REMOVE INVALID ADDRESS FROM A29201 78800019 * CHANNEL PROGRAM CHECK A29201 78900019 LA Y,LCBCLPCI-9 INITIALIZE FOR ACTIVATE A29201 79000019 ST Y,LCBCLCCW RESET THE BRB ADDRESS IN LCB 79200013 SVC QPOST INSERTS BRB INTO READY QUEUE 79600013 * AND POSTS TO THE DISK I/O QUEUE 80000013 B 232(0,14) WAIT FOR MESSAGE TO BE RECEIVED 80400013 * THE FOLLOWING LOOKS FOR A REPLY IN THE PROCESS QUEUE 80800013 CVRET OI MSTATUS-FBLOCK(X),X'10' SET SERVICED BIT IN PREFIX 81200013 NC LCBTTIND,LCBTTIND HAS SOURCE TERMINAL BEEN IDENTIFIED 81600013 BZ 244(0,14) SOURCE NOT IDENTIFIED - GO TO CLEANUP ROUTINE 82000013 L QREG,0(0,TCREG) SET UP QCB FOR SOURCE TERMINAL 82400013 SR FREG,FREG CLEAR A TESTING REGISTER 82800013 LOOK L QREG,QSORCE-1 GET ADDRESS OF FIRST LCB ON CHAIN 83200013 BCTR QREG,0 CLEAR LOW ORDER BIT WHICH 83600013 * IS USED AS A SWITCH 84000013 CLI QDUMMY,0 ARE WE BACK TO QCB AGAIN 84400013 BE ANYPROC YES - GO TEST FOR ANY REPLY FOUND 84800013 CLI 8(QREG),X'12' IS THIS AN LCB IN CHAIN 85200013 BE LOOK BRANCH IF YES - LOOKING FOR A DEB IN 85600013 * QUEUE TO IDENTIFY A PROCESS QUEUE 86000013 LR FREG,QREG SAVE LCB ADDRESS 86400013 B LOOK SCAN FOR LAST LCB 86800013 ANYPROC LTR FREG,FREG WAS THERE A REPLY IN THE QUEUE 87200013 BZ 244(14) BRANCH IF NO TO CLEANUP 87600013 IC TREG,LCBSTATE SAVE LCBSTATE A29201 87680019 ST FREG,LCBENDOP-1 POINT LCB TO DUMMY LCB IN A29201 87760019 * PROCESS QUEUE DEB A29201 87840019 STC TREG,LCBSTATE RESTORE LCBSTATE A29201 87920019 LR QREG,FREG ELSE ACCESS LAST PROCESS LCB CHAINED 88000013 MVI LCBCECB,2 SET WRITE INITIAL OP FOR BTAM 88400013 LR FREG,X GET BUFFER ADDRESS IN FREG 88800013 LA TREG,24(0,14) GET ADDRESS OF THE EMPTY BUFFER QUEUE 89200013 SVC QPOST POST ORIGINAL MESSAGE TO EMPTY BUFFER Q 89600013 L FREG,LCBCLPCI-1 GET THE BRB ADDRESS 90000013 MVC LCBRCADD,QNASEG RESTORE LCB WITH DISK ADDRESS OF REPLY 90400013 MVC LCBCHDR,QNASEG 90800013 MVC LCBCSEG,QNASEG 91200013 MVC MSLCB,QNASEG 91600013 MVI MSTATUS,9 SET TO INDICATE DISK ADDRESS IN MSLCB 92000013 MVI FPRI,X'E0' RESTORE TO LOWEST PRIORITY 92400013 LA TREG,HDSTRT-MSEGSZE GET RELATIVE ADDR OF EOB CHARACTER 92800013 STH TREG,LCBTRST STORE IN LCB 93200013 LA TREG,36(0,14) GET THE ADDRESS OF THE DISK I/O QUEUE 93600013 B RESUME GO WAIT FOR REPLY FROM DISK 94000013 EJECT 94400013 PREFIXD 94800013 EJECT 95200013 QCBD 95600013 EJECT 96000013 LCBD QTAM=3 96400013 EJECT 96800013 DCBD DSORG=(QX) 97200013 END 97600013 ./ ADD SSI=02012331,NAME=IECKDATE,SOURCE=0 TITLE 'IECKDATE QTAM DATESTAMP (DATESTMP)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKDATE QTAM DATE STAMP (DATESTMP) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * LINKS TO EXPAND ROUTINE TO EXPAND HEADER BY FIVE BYTES TO * 10000013 * ALLOW FOR THE DATE INFORMATION. CURRENT DATE IS OBTAINED * 11000013 * IN PACKED DECIMAL FORM. ROUTINE UNPACKS THE DATA AND INSERTS * 12000013 * IT INTO THE MESSAGE HEADER IN THE FORMAT BYY.DDD , WHERE B=BLANK * 13000013 * YY=YEAR, AND DDD=DAY OF THE YEAR. * 14000013 * * 15000013 *ENTRY POINTS- * 16000013 * IECKDATE - EXPANSION OF THE DATESTMP MACRO GENERATES A BALR TO * 17000013 * THIS POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER. * 18000013 * * 19000013 *INPUT- * 20000013 * REGISTER 14- RETURN ADDRESS. * 21000013 * REGISTER 14 ALSO POINTS TO A HALFWORD PARAMETER, THE LENGTH * 22000013 * (IN BINARY) OF THE DATE FIELD TO BE INSERTED IN THE MESSAGE * 23000013 * HEADER. THIS PARAMETER WILL BE USED BY THE EXPAND ROUTINE. * 24000013 * REGISTER 15- ENTRY POINT. * 25000013 * * 26000013 *OUTPUT- * 27000013 * THE DATE WILL BE INSERTED IN THE MESSAGE HEADER. * 28000013 * * 29000013 *EXTERNAL ROUTINES- * 30000013 * IECKEXPD - TO PROVIDE SPACE IN THE HEADER FOR THE DATE. * 31000013 * * 32000013 *EXITS- * 33000013 * NORMAL- RETURN TO THE NEXT LPS INSTRUCTION BY BRANCHING AROUND * 34000013 * MACRO GENERATED CONSTANT. BRANCH IS ON REGISTER 3. * 35000013 * ERROR- NONE. * 36000013 * * 37000013 *TABLES/WORK AREAS- * 38000013 * DATEWORD- USED AS WORK AREA IN UNPACKING DATE INFORMATION. * 39000013 * * 40000013 *ATTRIBUTES- * 41000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 42000013 * * 43000013 *NOTES- * 44000013 * REGISTER 1- USED AS A WORK REGISTER. WILL RECEIVE THE TIME AND * 45000013 * DATE INFORMATION FROM THE SUPERVISOR. * 46000013 * REGISTER 2- USED AS A BASE REGISTER. * 47000013 * REGISTER 3- RETURN ADDRESS TO NEXT LPS INSTRUCTION. * 48000013 * REGISTER 10- WILL CONTAIN ADDRESS OF FIRST BYTE IN EXPANDED FIELD * 49000013 * WHEN CONTROL RETURNS FROM EXPAND. * 50000013 * * 51000013 *********************************************************************** 52000013 IECKDATE START 53000013 DREG0 EQU 0 54000013 DATEREG EQU 1 55000013 TREG EQU 2 56000013 RREG2 EQU 3 57000013 WREG2 EQU 10 58000013 RREG1 EQU 14 59000013 SREG EQU 15 60000013 BALR TREG,0 61000013 USING *,TREG 62000013 L SREG,=V(IECKEXPD) GET ADDRESS OF THE EXPAND ROUTINE 63000013 BALR RREG2,SREG LINK TO EXPAND SUBROUTINE 64000013 LR RREG2,RREG1 SAVE RETURN REGISTER 65000013 TIME DEC OBTAIN TIME AND DATE FROM SUPERVISOR 66000013 SLL DATEREG,8 SHIFT LEFT ONE BYTE 67000013 ST DATEREG,TEMP PREPARE FOR EXPANSION 68000013 UNPK DATEWORD+1(5),TEMP(3) CHANGE TO ZONED FORMAT 69000013 OI DATEWORD+5,X'F0' ENSURE ZONES IN LOW ORDER 70000013 MVC DATEWORD(2),DATEWORD+1 EXPAND DATE ONE BYTE 71000013 MVI DATEWORD+2,X'4B' AND INSERT PERIOD YY.DDD 72000013 MVC 1(6,WREG2),DATEWORD INSERT DATE INTO HEADER 73000013 B 2(0,RREG2) RETURN 74000013 DATESZE DC X'0007' LENGTH OF DATE FIELD 75000013 DATEWORD DS 1D 76000013 TEMP DS 1F 77000013 DATE DC X'0065096C' 78000013 DS 0F 79000013 END 80000013 ./ ADD SSI=01011610,NAME=IECKDCBL,SOURCE=0 TITLE 'IECKDCBL - QTAM LOCATE DCB ROUTINE' 00800013 *********************************************************************** 01600013 * * 02400013 *NAME- * 03200013 * IECKDCBL QTAM LOCATE DCB * 04000013 * * 04800013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 05600013 * * 06400013 *FUNCTION- * 07200013 * IECKDCBL LOCATES THE DCB FOR A SPECIFIED TERMINAL. * 08000013 * THIS ROUTINE IS USED AS A SECOND LEVEL ROUTINE BY STOPLN, * 08800013 * STARTLN, COPYP, AND CHNGP TO LOCATE THE DESIRED DCB. * 09600013 * THE ADDRESS OF THE TERMINAL TABLE IS RETRIEVED FROM THE * 10400013 * COMMUNICATIONS VECTOR TABLE. THE TABLE IS SCANNED FOR THE * 11200013 * PROPER DESTINATION CODE. IF THE DESTINATION CODE IS NOT FOUND, * 12000013 * A RETURN CODE OF X'20' IS RETURNED TO THE CALLING ROUTINE. * 12800013 * IF THE TERMINAL TABLE ENTRY IS FOUND, THE ADDRESS OF THE * 13600013 * QCB FOR THAT DESTINATION IS OBTAINED AND A TEST IS MADE TO * 14400013 * DETERMINE THE TYPE OF TABLE ENTRY. IF IT IS A LIST OR PROCESS * 15200013 * ENTRY, AN ERROR CODE OF X'20' IS RETURNED TO THE CALLING * 16000013 * ROUTINE. * 16800013 * IF THAT ENTRY WAS NOT A LIST OR PROCESS ENTRY, THE ADDRESS * 17600013 * OF THE DCB IS RETRIEVED FROM THE QCB AND PLACED IN REGISTER 0. * 18400013 * THE RELATIVE LINE NUMBER IS INSERTED INTO THE HIGH ORDER BYTE * 19200013 * OF THAT REGISTER. A NORMAL RETURN CODE OF X'00' IS SET IN * 20000013 * REGISTER 15, AND CONTROL RETURNS TO THE CALLING ROUTINE. * 20800013 * * 21600013 *ENTRY POINTS- * 22400013 * IECKDCBL - EXPANSION OF THE STOPLN, STARTLN, COPYP, OR CHNGP * 23200013 * MACRO INSTRUCTION GENERATES A BALR TO THIS POINT, USING * 24000013 * REGISTER 15 AS THE ENTRY POINT REGISTER AND REGISTER 14 AS * 24800013 * THE RETURN REGISTER. * 25600013 * * 26400013 *INPUT- * 27200013 * REGISTER 1- ADDRESS OF THE TERMINAL NAME TO BE FOUND. * 28000013 * REGISTER 14- RETURN ADDRESS. * 28800013 * REGISTER 15- ENTRY POINT ADDRESS. * 29600013 * * 30400013 *OUTPUT- * 31200013 * REGISTER 6- IF THE PROPER ENTRY IS FOUND, AND IT IS NOT A LIST * 32000013 * OR PROCESS TERMINAL, THEN THIS REGISTER WILL HAVE THE * 32800013 * RELATIVE LINE NUMBER IN THE HIGH ORDER BYTE, AND THE * 33600013 * ADDRESS OF THE DCB IN THE LOW ORDER THREE BYTES. * 34400013 * REGISTER 15- THE CONDITION CODE WILL BE RETURNED HERE: * 35200013 * X'00'- NO ERRORS * 36000013 * X'20'- TERMINAL TABLE ENTRY NOT FOUND, OR * 36800013 * ENTRY IS LIST OR PROCESS ENTRY. * 37600013 * * 38400013 *EXTERNAL ROUTINES- * 39200013 * NONE. * 40000013 * * 40800013 *EXITS- * 41600013 * NORMAL- RETURN IS ACCOMPLISHED BY ISSUING A RETURN MACRO. RETURN * 42400013 * CODE IS X'00'. * 43200013 * ERROR - SAME AS ABOVE, BUT WITH ERROR CODE OF X'20'. * 44000013 * * 44800013 *TABLES/WORK AREAS- * 45600013 * NONE. * 46400013 * * 47200013 *ATTRIBUTES- * 48000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 48800013 * * 49600013 *NOTES- * 50400013 * REGISTER 4- WORK REGISTER. ADDRESS OF THE TERMINAL TABLE. * 51200013 * REGISTER 5- WORK REGISTER. MAXIMUM SIZE OF ANY TERMID ENTRY. * 52000013 * REGISTER 6- WORK REGISTER. LENGTH OF TERMINAL TABLE ENTRY. * 52800013 * REGISTER 8- WORK REGISTER. ADDRESS OF END OF TABLE. * 53600013 * REGISTER 9- WORK REGISTER. ERROR FLAG. * 54400013 * * 55200013 *********************************************************************** 56000013 IECKDCBL START 56800013 R1 EQU 1 57600013 TERM EQU 4 58400013 LEN EQU 5 59200013 WK EQU 6 60000013 WK1 EQU 7 60800013 LAST EQU 8 61600013 FLAG EQU 9 62400013 SREG EQU 15 63200013 * 64000013 CVTTRMTB EQU 156 64800013 INVALID EQU 32 65600013 EJECT 66400013 USING *,SREG 67200013 SAVE (4,12) 68000013 L TERM,16 LOAD ADDRESS OF THE CVT 68800013 L TERM,CVTTRMTB(TERM) NOW CONTAINS TERM TABLE ADDRESS 69600013 SR FLAG,FLAG SET RETURN CODE TO ZERO 70400013 SR LEN,LEN 71200013 IC LEN,4(TERM) MAX. SIZE OF TERM NAME 72000013 NONE BCTR LEN,0 SUB ONE FOR COMPARE INSTRUCTION 72800013 SR WK,WK ZERO REGISTER 73600013 L LAST,0(TERM) ADDRESS OF LAST TERM ENTRY 74400013 LA TERM,8(TERM) ADDRESS OF FIRST TERM ENTRY 75200013 NEXT EX LEN,COMPARE COMPARE TERM NAMES 76000013 BE FOUND BRANCH IF TERM NAMES EQUAL 76800013 IC WK,0(TERM) LENGTH OF THIS TERM ENTRY 77600013 LA TERM,0(TERM,WK) ADDRESS OF NEXT ENTRY 78400013 CR TERM,LAST PAST LAST ENTRY 79200013 BH ERROR BRANCH YES- TERMNAME INVALID 80000013 B NEXT GO COMPARE NEXT ENTRY 80800013 FOUND L WK,0(TERM) LOAD ADDRESS OF ASSOCIATED QCB 81600013 CLI 8(WK),X'68' TEST FOR TERMINAL TYPE ENTRY 82400013 BNE ERROR BRANCH LIST OR PROCESS ENTRY 83200013 L WK,16(WK) DCB ADDRESS 84000013 LA WK,0(WK) CLEAR HIGH ORDER BYTE 84800013 ALR 0,WK COMBINE RLN AND DCB ADDRESS 85600013 B RET EXIT 86400013 ERROR LA FLAG,INVALID SET ERROR RETURN CODE 87200013 RET LR 15,FLAG RETURN CODE TO REGISTER 15 88000013 RETURN (4,12) 88800013 COMPARE CLC 9(1,TERM),0(R1) COMPARE TERMINAL NAMES 89600013 END 90400013 ./ ADD SSI=02010131,NAME=IECKDLQT,SOURCE=0 TITLE 'IECKDLQT QTAM DISTRIBUTION-LIST' 00400013 *********************************************************************** 00800013 * * 01200013 *NAME- * 01600013 * IECKDLQT QTAM DISTRIBUTION-LIST * 02000013 * * 02400013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 02800013 * * 03200013 *FUNCTION- * 03600013 * IECKDLQT WILL PUT A MESSAGE ON THE QUEUE FOR A PARTICULAR * 04000013 * DISTRIBUTION LIST WHEN THAT LIST NAME IS SPECIFIED AS THE * 04400013 * DESTINATION. THE ROUTINE WILL ALSO ROUTE THE MESSAGE TO THE * 04800013 * DESTINATIONS SPECIFIED IN THE DISTRIBUTION LIST. * 05200013 * THE DESTINATION KEY IS OBTAINED FROM THE MESSAGE HEADER AND * 05600013 * STORED IN THE LCBDLPTR (LCB + 46) FIELD OF THE LCB. THIS KEY IS * 06000013 * THE OFFSET OF THE DISTRIBUTION LIST ENTRY FROM THE BEGINNING OF * 06400013 * THE TERMINAL TABLE. THE ADDRESS OF THE TERMINAL TABLE IS ADDED * 06800013 * TO THIS OFFSET TO GIVE THE ADDRESS OF THE LIST ENTRY. THE * 07200013 * DESTINATION ENTRIES ARE KEPT IN THE DISTRIBUTION LIST ENTRY AS * 07600013 * OFFSETS OF THAT TERMINAL TABLE ENTRY FROM THE BEGINNING OF THE * 08000013 * TABLE. THE OFFSET OF THE FIRST ENTRY IS OBTAINED AND INDEXED * 08400013 * TO THE BEGINNING OF TABLE ADDRESS TO YIELD THE ADDRESS IN THE * 08800013 * TERMINAL TABLE CORRESPONDING TO THE FIRST ENTRY IN THE * 09200013 * DISTRIBUTION LIST. THE QCB FOR THAT ENTRY IS MOVED TO LCBDESTQ * 09600013 * (LCB + 29). * 10000013 * IF THIS IS THE FIRST TIME THROUGH THIS ROUTINE EVER, THEN * 10400013 * CONTROL IS PASSED TO THE ENDINSRT ROUTINE IN IGG019NG. ENDINSERT * 10800013 * WILL PUT THIS ROUTINE ON A QUEUE FOR ROUTINES TO BE EXECUTED BY * 11200013 * CLEANUP. THE BRANCH TO ENDINSRT FROM IECKDLQT IS MODIFIED SO * 11600013 * THAT HEREAFTER THIS BRANCH WILL BE TO THE PRIORITY ROUTINE. * 12000013 * THE MESSAGE IS POSTED TO THE DISTRIBUTION LIST QUEUE. * 12400013 * AT CLEANUP TIME FOR THIS MESSAGE, CONTROL WILL PASS TO * 12800013 * THE ENTRY POINT DLRET. THIS BEGINS THE SECOND * 13200013 * FUNCTION OF THIS ROUTINE: DISTRIBUTING THE MESSAGE TO THE * 13600013 * DESIRED QUEUES FOR SUBSEQUENT TRANSMISSION. * 14000013 * THE ROUTINE WILL OBTAIN THE OFFSETS FROM THE DISTRIBUTION * 14400013 * LIST, ADD THE ADDRESS OF THE TERM TABLE AND GET THE QCB FROM THE * 14800013 * TABLE ENTRY. THE MESSAGE HEADER IS RECALLED USING THE RECALL * 15200013 * ROUTINE, AND THE DESTINATION CODE IS PLACED IN THE TTDKEY * 15600013 * (TERMINAL TABLE ADDRESS + 26) FIELD OF THE HEADER PREFIX. * 16000013 * CONTROL IS PASSED TO THE BUFFER CLEANUP ROUTINE TO POST THE * 16400013 * MESSAGE TO THE PROPER DESTINATION QUEUE. * 16800013 * WHEN CLEANUP HAS COMPLETED ITS FUNCTION, CONTROL IS AGAIN * 17200013 * PASSED TO THE DLRET ENTRY IN THIS ROUTINE. THE POINTER TO * 17600013 * OFFSETS IN THE DISTRIBUTION LIST IS UPDATED. THIS CYCLE IS * 18000013 * REPEATED UNTIL ALL THE ENTRIES IN THE LIST HAVE BEEN HANDLED. * 18400013 * CONTROL PASSES TO THE POINT IN THE CLEANUP ROUTINE WHICH WILL * 18800013 * HANDLE FINAL CLEANUP AT THIS TIME. * 19200013 * * 19600013 *ENTRY POINTS- * 20000013 * THERE ARE TWO UNLABELED ENTRY POINTS. THE FIRST IS AT IECKDLQT+14.* 20400013 * ENTRY HERE IS FROM IECKQQ01 WHEN THE DESTINATION CODE FOR A * 20800013 * MESSAGE IS A DISTRIBUTION LIST. * 21200013 * THE SECOND IS ENTERED FROM THE CLEANUP ROUTINE AFTER THE * 21600013 * MESSAGE HAS BEEN PUT ON THE DESTINATION QUEUE, AND THE LCB * 22000013 * FOR THIS DESTINATION CODE HAS COME TO THE TOP OF THE * 22400013 * READY QUEUE. * 22800013 * * 23200013 *INPUT- * 23600013 * REGISTER 1- ADDRESS OF THE ECB FOR THE BUFER. * 24000013 * * 24400013 *OUTPUT- * 24800013 * NONE. * 25200013 * * 25600013 *EXTERNAL ROUTINES- * 26000013 * ENDINSRT (IN MODULE IGG019NG). * 26400013 * PRIORITY (IN MODULE IECKQQQ1). * 26800013 * RECALL (IECKRC IN MODULE IGG019NG). * 27200013 * * 27600013 *EXITS- * 28000013 * NORMAL - CONTROL PASSES TO THE CLEANUP ROUTINE (IECKPR) TO POST * 28400013 * MESSAGE TO DISTRIBUTION LIST QUEUE. EXIT IS TO AN UNLABLED * 28800013 * POINT IN CLEANUP WHEN ALL DESTINATIONS HAVE BEEN PROCESSED. * 29200013 * * 29600013 *TABLES/WORK AREAS- * 30000013 * NONE. * 30400013 * * 30800013 *ATTRIBUTES- * 31200013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 31600013 * * 32000013 * NOTES- * 32400013 * REGISTER 0- THE OFFSET OF THE DESIRED DESTINATION ENTRY FROM * 32800013 * THE BEGINNING OF THE TERMINAL TABLE. * 33200013 * REGISTER 4- BASE FOR THIS LCB. * 33600013 * REGISTER 8- DESTINATION KEY FOR DISTRIBUTION LIST. * 34000013 * REGISTER 9- BASE FOR THIS ROUTINE. * 34400013 * REGISTER 12- BASE FOR CONTROL PROGRAM. * 34800013 * * 35200013 *********************************************************************** 35600013 IECKDLQT START 36000013 *2010686000 6930 36200016 QWAIT EQU 65 36400013 DREG0 EQU 0 36800013 FREG EQU 1 37200013 TREG EQU 2 37600013 Y EQU 3 38000013 LCBREG EQU 4 38400013 X EQU 6 38800013 MSREG EQU 6 39200013 TCREG EQU 8 39600013 QREG EQU 9 40000013 TCBREG EQU 10 40400013 BREG EQU 12 40800013 * IN THIS ROUTINE, REGISTER 13 HAS A POINTER TO IGG019NG 41200013 SPACE 41600013 USING IECKLCB0,LCBREG 42000013 USING IECKPREF,FREG 42400013 USING IECKDLQT,9 42800013 USING CTLPROG+2,BREG 43200013 * DISTRIBUTION-LIST SUBTASK 43600013 * STCB--PRE-ASSEMBLED IN MODULE IECKDLQT, LOCATED AT IECKDLQT+8. 44000013 * PROGRAM ENTRY--ENTERS THE MODULE AT IECKDLQT + 14. 44400013 * DISTRIBUTION LIST QUEUE 44800013 * QCB--PRE-ASSEMBLED IN THE MODULE (IECKDLQT) INTRODUCED 45200013 * BY THE APPEARANCE OF THE LIST MACRO-INSTR IN THE PROB PROG. 45600013 * ELEMENT CHAIN--LIMITED TO THE DUMMY LAST ELEMENT 46000013 * LABELED IECKSTOP. NO ELEMENT CHAIN IS DEVELOPED. 46400013 * ELEMENTS RELATED TO A DISTRIBUTION LIST ARE 46800013 * IMMEDIATELY TRANSFERRED TO THE DESTINATION-DASD 47200013 * QUEUE FOR THE FIRST TERMINAL IN THE DISTRIBUTION LIST. 47600013 * STCB--LIMITED TO THE STCB FOR THE DISTRIBUTION-LIST SUBTASK. 48000013 DC 2A(0) 48400013 DC AL1(2) 48800013 DC AL3(IECKDLQT+8) 49200013 DC AL1(255) 49600013 L LCBREG,MSLCB-1 GET ADDRESS OF LCB FROM PREFIX 50000013 LH TCREG,TTDKEY GET DESTINATION KEY FROM PREFIX 50400013 LA 15,DLRET ESTABLISH NEW BASE SO THAT REGISTER 50800013 * 9 CAN BE USED 51200013 USING DLRET,15 51600013 BAL 14,DLTEST GO GET ADDRESS OF NEXT ENTRY IN LIST 52000013 NOP 0 ENTRY POINT WHEN USER HAS SPECIFIED LIST 52400013 * WITHOUT ENTRIES 52800013 STH DREG0,TTDKEY PUT OFFSET IN PREFIX 53200013 MVC 1(3,FREG),1(TCREG) PUT QCB FOR DESTINATION INTO ECB 53600013 * OF BUFFER 54000013 LA 9,80(0,13) GET ADDRESS OF READY QUEUE 54400013 SPACE 54800013 CNOP 0,4 55200013 L 3,0(13) ADDRESS OF LPS SECTION OF NG 55600013 BAL 3,300(0,3) TO ROUTINE ENDINSRT IN NG. THIS 56000013 * BRANCH ADDRESS CHANGED IN THE 56400013 * ENDINSRT ROUTINE OF IGG019NG 56800013 * SO THAT THE BRANCH IS TO 57200013 * PRIORITY AFTER FIRST TIME 57600013 DLRET DC X'C000' THIS IS OVERLAID IN THE ENDINSRT 58000013 DC S(PRIORITY) ROUTINE OF IGG019NG TO BE THE 58400013 * ADDRESS OF THE NEXT ROUTINE 58800013 * IN THE QUEUE 59200013 USING IECKPREF,MSREG 59600013 LH TCREG,LCBDLPTR GET OFFSET TO DISTRIBUTION LIST 60000013 LTR TCREG,TCREG IS THERE AN ENTRY 60400013 BCR 8,14 BRANCH IF NO 60800013 MVC LCBCECB+1(3),LCBCHDR SAVE HEADER FOR INSERTION IN QUEUE 61200013 * OF NEXT DESTINATION 61600013 LA TCREG,2(0,TCREG) BUMP TO NEXT ENTRY IN LIST 62000013 DLTEST STH TCREG,LCBDLPTR STORE DESTINATION KEY IN POINTER 62400013 * TO NEXT ENTRY IN DISTRIBUTION 62800013 * LIST 63200013 A TCREG,=V(TERMTBL) GET ADDRESS OF LIST 63600013 LH TCREG,18(0,TCREG) GET OFFSET TO LIST ENTRY IN TABLE 64000013 LTR DREG0,TCREG IS THERE AN ENTRY IN TERMTBL 64400013 BCR 8,14 BRANCH IF NO 64800013 A TCREG,=V(TERMTBL) ELSE GET ADDRESS OF ENTRY 65200013 MVC LCBDESTQ,1(TCREG) PUT QCB ADDRESS IN LCB 65600013 BAL 3,4(0,14) WHEN THIS ROUTINE IS ENTERED FROM 66000013 * IGG019NG, THIS BRANCH GOES TO 66400013 * A SPECIAL ENTRY IN THE RECALL 66800013 * ROUTINE TO RETRIEVE THE HEADER 67200013 * A SPECIAL ENTRY IS REQUIRED 67600013 * SINCE NO BUFFER IS AVAILABLE 68000013 * FOR A NORMAL ENTRY 68400013 NI MSTATUS,X'FB' 6930 68600016 SPACE 68800013 STH DREG0,TTDKEY STORE DESTINATION IN PREFIX UPON 69200013 * RETURN 69600013 NI LCBSTATE,X'FD' SET LCBSTATE 70000013 L 15,0(0,13) GET ADDRESS OF THE LPS QUEUE 70400013 BC 15,244(0,15) GO TO BUFFER CLEANUP IN IGG019NG 70800013 SPACE 71200013 EJECT 71600013 USING TBLOCK,Y 72000013 USING QBLOCK,QREG 72400013 USING TCB,TCBREG 72800013 CTLPROG DSECT 73200013 QATTACH EQU X'48' 73600013 QSAVE EQU X'4C' 74000013 READY EQU X'50' 74400013 IRBSAVE EQU X'54' 74800013 WAITRB EQU X'58' 75200013 DUMMY EQU X'60' 75600013 NRET EQU X'76' 76000013 EJECT 76400013 CTLPROGD 76800013 EJECT 77200013 PREFIXD 77600013 EJECT 78000013 TCBD 78400013 EJECT 78800013 STCBD 79200013 EJECT 79600013 QCBD 80000013 EJECT 80400013 LCBD 80800013 END 81200013 ./ ADD SSI=02012010,NAME=IECKEOAD,SOURCE=0 TITLE 'IECKEOAD QTAM END-OF-ADDRESS (EOA)' 00700013 *********************************************************************** 01400013 * * 02100013 *NAME- * 02800013 * IECKEOAD QTAM END-OF-ADDRESS (EOA) * 03500013 * * 04200013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04900013 * * 05600013 *FUNCTION- * 06300013 * IECKEOAD CAUSES MULTIPLE ROUTING OF AN INCOMING MESSAGE * 07000013 * WHEN ONE OR MORE DESTINATIONS ARE SPECIFIED IN THE HEADER. * 07700013 * THE ROUTINE IS ENTERED AFTER MSGTYPE HAS FOUND THE NEXT * 08400013 * FIELD IN THE HEADER NOT TO BE THE EOA CHARACTER. THE ROUTINE * 09100013 * GETS THE OFFSET OF THIS DESTINATION AND STORES IT AT * 09800013 * LCBMPLRT (LCB+32). IF THIS IS THE FIRST TIME THROUGH THIS * 10500013 * ROUTINE, CONTROL IS PASSED TO ENDINSRT. ENDINSRT PLACES THE * 11200013 * ADDRESS OF THE SECOND SECTION OF THE EOA ROUTINE INTO A CHAIN * 11900013 * OF ADDRESSES OF ROUTINES TO BE ENTERED BY CLEANUP IN ITS HANDLING * 12600013 * OF INCOMING AND OUTGOING MESSAGES. PRIOR TO RETURNING TO EOA, * 13300013 * ENDINSRT OVERLAYS THE SECOND OPERAND OF THE BAL INSTRUCTION IN THE* 14000013 * EOA ROUTINE WITH THE ADDRESS OF THE SKIP CHARACTER SET ROUTINE. * 14700013 * ENDINSRT THEN RETURNS TO THAT BAL INSTRUCTION, WHICH BRANCHES TO * 15400013 * SKIP CHARACTER SET. SKIP CHARACTER SET BY-PASSES ANY * 16100013 * INTERVENING DESTINATION CODES AND RETURNS TO THE NEXT INSTRUCTION * 16800013 * IN THE EOA MACRO EXPANSION. * 17500013 * THE NEXT MACRO INSTRUCTION MAKES A TEST TO SEE IF A * 18200013 * DUPLICATE MESSAGE HEADER IS BEING HANDLED. IF THE HEADER IS NOT * 18900013 * A DUPLICATE, NORMAL LPS HEADER PROCESSING CONTINUES. IF IT IS A * 19600013 * DUPLICATE HEADER, A BRANCH IS MADE TO ENDRCV MACRO EXPANSION SINCE* 20300013 * LPS HEADER PROCESSING HAS ALREADY BEEN PERFORMED FOR THIS HEADER. * 21000013 * AFTER THE CLEANUP ROUTINE HAS COMPLETED THE ROUTING OF A * 21700013 * MESSAGE TO THE APPROPRIATE DASD DESTINATION OR PROCESS QUEUE, A * 22400013 * TEST IS MADE TO SEE IF MULTIPLE ROUTING IS IN PROGRESS. IF IT IS * 23100013 * NOT, RETURN IS TO THE CLEANUP ROUTINE. IF MULTIPLE ROUTING IS IN * 23800013 * PROGRESS, LINKAGE IS MADE TO THE RECALL ROUTINE TO OBTAIN A * 24500013 * DUPLICATE COPY OF THE HEADER. THE SCAN POINTER IS RESET TO POINT * 25200013 * TO THE NEXT DESTINATION CODE IN THE HEADER BY USING ITS OFFSET * 25900013 * PREVIOUSLY COMPUTED. EXIT IS TO THE ROUTE ROUTINE TO HANDLE THIS * 26600013 * DESTINATION CODE. THIS CONTINUES UNTIL THERE ARE NO MORE * 27300013 * DESTINATIONS. * 28000013 * * 28700013 *ENTRY POINTS- * 29400013 * IECKEOAD - CONTROL IS PASSED HERE WHEN MSGTYPE HAS GOTTEN THE * 30100013 * NEXT FIELD AND FOUND IT NOT TO BE THE EOA CHARACTER. * 30800013 * THERE IS AN UNLABELED ENTRY POINT WHICH BEGINS A SEPERATE * 31500013 * SECTION OF CODE EXECUTED ONLY WHEN ENTRY IS FROM THE * 32200013 * CLEANUP ROUTINE. * 32900013 * * 33600013 *INPUT- * 34300013 * REGISTER 1- ENTRY POINT REGISTER. * 35000013 * REGISTER 14- RETURN ADDRESS OF NEXT LPS INSTRUCTION. * 35700013 * REGISTER 14 ALSO SERVES AS A PARAMETER REGISTER, PASSING * 36400013 * THE FIELD SIZE AND EOA CHARACTER SPECIFIED IN THE MACRO. * 37100013 * REGISTER 15- ENTRY POINT ADDRESS. * 37800013 * * 38500013 *OUTPUT- * 39200013 * NONE. * 39900013 * * 40600013 *EXTERNAL ROUTINES- * 41300013 * IECKSKPS. * 42000013 * ENDINSRT (IN MODULE IGG019NG). * 42700013 * RECALL (IECKRC IN MODULE IGG019NG). * 43400013 * IECKROUT. * 44100013 * * 44800013 *EXITS- * 45500013 * NORMAL- RETURN IS TO ROUTE UNTIL ALL MULTIPLE ROUTING CEASES, * 46200013 * THEN RETURN IS TO THE CLEANUP ROUTINE. * 46900013 * ERROR - NONE. * 47600013 * * 48300013 *TABLES/WORK AREAS- * 49000013 * NONE. * 49700013 * * 50400013 *ATTRIBUTES- * 51100013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 51800013 * * 52500013 *NOTES- * 53200013 * REGISTER 3- SECOND LEVEL RETURN ADDRESS FOR BRANCHES TO ENDINSRT * 53900013 * OR SKIP. * 54600013 * REGISTER 4- BASE FOR LCB. * 55300013 * REGISTER 5- WORK REGISTER. PRESENT POSITION IN HEADER. * 56000013 * REGISTER 6- WORK REGISTER. ADDRESS OF BEGINNING OF BUFFER. * 56700013 * * 57400013 *********************************************************************** 58100013 IECKEOAD START 58800013 *2010850000 6930 59100018 DREG1 EQU 1 59500013 RREG2 EQU 3 60200013 LCBREG EQU 4 60900013 SPREG EQU 5 61600013 MSREG EQU 6 62300013 WREG1 EQU 9 63000013 RREG1 EQU 14 63700013 SREG EQU 15 64400013 USING *,DREG1 65100013 USING IECKLCB0,LCBREG 65800013 USING IECKPREF,MSREG 66500013 LA WREG1,256-31(0,SPREG) THIS CODE GETS THE OFFSET, FROM 67200013 SR WREG1,MSREG THE START OF THE HEADER, OF 67900013 * THE DESTINATION IN THE HEADER 68600013 * BY SUBTRACTING THE PREFIX SIZE 69300013 * AND BUFFER ADDRESS FROM THE 70000013 * SCAN POINTER 70700013 STC WREG1,LCBMPLRT STORE THE OFFSET IN THE LCB 71400013 L SREG,=V(IECKSKPS) GET ADDRESS OF SKIP TO CHARACTER SET 72100013 CNOP 0,4 72800013 L 3,0(13) ADDRESS OF LPS SECTION OF NG 73500013 BAL 3,300(0,3) TO ROUTINE ENDINSRT IN NG. 74200013 * INSTRUCTION IS OVERLAID IN THE 74900013 * ENDINSRT ROUTINE TO BRANCH 75600013 * TO THE SKIP ROUTINE AFTER THE 76300013 * FIRST TIME 77000013 USING *,SREG 77700013 DC X'8000F000' THIS CONSTANT IS CHANGED BY ENDINSRT 78400013 * TO REFLECT THE ADDRESS OF THE 79100013 * NEXT ROUTINE TO BE HANDLED BY 79800013 * THE BUFFER CLEANUP ROUTINE 80500013 CLI LCBMPLRT,0 HAS MULTIPLE ROUTING BEEN SPECIFIED 81200013 BCR 8,14 BRANCH IF NO TO THE ROUTINE 81900013 * SPECIFIED IN THE ABOVE CONSTANT 82600013 MVC LCBCECB+1(3),LCBCHDR SAVE HEADER FOR INSERTION IN QUEUE 83300013 * OF NEXT DESTINATION 84000013 BAL RREG2,4(0,14) GO TO SPECIAL ENTRY IN RECALL ROUTINE 84700013 NI MSTATUS,X'FB' 6930 85000018 SR SPREG,SPREG CLEAR THE SCAN POINTER 85400013 STH SPREG,LCBERRST CLEAR LCB ERROR INDICATOR 86100013 STH SPREG,LCBDLPTR CLEAR DISTRIBUTION LIST POINTER 86800013 IC SPREG,LCBMPLRT GET MULTIPLE ROUTE POINTER 87500013 LA SPREG,HDSTRT-1(SPREG) RESET SCAN POINTER TO OFFSET OF 88200013 * NEXT DESTINATION FROM END OF PREFIX 88900013 MVI LCBMPLRT,0 CLEAR MULTIPLE ROUTE INDICATOR 89600013 L RREG1,LCBSTATE RELOAD RETURN ADDRESS TO EOA MACRO 90300013 * SAVED BY ROUTE ROUTINE 91000013 L SREG,=V(IECKROUT) GET ADDRESS OF THE ROUTE ROUTINE 91700013 BR SREG GO TO THE ROUTE ROUTINE 92400013 EJECT 93100013 LCBD 93800013 EJECT 94500013 PREFIXD 95200013 END 95900013 ./ ADD SSI=03011062,NAME=IECKEOBC,SOURCE=0 *NAME- * 00400013 * IECKEOBC QTAM END-OF-BLOCK AND LINE CORRECTION * 00800013 * * 01200013 *STATUS- CHANGE LEVEL 001 OS QTAM II * 01600013 * * 02000013 *FUNCTION- * 02400013 * IF THE MESSAGE WAS CANCELLED OR AN ERROR MESSAGE WAS SENT, * 02800013 * RETURN IS TO THE NEXT LPS INSTRUCTION. * 03200013 * IF THERE WAS A DATA CHECK, THE RETRY COUNTER IS INCREMENTED * 03600013 * BY ONE. IF THE RETRY COUNT IS THREE, RETURN IS TO THE NEXT LPS * 04000013 * INSTRUCTION. OTHERWISE, THE ROUTINE BRANCHES TO THE RECALL * 04400013 * ROUTINE OF IGG019NG TO OBTAIN THE HEADER. IF THE LINE IS SENDING,* 04800013 * THE CODE FOR WRITE CONTINUE IS SET IN THE LCBCECB FIELD (LCB + 4) * 05200013 * OF THE LCB, AND RETURN IS TO LPSTART TO RETRY THE OPERATION. IF * 05600013 * THE LINE IS NOT SENDING, ACTION IS TAKEN TO RETRY RECEIVING THE * 06000013 * MESSAGE. IF THERE IS AN EOB IN THE HEADER SEGMENT, THE MESSAGE * 06400013 * IS CANCELLED AND A NEW FIRST BUFFER IS SET UP. IF THERE IS NO * 06800013 * EOB PRESENT IN ANY BUFFER POSITION OTHER THAN THE LAST * 07200013 * POSITION, THE CANCEL BIT OF MSTATUS IS SET TO A ONE (HEADER * 07600013 * PREFIX + 12 IS OR'ED WITH A X'80'). THE LAST SEQUENCE NUMBER IN * 08000013 * THE TERMINAL TABLE IS STORED IN TSEQUIN (TERMINAL TABLE ENTRY + * 08400013 * 4) FIELD, UNLESS THE NUMBER IS ZERO. LINKAGE IS MADE TO THE * 08800013 * RECALL ROUTINE TO OBTAIN THE HEADER. THE SCAN POINTER IS UPDATED * 09200013 * TO CONTAIN MESSAGE SIZE AND THE LCBTRST FIELD OF THE LCB (LCB+82) * 09600013 * IS UPDATED TO CONTAIN THE ADDRESS OF THE EOB CHARACTER RELATIVE * 10000013 * TO THE ADDRESS OF THE LAST CORRECTLY TRANSMITTED SEGMENT OF THE * 10400013 * CURRENT MESSAGE. AN END OF ADDRESS CHARACTER IS SET UP, AND THE * 10800013 * HEADER IS FILLED WITH IDLE CHARACTERS IN THE SPACE RESERVED FOR * 11200013 * TIME, DATE, OR SEQUENCE NUMBER. THE DISTRIBUTION LIST AND * 11600013 * MULTIPLE ROUTE INDICATORS AT LCBDLPTR (LCB + 46) AND LCBMPLRT * 12000013 * (LCB + 32) RESPECTIVELY ARE SET TO ZERO, AND THE ERROR HALF WORD * 12400013 * AT LCBERRST (LCB +40) IS SET TO ZERO. FOR ALL RECEIVING * 12800013 * MESSAGES, THE END OF MESSAGE IS SET IN THE MSTATUS FIELD OF THE * 13200013 * PREFIX (PREFIX +12 IS OR'ED WITH A X'02') AND THE RETRY OPERAND * 13600013 * IS SET AT LCBCECB (LCB + 4 IS REPLACED BY A X'07') AND THE * 14000013 * BUFFER SIZE IS STORED IN MSEGSZE (PREFIX + 8). THE LCBCLCCW AT * 14400013 * LCB + 36 IS SET TO REUSE THE BUFFER AND RETURN IS TO THE ACTIVATE * 14800013 * ROUTINE. (WRITE INITIAL IS SET FOR 1030 AND 1060 TERMINALS * 15200013 * INSTEAD OF WRITE CONTINUE). * 15600013 * IF THERE WAS NO DATA CHECK AND EITHER END OF TRANSMISSION, * 16000013 * UNIT EXCEPTION, OR UNIT CHECK HAS BEEN ENCOUNTERED OR THE RESIDUAL* 16400013 * COUNT OF THE CSW IS ZERO, THEN RETURN IS TO THE NEXT LPS * 16800013 * INSTRUCTION. IF NONE OF THESE CONDITIONS OCCURRED, THE END OF * 17200013 * BLOCK BIT IN THE PREFIX IS SET (MSTATUS AT PREFIX + 12 IS OR'ED * 17600013 * WITH A X'20') SINCE IT IS INDICATED THAT THE MESSAGE WAS * 18000013 * TRANSMITTED CORRECTLY. THE SCAN POINTER IS UPDATED TO CONTAIN * 18400013 * THE MESSAGE SIZE AND IS STORED IN THE MSPTR FIELD OF THE PREFIX * 18800013 * AT PREFIX + 25. THE RETRY COUNTER IS SET TO ZERO IN THE LCBERRST * 19200013 * FIELD OF THE LCB. THE LCBTRST HALF WORD IS UPDATED BY STORING * 19600013 * THE MESSAGE SEGMENT SIZE IN THIS FIELD. IF THE TRANSMISSION WAS * 20000013 * A WRITE OPERATION AND THE NEXT CHARACTER TO BE WRITTEN IS AN END * 20400013 * OF TRANSMISSION, RETURN IS TO THE NEXT LPS INSTRUCTION. OTHERWISE* 20800013 * AN END OF BLOCK INDICATION IS SET IN THE LCBCECB FIELD OF THE LCB.* 21200013 * FOR BOTH OPERATIONS THE BUFFER IS SET UP TO BE REUSED AND THE * 21600013 * ROUTINE BRANCHES TO THE ACTIVATE ROUTINE, AND RETURN IS FROM THE * 22000013 * ACTIVATE ROUTINE. * 22400013 * * 22800013 *ENTRY POINTS- * 23200013 * IECKEOBC - EXPANSION OF THE EOBLC MACRO GENERATES A BALR TO THIS * 23600013 * POINT USING REGISTER 15 AS THE BRANCH ADDRESS REGISTER * 24000013 * AND REGISTER 14 AS THE RETURN REGISTER. * 24400013 * * 24800013 *INPUT- * 25200013 * REGISTER 3- CONTAINS THE ADDRESS OF THE DCB ASSOCIATED WITH THE * 25600013 * TRANSMISSION. * 26000013 * REGISTER 4- ADDRESS OF THE LCB. * 26400013 * REGISTER 5- POINTER TO BYTE BEFORE CURRENT CHAR IN SEGMENT. * 26800013 * REGISTER 6- BUFFER ADDRESS. * 27200013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 27600013 * REGISTER 8- TERMINAL TABLE SOURCE ENTRY. * 28000013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT. * 28400013 * REGISTER 14- RETURN ADDRESS . * 28800013 * REGISTER 15- ENTRY POINT. * 29200013 * * 29600013 *OUTPUT- * 30000013 * REGISTER 5- CONTAINS MESSAGE SEGMENT SIZE. * 30400013 * REGISTER 11- CONTAINS ADDRESS OF LAST CHARACTER IN MESSAGE. * 30800013 * * 31200013 *EXTERNAL ROUTINES- * 31600013 * IECKACT - ACTIVATE ROUTINE OF IGG019NG TO REACTIVATE THE BUFFERS. * 32000013 * IECKRC - RECALL ROUTINE OF IGG019NG TO OBTAIN THE HEADER. * 32400013 * * 32800013 *EXITS- * 33200013 * NORMAL- EXIT IS TO NEXT LPS INSTRUCTION IF EITHER THE MESSAGE * 33600013 * WAS CANCELLED OR AN ERROR MESSAGE WAS SENT, OR IF * 34000013 * A DATA CHECK HAS NOT OCCURRED AND EITHER END OF * 34400013 * TRANSMISSION, UNIT CHECK, OR UNIT EXCEPTION IS * 34800013 * INDICATED. * 35200013 * ERROR- RETURN IS TO LPSTART TO RETRY THE OPERATION IF A * 35600013 * TRANSMISSION ERROR OCCURRED. IF THE ERROR HAS * 36000013 * OCCURRED THREE TIMES, THEN RETURN IS TO THE NEXT LPS * 36400013 * INSTRUCTION. * 36800013 * * 37200013 *TABLES/WORK AREAS- * 37600013 * BYTE - A ONE-BYTE WORK AREA USED TO SAVE THE MODEL AND ADAPTER * 38000013 * TYPE FOR TESTING FOR 1030 OR 1060 TERMINALS. * 38400013 * * 38800013 *ATTRIBUTES- * 39200013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 39600013 * * 40000013 *NOTES- * 40400013 * REGISTER 3- SECOND LEVEL RETURN REGISTER FROM RECALL ROUTINE. * 40800013 * REGISTER 9- WORK REGISTER AND BRANCH ADDRESS REGISTER TO ACTIVATE* 41200013 * ROUTINE. * 41600013 * REGISTER 12- WORK REGISTER USED TO SET UP EOA CHARACTER. * 42000013 * * 42400013 *********************************************************************** 42800013 IECKEOBC START 43200013 *3160468000,716000 00PS 43300015 *3160532000 2202 43400015 *3410666000 8308 43500017 *1200556000,648800-651200 23161 43530018 *1200728000 00PS 43560018 * 532100-532200,715000,870000 M3156 43580018 * 715000 M3174 43590018 * 724600-727000 A37721 43595020 DREG1 EQU 1 43600013 RREG2 EQU 3 44000013 LCBREG EQU 4 44400013 SPREG EQU 5 44800013 MSREG EQU 6 45200013 LGREG EQU 7 45600013 TCREG EQU 8 46000013 WREG1 EQU 9 46400013 IREG EQU 2 00PS 46800015 EOSREG EQU 11 47200013 WREG2 EQU 12 47600013 RREG1 EQU 14 48000013 SREG EQU 15 48400013 UCBDEV EQU 16 48800013 DEBUCB EQU 32 49200013 USING *,SREG 49600013 USING IECKPREF,MSREG 50000013 USING IECKLCB0,LCBREG 50400013 USING IHADCB,IREG 50800013 USING IECKTERM,TCREG 51200013 TM MSTATUS,64 TEST IF CANCELLED OR ERROR MSG SENT 51600013 BO CLEAR IF SO RETURN 52000013 L IREG,LCBDCBPT ADDRESS OF THE DCB 52400013 L IREG,DCBDEBAD ADDRESS OF THE DEB 52800013 L IREG,DEBUCB(IREG) ADDRESS OF A UCB FOR THIS LINE GROUP 53200013 TM LCBCSW+4,1 TEST FOR EOT RECEIVED M3156 53210018 BO CLEAR IF YES, RETURN TO LPS M3156 53220018 TM LCBECBPT,X'7F' TEST CONDITION CODE FOR ERROR 2202 53250015 * X'7F' NORMAL COMPLETION 2202 53300015 * X'FF' NORMAL COMPLETION,SIO 2202 53350015 * X'41' PERMANENT ERROR 2202 53400015 * X'F1' PERMANENT ERROR,SIO 2202 53450015 BO XXX BRANCH IF EITHER NORMAL COMP. 2202 53500015 TM LCBERRST+1,X'03' HAVE WE FAILED THREE TIMES 53600013 BO CKEND CHECK FOR END OF MESSAGE 54000013 BNZ RETRNSMT 54400013 XXX TM LCBCSW+4,X'03' TEST FOR EOT OR OTHER ERRORS2202 54800015 BNZ CLEAR IF YES,RETURN TO LPS 55200013 TSTZERO OC LCBCSW+6(2),LCBCSW+6 IS RESIDUAL COUNT ZERO 21858 55600018 BE CLEAR IF YES,RETURN TO LPS 56000013 OI MSTATUS,X'20' SET EOB BIT IN PREFIX 56400013 TM MSTATUS,1 IS THIS A TEXT SEGMENT 56800013 BC 7,PRTEXT IF YES CONTINUE - OTHERWISE 57200013 LA WREG1,HDSTRT-1 GET START OF MESSAGE HEADER 57600013 SR SPREG,WREG1 ADJUST SCAN POINTER TO MSG SIZE 58000013 STC SPREG,MSPTR AND RESTORE IN HEADER PREFIX 58400013 PRTEXT MVC LCBCECB+1(3),LCBCSEG STORE ADDR OF EOB CHAR 58800013 LH WREG1,MSEGSZE GET SIZE OF PARTIAL BUFFER 59200013 STH WREG1,LCBTRST SAVE IT FOR TRANSLATE AND ERROR 59600013 AH WREG1,LCBCSW+6 ADDBACK REMAINDER OF BUFFER 60000013 MVI LCBCECB,3 SET READ CONTINUE OP FOR BTAM 60400013 TM LCBSTATE,X'04' TEST FOR WRITE OPERATION 60800013 BC 8,PREBTAM IF NOT,BR TO SET UP REST OF DECB 61200013 BAL DREG1,TEST3060 GO TEST FOR 1030 OR 1060 61600013 B CLEAR RETURN TO LPS IS 1030 OR 1060 62000013 MVI LCBCECB,4 SET WRITE CONTINUE OP FOR BTAM 62400013 B PREBTAM GO SET UP REST OF DECB 62800013 RETRNSMT TM LCBSENSE,X'41' TIME OUT OR I R 63200013 BNZ CLEAR TREAT AS END OF MESSSAGE 63600013 TM LCBERCCW+2,1 TEST PREVIOUS PERM ERR FLAG 64000013 BO *+8 ON, DO NOT RESET ERRORS 64400013 NI LCBERRST+1,X'3F' RESET TRANSMISSION ERRORS 64800013 OI MSTATUS,X'80' SET CANCEL FLAG SO DESTINATION-23161 64880018 * DASD WILL NOT PLACE MESSAGE IN 23161 64960018 * QBACK CHAIN. CANCEL FLAG WILL BE23161 65040018 * TURNED OFF BY DESTINATION-DASD. 23161 65120018 L WREG1,0(0,13) GET ADDR OF NUCLEUS ENTRY TABLE 65200013 BAL RREG2,240(0,WREG1) BRANCH TO RECALL SUBR 65600013 TM LCBSTATE,4 IS LINE SENDING 66000013 BC 8,RECV IF NO, GO TO RECEIVE ROUTINE 66400013 OI MSTATUS,X'20' SET EOB BIT IN PREFIX 8308 66600017 MVI LCBCECB,4 SET WRITE CONTINUE OP FOR BTAM 66800013 BAL DREG1,TEST3060 GO TEST FOR 1030 OR 1060 67200013 MVI LCBCECB,2 SET WRITE INITIAL OP FOR BTAM 67600013 BCR 15,LGREG RETURN TO LPS 68000013 TEST3060 MVC BYTE(1),UCBDEV+3(IREG) ADAPTER TYPE TO WORK AREA 68400013 MVN BYTE(1),UCBDEV(IREG) MODEL TO WORK BYTE 68800013 CLI BYTE,X'12' TEST FOR 1030 69200013 BCR 8,DREG1 BRANCH IF 1030 69600013 CLI BYTE,X'21' TEST FOR 1060 70000013 BCR 8,DREG1 BRANCH IF 1060 70400013 BC 15,4(DREG1) RETURN NOT 1030 OR 1060 70800013 BYTE DC X'00' 71200013 RECV DS 0H M3174 71500018 TM MSTATUS,32 TEST FOR FIRST EOB IN MESSAGE 00PS 71800015 BC 7,GOOD BRANCH IF EOB NOT LAST IN BUFFER 72000013 OI MSTATUS,128 IF FIRST CANCEL AND RETURN TO DISK 72400013 L WREG1,LCBDESTQ-1 GET DESTINATION QCB ADDRESS A37721 72460020 USING QBLOCK,WREG1 A37721 72520020 LH WREG2,QSIZE GET COUNT OF MESSAGES IN Q A37721 72580020 BCTR WREG2,0 DECREMENT BY ONE A37721 72640020 STH WREG2,QSIZE AND RESTORE A37721 72700020 LH WREG1,MSNUMIN GET LAST SEQIN NUMBER 00PS 72800018 LTR WREG1,WREG1 IS SEQUENCE EQUAL ZERO 73200013 BE *+8 IF YES BRANCH 73600013 STH WREG1,TSEQUIN OTHERWISE LOAD TSEQUIN 74000013 L WREG1,0(0,13) GET ADDR OF NUCLEUS ENTRY TABLE 74400013 BAL RREG2,240(0,WREG1) BRANCH TO RECALL SUBR 74800013 LH WREG1,8(LGREG) RESET SCAN POINTER 75200013 STC WREG1,MSPTR 75600013 TM UCBDEV+3(IREG),X'70' TEST FOR 2260 76000013 BC 8,ENT260 BRANCH IF 2260 76400013 LA WREG2,HDSTRT-7-IECKPREF(WREG1) CHARACTER AFTER EOA 76800013 STH WREG2,LCBTRST FOR ACTIVATE AND TRANSLATE 77200013 LTR WREG1,WREG1 SPACE FOR TIME AND DATE 77600013 BC 8,ENT260 BRANCH IF NO 78000013 LA WREG1,1(0,WREG1) BUMP WREG1 78400013 LA WREG2,C'#' SETUP EOA CHARACTER 78800013 STC WREG2,HDSTRT-1(WREG1) AND FILL 79200013 LA WREG2,X'17' WITH IDLE CHARS 79600013 BCT WREG1,*-8 DECREMENT AND RETURN TO FILL 80000013 ENT260 SR WREG1,WREG1 80400013 STH WREG1,LCBDLPTR CLEAR DISTRIBUTION LIST AND 80800013 MVI LCBMPLRT,0 MULTIPLE ROUTE INDICATORS 81200013 NI LCBERRST,1 RESET HEADER ERROR FLAGS 81600013 GOOD L WREG2,=V(IECKBFSZ) GET ADDR OF BFR SIZE ENTRY 82000013 OI MSTATUS,2 TURN ON END OF MESSAGE 82400013 MVI LCBCECB,7 SET RETRY OP FOR ACTIVATE 82800013 LH WREG1,0(0,WREG2) GET SIZE OF BUFFER 83200013 PREBTAM STH WREG1,MSEGSZE AND STORE 83600013 LA EOSREG,MSEGSZE-1(WREG1) GET ADDR OF LAST CHAR IN BUFFER 84000013 LA WREG1,LCBCLPCI-9 RESET ACTIVATE TO REUSE BUFFER 84400013 ST WREG1,LCBCLCCW 84800013 L WREG1,0(0,13) GET ADDR OF NUCLEUS ENTRY TABLE 85200013 B 236(0,WREG1) BRANCH TO ACTIVATE SUBROUTINE 85600013 CKEND NI LCBERRST+1,X'FC' ZERO RETRY COUNTER 86000013 OI LCBERCCW+2,1 SET PREVIOUS ERROR FLAG 86400013 B TSTZERO TEST RESIDUAL COUNT M3156 87000018 CLEAR NI LCBERRST+1,X'FC' ZERO RETRY COUNTER 87600013 NI LCBERCCW+2,X'FE' CLEAR PREVIOUS ERROR FLAG 88000013 BR RREG1 RETURN TO LPS 88400013 EJECT 88800013 PREFIXD 89200013 EJECT 89600013 LCBD QTAM=3 90000013 EJECT 90400013 TERMTBLD 90800013 EJECT 90900020 QCBD 91000020 EJECT 91200013 DCBD DSORG=CX 91600013 END 92000013 ./ ADD SSI=03010183,NAME=IECKEOBK,SOURCE=0 TITLE 'IECKEOBK QTAM END-OF-BLOCK (EOB)' 00600013 *********************************************************************** 01200013 * * 01800013 * * 02400013 *NAME- * 03000013 * IECKEOBK QTAM END-OF-BLOCK (EOB) * 03600013 * * 04200013 *STATUS- CHANGE LEVEL= 18 JANUARY 1971 * 04800021 * * 05400013 *FUNCTION- * 06000013 * FOR A WTTA LINE GROUP, IF WRU SIGNAL RECEIVED (INDICATED BY * 06200021 * X'40' IN LCBINCAM), A READ CONTINUE IS SET UP. * 06400021 * THIS ROUTINE IS NOT EXECUTED AND RETURN IS TO THE NEXT LPS * 06600013 * INSTRUCTION IF ANY OF THE FOLLOWING CONDITIONS ARE SATISFIED: * 07200013 * 1) THE MESSAGE HAS BEEN CANCELLED. * 07800013 * 1) AN ERROR MESSAGE HAS BEEN SENT. * 08400013 * 3) THE MESSAGE HAS BEEN REROUTED. * 09000013 * 4) THE STATUS BYTE OF THE CSW INDICATES END OF TRANSMISSION. * 09600013 * 5) A UNIT EXCEPTION HAS OCCURRED. (NOT FOR 2260) * 10200021 * 6) THE RESIDUAL COUNT IN THE CSW IS ZERO. * 10800013 * IF NONE OF THE ABOVE HAVE OCCURRED, THE END OF BLOCK BIT IN * 11400013 * THE PREFIX IS SET (MSTATUS AT ADDRESS OF HEADER PREFIX + 8 IS * 12000013 * OR'ED WITH A X'20'), SINCE IT IS INDICATED THAT THIS MESSAGE WAS * 12600013 * TRANSMITTED CORRECTLY. IF THE SEGEMENT IS NOT A TEXT SEGMENT, * 13200013 * THE SCAN POINTER IS ADJUSTED TO CONTAIN THE MESSAGE SIZE, WHICH * 13800013 * IS PLACED IN THE MSPTR BYTE AT HEADER PREFIX +25. * 14400013 * THE LCBTRST HALF WORD AT LCB+82 IS UPDATED BY PLACING THE * 15000013 * SEGMENT SIZE, OBTAINED FROM MSGSIZE AT HEADER PREFIX + 8, IN THIS * 15600013 * FIELD. * 16200013 * IF THE TRANSMISSION WAS A WRITE OPERATION AND THE DEVICE IS A* 16800013 * 1030 OR A 1060, CONTROL IS RETURNED TO THE NEXT LPS INSTRUCTION. * 17400013 * OTHERWISE THE WRITE CONTINUE CODE OF X'04' IS SET AT LCBCEBC. IF * 18000013 * THE TRANSMISSION WAS A READ, THE OP CODE FOR A READ (X'03') IS * 18600013 * SET IN THE LCBCEBC FIELD OF THE LCB. IN BOTH CASES, THE BUFFER * 19200013 * IS SET TO BE REUSED. THE ROUTINE THEN BRANCHES TO THE ACTIVATE * 19800013 * ROUTINE OF IGG019NG AND CONTROL IS RETURNED TO THE CALLING ROUTINE* 20400013 * FROM THERE. * 21000013 * * 21600013 *ENTRY POINTS- * 22200013 * IECKEOBK - EXPANSION OF THE EOB MACRO GENERATES A BALR TO THIS * 22800013 * POINT USING REGISTER 15 AS THE BRANCH ADDRESS REGISTER * 23400013 * AND REGISTER 14 AS THE RETURN REGISTER. * 24000013 * * 24600013 *INPUT- * 25200013 * REGISTER 3- POINTER TO THE DCB ASSOCIATED WITH THE TRANSMISSION * 25800013 * REGISTER 4- ADDRESS OF THE LCB * 26400013 * REGISTER 5- POINTS TO THE LAST CHARACTER IN THE HEADER * 27000013 * REGISTER 6- BUFFER ADDRESS * 27600013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 28200013 * REGISTER 14- RETURN ADDRESS * 28800013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 29400013 * * 30000013 *OUTPUT- * 30600013 * IF NONE OF THE 6 CONDITIONS MENTIONED ABOVE ARE SATISFIED, THE * 31200013 * MSTATUS FIELD OF THE PREFIX INDICATES END OF BLOCK. ALSO, * 31800013 * IF THE OPERATION WAS A WRITE AND THE DEVICE IS NOT A 1030 OR * 32400013 * 1060, WRITE CONTINUE IS INDICATED IN THE LCB AT LCBCEBC BY A * 33000013 * X'04'. IF THE OPERATION WAS A READ, THE OP CODE FOR A READ * 33600013 * (X'03') IS SET IN THE LCBCEBC FIELD. IN BOTH CASES REGISTER * 34200013 * 11 IS SET TO POINT TO THE LAST CHARACTER IN THE BUFFER. * 34800013 * * 35400013 *EXTERNAL ROUTINES- * 36000013 * IECKACT - ACTIVATE MODULE IN IGG019NG TO SET UP THE BUFFER FOR * 36600013 * REUSE. * 37200013 * * 37800013 *EXITS- * 38400013 * NORMAL- IF ANY OF THE 6 CONDITIONS MENTIONED ABOVE ARE SATISFIED * 39000013 * OR IF THE TRANSMISSION WAS A WRITE OPERATION AND THE * 39600013 * DEVICE WAS A 1030 OR 1060, RETURN IS TO THE NEXT LPS * 40200013 * INSTRUCTION. * 40800013 * OTHERWISE, EXIT IS TO THE ACTIVATE ROUTINE, WHICH IN TURN * 41400013 * EXITS TO THE NEXT LPS INSTRUCTION. * 42000013 * ERROR- NONE. * 42600013 * * 43200013 *TABLES/WORK AREAS- * 43800013 * BYTE - A ONE-BYTE WORK AREA USED TO SAVE THE MODEL AND ADAPTER * 44400013 * TYPE FOR TESTING FOR 1030 OR 1060 TERMINALS. * 45000013 * * 45600013 *ATTRIBUTES- * 46200013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 46800013 * * 47400013 *NOTES- * 48000013 * REGISTER 9- WORK REGISTER. USED FOR MANIPULATION OF DATA WITHIN * 48600013 * THE ROUTINE AND AS THE BRANCH ADDRESS REGISTER TO THE * 49200013 * ACTIVATE ROUTINE. * 49800013 * * 50400013 *********************************************************************** 51000013 IECKEOBK START 51600013 *2719606700-610900,666000 000C 51900017 *1200636000 21858 52000018 * 618600-619200,623400,633000 M3164 52060018 * 619800-622800 M3126 52120018 *A048000,062000-064000,102000 S21016 52160021 *A622900-623200,D623400 A50579 52180021 DREG1 EQU 1 52200013 LCBREG EQU 4 52800013 SPREG EQU 5 53400013 MSREG EQU 6 54000013 WREG1 EQU 9 54600013 EOSREG EQU 11 55200013 WREG2 EQU 12 55800013 RREG1 EQU 14 56400013 SREG EQU 15 57000013 UCBDEV EQU 16 57600013 DEBUCB EQU 32 58200013 USING *,SREG 58800013 USING IECKPREF,MSREG 59400013 USING IECKLCB0,LCBREG 60000013 USING IHADCB,WREG1 60600013 L WREG1,LCBDCBPT ADDRESS OF THE DCB 000C 60670017 TM DCBCPOLL,X'68' IS IT A WTTA LINE GROUP 000C 60740017 BNO NOWTTA NO 000C 60810017 TM LCBINCAM,X'40' YES,IS WRU SIGNAL RECEIVED 000C 60880017 BCR 8,RREG1 NO,RETURN TO LPS 000C 60950017 B WTTA01 YES,PERFORM A READ CONTINUE 000C 61020017 NOWTTA EQU * 000C 61090017 TM MSTATUS,64 TEST IF CANCELLED OR ERROR MSG SENT 61200013 BCR 1,RREG1 IF SO RETURN 61800013 TM LCBCSW+4,1 TEST FOR EOT RECEIVED M3164 61860018 BCR 7,RREG1 IF YES, RETURN TO LPS M3164 61920018 L WREG2,DCBDEBAD ADDRESS OF THE DEB M3126 61980018 L WREG2,DEBUCB(WREG2) ADDRESS OF A UCB FOR THIS M3126 62040018 * LINE GROUP M3126 62100018 MVC BYTE(1),UCBDEV+3(WREG2) ADAPTER TYPE TO WORK AREA M3126 62160018 MVN BYTE(1),UCBDEV(WREG2) MODEL TYPE TO WORK AREA M3126 62220018 CLI BYTE,X'81' IS THIS A 2260 DEVICE M3126 62280018 BNE CKEOT NO, CONTINUE A50579 62290021 CLI LCBCECB,X'03' 2260 READ CONTINUE? A50579 62300021 BNE CKCOUNT NO, CHECK RESIDUAL COUNT A50579 62310021 CKEOT EQU * A50579 62320021 TM LCBCSW+4,X'03' TEST FOR EOT OR OTHER ERRORS 62400013 BCR 7,RREG1 IF YES,RETURN TO LPS 63000013 CKCOUNT EQU * M3164 63300018 OC LCBCSW+6(2),LCBCSW+6 IS RESIDUAL COUNT ZERO 21858 63600018 BCR 8,RREG1 IF YES,RETURN TO LPS 64200013 * 64800013 * EXIT IF 1030 OR 1060 65400013 * 66000013 WTTA01 EQU * 000C 66600017 OI MSTATUS,X'20' SET EOB BIT IN THE PREFIX 68400013 TM MSTATUS,1 IS THIS A TEXT SEGMENT 69000013 BC 7,PRTEXT IF YES CONTINUE - OTHERWISE 69600013 LA WREG1,HDSTRT-1 GET START OF MESSAGE HEADER 70200013 SR SPREG,WREG1 ADJUST SCAN PTR TO MESSAGE SIZE 70800013 STC SPREG,MSPTR AND RESTORE IN HEADER PREFIX 71400013 * SPREG INITIALLY POINTED TO THE LAST CHARACTER IN THE HEADER 72000013 * AT THIS POINT, MSEGSZE HAS BUFFER SIZE UP TO & INCLUDING 72600013 * THE EOB CHARACTER MINUS 8 BYTES FOR ECB 73200013 PRTEXT LH WREG1,MSEGSZE VALUE OF MSEGSZE AFTER NXT TRANSMN 73800013 STH WREG1,LCBTRST SAVE LIMIT OF AREA TRANS 74400013 AH WREG1,LCBCSW+6 WREG1 CONTAINS BUFFER SIZE MINUS 8 75000013 MVI LCBCECB,3 SET OP CODE FOR READ CONTINUE 75600013 TM LCBSTATE,X'04' IS THIS A WRITE OP 76200013 BC 8,BTAMENT IF YES, CHECK FOR EOT 76800013 CLI BYTE,X'12' TEST FOR 1030 78600013 BCR 8,RREG1 RETURN IF 1030 79200013 CLI BYTE,X'21' TEST FOR 1060 79800013 BCR 8,RREG1 RETURN IF 1060 80400013 CONTN MVI LCBCECB,4 SET OP CODE FOR WRITE CONTINUE 81000013 BTAMENT STH WREG1,MSEGSZE STORE IT - VARIABLE SEGMENT SIZE 81600013 LA EOSREG,MSEGSZE-1(WREG1) GET ADDR OF LAST CHAR IN BUFFER 82200013 LA WREG1,LCBCLPCI-9 RESET ACTIVATE TO REUSE BUFFER 82800013 ST WREG1,LCBCLCCW 83400013 L WREG1,0(0,13) GET ADDR OF NUCLEUS ENTRY TABLE 84000013 B 236(0,WREG1) BRANCH TO ACTIVATE SUBROUTINE 84600013 BYTE DC X'00' 85200013 EJECT 85800013 PREFIXD 86400013 EJECT 87000013 LCBD 87600013 EJECT 88200013 DCBD DSORG=CX 88800013 END 89400013 ./ ADD SSI=03013242,NAME=IECKERMG,SOURCE=0 *********************************************************************** 00500013 * * 01000013 *NAME- * 01500013 * IECKERMG QTAM ERROR MESSAGE (ERRMSG) * 02000013 * * 02500013 *STATUS- CHANGE LEVEL= 19 JANUARY 1971 * 03000021 * * 03500013 *FUNCTION- * 04000013 * IECKERMG CAUSES AN ERROR MESSAGE SPECIFIED BY THE CALLING * 04500013 * ROUTINE TO BE SENT TO A DESIGNATED TERMINAL IF ANY OF THE ERROR * 05000013 * CONDITIONS SPECIFIED IN THE ERROR MASK IN THE ERRMSG MACRO * 05500013 * EXPANSION IS INDICATED IN THE ERROR HALFWORD (LCBERRST AT LCB+43),* 06000013 * OR IF THE ERROR MASK IS ZERO. * 06500013 * IF NONE OF THE ERROR CONDITIONS SPECIFIED BY A NON-ZERO * 07000013 * ERROR MASK ARE INDICATED IN THE ERROR HALFWORD OF THE LCB, THEN * 07500013 * CONTROL IS RETURNED TO THE NEXT LPS INSTRUCTION. * 08000013 * IF THE MESSAGE IS TO BE RETRANSMITTED TO 2740 MOD 2 (INDI- * 08100021 * CATED BY X'FF' IN LCBCPA + 29), RETURN IS MADE TO THE LPS TO * 08200021 * AVOID DUPLICATE ERROR MESSAGES. * 08300021 * IF AT LEAST ONE OF THE ERROR CONDITIONS SPECIFIED HAS * 08500013 * OCCURRED, THE RECALL ROUTINE OF MODULE IGG019NG IS ENTERED TO * 09000013 * OBTAIN THE HEADER. THE SEQUENCE OUT NUMBER, MSNUMOUT IS ZEROED * 09300021 * FOR RETRIEVE. THEN A TEST IS MADE FOR THE OPTION OF * 09600021 * INCLUDING THE MESSAGE HEADER IN THE ERROR MESSAGE (A PERIOD AS * 10000013 * THE FIRST CHARACTER OF THE ERROR MESSAGE INDICATES INCLUSION OF * 10500013 * THE HEADER). IF THE HEADER IS NOT TO BE INCLUDED, THE SCAN * 11000013 * POINTER IS POSITIONED PAST THE CHARACTERS IN THE HEADER FOR THE * 11500013 * TIME AND DATE STAMP AND THE ERROR MESSAGE OVERLAYS THE REMAINDER * 12000013 * OF THE HEADER, AND THE NUMBER OF CHARACTERS SKIPPED IS PLACED IN * 12500013 * THE MSPTR FIELD OF THE HEADER PREFIX (AT PREFIX + 25). IF THE * 13000013 * HEADER IS TO BE INCLUDED, THE ERROR MESSAGE IS PLACED IN THE * 13500013 * BUFFER FOLLOWING THE HEADER IF THERE IS SUFFICIENT SPACE. IF NO * 13700021 * EOB IS PRESENT AND IF INCOMPLETE HEADER BIT (X'04') HAS BEEN SET * 13900021 * IN THE ERROR HALFWORD, THE SCAN POINTER IS DECREMENTED BY ONE TO * 14100021 * OVERLAY THE EOT. * 14300021 * LENGTH OF THE ERROR MESSAGE EXCEEDS THE SPACE IN THE BUFFER, THE * 14500013 * ERROR TEXT IS TRUNCATED FROM THE RIGHT. * 15000013 * THE MESSAGE SIZE IS PLACED IN THE MSGSIZE HALFWORD AT HEADER * 15500013 * PREFIX + 8, AND A X'46' IS PLACED IN THE MSTATUS BYTE AT HEADER * 16000021 * PREFIX + 12 TO INDICATE A SINGLE SEGMENT MESSAGE. * 16500013 * IF THERE HAS BEEN A SEQUENCE NUMBER ERROR, THE LAST VALID * 16600021 * SEQUENCE-IN NUMBER IS OBTAINED FROM THE TERMINAL TABLE. THE ERROR* 16700021 * TEXT IS SCANNED FOR A $. IF A $ IS FOUND, THE SEQUENCE-IN NUMBER * 16800021 * IS INSERTED, IN DECIMAL FORM, IN THE ERROR TEXT. UPON ENCOUNTER- * 16900021 * ING A SECOND $, THE SPECIFIED SEQUENCE NUMBER, OBTAINED FROM THE * 17000021 * LCBBRKCT FIELD IN THE LCB, IS INSERTED INTO THE TEXT. * 17100021 * FOR ALL MESSAGES MSNUMIN IN THE PREFIX IS ZEROED FOR * 17200021 * RETRIEVE. EXIT IS MADE TO THE LOOK-UP ROUTINE, WHICH RETURNS TO * 17300021 * THE NEXT LPS INSTRUCTION BY BRANCHING VIA REGISTER 14 AROUND THE * 17500013 * MACRO GENERATED CONSTANTS. * 18000013 * * 18500013 *ENTRY POINTS- * 19000013 * IECKERMG - CONTROL IS GIVEN HERE VIA A BALR USING REGISTER 15 AS * 19500013 * THE BRANCH ADDRESS REGISTER AND REGISTER 14 AS THE * 20000013 * RETURN REGISTER AS A PART OF THE ERRMSG MACRO * 20500013 * EXPANSION. * 21000013 * * 21500013 *INPUT- * 22000013 * REGISTER 0- CONTAINS THE SIZE OF THE ERROR MESSAGE * 22500013 * REGISTER 1- CONTAINS THE ADDRESS OF THE ERROR MESSAGE * 23000013 * REGISTER 2- CONTAINS THE ADDRESS OF THE DESTINATION NAME. * 23500013 * REGISTER 4- ADDRESS OF THE LCB * 24000013 * REGISTER 5- POINTER TO BYTE BEFORE CURRENT CHAR IN SEGMENT * 24500013 * REGISTER 6- BUFFER ADDRESS * 25000013 * REGISTER 14- RETURN ADDRESS * 25500013 * REGISTER 14 ALSO POINTS TO A MACRO GENERATED PARAMETER * 26000013 * CONSISTING OF THE HALFWORD ERROR MASK SPECIFIED BY THE * 26500013 * CALLING ROUTINE. * 27000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 27500013 * * 28000013 *OUTPUT- * 28500013 * THE ERROR MESSAGE TEXT WILL BE MOVED TO THE PROPER PLACE IN THE * 29000013 * HEADER OF BUFFER (AS EXPLAINED ABOVE). * 29500013 * * 30000013 *EXTERNAL ROUTINES- * 30500013 * IECKRC - RECALL ROUTINE OF IGG019NG TO OBTAIN ACCESS TO THE * 31000013 * HEADER. * 31500013 * IECKLKUP - LOOKUP ROUTINE TO SCAN THE TERMINAL TABLE FOR THE * 32000013 * DESTINATION NAME. * 32500013 * * 33000013 *EXITS- * 33500013 * NORMAL- IF NONE OF THE ERRORS SPECIFIED BY THE ERROR MASK ARE * 34000013 * INDICATED IN THE ERROR HALFWORD (LCBERRST AT LCB+40), * 34500013 * RETURN IS TO THE NEXT LPS INSTRUCTION. IF THE ERROR * 35000013 * MASK IS ZERO OR IF AT LEAST ONE OF THE ERRORS SPECIFIED* 35500013 * IS INDICATED, RETURN IS TO IECKLKUP WHICH IN TURN * 36000013 * RETURNS TO THE NEXT LPS INSTRUCTION. * 36500013 * ERROR- NONE. * 37000013 * * 37500013 *TABLES/WORK AREAS- * 38000013 * NONE. * 38500013 * * 39000013 *ATTRIBUTES- * 39500013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 40000013 * * 40500013 *NOTES- * 41000013 * REGISTER 3- SECOND LEVEL LINKAGE TO RECALL SUBROUTINE. * 41500013 * REGISTER 9- WORK REGISTER. USED TO HOLD THE CALLING ROUTINE'S * 42000013 * ERROR MASK. * 42500013 * REGISTER 10- WORK REGISTER. HOLDS THE ADDRESS OF THE START OF THE* 43000013 * ERROR TEXT IN THE BUFFER AND, ON RETURN TO IECKLKUP, * 43500013 * THE ADDRESS OF THE START OF THE PREFIX-1. * 44000013 * REGISTER 15- BASE REGISTER FOR THIS ROUTINE * 44500013 * * 45000013 *********************************************************************** 45500013 TITLE 'IECKERMG QTAM ERROR MESSAGE (ERRMSG)' 46000013 IECKERMG START 46500013 *3410612000 20394 46600017 *3410666000-67000 19064 46700017 *90351820000 19064 46800017 *1200572000-578000 000D 46900018 * 832000 A27523 46950019 * 665500 A29189 46970019 *A030000,081000-083000,093000-096000,137000-143000,160000, S21016 46980021 *A166000-173000 S21016 46990021 DREG0 EQU 0 47000013 DREG1 EQU 1 47500013 RREG2 EQU 3 48000013 LCBREG EQU 4 48500013 SPREG EQU 5 49000013 MSREG EQU 6 49500013 TCREG EQU 8 50000013 WREG1 EQU 9 50500013 WREG2 EQU 10 51000013 IREG EQU 12 51500013 RREG1 EQU 14 52000013 SREG EQU 15 52500013 USING *,SREG 53000013 USING IECKPREF,MSREG 53500013 USING IECKTERM,TCREG 54000013 USING IECKLCB0,LCBREG 54500013 LH WREG1,0(0,RREG1) LOAD ERROR HALF WORD 55000013 SLA WREG1,16 ERROR MASK TO HI ORDER PART OF REG 55500013 BC 8,ERRACT3 IF MASK IS ZERO, DO ERROR ACTION 56000013 N WREG1,LCBERRST TEST FOR DESIGNATED ERRORS 56500013 BC 8,2(0,RREG1) IF NO ERRORS,RETURN 57000013 ERRACT3 CLI LCBCPA+29,X'FF' IS THIS MESSAGE TO BE 000D 57200018 * RETRANSMITTED TO 2740 M2 000D 57400018 BE 2(0,RREG1) RETURN IF YES 000D 57600018 MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 000D 57800018 OR DREG0,WREG1 SAVE ERROR INDICATOR 58000013 L WREG1,0(0,13) GET ADDRESS OF THE LPS QUEUE 58500013 OI LCBSTATE,16 SET INIT. MODE FOR RECALL 59000013 BAL RREG2,240(0,WREG1) BRANCH TO RECALL SUBROUTINE 59500013 ST DREG0,FIELD SET UP ERROR INDICATOR 60000013 SLL DREG0,16 RESTORE REGISTER WITH COUNT 60500013 SRL DREG0,16 OF ERROR MESSAGE CHARCTERS 61000013 XC MSNUMOUT,MSNUMOUT CLEAR SEQUENCE OUT NUMBER 20394 61200017 CLI 0(DREG1),C'.' HEADER TO BE INCLUDED WITH MESSAGE 61500013 BC 8,ADDHDR BRANCH IF YES 62000013 LA SPREG,HDSTRT-2 IF THE HEADER IS NOT INCLUDED, RESET 62500013 * SCANPOINTER TO START OF THE HEADER 63000013 LA SPREG,1(0,SPREG) SKIPPING OVER 'DF' CHARACTERS WHICH 63500013 CLI 1(SPREG),X'17' ARE IN THE HEADER FOR TIME AND 64000013 BE *-8 DATE STAMP 64500013 LA WREG2,HDSTRT-1 SET POINTER FOR SUB 65000013 SR SPREG,WREG2 NUMBER OF IDLE CHARACTERS 65500013 STC SPREG,MSPTR SET MSPTR EQUAL NUMBER OF IDLES 66000013 AR SPREG,WREG2 RESET SPREG 66500013 B A CONTINUE PROCESSING A29189 66550019 ADDHDR TM MSTATUS,X'20' IS EOB PRESENT 19064 66600017 BO A YES 19064 66700017 TM LCBERRST,4 IS INCOMPLETE HEADER SET 19064 66800017 BZ A NO, OK 19064 66900017 BCTR SPREG,0 OVERLAY EOT 19064 67000017 A LA WREG2,1(0,SPREG) GET START OF ERROR TEXT IN SEGMENT19064 67100017 L WREG1,=V(IECKBFSZ) GET ADDRESS OF BUFFER SIZE 67500013 LH WREG1,0(WREG1) GET SIZE OF BUFFER 68000013 LA WREG1,8(WREG1,MSREG) GET END OF BUFFER + 1 68500013 SR WREG1,WREG2 GET SPACE REMAINING IN BUFFER 69000013 BC 12,DESTIN BRANCH IF HEADER EXCEEDS SEGMENT 69500013 CR WREG1,DREG0 IS ERROR TEXT LARGER THAN REMAINING 70000013 * BUFFER 70500013 BC 12,TRUNC BRANCH IF YES 71000013 LR WREG1,DREG0 OTHERWISE USE SIZE OF TEXT 71500013 TRUNC BCTR WREG1,0 REDUCE COUNT BY ONE FOR EXECUTE 72000013 STH WREG1,COUNT SAVE COUNT-1 OF ERROR TEXT 72500013 EX WREG1,MOVEMSG CAUSE ERROR MESSAGE TO BE MOVED 73000013 * TO BUFFER 73500013 AR WREG1,WREG2 GET ADDRESS OF LAST CHARACTER OF 74000013 * ERROR MESSAGE IN BUFFER 74500013 LA WREG2,MSEGSZE-1 GET ADDRESS OF START OF PREFIX-1 75000013 SR WREG1,WREG2 GET MESSAGE SIZE 75500013 STH WREG1,MSEGSZE AND STORE IT IN PREFIX 76000013 DESTIN MVI MSTATUS,X'46' INDICATE RECALL,SINGLE-SEGMENT, 76500013 * AND PRIORITY MESSAGE 77000013 TM FIELD,X'30' IS THIS A SEQ. NO. ERROR 77500013 BZ DONE NO 78000013 LA DREG0,1 SET INCREMENT OF ONE FOR LOOP 78500013 LH DREG1,COUNT COUNT-1 OF ERROR TEXT IN SETMENT 79000013 LA WREG1,1(0,SPREG) SET PRT. TO START OF ERROR TEXT 79500013 LA DREG1,0(DREG1,WREG1) SET PTR. TO LAST CHAR. OF TEXT 80000013 LH IREG,TSEQUIN SET UP LAST VALID SEQIN NUMBER 80500013 BAL RREG2,LOOP PROCESS SEQ. NO. 81000013 LA WREG1,1(0,WREG1) SET UP FOR NEXT SCAN IN SEGMENT 81500013 LH IREG,LCBBRKCT SET UP INVALID SEQ # RCVD. 00PS 82000017 BAL RREG2,LOOP PROCESS IT 82500013 DONE EQU * 83000013 XC MSNUMIN(2),MSNUMIN ZERO INPUT SEQUENCE NO. A27523 83200019 L SREG,=V(IECKLKUP) GET ADDRESS OF LOOKUP ROUTINE 83500013 BR SREG GO TO LOOKUP ROUTINE 84000013 LOOP CLI 0(WREG1),C'$' SCAN ERROR TEXT FOR $ 84500013 BE CONVERT BRANCH IF FOUND 85000013 BXLE WREG1,DREG0,LOOP SET UP FOR NEXT CHAR. 85500013 B DONE EXIT IF NO $ FOUND 86000013 CONVERT CVD IREG,SEQWORD CONVERT SEQ. NO. TO DECIMAL 86500013 OI SEQWORD+7,X'0F' MASK OUT ZONE 87000013 UNPK 1(4,WREG1),SEQWORD UNPACK FIELD INTO ERROR TEXT 87500013 MVI 0(WREG1),X'40' SET BLANK AT BEGINNING OF FIELD 88000013 BR RREG2 RETURN 88500013 MOVEMSG MVC 0(1,WREG2),0(DREG1) MOVE ERROR MESSAGE TO BUFFER 89000013 SEQWORD DS 1D 89500013 FIELD DS 1F 90000013 COUNT DS 1H 90500013 EJECT 91000013 PREFIXD 91500013 EJECT 92000013 LCBD QTAM=3 92500018 EJECT 93000013 TERMTBLD 93500013 END 94000013 ./ ADD SSI=02010770,NAME=IECKEXPD,SOURCE=0 TITLE 'IECKEXPD QTAM EXPAND' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKEXPD QTAM EXPAND * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THE DATA IN THE MESSAGE HEADER IS SHIFTED LEFT STARTING * 10000013 * AT THE SCAN POINTER FOR THE NUMBER OF BYTES INDICATED BY THE * 11000013 * PARAMETER POINTED TO BY REGISTER 14. THIS WILL PROVIDE THE ROOM * 12000013 * IN THE HEADER FOR A FIELD TO BE INSERTED BY SEQOUT, TIMESTMP, * 13000013 * OR DATESTMP. THE FIELD TO BE INSERTED WILL TERMINATE IN THE * 14000013 * BYTE POINTED TO BY THE SCAN POINTER. A BLANK WILL BE INSERTED IN * 15000013 * THE LEFTMOST POSITION OF THE NEWLY CREATED FIELD. * 16000013 * * 17000013 *ENTRY POINTS- * 18000013 * IECKEXPD - THIS ROUTINE IS ENTERED BY A BALR GENERATED BY THE * 19000013 * SEQOUT, TIMESTMP, OR DATESTMP MACRO'S. * 20000013 * * 21000013 *INPUT- * 22000013 * REGISTER 3- RETURN ADDRESS. * 23000013 * REGISTER 4- ADDRESS OF THE LCB * 24000013 * REGISTER 5- POINTER TO THE BYTE AT THE START OF THE NEXT FIELD. * 25000013 * REGISTER 6- BUFFER ADDRESS * 26000013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 27000013 * REGISTER 14- PARAMETER REGISTER. POINTS TO A HALFWORD CONTAINING * 28000013 * THE LENGTH OF THE FIELD TO BE INSERTED. REGISTER IS ALSO TO * 29000013 * BE USED BY THE CALLING ROUTINE AS ITS RETURN REGISTER. * 30000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 31000013 * * 32000013 *OUTPUT- * 33000013 * REGISTER 9- CONTAINS THE FIELD SIZE MINUS ONE. * 34000013 * REGISTER 10- CONTAINS A POINTER TO BEGINNING OF THE NEW FIELD. * 35000013 * * 36000013 *EXTERNAL ROUTINES- * 37000013 * NONE. * 38000013 * * 39000013 *EXITS- * 40000013 * NORMAL- RETURN TO CALLING ROUTINE BY BRANCHING ON REGISTER 3. * 41000013 * ERROR- IF THERE IS NO ROOM IN THE HEADER TO SHIFT, RETURN IS TO * 42000013 * THE NEXT INSTRUCTION IN THE LPS, WITH NO EXPANSION OF THE * 43000013 * HEADER. (NO ERROR INDICATION IS GIVEN). * 44000013 * * 45000013 *TABLES/WORK AREAS- * 46000013 * NONE. * 47000013 * * 48000013 *ATTRIBUTES- * 49000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 50000013 * * 51000013 *NOTES- * 52000013 * REGISTER 12- WORK REGISTER. * 53000013 * * 54000013 *********************************************************************** 55000013 IECKEXPD START 56000013 RREG2 EQU 3 57000013 LCBREG EQU 4 58000013 SPREG EQU 5 59000013 MSREG EQU 6 60000013 WREG1 EQU 9 61000013 WREG2 EQU 10 62000013 EOSREG EQU 11 63000013 IREG EQU 12 64000013 RREG1 EQU 14 65000013 SREG EQU 15 66000013 USING *,SREG 67000013 USING IECKLCB0,LCBREG 68000013 USING IECKPREF,MSREG 69000013 CLI 0(SPREG),X'40' IS SCAN POINTER POINTING AT BLANK 70000013 BC 7,NOBLNK IF NOT DON'T BACK UP POINTER 71000013 BCTR SPREG,0 ELSE BACK UP POINTER 72000013 NOBLNK LA WREG2,HDSTRT-1 LOAD START OF MESSAGE ADDRESS 73000013 AH WREG2,0(0,RREG1) COMPUTE ADDRESS OF FIRST CHARACTER 74000013 * TO SHIFT 75000013 LR WREG1,SPREG LOAD SCAN POINTER VALUE 76000013 SR WREG1,WREG2 COMPUTE NUMBER OF CHARACTERS TO SHIFT 77000013 BC 4,2(0,RREG1) RETURN TO USER IF NEGATIVE 78000013 EX WREG1,SHIFT CAUSE CHARACTERS TO BE SHIFTED 79000013 LH WREG1,0(0,RREG1) GET FIELD SIZE 80000013 BCTR WREG1,0 DECREMENT BY ONE 81000013 LR WREG2,SPREG LOAD VALUE OF SCAN POINTER 82000013 SR WREG2,WREG1 GET ADDRESS OF START OF TIME FIELD 83000013 MVI 0(WREG2),X'40' INSERT LEFT DELIMITER (BLANK) 84000013 SR IREG,IREG CLEAR REGISTER 85000013 IC IREG,LCBMPLRT GET POINTER TO DESTINATION CODE(EOA) 86000013 SH IREG,0(0,RREG1) SHIFT POINTER LEFT,SIZE OF NEW FIELD 87000013 BCR 4,RREG2 IF NEGATIVE, SKIP STORED SCAN 88000013 * POINTER UPDATE 89000013 STC IREG,LCBMPLRT RESTORE SCAN POINTER IN LCB 90000013 BR RREG2 RETURN TO CALLING SUBROUTINE 91000013 SPACE 92000013 SHIFT MVC HDSTRT(1),1(WREG2) SHIFT CHARACTERS TO EXPAND HEADER 93000013 EJECT 94000013 LCBD 95000013 EJECT 96000013 PREFIXD 97000013 END 98000013 ./ ADD SSI=02013242,NAME=IECKITCP,SOURCE=0 TITLE 'IECKITCP QTAM INTERCEPT (INTERCPT)' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKITCP QTAM INTERCEPT (INTERCPT) * 03000013 * * 03600013 *STATUS- CHANGE LEVEL= 18 JANUARY 1971 * 04200021 * * 04800013 *FUNCTION- * 05400013 * IECKITCP CAUSES SUPPRESSION OF ALL MESSAGE TRANSMISSION TO * 06000013 * A TERMINAL IF ANY OF THE ERROR CONDITIONS SPECIFIED IN THE * 06600013 * ERROR MASK (A HALF WORD POINTED TO BY REGISTER 14) IS INDICATED IN* 07200013 * THE ERROR HALF WORD OF THE LCB (LCBERRST AT LCB+40), OR WHEN THE * 07800013 * ERROR MASK IS ZERO. * 08400013 * IF THE ERROR MASK IS NOT ZERO AND NONE OF THE ERROR * 09600013 * CONDITIONS ARE INDICATED, THEN RETURN IS TO THE NEXT LPS * 10200013 * INSTRUCTION BY BRANCHING ON THE CONTENTS OF REGISTER 14 + 2 AROUND* 10800013 * THE ERROR MASK. * 11400013 * IF AT LEAST ONE OF THE ERROR CONDITIONS SPECIFIED IN THE MASK* 12000013 * IS INDICATED IN LCBERRST OR IF THE ERROR MASK IS ZERO, THEN * 12600013 * LINKAGE IS MADE TO THE RECALL ROUTINE (IECKRC) OF IGG019NG TO * 13200013 * OBTAIN THE HEADER. QSIZE OF THE QCB IS INCREASED BY ONE SINCE THE* 13600021 * MESSAGE WAS NOT SENT. THE PRIORITY BIT IN MSTATUS (HEADER PREFIX * 14000021 * + 12) IS SET TO A ONE (MSTATUS IS OR'ED WITH A X'04') SO THAT A * 14400013 * NEW SEQUENCE NUMBER WILL NOT BE ASSIGNED. THE SERVICED BIT OF * 15000013 * MSTATUS IS SET TO A ZERO (MSTATUS IS AND'ED WITH A X'EF'). THE * 15600013 * SEND BIT OF THE ENTRY IN THE TERMINAL TABLE (TSTATUS AT ENTRY + 8)* 16200013 * IS SET TO A ZERO (TSTATUS IS AND'ED WITH A X'FD') TO INDICATE * 16800013 * THAT MESSAGES ON THE QUEUE FOR THE DESTINATION WERE WITHHELD FROM * 17400013 * TRANSMISSION. * 18000013 * THE INTERCEPT BIT (BIT 5, REPRESENTED BY A X'04') IS TESTED. * 18600013 * IF IT IS ON (ONE), AND THE HEADER ADDRESS IS NOT LESS THAN THE * 19200013 * INTERCEPT FIELD, RETURN IS TO THE NEXT LPS INSTRUCTION SINCE IT * 19800013 * IS INDICATED THAT A PREVIOUS MESSAGE IS IN THE INTERCEPT FIELD. * 20400013 * OTHERWISE, THE QUEUE ADDRESS IS MOVED FROM TQCBADDR AT TERMINAL * 21000013 * TABLE ENTRY + 1 TO LCBDESTQ AT LCB + 29, THE HEADER ADDRESS IS * 21600013 * PLACED IN THE INTERCEPT FIELD IN THE USER AREA OF THE TERMINAL * 22200013 * TABLE ENTRY, AND THE INTERCEPT BIT IN THE TERMINAL TABLE ENTRY * 22800013 * IS SET TO A ONE (TSTATUS IN OR'ED WITH A X'04'). THEN THE OFFSET * 23400013 * TO THE INTERCEPT FIELD IN THE TERMINAL TABLE IS PLACED IN THE * 24000013 * FIRST BYTE OF THE SCAN ROUTINE ADDRESS AT LPSTART FOR LATER USE * 24600013 * BY THE RELEASE MESSAGE ROUTINE (RELEASM MACRO), AND RETURN IS TO * 25200013 * THE NEXT LPS INSTRUCTION * 25800013 * IF THIS MESSAGE IS TO BE RETRANSMITTED TO A 2740 MOD 2, * 25870021 * INDICATED BY X'FF' IN LCB, AN AUTOMATIC RELEASEM IS DONE. QFAC * 25940021 * IS SET TO LCBCHDR TO CAUSE MESSAGES TO BE RETRANSMITTED UNLESS * 26010021 * A PRIORTY MESSAGE WAS INTERCEPTED (INDICATED IF THE HEADER ADDR. * 26080021 * IS GREATER THAN QFAC IN QUEUE). THE INTERCEPT BIT IS TURN OFF * 26150021 * AND THE SEND BIT IS TURNED ON IN THE TSTATUS FIELD OF THE TERMINAL* 26220021 * TABLE ENTRY. RETURN IS MADE TO THE NEXT LPS INSTRUCTION. * 26290021 * * 26400013 *ENTRY POINTS- * 27000013 * IECKITCP - THE EXPANSION OF THE INTERCPT MACRO GENERATES A BALR * 27600013 * TO THIS POINT USING REGISTER 15 AS THE BRANCH ADDRESS * 28200013 * * 28800013 *INPUT- * 29400013 * REGISTER 1- POINTER TO THE INTERCEPT FIELD IN THE USER'S PORTION * 30000013 * OF THE TERMINAL TABLE ENTRY. * 30600013 * REGISTER 4- ADDRESS OF THE LCB * 31200013 * REGISTER 6- BUFFER ADDRESS * 31800013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 32400013 * REGISTER 8- TERMINAL TABLE SOURCE ENTRY * 33000013 * REGISTER 14- RETURN ADDRESS * 33600013 * REGISTER 14 ALSO POINTS TO A PARAMETER LIST CONSISTING * 34200013 * OF THE HALF WORD ERROR MASK GENERATED BY THE * 34800013 * INTERCPT MACRO. * 35400013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 36000013 * * 36600013 *OUTPUT- * 37200013 * IF NONE OF THE ERRORS DESIGNATED BY THE ERROR MASK HAVE OCCURRED, * 37800013 * THERE IS NO OUTPUT. * 38400013 * OTHERWISE, THE FOLLOWING ACTIONS ARE TAKEN: * 39000013 * 1) THE PRIORITY BIT AT MSTATUS IS SET TO A ONE. * 39600013 * 2) THE SERVICED BIT AT MSTATUS IS SET TO A ZERO. * 40200013 * 3) THE SEND BIT AT TSTATUS IS SET TO A ZERO. * 40800013 * 4) THE INTERCEPT BIT AT TSTATUS IS SET TO A ONE IF IT * 41400013 * IS NOT ALREADY A ONE. * 42000013 * IF THE INTERCEPT BIT IS ALREADY A ONE AND THE HEADER ADDRESS IS * 42600013 * NOT LESS THAN THE INTERCEPT FIELD, THERE IS NO FURTHER * 43200013 * OUTPUT. OTHERWISE THE OFFSET FROM THE START OF THE * 43800013 * TERMINAL TABLE ENTRY TO THE INTERCEPT FIELD IS PLACED * 44400013 * IN THE FIRST BYTE OF THE ADDRESS OF THE SCAN ROUTINE * 45000013 * AT LPSTART (POINTED TO BY REGISTER 7). * 45600013 * * 46200013 *EXTERNAL ROUTINES- * 46800013 * IECKRC - RECALL ROUTINE OF IGG019NG IS ENTERED TO OBTAIN THE * 47400013 * HEADER. * 48000013 * * 48600013 *EXITS- * 49200013 * NORMAL- EXIT IS TO THE NEXT LPS INSTRUCTION BY BRANCHING ON THE * 49800013 * CONTENTS OF REGISTER 14 +2 AROUND THE MACRO GENERATED * 50400013 * CONSTANT. * 51000013 * ERROR- NONE. * 51600013 * * 52200013 *TABLES/WORK AREAS- * 52800013 * NONE. * 53400013 * * 54000013 *ATTRIBUTES- * 54600013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 55200013 * * 55800013 *NOTES- * 56400013 * REGISTER 3- SECOND LEVEL RETURN REGISTER FORM RECALL ROUTINE. * 57000013 * REGISTER 9- BRANCH ADDRESS REGISTER OT RECALL ROUTINE. * 57600013 * * 58200013 *********************************************************************** 58800013 IECKITCP START 59400013 *1171727000-730000 5480 59700016 *1200598000,840400-845600 000D 59800018 *A042000,136000-140000,258700-2629000 S21016 59850021 WREG0 EQU 0 000D 59900018 DREG1 EQU 1 60000013 RREG2 EQU 3 60600013 LCBREG EQU 4 61200013 MSREG EQU 6 61800013 LGREG EQU 7 62400013 TCREG EQU 8 63000013 WREG1 EQU 9 63600013 RREG1 EQU 14 64200013 SREG EQU 15 64800013 USING *,SREG 65400013 USING IECKTERM,TCREG 66000013 USING IECKPREF,MSREG 66600013 USING IECKLCB0,LCBREG 67200013 LH WREG1,0(0,RREG1) LOAD ERROR HALF WORD 67800013 SLA WREG1,16 ERROR MASK TO HI ORDER PART OF REG 68400013 BC 8,ERRACT2 IF MASK IS ZERO,DO ERR ACTION UNCND 69000013 N WREG1,LCBERRST TEST FOR DESIGNATED ERRORS 69600013 BC 8,2(0,RREG1) IF NO ERRORS,RETURN 70200013 ERRACT2 MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 70800013 L WREG1,0(0,13) GET ADDRESS OF LPS QUEUE 71400013 BAL RREG2,240(WREG1) BRANCH TO RECALL FOR HEADER 72000013 MVC LCBDESTQ(3),TQCBADDR MOVE QUEUE ADDRESS TO LCB 72600013 L WREG1,TQCBADDR-1 ACCESS QCB ADDRESS 5480 72700016 LH RREG2,20(WREG1) ACCESS QSIZE 5480 72800016 LA RREG2,1(RREG2) BUMP 5480 72900016 STH RREG2,20(WREG1) RESTORE QSIZE 5480 73000016 OI MSTATUS,X'04' TURN ON PRIORITY BIT SO THAT A NEW 73200013 * SEQUENCE NUMBER IS NOT ASSIGNED 73800013 NI MSTATUS,X'EF' TURN OFF SERVICED BIT 74400013 NI TSTATUS,X'FD' TURN OFF THE SEND BIT 75000013 TM TSTATUS,X'04' TEST THE INTERCEPT BIT 75600013 BZ SET BRANCH IF NOT ON (PREVIOUS MESSAGE 76200013 * NOT IN INTERCEPT) 76800013 CLC LCBCHDR(3),0(DREG1) ELSE IS RECALLED HEADER ADDRESS LESS 77400013 * THAN INTERCEPT FIELD 78000013 BNL 2(RREG1) RETURN IF NO 78600013 SET MVC 0(3,DREG1),LCBCHDR UPDATE INTERCEPT FIELD WITH HEADER 79200013 * ADDRESS 79800013 OI TSTATUS,X'04' SET INTERCEPT BIT IN TERMTBL 80400013 SR DREG1,TCREG GET OFFSET FROM START OF TERMTBL 81000013 * ENTRY TO INTERCEPT FIELD IN 81600013 * TERMTBL ENTRY 82200013 STC DREG1,4(LGREG) AND STORE IT IN 1ST BYTE OF ADDRESS 82800013 * OF SCAN ROUTINE IN LPSTART. LGREG 83400013 * HAS ADDRESS OF START OF LPS. 84000013 CLI LCBCPA+29,X'FF' IS THIS MESSAGE TO BE 000D 84040018 * RETRANSMITTED TO 2740 M2 000D 84080018 BNE 2(RREG1) BRANCH IF NO, OTHERWISE DO 000D 84120018 * RELEASEM FUNCTION NOW 000D 84160018 CLC 1(3,WREG1),LCBCHDR COMPARE MESSAGE HEADER ADDRESS 000D 84200018 * IN LCB TO ADDRESS OF FIRST 000D 84240018 * ELEMENT IN QUEUE 000D 84280018 BNH *+10 BRANCH IF HEADER ADDRESS IS 000D 84320018 * GREATER THAN MESSAGE ADDRESS 000D 84360018 * IN QUEUE (PRIORITY MESSAGES 000D 84400018 * HAVE BEEN PLACED ON THE QUEUE) 000D 84440018 MVC 1(3,WREG1),LCBCHDR UPDATE QFAC WITH CURRENT RRN 000D 84480018 XI TSTATUS,6 TURN OFF INTERCEPT BIT AND 000D 84520018 * TURN ON SEND BIT IN TSTATUS 000D 84560018 B 2(RREG1) AND RETURN 84600013 EJECT 85200013 TERMTBLD 85800013 EJECT 86400013 LCBD QTAM=3 87000018 EJECT 87600013 PREFIXD 88200013 END 88800013 ./ ADD SSI=02010770,NAME=IECKLKUP,SOURCE=0 TITLE 'IECKLKUP QTAM LOOK-UP' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKLKUP QTAM LOOK-UP * 03000013 * * 03600013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04200013 * * 04800013 *FUNCTION- * 05400013 * IECKLKUP WILL SCAN THE TERMINAL TABLE IN SEARCH OF ONE * 06000013 * PARTICULAR DESTINATION NAME. THE ADDRESS OF THE FIRST BYTE * 06600013 * IN THE TERMINAL TABLE IS LOADED INTO A WORK REGISTER. THE MAXIMUM* 07200013 * NUMBER OF CHARACTERS IN THE DESTINATION NAME OF ANY ENTRY IS * 07800013 * RETRIEVED FROM TERMTBL+4. THIS NUMBER OF CHARACTERS IS COMPARED * 08400013 * BETWEEN THE DESTINATION SPECIFIED IN THE HEADER AND THE TERMID * 09000013 * OF THIS ENTRY IN THE TERMINAL TABLE. * 09600013 * IF THE COMPARANDS ARE EQUAL, THE ADDRESS OF THE QUEUE CONTROL* 10200013 * BLOCK FOR THE DESTINATION QUEUE IS PLACED IN THE LCBDESTQ (LCB+29)* 10800013 * FIELD OF THE LCB. THE RELATIVE ADDRESS OF THE DESTINATION ENTRY * 11400013 * IS PLACED IN THE TTDKEY FIELD OF THE HEADER PREFIX. CONTROL * 12000013 * RETURNS TO THE USER BY BRANCHING ON REGISTER 14 PAST THE MACRO * 12600013 * GENERATED CONSTANT. * 13200013 * IF THE COMPARANDS ARE NOT EQUAL, THE SIZE OF A TERMINAL TABLE* 13800013 * ENTRY IS INDEXED TO THE WORK REGISTER. THE SEARCH CONTINUES UNTIL* 14400013 * THE END OF THE TABLE IS REACHED. * 15000013 * IF THE END OF THE TABLE IS REACHED BEFORE THE DESIRED ENTRY * 15600013 * IS FOUND, THE INVALID DESTINATION BIT IN THE ERROR HALFWORD IS * 16200013 * SET (LCBERRST AT LCB+40 IS OR'ED WITH A X'80'), AND THE ADDRESS * 16800013 * OF THE QCB FOR THE ERROR DESTINATION QUEUE IS PLACED IN THE * 17400013 * LCBDESTQ FIELD OF THE LCB. THE TTDKEY FIELD OF THE HEADER PREFIX * 18000013 * IS ZERO IF THE DESTINATION NAME IS NOT FOUND. RETURN IS TO THE * 18600013 * CALLING ROUTINE BY BRANCHING ON REGISTER 14 AROUND THE MACRO * 19200013 * GENERATED CONSTANT. * 19800013 * * 20400013 *ENTRY POINTS- * 21000013 * IECKDRCT - CONTROL IS PASSED HERE BY A BALR FROM THE GENERATED * 21600013 * CODE OF THE DIRECT MACRO. REGISTER 15 IS THE BRANCH * 22200013 * ADDRESS REGISTER, AND REGISTER 14 IS THE RETURN ADDRESS * 22800013 * REGISTER. * 23400013 * IECKLKUP - CONTROL IS PASSED HERE BY AN UNCONDITIONAL BRANCH * 24000013 * FROM THE ROUTE, ERROR MESSAGE, OR REROUTE ROUTINES. * 24600013 * * 25200013 *INPUT- * 25800013 * REGISTER 2- POINTER TO COPY OF DESTINATION TERMINAL NAME FROM THE* 26400013 * HEADER. * 27000013 * REGISTER 14- RETURN ADDRESS * 27600013 * REGISTER 15- ENTRY POINT REGISTER. * 28200013 * * 28800013 *OUTPUT- * 29400013 * REGISTER 1- IF DESTINATION NAME WAS FOUND, THIS REGISTER WILL * 30000013 * HOLD THE ADDRESS OF THAT TERMINAL TABLE ENTRY. IF NAME WAS * 30600013 * NOT FOUND, THIS REGISTER WILL HAVE THE ADDRESS OF THE * 31200013 * ERROR DESTINATION QUEUE. * 31800013 * IF THE TERMINAL NAME WAS FOUND, THE ADDRESS OF THE QCB ASSOCIATED * 32400013 * WITH THIS DESTINATION QUEUE WILL BE IN THE LCBDESTQ (LCB+29) * 33000013 * FIELD OF THE LCB. THE RELATIVE ADDRESS OF THE DESTINATION * 33600013 * ENTRY IS PLACED IN THE TTDKEY FIELD OF THE HEADER PREFIX. * 34200013 * IF THE TERMINAL NAME WAS NOT FOUND,THE ADDRESS OF THE QCB * 34800013 * ASSOCIATED WITH THE ERROR DESTINATION QUEUE IS PLACED IN * 35400013 * THE LCBDESTQ FIELD OF THE LCB. THE INVALID DESTINATION BIT * 36000013 * IN THE ERROR HALFWORD IS TURNED ON (LCBERRST IS OR'ED WITH * 36600013 * A X'80'). THE TTDKEY FIELD OF THE HEADER PREFIX IS ZERO. * 37200013 * * 37800013 *EXTERNAL ROUTINES- * 38400013 * NONE. * 39000013 * * 39600013 *EXITS- * 40200013 * NORMAL - RETURN TO THE USER BY A BRANCH ON REGISTER 14. * 40800013 * REGISTER 14 WILL HAVE BEEN UPDATED BY 2 TO AID IN * 41400013 * BRANCHING AROUND THE CONSTANT. * 42000013 * ERROR- IF THE END OF THE TABLE IS REACHED BEFORE THE DESIRED ENTRY* 42600013 * IS FOUND, THE INVALID DESTINATION BIT IN THE ERROR HALFWORD * 43200013 * IS SET (LCBERRST AT LCB+40 IS OR'ED WITH A X'80'), AND THE * 43800013 * ADDRESS OF THE QCB FOR THE ERROR DESTINATION QUEUE IS PLACED * 44400013 * IN THE LCBDESTQ FIELD OF THE LCB. THE TTDKEY FIELD OF THE * 45000013 * HEADER PREFIX IS ZERO IF THE DESTINATION NAME IS NOT FOUND. * 45600013 * * 46200013 *TABLES/WORK AREAS- * 46800013 * NONE. * 47400013 * * 48000013 *ATTRIBUTES- * 48600013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 49200013 * * 49800013 *NOTES- * 50400013 * REGISTER 1- WORK REGISTER. USED TO KEEP TRACK OF TERMINAL TABLE * 51000013 * ENTRY BEING EXAMINED AT ANY GIVEN TIME WHILE THIS ROUTINE * 51600013 * HAS CONTROL. * 52200013 * REGISTER 9- WORK REGISTER. WILL HOLD THE MAXIMUM NUMBER OF * 52800013 * CHARACTERS IN A DESTINATION NAME. WILL CONTROL THE * 53400013 * NUMBER OF CHARACTERS COMPARED. * 54000013 * REGISTER 10- BASE REGISTER FOR IECKTERM. USED TO REFERENCE * 54600013 * CONSECUTIVE TERMID'S IN THE TERMINAL TABLE. * 55200013 * REGISTER 12- WORK REGISTER. WILL HOLD THE SIZE OF THIS TERMINAL * 55800013 * TABLE ENTRY. * 56400013 * * 57000013 *********************************************************************** 57600013 IECKLKUP START 58200013 ENTRY IECKDRCT 58800013 DREG1 EQU 1 59400013 KREG EQU 2 60000013 LCBREG EQU 4 60600013 MSREG EQU 6 61200013 WREG1 EQU 9 61800013 TCREG EQU 10 SPECIAL ASSIGNMENT FOR THIS ROUTINE 62400013 IREG EQU 12 63000013 RREG1 EQU 14 63600013 SREG EQU 15 64200013 USING IECKLCB0,LCBREG 64800013 USING IECKTERM,TCREG 65400013 USING IECKPREF,MSREG 66000013 LA RREG1,2(0,RREG1) BUMP RETURN REGISTER PAST CONSTANT 66600013 BALR SREG,0 SET UP BASE FOR THIS ROUTINE 67200013 USING *,SREG 67800013 IECKDRCT SR WREG1,WREG1 CLEAR REGISTER 68400013 L DREG1,=V(TERMTBL) GET ADDRESS OF TERMINAL TABLE 69000013 IC WREG1,4(0,DREG1) GET MAXIMUM SIZE OF TERMINAL NAME 69600013 BCTR WREG1,0 ADJUST COUNT FOR EXECUTE 70200013 NI LCBSTATE,X'FD' TURN OFF EOB STATUS BIT 70800013 SR IREG,IREG CLEAR INCREMENT REGISTER 71400013 LA TCREG,8(0,DREG1) GET ADDRESS OF FIRST TERMINAL ENTRY 72000013 COMPAR1 AR TCREG,IREG INDEX NEXT ENTRY 72600013 EX WREG1,DESTCK2 EXECUTE TEST FOR DESTINATION ENTRY 73200013 BC 8,DESTOK2 BRANCH IF COMPARE EQUAL 73800013 IC IREG,TNTRYSZE GET ENTRY SIZE 74400013 CL TCREG,0(0,DREG1) TEST FOR END OF TABLE 75000013 BC 7,COMPAR1 IF NOT END OF TABLE LOOP BACK 75600013 OI LCBERRST,X'80' SET DESTINATION ERROR BIT 76200013 L WREG1,0(0,13) GET LPS QUEUE ADDRESS FROM IGG019NG 76800013 LA TCREG,212(0,WREG1) GET ADDRESS OF ERROR DESTINATION QUE 77400013 LR DREG1,TCREG NEW BASE ESTABLISHED-MOVE IT TO RG 1 78000013 DESTOK2 MVC LCBDESTQ(3),TQCBADDR MOVE ERROR QUEUE OR DESTINATION 78600013 * QUEUE QCB TO LCB 79200013 SR TCREG,DREG1 GET RELATIVE ADDRESS OF DESTINATION 79800013 * ENTRY 80400013 STH TCREG,TTDKEY STORE IN HEADER PREFIX 81000013 BR RREG1 RETURN 81600013 SPACE 82200013 DESTCK2 CLC TERMID(1),0(KREG) 82800013 EJECT 83400013 LCBD 84000013 EJECT 84600013 TERMTBLD 85200013 EJECT 85800013 PREFIXD 86400013 END 87000013 ./ ADD SSI=02010131,NAME=IECKLNCH,SOURCE=0 TITLE 'QTAM START LINE - STOP LINE ROUTINE' 00200013 *********************************************************************** 00400013 * * 00600013 *NAME- * 00800013 * IECKLNCH QTAM START LINE - STOP LINE ROUTINE * 01000013 * * 01200013 *STATUS CHANGE LEVEL = 20 JANUARY 1971 * 01400021 * * 01600013 *FUNCTION- * 01800013 * THIS ROUTINE CAUSES ONE OR ALL LINES IN A COMMUNICATIONS * 02000013 * LINE GROUP TO BE ACTIVATED OR DEACTIVATED AS SPECIFIED BY THE * 02200013 * STARTLN, STOPLN OR STOPNOW MACROS. REGISTERS ARE SAVED ON * 02400013 * ENTRY AND RESTORED ON EXIT EXCEPT REGISTER 15, WHICH WILL * 02600013 * CONTAIN ONE OF THE FOLLOWING CODES: * 02800013 * X'00' - NO ERRORS . * 03000013 * X'01' - THE DCB HAS NOT BEEN OPENED. * 03200013 * X'08' - PASSED RELATIVE LINE NUMBER TOO HIGH. * 03400013 * IF A TERMINAL WAS SPECIFIED AS THE FIRST OPERAND OF THE * 03600013 * MACRO, LINKAGE IS MADE FIRST TO IECKDCBL TO LOCATE THE DCB AND * 03800013 * THEN CONTROL IS PASSED TO THIS ROUTINE. THE LAST BYTE OF THE * 04000013 * BAL INSTRUCTION PROVIDING ENTRY TO THIS ROUTINE INDICATES WHETHER * 04200013 * ONE OR ALL OF THE LINES ARE TO BE EITHER STARTED OR STOPPED. * 04400013 * THE CORRESPONDENCE IS AS FOLLOWS: * 04600013 * X'00' - STOP SINGLE LINE. * 04800013 * X'02' - START SINGLE LINE. * 05000013 * X'04' - STOP ALL LINES. * 05200013 * X'06' - START ALL LINES. * 05400013 * PARAMETER REGISTER 0 CONTAINS ON ENTRY THE DCB ADDRESS IN * 05600013 * THE THREE LOW ORDER BYTES AND THE RELATIVE LINE NUMBER (RLN) * 05800013 * OF THE SINGLE LINE TO BE STARTED OR STOPPED OR A ZERO IF ALL * 06000013 * LINES ARE TO BE STARTED OR STOPPED IN THE HIGH ORDER BYTE. * 06200013 * IF THE DCB HAS NOT BEEN OPENED OR IF THE PASSED RLN IS TOO * 06400013 * HIGH, THE CORRESPONDING ERROR FLAG IS SET IN REGISTER 15 AND * 06600013 * RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE AFTER * 06800013 * THE OTHER REGISTERS HAVE BEEN RESTORED. * 07000013 * IF THE ENTRY POINT INDICATES THAT ALL LINES ARE TO BE * 07200013 * ACTIVATED OR DEACTIVATED, THE NUMBER OF LINES IS OBTAINED FROM * 07400013 * THE DEB, WHICH IS POINTED TO BY THE DCB. THIS NUMBER IS PLACED * 07600013 * IN REGISTER 6. IF ONLY ONE LINE IS TO BE ACTED UPON, REGISTER 6 * 07800013 * CONTAINS A ONE. A WAIT IS ISSUED ON QATTACH TO ENSURE THAT THE * 07900021 * LCB FOR THE LINE IS NOT ON THE READY QUEUE. (THIS COULD HAPPEN * 08000021 * AFTER A RESTART.) * 08100021 * THE ADDRESS OF THE LCB FOR THE LINE IS OBTAINED FROM THE * 08200013 * FORMULA (LCB FOR THIS LINE)=(START OF LCB'S)+(LCB-IOB SIZE)X(RLN).* 08400013 * IF THE ROUTINE WAS ENTERED TO START A LINE THAT WAS IN * 08430021 * 'INTREL', LCBSAVE, A CONSTANT IN THIS ROUTINE, IS SET TO X'FF' TO * 08460021 * INDICATE STARTLN. AN SVC QPOST IS ISSUED TO POST THE STOPQCB TO * 08490021 * ITSELF. WHEN THE STOPSTCB SUBTASK GAINS CONTROL, THE INTREL BIT * 08520021 * IN THE HIGH ORDER BYTE OF LCBDCBPT IS TURNED OFF. (SUBTASK IS * 08550021 * NECESSARY TO CHANGE CORE ACROSS PARTITIONS.) * 08580021 * IF THE ROUTINE WAS ENTERED FOR INTREL OR STARTLN FROM A * 08610021 * PROCESS PROGRAM, A CHECK IS MADE IN LCBERCCW + 2 FOR I/O COMPLETE * 08640021 * ON THE LINE. IF I/O HAS NOT COMPLETED FROM LAST STARTLN, THE * 08670021 * TIMEUP QCB IS POSTED TO ITSELF. WHEN THE TUPSTCB SUBTASK GAINS * 08700021 * CONTROL, A FLAG OF X'FE' IS SET IN LCBCPA + 32 SO THAT IF THE * 08730021 * INTERRUPT DOES COME IN A STOPLN WILL BE DONE. UPON RETURN FROM * 08760021 * THE QPOST, A WTO IS ISSUED WITH THE FOLLOWING MESSAGE: 'IEC806I * 08790021 * XXX LINE UNAVAILABLE, ENDING STATUS NOT RECEIVED.' RETURN IS MADE* 08820021 * TO USER IGNORING THE REQUEST. * 08850021 * IF I/O HAS COMPLETED,THE STATUS OF THE LINE IS CHECKED. IF * 08880021 * LCBSTATE IS NONZERO, INDICATING THAT THE LINE IS ACTIVE, THE START* 08910021 * LINE REQUEST IS IGNORED AND RETURN IS MADE TO THE USERS PROGRAM. * 08940021 * IF LCBSTATE=0, INDICATING THE LINE IS STOPPED, AN SVC QPOST IS * 08970021 * ISSUED TO POST THE LCB TO Q1. THE SUBTASK S1, ASSOCIATED WITH Q1,* 09000021 * RECEIVES CONTROL TO BUILD APPROPRIATE CHANNEL PROGRAMS * 09030021 * EXCEPT FOR OUTPUT ONLY LINES, THE RECEIVE SCHEDULER IS PLACED* 09060021 * AT THE END OF THE CHAIN. IF THE RECEIVE SCHEDULER WAS NOT REMOVED* 09090021 * BY STOPLN (LCBCPRI = X'80'), THE SCHEDULER IS NOT RESTORED. IF * 09120021 * THE SCHEDULER HAD BEEN REMOVED, THE FLAG IN LCBCPRI IS TURNED OFF,* 09150021 * AND THE RECEIVE SCHEDULER IS LINKED INTO THE STCB CHAIN. * 09180021 * FOR DIAL LINES, LCBINCAM IS SET TO 7 (LINE IS STOPPED AND CAN* 09210021 * BE DISCONNECTED). FOR ALL LINES, LCBCPA + 32 IS SET TO X'FF' TO * 09240021 * INDICATE STARTLN. INITIAL CCW'S ARE SET UP IN THE CHANNEL PROGRAM* 09270021 * AREA. THE PROPER SAD CCW IS SET FOR 2702'S, NOP FOR DIAL LINES * 09300021 * AND TYPE III ADAPTERS AND ENABLE FOR NONDIAL LINES. (THIS IS ALSO * 09330021 * AN ENTRY POINT FOR STOPLN.) A FLAG IS SET IN LCBERCCW + 2 TO * 09360021 * INDICATE SIO. THE LCB IS PUT ON TOP OF Q3. * 09390021 * IF Q3 IS ALREADY ON THE READY QUEUE, EXIT IS MADE TO DIS- * 09420021 * PATCH. OTHERWISE, A DUMMY ELEMENT IS POSTED TO THE LPS QUEUE IF * 09450021 * UNDER MPP CONTROL. IF UNDER MCP CONTROL, A BRANCH IS TAKEN TO POST* 09480021 * IN IECKQQ01 TO POST ELEMENT TO ITSELF. * 09510021 * WHEN THE SUBTASK GAINS CONTROL, A LOOP IS MADE TO ISSUE AN * 09540021 * EXCP FOR EACH LINE ON Q3. THE FLAG AT LCBCPA + 1 IS ZEROED. EXIT * 09570021 * IS MADE TO DISPATCH. * 09600021 * UPON RETURN FROM THE QPOST TO Q1, THE ROUTINE HAS TO ISSUE A * 09630021 * WAIT TO CAUSE A TASK SWITCH AND WAIT UP TO 30 SECONDS FOR AN IN- * 09660021 * TERRUPT TO COME IN. TO DO THIS, A TIME MACRO IS ISSUED TO OBTAIN * 09690021 * CURRENT TIME. THE COMPLETE BIT IN THE TIMECB IS SET TO ZERO * 09720021 * BEFORE THE TIMEQCB IS POSTED TO ITSELF. WHEN THE SUBTASK FOR THE * 09750021 * TIMESTCB GAINS CONTROL, THE TIMEQCB IS REMOVED FROM THE READY * 09780021 * QUEUE. IF UNDER THE CONTROL OF MPP THE TIMEQCB IS POSTED TO LPS * 09810021 * QUEUE TO BE UNDER CONTROL OF MCP. IF UNDER MCP CONTROL, A BRANCH * 09840021 * IS TAKEN TO LPS CONTROL TO ENQUEUE THE TIMELMNT ELEMENT ON THE * 09870021 * TIME QUEUE FOR 1 SECOND. * 09900021 * WHEN THE TIME HAS ELAPSED, THE SUBTASK FOR LMNTSTCB GAINS * 09930021 * CONTROL. THE TIMECB IS CHECKED TO SEE IF WAIT HAS BEEN ISSUED. IF* 09960021 * A WAIT HAS BEEN ISSUED A BRANCH IS TAKEN TO OS POST ROUTINE TO * 09990021 * POST ECB COMPLETE, AND RETURN IS MADE TO DISPATCH. IF A WAIT HAS * 10020021 * NOT BEEN ISSUED RETURN IS MADE TO DISPATCH. * 10050021 * UPON RETURN FROM THE QPOST TO TIMECB, A WAIT IS ISSUED TO * 10080021 * CAUSE A TASK SWITCH. IF THE WAIT HAS BEEN ISSUED BEFORE, THE ECB * 10110021 * HAS BEEN POSTED COMPLETE BY THE LMNTSTCB SUBTASK. LCBERCCW +2 IS * 10140021 * CHECKED TO SEE IF THE INTERRUPT HAS OCCURRED. IF THE INTERRUPT * 10170021 * HAS COME IN, THE ROUTINE LOOPS BACK FOR THE NEXT LINE TO START. * 10200021 * IF THE INTERRUPT HAS NOT OCCURRED, A TIME MACRO IS ISSUED FOR* 10230021 * THE CURRENT TIME. THE TIME ELAPSED FROM THE FIRST TIME MACRO TO * 10260021 * NOW IS COMPARED TO THE LIMIT OF 30 SECONDS. IF THE TIME HAS NOT * 10290021 * ELAPSED, THE ROUTINE LOOPS BACK TO WAIT FOR 1 SECOND UNTIL EITHER * 10320021 * THE INTERRUPT IS RECEIVED OR UNTIL THE TIME HAS ELAPSED. IF THE * 10350021 * TIME HAS ELAPSED, AN SVC QPOST IS ISSUED TO POST TIMEUP QUEUE TO * 10380021 * ITSELF. THIS SUBTASK SETS A X'FE' IN LCBCPA + 32. THIS FLAG * 10410021 * INDICATES A STOPLN SO THAT IF THE INTERRUPT COMES IN AFTER 30 * 10440021 * SECONDS, A STOPLN WILL BE DONE. UPON RETURN, A WTO MACRO IS * 10470021 * ISSUED FOR THE FOLLOWING MESSAGE IEC806I XXX LINE UNAVAILABLE, * 10500021 * ENDING STATUS NOT RECEIVED. UPON RECEIPT OF THIS MESSAGE, THE * 10530021 * CUSTOMER SHOULD MANUALLY GIVE AN INTERRUPT, AFTER WHICH A STARTLN * 10560021 * SHOULD BE RE-ISSUED. * 10590021 * IF THIS ROUTINE WAS ENTERED FOR A STOP LINE, THE STATUS OF * 10620021 * THE LINE IS CHECKED. THE STOPLN REQUEST IS IGNORED, AND RETURN IS* 10650021 * MADE FOR ONE OF THE FOLLOWING: 1. LCBSTATE = X'0C', THE LINE IS IN* 10680021 * 'INTREL'. 2. LCBSTATE = 0, THE LINE IS ALREADY STOPPED. 3. * 10710021 * LCBSTATE = X'20', THE LINE IS IN CONVERSE MODE. AN SVC QPOST IS * 10740021 * ISSUED TO POST THE STOPQCB TO ITSELF. * 10770021 * WHEN THE SUBTASK FOR STOPSTCB IS ACTIVATED, THE UCB IS OB- * 10800021 * TAINED. IF THE LINE IS ACTIVE, THE RECEIVE SCHEDULER IS REMOVED * 10830021 * FROM THE LINE TO STOP THE NEXT POLLING OPERATION. IF THE RECEIVE * 10860021 * SCHEDULER IS REMOVED, LCBCPRI IS SET TO X'80' SO THAT STARTLN WILL* 10890021 * KNOW TO PUT THE RECEIVE SCHEDULER BACK IN THE STCB CHAIN. A BRANCH* 10920021 * IS TAKEN TO DISPATCH. * 10950021 * FOR AUTO POLL LINES, IF THE LINE IS RECEIVING, THE TIC AFTER * 10980021 * POLL IS NOP'ED TO STOP THE POLLING ACTION. A X'FE' IS MOVED INTO * 11010021 * LCBCPA + 47 TO LOOK LIKE END OF POLLING LIST. * 11040021 * A HIO IS DONE FOR THE FOLLOWING CASES: * 11070021 * 1. FOR WTTA LINES IF LCBCPA + 37 = X'FF' INDICATING NO DATA * 11100021 * TRANSFERING. * 11130021 * 2. FOR DIAL LINES UNLESS LCBINCAM = 2 INDICATING ACTIVE LINE.* 11160021 * 3. FOR 2740 TERMINALS IF THE TP OP CODE OF THE SENSE CCW IS * 11190021 * NON-ZERO INDICATING LINE IS NOT ACTIVE. * 11220021 * TO DO THE HIO, ERP FLAGS ARE TURNED OFF IN LCBFLAG1 AND LCBECBPT * 11250021 * IS SET TO X'48' TO INDICATE HIO TO LINE END. A BRANCH AND LINK IS* 11280021 * TAKEN TO THE HALT I/O ROUTINE. * 11310021 * UPON RETURN FROM QPOST TO STOPQCB, AN SVC QWAIT IS ISSUED TO * 11340021 * WAIT FOR THE LINE. FOR NON-DIAL LINES, THE ROUTINE LOOPS BACK FOR * 11370021 * THE NEXT LINE TO STOP. * 11400021 * FOR DIAL LINES, Q1 IS POSTED TO ITSELF FOR SIO SUBTASK. WHEN* 11430021 * THE SUBTASK GAINS CONTROL FOR A STOPLN, A DISABLE IS SET IN * 11460021 * CHANNEL PROGRAM AREA. LCBINCAM IS SET TO A 7 TO INDICATE LINE IS * 11490021 * STOPPED AND CAN BE DISCONNECTED. LCBTTIND IS ZEROED AND LCBCPA + * 11520021 * 32 IS SET TO X'FE' TO INDICATE STOP LINE. EACH SEND SCHEDULER IS * 11550021 * REMOVED FROM THE LCB-STCB CHAIN. THE LINK FIELD OF THE SEND * 11580021 * SCHEDULER IS SET TO END ELEMENT (DASD DESTINATION) AND SEND * 11610021 * SCHEDULER IS PLACED IN QCB. IF THERE ARE OUTGOING MESSAGES IN THE* 11640021 * QUEUE, A PRIMER ELEMENT IS POSTED TO THE SEND SCHEDULER TO SEND ON* 11670021 * ANOTHER LINE. THEN A SIO MUST BE ISSUED TO DISABLE THE LINE. THIS* 11700021 * IS THE SAME AS FOR DOING AN EXCP FOR A STARTLN INCLUDING THE WAIT * 11730021 * AND TIME LIMIT FOR AN INTERRUPT. * 11760021 * * 11800013 *ENTRY POINTS- * 12000013 * IECKLNCH + 0 - THE STOPLN MACRO GENERATES A BAL TO THIS POINT * 12200013 * WHEN A SINGLE LINE IS TO BE STOPPED. * 12400013 * IECKLNCH + 2- THE STARTLN MACRO GENERATES A BAL TO THIS POINT * 12600013 * WHEN A SINGLE LINE IS TO BE STARTED. * 12800013 * IECKLNCH + 4 - THE STOPLN MACRO GENERATES A BAL TO THIS POINT * 13000013 * WHEN ALL LINES ARE TO BE STOPPED. * 13200013 * IECKLNCH + 6 - THE STARTLN MACRO GENERATES A BAL TO THIS POINT * 13400013 * WHEN ALL LINES ARE TO BE STARTED. * 13600013 * * 13800013 * S1+8 - SUBTASK ASSOCIATED WITH Q1 QCB. * 13820021 * STCB+8 - SUBTASK ASSOCIATED WITH QUEUE QCB. * 13840021 * STOPSTCB+6 - SUBTASK ASSOCIATED WITH STOPQCB QCB. * 13860021 * TIMESTCB+8 - SUBTASK ASSOCIATED WITH TIMEQCB QCB. * 13880021 * LMNTSTCB+8 - SUBTASK FROM TIME DELAY OF TIMELMNT ELEMENT. * 13900021 * TUPSTCB+8 - SUBTASK ASSOCIATED WITH TIMEUP QCB. * 13920021 *INPUT- * 14000013 * REGISTER 0- CONTAINS THE RLN IN THE HIGH ORDER BYTE AND THE * 14200013 * ADDRESS OF THE DCB IN THE THREE LOW ORDER BYTES. * 14400013 * REGISTER 13- POINTS TO SAVE AREA FOR REGISTERS. * 14600013 * REGISTER 14- RETURN ADDRESS * 14800013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 15000013 * THE LAST BYTE OF THE BAL INSTRUCTION TO THIS ROUTINE INDICATES * 15200013 * THE FOLLOWING: * 15400013 * X'00' - STOP SINGLE LINE. * 15600013 * X'02' - START SINGLE LINE. * 15800013 * X'04' - STOP ALL LINES. * 16000013 * X'06' - START ALL LINES. * 16200013 * * 16400013 *OUTPUT- * 16600013 * REGISTER 15- CONTAINS ONE OF THE FOLLOWING CODES: * 16800013 * X'00' - NO ERRORS. * 17000013 * X'01' - DCB NOT OPENED. * 17200013 * X'08' - PASSED RLN TOO HIGH. * 17400013 * * 17600013 *EXTERNAL ROUTINES- * 17800013 * QPOST - IGG067 * 18000021 * QWAIT - IGG065 * 18200021 * * 18400013 *EXITS- * 18600013 * NORMAL- RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE * 18800013 * WITH A CODE OF ZERO IN REGISTER 15. * 19000013 * ERROR- RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE * 19200013 * WITH A CODE OF X'01' FOR DCB NOT OPEN OR X'08' FOR * 19400013 * PASSED RLN TOO HIGH. * 19600013 * * 19800013 *TABLES/WORK AREAS- * 20000013 * NONE. * 20200013 * * 20400013 *ATTRIBUTES- * 20600013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 20800013 * * 21000013 *NOTES- * 21200013 * INTERNAL REGISTER USAGES ARE AS FOLLOWS: * 21400013 * REGISTER 1- WORK REGISTER. * 21600013 * REGISTER 2- LOADED WITH THE ADDRESS OF THE LCB FOR THE LINE.* 21800013 * REGISTER 3- USED TO SAVE THE RLN. * 22000013 * REGISTER 5- WORK REGISTER. * 22200013 * REGISTER 6- LOADED WITH NUMBER OF LINES TO BE STARTED OR * 22400013 * STOPPED. * 22600013 * REGISTER 7- USED TO SAVE THE ADDRESS OF THE DCB. * 22800013 * REGISTER 8- LOADED WITH THE ADDRESS OF THE DEB. * 23000013 * REGISTER 9- BASE REGISTER FOR THIS ROUTINE. * 23200013 * REGISTER 10- CONTAINS ERROR CODE TO BE PLACED IN REGISTER 15.* 23400013 * * 23600013 *********************************************************************** 23800013 IECKLNCH START 24000013 *3160390000-434000,440000-444000,474000-476000,494000, 00PS 24050015 *3160498000-540000,544000-550000,564000-574000,638000-732000, 00PS 24100015 *3160750000 00PS 24150015 *1171452300-455300,482000-486000 6646 24160016 *1171744000 5479 24170016 *2719450600-451200,452340-452540,454400,754000 000C 24180017 *3410389200-469200,492600-493400,649900,669360-670860, 19340 24182017 *3410748020-748360,748430-748480,748630-748690,748720-748990749010 9340 24184017 *3410578200-577400,748700-748710 20395 24186017 *3410660700 19782 24188017 *3410748370-748420 000D 24190017 *3410748490-748620,749000 00PS 24192017 *0300748535,748605 00PS 24194017 *90351380200-380400,494000-494500 00PS 24196017 *1200666600-667500,748775 22760 24197018 *1200670030-670060,748722-748726 22754 24198018 *1200748525 22437 24199018 *1990275000-278000,348500-351000 24108 24199118 *1990449200 24117 24199218 *1990563000-564000 23166 24199318 *1990667900,748775 22760 24199418 *1990748951-748596 22438 24199518 * 748797-748909,749014-749018 25340 24199718 * 618000 M3131 24199818 * 668430-669150,690100-697100,735000,748640,748690,748826,748710 M3167 24199918 * 578400-579600 A27522 24259919 * 660700 A29181 24279919 * 748320,748400,748440,74847 A27852 24299919 * 276100-276600,302000,336000,372000,532000-556000,578100-579100 A37725 24300521 * 616200-619000,622400-625600,696600-700100,721900,749040-751120 A37725 24301121 * 546000-548000,552000-558000,576050,579020-579080,618400, A37725 24301920 * 619800,625800 A37725 24303920 * 696600,699100 M1604 24305920 * 715300-716000 A39114 24307920 * 266000,276100-276600,302000,336000,350000,372000,532000-556000, M1604 24309920 * 578100-579100,590000,616200-619000,620000,622400-625600,669060, M1604 24311920 * 669210,694100,696600-700100,717900,721900,748270,748670, M1604 24313920 * 748826,749040-751120 M1604 24315920 *A014000,079000-081000,084200-117600,138200-139200,180000-182000 S21016 24317921 *A748422-748426,748944-748948 A41209 24318921 *A669550-669570,669604-669652 A50276 24319421 *A492080-492400,C492500,A748251-748256,C748260 A52229 24319621 REG0 EQU 0 24319919 FREG EQU 1 24400013 TREG EQU 2 24600013 RLNR EQU 3 24800013 REG4 EQU 4 25000013 WK1 EQU 5 25200013 IX1 EQU 6 25400013 DCBR EQU 7 25600013 DEBR EQU 8 25800013 WKBASE EQU 9 26000013 FLAG EQU 10 26200013 RSAVE EQU 13 26400013 RETURNR EQU 14 M1604 26600000 RBASE EQU 15 26800013 DEBEXT EQU 16 27000013 QWAIT EQU 65 27200013 QPOST EQU 67 27400013 CVTTRMTB EQU 156 24108 27500018 CVT EQU 16 24108 27600018 CVTTCB EQU 0 M1604 27610000 CURTCB EQU 5 M1604 27620000 CTLTCB EQU 289 M1604 27630000 CPENTRY EQU 308 M1604 27640000 USING SVCBASE+2,BREG M1604 27650000 USING NG,Z M1604 27660000 NGADD EQU 4 24108 27700018 USING IHADCB,DCBR 28200013 USING IECKLCB0,TREG 28400013 USING *,WKBASE 28600013 BCR 0,0 STOP SINGLE LINE ENTRY POINT 28800013 BCR 0,0 START SINGLE LINE ENTRY POINT 29000013 BCR 0,0 STOP ALL ENTRY POINT 29200013 STM 14,12,12(13) START ALL ENTRY POINT 29400013 * 29600013 * INITIALIZE WORKING REGISTERS 29800013 * 30000013 BCTR RETURNR,0 BACK UP RETURN ADDRESS M1604 30200000 LR WKBASE,RBASE SET THE BASE REGISTER 30400013 LR RLNR,REG0 COPY RELATIVE LINE NUMBER 30600013 SRL RLNR,24 SHIFT RLN TO LOW ORDER 30800013 LR DCBR,REG0 LOAD DCB BASE REGISTER 31000013 L DEBR,DCBDEBAD LOAD DEB BASE REGISTER 31200013 LA IX1,1 SET INDEX FOR SINGLE LINE 31400013 LR FLAG,IX1 SET UNOPENED DCB ERROR FLAG 31600013 TM DCBOFLGS,X'10' HAS THE DCB BEEN OPENED 31800013 BNO RET BRANCH IF NO (NO DEB AVAILABLE) 32000013 LA FLAG,X'08' SET INVALID RLN FLAG 32200013 CLC 20(1,13),DEBEXT(DEBR) IS PASSED RLN TOO HIGH 32400013 BH RET BRANCH IF YES 32600013 SR FLAG,FLAG ELSE CLEAR USER'S ERROR INDICATOR 32800013 * 33000013 * RESET INDEX AND LINE NUMBER IF START OR STOP ALL. 33200013 * 33400013 CLI 0(RETURNR),2 TEST FOR ALL ENTRY M1604 33600000 BNH LOOP BRANCH NOT ALL ENTRY 33800013 LR RLNR,IX1 SET RELATIVE LINE NUMBER TO 1 34000013 IC IX1,16(DEBR) SET INDEX TO COUNT OF LINES 34200013 * 34400013 * COMPUTE ADDRESS OF THE LCB FOR THIS LINE 34600013 * 34800013 LOOP L TREG,CVT GET CVT ADDRESS 24108 34850018 L TREG,CVTTRMTB(0,TREG) GET TERMTABLE ADDRESS 24108 34900018 L TREG,NGADD(0,TREG) GET ADDRESS OF IGG019NG 24108 34950018 LA TREG,QATTACH-NG(TREG) GET ADDRESS OF QATTACH QCB M1604 35000000 SVC QWAIT WAIT FOR LCB'S TO LEAVE READY Q24108 35050018 SR FREG,FREG CLEAR INSERT REGISTER 24108 35100018 IC FREG,DCBEIOBX SIZE OF AN LCB-IOB 35200013 MR REG0,RLNR LCB-IOB SIZE TIMES LINE NUMBER 35400013 L TREG,DCBLCBAD START OF LCB'S 35600013 LA TREG,0(TREG,FREG) ADDRESS OF LCB FOR THIS LINE 35800013 LR WK1,RLNR COPY THE RELATIVE LINE NUMBER 36000013 SLL WK1,2 RELATIVE LINE NUMBER TIMES FOUR 36200013 L FREG,28(WK1,DEBR) UCB ADDRESS FOR THIS LINE 36400013 * 36600013 * DETERMINE IF STOP LINE OR START LINE REQUESTED 36800013 * 37000013 TM 0(RETURNR),2 TEST BRANCH OFFSET M1604 37200000 BC 7,STARTLN BRANCH IF START LINE 37400013 * 37600013 * 38000013 CLI LCBSTATE,X'0C' IS OPCTL STOPLN SET 00PS 38020017 BE TRYEXIT YES, LINE IS IN INTREL 00PS 38040017 CLI LCBSTATE,X'00' IS LINE ALREADY STOPPED 38060015 BE TRYEXIT BRANCH IF YES 38120015 TM LCBSTATE,X'20' LINE FREE OR IN CONVERSE MODE 19340 38920017 BNZ TRYEXIT BRANCH IF YES 19340 39720017 STM FREG,TREG,STOPSAVE SAVE UCB AND LCB ADDRESSES 19340 40520017 LA TREG,STOPQCB STOP QCB ADDRESS TO TREG 19340 41320017 LR FREG,TREG SET FREG FOR QPOST 19340 42120017 SVC QPOST POST STOP QCB 19340 42920017 LM FREG,TREG,STOPSAVE RESTORE UCB AND LCB ADDRESSES 19340 43720017 SVC QWAIT WAIT FOR THE LINE 19340 44520017 L FREG,STOPSAVE RELOAD UCB ADDRESS 24117 44920018 TM 17(FREG),X'90' IS THIS A DIAL LINE 19340 45320017 BZ TRYEXIT BRANCH IF NO 19340 46120017 B SETCHN ELSE POST TO SIO SUBTASK 19340 46920017 * 48800013 * THE FOLLOWING CODE STARTS AN INACTIVE LINE 49000013 * 49200013 STARTLN SR WK1,WK1 CLEAR WORK REG A52229 49208021 IC WK1,LCBUCBX GET REL LINE NUMBER A52229 49216021 SLA WK1,2 TIMES 4 A52229 49224021 A WK1,LCBDCBPT ADD DCB ADDRESS A52229 49232021 LA WK1,DCBCPOLL-IHADCB(WK1) POINT TO CPOLL FOR THIS LINE 49240021 TM 0(WK1),X'04' IS INTREL BIT ON A52229 49250021 BZ NOINTREL BRANCH IF NO 19340 49260017 STM FREG,TREG,STOPSAVE SAVE REGISTERS FOR QPOST 19340 49270017 MVI LCBSAVE,X'FF' INDICATE STARTLN ENTRY 19340 49280017 LA FREG,STOPQCB GET QCB ADDRESS 19340 49290017 LR TREG,FREG SET TO POST STOPQCB 19340 49300017 SVC QPOST ACTIVATE SUBTASK 19340 49310017 LM FREG,TREG,STOPSAVE RESTORE REGISTERS 19340 49320017 LA TREG,0(TREG) CLEAR HIGH ORDER BYTE 19340 49330017 NOINTREL EQU * 19340 49340017 LA FREG,0(FREG) CLEAR HI ORDER BYTE 00PS 50600015 * TO INDICATE START 00PS 51600015 ST FREG,S1SAVE SAVE UCB ADDRESS FOR SUBTASK00PS 52600015 SETCHN EQU * M1604 53200000 LR WK1,RETURNR SAVE RETURN ADDRESS M1604 53800000 LR BREG,TREG SAVE LCB ADDRESS M1604 54400000 MVI SWITCH,0 SET SWITCH IN CASE BRANCH A37725 54600020 * IS TAKEN A37725 54800020 TM LCBERCCW+2,2 I/O COMPLETE FROM LAST STARTLN M1604 55000000 BO TIME NO, WAIT 30 SECONDS A37725 55200020 MVI SWITCH,X'FF' RESET SWITCH IF BRANCH NOT A37725 55400020 * TAKEN A37725 55600020 CHECKLCB EQU * A37725 55800020 CLI LCBSTATE,0 IS LCB ALREADY ACTIVE 23166 56300018 BNE TRYEXIT YES, IGNORE STARTLN REQUEST 23166 56400018 LR FREG,TREG LCB ADDRESS FOR QPOST 00PS 56600015 L TREG,Q1+4 QUEUE ADDRESSAND PRIORITY 00PS 57000015 SVC QPOST 57600013 * 57800013 TIME EQU * A37725 57805020 TIME BIN GET STARTING TIME M1604 57810000 LR REG4,REG0 SAVE ORIGINAL TIME M1604 57820000 WAIT2 LA FREG,TIMEQCB GET QCB ADDRESS FOR QPOST M1604 57830000 MVI TIMEQCB+4,X'F4' SET PRIORITY FOR QPOST M1604 57840000 LR TREG,FREG TRANSFER TO TREG M1604 57850000 MVI TIMECB,0 ZERO COMPLETE BIT IN ECB M1604 57860000 SVC QPOST AND ACTIVATE SUBTASK M1604 57870000 WAIT ECB=TIMECB WAIT FOR TIME TO EXPIRE M1604 57880000 TM LCBERCCW+2-LCB(BREG),2 HAS INTERRUPT OCCURRED M1604 57890000 BO GETTIME NO, CHECK FOR TIME EXPIRED M1604 57900000 CKENTRY TS SWITCH WAS BRANCH TO WAIT2 TAKEN A37725 57902020 * BEFORE STARTLN SUBTASK WAS A37725 57904020 * ACTIVATED A37725 57906020 BZ CHECKLCB YES, RETURN TO CHECK LCBSTATE A37725 57908020 LR RETURNR,WK1 RESTORE RETURN REGISTER M1604 57910000 * RETURN TO CALLER IF NO MORE LINES . 58000013 * 58200013 TRYEXIT LA RLNR,1(RLNR) ADD ONE TO RELATIVE LINE NUMBER 58400013 BCT IX1,LOOP BRANCH IF MORE LINES 58600013 RET LR RBASE,FLAG LOAD USER'S ERROR INDICATOR 58800013 LA RETURNR,1(RETURNR) RESET RETURN ADDRESS M1604 59000000 RETURN (0,12) RETURN 59200013 SPACE 59400013 GETTIME TIME BIN GET TIME 59600013 SUB SLR REG0,REG4 ELAPSED TIME 61400013 COMP CH REG0,LIMIT REACHED LIMIT 61600013 BL WAIT2 NO, WAIT FOR INTERRUPT M1604 61620000 NOSTATUS LR FREG,RLNR COPY THE RLN M1604 61640000 SLL FREG,2 MULTIPLY BY FOUR M1604 61660000 L FREG,28(FREG,DEBR) UCB ADDRESS FOR THIS LINE M1604 61680000 MVC LINE(3),13(FREG) MOVE LINE NUMBER TO MSG. M1604 61700000 ST BREG,LCBAD SAVE LCB ADDRESS FOR SUBTASK M1604 61720000 LA FREG,TIMEUP SET UP TO ACTIVATE M1604 61740000 LR TREG,FREG SUBTASK TO SET STOPLN M1604 61760000 SVC QPOST CODE IN LCB M1604 61780000 TM LCBAD,X'FF' DID INTERRUPT OCCUR BEFORE M1604 61800000 * SUBTASK COULD CHANGE CODE M1604 61820000 BO CKENTRY YES, BYPASS WTO A37725 61840020 LA FREG,MSG GET MSG. ADDRESS FOR WTO M1604 61860000 WTO MF=(E,(1)) WRITE MSG. TO OPERATOR M1604 61880000 B TRYEXIT-2 IGNORE REQUEST, I/O NOT COMP A37725 61980020 LIMIT DC H'3000' 30 SECONDS M1604 62240000 MSG DC AL2(ENDMSG-MSG) MESSAGE LENGTH M1604 62280000 DC X'8000' MCSFLAGS M1604 62320000 DC C'IEC806I ' MESSAGE ID M1604 62360000 LINE DC C'000 LINE UNAVAILABLE, ' M1604 62400000 DC C'ENDING STATUS NOT RECEIVED' M1604 62440000 ENDMSG EQU * M1604 62480000 DC X'1000' DESCRIPTOR TYPE M1604 62520000 DC X'0140' DESTINATION CODE M1604 62560000 SWITCH DC X'FF' WAIT2 ENTRY SWITCH A37725 62580020 * THE FOLLOWING ERROR INDICATORS ARE SET FOR THE USER IN THIS ROUTINE 62600013 * AND ARE RIGHT ADJUSTED IN REGISTER 15 62800013 * X'00' NO ERRORS 63000013 * X'01' THE DCB HAS NOT BEEN OPENED 63200013 * X'08' PASSED RELATIVE LINE NUMBER TOO HIGH 63400013 EJECT 63600013 * THE FOLLOWING SUBTASK GAINS CONTROL WHEN A LCB IS POSTED TO 00PS 63690015 * Q1. THIS SUBTASK WILL DETERMINE IF A STOPLN OR A STARTLN IS TO BE00PS 63780015 * DONE, BUILD THE APPROPRIATE CHANNEL PROGRAM AND POST THE LCB TO 00PS 63870015 * Q3 FOR SIO TO BE ISSUED. A CHECK IS ALSO MADE TO DETERMINE IF QZ 00PS 63960015 * HAS BEEN POSTED TO THE LPS QUEUE. IF NOT THIS IS DONE. 00PS 64050015 * 00PS 64140015 * ATTRIBUTES - 00PS 64230015 * SERIALLY REUSEABLE, DISABLED, RESIDENT, SUPERVISOR MODE, UNDER 00PS 64320015 * THE TCB OF PARTITION WHICH CONTAINS THIS ROUTINE. 00PS 64410015 * 00PS 64500015 DROP TREG 00PS 64590015 USING QBLOCK,QREG 00PS 64680015 USING S1,TREG 00PS 64770015 USING IECKLCB0,FREG 00PS 64860015 QREG EQU 9 00PS 64950015 DEBOPATB EQU 12 19340 64990017 DS 0F 00PS 65040015 Q1 DC X'03' 00PS 65130015 DC X'000000' 00PS 65220015 DC X'F0' 00PS 65310015 DC AL3(Q1) 00PS 65400015 S1 DC X'6C' 00PS 65490015 DC AL3(S1) 00PS 65580015 S1SAVE DC X'FF' X'FF' INDICATES A STOPLN TO BE 00PS 65670015 DC AL3(0) DONE,OTHERWISE THE LOW ORDER00PS 65760015 * 3 BYTES CONTAIN THE UCB FOR THE 00PS 65850015 * LINE FOR WHICH A STARTLN IS TO 00PS 65940015 * BE DONE. 00PS 66030015 XC LCBCPA(24),LCBCPA CLEAR FIRST THREE CCW'S A29181 66070019 L IX1,SADENNOP LOAD FLAGS AND COUNT 00PS 66120015 ST IX1,LCBCPA+4 STORE FLAGS AND COUNT 00PS 66210015 LA WK1,LCBERCCW 00PS 66300015 TS S1SAVE STARTLN OR STOPLN AND RESET 00PS 66390015 BZ S1START BRANCH STARTLN 00PS 66480015 MVI LCBCPA,X'2F' SET UP DISABLE 00PS 66570015 MVI LCBINCAM,7 INDICATE LINE IS TO BE REUSED 22760 66660018 * AFTER STARTLN 22760 66750018 XC LCBTTIND(2),LCBTTIND ZERO TERM OFFSET 22760 66790018 MVI LCBCPA+32,X'FE' SET FLAG FOR STOPLN 00PS 66840015 LA IX1,LCBSCHAD-4 SET UP FOR LOOP M3167 66843018 STCBLOOP LR REG4,IX1 SAVE LAST STCB ADDRESS M3167 66846018 L IX1,4(REG4) GET NEXT STCB ADDRESS M3167 66849018 CLI 4(IX1),255 255 SIGNALS END OF CHAIN M3167 66852018 BE SETSTRT END, SET UP TO DO EXCP M3167 66855018 CLI 0(IX1),X'68' X'68' INDICATES SEND SCHEDULER M3167 66858018 BNE STCBLOOP NOT SEND SCHEDULER, RELOOP M3167 66861018 MVC 5(3,REG4),5(IX1) ELSE REMOVE SEND SCHEDULER M3167 66864018 LR QREG,IX1 SET QREG TO SNED SCHEDULER M3167 66867018 SH QREG,H8 BACK UP TO QCB M3167 66870018 MVC QTRAN+5(3),QTRAN+1 POINT SEND SCHEDULER TO END M3167 66873018 * ELEMENT (DESTINATION - DASD) M3167 66876018 ST IX1,QTRAN PUT SEND SCHEDULER IN QCB M3167 66879018 MVI QTRAN,X'68' RESTORE ENTRY CODE M3167 66882018 CLC QFAC,QNASEG IS QFAC LESS THAN QNASEG M3167 66885018 BNL STCBLOOP+2 NO, THERE ARE NO OUTGOING MESSAGES M3167 66888018 * IN THE QUEUE M3167 66891018 LA QREG,0(QREG) CLEAR HIGH ORDER BYTE M3167 66894018 ST QREG,PRIMER POST DUMMY PRIMER ELEMENT M3167 66897018 * TO SEND SCHEDULER TO START M3167 66900018 * SENDING ON ANOTHER LINE M3167 66903018 MVC PRIMER+5(3),READY+1 POINT PRIMER TO NEXT M1604 66906000 * READY ITEM M3167 66909018 LA QREG,PRIMER PLACE PRIMER AT M3167 66912018 ST QREG,READY READY QUEUE HEAD M1604 66921000 B SETSTRT SET START ADDRESS 00PS 66930015 S1START L FLAG,LCBDCBPT GET DCB ADDRESS 19340 66936017 L FLAG,DCBDEBAD-IHADCB(FLAG) GET DEB ADDRESS 19340 66942017 TM DEBOPATB(FLAG),X'0F' IS THIS AN OUTPUT ONLY LINE 19340 66948017 BO S2START BRANCH IF YES 19340 66954017 * A50276 66955021 * PLACE RECEIVE SCHED STCH 1ST IF RCV PRIORTY (CPRI=X'04') A50276 66956021 * AND LCB WAS REMOVED BY STOPLINE (CPRI=X'80') A50276 66957021 * ELSE PLACE RECEIVE SCHEDULER AT END OF LCB SUBTASK CHAIN 19340 66960017 * A50276 66960421 TM LCBCPRI,X'84' R.S. REMOVED BY STOPLN AND RCV PRIORA50276 66960821 BNO NOTRCVPR NO. SEND OR EQUAL PRIOR OR NOT A50276 66961221 * *** REMOVED BY STOPLINE A50276 66961621 MVC LCBSCHLK(3),LCBSCHAD+1 YES. MOVE CURRENT 1ST ST A50276 66962021 * *** PTR TO RCV SCHED STCB (IN LCB) A50276 66962421 LA REG0,LCBSCHAD SET NEW 1ST S.T. = RCV SCHED AT * A50276 66962821 ST REG0,LCBSCHAD WHICH THIS SHOULD DO A50276 66963221 MVI LCBSCHAD,X'12' RESTORE RCV SCHED CODE BYTE A50276 66963621 B S2START CONTINUE STARTLINE PROCESSING A50276 66964021 NOTRCVPR DS 0H RCV NOT PRIOR OR RCV ST NOT REMOVED A50276 66964421 * *** BY STOPLINE. THE X'80' BIT IN CPRI A50276 66964821 * *** WILL KICK US OUT TO S2START BELOW A50276 66965221 LA FLAG,LCBSCHAD-4 SET UP FOR LOOP 19340 66966017 LOOP2 LR WKBASE,FLAG SAVE LAST STCB ADDRESS 19340 66972017 L FLAG,4(WKBASE) GET NEXT STCB IN CHAIN 19340 66978017 CLI 0(FLAG),X'12' IS THIS THE RECEIVE SCHEDULER 19340 66984017 BE S2START BRANCH IF YES 19340 66990017 CLI 4(FLAG),255 255 SIGNALS END OF CHAIN 19340 66996017 BNE LOOP2 BRANCH IF NOT END 19340 67002017 TM LCBCPRI,X'80' WAS RECEIVE SCHEDULER REMOVED 22754 67003018 * BY STOPLN 22754 67004018 BZ S2START NO, DO NOT RESTORE SCHEDULER 22754 67005018 NI LCBCPRI,X'7F' TURN OFF FLAG 22754 67006018 IC REG0,LCBCPRI SAVE RECEIVE SCHEDULER PRIORITY19340 67008017 ST FLAG,LCBSCHLK-1 SET LINK FIELD TO DUMMY END 19340 67014017 * ELEMENT 19340 67020017 STC REG0,LCBCPRI RESTORE PRIORITY 19340 67026017 LA FLAG,LCBSCHAD GET RECEIVE SCHEDULER ADDRESS 19340 67032017 IC REG0,4(WKBASE) SAVE PRIORITY OF LAST STCB 19340 67038017 ST FLAG,4(WKBASE) SET RECEIVE SCHEDULER AS LAST 19340 67044017 * STCB IN CHAIN 19340 67050017 STC REG0,4(WKBASE) RESTORE STCB PRIORITY 19340 67056017 S2START L WKBASE,S1SAVE GET SAVED UCB ADDRESS 19340 67062017 TM 17(WKBASE),X'90' IS THIS A DIAL LINE 19340 67068017 BZ S3START NO, DON'T CHANGE INCAM 19340 67074017 MVI LCBINCAM,7 SET INCAM TO DISCONNECT LINE 19340 67080017 S3START EQU * 19340 67086017 MVI LCBCPA+32,X'FF' SET FLAG FOR STARTLN 00PS 67110015 MVI LCBCPA,3 SET NOP 00PS 67200015 SR FLAG,FLAG 00PS 67290015 IC FLAG,19(WKBASE) CONTROL UNIT TYPE 00PS 67380015 N FLAG,ANDMASK CLEAR UNUSED BITS 00PS 67470015 BCT FLAG,NOT2702 BRANCH IF 2701 OR 2703 00PS 67560015 IC FLAG,17(WKBASE) DETERMINE SAD REQUIRED 00PS 67650015 N FLAG,ANDMASK CLEAR UNUSED BITS 00PS 67740015 IC FLAG,SADCODE(FLAG) PROPER SAD CODE 00PS 67830015 STC FLAG,LCBCPA STORE IN CHANNEL PRGM AREA 00PS 67920015 LA WK1,8(WK1) BUMP TO NEXT CCM SLOT 00PS 68010015 NOT2702 CLI 19(WKBASE),X'82' IBM III ADAPTER 00PS 68100015 BE SETSTRT SET START ADDRESS IF YES 00PS 68190015 TM 17(WKBASE),X'90' SWITCHED CONNECTION 00PS 68280015 BNZ SETSTRT BRANCH YES, NO ENABLE 00PS 68370015 MVI 8(WK1),X'27' SET ENABLE OP CODE 00PS 68460015 ST IX1,12(WK1) STORE FLAGS AND COUNT 00PS 68550015 MVI 4(WK1),X'60' SET CHAINING IN PREVIOUS 00PS 68640015 SETSTRT LA IX1,LCBCPA CPA ADDRESS 00PS 68730015 ST IX1,LCBSTART-1 INITIALIZE START 00PS 68820015 OI LCBCPA-6,2 SET FLAG TO PREVENT DOUBLE SIO 00PS 68910015 L QREG,Q3 GET FIRST ITEM ON Q3 M3167 69010018 MVC LCBRCADD(3),Q3+1 POINT TO NEXT ITEM ON QO M3167 69110018 ST FREG,Q3 PUT LCB AT HEAD OF Q3 M3167 69210018 CLI QPRI,X'FF' HAS Q2 BEEN POSTED TO LPS Q M3167 69310018 BNE DISPATCH YES,DISPATCH NEXT READY ITEM M1604 69410000 LA FREG,DUMELE GET DUMMY ELEMENT ADDRESS M3167 69510018 L TREG,0(13) GET ADDRESS OF LPS QUEUE M3167 69610018 MVI 4(FREG),X'E3' SET PRIORITY FOR POST M5579 69660020 L WK1,CVT GET CVT ADDRESS M1604 69710000 L WK1,CVTTCB(WK1) GET TCB LIST ADDRESS M1604 69760000 CLC CURTCB(3,WK1),CTLTCB(TREG) IS THIS MSG. CTL. TCB M1604 69810000 BNE POST NO, POST DUMMY ELEMENT TO LPS M1604 69860000 MVI 4(FREG),X'F4' ELSE SET HIGH PRIORITY M5579 69910020 LR TREG,FREG SET TREG FOR POST M1604 69960000 B POST AND POST ELEMENT TO ITSELF M1604 70010000 EJECT 70140017 * THE FOLLOWING SUBTASK GAINS CONTROL AS A RESULT OF A DUMMY 00PS 70200017 * ELEMENT, LABELED 'DUMELE' BEING POSTED TO THE LPS QUEUE. THIS 00PS 70260015 * SUBTASK WILL REMOVE ALL LCB'S WHICH HAVE BEEN POSTED TO Q3 AND 00PS 70350015 * ISSUE AN EXCP FOR EACH ONE. THIS WILL CAUSE A START I/O TO BE 00PS 70440015 * GIVEN TO EXECUTE THE CHANNEL PROGRAM BUILT BY Q1. 00PS 70530015 * 00PS 70620015 * ATTRIBUTES - 00PS 70710015 * SERIALLY REUSEABLE, DISABLED,RESIDENT,SUPERVISOR MODE, 00PS 70800015 * UNDER TCB MESSAGE OF MESSAGE CONTROL PROGRAM. 00PS 70890015 * 00PS 70980015 USING STCB,TREG 00PS 71070015 DS 0F 00PS 71160015 ANDMASK DC X'00000003' 00PS 71250015 STCB DC X'6C' 00PS 71340015 DC AL3(STCB) 00PS 71430015 SADENNOP DC X'20000001' FLAGS AND COUNT 00PS 71520015 L WK1,CVT GET CVT ADDRESS A39114 71530020 L WK1,CVTTCB(WK1) GET TCB POINTER A39114 71540020 L FREG,0(13) GET ADDRESS OF LPS QUEUE A39114 71550020 CLC CURTCB(3,WK1),CTLTCB(FREG) IS CONTROL UNDER MCP A39114 71560020 * TCB? A39114 71570020 BE Q2LOOP IF YES, CONTINUE PROCESSING A39114 71580020 ST FREG,DUMELE IF NOT, POST ELEMENT BACK TO A39114 71590020 B DISPATCH LPS QUEUE (DUMELE ON READY Q.) A39114 71600020 Q2LOOP L FREG,Q3 LCB ADDRESS TO EXCP 00PS 71610015 CLI 4(FREG),X'FF' IS THIS END OF LCB CHAIN 00PS 71700015 BE DISPATCH YES,DISPATCH NEXT STCB M1604 71790000 MVC Q3(4),4(FREG) REMOVE LCB FROM Q3 00PS 71880015 MVI LCBCPA+1,0 CLEAR FLAG BYTE 00PS 71970015 LA FREG,LCBFLAG1 BUMP TO IOB 00PS 72060015 SVC 0 00PS 72150015 MVI IOSSAVE,X'FF' RESET SVC ENTRY M1604 72190000 B Q2LOOP BRANCH NO TO GET NEXT LCB 00PS 72240015 Q3 DC A(Q3) QUEUE OF LCB'S FOR WHICH 00PS 72330015 DC X'FF' START I/O'S ARE TO BE 00PS 72420015 DC AL3(Q3) ISSUED. 00PS 72510015 SADCODE DC X'13171B1F' SAD OP CODES 73600013 DS 0F 73800013 QUEUE DC X'03' 74000013 DC X'000000' 74200013 DUMELE DC X'00000000E3000000' 5479 74400016 DC A(STCB) 74600013 DC F'0' 74800013 EJECT 74801017 * DISABLED SUBTASK TO INITIATE STOPLN FUNCTION. THIS SUBTASK 19340 74802017 * RECEIVES CONTROL WHEN POSTED TO ITSELF IN THE STOPLN CODE. 19340 74803017 * IT WILL REMOVE THE RECEIVE SCHEDULER FROM THE SUBTASK CHAIN 19340 74804017 * OF THE LCB SO THAT ANOTHER POLLING OPERATION CANNOT TAKE 19340 74805017 * PLACE BEFORE QWAITING ON THE LCB. 19340 74806017 SPACE 2 74807017 UCBR EQU 7 19340 74808017 WK2 EQU 11 19340 74809017 CTLBASE EQU 12 19340 74810017 DROP FREG 19340 74811017 USING IECKLCB0,WK2 19340 74812017 USING QBLOCK,WK1 19340 74813017 USING STOPQCB,WKBASE 19340 74814017 DS 0F 19340 74815017 STOPQCB DC A(STOPQCB) 19340 74816017 DC X'F0' 19340 74817017 DC AL3(STOPQCB) 19340 74818017 STOPSTCB DC X'02' 19340 74819017 DC AL3(STOPSTCB) 19340 74820017 DC X'FF00' 19340 74821017 SPACE 2 74822017 L WK2,LCBSAVE LCB ADDRESS TO WORK REG 19340 74823017 LTR WK2,WK2 IS HIGH ORDER BIT SET 19340 74824017 BP STOPLN NO, THIS IS STOPLINE ENTRY 19340 74825017 * ELSE, LOCATE AND TURN OFF INTREL BIT A52229 74825121 SR WK1,WK1 CLEAR WORK REG A52229 74825221 IC WK1,LCBUCBX GET REL LINE NUMBER A52229 74825321 SLA WK1,2 TIMES 4 A52229 74825421 A WK1,LCBDCBPT ADD DCB ADDRESS A52229 74825521 LA WK1,DCBCPOLL-IHADCB(WK1) POINT TO CPOLL FOR THIS LINE 74825621 NI 0(WK1),X'FB' TURN OFF INTREL BIT A52229 74826021 B DISPATCH AND RETURN M1604 74827000 STOPLN L UCBR,STOPSAVE LOAD UCB ADDRESS 19340 74828017 TM LCBFLAG2,1 IS THIS AN AUTOPOLL LINE 19340 74829017 BZ DIAL BRANCH IF NO 19340 74830017 TM LCBSTATE,X'08' IS LINE RECEIVING 19340 74831017 BZ CHEKSTCB IF NO, TAKE OUT RECEIVE SCHED. A27852 74832019 MVI LCBCPA+47,X'FE' CHANGE TIC ADDRESS AFTER POLL 19340 74833017 MVI LCBCPA+40,3 CHANGE TIC TO NOP 19340 74834017 DIAL TM 17(UCBR),X'90' IS THIS A DIAL LINE 19340 74835017 BNZ TRYHIO YES, DO HIO 19340 74836017 L WK1,LCBDCBPT GET DCB ADDRESS 000C 74836618 TM DCBCPOLL-IHADCB(WK1),X'68' IS IT A WTTA LINE 000C 74837218 BNO NOTWTTA BRANCH NOT WTTA 000D 74838017 CLI LCBCPA+37,255 IS IT TRANSFERRING DATA 000D 74839017 BNE CHEKSTCB IF YES, TAKE OUT RCV SCHEDULER A27852 74840019 B HALTIO 000D 74841017 NOTWTTA EQU * 000D 74842017 TM 19(UCBR),X'C0' TEST FOR 2260,115A,83B3 A41209 74842221 BM DISPATCH DO NOT REMOVE RCV SHED AS MAY A41209 74842421 * BE IN BREAKOFF A41209 74842621 CLI LCBCPA+16,4 IS THIS A SENSE COMMAND 19340 74843017 BNE CHEKSTCB IF NO, TAKE OUT RCV SCHEDULER A27852 74844019 CLI LCBCPA+21,0 IF TP OP CODE=0, LINE IS BUSY, 19340 74845017 * NO HIO ISSUED 19340 74846017 BE CHEKSTCB IF LINE BUSY, TAKE OUT RCV SCHED27852 74847019 HALTIO NI LCBFLAG1,X'DB' TURN OFF ERP FLAGS 19340 74848017 UCBFLAGS EQU 6 00PS 74849017 UCBRQEAD EQU 20 00PS 74850017 CVTIXAVL EQU 124 00PS 74851017 HIORTN EQU 8 00PS 74852017 MVI LCBECBPT,X'48' SET HIO FLAG FOR LINE-END 22437 74852518 IC WK1,UCBFLAGS(UCBR) SAVE UCBFLAGS STATUS 00PS 74853017 LR REG4,WKBASE SAVE BASE REGISTER 00PS 74853517 STM 8,15,SAVE SAVE REGISTERS FOR HALT I/O 00PS 74854017 LR DEBR,UCBR UCB ADDRESS TO REGISTER 8 00PS 74855017 LH WKBASE,UCBRQEAD(DEBR) RQE ADDRESS IN REGISTER 9 00PS 74856017 L FLAG,CVT CVT ADDRESS 00PS 74857017 L FLAG,CVTIXAVL(FLAG) LIST ADDRESS 00PS 74858017 L FLAG,HIORTN(FLAG) HALT I/O ROUTINE ADDRESS 00PS 74859017 BALR RBASE,FLAG LINK TO HALT I/O ROUTINE 00PS 74860017 LR WKBASE,REG4 RESTORE BASE REGISTER 00PS 74860517 LM 8,15,SAVE RESTORE REGISTERS 00PS 74861017 STC WK1,UCBFLAGS(UCBR) RESTORE UCBFLAGS 00PS 74862017 CHEKSTCB LA WK1,LCBSCHAD-4 SET UP FOR LOOP 19340 74863017 RCVLOOP LR REG4,WK1 SAVE LAST STCB ADDRESS M3167 74864018 L WK1,4(REG4) GET NEXT STCB IN CHAIN 19340 74865017 CLI 4(WK1),255 255 SIGNALS END OF CHAIN 19340 74866017 BE DISPATCH BRANCH IF END M1604 74867000 CLI 0(WK1),X'12' X'12' INDICATES RECEIVE SCHED 19340 74868017 BNE RCVLOOP BRANCH NOT RECEIVE SCHEDULER M3167 74869018 CLI LCBINCAM,2 IS THIS AN ACTIVE DIAL LINE 20395 74870017 BE RCVLOOP YES, LOOK AT NEXT STCB M3167 74871018 MOVE MVC 5(3,REG4),5(WK1) ELSE REMOVE RECIEVE SCHEDULER 19340 74872017 OI LCBCPRI,X'80' SET FLAG FOR STARTLN TO 22754 74872218 * RECOGNIZE RECEIVE SCHEDULER 22754 74872418 * REMOVED BY STOPLN 22754 74872618 B DISPATCH GO DISPATCH NEXT READY ITEM M1604 74882600 SPACE 2 74893017 TRYHIO CLI LCBINCAM,2 IS LINE ACTIVE 19340 74894017 BNE HALTIO NO, DO HIO 19340 74894221 TM 19(UCBR),X'50' TEST FOR TWX A41209 74894421 BO DISPATCH BRANCH IF TWX, DO NOT REMOVE A41209 74894621 * RCV SCHED AS MAY BE IN BREAKOFFA41209 74894821 CLI LCBCPA+32,4 DOES CHANNEL PROGRAM CONTAIN 22438 74895118 * SENSE COMMAND 22438 74895218 BNE CHEKSTCB NO,LOOK AT STCB CHAIN 22438 74895318 CLI LCBCPA+37,0 IF TP OP CODE=0, LINE IS BUSY 22438 74895418 * IF NOT 0, HIO NECESSARY 22438 74895518 * BNE HALTIO BRANCH IF HIO NECESSARY 22438 74895618 B CHEKSTCB ELSE LOOK AT STCB CHAIN 19340 74896017 H8 DC H'8' 19340 74897017 STOPSAVE DC A(0) 19340 74898017 LCBSAVE DC F'0' 19340 74899017 SAVE DS 8F 00PS 74900017 H16 DC H'16' 19340 74901017 SPACE 2 74901218 PRIMER DC A(PRIMER) 25340 74901418 DC X'FE' 25340 74901618 DC AL3(PRIMER) 25340 74901818 EJECT 74902017 * THIS SUBTASK PUTS AN ELEMENT ON THE TIME DELAY QUEUE TO M1604 74904000 * ALLOW A TASK SWITCH WHILE AWAITING THE INTERRUPT FROM THE M1604 74906000 * EXCP ISSUED PREVIOUSLY. M1604 74908000 SPACE 3 74910000 TIMEQCB DC A(TIMEQCB) M1604 74912000 DC X'F4' ELEMENT PRIORITY M1604 74914000 DC AL3(0) LINK FIELD ON LPS OR READY Q M1604 74916000 TIMESTCB DC X'6C' SUBTASK RETURN CODE M1604 74918000 DC AL3(TIMESTCB) STCB ADDRESS M1604 74920000 DC F'0' FILLER M1604 74922000 USING TIMEQCB,WKBASE M1604 74924000 L TREG,0(RSAVE) LOAD LPS Q ADDRESS FOR POST M1604 74926000 MVC READY+1(3),TIMEQCB+5 REMOVE TIMEQCB FROM READY Q M1604 74928000 MVI TIMEQCB+4,X'E3' SET LOW PRIORITY FOR POST M1604 74930000 LR FREG,QREG PUT TIMEQCB ADDRESS IN R1 M1604 74932000 L WK1,CVT GET CVT ADDRESS M1604 74934000 L WK1,CVTTCB(WK1) GET TCB LIST ADDRESS M1604 74936000 CLC CURTCB(3,WK1),CTLTCB(TREG) IS THIS MSG. CTL. TCB M1604 74938000 BNE POST NO, POST TIMEQCB TO LPS Q M1604 74940000 LA IX1,1 SET TIME INTERVAL M1604 74942000 LA REG4,TIMELMNT GET TIMER ELEMENT ADDRESS M1604 74944000 B CPENTRY(TREG) BRANCH TO ENQUEUE ELEMENT ON M1604 74946000 * TIME QUEUE M1604 74948000 TIMELMNT DC A(TIMELMNT) M1604 74950000 DC X'F4' ELEMENT PRIORITY M1604 74952000 DC AL3(0) READY Q LINK FIELD M1604 74954000 LMNTSTCB DC X'6C' STCB RETURN CODE M1604 74956000 DC AL3(LMNTSTCB) TIME ELEMENT STCB ADDRESS M1604 74958000 DC F'0' TIME Q LINK FIELD M1604 74960000 USING TIMELMNT,QREG M1604 74962000 TM TIMECB,X'80' HAS WAIT BEEN ISSUED YET M1604 74964000 BO TOPOST YES, DO BALR TO POST M1604 74966000 MVI TIMECB,X'40' ELSE SET COMPLETE BIT IN ECB M1604 74968000 B DISPATCH AND DISPATCH NEXT READY ITEM M1604 74970000 TOPOST LA 11,TIMECB LOAD ECB ADDRESS FOR POST M1604 74972000 LR IX1,CTLBASE SAVE QQ01 BASE ADDRESS M1604 74974000 B BYPASS BRANCH AROUND AREA USED BY M1604 74976000 * TIME DELAY ROUTINE M1604 74978000 ORG TIMELMNT+X'2A' M1604 74980000 DC H'0' SAVE AREA FOR TIME DELAY M1604 74982000 BYPASS L CTLBASE,TIMECB GET RB ADDRESS M1604 74984000 LR WK1,RSAVE SAVE ADDRESS OF IGG019NG M5568 74985020 USING TBLOCK,CTLBASE M1604 74986000 TCBLOOP TM XSTZB+1,X'80' TEST FOR LINK FIELD = TCB M1604 74988000 L CTLBASE,XRBLNK-1 LOAD RB LINK ADDRESS M1604 74990000 BZ TCBLOOP NOT TCB, LOOP M1604 74992000 DROP CTLBASE M1604 74994000 USING SVCBASE+2,IX1 M1604 74996000 L RBASE,POSTCON LOAD POST ENTRY POINT M1604 74998000 DROP IX1 M1604 75000000 USING SVCBASE+2,CTLBASE M1604 75002000 BALR 14,15 LINK TO POST ECB M1604 75004000 LR CTLBASE,IX1 RELOAD QQ01 BASE M1604 75006000 LR RSAVE,WK1 RESTORE ADDRESS OF IGG019NG M5568 75007020 B DISPATCH AND DISPATCH NEXT READY ITEM M1604 75008000 TIMECB DC F'0' M1604 75010000 SPACE 3 75012000 * THIS SUBTASK RESETS STARTLN CODE TO STOPLN CODE IF 30 M1604 75014000 * SECONDS HAS ELAPSED WITH NO INTERRUPT. M1604 75016000 TIMEUP DC A(TIMEUP) M1604 75018000 DC X'F4' QCB PRIORITY M1604 75020000 DC AL3(TIMEUP) LINK FIELD ON READY QUEUE M1604 75022000 TUPSTCB DC X'6C' SUBTASK RETURN CODE M1604 75024000 DC AL3(TUPSTCB) STCB ADDRESS M1604 75026000 LCBAD DC F'0' LCB ADDRESS SAVE AREA M1604 75028000 USING TIMEUP,QREG M1604 75030000 L WK1,LCBAD GET LCB ADDRESS M1604 75032000 TM LCBERCCW+2-LCB(WK1),2 DID INTERRUPT OCCUR M1604 75034000 BZ SETFLAG YES, SET FLAG TO BYPASS WTO M1604 75036000 MVI LCBCPA+32-LCB(WK1),X'FE' ELSE SET STOPLN CODE M1604 75038000 * IN LCB M1604 75040000 B DISPATCH AND RETURN M1604 75042000 SETFLAG MVI LCBAD,X'FF' SET FLAG SHOWING INTERRUPT M1604 75044000 * HAS OCCURRED M1604 75046000 B DISPATCH AND RETURN M1604 75048000 EJECT 75050000 PREFIXD 75052000 EJECT 75054000 QCBD 75056000 EJECT 75058000 TCBD 75060000 EJECT 75062000 STCBD 75064000 EJECT 75066000 * EQUATES AND USINGS FOR QQ01 DSECTS M1604 75068000 Y EQU 3 M1604 75070000 X EQU 6 M1604 75072000 TCBREG EQU 10 M1604 75074000 BREG EQU 12 M1604 75076000 Z EQU 13 M1604 75078000 USING IECKPREF,FREG M1604 75080000 USING QBLOCK,QREG M1604 75082000 USING TBLOCK,Y M1604 75084000 USING TCB,TCBREG M1604 75086000 * IGG019NG DSECT M1604 75088000 NG DSECT 75090000 DS XL72 M1604 75092000 QSAVE DS 0XL1 M1604 75094000 QATTACH DS XL8 M1604 75096000 READY DS XL4 M1604 75098000 DS XL1 M1604 75100000 DUMMY DS XL3 M1604 75102000 ORG NG+102 M1604 75104000 NRET DS XL4 M1604 75106000 EJECT 75108000 SVCBASE DSECT 75110000 CTLPROGD 75112000 EJECT 75200013 DCBD DSORG=CX,DEVD=WT 000C 75400017 EJECT 75600013 LCBD QTAM=3 75800013 END 76000013 ./ ADD SSI=02010770,NAME=IECKMODE,SOURCE=0 TITLE 'IECKMODE QTAM MESSAGE MODE (MODE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * * 05000013 * IECKMODE QTAM MESSAGE MODE (MODE) * 06000013 * * 07000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 08000013 * * 09000013 *FUNCTION- * 10000013 * THIS ROUTINE IS ENTERED WHEN A SPECIFIC CHARACTER IS * 11000013 * SPECIFIED AS THE SECOND OPERAND OF THE MODE MACRO. THE SCAN * 12000013 * ROUTINE IS USED TO LOCATE THE NEXT FIELD IN THE MESSAGE HEADER. * 13000013 * IF THIS CHARACTER IS IDENTICAL TO THE CONTROL CHARACTER SPECIFIED * 14000013 * IN THE MACRO STATEMENT, THEN THE SPECIFIED ROUTINE IS EXECUTED. * 15000013 * IF THE CHARACTERS DO NOT MATCH, THE SCAN POINTER IS RESTORED,* 16000013 * AND CONTROL RETURNS TO THE NEXT LPS INSTRUCTION. * 17000013 * * 18000013 *ENTRY POINTS- * 19000013 * IECKMODE - CONTROL IS PASSED TO THIS POINT WHEN A SPECIFIC * 20000013 * CHARACTER IS GIVEN AS THE OPERAND OF THE MODE MACRO * 21000013 * STATEMENT. REGISTER 15 WILL CONTAIN THE BRANCH ADDRESS, AND * 22000013 * REGISTER 14 WILL CONTAIN THE RETURN ADDRESS. * 23000013 * * 24000013 *INPUT- * 25000013 * REGISTER 1- PARAMETER REGISTER CONTAINING THE ADDRESS OF THE * 26000013 * ROUTINE NAMED AS THE FIRST OPERAND OF THE MACRO. * 27000013 * REGISTER 14- RETURN ADDRESS * 28000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 29000013 * * 30000013 *OUTPUT- * 31000013 * NONE. * 32000013 * * 33000013 *EXTERNAL ROUTINES- * 34000013 * IECKSCAN - TO LOCATE THE START OF THE NEXT FIELD IN THE MESSAGE * 35000013 * HEADER. * 36000013 * * 37000013 *EXITS- * 38000013 * NORMAL- IF CHARACTERS ARE IDENTICAL, A BRANCH TO THE SPECIFIED * 39000013 * ROUTINE IS EXECUTED. BRANCH IS ON REGISTER 1. * 40000013 * IF CHARACTERS DO NOT AGREE, SCAN POINTER IS REPOSITIONED TO * 41000013 * ITS PLACE BEFORE THIS TEST. CONTROL PASSES TO NEXT LPS * 42000013 * INSTRUCTION BY BRANCHING ON REGISTER 14. * 43000013 * ERROR- NONE. * 44000013 * * 45000013 *TABLES/WORK AREAS- * 46000013 * NONE. * 47000013 * * 48000013 *ATTRIBUTES- * 49000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 50000013 * * 51000013 *NOTES- * 52000013 * REGISTER 0- WORK REGISTER TO SAVE SCAN POINTER. * 53000013 * REGISTER 2- OUTPUT FROM SCAN ROUTINE. WILL CONTAIN ADDRESS OF * 54000013 * START OF NEW FIELD. * 55000013 * REGISTER 3- RETURN ADDRESS FOR BRANCH TO SCAN. * 56000013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 57000013 * * 58000013 *********************************************************************** 59000013 IECKMODE START 60000013 DREG0 EQU 0 61000013 DREG1 EQU 1 62000013 KREG EQU 2 63000013 RREG2 EQU 3 64000013 SPREG EQU 5 65000013 LGREG EQU 7 66000013 RREG1 EQU 14 67000013 SREG EQU 15 68000013 LR DREG0,SPREG SAVE SCAN POINTER 69000013 L SREG,4(0,LGREG) GET ADDRESS OF SCAN SUBROUTINE 70000013 BALR RREG2,SREG LINK TO SCAN SUBROUTINE 71000013 CLC 2(1,RREG1),0(KREG) WAS MODE CHARACTER FOUND 72000013 BCR 8,DREG1 IF YES GO TO DESIGNATED SUBROUTINE 73000013 LR SPREG,DREG0 ELSE RESTORE THE SCAN POINTER 74000013 B 4(0,RREG1) AND RETURN 75000013 END 76000013 ./ ADD SSI=02010771,NAME=IECKNATE,SOURCE=0 TITLE 'IECKNATE QTAM INITIATE-MODE (MODE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKNATE QTAM INITIATE (MODE) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THIS ROUTINE WILL SET THE INITIATE BIT IN THE LCB WHEN * 10000013 * INITIATE IS SPECIFIED AS A PARAMETER OF THE MODE MACRO * 11000013 * * 12000013 *ENTRY POINTS- * 13000013 * IECKNATE - THE EXPANSION OF THE MODE MACRO GENERATES A BRANCH TO * 14000013 * THIS POINT WHEN INITIATE IS SPECIFIED. * 15000013 * * 16000013 *INPUT- * 17000013 * REGISTER 4- ADDRESS OF THE LCB * 18000013 * REGISTER 14- RETURN ADDRESS * 19000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 20000013 * * 21000013 *OUTPUT- * 22000013 * REGISTER 4- ADDRESS OF THE LCB * 23000013 * LCBSTATE (LCB+0) WILL HAVE BEEN OR'ED WITH X'10' TO SET THE * 24000013 * INITIATE BIT ON. * 25000013 * * 26000013 *EXTERNAL ROUTINES- * 27000013 * NONE. * 28000013 * * 29000013 *EXITS- * 30000013 * NORMAL- RETURN TO NEXT INSTRUCTION IN MACRO EXPANSION VIA A * 31000013 * BRANCH ON REGISTER 14. * 32000013 * ERROR- NONE. * 33000013 * * 34000013 *TABLES/WORK AREAS- * 35000013 * NONE. * 36000013 * * 37000013 *ATTRIBUTES- * 38000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 39000013 * * 40000013 *********************************************************************** 41000013 IECKNATE START 42000013 DREG1 EQU 1 43000013 LCBREG EQU 4 44000013 RREG1 EQU 14 45000013 USING *,DREG1 46000013 USING IECKLCB0,LCBREG 47000013 OI LCBSTATE,X'10' SET INITIATE BIT IN LCB 48000013 B 4(0,RREG1) 49000013 EJECT 50000013 LCBD 51000013 END 52000013 ./ ADD SSI=01010131,NAME=IECKOCTL,SOURCE=0 *********************************************************************** 00000221 * * 00000421 * STATUS CHANGE LEVEL 190 JANUARY 1971 * 00000621 * * 00000821 * FUNCTION- THE RETURN REGISTER (14) AND SCAN POINTER REGISTER (5) ARE* 00001021 * SAVED IN THE SAVE AREA IN THIS ROUTINE. THE ADDRESS OF THE SCAN * 00001221 * ROUTINE IS OBTAINED FROM THE LPSTART MACRO EXPANSION. THE ROUTINE* 00001421 * BRANCHES TO THE SCAN ROUTINE TO OBTAIN THE FIRST FIELD OF THE * 00001621 * MESSAGE. THE CONTROL MESSAGE IDENTIFER IS MOVED FROM THE MACRO * 00001821 * EXPANSION INTO A WORKAREA. IF THE CONTROL MESSAGE IDENTIFER DOES* 00002021 * NOT COMPARE WITH THE FIELD OBTAINED BY SCAN ROUTINE, 'INCOMPLETE * 00002221 * HEADER' (BIT 5) IS SET IN LCBERRST OF THE LCB. THE SCAN POINTER * 00002421 * IS RESTORED, AND RETURN IS MADE TO THE NEXT LPS INSTRUCTION. * 00002621 * IF THE COMPARE WAS GOOD, INDICATING AN OPERATOR CONTROL * 00002821 * MESSAGE,MSTATUS IS CHECKED FOR SINGLE SEGEMENT. IF A SINGLE * 00003021 * SEGMENT MESSAGE, LINKAGE IS MADE TO THE SCAN ROUTINE TO OBTAIN * 00003221 * THE FUNCTION TO BE PERFORMED. IF THE OPERATION TO BE PERFORMED * 00003421 * IS NOT VALID, OR THE MESSAGE IS NOT HEADER LAST SEGMENT, THE * 00003621 * MESSAGE IS RETRANSMITTED TO THE SOURCE TERMINAL. THIS IS DONE BY* 00003821 * MOVING THE SOURCE KEY 'TTSKEY' TO THE DESTINATION KEY 'TTDKEY' OF* 00004021 * THE BUFFER, THE ADDRESS OF THE QCB FROM THE TERMINAL TABLE OF THE* 00004221 * SOURCE IS MOVED TO LCBDESTQ, REGISTERS ARE RESTORED, AND RETURN * 00004421 * IS TO THE MACRO EXPANSION WHICH BRANCHES TO ENDRCV SECTION. * 00004621 * IF THE OPERATION TYPE IS FOUND, CONTROL IS PASSED TO THE * 00004821 * PARTICULAR ROUTINE. * 00005021 * RCOPYT - SUBROUTINE SUB1 IS USED TO OBTAIN THE TERMINAL * 00005221 * ADDRESS OF THE SPECIFIED ENTRY AND BUFFER SIZE. ENTRY SIZE IS * 00005421 * LOWERED BY FOUR,SINCE THE SIZE AND QCB ADDRESS IS NOT COPIED, AND* 00005621 * THEN THE SIZE IS DOUBLED FOR CONVERSION. IF THE BUFFER SIZE IS * 00005821 * LESS THAN THE TERMINAL TABLE SIZE-4, THE BUFFER SIZE IS USED. THE* 00006021 * UNPAK SUBROUTINE IS USED TO UNPACK AND TRANSLATE THE TERMINAL * 00006221 * ENTRY INTO THE BUFFER. THE MESSAGE IS SENT BACK TO THE SOURCE. * 00006421 * RCOPYC- SUBROUTINE SUB1 IS USED TO OBTAIN THE TERMINAL TABLE* 00006621 * ADDRESS OF THE SPECIFIED ENTRY AND BUFFER SIZE. THE QCB ADDRESS * 00006821 * IS OBTAINED FROM THE TERMINAL TABLE. IF THE QCB IS NOT FOR A * 00007021 * DESTINATION (X'68'), THE MESSAGE IS RETURNED TO SOURCE TERMINAL. * 00007221 * THE LCB IS CALCULATED FROM THE LCB ADDRESS IN THE DCB AND THE * 00007421 * RELATIVE LINE NUMBER(RLN) TIMES THE SIZE OF AN LCB. THE ADDRESS * 00007621 * OF THE ERROR COUNTERS IN THE LCB IS OBTAINED BY SUBTRACTING 16 * 00007821 * FROM THE END OF THE LCB. THE REGISTERS ARE SAVED BEFORE AN SVC * 00008021 * QPOST IS ISSUED TO POST COPYCLR QCB TO ITSELF TO GAIN CONTROL IN * 00008221 * DISABLE MODE SO THAT THE COUNTERS MAY BE MANIPULATED. * 00008421 * WHEN THE COPYCLR SUBTASK GAINS CONTROL, THE REGISTERS BEFORE* 00008621 * QPOST ARE RESTORED. THE THRESHOLD VALUES ARE ADDED TO THE ACCUM-* 00008821 * LATIVE COUNTERS FOR TRANSMISSIONS, DATA CHECKS, INTERVENTION * 00009021 * REQUIRED, AND TIME OUT. IF THE BUFFER SIZE IS LESS THAN 32 * 00009221 * (DOUBLE THE 16 BYTE AREA NEEDED FOR CONVERSION), THE BUFFER SIZE * 00009421 * IS USED FOR MOVE. LINKAGE IS MADE TO THE UNPAK SUBROUTINE TO * 00009621 * TRANSLATE AND MOVE THE ERROR COUNTERS INTO THE BUFFER. THE * 00009821 * THRESHOLD COUNTERS IN THE LCB ARE ZEROED. A BRANCH TO DISPATCH * 00010021 * IS TAKEN TO RETURN TO COPYC. COPYC RETURNS TO THE MACRO EXPAN- * 00010221 * SION TO SEND MESSAGES TO SOURCE TERMINAL. * 00010421 * RSWITCH- THIS ROUTINE CHANGES THE OPERATOR CONTROL FACILITY * 00010621 * TO AN ALTERNATE SPECIFIED IN THE MACRO. IF 'ALTERNATE TERMINAL' * 00010821 * (X'01') IS NOT SET IN THE FLAGS, THE MESSAGE IS RETURNED TO THE * 00011021 * SOURCE TERMINAL. THE OFFSETS TO THE ALTERNATE AND PRIMARY * 00011221 * TERMINALS IN THE MACRO PARAMETER LIST ARE SWITCHED VIA 3 EXCLU- * 00011421 * SIVE OR'S. THE SERVICE BIT IN THE MESSAGE IS SET SO THAT THE * 00011621 * BUFFER WILL BE RETURNED TO THE AVAILABLE BUFFER QUEUE. RETURN IS* 00011821 * TO THE MACRO EXPANSION WHICH BRANCHES TO ENDRCV SECTION. * 00012021 * CHNGT- LINKAGE IS MADE TO THE SUB1 SUBROUTINE TO OBTAIN THE * 00012221 * TERMINAL ADDRESS AND BUFFER SIZE. THE SCAN POINTER IS BUMPTED * 00012421 * PASSED ALL BLANKS. IF THE BUFFER IS ALL BLANKS, RETURN IS MADE TO* 00012621 * THE NEXT LPS INSTRUCTION. THE CHARACTERS TO BE PLACED IN THE * 00012821 * TERMINAL TABLE ARE TRANSLATED AND CHECKED FOR ENDING CHARACTER OF* 00013021 * EOB OR EOT. IF AN INVALID CHARACTER IS USED, A TEST IS MADE TO * 00013221 * SEE IF THERE IS ENOUGH SPACE FOR AN EOB OR EOT TO BE INSERTED * 00013421 * AFTER THE DATA; IF NOT, AN EOT IS INSERTED AFTER THE TERM NAME. * 00013621 * THE MESSAGE IS THEN RETURNED TO THE SOURCE TERMINAL. * 00013821 * IF THE DATA IS VALID, THE SIZE IS CHECKED. IF THE SIZE IS * 00014021 * ZERO, THE SERVICE BIT IS SET IN MSTATUS FIELD OF THE BUFFER SO * 00014221 * THAT THE BUFFER IS RETURNED. IF THERE IS AN ODD NUMBER OF CHAR- * 00014421 * ACTERS, THE MESSAGE IS TREATED AS INVALID. THE SIZE OF THE * 00014621 * TERMINAL TABLE ENTRY IS ACCESSED AND DECREASED BY 4 FOR SIZE AND * 00014821 * QCB ADDRESS. THE DATA TO BE INSERTED IS DIVIDED BY 2 AND COM- * 00015021 * PARED WITH THE ADJUSTED TERMINAL SIZE. IF DATA IS TOO LARGE FOR * 00015221 * TERMINAL ENTRY THE MESSAGE IS TREATED AS INVALID. FOR A VALID * 00015421 * MESSAGE, THE CHANGE QCB IS POSTED TO ITSELF TO GAIN CONTROL WHILE* 00015621 * DISABLED. * 00015821 * WHEN THE CHANGE1 SUBTASK GAINS CONTROL, IT ACCESSES THE QCB * 00016021 * FROM THE TERMINAL TABLE ENTRY TO BE CHANGED. IF THE QCB IS NOT A* 00016221 * DESTINATION QCB, THE DCB HAS NOT BEEN OPENED, OR THE LINE IS NOT * 00016421 * ACTIVE, THEN THE SEQUENCE NUMBER CAN BE CHANGED. OTHERWISE, THE * 00016621 * SEQUENCE NUMBER CANNOT BE CHANGED SO THE COUNT IS DECREASED BY 4.* 00016821 * THE DATA IS PACKED INTO AN AREA AND MOVED INTO THE TERMINAL ENTRY* 00017021 * 16 BYTES AT A TIME. EXIT IS MADE TO DISPATCH TO RETURN TO CHNGT.* 00017221 * THE SERVICE BIT IS SET IN THE BUFFER SO THAT IT WILL BE RETURNED * 00017421 * TO THE AVAILABLE BUFFER QUEUE. RETURN IS MADE TO THE MACRO WHICH* 00017621 * BRANCHES TO ENDRCV SECTION. * 00017821 * RINTRCPT- THE FLAGS IN THE MACRO EXPANSION ARE CHECKED FOR * 00018021 * INTERCEPT (X'02'). IF THE INTERCEPT FLAG HAS NOT BEEN SET, THE * 00018221 * INTERCPT MACRO HAS NOT BEEN SPECIFIED. SINCE OPCTL INTERCEPT USES* 00018421 * THE INTERCPT MACRO FUNCTION, THE MESSAGE IS ROUTED TO THE SOURCE * 00018621 * AS IN ERROR. LINKAGE IS MADE TO THE SUB1 SUBROUTINE TO GET THE * 00018821 * TERMINAL ADDRESS. IF THE QCB IS NOT FOR A TERMINAL, THE MESSAGE * 00019021 * IS RETURNED TO THE SOURCE TERMINAL. THE 'SEND' BIT IN TSTATUS OF* 00019221 * THE TERMINAL ENTRY IS TURNED OFF TO CAUSE THE TERMINAL TO BE * 00019421 * INTERCEPTED WHEN THE NEXT MESSAGE IS SENT. THE 'SERVICED' BIT IS* 00019621 * SET IN MSTATUS OF THE BUFFER TO CAUSE THE BUFFER TO BE RETURNED * 00019821 * TO THE AVAILABLE BUFFER QUEUE. RETURN IS MADE TO THE MACRO * 00020021 * EXPANSION WHICH BRANCHES TO ENDRCV. * 00020221 * RRELEASM- THE FLAGS IN THE MACRO EXPANSION ARE CHECKED FOR * 00020421 * INTERCEPT. IF INTERCEPT HAS NOT BEEN SPECIFIED,RELEASEM CANNOT BE* 00020621 * DONE SO THE MESSAGE IS RETURNED TO THE SOURCE TERMINAL. LINKAGE * 00020821 * IS MADE TO THE SUB1 SUBROUTINE TO OBTAIN THE TERMINAL ADDRESS. * 00021021 * THE QLINK FIELD OF THE DESTINATION QCB IS CHECKED FOR RESTART. IF* 00021221 * NONZERO A RESTART IS IN PROGRESS, SO A RELEASEM CANNOT BE DONE. * 00021421 * THE MESSAGE IS RETURNED TO THE SOURCE TERMINAL. IF TSTATUS IN * 00021621 * THE TERMINAL TABLE INDICATES THAT THE ENTRY IS NOT INTERCEPTED, * 00021821 * THE 'SERVICED' BIT IS SET IN MSTATUS TO RETURN BUFFER TO AVAIL- * 00022021 * ABLE BUFFER QUEUE. THE ADDRESS IN THE INTERCPT FIELD IS LESS * 00022221 * THAN OR EQUAL TO THE FIRST ELEMENT IN THE QUEUE (QFAC), THE * 00022421 * INTERCPT OPTION FIELD OF THE TERMINAL TABLE IS MOVED INTO QFAC AS* 00022621 * THE FIRST MESSAGE TO BE SENT. THE 'INTERCPT' BIT IS TURNED OFF * 00022821 * AND RELEASE PENDING BIT IS SET ON IN TSTATUS OF THE TERMINAL * 00023021 * TABLE ENTRY. IF THE STCB IN THE QCB IS THE SEND SCHEDULER, A * 00023221 * PRIMER IS NOT NEEDED SO THE 'SERVICE' BIT IS SET IN MSTATUS OF * 00023421 * THE BUFFER IS RETURNED TO THE AVAILABLE BUFFER QUEUE. OTHERWISE,* 00023621 * A PRIMER ELEMENT IS POSTED TO THE QCB TO ACTIVATE THE SEND SCHED-* 00023821 * LER. THE 'SERVICED' BIT IS SET IN MSTATUS TO RETURN THE BUFFER TO* 00024021 * THE AVAILABLE BUFFER QUEUE. * 00024221 * RSTARTLN- LINKAGE IS MADE TO THE SUB1 SUBROUTINE TO GET THE * 00024421 * TERMINAL ADDRESS. LINKAGE IS MADE TO SUB2 SUBROUTINE TO OBTAIN * 00024621 * TERMINAL ADDRESS. A STARTLN INDICATOR OF 2 IS SET IN SW1. A * 00024821 * BRANCH IS TAKEN TO THE STOPLN ROUTINE TO USE COMMON CODE FOR * 00025021 * ERROR CHECKING. THE MESSAGE IS RETURNED TO THE TERMINAL IF THE * 00025221 * TERMINAL ENTRY IS NOT FOR A DESTINATION ENTRY, THE BUFFER DOES * 00025421 * NOT CONTAIN 22 USEABLE BYTES, THE DCB FOR THE LINE HAS NOT BEEN * 00025621 * OPENED, OR THE LINE NUMBER IS GREATER THAN THE NUMBER OF DEB * 00025821 * EXTENTS. IF LCBERCCW + 2 HAS THE 2 BIT ON, THE ROUTINE LOOPS * 00026021 * UNTIL THE PREVIOUS STARTLN OR STOPLN HAS COMPLETED. * 00026221 * TO START THE LINE, THE RECEIVE SCHEDULER IS RESTORED. IF THE* 00026421 * RECEIVE SCHEDULER WAS NOT REMOVED BY STOPLN (LCBCPRI=X'80'), THE * 00026621 * SCHEDULER IS RESTORED. IF THE SCHEDULER HAD BEEN REMOVED, THE * 00026821 * FLAG IN LCBCPRI IS TURNED OFF, AND THE RECEIVE SCHEDULER IS LINK-* 00027021 * ED INTO THE STCB CHAIN. LCBCPA + 32 IS SET TO X'FF' TO INDICATE * 00027221 * STARTLN. INITIAL CCW'S ARE SET UP IN THE CHANNEL PROGRAM AREA. * 00027421 * THE PROPER SAD CCW IS SET FOR 2702'S, NOP FOR DIAL LINES, AND * 00027621 * TYPE III ADAPTERS AND ENABLE FOR NONDIAL LINES. A FLAG IS SET IN* 00027821 * LCBERCCW + 2 TO INDICATE SIO. AN SVC 0 IS ISSUED TO START THE * 00028021 * LINE. UPON RETURN, THE ROUTINE LOOPS BACK IF THERE ARE MORE * 00028221 * LINES TO START. IF * 00028421 * STARTLN WAS SUCCESSFUL, THE 'SERVICE' BIT IS SET IN MSTATUS TO * 00028621 * RETURN BUFFER TO AVAILABLE BUFFER QUEUE. RETURN IS MADE TO THE * 00028821 * MACRO WHICH BRANCHES TO ENDRCV SECTION. * 00029021 * RINTREL- THE INTREL ROUTINE SETS AN INTREL SWITCH (SW1) TO * 00029221 * INDICATE INTREL, AND THEN EXECUTES THE SAME AS RSTOPLN. * 00029421 * RSTOPLN - LINKAGE IS MADE TO THE SUB1 SUBROUTINE TO OBTAIN * 00029621 * THE TERMINAL ADDRESS. IF THE TERMINAL ENTRY IS NOT A DESTINATION* 00029821 * ENTRY (A PROCESS OR DLIST ENTRY), THE MESSAGE IS RETURNED AND * 00030021 * THE FUNCTION IS NOT PERFORMED. THE SCAN POINTER IS BUMPED PAST * 00030221 * ALL BLANKS. IF THE BUFFER DOES NOT CONTAIN 22 USEABLE * 00030421 * BYTES, THE FUNCTION IS NOT PERFORMED. THE DCB OF THE LINE TO BE * 00030621 * STOPPED IS COMPARED TO THE DCB OF THE SOURCE TERMINAL IF THE * 00030821 * DCB'S ARE THE SAME AND 'ALL' HAS BEEN SPECIFIED OR THE LINE TO BE* 00031021 * STOPPED IS THE SOURCE LINE, THE FUNCTION IS NOT PERFORMED. IF THE* 00031221 * DCB'S ARE NOT EQUAL BUT THE DCB FOR THE SPECIFIED LINE IS NOT * 00031421 * OPEN, THE FUNCTION IS NOT PERFORMED. IF THE RLN IN THE QCB IS * 00031621 * GREATER THAN THE NUMBER OF EXTENTS IN THE DEB, THE FUNCTION IS * 00031821 * NOT PERFORMED. FOR INTREL, IF THE LINE IS ALREADY STOPPED * 00032021 * (LCBSTATE=0), THE FUNCTION IS NOT PERFORMED. FOR THE ABOVE * 00032221 * ERRORS, THE MESSAGE IS THEN ROUTED BACK TO THE SOURCE TERMINAL * 00032421 * AFTER ZEROING THE INTREL SWITCH (SW1). * 00032621 * IF FUNCTION CAN BE PERFORMED, MESSAGE SIZE IS SET TO 56 * 00032821 * BYTES. IF LCBERCCW + 2 HAS THE 2 BIT ON, THE ROUTINE LOOPS UNTIL* 00033021 * THE PREVIOUS STARTLN OR STOPLN HAS COMPLETED. (THIS BIT IS SET IN* 00033221 * STARTLN, STOPLN, OR OPEN BEFORE A SIO AND IS TURNED OFF WHEN THE * 00033421 * INTERRUPT IS RECEIVED.) IF STOPLN 'ALL' WAS SPECIFIED, AN INDEX * 00033621 * IS SET FOR THE NUMBER OF LINES IN THE LINE GROUP AN SVC QPOST * 00033821 * IS ISSUED TO POST THE STOP QCB TO ITSELF TO GAIN CONTROL IN * 00034021 * DISABLED CODE. * 00034221 * STOP1 SUBTASK STORES THE ADDRESS OF IECKOPAW IN THE BUFFER * 00034421 * RECALL/CLEANUP ADDRESS IN MODULE IGG019NG TO INSURE THE IECKOPAW * 00034621 * IS EXECUTED AT BUFFER CLEANUP TIME. THE SIZE OF THE LCB FROM THE* 00034821 * DCB IS SAVED AT HDSTRT + 21 AND THE LINE NUMBER AT HDSTRT FIELD * 00035021 * OF THE BUFFER. EACH LCB OF THE LINE GROUP IS PROCESSED THROUGH * 00035221 * A LOOP. IF THE LINE IS NOT ACTIVE, LCBSTATE=0, EXIT IS MADE TO * 00035421 * LOOP CONTROL. IF THE FIRST STCB IN THE LCB IS FOR AN OPCTL FOR * 00035621 * STOPLN, THE STOPLN REQUEST IS IGNORED AND EXIT IS MADE TO LOOP * 00035821 * CONTROL. * 00036021 * IF THE LINE IS FOR A NONDIAL 2740 (CHECKED BY SENSE CCW IN * 00036221 * LCBCPA+16), THE TP OP CODE OF THE SENSE CCW IS CHECKED FOR ZERO. * 00036421 * IF TP OP CODE IS NOT ZERO, INDICATING THAT THE SENSE HAS NOT BEEN* 00036621 * ISSUED AND THEREFORE THE LINE IS NOT BUSY, A HALT I/O IS NEEDED. * 00036821 * FOR A DIAL LINE, THE LINE IS CHECKED FOR ACTIVE TRANSMISSION BY * 00037021 * TESTING LCBINCAM FOR A 2. IF THE LINE IS IN ACTIVE TRANSMISSION,* 00037221 * A CHECK FOR A 2740 MUST BE MADE. IF A 2740 TERMINAL AND THE TP * 00037421 * OP CODE OF THE SENSE INDICATES THE LINE IS NOT BUSY, LCBINCAM IS * 00037621 * SET TO A 3 AND A HIO MUST BE ISSUED. IF DIAL LINE (NOT A 2740) * 00037821 * IS NOT IN ACTIVE TRANSMISSION, LCBINCAM IS SET TO A 3 AND A HIO * 00038021 * MUST BE ISSUED. BEFORE ISSUING THE HIO,THE ERP FLAGS ARE CLEARED* 00038221 * IN LCBFLAG1, AND HIO FLAG (X'48') FOR LINE END IS SET IN * 00038421 * LCBECBPT. THE ADDRESS OF THE HIO ROUTINE IS OBTAINED FROM THE * 00038621 * CVT. LINKAGE IS MADE TO THE HIO ROUTINE TO CLEAR THE ENABLE. * 00038821 * FOR EITHER DIAL OR NONDIAL LINES, THE BUFFER AREA IS CHECKED* 00039021 * FOR A STCB. IF THE STCB IS NOT IN THE BUFFER, THE ADDRESS OF * 00039221 * STOP2 QCB IS MOVED INTO LCBDESTQ TO CAUSE THE BUFFER TO BE POSTED* 00039421 * TO STOP2QCB FOR A DESTINATION QCB. EXIT IS MADE TO DISPATCH * 00039621 * RETURNS TO RSTOPLN ROUTINE. RSTOPLN RETURNS TO THE MACRO EXPAN- * 00039821 * SION WHICH BRANCHES TO ENDRCV SECTION. IF THE STCB IS IN THE * 00040021 * BUFFER (SET UP BY PREVIOUS PASS OF STOPLN ALL), A BRANCH IS * 00040221 * TAKEN TO THE SUBTASK OF STOP2 QCB. * 00040421 * STOP3- THIS ROUTINE GAINS CONTROL BY EITHER A BRANCH FROM * 00040621 * STOP1 OR STOP3 SUBTASK GAINING CONTROL WHEN A BUFFER IS POSTED TO* 00040821 * IT'S DESTINATION QUEUE (STOP2). THE ADDRESS OF THE LCB FOR THE * 00041021 * LINE TO BE STOPPED IS RETRIEVED FROM THE STOP2 QCB. THE COUNT * 00041221 * AND ADDRESS OF IECKLNCH IS STORED AT HDSTART + 16 IN THE BUFFER. * 00041421 * A STCB IS BUILT IN THE BUFFER USING A PRIORITY OF X'E4', X'6C' * 00041621 * AS THE BRANCH OFFSET, AND STCB ADDRESS IN THE FIRST WORD. A SUB- * 00041821 * TASK CONTAINING A LOAD AND BRANCH INSTRUCTIONS TO SUBTASK1 IS * 00042021 * MOVED INTO THE BUFFER. THIS STCB IS INSERTED AS THE FIRST STCB * 00042221 * IN THE LCB CHAIN OF STCB'S. IF THE LINE IS RECEIVING AND USES * 00042421 * THE AUTOPOLL FEATURE, X'FE' IS SET IN LCBCPA + 47 AND THE TIC AT * 00042621 * LCBCPA + 40 IS NOPED TO STOP THE LINE. * 00042821 * IF ENTRY IS FROM INTREL, THE INTREL SWITCH (SW1) IS CLEARED,* 00043021 * THE LCB INTREL SWITCH AT LCBDCBPT (HIGH ORDER BYTE) IS SET TO * 00043221 * ONE, AND THE COUNT INDEX IS ZEROED AT HDSTART+16 IN THE BUFFER. * 00043421 * FOR EITHER INTREL OR STOPLN, THE STATUS OF THE LINE IS CHECKED. * 00043621 * IF THE LINE IS FREE (LCBSTATE=1), THE LINE IS POSTED TO ITSELF * 00043821 * TO ACTIVATE THE STCB. IF THE LINE IS NOT FREE OR ON THE TIME * 00044021 * DELAY QUEUE, A BRANCH IS TAKEN TO DISPATCH TO RETURN TO RSTOPLN. * 00044221 * THIS PROCEDURE IS FOLLOWED FOR EACH LINE IN THE LINE GROUP * 00044421 * TO BE STOPPED. WHEN ALL LINES HAVE BEEN PROCESSED AND THE ENTRY * 00044621 * IS FOR STOPLN, THE BUFFER IS CHECKED FOR A FIRST TIME PASS. IF * 00044821 * THE STCB WAS NOT BUILT, THE BUFFER IS POSTED TO THE AVAILABLE * 00045021 * BUFFER QUEUE TO FREE THE BUFFER. IF THE STCB HAS BEEN USED, THE * 00045221 * SERVICE BIT IS SET IN THE BUFFER AND A BRANCH IS TAKEN TO DIS- * 00045421 * PATCH TO RETURN TO THE RSTOPLN ROUTINE TO FREE THE BUFFER. IF * 00045621 * THE SUBTASK WAS FOR INTREL, A BRANCH IS TAKEN TO DISPATCH * 00045821 * SUBTASK1. * 00046021 * SUBTASK1- THIS ROUTINE IS ENTERED WHEN THE STCB IS ACTIVATED* 00046221 * BY THE QCB BEING POSTED TO ITSELF BY CLEANUP OR STOP3. THE STCB * 00046421 * IS REMOVED FROM THE LCB CHAIN. LCBSTATE IS SET TO 0 TO INDICATE * 00046621 * THE LINE IS STOPPED. THE OFFSET AND STCB ADDRESS IN THE BUFFER * 00046821 * ARE ZEROED. * 00047021 * FOR DIAL LINES, A DISABLE CCW IS SET UP IN THE LCBERCCW AND * 00047221 * LCBSTATE IS SET TO POINT TO LCBERCCW. A FLAG OF X'FE' IS SET IN * 00047421 * LCBCPA + 32 TO INDICATE 'OPEN IDLE'. LCBINCAM IS SET TO 7 SO * 00047621 * THAT THE LINE WILL NOT BE SELECTED FOR SENDING. THE STCB CHAIN * 00047821 * OF THE LCB IS SEARCHED TO REMOVE THE SEND SCHEDULER. THE * 00048021 * TERMINAL OFFSET IN LCBTTIND IS ZEROED AND THE SEND SCHEDULER IS * 00048221 * PLACED IN THE DESTINATION QCB. IF QFAC IS LESS THAN QNAGSEG, * 00048421 * THERE ARE NO MESSAGES TO SEND SO THE SEARCH OF STCB'S IS CONTIN- * 00048621 * UED. * 00048821 * IF THERE ARE MESSAGES TO SEND AND ENTRY WAS FOR INTREL, A * 00049021 * DUMMY PRIMER ELEMENT MUST BE POSTED TO THE QCB SO ANOTHER LINE * 00049221 * MAY BE ASSIGNED TO THIS TERMINAL. THE PRIMER ELEMENT (DEFINED * 00049421 * IN THIS ROUTINE) IS PLACED AS THE NEXT ITEM AFTER THE LCB ON THE * 00049621 * READY QUEUE. A FLAG OF X'02' IS SET IN LCBERCCW+2 TO INDICATE * 00049821 * TO STARTLN THAT THE DISABLE HAS NOT COMPLETED. EXCP IS ISSUED TO * 00050021 * EXECUTE THE DISABLE TO HANG UP THE LINE. * 00050221 * IF THERE ARE MESSAGES TO SEND AND ENTRY WAS FOR STOPLN, THE * 00050421 * SEND SCHEDULER IS PUT IN THE DIAL-OUT CALL QUEUE FOR THAT LINE. * 00050621 * A FLAG OF X'02' IS SET IN LCBERCCW + 2 FOR THE STARTLN ROUTINE * 00050821 * AN EXCP IS ISSUED TO DISABLE THE LINE. * 00051021 * FOR DIAL OR NONDIAL LINES, IF ENTRY WAS FOR INTREL, A BRANCH* 00051221 * IS TAKEN TO SUBTASK2. IF ENTRY IS FOR STOPLN, THE LCB IS * 00051421 * REMOVED FROM THE READY QUEUE. THIS IS DONE SO THAT THE QKEY * 00051621 * FIELD (LCBSTATE) CAN REMAIN A ZERO. IF THERE ARE MORE LINES TO * 00051821 * STOP, THE ROUTINE LOOPS BACK TO FOLLOW THE SAME PROCEDURE TO * 00052021 * STOP THE NEXT LINE. WHEN THERE ARE NO MORE LINES TO STOP, THE * 00052221 * BUFFER IS POSTED TO THE AVAILABLE BUFFER QUEUE TO FREE THE * 00052421 * BUFFER. * 00052621 * SUBTASK2- THIS ROUTINE IS ENTERED FOR INTREL. THE LCB IS * 00052821 * REMOVED FROM THE READY QUEUE TO PRESERVE 'QKEY' (LCBSTATE = 0). * 00053021 * THE INTREL SWITCH (SW1) IS ZEROED. THE ADDRESS OF A STCB FOR * 00053221 * STCB2 IS PLACED IN THE BUFFER. IF ENTRY TO ROUTINE WAS FROM AN * 00053421 * I/O INTERRUPT, THE GETSVC1 QCB IS POSTED TO THE LPS CONTROL * 00053621 * ROUTINE TO ENTER UNDER SVC CONTROL. WHEN ENTRY IS FROM AN SVC * 00053821 * (X'FF' IN IOSSAVE), THE BUFFER IS MADE TO LOOK LIKE AN LCB BY * 00054021 * ZEROING LCBSCHAD AND SETTING LCBSTATE TO X'0C'. A 2 MINUTE * 00054221 * INTERVAL IS SET UP. A BRANCH IS TAKEN TO THE TIME DELAY ROUTINE * 00054421 * IN MODULE IGG019NG TO PLACE THE BUFFER IN THE TIME QUEUE. * 00054621 * STCB2- WHEN THE 2 MINUTE INTERVAL HAS ELAPSED, STCB2 SUBTASK* 00054821 * IS DISPATCHED. THE FIRST WORD OF THE BUFFER,WHICH IS ALREADY ON * 00055021 * THE READY QUEUE, IS SET TO THE AVAILABLE BUFFER QUEUE TO FREE * 00055221 * THE BUFFER. THE LCB IS POSTED TO ITSELF TO ACTIVATE THE LINE. * 00055421 * STOP5- WHEN THE OPERATOR AWARENESS ROUTINE HAS AN IRRECOVER-* 00055621 * ABLE ERROR ON A LINE THAT IS IN INTREL, IT GETS A BUFFER AND * 00055821 * CLEANUP POSTS THAT BUFFER TO STOP4 QCB FOR THE STOP5 SUBTASK. IF* 00056021 * THE LINE IS ACTIVE, THE INTREL SWITCH (SW1) IS SET TO 1 AND A * 00056221 * BRANCH IS TAKEN TO STOP3 SUBTASK TO STOP THE LINE. IF THE LINE * 00056421 * IS NOT ACTIVE A BRANCH IS TAKEN TO THE SUBTASK2 SUBTASK TO PUT * 00056621 * THE LINE IN THE TIME DELAY QUEUE. * 00056821 * SUB1- THIS SUBROUTINE IS USED TO OBTAIN THE TERMINAL TABLE * 00057021 * ENTRY ADDRESS AND BUFFER SIZE. THE ADDRESS OF IECKSCAN IS OB- * 00057221 * TAINED FROM LPSTART MACRO EXPANSION. THE SCAN ROUTINE IS USED TO* 00057421 * OBTAIN THE NEXT FIELD (TERMINAL NAME) IN A WORKAREA. THE SCAN * 00057621 * POINTER IS SET TO POINT TO THE BLANK FOLLOWING THE TERM NAME. * 00057821 * LINKAGE IS MADE TO IECKDRCT TO OBTAIN THE TERMINAL TABLE OFFSET * 00058021 * FOR THE TERMINAL ID. IF THE TERMINAL TABLE ENTRY WAS NOT FOUND, * 00058221 * THE MESSAGE IS REROUTED BACK TO THE SOURCE TERMINAL. THE BUFFER * 00058421 * SIZE IS OBTAINED BY A V-CON OF IECKBFSZ WHICH IS IN THE BUFFER * 00058621 * MACRO EXPANSION. AFTER ADDING 8 TO THE BUFFER SIZE FOR THE RECB,* 00058821 * THE SCAN POINTER OFFSET IS SUBTRACTED TO OBTAIN THE AMOUNT OF * 00059021 * SPACE LEFT IN BUFFER PASSED IN REGISTER 9. IN REGISTER 10 IS * 00059221 * PASSED THE ADDRESS OF THE TERMINAL TABLE ENTRY. * 00059421 * UNPAK- THIS SUBROUTINE IS USED BY COPYT, CHNGT, OR COPYC TO * 00059621 * UNPACK THE TERMINAL TABLE ENTRY OR COUNTERS INTO EBCDIC. THE DATA* 00059821 * IS UNPACKED INTO THE BUFFER 8 BYTES AT A TIME UNTIL THERE IS LESS* 00060021 * THAN 8 BYTES TO CONVERT. WHEN THIS OCCURS, THE NEXT 8 BYTES ARE * 00060221 * CONVERTED INTO A WORKAREA AND THEN THE CORRECT NUMBER IS MOVED * 00060421 * INTO THE BUFFER. THE BUFFER DATA IS TRANSLATED INTO EBCDIC. A * 00060621 * CHECK IS MADE TO SEE IF EOB AND EOT CHARACTERS CAN FIT INTO THE * 00060821 * BUFFER. IF NOT, EOB AND EOT ARE MOVED INTO THE LAST TWO CHAR- * 00061021 * ACTERS OF THE BUFFER; OTHERWISE, THEY ARE MOVED AFTER THE DATA. * 00061221 * THE ACTUAL SIZE OF THE DATA IS STORED IN MSEGSZE FIELD OF THE * 00061421 * BUFFER PREFIX. * 00061621 * * 00061821 * ENTRY POINTS- ENTRY MAY BE MADE TO THE FIRST BYTE OF THE MODULE * 00062021 * WHEN THE OPTCL MACRO INSTRUCTION IS EXECUTED. * 00062221 * ENTRY MAY BE MADE AT COPYCLR1 + 6 WHEN THE SUBTASK FOR * 00062421 * COPYCLR QCB IS DISPATCHED. * 00062621 * ENTRY MAY BE MADE AT CHANGE1 + 6 WHEN THE SUBTASK FOR * 00062821 * CHANGE QCB IS DISPATCHED. * 00063021 * ENTRY MAY BE MADE AT STOP1 + 6 WHEN THE SUBTASK FOR STOP QCB* 00063221 * IS DISPATCHED. * 00063421 * ENTRY MAYBE MADE AT STOP3 + 8 WHEN THE SUBTASK FOR STOP2 * 00063621 * QCB IS DISPATCHED. * 00063821 * ENTRY MAY BE MADE AT STCB2 + 6 WHEN 2 MINUTE INTERVAL HAS * 00064021 * EXPIRED. * 00064221 * ENTRY MAY BE MADE AT GETSVC2 + 8 WHEN THE SUBTASK FOR * 00064421 * GETSVC1 IS DISPATCHED. * 00064621 * ENTRY MAY BE MADE AT STOP5 + 8 WHEN THE SUBTASK FOR STOP4 * 00064821 * QCB IS DISPATCHED. * 00065021 * * 00065221 * INPUT- * 00065421 * REGISTER 1 - PARAMETER LIST FROM MACRO EXPANSION. * 00065621 * REGISTER 14 - RETURN ADDRESS OF MACRO EXPANSION. * 00065821 * REGISTER 15 - BASE OF IECKOCTL. * 00066021 * * 00066221 * OUTPUT = EXIT VIA BRANCH ON RETURN REGISTER * 00066421 * REGISTER 14 - ADDRESS OF OPCTL MACRO EXPANSION * 00066621 * EXIT VIA BRANCH TO POST * 00066821 * REGISTER 1 - ELEMENT ADDRESS * 00067021 * REGISTER 2 - QCB ADDRESS * 00067221 * REGISTER 12 - BASE FOR IECKQQ01 * 00067421 * BUFFER CONTAINING TERMINAL TABLE ENTRY * 00067621 * * 00067821 * EXTERNAL REFERENCES- * 00068021 * SVC QPOST * 00068221 * IECKSCAN * 00068421 * IECKDRCT * 00068621 * IECKBFSZ * 00068821 * * 00069021 * EXITS, NORMAL- A BRANCH TO DISPATCH OR POST IN IECKQQ01, OR * 00069221 * SVC QPOST, OR * 00069421 * A BRANCH ON REGISTER 14 TO RETURN TO OPCTL MACRO EXPANSION. * 00069621 * * 00069821 * EXITS, ERROR A BRANCH TO MACRO EXPANSION TO RETURN BUFFER IN ERROR * 00070021 * * 00070221 * TABLES AND WORK AREAS * 00070421 * TABLE- TO TRANSLATE HEX TO EBCDIC * 00070621 * TABLETRN - TO USE FOR TRANSLATION AND TRANSLATE AND TEST * 00070821 * AREA- TO UNPACK INTO. * 00071021 * * 00071221 * ATTRIBUTES- REUSABLE, ENABLED OR DISABLED, PROBLEM PROGRAM MODE OR * 00071421 * SUPERVISOR MODE, RESIDENT * 00071621 * * 00071821 * CHARACTER CODE DEPENDENCY - NONE * 00072021 * * 00072221 * NOTES - NONE * 00072421 *********************************************************************** 00072621 TITLE 'IECKOCTL - OPERATOR CONTROL ROUTINE - OS QTAM III' 00100013 IECKOCTL START 00200013 * 451000-461000,475700,476100-477300,487200-487600,507520-507580, M1604 00208020 * 509400-510200,512000,514300-514600,523010-5123650 M1604 00216020 * 688500 A39103 00224020 * 773100-774100 A39114 00232020 * 767000 00PS 00240020 *A523035 A41219 00245021 *A000002-000726 S21016 00252021 *A523101-523105,C523110,A628100-628500,C629000, A52229 00254021 *A711100-711500,C712000,A817500 A52229 00256021 *1210538000 5645 00260016 *1210564200-565600 6646 00270016 *1210583500-584500 5044 00280016 *2540569000,570200-572800 00PS 00290017 * 507530-507560 M3144 00290318 * 627000,633200-634200 M3170 00290618 * 682200,682904-682914 M3147 00290918 * 682685-682693,682804-682894 M00PS 00291218 * 682734-682794 M3167 00291518 *1200089500,475200-475800,50710-507700 21213 00292018 *1200563200-563600,567000,569700,571000,572900-575800 22760 00294018 *1200681500-682500,823600 22760 00296018 *1990567000,584580-584900 22438 00297018 *1990571000 00PS 00298018 *1990574800,682510-682780 22760 00299018 * 438200-439700,682628-682756,703400-703800 25340 00299218 * 508300-508600 00PS 00299418 * 584950 22438 00299618 * 417200-417600,873000 A27860 00299819 R0 EQU 0 WORK REGISTER 00300013 R1 EQU 1 POINTER TO PASSED PARAMETER LIST 00400013 KREG EQU 2 WORKWORD ADDRESS FOR IECKSCAN 00500013 RREG2 EQU 3 LINK REGISTER FOR IECKSCAN 00600013 LCBREG EQU 4 POINTER TO LCB 00700013 SPREG EQU 5 SCAN POINTER FOR MESSAGE HEADER 00800013 MSREG EQU 6 ADDRESS OF BUFFER 00900013 LGREG EQU 7 POINTER TO LPSTART 01000013 TERMREG EQU 8 BASE FOR TERMINAL TABLE ENTRY 01100013 BREG EQU 8 TEMPORARY BASE FOR ERROR COUNTERS 01200013 WREG1 EQU 9 WORK REGISTER 01300013 WREG3 EQU 10 WORK REGISTER 01400013 EOSREG EQU 11 END OF SEGMENT ADDRESS FOR IECKSCAN 01500013 WREG2 EQU 12 WORK REGISTER -QCB BASE REGISTER 01600013 NGREG EQU 13 POINTER TO IGG019NG 01700013 RREG1 EQU 14 RETURN REGISTER TO MACRO 01800013 SREG EQU 15 BASE FOR THIS ROUTINE 01900013 ENTRY IECKNTRL 02000013 USING IECKTERM,TERMREG 02100013 USING QBLOCK,WREG2 02200013 USING LCB,LCBREG 02300013 USING IECKPREF,MSREG 02400013 USING *,SREG 02500013 LR R0,SREG SAVE BASE REGISTER 02600013 LA R1,4(R1) BUMP LIST ADDRESS TO DATA USED 02700013 ST RREG1,SAVEAREA SAVE RETURN REGISTER TO MACRO 02800013 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER 02900013 LA RREG1,VAR INDICATE VARIABLE LENGTH TO SCAN 03000013 L SREG,4(LGREG) GET ADDRESS OF SCAN ROUTINE 03100013 BALR RREG2,SREG LINK TO SCAN ROUTINE FOR MESSAGE ID 03200013 LR SREG,R0 RESTORE BASE REGISTER 03300013 LTR WREG1,WREG1 TEST FOR HEADER ERROR IN SCAN 03400013 BE RETURN1 EXIT TO NEXT LPS IF ERROR 03500013 OC 0(8,KREG),MASK ENSURE UPPER CASE IN WORKWORD 03600013 MVC WK1(8),MASK BLANK OUT WORKAREA 03700013 IC WREG2,0(R1) GET LENGTH OF MESSAGE NAME FROM LIST 03800013 BCTR WREG2,0 DECREMENT FOR EXECUTE 03900013 TM 1(R1),X'03' ALTERNATE AND INTERCEPT SPECIFIED 04000013 BO HAVE2 BRANCH IF YES 04100013 TM 1(R1),X'02' INTERCEPT ONLY SPECIFIED 04200013 BO HAVE1 BRANCH IF YES 04300013 TM 1(R1),X'01' ALTERNATE ONLY SPECIFIED 04400013 BO HAVE1 BRANCH IF YES 04500013 EX WREG2,MOVA CAUSE MESSAGE NAME TO GO TO WORKAREA 04600013 B COMPARE GO TO COMPARE 04700013 HAVE1 EX WREG2,MOVB CAUSE MESSAGE NAME TO GO TO WORKAREA 04800013 B COMPARE GO TO COMPARE 04900013 HAVE2 EX WREG2,MOVC CAUSE MESSAGE NAME TO GO TO WORKAREA 05000013 COMPARE CLC 0(8,KREG),WK1 IS THIS A CONTROL MESSAGE 05100013 BE CTLMSG BRANCH IF YES 05200013 RETURN NI LCBERRST,251 RESET END OF SEGMENT SCAN ERROR 05300013 RETURN1 L RREG1,SAVEAREA RESTORE LINKAGE TO LPS 05400013 L SPREG,SAVEAREA+4 RESTORE SAVED SCAN POINTER 05500013 B 4(RREG1) AND RETURN TO NEXT LPS INSTRUCTION 05600013 SPACE 05700013 CTLMSG ST NGREG,SAVE+4 SAVE ADDRESS OF IGG019NG 05800013 MVI SW1,0 RESET STOPLN SWITCH M1604 05850000 TM MSTATUS,2 IS THIS A SINGLE SEGMENT MESSAGE 05900013 BZ ROUTE BRANCH IF NO TO RETURN TO SOURCE 06000013 ST SPREG,SAVEAREA+4 SAVE THE SCAN POINTER 06100013 L SREG,4(LGREG) GET ADDRESS OF SCAN ROUTINE 06200013 BALR RREG2,SREG LINK TO SCAN ROUTINE - MESSAGE TYPE 06300013 LR SREG,R0 RESTORE BASE REGISTER 06400013 OC 0(8,KREG),MASK ENSURE UPPER CASE IN WORKWORD 06500013 ST TERMREG,SAVEAREA+8 SAVE TERMREG FOR LATER USAGE AS LINK 06600013 CLC COPYC,0(KREG) COPY ERROR COUNTERS SPECIFIED 06700013 BE RCOPYC BRANCH IF YES 06800013 CLC COPYT,0(KREG) COPY TERMINAL TABLE ENTRY SPECIFIED 06900013 BE RCOPYT BRANCH IF YES 07000013 CLC CHNGT,0(KREG) CHANGE TERMINAL TABLE SPECIFIED 07100013 BE RCHNGT BRANCH IF YES 07200013 CLC INTERCPT,0(KREG) INTERCEPT MESSAGES SPECIFIED 07300013 BE RINTRCPT BRANCH IF YES 07400013 CLC INTREL,0(KREG) INTERCEPT-RELEASE SPECIFIED 07500013 BE RINTREL BRANCH IF YES 07600013 CLC RELEASEM,0(KREG) RELEASE MESSAGES SPECIFIED 07700013 BE RRELEASM BRANCH IF YES 07800013 CLC STOPLN,0(KREG) STOP LINE SPECIFIED 07900013 BE RSTOPLN BRANCH IF YES 08000013 CLC STARTLN,0(KREG) START LINE SPECIFIED 08100013 BE RSTARTLN BRANCH IF YES 08200013 CLC SWITCH,0(KREG) SWITCH PRIMARY TERMINAL SPECIFIED 08300013 BE RSWITCH BRANCH IF YES 08400013 ROUTE MVC TTDKEY(2),TTSKEY INSERT OFFSET TO SOURCE TERMINAL IN 08500013 * DESTINATION FIELD OF HEADER PREFIX 08600013 L TERMREG,=V(TERMTBL) GET ADDRESS OF TERMINAL TABLE 08700013 AH TERMREG,TTSKEY ACCESS CONTROL TERMINAL ENTRY 08800013 MVC LCBDESTQ(3),TQCBADDR PUT QCB FOR SOURCE TERMINAL IN LCB 08900013 MVI SW1,0 RESTORE SWITCH TO 0 21213 08950018 RETURN2 L RREG1,SAVEAREA RESTORE LINKAGE TO MACRO 09000013 L SPREG,SAVEAREA+4 RESTORE SAVED SCAN POINTER 09100013 L NGREG,SAVE+4 RELOAD ADDRESS OF IGG019NG 09200013 L TERMREG,SAVEAREA+8 RELOAD TERMINAL BASE FOR CANCEL 00PS 09250015 BR RREG1 EXIT TO MACRO TO GO TO ENDRCV 09300013 REENTER OI MSTATUS,X'10' SET SERVICED BIT IN PREFIX 09400013 B RETURN2 EXIT TO RETURN BUFFER 09500013 SPACE 2 09600013 MOVA MVC WK1(1),4(R1) MOVE WHEN NEITHER ALTERNATE OR ITCP 09700013 MOVB MVC WK1(1),6(R1) MOVE NAME WHEN ALTERNATE OR INTERCPT 09800013 MOVC MVC WK1(1),8(R1) MOVE WHEN BOTH ALTERNATE AND INTERCEPT 09900013 SPACE 2 10000013 SUB1 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER 10100013 L SREG,4(LGREG) GET ADDRESS OF SCAN ROUTINE 10200013 BALR RREG2,SREG LINK TO SCAN ROUTINE FOR TERMNAME 10300013 LR SREG,R0 RESTORE BASE REGISTER 10400013 CH WREG1,H8 WAS TERMNAME MAXIMUM SIZE OF 8 BYTES 10500013 BNE *+16 BRANCH IF NO - SPREG POINTS TO BLANK 10600013 CLI 1(SPREG),C' ' ELSE SPREG POINTS TO LAST CHARACTER 10700013 * IN TERMNAME - IS NEXT BLANK 10800013 BNE *+8 BRANCH IF NO-BLANK DELIMITER ABSENT 10900013 LA SPREG,1(SPREG) ADJUST SPREG TO POINT TO BLANK 11000013 L SREG,=V(IECKDRCT) GET ADDRESS OF LOOKUP ROUTINE 11100013 LR RREG2,R1 SAVE POINTER TO MACRO PARAMETER LIST 11200013 BALR RREG1,SREG LINK TO LOOKUP ROUTINE FOR TERMID 11300013 LR SREG,R0 RESTORE BASE REGISTER 11400013 LR R0,R1 SAVE TERMTBL POINTER FROM LOOKUP 11500013 LR R1,RREG2 RESTORE PARAMETER LIST POINTER 11600013 TM LCBERRST,X'80' WAS TERMINAL ENTRY FOUND IN TERMTBL 11700013 BO ROUTE BRANCH IF NO TO RETURN TO SOURCE 11800013 L RREG2,=V(IECKBFSZ) GET ADDRESS OF BUFFER SIZE LOCATION 11900013 SR WREG1,WREG1 CLEAR WORK REGISTER 12000013 LH WREG1,0(RREG2) GET BUFFER SIZE IN WORK REGISTER 12100013 LA WREG1,MSEGSZE-1(WREG1) GET ADDRESS OF LAST CHARACTER IN 12200013 * THE BUFFER 12300013 LR RREG2,WREG1 SAVE ADDRESS OF LAST CHARACTER 12400013 SR WREG1,SPREG GET BUFFER REMAINING FOLLOWING THE 12500013 * TERMNAME ENTRY IN OPCTL MESSAGE 12600013 AR WREG3,R0 GET ADDRESS OF TERMTBL ENTRY 12700013 BR TERMREG RETURN TO CALLING SUBROUTINE 12800013 SPACE 2 12900013 UNPAK CH WREG1,H14 WREG1 HAS CHARACTER COUNT 13000013 BNH LASTSECT BRANCH IF LESS THAN 8 TO BE UNPACKED 13100013 UNPK 1(15,SPREG),4(8,WREG3) UNPACK 8 BYTES FROM TERMTBL ENTRY 13200013 * (OR ERROR COUNTERS LOCATION) 13300013 * INTO BUFFER STARTING WITH 13400013 * TSEQUIN AND 1ST CHARACTER IN 13500013 * BUFFER FOLLOWING SCAN POINTER 13600013 LA SPREG,14(SPREG) BUMP SCAN POINTER TO OVERLAY THE 13700013 * RIGHTMOST BYTE PREVIOUSLY 13800013 * UNPACKED IN BUFFER 13900013 LA WREG3,7(WREG3) BUMP TERMTBL ENTRY OR ERROR COUNTER 14000013 * POINTER 7 BYTES 14100013 SH WREG1,H14 ADJUST COUNT FOR THOSE UNPACKED 14200013 B UNPAK AND RELOOP 14300013 SPACE 14400013 LASTSECT UNPK AREA(15),4(8,WREG3) UNPACK 8 MORE BYTES FROM TERMTBL 14500013 * ENTRY OR ERROR COUNTERS TO 14600013 * WORKAREA (NONE OR A PORTION OF 14700013 * THE EIGHT BYTES MAY BE USEFUL 14800013 * INFORMATION) 14900013 BCTR WREG1,0 DECREMENT COUNT FOR EXECUTE MOVE 15000013 EX WREG1,MOV1 CAUSE WORKAREA TO BE MOVED TO BUFFER 15100013 LA SPREG,3(SPREG,WREG1) GET ADDRESS OF LAST BYTE MOVED+2 15200013 L WREG1,SAVEAREA+4 RETRIEVE ADDRESS OF 1ST BYTE UNPAKED 15300013 BCTR KREG,0 DECREMENT FOR EXECUTE 15400013 EX KREG,TRANS EXECUTE TRANSLATE 15500013 CR SPREG,RREG2 IS LAST CHARACTER MOVED WITHIN 2 15600013 * BYTES OF THE END OF THE BUFFER 15700013 BNL ENDBUF BRANCH IF YES 15800013 SPACE 15900013 LR RREG2,SPREG SET UP TO MOVE EOB-EOT INTO BUFFER 16000013 * FOLLOWING LAST CHARACTER THAT 16100013 * WAS UNPACKED 16200013 ENDBUF BCTR RREG2,0 DECREMENT FOR 2 BYTE MOVE 16300013 MVC 0(2,RREG2),EOBEOT MOVE IN EOB-EOT INTO EITHER 16400013 * 1) LAST 2 BYTES OF BUFFER OR 16500013 * 2) FOLLOWING LAST CHARACTER 16600013 * UNPACKED INTO BUFFER 16700013 LR SPREG,RREG2 POINT SPREG TO THE EOB 16800013 LA WREG1,7(MSREG) GET BUFFER PLUS 7 16900013 SR RREG2,WREG1 GET SEGMENT SIZE TO BE WRITTEN 17000013 STH RREG2,MSEGSZE RESET SEGMENT SIZE IN PREFIX 17100013 BR WREG2 RETURN TO RCOPYT, RCOPYC OR RCHNGT 17200013 SPACE 2 17300013 MOV1 MVC 1(1,SPREG),AREA MOVE WORKAREA CHARACTERS TO BUFFER 17400013 TRANS TR 1(1,WREG1),TABLE-240 TRANSLATE BUFFER TO EBCDIC 17500013 SPACE 2 17600013 RCOPYT BAL TERMREG,SUB1 LINK TO GET TERMINAL ADDRESS IN 17700013 * TERMTBL AND BUFFER SIZE INFO 17800013 L TERMREG,SAVEAREA+8 RESTORE TERMREG 17900013 IC WREG2,0(WREG3) ACCESS SIZE OF TERMTBL ENTRY 18000013 SH WREG2,H4 ADJUST TNTRYSZE FOR PART NOT COPIED 18100013 SLL WREG2,1 DOUBLE TERMTBL ENTRY SIZE 18200013 CR WREG1,WREG2 COMPARE SIZE OF REMAINING BUFFER 18300013 * AREA WITH TERMTBL ENTRY SIZE 18400013 * TO BE COPIED 18500013 BNH *+6 BRANCH TO USE BUFFER SIZE IF LO/EQ 18600013 LR WREG1,WREG2 ELSE USE TERMTBL ENTRY SIZE 18700013 LR KREG,WREG1 SAVE COUNT FOR TRANSLATE 18800013 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER FOR TRANSLATE 18900013 BAL WREG2,UNPAK LINK TO UNPACK-TRANSLATE INTO BUFFER 19000013 BCTR SPREG,0 ADJUST TO LAST BYTE MOVED 19100013 ST SPREG,SAVEAREA+4 STORE FOR INSERTIONS IN SEND LPS 19200013 B ROUTE GO SEND COPIED ENTRY TO SOURCE 19300013 SPACE 2 19400013 RCOPYC BAL TERMREG,SUB1 LINK TO ACCESS TERMINAL ADDRESS IN 19500013 * TERMTBL AND BUFFER SIZE INFO 19600013 L WREG2,0(WREG3) GET QCB ADDRESS FROM TERMTBL ENTRY 19700013 CLI 8(WREG2),X'68' IS THIS A TERMINAL ENTRY 19800013 BNE ROUTE BRANCH IF NO TO RETURN MESSAGE TO 19900013 * SOURCE (A LIST OR PROCESS ENTRY 20000013 * HAS BEEN ACCESSED) 20100013 SR WREG3,WREG3 CLEAR FOR INSERTION OF RLN 20200013 IC WREG3,QRLN GET RELATIVE LINE NUMBER FROM QCB 20300013 L BREG,QDCB-1 GET DCB ADDRESS FROM QCB 20400013 TM DCBOFLGS(BREG),X'10' HAS THE LINE BEEN OPENED 20500013 BNO ROUTE BRANCH IF NO TO RETURN MESSAGE 20600013 SR R1,R1 PARAMETER LIST POINTER NOT NEEDED 20700013 IC R1,DCBEIOBX(BREG) GET THE SIZE OF AN LCB-IOB 20800013 LA WREG3,1(WREG3) BUMP LINE NUMBER TO NEXT LCB 20900013 MR R0,WREG3 LCB-IOB SIZE TIMES LINE NUMBER 21000013 L BREG,DCBLCBAD(BREG) GET THE START OF THE LCB'S 21100013 LA BREG,0(BREG,R1) ADDRESS OF NEXT LCB 21200013 SH BREG,H16 GET ADDRESS OF CUMULATIVE 21300013 * TRANSMISSION COUNTER IN LCB 21400013 * INDICATED BY THE LINE NUMBER 21500013 LA R1,COPYCLR GET ADDRESS OF COPY QCB 21600013 LR KREG,R1 SET UP FOR POSTING 21700013 STM 14,11,SAVE+12 SAVE REGISTERS DESTROYED BY IECKQQ01 21800013 SVC QPOST POST COPY QCB TO ITSELF SO THAT THE 21900013 * COUNTERS CAN BE MANIPULATED IN 22000013 * DISABLED MODE 22100013 L TERMREG,SAVEAREA+8 RELOAD SAVED REGISTER 22200013 B ROUTE GO SEND COPIED COUNTERS TO SOURCE 22300013 SPACE 2 22400013 * COPY AND CLEAR ERROR COUNTERS STCB COMBINED WITH QCB 22500013 * PROGRAM ENTRY--ENTERS THE ROUTINE AT COPYCLR1+6 22600013 USING COPYCLR,WREG1 PROVIDE SAVE AREA ADDRESSABILITY 22700013 COPYCLR DC A(COPYCLR) 22800013 DC X'FE' 22900013 DC AL3(COPYCLR) 23000013 COPYCLR1 DC X'02' 23100013 DC AL3(COPYCLR1) 23200013 DC X'0000' 23300013 SPACE 23400013 USING IECKLERB,BREG TEMPORARY BASE FOR DSECT 23500013 LM 14,11,SAVE+12 RESTORE REGISTERS SAVED BEFORE QPOST 23600013 DROP WREG1 SAVE AREA ACCESSED 23700013 L WREG3,LERACTR GET CUMULATIVE TRANSMISSIONS COUNTER 23800013 SR R1,R1 CLEAR WORKING REGISTER 23900013 IC R1,LERTHTR GET TRANSMISSION THRESHOLD COUNTER 24000013 ALR WREG3,R1 ADD THRESHOLD TO CUMULATIVE 24100013 ST WREG3,LERACTR STORE TOTAL IN CUMULATIVE COUNTER 24200013 LH WREG3,LERACDC GET CUMULATIVE DATA CHECK COUNTER 24300013 IC R1,LERTHDC GET DATA CHECK THRESHOLD COUNTER 24400013 ALR WREG3,R1 ADD THRESHOLD TO CUMULATIVE 24500013 STH WREG3,LERACDC STORE TOTAL IN CUMULATIVE COUNTER 24600013 LH WREG3,LERACIR GET CUMULATIVE INTERVENTION REQUIRED 24700013 IC R1,LERTHIR GET INTERVENTION REQUIRED THRESHOLD 24800013 ALR WREG3,R1 ADD THRESHOLD TO CUMULATIVE 24900013 STH WREG3,LERACIR STORE TOTAL IN CUMULATIVE COUNTER 25000013 LH WREG3,LERACTO GET CUMULATIVE TIME OUT COUNTER 25100013 IC R1,LERTHTO GET TIME OUT THRESHOLD COUNTER 25200013 ALR WREG3,R1 ADD THRESHOLD TO CUMULATIVE 25300013 STH WREG3,LERACTO STORE TOTAL IN CUMULATIVE COUNTER 25400013 ST WREG2,QQPTR SAVE BASE FOR IECKQQ01 25500013 LA WREG2,20 DOUBLE SIZE OF COUNTER AREA 25600013 CR WREG1,WREG2 COMPARE SIZE OF REMAINING BUFFER 25700013 * AREA WITH COUNTER AREA TO BE 25800013 * COPIED 25900013 BNH *+6 BRANCH TO USE BUFFER SIZE IF LESS/EQ 26000013 LR WREG1,WREG2 OTHERWISE USE COUNTERS SIZE 26100013 LR KREG,WREG1 SAVE COUNT FOR TRANSLATE 26200013 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER FOR TRANSLATE 26300013 LR WREG3,BREG GET COUNTER ADDRESS 26400013 SH WREG3,H4 SUBTRACT 4 FOR INTERFACE TO UNPAK 26500013 BAL WREG2,UNPAK LINK TO UNPACK-TRANSLATE INTO BUFFER 26600013 XC LERTHTR(4),LERTHTR CLEAR THRESHOLD COUNTERS 26700013 L WREG2,QQPTR GET ADDRESS OF IECKQQ01 26800013 BCTR SPREG,0 ADJUST TO LAST BYTE MOVED 26900013 ST SPREG,SAVEAREA+4 STORE FOR INSERTIONS IN SEND LPS 27000013 B DISPATCH-2(WREG2) GO DISPATCH NEXT ITEM ON READY 27100013 * (RETURNS TO RCOPYC ROUTINE) 27200013 USING IECKTERM,TERMREG REESTABLISH TERMTBL BASE 27300013 SPACE 2 27400013 RSWITCH TM 1(R1),X'01' WAS ALTERNATE TERMINAL SPECIFIED 27500013 BC 8,ROUTE BRANCH IF NO TO RETURN MESSAGE 27600013 XC 4(2,R1),2(R1) ELSE SWITCH OFFSETS TO ALTERNATE 27700013 XC 2(2,R1),4(R1) AND PRIMARY TERMINALS IN THE 27800013 XC 4(2,R1),2(R1) MACRO PARAMETER LIST 27900013 B REENTER BRANCH TO 'LOSE' BUFFER 28000013 SPACE 2 28100013 RCHNGT BAL TERMREG,SUB1 LINK TO GET TERMINAL ADDRESS IN 28200013 * TERMTBL AND BUFFER SIZE INFO 28300013 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER 28400013 CHKBLK CLI 1(SPREG),C' ' CHECK FOR BLANK FOLLOWING DELIMITER 28500013 BNE NOBLANK BRANCH IF NOT BLANK - NO ADJUSTMENT 28600013 LA SPREG,1(SPREG) ELSE BUMP SCAN POINTER - SKIP BLANKS 28700013 BCT WREG1,CHKBLK DECREMENT BUFFER SIZE REMAINING 28800013 B RETURN1 RETURN TO LPS WHEN BUFFER BLANK 28900013 NOBLANK BCTR WREG1,0 DECREMENT FOR EXECUTE 29000013 SR R1,R1 CLEAR FOR ADDRESS LOAD IN TRT 29100013 EX WREG1,TRANS1 TRANSLATE FROM 1ST CHARACTER AFTER 29200013 * TERMNAME IN BUFFER (EXCLUDING 29300013 * LEADING BLANKS) TO BUFFER END 29400013 EX WREG1,TRANSTST SCAN BUFFER FOR DELIMITER - BLANK, 29500013 * EOB, EOT OR INVALID CHARACTER 29600013 BZ INVALID RETURN MESSAGE IF NOT FOUND 29700013 STC KREG,WK1+7 STORE RETURNED CHARACTER TO COMPARE 29800013 CLI WK1+7,X'07' WAS RETURNED CHARACTER A VALID 29900013 * DELIMITER (BLANK, EOB OR EOT) 30000013 BE VALID BRANCH IF VALID 30100013 INVALID L SPREG,SAVEAREA+4 ELSE RELOAD END OF TERMNAME POINTER 30200013 LTR WREG1,WREG1 CAN EOB-EOT BE INSERTED INTO BUFFER 30300013 BH *+14 BRANCH IF YES 30400013 MVC 1(1,SPREG),EOBEOT+1 ELSE PUT EOT IN BUFFER 30500013 B ROUTE AND RETURN MESSAGE 30600013 LA RREG2,2(SPREG) SET UP INTERFACE TO COMMON CODE 30700013 BAL WREG2,ENDBUF LINK TO PUT EOB-EOT INTO BUFFER 30800013 * FOLLOWING TERMNAME 30900013 B ROUTE RETURN MESSAGE (THRU TERMNAME) TO 31000013 * SOURCE IF INVALID CHARACTER 31100013 VALID BCTR R1,0 GET POINTER TO DELIMITER-1 31200013 SR R1,SPREG GET LENGTH OF DATA TO BE INSERTED 31300013 BNH REENTER EXIT TO 'LOSE' BUFFER WHEN NO DATA 31400013 * IS TO BE MOVED 31500013 LA TERMREG,1 INSERT A 1 INTO TERMREG TO TEST ODD 31600013 NR TERMREG,R1 TEST FOR ODD NUMBER OF CHARACTERS 31700013 BNZ INVALID BRANCH IF ODD NUMBER SPECIFIED 31800013 IC WREG2,0(WREG3) ACCESS SIZE OF TERMTBL ENTRY 31900013 SH WREG2,H4 ADJUST TNTRYSZE FOR PART NOT CHANGED 32000013 SRL R1,1 DIVIDE DATA TO BE INSERTED BY TWO 32100013 CR R1,WREG2 WILL BUFFER DATA FIT INTO TERMTBL 32200013 BH INVALID BRANCH IF NO TO RETURN MESSAGE 32300013 LR BREG,R1 USE BUFFER LENGTH FOR MOVE 32400013 LA R1,CHANGE GET ADDRESS OF CHANGE QCB 32500013 LR KREG,R1 SET UP FOR POSTING 32600013 STM 14,11,SAVE+12 SAVE REGISTERS 32700013 SVC QPOST POST CHANGE QCB TO ITSELF SO THAT 32800013 * THE TERMINAL TABLE ENTRY CAN BE 32900013 * CHANGED WHILE DISABLED 33000013 B REENTER BRANCH TO 'LOSE' BUFFER 33100013 SPACE 2 33200013 * CHANGE TERMINAL TABLE STCB COMBINED WITH QCB 33300013 * PROGRAM ENTRY--ENTERS THE ROUTINE AT CHANGE1+6 33400013 USING CHANGE,WREG1 PROVIDE SAVE AREA ADDRESSABILITY 33500013 CHANGE DC A(CHANGE) 33600013 DC X'FE' 33700013 DC AL3(CHANGE) 33800013 CHANGE1 DC X'02' 33900013 DC AL3(CHANGE1) 34000013 DC X'0000' 34100013 SPACE 1 34200013 LM 14,11,SAVE+12 RESTORE REGISTERS SAVED BEFORE QPOST 34300013 DROP WREG1 SAVE AREA ACCESSED 34400013 ST WREG2,QQPTR SAVE BASE FOR IECKQQ01 34500013 L WREG2,0(WREG3) ACCESS QCB ADDRESS FOR TERMINAL 34600013 * ENTRY TO BE CHANGED 34700013 CLI 8(WREG2),X'68' IS THIS A DESTINATION QUEUE QCB 34800013 BNE INACTIVE BRANCH IF NOT TERMINAL 34900013 SR KREG,KREG CLEAR WORKING REGISTER 35000013 IC KREG,QRLN-QBLOCK(WREG2) GET RELATIVE LINE NUMBER OF LCB 35100013 L RREG2,QDCB-1-QBLOCK(WREG2) GET DCB ADDRESS FROM QCB 35200013 TM DCBOFLGS(RREG2),X'10' HAS THE LINE BEEN OPENED 35300013 BNO INACTIVE BRANCH IF NO - NO LCB AVAILABLE 35400013 SR R1,R1 CLEAR WORKING REGISTER 35500013 IC R1,DCBEIOBX(RREG2) GET THE SIZE OF AN LCB-IOB 35600013 MR R0,KREG LCB-IOB SIZE TIMES LINE NUMBER 35700013 L RREG2,DCBLCBAD(RREG2) GET THE START OF THE LCB'S 35800013 LA RREG2,0(RREG2,R1) GET LCB ADDRESS 35900013 CLI LCBSTATE-LCB(RREG2),0 IS THE LINE ACTIVE 36000013 * IF STOPLINE HAS BEEN EXECUTED THEN THE SEQUENCE NUMBERS WILL NOT BE 36100013 * INCREMENTING AND THE TERMINAL TABLE ENTRY CAN BE MODIFIED BEGINNING 36200013 * WITH THE SEQUENCE NUMBERS - OTHERWISE THE SEQUENCE NUMBERS WILL 36300013 * REMAIN INTACT 36400013 BE INACTIVE BRANCH IF LINE NOT ACTIVE 36500013 AH SPREG,H8 BUMP SCAN POINTER PAST SEQUENCE NOS. 36600013 AH WREG3,H4 ADJUST TERMTBL ENTRY POINTER 36700013 SH BREG,H4 ADJUST COUNT TO BE MOVED 36800013 BNH EXIT EXIT IF NO MORE TO MOVE 36900013 INACTIVE AH WREG3,H4 BUMP TERMTBL ENTRY POINTER PAST SIZE 37000013 * AND QCB ADDRESS (ADJUSTS PAST 37100013 * SEQUENCE NUMBERS IF LINE HAS 37200013 * NOT BEEN STOPPED) 37300013 MVC AREA(8),MASK BLANK OUT AREA TO BE USED 37400013 PACK PACK AREA(8),1(15,SPREG) PACK FROM BUFFER INTO WORKAREA 37500013 CH BREG,H7 BREG HAS CHARACTER COUNT 37600013 BNH ENDPACK BRANCH IF LESS THAN 16 TO BE PACKED 37700013 MVC 0(7,WREG3),AREA MOVE 7 CHARACTERS TO TERMTBL ENTRY 37800013 AH WREG3,H7 BUMP TERMTBL POINTER BY 7 BYTES 37900013 AH SPREG,H14 BUMP BUFFER POINTER BY 14 BYTES 38000013 SH BREG,H7 DECREMENT CHARACTER COUNT BY 7 BYTES 38100013 B PACK RELOOP TO PACK AGAIN 38200013 SPACE 1 38300013 ENDPACK BCTR BREG,0 DECREMENT FOR EXECUTE 38400013 EX BREG,MOV2 CAUSE LAST CHANGE TO BE MADE 38500013 EXIT L WREG2,QQPTR RESTORE ADDRESS OF IECKQQ01 38600013 B DISPATCH-2(WREG2) GO DISPATCH NEXT ITEM ON READY 38700013 * (RETURNS TO RCHNGT ROUTINE) 38800013 SPACE 2 38900013 MOV2 MVC 0(1,WREG3),AREA MOVE LAST BYTES TO TERMTBL ENTRY 39000013 TRANS1 TR 1(1,SPREG),TABLETRN TRANSLATE BUFFER FOR CHNGT 39100013 TRANSTST TRT 1(1,SPREG),TABLETST SCAN FOR SPECIAL CHARACTER IN BUFFER 39200013 SPACE 2 39300013 * WHEN THE INTERCEPT FUNCTION IS TO BE USED BY OPERATOR CONTROL, THE 39400013 * INTERCPT MACRO MUST BE SPECIFIED IN THE ENDSEND SECTION OF LPS WITH 39500013 * AN ERROR MASK OF X'4000'. THE ACTIVATE ROUTINE IN IGG019NG WILL 39600013 * DETECT THE ABSENCE OF THE SEND BIT IN THE TERMTBL ENTRY AND SET THE 39700013 * TERMINAL INOPERATIVE BIT IN LCBERRST BEFORE EXITING TO LPS WHEN 39800013 * MESSAGES ARE TO BE SENT TO THE DESTINATION TERMINAL. THE X'4000' 39900013 * ALLOWS THE IECKITCP ROUTINE TO DETECT THE TERMINAL INOPERATIVE BIT 40000013 * AND PERFORM THE INTERCEPT FUNCTION ON THE DESTINATION QUEUE. 40100013 RINTRCPT TM 1(R1),X'02' WAS INTERCEPT SPECIFIED IN MACRO 40200013 BZ ROUTE BRANCH IF NO - RETURN MESSAGE 40300013 BAL TERMREG,SUB1 LINK TO GET TERMINAL ADDRESS 40400013 L WREG2,0(WREG3) GET QCB ADDRESS FROM TERMTBL ENTRY 40500013 CLI 8(WREG2),X'68' IS THIS A TERMINAL ENTRY 40600013 BNE ROUTE BRANCH IF NO TO RETURN MESSAGE TO 40700013 * SOURCE (A LIST OR PROCESS ENTRY 40800013 * HAS BEEN ACCESSED) 40900013 LR TERMREG,WREG3 SET UP TERMINAL ADDRESS FOR BASE 41000013 NI TSTATUS,X'FD' TURN OFF THE SEND BIT 41100013 B REENTER BRANCH TO 'LOSE' BUFFER 41200013 SPACE 2 41300013 RRELEASM TM 1(R1),X'02' WAS INTRCPT SPECIFIED IN MACRO 41400013 BZ ROUTE BRANCH IF NO - RETURN MESSAGE 41500013 BAL TERMREG,SUB1 LINK TO GET TERMINAL ADDRESS 41600013 LR TERMREG,WREG3 LOAD BASE REGISTER FOR TERMINAL 41700013 L WREG3,TQCBADDR-1 QCB ADDRESS OF TTENTRY A27860 41720019 CLC QLINK-QBLOCK(3,WREG3),ZERO IS RESTART IN PROGRESS A27860 41740019 BNE ROUTE YES, RETURN MESSAGE A27860 41760019 TM TSTATUS,4 IS THE TERMINAL IN INTERCEPT 41800013 BZ REENTER BRANCH IF NO TO LOSE BUFFER 41900013 TM 1(R1),X'01' WAS ALTERM SPECIFIED IN MACRO 42000013 BNO *+12 BRANCH IF NO 42100013 LH WREG2,6(R1) LOAD OFFSET TO INTERCEPT FIELD 42200013 B *+8 AND GO RELEASE 42300013 LH WREG2,4(R1) LOAD OFFSET TO INTERCEPT FIELD 42400013 AR WREG2,TERMREG ADD IN TERMINAL ENTRY FOR ADDRESS 42500013 L WREG3,TQCBADDR-1 GET QCB ADDRESS FROM TABLE ENTRY 42600013 CLC 1(3,WREG3),0(WREG2) COMPARE MESSAGE HEADER ADDRESS IN 42700013 * TERMTBL INTERCEPT FIELD TO 42800013 * ADDRESS OF FIRST ELEMENT IN 42900013 * THE QUEUE 43000013 BNH *+10 BRANCH IF HEADER ADDRESS GREATER 43100013 * THAN MESSAGE ADDRESS IN QUEUE 43200013 * (PRIORITY MESSAGES HAVE BEEN 43300013 * INTERCEPTED) 43400013 MVC 1(3,WREG3),0(WREG2) INSERT HEADER ADDRESS OF INTERCEPTED 43500013 * MESSAGES AS 1ST MESSAGE TO BE 43600013 * RELEASED 43700013 NI TSTATUS,251 RESET INTERCEPT BIT TO 0 IN TSTATUS 43800013 OI TSTATUS,8 SET RELEASE PENDING BIT ON 00PS 43820018 L R1,QTRAN-QBLOCK(WREG3) GET STCB POINTER FROM QCB 25340 43840018 CLI 0(R1),X'68' IS THE SEND SCHEDULER ACTIVE 25340 43860018 BNE REENTER YES, NO PRIMER NEEDED 25340 43880018 LA R1,PRIMER PUT PRIMER ADDRESS IN R1 25340 43900018 LA KREG,0(0,WREG3) QCB ADDRESS TO R2 25340 43920018 SVC QPOST POST PRIMER ELEMENT TO THE 25340 43940018 * SEND SCHEDULER TO START SENDING 25340 43960018 B REENTER BRANCH TO LOSE BUFFER 44000013 SPACE 2 44100013 RSTARTLN MVI SW1,2 SET STARTLN INDICATOR M1604 45100000 B RSTOPLN AND USE COMMON CODE M1604 46100000 SW1 DC X'00' SW FOR STOPLN & INTREL 21213 47520018 * X'00' - STOPLN CONTROL21213 47540018 * X'01' - INTREL CONTROL21213 47560018 * X'02' - STARTLN ENTRY M1604 47570000 RINTREL MVI SW1,1 SET INTREL INDICATOR FOR RSTOPLN21213 47580018 RSTOPLN BAL TERMREG,SUB1 LINK TO GET TERMINAL ADDRESS 47600013 ST SPREG,SAVEAREA+4 SAVE SCAN POINTER M1604 47610000 L WREG2,0(WREG3) ACCESS QCB FRO TERMINAL ENTRY M1604 47620000 CLI 8(WREG2),X'68' IS THIS A TERMINAL ENTRY M1604 47630000 BNE ROUTE BRANCH IF NO TO RETURN M1604 47640000 * MESSAGE TO SOURCE ( A DLIST M1604 47650000 * OR PROCESS ENTRY HAS BEEN M1604 47660000 * ACCESSED) M1604 47670000 L R0,QRLN-QBLOCK(WREG2) GET RLN AND DCB ADDRESS M1604 47680000 CHKBLK1 CLI 1(SPREG),C' ' CHECK FOR BLANK M1604 47690000 BNE *+12 BRANCH IF NOT BLANK M1604 47700000 LA SPREG,1(SPREG) ELSE BUMP SCAN POINTER M1604 47710000 BCT WREG1,CHKBLK1 DECREMENT BUFFER SIZE M1604 47720000 * REMAINING AND SKIP BLANKS M1604 47730000 LA WREG1,HDSTRT-1 GET START OF TEXT-1 47800013 SR RREG2,WREG1 GET BUFFER SIZE FOLLOWING PREFIX 47900013 LA WREG1,22 LOAD MINIMUM BUFFER SIZE NECESSARY 48000013 CR RREG2,WREG1 DOES BUFFER HAVE 22 USEABLE BYTES 48100013 BL ROUTE RETURN TO SOURCE IF NO 48200013 SR WREG1,WREG1 CLEAR WORKING REGISTER 48300013 LA WREG3,1 SET NUMBER OF LINES TO 1 48400013 IC WREG1,QRLN-QBLOCK(WREG2) GET RELATIVE LINE NUMBER OF LCB 48500013 LR RREG2,R0 GET DCB ADDRESS ACCESSED IN SUB2 48600013 LA RREG2,0(RREG2) CLEAR HI ORDER OF DCB ADDRESS 48700013 CLI SW1,2 IS THIS STARTLN ENTRY M1604 48720000 BE STOPOK YES, BYPASS TEST FOR STARTLN M1604 48740000 * ON SOURCE TERMINAL LINE GROUPM1604 48760000 L TERMREG,=V(TERMTBL) GET TERMINAL TABLE ADDRESS 48800013 AH TERMREG,TTSKEY GET ADDRESS OF SOURCE TERMINAL ENTRY 48900013 L R1,TQCBADDR-1 ACCESS QCB FOR SOURCE TERMINAL 49000013 SR TERMREG,TERMREG CLEAR FOR RELATIVE LINE NUMBER 49100013 IC TERMREG,QRLN-QBLOCK(R1) GET SOURCE RELATIVE LINE NUMBER 49200013 L R1,QDCB-1-QBLOCK(R1) ACCESS DCB FOR SOURCE TERMINAL 49300013 LA R1,0(R1) CLEAR HIGH ORDER 49400013 CR RREG2,R1 STOPLN ISSUED FOR SOURCE LINE GROUP 49500013 BNE STOPOK BRANCH IF NO - NOT THIS LINE GROUP 49600013 CLC ALL,1(SPREG) IS STOP ALL SPECIFIED IN MESSAGE 49700013 BE ROUTE BRANCH IF YES - RETURN TO SOURCE 49800013 CR WREG1,TERMREG STOP SOURCE LINE SPECIFIED 49900013 BE ROUTE BRANCH IF YES TO RETURN MESSAGE 50000013 STOPOK TM DCBOFLGS(RREG2),X'10' HAS THE DCB BEEN OPENED 50100013 BNO ROUTE BRANCH IF NO (NO DEB AVAILABLE) 50200013 L BREG,DCBDEBAD(RREG2) GET DEB ADDRESS FROM THE DCB 50300013 SR R1,R1 CLEAR FOR NUMBER OF EXTENTS 50400013 IC R1,DEBEXT(BREG) GET DEB NUMBER OF EXTENTS 50500013 CR WREG1,R1 IS QCB LINE NUMBER TOO HIGH 50600013 BH ROUTE RETURN MESSAGE IF YES 50700013 LR R1,WREG1 GET REL. LINE NO. IN R1 21213 50710018 SR R0,R0 CLEAR REGISTER 21213 50720018 IC R0,DCBEIOBX(RREG2) GET SIZE OF AN LCB 21213 50730018 MR R0,R0 GET NO. FOR FINDING LCB 21213 50740018 A R1,DCBLCBAD(RREG2) GET RIGHT LCB 21213 50750018 CLI SW1,1 CHECK FOR STARTLN, STOPLN, M1604 50752000 * OR INTREL M1604 50754000 BH XXX BRANCH IF STARTLN M1604 50756000 BL *+12 BRANCH IF STOPLN M1604 50758000 CLI LCBSTATE-LCB(R1),0 SEE IF LCB ALREADY STOPPED21213 50760018 BE ROUTE IF SO, RETURN MESSAGE 21213 50770018 MVC MSEGSZE(2),H56 PREVENT EOT OVERLAYING STCB 50800013 XXX TM LCBCPA-6-LCB(R1),2 WAIT FOR INTERRUPT FROM ANY 00PS 50830018 BO XXX PREVIOUS STARTLINE 00PS 50860018 CLI SW1,1 WAS ENTRY FOR INTREL M1604 50940000 BE SUBTASK YES, BYPASS TEST FOR ALL M1604 51020000 CLC ALL,1(SPREG) IS STOP 'ALL' SPECIFIED IN MESSAGE 51100013 BNE CHKSTART BRANCH IF NO M1604 51200000 LA WREG1,1 ELSE SET LINE NUMBER TO 1 51300013 IC WREG3,DEBEXT(BREG) SET INDEX TO COUNT OF LINES 51400013 CHKSTART CLI SW1,2 WAS ENTRY FOR STARTLN M1604 51430000 BE START YES, ISSUE SIO ON LINES M1604 51460000 SUBTASK LA R1,STOP GET ADDRESS OF STOP QCB 51500013 LR KREG,R1 SET UP FOR POSTING 51600013 STM 14,11,SAVE+12 SAVE REGISTERS TO BE USED IN SUBTASK 51700013 SVC QPOST POST QCB TO ITSELF TO GET DISABLED 51800013 B RETURN2 RETURN TO ENDRCV IN LPS WITHOUT THE 51900013 * SERVICED BIT SET SO THAT THE 52000013 * CLEANUP ROUTINE IN IGG019NG CAN 52100013 * POST THE BUFFER TO THE QUEUE 52200013 * IN THIS ROUTINE 52300013 SPACE 3 M1604 52301000 START SR R1,R1 CLEAR REGISTER FOR IC M1604 52302000 IC R1,DCBEIOBX(RREG2) GET LCB SIZE M1604 52303000 L BREG,DCBDEBAD(RREG2) GET DEB ADDRESS FROM DCB A41219 52303521 MR R0,WREG1 MULTIPLY BY LINE NUMBER M1604 52304000 AL R1,DCBLCBAD(RREG2) GET LCB ADDRESS M1604 52305000 LR KREG,WREG1 COPY RLN M1604 52306000 SLL KREG,2 MULTIPLY BY FOUR M1604 52307000 L KREG,DEBUCBAD-4(KREG,BREG) UCB ADDRESS M1604 52308000 DROP LCBREG M1604 52309000 USING LCB,R1 M1604 52310000 SR WREG2,WREG2 CLEAR WORK REG A52229 52310121 IC WREG2,LCBUCBX GET REL LINE # A52229 52310221 SLA WREG2,2 TIMES 4 A52229 52310321 A WREG2,LCBDCBPT ADD DCB ADDRESS A52229 52310421 LA WREG2,DCBCPOLL(WREG2) POINT TO CPOLL FOR THIS LINEA52229 52310521 NI 0(WREG2),X'FB' TURN OFF INTREL BIT A52229 52311021 CLI LCBSTATE,0 IS LINE ALREADY ACTIVE M1604 52312000 BNE TRYEXIT2 YES, BYPASS STARTLN M1604 52313000 XC LCBCPA(24),LCBCPA CLEAR FIRST 3 CCW SLOTS M1604 52314000 LA BREG,LCBSCHAD-4 SET UP FOR LOOP M1604 52315000 LOOP3 LR SPREG,BREG SAVE LAST STCB ADDRESS M1604 52316000 L BREG,4(SPREG) GET NEXT STCB IN CHAIN M1604 52317000 CLI 0(BREG),X'12' IS THIS THE RECEIVE SCHEDULER M1604 52318000 BE START2 BRANCH IF YES M1604 52319000 CLI 4(BREG),255 IS THIS END OF CHAIN M1604 52320000 BNE LOOP3 BRANCH IF NOT END M1604 52321000 TM LCBCPRI,X'80' WAS RECEIVE SCHEDULER REMOVED M1604 52322000 * BY STOPLN M1604 52323000 BZ START2 NO, DO NOT RESTORE SCHEDULER M1604 52324000 NI LCBCPRI,X'7F' TURN OFF FLAG M1604 52325000 IC R0,LCBCPRI SAVE SCHEDULER PRIORITY M1604 52326000 ST BREG,LCBSCHLK-1 SET LINK FIELD TO DUMMY M1604 52327000 * END ELEMENT M1604 52328000 STC R0,LCBCPRI RESTORE PRIORITY M1604 52329000 LA BREG,LCBSCHAD GET RECEIVE SCHEDULER ADDRESS M1604 52330000 IC R0,4(SPREG) SAVE PRIORITY OF LAST STCB M1604 52331000 ST BREG,4(SPREG) SET RECEIVE SCHEDULER AS LAST M1604 52332000 * STCB IN CHAIN M1604 52333000 STC R0,4(SPREG) AND RESTORE STCB PRIORITY M1604 52334000 START2 MVI LCBCPA+32,X'FF' SET STARTLN FLAG M1604 52335000 MVI LCBCPA,3 SET NOP COMMAND M1604 52336000 MVC LCBCPA+4(4),C1 SET FLAGS AND COUNT M1604 52337000 LA RREG1,LCBERCCW SET CCW POINTER M1604 52338000 IC BREG,19(KREG) CONTROL UNIT TYPE FROM UCB M1604 52339000 N BREG,ANDMASK CLEAR UNUSED BITS M1604 52340000 BCT BREG,NOT2702 BRANCH IF 2701 OR 2703 M1604 52341000 IC BREG,17(KREG) DETERMINE SAD TYPE M1604 52342000 N BREG,ANDMASK CLEAR UNUSED BITS M1604 52343000 IC BREG,SADCODE(BREG) GET PROPER SAD CODE M1604 52344000 STC BREG,LCBCPA AND STORE IN CPA M1604 52345000 LA RREG1,8(RREG1) RESET CCW POINTER M1604 52346000 NOT2702 CLI 19(KREG),X'82' IBM III ADAPTER M1604 52347000 BE SIO YES, NO ENABLE NEEDED M1604 52348000 TM 17(KREG),X'90' SWITCHED LINE M1604 52349000 BNZ SIO YES, NO ENABLE NEEDED M1604 52350000 MVI 8(RREG1),X'27' ELSE SET ENABLE OP CODE M1604 52351000 MVC 12(4,RREG1),C1 STORE FLAGS AND COUNT M1604 52352000 MVI 4(RREG1),X'60' SET CHAINING IN PREVIOUS CCW M1604 52353000 SIO LA BREG,LCBCPA GET CPA ADDRESS M1604 52354000 ST BREG,LCBSTART-1 INITIALIZE IOBSTART M1604 52355000 OI LCBCPA-6,2 SET FLAG TO PREVENT DOUBLE SIO M1604 52356000 LA R1,LCBFLAG1 GET IOB ADDRESS FOR EXCP M1604 52357000 LR BREG,SREG SAVE BASE REG. FOR EXCP M1604 52357500 SVC 0 DO SIO M1604 52358000 LR SREG,BREG RESTORE BASE REGISTER M1604 52358500 DROP R1 M1604 52359000 USING LCB,LCBREG M1604 52360000 TRYEXIT2 LA WREG1,1(WREG1) INCREMENT LINE NUMBER M1604 52361000 BCT WREG3,START RELOOP FOR NEXT LINE M1604 52362000 B REENTER RETURN IF LAST LINE M1604 52363000 ANDMASK DC F'3' M1604 52364000 SADCODE DC X'13171B1F' SAD CWW OP CODES M1604 52365000 SPACE 2 52400013 * STOP LINE STCB COMBINED WITH QCB 52500013 * PROGRAM ENTRY--ENTERS THE ROUTINE AT STOP1+6 52600013 USING STOP,WREG1 PROVIDE SAVE AREA ADDRESSABILITY 52700013 STOP DC A(STOP) 52800013 DC X'FE' 52900013 DC AL3(STOP) 53000013 STOP1 DC X'02' 53100013 DC AL3(STOP1) 53200013 DC X'0000' 53300013 SPACE 1 53400013 LM 14,11,SAVE+12 RESTORE REGISTERS SAVED BEFORE QPOST 53500013 DROP WREG1 SAVE AREA ACCESSED 53600013 L R1,0(NGREG) GET LPS QUEUE ADDRESS 53700013 MVC 321(3,R1),=VL3(IECKOPAW) MOVE ADDR OF IECKOPAW IN 5645 53800016 * IGG019NG SO THAT ENTRY WILL 54000013 * ALWAYS BE TO IECKOPAW AT 54100013 * POSTRCV OR POSTSEND TO CHECK 54200013 * FOR UNRECOVERABLE ERRORS FOR 54300013 * INTREL 54400013 SR R1,R1 CLEAR WORKING REGISTER 54500013 IC R1,DCBEIOBX(RREG2) GET THE SIZE OF AN LCB-IOB 54600013 STC R1,HDSTRT+21 SAVE LCB SIZE IN THE BUFFER 54700013 STC WREG1,HDSTRT SAVE LINE NUMBER IN BUFFER 54800013 MR R0,WREG1 LCB-IOB SIZE TIMES LINE NUMBER 54900013 L RREG2,DCBLCBAD(RREG2) GET THE START OF THE LCB'S 55000013 LOOP1 LA RREG2,0(RREG2,R1) GET LCB ADDRESS FOR THIS LINE 55100013 CLI LCBSTATE-LCB(RREG2),0 IS THE LINE ACTIVE 55200013 BE TRYEXIT BRANCH IF NO - LINE STOPPED 55300013 L KREG,LCBSCHAD-LCB(RREG2) ACCESS 1ST STCB IN THE LCB 55400013 CLI 0(KREG),X'6C' IS AN OPCTL TYPE STCB PENDING 55500013 BNE *+18 BRANCH IF NO 55600013 L R1,16(KREG) ELSE ACCESS IECKOCTL BASE FROM STCB 55700013 LA R1,0(R1) CLEAR HIGH ORDER BYTE 55800013 CR R1,SREG IS AN OPCTL STOPLN PENDING 55900013 BE TRYEXIT BRANCH IF YES - IGNORE THE STOPLN 56000013 LR R1,WREG1 COPY RELATIVE LINE NUMBER 56100013 SLL R1,2 RELATIVE LINE NUMBER TIMES 4 56200013 L KREG,28(R1,BREG) GET UCB ADDRESS FOR THIS LINE 56300013 ST RREG2,STOP2+4 SAVE LCB ADDRESS TO BE STOPPED 22760 56320018 MVI STOP2+4,X'FE' RESTORE PRIORITY 22760 56340018 STC WREG3,BASE SAVE COUNT INDEX IN THE QCB 22760 56360018 TM 17(KREG),X'90' IS THIS A DIAL LINE 56400013 BO *+24 BRANCH IF DIAL 6646 56420016 CLI LCBCPA-LCB+16(RREG2),X'04' IS THIS A SENSE COMMAND 6646 56440016 * (2740 BASIC OR WITH CHECKING) 6646 56460016 BNE NOTDIAL NOT 2740 OR DIAL 6646 56480016 CLI LCBCPA-LCB+21(RREG2),X'00' IF TP OP CODE =00, LINE 6646 56500016 * IS BUSY, NO HIO ISSUED 6646 56520016 BE NOTDIAL 2740 IS BUSY - NO HIO 6646 56540016 B *+16 HIO TO ALLOW SENDING 6646 56560016 CLI LCBINCAM-LCB(RREG2),2 IS LINE IN ACTIVE TRANSMISSION 56600013 BE CHEK2740 CHECK FOR 2740 22438 56700018 OI LCBINCAM-LCB(RREG2),3 SET SO LINE WILL BE REDIALED 56800013 HIOLOOP NI LCBFLAG1-LCB(RREG2),X'DB' TURN OFF ERP FLAGS 00PS 56960015 MVI LCBECBPT-LCB(RREG2),X'48' SET HIO FLAG FOR LINE-END22437 56970018 UCBFLAGS EQU 6 00PS 56980017 UCBRQEAD EQU 20 00PS 57000017 CVT EQU 16 00PS 57020017 CVTIXAVL EQU 124 00PS 57040017 HIORTN EQU 8 00PS 57060017 IC R0,UCBFLAGS(KREG) SAVE UCBFLAG STATUS 00PS 57080017 STM 1,15,SAVE+12 SAVE REGISTERS FOR HALT I/O 00PS 57100018 LR BREG,KREG UCB ADDRESS TO BREG 00PS 57120017 LH WREG1,UCBRQEAD(BREG) RQE ADDRESS IN REG 9 00PS 57140017 LR R1,SREG SAVE BASE REGISTER 00PS 57160017 L WREG3,CVT CVT ADDRESS 00PS 57180017 L WREG3,CVTIXAVL(WREG3) PARAMETER LIST ADDRESS 00PS 57200017 L WREG3,HIORTN(WREG3) HALT I/O ROUTINE ADDRESS 00PS 57220017 BALR SREG,WREG3 LINK TO HALT I/O ROUTINE 00PS 57240017 LM 1,15,SAVE+12-IECKOCTL(R1) RESTORE REGISTERS 00PS 57260017 STC R0,UCBFLAGS(KREG) RESTORE UCBFLAGS STATUS 00PS 57280017 NOTDIAL EQU * 22760 57480018 CLC HDSTRT+8(8),STCB IS THIS THE FIRST PASS 57700013 BE *+14 BRANCH IF NO (STOP 'ALL' SPECIFIED) 57800013 MVC LCBDESTQ(3),STOP2+1 LOAD LCBDESTQ SO THAT CONTROL WILL 57900013 * BE RETURNED FOLLOWING RELEASE 58000013 * IN CLEANUP IN IGG019NG 58100013 B DISPATCH-2(WREG2) EXIT TO RSTOPLN ROUTINE 58200013 LR R1,MSREG SET UP INTERFACE TO BUILD STCB 58300013 STC WREG1,HDSTRT STORE REL LINE NO. IN BUFFER 5044 58350016 LA WREG1,STOP2 SET UP BASE REGISTER 5044 58400016 B BASE+4 5044 58450016 CHEK2740 CLI LCBCPA+32,4 DOES CHANNEL PROGRAM CONTAIN 58458018 * SENSE COMMAND 22438 58466018 BNE NOTDIAL NO, LOOK AT STCB CHAIN 22438 58474018 CLI LCBCPA+37,0 IF TP OP CODE=0, LINE IS BUSY 22438 58482018 BNE HIOLOOP-4 BRANCH IF HIO NECESSARY 22438 58490018 B NOTDIAL 22438 58495018 SPACE 2 58500013 * THIS QCB IS USED TO GET CONTROL BACK HERE WHEN CLEANUP IN IGG019NG 58600013 * POSTS THE BUFFER TO THE DESTINATION QUEUE (ACTUALLY STOP2) 58700013 DS 0F 58800013 USING STOP2,WREG1 SET UP BASE FOR THIS SECTION OF CODE 58900013 STOP2 DC X'03' 59000013 DC AL3(STOP2) 59100013 DC X'FE' 59200013 DC AL3(0) 59300013 STOP3 DC X'6C' 59400013 DC AL3(STOP3) 59500013 BASE DC A(IECKOCTL) 59600013 L SREG,BASE RESTORE BASE REGISTER 59700013 DROP WREG1 59800013 LR MSREG,R1 SET UP BUFFER BASE 59900013 TM MSTATUS,X'01' IS THIS OTHER THAN THE HEADER BUFFER 60000013 BO FREEBUF BRANCH IF YES TO FREE BUFFER 60100013 L RREG2,STOP2+4 SET UP LCB ADDRESS TO BE STOPPED 60200013 * THE FOLLOWING IS DYNAMIC GENERATION OF AN STCB IN THE BUFFER 60300013 * FOR THE LCB SUBTASK CHAIN 60400013 GENSTCB ST SREG,HDSTRT+16 STORE BASE IN BUFFER FOR FUTURE USE 60500013 MVC HDSTRT+20(1),HDSTRT MOVE SAVED CURRENT LINE NUMBER 60600013 LA R1,HDSTRT GET ADDRESS OF DYNAMIC BUFFER STCB 60700013 ST R1,HDSTRT STORE STCB ADDRESS IN STCB 60800013 MVI HDSTRT,X'6C' MOVE IN BRANCH OFFSET 60900013 MVI HDSTRT+4,X'E4' SET STCB PRIORITY IN BUFFER 61000013 MVC HDSTRT+8(8),STCB MOVE LOAD AND BRANCH INTO BUFFER 61100013 MVC HDSTRT+5(3),LCBSCHAD+1-LCB(RREG2) LINK STCB CHAIN OF LCB 61200013 * TO THE STCB BEING BUILT IN THE 61300013 * BUFFER 61400013 MVC LCBSCHAD+1-LCB(3,RREG2),HDSTRT+1 INSERT ADDRESS OF THE 61500013 * STOPLN STCB AS 1ST STCB IN STCB 61600013 * CHAIN OF THE LCB 61700013 * THE FOLLOWING CODE IS NECESSARY FOR AUTOPOLLED LINES 61800013 TM LCBSTATE-LCB(RREG2),X'08' IS THE LINE RECEIVING 61900013 BNO NOAUTOPL BRANCH IF NO - NO AUTOPOLL SET UP 62000013 TM LCBFLAG2-LCB(RREG2),X'01' IS THE LINE AUTOPOLLED 62100013 BNO NOAUTOPL BRANCH IF NO - NO AUTOPOLL SET UP 62200013 MVI LCBCPA+47-LCB(RREG2),X'FE' PUT AUTOPOLL FLAG IN CHANNEL 62300013 * PROGRAM AREA 62400013 MVI LCBCPA+40-LCB(RREG2),X'03' PUT NOP INTO TIC CCW 62500013 NOAUTOPL CLI SW1,0 WAS ENTRY FROM THE INTREL ROUTINE 62600013 BE LINEFREE NO, CHECK FOR LINE FREE M3170 62700018 MVI SW1,0 CLEAR THE INTREL CONTROL SWITCH 62800013 SR WREG3,WREG3 CLEAR WORK REG A52229 62810021 IC WREG3,LCBUCBX-LCB(RREG2) GET REL LINE # A52229 62820021 SLA WREG3,2 TIMES 4 A52229 62830021 A WREG3,LCBDCBPT-LCB(RREG2) ADD DCB ADDRESS A52229 62840021 LA WREG3,DCBCPOLL(WREG3) POINT TO CPOLL FOR THIS LINE2229 62850021 OI 0(WREG3),4 SET INTREL SWITCH A52229 62900021 MVI HDSTRT+16,0 ZERO COUNT INDEX IN THE BUFFER STCB 63000013 * SO THE STARTLN STCB CAN BE 63100013 * BUILT WHEN THE LINE IS STOPPED 63200013 * AND THE SWITCH IS FOUND TO BE 0 63300013 LINEFREE CLI LCBSTATE-LCB(RREG2),1 IS LINE FREE M3170 63320018 BNE DISPATCH-2(WREG2) IF NO, DISPATCH NEXT ITEM M3170 63340018 LA R1,0(RREG2) CLEAR HIGH ORDER BYTE AND PUT M3170 63360018 * LCB ADDRESS IN R1 M3170 63380018 LR KREG,R1 LCB ADDRESS TO R2 M3170 63400018 B POST-2(WREG2) POST LCB TO ITSELF TO ACTIVATE M3170 63420018 TRYEXIT LA WREG1,1(WREG1) BUMP TO NEXT RELATIVE LINE NUMBER 63500013 BCT WREG3,RELOOP BRANCH IF MORE LINES TO CHECK 63600013 BCTR WREG1,0 RESET THE LINE NUMBER 63700013 CLI SW1,0 WAS ENTRY FROM THE INTREL ROUTINE 63800013 BNE TIMEQ BRANCH IF YES 63900013 CLC HDSTRT+8(8),STCB IS THIS THE FIRST PASS 64000013 BE FREEBUF BRANCH IF NO - BUFFER MUST BE FREED 64100013 OI MSTATUS,X'10' SET SERVICED BIT TO FREE BUFFER 64200013 B DISPATCH-2(WREG2) GO DISPATCH NEXT ITEM ON READY 64300013 * (RETURNS TO RSTOPLN ROUTINE) 64400013 RELOOP SR R1,R1 CLEAR SIZE REGISTER 64500013 IC R1,HDSTRT+21 GET LCB SIZE STORED ABOVE IN BUFFER 64600013 B LOOP1 GO CHECK NEXT LCB 64700013 SPACE 2 64800013 * THE FOLLOWING CODE IS ENTERED WHEN THE LCB IS POSTED TO ITSELF IN 64900013 * THE CLEANUP ROUTINE IN IGG019NG AND THE STCB CHAIN CONTAINS THE 65000013 * BUFFER CONSTRUCTED ABOVE. WHEN THE SUBTASK SPECIFIED BY THE STCB IN 65100013 * THE BUFFER IS ACTIVATED, CONTROL IS GIVEN TO THE FOLLOWING ROUTINE. 65200013 SPACE 1 65300013 SUBTASK1 MVC LCBSCHAD+1-LCB(3,WREG1),5(KREG) REMOVE THE OPCTL STOPLN 65400013 * STCB FROM THE LCB'S STCB CHAIN 65500013 * (UPON ENTRY TO THIS SUBTASK, 65600013 * WREG1 HAS A POINTER TO THE LCB 65700013 * ON READY QUEUE AND KREG HAS A 65800013 * POINTER TO THE STCB FOR THIS 65900013 * SUBTASK) 66000013 MVI LCBSTATE-LCB(WREG1),0 DEACTIVATE THE LCB 66100013 SR WREG3,WREG3 CLEAR INDEX REGISTER 66200013 ST WREG3,0(KREG) CLEAR X'6C' AND HDSTRT IN BUFFER 66300013 IC WREG3,16(KREG) LOAD COUNT REMAINING IN WREG3 66400013 SH KREG,H32 ADJUST KREG TO START OF BUFFER 66500013 LR MSREG,KREG SET UP BUFFER BASE REGISTER 66600013 L RREG2,LCBDCBPT-LCB(WREG1) ACCESS DCB FROM LCB 66700013 L BREG,DCBDEBAD(RREG2) ACCESS DEB FROM DCB 66800013 LR RREG2,WREG1 TRANSFER LCB ADDRESS 66900013 SR WREG1,WREG1 CLEAR LINE NUMBER REGISTER 67000013 IC WREG1,HDSTRT+20 LOAD RELATIVE LINE NUMBER INTO WREG1 67100013 LR R1,WREG1 COPY RELATIVE LINE NUMBER 67200013 SLL R1,2 RELATIVE LINE NUMBER TIMES 4 67300013 L R1,28(R1,BREG) GET UCB ADDRESS FOR THIS LINE 67400013 TM 17(R1),X'90' IS THIS A DIAL LINE 67500013 BNO NOTDIAL1 BRANCH IF NO 67600013 MVI LCBERCCW-LCB(RREG2),X'2F' SET UP DISABLE COMMAND 67700013 MVC LCBERCCW+4-LCB(4,RREG2),C1 MOVE IN FLAG AND COUNT 67800013 LA R1,LCBERCCW-LCB(RREG2) GET ERROR CCW ADDRESS 67900013 ST R1,LCBSTART-1-LCB(RREG2) AND STORE IT IN RESTART 68000013 MVI LCBCPA+32-LCB(RREG2),X'FE' INDICATE OPEN IDLE TO APNDAGE 68100013 MVI LCBINCAM-LCB(RREG2),7 FLAG THE LCB SO THE SEND 22760 68150018 * SCHEDULER WILL NOT ASSIGN 22760 68200018 STM BREG,WREG1,SAVE+12 SAVE REGISTERS USED BY STCBLOOPM3147 68220018 * THE LINE TO ANOTHER TERM 22760 68250018 LA R1,LCBSCHAD-4-LCB(RREG2) SET UP FOR LOOP 22760 68251018 STCBLOOP LR WREG1,R1 SAVE LAST STCB ADDRESS 22760 68252018 L R1,4(WREG1) GET NEXT STCB IN CHAIN 22760 68253018 CLI 4(R1),255 255 SIGNALS END OF CHAIN 22760 68254018 BE NOMOSTCB BRANCH IF END 22760 68255018 CLI 0(R1),X'68' IS THIS A SEND SCHEDULER 22760 68256018 BNE STCBLOOP BRANCH IF NOT 22760 68257018 MVC 5(3,WREG1),5(R1) REMOVE SEND SCHEDULER 22760 68258018 XC LCBTTIND-LCB(2,RREG2),LCBTTIND-LCB(RREG2) AND ZERO22760 68259018 * TERMINAL OFFSET IN LCB 22760 68260018 LR BREG,R1 SET BREG TO SEND SCHEDULER 22760 68261018 SH R1,H8 BACK UP TO QCB 22760 68262018 MVC QTRAN+5-QBLOCK(3,R1),1(BREG) POINT SEND 25340 68262818 * SCHEDULER TO END ELEMENT 25340 68263618 * (DESTINATION-DASD) 25340 68264418 ST BREG,0(BREG) PUT SEND SCHEDULER IN QCB 25340 68265218 MVI 0(BREG),X'68' RESTORE ENTRY CODE 25340 68266018 CLC QFAC-QBLOCK(3,R1),QNASEG-QBLOCK(R1) IS QFAC LESS 25340 68266818 * THAN QNASEG 25340 68267618 BNL STCBLOOP+2 NO, THERE ARE NO OUTGOING 25340 68268418 * MESSAGES TO SEND 00PS 68268518 LTR WREG3,WREG3 WAS THIS ENTRY FOR INTREL 00PS 68268618 BZ PRIME YES, PRIMING IS NEEDED 00PS 68268718 BCTR WREG3,0 DECREMENT COUNT OF LINES 1 00PS 68268818 LTR WREG3,WREG3 WAS COUNT ONE 00PS 68268918 LA WREG3,1(WREG3) RESTORE ORIGINAL COUNT 00PS 68269018 BNZ CALLQ NO, PUT SEND SCHEDULER ON 00PS 68269118 * DIAL-OUT CALL QUEUE 00PS 68269218 PRIME EQU * 00PS 68269318 LA R1,0(0,R1) CLEAR HIGH ORDER BYTE 25340 68270018 ST R1,PRIMER POST DUMMY PRIMER ELEMENT TO 25340 68270818 * QCB SO ANOTHER LINE WILL BE 25340 68271618 * ASSIGNED TO TERMINAL 25340 68272418 MVC PRIMER+5(3),LCBRCADD-LCB(RREG2) POINT PRIMER TO M3167 68273418 * NEXT READY ITEM AFTER LCB M3167 68274418 LA BREG,PRIMER AND PLACE PRIMER AS NEXT READY M3167 68275418 * ITEM AFTER LCB M3167 68276418 ST BREG,LCBRCADD-1-LCB(RREG2) ON READY QUEUE M3167 68277418 MVI LCBCECB-LCB(RREG2),X'E4' RESET LCB PRIORITY M3167 68278418 B NOMOSTCB GO TO EXECUTE DISABLE CCW M3167 68279418 CALLQ L R1,LCBDCBPT-LCB(RREG2) ACCESS DCB POINTER FROM LCB 00PS 68280418 L R1,DCBDEBAD(R1) ACCESS DEB ADDRESS FROM DCB 00PS 68281418 SH R1,H16 BACK UP TO CALL QUEUE 00PS 68282418 MVC 1(3,BREG),5(BREG) PLACE DEST-DASD AS FIRST 00PS 68283418 * SUBTASK IN QCB 00PS 68284418 MVC 5(3,BREG),1(R1) POINT SENT SCHEDULER TO NEXT00PS 68285418 * ITEM ON DIAL-OUT CALL QUEUE 00PS 68286418 ST BREG,0(R1) PUT SEND SCHEDULER AT HEAD 00PS 68287418 * OF DIAL-OUT CALL QUEUE 00PS 68288418 MVI 0(R1),0 ZERO HIGH ORDER BYTE OF ADD.00PS 68289418 NOMOSTCB EQU * M3147 68290418 LM BREG,WREG1,SAVE+12 RESTORE REGISTERS M3147 68291418 LA R1,LCBFLAG1-LCB(RREG2) SET UP IOB ADDRESS FOR EXCP 68300013 OI LCBERCCW+2-LCB(RREG2),2 SET SO THAT A START LINE 68400013 * CANNOT ISSUE SIO PRIOR TO 68500013 * COMPLETION OF DISABLE. (ABOUT 68600013 * 3 SECONDS) 68700013 SVC 0 EXECUTE THE DISABLE TO HANG UP LINE 68800013 MVI IOSSAVE-2(WREG2),X'FF' RESET SVC ENTRY A39103 68850020 L SREG,48(KREG) RESTORE BASE REGISTER FROM BUFFER 68900013 NOTDIAL1 LTR WREG3,WREG3 WAS ENTRY FROM THE INTREL ROUTINE 69000013 BZ SUBTASK2 BRANCH IF YES 69100013 L R1,36(KREG) ACCESS NEXT STCB FROM THE LCB 69200013 TM 0(R1),X'FF' IS IT A FULL STCB 69300013 BZ *+10 BRANCH IF FULL STCB 69400013 MVC READY+1(3,NGREG),5(RREG2) REMOVE LCB FROM READY QUEUE 69500013 BCT WREG3,LOOP2 BRANCH IF MORE LINES TO STOP 69600013 FREEBUF LR R1,MSREG ELSE SET UP TO FREE BUFFER 69700013 L KREG,0(NGREG) GET ADDRESS OF LPS QUEUE 69800013 LA KREG,24(KREG) GET AVAILABLE BUFFER QUEUE ADDRESS 69900013 MVI 4(R1),X'E4' SET BUFFER PRIORITY TO POST 70000013 B POST-2(WREG2) EXIT TO POST BUFFER TO FREE 70100013 LOOP2 LA WREG3,1(WREG3) RESTORE INDEX DECREMENTED ABOVE 70200013 B TRYEXIT GO FIND A LINE TO STOP 70300013 SPACE 2 70320018 PRIMER DC A(PRIMER) 25340 70340018 DC X'FE' 25340 70360018 DC AL3(PRIMER) 25340 70380018 SPACE 1 70400013 * THE FOLLOWING TWO INSTRUCTIONS WILL BE INSERTED INTO THE BUFFER 70500013 * FOLLOWING THE DYNAMICALLY CREATED STCB AT HDSTRT+8. THEY ARE 70600013 * USED FOR ACTIVATING SUBTASK1. 70700013 STCB L SREG,16(KREG) GET THE BASE ADDRESS STORED EARLIER 70800013 B SUBTASK1 BRANCH TO STOPLN SUBTASK 70900013 SPACE 2 71000013 TIMEQ MVI SW1,0 CLEAR THE INTREL CONTROL SWITCH 71100013 SR R0,R0 CLEAR WORK REG A52229 71110021 IC R0,LCBUCBX-LCB(RREG2) GET REL LINE # A52229 71120021 SLA R0,2 TIMES 4 A52229 71130021 A R0,LCBDCBPT-LCB(RREG2) ADD DCB ADDRESS A52229 71140021 LA R0,DCBCPOLL(R0) POINT TO CPOLL FOR THIS LINE A52229 71150021 OI 0(R0),4 SET THE INTREL SWITCH A52229 71200021 CLI LCBSTATE-LCB(RREG2),0 IS THE LCB ALREADY DEACTIVATED 71300013 BE BUILD2 BRANCH IF YES TO BUILD RELEASE STCB 71400013 MVI HDSTRT+16,0 ZERO COUNT INDEX IN THE BUFFER STCB 71500013 * SO THE STARTLN STCB CAN BE 71600013 * BUILT WHEN THE LINE IS STOPPED 71700013 * AND THE SWITCH IS FOUND TO BE 0 71800013 B DISPATCH-2(WREG2) RETURN TO RSTOPLN ROUTINE 71900013 SPACE 2 72000013 * SET UP THE BUFFER TO INSERT IT INTO THE TIME QUEUE IN IGG019NG 72100013 * LOOKING LIKE AN LCB. WHEN THE BUFFER COMES OUT OF THE TIME QUEUE 72200013 * THE ROUTINE AT STCB2 GETS CONTROL. 72300013 SUBTASK2 MVC READY+1(3,NGREG),5(RREG2) REMOVE LCB FROM READY QUEUE 72400013 MVI SW1,0 CLEAR THE INTREL CONTROL SWITCH 72500013 BUILD2 LA R1,STCB2 GET STCB FOR BUFFER 72600013 ST R1,8(MSREG) INSERT INTO STCB FIELD OF BUFFER 72700013 ST RREG2,20(MSREG) SAVE LCB ADDRESS IN BUFFER 72800013 SPACE 1 72900013 * PUT THE BUFFER IN THE TIME QUEUE IN IGG019NG WITH A 2 MINUTE DELAY 73000013 HAVESVC CLI IOSSAVE-2(WREG2),255 WAS ENTRY FROM AN SVC 73100013 BNE GETSVC BRANCH IF NO - I/O INTERRUPT 73200013 LA LCBREG,0(MSREG) MAKE BUFFER LOOK LIKE LCB TO TIMEQ 73300013 LA MSREG,X'78' SET UP 120 SECOND INTERVAL IN HEX 73400013 MVI LCBSCHAD,0 ZERO LCB+8 FOR TIME ROUTINE 73500013 MVI LCBSTATE-LCB(RREG2),X'0C' PREVENT LCB BEING STARTED WHEN 73600013 * THE BUFFER IS IN THE TIME QUEUE 73700013 SPACE 1 73800013 SPACE 1 73900013 * NOW PUT THE BUFFER FOR THE STOPPED LINE IN THE TIME DELAY QUEUE 74000013 SCANDONE L KREG,0(NGREG) GET LPS QUEUE ADDRESS 74100013 B TIMENT(KREG) TO DELAY ROUTINE IN IGG019NG 74200013 SPACE 2 74900013 * THE FOLLOWING CODE IS ENTERED WHEN THE 2 MINUTE INTERVAL HAS EXPIRED 75000013 * FOR THE BUFFER WHICH WAS INSERTED INTO TIMEQ IN IGG019NG. AT THIS 75100013 * POINT THE LINE CAN BE RESTARTED AND THE BUFFER CONTAINING THE STCB 75200013 * WHICH ACTIVATED THIS ROUTINE CAN BE FREED. 75300013 SPACE 1 75400013 DS 0H 75500013 STCB2 DC X'02' STCB FOR BUFFER IN TIME QUEUE 75600013 DC XL5'0' 75700013 L R1,20(WREG1) ACCESS LCB ADDRESS FROM THE BUFFER 75800013 L RREG2,0(NGREG) GET LPS QUEUE ADDRESS FROM IGG019NG 75900013 LA RREG2,24(RREG2) GET AVAILABLE BUFFER QUEUE ADDRESS 76000013 ST RREG2,0(WREG1) STORE IN FIRST WORD OF BUFFER 76100013 LR KREG,R1 SET UP TO POST LCB TO ITSELF 76200013 B POST-2(WREG2) EXIT TO POST LCB TO ITSELF 76300013 SPACE 2 76400013 USING GETSVC1,WREG1 76500013 GETSVC1 DC A(GETSVC1) 76600013 DC X'E3' 00PS 76700020 DC AL3(GETSVC1) 76800013 GETSVC2 DC X'6C' 76900013 DC AL3(GETSVC2) 77000013 DC F'0' 77100013 LM 14,11,SAVE+12 RESTORE REGISTERS SAVED BEFORE QPOST 77200013 DROP WREG1 SAVE AREA ACCESSED 77300013 L R1,CVT GET CVT ADDRESS A39114 77310020 L R1,CVTTCB(R1) GET TCB POINTER A39114 77320020 L KREG,0(NGREG) GET LPS Q ADDRESS A39114 77330020 CLC CURTCB(3,R1),CTLTCB(KREG) IS CONTROL UNDER MCP A39114 77340020 * TCB? A39114 77350020 BE HAVESVC IF YES, CONTINUE PROCESSING A39114 77360020 ST KREG,GETSVC1 IF NOT, POST ELEMENT TO LPS A39114 77370020 B DISPATCH-2(WREG2) QUEUE (GETSVC1 ON READY QUEUE) A39114 77380020 CVTTCB EQU 0 A39114 77390020 CURTCB EQU 5 A39114 77400020 CTLTCB EQU 289 A39114 77410020 SPACE 2 77500013 * SET UP TO POST GETSVC1 QCB TO LPS QUEUE TO ENSURE SVC ENTRY 77600013 GETSVC LA R1,GETSVC1 GET QCB ADDRESS FOR POSTING 77700013 L KREG,0(NGREG) GET ADDRESS OF LPS QUEUE 77800013 STM 14,11,SAVE+12 SAVE REGISTERS 77900013 B POST-2(WREG2) GO POST TO LPS QUEUE 78000013 SPACE 2 78100013 * THIS QCB IS USED BY THE OPERATOR AWARENESS ROUTINE TO RETURN THE LCB 78200013 * TO INTREL CONTROL WHEN AN UNRECOVERABLE ERROR OCCURS AND THE LINE 78300013 * HAS BEEN PREVIOUSLY PUT IN INTREL. A BUFFER IS OBTAINED BY IECKOPAW 78400013 * AND THE CLEANUP ROUTINE POSTS THE BUFFER TO THE QUEUE BELOW. 78500013 DS 0F 78600013 USING STOP4,WREG1 78700013 STOP4 DC X'03' 78800013 DC AL3(STOP4) 78900013 DC X'FE' 79000013 DC AL3(0) 79100013 STOP5 DC X'6C' 79200013 DC AL3(STOP5) 79300013 BASE1 DC A(IECKOCTL) 79400013 L SREG,BASE1 RESTORE BASE REGISTER 79500013 DROP WREG1 79600013 LR MSREG,R1 SET UP BUFFER BASE 79700013 L RREG2,STOP4+4 ACCESS LCB ADDRESS FROM IECKOPAW 79800013 SR WREG1,WREG1 CLEAR FOR LINE NUMBER 79900013 IC WREG1,LCBUCBX-LCB(RREG2) ACCESS UCB INDEX FROM LCB 80000013 LA WREG1,1(WREG1) BUMP TO RELATIVE LINE NUMBER 80100013 STC WREG1,HDSTRT STORE LINE NUMBER IN BUFFER 80200013 CLI LCBSTATE-LCB(RREG2),0 IS THE LCB ACTIVE 80300013 BE BUILD2 BRANCH IF NO TO PUT LCB IN TIMEQ 80400013 MVI SW1,1 SET INTREL CONTROL SWITCH 80500013 B GENSTCB BRANCH TO STOP THE LINE 80600013 SPACE 1 80700013 IECKNTRL EQU STOP4 A BUFFER WILL BE POSTED TO THIS 80800013 * QUEUE BY IECKOPAW TO RETURN THE 80900013 * LCB TO THE TIME QUEUE 81000013 EJECT 81100013 DEBEXT EQU 16 OFFSET TO NUMBER OF EXTENTS IN DEB 81200013 DEBUCBAD EQU 32 OFFSET TO UCB IN THE DEB 81300013 DCBLCBAD EQU 32 OFFSET TO LCB ADDRESS IN DCB 81400013 DCBEIOBX EQU 36 OFFSET TO SIZE OF LCB IN DCB 81500013 DCBDEBAD EQU 44 OFFSET TO DEB ADDRESS IN DCB 81600013 DCBOFLGS EQU 48 OFFSET TO FLAGS FIELD IN DCB 81700013 DCBCPOLL EQU 56 OFFSET TO CPOLL IN DCB A52229 81750021 QPOST EQU 67 81800013 TIMENT EQU 308 OFFSET FROM LPS QUEUE FOR TIME ENTRY 81900013 POST EQU X'82' OFFSET TO POST IN IECKQQ01 82000013 DISPATCH EQU X'F8' OFFSET TO DISPATCH IN IECKQQ01 82100013 READY EQU X'50' OFFSET TO READY QUEUE IN IGG019NG 82200013 IOSSAVE EQU X'1DC' 82300013 CVTTRMTB EQU 156 OFFSET TO TERMTBL ADDRESS 22760 82350018 QQPTR DC A(0) SAVE AREA FOR IECKQQ01 POINTER 82400013 H7 DC H'7' 82500013 H16 DC H'16' 82600013 H32 DC H'32' 82700013 H56 DC H'56' 82800013 C1 DC X'20000001' 82900013 SAVEAREA DC 3F'0' ROUTINE PROVIDED SAVE AREA 83000013 AREA DC XL16'0' WORKAREA 83100013 SAVE DC 18F'0' SAVE AREA BEFORE ENTRY TO IECKQQ01 83200013 TABLE DC C'0123456789ABCDEF' TRANSLATE TABLE - HEX TO EBCDIC 83300013 ALL DC C'ALL' 83400013 * 83500013 * THE FOLLOWING TABLE IS USED FOR BOTH TRANSLATION 83600013 * AND TRANS AND TEST. CONSTANTS ARE INTERSPERSED IN 83700013 * THE TABLE. EXAMINE CAREFULLY BEFORE CHANGING. 83800013 * 83900013 TABLETRN DS 0H 84000013 H4 DC H'4' 84100013 VAR DC X'00FF' VARIABLE FIELD INDICATOR FOR SCAN 84200013 H8 DC H'8' 84300013 H14 DC H'14' 84400013 WK1 DC 2F'0' 84500013 TABLETST EQU * 84600013 MASK DC X'4040404040404040' MASK TO ENSURE UPPER CASE IN HEADER 84700013 EOBEOT DC X'2637' EOB-EOT FOR 2740-1050 OUTGOING 84800013 COPYC DC C'COPYC ' 84900013 COPYT DC C'COPYT ' 85000013 DC X'EF' 85100013 CHNGT DC C'CHNGT ' 85200013 INTERCPT DC C'INTERCPT' 85300013 DC X'2222EF' 85400013 RELEASEM DC C'RELEASEM' 85500013 DC X'EF' 85600013 INTREL DC C'INTREL ' 85700013 DC X'22222222F2F9' 85800013 STOPLN DC C'STOPLN ' 85900013 SWITCH DC C'SWITCH ' 86000013 DC X'F8F0F3' 86100013 STARTLN DC C'STARTLN ' 86200013 DC X'2222222222F522F722' 86300013 DC X'22222222222222222222F42222F6F122' 86400013 DC X'22FAFBFCFDFEFF222222222222222222' 86500013 DC X'22222222222222222222222222222222' 86600013 DC X'22222222222222222222222222222222' 86700013 DC X'22222222222222222222222222222222' 86800013 DC X'22FAFBFCFDFEFF222222222222222222' 86900013 DC X'22222222222222222222222222222222' 87000013 DC X'22222222222222222222222222222222' 87100013 DC X'F0F1F2F3F4F5F6F7F8F9222222222207' 87200013 ZERO DC X'00000000000000000000000000000000' A27860 87300019 * 87400013 EJECT 87500013 PREFIXD 87600013 EJECT 87700013 LCBD QTAM=3 87800013 SPACE 2 87900013 IECKLERB DSECT 88000013 LERBLOCK EQU IECKLERB 88100013 LERACTR DS A CUMULATIVE TRANSMISSIONS COUNTER 88200013 LERACDC DS H CUMULATIVE DATA CHECK COUNTER 88300013 LERACIR DS H CUMULATIVE INTERVENTION REQUIRED 88400013 LERACTO DS H CUMULATIVE TIMEOUT COUNTER 88500013 LERTHTR DS XL1 THRESHOLD TRANSMISSION COUNTER 88600013 LERTHDC DS XL1 THRESHOLD DATA CHECK COUNTER 88700013 LERTHIR DS XL1 THRESHOLD INTERVENTION REQUIRED 88800013 LERTHTO DS XL1 THRESHOLD TIMEOUT COUNTER 88900013 LERFLG1 DS XL1 89000013 EJECT 89100013 TERMTBLD 89200013 EJECT 89300013 QCBD 89400013 END 89500013 ./ ADD SSI=01010131,NAME=IECKONLT,SOURCE=0 TITLE 'IECKONLT-TERMINAL TEST RECOGNITION MODULE.' 00100013 *********************************************************************** 00170021 * * 00240021 *STATUS- CHANGE LEVEL= 19 JANUARY 1971 * 00310021 * 00400013 * 00500013 * FUNCTION - RECOGNIZE TERMINAL TEST ACTIVITY, CALL TERMINAL 00600013 * TEST TRANSIENT ROUTINES, CLEANUP, STOP AND 00700013 * RESTART LINE OPERATION. 00800013 * 00900013 * 01000013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM LPSTART MACRO. 01100013 * 01200013 * 01300013 * INPUT - REGISTER 1 - ADDRESS OF A PARAMETER LIST 01400013 * GENERATED BY THE LPSTART MACRO. 01500013 * REGISTER 6 - ADDRESS OF BUFFER TO BE PROCESSED. 01600013 * REGISTER 14 - RETURN ADDRESS 01700013 * 01800013 * 01900013 * OUTPUT REGISTER 0 - ADDRESS OF THE TEST ACTIVATION CODE. 02000013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST TO BE 02100013 * UTILIZED BY THE TERMINAL TEST 02200013 * TRANSIENT ROUTINES. 02300013 * REGISTER 15 - ADDRESS OF THE UNIT CONTROL BLOCK. 02400013 * 02500013 * 02600013 * EXTERNAL ROUTINES- 1. IOS SVC 0 ROUTINE (EXECUTE CHANNEL PROGRAM). 02700013 * 2. QTAM IMPLEMENTATION MODULE (IGG019NG). 02800013 * 3. SVC 10 ROUTINE (FREEMAIN). 02900013 * 4. QTAM CONTROL PROGRAM (IECKQQ01). 03000013 * 5. SVC 77 ROUTINE (TERMINAL TEST TRANSIENTS). 03100013 * 03200013 * 03300013 * EXITS- 1. RETURN TO THE ADDRESS IN REGISTER 14 IF 03400013 * MESSAGE IS NOT A TEST REQUEST. 03500013 * 2. TO BUFFER RECALL CLEANUP ROUTINE IN QTAM 03600013 * IMPLEMENTATION MODULE (IGG019NG) TO 03700013 * POST BUFFERS TO THE TEST QCB. 03800013 * 3. TO DISPATCH ROUTINE IN QTAM CONTROL 03900013 * PROGRAM (IECKQQ01) TO DISPATCH THE NEXT 04000013 * ITEM ON THE READY QUEUE. 04100013 * 4. TO THE DEFER-ENTRY ROUTINE IN QTAM CONTROL 04200013 * PROGRAM TO PLACE TEST STCB IN CHAIN 04300013 * OF LCB TO STOP THE LINE. 04400013 * 04500013 * 04600013 * INLINE ROUTINES - THE LPSTART MACRO WILL GENERATE A LINKAGE TO THE 04700013 * ON-LINE-TERMINAL TEST MODULE WHICH TEST FOR BUFFER 04730021 * TO BE POSTED TO A ONLT QCB OR ONLT IN OPERATION. IF 04760021 * NOT, LCBSTATE IS TESTED FOR SENDING. IF THE LINE IS 04790021 * SENDING, RETURN IS MADE TO LPS FOR NORMAL PROCESS- 04820021 * ING OF THE MESSAGE. IF NOT, A CHECK IS MADE FOR 04850021 * THE TEST ACTIVATION CODE. IF THE CODE IS NOT 04900013 * PRESENT, NORMAL OPERATION OF LPS WILL CONTINUE. 05000013 * IF THE TEST ACTIVATION CODE IS PRESENT, THE 05100013 * BUFFERS ASSOCIATED WITH THE LINE OPERATION ARE 05200013 * POSTED TO A TEST QUEUE CONTROL BLOCK. THE SUBTASK 05300013 * ACTIVATED WILL SET TEST IDENTIFICATION FLAGS IN 05400013 * THE BUFFER PREFIX CONTAINING THE TEST REQUEST AND 05500013 * POST IT TO THE LPS QUEUE. SUBSEQUENT BUFFERS WILL 05600013 * BE POSTED TO THE AVAILABLE BUFFER QUEUE. (TERMINAL 05700013 * TESTS WILL UTILIZE ONLY THE BUFFER CONTAINING THE 05800013 * HEADER SEGMENT.) 05900013 * THE TEST IDENTIFICATION FLAGS WILL BE RECOGNIZED 06000013 * AT ENTRY TO THE MODULE AND THE TERMINAL TEST 06100013 * TRANSIENT ROUTINES WILL BE CALLED. THESE ROUTINES 06200013 * WILL VALIDATE THE TEST REQUEST AND SET UP THE 06300013 * APPROPRIATE TEST. 06400013 * THE BUFFER WILL THEN BE POSTED TO ANOTHER TEST 06500013 * QUEUE CONTROL BLOCK. THE SUBTASK ACTIVATED WILL 06600013 * STOP THE LINE TO BE UTILIZED BY THE TERMINAL TESTS 06700013 * BY PLACING A TEST SUBTASK CONTROL BLOCK IN THE 06800013 * STCB CHAIN OF THE APPROPRIATE LCB. 06900013 * AFTER THE LINE OPERATION HAS BEEN STOPPED, 07000013 * FURTHER IDENTIFICATION FLAGS ARE SET IN THE BUFFER 07100013 * PREFIX AND AGAIN IT IS POSTED TO THE LPS QUEUE. 07200013 * THESE FLAGS ARE RECOGNIZED AT ENTRY INTO THE 07300013 * MODULE AND THE TEST MESSAGE IS SENT TO THE 07400013 * TERMINAL. 07500013 * UPON COMPLETION OF THE TEST MESSAGE TRANSMISSION, 07600013 * THE LINE END APPENDAGE WILL POST THE BUFFER TO 07700013 * THE LPS QUEUE. ALL AREAS AND BUFFERS UTILIZED BY 07800013 * THE TERMINAL TESTS WILL THEN BE FREED AND QTAM 07900013 * LINE OPERATION WILL BE RESTARTED ON THE SUBJECT 08000013 * LINE. 08100013 * 08200013 * IF A TEST MESSAGE IS TO BE RETURNED TO THE 08300013 * REQUESTING TERMINAL ON A DIAL LINE, THE TRANSIENT 08400013 * ROUTINES ARE CALLED IMMEDIATELY UPON RECOGNITION 08500013 * OF THE TEST ACTIVATION CODE. THE TEST MESSAGE IS 08600013 * THEN SENT TO THE TERMINAL WITHOUT UTILZING THE 08700013 * STOP LINE SUBTASK. BUFFERS ARE RELEASED TO THE 08800013 * AVAILABLE BUFFER QUEUE BY THE BUFFER ROUTING 08900013 * SUBTASK. 09000013 * 09100013 * A SUBROUTINE LINKS BUFFERS TO THE READY QUEUE. 09200013 * 09300013 * 09400013 * ATTRIBUTES - THIS ROUTINE IS SERIALLY REUSABLE. 09500013 * 09600013 * 09700013 EJECT 09800013 IECKONLT START 09900013 *3410151000,157000-158000 20180 09930017 *3410193500-194000 00PS 09960017 *0301151500 00PS 09970017 *0340309000 00PS 09980017 *1201175000,192600,210000,366000,368000,370000 21843 09990018 * 350200-351800,354100-354600,358300-363700 00PS 09995018 * 195470-194920,199000,202200-202800 A26033 09996019 * 197200-197800,205000-206000 A27528 09997019 * 146300-146600 A29191 09997719 * 197600-197800,205000-206000 A26033 09998419 * 199000,202200-202800,228000 A27528 09999119 *A001700-003100-048500 S21016 09999521 *A239000,241300-241600 A43634 09999721 * 10000013 * 10100013 IOREG EQU 0 DATA AREA POINTER 10200013 FREG EQU 1 ELEMENT ADDRESS 10300013 IOBREG EQU 1 IOB ADDRESS FOR EXCP 10400013 TREG EQU 2 QCB ADDRESS 10500013 Y EQU 3 BASE FOR DCB 10600013 LCBREG EQU 4 LCB ADDRESS 10700013 SPREG EQU 5 SCAN POINTER 10800013 WREG3 EQU 5 WORK REGISTER 10900013 X EQU 6 TEMP. REG FOR DCB OR 1ST LCB BASE 11000013 MSREG EQU 6 BUFFER ADDRESS 11100013 LGREG EQU 7 BASE FOR USER'S LPS PROGRAM 11200013 SUBASE EQU 7 SUBTASK BASE REGISTER 11300013 BASEREG EQU 8 MODULE BASE REGISTER 11400013 QREG EQU 9 BASE FOR QCB 11500013 WREG1 EQU 9 WORK REGISTER 11600013 WREG2 EQU 10 WORK REGISTER 11700013 TCBREG EQU 10 BASE FOR TASK CONTROL BLOCK 11800013 EOSREG EQU 11 END OF SEGMENT ADDRESS 11900013 BREG EQU 12 BASE FOR IECKQQ01 12000013 Z EQU 13 BASE FOR IGG019NG 12100013 LNKRG2 EQU 14 LINKAGE REGISTER 12200013 RREG1 EQU 14 RETURN REGISTER 12300013 UCBREG EQU 15 UCB ADDRESS REGISTER 12400013 SREG EQU 15 LINK OUT REGISTER 12500013 QWAIT EQU 65 QTAM WAIT SVC 12600013 QPOST EQU 67 QTAM POST SVC 12700013 TESTFLAG EQU X'FF' TERMINAL TEST FLAGS 12800013 SWITCHON EQU X'01' TERMINAL TEST SWITCH ON INDICATOR 12900013 CLRBYTE EQU X'00' CLEAR FIELD 13000013 BCDZERO EQU X'15' ZERO IN LINE CODE 13100013 USING SVCBASE+2,BREG 13200013 USING IHADCB,Y 13300013 USING QBLOCK,QREG 13400013 USING TBLOCK,TREG 13500013 USING IECKLCB0,LCBREG 13600013 USING IECKPREF,FREG 13700013 USING ONLTBUF,MSREG 13800013 USING IGG019NG,Z 13900013 EJECT 14000013 * 14100013 * RECOGNITION OF TERMINAL TEST ACTIVITY AND OPERATING FLAGS 14200013 * 14300013 STM RREG1,BREG,12(Z) SAVE REGISTERS 14400013 BALR BASEREG,0 LOAD BASE REGISTER 14500013 USING *,BASEREG 14600013 TM SAVE,X'21' IS THIS A HEADER OR AFTER EOB A29191 14630019 BNZ TESTBFR BRANCH IF NO A29191 14660019 CLC TESTACTV(3),INTTFLAG BUFFER TO BE POSTED TO ONLTTQCB? 14700013 BNE TESTSEND BRANCH IF NO 14800013 CALLTRAN MVI FLAGBYTE,TESTFLAG SET TERM. TEST OPERATING FLAGS 14900013 ST MSREG,ECBADDR SAVE BUFFER ADDRESS 15000013 L WREG1,ADDRSAVE LOAD ADDRESS OF ACTIVATION CODE 20180 15100017 LR IOREG,WREG1 LOAD R0 FOR SVC 00PS 15150017 LA FREG,PARMLIST LOAD ADDRESS OF PARAMETER LIST 15200013 SVC 77 CALL TERMINAL TEST TRANSIENT 15300013 * 15400013 * RETURN FROM TRANSIENT ROUTINES 15500013 * 15600013 SR WREG1,MSREG OFFSET TO FIRST DATA POSITION 20180 15700017 STH WREG1,CHARCNT SAVE OFFSET 20180 15800017 TM NOTEST,SWITCHON CHECK FOR TEST INITALIZED 15900013 BO CLEANUP ONE MEANS TEST NOT SET UP 16000013 TM ANSWTEST,SWITCHON TEST FOR DIAL ANSWER 16100013 BZ SETPOST ZERO MEANS NOT ANSWER 16200013 NI ANSWTEST,CLRBYTE CLEAR ANSWER SWITCH 16300013 MVI DEVICETP,TESTFLAG SET ANSWER INDICATOR IN BUFFER 16400013 B SENDMSG GO TO SEND MESSAGE 16500013 * 16600013 SETPOST LR FREG,MSREG LOAD BUFFER ADDRESS 16700013 LA TREG,ONLTTQCB LOAD ADDRESS OF TERMINAL TESTQCB 16800013 POSTELEM SVC QPOST POST BUFFER TO QCB 16900013 MVI NOTEST,CLRBYTE CLEAR THE NO TEST SWITCH 17000013 L SREG,0(Z) GET ADDRESS OF IGG019NG 17100013 B 232(SREG) GO TO LPS CONTROL ROUTINE 17200013 * 17300013 TESTSEND CLI FLAGBYTE,TESTFLAG TEST FOR TERM. TEST OPERATING 17400013 BNE SENDTEST BRANCH IF NO 21843 17500018 TM LINEFREE,TESTFLAG CHECK FOR DIAL CLEANUP 17600013 BO CLEANUP ONE MEANS CLEANUP 17700013 TM LCBCPA,TESTFLAG TEST FOR TEST MESSAGE COMPLETION 17800013 BO CLEANUP 17900013 * 18000013 * SEND TEST MESSAGE 18100013 * 18200013 SENDMSG LA IOBREG,LCBFLAG1 LOAD IOB ADDRESS 18300013 L WREG1,CCWAREA LOAD ADDRESS OF STCB + CCW AREA 18400013 LA WREG1,24(WREG1) POINT TO ACTUAL CCWS 18500013 ST WREG1,LCBSTART-1 POINT LCB TO TEST CCWS 18600013 ST MSREG,LCBCPA+4 SAVE BUFFER ADDR. FOR LINE END 18700013 MVI LCBCPA,TESTFLAG SET SWITCH FOR LINE END 18800013 EXCP (1) SEND TEST MESSAGE 18900013 B POSTELEM+2 RETURN TO LPS CONTROL ROUTINE 19000013 * 19100013 * TEST FOR ACTIVATION CODE 19200013 SENDTEST TM LCBSTATE,X'04' IS TERMINAL SENDING 21843 19230018 BO RET RETURN IF SENDING 21843 19260018 * 19300013 SR WREG1,WREG1 00PS 19450015 L Y,LCBDCBPT GET DCB ADDRESS A26033 19457019 IC WREG1,LCBUCBX INSERT UCB INDEX A26033 19464019 L UCBREG,DCBDEBAD LOAD DEB ADDRESS A26033 19471019 SLL WREG1,2 MULTIPLY INDEX BY 4 A26033 19478019 L UCBREG,32(WREG1,UCBREG) LOAD UCB ADDRESS A26033 19485019 NEXTEST SR WREG1,WREG1 CLEAR REGISTER A26033 19492019 IC WREG1,0(FREG) INSERT OFFSET TO INPUT DATA 19500013 AR WREG1,SPREG ADD SCAN POINTER 19600013 LA WREG2,5 LOAD COMPARE COUNT 19700013 CLI 0(FREG),X'01' 2740 BASIC ONLT CODE A27528 19720019 BNE COMPACT CONTINUE IF NOT EQUAL A27528 19740019 TM 17(UCBREG),X'40' AUTOPOLL TERMINAL A26033 19760019 BO INCR IF YES, USE CODE OF 2 A26033 19780019 COMPACT CLC 1(1,FREG),0(WREG1) COMPARE FOR ACTIVATION CODE 19800013 BNE T2740 IF NOT, CHECK FOR 2740 BASIC A27528 19900019 LA WREG1,1(WREG1) POINT TO NEXT DATA CHARACTER 20000013 BCT WREG2,COMPACT TO TO COMPARE NEXT CHARACTER 20100013 B REQFOUND BRANCH TO PROCESS REQUEST 20200013 T2740 TM 16(UCBREG),X'04' TEST FOR 2740 127528 20220019 BZ TESTLAST CONTINUE IF NOT 2740 A27528 20240019 TM 17(UCBREG),X'DC' BASIC OR CHECKING TERMINAL A27528 20260019 BZ TESTBFR YES, NOT ONLT MESSAGE A27528 20280019 TESTLAST CLI 2(FREG),TESTFLAG CHECK FOR LAST ENTRY 20300013 BE TESTBFR BRANCH IF LAST ENTRY 20400013 INCR LA FREG,2(FREG) GET NEXT LIST ENTRY A26033 20500019 B NEXTEST TRY NEXT ENTRY A26033 20600019 * 20700013 TESTBFR CLC LCBDESTQ,TSTQCBAD TEST FOR TERMINAL TEST BUFFERS 20800013 BE EXEOB GO TO EOB MACRO 20900013 RET LM RREG1,BREG,12(Z) RESTORE REGISTERS 21000018 BR RREG1 RETURN TO LPS 21100013 * 21200013 REQFOUND SH WREG1,=X'0005' BACK UP POINTER TO FIRST NINE 21300013 CR SPREG,EOSREG 21400013 BE RET RETURN IF NINES ARE PAST END 21460018 * OF BUFFER 21520018 ST WREG1,ADDRSAVE SAVE FOR TRANSIENT ROUTINES 21600013 SR EOSREG,WREG1 GET CHARACTER COUNT 21700013 LA EOSREG,1(EOSREG) SET CORRECT COUNT 21800013 STH EOSREG,CHARCNT SAVE COUNT IN PREFIX 21900013 * 22000013 CLI 5(WREG1),BCDZERO TEST FOR FORMAT ZERO 22100013 BNE LOADDESQ NO, NOT FORMAT ZERO TEST 22200018 * 22400013 CHECKLST TM 16(UCBREG),X'04' TEST FOR 2740 TERMINAL A27528 22800019 BZ TESTDIAL BRANCH IF NOT 2740 23200013 TM 17(UCBREG),X'DC' TEST FOR BASIC 2740 23300013 BZ CHECKEOM BRANCH IF BASIC 2740 23400018 TESTDIAL TM 17(UCBREG),X'D0' TEST FOR DIAL LINE 23600013 BZ LOADDESQ BRANCH IF NOT DIAL 23700013 CHECKEOM TM SAVE,X'02' TEST FOR EOM IN FIRST BUFFER 23800013 BZ ERRPOST POST MESSAGE TO ERROR QUEUE A43634 23900021 OI ANSWTEST,SWITCHON SET ANSWER SWITCH 24000013 B CALLTRAN BRANCH TO CALL TRANSIENTS 24100013 ERRPOST XC CHARCNT(2),CHARCNT ZERO TTDKEY WHEN POSTIN TO A43634 24130021 B BFRPOST ERROR QUEUE A43634 24160021 * 24200013 LOADDESQ MVC LCBDESTQ,TSTQCBAD MOVE ADDRESS OF TEST QCB 24300013 EXEOB EQU * 24400013 EOB SEND RESPONSE IF REQUIRED 24500013 BFRPOST L SREG,0(Z) LOAD IGG019NG FIXED CODE ADDRESS 24600013 B 244(SREG) GO TO POST BUFFER TO TEST QCB 24700013 EJECT 24800013 * 24900013 * ROUTINE TO CLEANUP TERMINAL TEST AREAS 25000013 * 25100013 CLEANUP TM BYTE1030,TESTFLAG TEST FOR 1030 MESSAGE SWITCH 25200013 BZ CHKAREA ZERO MEANS NOT 1030 MSG. SWITCH 25300013 L 1,ADDR1030 LOAD 1030 DATA ADDRESS 25400013 SR 0,0 CLEAR REGISTER 25500013 IC 0,BYTE1030 INSERT AREA COUNT 25600013 B FREECORE GO TO FREE AREA VIA FREEMAIN 25700013 * 25800013 CHKAREA TM DISPLACE,TESTFLAG TEST FOR AREA IN USE 25900013 BZ FREECCWS ZERO MEANS AREA NOT IN USE 26000013 SR WREG1,WREG1 CLEAR REGISTER 26100013 IC WREG1,DISPLACE INSERT PATTERN SELECT OFFSET 26200013 A WREG1,PATRNLST ADD POINTER TO HEAD OF LIST 26300013 SR WREG2,WREG2 CLEAR REGISTER 26400013 IC WREG2,0(WREG1) INSERT PATTERN USAGE COUNT 26500013 SH WREG2,=X'0001' DECREMENT USAGE COUNT 26600013 STC WREG2,0(WREG1) STORE CORRECT COUNT BACK 26700013 BNZ FREECCWS BRANCH IF AREA STILL IN USE 26800013 SR 0,0 CLEAR REGISTER 26900013 L 1,0(WREG1) LOAD PATTERN ADDRESS 27000013 IC 0,0(1) INSERT COUNT FOR FREEMAIN 27100013 FREECORE LA 1,0(1) CLEAR HIGH ORDER BYTE 27200013 FREEMAIN R,LV=(0),A=(1) FREE PATTERN AREA 27300013 * 27400013 * FREE CCW AREA 27500013 * 27600013 FREECCWS TM CCWBYTES,TESTFLAG TEST FOR CCW LOADED 27700013 BZ AVAILBFR ZERO MEANS NO CCWS 27800013 L 1,CCWAREA LOAD CCW AREA ADDRESS 27900013 SR 0,0 CLEAR REGISTER 28000013 IC 0,CCWBYTES INSERT COUNT FOR CCWS 28100013 FREEMAIN R,LV=(0),A=(1) FREE CCW AREA 28200013 * 28300013 * POST BUFFER TO AVAILABLE BUFFER QUEUE 28400013 * 28500013 AVAILBFR MVI FLAGBYTE,CLRBYTE CLEAR TERMINAL TEST FLAG 28600013 LR WREG1,MSREG LOAD BUFFER ADDRESS 28700013 AH WREG1,CHARCNT ADD OFFSET TO FIRST DATA CHAR. 28800013 MVI 1(WREG1),CLRBYTE DISABLE ACTIVATION CODE 28900013 TM ANSWTEST,SWITCHON TEST FOR ANSWER LIST SWITCH ON 29000013 BO CLRSW ONE MEANS SWITCH ON 29100013 TM DEVICETP,TESTFLAG TEST FOR ANSWER MESSAGE COMPLETE 29200013 BO LOADDESQ ONE MEANS MESSAGE COMPLETE 29300013 L TREG,0(Z) GET ADDR. OF IGG019NG FIXED CODE 29400013 LA TREG,24(TREG) GET ADDR. OF AVAILABLE BUFFER Q 29500013 LR FREG,MSREG LOAD BUFFER ADDRESS 29600013 SVC QPOST POST BUFFER TO AVAILABLE BFR. Q 29700013 * 29800013 SPACE 3 29900013 * 30000013 * FREE LINE 30100013 * 30200013 TM NOTEST,SWITCHON CHECK FOR TEST NOT SET UP 30300013 BO POSTELEM+2 ONE MEANS TEST NOT SET UP 30400013 TM LINEFREE,TESTFLAG TEST FOR FREE LINE FLAGS 30500013 BO POSTELEM+2 BRANCH IF LINE FREE 30600013 MVI LCBCPA,CLRBYTE CLEAR TERMINAL TEST APP. FLAG 30700013 NI LCBINCAM,X'FC' CLEAR LCB FLAGS 30800013 LR TREG,LCBREG GET LCB ADDRESS 00PS 30900017 LA TREG,0(TREG) CLEAR HIGH ORDER BYTE 31000013 LR FREG,TREG LCB ADDRESS TO FREG 31100013 B POSTELEM POST LCB TO ITSELF TO FREE LINE 31200013 * 31300013 CLRSW NI ANSWTEST,CLRBYTE CLEAR SWITCH 31400013 MVI LCBCPA,CLRBYTE CLEAR TERMINAL TEST APP. FLAG 31500013 MVI DEVICETP,TESTFLAG INDICATE MESSAGE COMPLETE 31600013 B LOADDESQ GO TO RELEASE BUFFERS 31700013 * 31800013 * 31900013 EJECT 32000013 * 32100013 * TERMINAL TEST QUEUE CONTROL BLOCK FOR STOP LINE 32200013 * 32300013 DS 0F 32400013 USING *,SUBASE 32500013 ONLTTQCB EQU * 32600013 DC X'01' QUEUE STATUS-INITALLY WAITING 32700013 DC AL3(TERMINAT) ELEMENT CHAIN POINTER 32800013 DC X'E4' READY QUEUE PRIORITY 32900013 DC AL3(0) NEXT QCB ADDRESS 33000013 STCBLNK DC X'00' FILLER BYTE 33100013 DC AL3(STCBKEY) LINK FOR STCB 33200013 * 33300013 * 33400013 * SUBTASK CONTROL BLOCK FOR TERMINAL TESTS 33500013 * 33600013 STCBKEY DC X'6C' OFFSET FOR DISPATCH 33700013 DC AL3(0) 33800013 DC X'E0' SUBTASK PRIORITY 33900013 DC AL3(TERMSTCB) LINK TO TERMINATING STCB 34000013 * 34100013 * TERMINAL TEST STOP LINE SUBTASK 34200013 * 34300013 * 34400013 LR SUBASE,TREG LOAD STCB ADDRESS 34500013 LA WREG1,12 LOAD CONSTANT OF 12 34600013 SR SUBASE,WREG1 ADJUST BASE REGISTER 34700013 PROCBFR LR MSREG,FREG ESTABLISH BUFFER BASE 34800013 L TREG,LCBADDR LOAD LCB ADDRESS 34900013 TM FEATURES,X'90' TEST FOR DIAL 35000013 BNZ CHEKDIAL BRANCH IF DIAL LINE 00PS 35030018 CLI LCBCPA-LCB+16(TREG),X'04' IS THIS SENSE COMMAND 00PS 35060018 * (2740 BASIC OR WITH CHECKING) 00PS 35090018 BNE LOADQUAD NOT DIAL OR 2740 BASIC 00PS 35120018 CLI LCBCPA-LCB+21(TREG),X'00' IF TP OP CODE=00, LINE 00PS 35150018 * IS BUSY, NO HIO ISSUED. 35180018 BE LOADQUAD 2740 IS BUSY - NO HIO 00PS 35210018 B HIOLOOP 00PS 35240018 CHEKDIAL EQU * 35270018 TM LCBINCAM-LCB(TREG),X'02' TEST FOR LINE AVAILABLE 35300013 BZ LINEAVAL ZERO MEANS LINE AVAILABLE 35400013 CLI LCBCPA-LCB+32(TREG),4 SENSE COMMAND FOR 2740 00PS 35410018 * BASIC DIAL 00PS 35420018 BNE LINEUSE BRANCH IF NOT 00PS 35430018 CLI LCBCPA-LCB+37(TREG),0 IF TP CODE=0, LINE IS BUSY 00PS 35440018 * IF NOT 0, DO HIO 00PS 35450018 BNE LINEAVAL 2740 NOT BUSY - DO HIO 00PS 35460018 LINEUSE MVI LINEFREE,X'FF' INDICATE LINE NOT FREE 35500013 BAL RREG1,RDYQLINK PLACE BUFFER ON READY QUEUE 35600013 B DISPATCH DISPATCH READY QUEUE ITEM 35700013 * 35800013 SAVEAREA DC 8F'0' 00PS 35830018 UCBFLAGS EQU 6 00PS 35860018 UCBRQEAD EQU 20 00PS 35890018 CVT EQU 16 00PS 35920018 CVTIXAVL EQU 124 00PS 35950018 HIORTN EQU 8 00PS 35980018 WREG8 EQU 8 00PS 36010018 LINEAVAL OI LCBINCAM-LCB(TREG),7 SET SO LINE WILL BE REDIALED00PS 36040018 HIOLOOP NI LCBFLAG1-LCB(TREG),X'DB' TURN OFF ERP FLAGS 00PS 36070018 MVI LCBECBPT-LCB(TREG),X'48' SET HIO FLAG FOR LINE-END 00PS 36100018 L UCBREG,UCBADDR LOAD UCB ADDRESS 00PS 36130018 IC WREG1,UCBFLAGS(UCBREG) SAVE UCBFLAG STATUS 00PS 36160018 STM 8,15,SAVEAREA SAVE REGISTERS FOR HIO 00PS 36190018 LR WREG8,UCBREG UCB ADDRESS TO REG 8 00PS 36220018 L WREG2,CVT LOAD CVT ADDRESS 00PS 36250018 L WREG2,CVTIXAVL(WREG2) PARAMETER LIST ADDRESS 00PS 36280018 L WREG2,HIORTN(WREG2) HALT I/O ROUTINE ADDRESS 00PS 36310018 BALR UCBREG,WREG2 LINK TO HALT I/O ROUTINE 00PS 36340018 LM 8,15,SAVEAREA RESTORE REGISTERS 00PS 36370018 STC WREG1,UCBFLAGS(UCBREG) RESTORE UCBFLAG STATUS 00PS 36400018 LOADQUAD L WREG3,CCWAREA LOAD SAVE ADDRESS FOR SUBTASK 36500013 TM LCBSTATE-LCB(TREG),X'08' TEST FOR LINE RECEIVING 21843 36600018 BZ MOVESTCB ZERO MEANS NOT RECEIVING 36700013 TM LCBFLAG2-LCB(TREG),X'01' TEST FOR AUTOPOLL 21843 36800018 BZ *+8 ZERO MEANS NOT AUTOPOLL 36900013 MVI LCBCPA+40-LCB(TREG),X'03' NO-OP AUTOPOLL TIC 21843 37000018 MOVESTCB MVC 0(24,WREG3),STPLSTCB MOVE STCB 37100013 ST MSREG,16(WREG3) SAVE BUFFER ADDRESS 37200013 ST SUBASE,20(WREG3) SAVE SUBTASK BASE REGISTER 37300013 LR FREG,WREG3 PUT ELEMENT ADDRESS IN REG 1 37380018 LA QREG,LCBSCHAD-LCB(TREG) POINT TO BEGINNING OF 37460018 * LCB SUBTASK CHAIN 37540018 B PRIORITY GO TO PUT ELEMENT AS A SUBTASK 37620018 * IN THE LCB SUBTASK CHAIN 37700018 * 37800013 POSTLPS L FREG,0(MSREG) LOAD BUFFER ADDRESS 37900013 LR MSREG,FREG LOAD BUFFER ADDRESS 38000013 L LCBREG,LCBADDR ESTABLISH LCB BASE 38100013 MVC LCBSCHAD+1(3),5(TREG) REMOVE TEST STCB FROM LCB CHAIN 38200013 MVI LCBSTATE,X'08' 38300013 MVC READY+1(3),LCBRCADD 38400013 BAL RREG1,RDYQLINK PLACE BUFFER ON READY QUEUE 38500013 CLC ONLTTQCB+1(3),TERMADDR IS ANOTHER BUFFER IN QCB CHAIN 38600013 BE DISPATCH EQUAL MEANS NO OTHER BUFFER 38700013 L FREG,ONLTTQCB LOAD NEXT BUFFER ADDRESS 38800013 LA FREG,0(FREG) CLEAR HIGH ORDER BYTE 38900013 MVC ONLTTQCB+1(3),5(FREG) REMOVE BUFFER FROM ELEMENT CHAIN 39000013 B PROCBFR GO TO PROCESS BUFFER 39100013 * 39200013 RDYQLINK LA FREG,0(FREG) CLEAR HIGH ORDER BYTE 39300013 L QREG,0(13) LOAD ADDRESS OF LPS QCB 39400013 ST QREG,FKEY STORE LPS QCB ADDR. IN ELEMENT 39500013 LA QREG,READY POINT TO HEAD OF READY QUEUE 39600013 MVC FLINK,QFAC LINK ADDR. OF OLD ITEM TO NEW 39700013 IC WREG3,QFAC-1 SAVE BYTE OF OLD LINK FIELD 39800013 ST FREG,QFAC-1 NEW ITEM ADDRESS TO OLD 39900013 STC WREG3,QFAC-1 RESTORE BYTE OF OLD LINK FIELD 40000013 BR RREG1 RETURN TO CALLER 40100013 * 40200013 TERMADDR DC AL3(TERMINAT) ADDRESS OF TERMINATING ELEMENT 40300013 * 40400013 * 40500013 * STCB UTILIZED TO STOP AN INDIVIDUAL LINE 40600013 * 40700013 DS 0F 40800013 USING *,TREG 40900013 STPLSTCB DC X'6C' OFFSET FOR DISPATCH 41000013 DC AL3(0) 41100013 DC X'E0' SUBTASK PRIORITY 41200013 DC AL3(TERMSTCB) LINK TO TERMINATING STCB 41300013 L SUBASE,BASEADDR LOAD BASE FOR RETURN TO SUBTASK 41400013 BAL MSREG,POSTLPS-ONLTTQCB(0,SUBASE) BRANCH TO SUBTASK 41500013 DC A(0) BUFFER ADDRESS 41600013 BASEADDR DC A(0) SUBTASK BASE ADDRSSS 41700013 DROP TREG 41800013 * 41900013 DS 0F 42000013 TERMINAT DC F'0' TERMINATING 42100013 DC X'FF' ELEMENT 42200013 DC AL3(TERMINAT) CONTROL BLOCK 42300013 * 42400013 * 42500013 * 42600013 TERMSTCB DC X'02' TERMINATING 42700013 DC FL4'255' SUBTASK 42800013 B PRIORITY CONTROL BLOCK 42900013 DROP SUBASE 43000013 * 43100013 EJECT 43200013 * 43300013 * QUEUE CONTROL BLOCK FOR TERMINAL TESTS- BUFFER ROUTING 43400013 * 43500013 DS 0F 43600013 TESTQCB EQU * 43700013 KEY DC X'01' QUEUE STATUS-INITIALLY WAITING 43800013 ELEMPTR DC AL3(ELEMTERM) ELEMENT CHAIN POINTER 43900013 PRIOR DC X'E4' READY QUEUE PRIORITY 44000013 QCBLINK DC AL3(0) NEXT QCB ADDRESS 44100013 STCBLINK DC X'00' FILLER BYTE 44200013 DC AL3(TESTSTCB) LINK FOR STCB 44300013 * 44400013 ORG TESTQCB+25 44500013 QSOURCE DC AL3(0) ADDR OF FIRST LCB IN CHAIN 44600013 DS XL4 44700013 * 44800013 DS 0F 44900013 ELEMTERM DC F'0' TERMINATING 45000013 DC X'FF' ELEMENT 45100013 DC AL3(ELEMTERM) CONTROL BLOCK 45200013 * 45300013 USING *,SUBASE 45400013 * 45500013 TESTSTCB DC X'02' OFFSET FOR DISPATCH 45600013 DC FL4'255' 45700013 * 45800013 * TERMINAL TEST BUFFER ROUTING SUBTASK 45900013 * 46000013 LR SUBASE,TREG ESTABLISH BASE REGISTER 46100013 L TREG,0(13) ADDR. OF IGG019NG FIXED CODE 46200013 TM MSDLINK,X'FF' TEST FOR DIAL ROUTING 46300013 BO *+12 BRANCH IF DIAL 46400013 TM MSTATUS,X'01' TEST FOR HEADER SEGMENT 46500013 BZ LPSPOST GO TO POST BUFFER TO LPS QUEUE 46600013 MVI MSDLINK,CLRBYTE CLEAR DIAL INDICATOR 46700013 LA TREG,24(TREG) ADDR. OF AVAILABLE BUFFER QUEUE 46800013 B POST POST BUFFER TO AVAILABLE BUFFERQ 46900013 * 47000013 LPSPOST MVC MSLINK,INTTFLAG SET TERMINAL TEST SWITCH FOR LPS 47100013 MVI MSTATUS,CLRBYTE CLEAR MESSAGE STATUS 47200013 MVI FPRI,X'E0' SET PRIORITY FOR POST 47250018 B POST POST BUFFER TO LPS QUEUE 47300013 DROP SUBASE 47400013 TSTQCBAD DC AL3(TESTQCB) 47500013 INTTFLAG DC X'FFFFFF' INITIATE TEST FLAGS 47600013 EJECT 47700013 * 47800013 * PARAMETER LIST TO BE PASSED TO TRANSIENT ROUTINES 47900013 * 48000013 DS 0D 48100013 DC A(*+8) ADDRESS OF EP PARAMETER 48200013 DC A(0) DCB PARAMETER 48300013 DS 1D EP PARAMETER 48400013 PARMLIST EQU * 48500013 ECBADDR DC A(0) ELEMENT CONTROL BLOCK ADDRESS 48600013 PATRNLST DC A(PATNAME) ADDRESS OF PATTERN LIST 48700013 DC A(CRIDLES) ADDRESS OF CR & IDLES 48800013 NOTEST DC X'00' NO TEST SWITCH 48900013 ANSWTEST DC X'00' ANSWER LIST SWITCH 49000013 * 49100013 * SPECIAL CHARACTERS AND PARAMETERS 49200013 * 49300013 GETMAIN1 DC A(0) LENGTH FOR GETMAIN MACRO 49400013 DC A(0) ADDR. OF ADDR. LIST 49500013 DC X'20FA' 49600013 CRIDLES DC X'16' TERMINAL TEST 49700013 DC 3XL1'DF' LINE 49800013 DC X'5B' INITIALIZATION 49900013 DC 15XL1'DF' CHARACTERS 50000013 DC X'161F1F1F' CIRCLE D AND CIRCLE C'S 50100013 DC X'761F1F1F37' CIRCLE Y,CIRCLE C'S AND CIRCLE S 50200013 * 50300013 EJECT 50400013 * 50500013 * ADDRESS OF GETMAIN PARAMETERS AND TERMINAL TEST PATTERN TABLE 50600013 * 50700013 DS 0F 50800013 PATNAME EQU * 50900013 DC A(GETMAIN1) ADDRESS OF GETMAIN PARAMETERS 51000013 BTTP5TLT DC X'00' 1050 TILT PATTERN USAGE COUNT 51100013 BTTA5TLT DC AL3(0) 1050 TILT ADDRESS 51200013 BTTP5ROT DC X'00' 1050 ROTATE PATTERN USAGE COUNT 51300013 BTTA5ROT DC AL3(0) 1050 ROTATE ADDRESS 51400013 BTTP5TWS DC X'00' 1050 TWIST PATTERN USAGE COUNT 51500013 BTTA5TWS DC AL3(0) 1050 TWIST ADDRESS 51600013 BTTP5ALC DC X'00' 1050 ALL CHARACTERS USAGE COUNT 51700013 BTTA5ALC DC AL3(0) 1050 ALL CHARACTERS ADDRESS 51800013 BTTP5SLA DC X'00' 1050 SELECTRIC ANALYZER USAGE CT 51900013 BTTA5SLA DC AL3(0) 1050 SELECTRIC ANALYZER ADDRESS 52000013 SPACE 52100013 BTTP6TLT DC X'00' 1060 TILT PATTERN USAGE COUNT 52200013 BTTA6TLT DC AL3(0) 1060 TILT ADDRESS 52300013 BTTP6ROT DC X'00' 1060 ROTATE PATTERN USAGE COUNT 52400013 BTTA6ROT DC AL3(0) 1060 ROTATE ADDRESS 52500013 BTTP6TWS DC X'00' 1060 TWIST PATTERN USAGE COUNT 52600013 BTTA6TWS DC AL3(0) 1060 TWIST ADDRESS 52700013 BTTP6ALC DC X'00' 1060 ALL CHARACTERS USAGE COUNT 52800013 BTTA6ALC DC AL3(0) 1060 ALL CHARACTERS ADDRESS 52900013 BTTP6SLA DC X'00' 1060 SELECTRIC ANALYZER USAGE COUNT 53000013 BTTA6SLA DC AL3(0) 1060 SELECTRIC ANALYZER ADDRESS 53100013 SPACE 53200013 BTTP3TLT DC X'00' 1030 TILT PATTERN USAGE COUNT 53300013 BTTA3TLT DC AL3(0) 1030 TILT ADDRESS 53400013 BTTP3ROT DC X'00' 1030 ROTATE PATTERN USAGE COUNT 53500013 BTTA3ROT DC AL3(0) 1030 ROTATE ADDRESS 53600013 BTTP3TWS DC X'00' 1030 TWIST PATTERN USAGE COUNT 53700013 BTTA3TWS DC AL3(0) 1030 TWIST ADDRESS 53800013 BTTP3ALC DC X'00' 1030 ALL CHARACTERS USAGE COUNT 53900013 BTTA3ALC DC AL3(0) 1030 ALL CHARACTERS ADDRESS 54000013 BTTP3SLA DC X'00' 1030 SELECTRIC ANALYZER USAGE COUNT 54100013 BTTA3SLA DC AL3(0) 1030 SELECTRIC ANALYZER ADDRESS 54200013 SPACE 54300013 BTTP2TLT DC X'00' 2848 TILT PATTERN USAGE COUNT 54400013 BTTA2TLT DC AL3(0) 2848 TILT ADDRESS 54500013 BTTP2ROT DC X'00' 2848 ROTATE PATTERN USAGE COUNT 54600013 BTTA2ROT DC AL3(0) 2848 ROTATE ADDRESS 54700013 BTTP2TWS DC X'00' 2848 TWIST PATTERN USAGE COUNT 54800013 BTTA2TWS DC AL3(0) 2848 TWIST ADDRESS 54900013 BTTP2ALC DC X'00' 2848 ALL CHARACTERS USAGE COUNT 55000013 BTTA2ALC DC AL3(0) 2848 ALL CHARACTERS ADDRESS 55100013 * 55200013 EJECT 55300013 * 55400013 * BUFFER PREFIX FOR ONLINE TERMINAL TESTS 55500013 * 55600013 ONLTBUF DSECT 55700013 ECB DS XL8 QTAM ELEMENT CONTROL BLOCK 55800013 CCWBYTES DS 0XL1 NUMBER OF BYTES FOR TERM TEST CHANNEL PROG 55900013 CCWAREA DS A ADDRESS OF CCW AREA 56000013 SAVE DS 0XL1 SAVE BYTE FOR MSTATUS 56100013 LCBADDR DS A LINE CONTROL BLOCK ADDRESS 56200013 TESTACTV DS 0XL3 TERMINAL TEST REQUEST FLAGS 56300013 BYTE1030 DS 0XL1 NUMBER OF BYTES FOR 1030 MESSAGE SWITCH 56400013 ADDR1030 DS 0A ADDRESS OF 1030 SWITCH AREA 56500013 DIALINFO DS XL2 ADDRESS OF COUNT DIAL DIGITS 56600013 ADDR2260 DS XL2 2260 ADDRESSING CHARACTERS 56700013 ADDRESS DS XL2 TERMINAL ADDRESSING CHARACTERS 56800013 DEVICETP DS XL1 UCB ADAPTER + MODEL FIELDS 56900013 FEATURES DS 0XL1 UCB FEATURES FIELD 57000013 RESPONSE DS XL1 RESPONSE CHARACTER-READ FROM TERMINAL 57100013 DISPLACE DS XL1 DISPLACEMENT IN PATTERN USAGE TABLE 57200013 FLAGBYTE DS XL1 TERMINAL TEST OPERATING FLAGS 57300013 CHARCNT DS XL2 CHARACTER COUNT FOR TERMINAL TESTS 57400013 ADDRSAVE DS 0A SAVE AREA FOR DATA POINTER 57500013 LINEFREE DS 0XL1 FREE LINE INDICATOR 57600013 UCBADDR DS A UCB ADDRESS 57700013 OFFSET EQU ONLTBUF+10 TERMINAL TABLE ENTRY OFFSET 57800013 * 57900013 * 58000013 EJECT 58100013 DCBD DSORG=(QX) 58200013 EJECT 58300013 LCBD QTAM=3 58400013 EJECT 58500013 TCBD 58600013 EJECT 58700013 STCBD 58800013 EJECT 58900013 QCBD 59000013 EJECT 59100013 PREFIXD 59200013 EJECT 59300013 DEB DSECT 59400013 DS XL16 59500013 DEBNMEXT DS FL1 59600013 DS 7X 59700013 DEBDCBAD DS A 59800013 DS 4X 59900013 EXT1 DS XL16 60000013 * 60100013 * 60200013 * 60300013 IGG019NG DSECT 60400013 DS XL72 60500013 QSAVE DS 0XL1 60600013 QATTACH DS XL8 60700013 READY DS XL5 60800013 DUMMY DS XL3 60900013 ORG IGG019NG+102 61000013 NRET DS XL4 61100013 USING TCB,TCBREG 61200013 USING TBLOCK,Y 61300013 SVCBASE DSECT 61400013 CTLPROGD 61500013 END 61600013 ./ ADD SSI=01010132,NAME=IECKOPAW,SOURCE=0 TITLE 'IECKOPAW OPERATOR AWARENESS' 00300013 *********************************************************************** 00600013 * * 00900013 *NAME- IECKOPAW OPERATOR AWARENESS * 01200013 * * 01500013 *STATUS- CHANGE LEVEL 000 OS QTAM III * 01800013 * * 02100013 *FUNCTION- IECKOPAW IS ENTERED FROM THE POSTSEND AND POSTRCV MACRO'S * 02400013 * WHEN OPERATOR CONTROL IS INCLUDED IN THE LPS ROUTINE. IT SENDS * 02700013 * AN I/O ERROR AND/OR A THRESHOLD MESSAGE TO THE OPERATOR CONTROL * 03000013 * TERMINAL. IF LCBCPA+28 DOES NOT CONTAIN A X'FF', AN I/O ERROR * 03300013 * MESSAGE IS NOT TO BE SENT. IF AN I/O ERROR MESSAGE IS TO BE * 03600013 * SENT, IT IS FORMATTED AS FOLLOWS- * 03900013 * * 04200013 * AAA,I/O ERR,BB,CCCC,DDDD,EE00FFFF * 04500018 * WHERE- * 04800013 * AAA = LINE NUMBER * 05100013 * BB = OP CODE * 05400013 * CCCC = STATUS HALF WORD OF LCBCCW * 05700013 * DDDD = SENSE INFORMATION * 06000013 * EE = TP OP CODE * 06300013 * FFFF = TERMINAL IDENTIFIER * 06600013 * * 06900013 * THE I/O ERROR MESSAGE IS THEN SENT TO THE OPERATOR CONTROL * 07200013 * TERMINAL. * 07500013 * IF LCB+LCBSIZE-6 CONTAINS A ZERO, NO THRESHOLD MESSAGE IS * 07800013 * TO BE SENT. IF A THRESHOLD MESSAGE IS TO BE SENT, IT IS FORMATTED* 08100013 * AS FOLLOWS- * 08400013 * * 08700013 * THRESHOLD AAA TRANS=BBB DC=CCC IR=DDD TO=EEE * 09000013 * WHERE- * 09300013 * AAA = LINE NUMBER * 09600013 * BBB = TRANSMISSION NUMBER * 09900013 * CCC = DATA CHECK COUNTER * 10200013 * DDD = INTERVENTION REQUIRED COUNTER * 10500013 * EEE = TIME OUT COUNTER * 10800013 * * 11100013 * THE MESSAGE IS THEN SENT TO THE OPERATOR CONTROL TERMINAL AND * 11400013 * CONTROL IS PASSED TO THE BUFFER RECALL CLEANUP ROUTINE OF * 11700013 * IGG019NG. * 12000013 * * 12300013 *ENTRY POINTS- IECKOPAW - CONTROL IS PASSED HERE BY A BRANCH FROM * 12600013 * THE FIXED PORTION OF IGG019NG AFTER IT IS ENTERED BY A BRANCH * 12900013 * FROM THE POSTSEND AND POSTRCV MACRO'S WHEN OPERATOR CONTROL IS * 13200013 * SPECIFIED IN THE LPS ROUTINE. * 13500013 * * 13800013 *INPUT- THE INPUT CONSISTS OF THE INFORMATION CONTAINED IN THE LCB * 14100013 * WHICH IS TO BE PLACED IN THE I/O ERROR AND THRESHOLD MESSAGES. * 14400013 * ADDITIONAL INPUT IS- * 14700013 * REGISTER 4- ADDRESS OF THE LCB. * 15000013 * REGISTER 6- ADDRESS OF THE BUFFER. * 15300013 * REGISTER 15- ENTRY POINT REGISTER. * 15600013 * * 15900013 *OUTPUT- THE I/O ERROR AND THRESHOLD MESSAGES WILL BE SENT TO THE * 16200013 * OPERATOR CONTROL TERMINAL. * 16500013 * * 16800013 *EXTERNAL ROUTINES- * 17100013 * IECKRC - BUFFER RECALL OF IGG019NG TO RECALL THE HEADER. * 17400013 * IECKPR - BUFFER CLEANUP OF IGG019NG TO SEND THE LAST MESSAGE * 17700013 * AND TO RETURN ALL BUFFERS BEFORE RETURNING TO * 18000013 * LPSTART. * 18300013 * * 18600013 *EXITS- NORMAL - EXIT IS TO BUFFER CLEANUP ROUTINE OF IGG019NG. * 18900013 * ERRORS - NONE. * 19200013 * * 19500013 *TABLES/WORKAREAS- * 19800013 * TRTABLE1 AND TRTABLE2 - TO TRANSLATE INFORMATION TO PRINTABLE* 20100013 * FORM. * 20400013 * * 20700013 *ATTRIBUTES- SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM * 21000013 * MODE. * 21300013 * * 21600013 *********************************************************************** 21900013 SPACE 2 22200013 IECKOPAW START 22500013 *3170342000 00PS 22600015 *1201603000-609000,786000,792000,805000-807000,813000-816000 18035 22660018 *1201829000-830000 18035 22720018 * 373000-377000,384000,514000-515000,562000-563000,654000, 00PS 22730018 * 804500,807000-808000,828500 00PS 22740018 * 434000-436000 24119 22750018 * 786000 18035 22760018 *A723500-725500,C726000 A52229 22780021 SPACE 2 22800013 DREG0 EQU 0 23100013 DREG1 EQU 1 23400013 KREG EQU 2 23700013 RREG2 EQU 3 24000013 LCBREG EQU 4 24300013 SPREG EQU 5 24600013 MSREG EQU 6 24900013 LGREG EQU 7 25200013 WREG1 EQU 8 25500013 WREG2 EQU 9 25800013 TCREG EQU 10 26100013 EOSREG EQU 11 26400013 WREG3 EQU 12 26700013 NGREG EQU 13 27000013 RREG1 EQU 14 27300013 SREG EQU 15 27600013 CVTABLE EQU 16 27900013 CVTTRMTB EQU 156 28200013 IDLE EQU X'17' 28500013 EOA EQU X'7B' 28800013 NEWLINE EQU X'15' 29100013 SPACE 2 29400013 USING *,SREG 29700013 USING IECKPREF,MSREG 30000013 USING IECKLCB0,LCBREG 30300013 USING IHADCB,KREG 30600013 USING IECKTERM,TCREG 30900013 USING QBLOCK,WREG2 31200013 SPACE 3 31500013 * THE FOLLOWING ROUTINE TESTS FOR AN I/O ERROR MESSAGE TO BE SENT * 31800013 * AND FORMATS THE MESSAGE. * 32100013 SPACE 3 32400013 L KREG,LCBDCBPT LOAD DCB ADDRESS 32700013 CLI LCBCPA+28,X'FF' IS AN I/O ERROR MESSAGE TO BE SENT 33000013 BNE THRESH IF NOT, GO CHECK FOR THRESHOLD MSG 33300013 BAL RREG1,RECALL GO TO RECALL A BUFFER FOR MESSAGE 33600013 MVI LCBCPA+28,X'00' CLEAR I/O ERROR INDICATION 33900013 MVC ERLINENO+1(2),LCBCPA+30 MOVE LINE NUMBER TO MESSAGE00PS 34200015 UNPK EROPCODE(3),LCBCPA+32(2) UNPACK OP CODE INTO MESSAGE 34500013 UNPK ERSTATUS(5),LCBCSW+4(3) UNPACK STATUS INTO MESSAGE 35400013 UNPK ERSENSE(5),LCBSENSE(3) UNPACK SENSE INFORMATION 36300013 UNPK ERTERMID(9),LCBRESTR(5) UNPACK TP OP CODE AND TERMID 37200013 TR EROPCODE(21),TRTABLE2 TRANSLATE TO PRINTABLE FORM 00PS 37300018 MVI EROPCODE+2,C',' CLEAR LAST NUMBER 00PS 37400018 MVI ERSTATUS+4,C',' AND INSERT 00PS 37500018 MVI ERSENSE+4,C',' PUNCTUATION FOR 00PS 37600018 MVI ERTERMID+8,C' ' PRINTABLE FORM 00PS 37700018 LA DREG1,IOERRMSG LOAD MESSAGE ADDRESS 38100013 LA WREG3,34 LOAD MSG. LENGTH 00PS 38400018 SPACE 3 38700013 * THE FOLLOWING ROUTINE SENDS THE I/O ERROR OR THRESHOLD MESSAGES * 39000013 * TO THE OPERATOR CONTROL TERMINAL IF ONE IS SPECIFIED. * 39300013 SPACE 3 39600013 SENDMSG L TCREG,CVTABLE GET CVT ADDRESS 39900013 L TCREG,CVTTRMTB(TCREG) GET TERMTBL ADDRESS 40200013 SH TCREG,FOUR GET ADDRESS OF TERMTBL-4 40500013 L WREG2,0(TCREG) GET ADDRESS OF OPCTL MACRO 40800013 LH WREG2,10(WREG2) LOAD RELATIVE OFFSET 41100013 SLL WREG2,16 CLEAR HIGH ORDER 41400013 SRL WREG2,16 HALF WORD 41700013 LR DREG0,WREG2 SAVE OFFSET 42000013 L WREG2,4(TCREG,WREG2) GET QCB ADDRESS OF OPCTL TERMINAL 42300013 L WREG1,QDCB-1 GET DCB ADDRESS OF OPCTL TERMINAL 42600013 TM DCBOFLGS-IHADCB(WREG1),X'10' HAS OPCTL TERM BEEN OPENED 42900013 BZ WTO IF NOT, DO WRITE TO OPERATOR 43200013 L WREG2,DCBCLPS-IHADCB(WREG1) GET LPS ADD. OF OPCTL 24119 43400018 LH WREG2,8(WREG2) GET NO. OF IDLES IN OPCTL LPS 24119 43600018 LA WREG2,2(WREG2) ADD TWO FOR EOA AND NEW LINE 43800013 LR RREG2,WREG2 SAVE COUNT OF IDLES 00PS 44100018 BCTR WREG2,DREG0 SUBTRACT TWO 44400013 BCTR WREG2,DREG0 FOR LOOP 44700013 LA SPREG,HDSTRT SET SCAN POINTER TO START OF 45000013 * HEADER 45300013 LTR WREG2,WREG2 IS NUMBER OF INSERTIONS ZERO 45600013 BZ NOIDLES IF YES, DO NOT INSERT IDLES 45900013 MOVEIDLE MVI 0(SPREG),IDLE INSERT IDLE CHARACTER 46200013 LA SPREG,1(SPREG) ADD ONE TO SCAN POINTER 46500013 BCT WREG2,MOVEIDLE RETURN IF ALL IDLES HAVE NOT BEEN 46800013 * MOVED 47100013 NOIDLES MVI 0(SPREG),EOA INSERT EOA CHARACTER AFTER IDLES 47400013 MVI 1(SPREG),NEWLINE INSERT NEW LINE CHARACTER AFTER EOA 47700013 LA SPREG,2(SPREG) BUMP SCAN POINTER PAST EOA AND NL 48000013 LR WREG2,SPREG LOAD SCAN POINTER INTO WORK REGISTER 48300013 L WREG1,=V(IECKBFSZ) GET ADDRESS OF BUFFER SIZE 48600013 LH WREG1,0(WREG1) GET SIZE OF BUFFER 48900013 LA WREG1,8(WREG1,MSREG) GET END OF BUFFER+1 49200013 SR WREG1,WREG2 GET SPACE REMAINING IN BUFFER 49500013 CR WREG1,WREG3 IS MESSAGE TEXT LARGER THAN 49800013 * REMAINING BUFFER 50100013 BC 12,TRUNC IF YES, GO TO TRUNCATE MESSAGE 50400013 LR WREG1,WREG3 OTHERWISE USE MESSAGE SIZE 50700013 TRUNC AR SPREG,WREG1 SET SCAN POINTER TO END OF MESSAGE 51000013 BCTR WREG1,0 REDUCE COUNT BY ONE FOR EXECUTE 51300013 AR RREG2,WREG1 ADD IDLE COUNT TO MSG LENGTH 00PS 51400018 STC RREG2,MSPTR SET MSPTR TO END OF MESSAGE 00PS 51500018 EX WREG1,MOVEMSG MOVE ERROR MESSAGE TO BUFFER 51600013 AR WREG1,WREG2 GET ADDRESS OF LAST CHARACTER OF 51900013 * MESSAGE IN BUFFER 52200013 LA WREG2,MSEGSZE-1 GET ADDRESS OF START OF PREFIX-1 52500013 SR WREG1,WREG2 GET MESSAGE SIZE 52800013 STH WREG1,MSEGSZE AND STORE IT IN PREFIX 53100013 MVI MSTATUS,70 INDICATE SINGLE SEGMENT MESSAGE 53400013 LR WREG2,DREG0 RESTORE OFFSET TO OPCTL TERMINAL 53700013 STH WREG2,TTDKEY STORE RELATIVE OFFSET OF OPCTL 54000013 * TERMINAL ENTRY TO DESTINATION KEY 54300013 LA WREG2,5(TCREG,WREG2) GET QCB ADDRESS OF OPCTL TERMINAL 54600013 MVC LCBDESTQ(3),0(WREG2) MOVE QCB ADDRESS TO LCBDESTQ 54900013 NI LCBSTATE,X'FD' TURN OFF PARTIAL MESSAGE SWITCH 55200013 MVI LCBPTEMP,C' ' BLANK OUT LCBPTEMP FIELD 55500013 SR WREG1,WREG1 CLEAR REGISTER 55800013 STH WREG1,MSNUMOUT CLEAR MSNUMOUT FIELD 56100013 STH WREG1,MSNUMIN CLEAR MSNUMIN FIELD 00PS 56200018 STH WREG1,TTSKEY CLEAR TTSKEY FIELD 00PS 56300018 SPACE 3 56400013 * THE FOLLOWING ROUTINE TESTS FOR A THRESHOLD MESSAGE TO BE SENT * 56700013 * AND FORMATS THE MESSAGE. * 57000013 SPACE 3 57300013 THRESH SR WREG3,WREG3 CLEAR REGISTER FOR IC 57600013 IC WREG3,DCBEIOBX INSERT LCB SIZE 57900013 ALR WREG3,LCBREG ADD LCB ADDRESS 58200013 LA WREG3,0(WREG3) CLEAR HIGH ORDER BYTE 58500013 SH WREG3,SIX SUBTRACT 6 TO POINT TO THRESHOLD 58800013 * COUNTERS 59100013 CLI 4(WREG3),0 IS A THRESHOLD MESSAGE TO BE SENT 59400013 BE RETURN IF NOT, GO TO BUFFER RECALL CLEANUP 59700013 BAL RREG1,RECALL GO TO RECALL A BUFFER FOR MESSAGE 60000013 UNPK LEMSG(4),4(2,WREG3) UNPACK UNIT NUMBER 18035 60300018 MVI LEMSG+3,C' ' BLANK OUT LAST NUMBER 18035 60600018 TR LEMSG(3),TRTABLE2 TRANSLATE TO PRINTABLE FORM 18035 60900018 SR DREG1,DREG1 CLEAR REGISTER FOR IC 61200013 LA WREG1,7 LOAD DECREMENT 61500013 LNR WREG1,WREG1 FOR BXH INSTRUCTION 61800013 LA WREG2,LEMSTR+5 LOAD STOPPING ADDRESS FOR BXH LOOP 62100013 LA RREG2,LEMSTO+4 LOAD STARTING ADDRESS FOR BXH LOOP 62400013 LOOP BCTR WREG3,0 DECREMENT POINTER TO NEXT COUNTER 62700013 IC DREG1,4(WREG3) INSERT COUNTER 63000013 CVD DREG1,UNPACK CONVERT COUNTER TO DECIMAL 63300013 UNPK 0(3,RREG2),UNPACK+6(2) UNPACK TO PUT IN PRINTABLE FORM 63600013 OI 2(RREG2),X'F0' CLEAR SIGN OF LAST NUMBER 63900013 BXH RREG2,WREG1,LOOP DECREMENT TO NEXT COUNTER AND RETURN 64200013 * TO CONVERT NEXT COUNTER 64500013 XC 4(5,WREG3),4(WREG3) CLEAR THRESHOLD COUNTERS 64800013 LA DREG1,LEMSG LOAD MESSAGE ADDRESS 65100013 LA WREG3,45 LOAD MSG. SIZE 00PS 65400018 B SENDMSG GO TO SEND MESSAGE TO OPCTL TERMINAL 65700013 SPACE 3 66000013 * THE FOLLOWING ROUTINE RECALLS THE BUFFER NEEDED FOR THE MESSAGE * 66300013 SPACE 3 66600013 RECALL TM MSTATUS,X'10' IS MESSAGE TO BE PLACED ON DISK 66900013 BO SKIPRC IF NOT, SKIP RECALL 67200013 MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 67500013 L WREG1,0(NGREG) GET ADDRESS OF LPS QUEUE 67800013 LR DREG0,WREG3 SAVE LCB ADDRESS BEFORE RECALL 68100013 BAL RREG2,240(WREG1) BRANCH TO RECALL 68400013 LR WREG3,DREG0 RESTORE LCB ADDRESS 68700013 SKIPRC BR RREG1 RETURN TO SET UP MESSAGE 69000013 SPACE 3 69300013 * THE FOLLOWING RETURNS TO BUFFER RECALL/CLEANUP IN IGG019NG * 69600013 SPACE 3 69900013 WTO SH DREG1,TWELVE BACK UP POINTER FOR WTO 70200013 LR WREG2,SREG SAVE BASE REGISTER FOR WTO 70500013 WTO MF=(E,(1)) 70800013 LR SREG,WREG2 RESTORE BASE REGISTER 71100013 OI MSTATUS,X'10' SET MESSAGE SENT BIT 71400013 B THRESH CHECK FOR THRESHOLD MESSAGE 71700013 RETURN TM LCBERRST+1,X'80' HAS A PERMANENT ERROR OCCURRED 72000013 BZ NOINTREL IF NOT, IGNORE INTREL SWITCH 72300013 SR WREG1,WREG1 CLEAR WORK REG A52229 72350021 IC WREG1,LCBUCBX GET REL LINE # A52229 72400021 SLA WREG1,2 TIMES 4 A52229 72450021 A WREG1,LCBDCBPT ADD DCB ADDRESS A52229 72500021 LA WREG1,DCBCPOLL-IHADCB(WREG1) POINT TO DCBCPOLL A52229 72550021 TM 0(WREG1),X'04' IS INTREL ENTRY INDICATED 72600021 BZ NOINTREL IF NOT, DO NOT RETURN TO INTREL 72900013 MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 73200013 L WREG1,0(NGREG) GET ADDRESS OF LPS QUEUE 73500013 BAL RREG2,240(WREG1) BRANCH TO RECALL 73800013 L WREG1,=V(IECKNTRL) GET ADDRESS OF INTREL QCB 74100013 MVC LCBDESTQ(3),1(WREG1) SET DESTINATION TO INTREL QUEUE 74400013 ST LCBREG,4(WREG1) SAVE LCB ADDRESS FOR INTREL 74700013 MVI 4(WREG1),X'FE' RESTORE PRIORITY 75000013 NOINTREL EQU * 75300013 L SREG,0(13) GET ADDRESS OF LPS QUEUE 75600013 B 244(SREG) BRANCH TO RECALL/CLEANUP 75900013 SPACE 3 76200013 * CONSTANTS AND WORK AREAS USED BY THIS ROUTINE FOLLOW. * 76500013 SPACE 3 76800013 MOVEMSG MVC 0(1,WREG2),0(DREG1) 77100013 FOUR DC H'4' 77400013 SIX DC H'6' 77700013 TWELVE DC H'12' 78000013 UNPACK DS D 78300013 DC X'00398000' MSG LENGTH AND MCSFLAGS FIELD 18035 78600018 DC CL8'IEC801I ' 78900013 LEMSG DC CL13' THRESHOLD' 18035 79200018 LEMSTR DC CL10' TRANS= ' 79500013 LEMSDC DC CL7' DC= ' 79800013 LEMSIR DC CL7' IR= ' 80100013 LEMSTO DC CL7' TO= ' 80400013 DC X'40' 00PS 80450018 DC B'0001000000000000' DESCRIPTOR CODES 18035 80500018 DC B'0000000101000000' ROUTING CODES 18035 80600018 DS 0F 00PS 80700018 DC X'002E8000' MSG LENGTH AND MCSFLAGS FIELD 18035 80800018 DC CL8'IEA000I ' 81000013 IOERRMSG DC CL12'000,I/O ERR,' 18035 81300018 ERLINENO EQU IOERRMSG 18035 81600018 EROPCODE DC CL3'00,' 81900013 ERSTATUS DC CL5'0000,' 82200013 ERSENSE DC CL5'0000,' 82500013 ERTERMID DC CL8'00000000' 82800013 DC X'40' 00PS 82850018 DC B'0001000000000000' DESCRIPTOR CODES 18035 82900018 DC B'0000000101000000' ROUTING CODES 18035 83000018 TRTABLE1 EQU * 83100013 TRTABLE2 EQU TRTABLE1-240 83400013 DC C'0123456789ABCDEF' 83700013 EJECT 84000013 LCBD QTAM=3 84300013 EJECT 84600013 PREFIXD 84900013 EJECT 85200013 DCBD DSORG=(QX) 85500013 EJECT 85800013 TERMTBLD 86100013 EJECT 86400013 QCBD 86700013 END 87000013 ./ ADD SSI=01010132,NAME=IECKPAUS,SOURCE=0 TITLE 'IECKPAUS QTAM PAUSE (PAUSE)' 00400013 *********************************************************************** 00800013 * * 01200013 *NAME- * 01600013 * IECKPAUS QTAM PAUSE (PAUSE) * 02000013 * * 02400013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 02800013 * * 03200013 *FUNCTION- * 03600013 * IECKPAUS WILL CAUSE CERTAIN USER SPECIFIED CHARACTERS TO * 04000013 * BE SENT TO A TERMINAL WHEN A GIVEN CHARACTER OR CHARACTER * 04400013 * SEQUENCE IS FOUND IN A SEGMENT OF THE MESSAGE CURRENTLY BEING * 04800013 * SENT. * 05200013 * THE ADDRESS OF THE FIRST BYTE OF THE MESSAGE SEGMENT IS * 05600013 * OBTAINED FROM THE LCBTRST (LBC + 82) FIELD OF THE LCB. IF IT * 06000013 * IS NOT A TEXT SEGMENT, THE SIZE OF THE PREFIX AND EXPANSION * 06400013 * FIELDS IS ADDED TO THE POINTER TO THE BEGINNING OF THE BUFFER * 06800013 * TO GET THE ADDRESS OF THE FIRST HEADER CHARACTER. * 07200013 * THE MESSAGE IS THEN SCANNED FOR THE CONTROL CHARACTER * 07600013 * DEFINED IN THE PAUSE MACRO STATEMENT. IF THE SEGMENT IS * 08000013 * DEPLETED AND THE CHARACTER OR CHARACTER SEQUENCE IS NOT FOUND, * 08400013 * CONTROL IS PASSED TO THE NEXT LPS INSTRUCTION. * 08800013 * WHEN THE CHARACTER SEQUENCE IS FOUND, THE COUNT IS DECREMENT-* 09200013 * ED BY ONE. (IF THIS IS THE FIRST PAUSE FOR THIS SEGMENT, COUNT * 09600013 * WILL BE INITIALIZED TO THE NUMBER OF INSERT BLOCKS. AFTER THE * 10000013 * FIRST PAUSE, COUNT WILL THEN BE THE NUMBER OF INSERT BLOCKS LEFT. * 10400013 * THIS NUMBER WILL BE DIMINISHED BY ONE WHEN AN INSERT BLOCK IS * 10800013 * REQUESTED.) * 11200013 * THE INSERT BLOCK WILL CONSIST MAINLY OF 3 CCWS: * 11600013 * 1. CCW TO WRITE INSERTED CHARACTERS, * 12000013 * 2. CCW TO WRITE REMAINDER OF BUFFER, * 12400013 * 3. CCW TO TIC TO NEXT BRB. * 12800013 * * 13200013 * WHEN THE INSERT BLOCK HAS BEEN ALLOCATED, THE ADDRESS OF THE * 13600013 * CHARACTER AFTER THE CONTROL CHARACTER IS COMPUTED AND PLACED * 14000013 * INTO THE ADDRESS FIELD IN THE FIRST CCW IN THE INSERT BLOCK (IB). * 14400013 * THE ADDRESS OF THE NEXT BRB IN THE CHAIN IS OBTAINED AND STORED * 14800013 * IN THE TIC ADDRESS IN THE IB TIC CCW. * 15200013 * THE COUNT OF CHARACTERS IN THE REST OF THE BUFFER IS OBTAIN- * 15600013 * ED AND INSERTED INTO THE COUNT FIELD IN THE FIRST IB CCW. THE * 16000013 * ADDRESS OF THE BYTE AFTER THE CONTROL CHARACTERS IS MOVED INTO * 16400013 * THE DATA ADDRESS FIELD OF THIS CCW. * 16800013 * THE COUNT OF CHARACTERS UP TO THE CONTROL CHARACTER(S) IS * 17200013 * COMPUTED AND PLACED INTO THE COUNT FIELD OF THE FIRST CCW IN * 17600013 * THE PREVIOUS BRB. * 18000013 * THE COUNT OF IDLE CHARACTERS IS MOVED INTO THE FIRST CCW * 18400013 * IN THE IB. * 18800013 * IN EFFECT, AT THE END OF THIS ROUTINE, THE BRB WITH THE * 19200013 * CCW TO SEND THE ENTIRE MESSAGE NOW SENDS ONLY THOSE * 19600013 * CHARACTERS UP TO AND INCLUDING THE CONTROL CHARACTER(S). THE * 20000013 * INSERT BLOCK WILL HOLD THE CCWS TO SEND THE DESIRED CHARACTER, * 20400013 * SEND THE REMAINDER OF THE BUFFER, AND TIC TO THE NEXT BRB. * 20800013 * AT THE COMPLETION OF THE ROUTINE, CONTROL IS PASSED TO * 21200013 * THE POINT NEXTCHAR TO CONTINUE SCANNING OF THE SEGMENT. * 21600013 * * 22000013 *ENTRY POINTS- * 22400013 * IECKPAUS - EXPANSION OF THE PAUSE MACRO GENERATES A BALR TO THIS * 22800013 * POINT USING REGISTER 15 AS THE ENTRY POINT REGISTER, AND * 23200013 * REGISTER 3 AS THE RETURN POINT REGISTER. * 23600013 * * 24000013 *INPUT- * 24400013 * REGISTER 3- RETURN ADDRESS FROM THIS ROUTINE. * 24800013 * REGISTER 11- ADDRESS OF END OF SEGMENT. * 25200013 * REGISTER 14- PARAMETER REGISTER. THE PARAMETER LIST PASSED * 25600013 * TO THE ROUTINE CONSISTS OF THE NUMBER OF CHARACTERS TO BE * 26000013 * SENT WHEN THE CONTROL CHARACTER(S) IS INCOUNTERED, THE * 26400013 * CONTROL CHARACTER(S), AND THE BIT CONFIGURATION TO BE * 26800013 * SENT. * 27200013 * * 27600013 *OUTPUT- * 28000013 * THE SPECIFIED NUMBER OF OUTPUT CHARACTERS WILL BE SENT TO THE * 28400013 * DESTINATION FOR EACH OCCURRANCE OF THE CONTROL CHARACTER * 28800013 * SEQUENCE IN THE MESSAGE HEADER. * 29200013 * * 29600013 *EXTERNAL ROUTINES- * 30000013 * QWAIT (IGG065 IN MODULE IECKQQ01) * 30400013 * * 30800013 *EXITS- * 31200013 * NORMAL - WHEN THE ENTIRE HEADER HAS BEEN SCANNED, CONTROL IS * 31600013 * RETURNED TO THE NEXT LPS INSTRUCTION BY BRANCHING ON * 32000013 * REGISTER 3. * 32400013 * ERROR - NONE. * 32800013 * * 33200013 *TABLES/WORK AREAS- * 33600013 * A QUEUE CONTROL BLOCK, INSERTQ, IS DEFINED IN THIS ROUTINE. * 34000013 * * 34400013 *ATTRIBUTES- * 34800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 35200013 * * 35600013 *NOTES- * 36000013 * REGISTER 0- WORK REGISTER * 36400013 * REGISTER 1- ADDRESS OF THE INSERT BLOCK. * 36800013 * REGISTER 2- ADDRESS OF NEXT BRB ON RING. * 37200013 * REGISTER 3- BASE REGISTER FOR FULL STCB. * 37600013 * REGISTER 4- BASE REGISTER FOR LCB. * 38000013 * REGISTER 6- BASE REGISTER. * 38400013 * REGISTER 9- SCAN POINTER FOR THIS ROUTINE. * 38800013 * REGISTER 10- INCREMENT FOR SCANNING SEGMENT. * 39200013 * REGISTER 12- WORK REGISTER. * 39600013 * * 40000013 *********************************************************************** 40400013 * 674000,706000,718000 23165 40600018 * 694000 A37733 40700020 IECKPAUS START 40800013 QWAIT EQU 65 41200013 DREG0 EQU 0 41600013 FREG EQU 1 42000013 TREG EQU 2 42400013 RREG2 EQU 3 42800013 Y EQU 3 43200013 LCBREG EQU 4 43600013 MSREG EQU 6 44000013 X EQU 6 44400013 WREG1 EQU 9 44800013 QREG EQU 9 45200013 IREG EQU 10 45600013 TCBREG EQU 10 46000013 EOSREG EQU 11 46400013 WREG2 EQU 12 46800013 BREG EQU 12 47200013 RREG1 EQU 14 47600013 SREG EQU 15 48000013 USING *,SREG 48400013 USING IECKLCB0,LCBREG 48800013 USING IECKPREF,MSREG 49200013 USING CTLPROG+2,BREG 49600013 LH IREG,LCBTRST GET REL ADDR OF FIRST CHAR TO TRANS 50000013 TM MSTATUS,X'01' TEST FOR TEXT SEGMENT 50400013 BC 8,USETRST IF HEADER,IREG IS SET OK 50800013 TM MSTATUS,X'20' IS EOB BIT ON 51200013 BC 1,USETRST IF YES,IREG IS SET OK 51600013 LA IREG,TXSTRT-MSEGSZE GET REL ADDR OF FIRST CHAR TO TRANS 52000013 USETRST LA WREG1,MSEGSZE-1(IREG) ADDR OF FIRST BYTE TO SCAN-1 52400013 L WREG2,LCBCLCCW GET ADDR OF PREV CCW 52800013 L FREG,=V(IECKBFSZ) GET NUMBER OF INSERT BLOCKS 53200013 LH FREG,2(0,FREG) CURRENTLY AVAILABLE 53600013 L TREG,8(0,WREG2) GET ADDR OF NEXT BRB OR INSERT BLOCK 54000013 CLI 12(TREG),128 WAS THERE APREVIOUS PAUSE 54400013 * IN INSERT BLOCK, TEST FLAGS BYTE OF WRITE IDLES CCW 54800013 * IN BRB, TESTS LAST HALF OF TIC CCW WHICH IS TEMPORARILY 55200013 * USED FOR THE LCB ADDRESS, THE FIRST BYTE OF WHICH IS ZERO 55600013 * THEREFORE FOR PREVIOUS PAUSE, AN INSERT BLOCK WILL BE DETECTED 56000013 BC 7,NEXTCHAR+4 BRANCH IF NO 56400013 NEXTCHAR LH FREG,COUNT PREVIOUS COUNT OF PAUSES 56800013 LA IREG,1 GET INCR OF ONE 57200013 INDICE BXH WREG1,IREG,0(RREG2) BUFFER SCANNER-RTRN TO LPS VIA MACRO 57600013 CLC 0(1,WREG1),2(RREG1) TEST FOR SPECIAL CHAR 58000013 BC 7,INDICE IF NO,TEST NXT CHAR 58400013 BCT FREG,GETCCW COUNT PAUSES IN THIS BUFFER 58800013 BC 15,0(0,RREG2) EXIT IF LIMIT IS EXCEEDED 59200013 GETCCW STH FREG,COUNT STORE NEW COUNT FOR NEXT BUFFER 59600013 LA TREG,INSERTQ ELSE INSERT IDLES 60000013 SVC QWAIT REQUEST INSERT BLOCK 60400013 ST TREG,20(0,FREG) STORE ADDRESS OF INSERT Q INTO 60800013 * INSERT BLOCK FOR RELEASE 61200013 LA DREG0,1(0,WREG1) GET ADDR OF REST OF BUFFER 61600013 AGAIN MVC 17(3,FREG),9(WREG2) PUT POINTER TO NEXT ELEMENT INTO IB 62000013 LR IREG,WREG2 SAVE ADDRESS OF PREVIOUS ELEMENT 62400013 NI 19(FREG),252 CLEAR STATUS BITS FROM TIC ADDRESS 62800013 L TREG,16(0,FREG) GET ADDRESS OF NEXT BLOCK IN CHAIN 63200013 MVC 0(4,FREG),0(TREG) PUT COMMAND & BUFFER ADDR INTO IB 63600013 LA WREG1,1(0,EOSREG) IF NEXT CCW IS NOT INSERT USE EOS 64000013 CLI 12(TREG),128 IS THE NEXT ELEMENT AN INSERT BLOCK 64400013 BC 7,HERE FROM A PREVIOUS PAUSE - BRANCH IF NO 64800013 L WREG1,16(0,TREG) IF IT IS GET ADDRESS OF NEXT BLOCK 65200013 L WREG1,0(0,WREG1) FROM INSERT BLOCK 65600013 LA WREG2,8(0,TREG) AND LOOK AT NEXT ELEMENT 66000013 LA WREG1,0(0,WREG1) CLEAR HIGH ORDER BYTE FOR SUBT 23165 66200018 HERE SR WREG1,DREG0 GET COUNT OF CHARS IN REST OF BUFFER 66400013 BC 4,AGAIN BRANCH IF END OF BUFFER 66800013 ST DREG0,0(0,TREG) INSERT BUFFER ADDRESS IN NEXT ELEMNT 67200013 MVI 0(TREG),1 SET WRITE OP CODE IN CCW 23165 67400018 STH WREG1,6(0,TREG) PUT COUNT IN NEXT ELEMENT 67600013 LR WREG1,DREG0 RESTORE SCAN REGISTER AND 68000013 S DREG0,0(0,FREG) GET COUNT UP TO INSERT IDLES 68400013 STH DREG0,6(0,FREG) CHARACTER 68800013 ST FREG,8(0,FREG) USE 8(FREG) AS TEMPORARY STORAGE 69200013 MVI 12(FREG),128 SET CDA FLAG IN SECOND CCW A37733 69400020 XC 9(3,IREG),17(FREG) CLEAR ADDRESS FROM PREVIOUS TIC 69600013 OC 9(3,IREG),9(FREG) INSERT ADDR OF CCW1 IN PREV CCW 70000013 MVI 4(FREG),136 SET CDA & PCI FLAGS IN FIRST CCW 70400013 LA DREG0,3(0,RREG1) GET ADDR OF IDLE BUFFER 70800013 ST DREG0,8(0,FREG) PUT INTO INSERT CCW2 71200013 MVC 14(2,FREG),0(RREG1) MOVE COUNT OF IDLE CHARS TO CCW2 72000013 MVI 16(FREG),8 INSERT TIC COMMAND 72400013 LA WREG2,8(0,FREG) AND LOOK AT NEXTCCW 72800013 BCT WREG1,NEXTCHAR LOOK FOR NEXT SPEC CHAR 73200013 * ADDITIONAL-CCW QUEUE 73600013 * QCB--PRE-ASSEMBLED IN THE MODULE(IECKPAUS) 74000013 * INTRODUCED THROUGH THE APPEARANCE OF THE PAUSE 74400013 * MACRO-INSTR IN THE MESSAGE CONTROL PROGRAM, 74800013 * LABELED INSERTQ. 75200013 * ELEMENT CHAIN--GENERATED IN THE PROB PROG ON 75600013 * EXPANSION OF THE BUFFER MACRO-INSTR LABELED 76000013 * IECKISRT. A CHAIN OF SPECIAL-PURPOSE BRB'S USED TO 76400013 * SCHEDULE AND CONTAIN CHANNEL COMMANDS FOR THE TRANSMISSION 76800013 * OF IDLE CHARACTERS. 77200013 * STCB CHAIN--MAY CONTAIN THE STCB FOR THE LPS 77600013 * SUBTASK. ALWAYS ENDS WITH THE STCB FOR THE QUEUE 78000013 * INSERT SUBTASK. 78400013 INSERTQ DS 0F 78800013 DC FL1'1' 79200013 DC VL3(IECKISRT) 79600013 DC A(0) 80000013 DC AL1(2) 80400013 DC AL3(INSERTQ+8) 80800013 DC AL1(255) 81200013 B LIFO 81600013 COUNT DC H'1' 82000013 EJECT 82400013 DROP MSREG 82800013 USING IECKPREF,FREG 83200013 USING TBLOCK,Y 83600013 USING QBLOCK,QREG 84000013 USING TCB,TCBREG 84400013 QATTACH EQU X'48' 84800013 QSAVE EQU X'4C' 85200013 READY EQU X'50' 85600013 IRBSAVE EQU X'54' 86000013 WAITRB EQU X'58' 86400013 DUMMY EQU X'60' 86800013 NRET EQU X'76' 87200013 SPACE 87600013 CTLPROG DSECT 88000013 CTLPROGD 88400013 EJECT 88800013 PREFIXD 89200013 EJECT 89600013 LCBD 90000013 EJECT 90400013 QCBD 90800013 EJECT 91200013 STCBD 91600013 EJECT 92000013 TCBD 92400013 END 92800013 ./ ADD SSI=03010721,NAME=IECKPLMT,SOURCE=0 TITLE 'IECKPLMT QTAM POLLING LIMIT (POLLIMIT)' 00800013 *********************************************************************** 01600013 * * 02400013 *NAME- * 03200013 * IECKPLMT QTAM POLL LIMIT * 04000013 * * 04800013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 05600013 * * 06400013 *FUNCTION- * 07200013 * THIS ROUTINE KEEPS TRACK OF THE NUMBER OF MESSAGES RECEIVED FROM * 08000013 * A TERMINAL ON ONE POLLING PASS, AND RETURNS TO REPOLL THE SAME * 08800013 * TERMINAL IF THE COUNT IS LESS THAN THE LIMIT FOR THE TERMINAL. IF* 09600013 * THE COUNT IS EQUAL TO OR GREATER THAN THE LIMIT, POINTER TO * 10400013 * CURRENT TERMINAL ENTRY IN THE POLLING LIST IS UPDATED TO POINT TO * 11200013 * THE NEXT ENTRY. * 12000013 * * 12800013 *ENTRY POINTS- * 13600013 * IECKPLMT - THE EXPANSION OF THE POLL LIMIT MACRO GENERATES A * 14400013 * BRANCH AND LINK TO THIS POINT. * 15200013 * * 16000013 *INPUT- * 16800013 * REGISTER 1- MAXIMUM LIMIT OF MESSAGES TO BE ACCEPTED FROM THIS * 17600013 * NON-SWITCHED TERMINAL DURING ONE POLLING PASS. * 18400013 * REGISTER 4- ADDRESS OF THE LCB * 19200013 * REGISTER 14- RETURN ADDRESS * 20000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 20800013 * * 21600013 *OUTPUT- * 22400013 * UPDATED COUNT IN LCBPOLCT (LCB ADDRESS +84). * 23200013 * UPDATED POINTER TO PROPER ENTRY IN TERMINAL TABLE AT LCBPOLPT * 24000013 * (LCB ADDRESS+85). * 24800013 * * 25600013 *EXTERNAL ROUTINES- * 26400013 * NONE. * 27200013 *EXITS- * 28000013 * NORMAL- RETURN TO NEXT LPS INSTRUCTION VIA A BRANCH ON REGISTER * 28800013 * 14. * 29600013 * ERROR- NONE. * 30400013 * * 31200013 *TABLES/WORK AREAS- * 32000013 * NONE. * 32800013 * * 33600013 *ATTRIBUTES- * 34400013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 35200013 * * 36000013 *NOTES- * 36800013 * REGISTERS 9 AND 10 ARE USED AS WORK REGISTERS. * 37600013 * THIS FUNCTION IS NOT APPLICABLE TO SWITCHED-CONNECTION TERMINALS. * 38400013 * * 39200013 *********************************************************************** 40000013 IECKPLMT START 40800013 * 804000 A27842 41200019 DREG1 EQU 1 41600013 R2 EQU 2 42400013 R3 EQU 3 43200013 LCBREG EQU 4 44000013 R9 EQU 9 44800013 WREG1 EQU 9 45600013 WREG2 EQU 10 46400013 RREG1 EQU 14 47200013 SREG EQU 15 48000013 DCBPOLSZ EQU 56 48800013 USING *,SREG 49600013 USING IECKLCB0,LCBREG 50400013 L WREG2,LCBPOLPT-1 GET POLL POINTER 51200013 TM LCBFLAG2,X'01' IS THIS AN AUTOPOLL LINE 52000013 BO AP IF YES BRANCH 52800013 * 53600013 * HAS AN ERROR CONDITION CHANGED POLL POINTER 54400013 * 55200013 CLC LCBTTIND,0(WREG2) IS TERM TABLE OFFSET FOR CURRENT 56000013 * MESSAGE SAME AS THAT POINTED TO 56800013 * BY LCB POLL POINTER 57600013 BCR 7,RREG1 IF NO RETURN 58400013 * 59200013 * HAS END OF LIST BEEN REACHED 60000013 * 60800013 NC 0(2,WREG2),0(WREG2) IS THIS LAST ENTRY 61600013 BCR 8,RREG1 IF YES RETURN 62400013 * 63200013 * INCREMENT COUNT AND TEST FOR LIMIT 64000013 * 64800013 BAL R2,INCOUNT GO TO INCREMENT COUNTER ROUTINE 65600013 LA WREG1,2(0,WREG2) INCR POINTER TO NEXT TERMINAL 66400013 OK ST WREG1,LCBPOLPT-1 RESET STORED POINTER AND ZERO COUNT 67200013 BR RREG1 RETURN 68000013 * 68800013 * INCREMENT COUNT AND TEST 69600013 * 70400013 AP BAL R2,INCOUNT GO TO INCREMENT COUNTER ROUTINE 71200013 * 72000013 * GET POINTER TO POLL LIST 72800013 * 73600013 SR R9,R9 74400013 IC R9,LCBUCBX LOAD RELATIVE LINE NUMBER MINUS ONE 75200013 SLL R9,2 MULTIPLY BY FOUR 76000013 L R3,LCBDCBPT LOAD POINTER TO DCB 76800013 L R3,DCBPOLSZ(R3,R9) LOAD POINTER TO POLL LIST 77600013 * 78400013 * INCREMENT POINTER TO NEXT TERMINAL 79200013 * 80000013 SR R9,R9 CLEAR REGISTER A27842 80400019 IC R9,4(R3) GET BYTE CONTAINING WIDTH 80800013 SRL R9,5 SHIFT OUT MISC INFO 81600013 LA WREG1,0(WREG2,R9) INCREMENT POINTER BY ENTRY WIDTH 82400013 * 83200013 * TEST FOR END OF LIST AND RESET TO BEGINNING IF NECESSARY 84000013 * 84800013 CLI 0(WREG1),X'FE' IS THIS THE END OF THE LIST 85600013 BNE OK IF NO BRANCH 86400013 LA WREG1,5(R3) ELSE SET POINTER TO FIRST ENTRY 87200013 B OK 88000013 * 88800013 * THIS CODE INCREMENTS POLL COUNT,COMPARES IT TO THE LIMIT AND RETURNS 89600013 * 90400013 INCOUNT SR WREG1,WREG1 91200013 IC WREG1,LCBPOLCT GET CURRENT POLL COUNT FROM LCB 92000013 LA WREG1,1(0,WREG1) INCREMENT COUNT 92800013 STC WREG1,LCBPOLCT ELSE PUT BACK UPDATED COUNT 93600013 CR WREG1,DREG1 COMPARE COUNT TO LIMIT 94400013 BCR 4,RREG1 AND RETURN 95200013 BR R2 96000013 EJECT 96800013 LCBD 97600013 END 98400013 ./ ADD SSI=02010771,NAME=IECKPRTY,SOURCE=0 TITLE 'IECKPRTY QTAM PRIORITY-MODE (MODE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKPRTY QTAM PRIORITY (MODE) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THIS ROUTINE USES IECKSCAN (SCAN) TO FIND THE NEXT NON-BLANK * 10000013 * CHARACTER IN THE MESSAGE HEADER SEGMENT. THE ROUTINE MAY BE * 11000013 * ENTERED * 12000013 * A. UNCONDITIONALLY FROM THE EXPANSION OF THE MODE MACRO, OR * 13000013 * B. CONDITIONALLY FROM IECKMODE (MODE) IF THE CHARACTER * 14000013 * SPECIFIED AS THE SECOND OPERAND IN THE MACRO APPEARS IN THE NEXT * 15000013 * CHARACTER POSITION IN THE MESSAGE HEADER SEGMENT. * 16000013 * THE ROUTINE MOVES THE PRIORITY CHARACTER TO THE LCBPTEMP * 17000013 * FIELD OF THE LCB AT LCB + 81. * 18000013 * * 19000013 *ENTRY POINTS- * 20000013 * IECKPRYT - EITHER DIRECTLY FROM THE MACRO EXPANSION, OR FROM * 21000013 * IECKMODE, AS DESCRIBED ABOVE. * 22000013 * * 23000013 *INPUT- * 24000013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 25000013 * REGISTER 14- RETURN ADDRESS * 26000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 27000013 * * 28000013 *OUTPUT- * 29000013 * THE PRIORITY CHARACTER WILL HAVE BEEN MOVED TO THE LCBPTEMP FIELD * 30000013 * AT LCB + 81. * 31000013 * * 32000013 *EXTERNAL ROUTINES- * 33000013 * IECKSCAN - TO FIND THE NEXT NON-BLANK CHARACTER. * 34000013 * * 35000013 *EXITS- * 36000013 * NORMAL- RETURN TO NEXT LPS INSTRUCTION BY BRANCHING AROUND * 37000013 * THE GENERATED CONSTANTS. * 38000013 * ERROR- NONE. * 39000013 * * 40000013 *TABLES/WORK AREAS- * 41000013 * NONE. * 42000013 * * 43000013 *ATTRIBUTES- * 44000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 45000013 * * 46000013 *NOTES: * 47000013 * REGISTER 3- SECOND LEVEL LINKAGE TO IECKSCAN. * 48000013 * * 49000013 *********************************************************************** 50000013 IECKPRTY START 51000013 DREG0 EQU 0 52000013 DREG1 EQU 1 53000013 KREG EQU 2 54000013 RREG2 EQU 3 55000013 LCBREG EQU 4 56000013 MSREG EQU 6 57000013 LGREG EQU 7 58000013 RREG1 EQU 14 59000013 SREG EQU 15 60000013 USING *,DREG1 61000013 USING IECKLCB0,LCBREG 62000013 USING IECKPREF,MSREG 63000013 L SREG,4(0,LGREG) GET SCAN ADDR 64000013 BALR RREG2,SREG LINKAGE TO SCAN SUBR 65000013 MVC LCBUCBX+1(1),0(KREG) MOVE PRIORITY CHAR TO LCB 66000013 B 4(0,RREG1) RETURN 67000013 EJECT 68000013 LCBD 69000013 EJECT 70000013 PREFIXD 71000013 END 72000013 ./ ADD SSI=02050132,NAME=IECKQQ01,SOURCE=0 TITLE 'QTAM CONTROL PROGRAM' 00050021 IECKQQ01 START 00100021 FREG EQU 1 BASE FOR IECKPREF 00150021 TREG EQU 2 00200021 Y EQU 3 BASE FOR STCB/SVRB 00250021 X EQU 6 00300021 QREG EQU 9 BASE FOR QCB 00350021 TCBREG EQU 10 BASE FOR TCB 00400021 BREG EQU 12 BASE REG FOR IECKQQ01 00450021 Z EQU 13 BASE REG FOR IGG019NG 00500021 LNKRG2 EQU 14 00550021 SPACE 00600021 QWAIT EQU 65 00650021 QPOST EQU 67 00700021 USING IECKPREF,FREG 00750021 USING QBLOCK,QREG 00800021 USING TBLOCK,Y 00850021 USING VECTOR,Z 00900021 USING TCB,TCBREG 00950021 ENTRY IGC065,IGC067 01000021 CTLPROGD 01050021 TITLE 'BASIC CONTROL BLOCKS' 01100021 STCBD 01150021 EJECT 01200021 TCBD 01250021 EJECT 01300021 QCBD 01350021 EJECT 01400021 PREFIXD 01450021 TITLE 'WORKING STORAGE IN IGG019NG' 01500021 VECTOR DSECT 01550021 * QPOST-QWAIT STATUS SAVE AREA 01600021 DC A(0) LPS 01650021 DC A(0) B ENDINSRT 01700021 DC 16F'0' 01750021 SPACE 01800021 * PSUEDO 'NOT WAITING' QCB 01850021 IECKSTOP EQU * 01900021 QSAVE EQU * 01950021 WAITRB EQU * 02000021 QATTACH DC X'02' 02050021 DC AL3(WAITRB) 02100021 DC X'FF' 02150021 DC AL3(WAITRB) 02200021 SPACE 02250021 * READY QUEUE 02300021 READY DC A(WAITRB) 02350021 DC X'00' 02400021 DUMMY DC AL3(WAITRB) 02450021 SPACE 02500021 STARTIO DC 2A(0) 02550021 CLOSEOUT DC 2A(0) 02600021 SPACE 02650021 * TRANSFERS TO VARIOUS TRUNCATED SUBTASK ENTRY POINTS 02700021 NRET EQU *-2 02750021 END 02800021 ./ ADD SSI=02013243,NAME=IECKRELM,SOURCE=0 TITLE 'IECKRELM RELEASE INTERCEPTED MESSAGES (RELEASEM)' 00500013 *********************************************************************** 01000013 * * 01500013 *NAME- * 02000013 * IECKRELM RELEASE INTERCEPTED MESSAGES (RELEASEM) * 02500013 * * 03000013 *STATUS- CHANGE LEVEL= 18 JANUARY 1971 * 03500021 * * 04000013 *FUNCTION- * 04500013 * IECKRELM RELEASES THE MESSAGES THAT WERE HELD ON THE QUEUE * 05000013 * OF A DESTINATION BY AN INTERCEPT MACRO INSTRUCTION FOR THAT * 05500013 * DESTINATION. * 06000013 * THIS ROUTINE GETS THE ADDRESS OF THE TERMINAL TABLE AND * 06500013 * SCANS THE TABLE FOR THE DESTINATION SPECIFIED BY THE CALLING * 07000013 * ROUTINE. IF THE DESTINATION CODE IS NOT FOUND, A RETURN CODE OF * 07500013 * X'20', FOR ENTRY NOT FOUND, IS PASSED TO THE CALLING ROUTINE VIA * 08000013 * A RETURN MACRO. * 08500013 * IF THE INTERCEPT BIT (X'04') IS NOT ON OR RELEASEM PENDING * 08700021 * BIT (X'80') IS ON, CONTROL IS RETURN TO THE USER WITH A RETURN * 08900021 * CODE OF X'04'. IF THE INTERCEPT BIT IS NOT ON, THE QCB ADDRESS * 09100021 * IS GOTTEN FROM THE TERMINAL TABLE ENTRY. IF THE QLINK FIELD IS * 09300021 * ZERO, A RESTART IS IN PROGRESS AND A RELEASEM CANNOT BE DONE. * 09500021 * RETURN IS MADE TO THE USER WITH A RETURN CODE OF 2. THE * 09700021 * DCB IS RETRIEVED FROM THE QCB, AND THE ADDRESS OF LPS IS GOTTEN * 10000013 * FROM THE DCB. THE OFFSET OF THE INTERCEPT FIELD IS * 10500021 * RETRIEVED FROM LPS ADDRESS+4. THIS VALUE IS ADDED TO THE VALUE IN * 11000013 * THE TERMINAL TABLE BASE REGISTER TO GET THE ABSOLUTE ADDRESS OF * 11500013 * THE INTERCEPT FIELD FOR THIS DESTINATION. THE RELQCB IS POSTED * 11900021 * TO ITSELF TO CAUSE RELSTCB SUBTASK, IN THIS MODULE, TO GAIN * 12300021 * CONTROL IN DISABLED STATE. * 12700021 * WHEN RELSTCB SUBTASK GAINS CONTROL, THE QCB ADDRESS IS * 13100021 * OBTAINED. IF THE MESSAGE HEADER ADDRESS IN THE INTERCEPT FIELD IS * 13500021 * GREATER THAN THE MESSAGE ADDRESS IN QUEUE (QFAC), A PRIORITY * 13900021 * MESSAGE WAS INTERCEPTED. EXCEPT FOR THIS PRIORITY SITUATION, * 14300021 * THE DISK ADDRESS SAVED IN THE INTERCEPT OPTION FIELD OF THE TERM * 14700021 * TABLE IS STORED IN QFAC. THIS WILL CAUSE TRANSMISSION OF MESSAGES * 15100021 * STARTING WITH ADDRESS IN QFAC. IN ALL CASES, THE RELEASE PENDING * 15500021 * BIT (8) IS SET IN TSTATUS. IF THE SEND SCHEDULER IS ACTIVE, * 15900021 * RETURN IS MADE TO DISPATCH NEXT ITEM. IF SEND SCHEDULER IS NOT * 16300021 * ACTIVE, A PRIMER ELEMENT (IN MODULE) IS POSTED TO SEND SCHEDULER * 16700021 * TO CAUSE ACTIVATION OF SEND SCHEDULER. * 17100021 * UPON RETURN FROM THE QPOST, RETURN IS MADE TO THE PROCESSING * 17500021 * PROGRAM WITH A NORMAL RETURN CODE OF ZERO. * 17900021 * * 19500013 *ENTRY POINTS- * 20000013 * IECKRELM - EXPANSION OF THE RELEASEM MACRO INSTRUCTION GENERATES * 20500013 * A BALR TO THIS POINT, USING REGISTER 15 AS THE ENTRY POINT * 21000013 * REGISTER, AND REGISTER 14 AS THE RETURN REGISTER. * 21500013 * * 22000013 *INPUT- * 22500013 * REGISTER 1- PARAMETER REGISTER. WILL HOLD THE ADDRESS OF THE * 23000013 * TERMINAL NAME. * 23500013 * REGISTER 14- RETURN ADDRESS REGISTER. * 24000013 * REGISTER 15- ENTRY POINT REGISTER. * 24500013 * * 25000013 *OUTPUT- * 25500013 * REGISTER 15- RETURN CODE. * 26000013 * X'00'- NO ERRORS * 26500013 * X'04'- TERMINAL NOT IN INTERCEPT MODE * 27000013 * X'20'- TERMINAL ENTRY NOT FOUND. * 27500013 * X'02'- RESTART IN PROGRESS. * 28500021 * * 29500013 *EXTERNAL ROUTINES- * 30000013 * SVC QPOST * 30500021 * * 31000013 *EXITS- * 31500013 * NORMAL - RETURN IS ACCOMPLISHED BY ISSUING A RETURN MACRO WITH * 32000013 * A RETURN CODE OF X'00'. * 32500013 * ERROR - SAME AS ABOVE, BUT WITH ONE OF THE FOLLOWING RETURN CODES:* 33000013 * X'04'- TERMINAL NOT IN INTERCEPT MODE. * 33500013 * X'20'- TERMINAL TABLE NOT FOUND. * 34000013 * X'02'- RESTART IN PROGRESS. * 34200021 * * 34500013 *TABLES/WORK AREAS- * 35000013 * NONE. * 35500013 * * 36000013 *ATTRIBUTES- * 36500013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 37000013 * * 37500013 *NOTES- * 38000013 * REGISTER 2- WORK REGISTER. USED FOR PARAMETER TO QMOVE * 38500013 * REGISTER 3- WORK REGISTER. LENGTH FOR TSTUS CHANGE * 39000013 * REGISTER 4- WORK REGISTER. QCB ADDRESS. 'TO' ADDRESS FOR MOVE. * 39500013 * REGISTER 5- WORK REGISTER. ADDRESS OF INTERCEPT FIELD IN * 40000013 * TERMINAL TABLE ENTRY. * 40500013 * REGISTER 7- WORK REGISTER. ADDRESS OF TERMINAL TABLE. * 41000013 * REGISTER 8- BASE REGISTER FOR TERMINAL TABLE. * 41500013 * REGISTER 9- WORK REGISTER. ADDRESS OF LPS FOR THIS DESTINATION. * 42000013 * REGISTER 11- WORK REGISTER. ADDRESS OF LPS QUEUE. * 42500013 * * 43000013 *********************************************************************** 43500013 IECKRELM START 44000013 *1171660000-755000,782000 5480 44200016 *341062000-627000,777000,786000-787000,847000 19198 44300017 * 597000,605000,610000-620000,626000,695000-715000,782000-785000, 25340 44360018 * 787000,847060-849760,856000,857000 25340 44420018 *A035000,087000-097000,105000,119000-179000,285000,305000,342000 S21016 44460021 FREG EQU 1 44500013 WORKREG EQU 2 45000013 XREG EQU 3 45500013 WREG EQU 4 46000013 RD EQU 5 46500013 DREG1 EQU 7 47000013 TCREG EQU 8 47500013 WREG1 EQU 9 48000013 WREG2 EQU 10 48500013 LPSQUE EQU 11 49000013 IREG EQU 12 49500013 RREG1 EQU 14 50000013 SREG EQU 15 50500013 USING IECKTERM,TCREG 51000013 USING *,SREG 51500013 SAVE (14,12) SAVE REGISTERS 14-12 52000013 SR WREG1,WREG1 CLEAR WORKING REGISTER 52500013 L DREG1,16 GET COMMUNICATIONS VECTOR TABLE (CVT) ADDRESS 53000013 L DREG1,156(0,DREG1) GET THE TERMTBL ADDRESS FROM THE CVT 53500013 IC WREG1,4(0,DREG1) GET MAXIMUM SIZE OF TERMINAL NAME 54000013 L LPSQUE,4(DREG1) GET ADDRESS OF IGG019NG 54500013 L LPSQUE,0(LPSQUE) GET ADDRESS OF LPS QUEUE 55000013 BCTR WREG1,0 ADJUST COUNT FOR EXECUTE 55500013 LR TCREG,DREG1 SET UP THE BASE REGISTER FOR TERMTBL 56000013 LA RD,8 INITIALIZE FOR FIRST ENTRY 56500013 COMPAR1 CL TCREG,0(0,DREG1) IS THIS END OF TABLE 57000013 BE DESTERR BRANCH IF END OF TABLE 57500013 AR TCREG,RD INDEX NEXT ENTRY 58000013 IC RD,TNTRYSZE GET ENTRY SIZE 58500013 EX WREG1,DESTCK2 IS THIS CORRECT TERMINAL ENTRY 59000013 BC 7,COMPAR1 BRANCH IF NO 59500013 TM TSTATUS,12 IS TERMINAL IN INTERCEPT OR 25340 59700018 * IS RELEASEM PENDING 25340 59900018 BNM RETURN2 EXIT IF NOT INTERCEPTED OR 25340 60100018 * IF RELEASEM PENDING WITH X'04'25340 60300018 * RETURN CODE 25340 60500018 L WREG,TQCBADDR-1 GET QCB ADDRESS FROM TABLE ENTRY 62500013 CLC QLINK-QBLOCK(3,WREG),ZEROS IS RESTART IN PROGRESS 19198 62600018 BNE RETURN3 YES,DO NOT RELEASE 19198 62700017 L WREG1,16(0,WREG) GET DCB ADDRESS FROM THE QCB 63000013 L WREG1,20(0,WREG1) GET LPS ADDRESS FROM THE DCB 63500013 IC RD,4(0,WREG1) GET OFFSET TO INTERCEPT FIELD 64000013 * (STORED BY THE INTERCEPT ROUTINE) 64500013 AR RD,TCREG ADD IN TERMINAL ENTRY ADDRESS TO GET 65000013 * ADDRESS OF INTERCEPT FIELD 65500013 LR WREG,TCREG COPY ADDRESS OF TERMTBL ENTRY 5480 68500016 STM WREG,RD,SAVE SAVE REGISTERS FOR SUBTASK 25340 69500018 LA FREG,RELSTCB SET R1 FOR QPOST 25340 70500018 LR WORKREG,FREG SET R2 FOR QPOST 25340 71500018 SVC QPOST CAUSE TSTATUS TO BE CHANGED 76000013 RETURN (14,12),RC=0 SET X'00' FOR NORMAL RETURN 76500013 DESTERR RETURN (14,12),RC=32 SET X'20' FOR ENTRY NOT FOUND 77000013 RETURN2 RETURN (14,12),RC=4 SET X'04' TERMINAL NOT IN INTERCEPT 77500013 RETURN3 RETURN (14,12),RC=2 SET RETURN CODE 19198 77700017 * 78000013 ZEROS DC X'000000' 19198 78600017 QPOST EQU 67 79000013 CVTABLE EQU 16 79500013 CVTTRMTB EQU 156 80000013 * 80500013 * 81000013 DESTCK2 CLC TERMID(1),0(FREG) COMPARE TERMINAL NAME 81500013 SPACE 82000013 * THE FOLLOWING ERROR FLAGS ARE PASSED TO THE USER RIGHT ADJUSTED 82500013 * IN REGISTER 15 BY THIS ROUTINE 83000013 * X'00' NO ERRORS 83500013 * X'04' TERMINAL NOT IN INTERCEPT 84000013 * X'20' TERMINAL ENTRY NOT FOUND 84500013 * X'02' RELEASE CANNOT BE DONE DURING RESTART 19198 84700017 EJECT 84706018 * 25340 84712018 * THE FOLLOWING SUBTASK IS ACTIVATED TO CHANGE THE TSTATUS 25340 84718018 * FIELD OF THE TERMTABLE ENTRY, RESET QFAC IN THE QCB, AND POST 25340 84724018 * A PRIMER ELEMENT TO THE SEND SCHEDULER TO START SENDING TO THE 25340 84730018 * RELEASED TERMINAL 25340 84736018 * 25340 84742018 RELSTCB DC A(RELSTCB) 25340 84748018 DC X'FE' 25340 84754018 DC AL3(RELSTCB) 25340 84760018 RELQCB DC X'02' 25340 84766018 DC AL3(RELQCB) 25340 84772018 DC X'FF00' 25340 84778018 USING RELQCB,WORKREG 25340 84784018 USING QBLOCK,DREG1 25340 84790018 LM WREG,RD,SAVE RELOAD SAVED REGISTERS 25340 84796018 L DREG1,0(WREG) GET QCB ADDRESS 25340 84802018 CLC QFAC(3),0(RD) COMPARE MESSAGE HEADER ADDRESS 25340 84808018 * IN TERMTBL INTERCPT FIELD TO 25340 84814018 * ADDRESS OF THE FIRST ELEMENT 25340 84820018 * IN THE QUEUE 25340 84826018 BNH *+10 BRANCH IF HEADER ADDRESS IS 25340 84832018 * GREATER THAN MESSAGE ADDRESS 25340 84838018 * IN QUEUE (PRIORITY MESSAGES 25340 84844018 * HAVE BEEN INTERCEPTED) 25340 84850018 MVC QFAC(3),0(RD) UPDATE QFAC WITH NEW RRN 25340 84856018 OI TSTATUS-IECKTERM(WREG),8 SHOW RELEASEM PENDING 25340 84862018 * (TESTED IN DISK-END) 25340 84868018 L WREG,QTRAN GET STCB POINTER FROM QCB 25340 84874018 CLI 0(WREG),X'68' IS THE SEND SCHEDULER ACTIVE 25340 84880018 BNE DISPATCH(IREG) YES, RETURN TO DISPATCH NEXT 25340 84886018 * READY ITEM 25340 84892018 LA FREG,PRIMER PUT PRIMER ADDRESS IN R1 25340 84898018 LA WORKREG,0(0,DREG1) QCB ADDRESS TO R2 (NOTE, THIS 25340 84904018 * DESTROYS THE BASE REGISTER) 25340 84910018 B POST(IREG) GO TO POST PRIMER TO SNED 25340 84916018 * SCHEDULER 25340 84922018 SPACE 3 84928018 PRIMER DC A(PRIMER) 25340 84934018 DC X'FE' 25340 84940018 DC AL3(PRIMER) 25340 84946018 SPACE 3 84952018 SAVE DS 2F 25340 84958018 SPACE 3 84964018 POST EQU X'80' 25340 84970018 DISPATCH EQU X'F6' 25340 84976018 EJECT 85000013 TERMTBLD 85500013 EJECT 85600018 QCBD 85700018 END 86000013 ./ ADD SSI=03011280,NAME=IECKRETD,SOURCE=0 TITLE 'IECKRETD QTAM RETRIEVE-DASD (RETRIEVE)' 00500013 *********************************************************************** 01000013 * * 01500013 *NAME- * 02000013 * IECKRETD QTAM RETREIVE-DASD * 02500013 * * 03000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 03500013 * * 04000013 *FUNCTION- * 04500013 * CAUSES A MESSAGE SEGMENT TO BE RETRIEVED AND PLACED IN THE * 05000013 * CALLING PROGRAM'S WORK AREA (SPECIFIED AS THE SECOND OPERAND OF * 05500013 * THE RETRIEVE MACRO) WHEN A REGISTER IS SPECIFIED AS THE FIRST * 06000013 * OPERAND OF THE MACRO. THE SPECIFIED REGISTER MUST CONTAIN THE * 06500013 * DIRECT ACCESS DEVICE ADDRESS OF THE MESSAGE SEGMENT TO BE * 07000013 * RETRIEVED. THE SEGMENT IS RETRIEVED FROM THE DASD DESTINATION * 07500013 * OR PROCESS QUEUES AND PLACED INTO THE WORK AREA. THE REGISTERS * 08000013 * ARE STORED IN THE SAVE AREA POINTED TO BY REGISTER 13. * 08500013 * IF AN INVALID DISK ADDRESS IS RECEIVED (IF THE ADDRESS IS * 09000013 * GREATER THAN THE LAST ONE ASSIGNED), AN ERROR CODE OF A X'02' * 09500013 * IS PLACED IN REGISTER 15 AND RETURN IS TO THE NEXT INSTRUCTION * 10000013 * IN THE PROCESSING PROGRAM. * 10500013 * A COMBINATION BRB AND QCB IS BUILT IN THE CALLING ROUTINES'S * 11000013 * WORK AREA AS FOLLOWS: * 11500013 * 1) THE ADDRESS OF THE QUEUE-INSERT-BY-PRIORITY-STCB IS * 12000013 * PLACED IN THE QTRAN FIELD AT WORK AREA + 12. * 12500013 * 2) THE DIRECT ACCESS ADDRESS IS PLACED IN THE BRB AT WORK * 13000013 * AREA + 16 AS THE RELATIVE RECORD ADDRESS OF THE NEXT * 13500013 * SEGMENT TO BE READ. * 14000013 * 3) A X'09' IS PLACED IN THE MSTATUS FIELD OF THE BRB (AT * 14500013 * WORK AREA + 16) TO INDICATE THAT A DISK RECORD IS TO * 15000013 * BE READ. * 15500013 * 4) THE PRIORITY AT WORK AREA + 8 IS SET TO A X'E4'. * 16000013 * THE BRB/QCB IS THEN POSTED (SVC 67) TO THE DISK QUEUE AND A * 16500013 * WAIT (SVC 65) IS ISSUED TO AWAIT DISK I/O COMPLETION. ANOTHER * 17000013 * WAIT IS ISSUED TO ENSURE THAT THE BRB/QCB IS OFF THE READY QUEUE * 17500013 * SO THE WORK AREA CAN BE USED. THE MESSAGE IS THEN MOVED INTO THE * 18000013 * WORK AREA AND THE BUFFER IS MADE AVAILABLE AGAIN BY POSTING IT * 18500013 * TO THE AVAIABLE BUFFER QUEUE. THEN THE REGISTERS ARE RESTORED * 19000013 * EXCEPT REGISTER 15 AND RETURN IS TO THE NEXT INSTRUCTION IN THE * 19500013 * CALLING ROUTINE. REGISTER 15 NOW CONTAINS EITHER A CODE OF ZERO, * 20000013 * SIGNIFYING COMPLETION OF RETRIEVAL, OR A CODE OF X'02', SIGNIFING * 20500013 * THAT AN INVALID DIRECT ACCESS ADDRESS WAS PASSED. * 21000013 * * 21500013 *ENTRY POINTS- * 22000013 * IECKRETD - EXPANSION OF THE RETRIEVE MACRO WITH A REGISTER NAME * 22500013 * OR NUMBER ENCLOSED IN PARENTHESIS GIVEN AS THE FIRST * 23000013 * OPERAND GENERATES A BALR TO THIS POINT USING REGISTER * 23500013 * 15 AS THE ENTRY POINT REGISTER AND REGISTER 14 AS THE * 24000013 * RETURN REGISTER. ALTERNATE ENTRY IS FROM IECKRETS. * 24500013 * * 25000013 *INPUT- * 25500013 * REGISTER 0- CONTAINS THE ADDRESS OF THE WORK AREA INTO WHICH * 26000013 * THE MESSAGE IS TO BE PLACED. * 26500013 * REGISTER 1- CONTAINS THE DIRECT ACCESS ADDRESS OF THE MESSAGE * 27000013 * SEGMENT TO BE RETRIEVED. * 27500013 * REGISTER 14- RETURN ADDRESS. * 28000013 * REGISTER 15- ENTRY POINT. * 28500013 * * 29000013 *OUTPUT- * 29500013 * THE MESSAGE SEGMENT IS MOVED TO THE WORK AREA SPECIFIED IN THE * 30000013 * SECOND OPERAND OF THE RETRIEVE MACRO, UNLESS AN * 30500013 * INVALID DISK ADDRESS IS SPECIFIED, IN WHICH CASE A * 31000013 * CODE OF X'02' IS RETURNED IN REGISTER 15. * 31500013 * REGISTER 15- RETURN CODE OF X'00' FOR SEGMENT FOUND OR X'02' FOR * 32000013 * INVALID DIRECT ACCESS ADDRESS SPECIFIED. * 32500013 * * 33000013 *EXTERNAL ROUTINES- * 33500013 * QWAIT- IGG065 IN MODULE IECKQQ01 TO WAIT FOR DISK I/O COMPLETION * 34000013 * AND TO WAIT FOR THE BRB/QCB TO BE REMOVED FROM THE * 34500013 * READY QUEUE. * 35000013 * QPOST-IGG067 IN MODULE IECKQQ01 TO POST THE BRB/QCB TO THE DISK * 35500013 * I/O QUEUE AND TO POST THE BUFFER USED TO THE ACTIVE * 36000013 * BUFFER QUEUE. * 36500013 * * 37000013 *EXITS- * 37500013 * NORMAL- RETURN TO NEXT INSTRUCTION IN THE CALLING ROUTINE WITH * 38000013 * A CODE OF ZERO IN REGISTER 15. * 38500013 * ERROR- RETURN TO NEXT INSTRUCTION IN THE CALLING ROUTINE WITH A * 39000013 * CODE OF X'02' IN REGISTER 15. * 39500013 * * 40000013 *TABLES/WORK AREAS- * 40500013 * NONE. * 41000013 * * 41500013 *ATTRIBUTES- * 42000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 42500013 * * 43000013 *NOTES- * 43500013 * INTERNAL REGISTER USAGE IS AS FOLLOWS: * 44000013 * REGISTER 1- CONTAINS BUFFER ADDRESS ON RETURN FROM QWAIT, * 44500013 * WHICH IS USED AS INPUT TO QPOST. * 45000013 * REGISTER 2- CONTAINS RETURN CODE TO BE PLACED IN REGISTER * 45500013 * 15. * 46000013 * REGISTER 3- CONTAINS BRB/QCB ADDRESS FOR SETTING UP BRB/QCB.* 46500013 * REGISTER 4- USED TO SAVE THE BUFFER ADDRESS RETURNED FROM * 47000013 * QWAIT. * 47500013 * REGISTER 5- LOADED WITH ADDRESS OF IGG019NG. * 48000013 * REGISTER 6- LOADED WITH SIZE OF MESSAGE SEGMENT -1, USED * 48500013 * TO EXECUTE MOVE TO PLACE SEGMENT IN WORK AREA. * 49000013 * REGISTER 10- LOADED WITH ADDRESS OF QUEUES IN IGG019NG. * 49500013 * REGISTER 12- LOADED WITH ADDRESS OF CVT. * 50000013 * REGISTER 15- BASE REGISTER FOR THIS ROUTINE. * 50500013 * * 51000013 *********************************************************************** 51500013 IECKRETD START 52000013 *3410836000-843000,932000 8833 52200019 * 833000,967000 A28773 52300019 R0 EQU 0 ADDR OF USER SPECIFIED WORK AREA AT ENTRY TO MODULE 52500013 FREG EQU 1 53000013 TREG EQU 2 53500013 QREG EQU 3 54000013 DREG EQU 4 54500013 SAVREG EQU 5 55000013 WREG2 EQU 6 55500013 WREG0 EQU 9 CONTENTS OF R0 AT ENTRY 56000013 RC EQU 10 BASE REG FOR QUEUES IN IGG019NG 56500013 RD EQU 12 57000013 RETR EQU 14 57500013 SREG EQU 15 58000013 * 58500013 QWAIT EQU 65 59000013 QPOST EQU 67 59500013 * 60000013 * UPON ENTRY REGISTER 1 CONTAINS THE 3-BYTE RECORD ADDRESS 60500013 * REGISTER 0 CONTAINS THE ADDRESS OF THE WORKAREA 61000013 SPACE 61500013 USING *,SREG 62000013 SAVE (14,12) 62500013 L RD,CVTABLE(0,0) GET ADDRESS OF COMM VECT TABLE 63000013 L RC,CVTTRMTB(0,RD) GET TERMTBL ADDRESS FROM CVT 63500013 L SAVREG,TTQUES(0,RC) GET ADDR OF IGG019NG 64000013 L RC,0(0,SAVREG) GET ADDR OF QUEUES FROM IGG019NG WORD 1 64500013 * 65000013 * TEST FOR VALID DISK ADDRESS 65500013 * 66000013 C FREG,196(RC) DISK ADDRESS TO LAST ASSIGNED 66500013 LA TREG,2 LOAD ERROR CODE 67000013 BH RET BRANCH ON INVALID ADDRESS 67500013 * 68000013 * BUILD A BRB/QCB IN USERS WORK AREA 68500013 * 69000013 LR QREG,R0 COPY ADDRESS OF THE WORKAREA 69500013 LA QREG,4(QREG) ADD FOUR TO ADDRESS 70000013 SRL QREG,2 ASSURE FULL WORD BOUNDRY 70500013 SLL QREG,2 ASSURE FULL WORD BOUNDRY 71000013 LA TREG,QPRIRTY(0,RC) GET ADDRESS OF QUEUE-INSERT- 71500013 * BY-PRIORITY-STCB 72000013 ST TREG,8(0,QREG) QTRAN (ADDR OF STCB) 72500013 ST FREG,12(QREG) PUT DASD ADDR INTO QCB/BRB 73000013 MVI 12(QREG),9 9 IN MSTATUS-DISK RECORD TO BE READ 73500013 * 74000013 * POST THE BRB/QCB TO THE DISK QUEUE 74500013 * 75000013 MVI 4(QREG),X'E4' SET PRIOROITY 75500013 LA TREG,DISK(0,RC) DISK I/O STCB ADDR 76000013 LR FREG,QREG QCB/BRB ADDRESS TO FREG 76500013 SVC QPOST POST BRB-QCB TO DISK QUEUE 77000013 * 77500013 * QWAIT QCB NOW CREATED FROM BRB 78000013 * WAIT FOR DISK COMPLETION 78500013 * 79000013 LR TREG,QREG QCB ADDR TO TREG 79500013 SVC QWAIT WAIT FOR DISK I/O COMPLETION 80000013 LR DREG,FREG SAVE THE BUFFER ADDRESS 80500013 LA TREG,QATTACH(0,SAVREG) TREG HAS ADDR QATTACH QCB 81000013 SVC QWAIT ASSURE THE BRB/QCB IS OFF READY 81500013 SPACE 82000013 * ON RETURN, DREG CONTAINS ADDR OF RECORD RETRIEVED FROM DISK 82500013 USING IECKPREF,DREG 83000013 LH WREG2,BUFSIZE(RC) USE BUFFER SIZE FOR MOVE A28773 83300019 LR QREG,R0 8833 83600019 LR FREG,DREG BUFFER ADDR TO FREG FOR POST 8833 83700019 CH WREG2,H256 IS BUFFER SIZE GREATER THAN256 8833 83800019 BNH LESS BRANCH IF LESS OR EQUAL 8833 83900019 MVC 0(256,QREG),FDATA-FBLOCK(DREG) MOVE 256 OF BUFFER 8833 84000019 AH DREG,H256 ADD 256 TO BUFFER ADDR FOR NEXT MOVE 8833 84100019 AH QREG,H256 ADD 256 TO WORK AREA 8833 84200019 LESS BCTR WREG2,0 SUBTRACT ONE FOR EXECUTE 8833 84300019 EX WREG2,MOVSEG EXECUTE MOVE 85000013 * 85500013 * RETURN BUFFER TO AVAILABLE BUFFER QUEUE 86000013 * 86500013 LA TREG,BUFFER(0,RC) GET ADDR OF AVAILABLE BUFFER QUEUE 87500013 SVC QPOST POST BUFFER TO AVAILABLE BUFFER QUEUE 88000013 * 88500013 * RETURN TO THE CALLER 89000013 * 89500013 SR TREG,TREG SET VALID COMPLECTION CODE 90000013 RET LR 15,TREG COMPLECTION CODE TO REGISTER 15 90500013 RETURN (0,12) 91000013 * 91500013 MOVSEG MVC 0(0,QREG),FDATA-FBLOCK(DREG) MOVE SEG. TO WORK AREA 92000013 * 92500013 CVTABLE EQU 16 93000013 H256 DC H'256' 8833 93200019 CVTTRMTB EQU 156 93500013 TTQUES EQU 4 94000013 * 94500013 BUFFER EQU 24 AVAILABLE BUFFER QCB 95000013 DISK EQU 36 DISK I/O QCB 95500013 QPRIRTY EQU 60 QUEUE INSERT BY PRIORITY STCB 96000013 QATTACH EQU 72 QATTACH QCB 96500013 BUFSIZE EQU 154 M3621 96700019 * 97000013 EJECT 97500013 PREFIXD 98000013 END 98500013 ./ ADD SSI=03011960,NAME=IECKRETS,SOURCE=0 TITLE ' QTAM RETRIEVE BY SEQUENCE NUMBER ' 00300013 *********************************************************************** 00600013 * * 00900013 *NAME- * 01200013 * IECKRETS QTAM RETRIEVE BY SEQUENCE NUMBER * 01500013 * * 01800013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 02100013 * * 02400013 *FUNCTION- * 02700013 * CAUSES A MESSAGE SEGMENT TO BE RETRIEVED AND PLACED IN THE * 03000013 * CALLING PROGRAM'S WORK AREA (SPECIFIED AS THE SECOND OPERAND OF * 03300013 * THE RETRIEVE MACRO) WHEN THE FIRST OPERAND OF THE MACRO IS THE * 03600013 * NAME OF THE DESTINATION TERMINAL TO WHICH THE MESSAGE SEGMENT * 03900013 * WAS SENT. THE PURPOSE OF THIS ROUTINE IS TO PROVIDE THE PROPER * 04200013 * REGISTER SETUP FOR USE BY IECKRETD, WHICH RETRIEVES THE MESSAGE * 04500013 * WHEN REGISTER ONE CONTAINS THE DIRECT ACCESS ADDRESS OF THE * 04800013 * MESSAGE SEGMENT AND REGISTER 0 CONTAINS THE ADDRESS OF THE WORK * 05100013 * AREA INTO WHICH THE MESSAGE IS TO BE PLACED. THE ROUTINE SAVES * 05400013 * ALL THE REGISTERS AND PLACES THE ADDRESS OF IT'S OWN SAVE AREA * 05700013 * INTO REGISTER 13 FOR USE BY IECKRETD. * 06000013 * THE CVT (COMMUNICATIONS VECTOR TABLE) PROVIDES THE ADDRESS * 06300013 * OF THE TERMINAL TABLE AT CVT + 156. THE TERMINAL TABLE IS * 06600013 * SEARCHED FOR A MATCHING DESTINATION NAME. IF THERE IS NO * 06900013 * MATCHING NAME, A CODE OF X'20' IS PLACED IN REGISTER 15 AND * 07200013 * RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE. IF * 07500013 * A MATCHING NAME IS FOUND, THE OFFSET OF THE ENTRY FROM THE * 07800013 * START OF THE TERMINAL TABLE IS SAVED AND THE DESTINATION QUEUE * 08100013 * ADDRESS IS OBTAINED FROM THE TERMINAL TABLE ENTRY. THE DISK * 08400013 * ADDRESS FOR THE START OF THE SEARCH IS THEN OBTAINED FROM THE * 08700013 * DESTINATION QUEUE. THE ADDRESS OF THE SEQUENCE FIELD (EITHER * 09000013 * IN OR OUT AS DESIGNATED BY A NEGATIVE OR POSTITIVE NUMBER * 09300013 * RESPECTIVELY) IS COMPUTED, AND THE ROUTINE BRANCHES TO IECKRETD * 09600013 * TO RETRIEVE THE NEXT SEGMENT OF THE MESSAGE, UNLESS THE DIRECT * 09900013 * ACCESS ADDRESS IS ZERO, IN WHICH CASE THE REGISTERS ARE RESTORED * 10200013 * AND RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE * 10500013 * WITH A CODE OF X'40' IN REGISTER 15. IF THE SEQUENCE NUMBER * 10800013 * SPECIFIED BY THE CALLING ROUTINE IS GREATER THAN THE SEQUENCE * 11100013 * NUMBER OF THE RETRIEVED MESSAGE OF IF THE RETRIEVED MESSAGE WAS * 11400013 * A PRIORITY MESSAGE, THE NEXT MESSAGE IS OBTAINED BY IECKRETD. * 11700013 * THIS PROCESS CONTINUES UNTIL EITHER THE MESSAGE IS FOUND OR A * 12000013 * MESSAGE THAT IS NOT A PRIORITY MESSAGE WHICH HAS A LARGER * 12300013 * SEQUENCE NUMBER THAN THE ONE GIVEN BY THE CALLING ROUTINE. THE * 12600013 * LATTER INDICATES AN INVALID SEQUENCE NUMBER AND IN THIS CASE * 12900013 * THE REGISTERS ARE RESTORED AND RETURN IS TO THE NEXT INSTRUCTION * 13200013 * IN THE CALLING ROUTINE WITH A CODE OF X'40' IN REGISTER 15. IF * 13500013 * THE SEQUENCE NUMBER IS ZERO, WHICH INDICATES AN ERROR MESSAGE, THE* 13530000 * SEARCH CONTINUES FOR THE MESSAGE IN ERROR. IN ORDER TO RETRIEVE * 13560000 * INTERCEPTED MESSAGES, THE FOLLOWING TESTS ARE MADE. IF THE MESSAGE* 13590000 * IS NOT SERVICED AND FOR SEQUENCE OUT, THE RETRIEVE IS INVALID. * 13620000 * IF THE MESSAGE IS SERVICED AND FOR SEQUENCE OUT OR THE RETRIEVE * 13650000 * IS FOR SEQUENCE IN, A CHECK IS MADE FOR COMPLETE MESSAGE RECEIVED.* 13680000 * IF LINE IS SENDING OR PARTIAL MSG BIT OFF, THEN MSG IS VALID. IF * 13710000 * THE PROPER SEQUENCE NUMBER IS FOUND, THE MESSAGE SEGMENT IS * 13800013 * MOVED TO THE CALLING ROUTINE'S WORK AREA (THIS IS DONE BY * 14100013 * IECKRETD), THE REGISTERS ARE RESTORED, AND RETURN IS TO THE NEXT * 14400013 * INSTRUCTION IN THE CALLING ROUTINE WITH A CODE OF ZERO IN * 14700013 * REGISTER 15. * 15000013 * * 15300013 *ENTRY POINTS- * 15600013 * IECKRETS - EXPANSION OF THE RETRIEVE MACRO WITH A DESTINATION * 15900013 * TERMINAL NAME AS THE FIRST OPERAND GENERATES A BALR * 16200013 * TO THIS POINT USING REGISTER 15 AS THE ENTRY POINT * 16500013 * REGISTER AND REGISTER 14 AS THE RETURN REGISTER. * 16800013 * * 17100013 *INPUT- * 17400013 * REGISTER 0- ADDRESS OF THE WORK AREA INTO WHICH THE MESSAGE * 17700013 * SEGMENT IS TO BE PLACED. THE DESTINATION TERMINAL * 18000013 * NAME WILL START IN THE FIRST BYTE OF THIS WORK AREA. * 18300013 * * 18600013 *OUTPUT- * 18900013 * THE REQUESTED MESSAGE SEGMENT WILL BE MOVED TO THE WORK AREA * 19200013 * SPECIFIED AS THE SECOND OPERAND OF THE RETRIEVE * 19500013 * MACRO, UNLESS AN ERROR OCCURS, IN WHICH CASE THE * 19800013 * FOLLOWING RETURN CODES ARE PLACED IN REGISTER 15: * 20100013 * X'00' INDICATES NO ERRORS. * 20400013 * X'20' INDICATES INVALID DESTINATION TERMINAL NAME. * 20700013 * X'40' INDICATES INVALID SEQUENCE NUMBER. * 21000013 * * 21300013 *EXTERNAL ROUTINES- * 21600013 * IECKRETD - TO RETRIEVE THE MESSAGE SEGMENT BY DIRECT ACCESS * 21900013 * ADDRESS. * 22200013 * * 22500013 *EXITS- * 22800013 * NORMAL- RETURN IS TO NEXT INSTRUCTION IN THE CALLING ROUTINE WITH * 23100013 * THE REQUESTED MESSAGE CONTAINED IN THE WORK AREA AND * 23400013 * A CODE OF X'00' IN REGISTER 15. * 23700013 * ERROR- RETURN IS TO THE NEXT INSTRUCTION IN THE CALLING ROUTINE * 24000013 * WITH ONE OF THE FOLLOWING CODES IN REGISTER 15: * 24300013 * X'20' INDICATING INVALID DESTINATION TERMINAL NAME. * 24600013 * X'40' INDICATING INVALID SEQUENCE NUMBER. * 24900013 * * 25200013 *TABLES/WORK AREAS- * 25500013 * SECOND - A WORK AREA USED AS A SAVE AREA FOR REGISTERS DURING * 25800013 * SECOND LEVEL LINKAGE TO IECKRETD. * 26100013 * * 26400013 *ATTRIBUTES- * 26700013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 27000013 * * 27300013 *NOTES- * 27600013 * INTERNAL REGISTER USAGES ARE AS FOLLOWS: * 27900013 * REGISTER 1- USED FOR INTERNAL LINKAGE TO A ROUTINE WHICH * 28200013 * CHECKS THE SEQUENCE NUMBER FOR VALIDITY WHEN * 28500013 * EACH MESSAGE IS OBTAINED. * 28800013 * REGISTER 2- LOADED WITH ADDRESS OF TERMINAL TABLE. * 29100013 * REGISTER 3- BASE REGISTER FOR THIS ROUTINE. * 29400013 * REGISTER 4- LOADED WITH ADDRESS OF SEQUENCE NUMBER FIELD * 29700013 * OF HEADER * 30000013 * REGISTER 5- LOADED WITH ADDRESS OF TERMINAL TABLE ENTRY. * 30300013 * REGISTER 6- LOADED WITH RETURN ADDRESS OF INTERNAL ROUTINE * 30600013 * WHICH GETS THE NEXT RECORD. * 30900013 * REGISTER 7- LOADED WITH CODE OF ZERO FOR SEQUENCE IN FIELD * 31200013 * TO BE COMPARED WITH NUMBER PASSED IN REGISTER * 31500013 * 1 AND X'02' FOR SEQUENCE OUT FIELD. * 31800013 * REGISTER 8- LOADED WITH LENGTH OF TERMID FOR COMPARE AND * 32100013 * USED TO COMPUTE OFFSET OF TABLE ENTRY FROM * 32400013 * BEGINNING OF TERMINAL TABLE. * 32700013 * REGISTER 9- USED TO SAVE WORK AREA ADDRESS PASSED IN * 33000013 * REGISTER 0. * 33300013 * REGISTER 10- USED TO SAVE POSITIVE SEQUENCE NUMBER PASSED * 33600013 * IN REGISTER 1. * 33900013 * REGISTER 11- USED TO SAVE MSHEAD FIELD OF HEADER WHICH * 34200013 * CONTAINS DISK ADDRESS OF PREVIOUS MESSAGE * 34500013 * HEADER. * 34800013 * REGISTER 12- USED TO SAVE MSLINK FIELD OF HEADER WHICH * 35100013 * CONTAINS DISK ADDRESS OF NEXT MESSAGE HEADER. * 35400013 * REGISTER 13- LOADED WITH ADDRESS OF THIS ROUTINE'S SAVE AREA.* 35700013 * REGISTER 14- SECOND LEVEL RETURN REGISTER FROM IECKRETD. * 36000013 * REGISTER 15- SECOND LEVEL ENTRY POINT REGISTER TO IECKRETD. * 36300013 * * 36600013 *********************************************************************** 36900013 IECKRETS START 37200013 *1171699000-702000 5619 37300000 *1171757000-758000 00PS 37400000 *1201758300-758600 22427 37450000 * 626000 A27523 37500000 * 758320-758800,444300-446400 00PS 37550000 * 625000-626000 M3161 37600000 * 553000 00PS 37630000 * 758426-758432,758583-758595 A31038 37660000 R0 EQU 0 37700000 FREG EQU 1 37800013 TREG EQU 2 38100013 BASE EQU 3 38400013 HEAD EQU 4 38700013 TERM EQU 5 39000013 NEXT EQU 6 39300013 IO EQU 7 39600013 OFF EQU 8 39900013 AREA EQU 9 40200013 SEQ EQU 10 40500013 LINK EQU 11 40800013 DASD EQU 12 41100013 SAVE EQU 13 41400013 RET EQU 14 41700013 CODE EQU 15 42000013 INVALID EQU 32 42300013 CVTTRMTB EQU 156 42600013 BADSEQ EQU 64 42900013 QBACK EQU 29 43200013 MSLINK EQU 8 43500013 TTSKEY EQU 2 43800013 TTDKEY EQU 18 44100013 MSTATUS EQU 4 44400013 TQCB EQU 0 00PS 44430000 QPRI EQU 4 A31038 44437000 QRET EQU 8 A31038 44444000 QPROC EQU 12 A31038 44451000 QDCB EQU 17 00PS 44460000 QRLN EQU 16 00PS 44490000 DCBEIOBX EQU 36 00PS 44520000 DCBLCBAD EQU 32 00PS 44550000 MSLCB EQU 5 00PS 44580000 LCBSTATE EQU 0 00PS 44610000 LCBCHDR EQU 16 00PS 44640000 SAVE (14,12) 44700013 BALR BASE,0 45000013 USING *,BASE 45300013 ST SAVE,SECOND+4 SAVE ADDRESS OF SAVE AREA 45600013 LA SAVE,SECOND LOAD ADDRESS OF NEW SAVE AREA 45900013 * 46200013 * INITIALIZE IN/OUT REGISTER TO INDICATE SEQUENCE IN OR OUT 46500013 * 46800013 LA IO,2 INITIALIZE FOR SEQUENCE OUT 47100013 LPR SEQ,FREG POSITIVE SEQUENCE NUMBER TO WORK REG. 47400013 LTR FREG,FREG TEST SEQUENCE NUMBER PARAMETER 47700013 BP SETSEQ BRANCH REGISTER POSITIVE (SEQ. OUT) 48000013 SR IO,IO SET IN/OUT REGISTER TO SEQUENCE IN 48300013 * 48600013 * LOCATE CORRECT ENTRY IN THE TERM TABLE 48900013 * 49200013 SETSEQ LR AREA,R0 WORKAREA ADDRESS TO WORK REGISTER 49500013 LA CODE,INVALID RETURN CODE IF TERMINAL NOT FOUND 49800013 L TREG,16 ADDRESS OF THE CVT 50100013 L TREG,CVTTRMTB(TREG) ADDRESS OF QTAM TERMINAL TABLE 50400013 L LINK,0(TREG) ADDRESS OF LAST TERM TABLE ENTRY 50700013 LA LINK,0(LINK) CLEAR THE HIGH ORDER BYTE 51000013 LR TERM,TREG TERM TABLE ADDRESS TO WORK REGISTER 51300013 LA HEAD,8 INITIALIZE LENGTH REGISTER 51600013 IC OFF,4(TREG) LOAD MAXIMUM LENGTH OF TERM NAME 51900013 BCTR OFF,0 SUB ONE FOR COMPARE INSTRUCTION 52200013 TERMLOOP LA TERM,0(TERM,HEAD) COMPUTE NEXT TERM ENTRY ADDRESS 52500013 EX OFF,COMPARE COMPARE TERM NAMES 52800013 BE FOUND BRANCH IF CORRECT ENTRY 53100013 CR TERM,LINK END OF TERM TABLE 53400013 BE EXIT BRANCH IF YES TO RETURN ON ERROR 53700013 IC HEAD,0(TERM) LOAD LENGTH OF THIS ENTRY 54000013 B TERMLOOP BRANCH TO COMPARE NEXT TERM NAME 54300013 * 54600013 * INITIALIZE FOR MESSAGE SEARCH 54900013 * 55200013 FOUND L OFF,TQCB(TERM) LOAD QCB ADDRESS 00PS 55300000 CLI QRET(OFF),2 IS THIS A DISTRIBUTION LIST 00PS 55400000 BE EXIT YES, RETURN ERROR CODE=X'20' 00PS 55500000 LR OFF,TERM COPY TERM ENTRY ADDRESS 00PS 55600000 SLR OFF,TREG COMPUTE OFFSET FROM TERM TABLE START 55800013 STH OFF,SECOND+8 PLACE OFFSET IN WORKAREA 56100013 L NEXT,0(TERM) LOAD DESTINATION QUEUE ADDRESS 56400013 L DASD,QBACK-1(NEXT) DISK ADDRESS FOR START OF SEARCH 56700013 LA NEXT,GETNEXT RETURN ADDRESS TO GET NEXT RECORD 57000013 LA HEAD,20(AREA,IO) COMPUTE ADDRESS OF SEQUENCE FIELD 57300013 * 57600013 * RETRIEVE THE NEXT SEGMENT FROM THE DISK USING DIRECT ACCESS ADR. 57900013 * 58200013 GETNEXT LA DASD,0(DASD) CLEAR THE HIGH ORDER BYTE 58500013 LTR DASD,DASD TEST FOR ZERO ADDRESS 58800013 BZ ERROR BRANCH IF ZERO (END OF QUEUE) 59100013 BAL RET,RETR GO RETRIEVE NEXT RECORD 59400013 MVC SECOND+21(6),MSLINK(AREA) MSLINK AND MSHEAD TO SAVE AREA 59700013 LM LINK,DASD,SECOND+20 LOAD MSLINK AND MSHEAD FIELDS 60000013 SRL DASD,8 POSITION ADDRESS IN REGISTER 60300013 LTR IO,IO TEST FOR SEQUENCE IN OR SEQUENCE OUT 60600013 BC 7,SEQOUT BRANCH IF SEQUENCE OUT 60900013 * 61200013 * CHECK FOR CORRECT SEQUENCE IN MESSAGE 61500013 * 61800013 CLC SECOND+8(2),TTSKEY(AREA) IS SOURCE KEY CORRECT 62100013 BNE SEQOUT BRANCH NO TO GET NEXT MESSAGE 62400013 TM MSTATUS(AREA),X'44' HAS THIS MSG BEEN INTERCEPTED M3161 62500000 BO HEADERIN BRANCH IF YES TO CHECK SEQ. NO.M3185 62600000 TM MSTATUS(AREA),X'40' IS THIS A DUPLICATE HEADER 62700013 BO SEQOUT BRANCH IF YES 63000013 * 63300013 * RETRIEVE HEADER IF NOT ALREADY RETRIEVED 63600013 * 63900013 TM MSTATUS(AREA),1 IS THIS HEADER OF MESSAGE 64200013 BC 8,HEADERIN BRANCH IF YES 64500013 BAL RET,RETR GO RETRIEVE NEXT RECORD 64800013 SR RET,RET SIGNAL NOT ORGINAL RECORD 65100013 LR DASD,LINK SET ADDRESS OF NEXT RECORD IN QUEUE 65400013 * 65700013 * HEADER IN CHECK SEQUENCE NUMBER 66000013 * 66300013 HEADERIN BAL FREG,SEQCK GO TEST SEQUENCE NUMBER 66600013 LTR RET,RET WAS ORGINAL RECORD HEADER 66900013 BCR 8,NEXT ORGINAL RCD. NOT HEADER GO GET NEXT 67200013 B LOCATE GO FIND CHAIN TO NEXT RECORD 67500013 * 67800013 * CHECK FOR CORRECT SEQUENCE OUT MESSAGE 68100013 * 68400013 SEQOUT TM MSTATUS(AREA),1 IS THE A HEADER SEGMENT 68700013 BC 7,LOADDASD BRANCH NOT HEADER SEGMENT 69000013 LOCATE CLC SECOND+8(2),TTDKEY(AREA) COMPARE DESTINATION KEYS 69300013 BNE QUECK BRANCH IF NOT CORRECT TERMINAL 69600013 LTR IO,IO TEST FOR SEQUENCE IN OR SEQUENCE OUT 70500013 BCR 8,NEXT SEQUENCE IN GO GET NEXT RECORD 70800013 BAL FREG,SEQCK GO TEST SEQUENCE NUMBER 71100013 BR NEXT NOT CORRECT MSG. GO GET NEXT RECORD 71400013 * 71700013 * DETERMINE IF DESTINATION QUEUE EQUALS SEARCH QUEUE 72000013 * 72300013 QUECK MVC SECOND+2(2),TTDKEY(AREA) DESTINATION KEY TO WORK AREA 72600013 L FREG,SECOND LOAD TTDKEY 72900013 ALR FREG,TREG ADD IN START OF TERM TABLE 73200013 CLC 1(3,FREG),1(TERM) COMPARE QUEUE ADDRESSES 73500013 BCR 8,NEXT QUEUE'S DIFFERENT GO GET NEXT RECORD 73800013 LOADDASD LR DASD,LINK SET DISK ADDRESS OF THE NEXT RECORD 74100013 BR NEXT GO GET NEXT RECORD (USE MSLINK PT.) 74400013 * 74700013 * COMPARE SEQUENCE NUMBERS 75000013 * 75300013 SEQCK MVC SECOND+20(2),0(HEAD) SEQUENCE NUMBER TO WORK AREA 75600013 OC SECOND+20(2),SECOND+20 IS SEQUENCE NUMBER ZERO 00PS 75700000 BCR 8,FREG BRANCH IF YES 00PS 75800000 TM MSTATUS(AREA),X'10' IS MESSAGE SERVICED 22427 75830000 BO COMPLETE YES, COMPARE FOR MSG. COMPLETE 00PS 75832000 LTR IO,IO RETRIEVE BY SEQUENCE IN OR OUT 00PS 75834000 BZ COMPLETE SEQUENCE IN, CAN DO RETRIEVE 00PS 75836000 TM MSTATUS(AREA),X'44' IS SEQUENCE NO. OUT ASSIGNED 00PS 75838000 BCR 8,FREG NO, CANNOT DO RETREIVE 00PS 75840000 COMPLETE L CODE,TQCB(TERM) GET QCB ADDRESS 00PS 75842000 CLI QRET(CODE),X'68' IS THIS A DESTINATION QUEUE A31038 75842600 BNE PROCQ NO, CHECK FOR OPEN PROCESS Q A31038 75843200 SR OFF,OFF CLEAR REGISTER FOR IC 00PS 75844000 STH OFF,SECOND+28 CLEAR WORK AREA 00PS 75846000 IC OFF,QRLN(CODE) GET RLN FROM QCB 00PS 75848000 L CODE,QDCB-1(CODE) GET DCB ADDRESS 00PS 75850000 MVC SECOND+29(1),DCBEIOBX(CODE) MOVE LCB SIZE TO 00PS 75852000 * HALFWORD BOUNDARY 00PS 75854000 MH OFF,SECOND+28 RLN TIMES LCBSIZE 00PS 75856000 A OFF,DCBLCBAD(CODE) ADD IN LCB ADDRESS 00PS 75858000 B TESTSEQ GO TEST FOR SEQIN A31038 75858300 PROCQ CLI QPRI(CODE),1 IS PROCESS QUEUE OPEN A31038 75858600 BNE CHECKSEQ NO, OK TO RETRIEVE A31038 75858900 L OFF,QPROC(CODE) ELSE LOAD LCB ADDRESS A31038 75859200 TESTSEQ EQU * A31038 75859500 LTR IO,IO RETRIEVE BY SEQUENCE OUT OR IN 00PS 75860000 BZ SEQIN SEQ. IN, USE THIS LCB ADDRESS 00PS 75862000 L OFF,LCBSTATE(OFF) ELSE USE ORIGINATING LCB ADDR. 00PS 75864000 SEQIN TM LCBSTATE(OFF),4 IS LINE SENDING 00PS 75866000 BO CHECKSEQ YES, OK TO RETRIEVE MESSAGE 00PS 75868000 TM LCBSTATE(OFF),2 IS PARTIAL MSG. ENQUEUED 00PS 75870000 BZ CHECKSEQ NO, OK TO RETRIEVE MSG. 00PS 75872000 CLC LCBCHDR(3,OFF),MSLCB(AREA) IS THIS SAME MESSAGE 00PS 75874000 BCR 8,FREG YES, MSG. NOT COMPLETE, CANNOT 00PS 75876000 * BE RETRIEVED 00PS 75878000 CHECKSEQ EQU * 00PS 75880000 CH SEQ,SECOND+20 COMPARE SEARCH SEQUENCE NUMBER TO IT 75900013 BE RETURN MESSAGE RETRIEVED EXIT 76200013 BCR 4,FREG RETURN IF SEQUENCE NUMBER LOW 76500013 TM MSTATUS(AREA),4 TEST FOR PRIORITY MESSAGE 76800013 BCR 7,FREG RETURN MESSAGE IS PRIORITY MESSAGE 77100013 ERROR LA CODE,BADSEQ LOAD ERROR CODE BAD SEQUENCE NUMBER 77400013 B EXIT 77700013 * 78000013 * RETRIEVE A RECORD FROM THE DISK 78300013 * 78600013 RETR LR FREG,DASD DIRECT ACCESS ADDRESS TO REGISTER 1 78900013 L 15,=V(IECKRETD) ADDRESS OF RETRIEVE BY DISK ADDR. RT. 79200013 BR 15 LINK TO ROUTINE 79500013 * 79800013 * RETURN TO THE CALLER 80100013 * 80400013 RETURN SR CODE,CODE SET VALID RETURN CODE 80700013 EXIT L SAVE,SECOND+4 RELOAD ADDRESS OF USERS SAVE AREA 81000013 L RET,12(SAVE) LOAD RETURN ADDRESS 81300013 RETURN (0,12) 81600013 COMPARE CLC 9(1,TERM),0(AREA) COMPARE TERM NAMES 81900013 SECOND DC 18F'0' 82200013 END 82500013 ./ ADD SSI=02012300,NAME=IECKRF40,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRF40 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 2740 CODE TO EBCDIC. (CONVERTS LOWERCASE ALPHABETIC TO * 15000013 * UPPER CASE). APPLICABLE TO IBM 2740 TYPES I-VIII. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRF40 START 27000013 * 600000 24104 28000018 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 33000013 DC X'F83F3FF93FF07B3F3F3F353F363F3F37' 1 36000013 DC X'7C3F3F613FE2E33F3FE4E53FE63F3FE7' 2 39000013 DC X'3FE8E93F3F3F3F6B3F3F3F253F263F3F' 3 42000013 DC X'603F3FD13FD2D33F3FD4D53FD63F3FD7' 4 45000013 DC X'3FD8D93F3F3F3F5B3F3F3F153F16173F' 5 48000013 DC X'3F50C13FC23F3FC3C43F3FC53FC6C73F' 6 51000013 DC X'C83F3FC93F3F4B3F3F3F053F063F3F07' 7 54000013 DC X'3F407E3F4C3F3F5E7A3F3F6C3F7D6E3F' 8 57000013 DC X'5C3F3F4D3F5D7F3F3F3F353F363F3F37' 9 24104 60000018 DC X'4A3F3F6F3FE2E33F3FE4E53FE63F3FE7' A 63000013 DC X'3FE8E93F3F3F3F4F3F3F3F253F263F3F' B 66000013 DC X'6D3F3FD13FD2D33F3FD4D53FD63F3FD7' C 69000013 DC X'3FD8D93F3F3F3F5A3F3F3F153F16173F' D 72000013 DC X'3F4EC13FC23F3FC3C43F3FC53FC6C73F' E 75000013 DC X'C83F3FC93F3F5F3F3F3F053F063F3F07' F 78000013 END 81000013 ./ ADD SSI=03012300,NAME=IECKRF50,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRF50 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 1050 TRANSMISSION CODE TO EBCDIC. (CONVERTS LOWERCASE * 15000013 * ALPHABETIC CHARACTERS TO UPPERCASE). APPLICABLE TO IBM 1050 ON A * 18000013 * SWITCHED OR NONSWITCHED NETWORK. * 21000013 * * 24000013 *********************************************************************** 27000013 IECKRF50 START 30000013 * 630000 24104 31000018 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 33000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 36000013 DC X'F83F3FF93FF07B3F3F34353F363F3F37' 1 39000013 DC X'7C3F3F613FE2E33F3FE4E53FE63F3FE7' 2 42000013 DC X'3FE8E93FE03F3F6B243F3F253F26273F' 3 45000013 DC X'603F3FD13FD2D33F3FD4D53FD63F3FD7' 4 48000013 DC X'3FD8D93FD03F3F5B143F3F153F16173F' 5 51000013 DC X'3F50C13FC23F3FC3C43F3FC53FC6C73F' 6 54000013 DC X'C83F3FC93FC04B3F3F04053F063F3F07' 7 57000013 DC X'3F407E3F4C3F3F5E7A3F3F6C3F7D6E3F' 8 60000013 DC X'5C3F3F4D3F5D7F3F3F34353F363F3F37' 9 24104 63000018 DC X'4A3F3F6F3FE2E33F3FE4E53FE63F3FE7' A 66000013 DC X'3FE8E93F3F3F3F4F243F3F253F26273F' B 69000013 DC X'6D3F3FD13FD2D33F3FD4D53FD63F3FD7' C 72000013 DC X'3FD8D93F3F3F3F5A143F3F153F16173F' D 75000013 DC X'3F4EC13FC23F3FC3C43F3FC53FC6C73F' E 78000013 DC X'C83F3FC93F3F5F3F3F04053F063F3F07' F 81000013 END 84000013 ./ ADD SSI=02012331,NAME=IECKROUT,SOURCE=0 TITLE 'IECKROUT QTAM ROUTING (ROUTE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKROUT QTAM ROUTING (ROUTE) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THIS ROUTINE USES SCAN TO LOCATE THE START OF THE NEXT * 10000013 * FIELD IN THE INCOMING MESSAGE HEADER. THE LOOKUP ROUTINE IS USED * 11000013 * TO SCAN THE TERMINAL TABLE TO FIND THE RELATIVE OFFSET OF THIS * 12000013 * DESTINATION. IECKROUT THEN PLACES THIS OFFSET IN THE TTDKEY * 13000013 * FIELD OF THE INCOMING MESSAGE HEADER PREFIX AND PLACES THE * 14000013 * ADDRESS OF THE DESTINATION QCB INTO LCBDESTQ FIELD OF THE LCB * 15000013 * FOR THE SOURCE LINE. * 16000013 * * 17000013 *ENTRY POINTS- * 18000013 * IECKROUT - EXPANSION OF THE ROUTE MACRO GENERATES A BALR TO THIS * 19000013 * POINT, USING STANDARD LINKAGE CONVENTIONS. * 20000013 * * 21000013 *INPUT- * 22000013 * REGISTER 5- POINTER TO BYTE BEFORE CURRENT FIELD IN SEGMENT. * 23000013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 24000013 * REGISTER 14- RETURN ADDRESS * 25000013 * REGISTER 14 ALSO POINTS TO A HALF-WORD PARAMETER. THIS PARAMETER * 26000013 * MAY BE * 27000013 * 1. THE MAXIMUM SIZE OF EACH DESTINATION CODE, OR * 28000013 * 2. ALL ONES, INDICATING THAT THE DESTINATION CODE * 29000013 * FIELDS ARE VARIABLE LENGTH. * 30000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 31000013 * * 32000013 *OUTPUT- * 33000013 * THE RETURN ADDRESS FOR THIS ROUTINE WILL BE IN THE LCBENDOP FIELD * 34000013 * OF THE LCB (LCB ADDRESS+1). * 35000013 * * 36000013 *EXTERNAL ROUTINES- * 37000013 * IECKSCAN(SCAN) TO FIND NEXT NON-BLANK CHARACTER * 38000013 * IECKLKUP(LOOKUP) TO SCAN TERMINAL TABLE * 39000013 * * 40000013 *EXITS- * 41000013 * NORMAL- EXIT IS TO IECKLKUP. RETURN TO LPS IS FROM LOOKUP, * 42000013 * RATHER THAN FROM ROUTE. * 43000013 * ERROR- NONE. * 44000013 * * 45000013 *TABLES/WORK AREAS- * 46000013 * NONE. * 47000013 * * 48000013 *ATTRIBUTES- * 49000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 50000013 * * 51000013 *NOTES- * 52000013 * REGISTER 0- USED AS A WORK REGISTER TO TEMPORARILY HOLD THE * 53000013 * CONTENTS OF REGISTER 15 (THE BRANCH ADDRESS WHEN COMING FROM LPS) * 54000013 * * 55000013 *********************************************************************** 56000013 IECKROUT START 57000013 DREG0 EQU 0 58000013 DREG1 EQU 1 59000013 RREG2 EQU 3 60000013 LCBREG EQU 4 61000013 SPREG EQU 5 62000013 MSREG EQU 6 63000013 LGREG EQU 7 64000013 WREG1 EQU 9 65000013 RREG1 EQU 14 66000013 SREG EQU 15 67000013 USING IECKLCB0,LCBREG 68000013 USING *,SREG 69000013 LR DREG0,SREG SAVE BASE REG 70000013 ST RREG1,TEMP 71000013 MVC LCBENDOP,TEMP+1 72000013 L SREG,4(0,LGREG) GET SCAN ADDR 73000013 BALR RREG2,SREG LINKAGE TO SCAN SUBR 74000013 LR SREG,DREG0 RESTORE BASE REG 75000013 L SREG,=V(IECKLKUP) 76000013 BR SREG LINKAGE TO DESTCK SUBR 77000013 SPACE 78000013 TEMP DS F 79000013 EJECT 80000013 LCBD 81000013 END 82000013 ./ ADD SSI=03011201,NAME=IECKRRTE,SOURCE=0 TITLE 'IECKRRTE QTAM REROUTE (REROUTE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKRRTE QTAM REROUTE (REROUTE) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * IECKRRTE WILL QUEUE A MESSAGE ON AN ALTERNATE DESTINATION * 10000013 * QUEUE (IN ADDITION TO THE DESTINATION(S) SPECIFIED BY THE * 11000013 * MESSAGE HEADER) WHEN ANY OF THE ERRORS SPECIFIED IN THE MASK * 12000013 * HAS BEEN DETECTED. * 13000013 * THE ROUTINE WILL OBTAIN THE MASK FROM THE PARAMETER LIST. * 14000013 * THIS MASK WILL BE AND'ED WITH THE ERROR HALFWORD. IF THE * 15000013 * SPECIFIED ERRORS HAVE NOT OCCURRED, PROCESSING CONTINUES WITH * 16000013 * THE NEXT LPS INSTRUCTION. * 17000013 * IF ANY OF THE ERRORS HAVE OCCURRED, CONTROL IS PASSED TO * 18000013 * THE RECALL ROUTINE (IN MODULE IGG019NG) WHICH OBTAINS THE * 19000013 * HEADER. IECKLKUP (LOOK-UP) IS USED TO GET THE DESTINATION CODE * 20000013 * IN THE TERMINAL TABLE AND PLACES THE RELATIVE ADDRESS IN THE * 21000013 * TTDKEY FIELD OF THE INCOMING HEADER PREFIX. CONTROL IS PASSED * 22000013 * ON TO THE NEXT LPS INSTRUCTION FROM THE LOOK-UP ROUTINE. * 23000013 * * 24000013 *ENTRY POINTS- * 25000013 * IECKRRTE - CONTROL IS PASSED HERE BY THE EXPANSION OF THE * 26000013 * REROUTE MACRO. BRANCHING IS BY A BALR, USING REGISTER 15 * 27000013 * AS THE ENTRY POINT REGISTER AND REGISTER 14 AS THE RETURN * 28000013 * ADDRESS REGISTER. * 29000013 * * 30000013 *INPUT- * 31000013 * REGISTER 2- PARAMETER REGISTER PASSING THE ADDRESS OF THE * 32000013 * ALTERNATE DESTINATION. * 33000013 * REGISTER 14- RETURN ADDRESS * 34000013 * REGISTER 14 IS ALSO USED AS A PARAMETER REGISTER, PASSING * 35000013 * THE ADDRESS OF THE HALFWORD ERROR MASK IN HEX NOTATION. * 36000013 * REGISTER 15- ENTRY POINT REGISTER. * 37000013 * * 38000013 *OUTPUT- * 39000013 * REGISTER 15- IF A DESIGNATED ERROR OCCURRED, THE ADDRESS OF * 40000013 * IECKLKUP WILL BE HERE. IF THERE WERE NO DESIGNATED ERROR, * 41000013 * THE ADDRESS OF IECKRRTE WILL BE HERE. * 42000013 * IF ONE OF THE SPECIFIED ERRORS HAD OCCURRED, THEN THE MESSAGE * 43000013 * WILL HAVE BEEN RECALLED, AND THE ALTERNATE DESTINATION * 44000013 * RELATIVE ADDRESS IS IN THE TTDKEY FIELD OF THE HEADER * 45000013 * PREFIX. * 46000013 * * 47000013 *EXTERNAL ROUTINES- * 48000013 * RECALL (IECKRC IN MODULE IGG019NG) * 49000013 * LOOK-UP (IECKLKUP) * 50000013 * * 51000013 *EXITS- * 52000013 * NORMAL- RETURN IS BY A BRANCH ON REGISTER 14. * 53000013 * ERROR- CONTROL WILL PASS TO RECALL. WHEN IT COMPLETES ITS * 54000013 * FUNCTION, IT RETURNS TO REROUTE WHICH THEN BRANCHES TO * 55000013 * LOOK-UP. LOOK-UP FINALLY EXITS TO THE NEXT LPS INSTRUCTION. * 56000013 * * 57000013 *TABLES/WORK AREAS- * 58000013 * NONE. * 59000013 * * 60000013 *ATTRIBUTES- * 61000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 62000013 * * 63000013 *NOTES- * 64000013 * REGISTER 3- SECOND LEVEL LINKAGE. WILL CONTAIN RETURN ADDRESS * 65000013 * WHEN LINKING TO RECALL. * 66000013 * REGISTER 9- WORK REGISTER. WILL CONTAIN THE LPS QUEUE ADDRESS * 67000013 * AS INPUT TO THE RECALL ROUTINE. * 68000013 * * 69000013 *********************************************************************** 70000013 IECKRRTE START 71000013 *1201844000-856000,920000 000D 71500018 DREG1 EQU 1 72000013 RREG2 EQU 3 73000013 LCBREG EQU 4 74000013 WREG1 EQU 9 75000013 RREG1 EQU 14 76000013 SREG EQU 15 77000013 USING *,SREG 78000013 USING IECKLCB0,LCBREG 79000013 LH WREG1,0(0,RREG1) LOAD ERROR HALF WORD FROM USER 80000013 SLA WREG1,16 SHIFT ERROR MASK TO HIGH ORDER BYTE 81000013 BC 8,ERRACT1 BRANCH IF MASK IS ZERO 82000013 N WREG1,LCBERRST TEST FOR DESIGNATED ERRORS 83000013 BC 8,2(0,RREG1) RETURN IF NO ERRORS 84000013 ERRACT1 CLI LCBCPA+29,X'FF' IS THIS MESSAGE TO BE 000D 84400018 * RETRANSMITTED TO 2740 MOD 2 000D 84800018 BE 2(0,RREG1) RETURN IF YES 000D 85200018 MVC LCBCECB+1(3),LCBCHDR MAKE HEADER ADDRESS AVAILABLE 000D 85600018 L WREG1,0(0,13) GET LPS QUEUE ADDRESS FROM IGG019NG 86000013 OI LCBSTATE,X'10' SET INITIATE BIT IN LCB 87000013 BAL RREG2,240(0,WREG1) BRANCH TO RECALL SUBROUTINE FOR HDR 88000013 L SREG,=V(IECKLKUP) GET ADDRESS OF LOOKUP ROUTINE 89000013 BR SREG EXIT TO LOOKUP 90000013 EJECT 91000013 LCBD QTAM=3 000D 92000018 END 93000013 ./ ADD SSI=00012110,NAME=IECKRVTW,SOURCE=0 TITLE 'IECKRVTW - WTTA TELETYPE TRANSLATION TABLE' 03000017 IECKRVTW CSECT 06000017 SPACE 2 09000017 * STATUS - CHANGE LEVEL 000 MAY,10 1968 12000017 SPACE 15000017 *FUNCTION- THE IECKRVTW TRANSLATION TABLE TRANSLATES THE 5-BIT 18000017 * INTERNATIONAL TELEGRAPH ALPHABET NUMBER 2 INTO EBCDIC 21000017 SPACE 4 24000017 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000017 DC X'3FE315D640C8D5D425D3D9C7C9D7C3E5' 0 30000017 DC X'C5E9C4C2E2E8C6E7C1E6D136E4D8D237' 1 33000017 DC X'3FF515F9403F6B4B255DF43FF8F07A7E' 2 36000017 DC X'F34E266F7DF63F6160F22A36F7F14D06' 3 39000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 4 42000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 5 45000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 6 48000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 7 51000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 54000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 57000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A 60000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B 63000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C 66000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 69000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 72000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F 75000017 END 78000017 ./ ADD SSI=00012110,NAME=IECKRVTZ,SOURCE=0 TITLE 'IECKRVTZ - WTTA TELETYPE TRANSLATION TABLE' 03000017 IECKRVTZ CSECT 06000017 SPACE 2 09000017 * STATUS - CHANGE LEVEL 000 MAY,10 1968 12000017 SPACE 15000017 *FUNCTION- THE IECKRVTZ TRANSLATION TABLE TRANSLATES THE 5-BIT 18000017 * FIGURE PROTECTED TELEGRAPH CODE ZSC3 INTO EBCDIC 21000017 SPACE 4 24000017 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000017 DC X'3FE315D640C8D5D425D3D9C7C9D7C3E5' 0 30000017 DC X'C5E9C4C2E2E8C6E7C1E6D136E4D8D237' 1 33000017 DC X'3F4B157A406F6BF7255D61F02AF9F87E' 2 36000017 DC X'603F26F67DF5F43F4EF3F236F13F4D06' 3 39000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 4 42000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 5 45000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 6 48000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 7 51000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 54000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 57000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A 60000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B 63000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C 66000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 69000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 72000017 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F 75000017 END 78000017 ./ ADD SSI=03010773,NAME=IECKRVT1,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRVT1 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 5-LEVEL (BAUDOT) CODE TO EBCDIC. APPLICABLE TO AT&T 83B3 * 15000013 * AND WESTERN UNION MODEL 115A * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRVT1 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3FE326D640C8D5D415D3D9C7C9D7C3E5' 0 33000013 DC X'C5E9C4C2E2E8C6E7C1E6D136E4D8D206' 1 36000013 DC X'3FF526F9403F6B4B155DF450F8F07A5E' 2 39000013 DC X'F37F5B6F7DF65A6160F22F36F7F14D06' 3 42000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 4 45000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 5 48000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 6 51000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 7 54000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 57000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 60000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A 63000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B 66000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C 69000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 72000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 75000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F 78000013 END 81000013 ./ ADD SSI=03010773,NAME=IECKRVT2,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRVT2 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 8-LEVEL TWX CODE TO EBCDIC. APPLICABLE TO AT&T 33/35. * 15000013 * * 18000013 *********************************************************************** 21000013 IECKRVT2 START 24000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000013 DC X'3F3F3F7C3F403F3F3F3FD7D7F0F03F3F' 0 30000013 DC X'3F3FC8C84D4D3F3F3F3F3FE73FF83F3F' 1 33000013 DC X'3F37C4C45B5B3F3F04043FE33FF43F3F' 2 36000013 DC X'0C0C3FD33F6B3F3F3F3FE1E14C4C3F3F' 3 39000013 DC X'3F3FC2C27F7F3F3F343F3FD93FF23F3F' 4 42000013 DC X'15153FD13F5C3F3F3F3FE9E97A7A3F3F' 5 45000013 DC X'3F3F3FC63F503F3F3F3FE5E5F6F63F3F' 6 48000013 DC X'3F0ED5D54B4B3F3F3F3F3F4F3F6E3F3F' 7 51000013 DC X'3F3FC1C15A5A3F3F11113FD83FF13F3F' 8 54000013 DC X'05053FC93F5D3F3F3F3FE8E8F9F93F3F' 9 57000013 DC X'2D2D3FC53F6C3F3F3F3FE4E4F5F53F3F' A 60000013 DC X'3F26D4D460603F3F3F3F3F493F7E3F3F' B 63000013 DC X'3F3F3FC33F7B3F3F3F3CE2E2F3F33F3F' C 66000013 DC X'3F0BD2D24E4E3F3F3F3F3F793F5E3F3F' D 69000013 DC X'3F2FC7C77D7D3F3F3F3F3FE63FF73F3F' E 72000013 DC X'0F0F3FD63F613F3F3F3F6D6D6F6F3F07' F 75000013 END 78000013 ./ ADD SSI=03010772,NAME=IECKRV30,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRV30 QTAM TRANSLATE TABLES * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 1030 TRANSMISSION CODE TO EBCDIC. APPLICABLE TO IBM 1031 * 15000013 * AND 1033 ONLY. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRV30 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 33000013 DC X'F83F3FF93F3F7B3F3F3F3F3F3F3F3F37' 1 36000013 DC X'F03F3F613FE2E33F3FE4E53FE63F3FE7' 2 39000013 DC X'3FE8E93F3F3F3F6B3F3F3F3F3F263F3F' 3 42000013 DC X'603F3FD13FD2D33F3FD4D53FD63F3FD7' 4 45000013 DC X'3FD8D93F3F3F3F5B3F3F3F3F3F3F3F3F' 5 48000013 DC X'3F50C13FC23F3FC3C43F3FC53FC6C73F' 6 51000013 DC X'C83F3FC93F3F4B3F3F3F3F3F3F3F3F07' 7 54000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 57000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 60000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A 63000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B 66000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C 69000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 72000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 75000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F 78000013 END 81000013 ./ ADD SSI=02012300,NAME=IECKRV40,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRV40 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 2740 TRANSMISSION CODE TO EBCDIC. APPLICABLE TO IBM 2740 * 15000013 * TYPES I-VIII. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRV40 START 27000013 * 600000 24104 28000018 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 33000013 DC X'F83F3FF93FF07B3F3F3F353F363F3F37' 1 36000013 DC X'7C3F3F613FA2A33F3FA4A53FA63F3FA7' 2 39000013 DC X'3FA8A93F3F3F3F6B3F3F3F253F263F3F' 3 42000013 DC X'603F3F913F92933F3F94953F963F3F97' 4 45000013 DC X'3F98993F3F3F3F5B3F3F3F153F16173F' 5 48000013 DC X'3F50813F823F3F83843F3F853F86873F' 6 51000013 DC X'883F3F893F3F4B3F3F3F053F063F3F07' 7 54000013 DC X'3F407E3F4C3F3F5E7A3F3F6C3F7D6E3F' 8 57000013 DC X'5C3F3F4D3F5D7F3F3F3F353F363F3F37' 9 24104 60000018 DC X'4A3F3F6F3FE2E33F3FE4E53FE63F3FE7' A 63000013 DC X'3FE8E93F3F3F3F4F3F3F3F253F263F3F' B 66000013 DC X'6D3F3FD13FD2D33F3FD4D53FD63F3FD7' C 69000013 DC X'3FD8D93F3F3F3F5A3F3F3F153F16173F' D 72000013 DC X'3F4EC13FC23F3FC3C43F3FC53FC6C73F' E 75000013 DC X'C83F3FC93F3F5F3F3F3F053F063F3F07' F 78000013 END 81000013 ./ ADD SSI=03012300,NAME=IECKRV50,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRV50 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 1050 TRANSMISSION CODE TO EBCDIC. APPLICABLE TO IBM 1050 ON * 15000013 * A SWITCHED OR NONSWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRV50 START 27000013 * 600000 24104 28000018 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 33000013 DC X'F83F3FF93FF07B3F3F34353F363F3F37' 1 36000013 DC X'7C3F3F613FA2A33F3FA4A53FA63F3FA7' 2 39000013 DC X'3FA8A93FE03F3F6B243F3F253F26273F' 3 42000013 DC X'603F3F913F92933F3F94953F963F3F97' 4 45000013 DC X'3F98993FD03F3F5B143F3F153F16173F' 5 48000013 DC X'3F50813F823F3F83843F3F853F86873F' 6 51000013 DC X'883F3F893FC04B3F3F04053F063F3F07' 7 54000013 DC X'3F407E3F4C3F3F5E7A3F3F6C3F7D6E3F' 8 57000013 DC X'5C3F3F4D3F5D7F3F3F34353F363F3F37' 9 24104 60000018 DC X'4A3F3F6F3FE2E33F3FE4E53FE63F3FE7' A 63000013 DC X'3FE8E93F3F3F3F4F243F3F253F26273F' B 66000013 DC X'6D3F3FD13FD2D33F3FD4D53FD63F3FD7' C 69000013 DC X'3FD8D93F3F3F3F5A143F3F153F16173F' D 72000013 DC X'3F4EC13FC23F3FC3C43F3FC53FC6C73F' E 75000013 DC X'C83F3FC93F3F5F3F3F04053F063F3F07' F 78000013 END 81000013 ./ ADD SSI=03010773,NAME=IECKRV60,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKRV60 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 1060 TRANSMISSION CODE TO EBCDID. APPLICABLE TO IBM 1060'S * 15000013 * ON A SWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKRV60 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F40F13FF23F3FF3F43F3FF53FF6F73F' 0 33000013 DC X'F83F3FF93FF07B3F3F3F3F3F3F3F3F3F' 1 36000013 DC X'3F3F3F613F3F3F3F3F3F3F3F3F3F3F3F' 2 39000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F263F3F' 3 42000013 DC X'3F3F3FD13FD23F3F3F3F3F3F3F3F3F3F' 4 45000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 5 48000013 DC X'3F3FC13FC23F3F3F3F3F3FC53FC63F3F' 6 51000013 DC X'3F3F3FC93F3F3F3F3F3F3F3F3F3F3F07' 7 54000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 57000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 60000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A 63000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B 66000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C 69000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 72000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 75000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F 78000013 END 81000013 ./ ADD SSI=02010773,NAME=IECKR260,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKR260 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM 2260 TRANSMISSION CODE TO EBCDIC. APPLICABLE TO IBM 2260 * 15000013 * ON A NONSWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKR260 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'3F3F0203373F2E3F3F3F153F3F3F3F3F' 0 33000013 DC X'3F3F3F3F3F3D3F3F183F3F3F3F3F3F3F' 1 36000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 2 39000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 3 42000013 DC X'406A1A7B5B6C507D4D5D5C4E6B604B61' 4 45000013 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 5 48000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 6 51000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 7 54000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8 57000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9 60000013 DC X'3FC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' A 63000013 DC X'D7D8D9E2E3E4E5E6E7E8E93F3F3F3F6D' B 66000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F0A3F3F' C 69000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D 72000013 DC X'7C3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E 75000013 DC X'3F3F3F3F3F3F3F3F3F3F3F3F5F3F4F3F' F 78000013 END 81000013 ./ ADD SSI=01011670,NAME=IECKSCAN,SOURCE=0 TITLE 'IECKSCAN QTAM SCAN HEADER' 00700013 *********************************************************************** 01400013 * * 02100013 *NAME- * 02800013 * IECKSCAN QTAM SCAN HEADER * 03500013 * * 04200013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04900013 * * 05600013 *FUNCTION- * 06300013 * IECKSCAN (SCAN) WILL PERFORM ONE OF TWO FUNCTIONS,DEPENDING * 07000013 * UPON THE PARAMETER PASSED TO IT BY THE ROUTINE USING SCAN. * 07700013 * 1) SCAN WILL ADVANCE THE SCAN POINTER TO THE NEXT BLANK * 08400013 * CHARACTER (END OF FIELD) IF THE CALLING ROUTINE PASSES THE * 09100013 * VARIABLE FIELD INDICATOR (X'FF') AS THE PARAMETER, OR * 09800013 * 2) IF THE CALLING ROUTINE PASSES A GIVEN BINARY NUMBER * 10500013 * LESS THAN OR EQUAL TO 8,SCAN WILL ADVANCE THE SCAN POINTER * 11200013 * TO THE LAST NONBLANK CHARACTER WHICH SATISFIES THE COUNT. * 11900013 * BLANK CHARACTERS ARE IGNORED AND NOT INCLUDED IN THIS COUNT. * 12600013 * IN EITHER CASE, EACH NON-BLANK CHARACTER ENCOUNTERED, UP TO * 13300013 * A MAXIMUM OF 8, WILL BE MOVED TO WORKWORD. AFTER THE EIGHTH * 14000013 * CHARACTER IS MOVED, CONTROL WILL RETURN TO THE CALLING * 14700013 * ROUTINE WHETHER THE REQUIREMENTS ARE MET OR NOT. * 15400013 * BOTH FUNCTIONS ARE CONTINGENT UPON THE SCAN POINTER NOT * 16100013 * REACHING THE END OF THE SEGMENT BEFORE SATISFYING THE REQUIREMENTS* 16800013 * OF THE CALLING ROUTINE. IF THIS SITUATION ARISES, BIT FIVE, * 17500013 * INCOMPLETE MESSAGE HEADER, IS SET IN THE ERROR HALFWORD (LCBERRST * 18200013 * IS OR'ED WITH A X'04'), AND THE SCAN POINTER IS BACKED UP TO POINT* 18900013 * TO THE END OF THE SEGMENT. * 19600013 * RETURN IS TO THE CALLING ROUTINE BY BRANCHING ON THE CONTENTS* 20300013 * OF REGISTER 3. * 21000013 * * 21700013 *ENTRY POINTS- * 22400013 * IECKSCAN - ENTRY TO THIS POINTS IS BY A BALR WITH REGISTER 15 AS * 23100013 * THE BRANCH REGISTER, AND REGISTER 3 AS RETURN REGISTER.* 23800013 * ENTRY IS FROM IECKPRTY, IECKSEQN, IECKSKPS, IECKMODE, * 24500013 * IECKROUT, IECKSRCE, OR IECKTYPE. * 25200013 * * 25900013 *INPUT- * 26600013 * REGISTER 3- RETURN REGISTER. * 27300013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 28000013 * REGISTER 14- POINTER TO MACRO GENERATED PARAMETER LIST. THIS * 28700013 * PARAMETER IS EITHER THE FIELD LENGTH, OR THE VARIABLE * 29400013 * FIELD LENGTH INDICATOR. * 30100013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 30800013 * * 31500013 *OUTPUT- * 32200013 * REGISTER 2- POINTS TO THE WORKAREA CONTAINING THE TRANSFERRED * 32900013 * CHARACTERS. * 33600013 * REGISTER 5- POINTS TO THE LAST CHARACTER WHICH SATISFIED THE * 34300013 * FIELD SIZE COUNT, IF COUNT IS GIVEN. POINTS TO NEXT * 35000013 * BLANK CHARACTER IF VARIABLE LENGTH INDICATOR IS GIVEN. * 35700013 * REGISTER 9- CONTAINS THE NUMBER OF NON-BLANK CHARACTERS * 36400013 * SCANNED. * 37100013 * REGISTER 14- POINTS TO THE PARAMETER LIST DESCRIBED ABOVE. * 37800013 * * 38500013 *EXTERNAL ROUTINES- * 39200013 * NONE. * 39900013 * * 40600013 *EXITS- * 41300013 * NORMAL- RETURN TO LOCATION POINTED TO BY REGISTER 3. * 42000013 * ERROR- IF A COUNT IS GIVEN AND END OF SEGMENT IS FOUND BEFORE * 42700013 * THIS COUNT HAS BEEN SATISFIED, BIT FIVE, INCOMPLETE * 43400013 * MESSAGE HEADER, IS SET IN THE ERROR HALFWORD (LCBERRST * 44100013 * IS OR'ED WITH A X'04'), AND THE SCAN POINTER IS BACKED * 44800013 * UP TO POINT TO THE END OF THE SEGMENT. THE SAME ERROR * 45500013 * INDICATION IS GIVEN IF VARIABLE LENGTH INDICATION IS * 46200013 * GIVEN AND END OF SEGMENT IS FOUND BEFORE THE NEXT * 46900013 * BLANK CHARACTER. * 47600013 * * 48300013 *TABLES/WORK AREAS- * 49000013 * WORKWORD IS USED TO HOLD THE NON-BLANK CHARACTERS. * 49700013 * * 50400013 *ATTRIBUTES- * 51100013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 51800013 * * 52500013 *NOTES- * 53200013 * REGISTER 9- WORK REGISTER. KEEPS COUNT OF CHARACTERS SCANNED. * 53900013 * REGISTER 10- WORK REGISTER. HOLDS INCREMENT VALUE OF 1. * 54600013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 55300013 * REGISTER 12- WORK REGISTER. USED TO TRANSFER THE CHARACTERS FROM * 56000013 * THE HEADER TO WORKWORD. * 56700013 * REGISTER 15- BASE REGISTER FOR THIS ROUTINE. * 57400013 * * 58100013 *********************************************************************** 58800013 IECKSCAN START 59500013 KREG EQU 2 60200013 RREG2 EQU 3 60900013 LCBREG EQU 4 61600013 SPREG EQU 5 62300013 WREG1 EQU 9 63000013 IREG EQU 10 63700013 WREG2 EQU 12 64400013 RREG1 EQU 14 65100013 SREG EQU 15 65800013 USING *,SREG 66500013 USING IECKLCB0,LCBREG 67200013 LA IREG,1 LOAD INCREMENT VALUE OF ONE 67900013 MVC WORKWORD,BLANK BLANK WORKWORD 68600013 SR WREG1,WREG1 CLEAR 69300013 LA KREG,WORKWORD LOAD WORKWORD ADDR FOR EXTERN USE 70000013 PTR1 CH WREG1,0(0,RREG1) GET FIELD SIZE 70700013 BCR 8,RREG2 RETURN IF END 71400013 PTR2 BXH SPREG,IREG,HEADERR BUMP SCAN POINTER--END OF SEGM TST 72100013 CLI 0(SPREG),C' ' TEST FOR BLANK 72800013 BE PTR2 IF YES,SCAN NXT HEADER CHAR 73500013 VARIFLD CLI 0(SPREG),C' ' TEST FOR BLANK 74200013 BCR 8,RREG2 IF YES,DO END OF FLD RETURN TO SUBR 74900013 IC WREG2,0(0,SPREG) ELSE PUT CHAR IN WORKWORD 75600013 STC WREG2,WORKWORD(WREG1) 76300013 AR WREG1,IREG HAR COUNTER FOR VAR FLD 77000013 CH WREG1,H8 IS FIELD MAX SIZE 77700013 BCR 8,RREG2 IF END OF FLD RETURN TO CALLING SUBR 78400013 CLI 1(RREG1),X'FF' TST FOR VAR LNGTH FLD INDIC 79100013 BNE PTR1 BR IF NOT VARIABLE 79800013 BXLE SPREG,IREG,VARIFLD BUMP SCAN POINTER--END OF SEGM TST 80500013 HEADERR OI LCBERRST,X'04' SET ERROR BIT 81200013 BCTR SPREG,RREG2 RETURN 81900013 SPACE 82600013 H8 DC X'000800' 83300013 BLANK DC C' ' BLANK TO FILL WORKWORD 84000013 WORKWORD DC C' ' DEFINE STORAGE FOR WORK AREA 84700013 EJECT 85400013 LCBD 86100013 END 86800013 ./ ADD SSI=00012110,NAME=IECKSDTW,SOURCE=0 TITLE 'IECKSDTW - WTTA TELETYPE TRANSLATION TABLE' 03000017 IECKSDTW CSECT 06000017 SPACE 2 09000017 * STATUS - CHANGE LEVEL 000 MAY,10 1968 12000017 SPACE 15000017 *FUNCTION- THE IECKSDTW TRANSLATION TABLE TRANSLATES THE EBCDIC 18000017 * INTO 5-BIT INTERNATIONAL TELEGRAPH ALPHABET NUMBER 2 21000017 SPACE 4 24000017 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000017 DC X'1F37370237371F1F3737373737023737' 0 30000017 DC X'373737373702371F3737373737373737' 1 33000017 DC X'373737373708083737373A3737373737' 2 36000017 DC X'37371F3737373B1F3737373737373737' 3 39000017 DC X'043737373737373737373727373E3137' 4 42000017 DC X'37373737373737373737373737293737' 5 45000017 DC X'38373737373737373737372637373733' 6 48000017 DC X'373737373737373737372E3737342F37' 7 51000017 DC X'3718130E1210160B050C373737373737' 8 54000017 DC X'371A1E090706030D1D0A373737373737' 9 57000017 DC X'373714011C0F19171511373737373737' A 60000017 DC X'37373737373737373737373737373737' B 63000017 DC X'3718130E1210160B050C373737373737' C 66000017 DC X'371A1E090706030D1D0A373737373737' D 69000017 DC X'373714011C0F19171511373737373737' E 72000017 DC X'2D3D39302A21353C2C23373737373737' F 75000017 END 78000017 ./ ADD SSI=00012111,NAME=IECKSDTZ,SOURCE=0 TITLE 'IECKSDTZ - WTTA TELETYPE TRANSLATION TABLE' 03000017 IECKSDTZ CSECT 06000017 SPACE 2 09000017 * STATUS - CHANGE LEVEL 000 MAY,10 1968 12000017 SPACE 15000017 *FUNCTION- THE IECKSDTZ TRANSLATION TABLE TRANSLATES THE EBCDIC 18000017 * INTO FIGURE PROTECTED TELEGRAPH CODE ZSC3 21000017 SPACE 1 24000017 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000017 DC X'1F2A2A022A2A1F1F2A2A2A2A2A022A2A' 0 30000017 DC X'2A2A2A2A2A022A1F2A2A2A2A2A2A2A2A' 1 33000017 DC X'2A2A2A2A2A08082A2A2A2C2A2A2A2A2A' 2 36000017 DC X'2A2A1F2A2A2A3B1F2A2A2A2A2A2A2A2A' 3 39000017 DC X'042A2A2A2A2A2A2A2A2A2A212A3E382A' 4 42000017 DC X'2A2A2A2A2A2A2A2A2A2A2A2A2A292A2A' 5 45000017 DC X'302A2A2A2A2A2A2A2A2A2A262A2A2A25' 6 48000017 DC X'2A2A2A2A2A2A2A2A2A2A232A2A342F2A' 7 51000017 DC X'2A18130E1210160B050C2A2A2A2A2A2A' 8 54000017 DC X'2A1A1E090706030D1D0A2A2A2A2A2A2A' 9 57000017 DC X'2A2A14011C0F191715112A2A2A2A2A2A' A 60000017 DC X'2A2A2A2A2A2A2A2A2A2A2A2A2A2A2A2A' B 63000017 DC X'2A18130E1210160B050C2A2A2A2A2A2A' C 66000017 DC X'2A1A1E090706030D1D0A2A2A2A2A2A2A' D 69000017 DC X'2A2A14011C0F191715112A2A2A2A2A2A' E 72000017 DC X'2B3C3A39363533272E2D2A2A2A2A2A2A' F 75000017 END 78000017 ./ ADD SSI=03011170,NAME=IECKSDT1,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSDT1 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 5-LEVEL (BAUDOT) CODE. APPLICABLE TO WESTERN UNION * 15000013 * MODEL 115A AND AT&T 83B3. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKSDT1 START 27000013 *1170360000-390000 4549 28000016 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'1F37370237371F1F3737373737023737' 0 33000013 DC X'373737373708371F3737373737373737' 1 4549 36000016 DC X'3737373737080237373737373737373A' 2 4549 39000016 DC X'37371F3737371B253737373737373737' 3 42000013 DC X'043737373737373737373727373E3737' 4 45000013 DC X'2B373737373737373737363237292F37' 5 48000013 DC X'38373737373737373737372637373733' 6 51000013 DC X'373737373737373737372E0237343731' 7 54000013 DC X'3718130E1210160B050C373737373737' 8 57000013 DC X'371A1E090706030D1D0A373737373737' 9 60000013 DC X'373714011C0F19171511373737373737' A 63000013 DC X'37373737373737373737373737373737' B 66000013 DC X'3718130E1210160B050C373737373737' C 69000013 DC X'371A1E090706030D1D0A373737373737' D 72000013 DC X'373714011C0F19171511373737373737' E 75000013 DC X'2D3D39302A21353C2C23373737373737' F 78000013 END 81000013 ./ ADD SSI=03011170,NAME=IECKSDT2,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSDT2 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE * 12000013 * FROM EBCDIC TO 8-LEVEL TWX CODE. APPLICABLE FOR AT&T 33/35. * 15000013 * * 18000013 *********************************************************************** 21000013 IECKSDT2 START 24000013 *1170330000-360000 4549 25000016 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000013 DC X'FF5C5CB128905CFF5C5C5CD130B171F0' 0 30000013 DC X'5C885C5C5C505CFF5C5C5C5C5C5C5C5C' 1 4549 33000016 DC X'5C5C5C5C5C50B15C5C5C5C5C5C5C5CE1' 2 4549 36000016 DC X'5C5CFF5C485C5C5C5C5C5C5CC95C5C5C' 3 39000013 DC X'055C5C5C5C5C5C5C5CBB5C743C14D47B' 4 42000013 DC X'655C5C5C5C5C5C5C5C5C84245595DD5C' 5 45000013 DC X'B4F55C5C5C5C5C5C5C5C5C35A5FA7DFC' 6 48000013 DC X'5C5C5C5C5C5C5C5C5CDB5CC503E4BD44' 7 51000013 DC X'5C8242C322A363E212935C5C5C5C5C5C' 8 54000013 DC X'5C53D233B272F30A8B4B5C5C5C5C5C5C' 9 57000013 DC X'5C5CCA2BAA6AEB1B9A5A5C5C5C5C5C5C' A 60000013 DC X'5C5C5C5C5C5C5C5C5C5C5C5C5C5C5C5C' B 63000013 DC X'5C8242C322A363E212935C5C5C5C5C5C' C 66000013 DC X'5C53D233B272F30A8B4B5C5C5C5C5C5C' D 69000013 DC X'5C3ACA2BAA6AEB1B9A5A5C5C5C5C5C5C' E 72000013 DC X'0C8D4DCC2DAC6CED1D9C5C5C5C5C5C5C' F 75000013 END 78000013 ./ ADD SSI=01011170,NAME=IECKSDT3,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSDT3 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE * 12000013 * FROM EBCDIC TO 8-LEVEL TWX CODE. APPLICABLE FOR AT&T 33/35. * 15000013 * * 18000013 *********************************************************************** 21000013 IECKSDT3 START 24000013 *1170330000-360000 4549 25000016 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 27000013 DC X'FF5D5DB129915DFF5D5D5DD131B171F1' 0 30000013 DC X'5D895D5D5D515DFF5D5D5D5D5D5D5D5D' 1 4549 33000016 DC X'5D5D5D5D5D51B15D5D5D5D5D5D5D5DE1' 2 4549 36000016 DC X'5D5DFF5D495D5D5D5D5D5D5DC95D5D5D' 3 39000013 DC X'055D5D5D5D5D5D5D5DBB5D753D15D57B' 4 42000013 DC X'655D5D5D5D5D5D5D5D5D85255595DD5D' 5 45000013 DC X'B5F55D5D5D5D5D5D5D5D5D35A5FB7DFD' 6 48000013 DC X'5D5D5D5D5D5D5D5D5DDB5DC503E5BD45' 7 51000013 DC X'5D8343C323A363E313935D5D5D5D5D5D' 8 54000013 DC X'5D53D333B373F30B8B4B5D5D5D5D5D5D' 9 57000013 DC X'5D5DCB2BAB6BEB1B9B5B5D5D5D5D5D5D' A 60000013 DC X'5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D' B 63000013 DC X'5D8343C323A363E313935D5D5D5D5D5D' C 66000013 DC X'5D53D333B373F30B8B4B5D5D5D5D5D5D' D 69000013 DC X'5D3BCB2BAB6BEB1B9B5B5D5D5D5D5D5D' E 72000013 DC X'0D8D4DCD2DAD6DED1D9D5D5D5D5D5D5D' F 75000013 END 78000013 ./ ADD SSI=03010773,NAME=IECKSD30,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSD30 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 1030 TRANSMISSION CODE. APPLICABLE TO IBM 1031 * 15000013 * AND 1033 ONLY. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKSD30 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'DF37163D237ADF7F23232323235B2323' 0 33000013 DC X'23232323235B23DF2323232323232323' 1 36000013 DC X'23232323233B3D232323232323232323' 2 39000013 DC X'2323DF232323231F2323232323232323' 3 42000013 DC X'01232323232323232323237623232323' 4 45000013 DC X'61232323232323232323235723232323' 5 48000013 DC X'40232323232323232323233723232323' 6 51000013 DC X'23232323232323232323231620232323' 7 54000013 DC X'23626467686B6D6E7073232323232323' 8 57000013 DC X'23434546494A4C4F5152232323232323' 9 60000013 DC X'23232526292A2C2F3132232323232323' A 63000013 DC X'23232323232323232323232323232323' B 66000013 DC X'23626467686B6D6E7073232323232323' C 69000013 DC X'23434546494A4C4F5152232323232323' D 72000013 DC X'23232526292A2C2F3132232323232323' E 75000013 DC X'15020407080B0D0E1013232323232323' F 78000013 END 81000013 ./ ADD SSI=02010774,NAME=IECKSD40,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSD40 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 2740 TRANSMISSION CODE. APPLICABLE TO IBM 2740 * 15000013 * TYPES I-VIII ONLY. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKSD40 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'5E37163D887A7C7F88888888885B8888' 0 33000013 DC X'88888888885B5D5E8888888888888888' 1 36000013 DC X'88888888883B3D888888888888888888' 2 39000013 DC X'88885E8888881C1F8888888888888888' 3 42000013 DC X'01888888888888888888A0768493E1B7' 4 45000013 DC X'61888888888888888888D757909587F6' 5 48000013 DC X'4023888888888888888888378BC08EA3' 6 51000013 DC X'888888888888888888888816208D8296' 7 54000013 DC X'88626467686B6D6E7073888888888888' 8 57000013 DC X'88434546494A4C4F5152888888888888' 9 60000013 DC X'88882526292A2C2F3132888888888888' A 63000013 DC X'88888888888888888888888888888888' B 66000013 DC X'88E2E4E7E8EBEDEEF0F3888888888888' C 69000013 DC X'88C3C5C6C9CACCCFD1D2888888888888' D 72000013 DC X'8888A5A6A9AAACAFB1B2888888888888' E 75000013 DC X'15020407080B0D0E1013888888888888' F 78000013 END 81000013 ./ ADD SSI=03010774,NAME=IECKSD50,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSD50 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 1060 TRANSMISSION CODE. APPLICABLE TO IBM 1050'S * 15000013 * ON A SWITCHED OR NONSWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKSD50 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'5E88163D797A7C7F88888888885B3858' 0 33000013 DC X'88888888585B5D5E8888888888888888' 1 36000013 DC X'88888888383B3D3E8888888888888888' 2 39000013 DC X'88885E88191A1C1F8888888888888888' 3 42000013 DC X'01888888888888888888A0768493E1B7' 4 45000013 DC X'61888888888888888888D757909587F6' 5 48000013 DC X'4023888888888888888888378BC08EA3' 6 51000013 DC X'888888888888888888888816208D8296' 7 54000013 DC X'88626467686B6D6E7073888888888888' 8 57000013 DC X'88434546494A4C4F5152888888888888' 9 60000013 DC X'88882526292A2C2F3132888888888888' A 63000013 DC X'88888888888888888888888888888888' B 66000013 DC X'75E2E4E7E8EBEDEEF0F3888888888888' C 69000013 DC X'54C3C5C6C9CACCCFD1D2888888888888' D 72000013 DC X'3488A5A6A9AAACAFB1B2888888888888' E 75000013 DC X'15020407080B0D0E1013888888888888' F 78000013 END 81000013 ./ ADD SSI=03010774,NAME=IECKSD60,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKSD60 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 1060 TRANSMISSION CODE. APPLICABLE TO IBM * 15000013 * 1060 ON A NONSWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKSD60 START 27000013 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'5E23163D797A5E7F23232323235B2323' 0 33000013 DC X'23232323585B235E2323232323232323' 1 36000013 DC X'23232323233B3D232323232323232323' 2 39000013 DC X'23235E232323231F2323232323232323' 3 42000013 DC X'01232323232323232323237623232323' 4 45000013 DC X'61232323232323232323235723232323' 5 48000013 DC X'40232323232323232323233723232323' 6 51000013 DC X'23232323232323232323231620232323' 7 54000013 DC X'23626467686B6D6E7073232323232323' 8 57000013 DC X'23434546494A4C4F5152232323232323' 9 60000013 DC X'23232526292A2C2F3132232323232323' A 63000013 DC X'23232323232323232323232323232323' B 66000013 DC X'75626467686B6D6E7073232323232323' C 69000013 DC X'54434546494A4C4F5152232323232323' D 72000013 DC X'23232526292A2C2F3132232323232323' E 75000013 DC X'15020407080B0D0E1013232323232323' F 78000013 END 81000013 ./ ADD SSI=03010356,NAME=IECKSEQN,SOURCE=0 TITLE 'IECKSEQN QTAM SEQUENCE-IN (SEQIN)' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKSEQN QTAM SEQUENCE-IN (SEQIN) * 03000013 * * 03600013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04200013 * * 04800013 *FUNCTION- * 05400013 * IECKSEQN IS USED TO CHECK THE SEQUENCE NUMBER OF AN INCOMING * 06000013 * MESSAGE. IF THE NUMBER IS NOT IN SEQUENCE ACCORDING TO THE * 06600013 * TSEQUIN FIELD IN THE TERMINAL TABLE ENTRY, THE SEQUENCE ERROR BIT * 07200013 * IN THE LCB IS SET ACCORDINGLY. IF THE NUMBER IS TOO HIGH OR IN * 07800013 * CORRECT SEQUENCE, THE EXPECTED SEQUENCE NUMBER FROM THE TERMINAL * 08400013 * TABLE IS STORED IN THE LCBERRST FIELD OF THE LCB (LCB+40). THE * 09000013 * EXPECTED SEQUENCE NUMBER IS INCREMENTED BY ONE FOR THE NEXT * 09600013 * MESSAGE BEFORE RETURNING TO THE NEXT LPS INSTRUCTION. * 10200013 * IECKSCAN IS USED TO FIND THE END OF THE SEQUENCE NUMBER IN * 10800013 * THE MESSAGE HEADER. SCAN WILL RETURN THE ADDRESS OF THE WORKWORD * 11400013 * CONTAINING THE CHARACTERS THAT WERE SCANNED, AND THE COUNT OF THE * 12000013 * CHARACTERS SCANNED. SEQIN WILL ASSUME THESE CHARACTERS TO BE * 12600013 * NUMERIC. ONE AT A TIME THESE CHARACTERS WILL BE INSERTED INTO A * 13200013 * WORK REGISTER, STRIPPED OF THEIR ZONES, AND MULTIPLIED BY TEN. * 13800013 * THE LAST NUMBER IS MERELY ADDED TO THIS SUM WITHOUT * 14400013 * MULTIPLICATION. THE RESULT IS THE CONVERTED INPUT SEQUENCE * 15000013 * NUMBER IN BINARY FORM. * 15600013 * THIS BINARY SUM IS COMPARED WITH THE EXPECTED INCOMMING * 16200013 * SEQUENCE NUMBER. IF THIS SUM IS LOW, LCBERRST (LCB+40) IS OR'ED * 16800013 * WITH A X'10' TO SET THE SEQUENCE LOW BIT IN THE ERROR HALFWORD. * 17400013 * IF SUM IS HIGH, LCBERRST IS OR'ED WITH X'20' TO SET THE * 18000013 * SEQUENCE HIGH ERROR BIT. * 18600013 * ON A HIGH OR EQUAL, THE BINARY SEQUENCE NUMBER FORMED IS * 19200013 * STORED IN THE MSNUMIN FIELD OF THE HEADER PREFIX. THE EXPECTED * 19800013 * SEQUENCE NUMBER IS MOVED INTO THE LCBBRKCT FIELD OF THE LCB. * 20400013 * IT IS UPDATED BY ONE AND RETURNED TO THE TSEQUIN FIELD OF THE * 21000013 * TERMINAL TABLE. * 21600013 * RETURN IS TO THE NEXT LPS INSTRUCTION. * 22200013 * * 22800013 *ENTRY POINTS- * 23400013 * IECKSEQN - THE EXPANSION OF THE SEQIN MACRO GENERATES A BALR TO * 24000013 * THIS POINT, USING REGISTER 15 AS THE ENTRY POINT REGISTER * 24600013 * AND REGISTER 14 AS THE RETURN REGISTER. * 25200013 * * 25800013 *INPUT- * 26400013 * REGISTER 14- RETURN ADDRESS * 27000013 * REGISTER 14 ALSO CONTAINS A POINTER TO THE NUMBER OF * 27600013 * CHARACTERS IN THE SEQUENCE NUMBER IN THE HEADER. THIS * 28200013 * NUMBER IS USED BY IECKSCAN. * 28800013 * REGISTER 15- ENTRY POINT REGISTER. * 29400013 * * 30000013 *OUTPUT- * 30600013 * IF SEQUENCE NUMBER IS LOW, LOW SEQUENCE ERROR FLAG IS SET IN THE * 31200013 * ERROR HALFWORD. * 31800013 * IF SEQUENCE NUMBER IS CORRECT, BINARY SEQUENCE NO. IS IN HEADER * 32400013 * PREFIX AND EXPECTED SEQUENCE IS IN TERMINAL TABLE ENTRY. * 33000013 * IF SEQUENCE NUMBER IS HIGH, THE HIGH SEQUENCE BIT IS SET IN THE * 33600013 * ERROR HALFWORD, AS WELL AS ALL RESULTS FROM EQUAL COMPARE. * 34200013 * * 34800013 *EXTERNAL ROUTINES- * 35400013 * IECKSCAN - USED TO SCAN THE HEADER FOR EITHER THE NUMBER OF * 36000013 * CHARACTERS SPECIFIED, OR THE END OF THE NEXT FIELD, * 36600013 * DEPENDING UPON WHAT THE CALLING ROUTINE SPECIFIES. * 37200013 * * 37800013 *EXITS- * 38400013 * NORMAL - RETURN IS TO THE NEXT LPS INSTRUCTION BY BRANCHING * 39000013 * ON REGISTER 14. * 39600013 * ERROR - SAME AS ABOVE BUT WITH PROPER ERROR BIT SET IN THE * 40200013 * ERROR HALFWORD (LCB+40): * 40800013 * X'10' FOR LOW SEQUENCE NUMBER * 41400013 * X'20' FOR HIGH SEQUENCE NUMBER. * 42000013 * * 42600013 *TABLES/WORK AREAS- * 43200013 * NONE * 43800013 * * 44400013 *ATTRIBUTES- * 45000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 45600013 * * 46200013 *NOTES- * 46800013 * REGISTER 0- WORK REGISTER. CHARACTERS FROM SCAN'S WORK AREA WILL * 47400013 * BE INSERTED INTO THE LOW ORDER BYTE OF THIS REGISTER. * 48000013 * REGISTER 1- WORK REGISTER. WILL HOLD A MASK FOR CLEARING A * 48600013 * HALFWORD. * 49200013 * REGISTER 2- WORK REGISTER. ON RETURNING FROM SCAN, THIS REGISTER* 49800013 * WILL HOLD THE POINTER TO SCAN'S WORK AREA. * 50400013 * REGISTER 3- SECOND LEVEL LINKAGE. WILL HOLD THE RETURN ADDRESS * 51000013 * WHEN LINKING TO SCAN. LATER, IT WILL HOLD A MASK TO STRIP * 51600013 * ZONE BITS FROM CHARACTERS. * 52200013 * REGISTER 4- BASE FOR LCB. * 52800013 * REGISTER 7- BASE FOR THIS LPS. * 53400013 * REGISTER 8- BASE FOR TERMINAL TABLE. * 54000013 * REGISTER 9- WORK REGISTER. SCAN WILL RETURN THE NUMBER OF * 54600013 * CHARACTERS SCANNED IN THIS REGISTER. * 55200013 * REGISTER 10- WORK REGISTER. WILL HOLD AN INCREMENT VALUE OF 1. * 55800013 * REGISTER 12- WORK REGISTER. BINARY SEQUENCE NUMBER WILL BE * 56400013 * ACCUMULATED HERE. * 57000013 * * 57600013 *********************************************************************** 58200013 IECKSEQN START 58800013 *3410738000,900000 18912 59100017 *90351816000,852000 00PS 59200017 *90356819000,831000 00PS 59300017 DREG0 EQU 0 59400013 DREG1 EQU 1 60000013 KREG EQU 2 60600013 RREG2 EQU 3 61200013 LCBREG EQU 4 61800013 MSREG EQU 6 62400013 LGREG EQU 7 63000013 TCREG EQU 8 63600013 WREG1 EQU 9 64200013 IREG EQU 10 64800013 WREG2 EQU 12 65400013 RREG1 EQU 14 66000013 SREG EQU 15 66600013 USING *,SREG 67200013 USING IECKPREF,MSREG 67800013 USING IECKTERM,TCREG 68400013 USING IECKLCB0,LCBREG 69000013 LR DREG0,SREG SAVE BASE REG 69600013 L SREG,4(0,LGREG) GET SCAN ADDR 70200013 BALR RREG2,SREG LINKAGE TO SCAN SUBR 70800013 LR SREG,DREG0 RESTORE BASE REG 71400013 LTR WREG1,WREG1 TEST FOR HEADER ERROR 72000013 BE TOOLOW IF YES ASSUME LOW SEQ 72600013 LA RREG2,15 MASK FOR CLEARING ZONE BITS 73200013 L DREG1,XFFFF MASK FOR CLEARING WRAP VALUE 18912 73800017 LA WREG2,1(0,DREG1) SET INITIAL WRAP VALUE 74400013 TLOOP MH WREG2,H10 MULTIPLY PREVIOUS ACCUMULATION BY 10 75000013 IC DREG0,0(0,KREG) GET CHARACTER 75600013 NR DREG0,RREG2 CLEAR ZONES 76200013 BZ TEST TEST FOR ZERO 76800013 NR WREG2,DREG1 CLEAR WRAP VALUE 77400013 AR WREG2,DREG0 ADD DIGIT 78000013 TEST AR KREG,IREG GET NEXT SCAN CHARACTER 78600013 BCT WREG1,TLOOP RETURN IF NOT END 79200013 NR DREG1,WREG2 CLEAR NON WRAP VALUE 79800013 SRL WREG2,16 CLEAR WRAP INCREMENT 80400013 AR WREG2,DREG1 GET WRAP VALUE 81000013 STH DREG1,LCBBRKCT AND SAVE IN LCB 00PS 81600017 STH DREG1,MSNUMIN SAVE IN BUFFER PREFIX 00PS 81900017 CH WREG2,TSEQUIN IS MSG NUM INSEQ 82200013 BE GOOD 82800013 MVC MSNUMIN(2),XFFFF CLEAR OUT MSNUMIN IF WRONG 00PS 83100017 NONSEQ BC 4,TOOLOW BRANCH IF NUMBER TOO LOW 83400013 OI LCBERRST,X'20' SET SEQ HIGH ERROR BIT 84000013 B 2(0,RREG1) RETURN 84600013 GOOD MVC LCBBRKCT,TSEQUIN STORE EXPECTED SEQUENCE NO. 00PS 85200017 AR DREG1,IREG INCREMENT SEQUENCE 85800013 STH DREG1,TSEQUIN STORE FOR NEXT MESSAGE 86400013 B 2(0,RREG1) RETURN 87000013 SPACE 87600013 TOOLOW OI LCBERRST,X'10' SET SEQ LOW ERROR BIT 88200013 B 2(0,RREG1) RETURN 88800013 SPACE 89400013 XFFFF DC F'65535' 18912 90000017 H10 DC H'10' 90600013 EJECT 91200013 PREFIXD 91800013 EJECT 92400013 TERMTBLD 93000013 EJECT 93600013 LCBD 94200013 END 94800013 ./ ADD SSI=02013243,NAME=IECKSEQT,SOURCE=0 TITLE 'IECKSEQT QTAM SEQUENCE-OUT (SEQOUT) QTAM III' 02000013 *********************************************************************** 02070018 * * 02140018 *NAME- * 02210018 * IECKSEQT QTAM SEQUENCE OUT (SEQOUT) * 02280018 * * 02350018 *STATUS- CHANGE LEVEL= 19 JANUARY 1971 * 02420021 * * 02490018 *FUNCTION- * 02560018 * IF THE SEQOUT MACRO APPEARS IN THE RCVHDR PORTION OF THE LPS,* 02570021 * THE DESTINATION QCB IS CHECKED FOR BEING A PROCESS QCB. IF THIS IS* 02580021 * NOT A PROCESS QCB, RETURN IS MADE TO THE NEXT LPS INSTRUCTION. IF * 02590021 * A PROCESS QCB, LINKAGE IS MADE TO THE EXPAND ROUTINE, WHICH * 02600021 * EXPANDS THE HEADER TO CREATE A NEW FIELD. IDLE CHARACTERS ARE * 02610021 * INSERTED INTO THIS FIELD. THE VALUE OF THE SCAN POINTER IS STORED* 02620021 * IN THE MSNUMOUT FIELD OF THE HEADER. RETURN IS MADE TO THE NEXT * 02630021 * LPS INSTRUCTION. * 02640021 * IF THE SEQOUT MACRO APPEARS IN THE SENDHR PORTION OF THE LPS,* 02650021 * THE ROUTINE BRANCHES AND LINKS TO IECKEXPD TO SHIFT THE * 02660021 * CONTENTS OF THE HEADER LEFT FROM THE CURRENT POINT BY THE * 02700018 * NUMBER OF BYTES SPECIFIED IN THE PARAMETER OF THE MACRO. * 02770018 * THE BINARY OUTPUT SEQUENCE NUMBER IS RETRIEVED FROM THE HEADER * 02840018 * PREFIX, CONVERTED TO DECIMAL FORM, UNPACKED, AND INSERTED INTO * 02910018 * THE NEWLY CREATED HEADER FIELD. * 02980018 * * 03050018 *ENTRY POINTS- * 03120018 * IECKSEQT - ENTERED FROM MACRO GENERATION BY STANDARD LINKAGE * 03190018 * CONVENTIONS. * 03260018 * * 03330018 *INPUT- * 03400018 * REGISTER 6- ADDRESS OF MESSAGE BUFFER. * 03470018 * REGISTER 14- RETURN ADDRESS * 03540018 * REGISTER 14 ALSO POINTS TO A PARAMETER LIST WHICH CONTAINS * 03610018 * THE SIZE OF THE FIELD TO BE EXPANDED. THIS PARAMETER IS USED * 03680018 * BY IECKEXPD. * 03750018 * REGISTER 15- ADDRESS OF THIS ROUTINE. * 03820018 * * 03890018 *OUTPUT- * 03960018 * UNPACKED DECIMAL OUTPUT SEQUENCE NUMBER IS IN THE NEWLY-CREATED * 04030018 * FIELD OF THE HEADER. REGISTER 10 POINTS TO THIS FIELD.* 04100018 * * 04170018 *EXTERNAL ROUTINES- * 04240018 * IECKEXPD - USED TO EXPAND HEADER TO MAKE ROOM FOR NEW FIELD. * 04310018 * * 04380018 *EXITS- * 04450018 * NORMAL- RETURN IS TO NEXT LPS INSTRUCTION BY BRANCHING AROUND * 04520018 * 2 BYTE CONSTANT CREATED BY THE MACRO EXPANSION. * 04590018 * ERROR- NONE. * 04660018 * * 04730018 *TABLES/WORK AREAS- * 04800018 * SEQWORD IS USED TO RECEIVE CONVERTED DECIMAL DATA. DATA HERE IS * 04870018 * UNPACKED INTO THE HEADER FIELD. * 04940018 * * 05010018 *ATTRIBUTES- * 05080018 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 05150018 * * 05220018 *NOTES- * 05290018 * REGISTER 0 IS USED AS A WORK REGISTER * 05360018 * REGISTER 3 IS USED FOR SECOND LEVEL LINKAGE TO IECKEXPD. * 05430018 * REGISTER 9 IS USED AS A WORK REGISTER * 05500018 * * 05570018 *********************************************************************** 05640018 IECKSEQT START 05710018 * 490000-550000 M3139 05780018 * 520000-530000 A29205 05880019 *A024200,025700-026600 S21016 05940021 DREG0 EQU 0 06000013 RREG2 EQU 3 08000013 LCBREG EQU 4 10000013 MSREG EQU 6 12000013 WREG1 EQU 9 14000013 WREG2 EQU 10 16000013 WREG3 EQU 12 18000013 REG13 EQU 13 20000013 RREG1 EQU 14 22000013 SREG EQU 15 24000013 USING *,SREG 26000013 USING IECKPREF,MSREG 28000013 USING IECKLCB0,LCBREG 30000013 LR DREG0,SREG SAVE BASE REG 32000013 TM 0(LCBREG),X'04' IS THIS AN OUTPUT OPERATION 34000013 BO SEQT BRANCH IF YES 36000013 L WREG3,LCBDESTQ-1 NO, ACCESS DEST. QCB 38000013 CLI 8(WREG3),0 IS THIS A PROCESS QCB 40000013 BNE 2(0,RREG1) NO, NO OP THIS MACRO AND RETURN 42000013 L SREG,=V(IECKEXPD) ACCESS ADDR OF EXPAND ROUTINE 44000013 BALR RREG2,SREG LINK TO EXPAND ROUTINE 46000013 LR SREG,DREG0 RESTORE BASE REG 48000013 LA WREG3,1(WREG2) PREPARE AND SAVE M3139 49000018 SR WREG3,MSREG ONE BYTE OFFSET TO M3139 50000018 STH WREG3,MSNUMOUT SEQ OUT FIELD IN MSG HDR M3139 51000018 LOOP MVI 1(WREG2),X'17' INSERT IDLE CHARACTER IN FIELD A29205 52000019 LA WREG2,1(WREG2) ADD ONE TO AREA A29205 53000019 BCT WREG1,LOOP LOOP FOR ENTIRE FIELD M3139 55000018 B 2(0,RREG1) RETURN TO MAINLINE LPS 56000013 SEQT EQU * 58000013 L SREG,=V(IECKEXPD) 60000013 BALR RREG2,SREG LINK TO EXPAND SUBR 62000013 LR SREG,DREG0 RESTORE BASE REG 64000013 LH DREG0,MSNUMOUT GET BINARY SEQ NO FROM HDR PRFX 66000013 CVD DREG0,SEQWORD CPNVERT BINARY SEQ NO TO DECIMAL 68000013 OI SEQWORD+7,X'0F' DELETE SIGN 70000013 BCTR WREG1,0 DECR COUNT FIELD BY ONE 72000013 SLL WREG1,4 ALIGN FIELD SIZE 74000013 EX WREG1,UNPAK1 EXEC UNPACK SEQ NO INTO HDR FLD 76000013 B 2(0,RREG1) RETURN 78000013 SPACE 80000013 UNPAK1 UNPK 1(1,WREG2),SEQWORD UNPACK SEQ NO INTO HDR FIELD 82000013 SEQWORD DS 1D 84000013 DS 0F 86000013 EJECT 88000013 PREFIXD 90000013 EJECT 92000013 LCBD 94000013 END 96000013 ./ ADD SSI=02010760,NAME=IECKSKPC,SOURCE=0 *********************************************************************** 01000013 * * 02000013 *NAME- * 03000013 * IECKSKPC QTAM SKIP CHARACTER COUNT (SKIP) * 04000013 * * 05000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 06000013 * * 07000013 *FUNCTION- * 08000013 * THIS ROUTINE SKIPS THE SCAN POINTER OVER A SPECIFIED * 09000013 * NUMBER OF NON-BLANK CHARACTERS. ALL CHARACTERS BYPASSED ARE * 10000013 * COMPLETELY IGNORED. AT THE END OF THE OPERATION, THE SCAN * 11000013 * POINTER POINTS TO THE LAST NON-BLANK CHARACTER SKIPPED. * 12000013 * * 13000013 *ENTRY POINTS- * 14000013 * IECKSKPC - EXPANSION OF THE SKIP MACRO GENERATES A BRANCH TO * 15000013 * THIS POINT WHEN A NUMBER OF CHARACTERS IS SPECIFIED * 16000013 * AS THE OPERAND. LINKAGE IS BY STANDARD LINKAGE * 17000013 * CONVENTIONS. * 18000013 * * 19000013 *INPUT- * 20000013 * REGISTER 5- POINTER TO BYTE BEFORE CURRENT CHAR IN SEGMENT * 21000013 * REGISTER 14- RETURN ADDRESS * 22000013 * REGISTER 14 IS ALSO A POINTER TO A HALF-WORD PARAMETER, THE * 23000013 * NUMBER OF NON-BLANK CHARACTERS TO BE SKIPPED. * 24000013 * REGISTER 15- ADDRESS OF THIS ROUTINE. * 25000013 * * 26000013 *OUTPUT- * 27000013 * REGISTER 5- THE SCAN POINTER WILL HAVE BEEN UPDATED BY THE NUMBER* 28000013 * OF CHARACTERS SPECIFIED. IF THE SCAN POINTER REACHES * 29000013 * THE END OF THE SEGMENT BEFORE EXHAUSTING THE SPECIFIED * 30000013 * COUNT,BIT 5, INCOMPLETE MESSAGE HEADER, IS SET IN * 31000013 * THE ERROR HALFWORD, LCBERRST (LCB ADDRESS+40). * 32000013 * * 33000013 *EXTERNAL ROUTINES- * 34000013 * NONE. * 35000013 * * 36000013 *EXITS- * 37000013 * NORMAL- RETURN IS TO THE NEXT LPS INSTRUCTION BY BRANCHING * 38000013 * ON REGISTER 14. * 39000013 * ERROR- IF THE SCAN POINTER SKIPS PAST THE END OF THE SEGMENT, * 40000013 * THE INCOMPLETE HEADER BIT IN THE ERROR HALFWORD WILL BE SET, * 41000013 * THAT IS, THE CONTENTS OF LCBERRST (LCB+40) WILL BE OR'ED WITH A * 42000013 * X'04' TO SET THE ERROR BIT. * 43000013 * * 44000013 *TABLES/WORK AREAS- * 45000013 * NONE. * 46000013 * * 47000013 *ATTRIBUTES- * 48000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 49000013 * * 50000013 *NOTES- * 51000013 * REGISTER 9- USED AS A WORK REGISTER. * 52000013 * REGISTER 10- USED AS A WORK REGISTER. * 53000013 * * 54000013 *********************************************************************** 55000013 IECKSKPC START 56000013 LCBREG EQU 4 57000013 SPREG EQU 5 58000013 WREG1 EQU 9 59000013 IREG EQU 10 60000013 RREG1 EQU 14 61000013 SREG EQU 15 62000013 USING *,SREG 63000013 USING IECKLCB0,LCBREG 64000013 LH WREG1,0(0,RREG1) GET FIELD SIZE 65000013 LA IREG,1 GET INCREMENT VALUE 66000013 SKPCHAR BXH SPREG,IREG,HEADERR2 BUMP SCAN POINTER--END OF SEGM TST 67000013 CLI 0(SPREG),X'40' TEST FOR BLANK 68000013 BC 8,SKPCHAR IF YES POINT TO NXT CHAR 69000013 BCT WREG1,SKPCHAR DECR COUNT TO SKIP 70000013 B 2(0,RREG1) RETURN 71000013 SPACE 72000013 HEADERR2 OI LCBERRST,X'04' SET ERROR BIT 73000013 BCT SPREG,2(0,RREG1) RETURN 74000013 EJECT 75000013 LCBD 76000013 END 77000013 ./ ADD SSI=02010760,NAME=IECKSKPS,SOURCE=0 *********************************************************************** 00800013 * * 01600013 *NAME- * 02400013 * IECKSKPS QTAM SKIP CHARACTER SET (SKIP) * 03200013 * * 04000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04800013 * * 05600013 *FUNCTION- * 06400013 * LOCATE A GIVEN CHARACTER SEQUENCE IN THE HEADER SEGMENT. * 07200013 * IECKSCAN(SCAN) IS USED TO LOCATE THE NEXT NON-BLANK CHARACTER. * 08000013 * SKIP COMPARES THE REQUIRED NUMBER OF CHARACTERS WITH THE * 08800013 * DESIRED CHARACTER SEQUENCE. IF THEY ARE THE SAME, SKIP RETURNS * 09600013 * TO THE NEXT LPS INSTRUCTION. IF NOT EQUAL, SKIP GOES BACKTO SCAN * 10400013 * TO GET THE NEXT NON-BLANK CHARACTER. THIS CONTINUES UNTIL * 11200013 * THE DESIRED SEQUENCE IS FOUND, OR UNTIL END OF SEGMENT IS REACHED.* 12000013 * IF END OF SEGMENT IS FOUND, FIRST MULTIPLE DESTINATION ROUTING * 12800013 * IS CANCELLED, THE SCAN POINTER IS RESET TO THE END OF THE * 13600013 * SEGMENT, AND CONTROL RETURNS TO THE NEXT LPS INSTRUCTION. * 14400013 * * 15200013 *ENTRY POINTS- * 16000013 * IECKSKPS - EXPANSION OF THE SKIP MACRO GENERATES A BRANCH AND * 16800013 * LINK TO THIS POINT IF A CHARACTER SEQUENCE IS GIVEN * 17600013 * AS THE OPERAND OF THE SKIP MACRO. * 18400013 * * 19200013 *INPUT- * 20000013 * REGISTER 2- POINTS TO WORKAREA CONTAINING THE NEXT FIELD IN THE * 20800013 * HEADER SEGMENT PASSED FROM IECKSCAN. * 21600013 * REGISTER 4- ADDRESS OF LCB. * 22400013 * REGISTER 5- POINTER TO BYTE BEFORE CURRENT FIELD IN HEADER * 23200013 * SEGMENT * 24000013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 24800013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 25600013 * REGISTER 14- RETURN ADDRESS * 26400013 * REGISTER 14 ALSO POINTS TO A PARAMETER LIST CONSISTING OF: * 27200013 * 1. A HALFWORD CONTAINING THE LENGTH OF THE CHARACTER * 28000013 * SEQUENCE TO BE FOUND, AND * 28800013 * 2. A CHARACTER CONSTANT CONTAINING THE CHARACTER * 29600013 * TO BE FOUND. * 30400013 * REGISTER 15- ADDRESS OF THIS ROUTINE. * 31200013 * * 32000013 *OUTPUT- * 32800013 * REGISTER 4- ADDRESS OF THE LCB * 33600013 * REGISTER 5- POINTS TO THE LAST CHARACTER OF THE DESIRED * 34400013 * CHARACTER SEQUENCE, OR THE LAST CHARACTER OF THE * 35200013 * HEADER SEGMENT IF THE SPECIFIED CHARACTER SET WAS * 36000013 * NOT FOUND. * 36800013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 37600013 * REGISTER 9- WORK REGISTER. * 38400013 * IF THE NUMBER OF CHARACTERS DESIRED IS ODD, * 39200013 * REGISTER 9 WILL CONTAIN THAT NUMBER. IF THE * 40000013 * NUMBER IS EVEN, REGISTER 9 WILL CONTAIN THE * 40800013 * NEXT HIGHEST ODD NUMBER, I.E., REGISTER 9 WILL ALWAYS * 41600013 * CONTAIN AN ODD NUMBER. * 42400013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 43200013 * * 44000013 *EXTERNAL ROUTINES- * 44800013 * IECKSCAN - SKIP BRANCHES AND LINKS TO SCAN (USING REGISTER 3 AS * 45600013 * THE RETURN REGISTER) TO GET THE ADDRESS OF THE NEXT * 46400013 * NON-BLANK CHARACTER IN THE SEGMENT. * 47200013 * * 48000013 *EXITS- * 48800013 * NORMAL- RETURN TO THE NEXT LPS INSTRUCTION IS ACCOMPLISHED BY * 49600013 * BRANCHING AROUND CONSTANTS GENERATED BY THE SKIP MACRO. * 50400013 * ERROR- NONE. * 51200013 * * 52000013 *TABLES/WORK AREAS- * 52800013 * NONE. * 53600013 * * 54400013 *ATTRIBUTES- * 55200013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 56000013 * * 56800013 *NOTES- * 57600013 * REGISTER 0- USED AS A WORK REGISTER TO HOLD THE SCAN POINTER. * 58400013 * REGISTER 1- USED FOR BASE REGISTER FOR IECKSKPC * 59200013 * REGISTER 3- USED AS A SECOND LEVEL RETURN REGISTER FOR * 60000013 * RETURNING FROM SCAN. * 60800013 * REGISTER 9- USED AS A WORK REGISTER. * 61600013 * REGISTER 10- USED AS A WORK REGISTER * 62400013 * * 63200013 *********************************************************************** 64000013 IECKSKPS START 64800013 DREG0 EQU 0 65600013 DREG1 EQU 1 66400013 KREG EQU 2 67200013 RREG2 EQU 3 68000013 LCBREG EQU 4 68800013 SPREG EQU 5 69600013 LGREG EQU 7 70400013 WREG1 EQU 9 71200013 IREG EQU 10 72000013 EOSREG EQU 11 72800013 RREG1 EQU 14 73600013 SREG EQU 15 74400013 USING IECKLCB0,LCBREG 75200013 BALR DREG1,0 SAVE BASE REG 76000013 USING *,DREG1 76800013 LA DREG0,1(0,SPREG) STORE SCAN POINTER 77600013 L SREG,4(0,LGREG) GET SCAN ADDR 78400013 BALR RREG2,SREG LINKAGE TO SCAN SUBR 79200013 LH WREG1,0(0,RREG1) GET FIELD SIZE 80000013 SR WREG1,IREG ADJUST COUNT 80800013 EX WREG1,MATCH WAS SET FOUND 81600013 BC 8,RETURN IF YES,RETURN 82400013 LR SPREG,DREG0 ELSE INCR STORED SCAN PTR ONE BYTE 83200013 TM LCBERRST,X'04' TEST FOR SCAN ERROR 84000013 BCR 8,DREG1 IF NOT RETURN TO TRY AGAIN 84800013 ERROR MVI LCBMPLRT,0 AND CANCEL MULTIPLE ROUTING 85600013 LR SPREG,EOSREG RESET SCAN TO END OF BUFFER 86400013 RETURN OR WREG1,IREG INCREMENT COUNT IF ODD 87200013 USING CALL+1,RREG1 88000013 B RETLOC(WREG1) 88800013 SPACE 89600013 MATCH CLC 2(1,RREG1),0(KREG) COMPARE INSTRUCT 90400013 CALL DSECT 91200013 SIZE DS H 92000013 CHAR DS C 92800013 RETLOC DS 0H 93600013 EJECT 94400013 LCBD 95200013 END 96000013 ./ ADD SSI=02011960,NAME=IECKSRCE,SOURCE=0 TITLE 'IECKSRCE QTAM SOURCE (SOURCE)' 00600013 *********************************************************************** 01200013 * * 01800013 *NAME- * 02400013 * IECKSRCE QTAM SOURCE (SOURCE) * 03000013 * * 03600013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 04200013 * * 04800013 *FUNCTION- * 05400013 * DETERMINES THE VALIDITY OF THE SOURCE CODE FIELD OF AN * 06000013 * INCOMING MESSAGE HEADER. THE ROUTINE LINKS TO THE SCAN ROUTINE * 06600013 * TO OBTAIN THE SOURCE CODE FROM THE HEADER. * 07200013 * IF THE MESSAGE ORIGINATED FROM A NON-SWITCHED TERMINAL, THE * 07800013 * CONTENTS OF THE SOURCE FIELD ARE COMPARED WITH THE NAME OF THE * 08400013 * ORIGINATING TERMINAL (AS THE NAME APPEARS IN THE TERMINAL TABLE * 09000013 * ENTRY). IF THE CHARACTERS MATCH, THE SOURCE CODE IS CONSIDERED * 09600013 * VALID. * 10200013 * IF THE MESSAGE ORIGINATED FROM A SWITCHED TERMINAL, THE * 10800013 * CONTENTS OF THE SOURCE CODE FIELD ARE COMPARED WITH EACH TERMINAL * 11400013 * ENTRY NAME IN THE TERMINAL TABLE, IN SUCCESSION, UNTIL A MATCH IS * 12000013 * FOUND. IF THE SOURCE CODE MATCHES ANY OF THE ENTRY NAMES IN THE * 12600013 * TERMINAL TABLE THAT IS IN THE SAME LINE GROUP AS THE LINE, IT IS * 13200000 * CONSIDERED VALID. IF NO MATCH IS FOUND AMONG ANY OF THE ENTRY * 13800000 * NAMES IN THE TABLE, THE CODE IS CONSIDERED INVALID. * 14400000 * IF THE SOURCE CODE IS VALID, THE ROUTINE PLACES ITS RELATIVE * 15000013 * ADDRESS IN TTSKEY FIELD OF THE HEADER PREFIX IN THE BUFFER WHOSE * 15600013 * MESSAGE SEGMENT IS BEING OPERATED UPON. * 16200013 * IF THE SOURCE CODE IS INVALID, THE ROUTINE SETS BIT 6 * 16800013 * (INVALID SOURCE CODE) OF THE ERROR HALFWORD FOR THE LINE TO 1. * 17400013 * CONTROL RETURNS TO THE NEXT LPS INSTRUCTION. * 18000013 * * 18600013 *ENTRY POINTS- * 19200013 * IECKSRCE - EXPANSION OF SOURCE MACRO-INSTRUCTION GENERATES A * 19800013 * BALR TO THIS POINT, USING REGISTER 15 AS THE BRANCH * 20400013 * ADDRESS REGISTER AND REGISTER 14 AS THE RETURN * 21000013 * ADDRESS REGISTER. * 21600013 * * 22200013 *INPUT- * 22800013 * REGISTER 4- ADDRESS OF THE LCB * 23400013 * REGISTER 6- BUFFER ADDRESS * 24000013 * REGISTER 7- BASE REGISTER FOR THIS LPS. * 24600013 * REGISTER 8- TERMINAL TABLE SOURCE ENTRY * 25200013 * REGISTER 14- RETURN ADDRESS * 25800013 * REGISTER 14 ALSO POINTS TO A PARAMETER, A HALFWORD CONTAINING * 26400013 * A SOURCE CODE FIELD-LENGTH INDICATOR. * 27000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 27600013 * * 28200013 *OUTPUT- * 28800013 * THE RELATIVE ADDRESS OF THE SOURCE CODE FIELD WILL BE PLACED IN * 29400013 * THE TTSKEY FIELD OF THE HEADER PREFIX. * 30000013 * * 30600013 *EXTERNAL ROUTINES- * 31200013 * IECKSCAN - TO OBTAIN SOURCE CODE FROM HEADER. * 31800013 * * 32400013 *EXITS- * 33000013 * NORMAL- RETURN IS BY A BRANCH ON REGISTER 14 TO THE NEXT LPS * 33600013 * INSTRUCTION. * 34200013 * ERROR- NONE. * 34800013 * * 35400013 *TABLES/WORK AREAS- * 36000013 * NONE. * 36600013 * * 37200013 *ATTRIBUTES- * 37800013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 38400013 * * 39000013 *NOTES- * 39600013 * REGISTER 1- LOADED WITH THE ADDRESS OF TERMTBL BY THIS ROUTINE * 40200013 * REGISTER 2- POINTER TO COPY OF HEADER SOURCE CODE FIELD IN * 40800013 * IECKSCAN ROUTINE. * 41400013 * REGISTER 3- CONTAINS RETURN ADDRESS FOR IECKSCAN. * 42000013 * REGISTERS 9, 10, AND 12 ARE WORK REGISTERS. * 42600013 * * 43200013 *********************************************************************** 43800013 IECKSRCE START 44400013 *3170630000-636000 000A 44700000 *1201772000-7728000 22437 44800000 * 642000 A29210 44900000 DREG1 EQU 1 45000013 KREG EQU 2 45600013 RREG2 EQU 3 46200013 LCBREG EQU 4 46800013 MSREG EQU 6 47400013 LGREG EQU 7 48000013 TCREG EQU 8 48600013 WREG1 EQU 9 49200013 WREG2 EQU 10 49800013 IREG EQU 12 50400013 RREG1 EQU 14 51000013 SREG EQU 15 51600013 DEBUCBAD EQU 32 52200013 DCBDEBAD EQU 44 52800013 QCBDCBPT EQU 17 000A 53200000 USING IECKPREF,MSREG 53400013 USING IECKTERM,WREG2 54000013 USING IECKLCB0,LCBREG 54600013 L SREG,4(0,LGREG) GET SCAN ADDR 55200013 BALR RREG2,SREG LINKAGE TO SCAN SUBR 55800013 USING *,RREG2 56400013 * 57000013 * 59400013 SR WREG2,WREG2 60000013 IC WREG2,LCBUCBX GET RELATIVE LINE NUMBER-1 60600013 SLL WREG2,2 MULTIPLY BY FOUR AND SAVE 61200013 L WREG1,LCBDCBPT GET DCB ADDRESS 61800013 L WREG1,DCBDEBAD(WREG1) GET DEB ADDRESS 62400013 AR WREG1,WREG2 BUMP TO APPROPRIATE UCB ADDRESS 000A 63000000 L WREG1,DEBUCBAD(WREG1) GET ADDRESS OF UCB 000A 63600000 TM 17(WREG1),X'90' IS THIS A DIAL LINE A29210 64200000 BZ *+8 BRANCH IF NO 64800013 L TCREG,=V(TERMTBL) SET TCREG TO BEGINNING OF TERMTBL 65400013 * 66000013 L DREG1,=V(TERMTBL) 66600013 SR WREG1,WREG1 CLEAR REG 67200013 IC WREG1,4(0,DREG1) GET MAX SIZE OF TERM NAME 67800013 BCTR WREG1,0 ADJUST COUNT 68400013 LA WREG2,0(0,TCREG) STORE TCREG 69000013 LA IREG,8 CLEAR INCR REG 69600013 CLR WREG2,DREG1 IS MSG FROM A DIAL LINE 70200000 BE DIALUP IF YES,BRANCH 70800013 EX WREG1,TERMCK EXECT TST FOR VALID SOURCE TERM 71400013 BE 2(0,RREG1) AND RETURN 72000013 SOURCERR OI LCBERRST,X'02' IF YES,SET SOURCE ERROR BIT 72600013 B 2(0,RREG1) AND RETURN 73200013 COMPAR2 CL WREG2,0(0,DREG1) ELSE TEST FOR END OF TABLE 73800013 BC 8,SOURCERR IF EOT GO SET ERROR 74400013 DIALUP AR WREG2,IREG INDEX NEXT ENTRY 75000013 IC IREG,TNTRYSZE GET ENTRY SIZE 75600013 EX WREG1,TERMCK EXECT TST FOR TERM ENTRY 76200013 BNE COMPAR2 GO TEST NEXT ENTRY 76800013 L WREG1,TQCBADDR-1 LOAD ADDRESS OF TERMINAL'S QCB 000A 76880000 CLC LCBDCBPT+1(3),QCBDCBPT(WREG1) COMPARE 000A 76960000 * THE DCB FIELDS IN THE LCB AND QCB 000A 77040000 BNE SOURCERR BRANCH IF NOT IN SAME LINE GROUP 000A 77120000 LR TCREG,WREG2 PUT SOURCE ENTRY INTO TC REG 77400013 SR WREG2,DREG1 GET RELATIVE ADDR OF SOURCE ENTRY 78000013 STH WREG2,TTSKEY STORE IN HEADER PREFIX 78600013 STH WREG2,LCBTTIND SET REL TERM TBL ADDR OF TERM IN LCB 79200013 B 2(0,RREG1) RETURN 79800013 SPACE 80400013 TERMCK CLC TERMID(1),0(KREG) COMPARE TERMID TO HEADER SOURCE FLD 81000013 EJECT 81600013 PREFIXD 82200013 EJECT 82800013 TERMTBLD 83400013 EJECT 84000013 LCBD 84600013 END 85200013 ./ ADD SSI=02011201,NAME=IECKS260,SOURCE=0 *********************************************************************** 03000013 * * 06000013 * IECKS260 QTAM TRANSLATE TABLE * 09000013 * THIS TRANSLATE TABLE USED TO TRANSLATE MESSAGE SEGMENTS * 12000013 * FROM EBCDIC TO 2260 TRANSMISSION CODE. APPLICABLE FOR IBM * 15000013 * 2260 ON A NONSWITCHED NETWORK. * 18000013 * * 21000013 *********************************************************************** 24000013 IECKS260 START 27000013 *1170330000 00PS 28000018 *1201330000 21848 29000018 * 0 1 2 3 4 5 6 7 8 9 A B C D E F 30000013 DC X'5A5A02035A5A5A5A5A5ABD5A5A0A5A5A' 0 21848 33000018 DC X'5A5A5A5A5A0A5A5A5A5A425A5A5A5A5A' 1 36000013 DC X'5A5A5A5A5A5A035A5A5A5A5A5A5A065A' 2 39000013 DC X'5A5A5A5A5A5A5A045A5A5A5A5A155A5A' 3 42000013 DC X'405A5A5A5A5A5A5A5A5A5A4E5C484BFE' 4 45000013 DC X'465A5A5A5A5A5A5A5A5A5A444A495BFC' 5 48000013 DC X'4D4F5A5A5A5A5A5A5A5A414C45BF5E5F' 6 51000013 DC X'5A5A5A5A5A5A5A5A5A5A5A43E0475D5A' 7 54000013 DC X'5AA1A2A3A4A5A6A7A8A95A5A5A5A5A5A' 8 57000013 DC X'5AAAABACADAEAFB0B1B25A5A5A5A5A5A' 9 60000013 DC X'5A5AB3B4B5B6B7B8B9BA5A5A5A5A5A5A' A 63000013 DC X'5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A' B 66000013 DC X'5AA1A2A3A4A5A6A7A8A95A5A5A5A5A5A' C 69000013 DC X'5AAAABACADAEAFB0B1B25A5A5A5A5A5A' D 72000013 DC X'5A5AB3B4B5B6B7B8B9BA5A5A5A5A5A5A' E 75000013 DC X'505152535455565758595A5A5A5A5A5A' F 78000013 END 81000013 ./ ADD SSI=03012331,NAME=IECKTIME,SOURCE=0 TITLE 'IECKTIME QTAM TIMESTAMP (TIMESTMP)' 00900013 *********************************************************************** 01800013 * * 02700013 *NAME- * 03600013 * IECKTIME QTAM TIME STAMP (TIMESTMP) * 04500013 *STATUS- CHANGE LEVEL 001 OS QTAM II * 05400013 * * 06300013 * * 07200013 *FUNCTION- * 08100013 * OBTAINS THE CURRENT TIME IN PACKED DECIMAL FORMAT (VIA A * 09000013 * TIME MACRO), UNPACKS IT, AND INSERTS A SPECIFIED PORTION OF THE * 09900013 * TIME INFORMATION IN THE MESSAGE HEADER. THE TIME IS INSERTED IN * 10800013 * A FIELD CREATED BY THE EXPAND ROUTINE. THE MAXIMUM FIELD SIZE * 11700013 * IS NINE CHARACTERS IN THE FORMAT BHH.MM.SS, WHERE B=BLANK, * 12600013 * HH=HOURS, MM=MINUTES, AND SS=SECONDS. THE SCAN POINTER WILL * 13500013 * POINT TO THE LAST CHARACTER IN THE TIME. LESSER FIELD SIZES * 14400013 * HAVE A SIMILAR FORMAT, TRUNCATED FROM THE RIGHT. * 15300013 * * 16200013 *ENTRY POINTS- * 17100013 * IECKTIME - EXPANSION OF THE TIMESTMP MACRO GENERATES A BALR TO * 18000013 * THIS LOCATION, USING REGISTER 15 AS THE BRANCH ADDRESS * 18900013 * REGISTER AND REGISTER 14 AS THE RETURN ADDRESS REGISTER. * 19800013 * * 20700013 *INPUT- * 21600013 * REGISTER 14- * 22500013 * REGISTER 14 SERVES AS A PARAMETER REGISTER FOR IECKEXPD. THE* 23400013 * PARAMETER LIST PASSED CONSISTS OF ONE ITEM- A HALFWORD * 24300013 * CONTAINING, IN BINARY, THE LENGTH OF THE TIME INFORMATION * 25200013 * FIELD TO BE INSERTED INTO THE MESSAGE HEADER. * 26100013 * REGISTER 15- ENTRY POINT REGISTER FOR EXPAND SUBROUTINE. * 27000013 * * 27900013 *OUTPUT- * 28800013 * THE TIME WILL BE INSERTED INTO THE HEADER IF THERE IS ENOUGH SPACE* 29700013 * * 30600013 *EXTERNAL ROUTINES- * 31500013 * IECKEXPD - TO EXPAND THE HEADER TO ALLOW FOR INSERTION OF TIME * 32400013 * DATA. * 33300013 * * 34200013 *EXITS- * 35100013 * NORMAL- RETURN IS TO THE NEXT LPS INSTRUCTION BY BRANCHING ON THE * 36000013 * CONTENTS OF REGISTER 3 PAST THE MACRO GENERATED CONSTANT. * 36900013 * ERROR- NONE. * 37800013 * * 38700013 *TABLES/WORK AREAS- * 39600013 * TIMEWORD - TIME RETURNED FROM SUPERVISOR IS STORED HERE FOR USE * 40500013 * BY UNPK INSTRUCTION. * 41400013 * * 42300013 *ATTRIBUTES- * 43200013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 44100013 * * 45000013 *NOTES- * 45900013 * REGISTER 0- USED AS WORK REGISTER. WILL CONTAIN TIME RETURNED * 46800013 * FROM SUPERVISOR BY TIME MACRO. * 47700013 * REGISTER 2- BASE REGISTER. * 48600013 * REGISTER 3- RETURN ADDRESS FROM EXPAND SUBROUTINE AND TO THE * 49500013 * NEXT LPS INSTRUCTION. * 50400013 * REGISTER 9- WORK REGISTER. * 51300013 * REGISTER 10- CONTAINS BEGINNING OF FIELD INSERTED ON RETURN FROM * 52200013 * IECKEXPD. CONTAINS END OF FIELD INSERTED ON RETURN TO LPS. * 53100013 * REGISTER 12- USED AS WORK REGISTER. * 54000013 * * 54900013 *********************************************************************** 55800013 IECKTIME START 56700013 DREG0 EQU 0 57600013 TMREG EQU 0 58500013 TREG EQU 2 59400013 RREG2 EQU 3 60300013 WREG1 EQU 9 61200013 WREG2 EQU 10 62100013 IREG EQU 12 63000013 RREG1 EQU 14 63900013 SREG EQU 15 64800013 BALR TREG,0 65700013 USING *,TREG 66600013 L SREG,=V(IECKEXPD) 67500013 BALR RREG2,SREG LINK TO EXPAND SUBR 68400013 LR RREG2,RREG1 SAVE RETURN REG 69300013 TIME DEC OBTAIN TIME AND DATE FROM SUPERVISOR 70200013 ST TMREG,TIMEWORD PUT TIME INTO WORKWORD HHMMSSTH 71100013 UNPK TIMEWORD(9),TIMEWORD(5) UNPACK TIME DATA 72000013 LA IREG,TIMEWORD GET WORKWORD ADDR 72900013 SPACER LH DREG0,TWO SPEC NUM OF CHARS BETWEEN PERIODS 73800013 EDIT MVC 1(1,WREG2),0(IREG) MOVE FIRST(NXT) BYTE TO TIME FLD 74700013 LA WREG2,1(0,WREG2) INCR TIME FIELD POINTER 75600013 LA IREG,1(0,IREG) INCR WORKWORD POINTER 76500013 BCT WREG1,*+8 IF NOT END OF FIELD,CONTINUE 77400013 B 2(0,RREG2) RETURN 78300013 BCT DREG0,EDIT TEST FOR PERIOD INSERTION 79200013 MVI 1(WREG2),X'4B' INSERT PERIOD INTO TIME 80100013 LA WREG2,1(0,WREG2) INCR TIME FIELD POINTER 81000013 BCT WREG1,SPACER IF NOT END OF FIELD,CONTINUE 81900013 B 2(0,RREG2) RETURN 82800013 SPACE 83700013 TIMEWORD DS 1D 84600013 DS 1H 85500013 TWO DC X'0002' CONSTANT 86400013 TIME DC X'21452233' STORED TIME OF DAY 87300013 DS 0F 88200013 END 89100013 ./ ADD SSI=02010760,NAME=IECKTRNS,SOURCE=0 TITLE 'IECKTRNS QTAM TRANSLATE (TRANS)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKTRNS QTAM TRANSLATE (TRANS) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THIS ROUTINE TRANSLATES MESSAGE SEGMENTS FROM ONE CODE TO * 10000013 * ANOTHER. THE NUMBER OF CHARACTERS TRANSLATED IS COMPUTED BY * 11000013 * SUBTRACTING THE ADDRESS OF THE FIRST BYTE TO BE TRANSLATED * 12000013 * FROM THE ADDRESS OF THE END OF THE SEGMENT. * 13000013 * * 14000013 *ENTRY POINTS- * 15000013 * IECKTRNS - EXPANSION OF THE TRANS MACRO GENERATES A BALR TO THIS * 16000013 * POINT, USING REGISTER 15 AS THE BRANCH ADDRESS REGISTER, AND * 17000013 * REGISTER 14 AS THE RETURN ADDRESS REGISTER. * 18000013 * * 19000013 *INPUT- * 20000013 * REGISTER 1- CONTAINS THE ADDRESS OF THE TRANSLATION CODE TABLE * 21000013 * NAMED IN THE OPERAND OF THE MACRO. * 22000013 * REGISTER 4- ADDRESS OF THE LCB * 23000013 * REGISTER 6- ADDRESS OF MESSAGE BUFFER. * 24000013 * REGISTER 11- POINTER TO LAST BYTE IN SEGMENT * 25000013 * REGISTER 14- RETURN ADDRESS * 26000013 * REGISTER 15- ADDRESS OF THIS ROUTINE * 27000013 * * 28000013 *OUTPUT- * 29000013 * THE SPECIFIED CHARACTERS WILL BE TRANSLATED TO THE SPECIFIED CODE.* 30000013 * * 31000013 *EXTERNAL ROUTINES- * 32000013 * NONE. * 33000013 * * 34000013 *EXITS- * 35000013 * NORMAL- RETURN IS TO THE NEXT LPS INSTRUCTION BY BRANCHING ON * 36000013 * REGISTER 14. * 37000013 * ERROR- IF NO CHARACTERS ARE TO BE TRANSLATED, RETURN IS TO THE * 38000013 * NEXT LPS INSTRUCTION WITH NO TRANSLATION TAKING PLACE. * 39000013 * * 40000013 *TABLES/WORK AREAS- * 41000013 * NONE. * 42000013 * * 43000013 *ATTRIBUTES- * 44000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 45000013 * * 46000013 *NOTES- * 47000013 * REGISTER 9- WORK REGISTER. * 48000013 * REGISTER 10- WORK REGISTER. * 49000013 * REGISTER 12- USED AS WORK REGISTER. USED TO CALCULATE THE * 50000013 * ADDRESS OF THE FIRST BYTE TO BE TRANSLATED. CONTAINS * 51000013 * RELATIVE ADDRESS OF BYTE WITH RESPECT TO BEGINNING OF * 52000013 * THE BUFFER. * 53000013 * * 54000013 *********************************************************************** 55000013 IECKTRNS START 56000013 DREG1 EQU 1 57000013 LCBREG EQU 4 58000013 MSREG EQU 6 59000013 WREG1 EQU 9 60000013 WREG2 EQU 10 61000013 EOSREG EQU 11 62000013 IREG EQU 12 63000013 RREG1 EQU 14 64000013 SREG EQU 15 65000013 USING *,SREG 66000013 USING IECKLCB0,LCBREG 67000013 USING IECKPREF,MSREG 68000013 LH IREG,LCBTRST GET REL ADDR OF FIRST CHAR TO TRANS 69000013 TM MSTATUS,X'01' TEST FOR TEXT SEGMENT 70000013 BC 8,USETRST IF HEADER,IREG IS SET OK 71000013 TM MSTATUS,X'20' IS EOB BIT ON 72000013 BC 1,USETRST IF YES,IREG IS SET OK 73000013 LA IREG,TXSTRT-MSEGSZE GET REL ADDR OF FIRST CHAR TO TRANS 74000013 USETRST LA WREG2,8(MSREG,IREG) GET ADDR OF FIRST BYTE TO TRANS 75000013 LR WREG1,EOSREG GET ENDOF SEGMENT 76000013 SR WREG1,WREG2 SUBTRACT START TO GET COUNT 77000013 BCR 4,RREG1 EXIT IF NO CHARACTERS 78000013 EX WREG1,CONV EXECUTE TRANSLATE 79000013 BR RREG1 RETURN TO LPS 80000013 SPACE 81000013 CONV TR 0(1,WREG2),0(DREG1) 82000013 EJECT 83000013 LCBD 84000013 EJECT 85000013 PREFIXD 86000013 END 87000013 ./ ADD SSI=03011060,NAME=IECKTYPE,SOURCE=0 TITLE 'IECKTYPE QTAM MESSAGE TYPE (MSGTYPE)' 01000013 *********************************************************************** 02000013 * * 03000013 *NAME- * 04000013 * IECKTYPE QTAM MESSAGE TYPE (MSGTYPE) * 05000013 * * 06000013 *STATUS- CHANGE LEVEL 000 OS QTAM I * 07000013 * * 08000013 *FUNCTION- * 09000013 * THIS ROUTINE LINKS TO THE SCAN ROUTINE TO LOCATE THE NEXT * 10000013 * FIELD IN THE MESSAGE HEADER. THIS CHARACTER IS COMPARED WITH THE * 11000013 * CHARACTER GIVEN AS THE OPERAND OF THE MSGTYPE MACRO-INSTRUCTION. * 12000013 * IF THE TWO CHARACTERS ARE IDENTICAL, THE INSTRUCTIONS BETWEEN THIS* 13000013 * MSGTYPE MACRO AND THE NEXT MSGTYPE MACRO OR THE NEXT DELIMITER * 14000013 * MACRO INSTRUCTION ARE EXECUTED. * 15000013 * IF THE TWO CHARACTERS ARE NOT IDENTICAL, THE INSTRUCTIONS * 16000013 * BETWEEN THE MSGTYPE MACRO PERFORMING THE TEST AND THE NEXT * 17000013 * MSGTYPE MACRO OR DELIMITER ARE NOT EXECUTED. THE SCAN POINTER IS * 18000013 * RESET TO ITS POSITION PRIOR TO THE COMPARISON. IN THIS INSTANCE, * 19000013 * CONTROL PASSES TO THE NEXT MSGTYPE OR DELIMITER MACRO. * 20000013 * * 21000013 *ENTRY POINTS- * 22000013 * IECKTYPE - EXPANSION OF MSGTYPE MACRO GENERATES A BALR TO THIS * 23000013 * POINT. REGISTER 15 IS THE ENTRY POINT REGISTER, AND * 24000013 * REGISTER 14 IS THE RETURN ADDRESS REGISTER. * 25000013 * * 26000013 *INPUT- * 27000013 * REGISTER 1- CONTAINS ADDRESS OF NEXT MSGTYPE INSTRUCTION. * 28000013 * REGISTER 14- RETURN ADDRESS * 29000013 * REGISTER 14 ALSO POINTS TO A PARAMETER LIST CONSISTING OF * 30000013 * 1) A HALFWORD BINARY 1, INDICATING SINGLE BYTE LENGTH,AND * 31000013 * 2) THE CHARACTER SPECIFIED IN THE MACRO STATEMENT. * 32000013 * REGISTER 15- ENTRY POINT. * 33000013 * * 34000013 *OUTPUT- * 35000013 * NONE. * 36000013 * * 37000013 *EXTERNAL ROUTINES- * 38000013 * IECKSCAN - TO LOCATE NEXT FIELD IN THE MESSAGE HEADER. * 39000013 * * 40000013 *EXITS- * 41000013 * NORMAL- IDENTICAL CHARACTERS - BRANCH ON REGISTER 14 TO NEXT LPS * 42000013 * INSTRUCTION. * 43000013 * NON-IDENTICAL CHARACTERS - BRANCH ON REGISTER 1 TO NEXT * 44000013 * MSGTYPE MACRO OR DELIMITER. * 45000013 * ERROR- NONE. * 46000013 * * 47000013 *TABLES/WORK AREAS- * 48000013 * NONE. * 49000013 * * 50000013 *ATTRIBUTES- * 51000013 * SERIALLY REUSABLE, ENABLED, RESIDENT, PROBLEM PROGRAM MODE. * 52000013 * * 53000013 *NOTES- * 54000013 * REGISTER 0- USED AS WORK REGISTER TO SAVE SCAN POINTER. * 55000013 * REGISTER 2- USED AS WORK REGISTER. WILL CONTAIN ADDRESS OF NEXT * 56000013 * NON-BLANK CHARACTER AS RETURNED BY SCAN. * 57000013 * REGISTER 3- RETURN REGISTER FROM SCAN SUBROUTINE. * 58000013 * REGISTER 15- ADDRESS OF THIS ROUTINE AND OF SCAN ROUTINE. * 59000013 * * 60000013 *********************************************************************** 61000013 IECKTYPE START 62000013 *3170702000-780000 00PS 62500015 DREG0 EQU 0 63000013 DREG1 EQU 1 64000013 KREG EQU 2 65000013 RREG2 EQU 3 66000013 SPREG EQU 5 67000013 LGREG EQU 7 68000013 RREG1 EQU 14 69000013 SREG EQU 15 70000013 R9 EQU 9 00PS 70200015 TWOREG EQU 10 00PS 70400015 WREG EQU 12 00PS 70600015 * 00PS 70800015 * SCAN OFF CHARACTERS INTO WORK AREA, REGISTER 14 POINTS TO FIELD 00PS 71000015 * SIZE 00PS 71200015 LR DREG0,SPREG SAVE SCAN POINTER 00PS 71400015 L SREG,4(LGREG) GET SCAN ROUTINE ADDRESS 00PS 71600015 BALR RREG2,SREG LINK TO SCAN ROUTINE 00PS 71800015 * 00PS 72000015 * COMPUTE RETURN ADDRESS FOR EQUAL COMPARE 00PS 72200015 * 00PS 72400015 LH RREG2,0(RREG1) GET FIELD SIZE 00PS 72600015 LR R9,RREG2 SAVE FIELD SIZE FOR COMPARE 00PS 72800015 LA RREG2,1(RREG2) INCREMENT FIELD SIZE BY ONE 00PS 73000015 SRL RREG2,1 DIVIDE BY 2 00PS 73200015 SLL RREG2,1 MULTIPLY BY 2 00PS 73400015 LA RREG2,2(RREG1,RREG2) ADD RETURN ADDRESS PLUS TWO 00PS 73600015 * 00PS 73800015 * COMPARE MESSAGE TYPE CHARACTERS AND RETURN 00PS 74000015 * 00PS 74200015 BALR WREG,0 00PS 74400015 USING *,WREG 00PS 74600015 BCTR R9,0 SUBTRACT ONE FOR COMPARE 00PS 74800015 EX R9,CMPR WERE MESSAGE CHARACTERS FOUND 00PS 75000015 BCR 8,RREG2 IF YES RETURN TO NEXT INSTRUCTION00PS 75200015 LR SPREG,DREG0 ELSE RESTORE SCAN POINTER 00PS 75400015 BR DREG1 AND GO TO NEXT MSGTYPE INSTRUCTION00PS 75600015 CMPR CLC 2(1,RREG1),0(KREG) 00PS 75800015 END 78000013 ./ ADD SSI=01012301,NAME=IGC0007G,SOURCE=0 TITLE 'IGC0007G-TERMINAL TEST HEADER ANALYSIS.' 00200013 * 00400013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00600013 * 00800013 * 01000013 * FUNCTIONS - PERFORM PRELIMINARY VALIDATION OF THE TEST REQUEST, 01200013 * TRANSLATE THE INPUT MESSAGE AS NECESSARY, AND 01400013 * SET UP TERMINAL ADDRESSING CHARACTERS. 01600013 * 01800013 * 02000013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM THE RESIDENT 02200013 * TERMINAL TEST MODULE (IECKONLT) 02400013 * 02600013 * 02800013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 03000013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 03200013 * REGISTER 14 - RETURN ADDRESS 03400013 * REGISTER 15 - ADDRESS OF UCB IF DIAL LINE 03600013 * 03800013 * 04000013 * OUTPUT - 1. TRANSLATED INPUT MESSAGE 04200013 * 2. TERMINAL ADDRESSING CHARATERS IN BUFFER PREFIX 04400013 * 3. LCB POINTER IN BUFFER PREFIX 04600013 * 4. UCB POINTER IN BUFFER PREFIX 04800013 * 05000013 * 05200013 * EXTERNAL ROUTINES- NONE 05400013 * 05600013 * 05800013 * EXITS - 1. TO THE APPROPRIATE DEVICE DEPENDENT MODULE IF 06000013 * THE TEST REQUEST IS VALID. 06200013 * 2. TO THE ADDRESS IN REGISTER 14 IF THE TEST 06400013 * REQUEST IS INVALID. 06600013 * 06800013 * 07000013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND ANY TRANSLATION 07200013 * NECESSARY IS PERFORMED. IF THE REQUEST IS IN 07400013 * FORMAT ONE, THE TERMINAL TABLE IS SEARCHED AND 07600013 * THE TERMINAL ADDRESSING CHARACTERS ARE PLACED 07800013 * IN THE BUFFER PREFIX. THE LCB AND UCB ADDRESSES 08000013 * ARE PLACED IN THE BUFFER PREFIX FOR ALL REQUESTS. 08200013 * PRELIMINARY VALIDATION OF THE TEST REQUEST IS 08400013 * PERFORMED. A SUBROUTINE -- 08600013 * A. TRANSLATES THE INPUT MESSAGE TO THE 08800013 * DESTINATION LINE CODE. 09000013 * B. TRANSLATES SYMBOLIC ADDRESSING CHARACTERS 09200013 * TO EBCDIC. 09400013 * 09600013 * 09800013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 10000013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 10200013 * REENTRANT. 10400013 * 10600013 EJECT 10800013 IGC0007G CSECT 11000013 *90351405000-413000 00PS 11100018 * 144000,154000,205200,226000,367000,368800-371200,373000-374000, 23154 11130018 * 380000,434000-444000 23154 11160018 * 11200013 * 11400013 * 11600013 BALR BASEREG,0 11800013 USING *,BASEREG 12000013 USING PARAMLST,PARREG 12200013 USING ONLTBUF,BUFREG 12400013 * SET BASE REGISTERS 12600013 L BUFREG,ECBADDR ADDRESS OF INPUT BUFFER 12800013 LR IOREG,0 ADDRESS OF FIRST 9 13000013 * 13200013 MVI NOTEST,X'00' CLEAR THE NO TEST SWITCH 13400013 SR WORKREG,WORKREG CLEAR ADDRESS FIELDS IN BUFFER 13600013 STC WORKREG,CCWBYTES 13800013 ST WORKREG,AREA1030 14000013 * 14200013 LH LENGTH,CHARCNT COUNT OF CHARACTERS IN MESSAGE 23154 14400018 CLI 0(IOREG),X'20' TEST FOR 1030 ZERO INPUT 14600013 BNE *+8 BRANCH IF NOT 14800013 MVI 0(IOREG),X'15' CHANGE TO NORMAL ZERO 15000013 LA IOREG,1(IOREG) UP DATA POINTER 15200013 BCT LENGTH,*-16 LOOP ON CHARACTER COUNT 23154 15400018 LR IOREG,0 RESTORE DATA POINTER 15600013 * 15800013 TM ANSWTEST,X'01' TEST FOR ANSWER INDICATOR ON 16000013 BO UCBFOUND ONE MEANS ANSWER 16200013 CLI 5(IOREG),X'15' TEST FOR BCD FORMAT 0 16400013 BE CONTINUE 16600013 CLI 5(IOREG),X'50' TEST FOR ASCII FORMAT 0 16800013 BE CONTINUE 17000013 IC LENGTH,8(IOREG) PICK UP COUNT OF CHARS IN SYMB. 17400013 CLI 5(IOREG),X'51' TEST FOR ASCII FORMAT 1 17600013 BE ASCIIN 17800013 CLI 5(IOREG),X'02' TEST FOR BCD FORMAT 1 18000013 BNE COMP1030 LOOK FOR 1060 COMPARE 18200013 CLI 8(IOREG),X'15' TEST FOR NO SYMBOL 18400013 BE ZERO 18600013 LA FROMCODE,BCD TRANSLATE FROM BCD CODE 18800013 SRA LENGTH,1 SHIFT OUT PARITY BIT 19000013 BZ RESTART ZERO IS INVALID 19200013 CHECK8 CH LENGTH,=H'8' 19400013 BH RESTART OVER 8 CHARACTERS IN INVALID 19600013 LA TOCODE,EBCDIC TRANSLATE TO EBCDIC 19800013 LA FROMADDR,9(IOREG) ADDRESS OF FIRST CHAR TO XLATE 20000013 LA TOADDR,CVTAREA ADDRESS TO TRANSLATE IN 20200013 STC LENGTH,SAVLNGTH SAVE LENGTH 20400013 MVI CVTAREA,X'40' MOVE BLANKS INTO CONVERT AREA 23154 20460018 MVC CVTAREA+1(7),CVTAREA PROPAGATE BLANKS 23154 20520018 BAL LINKREG,CONVERT TRANSLATE SYMBOL TO EBCDIC 20600013 * SEARCH TERMINAL TABLE FOR THIS SYMBOL 20800013 L WORKREG,16 ADDR OF COMM VECTOR TABLE 21000013 L WORKREG,156(WORKREG) ADDRESS OF TERMINAL TABLE 21200013 LR TOLIST,WORKREG SAVE TERMINAL TABLE ADDRESS 21400013 CLC SAVLNGTH(1),4(WORKREG) CHECK THAT LENGTH IS NOT LONGER 21600013 BH RESTART THAN MAXIMUM IN TABLE 21800013 L WORKREG2,0(WORKREG) ADDRESS OF FINAL ENTRY 22000013 SR CLCINDEX,CLCINDEX CLEAR WORKING 22200013 SR ADDREG,ADDREG REGISTERS 22400013 IC CLCINDEX,4(WORKREG) MAX. LENGTH OF TERM NAME 23154 22600018 BCTR CLCINDEX,0 22800013 LA WORKREG,8(WORKREG) UP TABLE POINTER 23000013 * BEGIN COMPARE LOOP 23200013 NEXTID EX CLCINDEX,EXCLC IS THIS THE ID 23400013 BE IDFOUND BRANCH IF YES 23600013 CR WORKREG,WORKREG2 ARE WE AT END OF TABLE 23800013 BE RESTART BRANCH IF YES 24000013 IC ADDREG,0(WORKREG) SIZE OF THIS ENTRY 24200013 AR WORKREG,ADDREG COMPUTE ADDRESS OF NEXT ENTRY 24400013 B NEXTID 24600013 * 24800013 IDFOUND L QCBREG,0(WORKREG) ADDRESS OF QCB 25000013 SR MULTODD,MULTODD CLEAR MULTIPLY 25200013 SR MULTEVEN,MULTEVEN REGISTERS 25400013 IC MULTODD,16(QCBREG) RELATIVE LINE NUMBER 25600013 L WORKREG2,16(QCBREG) ADDRESS OF DCB 25800013 IC MULTEVEN,36(WORKREG2) SIZE OF LCB 26000013 MR MULTEVEN,MULTEVEN COMPUTE DISPLACEMENT 26200013 A MULTODD,32(WORKREG2) ADDRESS OF LCB 26400013 IC LINKREG,SAVE 26600013 ST MULTODD,LCBADDR PUT IN BUFFER AREA 26800013 STC LINKREG,SAVE 27000013 TESTOPEN EQU * 27100018 TM 48(WORKREG2),X'10' TEST FOR DCB OPEN 27200013 BZ RESTART ZERO MEANS DCB NOT OPEN 27400013 * MOVE DEVICE TYPE AND FEATURES TO BUFFER 27600013 L DEBREG,44(WORKREG2) DEB ADDRESS 27800013 SR UCBREG,UCBREG CLEAR WORKING REGISTER 28000013 IC UCBREG,16(QCBREG) RELATIVE LINE NUMBER 28200013 BCTR UCBREG,0 ADJUST OFFSET 28400013 SLL UCBREG,2 MULTIPLY BY 4 28600013 L UCBREG,32(UCBREG,DEBREG) UCB ADDRESS 28800013 UCBFOUND ST UCBREG,UCBADDR 29000013 MVC DEVICETP(1),16(UCBREG) MOVE MODEL CODE 29200013 NI DEVICETP,X'0F' 29400013 SR TESTREG,TESTREG CLEAR WORKING REGISTER 29600013 IC TESTREG,DEVICETP 29800013 MVC DEVICETP(1),19(UCBREG) ADAPTER TYPE 30000013 NI DEVICETP,X'F0' 30200013 EX TESTREG,EXOI COMBINE ADAPTER AND MODEL 30400013 MVC FEATURES(1),17(UCBREG) PUT IN FEATURES CODE 30600013 * 30800013 SR ADDREG,ADDREG CLEAR THE WORKING REGISTER 31000013 IC ADDREG,4(TOLIST) INSERT LENGTH OF TERM. NAME 31200013 SR TOLIST,TOLIST CLEAR REGISTER 31400013 IC TOLIST,9(ADDREG,WORKREG) OFFSET TO ADDRESSING CHARACTER 31600013 AR WORKREG,TOLIST POINT TO ADDRESSING CHARACTER 31800013 TM FEATURES,X'90' TEST FOR DIAL 32000013 BZ NODIAL 32200013 LA WORKREG,0(WORKREG) 32400013 ST WORKREG,DIALINFO PUT DIAL INFORMATION IN BUFFER 32600013 IC ADDREG,0(WORKREG) 32800013 LA WORKREG,1(ADDREG,WORKREG) BUMP ADDRESS PAST DIAL 33000013 NODIAL MVC ADDRESS(2),0(WORKREG) MOVE ADDRESSING CHARACTERS 33200013 SPACE 3 33400013 * 33600013 * DETERMINE FROM AND TO TYPES, TRANSLATE IF NECESSARY AND GO TO 33800013 * APPROPRIATE DEVICE DEPENDENT ROUTINE. 34000013 * 34200013 LR 15,PARREG SET ADDRESS FOR XCTL 34400013 SH 15,=H'16' 34600013 MVI DISPLACE,X'00' CLEAR PATTERN OFFSET 34800013 MVI BYTE1030,X'00' INSURE THIS BYTE IS ZERO 35000013 CLI 7(IOREG),X'56' TEST IF FROM AND TO A 2260 35200013 BE ROUT2260 35400013 CLI 7(IOREG),X'0D' TEST IF FROM A BCD TERMINAL AND 35600013 BE BCD2260 TO A 2260 35800013 TM 7(IOREG),X'50' TEST IF FROM A 2260 AND TO A 36000013 BO ASCIIBCD BCD TERMINAL 36200013 TEST2740 CLI 7(IOREG),X'08' TEST IF TO A 2740 36400013 BE TO2740 36600013 MVC 8(8,15),NAME1030 MOVE IN 1030 NAME FOR XCTL 23154 36700018 CLI 7(IOREG),X'02' TEST IF TO A 1030 36800013 BE CALL2260 YES, DO XCTL 23154 36880018 CLI 7(IOREG),X'0B' TEST IF TO A 1030 23154 36960018 BE CALL2260 YES, DO XCTL 23154 37040018 MVC 8(8,15),NAME1050 MOVE IN 1050 NAME FOR XCTL 23154 37120018 CLI 7(IOREG),X'04' TEST IF TO A 1050 37200013 BE CALL2260 YES, DO XCTL 23154 37300018 MVC 8(8,15),NAME1060 MOVE IN 1060 NAME FOR XCTL 23154 37400018 CLI 7(IOREG),X'07' TEST IF TO A 1060 37600013 BE CALL2260 YES, DO XCTL 23154 38000018 * 38400013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 38600013 MVI DISPLACE,X'00' 38800013 MVI BYTE1030,X'00' CLEAR 1030 BYTE COUNT 39000013 BR RETURN RETURN 39200013 * 39400013 ASCIIN LA FROMCODE,ASCII TRANSLATE FROM ASCII CODE 39600013 N LENGTH,=F'15' CLEAR HIGH BITS 39800013 BNZ CHECK8 40000013 ZERO EQU * 40200013 CONTINUE EQU * 40400013 L TOLIST,16 GET CVT ADDRESS 00PS 40500018 L TOLIST,156(TOLIST) GET TERMTAB ADDRESS 00PS 40600018 LH WORKREG,OFFSET GET TERM OFFSET FROM BUFFER00PS 40700018 LTR WORKREG,WORKREG TEST TO SEE IF OFFSET 0 00PS 40800018 LA WORKREG,0(WORKREG,TOLIST) ADD OFFSET TO TERMTAB AD00PS 40900018 BNZ IDFOUND BRANCH IF OFFSET IN BUFFER 00PS 41000018 L WORKREG,LCBADDR LOAD LCB ADDRESS 00PS 41100018 L WORKREG2,LCBDCBPT(WORKREG) GET DCB ADDRESS 00PS 41200018 B TESTOPEN 00PS 41300018 TO2740 EQU * 41600013 CLI DEVICETP,X'14' TEST FOR 2740 DEVICE TYPE 41800013 BNE RESTART BRANCH IF NOT 42000013 MVC 8(8,15),NAME2740 SET UP TRANSFER CONTROL 42200013 CLI 6(IOREG),X'15' BRANCH IF TEST CODE OF ZERO 42400013 BE RESTART 42600013 CLI 6(IOREG),X'0E' BRANCH IF TEST SELECTION IS 42800013 BH RESTART GREATER THAN 7 43000013 SVC 7 TRANSFER CONTROL 43200013 * 44600013 * 44800013 COMP1030 CLI 5(IOREG),X'0D' TEST FOR 6 IN FORMAT POSITION 45000013 BNE RESTART BRANCH IF NOT 45200013 CLI 7(IOREG),X'07' TEST IF TO A 1060 45400013 BNE RESTART BRANCH IF NOT 45600013 B CONTINUE 45800013 * 46000013 ASCIIBCD EQU * 46200013 LA FROMCODE,ASCII FROM ASCII CODE 46400013 LA TOCODE,BCD TO BCD CODE 46600013 BAL LINKREG,CONVTIPT CONVERT INPUT AREA 46800013 B TEST2740 CONTINUE PROCESSING FOR BCD 47000013 * TERMINAL 47200013 * 47400013 CONVTIPT LR FROMREG,IOREG ADDRESS OF INPUT DATA 47600013 LR TOREG,IOREG CONVERT IN INPUT AREA 47800013 LH LENGTH,CHARCNT GET LENGTH OF AREA TO TRANSLATE 48000013 B CONVERT 48200013 * 48400013 * 48600013 * 48800013 BCD2260 EQU * 49000013 LA FROMCODE,BCD FROM BCD CODE 49200013 LA TOCODE,ASCII TO ASCII CODE 49400013 BAL LINKREG,CONVTIPT CONVERT INPUT FOR 2260 49600013 ROUT2260 EQU * 49800013 MVC 8(8,15),NAME2260 SET MODULE NAME TO BE CALLED 50000013 CALL2260 SVC 7 TRANSFER CONTROL 50200013 EJECT 50400013 * 50600013 * SUBROUTINE TO CONVERT BETWEEN BCD-LINE, ASCII AND EBCDIC CODES 50800013 * 51000013 CONVERT DS 0H 51200013 LOOPA LR FROMLIST,FROMCODE SET-UP WORKING REGISTERS 51400013 LR TOLIST,TOCODE 51600013 LA LOOPCNT,(TABLEND-TABLE)/3 SET LOOP COUNT 51800013 LOOP CLC 0(1,FROMADDR),0(FROMLIST) IS THIS THE CHARACTER TO 52000013 BE FOUND BE TRANSLATED 52200013 LA FROMLIST,3(FROMLIST) NO--UP THE POINTERS TO TABLE 52400013 LA TOLIST,3(TOLIST) 52600013 BCT LOOPCNT,LOOP LOOP IF ANY TABLE LEFT 52800013 MVC 0(1,TOADDR),BLANK-TABLE(TOCODE) MOVE A BLANK INSTEAD 53000013 NEXTCHAR LA FROMADDR,1(FROMADDR) UP POINTERS TO DATA 53200013 LA TOADDR,1(TOADDR) 53400013 BCT LENGTH,LOOPA LOOP IN ANY MORE CHARACTERS 53600013 BR LINKREG RETURN 53800013 FOUND MVC 0(1,TOADDR),0(TOLIST) MOVE THE TRANSLATION INTO TO 54000013 B NEXTCHAR AREA AND GO TO GET NEXT CHAR. 54200013 * 54400013 * 54600013 TABLE EQU * 54800013 * 1 - - 2 - - 3 - - 4 - - 5 - - 6 - - 7 - - 1234567 55000013 DC X'1550F00251F10452F20753F30854F40B55F50D56F6' 0123456 55200013 DC X'0E57F71058F81359F962A1C164A2C267A3C368A4C4' 789ABCD 55400013 DC X'6BA5C56DA6C66EA7C770A8C873A9C943AAD145ABD2' EFGHIJK 55600013 DC X'46ACD349ADD44AAED54CAFD64FB0D751B1D852B2D9' LMNOPQR 55800013 DC X'25B3E226B4E329B5E42AB6E52CB7E62FB8E731B9E8' STUVWXY 56000013 DC X'32BAE9' Z 56200013 BLANK DC X'0140408140401F03379F03373B0326BD0326E2A1C1' A 56400013 DC X'E4A2C2E7A3C3E8A4C4EBA5C5EDA6C6EEA7C7F0A8C8' BCDEFGH 56600013 DC X'F3A9C9C3AAD1C5ABD2C6ACD3C9ADD4CAAED5CCAFD6' IJKLMNO 56800013 DC X'CFB0D7D1B1D8D2B2D9A5B3E2A6B4E3A9B5E4AAB6E5' PQRSTUV 57000013 DC X'ACB7E6AFB8E7B1B9E8B2BAE916437B234F61374C6B' WXYZ#/, 57200013 DC X'B74C6B3B0A25BB0A25404D6057445B5B0A15DB0A15' , -$ 57400013 DC X'614650764E4BF64E4BC0BF6D20E07C825D7E84BD4A' &.._@=› 57600013 DC X'874B5E884A7A8B456C8D477D904A5C93484D95495D' ;:%'*() 57800013 DC X'A35F6FE14B4E' ?+ 58000013 * 1 - - 2 - - 3 - - 4 - - 5 - - 6 - - 7 - - 1234567 58200013 TABLEND EQU * 58400013 * 58600013 BCD EQU TABLE 58800013 ASCII EQU TABLE+1 59000013 EBCDIC EQU TABLE+2 59200013 NAME1030 DC C'IGC0107G' 59400013 NAME1050 DC C'IGC0207G' 59600013 NAME1060 DC C'IGC0307G' 59800013 NAME2740 DC C'IGC0407G' 60000013 NAME2260 DC C'IGC0507G' 60200013 EXCLC CLC CVTAREA(1),9(WORKREG) 60400013 EXOI OI DEVICETP,X'00' 60600013 EJECT 60800013 * 61000013 * INPUT AREA DEFINITION 61200013 * 61400013 ONLTBUF DSECT 61600013 ECB DS 8C 61800013 CCWBYTES DS 0C COUNT OF CCW AREA 62000013 CCWAREA DS 4C ADDRESS OF CCW AREA 62200013 SAVE DS 0C 62400013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 62600013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 62800013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 63000013 CVTAREA DS 0C 63200013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 63400013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 63600013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 63800013 DEVICETP DS 1C DEVICE TYPE CODE 64000013 FEATURES DS 0C FEATURES CODE 64200013 RESPONSE DS 1C FOR RESPONSES 64400013 SAVLNGTH DS 0C 64600013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 64800013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 65000013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 65200013 UCBADDR DS 4C SAVE AREA FOR UCB ADDRESS 65400013 OFFSET EQU ONLTBUF+10 65600013 * 65800013 * PARAMETER LIST DEFINITION 66000013 * 66200013 PARAMLST DSECT 66400013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 66600013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 66800013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 67000013 NOTEST DS 1C NO TEST SWITCH 67200013 ANSWTEST DS 1C DIAL ANSWER INDICATOR 67400013 EJECT 67600013 * 67800013 * REGISTERS 68000013 * 68200013 PARREG EQU 1 68400013 TOCODE EQU 2 68600013 WORKREG EQU 2 68800013 FROMCODE EQU 3 69000013 WORKREG2 EQU 3 69200013 CLCINDEX EQU 4 69400013 MULTEVEN EQU 4 69600013 TOADDR EQU 4 69800013 TOREG EQU TOADDR 70000013 ADDREG EQU 5 70200013 FROMADDR EQU 5 70400013 FROMREG EQU FROMADDR 70600013 MULTODD EQU MULTEVEN+1 5 70800013 BASEREG EQU 6 71000013 IOREG EQU 7 FROM 0 71200013 BUFREG EQU 8 71400013 LENGTH EQU 9 71600013 QCBREG EQU 9 71800013 LOOPCNT EQU 10 72000013 TESTREG EQU 10 72200013 DEBREG EQU 11 72400013 FROMLIST EQU 11 72600013 TOLIST EQU 12 72800013 LINKREG EQU 13 73000013 RETURN EQU 14 73200013 UCBREG EQU 15 73400013 LCBDCBPT EQU X'44' 73500018 END 73600013 ./ ADD SSI=01010761,NAME=IGC0107G,SOURCE=0 TITLE 'IGC0107G-1030 TERMINAL TEST MODULE.' 00200013 * 00400013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00600013 * 00800013 * 01000013 * FUNCTION - GENERATE CHANNEL PROGRAM FOR 1030 ON LINE TESTS 01200013 * 01400013 * 01600013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM HEADER ANALYSIS 01800013 * MODULE 02000013 * 02200013 * 02400013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 02600013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 02800013 * REGISTER 14 - RETURN ADDRESS 03000013 * 03200013 * 03400013 * OUTPUT - 1. GENERATED CHANNEL PROGRAM 03600013 * 2. UPDATED USAGE COUNT AND POINTER IN RESIDENT 03800013 * TERMINAL TEST MODULE (IECKONLT). 04000013 * 04200013 * 04400013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 04600013 * 04800013 * 05000013 * EXIT - RETURN TO ADDRESS IN REGISTER 14 05200013 * 05400013 * 05600013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND THE HEADER IS 05800013 * VALIDATED. IT IS ANALYZED FOR TYPE OF REQUEST. 06000013 * CORE IS OBTAINED AND CCW'S FOR THE PROPER DATA AND 06200013 * CONTROL PURPOSES ARE FORMED IN THE AREA. IF THE 06400013 * REQUESTED DATA PATTERN IS NOT IN USE, CORE WILL BE 06600013 * OBTAINED AND THE PATTERN MOVED INTO THE NEW AREA. 06800013 * IF THE REQUEST IS FOR A STORED DATA COMPARISION 07000013 * AND THE DATA ARE NOT CORRECT, THE INPUT MESSAGE 07200013 * WILL BE SWITCHED. NO SUBROUTINES ARE USED. 07400013 * 07600013 * 07800013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 08000013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 08200013 * REENTRANT. 08400013 * 08600013 EJECT 08800013 IGC0107G CSECT 09000013 * 09200013 * 09400013 * 09600013 BALR BASEREG,0 09800013 USING *,BASEREG 10000013 USING PARAMLST,PARREG 10200013 USING ONLTBUF,BUFREG 10400013 * SET BASE REGISTERS 10600013 LR PARREG,1 LOAD PARAMETER LIST ADDRESS 10800013 L BUFREG,ECBADDR ADDRESS OF INPUT BUFFER 11000013 LR IOREG,0 ADDRESS OF FIRST 9 11200013 L PATRNREG,PATRNLST ADDRESS OF PATTERN LIST 11400013 * VALIDATE HEADER 11600013 CLI DEVICETP,X'21' TEST FOR 1030 DEVICE TYPE 11800013 MVI NOTEST,X'12' SET SEQUENCE INDICATOR 12000013 BNE RESTART BRANCH IF NOT 1030 12200013 CLI 6(IOREG),X'15' BRANCH IF 12400013 MVI NOTEST,X'22' SET SEQUENCE INDICATOR 12600013 BE RESTART TEST CODE OF ZERO 12800013 CLI 6(IOREG),X'0E' BRANCH IF TEST SELECTION 13000013 MVI NOTEST,X'32' SET SEQUENCE INDICATOR 13200013 BH RESTART IS GREATER THAN 7 13400013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 13600013 BE FORMAT1A 13800013 CLI 5(IOREG),X'15' TEST FOR FORMAT 0 14000013 MVI NOTEST,X'42' SET SEQUENCE INDICATOR 14200013 BNE RESTART 14400013 MVC ADDRESS(1),8(IOREG) MOVE ADDRESS CHAR FOR CARD RDR 14600013 CLI 7(IOREG),X'0B' CHECK FOR MANUAL ENTRY OR BADGE 14800013 BE NOTCARD READER 15000013 ADDRSET EQU * 15200013 * GET CORE FOR CCW'S 15400013 L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 15600013 LA WORKREG,72 COUNT OF BYTES NEEDED 15800013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 16000013 LA WORKREG,CCWAREA FOR ADDRESS OF AREA OBTAINED 16200013 ST WORKREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 16400013 SVC 4 ISSUE GETMAIN SVC 16600013 NR 15,15 TEST FOR ZERO RETURN CODE 16800013 MVI NOTEST,X'52' SET SEQUENCE INDICATOR 17000013 BNZ RESTART NO CODE FOR CCW'S 17200013 MVI CCWBYTES,72 PUT COUNT IN COMMUNICATION AREA 17400013 L CCWREG,CCWAREA 17600013 LA CCWREG,24(CCWREG) ALLOW FOR STCB AREA 17800013 MVC 0(48,CCWREG),CHANPROG MOVE CCW'S INTO CCW AREA 18000013 * SET UP ALL BUT DATA CCW 18200013 SETCCWS L WORKREG,CRIDLES 18400013 LA WORKREG,24(WORKREG) ADDRESS OF CIRCLE Y, C, S. 18600013 ST WORKREG,0(CCWREG) PUT IN CCW 18800013 MVI 0(CCWREG),X'01' RESTORE OP CODE 19000013 * 19200013 LA WORKREG,ADDRESS ADDRESS OF ADDRESSING CHARACTER 19400013 ST WORKREG,8(CCWREG) PUT IN CCW 19600013 MVI 8(CCWREG),X'01' RESTORE OP CODE 19800013 * 20000013 MVI ADDRESS+1,X'02' INSERT SECOND ADDRESSING CHAR 20200013 * 20400013 LA WORKREG,RESPONSE ADDRESS OF RESPONSE AREA 20600013 ST WORKREG,16(CCWREG) PUT IN CCW 20800013 MVI 16(CCWREG),X'02' RESTORE OP CODE 21000013 * 21200013 MVC 25(3,CCWREG),CRIDLES+1 ADDRESS OF CR-IDLES FOR CCW 21400013 * 21600013 MVC 41(3,CCWREG),17(CCWREG) ADDRESS FOR LRC RESPONSE 21800013 * CHECK TEST REQUEST 22000013 CLI 6(IOREG),X'02' BRANCH IF 22200013 BE MSGSWTCH SWITCH TEST (1) 22400013 CLI 6(IOREG),X'0B' BRANCH IF 22600013 BE COMPARE COMPARE TEST (5) 22800013 SR TESTREG,TESTREG CLEAR TEST REGISTER 23000013 IC TESTREG,6(IOREG) INSERT TEST SELECT CHARACTER 23200013 SRA TESTREG,1 SHIFT OUT PARITY 23400013 MVI NOTEST,X'62' SET SEQUENCE INDICATOR 23600013 BZ RESTART 23800013 IC TESTREG,TESTCODE-2(TESTREG) SET UP INDEXING 24000013 LA WORKREG,0(TESTREG,PATRNREG) 24200013 CLI 0(WORKREG),X'00' BRANCH IF THIS PATTERN 24400013 BE NOTINUSE IS NOT IN USE 24600013 IC WORKREG2,0(WORKREG) 1-UP 24800013 LA WORKREG2,1(WORKREG2) USAGE 25000013 STC WORKREG2,0(WORKREG) COUNT 25200013 * SET UP DATA CCW 25400013 SETDATA EQU * 25600013 STC TESTREG,DISPLACE 25800013 L WORKREG,0(WORKREG) ADDRESS OF DATA 26000013 SR WORKREG2,WORKREG2 CLEAR WORKING REGISTER 2 26200013 IC WORKREG2,0(WORKREG) COUNT OF DATA 26400013 SH WORKREG2,=H'4' REDUCE BY FOUR 26600013 STC WORKREG2,39(CCWREG) PUT IN CCW 26800013 LA WORKREG,4(WORKREG) ADDRESS OF DATA TO BE SENT 27000013 ST WORKREG,32(CCWREG) PUT IN CCW 27200013 MVI 32(CCWREG),X'01' RESTORE OP CODE 27400013 * 27600013 BR RETURN 27800013 * GET CORE FOR THIS PATTERN 28000013 NOTINUSE EQU * 28200013 EX 0,DATAADDR-X'2C'(TESTREG) ADDRESS OF DATA TO MOVE 28400013 SR COUNTREG,COUNTREG CLEAR REGISTER FOR COUNT 28600013 IC COUNTREG,0(FROMREG) GET COUNT 28800013 BAL LINKREG,GETCORE GET STORAGE, MOVE DATA, ETC. 29000013 LA WORKREG,0(TESTREG,PATRNREG) ADDRESS OF TABLE ENTRY 29200013 MVI 0(WORKREG),X'01' SET USAGE COUNT TO 1 29400013 L WORKREG2,0(WORKREG) DATA AREA ADDRESS 29600013 MVC 0(1,WORKREG2),3(WORKREG2) COUNT WAS PADDED-PUT IN PLACE 29800013 B SETDATA 30000013 * GET STORAGE, MOVE DATA AND PAD IT 30200013 GETCORE EQU * 30400013 L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 30600013 ST TOREG,4(GETMAIN) PUT ADDRESS IN GETMAIN CONSTANT 30800013 ST COUNTREG,0(GETMAIN) COUNT TO GETMAIN CONSTANT 31000013 SVC 4 ISSUE GETMAIN SVC 31200013 NR 15,15 TEST FOR ZERO RETURN CODE 31400013 MVI NOTEST,X'72' SET SEQUENCE INDICATOR 31600013 BNZ RESTART NON-ZERO IS NO CORE AVAILABLE 31800013 L TOREG,0(TOREG) ADDRESS OF BUFFER 32000013 L PADSREG,=X'DFDFDFDF' INITIALIZE PADDING REGISTER 32200013 SRA COUNTREG,2 DIVIDE COUNT BY 4 32400013 IC PADSREG,0(FROMREG) GET A CHARACTER 32600013 ST PADSREG,0(TOREG) STORE A WORD WITH PADS AND CHAR 32800013 LA FROMREG,1(FROMREG) UP POINTERS 33000013 LA TOREG,4(TOREG) 33200013 BCT COUNTREG,*-16 LOOP ON COUNT 33400013 BR LINKREG 33600013 * DEVELOP ADDRESS FROM MAN ENTRY OR BADGE 33800013 NOTCARD EQU * 34000013 SR WORKREG,WORKREG CLEAR RESULT REGISTER 34200013 CLI 8(IOREG),X'15' TEST TENS FOR ZERO 34400013 BE TESTUNIT 34600013 IC WORKREG,8(IOREG) TENS ADDRESSING CHARACTER 34800013 SRA WORKREG,1 DROP PARITY BIT 35000013 MVI NOTEST,X'82' SET SEQUENCE INDICATOR 35200013 BZ RESTART NO TEST--INVALID CHARACTER 35400013 MH WORKREG,=H'10' TENS VALUE IN RESULT REGISTER 35600013 TESTUNIT CLI 9(IOREG),X'15' TEST UNITS FOR ZERO 35800013 BE TESTRSLT 36000013 SR WORKREG2,WORKREG2 CLEAR SECOND WORKING REGISTER 36200013 IC WORKREG2,9(IOREG) UNITS ADDRESSING CHARACTER 36400013 SRA WORKREG2,1 DROP PARITY BIT 36600013 MVI NOTEST,X'92' SET SEQUENCE INDICATOR 36800013 BZ RESTART NO TEST--INVALID CHARACTER 37000013 CH WORKREG,=H'9' UNITS CHARACTER MUST BE NUMERIC 37200013 MVI NOTEST,X'A2' SET SEQUENCE INDICATOR 37400013 BH RESTART BRANCH IF NOT 37600013 AR WORKREG,WORKREG2 DEVELOP FINAL RESULT 37800013 TESTRSLT CH WORKREG,=H'26' TEST RESULT FOR 26 38000013 MVI NOTEST,X'B2' SET SEQUENCE INDICATOR 38200013 BH RESTART 38400013 SR WORKREG2,WORKREG2 CLEAR SECOND WORK REGISTER 38600013 IC WORKREG2,ADDRCHAR(WORKREG) ADDRESSING CHARACTER 38800013 STC WORKREG2,ADDRESS PUT IN BUFFER 39000013 NR WORKREG2,WORKREG2 TEST REGISTER 39200013 MVI NOTEST,X'C2' SET SEQUENCE INDICATOR 39400013 BZ RESTART ZERO IS AN INVALID ADDRESS 39600013 B ADDRSET 39800013 * 40000013 FORMAT1A EQU ADDRSET 40200013 * 40400013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 40600013 BR RETURN RETURN 40800013 * 41000013 COMPARE EQU * 41200013 CLI 7(IOREG),X'0B' COMPARE REQUEST NOT VALID FROM 41400013 MVI NOTEST,X'D2' SET SEQUENCE INDICATOR 41600013 BE RESTART BADGE READER OR MANUAL ENTRY 41800013 LH COUNTREG,CHARCNT COUNT OF CHARACTERS IN MESSAGE 42000013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 42200013 BNE FORMAT0C 42400013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 42600013 CLI 8(IOREG),X'15' TEST FOR RETURN TO SOURCE 42800013 BE GETCOUNT EQUAL IS RETURN TO SOURCE 43000013 IC WORKREG,8(IOREG) COUNT OF CHARACTERS IN SYMBOL 43200013 SRA WORKREG,1 SHIFT OUT PARITY BIT 43400013 CH WORKREG,=H'8' 43600013 MVI NOTEST,X'E2' SET SEQUENCE INDICATOR 43800013 BH RESTART OVER 8 IS INVALID 44000013 GETCOUNT EQU * 44200013 SH COUNTREG,=H'10' ADJUST FOR HEADER 44400013 SR COUNTREG,WORKREG ADJUST FOR SYMBOL 44600013 LA WORKREG,9(WORKREG,IOREG) ADDRESS OF FIRST CHAR TO COMP 44800013 COMPARE5 BZ CMPVALID NO DATA TO BE COMPARED 45000013 LA WORKREG2,ALLCHAR+1 ADDRESS OF FIRST COMPARE CHAR 45200013 BCTR COUNTREG,0 ADJUST FOR CLC INSTRUCTION 45400013 EXCLC CLC 0(1,WORKREG),0(WORKREG2) 45600013 EX COUNTREG,EXCLC DO THE COMPARE 45800013 BNE MSGSWTCH 46000013 COMPARE4 MVC 0(11,IOREG),VALIDCMP MOVE IN VALID COMPARE MESSAGE 46200013 IC WORKREG,0(WORKREG2,COUNTREG) LAST CHARACTER COMPARED 46400013 STC WORKREG,8(IOREG) COMPLETE MESSAGE 46600013 * PREPARE TO SWITCH THE COMPARE VALID MSG 46800013 COMPARE3 LA COUNTREG,11 SET COUNT FOR SWITCH 47000013 STH COUNTREG,CHARCNT STORE CORRECT CHARACTER COUNT 47200013 B MSGSWTCH SWITCH THE MESSAGE 47400013 * 47600013 CMPVALID EX 0,COMPARE4 MOVE IN VALID COMPARE MESSAGE 47800013 B COMPARE3 COMPLETE SWITCH SETUP 48000013 * 48200013 FORMAT0C EQU * 48400013 LA WORKREG,9(IOREG) ADJUST ADDRESS POINTER 48600013 SH COUNTREG,=H'10' ADJUST COUNT FOR FORMAT ZERO 48800013 B COMPARE5 49000013 * 49200013 MSGSWTCH EQU * 49400013 LA WORKREG2,63 LOAD MAXIMUM SWITCH COUNT 49600013 CH WORKREG2,CHARCNT COMPARE MAXIMUM COUNT TO ACTUAL 49800013 BH *+8 BRANCH IF COUNT LESS THAN MAX. 50000013 STH WORKREG2,CHARCNT STORE MAXIMUM COUNT 50200013 LH COUNTREG,CHARCNT COUNT OF CHARS TO BE SWITCHED 50400013 SLA COUNTREG,2 50600013 LR FROMREG,IOREG ADDRESS OF DATA SOURCE 50800013 LA TOREG,AREA1030 ADDRESS FOR ADDRESS OF AREA 51000013 BAL LINKREG,GETCORE GET CORE FOR SWITCH 51200013 BCTR TOREG,0 INSURE LAST CHARACTER IS EOB 51400013 MVI 0(TOREG),X'3D' 51600013 LH COUNTREG,CHARCNT GET COUNT OF CHARACTERS AGAIN 51800013 SLA COUNTREG,2 52000013 STC COUNTREG,BYTE1030 COUNT FOR RESIDENT MODULE 52200013 MVC 33(3,CCWREG),AREA1030+1 ADDRESS FOR CCW 52400013 STC COUNTREG,39(CCWREG) PUT COUNT IN CCW 52600013 MVI DISPLACE,X'00' 52800013 * 53000013 BR RETURN 53200013 * 53400013 EJECT 53600013 * 53800013 * PATTERN OF DATA FOR 1030 TESTS 54000013 * 54200013 TILT DC AL1(4*(TILTEND-TILT)) 54400013 DC X'62026B0B701064046D0D765BDFDFDFDF167313680861156E0E68' 54600013 DC X'075BDF3D' 54800013 TILTEND EQU * 55000013 * 55200013 ROTATE DC AL1(4*(ROTATEND-ROTATE)) 55400013 DC X'62766E686143574F49405BDFDFDFDF23372F292002160E08155B' 55600013 DC X'DF3D' 55800013 ROTATEND EQU * 56000013 * 56200013 TWIST DC AL1(4*(TWISTEND-TWIST)) 56400013 DC X'62160276700410646B0D0B6D5BDFDFDFDF43322352512531454A' 56600013 DC X'2C2A4C5BDF3D' 56800013 TWISTEND EQU * 57000013 * 57200013 ALLCHAR DC AL1(4*(ALLCHARX-ALLCHAR)) 57400013 DC X'15020407080B0D0E1013626467686B6D6E7073434546494A4C4F' 57600013 DC X'51522526292A2C2F31325BDF3D' 57800013 ALLCHARX EQU * 58000013 * 58200013 ANALYZER DC AL1(4*(ANALYZEX-ANALYZER)) 58400013 DC X'25014F01620167016B5B0101010101010167015BDFDF466D3BDF' 58600013 DC X'023BDF045BDF3D' 58800013 ANALYZEX EQU * 59000013 * 59200013 * CCW'S 59400013 * 59600013 CHANPROG CCW X'01',0,X'A0',5 WRITE CIRCLE Y, C'S, S 59800013 CCW X'01',0,X'60',2 WRITE ADDRESSING CHARACTERS 60000013 CCW X'02',0,X'60',1 READ ADDRESSING RESPONSE 60200013 CCW X'01',0,X'A0',20 WRITE CARRIAGE RETURN AND IDLES 60400013 CCW X'01',0,X'60',0 WRITE THE TEST MESSAGE 60600013 CCW X'02',0,X'20',1 READ THE LRC RESPONSE 60800013 * 61000013 * ADDRESSES OF DATA TO BE MOVED TO PATTERN BUFFER 61200013 * 61400013 DATAADDR EQU * 61600013 LA FROMREG,TILT 61800013 LA FROMREG,ROTATE 62000013 LA FROMREG,TWIST 62200013 LA FROMREG,ALLCHAR 62400013 LA FROMREG,ANALYZER 62600013 * 62800013 TESTCODE DC X'2C303400383C' 63000013 ADDRCHAR DC X'00006467686B6D6E7073004546494A4C4F51522526292A2C2F31' 63200013 DC X'32' 63400013 VALIDCMP DC X'67494F012A466840235B3D' VALID COMPARE MESSAGE 63600013 EJECT 63800013 * 64000013 * EQUATES 64200013 * 64400013 GETMAIN EQU 1 64600013 BUFREG EQU 2 64800013 PARREG EQU 3 65000013 WORKREG EQU 4 65200013 TOREG EQU 4 65400013 WORKREG2 EQU 5 65600013 BASEREG EQU 6 65800013 IOREG EQU 7 66000013 TESTREG EQU 8 66200013 PATRNREG EQU 9 66400013 CCWREG EQU 10 66600013 FROMREG EQU 11 66800013 LINKREG EQU 12 67000013 COUNTREG EQU 13 67200013 RETURN EQU 14 67400013 PADSREG EQU 15 67600013 * 67800013 * INPUT AREA DEFINITION 68000013 * 68200013 ONLTBUF DSECT 68400013 ECB DS 8C 68600013 CCWBYTES DS 0C COUNT OF CCW AREA 68800013 CCWAREA DS 4C ADDRESS OF CCW AREA 69000013 SAVE DS 0C 69200013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 69400013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 69600013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 69800013 CVTAREA DS 0C 70000013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 70200013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 70400013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 70600013 DEVICETP DS 1C DEVICE TYPE CODE 70800013 FEATURES DS 0C FEATURES CODE 71000013 RESPONSE DS 1C FOR RESPONSES 71200013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 71400013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 71600013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 71800013 UCBADDR DS 4C SAVE AREA FOR UCB ADDRESS 72000013 * 72200013 * PARAMETER LIST DEFINITION 72400013 * 72600013 PARAMLST DSECT 72800013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 73000013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 73200013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 73400013 NOTEST DS 1C NO TEST SWITCH 73600013 END 73800013 ./ ADD SSI=01010761,NAME=IGC0207G,SOURCE=0 TITLE 'IGC0207G-1050 TERMINAL TEST MODULE.' 00200013 * 00400013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00600013 * 00800013 * 01000013 * FUNCTION - GENERATE CHANNEL PROGRAM FOR 1050 ON LINE TESTS 01200013 * 01400013 * 01600013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM HEADER ANALYSIS 01800013 * MODULE 02000013 * 02200013 * 02400013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 02600013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 02800013 * REGISTER 14 - RETURN ADDRESS 03000013 * 03200013 * 03400013 * OUTPUT - 1. GENERATED CHANNEL PROGRAM 03600013 * 2. UPDATED USAGE COUNT AND POINTER IN RESIDENT 03800013 * TERMINAL TEST MODULE (IECKONLT). 04000013 * 04200013 * 04400013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 04600013 * 04800013 * 05000013 * EXIT - RETURN TO ADDRESS IN REGISTER 14 05200013 * 05400013 * 05600013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND THE HEADER IS 05800013 * VALIDATED. IT IS ANALYZED FOR TYPE OF REQUEST. 06000013 * CORE IS OBTAINED AND CCW'S FOR THE PROPER DATA AND 06200013 * CONTROL PURPOSES ARE FORMED IN THE AREA. IF THE 06400013 * REQUESTED DATA PATTERN IS NOT IN USE, CORE WILL BE 06600013 * OBTAINED AND THE PATTERN MOVED INTO THE NEW AREA. 06800013 * IF NO CORE IS AVAILABLE, THE TEST REQUEST WILL BE 07000013 * SWITCHED TO THE TERMINAL SPECIFIED IN THE TEST 07200013 * REQUEST. IF THE REQUEST IS FOR A STORED DATA 07400013 * COMPARISON AND THE DATA ARE NOT CORRECT, THE INPUT 07600013 * MESSAGE WILL BE SWITCHED. NO SUBROUTINES ARE USED. 07800013 * 08000013 * 08200013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 08400013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 08600013 * REENTRANT. 08800013 * 09000013 EJECT 09200013 IGC0207G CSECT 09400013 * 09600013 BALR BASEREG,0 09800013 USING *,BASEREG 10000013 USING PARAMLST,PARREG 10200013 USING ONLTBUF,BUFREG 10400013 * SET BASE REGISTERS 10600013 LR PARREG,1 LOAD PARAMETER LIST ADDRESS 10800013 L BUFREG,ECBADDR ADDRESS OF INPUT BUFFER 11000013 LR IOREG,0 ADDRESS OF FIRST 9 11200013 L PATRNREG,PATRNLST ADDRESS OF PATTERN LIST 11400013 * VALIDATE HEADER 11600013 CLI DEVICETP,X'11' CHECK FOR 1050 ADAPTER & MODEL 11800013 BE TYPE1050 EQUAL IS OK 12000013 CLI DEVICETP,X'31' CHECK FOR 1050 ADAPTER & MODEL 12200013 BNE RESTART INVALID REQUEST--GO TO RESTART 12400013 TYPE1050 CLI 6(IOREG),X'15' BRANCH IF 12600013 BE RESTART TEST CODE OF ZERO 12800013 CLI 6(IOREG),X'0E' BRANCH IF TEST SELECTION IS 13000013 BH RESTART GREATER THAN 7 13200013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 13400013 BE LOADCON 13600013 CLI 5(IOREG),X'15' TEST FOR FORMAT 0 13800013 BNE RESTART 14000013 CLI 9(IOREG),X'02' BRANCH IF 14200013 BL RESTART NO COMPONENT SELECTION 14400013 CLI 9(IOREG),X'15' BRANCH IF 14600013 BH RESTART ILLEGAL COMPONENT 14800013 MVC ADDRESS(2),8(IOREG) MOVE ADDRESSING CHARACTERS 15000013 * 15200013 LOADCON L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 15400013 TM FEATURES,X'90' TEST FOR DIAL 15600013 BZ NOTDIAL 15800013 L WORKREG,DIALINFO CHECK IF ANSWER OR DIALOUT 16000013 CLI 5(IOREG),X'15' TEST FOR FORMAT ZERO 16200013 BE NOTDIAL BRANCH IF ZERO 16400013 CLI 8(IOREG),X'15' TEST FOR RETURN TO SOURCE 16600013 BE NOTDIAL BRANCH IF RETURN TO SOURCE 16800013 LA WORKREG,80 COUNT OF BYTES TO OBTAIN 17000013 GETCORE ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 17200013 LA WORKREG,CCWAREA FOR ADDRESS OF AREA OBTAINED 17400013 ST WORKREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 17600013 SVC 4 ISSUE GETMAIN SVC 17800013 NR 15,15 TEST FOR ZERO RETURN CODE 18000013 BNE RESTART NO CORE FOR CCW'S 18200013 MVC CCWBYTES(1),3(GETMAIN) PUT COUNT IN COMMUNICATION AREA 18400013 L CCWREG,CCWAREA 18600013 LA CCWREG,24(CCWREG) ALLOW FOR STCB AREA 18800013 CLI CCWBYTES,X'40' TEST IF DIAL 19000013 BE NOTDIAL1 BYPASS DIAL CCW SETUP IF NOT 19200013 MVC 0(16,CCWREG),DIALCCW MOVE IN DIAL CCW'S 19400013 L WORKREG,DIALINFO ADDRESS OF DIAL INFORMATION 19600013 MVC 15(1,CCWREG),0(WORKREG) PUT DIAL DIGIT COUNT IN CCW 19800013 LA WORKREG,1(WORKREG) ADDRESS OF DIAL DIGITS 20000013 ST WORKREG,8(CCWREG) PUT IN CCW 20200013 MVI 8(CCWREG),X'29' RESTORE OP CODE IN CCW 20400013 LA CCWREG,16(CCWREG) UP CCW STORE LOCATION PAST DIAL 20600013 NOTDIAL1 EQU * 20800013 MVC 0(40,CCWREG),CHANPROG MOVE CCW'S INTO CCW AREA 21000013 * 21200013 * SET UP ALL BUT DATA CCW 21400013 * 21600013 L WORKREG,CRIDLES 21800013 LA WORKREG,20(WORKREG) ADDRESS OF CIRCLE D AND C 22000013 ST WORKREG,0(CCWREG) PUT IN CCW 22200013 MVI 0(CCWREG),X'01' RESTORE OP CODE 22400013 * 22600013 MVC 25(3,CCWREG),CRIDLES+1 ADDRESS OF CR, IDLES FOR CCW 22800013 * 23000013 LA WORKREG,RESPONSE ADDRESS OF RESPONSE AREA 23200013 ST WORKREG,16(CCWREG) PUT IN CCW 23400013 MVI 16(CCWREG),X'02' RESTORE OP CODE 23600013 * 23800013 LA WORKREG,ADDRESS ADDRESS OF ADDRESSING CHARS. 24000013 ST WORKREG,8(CCWREG) PUT IN CCW 24200013 MVI 8(CCWREG),X'01' RESTORE OP CODE 24400013 * 24600013 CLI 6(IOREG),X'02' BRANCH IF 24800013 BE MSGSWTCH SWITCH TEST (1) 25000013 CLI 6(IOREG),X'0B' BRANCH IF 25200013 BE COMPARE COMPARE TEST (5) 25400013 SR TESTREG,TESTREG CLEAR TEST REGISTER 25600013 IC TESTREG,6(IOREG) INSERT TEST SEL. CHARACTER 25800013 SRA TESTREG,1 SHIFT OUT PARITY BIT 26000013 BZ RESTART 26200013 IC TESTREG,TESTCODE-2(TESTREG) SET UP INDEXING 26400013 LA WORKREG,0(TESTREG,PATRNREG) 26600013 CLI 0(WORKREG),X'00' BRANCH IF THIS PATTERN 26800013 BE NOTINUSE IS NOT IN USE 27000013 IC WORKREG,0(TESTREG,PATRNREG) 1-UP 27200013 LA WORKREG,1(WORKREG) USAGE 27400013 STC WORKREG,0(TESTREG,PATRNREG) COUNT 27600013 * 27800013 SETCCW EQU * 28000013 L WORKREG,0(TESTREG,PATRNREG) 28200013 IC WORKREG2,0(WORKREG) PATTERN AREA SIZE 28400013 LA WORKREG,1(WORKREG) ADDRESS OF DATA TO BE SENT 28600013 ST WORKREG,32(CCWREG) PUT IN CCW 28800013 MVI 32(CCWREG),X'01' RESTORE OP CODE 29000013 BCTR WORKREG2,0 REDUCE COUNT BY ONE 29200013 STC WORKREG2,39(CCWREG) PUT IN CCW 29400013 STC TESTREG,DISPLACE PUT DISPLACEMENT IN WORK AREA 29600013 * 29800013 BR RETURN 30000013 * 30200013 * 30400013 * 30600013 NOTINUSE EQU * 30800013 EX 0,DATAADDR-4(TESTREG) ADDRESS OF DATA TO MOVE 31000013 LA TOREG,0(TESTREG,PATRNREG) ADDRESS OF THE TABLE ENTRY 31200013 ST TOREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 31400013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 31600013 IC WORKREG,0(FROMREG) CHARACTER COUNT OF DATA 31800013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 32000013 SVC 4 ISSUE GETMAIN SVC 32200013 NR 15,15 TEST FOR ZERO RETURN CODE 32400013 BNE MSGSWTCH NON-ZERO IS CODE NOT AVAILABLE 32600013 MVI 0(TOREG),X'01' SET USAGE COUNT TO ONE 32800013 L TOREG,0(TOREG) GET ADDRESS OF DATA 33000013 BCTR WORKREG,0 REDUCE COUNT FOR MVC INST 33200013 EX WORKREG,EXMVC MOVE THE DATA 33400013 B SETCCW FINISH DATA CCW 33600013 * 33800013 NOTDIAL EQU * 34000013 LA WORKREG,64 COUNT OF BYTES TO OBTAIN FOR 34200013 B GETCORE NON DIAL 34400013 * 34600013 * 34800013 * 35000013 COMPARE EQU * 35200013 LH COUNTREG,CHARCNT COUNT OF CHARACTERS IN MESSAGE 35400013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 35600013 BNE FORMAT0C 35800013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 36000013 CLI 8(IOREG),X'15' CHECK FOR RETURN TO SOURCE 36200013 BE GETCOUNT EQUAL MEANS RETURN TO SOURCE 36400013 IC WORKREG,8(IOREG) GET COUNT OF CHARS. IN SYMBOL 36600013 SRA WORKREG,1 SHIFT OUT PARITY BIT 36800013 CH WORKREG,=H'8' 37000013 BH RESTART OVER 8 IS INVALID 37200013 GETCOUNT SH COUNTREG,=H'10' ADJUST FOR HEADER 37400013 SR COUNTREG,WORKREG ADJUST FOR SYMBOL 37600013 LA WORKREG,9(WORKREG,IOREG) ADDRESS OF FIRST CHAR TO COMP 37800013 COMPARE5 BZ CMPVALID NO DATA TO BE COMPARED 38000013 LA WORKREG2,ALLCHAR+1 ADDRESS OF COMPARE DATA 38200013 BCTR COUNTREG,0 ADJUST FOR CLC INSTRUCTION 38400013 EXCLC CLC 0(1,WORKREG),0(WORKREG2) DUMMY INSTRUCTION 38600013 EX COUNTREG,EXCLC DO THE COMPARE 38800013 BNE MSGSWTCH SWITCH IF COMPARE IS INCORRECT 39000013 COMPARE4 MVC 0(11,IOREG),VALIDCMP MOVE VALID COMPARE MESSAGE IN 39200013 IC WORKREG,0(WORKREG2,COUNTREG) LAST CHARACTER COMPARED 39400013 STC WORKREG,8(IOREG) COMPLETE MESSAGE 39600013 * PREPARE DATA CCW 39800013 COMPARE3 ST IOREG,32(CCWREG) PUT ADDRESS IN CCW 40000013 MVI 32(CCWREG),X'01' RESTORE OP CODE 40200013 MVI 39(CCWREG),11 PUT COUNT IN CCW 40400013 MVI DISPLACE,X'00' PUT DISPLACEMENT IN WORK AREA 40600013 BR RETURN 40800013 * 41000013 CMPVALID EX 0,COMPARE4 MOVE IN VALID COMPARE MESSAGE 41200013 B COMPARE3 CONTINUE 41400013 * 41600013 FORMAT0C EQU * 41800013 LA WORKREG,10(IOREG) 42000013 SH COUNTREG,=H'11' ADJUST COUNT 42200013 B COMPARE5 COMPLETE COMPARE 42400013 * 42600013 * 42800013 VALIDCMP DC X'E7C9CF81AAC6E840235B1F' VALID COMPARE MESSAGE 43000013 DS 0H 43200013 MSGSWTCH EQU * 43400013 ST IOREG,32(CCWREG) PUT ADDRESS IN CCW 43600013 MVI 32(CCWREG),X'01' RESTORE OP CODE 43800013 MVC 39(1,CCWREG),CHARCNT+1 PUT COUNT IN CCW 44000013 * 44200013 LH COUNTREG,CHARCNT COUNT OF CHARACTERS 44400013 BCTR COUNTREG,0 44600013 LA COUNTREG,0(COUNTREG,IOREG) ADDRESS OF LAST DATA CHAR. 44800013 MVI 0(COUNTREG),X'1F' PUT EOT AT END 45000013 MVI DISPLACE,X'00' SET DISPLACEMENT FOR RESIDENT 45200013 * 45400013 BR RETURN 45600013 * 45800013 * 46000013 * 46200013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 46400013 BR RETURN 46600013 * 46800013 * 47000013 * 47200013 * CONSTANTS 47400013 * 47600013 TESTCODE DC X'04080C001014' 47800013 EXMVC MVC 0(1,TOREG),0(FROMREG) 48000013 EJECT 48200013 * 48400013 * PATTERN OF DATA FOR 1050 TESTS 48600013 * 48800013 TILT DC AL1(TILTEND-TILT) 49000013 DC X'622367266B2A6E2F70316120642568296D2C733276375B5E5E5E' 49200013 DC X'5E5E5E573452134C0D49084504401551104F0E4A0B460743025B' 49400013 DC X'5E5E5E5E5E5E1F' 49600013 TILTEND EQU * 49800013 * 50000013 ROTATE DC AL1(ROTATEND-ROTATE) 50200013 DC X'62766B6D706443574A4C514523372A23312502340B0D5B5E5E5E' 50400013 DC X'5E5E5E100407130E081526322F292046524F494067736E68615B' 50600013 DC X'5E5E5E5E5E5E1F' 50800013 ROTATEND EQU * 51000013 * 51200013 TWIST DC AL1(TWISTEND-TWIST) 51400013 DC X'E234A357E713A652EB0DAA4CEE08AF49F004B145E1155B5E5E5E' 51600013 DC X'5E5E5E8276C3378773C6328B6DCA2C8E68CF299064D125A0405B' 51800013 DC X'5E5E5E5E5E5E1F' 52000013 TWISTEND EQU * 52200013 * 52400013 ALLCHAR DC AL1(ALLCHARX-ALLCHAR) 52600013 DC X'15020407080B0D0E1013626467686B6D6E7073434546494A4C4F' 52800013 DC X'51522526292A2C2F31325B5E5E5E5E5E5EE2E4E7E8EBEDEEF0F3' 53000013 DC X'C3C5C6C9CACCCFD1D2A5A6A9AAACAFB1B25B5E5E1F' 53200013 ALLCHARX EQU * 53400013 * 53600013 ANALYZER DC AL1(ANALYZEX-ANALYZER) 53800013 DC X'020407080B016701130101250162016B616445254F5D5D5D5D5D' 54000013 DC X'5D5D5D5D5D5D5D155D5D5D105D5D5D0D0101010101014F01675B' 54200013 DC X'0101010101010101675B5E5E5E466D3B5E5E023B5E5E043B5E5E' 54400013 DC X'075B1F' 54600013 ANALYZEX EQU * 54800013 * 55000013 * ADDRESSES OF DATA TO BE MOVED TO PATTERN BUFFER 55200013 * 55400013 DS 0H 55600013 DATAADDR EQU * 55800013 LA FROMREG,TILT 56000013 LA FROMREG,ROTATE 56200013 LA FROMREG,TWIST 56400013 LA FROMREG,ALLCHAR 56600013 LA FROMREG,ANALYZER 56800013 * 57000013 * CCW'S 57200013 * 57400013 DIALCCW CCW X'2F',0,X'60',1 DISABLE THE LINE 57600013 CCW X'29',0,X'60',0 SEND THE DIAL DIGITS 57800013 CHANPROG CCW X'01',0,X'A0',4 WRITE CIRCLE D AND CIRCLE C 58000013 CCW X'01',0,X'60',2 WRITE THE ADDRESSING CHARACTERS 58200013 CCW X'02',0,X'60',1 READ THE ADDRESSING RESPONSE 58400013 CCW X'01',0,X'A0',15 WRITE CARRIAGE RETURN AND IDLES 58600013 CCW X'01',0,X'20',0 WRITE THE TEST MESSAGE 58800013 EJECT 59000013 * INPUT AREA DEFINITION 59200013 * 59400013 ONLTBUF DSECT 59600013 ECB DS 8C 59800013 CCWBYTES DS 0C COUNT OF CCW AREA 60000013 CCWAREA DS 4C ADDRESS OF CCW AREA 60200013 SAVE DS 0C 60400013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 60600013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 60800013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 61000013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 61200013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 61400013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 61600013 DEVICETP DS 1C DEVICE TYPE CODE 61800013 FEATURES DS 0C FEATURES CODE 62000013 RESPONSE DS 1C FOR RESPONSES 62200013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 62400013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 62600013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 62800013 * 63000013 * PARAMETER LIST DEFINITION 63200013 * 63400013 PARAMLST DSECT 63600013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 63800013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 64000013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 64200013 NOTEST DS 1C NO TEST SWITCH 64400013 * 64600013 * EQUATES 64800013 * 65000013 GETMAIN EQU 1 65200013 WORKREG EQU 2 65400013 PARREG EQU 3 65600013 FROMREG EQU 4 65800013 TOREG EQU 5 66000013 BASEREG EQU 6 66200013 IOREG EQU 7 66400013 TESTREG EQU 8 66600013 PATRNREG EQU 9 66800013 CCWREG EQU 10 67000013 COUNTREG EQU 11 67200013 BUFREG EQU 12 67400013 WORKREG2 EQU 13 67600013 RETURN EQU 14 67800013 LINKREG EQU 15 68000013 END 68200013 ./ ADD SSI=01013243,NAME=IGC0307G,SOURCE=0 TITLE 'IGC0307G-1060 TERMINAL TEST MODULE.' 00300013 * 00600013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00900013 * 01200013 * 01500013 * FUNCTION - GENERATE CHANNEL PROGRAM FOR 1060 ON LINE TESTS 01800013 * 02100013 * 02400013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM HEADER ANALYSIS 02700013 * MODULE 03000013 * 03300013 * 03600013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 03900013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 04200013 * REGISTER 14 - RETURN ADDRESS 04500013 * 04800013 * 05100013 * OUTPUT - 1. GENERATED CHANNEL PROGRAM 05400013 * 2. UPDATED USAGE COUNT AND POINTER IN RESIDENT 05700013 * TERMINAL TEST MODULE (IECKONLT). 06000013 * 06300013 * 06600013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 06900013 * 07200013 * 07500013 * EXIT - RETURN TO ADDRESS IN REGISTER 14 07800013 * 08100013 * 08400013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND THE HEADER IS 08700013 * VALIDATED. IT IS ANALYZED FOR TYPE OF REQUEST. 09000013 * CORE IS OBTAINED AND CCW'S FOR THE PROPER DATA AND 09300013 * CONTROL PURPOSES ARE FORMED IN THE AREA. IF THE 09600013 * REQUESTED DATA PATTERN IS NOT IN USE, CORE WILL BE 09900013 * OBTAINED AND THE PATTERN MOVED INTO THE NEW AREA. 10200013 * IF NO CORE IS AVAILABLE, THE TEST REQUEST WILL BE 10500013 * SWITCHED TO THE TERMINAL SPECIFIED IN THE TEST 10800013 * REQUEST. IF THE REQUEST IS FOR A STORED DATA 11100013 * CORE IS OBTAINED AND CCW'S FOR THE PROPER DATA AND 11400013 * MESSAGE WILL BE SWITCHED. NO SUBROUTINES ARE USED. 11700013 * 12000013 * 12300013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 12600013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 12900013 * REENTRANT. 13200013 * 13500013 EJECT 13800013 IGC0307G CSECT 14100013 * 14400013 *D189000,192000 A41216 14500021 BALR BASEREG,0 14700013 USING *,BASEREG 15000013 USING PARAMLST,PARREG 15300013 USING ONLTBUF,BUFREG 15600013 * SET BASE REGISTERS 15900013 LR PARREG,1 LOAD PARAMETER LIST ADDRESS 16200013 L BUFREG,ECBADDR ADDRESS OF INPUT BUFFER 16500013 LR IOREG,0 ADDRESS OF FIRST 9 16800013 L PATRNREG,PATRNLST ADDRESS OF PATTERN LIST 17100013 L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 17400013 * VALIDATE HEADER 17700013 CLI DEVICETP,X'12' TEST FOR 1060 DEVICE TYPE 18000013 MVI NOTEST,X'16' SET SEQUENCE INDICATOR 18300013 BNE RESTART BRANCH IF NOT 1060 DEVICE 18600013 CLI 6(IOREG),X'0B' BRANCH IF 19500013 BE COMPARE1 COMPARE TEST 19800013 CLI 10(IOREG),X'02' BRANCH IF 20100013 BE CHKADDR COMPONENT SELECTION OF 1 20400013 CLI 10(IOREG),X'07' BRANCH IF 20700013 MVI NOTEST,X'26' SET SEQUENCE INDICATOR 21000013 BNE RESTART NOT COMPONENT SELECTION OF 3 21300013 CHKADDR CLI 8(IOREG),X'15' BRANCH IF 21600013 BE *+20 FIRST ADDRESS POSITION IS ZERO 21900013 CLI 8(IOREG),X'02' BRANCH IF 22200013 BE *+12 FIRST ADDRESS POSITION IS ONE 22500013 CLI 8(IOREG),X'04' BRANCH IF SECOND 22800013 MVI NOTEST,X'36' SET SEQUENCE INDICATOR 23100013 BNE RESTART ADDRESS POSITION IS NOT TWO 23400013 CLI 6(IOREG),X'15' BRANCH IF 23700013 MVI NOTEST,X'46' SET SEQUENCE INDICATOR 24000013 BE RESTART TEST CODE OF ZERO 24300013 CLI 6(IOREG),X'0E' BRANCH IF 24600013 MVI NOTEST,X'56' SET SEQUENCE INDICATOR 24900013 BH RESTART TEST SELECTION GREATER THAN 7 25200013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 25500013 BE COMPARE1 25800013 CLI 5(IOREG),X'15' TEST FOR FORMAT 0 26100013 MVI NOTEST,X'66' SET SEQUENCE INDICATOR 26400013 BNE RESTART BRANCH IF NOT 26700013 SR WORKREG,WORKREG CLEAR RESULT REGISTER 27000013 CLI 8(IOREG),X'15' TEST TENS FOR ZERO 27300013 BE TESTUNIT 27600013 IC WORKREG,8(IOREG) TENS ADDRESSING CHARACTER 27900013 SRA WORKREG,1 DROP PARITY BIT 28200013 MVI NOTEST,X'76' SET SEQUENCE INDICATOR 28500013 BZ RESTART INVALID CHARACTER TEST 28800013 MH WORKREG,=X'10' TIMES TEN 29100013 TESTUNIT CLI 9(IOREG),X'15' TEST UNITS FOR ZERO 29400013 BE TSTRSLT 29700013 SR WORKREG2,WORKREG2 CLEAR SECOND WORKING REGISTER 30000013 IC WORKREG2,9(IOREG) UNITS ADDRESSING CHARACTER 30300013 SRA WORKREG2,1 DROP PARITY BIT 30600013 MVI NOTEST,X'86' SET SEQUENCE INDICATOR 30900013 BZ RESTART INVALID CHARACTER TEST 31200013 CH WORKREG2,=H'9' UNITS CHARACTER MUST BE NUMERIC 31500013 MVI NOTEST,X'96' SET SEQUENCE INDICATOR 31800013 BH RESTART BRANCH IF NOT 32100013 AR WORKREG,WORKREG2 DEVELOP FINAL RESULT 32400013 TSTRSLT CH WORKREG,=H'26' TEST RESULT FOR 26 32700013 MVI NOTEST,X'A6' SET SEQUENCE INDICATOR 33000013 BH RESTART OVER 26 IS NOT VALID 33300013 IC WORKREG,ALLCHAR+10(WORKREG) MOVE ADDRESSING 33600013 STC WORKREG,ADDRESS CHARACTERS 33900013 MVC ADDRESS+1(1),10(IOREG) INTO BUFFER 34200013 COMPARE1 EQU * 34500013 LA WORKREG,72 COUNT OF BYTES TO OBTAIN 34800013 GETCORE ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 35100013 LA WORKREG,CCWAREA FOR ADDRESS OF AREA OBTAINED 35400013 ST WORKREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 35700013 SVC 4 ISSUE GETMAIN SVC 36000013 NR 15,15 TEST FOR ZERO RETURN CODE 36300013 MVI NOTEST,X'B6' SET SEQUENCE INDICATOR 36600013 BNE RESTART NO CORE FOR CCW'S 36900013 MVC CCWBYTES(1),3(GETMAIN) PUT COUNT IN COMMUNICATION AREA 37200013 L CCWREG,CCWAREA 37500013 LA CCWREG,24(CCWREG) ALLOW FOR STCB AREA 37800013 MVC 0(48,CCWREG),CHANPROG MOVE CCW'S INTO CCW AREA 38100013 * 38400013 * SET UP ALL BUT DATA CCW 38700013 * 39000013 L WORKREG,CRIDLES 39300013 LA WORKREG,24(WORKREG) ADDRESS OF CIRCLE Y, C, S 39600013 ST WORKREG,0(CCWREG) PUT IN CCW 39900013 MVI 0(CCWREG),X'01' RESTORE OP CODE 40200013 * 40500013 MVC 25(3,CCWREG),CRIDLES+1 ADDRESS OF CR, IDLES FOR CCW 40800013 * 41100013 LA WORKREG,RESPONSE ADDRESS OF RESPONSE AREA 41400013 ST WORKREG,16(CCWREG) PUT IN CCW 41700013 MVI 16(CCWREG),X'02' RESTORE OP CODE 42000013 * 42300013 LA WORKREG,ADDRESS ADDRESS OF ADDRESSING CHARS. 42600013 ST WORKREG,8(CCWREG) PUT IN CCW 42900013 MVI 8(CCWREG),X'01' RESTORE OP CODE 43200013 * 43500013 MVC 41(3,CCWREG),17(CCWREG) ADDRESS FOR LRC RESPONSE 43800013 * 44100013 CLI 6(IOREG),X'02' BRANCH IF 44400013 BE MSGSWTCH SWITCH TEST (1) 44700013 CLI 6(IOREG),X'0B' BRANCH IF 45000013 BE COMPARE COMPARE TEST (5) 45300013 SR TESTREG,TESTREG CLEAR TEST REGISTER 45600013 IC TESTREG,6(IOREG) INSERT TEST SEL. CHARACTER 45900013 SRA TESTREG,1 SHIFT OUT PARITY BIT 46200013 MVI NOTEST,X'C6' SET SEQUENCE INDICATOR 46500013 BZ RESTART 46800013 IC TESTREG,TESTCODE-2(TESTREG) SET UP INDEXING 47100013 LA WORKREG,0(TESTREG,PATRNREG) 47400013 CLI 0(WORKREG),X'00' BRANCH IF THIS PATTERN 47700013 BE NOTINUSE IS NOT IN USE 48000013 IC WORKREG,0(TESTREG,PATRNREG) 1-UP 48300013 LA WORKREG,1(WORKREG) USAGE 48600013 STC WORKREG,0(TESTREG,PATRNREG) COUNT 48900013 * 49200013 SETCCW EQU * 49500013 L WORKREG,0(TESTREG,PATRNREG) 49800013 IC WORKREG2,0(WORKREG) PATTERN AREA SIZE 50100013 LA WORKREG,1(WORKREG) ADDRESS OF DATA TO BE SENT 50400013 ST WORKREG,32(CCWREG) PUT IN CCW 50700013 MVI 32(CCWREG),X'01' RESTORE OP CODE 51000013 BCTR WORKREG2,0 REDUCE COUNT BY ONE 51300013 STC WORKREG2,39(CCWREG) PUT IN CCW 51600013 STC TESTREG,DISPLACE PUT DISPLACEMENT IN WORK AREA 51900013 * 52200013 BR RETURN 52500013 * 52800013 * 53100013 * 53400013 NOTINUSE EQU * 53700013 EX 0,DATAADDR-24(TESTREG) ADDRESS OF DATA TO MOVE 54000013 LA TOREG,0(TESTREG,PATRNREG) ADDRESS OF THE TABLE ENTRY 54300013 ST TOREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 54600013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 54900013 IC WORKREG,0(FROMREG) CHARACTER COUNT OF DATA 55200013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 55500013 SVC 4 ISSUE GETMAIN SVC 55800013 NR 15,15 TEST FOR ZERO RETURN CODE 56100013 BNE MSGSWTCH NON-ZERO IS CODE NOT AVAILABLE 56400013 MVI 0(TOREG),X'01' SET USAGE COUNT TO ONE 56700013 L TOREG,0(TOREG) GET ADDRESS OF DATA 57000013 BCTR WORKREG,0 REDUCE COUNT FOR MVC INST 57300013 EX WORKREG,EXMVC MOVE THE DATA 57600013 B SETCCW FINISH DATA CCW 57900013 * 58200013 COMPARE EQU * 58500013 CLC 5(7,IOREG),CMPDATA BRANCH IF 58800013 BNE MSGSWTCH INVALID COMPARISON 59100013 MVC 0(9,IOREG),VALIDMSG LOAD VALID COMPARE MESSAGE 59400013 ST IOREG,32(CCWREG) PUT ADDRESS IN CCW 59700013 MVI 32(CCWREG),X'01' RESTORE OP CODE 60000013 MVI 39(CCWREG),9 PUT COUNT IN CCW 60300013 MVI DISPLACE,X'00' PUT DISPLACEMENT IN WORK AREA 60600013 BR RETURN 60900013 * 61200013 MSGSWTCH EQU * 61500013 LH COUNTREG,CHARCNT COUNT OF CHARACTERS 61800013 BCTR IOREG,0 ALLOW SPACE FOR RESTORE CHAR 62100013 MVI 0(IOREG),X'75' MOVE RESTORE CHARACTER 62400013 ST IOREG,32(CCWREG) PUT ADDRESS IN CCW 62700013 MVI 32(CCWREG),X'01' RESTORE OP CODE 63000013 LA WORKREG,0(COUNTREG,IOREG) ADDRESS OF LAST DATA CHAR. 63300013 MVI 0(WORKREG),X'3D' PUT EOB AT END 63600013 LA COUNTREG,1(COUNTREG) UP COUNT TO INCLUDE RESTORE 63900013 STC COUNTREG,39(CCWREG) PUT IN CCW 64200013 * 64500013 MVI DISPLACE,X'00' SET DISPLACEMENT FOR RESIDENT 64800013 BR RETURN 65100013 * 65400013 * 65700013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 66000013 BR RETURN 66300013 EJECT 66600013 * 66900013 * PATTERN OF DATA FOR 1060 TESTS 67200013 * 67500013 TILT DC AL1(TILTEND-TILT) 67800013 DC X'6123294F2C4A702664327637732567' 68100013 DC X'312A4C2F4962585B5E5E5E5E5E5E40' * TILT * 68400013 DC X'1508680D6D51104504571652134607' * TEST * 68700013 DC X'0B6B0E6E4302755E5E5E5E5E5E3D' 69000013 TILTEND EQU * 69300013 * 69600013 ROTATE DC AL1(ROTATEND-ROTATE) 69900013 DC X'61622C2A647343400B0D524523584A' 70200013 DC X'4C322502156B6D5B5E5E5E5E5E5E13' * ROTATE * 70500013 DC X'046E680710164F492631370E084651' * TEST * 70800013 DC X'57292F706776755E5E5E5E5E5E3D' 71100013 ROTATEND EQU * 71400013 * 71700013 TWIST DC AL1(TWISTEND-TWIST) 72000013 DC X'6115234029684F082C6D4A0D701026' 72300013 DC X'516404324576165B5E5E5E5E5E5E02' * TWIST * 72600013 DC X'6243586E2F0E496B2A0B4C07674631' * TEST * 72900013 DC X'137352253757755E5E5E5E5E5E3D' 73200013 TWISTEND EQU * 73500013 * 73800013 ALLCHAR DC AL1(ALLCHARX-ALLCHAR) 74100013 DC X'15020407080B0D0E1013626467686B6D' * ALL CHARACTER * 74400013 DC X'6E7073434546494A4C4F51522526292A' 74700013 DC X'2C2F3132755E5E5E5E5E5E3D' * TEST MESSAGE * 75000013 ALLCHARX EQU * 75300013 * 75600013 ANALYZER DC AL1(ANALYZEX-ANALYZER) 75900013 DC X'02010401070108010B010D010E011367' *SELECTRIC* 76200013 DC X'010101254F62676B5B01010101010101' * ANALYZER* 76500013 DC X'01010101010101010101675B5E5E5E46' * TEST * 76800013 DC X'6D3B5E5E023B5E5E043B5E5E07753D' 77100013 ANALYZEX EQU * 77400013 EJECT 77700013 * 78000013 * CCW'S 78300013 * 78600013 CHANPROG CCW X'01',0,X'A0',4 WRITE CIRCLE Y, C'S, S 78900013 CCW X'01',0,X'60',2 WRITE ADDRESSING CHARACTERS 79200013 CCW X'02',0,X'60',1 READ ADDRESSING RESPONSE 79500013 CCW X'01',0,X'A0',20 WRITE CARRIAGE RETURN AND IDLES 79800013 CCW X'01',0,X'60',0 WRITE THE TEST MESSAGE 80100013 CCW X'02',0,X'20',1 READ THE LRC RESPONSE 80400013 * 80700013 * ADDRESSES OF DATA TO BE MOVED TO PATTERN BUFFER 81000013 * 81300013 DATAADDR EQU * 81600013 LA FROMREG,TILT 81900013 LA FROMREG,ROTATE 82200013 LA FROMREG,TWIST 82500013 LA FROMREG,ALLCHAR 82800013 LA FROMREG,ANALYZER 83100013 * 83400013 * 83700013 * CONSTANTS 84000013 * 84300013 EXMVC MVC 0(1,TOREG),0(FROMREG) 84600013 VALIDMSG DC X'67494F012A4668753D' VALID COMPARE MESSAGE 84900013 CMPDATA DC X'0D0B0708040215' COMPARISON DATA 85200013 TESTCODE DC X'181C20002428' 85500013 EJECT 85800013 * INPUT AREA DEFINITION 86100013 * 86400013 ONLTBUF DSECT 86700013 ECB DS 8C 87000013 CCWBYTES DS 0C COUNT OF CCW AREA 87300013 CCWAREA DS 4C ADDRESS OF CCW AREA 87600013 SAVE DS 0C 87900013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 88200013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 88500013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 88800013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 89100013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 89400013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 89700013 DEVICETP DS 1C DEVICE TYPE CODE 90000013 FEATURES DS 0C FEATURES CODE 90300013 RESPONSE DS 1C FOR RESPONSES 90600013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 90900013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 91200013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 91500013 * 91800013 * PARAMETER LIST DEFINITION 92100013 * 92400013 PARAMLST DSECT 92700013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 93000013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 93300013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 93600013 NOTEST DS 1C NO TEST SWITCH 93900013 * 94200013 * EQUATES 94500013 * 94800013 GETMAIN EQU 1 95100013 WORKREG EQU 2 95400013 PARREG EQU 3 95700013 FROMREG EQU 4 96000013 TOREG EQU 5 96300013 BASEREG EQU 6 96600013 IOREG EQU 7 96900013 TESTREG EQU 8 97200013 PATRNREG EQU 9 97500013 CCWREG EQU 10 97800013 COUNTREG EQU 11 98100013 BUFREG EQU 12 98400013 WORKREG2 EQU 13 98700013 RETURN EQU 14 99000013 LINKREG EQU 15 99300013 END 99600013 ./ ADD SSI=01012301,NAME=IGC0407G,SOURCE=0 TITLE 'IGC0407G-2740 TERMINAL TEST MODULE.' 00200013 * 00400013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00600013 * 00800013 * 01000013 * FUNCTION - GENERATE CHANNEL PROGRAM FOR 2740 ON LINE TESTS 01200013 * 01400013 * 01600013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM HEADER ANALYSIS 01800013 * MODULE 02000013 * 02200013 * 02400013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 02600013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 02800013 * REGISTER 14 - RETURN ADDRESS 03000013 * 03200013 * 03400013 * OUTPUT - 1. GENERATED CHANNEL PROGRAM 03600013 * 2. UPDATED USAGE COUNT AND POINTER IN RESIDENT 03800013 * TERMINAL TEST MODULE (IECKONLT). 04000013 * 04200013 * 04400013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 04600013 * 04800013 * 05000013 * EXIT - RETURN TO ADDRESS IN REGISTER 14 05200013 * 05400013 * 05600013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND THE HEADER IS 05800013 * VALIDATED. IT IS ANALYZED FOR TYPE OF REQUEST. 06000013 * CORE IS OBTAINED AND CCW'S FOR THE PROPER DATA AND 06200013 * CONTROL PURPOSES ARE FORMED IN THE AREA. IF THE 06400013 * REQUESTED DATA PATTERN IS NOT IN USE, CORE WILL BE 06600013 * OBTAINED AND THE PATTERN MOVED INTO THE NEW AREA. 06800013 * IF NO CORE IS AVAILABLE, THE TEST REQUEST WILL BE 07000013 * SWITCHED TO THE TERMINAL SPECIFIED IN THE TEST 07200013 * REQUEST. IF THE REQUEST IS FOR A STORED DATA 07400013 * COMPARISON AND THE DATA ARE NOT CORRECT, THE INPUT 07600013 * MESSAGE WILL BE SWITCHED. NO SUBROUTINES ARE USED. 07800013 * 08000013 * 08200013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 08400013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 08600013 * REENTRANT. 08800013 * 09000013 EJECT 09200013 IGC0407G CSECT 09400013 *1201338000 000D 09500018 * 330000 24942 09550018 * 09600013 * 09800013 * ESTABLISH ADDRESSABILITY 10000013 BALR BASEREG,0 10200013 USING *,BASEREG 10400013 USING ONLTBUF,BUFREG 10600013 USING PARAMLST,PARREG 10800013 * LOAD OTHER BASE REGISTERS 11000013 LR PARREG,1 11200013 L BUFREG,ECBADDR 11400013 LR IOREG,0 11600013 * GET CORE FOR CCW'S, ETC. 11800013 L PATRNREG,PATRNLST ADDRESS OF PATTERN TABLE 12000013 L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 12200013 LA WORKREG,CCWAREA ADDRESS FOR ADDRESS OF AREA 12400013 ST WORKREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 12600013 LA WORKREG,88 COUNT OF BYTES TO OBTAIN 12800013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 13000013 SVC 4 ISSUE GETMAIN SVC 13200013 NR 15,15 TEST FOR ZERO RETURN CODE 13400013 BNZ RESTART NON ZERO IS NO CORE FOR CCW'S 13600013 L CCWREG,CCWAREA ADDRESS OF CCWAREA 13800013 LA CCWREG,24(CCWREG) ALLOW FOR STCB AREA 14000013 XC 0(64,CCWREG),0(CCWREG) CLEAR AREA 14200013 LA DATAREG,32(CCWREG) POINT TO SPECIAL DATA AREA 14400013 MVI CCWBYTES,88 PUT COUNT IN FOR RESIDENT MOD. 14600013 * TEST FEATURES TO DETERMINE CHANNEL 14800013 * PROGRAM REQUIRED 15000013 TM FEATURES,X'08' TEST FOR STATION CONTROL 15200013 BO STC ONE IS YES 15400013 TM FEATURES,X'90' TEST FOR DIAL 15600013 BNZ DIAL EITHER ONE IS YES 15800013 * BASIC--NO STC AND NO DIAL 16000013 MVI 7(CCWREG),32 COUNT FOR THIS CCW 16200013 BAL LINKREG,SETCCW SETUP THIS CCW 16400013 MVI 0(DATAREG),X'16' CIRCLE D 16600013 LA DATAREG,1(DATAREG) UP POINTER 16800013 MVI 0(DATAREG),X'5E' MOVE FIFTEEN IDLES INTO DATA 17000013 BAL LINKREG,FIFTEEN AREA 17200013 B MOVECR 17400013 * CHECK FOR ANSWER OR DIAL LIST 17600013 DIAL EQU * 17800013 L WORKREG,DIALINFO ADDRESS OF DIAL INFORMATION 18000013 CLI 5(IOREG),X'15' 18200013 BNE DIALST NOT EQUAL-SEND DIAL DIGITS 18400013 * SET UP CCW FOR CIRCLE D, CR AND PADS 18600013 SETCCWD EQU * 18800013 MVI 7(CCWREG),17 COUNT FOR THIS CCW 19000013 BAL LINKREG,SETCCW SETUP THIS CCW 19200013 MOVED MVI 0(DATAREG),X'16' CIRCLE D 19400013 LA DATAREG,1(DATAREG) UP POINTER 19600013 MOVECR MVI 0(DATAREG),X'5B' CARRIER RETURN 19800013 LA DATAREG,1(DATAREG) UP POINTER 20000013 MVI 0(DATAREG),X'DF' MOVE FIFTEEN PADS INTO DATA 20200013 BAL LINKREG,FIFTEEN AREA 20400013 * DETERMINE TEST CODE 20600013 CLI 6(IOREG),X'02' BRANCH IF 20800013 BE MSGSWTCH SWITCH TEST (1) 21000013 CLI 6(IOREG),X'0B' BRANCH IF 21200013 BE COMPARE COMPARE TEST 21400013 * HANDLE THIS PATTERN REQUEST 21600013 SR TESTREG,TESTREG CLEAR TEST REGISTER 21800013 IC TESTREG,6(IOREG) INSERT TEST SELECT CHARACTER 22000013 SRA TESTREG,1 SHIFT OUT PARITY BIT 22200013 BZ RESTART ZERO IS NOT VALID 22400013 IC TESTREG,TESTCODE-2(TESTREG) SET UP INDEXING 22600013 LA TABLEREG,0(TESTREG,PATRNREG) ADDRESS OF TABLE ENTRY 22800013 CLI 0(TABLEREG),X'00' BRANCH IF THIS PATTERN 23000013 BE NOTINUSE IS NOT IN USE 23200013 IC WORKREG,0(TABLEREG) 1-UP 23400013 LA WORKREG,1(WORKREG) USAGE 23600013 STC WORKREG,0(TABLEREG) COUNT 23800013 * FINISH DATA CCW 24000013 L WORKREG,0(TABLEREG) ADDRESS OF DATA AREA 24200013 FINCCW EQU * 24400013 IC TABLEREG,0(WORKREG) COUNT OF BYTES IN AREA 24600013 BCTR TABLEREG,0 BYPASS COUNT BYTE 24800013 STC TABLEREG,7(CCWREG) PUT IN CCW 25000013 LA WORKREG,1(WORKREG) UP ADDRESS PAST COUNT BYTE 25200013 ST WORKREG,0(CCWREG) PUT IN CCW 25400013 MVI 0(CCWREG),X'01' WRITE OP 25600013 * 25800013 STC TESTREG,DISPLACE FLAG FOR RESIDENT MODULE 26000013 BR RETURN 26200013 * 26400013 * SET UP DIAL CHANNEL PROGRAM 26600013 DIALST EQU * 26800013 MVI 0(CCWREG),X'2F' DISABLE OP 27000013 MVI 4(CCWREG),X'60' FLAGS--CC,SLI 27200013 MVI 7(CCWREG),X'01' COUNT 27400013 * 27600013 MVC 15(1,CCWREG),0(WORKREG) COUNT OF DIAL DIGITS 27800013 MVI 12(CCWREG),X'60' FLAGS--CC,SLI 28000013 LA WORKREG,1(WORKREG) ADDRESS OF DIAL DIGITS 28200013 ST WORKREG,8(CCWREG) PUT IN CCW 28400013 MVI 8(CCWREG),X'29' DIAL OP 28600013 * 28800013 LA CCWREG,16(CCWREG) UP CCW POINTER 29000013 MVI 7(CCWREG),32 COUNT FOR THIS CCW 29200013 BAL LINKREG,SETCCW SET UP THIS CCW 29400013 MVI 0(DATAREG),X'DF' MOVE FIFTEEN PADS INTO DATA 29600013 BAL LINKREG,FIFTEEN AREA 29800013 * 30000013 B MOVED 30200013 * 30400013 * SET UP STATION CONTROL CHANNEL PROGRAM 30600013 STC EQU * 30800013 MVC 0(7,DATAREG),=X'161F1F1F370001' CONTROL CHARACTERS 31000013 MVC 5(1,DATAREG),ADDRESS ADDRESSING CHARACTER 31200013 CLI 5(IOREG),X'15' TEST FOR FORMAT ZERO 31400013 BNE *+10 BRANCH IF FORMAT ZERO 31600013 MVC 5(1,DATAREG),8(IOREG) GET ADDRESSING FROM MESSAGE 31800013 ST DATAREG,0(CCWREG) PUT ADDRESS IN CCW 32000013 MVI 0(CCWREG),X'01' WRITE OP 32200013 MVI 4(CCWREG),X'60' FLAGS--CC,SLI 32400013 MVI 7(CCWREG),7 LOAD COUNT 32600013 * 32800013 LA WORKREG,0(CCWREG) ADDRESS OF RESPONSE AREA 24942 33000018 ST WORKREG,8(CCWREG) PUT IN CCW 33200013 MVI 8(CCWREG),X'02' READ OP 33400013 MVI 12(CCWREG),X'60' FLAGS--CC,SLI 33600013 MVI 15(CCWREG),2 COUNT 000D 33800018 * 34000013 LA CCWREG,16(CCWREG) UP CCW POINTER 34200013 LA DATAREG,7(DATAREG) UP SPECIAL AREA POINTER 34400013 B SETCCWD 34600013 * GET CORE FOR THIS PATTERN 34800013 NOTINUSE EQU * 35000013 L GETMAIN,0(PATRNREG) ADDRESS OF GETMAIN CONSTANTS 35200013 EX 0,DATAADDR-4(TESTREG) ADDRESS OF DATA TO MOVE 35400013 ST TOREG,4(GETMAIN) PUT TABLE ENTRY ADDR IN CONST 35600013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 35800013 IC WORKREG,0(FROMREG) CHARACTER COUNT OF DATA 36000013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 36200013 SVC 4 ISSUE GETMAIN SVC 36400013 NR 15,15 TEST FOR ZERO RETURN CODE 36600013 BNZ MSGSWTCH NON-ZERO IS NO CORE AVAILABLE 36800013 MVI 0(TOREG),X'01' SET USAGE COUNT TO ONE 37000013 L TOREG,0(TOREG) GET ADDRESS OF DATA AREA 37200013 BCTR WORKREG,0 ADJUST COUNT FOR MVC INST 37400013 EX WORKREG,EXMVC MOVE THE DATA 37600013 LR WORKREG,TOREG RESTORE POINTER 37800013 B FINCCW FINISH THE CCW 38000013 * SWITCH THE MESSAGE 38200013 MSGSWTCH EQU * 38400013 ST IOREG,0(CCWREG) ADDRESS OF DATA 38600013 MVC 7(1,CCWREG),CHARCNT+1 COUNT OF CHARACTERS IN INPUT 38800013 MVI 0(CCWREG),X'01' WRITE OP 39000013 * 39200013 MVI DISPLACE,X'00' FLAG FOR RESIDENT MODULE 39400013 LH WORKREG,CHARCNT COUNT OF CHARACTERS 39600013 BCTR WORKREG,0 39800013 LA WORKREG,0(WORKREG,IOREG) ADDRESS OF LAST DATA CHARACTER 40000013 MVI 0(WORKREG),X'1F' PUT EOT AT END 40200013 * 40400013 BR RETURN 40600013 * INDICATE NO TEST SET UP 40800013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 41000013 BR RETURN 41200013 * COMPARE RECEIVED DATA 41400013 COMPARE EQU * 41600013 LH COUNTREG,CHARCNT COUNT OF CHARACTERS IN MESSAGE 41800013 CLI 5(IOREG),X'02' TEST FOR FORMAT 1 42000013 BNE FORMAT0C 42200013 SR WORKREG,WORKREG CLEAR WORKING REGISTER 42400013 CLI 8(IOREG),X'15' TEST FOR RETURN TO SOURCE 42600013 BE GETCOUNT EQUAL IS RETURN TO SOURCE 42800013 IC WORKREG,8(IOREG) COUNT OF CHARACTERS IN SYMBOL 43000013 SRA WORKREG,1 SHIFT OUT PARITY BIT 43200013 GETCOUNT EQU * 43400013 SH COUNTREG,=H'10' ADJUST FOR HEADER 43600013 SR COUNTREG,WORKREG ADJUST FOR SYMBOL 43800013 LA WORKREG,9(WORKREG,IOREG) ADDRESS OF FIRST CHAR TO COMP 44000013 COMPARE5 BZ CMPVALID NO DATA TO BE COMPARED 44200013 LA WORKREG2,ALLCHAR+1 ADDRESS OF FIRST COMPARE CHAR 44400013 BCTR COUNTREG,0 ADJUST FOR CLC INSTRUCTION 44600013 EXCLC CLC 0(1,WORKREG),0(WORKREG2) DUMMY INSTRUCTION 44800013 EX COUNTREG,EXCLC DO THE COMPARE 45000013 BNE MSGSWTCH 45200013 COMPARE4 MVC 0(11,IOREG),VALIDCMP MOVE IN VALID COMPARE MESSAGE 45400013 IC WORKREG,0(WORKREG2,COUNTREG) LAST CHARACTER COMPARED 45600013 STC WORKREG,8(IOREG) COMPLETE MESSAGE 45800013 * PREPARE DATA CCW 46000013 COMPARE3 MVI 7(CCWREG),11 COUNT 46200013 ST IOREG,0(CCWREG) ADDRESS 46400013 MVI 0(CCWREG),X'01' WRITE OP 46600013 MVI DISPLACE,X'00' SET DISPLACEMENT FOR RESIDENT 46800013 BR RETURN 47000013 * 47200013 CMPVALID EX 0,COMPARE4 MOVE IN VALID COMPARE MESSAGE 47400013 B COMPARE3 47600013 * FORMAT 0 ADJUSTMENTS 47800013 FORMAT0C EQU * 48000013 LA WORKREG,10(IOREG) ADJUST DATA POINTER 48200013 SH COUNTREG,=H'11' ADJUST COUNT 48400013 B COMPARE5 COMPLETE COMPARE 48600013 * ESTABLISH CCW FOR SPECIAL CHARACTERS 48800013 SETCCW EQU * 49000013 ST DATAREG,0(CCWREG) ADDRESS 49200013 MVI 0(CCWREG),X'01' OPERATION 49400013 MVI 4(CCWREG),X'A0' FLAGS--CD,SLI 49600013 LA CCWREG,8(CCWREG) UP TO NEXT POSITION 49800013 MVI 4(CCWREG),X'20' FLAG--SLI 50000013 BR LINKREG 50200013 * MOVE 15 OF A CHARACTER INTO DATA AREA 50400013 FIFTEEN EQU * 50600013 MVC 1(14,DATAREG),0(DATAREG) MOVE CHARACTER 14 TIMES 50800013 LA DATAREG,15(DATAREG) UP DATA POINTER 51000013 BR LINKREG 51200013 EJECT 51400013 * CONSTANTS 51600013 * 51800013 TESTCODE DC X'04080C001014' 52000013 EXMVC MVC 0(1,TOREG),0(FROMREG) 52200013 VALIDCMP DC X'E7C9CF81AAC6E840235B1F' VALID COMPARE MESSAGE 52400013 * 52600013 * PATTERN OF DATA FOR 2740 TESTS 52800013 * 53000013 TILT DC AL1(TILTEND-TILT) 53200013 DC X'622367266B2A6E2F70316120642568296D2C733276375B5E5E5E' 53400013 DC X'5E5E5E573452134C0D49084504401551104F0E4A0B460743025B' 53600013 DC X'5E5E5E5E5E5E1F' 53800013 TILTEND EQU * 54000013 * 54200013 ROTATE DC AL1(ROTATEND-ROTATE) 54400013 DC X'62766B6D706443574A4C514523372A23312502340B0D5B5E5E5E' 54600013 DC X'5E5E5E100407130E081526322F292046524F494067736E68615B' 54800013 DC X'5E5E5E5E5E5E1F' 55000013 ROTATEND EQU * 55200013 * 55400013 TWIST DC AL1(TWISTEND-TWIST) 55600013 DC X'E234A357E713A652EB0DAA4CEE08AF49F004B145E1155B5E5E5E' 55800013 DC X'5E5E5E8276C3378773C6328B6DCA2C8E68CF299064D125A0405B' 56000013 DC X'5E5E5E5E5E5E1F' 56200013 TWISTEND EQU * 56400013 * 56600013 ALLCHAR DC AL1(ALLCHARX-ALLCHAR) 56800013 DC X'15020407080B0D0E1013626467686B6D6E7073434546494A4C4F' 57000013 DC X'51522526292A2C2F31325B5E5E5E5E5E5EE2E4E7E8EBEDEEF0F3' 57200013 DC X'C3C5C6C9CACCCFD1D2A5A6A9AAACAFB1B25B5E5E1F' 57400013 ALLCHARX EQU * 57600013 * 57800013 ANALYZER DC AL1(ANALYZEX-ANALYZER) 58000013 DC X'020407080B016701130101250162016B616445254F5D5D5D5D5D' 58200013 DC X'5D5D5D5D5D5D5D155D5D5D105D5D5D0D0101010101014F01675B' 58400013 DC X'01010101010101675E5B5E5E5E466D3B5E5E023B5E5E043B5E5E' 58600013 DC X'075B1F' 58800013 ANALYZEX EQU * 59000013 * 59200013 * ADDRESSES OF DATA TO BE MOVED TO PATTERN BUFFER 59400013 * 59600013 DS 0H 59800013 DATAADDR EQU * 60000013 LA FROMREG,TILT 60200013 LA FROMREG,ROTATE 60400013 LA FROMREG,TWIST 60600013 LA FROMREG,ALLCHAR 60800013 LA FROMREG,ANALYZER 61000013 EJECT 61200013 * 61400013 * EQUATES 61600013 * 61800013 DATAREG EQU 1 62000013 GETMAIN EQU 1 62200013 WORKREG EQU 2 62400013 PARREG EQU 3 62600013 FROMREG EQU 4 62800013 BUFREG EQU 5 63000013 BASEREG EQU 6 63200013 IOREG EQU 7 63400013 TESTREG EQU 8 63600013 PATRNREG EQU 9 63800013 CCWREG EQU 10 64000013 COUNTREG EQU 11 64200013 WORKREG2 EQU 12 64400013 LINKREG EQU 13 64600013 TABLEREG EQU 13 64800013 TOREG EQU 13 65000013 RETURN EQU 14 65200013 EJECT 65400013 * 65600013 * INPUT AREA DEFINITION 65800013 * 66000013 ONLTBUF DSECT 66200013 ECB DS 8C 66400013 CCWBYTES DS 0C COUNT OF CCW AREA 66600013 CCWAREA DS 4C ADDRESS OF CCW AREA 66800013 SAVE DS 0C 67000013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 67200013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 67400013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 67600013 CVTAREA DS 0C 67800013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 68000013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 68200013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 68400013 DEVICETP DS 1C DEVICE TYPE CODE 68600013 FEATURES DS 0C FEATURES CODE 68800013 RESPONSE DS 1C FOR RESPONSES 69000013 SAVLNGTH DS 0C 69200013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 69400013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 69600013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 69800013 UCBADDR DS 4C SAVE AREA FOR UCB ADDRESS 70000013 OFFSET EQU ONLTBUF+10 70200013 * 70400013 * PARAMETER LIST DEFINITION 70600013 * 70800013 PARAMLST DSECT 71000013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 71200013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 71400013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 71600013 NOTEST DS 1C NO TEST SWITCH 71800013 END 72000013 ./ ADD SSI=02013300,NAME=IGC0507G,SOURCE=0 TITLE 'IGC0507G-2848 TERMINAL TEST MODULE 1.' 00300013 * 00600013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00900013 * 01200013 * 01500013 * FUNCTION - BEGIN GENERATION OF CHANNEL PROGRAM FOR 2848 01800013 * ON LINE TESTS. 02100013 * 02400013 * 02700013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM HEADER ANALYSIS 03000013 * MODULE 03300013 * 03600013 * 03900013 * INPUT - REGISTER 0 - ADDRESS OF FIRST 9 IN TEST REQUEST 04200013 * REGISTER 1 - ADDRESS OF A PARAMETER LIST 04500013 * REGISTER 14 - RETURN ADDRESS 04800013 * 05100013 * 05400013 * OUTPUT - GENERATED CCWS 05700013 * 06000013 * 06300013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 06600013 * 06900013 * 07200013 * EXITS - 1. TO THE ADDRESS IN REGISTER 14 IF THE TEST 07500013 * REQUEST IS INVALID. 07800013 * 2. TO 2848 TERMINAL TEST MODULE 2 IF THE TEST 08100013 * REQUEST IS VALID. 08400013 * 08700013 * 09000013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND THE HEADER IS 09300013 * VALIDATED. IT IS ANALYZED FOR TYPE OF REQUEST. 09600013 * CORE IS OBTAINED AND CCWS FOR CONTROL PURPOSES 09900013 * ARE FORMED IN THE AREA. ADDRESSING CHARACTERS 10200013 * IN FORMAT ZERO REQUESTS ARE CONVERTED TO ASCII AND 10500013 * THE WRITE-AT-LINE-ADDRESS TEST IS INITIALIZED. 10800013 * A SUBROUTINE -- 11100013 * A. CONVERTS ADDRESSING CHARACTERS. 11400013 * B. VALIDATES THE HEADER. 11700013 * 12000013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 12300013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 12600013 * REENTRANT. 12900013 * 13200013 EJECT 13500013 IGC0507G CSECT 13800013 * 264000,309400-314200,324000-330000,361000-366000,612700-614100 A26768 13900019 * 14100013 * 14400013 * ESTABLISH ADDRESSABILITY 14700013 BALR BASEREG,0 15000013 USING *,BASEREG 15300013 USING ONLTBUF,BUFREG 15600013 USING PARAMLST,PARREG 15900013 * LOAD OTHER BASE REGISTERS 16200013 LR PARREG,1 16500013 L BUFREG,ECBADDR 16800013 LR IOREG,0 17100013 * 17400013 * 17700013 * 18000013 CLI DEVICETP,X'81' TEST FOR 2848 DEVICE TYPE 18300013 MVI NOTEST,X'1A' SET SEQUENCE INDICATOR 18600013 BNE RESTART BRANCH IF NOT 18900013 CLI 6(IOREG),X'59' BRANCH IF ADDRESS RETURN TEST 19200013 BE CALL2260 19500013 MVI NOTEST,X'2A' SET SEQUENCE INDICATOR 19800013 BH RESTART BRANCH IF INVALID REQUEST 20100013 CLI 6(IOREG),X'51' 20400013 MVI NOTEST,X'3A' SET SEQUENCE INDICATOR 20700013 BL RESTART BRANCH IF INVALID REQUEST 21000013 CLI 6(IOREG),X'57' 21300013 MVI NOTEST,X'4A' SET SEQUENCE INDICATOR 21600013 BE RESTART BRANCH IF INVALID REQUEST 21900013 CLI 5(IOREG),X'51' 22200013 BE FORMAT1 BRANCH IF FORMAT 1 22500013 LA LOOPCNT,4 COUNT OF POSITIONS TO CHECK 22800013 LA LENGTH,11(IOREG) ADDRESS OF LAST POSITION 23100013 BAL LINKREG,TESTHDR CHECK FOR ASCII NUMBERS 23400013 CLC 8(2,IOREG),=X'5051' CHECK FOR DC ADDRESS RANGE OF 23700013 MVI NOTEST,X'5A' SET SEQUENCE INDICATOR 24000013 BL RESTART 01 24300013 CLC 8(2,IOREG),=X'5956' TO 24600013 MVI NOTEST,X'6A' SET SEQUENCE INDICATOR 24900013 BH RESTART 96 25200013 CLC 10(2,IOREG),=X'5051' CHECK FOR DS ADDRESS RANGE OF 25500013 MVI NOTEST,X'7A' SET SEQUENCE INDICATOR 25800013 BL RESTART 01 26100013 CLC 10(2,IOREG),X5257 TO A26768 26400019 MVI NOTEST,X'8A' SET SEQUENCE INDICATOR 26700013 BH RESTART 26 27000013 * 27300013 BAL LINKREG,ASCIIBIN CONVERT DC ADDRESS TO BINARY 27600013 IC WORKREG,8(IOREG) TENS 27900013 IC WORKREG2,9(IOREG) UNITS 28200013 CH WORKREG,=H'33' TEST FOR 1-32 28500013 BL ADD3F 28800013 CH WORKREG,=H'65' TEST FOR 33-64 29100013 BL ADD40 29400013 LA WORKREG,32(WORKREG) ADDRESS IS 65-96 29700013 ADD40 LA WORKREG,64(WORKREG) ADDRESS IS 33 OR MORE 30000013 ADD3F LA WORKREG,63(WORKREG) 30300013 STC WORKREG,ADDRESS PUT DC ADDRESS IN WORK AREA 30600013 * 30900013 CLC 10(2,IOREG),X5256 26 IS DS CODE FOR 2265 A26768 30940019 BE REQ2265 BRANCH IF 26 A26768 30980019 BL CONVDS B IF LESS THAN 26 FOR 2260 A26768 31020019 CLI ADDRESS,X'50' ELSE MUST BE 27 FOR 2845-1053 A26768 31060019 BNL RESTART DC ADDRESS 40-4F FOR 2845 A26768 31100019 MVC ADDRESS+1(1),ADDRESS DV = DC FOR 2845-1053 A26768 31140019 B GOON BYPASS CONVERT A26768 31180019 REQ2265 CLI ADDRESS,X'50' DC ADDRESS IS 40-4F FOR 2845 A26768 31220019 BNL RESTART A26768 31260019 IC WORKREG,ADDRESS ADD 16 TO THE A26768 31300019 LA WORKREG,16(WORKREG) DC ADDRESS FOR THE DV A26768 31340019 B STCDS ADDRESS OF 2265 A26768 31380019 CONVDS BAL LINKREG,ASCIIBIN CONVERT DS ADDRESS TO BIN A26768 31420019 IC WORKREG,10(IOREG) TENS 31500013 IC WORKREG2,11(IOREG) UNITS 31800013 LA WORKREG,159(WORKREG) DEVELOP ADDRESS RESULT 32100013 STCDS STC WORKREG,ADDRESS+1 A26768 32400019 * A26768 32700019 GOON CLI 6(IOREG),X'58' TEST FOR WRITE AT LINE ADDRESS A26768 33000019 BNE NOTEST8 33300013 TESTLINE LA LOOPCNT,2 COUNT OF POSITIONS TO CHECK 33600013 LA LENGTH,13(IOREG) ADDRESS OF LAST POSITION 33900013 BAL LINKREG,TESTHDR CHECK FOR ASCII NUMBERS 34200013 BAL LINKREG,ASCIIBIN CONVERT LINE ADDRESS 34500013 IC WORKREG,12(IOREG) TENS 34800013 IC WORKREG2,13(IOREG) UNITS 35100013 MVI NOTEST,X'9A' SET SEQUENCE INDICATOR 35400013 BZ RESTART ZERO IS INVALID 35700013 CH WORKREG,=H'12' 36000013 BNH LINEADOK 12 OR LESS OK FOR 2260 OR 2265 A26768 36100019 TM ADDRESS+1,X'40' TEST IF 2265-2848 A26768 36200019 BNO RESTART IF NOT, LINE ADDRESS INVALID A26768 36300019 CH WORKREG,H15 15 OR LESS OK FOR 2265 A26768 36400019 BH RESTART INVALID IF HIGHER A26768 36500019 LINEADOK LA WORKREG,79(WORKREG) CONVERT TO PROPER ASCII CHAR. A26768 36600019 LR IOREG,0 37200013 BCTR IOREG,0 37500013 STC WORKREG,0(IOREG) PUT LINE ADDRESS IN PLACE 37800013 LR IOREG,0 38100013 NOTEST8 EQU * 38400013 CALL2260 EQU * 38700013 * GET CORE FOR CCW'S 39000013 L PATRNREG,PATRNLST 39300013 L GETMAIN,0(PATRNREG) 39600013 LA WORKREG,CCWAREA ADDRESS FOR ADDRESS OF AREA 39900013 ST WORKREG,4(GETMAIN) PUT IN GETMAIN CONSTANTS 40200013 LA WORKREG,56 COUNT OF BYTES TO GET 40500013 ST WORKREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 40800013 SVC 4 ISSUE GETMAIN SVC 41100013 NR 15,15 TEST FOR ZERO RETURN CODE 41400013 MVI NOTEST,X'BA' SET SEQUENCE INDICATOR 41700013 BNZ RESTART NON ZERO IS NO CORE FOR CCW'S 42000013 L CCWREG,CCWAREA ADDRESS OF CCW AREA 42300013 LA CCWREG,24(CCWREG) ALLOW FOR STCB AREA 42600013 MVC 0(32,CCWREG),CHANPROG MOVE CCW'S INTO PLACE 42900013 MVI CCWBYTES,56 PUT COUNT IN FOR RESIDENT MOD. 43200013 * BUILD CHANNEL PROGRAM EXCEPT DATA CCW 43500013 LA WORKREG,RESPONSE ADDRESS FOR RESPONSES 43800013 ST WORKREG,8(CCWREG) PUT IN CCW FOR ADDRESS RESPONSE 44100013 MVI 8(CCWREG),X'02' RESTORE OP CODE 44400013 * 44700013 MVC 25(3,CCWREG),9(CCWREG) FOR LRC RESPONSE 45000013 * 45300013 LA WORKREG,ADDR2260 ADDRESS OF STX, ETC. 45600013 ST WORKREG,0(CCWREG) PUT IN CCW 45900013 MVI 0(CCWREG),X'01' RESTORE OP CODE 46200013 * SET UP CONSTANTS 46500013 MVI ADDR2260,X'02' PUT STX IN BUFFER 46800013 MVI ADDR2260+1,X'04' PUT EOT IN BUFFER 47100013 MVI ADDR2260+4,X'A0' PUT OP CODE IN BUFFER 47400013 * 47700013 LR 15,PARREG 48000013 SH 15,=H'16' 48300013 MVC 8(8,15),=C'IGC0607G' 48600013 SVC 7 48900013 * 49200013 FORMAT1 EQU * 49500013 CLI 6(IOREG),X'58' TEST IF WRITE AT LINE ADDRESS 49800013 BNE NOTEST8 50100013 IC LENGTH,8(IOREG) COUNT OF CHARACTERS IN SYMBOL 50400013 N LENGTH,=F'15' DROP ZONE BITS 50700013 SH LENGTH,=H'3' ADJUST DISPLACEMENT 51000013 AR IOREG,LENGTH COMPUTE IOREG 51300013 B TESTLINE CONTINUE 51600013 * 51900013 * CONVERT TWO ASCII DIGITS TO A BINARY NUMBER ENTRY IS-- 52200013 * 52500013 * BAL LINKREG,ASCIIBIN 52800013 * IC WORKREG,TENSCHAR RESULT IS RETURNED IN WORKREG 53100013 * IC WORKREG2,UNITCHAR 53400013 * 53700013 DS 0H 54000013 ASCIIBIN EQU * 54300013 SR WORKREG,WORKREG CLEAR WORKING REGISTERS 54600013 SR WORKREG2,WORKREG2 54900013 EX 0,0(LINKREG) GET TENS CHARACTER 55200013 N WORKREG,=F'15' DROP ZONE BITS 55500013 MH WORKREG,=H'10' CONVERT TO TENS FACTOR 55800013 EX 0,4(LINKREG) GET UNITS CHARACTER 56100013 N WORKREG2,=F'15' DROP ZONE BITS 56400013 AR WORKREG,WORKREG2 DEVELOP FINAL RESULT 56700013 B 8(LINKREG) RETURN 57000013 * 57300013 TESTHDR CLI 0(LENGTH),X'50' 57600013 MVI NOTEST,X'CA' SET SEQUENCE INDICATOR 57900013 BL RESTART BRANCH IF NOT A NUMBER 58200013 CLI 0(LENGTH),X'59' 58500013 MVI NOTEST,X'DA' SET SEQUENCE INDICATOR 58800013 BH RESTART BRANCH IF NOT A NUMBER 59100013 BCTR LENGTH,0 BACK UP A CHARACTER 59400013 BCT LOOPCNT,TESTHDR TEST NEXT CHARACTER IF ANY LEFT 59700013 BR LINKREG RETURN 60000013 * 60300013 * NO TEST SET UP--RETURN TO RESIDENT MODULE 60600013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 60900013 BR RETURN 61200013 X5256 DC X'5256' DV CONSTANT FOR 2265 A26768 61270019 X5257 DC X'5257' DV CONSTANT FOR 2845-1053 A26768 61340019 H15 DC H'15' A26768 61410019 EJECT 61500013 * 61800013 * CCW'S 62100013 * 62400013 F15 CCW X'00',15,X'60',5 STX, EOT, ADDRESS, OPERATION 62700013 CCW X'02',0,X'60',1 READ ADDRESSING RESPONSE 63000013 H65 CCW X'01',65,X'60',42 WRITE THE TEST MESSAGE 63300013 CCW X'02',0,X'20',1 READ THE LRC RESPONSE 63600013 CHANPROG EQU F15 63900013 * 64200013 * REGISTERS 64500013 * 64800013 GETMAIN EQU 1 65100013 LINKREG EQU 2 65400013 PATRNREG EQU 2 65700013 PARREG EQU 3 66000013 LOOPCNT EQU 4 66300013 TESTREG EQU 4 66600013 COUNTREG EQU 5 66900013 BASEREG EQU 6 67200013 IOREG EQU 7 67500013 WORKREG EQU 8 67800013 WORKREG2 EQU 9 68100013 CCWREG EQU 10 68400013 FROMADDR EQU 11 68700013 FROMREG EQU 11 69000013 TOADDR EQU 12 69300013 TOREG EQU 12 69600013 BUFREG EQU 13 69900013 RETURN EQU 14 70200013 LENGTH EQU 10 70500013 * 70800013 EJECT 71100013 * 71400013 * INPUT AREA DEFINITION 71700013 * 72000013 ONLTBUF DSECT 72300013 ECB DS 8C 72600013 CCWBYTES DS 0C COUNT OF CCW AREA 72900013 CCWAREA DS 4C ADDRESS OF CCW AREA 73200013 SAVE DS 0C 73500013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 73800013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 74100013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 74400013 CVTAREA DS 0C 74700013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 75000013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 75300013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 75600013 DEVICETP DS 1C DEVICE TYPE CODE 75900013 FEATURES DS 0C FEATURES CODE 76200013 RESPONSE DS 1C FOR RESPONSES 76500013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 76800013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 77100013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 77400013 UCBADDR DS 4C SAVE AREA FOR UCB ADDRESS 77700013 * 78000013 * PARAMETER LIST DEFINITION 78300013 * 78600013 PARAMLST DSECT 78900013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 79200013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 79500013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 79800013 NOTEST DS 1C NO TEST SWITCH 80100013 END 80400013 ./ ADD SSI=01011960,NAME=IGC0607G,SOURCE=0 TITLE 'IGC0607G-2848 TERMINAL TEST MODULE 2.' 00300013 * 00600013 * STATUS - CHANGE LEVEL 000 MARCH 1, 1967 00900013 * 01200013 * 01500013 * FUNCTION - COMPLETE GENERATION OF CHANNEL PROGRAM FOR 2848 01800013 * ON LINE TESTS. 02100013 * 02400013 * 02700013 * ENTRY POINT - ENTRY IS TO FIRST INSTRUCTION FROM 2848 TERMINAL 03000013 * TEST MODULE 1. 03300013 * 03600013 * 03900013 * INPUT - REGISTER 2 - ADDRESS OF PATTERN LIST 04200013 * REGISTER 3 - ADDRESS OF PARAMETER LIST 04500013 * REGISTER 4 - PATTERN LIST OFFSET 04800013 * REGISTER 7 - ADDRESS OF FIRST 9 IN TEST REQUEST 05100013 * REGISTER 10 - ADDRESS OF FIRST CCW 05400013 * REGISTER 13 - ADDRESS OF BUFFER 05700013 * REGISTER 14 - RETURN ADDRESS 06000013 * 06300013 * 06600013 * OUTPUT - 1. GENERATED CHANNEL PROGRAM 06900013 * 2. UPDATED USAGE COUNT AND POINTER IN RESIDENT 07200013 * TERMINAL TEST MODULE (IECKONLT). 07500013 * 07800013 * 08100013 * EXTERNAL ROUTINE -SVC 4 ROUTINE (GETMAIN) 08400013 * 08700013 * 09000013 * EXIT - RETURN TO ADDRESS IN REGISTER 14 09300013 * 09600013 * 09900013 * INLINE ROUTINES - THE INPUT MESSAGE IS LOCATED AND ANALYZED FOR 10200013 * TYPE OF REQUEST. A DATA CCW IS FORMED IN THE CCW 10500013 * AREA. IF THE REQUESTED DATA PATTERN IS NOT IN USE, 10800013 * CORE WILL BE OBTAINED AND THE PATTERN MOVED INTO 11100013 * THE NEW AREA. IF NO CORE IS AVAILABLE, THE TEST 11400013 * REQUEST WILL BE SWITCHED TO THE TERMINAL SPECIFIED 11700013 * IN THE TEST REQUEST. IF THE REQUEST IS FOR A 12000013 * STORED DATA COMPARE AND THE DATA ARE NOT CORRECT, 12300013 * THE INPUT MESSAGE WILL BE SWITCHED. A SUBROUTINE 12600013 * CONVERTS ASCII TO BINARY FOR REQUEST ADDRESS TEST. 12900013 * 13200013 * 13500013 * ATTRIBUTES - THIS ROUTINE IS EXECUTED IN THE SVC TRANSIENT AREA 13800013 * AS A TYPE 4 SVC ROUTINE, ENABLED,PRIVILEGED AND 14100013 * REENTRANT. 14400013 * 14700013 EJECT 15000013 IGC0607G CSECT 15300013 * 504000 00PS 15400000 * 525200-527000,534000,556000-564000,844000-845000 A26768 15500000 * 402000 00PS 15550000 * 15600013 * 15900013 * 16200013 * ESTABLISH ADDRESSABILITY 16500013 BALR BASEREG,0 16800013 USING *,BASEREG 17100013 USING ONLTBUF,BUFREG 17400013 USING PARAMLST,PARREG 17700013 * 18000013 CLI 6(IOREG),X'58' CHECK FOR TYPE 8 REQUEST 18300013 BNE CHECKREQ 18600013 MVI ADDR2260+4,X'B0' PUT IN OP FOR TYPE 8 REQUEST 18900013 * WRITE AT LINE REQUEST 19200013 BCTR IOREG,0 ALLOW FOR LINE ADDRESS 19500013 LH WORKREG,CHARCNT BUMP CHARACTER COUNT TO ALLOW 19800013 LA WORKREG,1(WORKREG) FOR LINE ADDRESS CHARACTER 20100013 B MSGSWCH1 ENTER MESSAGE SWITCH ROUTINE 20400013 * SWITCH THE INPUT MESSAGE 20700013 MSGSWTCH EQU * 21000013 LH WORKREG,CHARCNT NUMBER OF CHARACTERS 21300013 MSGSWCH1 EQU * 21600013 LA WORKREG,1(WORKREG) ALLOW FOR STX IN COUNT 21900013 STC WORKREG,23(CCWREG) PUT COUNT IN CCW 22200013 BCTR IOREG,0 ALLOW FOR STX IN ADDRESS 22500013 ST IOREG,16(CCWREG) PUT ADDRESS IN CCW 22800013 MVI 16(CCWREG),X'01' RESTORE OP CODE 23100013 MVI 0(IOREG),X'02' PUT STX IN MESSAGE 23400013 LA WORKREG,0(WORKREG,IOREG) FIND ADDRESS TO PUT IN ETX 23700013 BCTR WORKREG,0 24000013 MVI 0(WORKREG),3 PUT IN THE ETX 24300013 * 24600013 MVI DISPLACE,X'00' FLAG DISPLACEMENT FOR MESSAGE 24900013 BR RETURN SWITCH AND RETURN 25200013 * CHECK TEST REQUEST 25500013 CHECKREQ EQU * 25800013 BH REQADDR 59 BRANCH IF REQUEST ADDRESS 26100013 CLI 6(IOREG),X'51' BRANCH IF 26400013 BE MSGSWTCH MESSAGE SWITCH 26700013 CLI 6(IOREG),X'55' BRANCH IF 27000013 BE COMPARE COMPARE TEST 27300013 * HANDLE THIS PATTERN 27600013 SR TESTREG,TESTREG CLEAR TEST REGISTER 27900013 IC TESTREG,6(IOREG) INSERT TEST SELECT CHARACTER 28200013 IC TESTREG,TESTCODE-82(TESTREG) SET UP INDEXING 28500013 LA WORKREG,0(TESTREG,PATRNREG) ADDRESS OF PATTERN ENTRY 28800013 CLI 0(WORKREG),X'00' BRANCH IF THIS PATTERN 29100013 BE NOTINUSE IS NOT IN USE 29400013 IC WORKREG2,0(WORKREG) 1-UP 29700013 LA WORKREG2,1(WORKREG2) USAGE 30000013 STC WORKREG2,0(WORKREG) COUNT 30300013 SETDATA EQU * 30600013 L WORKREG2,0(WORKREG) ADDRESS OF DATA AREA 30900013 IC WORKREG,0(WORKREG2) LENGTH OF DATA 31200013 BCTR WORKREG,0 REDUCE PAST COUNT CHARACTER 31500013 STC WORKREG,23(CCWREG) PUT IN CCW 31800013 LA WORKREG2,1(WORKREG2) ADDRESS OF DATA TO BE SENT 32100013 ST WORKREG2,16(CCWREG) PUT IN CCW 32400013 MVI 16(CCWREG),X'01' RESTORE OP CODE 32700013 * 33000013 STC TESTREG,DISPLACE STORE DISPLACEMENT FOR LATER 33300013 BR RETURN 33600013 * GET CORE FOR THE PATTERN 33900013 NOTINUSE EQU * 34200013 EX 0,DATAADDR-X'40'(TESTREG) ADDRESS OF DATA TO SENT 34500013 ST WORKREG,4(GETMAIN) ADDRESSS FOR ADDRESS OF DATA 34800013 SR COUNTREG,COUNTREG CLEAR A REGISTER FOR COUNT 35100013 IC COUNTREG,0(FROMREG) CHARACTER COUNT OF DATA 35400013 ST COUNTREG,0(GETMAIN) PUT IN GETMAIN CONSTANTS 35700013 SVC 4 ISSUE GETMAIN SVC 36000013 NR 15,15 TEST FOR ZERO RETURN CODE 36300013 BNZ MSGSWTCH NON-ZERO IS NO CORE AVAILABLE 36600013 MVI 0(WORKREG),X'01' SET USAGE COUNT TO ONE 36900013 L TOREG,0(WORKREG) ADDRESS OF DATA AREA 37200013 BCTR COUNTREG,0 ADJUST COUNT FOR MVC INST 37500013 EX COUNTREG,EXMVC MOVE THE DATA 37800013 B SETDATA 38100013 * NO TEST SET UP--RETURN TO RESIDENT MODULE 38400013 RESTART OI NOTEST,X'01' SET NO TEST SWITCH 38700013 BR RETURN 39000013 * COMPARE ROUTINE 39300013 COMPARE EQU * 39600013 LH COUNTREG,CHARCNT LOAD COUNT OF CHARS IN MESSAGE 39900013 CLI 5(IOREG),X'51' TEST FOR FORMAT ONE 40500013 BNE FORMAT0C 40800013 SR FROMADDR,FROMADDR CLEAR WORKING REGISTER 41100013 IC FROMADDR,8(IOREG) COUNT OF CHARACTERS IN SYMBOL 41400013 N FROMADDR,=F'15' CLEAR ZONE BITS 41700013 SH COUNTREG,=H'10' ADJUST FOR HEADER 42000013 SR COUNTREG,FROMADDR 42300013 LA FROMADDR,9(FROMADDR,IOREG) ADDRESS OF FIRST CHAR TO CMP 42600013 COMPARE5 BZ CMPVALID NO DATA TO BE COMPARED 42900013 LA TOADDR,ALLCHAR+3 ADDRESS OF COMPARE DATA 43200013 BCTR COUNTREG,0 ADJUST FOR CLC INSTRUCTION 43500013 EXCLC CLC 0(1,FROMADDR),0(TOADDR) DUMMY INSTRUCTION 43800013 EX COUNTREG,EXCLC DO THE COMPARE 44100013 BNE MSGSWTCH SWITCH IF COMPARE IS INCORRECT 44400013 COMPARE4 MVC 0(11,IOREG),VALIDCMP MOVE IN VALID COMPARE MESSAGE 44700013 IC FROMADDR,0(TOADDR,COUNTREG) LAST CHARACTER COMPARED 45000013 STC FROMADDR,8(IOREG) COMPLETE MESSAGE 45300013 * PREPARE DATA CCW 45600013 COMPARE3 B MSGSWCH2 45900013 * 46200013 CMPVALID EX 0,COMPARE4 MOVE IN VALID COMPARE MESSAGE 46500013 B COMPARE3 CONTINUE 46800013 FORMAT0C EQU * 47100013 LA FROMADDR,12(IOREG) ADJUST DATA POINTER 47400013 SH COUNTREG,=H'13' ADJUST COUNT 47700013 B COMPARE5 COMPLETE COMPARE 48000013 * REQUEST ADDRESS TEST 48300013 REQADDR EQU * 48600013 MVC 0(11,IOREG),DEVMSG PUT MESSAGE IN INPUT AREA 48900013 * CONVERT DC ADDRESS 49200013 LA WORKREG,ADDRESS ADDRESS OF DC ADDR IN ASCII 49500013 BAL LINKREG,CONVERT CONVERT TO BINARY 49800013 LA WORKREG,X'50' INITIALIZE WORK REGISTER 50100013 SH WORKREG2,H10 CONVERT 00PS 50400000 BM *+12 BINARY 50700013 LA WORKREG,1(WORKREG) TO 51000013 B *-12 DECIMAL 51300013 STC WORKREG,6(IOREG) PUT TENS IN MESSAGE 51600013 LA WORKREG2,90(WORKREG2) 51900013 STC WORKREG2,7(IOREG) PUT UNITS IN MESSAGE 52200013 * CONVERT DS ADDRESS 52500013 CLI ADDRESS+1,X'60' 40-5F DS'S FOR 2265-1053 A26768 52520000 BNL NOT2265 A26768 52540000 CLI ADDRESS,X'50' 40-4F DC'S FOR 2845 A26768 52560000 BNL RESTART A26768 52580000 MVC 8(2,IOREG),X5256 MOVE IN 26 FOR DV A26768 52600000 CLI ADDRESS+1,X'50' DS FOR 2265 A26768 52620000 BNL MSGSWCH2 A26768 52640000 OI 9(IOREG),X'01' INCREMENT DV TO 27 A26768 52660000 B MSGSWCH2 BRANCH AROUND CONVERSION FOR 2260 A26768 52680000 NOT2265 EQU * A26768 52700000 LA WORKREG,ADDRESS+1 ADDRESS OF DS ADDR IN ASCII 52800013 BAL LINKREG,CONVERT CONVERT TO BINARY 53100013 MVI 8(IOREG),X'50' STORE TENS ZERO IN ASCII A26768 53400000 CH WORKREG2,=H'33' 53700013 MVI NOTEST,X'1C' SET SEQUENCE INDICATOR 54000013 BL RESTART LESS THAN 33 IS NOT VALID 54300013 CH WORKREG2,=H'57' 54600013 MVI NOTEST,X'2C' SET SEQUENCE INDICATOR 54900013 BH RESTART OVER 57 IS NOT VALID 55200013 SH WORKREG2,=H'42' 55500013 BC 10,ABOVE9 PLUS OR ZERO - 10 TO 25 A26768 55600000 LA WORKREG2,10(WORKREG2) CORRECT TENS A26768 55700000 B STORE B TO STORE UNITS A26768 55800000 ABOVE9 MVI 8(IOREG),X'52' MOVE IN TENS TWO IN ASCII A26768 55900000 SH WORKREG2,H10 A26768 56000000 BC 10,STORE PLUS OR ZERO - 20 TO 25 A26768 56100000 LA WORKREG2,10(WORKREG2) CORRECT UNITS A26768 56200000 MVI 8(IOREG),X'51' MOVE IN TENS ONE IN ASCII A26768 56300000 STORE EQU * A26768 56400000 STC WORKREG2,9(IOREG) STORE UNITS 56700013 OI 9(IOREG),X'50' ADD ASCII ZONE 57000013 MSGSWCH2 LA WORKREG,11 SET COUNT FOR SWITCHING 57300013 B MSGSWCH1 SWITCH INPUT AREA 57600013 EJECT 57900013 * 58200013 * REGISTERS 58500013 * 58800013 GETMAIN EQU 1 59100013 LINKREG EQU 2 59400013 PATRNREG EQU 2 59700013 PARREG EQU 3 60000013 LOOPCNT EQU 4 60300013 TESTREG EQU 4 60600013 COUNTREG EQU 5 60900013 BASEREG EQU 6 61200013 IOREG EQU 7 61500013 WORKREG EQU 8 61800013 WORKREG2 EQU 9 62100013 CCWREG EQU 10 62400013 LENGTH EQU 10 62700013 FROMADDR EQU 11 63000013 FROMREG EQU 11 63300013 TOADDR EQU 12 63600013 TOREG EQU 12 63900013 BUFREG EQU 13 64200013 RETURN EQU 14 64500013 * 64800013 * 65100013 * CONVERT AN ASCII ADDRESSING CHARACTER TO BINARY 65400013 * 65700013 CONVERT EQU * 66000013 SR WORKREG2,WORKREG2 CLEAR SECOND WORKING REGISTER 66300013 IC WORKREG2,0(WORKREG) GET CHARACTER TO BE CONVERTED 66600013 CLI 0(WORKREG),X'40' LESS THAN 40 IS INVALID 66900013 MVI NOTEST,X'3C' SET SEQUENCE INDICATOR 67200013 BL RESTART 67500013 CLI 0(WORKREG),X'60' 40 TO 5F IS EQUIVALENT TO 1-32 67800013 BL SUB3F 68100013 CLI 0(WORKREG),X'A0' 60 TO 9F IS INVALID 68400013 MVI NOTEST,X'4C' SET SEQUENCE INDICATOR 68700013 BL RESTART 69000013 CLI 0(WORKREG),X'C0' A0 TO BF IS EQUIVALENT TO 33-64 69300013 BL SUB40 69600013 CLI 0(WORKREG),X'E0' C0 TO DF IS INVALID 69900013 MVI NOTEST,X'5C' SET SEQUENCE INDICATOR 70200013 BL RESTART 70500013 SH WORKREG2,=H'32' E0 TO FF IS EQUIVALENT TO 65-96 70800013 SUB40 SH WORKREG2,=H'64' 71100013 SUB3F SH WORKREG2,=H'63' 71400013 BR LINKREG RETURN 71700013 * 72000013 EJECT 72300013 * 72600013 * PATTERNS OF DATA FOR 2848 TESTS 72900013 * 73200013 TILT DC AL1(TILTEND-TILT) 73500013 DC X'020AA1BFA3B4A5B6A7B8A8B9455FA2B3A4B5A6B7A9BA5A48AA5C' 73800013 DC X'AC0A49AE4AB047B1FE5EBDABFCAD5BAF42B25D0A03' 74100013 TILTEND EQU * 74400013 * 74700013 ROTATE DC AL1(ROTATEND-ROTATE) 75000013 DC X'020AA1A9A5A4A8A2AAB2AEADB1ABBFBAB6B5B9B3484249FC47BD' 75300013 DC X'5159550A54585243535657505D5C5B4AFE5AB4B7B85FACAFB05E' 75600013 DC X'A3A6A7450A03' 75900013 ROTATEND EQU * 76200013 * 76500013 TWIST DC AL1(TWISTEND-TWIST) 76800013 DC X'020AA143BF44A359B4A9A556B6A6A754B8A4A852B9A24550B346' 77100013 DC X'A457A6B8B755A9B6BA0A534351485DB253AF5C42AD55AB495B5E' 77400013 DC X'58B1FCB050AEBDAC52AAFE54AE56B1590A03' 77700013 TWISTEND EQU * 78000013 * 78300013 ALLCHAR DC AL1(ALLCHARX-ALLCHAR) 78600013 DC X'020A50515253545556575859A1A2A3A4A5A6A7A8A9AAABACADAE' 78900013 DC X'AFB0B1B2B3B4B5B6B7B8B9BA0A03' 79200013 ALLCHARX EQU * 79500013 * 79800013 * ADDRESSES OF DATA TO BE MOVED TO PATTERN BUFFER 80100013 * 80400013 DS 0H 80700013 DATAADDR EQU * 81000013 LA FROMREG,TILT 81300013 LA FROMREG,ROTATE 81600013 LA FROMREG,TWIST 81900013 LA FROMREG,ALLCHAR 82200013 * 82500013 * CONSTANTS 82800013 * 83100013 TESTCODE DC X'404448004C' 83400013 EXMVC MVC 0(1,TOREG),0(FROMREG) 83700013 VALIDCMP DC X'A3ADB040B6ACA44D4F0A03' VALID COMPARE MESSAGE 84000013 DEVMSG DC X'A4A34BA4B6404040404003' DEVICE ADDRESS MESSAGE 84300013 X5256 DC X'5256' DV CONSTANT FOR 2265 A26768 84400000 H10 DC H'10' A26768 84500000 EJECT 84600013 * 84900013 * INPUT AREA DEFINITION 85200013 * 85500013 ONLTBUF DSECT 85800013 ECB DS 8C 86100013 CCWBYTES DS 0C COUNT OF CCW AREA 86400013 CCWAREA DS 4C ADDRESS OF CCW AREA 86700013 SAVE DS 0C 87000013 LCBADDR DS 4C ADDRESS FOR OTHER ADDRESSING 87300013 BYTE1030 DS 0C COUNT FOR 1030 MESSAGE SWITCH 87600013 AREA1030 DS 0C ADDRESS FOR 1030 MESSAGE SWITCH 87900013 CVTAREA DS 0C 88200013 DIALINFO DS 2C ADDRESS OF DIAL INFORMATION 88500013 ADDR2260 DS 2C 2260 ADDRESSING, ETC. 88800013 ADDRESS DS 2C OTHER ADDRESSING CHARACTERS 89100013 DEVICETP DS 1C DEVICE TYPE CODE 89400013 FEATURES DS 0C FEATURES CODE 89700013 RESPONSE DS 1C FOR RESPONSES 90000013 DISPLACE DS 1C RESIDENT TABLE DISPLACEMENT 90300013 FLAGBYTE DS 1C FLAG FOR TP OP CODE 90600013 CHARCNT DS 2C COUNT OF CHARACTERS IN MESSAGE 90900013 UCBADDR DS 4C SAVE AREA FOR UCB ADDRESS 91200013 * 91500013 * PARAMETER LIST DEFINITION 91800013 * 92100013 PARAMLST DSECT 92400013 ECBADDR DS 4C ADDRESS OF ENTRY CONTROL BLOCK 92700013 PATRNLST DS 4C ADDRESS OF PATTERN LIST 93000013 CRIDLES DS 4C ADDRESS OF CR, IDLES, ETC. 93300013 NOTEST DS 1C NO TEST SWITCH 93600013 END 93900013 ./ ADD SSI=01012301,NAME=IGE0004E,SOURCE=0 TITLE 'IGE0004E QTAM III AUTOPOLL TIME OUT AND DATA CHECK' 00800013 * * 00820018 *STATUS- CHANGE LEVEL 003 * 00840018 * * 00860018 *FUNCTION- AFTER ADJUSTING TO THE FAILING CCW, THE ROUTINE TESTS THE * 00880018 * CCW. FOR A POLL CCW, THE POLLING LIST ADDRESS AND ENTRY SIZE ARE * 00900018 * ACCESSED. THE NEW COUNT, OBTAINED BY ADDING THE RESIDUAL COUNT * 00920018 * TO THE ENTRY SIZE, IS PLACED IN THE POLL CCW. THE DATA ADDRESS * 00940018 * FOR THE POLL CCW IS OBTAINED BY SUBTRACTING THE NEW COUNT FROM THE* 00960018 * ORIGINAL COUNT AND ADDING THAT TO THE POLLING LIST ADDRESS. * 00980018 * FOR A READ RESPONSE CCW, THE POLLING LIST ADDRESS AND ENTRY * 01000018 * SIZE ARE ACCESSED. THE POLLING LIST IS SEARCHED FOR AN ENTRY WITH * 01020018 * THE INDEX BYTE THE SAME AS THE ONE STORED. THE NEW COUNT,OBTAINED* 01040018 * BY SUBTRACTING THE LIST ADDRESS FOR THE ENTRY FROM THE LIST * 01060018 * ADDRESS OF THE POLL CCW AND ADDING THE COUNT IN THE SECOND POLL * 01080018 * CCW, IS PLACED IN THE FIRST POLL CCW. THE DATA ADDRESS FOR THE * 01100018 * POLL CCW IS THE ADDRESS FOUND IN THE ENTRY OF THE LIST. * 01120018 * THE IOB IS SET TO RESTART ON THE FIRST CCW OF THE CHANNEL * 01140018 * PROGRAM. IF THE RETRY HAS FAILED TWO TIMES, EITHER TIMEOUT IS SET * 01160018 * IN THE ERROR HALFWORD AND IN LCBINCAM OR DATA CHECK IS SET IN * 01180018 * LCBINCAM. ON A DATA CHECK FOR A 2701 CONTROL UNIT, THE DIAGNOSTIC * 01200018 * WRITE/READ EXIT IS SET. ALSO FOR A PERMANENT ERROR LCBERRCT+1 IS * 01220018 * SET TO INDICATE POST WITH MESSAGE. * 01240018 * EXIT FROM THE ROUTINE IS TO THE LINE ERROR RECORDING WHICH * 01260018 * DOES THE EXCP TO RESTART THE CHANNEL PROGRAM. * 01280018 * * 01300018 *ENTRY POINTS- * 01320018 * IGE0004E- CONTROL IS PASSED HERE BY IGE0104E AND IGE0204E * 01340018 * * 01360018 *INPUT- * 01380018 * REGISTER 1 - RQE ADDRESS * 01400018 * REGISTER 15- ENTRY POINT * 01420018 * * 01440018 *OUTPUT- * 01460018 * BRANCHES TO THE LINK ROUTINE WITH REGISTER 13 CONTAINING THE CODE * 01480018 * FOR THE LINE ERROR RECORDING ROUTINE. LCBERRCT+1=X'02' FOR MESSAGE* 01500018 * FOR TIMEOUT ERRORS LCBINCAM+1=X'03' AND THE TIMEOUT BIT IS SET IN * 01520018 * THE ERROR HALF WORD. * 01540018 * FOR DATA CHECK ERRORS LCBINCAM+1=X'01'. IF A 2701 CONTROL UNIT, * 01560018 * LCBINCAM+1=X'04'. * 01580018 * * 01600018 *EXTERNAL REFERENCES- NONE * 01620018 * * 01640018 *EXITS,NORMAL- * 01660018 * EXIT IS MADE BY A BRANCH TO THE LINKAGE ROUTINE POINTED TO BY* 01680018 * CVT+44 WITH REGISTER 13 CONTAINING 2046 TO INDICATE LINKAGE * 01700018 * TO IGE0204F. * 01720018 * * 01740018 *EXITS,ERROR- NONE * 01760018 * * 01780018 *TABLES/WORKAREAS- NONE * 01800018 * * 01820018 *ATTRIBUTES- SERIALLY REUSABLE,DISABLED,TRANSIENT,ONLY LOADABLE, * 01840018 * SUPERVISOR MODE,REFRESHABLE * 01860018 * * 01880018 * 288000,416000 24943 01900018 * REGISTER USAGE 02400013 SPACE 2 03200013 IGE0004E CSECT 04000013 TSTREG EQU 1 TWELVE STAR ADDRESS 04800013 UCBREG EQU 2 UNIT CONTROL BLOCK ADDRESS 05600013 DCBREG EQU 3 DATA CONTROL BLOCK ADDRESS 06400013 CCWREG EQU 4 ADDRESS OF CHANNEL COMMAND WORD 07200013 LCBREG EQU 5 WORK REGISTER 08000013 W1 EQU 6 WORK REGISTER 08800013 W2 EQU 7 WORK REGISTER 09600013 W3 EQU 8 WORK REGISTER 10400013 W4 EQU 9 WORK REGISTER 11200013 W6 EQU 11 WORK REGISTER 12000013 W7 EQU 12 WORK REGISTER 12800013 LINKREG EQU 13 NAME OF NEXT ERP MODULE 13600013 RETREG EQU 14 14400013 BASEREG EQU 15 BASE REGISTER 15200013 SPACE 2 16000013 USING *,BASEREG 16800013 USING IECKLCB0,LCBREG 17600013 L LCBREG,X4(TSTREG) IOB ADDRESS 18400013 SH LCBREG,H48 ADJUST TO LCB 19200013 L CCWREG,LCBCSW FAILING CCW+8 20000013 SH CCWREG,H8 ADJUST TO FAILING CCW 20800013 CLI X0(CCWREG),X9 IS THIS A POLLCCW 21600013 BNE TORDPOLL NO, READ RESPONSE TO AUTOPOLL 22400013 BAL W2,TOPOLSUB GET POLL LIST ADDRESS 23200013 AH W4,LCBCSW+6 ADD RESIDUAL COUNT TO WIDTH 24000013 AH W6,X6(CCWREG) ADD ORIGINAL COUNT TO ADDRESS 24800013 SR W6,W4 SUBTRACT WIDTH AND RESIDUAL 25600013 * COUNT FROM ADDRESS 26400013 TOCOM STH W4,LCBCPA+14 STORE NEW COUNT 27200013 ST W6,LCBCPA+8 STORE NEW DATA ADDRESS 28000013 XXX MVC LCBERRCT(1),LCBERRCT+1 RETRY COUNT A24943 28800018 MVI LCBERRCT+1,X0 CLEAR LINK BYTE 29600013 NI LCBERRCT,X3 ONLY RETRY BITS 30400013 CLI LCBERRCT,X3 HAS RETRY FAILED 31200013 BE TOSWT YES 32000013 LA W1,LCBCPA RESTART AT FIRST 32800013 ST W1,LCBSTART-1 INITIALIZE IOBSTART 33600013 LR W2,TSTREG SAVE RB POINTER 34400013 TOLERB L RETREG,X10 CVT ADDRESS 36000013 L RETREG,X2C(RETREG) LINK ROUTINE ADDRESS 36800013 LA LINKREG,LERBMOD NAME OF LINE ERROR RECORDING 37600013 BR RETREG LINK 38400013 TORDPOLL BAL W2,TOPOLSUB GET POLL LIST ADDRESS 39200013 LR W7,W3 SAVE POLLING LIST ADDRESS 40000013 TOLOOP CLI X1(W7),XFE END OF LIST 40800013 BC 8,XXX YES RESTART WITH OLD POLL A24943 41600018 AR W7,W4 BUMP TO NEXT ENTRY 42400013 CLC X0(1,W6),X0(W7) INDEX BYTE COMPARE 43200013 BNE TOLOOP NO, CHECK FOR END OF LIST 44000013 BCTR W4,0 REDUCE ENTRY SIXE BY ONE 44800013 SR W7,W4 W7 = ADDRESS OF POLL CHARS 45600013 LR W6,W7 SET FOR COMMON CODE 46400013 LH W4,LCBCPA+38 COUNT OF 2ND POLL CCW 47200013 SLR W3,W7 1ST - MATCH (NEGATIVE) 48000013 LA W4,X1(W3,W4) W4 = NEW COUNT 48800013 B TOCOM USE COMMON CODE 49600013 * THE FOLLOWING SUBROUTINE IS USED TO FIND THE POLLING LIST AND THE 50400013 * LENGTH OF THE POLLING LIST ENTRIES. REGISTERS ON EXIT ARE 51200013 * W3 - ADDRESS OF THE POLLING LIST 52000013 * W4 - LENGTH OF EACH ENTRY (2 OR 3 BYTES) 52800013 * W6 - OP CODE AND DATA ADDRESS OF FAILING CCW 53600013 * W7 - FLAGS, TP OP CODE AND COUNT OF F AILING CCW 54400013 TOPOLSUB LM W6,W7,X0(CCWREG) FAILING CCW TO W6 AND W7 55200013 L W3,LCBCPA+32 POLL LIST ADDRESS FROM POLL CCW 56000013 BCTR W3,0 BACK UP TO CHECK ENTRY SIZE 56800013 LA W4,X3 ASSUME 3 BYTE ENTRIES 57600013 TM X0(W3),X20 CHECK LENGTH OF ENTRIES 58400013 BCR 1,W2 THREE, RETURN 59200013 BCTR W4,W2 DECREMENT COUNT AND RETURN 60000013 TOSWT TM LCBSENSE,X1 TIME OUT 60800013 BZ DCTRLUNT NO, DATA CKECK 61600013 MVI LCBINCAM+1,X3 TIME OUT UPDATE 62400013 OI LCBERRST+1,X40 SET ERROR 63200013 TOPOST MVI LCBERRCT+1,X2 POST WITH MESSAGE 64000013 B TOLERB 64800013 DCTRLUNT MVI LCBINCAM+1,X1 DATA CHECK UPDATE 65600013 LH UCBREG,X2(TSTREG) UCB ADDRESS 66400013 MVC LCBERCCW+7(1),19(UCBREG) 67200013 NI LCBERCCW+7,XF DEVICE TYPE 68000013 CLI LCBERCCW+7,X2 68800013 BNE TOPOST NO DIAG W/R 69600013 MVI LCBERRCT+1,X4 EXIT TO DIAG W/R 70400013 B TOLERB 71200013 EJECT 72000013 * 72800013 * CONSTANTS 73600013 * 74400013 X0 EQU 0 75200013 X1 EQU 1 76000013 X2 EQU 2 76800013 X3 EQU 3 77600013 X4 EQU 4 78400013 X9 EQU 9 79200013 XF EQU 15 80000013 X10 EQU 16 80800013 X2C EQU 44 81600013 X40 EQU 64 82400013 X6 EQU 6 83200013 X20 EQU 32 84000013 XFE EQU 254 84800013 EREXCP EQU 15 85600013 LERBMOD EQU 2046 86400013 H8 DC AL2(8) 87200013 H48 DC AL2(48) 88000013 EJECT 88800013 LCBD QTAM=3 89600013 END 90400013 ./ ADD SSI=21540544,NAME=IGE0004F,SOURCE=0 TITLE 'IGE0004F QTAM ERP READ SKIP RETURN MODULE' 00800013 IGE0004F CSECT 01600013 *1203280000 20399 02000018 * 020000,032000 00PS 02010019 * 376000 A29183 02020019 * 424000 A28769 02030019 *A658000-660000 A43629 02035021 *A296300-302000,A321000-325000 A48042 02036021 *D424000,A424000-444000 A48044 02037021 *********************************************************************** 02040019 * * 02050019 *STATUS- CHANGE LEVEL 003 * 02060019 * * 02070019 *FUNCTION- AFTER INITIALIZATION, ACTION IS TAKEN ACCORDING TO * 02080019 * ERRORS FOUND. * 02090019 * FOR THE FOLLOWING INDICATIONS THE "SHOULD NOT OCCUR" * 02100019 * BIT IS SET IN THE ERROR HALFWORD, AND LINKAGE IS MADE TO * 02110019 * THE ERROR POST ROUTINE: UNIT CHECK, UNIT EXCEPTION, COMMAND * 02120019 * REJECT, BUS-OUT CHECK, EQUIPMENT CHECK, OVERRUN, OR * 02130019 * RESIDUAL COUNT EQUAL TO ZERO. * 02140019 * IF THE SECOND CCW IS FOR A SWITCHED LINE, THE READ * 02150019 * SKIP SENSE BYTE IS CHECKED. * 02160019 * (A) FOR AN INTERVENTION REQUIRED, LINKAGE IS MADE TO THE POST * 02170019 * ROUTINE. THE RETRY COUNT IN THE ERROR HALFWORD IS UPDATED IF * 02180019 * THERE WAS DATA TRANSFER. * 02190019 * (B) IF NOT INTERVENTION REQUIRED AND NO DATA TRANSFER, THE * 02200019 * CHANNEL PROGRAM IS RESTARTED WITH THE THIRD CCW. IF DATA * 02210019 * TRANSFER, LINKAGE IS MADE TO POST ROUTINE WITH "NO MESSAGE" * 02220019 * INDICATOR SET. * 02230019 * IF THE SECOND CCW IS NOT FOR A SWITCHED LINE; * 02240019 * (A) FOR A TEXT TRANSFER, LINKAGE IS MADE TO ERROR POST ROUTINE * 02250019 * WITH NO MESSAGE INDICATED. PRIOR TO LINKING, IF THE READ SKIP * 02260019 * ENDED WITH A TIME-OUT OR INTERVENTION REQUIRED, THE ROUTINE * 02270019 * INDICATES THAT RESELECTION IS NECESSARY. * 02280019 * (B) FOR NOT TEXT TRANSFER, THE CHANNEL PROGRAM IS RESTARTED AT * 02290019 * THE FIRST CCW. RETURN FROM THE ERROR EXCP IS TO IOS. * 02300019 * * 02310019 *ENTRY POINTS- * 02320019 * IGE0004F- CONTROL IS PASSED HERE FROM THE LINK MODULE * 02330019 * IGE0704E. * 02340019 * * 02350019 *INPUT- * 02360019 * REGISTER 1 - RQE ADDRESS * 02370019 * REGISTER 15- ENTRY POINT * 02380019 * * 02390019 *OUTPUT- * 02400019 * FOR LINKING TO POST MODULE (IGE0504E) REG 13 CONTAINS CODE FOR * 02410019 * MODULE, A CODE OF DECIMAL 5045. * 02420019 * FOR ERROR EXCP (SVC 15) LCBSTART CONTAINS ADDRESS OF CCW TO * 02430019 * RESTART WITH. * 02440019 * * 02450019 *EXTERNAL REFERENCES- * 02460019 * IOS SVC 15 ROUTINE (ERROR EXECUTE CHANNEL PROGRAM) * 02470019 * IOS SVC 3 ROUTINE (TO RETURN TO IOS) * 02480019 * * 02490019 *EXITS, NORMAL- * 02500019 * TO RESTART THE CHANNEL PROGRAM, AN SVC 15 IS EXECUTED * 02510019 * FOLLOWED BY AN SVC 3 TO RETURN TO IOS. * 02520019 * FOR LINKAGE TO IGE0504E, REG 13 IS LOADED WITH A CODE * 02530019 * FOR THAT MODULE AND A BRANCH IS MADE TO THE LINKAGE ROUTINE * 02540019 * POINTED TO BY CVT+44. * 02550019 * * 02560019 *EXITS, ERROR- NONE * 02570019 * * 02580019 *TABLES/WORKAREAS- NONE * 02590019 * * 02600019 *ATTRIBUTES- SERIALLY REUSABLE, DISABLED, TRANSIENT, ONLY LOADABLE, * 02610019 * SUPERVISOR MODE, REFRESHABLE * 02620019 * * 02630019 *********************************************************************** 02640019 * REGISTER USAGE 03200013 SPACE 2 04000013 TSTREG EQU 1 TWELVE STAR ADDRESS 04800013 UCBREG EQU 2 UNIT CONTROL BLOCK ADDRESS 05600013 DCBREG EQU 3 DATA CONTROL BLOCK ADDRESS 06400013 CCWREG EQU 4 ADDRESS OF CHANNEL COMMAND WORD 07200013 LCBREG EQU 5 LINE CONTROL BLOCK ADDRESS 08000013 W1 EQU 6 WORK REGISTER 08800013 W2 EQU 7 WORK REGISTER 09600013 W3 EQU 8 WORK REGISTER 10400013 W4 EQU 9 WORK REGISTER 11200013 LINKREG EQU 13 NAME OF NEXT ERP MODULE 12000013 RETREG EQU 14 RETURN REGISTER 12800013 BASEREG EQU 15 BASE REGISTER 13600013 SPACE 2 14400013 USING *,BASEREG 15200013 USING IECKLCB0,LCBREG 16000013 L LCBREG,X4(TSTREG) IOB ADDRESS 16800013 SH LCBREG,H48 ADJUST TO LCB 17600013 TM LCBCSW+5,XFF CHECK SECOND STATUS BYTE 18400013 BNZ RDERROR FOR ANY ERRORS 19200013 TM LCBCSW+4,XF0 CHECK FIRST HALF OF FIRST STATUS 20000013 BNZ RDERROR BYTE FOR ANY ERRORS 20800013 * UNIT CHECK AND/OR UNIT 21600013 * EXCEPTION MAY BE VALID 22400013 TM LCBSENSE,XB4 COMMAND REJECT, BUSS OUT CHECK 23200013 BNZ RDERROR EQUIPMENT CHECK AND OVERRUN 24000013 * ARE NOT VALID ERRORS 24800013 LH W1,LCBCSW+6 IF RESIDUAL COUNT IS ZERO, WE 25600013 LTR W1,W1 HAVE READ 65,535 BYTES OF 26400013 BZ RDERROR GARBAGE! 27200013 MVC LCBSENSE+1(1),LCBSENSE SAVE READ SKIP SENSE BYTE 20399 28000018 LA W1,LCBCPA INITIALIZW FOR LOOP 28800013 LR W2,W1 29600013 * A48042 29630021 * AUTOPOLL CHAN.PROGS HAVE MORE THAN 1 TIC SO THE A48042 29660021 * USUAL PRACTICE OF SAVING THE CSW AFTER THE TIC CCW IN A48042 29690021 * THE CPA OF THE LCB WAS NOT FOLLOWED BY IGE0804E A48042 29720021 * REG 1 POINTS TO THE RQE. RQE BYTES 2 -3 IS UCB ADR A48042 29750021 * A48042 29780021 L 14,0(TSTREG) GET 1ST WD OF RQE A48042 29810021 N 14,=F'65535' ISOLATE UCB PTR IN LOW HALF A48042 29840021 TM 17(14),X'40' IS THIS AUTO-POLL DEVICE? A48042 29870021 BNO RDLOOP NO. OK TO USE TIC IN CHANNEL PROG A48042 29900021 * A48042 29930021 * YES AUTOPOLL. SET W2 TO IDENTIFY SAVE AREA AT A48042 29960021 * LCBCPA+X'50'. W2 ACTUALLY POINTS TO CPA+X'48' A48042 29990021 * SAVE AREA IS 8 BYTES PAST W2. SEE ALSO IGE0804E A48042 30020021 * A48042 30050021 LA W2,X'48'(W2) W2<--CPA(W2)+X'48' A48042 30080021 B W2SET GO ON TO SUBSEQUENT WORK A48042 30110021 * A48042 30140021 * NOT AUTOPOLL. SET W2 TO POINT TO TIC IN CHANNEL PROG. A48042 30170021 * A48042 30200021 RDLOOP LA W2,X8(W2) ACCESS NEXT CCW 30400013 CLI X0(W2),X8 IS IT A TIC 31200013 BNE RDLOOP NO, TRY NEXT 32000013 * A48042 32100021 * W2 IS NOW SET TO A. --> TIC IF NOT AUTOPOLL A48042 32200021 * B. -->CPA+X'48' IF AUTOPOLL A48042 32300021 * A48042 32400021 W2SET DS 0H CONTINUATION POINT A48042 32500021 MVC LCBSENSE(1),X8(W2) RESTORE ORIGINAL SENSE BYTE 32800013 MVC LCBCSW+1(7),X9(W2) RESTORE ORIGINAL CSW 33600013 L CCWREG,LCBCSW ORIGINAL FAILING CCW+8 34400013 SH CCWREG,H8 ADJUST TO FAILING CCW 35200013 TM LCBCPA+8,X20 SECOND CCW FOR A DIAL LINE 36000013 BZ RDCKCNT NO, LEASED LINE 36800013 TM LCBSENSE+1,X'40' I.R. ON READ SKIP A29183 37600019 BZ RDCKTXT 38400013 B RDTEXT YES. TO POST (504E) AS PERM ERROR A48044 42400021 * **** WITH RETRY CT IF READ OR NONE IF NOTA48044 44400021 RDSTORE ST W1,LCBSTART-1 INITIALIZE IOBSTART 46400013 MVI LCBSENSE,X0 CLEAR SENSE 47200013 NI LCBERRST+1,XFC ZERO EOBLC CTR 48000013 SVC EREXCP ERROR EXECUTE CHANNEL PROGRAM 48800013 SVC RETURN RETURN 49600013 RDCKCNT CLI LCBERRCT,X3 RETRY FAILED 50400013 BNL RDTEXT 51200013 TM X5(CCWREG),X30 TEXT TRANSFER CCW 52000013 BZ RDSTORE NO, RETRY CHANNEL PROGRAM 52800013 TM LCBSENSE+1,X41 DID READ SKIP END WITH TO OR IR 53600013 BZ *+8 NO 54400013 OI LCBSENSE,X1 INDICATE RESELECTION NECESSARY 55200013 * FOR EOBLC 56000013 RDNOMSG MVI LCBERRCT+1,X1 POST, NO MESSAGE 56800013 RDOR OC LCBERRST+1(1),LCBERRCT PUT RETRY COUNT IN ERROR HALF 57600013 * WORD 58400013 RDPOST L RETREG,X10 CVT ADDRESS 59200013 L RETREG,X2C(RETREG) LINK ROUTINE ADDRESS 60000013 LH LINKREG,POSTMOD NAME OF POST MODULE 60800013 BR RETREG LINK TO POST ROUTINE 61600013 RDTEXT TM X5(CCWREG),X30 TEXT TRANSFER CCW 62400013 BZ RDPOST 63200013 B RDOR 64000013 RDCKTXT TM X5(CCWREG),X30 TEST TRANSFER CCW 64800013 BNZ RDNOMSG YES 65600013 CLI LCBCECB,X'0A' WRITE NEG-ACK CHANNEL PGM A43629 65800021 BE RDCKCNT RESTART ON FIRST CCW A43629 66000021 LA W1,LCBCPA+16 RESTART AT THIRD CCW 66400013 B RDSTORE 67200013 RDERROR OI LCBERRST,X1 SET SNO ERROR 68000013 B RDPOST 68800013 * 69600013 * CONSTANTS 70400013 * 71200013 X0 EQU 0 72000013 X1 EQU 1 72800013 X2 EQU 2 73600013 X3 EQU 3 74400013 X4 EQU 4 75200013 X5 EQU 5 76000013 X8 EQU 8 76800013 X9 EQU 9 77600013 X10 EQU 16 78400013 X20 EQU 32 79200013 X2C EQU 44 80000013 X2F EQU 47 80800013 X30 EQU 48 81600013 X40 EQU 64 82400013 X41 EQU 65 83200013 X80 EQU 128 84000013 XB4 EQU 180 84800013 XF0 EQU 240 85600013 XFC EQU 252 86400013 XFF EQU 255 87200013 EREXCP EQU 15 88000013 RETURN EQU 3 88800013 H8 DC AL2(8) 89600013 H48 DC AL2(48) 90400013 POSTMOD DC AL2(5045) 91200013 LCBD QTAM=3 92000013 END 92800013 ./ ADD SSI=02013243,NAME=IGE0104E,SOURCE=0 *********************************************************************** 00006021 * * 00012021 *STATUS - CHANGE LEVEL=18 JANUARY 1971 * 00018021 * * 00024021 *FUNCTION- AFTER INITIALIZING, THE ROUTINE INDICATES A DATA CHECK UP- * 00030021 * DATE FOR THE LINE ERROR RECORDING MODULE IN LCBINCAM + 1 (X'01'). * 00036021 * IF THE FAILING CCW IS A READ: * 00042021 * FOR A TEXT TRANSFER AND NO PERMANENT ERROR, LINKAGE IS MADE TO THE* 00048021 * LINE ERROR RECORDING ROUTINE FOR DATA CHECK UPDATE WITH AN INDICA-* 00054021 * TION FOR NO MESSAGE. * 00060021 * FOR NO TEXT TRANSFER: * 00066021 * (A)IF A READ TWX ID RESPONSE, THE START OF THE RETRY CHANNEL * 00072021 * PROGRAM IS SET SO AS TO DISABLE AND REDIAL BEFORE THE RETRY. LINK-* 00078021 * AGE IS MADE TO LINE ERROR RECORDING FOR DATA CHECK UPDATE. * 00084021 * (B)IF A READ RESPONSE TO AUTOPOLLING, LINKAGE IS MADE TO THE * 00090021 * TIME-OUT AND DATA CHECK FOR AUTOPOLL MODULE. * 00096021 * (C)IF A SWITCHED CONNECTION, THE ROUTINE SETS UP FOR A RETRY * 00102021 * AFTER THE DISABLE-DIAL OR DISABLE-ENABLE SEQUENCE. LINKAGE IS MADE* 00108021 * TO THE LINE ERROR RECORDING ROUTINE FOR DATA CHECK UPDATE. * 00114021 * (D)OTHERWISE, RETRY IS SET TO START WITH THE FIRST CCW, AND * 00120021 * LINKAGE IS MADE TO THE LINE ERROR RECORDING MODULE. * 00126021 * IF THE FAILING CCW IS A WRITE: * 00132021 * FOR A TYPE I ADAPTER, THE ACTION TAKEN IS THE SAME AS FOR A READ. * 00138021 * FOR A WTTA ADAPTER, LINKAGE IS MADE TO THE LINE ERROR RECORDING * 00144021 * ROUTINE WITH A PERMANENT ERROR INDICATED. * 00150021 * FOR OTHER ADAPTERS, THE ROUTINE INDICATES NO LINKAGE TO THE LINE * 00156021 * ERROR RECORDING ROUTINE AND THE 'SHOULD NOT OCCUR' BIT IN THE * 00162021 * ERROR HALFWORD OF THE LCB. A PERMANENT ERROR CONDITION EXISTS. * 00168021 * IF THE FAILING CCW IS A POLL, LINKAGE IS MADE TO THE TIMEOUT * 00174021 * AND DATA CHECK FOR AUTOPOLL MODULE. * 00180021 * IF THE FAILING CCW IS A BREAK FOR WTTA ADAPTER, IT IS TREATED* 00186021 * AS A PERMANENT ERROR. * 00192021 * IF RETRY HAS FAILED TWO TIMES, THEN IT IS CONSIDERED A * 00198021 * PERMANENT ERROR. * 00204021 * ON A 2701 CONTROL UNIT, * 00210021 * (A)IF THE LER ROUTINE IS REQUIRED, AN INDICATION (X'04') * 00216021 * FOR DIAGNOSTIC WRITE/READ IS SET IN LCBERRCT + 1 AND LINKAGE IS * 00222021 * MADE TO THE LER ROUTINE. * 00228021 * (B)IF THE LER ROUTINE IS NOT REQUIRED, LINKAGE IS MADE TO * 00234021 * THE DIAGNOSTIC WRITE/READ ROUTINE. * 00240021 * OTHERWISE IF LER IS REQUIRED, POST WITH MESSAGE IS INDICATED IN * 00246021 * LCBERRCT + 1 FOR LER. IF NO LER IS REQUIRED, LINKAGE IS MADE TO * 00252021 * THE POST MODULE TO POST WITH MESSAGE. * 00258021 * * 00264021 *ENTRY POINTS- * 00270021 * IGE0104E - CONTROL IS PASSED HERE BY IGE0004A. * 00276021 * * 00282021 *INPUT- * 00288021 * REGISTER 1 - RQE ADDRESS * 00294021 * REGISTER 15- ENTRY POINT * 00300021 * * 00306021 * OUTPUT - * 00312021 * FOR ERROR EXCP - LCBSTART POINTS TO THE CCW TO RESTART WITH. * 00318021 * FOR BRANCHING TO XCTL ROUTINE, REGISTER 13 CONTAINS CODE FOR NEXT* 00324021 * MODULE TO CALL. * 00330021 * * 00336021 *EXTERNAL REFERENCES- * 00342021 * IOS SVC 15 ROUTINE (ERROR EXECUTE CHANNEL PROGRAM) * 00348021 * IOS SVC 3 ROUTINE (TO RETURN TO IOS) * 00354021 *EXITS, NORMAL- * 00360021 * TO RESTART THE CHANNEL PROGRAM, AN SVC 15 IS EXECUTED * 00366021 * FOLLOWED BY AN SVC 3 TO RETURN TO IOS. * 00372021 * TO XCTL TO THE NEXT ROUTINE, THE ROUTINE EXITS VIA A BRANCH * 00378021 * REGISTER 14 WITH THE MODULE CODE IN REGISTER 13. * 00384021 * * 00390021 *EXITS, ERROR- NONE * 00396021 * * 00402021 *TABLES/WORKAREAS- NONE * 00408021 * * 00414021 *ATTRIBUTES- SERIALLY REUSABLE, DISABLED, TRANSIENT, ONLY LOADABLE, * 00420021 * SUPERVISOR MODE, REFRESHABLE * 00426021 * * 00432021 * CHARACTER CODE DEPENDENCY - NONE * 00438021 * * 00444021 * NOTES - NONE * 00450021 * * 00456021 *********************************************************************** 00462021 TITLE 'IGE0104E QTAM ERP DATA CHECK MODULE' 00500013 IGE0104E CSECT 01000013 *83660580000 20800 01200017 *1203387000 23168 01300018 *2719247000-253000,270000,340700-344200 000C 01600017 *2719662000-666000,762000,797000 000C 01700017 *3410245000 00PS 01800017 *A000060-004620 S21016 01900021 * REGISTER USAGE 02000013 SPACE 2 02500013 W8 EQU 0 03000013 TSTREG EQU 1 TWELVE STAR ADDRESS 03500013 UCBREG EQU 2 UNIT CONTROL BLOCK ADDRESS 04000013 DCBREG EQU 3 DATA CONTROL BLOCK ADDRESS 04500013 CCWREG EQU 4 ADDRESS OF CHANNEL COMMAND WORD 05000013 LCBREG EQU 5 LINE CONTROL BLOCK ADDRESS 05500013 W1 EQU 6 WORK REGISTER 06000013 W2 EQU 7 WORK REGISTER 06500013 W3 EQU 8 WORK REGISTER 07000013 W4 EQU 9 WORK REGISTER 07500013 W5 EQU 10 WORK REGISTER 08000013 W6 EQU 11 WORK REGISTER 08500013 W7 EQU 12 WORK REGISTER 09000013 LINKREG EQU 13 NAME OF NEXT ERP MODULE 09500013 RETREG EQU 14 10000013 BASEREG EQU 15 BASE REGISTER 10500013 SPACE 2 11000013 USING *,BASEREG 11500013 USING IECKLCB0,LCBREG 12000013 L LCBREG,X4(TSTREG) IOB ADDRESS 12500013 SH LCBREG,H48 ADJUST TO LCB 13000013 L CCWREG,LCBCSW CCW+8 13500013 SH CCWREG,H8 ADJUST TO FAILING CCW 14000013 LH UCBREG,X2(TSTREG) UCB ADDRESS 14500013 LA W5,DCLERB FOR LINE ERROR RECORDING 15000013 LA W8,LCBCPA ASSUME RESTART AT FIRST CCW 15500013 LA LINKREG,LERBMOD ASSUME LER IS NEXT LOAD 16000013 SR W1,W1 16500013 IC W1,LCBERRCT ERP RETRY COUNTER 17000013 AH W1,LCBERRST ADD ERROR HALF WORD 17500013 * W3 NOW CONTAINS ERROR HALF 18000013 * WORD WITH COMBINED COUNT 18500013 LA W1,X1(W1) ADD ONE 19000013 NI LCBERRST+1,XFC ZERO EOBLC COUNTER 19500013 CLI X0(CCWREG),X2 FAILING CCW A READ 20000013 BE DCTEXT YES CHECK TEXT TRANSFER 20500013 BH DCKPOLL NOT WRITE, CHECK POLL 21000013 CLI X0(CCWREG),X1 IS THIS A WRITE OP CODE 21500013 BE *+12 YES 22000013 TM LCBCECB,X1 IS THIS A READ OPERATION 22500013 BO DCTXTER YES 23000013 EX 0,DCTRLUNT YES, CHECK ADAPTER TYPE 23500013 NI LCBERCCW+7,XF0 MASK OUT CONTROL UNIT 24000013 CLI LCBERCCW+7,X40 TELETYPE I ADAPTER 00PS 24300017 BE DCTEXT YES 000C 24700017 CLI LCBERCCW+7,X60 WTTA ADAPTER 000C 24900017 BNE DCSNO NO,SHOULD NOT OCCUR 000C 25100017 B DCTXTER BRANCH IF YES 000C 25300017 DCTEXT TM X5(CCWREG),X30 TEXT TRANSFER INDICATED BY TP 25500013 * OP CODE 26000013 BNZ DCTXTER YES 26500013 CLI X5(CCWREG),X7 READ TWX/WTTA ID RESPONSE 000C 27000017 BE DCFIRST YES, MUST HANG UP(DISABLE) AND 27500013 * REDIAL TO RETRY 28000013 CLI X5(CCWREG),XA AUTOPOLL READ RESPONSE 28500013 BE DCRDPOLL YES 29000013 TM LCBCPA+8,X20 IS THE SECOND CCW A DIAL OR 29500013 * ENABLE COMMAND, INDICATES A 30000013 * SWITCHED CONNECTION 30500013 BZ DCFIRST NO, RETRY AT FIRST CCW 31000013 LA W8,LCBCPA+16 IF SWITCHED CONNECTION, RETRY 31500013 * AFTER THE DISABLE-DIAL OR 32000013 DCFIRST STC W1,LCBERRCT STORE UPDATED COUNT 32500013 NI LCBERRCT,X3 ONLY RETRY BITS 33000013 CLI LCBERRCT,X3 HAS RETRY FAILED 33500013 BNL DCTRLUNT YES, PERMANENT ERROR 34000013 EX 0,DCTRLUNT CHECK ADAPTER TYPE 000C 34070017 NI LCBERCCW+7,XF0 MASK OUT CONTROL UNIT BITS 000C 34140017 CLI LCBERCCW+7,X60 WTTA ADAPTER 000C 34210017 BNE DCEXCP NO 000C 34280017 SH CCWREG,H8 PREPARE RESTART FOR WTTA 000C 34350017 LR W8,CCWREG ON WRITE WRU CCW 000C 34420017 DCEXCP ST W8,LCBSTART-1 INITIALIZE IOBSTART 34500013 BALR W5,W5 IF LINE ERROR RECORDING 37500013 * REQUIRED GO TO DCLERB ELSE, 38000013 * RETURN VIA W5 38500013 SVC EREXCP ERROR EXECUTE CHANNEL PROG.23168 38700018 SVC RETURN RETURN 39000013 DCPERM MVI LCBERRCT+1,X2 INDICATE LINE ERROR RECORDING TO 40000013 * EXIT TO POST AND POST TO WRITE 40500013 * MESSAGE 41000013 BALR W5,W5 IF LINE ERROR RECORDING 41500013 * REQUIRED GO TO DCLERB ELSE, 42000013 * RETURN VIA W5 42500013 LA LINKREG,POSTMOD(LINKREG) NAME OF POST MODULE 43000013 B DCLINK 43500013 DCBRIN BR W5 RETURN TO INSTRUCTION FOLLOWING 44000013 * BALR FOR LINE ERROR RECORDING 44500013 DCTXTER STH W1,LCBERRST STORE UPDATED HALF WORD 45000013 TM LCBERRST+1,X3 HAS RETRY FAILED 45500013 BO DCPERM Y&ST -&R-A-&-T &RR-- 46000013 MVI LCBERRCT+1,X1 INDICATE LINE ERROR RECORDING TO 46500013 * POST WITHOUT MESSAGE 47000013 ********************************************************************** 47500013 * "NOTE : FOLLOWING CODE IS EXECUTED WITHOUT A BASE REGISTER 48000013 * WHEN ENTERED VIA BALR 48500013 DCLERB MVI LCBINCAM+1,X1 INDICATE DATA CHECK UP DATE FOR 49000013 * LINE ERROR RECORDING 49500013 DCLINK L RETREG,X10 CVT ADDRESS 50000013 L RETREG,X2C(RETREG) ADDRESS OF LINK ROUTINE 50500013 BR RETREG LINK TO NEXT MODULE 51000013 ********************************************************************** 51500013 DCSNO LA W5,DCBRIN SET SO NO LINE ERROR RECORDING 52000013 OI LCBERRST,X1 INDICATE SHOULD NOT OCCUR ERROR 52500013 DCTRLUNT MVC LCBERCCW+7(1),D19(UCBREG) CTRL UNIT TYPE TO WORK AREA 53000013 NI LCBERCCW+7,X0F MASK OUT ADAPTER TYPE 53500013 CLI LCBERCCW+7,X2 CONTROL UNIT A 2701 54000013 BNE DCPERM NOT 2701, INDICATE PERM ERROR 20800 58000017 DCDIAGWR MVI LCBERRCT+1,X4 INDICATE LINE ERROR RECORDING TO 63000013 * EXIT TO DIAGNOSTIC WRITE/READ 63500013 BALR W5,W5 IF LINE ERROR RECORDING 64000013 * REQUIRED GO TO DCLERB ELSE, 64500013 * RETURN VIA W5 65000013 LA LINKREG,DIAGLOD NAME OF DIAGNOSTIC WRITE/READ 65500013 B DCLINK MODULE 66000013 DCKPOLL CLI X0(CCWREG),XD IS IT A BREAK CCW 000C 66200017 BE DCTRLUNT YES 000C 66400017 CLI X0(CCWREG),X9 IS OT A POLL CCW 000C 66600017 BNE DCSNO NO, SHOULD NOT OCCUR 67000013 DCRDPOLL LA LINKREG,POLMOD POLL MODULE 67500013 STH W1,LCBERRCT ERROR HALF WORD 68000013 B DCLINK 68500013 EJECT 69000013 * 69500013 * CONSTANTS 70000013 * 70500013 SPACE 2 71000013 X0 EQU 0 71500013 X1 EQU 1 72000013 X2 EQU 2 72500013 X3 EQU 3 73000013 X4 EQU 4 73500013 X5 EQU 5 74000013 X6 EQU 6 74500013 X7 EQU 7 75000013 X9 EQU 9 75500013 XA EQU 10 76000013 XD EQU 13 000C 76200017 X0F EQU 15 76500013 X10 EQU 16 77000013 X20 EQU 32 77500013 X2C EQU 44 78000013 X2F EQU 47 78500013 X30 EQU 48 79000013 X40 EQU 64 79500013 X60 EQU 96 000C 79700017 X90 EQU 144 80000013 XF0 EQU 240 80500013 XFC EQU 252 81000013 XFE EQU 254 81500013 D17 EQU 17 82000013 D19 EQU 19 82500013 H8 DC AL2(8) 83000013 H48 DC AL2(48) 83500013 EREXCP EQU 15 84000013 RETURN EQU 3 84500013 POLMOD EQU 45 85000013 DIAGLOD EQU 1046 NAME OF DIAG W/R MODULE 85500013 LERBMOD EQU 2046 NAME OF LINE ERROR REC MODULE 86000013 POSTMOD EQU 2999 NAME OF POST MODULE 86500013 SPACE 2 87000013 EJECT 87500013 LCBD QTAM=3 88000013 END 88500013 ./ ADD SSI=01012881,NAME=IGE0104F,SOURCE=0 TITLE 'IGE0104F QTAM ERP DIAGNOSTIC WRITE/READ MODULE' 00900013 IGE0104F CSECT 01800013 *********************************************************************** 01810000 * * 01820000 *STATUS- CHANGE LEVEL 003 * 01830000 * * 01840000 *FUNCTION- AFTER ADJUSTING TO THE FAILING CCW,THE SENSE BYTE, CSW, AND* 01850000 * FAILING CCW ARE SAVED BEGINNING AT LCBCPA + 32. THIS INFORMATION * 01860000 * IS USED FOR AN ERROR MESSAGE. LCBSENSE IS ZEROED AND THE * 01870000 * DIAGNOSTIC WRITE/READ RETURN CODE (X'04') IS SET IN LCBERRCT + 1 * 01880000 * FIELD OF THE LCB. * 01890000 * THE DISABLE OP CODE IS SET IN LCBERCCW FOLLOWED BY THE CCWS * 01900000 * FOR A DIAGNOSTIC WRITE, DIAGNOSTIC READ, AND ENABLE. THE TEST DATA* 01910000 * FOR THE PARTICULAR DEVICE IS MOVED AFTER THE CCWS IN LCBCPA + 24. * 01920000 * THE ADDRESS OF THE TEST DATA IS STORED IN THE CCW AT LCBCPA. THE * 01930000 * ENABLE IS CHAINED EXCE