program { logicsim.p } logicsim( input, output, f1, f2, f3, f4 );

{ The Iowa Logic Simulator, version 10
    a digital logic simulation system taking
    input in the Iowa Logic Specification Language. }

{ -----------------------------------------------------------------
  Copyright 1988, Douglas Jones.

    Permission is hereby granted to make copies of this program for
    research and personal use so long as this copyright notice is
    included in the copy.

    Neither this software nor any software derived from it may be
    sold or incorporated into a product which is sold without
    explicit permission from the copyright holder.
  ----------------------------------------------------------------- }

{ -----------------------------------------------------------------
  Warrantee:
    This software is distributed without any warrantee.  I hope it
    will be useful, but it may not work at all.  You get what you
    pay for.
  ----------------------------------------------------------------- }

{ Version 1:  started May 26, 1983; released for student use, fall 83;
    Douglas W. Jones -- buildmodel
    Wun-Chin Kao     -- simulate }
{ Version 2:  started Feb 11, 1984; released for student use, fall 84;
    George S. Singer -- add subcircuit mechanism to simulate }
{ Version 3:  started Fall, 1984; not released;
    George S. Singer -- add use statement, major changes to buildmodel 
                        See Univ. of Iowa, Dept. of Comp. Sci, TR 85-03 }
{ Version 4:  started Jan 4, 1985; released for student use, spring 85;
    Douglas W. Jones -- eliminate command mode from simulate }
{ Version 5:  started June, 1985; released for student use, fall 85;
        Work on Version 5 was supported, in part, by the University of Iowa
        Weeg Computing Center in the form of salary support for Daniela Rus.
    Daniela Rus      -- move most lexical work to firstpass, fast event set
    Douglas W. Jones -- structural changes in simulate to increase speed }
{ Version 6:  started Sept., 1986;
    Jing Jan         -- structural changes in buildmodel to increase clarity
    Douglas W. Jones -- ditto, and changes in buildmodel for increased speed }
{ Version 7:  started Apr., 1987; released for student use, summer 87;
    Jing Jan         -- implemented exprs, arrays, iterators and parameterized
                        subcircuits }
{ Version 8:  started June, 1987; released for student use, jan 1988;
    Jing Jan         -- implemented conditional parts & wire lists, as well
                        as free mixing of constant and subcirc declarations
    Douglas W. Jones -- added pulse input to simulator, latch gates, changed
                        simulation header to accomodate arrays.  }
{ Version 9:  started April, 1988;
    Douglas W. Jones -- bug fixes, faster pass 1,
                        changed boolean operators to &, |, \.}
{ Version 10:  started Nov, 1998;
    Douglas W. Jones -- bug fixes, line nums from preprocessor, range
                        comparison, range or, assert construct, fix tristate
			bitcount function. }

{ Bugs:
    The official grammar lists very specific details of where commas and
        semicolons are allowed.  The simulator enforces none of these rules.
    If two different source files include the same source file, the result
        is that the text is included twice in pactext; this should be avoided.
        Now that file names are in the symbol table, it might be possible
        to search for a previous use of a file and, in that case, avoid
        rereading files, but instead, simply duplicate the needed
        parts of the data structure, specifically, the subcircuit description
        nodes for the root level subcircuits found in the file in question.
    Procedure readline depends on the ASCII colating sequence.
    The symbol table implements dynamic scope rules; it should implement
        static scope rules!
    Procedure displayheader is a mess, resulting from shotgun debugging and
        patching over the years.
    Should not rely on the characters # $ @ [ \ ] ^ | ~ to remain same from
        one language to another in ISO character set; curly braces also
        change from one language to another.  This means use of | and \ for
        or and not in expressions should have an alternative, possibly !
        and -. 
}

label 9999 { for goto from procedure fatalerror to end of main program };

const
    { constants governing limits on circuits which can be simulated }
    strpoollim = 8000  { size of strpool, identifier and string table };
    pactextlim = 16000 { size of pactext, packed input copy (see textradix) };
    tabsize = 2303     { number of entries in symtab (see textradix) };
    niltabindex = tabsize { last entry used for nil ptr to symtab };
    pooldel = '@'      { delimiter character used strpool (illegal in input) };
    linelen = 120      { input line length limit (intentionally generous) };
    filestklength = 4  { length of file stack (see f1, f2, f3, f4) };
    maxparams = 20     { suc(maximum param count) for gates and subcircuits };
    undefined = -maxint { constant for undefined parameter or array index };

    { definitions of fundamental time units, in nanoseconds }
    second = 1.0e9;
    millisecond = 1.0e6;
    microsecond = 1.0e3;
    nanosecond = 1.0;
    defgdel = 10.0     { default gate delay in nanoseconds; common TTL };
    defwdel = 0.7      { default wire delay in nanoseconds; 8-inch wire };

type
    { names of logic levels used in simulation }
    logiclevel = (low { 0, false }, high { 1, true }, open {tristate} );

    strpoolindex = 0 .. strpoollim { index type for strpool };
    tabindex = 0 .. tabsize { index type for symbol table in buildmodel };

    lineindex = 1..linelen { index type for lines of text };
    line = packed array [lineindex] of char;

    eventkinds = (lateinit, showoutput, getinput, logicchange, outchange);
    eventref = ^event;
    gateref = ^gate;
    event = record { of one event in simulate, used also to pass
                            a list of gates from buildmodel to simulate }
                kind: eventkinds;
                old, new: logiclevel;
                time: real;
                gateid: gateref;
                inputval: integer;

                { link fields for event list management }
                downlink: eventref;
                leftlink: eventref;
            end { record };

    { data structures used to represent the circuit being tested }
    wireref = ^wirelist;
    instdescrref = ^instdescr;
    tieptref = ^tiept;

    gatekind = ( { symmetric (all inputs have equal meanings) }
                 andg, nandg, org, norg, xorg, equg

                 { tristate drivers (have data and control inputs) }
               , trig, ntrig

                 { memory element (d latch) (has data and control inputs) }
               , latchg

                 { tristate bus (a named wire between bus drivers) }
               , trbg

                 { input/output interface to simulator, unused in buildmodel }
               , iogate

                 { not gate; changed to 1-input nand prior to gate allocation }
               , notg
               );

    gate = packed record
               { fields used for gate naming and error reporting }
               name: strpoolindex { name of gate };
               inst: instdescrref { circuit instance it is part of };

               { fields used for arrays of gates }
               index: integer { index of gate };
               nextgate: gateref { next gate in array (circularly linked) };
      {10}     { nextgate not needed after model is built }

      {10}     { fields used in fixtristate after model is built }
      {10}     { nextgate: if non-nil, gate where outputs were relocated to }

               { fields used for gate semantics }
               lastout: logiclevel;
               outto: wireref;
               delay: real;
               request: eventref;
               case kind:gatekind of
                  andg, nandg, org, norg, xorg, equg, trbg: (
                      { symmetrical logic gates are all the same }
                      fanin: integer;
                      instates: array [ logiclevel ] of integer;
                  );
                  ntrig, trig, latchg: (
                      inp, control: logiclevel;
                  );
                  iogate: (
                      next: gateref;
                      state: logiclevel;
                      changecount: integer;
                  );
                  notg: ( { this variant is never allocated! }
                  );
           end { record };

    instdescr = record { describes one subcircuit instance }

                    { fields used for error reporting }
                    name: strpoolindex { name of gate };
                    inst: instdescrref { circuit instance it is part of };

                    { fields used if instance is a member of an array }
                    index: integer { index of instance };
                    nextinst: instdescrref { next instance in sequence };

                    { fields used during construction of circuit only }
                    inputlist,
                    outputlist: tieptref;
                end { record };

    wirelist = packed record
                   g: gateref { gate this wire connects to };
                   inputval: integer { pin number of gate connected };
                   delay: real { delay of wire };
                   next: wireref { next wire in this chain };
               end { record };

    { types for Tie point management, used only in secondpass but
      declared here because they hook onto the symbol table and inst records }

    tiept = record   { input or output nodes of subs }
                slot: tabindex { name of this tiepoint };
                index: integer { subscript of this tiepoint };
                nexttiept: tieptref { successor of this in tiepoint list };
                nextelem: tieptref { used to circularly link tiepoint arrays };
                isinput: boolean { if false, this must be an output tiepoint };

                { if tiepoint has unknown source, following may be non-nil }
                destlist: wireref { pointer to wirelist };

                { if tiepoint has known source, following will be non-nil }
                srcgate: gateref { source (if a gate) };
                srctiept: tieptref { source (if a tiepoint) };
                delay: real { delay from source to this tiepoint };
            end;

var  { data structures for description of the model, built by second pass }
    inputs, outputs: gateref { global input and output gate lists };
    hiwire, lowire: wireref { global input constant sources };
    gatelist: eventref { master list of gates in model,
                         used for initialization in simulate };

    { data structures used for symbolic information about model; note,
      these are built by firstpass, but used everywhere }
    strpool: packed array [strpoolindex] of char;
    circuitinst: instdescrref { the main circuit instance };

    waserror: boolean { is circuit correctly defined };

    { data structures used for input processing }
    f1, f2, f3, f4: text { stack of input files };

    { private data for random number generation }
    seed: integer;



    { random number generation package }

    function random: real;
    { returns a random number between 0 and 1 }
    const
        modulus=65536;
        mul=25173;
        inc=13849;
    begin
        seed :=((mul * seed) + inc) mod modulus;
        random :=seed / modulus;
    end { random };

    function jitter( r: real ): real;
    { returns a multiplier approximately equal to 1, but with
      a random variation constrained by the given range(which
      must be less than 1 if negative results are to be avoided) }
    begin
        jitter := 1 + r * (1 - (random + random));
    end { jitter };



    { print name management }

    procedure printname( r: strpoolindex ; var len:integer; limit: integer);
    { print a name from the strpool, report printed length in len, but never
      print more than limit chars }
    begin
        len := 0;
        while (strpool[r] <> pooldel) and (len < limit) do begin
            write( strpool[r] );
            r := r + 1;
            len := len + 1;
        end;
    end { printname };

    procedure printprefix( inst: instdescrref; length: integer );
    { print the prefix path name of a circuit instance }
    var i: integer;
    begin
        if (inst <> nil) and (length > 0) then begin 
            printprefix( inst^.inst, length - 1 );
            printname( inst^.name, i, 80 );
            if inst^.index <> undefined then
                write( '(', inst^.index:1, ')' );
            write( '.' );
        end;
    end { printprefix };

    procedure printgatename( gate: gateref );
    { print the full path name of a gate (through all instances) }
    var i: integer;
    begin { printgatename }
        printprefix( gate^.inst, maxint );
        printname( gate^.name, i, 80 );
        if gate^.index <> undefined then
            write( '(', gate^.index:3, ')' );
    end { printgatename };



    { basic line management package }

    procedure readline( var f: text; var l: line; var len: integer );
    { read an input line from f ( cleanly );
      will strip all pooldel and control characters out of input;
      on end file, returns a line holding pooldel in column 1;
      l[len+1] is guaranteed to be blank; len < linelen always holds!
      WARNING:  This code depends on the ASCII colating sequence.
    }
    var ch: char;
        i: 0..linelen;
    begin
        i := 0;
        if not eof( f ) then begin
            while not eoln( f ) do begin
                read( f, ch );
                if ch = pooldel then begin
                    { ignore the string pool delimiter }
                end else if (ch >= ' ') and (ch <= '~') then begin { printing }
                    { the above line of code detects ASCII printing chars }
                    if i < (linelen - 1) then begin
                        i := i + 1;
                        l[i] := ch;
                    end;
                end else if ch = chr(8) then begin { ASCII backspace }
                    if i > 0 then i := i - 1;
                end else if ch = chr(9) then begin { ASCII tab }
                    if i < (linelen - 1) then begin { convert to blank }
                        i := i + 1;
                        l[i] := ' ';
                    end;
                end else begin
                    { ignore everything else }
                end;
            end { end while };
            readln( f );
        end else begin { at eof }
            i := 1;
            l[i] := pooldel;
        end;
        { assert 0 <= i < linelen }
        l[i+1] := ' ';
        len := i;
    end { readline };
    
    procedure writeoutput( var l:line; len: integer );
    { write a line cleanly to the terminal, minus trailing blanks;
      the line is passed by reference to avoid copying! }
    var i: lineindex;
    begin
        for i := 1 to len do write( l[i] );
        writeln;
    end { writeoutput };



    { main procedure to compile circuit specification }
    
    procedure buildmodel;
    { build the data structures for simulating a logic circuit }

    const
        textradix = 64 { radix used for integers encoded in pactext; this
                          must be bigger than root2( tabsize ), also bigger
                          than root3( pactextlim ), and less than
                          ord(maxchar); we assume that chr(0) is legal };
        undeflevel = 0 { nesting level of undefined ids };

    type
        fileref = 0..filestklength { ref to a file in the file stack };
        pactextindex = 0 .. pactextlim { index type for pactext };
        paramindex = 0 .. maxparams { parameter list index type };

        { structure describing nesting relations between (sub)circuits }
        subref = ^subdef;
        subdef = record
                     { description of circuit header, including name }
                     headpos: pactextindex { points to text after name };
                     slot: tabindex { name of the subcircuit };

                     parsed: boolean { were errors reported in this circuit };
                     instcount: integer { number of instances created };

                     { fields for structure itself }
                     son: subref { head of list of sons of this circuit };
                     brother: subref { link in list of sons };
                 end;

        { types of symbols and keywords }

        lextyp = { type of a lexeme; see arrays lextoch and chtolex,
                   initialized in initlexpack; changes here go there too!
                   the bounds will always be assumed to be id .. junk }
                 (
                  { complex lexeme types with other attributes,
                    always in the bounds id .. res }
                  id, inum, rnum, hop, res,

                  { simple cases such as punctuation follow }
                  colon, dot, plus, minus, star, slash, equal,
                  dotdot, starstar, bpar, epar, eofile,
                  less, lesseq, noteq, greateq, great,
                  andop, orop, notop,

                  kin { used in gotbutwant to flag 'in' is missing },
                  junk { not classifiable as a lexeme, also used between
                         the time a new symbol is put in the symbol table
                         and the time it is given appropriate attributes }
                 );

        keytyp = { type of a keyword; note: the bounds of keytyp will
                   always be assumed to be keycirc .. notkey; the order
                   of these determines which of a set of expected keywords
                   will be used in an error message when one is not found }
                 (keycirc 
                 ,keyint,  keyreal, keytime, keyrange, keybool
      {10}       ,keyassert
                 ,keyuse
                 ,keyinp,  keyoutp, keypart, keywire, keyend
                 ,keyfor,  keyto,   keydo,   keyendf
                 ,keyif,   keythen, keyelse, keyendif
                 ,keymod
                 ,notkey { not a keyword } );

        iduse =  { the use to which an indentifier has been put }
                 (inuse, outuse, gateuse, typeuse, subuse, instuse
                 ,decluse, unuse { use not yet determined } );

        symref = ^symbol;

        { types used for storing the value of an expression }

        exprtyp = ( { type of an expression }
                    inttyp, realtyp, timetyp, rangetyp, circtyp, booltyp,

                    undef { indicates the expression was in error },
                    noexpr { in a parameter list, indicates the end }
                  );

        valtyp = record
                     case typ: exprtyp of
                       inttyp: (ival: integer);
                      realtyp,
                      timetyp: (rval: real);
                     rangetyp: (first, last: integer);
                      booltyp: (bval: boolean);
                      circtyp: (subptr: symref);
                        undef,
                       noexpr: ();
                 end { record };

        { types used for storing a subcircuit }

        symbol = record
                     name: strpoolindex;
                     case typ: lextyp of
                         res: ( restyp: char { one letter code for it } );
                          id: ( level: integer {nesting level};
                                stkptr: symref { previous definition };
                                nextsym: tabindex { next symbol, same level };

                                { next 2 line applies only when
                                  use in [inuse, outuse, gateuse, instuse]
                                  if it is not an array, both equal undefined }
                                first, last: integer { array bounds if array };
                 
                                case use: iduse of
                                   inuse: (inputdef: tieptref);
                                  outuse: (outputdef: tieptref);
                                 gateuse: (g: gateref);
                                 typeuse: (t: gatekind;
                                           max, min: paramindex;
                                           typecount: integer);
                                  subuse: (s: subref);
                                 instuse: (inst: instdescrref );
                                 decluse: (valu: valtyp);
                                   unuse: ()
                              );
                        inum: ( ival: integer );
                        rnum: ( rval: real );

                        hop, colon, dot, plus, minus, star, slash,
                        equal, dotdot, starstar, bpar, epar, eofile,
                        less, lesseq, noteq, greateq, great, andop,
                        orop, notop, kin, junk
                            : ();
                 end { record };

    var { pseudo constants used in building and reading pactext }
        rescode: array[ char ] of keytyp { used to unpack keywords };
        lextoch: array[ lextyp ] of char { used to pack lexemes };
        chtolex: array[ char ] of lextyp { used to unpack lexemes };

        { pseudo constant pointers to predefined idents (not keywords!) }
        symin, symout: tabindex;
        symctl, symdata: tabindex;
        symsize, symfirst, symlast: tabindex;
        symodd, symonebits: tabindex;
        symhi, symlo: tabindex;
        symtally: tabindex;

        { the primary data items passed from firstpass to secondpass }

        pactext: packed array [pactextindex] of char {encoded text};
                        { the data format used in pactext is most
                          clearly documented in firstpass.copy. }

        symtab: array [tabindex] of symref { the symbol table };
        subhead: subref { root of the tree of subcircuits };
        tally: boolean { does user want tally of subcircuit and gate use? };


        procedure printsym( s: tabindex );
        { print a symbol; used inside error message packages of both passes }
        var xx: integer;
        begin
            write( '"' );
            if symtab[s] <> nil
              then printname( symtab[s]^.name, xx, 80 )
              else write( '-- error --' );
            write( '"' );
        end { printsym };

        procedure firstpass;
        { has to read from several files the definitions of circuits and
          of the main program and put them in the strpool. Also create
          the subcircuit structure, which is hanging from headSub }

        type
            errtype = ( errstrpoolovf, errsymtabovf, errunexpeof,
                        errcuioexp, errfilenest, errcirexp,
                        erridexp, erreofexp, erreparexp,
      {10}              errjunk,
                        errbadnum, errpactextovf );

            filerec = record
                          level: fileref;
                          name: tabindex { of file name };
                          currentline: line;
                          lineno: integer;
                          linepos: lineindex;
                      end;

        var { logical constants, legal characters, legal chars in idents }
            validch, idchars: set of char;

            currentfile: fileref { file currently reading from };

            srcfile: tabindex { index of name of current file in symtab };
            srcline: line { current line, read from };
            srclen: integer { number of characters in srcline };
            srclno: integer { line number of srcline };
            srcpos: lineindex { lexical scanner position in the srcline };
            srcchar: char { the character at srcpos in srcline };

            lexstart: lineindex { position where lexeme starts };
            lexend: lineindex { position where lexeme ends };
            lexemetyp: lextyp { type of lexeme };
            lexkeytyp: keytyp { more info for lexemetyp = res };
            lexslot: tabindex { more info if lexemetyp in [id,num] };

            strpos: strpoolindex { current position in strpool };

            symcount: tabindex { count of symbols defined in symtab };

            textpos: pactextindex { current position in pactext };
            textfile: tabindex { of most recent token copied to pactext };
            textlno: integer { of most recent token copied to pactext };

            procedure initializations;
            { initialize for firstpass }

                procedure initsymtab;
                { enter the reserved words in the symbol table }
                const strlen = 8;
                type string8 = packed array [1..strlen] of char;
                     { misspell string to avoid collisions with the reserved
                       word string used in some extended compilers; this
                       type is used only in define, and quoted strings passed
                       as parameters to define must coerce to this type. }
                var i, entry: integer;

                    procedure define( s: string8 );
                    { enter s in strpool and put it in the symbol table at
                      a position returned in the global variable entry;
                      This code computes a hash value of s;
                      NOTE: it must use the same hash function as
                      is used for hashing in lookup }
                    var start: strpoolindex;
                        j: integer;
                    begin
                        { put the string in strpool }
                        start := strpos { save the beginning };
                        for j := 1 to strlen do if s[j] <> ' ' then begin
                            strpool[ strpos ] := s[j];
                            strpos := strpos + 1;
                        end;
                        strpool[ strpos ] := pooldel;
                        strpos := strpos + 1;

                        { compute hash function as hash(s)
                          = (ord car(s) + 5*hash(cdr(s))) mod tabsize }
                        entry := 0;
                        for j := (strpos - start) - 1 downto 1
                          do entry := (entry*5 + ord(s[j])) mod tabsize;

                        { resolve collisions; note that this code
                          assumes that all definitions are new ones and
                          thus that a search for an empty slot suffices }
                        while symtab[ entry ] <> nil
                          do entry := (entry + 1) mod tabsize;

                        { begin building symtab entry; others end job }
                        new( symtab[ entry ] );
                        symtab[entry]^.name := start;
                        symcount := symcount + 1;
                    end { define };
                        
                    procedure makeid;
                    { make symbol at symtab[entry] into an identifier }
                    begin
                        symtab[entry]^.typ := id; 
                        symtab[entry]^.use := unuse;
                        symtab[entry]^.level := undeflevel;
                    end { makeid };

                    procedure maketime( t: real );
                    { make symbol at symtab[entry] into a time interval name }
                    begin
                        symtab[entry]^.typ := id;
                        symtab[entry]^.level := undeflevel;
                        symtab[entry]^.use := decluse;
                        symtab[entry]^.valu.typ := timetyp;
                        symtab[entry]^.valu.rval := t;
                    end { maketime };

                    procedure makebool( b: boolean );
                    { make symbol at symtab[entry] into a boolean constant }
                    begin
                        symtab[entry]^.typ := id;
                        symtab[entry]^.level := undeflevel;
                        symtab[entry]^.use := decluse;
                        symtab[entry]^.valu.typ := booltyp;
                        symtab[entry]^.valu.bval := b;
                    end { makebool };

                    procedure makekey( k: keytyp; c: char );
                    { make symbol at symtab[entry] into a reserved word }
                    begin
                        symtab[entry]^.typ := res;
                        symtab[entry]^.restyp := c;
                        rescode[c] := k;
                        chtolex[c] := res;
                    end { makekey };
                        
                    procedure makegate( gk: gatekind; lowp, highp: paramindex );
                    { make symbol at symtab[entry] into a gate of type g }
                    begin
                        with symtab[entry]^ do begin
                            typ := id;
                            level := undeflevel;
                            use := typeuse;
                            t := gk;
                            max := highp;
                            min := lowp;
                            typecount := 0;
                        end;
                    end;

                begin { initsymtab }

                    for i := 0 to tabsize do symtab[i] := nil;

                    { the following nonsense assignment is included to suppress
                      error messages from compilers that think entry is
                      undefined and don't notice that define defines it as a
                      side effect. }
                    entry := 0;

                    define('in      '); makeid; symin := entry;
                    define('out     '); makeid; symout := entry;
                    define('control '); makeid; symctl := entry;
                    define('data    '); makeid; symdata := entry;

                    define('size    '); makeid; symsize := entry;
                    define('first   '); makeid; symfirst := entry;
                    define('last    '); makeid; symlast := entry;
                    define('odd     '); makeid; symodd := entry;
                    define('onebits '); makeid; symonebits := entry;

                    define('high    '); makeid; symhi := entry;
                    define('low     '); makeid; symlo := entry;

                    define('tally   '); makeid; symtally := entry;

                    define('true    '); makebool( true );
                    define('false   '); makebool( false );

                    define('s       '); maketime( second );
                    define('ms      '); maketime( millisecond );
                    define('us      '); maketime( microsecond );
                    define('ns      '); maketime( nanosecond );

                    define('not     '); makegate( notg, 0, 1 );
                    define('equ     '); makegate( equg, 0, 1 );
                    define('and     '); makegate( andg, 1, 2 );
                    define('nand    '); makegate( nandg, 1, 2 );
                    define('or      '); makegate( org, 1, 2 );
                    define('nor     '); makegate( norg, 1, 2 );
                    define('xor     '); makegate( xorg, 0, 1 );
                    define('bus     '); makegate( trbg, 0, 0 );
                    define('tsgate  '); makegate( trig, 0, 1 );
                    define('ntsgate '); makegate( ntrig, 0, 1 );
                    define('latch   '); makegate( latchg, 0, 1 );

                    { the one letter codes listed for each keyword must not
                      conflict with the codes used in lextoch (see below) }
                    define('circuit '); makekey( keycirc, 'C' );
                    define('inputs  '); makekey( keyinp, 'I' );
                    define('outputs '); makekey( keyoutp, 'O' );
                    define('parts   '); makekey( keypart, 'P' );
                    define('wires   '); makekey( keywire, 'W' );
                    define('end     '); makekey( keyend, 'E' );
                    define('to      '); makekey( keyto, 'T' );
      {10}          define('assert  '); makekey( keyassert, 'S' );
                    define('use     '); makekey( keyuse, 'U' );
                    define('for     '); makekey( keyfor, 'F' );
                    define('mod     '); makekey( keymod, 'M' );
                    define('do      '); makekey( keydo, 'D' );
                    define('endfor  '); makekey( keyendf, 'N' );
                    define('integer '); makekey( keyint, 'G' );
                    define('real    '); makekey( keyreal, 'R' );
                    define('time    '); makekey( keytime, 'V' );
                    define('range   '); makekey( keyrange, 'A' );
                    define('boolean '); makekey( keybool, 'B' );
                    define('if      '); makekey( keyif, 'J' );
                    define('then    '); makekey( keythen, 'H' );
                    define('else    '); makekey( keyelse, 'L' );
                    define('endif   '); makekey( keyendif, 'K' );
                end { initsymtab };

                procedure initlexpack;
                { the one letter codes assigned here must differ from those
                  used above for keywords (as the second parameter to makekey)
                  and they must not include the digits used for line counting
                  in firstpass.copy and in secondpass.nextlex or blank, used
                  as a prefix on filenames in firstpass.fixhop and
                  secondpass.nextlex, or cedilla, used to negate line numbers }
                var lex: lextyp;
                begin
                    lextoch[id] := 'i';
                    lextoch[inum] := 'n';
                    lextoch[rnum] := 'r';
                    lextoch[hop] := 'h' { see planthop, secondpass.nextlex };
                    lextoch[res] := 's' { substitute rescode for this };
                    lextoch[colon] := ':';
                    lextoch[dot] := '.';
                    lextoch[plus] := '+';
                    lextoch[minus] := '-';
                    lextoch[star] := '*';
                    lextoch[slash] := '/';
                    lextoch[equal] := '=';
                    lextoch[dotdot] := 'd';
                    lextoch[starstar] := 's';
                    lextoch[bpar] := '(';
                    lextoch[epar] := ')';
                    lextoch[eofile] := 'e' { never sent! };
                    lextoch[less] := '<';
                    lextoch[lesseq] := 'l';
                    lextoch[noteq] := 'x';
                    lextoch[greateq] := 'g';
                    lextoch[great] := '>';
                    lextoch[andop] := '&';
                    lextoch[orop] := '!';
                    lextoch[notop] := '\';
                    lextoch[kin] := 'k' { never sent!};
                    lextoch[junk] := 'j' { never sent! };

                    for lex := id to junk do chtolex[lextoch[lex]] := lex;
                end { initlexpack };

            begin { initializations }
                strpos := 0;
                textpos := 0;
                currentfile := 0;
                symcount := 0;
                tally := false;

                { The following should be constants; note that the alphabet
                  is broken in such a way that this should work equally
                  well for EBCDIC and ASCII representations }
                idchars := ['A'..'I', 'J'..'R', 'S'..'Z',
                            'a'..'i', 'j'..'r', 's'..'z',
                            '0'..'9'                       ];
                validch := idchars + [':', '.', ',', ';', '(', ')',
                                      '+', '-', '*', '/', '=', '<', '>',
                                      '&', '|', '\'];

                initsymtab;
                initlexpack;
            end { initializations };

            procedure fatalerror;
            begin
                writeln;
                writeln ( 'Compilation aborted; fatal error.' );
                writeln;
                goto 9999 { transfer to end of program };
                { if nonlocal gotos are not available, a call to a
                  nonstandard halt procedure will be needed here };
            end {fatalerror};

            procedure error( errcode: errtype );
            begin
                waserror := true;
                writeln;
                write( 'ERROR on line ', srclno:1, ' of file ' );
                printsym(srcfile);
                writeln;
                write( '      ---> ' );

                case errcode of
                    errstrpoolovf: write('string pool overflow');
                    errpactextovf: write('packed text overflow');
                    errsymtabovf:  write('symbol table overflow');
                    errunexpeof:   write('unexpected EOF');
                    errcuioexp:    write('"circuit" or "inputs" expected');
                    erridexp:      write('identifier expected');
                    errfilenest:   write('too many use levels; limit = 4');
                    errcirexp:     write('"circuit" expected');
                    erreofexp:     write('EOF expected');
      {10}          errjunk:       write('unindentifiable lexeme');
                    errbadnum:     write('bad number');
                    erreparexp:    write('")" expected in parameter list');
                end { case }; 
                write( ' ' );

                if errcode in [ errstrpoolovf, errsymtabovf, errunexpeof
                              , errfilenest, errpactextovf ]
                  then fatalerror;
            end {error};


            { first pass lexical analysis package }
            
            procedure readfile;
            { read an input line from one file( cleanly ) }
            begin
                case currentfile of
                    1: readline( f1, srcline, srclen );
                    2: readline( f2, srcline, srclen );
                    3: readline( f3, srcline, srclen );
                    4: readline( f4, srcline, srclen );
                end {case};
            end { readfile };

            procedure bumppos;
            { advance the lexical analysis process one character,
              possibly advancing to the next line in the process;
              keep srcchar holding a copy of this character.
              For speed, the body of this is expanded as a macro in
              common cases (skipping comments, identifiers, numbers) }
            begin
                if srcpos > srclen then begin
                    readfile;
                    srclno := srclno + 1;
                    srcpos := 1;
                end else begin
                    srcpos := srcpos + 1;
                end;
                srcchar := srcline[srcpos];
            end { bumppos };

            procedure skipcomments;
            { scan over current character(s) if they're delimiters;
              delimeters include spaces, Pascal style comments,
              PL/I style comments, and Ada style comments }
            var  del: boolean;
      {10}       num: integer;
            begin
                del := true;
                while del do begin
                    while (srcchar = ' ') do begin { bumppos }
                        if srcpos > srclen then begin
                            readfile;
                            srclno := srclno + 1;
                            srcpos := 1;
                        end else begin
                            srcpos := srcpos + 1;
                        end;
                        srcchar := srcline[srcpos];
                    end { bumppos };
                    if srcchar in [ '{', '(', '-', '/', ',', ';' ]
                    then case srcchar of
                      ';',              { note that this code implies that }
                      ',':begin         { semicolons and commas never appear }
                              bumppos;  { as lexemes! }
                          end;
                      '{':begin
      {10}                    if srcline[srcpos+1] = '=' then begin
      {10}                        { line number fix provided by preprocessor }
      {10}                        bumppos;
      {10}                        bumppos;
      {10}                        num := 0;
      {10}                        while srcchar in ['0'..'9'] do begin
      {10}                            num := num*10 + (ord(srcchar)-ord('0'));
      {10}                            bumppos;
      {10}                        end;
      {10}                        if  (srcchar = '=')
      {10}                        and (srcline[srcpos + 1] = '}')
      {10}                          then srclno := num;
      {10}                    end else begin
      {10}                        bumppos;
      {10}                    end;
      {10}                    while (srcchar <> '}')
      {10}                    and   (srcchar <> pooldel) do begin
                                  { bumppos }
                                  if srcpos > srclen then begin
                                      readfile;
                                      srclno := srclno + 1;
                                      srcpos := 1;
                                  end else begin
                                      srcpos := srcpos + 1;
                                  end;
                                  srcchar := srcline[srcpos];
                                  { end bumppos }
      {10}                    end;
                              if srcchar <> pooldel then bumppos;
                          end;
                      '-':if srcline[srcpos+1] = '-' then begin
                              srcpos := linelen { force newline };
                              bumppos;
                          end else begin
                              del := false;
                          end;
                      '(':if srcline[srcpos+1] = '*' then begin
                              repeat
                                  repeat bumppos until (srcchar = '*')
                                                    or (srcchar = pooldel);
                              until (srcline[srcpos+1] = ')')
                                 or (srcchar = pooldel);
                              if srcchar <> pooldel then begin
                                  bumppos;
                                  bumppos;
                              end;
                          end else begin
                              del := false;
                          end;
                      '/':if srcline[srcpos+1] = '*' then begin
                              repeat
                                   repeat bumppos until (srcchar = '*')
                                                     or (srcchar = pooldel);
                              until (srcline[srcpos+1] = '/')
                                 or (srcchar = pooldel);
                              if srcchar <> pooldel then begin
                                  bumppos;
                                  bumppos;
                              end;
                          end else begin
                              del := false;
                          end;
                    end { case } else begin
                        del := false;
                    end { if };
                end { while };
            end { skipcomments };

            function lookup: tabindex;
            { This function returns the index of the current lexeme in
              symtab, it may have to put it there first, in which case, it
              declares the type of the symbol to be junk (the user must
              change this after calling lookup if it isn't junk);
              NOTE: this function must use the same code as
              is used for hashing in initsymtab.define }

            var done: boolean;
                x: strpoolindex;
                y: lineindex;
                i,initial: tabindex;

            begin { lookup }
                { compute the hash code for the lexeme as
                  hash(s) = (ord car(s) + 5*hash(cdr(s))) mod tabsize }
                i := 0;
                for y := lexend - 1 downto lexstart
                  do i := (i * 5 + ord( srcline[y] )) mod tabsize;
                { note that the above intentionally avoids using
                  symtab[tabsize]; this is used as a nil entry in
                  lists of symbols }

                { resolve collisions }
                done := false;
                initial := i;
                while (symtab[i] <> nil) and not done do begin
                    x := symtab[i]^.name;
                    y := lexstart;
                    { note that pooldel will not be in the lexeme }
                    while (strpool[x] = srcline[y]) do begin
                        y := y + 1;
                        x := x + 1;
                    end;
                    done := (strpool[ x ] = pooldel) and (y = lexend);
                    if not done then begin
                        i := (i + 1) mod tabsize;
                        if i = initial then error( errsymtabovf );
                    end;
                end;

                { put the symbol in the table if needed }
                if not done then begin { must define the symbol }
                    new( symtab[i] );
                    symtab[i]^.name := strpos;
                    if (strpos +(lexend - lexstart)+ 2) > strpoollim then begin
                        error( errstrpoolovf );
                    end else begin { put it in the stringpool }
                        for y := lexstart to lexend - 1 do begin
                            strpool[strpos] := srcline[ y ];
                            strpos := strpos + 1;
                        end;
                        strpool[strpos] := pooldel;
                        strpos := strpos + 1;
                    end { if };
                    symtab[i]^.typ := junk;
                    symcount := symcount + 1;
                end;

                lookup := i;
            end { lookup };

            procedure nextlex;
            { get the next lexeme from the input file; uses bumppos and
              skipcomments to advance through input; returns information
              about lexeme in lexstart and lexend (the position of the
              lexeme in linebuf) }

                function number( base: integer ): real;
                { parse a floating point number }
                var err: boolean;
                    val: integer;
                    scale: real;
                    y: lineindex;

                    procedure onedigit;
                    { compute value of the current digit and accumulate
                      it in number.val }
                    var d: integer;
                    begin
                        d := ord( srcline[y] ) - ord( '0' );
                        if d >= base then
                            err := true
                        else if val > ((maxint - d ) div base) then
                            err := true
                        else val := val * base + d;
                        y := y + 1;
                    end { onedigit };
              
                begin { number }
                    val := 0;
                    err := false;
                    y := lexstart;
                    while srcline[y] in ['0'..'9'] do onedigit;
                    if srcline[y] = '.' then begin
                        scale := 1;
                        y := y + 1;
                        while srcline[y] in ['0'..'9'] do begin
                            onedigit;
                            scale := scale * base;
                        end;
                        number := val / scale;
                    end else number := val;
                    if err then error( errbadnum ); 
                end { number };

            begin { nextlex }
                { assume that srcchar = srcline[srcpos] ready to examine }
                skipcomments;
                lexkeytyp := notkey { default assumption };
                lexslot := niltabindex { default };
                lexstart := srcpos;
                if srcchar = pooldel then begin { at end of file }
                    lexemetyp := eofile;
                end else if srcchar in validch then case srcchar of

                    ':': begin lexemetyp := colon; bumppos; end;
                    '(': begin lexemetyp := bpar; bumppos; end;
                    ')': begin lexemetyp := epar; bumppos; end;
                    '+': begin lexemetyp := plus; bumppos; end;
                    '-': begin lexemetyp := minus; bumppos; end;
                    '=': begin lexemetyp := equal; bumppos; end;
                    '/': begin lexemetyp := slash; bumppos; end;
                    '&': begin lexemetyp := andop; bumppos; end;
                    '|': begin lexemetyp := orop; bumppos; end;
                    '\': begin lexemetyp := notop; bumppos; end;

                    '.': begin
                               lexemetyp := dot; bumppos;
                               if srcchar = '.' then begin
                                   lexemetyp := dotdot;
                                   bumppos;
                               end;
                         end;
                    '*': begin
                               lexemetyp := star; bumppos;
                               if srcchar = '*' then begin
                                   lexemetyp := starstar;
                                   bumppos;
                               end;
                         end;
                    '<': begin
                               lexemetyp := less; bumppos;
                               if srcchar = '>' then begin
                                   lexemetyp := noteq;
                                   bumppos;
                               end else if srcchar = '=' then begin
                                   lexemetyp := lesseq;
                                   bumppos;
                               end;
                         end;
                    '>': begin
                               lexemetyp := great; bumppos;
                               if srcchar = '=' then begin
                                   lexemetyp := greateq;
                                   bumppos;
                               end;
                         end;

                    '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':
                        begin { identifier or reserved word }
                            repeat { bumppos }
                                if srcpos > srclen then begin
                                    readfile;
                                    srclno := srclno + 1;
                                    srcpos := 1;
                                end else begin
                                    srcpos := srcpos + 1;
                                end;
                                srcchar := srcline[srcpos];
                            { end bumppos } until not( srcchar in idchars );
                            lexend := srcpos;
                            lexslot := lookup;
                            with symtab[lexslot]^ do begin
                                if typ = junk then begin
                                    typ := id;
                                    use := unuse;
                                    level := undeflevel;
                                end;
                                lexemetyp := typ;
                                if lexemetyp = res
                                  then lexkeytyp := rescode[restyp];
                            end;
                        end;

                    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
                        begin { number }
                            repeat { bumppos }
                                if srcpos > srclen then begin
                                    readfile;
                                    srclno := srclno + 1;
                                    srcpos := 1;
                                end else begin
                                    srcpos := srcpos + 1;
                                end;
                                srcchar := srcline[srcpos];
                            { end bumppos } until not( srcchar in ['0'..'9'] );
                            if (srcchar = '.')
                            and (srcline[srcpos+1] <> '.') then begin
                                repeat bumppos
                                  until not( srcchar in ['0'..'9'] );
                                lexemetyp := rnum;
                                lexend := srcpos;
                                lexslot := lookup;
                                with symtab[lexslot]^ do
                                if typ = junk then begin
                                    typ := rnum;
                                    rval := number( 10 );
                                end;
                            end else begin;
                                lexemetyp := inum;
                                lexend := srcpos;
                                lexslot := lookup;
                                with symtab[lexslot]^ do
                                if typ = junk then begin
                                    typ := inum;
                                    ival := round( number( 10 ) );
                                end;
                            end;
                        end;

                end { case } else begin { any other character }
                    lexemetyp := junk;
                    repeat bumppos until srcchar in validch + [pooldel];
                    lexend := srcpos;
                end { if };
            end { nextlex };

            procedure getfname( var n: tabindex );
            { get a file name into the current lexeme; note that file names
              do not obey the usual lexical rules; they may have characters
              which would normally separate lexemes; nonetheless, they
              end up occupying a space in the symbol table, but their use
              as file names does not involve any of the normal semantic
              information stored in the symbol table }
            begin
                skipcomments;
                lexstart := srcpos;
                lexkeytyp := notkey;
                if srcchar <> pooldel then begin
                    lexemetyp := junk;
                    repeat { search for end of file name }
                        bumppos;
                    until srcchar in [' ',';'];
                    lexend := srcpos;
                    n := lookup;
                end else begin { eof occured }
                    lexemetyp := eofile;
                end;
            end { getfname };

            procedure savelex( var f: filerec );
            { save the state of the lexical analysis system }
            begin
                f.level := currentfile;
                f.name := srcfile;
                f.currentline := srcline;
                f.lineno := srclno;
                f.linepos := srcpos;
            end { savelex };

            procedure restorelex( var f: filerec );
            { recover the state of the lexical analysis system }
            begin
                currentfile := f.level;
                srcfile := f.name;
                srcline := f.currentline;
                srclno := f.lineno;
                srcpos := f.linepos;
                srcchar := srcline[srcpos];
                lexemetyp := junk { not saved, but was a file name, aka junk! };
            end { restorelex };

            procedure openlex( f: tabindex );
            { open lexical analysis from f, a file name indexed in symtab }
            var fname: line;
                i: strpoolindex;
                j: lineindex;
            begin
                if currentfile >= filestklength then begin
                    error( errfilenest );
                end else begin { there are enough nesting levels }
                    currentfile := currentfile + 1;

                    { copy f into fname }
                    i := symtab[f]^.name;
                    j := 1;
                    while strpool[i] <> pooldel do begin
                        fname[j] := strpool[i];
                        i := i + 1;
                        j := j + 1;
                    end;
                    for j := j to linelen do fname[j] := ' ';

                    { open the file }
                    case currentfile of
                        1: reset( f1, fname );
                        2: reset( f2, fname );
                        3: reset( f3, fname );
                        4: reset( f4, fname );
                    end {case};

                    readfile { read the first line };
                    srcfile := f;
                    srclno := 1;
                    srcpos := 1;
                    srcchar := srcline[srcpos];
                    nextlex;
                end;
            end { openlex };


            { first pass code used to build pactext for second pass }
              
            procedure copy;
            { Copies the current lexeme to pactext in packed form. }
            var d: integer;
            begin { copy }

                if textfile <> srcfile then begin { new file since last copy! }
                    if textpos > (pactextlim - 3)
                      then error( errpactextovf );
                    pactext[textpos    ] := ' ';
                    pactext[textpos + 1] := chr(srcfile mod textradix);
                    pactext[textpos + 2] := chr(srcfile div textradix);
                    textpos := textpos + 3;
                    textfile := srcfile;
                    textlno := 0;
                end;

      {10}      if textlno <> srclno then begin { new line since last copy }
                    d := srclno - textlno;
      {10}          if d < 0 then begin { handle backward steps }
      {10}              { backsteps occur when preprocessor resets line num }
      {10}              if textpos > (pactextlim - 1)
      {10}                then error( errpactextovf );
      {10}              pactext[ textpos ] := '~';
      {10}              textpos := textpos + 1;
      {10}              d := -d;
      {10}          end;
                    while d > 0 do begin
                        if textpos > (pactextlim - 1)
                          then error( errpactextovf );
                        pactext[ textpos ] := chr( (d mod 10) + ord('0') );
                        textpos := textpos + 1;
                        d := d div 10;
                    end { while };
                    textlno := srclno;
                end { if };

                case lexemetyp of { copy the lexeme into pactext }

                    colon, dot, bpar, epar, plus, minus,
                    star, slash, equal, less, great, andop, orop, notop,
                    dotdot, starstar, lesseq, greateq, noteq:
                        begin
                            if textpos > (pactextlim - 1)
                              then error( errpactextovf );
                            { enter separators as themselves }
                            pactext[textpos] := lextoch[lexemetyp];
                            textpos := textpos + 1;
                        end;

                    id, inum, rnum:
                        begin
                            if textpos > (pactextlim - 3)
                              then error( errpactextovf );
                            pactext[textpos] := lextoch[lexemetyp];
                            pactext[textpos+1]
                                        := chr(lexslot mod textradix);
                            pactext[textpos+2]
                                        := chr(lexslot div textradix);
                            textpos := textpos + 3;
                        end;

                    res:
                        begin
                            if textpos > (pactextlim - 1)
                              then error( errpactextovf );
                            pactext[textpos] := symtab[lexslot]^.restyp;
                            textpos := textpos + 1;
                        end;

                    hop { never happens },
                    eofile { never happens }:
                        { do nothing };

      {10}          junk { error needs reporting }:
      {10}              error( errjunk );

                end { case };
            end { copy };
              

            { procedures to parse circuit and subcircuit defintions }

            procedure readcirc( var s: subref );
            { read and copy the definition of one circuit, and set s
              to point to a record of that circuit; the syntax follows:

                <circuit> ::= <head> [ <declaration> |
                                       <use> | <circuit> ]* <body>
                <head> ::= circuit <identifier> [ <formalparamlist> ]
                <formalparamlist> ::= "(" <lexeme>* ")"
                <declaration> ::= <declkeyword> [ <lexeme> ]*
                <use> ::= use <filename>
                <body> ::= [ (inputs | outputs | parts | wires) <lexeme>* ] end
            }
            var myson: subref { working ref to a son of current circuit };
                lasthop: pactextindex { pointer to last text prior to subcirc };
                lastfile: tabindex { file reading from at time of hop };
                lastline: integer { line reading from at time of hop };

                procedure planthop;
                begin
                    if lasthop = 0 then begin { hop must be planted }
                        if textpos > (pactextlim - 4)
                          then error( errpactextovf );
                        lasthop := textpos + 1;
                        lastfile := textfile;
                        lastline := textlno;
                        pactext[textpos] := lextoch[hop];
                        textpos := textpos + 4;
                    end;
                end { planthop };

                procedure fixhop;
                begin
                    if lasthop <> 0 then begin { a hop to here was planted }
                        pactext[lasthop    ]
                                := chr(textpos mod textradix);
                        pactext[lasthop + 1]
                                := chr((textpos div textradix) mod textradix);
                        pactext[lasthop + 2]
                                := chr(textpos div (textradix * textradix));
                        lasthop := 0;
                        textfile := lastfile;
                        textlno := lastline;
                    end;
                end { fixhop };

                procedure copydefs;
                { copy definitions in circuit body or use file }

                    procedure readuse;
                    { handle use file insertions }
                    var f: filerec { save location for previous input source };
                        newf: tabindex { the text of a file name };
                    begin
                        getfname( newf );
                        if lexemetyp <> eofile then begin { have file name }
                            savelex( f );
                            openlex( newf );
                            copydefs;
                            if lexemetyp = dot then nextlex;
                            if lexemetyp <> eofile then error( erreofexp );
                            restorelex( f );
                            nextlex { get the lexeme after the file name };
                        end { else someone else will complain about eof };
                    end { readuse };

                begin { copydefs }
                    repeat
                        { find the next keyword }
                        if (lexemetyp <> eofile)
                        and not(lexkeytyp in [keyuse,
     {10}                                     keyassert,
                                              keycirc, keyint, keyreal,
                                              keytime, keyrange, keybool,
                                              keypart, keyinp, keyoutp,
					      keywire, keyend])
                        then begin
                            error( errcuioexp );
                            repeat nextlex
                            until (lexemetyp = eofile)
                               or (lexkeytyp in [keyuse,
     {10}                                        keyassert,
                                                 keycirc, keyint, keyreal,
                                                 keytime, keyrange, keybool,
                                                 keypart, keyinp, keyoutp,
					         keywire, keyend]);
                        end;

                        if lexkeytyp = keyuse then begin
                            readuse;
                        end else if lexkeytyp = keycirc then begin
                            planthop;
                            readcirc( myson );
                            { add myson to son list }
                            myson^.brother := s^.son;
                            s^.son := myson;
                        end else if lexkeytyp in [keyint, keyreal, keytime,
     {10}                                         keyassert,
                                                  keyrange, keybool] then begin
                            fixhop;
                            repeat
                                copy;
                                nextlex;
                            until (lexemetyp = eofile) or
                                  (lexkeytyp in [keyuse, keycirc, keypart,
     {10}                                        keyassert,
                                                 keyinp, keyoutp, keywire,
						 keyend]);
                        end { else (lexkeytyp in [part, inp, outp, wire, end])
                                or (lexemetyp = eofile) };
                    until (lexemetyp in [dot, eofile])
                       or (lexkeytyp in [keypart, keyinp, keyoutp,
					 keywire, keyend ]);
                end { copydefs };

            begin { readcirc };
                { first, create a record of the circuit }
                new(s);
                with s^ do begin
                    son := nil { default, changes when sons are found };
                    brother := nil { the caller may tack sons on here };
                    parsed := false { default needed by secondpass };
                    instcount := 0 { number of instances is initially zero };
                end { with };

                { start parsing by looking for the keyword circuit }
                if lexkeytyp <> keycirc then begin { hunt for keyword }
                    error( errcirexp );
                    repeat nextlex until (lexkeytyp = keycirc)
                                      or (lexemetyp = eofile);
                end;
                if lexkeytyp = keycirc then nextlex;
                lasthop := 0;
                textlno := 0;
                textfile := niltabindex;

                if lexemetyp <> id then begin
                    error( erridexp );
                end else begin { read circuit name and record position }
                    s^.headpos := textpos;
                    s^.slot := lexslot;
                    nextlex { skip circuit name };
                end;

                { put formal param list in pactext (if any) }
                if lexemetyp = bpar then begin
                    repeat
                        copy;
                        nextlex;
                    until (lexemetyp in [epar,eofile]) or
                          (lexkeytyp in
      {10}                   [keyuse,keyinp,keyoutp,keypart,keywire,keyend]);
                    if lexemetyp = epar then begin
                        copy;
                        nextlex;
                    end else begin
                        error( erreparexp );
                    end;
                end;

                { put local definitions in pactext and subcirc's in symtab }
                copydefs;

                { put body of circuit in pactext }
                fixhop;
                while (lexemetyp <> eofile)and(lexkeytyp <> keyend) do begin
                    copy;
                    nextlex;
                end;

                if lexemetyp = eofile then begin
                    error( errunexpeof );
                end else { assert lexkeytyp = keyend } begin
                    copy;
                    nextlex;
                end;
            end { readcirc };

        begin { firstpass }
            initializations;

            write( 'Source file name: ');
            readline(input, srcline, srclen);

            { put file name in symbol table, then open it }
            srcpos := 1;
            srcchar := srcline[srcpos];
            getfname(srcfile);
            openlex(srcfile);

            if lexslot = symtally then begin
                tally := true;
                nextlex;
            end;

            readcirc( subhead );
            if lexemetyp = dot then nextlex;
            if lexemetyp <> eofile then error( erreofexp );
            if waserror then fatalerror { halt };

            if tally or (strpos > (0.85 * strpoollim))
              then writeln( 'String pool occupies ', strpos:1,
                            ' bytes out of ', strpoollim:1, ' available.');
            if tally or (textpos > (0.85 * pactextlim))
              then writeln( 'Packed text occupies ', textpos:1,
                            ' bytes out of ', pactextlim:1, ' available.');
            if tally or (symcount > (0.85 * tabsize))
              then writeln( 'Symbol table holds ', symcount:1,
                            ' entries out of ', tabsize:1, ' available.');

            { replace [] in begin and end lines to get debug dump of pactext }
            { begin debug ]
            for srclno := 0 to textpos do begin
                if (srclno mod 16) = 0
                  then begin writeln; write( srclno:8, ': ' ) end;
                if pactext[srclno] < ' '
                  then write( '^', chr(ord(pactext[srclno])+ord('@')), '  ' )
                else if ord(pactext[srclno]) >= 127
                  then write( 'DEL ' )
                else write( ' ', pactext[srclno], '  ' );
            end;
            writeln;
            [ end debug }
        end { firstpass };
        


        procedure secondpass;

        type
            errtype = ( errredefine, errmanyparam,
                        errfewparam, errivdname, errpinname,
                        errpartname, errmodifier,
                        errreused, errnodest, errnotsource,
                        errnotdest, errnosrc, errrelop,
                        erridundef, errwrongtyp,
                        errplus, errminus, errstar, errslash, errbool,
      {10}              errassert,
                        errinteger, errposint, errnonzero, errpostime,
                        errillconn,
                        errrange, erroutofbnd,
                        errindexreq,
                        errnotarray, errbadparam );

            lexeme = record
                         key: keytyp { always notkey unless typ = res };
                         case typ: lextyp of
                               id: (slot: tabindex);
                             inum: (ival: integer);
                             rnum: (rval: real);

                             hop, res, colon, dot, plus, minus, star, slash,
                             equal, dotdot, starstar, bpar, epar, eofile,
                             less, lesseq, noteq, greateq, great, andop,
                             orop, notop, kin, junk
                                 : ();
                     end { record };

            textrec = record
                          pos: pactextindex { position in packed text };
                          lno: integer { the line number of current line };
                          fil: tabindex { file name from which line came };
                          lex: lexeme { the last lexeme };
                          err: boolean { should errors be shown };
                      end { record };

            keyset = set of keytyp;
            lexset = set of lextyp;

            dirpossible = ( indir, outdir, unkdir );
            pinrec = record { record of one pin of one device }
                         partname: symref;
                         partslot: tabindex;
                         partnum: integer;
                         pinslot: tabindex;
                         pinnum: integer;
                         pindir: dirpossible;
                         tiept: tieptref;
                         gate: gateref;
                         lno: integer
                     end;

            { data type used for parameters to a circuit instance }
            parampool = array [paramindex] of valtyp;
            { by convention, if x is of type parampool, and there are y
              actual parameters, x[y + 1].typ = noexpr, and x[0].typ = rangetyp,
              x[0].first = <source file from which actual params came>
              x[0].last = <line number from which actual params came> }

        var { lexical analysis state }
            textpos: pactextindex { position in packed text };
            lex: lexeme { current lexeme };

            { error reporting information (an extension of lexical state) }
            srclno: integer { line number of current line };
            srcfname: tabindex { name of file from which line originally came };
            showerror: boolean { should errors be reported? };
            errlno: integer { srclno of last error };

            currentlevel: integer;
            symfreelist: symref { symbol free list };
            tieptfreelist: tieptref { tie point free list };

            i: integer;
            nilparms: parampool;

            { error message format code (tightly coupled to lexical analysis) }

            procedure error( errcode: errtype );
            begin
                if showerror then begin
                    case errcode of
                        errredefine:  write( ' illegal redefinition' );
                        errmanyparam: write( ' too many (actual)parms' );
                        errfewparam:  write( ' too few (actual)parms' );
                        errivdname:   write( ' invalid gate/circuit name' );
                        errpinname:   write( ' invalid pin name' );
                        errpartname:  write( ' invalid part name' );
                        errmodifier:  write( ' unmodifiable name' );
                        errreused:    write( ' is illegally reused' );
                        errnodest:    write( ' no destination given' );
                        errnotsource: write( ' is not a source' );
                        errnotdest:   write( ' is not a destination' );
                        errnosrc:     write( ' has an open source connection' );
                        erridundef:   write( ' undeclared' );
                        errwrongtyp:  write( ' value is of wrong type' );
                        errplus:      write( ' operands of "+" incompatible' );
                        errminus:     write( ' operands of "-" incompatible' );
                        errstar:      write( ' operands of "*" incompatible' );
                        errslash:     write( ' operands of "/" incompatible' );
                        errrelop:     write( ' incomparable operands' );
                        errbool:      write( ' boolean expected' );
      {10}              errassert:    write( ' assertion failure' );
                        errinteger:   write( ' integer expected' );
                        errposint:    write( ' positive integer expected' );
                        errnonzero:   write( ' nonzero real expected' );
                        errpostime:   write( ' positive time expected' );
                        errrange:     write( ' range expected' );
                        erroutofbnd:  write( ' index out of bounds' );
                        errnotarray:  write( ' not an array name' );
                        errbadparam:  write( ' unmatched parameter types' );
                        errillconn:   write( ' unmatched bounds' );
                        errindexreq:  write( ' index required for this part' );
        
                    end { case };
                    writeln;
                end { if };
            end { error };

            procedure errorprefix( lno: integer );
            { This procedure writes the prefix for an error message }
            begin
                waserror := true;
                if showerror then begin
                    if errlno <> lno then begin
                        writeln;
                        write( 'ERROR on line ', lno:1, ' of file ' );
                        printsym( srcfname );
                        writeln;
                        errlno := lno;
                    end;
                    write( '     ---> ');
                end;
            end { errorprefix };

            procedure pinerror( var pin: pinrec; errcode: errtype );
            { print out name of current pin as part of an error msg }
            var i: integer;
            begin
                if showerror then begin
                    errorprefix( pin.lno );
                    write( 'pin "' );
                    printname( pin.partname^.name, i, 80 );
                    if pin.partnum <> undefined then
                        write( '(', pin.partnum:1, ')' );
                    if pin.pinslot <> niltabindex then begin
                        write('.');
                        printname( symtab[pin.pinslot]^.name, i, 80 );  
                        if pin.pinnum <> undefined then
                            write('(', pin.pinnum:1, ')');
                    end;
                    write( '"' );
                    error( errcode );
                end;
            end { pinerror };

            procedure gotbutwant( var got: lexeme;
                                  wantt: lextyp; wantk: keytyp );
            { This procedure invokes the error reporting routine
              to indicate that some particular kind of token is
              expected from the input; got is passed by reference
              only to avoid copying, and must not be modified }
            var templex: lexeme;

                procedure putlex( var lx:lexeme );
                { print the lexeme; lx is passed by reference
                  only to avoid copying, and must not be modified }
                begin
                    case lx.typ of
                        colon: write( '":"' );
                          dot: write( '"."' );
                         bpar: write( '"("' );
                         epar: write( '")"' );
                         plus: write( '"+"' );
                        minus: write( '"-"' );
                         star: write( '"*"' );
                        slash: write( '"/"' );
                        equal: write( '"="' );
                       dotdot: write( '".."' );
                     starstar: write( '"**"' );
                         less: write( '"<"' );
                       lesseq: write( '"<="' );
                        noteq: write( '"<>"' );
                      greateq: write( '">="' );
                        great: write( '">"' );
                        andop: write( '"&"' );
                         orop: write( '"|"' );
                        notop: write( '"\"' );
                         junk: ;
                         inum: write( 'number "', lx.ival:1, '"' );
                         rnum: write( 'number "', lx.rval:9:3, '"' );
                          hop: write( '"circuit"' { this init's a hop } );
                          res: case lx.key of
                                  keycirc: write( '"circuit"' );
                                   keyinp: write( '"inputs"'  );
                                  keyoutp: write( '"outputs"' );
                                  keypart: write( '"parts"'   );
                                  keywire: write( '"wires"'   );
                                   keyend: write( '"end"'     );
                                    keyto: write( '"to"'      );
                                   keyfor: write( '"for"'     );
                                   keymod: write( '"mod"'     );
                                    keydo: write( '"do"'      );
                                  keyendf: write( '"endfor"'  );
                                   keyint: write( '"integer"' );
                                  keyreal: write( '"real"'    );
                                  keytime: write( '"time"'    );
                                 keyrange: write( '"range"'   );
                                  keybool: write( '"boolean"' );
                                    keyif: write( '"if"'      );
                                  keythen: write( '"then"'    );
                                  keyelse: write( '"else"'    );
                                 keyendif: write( '"endif"'   );
                                   notkey: ;
                               end { res };
                           id: printsym( lx.slot );
                    end { case };
                end { putlex };

            begin { gotbutwant };
                if showerror then begin
                    errorprefix( srclno );
                    templex.typ := wantt;
                    templex.key := wantk;
                    putlex( got );
                    write( ' found; ' );
                    if wantt = id
                      then write( 'identifier' )
                    else if wantt = kin
                      then write( '"in"' )
                      else putlex( templex );
                    writeln( ' expected.' );
                end;
            end { gotbutwant };

            procedure badname( name: tabindex; errcode: errtype );
            { This procedure invokes the error reporting routine
              to indicate that the current identifier in the source
              file is illegal }
            begin
                if showerror then begin
                    errorprefix( srclno );
                    printsym( name );
                    write( ':' );
                    error( errcode );
                end;
            end { badname };

            procedure badnum( name: tabindex; num: valtyp; errcode: errtype );
            { report a bad number or other kind of value }
            var xx: integer;
            begin
                if showerror then begin
                    if name <> niltabindex
                      then badname( name, errcode )
                      else begin errorprefix( srclno ); error( errcode ) end;
                    write( '          ' );
                    write( 'the value found is: ');
                    case num.typ of
                        inttyp:   if num.ival <> undefined
                                    then write( num.ival:1 )
                                    else write( 'undefined' );
                        realtyp:  write( num.rval:9:3 );
                        timetyp:  if (num.rval < microsecond)
                                  and (num.rval > -microsecond)
                                    then write((num.rval/nanosecond):9:3,'ns')
                                  else if (num.rval < millisecond)
                                       and (num.rval > -millisecond)
                                    then write((num.rval/microsecond):9:3,'us')
                                  else if (num.rval < second)
                                       and (num.rval > -second)
                                    then write((num.rval/millisecond):9:3,'ms')
                                    else write((num.rval/second):9:3,'s');
                        rangetyp: write( num.first:1, ' .. ', num.last:1 );
                        booltyp:  write( num.bval );
                        circtyp:  begin
                                      write( '"' );
                                      printname( num.subptr^.name, xx, 80 );
                                      write( '"' );
                                  end;
                        noexpr,
                        undef:    write( 'undefined' );
                    end;
                    writeln;
                end;
            end { badnum };

            procedure badgate( g: gateref; errcode: errtype );
            var xx: integer;
            begin
                if showerror then begin
                    errorprefix( srclno );
                    write( '"' );
                    printname( g^.name, xx, 80 );
                    if g^.index <> undefined then write( '(', g^.index:1, ')' );
                    write( '":' );
                    error( errcode );
                end;
            end { badgate };

            procedure semanticerror( errcode: errtype; line: integer );
            { report that an operator has operands with incompatible types }
            begin
                if showerror then begin
                    errorprefix( line );
                    error( errcode );
                end;
            end { semanticerror };

            { Lexical analysis package }

            procedure nextlex;
            { get the next lexeme from pactext into lex }
            var i: tabindex;
                d: integer;
                ch: char;
            begin
                { first skip file and newline markers }
                ch := pactext[ textpos ];

                if ch = ' ' then begin { file name }
                    srcfname := ord(pactext[textpos + 1])
                              + ord(pactext[textpos + 2]) * textradix;
                    srclno := 0;
                    textpos := textpos + 3;
                    ch := pactext[ textpos ];
                end { if };

      {10}      if ((ch >= '0') and (ch <= '9')) or (ch = '~') then begin
                    { line number }
      {10}          if ch = '~' then begin
      {10}              d := -1;
      {10}              textpos := textpos + 1;
      {10}              ch := pactext[ textpos ];
      {10}              { assert that firstpass.copy guarantees ch is digit! }
      {10}          end else begin
                        d := 1;
      {10}          end { if };
                    repeat
                        srclno := srclno + ((ord(ch) - ord('0')) * d); 
                        d := d * 10;
                        textpos := textpos + 1;
                        ch := pactext[ textpos ];
                    until (ch < '0') or (ch > '9');
                end { if };

                lex.key := notkey { default assumption };

                { note: no error checks are needed here
                  statement because firstpass.copy guarantees that
                  pactext contains only legal sequences }

                lex.typ := chtolex[ch];

                if (lex.typ >= id) and (lex.typ <= res) then begin { more info }
                    if lex.typ = res then begin { reserved word codes }
                        lex.key := rescode[ch];
                        textpos := textpos + 1;
                    end else if lex.typ = hop then begin { hop over subcircuit }
                        textpos := ord(pactext[textpos + 1])
                                 + ord(pactext[textpos + 2]) * textradix
                                 + ord(pactext[textpos + 3]) * textradix
                                                             * textradix;
                    end else begin { lex.typ in [id, inum, rnum], get value }
                        i := ord(pactext[textpos + 1])
                           + ord(pactext[textpos + 2]) * textradix;
                        textpos := textpos + 3;
                        if lex.typ = id then begin
                            lex.slot := i
                        end else if lex.typ = inum then begin
                            lex.ival := symtab[ i ]^.ival
                        end else { lex.typ = rnum } begin
                            lex.rval := symtab[ i ]^.rval
                        end;
                    end;
                end else begin
                    textpos := textpos + 1;
                end { if };
            end { nextlex };

            procedure savelex( var t: textrec );
            { save the state of the lexical analysis system }
            begin
                t.pos := textpos;
                t.lno := srclno;
                t.fil := srcfname;
                t.lex := lex;
                t.err := showerror;
            end { savelex };

            procedure restorelex( var t: textrec );
            { restore the state of the lexical analysis system }
            begin
                textpos := t.pos;
                srclno := t.lno;
                srcfname := t.fil;
                lex := t.lex;
                showerror := t.err;
                errlno := -1 { if errors are printed, force new line header };
            end { restorelex };

            procedure openlex( err: boolean; pos: pactextindex );
            { start lexical analysis from copy in pactext }
            begin
                showerror := not err;
                textpos := pos;
                srclno := 0;
                srcfname := niltabindex;
                errlno := -1 { if errors are printed, force new line header };
                nextlex;
            end { openlex };


            { Procedures for handling free lists }

            procedure putsymbol( s: symref );
            { put a new symbol in the free list }
            begin
                s^.stkptr := symfreelist;
                symfreelist := s;
            end { putsymbol };

            procedure getsymbol( var s: symref );
            { get a symbol from the free list }
            begin
                if symfreelist = nil then begin
                    new( s );
                end else begin
                    s := symfreelist;
                    symfreelist := s^.stkptr;
                end;
            end { getsymbol };

            procedure puttiept( t: tieptref );
            { put a new tiepoint in the free list }
            begin
                t^.nexttiept := tieptfreelist;
                tieptfreelist := t;
            end { puttiept };

            procedure gettiept( var t: tieptref );
            { get a tiepoint from the freelist }
            begin
                if tieptfreelist = nil then begin
                    new( t );
                end else begin
                    t := tieptfreelist;
                    tieptfreelist := t^.nexttiept;
                end;
            end { gettiept };

            procedure dumpfreelists;
            var s: symref;
                t: tieptref;
            begin
                while symfreelist <> nil do begin
                    s := symfreelist;
                    symfreelist := s^.stkptr;
                    dispose( s );
                end;
                while tieptfreelist <> nil do begin
                    t := tieptfreelist;
                    tieptfreelist := t^.nexttiept;
                    dispose( t );
                end;
            end { dumpfreelists };


            { procedures for disposing of other data structures }

            procedure dumpsymtable;
            { dumps the main symbol table }
            var i: tabindex { index of entry being dumped };
                len: integer { length of name in printed report };
                num: integer { number of names on current line };
            begin
                if tally then begin
                    writeln;
                    writeln( 'Tally of parts used to build circuit:' );
                end;
                num := 0;
                for i := 0 to tabsize do begin
                    if symtab[i] <> nil then begin
                        with symtab[i]^ do begin
                            if tally
                            then if typ = id
                            then if use = typeuse
                            then if typecount > 0 then begin
                                if num >= 5 then begin
                                    writeln;
                                    num := 0;
                                end;
                                write( typecount:5, ' ' );
                                printname( name, len, 9 );
                                write( ' ':(9 - len) );
                                num := num + 1;
                            end;
                            putsymbol( symtab[i] );
                        end { with };
                        symtab[i] := nil;
                    end { if };
                end { for };
                if tally then writeln;
            end { dumpsymtable };

            procedure dumpsubtable;

                procedure dumpsub( s: subref; level: integer );
                { dumps the subcircuit symble table }
                var son, brother: subref;
                    len: integer { length of name printed on line, also temp };
                    num: integer { number of spaces used on this line };
                begin
                    num := 6;
                    while s <> nil do begin
                        son := s^.son;
                        brother := s^.brother;
                        if tally then if level > 0 then begin
                            if num >= 5 then begin
                                writeln;
                                for len := 1 to level - 1 do write( ' ':5 );
                                num := (level + 1) div 3;
                            end;
                            write( s^.instcount:5, ' ' );
                            printname( symtab[s^.slot]^.name, len, 9 );
                            if len < 9 then write( ' ':(9 - len) );
                            num := num + 1;
                        end;
                        dispose( s );
                        if son <> nil then begin
                            if level < 9
                              then dumpsub(son, level + 1)
                              else dumpsub(son, level);
                            if brother <> nil then num := 6;
                        end;
                        s := brother;
                    end;
                end { dumpsub };

            begin { dumpsubtable }
                if tally then begin
                    writeln;
                    write( 'Tally of subcircuits:' );
                end;
                dumpsub( subhead, 0 );
                if tally then writeln;
            end { dumpsubtable };


            { main procedure to connect wires between gates in model }

            procedure hookwire( var src, dest: pinrec; newdelay: real );
            { stretch wire from srcpin to destpin }
            var wire, lastwire: wireref;
                gate: gateref { source gate, if known };
            begin { hookwire }
                if (dest.partname <> nil) and (src.partname <> nil) then begin

                    { have a legal wire,
                      must first get destination wirelist if there is one }

                    if dest.tiept = nil then begin
                        { assert dest.partname^.use = gateuse }

                        { make a wire list entry for destination gate }
                        new( wire );
                        wire^.delay := 0.0 { delay will be added later };
                        wire^.g := dest.gate;
                        wire^.inputval := dest.pinnum;
                        wire^.next := nil;
                        with wire^.g^ do case kind of
                            andg, nandg, org, norg, xorg, equg, trbg:
                                begin
                                    instates[open] := instates[open] - 1;
                                    instates[low] := instates[low] + 1;
                                    if instates[low] > fanin
                                      then pinerror( dest, errreused );
                                end;
                            trig, ntrig, latchg:
                                begin
                                    if wire^.inputval = 0 then begin
                                        if control = open
                                          then control := low
                                          else pinerror( dest, errreused );
                                    end else begin { wire^.inputval = 1 }
                                        if inp = open
                                          then inp := low
                                          else pinerror( dest, errreused );
                                    end;
                                end;
                            iogate:
                                begin
                                    if state = open
                                      then state := low
                                      else pinerror( dest, errreused );
                                end;
                        end { with case };

                    end else begin

                        { destination is a tiepoint }

                        wire := dest.tiept^.destlist;
                        if (dest.tiept^.srcgate <> nil)
                        or (dest.tiept^.srctiept <> nil) then begin
                            { this tiepoint has already been used }
                            pinerror( dest, errreused );
                        end else begin
                            dest.tiept^.destlist := nil;
                            { values of .srcgate or .srctiept will be changed
                              when the best ultimate source is known }
                        end;

                    end;

                    { assert wire is head of list of destinations which
                      need their delays updated; these can then be put
                      on the wirelist closest to the ultimate source gate;
                      if the destination is a tiepoint, it must be updated
                      to hold a pointer to this approximation }

                    if src.tiept <> nil then begin { source is a tiepoint }
                        while src.tiept^.srctiept <> nil do begin
                            newdelay := newdelay + src.tiept^.delay;
                            src.tiept := src.tiept^.srctiept;
                        end;

                        { src.tiept now points to the tiepoint closest to
                          the ultimate source, and newdelay is the composite
                          delay from that source }
                        gate := src.tiept^.srcgate;
                        if gate <> nil
                          then newdelay := newdelay + src.tiept^.delay
                    end else begin { source is a gate }
                        gate := src.gate;
                    end;

                    { newdelay is now best known composite delay from ultimate
                      source; gate points to the source gate, if known; if not,
                      src.tiept points to the source tiepoint }

                    { update wirelist by composite delay }
                    if wire <> nil then begin 
                        lastwire := wire;
                        with lastwire^ do delay := delay + newdelay;
                        while lastwire^.next <> nil do begin
                            lastwire := lastwire^.next;
                            with lastwire^ do delay := delay + newdelay;
                        end;
                    end;
                    { if wire <> nil, lastwire is pointer to end of list }

                    { make connection to source }
                    if gate = nil then begin { source is tiepoint }
                        if wire <> nil then begin { connect the wires }
                            lastwire^.next := src.tiept^.destlist;
                            src.tiept^.destlist := wire;
                        end;

                        if dest.tiept <> nil then begin
                            { put back pointer in destination tiepoint }
                            dest.tiept^.srctiept := src.tiept;
                            dest.tiept^.delay := newdelay;
                        end;
                    end else begin { source is gate }
                        if wire <> nil then begin { connect the wires }
                            lastwire^.next := gate^.outto;
                            gate^.outto := wire;
                        end;

                        if dest.tiept <> nil then begin
                            { put back pointer in destination tiepoint }
                            dest.tiept^.srcgate := gate;
                            dest.tiept^.delay := newdelay;
                        end;
                    end;

                end;
            end { hookwire };

            procedure hookarrayofwires( var srcpin, destpin: pinrec;
                                        timedelay: real; first, last: integer );
            { hook up two arrays of pins with bounds 'first .. last' }
            var i: integer;

            begin
                { assert srcpin.tiept, destpin.tiept <> nil }

                { find head of source array }
                while srcpin.tiept^.index <> first do
                    srcpin.tiept := srcpin.tiept^.nextelem;
                { find head of destination array }
                while destpin.tiept^.index <> first do
                    destpin.tiept := destpin.tiept^.nextelem;

                for i := first to last do begin { hook them up! }
                    hookwire( srcpin, destpin, timedelay );
                    srcpin.tiept := srcpin.tiept^.nextelem;
                    destpin.tiept := destpin.tiept^.nextelem;
                end;
            end { hookarrayofwires };


            { syntax driven parser for the second pass }

            procedure parsecircuit( cursub: subref; var curinst: instdescrref;
                                    var actuals: parampool );
            { parse one circuit, an instance of cursub, with params in actuals;
              put pointer to instance in curinst; actuals are passed by ref
              only to avoid copying -- they must not be modified! }
            var
                save: textrec { saved lexical analysis state for recursion };
                symlist: tabindex { list of symbols defined in this circuit };


                { procedure for input and output tiepoint list error checks }

                procedure checktiepts( inst: instdescrref;
                                       tp: tieptref; length: integer );
                { check that all tiepoints in list tp of circuit instance inst
                  have a source connection; limit name of gate to length
                  components }
                var xx: integer;
                begin
                    if showerror then begin { don't check if messages ignored }
                        while tp <> nil do begin { check each tiept in list }
                            if (tp^.srcgate = nil)
                            then if (tp^.srctiept = nil ) then begin
                                { no source, neither a gate nor a tiepoint }
                                errorprefix( srclno );
                                write( '"' );
                                printprefix( inst, length );
                                printname( symtab[tp^.slot]^.name, xx, 80 );
                                if tp^.index <> undefined
                                  then write( '(', tp^.index:1, ')' );
                                write( '":' );
                                error( errnosrc );
                            end;
                            tp := tp^.nexttiept;
                        end { while };
                    end;
                end { checktiepts };


                { procedures for scope rule management }

                procedure redefine( slot: tabindex );
                { redefine symtab[slot] (assumed to be an indentifier) in the
                  current circuit, if possible; push previous definition,
                  if any, so it will be restored when this circuit ends;
                  only redefine previously defined identifiers from outer
                  nesting levels! }
                var olds, news: symref;
                begin { redefine }
                    olds := symtab[slot];
                    if olds^.level < currentlevel then begin { redefinable }
                        if olds^.use <> unuse then begin
                            { get new symbol record for this identifier }
                            getsymbol( news );
                            with news^ do begin
                                name := olds^.name;
                                typ := id;
                                use := unuse;
                                level := currentlevel;
                                stkptr := olds;
                            end;
                            symtab[slot] := news;
                        end else begin
                            olds^.level := currentlevel;
                            olds^.stkptr := nil;
                            news := olds;
                        end;

                        { record that this symbol was defined at current level }
                        news^.nextsym := symlist;
                        symlist := slot;
                    end else begin
                        badname( slot, errredefine );
                    end;
                end { redefine };

                procedure predefinelocals;
                { get all children of cursub and put them in symtab }
                var sub: subref {temp used for scanning};
                begin
                    sub := cursub^.son;
                    while sub <> nil do begin { march down brother list }

                        { put the subcircuit name in the symboltable }
                        redefine( sub^.slot );

                        { update the symboltable entry appropriately }
                        with symtab[sub^.slot]^ do begin
                            use := subuse;
                            s := sub;
                        end { with };

                        sub := sub^.brother;
                    end { while };
                end { predefinelocals };

                procedure undefinelocals;
                { undo definitions of local symbols }
                var sym: symref { symbol being undefined };
                    slot: tabindex { symbol table slot being undefined };
                    t, tt: tieptref { tiepoints of instance being undefined };
                    gate: gateref { gate being undefined };
                begin
                    slot := symlist;
                    while ( slot <> niltabindex ) do begin { undo local defs }
                        sym := symtab[slot];

                        { first do things specific to symbol being undefined }
                        if (sym^.use = instuse) then begin
                            { undefining a circuit instance }
                            if (sym^.inst <> nil) then begin { dump tiepoints }
                                { do input list and check that they were used }
                                t := sym^.inst^.inputlist;
                                checktiepts( sym^.inst, t, 1 );
                                while t <> nil do begin
                                    tt := t;
                                    t := t^.nexttiept;
                                    puttiept( tt );
                                end;
                                { do output list }
                                t := sym^.inst^.outputlist;
                                while t <> nil do begin
                                    tt := t;
                                    t := t^.nexttiept;
                                    puttiept( tt );
                                end;
                            end;
                        end else if (sym^.use = gateuse) then begin
                            { undefining a gate }
                            gate := sym^.g;
                            if (gate <> nil) then repeat
                                { check gate(s in this array) for open inputs }
                                case gate^.kind of
                                  andg, nandg, org, norg, xorg, equg:
                                    if gate^.instates[open] > 0
                                      then badgate( gate, errnosrc );
                                  trbg:
                                    if gate^.instates[low] = 0
                                      then badgate( gate, errnosrc );
                                  trig, ntrig, latchg:
                                    if (gate^.inp = open)
                                    or (gate^.control = open)
                                      then badgate( gate, errnosrc );
                                end { case };
                                gate := gate^.nextgate;
                            until gate = sym^.g;
                        end;

                        { then handle removal of symbol from environment }
                        if sym^.stkptr = nil then begin { no previous def }
                            sym^.level := undeflevel;
                            sym^.use := unuse;
                        end else begin { restore previous def }
                            symtab[slot] := sym^.stkptr;
                            putsymbol( sym );
                        end;
                        slot := sym^.nextsym;
                    end;
                end { undefinelocals };


                { parser service routines for error recovery }

                procedure findkeyword( k: keyset );
                { make sure that the current lexeme is a keyword in the
                  set k; if not, complain and scan for such a keyword }
                var i: keytyp;
                begin
                    { assert k <> [] }
                    if not (lex.key in k) then begin
                        i := keycirc;
                        while not (i in k) do i := succ( i );
                        gotbutwant( lex, res, i );
                        repeat nextlex until lex.key in k;
                    end;
                end { findkeyword };

                procedure findid( t:lexset );
                { verify that the current lexeme is an identifier; if
                  not, complain, and scan for some lexeme in the set t
                  which is assumed to contain identifier as one component }
                begin
                    if not (lex.typ in t) then begin
                        gotbutwant( lex, id, notkey );
                        repeat nextlex until lex.typ in t;
                    end;
                end { findid };


                { routines to parse components of a circuit }

                procedure parseexpr( var v: valtyp; enders: lexset );
                { <expr>  ::= <simpexpr> | <simpexpr> ..|<relop> <simpexpr>
                  <relop> ::= < | <= | <> | = | > | >=                    }
                var v1, v2: valtyp;
                    relop: lextyp;

                    procedure parsesimpexpr( var v: valtyp; enders: lexset );
                    { <simpexpr> ::= [ +|- ] <term> [ (+|-|or) <term> ]* }
                    var v1, v2: valtyp;
                        op: lextyp;

                        procedure parseterm( var v: valtyp; enders: lexset );
                        { <term> ::= <fact> [ (*|/|mod|and) <fact> ]* }
                        var v1, v2: valtyp;
                            op: lextyp;

                            procedure parsefact( var v:valtyp; enders:lexset );
                            { <fact> ::= <factor> [ ** <factor> ] }
                            var v1, v2: valtyp;

				function bitc(i: integer): integer;
                                { count ones in binary rep of an integer }
				var j: integer;
				begin
				    j := 0;
				    if i < 0 then begin
					i := (i - maxint) - 1;
					j := j + 1;
				    end;
				    while i > 0 do begin
					if odd(i) then j := j + 1;
					i := i div 2;
				    end;
				    bitc := j;
				end;

                                procedure parsefactor( var v: valtyp;
                                                       enders: lexset );
                                { <factor> ::=  <id> [ ( <expr> ) ] | <inum>
                                             |  <rnum> | ( <expr> )
                                             |  \ <factor>                 }
                                var v1: valtyp;
                                    functyp: tabindex;

                                begin
                                    { verify that lex is the start of a factor;
                                      if not, gripe and scan for one }
                                    if not(lex.typ in[notop,id,inum,rnum,bpar])
                                    then begin
                                        gotbutwant( lex, id, notkey );
                                        while not(lex.typ in ([id, inum, rnum,
                                                         bpar, notop]+enders))
                                          do nextlex;
                                    end;

                                    if lex.typ = id then begin
                                        if symtab[lex.slot]^.use = unuse
                                        then begin
                                            { error or predefined functions }
                                            if (lex.slot = symsize)
                                                     or (lex.slot = symfirst)
                                                     or (lex.slot = symlast)
                                            then begin
                                                v.typ := inttyp;
                                                functyp := lex.slot;
                                                nextlex;
                                                if lex.typ = bpar then begin
                                                    nextlex;
                                                    parseexpr(v1,enders+[epar]);
                                                    if (v1.typ <> rangetyp) and
                                                       (v1.typ <> undef)
                                                    then begin
                                                        v.typ := undef;
                                                        badnum( functyp,
                                                                v1, errrange );
                                                    end else if v1.typ = undef
                                                    then begin
                                                        v.typ := undef;
                                                    end else if functyp=symsize
                                                    then begin
                                                        v.ival := (v1.last -
                                                                  v1.first) + 1;
                                                        if v.ival < 0
                                                          then v.ival := 0;
                                                    end else if functyp=symfirst
                                                    then begin
                                                        v.ival := v1.first;
                                                    end else if functyp=symlast
                                                    then begin
                                                        v.ival := v1.last;
                                                    end;
                                                    if lex.typ<>epar then begin
                                                        gotbutwant( lex, epar,
                                                                    notkey );
                                                        repeat
                                                            nextlex;
                                                        until lex.typ
                                                           in enders+[epar];
                                                    end;
                                                end else begin
                                                    gotbutwant( lex, bpar,
                                                                notkey );
                                                    v.typ := undef;
                                                    repeat
                                                        nextlex;
                                                    until lex.typ
                                                       in enders+[epar];
                                                end;
                                            end else if (lex.slot = symodd)
                                                     or (lex.slot = symonebits)
                                            then begin
                                                functyp := lex.slot;
                                                nextlex;
                                                if lex.typ = bpar then begin
                                                    nextlex;
                                                    parseexpr(v1,enders+[epar]);
                                                    if (v1.typ <> inttyp) and
                                                       (v1.typ <> undef)
                                                    then begin
                                                       v.typ := undef;
                                                       badnum( symodd,
                                                               v1, errinteger );
                                                    end else if v1.typ = undef
                                                    then begin
                                                        v.typ := undef;
                                                    end else if functyp = symodd
		    			            then begin
                                                        v.typ := booltyp;
                                                        v.bval := odd(v1.ival);
						    end else begin
                                                        v.typ := inttyp;
                                                        v.ival := bitc(v1.ival);
                                                    end;
                                                    if lex.typ<>epar then begin
                                                        gotbutwant( lex, epar,
                                                                    notkey );
                                                        repeat
                                                            nextlex;
                                                        until lex.typ
                                                           in enders+[epar];
                                                    end;
                                                end else begin
                                                    gotbutwant( lex, bpar,
                                                                notkey );
                                                    v.typ := undef;
                                                    repeat
                                                        nextlex;
                                                    until lex.typ
                                                       in enders+[epar];
                                                end;
                                            end else begin
                                                v.typ := undef;
                                                badname( lex.slot, erridundef );
                                            end;
                                            nextlex;
                                        end else if symtab[lex.slot]^.use
                                                        = decluse then begin
                                            v := symtab[lex.slot]^.valu;
                                            nextlex;
                                        end else if symtab[lex.slot]^.use in
                                                 [typeuse, subuse] then begin
                                            v.typ := circtyp;
                                            v.subptr := symtab[lex.slot];
                                            nextlex;
                                        end else begin { defined but illegal }
                                            { instuse, gateuse, inuse, outuse }
                                            v.typ := undef;
                                            badname( lex.slot, errwrongtyp );
                                            nextlex;
                                        end;
                                    end else if lex.typ = inum then begin
                                        v.typ := inttyp;
                                        v.ival := lex.ival;
                                        nextlex;
                                    end else if lex.typ = rnum then begin
                                        v.typ := realtyp;
                                        v.rval := lex.rval;
                                        nextlex;
                                    end else if lex.typ = bpar then begin
                                        nextlex;
                                        parseexpr( v1, enders+[epar] );
                                        v := v1;
                                        if lex.typ = epar then nextlex
                                        else gotbutwant( lex, epar, notkey );
                                    end else if lex.typ = notop then begin
                                        nextlex;
                                        parsefactor( v1, enders );
                                        if v1.typ = booltyp then begin
                                            v.typ := booltyp;
                                            v.bval := not v1.bval;
                                        end else begin
                                            v.typ := undef;
                                            badnum( niltabindex, v, errbool );
                                        end;
                                    end else begin { syntax err already done }
                                        v.typ := undef;
                                    end;

                                    if not (lex.typ in enders) then begin
                                        gotbutwant( lex, plus, notkey );
                                        repeat
                                            nextlex;
                                        until lex.typ in (enders + [bpar]);
                                    end;
                                end { parsefactor };

                                function power( x, n: integer ): integer;
                                { compute x ** n }
                                var result: integer;
                                begin
                                    result := 1;
                                    while n > 0 do
                                        if odd(n) then begin
                                            result := x * result;
                                            n := n - 1;
                                        end else begin
                                            x := x * x;
                                            n := n div 2;
                                        end;
                                    power := result;
                                end { power };

                            begin { parsefact }
                                parsefactor( v1, enders+[starstar] );
                                if lex.typ = starstar then begin
                                    nextlex;
                                    parsefactor( v2, enders );
                                    if v1.typ <> inttyp then begin
                                        if v1.typ <> undef
                                          then badnum( niltabindex, v1,
                                                       errinteger );
                                        v1.typ := undef;
                                    end else if v2.typ <> inttyp then begin
                                        if v2.typ <> undef
                                          then badnum( niltabindex, v2,
                                                       errposint );
                                        v1.typ := undef;
                                    end else if v2.ival < 0 then begin
                                        badnum( niltabindex, v2, errposint );
                                        v1.typ := undef;
                                    end else if (v1.ival = 0)
                                                and (v2.ival = 0) then begin
                                        badnum( niltabindex, v2, errposint );
                                        v1.typ := undef;
                                    end else begin
                                        v1.ival := power( v1.ival, v2.ival )
                                    end;
                                end;
                                v := v1;
                            end { parsefact };

                        begin { parseterm }
                            parsefact( v1, enders+[star,slash,andop] );
                            op := lex.typ;
                            while (op in [star, slash, andop]) or
                                  ((lex.typ = res) and (lex.key = keymod))
                            do begin
                                nextlex;
                                parsefact( v2, enders+[star,slash,andop] );
                                if op = star then begin
                                    if (v1.typ = inttyp)
                                    and (v2.typ = inttyp) then begin
                                        v1.ival := v1.ival * v2.ival
                                    end else if (v1.typ = realtyp)
                                    and (v2.typ = inttyp) then begin
                                        v1.rval := v1.rval * v2.ival;
                                    end else if (v1.typ = inttyp)
                                    and (v2.typ = realtyp) then begin
                                        v2.rval := v1.ival * v2.rval;   
                                        v1 := v2;
                                    end else if (v1.typ = realtyp)
                                    and (v2.typ = realtyp) then begin
                                        v1.rval := v1.rval * v2.rval;
                                    end else if ((v1.typ = timetyp)
                                                and (v2.typ = realtyp))
                                    or ((v1.typ = realtyp)
                                       and (v2.typ = timetyp))
                                    then begin
                                        v1.typ := timetyp;
                                        v1.rval := v1.rval * v2.rval;
                                    end else if (v1.typ = timetyp)
                                    and (v2.typ = inttyp) then begin
                                        v1.rval := v1.rval * v2.ival;
                                    end else if (v1.typ = inttyp)
                                    and (v2.typ = timetyp) then begin
                                        v2.rval := v1.ival * v2.rval;
                                        v1 := v2;
                                    end else if (v1.typ <> undef)
                                    and (v2.typ <> undef) then begin
                                        semanticerror( errstar, srclno );
                                        v1.typ := undef;
                                    end else begin
                                        v1.typ := undef;
                                    end;
                                end else if op = slash then begin
                                    if (v1.typ = inttyp)
                                    and (v2.typ = inttyp) then begin
                                        if (v1.ival >= 0)
                                        and (v2.ival > 0) then begin
                                            v1.ival := v1.ival div v2.ival;
                                        end else begin
                                            if v1.ival < 0
                                              then badnum( niltabindex, v1,
                                                           errposint );
                                            if v2.ival <= 0
                                              then badnum( niltabindex, v2,
                                                           errposint );
                                            v1.typ := undef;
                                        end;
                                    end else if ((v1.typ = realtyp)
                                                and (v2.typ = realtyp))
                                    or ((v1.typ = timetyp)
                                       and (v2.typ = timetyp)) then begin
                                        if (v2.rval <> 0) then begin
                                            v1.rval := v1.rval / v2.rval;
                                            v1.typ := realtyp;
                                        end else begin
                                            badnum( niltabindex, v2,
                                                    errnonzero );
                                            v1.typ := undef;
                                        end;
                                    end else if ((v1.typ = realtyp)
                                                or (v1.typ = timetyp))
                                    and (v2.typ = inttyp) then begin
                                        if (v2.ival <> 0) then begin
                                            v1.rval := v1.rval / v2.ival;
                                        end else begin
                                            badnum( niltabindex, v2,
                                                    errposint );
                                            v1.typ := undef;
                                        end;
                                    end else if (v1.typ = timetyp)
                                    and (v2.typ = realtyp) then begin
                                        if (v2.rval <> 0) then begin
                                            v1.rval := v1.rval / v2.rval;
                                        end else begin
                                            badnum( niltabindex, v2,
                                                    errnonzero );
                                            v1.typ := undef;
                                        end;
                                    end else if (v1.typ = inttyp)
                                    and (v2.typ = realtyp) then begin
                                        if (v2.ival <> 0) then begin
                                            v2.rval := v1.ival / v2.rval;
                                            v1 := v2;
                                        end else begin
                                            badnum( niltabindex, v2,
                                                    errnonzero );
                                            v1.typ := undef;
                                        end;
                                    end else if (v1.typ <> undef)
                                    and (v2.typ <> undef) then begin
                                        semanticerror( errslash, srclno );
                                        v1.typ := undef;
                                    end else begin
                                        v1.typ := undef;
                                    end;
                                end else if op = res then begin { must be mod }
                                    if (v1.typ = inttyp)
                                    and (v2.typ = inttyp) then begin
                                        if (v1.ival >= 0)
                                        and (v2.ival > 0) then begin
                                            v1.ival := v1.ival mod v2.ival;
                                        end else if v1.ival < 0 then begin
                                            badnum( niltabindex, v1,
                                                           errposint );
                                            v1.typ := undef;
                                        end else if v2.ival <= 0 then begin
                                            badnum( niltabindex, v2,
                                                           errposint );
                                            v1.typ := undef;
                                        end;
                                    end else if (v1.typ <> undef)
                                    and (v1.typ <> inttyp) then begin
                                        badnum( niltabindex, v1, errinteger );
                                        v1.typ := undef;
                                    end else if (v2.typ <> undef)
                                    and (v2.typ <> inttyp) then begin
                                        badnum( niltabindex, v2, errinteger );
                                        v1.typ := undef;
                                    end else begin
                                        v1.typ := undef; 
                                    end;
                                end else begin { must be and }
                                    if (v1.typ = booltyp)
                                    and (v2.typ = booltyp) then begin
                                        v1.bval := v1.bval and v2.bval;
                                    end else if (v1.typ <> undef)
                                             and (v1.typ <> booltyp) then begin
                                        badnum( niltabindex, v1, errbool );
                                        v1.typ := undef;
                                    end else if (v2.typ <> undef)
                                             and (v2.typ <> booltyp) then begin
                                        badnum( niltabindex, v2, errbool );
                                        v1.typ := undef;
                                    end else begin
                                        v1.typ := undef;
                                    end;
                                end;
                                op := lex.typ;
                            end { while };
                            v := v1;
                        end { parseterm };

                    begin { parsesimpexpr }
                        if lex.typ in [plus, minus] then begin
                            op := lex.typ;
                            nextlex;
                            parseterm( v1, enders+[plus,minus] );
                            if op = minus then begin
                                case v1.typ of
                                    inttyp: v1.ival := -v1.ival;
                                   realtyp,
                                   timetyp: v1.rval := -v1.rval;
                                  rangetyp: semanticerror( errminus, srclno );
                                    noexpr,
                                     undef: ;
                                end;
                            end;
                        end else begin
                            parseterm( v1, enders+[plus,minus,orop] );
                        end;

                        op := lex.typ;
                        while (op in [plus, minus, orop]) do begin
                            nextlex;
                            parseterm( v2, enders+[plus,minus,orop] );
                            if op = plus then begin
                                if (v1.typ = inttyp)
                                and (v2.typ = inttyp) then begin
                                    v1.ival := v1.ival + v2.ival;
                                end else if (v1.typ = realtyp)
                                and (v2.typ = realtyp) then begin
                                    v1.rval := v1.rval + v2.rval;
                                end else if (v1.typ = realtyp)
                                and (v2.typ = inttyp) then begin
                                    v1.rval := v1.rval + v2.ival;
                                end else if (v1.typ = inttyp)
                                and (v2.typ = realtyp) then begin
                                    v2.rval := v1.ival + v2.rval;
                                    v1 := v2;
                                end else if (v1.typ = timetyp)
                                and (v2.typ = timetyp) then begin
                                    v1.rval := v1.rval + v2.rval;
                                end else if (v1.typ <> undef)
                                and (v2.typ <> undef) then begin
                                    semanticerror( errplus, srclno );
                                    v1.typ := undef;
                                end else begin
                                    v1.typ := undef;
                                end;
                            end else if op = minus then begin
                                if (v1.typ = inttyp)
                                and (v2.typ = inttyp) then begin
                                    v1.ival := v1.ival - v2.ival;
                                end else if (v1.typ = realtyp)
                                and (v2.typ = realtyp) then begin
                                    v1.rval := v1.rval - v2.rval;
                                end else if (v1.typ = realtyp)
                                and (v2.typ = inttyp) then begin
                                    v1.rval := v1.rval - v2.ival;
                                end else if (v1.typ = inttyp)
                                and (v2.typ = realtyp) then begin
                                    v2.rval := v1.ival - v2.rval;
                                    v1 := v2;
                                end else if (v1.typ = timetyp)
                                and (v2.typ = timetyp) then begin
                                    v1.rval := v1.rval - v2.rval;
                                end else if (v1.typ <> undef)
                                and (v2.typ <> undef) then begin
                                    semanticerror( errminus, srclno );
                                    v1.typ := undef;
                                end else begin
                                    v1.typ := undef;
                                end;
                            end else begin { must be or }
                                if (v1.typ = booltyp)
                                and (v2.typ = booltyp) then begin
                                    v1.bval := v1.bval or v2.bval;
      {10}                      end else if (v1.typ = rangetyp)
      {10}                      and (v2.typ = rangetyp) then begin
      {10}                          if v1.last = (v2.first - 1) 
      {10}                            then v1.last := v2.last
      {10}                          else if v2.last = (v1.first - 1)
      {10}                            then v1.first := v2.first
      {10}                            else badnum(niltabindex, v2, errillconn);
                                end else if (v1.typ <> booltyp)
                                         and (v1.typ <> undef) then begin
                                    badnum( niltabindex, v1, errbool );
                                    v1.typ := undef;
                                end else if (v2.typ <> booltyp)
                                         and (v2.typ <> undef) then begin
                                    badnum( niltabindex, v2, errbool );
                                    v1.typ := undef;
                                end else begin
                                    v1.typ := undef;
                                end;
                            end;
                            op := lex.typ;
                        end { while };
                        v := v1;
                    end { parsesimpexpr };
                                     
                begin { parseexpr }
                    parsesimpexpr( v1, enders+[dotdot, less, lesseq, equal,
                                               noteq, great, greateq] );
                    if lex.typ in [dotdot, less, lesseq, equal,
                                   noteq, great, greateq ] then begin
                        relop := lex.typ;
                        nextlex;
                        parsesimpexpr( v2, enders );
                        if relop = dotdot then begin { range expression }
                            if (v1.typ = inttyp) and (v2.typ = inttyp)
                            then begin
                                v.typ := rangetyp;
                                v.first := v1.ival;
                                v.last := v2.ival;
                            end else if v1.typ <> undef then begin
                                badnum( niltabindex, v1, errinteger );
                                v.typ := undef;
                            end else if (v2.typ <> undef) then begin
                                badnum( niltabindex, v2, errinteger );
                                v.typ := undef;
                            end else begin
                                v.typ := undef;
                            end;
                        end else begin { not a range, must be compare or error }
                            v.typ := booltyp;
                            if (v1.typ = inttyp)
                            and (v2.typ = inttyp) then case relop of
                                    less:    v.bval := v1.ival <  v2.ival;
                                    lesseq:  v.bval := v1.ival <= v2.ival;
                                    noteq:   v.bval := v1.ival <> v2.ival;
                                    equal:   v.bval := v1.ival =  v2.ival;
                                    great:   v.bval := v1.ival >  v2.ival;
                                    greateq: v.bval := v1.ival >= v2.ival;
                            end else if (v1.typ = inttyp)
                            and (v2.typ = realtyp) then case relop of
                                    less:    v.bval := v1.ival <  v2.rval;
                                    lesseq:  v.bval := v1.ival <= v2.rval;
                                    noteq:   v.bval := v1.ival <> v2.rval;
                                    equal:   v.bval := v1.ival =  v2.rval;
                                    great:   v.bval := v1.ival >  v2.rval;
                                    greateq: v.bval := v1.ival >= v2.rval;
                            end else if (v1.typ = realtyp)
                            and (v2.typ = inttyp) then case relop of
                                    less:    v.bval := v1.rval <  v2.ival;
                                    lesseq:  v.bval := v1.rval <= v2.ival;
                                    noteq:   v.bval := v1.rval <> v2.ival;
                                    equal:   v.bval := v1.rval =  v2.ival;
                                    great:   v.bval := v1.rval >  v2.ival;
                                    greateq: v.bval := v1.rval >= v2.ival;
                            end else if ((v1.typ=realtyp) and (v2.typ=realtyp))
                            or ((v1.typ = timetyp) and (v2.typ = timetyp))
                            then case relop of
                                    less:    v.bval := v1.rval <  v2.rval;
                                    lesseq:  v.bval := v1.rval <= v2.rval;
                                    noteq:   v.bval := v1.rval <> v2.rval;
                                    equal:   v.bval := v1.rval =  v2.rval;
                                    great:   v.bval := v1.rval >  v2.rval;
                                    greateq: v.bval := v1.rval >= v2.rval;
      {10}                  end else if (v1.typ=rangetyp)
      {10}                  and (v2.typ=rangetyp) then case relop of
      {10}                          less, lesseq, great, greateq: begin
      {10}                                  semanticerror( errrelop, srclno );
      {10}                                  v.typ := undef;
      {10}                              end;
      {10}                          equal:   v.bval := (v1.first = v2.first)
      {10}                                         and (v1.last  = v2.last);
      {10}                          noteq:   v.bval := (v1.first <> v2.first)
      {10}                                         or  (v1.last <> v2.last);
                            end else if (v1.typ <> undef)
                            and (v2.typ <> undef) then begin
                                semanticerror( errrelop, srclno );
                                v.typ := undef;
                            end else v.typ := undef;
                        end;
                    end else begin
                        v := v1;
                    end;
                end { parseexpr };

                procedure parseparamlist;
                { <paramlist> ::= ( [ <declaration> ]* )
                  <declaration> ::= <declkeyword> [ <identifier> ]*
                  <declkeyword> ::= integer | real | time | range 
                                  | boolean | circuit
                }
                var 
                    param: symref;
                    keytype: exprtyp;
                    i: integer { index into parameter list };
                    templno: integer { save location for srclno };
                    tempfname: tabindex { save location for srcfname };

                begin
                    { assert lex.typ = bpar }
                    nextlex { skip over '(' };
                    i := 1;

                    findkeyword( [ { desired keywords at start of formal decl }
                                   keyint, keyreal, keyrange,
                                   keytime, keybool, keycirc,

                                   { undesirable stoppers }
      {10}                         keyassert,
                                   keyinp, keyoutp, keypart,
                                   keywire, keyend, notkey
                                 ] );
                    while (lex.key in [keyint,  keyreal, keyrange,
                                       keytime, keybool, keycirc])
                    or (lex.typ = id) do begin
                        case lex.key of { classify parameter type }
                            keycirc: keytype := circtyp;
                            keyint:  keytype := inttyp;
                            keyreal: keytype := realtyp;
                            keytime: keytype := timetyp;
                            keyrange:keytype := rangetyp;
                            keybool: keytype := booltyp;
                            notkey:  begin
                                         gotbutwant( lex, res, keyint );
                                         keytype := noexpr;
                                     end;
                        end { case };
                        nextlex { skip over declaration keyword };
                        findid( [id, res, epar] );
                        while lex.typ = id do begin
                            redefine( lex.slot );
                            param := symtab[lex.slot];
                            if param^.use = unuse then begin
                                param^.use := decluse;
                                if i > maxparams then begin
                                    { too many formal parameters }
                                    semanticerror( errfewparam, srclno );
                                    param^.valu.typ := undef;
                                end else if (actuals[i].typ <> keytype)
                                        and (actuals[i].typ <> undef) then begin
                                    { flag unmatched types }
                                    templno := srclno;
                                    tempfname := srcfname;
                                    srclno := actuals[0].last;
                                    srcfname := actuals[0].first;
                                    badnum( lex.slot, actuals[i], errbadparam );
                                    srclno := templno;
                                    srcfname := tempfname;
                                    param^.valu.typ := undef;
                                end else if actuals[i].typ = noexpr then begin
                                    { too few actual params }
                                    tempfname := srcfname;
                                    srcfname := actuals[0].first;
                                    semanticerror( errfewparam,actuals[0].last);
                                    srcfname := tempfname;
                                end else if (keytype = realtyp) and
                                            (actuals[i].typ = inttyp) then begin
                                    { coerce integer into real }
                                    param^.valu.typ := realtyp;
                                    param^.valu.rval := actuals[i].ival;
                                end else if keytype = circtyp then begin
                                    { get gate/circuit info }
                                    if actuals[i].subptr^.use = subuse
                                    then begin
                                        param^.use := subuse;
                                        param^.s := actuals[i].subptr^.s;
                                    end else begin
                                        param^.use := typeuse;
                                        param^.t := actuals[i].subptr^.t;
                                        param^.max := actuals[i].subptr^.max;
                                        param^.min := actuals[i].subptr^.min;
                                    end;
                                end else if keytype = noexpr then begin
                                    { first sym of paramlist not decl keyword }
                                    param^.valu.typ := undef;
                                end else begin
                                    { O.K. }
                                    param^.valu := actuals[i];
                                end;
                            end;
                            nextlex;
                            i := i + 1;
                            findid( [id, res, epar] );
                        end { while loop picking off identifiers to define };

                        findkeyword( [ { desired keywords }
                                       keyint, keyreal, keyrange,
                                       keytime, keybool, keycirc,

                                       { undesirable stoppers }
      {10}                             keyassert,
                                       keyinp, keyoutp, keypart,
                                       keywire, keyend, notkey
                                     ] );
                    end { while loop scanning for declaration keywords };

                    { check if there are too many actual params }
                    if i <= maxparams then
                    if actuals[i].typ <> noexpr then begin
                        tempfname := srcfname;
                        srcfname := actuals[0].first;
                        semanticerror( errmanyparam, actuals[0].last );
                        srcfname := tempfname;
                    end;

                    if lex.typ = epar
                      then nextlex
                      else gotbutwant( lex, epar, lex.key );
                end { parseparamlist };

                procedure parsedeclare;
                { <declare> ::= [ <declaration> | <assertion> ]*
                  <declaration> ::= <declkeyword> [ <id> = <expr> ]*
                  <declkeyword> ::= integer | real | time | range | boolean
      [10]        <assertion> ::= assert <expr>
                }
                var
                    x: tabindex;
                    constname: symref;
                    val: valtyp;
                    keytype: keytyp;

                begin
                    while (lex.typ = hop)
                    or (lex.key in
                      [keyint, keyreal, keytime, keyrange, keybool, keyassert])
                    do begin
                        if lex.typ = hop then begin
                            nextlex;
                            { note that firstpass got the circuit declaration
                              and replaced it with a hop lexeme that hops
                              around the text of the circuit }
      {10}              end else if lex.key = keyassert then begin { assert! }
      {10}                  nextlex { skip over decl keyword };
      {10}                  parseexpr( val, [id, res, hop] );
      {10}                  if val.typ <> booltyp
      {10}                    then badnum( x, val, errbool )
      {10}                    else if not val.bval
      {10}                      then semanticerror( errassert, srclno );
                        end else begin { process declaration }
                            keytype := lex.key;
                            nextlex { skip over decl keyword };
                            findid( [id, res, hop] );
                            while lex.typ = id do begin
                                redefine( lex.slot );
                                x := lex.slot;
                                constname := symtab[lex.slot];
                                nextlex;
                                if lex.typ <> equal
                                  then gotbutwant( lex, equal, notkey )
                                  else nextlex;
                                parseexpr( val, [id, res, hop] );
                                if constname^.use = unuse then begin { use it }
                                    constname^.use := decluse;
                                    if ((keytype = keyint) and
                                            (val.typ <> inttyp)
                                        or (keytype = keyreal) and
                                            (val.typ <> realtyp) and
                                             (val.typ <> inttyp)
                                        or (keytype = keytime) and
                                            (val.typ <> timetyp)
                                        or (keytype = keybool) and
                                            (val.typ <> booltyp)
                                        or (keytype = keyrange) and
                                            (val.typ <> rangetyp))
                                    and (val.typ <> undef) then begin
                                        { flag unmatched types }
                                        badnum( x, val, errwrongtyp );
                                        constname^.valu.typ := undef;
                                    end else if (keytype = keyreal) and
                                                (val.typ = inttyp) then begin
                                        { coerce integer into real }
                                        constname^.valu.typ := realtyp;
                                        constname^.valu.rval := val.ival;
                                    end else begin { O.K. }
                                        constname^.valu := val;
                                    end { if };
                                end { if };
                                findid( [id, res, hop] );
                            end { while };
                        end { if };
                    end { while };
                end { parsedeclare };

                procedure parseinputs;
                { <inputs> ::= inputs [ <id> | <id> ( <expr> ) ]* }
                var tp, y: tieptref;
                    pinslot: tabindex;
                    pinname: symref;
                    i: integer;
                    bounds: valtyp;

                begin
                    nextlex { skip over keyword 'inputs' };
                    findid( [id, res] );
                    if lex.typ <> id then gotbutwant( lex, id, notkey );
                    while lex.typ = id do begin { try to define input ident }
                        pinslot := lex.slot;
                        redefine( pinslot );
                        pinname := symtab[pinslot];
                        if pinname^.use = unuse then begin { legal }
                            pinname^.use := inuse;
                            pinname^.first := undefined;
                            pinname^.last := undefined;
                            nextlex;
                            if lex.typ = bpar then begin { array bounds }
                                nextlex;
                                parseexpr( bounds, [res, epar] );
                                if lex.typ <> epar then begin
                                    gotbutwant( lex, epar, notkey );
                                    while not (lex.typ in [res, epar]) do
                                        nextlex;
                                end;
                                if lex.typ = epar then nextlex;
                                if bounds.typ = rangetyp then begin
                                    pinname^.first := bounds.first;
                                    pinname^.last := bounds.last;
                                end else if bounds.typ <> undef then begin
                                    badnum( pinslot, bounds, errrange );
                                end;
                            end;

                            y := nil;
                            pinname^.inputdef := nil;
                            for i := pinname^.last downto pinname^.first
                            do begin
                                gettiept( tp );
                                tp^.nexttiept := curinst^.inputlist;
                                curinst^.inputlist := tp;
                                if i = pinname^.last
                                  then y := tp
                                  else tp^.nextelem := tp^.nexttiept;
                                with tp^ do begin
                                    slot := pinslot;
                                    isinput := true;
                                    index := i;

                                    destlist := nil;
                                    srcgate := nil;
                                    srctiept := nil;
                                    delay := 0.0;
                                end;
                            end;
                            if y <> nil then begin
                                pinname^.inputdef := tp;
                                y^.nextelem := tp;
                            end;

                        end else begin { skip an unredefinable identifier }
                            nextlex;
                        end;

                        findid( [id, res] );
                    end;
                end { parseinputs };

                procedure parseoutputs;
                { <outputs> ::= outputs [ <id> | <id> ( <expr> ) ]* }
                var tp, y: tieptref;
                    pinslot: tabindex;
                    pinname: symref;
                    i: integer;
                    bounds: valtyp;

                begin
                    nextlex { skip over keyword 'outputs' };
                    findid( [id, res] );
                    if lex.typ <> id then gotbutwant( lex, id, notkey );
                    while lex.typ = id do begin { try to define output ident }
                        pinslot := lex.slot;
                        redefine( pinslot );
                        pinname := symtab[pinslot];
                        if pinname^.use = unuse then begin { legal }
                            pinname^.use := outuse;
                            pinname^.first := undefined;
                            pinname^.last := undefined;
                            nextlex;
                            if lex.typ = bpar then begin { array of outputs }
                                nextlex;
                                parseexpr( bounds, [res, epar] );
                                if lex.typ <> epar then begin
                                    gotbutwant( lex, epar, notkey );
                                    while not (lex.typ in [res, epar]) do
                                        nextlex;
                                end;
                                if lex.typ = epar then nextlex;
                                if bounds.typ = rangetyp then begin
                                    pinname^.first := bounds.first;
                                    pinname^.last := bounds.last;
                                end else if bounds.typ <> undef then begin
                                    badnum( pinslot, bounds, errrange );
                                end;
                            end;

                            y := nil;
                            pinname^.outputdef := nil;
                            for i := pinname^.last downto pinname^.first
                            do begin
                                gettiept( tp );
                                tp^.nexttiept := curinst^.outputlist;
                                curinst^.outputlist := tp;
                                if i = pinname^.last
                                  then y := tp
                                  else tp^.nextelem := tp^.nexttiept;
                                with tp^ do begin
                                    slot := pinslot;
                                    isinput := false;
                                    index := i;

                                    destlist := nil;
                                    srcgate := nil;
                                    srctiept := nil;
                                    delay := 0.0;
                                end;
                            end;
                            if y <> nil then begin
                                pinname^.outputdef := tp;
                                y^.nextelem := tp;
                            end;

                        end else begin { skip unredefinable identifier }
                            nextlex;
                        end;
                        findid( [id, res] );
                    end;
                end { parseoutputs };


                procedure parseparts;
                { <parts> ::= [ <decl> ]* }
                var { the following change value with each new <decl> }
                    parttype: symref { type of parts being declared };
                    partslot: tabindex { slot of type name of part };
                    partparms: parampool { params to gate/subcircuit };
                    partpcnt: paramindex { count of parameters };

                    procedure parsedecl;
                    { <decl> ::= [ <id> [ ( <expr> ) ] ]* : <id> [ <params> ] }
                    var partname: symref { name of part being decl'd };
                        nameslot: tabindex;
                        partbounds: valtyp { bounds of array, if needed };

                        procedure createinstance;
                        { create an instance (or array of instances)
                          of the subcircuit specified by parttype^.s }
                        var newinst, y: instdescrref;
                            i: integer;
                            subcirc: subref;

                        begin
                            partname^.use := instuse;
                            y := nil;
                            partname^.inst := nil;
                            subcirc := parttype^.s;
                            for i := partname^.last downto partname^.first
                            do begin
                                parsecircuit(subcirc, newinst, partparms);
                                if i = partname^.last
                                  then y := newinst
                                  else newinst^.nextinst := partname^.inst;
                                partname^.inst := newinst;
                                newinst^.name := partname^.name;
                                newinst^.inst := curinst;
                                newinst^.index := i;
                            end;
                            if y <> nil then y^.nextinst := newinst;    
                        end { createinstance };
                
                        procedure defname;
                        { define partname as a gate (or array of gates)
                          of the predefined gate type
                          parttype as modified by the parameters in partparms,
                          parameters equal to zero are taken as default
                          values, and changed in a device specific manner }
                        var e: eventref { temp used to update main gate list };
                            y, z: gateref;
                            i: integer;

                            procedure initializegate( var gate: gateref;
                                                      idx: integer );
                            { initialize a predefined gate }

                            begin

                                with gate^ do begin
                                    kind := parttype^.t;
                                    outto := nil;
                                    index := idx;
                                    name := partname^.name;
                                end;
                                gate^.inst := curinst;

                                case parttype^.t of
                                    andg, nandg, org, norg:
                                        with gate^ do begin

                                            if (partparms[1].typ = inttyp)
                                            and (partparms[1].ival >= 0) then
                                                fanin := partparms[1].ival
                                            else if (partparms[1].typ = undef)
                                            or (partparms[1].typ = noexpr)
                                            then begin
                                                fanin := maxint;
                                            end else begin
                                                badnum( partslot,
                                                        partparms[1],
                                                        errposint );
                                                fanin := maxint;
                                            end;

                                            if (partparms[2].typ = timetyp)
                                            and (partparms[2].rval >= 0.0) then 
                                                delay := partparms[2].rval
                                            else if (partparms[2].typ = undef)
                                            or (partparms[2].typ = noexpr)
                                            then
                                                delay := -1.0
                                            else begin
                                                badnum( partslot,
                                                        partparms[2],
                                                        errpostime );
                                                delay := -1.0;
                                            end;

                                            { compute default delay }
                                            if delay < 0.0
                                              then delay := jitter( 0.1 )
                                                    * (defgdel * nanosecond);

                                            instates[low] := 0;
                                            instates[high] := 0;
                                            instates[open] := fanin;
                                        end { with for symmetrical gates };

                                    xorg, equg:
                                        with gate^ do begin

                                            fanin := 2;

                                            if (partparms[1].typ = timetyp)
                                            and (partparms[1].rval >= 0.0) then 
                                                delay := partparms[1].rval
                                            else if (partparms[1].typ = undef)
                                            or (partparms[1].typ = noexpr)
                                            then
                                                delay := -1.0
                                            else begin
                                                badnum( partslot,
                                                        partparms[1],
                                                        errpostime );
                                                delay := -1.0;
                                            end;

                                            { compute default delay }
                                            if delay < 0.0
                                              then delay := jitter( 0.1 )
                                                    * (defgdel * nanosecond);

                                            instates[low] := 0;
                                            instates[high] := 0;
                                            instates[open] := fanin;
                                        end { with for xor and equ gates };

                                    notg:
                                        with gate^ do begin

                                            { use a 1 input nand gate for not }
                                            kind := nandg;
                                            fanin := 1;

                                            if (partparms[1].typ = timetyp)
                                            and (partparms[1].rval >= 0.0) then 
                                                delay := partparms[1].rval
                                            else if (partparms[1].typ = undef)
                                            or (partparms[1].typ = noexpr)
                                            then
                                                delay := -1.0
                                            else begin
                                                badnum( partslot,
                                                        partparms[1],
                                                        errpostime );
                                                delay := -1.0;
                                            end;

                                            { compute default delay }
                                            if delay < 0.0
                                              then delay := jitter( 0.1 )
                                                    * (defgdel * nanosecond);

                                            instates[low] := 0;
                                            instates[high] := 0;
                                            instates[open] := fanin;
                                        end { with for notg };

                                    trbg:
                                        with gate^ do begin
                                            fanin := maxint;
                                            delay := 0.0;
                                            instates[low] := 0;
                                            instates[high] := 0;
                                            instates[open] := fanin;
                                        end { with for trbg };

                                    trig, ntrig, latchg:
                                        with gate^ do begin
                                            if (partparms[1].typ = timetyp)
                                            and (partparms[1].rval >= 0.0) then 
                                                delay := partparms[1].rval
                                            else if (partparms[1].typ = undef)
                                            or (partparms[1].typ = noexpr)
                                            then
                                                delay := -1.0
                                            else begin
                                                badnum( partslot,
                                                        partparms[1],
                                                        errpostime );
                                                delay := -1.0;
                                            end;

                                            { compute default delay }
                                            if delay < 0.0 then begin
                                                delay := jitter( 0.1 )
                                                    * (defgdel * nanosecond);
                                                if parttype^.t = latchg
                                                    then delay := delay * 1.5;
                                            end;
                                            inp := open;
                                            control := open;
                                        end { with for tristate and latchg };
                                end { case };

                                { add the gate to the master gate list }
                                new( e );
                                e^.gateid := gate;
                                e^.downlink := gatelist;
                                gatelist := e;

                                { count instances of this part type }
                                with parttype^ do typecount := typecount + 1;
                            end { initializegate };

                        begin { defname }
                            y := nil;
                            partname^.g := nil;
                            for i := partname^.last downto partname^.first
                            do begin
                                new( z );
                                if i = partname^.last
                                  then y := z
                                  else z^.nextgate := partname^.g;
                                partname^.g := z;
                                initializegate( z, i );
                            end;
                            if y <> nil then y^.nextgate := z;
                        end { defname };

                        procedure parsepart;
                        { parse '<identifier> [ ( [ <expr> ]* ) ]',
                          record the identifier in partname, partslot;
                          record parameters in parsedecl.partparms,
                          check the parameter count for predefined gates }

                        var param: valtyp { temp value of one parameter };
                            i: paramindex;

                        begin { parsepart }

                            { assert lex.typ = colon }
                            nextlex;
                            findid( [id, res] );
                            if lex.typ = id then begin { possible type name }
                                parttype := symtab[lex.slot];
                                partslot := lex.slot;
                                if parttype <> nil
                                then if not (parttype^.use in [subuse,typeuse])
                                then begin { complain }
                                    badname( lex.slot, errivdname );
                                    parttype := nil;
                                end;

                                { get parameters }
                                partpcnt := 0;
                                partparms[0].typ := rangetyp;
                                partparms[0].last := srclno;
                                partparms[0].first := srcfname;
                                nextlex { skip over identifier, look for '(' };
                                if lex.typ = bpar then begin { param list }
                                    nextlex { skip begin paren };
                                    while not (lex.typ in [epar, res])
                                    do begin { get one parameter }
                                        parseexpr( param,
                                            [id, inum, rnum, res, epar] );
                                        partpcnt := partpcnt + 1;
                                        if partpcnt <= maxparams then begin
                                            partparms[partpcnt] := param;
                                        end else begin
                                            badnum( partslot, param,
                                                    errmanyparam );
                                        end;
                                    end { while };
                                    if lex.typ = epar then nextlex
                                    else gotbutwant( lex, epar, notkey );
                                end { if parsing actual param list };

                                { mark all remaining slots as empty }
                                for i := partpcnt + 1 to maxparams
                                  do partparms[i].typ := noexpr;

                                if parttype <> nil
                                then if parttype^.use = typeuse then begin

                                    { check parameter count }
                                    if partpcnt > parttype^.max then begin
                                        badname( partslot, errmanyparam );
                                        partpcnt := parttype^.max;
                                    end else if partpcnt < parttype^.min
                                    then begin
                                        badname( partslot, errfewparam );
                                    end;

                                end { else parttype = nil };
                            end { else it is a reserved word };
                        end { parsepart };

                    begin { parsedecl }
                        { assert lex.typ = id }

                        { set aside name being declared }
                        redefine( lex.slot );
                        partname := symtab[lex.slot];
                        nameslot := lex.slot;

                        { preliminary definition; suppresses later error
                          messages if parttype turns out to be illdefined }
                        partname^.use := gateuse;
                        partname^.g := nil;
                        partname^.first := undefined;
                        partname^.last := undefined;

                        { advance to next lexeme }
                        nextlex;
                        findid( [id, res, colon, bpar] );

                        if lex.typ = bpar then begin { optional array bounds }
                            nextlex;
                            parseexpr( partbounds, [res,epar,colon] );
                            if lex.typ <> epar then begin
                                gotbutwant( lex, epar, notkey );
                                while not (lex.typ in[res,epar,id,colon])do
                                    nextlex;
                            end;
                            if lex.typ = epar then nextlex;
                            if partbounds.typ = rangetyp then begin
                                partname^.first := partbounds.first;
                                partname^.last  := partbounds.last;
                            end else if partbounds.typ <> undef then begin
                                badnum( nameslot, partbounds, errrange );
                            end;
                            findid( [id, colon, res] );
                        end { done with array bounds };

                        if lex.typ = colon then begin { get parttype }
                            parsepart
                        end else if lex.typ = id then begin { another partname}
                            parsedecl;
                        end else begin { a keyword }
                            parttype := nil;
                            gotbutwant( lex, colon, notkey );
                        end;

                        if parttype<>nil then begin { define this sym }
                            if parttype^.use = subuse
                              then createinstance { define a subcircuit }
                            else if parttype^.use = typeuse
                              then defname { define a simple gate };
                        end { else do nothing, error is already reported };
                    end { parsedecl };

                    procedure parseconditional;
                    { <conditional> ::=   if <expr> then
                                           [ <decl> ]*
                                        [ else if <expr> then
                                           [ <decl> ]*       ]*
                                        [ else
                                           [ <decl> ]*       ]
                                          endif
                    }
                    var condval: valtyp;

                        procedure skiptoelse;
                        { skip to the next 'else' or 'endif'
                          corresponding to the current 'if'  }
                        var count: integer;
                            lastlex: keytyp;

                        begin
                            count := 1;
                            repeat
                                lastlex := lex.key;
                                nextlex;
                                if (lex.key = keyif) and
                                   (lastlex <> keyelse) then
                                    count := count + 1
                                else if lex.key = keyendif then
                                    count := count - 1;
                            until (count = 0) or
                                  (count = 1) and (lex.key = keyelse) or
                                  (lex.key = keyend) or
                                  (lex.key = keywire);
                            if (lex.key = keyend) or
                               (lex.key = keywire) then
                                gotbutwant( lex, res, keyendif );
                        end { skiptoelse };

                        procedure skiptoendif;
                        { this is the same as 'skiptoelse' except
                          that it must skip to 'endif' that ends
                          the current 'if'                        }
                        var count: integer;
                            lastlex: keytyp;

                        begin
                            count := 1;
                            repeat
                                lastlex := lex.key;
                                nextlex;
                                if (lex.key = keyif) and
                                   (lastlex <> keyelse) then
                                    count := count + 1
                                else if lex.key = keyendif then
                                    count := count - 1;
                            until (count = 0) or (lex.key = keyend) or
                                  (lex.key = keywire);
                            if (lex.key = keyend) or
                               (lex.key = keywire) then
                                gotbutwant( lex, res, keyendif );
                        end { skiptoendif };
                    
                    begin { parseconditional }
                        nextlex { skip over keyword 'if' };
                        parseexpr( condval, [id, res] );
                        if condval.typ = booltyp then begin
                            if lex.key = keythen
                              then nextlex
                              else gotbutwant( lex, res, keythen );
                            if condval.bval then begin
                                parseparts;
                                if lex.key = keyelse then skiptoendif;
                            end else begin
                                skiptoelse;
                            end;
                            while lex.key = keyelse do begin
                                nextlex { skip over 'else' };
                                if lex.key = keyif then begin
                                    nextlex { skip over keyword 'if' };
                                    parseexpr( condval, [id, res] );
                                    if condval.typ = booltyp then begin
                                        if lex.key = keythen
                                          then nextlex
                                          else gotbutwant( lex, res, keythen );
                                        if condval.bval then begin
                                            parseparts;
                                            if lex.key=keyelse then skiptoendif;
                                        end else begin
                                            skiptoelse;
                                        end;
                                    end else begin
                                        if condval.typ <> undef then
                                          badnum(niltabindex,condval,errbool);
                                        skiptoendif;
                                    end;
                                end else begin
                                    parseparts;
                                end;
                            end;
                            if lex.key = keyendif
                              then nextlex
                              else gotbutwant( lex, res, keyendif );
                        end else begin
                            if condval.typ <> undef then
                              badnum(niltabindex,condval,errbool);
                            skiptoendif;
                        end;
                    end { parseconditional };
                                
                begin { parseparts }
                    findid( [id, res] );
                    while (lex.typ = id) or
                          (lex.key = keyif) do begin
                        if lex.typ = id then
                            parsedecl
                        else
                            parseconditional;
                        findid( [id, res] );
                    end;
                end { parseparts };


                procedure parsewires( enders: keyset );
                { <wires> ::= wires [ <wire> ]*
                  <wire>  ::= <singlewire> | <iteration>
                }

                    procedure parsepin ( var pin: pinrec;
                                         var first, last: integer );
                    { <pin> ::= <id> [ ( <expr> ) ][ . <id> [ ( <expr> ) ]] }

                    var
                        y: tieptref;
                        u: gateref;
                        v: instdescrref;
                        subscript: valtyp { temp holder for subscript };

                        procedure checkpinname;
                        { check to see that pinname of part is valid }
                        begin { checkpinname }
                            case pin.partname^.g^.kind of
                                andg, nandg, org, norg, xorg, equg, trbg:
                                    if (pin.pinslot <> symin)
                                    and (pin.pinslot <> symout) then begin
                                        badname( pin.pinslot, errpinname );
                                        pin.partname := nil;
                                    end;
                                trig, ntrig, latchg:
                                    if (pin.pinslot <> symdata)
                                    and (pin.pinslot <> symctl)
                                    and (pin.pinslot <> symout) then begin
                                        badname( pin.pinslot, errpinname );
                                        pin.partname := nil;
                                    end;
                            end { case };
                        end { checkpinname };

                        procedure findsubsinout;
                        { find tiepoint of a subcircuit }
                        var tp: tieptref;
                        begin { findsubsinout }
                            tp := pin.partname^.inst^.inputlist;
                            while (pin.tiept = nil) and (tp <> nil) do begin
                                if tp^.slot = lex.slot
                                  then pin.tiept := tp
                                  else tp := tp^.nexttiept;
                            end;
                            if pin.tiept = nil then begin
                                tp := pin.partname^.inst^.outputlist;
                                while (pin.tiept = nil)and(tp <> nil) do begin
                                    if tp^.slot = lex.slot
                                      then pin.tiept := tp
                                      else tp := tp^.nexttiept;
                                end;
                            end;
                            if pin.tiept = nil then begin
                                badname( lex.slot, errpinname );
                                pin.partname := nil;
                            end;
                        end { findsubsinout };

                        procedure badpinnum( i: integer );
                        { report a bad pin number error }
                        var temp: valtyp;
                        begin
                            temp.typ := inttyp;
                            temp.ival := i;
                            badnum( pin.pinslot, temp, erroutofbnd );
                            pin.partname := nil;
                        end { badpin };

                        procedure checkgatenum;
                        { check to see that pin number provided for a
                          gate is valid; fake up pin numbers for such things
                          as inputs of 1 input gates and tristate gates }

                        begin { checkgatenum }
                            case pin.partname^.g^.kind of
                                andg, nandg, org, norg, xorg, equg:
                                begin
                                    if pin.pinslot = symout then begin
                                        if pin.pinnum <> undefined then
                                          badpinnum( pin.pinnum );
                                    end else if pin.partname^.g^.fanin = 1
                                    then begin
                                        if pin.pinnum <> undefined then
                                          badpinnum( pin.pinnum );
                                        pin.pinnum := 1;
                                    end else begin
                                        if (pin.pinnum>pin.partname^.g^.fanin)
                                        or (pin.pinnum < 1) then
                                          badpinnum( pin.pinnum );
                                    end;
                                end;

                                trig, ntrig, latchg:
                                begin
                                    if pin.pinnum <> undefined then begin
                                        badpinnum( pin.pinnum );
                                    end else begin
                                        if pin.pinslot = symdata
                                          then pin.pinnum := 1
                                        else
                                          pin.pinnum := 0;
                                    end;
                                end;

                                trbg:
                                begin
                                    if pin.pinnum <> undefined then
                                      badpinnum( pin.pinnum );
                                end;
                            end { case };
                        end { checkgatenum };

                        procedure checkinstnum;
                        { check to see if index to a subcircuit is valid }
                        var tp, head: tieptref;

                        begin
                            { assert pin.tiept <> nil }
                            if pin.tiept^.index <> undefined then begin
                                tp := pin.tiept;
                                head := tp;
                                if tp^.index <> pin.pinnum then
                                    repeat
                                        tp := tp^.nextelem;
                                    until (tp^.index = pin.pinnum) or
                                          (tp = head);
                                if tp^.index = pin.pinnum then
                                    pin.tiept := tp
                                else begin
                                    badpinnum( pin.pinnum );
                                    pin.partname := nil;
                                end;
                            end else begin
                                badname( pin.tiept^.slot, errnotarray );
                                pin.partname := nil;
                            end;
                        end { checkinstnum };

                    begin { parsepin }
                        pin.partname := nil;
                        pin.partnum := undefined;
                        pin.tiept :=  nil;
                        pin.pinslot := niltabindex;
                        pin.pinnum := undefined;
                        first := undefined;
                        last := undefined;

                        if lex.typ = id then begin
                            if (symtab[lex.slot] <> nil)
                            and (symtab[lex.slot]^.use
                                 in [inuse, outuse, gateuse, instuse])
                            then begin
                                pin.partname := symtab[lex.slot];
                                pin.partslot := lex.slot;
                                if pin.partname^.use = gateuse then begin
                                    if pin.partname^.g = nil
                                      then pin.partname := nil
                                    else
                                        pin.gate := pin.partname^.g;
                                end else if pin.partname^.use = instuse
                                then begin
                                    if pin.partname^.inst = nil
                                      then pin.partname := nil;
                                end else if pin.partname^.use = inuse then begin
                                    pin.tiept := pin.partname^.inputdef;
                                end else begin
                                    pin.tiept := pin.partname^.outputdef;
                                end;
                            end else begin
                                badname( lex.slot, errpartname );
                                pin.partname := nil;
                            end;
                            pin.lno := srclno { save lineno for errors };
                            nextlex;

                            if lex.typ = bpar then begin
                                nextlex;
                                parseexpr( subscript, [res, epar] );
                                if lex.typ <> epar then begin
                                    gotbutwant( lex, epar, notkey );
                                    while not (lex.typ in [epar, res]) do
                                        nextlex;
                                end;
                                if lex.typ = epar then nextlex;
                                if (subscript.typ <> inttyp) and
                                   (subscript.typ <> undef ) then begin
                                    badnum( pin.partslot,subscript,errinteger );
                                    pin.partname := nil;
                                end else if subscript.typ = undef then
                                    pin.partname := nil
                                else
                                    pin.partnum := subscript.ival;

                                if pin.partname <> nil then begin
                                    { check array bounds }
                                    if not (pin.partname^.first = undefined)
                                    then begin
                                        if (pin.partnum >= pin.partname^.first)
                                        and (pin.partnum <= pin.partname^.last)
                                        then begin
                                            if pin.partname^.use = inuse
                                            then begin
                                                y := pin.tiept;
                                                while y^.index <> pin.partnum do
                                                    y := y^.nextelem;
                                                pin.tiept := y;
                                                symtab[pin.partslot]^.inputdef
                                                          := y;
                                            end else if pin.partname^.use
                                                        = outuse then begin
                                                y := pin.tiept;
                                                while y^.index <> pin.partnum do
                                                    y := y^.nextelem;
                                                pin.tiept := y;
                                                symtab[pin.partslot]^.outputdef
                                                          := y;
                                            end else if pin.partname^.use
                                                        = gateuse then begin
                                                u := pin.partname^.g;
                                                while u^.index <> pin.partnum do
                                                    u := u^.nextgate;
                                                pin.gate := u;
                                                symtab[pin.partslot]^.g := u;
                                            end else begin
                                                v := pin.partname^.inst;
                                                while v^.index <> pin.partnum do
                                                    v := v^.nextinst;
                                                pin.partname^.inst := v;
                                                symtab[pin.partslot]^.inst := v;
                                            end;
                                        end else begin
                                            badnum( pin.partslot,
                                                    subscript, erroutofbnd );
                                            pin.partname := nil;
                                        end;
                                    end else begin
                                        badname( pin.partslot, errnotarray );
                                        pin.partname := nil;
                                    end;
                                end;

                            end else begin { no index, see if it is required }
                                if pin.partname <> nil
                                then if pin.partname^.use in [gateuse, instuse]
                                then if not (pin.partname^.first = undefined)
                                then begin
                                    badname( lex.slot, errindexreq );
                                    pin.partname := nil;
                                end;
                            end;

                            if lex.typ = dot then begin
                                nextlex;
                                findid( [id, res] );
                                if lex.typ = id then begin
                                    if pin.partname <> nil then begin
                                        if pin.partname^.use = gateuse
                                        then begin
                                            pin.pinslot := lex.slot;
                                            checkpinname;
                                        end else if pin.partname^.use = instuse
                                        then begin
                                            pin.pinslot := lex.slot;
                                            findsubsinout;
                                        end else begin
                                            badname( pin.partslot,errmodifier );
                                            pin.partname := nil;
                                        end;
                                    end;
                                    nextlex;
                                    if pin.partname<>nil then begin
                                        if pin.partname^.use
                                           in [gateuse, instuse]
                                        then begin
                                            if lex.typ = bpar then begin
                                                nextlex;
                                                parseexpr(subscript,[epar,res]);
                                                if subscript.typ <> inttyp
                                                then begin
                                                    badnum( pin.pinslot,
                                                            subscript,
                                                            erroutofbnd );
                                                    pin.partname := nil;
                                                end else if pin.partname^.use
                                                            = gateuse then begin
                                                    pin.pinnum :=subscript.ival;
                                                    checkgatenum;
                                                end else begin
                                                    pin.pinnum :=subscript.ival;
                                                    checkinstnum;
                                                end;
                                                if lex.typ <> epar then begin
                                                    gotbutwant(lex,epar,notkey);
                                                    while not(lex.typ
                                                              in [epar,res])
                                                      do nextlex;
                                                end;
                                                if lex.typ = epar
                                                  then nextlex;
                                            end else if pin.partname <> nil
                                            then begin
                                                if pin.partname^.use = instuse
                                                then begin
                                                    if pin.tiept^.index
                                                       <> undefined
                                                    then begin
                                                        y := pin.tiept;
                                                        first
                                                          := pin.tiept^.index;
                                                        while y <> nil do begin
                                                            last := y^.index;
                                                            y := y^.nexttiept;
                                                            if y <> nil then
                                                            if y^.slot
                                                                <>pin.pinslot
                                                              then y := nil;
                                                        end;
                                                    end;
                                                end else
                                                    checkgatenum;
                                            end;
                                        end;
                                    end else begin { get rest of invalid def }
                                        if lex.typ = bpar then begin
                                            while not(lex.typ in [epar, res])
                                              do nextlex;
                                            if lex.typ=epar then nextlex;
                                        end;
                                    end;
                                end;

                            end else begin { lex.typ <> dot, no modifier }
                                if pin.partname <> nil then begin
                                    if pin.partname^.use in [gateuse, instuse]
                                    then begin
                                        gotbutwant( lex, dot, notkey );
                                        pin.partname := nil;
                                    end else if (pin.partnum = undefined)
                                    and (pin.partname^.first <> undefined)
                                    then begin
                                        first := pin.partname^.first;
                                        last  := pin.partname^.last;
                                    end;
                                end;
                            end;
                        end;

                        if pin.partname = nil then begin
                            pin.pindir := unkdir;
                        end else if pin.partname^.use = inuse then begin
                            pin.pindir := outdir;
                        end else if pin.partname^.use = outuse then begin
                            pin.pindir := indir;
                        end else begin
                            if pin.tiept = nil then begin { ..^.use = gateuse }
                                if pin.pinslot = symout
                                  then pin.pindir := outdir
                                  else pin.pindir := indir;
                            end else begin { pin.partname^.use = instuse }
                                if pin.tiept^.isinput then begin
                                    pin.pindir := indir;
                                end else begin
                                    pin.pindir := outdir;
                                end;
                            end;
                        end;
                    end { parsepin };

                    procedure parsewire;
                    { <singlewire> ::= <pin> to [ <delay> ] [ <pin> ]* }
                    var srcpin: pinrec;
                        destpin: pinrec;
                        timedelay: real;
                        dfirst, dlast,
                        sfirst, slast: integer;

                        procedure parsedelay;
                        { parse '[ ( <expression> ) ]' }
                        var delayval: valtyp;
                        begin
                            if lex.typ = bpar then begin
                                nextlex { skip open paren };
                                parseexpr( delayval, [res, epar] );
                                if (delayval.typ = timetyp) and
                                   (delayval.rval >= 0.0) then
                                    timedelay := delayval.rval
                                else begin
                                    badnum( srcpin.partslot, delayval,
                                            errpostime );
                                    timedelay := 0.0;
                                end;
                                if lex.typ <> epar then begin
                                    gotbutwant( lex, epar, notkey );
                                    while not( lex.typ in [epar,res] )
                                      do nextlex;
                                end;
                                if lex.typ = epar then nextlex;
                            end else begin
                                timedelay := defwdel * (0.5+random)*nanosecond;
                            end;
                        end { parsedelay };

                    begin { parsewire }
                        parsepin( destpin, dfirst, dlast );
                        findkeyword( enders+[keyto,keyfor,keyif] );
                        if lex.key <> keyto then begin
                            errorprefix( srclno );
                            error( errnodest );
                        end else begin
                            repeat
                                if destpin.pindir = indir then begin
                                    pinerror( destpin, errnotsource );
                                    destpin.partname := nil;
                                end;
                                srcpin := destpin;
                                sfirst := dfirst;
                                slast  := dlast;
                                nextlex { scan over 'to' };
                                parsedelay;
                                findid( [id, res] );
                                parsepin( destpin, dfirst, dlast );
                                findid( [id, res] );
                                while lex.typ = id do begin
                                    if destpin.pindir = outdir then begin
                                        pinerror( destpin, errnotdest );
                                    end else if srcpin.partname = nil then begin
                                        { don't bother with old errors }
                                    end else if (sfirst <> undefined)
                                    and (dfirst <> undefined) then begin
                                        { two possible arrays of pins }
                                        if (sfirst = dfirst)
                                        and (slast = dlast) then begin
                                            hookarrayofwires( srcpin,
                                                     destpin, timedelay,
                                                     sfirst, slast )
                                        end else begin
                                            semanticerror( errillconn,
                                                           destpin.lno );
                                        end;
                                    end else if (sfirst = undefined)
                                    and (dfirst = undefined) then begin
                                        { hook up two single pins }
                                        hookwire( srcpin, destpin, timedelay );
                                    end else begin
                                        { attempt to hook pin to array }
                                        semanticerror( errillconn,
                                                       destpin.lno );
                                    end;
                                    parsepin( destpin, dfirst, dlast );
                                    findid( [id, res] );
                                end { while };
                                findkeyword( enders+[keyto,keyfor,keyif] );
                            until lex.key <> keyto;
                            if destpin.pindir = outdir then begin
                                pinerror( destpin, errnotdest );
                            end else if srcpin.partname = nil then begin
                                { don't bother with old errors }
                            end else if (sfirst <> undefined)
                            and (dfirst <> undefined) then begin
                                if (sfirst = dfirst)
                                and (slast = dlast) then begin
                                    hookarrayofwires( srcpin, destpin,
                                                 timedelay, sfirst, slast )
                                end else begin
                                    semanticerror( errillconn, destpin.lno );
                                end;
                            end else if (sfirst = undefined)
                            and (dfirst = undefined) then begin
                                hookwire( srcpin, destpin, timedelay );
                            end else begin
                                semanticerror( errillconn, destpin.lno );
                            end;
                        end;
                    end { parsewire };

                    procedure parseloop( enders: keyset );
                    { <iteration>  ::= for <id> in <expr> do
                                           [ <wire> ]*
                                       endfor
                    }
                    var loopcount: integer { value of loop counter };
                        index: symref { loop counter identifier reference };
                        slot: tabindex { slot for loop counter in symtab };
                        indexval: valtyp { range of values for index in loop };
                        looplno: integer { line number of start of loop body };
                        looppos: pactextindex { start of loop body };
                        showsave: boolean { saved showerror value };

                        procedure skiploop;
                        { skip over a loop }
                        var count: integer;

                        begin
                            count := 1;
                            repeat
                                nextlex;
                                if lex.key = keyfor then
                                    count := count + 1
                                else if lex.key = keyendf then
                                    count := count - 1;
                            until (count = 0) or (lex.key = keyend);
                            if lex.key = keyend
                              then gotbutwant( lex, res, keyendf )
                              else nextlex;
                        end { skiploop };

                        procedure undefineindex;
                        { undefine current loop index so can be
                          reused in the same circuit body in future }
                        var k: tabindex;

                        begin
                            k := symlist;
                            while k <> slot do
                                k := symtab[k]^.nextsym;
                            if k = symlist then
                                symlist := symtab[symlist]^.nextsym
                            else
                                symtab[k]^.nextsym :=
                                    symtab[symtab[k]^.nextsym]^.nextsym;

                            if index^.stkptr = nil then begin
                                index^.level := undeflevel;
                                index^.use := unuse;
                            end else begin
                                symtab[slot] := index^.stkptr;
                                putsymbol( index );
                            end;
                        end { undefineindex };

                    begin
                        nextlex { skip over keyword 'for' };
                        if lex.typ = id then begin { have index identifier }
                            redefine( lex.slot );
                            slot := lex.slot;
                            index := symtab[lex.slot];
                            if index^.use = unuse then begin { can define it }
                                index^.use := decluse;
                                nextlex;
                                if (lex.typ = id) and (lex.slot = symin) then
                                    nextlex
                                else
                                    gotbutwant( lex, kin, notkey );
                                parseexpr( indexval, [res, epar] );
                                if indexval.typ = undef then begin
                                    skiploop;
                                end else if (indexval.typ <> rangetyp) and
                                            (indexval.typ <> undef) then begin
                                    badnum( slot, indexval, errrange );
                                    skiploop;
                                end else begin
                                    if lex.key <> keydo then
                                        gotbutwant( lex, res, keydo );
                                    if indexval.first > indexval.last then
                                        skiploop
                                    else begin { ready to iterate ! }
                                        looplno := srclno { remember loop top };
                                        looppos := textpos;
                                        showsave := showerror;
                                        index^.valu.typ := inttyp;
                                        for loopcount := indexval.first
                                                      to indexval.last do begin
                                            index^.valu.ival := loopcount;
                                            srclno := looplno { back to top };
                                            textpos := looppos;
                                            nextlex;
                                            parsewires( enders );
                                            { don't show errors if previous
                                              iteration had an error }
                                            showerror := not waserror;
                                        end;
                                        showerror := showsave;
                                        if lex.key = keyendf
                                          then nextlex
                                          else gotbutwant( lex, res, keyendf );
                                    end;
                                end;
                                undefineindex;
                            end else begin { index variable already used }
                                skiploop;
                            end;
                        end else begin { no loop index identifier }
                            gotbutwant( lex, id, notkey );
                            skiploop;
                        end;
                    end { parseloop };

                    procedure parseconditional( enders: keyset );
                    { <conditional> ::=   if <expr> then
                                           [ <wire> ]*
                                        [ else if <expr> then
                                           [ <wire> ]*       ]*
                                        [ else
                                           [ <wire> ]*       ]
                                          endif
                    }
                    var condval: valtyp;

                        procedure skiptoelse;
                        { skip to the next 'else' or 'endif'
                          corresponding to the current 'if'  }
                        var count: integer;
                            lastlex: keytyp;

                        begin
                            count := 1;
                            repeat
                                lastlex := lex.key;
                                nextlex;
                                if (lex.key = keyif) and
                                   (lastlex <> keyelse) then
                                    count := count + 1
                                else if lex.key = keyendif then
                                    count := count - 1;
                            until (count = 0) or
                                  (count = 1) and (lex.key = keyelse) or
                                  (lex.key = keyend);
                            if lex.key = keyend then
                                gotbutwant( lex, res, keyendif );
                        end { skiptoelse };

                        procedure skiptoendif;
                        { this is the same as 'skiptoelse' except
                          that it must skip to 'endif' that ends
                          the current 'if'                        }
                        var count: integer;
                            lastlex: keytyp;

                        begin
                            count := 1;
                            repeat
                                lastlex := lex.key;
                                nextlex;
                                if (lex.key = keyif) and
                                   (lastlex <> keyelse) then
                                    count := count + 1
                                else if lex.key = keyendif then
                                    count := count - 1;
                            until (count = 0) or (lex.key = keyend);
                            if lex.key = keyend then
                                gotbutwant( lex, res, keyendif );
                        end { skiptoendif };
                    
                    begin { parseconditional }
                        nextlex { skip over keyword 'if' };
                        parseexpr( condval, [id, res] );
                        if condval.typ = booltyp then begin
                            if lex.key = keythen
                              then nextlex
                              else gotbutwant( lex, res, keythen );
                            if condval.bval then begin
                                parsewires( enders );
                                if lex.key = keyelse then skiptoendif;
                            end else begin
                                skiptoelse;
                            end;
                            while lex.key = keyelse do begin
                                nextlex { skip over 'else' };
                                if lex.key = keyif then begin
                                    nextlex { skip over keyword 'if' };
                                    parseexpr( condval, [id, res] );
                                    if condval.typ = booltyp then begin
                                        if lex.key = keythen
                                          then nextlex
                                          else gotbutwant( lex, res, keythen );
                                        if condval.bval then begin
                                            parsewires( enders );
                                            if lex.key = keyelse then
                                                skiptoendif;
                                        end else begin
                                            skiptoelse;
                                        end;
                                    end else begin
                                        if condval.typ <> undef then
                                          badnum(niltabindex,condval,errbool);
                                        skiptoendif;
                                    end;
                                end else begin
                                    parsewires( enders );
                                end;
                            end;
                            if lex.key = keyendif
                              then nextlex
                              else gotbutwant( lex, res, keyendif );
                        end else begin
                            if condval.typ <> undef then
                              badnum(niltabindex,condval,errbool);
                            skiptoendif;
                        end;
                    end { parseconditional };
                                
                begin { parsewires }
                    repeat { demand a non-empty wire list }
                        if lex.typ = id then
                            parsewire
                        else if lex.key = keyfor then
                            parseloop( enders+[keyendf] )
                        else if lex.key = keyif then
                            parseconditional( enders+[keyelse, keyendif] )
                        else begin
                            gotbutwant( lex, id, notkey );
                            while (lex.typ <> id) and
                                  not (lex.key in enders+[keyfor, keyif])
                              do nextlex;
                        end;
                    until lex.key in enders;
                end { parsewires };


            begin { parsecircuit }
                savelex( save );

                symlist := niltabindex { no symbols have yet been defined };

                currentlevel := currentlevel + 1;

                { fire up lexical analysis right after circuit identifier }
                with cursub^ do begin
                    openlex( parsed, headpos );
                    instcount := instcount + 1;
                end;

                new( curinst );
                with curinst^ do begin { initialize the instance record }
                    name := symtab[cursub^.slot]^.name;
                    index := undefined;
                    inputlist := nil;
                    outputlist := nil;
                end;

                { process subcircuit definitions }
                predefinelocals;

                { process formal parameter list, if any }
                if lex.typ = bpar
                  then parseparamlist
                  else if actuals[1].typ <> noexpr
                         then gotbutwant( lex, bpar, notkey );

                { parse declarations }
                parsedeclare;

      {10}      findkeyword( [keyinp, keyoutp, keypart, keywire, keyend] );
                if lex.key = keyinp then parseinputs;

      {10}      findkeyword( [keyoutp, keypart, keywire, keyend] );
                if lex.key = keyoutp then parseoutputs;

                findkeyword( [keypart, keywire, keyend] );
                if lex.key = keypart then begin
                    nextlex { skip over 'parts' (parseparts calls itself) };
                    parseparts;
                end;

                findkeyword( [keywire, keyend] );
                if lex.key = keywire then begin
                    nextlex { skip over 'wires' (parsewires calls itself) };
                    parsewires( [keyend] );
                end;

		{ needed only if no wire list, but that's possible! }
      {10}      findkeyword( [keyend] );

                { note: firstpass won't let a circuit get through which has
                  a missing end, so that is not checked here }

                checktiepts( curinst, curinst^.outputlist, 0 );
                { note that input tiepoint list must be checked later }
                undefinelocals;

                cursub^.parsed := waserror;
                currentlevel := currentlevel - 1;

                restorelex( save );
            end { parsecircuit };

            procedure makehighlo( highlo: tabindex );
            { make dummy input tiepoints for constants high and low }
            begin
                with symtab[highlo]^ do begin
                    first := undefined;
                    last := undefined;
                    use := inuse { it is a tiepoint, not part of an array };
                    new( inputdef );
                    with inputdef^ do begin
                        slot := highlo;
                        index := undefined;
                        nexttiept := nil;
                        nextelem := inputdef;
                        isinput := true;
                        destlist := nil;
                        srcgate := nil;
                        srctiept := nil;
                        delay := 0.0;
                    end;
                end;
            end { makehighlo };

            procedure makeio;
            { make dummy input/output gates and hook them to the
              tiepoints of the main circuit }
            var
                newgate: gateref;
                scanner: tieptref;
                dumspin, dumdpin: pinrec;
            begin
                new( dumspin.partname );
                new( dumdpin.partname );

                inputs := nil;
                dumspin.partname^.use := gateuse;
                dumdpin.partname^.use := inuse;
                scanner := circuitinst^.inputlist;
                while (scanner<>nil) do begin { do input list first }

                    new( newgate );
                    with newgate^ do begin { initialize input gate }
                        name := symtab[scanner^.slot]^.name;
                        outto := nil;
                        delay := 0.0;
                        request := nil;
                        kind := iogate;
                        next := inputs;
                        index := scanner^.index;
                        state := open;
                    end { with };

                    inputs := newgate;

                    dumspin.tiept := nil;
                    dumspin.gate := newgate;
                    dumdpin.tiept := scanner;
                    dumdpin.lno := -7777 { this should never be used };
                    hookwire( dumspin, dumdpin, 0.0 );

                    scanner := scanner^.nexttiept;
                end { while };

                outputs := nil;
                dumspin.partname^.use := outuse;
                dumdpin.partname^.use := gateuse;
                scanner := circuitinst^.outputlist;
                while (scanner<>nil) do begin { do output list second }

                    new( newgate );
                    with newgate^ do begin { initialize output gate }
                        name := symtab[ scanner^.slot ]^.name;
                        outto := nil;
                        delay := 0.0;
                        request := nil;
                        kind := iogate;
                        next := outputs;
                        index := scanner^.index;
                        state := open;
                    end { with };

                    outputs := newgate;

                    dumspin.tiept := scanner;
                    dumdpin.gate := newgate;
                    dumdpin.pinnum := 0;
                    dumdpin.tiept := nil;
                    dumdpin.lno := -7777 { this should never be used };
                    hookwire( dumspin, dumdpin, 0.0 );

                    scanner := scanner^.nexttiept;
                end { while };

            end { makeio };


        begin { secondpass }
            gatelist := nil;
            symfreelist := nil;
            tieptfreelist := nil;

            currentlevel := undeflevel;

            { setup dummy inputs for the constants zero and one }
            makehighlo( symhi );
            makehighlo( symlo );

            { create an initial nonsense lexical analysis state so that
              checks for undefined variables won't bother us about this }
            textpos := 0;
            srclno := -1;
            errlno := -2;
            lex.key := notkey;
            lex.typ := res;
            showerror := true;
            srcfname := niltabindex;

            { the main circuit has no parameters }
            for i := 1 to maxparams do nilparms[i].typ := noexpr;
            nilparms[0].typ := inttyp;
            nilparms[0].ival := -1;

            parsecircuit( subhead, circuitinst, nilparms );
            circuitinst^.inst := nil;

            { make what is needed to communicate with simulate }
            if not waserror then makeio;
            hiwire := symtab[symhi]^.inputdef^.destlist;
            lowire := symtab[symlo]^.inputdef^.destlist;

            dumpsubtable;
            dumpsymtable;
            dumpfreelists;

        end { secondpass };

  {10}  procedure fixtristate;
  {10}  { fix so gates driven directly by bus driver are driven by bus }
  {10}  { also detects some errors in wiring tristate busses }

  {10}  var w: eventref;
  {10}      g, g1: gateref;
  {10}      o, o1: wireref;
  {10}      drivests: integer; { number of tristates driven by g }
  {10}      tsdcount: integer; { count of gates that drive tristate busses }
  {10}      fixcount: integer; { count of wires moved down bus chains }
  {10}      wircount: integer; { count of wires moved during fixup }
  {10}      bugcount: integer; { count of potential problems }
  {10}      circount: integer; { count of circular linkages }
  {10}  begin { fixtristate };

  {10}      w := gatelist;
  {10}      { note; nextgate field of all gates gets new use here }
  {10}      while w <> nil do begin { preset nextgate field on all gates }
  {10}          { initially, no output relocation; nextgate point to self }
  {10}          g := w^.gateid;
  {10}          g^.nextgate := g;
  {10}          w := w^.downlink;
  {10}      end { while w <> nil };

  {10}      tsdcount := 0;
  {10}      fixcount := 0;
  {10}      bugcount := 0;
  {10}      circount := 0;
  {10}      w := gatelist;
  {10}      while w <> nil do begin { for each gate in the model }
  {10}          drivests := 0;
  {10}          g := w^.gateid;
  {10}          o := g^.outto;
  {10}          g1 := nil;
  {10}          while o <> nil do begin { for each driven wire }
  {10}              if o^.g^.kind = trbg then begin
  {10}                  drivests := drivests + 1;
  {10}	                g1 := o^.g; { gate g drives tristate g1 }
  {10}	                o1 := o;
  {10}              end;
  {10}              o := o^.next;
  {10}          end;
  {10}          { gate g drives tristate g1, and possibly others }

  {10}          if drivests >= 1 then begin { g drives at least one bus }

  {10}              { drivests > 1 implies tristates driven in parallel }
  {10}              { this algorithm corrects some of these, not all! }
  {10}              if drivests > 1 then begin
  {10}                  bugcount := bugcount + 1;
  {10}                  writeln;
  {10}                  write('Warning: "');
  {10}                  printgatename( g );
  {10}                  writeln('"');
  {10}                  write('  drives more than one tristate bus in',
  {10}                        ' parallel; results may be inaccurate.');
  {10}              end;

  {10}              { account for possible relocation of g1's outputs }
  {10}              g1 := g1^.nextgate;

  {10}              { check for and count circular relocations }
  {10}              if g1 = g then begin
  {10}                  bugcount := bugcount + 1;
  {10}                  writeln;
  {10}                  write('Error: "');
  {10}                  printgatename( g );
  {10}                  writeln('"');
  {10}                  write('  is involved in a circular',
  {10}                        ' interconnection of tristate busses.');
  {10}                  waserror := true;
  {10}              end;

  {10}              if (g1 <> g) then begin
  {10}                  { no circular wiring, relocate other wires }
  {10}	                { move other gates driven by g to output of g1! }
  {10}                  tsdcount := tsdcount + 1;

  {10}                  { first, relocate all gates before g1 in list }
  {10}                  while g^.outto <> o1 do begin
  {10}                      fixcount := fixcount + 1;
  {10}                      { snip wire wire from list of driver }
  {10}                      o := g^.outto;
  {10}                      g^.outto := o^.next;
  {10}                      { pop wire into list of driven bus }
  {10}                      o^.next := g1^.outto;
  {10}                      g1^.outto := o;
  {10}                      fixcount := fixcount + 1;
  {10}                  end;

  {10}                  { second, relocate all gates after g1 in list }
  {10}                  while o1^.next <> nil do begin
  {10}                      fixcount := fixcount + 1;
  {10}                      { snip wire wire from list following g1 }
  {10}                      o := o1^.next;
  {10}                      o1^.next := o^.next;
  {10}                      { pop wire into list of driven bus }
  {10}                      o^.next := g1^.outto;
  {10}                      g1^.outto := o;
  {10}                  end;

  {10}                  { record the change that has been made }
  {10}                  g^.nextgate := g1^.nextgate;

  {10}              end;
  {10}          end;

  {10}          w := w^.downlink;
  {10}      end { while w <> nil };

  {10}      if tally and (tsdcount > 0) then begin
  {10}          writeln;
  {10}          write( 'Tally gates that drive busses: ', tsdcount:1 );
  {10}          writeln;
  {10}          write( 'Tally wires moved to downstream busses: ', fixcount:1 );
  {10}      end { if tally };

  {10}      if (tally and(tsdcount > 0)) or (bugcount > 0)
  {10}        then writeln;

  {10}  end { fixtristate };


    begin { buildmodel }
        firstpass;
        if not waserror then secondpass;
  {10}  if not waserror then fixtristate;
    end { buildmodel };



    procedure simulate;
    { run the simulation using the globally provided model }
    const
        initialtime = 0.0;
    type
        wordlit = packed array [1..12] of char { word literal };

    var  { variables used by event management package }
        eventlist: eventref    { list of pending events };
        sparevents: eventref   { list of spare event records };

        inxint, outxint: real  { input and output display intervals };

        { line buffer for simulation commands and input data }
        cmdline: line  { line most recently read by getcmdline };
        cmdlen: integer { length of cmdline };
        readf: boolean { true if line should come from file };
        wordst: integer{ start of word on line set by getword, getnum };
        worden: integer{ end of word on line, set by getword, getnum };

        done: boolean { used to terminate main simulation loop };
        currentevent: eventref { the current event being done };
        result: logiclevel;
        lastio: (show,get)  { was last I/O event a show or get };


        { inside simulate, event list management package }

        function newevent( k: eventkinds; t: real ): eventref;
        { return a new event, ready to initialize and schedule }
        { note: the logic of newevent is duplicated in foreachwire }
        var e: eventref;
        begin { newevent }
            if sparevents = nil then begin
                new(e);
            end else begin
                e := sparevents;
                sparevents :=sparevents^.downlink
            end;
            e^.kind := k;
            e^.time := t;
            newevent := e;
        end { newevent };

        procedure schedule( n: eventref );
        { put the event on the event list, uses pairing heap algorithm }
        begin
            if eventlist = nil then begin
                n^.downlink := nil;
                eventlist := n;
            end else begin 
                { consider n to be minimal heap, pair it with q }
                if eventlist^.time < n^.time then begin
                    { q remains the root }
                    n^.downlink := nil;
                    n^.leftlink := eventlist^.downlink;
                    eventlist^.downlink := n;
                end else begin 
                    { n become the new root }
                    eventlist^.leftlink := nil;
                    n^.downlink := eventlist;
                    eventlist := n;
                end;
            end;
        end { schedule };

        procedure getcurrent;
        { get the next event, and make it the current event }
        var head: eventref;
            next: eventref;
            a, b: eventref;

        begin
            currentevent := eventlist;
            if eventlist <> nil then begin
                { recognize a pair heap }
                next := eventlist^.downlink;
                head := nil;
                while next <> nil do begin { make list of pairs }
                    a := next;
                    next := a^.leftlink;
                    if next <> nil then begin
                        b := next;
                        next := b^.leftlink;
                        { pair up a and b }
                        if a^.time < b^.time then begin
                            b^.leftlink := a^.downlink;
                            a^.downlink := b;
                            a^.leftlink := head;
                            head := a;
                        end else begin
                            a^.leftlink := b^.downlink;
                            b^.downlink := a;
                            b^.leftlink := head;
                            head := b;
                        end;
                    end else begin
                        { put single left over node on pair list }
                        a^.leftlink := head;
                        head := a;
                    end;
                end;
                { compute new head of the list }
                a := head;
                if a <> nil then begin
                    head := a^.leftlink;
                    while head <> nil do begin
                        { link up entries with a }
                        b := head;
                        head := b^.leftlink;
                        if a^.time < b^.time then begin
                            b^.leftlink := a^.downlink;
                            a^.downlink := b;
                        end else begin
                            a^.leftlink := b^.downlink;
                            b^.downlink := a;
                            a := b;
                        end;
                    end;
                end;
                eventlist := a;
            end;
        end { getcurrent };

        procedure endcurrent;
        { deallocate the current event in preparation for next }
        begin { endcurrent }
            currentevent^.downlink :=sparevents;
            sparevents :=currentevent
        end { endcurrent };

        procedure foreachwire( r: wireref; o, n: logiclevel; t: real );
        { construct and sechedule a logic change for each wire in a wirelist }
        { note: this duplicates the logic of newevent for speed's sake }
        var event:eventref;
        begin
            while r <> nil do begin
                if sparevents = nil then begin
                    new(event);
                end else begin
                    event := sparevents;
                    sparevents :=sparevents^.downlink
                end;
                with event^ do begin
                    kind := logicchange;
                    time := t + r^.delay; 
                    old := o;
                    new := n;
                    gateid := r^.g;
                    inputval := r^.inputval;
                end { with };
                schedule(event);
                r := r^.next;
            end { while };
        end { foreachwire };

        { inside simulate, initialization }

        procedure initialize;
        var w, x: eventref;
            g: gateref;

        begin { initialize }
            { initialization of simulation parameters }
            inxint :=1.0 * microsecond;
            outxint :=0.5 * microsecond;

            readf := false;
            eventlist :=nil;
            sparevents :=nil;

            { begin power on initialization of model }
            g := outputs;
            while g <> nil do begin { initialize outputs }
                g^.changecount := 0;
                g^.state := low;
                g^.lastout := low;
                g := g^.next { march down output list };
            end;

            g := inputs;
            while g <> nil do begin { initialize inputs }
                with g^ do begin
                    state := low;
                    lastout := low;
                end;
                g := g^.next;
            end;

            w := gatelist;
            while w <> nil do begin
                { this loop schedules an immediate event for each gate
                  in the gatelist, using the gatelist entries themselves
                  as the entries in the sequencing set }
                with w^.gateid^ do begin { gate specific initialization }
                    request := nil;
                    lastout := low;
                    case kind of
                        andg,nandg,org,norg,xorg,equg:
                            begin
                                instates[low] := fanin - instates[open];
                                instates[high] := 0;
                            end;
                        trbg:
                            begin
                                fanin := instates[low];
                                instates[open] := 0;
                                instates[high] := 0;
                            end;
                        trig,ntrig,latchg:
                            begin
                                inp := low;
                                control := low;
                            end;
                    end { case };
                end { with };
                with w^ do begin
                    { schedule event to kick gate so it will fix its output }
                    kind := logicchange;
                    old := low; new := low;
                    time := initialtime;
                    { gateid is already set }
                    inputval := 1;
                end { with };
                x := w^.downlink;
                schedule( w );
                w := x;
            end { while w <> nil };

            { set constant inputs after gates are kicked, before user input }
            schedule( newevent( lateinit, initialtime + (0.05*outxint) ));

            { setup initial input/output events }
            schedule( newevent( showoutput, initialtime ));
            schedule( newevent( getinput, initialtime + (0.25*outxint) ));
        end { initialize };


        { inside simulate, command line management package }

        procedure getcmdline;
        { read a line from terminal or file(if file, echo) }
        begin
            if readf then begin
                readline(f1, cmdline, cmdlen);
                if cmdline[1]=pooldel then begin
                    readf :=false;
                    readline(input, cmdline, cmdlen);
                end else begin
                    writeoutput(cmdline, cmdlen);
                end;
            end else begin
                readline(input, cmdline, cmdlen);
            end;
            wordst := 0;
            worden := 0;
        end { getcmdline };

        procedure getword;
        { find a word on the command line }
        begin
            wordst := worden + 1  { start after the previous word };
            while (cmdline[wordst] = ' ') and (wordst < cmdlen)
              do wordst := wordst + 1   { skip blanks };
            { note that because cmdline[cmdlen+1] is guaranteed to be blank,
              no checks are required in the following for worden > linelen. }
            if cmdline[wordst] <> ' ' then begin
                worden := wordst;
                while cmdline[worden+1] <> ' '
                  do worden := worden + 1;
            end;
        end { getword };

        procedure resetword;
        { reset the input to read from the file named by this word }
        var fname: line;
            i,j: integer;
        begin
            j := 1;
            for i := wordst to worden do begin
                fname[j] := cmdline[i];
                j := j + 1;
            end;
            for j := j to linelen do fname[j] := ' ';
            reset( f1, fname );
            readf := true;
        end { resetword };

        function notaword: boolean;
        { returns true if getword found a word }
        begin
            notaword := worden < wordst;
        end { notaword };

        function isword( s: wordlit ): boolean;
        { returns true if the current word partially matches s }
        { must be terminated by a blank }
        var i, j: integer;
        begin
            j := wordst;
            i := 1;
            while (cmdline[j] = s[i]) and (s[i] <> ' ') do begin
                i := i + 1;
                j := j + 1;
            end;
            isword := (j > worden) and (i > 1);
        end { isword };

        procedure getnum(var i: real);
        { get a number from the line into i }
        var scale: real;
        begin
            wordst := worden + 1  { start after previous word };
            while (cmdline[wordst] = ' ') and (wordst < cmdlen)
              do wordst := wordst + 1   { skip blanks };
            i := 0;
            worden := wordst;
            while cmdline[worden] in ['0'..'9'] do begin
                i := ( ord(cmdline[worden]) - ord('0') ) + ( i * 10.0 );
                worden := worden + 1;
            end;
            if cmdline[worden] = '.' then begin
                scale := 1.0;
                worden := worden + 1;
                while cmdline[worden] in ['0'..'9'] do begin
                    i := ( ord(cmdline[worden]) - ord('0') ) + ( i * 10.0 );
                    worden := worden + 1;
                    scale := scale * 10.0;
                end;
                i := i / scale;
            end;
            worden := worden - 1 { point it to last char used };
        end { getnum };

        procedure getinterval( var i: real );
        { read an interval ( <number> <units> ) from the current }
        { and following lines, interacting as needed to get it }
        begin
            repeat
                getnum(i) { try to get the number };
                while notaword do begin
                    getword { see if bad number was a word };
                    if not notaword then begin { help request }
                        writeln('  Use a numeric value.');
                    end;
                    write('  Enter interval: ');
                    getcmdline;
                    getnum(i);
                end;
                getword { try to get the units };
                while (not isword('s           '))
                  and (not isword('ms          '))
                  and (not isword('us          '))
                  and (not isword('ns          ')) do begin
                    if not notaword then begin { help request }
                        writeln('  Valid units are:');
                        write('    s  - seconds ');
                        writeln;
                        write('    ms - milliseconds ');
                        writeln('(1000ms = 1s)');
                        write('    us - microseconds ');
                        writeln('(1000us = 1ms)');
                        write('    ns - nanoseconds  ');
                        writeln('(1000ns = 1us)');
                    end;
                    write('  Enter units: ');
                    getcmdline;
                    getword;
                end;
                if isword('s           ') then begin
                    i := i * second;
                end else if isword('ms          ') then begin
                    i := i * millisecond;
                end else if isword('us          ') then begin
                    i := i * microsecond;
                end else {  isword('ns          ')  }   begin
                    i := i * nanosecond;
                end;
                if (i > 10*second)
                or (i < 0.1*nanosecond) then begin
                    write('  Interval must be between');
                    writeln(' 0.1 ns and 10 s.');
                    write('  Enter interval: ');
                    getcmdline;
                end;
            until (i <= 10*second) and (i >= 0.1*nanosecond);
        end { getinterval };


        { inside simulate, general display formats }

        procedure displayheader;
        var inno, outno, lastoutno, lng: integer;
            i: integer;
            ing, outg: gateref;
            inpinused, outpinused: integer;

            procedure showtime( t: real );
            { show the time in a 4 column format }

                procedure show( n: real );
                begin
                    n := round(10.0 * n) / 10.0;
                    if n > 10
                      then write( round(n):4 )
                      else write( trunc(n):2, '.',
                                  round(10.0 * (n - trunc(n))):1 );
                end { show };

            begin { showtime };
                if (t/second) > 0.9995 then begin
                    show(t/second);
                end else if (t/millisecond) > 0.9995 then begin
                    show(t/millisecond);
                end else if (t/microsecond) > 0.9995 then begin
                    show(t/microsecond);
                end else begin
                    show(t/nanosecond);
                end;
            end { showtime };

            procedure showunit( t: real );
            { show the units used by showtime }
            begin
                if (t/second) > 0.9995 then begin
                    write('s ');
                end else if (t/millisecond) > 0.9995 then begin
                    write('ms');
                end else if (t/microsecond) > 0.9995 then begin
                    write('us');
                end else begin
                    write('ns');
                end;
            end { showunit };

        begin { displayheader }
            inpinused := 0;
            ing := inputs;
            while ing <> nil do begin
                inpinused := inpinused + 1;
                ing := ing^.next;
            end;
            outpinused := 0;
            outg := outputs;
            while outg <> nil do begin
                outpinused := outpinused + 1;
                outg := outg^.next;
            end;

            for i :=1 to 70 do write('=');
            writeln;
            write('   circuit name   = ');
            printname( circuitinst^.name, lng, 32 );
            writeln;
            write('   input interval =');
            showtime( inxint );
            showunit( inxint );
            writeln('       If you need help, type h.');
            write('   output interval=');
            showtime( outxint );
            showunit( outxint );
            writeln;
            for i := 1 to 70 do write('-');
            writeln;
            write('TIME:OUTPUTS  ');
            for i := 1 to outpinused - 1 do write('    ');
            write(':INPUTS');
            writeln;
            write('----:-------  ');
            for i := 1 to outpinused - 1 do write('    ');
            write(':------');
            writeln;
            outno := 1;
            lastoutno := outno;
            ing := inputs;
            inno := 1;
            outg := outputs;
            repeat
                if inno = 1 then begin
                    showtime( outxint );
                end else if inno=2 then begin
                    write(' ');
                    showunit( outxint );
                    write(' ');
                end else begin
                    write('    ');
                end;
                for i := 1 to outno - 1 do write(': | ');
                lng := 0;
                while (outno <= outpinused) and (lng < 4) do begin
                    write(':');
                    printname( outg^.name, lng, 9 + (outpinused-outno)*4 );
                    lastoutno := outno;
                    if outg^.index <> undefined then begin
                        write( '(', outg^.index:3, ')' );
                        lng := lng + 5;
                        i := 0 { loop control boolean };
                        repeat
                            outno := outno + 1;
                            outg := outg^.next;
                            if outg = nil { test terminating conditions }
                              then i := 1
                            else if outg^.next = nil { test loop terminators }
                              then i := 1
                            else if outg^.name <> outg^.next^.name
                              then i := 1;
                        until i = 1;
                    end else begin
                        outno := outno + 1;
                        outg := outg^.next;
                    end;
                    for i := 1 to 4 - lng - 1 do write(' ');
                end;
                if (outno > outpinused) and (lng < 4) then begin
                    write('      ');
                end else begin
                    if lng = 0 then lng := 4;
                    for i := (lastoutno-1)*4 + 2 + lng to outpinused*4 + 6
                      do write(' ');
                end;
                write(': ');
                for i :=1 to inno-1 do write('|');
                if inno <= inpinused then begin
                    printname(ing^.name,lng,32);
                    if ing^.index <> undefined then begin
                        write( '(', ing^.index:3, ')' );
                        i := 0 { loop control boolean };
                        repeat
                            inno := inno + 1;
                            ing := ing^.next;
                            if ing = nil { test terminator }
                              then i := 1
                            else if ing^.next = nil
                              then i := 1
                            else if ing^.name <> ing^.next^.name
                              then i := 1;
                        until i = 1;
                    end else begin;
                        inno := inno + 1;
                        ing := ing^.next;
                    end;
                end;
                writeln;
            until (inno>inpinused) and (outno>outpinused);
            write('    ');
            for i :=1 to outpinused do write(': | ');
            write(':     : ');
            for i :=1 to inpinused do write('|');
            writeln;
            for i :=1 to 70 do write('=');
            writeln;
        end { displayheader };

        procedure help;
        { help message for simulation mode }
        begin
            getword { get parameter to help };
            writeln;
            if isword('command     ') then begin
                write('  What command or topic do you');
                write(' want to know about: ');
                getcmdline;
                getword;
                writeln;
            end;
            if notaword then begin
                write('  At this point, you have the');
                writeln(' option of giving');
                write('  input values or using the commands:');
                writeln(' quit, input, output,');
                write('  read or title. More information');
                writeln(' about each of these ');
                write('  are available by typing "h value"');
                writeln(' or "h <command name>";');
                write('  help is also available on other topics.');
                writeln;
            end else if isword('formats     ')
                     or isword('data        ')
                     or isword('values      ') then begin
                write('  Input values are specified by giving');
                writeln(' one character for each input');
                write('  of the circuit being simulated.  The');
                writeln(' character values are:');
                writeln('    H and L   -- specific input levels.');
                writeln('    1 and 0   -- synonyms for H and L.');
                writeln('   blank or x -- keep old value.');
                writeln('       p      -- a short pulse.');
                writeln;
                write('  Output values are reported graphically');
                writeln(' as follows:');
                writeln(':|_ :    -- a value of 0 or false');
                writeln(':  |:    -- a value of 1 or true');
            end else if isword('input       ') then begin
                write('  The input command sets the interval');
                writeln(' between successive input prompts');
                write('  in the simulation.  For example,');
                writeln(' "i 100ns" will set the input');
                write('  interval to 100 nanoseconds.');
                writeln;
                write('  Note: the input interval must be');
                writeln(' no smaler than the output interval.');
                write('  For help with input data formats,');
                writeln(' type "h data".');
            end else if isword('output      ') then begin
                write('  The output command sets the interval');
                writeln(' between successive displays of the');
                write('  simulation outputs.  For example,');
                writeln(' "o 50ns" will set the output');
                write('  interval to 50 nanoseconds.');
                writeln;
                write('  Note: the output interval must be');
                writeln(' no greater than the input interval.');
                write('  For help with output data formats,');
                writeln(' type "h data".');
            end else if isword('read        ') then begin
                write('  The read command causes the logic');
                writeln(' simulator to read all further commands');
                write('  from a file, echoing what it reads');
                writeln(' on the terminal.  For example,');
                write('  "r script" will cause the simulator');
                writeln(' to read from the file "script".');
            end else if isword('title       ') then begin
                write('  The title command reprints the current');
                writeln(' simulation title, including');
                write('  the circuit name, the current');
                writeln(' settings of the input and output');
                write('  intervals, and the labels');
                writeln(' on the input and output columns.');
            end else if isword('quit        ') then begin
                write('  The quit command terminates the');
                writeln(' simulation session.');
            end else if isword('units       ')
                     or isword('seconds     ')
                     or isword('ns          ')
                     or isword('ms          ')
                     or isword('us          ')
                     or isword('nanoseconds ')
                     or isword('millisecond ')
                     or isword('miliseconds ')
                     or isword('microsecond ')
                     or isword('time        ') then begin
                write('  Time is measured in terms of the');
                writeln(' following units:');
                writeln('    s  -- seconds');
                writeln('    ms -- milliseconds (1000ms = 1s)');
                writeln('    us -- microseconds (1000us = 1ms)');
                writeln('    ns -- nanoseconds  (1000ns = 1us)');
            end else if isword('intervals   ')
                     or isword('periods     ') then begin
                write('  The input and output intervals');
                writeln(' determine how frequently input');
                write('  to the simulation is requested,');
                writeln(' and how frequently the outputs');
                write('  are reported.  The input and');
                writeln(' output commands may be used');
                write('  to set these intervals.');
                writeln;
            end else if isword('topics      ')
                     or isword('other       ') then begin
                write('  In addition to help on specific');
                writeln(' commands, help is available on');
                write('  time units, intervals,');
                writeln(' and data formats.');
            end else if isword('help        ') then begin
                write('  The help command takes a topic');
                writeln(' or command as a parameter.');
            end else if isword('iowa        ') then begin
  {silly}       write('  Iowa is known as the hawkeye state.');
  {silly}       writeln;
            end else begin
                write('  That was not a command name');
                writeln(' and no help is available on that topic.');
            end;
            writeln;
        end { help };


        { inside simulate, primary display formatting routines }

        procedure showinp;
        var g:gateref;
        begin
            write(':     : ');
            g := inputs;
            while g <> nil do begin
                if g^.lastout=low
                  then write('0')
                  else write('1');
                g := g^.next;
            end;
            writeln;
        end { showinp };

        procedure showout ( time: real );
        var g: gateref;
        begin
            write(round(time/outxint) mod 10000:4);
            g := outputs;
            while g <> nil do begin
                write(':');
                case g^.lastout of
                    low: write('|');
                    open,high: write(' ');
                end;
                if g^.changecount > 3 then begin
                    write('=');
                end else case g^.changecount of
                    0: write(' ');
                    1: write('_');
                    2: if g^.lastout= g^.state
                         then write('-')
                         else write('=');
                    3: write('=');
                end;
                case g^.lastout of
                    low: write(' ');
                    open,high: write('|');
                end;
                g^.changecount := 0;
                g^.lastout := g^.state;
                g := g^.next;
            end { while };
        end { showout };

        procedure getinp ( time: real );
        var g: gateref;
            i: integer;
            err: boolean {used to flag errors in input data};
            needmore: boolean {used to indicate need for more inp};

        begin
            repeat
                write(':INPUT: ');
                getcmdline;
                getword;
                needmore := true;
                if isword('help        ') then begin
                    help;
                    showout (time);
                end else if isword('quit        ')
                         or isword('stop        ') then begin
                    done := true;
                    needmore := false;
                end else if isword('title       ') then begin
                    displayheader;
                    showout (time);
                end else if isword('read        ') then begin
                    getword { get file name };
                    while notaword do begin
                        writeln('  Read from what file: ');
                        getcmdline;
                        getword;
                    end;
                    resetword;
                    showout (time);
                end else if isword('input       ') then begin
                    getinterval( inxint );
                    showout (time);
                end else if isword('output      ') then begin
                    getinterval( outxint );
                    showout (time);
                end else begin {try to parse line as input data}
                    g := inputs;
                    i := 1;
                    err := false;
                    while (g <> nil) and (i <= cmdlen) do begin
                        if (cmdline[i] in ['0','1','H','L',' ','p','x','X'])
                          then case cmdline[i] of
                            'L', '0':      g^.state := low;
                            'H', '1':      g^.state := high;
                            'p':           g^.state := open { temporarily };
                            ' ', 'x', 'X': g^.state := g^.lastout;
                        end else err := true;
                        g := g^.next;
                        i := i + 1;
                    end;
                    while (g <> nil) do begin { handle short command line }
                        g^.state := g^.lastout;
                        g := g^.next;
                    end;
                    if err then begin
                        writeln;
                        write('  Invalid simulation input,');
                        writeln(' type "h" for help.');
                        writeln;
                        showout (time);
                    end else if cmdline[i] <> ' ' then begin
                        writeln;
                        write('  Too many inputs.');
                        write('  Only ',i-1:1,' allowed.');
                        writeln;
                        writeln;
                        showout (time);
                    end else begin {line held valid input data}
                        needmore := false;
                        g := inputs;
                        while g <> nil do begin
                            with g^ do if lastout <> state then begin
                                if state = open then begin
                                    if lastout = high
                                      then state := low else state := high;
                                    foreachwire(outto, lastout, state,
                                                time + (inxint*0.23) );
                                    foreachwire(outto, state, lastout,
                                                time + (inxint*0.73) );
                                    state := lastout;
                                end else begin
                                    foreachwire(outto, lastout, state, time );
                                    lastout := state;
                                end;
                            end;
                            g := g^.next;
                        end;
                        for i :=1 to trunc(inxint/outxint)
                          do schedule( newevent( showoutput,
                                                 time + (i-0.25)*outxint ));
                        schedule( newevent( getinput, time + inxint ));
                    end { if err or line too long or valid data };
                end { if isword ... };
            until not needmore;
        end { getinp };

        procedure burnup( gate: gateref );
        { report burnt tristate bus }
        begin
            write('  Warning, bus "');
            printgatename( gate );
            writeln('"');
            write('  was driven with conflicting inputs.');
            writeln;
        end { burnup };
    
    begin { simulate }
        initialize;
        displayheader;
        lastio := get;
        done := false;
        repeat { until done }
            getcurrent;
            with currentevent^ do case kind of
                lateinit:
                    begin { late phase of initialization }
                        foreachwire( hiwire, low, high, time);
                        { no need to do same on lowire since it's already low }
                    end;

                showoutput:
                    begin
                        if lastio = show then showinp;
                        showout (time);
                        lastio := show;
                        endcurrent;
                    end;

                getinput:
                    begin
                        if lastio = get then showout (time);
                        getinp (time);
                        lastio := get;
                        endcurrent;
                    end { getinput };

                outchange:
                    begin
                        if gateid^.request = currentevent
                          then gateid^.request := nil;
                        if old <> new
                          then foreachwire( gateid^.outto, old, new, time );
                        endcurrent;
                    end;

                logicchange:
                    with gateid^ do begin
                        time := time + delay * jitter(0.1);

                        { update gate inputs }
                        case kind of
                            andg, org, nandg, norg, xorg, equg, trbg:
                                begin
                                    instates[new] := instates[new] + 1;
                                    instates[old] := instates[old] - 1;
                                end;
                            ntrig, trig, latchg:
                                begin
                                    if inputval = 1
                                      then inp := new
                                      else control := new;
                                end;
                            iogate:
                                ;
                        end { case };

                        { get new outputs }
                        case kind of
                            iogate:
                                begin
                                    if (state <> new)
                                    and not ((state in [open,high])
                                           and (new in [open,high]))
                                      then changecount :=changecount+1;
                                    state := new;
                                end;
                            andg:
                                if (instates[low] = 0)
                                  then result := high
                                  else result := low;
                            org:
                                if (instates[high] > 0)
                                or (instates[open] > 0)
                                  then result := high
                                  else result := low;
                            nandg:
                                if (instates[low] = 0)
                                  then result := low
                                  else result := high;
                            norg:
                                if (instates[high] > 0)
                                or (instates[open] > 0)
                                  then result := low
                                  else result := high;
                            xorg:
                                if instates[low] = 1
                                  then result := high
                                  else result := low;
                            equg:
                                if instates[low] = 1
                                  then result := low
                                  else result := high;
                            trig:
                                if control = low
                                  then result := open
                                else if inp = low
                                  then result := low
                                  else result := high;
                            ntrig:
                                if control = low
                                  then result := open
                                else if inp = low
                                  then result := high
                                  else result := low;
                            latchg:
                                if control = low
                                  then result := lastout
                                else if inp = low
                                  then result := low
                                  else result := high;
                            trbg:
                                if instates[low] > 0
                                  then if instates[high] > 0
                                    then burnup( gateid )
                                    else result := low
                                else if instates[high] > 0
                                  then result := high
                                else begin
                                    result := open;
                                    if lastout = low
                                      then time := time + nanosecond;
                                end;
                        end { case kind };

                        { figure how to send result onwards }
                        case kind of
                            iogate:
                                endcurrent;
                            andg, org, nandg, norg, xorg, equg,
                            trig, ntrig, trbg, latchg:
                                if lastout <> result then begin
                                    if request = nil then begin
                                        currentevent^.kind := outchange;
                                        currentevent^.old := lastout;
                                        currentevent^.new := result;
                                        { note that time and gateid fields
                                          don't need reset }
                                        request := currentevent;
                                        schedule( currentevent );
                                    end else if time < (request^.time + delay/4)
                                                         then begin
                                        { new output cancels old }
                                        request^.new := result;
                                        endcurrent;
                                    end else begin;
                                        currentevent^.kind := outchange;
                                        currentevent^.old := lastout;
                                        currentevent^.new := result;
                                        { note that time and gateid fields
                                          don't need reset }
                                        request := currentevent;
                                        schedule( currentevent );
                                    end;
                                    lastout := result;
                                end else begin { lastout = result }
                                    endcurrent;
                                end { if lastout <> result };

                        end { case kind of };
                    end { logicchange with gateid^ };

            end { with currentevent^ case kind };
        until done;
        writeln;
        writeln('   Simulation ends.');
    end { simulate };



begin { logicsim }
    writeln( 'IOWA Logic Simulator, Ver. 10' );
    seed := 329;
    waserror := false;

    buildmodel;

    if waserror then begin
        writeln;
        writeln ( 'Simulation aborted due to input error' );
        writeln;
    end else begin
        simulate;
    end;

    9999: { fatal error };

end { logicsim }.