FTN4,L SUBROUTINE XXTD3,91711-18032 REV 1926 790906 * * DATE: MARCH 15, 1979 * NAME: XXTD3 * SOURCE: 91711-18032 * RELOC: NONE * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * RETURN END C END$ CFTN4,L SUBROUTINE DNMPL(ILU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE REMOVES A MULTIPOINT LINE. C LINES ARE REMOVED WHEN PRESENTLY INITIALIZED. IF A LINE IS C DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE C THE LINE IS MADE. C C ILU = CONSOLE LU C ILLU = LIST LU C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA ICWORD/0,2100B/ DATA ICCC/7/ 5 CALL IMSG6(ILLU,0,0,0,IARAY,6,11) C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE IF IERCD = 7 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.NE.7) GO TO 15 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C REMOVE THE LINE ICW=IOR(100000B,LINE) ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(3,ICWORD,ICW) C 45 CALL IMSG6(ILLU,INLU,LINE,0,IARAY,2,11) C C SET INLU AND ITLU TO ZERO C INLU = 0 ITLU = 0 C C END MULTIPOINT LINE REMOVAL 900 RETURN END C END$ CFTN4,L SUBROUTINE VMPLN(ILU,INLU,ILLU, +IARAY,IXLU),91711-1X032 REV 1926 790906 C 27.08.79 C THIS SUBROUTINE USES THE MULTIPOINT LINE LU TO FIND THE C TERMINALS TO BE VERIFIED. ALL ACTIVE TERMINALS ARE FOUND C BY A "WHO ARE YOU" POLL ON THE LINE, THE RESPONDING TERMINAL ID C ARE THEN USED TO FIND THE EQT ASSIGNMENTS AND THE LU NUMBERS. C THOSE ID NOT FOUND IN THE EQT FROM THE WRU RESPONSE ARE FLAGGED C AS OFF-LINE. THOSE ID FOUND IN THE EQT BUT NOT AMONG THE WRU C RESPONSE ARE FLAGGED AS EQT VERIFY FAILURES. THE REMAINING LU C ARE VERIFIED. AS EACH LU IS VERIFIED, THOSE LU FAILING THE VERIFY C DISPLAYED WITH COMMENTS. WHEN ALL ACTIVE LU ARE VERIFIED, THE C OFF-LINE TERMINALS ARE VERIFIED. C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C C C DIMENSION IARAY(3),IOFLN(30),IBUFX(28),IGRUP(30) ICNT = 0 C C INITIALIZE BUFFERS C CALL SFILL(IBUFX,1,56,000B) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C TXTD1 - VERIFY LINE C 5 CALL IMSG4(ILLU,0,0,0,0,IARAY,11) C C IF INLU IS ZERO, GET A LINE LU C IF(INLU.GT.0) GO TO 20 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 19 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 20 CALL IMSG4(ILLU,INLU,0,0,1,IARAY,11) ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C IF LINE LU INLU IS INITIALIZED, NO TRMLS ASSIGNED, DO OFF LINE C IF(IERCD.EQ.7) GO TO 29 IF(IERCD.NE.9) GO TO 19 C C SKIP THE LINE LIST IF THE RUN STRING PARAMETERS DIRECT THE C LINE VERIFY. C IF(IXLU) 23,22 C C LINE IS INITIALIZED, TERMINALS ARE ASSIGNED. SHOW LINE LIST. C 22 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO THE ACTIVE TERMINALS CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C TXTD1 - VERIFY ACTIVE TERMINALS C 23 CALL IMSG4(ILLU,0,0,0,3,IARAY,11) C L = 1 IF(INLU.EQ.0) GO TO 24 L = INLU - 1 24 L = L+1 ICCC = 10 CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) C IF(IERCD.EQ.1) GO TO 26 IF(IERCD.EQ.3) GO TO 26 IF(IERCD.EQ.-2) GO TO 26 IF(IERCD.EQ.5) GO TO 25 IF(IERCD.EQ.6) 26,25 25 IF(L.EQ.99) GO TO 29 GO TO 24 C C C C C C C C CALL THE TERMINAL VERIFY SUBROUTINE C C C C 26 IXLU = -1 CALL VMPTL(ILU,INLU,ILLU,L,IARAY,IXLU) GO TO 24 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO THE OFF LINE TERMINALS CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C TXTD1 - VERIFY OFF LINE TERMINALS C 29 CALL IMSG4(ILLU,0,0,0,2,IARAY,11) ID = 040175B C C C C 30 DO 40 J = 1,27 L = INLU C C SHOW THE OFF LINE ID C CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,-1) C C ARE THERE OFF LINE TRMLS ? C IF(IOFLN(1)) 40,33 C C ARE ALL ID IN THIS GROUP UNIQUE ? C 33 IF(IBUFX(2) - 1) 50,51 C C YES, OK TO DEAL WITH THIS GROUP C 50 ICCC = 10 CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) C C IS L A DORMANT MULTIPOINT LU ? C IF(IERCD.EQ.0) 35,34 34 IF(L.EQ.99) GO TO 44 L = L+1 GO TO 33 C C TXTD1 * ab NOT VERIFIED C 51 CALL IMSG3(ILLU,0,0,IBUFX(3),7,IARAY,11) ICNT = ICNT + 1 GO TO 40 C C DORMANT TRML LU HERE C 35 CALL ILINA(INLU,LINE,IE16,IE11) I4LIN = LINE*10000B KK = 1 IDCT = 0 ITLU = L C C FOR EACH VALID ID, INITIALIZE, VERIFY, AND REMOVE THE TERMINAL C DO 36 K = 2,IOFLN(1) IYLU = 0 KGID = IOR(IAND(IOFLN(K),057400B),40B) 357 ICWG = IAND(IOFLN(K),37400B)/4B ICWD = IAND(IOFLN(K),077B) ICW = IOR((IOR(I4LIN,ICWG)),(ICWD)) C C INITIALIZE TRML, VERIFY TERMINAL C CALL UPMPT(ILU,INLU,ILLU,ITLU,ICW,IYLU,IARAY) IF(IYLU.GT.0) GO TO 41 C C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB PASS C CALL IMSG4(ILLU,ITLU,0,IOFLN(K),5,IARAY,11) C C *LN R TL MM PASS* C C CALL IMSG3(ILLU,LINE,ITLU,IOFLN(K),IARAY,3,11) GO TO 43 C C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB FAIL C 41 CALL IMSG4(ILLU,ITLU,0,IOFLN(K),9,IARAY,11) C C REMOVE TRML C 43 CALL DNMPT(ILU,ILLU,ITLU,IARAY) ICNT = ICNT+1 36 CONTINUE GO TO 40 C C C TXTD1 * AB NOT VERIFIED C 44 DO 45 K = 2,IOFLN(1) 45 CALL IMSG3(ILLU,0,0,IOFLN(K),IARAY,7,11) ICNT = ICNT+1 C C UPDATE THE GROUP UNDER TEST C 40 ID = ID + 400B C C C C C IF(ICNT-1) 42,900 C C TXTD1 - NO OFF LINE TERMINALS PRESENT 42 CALL IMSG4(ILLU,0,0,0,4,IARAY,11) C C END MULTIPOINT VERIFY C 900 RETURN END C END$ CFTN4,L SUBROUTINE VMPTL(ILU,INLU,ILLU,ITLU,IARAY, +IXLU),91711-1X032 REV 1926 790906 C 06.11.79 C THIS SUBROUTINE VALIDATES THE MULTIPOINT LINE LU AND TERMINAL C LU BEFORE VERIFYING THE TERMINAL LU. C IF INLU OR ITLU POINTS TO EQT = 0, NO VERIFY IS MADE. C FOR NEGATIVE IXLU, INTERACTIVE PROMPTS ARE INHIBITED. C FOR INLU NOT USEABLE, NO VERIFY IS MADE. C FOR ITLU HAVING ITS ASSIGNED EQT DOWN, AN ATTEMPT IS C MADE TO UP THE EQT. THE TRML LU IS VERIFIED, THEN IF C THIS LU HAD ITS EQT UPPED BEFORE BEING VERIFIED, THE C EQT IS DOWNED. C C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C ITLU = TERMINAL LU C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C C C DIMENSION IGRUP(30),IARAY(3),IOFLN(30) C C INITIALIZE BUFFERS C CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C TXTD1 - VERIFY A TERMINAL C 5 CALL IMSG6(ILLU,0,0,0,IARAY,7,11) C C IF INLU IS ZERO, GET A LINE LU C IF(INLU.GT.0) GO TO 20 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 20 ICCC = 9 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.5) GO TO 900 IF(IERCD.EQ.7) GO TO 19 IF(IERCD.NE.9) GO TO 15 C C 19 IF(IXLU) 24,21 C C SHOW THE LINE C 21 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C IF ITLU IS ZERO, GET A TERMINAL LU. CHECK THAT THE TERMINAL LU C IS NOT THE SAME AS THE LINE LU. C 24 IF(ITLU.GT.0) GO TO 27 C IF(INLU.EQ.ITLU) GO TO 30 C C GET A TRML LU C 26 CALL IMSG7(ILU,ITLU,IARAY,3,11) C IF(ITLU.EQ.0) GO TO 15 C C CHECK THE LU C GO TO 27 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GET THE TERMINAL EQT NUMBER AND TRY TO UP THE EQT C THE VALUE OF ICCC RETURNED BY LUCHK FOR IERCD = 3 IS C THE INTEGER EQT NUMBER FOR THE TERMINAL LU. C 22 IUPDN = ICCC CALL IMSG3(ILLU,ICCC,IX,0,IARAY,9,11) C C IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO UP AN EQT. C IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED. C GO VERIFY THE TERMINAL ANYWAY, REPORT THE EQT STRUCTURE. C ICCC = 10 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) C IF(IERCD.EQ.6) GO TO 28 C C THIS EQT CANNOT BE VERIFIED. C TXTD1 * LN E TL AB** NOT VERIFIED C 18 CALL IMSG3(ILLU,LINE,ITLU,025052B,IARAY,0,11) GO TO 900 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C CHECK TERMINAL ASSIGNMENT C 27 ICCC = 6 IUPDN = -1 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.3) GO TO 29 IF(IERCD.EQ.5) GO TO 900 IF(IERCD.EQ.6) GO TO 29 IF(IERCD.EQ.-2) GO TO 29 C C THERE'S SOMETHING WRONG WITH USING THIS LU THAT AN :UP,EQT C WON'T FIX. IF THIS IS A VERIFY SPECIFIED TO RUN TO COMPLETION C BY THE RUN PARAMETERS, SHOW A NOT VERIFIED MESSAGE. OTHERWISE C ASK THE OPERATOR FOR ANOTHER LU. C IF(IXLU) 18,26 C C C C C C GET THE TERMINAL ID CHARACTERS FROM THE EQT C 29 CALL ILINA(ITLU,LINE,ITID,IE11) KGID = IOR(IAND(ITID,057400B),40B) ID = IOR(KGID,175B) C C IF THE TERMINAL LU OR EQT IS DOWN, TRY TO UP THE EQT BEFORE C VERIFYING THE TERMINAL LU. C 31 IF(IERCD.EQ.3) GO TO 22 IF(IERCD.EQ.-2) GO TO 22 C C VERIFY THE TERMINAL C 28 IXLU = 0 CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,5,IXLU,IARAY) IF(IXLU.GT.0) GO TO 30 C C TXTD1 - VERIFY MULTIPOINT TRML LU NNAB PASS C CALL IMSG4(ILLU,ITLU,0,ITID,5,IARAY,11) C C *LN L TL NN PASS* C C CALL IMSG3(ILLU,LINE,ITLU,ITID,IARAY,3,11) GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU NNAB FAIL C 30 CALL IMSG4(ILLU,ITLU,0,ITID,9,IARAY,11) C C DOWN THE EQT IF THE EQT WAS UPPED BEFORE VERIFICATON. C 40 IF(IUPDN) 900,41 C C DOWN THE EQT = IUPDN C 41 CALL IMSG3(ILLU,IUPDN,IX,0,IARAY,2,11) C C IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO DOWN THE C EQT. IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED. C C C 900 RETURN END C END$ CFTN4,L SUBROUTINE UPMPL(ILU,INLU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE INITIALIZES A MULTIPOINT LINE. C LINES THAT ARE ALREADY INITIALIZED WILL NOT BE RE-INITIALIZED AND C A WARNING MESSAGE IS OUTPUT. C C ILU = CONSOLE LU C ILLU = LIST LU C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C C C DIMENSION IREG(2),ICWORD(2),IARAY(3),IMESS1(1) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA IMESS1/15505B/ DATA ICWORD/0,0/ DATA IFUN/2000B/ DATA ICCC/4/ C C TXTD1 - INITIALIZE A LINE C 5 CALL IMSG6(ILLU,0,0,0,IARAY,8,11) C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,0,11) IF(INLU.EQ.0) GO TO 9999 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE IF IERCD = 4 C CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.4) GO TO 25 IF(IERCD.EQ.7) GO TO 60 IF(IERCD.EQ.9) GO TO 60 GO TO 15 C C ENTER TIMEOUT AND LINE NUMBER DATA C 25 CALL IMSG7(ILU,ITOV,IARAY,8,11) 35 CALL IMSG7(ILU,ILNN,IARAY,9,11) C C INITIALIZE THE LINE C ICW=IOR(IOR(100000B,(ITOV*1000B)),ILNN) ICWORD(1) = IOR(100000B,INLU) ICWORD(2) = IFUN REG = XLUEX(3,ICWORD,ICW) ID = 17776B ICWORD(2) = 400B REG = XLUEX(2,ICWORD,IMESS1,1,ID) C C TXTD1 - LINE LU N INITIALIZED. ASSIGNED LINE NO. M. C 45 CALL IMSG6(ILLU,INLU,ILNN,0,IARAY,1,11) GO TO 9999 C C SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED TO THIS LINE 60 CONTINUE CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C INUM = 0 NO MULTIPOINT DEVICES ASSIGNED C INUM = 1 LINE IS ASSIGNED C INUM > 1 LINE AND TERMINALS ASSIGNED 63 GO TO 15 9999 CONTINUE C C END MULTIPOINT LINE INITIALIZATION C RETURN END C END$ CFTN4,L SUBROUTINE OFFLN(ILU,INLU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 27.06.79 C THIS SUBROUTINE SHOWS OFF LINE MULTIPOINT TERMINAL ID C FOR ALL GROUPS. ONLY THOSE TERMINAL ID WHICH ARE CLEAR FOR C VERIFICATON ARE SHOWN. C NO PARAMETERS IN THE CALL STRING ARE MODIFIED. C THIS SUBROUTINE IS CALLED BY TXTD3. C C ILLU = LIST LU C INLU = LINE LU C DIMENSION IREG(2),IOFLN(30),IBUFX(28),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) C CALL SFILL(IBUFX,1,56,000B) CALL SFILL(IOFLN,1,60,000B) C C C SKIP THE LINE LU ENTRY IF THE CURRENT INLU IS VALID. C IF(INLU.EQ.0) GO TO 11 ICNT = 0 10 ICCC = 11 CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC) IF(IERXX.EQ.7) GO TO 15 IF(IERXX.EQ.9) GO TO 15 C C ENTER THE LINE LU. ENTER 0 TO ABORT C 11 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 GO TO 10 C C C 15 ID = 040175B DO 60 J = 1,27 C SHOW THE OFF LINE ID CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,1) IF(IOFLN(1)) 60,20 20 ICNT = ICNT+1 60 ID = ID + 400B C C IF(ICNT-1) 61,900 C TXTD1 - NO MULTIPOINT TERMINALS PRESENT 61 CALL IMSG4(ILLU,0,0,0,4,IARAY,11) C 900 RETURN END C END$ CFTN4,L SUBROUTINE IMPXX(ITLU,ILLU,INLU,IARAY, +IFFF),91711-1X032 REV 1926 790906 C 10.29.79 C THIS SUBROUTINE DISPLAYS THE MULTIPOINT LINE AND TERMINAL C CONFIGURATION FOR THE 3075A, 3076A, 3077A TERMINALS. C ITLU, ILLU, INLU, IARAY, IFFF ARE PASSED TO IMPXX IN ALL CASES. C INLU AND IFFF ARE REDEFINED IN THE FOLLOWING WAY: C C ITLU = MULTIPOINT LU C ILLU = LIST LU C INLU = LINE LU C IF ITLU IS A LINE LU, THEN INLU = ITLU. THIS WORKS FOR C A LINE LU BEING THE NUMERICALLY SMALLEST NUMBER AND THEREFORE C THE FIRST TYPE 7 EQT AS THE DRT IS SEARCHED IN ASCENDING C NUMERICAL ORDER. IF A SECOND LINE LU IS DEFINED, INLU WILL C BE REDEFINED AS THE CURRENT LINE LU. GENERATION OF TWO LINES C IN A SYSTEM MUST GROUP INTENDED LU TO BE ATTACHED TO EACH C LINE IN NUMERICAL ORDER BY LINE LU. (I.E., INLUA, ITLUA1, C ITLUA2, ITLUA3,...,INLUB, INLUB1, INLUB2, INLUB3,...) C IFFF = MESSAGE FORMAT CONTROL ON ENTRY, ITLU CONDITION CODE ON EXIT C = -1, SURVEY MESSAGE ON ENTRY, OTHERWISE VERIFY MESSAGE C = -2, ITLU IS NOT AVAILABLE FOR VERIFICATION ON EXIT C C CALLS: X13 ASSEMBLY ROUTINE FOR STATUS REQUEST ON C SYSTEM LU. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ITSTA GET MULTIPOINT TERMINAL STATUS FROM ACTIVE C MULTIOINT TERMINAL. C C C C DIMENSION IREG(2),IBUFR(128),IMDL5(3),IMDL6(3),IMDL7(3), +IBT41(1),IBT42(1),IBT43(1),IBT44(1),IBT51(1),IBT52(1),IBT53(2), +IMESS1(2),IMESS2(2),IMESS3(2),IMESS4(3),IMESSA(2),IMESSB(2), +IMESSC(3),IBT45(1),IBT46(1),IBT47(3), +XGRUP(30),IBUFS(28),IBUFV(60), +ICWORD(2),IBUFX(28),IBT48(3),IBT49(1),IMESSD(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) INTEGER XGRUP DATA IMDL5/2H30,2H75,2HA / DATA IMDL6/2H30,2H76,2HA / DATA IMDL7/2H30,2H77,2HA / DATA IBT41/2H P/ DATA IBT42/2H M/ DATA IBT43/2H V/ DATA IBT44/2H -/ DATA IBT45/2H */ DATA IBT46/2H**/ DATA IBT47/2H**,2H**,2H* / DATA IBT48/2H*2,2H64,2HX / DATA IBT49/2H*S/ DATA IBT51/2H N/ DATA IBT52/2H A/ DATA IBT53/2H -,2H- / DATA IMESS1/2HLI,2HNE/ DATA IMESS2/2HTR,2HML/ DATA IMESS3/2HDO,2HWN/ DATA IMESS4/2H ,2H ,2H / DATA ICCC/10/ DATA ICWORD/0,0/ DATA IMESSD/2H ,2H: ,2H / DATA IMESSC/2H ,2H ,2H / DATA IMESSA/2H ,2H / DATA IMESSB/2H ,2H / ISINT = 0 ISPR = 0 ISRM = 0 ISLM = 0 ISMDL = 0 ISDSY = 0 ISKY = 0 IFBIT = 0 ISCOD = 0 C IDRT= IGET(1652B) IEQTA=IGET(1650B) C IVAL =IGET(IDRT+ITLU-1) IEQQ = IAND(IVAL,077B) C C STATUS REQUEST ON ITLU. X13 SETS BYPASS CONDITION. CALL X13(ITLU,IEQT5,IEQT4,IEQTST) C C CHECK FOR TYPE 7 DEVICE AT THIS LU C IDVC7 = IAND(IEQT5,037400B) CALL SHFT(IDVC7) C IDVC7 HAS LOWER 8 BITS CONTAINING INFORMATION IF(IDVC7.NE.7) GO TO 900 C IF LU IS POINTED TO EQT 0, SHOW THE LU IF(IEQQ.EQ.0) GO TO 12 C CHECK FOR NONZERO SELECT CODE ASSIGNMENT ISCOD =IAND(IEQT4,077B) IF(ISCOD.EQ.0) GO TO 900 C C C DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT IAV = IEQT5 CALL SHF14(IAV) IFBIT=IEQTST CALL SHF15(IFBIT) IEQ5S=IAND(IEQT5,377B) C DETERMINE IF LU IS LINE OR TERMINAL IETBL=(IEQQ-1)*15+IEQTA IE11 = IGET(IETBL+10) IEQX = IGET(IETBL+12) IE16 =IGET(IEQX) IE17 =IGET(IEQX+1) LBIT=IE16 CALL SHF15(LBIT) LINE = IAND(IE17,03400B) CALL SHFT(LINE) C INITIALIZE VARIABLES FOR LISTING 12 ILLP=0 ILNN=55B CALL SFILL(IMESSC,1,6,040B) IKY=40B IDSY=40B ILM =40B IRM =40B INT =20040B IPR =40B IHRS=20040B IMIN=20040B C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DETERMINE IF TERMINAL IS INITIALIZED, SHOW NO MESSAGE C C WRITE(ILLU,110) INLU,ITLU 110 FORMAT(2X"IMPXX N:",I2X,"T:",I2) ICCC = 10 20 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) C C IF(IERCD.EQ.-1)GO TO 29 IF(IERCD.EQ.-2)GO TO 29 IF(IERCD.EQ.0) GO TO 21 IF(IERCD.EQ.1) GO TO 30 IF(IERCD.EQ.2) GO TO 40 IF(IERCD.EQ.3) GO TO 30 IF(IERCD.EQ.4) GO TO 23 IF(IERCD.EQ.5) GO TO 40 IF(IERCD.EQ.6) GO TO 25 IF(IERCD.EQ.7) GO TO 27 IF(IERCD.EQ.8) GO TO 10 IF(IERCD.EQ.9) GO TO 27 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DORMANT MULTIPOINT TERMINAL C 21 DO 22 J=1,2 IMESSA(J)=IMESS2(J) IMESSB(J)=IMESS4(J) 22 CONTINUE GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DORMANT MULTIPOINT LINE C 23 DO 24 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS4(J) 24 CONTINUE GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C NONZERO SUBCHANNEL C 29 IMESSA(1) = IBT49 IMESSA(2) = KCVT(IAND(IEQTST,17B)) CALL SFILL(IMESSB,1,4,0040B) C C IF THIS LU SHARES AN EQT, THEN THE EQT MAY HAVE A LINE NUMBER. C IF(IE11.NE.0) ILNN = KCVT(LINE) C C IF THIS LU IS UNAVAILABLE AS WELL, GO FILL IN THE DOWN MESSAGE C IF(IERCD.EQ.-2) GO TO 291 GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C********************************************************************* C C ACTIVE MULTIPOINT TERMINAL C 25 IMESSA(1)=IE16 IMESSA(2)=020040B DO 26 J=1,2 IMESSB(J)=IMESS4(J) 26 CONTINUE ILNN = KCVT(LINE) C C FOR INLU = 0, COMPLETE IMMEDIATELY C IF(INLU.EQ.0) GO TO 10 C C GET TERMINAL CONFIGURATION DATA C C************************************************************** C C INITIALIZE BUFFERS C 13 CALL SFILL(XGRUP,1,60,000B) CALL SFILL(IBUFS,1,56,000B) CALL SFILL(IBUFX,1,56,000B) IBUFL = 128 CALL SFILL(IBUFR,1,256,000B) IF(IE11.NE.0) ILLP = 1 C C 132 CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC) C C IF(IERXX.EQ.9) GO TO 133 GO TO 10 C C GET THE GROUP ID FOR ITLU 133 CALL ILINA(ITLU,ILXX,IE16,IE11) KGID = IOR(IAND(IE16,057400B),40B) C C GET ALL TERMINALS IN CURRENT GROUP WITH WRU CALL IGRID(INLU,KGID,XGRUP) IF(XGRUP(1)) 608,137 C C CHECK XGRUP FOR DUPLICATE ID. ANY DUPLICATES ARE PUT IN IBUFX. 137 CALL IXBUF(XGRUP,IBUFX) C C GET ALL LU IN CURRENT GROUP RETURNED IN IBUFS C IBUFS(1) = INLU , IBUFS(2) = NUMBER OF NONZERO WORDS IN IBUFS C IBUFS(3) = ITLU1, IBUFS(4) = ITLU2, IBUFS(5) = ITLU3 ... 608 CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C WERE ANY LU IN CURRENT GROUP ? IBUFS(2) WILL BE 3 OR GREATER. IF(IBUFS(2) - 3) 165,139 C C************************************************************ C THERE ARE LU IN THE CURRENT GROUP. SORT IT OUT. C 139 IDVCT = 0 KK = 1 CALL SFILL(IBUFV,1,120,000B) IBUFV(1) = -1 C C EACH LU IN IBUFS HAS AN ID IN CURRENT GROUP. IF MATCH IS NOT C ONE-ONE SAVE THE DATA. C DO 145 J = 3,IBUFS(2) IDCT = -1 C DO 143 K = 2,XGRUP(1) C COUNT HOW MANY TRML ID ARE IN WRU LIST IF(XGRUP(K).NE.IE16) 143,142 142 IDCT = IDCT+1 IDVCT = IDVCT+1 143 CONTINUE C C IDCT = HOW MANY SIMILAR ID WERE FOUND IN THE CURRENT GROUP C IDCT = 0 IF ONE MATCH WAS FOUND. C IF(IDCT) 144,145,144 C IF MATCH IS NOT ONE-ONE, SAVE THE DATA IN IBUFV 144 CALL IVBUF(IDCT,IE16,IBUFS(J),IBUFV) 145 CONTINUE C C FOR A RESPONSE TO WRU IN THIS GROUP, INAT > 0. FOR THE EXPECTED C ONE-ONE MATCH BETWEEN ID'S IN EQT AND ID'S IN WRU RESPONSES, C AND INAT > 0, SET IDCT = 0. IF((INAT.EQ.IDVCT).AND.(INAT.GT.0)) IDCT = 0 C C************************************************************ C C IF IBUFV HAS ANY DATA ALL IS NOT WELL IF(IBUFV(1).GT.0) IERCT = IERCT+1 C C FIND ID IN WRU LIST ? IF(IDCT) 146,41 C C C NO ID IN WRU LIST. IS THIS A SURVEY OR VERIFY MESSAGE ? 146 IF(IFFF) 164,202 C SURVEY MESSAGE FOR ID NOT IN WRU 164 WRITE(ILLU,213)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP,ILNN, +IMESSA,IMESSB IFFF = -2 GO TO 900 C C ID FOUND IN WRU LIST C CHECK IBUFX FOR DUPLICATE ID IN WRU BEFORE GETTING CONFIGURATION C IBUFX(1) = -1 FOR NO DUPLICATE ID IN WRU 41 IF(IBUFX(1)) 147,36 C C C K POINTS TO ID, K-1 POINTS TO HOW MANY THERE ARE IN WRU LIST 36 K = 3 37 IF(IBUFX(K).EQ.IE16) 39,38 C C HAS THE LAST ID IN IBUFX BEEN CHECKED ? 38 IF(K.EQ.IBUFX(1)) 147,44 44 K = K+2 GO TO 37 C C DUPLICATE ID IN WRU, IS THIS A SURVEY MESSAGE ? 39 IF(IFFF) 42,43 C C SURVEY MESSAGE FOR DUPLICATE ID IN WRU 42 WRITE(ILLU,214)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP,ILNN, +IMESSA,IMESSB,IBUFX(K),IBUFX(K-1) IFFF = -2 GO TO 900 C C VERIFY MESSAGE FOR DUPLICATE ID IN WRU 43 WRITE(ILLU,220)ITLU,IEQQ,IMESSA,IMESSB,IBUFX(K),IBUFX(K-1) IFFF = -2 GO TO 900 C C C 147 CONTINUE 165 CONTINUE 163 CONTINUE C C THE ID ARE DISTINCT. IF IMPXX WAS CALLED BY ILIND, IFFF = 1. IF(IFFF) 150,150,202 C C IF THE LU OR EQT IS UNAVAILABLE, DO NOT GET THE TRML STATUS. C REPORT A DOWN SITUATION AND MARK INITIALIZED TRML WITH ***'S C 150 IF(IERCD.EQ.3) GO TO 61 IF(IERCD.EQ.1) GO TO 61 CONTINUE C C************************************************************** C 11 CALL ITSTA(ILLU,ITLU,IERCD,INT,IPR,IRM,ILM,IMDL,IDSY,IKY, +IHRS,IMIN,IARAY) C SAVE TERMINAL CONFIGURATION DATA ISINT = INT ISPR = IPR ISRM = IRM ISLM = ILM ISMDL = IMDL ISDSY = IDSY ISKY = IKY C CHECK ITSTA COMPLETION CODE IF(IERCD.EQ.0) GO TO 50 IF(IERCD.EQ.1) GO TO 69 IF(IERCD.EQ.2) GO TO 64 IF(IERCD.EQ.3) GO TO 65 IF(IERCD.EQ.4) GO TO 66 IF(IERCD.EQ.5) GO TO 67 IF(IERCD.EQ.6) GO TO 63 IF(IERCD.EQ.7) GO TO 70 IF(IERCD.EQ.-1) GO TO 60 C C TERMINAL STATUS AVAILABLE C TERMINAL RIGHT HAND MODULE 50 IF(ISRM.EQ.0) IRM = IBT44 IF(ISRM.EQ.1) IRM = IBT41 IF(ISRM.EQ.2) IRM = IBT42 IF(ISRM.EQ.3) IRM = IBT45 IF(ISRM.EQ.4) IRM = IBT43 IF(ISRM.EQ.5) IRM = IBT45 IF(ISRM.EQ.6) IRM = IBT45 IF(ISRM.EQ.7) IRM = IBT45 C TERMINAL LEFT HAND MODULE IF(ISLM.EQ.0) ILM = IBT44 IF(ISLM.EQ.1) ILM = IBT41 IF(ISLM.EQ.2) ILM = IBT42 IF(ISLM.EQ.3) ILM = IBT45 IF(ISLM.EQ.4) ILM = IBT43 IF(ISLM.EQ.5) ILM = IBT45 IF(ISLM.EQ.6) ILM = IBT45 IF(ISLM.EQ.7) ILM = IBT45 C TERMINAL DISPLAY IF(ISDSY.EQ.0) 510,511 510 IDSY = IBT51 GO TO 512 C 511 IDSY = IBT52 512 CONTINUE C C TERMINAL MODEL IF(ISMDL.EQ.0) GO TO 52 IF(ISMDL.EQ.1) GO TO 54 IF(ISMDL.EQ.2) GO TO 56 GO TO 58 C C 3075A 52 DO 53 J=1,3 IMESSC(J) = IMDL5(J) 53 CONTINUE GO TO 501 C C 3076A 54 DO 55 J=1,3 IMESSC(J) = IMDL6(J) 55 CONTINUE C C CONVERT TO ASCII - PRINTER BUSY STATE 501 IPR = IOR(ISPR,60B) C C TERMINAL INTERRUPT STATE 502 INT = IOR(IOR(ISINT*400B,30000B),102B) C C TERMINAL KEYBOARD C 503 IF(ISKY.EQ.0) 513,514 513 IKY = IBT51 GO TO 515 C 514 IKY = IBT52 515 CONTINUE GO TO 10 C C C 3077A 56 DO 57 J=1,3 IMESSC(J) = IMDL7(J) 57 CONTINUE C C SET THE HOURS AND MINUTES IN IMESSD IMESSD(1) = IHRS C ITMIN = IMIN C CALL SPUT(IMESSD,3,072B) C CALL SGET(ITMIN,1,JMT) CALL SGET(ITMIN,2,JMU) CALL SPUT(IMESSD,4,JMT) CALL SPUT(IMESSD,5,JMU) C C THERE'S NO KEYBOARD FOR 3077A C IKY = IBT44 GO TO 10 C C C UNKNOWN TERMINAL 58 DO 59 J=1,3 IMESSC(J) = IBT47(J) 59 CONTINUE GO TO 10 C C C C STATUS DATA IS NOT COMPLETE. ASSEMBLE IMESSA THEN FLAG THE C REMAINING FIELDS AS UNAVAILABLE. C C TRANSMISSION LOG IS ZERO 60 IMESSA(2) = 25052B C SET UNAVAILABLE FLAG IN REMAINING FIELDS 61 CONTINUE IPR = IBT45 INT = IBT46 IRM = IBT45 ILM = IBT45 IDSY= IBT45 IKY = IBT45 C IF(IERCD.EQ.1) 610,612 612 IF(IERCD.EQ.6) 610,620 C 610 IF(IFFF) 611,615 C SURVEY 611 IFFF = -2 GO TO 10 C C VERIFY 615 IFFF = -2 GO TO 201 C 620 DO 62 J=1,3 IMESSC(J)=IBT47(J) 62 CONTINUE GO TO 10 C C TRANSMISSION LOG IS 5, 264X TERMINAL 63 IMESSA(2) = 25052B DO 68 J = 1,3 68 IMESSC(J) = IBT48(J) GO TO 61 C C BYTE 6 IS NOT CR (15B) 64 IMESSA(2) = 25066B GO TO 61 C C C BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET 65 IMESSA(2) = 25063B GO TO 61 C C BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET 66 IMESSA(2) = 25064B GO TO 61 C C BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET 67 IMESSA(2) = 25065B GO TO 61 C C TRANSMISSION LOG IS NOT 3 OR 5, OR WORD 1 IS NOT RIGHT 69 IMESSA(2) = 25061B GO TO 61 C C TRANSMISSION LOG IS 4, UNKNOWN TERMINAL 70 IMESSA(2) = 25067B GO TO 61 C C C C********************************************************************* C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ACTIVE LINE, FILL IMESSA, IMESSB, AND ILNN FIELDS 27 DO 28 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS4(J) 28 CONTINUE ILNN = KCVT(LINE) INLU = ITLU GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C A MULTIPOINT DEVICE EQT OR LU IS DOWN. IERCD VALUES 5,1,2,3 C ARE TESTED AS SHOWN IN ORDERED LIST. 30 IF(LBIT.EQ.0) GO TO 32 C LINE HERE DO 31 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS3(J) 31 CONTINUE ILNN = KCVT(LINE) INLU = ITLU GO TO 10 C C C SIGN BIT IS CLEAR, DEVICE IS A TERMINAL. IS IT DORMANT? 32 IF(IE16.EQ.0) GO TO 34 C AN ACTIVE MULTIPOINT TERMINAL HERE. IMESSA(1) = IE16 IMESSA(2) = 020040B ILNN = KCVT(LINE) C C ENTER HERE FROM NONZERO SUBCHANNEL IF IERCD = -2 C 291 DO 33 J=1,2 IMESSB(J)=IMESS3(J) 33 CONTINUE C C IF THIS LU HAS A SUBCHANNEL AND IS UNAVAILABLE, DON'T GET STATUS C IF(IERCD.EQ.-2) GO TO 10 C C IF INLU = 0, WE CAN'T DO ANY LINE OPERATIONS FOR THIS ACTIVE LU. C COMPLETE IMMEDIATELY. C IF(INLU.EQ.0) GO TO 10 C C THE ONLY OTHER WAY TO GET THIS FAR WAS BY STATEMENT 20 C C SET UNAVAILABLE FLAG IN REMAINING FIELDS IF EQT IS IN LINKED LIST C IF(IE11.NE.0) GO TO 13 GO TO 10 C C C DORMANT MULTIPOINT TERMINAL HERE. 34 DO 35 J=1,2 IMESSA(J)=IMESS2(J) IMESSB(J)=IMESS3(J) 35 CONTINUE C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK LINKED LIST POINTER 10 IF(IE11.EQ.0) GO TO 45 ILLP = 1 C C C C C C SEND A SURVEY OR VERIFY MESSAGE C C IS THIS TERMINAL 3077A ? C 45 IF(ISMDL.EQ.2) 46,40 C C USE STATEMENT 47, 48 IF THIS IS SURVEY FORMAT AND 3077A TERMINAL C 46 IF(IFFF) 47,48,202 C C 3077A SURVEY MESSAGE C 47 WRITE(ILLU,204)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP, +ILNN,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM,IMESSD GO TO 900 C C 3077A VERIFY MESSAGE C 48 WRITE(ILLU,205)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM, +IRM,IMESSD GO TO 900 C C STATEMENTS 200, 201 USED FOR 3075A, 3076A TERMINALS. C IF IFFF = -1, SHOW SURVEY MESSAGE. OTHERWISE SHOW VERIFY MESSAGE. C 40 IF(IFFF)200,201,202 C C SURVEY MESSAGE C 200 WRITE(ILLU,210)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD, +IE17,ILLP,ILNN,IMESSA,IMESSB, +IMESSC,IKY,IDSY,ILM,IRM,INT,IPR C C CHECK IF THIS TERMINAL IS DOWN, SET IFFF = -2 IF IT IS. C IF(IERCD.EQ.-2) IFFF = -2 GO TO 900 C C VERIFY MESSAGE C 201 WRITE(ILLU,211)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM, +INT,IPR C C INHIBIT ANY MESSAGES TO THE TERMINAL LU IF ITLU OR THE EQT IS DOWN C IF(IERCD.EQ.3) IFFF = -2 GO TO 900 C C VERIFY MESSAGE FOR ID NOT IN WRU C 202 WRITE(ILLU,212)ITLU,IEQQ,IMESSA,IMESSB IFFF = -2 GO TO 900 C C C C C C C 3077A SURVEY 204 FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B",1XI1,2XR1,1X2A2, +1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2) C 3077A VERIFY 205 FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2) C C 3075A,3076A SURVEY 210 FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B", +1XI1,2XR1,1X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1) C 3075A, 3076A VERIFY 211 FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1) 212 FORMAT(18XI3,I3,2X2A2,1X2A2,1X"ID NOT IN WRU LIST") 213 FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), +1X"ID NOT IN WRU LIST") 214 FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), +1XA2" APPEARS",I2" TIMES IN WRU") 220 FORMAT(18XI3,I3,2X2A2,1X2A2,1XA2" APPEARS",I2" TIMES IN WRU") C 900 IF(IERCD.EQ.6) IFFF = -3 RETURN END C END$ CFTN4,L SUBROUTINE ITSTA(ILLU,ITLU,IERCD,IB31,IB32,IB41,IB42,IB51, +IB52,IB53,IHRS,IMIN,IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE GETS THE MULTIPOINT TERMINAL STATUS (6 BYTES) C FROM ACTIVE 3075A, 3076A, 3077A TERMINALS. THE CALLING PROGRAM C SHOULD CHECK ITLU BEFORE CALLING THIS SUBROUTINE. C C ILLU = LIST LU C ITLU = LU UNDER TEST C IERCD = COMPLETION CODE C = -1 TRANSMISSION LOG IS ZERO C = 0 TERMINAL STATUS AVAILABLE C = 1 WORD 1 IS NOT RIGHT OR TRANSMISSION LOG IS NOT 3 OR 5 C = 2 BYTE 6 IS NOT CR (15B) C = 3 BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET C = 4 BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET C = 5 BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET C = 6 TRANSMISSION LOG IS 5, 264X TERMINAL C = 7 TRANSMISSION LOG IS 4, UNKNOWN TERMINAL C C IB31 = OCTAL DIGIT INTERRUPT STATUS C IB32 = PRINTER BUSY FLAG. 1-BUSY. 0-NOT BUSY C IB41 = TERMINAL RIGHT HAND MODULE OCTAL CODE C IB42 = TERMINAL LEFT HAND MODULE OCTAL CODE C IB51 = TERMINAL MODEL NUMBER C IB52 = DISPLAY FLAG. 1-ALPHA 0-NUMERIC C IB53 = KEYBOARD FLAG. 1-ALPHA 0-NUMERIC C IHRS = 3077 HOURS C IMIN = 3077 MINUTES C C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C DIMENSION IREG(2),IBUFR(8),IBUFL(1),IMESS1(1),ICWORD(2), +IMESS3(1),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IMESS1/15536B/ DATA IBY3/0/ DATA IBY4/0/ DATA IBY5/0/ DATA IBY6/0/ DATA ICWORD/0,0/ DATA IBBB/100000B/ IBUFL = 0 IHRS = 0 IMIN = 0 5 CALL SFILL(IBUFR,1,16,000B) CALL EM(1,ITLU,ILLU,IARAY,IBBB) C STATUS REQUEST FROM THE TERMINAL ICWORD(1) = IOR(100000B,ITLU) CALL XLUEX(2,ICWORD,IMESS1,1) C STRIP RECORD SEPARATORS, CR-LF CHARACTERS WHEN POLLING TERMINAL REG = XLUEX(1,ICWORD,IBUFR,8) IBUFL = IB C IF IB = 0 THERE IS NO RESPONSE FROM TERMINAL. IF(IBUFL.EQ.0) GO TO 10 IF(IBUFL.EQ.1) GO TO 50 IF(IBUFL.EQ.3) GO TO 15 IF(IBUFL.EQ.4) GO TO 56 IF(IBUFL.EQ.5) GO TO 16 GO TO 50 C TRANSMISSION LOG IS ZERO 10 IERCD=-1 100 CALL IMSG6(ILLU,ITLU,0,0,IARAY,0,11) GO TO 998 C 3075A AND 3076A TERMINAL STATUS 15 IERCD=0 IF(IBUFR(1).NE.15534B) GO TO 50 C IBY3 = IBUFR(2) CALL SHFT(IBY3) IBY4 = IAND(IBUFR(2),377B) IBY5 = IBUFR(3) CALL SHFT(IBY5) IBY6 = IAND(IBUFR(3),377B) C 20 IF(IBY6.NE.15B) GO TO 51 IF(IBY3.LT.100B) GO TO 52 IF(IBY4.LT.100B) GO TO 53 IF(IBY5.LT.100B) GO TO 54 C IF(IBUFL.EQ.5) 22,21 C 21 IB31=IAND(IBY3,7B) IB32=(IAND(IBY3,40B))/40B GO TO 23 22 IB31 = 0 IB32 = 0 23 IB41=IAND(IBY4,7B) IB42=(IAND(IBY4,70B))/10B IB51=IAND(IBY5,7B) IB52=IAND(IBY5,20B) IB52 = IB52/20B IB53=IAND(IBY5,40B) IB53 = IB53/40B GO TO 998 C 3077A TERMINAL STATUS OR 264X STATUS ? 16 IERCD=0 IF(IBUFR(1).NE.15534B) GO TO 50 I77A = IAND(IBUFR(4),177400B) IF(I77A.NE.040000B) GO TO 55 C C 3077A STATUS IBY6 = IAND(IBUFR(5),377B) IBY5 = IBUFR(5) CALL SHFT(IBY5) C IBY4 = IAND(IBUFR(4),377B) IBY3 = IBUFR(4) CALL SHFT(IBY3) C IHRS = IBUFR(2) IMIN = IBUFR(3) GO TO 20 C TRANSMISSION LOG LENGTH IS NOT RIGHT 50 IERCD=1 GO TO 998 C TRANSMISSION LOG TERMINATION BYTE IS NOT CR (15B) 51 IERCD=2 GO TO 998 C BIT 7 IN BYTE 3 IS ZERO 52 IERCD=3 GO TO 998 C BIT 7 IN BYTE 4 IS ZERO 53 IERCD=4 GO TO 998 C BIT 7 IN BYTE 5 IS ZERO 54 IERCD=5 GO TO 998 C 264X TERMINAL ENABLE ROUTINE POLLING 55 IERCD = 6 CALL EM(1,ITLU,ILLU,IARAY,1401B) GO TO 999 C UNKNOWN TERMINAL, LEAVE IT WITH ROUTINE POLLING DISABLED 56 IERCD = 7 GO TO 999 C C DATACAP TERMINALS NEED THIS 998 CALL EM(1,ITLU,ILLU,IARAY,101000B) C C 999 RETURN END C END$ CFTN4,L SUBROUTINE LUCHK(ILLU,ITLU,IERCD,IARAY, +ICCC),91711-1X032 REV 1926 790906 C 10.26.79 C THIS SUBROUTINE CHECKS FOR MULTIPOINT LU ASSIGNMENTS RETURNING C TO THE CALLING PROGRAM A COMPLETION CODE (IERCD) C C ILLU = LIST LU C ITLU = LU UNDER TEST C IERCD= COMPLETION CODE RETURNED TO CALLER C = 1 : LU IS DOWN C = 2 : LU IS NOT DEVICE TYPE 7 C = 3 : EQT IS DOWN OR EQT STATE IS NOT CLEAR (IE17) C = 4 : LU IS ASSIGNED TO A DORMANT MULTIPOINT LINE C = 5 : LU HAS NO EQT ASSIGNMENT C = 6 : LU IS ASSIGNED TO AN INITIALIZED MULTIPOINT TERMINAL C = 7 : LU IS ACTIVE LINE WITH NO TERMINALS ASSIGNED C = 8 : LU IS NOT IN A LINKED LIST C = 9 : LU IS ACTIVE LINE WITH TERMINALS ASSIGNED C = 0 : LU IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL C =-1 : LU HAS NONZERO SUBCHANNEL C =-2 : LU HAS NONZERO SUBCHANNEL AND THE LU OR EQT OR BOTH C ARE UNAVAILABLE C C ICCC = INTEGER PASSED TO IMSG1 C ICCC = RETURNS INTEGER EQT NUMBER FOR UNAVAILABLE LU NUMBERS C (IERCD = 3,-2) C C CALLS: X13 ASSEMBLY ROUTINE FOR STATUS REQUEST ON C SYSTEM LU. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWERE C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: IMSG1 SHOW A MESSAGE ASSOCIATED WITH IERCD C C DIMENSION IERCD(1),ITLU(1),IARAY(3),ICCC(1) C C C THERE'S NO EQT ASSIGNMENT FOR ITLU = 0 C IF(ITLU.EQ.0) GO TO 85 IEQTA = IGET(1650B) IDRT = IGET(1652B) ILUMAX= IGET(1653B) IINTBA= IGET(1654B) IINTLG= IGET(1655B) C CHECK EQT ASSIGNMENT FOR THIS LU IVAL =IGET(IDRT+ITLU-1) IEQTQ=IAND(IVAL,077B) IF(IVAL.NE.0) GO TO 10 GO TO 85 C STATUS REQUEST ON ITLU. X13 SETS BYPASS CONDITION. 10 CONTINUE CALL X13(ITLU,IEQT5,IEQT4,IEQST) C CHECK SELECT CODE ASSIGNMENT OF EQT ISCOD=IAND(IEQT4,077B) IF(ISCOD.NE.O) GO TO 20 GO TO 81 C CHECK DEVICE TYPE. MUST BE TYPE 7 20 IDTYPE=IAND(IEQT5,037400B) CALL SHFT(IDTYPE) C IDTYPE HAS LOWER 8 BITS CONTAINING INFORMATION IF(IDTYPE.EQ.07) GO TO 30 GO TO 82 30 IAV=IEQT5 CALL SHF14(IAV) IFBIT=IEQST CALL SHF15(IFBIT) C CHECK FOR NONZERO SUBCHANNEL ISBCH = IAND(IEQST,17B) IF(ISBCH.NE.0) GO TO 90 C CHECK IF LU IS DOWN AND AVAILABILITY OF EQT IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 40 IF(IFBIT.EQ.1) GO TO 81 GO TO 83 40 CONTINUE C GET EQT DATA IETBL = (IEQTQ-1)*15+IEQTA IE11 = IGET(IETBL+10) IEQX = IGET(IETBL+12) IE16 = IGET(IEQX) IE17 = IGET(IEQX+1) LBIT = IE16 CALL SHF15(LBIT) IF(LBIT.EQ.1) GO TO 50 C DETERMINE IF THIS IS A DORMANT TERMINAL OR LINE. LBIT = 0 IF(IAND((IOR(IE11,IE16).EQ.0),(ISCOD.GT.025B))) GO TO 60 C LBIT=0 AND IE16 AND IE11 ARE NOT ZERO. LU IS AN INITIALIZED C TERMINAL C NO CHECK ON STATE IF((IE11.NE.0).AND.(IE16.LT.100000B).AND.(IE16.NE.0)) GO TO 86 C IE16 AND IE11 ARE ZERO AND (SELECT CODE) < 26B. DORMANT TERMINAL IF(((IE16.OR.IE11).EQ.0).AND.(ISCOD.LT.026B)) GO TO 80 GO TO 60 C C LBIT=1 DETERMINE IF LINE LU IS DORMANT C C ***PROGRAM PRMPT ADDITION TO SYSTEM****09.04.79**** 50 CONTINUE IF((IE16.EQ.100000B).AND.(IE11.EQ.0)) GO TO 51 IF((IE16.GT.100000B).AND.(IE11.EQ.0)) GO TO 52 C THERE SHOULD BE A POINTER IN IE11 IF(IE11.EQ.0) GO TO 88 C LINE IS INTIALIZED. CHECK FOR CLEAR STATE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. CHECK FOR ASSIGNED TERMINALS IF(IE11.EQ.IETBL) GO TO 87 GO TO 89 C LBIT=1 LINE IS DORMANT. CHECK IF SELECT CODE < 26B 51 IF(ISCOD.GT.025B) GO TO 83 C LINE LU IS DORMANT. CHECK FOR CLEAR EQT STATE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. GO TO 84 C LINE LU IS DORMANT. CHECK FOR CLEAR EQT STATE. IE16=ID SEGMT 52 CONTINUE GO TO 51 C C TERMINAL LU IS DORMANT. CHECK FOR CLEAR EQT STATE C 60 CONTINUE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. CONTINUE C ******* C ******* C DORMANT TERMINAL RETURN 80 IERCD = 0 GO TO 9999 C LU IS DOWN 81 IERCD = 1 GO TO 9999 C LU IS NOT ASSIGNED TO A TYPE 7 DEVICE 82 IERCD = 2 GO TO 9999 C EQT IS DOWN OR EQT STATE IS NOT CLEAR C RETURN THE EQT NUMBER IN PARAMETER ICCC, BUT BEFORE MAKING C THIS ASSIGNMENT, OUTPUT A MESSAGE. 83 IERCD = 3 GO TO 9999 C DORMANT LINE RETURN 84 IERCD = 4 GO TO 9999 C LU NOT ASSIGNED (NO EQT) 85 IERCD = 5 GO TO 9999 C INITIALIZED TERMINAL RETURN 86 IERCD = 6 GO TO 9999 C INTIALIZED LINE WITH NO TERMINALS ASSIGNED 87 IERCD = 7 GO TO 9999 C TYPE 7 EQT IS NOT IN A LINKED LIST (SERIOUS ERROR) 88 IERCD = 8 GO TO 9999 C INITIALIZED LINE WITH TERMINALS ASSIGNED 89 IERCD = 9 GO TO 9999 C NONZERO SUBCHANNEL ASSIGNMENT 90 IERCD = -1 C C CHECK IF LU IS DOWN OR EQT IS UNAVAILABLE. C IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 9999 C C THIS LU HAS A SUBCHANNEL ASSIGNMENT AND IS UNAVAILABLE. C IERCD = -2 C C 9999 CONTINUE CALL IMSG1(ILLU,ITLU,IARAY,IERCD,ICCC,IEQTQ) ICCC = IEQTQ C C WRITE(ILLU,710)ITLU,IERCD 710 FORMAT(2X"LUCHK ITLU:",I2X"IERCD:",I2) RETURN END C END$ CFTN4,Q,C SUBROUTINE LINK(INLU,ITLU,LLINK, +ITMCT),91711-1X032 REV 1926 790906 C 17.10.79 C THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS ON THE C LINE BY SEARCHING THE EQT LINKED LIST. C ITLU PASSED IS CHECKED FOR LINE MEMBERSHIP, ITMCT INDICATES IF C THE TRML LU WAS FOUND. C C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS C A LINE LU. USE LUCHK BEFORE CALLING LINK. C C ILLU = LIST LU C INLU = LINE LU C ITLU = TERMINAL LU C LLINK = LLINK(1) IS LINE LU NUMBER, LLINK(2) IS IBUFL, THEN C TERMINAL LU NUMBERS. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN LLINK, ONE WORD PER TERMINAL, PLUS C ONE (FOR THE LINE LU). C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C ITMCT = 0 TRML LU WAS NOT FOUND ASSIGNED TO LINKED LIST C = -1 TRML LU WAS FOUND ON THIS LINKED LIST C C C CALLS: ILINA GET THE LINE NUMBER, LIST POINTER C CALLS: LDARG ASSEMBLY ROUTINE TO CALL TRMLU C C SOURCE TERM : LLINK LIST OF TERMINAL LU ON ASSIGNED LINKED LIST C ITMCT VERIFY ITLU COMPLETION CODE C DIMENSION LLINK(28) KK = 2 ITMCT = 0 DO 1 J=1,28 1 LLINK(J) = 0 LLINK(2) = -1 C C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(INLU,ILNN,IE16,IE11) C C DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE IF(IE11.EQ.0) 901,3 C DON'T GO ON IF THE LINE IS DORMANT 3 IF(IE16.EQ.100000B) 901,4 C C PUT THE LINE LU NUMBER INTO THE FIRST WORD OF LLINK. C STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE C NEXT EQT IN THE LIST. GET THAT LU NUMBER, THEN USE IT TO GET THE C EQT WORD 11 AND 16 DATA CONTAINING LIST POINTER AND LINE NUMBER. C CHECK ITLU AGAINST EACH TERMINAL LU NUMBER RETURNED BY LDARG C FOR IDENTITY, SET ITMCT = -1 IF THEY ARE THE SAME. C PUT ALL TERMINAL LU FOUND ON THIS LINKED LIST INTO LLINK. C ENTER THE LU NUMBER INTO THE NEXT WORD OF LLINK AND INCREMENT KK. C USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS C TO THE LINE EQT. IF IT DOES, THE LINE SEARCH IS COMPLETE. C EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN C A NORMAL EXIT IS TAKEN. C 4 LLINK(1) = INLU IT11 = IE11 IDRT = IGET(1652B) C C DOES THIS LINE LU POINT TO A TERMINAL ? C 5 IF(IE11.NE.(IE11-10)) 51,900 C C YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU C 51 IT4 = IT11+3 C C FIRST PUT IT4 INTO THE B-REGISTER C CALL LDARG(IT4,ITT) C C GET SYSTEM LU OF THIS EQT. IT4 AND A-REGISTER ARE INTEGER FORMAT C ITT AND B-REGISTER ARE ASCII FORMAT. C CHECK ITLU AGAINST IT4 FOR IDENTITY C IF(IT4.EQ.ITLU) ITMCT = -1 C C MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN C 52 IF(IT4.NE.INLU) 54,900 C C PUT IT4 INTO LLINK C 54 KK = KK+1 LLINK(KK) = IT4 C C SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. C 55 IF(IT11.NE.IE11) 51,900 C C KK = THE NUMBER OF TERMINALS ON THIS LINE C ITMCT = -1 ITLU WAS FOUND AMONG THIS LINKED LIST C = 0 ITLU WAS NOT FOUND AMONG THIS LINKED LIST C 900 LLINK(2) = KK 901 RETURN END C END$ CFTN4,L SUBROUTINE IMSG1(ILLU,ITLU,IARAY,INUM, +IAAA,IEQTQ),91711-1X032 REV 1926 790906 C 31.08.79 C C C ILLU = LIST LU C ITLU = LU NUMBER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9, -1, SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IARAY(3) DATA IBBB/100000B/ IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 IF(INUM.EQ.-1)GO TO 40 IF(INUM.EQ.-2)GO TO 40 GO TO 900 C C TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL 20 WRITE(ILLU,30)IARAY,ITLU 30 FORMAT(2X3A2"- LU ",I2X"ASSIGNED TO A DORMANT MULTIPOINT", +" TERMINAL") GO TO 900 C C TXTD1 - LU MM IS DOWN 21 WRITE(ILLU,31)IARAY,ITLU 31 FORMAT(2X3A2"- LU ",I2X"IS DOWN") GO TO 900 C C TXTD1 - LU MM IS NOT ASSIGNED TO A DEVICE C 22 WRITE(ILLU,32)IARAY,ITLU 32 FORMAT(2X3A2"- LU ",I2X"IS NOT ASSIGNED TO A DEVICE") GO TO 900 C C TXTD1 - EQT ZZ IS DOWN 23 WRITE(ILLU,33)IARAY,IEQTQ 33 FORMAT(2X3A2"- EQT ",I2X"IS DOWN") GO TO 900 C C TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT LINE 24 WRITE(ILLU,34)IARAY,ITLU 34 FORMAT(2X3A2"- LU ",I2X"IS ASSIGNED TO A DORMANT MULTIPOINT", +" LINE") GO TO 900 C C TXTD1 - LU MM NOT ASSIGNED, NOT TESTED 25 WRITE(ILLU,35)IARAY,ITLU 35 FORMAT(2X3A2"- LU ",I2X"NOT ASSIGNED, NOT TESTED") GO TO 900 C C TXTD1 - LU MM IS AN INITIALIZED MULTIPOINT TERMINAL 26 WRITE(ILLU,36)IARAY,ITLU 36 FORMAT(2X3A2"- LU ",I2X"IS AN INITIALIZED MULTIPOINT TERMINAL") GO TO 900 C C TXTD1 - LINE LU MM IS INITIALIZED, NO TERMINALS ASSIGNED 27 WRITE(ILLU,37)IARAY,ITLU 37 FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, NO TERMINALS", +" ASSIGNED") GO TO 900 C C TXTD1 - LU MM IS NOT IN LINKED LIST 28 WRITE(ILLU,38)IARAY,ITLU 38 FORMAT(2X3A2"- LU ",I2X"IS NOT IN A LINKED LIST") GO TO 900 C C TXTD1 - LINE LU MM IS INITIALIZED, TERMINALS ARE ASSIGNED 29 WRITE(ILLU,39)IARAY,ITLU 39 FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, TERMINALS ARE", +" ASSIGNED") GO TO 900 C C TXTD1 - LU MM HAS NONZERO SUBCHANNEL ASSIGNMENT 40 WRITE(ILLU,50)IARAY,ITLU 50 FORMAT(2X3A2"- LU",XI2X"HAS NONZERO SUBCHANNEL ASSIGNMENT") GO TO 900 C C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE UPMPT(ILU,INLU,ILLU,ITLU,IGGG,IXLU, +IARAY),91711-1X032 REV 1926 790906 C 26.09.79 C THIS SUBROUTINE INITIALIZES A MULTIPOINT TERMINAL. C TERMINALS THAT ARE INITIALIZED WILL NOT BE RE-INITIALIZED C AND A WARNING MESSAGE IS OUTPUT. C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C ITLU = TERMINAL LU C IGGG = -1 DIAGNOSTIC. CALLED BY TXTD2. C > 0 VERIFY. IGGG IS ICW FOR INITIALIZING A TERMINAL. C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C CALLS: LUVFY VERIFY TERMINAL LU = ITLU ON LINE LU = INLU C WHICH HAS A SPECIFIED ID FOUND IN THE EQT C CALLS: IXGID GET THE GROUP CHARACTER OR DEVICE CHARACTER C CALLS: ILINA GET THE LINE NUMBER, ID FOR AN LU FROM THE EQT C CALLS: IGRID GET THE GROUP RESPONSE FOR THE SPECIFIED GROUP C CHARACTER ON THE SPECIFIED LINE LU C C C DIMENSION IREG(2),IBUFR(128),ICWORD(2),IOFLN(30),IGRUP(30), +IARAY(3),IMESS1(1) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) IXLU = 0 DATA ICWORD/0,2000B/ DATA IMESS1/15505B/ IF(IGGG.EQ.-1) 5,71 5 CALL IMSG8(ILLU,IARAY,1,11) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C IF INLU IS ZERO, GET A LINE LU IF(INLU.GT.0) GO TO 30 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 30 ICCC = 9 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.7) GO TO 25 IF(IERCD.EQ.9) GO TO 25 GO TO 15 C C SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED C TO THIS LINE LU. C 25 CONTINUE CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) I4LIN = LINE*10000B C C GET GROUP ID C 28 INUM = 0 CALL IXGID(ILU,IGID,KGID,IARAY,INUM) IF(IGID.EQ.20040B) GO TO 15 C C GET ALL RESPONSES TO GROUP KGID ON LINE LU = INLU, PU THE C ID COLLECTED IN BUFFER IGRUP C CALL IGRID(INLU,KGID,IGRUP) C C SHOW THE RESPONDING TERMINALS C IF(IGRUP(1)) 27,26 26 INAT = IGRUP(1) - 1 CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) DO 27 K = 2,IGRUP(1) CALL IMSG2(ILLU,0,IGRUP(K),3,IARAY,11) 27 CONTINUE C C ENTER TERMINAL LU. IF NO MORE TERMINALS ON THIS LINE, ENTER C 0 TO STOP C 16 CALL IMSG7(ILU,ITLU,IARAY,2,11) IF(ITLU.EQ.0) GO TO 15 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE FOR IERCD = 0 C 36 ICCC = 0 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.0) GO TO 70 IF(IERCD.EQ.-1) GO TO 70 GO TO 16 C C GET THE DEVICE ID C 70 INUM = 1 CALL IXGID(ILU,IDID,IXXX,IARAY,INUM) IF(IDID.EQ.020040B) GO TO 16 C C INITIALIZE THE TERMINAL C ICWG = IAND(IGID,37400B)/4B ICWD = IAND(IDID,077B) ICW=IOR((IOR(I4LIN,ICWG)),(ICWD)) GO TO 72 C C IF THIS WAS CALLED WITH ICW DEFINED, ENTER HERE C 71 ICW = IGGG 72 ICWORD(1) = IOR(100000B,ITLU) C C SINCE DATACAP TERMINALS CAN'T HAVE ROUTINE POLLING, SET IT OFF C CALL EM(1,ITLU,ILLU,IARAY,101000B) CALL XLUEX(3,ICWORD,ICW) C C TXTD1 - TRML LU MMAB INITIALIZED, ASSIGNED LINE NO. L C CALL ILINA(ITLU,LINE,ITID,IE11) KGID = IOR(IAND(ITID,057400B),40B) ID = IOR(KGID,175B) CALL IMSG4(ILLU,ITLU,LINE,ITID,8,IARAY,11) C C VERIFY TERMINAL ID ON THIS LINE AND GROUP C 74 CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,0,IXLU,IARAY) C 900 CONTINUE C C END MULTIPOINT TERMINAL INITIALIZATION C RETURN END C END$ CFTN4,L SUBROUTINE IXGID(ILU,IGID,KGID,IARAY, +INUM),91711-1X032 REV 1926 790906 C 79.10.26 C C THIS SUBROUTINE GETS GROUP AND DEVICE CHARACTERS FROM C THE INTERACTIVE LU = ILU. IGID IS RETURNED WITH A C SPACE-SPACE ASCII CODE IF AN OUT OF BOUNDS ENTRY WAS C MADE, OR THE ASCII CHARACTER IN THE UPPER BYTE FOR GROUP C CHARACTER, ASCII CHARACTER IN THE LOWER BYTE FOR THE C DEVICE CHARACTER. KGID IS RETURNED FOR WITH THE GROUP C CHARACTER IN THE UPPER BYTE AND A SPACE CARACTER IN THE C LOWER BYTE. C DIMENSION IARAY(3) C IF(INUM.EQ.0) GO TO 100 IF(INUM.EQ.1) GO TO 200 C C C GROUP ID CHARACTER C PARAMETER KGID RETURNS THE GROUP CHARACTER IN THE UPPER BYTE, C SPACE CHARACTER IN THE LOWER BYTE. IGID RETURNS WHATEVER THE C OPERATOR ENTRY IN THE UPPER BYTE. C 100 WRITE(ILU,110)IARAY 110 FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER :_") READ(ILU,111)IGID 111 FORMAT(A1) IF(IGID.EQ.020040B) GO TO 900 IF(IGID.LT.040000B) GO TO 100 IF(IGID.GT.055040B) GO TO 100 C KGID = IOR(IAND(IGID,057400B),40B) GO TO 900 C C C DEVICE ID CHARACTER C PARAMETER KGID IS NOT USED C PARAMETER IGID IS USED TO PASS THE DEVICE CHARACTER C 200 WRITE(ILU,210)IARAY 210 FORMAT(2X3A2"- ENTER DEVICE ID CHARACTER :_") READ(ILU,211)IDID 211 FORMAT(R1) IF(IDID.LT.000100B) GO TO 230 IF(IDID.EQ.000040B) GO TO 230 IF(IDID.GT.000132B) GO TO 230 C 220 IGID = IDID GO TO 900 C 230 IGID = 020040B 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE DNMPT(ILU,ILLU,IGGG, +IARAY),91711-1X032 REV 1926 790906 C 20.06.79 C THIS SUBROUTINE REMOVES A MULTIPOINT TERMINAL. C TERMINALS ARE REMOVED WHEN PRESENTLY INITIALIZED. IF A TERMINAL IS C DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE C THE TERMINAL IS MADE. C C ILU = CONSOLE LU C ILLU = LIST LU C IGGG = -1 DIAGNOSTIC C > 0 VERIFY, ICWORD FOR TERMINAL REMOVAL C ILLU = LIST LU C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C C C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA ICWORD/0,2100B/ DATA ICCC/6/ IF(IGGG.EQ.-1) 5,61 5 CALL IMSG8(ILLU,IARAY,0,11) C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. 15 CALL IMSG7(ILU,ITLU,IARAY,3,11) IF(ITLU.EQ.0) GO TO 9999 ICWORD(1) = IOR(100000B,ITLU) C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE FOR IERCD = 6 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.6) GO TO 60 GO TO 15 C 61 ITLU = IGGG ICWORD(1) = IOR(100000B,ITLU) 60 CALL ILINA(ITLU,LINE,IE16,IE11) CALL IMSG3(ILLU,LINE,ITLU,IE16,IARAY,1,11) C REMOVE THE TERMINAL ICW = 0 REG = XLUEX(3,ICWORD,ICW) C 62 CALL IMSG4(ILLU,ITLU,LINE,IE16,6,IARAY,11) C C END MULTIPOINT TERMINAL REMOVAL 9999 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG2(ILLU,IPAR1,IPAR2,INUM,IARAY, +IAAA),91711-1X032 REV 1926 790906 C 24.07.79 C MESSAGES ASSOCIATED WITH IWRU C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMESS0(11),IMESS1(11),IMESS2(14),IMESS3(1),IMESS4(4), +IMESS5(13),IMESS6(13),IMESS7(14),ICWORD(2),IREG(2),IMSG(40), +IMESS8(13),IARAY(3),IPB1(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H ,2H :, +2H P,2HAS,2HS / DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H ,2H :, +2H F,2HAI,2HL / DATA IMESS2/2H- ,2H ,2H R,2HES,2HPO, +2HNS,2HE(,2HS),2H F,2HRO,2HM ,2HGR,2HOU,2HP / DATA IMESS3/0/ DATA IMESS4/2HOF,2HF ,2HLI,2HNE/ DATA IMESS5/2HID,2H A,2HPP,2HEA,2HRS,2H ,2H ,2HTI,2HME, +2HS ,2HIN,2H E,2HQT/ DATA IMESS6/2HGR,2HOU,2HP ,0,2H F,2HAI,2HLS,2H E,2HQT,2H V,2HER, +2HIF,2HY / DATA IMESS7/2HLU,2H ,0,2H I,2HD:,0,2H N,2HOT,2H I,2HN ,2HWR, +2HU ,2HLI,2HST/ DATA IMESS8/2HEQ,2HT ,2HFA,2HIL,2HS ,2HGR,2HOU,2HP ,0,2H V, +2HER,2HIF,2HY / CALL SFILL(IMSG,1,80,0040B) IPB1 = KCVT(IPAR1) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - VERIFY GID a : PASS 20 DO 30 J=1,11 30 IMSG(J+4) = IMESS0(J) CALL SHFT(IPAR2) IMSG(11) = IOR(020000B,IPAR2) IBUFL = 15 GO TO 40 C C TXTD1 - VERIFY GID a : FAIL 21 DO 31 J = 1,11 31 IMSG(J+4) = IMESS1(J) CALL SHFT(IPAR2) IMSG(11) = IOR(020000B,IPAR2) IBUFL = 16 GO TO 40 C C TXTD1 - xx RESPONSE(S) FROM GROUP a 22 DO 32 J = 1,14 32 IMSG(J+4) = IMESS2(J) CALL SPUT(IMSG,11,JPB10) CALL SPUT(IMSG,12,JPB11) IMSG(19) = IPAR2 IBUFL = 20 GO TO 40 C C ab 23 IMSG(19) = IPAR2 IBUFL = 20 GO TO 43 C C ab OFF LINE 24 DO 34 J = 1,4 34 IMSG(J+18) = IMESS4(J) IMSG(14) = IPAR2 IBUFL = 22 GO TO 43 C 25 GO TO 900 C C GROUP a FAILS EQT VERIFY 26 DO 36 J = 1,13 36 IMSG(J+20) = IMESS6(J) IMSG(24) = IPAR2 IBUFL = 34 GO TO 43 C C LU mm ID:ab NOT IN WRU LIST 27 DO 37 J = 1,14 37 IMSG(J+20) = IMESS7(J) IMSG(23) = ITLU IMSG(26) = IPAR2 IBUFL = 34 GO TO 43 C C EQT FAILS GROUP a VERIFY 28 DO 38 J =0 1,13 38 IMSG(J+20) = IMESS8(J) IMSG(29) = IPAR2 IBUFL = 33 GO TO 43 C C ab OFF LINE 29 DO 39 J = 1,4 39 IMSG(J+25) = IMESS4(J) IMSG(21) = IPAR2 IBUFL = 29 GO TO 43 C 40 DO 41 J = 1,3 41 IMSG(J+1) = IARAY(J) 43 ICWORD(1) = IOR(100000B,ILLU) CALL REIO(2,ICWORD,IMSG,IBUFL) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG3(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 06.11.79 C THIS SUBROUTINE OUTPUTS A MESSAGE ASSOCIATED WITH CFTML, C DNMPT, UPMPT, VMPLN, VMPTL C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMS0(1), IMS1(11), IMS2(2), +IMS4(11),IMS5(11),ICWORD(2), IREG(2), IMSG(12),IARAY(3), +IMS6(2),IEQ(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA IMS0/0/ DATA IMS1/2H*L,2HN ,0,2H T,2HL ,0,0,2H ,2HOF,2HFL,2HN*/ DATA IMS2/2HDN,2H, / DATA IMS4/2H*L,2HN ,0,2H T,2HL ,0,0,2H V,2HER,2HIF,2HY*/ DATA IMS5/2H*L,2HN ,0,2H T,2HL ,0,0,2H ,2H O,2HNL,2HN*/ DATA IMS6/2HUP,2H, / DATA ICWORD/0,0400B/ DATA IBBB/100000B/ C C INITIALIZE BUFFER IMSG C CALL SFILL(IMSG,1,24,040B) C IF(IAAA.EQ.11) 7,5 C 5 IF(IAAA-10) 6,900 C 6 IF(INUM.EQ.IAAA) GO TO 900 C 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 900 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 * LN E TL ABNN NOT VERIFIED C 20 WRITE(ILLU,30)IPAR1,IPAR2,IPAR3 30 FORMAT(2X"TXTD1 * LINE NO.",I2X"TL ",I2,A2X"NOT VERIFIED") GO TO 900 C C *LN e TL mm OFFLN* 21 DO 31 J = 1,11 31 IMSG(J) = IMS1(J) IBUFL = 11 GO TO 40 C C DOWN THE EQT C FILL IN THE "DN, " THEN GO TO 50 TO PUT IN THE EQT NUMBER C IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE C 22 DO 32 J = 1,2 32 IMSG(J) = IMS2(J) GO TO 50 C C C *LN e TL mm VERIFY* 24 DO 34 J = 1,11 34 IMSG(J) = IMS4(J) IBUFL = 11 GO TO 40 C C *LN e TL mm ONLN* 25 DO 35 J = 1,11 35 IMSG(J) = IMS5(J) IBUFL = 11 GO TO 40 C C TXTD1 * ab APPEARS OFF LINE nnn TIMES 26 WRITE(ILLU,36)IARAY,IPAR3,IPAR1 36 FORMAT(/2X3A2"* ",A2" APPEARS OFF LINE",I3X"TIMES") GO TO 900 C C TXTD1 * ab NOT VERIFIED 27 WRITE(ILLU,37)IARAY,IPAR3 37 FORMAT(2X3A2"* ",A2X" NOT VERIFIED") GO TO 900 C C TXTD1 * ab APPEARS nnn TIMES IN EQT 28 WRITE(ILLU,38)IARAY,IPAR3,IPAR1 38 FORMAT(2X3A2"* ",A2X" APPEARS",I3X"TIMES IN EQT") GO TO 900 C C UP THE EQT C IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE. C 29 DO 39 J = 1,2 39 IMSG(J) = IMS6(J) C C C ENTER HERE FROM DOWN AN EQT C 50 IEQ = KCVT(IPAR1) CALL SGET(IEQ,1,JEQ1) CALL SGET(IEQ,2,JEQ2) C CALL SPUT(IMSG,4,JEQ1) CALL SPUT(IMSG,5,JEQ2) C REG = MESSS(IMSG,12) C C FOR ANY MESSAGE RETURNED FROM THE SYSTEM, SET IPAR2 = IA TO C LET THE CALLER KNOW THE ATTEMPT TO UP OR DOWN THE EQT HAS FAILED. C IPAR2 = IA GO TO 900 C 40 CALL EM(1,IPAR2,ILLU,IARAY,IBBB) CALL SPUT(IMSG,5,KCVT(IPAR1)) IMSG(6) = KCVT(IPAR2) IMSG(7) = IPAR3 ICWORD(1) = IOR(100000B,IPAR2) CALL XLUEX(2,ICWORD,IMSG,IBUFL) CALL EM(1,IPAR2,ILLU,IARAY,1401B) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG4(ILLU,IPAR1,IPAR2,IPAR3,INUM,IARAY, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C MESSAGES ASSOCIATED WITH IWRU C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMESS0(7),IMESS1(14),IMESS2(14),IMESS3(13),IMESS4(16), +IMESS5(19),IMESS6(17),IMESS7(14),ICWORD(2),IREG(2),IMSG(28), +IMESS8(23),IMESS9(19),IARAY(3),IPB1(1),IPB2(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H L,2HIN,2HE / DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HLI,2HNE,2H L,2HU / DATA IMESS2/2H- ,2HVE,2HRI,2HFY,2H O,2HFF,2H L,2HIN, +2HE ,2HTE,2HRM,2HIN,2HAL,2HS / DATA IMESS3/2H- ,2HVE,2HRI,2HFY,2H A,2HCT,2HIV,2HE , +2HTE,2HRM,2HIN,2HAL,2HS / DATA IMESS4/2H- ,2HNO,2H O,2HFF,2H L,2HIN,2HE ,2HTE,2HRM, +2HIN,2HAL,2HS ,2HPR,2HES,2HEN,2HT / DATA IMESS5/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,2HIN, +2HT ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HPA,2HSS/ DATA IMESS6/2H- ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HLI, +2HNE,2H N,2HO.,2H ,2H R,2HEM,2HOV,2HED/ DATA IMESS7/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HTR,2HML,2H L,2HU / DATA IMESS8/2H- ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HIN, +2HIT,2HIA,2HLI,2HZE,2HD.,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE, +2H N,2HO./ DATA IMESS9/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HFA,2HIL/ C ICRLF = 1 CALL SFILL(IMSG,1,56,0040B) IPB1 = KCVT(IPAR1) IPB2 = KCVT(IPAR2) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) CALL SGET(IPB2,1,JPB20) CALL SGET(IPB2,2,JPB21) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - VERIFY LINE 20 DO 30 J=1,7 30 IMSG(J+4) = IMESS0(J) IBUFL = 11 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT LINE LU mm 21 DO 31 J = 1,14 31 IMSG(J+4) = IMESS1(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IBUFL = 19 C C TXTD1 - VERIFY OFF LINE TERMINALS GO TO 40 22 DO 32 J = 1,14 32 IMSG(J+4) = IMESS2(J) IBUFL = 18 ICRLF = 2 GO TO 40 C C TXTD1 - VERIFY ACTIVE TERMINALS 23 DO 33 J = 1,13 33 IMSG(J+4) = IMESS3(J) ICRLF = 2 IBUFL = 17 GO TO 40 C C TXTD1 - NO OFF LINE TERMINALS PRESENT 24 DO 34 J = 1,16 34 IMSG(J+4) = IMESS4(J) IBUFL = 20 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm PASS 25 DO 35 J = 1,19 35 IMSG(J+4) = IMESS5(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 23 ICRLF = 3 GO TO 40 C C TXTD1 - TRML LU mm LINE NO. e REMOVED 26 DO 36 J = 1,17 36 IMSG(J+4) = IMESS6(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) IMSG(11) = IPAR3 CALL SPUT(IMSG,34,JPB21) IBUFL = 21 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm 27 DO 37 J = 1,14 37 IMSG(J+4) = IMESS7(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 21 GO TO 40 C C TXTD1 - TRML LU mm INITIALIZED, ASSIGNED LINE NO. e 28 DO 38 J = 1,23 38 IMSG(J+4) = IMESS8(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) IMSG(11) = IPAR3 CALL SPUT(IMSG,56,JPB21) IBUFL = 28 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm FAIL 29 DO 39 J = 1,19 39 IMSG(J+4) = IMESS9(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 23 ICRLF = 3 C 40 DO 41 J = 1,3 41 IMSG(J+1) = IARAY(J) 43 ICWORD(1) = IOR(100000B,ILLU) IF(INUM.EQ.5) GO TO 42 IF(INUM.EQ.9) GO TO 42 DO 44 J = 1,ICRLF 44 WRITE(ILLU,46) 42 CALL REIO(2,ICWORD,IMSG,IBUFL) IF(ICRLF.EQ.1) GO TO 900 DO 45 J = 1,ICRLF 45 WRITE(ILLU,46) 46 FORMAT(/) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG6(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMES0(14),IMES1(22),IMES2(16),IMES3(3),IMES4(11), +IMES5(5),ICWORD(2),IREG(2),IMSG(28), +IPB1(1),IPB2(1),IPB3(1),IARAY(3),IMES6(13) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMES0/2H- ,2HNO,2H S,2HTA,2HTU,2HS ,2HRE,2HSP,2HON, +2HSE,2H F,2HRO,2HM ,2HLU/ DATA IMES1/2H- ,2HLI,2HNE,2H L,2HU ,0,2H I,2HNI, +2HTI,2HAL,2HIZ,2HED,2H. ,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE, +2H N,2HO./ DATA IMES2/2H- ,2HLI,2HNE,2H L,2HU ,0,2H L,2HIN, +2HE ,2HNO,2H. ,2H ,2HRE,2HMO,2HVE,2HD / DATA IMES3/2H- ,2HDO,2HNE/ DATA IMES4/2H- ,2HNO,2H M,2HUL,2HTI,2HPO,2HIN,2HT ,2HSY, +2HST,2HEM/ DATA IMES5/2H- ,2HRU,2HNN,2HIN,2HG / DATA IMES6/2H* ,2HCO,2HRR,2HEC,2HTI,2HVE,2H A,2HCT,2HIO,2HN , +2HNE,2HED,2HED/ ICRLF = -1 CALL SFILL(IMSG,1,56,0040B) IPB1 = KCVT(IPAR1) IPB2 = KCVT(IPAR2) C WRITE(ILLU,110) IPAR1,IPAR2,IPAR3 110 FORMAT(2X"IMSG6 :",I2X":",I2X":",A2) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) CALL SGET(IPB2,1,JPB20) CALL SGET(IPB2,2,JPB21) C WRITE(ILLU,111) JPB10,JPB11,JPB20,JPB21 111 FORMAT(2X"IMSG6 :"A2X":",A2X":",A2X":",A2) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 DO 8 J = 1,3 8 IMSG(J+1) = IARAY(J) IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - NO STATUS RESPONSE FROM LU mm 20 DO 30 J = 1,14 30 IMSG(J+4) = IMES0(J) CALL SPUT(IMSG,38,JPB10) CALL SPUT(IMSG,39,JPB11) IBUFL = 20 GO TO 40 C C TXTD1 - LINE LU mm INITIALIZED. ASSIGNED LINE NO. e 21 DO 31 J = 1,22 31 IMSG(J+4) = IMES1(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) CALL SPUT(IMSG,54,JPB21) IBUFL = 27 GO TO 40 C C TXTD1 - LINE LU mm LINE NO. e REMOVED 22 DO 32 J = 1,16 32 IMSG(J+4) = IMES2(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) CALL SPUT(IMSG,31,JPB21) IBUFL = 20 GO TO 40 C C TXTD1 - DONE 23 DO 33 J = 1,3 33 IMSG(J+4) = IMES3(J) IBUFL = 7 ICRLF = 1 GO TO 40 C C TXTD1 - NO MULTIPOINT SYSTEM 24 DO 34 J = 1,11 34 IMSG(J+4) = IMES4(J) IBUFL = 16 GO TO 40 C C TXTD1 - RUNNING 25 DO 35 J = 1,5 35 IMSG(J+4) = IMES5(J) ICRLF = 1 IBUFL = 10 GO TO 40 C C TXTD1 - REMOVE A LINE 26 WRITE(ILLU,36)IARAY 36 FORMAT(/2X3A2"- REMOVE A LINE") GO TO 900 C C TXTD1 - VERIFY A TERMINAL 27 WRITE(ILLU,37)IARAY 37 FORMAT(/2X3A2"- VERIFY TERMINAL") GO TO 900 C C TXTD1 - INITIALIZE A LINE 28 WRITE(ILLU,38)IARAY 38 FORMAT(/2X3A2"- INITIALIZE A LINE") GO TO 900 C C TXTD1 * CORRECTIVE ACTION NEEDED C 29 DO 39 J = 1,13 39 IMSG(J+4) = IMES6(J) IBUFL = 18 C 40 ICWORD(1) = IOR(100000B,ILLU) IF(ICRFL) 43,41 41 DO 42 J = 1,ICRLF 42 WRITE(ILLU,44) 44 FORMAT(/) 43 CALL REIO(2,ICWORD,IMSG,IBUFL) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG7(ILU, +IPAR1,IARAY,INUM,IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILU = LIST LU C IPAR1 = PARAMETER RETURNED TO CALLER C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION ICWORD(2),IARAY(3) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ IPAR1 = 0 IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C 20 WRITE(ILU,111)IARAY GO TO 40 21 WRITE(ILU,112)IARAY GO TO 40 22 WRITE(ILU,113)IARAY GO TO 40 23 WRITE(ILU,114)IARAY GO TO 40 24 WRITE(ILU,115)IARAY GO TO 40 25 WRITE(ILU,116)IARAY GO TO 40 26 WRITE(ILU,117)IARAY GO TO 40 27 WRITE(ILU,118)IARAY GO TO 40 28 WRITE(ILU,119)IARAY GO TO 40 29 WRITE(ILU,120)IARAY GO TO 40 C C 40 READ(ILU,*)IPAR1 C 111 FORMAT(/2X3A2"- ENTER LINE LU (SYSTEM) (0 TO STOP):_") 112 FORMAT(/2X3A2"- ACTIVE LINE LU (SYSTEM) (0 TO STOP):_") 113 FORMAT(/2X3A2"- ENTER TRML LU (SYSTEM) (0 TO STOP):_") 114 FORMAT(/2X3A2"- ACTIVE TRML LU (SYSTEM) (0 TO STOP):_") 115 FORMAT(2X3A2"- ENTER TRAMSMIT NAK COUNT (0-15):_") 116 FORMAT(2X3A2"- ENTER RECEIVE NAK COUNT (0-15):_") 117 FORMAT(2X3A2"- ENTER WACK COUNT (0-31):_") 118 FORMAT(2X3A2"- ENTER TRML BLOCK FACTOR (0-4):_") 119 FORMAT(/2X3A2"- ENTER TIMEOUT VALUE (0-30):_") 120 FORMAT(/2X3A2"- ENTER LINE NUMBER (0-7):_") C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG8(ILLU,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILLU = LIST LU C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IARAY(3) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 900 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 900 IF(INUM.EQ.7) GO TO 27 GO TO 900 C C 20 WRITE(ILLU,30)IARAY 30 FORMAT(/2X3A2"- REMOVE A TERMINAL") GO TO 900 C C 21 WRITE(ILLU,31)IARAY 31 FORMAT(/2X3A2"- INITIALIZE A TERMINAL") GO TO 900 C C TXTD1 - SET NAK, WAK, TERMINAL BLOCK SIZE 22 WRITE(ILLU,32)IARAY 32 FORMAT(/2X3A2"- SET NAK, WAK, TERMINAL BLOCK SIZE") GO TO 900 C C TXTD1 - SET EDIT MODE AND POLLING GLOBALS 23 WRITE(ILLU,33)IARAY 33 FORMAT(/2X3A2"- SET EDIT MODE AND POLLING GLOBALS") GO TO 900 C C TXTD1 - GROUP-LINE SELECT AND SEND A MESSAGE 25 WRITE(ILLU,35)IARAY 35 FORMAT(/2X3A2"- GROUP-LINE SELECT AND SEND A MESSAGE") GO TO 900 C C TXTD1 - CONFIGURE A TERMINAL 27 WRITE(ILLU,37)IARAY 37 FORMAT(/2X3A2"- CONFIGURE A TERMINAL") ICRLF = 1 GO TO 900 C C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID, +KEY,IXLU,IARAY),91711-1X032 REV 1926 790906 C 03.10.79 C C THIS SUBROUTINE IS CALLED BY VMPLN, VMPTL, UPMTL TO VERIFY C TERMINAL = ITLU ON LINE LU = INLU. FIRST THE WHO ARE YOU POLL IS C MADE ON THE CURRENT GROUP = ID, THEN THE EQT IS CHECKED FOR C TERMINAL ID MATCHES AGAINST THE WRU LIST IN BUFFER IGRUP. C IBUFS RETURNED FROM ILINB CONTAINS ANY LU FOUND FOR THE GROUP. C FOR NO LU IN THE GROUP, MAKE SURE THERE WAS NO WRU RESPONSE, C IF THERE WAS, GO ON TO EXAMINE IF THIS IS AN OFF-LINE TERMINAL. C FOR LU RETURNED IN IBUFS, TRY TO MATCH EACH ID FROM THE EQT C TO ONLY ONE ID IN THE WRU, ANY EXTRA ITEMS IN WRU ARE THEN C TESTED FOR BEING OFF-LINE. C DIMENSION IGRUP(30),IBUFS(28) DIMENSION IBUFV(60),IARAY(3),IOFLN(30),IBUFX(28),IBXLU(60) C C INITIALIZE VARIABLES IERCT = 0 IXLU = 0 IBSL = 0 INAT = 0 C INITIALIZE BUFFERS CALL SFILL(IBXLU,1,120,000B) CALL SFILL(IBUFV,1,120,000B) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) IOFLN(1) = -1 CALL SFILL(IBUFS,1,56,000B) CALL SFILL(IBUFX,1,56,000B) C C IF KEY IS NEGATIVE, GO DIRECTLY TO THE GROUP POLL C IF(KEY.EQ.-1) GO TO 10 C C GET THE TERMINAL'S ID CHARACTERS THEN SHOW C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB C CALL ILINA(ITLU,ILNN,ITID,IE11) CALL IMSG4(ILLU,ITLU,0,ITID,7,IARAY,11) C C GET THE TERMINALS IN THE CURRENT GROUP ID 10 CALL IGRID(INLU,ID,IGRUP) C IF IGRUP(1) = -1 THERE IS NO RESPONSE FROM TERMINALS IF(IGRUP(1)) 55,53 C C SHOW THE RESPONDING TERMINALS 53 INAT = IGRUP(1) - 1 CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) C DO 54 K = 2,IGRUP(1) 103 CALL IMSG2(ILLU,0,IGRUP(K),3,IARAY,11) 54 CONTINUE C C C WHETHER THERE IS OR THERE IS NOT A REPLY IN THE GROUP, C GET EQT LIST, THEN COMPARE ID FIELD OF EQT WITH WRU LIST. C IBSL FROM ILINB = (# OF TRML LU IN GROUP KGID) + 1 C C 55 CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C WERE ANY LU IN CURRENT GROUP ? IF(IBUFS(2) -3) 556,56 C C VERIFY THE EQT LIST AGAINST THE WRU LIST C 56 CALL ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU,IARAY,KEY) C C IS ITLU 264X TERMINAL ? C IBXLU CONTAINS THE LU IN THIS GROUP WHICH FAIL VERIFICATION C K = 4 560 IF(IBXLU(1).GT.1) 561,554 561 IF(ITLU.EQ.IBXLU(K)) 565,562 562 IF(K.EQ.IBXLU(1)) 554,563 563 K = K+3 GO TO 561 C 565 IXLU = IBXLU(K) IERCT = IERCT + 1 C C C C C IF THERE WAS NO WRU REPLY, EQT TABLE IS NOT CURRENT. HARD ERROR. C FOR ANY MISSING OR DUPLICATE ID IN EQT IBUFV(1) > 0. C 554 IF(IBUFV(1).GT.0) IERCT = IERCT + 1 C C IF THERE WAS NO WRU REPLY, EQT HAS AN ID THAT DOESN'T ANSWER. C 556 IF(INAT.EQ.0) GO TO 57 C C USING THE WRU AND EQT DATA, COMPARE AND CONTRAST TO FIND ANY C OFF-LINE TERMINALS. C CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,-1) C C HOW MANY ID WERE SIMILAR IN EQT LIST ? ANS. SHOULD BE 1. C 558 IF(IDCT-2) 25,26 C C WHEN IBUFX(2) IS ZERO, THERE ARE NO DUPLICATE OFF-LINE ID C 25 IF(IBUFX(2)-1) 57,27 C C DUPLCATE ID IN EQT MESSAGE 26 IERCT = IERCT+1 C C IF THERE WERE NO PROBLEMS, SEND PASS MESSAGE C 57 IF(IERCT-1) 573,27 C C SEND FAIL MESSAGE C TXTD1 - VERIFY GID AB : FAIL C 27 CALL IMSG2(ILLU,0,KGID,1,IARAY,11) GO TO 900 C C SEND PASS MESSAGE C TXTD1 - VERIFY GID AB : PASS C 573 CALL IMSG2(ILLU,0,KGID,0,IARAY,11) C 900 CONTINUE C WRITE(ILLU,110)IXLU,KEY 110 FORMAT(2X"LUVFY IXLU:",I2X"KEY:",I2) END C END$ CFTN4,L SUBROUTINE IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID, +ILNN),91711-1X032 REV 1926 790906 C 25.04.79 C THIS SUBROUTINE SENDS A GROUP/LINE SELECT AND A MESSAGE C TO THE 3075A, 3076A, 3077A TERMINALS. CHECK THE BUFFER LENGTH C BEFORE CALLING TO ENSURE IT ISN'T ZERO OR TOO BIG. C NO CHECK IS MADE FOR GROUP ID PRESENT ON THE LINE, AND ONLY C THE LAST TWO DECIMAL DIGITS APPEAR IN THE TRANSMISSION LOG. C NOTE: IGID IS FORMED IN IOGLS BEFORE CALLINF IXGLS. C C C ILLU = LIST LU C INLU = LINE LU C IBUFR = ADDRESS OF BUFFER C IBUFL = BUFFER LENGTH C IGID = GID IN UPPER 8 BITS, ZEROS IN LOWER 8 BITS, GROUP SELECT C OR 177376B, LINE SELECT. C ILNN = INTEGER LINE NUMBER C C SOURCE TERM : C DIMENSION IREG(2),IBUFR(128),ICWORD(2),IMESSA(14),IMSG(24), +IMESS1(3),IMESS2(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,400B/ DATA IMESSA/2HME,2HSS,2HAG,2HE ,2H (,0,2H W,2HOR,2HDS,2H) , +2HSE,2HNT,2H T,2HO / DATA IMESS1/2HLI,2HNE,2H / DATA IMESS2/2HGR,2HOU,2HP / CALL SFILL(IMSG,1,48,0040B) C C PREPARE BASIC MESSAGE FORMAT C DO 3 J = 1,14 3 IMSG(J+1) = IMESSA(J) C C CONVERT IBUFL AND LINE NUMBER TO ASCII DIGITS C IMSG(7) = KCVT(IBUFL) LINE = KCVT(ILNN) C C CHECK FOR GROUP SELECT OR LINE SELECT C IF (IGID.EQ.177376B) 5,6 C C MESSAGE TO LINE : FILL IMSG WITH IMESS1 C 5 DO 7 J = 1,2 7 IMSG(J+15) = IMESS1(J) CALL SPUT(IMSG,37,LINE) GO TO 10 C C MESSAGE TO GROUP : SET ID FOR GROUP SELECT, FILL IMSG WITH IMESS2 C 6 ID = IOR(IGID,376B) DO 8 J = 1,3 8 IMSG(J+15) = IMESS2(J) IMSG(19) = IGID C C SEND THE MESSAGE C 10 CONTINUE 100 WRITE(ILLU,110)IMSG ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(2,ICWORD,IBUFR,IBUFL,ID) CONTINUE IF(IBUFL) 910,910,900 C MESSAGE NOT SENT 910 WRITE(ILLU,911)IBUFL GO TO 900 C 110 FORMAT(19A2) 911 FORMAT(2X"MESSAGE NOT SENT, (",I2," WORDS IN BUFFER)") C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IOGLS(ILU,ILLU,INLU, +IBUFL,IARAY),91711-1X032 REV 1926 790906 C 28.08.79 C THIS SUBROUTINE PREPARES A MESSAGE BUFFER AND SENDS C THE MESSAGE TO THE 3075A, 3076A, 3077A TERMINALS. C C ILU = CONSOLE LU C ILLU = LIST LU C INLU = LINE LU C C CALLS: IXGLS GROUP OR LINE SELECT AND SEND THE MESSAGE. C CALLS: ILINA GET MULTIPOINT LINE NUMBER FOR INLU. C C DIMENSION IREG(2),IBUFR(128),IMESSA(4),IMESS1(3),IMESS2(3), +ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IMESS1/2HGR,2HOU,2HP / DATA IMESS2/2HLI,2HNE,2H / DATA IREG/0,0/ DATA ICWORD/0,2200B/ IBUFL = 128 C INITIALIZE IMESSA CALL SFILL(IMESSA,1,8,0040B) C INITIALIZE THE MESSAGE BUFFER CALL SFILL(IBUFR,1,255,0040B) C GET LINE NUMBER FROM LINE EQT CALL ILINA(INLU,ILNN,IE16,IE11) LINE = KCVT(ILNN) C GET GROUP ID 100 WRITE(ILU,110)IARAY,LINE C ENTER KEY FOR LINE SELECTION, GID CHARACTER FOR GROUP SELECTION 101 READ(ILU,111)IGID IF(IGID.EQ.020040B) GO TO 5 IF((IGID.GT.37440B).AND.(IGID.LT.55440B)) GO TO 7 GO TO 100 C C DEFAULT ENTERED, IGID SET TO LINE SELECT CODE 5 IGID = 177376B C FILL IN MESSAGE 2 DO 3 J = 1,3 3 IMESSA(J) = IMESS2(J) IMESSA(4) = KCVT(ILNN) GO TO 9 C GROUP ID ENTERED, FILL IN MESSAGE 1 7 DO 4 J = 1,3 4 IMESSA(J) = IMESS1(J) IMESSA(4) = IGID C STRIP SPACE CHARACTER IN LOWER BYTE IGID = IAND(IGID,057400B) C C GET A MESSAGE 9 CONTINUE 102 WRITE(ILU,112)IARAY,IMESSA ICW = IOR(400B,ILU) 103 REG = REIO(1,ICW,IBUFR,IBUFL) IBUFL = IB C WRITE THE DATA TO THE PRINTER. SET V BIT TO WRITE COLUMN 1. C ICW = IOR(200B,6) C04 REG = EXEC(2,ICW,IBUFR,IBUFL) C C DON'T SEND ANYTHING IF IBUFL = 0. IF(IBUFL.EQ.0) GO TO 40 C IS THE NUMBER OF WORDS IN THE MESSAGE TOO BIG FOR THE TERMINAL? IF(IBUFL.LT.90) 105,10 C SET THE TERMINAL BLOCKING FACTOR FOR THE LINE C SET FOR 512 BYTES 10 ICW = 043146B 20 ICWORD(1) = IOR(100000B,INLU) 30 REG = XLUEX(3,ICWORD,ICW) GO TO 105 C NO MESSAGE AVAILABLE, DO NOTHING AND RETURN 40 GO TO 900 C C SEND THE MESSAGE TO THE TERMINAL. 105 CALL IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID,ILNN) GO TO 900 C 110 FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER (DEFAULT LINE ",R1,")", +" :_") 111 FORMAT(A1) 112 FORMAT(2X3A2"- MESSAGE TO ",4A2," :_") C 210 FORMAT(2X"IOGLS CHECKPOINT 0 IBUFL = ",I6) 900 RETURN END C END$ CFTN4,L SUBROUTINE ILINA(ITLU,LINE,IE16, +IE11),91711-1X032 REV 1926 790906 C 25.04.79 C THIS SUBROUTINE GETS THE LINE NUMBER AND TERMINAL ID FOR ITLU. C THE TERMINAL MUST BE INITIALIZED BEFORE CALLING ILINA. C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF THIS IS A C TERMINAL. USE LUCHK BEFORE CALLING ILINA. C C ITLU = LU UNDER TEST C LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST C IE16 = TERMINAL ID C IE11 = LINK LIST POINTER C C C C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C C C SOURCE TERM : LINE CHARACTER IN LOWER BYTE, ZERO FILLED. C IE16 TERMINAL ID FROM EQT WORD 16. C IE11 LINK LIST POINTER EQT WORD 11. C C IEQTA = IGET(1650B) IDRT = IGET(1652B) C EQT ASSIGNMENT FOR THIS LU ITVAL =IGET(IDRT+ITLU-1) IEQTT=IAND(ITVAL,077B) C EQT DATA ITTBL = (IEQTT-1)*15+IEQTA IE11 = IGET(ITTBL+10) ITQX = IGET(ITTBL+12) IE16 = IGET(ITQX) IT17 = IGET(ITQX+1) LINE = IAND(IT17,03400B) CALL SHFT(LINE) RETURN END C END$ CFTN4,L SUBROUTINE ILINE(INLU,ILLU,INUM, +LINE,IARAY),91711-1X032 REV 1926 790906 C 08.31.79 C THIS SUBROUTINE FINDS MULTIPOINT LINE ASSIGNMENTS. C A LINE ASSIGNMENT TABLE IS OUTPUT TO ILLU. THE PARAMETER C "LINE" IS RETURNED RIGHT ADJUSTED, ZERO FILLED, READY FOR KCVT. C C INLU = LINE LU UNDER TEST C ILLU = LIST LU C INUM = COMPLETION CODE C = 0 NO MULTIPOINT DEVICES ASSIGNED C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (INUM-1) ASSIGNED TERMINALS. C LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST C C C C CALLS: X13 ASSEMBLY ROUTINE REQUESTS STATUS ON SYSTEM LU C BYPASSING SWITCH TABLE. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINA GET THE LINE NUMBER FROM EQT. C C SOURCE TERM : LINE CHARACTER IN LOWER BYTE, ZERO FILLED. C INUM COMPLETION CODE C C DIMENSION IMESS1(3),IMESS2(3),IMESS3(3), +IMESS4(2),ICWORD(2),IARAY(3),IMSG(20),IMESS5(15),IMESS6(1) DATA IMESS1/2H L,2HIN,2HE / DATA IMESS2/2H T,2HRM,2HL / DATA IMESS3/2HDO,2HWN,2H / DATA IMESS4/0/ DATA IMESS5/2HLN,2H ,2HID,2H ,2HIN,2H L,2HU ,2HFB,2HIT,2H E, +2HQT,2H A,2HV ,2HS.,2HC./ DATA IMESS6/2H*S/ DATA ICWORD/0,400B/ INUM = 0 C IEQTA = IGET(1650B) IDRT = IGET(1652B) ILUMAX= IGET(1653B) CALL SFILL(IMSG,1,40,0040B) C C GET THE LINE NUMBER OF THE LINE LU CALL ILINA(INLU,LINE,IT16,IT11) C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ITERATE FROM LINE LU = INLU IN ASCENDING NUMERICAL ORDER TO LUMAX C CHECK FOR LU POINTING TO NONZERO EQT C C DO 50 I=INLU,ILUMAX IVAL = IGET(IDRT+INLU-1) C C IF THE EQT FIELD IS ZERO, GO ON TO THE NEXT LU. C IEQQ = IAND(IVAL,077B) IF(IEQQ.EQ.0) GO TO 50 C C THE LU POINTS TO AN EQT C STATUS REQUEST ON TEST LU. X13 SETS BYPASS CONDITION. C CALL X13(I,IEQT5,IEQT4,IEQST) C GET THE NONZERO SELECT CODE ASSIGNMENT ISCOD = IAND(IEQT4,077B) C CHECK FOR TYPE 7 DEVICE AT THIS LU IDVC7 = IAND(IEQT5,037400B) CALL SHFT(IDVC7) IF(IDVC7.NE.7) GO TO 50 C DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT IAV = IEQT5 CALL SHF14(IAV) IFBIT = IEQST CALL SHF15(IFBIT) C GET TERMINAL LINE NUMBER, ID, AND LINK POINTER CALL ILINA(I,ILNN,IE16,IE11) C LBIT = IE16 CALL SHF15(LBIT) C C IF LINE LU AND TERMINAL LU DON'T HAVE THE SAME NUMBER, GO TO 50 C IF(ILNN.NE.LINE) GO TO 50 INUM = INUM+1 C C C C C SHOW MESSSAGE BANNER THE FIRST ITERATION C IF(INUM.NE.1) GO TO 20 DO 5 J = 1,15 5 IMSG(J+1) = IMESS5(J) WRITE(ILLU,6) 6 FORMAT(/) ICWORD(1) = IOR(100000B,ILLU) CALL REIO(2,ICWORD,IMSG,16) CALL SFILL(IMSG,1,40,0040B) GO TO 20 C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK LINKED LIST POINTER AND GET AN ASCII LINE NUMBER C 10 IMSG(6) = 020061B IF(IE11.EQ.0) IMSG(6) = 020060B IMLN = KCVT(ILNN) CALL SGET(IMLN,2,IMLN11) CALL SPUT(IMSG,3,IMLN11) GO TO 40 C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CHECK THIS LU, SHOW NO MESSAGES C 20 ICCC = 10 CALL LUCHK(ILLU,I,IERCD,IARAY,ICCC) IF(IERCD.EQ.0) GO TO 21 IF(IERCD.EQ.1) GO TO 30 IF(IERCD.EQ.3) GO TO 30 IF(IERCD.EQ.4) GO TO 23 IF(IERCD.EQ.6) GO TO 25 IF(IERCD.EQ.7) GO TO 23 IF(IERCD.EQ.9) GO TO 23 IF(IERCD.EQ.-1)GO TO 26 IF(IERCD.EQ.-2)GO TO 26 GO TO 10 C C FILL IMESSA AND IMESSB C DORMANT TERMINAL 21 DO 22 J=1,3 IMSG(J+2)=IMESS2(J) 22 CONTINUE GO TO 10 C DORMANT LINE 23 DO 24 J=1,3 IMSG(J+2)=IMESS1(J) 24 CONTINUE GO TO 10 C INITIALIZED TERMINAL 25 IMSG(4)=IE16 GO TO 10 C NONZERO SUBCHANNEL 26 CALL SGET(IMESS6,1,ISBCH) CALL SPUT(IMSG,6,ISBCH) CALL SGET(IMESS6,2,ISBCH) CALL SPUT(IMSG,7,ISBCH) ISUB1 = (IAND(IEQST,30B))/10B ISUB2 = IAND(IEQST,7B) ISUB1 = KCVT(ISUB1) ISUB2 = KCVT(ISUB2) CALL SPUT(IMSG,8,ISUB1) CALL SPUT(IMSG,9,ISUB2) C C IF THIS SUBCHANNEL IS ALSO DOWN, GO TO 32 C IF(IERCD.EQ.-2) 261,10 C C C C EQT DOWN OR STATE IS NOT CLEAR 30 IF(LBIT.EQ.0) GO TO 32 C C LINE IS DOWN C DO 31 J=1,3 IMSG(J+2)=IMESS1(J) IMSG(J+16) = IMESS3(J) 31 CONTINUE GO TO 10 C C TERMINAL IS DOWN C 32 IF(IE16.EQ.0) GO TO 34 C C ACTIVE TERMINAL C IMSG(4) = IE16 C C ENTER HERE FROM NONZERO SUBCHANNEL FOR IERCD = -2 C 261 DO 33 J=1,3 IMSG(J+16) = IMESS3(J) 33 CONTINUE GO TO 10 C C DORMANT TERMINAL C 34 DO 35 J=1,3 IMSG(J+2)=IMESS2(J) IMSG(J+16) = IMESS3(J) 35 CONTINUE GO TO 10 C 40 CONTINUE IMLU = KCVT(I) CALL SGET(IMLU,1,ILU10) CALL SGET(IMLU,2,ILU11) CALL SPUT(IMSG,14,ILU10) CALL SPUT(IMSG,15,ILU11) IMSG(9) = KCVT(IFBIT) IMSG(12) = KCVT(IEQQ) IMSG(13) = KCVT(IAV) IMSG(16) = 041040B LCOD1 = IAND(ISCOD,000007B) LCOD1 = KCVT(LCOD1) LCOD2 = (IAND(ISCOD,000070B))/10B LCOD2 = KCVT(LCOD2) CALL SPUT(IMSG,29,LCOD2) CALL SPUT(IMSG,30,LCOD1) CALL REIO(2,ICWORD,IMSG,20) C CALL SFILL(IMSG,1,40,0040B) C 50 IDRT=IDRT+1 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C WRITE(ILLU,6) RETURN END C END$ CFTN4,L SUBROUTINE ILINB(ILLU,INLU,IGID,IBUFS,INAT, +ITMCT),91711-1X032 REV 1926 790906 C 28.06.79 C THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS IN THE C GROUP BY SEARCHING THE EQT. A GROUP ID CHARACTER IS PASSED C TO THIS ROUTINE. C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS C A LINE LU. USE LUCHK BEFORE CALLING ILINB. C C ILLU = LIST LU C INLU = LINE LU C IGID = GROUP ID C IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL, THEN C GROUP IGID TERMINAL NUMBERS. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS C ONE (FOR THE LINE LU). C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C CALLS: ILINA GET THE LINE NUMBER, LIST POINTER, AND TERMINAL C GROUP ID CHARACTER. C CALLS: LDARG ASSEMBLY ROUTINE TO CALL TRMLU C C SOURCE TERM : IBUFS LIST OF TERMINAL LU ON ASSIGNED LINE C C DIMENSION IBUFS(28) KK = 2 ITMCT = 0 DO 1 J=1,28 1 IBUFS(J) = 0 IBUFS(2) = -1 C C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(INLU,ILNN,IE16,IE11) C C DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE IF(IE11.EQ.0) 901,3 C DON'T GO ON IF THE LINE IS DORMANT 3 IF(IE16.EQ.100000B) 901,4 C C PUT THE LINE LU NUMBER INTO THE FIRST WORD OF IBUFS. C STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE C NEXT EQT IN THE LIST. GET THAT LU NUMBER, THEN USE IT TO GET THE C EQT WORD 11, 16, AND 17 DATA CONTAINING LIST POINTER, TERMINAL ID, C AND LINE NUMBER. CHECK THE LINE NUMBER AND GROUP ID OF THE TERMINAL C EQT TO BE SURE IT'S THE CORRECT LINE AND GROUP. IF IT IS, PUT IT C INTO IBUFS. IF IT DOESN'T CHECK OUT, DON'T PUT ANYTHING INTO IBUFS C FOR THIS EQT. USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS C TO THE LINE EQT. IF IT DOES, THE GROUP SEARCH IS COMPLETE. C FOR EACH TERMINAL FOUND SATISFYING LINE AND GROUP ID CHECKS, ENTER C THE LU NUMBER INTO THE NEXT WORD OF IBUFS AND INCREMENT KK. C EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN C A NORMAL EXIT IS TAKEN. C 4 IBUFS(1) = INLU IT11 = IE11 IDRT = IGET(1652B) C C DOES THIS LINE LU POINT TO A TERMINAL ? 5 IF(IE11.NE.(IE11-10)) 51,900 C YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU 51 IT4 = IT11+3 C FIRST PUT IT4 INTO THE B-REGISTER CALL LDARG(IT4,ITT) C GET SYSTEM LU OF THIS EQT. IT4 AND A-REGISTER ARE INTEGER FORMAT C ITT AND B-REGISTER ARE ASCII FORMAT. C VALIDATE LU AS BEING BETTER THAN THE BIT BUCKET IF(IT4.NE.0) 52,900 C MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN 52 IF(IT4.NE.INLU) 53,900 C GET THE LINE ASSIGNMENT AND GROUP ID OF THIS EQT 53 CALL ILINA(IT4,ILNN,IT16,IT11) C TERMINAL DATA HERE. COMPARE TERMINAL GROUP ID WITH SEARCH VALUE IDG = IOR(IAND(IT16,57400B),40B) C ARE THE GROUP ID THE SAME ? IF(IGID.EQ.IDG) 54,55 C GROUP ID ARE THE SAME. PUT TERMINAL LU INTO IBUFS 54 KK = KK+1 IBUFS(KK) = IT4 C ASSIGN ITID = TERMINAL ID THE FIRST TIME GROUP ID IS FOUND IF(ITMCT.EQ.0) 541,542 541 ITID = IT16 542 ITMCT = ITMCT+1 C SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. 55 IF(IT11.NE.IE11) 51,900 C KK = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID C ITMCT = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID AND C DEVICE ID. IF THERE ARE ANY OF THESE, SEND A MESSAGE. C 900 IBUFS(2) = KK 901 RETURN END C END$ CFTN4,L SUBROUTINE ILINC(ILLU,INLU,ITID,IBUFS, +IDCT),91711-1X032 REV 1926 790906 C 28.06.79 C THIS SUBROUTINE USES THE WRU TERMINAL ID CHARACTER TO VERIFY THE C ACTIVE EQT ID LIST FOUND BY ILINB. C THE LINE LU IS USED TO LOCATE THE LINKED LIST. EACH TERMINAL IN C THE LINKED LIST IS TESTED FOR GROUP MEMBERSHIP. IDCT SHOWS HOW C MANY TERMINALS ARE IN THE GROUP UNDER TEST. C C ILLU = LIST LU C INLU = LINE LU USED IN ILINB. C ITID = TERMINAL ID: GROUP ID-DEVICE ID C IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL. THE C TERMINAL LU NUMBERS IN GROUP ITID FOLLOW. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS C THE LINE LU AT THE HEAD OF THE LIST. C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C IDCT = COMPLETION CODE C = 0 NO MATCH FOUND IN EQT ID LIST C = 1 ONE MATCH FOUND IN EQT ID LIST C > 1 NUMBER OF DUPLICATE EQT ID FOUND C C DIMENSION IBUFS(28) IDDD = 11 IDCT = 0 IF(IBUFS(1).EQ.0) GO TO 900 IF(IBUFS(2)) 900,4 4 DO 60 J=3,IBUFS(2) C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(IBUFS(J),ILNN,IT16,IT11) C GET THE ID OF EACH TERMINAL IN IBUFS AND COMPARE WITH ITID. FOR C EACH LU WITH A MATCHING ITID, INCREMENT IDCT. 100 IF(ITID.EQ.IT16) 54,60 54 IDCT = IDCT+1 60 CONTINUE 900 RETURN END C END$ CFTN4,L SUBROUTINE ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU, +IARAY,IHHH),91711-1X032 REV 1926 790906 C 17.07.79 C THIS SUBROUTINE VERIFIES THE WRU ID LIST IS FOUND IN THE C EQT. THE EQT ID LIST FROM ILINB IS USED HERE. C C ILLU = LIST LU C IGRUP = WRU LIST OF TERMINAL ID IN THE GROUP UNDER TEST C INAT = THE NUMBER OF REPLYS TO THE WRU ON THIS GROUP C IBUFS = THE FIRST ENTRY IS THE LINE LU FOLLOWED BY IBSL, THEN A C LIST OF TERMINAL LU NUMBERS. THE NUMBERS ARE SYSTEM LU C NUMBERS IN INTEGER FORMAT. C IBSL = NUMBER OF LU NUMBERS IN IBUFS TO VERIFY = IBUFS(1) C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBSL-1) ASSIGNED TERMINALS. C IBUFV = IF NONZERO, CONTAINS 3-WORD ENTRY PER FAILURE: IDCT, ID, LU C IBVL = TOTAL NUMBER OF LU WHICH FAILED WRU VERIFY = IBUFV(1) C = 0 ALL IS WELL, NO LU VERIFY FAILURES C > 0 VERIFY FAILURES C = -1 TEST ABORTED. NO TERMINAL LU IN IBUFS. C C DIMENSION IBUFS(28),IGRUP(30),IBUFV(60),IARAY(3),IBXLU(60) C C INITIALIZE VARIABLES AND BUFFERS C IDVCT = 0 IDCT = -1 CALL SFILL(IBUFV,1,120,0B) CALL SFILL(IBXLU,1,120,0B) IBUFV(1) = -1 IBXLU(1) = -1 C C C C C C C DO 60 J = 1,IBUFS(2) IF(J.EQ.2) J = J+1 IAAA = 11 IFFF = 0 IDCT = -1 C J = 1, GET THE LINE WORD 11 AND WORD 16 C J > 2, TERMINAL ID CALL ILINA(IBUFS(J),ILNN,IT16,IT11) IF(J.NE.1) GO TO 100 C C THE FIRST ITERATION SHOWS A MESSAGE HEADER. C WRITE(ILLU,110)IARAY GO TO 20 C C C C C GET THE ID OF EACH TERMINAL IN IBUFS AND SEARCH THE IGRUP LIST. C FOR EACH ID (VIA ILINA) COUNT THE NUMBER OF MATCHES FOUND. IF ONE C MATCH IS FOUND, VERIFY IS GOOD, NO ACTION IS NECESSARY. OTHERWISE C SAVE IDCT, ID, AND LU NUMBER, THEN INCREMENT IERCT. C 100 DO 30 K=2,IGRUP(1) C C COMPARE COMPARE EACH ID FROM THE EQT STRUCTURE WITH THE ID FROM C THE POLL ON THE LINE. COUNT THE NUMBER OF ID MATCHES FOUND AND C THE NUMBER OF TERMINAL LU PROCESSED. C IF(IT16.NE.IGRUP(K)) GO TO 30 IDCT = IDCT+1 IDVCT = IDVCT+1 30 CONTINUE C C IF IT16 IS NOT FOUND IN IGRUP THEN IDCT = -1, GO TO 31 C IF DUPLICATE IT16 ARE FOUND IN IGRUP THEN IDCT > 0, GO TO 33 C IF ONE MATCH IS FOUND IDCT = 0, GO TO 20 C IF(IDCT) 31,20,33 C C C 31 IFFF = 1 C C UPDATE IBUFV BY APPENDING IDCT, ITID, ITLU TO BUFFER IBUFV C 33 CALL IVBUF(IDCT,IT16,IBUFS(J),IBUFV) C C GET CONFIGURATION MESSAGE FOR LINE AND CLEAR TERMINALS C 20 CALL IMPXX(IBUFS(J),ILLU,IBUFS(1),IARAY,IFFF) C C THE FIRST ITERATION IS THE LINE LU, GO TO 60 C IF(J.EQ.1) GO TO 60 C C C IF ITLU HAS BEEN INITIALIZED IN ORDER TO DEMONSTRATE C SOMETHING HERE, SEND THE FOLLOWING MESSAGES. OTHERWISE C NO MESSAGES ARE SENT. C IF(IHHH.EQ.5) GO TO 40 IF(IHHH.EQ.-1) GO TO 40 C C IMPXX RETURNED A QUALIFICATION CODE, IFFF. IFFF = -2 C SAYS ITLU IS UNAVAILABLE FOR ANY MESSAGE C IFFF = -3 SAYS THIS WAS A 264X TERMINAL. C IF(IFFF.EQ.-2) GO TO 22 C C *LN N TL MMAB ONLN* C 23 CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,5,IAAA) C C *LN N TL MMAB VERIFY* C CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,4,IAAA) C C C IMPXX RETURNED A QUALIFICATION CODE, IFFF. C IFFF = -3, IT WAS OK TO SEND THE MESSAGE IF THIS TRML WAS C JUST INITIALIZED (KEY = 0), BUT FLAG THIS LU AS UNAVAILABLE C FOR FURTHER MESSAGES. C 40 IF(IFFF.EQ.-3) GO TO 22 GO TO 60 C C C C C UPDATE IBUFV FROM WHAT IMPXX TELLS US ABOUT ITLU. C 22 CALL IVBUF(IDCT,IT16,IBUFS(J),IBXLU) C C C 60 CONTINUE C C C C C RETURN 110 FORMAT(/2X3A2"- *VERIFY* LU EQT ID MODEL K D LM RM INT PR") END C END$ CFTN4,L SUBROUTINE TB(ILU,INLU,ILLU,IARAY, +IBBB),91711-1X032 REV 1926 790906 C 10.05.79 C THIS SUBROUTINE SETS THE NAK, WACK COUNTS AND TERMINAL BLOCKING C FACTOR FOR THE LINE C C ILU = CONSOLE LU C ILLU = LIST LU C IBBB = MODE SELECTION C C CALLS: C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,2200B/ 100 CALL IMSG7(ILU,KTNC,IARAY,4,11) IF(KTNC.GT.17B) 100,101 101 CALL IMSG7(ILU,KRNC,IARAY,5,11) IF(KRNC.GT.17B) 101,102 102 CALL IMSG7(ILU,KWC,IARAY,6,11) IF(KWC.GT.37B) 102,103 103 CALL IMSG7(ILU,KTBF,IARAY,7,11) IF(KTBF.GT.4) 103,200 200 WRITE(ILLU,120)IARAY,KTNC,KRNC,KWC,KTBF LRNC = KRNC*20B LWC = KWC*400B LTBF = KTBF*20000B ICW = IOR(IOR(IOR(LRNC,KTNC),LWC),LTBF) ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(3,ICWORD,ICW) 120 FORMAT(2X3A2"- TNC:",I3," RNC:",I3," WC:",I3," TBF:",I3) RETURN END C END$ CFTN4,L SUBROUTINE EM(ILU,ITLU,ILLU,IARAY, +IBBB),91711-1X032 REV 1926 790906 C 10.05.79 C THIS SUBROUTINE SETS THE EDIT MODE AND POLLING GLOBALS C C ILU = CONSOLE LU C ITLU = LINE LU C ILLU = LIST LU C IBBB = MODE SELECTION C = 0 OPERATOR ENTRY C = ICW VERIFY C C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,2300B/ IF(IBBB.NE.0) 10,100 10 ICW = IBBB GO TO 103 100 WRITE(ILU,110)IARAY 101 READ(ILU,*)KD,KR,KL,KC,KH,KX,KN,KS,KA 102 WRITE(ILU,112)KD,KR,KL,KC,KH,KX,KN,KS,KA IF(KD.EQ.1) 121,122 121 KD = 100000B 122 IF(KR.EQ.1) 123,124 123 KR = 40000B 124 IF(KL.EQ.1) 125,126 125 KL = 20000B 126 IF(KC.EQ.1) 127,128 127 KC = 10000B 128 IF(KH.EQ.1) 129,130 129 KH = 4000B 130 IF(KX.EQ.1) 131,132 131 KX = 2000B 132 IF(KN.EQ.1) 133,134 133 KN = 1000B 134 IF(KS.EQ.1) 135,136 135 KS = 400B 136 IF(KA.NE.1) 137,138 137 KA = 0 138 ICW = IOR(IOR(IOR(IOR(IOR(IOR(IOR(IOR(KD,KR),KL),KC),KH),KX),KN), +KS),KA) 103 ICWORD(1) = IOR(100000B,ITLU) REG = XLUEX(3,ICWORD,ICW) 110 FORMAT(2X3A2"- D R L C H X N S A",/,10X"_") 112 FORMAT(10X9(I1X)) RETURN END C END$ CFTN4,L SUBROUTINE IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX, +IOFLN,IEEE),91711-1X032 REV 1926 790906 C 09.07.79 C C THIS SUBROUTINE CALLS THE SUBROUTINES TO GENERATE OFF-LINE C TERMINAL ID FOR THE LINE UNDER TEST. C C IEEE = -1, CALLED BY VMPLN C IEEE = 1 , CALLED BY IOFLN C C DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2),IBUFS(28), +IARAY(3),IBUFV(60),IOFLN(30),IBUFX(28) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,0/,IREG/0,0/ C C C INAT = 0 C C INITIALIZE VARIABLES AND BUFFERS C CALL SFILL(IOFLN,1,60,0B) CALL SFILL(IGRUP,1,60,0B) CALL SFILL(IOFLN,1,60,0B) IOFLN(1) = -1 C CALL SFILL(IBUFR,1,256,0B) IBUFL = 128 C KGID = IOR(IAND(ID,57400B),40B) C C ALL TERMINALS THAT RESPOND TO THE POLL WILL HAVE THEIR ID IN C BUFFER IGRUP. C C CALL IGRID(INLU,ID,IGRUP) C C IF NO WRU RESPONSE FOR THIS GROUP, EXIT C IF(IGRUP(1)) 900,20 20 CALL SFILL(IBUFS,1,56,0B) CALL SFILL(IBUFX,1,56,0B) C C C C C C C USING THE LINKED EQT STRUCTURE FOR LINE LU = INLU, FIND ALL C THE TERMINAL LU NUMBERS THAT ARE INITIALIZED TO TERMINALS IN C GROUP KGID. C CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C C IF THERE ARE ANY OFF-LINE ID, SHOW THEM. C CHECK FOR UNIQUE ID AMONG THE GROUP KGID C AREAS VERIFIED ARE EQT LIST, WRU LIST, OFF LINE LIST C CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,IEEE) 900 RETURN END C END$ CFTN4,L SUBROUTINE IGRID(INLU,KGID, +IGRUP),91711-1X032 REV 1926 790906 C 03.08.79 C C WHO ARE YOU ON LINE LU = INLU, GROUP KGID. ALL TERMINALS C THAT REPLY HAVE THEIR ID PUT INTO BUFFER IGRUP. C DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,0/,IREG/0,0/,INAT/0/ C C INITIALIZE VARIABLES AND BUFFERS C KK = 1 C CALL SFILL(IGRUP,1,60,000B) IGRUP(1) = -1 C CALL SFILL(IBUFR,1,256,000B) IBUFL = 128 C ICWORD(1) = IOR(100000B,INLU) C FORM THE GROUP POLL CHARACTER ID = IOR(KGID,175B) C 21 REG = XLUEX(1,ICWORD,IBUFR,IBUFL,ID) IBUFL = IB C NUMBER OF RESPONDING TERMINALS = INAT INAT = IBUFL/3 C IF IBUFL = 0 THERE IS NO RESPONSE FROM TERMINALS IF(IBUFL.EQ.0) GO TO 900 C C PUT THE TERMINAL ID INTO IGRUP C IGRUP(1) = INAT+1 I = 1 C C 51 DO 52 NN = 2,IGRUP(1) IGRUP(NN) = IAND(IBUFR(I),077777B) 52 I = I+3 C C C 900 RETURN END C END$ CFTN4,L SUBROUTINE ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN, +IBUFX,IDCT,IEEE),91711-1X032 REV 1926 790906 C 28.08.79 C C IEEE = -1 CALLED BY IWRXX, VMPLN C IEEE = 1 CALLED BY IWRXX, IOFLN C C C C THIS SUBROUTINE OUTPUTS OFF-LINE TERMINAL ID FROM INPUT C BUFFERS IGRUP, IBUFS, AND THE LINE LU. C C IGRUP WAS CREATED BY SUBROUTINE IGRID BY POLLING LINE LU = INLU C WITH THE GROUP POLL CHARACTER UNDER TEST. THEREFORE, BUFFER C IGRUP CONTAINS THOSE TERMINAL'S ID WHICH HAVE RESPONDED TO THE C GROUP POLL ON THE LINE UNDER TEST. C C IBUFS WAS CREATED BY SUBROUTINE ILINB BY FIRST KNOWING THE C LINE LU NUMBER, THEN FOLLOWING THE LINKED LIST STRUCTURE C FOR THE LINE. FOR EACH TERMINAL EQT FOUND, A SYSTEM SUBROUTINE C (TRMLU) RETURNED WITH THE LU NUMBER FOR THAT EQT, WHICH WAS C PUT INTO IBUFS. FOR THE CASE WHERE THE DRT ENTRY WAS ZERO IN C THE EQT FIELD, THE LU IS INDETERMINATE AND TRMLU RETURNED WITH C ZERO, AND THERE WAS NO ENTRY MADE IN IBUFS. C C HERE, THOSE TERMINALS RESPONDING TO THE GROUP POLL HAVE THEIR ID C EXAMINED FOR A SINGLE MATCH AMONG THE ID CONTAINED IN THE LINKED C EQT STRUCTURE FOR THE LINE UNDER TEST. IF THERE IS A SINGLE C ID FOUND OR MULTIPLE ID ARE FOUND IN THE EQT STRUCTURE THAT ARE C THE SAME, THE ID IS PASSED OVER AND THE NEXT ID IN IGRUP IS C UNDER TEST. IF THE ID UNDER TEST IS NOT FOUND IN THE EQT C STRUCTURE, THAT ID IS PUT INTO BUFFER IOFLN. FINALLY, ALL ID C IN BUFFER IOFLN ARE OUTPUT. C C NOTE THE PROCEDURE IS AN ITERATIVE OUTPUT OF OFF-LINE ID BY C GROUP (THERE ARE 27 POSSIBLE GROUPS PER LINE). C C C C C C DIMENSION IBUFS(28),IBUFX(28),IGRUP(30),IOFLN(30),IARAY(3), +IXEQT(30) C C INITIALIZE VARIABLES C KK = 1 LL = 1 C C INITIALIZE BUFFERS IXEQT, IOFLN C CALL SFILL(IXEQT,1,60,000B) CALL SFILL(IOFLN,1,60,000B) IOFLN(1) = -1 CALL SFILL(IBUFX,1,56,000B) C C C C C C FOR EACH MEMBER OF IGRUP, CALL ILINC TO TEST FOR UNIQUENESS. C ILINC TESTS THE TRML ID FOR MEMBERSHIP AMONG ID FOUND IN EQT. C DO 24 K=2,IGRUP(1) 555 CALL ILINC(ILLU,INLU,IGRUP(K),IBUFS,IDCT) C C IDCT = 0, NO ID WAS FOUND IN EQT. THIS TRML IS OFF LINE. C IF(IDCT.EQ.0) 30,24 C C PUT THE OFF LINE ID INTO BUFFER IOFLN C 30 KK = KK+1 IOFLN(KK) = IGRUP(K) IOFLN(1) = KK GO TO 24 C C C C IF IDCT = 1, GO TO 24 THIS IS THE EXPECTED CASE (SINGLE, DISTINCT) C IF IDCT > 1, MORE THAN ONE EQT IS INITIALIZED TO THE SAME TRML. C PUT THE ID INTO BUFFER IXEQT. C 40 IF(IDCT-2) 24,41 C PUT ID INTO IXEQT. 41 LL = LL+1 IXEQT(LL) = IGRUP(K) IXEQT(1) = LL C C PUT IXEQT INTO IBUFX. CALL IXBUF TO TEST FOR SIMILAR ID AMONG C IXBUF. THIS CAN HAPPEN IF THERE ARE SIMILAR ID AMONG IGRUP. C IF(IEEE) 42,24 42 CALL IMSG3(ILLU,IDCT,0,IGRUP(K),8,IARAY,11) C C 24 CONTINUE C C C C C C CHECK FOR ANY OFF-LINE ID NOW. C GO TO 900 IF THERE ARE NO OFF-LINE ID. IF THERE ARE OFF-LINE C ID PRESENT, CHECK FOR NO DUPLICATE ID AMONG THE GROUP POLL LIST, C AND NO DUPLICATE ID AMONG THE EQT ID. C C C C C IF(IOFLN(1)) 900,34 C IXBUF WILL FIND ANY DUPLICATE ID AMONG THE OFF-LINE ID AND C RETURN WITH BUFFER IBUFX CONTAINING ANY DUPLICATE OFF-LINE ID. C THE FIRST WORD OF IBUFX CONTAINS THE COMPLETION CODE. 34 CALL IXBUF(IOFLN,IBUFX) C C IF IBUFX(1) = -1, THERE WAS ONLY 1 OFF LINE ID. C IF(IBUFX(1)) 26,31 C C IF IBUFX(1) = 3,5,7,... THERE APPEARS TO BE SEVERAL SIMILAR ID C A BETTER ALOGORITHM CAN BE MADE BY SKIPPING ID ALREADY IN IBUFX. C HOWEVER, IF IBUFX(2) = 0, THEN NO SIMILAR ID WERE FOUND. C 31 IF(IBUFX(2).EQ.0) 26,32 C C TXTD1 * ab APPEARS OFF LINE nnn TIMES C 32 NN = 2 CALL IMSG3(ILLU,IBUFX(NN),0,IBUFX(NN+1),6,IARAY,11) IF((NN+1).EQ.IBUFX(1)) 900,33 33 NN = NN+2 GO TO 32 C C C C C C C C SHOW THE OFF LINE ID C 26 DO 29 K = 2,IOFLN(1) C SHOW EITHER THE SURVEY OR VERIFY OFF-LINE MESSAGE IF(IEEE) 27,28 C OFF LINE FOR VERIFY MESSAGE 27 CALL IMSG2(ILLU,0,IOFLN(K),4,IARAY,11) GO TO 29 C OFF LINE FOR SURVEY MESSAGE 28 CALL IMSG2(ILLU,0,IOFLN(K),9,IARAY,11) 29 CONTINUE 900 RETURN END C END$ CFTN4,L SUBROUTINE IXBUF(IGRUP,IBUFX),91711-1X032 REV 1926 790906 C 28.08.79 C C CHECK IGRUP FOR DUPLICATE ID, PUT ANY DUPLICATE ID IN BUFFER C IBUFX. C DIMENSION IGRUP(30),IBUFX(28) LL = 2 C INITIALIZE IBUFX DO 5 K = 1,28 5 IBUFX(K) = 0 IBUFX(1) = -1 C DON'T FOOL WITH A SINGLE ID IF(IGRUP(1).EQ.2) GO TO 606 C DO 606 K = 2,IGRUP(1)-1 IDNUM = 1 L = K+1 C COMPARE TWO ID. IF THEY ARE THE SAME, SAVE IGRUP(K) AND THE RUNNING C TOTAL (IDNUM) . 601 IF(IGRUP(K).EQ.IGRUP(L)) 602,603 602 IDNUM = IDNUM+1 IBUFX(LL) = IDNUM IBUFX(LL + 1) = IGRUP(K) 603 IF(L.EQ.IGRUP(1)) 605,604 604 L = L+1 GO TO 601 C ALL THE ID HAVE BEEN TESTED. (A BETTER TEST CAN BE MADE) C ER 605 IBUFX(1) = LL + 1 606 LL = LL + 2 C WRITE(1,110) IBUFX(1),IBUFX(2),IBUFX(3) 110 FORMAT(2X"IXBUF BX1:",I2X"BX2:",I2X"BX3:",A2) RETURN END C END$ CFTN4,L SUBROUTINE IVBUF(IDCT,ITID,ITLU, +IBUFV),91711-1X032 REV 1926 790906 C 28.08.79 C C APPEND THE VALUES IDCT, ITID, ITLU TO BUFFER IBUFV, C THEN RETURN. C DIMENSION IBUFV(60),IBVVV(60) C C INITIALIZE IBVVV C CALL SFILL(IBVVV,1,120,0B) C C IS THIS THE FIRST TIME IBUFV IS ENTERED ? C IF(IBUFV(1)) 15,6 C C NO... THERE ARE ENTRIES TO BE PRESERVED. C 6 KK = IBUFV(1) + 1 DO 10 K = 1,IBUFV(1) 10 IBVVV(K) = IBUFV(K) GO TO 17 C C C C YES.. START ENTERING DATA INTO THE SECOND WORD OF IBVVV C 15 KK = 2 C C C C C NEW DATA IS APPENDED TO EXISTING DATA C 17 IBVVV(KK) = IDCT KK = KK + 1 IBVVV(KK) = ITID KK = KK + 1 IBVVV(KK) = ITLU C UPDATE THE BUFFER LENGTH IBVVV(1) = KK C C C C C NOW CLEAR IBUFV TO 0 C CALL SFILL(IBUFV,1,120,0B) C C COPY THE CURRENT DATA INTO IBUFV AND RETURN C DO 30 K = 1,IBVVV(1) 30 IBUFV(K) = IBVVV(K) C C C C C 40 RETURN END END$