mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-25 17:19:15 +02:00
812 lines
32 KiB
ObjectPascal
812 lines
32 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2002 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 fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ common }
|
|
cutils,cclasses,
|
|
{ global }
|
|
globtype,globals,tokens,verbose,
|
|
systems,
|
|
{ symtable }
|
|
symconst,symbase,symtype,symdef,symsym,symtable,defutil,
|
|
fmodule,
|
|
{ pass 1 }
|
|
node,
|
|
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
|
|
{ codegen }
|
|
ncgutil,
|
|
{ parser }
|
|
scanner,
|
|
pbase,pexpr,ptype,ptconst,pdecsub,
|
|
{ link }
|
|
import
|
|
{$ifdef Delphi}
|
|
,dmisc
|
|
,sysutils
|
|
{$endif}
|
|
;
|
|
|
|
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(sc : tsinglelist;tt : ttype;is_threadvar : boolean; addsymopts : tsymoptions);
|
|
{ inserts the symbols of sc in st with def as definition or sym as ttypesym, sc is disposed }
|
|
var
|
|
vs,vs2 : tvarsym;
|
|
begin
|
|
vs:=tvarsym(sc.first);
|
|
while assigned(vs) do
|
|
begin
|
|
vs.vartype:=tt;
|
|
{ insert any additional hint directives }
|
|
vs.symoptions := vs.symoptions + addsymopts;
|
|
if (sp_static in current_object_option) then
|
|
include(vs.symoptions,sp_static);
|
|
if is_threadvar then
|
|
include(vs.varoptions,vo_is_thread_var);
|
|
{ static data fields are inserted in the globalsymtable }
|
|
if (symtablestack.symtabletype=objectsymtable) and
|
|
(sp_static in current_object_option) then
|
|
begin
|
|
vs2:=tvarsym.create('$'+lower(symtablestack.name^)+'_'+vs.name,vs_value,tt);
|
|
symtablestack.defowner.owner.insert(vs2);
|
|
insertbssdata(vs2);
|
|
end
|
|
else
|
|
begin
|
|
{ external data is not possible here }
|
|
case symtablestack.symtabletype of
|
|
globalsymtable,
|
|
staticsymtable :
|
|
insertbssdata(vs);
|
|
recordsymtable,
|
|
objectsymtable :
|
|
tabstractrecordsymtable(symtablestack).insertfield(vs,false);
|
|
end;
|
|
end;
|
|
vs:=tvarsym(vs.listnext);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
sc : tsinglelist;
|
|
old_block_type : tblock_type;
|
|
symdone : boolean;
|
|
{ to handle absolute }
|
|
abssym : tabsolutesym;
|
|
{ c var }
|
|
newtype : ttypesym;
|
|
is_dll,
|
|
is_gpc_name,is_cdecl,
|
|
extern_var,export_var : boolean;
|
|
old_current_object_option : tsymoptions;
|
|
hs,sorg,C_name,dll_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 }
|
|
maxsize, startvarrecsize : longint;
|
|
usedalign,
|
|
minalignment,maxalignment,startvarrecalign : byte;
|
|
hp,pt : tnode;
|
|
vs,vs2 : tvarsym;
|
|
srsym : tsym;
|
|
oldsymtablestack,
|
|
srsymtable : tsymtable;
|
|
unionsymtable : trecordsymtable;
|
|
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 }
|
|
sc:=tsinglelist.create;
|
|
while (token=_ID) and
|
|
not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do
|
|
begin
|
|
sorg:=orgpattern;
|
|
sc.reset;
|
|
repeat
|
|
vs:=tvarsym.create(orgpattern,vs_value,generrortype);
|
|
symtablestack.insert(vs);
|
|
if assigned(vs.owner) then
|
|
sc.insert(vs)
|
|
else
|
|
vs.free;
|
|
consume(_ID);
|
|
until not try_to_consume(_COMMA);
|
|
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 or is_object then
|
|
begin
|
|
{ for records, don't search the recordsymtable for
|
|
the symbols of the types }
|
|
oldsymtablestack:=symtablestack;
|
|
symtablestack:=symtablestack.next;
|
|
read_type(tt,'',false);
|
|
symtablestack:=oldsymtablestack;
|
|
end
|
|
else
|
|
read_type(tt,'',false);
|
|
{ Process procvar directives }
|
|
if (tt.def.deftype=procvardef) and
|
|
(tt.def.typesym=nil) and
|
|
is_proc_directive(token,true) then
|
|
begin
|
|
newtype:=ttypesym.create('unnamed',tt);
|
|
parse_var_proc_directives(tsym(newtype));
|
|
newtype.restype.def:=nil;
|
|
tt.def.typesym:=nil;
|
|
newtype.free;
|
|
end;
|
|
{ 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
|
|
vs:=tvarsym(sc.first);
|
|
if assigned(vs.listnext) then
|
|
Message(parser_e_absolute_only_one_var);
|
|
vs.vartype:=tt;
|
|
include(vs.varoptions,vo_is_C_var);
|
|
vs.set_mangledname(target_info.Cprefix+sorg);
|
|
include(vs.varoptions,vo_is_external);
|
|
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);
|
|
abssym:=nil;
|
|
{ only allowed for one var }
|
|
vs:=tvarsym(sc.first);
|
|
if assigned(vs.listnext) then
|
|
Message(parser_e_absolute_only_one_var);
|
|
{ parse the rest }
|
|
pt:=expr;
|
|
{ transform a procvar calln to loadn }
|
|
if pt.nodetype=calln then
|
|
load_procvar_from_calln(pt);
|
|
{ check allowed absolute types }
|
|
if (pt.nodetype=stringconstn) or
|
|
(is_constcharnode(pt)) then
|
|
begin
|
|
abssym:=tabsolutesym.create(vs.realname,tt);
|
|
abssym.fileinfo:=vs.fileinfo;
|
|
if pt.nodetype=stringconstn then
|
|
hs:=strpas(tstringconstnode(pt).value_str)
|
|
else
|
|
hs:=chr(tordconstnode(pt).value);
|
|
consume(token);
|
|
abssym.abstyp:=toasm;
|
|
abssym.asmname:=stringdup(hs);
|
|
{ replace the varsym }
|
|
symtablestack.replace(vs,abssym);
|
|
vs.free;
|
|
end
|
|
{ address }
|
|
else if is_constintnode(pt) and
|
|
((target_info.system in [system_i386_go32v2,system_i386_watcom,
|
|
system_i386_wdosx,system_i386_win32]) or
|
|
(m_objfpc in aktmodeswitches) or
|
|
(m_delphi in aktmodeswitches)) then
|
|
begin
|
|
abssym:=tabsolutesym.create(vs.realname,tt);
|
|
abssym.fileinfo:=vs.fileinfo;
|
|
abssym.abstyp:=toaddr;
|
|
abssym.absseg:=false;
|
|
abssym.fieldoffset:=tordconstnode(pt).value;
|
|
if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and
|
|
try_to_consume(_COLON) then
|
|
begin
|
|
pt.free;
|
|
pt:=expr;
|
|
if is_constintnode(pt) then
|
|
begin
|
|
abssym.fieldoffset:=abssym.fieldoffset shl 4+tordconstnode(pt).value;
|
|
abssym.absseg:=true;
|
|
end
|
|
else
|
|
Message(type_e_ordinal_expr_expected);
|
|
end;
|
|
symtablestack.replace(vs,abssym);
|
|
vs.free;
|
|
end
|
|
{ variable }
|
|
else
|
|
begin
|
|
{ remove subscriptn before checking for loadn }
|
|
hp:=pt;
|
|
while (hp.nodetype in [subscriptn,typeconvn,vecn]) do
|
|
hp:=tsubscriptnode(hp).left;
|
|
if (hp.nodetype=loadn) then
|
|
begin
|
|
{ we should check the result type of loadn }
|
|
if not (tloadnode(hp).symtableentry.typ in [varsym,typedconstsym]) then
|
|
Message(parser_e_absolute_only_to_var_or_const);
|
|
abssym:=tabsolutesym.create(vs.realname,tt);
|
|
abssym.fileinfo:=vs.fileinfo;
|
|
abssym.abstyp:=tovar;
|
|
abssym.ref:=node_to_symlist(pt);
|
|
symtablestack.replace(vs,abssym);
|
|
vs.free;
|
|
end
|
|
else
|
|
Message(parser_e_absolute_only_to_var_or_const);
|
|
end;
|
|
if assigned(abssym) then
|
|
begin
|
|
{ try to consume the hint directives with absolute symbols }
|
|
dummysymoptions:=[];
|
|
try_consume_hintdirective(dummysymoptions);
|
|
abssym.symoptions := abssym.symoptions + dummysymoptions;
|
|
end;
|
|
pt.free;
|
|
symdone:=true;
|
|
end;
|
|
{ Records and objects can't have default values }
|
|
if is_record or is_object then
|
|
begin
|
|
{ try to parse the hint directives }
|
|
dummysymoptions:=[];
|
|
try_consume_hintdirective(dummysymoptions);
|
|
|
|
{ for a record there doesn't need to be a ; before the END or ) }
|
|
if not(token in [_END,_RKLAMMER]) then
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
begin
|
|
{ Process procvar directives before = and ; }
|
|
if (tt.def.deftype=procvardef) and
|
|
(tt.def.typesym=nil) and
|
|
is_proc_directive(token,true) then
|
|
begin
|
|
newtype:=ttypesym.create('unnamed',tt);
|
|
parse_var_proc_directives(tsym(newtype));
|
|
newtype.restype.def:=nil;
|
|
tt.def.typesym:=nil;
|
|
newtype.free;
|
|
end;
|
|
|
|
{ try to parse the hint directives }
|
|
dummysymoptions:=[];
|
|
try_consume_hintdirective(dummysymoptions);
|
|
|
|
{ Handling of Delphi typed const = initialized vars ! }
|
|
{ When should this be rejected ?
|
|
- in parasymtable
|
|
- in record or object
|
|
- ... (PM) }
|
|
if (token=_EQUAL) and
|
|
not(m_tp7 in aktmodeswitches) and
|
|
not(symtablestack.symtabletype in [parasymtable]) and
|
|
not is_record and
|
|
not is_object then
|
|
begin
|
|
vs:=tvarsym(sc.first);
|
|
if assigned(vs.listnext) then
|
|
Message(parser_e_initialized_only_one_var);
|
|
if is_threadvar then
|
|
Message(parser_e_initialized_not_for_threadvar);
|
|
if symtablestack.symtabletype=localsymtable then
|
|
begin
|
|
consume(_EQUAL);
|
|
tconstsym:=ttypedconstsym.createtype('default'+vs.realname,tt,false);
|
|
vs.defaultconstsym:=tconstsym;
|
|
symtablestack.insert(tconstsym);
|
|
insertconstdata(tconstsym);
|
|
readtypedconst(tt,tconstsym,false);
|
|
end
|
|
else
|
|
begin
|
|
tconstsym:=ttypedconstsym.createtype(vs.realname,tt,true);
|
|
tconstsym.fileinfo:=vs.fileinfo;
|
|
symtablestack.replace(vs,tconstsym);
|
|
vs.free;
|
|
insertconstdata(tconstsym);
|
|
consume(_EQUAL);
|
|
readtypedconst(tt,tconstsym,true);
|
|
symdone:=true;
|
|
end;
|
|
consume(_SEMICOLON);
|
|
end
|
|
else
|
|
begin
|
|
consume(_SEMICOLON);
|
|
end;
|
|
end;
|
|
{ Add calling convention for procvars }
|
|
if (tt.def.deftype=procvardef) and
|
|
(tt.def.typesym=nil) then
|
|
begin
|
|
{ Parse procvar directives after ; }
|
|
if is_proc_directive(token,true) then
|
|
begin
|
|
newtype:=ttypesym.create('unnamed',tt);
|
|
parse_var_proc_directives(tsym(newtype));
|
|
newtype.restype.def:=nil;
|
|
tt.def.typesym:=nil;
|
|
newtype.free;
|
|
end;
|
|
{ Add calling convention for procvar }
|
|
handle_calling_convention(tprocvardef(tt.def));
|
|
calc_parast(tprocvardef(tt.def));
|
|
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 }
|
|
vs:=tvarsym(sc.first);
|
|
if assigned(vs.listnext) then
|
|
Message(parser_e_absolute_only_one_var);
|
|
{ set type of the var }
|
|
vs.vartype:=tt;
|
|
vs.symoptions := vs.symoptions + dummysymoptions;
|
|
{ defaults }
|
|
is_dll:=false;
|
|
is_cdecl:=false;
|
|
extern_var:=false;
|
|
export_var:=false;
|
|
C_name:=sorg;
|
|
{ cdecl }
|
|
if idtoken=_CVAR then
|
|
begin
|
|
consume(_CVAR);
|
|
consume(_SEMICOLON);
|
|
is_cdecl:=true;
|
|
C_name:=target_info.Cprefix+sorg;
|
|
end;
|
|
{ external }
|
|
if idtoken=_EXTERNAL then
|
|
begin
|
|
consume(_EXTERNAL);
|
|
extern_var:=true;
|
|
end;
|
|
{ export }
|
|
if idtoken in [_EXPORT,_PUBLIC] then
|
|
begin
|
|
consume(_ID);
|
|
if extern_var or
|
|
(symtablestack.symtabletype in [parasymtable,localsymtable]) then
|
|
Message(parser_e_not_external_and_export)
|
|
else
|
|
export_var:=true;
|
|
end;
|
|
{ external and export need a name after when no cdecl is used }
|
|
if not is_cdecl then
|
|
begin
|
|
{ dll name ? }
|
|
if (extern_var) 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_var or export_var then
|
|
consume(_SEMICOLON);
|
|
{ set some vars options }
|
|
if is_dll then
|
|
include(vs.varoptions,vo_is_dll_var)
|
|
else
|
|
include(vs.varoptions,vo_is_C_var);
|
|
vs.set_mangledname(C_Name);
|
|
if export_var then
|
|
begin
|
|
inc(vs.refs);
|
|
include(vs.varoptions,vo_is_exported);
|
|
end;
|
|
if extern_var then
|
|
include(vs.varoptions,vo_is_external);
|
|
{ insert in the datasegment when it is not external }
|
|
if (not extern_var) then
|
|
insertbssdata(vs);
|
|
{ now we can insert it in the import lib if its a dll, or
|
|
add it to the externals }
|
|
if extern_var 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(vs,C_name,dll_name);
|
|
end
|
|
else
|
|
if target_info.DllScanSupported then
|
|
current_module.Externals.insert(tExternalsItem.create(vs.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(sc,tt,false,dummysymoptions);
|
|
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);
|
|
{ recover by changing access type to public }
|
|
vs2:=tvarsym(sc.first);
|
|
while assigned (vs2) do
|
|
begin
|
|
exclude(vs2.symoptions,sp_published);
|
|
include(vs2.symoptions,sp_public);
|
|
vs2:=tvarsym(vs2.listnext);
|
|
end;
|
|
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(sc,tt,is_threadvar,dummysymoptions);
|
|
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);
|
|
sorg:=orgpattern;
|
|
hs:=pattern;
|
|
searchsym(hs,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,'',true);
|
|
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,'',true);
|
|
symtablestack:=oldsymtablestack;
|
|
vs:=tvarsym.create(sorg,vs_value,casetype);
|
|
tabstractrecordsymtable(symtablestack).insertfield(vs,true);
|
|
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);
|
|
uniondef.isunion:=true;
|
|
if assigned(symtablestack.defowner) then
|
|
Uniondef.owner:=symtablestack.defowner.owner;
|
|
registerdef:=true;
|
|
startvarrecsize:=UnionSymtable.datasize;
|
|
startvarrecalign:=UnionSymtable.dataalignment;
|
|
symtablestack:=UnionSymtable;
|
|
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,unionsymtable.datasize);
|
|
maxalignment:=max(maxalignment,unionsymtable.dataalignment);
|
|
{ the items of the next variant are overlayed }
|
|
unionsymtable.datasize:=startvarrecsize;
|
|
unionsymtable.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 }
|
|
unionsymtable.datasize:=maxsize;
|
|
unionsymtable.dataalignment:=maxalignment;
|
|
uniontype.def:=uniondef;
|
|
uniontype.sym:=nil;
|
|
UnionSym:=tvarsym.create('$case',vs_value,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(trecordsymtable(symtablestack).datasize,usedalign);
|
|
trecordsymtable(symtablestack).datasize:=offset+unionsymtable.datasize;
|
|
if maxalignment>trecordsymtable(symtablestack).dataalignment then
|
|
trecordsymtable(symtablestack).dataalignment:=maxalignment;
|
|
Unionsymtable.Insert_in(trecordsymtable(symtablestack),offset);
|
|
Unionsym.owner:=nil;
|
|
unionsym.free;
|
|
uniondef.owner:=nil;
|
|
uniondef.free;
|
|
end;
|
|
block_type:=old_block_type;
|
|
current_object_option:=old_current_object_option;
|
|
{ free the list }
|
|
sc.free;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.58 2003-11-23 17:05:15 peter
|
|
* register calling is left-right
|
|
* parameter ordering
|
|
* left-right calling inserts result parameter last
|
|
|
|
Revision 1.57 2003/10/28 15:36:01 peter
|
|
* absolute to object field supported, fixes tb0458
|
|
|
|
Revision 1.56 2003/10/05 12:55:37 peter
|
|
* allow absolute with value for win32,wdos
|
|
|
|
Revision 1.55 2003/10/03 14:45:09 peter
|
|
* more proc directive for procvar fixes
|
|
|
|
Revision 1.54 2003/10/02 21:13:09 peter
|
|
* procvar directive parsing fixes
|
|
|
|
Revision 1.53 2003/10/02 15:12:07 peter
|
|
* fix type parsing in records
|
|
|
|
Revision 1.52 2003/10/01 19:05:33 peter
|
|
* searchsym_type to search for type definitions. It ignores
|
|
records,objects and parameters
|
|
|
|
Revision 1.51 2003/09/23 17:56:05 peter
|
|
* locals and paras are allocated in the code generation
|
|
* tvarsym.localloc contains the location of para/local when
|
|
generating code for the current procedure
|
|
|
|
Revision 1.50 2003/09/07 14:14:51 florian
|
|
* proper error recovering from invalid published fields
|
|
|
|
Revision 1.49 2003/09/05 17:41:12 florian
|
|
* merged Wiktor's Watcom patches in 1.1
|
|
|
|
Revision 1.48 2003/07/02 22:18:04 peter
|
|
* paraloc splitted in callerparaloc,calleeparaloc
|
|
* sparc calling convention updates
|
|
|
|
Revision 1.47 2003/05/09 17:47:03 peter
|
|
* self moved to hidden parameter
|
|
* removed hdisposen,hnewn,selfn
|
|
|
|
Revision 1.46 2003/04/25 20:59:33 peter
|
|
* removed funcretn,funcretsym, function result is now in varsym
|
|
and aliases for result and function name are added using absolutesym
|
|
* vs_hidden parameter for funcret passed in parameter
|
|
* vs_hidden fixes
|
|
* writenode changed to printnode and released from extdebug
|
|
* -vp option added to generate a tree.log with the nodetree
|
|
* nicer printnode for statements, callnode
|
|
|
|
Revision 1.45 2003/03/17 18:56:02 peter
|
|
* fix crash with duplicate id
|
|
|
|
Revision 1.44 2003/01/02 11:14:02 michael
|
|
+ Patch from peter to support initial values for local variables
|
|
|
|
Revision 1.43 2002/12/27 15:22:20 peter
|
|
* don't allow initialized threadvars
|
|
|
|
Revision 1.42 2002/12/07 14:04:59 carl
|
|
* convert some vars from longint -> byte
|
|
|
|
Revision 1.41 2002/11/29 22:31:19 carl
|
|
+ unimplemented hint directive added
|
|
* hint directive parsing implemented
|
|
* warning on these directives
|
|
|
|
Revision 1.40 2002/11/25 17:43:21 peter
|
|
* splitted defbase in defutil,symutil,defcmp
|
|
* merged isconvertable and is_equal into compare_defs(_ext)
|
|
* made operator search faster by walking the list only once
|
|
|
|
Revision 1.39 2002/11/15 16:29:31 peter
|
|
* made tasmsymbol.refs private (merged)
|
|
|
|
Revision 1.38 2002/11/15 01:58:53 peter
|
|
* merged changes from 1.0.7 up to 04-11
|
|
- -V option for generating bug report tracing
|
|
- more tracing for option parsing
|
|
- errors for cdecl and high()
|
|
- win32 import stabs
|
|
- win32 records<=8 are returned in eax:edx (turned off by default)
|
|
- heaptrc update
|
|
- more info for temp management in .s file with EXTDEBUG
|
|
|
|
Revision 1.37 2002/10/05 15:18:43 carl
|
|
* fix heap leaks
|
|
|
|
Revision 1.36 2002/10/05 12:43:26 carl
|
|
* fixes for Delphi 6 compilation
|
|
(warning : Some features do not work under Delphi)
|
|
|
|
Revision 1.35 2002/10/04 20:53:05 carl
|
|
* bugfix of crash
|
|
|
|
Revision 1.34 2002/10/03 21:22:01 carl
|
|
* don't make the vars regable if they are absolute and their definitions
|
|
are not the same.
|
|
|
|
Revision 1.33 2002/09/16 18:08:45 peter
|
|
* fix setting of sp_static
|
|
|
|
Revision 1.32 2002/09/09 17:34:15 peter
|
|
* tdicationary.replace added to replace and item in a dictionary. This
|
|
is only allowed for the same name
|
|
* varsyms are inserted in symtable before the types are parsed. This
|
|
fixes the long standing "var longint : longint" bug
|
|
- consume_idlist and idstringlist removed. The loops are inserted
|
|
at the callers place and uses the symtable for duplicate id checking
|
|
|
|
Revision 1.31 2002/08/25 19:25:20 peter
|
|
* sym.insert_in_data removed
|
|
* symtable.insertvardata/insertconstdata added
|
|
* removed insert_in_data call from symtable.insert, it needs to be
|
|
called separatly. This allows to deref the address calculation
|
|
* procedures now calculate the parast addresses after the procedure
|
|
directives are parsed. This fixes the cdecl parast problem
|
|
* push_addr_param has an extra argument that specifies if cdecl is used
|
|
or not
|
|
|
|
Revision 1.30 2002/07/29 21:23:44 florian
|
|
* more fixes for the ppc
|
|
+ wrappers for the tcnvnode.first_* stuff introduced
|
|
|
|
Revision 1.29 2002/07/26 21:15:40 florian
|
|
* rewrote the system handling
|
|
|
|
Revision 1.28 2002/07/20 11:57:55 florian
|
|
* types.pas renamed to defbase.pas because D6 contains a types
|
|
unit so this would conflicts if D6 programms are compiled
|
|
+ Willamette/SSE2 instructions to assembler added
|
|
|
|
Revision 1.27 2002/06/10 13:41:26 jonas
|
|
* fixed bug 1985
|
|
|
|
Revision 1.26 2002/05/18 13:34:12 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.25 2002/05/16 19:46:43 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.23 2002/04/21 18:57:24 peter
|
|
* fixed memleaks when file can't be opened
|
|
|
|
}
|