diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas
index 41ee78fb3b..d45bc39717 100644
--- a/compiler/cgbase.pas
+++ b/compiler/cgbase.pas
@@ -72,11 +72,6 @@ unit cgbase;
frame pointer from the outer procedure is stored.
}
framepointer_offset : longint;
- {# offset from frame pointer to get self reference }
- selfpointer_offset : longint;
- {# offset from frame pointer to get vmt reference (constructors only) }
- inheritedflag_offset,
- vmtpointer_offset : longint;
{# result value offset in stack (functions only) }
return_offset : longint;
{# firsttemp position }
@@ -352,9 +347,6 @@ implementation
parent:=aparent;
procdef:=nil;
framepointer_offset:=0;
- selfpointer_offset:=0;
- vmtpointer_offset:=0;
- inheritedflag_offset:=0;
return_offset:=0;
firsttemp_offset:=0;
flags:=[];
@@ -424,60 +416,7 @@ implementation
begin
{ Retrieve function result offset }
if assigned(procdef.funcretsym) then
- begin
- current_procinfo.return_offset:=tvarsym(procdef.funcretsym).address+
- tvarsym(procdef.funcretsym).owner.address_fixup;
- if tvarsym(procdef.funcretsym).owner.symtabletype=localsymtable then
- current_procinfo.return_offset:=tg.direction*current_procinfo.return_offset;
- end;
- { retrieve offsets of self/vmt }
- if assigned(procdef._class) then
- begin
- if (po_containsself in procdef.procoptions) then
- begin
- inc(current_procinfo.selfpointer_offset,tvarsym(procdef.selfpara.parasym).address);
- end
- else
- { self isn't pushed in nested procedure of methods }
- if (procdef.parast.symtablelevel=normal_function_level) then
- begin
- srsym:=tvarsym(procdef.parast.search('self'));
- if not assigned(srsym) then
- internalerror(200305058);
- selfpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
- end;
-
- { Special parameters for de-/constructors }
- case procdef.proctypeoption of
- potype_constructor :
- begin
- srsym:=tvarsym(procdef.parast.search('vmt'));
- if not assigned(srsym) then
- internalerror(200305058);
- vmtpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
- end;
- potype_destructor :
- begin
- if is_object(procdef._class) then
- begin
- srsym:=tvarsym(procdef.parast.search('vmt'));
- if not assigned(srsym) then
- internalerror(200305058);
- vmtpointer_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
- end
- else
- if is_class(procdef._class) then
- begin
- srsym:=tvarsym(procdef.parast.search('vmt'));
- if not assigned(srsym) then
- internalerror(200305058);
- inheritedflag_offset:=tvarsym(srsym).address+srsym.owner.address_fixup;
- end
- else
- internalerror(200303261);
- end;
- end;
- end;
+ current_procinfo.return_offset:=tvarsym(procdef.funcretsym).adjusted_address;
end;
@@ -640,7 +579,13 @@ implementation
end.
{
$Log$
- Revision 1.47 2003-05-13 19:14:41 peter
+ Revision 1.48 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.47 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas
index 4ef67a56ee..202eee47ac 100644
--- a/compiler/cgobj.pas
+++ b/compiler/cgobj.pas
@@ -374,7 +374,7 @@ unit cgobj;
a routine declared as @var(interrupt). The default
behavior does nothing, should be overriden as required.
}
- procedure g_interrupt_stackframe_exit(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;
+ procedure g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);virtual;
{# Emits instructions when compilation is done in profile
mode (this is set as a command line option). The default
@@ -424,7 +424,7 @@ unit cgobj;
}
procedure g_restore_standard_registers(list:Taasmoutput;usedinproc:Tsupregset);virtual;abstract;
procedure g_save_all_registers(list : taasmoutput);virtual;abstract;
- procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;abstract;
+ procedure g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);virtual;abstract;
end;
{# @abstract(Abstract code generator for 64 Bit operations)
@@ -1635,7 +1635,7 @@ unit cgobj;
end;
- procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput;selfused,accused,acchiused:boolean);
+ procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);
begin
end;
@@ -1697,7 +1697,13 @@ finalization
end.
{
$Log$
- Revision 1.97 2003-05-13 19:14:41 peter
+ Revision 1.98 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.97 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas
index 33fdff50d1..736553e807 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -1175,7 +1175,7 @@ implementation
exit;
end;
{ check return value and options, methodpointer is already checked }
- po_comp:=[po_staticmethod,po_containsself,po_interrupt,
+ po_comp:=[po_staticmethod,po_interrupt,
po_iocheck,po_varargs];
if (m_delphi in aktmodeswitches) then
exclude(po_comp,po_varargs);
@@ -1211,7 +1211,13 @@ implementation
end.
{
$Log$
- Revision 1.24 2003-05-09 17:47:02 peter
+ Revision 1.25 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.24 2003/05/09 17:47:02 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn
diff --git a/compiler/globals.pas b/compiler/globals.pas
index 7ed91419bd..db1ca008be 100644
--- a/compiler/globals.pas
+++ b/compiler/globals.pas
@@ -130,7 +130,6 @@ interface
do_build,
do_release,
do_make : boolean;
- not_unit_proc : boolean;
{ path for searching units, different paths can be seperated by ; }
exepath : dirstr; { Path to ppc }
librarysearchpath,
@@ -154,18 +153,14 @@ interface
block_type : tblock_type; { type of currently parsed block }
- in_args : boolean; { arguments must be checked especially }
parsing_para_level : integer; { parameter level, used to convert
proc calls to proc loads in firstcalln }
compile_level : word;
make_ref : boolean;
resolving_forward : boolean; { used to add forward reference as second ref }
- use_esp_stackframe : boolean; { to test for call with ESP as stack frame }
inlining_procedure : boolean; { are we inlining a procedure }
- statement_level : integer;
exceptblockcounter : integer; { each except block gets a unique number check gotos }
aktexceptblock : integer; { the exceptblock number of the current block (0 if none) }
- have_local_threadvars : boolean; { set if a table of local threadvars-tables is present and has to be initialized }
{ commandline values }
initdefines : tstringlist;
@@ -1448,7 +1443,6 @@ implementation
DLLsource:=false;
inlining_procedure:=false;
resolving_forward:=false;
- in_args:=false;
make_ref:=false;
{ Output }
@@ -1515,20 +1509,19 @@ implementation
stacksize:=0;
heapsize:=0;
- { compile state }
- in_args:=false;
- { must_be_valid:=true; obsolete PM }
- not_unit_proc:=true;
-
apptype:=app_cui;
-
- have_local_threadvars := false;
end;
end.
{
$Log$
- Revision 1.88 2003-04-27 11:21:32 peter
+ Revision 1.89 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.88 2003/04/27 11:21:32 peter
* aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be
diff --git a/compiler/i386/n386obj.pas b/compiler/i386/n386obj.pas
index 2d4d55c960..ff20e8ced3 100644
--- a/compiler/i386/n386obj.pas
+++ b/compiler/i386/n386obj.pas
@@ -167,7 +167,7 @@ begin
if procdef.proctypeoption<>potype_none then
Internalerror(200006137);
if not assigned(procdef._class) or
- (procdef.procoptions*[po_containsself, po_classmethod, po_staticmethod,
+ (procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>objectsymtable then
@@ -247,7 +247,13 @@ initialization
end.
{
$Log$
- Revision 1.18 2003-04-22 14:33:38 peter
+ Revision 1.19 2003-05-15 18:58:54 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.18 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.17 2003/01/13 14:54:34 daniel
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index 858cc626e3..5a646ef777 100644
--- a/compiler/ncgcal.pas
+++ b/compiler/ncgcal.pas
@@ -805,14 +805,10 @@ implementation
if (po_methodpointer in procdefinition.procoptions) then
begin
- { push self, but not if it's already explicitly pushed }
- if not(po_containsself in procdefinition.procoptions) then
- begin
- { push self }
- href:=right.location.reference;
- inc(href.offset,POINTER_SIZE);
- cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
- end;
+ { push self }
+ href:=right.location.reference;
+ inc(href.offset,POINTER_SIZE);
+ cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
@@ -1022,7 +1018,10 @@ implementation
if st.datasize>0 then
begin
tg.GetTemp(exprasmlist,st.datasize,tt_persistant,localsref);
- st.address_fixup:=localsref.offset+st.datasize;
+ if tg.direction>0 then
+ st.address_fixup:=localsref.offset
+ else
+ st.address_fixup:=localsref.offset+st.datasize;
{$ifdef extdebug}
Comment(V_debug,'local symtable is at offset '+tostr(st.address_fixup));
exprasmList.concat(tai_comment.Create(strpnew(
@@ -1129,7 +1128,13 @@ begin
end.
{
$Log$
- Revision 1.64 2003-05-14 19:36:54 jonas
+ Revision 1.65 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.64 2003/05/14 19:36:54 jonas
* patch from Peter for int64 function results
Revision 1.63 2003/05/13 19:14:41 peter
diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas
index dd5c2e41eb..6147a17115 100644
--- a/compiler/ncgld.pas
+++ b/compiler/ncgld.pas
@@ -192,25 +192,8 @@ implementation
inlineparasymtable :
begin
location.reference.base:=current_procinfo.framepointer;
- if (symtabletype in [inlinelocalsymtable,
- localsymtable])
- then
- location.reference.offset:=
- tvarsym(symtableentry).address+tg.direction*symtable.address_fixup
- else
- location.reference.offset:=
- tvarsym(symtableentry).address+symtable.address_fixup;
+ location.reference.offset:=tvarsym(symtableentry).adjusted_address;
-{$ifndef powerpc}
- if (symtabletype in [localsymtable,inlinelocalsymtable]) then
- begin
- if use_esp_stackframe then
- dec(location.reference.offset,
- tvarsym(symtableentry).getvaluesize)
- else
- location.reference.offset:=-location.reference.offset;
- end;
-{$endif powerpc}
if (current_procdef.parast.symtablelevel>symtable.symtablelevel) then
begin
hregister:=rg.getaddressregister(exprasmlist);
@@ -932,7 +915,13 @@ begin
end.
{
$Log$
- Revision 1.58 2003-05-12 17:22:00 jonas
+ Revision 1.59 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.58 2003/05/12 17:22:00 jonas
* fixed (last?) remaining -tvarsym(X).address to
tg.direction*tvarsym(X).address...
diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas
index 379a2e1876..165fe10070 100644
--- a/compiler/ncgutil.pas
+++ b/compiler/ncgutil.pas
@@ -975,13 +975,13 @@ implementation
(tvarsym(p).varspez=vs_value) and
(paramanager.push_addr_param(tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption)) then
begin
- reference_reset_base(href1,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+ reference_reset_base(href1,current_procinfo.framepointer,tvarsym(p).adjusted_address);
if is_open_array(tvarsym(p).vartype.def) or
is_array_of_const(tvarsym(p).vartype.def) then
cg.g_copyvaluepara_openarray(list,href1,tarraydef(tvarsym(p).vartype.def).elesize)
else
begin
- reference_reset_base(href2,current_procinfo.framepointer,tg.direction*tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup);
+ reference_reset_base(href2,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address);
if is_shortstring(tvarsym(p).vartype.def) then
cg.g_copyshortstring(list,href1,href2,tstringdef(tvarsym(p).vartype.def).len,false,true)
else
@@ -1007,7 +1007,7 @@ implementation
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
- reference_reset_base(href,current_procinfo.framepointer,tg.direction*tvarsym(p).address+tvarsym(p).owner.address_fixup)
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
else
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
@@ -1032,7 +1032,7 @@ implementation
tvarsym(p).vartype.def.needs_inittable then
begin
if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
- reference_reset_base(href,current_procinfo.framepointer,tg.direction*tvarsym(p).address+tvarsym(p).owner.address_fixup)
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address)
else
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(p).mangledname),0);
cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
@@ -1070,15 +1070,14 @@ implementation
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if assigned(tvarsym(p).localvarsym) then
- reference_reset_base(href,current_procinfo.framepointer,
- tg.direction*tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
else
- reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
cg.g_incrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
end;
vs_out :
begin
- reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
@@ -1111,10 +1110,9 @@ implementation
if (tvarsym(p).varspez=vs_value) then
begin
if assigned(tvarsym(p).localvarsym) then
- reference_reset_base(href,current_procinfo.framepointer,
- tg.direction*tvarsym(p).localvarsym.address+tvarsym(p).localvarsym.owner.address_fixup)
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).localvarsym.adjusted_address)
else
- reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).address+tvarsym(p).owner.address_fixup);
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(p).adjusted_address);
cg.g_decrrefcount(list,tvarsym(p).vartype.def,href,is_open_array(tvarsym(p).vartype.def));
end;
end;
@@ -1357,11 +1355,10 @@ implementation
cg.a_loadfpu_reg_reg(list,hp.paraloc.register,tvarsym(hp.parasym).reg);
end
else if (hp.paraloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
- LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
- (tvarsym(hp.parasym).reg.enum=R_NO) then
+ LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
+ (tvarsym(hp.parasym).reg.enum=R_NO) then
begin
- reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).address+
- tvarsym(hp.parasym).owner.address_fixup);
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
case hp.paraloc.loc of
LOC_CREGISTER,
LOC_REGISTER:
@@ -1620,13 +1617,13 @@ implementation
stabsendlabel : tasmlabel;
mangled_length : longint;
p : pchar;
- st : string[2];
{$endif GDB}
okexitlabel : tasmlabel;
href : treference;
+ srsym : tsym;
usesacc,
usesacchi,
- usesself,usesfpu : boolean;
+ usesfpu : boolean;
rsp,r : Tregister;
begin
if aktexit2label.is_used and
@@ -1639,7 +1636,7 @@ implementation
end;
if aktexitlabel.is_used then
- list.concat(Tai_label.Create(aktexitlabel));
+ cg.a_label(list,aktexitlabel);
cleanup_regvars(list);
@@ -1680,7 +1677,6 @@ implementation
they didn't reference the result variable }
usesacc:=false;
usesacchi:=false;
- usesself:=false;
if not(po_assembler in current_procdef.procoptions) or
(assigned(current_procdef.funcretsym) and
(tvarsym(current_procdef.funcretsym).refcount>1)) then
@@ -1695,7 +1691,10 @@ implementation
r.number:=NR_ACCUMULATOR;
cg.a_reg_alloc(list,r);
{ return the self pointer }
- reference_reset_base(href, current_procinfo.framepointer,current_procinfo.selfpointer_offset);
+ srsym:=tvarsym(current_procdef.parast.search('self'));
+ if not assigned(srsym) then
+ internalerror(200305058);
+ reference_reset_base(href,current_procinfo.framepointer,tvarsym(srsym).adjusted_address);
cg.a_load_ref_reg(list,OS_ADDR,href,r);
cg.a_reg_dealloc(list,r);
usesacc:=true;
@@ -1730,7 +1729,7 @@ implementation
{ for the save all registers we can simply use a pusha,popa which
push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
if (po_saveregisters in current_procdef.procoptions) then
- cg.g_restore_all_registers(list,usesself,usesacc,usesacchi)
+ cg.g_restore_all_registers(list,usesacc,usesacchi)
else
{ should we restore edi ? }
if (po_savestdregs in current_procdef.procoptions) then
@@ -1753,7 +1752,7 @@ implementation
if not inlined then
begin
if (po_interrupt in current_procdef.procoptions) then
- cg.g_interrupt_stackframe_exit(list,usesself,usesacc,usesacchi)
+ cg.g_interrupt_stackframe_exit(list,usesacc,usesacchi)
else
begin
{$ifndef i386}
@@ -1773,42 +1772,6 @@ implementation
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and not inlined then
begin
- if assigned(current_procdef._class) then
- if (not assigned(current_procinfo.parent) or
- not assigned(current_procinfo.parent.procdef._class)) then
- begin
- if (po_classmethod in current_procdef.procoptions) or
- ((po_virtualmethod in current_procdef.procoptions) and
- (potype_constructor=current_procdef.proctypeoption)) or
- (po_staticmethod in current_procdef.procoptions) then
- begin
- list.concat(Tai_stabs.Create(strpnew(
- '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(current_procinfo.selfpointer_offset))));
- end
- else
- begin
- if not(is_class(current_procdef._class)) then
- st:='v'
- else
- st:='p';
- list.concat(Tai_stabs.Create(strpnew(
- '"$t:'+st+current_procdef._class.numberstring+'",'+
- tostr(N_tsym)+',0,0,'+tostr(current_procinfo.selfpointer_offset))));
- end;
- end
- else
- begin
- if not is_class(current_procdef._class) then
- st:='*'
- else
- st:='';
-{$warning GDB self}
- {list.concat(Tai_stabs.Create(strpnew(
- '"$t:r'+st+current_procdef._class.numberstring+'",'+
- tostr(N_RSYM)+',0,0,'+tostr(stab_regindex[SELF_POINTER_REG]))));}
- end;
-
{ define calling EBP as pseudo local var PM }
{ this enables test if the function is a local one !! }
if assigned(current_procinfo.parent) and
@@ -1872,7 +1835,13 @@ implementation
end.
{
$Log$
- Revision 1.103 2003-05-14 19:37:25 jonas
+ Revision 1.104 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.103 2003/05/14 19:37:25 jonas
* patch from Peter for int64 function results
Revision 1.102 2003/05/13 19:14:41 peter
diff --git a/compiler/parser.pas b/compiler/parser.pas
index 4fd5c7820b..6a18dfb5aa 100644
--- a/compiler/parser.pas
+++ b/compiler/parser.pas
@@ -287,7 +287,6 @@ implementation
old_compiled_module : tmodule;
oldaktdefproccall : tproccalloption;
oldsourcecodepage : tcodepagestring;
- oldstatement_level : integer;
{$ifdef GDB}
store_dbx : plongint;
{$endif GDB}
@@ -363,7 +362,6 @@ implementation
oldaktinterfacetype:=aktinterfacetype;
oldaktfilepos:=aktfilepos;
oldaktmodeswitches:=aktmodeswitches;
- oldstatement_level:=statement_level;
{$ifdef GDB}
store_dbx:=dbx_counter;
dbx_counter:=nil;
@@ -379,7 +377,6 @@ implementation
refsymtable:=nil;
aktdefproccall:=initdefproccall;
registerdef:=true;
- statement_level:=0;
aktexceptblock:=0;
exceptblockcounter:=0;
aktmaxfpuregisters:=-1;
@@ -548,7 +545,6 @@ implementation
aktinterfacetype:=oldaktinterfacetype;
aktfilepos:=oldaktfilepos;
aktmodeswitches:=oldaktmodeswitches;
- statement_level:=oldstatement_level;
aktexceptblock:=0;
exceptblockcounter:=0;
{$ifdef GDB}
@@ -622,7 +618,13 @@ implementation
end.
{
$Log$
- Revision 1.52 2003-04-27 11:21:33 peter
+ Revision 1.53 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.52 2003/04/27 11:21:33 peter
* aktprocdef renamed to current_procdef
* procinfo renamed to current_procinfo
* procinfo will now be stored in current_module so it can be
diff --git a/compiler/pass_2.pas b/compiler/pass_2.pas
index aebb752706..4310891cdc 100644
--- a/compiler/pass_2.pas
+++ b/compiler/pass_2.pas
@@ -264,7 +264,6 @@ implementation
rg.t_times:=100;
{ clear register count }
rg.clearregistercount;
- use_esp_stackframe:=false;
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs,nil);
symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs,nil);
{ firstpass everything }
@@ -302,7 +301,13 @@ implementation
end.
{
$Log$
- Revision 1.51 2003-05-13 19:14:41 peter
+ Revision 1.52 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.51 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
diff --git a/compiler/pbase.pas b/compiler/pbase.pas
index 4521d79411..3e07a8e1af 100644
--- a/compiler/pbase.pas
+++ b/compiler/pbase.pas
@@ -40,6 +40,12 @@ interface
{ true, if we are after an assignement }
afterassignment : boolean = false;
+ { true, if we are parsing arguments }
+ in_args : boolean = false;
+
+ { true, if we got an @ to get the address }
+ got_addrn : boolean = false;
+
{ special for handling procedure vars }
getprocvardef : tprocvardef = nil;
@@ -267,7 +273,13 @@ implementation
end.
{
$Log$
- Revision 1.23 2003-03-17 18:55:30 peter
+ Revision 1.24 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.23 2003/03/17 18:55:30 peter
* allow more tokens instead of only semicolon after inherited
Revision 1.22 2002/12/05 19:28:05 carl
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index ebf294e8f8..4a7b9b05df 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -45,8 +45,6 @@ interface
procedure insert_funcret_local(pd:tprocdef);
- procedure check_self_para(pd:tabstractprocdef);
-
function proc_add_definition(var pd:tprocdef):boolean;
procedure handle_calling_convention(pd:tabstractprocdef);
@@ -132,16 +130,13 @@ implementation
if (pd.deftype=procvardef) and
pd.is_methodpointer then
begin
- if not(po_containsself in pd.procoptions) then
- begin
- { Generate self variable }
- tt:=voidpointertype;
- vs:=tvarsym.create('$self',vs_value,tt);
- include(vs.varoptions,vo_is_self);
- { Insert as hidden parameter }
- pd.parast.insert(vs);
- pd.insertpara(vs.vartype,vs,nil,true);
- end;
+ { Generate self variable }
+ tt:=voidpointertype;
+ vs:=tvarsym.create('$self',vs_value,tt);
+ include(vs.varoptions,vo_is_self);
+ { Insert as hidden parameter }
+ pd.parast.insert(vs);
+ pd.insertpara(vs.vartype,vs,nil,true);
end
else
begin
@@ -167,29 +162,25 @@ implementation
{ Generate self variable, for classes we need
to use the generic voidpointer to be compatible with
- methodpointers.
- Only needed when there is no explicit self para }
- if not(po_containsself in pd.procoptions) then
- begin
- vsp:=vs_value;
- if (po_staticmethod in pd.procoptions) or
- (po_classmethod in pd.procoptions) then
- begin
- tt.setdef(tprocdef(pd)._class);
- tt.setdef(tclassrefdef.create(tt));
- end
- else
- begin
- if is_object(tprocdef(pd)._class) then
- vsp:=vs_var;
- tt.setdef(tprocdef(pd)._class);
- end;
- vs:=tvarsym.create('$self',vsp,tt);
- include(vs.varoptions,vo_is_self);
- { Insert as hidden parameter }
- pd.parast.insert(vs);
- pd.insertpara(vs.vartype,vs,nil,true);
- end;
+ methodpointers }
+ vsp:=vs_value;
+ if (po_staticmethod in pd.procoptions) or
+ (po_classmethod in pd.procoptions) then
+ begin
+ tt.setdef(tprocdef(pd)._class);
+ tt.setdef(tclassrefdef.create(tt));
+ end
+ else
+ begin
+ if is_object(tprocdef(pd)._class) then
+ vsp:=vs_var;
+ tt.setdef(tprocdef(pd)._class);
+ end;
+ vs:=tvarsym.create('$self',vsp,tt);
+ include(vs.varoptions,vo_is_self);
+ { Insert as hidden parameter }
+ pd.parast.insert(vs);
+ pd.insertpara(vs.vartype,vs,nil,true);
akttokenpos:=storepos;
end;
@@ -337,36 +328,6 @@ implementation
end;
- procedure check_self_para(pd:tabstractprocdef);
- var
- hpara : tparaitem;
- vs : tvarsym;
- begin
- hpara:=pd.selfpara;
- if assigned(hpara) and
- (
- ((pd.deftype=procvardef) and
- (po_methodpointer in pd.procoptions)) or
- ((pd.deftype=procdef) and
- assigned(tprocdef(pd)._class))
- ) then
- begin
- include(pd.procoptions,po_containsself);
- if hpara.paratyp <> vs_value then
- CGMessage(parser_e_self_call_by_value);
- if (pd.deftype=procdef) then
- begin
- if compare_defs(hpara.paratype.def,tprocdef(pd)._class,nothingn)=te_incompatible then
- CGMessage2(type_e_incompatible_types,hpara.paratype.def.typename,tprocdef(pd)._class.typename);
- end;
- { add an alias for $self which is for internal use }
- vs:=tabsolutesym.create_ref('$self',hpara.paratype,tstoredsym(hpara.parasym));
- include(vs.varoptions,vo_is_self);
- pd.parast.insert(vs);
- end;
- end;
-
-
procedure parse_parameter_dec(pd:tabstractprocdef);
{
handle_procvar needs the same changes
@@ -524,19 +485,11 @@ implementation
include(vs.varoptions,vo_regable);
end;
hpara:=pd.concatpara(nil,tt,vs,tdefaultvalue,false);
- { save position of self parameter }
- if vs.name='SELF' then
- pd.selfpara:=hpara;
vs:=tvarsym(vs.listnext);
end;
until not try_to_consume(_SEMICOLON);
{ remove parasymtable from stack }
sc.free;
- { check for a self parameter which is needed to allow message
- directive, only for normal procedures. For procvars we need
- to wait until the 'of object' is parsed }
- if not is_procvar then
- check_self_para(pd);
{ reset object options }
dec(testcurobject);
current_object_option:=old_object_option;
@@ -1107,8 +1060,7 @@ begin
if not is_class(tprocdef(pd)._class) then
Message(parser_e_msg_only_for_classes);
{ check parameter type }
- if not(po_containsself in pd.procoptions) and
- ((pd.minparacount<>1) or
+ if ((pd.minparacount<>1) or
(pd.maxparacount<>1) or
(TParaItem(pd.Para.first).paratyp<>vs_var)) then
Message(parser_e_ill_msg_param);
@@ -1946,9 +1898,6 @@ const
begin
pdflags:=pd_object;
parse_proc_directives(pd,pdflags);
- if (po_containsself in pd.procoptions) and
- (([po_msgstr,po_msgint]*pd.procoptions)=[]) then
- Message(parser_e_self_in_non_message_handler);
end;
@@ -2074,9 +2023,9 @@ const
{ Check procedure options, Delphi requires that class is
repeated in the implementation for class methods }
if (m_fpc in aktmodeswitches) then
- po_comp:=[po_varargs,po_methodpointer,po_containsself,po_interrupt,po_clearstack]
+ po_comp:=[po_varargs,po_methodpointer,po_interrupt,po_clearstack]
else
- po_comp:=[po_classmethod,po_methodpointer,po_containsself];
+ po_comp:=[po_classmethod,po_methodpointer];
if ((po_comp * hd.procoptions)<>(po_comp * pd.procoptions)) then
begin
@@ -2224,7 +2173,13 @@ const
end.
{
$Log$
- Revision 1.123 2003-05-13 15:18:49 peter
+ Revision 1.124 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.123 2003/05/13 15:18:49 peter
* fixed various crashes
Revision 1.122 2003/05/09 17:47:03 peter
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 6fa1610461..0c9521ea46 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -90,9 +90,8 @@ implementation
function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;forward;
const
- got_addrn : boolean = false;
- anon_inherited : boolean = false;
-
+ { true, if the inherited call is anonymous }
+ anon_inherited : boolean = false;
@@ -2400,7 +2399,13 @@ implementation
end.
{
$Log$
- Revision 1.119 2003-05-13 20:54:39 peter
+ Revision 1.120 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.119 2003/05/13 20:54:39 peter
* ifdef'd code that checked for failed inherited constructors
Revision 1.118 2003/05/13 19:14:41 peter
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index 377d6ec39e..37a210a0c7 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -209,8 +209,6 @@ implementation
dataSegment.concat(Tai_cut.Create);
dataSegment.concatlist(ltvTables);
ltvTables.free;
- if count > 0 then
- have_local_threadvars := true;
end;
@@ -1484,7 +1482,13 @@ So, all parameters are passerd into registers in sparc architecture.}
end.
{
$Log$
- Revision 1.105 2003-05-11 19:31:28 florian
+ Revision 1.106 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.105 2003/05/11 19:31:28 florian
* fixed implicit init/final code for units, stack frame was wrong for ppc
Revision 1.104 2003/04/28 21:19:02 peter
diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas
index 1b075a4864..bb339c13d7 100644
--- a/compiler/pstatmnt.pas
+++ b/compiler/pstatmnt.pas
@@ -205,7 +205,6 @@ implementation
end;
consume(_OF);
- inc(statement_level);
root:=nil;
instruc:=nil;
repeat
@@ -293,7 +292,6 @@ implementation
elseblock:=nil;
consume(_END);
end;
- dec(statement_level);
code:=ccasenode.create(caseexpr,instruc,root);
@@ -311,7 +309,6 @@ implementation
begin
consume(_REPEAT);
first:=nil;
- inc(statement_level);
while token<>_UNTIL do
begin
@@ -330,7 +327,6 @@ implementation
consume_emptystats;
end;
consume(_UNTIL);
- dec(statement_level);
first:=cblocknode.create(first,true);
p_e:=comp_expr(true);
@@ -593,7 +589,6 @@ implementation
inc(exceptblockcounter);
oldaktexceptblock := aktexceptblock;
aktexceptblock := exceptblockcounter;
- inc(statement_level);
while (token<>_FINALLY) and (token<>_EXCEPT) do
begin
@@ -619,7 +614,6 @@ implementation
aktexceptblock := exceptblockcounter;
p_finally_block:=statements_til_end;
try_statement:=ctryfinallynode.create(p_try_block,p_finally_block);
- dec(statement_level);
end
else
begin
@@ -755,7 +749,6 @@ implementation
{ catch all exceptions }
p_default:=statements_til_end;
end;
- dec(statement_level);
block_type:=old_block_type;
try_statement:=ctryexceptnode.create(p_try_block,p_specific,p_default);
@@ -1009,7 +1002,6 @@ implementation
first:=nil;
filepos:=akttokenpos;
consume(starttoken);
- inc(statement_level);
while not(token in [_END,_FINALIZATION]) do
begin
@@ -1044,8 +1036,6 @@ implementation
if (starttoken<>_INITIALIZATION) or (token<>_FINALIZATION) then
consume(_END);
- dec(statement_level);
-
last:=cblocknode.create(first,true);
last.set_tree_filepos(filepos);
statement_block:=last;
@@ -1185,7 +1175,13 @@ implementation
end.
{
$Log$
- Revision 1.98 2003-05-13 19:14:41 peter
+ Revision 1.99 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.98 2003/05/13 19:14:41 peter
* failn removed
* inherited result code check moven to pexpr
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index b2d25baba1..5dab594fac 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -612,7 +612,6 @@ implementation
consume(_OF);
consume(_OBJECT);
include(pd.procoptions,po_methodpointer);
- check_self_para(pd);
end;
{ Add implicit hidden parameters and function result }
calc_parast(pd);
@@ -628,7 +627,13 @@ implementation
end.
{
$Log$
- Revision 1.54 2003-05-09 17:47:03 peter
+ Revision 1.55 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.54 2003/05/09 17:47:03 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn
diff --git a/compiler/rautils.pas b/compiler/rautils.pas
index f61ba38cf1..f8fe189a4a 100644
--- a/compiler/rautils.pas
+++ b/compiler/rautils.pas
@@ -759,15 +759,9 @@ Function TOperand.SetupSelf:boolean;
Begin
SetupSelf:=false;
if assigned(current_procdef._class) then
- Begin
- opr.typ:=OPR_REFERENCE;
- opr.ref.offset:=current_procinfo.selfpointer_offset;
- opr.ref.base:=current_procinfo.framepointer;
- opr.ref.options:=ref_selffixup;
- SetupSelf:=true;
- end
+ SetupSelf:=setupvar('self',false)
else
- Message(asmr_e_cannot_use_SELF_outside_a_method);
+ Message(asmr_e_cannot_use_SELF_outside_a_method);
end;
@@ -775,15 +769,9 @@ Function TOperand.SetupOldEBP:boolean;
Begin
SetupOldEBP:=false;
if current_procdef.parast.symtablelevel>normal_function_level then
- Begin
- opr.typ:=OPR_REFERENCE;
- opr.ref.offset:=current_procinfo.framepointer_offset;
- opr.ref.base:=current_procinfo.framepointer;
- opr.ref.options:=ref_parafixup;
- SetupOldEBP:=true;
- end
+ SetupOldEBP:=setupvar('parentframe',false)
else
- Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+ Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
end;
@@ -877,7 +865,7 @@ Begin
else
message1(asmr_e_local_para_unreachable,s);
end;
- opr.ref.offset:=tg.direction*(tvarsym(sym).address);
+ opr.ref.offset:=tvarsym(sym).address;
if (current_procdef.localst.symtablelevel=tvarsym(sym).owner.symtablelevel) then
begin
opr.ref.offsetfixup:=current_procdef.localst.address_fixup;
@@ -1574,7 +1562,13 @@ end;
end.
{
$Log$
- Revision 1.59 2003-05-12 17:22:00 jonas
+ Revision 1.60 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.59 2003/05/12 17:22:00 jonas
* fixed (last?) remaining -tvarsym(X).address to
tg.direction*tvarsym(X).address...
diff --git a/compiler/regvars.pas b/compiler/regvars.pas
index 85a2139a12..84eb393144 100644
--- a/compiler/regvars.pas
+++ b/compiler/regvars.pas
@@ -303,12 +303,7 @@ implementation
{ possible that it's been modified (JM) }
if not(vsym.varspez in [vs_const,vs_var,vs_out]) then
begin
- reference_reset(hr);
- if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
- hr.offset:=tg.direction*vsym.address+vsym.owner.address_fixup
- else
- hr.offset:=vsym.address+vsym.owner.address_fixup;
- hr.base:=current_procinfo.framepointer;
+ reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
end;
asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
@@ -330,12 +325,7 @@ implementation
if not rg.regvar_loaded[reg.enum] then
begin
asml.concat(tai_regalloc.alloc(reg));
- reference_reset(hr);
- if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
- hr.offset:=tg.direction*vsym.address+vsym.owner.address_fixup
- else
- hr.offset:=vsym.address+vsym.owner.address_fixup;
- hr.base:=current_procinfo.framepointer;
+ reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address);
if (vsym.varspez in [vs_var,vs_out]) or
((vsym.varspez=vs_const) and
paramanager.push_addr_param(vsym.vartype.def,current_procdef.proccalloption)) then
@@ -500,7 +490,13 @@ end.
{
$Log$
- Revision 1.48 2003-05-12 17:22:00 jonas
+ Revision 1.49 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.48 2003/05/12 17:22:00 jonas
* fixed (last?) remaining -tvarsym(X).address to
tg.direction*tvarsym(X).address...
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 0de0131f41..44706c9d8f 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -414,7 +414,6 @@ interface
rettype : ttype;
parast : tsymtable;
para : tlinkedlist;
- selfpara : tparaitem;
proctypeoption : tproctypeoption;
proccalloption : tproccalloption;
procoptions : tprocoptions;
@@ -3060,7 +3059,6 @@ implementation
parast:=tparasymtable.create(level);
parast.defowner:=self;
para:=TLinkedList.Create;
- selfpara:=nil;
minparacount:=0;
maxparacount:=0;
proctypeoption:=potype_none;
@@ -3207,7 +3205,6 @@ implementation
inherited ppuloaddef(ppufile);
parast:=nil;
Para:=TLinkedList.Create;
- selfpara:=nil;
minparacount:=0;
maxparacount:=0;
ppufile.gettype(rettype);
@@ -5764,7 +5761,13 @@ implementation
end.
{
$Log$
- Revision 1.143 2003-05-13 08:13:16 jonas
+ Revision 1.144 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.143 2003/05/13 08:13:16 jonas
* patch from Peter for rtti symbols
Revision 1.142 2003/05/11 21:37:03 peter
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index f3ac722210..5723ea6a3f 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -195,6 +195,7 @@ interface
procedure set_mangledname(const s:string);
function getsize : longint;
function getvaluesize : longint;
+ function adjusted_address : longint;
procedure trigger_notifications(what:Tnotification_flag);
function register_notification(flags:Tnotification_flags;
callback:Tnotification_callback):cardinal;
@@ -1707,6 +1708,12 @@ implementation
end;
+ function tvarsym.adjusted_address : longint;
+ begin
+ result:=address+owner.address_fixup;
+ end;
+
+
procedure Tvarsym.trigger_notifications(what:Tnotification_flag);
var n:Tnotification;
@@ -1803,7 +1810,7 @@ implementation
end;
stabstring := strpnew('"'+name+':'+st+'",'+
tostr(N_tsym)+',0,'+tostr(fileinfo.line)+','+
- tostr(address+owner.address_fixup));
+ tostr(adjusted_address));
{offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
end
@@ -1825,31 +1832,54 @@ implementation
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
else
stabstring := strpnew('"'+name+':'+st+'",'+
- tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+','+tostr(tg.direction*address+owner.address_fixup))
+ tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+','+tostr(adjusted_address))
else
stabstring := inherited stabstring;
end;
procedure tvarsym.concatstabto(asmlist : taasmoutput);
- var stab_str : pchar;
+ var
+ stab_str : pchar;
+ c : char;
begin
if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
(copy(name,1,6)='hidden') then
exit;
- inherited concatstabto(asmlist);
- if (owner.symtabletype=parasymtable) and
- (reg.enum<>R_NO) then
+ if (vo_is_self in varoptions) then
begin
- if reg.enum>lastreg then
- internalerror(2003010801);
- { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
- { this is the register order for GDB}
- stab_str:=strpnew('"'+name+':r'
- +tstoreddef(vartype.def).numberstring+'",'+
- tostr(N_RSYM)+',0,'+
- tostr(fileinfo.line)+','+tostr(stab_regindex[reg.enum]));
- asmList.concat(Tai_stabs.Create(stab_str));
- end;
+ if (po_classmethod in current_procdef.procoptions) or
+ (po_staticmethod in current_procdef.procoptions) then
+ begin
+ asmlist.concat(Tai_stabs.Create(strpnew(
+ '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
+ tostr(N_tsym)+',0,0,'+tostr(adjusted_address))));
+ end
+ else
+ begin
+ if not(is_class(current_procdef._class)) then
+ c:='v'
+ else
+ c:='p';
+ asmlist.concat(Tai_stabs.Create(strpnew(
+ '"$t:'+c+current_procdef._class.numberstring+'",'+
+ tostr(N_tsym)+',0,0,'+tostr(adjusted_address))));
+ end;
+ end
+ else
+ if (reg.enum<>R_NO) then
+ begin
+ if reg.enum>lastreg then
+ internalerror(2003010801);
+ { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
+ { this is the register order for GDB}
+ stab_str:=strpnew('"'+name+':r'
+ +tstoreddef(vartype.def).numberstring+'",'+
+ tostr(N_RSYM)+',0,'+
+ tostr(fileinfo.line)+','+tostr(stab_regindex[reg.enum]));
+ asmList.concat(Tai_stabs.Create(stab_str));
+ end
+ else
+ inherited concatstabto(asmlist);
end;
{$endif GDB}
@@ -2558,7 +2588,13 @@ implementation
end.
{
$Log$
- Revision 1.103 2003-05-12 18:13:57 peter
+ Revision 1.104 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.103 2003/05/12 18:13:57 peter
* create rtti label using newasmsymboldata and update binding
only when calling tai_symbol.create
* tai_symbol.create_global added
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 0a74089c69..bce69311ea 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -1311,7 +1311,7 @@ implementation
l:=tvarsym(sym).getvaluesize;
varalign:=size_2_align(l);
varalign:=used_align(varalign,aktalignment.localalignmin,aktalignment.localalignmax);
- if (tg.direction = 1) then
+ if (tg.direction>0) then
begin
{ on the powerpc, the local variables are accessed with a positiv offset }
tvarsym(sym).address:=align(datasize,varalign);
@@ -1319,8 +1319,8 @@ implementation
end
else
begin
- tvarsym(sym).address:=align(datasize+l,varalign);
- datasize:=tvarsym(sym).address;
+ datasize:=align(datasize+l,varalign);
+ tvarsym(sym).address:=-datasize;
end;
end;
end;
@@ -2420,7 +2420,13 @@ implementation
end.
{
$Log$
- Revision 1.99 2003-05-13 15:17:13 peter
+ Revision 1.100 2003-05-15 18:58:53 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.99 2003/05/13 15:17:13 peter
* fix crash with hiding function result. The function result is now
inserted as last so the symbol that we are going to insert is the
result and needs to be renamed instead of the already existing
diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas
index e49fda19a3..e76c9a44af 100644
--- a/compiler/x86/cgx86.pas
+++ b/compiler/x86/cgx86.pas
@@ -110,7 +110,7 @@ unit cgx86;
{ entry/exit code helpers }
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
procedure g_interrupt_stackframe_entry(list : taasmoutput);override;
- procedure g_interrupt_stackframe_exit(list : taasmoutput;selfused,accused,acchiused:boolean);override;
+ procedure g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);override;
procedure g_profilecode(list : taasmoutput);override;
procedure g_stackpointer_alloc(list : taasmoutput;localsize : longint);override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
@@ -119,7 +119,7 @@ unit cgx86;
procedure g_save_standard_registers(list:Taasmoutput;usedinproc:Tsupregset);override;
procedure g_restore_standard_registers(list:Taasmoutput;usedinproc:Tsupregset);override;
procedure g_save_all_registers(list : taasmoutput);override;
- procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
+ procedure g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);override;
procedure g_overflowcheck(list: taasmoutput; const p: tnode);override;
@@ -1667,7 +1667,7 @@ unit cgx86;
end;
- procedure tcgx86.g_interrupt_stackframe_exit(list : taasmoutput;selfused,accused,acchiused:boolean);
+ procedure tcgx86.g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);
var r:Tregister;
@@ -1697,16 +1697,6 @@ unit cgx86;
r.number:=NR_EDX;
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
end;
- if selfused then
- begin
- r.number:=NR_ESP;
- list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,r))
- end
- else
- begin
- r.number:=NR_ESI;
- list.concat(Taicpu.Op_reg(A_POP,S_L,r));
- end;
r.number:=NR_EDI;
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
{ .... also the segment registers }
@@ -1893,7 +1883,7 @@ unit cgx86;
end;
- procedure tcgx86.g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);
+ procedure tcgx86.g_restore_all_registers(list : taasmoutput;accused,acchiused:boolean);
var
href : treference;
r,rsp: Tregister;
@@ -1901,12 +1891,6 @@ unit cgx86;
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_ESP;
r.enum:=R_INTREGISTER;
- if selfused then
- begin
- reference_reset_base(href,rsp,4);
- r.number:=NR_ESI;
- list.concat(Taicpu.Op_reg_ref(A_MOV,S_L,r,href));
- end;
if acchiused then
begin
reference_reset_base(href,rsp,20);
@@ -1955,7 +1939,13 @@ unit cgx86;
end.
{
$Log$
- Revision 1.44 2003-04-30 20:53:32 florian
+ Revision 1.45 2003-05-15 18:58:54 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.44 2003/04/30 20:53:32 florian
* error when address of an abstract method is taken
* fixed some x86-64 problems
* merged some more x86-64 and i386 code
diff --git a/compiler/x86/radirect.pas b/compiler/x86/radirect.pas
index 0b1d4440ad..5fd360b38e 100644
--- a/compiler/x86/radirect.pas
+++ b/compiler/x86/radirect.pas
@@ -58,6 +58,7 @@ interface
function assemble : tnode;
var
+ uhs,
retstr,s,hs : string;
c : char;
ende : boolean;
@@ -96,202 +97,242 @@ interface
retstr:=upper(tostr(current_procinfo.return_offset)+'('+gas_reg2str[framereg.enum]+')')
else
retstr:='';
- c:=current_scanner.asmgetchar;
- code:=TAAsmoutput.Create;
- while not(ende) do
- begin
- { wrong placement
- current_scanner.gettokenpos; }
- case c of
- 'A'..'Z','a'..'z','_' : begin
- current_scanner.gettokenpos;
- i:=0;
- hs:='';
- while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
- or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
- or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
- or (c='_') do
- begin
- inc(i);
- hs[i]:=c;
- c:=current_scanner.asmgetchar;
- end;
- hs[0]:=chr(i);
- if upper(hs)='END' then
- ende:=true
- else
- begin
- if c=':' then
- begin
- searchsym(upper(hs),srsym,srsymtable);
- if srsym<>nil then
- if (srsym.typ = labelsym) then
- Begin
- hs:=tlabelsym(srsym).lab.name;
- tlabelsym(srsym).lab.is_set:=true;
- end
- else
- Message(asmr_w_using_defined_as_local);
- end
- else if upper(hs)='FWAIT' then
- FwaitWarning
- else
- { access to local variables }
- if assigned(current_procdef) then
- begin
- { is the last written character an special }
- { char ? }
- if (s[length(s)]='%') and
- (not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption)) and
- ((pos('AX',upper(hs))>0) or
- (pos('AL',upper(hs))>0)) then
- tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
- if (s[length(s)]<>'%') and
- (s[length(s)]<>'$') and
- (s[length(s)]<>'.') and
- ((s[length(s)]<>'0') or (hs[1]<>'x')) then
- begin
- if assigned(current_procdef.localst) and
- (current_procdef.localst.symtablelevel>=normal_function_level) then
- sym:=tsym(current_procdef.localst.search(upper(hs)))
- else
- sym:=nil;
- if assigned(sym) then
- begin
- if (sym.typ = labelsym) then
- Begin
- hs:=tlabelsym(sym).lab.name;
- end
- else if sym.typ=varsym then
- begin
- {variables set are after a comma }
- {like in movl %eax,I }
- if pos(',',s) > 0 then
- tvarsym(sym).varstate:=vs_used
- else
- if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
- Message1(sym_n_uninitialized_local_variable,hs);
- if (vo_is_external in tvarsym(sym).varoptions) then
- hs:=tvarsym(sym).mangledname
- else
- hs:='-'+tostr(tvarsym(sym).address)+
- '('+gas_reg2str[framereg.enum]+')';
- end
+ c:=current_scanner.asmgetchar;
+ code:=TAAsmoutput.Create;
+ while not(ende) do
+ begin
+ { wrong placement
+ current_scanner.gettokenpos; }
+ case c of
+ 'A'..'Z','a'..'z','_' : begin
+ current_scanner.gettokenpos;
+ i:=0;
+ hs:='';
+ while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+ or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+ or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+ or (c='_') do
+ begin
+ inc(i);
+ hs[i]:=c;
+ c:=current_scanner.asmgetchar;
+ end;
+ hs[0]:=chr(i);
+ if upper(hs)='END' then
+ ende:=true
+ else
+ begin
+ if c=':' then
+ begin
+ searchsym(upper(hs),srsym,srsymtable);
+ if srsym<>nil then
+ if (srsym.typ = labelsym) then
+ Begin
+ hs:=tlabelsym(srsym).lab.name;
+ tlabelsym(srsym).lab.is_set:=true;
+ end
+ else
+ Message(asmr_w_using_defined_as_local);
+ end
+ else if upper(hs)='FWAIT' then
+ FwaitWarning
+ else
+ { access to local variables }
+ if assigned(current_procdef) then
+ begin
+ { is the last written character an special }
+ { char ? }
+ if (s[length(s)]='%') and
+ (not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption)) and
+ ((pos('AX',upper(hs))>0) or
+ (pos('AL',upper(hs))>0)) then
+ tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
+ if (s[length(s)]<>'%') and
+ (s[length(s)]<>'$') and
+ (s[length(s)]<>'.') and
+ ((s[length(s)]<>'0') or (hs[1]<>'x')) then
+ begin
+ if assigned(current_procdef.localst) and
+ (current_procdef.localst.symtablelevel>=normal_function_level) then
+ sym:=tsym(current_procdef.localst.search(upper(hs)))
+ else
+ sym:=nil;
+ if assigned(sym) then
+ begin
+ if (sym.typ = labelsym) then
+ Begin
+ hs:=tlabelsym(sym).lab.name;
+ end
+ else if sym.typ=varsym then
+ begin
+ {variables set are after a comma }
+ {like in movl %eax,I }
+ if pos(',',s) > 0 then
+ tvarsym(sym).varstate:=vs_used
else
- { call to local function }
- if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
- (pos('LEA',upper(s))>0)) then
- begin
- hs:=tprocsym(sym).first_procdef.mangledname;
- end;
- end
- else
- begin
- if assigned(current_procdef.parast) then
- sym:=tsym(current_procdef.parast.search(upper(hs)))
+ if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
+ Message1(sym_n_uninitialized_local_variable,hs);
+ if (vo_is_external in tvarsym(sym).varoptions) then
+ hs:=tvarsym(sym).mangledname
else
- sym:=nil;
- if assigned(sym) then
- begin
- if sym.typ=varsym then
- begin
- l:=tvarsym(sym).address;
- { set offset }
- inc(l,current_procdef.parast.address_fixup);
- hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
- if pos(',',s) > 0 then
- tvarsym(sym).varstate:=vs_used;
- end;
- end
- { I added that but it creates a problem in line.ppi
- because there is a local label wbuffer and
- a static variable WBUFFER ...
- what would you decide, florian ?}
- else
-
- begin
- searchsym(upper(hs),sym,srsymtable);
- if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
- begin
- case sym.typ of
- varsym :
- begin
- Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
- hs:=tvarsym(sym).mangledname;
- inc(tvarsym(sym).refs);
- end;
- typedconstsym :
- begin
- Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
- hs:=ttypedconstsym(sym).mangledname;
- end;
- procsym :
- begin
- { procs can be called or the address can be loaded }
- if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
- begin
- if tprocsym(sym).procdef_count>1 then
- Message1(asmr_w_direct_global_is_overloaded_func,hs);
- Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
- hs:=tprocsym(sym).first_procdef.mangledname;
- end;
- end;
- else
- Message(asmr_e_wrong_sym_type);
- end;
- end
- else if upper(hs)='__SELF' then
- begin
- if assigned(current_procdef._class) then
- hs:=tostr(current_procinfo.selfpointer_offset)+
- '('+gas_reg2str[framereg.enum]+')'
- else
- Message(asmr_e_cannot_use_SELF_outside_a_method);
- end
- else if upper(hs)='__RESULT' then
- begin
- if (not is_void(current_procdef.rettype.def)) then
- hs:=retstr
- else
- Message(asmr_e_void_function);
- end
- else if upper(hs)='__OLDEBP' then
- begin
- { complicate to check there }
- { we do it: }
- if current_procdef.parast.symtablelevel>normal_function_level then
- hs:=tostr(current_procinfo.framepointer_offset)+
- '('+gas_reg2str[framereg.enum]+')'
- else
- Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
- end;
+ hs:='-'+tostr(tvarsym(sym).address)+
+ '('+gas_reg2str[framereg.enum]+')';
+ end
+ else
+ { call to local function }
+ if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
+ (pos('LEA',upper(s))>0)) then
+ begin
+ hs:=tprocsym(sym).first_procdef.mangledname;
end;
- end;
- end;
- end;
- s:=s+hs;
- end;
- end;
- '{',';',#10,#13 : begin
- if pos(retstr,s) > 0 then
- tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
- writeasmline;
- c:=current_scanner.asmgetchar;
- end;
- #26 : Message(scan_f_end_of_file);
- else
- begin
- current_scanner.gettokenpos;
- inc(byte(s[0]));
- s[length(s)]:=c;
- c:=current_scanner.asmgetchar;
- end;
- end;
+ end
+ else
+ begin
+ if assigned(current_procdef.parast) then
+ sym:=tsym(current_procdef.parast.search(upper(hs)))
+ else
+ sym:=nil;
+ if assigned(sym) then
+ begin
+ if sym.typ=varsym then
+ begin
+ l:=tvarsym(sym).address;
+ { set offset }
+ inc(l,current_procdef.parast.address_fixup);
+ hs:=tostr(l)+'('+gas_reg2str[framereg.enum]+')';
+ if pos(',',s) > 0 then
+ tvarsym(sym).varstate:=vs_used;
+ end;
+ end
+ { I added that but it creates a problem in line.ppi
+ because there is a local label wbuffer and
+ a static variable WBUFFER ...
+ what would you decide, florian ?}
+ else
+
+ begin
+ uhs:=upper(hs);
+ if (uhs='__SELF') then
+ begin
+ if assigned(current_procdef._class) then
+ uhs:='self'
+ else
+ begin
+ Message(asmr_e_cannot_use_SELF_outside_a_method);
+ uhs:='';
+ end;
+ end
+ else
+ if (uhs='__OLDEBP') then
+ begin
+ if current_procdef.parast.symtablelevel>normal_function_level then
+ uhs:='parentframe'
+ else
+ begin
+ Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+ uhs:='';
+ end;
+ end
+ else
+ if uhs='__RESULT' then
+ begin
+ if (not is_void(current_procdef.rettype.def)) then
+ uhs:='result'
+ else
+ begin
+ Message(asmr_e_void_function);
+ uhs:='';
+ end;
+ end;
+
+ if uhs<>'' then
+ searchsym(uhs,sym,srsymtable)
+ else
+ sym:=nil;
+ if assigned(sym) then
+ begin
+ case sym.owner.symtabletype of
+ globalsymtable,
+ staticsymtable :
+ begin
+ case sym.typ of
+ varsym :
+ begin
+ Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+ hs:=tvarsym(sym).mangledname;
+ inc(tvarsym(sym).refs);
+ end;
+ typedconstsym :
+ begin
+ Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+ hs:=ttypedconstsym(sym).mangledname;
+ end;
+ procsym :
+ begin
+ { procs can be called or the address can be loaded }
+ if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
+ begin
+ if tprocsym(sym).procdef_count>1 then
+ Message1(asmr_w_direct_global_is_overloaded_func,hs);
+ Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
+ hs:=tprocsym(sym).first_procdef.mangledname;
+ end;
+ end;
+ else
+ Message(asmr_e_wrong_sym_type);
+ end;
+ end;
+ parasymtable,
+ localsymtable :
+ begin
+ case sym.typ of
+ varsym :
+ begin
+ hs:=tostr(tvarsym(sym).adjusted_address)+
+ '('+gas_reg2str[framereg.enum]+')';
+ inc(tvarsym(sym).refs);
+ end;
+ typedconstsym :
+ begin
+ Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+ hs:=ttypedconstsym(sym).mangledname;
+ end;
+ else
+ Message(asmr_e_wrong_sym_type);
+ end;
+ end;
+ end;
+ end
+ end;
+ end;
+ end;
+ end;
+ s:=s+hs;
+ end;
+ end;
+ '{',';',#10,#13 :
+ begin
+ if pos(retstr,s) > 0 then
+ tvarsym(current_procdef.funcretsym).varstate:=vs_assigned;
+ writeasmline;
+ c:=current_scanner.asmgetchar;
+ end;
+ #26 :
+ Message(scan_f_end_of_file);
+ else
+ begin
+ current_scanner.gettokenpos;
+ inc(byte(s[0]));
+ s[length(s)]:=c;
+ c:=current_scanner.asmgetchar;
+ end;
+ end;
end;
writeasmline;
assemble:=casmnode.create(code);
end;
+
{*****************************************************************************
Initialize
*****************************************************************************}
@@ -320,7 +361,13 @@ initialization
end.
{
$Log$
- Revision 1.3 2003-05-13 19:15:28 peter
+ Revision 1.4 2003-05-15 18:58:54 peter
+ * removed selfpointer_offset, vmtpointer_offset
+ * tvarsym.adjusted_address
+ * address in localsymtable is now in the real direction
+ * removed some obsolete globals
+
+ Revision 1.3 2003/05/13 19:15:28 peter
* removed radirect
Revision 1.2 2003/05/01 07:59:43 florian