                        {file TYP}

procedure routinetype(*fsys: setofsys; var fsp: stp; fsy: symbol*);
  var lsp: stp; llc: addrrange; oldtop: disprange;
  begin
  new(lsp,prok);
  with lsp^ do
    begin form := prok; params := nil; info := sysinfo;
    ispackable := false; sizeoflo := false;
    unpacksize := PROKSIZE; align := PROKALIGN;
    parmlc := 0;
    if sy = lparent then
      begin
      llc := lc; lc := lcaftermarkstack;
      oldtop := top;
      if top < displimit then
        begin top := top + 1;
        with display[top] do
          begin
          fname := nil; occur := BLOCKscope;
          fmodule := nil; ffile := nil;
          flabel := nil; available_module := nil;
          end;
        end
      else error(662);
      if fsy = procsy then
        parameterlist(fsys,[semicolon],params,parmlc,false,0)
      else parameterlist(fsys,[semicolon,colon],params,parmlc,false,0);
      lc := llc;
      top := oldtop;
      end;
    end;
  fsp := lsp;
  end;

PROCEDURE TYP (FSYS: SETOFSYS; VAR FSP: STP);
  VAR LSP,LSP1: STP; OLDTOP: DISPRANGE; llc: addrrange;
      DISPL: ADDRRANGE; NEXTBIT,maxfldalign: shortint;
      PACKING: BOOLEAN; LMIN,LMAX: integer; linfo: infobits;
      lcproot: ctp;

  PROCEDURE SIMPLETYPE (FSYS: SETOFSYS; VAR FSP: STP);
    VAR LSP,LSP1: STP;
        LCP,LCP1: CTP;
        TTOP: DISPRANGE;
        LVALU: VALU;
        LCNT,minbits,maxbits: shortint;
        minsign,maxsign,test: boolean;
    BEGIN
    IF NOT (SY IN SIMPTYPEBEGSYS) THEN
      BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END;
    IF SY IN SIMPTYPEBEGSYS THEN
      BEGIN
      IF SY = LPARENT THEN
        BEGIN                                 {Enumerated type}
        TTOP := TOP;
        WHILE DISPLAY[TOP].OCCUR in [RECORDscope,WITHscope] DO TOP := TOP - 1;
        NEW(LSP,SCALAR,DECLARED);
        WITH LSP^ DO
          BEGIN FORM := SCALAR;
          unpacksize := SCALARSIZE; align := SCALARALIGN; sizeoflo := false;
          ispackable := true; signbit := false;
          SCALKIND := DECLARED; info := linfo
          END;
        LCP1 := NIL; LCNT := 0;
        REPEAT INSYMBOL;
          IF SY = IDENT THEN
            BEGIN NEW(LCP,KONST);
              WITH LCP^ DO
                BEGIN newident(namep,ID); IDTYPE := LSP; NEXT := LCP1;
                   KLASS := KONST; info := linfo;
                   values.intval := true; values.IVAL := LCNT;
                END;
              ENTERID(LCP);
              LCNT := LCNT + 1;
              LCP1 := LCP; INSYMBOL
            END
          ELSE ERROR(2);
          IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
            BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
        UNTIL SY <> COMMA;
        LSP^.FCONST := LCP1;
        countbits(lcnt-1,lcnt,maxsign);
        LSP^.bitsize := lcnt;
        TOP := TTOP;
        IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
        END (*SY=LPARENT*)
      ELSE
        BEGIN
        IF SY = IDENT THEN    {Is it type name or subrange declaration?}
          begin SEARCHID([FUNC,TYPES,KONST],LCP);
          test:=(LCP^.KLASS = TYPES);
          end
        else test:=false;
        if test then
          BEGIN                               {Type name}
          if disx = disdef.level then
            if lcp^.namep^ = disdef.id^ then
              error(190);
          INSYMBOL;
          LSP := LCP^.IDTYPE;
          IF LSP = STRGPTR then
            if SY <> LBRACK THEN error(732)
            else
              BEGIN INSYMBOL;
              CONSTANT(FSYS + [RBRACK],LSP1,LVALU);
              IF LSP1 = INTPTR THEN
                BEGIN
                IF (LVALU.IVAL <= 0) OR
                   (LVALU.IVAL > STRGLGTH) THEN
                  BEGIN ERROR(678); LVALU.IVAL := STRGLGTH END;
                NEW(LSP);
                LSP^ := STRGPTR^;
                WITH LSP^ DO
                  BEGIN
                  MAXLENG := LVALU.IVAL; info := linfo;
                  unpacksize := LVALU.IVAL+1                  {*********}
                  END;
                END
              ELSE ERROR(15);
              IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
              END; (*string length*)
          END (*if test*)
        ELSE
          BEGIN                               {Subrange}
          CONSTANT(FSYS + [rangesy],LSP1,LVALU);
          if lsp1 <> nil then
            if lsp1^.form <> scalar then
              BEGIN ERROR(107); LSP1 := NIL END;
          NEW(LSP,SUBRANGE);
          WITH LSP^ DO
            BEGIN
            FORM := SUBRANGE;
            info := linfo;
            sizeoflo:=false;
            if lsp1<>nil then
              begin
              unpacksize := lsp1^.unpacksize;
              align:=lsp1^.align;
              min := lvalu.ival;
              end
            else
              begin
              unpacksize:=wordsize;
              align:=wordalign;
              min := 0;
              end;
            RANGETYPE := LSP1;
            END;
          IF SY = rangesy THEN INSYMBOL ELSE ERROR(22);
          CONSTANT(FSYS,LSP1,LVALU);
          WITH LSP^ DO
            begin
            if lsp1 <> NIL then
              begin
              MAX := LVALU.ival;
              if (rangetype <> NIL) and
                 (RANGETYPE <> LSP1) THEN ERROR(107);
              end
            else
              max := min;
            IF MIN > MAX THEN
              BEGIN ERROR(102); MAX := MIN END;
            countbits(min,minbits,minsign);             {Size it}
            countbits(max,maxbits,maxsign);
            if minbits>maxbits then maxbits:=minbits;
{*** For machines without sign extension, change next line to
                              ... then maxbits:=bitsperword;          ***}
            if minsign or maxsign then maxbits:=maxbits+1;
            if maxbits<bitsperword then
              begin           {packable!}
              ispackable := true; bitsize := maxbits;
              signbit := (minsign or maxsign);
              if (maxbits+ord(not signbit) <=  bitsperaddr*shortintsize)
                   and (rangetype = intptr) then
                begin unpacksize := shortintsize; rangetype := shortintptr end;
              end
            else
              ispackable := false;     {not packable}
            end;
          END;  (*subrange*)
        END;
      FSP := LSP;
      IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END
      END (*SY IN SIMPTYPEBEGSYS*)
    ELSE FSP := NIL
    END (*SIMPLETYPE*) ;

  procedure setrecordsize (fsp: stp);
    { set the size fields in a record or variant node }
    { Uses DISPL, MAXFLDALIGN, and NEXTBIT variables }
    begin
    with fsp^ do
      begin
      if nextbit>0 then
        unpacksize := displ + (nextbit+bitsperaddr-1) div bitsperaddr
      else unpacksize := displ;
      sizeoflo := false;
      if (unpacksize = 1) and (maxfldalign = 1) then
        align := 1
      else align := wordalign;
      if (displ=0) and (nextbit<bitsperword) and not packing then
        begin
        ispackable := true; signbit := false;
        bitsize := nextbit;
        end
      else
        ispackable := false;
      end
    end;

  PROCEDURE FIELDLIST (FSYS: SETOFSYS; VAR FRECVAR: STP;
                       var finfo: infobits; var lcproot: ctp);
    VAR lcproot1,LCP,LCP1,PREVLCP: CTP; LSP: STP; TEST: BOOLEAN;
        foundfixedpart: boolean;

    PROCEDURE FLDALLOC (FCP: CTP);
      { allocate the given field in current record }
      VAR t: shortint;
      BEGIN
      WITH FCP^ DO
        if idtype = nil then          {punt}
          begin fldaddr:=0; fispackd:=false end
        ELSE IF PACKING AND (idtype^.ispackable) THEN
          BEGIN                       {Allocate packed field}
          if nextbit=0 then
            begin                     {ensure DISPL is word aligned}
            t := DISPL mod wordalign;
            if t<>0 then
              begin DISPL := DISPL-t;   {back up to previous word boundary}
              nextbit := t*bitsperaddr; {set NEXTBIT to skip used part}
              end;
            end;
          try
            $ovflcheck on$
            while (idtype^.bitsize + NEXTBIT) > BITSPERWORD do {** B.R. 4/80 **}
              BEGIN DISPL := DISPL + 2; NEXTBIT := nextbit-16;
              if nextbit < 0 then nextbit := 0;
              END;
            $if not ovflchecking$
              $ovflcheck off$
            $end$
          recover
            if escapecode = -4 { integer ovfl } then
              begin
              error(672);
              displ := 0;
              nextbit := 0;
              end
            else escape(escapecode);
          FLDADDR := DISPL; FISPACKD := TRUE;
          FLDFBIT := NEXTBIT;
          NEXTBIT := NEXTBIT + idtype^.bitsize;
          if ((fldfbit = 0) or (fldfbit = 16)) and
             (idtype^.bitsize = 16) and idtype^.signbit then
             begin
             fldaddr := fldaddr + fldfbit DIV 8;
             fispackd := false;
             strucwaspackd := true;
             end;
          if maxfldalign < wordalign then maxfldalign := wordalign;
          END
        ELSE
          BEGIN                       {Allocate unpacked field}
          if nextbit>0 then
            begin
            try
              $ovflcheck on$
              DISPL := DISPL + (nextbit+bitsperaddr-1) div bitsperaddr;
              $if not ovflchecking$
                $ovflcheck off$
              $end$
            recover
              if escapecode = -4 { integer ovfl } then
                begin error(672); displ := 0; end
              else escape(escapecode);
            NEXTBIT := 0;
            end;
          FISPACKD := FALSE;
          strucwaspackd := packing;
          FLDADDR := allocate(DISPL, idtype, true,1);
          if maxfldalign < idtype^.align then maxfldalign := idtype^.align;
          END
      END (*FLDALLOC*) ;

    PROCEDURE VARIANTLIST;
      label 1,2;
      VAR GOTTAGNAME,TEST: BOOLEAN;
          linfo: infobits;
          LCP,LCP1: CTP;
          LSP,LSP1,LSP2,LSP3,LSP4,lspt: STP;
          MINSIZE,MAXSIZE: ADDRRANGE;
          testval: varlab;
          LVALU: VALU;
          MAXBIT,MINBIT: BITRANGE;
          t1, t2 : addrrange;

      BEGIN NEW(LSP,TAGFLD); linfo := sysinfo;
      WITH LSP^ DO
        BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM := TAGFLD;
          info := linfo;
        END;
      FRECVAR := LSP;
      INSYMBOL;
      IF SY = IDENT THEN
        BEGIN
        IF PACKING THEN NEW(LCP,FIELD,TRUE)
        ELSE NEW(LCP,FIELD,FALSE);
        WITH LCP^ DO
          BEGIN namep := nil; IDTYPE := NIL; KLASS:=FIELD;
            NEXT := NIL; FISPACKD := FALSE; info := linfo
          END;
        GOTTAGNAME := FALSE; PRTERR := FALSE;
        SEARCHID([TYPES],LCP1); PRTERR := TRUE;
        INSYMBOL;
        IF (LCP1 = NIL) or (sy = colon) THEN
          BEGIN
          GOTTAGNAME := TRUE; foundfixedpart := true;
          if prevlcp <> nil then prevlcp^.next := lcp;
          prevlcp := lcp;
          if lcproot = nil then lcproot := lcp;
          newident(LCP^.NAMEP,ID); ENTERID(LCP);
          IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
          IF SY = IDENT THEN
            BEGIN
            SEARCHID([TYPES],LCP1);
            INSYMBOL;
            END
          ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END
          END;
        if lcp1 <> NIL then
          LSP1 := LCP1^.IDTYPE
        else
          lsp1 := NIL;
        IF LSP1 <> NIL THEN
          IF LSP1^.FORM <= SUBRANGE THEN
            BEGIN
            LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP;
            IF GOTTAGNAME THEN FLDALLOC(LCP)
            END
          ELSE ERROR(110);
        END
      ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END;
      lsp^.hasfixedpart := foundfixedpart; setrecordsize(LSP);
      IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
      LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
      MINBIT := NEXTBIT; MAXBIT := NEXTBIT;
      REPEAT LSP2 := NIL;
        REPEAT CONSTANT(FSYS + [COMMA,rangesy,COLON,LPARENT],LSP3,LVALU);
          IF LSP^.TAGFIELDP <> NIL THEN
            IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3) THEN
              ERROR(111);
          NEW(LSP3,VARIANT);
          WITH LSP3^ DO
            BEGIN NXTVAR := LSP1; SUBVAR := LSP2; vflds := nil;
              VARVAL.lo := LVALU.ival; FORM := VARIANT; info := linfo;
            END;
          if sy = rangesy then
            begin
            if stdpasc then error(606);
            insymbol;
            CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP2,LVALU);
            if lsp^.tagfieldp <> NIL then
              if not comptypes(lsp^.tagfieldp^.idtype,lsp2) then
                error(111);
            end;
          lsp3^.varval.hi := lvalu.ival;
          if lsp3^.varval.lo > lvalu.ival then
            error(102);
          LSP1 := LSP3; LSP2 := LSP3;
          TEST := SY <> COMMA;
          IF NOT TEST THEN INSYMBOL
        UNTIL TEST;
        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
        IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
        IF SY = RPARENT THEN LSP2 := NIL
        ELSE { link a particular variant with its associated fields.
               The fields are linked together through their NEXT field }
          begin lcproot1 := nil;
          linfo := sysinfo;
          FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2,linfo,lcproot1);
          lspt := lsp1;
          while lspt <> nil do
            if lspt^.vflds = nil then
              begin lspt^.vflds := lcproot1; lspt := lspt^.nxtvar end
            else goto 2;
       2: if mustinitialize in linfo then error(707);
          finfo := finfo + (linfo * [cantassign]);
          end;
        t1 := displ + (nextbit div bitsperaddr);
        t2 := maxsize + (maxbit div bitsperaddr);
        if (t1 > t2) or
                ((t1 = t2) and ( (nextbit mod bitsperaddr) >
                                  (maxbit mod bitsperaddr) ) ) then
          begin
            maxsize := displ;
            maxbit := nextbit;
          end;
        WHILE LSP3 <> NIL DO
          BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2;
            setrecordsize(LSP3);
            LSP3 := LSP4
          END;
        IF SY = RPARENT THEN
          BEGIN INSYMBOL;
            IF NOT (SY IN FSYS + [SEMICOLON]) THEN
              BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END
          END
        ELSE ERROR(4);
        TEST := SY <> SEMICOLON;
        IF NOT TEST THEN
          BEGIN INSYMBOL;
            DISPL := MINSIZE; NEXTBIT := MINBIT
          END
      UNTIL TEST OR (SY=ENDSY);
      DISPL := MAXSIZE; NEXTBIT := MAXBIT;
      LSP^.FSTVAR := LSP1;
      while lsp1 <> nil do
        begin testval := lsp1^.varval;
        lsp2 := lsp1^.nxtvar;
        while lsp2 <> nil do
          with lsp2^.varval do
            if ((testval.lo >= lo) and (testval.lo <= hi)) or
               ((testval.hi >= lo) and (testval.hi <= hi)) or
               ((testval.lo <  lo) and (testval.hi >  hi)) then
              begin error(156); goto 1 end
            else lsp2 := lsp2^.nxtvar;
        lsp1 := lsp1^.nxtvar;
        end;
   1: END (*VARIANTLIST*) ;

    BEGIN (*FIELDLIST*)
    foundfixedpart := false;
    prevlcp := nil;
    IF NOT (SY IN [IDENT,CASESY,endsy]) THEN
      BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END;
    WHILE SY = IDENT DO
      BEGIN
        foundfixedpart := true;
        lcp1 := nil;
        REPEAT
          IF SY = IDENT THEN
            BEGIN
              IF PACKING THEN NEW(LCP,FIELD,TRUE)
              ELSE NEW(LCP,FIELD,FALSE);
              WITH LCP^ DO
                BEGIN newident(namep,ID); IDTYPE := NIL; NEXT := NIL;
                  KLASS := FIELD; FISPACKD := FALSE; info := linfo
                END;
              if lcproot = nil then lcproot := lcp;
              if prevlcp <> nil then prevlcp^.next:=lcp;
              prevlcp := lcp;
              if lcp1=nil then lcp1 := lcp;
              ENTERID(LCP);
              INSYMBOL
            END
          ELSE ERROR(2);
          IF NOT (SY IN [COMMA,COLON]) THEN
            BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END;
          TEST := SY <> COMMA;
          IF NOT TEST THEN INSYMBOL
        UNTIL TEST;
        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
        TYP(FSYS + [CASESY,SEMICOLON],LSP);
        IF LSP <> NIL THEN
          finfo := finfo + (lsp^.info * [mustinitialize,cantassign]);
        WHILE LCP1 <> NIL DO      {attach type ptr & allocate space}
          WITH LCP1^ DO
            BEGIN IDTYPE := LSP; FLDALLOC(LCP1); LCP1 := NEXT END;
        IF SY = SEMICOLON THEN
          BEGIN INSYMBOL;
            IF NOT (SY IN [IDENT,ENDSY,CASESY,rparent]) THEN
              BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END
          END
      END (*WHILE*);
    IF SY = CASESY THEN VARIANTLIST
    ELSE FRECVAR := NIL
    END (*FIELDLIST*) ;

  PROCEDURE POINTERTYPE;
    VAR LSP: STP; LCP: CTP;
    BEGIN NEW(LSP,POINTER); FSP := LSP;
    WITH LSP^ DO
      BEGIN ELTYPE := NIL; FORM := POINTER;
      ispackable := false; sizeoflo := false;
      unpacksize := PTRSIZE; align := PTRALIGN;
      info := linfo;
      END;
    INSYMBOL;
    IF SY = IDENT THEN
      BEGIN NEW(LCP,TYPES);
      WITH LCP^ DO
        BEGIN newident(namep,ID); IDTYPE := LSP;
        NEXT := FWPTR; KLASS := TYPES;
        END;
      FWPTR := LCP;
      INSYMBOL;
      END
    ELSE ERROR(2)
    END (*POINTERTYPE*) ;

  procedure arraytype;
    var LSP,LSP1,LSP2: STP;
        LSIZE: addrrange;
        TEST,packit,itfits: BOOLEAN;
        numbits,elsperbyte: shortint;
        numelements,lmin,lmax: integer;

    procedure checkarray(aelsize: addrrange; inxtype: stp);
      { check if aelsize*lowerbound will overflow}
      var dummy: integer;
      begin
      try
      $ovflcheck on$
        dummy := lmin*aelsize;
      $if not ovflchecking$
        $ovflcheck off$
      $end$
      recover
        if escapecode = -4 {integer overflow} then
          begin error(697);
          if inxtype <> nil then
            if inxtype^.form = subrange then
              inxtype^.min := 0;
          end;
      end; {checkarray}

    BEGIN INSYMBOL;
    IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11);
    LSP1 := NIL;
    REPEAT
      NEW(LSP,ARRAYS);
      WITH LSP^ DO
        BEGIN AELTYPE := LSP1; INXTYPE := NIL;
          strucwaspackd := packing;
          ispackable := false; sizeoflo := false;
          unpacksize := wordsize; align := wordalign;
          AISPACKD := FALSE; aelsize := wordsize;
          FORM := ARRAYS; info := linfo; aisstrng := false;
        END;
      LSP1 := LSP;
      SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2);
      IF LSP2 <> NIL THEN
        IF LSP2^.FORM <= SUBRANGE THEN
          IF LSP2 = INTPTR THEN ERROR(149)
          ELSE LSP^.INXTYPE := LSP2
        ELSE ERROR(113);
      TEST := SY <> COMMA;
      IF NOT TEST THEN INSYMBOL
    UNTIL TEST;
    IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
    IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
    TYP(FSYS,LSP);
    REPEAT
      WITH LSP1^ DO
        BEGIN LSP2 := AELTYPE; AELTYPE := LSP;
        IF LSP <> NIL THEN
          info := linfo + (lsp^.info * [mustinitialize,cantassign]);
        IF (INXTYPE <> NIL) and (AELTYPE <> NIL) THEN
          BEGIN
{***** Compute array element size *****}
          packit := PACKING and aeltype^.ispackable;
          IF packit THEN
            BEGIN         {packable array}
            numbits := aeltype^.bitsize;
            if numbits+numbits > BITSPERWORD then packit := false
            else
              begin
              {*** 1,2,4,8,16 bit arrays only ***}
              if numbits > 8 then numbits := 16
              else if numbits > 4 then numbits := 8
              else if numbits = 3 then numbits := 4;
              end
            END;
          if packit then
            begin
            AISPACKD := TRUE; AISSTRNG := FALSE;
            aelbitsize := numbits;
            align := wordalign;
            end
          else
            begin
            AISPACKD := FALSE;
            with aeltype^ do
              begin
              if sizeoflo then error(675);
              lsize := ((unpacksize + align-1) div align) * align;
              end;
            aelsize := lsize;
            align := wordalign;
            end;
{***** Compute size of whole array *****}
          sizeoflo := true;      {assume the worst}
          GETBOUNDS(INXTYPE,LMIN,LMAX);
          if lmax < 0 then itfits := (lmax<lmin+maxint)
          else itfits := (lmax-maxint<lmin);
          if itfits then    {number of elements is computable}
            begin
            numelements := LMAX-LMIN+1;
            if AISPACKD then
              if aelbitsize = 16 then
                begin             {HALF ARRAY}
                itfits := numelements < (maxint DIV 2);
                if itfits then lsize := numelements*2;
                checkarray(2,inxtype);
                end
              else
                begin
                itfits := true;
                if aelbitsize = 0 then
                  lsize := 0
                else
                  begin
                  elsperbyte := bitsperaddr DIV aelbitsize;
                  lsize := (numelements + (elsperbyte-1)) DIV elsperbyte;
                  end;
                end
            else
              begin         {unpacked array}
              if aeltype^.sizeoflo then itfits := false
              else itfits := (aelsize <= (maxint div numelements));
              if itfits then lsize := numelements * aelsize;
              checkarray(aelsize,inxtype);
              end;
            if itfits then
              begin unpacksize := lsize; sizeoflo := false end;
            end
          END
        END;
      LSP := LSP1; LSP1 := LSP2
    UNTIL LSP1 = NIL;
    FSP := LSP;
    END; (* arraytype *)

  BEGIN (*TYP*)
    PACKING := FALSE; linfo := sysinfo;
    IF NOT (SY IN TYPEBEGSYS) THEN
      BEGIN ERROR(10); SKIP(FSYS + TYPEBEGSYS) END;
    IF SY IN TYPEBEGSYS THEN
      BEGIN
      IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP)
{ ^ } ELSE IF SY = ARROW THEN POINTERTYPE
      ELSE
        BEGIN
          IF SY = PACKEDSY THEN
            BEGIN INSYMBOL; PACKING := TRUE;
            IF NOT (SY IN TYPEDELS) THEN
              BEGIN ERROR(10); SKIP(FSYS+TYPEDELS) END
            END;
{ARRAY}   IF SY = ARRAYSY THEN arraytype
{RECORD}  ELSE IF SY = RECORDSY THEN
            BEGIN INSYMBOL;
              OLDTOP := TOP;
              IF TOP < DISPLIMIT THEN
                BEGIN TOP := TOP + 1;
                  WITH DISPLAY[TOP] DO
                    BEGIN FNAME := NIL; OCCUR := RECORDscope END
                END
              ELSE ERROR(662);
              DISPL := 0; NEXTBIT := 0; maxfldalign := 1;
              lcproot := nil;
              FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1,linfo,lcproot);
              NEW(LSP,RECORDS);
              WITH LSP^ DO
                BEGIN FSTFLD := DISPLAY[TOP].FNAME;
                  RECVAR := LSP1; setrecordsize(LSP);
                  FORM := RECORDS; info := linfo
                END;
              TOP := OLDTOP;
              IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13);
              FSP := LSP
            END
{SET}     ELSE IF SY = SETSY THEN
            BEGIN INSYMBOL;
              IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
              SIMPLETYPE(FSYS,LSP1);
              IF LSP1 <> NIL THEN
                IF LSP1^.FORM > SUBRANGE THEN
                  BEGIN ERROR(115); LSP1 := NIL END
                ELSE IF LSP1=INTPTR THEN
                  BEGIN ERROR(169); LSP1 := NIL END;
              NEW(LSP,POWER);
              WITH LSP^ DO
                BEGIN ELSET := LSP1; FORM := POWER;
                info := linfo;
                ispackable := false; sizeoflo := false;
                unpacksize := 0 {SETSIZE}; align := SETALIGN;
                setmin := SETLOW; setmax := SETHIGH;
                IF LSP1 <> NIL THEN
                  BEGIN GETBOUNDS(LSP1,LMIN,LMAX);
                  if (lmin<SETLOW) or (lmax>SETHIGH) then
                    error(658)
                  else
                    begin                          {Compute set size}
                    setmax := LMAX;
                    setmin := LMIN;
                    unpacksize := setlensize + SETELEMSIZE *
                           ((LMAX + SETELEMBITS) DIV SETELEMBITS)
                    end;
                  END
                END;
              FSP := LSP
            END
{FILE}    ELSE IF SY = FILESY THEN
            BEGIN
            INSYMBOL; NEW(LSP,FILES);
            WITH LSP^ DO
              BEGIN
              ispackable := false; sizeoflo := false;
              align := wordalign; FORM := FILES;
              info := linfo + [mustinitialize, cantassign];
              IF SY = OFSY THEN
                BEGIN
                INSYMBOL;
                TYP(FSYS,FILTYPE);
                if filtype <> NIL then
                  if (filtype^.unpacksize <= 0) or
                     (filtype^.unpacksize > 32766) then
                    error(673)
                  else if mustinitialize in filtype^.info
                    then error(183);
                END
              ELSE
                begin
                if not ucsd then error(607);
                FILTYPE := NIL;
                end;
              if filtype = nil then unpacksize := nilfilesize
              else unpacksize := filesize + filtype^.unpacksize;
              END;
            FSP := LSP;
            END
{PROC}    else if sy = procsy then
            begin
            if not (modcal or sysprog) then
              error(612);
            insymbol;
            routinetype(fsys,fsp,procsy);
            end;
        END;
      IF NOT (SY IN FSYS) THEN BEGIN ERROR(6); SKIP(FSYS) END
      END (* sy in typebegsys *)
    ELSE FSP := NIL;
  END; (*TYP*)


