C***PLEASM**PLEASM**PLEASM**PLEASM***PLEASM**PLEASM**PLEASM**PLEASM***
C
C   P L E A S M   - -   TRANSLATES SYMBOLIC EQUATIONS INTO PROM OBJECT
C                       CODE FORMATTED FOR DIRECT INPUT TO STANDARD
C                       PROM PROGRAMMERS.
C
C                       INPUT:       THE PROM DESIGN SPECIFICATION IS
C                                    ASSIGNED TO RPD(1).  OPERATION
C                                    CODES ARE ASSIGNED TO ROP(5).
C
C                       OUTPUT:      ECHO, SIMULATION, AND TRUTH TABLES
C                                    ARE ASSIGNED TO POF(6).  HEX AND
C                                    BINARY PROGRAMMING FORMATS ARE
C                                    ASSIGNED TO PDF(6).  PROMPTS AND
C                                    ERROR MESSAGES ARE ASSIGNED TO
C                                    PMS(6).
C
C                       PART NUMBER: THE PROM PART NUMBER MUST APPEAR
C                                    IN COLUMN ONE OF LINE ONE IN THE
C                                    MEMORY ORGANIZATION FORM,
C                                        I.E. PROM32X8
C
C                       PIN          24 SYMBOLIC PIN NAMES MUST APPEAR
C                       ASSIGNMENTS: STARTING ON LINE FIVE.
C
C                       EQUATIONS:   STARTING FIRST LINE AFTER THE
C                                    PIN LIST IN THE FOLLOWING FORMS:
C
C                                       A = E*F + G
C
C                                       B := H*/I + /J*K
C
C                                       C = L + M :+: N
C
C                                       D = (O:*:P) + /Q
C
C                                    ALL CHARACTERS FOLLOWING ';' ARE
C                                    IGNORED UNTIL THE NEXT LINE.
C
C                                    BLANKS ARE IGNORED.
C
C                       OPERATORS:   ( IN HIERARCHY OF EVALUATION )
C
C                                     ;    COMMENT FOLLOWS
C                                     .    MACRO DEFINITION FOLLOWS
C                                     /    COMPLEMENT
C                                     *    AND (PRODUCT)
C                                     +    OR (SUM)
C                                    :+:   XOR (EXCLUSIVE OR)
C                                    :*:   XNOR (EXCLUSIVE NOR)
C                                    ( )   FIXED SYMBOL
C                                     =    EQUALITY
C                                    :=    REPLACED BY (AFTER CLOCK)
C
C                       FUNCTION     L AND H ARE VALID FUNCTION
C                         TABLE:     TABLE VECTOR ENTRIES.
C
C                       REFERENCE:   A COMPLETE USERS GUIDE FOR
C                                    DESIGNING PROMS USING PLEASM WILL
C                                    BE PROVIDED IN THE MONOLITHIC
C                                    MEMORIES PROM HANDBOOK.
C
C                       SUBROUTINES: GETSYM,INCR,MATCH,SIM,BINC,HEXBC,
C                                    HEXDC,DECC,ADCON,ECHO,FUNCT,
C                                    TRUTH,CAT,HEX,BINR,IODC2,IODC4
C
C                       REV LEVEL:   VERSION 1.0  (05/20/82)
C
C                       AUTHOR:      VINCENT J. COLI
C                                    MONOLITHIC MEMORIES INC.
C                                    1165 EAST ARQUES AVENUE
C                                    SUNNYVALE, CALIFORNIA 94043
C                                    (408) 739-3535
C
C                       FINE PRINT:  MONOLITHIC MEMORIES TAKES NO
C                                    RESPONSIBILITY FOR THE OPERATION
C                                    OR MAINTENANCE OF THIS PROGRAM.
C                                    THE SOURCE CODE AS PRINTED HERE
C                                    PRODUCED THE OBJECT CODE OF THE
C                                    EXAMPLES IN THE APPLICATIONS
C                                    SECTION ON A VAX/VMS 11/780
C                                    COMPUTER WITH FORTRAN 77 AND A
C                                    NATIONAL CSS IBM SYSTEM/370
C                                    WITH FORTRAN IV (LEVEL G).
C
C***********************************************************************
C
C
C***********************************************************************
C
C
C     MAIN PROGRAM
C
      IMPLICIT INTEGER (A-Z)
      INTEGER CWORD(5),CTWORD(4,12),CWIDE(2),CTWIDE(10),CSYM(8,24),
     1        CBUF(8,24),CMACRO(8,24),DAT(16),BADD(12)
      LOGICAL LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ,LPHASE(24),LMACRO(24)
      COMMON  LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
      COMMON /ILINE/ ILEQ,IFUNCT,IDESC,IEND
      DATA CA/'A'/,CB/'B'/,CC/'C'/,CD/'D'/,CE/'E'/,CF/'F'/,CH/'H'/,
     1     CI/'I'/,CL/'L'/,CN/'N'/,CO/'O'/,CP/'P'/,CQ/'Q'/,CR/'R'/,
     2     CS/'S'/,CT/'T'/,CU/'U'/,CX/'X'/,C0/'0'/,C1/'1'/,C2/'2'/,
     3     C3/'3'/,C4/'4'/,C5/'5'/,C6/'6'/,C7/'7'/,C8/'8'/,C9/'9'/,
     4     CLO/'L'/,CHI/'H'/
      DATA CTWORD/'2',' ',' ',' ', '4',' ',' ',' ',
     2            '8',' ',' ',' ', '1','6',' ',' ',
     3            '3','2',' ',' ', '6','4',' ',' ',
     4            '1','2','8',' ', '2','5','6',' ',
     5            '5','1','2',' ', '1','0','2','4',
     6            '2','0','4','8', '4','0','9','6'/
     7     CTWIDE/'0','1','2','3', '4','5','6','7','8','9'/
C
C
C     PRINT PLEASM VERSION (CVER) AND REVISION LEVEL (CREV)
      DATA CVER/'1'/,CREV/'0'/
      WRITE(6,1) CVER,CREV
    1 FORMAT(/,' MONOLITHIC MEMORIES PLEASM VERSION ',1A1,'.',1A1)
C
C     ASSIGNMENT OF DATA SET REFERENCES
C     RPD - PROM DESIGN SPECIFICATION (INPUT FROM DATA FILE)
C     ROC - OPERATION CODE (INPUT FROM TERMINAL)
C     POF - ECHO, SIMULATION AND TRUTH TABLES (OUTPUT)
C     PDF - HEX AND BINARY PROGRAMMING FORMATS (OUTPUT)
C     PMS - PROMPTS AND ERROR MESSAGES (OUTPUT TO TERMINAL)
      WRITE(6,2)
    2 FORMAT(/,' WHAT IS THE LOGICAL UNIT NUMBER FOR OUTPUT(6)?: '$)
      READ(5,3) ILUN
    3 FORMAT(I4)
      RPD=1
      ROC=5
      POF=ILUN
      PDF=ILUN
      PMS=ILUN
      IFUNCT=0
      IDESC=0
C     READ IN PROM DESIGN SPECIFICATION
      DO 10 IL=1,200
          READ(RPD,5,END=15) (CPAGE(IC,IL),IC=1,80)
    5     FORMAT(80A1)
C     CHECK FOR 'FUNCTION TABLE' AND SAVE ITS LINE NUMBER
      IF(     IFUNCT.EQ.0 .AND.CPAGE(1,IL).EQ.CF.AND.
     1    CPAGE(2,IL).EQ.CU.AND.CPAGE(3,IL).EQ.CN.AND.
     2    CPAGE(4,IL).EQ.CC.AND.CPAGE(5,IL).EQ.CT.AND.
     3    CPAGE(6,IL).EQ.CI.AND.CPAGE(7,IL).EQ.CO.AND.
     4    CPAGE(8,IL).EQ.CN.AND.CPAGE(10,IL).EQ.CT.AND.
     5    CPAGE(12,IL).EQ.CB.AND.CPAGE(14,IL).EQ.CE ) IFUNCT=IL
C     CHECK FOR 'DESCRIPTION' AND SAVE ITS LINE NUMBER
      IF(      IDESC.EQ.0 .AND.CPAGE(1,IL).EQ.CD.AND.
     1    CPAGE(2,IL).EQ.CE.AND.CPAGE(3,IL).EQ.CS.AND.
     2    CPAGE(4,IL).EQ.CC.AND.CPAGE(5,IL).EQ.CR.AND.
     3    CPAGE(6,IL).EQ.CI.AND.CPAGE(7,IL).EQ.CP.AND.
     4    CPAGE(8,IL).EQ.CT.AND.CPAGE(9,IL).EQ.CI.AND.
     5    CPAGE(10,IL).EQ.CO.AND.CPAGE(11,IL).EQ.CN ) IDESC=IL
   10 CONTINUE
C     SAVE THE LAST LINE NUMBER OF THE PROM DESIGN SPECIFICATION
   15 IEND=IL-1
C     DETERMINE PROM ORGANIZATION (NO. OF ADDRESSES,X,NO. OF DATA)
      IC=0
   20 IC=IC+1
      A=CPAGE(IC,1)
      IF( (.NOT.(A.EQ.C0.OR.A.EQ.C1.OR.A.EQ.C2.OR.A.EQ.C3.OR.
     1           A.EQ.C4.OR.A.EQ.C5.OR.A.EQ.C6.OR.A.EQ.C7.OR.
     2           A.EQ.C8.OR.A.EQ.C9)).AND.IC.LT.78 ) GO TO 20
      IF(IC.LT.78) GO TO 30
      WRITE(PMS,25) (CPAGE(IC,1),IC=1,80)
   25 FORMAT(/,' INVALID PROM ORGANIZATION',/,' ',80A1)
      CALL EXIT
C     READ NUMBER OF ADDRESSES AND DECODE MAXIUM NUMBER OF INPUTS
   30 NWORD=0
      NWIDE=0
      J=0
   35 J=J+1
      CWORD(J)=CPAGE(IC,1)
      IC=IC+1
      IF(.NOT.(CPAGE(IC,1).EQ.CX) ) GO TO 35
      DO 45 I=1,12
          LMATCH=.TRUE.
          DO 40 JJ=1,J
   40         LMATCH=LMATCH.AND.(CWORD(JJ).EQ.CTWORD(JJ,I))
          IF(LMATCH.AND.NWORD.EQ.0) NWORD=I
   45 CONTINUE
C     READ WIDTH OF EACH WORD AND CONVERT IT TO AN INTEGER
      CWIDE(1)=CPAGE(IC+1,1)
      CWIDE(2)=CPAGE(IC+2,1)
      DO 50 I=1,9
   50     IF( CWIDE(1).EQ.CTWIDE(I) ) NWIDE=I-1
      DO 55 I=1,3
   55     IF( CWIDE(2).EQ.CTWIDE(I) ) NWIDE=10+I-1
      IF(NWORD.NE.0.AND.NWIDE.NE.0.AND.NWIDE.LE.12) GO TO 65
      WRITE(PMS,60) CWORD,CWIDE
   60 FORMAT(/,' ',4A1,'X',2A1,
     1      ' PROM ORGANIZATION IS NOT SUPPORTED BY PLEASM')
      CALL EXIT
C     GET ADDRESS PIN NAMES FOLLOWING .ADDRESS (MAXIUM OF 12 ALLOWED)
   65 IC=0
      IL=5
   70 CALL INCR(IC,IL)
      IF(.NOT.LDOT) GO TO 70
      CALL GETSYM(LMACRO,CMACRO,1,IC,IL)
      DO 75 I=1,NWORD
          CALL GETSYM(LPHASE,CSYM,I,IC,IL)
          UWORD=I
          IF(LDOT) GO TO 80
   75 CONTINUE
C     GET DATA PIN NAMES FOLLOWING .DATA (MAXIUM OF 12 ALLOWED)
   80 CALL GETSYM(LMACRO,CMACRO,1,IC,IL)
      DO 85 I=1,NWIDE
          J=I+12
          CALL GETSYM(LPHASE,CSYM,J,IC,IL)
          IF( LDOT.OR.LEQUAL.OR.LREQ ) GO TO 90
          UWIDE=I
   85 CONTINUE
   90 ILEQ=IL
   95 WRITE(6,100)
  100 FORMAT(/,' OPERATION CODES:')
      WRITE(6,105)
  105 FORMAT(/,' E=ECHO INPUT  S=SIMULATE  T=TRUTH TABLE  B=BRIEF  ',
     1 'A=ADDRESS',/,' H=HEX  I=SHORT  L=BHLF  N=BNPF  C=CATALOG  ',
     2 'Q=QUIT')
      WRITE(6,110)
  110 FORMAT(/,' ENTER OPERATION CODE: ',$)
      READ(ROC,115) COP
  115 FORMAT(A1)
C     INITIALIZE BINARY ADDRESS (BADD) TO ZERO
      DO 120 I=1,12
          BADD(I)=CLO
  120 CONTINUE
C     CALL IODC2
      IF(POF.NE.6) WRITE(POF,125)
  125 FORMAT('1')
      IF(COP.EQ.CE) CALL ECHO
      IF(COP.EQ.CS) CALL FUNCT
      IF(COP.EQ.CT) CALL TRUTH(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CT)
      IF(COP.EQ.CB) CALL TRUTH(UWORD,UWIDE,BADD,LPHASE,CSYM,CBUF,CB)
      IF(COP.EQ.CA) CALL TRUTH(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CA)
      IF(COP.EQ.CH) CALL HEX(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CH)
      IF(COP.EQ.CI) CALL HEX(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CI)
      IF(COP.EQ.CL) CALL BINR(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CH,CL)
      IF(COP.EQ.CN) CALL BINR(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,CP,CN)
      IF(COP.EQ.CC) CALL CAT(CVER,CREV)
C     CALL IODC4
      IF(COP.NE.CQ) GO TO 95
      CALL EXIT
      END
C
C***********************************************************************
C
      SUBROUTINE GETSYM(LPHASE,CSYM,J,IC,IL)
C     THIS SUBROUTINE GETS THE PIN NAME, / IF COMPLEMENT LOGIC, AND
C      THE FOLLOWING OPERATOR IF ANY
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24)
      LOGICAL LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ,LPHASE(24)
      COMMON  LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ
      COMMON /PDS/ CPAGE(80,200)
      DATA CBLANK/' '/
      IF( .NOT.(LDOT.OR.LAND.OR.LOR.OR.LXOR.OR.LXNOR.OR.LLEFT.OR.
     1          LRIGHT.OR.LEQUAL.OR.LREQ) ) GO TO 10
      CALL INCR(IC,IL)
   10 LPHASE(J)=( .NOT.LSLASH )
      IF( .NOT.LPHASE(J) ) CALL INCR(IC,IL)
      DO 20 I=1,8
   20     CSYM(I,J)=CBLANK
   25 DO 30 I=1,7
   30     CSYM(I,J)=CSYM(I+1,J)
      CSYM(8,J)=CPAGE(IC,IL)
      CALL INCR(IC,IL)
      IF( LBLANK.OR.LDOT.OR.LAND.OR.LOR.OR.LXOR.OR.LXNOR.OR.
     1    LLEFT.OR.LRIGHT.OR.LEQUAL.OR.LREQ ) RETURN
      GO TO 25
      END
C
C**********************************************************************
C
      SUBROUTINE INCR(IC,IL)
C     THIS SUBROUTINE INCREMENTS COLUMN AND LINE POINTERS
C      BLANKS AND CHARACTERS AFTER ';' ARE IGNORED
      IMPLICIT INTEGER (A-Z)
      LOGICAL LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ
      COMMON  LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
C     CHANGE THIS DATA STATMENT IF AN ALTERNATE SET OF OPERATORS IS
C      DESIRED
      DATA CBLANK/' '/,COMENT/';'/,CDOT/'.'/,CSLASH/'/'/,CAND/'*'/,
     1     COR/'+'/,COLON/':'/,CLEFT/'('/,CRIGHT/')'/,CEQUAL/'='/
      LBLANK=.FALSE.
    5 IC=IC+1
      IF( IC.LE.79.AND.CPAGE(IC,IL).NE.COMENT ) GO TO 20
      IL=IL+1
      IF(IL.LE.200) GO TO 15
          WRITE(PMS,10)
   10     FORMAT(/,' SOURCE FILE EXCEEDS 200 LINES OR MISSING',
     1             ' DESCRIPTION OR FUNCTION TABLE KEY WORD')
          CALL EXIT
   15 IC=0
      GO TO 5
   20 IF(CPAGE(IC,IL).NE.CBLANK) GO TO 25
      LBLANK= .TRUE.
      GO TO 5
   25 LXOR  = .FALSE.
      LXNOR = .FALSE.
      LREQ  = .FALSE.
      IF(CPAGE(IC,IL).NE.COLON) GO TO 30
      IC=IC+1
      LXOR  =( CPAGE(IC,IL).EQ. COR   )
      LXNOR =( CPAGE(IC,IL).EQ. CAND  )
      LREQ  =( CPAGE(IC,IL).EQ.CEQUAL )
      IF( (LXOR.OR.LXNOR) ) IC=IC+1
   30 LDOT  =( CPAGE(IC,IL).EQ. CDOT  )
      LSLASH=( CPAGE(IC,IL).EQ.CSLASH )
      LAND  =( CPAGE(IC,IL).EQ. CAND  )
      LOR   =( CPAGE(IC,IL).EQ. COR   )
      LLEFT =( CPAGE(IC,IL).EQ.CLEFT  )
      LRIGHT=( CPAGE(IC,IL).EQ.CRIGHT )
      LEQUAL=( CPAGE(IC,IL).EQ.CEQUAL )
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE MATCH(CSYM,CBUF,IMATCH)
C     THIS SUBROUTINE FINDS A MATCH BETWEEN THE PIN NAME IN THE EQUATION
C      AND THE PIN NAME IN THE PIN LIST OR FUNCTION TABLE PIN LIST
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24),CBUF(8,24)
      LOGICAL LMATCH
      IMATCH=0
      DO 20 J=1,24
          LMATCH=.TRUE.
          DO 10 I=1,8
   10         LMATCH=LMATCH.AND.(CSYM(I,J).EQ.CBUF(I,1))
          IF(LMATCH) IMATCH=J
   20     CONTINUE
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE SIM(NWIDE,BADD,BDAT,CSYM,CBUF,LPHASE)
C     THIS SUBROUTINE PERFORMS BOOLEAN ALGEBRA ON THE LOGIC EQUATIONS
C      GIVEN A BINARY ADDRESS (BADD) AS INPUT, IT WILL GENERATE BINARY
C      DATA (BDAT) AS OUTPUT.
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24),CBUF(8,24),BADD(12),BDAT(12)
      LOGICAL LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ,LMATCH,LPHASE(24),LBUF(24),LDAT,LADD
      COMMON  LBLANK,LDOT,LSLASH,LAND,LOR,LXOR,LXNOR,LLEFT,LRIGHT,
     1        LEQUAL,LREQ
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
      COMMON /ILINE/ ILEQ,IFUNCT,IDESC,IEND
      DATA CLO/'L'/,CHI/'H'/
      IC=0
      IL=ILEQ
      DO 5 I=1,NWIDE
    5 BDAT(I)=CLO
      CALL INCR(IC,IL)
   10 CALL GETSYM(LBUF,CBUF,1,IC,IL)
   15 IF(.NOT.LEQUAL) GO TO 10
      CALL MATCH(CSYM,CBUF,NDAT)
      LOUT=( (     LPHASE(NDAT)).AND.(     LBUF(1)).OR.
     1       (.NOT.LPHASE(NDAT)).AND.(.NOT.LBUF(1)) )
      SUM=CLO
   20 PROD=CHI
   25 CALL GETSYM(LBUF,CBUF,1,IC,IL)
      CALL MATCH(CSYM,CBUF,NADD)
      LADD=( (     LPHASE(NADD)).AND.(     LBUF(1)).OR.
     1       (.NOT.LPHASE(NADD)).AND.(.NOT.LBUF(1)) )
      IF( BADD(NADD).EQ.CLO.AND.(     LADD) ) TEMP=CLO
      IF( BADD(NADD).EQ.CHI.AND.(     LADD) ) TEMP=CHI
      IF( BADD(NADD).EQ.CLO.AND.(.NOT.LADD) ) TEMP=CHI
      IF( BADD(NADD).EQ.CHI.AND.(.NOT.LADD) ) TEMP=CLO
      IF(TEMP.EQ.CLO) PROD=CLO
      IF(LAND) GO TO 25
      IF(PROD.EQ.CHI) SUM=CHI
      IF(LOR) GO TO 20
      BDAT(NDAT-12)=SUM
      IF( SUM.EQ.CLO.AND.(.NOT.LOUT) ) BDAT(NDAT-12)=CHI
      IF( SUM.EQ.CHI.AND.(.NOT.LOUT) ) BDAT(NDAT-12)=CLO
      IF(LEQUAL) GO TO 15
      IF( (IL.LT.IFUNCT.AND.IFUNCT.NE.0).OR.
     1    (IL.LT.IDESC.AND.IFUNCT.EQ.0) ) GO TO 15
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE BINC(BADD)
C     THIS SUBROUTINE COUNTS IN BINARY (BADD) TO GENERATE THE NEXT ADDRESS
      IMPLICIT INTEGER (A-Z)
      INTEGER BADD(12)
      DATA CLO/'L'/,CHI/'H'/
      I=0
    5 I=I+1
      IF( BADD(I).EQ.CHI ) GO TO 5
      BADD(I)=CHI
   10 I=I-1
      IF(I.EQ.0) RETURN
      BADD(I)=CLO
      GO TO 10
      END

C
C***********************************************************************
C
      SUBROUTINE HEXBC(N,BIT,ZHEX)
C     THIS SUBROUTINE CONVERTS BINARY BITS INTO HEX NUMBERS
      IMPLICIT INTEGER (A-Z)
      INTEGER ZTABLE(16),BIT(12),ZHEX(4)
      DATA CHI/'H'/,ZTABLE/'0','1','2','3','4','5','6','7',
     1                     '8','9','A','B','C','D','E','F'/
      DO 5 I=1,2
    5     ZHEX(I+1)=ZTABLE(1)
      J=0
      DO 10 I=1,N,4
          J=J+1
          IHEX=0
          IF( BIT(I + 0).EQ.CHI ) IHEX=IHEX+1
          IF( BIT(I + 1).EQ.CHI ) IHEX=IHEX+2
          IF( BIT(I + 2).EQ.CHI ) IHEX=IHEX+4
          IF( BIT(I + 3).EQ.CHI ) IHEX=IHEX+8
          ZHEX(J)=ZTABLE(IHEX+1)
   10 CONTINUE
C      WRITE(6,123) N,BIT,ZHEX
C  123 FORMAT(' N = ',I3,' BIT = ',12A1,' ZHEX = ',4A1)
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE HEXDC(DEC,ZHEX)
C     THIS SUBROUTINE CONVERTS DECIMAL NUMBERS INTO HEX NUMBERS
      IMPLICIT INTEGER (A-Z)
      INTEGER ZTABLE(16),ZHEX(5)
      DATA ZTABLE/'0','1','2','3','4','5','6','7',
     1            '8','9','A','B','C','D','E','F'/
      DO 5 I=1,5
          ZTEMP=DEC-16*(DEC/16)
          ZHEX(6-I)=ZTABLE(ZTEMP+1)
          DEC=DEC/16
    5 CONTINUE
      RETURN
      END
C
C***********************************************************************
C
      FUNCTION DECC(N,BIT)
C     THIS SUBFUNCTION CONVERTS BINARY BITS INTO DECIMAL NUMBERS
      IMPLICIT INTEGER (A-Z)
      INTEGER BIT(12)
      DATA CHI/'H'/
      DECC=0
      DO 5 I=1,N
          DTEMP=0
          IF(BIT(I).EQ.CHI) DTEMP=2**(I-1)
          DECC=DECC+DTEMP
    5 CONTINUE
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE ADCON(INT,CHAR)
C     THIS SUBROUTINE CONVERTS AN INTEGER (INT) INTO A CHARACTER (CHAR)
      DATA C0/'0'/,C1/'1'/,C2/'2'/,C3/'3'/,C4/'4'/,
     1     C5/'5'/,C6/'6'/,C7/'7'/,C8/'8'/,C9/'9'/
      IF(INT.EQ.0) CHAR=C0
      IF(INT.EQ.1) CHAR=C1
      IF(INT.EQ.2) CHAR=C2
      IF(INT.EQ.3) CHAR=C3
      IF(INT.EQ.4) CHAR=C4
      IF(INT.EQ.5) CHAR=C5
      IF(INT.EQ.6) CHAR=C6
      IF(INT.EQ.7) CHAR=C7
      IF(INT.EQ.8) CHAR=C8
      IF(INT.EQ.9) CHAR=C9
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE ECHO
C     THIS SUBROUTINE PRINTS THE PROM DESIGN SPECIFICATION INPUT FILE
      IMPLICIT INTEGER (A-Z)
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
      COMMON /ILINE/ ILEQ,IFUNCT,IDESC,IEND
      DATA CBLANK/' '/
      DO 15 IL=1,IEND
          IC=81
    5     IC=IC-1
          IF( CPAGE(IC,IL).EQ.CBLANK.AND.IC.GT.1 ) GO TO 5
          WRITE(POF,10) (CPAGE(I,IL),I=1,IC)
   10     FORMAT(' ',80A1)
   15 CONTINUE
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE FUNCT
C     THIS SUBROUTINE PERFORMS THE SIMULATION
      IMPLICIT INTEGER (A-Z)
      LOGICAL LERR
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
      COMMON /ILINE/ ILEQ,IFUNCT,IDESC,IEND
      DATA CBLANK/' '/
      IF(IFUNCT.NE.0) GO TO 10
      WRITE(PMS,5)
    5 FORMAT(/,' FUNCTION TABLE MUST BE SUPPLIED IN ORDER TO PERFORM',
     1         ' SIMULATION')
      RETURN
   10 LERR=.FALSE.
      ILE=IDESC-1
      IF(ILE.LT.IFUNCT) ILE=IEND
      DO 25 IL=IFUNCT,ILE
          IC=81
   15     IC=IC-1
          IF( CPAGE(IC,IL).EQ.CBLANK.AND.IC.GT.1 ) GO TO 15
          WRITE(POF,20) (CPAGE(I,IL),I=1,IC)
   20     FORMAT(' ',80A1)
   25 CONTINUE
      IF(.NOT.LERR) WRITE(POF,30)
   30 FORMAT(' PASS SIMULATION')
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE TRUTH(IWORD,IWIDE,BADD,LPHASE,CSYM,CBUF,COP)
C     THIS SUBROUTINE GENERATES THE PROM TRUTH TABLE
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24),CBUF(8,24),BADD(12),BDAT(12),ZTEMP(4),
     1        ZCSUM(5),CLINE(76)
      LOGICAL LPHASE(24)
      COMMON /PDS/ CPAGE(80,200)
      COMMON /LUNIT/ PMS,POF,PDF
      COMMON /ILINE/ ILEQ,IFUNCT,IDESC,IEND
      DATA CBLANK/' '/,CDASH/'-'/,CA/'A'/,CB/'B'/,CD/'D'/,CO/'O'/,
     1     CT/'T'/
      NADD=2**IWORD
      ILE=ILEQ-1
      DO 5 I=1,75
    5     CLINE(I)=CBLANK
      DO 20 IL=3,ILE
          IF(IL.EQ.4) GO TO 20
          IC=81
   10     IC=IC-1
          IF( CPAGE(IC,IL).EQ.CBLANK.AND.IC.GT.1 ) GO TO 10
          WRITE(POF,15) (CPAGE(I,IL),I=1,IC)
   15     FORMAT(' ',80A1)
   20 CONTINUE
      N = 8 + 3*(IWORD+IWIDE)
      IF(COP.EQ.CA) N = 17
      CLINE(2)=CA
      CLINE(3)=CD
      CLINE(4)=CD
      J=6
      DO 25 I=1,IWORD
          J=J+2
          CLINE(J)=CA
          J=J+1
          INT=I-1
          CALL ADCON(INT,CHAR)
          CLINE(J)=CHAR
   25 CONTINUE
      J=J+1
      DO 30 I=1,IWIDE
          J=J+2
          CLINE(J)=CO
          J=J+1
          INT=I
          CALL ADCON(INT,CHAR)
          CLINE(J)=CHAR
   30 CONTINUE
      WRITE(POF,35) (CLINE(I),I=1,J)
   35 FORMAT(' ',80A1)
      DO 40 I=1,75
   40     CLINE(I)=CBLANK
      WRITE(POF,45) (CDASH,I=1,N)
   45 FORMAT(' ',80A1)
      DO 65 IADD=1,NADD
          IAD=IADD-1
          CALL SIM(IWIDE,BADD,BDAT,CSYM,CBUF,LPHASE)
          CALL HEXBC(IWIDE,BDAT,ZTEMP)
          CSUM=CSUM+DECC(IWIDE,BDAT)
          J=1
          DO 50 I=1,IWORD
              J=J+3
              CLINE(J)=BADD(I)
   50     CONTINUE
          J=J+1
          DO 55 I=1,IWIDE
              J=J+3
              CLINE(J)=BDAT(I)
   55     CONTINUE
          WRITE(POF,60) IAD,(CLINE(I),I=1,J)
   60     FORMAT(' ',I4,76A1)
          CALL BINC(BADD)
   65 CONTINUE
      WRITE(POF,45) (CDASH,I=1,N)
      CALL HEXDC(CSUM,ZCSUM)
      WRITE(POF,70) ZCSUM
   70 FORMAT(/,' HEX CHECK SUM = ',5A1)
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE CAT(CVER,CREV)
C     THIS SUBROUTINE PRINTS THE PLEASM CATALOG
      IMPLICIT INTEGER (A-Z)
      COMMON /LUNIT/ PMS,POF,PDF
      WRITE(POF,5) CVER,CREV
    5 FORMAT(/,' MONOLITHIC MEMORIES PLEASM VERSION ',1A1,'.',1A1)
      WRITE(POF,10)
   10 FORMAT(/,' THIS PLEASM AIDS THE USER IN THE DESIGN AND',
     1         ' PROGRAMMING OF THE',/,' PROMS.  THE',
     2         ' FOLLOWING OPTIONS ARE PROVIDED:',
     3      //,'    ECHO (E)        - PRINTS THE PROM DESIGN', 
     4         ' SPECIFICATION',
     5      //,'    SIMULATE (S)    - EXERCISES THE FUNCTION TABLE',
     6         ' VECTORS IN THE',/,' ',21X,'LOGIC EQUATIONS',
     7      //,'    TRUTH TABLE (T) - PRINTS THE ENTIRE TRUTH TABLE')
      WRITE(POF,15)
   15 FORMAT(/,'    BRIEF (B)       - PRINTS ONLY USED ADDRESSES',
     1      //,'    HEX ADDRESS (A) - PRINTS HEX ADDRESSES',
     2      //,'    HEX (H)',9X,'- GENERATES HEX PROGRAMMING FORMAT',
     3      //,'    SHORT (I)',7X,'- GENERATES HEX PROGRAMMING FORMAT',
     4      //,'    BHLF (L)',8X,'- GENERATES BHLF PROGRAMMING FORMAT',
     5      //,'    BNPF (N)',8X,'- GENERATES BNPF PROGRAMMING FORMAT',
     6      //,'    CATALOG (C)     - PRINTS THE PLEASM CATALOG',
     7      //,'    QUIT (Q)        - EXIT PLEASM')
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE HEX(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,COP)
C     THIS SUBROUTINE GENERATES HEX PROGRAMMING FORMATS AND CHECK SUM
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24),CBUF(8,24),BADD(12),BDAT(12),ZTEMP(4),
     1        ZHEX(2,32),ZCSUM(5)
      LOGICAL LPHASE(24)
      CHARACTER SOH,STX,ETX,BEL
      COMMON /LUNIT/PMS,POF,PDF
      DATA CH/'H'/,CI/'I'/
      DATA SOH/001/,STX/002/,ETX/003/,BEL/007/
      NADD=2**NWORD
      IF( NWORD.GE.5.AND.(NWIDE.EQ.4.OR.NWIDE.EQ.8) ) GO TO 10
          WRITE(PMS,5) NADD,NWIDE
    5     FORMAT(/,' PLEASM DOES NOT SUPPLY HEX PROGRAMMING',
     1             ' FORMAT',I4,' BY ',I2,' PROMS')
          RETURN
   10 CSUM=0
      IF(COP.EQ.CH) WRITE(PDF,15)
   15 FORMAT(//,'                                         .',//)
C***** NOTE: SOME PROM PROGRAMMERS NEED A START CHARACTER.
C***** MODIFY OR DELETE THESE START CHARACTERS AS REQUIRED.
      WRITE(PDF,20) BEL,BEL,BEL,STX,SOH
   20 FORMAT(' ',5A1)
      DO 50 IADD=1,NADD,32
          DO 25 J=1,32
              ADD=IADD+J-2
              CALL SIM(NWIDE,BADD,BDAT,CSYM,CBUF,LPHASE)
              CALL HEXBC(NWIDE,BDAT,ZTEMP)
              ZHEX(1,J)=ZTEMP(1)
              ZHEX(2,J)=ZTEMP(2)
              CSUM=CSUM+DECC(NWIDE,BDAT)
              CALL BINC(BADD)
   25     CONTINUE
          IF(COP.EQ.CH.AND.NWIDE.EQ.4) WRITE(PDF,30) (ZHEX(1,J),J=1,32)
   30     FORMAT(' ',32(A1,' '),'.')
          IF(COP.EQ.CH.AND.NWIDE.EQ.8) WRITE(PDF,35)
     1    ((ZHEX(I,J),I=1,2),J=1,32)
   35     FORMAT(' ',16(2A1,' '),'.',/,' ',16(2A1,' '),'.')
          IF(COP.EQ.CI.AND.NWIDE.EQ.4) WRITE(PDF,40) (ZHEX(1,J),J=1,32)
   40     FORMAT(' ',32A1)
          IF(COP.EQ.CI.AND.NWIDE.EQ.8) WRITE(PDF,45)
     1    ((ZHEX(I,J),I=1,2),J=1,32)
   45     FORMAT(' ',32A1,/,' ',32A1)
   50 CONTINUE
      IF(COP.EQ.CH) WRITE(PDF,15)
      WRITE(PDF,80) ETX
   80 FORMAT(' ',A1)
      CALL HEXDC(CSUM,ZCSUM)
      WRITE(PDF,90) ZCSUM
   90 FORMAT(' ',5A1)
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE BINR(NWORD,NWIDE,BADD,LPHASE,CSYM,CBUF,HP,LN)
C     THIS SUBROUTINE GENERATES BINARY PROGRAMMING FORMATS
      IMPLICIT INTEGER (A-Z)
      INTEGER CSYM(8,24),CBUF(8,24),BADD(12),BDAT(12),BTEMP(8,8),
     1        ZCSUM(5)
      LOGICAL LPHASE(24)
      COMMON /LUNIT/ PMS,POF,PDF
      DATA CLO/'L'/,CHI/'H'/
      NADD=2**NWORD
      IF( NWORD.GE.5.AND.(NWIDE.EQ.4.OR.NWIDE.EQ.8) ) GO TO 10
      WRITE(PMS,5) HP,LN,NADD,NWIDE
    5 FORMAT(/,' PLEASM DOES NOT SUPPLY B',2A1,
     1         'F PROGRAMMING FORMAT FOR', I4,' BY ',I2,' PROMS')
      RETURN
   10 CSUM=0
      WRITE(PDF,15)
   15 FORMAT(//,'                          .',//)
      DO 40 IADD=1,NADD,8
          DO 25 J=1,8
              ADD=IADD+J-2
              CALL SIM(NWIDE,BADD,BDAT,CSYM,CBUF,LPHASE)
              DO 20 I=1,NWIDE
                  BTEMP(NWIDE-I+1,J)=LN
                  IF(BDAT(I).EQ.CHI) BTEMP(NWIDE-I+1,J)=HP
   20         CONTINUE
              CSUM=CSUM+DECC(NWIDE,BDAT)
              CALL BINC(BADD)
   25     CONTINUE
          IF(NWIDE.EQ.4) WRITE(PDF,30) ((BTEMP(I,J),I=1,4),J=1,8)
   30     FORMAT(' ',8('B',4A1,'F '))
          IF(NWIDE.EQ.8) WRITE(PDF,35) ((BTEMP(I,J),I=1,8),J=1,8)
   35     FORMAT(' ',4('B',8A1,'F '),/,' ',4('B',8A1,'F '))
   40 CONTINUE
      WRITE(PDF,15)
      CALL HEXDC(CSUM,ZCSUM)
      WRITE(PDF,45) (ZCSUM(I),I=1,5)
   45 FORMAT(' ',5A1)
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE IODC2
C***** THIS ROUTINE IS OPTIONAL, IT MAY BE USED TO TURN PERIPHERALS ON
      CHARACTER BEL,DC2,ESC,FF,NUL
      COMMON /LUNIT/ PMS,POF,PDF
      DATA BEL/007/,DC2/022/
      WRITE(PDF,5) DC2,BEL
    5 FORMAT(' ',2A1)
      RETURN
      END
C
C***********************************************************************
C
      SUBROUTINE IODC4
C***** THIS ROUTINE IS OPTIONAL, IT MAY BE USED TO TURN PERIPHERALS OFF
      CHARACTER BEL,DC3,DC4
      COMMON /LUNIT/ PMS,POF,PDF
      DATA BEL/007/,DC3/023/,DC4/024/
      WRITE(PDF,5) BEL,DC3,DC4
    5 FORMAT(' ',3A1)
      RETURN
      END
C
C***********************************************************************
C
C     SUBROUTINE BINC(NWORD,ADD,BADD)
C     THIS SUBROUTINE CONVERTS DECIMAL ADDRESSES (ADD) INTO NWIDE BITS
C      OF BINARY DATA (BDAT).
C     IMPLICIT INTEGER (A-Z)
C     INTEGER BADD(12)
C     DATA CLO/'L'/,CHI/'H'/
C     DEC=ADD
C     DO 5 I=1,NWORD
C         BADD(NWORD-I+1)=L1
C         DTEMP=DEC-2**(NWORD-I)
C         IF(DTEMP.LT.0) GO TO 5
C         BADD(NWORD-I+1)=CHI
C         DEC=DTEMP
C   5 CONTINUE
C     RETURN
C     END