         Edinburgh IMP77 Compiler - Version 8.4

    1  %begin; !6-valued logic simulator
    2  
    3  %constinteger low=-2,falling=-1,rising=1,high=2
    4  %constinteger open=0,undef=((-1)>>1)!!(-1)
    5  
    6  %record(*)%name nil==record(0)
    7  
    8  %recordformat hfm(%record(hfm)%name next,%integer state,since)
    9  %constinteger slotmax=11; !slots @ 2 lines each, leaves 2 for command etc
   10  %constinteger eqmax=800;  !event queue cells
   11  %constinteger hmax=5000;  !heap words
   12  
   13  %constinteger csize=5,psize=5,ssize=10; !size (in words) of heap records
   14  %constinteger hsize=3
   15  %recordformatspec pinf
   16  %recordformatspec sigf
   17  %recordformat compf(%record(compf)%name next,
   18+                     %integer type {indexes into behaviour switch},
   19+                     %record(pinf)%name ins,outs,private)
   20  %recordformat pinf(%record(pinf)%name next {pin in component},
   21+                    chain {next pin in net},%record(compf)%name comp,
   22+                    %record(sigf)%name signal, %integer state)
   23  %recordformat sigf(%record(sigf)%name next {for identification},
   24+                    %integer state,%record(pinf)%name from,to,
   25+                    %integer screenslot,%record(hfm)%name history,
   26+                    %string(15)name)
   27  %recordformat eqf(%record(eqf)%name next,%record(pinf)%name pin,
   28+                   %integer state,when)
   29  
   30  %record(sigf)%namearray slot(1:slotmax)
   31  %record(eqf)%name eventqueue,eclist
   32  %record(eqf)%array ecell(1:eqmax)
   33  %integer now=0
   34  
   35  %integer heapspace=1
   36  %integerarray heap(1:hmax)
   37  %record(sigf)%name nets==nil
   38  %record(compf)%name components==nil
   39  
   40  %routine initialise arrays
   41  %integer i
   42    slot(i)==nil %for i=1,1,slotmax
   43    ecell(i)_next==ecell(i-1) %for i=2,1,eqmax
   44    eclist==ecell(eqmax)
   45    ecell(1)_next==nil
   46    eventqueue==nil
   47  %end
   48  
   49  %record(*)%map new(%integer size)
   50  !This assumes that array elements with increasing
   51  !indices have increasing addresses
   52    %signal 15 %if heapspace>hmax
   53    heap(heapspace)=size; heapspace=heapspace+size+1
   54    %result==record(addr(heap(heapspace-size)))
   55  %end
   56  
   57  %record(pinf)%map newpin
   58  %record(pinf)%name x==new(psize)
   59    x=0; %result==x
   60  %end
   61  
   62  %record(compf)%map newcomp
   63  %record(compf)%name x==new(csize)
   64    x=0; %result==x
   65  %end
   66  
   67  %record(sigf)%map newsignal
   68  %record(sigf)%name x==new(ssize)
   69    x=0; x_state=undef; %result==x
   70  %end
   71  
   72  %record(hfm)%name history archive==nil
   73  
   74  %record(hfm)%map get hist
   75  %record(hfm)%name h
   76    h==history archive
   77    %if h==nil %then h==new(hsize) %else history archive==h_next
   78    h=0; %result==h
   79  %end
   80  
   81  %routine put hist(%record(hfm)%name h)
   82    h_next==history archive
   83    history archive==h
   84  %end
   85  
   86  %constinteger esc=27,cur='Y',graph='F',nograph='G',delete='O'
   87  %constinteger up='A',home='H',clearscreen='v',clearline='K'
   88  %constinteger insert='i',noinsert='j'
   89  
   90  %routine escape(%integer x)
   91    printsymbol(esc); printsymbol(x)
   92  %end
   93  
   94  %routine cursor(%integer x,y)
   95    escape(cur); printsymbol(y+' '); printsymbol(x+' ')
   96  %end
   97  
   98  %integerfn upper(%integer old,new)
   99    old=old+old %if |old|=rising
  100    new=new+new %if |new|=rising
  101    %if old=high %start
  102      %result='`' %if new=high
  103      %result='l' %if new=low
  104      %result='d' %if new=open
  105      %result='l'
  106    %finish
  107    %if old=low %start
  108      %result='s' %if new=high
  109      %result=' ' %if new=low
  110      %result='s' %if new=open
  111      %result=' '
  112    %finish
  113    %if old=open %start
  114      %result='d' %if new=high
  115      %result='l' %if new=low
  116      %result='d' %if new=open
  117      %result='l'
  118    %finish
  119    %result='s' %if new=high
  120    %result=' ' %if new=low
  121    %result=' ' %if new=open
  122    %result=' '
  123  %end
  124  
  125  %integerfn lower(%integer old,new)
  126    old=old+old %if |old|=rising
  127    new=new+new %if |new|=rising
  128    %if old=high %start
  129      %result=' ' %if new=high
  130      %result='e' %if new=low
  131      %result='e' %if new=open
  132      %result=' '
  133    %finish
  134    %if old=low %start
  135      %result='m' %if new=high
  136      %result='`' %if new=low
  137      %result='c' %if new=open
  138      %result='m'
  139    %finish
  140    %if old=open %start
  141      %result='m' %if new=high
  142      %result='c' %if new=low
  143      %result='c' %if new=open
  144      %result='m'
  145    %finish
  146    %result='e' %if new=high
  147    %result='e' %if new=low
  148    %result='%' %if new=open
  149    %result=' '
  150  %end
  151  
  152  %routine refresh(%integer i)
  153  %integer old,new
  154  %record(sigf)%name s
  155  %record(hfm)%name h
  156    s==slot(i); %returnif s==nil
  157    cursor(0,i+i+1); escape(clearline)
  158    cursor(0,i+i);   escape(clearline)
  159    cursor(65,i+i+1); printstring(s_name)
  160    cursor(65,i+i);   printstring(s_name); newline
  161  !rest not in yet
  162  %end
?H unused
?NEW unused
?OLD unused
  163  
  164  %routine log(%record(sigf)%name s,%integer old)
  165  %integer new,i
  166  %record(hfm)%name h,hh
  167    escape(graph)
  168    %if s==nil %start; ! Time has passed: old=ticks
  169      %while old>0 %cycle
  170        old=old-1
  171        escape(insert)
  172        %for i=slotmax,-1,1 %cycle
  173          %unless slot(i)==nil %start
  174            new=slot(i)_state
  175            cursor(0,i+i+1); escape(delete); cursor(63,i+i+1)
  176            printsymbol(lower(new,new))
  177            cursor(0,i+i); escape(delete);   cursor(63,i+i)
  178            printsymbol(upper(new,new))
  179            newline; !??
  180          %finish
  181        %repeat
  182        escape(noinsert)
  183      %repeat
  184    %finishelsestart; ! Signal has changed: old=previous state
  185      new=s_state
  186      h==s_history
  187      %if h==nil %start
  188        h==get hist; h_next==h; s_history==h
  189        h_since=now; h_state=new
  190      %finishelsestart
  191        old=h_state; ! overriding
  192        hh==get hist; hh_next==h_next; h_next==hh; s_history==hh
  193        hh_since=now; hh_state=new
  194        h==hh
  195      %finish
  196      %while h_next_next_since <= now-64 %cycle; !scavenge
  197        hh==h_next; h_next==hh_next; put hist(hh)
  198      %repeat
  199      i=s_screenslot
  200      %if i#0 %start
  201        cursor(63,i+i+1); printsymbol(lower(old,new))
  202        cursor(63,i+i);   printsymbol(upper(old,new))
  203        newline; !??
  204      %finish
  205    %finish
  206    escape(nograph); newline; !??
  207  %end
  208  
  209  %routine print(%integer state)
  210    %if state=high    %then printstring("high")      %elsec
  211+   %if state=low     %then printstring("low")       %elsec
  212+   %if state=undef   %then printstring("undefined") %elsec
  213+   %if state=open    %then printstring("open")      %elsec
  214+   %if state=rising  %then printstring("rising")    %elsec
  215+   %if state=falling %then printstring("falling")
  216    newline
  217  %end
  218  
  219  
  220  %routinespec excite(%record(compf)%name c)
  221  
  222  %routine propagate(%record(sigf)%name signal)
  223  %integer new,y,old
  224  %record(pinf)%name p
  225  
  226    old=signal_state
  227    p==signal_from
  228    %if p==nil %start;     ! External input
  229      new=old; old=undef
  230    %finishelsestart;      ! Establish agreement from all sources
  231      new=open
  232      %cycle
  233        y=p_state; new=y %if new#y %and new=open
  234        new=undef %andexitif new#y %and y#open; !Conflict
  235        p==p_chain
  236      %repeatuntil p==nil
  237      %returnif signal_state=new
  238      %if |old|=rising %start; !Forced: Set all sources
  239        new=old+old; p==signal_from
  240        %cycle
  241          p_state=new; p==p_chain
  242        %repeatuntil p==nil
  243        newline
  244      %finish
  245      signal_state=new
  246    %finish
  247  
  248    log(signal,old)
  249  
  250  ! Excite all components with inputs connected to this signal
  251  
  252    p==signal_to
  253    y=new; y=rising %if y=high; y=falling %if y=low
  254    %whilenot p==nil %cycle
  255      p_state=y; excite(p_comp)
  256      p_state=new; excite(p_comp); p==p_chain
  257    %repeat
  258  %end
  259  
  260  %routine make(%record(pinf)%name pin,%integer new,when)
  261  %record(eqf)%name e,f
  262  %integer old
  263    new=new+new %if |new|=rising
  264    %unless when=now %start;   ! Insert this event in event queue
  265      e==eclist; %signal 15 %if e==nil
  266      eclist==e_next; e_next==nil
  267      e_pin==pin; e_state=new; e_when=when
  268      f==eventqueue
  269      %if f==nil %start
  270        eventqueue==e; %return
  271      %finish
  272      %if when<f_when %start
  273        e_next==f; eventqueue==e; %return
  274      %finish
  275      %cycle
  276        %if f_next==nil %start
  277          f_next==e; %return
  278        %finish
  279        %if when<f_next_when %start
  280          e_next==f_next; f_next==e; %return
  281        %finish
  282        f==f_next
  283      %repeat
  284    %finish
  285    old=pin_state; %returnif old=new
  286    pin_state=new; %returnif pin_signal==nil
  287    propagate(pin_signal)
  288  %end
  289  
  290  %routine aftermath;  ! Flush event queue
  291  %record(eqf)%name e
  292    %cycle
  293      e==eventqueue; %returnif e==nil
  294      eventqueue==e_next; e_next==eclist; eclist==e
  295      log(nil,e_when-now)
  296      now=e_when
  297      make(e_pin,e_state,now)
  298    %repeat
  299  %end
  300  
  301  ! Basic logic primitives
  302  ! Note that NOT is just minus
  303  
  304  %integerfn float(%integer x)
  305    x=high %if x=open
  306    x=x+x %if |x|=rising
  307    %result=x
  308  %end
  309  
  310  %integerfn edgefloat(%integer x)
  311    x=undef %if x=open
  312    %result=x
  313  %end
  314  
  315  %integerfn setupfloat(%integer x)
  316    x=high %if x=open %or x=falling
  317    x=low %if x=rising
  318    %result=x
  319  %end
  320  
  321  %integerfn and(%integer x,y)
  322    %result=low %if x=low %or y=low
  323    %result=undef %if x=undef %or y=undef
  324    %result=high
  325  %end
  326  
  327  %integerfn or(%integer x,y)
  328    %result=high %if x=high %or y=high
  329    %result=undef %if x=undef %or y=undef
  330    %result=low
  331  %end
  332  
  333  %integerfn xor(%integer x,y)
  334    %result=undef %if x=undef %or y=undef
  335    %result=low %if x=y
  336    %result=high
  337  %end
  338  
  339  %integerfn oc(%integer x); !open collector
  340    %result=open %if x=high %or x=rising
  341    %result=x
  342  %end
  343  
  344  %constinteger known=13
  345  %conststring(15)%array type(0:known)="???",
  346+ "INV",  "INVO",
  347+ "AND",  "NAND",
  348+ "NANDO","OR",
  349+ "NOR",  "NORO",
  350+ "XOR",  "U74",
  351+ "TSBUF","U374",
  352+ "U123"
  353  
  354  %routine fail(%record(compf)%name c,%record(sigf)%name s,%string(15)m)
  355  %record(pinf)%name p
  356  %integer n
  357    printstring(m)
  358    %unless s==nil %start
  359      printstring(" Net "); printstring(s_name)
  360      p==s_from; n=0
  361      %whilenot p==nil %cycle
  362        n=n+1; p==p_chain
  363      %repeat
  364      write(n,1)
  365      p==s_to; n=0
  366      %whilenot p==nil %cycle
  367        n=n+1; p==p_chain
  368      %repeat
  369      write(n,1); newline
  370    %finish
  371    %unless c==nil %start
  372      printstring(type(c_type)); printstring(" (")
  373      p==c_ins
  374      %whilenot p==nil %cycle
  375        printstring(p_signal_name); p==p_next; printsymbol(',') %unless p==nil
  376      %repeat
  377      printsymbol('/')
  378      p==c_outs
  379      %whilenot p==nil %cycle
  380        printstring(p_signal_name); p==p_next; printsymbol(',') %unless p==nil
  381      %repeat
  382      printsymbol(')'); newline
  383    %finish
  384    %signal 15
  385  %end
  386  
  387  %routine excite(%record(compf)%name comp)
  388  %record(pinf)%name in1,in2,more,out
  389  %integer i1,i2
  390  %switch s(0:known)
  391  %switch t(3:9)
  392  
  393    more==nil; in2==nil
  394    in1==comp_ins
  395    %unless in1==nil %start
  396      i1=in1_state; in2==in1_next
  397      %unless in2==nil %start
  398        more==in2_next; i2=in2_state
  399      %finish
  400    %finish
  401    out==comp_outs
  402    ->s(comp_type)
  403  
  404  s(9): {xor}    i1=xor(float(i1),float(i2)); ->generic
  405  s(3): {and}
  406  s(4): {nand}
  407  s(5): {nando}  i1=and(float(i1),float(i2)); ->generic
  408  s(6): {or}
  409  s(7): {nor}
  410  s(8): {noro}   i1=or(float(i1),float(i2))
  411  generic:
  412    ->t(comp_type) %if more==nil
  413    i2=more_state; more==more_next; ->s(comp_type)
  414  
  415  t(9): {xor}
  416  t(6): {or}
  417  t(3): {and}    make(out,i1,now+1); %return
  418  s(1): {inv}
  419  t(7): {nor}
  420  t(4): {nand}   make(out,-float(i1),now+1); %return
  421  s(2): {invo}
  422  t(8): {noro}
  423  t(5): {nando}  make(out,oc(-float(i1)),now+1); %return
  424  
  425  s(10):{u74}
  426    %begin
  427    %integer d,s0,r0,c
  428    %record(pinf)%name out0
  429  
  430      d=setupfloat(i1); s0=float(i2); r0=float(more_state)
  431      c=edgefloat(more_next_state)
  432      out0==out_next
  433  
  434      %if r0=undef %start
  435        make(out,high,now+1) %if s0=low
  436      %finishelseif s0=undef %start
  437        make(out0,high,now+1) %if r0=low
  438      %finishelseif r0=low %and s0=low %start
  439        make(out,high,now+1); make(out0,high,now+1)
  440      %finishelseif r0=low %start
  441        make(out,low,now+1); make(out0,high,now+1)
  442      %finishelseif s0=low %start
  443        make(out,high,now+1); make(out0,low,now+1)
  444        %if c=rising %and (d=low %or d=undef) %start
  445          make(out0,-d,now+2); make(out0,low,now+3)
  446        %finish
  447      %finishelseif c=rising %start
  448        make(out,d,now+2); make(out0,-d,now+2)
  449      %finish
  450    %end
  451    %return
  452  
  453  s(11): {tsbuf: non-inverting, low-active enable}
  454    i1=float(i1); i2=float(i2)
  455    %if i2=low %then i2=i1 %elsec
  456+   %if i2=high %then i2=open %else i2=undef
  457    make(out,i2,now+1)
  458    %return
  459  
  460  s(12): {u374: clock, enable\ i(0:7) / o(0:7)}
  461  !%begin
  462  !%record(pinf)%namearray in,state,out(0:7)
  463  !%record(pinf)%name p
  464  !%integer i
  465  !  p==comp_private
  466  !  %if p==nil %start
  467  !    %for i=0,1,7 %cycle
  468  !      p==newpin; state(i)==p; p_comp==comp
  469  !    %repeat
  470  !    comp_private==state(0)
  471  !    %for i=0,1,6 %cycle
  472  !      state(i)_next==state(i+1)
  473  !    %repeat
  474  !    state(7)_next==nil
  475  !  %finishelsestart
  476  !    %for i=0,1,7 %cycle
  477  !      state(i)==p; p==p_next
  478  !    %repeat
  479  !  %finish
  480  !  p==comp_outs
  481  !  %for i=0,1,7 %cycle
  482  !    out(i)==p; p==p_next
  483  !  %repeat
  484  !  p==more
  485  !  %for i=0,1,7 %cycle
  486  !    in(i)==p; p==p_next
  487  !  %repeat
  488  !  %if i1=rising %start
  489  !    state(i)_state=setupfloat(in(i)_state) %for i=0,1,7
  490  !  %finish
  491  !  i2=float(i2)
  492  !  %if i2=low %start
  493  !    make(out(i),state(i)_state,now+1) %for i=0,1,7
  494  !  %finishelsestart
  495  !    %if i2=high %then i2=open %else i2=undef
  496  !    make(out(i),i2,now+1) %for i=0,1,7
  497  !  %finish
  498  !%end
  499    %return
  500  
  501  s(13): {u123: a0, b, c0, timeout / q, q0}
  502    %begin
  503   %integer a0,b,c0,timeout
  504    %record(pinf)%name out0
  505    a0=float(i1); b=float(i2); c0=float(more_state)
  506    timeout=more_next_state
  507    out0==out_next
  508    %if c0=low %start
  509      make(out,low,now+1); make(out0,high,now+1)
  510    %finishelseif c0=undef %start
  511      make(out,undef,now+1); make(out0,undef,now+1)
  512    %finishelsestart
  513      b=and(-a0,b)
  514      %if b=high %and out_state=low %start
  515        make(out,high,now+1)
  516        make(out0,low,now+1)
  517      %finishelseif |timeout|=rising %start
  518        make(out,low,now+1)
  519        make(out0,high,now+1)
  520      %finish
  521    %finish
  522    %end
  523    %return
  524  
  525  s(0):
  526  %end
  527  
  528  %string(15)atom,pend=""
  529  %integer sym=nl
  530  %constbyteintegerarray symtype(0:127)=
  531+ 1(33),0(3),2,0(3),2,2,0,0,2,2,0,2,0(16),0(33),3(26),0(5)
  532  !          $      ( )     , -   /
  533  ! 0 normal 1 separator 2 special 3 lower-case
  534  
  535  %routine readatom
  536  %integer st
  537    %unless pend="" %start
  538      atom=pend; pend=""; %return
  539    %finish
  540    %cycle
  541      %cycle
  542        st=symtype(sym&127); %exitunless st=1
  543        readsymbol(sym)
  544      %repeat
  545      %exitunless sym='$'
  546      readsymbol(sym) %until sym='$' %or sym=nl
  547      readsymbol(sym)
  548    %repeat
  549    sym=sym-32 %if st=3
  550    atom=tostring(sym)
  551    %if st=2 %start; !Special on its own
  552      %if sym='-' %start; ! "->" or "/" or "-" equivalent
  553        atom="/"
  554        readsymbol(sym); %returnunless sym='>'
  555      %finish
  556      readsymbol(sym); %return
  557    %finish
  558    readsymbol(sym)
  559    %cycle
  560      st=symtype(sym&127); sym=sym-32 %and st=0 %if st=3
  561      %exitunless st=0
  562      atom=atom.tostring(sym) %unless length(atom)=15
  563      readsymbol(sym)
  564    %repeat
  565  %end
  566  
  567  %record(sigf)%map findsignal
  568  %record(sigf)%name s
  569    s==nets
  570    %whilenot s==nil %cycle
  571      %result==s %if s_name=atom
  572      s==s_next
  573    %repeat
  574    s==newsignal; s_next==nets; nets==s; s_name=atom
  575    %result==s
  576  %end
  577  
  578  %routine readcomponent
  579  %record(compf)%name c
  580  %record(pinf)%name p,plist
  581  %record(sigf)%name s
  582  %integer t,slashes
  583  
  584  %record(pinf)%map reverse(%record(pinf)%name this)
  585  %record(pinf)%name tail,next
  586    tail==nil; %result==nil %if this==nil
  587    %cycle
  588      next==this_next; this_next==tail; tail==this
  589      %result==this %if next==nil; this==next
  590    %repeat
  591  %end
  592  
  593  !%record(pinf)%map reversecopy(%record(pinf)%name list)
  594  !%record(pinf)%name x,y
  595  !  x==nil
  596  !  %cycle
  597  !    %result==x %if list==nil
  598  !    y==newpin; y_next==x; x==y
  599  !    y_comp==c; y_signal==list_signal
  600  !    list==list_next
  601  !  %repeat
  602  !%end
  603  !
  604  !%record(pinf)%map append(%record(pinf)%name tail,list)
  605  !%record(pinf)%name p
  606  !  %result==tail %if list==nil
  607  !  p==list; p==p_next %whilenot p_next==nil; p_next==tail
  608  !  %result==list
  609  !%end
  610  
  611    readatom; %signal 9 %if atom="END"
  612    %for t=1,1,known %cycle
  613      ->ok %if type(t)=atom
  614    %repeat
  615    printstring("Unknown component "); printstring(atom); newline
  616    t=0
  617  ok: c==newcomp; c_type=t
  618    c_next==components; components==c
  619    slashes=0; plist==nil
  620    readatom
  621    printstring("( expected") %and newline %unless atom="("
  622  !Non-ESDL-compatible notation:  comp(ins{{/inouts}/outs})
  623  !  readatom
  624  !  %cycle
  625  !    %if atom="/" %or atom=")" %start
  626  !      %if slashes=0 %start
  627  !        c_ins==reverse(plist); %exitif atom=")"
  628  !        slashes=1
  629  !      %finishelsestart
  630  !        %if atom=")" %start
  631  !          c_outs==append(reverse(plist),c_outs); %exit
  632  !        %finish
  633  !        c_ins==append(reversecopy(plist),c_ins)
  634  !        c_outs==reverse(plist)
  635  !      %finish
  636  !      plist==nil
  637  !      readatom
  638  !    %finishelsestart
  639  !      printstring("Unexpected (") %and newline %if atom="("
  640  !      printstring("Unexpected ,") %and newline %if atom=","
  641  !      s==nil; s==findsignal %unless atom="?"
  642  !      p==newpin; p_next==plist; plist==p
  643  !      p_comp==c; p_signal==s; p_state=open %if s==nil
  644  !      readatom
  645  !      %if atom="," %then readatom %elsestart
  646  !        printstring(", expected") %and newline %unless atom="/" %or atom=")"
  647  !      %finish
  648  !    %finish
  649  !  %repeat
  650  !ESDL-compatible notation: comp(ins)->outs
  651  ! This requires pending atom and disallows inouts
  652    %cycle
  653      readatom
  654      %if atom=")" %or atom="," %or atom="/" %start
  655        printstring(atom); printstring(" not expected"); newline
  656        %exit
  657      %finish
  658      s==nil; s==findsignal %unless atom="?"
  659      p==newpin; p_next==plist; plist==p
  660      p_comp==c; p_signal==s; p_state=open %if s==nil
  661      readatom
  662      %exitif atom=")" %or atom="/"
  663      printstring(", expected") %and newline %unless atom=","
  664    %repeat
  665    readatom %if atom=")"
  666    printstring("-> expected") %and newline %unless atom="/"
  667    c_ins==reverse(plist); plist==nil
  668    %cycle
  669      readatom
  670      printstring(", not expected") %and newline %if atom=","
  671      s==nil; s==findsignal %unless atom="?"
  672      p==newpin; p_next==plist; plist==p
  673      p_comp==c; p_signal==s; p_state=open %if s==nil
  674      readatom; %exitunless atom=","
  675    %repeat
  676    pend=atom %unless atom=")"
  677    c_outs==reverse(plist); plist==nil
  678    p==c_ins
  679    %whilenot p==nil %cycle
  680      s==p_signal
  681      p_chain==s_to %and s_to==p %unless s==nil
  682      p==p_next
  683    %repeat
  684    p==c_outs
  685    %whilenot p==nil %cycle
  686      s==p_signal
  687      p_chain==s_from %and s_from==p %unless s==nil
  688      p==p_next
  689    %repeat
  690  %end
  691  
  692  %routine simulate
  693  %integer command,i
  694  %record(compf)%name c
  695  %record(sigf)%name s
  696  
  697  %routine identify
  698    readatom
  699    s==findsignal
  700    %if s_from==nil %and s_to==nil %start
  701      s==nil; printstring("Not connected"); newline
  702    %finish
  703  %end
  704  
  705    initialise arrays
  706    escape(clearscreen); newline
  707  
  708  %cycle
  709    escape(home); escape(clearline); newline
  710    prompt(tostring(esc).tostring(up)."scuovpdr+-?:")
  711    escape(clearline); newline
  712    readsymbol(command) %until command>' '
  713    command=command!32
  714    %stopif command=':'
  715    %if command='-' %start
  716      identify
  717      %unless s==nil %start
  718        i=s_screenslot
  719        %unless i=0 %start
  720          slot(i)==nil
  721          s_screenslot=0
  722          cursor(0,i+i+1); escape(clearline)
  723          cursor(0,i+i);   escape(clearline)
  724          newline; !??
  725        %finish
  726      %finish
  727    %finishelseif command='+' %start
  728      identify
  729      %unless s==nil %start
  730        %if s_screenslot=0 %start
  731          %for i=1,1,slotmax %cycle
  732            %if slot(i)==nil %start
  733              slot(i)==s; s_screenslot=i
  734              refresh(i)
  735              %exit
  736            %finish
  737          %repeat
  738        %finish
  739      %finish
  740    %finishelseif command='r' %start
  741      refresh(i) %for i=1,1,slotmax
  742    %finishelseif command='?' %start
  743      identify
  744      %unless s==nil %start
  745        printstring(atom); printstring(" = "); print(s_state); newline
  746      %finish
  747    %finishelseif command='s' %start
  748      identify
  749      %unless s==nil %start
  750        s_state=rising; propagate(s)
  751        s_state=high; propagate(s)
  752        aftermath
  753      %finish
  754    %finishelseif command='c' %start
  755      identify
  756      %unless s==nil %start
  757        s_state=falling; propagate(s)
  758        s_state=low; propagate(s)
  759        aftermath
  760      %finish
  761    %finishelseif command='u' %start
  762      identify
  763      %unless s==nil %start
  764        s_state=undef; propagate(s)
  765        aftermath
  766      %finish
  767    %finishelseif command='o' %start
  768      identify
  769      %unless s==nil %start
  770        s_state=open; propagate(s)
  771        aftermath
  772      %finish
  773    %finishelseif command='v' %start
  774      identify
  775      %unless s==nil %start
  776      %if |s_state|=high %start
  777        s_state=-s_state//2; propagate(s)
  778        s_state=s_state<<1; propagate(s)
  779        aftermath
  780      %finish
  781      %finish
  782    %finishelseif command='p' %start
  783      identify
  784      %unless s==nil %start
  785      %if |s_state|=high %start
  786        s_state=-s_state//2; propagate(s)
  787        s_state=s_state<<1; propagate(s)
  788        aftermath
  789        s_state=-s_state//2; propagate(s)
  790        s_state=s_state<<1; propagate(s)
  791        aftermath
  792      %finish
  793      %finish
  794    %finishelseif command='d' %start
  795      s==nets
  796      %cycle
  797        %if s_state=undef %start
  798          prompt(s_name." = "); readsymbol(sym)
  799          %if sym#nl %start
  800            sym=sym!32
  801            %if sym='h' %start
  802              s_state=rising; propagate(s)
  803              s_state=high; propagate(s)
  804            %finishelseif sym='l' %start
  805              s_state=falling; propagate(s)
  806              s_state=low; propagate(s)
  807            %finishelseif sym='o' %start
  808              s_state=open; propagate(s)
  809            %finishelse sym=0
  810            aftermath %unless sym=0
  811            readsymbol(sym) %until sym=nl
  812          %finish
  813        %finish
  814        s==s_next
  815      %repeatuntil s==nil
  816    %finish
  817  %repeat
  818  %end
?C unused
  819  
  820  %integer stream=1
  821  
  822  %onevent 9 %start
  823    %stopif stream=0; stream=0
  824  %finish
  825  
  826  selectinput(stream)
  827  simulate %if stream=0
  828  %cycle
  829    readcomponent
  830  %repeat
  831  
  832  %endofprogram
?FAIL unused

  788 Statements compiled
