home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / dirs / apalasm_432.lzh / APalAsm / Source / palasm24.for
Text File  |  1991-01-12  |  45KB  |  1,507 lines
  1. C**PALASM24**PALASM24**PALASM24**PALASM24**PALASM24**PALASM24**
  2. C
  3. C P A L A S M 2 4 - TRANSLATES SYMBOLIC EQUATIONS INTO PAL OBJECT
  4. C                    CODE FORMATTED FOR DIRECT INPUT TO STANDARD
  5. C                    PROM PROGRAMMERS.
  6. C
  7. C INPUT: PAL DESIGN SPECIFICATION ASSIGNED
  8. C          TO RPD(1). OPERATION CODES ARE
  9. C          ASSIGNED TO ROP(5).
  10. C
  11. C OUTPUT: ECHO,SIMULATION, AND FUSE PATTERN
  12. C           ARE ASSIGNED TO POF(6). HEX AND BINARY
  13. C          FORMATS ARE ASSIGNED TO PDF(6). PROMPTS
  14. C          AND ERROR MESSAGES ARE ASSIGNED TO PMS(6).
  15. C
  16. C PART NUMBER: THE PAL PART NUMBER MUST APPEAR IN
  17. C               COLUMN ONE OF LINE ONE.
  18. C
  19. C PIN LIST: 24 SYMBOLIC PIN NAMES MUST APPEAR STARTING
  20. C            ON LINE FIVE.
  21. C
  22. C EQUATIONS: STARTING FIRST LINE AFTER THE PIN LIST IN
  23. C             THE FOLLOWING FORMS:
  24. C
  25. C             A = B * C + D ; A EQUALS B AND C OR D
  26. C
  27. C             A := B * C + D ; A IS REPLACED AFTER LOW TO
  28. C                            ; HIGH TRANSISTION OF THE CLOCK
  29. C                            ; IF B AND C OR D
  30. C
  31. C             IF( A * B ) C = D + E ; IF A AND B ARE TRUE THEN
  32. C                                   ; C EQUALS D OR E
  33. C
  34. C ALL CHARACTERS FOLLOWING THE ';' ARE IGNORED UNTIL NEXT LINE
  35. C
  36. C BLANKS ARE IGNORED
  37. C
  38. C OPERATORS: (IN HIERARCHY OF EVALUATION )
  39. C
  40. C             ;        COMMENT FOLLOWS
  41. C             /        COMPLEMENT
  42. C             *        AND, PRODUCT
  43. C             +        OR, SUM
  44. C             :+:    EXCLUSIVE OR
  45. C             ( )    CONDITIONAL THREE STATE
  46. C             =         EQUALITY
  47. C             :=     REPLACE BY ( AFTER CLOCK )
  48. C
  49. C FUNCTION TABLE: L, H, X, Z, C ARE VALID FUNCTION
  50. C                  TABLE ENTRIES
  51. C
  52. C SUBROUTINES: INITLZ, GETSYM, INCR, MATCH, IXLATE,
  53. C               ECHO, PINOUT, PLOT, HEX, TWEEK, BINR,
  54. C               SLIP, FANTOM, IODC2, IODC4, TEST
  55. C
  56. C REV LEVEL: 07/20/81
  57. C
  58. C FINE PRINT: MONOLITHIC MEMORIES TAKES NO RESPONSIBILITY
  59. C              FOR THE OPERATION OR MAINTENANCE OF THIS PROGRAM.
  60. C              THE SOURCE CODE AS PRINTED HERE PRODUCED THE OBJECT 
  61. C              CODE OF THE EXAMPLES IN THE APPLICATIONS SECTION
  62. C              ON A VAX/VMS COMPUTER AND A NATIONAL CSS IBM
  63. C              SYSTEM/370 FORTRAN IV(G).
  64. C
  65. C****************************************************************
  66. C
  67. C Compile and Link using Absoft's AC/FORTRAN Ver. 2.3
  68. C
  69. C F77 -deksu palasm.for
  70. C
  71. C F77l -y -m -o apalasm24 palasm args.sub errmsg.sub
  72. C
  73. C MY USAGE FOR THE PROGRAM: apalasm24 filename
  74. C
  75. C INPUT: filename.pal
  76. C 
  77. C OUTPUT: The following files are generated from the following
  78. C          optional OPERATION CODES.
  79. C
  80. C            E = filename.src
  81. C            O = filename.pins
  82. C            T = filename.sim
  83. C            P = filename.plt
  84. C            B = filename.brf
  85. C            D = filename.jed
  86. C
  87. C          The other outputs were removed from the menu only
  88. C          because they are for paper tape type devices.
  89.  
  90. C****************************************************************
  91. C
  92.       PROGRAM PALASM
  93. C
  94. C****************************************************************
  95. C
  96. C
  97. C     MAIN PROGRAM
  98. C
  99.       IMPLICIT    NONE
  100.       INTEGER    IPAL(3),INAME(5),REST(72),PATNUM(80),TITLE(80),
  101.      .        COMP(80),ISYM(8,24),IBUF(8,24),IPAGE(80,200),
  102.      .        IFUNCT,IDESC,IEND,PMS,POF,PDF,E,O,T,P,B,D,ILE,ILL,
  103.      .        H,S,L,N,Q,U,F,BB,CC,DD,EE,FF,II,NN,OO,PP,RR,IMATCH,
  104.      .        SS,TT,UU,AA,LL,RPD,ROC,LEN,J,I,ITYPE,IC,IL,IBLOW,
  105.      .        I88PRO,I8PRO,C,IPROD,IINPUT,IOP,ILERR
  106.       LOGICAL    LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,
  107.      .        LFIRST,LMATCH,LFUSES(40,80),LPHASE(24),LBUF(24),
  108.      .        LPROD(80),LSAME,LACT,LOPERR,LHEAD
  109.       CHARACTER cmdline*20,filename*25
  110.       COMMON    LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  111.       COMMON    /PGE/ IPAGE(80,200)
  112.       COMMON      /FTEST/ IFUNCT,IDESC,IEND
  113.       COMMON      /LUNIT/ PMS,POF,PDF
  114.       DATA E/'E'/,O/'O'/,T/'T'/,P/'P'/,B/'B'/,D/'D'/,
  115.      .     H/'H'/,S/'S'/,L/'L'/,N/'N'/,Q/'Q'/,U/'U'/,F/'F'/
  116.       DATA BB/'B'/,CC/'C'/,DD/'D'/,EE/'E'/,FF/'F'/,II/'I'/,NN/'N'/,
  117.      .     OO/'O'/,PP/'P'/,RR/'R'/,SS/'S'/,TT/'T'/,UU/'U'/,AA/'A'/,
  118.      .     LL/'L'/
  119. C
  120. C
  121.       RPD = 2 
  122.       ROC = 5
  123.       POF = 9
  124.       PDF = 9
  125.       PMS = 9
  126.       IFUNCT = 0
  127.       IDESC = 0
  128. C
  129.       LSAME = .FALSE.
  130.       LACT = .FALSE.
  131.       LOPERR = .FALSE.
  132.       LHEAD = .TRUE.
  133. C
  134. C read in the first 4 lines of the pal design spec
  135. C
  136. C
  137. C read the command line arg
  138. C 
  139.       Call args(cmdline)
  140.       filename = cmdline
  141.       len = index(cmdline,' ')
  142.       filename(len:) = '.pal'
  143.       PRINT*,'This Program is in the Public Domain'
  144.       PRINT*,'Reading file ',filename
  145. C
  146.       OPEN(UNIT=2,FILE=filename,STATUS='old')
  147.       READ(RPD,10) IPAL,INAME,REST,PATNUM,TITLE,COMP
  148.    10 FORMAT(3A1,5A1,72A1,/,80A1,/,80A1,/,80A1)
  149. C
  150. C read in the pin list (line 5) through the end of the pal design
  151. C specification
  152. C
  153.       DO (J=1,200)
  154.       READ(RPD,11,END=16) (IPAGE(I,J),I=1,80)
  155.    11 FORMAT(80A1)
  156. C
  157. C check for 'FUNCTION TABLE'and save the line number
  158. C
  159.       IF( IFUNCT.EQ.0 .AND. IPAGE(1,J).EQ.FF.AND.
  160.      .    IPAGE(2,J).EQ.UU.AND.IPAGE(3,J).EQ.NN.AND.
  161.      .    IPAGE(4,J).EQ.CC.AND.IPAGE(5,J).EQ.TT.AND.
  162.      .    IPAGE(6,J).EQ.II.AND.IPAGE(7,J).EQ.OO.AND.
  163.      .    IPAGE(8,J).EQ.NN.AND.IPAGE(10,J).EQ.TT.AND.
  164.      .    IPAGE(11,J).EQ.AA.AND.IPAGE(12,J).EQ.BB.AND.
  165.      .    IPAGE(13,J).EQ.LL.AND.IPAGE(14,J).EQ.EE)IFUNCT=J
  166.  
  167. C
  168. C check for 'DESCRIPTION' and save the line number
  169. C
  170.       IF( IDESC.EQ.0 .AND. IPAGE(1,J).EQ.DD.AND.
  171.      .    IPAGE(2,J).EQ.EE.AND.IPAGE(3,J).EQ.SS.AND.
  172.      .    IPAGE(4,J).EQ.CC.AND.IPAGE(5,J).EQ.RR.AND.
  173.      .    IPAGE(6,J).EQ.II.AND.IPAGE(7,J).EQ.PP.AND.
  174.      .    IPAGE(8,J).EQ.TT.AND.IPAGE(9,J).EQ.II.AND.
  175.      .    IPAGE(10,J).EQ.OO.AND.IPAGE(11,J).EQ.NN) IDESC=J
  176.       REPEAT
  177. C
  178. C save the last line number of the pal design spec
  179. C
  180.    16 IEND = J-1
  181.       CLOSE(2)
  182.       CALL INITLZ(INAME,ITYPE,LFUSES,IC,IL,IBLOW,LPROD)
  183. C
  184. C print error message for invalid pal part type
  185. C
  186.       IF(ITYPE.NE.0) GO TO 17
  187.       WRITE(PMS,18) IPAL,INAME
  188.    18 FORMAT(/,' PAL PART TYPE "',3A1,5A1,'" IS INCORRECT')
  189.       STOP
  190. C
  191. C get 24 pin names
  192. C
  193.    17 DO (J=1,24)
  194.            CALL GETSYM(LPHASE,ISYM,J,IC,IL)
  195.       REPEAT
  196.       IF(.NOT.(LEQUAL.OR.LLEFT.OR.LAND.OR.LOR.OR.LRIGHT)) GO TO 24
  197.       WRITE(PMS,23)
  198.    23 FORMAT(/,' LESS THAN 24 PIN NAMES IN THE PIN LIST')
  199.       STOP
  200.    24 ILE = IL
  201.    25 CALL GETSYM(LBUF,IBUF,1,IC,IL)
  202.    28 IF(.NOT.LEQUAL) GO TO 25
  203.          ILL = IL
  204.       CALL MATCH(IMATCH,IBUF,ISYM)
  205.       IF(IMATCH.EQ.0) GO TO 100
  206. C
  207. C check for valid polarity (active low)
  208. C
  209.       LSAME = ((LPHASE(IMATCH)).AND.(LBUF(1)).OR.
  210.      .        (.NOT.LPHASE(IMATCH)).AND.(.NOT.LBUF(1)))
  211.       IF(ITYPE.NE.6.AND.(LSAME)) LACT = .TRUE.
  212. C
  213. C check for valid output pin
  214. C
  215.    29 IF((ITYPE.EQ.1.OR.ITYPE.EQ.7.OR.ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.
  216.      .   ITYPE.EQ.10).AND.(IMATCH.LT.14.OR.IMATCH.GT.23))
  217.      .   LOPERR = .TRUE.
  218.       IF((ITYPE.EQ.2.OR.ITYPE.EQ.11.OR.ITYPE.EQ.12.OR.ITYPE.EQ.13
  219.      .   .OR.ITYPE.EQ.14).AND.(IMATCH.LT.15.OR.IMATCH.GT.22))
  220.      .   LOPERR = .TRUE.
  221.       IF(ITYPE.EQ.3.AND.(IMATCH.LT.16.OR.IMATCH.GT.21))
  222.      .   LOPERR = .TRUE.
  223.       IF(ITYPE.EQ.4.AND.(IMATCH.LT.17.OR.IMATCH.GT.20))
  224.      .   LOPERR = .TRUE.
  225.       IF((ITYPE.EQ.5.OR.ITYPE.EQ.6).AND.(IMATCH.LT.18.OR.IMATCH.GT.19))
  226.      .   LOPERR = .TRUE.
  227.       IF((LACT).OR.(LOPERR)) GO TO 100
  228.       I88PRO = (23-IMATCH)*8+1
  229. C
  230. C start PAL20C1 on product line 33
  231. C
  232.       IF(INAME(3).EQ.C) I88PRO = 33
  233.       IC = 0
  234.    30 CALL INCR(IC,IL)
  235.          IF(.NOT.(LEQUAL.OR.LLEFT)) GO TO 30
  236.       LPROD(I88PRO) = .TRUE.
  237.       IF(.NOT.LLEFT) CALL SLIP(LFUSES,I88PRO,ITYPE,IBLOW)
  238.       DO(I8PRO = 1,16)
  239.             IPROD = I88PRO+I8PRO-1
  240.             LPROD(IPROD) = .TRUE.
  241.             LFIRST = .TRUE.
  242.    50         ILL = IL
  243.                CALL GETSYM (LBUF,IBUF,1,IC,IL)
  244.             CALL MATCH(IMATCH,IBUF,ISYM)
  245.             IF(IMATCH.EQ.0) GO TO 100
  246.             IF(IMATCH.EQ.12) GO TO 64
  247.             IF(.NOT.LFIRST) GO TO 58
  248.                 LFIRST = .FALSE.
  249.                 DO (I=1,40)
  250.                     IBLOW = IBLOW+1
  251.                     LFUSES(I,IPROD) = .TRUE.
  252.                 REPEAT
  253.    58 CALL IXLATE(IINPUT,LPHASE,IMATCH,LBUF,ITYPE)
  254.       IF(IINPUT.LE.0) GO TO 60
  255.       IBLOW = IBLOW-1
  256.       LFUSES(IINPUT,IPROD) = .FALSE.
  257.       CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE,
  258.      .             LPROD,IOP,IBLOW,I88PRO,I8PRO,cmdline)
  259.    60 IF(LAND) GO TO 50
  260.    64 IF(.NOT.LRIGHT) GO TO 68
  261.    66 CALL INCR(IC,IL)
  262.       IF(.NOT.LEQUAL) GO TO 66
  263.    68 IF(.NOT.(LOR.OR.LEQUAL)) GO TO 74
  264.       REPEAT
  265.    74 ILL = IL
  266.       CALL GETSYM(LBUF,IBUF,1,IC,IL)
  267.       IF(LLEFT.OR.LEQUAL) GO TO 28
  268.   100 IF(ILL.EQ.IFUNCT.OR.ILL.EQ.IDESC.OR.ILL.EQ.IEND) GO TO 104
  269. C
  270. C error message for unrecognizable symbol
  271. C
  272.       ILERR = ILL+4
  273.       WRITE(PMS,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,80)
  274.   101 FORMAT(/,' ERROR SYMBOL = ',8A1,' IN LINE NUMBER ',I3,
  275.      .       /, ' ',80A1)
  276. C
  277. C error message for active high/low errors
  278. C
  279.       IF((LACT).AND.(.NOT.LOPERR)) WRITE(PMS,102) IPAL,INAME
  280.   102 FORMAT(' OUTPUT MUST BE INVERTED SINCE ',3A1,5A1,
  281.      .        ' IS AN ACTIVE LOW DEVICE')
  282. C
  283. C error message for invalid output pin
  284. C
  285.       IF((LOPERR).AND.IMATCH.NE.0) WRITE(PMS,103)IMATCH,IPAL,INAME
  286.   103 FORMAT(' THIS PIN, NUMBER ',I2,' IS AN INVALID OUTPUT PIN',
  287.      .       ' FOR ',3A1,5A1)
  288.       STOP
  289.   104 CALL TWEEK(ITYPE,LFUSES)
  290. C
  291. C print optional header
  292. C
  293.       PRINT*,'APALASM24 by Bob Metzler                   Version 1.00'
  294.   105 IF(LHEAD) WRITE(PMS,106)
  295.   106 FORMAT(/,' THIS PALASM AIDS THE USER IN THE DESIGN AND'
  296.      .     ' PROGRAMMING OF THE',/,' SERIES 24 PAL FAMILY. THE',
  297.      .    ' FOLLOWING OPTIONS ARE PROVIDED:',
  298.      .     //,'     ECHO(E)      - PRINTS THE PAL DESIGN',
  299.      .    ' SPECIFICATION',
  300.      .     /,'     PIN OUT(O)   - PRINTS THE PIN OUT OF THE PAL',
  301.      .     /,'     SIMULATE(T)  - EXERCISES THE FUNCTION TABLE',
  302.      .    ' VECTORS IN LOGIC',/,'                    EQUATIONS',
  303.      .      ' AND GENERATES TEST VECTORS',
  304.      .     /,'     PLOT(P)      - PRINTS THE ENTIRE FUSE PLOT',
  305.      .     /,'     BRIEF(B)     - PRINTS ONLY THE USED PRODUCT LINES',
  306.      .      ' OF THE FUSE PLOT',/,'                    PHANTOM',
  307.      .      ' FUSES ARE OMITTED'
  308.      .     /,'     DATA I/O(D)  - GENERATES FUSE OUTPUT FOR DATA I/O',
  309.      .    ' PROGRAMMERS',
  310.      .     /,'     QUIT(Q)      - EXITS PALASM')
  311. C
  312. C    .     /,'     HEX(H)       - GENERATES HEX OUTPUT FOR PAPER TAPE',
  313. C    .     /,'     SHORT(S)     - GENERATES HEX OUTPUT FOR PAPER TAPE',
  314. C    .     /,'     BHLF(L)      - GENERATES BHLF OUTPUT FOR PAPER TAPE',
  315. C    .     /,'     BNPF(N)      - GENERATES BNPF OUTPUT FOR PAPER TAPE',
  316. C
  317.   107 WRITE(PMS,108)
  318.   108 FORMAT(/,' OPERATION CODES:')
  319.       WRITE(PMS,109)
  320.   109 FORMAT(/,' E=ECHO INPUT O=PIN OUT T=SIMULATE P=PLOT B=BRIEF',
  321.      .      /,' D=DATA I/O Q=QUIT')
  322. C
  323. C    .      /,' D=DATA I/O H=HEX S=SHORT L=BHLF N=BNPF Q=QUIT')
  324. C
  325.       WRITE(PMS,110)
  326.   110 FORMAT(/,' ENTER OPERATION CODE:')
  327.         READ(*,120) IOP
  328.   120 FORMAT(A1)
  329. C     call IODC2
  330.       IF(IOP.EQ.E) CALL ECHO(IPAL,INAME,REST,PATNUM,TITLE,COMP,
  331.      .                       cmdline)
  332.       IF(IOP.EQ.O) CALL PINOUT(IPAL,INAME,TITLE,cmdline)
  333.       IF(IOP.EQ.T) CALL TEST(LPHASE,LBUF,TITLE,IC,IL,
  334.      .                       ILE,ISYM,IBUF,ITYPE,cmdline)
  335.       IF(IOP.EQ.P) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,
  336.      .                      .TRUE.,ITYPE,LPROD,IOP,IBLOW,I88PRO,
  337.      .                      I8PRO,cmdline)
  338.       IF(IOP.EQ.B) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,
  339.      .                      .TRUE.,ITYPE,LPROD,IOP,IBLOW,I88PRO,
  340.      .                      I8PRO,cmdline)
  341.       IF(IOP.EQ.D) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,
  342.      .                      .TRUE.,ITYPE,LPROD,IOP,IBLOW,I88PRO,
  343.      .                      I8PRO,cmdline)
  344.       IF(IOP.EQ.H) CALL HEX(LFUSES,H,cmdline)
  345.       IF(IOP.EQ.S) CALL HEX(LFUSES,S,cmdline)
  346.       IF(IOP.EQ.L) CALL BINR(LFUSES,H,L)
  347.       IF(IOP.EQ.N) CALL BINR(LFUSES,P,N)
  348. C     call IODC4
  349.       IF(IOP.NE.Q) GO TO 107
  350.       STOP
  351.       END
  352. C
  353. C ********************************************************
  354. C
  355.       SUBROUTINE INITLZ(INAME,ITYPE,LFUSES,IC,IL,IBLOW,LPROD)
  356. C
  357. C This subroutine initializes variables and matches pal part
  358. C number with ITYPE
  359. C
  360.       IMPLICIT NONE
  361.       INTEGER INAME(5),INFO(6,14),ITYPE,IC,IL,IBLOW,IPAGE,I,J
  362.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,
  363.      .        LFUSES(40,80),LMATCH,LXOR,LPROD(80)
  364.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  365.       COMMON /PGE/ IPAGE(80,200)
  366.       DATA INFO/
  367.      . '1','2','L','1','0',1,
  368.      . '1','4','L','8',' ',2,
  369.      . '1','6','L','6',' ',3,
  370.      . '1','8','L','4',' ',4,
  371.      . '2','0','L','2',' ',5,
  372.      . '2','0','C','1',' ',6,
  373.      . '2','0','L','1','0',7,
  374.      . '2','0','X','1','0',8,
  375.      . '2','0','X','8',' ',9,
  376.      . '2','0','X','4',' ',10,
  377.      . '2','0','L','8',' ',11,
  378.      . '2','0','R','8',' ',12,
  379.      . '2','0','R','6',' ',13,
  380.      . '2','0','R','4',' ',14/
  381. C
  382. C initialize LFUSES array (fuse array)
  383. C
  384.       DO (J=1,80)
  385.             DO (I=1,40)
  386.                 LFUSES(I,J)=.FALSE.
  387.             REPEAT
  388.               LPROD(J)=.FALSE.
  389.       REPEAT
  390. C
  391. C initialize IBLOW (number of fuses blown)
  392. C
  393.       IBLOW = 0
  394. C
  395. C initialize IC and IL (column and line pointers)
  396. C
  397.       IC = 0
  398.       IL = 1
  399. C
  400. C initialize ITYPE (pal part type)
  401. C
  402.       ITYPE = 0
  403. C
  404. C ITYPE is assigned the following values for each of the pal types
  405. C PAL12L10 = 1 PAL14L8 = 2 PAL16L6 = 3 PAL18L4 = 4
  406. C PAL20L2 = 5 PAL20C1 = 6 PAL20L10 = 7 PAL20X10 =8 
  407. C PAL20X8 = 9 PAL20X4 = 10 PAL20L8 = 11 PAL20R8 =12
  408. C PAL20R6 = 13 PAL20R4 = 14
  409. C
  410.       DO (J=1,14)
  411.         LMATCH =.TRUE.
  412.         DO (I=1,4)
  413.             IF(INAME(I).NE.INFO(I,J)) LMATCH = .FALSE.
  414.         REPEAT
  415.         IF(LMATCH) ITYPE = INFO(6,J)
  416.         IF(LMATCH) go to 50
  417.       REPEAT
  418.       IF(ITYPE.EQ.0) RETURN
  419.    50 CALL INCR(IC,IL)
  420.       RETURN
  421.       END
  422. C
  423. C ********************************************************
  424. C
  425.       SUBROUTINE GETSYM(LPHASE,ISYM,J,IC,IL)
  426. C
  427. C This routine gets the PIN NAME, /if complement logic, and
  428. C the following operation symbol if any
  429. C
  430.       IMPLICIT NONE
  431.       INTEGER ISYM(8,24),IPAGE(80,200),IBLANK,IC,IL,I,J
  432.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,
  433.      .        LXOR,LPHASE(24)
  434.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  435.       COMMON /PGE/ IPAGE(80,200)
  436.       DATA IBLANK/' '/
  437.       IF( .NOT.(LLEFT.OR.LAND.OR.LOR.OR.LEQUAL.OR.LRIGHT)) GO TO 10
  438.       CALL INCR(IC,IL)
  439.    10 LPHASE(J) = (.NOT.LSLASH)
  440.       IF(LPHASE(J)) GO TO 15
  441.       CALL INCR(IC,IL)
  442.    15 DO (I=1,8)
  443.           ISYM(I,J) = IBLANK
  444.       REPEAT
  445.    25 DO (I=1,7)
  446.           ISYM(I,J) = ISYM(I+1,J)
  447.       REPEAT
  448.       ISYM(8,J) = IPAGE(IC,IL)
  449.       CALL INCR(IC,IL)
  450.       IF( LLEFT.OR.LBLANK.OR.LAND.OR.LOR.OR.LRIGHT.OR.LEQUAL) RETURN
  451.       GO TO 25
  452.       END
  453. C
  454. C ********************************************************
  455. C
  456.       SUBROUTINE INCR(IC,IL)
  457. C
  458. C This subroutine increments column and line pointers
  459. C blanks and characters after ';' are ignored
  460. C
  461.       IMPLICIT NONE
  462.       INTEGER ISYM(8,24),IPAGE(80,200),IBLANK,IC,IL,PMS,
  463.      .        POF,PDF,ILEFT,IAND,IOR,COMMENT,ISLASH,IEQUAL,
  464.      .        IRIGHT,ICOLON
  465.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,
  466.      .        LXOR,LXOR1
  467.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  468.       COMMON /PGE/ IPAGE(80,200)
  469.       COMMON /LUNIT/ PMS,POF,PDF
  470.       DATA IBLANK/' '/,ILEFT/'('/,IAND/'*'/,IOR/'+'/,COMMENT/';'/,
  471.      .     ISLASH/'/'/,IEQUAL/'='/,IRIGHT/')'/,ICOLON/':'/
  472.       LBLANK = .FALSE.
  473.       LXOR = .FALSE.
  474.       LXOR1 = .FALSE.
  475.    10 IC = IC+1
  476.       IF(IC.LE.79.AND.IPAGE(IC,IL).NE.COMMENT) GO TO 30
  477.       IL = IL+1
  478.       IF(IL.LE.200) GO TO 20
  479.       WRITE(PMS,15)
  480.    15 FORMAT(/,' SOURCE FILE EXCEEDS 200 LINES')
  481.       STOP
  482.    20 IC = 0
  483.       GO TO 10
  484.    30 IF(IPAGE(IC,IL).NE.IBLANK) GO TO 31
  485.       LBLANK = .TRUE.
  486.       GO TO 10
  487.    31 IF(IPAGE(IC,IL).NE.ICOLON) GO TO 33
  488.       IF(LXOR) GO TO 32
  489.       LXOR1 = .TRUE.
  490.       GO TO 10
  491.    32 LOR = .TRUE.
  492.       RETURN
  493.    33 IF( .NOT.(IPAGE(IC,IL).EQ.IOR.AND.(LXOR1)) ) GO TO 34
  494.       LXOR = .TRUE.
  495.       GO TO 10
  496.    34 LLEFT = (IPAGE(IC,IL).EQ.ILEFT)
  497.       LAND = (IPAGE(IC,IL).EQ.IAND)
  498.       LOR = (IPAGE(IC,IL).EQ.IOR)
  499.       LSLASH = (IPAGE(IC,IL).EQ.ISLASH)
  500.       LEQUAL = (IPAGE(IC,IL).EQ.IEQUAL)
  501.       LRIGHT = (IPAGE(IC,IL).EQ.IRIGHT)
  502.       RETURN
  503.       END
  504. C
  505. C ********************************************************
  506. C
  507.       SUBROUTINE MATCH(IMATCH,IBUF,ISYM)
  508. C
  509. C This subroutine finds a match between the pin name in the equation
  510. C and the pin name in the pin list or function table pin list
  511. C
  512.       IMPLICIT NONE
  513.       INTEGER IBUF(8,24),ISYM(8,24),IMATCH,I,J
  514.       LOGICAL LMATCH
  515.       IMATCH = 0
  516.       DO (J=1,24)
  517.           LMATCH = .TRUE.
  518.           DO (I=1,8)
  519.               LMATCH = LMATCH.AND.(IBUF(I,1).EQ.ISYM(I,J))
  520.           REPEAT
  521.           IF(LMATCH) IMATCH = J
  522.       REPEAT
  523.       RETURN
  524.       END
  525. C
  526. C ********************************************************
  527. C
  528.       SUBROUTINE IXLATE(IINPUT,LPHASE,IMATCH,LBUF,ITYPE)
  529. C
  530. C This subroutine finds a match between input pin number and
  531. C the input line number for a specific pal, add 1 the the input
  532. C line number if the pin is a complement
  533. C
  534.       IMPLICIT NONE
  535.       INTEGER ITABLE(24,14),IINPUT,IMATCH,ITYPE,IBUBL
  536.       LOGICAL LPHASE(24),LBUF(24)
  537.       DATA    ITABLE/
  538.      .3,1,5,9,13,17,21,25,29,33,37,0,39,0,0,0,0,0,0,0,0,0,0,0,
  539.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,0,0,0,0,0,0,0,0,7,0,
  540.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,31,0,0,0,0,0,0,11,7,0,
  541.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,31,27,0,0,0,0,15,11,7,0,
  542.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,31,27,23,0,0,19,15,11,7,0,
  543.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,31,27,23,0,0,19,15,11,7,0,
  544.      .3,1,5,9,13,17,21,25,29,33,37,0,39,0,35,31,27,23,19,15,11,7,0,0,
  545.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0,
  546.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0,
  547.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0,
  548.      .3,1,5,9,13,17,21,25,29,33,37,0,39,35,0,31,27,23,19,15,11,0,7,0,
  549.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0,
  550.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0,
  551.      .0,1,5,9,13,17,21,25,29,33,37,0,0,39,35,31,27,23,19,15,11,7,3,0/
  552.       IBUBL=0
  553.       IF( (( LPHASE(IMATCH)).AND.(.NOT.LBUF(1))).OR.
  554.      .    (( .NOT.LPHASE(IMATCH)).AND.(LBUF(1))) ) IBUBL=1
  555.       IINPUT=ITABLE(IMATCH,ITYPE)+IBUBL
  556.       RETURN
  557.       END
  558. C
  559. C ********************************************************
  560. C
  561.       SUBROUTINE ECHO(IPAL,INAME,REST,PATNUM,TITLE,COMP,cmdline)
  562. C 
  563. C this subroutine prints the pal design specification input file
  564. C
  565.       IMPLICIT NONE
  566.       INTEGER IPAL(3),INAME(5),REST(72),PATNUM(80),TITLE(80),
  567.      .        COMP(80),IPAGE(80,200),IFUNCT,IDESC,IEND,
  568.      .        PMS,POF,PDF,LEN,I,J
  569.       CHARACTER cmdline*20,echoname*25
  570.       COMMON /PGE/ IPAGE(80,200)
  571.       COMMON /LUNIT/ PMS,POF,PDF
  572.       COMMON /FTEST/ IFUNCT,IDESC,IEND
  573. C
  574.       echoname = cmdline
  575.       len = index(cmdline,' ')
  576.       echoname(len:) = '.src'
  577.       PRINT*,'Writing file ',echoname
  578.       OPEN(UNIT=7,FILE=echoname,STATUS='new')
  579. C
  580.       WRITE(7,10) IPAL,INAME,REST,PATNUM,TITLE,COMP
  581.   10  FORMAT(/,' ',3A1,5A1,72A1,/,' ',80A1,/,' ',80A1)
  582.       DO (J=1,IEND)
  583.           WRITE(7,20) (IPAGE(I,J),I=1,80)
  584.   20    FORMAT(' ',80A1)
  585.       REPEAT
  586.       CLOSE(7)
  587.       RETURN
  588.       END
  589. C
  590. C ********************************************************
  591. C
  592.       SUBROUTINE PINOUT(IPAL,INAME,TITLE,cmdline)
  593. C
  594. C this subroutine prints the pin out of the pal
  595. C
  596.       IMPLICIT NONE
  597.       INTEGER IPAL(3),INAME(5),TITLE(80),PIN(8,24),IIN(8,2),
  598.      .        IPAGE(80,200),IBLANK,ISTAR,LEN,PMS,POF,PDF,
  599.      .        I,J,IL,IC,II,JJ
  600.       CHARACTER cmdline*20,pinname*25
  601.       COMMON /PGE/ IPAGE(80,200)
  602.       COMMON /LUNIT/ PMS,POF,PDF
  603.       DATA IBLANK/' '/,ISTAR/'*'/
  604. C
  605.       pinname = cmdline
  606.       len = index(cmdline,' ')
  607.       pinname(len:) = '.pins'
  608.       PRINT*,'Writing file ',pinname
  609.       OPEN(UNIT=8,FILE=pinname,STATUS='new')
  610. C
  611.       DO (J=1,24)
  612.           DO (I=1,8)
  613.             PIN(I,J)=IBLANK
  614.         REPEAT
  615.       REPEAT
  616.       DO (J=1,2)
  617.           DO (I=1,8)
  618.             IIN(I,J)=IBLANK
  619.         REPEAT
  620.       REPEAT
  621.       IIN(2,1)=IPAL(1)
  622.       IIN(4,1)=IPAL(2)
  623.       IIN(6,1)=IPAL(3)
  624.       IIN(1,2)=INAME(1)
  625.       IIN(3,2)=INAME(2)
  626.       IIN(5,2)=INAME(3)
  627.       IIN(7,2)=INAME(4)
  628.       IIN(8,2)=INAME(5)
  629.       J=0
  630.       IL=0
  631.   30  IC=0
  632.       IL=IL+1
  633.   35  IC=IC+1
  634.   40  IF( IC.GT.80) GO TO 30
  635.       IF( IPAGE(IC,IL).EQ.IBLANK) GO TO 35
  636.       J=J+1
  637.       IF(J.GT.24) GO TO 60
  638.       DO (I=1,8)
  639.           PIN(I,J)=IPAGE(IC,IL)
  640.         IC=IC+1
  641.         IF(IC.GT.80) GO TO 40
  642.         IF(IPAGE(IC,IL).EQ.IBLANK) GO TO 40
  643.       REPEAT
  644.   60  DO(J=1,12)
  645.           II=0
  646.   65    II=II+1
  647.         IF(II.EQ.9) GO TO 75
  648.         IF(PIN(II,J).NE.IBLANK) GO TO 65
  649.         I=9
  650.   70    I=I-1
  651.         II=II-1
  652.         PIN(I,J)=PIN(II,J)
  653.         PIN(II,J)=IBLANK
  654.         IF(II.NE.1) GO TO 70
  655.   75  REPEAT
  656.       WRITE(8,76) TITLE
  657.   76  FORMAT(/,' ',80A1)
  658.       WRITE(8,78) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  659.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  660.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  661.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  662.   78  FORMAT(/,' ',14X,14A1,3X,14A1,
  663.      .       /,' ',14X,A1,13X,A1,1X,A1,13X,A1)
  664.       JJ=24
  665.       DO(J=1,12)
  666.           WRITE(8,80) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  667.   80    FORMAT(' ',11X,4A1,29X,4A1)
  668.         WRITE(8,81) (PIN(I,J),I=1,8), ISTAR,J,
  669.      .       (IIN(I,1),I=1,8),JJ,ISTAR,(PIN(I,JJ),I=1,8)
  670.   81    FORMAT(' ',8A1,3X,A1,I2,' ',11X,8A1,10X,' ',I2,A1,3X,8A1)
  671.           WRITE(8,82) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  672.   82    FORMAT(' ',11X,4A1,29X,4A1)
  673.         WRITE(8,84) ISTAR,(IIN(I,2),I=1,8),ISTAR
  674.   84    FORMAT(' ',14X,A1,11X,8A1,10X,A1)
  675.         DO(II=1,2)
  676.             DO(I=1,8)
  677.                 IIN(I,II)=IBLANK
  678.             REPEAT
  679.         REPEAT
  680.         JJ=JJ-1
  681.       REPEAT
  682.       WRITE(8,90) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  683.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  684.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
  685.      .              ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
  686.   90  FORMAT(' ',14X,31A1)
  687.       CLOSE(8)
  688.       RETURN
  689.       END
  690. C
  691. C ********************************************************
  692. C
  693.       SUBROUTINE PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,LDUMP,ITYPE,LPROD,
  694.      .                 IOP,IBLOW,I88PRO,I8PRO,cmdline)
  695. C
  696. C this subroutine produces the fuse plot
  697. C
  698.       IMPLICIT NONE
  699.       INTEGER IBUF(8,24),IOUT(64),ISAVE(80,40),TITLE(80),
  700.      .     IPROD,ITYPE,IOP,IBLOW,I88PRO,I8PRO,PMS,POF,PDF,IAND,
  701.      .     IOR,ISLASH,IDASH,X,IBLANK,P,B,D,ZERO,ONE,FX,FIDASH,
  702.      .     I,J,LEN,K,IDATA(40)
  703.       LOGICAL LBUF(24),LFUSES(40,80),LDUMP,LPROD(80)
  704.       CHARACTER cmdline*20,plotname*25,STX,ETX
  705.       PARAMETER (STX=2,ETX=3)
  706.       COMMON /LUNIT/ PMS,POF,PDF
  707.       DATA ISAVE/3200*' '/,IAND/'*'/,IOR/'+'/,ISLASH/'/'/,
  708.      .     IDASH/'-'/,X/'X'/,IBLANK/' '/,P/'P'/,B/'B'/,
  709.      .     D/'D'/,ZERO/'0'/,ONE/'1'/,FX/'0'/,FIDASH/'0'/
  710. C
  711.       IF(LDUMP) GO TO 58
  712.       IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
  713.       IF(LBUF(1)) GO TO 5
  714.       DO(J=1,39)
  715.           ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  716.       REPEAT
  717.       ISAVE(IPROD,40)=ISLASH
  718.   5   DO(I=1,8)
  719.           IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
  720.         IF(IBUF(I,1).EQ.IBLANK) GO TO 20
  721.         DO(J=1,39)
  722.             ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  723.         REPEAT
  724.         ISAVE(IPROD,40)=IBUF(I,1)
  725.   20  REPEAT
  726.       IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
  727.       DO(J=1,39)
  728.           ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  729.       REPEAT
  730.       ISAVE(IPROD,40)=IAND
  731.       RETURN
  732. C
  733. C print fuse plot
  734. C
  735.   58  plotname = cmdline
  736.       len = index(cmdline,' ')
  737. C
  738.       IF(IOP.EQ.D) THEN
  739.           plotname(len:) = '.jed'
  740.         GO TO 60
  741.       ELSE IF(IOP.EQ.B) THEN
  742.           plotname(len:) = '.brf'
  743.         GO TO 60
  744.       ELSE 
  745.           plotname(len:) = '.plt'
  746.       ENDIF
  747. C
  748.   60  PRINT*,'Writing file ',plotname
  749.       OPEN(UNIT=1,FILE=plotname,STATUS='new')
  750. C
  751.       IF(IOP.EQ.D) GO TO 62
  752.       WRITE(1,61) TITLE
  753.   61  FORMAT(/,' ',80A1,//,
  754.      . '                11 1111 1111 2222 2222 2233 3333 3333',/,
  755.      . '    0123 4567 8901 2345 6789 0123 4567 8901 2345 6789',/)
  756.       GO TO 64
  757. C
  758. C STX determines the starting character for DATA I/O format
  759. C
  760.   62  WRITE(1,63) STX
  761.   63  FORMAT(' ',A1,/,'*L0000'/)
  762.   64  DO(I88PRO=1,73,8)
  763.           DO(I8PRO=1,8)
  764.             IPROD=I88PRO+I8PRO-1
  765.             ISAVE(IPROD,40)=IBLANK
  766.             DO(I=1,40)
  767.                 IF(ISAVE(IPROD,1).NE.IBLANK) GO TO 70
  768.                 DO(J=1,39)
  769.                     ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
  770.                 REPEAT
  771.                 ISAVE(IPROD,40)=IBLANK
  772.   70        REPEAT
  773.             DO(I=1,24)
  774.                 IOUT(I+40)=ISAVE(IPROD,I)
  775.             REPEAT
  776.             IF(ISAVE(IPROD,25).NE.IBLANK) IOUT(64)=IDASH
  777.             DO(I=1,40)
  778.                 IOUT(I)=X
  779.                 IF(LFUSES(I,IPROD)) IOUT(I)=IDASH
  780.             REPEAT
  781.             CALL FANTOM(ITYPE,IOP,IOUT,IPROD,I8PRO)
  782.             IF(IOP.NE.D) GO TO 86
  783.             K=0
  784.   81        DO(I=1,40)
  785.         IF((IOUT(I).EQ.FX).OR.(IOUT(I).EQ.FIDASH)) GO TO 82
  786.                 K=K+1
  787.                 IF(IOUT(I).EQ.X) IDATA(K)=ZERO
  788.                 IF(IOUT(I).EQ.IDASH) IDATA(K)=ONE
  789.   82        REPEAT
  790.             DO(I=1,40)
  791.         IF((IOUT(I).EQ.X).OR.(IOUT(I).EQ.IDASH)) GO TO 84
  792.             REPEAT
  793.             GO TO 94
  794.   84        WRITE(1,85) IDATA
  795.   85        FORMAT(' ',40(A1))
  796.             GO TO 94
  797.   86        IPROD=IPROD-1
  798.             IF((IOP.EQ.P).OR.((IOP.EQ.B).AND.(LPROD(IPROD+1))))
  799.      .      WRITE(1,90) IPROD,IOUT
  800.   90        FORMAT(' ',I2,10(' ',4A1),' ',24A1)
  801.   94    REPEAT
  802.         WRITE(1,96)
  803.   96    FORMAT(1X)
  804.   100 REPEAT
  805.       IF(IOP.NE.D) GO TO 105
  806.       WRITE(1,101) ETX
  807.   101 FORMAT('*',A1,'0000')
  808.       CLOSE(1)
  809.       RETURN
  810.   105 WRITE(1,110)
  811.   110 FORMAT(/,
  812.      .' LEGEND:  X : FUSE NOT BLOWN (L,N,0) - : FUSE BLOWN (H,P,1)')
  813.       IF(IOP.EQ.P) WRITE(1,111)
  814.   111 FORMAT(
  815.      .'          - : PHANTOM FUSE (L,N,0)   - : PHANTOM FUSE (H,P,1)')
  816.       WRITE(1,112) IBLOW
  817.   112 FORMAT(/,' NUMBER OF FUSES BLOWN = ',I4)
  818.       WRITE(1,113)
  819.   113 FORMAT(//)
  820.       CLOSE(1)
  821.       RETURN
  822.       END
  823. C
  824. C ********************************************************
  825. C
  826.       SUBROUTINE HEX(LFUSES,IOP,cmdline)
  827. C
  828. C this subroutine generates hex programming formats
  829. C
  830.       IMPLICIT NONE
  831.       INTEGER ITEMP(80),ITABLE(32),IOP,PMS,POF,PDF,H,S,LEN,
  832.      .     I,INC,IPROD,J,IINPUT,IHEX
  833.       LOGICAL LFUSES(40,80)
  834.       CHARACTER cmdline*20,hexname*25,STX,ETX,SOH
  835.       PARAMETER (SOH=1,STX=2,ETX=3)
  836.       COMMON /LUNIT/PMS,POF,PDF
  837.       DATA H/'H'/,S/'S'/,
  838.      .     ITABLE/'00','01','02','03','04','05','06','07',
  839.      .            '08','09','0A','0B','0C','0D','0E','0F',
  840.      .            '10','11','12','13','14','15','16','17',
  841.      .            '18','19','1A','1B','1C','1D','1E','1F'/
  842. C
  843.       hexname = cmdline
  844.       len = index(cmdline,' ')
  845.       hexname(len:) = '.hex'
  846. C
  847.       PRINT*,'Writing file ',hexname
  848.       OPEN(UNIT=1,FILE=hexname,STATUS='new')
  849. C
  850. C ***** note: some prom programmers need a start character.
  851. C ***** this program outputs an stx for the DATA I/O model 9
  852. C ***** (use SOH instead of STX for model 5)
  853. C
  854.       WRITE(1,5)STX
  855.   5   FORMAT(A1)
  856.       IF(IOP.EQ.H) WRITE(1,10)
  857.   10  FORMAT(//,80(' '),//)
  858. C
  859.       DO(I=1,41,40)
  860.           INC=I-1
  861.         DO (IPROD=1,7,2)
  862.             DO(J=1,2)
  863.                 DO(IINPUT=1,40)
  864.                     IHEX=0
  865.             IF(LFUSES(IINPUT,IPROD+J-1+0+INC)) IHEX=IHEX+1
  866.             IF(LFUSES(IINPUT,IPROD+J-1+8+INC)) IHEX=IHEX+2
  867.             IF(LFUSES(IINPUT,IPROD+J-1+16+INC)) IHEX=IHEX+4
  868.             IF(LFUSES(IINPUT,IPROD+J-1+24+INC)) IHEX=IHEX+8
  869.             IF(LFUSES(IINPUT,IPROD+J-1+32+INC)) IHEX=IHEX+16
  870.             ITEMP(IINPUT+40*(J-1))=ITABLE(IHEX+1)
  871.                 REPEAT
  872.                 ITEMP(IINPUT+40*(J-1))=ITABLE(IHEX+1)
  873.             REPEAT
  874.             IF(IOP.EQ.H) WRITE(1,60)ITEMP
  875.  60         FORMAT(4(' ',20(A2,' '),'.',/))
  876.             IF(IOP.EQ.S) WRITE(1,70)
  877.         REPEAT
  878.         IF(IOP.EQ.S) WRITE(1,70)
  879.       REPEAT
  880.  61   FORMAT(4(' ',20A2,'.',/))
  881.       IF(IOP.EQ.H) WRITE(1,70)
  882.  70   FORMAT(//,80(' '),//)
  883.       WRITE(1,75)ETX
  884.  75   FORMAT(A1)
  885.       CLOSE(1)
  886.       RETURN
  887.       END
  888. C
  889. C ********************************************************
  890. C
  891.       BLOCK DATA
  892.       IMPLICIT NONE
  893.       INTEGER PR8X10(10,14),PROD8(8,11),PRODLN(40,7)
  894.       COMMON /BLK/ PR8X10(10,14),PROD8(8,11),PRODLN(40,7)
  895.       DATA PR8X10/
  896.      .       4,4,4,4,4,4,4,4,4,4,
  897.      .       3,6,5,5,5,5,5,5,6,3,
  898.      .       3,3,7,7,8,8,7,7,3,3,
  899.      .       3,3,3,9,10,10,9,3,3,3,
  900.      .       3,3,3,3,1,1,3,3,3,3,
  901.      .       3,3,3,3,1,1,3,3,3,3,
  902.      .       11,11,11,11,11,11,11,11,11,11,
  903.      .       11,11,11,11,11,11,11,11,11,11,
  904.      .       11,11,11,11,11,11,11,11,11,11,
  905.      .       11,11,11,11,11,11,11,11,11,11,
  906.      .       3,1,1,1,1,1,1,1,1,3,
  907.      .       3,1,1,1,1,1,1,1,1,3,
  908.      .       3,1,1,1,1,1,1,1,1,3,
  909.      .       3,1,1,1,1,1,1,1,1,3/
  910.       DATA PROD8/
  911.      .       1,1,1,1,1,1,1,1,
  912.      .       2,2,2,2,2,2,2,2,
  913.      .       3,3,3,3,3,3,3,3,
  914.      .       4,4,3,3,3,3,3,3,
  915.      .       5,5,3,3,3,3,3,3,
  916.      .       5,5,5,5,3,3,3,3,
  917.      .       6,6,6,6,3,3,3,3,
  918.      .       6,6,3,3,3,3,3,3,
  919.      .       7,7,7,7,7,7,3,3,
  920.      .       7,7,7,7,3,3,3,3,
  921.      .       1,1,1,1,3,3,3,3/
  922.       DATA PRODLN/
  923.      .       40*1HX,
  924.      .       40*1HP,
  925.      .       40*1HN,
  926.      .       6*1HX,2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,2*1HX,
  927.      .       2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,
  928.      .       2*1HX,2*1HP,4*1HX,
  929.      .       10*1HX,2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,2*1HX,
  930.      .       2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,8*1HX,
  931.      .       14*1HX,2*1HP,2*1HX,2*1HP,2*1HX,2*1HP,2*1HX,
  932.      .       2*1HP,12*1HX,
  933.      .       18*1HX,2*1HP,2*1HX,2*1HP,16*1HX/
  934.       END
  935. C
  936. C ********************************************************
  937. C
  938.       SUBROUTINE TWEEK(ITYPE,LFUSES)
  939. C
  940. C this subroutine tweeks the lfuses (the programming fuse plot)
  941. C for high and low phantom fuses
  942. C
  943.       IMPLICIT NONE
  944.       INTEGER ITYPE,PR8X10(10,14),PROD8(8,11),PRODLN(40,7),
  945.      .        P,N,FUSPTR,OUTPUT,GRTYPE,COL,LNTYPE,IROW
  946.       LOGICAL LFUSES(40,80),LBLANK,LLEFT,LAND,LOR,LSLASH,
  947.      .        LEQUAL,LRIGHT,LXOR
  948.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  949.       COMMON /BLK/ PR8X10(10,14),PROD8(8,11),PRODLN(40,7)
  950.       DATA P/'P'/,N/'N'/
  951.       FUSPTR=1
  952.       DO(OUTPUT=1,10)
  953.           GRTYPE=PR8X10(OUTPUT,ITYPE)
  954.         DO(IROW=1,8)
  955.         LNTYPE=PROD8(IROW,GRTYPE)
  956.           DO(COL=1,40)
  957.           IF(PRODLN(COL,LNTYPE).EQ.P) LFUSES(COL,FUSPTR)=.TRUE.
  958.           IF(PRODLN(COL,LNTYPE).EQ.N) LFUSES(COL,FUSPTR)=.FALSE.
  959.           REPEAT
  960.         FUSPTR=FUSPTR+1
  961.         REPEAT
  962.       REPEAT
  963.       RETURN
  964.       END
  965. C
  966. C ********************************************************
  967. C
  968.       SUBROUTINE BINR(LFUSES,H,L)
  969. C
  970. C this subroutine generates binary programming formats
  971. C
  972.       IMPLICIT NONE
  973.       INTEGER ITEMP(5,10),H,L,PMS,POF,PDF,COL,INC,
  974.      .        I,IPROD,J,K,IINPUT
  975.       LOGICAL LFUSES(40,80)
  976.       COMMON /LUNIT/ PMS,POF,PDF
  977.       WRITE(PDF,10)
  978.    10 FORMAT(//,'                                      .',//)
  979.       DO(COL=1,40,40)
  980.           INC=I-1
  981.         DO(IPROD=1,8)
  982.             DO(J=1,49,10)
  983.                 DO(K=1,10)
  984.                     IINPUT=J+K-1
  985.                     ITEMP(1,K)=L
  986.                     ITEMP(2,K)=L
  987.                     ITEMP(3,K)=L
  988.                     ITEMP(4,K)=L
  989.                     ITEMP(5,K)=L
  990.             IF(LFUSES(IINPUT,IPROD+0+INC)) ITEMP(5,K)=H
  991.             IF(LFUSES(IINPUT,IPROD+10+INC)) ITEMP(4,K)=H
  992.             IF(LFUSES(IINPUT,IPROD+20+INC)) ITEMP(3,K)=H
  993.             IF(LFUSES(IINPUT,IPROD+30+INC)) ITEMP(2,K)=H
  994.             IF(LFUSES(IINPUT,IPROD+40+INC)) ITEMP(1,K)=H
  995.                 REPEAT
  996.             WRITE(PDF,30) ITEMP
  997.             REPEAT
  998.         WRITE(PDF,30) ITEMP
  999.         REPEAT
  1000.       WRITE(PDF,30) ITEMP
  1001.       REPEAT
  1002.    30 FORMAT(' ',10('B',5A1,'F'))
  1003.       WRITE(PDF,10)
  1004.       RETURN
  1005.       END
  1006. C
  1007. C ********************************************************
  1008. C
  1009.       SUBROUTINE SLIP(LFUSES,I88PRO,ITYPE,IBLOW)
  1010. C
  1011. C this subroutine will blow the entire conditional three state
  1012. C product line when 'IF(VCC)' condition is used for the
  1013. C corresponding output pin
  1014.  
  1015.       IMPLICIT NONE
  1016.       INTEGER IENABL(10,14),I88PRO,ITYPE,IBLOW,IOUT,I
  1017.       LOGICAL LFUSES(40,80)
  1018. C
  1019. C 1=enabled output  0=anything else for that output
  1020. C
  1021.       DATA IENABL/
  1022.      .        0,0,0,0,0,0,0,0,0,0,
  1023.      .        0,0,0,0,0,0,0,0,0,0,
  1024.      .        0,0,0,0,0,0,0,0,0,0,
  1025.      .        0,0,0,0,0,0,0,0,0,0,
  1026.      .        0,0,0,0,0,0,0,0,0,0,
  1027.      .        0,0,0,0,0,0,0,0,0,0,
  1028.      .        1,1,1,1,1,1,1,1,1,1,
  1029.      .        0,0,0,0,0,0,0,0,0,0,
  1030.      .        1,0,0,0,0,0,0,0,0,1,
  1031.      .        1,1,1,0,0,0,0,1,1,1,
  1032.      .        0,1,1,1,1,1,1,1,1,0,
  1033.      .        0,0,0,0,0,0,0,0,0,0,
  1034.      .        0,1,0,0,0,0,0,0,1,0,
  1035.      .        0,1,1,0,0,0,0,1,1,0/
  1036.  
  1037.       IOUT = (I88PRO-1)/8+1
  1038.       IF(IENABL(IOUT,ITYPE).EQ.0) RETURN
  1039.       DO(I=1,40)
  1040.           IBLOW = IBLOW+1
  1041.         LFUSES(I,I88PRO) = .TRUE.
  1042.       REPEAT
  1043.       I88PRO = I88PRO+1
  1044.       RETURN
  1045.       END
  1046. C
  1047. C ********************************************************
  1048. C
  1049.       SUBROUTINE FANTOM(ITYPE,IOP,IOUT,IPROD,I8PRO)
  1050. C
  1051. C this subroutine updates IOUT (the printed fuse plot)
  1052. C for high and low phantom fuses
  1053. C 
  1054.  
  1055.       IMPLICIT NONE
  1056.       INTEGER IOUT(64),ITYPE,IOP,IPROD,I8PRO,PR8X10(10,14),
  1057.      .        PROD8(8,11),PRODLN(40,7),IROW,
  1058.      .        HIFANT,IBLANK,LNTYPE,GRTYPE,COL,P,B
  1059.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  1060.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  1061.       COMMON /BLK/ PR8X10(10,14),PROD8(8,11),PRODLN(40,7)
  1062.       DATA HIFANT/'0'/,IBLANK/' '/
  1063. C
  1064.       IROW=((IPROD-1)/8)+1
  1065.       GRTYPE=PR8X10(IROW,ITYPE)
  1066.       LNTYPE=PROD8(I8PRO,GRTYPE)
  1067. C
  1068.       DO(COL=1,40)
  1069.      IF(PRODLN(COL,LNTYPE).EQ.P.AND.IOP.EQ.P) IOUT(COL)=HIFANT
  1070.      IF(PRODLN(COL,LNTYPE).EQ.P.AND.IOP.EQ.B) IOUT(COL)=IBLANK
  1071. C     IF(PRODLN(COL,LNTYPE).EQ.N) 
  1072.       REPEAT
  1073.       RETURN
  1074.       END
  1075. C
  1076. C ********************************************************
  1077. C
  1078.       SUBROUTINE IODC2
  1079. C
  1080. C this subroutine turns on peripherals (optional)
  1081. C 
  1082.  
  1083.       IMPLICIT NONE
  1084.       INTEGER PMS,POF,PDF,DC2,BEL
  1085.       COMMON /LUNIT/ PMS,POF,PDF
  1086.       DATA DC2/18/,BEL/7/
  1087.       WRITE(PDF,10) DC2,BEL
  1088.    10 FORMAT(' ',2A1)
  1089.       RETURN
  1090.       END
  1091. C
  1092. C ********************************************************
  1093. C
  1094.       SUBROUTINE IODC4
  1095. C
  1096. C this subroutine turns off peripherals (optional)
  1097. C 
  1098.  
  1099.       IMPLICIT NONE
  1100.       INTEGER PMS,POF,PDF,DC3,DC4,BEL
  1101.       COMMON /LUNIT/ PMS,POF,PDF
  1102.       DATA DC3/19/,DC4/20/,BEL/7/
  1103.       WRITE(PDF,10) BEL,DC3,DC4
  1104.    10 FORMAT(' ',3A1)
  1105.       RETURN
  1106.       END
  1107. C
  1108. C ********************************************************
  1109. C
  1110.       SUBROUTINE TEST(LPHASE,LBUF,TITLE,IC,IL,ILE,ISYM,
  1111.      .                IBUF,ITYPE,cmdline)
  1112. C
  1113. C this subroutine performs the function table simulation
  1114. C and generates test vectors
  1115. C 
  1116.  
  1117.       IMPLICIT NONE
  1118.       INTEGER ISYM(8,24),ISYM1(8,24),IBUF(8,24),IVECT(24),
  1119.      .        IVECTP(24),ISTATE(24),ISTATT(24),IPIN(24),TITLE(80),
  1120.      .        IC,IL,ILE,ITYPE,IPAGE(80,200),PMS,POF,PDF,IFUNCT,
  1121.      .        IDESC,IEND,IDASH,L,H,X,C,Z,N0,N1,IBLANK,COMMENT,
  1122.      .        LEN,ITRST,I,J,IMATCH,ICLOCK,IMAX,NVECT,IC1,IL1,
  1123.      .        IINP,ILL,ITEST,IOUTP,XORSUM,ISUM,IPROD,IIFB,IMESS,
  1124.      .        ILERR
  1125.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LSAME,
  1126.      .          XORFND,LERR,LPHASE(24),LPHAS1(24),LBUF(24),LOUT(24),
  1127.      .          LOUTP(24),LCLOCK,LPTRST,LCTRST,LENABL(24),NREG
  1128.       CHARACTER cmdline*20,simname*25
  1129.       COMMON LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR
  1130.       COMMON    /PGE/ IPAGE(80,200)
  1131.       COMMON    /LUNIT/ PMS,POF,PDF
  1132.       COMMON    /FTEST/ IFUNCT,IDESC,IEND
  1133.       DATA IDASH/'-'/,L/'L'/,H/'H'/,X/'X'/,C/'C'/,Z/'Z'/,N0/'0'/,
  1134.      .     N1/'1'/,IBLANK/' '/,COMMENT/';'/
  1135. C
  1136. C open a file for the simulation vectors
  1137. C
  1138.       simname = cmdline
  1139.       len = index(cmdline,' ')
  1140.       simname(len:) = '.sim'
  1141.       OPEN(UNIT=12,FILE=simname,STATUS='new')
  1142. C
  1143. C print an error message if no function table is supplied
  1144. C
  1145.       IF(IFUNCT.NE.0) GO TO 3
  1146.       WRITE(PMS,2)
  1147.     2 FORMAT(/,' FUNCTION TABLE MUST BE SUPPLIED IN ORDER TO PERFORM',
  1148.      .       ' SIMULATION')
  1149.       RETURN
  1150. C
  1151. C print title
  1152. C
  1153.     3 PRINT*,'Writing file ',simname
  1154.       WRITE(12,4) TITLE
  1155.     4 FORMAT(/,' ',80A1,/)
  1156. C
  1157. C initialize LERR (error flag) to no error
  1158. C
  1159.       LERR=.FALSE.
  1160. C
  1161. C set the starting point of the function table to column 0
  1162. C and IFUNCT + 1
  1163. C
  1164.       IC=0
  1165.       IL=IFUNCT + 1
  1166. C
  1167. C initialize ITRST (three state enable function table pin number)
  1168. C
  1169.       ITRST=0
  1170. C
  1171. C make a dummy call to INCR
  1172. C
  1173.       CALL INCR(IC,IL)
  1174. C
  1175. C set the function table pin list (up to 22)
  1176. C and go 1 more than max to look for dashed line
  1177. C
  1178.       DO(I=1,23)
  1179.           CALL GETSYM(LPHAS1,ISYM1,I,IC,IL)
  1180.         DO(J=1,8)
  1181.             IBUF(J,1) = ISYM1(J,I)
  1182.         REPEAT
  1183.         IF(IBUF(8,1).EQ.IDASH) GO TO 12
  1184.         CALL MATCH(IMATCH,IBUF,ISYM)
  1185.         IF(IMATCH.NE.0) GO TO 7
  1186.         WRITE(PMS,6) (IBUF(J,1),J=1,8)
  1187.     6   FORMAT(/,' FUNCTION TABLE PIN LIST ERROR AT ',8A1)
  1188.         RETURN
  1189.     7   LOUT(I) = .FALSE.
  1190.         ISTATT(I) = X
  1191.         IVECTP(I) = X
  1192. C
  1193. C if appropiate pal type, remember location of the clock and the 
  1194. C three state enable pin in the function table pin list
  1195. C
  1196.         IF(.NOT.(ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.10.OR.
  1197.      .    ITYPE.EQ.12.OR.ITYPE.EQ.13.OR.ITYPE.EQ.14) ) GO TO 10
  1198.            IF(IMATCH.EQ.1) ICLOCK = I
  1199.         IF(IMATCH.EQ.13) ITRST = I
  1200.    10   IPIN(I)=IMATCH
  1201.       REPEAT
  1202. C
  1203. C all signal names for the functional test have been read in
  1204. C adjust the count
  1205. C
  1206.    12 IMAX = I - 1
  1207.       NVECT = 0
  1208. C
  1209. C ************ start of main loop for simulation *************
  1210. C
  1211.    90 NVECT = NVECT + 1
  1212.       IC1 = 0
  1213.       IL1 = ILE
  1214. c
  1215. C go passed the comment lines
  1216. C
  1217.    23 IF(IPAGE(1,IL).EQ.COMMENT) THEN
  1218.           IL = IL + 1
  1219.           GO TO 23
  1220.       ENDIF
  1221. C
  1222. C get vectors from the function table
  1223. C
  1224.       DO(I=1,IMAX)
  1225.           IF(IPAGE(IC,IL).EQ.IBLANK) GO TO 21
  1226.         GO TO 22
  1227.    21     IC = IC + 1
  1228.           IF(IPAGE(IC,IL).EQ.IBLANK) GO TO 21
  1229.    22     IVECT(I) = IPAGE(IC,IL)
  1230.           IC = IC + 1
  1231.       REPEAT
  1232. C
  1233. C advance line count to skip function table comments
  1234. C
  1235.       IL = IL + 1
  1236.       IC = 1
  1237.       IF(IVECT(1).EQ.IDASH) GO TO 95
  1238. C
  1239. C check for valid function table values (H,L,X,Z,C)
  1240. C
  1241.       DO(I=1,IMAX)
  1242.         IF((IVECT(I).EQ.H).OR.(IVECT(I).EQ.L).OR.(IVECT(I).EQ.X).OR.
  1243.      .   (IVECT(I).EQ.C).OR.(IVECT(I).EQ.Z)) GO TO 11 
  1244.         WRITE(PMS,8) IVECT(I),NVECT
  1245.     8   FORMAT(/,' ',A1,' IS NOT AN ALLOWED FUNCTION TABLE ',
  1246.      .         'ENTRY IN VECTOR ',I3)
  1247.         RETURN
  1248.    11 REPEAT
  1249. C
  1250. C initialize clock and three state enable flags
  1251. C
  1252.       LCLOCK = .FALSE.
  1253.       LCTRST = .TRUE.
  1254.       LPTRST = .TRUE.
  1255.       DO(I=1,IMAX)
  1256.           LENABL(I) = .TRUE.
  1257.       REPEAT
  1258. C
  1259. C initialize NREG (not registered output) to false
  1260. C
  1261.       NREG = .FALSE.
  1262. C
  1263. C initialize ISTATE array to all X's
  1264. C
  1265.       DO(I=1,24)
  1266.           ISTATE(I)=X 
  1267.       REPEAT
  1268. C
  1269. C check if this pal type has registers
  1270. C
  1271.         IF( .NOT.(ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.10.OR.
  1272.      .   ITYPE.EQ.12.OR.ITYPE.EQ.13.OR.ITYPE.EQ.14) ) GO TO 25
  1273. C
  1274. C check clock and three state enable pins and change flag if needed
  1275. C
  1276.       IF(IVECT(ICLOCK).EQ.C) LCLOCK = .TRUE.
  1277.       IF(ITRST.EQ.0) GO TO 25
  1278.       LSAME = ((LPHASE(13)).AND.(LPHAS1(ITRST)).OR.
  1279.      .        (.NOT.LPHASE(13)).AND.(.NOT.LPHAS1(ITRST)))
  1280.       IF(IVECT(ITRST).EQ.L.AND.(.NOT.LSAME).OR.
  1281.      .   IVECT(ITRST).EQ.H.AND.(LSAME)) LPTRST = .FALSE.
  1282.       IF(LPTRST) GO TO 25
  1283. C
  1284. C disable registered outputs if appropiate
  1285. C
  1286.       DO(I=1,IMAX)
  1287.           J = IPIN(I)
  1288.     IF(J.EQ.17.OR.J.EQ.18.OR.J.EQ.19.OR.J.EQ.20) LENABL(I)=.FALSE.
  1289.           IF((ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.12.OR.
  1290.      .     ITYPE.EQ.13).AND.(J.EQ.16.OR.J.EQ.21)) LENABL(I)=.FALSE.
  1291.           IF((ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.12).AND.
  1292.      .     (J.EQ.15.OR.J.EQ.22)) LENABL(I) = .FALSE.
  1293.           IF(ITYPE.EQ.8.AND.(J.EQ.14.OR.J.EQ.23)) LENABL(I) = .FALSE.
  1294.       REPEAT
  1295. C
  1296. C **************** scan through the logic equations *********
  1297. C
  1298. C make a dummy call to INCR
  1299. C
  1300.    25 CALL INCR(IC1,IL1)
  1301.    26 CALL GETSYM(LBUF,IBUF,1,IC1,IL1)
  1302.       IF(LLEFT) GO TO 29
  1303.    27 IF(.NOT.LEQUAL) GO TO 26
  1304. C
  1305. C evaluate conditional three state product line
  1306. C
  1307.    29 IF(LEQUAL) GO TO 35
  1308.       NREG = .TRUE.
  1309.    33 CALL GETSYM(LBUF,IBUF,1,IC1,IL1)
  1310.       CALL MATCH(IINP,IBUF,ISYM1)
  1311. C
  1312. C check for GND,VCC,/GND,or /VCC in conditional three state
  1313. C product line
  1314. C
  1315.       IF(IINP.NE.0) GO TO 32
  1316.       CALL MATCH(IMATCH,IBUF,ISYM)
  1317.       ILL = IL1
  1318.       IF(IMATCH.EQ.12.AND.(LBUF(1)).OR.
  1319.      .   IMATCH.EQ.24.AND.(.NOT.LBUF(1))) LCTRST = .FALSE.
  1320.       IF(IINP.EQ.0.AND.IMATCH.NE.12.AND.IMATCH.NE.24) GO TO 100
  1321.       GO TO 34
  1322.    32 ITEST = IVECT(IINP)
  1323.       IF(ITEST.EQ.L.AND.(LPHAS1(IINP)).AND.(LBUF(1))
  1324.      .   .OR.ITEST.EQ.H.AND.(LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  1325.      .   .OR.ITEST.EQ.H.AND.(.NOT.LPHAS1(IINP)).AND.(LBUF(1))
  1326.      .   .OR.ITEST.EQ.L.AND.(.NOT.LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  1327.      .   ) LCTRST = .FALSE.
  1328.       IF(ITEST.EQ.X.OR.ITEST.EQ.Z) LCTRST = .FALSE.
  1329.    34 IF(LAND) GO TO 33
  1330.       GO TO 27
  1331. C
  1332. C evaluate the logic equation
  1333. C find pin number of the output vectors
  1334. C
  1335.    35 CALL MATCH(IOUTP,IBUF,ISYM1)
  1336.       ILL = IL1
  1337.       IF(IOUTP.EQ.0) GO TO 100
  1338.       IF(NREG) LENABL(IOUTP) = LCTRST
  1339.       LOUT(IOUTP) = .TRUE.
  1340.       IF(.NOT.LCTRST) LOUT(IOUTP) = .FALSE.
  1341.       LCTRST = .TRUE.
  1342.       LOUTP(IOUTP) = LBUF(1)
  1343. C
  1344. C determine product term and eventually sum for output keeping
  1345. C track to see if an XOR (exclusive or) has been found
  1346. C
  1347.       XORSUM = H
  1348.       XORFND = .FALSE.
  1349.       ISUM = L
  1350.    28 IPROD = H
  1351.    30 ILL = IL1
  1352.       CALL GETSYM(LBUF,IBUF,1,IC1,IL1)
  1353.       CALL MATCH(IINP,IBUF,ISYM1)
  1354.       IF(IINP.NE.0) GO TO 45
  1355.       CALL MATCH(IMATCH,IBUF,ISYM)
  1356.       IF(IMATCH.NE.12) GO TO 100
  1357.       ITEST = L
  1358.       IINP = 23
  1359.       LPHAS1(23) = .TRUE.
  1360.       GO TO 37
  1361.    45 ITEST = IVECT(IINP)
  1362. C
  1363. C get feed back values
  1364. C
  1365.       IF((.NOT.LCLOCK).OR.(NREG)) GO TO 37
  1366.       CALL MATCH(IIFB,IBUF,ISYM)
  1367.       IF((ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.10.OR.ITYPE.EQ.12.OR.
  1368.      .    ITYPE.EQ.13.OR.ITYPE.EQ.14) .AND.(IIFB.EQ.17.OR.IIFB.EQ.18.OR.
  1369.      .    IIFB.EQ.19.OR.IIFB.EQ.20)) ITEST = IVECTP(IINP)
  1370.       IF((ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.12.OR.ITYPE.EQ.13)
  1371.      .   .AND.(IIFB.EQ.16.OR.IIFB.EQ.21)) ITEST = IVECTP(IINP)
  1372.       IF((ITYPE.EQ.8.OR.ITYPE.EQ.9.OR.ITYPE.EQ.12).AND.
  1373.      .   (IIFB.EQ.15.OR.IIFB.EQ.22)) ITEST = IVECTP(IINP)
  1374.       IF((ITYPE.EQ.8).AND.(IIFB.EQ.14.OR.IIFB.EQ.23)) 
  1375.      .    ITEST = IVECTP(IINP)
  1376.    37 IF(ITEST.EQ.X.OR.ITEST.EQ.Z) ITEST = L
  1377.       IF(ITEST.EQ.L.AND.(LPHAS1(IINP)).AND.(LBUF(1))
  1378.      .   .OR.ITEST.EQ.H.AND.(LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  1379.      .   .OR.ITEST.EQ.H.AND.(.NOT.LPHAS1(IINP)).AND.(LBUF(1))
  1380.      .   .OR.ITEST.EQ.L.AND.(.NOT.LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  1381.      .   ) IPROD = L
  1382.       IF(LAND) GO TO 30
  1383.       IF(ISUM.EQ.L.AND.IPROD.EQ.X) ISUM = X
  1384.       IF((ISUM.NE.H).AND.IPROD.EQ.H) ISUM = H
  1385. C
  1386. C check for XOR (exclusive or) and save intermediate value
  1387. C
  1388.       IF(.NOT.LXOR) GO TO 31
  1389.       XORSUM = ISUM
  1390.       XORFND = .TRUE.
  1391.       ISUM = L
  1392.       GO TO 28
  1393.    31 IF(LOR) GO TO 28
  1394. C
  1395. C if end of equation has been found, determine final sum and save it
  1396. C
  1397.       IF(.NOT.XORFND) ISTATT(IOUTP) = ISUM
  1398.       IF((XORFND).AND.((ISUM.EQ.L.AND.XORSUM.EQ.L).OR.
  1399.      .  (ISUM.EQ.L.AND.XORSUM.EQ.H))) ISTATT(IOUTP) = L
  1400.       IF((XORFND).AND.((ISUM.EQ.H.AND.XORSUM.EQ.L).OR.
  1401.      .  (ISUM.EQ.L.AND.XORSUM.EQ.H))) ISTATT(IOUTP) = H
  1402.       IF((XORFND).AND.((ISUM.EQ.X.AND.XORSUM.EQ.X)))ISTATT(IOUTP)=X 
  1403.       NREG = .FALSE.
  1404. C
  1405. C check if all equations have been processed by comparing current
  1406. C line number with function table line number
  1407. C
  1408.       IF(IDESC.NE.0.AND.IL1.LT.IFUNCT.AND.IL1.LT.IDESC.OR.
  1409.      .   IDESC.EQ.0.AND.IL1.LT.IFUNCT) GO TO 27
  1410. C
  1411. C determine output logic values
  1412. C compare outputs to see if vector agrees with results
  1413. C
  1414.       DO(I=1,IMAX)
  1415.           IF(.NOT.LOUT(I)) GO TO 50
  1416.         IF(ISTATT(I).EQ.X.AND.IVECT(I).EQ.X) GO TO 50
  1417.         LSAME = ((LOUTP(I)).AND.(LPHAS1(I)).OR.
  1418.      .          (.NOT.LOUTP(I)).AND.(.NOT.LPHAS1(I)))
  1419.       IMESS = 40
  1420.       IF(ISTATT(I).EQ.L.AND.IVECT(I).EQ.L.AND.(.NOT.LSAME))IMESS=41
  1421.       IF(ISTATT(I).EQ.H.AND.IVECT(I).EQ.H.AND.(.NOT.LSAME))IMESS=42
  1422.       IF(ISTATT(I).EQ.L.AND.IVECT(I).EQ.H.AND.(LSAME)) IMESS = 42
  1423.       IF(ISTATT(I).EQ.H.AND.IVECT(I).EQ.L.AND.(LSAME)) IMESS = 41
  1424.       IF((LENABL(I)).AND.IVECT(I).EQ.Z) IMESS = 43
  1425.       IF((.NOT.LENABL(I)).AND.(LOUT(I)).AND.IVECT(I).NE.Z)IMESS=44
  1426.       IF(IMESS.NE.40) LERR = .TRUE.
  1427.       IF(IMESS.EQ.41) WRITE(PMS,41) NVECT,(ISYM1(J,I),J=1,8)
  1428.    41 FORMAT(/,' FUNCTION TABLE ERROR IN VECTOR',I3,' PIN =',8A1,
  1429.      .        ' EXPECT = H ACTUAL = L')
  1430.       IF(IMESS.EQ.42) WRITE(PMS,42) NVECT,(ISYM1(J,I),J=1,8)
  1431.    42 FORMAT(/,' FUNCTION TABLE ERROR IN VECTOR',I3,' PIN =',8A1,
  1432.      .        ' EXPECT = L ACTUAL = H')
  1433.       IF(IMESS.EQ.43) WRITE(PMS,43) NVECT,(ISYM1(J,I),J=1,8)
  1434.    43 FORMAT(/,' FUNCTION TABLE ERROR IN VECTOR',I3,' PIN =',8A1,
  1435.      .        ' EXPECT = OUTPUT ENABLE ACTUAL = Z')
  1436.       IF(IMESS.EQ.44) WRITE(PMS,44) NVECT,(ISYM1(J,I),J=1,8),IVECT(I)
  1437.    44 FORMAT(/,' FUNCTION TABLE ERROR IN VECTOR',I3,' PIN =',8A1,
  1438.      .        ' EXPECT = Z ACTUAL = ',A1)
  1439.    50 REPEAT
  1440. C
  1441. C change the order of vectors from the order of appearance in the
  1442. C function table to that of the pin list and tweek for output
  1443. C 
  1444.       DO(I=1,24)
  1445.           DO(J=1,IMAX)
  1446.             IF(IPIN(J).NE.I) GO TO 55
  1447.             IF(IVECT(J).EQ.L.OR.IVECT(J).EQ.H) GO TO 51
  1448.             ISTATE(I) = IVECT(J)
  1449.             GO TO 65
  1450.    51       LSAME = ((LPHASE(I)).AND.(LPHAS1(J)).OR.
  1451.      .        (.NOT.LPHASE(I)).AND.(.NOT.LPHAS1(J)))
  1452.       IF(ITYPE.EQ.6.AND.(I.EQ.18.OR.I.EQ.19))LOUT(J)=.TRUE.
  1453.             IF((.NOT.LOUT(J)).AND.(LSAME).AND.
  1454.      .      IVECT(J).EQ.L) ISTATE(I) = N0 
  1455.             IF((.NOT.LOUT(J)).AND.(LSAME).AND.
  1456.      .      IVECT(J).EQ.H) ISTATE(I) = N1
  1457.             IF((.NOT.LOUT(J)).AND.(.NOT.LSAME).AND.
  1458.      .      IVECT(J).EQ.L) ISTATE(I) = N1
  1459.             IF((.NOT.LOUT(J)).AND.(.NOT.LSAME).AND.
  1460.      .      IVECT(J).EQ.H) ISTATE(I) = N0
  1461.             IF((LOUT(J)).AND.(LSAME).AND.
  1462.      .      IVECT(J).EQ.L.AND.(LENABL(J))) ISTATE(I) = L
  1463.             IF((LOUT(J)).AND.(LSAME).AND.
  1464.      .      IVECT(J).EQ.H.AND.(LENABL(J))) ISTATE(I) = H
  1465.             IF((LOUT(J)).AND.(.NOT.LSAME).AND.
  1466.      .      IVECT(J).EQ.L.AND.(LENABL(J))) ISTATE(I) = H
  1467.             IF((LOUT(J)).AND.(.NOT.LSAME).AND.
  1468.      .      IVECT(J).EQ.H.AND.(LENABL(J))) ISTATE(I) = L
  1469.              GO TO 65
  1470.    55     REPEAT
  1471. C
  1472. C save present vectors for feed back used with next set of vectors
  1473. C if clock pulse and not Z ( Z would be an unrealistic value)
  1474. C
  1475.    65 IF((LCLOCK).AND.IVECT(J).NE.Z) IVECTP(J) = IVECT(J)
  1476.       REPEAT
  1477. C
  1478. C assign X to ground and 1 to VCC pin
  1479. C
  1480.       ISTATE(12) = X
  1481.       ISTATE(24) = N1
  1482. C
  1483. C print test vectors
  1484. C
  1485.       WRITE(12,60) NVECT,(ISTATE(I),I=1,24)
  1486.    60 FORMAT(' ',I2,' ',24A1)
  1487.       GO TO 90
  1488. C
  1489. C terminate the simulation
  1490. C
  1491.    95 IF(.NOT.LERR) WRITE(12,67)
  1492.    67 FORMAT(/,' PASS SIMULATION')
  1493.       IF(.NOT.LERR) WRITE(PMS,68)
  1494.    68 FORMAT(/,' PASS SIMULATION')
  1495.       CLOSE(12)
  1496.       RETURN
  1497. C
  1498. C print an error message for an undefined pin name
  1499. C
  1500.   100 ILERR = ILL+4
  1501.       WRITE(PMS,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,80)
  1502.   101 FORMAT(/,' ERROR SYMBOL = ',8A1,'       IN LINE NUMBER ',I3,
  1503.      .      /,' ',80A1,/,' THIS PIN NAME IS NOT DEFINED IN THE ',
  1504.      .      ' FUNCTION TABLE PIN LIST')
  1505.       RETURN
  1506.       END
  1507.