!! SIM       *** 12/11/79 - includes ROM and RAM but there are bugs in
!!                        update inputs when the gate has multiple outputs
%BEGIN
%OWNSTRING(31) HEADING="SIM version 4.3 (VAX)"

%EXTERNAL %STRING(63) %FN %SPEC ITOS(%INTEGER N, P)
%EXTERNALSTRING(127)%FNSPEC CLIPARAM
%EXTERNALINTEGERFNSPEC DEF STREAMS(%STRING(127) STREAMS,DEFAULTS)
%INTEGER RETURN CODE
%OWNSTRING(47) DEFAULTS=".FIC,.CMD,ESDL:SIMULATR.PRM/%I1.TRC"

!! portability section
%CONSTINTEGER CPW=4;      !! characters per word
%CONSTINTEGER LCPW=2;     !! log characters per word
%CONSTINTEGER AUPW=4;     !! Addressing units per word
%CONSTINTEGER LAUPW=2;    !! Log addressing units per word
%CONSTINTEGER BPW=32;     !! Bits per word 
%CONSTINTEGER LBPW=5;      !! Log2 bits per word
%CONSTINTEGER MAXINTEGER=(-1)>>1

!! I/O streams
%CONSTINTEGER CONSOLE=0;   !! terminal report stream
%CONSTINTEGER CIRCUIT=1;   !! circuit to be  simulated
%CONSTINTEGER KEYWORDS=3;  !! keywords for initialisation

%CONSTINTEGER EVENTS=1;    !! main output stream
%CONSTINTEGER DUMP=3;      !! diagnostic dump stream

!! character interface
%CONSTINTEGER ENDFILE=9,   END OF FILE=-1,   END OF STRING=-1

%CONSTINTEGER CNTRL=128,   CNTRL CHAR='^'
%OWNINTEGER CH
%OWNINTEGER OUTSTREAM

!! workspace
%CONSTINTEGER STACKLEN=6000
%INTEGERARRAY STACK(0:STACKLEN)

%OWNINTEGER TOS,   BOS,   STACKTOP,   MAXTOS

!! string and tag mapping

%RECORDFORMAT FTAG(%INTEGER HNEXT, VALUE,
                   %RECORD(*)%NAME OWNER,
                   %STRING(255) S)
%RECORD(FTAG)%NAME NONAME
%CONSTINTEGER TAGLEN=3

!! gate delays
%RECORDFORMAT DELAYSF(%INTEGERARRAY D(1:4), %RECORD(DELAYSF)%NAME NEXT)
%CONSTINTEGER DELAYSLEN=5

%RECORD(DELAYSF)%NAME DEFAULT DELAYS,   DELAYS,   ZERODELAYS

%RECORDFORMAT GTYPEF(%INTEGER NIN, NOUT,
                     %RECORD(FTAG)%NAME NAME,
                     %RECORD(GTYPEF)%NAME NEXT)
%CONSTINTEGER GTYPELEN=4
%RECORD(GTYPEF)%NAME GTYPES

%RECORDFORMAT INPUTF(%BYTEINTEGER VALUE, P, junk1, junk2,
                     %INTEGER NK)
%CONSTINTEGER INPUTLEN=2
%RECORDFORMAT INPUTSF(%RECORD(INPUTF)%ARRAY INPUT(1:255))

%RECORDFORMAT OUTPUTF(%BYTEINTEGER VALUE, FLAG, junk1, junk2,
                      %INTEGER RANK,
                      %RECORD(GATEF)%NAME GATE,
                      %RECORD(FTAG)%NAME NAME,
                      %RECORD(ONEVF)%NAME ONEV,
                      %RECORD(CONNF)%NAME LINK)
%CONSTINTEGER OUTPUTLEN=6
%RECORDFORMAT OUTPUTSF(%RECORD(OUTPUTF)%ARRAY OUTPUT(1:1254))

%RECORDFORMAT EVENTF1(%RECORD(EVENTF)%NAME NEXT,
                     %RECORD(GATEF)%NAME GATE,
                     %RECORD(INPUTF)%NAME INPUT,
                     %INTEGER TIME, TRANSITION, RANK)

%RECORDFORMAT EVENTF2(%RECORD(EVENTF)%NAME NEXT,
                      %RECORD(GATEF)%NAME GATE,
                      %RECORD(TELF)%NAME TRACE,
                      %INTEGER TIME, TRANSITION, RANK)

%RECORDFORMAT EVENTF3(%RECORD(EVENTF)%NAME NEXT,
                      %STRING(255)%NAME NAME,
                      %INTEGER NEWVALUE,
                      %INTEGER TIME, TRANSITION, RANK)

%RECORDFORMAT EVENTF(EVENTF1 %OR EVENTF2 %OR EVENTF3)
%CONSTINTEGER EVENTLEN=6

!!...trace element formats..........................
!! COUNT=-1 => primitive (atomic) element 
!! COUNT=0  => TAG points at a named trace
!! COUNT>0  => SUB points at a trace to be repeated COUNT times
!!..................................................

%RECORDFORMAT TELF1(%RECORD(TELF)%NAME NEXT,  SUB,
                    %INTEGER LENGTH, VALUE, COUNT)

%RECORDFORMAT TELF2(%RECORD(TELF)%NAME NEXT,
                    %RECORD(FTAG)%NAME TAG,
                    %INTEGER LENGTH, VALUE, COUNT)

%RECORDFORMAT TELF(TELF1 %OR TELF2)
%CONSTINTEGER TELLEN=5

%RECORDFORMAT CONNF(%RECORD(GATEF)%NAME GATE,
                    %RECORD(INPUTF)%NAME INPUT,
                    %RECORD(CONNF)%NAME LINK)
%CONSTINTEGER CONNLEN=3

%RECORDFORMAT CONDF1(%BYTEINTEGER V,N, junk1, junk2,
                     %RECORD(OUTPUTF)%NAME OUTPUT, DUMMY,
                     %RECORD(ONEVF)%NAME ONEV)

%RECORDFORMAT CONDF2(%BYTEINTEGER V, N, junk1, junk2,
                     %RECORD(CONDF)%NAME L, R,
                     %RECORD(ONEVF)%NAME ONEV)

%RECORDFORMAT CONDF(CONDF1 %OR CONDF2)

%RECORDFORMAT ONEVF(%RECORD(TELF)%NAME TRACE,
                    %RECORD(OUTPUTF)%NAME OUTPUT,
                    %RECORD(CONDF)%NAME COND,
                    %RECORD(GPELF)%NAME NEXT)

%RECORDFORMAT GPELF(CONDF1 %OR CONDF2 %OR ONEVF)
%CONSTINTEGER GPELLEN=4

%RECORDFORMAT GATEF(%RECORD(GTYPEF)%NAME TYPE,
                    %RECORD(DELAYSF)%NAME DELAYS,
                    %INTEGER FN,
                    %RECORD(INPUTSF)%NAME INPUTS,
                    %RECORD(OUTPUTSF)%NAME OUTPUTS,
                    %INTEGER DEFAULT,
                    %INTEGERARRAY M(0:16000))
%CONSTINTEGER GATELEN=5

%RECORD(GATEF)%NAME CIRCUIT HEADER
%INTEGER NOGATES

%RECORDFORMAT GATESF(%RECORD(GATEF)%NAME %ARRAY GATE(0:1000))
%RECORD(GATESF)%NAME GATES

!! useful constants
%CONSTINTEGER NULL=0,   NCOMMANDS=22
%CONSTINTEGER YES=0,   NO=-1,   OK=0
%CONSTINTEGER A DELAY=5,   PVALUE=6
%CONSTINTEGER LO=0,   HALF=1,   HI=2
%CONSTINTEGER HELD=16_80,   SMASK=3
%OWNINTEGERARRAY SIGVAL(LO:HI)='0', 'X', '1'

!! errors
%CONSTINTEGER WARNING=0,   ERROR=1,   DISASTER=2
%OWNINTEGER NERRORS=0
%ROUTINE RCH

   !! Read the next character from the input
   %INTEGER I,   L
   %ON %EVENT ENDFILE %START
      CH=END OF FILE
      ->OUT
   %FINISH
START:
   %CYCLE
      READSYMBOL(CH)
   %REPEAT %UNTIL CH#NL
   %IF CH=CNTRL CHAR %START
      READSYMBOL(CH)
      CH=CH+CNTRL
   %FINISH
   %IF CH=CNTRL+'K' %START
      !! Read the comment text (self defining string)
      READ(L);   RCH
      %FOR I=1,1,L %CYCLE
         RCH
      %REPEAT
      ->START
   %FINISH
OUT:
%END
 
%ROUTINE SKIP TO(%INTEGER WHERE)
   RCH %WHILE CH#WHERE
%END

%ROUTINE REPORT( %STRING(63) S, %INTEGER SEVERE)
   SELECTOUTPUT(CONSOLE)
   PRINTSYMBOL('*') %AND NERRORS=NERRORS+1 %IF SEVERE>WARNING
   PRINTSTRING(S)
   NEWLINE
   SELECTOUTPUT(OUTSTREAM)
   %STOP %IF SEVERE=DISASTER
%END

%ROUTINE ZERO(%INTEGER NWORDS)
   !! ZERO the top NWORDS of the stack
   %INTEGER I,   P
   P=TOS
   %FOR I=1,1,NWORDS %CYCLE
      INTEGER(P)=0
      P=P+AUPW
   %REPEAT
%END

!! hashtable 
%CONSTINTEGER HASHTABLE LEN=127;   !! must be 2**N-1
%OWNINTEGERARRAY HASHTABLE(0:HASHTABLE LEN)=NULL(*)

!DIAGNOSTICS
%ROUTINE PHEX(%INTEGER H)
   ! routine to print a hexadecimal number
   %INTEGER I,C
   %FOR I=1,1,(BPW>>2) %CYCLE
      C=H>>(BPW-4)
      %IF C<10 %THEN C=C+'0' %ELSE C=C+'A'-10
      PRINTSYMBOL(C)
      H=H<<4
   %REPEAT
%END

%ROUTINE DUMP STACK
   ! dump the stack in hex format, 8-words to the line
   ! followed by character equivalent
   %INTEGER P,   I,   L,   Q,   END
   %CONSTINTEGER MASK=15
   %OWNBYTEINTEGERARRAY ASCII(0:127)='.'(32),
   '.', '!','"','#','$','%','&', '''', '(',
   ')', '*', '+', ',', '-', '.', '/', '0','1',
   '2','3','4','5','6','7','8','9', ':', ';',
    '<', '=', '>', '?', '@','A','B','C','D',
   'E','F','G','H','I','J','K','L','M','N','O',
   'P','Q','R','S','T','U','V','W','X','Y','Z',
    '[', '^', ']', '^', '.', '.','a','b','c',
   'd','e','f','g','h','i','j','k','l','m','n',
   'o','p','q','r','s','t','u','v','w','x','y',
   'z', '.'(5)
   SELECTOUTPUT(DUMP)
   P=ADDR(STACK(0));   END=TOS
START:
   Q=P
   ! print the address
   NEWLINE
   PHEX(P); PRINTSYMBOL(':')
   %CYCLE
      %IF P&MASK=0 %OR P=END %START
         SPACES(4)
         ! output character equivalent of line
         L=(((P-Q)>>LAUPW)<<LCPW)-1
         %FOR I=0,1,L %CYCLE
            PRINTSYMBOL(ASCII(BYTEINTEGER(Q+I)&127))
         %REPEAT
         Q=P
         NEWLINE
         ! and print the address again
         PHEX(P); PRINTSYMBOL(':')
      %FINISH
      %EXIT %IF P=END
      SPACE; PHEX(INTEGER(P))
      P=P+AUPW
   %REPEAT
   NEWLINE
   %IF END#(STACKTOP+1)<<LAUPW %START
      END=(STACKTOP+1)<<LAUPW
      P=BOS<<LAUPW
      ->START
   %FINISH
   SELECTOUTPUT(EVENTS)
%END
!DIAGNOSTIC END

%ROUTINE CLAIM(%INTEGER NWORDS)
!! claim NWORDS of the stack
   TOS=(TOS>>LAUPW)+NWORDS
   REPORT("Workspace full",DISASTER) %IF TOS>BOS
   MAXTOS=TOS %IF TOS>MAXTOS
   TOS=TOS<<LAUPW
%END

%STRING(255)%MAP READ STRING
   %STRING(255)%NAME S
   %INTEGER LEN,   I
!! read a string from the I-code and map it at the end of the stack
   READ(LEN);   RCH
   S==STRING((BOS-(LEN+CPW)>>LCPW)<<LAUPW)
   %FOR I=1,1,LEN %CYCLE
      RCH
      CHARNO(S,I)=CH
   %REPEAT
   CHARNO(S,0)=LEN
   %RESULT==S
%END

%ROUTINE SKIP NUM
   %INTEGER DISCARD
   READ(DISCARD)
%END

%STRING(255)%MAP MAP STRING(%STRING(255) S)
   %STRING(255)%NAME N
   N==STRING((BOS-(LENGTH(S)+CPW)>>LCPW)<<LAUPW)
   N=S
   %RESULT==N
%END

%OWNINTEGER POSN=0

%ROUTINE READSYM(%INTEGERNAME CH)
   READSYMBOL(CH)
   POSN=POSN+1
%END

%ROUTINE SKIPSYM
   SKIPSYMBOL
   POSN=POSN+1
%END

%INTEGERFN NEXTSYM
   %INTEGER CH
   CH=NEXTSYMBOL
   CH=CH-'a'+'A' %IF 'a'<=CH<='z'
   %RESULT=CH
%END

%ROUTINE SKIP TO NL 
   SKIPSYM %WHILE NEXTSYMBOL#NL
%END

%ROUTINE SKIP LINE
   SKIP TO NL
   SKIPSYM
   POSN=0
%END

%ROUTINE SKIP BLANKS 
   SKIPSYM %WHILE NEXTSYMBOL=' '
%END

%ROUTINE SKIP ITEM
   SKIPSYM
   SKIP BLANKS
%END

%ROUTINE RDEC(%INTEGERNAME N)
   %INTEGER CH
   SKIP BLANKS
   N=0
   %WHILE '0'<=NEXTSYMBOL<='9' %CYCLE
      READSYM(CH)
      N=N*10+CH-'0'
   %REPEAT
   SKIP BLANKS
%END

%STRING(255)%MAP GET STRING
   %CONSTINTEGER NTERMINATORS=9
   %OWNINTEGERARRAY TERMINATOR(1:NTERMINATORS)= %C
   '@','&','+',' ', ',', '=', '(', ')', NL
   %INTEGER LEN,   CH,   I
   %STRING(63) S
   LEN=0
   SKIP BLANKS
   %CYCLE
      CH=NEXTSYMBOL
      %FOR I=1,1,NTERMINATORS %CYCLE
         ->OUT %IF CH=TERMINATOR(I)
      %REPEAT
      LEN=LEN+1
      CH=CH-'a'+'A' %IF 'a'<=CH<='z'
      SKIPSYM;   !! force SIGNAL 9 before trying to
      CHARNO(S,LEN)=CH; !! assign -1 to a byte
   %REPEAT
OUT:
   SKIP BLANKS
   CHARNO(S,0)=LEN
   %RESULT==MAP STRING(S)
%END

%OWNINTEGER TAGTYPE=0;   !! used to type TAGs

%RECORD(FTAG)%MAP STORE TAG(%STRING(255)%NAME S)
!! assume that S is already on the end of the stack
!! but that space has not yet been claimed for it
   %RECORD(FTAG)%NAME OLD,   NEW
   %INTEGER HASH,   I
   %INTEGERNAME H 
   HASH=TAGTYPE;   TAGTYPE=0
   %FOR I=0,1,LENGTH(S) %CYCLE
      HASH=HASH+CHARNO(S,I)
   %REPEAT
   H==HASHTABLE(HASH&HASHTABLELEN)
   %WHILE H#NULL %CYCLE
      OLD==RECORD(H)
      %RESULT==OLD %IF OLD_S=S
      H==OLD_HNEXT
   %REPEAT
   !! create a new TAG
   BOS=BOS-TAGLEN-(LENGTH(S)+CPW)>>LCPW
   H=BOS<<LAUPW 
   NEW==RECORD(H)
   NEW_HNEXT=0
   NEW_VALUE=511;   !! default value for undefined fn and undefined signal
   NEW_OWNER==RECORD(NULL)
   %RESULT==NEW
%END

%ROUTINE REMOVE(%RECORD(FTAG)%NAME TAG)
!! remove TAG from the hash table
%RECORD(FTAG)%NAME OLD
%INTEGER HASH, I
%INTEGERNAME H
   HASH=TAGTYPE;   TAGTYPE=0
   %FOR I=0,1,LENGTH(TAG_S) %CYCLE
      HASH=HASH+CHARNO(TAG_S,I)
   %REPEAT
   H==HASHTABLE(HASH&HASHTABLELEN)
   %WHILE H#NULL %CYCLE
      OLD==RECORD(H)
      %IF OLD==TAG %START
         H=OLD_HNEXT
         BOS=BOS+TAGLEN+(LENGTH(TAG_S)+CPW)>>LCPW
         %EXIT
      %FINISH %ELSE H==OLD_HNEXT
   %REPEAT
%END

%ROUTINE PRINT TAG(%RECORD(FTAG)%NAME TAG)
   %IF TAG==RECORD(NULL) %START
      PRINTSYMBOL('?')
   %FINISH %ELSE %START
      PRINTSTRING(TAG_S)
   %FINISH
%END

%OWNINTEGER STRINGLEN=-1

%ROUTINE GETCH
   READ(STRINGLEN) %AND RCH %IF STRINGLEN<0
   CH=END OF STRING %AND %RETURN %IF STRINGLEN=0
   RCH
   STRINGLEN=STRINGLEN-1
%END

%ROUTINE FLUSH
   GETCH %WHILE STRINGLEN>0 
   STRINGLEN=-1
%END

%ROUTINE RNUM(%INTEGERNAME RESULT)
   %INTEGER SIGN,   N 
   GETCH
   %IF CH='-' %THEN SIGN=-1 %AND GETCH %ELSE SIGN=1
   %RETURN %UNLESS '0'<=CH<='9' 
   N=0
   %WHILE '0'<=CH<='9' %CYCLE 
      N=N*10+CH-'0'
      GETCH
   %REPEAT
   N=-N %IF SIGN<0
   RESULT=N
%END

%ROUTINE READ KEYWORDS
!! read the pre defined words and put them in the dictionary
   %RECORD(FTAG)%NAME TAG
   %INTEGER V, A, B
   SELECTINPUT(KEYWORDS)
   RCH
   %WHILE CH='*' %CYCLE
      TAG==STORE TAG(GET STRING)
      V=0
      %CYCLE
         READ(A)
         %IF NEXTSYMBOL='<' %START
            SKIPSYMBOL
            READ(B)
            A=A<<B
         %FINISH
         V=V+A
         %EXIT %UNLESS NEXTSYMBOL='+'
         SKIPSYMBOL
      %REPEAT
      TAG_VALUE=V 
      RCH
   %REPEAT
%END

%RECORD(GTYPEF)%MAP ADD TYPE(%RECORD(GTYPEF)%NAME GTYPE)
!! scan the list of types for GTYPE
!! return it if it already exists, otherwise add GTYPE
!! to the list and claim space for it.
   %RECORD(GTYPEF)%NAME G
   G==GTYPES
   %WHILE %NOT G==RECORD(NULL) %CYCLE
      %IF G_NAME==GTYPE_NAME %START
         !! could be the same
         %RESULT==G %IF G_NIN=GTYPE_NIN %AND G_NOUT=GTYPE_NOUT
      %FINISH
      G==G_NEXT
   %REPEAT
   !! claim space for the new one
   GTYPE_NEXT==GTYPES;   GTYPES==GTYPE
   CLAIM(GTYPELEN)
   %RESULT==GTYPE
%END

%RECORD(DELAYSF)%MAP ADD DELAYS(%RECORD(DELAYSF)%NAME DELAY)
!! search the list of delays for the delay element DELAY
!! return it found, otherwise add DELAY to the list
!! and claim space for it on the stack
   %INTEGER I
   %RECORD(DELAYSF)%NAME D
   D==DELAYS
   %WHILE %NOT D==RECORD(NULL) %CYCLE 
      %FOR I=1,1,4 %CYCLE
         ->NEXT %UNLESS D_D(I)=DELAY_D(I) 
      %REPEAT
      !! found the delay element
      %RESULT==D
NEXT:
      D==D_NEXT
   %REPEAT
   !! add the new delay element to the list
   DELAY_NEXT==DELAYS;   DELAYS==DELAY
   CLAIM(DELAYSLEN)
   %RESULT==DELAY 
%END

%ROUTINE PROPAGATE DELAYS(%RECORD(DELAYSF)%NAME DELAYS)
!! fill out default delays
   %INTEGERARRAYNAME D
   %INTEGERNAME V
   %INTEGER I 
   D==DELAYS_D
   %FOR I=2,1,4 %CYCLE
      V==D(I) 
      V=D(I>>1) %IF V=0
   %REPEAT
%END

%INTEGERFN CHECK DELAYS(%RECORD(DELAYSF)%NAME DELAYS) 
   %INTEGER RESULT
   %ROUTINE CHECK(%INTEGER MIN, MAX)
      %IF MIN>MAX %START
REPORT("Min delay(".ITOS(MIN,0).") > max delay(".ITOS(MAX,0).")",ERROR)
         RESULT=NO
      %FINISH 
      %IF MIN<=0 %START
         REPORT("Min delay(".ITOS(MIN,0).") is <= 0",ERROR) 
         RESULT=NO
      %FINISH 
   %END 
   RESULT=OK
   CHECK(DELAYS_D(1),DELAYS_D(2))
   CHECK(DELAYS_D(3),DELAYS_D(4))
   %RESULT=RESULT 
%END

%OWNINTEGER DEFAULT BIT=-1

%RECORD(GATEF)%MAP READ GATE(%INTEGER GATENO)
!! read a gate (or circuit header) description
!! from the I-code. Build delay records as we go
   %RECORD(GATEF)%NAME GATE 
   %RECORD(GTYPEF)%NAME GTYPE
   %RECORD(INPUTF)%NAME INPUT 
   %RECORD(OUTPUTF)%NAME OUTPUT
   %RECORD(FTAG)%NAME LABEL
   %INTEGER I,   PNO,   NBITS,   NWORDS,   DEFAULT

%RECORD(GTYPEF)%MAP READ GTYPE(%INTEGER GATENO)
!! read the first part of a header and create
!! the gate-type record. If this is the same
!! as a previously defined GTYPE then the 
!! previous record is used.
   %RECORD(GTYPEF)%NAME GTYPE 
   %RECORD(FTAG)%NAME TAG
   %STRING(31) UNAME
   %INTEGER NIO
   SKIPNUM
   GTYPE==RECORD(TOS)
   READ(GTYPE_NIN);   READ(GTYPE_NOUT);   READ(NIO);   SKIPNUM
   TAGTYPE=2;   !! unique label - don't confuse with tags
   LABEL==STORE TAG(READ STRING)
   UNAME=LABEL_S;  UNAME=UNAME.":" %IF LENGTH(UNAME)>0
   TAG==STORE TAG(READ STRING)
   UNAME=UNAME.TAG_S
   REPORT(UNAME." has input-outputs",ERROR) %IF NIO#0
   GTYPE_NAME==TAG
   !! swop inputs and outputs if circuit header.
   %IF GATENO=0 %START
      NIO=GTYPE_NIN; GTYPE_NIN=GTYPE_NOUT; GTYPE_NOUT=NIO
   %FINISH %ELSE %START
      !! check that gate is recognised, and has only one output
      REPORT(UNAME." not recognised",ERROR) %IF TAG_VALUE&255=255
      %IF GTYPE_NOUT>1 %AND GTYPE_NAME_VALUE&8=0 %START
         !! more than 1 output, and not ROM or RAM
         REPORT(UNAME." has more than one output",ERROR)
      %FINISH
   %FINISH
   !! see if GTYPE already exists 
   GTYPE==ADD TYPE(GTYPE)
   %RESULT==GTYPE
%END
 
%RECORD(DELAYSF)%MAP READ DELAYS
!! read delays from an I-code string
   %RECORD(DELAYSF)%NAME DELAY
   %INTEGER I
   DELAY==RECORD(TOS);   ZERO(DELAYSLEN)
   RNUM(DELAY_D(I)) %FOR I=1,1,4;   !! read the delays
   FLUSH
   PROPAGATE DELAYS(DELAY)
   I=CHECK DELAYS(DELAY)
   !! search existing delay records for this one
   DELAY==ADD DELAYS(DELAY) 
   %RESULT==DELAY 
%END

   !! start of READ GATE
   RCH;   !! skip ^H
   GTYPE==READ GTYPE(GATENO);   !! get the type of the gate
   GATE==RECORD(TOS);   CLAIM(GATELEN)
   GATE_TYPE==GTYPE
   %IF GATENO>0 %THEN GATE_FN=GTYPE_NAME_VALUE&255 %ELSE GATE_FN=-1
   %IF GATE_FN>=16 %THEN GATE_DELAYS==ZERODELAYS %C
   %ELSE GATE_DELAYS==DEFAULT DELAYS
   %IF GATE_FN=10 %OR GATE_FN=9 %START
      !! ROM or RAM
      %IF LABEL_S="" %START
         REPORT("Unlabeled memory element of type ".GTYPE_NAME_S,ERROR)
      %FINISH %ELSE %START
         LABEL_OWNER==GATE;   !! make label point at ROM/RAM
         NBITS=GTYPE_NIN-1;   !! no of bits in address
         %IF GATE_FN=9 %START
            !! got a RAM
            NBITS=NBITS-GTYPE_NOUT-1;   !! subtract DATA and RW
         %FINISH
         NWORDS=((1<<NBITS)*GTYPE_NOUT+BPW-1)>>LBPW
         !! set up default value for memory bits
         %UNLESS 0<=DEFAULT BIT<=1 %START
            SELECTINPUT(CONSOLE)
            %CYCLE
               PROMPT("Default memory value= ")
               SKIP BLANKS
               DEFAULT BIT=NEXTSYMBOL-'0'
               SKIP LINE
               %EXIT %IF 0<=DEFAULT BIT<=1
               PRINTSTRING("Default value must be 0 or 1"); NEWLINE
            %REPEAT
            NEWLINE
            SELECTINPUT(CIRCUIT)
         %FINISH
         GATE_DEFAULT=DEFAULT BIT
         %IF DEFAULT BIT=0 %THEN DEFAULT=0 %ELSE DEFAULT=-1
         GATE_M(I)=DEFAULT %FOR I=0,1,NWORDS-1
         CLAIM(NWORDS+1)
      %FINISH
   %FINISH
   !! look for the delay and value parameters
   PNO=0
   %CYCLE
      RCH %UNTIL CH=CNTRL+'P' %OR CH=CNTRL+'G'
      %EXIT %IF CH=CNTRL+'G';   !! end of gate description
      READ(PNO);   !! parameter number
      %IF PNO=A DELAY %START
         GATE_DELAYS==READ DELAYS
      %FINISH %ELSE %IF PNO=PVALUE %START
         %IF GATE_FN=10 %OR GATE_FN=9 %START
            !! set default ROM or RAM value
            DEFAULT=DEFAULT BIT
            RNUM(DEFAULT);   !! read the value - if there is one
            DEFAULT=DEFAULT&1
            GATE_DEFAULT=DEFAULT
            DEFAULT=-1 %IF DEFAULT=1
            GATE_M(I)=DEFAULT %FOR I=0,1,NWORDS-1
         %FINISH
      %FINISH
   %REPEAT
   !! now allocate the input records for the gate
   GATE_INPUTS==RECORD(TOS)
   %FOR I=1,1,GTYPE_NIN %CYCLE
      INPUT==RECORD(TOS)
      ZERO(INPUTLEN);   CLAIM(INPUTLEN)
      INPUT_VALUE=HALF
   %REPEAT
   !! and allocate output areas
   GATE_OUTPUTS==RECORD(TOS)
   %FOR I=1,1,GTYPE_NOUT %CYCLE
      OUTPUT==RECORD(TOS)
      ZERO(OUTPUTLEN);   CLAIM(OUTPUTLEN)
      OUTPUT_NAME==NONAME
      OUTPUT_VALUE=HALF+HALF<<2
      OUTPUT_GATE==GATE
   %REPEAT
   !! and return the built gates
   %RESULT==GATE
%END

!!*************************************************
!! routines for parsing the TRACE definition      *
!! notation - and building control block repres'n *
!!************************************************* 
 
%RECORD(TELF)%NAME FREE ELEMENTS
FREE ELEMENTS==RECORD(NULL)

%RECORD(TELF)%MAP NEW ELEMENT
!! allocate a new trace element
!! use a previously de-allocated one if possible
   %RECORD(TELF)%NAME T
   %IF FREE ELEMENTS==RECORD(NULL) %START
      T==RECORD(TOS);   ZERO(TELLEN);   CLAIM(TELLEN)
   %FINISH %ELSE %START
      T==FREE ELEMENTS;   FREE ELEMENTS==FREE ELEMENTS_NEXT
      T_NEXT==RECORD(NULL);   T_SUB==RECORD(NULL)
      T_LENGTH=0;   T_VALUE=0;   T_COUNT=0
   %FINISH
   %RESULT==T
%END

%ROUTINE FREE TRACE(%RECORD(TELF)%NAME T)
   %RECORD(TELF)%NAME NEXT
   %WHILE %NOT T==RECORD(NULL) %CYCLE
      NEXT==T_NEXT
      FREE TRACE(T_SUB) %IF T_COUNT>0
      T_NEXT==FREE ELEMENTS 
      FREE ELEMENTS==T
      T==NEXT
   %REPEAT
%END

!!...TOKEN interface for parsing trace definition notation
%OWNINTEGER TOKEN,   TOKEN VALUE,   TOKENPOS,   VALUE POS
%RECORD(FTAG)%NAME TAG
%CONSTINTEGER A TAG=1,   A NUMBER=2,   A VALUE=3,   AN ERROR=4

%ROUTINE READ TOKEN
   %INTEGER CH
   TAG==RECORD(NULL);   TOKEN VALUE=0
START:
   SKIP BLANKS
   CH=NEXTSYM;   TOKEN=CH
   TOKENPOS=POSN+1
   %RETURN %IF CH=NL
   %IF CH='$' %START
      !! a comment - terminated by $ or NL
      %CYCLE
         SKIPSYM
         CH=NEXTSYM
         %EXIT %IF CH='$' %OR CH=NL
      %REPEAT
      SKIPSYM %IF CH='$'
      ->START
   %FINISH %ELSE %IF CH='%' %START
      !! continuation 
      SKIPSYM
      %IF NEXTSYM='C' %START
         SKIP LINE
         PROMPT(" % ")
         ->START
      %FINISH
   %FINISH %ELSE %IF CH='@' %START
      !! reference to a named trace
      SKIPSYM;   SKIP BLANKS
      VALUE POS=TOKEN POS
      TAGTYPE=1
      TAG==STORE TAG(GET STRING)
      TOKEN=A TAG
   %FINISH %ELSE %IF '0'<=CH<='9' %START
      !! got a number
      RDEC(TOKEN VALUE) 
      TOKEN=A NUMBER
   %FINISH %ELSE %START 
      SKIPSYM;   TOKEN=A VALUE
      %IF CH='L' %START
         TOKEN VALUE=0
      %FINISH %ELSE %IF CH='R' %START 
         TOKEN VALUE=2
      %FINISH %ELSE %IF CH='H' %START
         TOKEN VALUE=34
      %FINISH %ELSE %IF CH='F' %START
         TOKEN VALUE=32
      %FINISH %ELSE %START
         TOKEN=CH
      %FINISH
      VALUE POS=TOKEN POS %IF TOKEN=A VALUE
   %FINISH
%END

%ROUTINE FAIL(%STRING(63) MESSAGE, %INTEGER WHERE)
   SKIP TO NL
   SPACES(WHERE+2);   PRINTSYMBOL('!');   NEWLINE
   REPORT(MESSAGE,ERROR)
   TOKEN=AN ERROR
%END

%RECORD(TELF)%MAP %SPEC GET TRACE

%RECORD(TELF)%MAP TRACE ELEMENT
!! parse and build the definition of a trace element
!! Trace elements can be:-
!! (1) a trace enclosed in parentheses
!! (2) a reference to a named trace ( '@' <name> )
!! (3) a primitive element (L, R, H, F) followed by a length
   %RECORD(TELF)%NAME TEL,   T
   %INTEGER LENGTH
   TEL==RECORD(NULL)
   %IF TOKEN='(' %START
      READ TOKEN
      TEL==GET TRACE
      ->OUT %IF TOKEN=AN ERROR
      FAIL("Missing ')'",POSN)  %AND -> OUT %UNLESS TOKEN=')'
      READTOKEN 
      %IF TOKEN='*' %START
         READTOKEN;   TEL_COUNT=MAXINTEGER
      %FINISH %ELSE %IF TOKEN=A NUMBER %START
         TOKEN VALUE=MAXINTEGER %IF TOKEN VALUE=0
         TEL_COUNT=TOKEN VALUE
         READTOKEN
      %FINISH
      !! fail if sequence is cyclic and ends don't match
      FAIL("Transition out of cyclic sequence",VALUE POS) %C
         %AND ->OUT %IF TEL_COUNT>1 %AND (TEL_VALUE>>4)#(TEL_VALUE&15)
   %FINISH %ELSE %IF TOKEN=A TAG %START
      TEL==NEW ELEMENT
      TEL_TAG==TAG
      T==TAG_OWNER
      %IF T==RECORD(NULL) %THEN TEL_VALUE=255 %ELSE TEL_VALUE=T_VALUE
      READTOKEN
   %FINISH %ELSE %IF TOKEN=A VALUE %START
      TEL==NEW ELEMENT
      TEL_VALUE=TOKEN VALUE
      READTOKEN;   LENGTH=1
      %IF TOKEN=A NUMBER %START
         LENGTH=TOKEN VALUE
         FAIL("Invalid length",TOKENPOS) %AND ->OUT %IF LENGTH<1
         READTOKEN
      %FINISH
      TEL_LENGTH=LENGTH;   TEL_COUNT=-1
   %FINISH
OUT:
   %RESULT==TEL 
%END

%RECORD(TELF)%MAP GET TRACE
!! parse and build a complete trace, comprising
!! any number of trace elements
   %RECORD(TELF)%NAME TEL,   T
   %RECORD(TELF)  TR
   %INTEGER V1, V2
   TR_NEXT==RECORD(NULL);   TR_VALUE=255
   T==TR
   %WHILE TOKEN='(' %OR TOKEN=A TAG %OR TOKEN=A VALUE %CYCLE
      TEL==TRACE ELEMENT
      T_NEXT==TEL
      ->OUT %IF TOKEN=AN ERROR
      !! check the value sequence
      V1=T_VALUE&15;   V2=TEL_VALUE>>4
      %UNLESS V1=15 %OR V2=15 %START
         %UNLESS V2=V1 %START
            FAIL("Transition out of sequence",VALUE POS)
            ->OUT
         %FINISH
      %FINISH 
      T==T_NEXT
   %REPEAT
   !! fail if no trace found
   FAIL("Missing trace element",TOKEN POS) %AND ->OUT %C
      %IF TR_NEXT==RECORD(NULL)
   !! create a unique element to represent the trace
   TEL==NEW ELEMENT
   TEL_SUB==TR_NEXT;   TEL_COUNT=1;   TEL_LENGTH=0
   TEL_VALUE=TR_NEXT_VALUE&(15<<4)+T_VALUE&15
   TR_NEXT==TEL
OUT:
   %RESULT==TR_NEXT
%END

!!*************************************************
!! routines for parsing conditional expressions   *
!! and building the relevant control-blocks       *
!!*************************************************

%RECORD(GPELF)%NAME FREE GPELS
%RECORD(ONEVF)%NAME ON EVENTS

FREE GPELS==RECORD(NULL);   ON EVENTS==RECORD(NULL) 

%RECORD(GPELF)%MAP NEW GPEL
   %RECORD(GPELF)%NAME NEW
   NEW==FREE GPELS
   %IF NEW==RECORD(NULL) %START
      NEW==RECORD(TOS);   CLAIM(GPELLEN)
   %FINISH %ELSE %START
      FREE GPELS==FREE GPELS_NEXT
   %FINISH
   NEW_ONEV==RECORD(NULL)
   %RESULT==NEW
%END

%ROUTINE FREE GPEL(%RECORD(GPELF)%NAME E)
   E_NEXT==FREE GPELS
   FREE GPELS==E
%END

%ROUTINE FREE COND(%RECORD(GPELF)%NAME C)
!! free up the data structure representing a condition
   %RETURN %IF C==RECORD(NULL)
   %IF C_N#0 %START
      FREE COND(C_L)
      FREE COND(C_R)
   %FINISH
   FREE GPEL(C)
%END

%PREDICATE TRUE(%RECORD(CONDF)%NAME C)
!! evaluate a condition and see if it is true
   %INTEGER N, V
   %TRUE %IF C==RECORD(NULL)
   V=C_V;   N=C_N
   %IF N=0 %START
      !! leaf node - compare with output value
      %TRUE %IF V=C_OUTPUT_VALUE&SMASK
   %FINISH %ELSE %START
      !! could be a conjunction aor a disjunction
      %IF TRUE(C_L) %START
         !! true if disjunction
         %TRUE %IF V=0
      %FINISH %ELSE %START 
         !! false if conjunction
         %FALSE %IF V=1
      %FINISH
      %TRUE %IF TRUE(C_R)
   %FINISH
   %FALSE
%END

!!...recursive routines for building the data structures......
!!...representing a conditional expression....................

%RECORD(CONDF)%MAP %SPEC CONDITION
%ROUTINESPEC READ LOGIC VALUE(%INTEGERNAME LVAL)

%RECORD(CONDF)%MAP LTERM
!! build the record representing the comparison
!! of a signal with a logic value
   %RECORD(CONDF)%NAME COND
   %RECORD(OUTPUTF)%NAME OUTPUT 
   %STRING(255)%NAME NAME
   %RECORD(FTAG)%NAME TAG
   %INTEGER LVAL,   OLDBOS,   LOP
   COND==RECORD(NULL)
   %IF NEXTSYMBOL='(' %START
      !!  expression in parentheses
      SKIP ITEM
      COND==CONDITION
      FAIL("Missing ')'",POSN) %AND ->OUT %UNLESS NEXTSYMBOL=')'
      SKIP ITEM
   %FINISH %ELSE %START
      !!  comparison of a signal with a logic value
      OLDBOS=BOS
      NAME==GET STRING
      TAG==STORE TAG(NAME)
      OUTPUT==TAG_OWNER
      REMOVE(TAG) %IF BOS#OLDBOS
      FAIL(NAME." is not an output",POSN) %AND ->OUT %C
         %IF OUTPUT==RECORD(NULL)
      FAIL("Missing '='",POSN+1) %AND ->OUT %UNLESS NEXTSYMBOL='='
      SKIP ITEM
      %IF NEXTSYMBOL='\' %THEN SKIP ITEM %AND LOP=1 %ELSE LOP=0
      READ LOGIC VALUE(LVAL)
      SKIP TO NL %AND ->OUT %UNLESS 0<=LVAL<3
      FAIL("Logic value 'X' out of context",POSN-1) %AND ->OUT %C
         %IF LVAL=1
      LVAL=1 %IF LOP=1
      COND==NEW GPEL
      COND_OUTPUT==OUTPUT
      COND_V=LVAL;   COND_N=0
   %FINISH
OUT:
   %RESULT==COND
%END

%RECORD(CONDF)%MAP CONJUNCTION
!! build the data structure representing the conjunction
!! of logical expressions
   %RECORD(CONDF)%NAME CONJ,   COND
   CONJ==LTERM
   ->OUT %IF CONJ==RECORD(NULL)
   %IF NEXTSYMBOL='&' %START
      !! got a conjunction
      SKIP ITEM
      %IF NEXTSYMBOL=NL %START
         !! continue the statement on the next line 
         SKIP LINE
         PROMPT(" & ")
         SKIP BLANKS
      %FINISH
      COND==CONJ
      CONJ==NEW GPEL
      CONJ_V=1;   CONJ_N=2
      CONJ_L==COND
      CONJ_R==CONJUNCTION
   %FINISH
OUT:
   %RESULT==CONJ
%END

%RECORD(CONDF)%MAP CONDITION 
!! build the record representing
!! <condition>=<lterm>{+<lterm>}*
   %RECORD(CONDF)%NAME COND,   CONJ
   COND==CONJUNCTION
   ->OUT %IF COND==RECORD(NULL)
   %IF NEXTSYMBOL='+' %START
      !! got a disjunction of terms 
      SKIP ITEM
      %IF NEXTSYMBOL=NL %START
         !! continue the statement on the next line
         SKIP LINE
         PROMPT(" + ")
         SKIP BLANKS
      %FINISH
      CONJ==COND
      COND==NEW GPEL
      COND_V=0;   COND_N=2
      COND_L==CONJ
      COND_R==CONDITION
   %FINISH
OUT:
   %RESULT==COND
%END

!!*************************************************
!! routines for circuit initialisation            *
!!    Eichelberger's time independent algorithm   *
!!************************************************* 

%RECORDFORMAT OUTPUTNMSF(%RECORD(OUTPUTF)%NAME %ARRAY OUTPUT(1:1253))
%RECORD(OUTPUTNMSF)%NAME L;   !! to store a list of outputs
%INTEGER STARTOFL,   ENDOFL
%OWNINTEGER INITIALISED=NO,   MONITOR=0,   PHASE=0
%OWNINTEGER SEED=0,   MAX TIME=0,   RANDOM DELAYS=NO

%ROUTINE MAKEL(%INTEGER WHERE)
   L==RECORD(WHERE)
   STARTOFL=0;   ENDOFL=0 
%END

%ROUTINE ADDTOL(%RECORD(OUTPUTF)%NAME OUTPUT)
   ENDOFL=ENDOFL+1
   L_OUTPUT(ENDOFL)==OUTPUT
%END

%RECORD(OUTPUTF)%MAP TAKEFROML
   %RESULT==RECORD(NULL) %UNLESS STARTOFL<ENDOFL
   STARTOFL=STARTOFL+1
   %RESULT==L_OUTPUT(STARTOFL)
%END

%ROUTINE ADDIFHALF(%RECORD(OUTPUTF)%NAME OUTPUT)
!! add to the list of outputs all gates fed by OUTPUTR
!! whose output value is 'X' (undefined)
   %RECORD(CONNF)%NAME CONN
   %RECORD(GATEF)%NAME GATE 
   %RECORD(OUTPUTF)%NAME OP
   CONN==OUTPUT_LINK
   %WHILE %NOT CONN==RECORD(NULL) %CYCLE
      !! for each input connection fed by OUTPUT
      GATE==CONN_GATE
      !! only add internal outputs to the list
      %UNLESS GATE_FN<0 %START
         OP==RECORD(ADDR(GATE_OUTPUTS))
         ADDTOL(OP) %IF OP_VALUE&HALF#0
      %FINISH
      CONN==CONN_LINK
   %REPEAT
%END

%ROUTINE ADDIFNOTHALF(%RECORD(OUTPUTF)%NAME OUTPUT)
!! add to the list the outputs of all gates fed by OUTPUT
!! whose output values rae not 'X' (ie defined) 
   %RECORD(CONNF)%NAME CONN
   %RECORD(GATEF)%NAME GATE
   %RECORD(OUTPUTF)%NAME OP
   CONN==OUTPUT_LINK
   %WHILE %NOT CONN==RECORD(NULL) %CYCLE
      !! for each connection fed by OUTPUT
      GATE==CONN_GATE
      !! only add internal gate outputs
      %UNLESS GATE_FN<0 %START
         OP==RECORD(ADDR(GATE_OUTPUTS))
         ADDTOL(OP) %IF OP_VALUE&HALF=0
      %FINISH 
      CONN==CONN_LINK
   %REPEAT
%END

%ROUTINE UPDATE INPUT VALUES(%RECORD(OUTPUTF)%NAME OUTPUT)
!! update all the inputs fed by OUTPUT
   %RECORD(CONNF)%NAME CONN 
   %RECORD(GATEF)%NAME GATE
   %INTEGER VALUE
   VALUE=OUTPUT_VALUE
   %RETURN %IF VALUE&HELD#0
   VALUE=VALUE&SMASK
   OUTPUT_VALUE=VALUE+VALUE<<2
   CONN==OUTPUT_LINK
   %WHILE %NOT CONN==RECORD(NULL) %CYCLE
      CONN_INPUT_VALUE=VALUE
      CONN==CONN_LINK
   %REPEAT
%END

%ROUTINE WRITE TO(%INTEGERARRAYNAME M, %INTEGER BIT, VALUE)
!! Put VALUE in the BITth position of M
   %INTEGER W,   WORD
   WORD=BIT>>LBPW
   BIT=BPW-1 - BIT + (WORD<<LBPW)
   W=M(WORD)
   M(WORD)=W&(\(1<<BIT))!(VALUE<<BIT)
%END

%INTEGERFN READ FROM(%INTEGERARRAYNAME M, %INTEGER BIT)
   %INTEGER WORD
   WORD=BIT>>LBPW
   %RESULT=((M(WORD)>>(BPW-1-BIT+(WORD<<LBPW)))&1)<<1
%END

%ROUTINE FILL(%RECORD(GATEF)%NAME GATE, %STRING(255)%NAME FROM)
   %INTEGER NWORDS,   WSIZE,   I,   J,   BIT,   DONE
   %ON %EVENT 9 %START
      %IF DONE=NO %THEN ->WRONG SHAPE %ELSE ->OUT
   %FINISH
   DONE=NO
   WSIZE=GATE_TYPE_NOUT;   !! no of bits in ROM/RAM word
   NWORDS=GATE_TYPE_NIN-1
   %IF GATE_FN=9 %THEN NWORDS=NWORDS-WSIZE-1
   NWORDS=1<<NWORDS;   !! no of words in ROM/RAM
   OPENINPUT(3,FROM)
   SELECTINPUT(3)
   %CYCLE
      CH=NEXTSYMBOL
      %EXIT %IF CH='0' %OR CH='1'
      SKIPSYMBOL
   %REPEAT
   %FOR I=0,WSIZE,(NWORDS-1)*WSIZE %CYCLE
      %FOR J=0,1,WSIZE-1 %CYCLE
         SKIPSYMBOL %WHILE NEXTSYMBOL=' '
         READSYMBOL(BIT)
         BIT=BIT-'0'
         ->WRONG SHAPE %UNLESS 0<=BIT<=1
         WRITE TO(GATE_M,I+J,BIT)
      %REPEAT
      SKIPSYMBOL %WHILE NEXTSYMBOL#NL
      SKIPSYMBOL
   %REPEAT
   DONE=YES
   %CYCLE
      CH=NEXTSYMBOL
      %EXIT %IF CH='0' %OR CH='1'
      SKIPSYMBOL
   %REPEAT
   !! fall through to wrong shape data
WRONG SHAPE:
   REPORT("Data for ".GATE_TYPE_NAME_S." has wrong no of rows/cols",ERROR)
   ->OUT
OUT:
   SELECTINPUT(CONSOLE)
%END

%ROUTINE DIAGNOSE(%STRING(63) S)
   SELECTOUTPUT(CONSOLE)
   PRINTSYMBOL('*')
   PRINTSTRING(S);   NEWLINE
   SELECTOUTPUT(OUTSTREAM)
%END

%ROUTINE EVAL MEM(%RECORD(GATEF)%NAME GATE)
!! evaluate a memory element - ROM or RAM
   %RECORD(GTYPEF)%NAME GTYPE
   %RECORD(INPUTF)%ARRAYNAME IN
   %RECORD(OUTPUTF)%ARRAYNAME OUT
   %INTEGER NIN,   NOUT,   I,   SEL,   RW,   V,   VALUE
   %INTEGER ADDRESS,   AX,   DX,   D
   GTYPE==GATE_TYPE
   NIN=GTYPE_NIN;   NOUT=GTYPE_NOUT
   IN==GATE_INPUTS_INPUT;   OUT==GATE_OUTPUTS_OUTPUT
   SEL=IN(NIN)_VALUE&SMASK;      !! memory select +ve logic
   %IF GATE_FN=9 %START
      !! RAM
      NIN=NIN-1
      RW=IN(NIN)_VALUE&SMASK
      NIN=NIN-NOUT
   %FINISH %ELSE RW=0;           !! ROM
   NIN=NIN-1
   AX=NO;                       !! address not uncertain
   %IF SEL=HI %START
      !! memory  selected
      !! need to calculate an address
      ADDRESS=0
      %FOR I=1,1,NIN %CYCLE
         V=IN(I)_VALUE&SMASK
         AX=YES %IF V=HALF
         ADDRESS=(ADDRESS<<1)!(V>>1)
      %REPEAT
      ADDRESS=ADDRESS*NOUT-1
   %FINISH
   DX=NO;                       !! data not uncertain
   %IF RW=HI %START
      !! RAM selected for write
      %FOR I=NIN+1,1,NIN+NOUT %CYCLE
         DX=YES %AND %EXIT %IF IN(I)_VALUE&HALF#0
      %REPEAT
   %FINISH
   D=HALF
   %IF SEL=LO %OR (SEL=HI %AND RW#HALF %AND AX=NO %AND DX=NO) %THEN %C
      D=(GATE_DEFAULT<<1)
   %IF SEL#LO %START
      %IF RW=LO %START
         DIAGNOSE("Memory selected for Read, address uncertain") %IF AX=YES
      %FINISH %ELSE %IF RW=HALF %START
         DIAGNOSE("Memory selected with Read/Write line uncertain")
      %FINISH %ELSE %START
         DIAGNOSE("Memory selected for Write, data uncertain") %IF DX=YES
         DIAGNOSE("Memory selected for Write, address uncertain") %IF AX=YES
      %FINISH
   %FINISH
   !! now put values into memory and/or produce output values
   %FOR I=1,1,NOUT %CYCLE
      VALUE=OUT(I)_VALUE
      V=D
      %IF SEL=HI %AND D#HALF %START
         !! chip selected, not an error condn
         %IF RW=HI %START
            !! write to memory
            V=IN(NIN+I)_VALUE&SMASK
            WRITE TO(GATE_M,ADDRESS+I,V>>1)
         %FINISH %ELSE %START
            !! RW=LO because RW=X & SEL=HI => D=HALF
            V=READ FROM(GATE_M,ADDRESS+I)
         %FINISH
      %FINISH
      OUT(I)_VALUE=(VALUE<<2+V)&15
   %REPEAT
%END

%ROUTINE EVALUATE(%RECORD(GATEF)%NAME GATE)
!! evaluate a gate function
!! we are guaranteed to get a recognised, single output gate
!! or a ROM or a RAM function
   %INTEGER FN, I, V, MAX, MIN, PARITY, VALUE
   %RECORD(OUTPUTF)%NAME OUTPUT
   %SWITCH ACTION(0:3)
   FN=GATE_FN
   %IF FN=10 %OR FN=9 %THEN EVAL MEM(GATE) %AND %RETURN
   OUTPUT==RECORD(ADDR(GATE_OUTPUTS));   !! the unique output
   VALUE=OUTPUT_VALUE
   %RETURN %IF VALUE&HELD#0 
   %IF FN<=32 %START
      MIN=HI;   MAX=LO;   PARITY=LO
      %FOR I=1,1,GATE_TYPE_NIN %CYCLE
         V=GATE_INPUTS_INPUT(I)_VALUE
         MAX=V %IF V>MAX
         MIN=V %IF V<MIN
         PARITY=HI-PARITY %IF V=HI
         PARITY=HALF %IF V=HALF 
      %REPEAT 
      ->ACTION(FN&3)
ACTION(1): !! AND / NAND
      V=MIN 
      ->END
ACTION(2): !! OR / NOR
      V=MAX
      ->END
ACTION(3): !! XOR / NXOR
      V=PARITY
      ->END
ACTION(0): !! DELAY / NOT / INV / PROGRAMMED INPUT
END:
      V=HI-V %IF FN&4#0 
   %FINISH %ELSE %START
      REPORT(GATE_TYPE_NAME_S." cannot be evaluated",DISASTER)
   %FINISH
   OUTPUT_VALUE=(VALUE<<2 + V)&15 
%END

%ROUTINE READ COMMAND VERB(%INTEGERNAME V)
   %INTEGER OLDBOS
   %STRING(255)%NAME VERB
   %RECORD(FTAG)%NAME TAG
   OLDBOS=BOS;   V=0
   VERB==GET STRING
   %RETURN %IF LENGTH(VERB)=0
   TAG==STORE TAG(VERB)
   V=TAG_VALUE>>10
   V=0 %IF V>NCOMMANDS
   REPORT("Command '".VERB."' not recognised",ERROR) %IF V=0
   REMOVE(TAG) %IF BOS#OLDBOS;   !! in case we created a new tag
%END

%ROUTINE READ LOGIC VALUE(%INTEGERNAME V)
   %INTEGER OLDBOS
   %STRING(255)%NAME VALUE
   %RECORD(FTAG)%NAME TAG
   OLDBOS=BOS
   VALUE==GET STRING
   TAG==STORE TAG(VALUE)
   V=(TAG_VALUE>>10)-29
   REPORT(" '".VALUE."' is not a valid logic value",ERROR) %IF V<0
   REMOVE(TAG) %IF BOS#OLDBOS;   !! in case we created a new tag
%END

%ROUTINE PRINT OUTPUTS
!! print the values taken by the circuit outputs
!! these are stored in the inputs to the outside world
   %INTEGER I
   SPACES(2)
   %FOR I=1,1,CIRCUITHEADER_TYPE_NIN %CYCLE 
      SPACE
      PRINTSYMBOL(SIGVAL(CIRCUITHEADER_INPUTS_INPUT(I)_VALUE&SMASK))
   %REPEAT
   NEWLINE
%END

%ROUTINE MAKE TRACE(%RECORD(OUTPUTF)%NAME OUTPUT)
!! routine to set up the circuit input OUTPUT as a trace output
   %RECORD(GTYPEF)%NAME GTYPE
   %RECORD(GATEF)%NAME GATE
   %RECORD(INPUTF)%NAME INPUT
!!......build the gate type  record for TRACE.... 
   GTYPE==RECORD(TOS)
   GTYPE_NIN=1; GTYPE_NOUT=1; GTYPE_NAME==STORE TAG(MAP STRING("TRACE"))
   GTYPE==ADD TYPE(GTYPE)
!!......and now build the gate record............
   %IF OUTPUT_GATE_FN=-1 %START
      !! not yet uesd as a TRACE
      GATE==RECORD(TOS);   CLAIM(GATELEN)
      INPUT==RECORD(TOS);   CLAIM(INPUTLEN)
   %FINISH %ELSE %START
      !! re-use the gate and its input
      GATE==OUTPUT_GATE
      INPUT==RECORD(ADDR(GATE_INPUTS))
   %FINISH
   GATE_DELAYS==ZERO DELAYS;   GATE_TYPE==GTYPE
   GATE_FN=-8;   !! TRACE
   GATE_INPUTS==RECORD(ADDR(INPUT))
   INPUT_VALUE=0;   INPUT_P=0;   INPUT_NK=0
!!......and finally re use the output............
   GATE_OUTPUTS==RECORD(ADDR(OUTPUT))
   OUTPUT_GATE==GATE
%END

%ROUTINE ADD ONEV(%RECORD(TELF)%NAME TRACE,
                  %RECORD(OUTPUTF)%NAME OUTPUT,
                  %RECORD(CONDF)%NAME COND)
!! add an element to the list of triples (trace,output,condition)
!! delete any elements that are superseded
   %RECORD(ONEVF)%NAME ON 
   ON==ON EVENTS
   %WHILE %NOT ON==RECORD(NULL) %CYCLE
      %IF ON_OUTPUT==OUTPUT %START
          !! found one that refers to OUTPUT
         %IF ON_COND==COND %START
            FREE TRACE(ON_TRACE)
            FREE COND(ON_COND)
            ->OUT
         %FINISH
      %FINISH
      ON==ON_NEXT
   %REPEAT
   !! create a new element on the list
   ON==NEW GPEL
   ON_NEXT==ON EVENTS
   ON EVENTS==ON
OUT:
   ON_TRACE==TRACE;   ON_OUTPUT==OUTPUT;   ON_COND==COND
%END

%ROUTINE PRINT TRACE(%RECORD(TELF)%NAME T)
   %INTEGER OLEN
   %OWNINTEGERARRAY TVAL(0:3)='L','F','R','H'
%ROUTINE P(%RECORD(TELF)%NAME T)
   %INTEGER V
   %STRING(255)%NAME S
   %WHILE %NOT T==RECORD(NULL) %CYCLE
      %IF T_COUNT=-1 %START
         !! primitive element
         V=T_VALUE
         PRINTSYMBOL(TVAL(V&2+V>>5))
         WRITE(T_LENGTH,0)
         OLEN=OLEN+4
      %FINISH %ELSE %IF T_COUNT=0 %START
         !! reference to a named trace
         PRINTSYMBOL('@')
         S==T_TAG_S
         PRINTSTRING(S)
         OLEN=OLEN+2+LENGTH(S)
      %FINISH %ELSE %START
         PRINTSYMBOL('(') %IF T_COUNT>1
         P(T_SUB)
         %IF T_COUNT>1 %START
            PRINTSYMBOL(')')
            V=T_COUNT;   V=0 %IF V=MAXINTEGER
            WRITE(V,0)
            OLEN=OLEN+5
         %FINISH
      %FINISH
      SPACE %UNLESS T_NEXT==RECORD(NULL)
      %IF OLEN>50 %START
         PRINTSTRING(" %C");   NEWLINE
         SPACES(8);            OLEN=0
      %FINISH
      T==T_NEXT
   %REPEAT
%END
   OLEN=0
   P(T)
%END

%ROUTINE PRINT COND(%RECORD(CONDF)%NAME COND)
   %INTEGER OLEN
%ROUTINE P(%RECORD(CONDF)%NAME C, %INTEGER PRECEDENCE)
   %INTEGER V
   %STRING(255)%NAME S
   V=C_V
   %IF C_N=0 %START
      !! comparison of a signal with a value
      S==C_OUTPUT_NAME_S
      PRINTSTRING(S);   PRINTSYMBOL('=');   PRINTSYMBOL('0'+V>>1)
      OLEN=OLEN+2+LENGTH(S)
   %FINISH %ELSE %START
      PRINTSYMBOL('(') %AND OLEN=OLEN+2 %IF PRECEDENCE>V
      P(C_L,V)
      %IF V=1 %THEN PRINTSTRING(" & ") %ELSE PRINTSTRING(" + ")
      OLEN=OLEN+3
      %IF OLEN>50 %START
         OLEN=0;   NEWLINE
         SPACES(8)
      %FINISH
      P(C_R,V)
      PRINTSYMBOL(')') %IF PRECEDENCE>V
   %FINISH
%END
   OLEN=0
   P(COND,-1)
%END

%ROUTINE PRINT ONEV(%RECORD(ONEVF)%NAME ONEV)
   %IF %NOT ONEV_COND==RECORD(NULL) %START
      PRINTSTRING("   WHEN ")
      PRINT COND(ONEV_COND);   NEWLINE
   %FINISH
   SPACES(8)
   PRINT TAG(ONEV_OUTPUT_NAME)
   PRINTSYMBOL('=')
   PRINT TRACE(ONEV_TRACE)
   NEWLINE
%END

%ROUTINE PROCESS ONEV(%RECORD(OUTPUTF)%NAME OUTPUT, %INTEGER FLAG)
!! print out the TRACE and CONDition under which it is connected
!! if FLAG is non-zero then prompt fot the deletion of this entry.
   %RECORD(ONEVF)%NAME PREV,   NEXT,   ONEV

%INTEGERFN REFS TO(%RECORD(CONDF)%NAME COND)
   %INTEGER N
   %RECORD(ONEVF)%NAME O
   N=0;   O==ON EVENTS
   %WHILE %NOT O==RECORD(NULL) %CYCLE
      N=N+1 %IF O_COND==COND
      O==O_NEXT
   %REPEAT
   %RESULT=N
%END

   ONEV==ON EVENTS;   PREV==RECORD(NULL)
   %WHILE %NOT ONEV==RECORD(NULL) %CYCLE
      NEXT==ONEV_NEXT
      %IF OUTPUT==RECORD(NULL) %OR ONEV_OUTPUT==OUTPUT %START
         PRINT ONEV(ONEV)
         %IF FLAG=1 %START
            !! prompt for deletion
            SKIP LINE
            PROMPT("Delete? ")
            SKIP BLANKS
            %IF NEXTSYM='Y' %START
               !! yes, delete it
               FREE TRACE(ONEV_TRACE)
               FREE COND(ONEV_COND) %IF REFS TO(ONEV_COND)<=1
               %IF PREV==RECORD(NULL) %THEN ON EVENTS==NEXT %C
               %ELSE PREV_NEXT==NEXT
               FREE GPEL(ONEV)
               ONEV==PREV
               PRINTSTRING("Deleted");   NEWLINE
            %FINISH
            SKIP TO NL
         %FINISH
      %FINISH
      PREV==ONEV;   ONEV==NEXT
   %REPEAT
%END

%ROUTINE READ INPUTS
!! read the circuit inputs 
   %SWITCH C(0:NCOMMANDS),   HELP(0:NCOMMANDS)
   %STRING(255)%NAME NAME
   %INTEGER LVAL,   O,   COMMAND,   FN,   GATENO,   OLEN,   OLDBOS
   %INTEGER INSTREAM=0
   %RECORD(CONNF)%NAME CONN
   %RECORD(GATEF)%NAME GATE
   %RECORD(OUTPUTF)%NAME OUTPUT
   %RECORD(TELF)%NAME TRACE
   %RECORD(CONDF)%NAME COND
   %RECORD(FTAG)%NAME TAG

%ROUTINE GET NAME
!! read a name from the terminal, terminated by
!! TERMINATOR, NL, or the next blank
!! The string value of the name is returned in NAME
!! and the output to which it refers is returned in OUTPUT
   %INTEGER OLDBOS
   %RECORD(FTAG)%NAME TAG
   OLDBOS=BOS
   NAME==GET STRING
   TAG==STORE TAG(NAME)
   OUTPUT==TAG_OWNER
   REMOVE(TAG) %IF BOS#OLDBOS;   !! in case new tag created
%END

%ROUTINE CPUT(%STRING(255)%NAME S)
   %IF LENGTH(S)+OLEN>60 %START
      NEWLINE;   SPACES(2);   OLEN=0
   %FINISH
   SPACE;   PRINTSTRING(S)
   OLEN=OLEN+LENGTH(S)+1
%END

!! at end of secondary input re-select the console and fall through
%ON %EVENT 9 %START
   !! end of secondary input
   SELECTINPUT(0)
%FINISH

   !! start of command cycle
   !! PHASE=0 => not yet issued SIMULATE command 
   !! PHASE=1 => SIMULATE issued
   INSTREAM=0
   %CYCLE
      PROMPT("-> ")
      POSN=0;      !! posn in line for error marker
      READ COMMAND VERB(COMMAND)
      ->C(COMMAND)
C(1):   !! ALL <logic value>
      READ LOGIC VALUE(LVAL)
      ->EOL %UNLESS 0<=LVAL<3
      %FOR O=1,1,CIRCUITHEADER_TYPE_NOUT %CYCLE
         OUTPUT==CIRCUITHEADER_OUTPUTS_OUTPUT(O)
         OUTPUT_VALUE=(OUTPUT_VALUE&16_8C)!LVAL
      %REPEAT
      INITIALISED=NO
      ->EOL
C(2):   !! SET <name>=<logic value> (,<name>=<logic value>)*
      %CYCLE
         GET NAME
         ->NAME ERR %IF OUTPUT==RECORD(NULL)
         ->CERR %UNLESS NEXTSYMBOL='='
         SKIPSYM
         READ LOGIC VALUE(LVAL)
         ->EOL %UNLESS 0<=LVAL<3
         OUTPUT_VALUE=(OUTPUT_VALUE&16_8C)!LVAL 
         INITIALISED=NO
         %EXIT %IF NEXTSYMBOL=NL
         SKIPSYM %IF NEXTSYMBOL=','
      %REPEAT
      ->EOL
C(3):   !! GO
      %EXIT
C(4):   !! STOP
      %STOP %IF INSTREAM=0
      INSTREAM=0
      SKIP LINE
      SELECTINPUT(0)
      ->EOL
C(5):   !! HOLD <name> (,<name>)*
C(12):  !! FREE <name> (,<name>)*
      %CYCLE
         GET NAME
         ->NAME ERR %IF OUTPUT==RECORD(NULL)
         LVAL=OUTPUT_VALUE
         %IF COMMAND=5 %THEN LVAL=LVAL!HELD %C
         %ELSE LVAL=LVAL&(\HELD)
         OUTPUT_VALUE=LVAL 
         %EXIT %IF NEXTSYMBOL=NL
         SKIPSYM %IF NEXTSYMBOL=',' 
      %REPEAT 
      ->EOL
C(6):   !! MONITOR / MON
      READ(MONITOR)
      ->EOL 
C(14):  !! RUN
      ->PHASE ERR %IF INITIALISED=NO
      PHASE=2 %AND ->SIMULATE %IF PHASE=0
      PHASE=2
      %EXIT
C(7):   !! SIMULATE / SIM 
SIMULATE: 
      %CYCLE
         SKIP LINE
         PROMPT("Default delays ")
         DEFAULTDELAYS_D(O)=0 %FOR O=1,1,4
         %FOR O=1,1,4 %CYCLE
            RDEC(DEFAULTDELAYS_D(O))
            SKIPSYM %IF NEXTSYMBOL=','
         %REPEAT
         PROPAGATE DELAYS(DEFAULT DELAYS)
      %REPEAT %UNTIL CHECK DELAYS(DEFAULT DELAYS)=OK
      %CYCLE
         SKIP LINE
         PROMPT("Simulat'n time ")
         READ(MAX TIME)
         %EXIT %IF 0<=MAX TIME<=30000
         REPORT("Time must be in range 0:30000",ERROR)
      %REPEAT
      SKIP LINE
      PROMPT("Random delays? ")
      SKIP BLANKS
      %IF NEXTSYMBOL='Y' %OR NEXTSYMBOL='y' %THEN RANDOM DELAYS=YES %C
      %ELSE RANDOM DELAYS=NO
      %IF RANDOM DELAYS=YES %START
         SKIP LINE
         PROMPT("Random no seed ")
         RDEC(SEED)
         SEED=SEED&16_7FFF
      %FINISH 
      %EXIT %IF PHASE=2
      PHASE=1
      ->EOL
C(8):   !! VALOF / VAL <name> (,<name>)*
      SPACES(3) 
      %CYCLE
         GET NAME
         ->NAME ERR %IF OUTPUT==RECORD(NULL)
         PRINTSTRING(NAME)
         PRINTSYMBOL('=')
         LVAL=OUTPUT_VALUE
         PRINTSYMBOL(SIGVAL(LVAL&SMASK))
         %EXIT %IF NEXTSYMBOL=NL
         SKIPSYM %IF NEXTSYMBOL=',' 
         SPACE
      %REPEAT 
      NEWLINE
      ->EOL
C(9):   !! INPUTS?
      SPACES(2);   OLEN=0
      %FOR O=1,1,CIRCUITHEADER_TYPE_NOUT %CYCLE
         CPUT(CIRCUITHEADER_OUTPUTS_OUTPUT(O)_NAME_S)
      %REPEAT 
      NEWLINE 
      ->EOL
C(10):  !! WHEN condition LET .....
      NERRORS=0
      COND==CONDITION
      ->NEXT %IF NERRORS>0
      %IF NEXTSYMBOL=NL %START
         SKIP  LINE
         PROMPT(" ? ")
      %FINISH
      SKIP BLANKS
      O=POSN+1 
      READ COMMAND VERB(COMMAND)
      FAIL("LET Missing",O) %AND ->NEXT %UNLESS COMMAND=15
      ->LET COMMAND 
C(11):  !! OUTPUTS?
      SPACES(2);   OLEN=0
      %FOR GATENO=1,1,NOGATES %CYCLE
         GATE==GATES_GATE(GATENO)
         %FOR O=1,1,GATE_TYPE_NOUT %CYCLE
            OUTPUT==GATE_OUTPUTS_OUTPUT(O)
            CPUT(OUTPUT_NAME_S)
            CONN==OUTPUT_LINK
            %WHILE %NOT CONN==RECORD(NULL) %CYCLE
               %IF CONN_GATE==CIRCUITHEADER %START
                  !! got a circuit output
                  PRINTSTRING("(cct-output)")
                  OLEN=OLEN+12
                  %EXIT
               %FINISH
               CONN==CONN_LINK
            %REPEAT 
         %REPEAT
      %REPEAT 
      NEWLINE
      ->EOL
C(13):  !! DEFINE / DEF name = trace {, name = trace }*
      %CYCLE
         TAG TYPE=1;   !! trace name
         TAG==STORE TAG(GET STRING)
         ->CERR %UNLESS NEXTSYMBOL='='
         SKIPSYM
         NERRORS=0;   READTOKEN
         TRACE==GET TRACE
         %IF NERRORS>0 %START
            FREE TRACE(TRACE) 
         %FINISH %ELSE %START
            FREE TRACE(TAG_OWNER)
            TAG_OWNER==TRACE
         %FINISH
         %EXIT %UNLESS NEXTSYMBOL=','
         SKIPSYM
      %REPEAT
      ->EOL
C(15):  !! LET name=trace {, name=trace}*
      COND==RECORD(NULL);      !! Unconditional
LET COMMAND:
      %CYCLE
         GET NAME
         ->NAME ERR %IF OUTPUT==RECORD(NULL)
         ->CERR %UNLESS NEXTSYMBOL='='
         SKIPSYM;   NERRORS=0
         READTOKEN;   TRACE==GET TRACE
         FN=OUTPUT_GATE_FN
         REPORT("No! (".NAME." is not a primary cct input)",ERROR) %C
            %IF FN>=0
         %IF NERRORS>0 %START
            FREE TRACE(TRACE);   FREE COND(COND)
         %FINISH %ELSE %START 
            MAKE TRACE(OUTPUT)
            ADD ONEV(TRACE,OUTPUT,COND)
         %FINISH 
         %EXIT %UNLESS TOKEN=','
      %REPEAT
      ->EOL
C(17):  !! SHOW { <name> {{,} <name> }* }
      FN=0
      ->DELTRACE
C(18):  !! DELTRACE <name>
      FN=1
DELTRACE:
      %IF NEXTSYMBOL=NL %START
         PROCESS ONEV(RECORD(NULL),FN)
      %FINISH %ELSE %START
         %CYCLE
            GET NAME
            ->NAME ERR %IF OUTPUT==RECORD(NULL)
            PROCESS ONEV(OUTPUT,FN)
            %EXIT %IF NEXTSYMBOL=NL
            SKIPSYM %IF NEXTSYMBOL=','
         %REPEAT
      %FINISH
      ->EOL
C(20):  !! %S
      !! read from the secondary input stream
      SKIP LINE %IF INSTREAM=2;   !! purge if in secondary input
      INSTREAM=2-INSTREAM
      SELECTINPUT(INSTREAM)
     %CONTINUE %IF INSTREAM=2;    !! no EOL processing til we return
      ->EOL;                      !! from secondary input
C(21):  !! FILL
      %CYCLE
         TAGTYPE=2
         OLDBOS=BOS
         NAME==GET STRING
         TAG==STORE TAG(NAME)
         GATE==TAG_OWNER
         TAGTYPE=2 %AND REMOVE(TAG) %IF BOS#OLDBOS
         %IF GATE==RECORD(NULL) %OR (GATE_FN#10 %AND GATE_FN#9) %START
            REPORT(NAME." is not a memory element",ERROR)
            ->NEXT
         %FINISH
         READ COMMAND VERB(COMMAND)
         ->NEXT %UNLESS COMMAND=22;   !! FROM
         NAME==GET STRING
         FILL(GATE,NAME)
         %EXIT %UNLESS NEXTSYMBOL=','
         SKIPSYM
      %REPEAT
      ->EOL
C(16):  !! HELP / ?
      %UNLESS NEXTSYMBOL=NL %START
         READ COMMAND VERB(COMMAND)
      %FINISH
      ->HELP(COMMAND)
HELP(1):  PRINTSTRING("   ALL <logic-value>
Set all circuit inputs to the given value
");  ->EOL
HELP(2):  PRINTSTRING("   SET <name>=<logic-value> {{,} -ditto- }*
Set the named circuit input(s) to the given logic value(s)
");   ->EOL 
HELP(3):  PRINTSTRING("   GO
Evaluate the circuit using Eichelberger's algorithm (time
independent simulation to simulate power-up)
");   ->EOL
HELP(4):  PRINTSTRING("   STOP
If in secondary input then return to simulator command level.
Otherwise return to O/S command level.
");   ->EOL
HELP(5):  PRINTSTRING("   HOLD <name> {{,} <name> }*
Fix the named output(s) at its current value
");   ->EOL
HELP(6):  PRINTSTRING("   MONITOR <integer-value>
Set the flags used to determine what monitoring is done
");   ->EOL
HELP(7):  PRINTSTRING("   SIMULATE alias SIM
Prompt for default delays, max simulation time, and other parameters
of the dynamic (time depenedent) simulation.
");   ->EOL
HELP(8):  PRINTSTRING("   VALOF (alias VAL) <name> {{,} <name> }*
Print the current values of the named output(s)
");   ->EOL
HELP(9):  PRINTSTRING("   INPUTS?
Print the names of the primary circuit inputs
");   ->EOL
HELP(10): PRINTSTRING("   WHEN <condition> LET ...
Specify that when <condition> becomes true the following LET
action is taken. <condition> is any number of terms connected by
the logical connectives '&' (and) and '+' (or). '&' has greater
");   PRINTSTRING( %C
"precedence than '+' (as usual) except where otherwise specified
through the use of parentheses. A term is of the form
   <output-name>=<logic-value>
");   ->EOL
HELP(11): PRINTSTRING("   OUTPUTS?
Print the names of all outputs. Primary circuit outputs are
identified by '(cct-output)' after the name 
");   ->EOL
HELP(12): PRINTSTRING("   FREE <name> {{,} <name> }*
Allow the named output's value to change once again (having
been fixed by use of the HOLD command)
");   ->EOL
HELP(13): PRINTSTRING("   DEFINE alias DEF <tname)=<trace> {, -ditto-}*
Define a signal trace and give it a name. Use HELP TRACE for
information about signal traces 
");   ->EOL
HELP(14): PRINTSTRING("   RUN
Proceed to the dynamic simulation phase. First prompt for default
delays etc, if these haven't been set by use of the SIMULATE command
");   ->EOL
HELP(15): PRINTSTRING("   LET <name>=<trace> {, -ditto-}*
Attatch the specified signal trace (use HELP TRACE for information) 
to the named circuit input
");   ->EOL
HELP(16): PRINTSTRING("   Subcommands available:
 ALL       DEFINE alias DEF    DELTRACE  FILL      FREE      GO
 HELP alias ?        HOLD      INPUTS?   LET       MONITOR alias MON
");   PRINTSTRING( %C
" OUTPUTS?  RUN       SET       SHOW      SIMULATE alias SIM
 STOP      TRACE     VALOF alias VAL     WHEN      %S
   Use HELP <subcommand> for further information
");   ->EOL
HELP(17): PRINTSTRING("   SHOW { <name> {{,} <name> }* }
Show what traces are connected to the specified outputs,
and under what conditions. If no output names are specified,
then all traces are shown.
");   ->EOL
HELP(18): PRINTSTRING("   DELTRACE <name>
Delete the signal trace connected to the specified output.
As there may be more than one conditional trace connected to
");   PRINTSTRING( %C
"an output a prompt is issued after printing the trace (and
its condition). A reply of 'y' causes the trace to be deleted.
");   ->EOL
HELP(19): PRINTSTRING( %C
"Signal traces are constructed recursively from other signal traces
and from primitive trace elements which specify the time the signal
is to spend at 0 (L), rising (R), at 1 (H), and falling (F). Sections
");   PRINTSTRING( %C
"of trace can be repeated a given number of times by enclosing it in
parentheses and following it by a repeat count - 0 or '*' specifies
infinite repetition. Named traces are referenced by '@'<tname>. E.G.
   ((@P1)5 L5 R2 H17 F3)9)
");   ->EOL
HELP(20): PRINTSTRING("   %S
Switch command input streams.
(The secondary input of commands is from input stream 2)
");   ->EOL
HELP(21): PRINTSTRING("   FILL <memory-name> FROM <file-name>
Initialise a memory element to the values held in the specified file.
A memory element is known by its label, NOT by the name of its type
(which is ROM or RAM)
");   PRINTSTRING( %C
"There must be as many lines in the file as words in the memory,
and each line must contain a contiguous string of 0s and 1s of 
a length equal to the number of bits in the memory word
");   ->EOL
HELP(22): ->HELP(21)
NAME ERR:
      !! error in name - name not found
      REPORT("Signal '".NAME."' not found",ERROR)
      ->NEXT
PHASE ERR:
      REPORT("Can't! (circuit not yet initialised)",ERROR)
      ->NEXT
EOL:
      SKIP BLANKS
      ->NEXT %IF NEXTSYMBOL=NL
      !! drop through to SYNTAX ERROR
CERR:
      FAIL("Syntax error in command",POSN)
C(*):
HELP(*):
NEXT:
      SKIP LINE
   %REPEAT
   SKIP LINE
   POSN=0
%END

%ROUTINE INITIALISE CIRCUIT
!! the Eichelberger routine
   %INTEGER SUBNO,   I,   O,   VALUE
   %RECORD(GATEF)%NAME GATE
   %RECORD(OUTPUTF)%NAME OUTPUT 
   OUTSTREAM=CONSOLE;   !! default output-stream set at end of REPORT
   SELECTINPUT(CONSOLE);   SELECTOUTPUT(CONSOLE)
   PRINTSTRING("Circuit initialisation (Eichelberger)")
   NEWLINES(2)
   READ INPUTS;   !! get initial input assignments
   !! build list of gate outputs for evaluation phases
   MAKEL(TOS);   !! unprotected on top of stack
   !! and add to it the list of gates with initialised inputs
   %FOR SUBNO=1,1,NOGATES %CYCLE
      GATE==GATES_GATE(SUBNO)
      %FOR I=1,1,GATE_TYPE_NIN %CYCLE
         %CONTINUE %IF GATE_INPUTS_INPUT(I)_VALUE&HALF#0 
         !! input is initialised
         %FOR O=1,1,GATE_TYPE_NOUT %CYCLE
            ADDTOL(GATE_OUTPUTS_OUTPUT(O))
         %REPEAT
         %EXIT;   !! and consider the next gate
      %REPEAT
   %REPEAT
   %CYCLE
      PRINT OUTPUTS

      !! set changing inputs to final values
      %FOR SUBNO=0,1,NOGATES %CYCLE
         GATE==GATES_GATE(SUBNO)
         %FOR O=1,1,GATE_TYPE_NOUT %CYCLE
            OUTPUT==GATE_OUTPUTS_OUTPUT(O)
            VALUE=OUTPUT_VALUE
            %CONTINUE %IF (VALUE>>2)&SMASK=VALUE&SMASK
            UPDATE INPUT VALUES(OUTPUT)
            ADDIFHALF(OUTPUT)
         %REPEAT
      %REPEAT

      !! evaluate the circuit
      %CYCLE
         OUTPUT==TAKEFROML
         %EXIT %IF OUTPUT==RECORD(NULL)
         EVALUATE(OUTPUT_GATE)
         UPDATE INPUT VALUES(OUTPUT)
         !! if the output is defined then add to the list
         !! all outputs of gates fed by OUTPUT which ae undefined
         ADDIFHALF(OUTPUT) %IF OUTPUT_VALUE&HALF=0
      %REPEAT

      !! out put the final values
      PRINT OUTPUTS
      INITIALISED=YES
      READ INPUTS
      %EXIT %IF PHASE=2
      PRINT OUTPUTS;   !! to remind the user

      !! set changing inputs to 'X'
      MAKEL(TOS)
      %FOR SUBNO=0,1,NOGATES %CYCLE
         GATE==GATES_GATE(SUBNO)
         %FOR O=1,1,GATE_TYPE_NOUT %CYCLE
            OUTPUT==GATE_OUTPUTS_OUTPUT(O)
            VALUE=OUTPUT_VALUE
            %CONTINUE %IF (VALUE>>2)&SMASK=VALUE&SMASK
            OUTPUT_VALUE=HALF
            UPDATE INPUT VALUES(OUTPUT)
            OUTPUT_VALUE=(HALF<<2)+(VALUE&SMASK)
            ADDIFNOTHALF(OUTPUT)
         %REPEAT
      %REPEAT

      !! and evaluate the circuit 
      %CYCLE
         OUTPUT==TAKEFROML
         %EXIT %IF OUTPUT==RECORD(NULL)
         EVALUATE(OUTPUT_GATE)
         UPDATE INPUT VALUES(OUTPUT)
         !! add to the list the outputs of all gates fed by OUTPUT
         !! whose outputs are defined, only if OUTPUT is undefined
         ADDIFNOTHALF(OUTPUT) %IF OUTPUT_VALUE&HALF#0
      %REPEAT
   %REPEAT
%END

!!*************************************************
!! routines for dynamic simulation (Chicoix et al)*
!!*************************************************

%INTEGERFN RANDOM(%INTEGER MIN, MAX)
!! calculate a pseudo-random number between MIN and MAX
   %INTEGER J
   SEED=(SEED*16_E945+13)&16_7FFF
   J=|MAX-MIN|+1
   %RESULT=MIN+(SEED-(SEED//J)*J)
%END

!!*************************************
!! event queue interface              *
!!*************************************

%RECORD(EVENTF)%NAME EVENT,   FREE EVENTS
%RECORD(EVENTF) EVENTQ
%OWNINTEGER TIME 
%INTEGERARRAY EVENTQDISTN(1:100)
%INTEGER EVENTQLEN

!!*************************************
!! event queue initialisation         *
!!*************************************

EVENTQ_TIME=MAXINTEGER;   EVENTQ_NEXT==RECORD(NULL)
FREE EVENTS==RECORD(NULL)
EVENTQDISTN(EVENTQLEN)=0 %FOR EVENTQLEN=1,1,100
EVENTQLEN=0

%ROUTINE CREATE EVENT(%INTEGER TIME)
!! create en event EVENT at the appropriate place in the event queue
   %RECORD(EVENTF)%NAME PREV,   NEXT
   %INTEGER INDEX
   PREV==EVENTQ
   %CYCLE
      NEXT==PREV_NEXT
      %EXIT %IF NEXT==RECORD(NULL);   !! end of queue
      %EXIT %IF NEXT_TIME>=TIME
      PREV==NEXT
   %REPEAT
   !! get an event to chain into the queue
   !! take one off the free list if possible
   %IF FREE EVENTS==RECORD(NULL) %START
      !! no free events, so create a new one
      EVENT==RECORD(TOS)
      CLAIM(EVENTLEN)
   %FINISH %ELSE %START 
      EVENT==FREE EVENTS
      FREE EVENTS==FREE EVENTS_NEXT
   %FINISH
   !! and set the event time
   EVENT_TIME=TIME
   EVENT_NEXT==NEXT;   PREV_NEXT==EVENT
   EVENTQLEN=EVENTQLEN+1
   INDEX=EVENTQLEN;   INDEX=100 %IF INDEX>100
   EVENTQDISTN(INDEX)=EVENTQDISTN(INDEX)+1
%END

%ROUTINE GET NEXT EVENT
!! take the next event off the event queue
!! and leave a pointer to it (on the free list) in EVENT
   EVENT==EVENTQ_NEXT
   EVENT==EVENTQ %AND %RETURN %IF EVENT==RECORD(NULL)
   EVENTQ_NEXT==EVENT_NEXT;   !! unchain the event
   EVENT_NEXT==FREE EVENTS
   FREE EVENTS==EVENT;   !! and leave it on the head of the free queue
   EVENTQLEN=EVENTQLEN-1
%END

%ROUTINE REMOVE EVENTS AT(%RECORD(OUTPUTF)%NAME OUTPUT)
   %RECORD(EVENTF)%NAME PREV,   NEXT
   %RECORD(GATEF)%NAME GATE
!! remove all wake-up events referring to OUTPUT_GATE
   PREV==EVENTQ;   GATE==OUTPUT_GATE
   %CYCLE
      NEXT==PREV_NEXT
      %EXIT %IF NEXT==RECORD(NULL)
      %IF NEXT_TRANSITION=255 %AND NEXT_GATE==GATE %START
         !! remove the event from the queue
         PREV_NEXT==NEXT_NEXT
         NEXT_NEXT==FREE EVENTS
         FREE EVENTS==NEXT
      %FINISH %ELSE PREV==NEXT
   %REPEAT
%END

%INTEGERFN INITIALISE TRACE(%RECORD(TELF)%NAME T, %INTEGER LVAL,
                            %STRING(255)%NAME NAME)
   %RECORD(TELF)%NAME NEXT,   SUB 
   %RECORD(FTAG)%NAME TAG
   %INTEGER RVAL,   L,   LEN
  LEN=0
   %WHILE %NOT T==RECORD(NULL) %CYCLE 
      NEXT==T_NEXT
      %IF T_COUNT=0 %START
         !! reference to a named trace
         TAG==T_TAG 
         SUB==TAG_OWNER
         %IF SUB==RECORD(NULL) %START
            REPORT("Trace ".TAG_S." is undefined (ignored)",ERROR)
         %FINISH %ELSE %START
            %IF SUB_COUNT>0 %START
               !! pull up compound trace
               T_SUB==SUB_SUB;   T_COUNT=SUB_COUNT 
            %FINISH %ELSE %START
               T_SUB==SUB;   T_COUNT=1
            %FINISH
            T_VALUE=SUB_VALUE;   T_LENGTH=SUB_LENGTH
         %FINISH
      %FINISH
      T_LENGTH=INITIALISE TRACE(T_SUB,LVAL,NAME) %IF T_COUNT>0
      RVAL=T_VALUE>>4
      REPORT("Trans'n out of seq. in trace driving input ".NAME, %C
         ERROR) %UNLESS LVAL=RVAL
      LVAL=T_VALUE&15
      !! fix up the length of the trace
      %IF T_LENGTH=MAXINTEGER %OR T_COUNT=MAXINTEGER %START
         LEN=MAXINTEGER
      %FINISH %ELSE %IF LEN#MAXINTEGER %START
         L=T_LENGTH
         L=L*T_COUNT %IF T_COUNT>0
         LEN=LEN+L
      %FINISH
      T==NEXT
   %REPEAT
   %RESULT=LEN
%END

%ROUTINE INITIALISE OUTPUT(%RECORD(OUTPUTF)%NAME OUTPUT,
                          %RECORD(TELF)%NAME TRACE)
   %RECORD(GATEF)%NAME GATE
   %INTEGER LVAL,   TOTLEN
   GATE==OUTPUT_GATE
   %RETURN %IF TRACE==RECORD(NULL)
   NERRORS=0
   !! check trace for consistency 
   LVAL=OUTPUT_VALUE&SMASK
   TOTLEN=INITIALISE TRACE(TRACE,LVAL,OUTPUT_NAME_S)
   %IF NERRORS=0 %START
      !! trace initialised OK
      GATE_FN=8;   !! trace now primed
      CREATE EVENT(TIME)
      EVENT_GATE==GATE;   EVENT_TRACE==TRACE
      EVENT_TRANSITION=255;   EVENT_RANK=1
   %FINISH
%END

%ROUTINE INITIALISE COND(%RECORD(CONDF)%NAME COND, ROOT)
!! initialise the structure representing a condition
!! by making all signals referenced by it point at it
   %RECORD(ONEVF)%NAME ONEV
   %RECORD(OUTPUTF)%NAME OUTPUT
   %RETURN %IF COND==RECORD(NULL) 
   %IF COND_N=0 %START
      !! leaf node, referring to a signal 
      OUTPUT==COND_OUTPUT
      !! chain all CONDs depending on this output together
      ONEV==NEW GPEL
      ONEV_NEXT==OUTPUT_ONEV;   OUTPUT_ONEV==ONEV
      ONEV_COND==ROOT;   ONEV_OUTPUT==OUTPUT
   %FINISH %ELSE %START
      INITIALISE COND(COND_L,ROOT)
      INITIALISE COND(COND_R,ROOT)
   %FINISH
%END

%ROUTINE SET UP TRACES(%RECORD(ONEVF)%NAME LIST)
!! set up a list of traces - connect them to the specified outputs
   %WHILE %NOT LIST==RECORD(NULL) %CYCLE
      REMOVE EVENTS AT(LIST_OUTPUT)
      INITIALISE OUTPUT(LIST_OUTPUT,LIST_TRACE)
      LIST==LIST_NEXT
   %REPEAT
%END

%ROUTINE DO EVENTS
!! repeatedly remove the next event from the event queue
!! and perform it 
   %RECORD(INPUTF)%NAME INPUT
   %RECORD(OUTPUTF)%NAME OUTPUT 
   %RECORD(TELF)%NAME TRACE
   %RECORD(ONEVF)%NAME ONEV
   %RECORD(CONDF)%NAME COND
   %RECORD(CONNF)%NAME CONN
   %RECORD(GATEF)%NAME GATE,   G
   %INTEGER DISORDER,   TRANSITION,   CHANGE,   FROM,   TO
   %INTEGER P,   O,   VALUE,   NEWVALUE,   RANK,   OLDT
!!.................................................
!! transition 1 is FROM 0 TO X, 2 FROM X TO 1
!! transition 3 is FROM 1 TO X, 4 FROM X TO 0
!!.................................................
   %CYCLE
      GET NEXT EVENT;   !! sets EVENT as a side effect
      TIME=EVENT_TIME
      %EXIT %IF TIME>MAX TIME 
      GATE==EVENT_GATE
      TRANSITION=EVENT_TRANSITION;   RANK=EVENT_RANK
      CHANGE=NO 
      %IF TRANSITION<254 %START
         !! ordinary transition at a gate's input
         INPUT==EVENT_INPUT
         !! DISORDER is a measure of the number of transitions
         !! that are out of sequence
         DISORDER=RANK-(INPUT_NK+1)
         !! DISORDER=4 => HF rejection, 2=> spike or dip
         REPORT("Too many transitions out of sequence",DISASTER) %C
            %IF DISORDER>4
         !! calculate the TO and FROM values of the transition
         FROM=TRANSITION-1;   FROM=1 %IF FROM=3
         %IF TRANSITION<3 %THEN TO=TRANSITION %ELSE TO=4-TRANSITION
         !! and set a flag marking whether transition is FROM X 1
         P=FROM&1;   !! 1 if transition is 2 or 4
!!....................................................
!! and now a compressed form of Chicoix's algorithm
!!....................................................
         %IF DISORDER=0 %OR (P=1 %AND INPUT_P=1) %START
            INPUT_VALUE=TO %AND CHANGE=YES %IF INPUT_VALUE=FROM
            INPUT_P=P
         %FINISH %ELSE %START 
            INPUT_P=1 %IF P=1
         %FINISH
         INPUT_NK=RANK %IF RANK>INPUT_NK
      %FINISH %ELSE %IF TRANSITION=255 %START
         !! wakeup event for a trace
         TRACE==EVENT_TRACE 
         %CYCLE
            !! for each event in the hierarchy
            %IF TRACE_LENGTH<MAXINTEGER %START
               !! no children repeated infinitely often
               !! so create the next wakeup event
               %UNLESS (RANK>=TRACE_COUNT) %AND %C
                       (TRACE_NEXT==RECORD(NULL)) %START
                  CREATE EVENT(TIME+TRACE_LENGTH)
                  EVENT_GATE==GATE
                  %IF RANK<TRACE_COUNT %START
                     !! sub trace to be repeated
                     EVENT_TRACE==TRACE
                     EVENT_RANK=RANK+1
                  %FINISH %ELSE %START
                     !! next trace to be invoked
                     EVENT_TRACE==TRACE_NEXT
                     EVENT_RANK=1 
                  %FINISH
                  EVENT_TRANSITION=255;   !! a wakeup event
               %FINISH
            %FINISH
            %EXIT %IF TRACE_SUB==RECORD(NULL)
            !! process the sub trace
            TRACE==TRACE_SUB;   RANK=1
         %REPEAT
         !! and finally perform the (lowest level) event
         INPUT==RECORD(ADDR(GATE_INPUTS)) 
         VALUE=TRACE_VALUE
         NEWVALUE=((VALUE>>5)+(VALUE>>1))&SMASK
         %IF NEWVALUE#INPUT_VALUE %START
            INPUT_VALUE=NEWVALUE;   CHANGE=YES
         %FINISH
      %FINISH %ELSE %START
         !! a printing event
         PRINTSTRING(EVENT_NAME)
         WRITE(EVENT_NEWVALUE,1)
         SPACE
         WRITE(TIME,0)
         NEWLINE
      %FINISH
      %CONTINUE %IF CHANGE=NO
      !! input value has changed, so evaluate gate
      EVALUATE(GATE)
      OLDT=TIME
      !! and see if its outputs have changed
      %FOR O=1,1,GATE_TYPE_NOUT %CYCLE
         OUTPUT==GATE_OUTPUTS_OUTPUT(O)
         NEWVALUE=OUTPUT_VALUE;   VALUE=NEWVALUE>>2  
         NEWVALUE=NEWVALUE&SMASK
         %CONTINUE %IF NEWVALUE=VALUE&SMASK;   !! no change
!!..........................................................
!! calculate the transition on this output
         %IF NEWVALUE=HALF %START
            %IF VALUE=LO %THEN TRANSITION=1 %ELSE TRANSITION=3
         %FINISH %ELSE TRANSITION=4-NEWVALUE
!!..........................................................
!! and the time at which the transition occurs
         TIME=OLDT+GATE_DELAYS_D(TRANSITION)
!!..........................................................
!! output the event to the list of events for postprocessing
         CREATE EVENT(TIME)
         EVENT_NAME==OUTPUT_NAME_S
         EVENT_NEWVALUE=NEWVALUE
         EVENT_TRANSITION=254
         EVENT_RANK=0
!!.........................................................
!! see if there any conditions to evaluate, and if so then
!! evaluate them and take the relevent action
         ONEV==OUTPUT_ONEV
         %WHILE %NOT ONEV==RECORD(NULL) %CYCLE
            %IF %NOT ONEV_OUTPUT==RECORD(NULL) %START
               !! got a condition to evaluate
               COND==ONEV_COND
               %IF TRUE(COND) %START
                  !! connect dependent traces
                  SET UP TRACES(COND_ONEV)
                  ONEV_OUTPUT==RECORD(NULL); !! and flag as done
               %FINISH
            %FINISH
            ONEV==ONEV_NEXT
         %REPEAT
!!.........................................................
!! and now add consequential events to the event queue
         OUTPUT_VALUE=NEWVALUE+NEWVALUE<<2
         RANK=OUTPUT_RANK;   RANK=RANK+1;   OUTPUT_RANK=RANK
         !! finally propagate the input values
         CONN==OUTPUT_LINK
         %WHILE %NOT CONN==RECORD(NULL) %CYCLE
            G==CONN_GATE
            INPUT==CONN_INPUT
            CONN==CONN_LINK
            %CONTINUE %IF G_FN<0;   !! primary output
            CREATE EVENT(TIME);   !! sets EVENT
            EVENT_GATE==G
            EVENT_INPUT==INPUT
            EVENT_TRANSITION=TRANSITION 
            EVENT_RANK=RANK
         %REPEAT
      %REPEAT
   %REPEAT
%END

!!*************************************************
!!  Start of mainline code for the simulator      *
!!*************************************************

RETURN CODE=DEF STREAMS(CLIPARAM,DEFAULTS)
->DONE %UNLESS RETURN CODE=1

SELECTOUTPUT(CONSOLE)
NEWLINE
SPACES(3);   PRINTSTRING(HEADING)
NEWLINES(2)
 
!!****************************** 
!!  initialisation             * 
!!******************************

TOS=ADDR(STACK(0));   MAXTOS=TOS>>LAUPW
STACKTOP=ADDR(STACK(STACKLEN))>>LAUPW;   BOS=STACKTOP+1

DEFAULT DELAYS==RECORD(TOS); ZERO(DELAYSLEN); CLAIM(DELAYSLEN)
ZERO DELAYS==RECORD(TOS);    ZERO(DELAYSLEN); CLAIM(DELAYSLEN) 
ZERO DELAYS_NEXT==DEFAULT DELAYS
DELAYS==ZERO DELAYS
GTYPES==RECORD(NULL)
NONAME==STORE TAG(MAP STRING("?"))

READ KEYWORDS

!!***********************************
!! start of building data structure *
!! (reading from the I-code)        *
!!***********************************

%RECORD(GATEF)%NAME GATE
%INTEGER GATENO
%RECORD(DELAYSF)%NAME DELAY
%RECORD(GTYPEF)%NAME GTYPE
%RECORD(OUTPUTF)%NAME OUTPUT
%RECORD(FTAG)%NAME TAGLIST
%RECORD(CONDF)%NAME COND
%RECORD(CONNF)%NAME CONN,   CONNLIST
%RECORD(ONEVF)%NAME ONEV
%INTEGER FAN,   F,   SUBNO,   TNO,   VALUE,   V

SELECTINPUT(CIRCUIT);   OUTSTREAM=CONSOLE;!! may need to be EVENTS
RCH
%IF CH=CNTRL+'S' %THEN SKIPNUM %AND RCH
REPORT("Not an I-code file",DISASTER) %UNLESS CH=CNTRL+'U'
SKIPNUM
CIRCUIT HEADER==READ GATE(0);   !! read the circuit header
RCH
REPORT("I-code hierarchical, or otherwise invalid",DISASTER) %c
      %UNLESS CH=CNTRL+'J'
READ(NOGATES)
REPORT("Icode begins with an empty unit",DISASTER) %UNLESS NOGATES>0

!! build the list of gates
GATES==RECORD(TOS);   CLAIM(NOGATES+1)
GATES_GATE(0)==CIRCUIT HEADER 
%FOR GATENO=1,1,NOGATES %CYCLE
   GATES_GATE(GATENO)==READ GATE(GATENO)
%REPEAT

!!*********************************************
!! read the connection nets and build the     *
!! connections records. nets with constant    *
!! values are initialised at this stage       *
!!*********************************************

RCH
REPORT("Expecting nets, found none",ERROR) %UNLESS CH=CNTRL+'N' 
%WHILE CH=CNTRL+'N' %CYCLE
   TAGLIST==RECORD(NULL);   !! list of names of the Net
   OUTPUT==RECORD(NULL);    !! the (unique) output feeding the net
   CONNLIST==RECORD(NULL);  !! the list of connections (inputs)
   RCH
   %WHILE CH=CNTRL+'A' %CYCLE
      !! for each net fragment
      TAG==STORE TAG(READ STRING)
      TAG_OWNER==TAGLIST;   TAGLIST==TAG
      READ(FAN)
      %FOR F=1,1,FAN %CYCLE
         READ(SUBNO);   READ(TNO)
         GATE==GATES_GATE(SUBNO)
         GTYPE==GATE_TYPE
         !! locate the output, or the input
         %IF (SUBNO>0 %AND TNO>GTYPE_NIN) %OR %C
             (SUBNO=0 %AND TNO<=GTYPE_NOUT) %START
            !! got an output, or primary circuit input (SUBNO=0)
            TNO=TNO-GTYPE_NIN %IF SUBNO>0
            !! error (fan-in>1) if OUTPUT already set
            %UNLESS OUTPUT==RECORD(NULL) %START
               REPORT("Net ".TAG_S." has fan-in",ERROR)
               REPORT("Use a WOR or WAND element to remove it",ERROR)
            %FINISH %ELSE %START
               OUTPUT==GATE_OUTPUTS_OUTPUT(TNO)
            %FINISH
         %FINISH %ELSE %START
            !! got an input, or primary circuit output
            TNO=TNO-GTYPE_NOUT %IF SUBNO=0
            !! build the connection element
            CONN==RECORD(TOS);   CLAIM(CONNLEN)
            CONN_LINK==CONNLIST;   CONNLIST==CONN
            CONN_GATE==GATE
            CONN_INPUT==GATE_INPUTS_INPUT(TNO)
         %FINISH
      %REPEAT
      RCH
   %REPEAT
   !! we have now read a complete net
   !! see if the net has a constant value (.VCC, .0, etc) 
   VALUE=HALF
   TAG==TAGLIST
   %WHILE %NOT TAG==RECORD(NULL) %CYCLE
      !! for the name of each Net fragment
      V=(TAG_VALUE>>8)&3
      %UNLESS V=HALF %START
         %IF VALUE=HALF %START
            VALUE=V
         %FINISH %ELSE %IF VALUE#V %START
            VALUE=-1
         %FINISH
      %FINISH
      TAG==TAG_OWNER
   %REPEAT
   !! deal with the cases that the net has no
   !! fanin, and no value, and that the net has two 
   !! conflicting values
   %IF (VALUE=HALF %AND OUTPUT==RECORD(NULL)) %OR VALUE<0 %START
      SELECTOUTPUT(CONSOLE)
      PRINTSTRING("*Net ")
      TAG==TAGLIST
      %CYCLE
         PRINT TAG(TAG)
         TAG==TAG_OWNER
         %EXIT %IF TAG==RECORD(NULL)
         PRINTSYMBOL('/') 
      %REPEAT
      %IF VALUE<0 %START
         PRINTSTRING(" has two conflicting values")
      %FINISH %ELSE %START
         PRINTSTRING(" has no fan-in, and an undefined value")
      %FINISH
      !! prompt for the value
      %IF NERRORS=0 %START
         !! no point if going to stop anyway
         SELECTINPUT(CONSOLE)
         %CYCLE
            NEWLINE
            PROMPT("Value= ")
            SKIPSYMBOL %WHILE NEXTSYMBOL=' '
            READSYMBOL(VALUE)
            V=VALUE;   READSYMBOL(V) %WHILE V#NL 
            VALUE=(VALUE-'0')<<1
            %EXIT %IF VALUE=LO %OR VALUE=HI
            PRINTSTRING("Possible values are 0 or 1")
         %REPEAT
         SELECTINPUT(CIRCUIT) 
      %FINISH %ELSE %START
         NEWLINE;   !! to end the error message
         VALUE=HALF;   !! dummy to keep IMP happy
      %FINISH
      SELECTOUTPUT(OUTSTREAM)
   %FINISH
   !! make the tags point at the OUTPUT they identify
   !! and the OUTPUT point at its tag
   %WHILE %NOT TAGLIST==RECORD(NULL) %CYCLE
      TAG==TAGLIST;   TAGLIST==TAGLIST_OWNER
      TAG_OWNER==OUTPUT
      OUTPUT_NAME==TAG %UNLESS OUTPUT==RECORD(NULL)
   %REPEAT
   !! make output point at list of connections
   %UNLESS OUTPUT==RECORD(NULL) %START
      OUTPUT_LINK==CONNLIST
      OUTPUT_VALUE=VALUE+VALUE<<2
   %FINISH
   !! and finally set the input values
   %UNLESS VALUE=HALF %START
      CONN==CONNLIST
      %WHILE %NOT CONN==RECORD(NULL) %CYCLE 
         CONN_INPUT_VALUE=VALUE
         CONN==CONN_LINK
      %REPEAT
   %FINISH
%REPEAT;   !! for each net

REPORT("Simulation abandonned",DISASTER) %IF NERRORS>0
INITIALISE CIRCUIT

!!*************************************************
!! dynamic simulation phase - Chicoix's algorithm *
!!*************************************************

!! dump initial output values
SELECTOUTPUT(EVENTS);   OUTSTREAM=EVENTS
PRINTSYMBOL('$');   NEWLINE
PRINTSTRING("   Simulation of circuit ")
PRINT TAG(CIRCUITHEADER_TYPE_NAME)
PRINTSTRING(" by ")
PRINTSTRING(HEADING);   NEWLINES(3)

PRINTSTRING("   Circuit inputs at start of simulation:-");   NEWLINES(2)
%FOR F=1,1,CIRCUITHEADER_TYPE_NOUT %CYCLE
   OUTPUT==CIRCUITHEADER_OUTPUTS_OUTPUT(F)
   SPACES(8)
   PRINT TAG(OUTPUT_NAME);   PRINTSYMBOL('=')
   V=OUTPUT_VALUE&SMASK
   %IF V=1 %THEN PRINTSYMBOL('X') %ELSE PRINTSYMBOL('0'+V>>1)
   NEWLINE
%REPEAT
NEWLINE

PRINTSTRING("   Signal traces attatched to circuit inputs:-")
NEWLINES(2)
ONEV==ON EVENTS
%WHILE %NOT ONEV==RECORD(NULL) %CYCLE
   PRINT ONEV(ONEV);   NEWLINE
   ONEV==ONEV_NEXT
%REPEAT
PRINTSYMBOL(12);   !! newpage
PRINTSYMBOL('$');   NEWLINE

!! output the initial values to the trace file
%FOR GATENO=0,1,NOGATES %CYCLE
   GATE==GATES_GATE(GATENO)
   %FOR F=1,1,GATE_TYPE_NOUT %CYCLE
      OUTPUT==GATE_OUTPUTS_OUTPUT(F) 
      PRINTSTRING(OUTPUT_NAME_S)
      WRITE(OUTPUT_VALUE&SMASK,1)
      SPACE
      PRINTSYMBOL('0')
      NEWLINE
   %REPEAT
%REPEAT

!! connect initial traces
%WHILE %NOT ON EVENTS==RECORD(NULL) %CYCLE
   ONEV==ON EVENTS;   ON EVENTS==ON EVENTS_NEXT
   COND==ONEV_COND
   %IF COND==RECORD(NULL) %START
      !! an unconditional trace connection
      INITIALISE OUTPUT(ONEV_OUTPUT,ONEV_TRACE)
   %FINISH %ELSE %START
      !! a conditional trace
      !! initialise the condition if not already done ...
      INITIALISE COND(COND,COND) %IF COND_ONEV==RECORD(NULL)
      !! and chain the (OUTPUT,TRACE) pair to the condition
      ONEV_NEXT==COND_ONEV
      COND_ONEV==ONEV
   %FINISH
%REPEAT
 
!! set random delays if required
%IF RANDOM DELAYS=YES %START
   DELAY==DELAYS
   %WHILE %NOT DELAY==RECORD(NULL) %CYCLE
      VALUE=RANDOM(DELAY_D(1),DELAY_D(2))
      DELAY_D(1)=VALUE;   DELAY_D(2)=VALUE
      VALUE=RANDOM(DELAY_D(3),DELAY_D(4))
      DELAY_D(3)=VALUE;   DELAY_D(4)=VALUE
      DELAY==DELAY_NEXT
   %REPEAT
%FINISH

!DIAGNOSTIC
DUMP STACK %if monitor#0
!DIAGNOSTIC END

DO EVENTS
PRINTSYMBOL('*');   NEWLINE;      !! end of tracee

SELECTOUTPUT(CONSOLE)
PRINTSTRING("*End of simulation");   NEWLINE

!! output the event queue distribution if required
%IF MONITOR#0 %START
   SELECTOUTPUT(DUMP)
   %FOR F=1,1,100 %CYCLE
      %IF F-(F//10)*10=1 %START
         NEWLINE
         WRITE(F,2);   PRINTSTRING(": ")
      %FINISH
      WRITE(EVENTQDISTN(F),4)
   %REPEAT
   NEWLINE
%FINISH

DONE:
%ENDOFPROGRAM