Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Applications/P4⁄Mac 1.0/Mac source/block.p

Text File | 1994-07-28 | 74.6 KB | 3,116 lines | [TEXT/PJMM]

unit block;

interface
    uses
        pcom1, block1;

{De flesta subprocedurer till block är utbrytna, och block lägger upp sina parametrar globalt.}
{TYVÄRR duger inte detta, ty BLOCK ÄR REKURSIV!!!}
    procedure block (fsys: setofsys; fsy: symbol; fprocp: ctp);

implementation

    procedure block (fsys: setofsys; fsy: symbol; fprocp: ctp);

        procedure procdeclaration (fsy: symbol);
            var
                oldlev: 0..maxlevel;
                lcp, lcp1: ctp;
                lsp: stp;
                forw: boolean;
                oldtop: disprange;
                llc, lcm: addrrange;
                lbname: integer;
                markp: marktype;

            procedure parameterlist (fsy: setofsys; var fpar: ctp);
                var
                    lcp, lcp1, lcp2, lcp3: ctp;
                    lsp: stp;
                    lkind: idkind;
                    llc, lsize: addrrange;
                    count: integer;
            begin
                lcp1 := nil;
                if not (sy in fsy + [lparent]) then
                    begin
                        error(7);
                        skip(fsys + fsy + [lparent])
                    end;
                if sy = lparent then
                    begin
                        if forw then
                            error(119);
                        insymbol;
                        if not (sy in [ident, varsy, procsy, funcsy]) then
                            begin
                                error(7);
                                skip(fsys + [ident, rparent])
                            end;
                        while sy in [ident, varsy, procsy, funcsy] do
                            begin
                                if sy = procsy then
                                    begin
                                        error(399);
                                        repeat
                                            insymbol;
                                            if sy = ident then
                                                begin
                                                    new(lcp, proc, declared, formal);
                                                    with lcp^ do
                                                        begin
                                                            name := id;
                                                            idtype := nil;
                                                            next := lcp1;
                                                            pflev := level; (*beware of parameter procedures*)
                                                            klass := proc;
                                                            pfdeckind := declared;
                                                            pfkind := formal
                                                        end;
                                                    enterid(lcp);
                                                    lcp1 := lcp;
                                                    align(parmptr, lc);
              (*lc := lc + some size *)
                                                    insymbol
                                                end
                                            else
                                                error(2);
                                            if not (sy in fsys + [comma, semicolon, rparent]) then
                                                begin
                                                    error(7);
                                                    skip(fsys + [comma, semicolon, rparent])
                                                end
                                        until sy <> comma
                                    end
                                else
                                    begin
                                        if sy = funcsy then
                                            begin
                                                error(399);
                                                lcp2 := nil;
                                                repeat
                                                    insymbol;
                                                    if sy = ident then
                                                        begin
                                                            new(lcp, func, declared, formal);
                                                            with lcp^ do
                                                                begin
                                                                    name := id;
                                                                    idtype := nil;
                                                                    next := lcp2;
                                                                    pflev := level; (*beware param funcs*)
                                                                    klass := func;
                                                                    pfdeckind := declared;
                                                                    pfkind := formal
                                                                end;
                                                            enterid(lcp);
                                                            lcp2 := lcp;
                                                            align(parmptr, lc);
                 (*lc := lc + some size*)
                                                            insymbol;
                                                        end;
                                                    if not (sy in [comma, colon] + fsys) then
                                                        begin
                                                            error(7);
                                                            skip(fsys + [comma, semicolon, rparent])
                                                        end
                                                until sy <> comma;
                                                if sy = colon then
                                                    begin
                                                        insymbol;
                                                        if sy = ident then
                                                            begin
                                                                searchid([types], lcp);
                                                                lsp := lcp^.idtype;
                                                                if lsp <> nil then
                                                                    if not (lsp^.form in [scalar, subrange, pointer]) then
                                                                        begin
                                                                            error(120);
                                                                            lsp := nil
                                                                        end;
                                                                lcp3 := lcp2;
                                                                while lcp2 <> nil do
                                                                    begin
                                                                        lcp2^.idtype := lsp;
                                                                        lcp := lcp2;
                                                                        lcp2 := lcp2^.next
                                                                    end;
                                                                lcp^.next := lcp1;
                                                                lcp1 := lcp3;
                                                                insymbol
                                                            end
                                                        else
                                                            error(2);
                                                        if not (sy in fsys + [semicolon, rparent]) then
                                                            begin
                                                                error(7);
                                                                skip(fsys + [semicolon, rparent])
                                                            end
                                                    end
                                                else
                                                    error(5)
                                            end
                                        else
                                            begin
                                                if sy = varsy then
                                                    begin
                                                        lkind := formal;
                                                        insymbol
                                                    end
                                                else
                                                    lkind := actual;
                                                lcp2 := nil;
                                                count := 0;
                                                repeat
                                                    if sy = ident then
                                                        begin
                                                            new(lcp, vars);
                                                            with lcp^ do
                                                                begin
                                                                    name := id;
                                                                    idtype := nil;
                                                                    klass := vars;
                                                                    vkind := lkind;
                                                                    next := lcp2;
                                                                    vlev := level;
                                                                end;
                                                            enterid(lcp);
                                                            lcp2 := lcp;
                                                            count := count + 1;
                                                            insymbol;
                                                        end;
                                                    if not (sy in [comma, colon] + fsys) then
                                                        begin
                                                            error(7);
                                                            skip(fsys + [comma, semicolon, rparent])
                                                        end;
                                                    test := sy <> comma;
                                                    if not test then
                                                        insymbol
                                                until test;
                                                if sy = colon then
                                                    begin
                                                        insymbol;
                                                        if sy = ident then
                                                            begin
                                                                searchid([types], lcp);
                                                                lsp := lcp^.idtype;
                                                                lsize := ptrsize;
                                                                if lsp <> nil then
                                                                    if lkind = actual then
                                                                        if lsp^.form <= power then
                                                                            lsize := lsp^.size
                                                                        else if lsp^.form = files then
                                                                            error(121);
                                                                align(parmptr, lsize);
                                                                lcp3 := lcp2;
                                                                align(parmptr, lc);
                                                                lc := lc + count * lsize;
                                                                llc := lc;
                                                                while lcp2 <> nil do
                                                                    begin
                                                                        lcp := lcp2;
                                                                        with lcp2^ do
                                                                            begin
                                                                                idtype := lsp;
                                                                                llc := llc - lsize;
                                                                                vaddr := llc;
                                                                            end;
                                                                        lcp2 := lcp2^.next
                                                                    end;
                                                                lcp^.next := lcp1;
                                                                lcp1 := lcp3;
                                                                insymbol
                                                            end
                                                        else
                                                            error(2);
                                                        if not (sy in fsys + [semicolon, rparent]) then
                                                            begin
                                                                error(7);
                                                                skip(fsys + [semicolon, rparent])
                                                            end
                                                    end
                                                else
                                                    error(5);
                                            end;
                                    end;
                                if sy = semicolon then
                                    begin
                                        insymbol;
                                        if not (sy in fsys + [ident, varsy, procsy, funcsy]) then
                                            begin
                                                error(7);
                                                skip(fsys + [ident, rparent])
                                            end
                                    end
                            end; (*while*)
                        if sy = rparent then
                            begin
                                insymbol;
                                if not (sy in fsy + fsys) then
                                    begin
                                        error(6);
                                        skip(fsy + fsys)
                                    end
                            end
                        else
                            error(4);
                        lcp3 := nil;
        (*reverse pointers and reserve local cells for copies of multiple}
{         values*)
                        while lcp1 <> nil do
                            with lcp1^ do
                                begin
                                    lcp2 := next;
                                    next := lcp3;
                                    if klass = vars then
                                        if idtype <> nil then
                                            if (vkind = actual) and (idtype^.form > power) then
                                                begin
                                                    align(idtype, lc);
                                                    vaddr := lc;
                                                    lc := lc + idtype^.size;
                                                end;
                                    lcp3 := lcp1;
                                    lcp1 := lcp2
                                end;
                        fpar := lcp3
                    end
                else
                    fpar := nil
            end; (*parameterlist*)

        begin (*procdeclaration*)
            llc := lc;
            lc := lcaftermarkstack;
            forw := false;
            if sy = ident then
                begin
                    searchsection(display[top].fname, lcp); (*decide whether forw.*)
                    if lcp <> nil then
                        begin
                            if lcp^.klass = proc then
                                forw := lcp^.forwdecl and (fsy = procsy) and (lcp^.pfkind = actual)
                            else if lcp^.klass = func then
                                forw := lcp^.forwdecl and (fsy = funcsy) and (lcp^.pfkind = actual)
                            else
                                forw := false;
                            if not forw then
                                error(160)
                        end;
                    if not forw then
                        begin
                            if fsy = procsy then
                                new(lcp, proc, declared, actual)
                            else
                                new(lcp, func, declared, actual);
                            with lcp^ do
                                begin
                                    name := id;
                                    idtype := nil;
                                    externl := false;
                                    pflev := level;
                                    genlabel(lbname);
                                    pfdeckind := declared;
                                    pfkind := actual;
                                    pfname := lbname;
                                    if fsy = procsy then
                                        klass := proc
                                    else
                                        klass := func
                                end;
                            enterid(lcp)
                        end
                    else
                        begin
                            lcp1 := lcp^.next;
                            while lcp1 <> nil do
                                begin
                                    with lcp1^ do
                                        if klass = vars then
                                            if idtype <> nil then
                                                begin
                                                    lcm := vaddr + idtype^.size;
                                                    if lcm > lc then
                                                        lc := lcm
                                                end;
                                    lcp1 := lcp1^.next
                                end
                        end;
                    insymbol
                end
            else
                begin
                    error(2);
                    lcp := ufctptr
                end;
            oldlev := level;
            oldtop := top;
            if level < maxlevel then
                level := level + 1
            else
                error(251);
            if top < displimit then
                begin
                    top := top + 1;
                    with display[top] do
                        begin
                            if forw then
                                fname := lcp^.next
                            else
                                fname := nil;
                            flabel := nil;
                            occur := blck
                        end
                end
            else
                error(250);
            if fsy = procsy then
                begin
                    parameterlist([semicolon], lcp1);
                    if not forw then
                        lcp^.next := lcp1
                end
            else
                begin
                    parameterlist([semicolon, colon], lcp1);
                    if not forw then
                        lcp^.next := lcp1;
                    if sy = colon then
                        begin
                            insymbol;
                            if sy = ident then
                                begin
                                    if forw then
                                        error(122);
                                    searchid([types], lcp1);
                                    lsp := lcp1^.idtype;
                                    lcp^.idtype := lsp;
                                    if lsp <> nil then
                                        if not (lsp^.form in [scalar, subrange, pointer]) then
                                            begin
                                                error(120);
                                                lcp^.idtype := nil
                                            end;
                                    insymbol
                                end
                            else
                                begin
                                    error(2);
                                    skip(fsys + [semicolon])
                                end
                        end
                    else if not forw then
                        error(123)
                end;
            if sy = semicolon then
                insymbol
            else
                error(14);
            if sy = forwardsy then
                begin
                    if forw then
                        error(161)
                    else
                        lcp^.forwdecl := true;
                    insymbol;
                    if sy = semicolon then
                        insymbol
                    else
                        error(14);
                    if not (sy in fsys) then
                        begin
                            error(6);
                            skip(fsys)
                        end
                end
            else
                begin
                    lcp^.forwdecl := false;
                    mark(markp);
                    repeat
                        block(fsys, semicolon, lcp);
                        if sy = semicolon then
                            begin
                                if prtables then
                                    printtables(false);
                                insymbol;
                                if not (sy in [beginsy, procsy, funcsy]) then
                                    begin
                                        error(6);
                                        skip(fsys)
                                    end
                            end
                        else
                            error(14)
                    until (sy in [beginsy, procsy, funcsy]) or eof(input);
                    release(markp); (* return local entries on runtime heap *)
                end;
            level := oldlev;
            top := oldtop;
            lc := llc;
        end; (*procdeclaration*)

        procedure body (fsys: setofsys);
            const
                cstoccmax = 65;
                cixmax = 1000;
            type
                oprange = 0..63;
            var
                llcp: ctp;
                saveid: alpha;
                cstptr: array[1..cstoccmax] of csp;
                cstptrix: 0..cstoccmax;
      (*allows referencing of noninteger constants by an index}
{       (instead of a pointer), which can be stored in the p2-field}
{       of the instruction record until writeout.}
{       --> procedure load, procedure writeout*)
                entname, segsize: integer;
                stacktop, topnew, topmax: integer;
                lcmax, llc1: addrrange;
                lcp: ctp;
                llp: lbp;


            procedure mes (i: integer);
            begin
                topnew := topnew + cdx[i] * maxstack;
                if topnew > topmax then
                    topmax := topnew
            end;

            procedure putic;
            begin
                if ic mod 10 = 0 then
                    writeln(prr, 'i', ic : 5)
            end;

            procedure gen0 (fop: oprange);
            begin
                if prcode then
                    begin
                        putic;
                        writeln(prr, mn[fop] : 4)
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*gen0*)

            procedure gen1 (fop: oprange; fp2: integer);
                var
                    k: integer;
            begin
                if prcode then
                    begin
                        putic;
                        write(prr, mn[fop] : 4);
                        if fop = 30 then
                            begin
                                writeln(prr, sna[fp2] : 12);
                                topnew := topnew + pdx[fp2] * maxstack;
                                if topnew > topmax then
                                    topmax := topnew
                            end
                        else
                            begin
                                if fop = 38 then
                                    begin
                                        write(prr, '''');
                                        with cstptr[fp2]^ do
                                            begin
                                                for k := 1 to slgth do
                                                    write(prr, sval[k] : 1);
                                                for k := slgth + 1 to strglgth do
                                                    write(prr, ' ');
                                            end;
                                        writeln(prr, '''')
                                    end
                                else if fop = 42 then
                                    writeln(prr, chr(fp2))
                                else
                                    writeln(prr, fp2 : 12);
                                mes(fop)
                            end
                    end;
                ic := ic + 1
            end; (*gen1*)

            procedure gen2 (fop: oprange; fp1, fp2: integer);
                var
                    k: integer;
            begin
                if prcode then
                    begin
                        putic;
                        write(prr, mn[fop] : 4);
                        case fop of
                            45, 50, 54, 56:
                                writeln(prr, ' ', fp1 : 3, fp2 : 8);
                            47, 48, 49, 52, 53, 55:
                                begin
                                    write(prr, chr(fp1));
                                    if chr(fp1) = 'm' then
                                        write(prr, fp2 : 11);
                                    writeln(prr)
                                end;
                            51:
                                case fp1 of
                                    1:
                                        writeln(prr, 'i ', fp2);
                                    2:
                                        begin
                                            write(prr, 'r ');
                                            with cstptr[fp2]^ do
                                                for k := 1 to strglgth do
                                                    write(prr, rval[k]);
                                            writeln(prr)
                                        end;
                                    3:
                                        writeln(prr, 'b ', fp2);
                                    4:
                                        writeln(prr, 'n');
                                    6:
                                        writeln(prr, 'c ''' : 3, chr(fp2), '''');
                                    5:
                                        begin
                                            write(prr, '(');
                                            with cstptr[fp2]^ do
                                                for k := setlow to sethigh do
                                                    if k in pval then
                                                        write(prr, k : 3);
                                            writeln(prr, ')')
                                        end
                                end
                        end;
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*gen2*)

            procedure gentypindicator (fsp: stp);
            begin
                if fsp <> nil then
                    with fsp^ do
                        case form of
                            scalar:
                                if fsp = intptr then
                                    write(prr, 'i')
                                else if fsp = boolptr then
                                    write(prr, 'b')
                                else if fsp = charptr then
                                    write(prr, 'c')
                                else if scalkind = declared then
                                    write(prr, 'i')
                                else
                                    write(prr, 'r');
                            subrange:
                                gentypindicator(rangetype);
                            pointer:
                                write(prr, 'a');
                            power:
                                write(prr, 's');
                            records, arrays:
                                write(prr, 'm');
                            files, tagfld, variant:
                                error(500)
                        end
            end; (*typindicator*)

            procedure gen0t (fop: oprange; fsp: stp);
            begin
                if prcode then
                    begin
                        putic;
                        write(prr, mn[fop] : 4);
                        gentypindicator(fsp);
                        writeln(prr);
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*gen0t*)

            procedure gen1t (fop: oprange; fp2: integer; fsp: stp);
            begin
                if prcode then
                    begin
                        putic;
                        write(prr, mn[fop] : 4);
                        gentypindicator(fsp);
                        writeln(prr, fp2 : 11)
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*gen1t*)

            procedure gen2t (fop: oprange; fp1, fp2: integer; fsp: stp);
            begin
                if prcode then
                    begin
                        putic;
                        write(prr, mn[fop] : 4);
                        gentypindicator(fsp);
                        writeln(prr, fp1 : 3 + 5 * ord(abs(fp1) > 99), fp2 : 8);
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*gen2t*)

            procedure load;
            begin
                with gattr do
                    if typtr <> nil then
                        begin
                            case kind of
                                cst:
                                    if (typtr^.form = scalar) and (typtr <> realptr) then
                                        if typtr = boolptr then
                                            gen2(51, 3, cval.ival)(*ldc*)
                                        else if typtr = charptr then
                                            gen2(51, 6, cval.ival)(*ldc*)
                                        else
                                            gen2(51, 1, cval.ival)(*ldc*)
                                    else if typtr = nilptr then
                                        gen2(51, 4, 0)(*ldc*)
                                    else if cstptrix >= cstoccmax then
                                        error(254)
                                    else
                                        begin
                                            cstptrix := cstptrix + 1;
                                            cstptr[cstptrix] := cval.valp;
                                            if typtr = realptr then
                                                gen2(51, 2, cstptrix)(*ldc*)
                                            else
                                                gen2(51, 5, cstptrix)(*ldc*)
                                        end;
                                varbl:
                                    case access of
                                        drct:
                                            if vlevel <= 1 then
                                                gen1t(39, dplmt, typtr)(*ldo*)
                                            else
                                                gen2t(54, level - vlevel, dplmt, typtr);(*lod*)
                                        indrct:
                                            gen1t(35, idplmt, typtr);(*ind*)
                                        inxd:
                                            error(400)
                                    end;
                                expr:
                            end;
                            kind := expr
                        end
            end; (*load*)

            procedure store (var fattr: attr);
            begin
                with fattr do
                    if typtr <> nil then
                        case access of
                            drct:
                                if vlevel <= 1 then
                                    gen1t(43, dplmt, typtr)(*sro*)
                                else
                                    gen2t(56, level - vlevel, dplmt, typtr);(*str*)
                            indrct:
                                if idplmt <> 0 then
                                    error(400)
                                else
                                    gen0t(26, typtr);(*sto*)
                            inxd:
                                error(400)
                        end
            end; (*store*)

            procedure loadaddress;
            begin
                with gattr do
                    if typtr <> nil then
                        begin
                            case kind of
                                cst:
                                    if isString(typtr) then
                                        if cstptrix >= cstoccmax then
                                            error(254)
                                        else
                                            begin
                                                cstptrix := cstptrix + 1;
                                                cstptr[cstptrix] := cval.valp;
                                                gen1(38, cstptrix)(*lca*)
                                            end
                                    else
                                        error(400);
                                varbl:
                                    case access of
                                        drct:
                                            if vlevel <= 1 then
                                                gen1(37, dplmt)(*lao*)
                                            else
                                                gen2(50, level - vlevel, dplmt);(*lda*)
                                        indrct:
                                            if idplmt <> 0 then
                                                gen1t(34, idplmt, nilptr);(*inc*)
                                        inxd:
                                            error(400)
                                    end;
                                expr:
                                    error(400)
                            end;
                            kind := varbl;
                            access := indrct;
                            idplmt := 0
                        end
            end; (*loadaddress*)


            procedure genfjp (faddr: integer);
            begin
                load;
                if gattr.typtr <> nil then
                    if gattr.typtr <> boolptr then
                        error(144);
                if prcode then
                    begin
                        putic;
                        writeln(prr, mn[33] : 4, ' l' : 8, faddr : 4)
                    end;
                ic := ic + 1;
                mes(33)
            end; (*genfjp*)

            procedure genujpxjp (fop: oprange; fp2: integer);
            begin
                if prcode then
                    begin
                        putic;
                        writeln(prr, mn[fop] : 4, ' l' : 8, fp2 : 4)
                    end;
                ic := ic + 1;
                mes(fop)
            end; (*genujpxjp*)


            procedure gencupent (fop: oprange; fp1, fp2: integer);
            begin
                if prcode then
                    begin
                        putic;
                        writeln(prr, mn[fop] : 4, fp1 : 4, 'l' : 4, fp2 : 4)
                    end;
                ic := ic + 1;
                mes(fop)
            end;


            procedure checkbnds (fsp: stp);
                var
                    lmin, lmax: integer;
            begin
                if fsp <> nil then
                    if fsp <> intptr then
                        if fsp <> realptr then
                            if fsp^.form <= subrange then
                                begin
                                    getbounds(fsp, lmin, lmax);
                                    gen2t(45, lmin, lmax, fsp)(*chk*)
                                end
            end; (*checkbnds*)


            procedure putlabel (labname: integer);
            begin
                if prcode then
                    writeln(prr, 'l', labname : 4)
            end; (*putlabel*)

            procedure statement (fsys: setofsys);
                label
                    1;
                var
                    lcp: ctp;
                    llp: lbp;

                procedure expression (fsys: setofsys);
                forward;

                procedure selector (fsys: setofsys; fcp: ctp);
                    var
                        lattr: attr;
                        lcp: ctp;
                        lsize: addrrange;
                        lmin, lmax: integer;
                begin
                    with fcp^, gattr do
                        begin
                            typtr := idtype;
                            kind := varbl;
                            case klass of
                                vars:
                                    if vkind = actual then
                                        begin
                                            access := drct;
                                            vlevel := vlev;
                                            dplmt := vaddr
                                        end
                                    else
                                        begin
                                            gen2t(54, level - vlev, vaddr, nilptr);(*lod*)
                                            access := indrct;
                                            idplmt := 0
                                        end;
                                field:
                                    with display[disx] do
                                        if occur = crec then
                                            begin
                                                access := drct;
                                                vlevel := clev;
                                                dplmt := cdspl + fldaddr
                                            end
                                        else
                                            begin
                                                if level = 1 then
                                                    gen1t(39, vdspl, nilptr)(*ldo*)
                                                else
                                                    gen2t(54, 0, vdspl, nilptr);(*lod*)
                                                access := indrct;
                                                idplmt := fldaddr
                                            end;
                                func:
                                    if pfdeckind = standard then
                                        begin
                                            error(150);
                                            typtr := nil
                                        end
                                    else
                                        begin
                                            if pfkind = formal then
                                                error(151)
                                            else if (pflev + 1 <> level) or (fprocp <> fcp) then
                                                error(177);
                                            begin
                                                access := drct;
                                                vlevel := pflev + 1;
                                                dplmt := 0   (*impl. relat. addr. of fct. result*)
                                            end
                                        end
                            end (*case*)
                        end; (*with*)
                    if not (sy in selectsys + fsys) then
                        begin
                            error(59);
                            skip(selectsys + fsys)
                        end;
                    while sy in selectsys do
                        begin
    (*[*)
                            if sy = lbrack then
                                begin
                                    repeat
                                        lattr := gattr;
                                        with lattr do
                                            if typtr <> nil then
                                                if typtr^.form <> arrays then
                                                    begin
                                                        error(138);
                                                        typtr := nil
                                                    end;
                                        loadaddress;
                                        insymbol;
                                        expression(fsys + [comma, rbrack]);
                                        load;
                                        if gattr.typtr <> nil then
                                            if gattr.typtr^.form <> scalar then
                                                error(113)
                                            else if not comptypes(gattr.typtr, intptr) then
                                                gen0t(58, gattr.typtr);(*ord*)
                                        if lattr.typtr <> nil then
                                            with lattr.typtr^ do
                                                begin
                                                    if comptypes(inxtype, gattr.typtr) then
                                                        begin
                                                            if inxtype <> nil then
                                                                begin
                                                                    getbounds(inxtype, lmin, lmax);
                                                                    if debug then
                                                                        gen2t(45, lmin, lmax, intptr);(*chk*)
                                                                    if lmin > 0 then
                                                                        gen1t(31, lmin, intptr)(*dec*)
                                                                    else if lmin < 0 then
                                                                        gen1t(34, -lmin, intptr);(*inc*)
                  (*or simply gen1(31,lmin)*)
                                                                end
                                                        end
                                                    else
                                                        error(139);
                                                    with gattr do
                                                        begin
                                                            typtr := aeltype;
                                                            kind := varbl;
                                                            access := indrct;
                                                            idplmt := 0
                                                        end;
                                                    if gattr.typtr <> nil then
                                                        begin
                                                            lsize := gattr.typtr^.size;
                                                            align(gattr.typtr, lsize);
                                                            gen1(36, lsize)(*ixa*)
                                                        end
                                                end
                                    until sy <> comma;
                                    if sy = rbrack then
                                        insymbol
                                    else
                                        error(12)
                                end (*if sy = lbrack*)
                            else
    (*.*)
                                if sy = period then
                                    begin
                                        with gattr do
                                            begin
                                                if typtr <> nil then
                                                    if typtr^.form <> records then
                                                        begin
                                                            error(140);
                                                            typtr := nil
                                                        end;
                                                insymbol;
                                                if sy = ident then
                                                    begin
                                                        if typtr <> nil then
                                                            begin
                                                                searchsection(typtr^.fstfld, lcp);
                                                                if lcp = nil then
                                                                    begin
                                                                        error(152);
                                                                        typtr := nil
                                                                    end
                                                                else
                                                                    with lcp^ do
                                                                        begin
                                                                            typtr := idtype;
                                                                            case access of
                                                                                drct:
                                                                                    dplmt := dplmt + fldaddr;
                                                                                indrct:
                                                                                    idplmt := idplmt + fldaddr;
                                                                                inxd:
                                                                                    error(400)
                                                                            end
                                                                        end
                                                            end;
                                                        insymbol
                                                    end (*sy = ident*)
                                                else
                                                    error(2)
                                            end (*with gattr*)
                                    end (*if sy = period*)
                                else
    (*^*)
                                    begin
                                        if gattr.typtr <> nil then
                                            with gattr, typtr^ do
                                                if form = pointer then
                                                    begin
                                                        load;
                                                        typtr := eltype;
                                                        if debug then
                                                            gen2t(45, 1, maxaddr, nilptr);(*chk*)
                                                        with gattr do
                                                            begin
                                                                kind := varbl;
                                                                access := indrct;
                                                                idplmt := 0
                                                            end
                                                    end
                                                else if form = files then
                                                    typtr := filtype
                                                else
                                                    error(141);
                                        insymbol
                                    end;
                            if not (sy in fsys + selectsys) then
                                begin
                                    error(6);
                                    skip(fsys + selectsys)
                                end
                        end (*while*)
                end; (*selector*)

                procedure call (fsys: setofsys; fcp: ctp);
                    var
                        lkey: 1..15;

                    procedure variable (fsys: setofsys);
                        var
                            lcp: ctp;
                    begin
                        if sy = ident then
                            begin
                                searchid([vars, field], lcp);
                                insymbol
                            end
                        else
                            begin
                                error(2);
                                lcp := uvarptr
                            end;
                        selector(fsys, lcp)
                    end; (*variable*)

                    procedure getputresetrewrite;
                    begin
                        variable(fsys + [rparent]);
                        loadaddress;
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form <> files then
                                error(116);
                        if lkey <= 2 then
                            gen1(30, lkey)(*csp*)
(*get,put*)
                        else
                            error(399)
                    end; (*getputresetrewrite*)

                    procedure read;
                        var
                            llev: levrange;
                            laddr: addrrange;
                            lsp: stp;
                    begin
                        llev := 1;
                        laddr := lcaftermarkstack;
                        if sy = lparent then
                            begin
                                insymbol;
                                variable(fsys + [comma, rparent]);
                                lsp := gattr.typtr;
                                test := false;
                                if lsp <> nil then
                                    if lsp^.form = files then
                                        with gattr, lsp^ do
                                            begin
                                                if filtype = charptr then
                                                    begin
                                                        llev := vlevel;
                                                        laddr := dplmt
                                                    end
                                                else
                                                    error(399);
                                                if sy = rparent then
                                                    begin
                                                        if lkey = 5 then
                                                            error(116);
                                                        test := true
                                                    end
                                                else if sy <> comma then
                                                    begin
                                                        error(116);
                                                        skip(fsys + [comma, rparent])
                                                    end;
                                                if sy = comma then
                                                    begin
                                                        insymbol;
                                                        variable(fsys + [comma, rparent])
                                                    end
                                                else
                                                    test := true
                                            end;
                                if not test then
                                    repeat
                                        loadaddress;
                                        gen2(50, level - llev, laddr);(*lda*)
                                        if gattr.typtr <> nil then
                                            if gattr.typtr^.form <= subrange then
                                                if comptypes(intptr, gattr.typtr) then
                                                    gen1(30, 3)(*csp*)
(*rdi*)
                                                else if comptypes(realptr, gattr.typtr) then
                                                    gen1(30, 4)(*csp*)
(*rdr*)
                                                else if comptypes(charptr, gattr.typtr) then
                                                    gen1(30, 5)(*csp*)
(*rdc*)
                                                else
                                                    error(399)
                                            else
                                                error(116);
                                        test := sy <> comma;
                                        if not test then
                                            begin
                                                insymbol;
                                                variable(fsys + [comma, rparent])
                                            end
                                    until test;
                                if sy = rparent then
                                    insymbol
                                else
                                    error(4)
                            end
                        else if lkey = 5 then
                            error(116);
                        if lkey = 11 then
                            begin
                                gen2(50, level - llev, laddr);(*lda*)
                                gen1(30, 21)(*csp*)
(*rln*)
                            end
                    end; (*read*)

                    procedure write;
                        var
                            lsp: stp;
                            default: boolean;
                            llkey: 1..15;
                            llev: levrange;
                            laddr, len: addrrange;
                    begin
                        llkey := lkey;
                        llev := 1;
                        laddr := lcaftermarkstack + charmax;
                        if sy = lparent then
                            begin
                                insymbol;
                                expression(fsys + [comma, colon, rparent]);
                                lsp := gattr.typtr;
                                test := false;
                                if lsp <> nil then
                                    if lsp^.form = files then
                                        with gattr, lsp^ do
                                            begin
                                                if filtype = charptr then
                                                    begin
                                                        llev := vlevel;
                                                        laddr := dplmt
                                                    end
                                                else
                                                    error(399);
                                                if sy = rparent then
                                                    begin
                                                        if llkey = 6 then
                                                            error(116);
                                                        test := true
                                                    end
                                                else if sy <> comma then
                                                    begin
                                                        error(116);
                                                        skip(fsys + [comma, rparent])
                                                    end;
                                                if sy = comma then
                                                    begin
                                                        insymbol;
                                                        expression(fsys + [comma, colon, rparent])
                                                    end
                                                else
                                                    test := true
                                            end;
                                if not test then
                                    repeat
                                        lsp := gattr.typtr;
                                        if lsp <> nil then
                                            if lsp^.form <= subrange then
                                                load
                                            else
                                                loadaddress;
                                        if sy = colon then
                                            begin
                                                insymbol;
                                                expression(fsys + [comma, colon, rparent]);
                                                if gattr.typtr <> nil then
                                                    if gattr.typtr <> intptr then
                                                        error(116);
                                                load;
                                                default := false
                                            end
                                        else
                                            default := true;
                                        if sy = colon then
                                            begin
                                                insymbol;
                                                expression(fsys + [comma, rparent]);
                                                if gattr.typtr <> nil then
                                                    if gattr.typtr <> intptr then
                                                        error(116);
                                                if lsp <> realptr then
                                                    error(124);
                                                load;
                                                error(399);
                                            end
                                        else if lsp = intptr then
                                            begin
                                                if default then
                                                    gen2(51, 1, 10);(*ldc*)
                                                gen2(50, level - llev, laddr);(*lda*)
                                                gen1(30, 6)(*csp*)
(*wri*)
                                            end
                                        else if lsp = realptr then
                                            begin
                                                if default then
                                                    gen2(51, 1, 20);(*ldc*)
                                                gen2(50, level - llev, laddr);(*lda*)
                                                gen1(30, 8)(*csp*)
(*wrr*)
                                            end
                                        else if lsp = charptr then
                                            begin
                                                if default then
                                                    gen2(51, 1, 1);(*ldc*)
                                                gen2(50, level - llev, laddr);(*lda*)
                                                gen1(30, 9)(*csp*)
(*wrc*)
                                            end
                                        else if lsp <> nil then
                                            begin
                                                if lsp^.form = scalar then
                                                    error(399)
                                                else if isString(lsp) then
                                                    begin
                                                        len := lsp^.size div charmax;
                                                        if default then
                                                            gen2(51, 1, len);(*ldc*)
                                                        gen2(51, 1, len);(*ldc*)
                                                        gen2(50, level - llev, laddr);(*lda*)
                                                        gen1(30, 10)(*csp*)
(*wrs*)
                                                    end
                                                else
                                                    error(116)
                                            end;
                                        test := sy <> comma;
                                        if not test then
                                            begin
                                                insymbol;
                                                expression(fsys + [comma, colon, rparent])
                                            end
                                    until test;
                                if sy = rparent then
                                    insymbol
                                else
                                    error(4)
                            end
                        else if lkey = 6 then
                            error(116);
                        if llkey = 12 then (*writeln*)
                            begin
                                gen2(50, level - llev, laddr);(*lda*)
                                gen1(30, 22)(*csp*)
(*wln*)
                            end
                    end; (*write*)

                    procedure pack;
                        var
                            lsp, lsp1: stp;
                    begin
                        error(399);
                        variable(fsys + [comma, rparent]);
                        lsp := nil;
                        lsp1 := nil;
                        if gattr.typtr <> nil then
                            with gattr.typtr^ do
                                if form = arrays then
                                    begin
                                        lsp := inxtype;
                                        lsp1 := aeltype
                                    end
                                else
                                    error(116);
                        if sy = comma then
                            insymbol
                        else
                            error(20);
                        expression(fsys + [comma, rparent]);
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form <> scalar then
                                error(116)
                            else if not comptypes(lsp, gattr.typtr) then
                                error(116);
                        if sy = comma then
                            insymbol
                        else
                            error(20);
                        variable(fsys + [rparent]);
                        if gattr.typtr <> nil then
                            with gattr.typtr^ do
                                if form = arrays then
                                    begin
                                        if not comptypes(aeltype, lsp1) or not comptypes(inxtype, lsp) then
                                            error(116)
                                    end
                                else
                                    error(116)
                    end; (*pack*)

                    procedure unpack;
                        var
                            lsp, lsp1: stp;
                    begin
                        error(399);
                        variable(fsys + [comma, rparent]);
                        lsp := nil;
                        lsp1 := nil;
                        if gattr.typtr <> nil then
                            with gattr.typtr^ do
                                if form = arrays then
                                    begin
                                        lsp := inxtype;
                                        lsp1 := aeltype
                                    end
                                else
                                    error(116);
                        if sy = comma then
                            insymbol
                        else
                            error(20);
                        variable(fsys + [comma, rparent]);
                        if gattr.typtr <> nil then
                            with gattr.typtr^ do
                                if form = arrays then
                                    begin
                                        if not comptypes(aeltype, lsp1) or not comptypes(inxtype, lsp) then
                                            error(116)
                                    end
                                else
                                    error(116);
                        if sy = comma then
                            insymbol
                        else
                            error(20);
                        expression(fsys + [rparent]);
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form <> scalar then
                                error(116)
                            else if not comptypes(lsp, gattr.typtr) then
                                error(116);
                    end; (*unpack*)

                    procedure new;
                        label
                            1;
                        var
                            lsp, lsp1: stp;
                            varts: integer;
                            lsize: addrrange;
                            lval: valu;
                    begin
                        variable(fsys + [comma, rparent]);
                        loadaddress;
                        lsp := nil;
                        varts := 0;
                        lsize := 0;
                        if gattr.typtr <> nil then
                            with gattr.typtr^ do
                                if form = pointer then
                                    begin
                                        if eltype <> nil then
                                            begin
                                                lsize := eltype^.size;
                                                if eltype^.form = records then
                                                    lsp := eltype^.recvar
                                            end
                                    end
                                else
                                    error(116);
                        while sy = comma do
                            begin
                                insymbol;
                                Bconstant(fsys + [comma, rparent], lsp1, lval);
                                varts := varts + 1;
        (*check to insert here: is constant in tagfieldtype range*)
                                if lsp = nil then
                                    error(158)
                                else if lsp^.form <> tagfld then
                                    error(162)
                                else if lsp^.tagfieldp <> nil then
                                    if isString(lsp1) or (lsp1 = realptr) then
                                        error(159)
                                    else if comptypes(lsp^.tagfieldp^.idtype, lsp1) then
                                        begin
                                            lsp1 := lsp^.fstvar;
                                            while lsp1 <> nil do
                                                with lsp1^ do
                                                    if varval.ival = lval.ival then
                                                        begin
                                                            lsize := size;
                                                            lsp := subvar;
                                                            goto 1
                                                        end
                                                    else
                                                        lsp1 := nxtvar;
                                            lsize := lsp^.size;
                                            lsp := nil;
                                        end
                                    else
                                        error(116);
1:
                            end; (*while*)
                        gen2(51, 1, lsize);(*ldc*)
                        gen1(30, 12);(*csp*)
(*new*)
                    end; (*new*)

                    procedure mark;
                    begin
                        variable(fsys + [rparent]);
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form = pointer then
                                begin
                                    loadaddress;
                                    gen1(30, 23)(*csp*)
(*sav*)
                                end
                            else
                                error(116)
                    end;(*mark*)

                    procedure release;
                    begin
                        variable(fsys + [rparent]);
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form = pointer then
                                begin
                                    load;
                                    gen1(30, 13)(*csp*)
(*rst*)
                                end
                            else
                                error(116)
                    end; (*release*)



                    procedure abs;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr = intptr then
                                gen0(0)(*abi*)
                            else if gattr.typtr = realptr then
                                gen0(1)(*abr*)
                            else
                                begin
                                    error(125);
                                    gattr.typtr := intptr
                                end
                    end; (*abs*)

                    procedure sqr;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr = intptr then
                                gen0(24)(*sqi*)
                            else if gattr.typtr = realptr then
                                gen0(25)(*sqr*)
                            else
                                begin
                                    error(125);
                                    gattr.typtr := intptr
                                end
                    end; (*sqr*)

                    procedure trunc;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr <> realptr then
                                error(125);
                        gen0(27);(*trc*)
                        gattr.typtr := intptr
                    end; (*trunc*)

                    procedure odd;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr <> intptr then
                                error(125);
                        gen0(20);(*odd*)
                        gattr.typtr := boolptr
                    end; (*odd*)

                    procedure ord;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form >= power then
                                error(125);
                        gen0t(58, gattr.typtr);(*ord*)
                        gattr.typtr := intptr
                    end; (*ord*)

                    procedure chr;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr <> intptr then
                                error(125);
                        gen0(59);(*chr*)
                        gattr.typtr := charptr
                    end; (*chr*)

                    procedure predsucc;
                    begin
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form <> scalar then
                                error(125);
                        if lkey = 7 then
                            gen1t(31, 1, gattr.typtr)(*dec*)
                        else
                            gen1t(34, 1, gattr.typtr)(*inc*)
                    end; (*predsucc*)

                    procedure eof;
                    begin
                        if sy = lparent then
                            begin
                                insymbol;
                                variable(fsys + [rparent]);
                                if sy = rparent then
                                    insymbol
                                else
                                    error(4)
                            end
                        else
                            with gattr do
                                begin
                                    typtr := textptr;
                                    kind := varbl;
                                    access := drct;
                                    vlevel := 1;
                                    dplmt := lcaftermarkstack
                                end;
                        loadaddress;
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form <> files then
                                error(125);
                        if lkey = 9 then
                            gen0(8)(*eof*)
                        else
                            gen1(30, 14);(*csp*)
(*eln*)
                        gattr.typtr := boolptr
                    end; (*eof*)



                    procedure callnonstandard;
                        var
                            nxt, lcp: ctp;
                            lsp: stp;
                            lkind: idkind;
                            lb: boolean;
                            locpar, llc: addrrange;
                    begin
                        locpar := 0;
                        with fcp^ do
                            begin
                                nxt := next;
                                lkind := pfkind;
                                if not externl then
                                    gen1(41, level - pflev)(*mst*)
                            end;
                        if sy = lparent then
                            begin
                                llc := lc;
                                repeat
                                    lb := false; (*decide whether proc/func must be passed*)
                                    if lkind = actual then
                                        begin
                                            if nxt = nil then
                                                error(126)
                                            else
                                                lb := nxt^.klass in [proc, func]
                                        end
                                    else
                                        error(399);
          (*For formal proc/func, lb is false and expression}
{           will be called, which will always interpret a proc/func id}
{           at its beginning as a call rather than a parameter passing.}
{           In this implementation, parameter procedures/functions}
{           are therefore not allowed to have procedure/function}
{           parameters*)
                                    insymbol;
                                    if lb then   (*pass function or procedure*)
                                        begin
                                            error(399);
                                            if sy <> ident then
                                                begin
                                                    error(2);
                                                    skip(fsys + [comma, rparent])
                                                end
                                            else
                                                begin
                                                    if nxt^.klass = proc then
                                                        searchid([proc], lcp)
                                                    else
                                                        begin
                                                            searchid([func], lcp);
                                                            if not comptypes(lcp^.idtype, nxt^.idtype) then
                                                                error(128)
                                                        end;
                                                    insymbol;
                                                    if not (sy in fsys + [comma, rparent]) then
                                                        begin
                                                            error(6);
                                                            skip(fsys + [comma, rparent])
                                                        end
                                                end
                                        end (*if lb*)
                                    else
                                        begin
                                            expression(fsys + [comma, rparent]);
                                            if gattr.typtr <> nil then
                                                if lkind = actual then
                                                    begin
                                                        if nxt <> nil then
                                                            begin
                                                                lsp := nxt^.idtype;
                                                                if lsp <> nil then
                                                                    begin
                                                                        if (nxt^.vkind = actual) then
                                                                            if lsp^.form <= power then
                                                                                begin
                                                                                    load;
                                                                                    if debug then
                                                                                        checkbnds(lsp);
                                                                                    if comptypes(realptr, lsp) and (gattr.typtr = intptr) then
                                                                                        begin
                                                                                            gen0(10);(*flt*)
                                                                                            gattr.typtr := realptr
                                                                                        end;
                                                                                    locpar := locpar + lsp^.size;
                                                                                    align(parmptr, locpar);
                                                                                end
                                                                            else
                                                                                begin
                                                                                    loadaddress;
                                                                                    locpar := locpar + ptrsize;
                                                                                    align(parmptr, locpar)
                                                                                end
                                                                        else if gattr.kind = varbl then
                                                                            begin
                                                                                loadaddress;
                                                                                locpar := locpar + ptrsize;
                                                                                align(parmptr, locpar);
                                                                            end
                                                                        else
                                                                            error(154);
                                                                        if not comptypes(lsp, gattr.typtr) then
                                                                            error(142)
                                                                    end
                                                            end
                                                    end
                                                else (*lkind = formal*)
                                                    begin (*pass formal param*)
                                                    end
                                        end;
                                    if (lkind = actual) and (nxt <> nil) then
                                        nxt := nxt^.next
                                until sy <> comma;
                                lc := llc;
                                if sy = rparent then
                                    insymbol
                                else
                                    error(4)
                            end; (*if lparent*)
                        if lkind = actual then
                            begin
                                if nxt <> nil then
                                    error(126);
                                with fcp^ do
                                    begin
                                        if externl then
                                            gen1(30, pfname)(*csp*)
                                        else
                                            gencupent(46, locpar, pfname);(*cup*)
                                    end
                            end;
                        gattr.typtr := fcp^.idtype
                    end; (*callnonstandard*)

                begin (*call*)
                    if fcp^.pfdeckind = standard then
                        begin
                            lkey := fcp^.key;
                            if fcp^.klass = proc then
                                begin
                                    if not (lkey in [5, 6, 11, 12]) then
                                        if sy = lparent then
                                            insymbol
                                        else
                                            error(9);
                                    case lkey of
                                        1, 2, 3, 4:
                                            getputresetrewrite;
                                        5, 11:
                                            read;
                                        6, 12:
                                            write;
                                        7:
                                            pack;
                                        8:
                                            unpack;
                                        9:
                                            new;
                                        10:
                                            release;
                                        13:
                                            mark
                                    end;
                                    if not (lkey in [5, 6, 11, 12]) then
                                        if sy = rparent then
                                            insymbol
                                        else
                                            error(4)
                                end
                            else
                                begin
                                    if lkey <= 8 then
                                        begin
                                            if sy = lparent then
                                                insymbol
                                            else
                                                error(9);
                                            expression(fsys + [rparent]);
                                            load
                                        end;
                                    case lkey of
                                        1:
                                            abs;
                                        2:
                                            sqr;
                                        3:
                                            trunc;
                                        4:
                                            odd;
                                        5:
                                            ord;
                                        6:
                                            chr;
                                        7, 8:
                                            predsucc;
                                        9, 10:
                                            eof
                                    end;
                                    if lkey <= 8 then
                                        if sy = rparent then
                                            insymbol
                                        else
                                            error(4)
                                end;
                        end (*standard procedures and functions*)
                    else
                        callnonstandard
                end; (*call*)

                procedure expression;
                    var
                        lattr: attr;
                        lop: operator;
                        typind: char;
                        lsize: addrrange;

                    procedure simpleexpression (fsys: setofsys);
                        var
                            lattr: attr;
                            lop: operator;
                            signed: boolean;

                        procedure term (fsys: setofsys);
                            var
                                lattr: attr;
                                lop: operator;

                            procedure factor (fsys: setofsys);
                                var
                                    lcp: ctp;
                                    lvp: csp;
                                    varpart: boolean;
                                    cstpart: setty;
                                    lsp: stp;
                            begin
                                if not (sy in facbegsys) then
                                    begin
                                        error(58);
                                        skip(fsys + facbegsys);
                                        gattr.typtr := nil
                                    end;
                                while sy in facbegsys do
                                    begin
                                        case sy of
          (*id*)
                                            ident:
                                                begin
                                                    searchid([konst, vars, field, func], lcp);
                                                    insymbol;
                                                    if lcp^.klass = func then
                                                        begin
                                                            call(fsys, lcp);
                                                            with gattr do
                                                                begin
                                                                    kind := expr;
                                                                    if typtr <> nil then
                                                                        if typtr^.form = subrange then
                                                                            typtr := typtr^.rangetype
                                                                end
                                                        end
                                                    else if lcp^.klass = konst then
                                                        with gattr, lcp^ do
                                                            begin
                                                                typtr := idtype;
                                                                kind := cst;
                                                                cval := values
                                                            end
                                                    else
                                                        begin
                                                            selector(fsys, lcp);
                                                            if gattr.typtr <> nil then(*elim.subr.types to*)
                                                                with gattr, typtr^ do(*simplify later tests*)
                                                                    if form = subrange then
                                                                        typtr := rangetype
                                                        end
                                                end;
          (*cst*)
                                            intconst:
                                                begin
                                                    with gattr do
                                                        begin
                                                            typtr := intptr;
                                                            kind := cst;
                                                            cval := val
                                                        end;
                                                    insymbol
                                                end;
                                            realconst:
                                                begin
                                                    with gattr do
                                                        begin
                                                            typtr := realptr;
                                                            kind := cst;
                                                            cval := val
                                                        end;
                                                    insymbol
                                                end;
                                            stringconst:
                                                begin
                                                    with gattr do
                                                        begin
                                                            if lgth = 1 then
                                                                typtr := charptr
                                                            else
                                                                begin
                                                                    new(lsp, arrays);
                                                                    with lsp^ do
                                                                        begin
                                                                            aeltype := charptr;
                                                                            form := arrays;
                                                                            inxtype := nil;
                                                                            size := lgth * charsize
                                                                        end;
                                                                    typtr := lsp
                                                                end;
                                                            kind := cst;
                                                            cval := val
                                                        end;
                                                    insymbol
                                                end;
          (* ( *)
                                            lparent:
                                                begin
                                                    insymbol;
                                                    expression(fsys + [rparent]);
                                                    if sy = rparent then
                                                        insymbol
                                                    else
                                                        error(4)
                                                end;
          (*not*)
                                            notsy:
                                                begin
                                                    insymbol;
                                                    factor(fsys);
                                                    load;
                                                    gen0(19);(*not*)
                                                    if gattr.typtr <> nil then
                                                        if gattr.typtr <> boolptr then
                                                            begin
                                                                error(135);
                                                                gattr.typtr := nil
                                                            end;
                                                end;
          (*[*)
                                            lbrack:
                                                begin
                                                    insymbol;
                                                    cstpart := [];
                                                    varpart := false;
                                                    new(lsp, power);
                                                    with lsp^ do
                                                        begin
                                                            elset := nil;
                                                            size := setsize;
                                                            form := power
                                                        end;
                                                    if sy = rbrack then
                                                        begin
                                                            with gattr do
                                                                begin
                                                                    typtr := lsp;
                                                                    kind := cst
                                                                end;
                                                            insymbol
                                                        end
                                                    else
                                                        begin
                                                            repeat
                                                                expression(fsys + [comma, rbrack]);
                                                                if gattr.typtr <> nil then
                                                                    if gattr.typtr^.form <> scalar then
                                                                        begin
                                                                            error(136);
                                                                            gattr.typtr := nil
                                                                        end
                                                                    else if comptypes(lsp^.elset, gattr.typtr) then
                                                                        begin
                                                                            if gattr.kind = cst then
                                                                                if (gattr.cval.ival < setlow) or (gattr.cval.ival > sethigh) then
                                                                                    error(304)
                                                                                else
                                                                                    cstpart := cstpart + [gattr.cval.ival]
                                                                            else
                                                                                begin
                                                                                    load;
                                                                                    if not comptypes(gattr.typtr, intptr) then
                                                                                        gen0t(58, gattr.typtr);(*ord*)
                                                                                    gen0(23);(*sgs*)
                                                                                    if varpart then
                                                                                        gen0(28)(*uni*)
                                                                                    else
                                                                                        varpart := true
                                                                                end;
                                                                            lsp^.elset := gattr.typtr;
                                                                            gattr.typtr := lsp
                                                                        end
                                                                    else
                                                                        error(137);
                                                                test := sy <> comma;
                                                                if not test then
                                                                    insymbol
                                                            until test;
                                                            if sy = rbrack then
                                                                insymbol
                                                            else
                                                                error(12)
                                                        end;
                                                    if varpart then
                                                        begin
                                                            if cstpart <> [] then
                                                                begin
                                                                    new(lvp, pset);
                                                                    lvp^.pval := cstpart;
                                                                    lvp^.cclass := pset;
                                                                    if cstptrix = cstoccmax then
                                                                        error(254)
                                                                    else
                                                                        begin
                                                                            cstptrix := cstptrix + 1;
                                                                            cstptr[cstptrix] := lvp;
                                                                            gen2(51, 5, cstptrix);(*ldc*)
                                                                            gen0(28);(*uni*)
                                                                            gattr.kind := expr
                                                                        end
                                                                end
                                                        end
                                                    else
                                                        begin
                                                            new(lvp, pset);
                                                            lvp^.pval := cstpart;
                                                            lvp^.cclass := pset;
                                                            gattr.cval.valp := lvp
                                                        end
                                                end
                                        end; (*case*)
                                        if not (sy in fsys) then
                                            begin
                                                error(6);
                                                skip(fsys + facbegsys)
                                            end
                                    end (*while*)
                            end; (*factor*)

                        begin (*term*)
                            factor(fsys + [mulop]);
                            while sy = mulop do
                                begin
                                    load;
                                    lattr := gattr;
                                    lop := op;
                                    insymbol;
                                    factor(fsys + [mulop]);
                                    load;
                                    if (lattr.typtr <> nil) and (gattr.typtr <> nil) then
                                        case lop of
        (***)
                                            mul:
                                                if (lattr.typtr = intptr) and (gattr.typtr = intptr) then
                                                    gen0(15)(*mpi*)
                                                else
                                                    begin
                                                        if lattr.typtr = intptr then
                                                            begin
                                                                gen0(9);(*flo*)
                                                                lattr.typtr := realptr
                                                            end
                                                        else if gattr.typtr = intptr then
                                                            begin
                                                                gen0(10);(*flt*)
                                                                gattr.typtr := realptr
                                                            end;
                                                        if (lattr.typtr = realptr) and (gattr.typtr = realptr) then
                                                            gen0(16)(*mpr*)
                                                        else if (lattr.typtr^.form = power) and comptypes(lattr.typtr, gattr.typtr) then
                                                            gen0(12)(*int*)
                                                        else
                                                            begin
                                                                error(134);
                                                                gattr.typtr := nil
                                                            end
                                                    end;
        (* / *)
                                            rdiv:
                                                begin
                                                    if gattr.typtr = intptr then
                                                        begin
                                                            gen0(10);(*flt*)
                                                            gattr.typtr := realptr
                                                        end;
                                                    if lattr.typtr = intptr then
                                                        begin
                                                            gen0(9);(*flo*)
                                                            lattr.typtr := realptr
                                                        end;
                                                    if (lattr.typtr = realptr) and (gattr.typtr = realptr) then
                                                        gen0(7)(*dvr*)
                                                    else
                                                        begin
                                                            error(134);
                                                            gattr.typtr := nil
                                                        end
                                                end;
        (*div*)
                                            idiv:
                                                if (lattr.typtr = intptr) and (gattr.typtr = intptr) then
                                                    gen0(6)(*dvi*)
                                                else
                                                    begin
                                                        error(134);
                                                        gattr.typtr := nil
                                                    end;
        (*mod*)
                                            imod:
                                                if (lattr.typtr = intptr) and (gattr.typtr = intptr) then
                                                    gen0(14)(*mod*)
                                                else
                                                    begin
                                                        error(134);
                                                        gattr.typtr := nil
                                                    end;
        (*and*)
                                            andop:
                                                if (lattr.typtr = boolptr) and (gattr.typtr = boolptr) then
                                                    gen0(4)(*and*)
                                                else
                                                    begin
                                                        error(134);
                                                        gattr.typtr := nil
                                                    end
                                        end (*case*)
                                    else
                                        gattr.typtr := nil
                                end (*while*)
                        end; (*term*)

                    begin (*simpleexpression*)
                        signed := false;
                        if (sy = addop) and (op in [plus, minus]) then
                            begin
                                signed := op = minus;
                                insymbol
                            end;
                        term(fsys + [addop]);
                        if signed then
                            begin
                                load;
                                if gattr.typtr = intptr then
                                    gen0(17)(*ngi*)
                                else if gattr.typtr = realptr then
                                    gen0(18)(*ngr*)
                                else
                                    begin
                                        error(134);
                                        gattr.typtr := nil
                                    end
                            end;
                        while sy = addop do
                            begin
                                load;
                                lattr := gattr;
                                lop := op;
                                insymbol;
                                term(fsys + [addop]);
                                load;
                                if (lattr.typtr <> nil) and (gattr.typtr <> nil) then
                                    case lop of
      (*+*)
                                        plus:
                                            if (lattr.typtr = intptr) and (gattr.typtr = intptr) then
                                                gen0(2)(*adi*)
                                            else
                                                begin
                                                    if lattr.typtr = intptr then
                                                        begin
                                                            gen0(9);(*flo*)
                                                            lattr.typtr := realptr
                                                        end
                                                    else if gattr.typtr = intptr then
                                                        begin
                                                            gen0(10);(*flt*)
                                                            gattr.typtr := realptr
                                                        end;
                                                    if (lattr.typtr = realptr) and (gattr.typtr = realptr) then
                                                        gen0(3)(*adr*)
                                                    else if (lattr.typtr^.form = power) and comptypes(lattr.typtr, gattr.typtr) then
                                                        gen0(28)(*uni*)
                                                    else
                                                        begin
                                                            error(134);
                                                            gattr.typtr := nil
                                                        end
                                                end;
      (*-*)
                                        minus:
                                            if (lattr.typtr = intptr) and (gattr.typtr = intptr) then
                                                gen0(21)(*sbi*)
                                            else
                                                begin
                                                    if lattr.typtr = intptr then
                                                        begin
                                                            gen0(9);(*flo*)
                                                            lattr.typtr := realptr
                                                        end
                                                    else if gattr.typtr = intptr then
                                                        begin
                                                            gen0(10);(*flt*)
                                                            gattr.typtr := realptr
                                                        end;
                                                    if (lattr.typtr = realptr) and (gattr.typtr = realptr) then
                                                        gen0(22)(*sbr*)
                                                    else if (lattr.typtr^.form = power) and comptypes(lattr.typtr, gattr.typtr) then
                                                        gen0(5)(*dif*)
                                                    else
                                                        begin
                                                            error(134);
                                                            gattr.typtr := nil
                                                        end
                                                end;
      (*or*)
                                        orop:
                                            if (lattr.typtr = boolptr) and (gattr.typtr = boolptr) then
                                                gen0(13)(*ior*)
                                            else
                                                begin
                                                    error(134);
                                                    gattr.typtr := nil
                                                end
                                    end (*case*)
                                else
                                    gattr.typtr := nil
                            end (*while*)
                    end; (*simpleexpression*)

                begin (*expression*)
                    simpleexpression(fsys + [relop]);
                    if sy = relop then
                        begin
                            if gattr.typtr <> nil then
                                if gattr.typtr^.form <= power then
                                    load
                                else
                                    loadaddress;
                            lattr := gattr;
                            lop := op;
                            if lop = inop then
                                if not comptypes(gattr.typtr, intptr) then
                                    gen0t(58, gattr.typtr);(*ord*)
                            insymbol;
                            simpleexpression(fsys);
                            if gattr.typtr <> nil then
                                if gattr.typtr^.form <= power then
                                    load
                                else
                                    loadaddress;
                            if (lattr.typtr <> nil) and (gattr.typtr <> nil) then
                                if lop = inop then
                                    if gattr.typtr^.form = power then
                                        if comptypes(lattr.typtr, gattr.typtr^.elset) then
                                            gen0(11)(*inn*)
                                        else
                                            begin
                                                error(129);
                                                gattr.typtr := nil
                                            end
                                    else
                                        begin
                                            error(130);
                                            gattr.typtr := nil
                                        end
                                else
                                    begin
                                        if lattr.typtr <> gattr.typtr then
                                            if lattr.typtr = intptr then
                                                begin
                                                    gen0(9);(*flo*)
                                                    lattr.typtr := realptr
                                                end
                                            else if gattr.typtr = intptr then
                                                begin
                                                    gen0(10);(*flt*)
                                                    gattr.typtr := realptr
                                                end;
                                        if comptypes(lattr.typtr, gattr.typtr) then
                                            begin
                                                lsize := lattr.typtr^.size;
                                                case lattr.typtr^.form of
                                                    scalar:
                                                        if lattr.typtr = realptr then
                                                            typind := 'r'
                                                        else if lattr.typtr = boolptr then
                                                            typind := 'b'
                                                        else if lattr.typtr = charptr then
                                                            typind := 'c'
                                                        else
                                                            typind := 'i';
                                                    pointer:
                                                        begin
                                                            if lop in [ltop, leop, gtop, geop] then
                                                                error(131);
                                                            typind := 'a'
                                                        end;
                                                    power:
                                                        begin
                                                            if lop in [ltop, gtop] then
                                                                error(132);
                                                            typind := 's'
                                                        end;
                                                    arrays:
                                                        begin
                                                            if not isString(lattr.typtr) then
                                                                error(134);
                                                            typind := 'm'
                                                        end;
                                                    records:
                                                        begin
                                                            error(134);
                                                            typind := 'm'
                                                        end;
                                                    files:
                                                        begin
                                                            error(133);
                                                            typind := 'f'
                                                        end
                                                end;
                                                case lop of
                                                    ltop:
                                                        gen2(53, ord(typind), lsize);(*les*)
                                                    leop:
                                                        gen2(52, ord(typind), lsize);(*leq*)
                                                    gtop:
                                                        gen2(49, ord(typind), lsize);(*grt*)
                                                    geop:
                                                        gen2(48, ord(typind), lsize);(*geq*)
                                                    neop:
                                                        gen2(55, ord(typind), lsize);(*neq*)
                                                    eqop:
                                                        gen2(47, ord(typind), lsize)(*equ*)
                                                end
                                            end
                                        else
                                            error(129)
                                    end;
                            gattr.typtr := boolptr;
                            gattr.kind := expr
                        end (*sy = relop*)
                end; (*expression*)

                procedure assignment (fcp: ctp);
                    var
                        lattr: attr;
                begin
                    selector(fsys + [becomes], fcp);
                    if sy = becomes then
                        begin
                            if gattr.typtr <> nil then
                                if (gattr.access <> drct) or (gattr.typtr^.form > power) then
                                    loadaddress;
                            lattr := gattr;
                            insymbol;
                            expression(fsys);
                            if gattr.typtr <> nil then
                                if gattr.typtr^.form <= power then
                                    load
                                else
                                    loadaddress;
                            if (lattr.typtr <> nil) and (gattr.typtr <> nil) then
                                begin
                                    if comptypes(realptr, lattr.typtr) and (gattr.typtr = intptr) then
                                        begin
                                            gen0(10);(*flt*)
                                            gattr.typtr := realptr
                                        end;
                                    if comptypes(lattr.typtr, gattr.typtr) then
                                        case lattr.typtr^.form of
                                            scalar, subrange:
                                                begin
                                                    if debug then
                                                        checkbnds(lattr.typtr);
                                                    store(lattr)
                                                end;
                                            pointer:
                                                begin
                                                    if debug then
                                                        gen2t(45, 0, maxaddr, nilptr);(*chk*)
                                                    store(lattr)
                                                end;
                                            power:
                                                store(lattr);
                                            arrays, records:
                                                gen1(40, lattr.typtr^.size);(*mov*)
                                            files:
                                                error(146)
                                        end
                                    else
                                        error(129)
                                end
                        end (*sy = becomes*)
                    else
                        error(51)
                end; (*assignment*)

                procedure gotostatement;
                    var
                        llp: lbp;
                        found: boolean;
                        ttop, ttop1: disprange;
                begin
                    if sy = intconst then
                        begin
                            found := false;
                            ttop := top;
                            while display[ttop].occur <> blck do
                                ttop := ttop - 1;
                            ttop1 := ttop;
                            repeat
                                llp := display[ttop].flabel;
                                while (llp <> nil) and not found do
                                    with llp^ do
                                        if labval = val.ival then
                                            begin
                                                found := true;
                                                if ttop = ttop1 then
                                                    genujpxjp(57, labname)(*ujp*)
                                                else (*goto leads out of procedure*)
                                                    error(399)
                                            end
                                        else
                                            llp := nextlab;
                                ttop := ttop - 1
                            until found or (ttop = 0);
                            if not found then
                                error(167);
                            insymbol
                        end
                    else
                        error(15)
                end; (*gotostatement*)

                procedure compoundstatement;
                begin
                    repeat
                        repeat
                            statement(fsys + [semicolon, endsy])
                        until not (sy in statbegsys);
                        test := sy <> semicolon;
                        if not test then
                            insymbol
                    until test;
                    if sy = endsy then
                        insymbol
                    else
                        error(13)
                end; (*compoundstatemenet*)

                procedure ifstatement;
                    var
                        lcix1, lcix2: integer;
                begin
                    expression(fsys + [thensy]);
                    genlabel(lcix1);
                    genfjp(lcix1);
                    if sy = thensy then
                        insymbol
                    else
                        error(52);
                    statement(fsys + [elsesy]);
                    if sy = elsesy then
                        begin
                            genlabel(lcix2);
                            genujpxjp(57, lcix2);(*ujp*)
                            putlabel(lcix1);
                            insymbol;
                            statement(fsys);
                            putlabel(lcix2)
                        end
                    else
                        putlabel(lcix1)
                end; (*ifstatement*)

                procedure casestatement;
                    label
                        1;
                    type
                        cip = ^caseinfo;
                        caseinfo = packed record
                                next: cip;
                                csstart: integer;
                                cslab: integer
                            end;
                    var
                        lsp, lsp1: stp;
                        fstptr, lpt1, lpt2, lpt3: cip;
                        lval: valu;
                        laddr, lcix, lcix1, lmin, lmax: integer;
                begin
                    expression(fsys + [ofsy, comma, colon]);
                    load;
                    genlabel(lcix);
                    lsp := gattr.typtr;
                    if lsp <> nil then
                        if (lsp^.form <> scalar) or (lsp = realptr) then
                            begin
                                error(144);
                                lsp := nil
                            end
                        else if not comptypes(lsp, intptr) then
                            gen0t(58, lsp);(*ord*)
                    genujpxjp(57, lcix);(*ujp*)
                    if sy = ofsy then
                        insymbol
                    else
                        error(8);
                    fstptr := nil;
                    genlabel(laddr);
                    repeat
                        lpt3 := nil;
                        genlabel(lcix1);
                        if not (sy in [semicolon, endsy]) then
                            begin
                                repeat
                                    Bconstant(fsys + [comma, colon], lsp1, lval);
                                    if lsp <> nil then
                                        if comptypes(lsp, lsp1) then
                                            begin
                                                lpt1 := fstptr;
                                                lpt2 := nil;
                                                while lpt1 <> nil do
                                                    with lpt1^ do
                                                        begin
                                                            if cslab <= lval.ival then
                                                                begin
                                                                    if cslab = lval.ival then
                                                                        error(156);
                                                                    goto 1
                                                                end;
                                                            lpt2 := lpt1;
                                                            lpt1 := next
                                                        end;
1:
                                                new(lpt3);
                                                with lpt3^ do
                                                    begin
                                                        next := lpt1;
                                                        cslab := lval.ival;
                                                        csstart := lcix1
                                                    end;
                                                if lpt2 = nil then
                                                    fstptr := lpt3
                                                else
                                                    lpt2^.next := lpt3
                                            end
                                        else
                                            error(147);
                                    test := sy <> comma;
                                    if not test then
                                        insymbol
                                until test;
                                if sy = colon then
                                    insymbol
                                else
                                    error(5);
                                putlabel(lcix1);
                                repeat
                                    statement(fsys + [semicolon])
                                until not (sy in statbegsys);
                                if lpt3 <> nil then
                                    genujpxjp(57, laddr);(*ujp*)
                            end;
                        test := sy <> semicolon;
                        if not test then
                            insymbol
                    until test;
                    putlabel(lcix);
                    if fstptr <> nil then
                        begin
                            lmax := fstptr^.cslab;
          (*reverse pointers*)
                            lpt1 := fstptr;
                            fstptr := nil;
                            repeat
                                lpt2 := lpt1^.next;
                                lpt1^.next := fstptr;
                                fstptr := lpt1;
                                lpt1 := lpt2
                            until lpt1 = nil;
                            lmin := fstptr^.cslab;
                            if lmax - lmin < cixmax then
                                begin
                                    gen2t(45, lmin, lmax, intptr);(*chk*)
                                    gen2(51, 1, lmin);(*ldc*)
                                    gen0(21);(*sbi*)
                                    genlabel(lcix);
                                    genujpxjp(44, lcix);(*xjp*)
                                    putlabel(lcix);
                                    repeat
                                        with fstptr^ do
                                            begin
                                                while cslab > lmin do
                                                    begin
                                                        gen0(60);(*ujc error*)
                                                        lmin := lmin + 1
                                                    end;
                                                genujpxjp(57, csstart);(*ujp*)
                                                fstptr := next;
                                                lmin := lmin + 1
                                            end
                                    until fstptr = nil;
                                    putlabel(laddr)
                                end
                            else
                                error(157)
                        end;
                    if sy = endsy then
                        insymbol
                    else
                        error(13)
                end; (*casestatement*)

                procedure repeatstatement;
                    var
                        laddr: integer;
                begin
                    genlabel(laddr);
                    putlabel(laddr);
                    repeat
                        statement(fsys + [semicolon, untilsy]);
                        if sy in statbegsys then
                            error(14)
                    until not (sy in statbegsys);
                    while sy = semicolon do
                        begin
                            insymbol;
                            repeat
                                statement(fsys + [semicolon, untilsy]);
                                if sy in statbegsys then
                                    error(14)
                            until not (sy in statbegsys);
                        end;
                    if sy = untilsy then
                        begin
                            insymbol;
                            expression(fsys);
                            genfjp(laddr)
                        end
                    else
                        error(53)
                end; (*repeatstatement*)

                procedure whilestatement;
                    var
                        laddr, lcix: integer;
                begin
                    genlabel(laddr);
                    putlabel(laddr);
                    expression(fsys + [dosy]);
                    genlabel(lcix);
                    genfjp(lcix);
                    if sy = dosy then
                        insymbol
                    else
                        error(54);
                    statement(fsys);
                    genujpxjp(57, laddr);(*ujp*)
                    putlabel(lcix)
                end; (*whilestatement*)

                procedure forstatement;
                    var
                        lattr: attr;
                        lsy: symbol;
                        lcix, laddr: integer;
                        llc: addrrange;
                begin
                    llc := lc;
                    with lattr do
                        begin
                            typtr := nil;
                            kind := varbl;
                            access := drct;
                            vlevel := level;
                            dplmt := 0
                        end;
                    if sy = ident then
                        begin
                            searchid([vars], lcp);
                            with lcp^, lattr do
                                begin
                                    typtr := idtype;
                                    kind := varbl;
                                    if vkind = actual then
                                        begin
                                            access := drct;
                                            vlevel := vlev;
                                            dplmt := vaddr
                                        end
                                    else
                                        begin
                                            error(155);
                                            typtr := nil
                                        end
                                end;
                            if lattr.typtr <> nil then
                                if (lattr.typtr^.form > subrange) or comptypes(realptr, lattr.typtr) then
                                    begin
                                        error(143);
                                        lattr.typtr := nil
                                    end;
                            insymbol
                        end
                    else
                        begin
                            error(2);
                            skip(fsys + [becomes, tosy, downtosy, dosy])
                        end;
                    if sy = becomes then
                        begin
                            insymbol;
                            expression(fsys + [tosy, downtosy, dosy]);
                            if gattr.typtr <> nil then
                                if gattr.typtr^.form <> scalar then
                                    error(144)
                                else if comptypes(lattr.typtr, gattr.typtr) then
                                    begin
                                        load;
                                        store(lattr)
                                    end
                                else
                                    error(145)
                        end
                    else
                        begin
                            error(51);
                            skip(fsys + [tosy, downtosy, dosy])
                        end;
                    if sy in [tosy, downtosy] then
                        begin
                            lsy := sy;
                            insymbol;
                            expression(fsys + [dosy]);
                            if gattr.typtr <> nil then
                                if gattr.typtr^.form <> scalar then
                                    error(144)
                                else if comptypes(lattr.typtr, gattr.typtr) then
                                    begin
                                        load;
                                        if not comptypes(lattr.typtr, intptr) then
                                            gen0t(58, gattr.typtr);(*ord*)
                                        align(intptr, lc);
                                        gen2t(56, 0, lc, intptr);(*str*)
                                        genlabel(laddr);
                                        putlabel(laddr);
                                        gattr := lattr;
                                        load;
                                        if not comptypes(gattr.typtr, intptr) then
                                            gen0t(58, gattr.typtr);(*ord*)
                                        gen2t(54, 0, lc, intptr);(*lod*)
                                        lc := lc + intsize;
                                        if lc > lcmax then
                                            lcmax := lc;
                                        if lsy = tosy then
                                            gen2(52, ord('i'), 1)(*leq*)
                                        else
                                            gen2(48, ord('i'), 1);(*geq*)
                                    end
                                else
                                    error(145)
                        end
                    else
                        begin
                            error(55);
                            skip(fsys + [dosy])
                        end;
                    genlabel(lcix);
                    genujpxjp(33, lcix);(*fjp*)
                    if sy = dosy then
                        insymbol
                    else
                        error(54);
                    statement(fsys);
                    gattr := lattr;
                    load;
                    if lsy = tosy then
                        gen1t(34, 1, gattr.typtr)(*inc*)
                    else
                        gen1t(31, 1, gattr.typtr);(*dec*)
                    store(lattr);
                    genujpxjp(57, laddr);(*ujp*)
                    putlabel(lcix);
                    lc := llc;
                end; (*forstatement*)


                procedure withstatement;
                    var
                        lcp: ctp;
                        lcnt1: disprange;
                        llc: addrrange;
                begin
                    lcnt1 := 0;
                    llc := lc;
                    repeat
                        if sy = ident then
                            begin
                                searchid([vars, field], lcp);
                                insymbol
                            end
                        else
                            begin
                                error(2);
                                lcp := uvarptr
                            end;
                        selector(fsys + [comma, dosy], lcp);
                        if gattr.typtr <> nil then
                            if gattr.typtr^.form = records then
                                if top < displimit then
                                    begin
                                        top := top + 1;
                                        lcnt1 := lcnt1 + 1;
                                        with display[top] do
                                            begin
                                                fname := gattr.typtr^.fstfld;
                                                flabel := nil
                                            end;
                                        if gattr.access = drct then
                                            with display[top] do
                                                begin
                                                    occur := crec;
                                                    clev := gattr.vlevel;
                                                    cdspl := gattr.dplmt
                                                end
                                        else
                                            begin
                                                loadaddress;
                                                align(nilptr, lc);
                                                gen2t(56, 0, lc, nilptr);(*str*)
                                                with display[top] do
                                                    begin
                                                        occur := vrec;
                                                        vdspl := lc
                                                    end;
                                                lc := lc + ptrsize;
                                                if lc > lcmax then
                                                    lcmax := lc
                                            end
                                    end
                                else
                                    error(250)
                            else
                                error(140);
                        test := sy <> comma;
                        if not test then
                            insymbol
                    until test;
                    if sy = dosy then
                        insymbol
                    else
                        error(54);
                    statement(fsys);
                    top := top - lcnt1;
                    lc := llc;
                end; (*withstatement*)

            begin (*statement*)
                if sy = intconst then (*label*)
                    begin
                        llp := display[level].flabel;
                        while llp <> nil do
                            with llp^ do
                                if labval = val.ival then
                                    begin
                                        if defined then
                                            error(165);
                                        putlabel(labname);
                                        defined := true;
                                        goto 1
                                    end
                                else
                                    llp := nextlab;
                        error(167);
1:
                        insymbol;
                        if sy = colon then
                            insymbol
                        else
                            error(5)
                    end;
                if not (sy in fsys + [ident]) then
                    begin
                        error(6);
                        skip(fsys)
                    end;
                if sy in statbegsys + [ident] then
                    begin
                        case sy of
                            ident:
                                begin
                                    searchid([vars, field, func, proc], lcp);
                                    insymbol;
                                    if lcp^.klass = proc then
                                        call(fsys, lcp)
                                    else
                                        assignment(lcp)
                                end;
                            beginsy:
                                begin
                                    insymbol;
                                    compoundstatement
                                end;
                            gotosy:
                                begin
                                    insymbol;
                                    gotostatement
                                end;
                            ifsy:
                                begin
                                    insymbol;
                                    ifstatement
                                end;
                            casesy:
                                begin
                                    insymbol;
                                    casestatement
                                end;
                            whilesy:
                                begin
                                    insymbol;
                                    whilestatement
                                end;
                            repeatsy:
                                begin
                                    insymbol;
                                    repeatstatement
                                end;
                            forsy:
                                begin
                                    insymbol;
                                    forstatement
                                end;
                            withsy:
                                begin
                                    insymbol;
                                    withstatement
                                end
                        end;
                        if not (sy in [semicolon, endsy, elsesy, untilsy]) then
                            begin
                                error(6);
                                skip(fsys)
                            end
                    end
            end; (*statement*)

        begin (*body*)
            if fprocp <> nil then
                entname := fprocp^.pfname
            else
                genlabel(entname);
            cstptrix := 0;
            topnew := lcaftermarkstack;
            topmax := lcaftermarkstack;
            putlabel(entname);
            genlabel(segsize);
            genlabel(stacktop);
            gencupent(32, 1, segsize);(*ent1*)
            gencupent(32, 2, stacktop);(*ent2*)
            if fprocp <> nil then (*copy multiple values into local cells*)
                begin
                    llc1 := lcaftermarkstack;
                    lcp := fprocp^.next;
                    while lcp <> nil do
                        with lcp^ do
                            begin
                                align(parmptr, llc1);
                                if klass = vars then
                                    if idtype <> nil then
                                        if idtype^.form > power then
                                            begin
                                                if vkind = actual then
                                                    begin
                                                        gen2(50, 0, vaddr);(*lda*)
                                                        gen2t(54, 0, llc1, nilptr);(*lod*)
                                                        gen1(40, idtype^.size);(*mov*)
                                                    end;
                                                llc1 := llc1 + ptrsize
                                            end
                                        else
                                            llc1 := llc1 + idtype^.size;
                                lcp := lcp^.next;
                            end;
                end;
            lcmax := lc;
            repeat
                repeat
                    statement(fsys + [semicolon, endsy])
                until not (sy in statbegsys);
                test := sy <> semicolon;
                if not test then
                    insymbol
            until test;
            if sy = endsy then
                insymbol
            else
                error(13);
            llp := display[top].flabel; (*test for undefined labels*)
            while llp <> nil do
                with llp^ do
                    begin
                        if not defined then
                            begin
                                error(168);
                                writeln(output);
                                writeln(output, ' label ', labval);
                                write(output, ' ' : chcnt + 16)
                            end;
                        llp := nextlab
                    end;
            if fprocp <> nil then
                begin
                    if fprocp^.idtype = nil then
                        gen1(42, ord('p'))(*ret*)
                    else
                        gen0t(42, fprocp^.idtype);(*ret*)
                    align(parmptr, lcmax);
                    if prcode then
                        begin
                            writeln(prr, 'l', segsize : 4, '=', lcmax);
                            writeln(prr, 'l', stacktop : 4, '=', topmax)
                        end
                end
            else
                begin
                    gen1(42, ord('p'));(*ret*)
                    align(parmptr, lcmax);
                    if prcode then
                        begin
                            writeln(prr, 'l', segsize : 4, '=', lcmax);
                            writeln(prr, 'l', stacktop : 4, '=', topmax);
                            writeln(prr, 'q')
                        end;
                    ic := 0;
      (*generate call of main program; note that this call must be loaded}
{        at absolute address zero*)
                    gen1(41, 0);(*mst*)
                    gencupent(46, 0, entname);(*cup*)
                    gen0(29);(*stp*)
                    if prcode then
                        writeln(prr, 'q');
                    saveid := id;
                    while fextfilep <> nil do
                        begin
                            with fextfilep^ do
                                if not ((filename = 'input   ') or (filename = 'output  ') or (filename = 'prd     ') or (filename = 'prr     ')) then
                                    begin
                                        id := filename;
                                        searchid([vars], llcp);
                                        if llcp^.idtype <> nil then
                                            if llcp^.idtype^.form <> files then
                                                begin
                                                    writeln(output);
                                                    writeln(output, ' ' : 8, 'undeclared ', 'external ', 'file', fextfilep^.filename : 8);
                                                    write(output, ' ' : chcnt + 16)
                                                end
                                    end;
                            fextfilep := fextfilep^.nextfile
                        end;
                    id := saveid;
                    if prtables then
                        begin
                            writeln(output);
                            printtables(true)
                        end
                end;
        end; (*body*)

    begin (*block*)
        dp := true;
        repeat
            if sy = labelsy then
                begin
                    insymbol;
                    labeldeclaration(fsys) {FIX!!!}
                end;
            if sy = constsy then
                begin
                    insymbol;
                    constdeclaration(fsys) {FIX!!!}
                end;
            if sy = typesy then
                begin
                    insymbol;
                    typedeclaration(fsys) {FIX!!!}
                end;
            if sy = varsy then
                begin
                    insymbol;
                    vardeclaration(fsys) {FIX!!!}
                end;
            while sy in [procsy, funcsy] do
                begin
                    lsy := sy;
                    insymbol;
                    procdeclaration(lsy)
                end;
            if sy <> beginsy then
                begin
                    error(18);
                    skip(fsys)
                end
        until (sy in statbegsys) or eof(input);
        dp := false;
        if sy = beginsy then
            insymbol
        else
            error(17);
        repeat
            body(fsys + [casesy]);
            if sy <> fsy then
                begin
                    error(6);
                    skip(fsys)
                end
        until ((sy = fsy) or (sy in blockbegsys)) or eof(input);
    end; (*block*)
end.