home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / fortran / palasm.lbr / PALASM.FQR / PALASM.FOR
Encoding:
Text File  |  1985-04-14  |  28.8 KB  |  795 lines
  1. C****************************************************************************
  2. C
  3. C
  4. C     MAIN PROGRAM
  5. C
  6.       BYTE    IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(80),
  7.      C        ISYM(8,20),IBUF(8,20)
  8.       BYTE    E,O,T,P,B,H,S,L,N,Q,U,F,C,R,A,
  9.      C        BB,CC,DD,EE,FF,II,NN,OO,PP,RR,SS,TT,UU,
  10.      C        IPAGE,FNAME(11),MYLINE(80),
  11.      C        INOAI,IOT,INOO,CR,LF,IOP,CLRS
  12.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  13.      C        LFIX,LFIRST,LMATCH,LFUSES(32,64),LPHASE(20),LBUF(20),
  14.      C        LPROD(80),LSAME,LACT,LOPERR,LINP,LPRD,LHEAD
  15.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  16.       COMMON /PGE/ IPAGE(80,100)
  17.       COMMON /FTEST/ IFUNCT,IDESC,IEND
  18.       DATA E/'E'/,O/'O'/,T/'T'/,P/'P'/,B/'B'/,H/'H'/,S/'S'/,L/'L'/,
  19.      C     N/'N'/,Q/'Q'/,U/'U'/,F/'F'/,C/'C'/,R/'R'/,A/'A'/
  20.       DATA BB/'B'/,CC/'C'/,DD/'D'/,EE/'E'/,FF/'F'/,II/'I'/,NN/'N'/,
  21.      C     OO/'O'/,PP/'P'/,RR/'R'/,SS/'S'/,TT/'T'/,UU/'U'/
  22.       DATA CR/X'0D'/,LF/X'0A'/,CLRS/X'0C'/
  23.  
  24.  999  IFUNCT=0
  25.       IDESC=0
  26.       LSAME=.FALSE.
  27.       LACT=.FALSE.
  28.       LOPERR=.FALSE.
  29.       LINP=.FALSE.
  30.       LPRD=.FALSE.
  31.       LHEAD=.FALSE.
  32. C
  33.       WRITE(1,3)CLRS
  34.     3    FORMAT(' ',A1,'  PAL ASSEMBLER  VERSION  3.1    ',/////)
  35.   530    CALL GFNAME(FNAME,INUNIT,.TRUE.)
  36.     CALL OPEN(6,FNAME,INUNIT)
  37.       READ(6,10,END=500) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
  38.    10 FORMAT(4A1,A1,A1,A1,73A1,/,80A1,/,80A1,/,80A1)
  39.     GOTO 510
  40.  500    WRITE(1,520)
  41.         ENDFILE 6
  42.  520    FORMAT(' FILE DOESN''T EXIST, REENTER',/)
  43.     GOTO 530
  44.  
  45. C
  46.  510  WRITE(1,511) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
  47.  511  FORMAT(' '4A1,A1,A1,A1,73A1,/,' ',80A1,/,
  48.      C       ' ',80A1,/,' ',80A1)
  49.       DO 15 J=1,100
  50.           READ(6,11,END=16) MYLINE
  51.    11     FORMAT(80A1)
  52.     WRITE(1,561)MYLINE
  53.  561    FORMAT(' ',80A1)
  54.     DO 560 I = 1,80
  55.     IPAGE(I,J) = ' '
  56.  560    IF(.NOT.((MYLINE(I).EQ.CR).OR.(MYLINE(I).EQ.LF)))
  57.      C     IPAGE(I,J) = MYLINE(I)
  58.  
  59.       IF(     IFUNCT.EQ.0 .AND.IPAGE(1,J).EQ.FF.AND.
  60.      C    IPAGE(3,J).EQ.NN.AND.IPAGE(5,J).EQ.TT.AND.
  61.      C    IPAGE(7,J).EQ.OO.AND.IPAGE(10,J) .EQ.TT ) IFUNCT=J
  62.       IF(      IDESC.EQ.0 .AND.IPAGE(1,J).EQ.DD.AND.
  63.      C    IPAGE(3,J).EQ.SS.AND.IPAGE(5,J).EQ.RR.AND.
  64.      C    IPAGE(7,J).EQ.PP.AND.IPAGE(10,J) .EQ.OO ) IDESC=J
  65.    15 CONTINUE
  66.    16 IEND=J-1
  67.       CALL INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX)
  68.       ILE=IL+1
  69.       IF(ITYPE.NE.0) GO TO 17
  70.           WRITE(1,18) IPAL,INOAI,IOT,INOO
  71.    18     FORMAT(/,' PAL PART TYPE ',4A1,A1,A1,A1,' IS INCORRECT')
  72.           STOP ERROR
  73.    17 DO 20 J=1,20
  74.    20     CALL GETSYM(LPHASE,ISYM,J,IC,IL,LFIX)
  75.           IF(.NOT.(LEQUAL.OR.LLEFT.OR.LAND.OR.LOR.OR.LRIGHT)) GO TO 24
  76.               WRITE(1,23)
  77.    23         FORMAT(/,' LESS THAN 20 PIN NAMES IN PIN LIST')
  78.               STOP ERROR
  79.    24 ILE=IL
  80.    25 CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
  81.    28     IF(.NOT.LEQUAL) GO TO 25
  82.           COUNT=0
  83.           ILL=IL
  84.           CALL MATCH(IMATCH,IBUF,ISYM)
  85.           IF( IMATCH.EQ.0 ) GO TO 100
  86.           IPRD=IMATCH
  87.           LSAME = ( (     LPHASE(IMATCH)).AND.(     LBUF(1)).OR.
  88.      C              (.NOT.LPHASE(IMATCH)).AND.(.NOT.LBUF(1)) )
  89.           IF( IOT.EQ.H.AND.(.NOT.LSAME) )                 LACT=.TRUE.
  90.           IF( (.NOT.(IOT.EQ.H.OR.IOT.EQ.C)).AND.(LSAME) ) LACT=.TRUE.
  91.           IF( (ITYPE.EQ.1.OR.ITYPE.EQ.5.OR.ITYPE.EQ.6).AND.IOT.NE.A.
  92.      C    AND.(IMATCH.LT.12.OR.IMATCH.GT.19) ) LOPERR=.TRUE.
  93.           IF(  ITYPE.EQ.2.AND.(IMATCH.LT.13.OR.IMATCH.GT.18) )
  94.      C                                         LOPERR=.TRUE.
  95.           IF(  ITYPE.EQ.3.AND.(IMATCH.LT.14.OR.IMATCH.GT.17) )
  96.      C                                         LOPERR=.TRUE.
  97.           IF(  ITYPE.EQ.4.AND.(IMATCH.LT.15.OR.IMATCH.GT.16) )
  98.      C                                         LOPERR=.TRUE.
  99.           IF( (LACT).OR.(LOPERR) ) GO TO 100
  100.           I88PRO=(19-IMATCH)*8 + 1
  101.           IF(IOT.EQ.C) I88PRO=25
  102.           IC=0
  103.    30       CALL INCR(IC,IL,LFIX)
  104.             IF( .NOT.(LEQUAL.OR.LLEFT) ) GO TO 30
  105.             LPROD(I88PRO)=.TRUE.
  106.             IF(.NOT.LLEFT) CALL SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW)
  107.             DO 70 I8PRO=1,16
  108.                 COUNT = COUNT + 1
  109.                 IPROD = I88PRO + I8PRO - 1
  110.                 LPROD(IPROD)=.TRUE.
  111.                 LFIRST=.TRUE.
  112.    50             ILL=IL
  113.                   CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
  114.                 IF( (ITYPE.EQ.1.OR.ITYPE.EQ.2.AND.IPRD.GT.13
  115.      C               .AND.IPRD.LT.18).AND.COUNT.GT.2 ) LPRD=.TRUE.
  116.                 IF( (ITYPE.EQ.3.OR.ITYPE.EQ.2.AND.(IPRD.EQ.13.OR.
  117.      C               IPRD.EQ.18)).AND.COUNT.GT.4 ) LPRD=.TRUE.
  118.                 IF( IOT.NE.A.AND.IOT.NE.C.AND.COUNT.GT.8 ) LPRD=.TRUE.
  119.                 IF( .NOT.LPRD ) GO TO 69
  120.                 IF(IL.NE.IFUNCT.AND.IL.NE.IDESC) ILL=IL
  121.                 IPROD = IPROD - 1
  122.                 GO TO 118
  123.    69             IF(LFIX) GO TO 59
  124.                   CALL MATCH(IMATCH,IBUF,ISYM)
  125.                   IF( ITYPE.EQ.1.AND.IMATCH.GT.11 ) LINP=.TRUE.
  126.                   IF( ITYPE.EQ.2.AND.(IMATCH.GT.12.AND.IMATCH.LT.19) )
  127.      C                LINP=.TRUE.
  128.                   IF( ITYPE.EQ.3.AND.(IMATCH.GT.13.AND.IMATCH.LT.18) )
  129.      C                LINP=.TRUE.
  130.                 ILL=IL
  131.                 IF(LINP) GO TO 100
  132.                 IF( IMATCH.EQ.0 ) GO TO 100
  133.                 IF( IMATCH.EQ.10.OR.IMATCH.EQ.99 ) GO TO 64
  134.                 IF(.NOT.LFIRST) GO TO 58
  135.                     LFIRST=.FALSE.
  136.                     DO 56 I=1,32
  137.                         IBLOW = IBLOW + 1
  138.    56                   LFUSES(I,IPROD)=.TRUE.
  139.    58           CALL IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE)
  140.                 IF(IINPUT.LE.0) GO TO 60
  141.                 IBLOW = IBLOW - 1
  142.                 LFUSES(IINPUT,IPROD)=.FALSE.
  143.                 CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE,
  144.      C                    LPROD,IOP,IBLOW)
  145.                 GO TO 60
  146.    59           CALL FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW,
  147.      C                      IPROD,LFIX)
  148.    60           IF(LAND) GO TO 50
  149.    64         IF(.NOT.LRIGHT) GO TO 68
  150.    66           CALL INCR(IC,IL,LFIX)
  151.                 IF(.NOT.LEQUAL)  GO TO 66
  152.    68         IF( .NOT.(LOR.OR.LEQUAL) ) GO TO 74
  153.    70         CONTINUE
  154.    74     ILL=IL
  155.           CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
  156.           IF(LLEFT.OR.LEQUAL) GO TO 28
  157.   100 IF( ILL.EQ.IFUNCT.OR.ILL.EQ.IDESC ) GO TO 102
  158.       ILERR=ILL+4
  159.       WRITE(1,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,79)
  160.   101 FORMAT(' ERROR SYMBOL = ',8A1,'     IN LINE NUMBER ',I3,
  161.      C       /,' ',80A1)
  162.       IF( (LACT).AND.(     LSAME).AND.(.NOT.LOPERR) )
  163.      C         WRITE(1,103) IPAL,INOAI,IOT,INOO
  164.   103 FORMAT(' OUTPUT MUST BE INVERTED SINCE ',4A1,A1,A1,A1,
  165.      C       ' IS AN ACTIVE LOW DEVICE')
  166.       IF( (LACT).AND.(.NOT.LSAME).AND.(.NOT.LOPERR) )
  167.      C         WRITE(1,109) IPAL,INOAI,IOT,INOO
  168.   109 FORMAT(' OUTPUT CANNOT BE INVERTED SINCE ',4A1,A1,A1,A1,
  169.      C       ' IS AN ACTIVE HIGH DEVICE')
  170.       IF( (LOPERR).AND.IMATCH.NE.0 )
  171.      C         WRITE(1,105) IMATCH,IPAL,INOAI,IOT,INOO
  172.   105 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID OUTPUT PIN',
  173.      C       ' FOR ',4A1,A1,A1,A1)
  174.       IF(LINP) WRITE(1,115) IMATCH,IPAL,INOAI,IOT,INOO
  175.   115 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID INPUT PIN',
  176.      C       ' FOR ',4A1,A1,A1,A1)
  177.   118 ILERR=ILL+4
  178.       IF(LPRD) WRITE(1,119)
  179.      C (ISYM(I,IPRD),I=1,8),IPRD,ILERR,(IPAGE(I,ILL),I=1,79)
  180.   119 FORMAT(' OUTPUT PIN NAME = ',8A1,' OUTPUT PIN NUMBER = ',I2,
  181.      C       ' MINTERM IN LINE NUMBER ',I3,/,' ',80A1)
  182.       IF( LPRD.AND.COUNT.LT.8 )
  183.      C         WRITE(1,116) IPROD,IPAL,INOAI,IOT,INOO
  184.   116 FORMAT(' THIS PRODUCT LINE NUMBER ',I2,' IS NOT VALID',
  185.      C       ' FOR ',4A1,A1,A1,A1)
  186.       IF( LPRD.AND.COUNT.GT.8 )
  187.      C         WRITE(1,117) IPAL,INOAI,IOT,INOO
  188.   117 FORMAT(' MAXIMUM OF 8 PRODUCTS LINES ARE VALID FOR ',4A1,A1,A1,A1,
  189.      C       ' TOO MANY MINTERMS ARE SPECIFIED IN THIS EQUATION')
  190.       STOP ERROR
  191.   102 IF(ITYPE.LE.4) CALL TWEEK(ITYPE,IOT,LFUSES)
  192.       ENDFILE 6
  193.   108 WRITE(1,106)
  194.   106 FORMAT(' OPERATION CODES:')
  195.       WRITE(1,107)
  196.   107 FORMAT(/,'  E=ECHO  O=PINOUT  P=PLOT    B=BRIEF  ',
  197.      C       /,'  H=HEX   L=BHLF    N=BNPF    Q=QUIT    S=SIMULATE')
  198.       WRITE(1,110)
  199.   110 FORMAT(' ENTER OPERATION CODE:')
  200.       READ(1,120) IOP
  201.   120 FORMAT(A1)
  202.       IF(IOP.EQ.E) CALL ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,
  203.      C                       COMP)
  204.       IF(IOP.EQ.O) CALL PINOUT(IPAL,INOAI,IOT,INOO,TITLE)
  205.       IF(IOP.EQ.P) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE,
  206.      C                       LPROD,IOP,IBLOW)
  207.       IF(IOP.EQ.B) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE,
  208.      C                       LPROD,IOP,IBLOW)
  209.       IF(IOP.EQ.H) CALL HEX(LFUSES)
  210.       IF(IOP.EQ.L) CALL BINR(LFUSES,H,L)
  211.       IF(IOP.EQ.N) CALL BINR(LFUSES,P,N)
  212. C     IF(IOP.EQ.R) GOTO 999
  213.       IF(IOP.EQ.S) CALL TEST(LPHASE,LBUF,TITLE,IC,IL,ILE,ISYM,IBUF,
  214.      C                       ITYPE,INOO,LFIX)
  215.       IF(IOP.NE.Q) GO TO 108
  216.       STOP
  217.       END
  218. C
  219. C************************************************************************
  220. C
  221.       SUBROUTINE INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX)
  222.       BYTE    INOAI,IOT,INOO
  223.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  224.      C        LFIX,LFUSES(32,64)
  225.     BYTE IPAGE,H,L,C,R,X,A,I0,I2,I4,I6,I8,INOAI,IOT,INOO
  226.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  227.       COMMON /PGE/ IPAGE(80,100)
  228.       DATA H/'H'/,L/'L'/,C/'C'/,R/'R'/,X/'X'/,A/'A'/
  229.      C     I0/'0'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/
  230.       DO 20 J=1,64
  231.          DO 20 I=1,32
  232.    20       LFUSES(I,J)=.FALSE.
  233.       IBLOW=0
  234.       IC=0
  235.       IL=1
  236.       ITYPE=0
  237.       IF(  INOAI.EQ.I0 )                            ITYPE=1
  238.       IF(  INOAI.EQ.I2 )                            ITYPE=2
  239.       IF(  INOAI.EQ.I4 )                            ITYPE=3
  240.       IF( (INOAI.EQ.I6) )                           ITYPE=4
  241.       IF( (INOAI.EQ.I6).AND.(INOO.EQ.I8) )          ITYPE=5
  242.       IF( (IOT.EQ.R).OR.(IOT.EQ.X).OR.(IOT.EQ.A) )  ITYPE=6
  243.       IF( .NOT.(IOT.EQ.H.OR.IOT.EQ.L.OR.IOT.EQ.C
  244.      C      .OR.IOT.EQ.R.OR.IOT.EQ.X.OR.IOT.EQ.A) ) ITYPE=0
  245.       CALL INCR(IC,IL,LFIX)
  246.       RETURN
  247.       END
  248. C
  249. C*************************************************************************
  250. C
  251.       SUBROUTINE INCR(IC,IL,LFIX)
  252.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  253.      C        LFIX,LX1
  254.     BYTE  IPAGE,IBLANK,ILEFT,IAND,IOR,COMENT,ISLASH,IEQUAL,
  255.      C        IRIGHT,ICOLON
  256.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  257.       COMMON /PGE/ IPAGE(80,100)
  258.       DATA IBLANK/' '/,ILEFT/'('/,IAND/'*'/,IOR/'+'/,COMENT/';'/,
  259.      C     ISLASH/'/'/,IEQUAL/'='/,IRIGHT/')'/,ICOLON/':'/
  260.       LBLANK=.FALSE.
  261.       LXOR=.FALSE.
  262.       LXNOR=.FALSE.
  263.       LX1=.FALSE.
  264.       LRIGHT=.FALSE.
  265.    10 IC=IC+1
  266.       IF( IC.LE.79.AND.IPAGE(IC,IL).NE.COMENT ) GO TO 30
  267.       IL=IL+1
  268.    20 IC=0
  269.       GO TO 10
  270.    30 IF( IPAGE(IC,IL).EQ.ICOLON.AND.(LFIX) ) RETURN
  271.       IF( IPAGE(IC,IL).NE.IBLANK ) GO TO 31
  272.           LBLANK=.TRUE.
  273.           GO TO 10
  274.    31 IF( IPAGE(IC,IL).NE.ICOLON ) GO TO 32
  275.       IF( (LXOR).OR.(LXNOR) )  GO TO 33
  276.       LX1=.TRUE.
  277.       GO TO 10
  278.    33 IF(LXOR)  LOR=.TRUE.
  279.       IF(LXNOR) LAND=.TRUE.
  280.       RETURN
  281.    32 IF( .NOT.(LX1.AND.(IPAGE(IC,IL).EQ.IOR.OR.IPAGE(IC,IL).EQ.IAND)) )
  282.      C     GO TO 34
  283.       IF( IPAGE(IC,IL).EQ.IOR  ) LXOR=.TRUE.
  284.       IF( IPAGE(IC,IL).EQ.IAND ) LXNOR=.TRUE.
  285.       GO TO 10
  286.    34 LLEFT =( IPAGE(IC,IL).EQ.ILEFT  )
  287.       LAND  =( IPAGE(IC,IL).EQ.IAND   )
  288.       LOR   =( IPAGE(IC,IL).EQ. IOR   )
  289.       LSLASH=( IPAGE(IC,IL).EQ.ISLASH )
  290.       LEQUAL=( IPAGE(IC,IL).EQ.IEQUAL )
  291.       LRIGHT=( IPAGE(IC,IL).EQ.IRIGHT )
  292.       RETURN
  293.       END
  294. C
  295. C************************************************************************
  296. C
  297.       SUBROUTINE GETSYM(LPHASE,ISYM,J,IC,IL,LFIX)
  298.       BYTE    ISYM(8,20)
  299.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  300.      C        LFIX,LPHASE(20)
  301.     BYTE  IPAGE,IBLANK
  302.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  303.       COMMON /PGE/ IPAGE(80,100)
  304.       DATA IBLANK/' '/
  305.       LFIX=.FALSE.
  306.       IF( .NOT.(LLEFT.OR.LAND.OR.LOR.OR.LEQUAL.OR.LRIGHT) ) GO TO 10
  307.       CALL INCR(IC,IL,LFIX)
  308.       IF(LLEFT) GO TO 60
  309.    10 LPHASE(J)=( .NOT.LSLASH )
  310.       IF(LPHASE(J)) GO TO 15
  311.       CALL INCR(IC,IL,LFIX)
  312.    15 DO 20 I=1,8
  313.    20     ISYM(I,J)=IBLANK
  314.    25 DO 30 I=1,7
  315.    30     ISYM(I,J)=ISYM(I+1,J)
  316.       ISYM(8,J)=IPAGE(IC,IL)
  317.       CALL INCR(IC,IL,LFIX)
  318.       IF( LLEFT.OR.LBLANK.OR.LAND.OR.LOR.OR.LRIGHT.OR.LEQUAL ) RETURN
  319.       GO TO 25
  320.    60 LFIX=.TRUE.
  321.       RETURN
  322.       END
  323. C
  324. C***************************************************************************
  325. C
  326.       SUBROUTINE MATCH(IMATCH,IBUF,ISYM)
  327.       BYTE    IBUF(8,20),ISYM(8,20)
  328.       LOGICAL LMATCH
  329.     BYTE  C,A,R,Y
  330.       DATA C/'C'/,A/'A'/,R/'R'/,Y/'Y'/
  331.       IMATCH=0
  332.       DO 20 J=1,20
  333.           LMATCH=.TRUE.
  334.           DO 10 I=1,8
  335.    10         LMATCH=LMATCH.AND.(IBUF(I,1).EQ.ISYM(I,J))
  336.           IF(LMATCH) IMATCH=J
  337.    20     CONTINUE
  338.       IF( IBUF(3,1).EQ.C.AND.IBUF(4,1).EQ.A.AND.IBUF(5,1).EQ.R.AND.
  339.      C    IBUF(6,1).EQ.R.AND.IBUF(7,1).EQ.Y ) IMATCH=99
  340.       RETURN
  341.       END
  342. C
  343. C**********************************************************************
  344. C
  345.       SUBROUTINE IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE)
  346.       BYTE    ITABLE(20,6)
  347.       LOGICAL LPHASE(20),LBUF(20)
  348.       DATA    ITABLE/
  349.      C   3, 1, 5, 9,13,17,21,25,29,-10,31,-1,-1,-1,-1,-1,-1,-1,-1,-20,
  350.      C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,-1,-1,-1,-1,-1,-1, 7,-20,
  351.      C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,-1,-1,-1,-1,11, 7,-20,
  352.      C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,19,-1,-1,15,11, 7,-20,
  353.      C   3, 1, 5, 9,13,17,21,25,29,-10,31,-1,27,23,19,15,11, 7,-1,-20,
  354.      C  -1, 1, 5, 9,13,17,21,25,29,-10,-1,31,27,23,19,15,11, 7, 3,-20/
  355.       IINPUT=0
  356.       IBUBL=0
  357.       IF(((     LPHASE(IMATCH)).AND.(.NOT.LBUF(1))).OR.
  358.      C   ((.NOT.LPHASE(IMATCH)).AND.(     LBUF(1)))) IBUBL=1
  359.       IF( ITABLE(IMATCH,ITYPE).GT.0 ) IINPUT=ITABLE(IMATCH,ITYPE)+IBUBL
  360.       RETURN
  361.       END
  362. C
  363. C************************************************************************
  364. C
  365.       SUBROUTINE PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,LDUMP,ITYPE,
  366.      C                LPROD,IOP,IBLOW)
  367.       BYTE    IBUF(8,20),IOUT(64),TITLE(80)
  368.       LOGICAL LBUF(20),LFUSES(32,64),LDUMP,LPROD(80)
  369.     BYTE  ISAVE(64,32),IAND,IOR,ISLASH,
  370.      C        IDASH,X,IBLANK,P,B,HIFANT,IOP,CLRS
  371.       DATA ISAVE/2048*' '/,IAND/'*'/,IOR/'+'/,ISLASH/'/'/,
  372.      C     IDASH/'-'/,X/'X'/,IBLANK/' '/,P/'P'/,B/'B'/,
  373.      C     HIFANT/'O'/,CLRS/X'0C'/
  374.       IF(.NOT.LDUMP) GO TO 4
  375.     4 IF(LDUMP) GO TO 60
  376.       IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
  377.       IF( LBUF(1) ) GO TO 5
  378.       DO 30 J=1,31
  379.    30     ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  380.       ISAVE(IPROD,32)=ISLASH
  381.     5 DO 20 I=1,8
  382.          IF( ISAVE(IPROD,1).NE.IBLANK ) RETURN
  383.           IF( IBUF(I,1).EQ.IBLANK ) GO TO 20
  384.           DO 10 J=1,31
  385.    10         ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  386.           ISAVE(IPROD,32)=IBUF(I,1)
  387.    20     CONTINUE
  388.       IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
  389.    40 DO 50 J=1,31
  390.    50     ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  391.       ISAVE(IPROD,32)=IAND
  392.       RETURN
  393.    60 WRITE(1,62) CLRS,TITLE
  394.    62 FORMAT(' ',A1,80A1,//,
  395.      C '                11 1111 1111 2222 2222 2233',/,
  396.      C '    0123 4567 8901 2345 6789 0123 4567 8901',/)
  397.       DO 100 I88PRO=1,57,8
  398.           DO 94 I8PRO=1,8
  399.               IPROD=I88PRO+I8PRO-1
  400.               ISAVE(IPROD,32)=IBLANK
  401.               DO 70 I=1,32
  402.                   IF( ISAVE(IPROD,1).NE.IBLANK ) GO TO 70
  403.                   DO 65 J=1,31
  404.                       ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  405.    65                 CONTINUE
  406.                   ISAVE(IPROD,32)=IBLANK
  407.    70         CONTINUE
  408.               DO 80 I=1,32
  409.                   IOUT(I)=X
  410.                   IF( LFUSES(I,IPROD) ) IOUT(I)=IDASH
  411.                   IOUT(I+32)=ISAVE(IPROD,I)
  412.    80         CONTINUE
  413.               IF(ITYPE.LE.4) CALL FANTOM(ITYPE,IOUT,IPROD,I8PRO)
  414.               IPROD=IPROD-1
  415.               DO 85 J=1,32
  416.                   IF( IOP.EQ.B.AND.IOUT(J).EQ.HIFANT ) IOUT(J)=IBLANK
  417.    85         CONTINUE
  418.               IF( (IOP.EQ.P).OR.(IOP.EQ.B.AND.(LPROD(IPROD+1))) )
  419.      C        WRITE(1,90) IPROD,IOUT
  420.    90         FORMAT(' ',I2,8(' ',4A1),' ',32A1)
  421.    94         CONTINUE
  422.           WRITE(1,96)
  423.    96     FORMAT(1X)
  424.   100     CONTINUE
  425.       WRITE(1,110)
  426.   110 FORMAT(/,
  427.      C' LEGEND:  X : FUSE NOT BLOWN (L,N,0)   - : FUSE BLOWN   (H,P,1)')
  428.       IF( IOP.EQ.P.AND.ITYPE.LE.4 ) WRITE(1,111)
  429.   111 FORMAT(
  430.      C'          0 : PHANTOM FUSE   (L,N,0)   O : PHANTOM FUSE (H,P,1)')
  431.       WRITE(1,112) IBLOW
  432.   112 FORMAT(/,' NUMBER OF FUSES BLOWN = ',I4)
  433.       WRITE(1,113)
  434.   113 FORMAT(////)
  435.       RETURN
  436.       END
  437. C
  438. C*************************************************************************
  439. C
  440.       SUBROUTINE TWEEK(ITYPE,IOT,LFUSES)
  441.       BYTE    IOT
  442.       LOGICAL LFUSES(32,64)
  443.     BYTE  L,C
  444.       DATA L/'L'/,C/'C'/
  445.       IF(ITYPE.GE.4) GO TO 20
  446.       DO 10 IPROD=1,64
  447.           LFUSES(15,IPROD)=.TRUE.
  448.           LFUSES(16,IPROD)=.TRUE.
  449.           LFUSES(19,IPROD)=.TRUE.
  450.           LFUSES(20,IPROD)=.TRUE.
  451.           IF(ITYPE.GE.3) GO TO 10
  452.           LFUSES(11,IPROD)=.TRUE.
  453.           LFUSES(12,IPROD)=.TRUE.
  454.           LFUSES(23,IPROD)=.TRUE.
  455.           LFUSES(24,IPROD)=.TRUE.
  456.           IF(ITYPE.GE.2) GO TO 10
  457.           LFUSES( 7,IPROD)=.TRUE.
  458.           LFUSES( 8,IPROD)=.TRUE.
  459.           LFUSES(27,IPROD)=.TRUE.
  460.           LFUSES(28,IPROD)=.TRUE.
  461.    10     CONTINUE
  462.       DO 18 IINPUT=7,28
  463.           DO 12 IPROD=1,57,8
  464.               LFUSES(IINPUT,IPROD+4)=.FALSE.
  465.               LFUSES(IINPUT,IPROD+5)=.FALSE.
  466.               LFUSES(IINPUT,IPROD+6)=.FALSE.
  467.    12         LFUSES(IINPUT,IPROD+7)=.FALSE.
  468.           IF(ITYPE.GE.3) GO TO 18
  469.           DO 14 IPROD=17,41,8
  470.               LFUSES(IINPUT,IPROD+2)=.FALSE.
  471.    14         LFUSES(IINPUT,IPROD+3)=.FALSE.
  472.           IF(ITYPE.GE.2) GO TO 18
  473.           DO 16 IPROD=1,57,8
  474.               LFUSES(IINPUT,IPROD+2)=.FALSE.
  475.    16         LFUSES(IINPUT,IPROD+3)=.FALSE.
  476.    18 CONTINUE
  477.    20 IF( (ITYPE.EQ.1) .OR. ((ITYPE.EQ.4).AND.(IOT.EQ.L)) ) RETURN
  478.       DO 99 IINPUT=1,32
  479.           DO 30 IPROD=1,8
  480.               LFUSES(IINPUT,IPROD+ 0)= (IOT.NE.L)
  481.    30         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+56)= (IOT.NE.L)
  482.           IF(ITYPE.LE.2) GO TO 99
  483.           DO 40 IPROD=1,8
  484.               LFUSES(IINPUT,IPROD+ 8)= (IOT.NE.L)
  485.    40         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+48)= (IOT.NE.L)
  486.           IF(ITYPE.LE.3) GO TO 99
  487.           DO 50 IPROD=1,8
  488.               LFUSES(IINPUT,IPROD+16)= (IOT.NE.L)
  489.    50         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+40)= (IOT.NE.L)
  490.    99     CONTINUE
  491.       RETURN
  492.       END
  493. C
  494. C************************************************************************
  495. C
  496.       SUBROUTINE SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW)
  497.       LOGICAL LFUSES(32,64)
  498.     BYTE  R,I1,I2,I4,I6,I8,IOT,INOO,INOAI
  499.       DATA R/'R'/,I1/'1'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/
  500.       IF( (INOAI.NE.I6) .OR. (INOO.EQ.I1) .OR.  (INOO.EQ.I2) .OR.
  501.      C    ( (IOT.EQ.R).AND.(INOO.EQ.I8) ) .OR.
  502.      C    ( (I88PRO.GE. 9).AND.(I88PRO.LE.49).AND.(INOO.EQ.I6) ) .OR.
  503.      C    ( (I88PRO.GE.17).AND.(I88PRO.LE.41).AND.(INOO.EQ.I4)) ) RETURN
  504.       DO 10 I=1,32
  505.       IBLOW = IBLOW + 1
  506.    10 LFUSES(I,I88PRO) = .TRUE.
  507.       I88PRO = I88PRO + 1
  508.       RETURN
  509.       END
  510. C
  511. C*************************************************************************
  512. C
  513.       SUBROUTINE FANTOM(ITYPE,IOUT,IPROD,I8PRO)
  514.       BYTE    IOUT(64)
  515.     BYTE  X,IDASH,LOFANT,HIFANT
  516.       DATA X/'X'/,IDASH/'-'/,LOFANT/'0'/,HIFANT/'O'/
  517.       DO 10 I=1,32
  518.           IF( IOUT(I).EQ.IDASH ) IOUT(I)=HIFANT
  519.           IF( IOUT(I).EQ.X )     IOUT(I)=LOFANT
  520.    10 CONTINUE
  521.       IF((ITYPE.EQ.4).AND.((IPROD.LE.24).OR.(IPROD.GE.41))) RETURN
  522.       IF((ITYPE.EQ.3).AND.((IPROD.LE.16).OR.(IPROD.GE.45))) RETURN
  523.       IF((ITYPE.EQ.2).AND.((IPROD.LE. 8).OR.(IPROD.GE.53))) RETURN
  524.       IF((ITYPE.LE.3).AND.(I8PRO.GE.5)) RETURN
  525.       IF((ITYPE.LE.2).AND.(IPROD.GE.19).AND.(IPROD.LE.48).AND.
  526.      C   (I8PRO.GE.3)) RETURN
  527.       IF((ITYPE.EQ.1).AND.(I8PRO.GE.3)) RETURN
  528.       DO 50 I=1,32
  529.         IF(((I.EQ.15).OR.(I.EQ.16).OR.(I.EQ.19).OR.(I.EQ.20)).AND.
  530.      C   (ITYPE.LE.3)) GO TO 50
  531.         IF(((I.EQ.11).OR.(I.EQ.12).OR.(I.EQ.23).OR.(I.EQ.24)).AND.
  532.      C   (ITYPE.LE.2)) GO TO 50
  533.         IF(((I.EQ. 7).OR.(I.EQ. 8).OR.(I.EQ.27).OR.(I.EQ.28)).AND.
  534.      C   (ITYPE.LE.1)) GO TO 50
  535.         IF( IOUT(I).EQ.HIFANT ) IOUT(I)=IDASH
  536.         IF( IOUT(I).EQ.LOFANT ) IOUT(I)=X
  537.    50 CONTINUE
  538.       RETURN
  539.       END
  540. C
  541. C****************************************************************************
  542. C    *****************************************************************
  543.     SUBROUTINE DATAIO (TEXT,NUMBER)
  544.     LOGICAL TEXT(1)
  545.     INTEGER NUMBER
  546.     EXTERNAL PUNCH
  547.     DO 10 I= 1, NUMBER
  548.  10    CALL PUNCH(TEXT(I))
  549.     RETURN
  550.     END
  551. C      ***********************************************************
  552. C      ***********************************************************
  553. C      ***********************************************************
  554.        LOGICAL FUNCTION IHEXA(I)
  555.        LOGICAL STRNG(16)
  556.        DATA STRNG/'0','1','2','3','4','5','6','7','8','9',
  557.      1  'A','B','C','D','E','F'/
  558.        M=MOD(I,16)+1
  559.        IHEXA=STRNG(M)
  560.        RETURN
  561.        END
  562. C    **********
  563.        SUBROUTINE HEX(LFUSES)
  564.        LOGICAL LFUSES(32,64)
  565.        LOGICAL    ITEMP(64),IHEXA
  566.     LOGICAL T(128)
  567.     LOGICAL STX,ETX,NULL(50),DC1,READER
  568.     EXTERNAL READER
  569.     DATA STX/X'02'/,ETX/X'03'/,NULL/50*X'00'/,DC1/X'11'/
  570.     WRITE(1,81)
  571.    81    FORMAT(' DATA I/O SETUP:'/' TYPE ''SELECT 50,ENTER''')
  572.     WRITE(1,82)
  573.    82    FORMAT(' TYPE ''SELECT D2,ENTER''')
  574.     WRITE(1,83)
  575.    83    FORMAT(' THEN PRESS ''START'' BUTTON ')
  576.    87   IF(READER(0).XOR.DC1) GOTO 87
  577.     WRITE(1,88)
  578.    88   FORMAT(' STARTING TRANSMISSION')
  579.     ENCODE(T,70)STX
  580.     CALL DATAIO(T,1)
  581.        DO 40 I=1,33,32
  582.        INC=I-1
  583.        DO 40 IPROD=1,7,2
  584.        DO 20 J=1,2
  585.        DO 20 IINPUT=1,32
  586.        IHEX=0
  587.        M=IPROD+INC+J-1
  588.          IF(LFUSES(IINPUT,M+ 0)) IHEX=IHEX+1
  589.          IF(LFUSES(IINPUT,M+ 8)) IHEX=IHEX+2
  590.          IF(LFUSES(IINPUT,M+16)) IHEX=IHEX+4
  591.          IF(LFUSES(IINPUT,M+24)) IHEX=IHEX+8
  592.        M=IINPUT+32*(J-1)
  593.    20  ITEMP(M)=IHEXA(IHEX)
  594.     ENCODE(T,60)ITEMP
  595.    40    CALL DATAIO(T,128)
  596.     ENCODE(T,80)ETX,NULL
  597.     CALL DATAIO(T,51)
  598.    60  FORMAT(64(A1,' '))
  599.    70    FORMAT(A1)
  600.    80    FORMAT(51A1)
  601.        RETURN
  602.        END
  603. C
  604. C*************************************************************************
  605. C
  606.       SUBROUTINE ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP)
  607.       BYTE    IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(79)
  608.     BYTE  IPAGE,INOAI,IOT,INOO,CLRS
  609.       COMMON /PGE/ IPAGE(80,100)
  610.       COMMON /FTEST/ IFUNCT,IDESC,IEND
  611.     DATA  CLRS/X'0C'/
  612.       WRITE(1,10)CLRS,IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
  613.    10 FORMAT(' ',A1,4A1,A1,A1,A1,73A1,/,' ',80A1,/,' ',80A1,/,' ',80A1)
  614.       DO 30 J=1,IEND
  615.            WRITE(1,20) (IPAGE(I,J),I=1,80)
  616.    20      FORMAT(' ',80A1)
  617.    30 CONTINUE
  618.       RETURN
  619.       END
  620. C
  621. C******************************************************************************
  622. C
  623.       SUBROUTINE BINR(LFUSES,H,L)
  624.       BYTE    ITEMP(4,8),H,L,CLRS
  625.       LOGICAL LFUSES(32,64)
  626.     DATA CLRS/X'0C'/
  627.       WRITE(1,10)CLRS
  628.    10 FORMAT(' ',A1)
  629.       DO 20 I=1,33,32
  630.       INC=I-1
  631.         DO 20 IPROD=1,8
  632.             DO 20 J=1,25,8
  633.               DO 15 K=1,8
  634.                 IINPUT=J+K-1
  635.                 ITEMP(1,K)=L
  636.                 ITEMP(2,K)=L
  637.                 ITEMP(3,K)=L
  638.                 ITEMP(4,K)=L
  639.         MYINX = IPROD + INC
  640.                 IF(LFUSES(IINPUT,MYINX +  0)) ITEMP(4,K)=H
  641.                 IF(LFUSES(IINPUT,MYINX +  8)) ITEMP(3,K)=H
  642.                 IF(LFUSES(IINPUT,MYINX + 16)) ITEMP(2,K)=H
  643.                 IF(LFUSES(IINPUT,MYINX + 24)) ITEMP(1,K)=H
  644.    15           CONTINUE
  645.    20         WRITE(1,30) ITEMP
  646.    30         FORMAT(' ',8('B',4A1,'F '))
  647.       WRITE(1,10)
  648.       RETURN
  649.       END
  650. C
  651. C**************************************************************************
  652. C
  653.       SUBROUTINE PINOUT(IPAL,INOAI,IOT,INOO,TITLE)
  654.       BYTE    IPAL(4),TITLE(80),PIN(8,20),IIN(7,2)
  655.     BYTE  IPAGE,IBLANK,ISTAR,INOAI,IOT,INOO,CLRS
  656.       COMMON /PGE/ IPAGE(80,100)
  657.       DATA IBLANK/' '/,ISTAR/'*'/,CLRS/X'0C'/
  658.       DO 10 J=1,20
  659.           DO 5 I=1,8
  660.     5         PIN(I,J)=IBLANK
  661.    10 CONTINUE
  662.    15 DO 25 J=1,2
  663.           DO 20 I=1,7
  664.    20         IIN(I,J)=IBLANK
  665.    25 CONTINUE
  666.       IIN(2,1)=IPAL(1)
  667.       IIN(4,1)=IPAL(2)
  668.       IIN(6,1)=IPAL(3)
  669.       IIN(1,2)=IPAL(4)
  670.       IIN(3,2)=INOAI
  671.       IIN(5,2)=IOT
  672.       IIN(7,2)=INOO
  673.       J=0
  674.       IL=0
  675.    30 IC=0
  676.       IL=IL+1
  677.    35 IC=IC+1
  678.    40 IF( IC.GT.80 ) GO TO 30
  679.       IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 35
  680.       J=J+1
  681.       IF(J.GT.20) GO TO 60
  682.       DO 55 I=1,8
  683.           PIN(I,J)=IPAGE(IC,IL)
  684.           IC=IC+1
  685.           IF( IC.GT.80 ) GO TO 40
  686.           IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 40
  687.    55 CONTINUE
  688.    60 DO 75 J=1,10
  689.           II=0
  690.    65     II=II+1
  691.           IF(II.EQ.9) GO TO 75
  692.           IF( PIN(II,J).NE.IBLANK ) GO TO 65
  693.           I=9
  694.    70     I=I-1
  695.           II=II-1
  696.           PIN(I,J)=PIN(II,J)
  697.           PIN(II,J)=IBLANK
  698.           IF(II.NE.1) GO TO 70
  699.    75 CONTINUE
  700.       WRITE(1,76)CLRS,TITLE
  701.    76 FORMAT(' ',A1,80A1)
  702.       WRITE(1,78) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  703.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  704.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  705.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  706.    78 FORMAT(/,' ',14X,14A1,3X,14A1,
  707.      C       /,' ',14X,A1,13X,A1,1X,A1,13X,A1)
  708.       JJ=20
  709.       DO 88 J=1,10
  710.           WRITE(1,80) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  711.    80 FORMAT(' ',11X,4A1,29X,4A1)
  712.       WRITE(1,81) (PIN(I,J),I=1,8),ISTAR,J,ISTAR,
  713.      C     (IIN(I,1),I=1,7),ISTAR,JJ,ISTAR,(PIN(I,JJ),I=1,8)
  714.    81 FORMAT(' ',8A1,3X,A1,I2,A1,11X,7A1,11X,A1,I2,A1,3X,8A1)
  715.       WRITE(1,82) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  716.    82 FORMAT(' ',11X,4A1,29X,4A1)
  717.       WRITE(1,84) ISTAR,(IIN(I,2),I=1,7),ISTAR
  718.    84 FORMAT(' ',14X,A1,11X,7A1,11X,A1)
  719.       DO 86 II=1,2
  720.           DO 85 I=1,7
  721.    85         IIN(I,II)=IBLANK
  722.    86 CONTINUE
  723.       JJ=JJ-1
  724.    88 CONTINUE
  725.       WRITE(1,90) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  726.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  727.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  728.      C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  729.    90 FORMAT(' ',14X,31A1)
  730.       RETURN
  731.       END
  732. C
  733. C*****************************************************************************
  734. C
  735.       SUBROUTINE FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW,IPROD,LFIX)
  736.       LOGICAL LBUF(20),LFUSES(32,64),LFIRST,LMATCH,LFIX
  737.       BYTE    IBUF(8,20),FIXBUF(8)
  738.     BYTE  IPAGE,A,B,ISLASH,IOR,IBLANK,IRIGHT,IAND,
  739.      C        N,Q,N0,N1,N2,N3,ICOLON,TABLE(5,14)
  740.       COMMON /PGE/ IPAGE(80,100)
  741.       DATA A/'A'/,B/'B'/,ISLASH/'/'/,IOR/'+'/,IBLANK/' '/,IRIGHT/')'/,
  742.      C        IAND/'*'/,N/'N'/,Q/'Q'/,N0/'0'/,N1/'1'/,N2/'2'/,N3/'3'/,
  743.      C      ICOLON/':'/
  744.       DATA    TABLE      /      ' ','A','+','/','B',' ',' ','A','+','B',
  745.      C      ' ',' ',' ',' ','A','/','A','+','/','B',' ',' ',' ','/','B',
  746.      C      'A',':','+',':','B',' ','A','*','/','B',' ','/','A','+','B',
  747.      C      'A',':','*',':','B',' ',' ',' ',' ','B',' ',' ','A','*','B',
  748.      C      ' ',' ',' ','/','A','/','A','*','/','B',' ','/','A','*','B'/
  749.       IINPUT=0
  750.       DO 20 I=1,8
  751.           IBUF(I,1)=IBLANK
  752.    20     FIXBUF(I)=IBLANK
  753.    21 CALL INCR(IC,IL,LFIX)
  754.       I=IPAGE(IC,IL)
  755.       IF(I.EQ.IRIGHT) GO TO 40
  756.       IF(I.EQ.N0) IINPUT=8
  757.       IF(I.EQ.N1) IINPUT=12
  758.       IF(I.EQ.N2) IINPUT=16
  759.       IF(I.EQ.N3) IINPUT=20
  760.       DO 24 J=1,7
  761.    24     IBUF(J,1)=IBUF(J+1,1)
  762.       IBUF(8,1)=I
  763.       IF(.NOT. ( (I.EQ.A).OR.(I.EQ.B).OR.(I.EQ.ISLASH).OR.(I.EQ.IOR)
  764.      C       .OR.(I.EQ.IAND).OR.(I.EQ.ICOLON) ) )  GO TO 21
  765.       DO 30 I=1,4
  766.    30     FIXBUF(I)=FIXBUF(I+1)
  767.       FIXBUF(5)=IPAGE(IC,IL)
  768.       GO TO 21
  769.    40 IMATCH=0
  770.       DO 60 J=1,14
  771.           LMATCH=.TRUE.
  772.           DO 50 I=1,5
  773.    50         LMATCH=LMATCH .AND. ( FIXBUF(I).EQ.TABLE(I,J) )
  774.    60     IF(LMATCH) IMATCH=J
  775.       IF(IMATCH.EQ.0) GO TO 100
  776.       IF(.NOT.LFIRST) GO TO 85
  777.           LFIRST=.FALSE.
  778.           DO 80 I=1,32
  779.               LFUSES(I,IPROD)=.TRUE.
  780.    80         IBLOW = IBLOW + 1
  781.    85 DO 90 I=1,4
  782.           IF( (IMATCH-7).LE.0 ) GO TO 90
  783.           MYINX = IINPUT + I
  784.           LFUSES(MYINX,IPROD)=.FALSE.
  785.           IBLOW = IBLOW - 1
  786.           IMATCH=IMATCH-8
  787.    90 IMATCH=IMATCH+IMATCH
  788.       LBUF(1)=.TRUE.
  789.       CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE,
  790.      C          LPROD,IOP,IBLOW)
  791.   100 LFIX=.FALSE.
  792.       CALL INCR(IC,IL,LFIX)
  793.       RETURN
  794.       END
  795.