home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / fortran / palasm.lbr / SIMLT.FQR / SIMLT.FOR
Encoding:
Text File  |  1985-04-14  |  12.0 KB  |  311 lines
  1. C
  2. C*************************************************************************
  3. C
  4.       SUBROUTINE TEST(LPHASE,LBUF,TITLE,IC,IL,ILE,ISYM,IBUF,
  5.      C                ITYPE,INOO,LFIX)
  6.       BYTE    ISYM(8,20),ISYM1(8,20),IBUF(8,20),
  7.      C        IVECT(20),IVECTP(20),IPAGE,IDASH,L,H,X,C,Z,N0,N1,
  8.      C        IBLANK,COMENT,I6,I8,CLRS,INOO,XORSUM,
  9.      C        ISTATE(20),ISTATT(20),IPIN(20),TITLE(80)
  10.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  11.      C        LFIX,LSAME,XORFND,LERR,LPHASE(20),LPHAS1(20),LBUF(20),
  12.      C        LOUT(20),LOUTP(20),LCLOCK,LPTRST,LCTRST,LENABL(20),NREG
  13.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  14.       COMMON /PGE/ IPAGE(80,100)
  15.       COMMON /FTEST/ IFUNCT,IDESC,IEND
  16.       DATA IDASH/'-'/,L/'L'/,H/'H'/,X/'X'/,C/'C'/,Z/'Z'/,
  17.      C     N0/'0'/,N1/'1'/,
  18.      C     IBLANK/' '/,COMENT/';'/,I6/'6'/I8/'8'/,CLRS/X'0C'/
  19.       IF(IFUNCT.NE.0) GO TO 3
  20.       WRITE(1,2)
  21.     2 FORMAT(/,' FUNCTION TABLE MUST BE SUPPLIED IN ORDER TO PERFORM',
  22.      C         ' SIMULATION')
  23.       RETURN
  24.     3 WRITE(1,4)CLRS,TITLE
  25.     4 FORMAT(' ',A1,' CHECKING THE FUNCTION TABLE',80A1,/)
  26.       LERR=.FALSE.
  27.       ITRST=0
  28.       IC=0
  29.       IL=IFUNCT + 1
  30.       CALL INCR(IC,IL,LFIX)
  31.       DO 10 I=1,19
  32.       CALL GETSYM(LPHAS1,ISYM1,I,IC,IL,LFIX)
  33.          DO 5 J=1,8
  34.     5    IBUF(J,1)=ISYM1(J,I)
  35.       IF(IBUF(8,1).EQ.IDASH) GO TO 12
  36.       CALL MATCH(IMATCH,IBUF,ISYM)
  37.       IF(IMATCH.NE.0) GO TO 7
  38.       WRITE(1,6) (IBUF(J,1),J=1,8)
  39.     6 FORMAT(/,' FUNCTION TABLE PIN LIST ERROR AT', 8A1)
  40.       RETURN
  41.     7 LOUT(I)=.FALSE.
  42.       ISTATT(I)=X
  43.       IVECTP(I)=X
  44.       IF(ITYPE.NE.6) GO TO 10
  45.       IF(IMATCH.EQ.1)  ICLOCK=I
  46.       IF(IMATCH.EQ.11) ITRST=I
  47.    10 IPIN(I)=IMATCH
  48.    12 IMAX=I-1
  49.       NVECT=0
  50.    90 NVECT=NVECT+1
  51.       IC1=0
  52.       IL1=ILE
  53.    23 IF(IPAGE(1,IL).NE.COMENT) GO TO 24
  54.       IL=IL+1
  55.       GO TO 23
  56.    24 CONTINUE
  57.       DO 20 I=1,IMAX
  58.         IF(IPAGE(IC,IL).EQ.IBLANK) GO TO 21
  59.         GO TO 22
  60.    21   IC=IC+1
  61.         IF(IPAGE(IC,IL).EQ.IBLANK) GO TO 21
  62.    22   IVECT(I)=IPAGE(IC,IL)
  63.         IC=IC+1
  64.    20 CONTINUE
  65.       IL=IL+1
  66.       IC=1
  67.       IF(IVECT(1).EQ.IDASH) GO TO 95
  68.       DO 11 I=1,IMAX
  69.          IF( IVECT(I).EQ.L.OR.IVECT(I).EQ.H.OR.IVECT(I).EQ.X.OR.
  70.      C       IVECT(I).EQ.Z.OR.IVECT(I).EQ.C) GO TO 11
  71.          WRITE(1,8) IVECT(I),NVECT
  72.     8    FORMAT(/,' ',A1,' IS NOT AN ALLOWED FUNCTION TABLE ENTRY',
  73.      C                   ' IN VECTOR ',I3)
  74.          RETURN
  75.    11 CONTINUE
  76.       LCLOCK=.FALSE.
  77.       LCTRST=.TRUE.
  78.       LPTRST=.TRUE.
  79.       DO 13 I=1,IMAX
  80.    13    LENABL(I)=.TRUE.
  81.       NREG=.FALSE.
  82.       DO 15 I=1,20
  83.    15 ISTATE(I)=X
  84.       IF(ITYPE.NE.6) GO TO 25
  85.       IF(IVECT(ICLOCK).EQ.C) LCLOCK=.TRUE.
  86.       LSAME=( (     LPHASE(11)).AND.(     LPHAS1(ITRST)).OR.
  87.      C        (.NOT.LPHASE(11)).AND.(.NOT.LPHAS1(ITRST)) )
  88.       IF( IVECT(ITRST).EQ.L.AND.(.NOT.LSAME).OR.
  89.      C    IVECT(ITRST).EQ.H.AND.(     LSAME) ) LPTRST=.FALSE.
  90.       IF(LPTRST) GO TO 25
  91.       DO 46 I=1,IMAX
  92.       J=IPIN(I)
  93.          IF(J.EQ.14.OR.J.EQ.15.OR.J.EQ.16.OR.J.EQ.17) LENABL(I)=.FALSE.
  94.          IF( INOO.EQ.I6.AND.(J.EQ.13.OR.J.EQ.18) )    LENABL(I)=.FALSE.
  95.          IF( INOO.EQ.I8.AND.(J.EQ.12.OR.J.EQ.13
  96.      C                   .OR.J.EQ.18.OR.J.EQ.19) )    LENABL(I)=.FALSE.
  97.    46 CONTINUE
  98.    25 CALL INCR(IC1,IL1,LFIX)
  99.    26 CALL GETSYM(LBUF,IBUF,1,IC1,IL1,LFIX)
  100.       IF(LLEFT) GO TO 29
  101.    27 IF(.NOT.LEQUAL) GO TO 26
  102.    29 IF(LEQUAL) GO TO 35
  103.       NREG=.TRUE.
  104.    33 CALL GETSYM(LBUF,IBUF,1,IC1,IL1,LFIX)
  105.       CALL MATCH(IINP,IBUF,ISYM1)
  106.       IF(IINP.NE.0) GO TO 32
  107.       CALL MATCH(IMATCH,IBUF,ISYM)
  108.       ILL=IL1
  109.       IF( IINP.EQ.0.AND.IMATCH.NE.10.AND.IMATCH.NE.20 ) GO TO 100
  110.       IF( IMATCH.EQ.10.AND.(LBUF(1)).OR.
  111.      C    IMATCH.EQ.20.AND.(.NOT.LBUF(1)) ) LCTRST=.FALSE.
  112.       GO TO 34
  113.    32 ITEST=IVECT(IINP)
  114.       IF(  ITEST.EQ.L.AND.(     LPHAS1(IINP)).AND.(     LBUF(1))
  115.      C.OR. ITEST.EQ.H.AND.(     LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  116.      C.OR. ITEST.EQ.H.AND.(.NOT.LPHAS1(IINP)).AND.(     LBUF(1))
  117.      C.OR. ITEST.EQ.L.AND.(.NOT.LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  118.      C  )  LCTRST=.FALSE.
  119.       IF(ITEST.EQ.X.OR.ITEST.EQ.Z) LCTRST=.FALSE.
  120.    34 IF(LAND) GO TO 33
  121.       GO TO 27
  122.    35 CALL MATCH(IOUTP,IBUF,ISYM1)
  123.       ILL=IL1
  124.       IF(IOUTP.EQ.0) GO TO 100
  125.       IF(NREG) LENABL(IOUTP)=LCTRST
  126.       LOUT(IOUTP)=.TRUE.
  127.       IF( .NOT.LCTRST ) LOUT(IOUTP)=.FALSE.
  128.       LCTRST=.TRUE.
  129.       LOUTP(IOUTP)=LBUF(1)
  130.       XORSUM=H
  131.       XORFND=.FALSE.
  132.       ISUM=L
  133.    28 IPROD=H
  134.    30 ILL=IL1
  135.       CALL GETSYM(LBUF,IBUF,1,IC1,IL1,LFIX)
  136.       IF( .NOT.LFIX ) GO TO 39
  137.           LFIX=.FALSE.
  138.           CALL FIXTST(LPHAS1,LBUF,IC1,IL1,ISYM,ISYM1,IBUF,
  139.      C                IVECT,IVECTP,ITEST,LCLOCK,NREG,LFIX)
  140.           IF(IPROD.EQ.H) IPROD=ITEST
  141.           GO TO 38
  142.    39 CALL MATCH(IINP,IBUF,ISYM1)
  143.       IF(IINP.NE.0) GO TO 45
  144.       CALL MATCH(IMATCH,IBUF,ISYM)
  145.       IF(IMATCH.NE.10) GO TO 100
  146.       ITEST=L
  147.       IINP=19
  148.       LPHAS1(19)=.TRUE.
  149.       GO TO 37
  150.    45 ITEST=IVECT(IINP)
  151.       IF( (.NOT.LCLOCK).OR.(NREG) ) GO TO 37
  152.       CALL MATCH(IIFB,IBUF,ISYM)
  153.       IF( IIFB.EQ.14.OR.IIFB.EQ.15.OR.IIFB.EQ.16.OR.IIFB.EQ.17 )
  154.      C     ITEST=IVECTP(IINP)
  155.       IF( (INOO.EQ.I6.OR.INOO.EQ.I8).AND.(IIFB.EQ.13.OR.IIFB.EQ.18) )
  156.      C     ITEST=IVECTP(IINP)
  157.       IF( INOO.EQ.I8.AND.(IIFB.EQ.12.OR.IIFB.EQ.19) )
  158.      C     ITEST=IVECTP(IINP)
  159.    37 IF(  ITEST.EQ.L.AND.(     LPHAS1(IINP)).AND.(     LBUF(1))
  160.      C.OR. ITEST.EQ.H.AND.(     LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  161.      C.OR. ITEST.EQ.H.AND.(.NOT.LPHAS1(IINP)).AND.(     LBUF(1))
  162.      C.OR. ITEST.EQ.L.AND.(.NOT.LPHAS1(IINP)).AND.(.NOT.LBUF(1))
  163.      C  )  IPROD=L
  164.    38 IF(LRIGHT) CALL INCR(IC1,IL1,LFIX)
  165.       IF(LAND) GO TO 30
  166.       IF(ISUM.EQ.L.AND.IPROD.EQ.X) ISUM=X
  167.       IF( (ISUM.NE.H).AND.IPROD.EQ.H ) ISUM=H
  168.       IF(.NOT.LXOR) GO TO 31
  169.       XORSUM=ISUM
  170.       XORFND=.TRUE.
  171.       ISUM=L
  172.       GO TO 28
  173.    31 IF(LOR) GO TO 28
  174.       IF(.NOT.XORFND)    ISTATT(IOUTP)=ISUM
  175.       IF( (XORFND).AND.((ISUM.EQ.L.AND.XORSUM.EQ.L).OR.
  176.      C                  (ISUM.EQ.H.AND.XORSUM.EQ.H)) ) ISTATT(IOUTP)=L
  177.       IF( (XORFND).AND.((ISUM.EQ.H.AND.XORSUM.EQ.L).OR.
  178.      C                  (ISUM.EQ.L.AND.XORSUM.EQ.H)) ) ISTATT(IOUTP)=H
  179.       IF( (XORFND).AND. (ISUM.EQ.X.OR. XORSUM.EQ.X) )  ISTATT(IOUTP)=X
  180.       NREG=.FALSE.
  181.       IF(IDESC.NE.0.AND.IL1.LT.IFUNCT.AND.IL1.LT.IDESC.OR.
  182.      C   IDESC.EQ.0.AND.IL1.LT.IFUNCT) GO TO 27
  183.       DO 50 I=1,IMAX
  184.       IF( .NOT.LOUT(I) ) GO TO 50
  185.       IF( ISTATT(I).EQ.X.AND.IVECT(I).EQ.X ) GO TO 50
  186.       LSAME = ( (     LOUTP(I)).AND.(     LPHAS1(I)).OR.
  187.      C          (.NOT.LOUTP(I)).AND.(.NOT.LPHAS1(I)) )
  188.       IMESS=40
  189.       IF(ISTATT(I).EQ.L.AND.IVECT(I).EQ.L.AND.(.NOT.LSAME)) IMESS=41
  190.       IF(ISTATT(I).EQ.H.AND.IVECT(I).EQ.H.AND.(.NOT.LSAME)) IMESS=42
  191.       IF(ISTATT(I).EQ.L.AND.IVECT(I).EQ.H.AND.(     LSAME)) IMESS=42
  192.       IF(ISTATT(I).EQ.H.AND.IVECT(I).EQ.L.AND.(     LSAME)) IMESS=41
  193.       IF( (     LENABL(I)).AND.IVECT(I).EQ.Z )              IMESS=43
  194.       IF( (.NOT.LENABL(I)).AND.(LOUT(I)).AND.IVECT(I).NE.Z) IMESS=44
  195.       IF(IMESS.NE.40) LERR=.TRUE.
  196.       IF(IMESS.EQ.41) WRITE(1,41) NVECT,(ISYM1(J,I),J=1,8)
  197.    41 FORMAT(/,' FUNCTION TABLE ERROR AT VECTOR',I3,' PIN =',8A1,
  198.      C         '  EXPECT = H  ACTUAL = L')
  199.       IF(IMESS.EQ.42) WRITE(1,42) NVECT,(ISYM1(J,I),J=1,8)
  200.    42 FORMAT(/,' FUNCTION TABLE ERROR AT VECTOR',I3,' PIN =',8A1,
  201.      C         '  EXPECT = L  ACTUAL = H')
  202.       IF(IMESS.EQ.43) WRITE(1,43) NVECT,(ISYM1(J,I),J=1,8)
  203.    43 FORMAT(/,' FUNCTION TABLE ERROR AT VECTOR',I3,'PIN =',8A1,
  204.      C       /,'  EXPECT  = OUTPUT ENABLE ACTUAL = Z')
  205.       IF(IMESS.EQ.44) WRITE(1,44) NVECT,(ISYM1(J,I),J=1,8),IVECT(I)
  206.    44 FORMAT(/,' FUNCTION TABLE ERROR AT VECTOR',I3,'PIN =',8A1,
  207.      C         '  EXPECT = Z ACTUAL = ',A1)
  208.    50 CONTINUE
  209.       DO 65 I=1,20
  210.          DO 55 J=1,IMAX
  211.          IF(IPIN(J).NE.I) GO TO 55
  212.          IF( IVECT(J).EQ.L.OR.IVECT(J).EQ.H ) GO TO 51
  213.          ISTATE(I)=IVECT(J)
  214.          GO TO 65
  215.    51    LSAME=( (     LPHASE(I)).AND.(     LPHAS1(J)).OR.
  216.      C           (.NOT.LPHASE(I)).AND.(.NOT.LPHAS1(J)) )
  217.          IF( INOO.EQ.N1.AND.(I.EQ.15.OR.I.EQ.16) )  LOUT(J)=.TRUE.
  218.          IF( (.NOT.LOUT(J)).AND.(     LSAME).AND.
  219.      C         IVECT(J).EQ.L )                      ISTATE(I)=N0
  220.          IF( (.NOT.LOUT(J)).AND.(     LSAME).AND.
  221.      C         IVECT(J).EQ.H )                      ISTATE(I)=N1
  222.          IF( (.NOT.LOUT(J)).AND.(.NOT.LSAME).AND.
  223.      C         IVECT(J).EQ.L )                      ISTATE(I)=N1
  224.          IF( (.NOT.LOUT(J)).AND.(.NOT.LSAME).AND.
  225.      C         IVECT(J).EQ.H )                      ISTATE(I)=N0
  226.          IF( (     LOUT(J)).AND.(     LSAME).AND.
  227.      C         IVECT(J).EQ.L.AND.(     LENABL(J)) ) ISTATE(I)=L
  228.          IF( (     LOUT(J)).AND.(     LSAME).AND.
  229.      C         IVECT(J).EQ.H.AND.(     LENABL(J)) ) ISTATE(I)=H
  230.          IF( (     LOUT(J)).AND.(.NOT.LSAME).AND.
  231.      C         IVECT(J).EQ.L.AND.(     LENABL(J)) ) ISTATE(I)=H
  232.          IF( (     LOUT(J)).AND.(.NOT.LSAME).AND.
  233.      C         IVECT(J).EQ.H.AND.(     LENABL(J)) ) ISTATE(I)=L
  234.          GO TO 65
  235.    55 CONTINUE
  236.    65 IF( (LCLOCK).AND.IVECT(J).NE.Z ) IVECTP(J)=IVECT(J)
  237.       ISTATE(10)=X
  238.       ISTATE(20)=N1
  239.       WRITE(1,60) NVECT,(ISTATE(I),I=1,20)
  240.    60 FORMAT(' ',I2,' ',20A1)
  241.       GO TO 90
  242.    95 IF(.NOT.LERR) WRITE(1,67)
  243.    67 FORMAT(/,' PASS SIMULATION')
  244.       RETURN
  245.   100 ILERR=ILL+4
  246.       WRITE(1,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,79)
  247.   101 FORMAT(/,' ERROR SYMBOL = ',8A1,'     IN LINE NUMBER ',I3,
  248.      C       /,' ',80A1,/,' THIS PIN NAME IS NOT DEFINED IN THE',
  249.      C                    ' FUNCTION TABLE PIN LIST')
  250.       RETURN
  251.       END
  252. C
  253. C******************************************************************************
  254. C
  255.       SUBROUTINE FIXTST(LPHAS1,LBUF,IC1,IL1,ISYM,ISYM1,IBUF,
  256.      C                  IVECT,IVECTP,ITEST,LCLOCK,NREG,LFIX)
  257.       BYTE    ISYM(8,20),ISYM1(8,20),IBUF(8,20),IVECT(20),IVECTP(20),
  258.      C        IPAGE,L,H,X,Z
  259.       LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
  260.      C        LFIX,LPHAS1(20),LBUF(20),LCLOCK,NREG,TOR,TXOR,TXNOR,TAND,
  261.      C        LPHASA,LPHASB
  262.       COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
  263.       COMMON /PGE/ IPAGE(80,100)
  264.       DATA L/'L'/,H/'H'/,X/'X'/,Z/'Z'/
  265.       CALL GETSYM(LBUF,IBUF,1,IC1,IL1,LFIX)
  266.       CALL MATCH(IINP,IBUF,ISYM1)
  267.       ITESTA=IVECT(IINP)
  268.       LPHASA = ( (     LBUF(1)).AND.(     LPHAS1(IINP)).OR.
  269.      C           (.NOT.LBUF(1)).AND.(.NOT.LPHAS1(IINP)) )
  270.       IF( (.NOT.LCLOCK).OR.(NREG) ) GO TO 5
  271.       CALL MATCH(IIFB,IBUF,ISYM)
  272.       IF( IIFB.EQ.14.OR.IIFB.EQ.15.OR.IIFB.EQ.16.OR.IIFB.EQ.17 )
  273.      C    ITESTA=IVECTP(IINP)
  274.     5 IF( (.NOT.LPHASA).AND.ITESTA.EQ.L ) GO TO 10
  275.       IF( (.NOT.LPHASA).AND.ITESTA.EQ.H ) GO TO 15
  276.       GO TO 20
  277.    10 ITESTA=H
  278.       GO TO 20
  279.    15 ITESTA=L
  280.    20 IF( .NOT.LRIGHT ) GO TO 25
  281.            ITEST=ITESTA
  282.            RETURN
  283.    25 TOR   = (LOR.AND.(.NOT.LXOR))
  284.       TXOR  = (LXOR)
  285.       TXNOR = (LXNOR)
  286.       TAND  = (LAND.AND.(.NOT.LXNOR))
  287.       CALL GETSYM(LBUF,IBUF,1,IC1,IL1,LFIX)
  288.       CALL MATCH(IINP,IBUF,ISYM1)
  289.       ITESTB=IVECT(IINP)
  290.       LPHASB = ( (     LBUF(1)).AND.(     LPHAS1(IINP)).OR.
  291.      C           (.NOT.LBUF(1)).AND.(.NOT.LPHAS1(IINP)) )
  292.       IF( (.NOT.LPHASB).AND.ITESTB.EQ.L ) GO TO 30
  293.       IF( (.NOT.LPHASB).AND.ITESTB.EQ.H ) GO TO 35
  294.       GO TO 40
  295.    30 ITESTB=H
  296.       GO TO 40
  297.    35 ITESTB=L
  298.    40 ITEST=L
  299.       IF(   (TOR).AND.(ITESTA.EQ.H.OR. ITESTB.EQ.H) )      ITEST=H
  300.       IF(  (TXOR).AND.((ITESTA.EQ.H.AND.ITESTB.NE.H).OR.
  301.      C                 (ITESTA.NE.H.AND.ITESTB.EQ.H) ))    ITEST=H
  302.       IF( (TXNOR).AND.((ITESTA.EQ.ITESTB).OR.
  303.      C                 (ITESTA.EQ.X.OR.ITESTB.EQ.X) ))     ITEST=H
  304.       IF(  (TAND).AND.(ITESTA.NE.L.AND.ITESTB.NE.L) )      ITEST=H
  305.       IF( (ITESTA.EQ.X.OR.ITESTA.EQ.Z).AND.(ITESTB.EQ.X) ) ITEST=X
  306.       RETURN
  307.       END
  308. C
  309. C***************************************************************************
  310. C
  311.