paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* removed selfpointer_offset, vmtpointer_offset

Browse Source 
* tvarsym.adjusted_address
  * address in localsymtable is now in the real direction
  * removed some obsolete globals
This commit is contained in:
peter 2003-05-15 18:58:53 +00:00
parent a41d686f98
commit 92ee1804b6
23 changed files with 523 additions and 548 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
compiler/cgbase.pas
View File

@ -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

14
compiler/cgobj.pas
View File

@ -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

10
compiler/defcmp.pas
View File

@ -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

21
compiler/globals.pas
View File

@ -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

10
compiler/i386/n386obj.pas
View File

@ -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

25
compiler/ncgcal.pas
View File

@ -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

27
compiler/ncgld.pas
View File

@ -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...

87
compiler/ncgutil.pas
View File

@ -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

12
compiler/parser.pas
View File

@ -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

9
compiler/pass_2.pas
View File

@ -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

14
compiler/pbase.pas
View File

@ -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

117
compiler/pdecsub.pas
View File

@ -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

13
compiler/pexpr.pas
View File

@ -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

10
compiler/pmodules.pas
View File

@ -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

18
compiler/pstatmnt.pas
View File

@ -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

9
compiler/ptype.pas
View File

@ -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

30
compiler/rautils.pas
View File

@ -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...

22
compiler/regvars.pas
View File

@ -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...

11
compiler/symdef.pas
View File

@ -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

70
compiler/symsym.pas
View File

@ -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

14
compiler/symtable.pas
View File

@ -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

32
compiler/x86/cgx86.pas
View File

@ -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

425
compiler/x86/radirect.pas
View File

@ -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