%begin; !Rom Finite State Machine Simulator

! Input:
! Number of inputs
!  Input Names
! Number of Outputs
!  Output Names
! Number of state bits
! { state : { = clone-state } { Output = expression }*
!           { next-state-number expression }* ; }* .
! Expressions involve input names, 0, 1, and )(+.\ and are
!  terminated by a colon, thereby allowing them to extend
!  over several lines.
! Output:
! A binary file for each byte the rom is wide.
! The state bits form the most significant part of both
! address and data, the input and output bits increase
! in significance, i.e. the first input bit is the least
! significant address bit, the last output bit is the most
! significant data bit (but less significant than the least
! significant state bit).

%include "inc:util.imp"
%string(31)file = cliparam

  file = file.tostring('.')
  openinput(1,file."fsm"); selectinput(1)

%integer line=1, pend=-1, i
%integer inputs, outputs, statebits
%integer inbits, outbits, max
%integer errorcount=0

%routine error(%string(255)s)
  errorcount = errorcount+1
  printstring(s." at line "); write(line,0); newline
  selectoutput(0)
  printstring(s." at line "); write(line,0); newline
  selectoutput(1)
%end

%routine wbsym(%integer x); !Write back symbol
  pend = x
%end

%integerfn rsym;            !Read symbol, skip comments, count lines
%integer x
  x = pend; pend = -1; %result = x %unless x<0
  %cycle
    readsymbol(x); line = line+1 %if x=nl
    %if x='{' %start
      %cycle
        readsymbol(x); line = line+1 %if x=nl
      %repeatuntil x='}'
    %elseif x='|'
      readsymbol(x) %until x=nl
      line = line+1
    %finishelseresult = x
  %repeat
%end

%integerfn sigsym;           !Read significant symbol
%integer x
  x = rsym %until ' '#x#nl
  %result = x
%end

%integerfn rdec;             !Read decimal number
%integer x=sigsym,n=0
  %unless '0'<=x<='9' %start
    error("Warning: decimal number expected")
    %result = 0
  %finish
  %cycle
    %exitunless '0'<=x<='9'
    n = n*10-'0'+x
    x = rsym
  %repeat
  wbsym(x); %result = n
%end

%routine rname(%string(15)%name s); !Read signal name or special symbol
%integer x = sigsym
  s = tostring(x)
  %returnunless 'A'<=x&95<='Z'
  %cycle
    x = rsym
    %exitunless 'A'<=x&95<='Z' %or '0'<=x<='9' %or x=''''
    s = s.tostring(x)
  %repeat
  wbsym(x)
%end

  inputs = rdec

%string(15)%array in(0:inputs); !0 never used

  rname(in(i)) %for i=1,1,inputs
  outputs = rdec

%begin
%string(15)%array out(0:outputs); !0 never used

  rname(out(i)) %for i=1,1,outputs
  statebits = rdec
  inbits = statebits+inputs
  outbits = statebits+outputs
  %if outbits>32 %start
    error("Rom too wide"); %stop
  %finish
  max = 1<<inbits-1

%begin
%integerarray a(0:max);    ! ROM
%integerarray e(0:max);    ! Expression stack

%constinteger maxstack=50
%shortarray opd(1:maxstack); !Operand stack
%shortarray opt(1:maxstack); !Operator stack
%integer pd,pt
%constbytearray op(0:6)='0','1',')','(','+','.','\'
%constinteger zero=0,one=1,right=2,left=3,or=4,and=5,not=6

%integer inbits=0,outbits,sym
%constinteger clear=0,set=1,complement=2

%routine dostate(%integer state)
%integer low = state<<inputs, high = low+1<<inputs-1; !array bounds

  %routine expr
  %string(15)s
  %integer k
  %constinteger d=1,t=2
  %integer mode = d; !indicates whether expecting operanD or operaTor

    %routine m(%integer x,y); !verify mode=x, then set to y
    %string(63)e
      %unless mode=x %start
        e = "Got "
        %if x=d %start
          e = e.tostring(k)
          error(e." when expecting an operand")
        %else
          error(e.s." when expecting an operator")
        %finish
      %finish
      mode = y
    %end

    %routine dpush(%integer x); !add to reverse polish list
{printstring("Dpush "); %if x>=0 %then printsymbol(op(x)) %else write(x,0); newline
      %returnif x=left
      error("Expression too complex") %if pd>=maxstack
      pd = pd+1; opd(pd) = x
    %end

    %integerfn tpop; !off operator stack
{printstring("Tpop:")
      %result = 0 %if pt<=0
      pt = pt-1; %result = opt(pt+1)
    %end

    %routine tpush(%integer x); !onto operator stack
    %integer y
{printstring("Tpush "); %if x>=0 %then printsymbol(op(x)) %else write(x,0); newline
      %unless x=left %start
        %while pt>0 %and x<=opt(pt) %cycle; !flush high-prec ops
          y = tpop; %exitif x=right %and y=left
          dpush(y)
        %repeat
      %finish
      %returnif x=right
      error("Expression too complex") %if pt>=maxstack
      pt = pt+1; opt(pt) = x
    %end

! Part 1 of EXPR: read expression and build reverse polish list

    pd = 0; pt = 0; tpush(left); !Initial open bracket
    %cycle
      rname(s); k = charno(s,1)
      %if k='(' %start
        m(d,d); tpush(left)
      %elseif k=')'
        m(t,t); tpush(right)
        %if pt=0 %start
          error("Spurious ')'")
          k = rsym %until k=',' %or k=';'; %exit
        %finish
      %elseif k='+'
        m(t,d); tpush(or)
      %elseif k='.'
        m(t,d); tpush(and)
      %elseif k='\'
        m(d,d); tpush(not)
      %elseif k=',' %or k=';'
        wbsym(k) %unless k=','
        m(t,0); tpush(right)
        %unless pt=0 %start
          error("Premature ','")
          %exit
        %finish
        %exit
      %elseif k='0'
        m(d,t); dpush(zero)
      %elseif k='1'
        m(d,t); dpush(one)
      %else
        m(d,t); k = inputs
        %while k>0 %cycle
          %exitif in(k)=s; k = k-1
        %repeat
        %if k=0 %start
           error("Unknown operand ".s)
           k = 0
        %finish
        dpush(-k)
      %finish
    %repeat

! Part 2 of EXPR: evaluate expression just built

  %integer p=0
  %integer stackbit=1,nextbit,i
    %while p<pd %cycle
      nextbit = stackbit>>1
      p = p+1; k = opd(p)
      %if k=one %start
        e(i) = e(i)!stackbit %for i=low,1,high
        stackbit = stackbit<<1
      %elseif k=zero
        e(i) = e(i)&\stackbit %for i=low,1,high
        stackbit = stackbit<<1
      %elseif k=not
        e(i) = e(i)!!nextbit %for i=low,1,high
      %elseif k=and
        stackbit = nextbit; nextbit = nextbit>>1
        %for i=low,1,high %cycle
          e(i) = e(i)&\nextbit %if e(i)&stackbit=0
        %repeat
      %elseif k=or
        stackbit = nextbit; nextbit = nextbit>>1
        %for i=low,1,high %cycle
          e(i) = e(i)!nextbit %if e(i)&stackbit#0
        %repeat
      %else
        k = 1<<(-1-k)
        %for i=low,1,high %cycle
          %if i&k#0 %start
            e(i) = e(i)!stackbit
          %else
            e(i) = e(i)&\stackbit
          %finish
        %repeat
        stackbit = stackbit<<1
      %finish
    %repeat
    error("Bit lost") %unless stackbit=2
    e(i) = e(i)&1 %for i=low,1,high
  %end

  %routine equals
  %integer x = sigsym
    %returnif x='='
    wbsym(x)
    error("Warning: '=' expected")
  %end

  %routine setoutput
  %string(15)o; rname(o)
  %integer k,i
    equals
    k = outputs
    %while k>0 %cycle
      %exitif out(k)=o
      k = k-1
    %repeat
    error("Unknown output ".o) %if k=0
    k = 1<<(k-1)
    expr
    %for i=low,1,high %cycle
      %if e(i)=0 %then a(i) = a(i)&\k %else a(i) = a(i)!k
    %repeat
  %end

  %routine nextstate
  %integer i,old,new,f=0
    new = rdec; equals; expr
    %for i=low,1,high %cycle
      %if e(i)#0 %start
        old = a(i)>>outputs
        error("Ambiguous next state") %and f=1 %if old#state %and f=0
        a(i) = a(i)!!(old!!new)<<outputs
      %finish
    %repeat
  %end

! Main part of DOSTATE

%integer k = sigsym,i
  %unless k=':' %start
    error("Warning: ':' expected")
  %finish
  k = sigsym
  %if k='=' %start; !clone output configuration of another state
    k = rdec
    k = k<<inputs!!low
    %for i=low,1,high %cycle
      a(i) = a(i!!k)
    %repeat
    k = sigsym
    error("',' expected") %unless k=','
  %finishelse wbsym(k)
  k = 1<<outputs-1
  a(i) = a(i)&k!state<<outputs %for i=low,1,high
  %cycle
    k = sigsym; wbsym(k)
    %if '0'<=k<='9' %then nextstate %c
    %elseif 'A'<=k&95<='Z' %then setoutput %c
    %elseexit
  %repeat
  k = rsym
  error("Warning: ';' expected") %unless k=';'
%end{dostate}

! Rest of main program

  a(i) = 0 %and e(i) = 0 %for i=0,1,max
  %cycle
    i = sigsym; %exitif i='.'; wbsym(i)
    dostate(rdec)
  %repeat
  %if errorcount#0 %start
    selectoutput(0); printstring("No output generated"); newline
    %stop
  %finish

! End of ROM building code, simulation follows.

%routine feedback
  inbits = inbits&(1<<inputs-1) ! outbits>>outputs<<inputs
%end

%routine list(%integer mode)
%string(15)signal
%integer i
  %cycle
    sym = rsym; %exitif sym=nl
    wbsym(sym); rname(signal)
    i = inputs
    %while i>0 %cycle
      %exitif in(i)=signal; i = i-1
    %repeat
    %if i=0 %start
      printstring("Unknown signal ".signal); newline
    %else
      i = 1<<(i-1)
      %if mode=clear %start
        inbits = inbits&\i
      %elseif mode=set
        inbits = inbits!i
      %else
        inbits = inbits!!i
      %finish
    %finish
  %repeat
%end

%routine show state
%integer i
  printstring("State:")
  i = inputs+statebits
  %cycle
    %exitif i=inputs
    i = i-1
    space; printsymbol(inbits>>i&1+'0')
  %repeat
  newline
  printstring("Inputs:"); phex4(inbits)
  %while i>0 %cycle
    space; printstring(in(i)); printsymbol('=')
    i = i-1
    printsymbol(inbits>>i&1+'0')
  %repeat
  newline
  printstring("Next state:")
  i = outputs+statebits
  %cycle
    %exitif i=outputs
    i = i-1
    space; printsymbol(outbits>>i&1+'0')
  %repeat
  newline
  printstring("Outputs:"); phex(outbits)
  %while i>0 %cycle
    space; printstring(out(i)); printsymbol('=')
    i = i-1
    printsymbol(outbits>>i&1+'0')
  %repeat
  newline
%end

selectinput(0); wbsym(-1)
%cycle
  sym = rsym
  %if sym=nl %start   {clock tick
!!phex(inbits); space; phex(a(inbits)); space
    outbits = a(inbits)
!!phex(outbits); newline
    show state
    feedback
  %elseif sym='0'
    list(clear)
  %elseif sym='1'
    list(set)
  %else
    wbsym(sym)
    list(complement)
  %finish
%repeat

%end
%end
%endofprogram