%begin; !6-valued logic simulator

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

%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
