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