Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume10/ptoc/part09/ptc.p.3

Text File | 1987-07-27 | 49.1 KB | 2,502 lines

                    tx^.tto := ty^.thi
                    end
                else if ty^.tt = nscalar then
                    begin
                    ty := ty^.tscalid;
                    tx^.tfrom := ty;
                    while ty^.tnext <> nil do
                        ty := ty^.tnext;
                    tx^.tto := ty
                    end
                else if ty = typnods[tchar] then
                    begin
                    currsym.st := schar;
                    currsym.vchr := chr(minchar);
                    tx^.tfrom := mklit;
                    currsym.st := schar;
                    currsym.vchr := chr(maxchar);
                    tx^.tto := mklit
                    end
                else if ty = typnods[tinteger] then
                    begin
                    currsym.st := sinteger;
                    currsym.vint := -maxint;
                    tx^.tfrom := mklit;
                    currsym.st := sinteger;
                    currsym.vint := maxint;
                    tx^.tto := mklit
                    end
                else
                    fatal(etree);
                tx^.tforstmt := tz;
                tx^.tincr := true
                end;
              npredef,
              nfileof:
                if opn then
                    begin
                    (* create file-struct initialization *)
                    ty := mknode(nselect);
                    ty^.trecord := ti;
                    ty^.tfield :=
                        oldid(defnams[dzinit]^.lid,
                                lforward);
                    tx := mknode(nassign);
                    tx^.tlhs := ty;
                    currsym.st := sinteger;
                    currsym.vint := 0;
                    tx^.trhs := mklit
                    end
                else begin
                    (* create file-struct wrapup *)
                    tx := mknode(ncall);
                    tx^.tcall :=
                        oldid(defnams[dclose]^.lid,
                                lidentifier);
                    tx^.taparm := ti
                     end;
              nrecord:
                begin
                ty := nil;
                tq := tq^.tflist;
                while tq <> nil do
                    begin
                    if filevar(typeof(tq^.tbind)) then
                        begin
                        tz := tq^.tidl;
                        while tz <> nil do
                            begin
                            tx := mknode(nselect);
                            tx^.trecord := ti;
                            tx^.tfield := tz;
                            tx := fileinit(tx,
                                typeof(tq^.tbind),
                                opn);
                            tx^.tnext := ty;
                            ty := tx;
                            tz := tz^.tnext
                            end
                        end;
                    tq := tq^.tnext
                    end;
                tx := mknode(nbegin);
                tx^.tbegin := ty
                end;
            end;(* case *)
            fileinit := tx
        end;

    begin    (* initcode *)
        while tp <> nil do
            begin
            initcode(tp^.tsubsub);
            tv := tp^.tsubvar;
            while tv <> nil do
                begin
                tq := typeof(tv^.tbind);
                if filevar(tq) then
                    begin
                    ti := tv^.tidl;
                    while ti <> nil do
                        begin
                        tu := fileinit(ti, tq, true);
                        linkup(tp, tu);
                        tu^.tnext := tp^.tsubstmt;
                        tp^.tsubstmt := tu;
                        while tu^.tnext <> nil do
                            tu := tu^.tnext;
                        tu^.tnext := fileinit(ti, tq,
                                    false);
                        linkup(tp, tu^.tnext);
                        ti := ti^.tnext
                        end
                    end;
                tv := tv^.tnext;
                end;
            tp := tp^.tnext
            end
    end;    (* initcode *)

begin    (* transform *)
    renamc;
    renamp(top^.tsubsub, false);
    extract(top);
    renamf(top);
    initcode(top^.tsubsub);
    global(top, top, false)
end;    (* transform *)

(*    Emit C-code for program or module.                *)
procedure emit;

const    include    = '# include ';
    define    = '# define ';
    ifdef    = '# ifdef ';
    ifndef    = '# ifndef ';
    elsif    = '# else';
    endif    = '# endif';
    static    = 'static ';
    xtern    = 'extern ';
    typdef    = 'typedef ';
    registr    = 'register ';
    usigned    = 'unsigned ';
    indstep    = 8;

var    conflag,
    setused,
    dropset,
    donearr    : boolean;
    doarrow,
    indnt    : integer;

    procedure increment;
    begin
        indnt := indnt + indstep
    end;

    procedure decrement;
    begin
        indnt := indnt - indstep
    end;

    (*    Write tabs/blanks to properly (?) indent C-code.    *)
    procedure indent;

    var    i    : integer;

    begin
        i := indnt;
        (* limit indent to an integral number of tabs *)
        if i > 60 then
            i := i div tabwidth * tabwidth;
        while i >= tabwidth do
            begin
            write(tab1);
            i := i - tabwidth
            end;
        while i > 0 do
            begin
            write(space);
            i := i - 1
            end;
    end;

    (*    Determine if tp must be cast to an integer before being    *)
    (*    used in an arithmetic expression.            *)
    function arithexpr(tp : treeptr) : boolean;

    begin
        tp := typeof(tp);
        if tp^.tt = nsubrange then
            if tp^.tup^.tt = nconfarr then
                tp := typeof(tp^.tup^.tindtyp)
            else
                tp := typeof(tp^.tlo);
        arithexpr := (tp = typnods[tinteger]) or
                (tp = typnods[tchar]) or
                    (tp = typnods[treal])
    end;

    procedure eexpr(tp : treeptr);                forward;
    procedure etypedef(tp : treeptr);            forward;

    (*    Emit code to select a record member.    *)
    procedure eselect(tp : treeptr);

    begin
        doarrow := doarrow + 1;
        eexpr(tp);
        doarrow := doarrow - 1;
        if donearr then
            donearr := false
        else
            write('.')
    end;

    (*    Emit code for call to a predefined function/procedure.    *)
    procedure epredef(ts, tp : treeptr);

    label    444, 555;

    var    tq,
        tv, tx    : treeptr;
        td    : predefs;
        nelems    : integer;
        ch    : char;
        txtfile    : boolean;

        (*    Determine a format-code for fprintf.        *)
        (*    Update nelems as a sideeffect.            *)
        function typeletter(tp : treeptr) : char;

        label    999;

        var    tq    : treeptr;

        begin
            tq := tp;
            if tq^.tt = nformat then
                begin
                if tq^.texpl^.tt = nformat then
                    begin
                    typeletter := 'f';
                    goto 999
                    end;
                tq := tp^.texpl
                end;
            tq := typeof(tq);
            if tq^.tt = nsubrange then
                tq := typeof(tq^.tlo);
            if tq = typnods[tstring] then
                typeletter := 's'
            else if tq = typnods[tinteger] then
                typeletter := 'd'
            else if tq = typnods[tchar] then
                typeletter := 'c'
            else if tq = typnods[treal] then
                if tp^.tt = nformat then
                    typeletter := 'e'
                else
                    typeletter := 'g'
            else if tq = typnods[tboolean] then
                begin
                typeletter := 'b';
                nelems := 6
                end
            else if tq^.tt = narray then
                begin
                typeletter := 'a';
                nelems := crange(tq^.taindx)
                end
            else if tq^.tt = nconfarr then
                begin
                typeletter := 'v';
                nelems := 0
                end
            else
                fatal(etree);
        999:
        end;    (* typeletter *)

        procedure etxt(tp : treeptr);

        var    w    : toknbuf;
            c    : char;
            i    : toknidx;

        begin
            case tp^.tt of
              nid:
                begin
                tp := idup(tp);
                if tp^.tt = nconst then
                    etxt(tp^.tbind)
                else
                    fatal(etree)
                end;
              nstring:
                begin
                (* printf format string *)
                gettokn(tp^.tsym^.lstr, w);
                i := 1;
                while w[i] <> chr(null) do
                    begin
                    c := w[i];
                    if (c = cite) or (c = bslash) then
                        write(bslash)
                    else if c = percent then
                        write(percent);
                    write(c);
                    i := i + 1
                    end
                end;
              nchar:
                begin
                (* single character in printf format *)
                c := tp^.tsym^.lchar;
                if (c = cite) or (c = bslash) then
                    write(bslash)
                else if c = percent then
                    write(percent);
                write(c)
                end;
            end;(* case *)
        end;    (* etxt *)

        (*    Emit format for fprintf.            *)
        procedure eformat(tq : treeptr);

        var    tx    : treeptr;
            i    : integer;

        begin
            case typeletter(tq) of
              'a':
                begin
                write(percent);
                if tq^.tt = nformat then
                    if tq^.texpr^.tt = ninteger then
                        eexpr(tq^.texpr)
                    else
                        write('*');
                write('.', nelems:1, 's')
                end;
              'b':
                begin
                write(percent);
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt = ninteger then
                        eexpr(tq^.texpr)
                    else
                        write('*')
                    end;
                write('s')
                end;
              'c':
                if tq^.tt = nchar then
                    etxt(tq)
                else begin
                    write(percent);
                    if tq^.tt = nformat then
                        if tq^.texpr^.tt = ninteger then
                            eexpr(tq^.texpr)
                        else
                            write('*');
                    write('c')
                     end;
              'd':
                begin
                write(percent);
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt = ninteger then
                        eexpr(tq^.texpr)
                    else
                        write('*')
                    end
                else
                    write(intlen:1);
                write('d')
                end;
              'e':
                begin
                write(percent, space);
                tx := tq^.texpr;
                if tx^.tt = ninteger then
                    begin
                    i := cvalof(tx);
                    write(i:1, '.');
                    i := i - 7;
                    if i < 1 then
                        write('1')
                    else
                        write(i:1)
                    end
                else
                    write('*.*');
                write('e')
                end;
              'f':
                begin
                write(percent);
                tx := tq^.texpl;
                if tx^.texpr^.tt = ninteger then
                    begin
                    eexpr(tx^.texpr);
                    write('.');
                    tx := tq^.texpr;
                    if tx^.tt = ninteger then
                        begin
                        i := cvalof(tx);
                        tx := tq^.texpl^.texpr;
                        if i > cvalof(tx) - 1 then
                            write('1')
                        else
                            write(i:1)
                        end
                    else
                        write('*');
                    end
                else
                    write('*.*');
                write('f')
                end;
              'g':
                write(percent, fixlen:1, 'e');
              's':
                if tq^.tt = nstring then
                    etxt(tq)
                else begin
                    write(percent);
                    if tq^.tt = nformat then
                        if tq^.texpr^.tt = ninteger then
                            eexpr(tq^.texpr)
                        else
                            write('*.*');
                    write('s')
                     end
            end (* case *)
        end;    (* eformat *)

        (*    Emit parameters to fprintf except format.    *)
        procedure ewrite(tq : treeptr);

        var    tx    : treeptr;

        begin
            case typeletter(tq) of
              'a':
                begin
                write(', ');
                tx := tq;
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt <> ninteger then
                        begin
                          eexpr(tq^.texpr);
                          write(', ')
                        end;
                    tx := tq^.texpl
                    end;
                eexpr(tx);
                write('.A')
                end;
              'b':
                begin
                write(', ');
                tx := tq;
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt <> ninteger then
                        begin
                          eexpr(tq^.texpr);
                          write(', ')
                        end;
                    tx := tq^.texpl
                    end;
                usebool := true;
                write('Bools[(int)(');
                eexpr(tx);
                write(')]')
                end;
              'c':
                begin
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt <> ninteger then
                        begin
                        write(', ');
                        eexpr(tq^.texpr)
                        end;
                    write(', ');
                    eexpr(tq^.texpl)
                    end
                else if tq^.tt <> nchar then
                    begin
                    write(', ');
                    eexpr(tq)
                    end
                end;
              'd':
                begin
                write(', ');
                tx := tq;
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt <> ninteger then
                        begin
                        eexpr(tq^.texpr);
                        write(', ')
                        end;
                    tx := tq^.texpl
                    end;
                eexpr(tx)
                end;
              'e':
                begin
                write(', ');
                tx := tq^.texpr;
                if tx^.tt <> ninteger then
                    begin
                    usemax := true;
                    eexpr(tx);
                    write(', Max(');
                    eexpr(tx);
                    write(' - 7, 1), ')
                    end;
                eexpr(tq^.texpl)
                end;
              'f':
                begin
                write(', ');
                tx := tq^.texpl;
                if tx^.texpr^.tt <> ninteger then
                    begin
                    eexpr(tx^.texpr);
                    write(', ')
                    end;
                if (tx^.texpr^.tt <> ninteger) or
                    (tq^.texpr^.tt <> ninteger) then
                    begin
                    usemax := true;
                    write('Max((');
                    eexpr(tx^.texpr);
                    write(') - (');
                    eexpr(tq^.texpr);
                    write(') - 1, 1), ')
                    end;
                eexpr(tq^.texpl^.texpl)
                end;
              'g':
                begin
                write(', ');
                eexpr(tq)
                end;
              's':
                begin
                if tq^.tt = nformat then
                    begin
                    if tq^.texpr^.tt <> ninteger then
                       begin
                        write(', ');
                        eexpr(tq^.texpr);
                        write(', ');
                        eexpr(tq^.texpr)
                       end;
                    write(', ');
                    eexpr(tq^.texpl)
                    end
                else if tq^.tt <> nstring then
                    begin
                    write(', ');
                    eexpr(tq)
                    end
                end
            end (* case *)
        end;    (* ewrite *)

        (*    Emit size of *tp for call to malloc. CPU    *)
        (*    There is no safe way to compute the size of a    *)
        (*    particular variant of a C-union, we assume that    *)
        (*    the size can be computed by taking the address    *)
        (*    of the first member and subracting the address    *)
        (*    of the record and then adding the size of the    *)
        (*    variant containing the record.            *)
        procedure enewsize(tp : treeptr);

        label    555;

        var    tq, tx, ty    : treeptr;
            v        : integer;

            (*    Emit size of union member tq.        *)
            procedure esubsize(tp, tq : treeptr);

            label    555, 666;

            var    tx, ty    : treeptr;
                addsize    : boolean;

            begin
                tx := tq^.tvrnt;
                ty := tx^.tflist;
                if ty = nil then
                    begin
                    ty := tx^.tvlist;
                    while ty <> nil do
                        begin
                        if ty^.tvrnt^.tflist <> nil then
                            begin
                            ty := ty^.tvrnt^.tflist;
                            goto 555
                            end;
                        ty := ty^.tnext
                        end;
                555:
                    end;
                addsize := true;
                if ty = nil then
                    begin
                    (* empty variant, try using another *)
                    addsize := false;
                    ty := tx^.tup^.tup^.tvlist;
                    while ty <> nil do
                        begin
                        if ty^.tvrnt^.tflist <> nil then
                            begin
                            ty := ty^.tvrnt^.tflist;
                            goto 666
                            end;
                        ty := ty^.tnext
                        end;
                666:
                    end;
                if ty = nil then
                    begin
                    (* its getting too complicated,
                        ignore tag value *)
                    write('sizeof(*');
                    eexpr(tp);
                    write(')')
                    end
                else begin
                    (* compute offset to first member of
                       the selected union variant *)
                    write('Unionoffs(');
                    eexpr(tp);
                    write(', ');
                    printid(ty^.tidl^.tsym^.lid);
                    if addsize then
                        begin
                        (* add the size of the selected
                           union variant *)
                        write(') + sizeof(');
                        eexpr(tp);
                        write('->');
                        printid(tx^.tuid)
                        end;
                    write(')')
                     end
            end;

        begin    (* newsize *)
            if (tp^.tnext <> nil) and unionnew then
                begin
                (* tnext points to a tag-value, evaluate it *)
                v := cvalof(tp^.tnext);
                (* find union type *)
                tq := typeof(tp);
                tq := typeof(tq^.tptrid);
                if tq^.tt <> nrecord then
                    fatal(etree);
                (* find corresponding variant *)
                tx := tq^.tvlist;
                while tx <> nil do
                    begin
                    ty := tx^.tselct;
                    while ty <> nil do
                        begin
                        if v = cvalof(ty) then
                            goto 555;
                        ty := ty^.tnext
                        end;
                    tx := tx^.tnext
                    end;
                fatal(etag);
            555:
                (* emit size for that variant *)
                esubsize(tp, tx)
                end
            else begin
                write('sizeof(*');
                eexpr(tp);
                write(')')
                 end
        end;    (* newsize *)

    begin    (* epredef *)
        td := ts^.tsubstmt^.tdef;
        case td of
          dabs:
            begin
            tq := typeof(tp^.taparm);
            if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
                write('abs(')            (* LIB *)
            else
                write('fabs(');            (* LIB *)
            eexpr(tp^.taparm);
            write(')')
            end;
          dargv:
            begin
            write('Argvgt(');
            eexpr(tp^.taparm);
            write(', ');
            eexpr(tp^.taparm^.tnext);
            write('.A, sizeof(');
            eexpr(tp^.taparm^.tnext);
            writeln('.A));')
            end;
          dchr:
            begin
            tq := typeof(tp^.taparm);
            if tq^.tt = nsubrange then
                if tq^.tup^.tt = nconfarr then
                    tq := typeof(tq^.tup^.tindtyp)
                else
                    tq := typeof(tq^.tlo);
            if (tq = typnods[tinteger]) or
                        (tq = typnods[tchar]) then
                eexpr(tp^.taparm)
            else begin
                write('(char)(');
                eexpr(tp^.taparm);
                write(')')
                 end
            end;
          ddispose:
            begin
            write('free(');                (* LIB *)
            eexpr(tp^.taparm);
            writeln(');')
            end;
          deof:
            begin
            write('Eof(');
            if tp^.taparm = nil then
                begin
                defnams[dinput]^.lused := true;
                printid(defnams[dinput]^.lid)
                end
            else
                eexpr(tp^.taparm);
            write(')')
            end;
          deoln:
            begin
            write('Eoln(');
            if tp^.taparm = nil then
                begin
                defnams[dinput]^.lused := true;
                printid(defnams[dinput]^.lid)
                end
            else
                eexpr(tp^.taparm);
            write(')');
            end;
          dexit:
            begin
            write('exit(');                (* OS *)
            if tp^.taparm = nil then
                write('0')
            else
                eexpr(tp^.taparm);
            writeln(');');
            end;
          dflush:
            begin
            write('fflush(');            (* LIB *)
            if tp^.taparm = nil then
                begin
                defnams[doutput]^.lused := true;
                printid(defnams[doutput]^.lid)
                end
            else
                eexpr(tp^.taparm);
            writeln('.fp);')
            end;
          dpage:
            begin
            (* write form-feed character *)
            write('Putchr(', ffchr, ', '); (* CHAR *)
            if tp^.taparm = nil then
                begin
                defnams[doutput]^.lused := true;
                printid(defnams[doutput]^.lid)
                end
            else
                eexpr(tp^.taparm);
            writeln(');');
            end;
          dput,
          dget:
            begin
            if typeof(tp^.taparm) = typnods[ttext] then
                if td = dget then
                    write('Getx')
                else
                    write('Putx')
            else begin
                write(voidcast);
                if td = dget then
                    write('Get')
                else
                    write('Put')
                 end;
            write('(');
            eexpr(tp^.taparm);
            writeln(');')
            end;
          dhalt:
            writeln('abort();');            (* OS *)
          dnew:
            begin
            eexpr(tp^.taparm);
            write(' = (');
            etypedef(typeof(tp^.taparm));
            write(')malloc((unsigned)(');    (* LIB *)
            enewsize(tp^.taparm);
            writeln('));')
            end;
          dord:
            begin
            write('(unsigned)(');
            eexpr(tp^.taparm);
            write(')')
            end;
          dread,
          dreadln:
            begin
            txtfile := false;
            tq := tp^.taparm;
            if tq <> nil then
                begin
                tv := typeof(tq);
                if tv = typnods[ttext] then
                    begin
                    (* reading from textfile *)
                    txtfile := true;
                    tv := tq;
                    tq := tq^.tnext
                    end
                else if tv^.tt = nfileof then
                    begin
                    (* reading from other file *)
                    txtfile := typeof(tv^.tof) =
                            typnods[tchar];
                    tv := tq;
                    tq := tq^.tnext
                    end
                else begin
                    (* reading from std-input *)
                    txtfile := true;
                    tv := nil
                     end
                end
            else begin
                tv := nil;
                txtfile := true
                 end;
            if txtfile then
                begin
                (* check for special case *)
                if tq = nil then
                    goto 444;
                if (tq^.tt <> nformat) and
                        (tq^.tnext = nil) and
                        (typeletter(tq) = 'c') then
                    begin
                    (* read single char *)
                    eexpr(tq);
                    write(' = ');
                    write('Getchr(');
                    if tv = nil then
                        printid(defnams[dinput]^.lid)
                    else
                        eexpr(tv);
                    write(')');
                    if td = dreadln then
                        write(',');
                    goto 444
                    end;
                usescan := true;
                write('Fscan(');
                if tv = nil then
                    printid(defnams[dinput]^.lid)
                else
                    eexpr(tv);
                write('), ');
                (* first pass, emit format string *)
                while tq <> nil do
                    begin
                    write('Scan(', cite);
                    ch := typeletter(tq);
                    case ch of
                      'a':
                        write(percent, 's');
                      'c':
                        write(percent, 'c');
                      'd':
                        write(percent, 'ld');
                      'g':
                        write(percent, 'le')
                    end;(* case *)
                    write(cite, ', ');
                    case ch of
                      'a':
                        begin
                        eexpr(tq);
                        write('.A')
                        end;
                      'c':
                        begin
                        write('&');
                        eexpr(tq)
                        end;
                      'd':
                        write('&Tmplng');
                      'g':
                        write('&Tmpdbl')
                    end;(* case *)
                    write(')');
                    case ch of
                      'd':
                        begin
                        write(', ');
                        eexpr(tq);
                        write(' = Tmplng')
                        end;
                      'g':
                        begin
                        write(', ');
                        eexpr(tq);
                        write(' = Tmpdbl')
                        end;
                      'a',
                      'c':
                        (* no op *)
                    end;(* case *)
                    tq := tq^.tnext;
                    if tq <> nil then
                        begin
                        writeln(',');
                        indent;
                        write(tab1)
                        end
                    end;
                write(', Getx(');
                if tv = nil then
                    printid(defnams[dinput]^.lid)
                else
                    eexpr(tv);
                write(')');
                if td = dreadln then
                    write(',');
            444:
                if td = dreadln then
                    begin
                    usegetl := true;
                    write('Getl(&');
                    if tv = nil then
                        printid(defnams[dinput]^.lid)
                    else
                        eexpr(tv);
                    write(')')
                    end
                end
            else begin
                increment;
                while tq <> nil do
                    begin
                    write(voidcast, 'Fread(');
                    eexpr(tq);
                    write(', ');
                    eexpr(tv);
                    write('.fp)');
                    tq := tq^.tnext;
                    if tq <> nil then
                        begin
                        writeln(',');
                        indent
                        end
                    end;
                decrement
                 end;
            writeln(';')
            end;
          dwrite,
          dwriteln,
          dmessage:
            begin
            txtfile := false;
            tq := tp^.taparm;
            if tq <> nil then
                begin
                tv := typeof(tq);
                if tv = typnods[ttext] then
                    begin
                    (* writing to textfile *)
                    txtfile := true;
                    tv := tq;
                    tq := tq^.tnext
                    end
                else if tv^.tt = nfileof then
                    begin
                    (* writing to other file *)
                    txtfile := typeof(tv^.tof) =
                            typnods[tchar];
                    tv := tq;
                    tq := tq^.tnext
                    end
                else begin
                    (* writing to std-output *)
                    txtfile := true;
                    tv := nil
                     end
                end
            else begin
                tv := nil;
                txtfile := true
                 end;
            if txtfile then
                begin
                (* check for special case *)
                if tq = nil then
                    begin
                    (* writeln whithout parameters *)
                    if td in [dwriteln, dmessage] then
                        begin
                        write('Putchr(', nlchr, ', ');
                        if tv = nil then
                            printid(
                              defnams[doutput]^.lid)
                        else
                            eexpr(tv);
                        write(')')
                        end;
                    writeln(';');
                    goto 555
                    end
                else if (tq^.tt <> nformat) and
                        (tq^.tnext = nil) then
                    if typeletter(tq) = 'c' then
                        begin
                        (* print single char *)
                        write('Putchr(');
                        eexpr(tq);
                        write(', ');
                        if tv = nil then
                            printid(
                              defnams[doutput]^.lid)
                        else
                            eexpr(tv);
                        write(')');
                        if td = dwriteln then
                            begin
                            write(',Putchr(',
                                nlchr, ', ');
                            if tv = nil then
                             printid(
                              defnams[doutput]^.lid)
                            else
                                eexpr(tv);
                            write(')');
                            end;
                        writeln(';');
                        goto 555
                        end;
                tx := nil;
                write(voidcast, 'fprintf(');    (* LIB *)
                if td = dmessage then
                    write('stderr, ')
                else begin
                    if tv = nil then
                        printid(defnams[doutput]^.lid)
                    else
                        eexpr(tv);
                    write('.fp, ')
                     end;
                write(cite);
                tx := tq;    (* remember 1:st parm *)
                (* first pass, emit format string *)
                while tq <> nil do
                    begin
                    eformat(tq);
                    tq := tq^.tnext
                    end;
                if (td = dmessage) or (td = dwriteln) then
                    write('\n');
                write(cite);
                (* second pass, add parameters *)
                tq := tx;
                while tq <> nil do
                    begin
                    ewrite(tq);
                    tq := tq^.tnext
                    end;
                write('), Putl(');
                if tv = nil then
                    printid(defnams[doutput]^.lid)
                else
                    eexpr(tv);
                if td = dwrite then
                    write(', 0)')
                else
                    write(', 1)')
                end
            else begin
                increment;
                tx := typeof(tv);
                if tx = typnods[ttext] then
                    tx := typnods[tchar]
                else if tx^.tt = nfileof then
                    tx := typeof(tx^.tof)
                else
                    fatal(etree);
                while tq <> nil do
                    begin
                    if (tq^.tt in [nid, nindex, nselect,
                            nderef]) and
                        (tx = typeof(tq)) then
                        begin
                        write(voidcast, 'Fwrite(');
                        eexpr(tq)
                        end
                    else begin
                        if tx^.tt = nsetof then
                            begin
                            usescpy := true;
                            write('Setncpy(');
                            eselect(tv);
                            write('buf.S, ');
                            eexpr(tq);
                            if typeof(tp^.trhs) =
                               typnods[tset] then
                                eexpr(tq)
                            else begin
                                eselect(tq);
                                write('S')
                                 end;
                            write(', sizeof(');
                            eexpr(tv);
                            write('.buf))');
                            end
                        else begin
                            eexpr(tv);
                            write('.buf = ');
                            eexpr(tq)
                             end;
                        write(', Fwrite(');
                        eexpr(tv);
                        write('.buf');
                         end;
                    write(', ');
                    eexpr(tv);
                    write('.fp)');
                    tq := tq^.tnext;
                    if tq <> nil then
                        begin
                        writeln(',');
                        indent
                        end
                    end;
                decrement
                 end;
            writeln(';');
        555:
            end;
          dclose:
            begin
            tq := typeof(tp^.taparm);
            txtfile := tq = typnods[ttext];
            if (not txtfile) and (tq^.tt = nfileof) then
                if typeof(tq^.tof) = typnods[tchar] then
                    txtfile := true;
            if txtfile then
                write('Closex(')
            else
                write('Close(');
            eexpr(tp^.taparm);
            writeln(');');
            end;
          dreset,
          drewrite:
            begin
            tq := typeof(tp^.taparm);
            txtfile := tq = typnods[ttext];
            if (not txtfile) and (tq^.tt = nfileof) then
                if typeof(tq^.tof) = typnods[tchar] then
                    txtfile := true;
            if txtfile then
                if td = dreset then
                    write('Resetx(')
                else
                    write('Rewritex(')
            else
                if td = dreset then
                    write('Reset(')
                else
                    write('Rewrite(');
            eexpr(tp^.taparm);
            write(', ');
            tq := tp^.taparm^.tnext;
            if tq = nil then
                write('NULL')
            else begin
                tq := typeof(tq);
                if tq = typnods[tchar] then
                    begin
                    write(cite);
                    ch := chr(cvalof(tp^.taparm^.tnext));
                    if (ch = bslash) or (ch = cite) then
                        write(bslash);
                    write(ch, cite)
                    end
                else if tq = typnods[tstring] then
                    eexpr(tp^.taparm^.tnext)
                else  if tq^.tt in [narray, nconfarr] then
                     begin
                    eexpr(tp^.taparm^.tnext);
                    write('.A')
                     end
                else
                    fatal(etree)
                 end;
            writeln(');')
            end;
          darctan:
            begin
            write('atan(');    (* LIB *)
            if typeof(tp^.taparm) <> typnods[treal] then
                write(dblcast);
            eexpr(tp^.taparm);
            write(')')
            end;
          dln:
            begin
            write('log(');    (* LIB *)
            if typeof(tp^.taparm) <> typnods[treal] then
                write(dblcast);
            eexpr(tp^.taparm);
            write(')')
            end;
          dexp:
            begin
            write('exp(');    (* LIB *)
            if typeof(tp^.taparm) <> typnods[treal] then
                write(dblcast);
            eexpr(tp^.taparm);
            write(')')
            end;
          dcos,
          dsin,
          dsqrt:
            begin
            eexpr(tp^.tcall);    (* LIB *)
            write('(');
            if typeof(tp^.taparm) <> typnods[treal] then
                write(dblcast);
            eexpr(tp^.taparm);
            write(')')
            end;
          dtan:
            begin
            write('atan(');        (* LIB *)
            if typeof(tp^.taparm) <> typnods[treal] then
                write(dblcast);
            eexpr(tp^.taparm);
            write(')')
            end;
          dsucc,
          dpred:
            begin
            tq := typeof(tp^.taparm);
            if tq^.tt = nsubrange then
                if tq^.tup^.tt = nconfarr then
                    tq := typeof(tq^.tup^.tindtyp)
                else
                    tq := typeof(tq^.tlo);
            if (tq = typnods[tinteger]) or
                        (tq = typnods[tchar]) then
                begin
                write('((');
                eexpr(tp^.taparm);
                if td = dpred then
                    write(')-1)')
                else
                    write(')+1)')
                end
            else begin
                (* some sort of scalar type, casting needed *)
                write('(');
                tq := tq^.tup;
                if tq^.tt = ntype then
                    begin
                    (* cast only if it is a named type *)
                    write('(');
                    printid(tq^.tidl^.tsym^.lid);
                    write(')')
                    end;
                write('((int)(');
                eexpr(tp^.taparm);
                if td = dpred then
                    write(')-1))')
                else
                    write(')+1))')
                 end
            end;
          dodd:
            begin
            write('(');
            printid(defnams[dboolean]^.lid);
            write(')((');
            eexpr(tp^.taparm);
            write(') & 1)')
            end;
          dsqr:
            begin
            tq := typeof(tp^.taparm);
            if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
                begin
                write('((');
                eexpr(tp^.taparm);
                write(') * (');
                eexpr(tp^.taparm);
                write('))')
                end
            else begin
                write('pow(');    (* LIB *)
                if typeof(tp^.taparm) <> typnods[treal] then
                    write(dblcast);
                eexpr(tp^.taparm);
                write(', 2.0)')
                 end
            end;
          dround:
            begin
            write('Round(');
            eexpr(tp^.taparm);
            write(')')
            end;
          dtrunc:
            begin
            write('Trunc(');
            eexpr(tp^.taparm);
            write(')')
            end;
          dpack:
            begin
            tq := typeof(tp^.taparm);
            tx := typeof(tp^.taparm^.tnext^.tnext);
            write('{    ', registr, inttyp, tab1, '_j, _i = ');
            if not arithexpr(tp^.taparm^.tnext) then
                write('(int)');
            eexpr(tp^.taparm^.tnext);
            if tx^.tt = narray then
                write(' - ', clower(tq^.taindx):1);
            writeln(';');
            indent;
            write('    for (_j = 0; _j < ');
            if tq^.tt = nconfarr then
                begin
                write('(int)(');
                printid(tx^.tcindx^.thi^.tsym^.lid);
                write(')')
                end
            else
                write(crange(tx^.taindx):1);
            writeln('; )');
            indent;
            write(tab1);
            eexpr(tp^.taparm^.tnext^.tnext);
            write('.A[_j++] = ');
            eexpr(tp^.taparm);
            writeln('.A[_i++];');
            indent;
            writeln('}')
            end;
          dunpack:
            begin
            tq := typeof(tp^.taparm);
            tx := typeof(tp^.taparm^.tnext);
            write('{   ', registr, inttyp, tab1, '_j, _i = ');
            if not arithexpr(tp^.taparm^.tnext^.tnext) then
                write('(int)');
            eexpr(tp^.taparm^.tnext^.tnext);
            if tx^.tt <> nconfarr then
                write(' - ', clower(tx^.taindx):1);
            writeln(';');
            indent;
            write('    for (_j = 0; _j < ');
            if tq^.tt = nconfarr then
                begin
                write('(int)(');
                printid(tq^.tcindx^.thi^.tsym^.lid);
                write(')')
                end
            else
                write(crange(tq^.taindx):1);
            writeln('; )');
            indent;
            write(tab1);
            eexpr(tp^.taparm^.tnext);
            write('.A[_i++] = ');
            eexpr(tp^.taparm);
            writeln('.A[_j++];');
            indent;
            writeln('}')
            end;
        end (* case *)
    end;    (* epredef *)

    procedure eaddr(tp : treeptr);

    begin
        write('&');
        if not(tp^.tt in [nid, nselect, nindex, nderef]) then
            error(evarpar);
        eexpr(tp)
    end;

    (*    Emit code for a subroutine call.            *)
    procedure ecall(tp : treeptr);

    var    tf, tq, tx    : treeptr;

    begin
        (* find first formal parameter id *)
        tf := idup(tp^.tcall);
        case tf^.tt of
          nproc,
          nfunc:
            tf := tf^.tsubpar;
          nparproc,
          nparfunc:
            tf := tf^.tparparm
        end;(* case *)
        if tf <> nil then
            begin
            case tf^.tt of
              nvalpar,
              nvarpar:
                tf := tf^.tidl;
              nparproc,
              nparfunc:
                tf := tf^.tparid
            end (* case *)
            end;
        (* emit called function name *)
        eexpr(tp^.tcall);
        write('(');
        (* emit actual parameters *)
        tq := tp^.taparm;
        while tq <> nil do
            begin
            if tf^.tup^.tt in [nparfunc, nparproc] then
                begin
                (* single subroutine-nid converted to ncall *)
                if tq^.tt = ncall then
                    printid(tq^.tcall^.tsym^.lid)
                else
                    printid(tq^.tsym^.lid)
                end
            else begin
                tx := typeof(tq);
                if tx = typnods[tboolean] then
                    begin
                    tx := tq;
                    while tx^.tt = nuplus do
                        tx := tx^.texps;
                    if tx^.tt in [nin .. nor, nand, nnot]
                                    then
                        begin
                        write('(');
                        printid(defnams[dboolean]^.lid);
                        write(')(');
                        eexpr(tq);
                        write(')')
                        end
                    else
                        eexpr(tq);
                    end
                else if (tx = typnods[tstring]) or
                        (tx = typnods[tset]) then
                    begin
                    (* cast literal to proper type *)
                    write('*((');
                    etypedef(tf^.tup^.tbind);
                    write(' *)');
                    if tx = typnods[tset] then
                        begin
                        dropset := true;
                        eexpr(tq);
                        dropset := false
                        end
                    else
                        eexpr(tq);
                    write(')')
                    end
                else if tx = typnods[tnil] then
                    begin
                    write('(');
                    etypedef(tf^.tup^.tbind);
                    write(')NIL')
                    end
                else if tf^.tup^.tbind^.tt = nconfarr then
                    begin
                    write('(struct ');
                    printid(tf^.tup^.tbind^.tcuid);
                    write(' *)&');
                    eexpr(tq);
                    (* add upper bound of actual value *)
                    if tq^.tnext = nil then
                        write(', ',
                            crange(tx^.taindx):1)
                    end
                else begin
                    if tf^.tup^.tt = nvarpar then
                        eaddr(tq)
                    else
                        eexpr(tq)
                     end
                end;
            tq := tq^.tnext;
            if tq <> nil then
                begin
                write(', ');
                (* next formal parameter *)
                if tf^.tnext = nil then
                    begin
                    tf := tf^.tup^.tnext;
                    case tf^.tt of
                      nvalpar,
                      nvarpar:
                        tf := tf^.tidl;
                      nparproc,
                      nparfunc:
                        tf := tf^.tparid
                    end (* case *)
                    end
                else
                    tf := tf^.tnext;
                end;
            end;
        write(')')
    end;    (* ecall *)

    (*    Emit code for a general expression.            *)
    procedure eexpr;

    label    999;

    var    tq    : treeptr;
        flag    : boolean;

        function constset(tp : treeptr) : boolean;

            function constxps(tp : treeptr) : boolean;
            begin
                case tp^.tt of
                  nrange:
                    if constxps(tp^.texpr) then
                        constxps := constxps(tp^.texpl)
                    else
                        constxps := false;
                  nempty,
                  ninteger,
                  nchar:
                    constxps := true;
                  nid:
                    begin
                    tp := idup(tp);
                    constxps := (tp^.tt = nconst)
                            or (tp^.tt = nscalar)
                    end;
                  nin, neq, nne, nlt, nle, ngt, nge, nor,
                  nplus, nminus, nand, nmul, ndiv, nmod,
                  nquot, nnot, numinus, nuplus, nset,
                  nindex, nselect, nderef, ncall,
                  nreal, nstring, nnil:
                    constxps := false
                end (* case *)
            end;

        begin
            constset := true;
            while tp <> nil do
                if constxps(tp) then
                    tp := tp^.tnext
                else begin
                    constset := false;
                    tp := nil
                    end
        end;

    begin    (* eexpr *)
        donearr := false;
        if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then
            begin
            tq := typeof(tp^.texpl);
            if (tq^.tt in [nset, nsetof]) or
                        (tq = typnods[tset]) then
                begin
                (* set operations *)
                case tp^.tt of
                  nplus:
                    begin
                    setused := true;
                    useunion := true;
                    write('Union')
                    end;
                  nminus:
                    begin
                    setused := true;
                    usediff := true;
                    write('Diff')
                    end;
                  nmul:
                    begin
                    setused := true;
                    useintr := true;
                    write('Inter')
                    end;
                  neq:
                    begin
                    useseq := true;
                    write('Eq')
                    end;
                  nne:
                    begin
                    usesne := true;
                    write('Ne')
                    end;
                  nge:
                    begin
                    usesge := true;
                    write('Ge')
                    end;
                  nle:
                    begin
                    usesle := true;
                    write('Le')
                    end
                end;(* case *)
                if tp^.tt in [nplus, nminus, nmul] then
                    dropset := false;
                write('(');
                eexpr(tp^.texpl);
                if tq^.tt = nsetof then
                    write('.S');
                write(', ');
                eexpr(tp^.texpr);
                tq := typeof(tp^.texpr);
                if tq^.tt = nsetof then
                    write('.S');
                write(')');
                goto 999
                end
            end;
        if tp^.tt in [neq, nne, ngt, nlt, nge, nle] then
            begin
            tq := typeof(tp^.texpl);
            if tq^.tt = nconfarr then
                fatal(ecmpconf);
            if (tq^.tt in [nstring, narray]) or
                        (tq = typnods[tstring]) then
                begin
                write('Cmpstr(');
                eexpr(tp^.texpl);
                if tq^.tt = narray then
                    write('.A');
                write(', ');
                tq := typeof(tp^.texpr);
                if tq^.tt = nconfarr then
                    fatal(ecmpconf);
                eexpr(tp^.texpr);
                if tq^.tt = narray then
                    write('.A');
                write(')');
                case tp^.tt of
                  neq:
                    write(' == ');
                  nne:
                    write(' != ');
                  ngt:
                    write(' > ');
                  nlt:
                    write(' < ');
                  nge:
                    write(' >= ');
                  nle:
                    write(' <= ');
                end;(* case *)
                write('0');
                goto 999
                end
            end;
        case tp^.tt of
          neq, nne, nlt, nle,
          ngt, nge, nor, nand, nplus, nminus,
          nmul, ndiv, nmod, nquot:
            begin
            flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
            if (tp^.tt in [nlt, nle, ngt, nge]) and
                    not arithexpr(tp^.texpl) then
                begin
                write('(int)');
                flag := true
                end;
            if flag then
                write('(');
            eexpr(tp^.texpl);
            if flag then
                write(')');
            case tp^.tt of
              neq:
                write(' == ');
              nne:
                write(' != ');
              nlt:
                write(' < ');
              nle:
                write(' <= ');
              ngt:
                write(' > ');
              nge:
                write(' >= ');
              nor:
                write(' || ');
              nand:
                write(' && ');
              nplus:
                write(' + ');
              nminus:
                write(' - ');
              nmul:
                write(' * ');
              ndiv:
                write(' / ');
              nmod:
                write(' % ');
              nquot:
                begin
                write(' / ((');
                printid(defnams[dreal]^.lid);
                write(')')
                end
            end;(* case *)
            flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
            if (tp^.tt in [nlt, nle, ngt, nge]) and
                    not arithexpr(tp^.texpr) then
                begin
                write('(int)');
                flag := true
                end;
            if flag then
                write('(');
            eexpr(tp^.texpr);
            if flag then
                write(')');
            if tp^.tt = nquot then
                write(')')
            end;

          nuplus, numinus, nnot:
            begin
            case tp^.tt of
              numinus:
                write('-');
              nnot:
                write('!');
              nuplus:
            end;(* case *)
            flag := cprio[tp^.tt] >= cprio[tp^.texps^.tt];
            if flag then
                write('(');
            eexpr(tp^.texps);
            if flag then
                write(')');
            end;

          nin:
            begin
            usememb := true;
            write('Member((unsigned)(');
            eexpr(tp^.texpl);
            write('), ');
            dropset := true;    (* no need to save set-expr *)
            eexpr(tp^.texpr);
            dropset := false;
            tq := typeof(tp^.texpr);
            if tq^.tt = nsetof then
                write('.S');
            write(')')
            end;

          nassign:
            begin
            tq := typeof(tp^.trhs);
            if tq = typnods[tstring] then
                begin
                write(voidcast, 'strncpy(');
                eexpr(tp^.tlhs);
                write('.A, ');
                eexpr(tp^.trhs);
                write(', sizeof(');
                eexpr(tp^.tlhs);
                write('.A))')
                end
            else if tq = typnods[tboolean] then
                begin
                eexpr(tp^.tlhs);
                write(' = ');
                tq := tp^.trhs;
                while tq^.tt = nuplus do
                    tq := tq^.texps;
                if tq^.tt in [nin .. nor, nand, nnot] then
                    begin
                    write('(');
                    printid(defnams[dboolean]^.lid);
                    write(')(');
                    eexpr(tq);
                    write(')')
                    end
                else
                    eexpr(tq)
                end
            else if tq = typnods[tnil] then
                begin
                eexpr(tp^.tlhs);
                write(' = (');
                etypedef(typeof(tp^.tlhs));
                write(')NIL')
                end
            else begin
                tq := typeof(tp^.tlhs);
                if tq^.tt = nsetof then
                    begin
                    usescpy := true;
                    write('Setncpy(');
                    eselect(tp^.tlhs);
                    write('S, ');
                    dropset := true;
                    tq := typeof(tp^.trhs);
                    if tq = typnods[tset] then
                        eexpr(tp^.trhs)
                    else begin
                        eselect(tp^.trhs);
                        write('S')
                         end;
                    dropset := false;
                    write(', sizeof(');
                    eselect(tp^.tlhs);
                    write('S))')
                    end
                else begin
                    eexpr(tp^.tlhs);
                    write(' = ');
                    eexpr(tp^.trhs)
                     end
                 end
            end;

          ncall:
            begin
            tq := idup(tp^.tcall);
            if (tq^.tt in [nfunc, nproc]) and
                    (tq^.tsubstmt <> nil) then
                if tq^.tsubstmt^.tt = npredef then
                    epredef(tq, tp)
                else
                    ecall(tp)
            else
                ecall(tp)
            end;

          nselect:
            begin
            eselect(tp^.trecord);
            eexpr(tp^.tfield)
            end;
          nindex:
            begin
            eselect(tp^.tvariable);
            write('A[');
            tq := tp^.toffset;
            if arithexpr(tq) then
                eexpr(tq)
            else begin
                write('(int)(');
                eexpr(tq);
                write(')')
                 end;
            tq := typeof(tp^.tvariable);
            if tq^.tt = narray then
                if clower(tq^.taindx) <> 0 then
                    begin
                    write(' - ');
                    tq := typeof(tq^.taindx);
                    if tq^.tt = nsubrange then
                        if arithexpr(tq^.tlo) then
                            eexpr(tq^.tlo)
                        else begin
                            write('(int)(');
                            eexpr(tq^.tlo);
                            write(')')
                             end
                    else
                        fatal(etree)
                    end;
            write(']')
            end;
          nderef:
            begin
            tq := typeof(tp^.texps);
            if (tq^.tt = nfileof) or
                 ((tq^.tt = npredef) and (tq^.tdef = dtext)) then
                begin
                (* using a file-variable as pointer *)
                eexpr(tp^.texps);
                write('.buf')
                end
            else if doarrow = 0 then
                begin
                write('*');
                eexpr(tp^.texps)
                end
            else begin
                eexpr(tp^.texps);
                write('->');
                donearr := true
                 end
            end;
          nid:
            begin
            (* add pointer-dereference if this id is declared as a
               var-parameter or as a procedure-parameter *)
            tq := idup(tp);
            if tq^.tt = nvarpar then
                begin
                if (doarrow = 0) or
                        (tq^.tattr = areference) then
                    begin
                    write('(*');
                    printid(tp^.tsym^.lid);
                    write(')')
                    end
                else begin
                    printid(tp^.tsym^.lid);
                    write('->');
                    donearr := true
                     end
                end
            else if (tq^.tt = nconst) and conflag then
                write(cvalof(tp):1)
            else if tq^.tt in [nparproc, nparfunc] then
                begin
                write('(*');
                printid(tp^.tsym^.lid);
                write(')')
                end
            else
                printid(tp^.tsym^.lid);
            end;
          nchar:
            printchr(tp^.tsym^.lchar);
          ninteger:
            write(tp^.tsym^.linum:1);
          nreal:
            printtok(tp^.tsym^.lfloat);
          nstring:
            printstr(tp^.tsym^.lstr);
          nset:
            if constset(tp^.texps) then
                begin
                (* save set expression for initialization *)
                write('Conset[', setcnt:1, ']');
                setcnt := setcnt + 1;
                tq := mknode(nset);
                tq^.tnext := setlst;
                setlst := tq;
                tq^.texps := tp^.texps
                end
            else begin
                increment;
                flag := dropset;
                (* if a set-constructor is used in an
                   expression involving + - *  it will need to
                   be saved temporarily (by Saveset) but often
                   we can simply forget the set-value when we
                   have finished using it *)
                if dropset then
                    dropset := false
                else
                    write('Saveset(');
                write('(Tmpset = Newset(), ');
                tq := tp^.texps;
                while tq <> nil do
                    begin
                    case tq^.tt of
                      nrange:
                        begin
                        usemksub := true;
                        write(voidcast, 'Mksubr(');
                        write('(unsigned)(');
                        eexpr(tq^.texpl);
                        write('), ');
                        write('(unsigned)(');
                        eexpr(tq^.texpr);
                        write('), Tmpset)')
                        end;
                      nin, neq, nne, nlt, nle, ngt, nge,
                      nor, nand, nmul, ndiv, nmod, nquot,
                      nplus, nminus, nnot, numinus, nuplus,
                      nindex, nselect, nderef, ncall,
                      ninteger, nchar, nid:
                        begin
                        useins := true;
                        write(voidcast, 'Insmem(');
                        write('(unsigned)(');
                        eexpr(tq);
                        write('), Tmpset)')
                        end
                    end;(* case *)
                    tq := tq^.tnext;
                    if tq <> nil then
                        begin
                        writeln(',');
                        indent
                        end
                    end;
                write(', Tmpset)');
                if not flag then
                    begin
                    write(')');
                    setused := true
                    end;
                decrement
                 end;
          nnil:
            begin
            tq := tp;
            repeat
                tq := tq^.tup
            until    tq^.tt in [neq, nne, ncall, nassign, npgm];
            if tq^.tt in [neq, nne] then
                begin
                if typeof(tq^.texpl) = typnods[tnil] then
                    tq := typeof(tq^.texpr)
                else
                    tq := typeof(tq^.texpl);
                if tq^.tt = nptr then
                    begin
                    write('(');
                    etypedef(tq);
                    write(')')
                    end
                end;
            write('NIL')
            end;
        end;(* case *)
    999:
    end;    (* eexpr *)

    (*    Emit constant definitions.                *)
    procedure econst(tp : treeptr);

    var    sp    : symptr;

    begin
        while tp <> nil do
            begin
            sp := tp^.tidl^.tsym;
            if sp^.lid^.inref > 1 then
                sp^.lid := mkrename('X', sp^.lid);
            if tp^.tbind^.tt = nstring then
                begin
                (* string constants emitted as
                   static local variables *)
                indent;
                write(static, chartyp, tab1);
                printid(sp^.lid);
                write('[]    = ');
                eexpr(tp^.tbind);
                writeln(';')
                end
            else begin
                (* all other constants emitted as
                   preprocessor # defines *)
                write(define);
                printid(sp^.lid);
                write(space);
                eexpr(tp^.tbind);
                writeln
                end;
            tp := tp^.tnext
            end
    end;    (* econst *)

    (*    Emit a typedef.                        *)
    procedure etypedef;

        (*    Workhorse for etypedef, this procedure also    *)
        (*    renames all fields in record-unions when    *)
        (*    necessary.                    *)
        procedure etdef(uid : idptr; tp : treeptr);

        var    i    : integer;
            tq    : treeptr;

            (*    Emit definition for an integer subrange    *)
            (*    using data from worddefs set up during    *)
            (*    initialization.                *)
            procedure etrange(tp : treeptr);

            label    999;

            var    lo, hi    : integer;
                i    : 1 .. maxmachdefs;

            begin
                lo := clower(tp);
                hi := cupper(tp);
                (* scan CPU word definitions for a type
                   enclosing wanted range *)
                for i := 1 to nmachdefs do
                    with machdefs[i] do
                    if (lo >= lolim) and (hi <= hilim) then
                        begin
                        (* found it, print type name *)
                        printtok(typstr);
                        goto 999
                        end;
                fatal(erange);
            999:
            end;

            (*    Print last component of identifier.    *)
            procedure printsuf(ip : idptr);

            var    w    : toknbuf;
                i, j    : toknidx;

            begin
                gettokn(ip^.istr, w);
                i := 1;
                j := i;
                while w[i] <> chr(null) do
                    begin
                    if w[i] = '.' then
                        j := i;
                    i := i + 1
                    end;
                if w[j] = '.' then
                    j := j + 1;
                while w[j] <> chr(null) do
                    begin
                    write(w[j]);
                    j := j + 1
                    end
            end;

        begin    (* etdef *)
            case tp^.tt of
              nid:
                printid(tp^.tsym^.lid);
              nptr:
                begin
                tq := typeof(tp^.tptrid);
                if tq^.tt = nrecord then
                    begin
                    write('struct ');
                    printid(tq^.tuid)
                    end
                else
                    printid(tp^.tptrid^.tsym^.lid);
                write(' *');
                end;
              nscalar:
                begin
                write('enum { ');
                increment;
                tp := tp^.tscalid;

                (* avoid bug in C-compiler:
                       enums are mixed in same namespace *)
                if tp^.tsym^.lid^.inref > 1 then
                    tp^.tsym^.lid :=
                        mkrename('E', tp^.tsym^.lid);
                printid(tp^.tsym^.lid);
                i := 1;
                while tp^.tnext <> nil do
                    begin
                    if i >= 4 then
                        begin
                        writeln(',');
                        indent;
                        i := 1
                        end
                    else begin
                        write(', ');
                        i := i + 1
                         end;
                    tp := tp^.tnext;
                    if tp^.tsym^.lid^.inref > 1 then
                        tp^.tsym^.lid :=
                        mkrename('E', tp^.tsym^.lid);
                    printid(tp^.tsym^.lid)
                    end;
                decrement;
                write(' } ')
                end;
              nsubrange:
                begin
                tq := typeof(tp^.tlo);
                if tq = typnods[tinteger] then
                    etrange(tp)
                else begin
                    if tq^.tup^.tt = ntype then
                        tq := tq^.tup^.tidl;
                    etdef(nil, tq)
                     end
                end;
              nfield:
                begin
                etdef(nil, tp^.tbind);
                write(tab1);
                tp := tp^.tidl;
                if uid <> nil then
                    tp^.tsym^.lid :=
                        mkconc('.', uid, tp^.tsym^.lid);
                printsuf(tp^.tsym^.lid);
                i := 1;
                while tp^.tnext <> nil do
                    begin
                    if i >= 4 then
                        begin
                        writeln(',');
                        indent;
                        write(tab1);
                        i := 1
                        end
                    else begin
                        write(', ');
                        i := i + 1
                         end;
                    tp := tp^.tnext;
                    if uid <> nil then
                        tp^.tsym^.lid :=
                        mkconc('.', uid, tp^.tsym^.lid);
                    printsuf(tp^.tsym^.lid);
                    end;
                writeln(';');
                end;
              nrecord:
                begin
                write('struct ');
                if tp^.tuid = nil then
                    tp^.tuid := uid
                else if uid = nil then
                    printid(tp^.tuid);
                writeln(' {');
                increment;
                if (tp^.tflist = nil) and
                            (tp^.tvlist = nil) then
                    begin
                    (* C doesn't allow empty structures *)
                    indent;
                    writeln(inttyp, tab1, 'dummy;')
                    end;
                tq := tp^.tflist;
                while tq <> nil do
                    begin
                    indent;
                    etdef(uid, tq);
                    tq := tq^.tnext
                    end;
                if tp^.tvlist <> nil then
                    begin
                    indent;
                    writeln('union {');
                    increment;
                    tq := tp^.tvlist;
                    while tq <> nil do
                        begin
                        if (tq^.tvrnt^.tflist <> nil) or
                         (tq^.tvrnt^.tvlist <> nil) then
                            begin
                            indent;
                            if uid = nil then
                                etdef(mkvrnt,
                                tq^.tvrnt)
                            else
                                etdef(mkconc('.',
                                   uid, mkvrnt),
                                tq^.tvrnt);
                            writeln(';')
                            end;
                        tq := tq^.tnext
                        end;
                    decrement;
                    indent;
                    writeln('} U;');
                    end;
                decrement;
                indent;
                if tp^.tup^.tt = nvariant then
                    begin
                    write('} ');
                    printsuf(tp^.tuid)
                    end
                else
                    write('}');
                end;
              nconfarr:
                begin
                write('struct ');
                printid(tp^.tcuid);
                write(' { ');
                etdef(nil, tp^.tcelem);
                write(tab1, 'A[]; }')
                end;
              narray:
                begin
                write('struct { ');
                etdef(nil, tp^.taelem);
                write(tab1, 'A[');
                tq := typeof(tp^.taindx);
                if tq^.tt = nsubrange then
                    begin
                    if arithexpr(tq^.thi) then
                        begin
                        eexpr(tq^.thi);
                        if cvalof(tq^.tlo) <> 0 then
                            begin
                            write(' - ');
                            eexpr(tq^.tlo)
                            end
                        end
                    else begin
                        write('(int)(');
                        eexpr(tq^.thi);
                        if cvalof(tq^.tlo) <> 0 then
                            begin
                            write(') - (int)(');
                            eexpr(tq^.tlo)
                            end;
                        write(')')
                         end;
                    write(' + 1')
                    end
                else
                    write(crange(tp^.taindx):1);
                write(']; }')
                end;
              nfileof:
                begin
                writeln('struct {');
                indent;
                writeln(tab1, 'FILE', tab1, '*fp;');
                indent;
                writeln(tab1, filebits, tab1, 'eoln:1,');
                indent;
                writeln(tab3, 'eof:1,');
                indent;
                writeln(tab3, 'out:1,');
                indent;
                writeln(tab3, 'init:1,');
                indent;
                writeln(tab3, ':', filefill:1, ';');
                indent;
                write(tab1);
                etdef(nil, tp^.tof);
                writeln(tab1, 'buf;');
                indent;
                write('} ')
                end;
              nsetof:
                write('struct { ', setwtyp, tab1, 'S[',
                            csetsize(tp):1, ']; }');
              npredef:
                begin
                case tp^.tobtyp of
                  tboolean:
                    printid(defnams[dboolean]^.lid);
                  tchar:
                    write(chartyp);
                  tinteger:
                    printid(defnams[dinteger]^.lid);
                  treal:
                    printid(defnams[dreal]^.lid);
                  tstring:
                    write(chartyp, ' *');
                  ttext:
                    write('text');
                  tnil,
                  tset,
                  terror:
                    fatal(etree);
                  tnone:
                    write(voidtyp);
                end (* case *)
                end;
              nempty:
                write(voidtyp);
            end;(* case *)
        end;    (* etdef *)
    begin
        etdef(nil, tp)
    end;    (* etypedef *)

    (*    Emit code for type declarations.            *)
    procedure etype(tp : treeptr);

    var    sp    : symptr;

    begin
        while tp <> nil do
            begin
            (* if identifier used more than once we rename the type
               to avoid typedef'ing an identifier twice *)
            sp := tp^.tidl^.tsym;
            if sp^.lid^.inref > 1 then
                sp^.lid := mkrename('Y', sp^.lid);
            indent;
            write(typdef);
            etypedef(tp^.tbind);
            write(tab1);
            printid(sp^.lid);
            writeln(';');
            tp := tp^.tnext
            end
    end;

    (*    Emit code for variable declarations.            *)
    procedure evar(tp : treeptr);

    label    555;

    var    tq    : treeptr;
        i    : integer;

    begin
        while tp <> nil do
            begin
            indent;
            case tp^.tt of
              nvar,
              nvalpar,
              nvarpar:
                begin
                if tp^.tattr = aregister then
                    write(registr);
                etypedef(tp^.tbind)
                end;
              nparproc,
              nparfunc:
                begin
                if tp^.tt = nparproc then
                    write(voidtyp)
                else
                    etypedef(tp^.tpartyp);
                tq := tp^.tparid;
                write(tab1, '(*');
                printid(tq^.tsym^.lid);
                write(')()');
                goto 555
                end
            end;(* case *)
            write(tab1);
            tq := tp^.tidl;
            i := 1;
            repeat
                if tp^.tt = nvarpar then
                    write('*');
                printid(tq^.tsym^.lid);
                tq := tq^.tnext;
                if tq <> nil then
                    begin
                    if i >= 6 then
                        begin
                        i := 1;
                        writeln(',');
                        indent;
                        write(tab1)
                        end
                    else begin
                        i := i + 1;
                        write(', ')
                         end