mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 13:39:39 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			648 lines
		
	
	
		
			26 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			648 lines
		
	
	
		
			26 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2000 by Florian Klaempfl
 | 
						|
 | 
						|
    Parses variable declarations. Used for var statement and record
 | 
						|
    definitions
 | 
						|
 | 
						|
    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 pdecvar;
 | 
						|
 | 
						|
{$i defines.inc}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
    procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
    uses
 | 
						|
       { common }
 | 
						|
       cutils,
 | 
						|
       { global }
 | 
						|
       globtype,globals,tokens,verbose,
 | 
						|
       systems,
 | 
						|
       { symtable }
 | 
						|
       symconst,symbase,symtype,symdef,symsym,symtable,types,fmodule,
 | 
						|
       { pass 1 }
 | 
						|
       node,
 | 
						|
       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
 | 
						|
       { parser }
 | 
						|
       scanner,
 | 
						|
       pbase,pexpr,ptype,ptconst,pdecsub,
 | 
						|
       { link }
 | 
						|
       import;
 | 
						|
 | 
						|
    const
 | 
						|
       variantrecordlevel : longint = 0;
 | 
						|
 | 
						|
    procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
 | 
						|
    { reads the filed of a record into a        }
 | 
						|
    { symtablestack, if record=false        }
 | 
						|
    { variants are forbidden, so this procedure }
 | 
						|
    { can be used to read object fields  }
 | 
						|
    { if absolute is true, ABSOLUTE and file    }
 | 
						|
    { types are allowed                  }
 | 
						|
    { => the procedure is also used to read     }
 | 
						|
    { a sequence of variable declaration        }
 | 
						|
 | 
						|
      procedure insert_syms(st : tsymtable;sc : tidstringlist;tt : ttype;is_threadvar : boolean);
 | 
						|
      { inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed }
 | 
						|
        var
 | 
						|
           s : string;
 | 
						|
           filepos : tfileposinfo;
 | 
						|
           ss : tvarsym;
 | 
						|
        begin
 | 
						|
           filepos:=akttokenpos;
 | 
						|
           while not sc.empty do
 | 
						|
             begin
 | 
						|
                s:=sc.get(akttokenpos);
 | 
						|
                ss:=tvarsym.Create(s,tt);
 | 
						|
                if is_threadvar then
 | 
						|
                  include(ss.varoptions,vo_is_thread_var);
 | 
						|
                st.insert(ss);
 | 
						|
                { static data fields are inserted in the globalsymtable }
 | 
						|
                if (st.symtabletype=objectsymtable) and
 | 
						|
                   (sp_static in current_object_option) then
 | 
						|
                  begin
 | 
						|
                     s:='$'+lower(st.name^)+'_'+upper(s);
 | 
						|
                     st.defowner.owner.insert(tvarsym.create(s,tt));
 | 
						|
                  end;
 | 
						|
             end;
 | 
						|
{$ifdef fixLeaksOnError}
 | 
						|
             if strContStack.pop <> sc then
 | 
						|
               writeln('problem with strContStack in pdecl (2)');
 | 
						|
{$endif fixLeaksOnError}
 | 
						|
           sc.free;
 | 
						|
           akttokenpos:=filepos;
 | 
						|
        end;
 | 
						|
 | 
						|
      var
 | 
						|
         sc : tidstringList;
 | 
						|
         s : stringid;
 | 
						|
         old_block_type : tblock_type;
 | 
						|
         declarepos,storetokenpos : tfileposinfo;
 | 
						|
         oldsymtablestack : tsymtable;
 | 
						|
         symdone : boolean;
 | 
						|
         { to handle absolute }
 | 
						|
         abssym : tabsolutesym;
 | 
						|
         { c var }
 | 
						|
         newtype : ttypesym;
 | 
						|
         is_dll,
 | 
						|
         is_gpc_name,is_cdecl,
 | 
						|
         extern_aktvarsym,export_aktvarsym : boolean;
 | 
						|
         old_current_object_option : tsymoptions;
 | 
						|
         dll_name,
 | 
						|
         C_name : string;
 | 
						|
         tt,casetype : ttype;
 | 
						|
         { Delphi initialized vars }
 | 
						|
         tconstsym : ttypedconstsym;
 | 
						|
         { maxsize contains the max. size of a variant }
 | 
						|
         { startvarrec contains the start of the variant part of a record }
 | 
						|
         usedalign,
 | 
						|
         maxsize,minalignment,maxalignment,startvarrecalign,startvarrecsize : longint;
 | 
						|
         pt : tnode;
 | 
						|
         srsym : tsym;
 | 
						|
         srsymtable : tsymtable;
 | 
						|
         unionsymtable : tsymtable;
 | 
						|
         offset : longint;
 | 
						|
         uniondef : trecorddef;
 | 
						|
         unionsym : tvarsym;
 | 
						|
         uniontype : ttype;
 | 
						|
         dummysymoptions : tsymoptions;
 | 
						|
      begin
 | 
						|
         old_current_object_option:=current_object_option;
 | 
						|
         { all variables are public if not in a object declaration }
 | 
						|
         if not is_object then
 | 
						|
          current_object_option:=[sp_public];
 | 
						|
         old_block_type:=block_type;
 | 
						|
         block_type:=bt_type;
 | 
						|
         is_gpc_name:=false;
 | 
						|
         { Force an expected ID error message }
 | 
						|
         if not (token in [_ID,_CASE,_END]) then
 | 
						|
          consume(_ID);
 | 
						|
         { read vars }
 | 
						|
         while (token=_ID) and
 | 
						|
               not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do
 | 
						|
           begin
 | 
						|
             C_name:=orgpattern;
 | 
						|
             sc:=consume_idlist;
 | 
						|
{$ifdef fixLeaksOnError}
 | 
						|
             strContStack.push(sc);
 | 
						|
{$endif fixLeaksOnError}
 | 
						|
             consume(_COLON);
 | 
						|
             if (m_gpc in aktmodeswitches) and
 | 
						|
                not(is_record or is_object or is_threadvar) and
 | 
						|
                (token=_ID) and (orgpattern='__asmname__') then
 | 
						|
               begin
 | 
						|
                 consume(_ID);
 | 
						|
                 C_name:=get_stringconst;
 | 
						|
                 Is_gpc_name:=true;
 | 
						|
               end;
 | 
						|
             { this is needed for Delphi mode at least
 | 
						|
               but should be OK for all modes !! (PM) }
 | 
						|
             ignore_equal:=true;
 | 
						|
             if is_record then
 | 
						|
              begin
 | 
						|
                { for records, don't search the recordsymtable for
 | 
						|
                  the symbols of the types }
 | 
						|
                oldsymtablestack:=symtablestack;
 | 
						|
                symtablestack:=symtablestack.next;
 | 
						|
                read_type(tt,'');
 | 
						|
                symtablestack:=oldsymtablestack;
 | 
						|
              end
 | 
						|
             else
 | 
						|
              read_type(tt,'');
 | 
						|
             { types that use init/final are not allowed in variant parts, but
 | 
						|
               classes are allowed }
 | 
						|
             if (variantrecordlevel>0) and
 | 
						|
                (tt.def.needs_inittable and not is_class(tt.def)) then
 | 
						|
               Message(parser_e_cant_use_inittable_here);
 | 
						|
             ignore_equal:=false;
 | 
						|
             symdone:=false;
 | 
						|
             if is_gpc_name then
 | 
						|
               begin
 | 
						|
                  storetokenpos:=akttokenpos;
 | 
						|
                  s:=sc.get(akttokenpos);
 | 
						|
                  if not sc.empty then
 | 
						|
                   Message(parser_e_absolute_only_one_var);
 | 
						|
{$ifdef fixLeaksOnError}
 | 
						|
                   if strContStack.pop <> sc then
 | 
						|
                     writeln('problem with strContStack in pdecl (3)');
 | 
						|
{$endif fixLeaksOnError}
 | 
						|
                  sc.free;
 | 
						|
                  aktvarsym:=tvarsym.create_C(s,target_info.Cprefix+C_name,tt);
 | 
						|
                  include(aktvarsym.varoptions,vo_is_external);
 | 
						|
                  symtablestack.insert(aktvarsym);
 | 
						|
                  akttokenpos:=storetokenpos;
 | 
						|
                  symdone:=true;
 | 
						|
               end;
 | 
						|
             { check for absolute }
 | 
						|
             if not symdone and
 | 
						|
                (idtoken=_ABSOLUTE) and not(is_record or is_object or is_threadvar) then
 | 
						|
              begin
 | 
						|
                consume(_ABSOLUTE);
 | 
						|
                { only allowed for one var }
 | 
						|
                s:=sc.get(declarepos);
 | 
						|
                if not sc.empty then
 | 
						|
                 Message(parser_e_absolute_only_one_var);
 | 
						|
{$ifdef fixLeaksOnError}
 | 
						|
                 if strContStack.pop <> sc then
 | 
						|
                   writeln('problem with strContStack in pdecl (4)');
 | 
						|
{$endif fixLeaksOnError}
 | 
						|
                sc.free;
 | 
						|
                { parse the rest }
 | 
						|
                pt:=expr;
 | 
						|
                if (pt.nodetype=stringconstn) or (is_constcharnode(pt)) then
 | 
						|
                 begin
 | 
						|
                   storetokenpos:=akttokenpos;
 | 
						|
                   akttokenpos:=declarepos;
 | 
						|
                   abssym:=tabsolutesym.create(s,tt);
 | 
						|
                   if pt.nodetype=stringconstn then
 | 
						|
                     s:=strpas(tstringconstnode(pt).value_str)
 | 
						|
                   else
 | 
						|
                     s:=chr(tordconstnode(pt).value);
 | 
						|
                   consume(token);
 | 
						|
                   abssym.abstyp:=toasm;
 | 
						|
                   abssym.asmname:=stringdup(s);
 | 
						|
                   symtablestack.insert(abssym);
 | 
						|
                   akttokenpos:=storetokenpos;
 | 
						|
                   symdone:=true;
 | 
						|
                 end;
 | 
						|
                if not symdone then
 | 
						|
                 begin
 | 
						|
                   { variable }
 | 
						|
                   if (pt.nodetype=loadn) then
 | 
						|
                    begin
 | 
						|
                      { we should check the result type of srsym }
 | 
						|
                      if not (tloadnode(pt).symtableentry.typ in [varsym,typedconstsym,funcretsym]) then
 | 
						|
                        Message(parser_e_absolute_only_to_var_or_const);
 | 
						|
                      storetokenpos:=akttokenpos;
 | 
						|
                      akttokenpos:=declarepos;
 | 
						|
                      abssym:=tabsolutesym.create(s,tt);
 | 
						|
                      abssym.abstyp:=tovar;
 | 
						|
                      abssym.ref:=tstoredsym(tloadnode(pt).symtableentry);
 | 
						|
                      symtablestack.insert(abssym);
 | 
						|
                      akttokenpos:=storetokenpos;
 | 
						|
                      symdone:=true;
 | 
						|
                    end
 | 
						|
                   { funcret }
 | 
						|
                   else if (pt.nodetype=funcretn) then
 | 
						|
                    begin
 | 
						|
                      storetokenpos:=akttokenpos;
 | 
						|
                      akttokenpos:=declarepos;
 | 
						|
                      abssym:=tabsolutesym.create(s,tt);
 | 
						|
                      abssym.abstyp:=tovar;
 | 
						|
                      abssym.ref:=tstoredsym(tfuncretnode(pt).funcretsym);
 | 
						|
                      symtablestack.insert(abssym);
 | 
						|
                      akttokenpos:=storetokenpos;
 | 
						|
                      symdone:=true;
 | 
						|
                    end;
 | 
						|
                   { address }
 | 
						|
                   if (not symdone) and
 | 
						|
                      ((target_info.target=target_i386_go32v2) or
 | 
						|
                       (m_objfpc in aktmodeswitches) or
 | 
						|
                       (m_delphi in aktmodeswitches)) then
 | 
						|
                    begin
 | 
						|
                      if is_constintnode(pt) then
 | 
						|
                       begin
 | 
						|
                         storetokenpos:=akttokenpos;
 | 
						|
                         akttokenpos:=declarepos;
 | 
						|
                         abssym:=tabsolutesym.create(s,tt);
 | 
						|
                         abssym.abstyp:=toaddr;
 | 
						|
                         abssym.absseg:=false;
 | 
						|
                         abssym.address:=tordconstnode(pt).value;
 | 
						|
                         if (token=_COLON) and
 | 
						|
                            (target_info.target=target_i386_go32v2) then
 | 
						|
                          begin
 | 
						|
                            consume(token);
 | 
						|
                            pt:=expr;
 | 
						|
                            if is_constintnode(pt) then
 | 
						|
                              begin
 | 
						|
                                abssym.address:=abssym.address shl 4+tordconstnode(pt).value;
 | 
						|
                                abssym.absseg:=true;
 | 
						|
                              end
 | 
						|
                            else
 | 
						|
                               Message(parser_e_absolute_only_to_var_or_const);
 | 
						|
                          end;
 | 
						|
                         symtablestack.insert(abssym);
 | 
						|
                         akttokenpos:=storetokenpos;
 | 
						|
                       end
 | 
						|
                      else
 | 
						|
                       Message(parser_e_absolute_only_to_var_or_const);
 | 
						|
                    end;
 | 
						|
                 end
 | 
						|
                else
 | 
						|
                  Message(parser_e_absolute_only_to_var_or_const);
 | 
						|
                symdone:=true;
 | 
						|
              end;
 | 
						|
             { Handling of Delphi typed const = initialized vars ! }
 | 
						|
             { When should this be rejected ?
 | 
						|
               - in parasymtable
 | 
						|
               - in record or object
 | 
						|
               - ... (PM) }
 | 
						|
             if (m_delphi in aktmodeswitches) and (token=_EQUAL) and
 | 
						|
                not (symtablestack.symtabletype in [parasymtable]) and
 | 
						|
                not is_record and not is_object then
 | 
						|
               begin
 | 
						|
                  storetokenpos:=akttokenpos;
 | 
						|
                  s:=sc.get(akttokenpos);
 | 
						|
                  if not sc.empty then
 | 
						|
                    Message(parser_e_initialized_only_one_var);
 | 
						|
                  tconstsym:=ttypedconstsym.createtype(s,tt,false);
 | 
						|
                  symtablestack.insert(tconstsym);
 | 
						|
                  akttokenpos:=storetokenpos;
 | 
						|
                  consume(_EQUAL);
 | 
						|
                  readtypedconst(tt,tconstsym,false);
 | 
						|
                  symdone:=true;
 | 
						|
               end;
 | 
						|
             { hint directive }
 | 
						|
             {$warning hintdirective not stored in syms}
 | 
						|
             dummysymoptions:=[];
 | 
						|
             try_consume_hintdirective(dummysymoptions);
 | 
						|
             { for a record there doesn't need to be a ; before the END or ) }
 | 
						|
             if not((is_record or is_object) and (token in [_END,_RKLAMMER])) then
 | 
						|
               consume(_SEMICOLON);
 | 
						|
             { procvar handling }
 | 
						|
             if (tt.def.deftype=procvardef) and (tt.def.typesym=nil) then
 | 
						|
               begin
 | 
						|
                  newtype:=ttypesym.create('unnamed',tt);
 | 
						|
                  parse_var_proc_directives(tsym(newtype));
 | 
						|
                  newtype.restype.def:=nil;
 | 
						|
                  tt.def.typesym:=nil;
 | 
						|
                  newtype.free;
 | 
						|
               end;
 | 
						|
             { Check for variable directives }
 | 
						|
             if not symdone and (token=_ID) then
 | 
						|
              begin
 | 
						|
                { Check for C Variable declarations }
 | 
						|
                if (m_cvar_support in aktmodeswitches) and
 | 
						|
                   not(is_record or is_object or is_threadvar) and
 | 
						|
                   (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
 | 
						|
                 begin
 | 
						|
                   { only allowed for one var }
 | 
						|
                   s:=sc.get(declarepos);
 | 
						|
                   if not sc.empty then
 | 
						|
                    Message(parser_e_absolute_only_one_var);
 | 
						|
{$ifdef fixLeaksOnError}
 | 
						|
                   if strContStack.pop <> sc then
 | 
						|
                     writeln('problem with strContStack in pdecl (5)');
 | 
						|
{$endif fixLeaksOnError}
 | 
						|
                   sc.free;
 | 
						|
                   { defaults }
 | 
						|
                   is_dll:=false;
 | 
						|
                   is_cdecl:=false;
 | 
						|
                   extern_aktvarsym:=false;
 | 
						|
                   export_aktvarsym:=false;
 | 
						|
                   { cdecl }
 | 
						|
                   if idtoken=_CVAR then
 | 
						|
                    begin
 | 
						|
                      consume(_CVAR);
 | 
						|
                      consume(_SEMICOLON);
 | 
						|
                      is_cdecl:=true;
 | 
						|
                      C_name:=target_info.Cprefix+C_name;
 | 
						|
                    end;
 | 
						|
                   { external }
 | 
						|
                   if idtoken=_EXTERNAL then
 | 
						|
                    begin
 | 
						|
                      consume(_EXTERNAL);
 | 
						|
                      extern_aktvarsym:=true;
 | 
						|
                    end;
 | 
						|
                   { export }
 | 
						|
                   if idtoken in [_EXPORT,_PUBLIC] then
 | 
						|
                    begin
 | 
						|
                      consume(_ID);
 | 
						|
                      if extern_aktvarsym or
 | 
						|
                         (symtablestack.symtabletype in [parasymtable,localsymtable]) then
 | 
						|
                       Message(parser_e_not_external_and_export)
 | 
						|
                      else
 | 
						|
                       export_aktvarsym:=true;
 | 
						|
                    end;
 | 
						|
                   { external and export need a name after when no cdecl is used }
 | 
						|
                   if not is_cdecl then
 | 
						|
                    begin
 | 
						|
                      { dll name ? }
 | 
						|
                      if (extern_aktvarsym) and (idtoken<>_NAME) then
 | 
						|
                       begin
 | 
						|
                         is_dll:=true;
 | 
						|
                         dll_name:=get_stringconst;
 | 
						|
                       end;
 | 
						|
                      consume(_NAME);
 | 
						|
                      C_name:=get_stringconst;
 | 
						|
                    end;
 | 
						|
                   { consume the ; when export or external is used }
 | 
						|
                   if extern_aktvarsym or export_aktvarsym then
 | 
						|
                    consume(_SEMICOLON);
 | 
						|
                   { insert in the symtable }
 | 
						|
                   storetokenpos:=akttokenpos;
 | 
						|
                   akttokenpos:=declarepos;
 | 
						|
                   if is_dll then
 | 
						|
                    aktvarsym:=tvarsym.create_dll(s,tt)
 | 
						|
                   else
 | 
						|
                    aktvarsym:=tvarsym.create_C(s,C_name,tt);
 | 
						|
                   { set some vars options }
 | 
						|
                   if export_aktvarsym then
 | 
						|
                    begin
 | 
						|
                      inc(aktvarsym.refs);
 | 
						|
                      include(aktvarsym.varoptions,vo_is_exported);
 | 
						|
                    end;
 | 
						|
                   if extern_aktvarsym then
 | 
						|
                    include(aktvarsym.varoptions,vo_is_external);
 | 
						|
                   { insert in the stack/datasegment }
 | 
						|
                   symtablestack.insert(aktvarsym);
 | 
						|
                   akttokenpos:=storetokenpos;
 | 
						|
                   { now we can insert it in the import lib if its a dll, or
 | 
						|
                     add it to the externals }
 | 
						|
                   if extern_aktvarsym then
 | 
						|
                    begin
 | 
						|
                      if is_dll then
 | 
						|
                       begin
 | 
						|
                         if not(current_module.uses_imports) then
 | 
						|
                          begin
 | 
						|
                            current_module.uses_imports:=true;
 | 
						|
                            importlib.preparelib(current_module.modulename^);
 | 
						|
                          end;
 | 
						|
                         importlib.importvariable(aktvarsym.mangledname,dll_name,C_name)
 | 
						|
                       end
 | 
						|
                      else
 | 
						|
                       if target_info.DllScanSupported then
 | 
						|
                        current_module.Externals.insert(tExternalsItem.create(aktvarsym.mangledname));
 | 
						|
                    end;
 | 
						|
                   symdone:=true;
 | 
						|
                 end
 | 
						|
                else
 | 
						|
                 if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
 | 
						|
                  begin
 | 
						|
                    include(current_object_option,sp_static);
 | 
						|
                    insert_syms(symtablestack,sc,tt,false);
 | 
						|
                    exclude(current_object_option,sp_static);
 | 
						|
                    consume(_STATIC);
 | 
						|
                    consume(_SEMICOLON);
 | 
						|
                    symdone:=true;
 | 
						|
                  end;
 | 
						|
              end;
 | 
						|
             { insert it in the symtable, if not done yet }
 | 
						|
             if not symdone then
 | 
						|
               begin
 | 
						|
                  { save object option, because we can turn of the sp_published }
 | 
						|
                  if (sp_published in current_object_option) and
 | 
						|
                    not(is_class(tt.def)) then
 | 
						|
                   begin
 | 
						|
                     Message(parser_e_cant_publish_that);
 | 
						|
                     exclude(current_object_option,sp_published);
 | 
						|
                   end
 | 
						|
                  else
 | 
						|
                   if (sp_published in current_object_option) and
 | 
						|
                      not(oo_can_have_published in tobjectdef(tt.def).objectoptions) then
 | 
						|
                    begin
 | 
						|
                      Message(parser_e_only_publishable_classes_can__be_published);
 | 
						|
                      exclude(current_object_option,sp_published);
 | 
						|
                    end;
 | 
						|
                  insert_syms(symtablestack,sc,tt,is_threadvar);
 | 
						|
                  current_object_option:=old_current_object_option;
 | 
						|
               end;
 | 
						|
           end;
 | 
						|
         { Check for Case }
 | 
						|
         if is_record and (token=_CASE) then
 | 
						|
           begin
 | 
						|
              maxsize:=0;
 | 
						|
              maxalignment:=0;
 | 
						|
              consume(_CASE);
 | 
						|
              s:=pattern;
 | 
						|
              searchsym(s,srsym,srsymtable);
 | 
						|
              { may be only a type: }
 | 
						|
              if assigned(srsym) and (srsym.typ in [typesym,unitsym]) then
 | 
						|
               begin
 | 
						|
                 { for records, don't search the recordsymtable for
 | 
						|
                   the symbols of the types }
 | 
						|
                 oldsymtablestack:=symtablestack;
 | 
						|
                 symtablestack:=symtablestack.next;
 | 
						|
                 read_type(casetype,'');
 | 
						|
                 symtablestack:=oldsymtablestack;
 | 
						|
               end
 | 
						|
              else
 | 
						|
                begin
 | 
						|
                  consume(_ID);
 | 
						|
                  consume(_COLON);
 | 
						|
                  { for records, don't search the recordsymtable for
 | 
						|
                    the symbols of the types }
 | 
						|
                  oldsymtablestack:=symtablestack;
 | 
						|
                  symtablestack:=symtablestack.next;
 | 
						|
                  read_type(casetype,'');
 | 
						|
                  symtablestack:=oldsymtablestack;
 | 
						|
                  symtablestack.insert(tvarsym.create(s,casetype));
 | 
						|
                end;
 | 
						|
              if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
 | 
						|
               Message(type_e_ordinal_expr_expected);
 | 
						|
              consume(_OF);
 | 
						|
              UnionSymtable:=trecordsymtable.create;
 | 
						|
              Unionsymtable.next:=symtablestack;
 | 
						|
              registerdef:=false;
 | 
						|
              UnionDef:=trecorddef.create(unionsymtable);
 | 
						|
              registerdef:=true;
 | 
						|
              symtablestack:=UnionSymtable;
 | 
						|
              startvarrecsize:=symtablestack.datasize;
 | 
						|
              startvarrecalign:=symtablestack.dataalignment;
 | 
						|
              repeat
 | 
						|
                repeat
 | 
						|
                  pt:=comp_expr(true);
 | 
						|
                  if not(pt.nodetype=ordconstn) then
 | 
						|
                    Message(cg_e_illegal_expression);
 | 
						|
                  pt.free;
 | 
						|
                  if token=_COMMA then
 | 
						|
                   consume(_COMMA)
 | 
						|
                  else
 | 
						|
                   break;
 | 
						|
                until false;
 | 
						|
                consume(_COLON);
 | 
						|
                { read the vars }
 | 
						|
                consume(_LKLAMMER);
 | 
						|
                inc(variantrecordlevel);
 | 
						|
                if token<>_RKLAMMER then
 | 
						|
                  read_var_decs(true,false,false);
 | 
						|
                dec(variantrecordlevel);
 | 
						|
                consume(_RKLAMMER);
 | 
						|
                { calculates maximal variant size }
 | 
						|
                maxsize:=max(maxsize,symtablestack.datasize);
 | 
						|
                maxalignment:=max(maxalignment,symtablestack.dataalignment);
 | 
						|
                { the items of the next variant are overlayed }
 | 
						|
                symtablestack.datasize:=startvarrecsize;
 | 
						|
                symtablestack.dataalignment:=startvarrecalign;
 | 
						|
                if (token<>_END) and (token<>_RKLAMMER) then
 | 
						|
                  consume(_SEMICOLON)
 | 
						|
                else
 | 
						|
                  break;
 | 
						|
              until (token=_END) or (token=_RKLAMMER);
 | 
						|
              { at last set the record size to that of the biggest variant }
 | 
						|
              symtablestack.datasize:=maxsize;
 | 
						|
              symtablestack.dataalignment:=maxalignment;
 | 
						|
              uniontype.def:=uniondef;
 | 
						|
              uniontype.sym:=nil;
 | 
						|
              UnionSym:=tvarsym.create('case',uniontype);
 | 
						|
              symtablestack:=symtablestack.next;
 | 
						|
              { we do NOT call symtablestack.insert
 | 
						|
               on purpose PM }
 | 
						|
              if aktalignment.recordalignmax=-1 then
 | 
						|
               begin
 | 
						|
{$ifdef i386}
 | 
						|
                 if maxalignment>2 then
 | 
						|
                  minalignment:=4
 | 
						|
                 else if maxalignment>1 then
 | 
						|
                  minalignment:=2
 | 
						|
                 else
 | 
						|
                  minalignment:=1;
 | 
						|
{$else}
 | 
						|
{$ifdef m68k}
 | 
						|
                 minalignment:=2;
 | 
						|
{$endif}
 | 
						|
                 minalignment:=1;
 | 
						|
{$endif}
 | 
						|
               end
 | 
						|
              else
 | 
						|
               minalignment:=maxalignment;
 | 
						|
              usedalign:=used_align(maxalignment,minalignment,maxalignment);
 | 
						|
              offset:=align(symtablestack.datasize,usedalign);
 | 
						|
              symtablestack.datasize:=offset+unionsymtable.datasize;
 | 
						|
              if maxalignment>symtablestack.dataalignment then
 | 
						|
                symtablestack.dataalignment:=maxalignment;
 | 
						|
              trecordsymtable(Unionsymtable).Insert_in(symtablestack,offset);
 | 
						|
              Unionsym.owner:=nil;
 | 
						|
              unionsym.free;
 | 
						|
              uniondef.free;
 | 
						|
           end;
 | 
						|
         block_type:=old_block_type;
 | 
						|
         current_object_option:=old_current_object_option;
 | 
						|
      end;
 | 
						|
 | 
						|
end.
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.20  2001-09-30 21:15:48  peter
 | 
						|
    * merged absolute support for constants
 | 
						|
 | 
						|
  Revision 1.19  2001/08/30 20:13:53  peter
 | 
						|
    * rtti/init table updates
 | 
						|
    * rttisym for reusable global rtti/init info
 | 
						|
    * support published for interfaces
 | 
						|
 | 
						|
  Revision 1.18  2001/07/01 20:16:16  peter
 | 
						|
    * alignmentinfo record added
 | 
						|
    * -Oa argument supports more alignment settings that can be specified
 | 
						|
      per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
 | 
						|
      RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
 | 
						|
      required alignment and the maximum usefull alignment. The final
 | 
						|
      alignment will be choosen per variable size dependent on these
 | 
						|
      settings
 | 
						|
 | 
						|
  Revision 1.17  2001/06/03 21:57:36  peter
 | 
						|
    + hint directive parsing support
 | 
						|
 | 
						|
  Revision 1.16  2001/04/18 22:01:57  peter
 | 
						|
    * registration of targets and assemblers
 | 
						|
 | 
						|
  Revision 1.15  2001/04/13 01:22:12  peter
 | 
						|
    * symtable change to classes
 | 
						|
    * range check generation and errors fixed, make cycle DEBUG=1 works
 | 
						|
    * memory leaks fixed
 | 
						|
 | 
						|
  Revision 1.14  2001/04/04 22:43:52  peter
 | 
						|
    * remove unnecessary calls to firstpass
 | 
						|
 | 
						|
  Revision 1.13  2001/04/04 21:30:45  florian
 | 
						|
    * applied several fixes to get the DD8 Delphi Unit compiled
 | 
						|
     e.g. "forward"-interfaces are working now
 | 
						|
 | 
						|
  Revision 1.12  2001/04/02 21:20:33  peter
 | 
						|
    * resulttype rewrite
 | 
						|
 | 
						|
  Revision 1.11  2001/03/11 22:58:50  peter
 | 
						|
    * getsym redesign, removed the globals srsym,srsymtable
 | 
						|
 | 
						|
  Revision 1.10  2001/03/06 18:28:02  peter
 | 
						|
    * patch from Pavel with a new and much faster DLL Scanner for
 | 
						|
      automatic importing so $linklib works for DLLs. Thanks Pavel!
 | 
						|
 | 
						|
  Revision 1.9  2001/02/20 21:42:54  peter
 | 
						|
    * record and object declaration with same field as type fixed
 | 
						|
 | 
						|
  Revision 1.7  2001/02/20 11:19:45  marco
 | 
						|
   * Fix passing tvarrec to array of const
 | 
						|
 | 
						|
  Revision 1.6  2000/12/25 00:07:27  peter
 | 
						|
    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
 | 
						|
      tlinkedlist objects)
 | 
						|
 | 
						|
  Revision 1.5  2000/12/17 14:00:18  peter
 | 
						|
    * fixed static variables
 | 
						|
 | 
						|
  Revision 1.4  2000/11/29 00:30:36  florian
 | 
						|
    * unused units removed from uses clause
 | 
						|
    * some changes for widestrings
 | 
						|
 | 
						|
  Revision 1.3  2000/11/04 14:25:20  florian
 | 
						|
    + merged Attila's changes for interfaces, not tested yet
 | 
						|
 | 
						|
  Revision 1.2  2000/10/31 22:02:49  peter
 | 
						|
    * symtable splitted, no real code changes
 | 
						|
 | 
						|
  Revision 1.1  2000/10/14 10:14:51  peter
 | 
						|
    * moehrendorf oct 2000 rewrite
 | 
						|
 | 
						|
}
 |