begin;  !6-valued logic simulator

constinteger low=-2,falling=-1,rising=1,high=2
constinteger open=0,undef=((-1)>>1)!!(-1)

ownrecord(*)name nil==0
!%record(*)%name nil==record(0)

recordformat hfm(record(hfm)name next,integer state,since)
constinteger slotmax=11;  !slots @ 2 lines each, leaves 2 for command etc
constinteger eqmax=800;   !event queue cells
constinteger hmax=5000;   !heap words

constinteger csize=5,psize=5,ssize=10;  !size (in words) of heap records
constinteger hsize=3
recordformatspec pinf
recordformatspec sigf
recordformat compf(record(compf)name next,
                    integer type {indexes into behaviour switch},
                    record(pinf)name ins,outs,private)
recordformat pinf(record(pinf)name next {pin in component},
                   chain {next pin in net},record(compf)name comp,
                   record(sigf)name signal, integer state)
recordformat sigf(record(sigf)name next {for identification},
                   integer state,record(pinf)name from,to,
                   integer screenslot,record(hfm)name history,
                   string(15)name)
recordformat eqf(record(eqf)name next,record(pinf)name pin,
                  integer state,when)

record(sigf)namearray slot(1:slotmax)
record(eqf)name eventqueue,eclist
record(eqf)array ecell(1:eqmax)
integer now=0

integer heapspace=1
integerarray heap(1:hmax)
record(sigf)name nets==nil
record(compf)name components==nil

routine initialise arrays
integer i
  slot(i)==nil for i=1,1,slotmax
  ecell(i)_next==ecell(i-1) for i=2,1,eqmax
  eclist==ecell(eqmax)
  ecell(1)_next==nil
  eventqueue==nil
end

record(*)map new(integer size)
!This assumes that array elements with increasing
!indices have increasing addresses
  signal 15 if heapspace>hmax
  heap(heapspace)=size; heapspace=heapspace+size+1
  result==record(addr(heap(heapspace-size)))
end

record(pinf)map newpin
record(pinf)name x==new(psize)
  x=0; result==x
end

record(compf)map newcomp
record(compf)name x==new(csize)
  x=0; result==x
end

record(sigf)map newsignal
record(sigf)name x==new(ssize)
  x=0; x_state=undef; result==x
end

record(hfm)name history archive==nil

record(hfm)map get hist
record(hfm)name h
  h==history archive
  if h==nil then h==new(hsize) else history archive==h_next
  h=0; result==h
end

routine put hist(record(hfm)name h)
  h_next==history archive
  history archive==h
end

constinteger esc=27,cur='Y',graph='F',nograph='G',delete='O'
constinteger up='A',home='H',clearscreen='v',clearline='K'
constinteger insert='i',noinsert='j'

routine escape(integer x)
  printsymbol(esc); printsymbol(x)
end

routine cursor(integer x,y)
  escape(cur); printsymbol(y+' '); printsymbol(x+' ')
end

integerfn upper(integer old,new)
  old=old+old if |old|=rising
  new=new+new if |new|=rising
  if old=high start
    result='`' if new=high
    result='l' if new=low
    result='d' if new=open
    result='l'
  finish
  if old=low start
    result='s' if new=high
    result=' ' if new=low
    result='s' if new=open
    result=' '
  finish
  if old=open start
    result='d' if new=high
    result='l' if new=low
    result='d' if new=open
    result='l'
  finish
  result='s' if new=high
  result=' ' if new=low
  result=' ' if new=open
  result=' '
end

integerfn lower(integer old,new)
  old=old+old if |old|=rising
  new=new+new if |new|=rising
  if old=high start
    result=' ' if new=high
    result='e' if new=low
    result='e' if new=open
    result=' '
  finish
  if old=low start
    result='m' if new=high
    result='`' if new=low
    result='c' if new=open
    result='m'
  finish
  if old=open start
    result='m' if new=high
    result='c' if new=low
    result='c' if new=open
    result='m'
  finish
  result='e' if new=high
  result='e' if new=low
  result='%' if new=open
  result=' '
end

routine refresh(integer i)
integer old,new
record(sigf)name s
record(hfm)name h
  s==slot(i); returnif s==nil
  cursor(0,i+i+1); escape(clearline)
  cursor(0,i+i);   escape(clearline)
  cursor(65,i+i+1); printstring(s_name)
  cursor(65,i+i);   printstring(s_name); newline
!rest not in yet
end

routine log(record(sigf)name s,integer old)
integer new,i
record(hfm)name h,hh
  escape(graph)
  if s==nil start;   ! Time has passed: old=ticks
    while old>0 cycle
      old=old-1
      escape(insert)
      for i=slotmax,-1,1 cycle
        unless slot(i)==nil start
          new=slot(i)_state
          cursor(0,i+i+1); escape(delete); cursor(63,i+i+1)
          printsymbol(lower(new,new))
          cursor(0,i+i); escape(delete);   cursor(63,i+i)
          printsymbol(upper(new,new))
          newline; !??
        finish
      repeat
      escape(noinsert)
    repeat
  finishelsestart;  ! Signal has changed: old=previous state
    new=s_state
    h==s_history
    if h==nil start
      h==get hist; h_next==h; s_history==h
      h_since=now; h_state=new
    finishelsestart
      old=h_state; ! overriding
      hh==get hist; hh_next==h_next; h_next==hh; s_history==hh
      hh_since=now; hh_state=new
      h==hh
    finish
    while h_next_next_since <= now-64 cycle;   !scavenge
      hh==h_next; h_next==hh_next; put hist(hh)
    repeat
    i=s_screenslot
    if i#0 start
      cursor(63,i+i+1); printsymbol(lower(old,new))
      cursor(63,i+i);   printsymbol(upper(old,new))
      newline; !??
    finish
  finish
  escape(nograph); newline; !??
end

routine print(integer state)
  if state=high    then printstring("high")      elsec
  if state=low     then printstring("low")       elsec
  if state=undef   then printstring("undefined") elsec
  if state=open    then printstring("open")      elsec
  if state=rising  then printstring("rising")    elsec
  if state=falling then printstring("falling")
  newline
end


routinespec excite(record(compf)name c)

routine propagate(record(sigf)name signal)
integer new,y,old
record(pinf)name p

  old=signal_state
  p==signal_from
  if p==nil start;       ! External input
    new=old; old=undef
  finishelsestart;       ! Establish agreement from all sources
    new=open
    cycle
      y=p_state; new=y if new#y and new=open
      new=undef andexitif new#y and y#open;   !Conflict
      p==p_chain
    repeatuntil p==nil
    returnif signal_state=new
    if |old|=rising start;   !Forced: Set all sources
      new=old+old; p==signal_from
      cycle
        p_state=new; p==p_chain
      repeatuntil p==nil
      newline
    finish
    signal_state=new
  finish

  log(signal,old)

! Excite all components with inputs connected to this signal

  p==signal_to
  y=new; y=rising if y=high; y=falling if y=low
  whilenot p==nil cycle
    p_state=y; excite(p_comp)
    p_state=new; excite(p_comp); p==p_chain
  repeat
end

routine make(record(pinf)name pin,integer new,when)
record(eqf)name e,f
integer old
  new=new+new if |new|=rising
  unless when=now start;     ! Insert this event in event queue
    e==eclist; signal 15 if e==nil
    eclist==e_next; e_next==nil
    e_pin==pin; e_state=new; e_when=when
    f==eventqueue
    if f==nil start
      eventqueue==e; return
    finish
    if when<f_when start
      e_next==f; eventqueue==e; return
    finish
    cycle
      if f_next==nil start
        f_next==e; return
      finish
      if when<f_next_when start
        e_next==f_next; f_next==e; return
      finish
      f==f_next
    repeat
  finish
  old=pin_state; returnif old=new
  pin_state=new; returnif pin_signal==nil
  propagate(pin_signal)
end

routine aftermath;   ! Flush event queue
record(eqf)name e
  cycle
    e==eventqueue; returnif e==nil
    eventqueue==e_next; e_next==eclist; eclist==e
    log(nil,e_when-now)
    now=e_when
    make(e_pin,e_state,now)
  repeat
end

! Basic logic primitives
! Note that NOT is just minus

integerfn float(integer x)
  x=high if x=open
  x=x+x if |x|=rising
  result=x
end

integerfn edgefloat(integer x)
  x=undef if x=open
  result=x
end

integerfn setupfloat(integer x)
  x=high if x=open or x=falling
  x=low if x=rising
  result=x
end

integerfn and(integer x,y)
  result=low if x=low or y=low
  result=undef if x=undef or y=undef
  result=high
end

integerfn or(integer x,y)
  result=high if x=high or y=high
  result=undef if x=undef or y=undef
  result=low
end

integerfn xor(integer x,y)
  result=undef if x=undef or y=undef
  result=low if x=y
  result=high
end

integerfn oc(integer x);   !open collector
  result=open if x=high or x=rising
  result=x
end

constinteger known=13
conststring(15)array type(0:known)="???",
"INV",  "INVO",
"AND",  "NAND",
"NANDO","OR",
"NOR",  "NORO",
"XOR",  "U74",
"TSBUF","U374",
"U123"

routine fail(record(compf)name c,record(sigf)name s,string(15)m)
record(pinf)name p
integer n
  printstring(m)
  unless s==nil start
    printstring(" Net "); printstring(s_name)
    p==s_from; n=0
    whilenot p==nil cycle
      n=n+1; p==p_chain
    repeat
    write(n,1)
    p==s_to; n=0
    whilenot p==nil cycle
      n=n+1; p==p_chain
    repeat
    write(n,1); newline
  finish
  unless c==nil start
    printstring(type(c_type)); printstring(" (")
    p==c_ins
    whilenot p==nil cycle
      printstring(p_signal_name); p==p_next; printsymbol(',') unless p==nil
    repeat
    printsymbol('/')
    p==c_outs
    whilenot p==nil cycle
      printstring(p_signal_name); p==p_next; printsymbol(',') unless p==nil
    repeat
    printsymbol(')'); newline
  finish
  signal 15
end

routine excite(record(compf)name comp)
record(pinf)name in1,in2,more,out
integer i1,i2
switch s(0:known)
switch t(3:9)

  more==nil; in2==nil
  in1==comp_ins
  unless in1==nil start
    i1=in1_state; in2==in1_next
    unless in2==nil start
      more==in2_next; i2=in2_state
    finish
  finish
  out==comp_outs
  ->s(comp_type)

s(9): {xor}    i1=xor(float(i1),float(i2)); ->generic
s(3): {and}
s(4): {nand}
s(5): {nando}  i1=and(float(i1),float(i2)); ->generic
s(6): {or}
s(7): {nor}
s(8): {noro}   i1=or(float(i1),float(i2))
generic:
  ->t(comp_type) if more==nil
  i2=more_state; more==more_next; ->s(comp_type)

t(9): {xor}
t(6): {or}
t(3): {and}    make(out,i1,now+1); return
s(1): {inv}
t(7): {nor}
t(4): {nand}   make(out,-float(i1),now+1); return
s(2): {invo}
t(8): {noro}
t(5): {nando}  make(out,oc(-float(i1)),now+1); return

s(10):{u74}
  begin
  integer d,s0,r0,c
  record(pinf)name out0

    d=setupfloat(i1); s0=float(i2); r0=float(more_state)
    c=edgefloat(more_next_state)
    out0==out_next

    if r0=undef start
      make(out,high,now+1) if s0=low
    finishelseif s0=undef start
      make(out0,high,now+1) if r0=low
    finishelseif r0=low and s0=low start
      make(out,high,now+1); make(out0,high,now+1)
    finishelseif r0=low start
      make(out,low,now+1); make(out0,high,now+1)
    finishelseif s0=low start
      make(out,high,now+1); make(out0,low,now+1)
      if c=rising and (d=low or d=undef) start
        make(out0,-d,now+2); make(out0,low,now+3)
      finish
    finishelseif c=rising start
      make(out,d,now+2); make(out0,-d,now+2)
    finish
  end
  return

s(11): {tsbuf: non-inverting, low-active enable}
  i1=float(i1); i2=float(i2)
  if i2=low then i2=i1 elsec
  if i2=high then i2=open else i2=undef
  make(out,i2,now+1)
  return

s(12): {u374: clock, enable¬ i(0:7) / o(0:7)}
!%begin
!%record(pinf)%namearray in,state,out(0:7)
!%record(pinf)%name p
!%integer i
!  p==comp_private
!  %if p==nil %start
!    %for i=0,1,7 %cycle
!      p==newpin; state(i)==p; p_comp==comp
!    %repeat
!    comp_private==state(0)
!    %for i=0,1,6 %cycle
!      state(i)_next==state(i+1)
!    %repeat
!    state(7)_next==nil
!  %finishelsestart
!    %for i=0,1,7 %cycle
!      state(i)==p; p==p_next
!    %repeat
!  %finish
!  p==comp_outs
!  %for i=0,1,7 %cycle
!    out(i)==p; p==p_next
!  %repeat
!  p==more
!  %for i=0,1,7 %cycle
!    in(i)==p; p==p_next
!  %repeat
!  %if i1=rising %start
!    state(i)_state=setupfloat(in(i)_state) %for i=0,1,7
!  %finish
!  i2=float(i2)
!  %if i2=low %start
!    make(out(i),state(i)_state,now+1) %for i=0,1,7
!  %finishelsestart
!    %if i2=high %then i2=open %else i2=undef
!    make(out(i),i2,now+1) %for i=0,1,7
!  %finish
!%end
  return

s(13): {u123: a0, b, c0, timeout / q, q0}
  begin
 integer a0,b,c0,timeout
  record(pinf)name out0
  a0=float(i1); b=float(i2); c0=float(more_state)
  timeout=more_next_state
  out0==out_next
  if c0=low start
    make(out,low,now+1); make(out0,high,now+1)
  finishelseif c0=undef start
    make(out,undef,now+1); make(out0,undef,now+1)
  finishelsestart
    b=and(-a0,b)
    if b=high and out_state=low start
      make(out,high,now+1)
      make(out0,low,now+1)
    finishelseif |timeout|=rising start
      make(out,low,now+1)
      make(out0,high,now+1)
    finish
  finish
  end
  return

s(0):
end

string(15)atom,pend=""
integer sym=nl
constbyteintegerarray symtype(0:127)=
1(33),0(3),2,0(3),2,2,0,0,2,2,0,2,0(16),0(33),3(26),0(5)
!          $      ( )     , -   /
! 0 normal 1 separator 2 special 3 lower-case

routine readatom
integer st
  unless pend="" start
    atom=pend; pend=""; return
  finish
  cycle
    cycle
      st=symtype(sym&127); exitunless st=1
      readsymbol(sym)
    repeat
    exitunless sym='$'
    readsymbol(sym) until sym='$' or sym=nl
    readsymbol(sym)
  repeat
  sym=sym-32 if st=3
  atom=tostring(sym)
  if st=2 start;   !Special on its own
    if sym='-' start;   ! "->" or "/" or "-" equivalent
      atom="/"
      readsymbol(sym); returnunless sym='>'
    finish
    readsymbol(sym); return
  finish
  readsymbol(sym)
  cycle
    st=symtype(sym&127); sym=sym-32 and st=0 if st=3
    exitunless st=0
    atom=atom.tostring(sym) unless length(atom)=15
    readsymbol(sym)
  repeat
end

record(sigf)map findsignal
record(sigf)name s
  s==nets
  whilenot s==nil cycle
    result==s if s_name=atom
    s==s_next
  repeat
  s==newsignal; s_next==nets; nets==s; s_name=atom
  result==s
end

routine readcomponent
record(compf)name c
record(pinf)name p,plist
record(sigf)name s
integer t,slashes

record(pinf)map reverse(record(pinf)name this)
record(pinf)name tail,next
  tail==nil; result==nil if this==nil
  cycle
    next==this_next; this_next==tail; tail==this
    result==this if next==nil; this==next
  repeat
end

!%record(pinf)%map reversecopy(%record(pinf)%name list)
!%record(pinf)%name x,y
!  x==nil
!  %cycle
!    %result==x %if list==nil
!    y==newpin; y_next==x; x==y
!    y_comp==c; y_signal==list_signal
!    list==list_next
!  %repeat
!%end
!
!%record(pinf)%map append(%record(pinf)%name tail,list)
!%record(pinf)%name p
!  %result==tail %if list==nil
!  p==list; p==p_next %whilenot p_next==nil; p_next==tail
!  %result==list
!%end

  readatom; signal 9 if atom="END"
  for t=1,1,known cycle
    ->ok if type(t)=atom
  repeat
  printstring("Unknown component "); printstring(atom); newline
  t=0
ok: c==newcomp; c_type=t
  c_next==components; components==c
  slashes=0; plist==nil
  readatom
  printstring("( expected") and newline unless atom="("
!Non-ESDL-compatible notation:  comp(ins{{/inouts}/outs})
!  readatom
!  %cycle
!    %if atom="/" %or atom=")" %start
!      %if slashes=0 %start
!        c_ins==reverse(plist); %exitif atom=")"
!        slashes=1
!      %finishelsestart
!        %if atom=")" %start
!          c_outs==append(reverse(plist),c_outs); %exit
!        %finish
!        c_ins==append(reversecopy(plist),c_ins)
!        c_outs==reverse(plist)
!      %finish
!      plist==nil
!      readatom
!    %finishelsestart
!      printstring("Unexpected (") %and newline %if atom="("
!      printstring("Unexpected ,") %and newline %if atom=","
!      s==nil; s==findsignal %unless atom="?"
!      p==newpin; p_next==plist; plist==p
!      p_comp==c; p_signal==s; p_state=open %if s==nil
!      readatom
!      %if atom="," %then readatom %elsestart
!        printstring(", expected") %and newline %unless atom="/" %or atom=")"
!      %finish
!    %finish
!  %repeat
!ESDL-compatible notation: comp(ins)->outs
! This requires pending atom and disallows inouts
  cycle
    readatom
    if atom=")" or atom="," or atom="/" start
      printstring(atom); printstring(" not expected"); newline
      exit
    finish
    s==nil; s==findsignal unless atom="?"
    p==newpin; p_next==plist; plist==p
    p_comp==c; p_signal==s; p_state=open if s==nil
    readatom
    exitif atom=")" or atom="/"
    printstring(", expected") and newline unless atom=","
  repeat
  readatom if atom=")"
  printstring("-> expected") and newline unless atom="/"
  c_ins==reverse(plist); plist==nil
  cycle
    readatom
    printstring(", not expected") and newline if atom=","
    s==nil; s==findsignal unless atom="?"
    p==newpin; p_next==plist; plist==p
    p_comp==c; p_signal==s; p_state=open if s==nil
    readatom; exitunless atom=","
  repeat
  pend=atom unless atom=")"
  c_outs==reverse(plist); plist==nil
  p==c_ins
  whilenot p==nil cycle
    s==p_signal
    p_chain==s_to and s_to==p unless s==nil
    p==p_next
  repeat
  p==c_outs
  whilenot p==nil cycle
    s==p_signal
    p_chain==s_from and s_from==p unless s==nil
    p==p_next
  repeat
end

routine simulate
integer command,i
record(compf)name c
record(sigf)name s

routine identify
  readatom
  s==findsignal
  if s_from==nil and s_to==nil start
    s==nil; printstring("Not connected"); newline
  finish
end

  initialise arrays
  escape(clearscreen); newline

cycle
  escape(home); escape(clearline); newline
  prompt(tostring(esc).tostring(up)."scuovpdr+-?:")
  escape(clearline); newline
  readsymbol(command) until command>' '
  command=command!32
  stopif command=':'
  if command='-' start
    identify
    unless s==nil start
      i=s_screenslot
      unless i=0 start
        slot(i)==nil
        s_screenslot=0
        cursor(0,i+i+1); escape(clearline)
        cursor(0,i+i);   escape(clearline)
        newline; !??
      finish
    finish
  finishelseif command='+' start
    identify
    unless s==nil start
      if s_screenslot=0 start
        for i=1,1,slotmax cycle
          if slot(i)==nil start
            slot(i)==s; s_screenslot=i
            refresh(i)
            exit
          finish
        repeat
      finish
    finish
  finishelseif command='r' start
    refresh(i) for i=1,1,slotmax
  finishelseif command='?' start
    identify
    unless s==nil start
      printstring(atom); printstring(" = "); print(s_state); newline
    finish
  finishelseif command='s' start
    identify
    unless s==nil start
      s_state=rising; propagate(s)
      s_state=high; propagate(s)
      aftermath
    finish
  finishelseif command='c' start
    identify
    unless s==nil start
      s_state=falling; propagate(s)
      s_state=low; propagate(s)
      aftermath
    finish
  finishelseif command='u' start
    identify
    unless s==nil start
      s_state=undef; propagate(s)
      aftermath
    finish
  finishelseif command='o' start
    identify
    unless s==nil start
      s_state=open; propagate(s)
      aftermath
    finish
  finishelseif command='v' start
    identify
    unless s==nil start
    if |s_state|=high start
      s_state=-s_state//2; propagate(s)
      s_state=s_state<<1; propagate(s)
      aftermath
    finish
    finish
  finishelseif command='p' start
    identify
    unless s==nil start
    if |s_state|=high start
      s_state=-s_state//2; propagate(s)
      s_state=s_state<<1; propagate(s)
      aftermath
      s_state=-s_state//2; propagate(s)
      s_state=s_state<<1; propagate(s)
      aftermath
    finish
    finish
  finishelseif command='d' start
    s==nets
    cycle
      if s_state=undef start
        prompt(s_name." = "); readsymbol(sym)
        if sym#nl start
          sym=sym!32
          if sym='h' start
            s_state=rising; propagate(s)
            s_state=high; propagate(s)
          finishelseif sym='l' start
            s_state=falling; propagate(s)
            s_state=low; propagate(s)
          finishelseif sym='o' start
            s_state=open; propagate(s)
          finishelse sym=0
          aftermath unless sym=0
          readsymbol(sym) until sym=nl
        finish
      finish
      s==s_next
    repeatuntil s==nil
  finish
repeat
end

integer stream=1

onevent 9 start
  stopif stream=0; stream=0
finish

selectinput(stream)
simulate if stream=0
cycle
  readcomponent
repeat

endofprogram