fpc/compiler/ptype.pas

{
    Copyright (c) 1998-2002 by Florian Klaempfl

    Does parsing types for Free Pascal

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit ptype;

{$i fpcdefs.inc}

interface

    uses
       globtype,cclasses,
       symtype,symdef,symbase;

    type
      TSingleTypeOption=(
        stoIsForwardDef,          { foward declaration         }
        stoAllowTypeDef,          { allow type definitions     }
        stoAllowSpecialization,   { allow type specialization  }
        stoParseClassParent       { parse of parent class type }
      );
      TSingleTypeOptions=set of TSingleTypeOption;

    procedure resolve_forward_types;

    { reads a string, file type or a type identifier }
    procedure single_type(var def:tdef;options:TSingleTypeOptions);

    { reads any type declaration, where the resulting type will get name as type identifier }
    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);

    { reads any type declaration }
    procedure read_anon_type(var def : tdef;parseprocvardir:boolean);

    { generate persistent type information like VMT, RTTI and inittables }
    procedure write_persistent_type_info(st:tsymtable;is_global:boolean);

    { add a definition for a method to a record/objectdef that will contain
      all code for initialising typed constants (only for targets in
      systems.systems_typed_constants_node_init) }
    procedure add_typedconst_init_routine(def: tabstractrecorddef);

    { parse hint directives (platform, deprecated, ...) for a procdef }
    procedure maybe_parse_hint_directives(pd:tprocdef);

implementation

    uses
       { common }
       cutils,
       { global }
       globals,tokens,verbose,constexp,
       systems,
       { target }
       paramgr,procinfo,
       { symtable }
       symconst,symsym,symtable,symcreat,
       defutil,defcmp,
{$ifdef jvm}
       jvmdef,
{$endif}
       { modules }
       fmodule,
       { pass 1 }
       node,ncgrtti,nobj,
       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
       { parser }
       scanner,
       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
{$ifdef jvm}
       ,pjvm
{$endif}
       ;


    procedure maybe_parse_hint_directives(pd:tprocdef);
      var
        dummysymoptions : tsymoptions;
        deprecatedmsg : pshortstring;
      begin
        dummysymoptions:=[];
        deprecatedmsg:=nil;
        while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
          Consume(_SEMICOLON);
        if assigned(pd) then
          begin
            pd.symoptions:=pd.symoptions+dummysymoptions;
            pd.deprecatedmsg:=deprecatedmsg;
          end
        else
          stringdispose(deprecatedmsg);
      end;


    procedure resolve_forward_types;
      var
        i: longint;
        hpd,
        def : tdef;
        srsym  : tsym;
        srsymtable : TSymtable;
        hs : string;
      begin
        for i:=0 to current_module.checkforwarddefs.Count-1 do
          begin
            def:=tdef(current_module.checkforwarddefs[i]);
            case def.typ of
              pointerdef,
              classrefdef :
                begin
                  { classrefdef inherits from pointerdef }
                  hpd:=tabstractpointerdef(def).pointeddef;
                  { still a forward def ? }
                  if hpd.typ=forwarddef then
                   begin
                     { try to resolve the forward }
                     if not assigned(tforwarddef(hpd).tosymname) then
                       internalerror(200211201);
                     hs:=tforwarddef(hpd).tosymname^;
                     searchsym(upper(hs),srsym,srsymtable);
                     { we don't need the forwarddef anymore, dispose it }
                     hpd.free;
                     tabstractpointerdef(def).pointeddef:=nil; { if error occurs }
                     { was a type sym found ? }
                     if assigned(srsym) and
                        (srsym.typ=typesym) then
                      begin
                        tabstractpointerdef(def).pointeddef:=ttypesym(srsym).typedef;
                        { avoid wrong unused warnings web bug 801 PM }
                        inc(ttypesym(srsym).refs);
                        { we need a class type for classrefdef }
                        if (def.typ=classrefdef) and
                           not(is_class(ttypesym(srsym).typedef)) and
                           not(is_objcclass(ttypesym(srsym).typedef)) and
                           not(is_javaclass(ttypesym(srsym).typedef)) then
                          MessagePos1(def.typesym.fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
                        { this could also be a generic dummy that was not
                          overridden with a specific type }
                        if (sp_generic_dummy in srsym.symoptions) and
                            (
                              (ttypesym(srsym).typedef.typ=undefineddef) or
                              (
                                { or an unspecialized generic symbol, which is
                                  the case for generics defined in non-Delphi
                                  modes }
                                (df_generic in ttypesym(srsym).typedef.defoptions) and
                                not parse_generic
                              )
                            ) then
                          MessagePos(def.typesym.fileinfo,parser_e_no_generics_as_types);
                      end
                     else
                      begin
                        Message1(sym_e_forward_type_not_resolved,hs);
                        { try to recover }
                        tabstractpointerdef(def).pointeddef:=generrordef;
                      end;
                   end;
                end;
              objectdef :
                begin
                  { give an error as the implementation may follow in an
                    other type block which is allowed by FPC modes }
                  if not(m_fpc in current_settings.modeswitches) and
                     (oo_is_forward in tobjectdef(def).objectoptions) then
                    MessagePos1(def.typesym.fileinfo,type_e_type_is_not_completly_defined,def.typename);
                 end;
              else
                internalerror(200811071);
            end;
          end;
        current_module.checkforwarddefs.clear;
      end;


    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); forward;


    { def is the outermost type in which other types have to be searched

      isforward indicates whether the current definition can be a forward definition

      if assigned, currentstructstack is a list of tabstractrecorddefs that, from
      last to first, are child types of def that are not yet visible via the
      normal symtable searching routines because they are types that are currently
      being parsed (so using id_type on them after pushing def on the
      symtablestack would result in errors because they'd come back as errordef)
    }
    procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist);
      var
        t2: tdef;
        structstackindex: longint;
        srsym: tsym;
        srsymtable: tsymtable;
        oldsymtablestack: TSymtablestack;
      begin
        if assigned(currentstructstack) then
          structstackindex:=currentstructstack.count-1
        else
          structstackindex:=-1;
        { handle types inside classes, e.g. TNode.TLongint }
        while (token=_POINT) do
          begin
             if is_class_or_object(def) or is_record(def) or is_java_class_or_interface(def) then
               begin
                 if (def.typ=objectdef) then
                   def:=find_real_class_definition(tobjectdef(def),false);
                 consume(_POINT);
                 if (structstackindex>=0) and
                    (tabstractrecorddef(currentstructstack[structstackindex]).objname^=pattern) then
                   begin
                     def:=tdef(currentstructstack[structstackindex]);
                     dec(structstackindex);
                     consume(_ID);
                   end
                 else
                   begin
                     structstackindex:=-1;
                     oldsymtablestack:=symtablestack;
                     symtablestack:=TSymtablestack.create;
                     symtablestack.push(tabstractrecorddef(def).symtable);
                     t2:=generrordef;
                     id_type(t2,isforwarddef,false,false,srsym,srsymtable);
                     symtablestack.pop(tabstractrecorddef(def).symtable);
                     symtablestack.free;
                     symtablestack:=oldsymtablestack;
                     def:=t2;
                   end;
               end
             else
               break;
          end;
      end;


    function try_parse_structdef_nested_type(out def: tdef; basedef: tabstractrecorddef; isfowarddef: boolean): boolean;
      var
        structdef : tdef;
        structdefstack : tfpobjectlist;
      begin
         def:=nil;
         { use of current parsed object:
           classes, objects, records can be used also in themself }
         structdef:=basedef;
         structdefstack:=nil;
         while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
           begin
             if (tabstractrecorddef(structdef).objname^=pattern) then
               begin
                 consume(_ID);
                 def:=structdef;
                 { we found the top-most match, now check how far down we can
                   follow }
                 structdefstack:=tfpobjectlist.create(false);
                 structdef:=basedef;
                 while (structdef<>def) do
                   begin
                     structdefstack.add(structdef);
                     structdef:=tabstractrecorddef(structdef.owner.defowner);
                   end;
                 parse_nested_types(def,isfowarddef,structdefstack);
                 structdefstack.free;
                 result:=true;
                 exit;
               end;
             structdef:=tdef(tabstractrecorddef(structdef).owner.defowner);
           end;
         result:=false;
      end;

    procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable);
    { reads a type definition }
    { to a appropriating tdef, s gets the name of   }
    { the type to allow name mangling          }
      var
        is_unit_specific : boolean;
        pos : tfileposinfo;
        s,sorg : TIDString;
        t : ttoken;
      begin
         srsym:=nil;
         srsymtable:=nil;
         s:=pattern;
         sorg:=orgpattern;
         pos:=current_tokenpos;
         { use of current parsed object:
           classes, objects, records can be used also in themself }
         if checkcurrentrecdef and
            try_parse_structdef_nested_type(def,current_structdef,isforwarddef) then
           exit;
         { Use the special searchsym_type that search only types }
         searchsym_type(s,srsym,srsymtable);
         { handle unit specification like System.Writeln }
         is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true);
         consume(t);
         { Types are first defined with an error def before assigning
           the real type so check if it's an errordef. if so then
           give an error. Only check for typesyms in the current symbol
           table as forwarddef are not resolved directly }
         if assigned(srsym) and
            (srsym.typ=typesym) and
            ((ttypesym(srsym).typedef.typ=errordef) or
            (not allowgenericsyms and
            (ttypesym(srsym).typedef.typ=undefineddef) and
            not (sp_generic_para in srsym.symoptions))) then
          begin
            Message1(type_e_type_is_not_completly_defined,ttypesym(srsym).realname);
            def:=generrordef;
            exit;
          end;
         { are we parsing a possible forward def ? }
         if isforwarddef and
            not(is_unit_specific) then
           begin
             def:=tforwarddef.create(sorg,pos);
             exit;
           end;
         { unknown sym ? }
         if not assigned(srsym) then
          begin
            Message1(sym_e_id_not_found,sorg);
            def:=generrordef;
            exit;
          end;
         { type sym ? }
         if (srsym.typ<>typesym) then
          begin
            Message(type_e_type_id_expected);
            def:=generrordef;
            exit;
          end;
         { Give an error when referring to an errordef }
         if (ttypesym(srsym).typedef.typ=errordef) then
          begin
            Message(sym_e_error_in_type_def);
            def:=generrordef;
            exit;
          end;
         { In non-Delphi modes the class/record name of a generic might be used
           in the declaration of sub types without type parameters; in that case
           we need to check by name as the link from the dummy symbol to the
           current type is not yet established }
         if (sp_generic_dummy in srsym.symoptions) and
             assigned(current_structdef) and
             (df_generic in current_structdef.defoptions) and
             (ttypesym(srsym).typedef.typ=undefineddef) and
             not (m_delphi in current_settings.modeswitches) then
           begin
             def:=get_generic_in_hierarchy_by_name(srsym,current_structdef);
             if assigned(def) then
               exit;
           end;
        def:=ttypesym(srsym).typedef;
      end;


    procedure single_type(var def:tdef;options:TSingleTypeOptions);
       var
         t2 : tdef;
         dospecialize,
         again : boolean;
         srsym : tsym;
         srsymtable : tsymtable;
       begin
         dospecialize:=false;
         repeat
           again:=false;
             case token of
               _STRING:
                 string_dec(def,stoAllowTypeDef in options);

               _FILE:
                 begin
                    consume(_FILE);
                    if (token=_OF) then
                      begin
                         if not(stoAllowTypeDef in options) then
                           Message(parser_e_no_local_para_def);
                         consume(_OF);
                         single_type(t2,[stoAllowTypeDef]);
                         if is_managed_type(t2) then
                           Message(parser_e_no_refcounted_typed_file);
                         def:=tfiledef.createtyped(t2);
                      end
                    else
                      def:=cfiletype;
                 end;

               _ID:
                 begin
                   if try_to_consume(_SPECIALIZE) then
                     begin
                       if ([stoAllowSpecialization,stoAllowTypeDef] * options = []) then
                         begin
                           Message(parser_e_no_local_para_def);

                           { try to recover }
                           while token<>_SEMICOLON do
                             consume(token);
                           def:=generrordef;
                         end
                       else
                         begin
                           dospecialize:=true;
                           again:=true;
                         end;
                     end
                   else
                     begin
                       id_type(def,stoIsForwardDef in options,true,true,srsym,srsymtable);
                       parse_nested_types(def,stoIsForwardDef in options,nil);
                     end;
                 end;

               else
                 begin
                   message(type_e_type_id_expected);
                   def:=generrordef;
                 end;
            end;
        until not again;
        if ([stoAllowSpecialization,stoAllowTypeDef] * options <> []) and
           (m_delphi in current_settings.modeswitches) then
          dospecialize:=token in [_LSHARPBRACKET,_LT];
        if dospecialize and
            (def.typ=forwarddef) then
          begin
            if not assigned(srsym) or not (srsym.typ=typesym) then
              begin
                Message(type_e_type_is_not_completly_defined);
                def:=generrordef;
                dospecialize:=false;
              end;
          end;
        if dospecialize then
          begin
            if def.typ=forwarddef then
              def:=ttypesym(srsym).typedef;
            generate_specialization(def,stoParseClassParent in options,'',nil,'');
          end
        else
          begin
            if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
              begin
                def:=current_specializedef
              end
            else if (def=current_genericdef) then
              begin
                def:=current_genericdef
              end
            { when parsing a nested specialization in non-Delphi mode it might
              use the name of the topmost generic without type paramaters, thus
              def will contain the generic definition, but we need a reference
              to the specialization of that generic }
            { TODO : only in non-Delphi modes? }
            else if assigned(current_structdef) and
                (df_specialization in current_structdef.defoptions) and
                return_specialization_of_generic(current_structdef,def,t2) then
              begin
                def:=t2
              end
            else if (df_generic in def.defoptions) and
                not
                  (
                    parse_generic and
                    (current_genericdef.typ in [recorddef,objectdef]) and
                    (
                      { if both defs belong to the same generic (e.g. both are
                        subtypes) then we must allow the usage }
                      defs_belong_to_same_generic(def,current_genericdef) or
                      { this is needed to correctly resolve "type Foo=SomeGeneric<T>"
                        declarations inside a generic }
                      sym_is_owned_by(srsym,tabstractrecorddef(current_genericdef).symtable)
                    )
                  )
                then
              begin
                Message(parser_e_no_generics_as_types);
                def:=generrordef;
              end
            else if (def.typ=undefineddef) and
                (sp_generic_dummy in srsym.symoptions) and
                parse_generic and
                (current_genericdef.typ in [recorddef,objectdef]) and
                (Pos(upper(srsym.realname),tabstractrecorddef(current_genericdef).objname^)=1) then
              begin
                if m_delphi in current_settings.modeswitches then
                  begin
                    Message(parser_e_no_generics_as_types);
                    def:=generrordef;
                  end
                else
                  def:=current_genericdef;
              end
            else if is_classhelper(def) and
                not (stoParseClassParent in options) then
              begin
                Message(parser_e_no_category_as_types);
                def:=generrordef
              end
          end;
      end;


    procedure parse_record_members;
      var
        pd : tprocdef;
        oldparse_only: boolean;
        member_blocktype : tblock_type;
        fields_allowed, is_classdef, classfields: boolean;
        vdoptions: tvar_dec_options;
      begin
        { empty record declaration ? }
        if (token=_SEMICOLON) then
          Exit;

        current_structdef.symtable.currentvisibility:=vis_public;
        fields_allowed:=true;
        is_classdef:=false;
        classfields:=false;
        member_blocktype:=bt_general;
        repeat
          case token of
            _TYPE :
              begin
                consume(_TYPE);
                member_blocktype:=bt_type;

                { local and anonymous records can not have inner types. skip top record symtable }
                if (current_structdef.objname^='') or
                   not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) then
                  Message(parser_e_no_types_in_local_anonymous_records);
              end;
            _VAR :
              begin
                consume(_VAR);
                fields_allowed:=true;
                member_blocktype:=bt_general;
                classfields:=is_classdef;
                is_classdef:=false;
              end;
            _CONST:
              begin
                consume(_CONST);
                member_blocktype:=bt_const;
              end;
            _ID, _CASE, _OPERATOR :
              begin
                case idtoken of
                  _PRIVATE :
                    begin
                       consume(_PRIVATE);
                       current_structdef.symtable.currentvisibility:=vis_private;
                       include(current_structdef.objectoptions,oo_has_private);
                       fields_allowed:=true;
                       is_classdef:=false;
                       classfields:=false;
                       member_blocktype:=bt_general;
                     end;
                   _PROTECTED :
                     begin
                       consume(_PROTECTED);
                       current_structdef.symtable.currentvisibility:=vis_protected;
                       include(current_structdef.objectoptions,oo_has_protected);
                       fields_allowed:=true;
                       is_classdef:=false;
                       classfields:=false;
                       member_blocktype:=bt_general;
                     end;
                   _PUBLIC :
                     begin
                       consume(_PUBLIC);
                       current_structdef.symtable.currentvisibility:=vis_public;
                       fields_allowed:=true;
                       is_classdef:=false;
                       classfields:=false;
                       member_blocktype:=bt_general;
                     end;
                   _PUBLISHED :
                     begin
                       Message(parser_e_no_record_published);
                       consume(_PUBLISHED);
                       current_structdef.symtable.currentvisibility:=vis_published;
                       fields_allowed:=true;
                       is_classdef:=false;
                       classfields:=false;
                       member_blocktype:=bt_general;
                     end;
                   _STRICT :
                     begin
                        consume(_STRICT);
                        if token=_ID then
                          begin
                            case idtoken of
                              _PRIVATE:
                                begin
                                  consume(_PRIVATE);
                                  current_structdef.symtable.currentvisibility:=vis_strictprivate;
                                  include(current_structdef.objectoptions,oo_has_strictprivate);
                                end;
                              _PROTECTED:
                                begin
                                  consume(_PROTECTED);
                                  current_structdef.symtable.currentvisibility:=vis_strictprotected;
                                  include(current_structdef.objectoptions,oo_has_strictprotected);
                                end;
                              else
                                message(parser_e_protected_or_private_expected);
                            end;
                          end
                        else
                          message(parser_e_protected_or_private_expected);
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
                        member_blocktype:=bt_general;
                     end
                    else
                    if is_classdef and (idtoken=_OPERATOR) then
                      begin
                        pd:=parse_record_method_dec(current_structdef,is_classdef);
                        fields_allowed:=false;
                        is_classdef:=false;
                      end
                      else
                      begin
                        if member_blocktype=bt_general then
                          begin
                            if (not fields_allowed)and(idtoken<>_CASE) then
                              Message(parser_e_field_not_allowed_here);
                            vdoptions:=[vd_record];
                            if classfields then
                              include(vdoptions,vd_class);
                            read_record_fields(vdoptions,nil);
                          end
                        else if member_blocktype=bt_type then
                          types_dec(true)
                        else if member_blocktype=bt_const then
                          consts_dec(true,true)
                        else
                          internalerror(201001110);
                      end;
                end;
              end;
            _PROPERTY :
              begin
                struct_property_dec(is_classdef);
                fields_allowed:=false;
                is_classdef:=false;
              end;
            _CLASS:
              begin
                is_classdef:=false;
                { read class method/field/property }
                consume(_CLASS);
                { class modifier is only allowed for procedures, functions, }
                { constructors, destructors, fields and properties          }
                if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR,_OPERATOR]) and
                   not((token=_ID) and (idtoken=_OPERATOR)) then
                  Message(parser_e_procedure_or_function_expected);

                is_classdef:=true;
              end;
            _PROCEDURE,
            _FUNCTION:
              begin
                pd:=parse_record_method_dec(current_structdef,is_classdef);
                fields_allowed:=false;
                is_classdef:=false;
              end;
            _CONSTRUCTOR :
              begin
                if not is_classdef then
                  Message(parser_e_no_constructor_in_records);
                if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
                  Message(parser_w_constructor_should_be_public);

                { only 1 class constructor is allowed }
                if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
                  Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^);

                oldparse_only:=parse_only;
                parse_only:=true;
                if is_classdef then
                  pd:=class_constructor_head(current_structdef)
                else
                  pd:=constructor_head;

                parse_only:=oldparse_only;
                fields_allowed:=false;
                is_classdef:=false;
              end;
            _DESTRUCTOR :
              begin
                if not is_classdef then
                  Message(parser_e_no_destructor_in_records);

                { only 1 class destructor is allowed }
                if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then
                  Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^);

                oldparse_only:=parse_only;
                parse_only:=true;
                if is_classdef then
                  pd:=class_destructor_head(current_structdef)
                else
                  pd:=destructor_head;

                parse_only:=oldparse_only;
                fields_allowed:=false;
                is_classdef:=false;
              end;
            _END :
              begin
{$ifdef jvm}
                add_java_default_record_methods_intf(trecorddef(current_structdef));
{$endif}
                if target_info.system in systems_typed_constants_node_init then
                  add_typedconst_init_routine(current_structdef);
                consume(_END);
                break;
              end;
            else
              consume(_ID); { Give a ident expected message, like tp7 }
          end;
        until false;
      end;

    { reads a record declaration }
    function record_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
      var
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef: tstoreddef;
         old_parse_generic: boolean;
         recst: trecordsymtable;
      begin
         old_current_structdef:=current_structdef;
         old_current_genericdef:=current_genericdef;
         old_current_specializedef:=current_specializedef;
         old_parse_generic:=parse_generic;

         current_genericdef:=nil;
         current_specializedef:=nil;
         { create recdef }
         if (n<>'') or
            not(target_info.system in systems_jvm) then
           begin
             recst:=trecordsymtable.create(n,current_settings.packrecords);
             { can't use recst.realname^ instead of n, because recst.realname is
               nil in case of an empty name }
             current_structdef:=trecorddef.create(n,recst);
           end
         else
           begin
             { for the JVM target records always need a name, because they are
               represented by a class }
             recst:=trecordsymtable.create(current_module.realmodulename^+'__fpc_intern_recname_'+tostr(current_module.deflist.count),current_settings.packrecords);
             current_structdef:=trecorddef.create(recst.name^,recst);
           end;
         result:=current_structdef;
         { insert in symtablestack }
         symtablestack.push(recst);

         { usage of specialized type inside its generic template }
         if assigned(genericdef) then
           current_specializedef:=current_structdef
         { reject declaration of generic class inside generic class }
         else if assigned(genericlist) then
           current_genericdef:=current_structdef;

         { nested types of specializations are specializations as well }
         if assigned(old_current_structdef) and
             (df_specialization in old_current_structdef.defoptions) then
           include(current_structdef.defoptions,df_specialization);
         if assigned(old_current_structdef) and
             (df_generic in old_current_structdef.defoptions) then
           begin
             include(current_structdef.defoptions,df_generic);
             current_genericdef:=current_structdef;
           end;

         insert_generic_parameter_types(current_structdef,genericdef,genericlist);
         { when we are parsing a generic already then this is a generic as
           well }
         if old_parse_generic then
           include(current_structdef.defoptions, df_generic);
         parse_generic:=(df_generic in current_structdef.defoptions);
         { in non-Delphi modes we need a strict private symbol without type
           count and type parameters in the name to simply resolving }
         maybe_insert_generic_rename_symbol(n,genericlist);

         if m_advanced_records in current_settings.modeswitches then
           begin
             parse_record_members;
           end
         else
           begin
             read_record_fields([vd_record],nil);
{$ifdef jvm}
             { we need a constructor to create temps, a deep copy helper, ... }
             add_java_default_record_methods_intf(trecorddef(current_structdef));
{$endif}
             if target_info.system in systems_typed_constants_node_init then
               add_typedconst_init_routine(current_structdef);
             consume(_END);
            end;
         { don't keep track of procdefs in a separate list, because the
           compiler may add additional procdefs (e.g. property wrappers for
           the jvm backend) }
         insert_record_hidden_paras(trecorddef(current_structdef));
         { make the record size aligned }
         recst.addalignmentpadding;
         { restore symtable stack }
         symtablestack.pop(recst);
         if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
           Message(type_e_no_packed_inittable);
         { restore old state }
         parse_generic:=old_parse_generic;
         current_structdef:=old_current_structdef;
         current_genericdef:=old_current_genericdef;
         current_specializedef:=old_current_specializedef;
      end;


    { reads a type definition and returns a pointer to it }
    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
      var
        pt : tnode;
        tt2 : tdef;
        aktenumdef : tenumdef;
        s : TIDString;
        l,v : TConstExprInt;
        oldpackrecords : longint;
        defpos,storepos : tfileposinfo;
        name: TIDString;

        procedure expr_type;
        var
           pt1,pt2 : tnode;
           lv,hv   : TConstExprInt;
           old_block_type : tblock_type;
           dospecialize : boolean;
           newdef  : tdef;
        begin
           old_block_type:=block_type;
           dospecialize:=false;
           { use of current parsed object:
             classes, objects, records can be used also in themself }
           if (token=_ID) then
             if try_parse_structdef_nested_type(def,current_structdef,false) then
               exit;
           { Generate a specialization in FPC mode? }
           dospecialize:=not(m_delphi in current_settings.modeswitches) and try_to_consume(_SPECIALIZE);
           { we can't accept a equal in type }
           pt1:=comp_expr(false,true);
           if not dospecialize and
              try_to_consume(_POINTPOINT) then
             begin
               { get high value of range }
               pt2:=comp_expr(false,false);
               { make both the same type or give an error. This is not
                 done when both are integer values, because typecasting
                 between -3200..3200 will result in a signed-unsigned
                 conflict and give a range check error (PFV) }
               if not(is_integer(pt1.resultdef) and is_integer(pt2.resultdef)) then
                 inserttypeconv(pt1,pt2.resultdef);
               { both must be evaluated to constants now }
               if (pt1.nodetype=ordconstn) and
                  (pt2.nodetype=ordconstn) then
                 begin
                   lv:=tordconstnode(pt1).value;
                   hv:=tordconstnode(pt2).value;
                   { Check bounds }
                   if hv<lv then
                     message(parser_e_upper_lower_than_lower)
                   else if (lv.signed and (lv.svalue<0)) and (not hv.signed and (hv.uvalue>qword(high(int64)))) then
                     message(type_e_cant_eval_constant_expr)
                   else
                     begin
                       { All checks passed, create the new def }
                       case pt1.resultdef.typ of
                         enumdef :
                           def:=tenumdef.create_subrange(tenumdef(pt1.resultdef),lv.svalue,hv.svalue);
                         orddef :
                           begin
                             if is_char(pt1.resultdef) then
                               def:=torddef.create(uchar,lv,hv)
                             else
                               if is_boolean(pt1.resultdef) then
                                 def:=torddef.create(pasbool8,lv,hv)
                               else if is_signed(pt1.resultdef) then
                                 def:=torddef.create(range_to_basetype(lv,hv),lv,hv)
                               else
                                 def:=torddef.create(range_to_basetype(lv,hv),lv,hv);
                           end;
                       end;
                     end;
                 end
               else
                 Message(sym_e_error_in_type_def);
               pt2.free;
             end
           else
             begin
               { a simple type renaming or generic specialization }
               if (pt1.nodetype=typen) then
                 begin
                   def:=ttypenode(pt1).resultdef;
                   { Delphi mode specialization? }
                   if (m_delphi in current_settings.modeswitches) then
                     dospecialize:=token=_LSHARPBRACKET
                   else
                     { in non-Delphi modes we might get a inline specialization
                       without "specialize" or "<T>" of the same type we're
                       currently parsing, so we need to handle that special }
                     newdef:=nil;
                     if not dospecialize and
                         assigned(ttypenode(pt1).typesym) and
                         (ttypenode(pt1).typesym.typ=typesym) and
                         (sp_generic_dummy in ttypenode(pt1).typesym.symoptions) and
                         assigned(current_structdef) and
                         (
                           (
                             not (m_delphi in current_settings.modeswitches) and
                             (ttypesym(ttypenode(pt1).typesym).typedef.typ=undefineddef) and
                             (df_generic in current_structdef.defoptions) and
                             (ttypesym(ttypenode(pt1).typesym).typedef.owner=current_structdef.owner) and
                             (upper(ttypenode(pt1).typesym.realname)=copy(current_structdef.objname^,1,pos('$',current_structdef.objname^)-1))
                           ) or (
                             { this could be a nested specialization which uses
                               the type name of a surrounding generic to
                               reference the specialization of said surrounding
                               class }
                             (df_specialization in current_structdef.defoptions) and
                             return_specialization_of_generic(current_structdef,ttypesym(ttypenode(pt1).typesym).typedef,newdef)
                           )
                         )
                         then
                       begin
                         if assigned(newdef) then
                           def:=newdef
                         else
                           def:=current_structdef;
                         if assigned(def) then
                           { handle nested types }
                           post_comp_expr_gendef(def)
                         else
                           def:=generrordef;
                       end;
                   if dospecialize then
                     begin
                       generate_specialization(def,false,name,nil,'');
                       { handle nested types }
                       if assigned(def) then
                         post_comp_expr_gendef(def);
                     end
                   else
                     begin
                       if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
                         begin
                           def:=current_specializedef
                         end
                       else if (def=current_genericdef) then
                         begin
                           def:=current_genericdef
                         end
                       else if (df_generic in def.defoptions) and
                           { TODO : check once nested generics are allowed }
                           not
                             (
                               parse_generic and
                               (current_genericdef.typ in [recorddef,objectdef]) and
                               (def.typ in [recorddef,objectdef]) and
                               (
                                 { if both defs belong to the same generic (e.g. both are
                                   subtypes) then we must allow the usage }
                                 defs_belong_to_same_generic(def,current_genericdef) or
                                 { this is needed to correctly resolve "type Foo=SomeGeneric<T>"
                                   declarations inside a generic }
                                 (
                                   (ttypenode(pt1).typesym<>nil) and
                                   sym_is_owned_by(ttypenode(pt1).typesym,tabstractrecorddef(current_genericdef).symtable)
                                 )
                               )
                             )
                           then
                         begin
                           Message(parser_e_no_generics_as_types);
                           def:=generrordef;
                         end
                       else if is_classhelper(def) then
                         begin
                           Message(parser_e_no_category_as_types);
                           def:=generrordef
                         end
                     end;
                 end
               else
                 Message(sym_e_error_in_type_def);
             end;
           pt1.free;
           block_type:=old_block_type;
        end;


      procedure set_dec;
        begin
          consume(_SET);
          consume(_OF);
          read_anon_type(tt2,true);
          if assigned(tt2) then
           begin
             case tt2.typ of
               { don't forget that min can be negativ  PM }
               enumdef :
                 if (tenumdef(tt2).min>=0) and
                    (tenumdef(tt2).max<=255) then
                  // !! def:=tsetdef.create(tt2,tenumdef(tt2.def).min,tenumdef(tt2.def).max))
                  def:=tsetdef.create(tt2,tenumdef(tt2).min,tenumdef(tt2).max)
                 else
                  Message(sym_e_ill_type_decl_set);
               orddef :
                 begin
                   if (torddef(tt2).ordtype<>uvoid) and
                      (torddef(tt2).ordtype<>uwidechar) and
                      (torddef(tt2).low>=0) then
                     // !! def:=tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high))
                     if Torddef(tt2).high>int64(high(byte)) then
                       message(sym_e_ill_type_decl_set)
                     else
                       def:=tsetdef.create(tt2,torddef(tt2).low.svalue,torddef(tt2).high.svalue)
                   else
                     Message(sym_e_ill_type_decl_set);
                 end;
               else
                 Message(sym_e_ill_type_decl_set);
             end;
           end
          else
           def:=generrordef;
        end;


      procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:TFPObjectList);
        var
          lowval,
          highval   : TConstExprInt;
          indexdef  : tdef;
          hdef      : tdef;
          arrdef    : tarraydef;

        procedure setdefdecl(def:tdef);
          begin
            case def.typ of
              enumdef :
                begin
                  lowval:=tenumdef(def).min;
                  highval:=tenumdef(def).max;
                  if (m_fpc in current_settings.modeswitches) and
                     (tenumdef(def).has_jumps) then
                   Message(type_e_array_index_enums_with_assign_not_possible);
                  indexdef:=def;
                end;
              orddef :
                begin
                  if torddef(def).ordtype in [uchar,
                    u8bit,u16bit,
                    s8bit,s16bit,s32bit,
{$ifdef cpu64bitaddr}
                    u32bit,s64bit,
{$endif cpu64bitaddr}
                    pasbool8,pasbool16,pasbool32,pasbool64,
                    bool8bit,bool16bit,bool32bit,bool64bit,
                    uwidechar] then
                    begin
                       lowval:=torddef(def).low;
                       highval:=torddef(def).high;
                       indexdef:=def;
                    end
                  else
                    Message1(parser_e_type_cant_be_used_in_array_index,def.typename);
                end;
              else
                Message(sym_e_error_in_type_def);
            end;
          end;

        var
          old_current_genericdef,
          old_current_specializedef: tstoreddef;
          first,
          old_parse_generic: boolean;
        begin
           old_current_genericdef:=current_genericdef;
           old_current_specializedef:=current_specializedef;
           old_parse_generic:=parse_generic;

           current_genericdef:=nil;
           current_specializedef:=nil;
           first:=true;
           arrdef:=tarraydef.create(0,0,s32inttype);
           consume(_ARRAY);

           { usage of specialized type inside its generic template }
           if assigned(genericdef) then
             current_specializedef:=arrdef
           { reject declaration of generic class inside generic class }
           else if assigned(genericlist) then
             current_genericdef:=arrdef;
           symtablestack.push(arrdef.symtable);
           insert_generic_parameter_types(arrdef,genericdef,genericlist);
           { there are two possibilties for the following to be true:
             * the array declaration itself is generic
             * the array is declared inside a generic
             in both cases we need "parse_generic" and "current_genericdef"
             so that e.g. specializations of another generic inside the
             current generic can be used (either inline ones or "type" ones) }
           parse_generic:=(df_generic in arrdef.defoptions) or old_parse_generic;
           if parse_generic and not assigned(current_genericdef) then
             current_genericdef:=old_current_genericdef;

           { open array? }
           if try_to_consume(_LECKKLAMMER) then
             begin
                { defaults }
                indexdef:=generrordef;
                { use defaults which don't overflow the compiler }
                lowval:=0;
                highval:=0;
                repeat
                  { read the expression and check it, check apart if the
                    declaration is an enum declaration because that needs to
                    be parsed by readtype (PFV) }
                  if token=_LKLAMMER then
                   begin
                     read_anon_type(hdef,true);
                     setdefdecl(hdef);
                   end
                  else
                   begin
                     pt:=expr(true);
                     if pt.nodetype=typen then
                       setdefdecl(pt.resultdef)
                     else
                       begin
                         if pt.nodetype=rangen then
                           begin
                             { pure ordconstn expressions can be checked for
                               generics as well, but don't give an error in case
                               of parsing a generic if that isn't yet the case }
                             if (trangenode(pt).left.nodetype=ordconstn) and
                                (trangenode(pt).right.nodetype=ordconstn) then
                               begin
                                 { make both the same type or give an error. This is not
                                   done when both are integer values, because typecasting
                                   between -3200..3200 will result in a signed-unsigned
                                   conflict and give a range check error (PFV) }
                                 if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
                                   inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
                                 lowval:=tordconstnode(trangenode(pt).left).value;
                                 highval:=tordconstnode(trangenode(pt).right).value;
                                 if highval<lowval then
                                  begin
                                    Message(parser_e_array_lower_less_than_upper_bound);
                                    highval:=lowval;
                                  end
                                 else if (lowval<int64(low(asizeint))) or
                                         (highval>high(asizeint)) then
                                   begin
                                     Message(parser_e_array_range_out_of_bounds);
                                     lowval :=0;
                                     highval:=0;
                                   end;
                                 if is_integer(trangenode(pt).left.resultdef) then
                                   range_to_type(lowval,highval,indexdef)
                                 else
                                   indexdef:=trangenode(pt).left.resultdef;
                               end
                             else
                               if not parse_generic then
                                 Message(type_e_cant_eval_constant_expr);
                           end
                         else
                           Message(sym_e_error_in_type_def)
                       end;
                     pt.free;
                   end;

                  { if we are not at the first dimension, add the new arrray
                    as element of the existing array, otherwise modify the existing array }
                  if not(first) then
                    begin
                      arrdef.elementdef:=tarraydef.create(lowval.svalue,highval.svalue,indexdef);
                      { push new symtable }
                      symtablestack.pop(arrdef.symtable);
                      arrdef:=tarraydef(arrdef.elementdef);
                      symtablestack.push(arrdef.symtable);
                    end
                  else
                    begin
                      arrdef.lowrange:=lowval.svalue;
                      arrdef.highrange:=highval.svalue;
                      arrdef.rangedef:=indexdef;
                      def:=arrdef;
                      first:=false;
                    end;
                  if is_packed then
                    include(arrdef.arrayoptions,ado_IsBitPacked);

                  if token=_COMMA then
                    consume(_COMMA)
                  else
                    break;
                until false;
                consume(_RECKKLAMMER);
             end
           else
             begin
                if is_packed then
                  Message(parser_e_packed_dynamic_open_array);
                arrdef.lowrange:=0;
                arrdef.highrange:=-1;
                arrdef.rangedef:=s32inttype;
                include(arrdef.arrayoptions,ado_IsDynamicArray);
                def:=arrdef;
             end;
           consume(_OF);
           read_anon_type(tt2,true);
           { set element type of the last array definition }
           if assigned(arrdef) then
             begin
               symtablestack.pop(arrdef.symtable);
               arrdef.elementdef:=tt2;
               if is_packed and
                  is_managed_type(tt2) then
                 Message(type_e_no_packed_inittable);
             end;
           { restore old state }
           parse_generic:=old_parse_generic;
           current_genericdef:=old_current_genericdef;
           current_specializedef:=old_current_specializedef;
        end;


        function procvar_dec(genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
          var
            is_func:boolean;
            pd:tabstractprocdef;
            newtype:ttypesym;
            old_current_genericdef,
            old_current_specializedef: tstoreddef;
            old_parse_generic: boolean;
          begin
            old_current_genericdef:=current_genericdef;
            old_current_specializedef:=current_specializedef;
            old_parse_generic:=parse_generic;

            current_genericdef:=nil;
            current_specializedef:=nil;

            is_func:=(token=_FUNCTION);
            consume(token);
            pd:=tprocvardef.create(normal_function_level);

            { usage of specialized type inside its generic template }
            if assigned(genericdef) then
              current_specializedef:=pd
            { reject declaration of generic class inside generic class }
            else if assigned(genericlist) then
              current_genericdef:=pd;
            symtablestack.push(pd.parast);
            insert_generic_parameter_types(pd,genericdef,genericlist);
            { there are two possibilties for the following to be true:
              * the procvar declaration itself is generic
              * the procvar is declared inside a generic
              in both cases we need "parse_generic" and "current_genericdef"
              so that e.g. specializations of another generic inside the
              current generic can be used (either inline ones or "type" ones) }
            parse_generic:=(df_generic in pd.defoptions) or old_parse_generic;
            if parse_generic and not assigned(current_genericdef) then
              current_genericdef:=old_current_genericdef;
            { don't allow to add defs to the symtable - use it for type param search only }
            tparasymtable(pd.parast).readonly:=true;

            if token=_LKLAMMER then
              parse_parameter_dec(pd);
            if is_func then
              begin
                consume(_COLON);
                single_type(pd.returndef,[]);
              end;
            if try_to_consume(_OF) then
              begin
                consume(_OBJECT);
                include(pd.procoptions,po_methodpointer);
              end
            else if (m_nested_procvars in current_settings.modeswitches) and
                    try_to_consume(_IS) then
              begin
                consume(_NESTED);
                pd.parast.symtablelevel:=normal_function_level+1;
                pd.check_mark_as_nested;
              end;
            symtablestack.pop(pd.parast);
            tparasymtable(pd.parast).readonly:=false;
            result:=pd;
            { possible proc directives }
            if parseprocvardir then
              begin
                if check_proc_directive(true) then
                  begin
                    newtype:=ttypesym.create('unnamed',result);
                    parse_var_proc_directives(tsym(newtype));
                    newtype.typedef:=nil;
                    result.typesym:=nil;
                    newtype.free;
                  end;
                { Add implicit hidden parameters and function result }
                handle_calling_convention(pd);
              end;
            { restore old state }
            parse_generic:=old_parse_generic;
            current_genericdef:=old_current_genericdef;
            current_specializedef:=old_current_specializedef;
          end;

      const
        SingleTypeOptionsInTypeBlock:array[Boolean] of TSingleTypeOptions = ([],[stoIsForwardDef]);
        SingleTypeOptionsIsDelphi:array[Boolean] of TSingleTypeOptions = ([],[stoAllowSpecialization]);
      var
        p  : tnode;
        hdef : tdef;
        enumdupmsg, first, is_specialize : boolean;
        oldlocalswitches : tlocalswitches;
        bitpacking: boolean;
        stitem: psymtablestackitem;
        sym: tsym;
        st: tsymtable;
      begin
         def:=nil;
         if assigned(newsym) then
           name:=newsym.RealName
         else
           name:='';
         case token of
            _STRING,_FILE:
              begin
                single_type(def,[stoAllowTypeDef]);
              end;
           _LKLAMMER:
              begin
                consume(_LKLAMMER);
                first:=true;
                { allow negativ value_str }
                l:=int64(-1);
                enumdupmsg:=false;
                { check that we are not adding an enum from specialization
                  we can't just use current_specializedef because of inner types
                  like specialize array of record }
                is_specialize:=false;
                stitem:=symtablestack.stack;
                while assigned(stitem) do
                  begin
                    { check records, classes and arrays because they can be specialized }
                    if stitem^.symtable.symtabletype in [recordsymtable,ObjectSymtable,arraysymtable] then
                      begin
                        is_specialize:=is_specialize or (df_specialization in tstoreddef(stitem^.symtable.defowner).defoptions);
                        stitem:=stitem^.next;
                      end
                    else
                      break;
                  end;
                if not is_specialize then
                  aktenumdef:=tenumdef.create
                else
                  aktenumdef:=nil;
                repeat
                  { if it is a specialization then search the first enum member
                    and get the member owner instead of just created enumdef }
                  if not assigned(aktenumdef) then
                    begin
                      searchsym(pattern,sym,st);
                      if sym.typ=enumsym then
                        aktenumdef:=tenumsym(sym).definition
                      else
                        internalerror(201101021);
                    end;
                  s:=orgpattern;
                  defpos:=current_tokenpos;
                  consume(_ID);
                  { only allow assigning of specific numbers under fpc mode }
                  if not(m_tp7 in current_settings.modeswitches) and
                     (
                      { in fpc mode also allow := to be compatible
                        with previous 1.0.x versions }
                      ((m_fpc in current_settings.modeswitches) and
                       try_to_consume(_ASSIGNMENT)) or
                      try_to_consume(_EQ)
                     ) then
                    begin
                       oldlocalswitches:=current_settings.localswitches;
                       include(current_settings.localswitches,cs_allow_enum_calc);
                       p:=comp_expr(true,false);
                       current_settings.localswitches:=oldlocalswitches;
                       if (p.nodetype=ordconstn) then
                        begin
                          { we expect an integer or an enum of the
                            same type }
                          if is_integer(p.resultdef) or
                             is_char(p.resultdef) or
                             equal_defs(p.resultdef,aktenumdef) then
                           v:=tordconstnode(p).value
                          else
                           IncompatibleTypes(p.resultdef,s32inttype);
                        end
                       else
                        Message(parser_e_illegal_expression);
                       p.free;
                       { please leave that a note, allows type save }
                       { declarations in the win32 units ! }
                       if (not first) and (v<=l) and (not enumdupmsg) then
                        begin
                          Message(parser_n_duplicate_enum);
                          enumdupmsg:=true;
                        end;
                       l:=v;
                    end
                  else
                    inc(l.svalue);
                  first:=false;
                  { don't generate enum members is this is a specialization because aktenumdef is copied from the generic type }
                  if not is_specialize then
                    begin
                      storepos:=current_tokenpos;
                      current_tokenpos:=defpos;
                      tenumsymtable(aktenumdef.symtable).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));
                      if not (cs_scopedenums in current_settings.localswitches) then
                        tstoredsymtable(aktenumdef.owner).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));
                      current_tokenpos:=storepos;
                    end;
                until not try_to_consume(_COMMA);
                def:=aktenumdef;
                consume(_RKLAMMER);
{$ifdef jvm}
                jvm_maybe_create_enum_class(name,def);
{$endif}
              end;
            _ARRAY:
              begin
                array_dec(false,genericdef,genericlist);
              end;
            _SET:
              begin
                set_dec;
              end;
           _CARET:
              begin
                consume(_CARET);
                single_type(tt2,
                    SingleTypeOptionsInTypeBlock[block_type=bt_type]+
                    SingleTypeOptionsIsDelphi[m_delphi in current_settings.modeswitches]
                  );
                { in case of e.g. var or const sections we need to especially
                  check that we don't use a generic dummy symbol }
                if (block_type<>bt_type) and
                    (tt2.typ=undefineddef) and
                    assigned(tt2.typesym) and
                    (sp_generic_dummy in tt2.typesym.symoptions) then
                  Message(parser_e_no_generics_as_types);
                { don't use getpointerdef() here, since this is a type
                  declaration (-> must create new typedef) }
                def:=tpointerdef.create(tt2);
                if tt2.typ=forwarddef then
                  current_module.checkforwarddefs.add(def);
              end;
            _RECORD:
              begin
                consume(token);
                if (idtoken=_HELPER) and (m_advanced_records in current_settings.modeswitches) then
                  begin
                    consume(_HELPER);
                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_record);
                  end
                else
                  def:=record_dec(name,genericdef,genericlist);
              end;
            _PACKED,
            _BITPACKED:
              begin
                bitpacking :=
                  (cs_bitpacking in current_settings.localswitches) or
                  (token = _BITPACKED);
                consume(token);
                if token=_ARRAY then
                  array_dec(bitpacking,genericdef,genericlist)
                else if token=_SET then
                  set_dec
                else if token=_FILE then
                  single_type(def,[stoAllowTypeDef])
                else
                  begin
                    oldpackrecords:=current_settings.packrecords;
                    if (not bitpacking) or
                       (token in [_CLASS,_OBJECT]) then
                      current_settings.packrecords:=1
                    else
                      current_settings.packrecords:=bit_alignment;
                    case token of
                      _CLASS :
                        begin
                          consume(_CLASS);
                          def:=object_dec(odt_class,name,newsym,genericdef,genericlist,nil,ht_none);
                        end;
                      _OBJECT :
                        begin
                          consume(_OBJECT);
                          def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
                        end;
                      else begin
                        consume(_RECORD);
                        def:=record_dec(name,genericdef,genericlist);
                      end;
                    end;
                    current_settings.packrecords:=oldpackrecords;
                  end;
              end;
            _DISPINTERFACE :
              begin
                { need extra check here since interface is a keyword
                  in all pascal modes }
                if not(m_class in current_settings.modeswitches) then
                  Message(parser_f_need_objfpc_or_delphi_mode);
                consume(token);
                def:=object_dec(odt_dispinterface,name,newsym,genericdef,genericlist,nil,ht_none);
              end;
            _CLASS :
              begin
                consume(token);
                { Delphi only allows class of in type blocks }
                if (token=_OF) and
                   (
                    not(m_delphi in current_settings.modeswitches) or
                    (block_type=bt_type)
                   ) then
                  begin
                    consume(_OF);
                    single_type(hdef,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
                    if is_class(hdef) or
                       is_objcclass(hdef) or
                       is_javaclass(hdef) then
                      def:=tclassrefdef.create(hdef)
                    else
                      if hdef.typ=forwarddef then
                        begin
                          def:=tclassrefdef.create(hdef);
                          current_module.checkforwarddefs.add(def);
                        end
                    else
                      Message1(type_e_class_or_objcclass_type_expected,hdef.typename);
                  end
                else
                if (idtoken=_HELPER) then
                  begin
                    consume(_HELPER);
                    def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_class);
                  end
                else
                  def:=object_dec(default_class_type,name,newsym,genericdef,genericlist,nil,ht_none);
              end;
            _CPPCLASS :
              begin
                consume(token);
                def:=object_dec(odt_cppclass,name,newsym,genericdef,genericlist,nil,ht_none);
              end;
            _OBJCCLASS :
              begin
                if not(m_objectivec1 in current_settings.modeswitches) then
                  Message(parser_f_need_objc);

                consume(token);
                def:=object_dec(odt_objcclass,name,newsym,genericdef,genericlist,nil,ht_none);
              end;
            _INTERFACE :
              begin
                { need extra check here since interface is a keyword
                  in all pascal modes }
                if not(m_class in current_settings.modeswitches) then
                  Message(parser_f_need_objfpc_or_delphi_mode);
                consume(token);
                case current_settings.interfacetype of
                  it_interfacecom:
                    def:=object_dec(odt_interfacecom,name,newsym,genericdef,genericlist,nil,ht_none);
                  it_interfacecorba:
                    def:=object_dec(odt_interfacecorba,name,newsym,genericdef,genericlist,nil,ht_none);
                  it_interfacejava:
                    def:=object_dec(odt_interfacejava,name,newsym,genericdef,genericlist,nil,ht_none);
                  else
                    internalerror(2010122612);
                end;
              end;
            _OBJCPROTOCOL :
               begin
                if not(m_objectivec1 in current_settings.modeswitches) then
                  Message(parser_f_need_objc);

                consume(token);
                def:=object_dec(odt_objcprotocol,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
            _OBJCCATEGORY :
               begin
                if not(m_objectivec1 in current_settings.modeswitches) then
                  Message(parser_f_need_objc);

                consume(token);
                def:=object_dec(odt_objccategory,name,newsym,genericdef,genericlist,nil,ht_none);
               end;
            _OBJECT :
              begin
                consume(token);
                def:=object_dec(odt_object,name,newsym,genericdef,genericlist,nil,ht_none);
              end;
            _PROCEDURE,
            _FUNCTION:
              begin
                def:=procvar_dec(genericdef,genericlist);
{$ifdef jvm}
                jvm_create_procvar_class(name,def);
{$endif}
              end;
            else
              if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
                begin
                  consume(_KLAMMERAFFE);
                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
                  def:=tpointerdef.create(tt2);
                  if tt2.typ=forwarddef then
                    current_module.checkforwarddefs.add(def);
                end
              else
                expr_type;
         end;

         if def=nil then
          def:=generrordef;
      end;


    procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
      begin
        read_named_type(def,nil,nil,nil,parseprocvardir);
      end;


    procedure write_persistent_type_info(st:tsymtable;is_global:boolean);
      var
        i : longint;
        def : tdef;
        vmtwriter  : TVMTWriter;
      begin
{$ifdef jvm}
        { no Delphi-style RTTI }
        exit;
{$endif jvm}
        for i:=0 to st.DefList.Count-1 do
          begin
            def:=tdef(st.DefList[i]);
            case def.typ of
              recorddef :
                write_persistent_type_info(trecorddef(def).symtable,is_global);
              objectdef :
                begin
                  { Skip generics and forward defs }
                  if (df_generic in def.defoptions) or
                     (oo_is_forward in tobjectdef(def).objectoptions) then
                    continue;
                  write_persistent_type_info(tobjectdef(def).symtable,is_global);
                  { Write also VMT if not done yet }
                  if not(ds_vmt_written in def.defstates) then
                    begin
                      vmtwriter:=TVMTWriter.create(tobjectdef(def));
                      if is_interface(tobjectdef(def)) then
                        vmtwriter.writeinterfaceids;
                      if (oo_has_vmt in tobjectdef(def).objectoptions) then
                        vmtwriter.writevmt;
                      vmtwriter.free;
                      include(def.defstates,ds_vmt_written);
                    end;
                end;
              procdef :
                begin
                  if assigned(tprocdef(def).localst) and
                     (tprocdef(def).localst.symtabletype=localsymtable) then
                    write_persistent_type_info(tprocdef(def).localst,false);
                  if assigned(tprocdef(def).parast) then
                    write_persistent_type_info(tprocdef(def).parast,false);
                end;
            end;
            { generate always persistent tables for types in the interface so it can
              be reused in other units and give always the same pointer location. }
            { Init }
            if (
                assigned(def.typesym) and
                is_global and
                not is_objc_class_or_protocol(def)
               ) or
               is_managed_type(def) or
               (ds_init_table_used in def.defstates) then
              RTTIWriter.write_rtti(def,initrtti);
            { RTTI }
            if (
                assigned(def.typesym) and
                is_global and
                not is_objc_class_or_protocol(def)
               ) or
               (ds_rtti_table_used in def.defstates) then
              RTTIWriter.write_rtti(def,fullrtti);
          end;
      end;


    procedure add_typedconst_init_routine(def: tabstractrecorddef);
      var
        sstate: tscannerstate;
        pd: tprocdef;
      begin
        replace_scanner('tcinit_routine',sstate);
        { the typed constant initialization code is called from the class
          constructor by tnodeutils.wrap_proc_body; at this point, we don't
          know yet whether that will be necessary, because there may be
          typed constants inside method bodies -> always force the addition
          of a class constructor.

          We cannot directly add the typed constant initialisations to the
          class constructor, because when it's parsed not all method bodies
          are necessarily already parsed }
        pd:=def.find_procdef_bytype(potype_class_constructor);
        { the class constructor }
        if not assigned(pd) then
          begin
            if str_parse_method_dec('constructor fpc_init_typed_consts_class_constructor;',potype_class_constructor,true,def,pd) then
              pd.synthetickind:=tsk_empty
            else
              internalerror(2011040206);
          end;
        { the initialisation helper }
        if str_parse_method_dec('procedure fpc_init_typed_consts_helper; static;',potype_procedure,true,def,pd) then
          pd.synthetickind:=tsk_tcinit
        else
          internalerror(2011040207);
        restore_scanner(sstate);
      end;


end.