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

* inline supported again, LOC_REFERENCEs are used to pass the

Browse Source 
parameters
  * inlineparasymtable,inlinelocalsymtable removed
  * exitlabel inserting fixed
This commit is contained in:
peter 2003-10-07 15:17:07 +00:00
parent 46a9df017c
commit e27d6f67da
9 changed files with 459 additions and 529 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/i386/cpupara.pas
View File

@ -208,15 +208,15 @@ unit cpupara;
else
begin
result.loc:=LOC_REFERENCE;
result.reference.index:=NR_EBP;
result.reference.offset:=4*nr;
result.reference.index:=NR_STACK_POINTER_REG;
result.reference.offset:=POINTER_SIZE*nr;
end;
end
else
begin
result.loc:=LOC_REFERENCE;
result.reference.index:=NR_EBP;
result.reference.offset:=4*nr;
result.reference.index:=NR_STACK_POINTER_REG;
result.reference.offset:=POINTER_SIZE*nr;
end;
end;
@ -440,7 +440,13 @@ begin
end.
{
$Log$
Revision 1.37 2003-10-05 21:21:52 peter
Revision 1.38 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.37 2003/10/05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes

343
compiler/ncgcal.pas
View File

@ -76,7 +76,7 @@ implementation
uses
systems,
cutils,verbose,globals,
symconst,symbase,symsym,symtable,defutil,paramgr,
symconst,symsym,symtable,defutil,paramgr,
{$ifdef GDB}
{$ifdef delphi}
sysutils,
@ -86,18 +86,13 @@ implementation
gdb,
{$endif GDB}
cgbase,pass_2,
cpuinfo,aasmbase,aasmtai,aasmcpu,
cpuinfo,aasmbase,aasmtai,
nbas,nmem,nld,ncnv,
{$ifdef x86}
cga,
{$endif x86}
{$ifdef cpu64bit}
cg64f64,
{$else cpu64bit}
cg64f32,
{$endif cpu64bit}
ncgutil,cgobj,tgobj,
regvars,rgobj,rgcpu,
rgobj,rgcpu,
procinfo;
@ -148,82 +143,61 @@ implementation
{ Handle Floating point types differently }
if left.resulttype.def.deftype=floatdef then
begin
(*
if calloption=pocall_inline then
begin
size:=align(tfloatdef(p.resulttype.def).size,alignment);
inc(pushedparasize,size);
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
case left.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_loadfpu_reg_ref(exprasmlist,def_cgsize(p.resulttype.def),left.location.register,href);
LOC_REFERENCE,
LOC_CREFERENCE :
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false);
else
internalerror(200204243);
end;
end
else
*)
begin
location_release(exprasmlist,left.location);
allocate_tempparaloc;
location_release(exprasmlist,left.location);
allocate_tempparaloc;
{$ifdef i386}
case left.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
if tempparaloc.loc<>LOC_REFERENCE then
internalerror(200309291);
size:=align(tfloatdef(left.resulttype.def).size,tempparaloc.alignment);
inc(tcgcallnode(aktcallnode).pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.a_loadfpu_reg_ref(exprasmlist,def_cgsize(left.resulttype.def),left.location.register,href);
end;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
sizetopush:=align(left.resulttype.def.size,tempparaloc.alignment);
tempreference:=left.location.reference;
inc(tempreference.offset,sizetopush);
while (sizetopush>0) do
begin
if (sizetopush>=4) or (tempparaloc.alignment>=4) then
begin
cgsize:=OS_32;
inc(tcgcallnode(aktcallnode).pushedparasize,4);
dec(tempreference.offset,4);
dec(sizetopush,4);
end
else
begin
cgsize:=OS_16;
inc(tcgcallnode(aktcallnode).pushedparasize,2);
dec(tempreference.offset,2);
dec(sizetopush,2);
end;
cg.a_param_ref(exprasmlist,cgsize,tempreference,tempparaloc);
end;
end;
else
internalerror(200204243);
case left.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
if tempparaloc.loc<>LOC_REFERENCE then
internalerror(200309291);
size:=align(tfloatdef(left.resulttype.def).size,tempparaloc.alignment);
inc(tcgcallnode(aktcallnode).pushedparasize,size);
cg.g_stackpointer_alloc(exprasmlist,size);
reference_reset_base(href,NR_STACK_POINTER_REG,0);
cg.a_loadfpu_reg_ref(exprasmlist,def_cgsize(left.resulttype.def),left.location.register,href);
end;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
sizetopush:=align(left.resulttype.def.size,tempparaloc.alignment);
tempreference:=left.location.reference;
inc(tempreference.offset,sizetopush);
while (sizetopush>0) do
begin
if (sizetopush>=4) or (tempparaloc.alignment>=4) then
begin
cgsize:=OS_32;
inc(tcgcallnode(aktcallnode).pushedparasize,4);
dec(tempreference.offset,4);
dec(sizetopush,4);
end
else
begin
cgsize:=OS_16;
inc(tcgcallnode(aktcallnode).pushedparasize,2);
dec(tempreference.offset,2);
dec(sizetopush,2);
end;
cg.a_param_ref(exprasmlist,cgsize,tempreference,tempparaloc);
end;
end;
else
internalerror(200204243);
end;
{$else i386}
case left.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_paramfpu_reg(exprasmlist,def_cgsize(left.resulttype.def),left.location.register,tempparaloc);
LOC_REFERENCE,
LOC_CREFERENCE :
cg.a_paramfpu_ref(exprasmlist,def_cgsize(left.resulttype.def),left.location.reference,tempparaloc)
else
internalerror(200204243);
end;
case left.location.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
cg.a_paramfpu_reg(exprasmlist,def_cgsize(left.resulttype.def),left.location.register,tempparaloc);
LOC_REFERENCE,
LOC_CREFERENCE :
cg.a_paramfpu_ref(exprasmlist,def_cgsize(left.resulttype.def),left.location.reference,tempparaloc)
else
internalerror(200204243);
end;
{$endif i386}
end;
end
else
begin
@ -263,44 +237,16 @@ implementation
if cgsize in [OS_64,OS_S64] then
begin
inc(tcgcallnode(aktcallnode).pushedparasize,8);
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
begin
size:=align(p.resulttype.def.size,alignment);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false)
end
else
cg64.a_load64_loc_ref(exprasmlist,left.location,href);
end
else
*)
allocate_tempparaloc;
cg64.a_param64_loc(exprasmlist,left.location,tempparaloc);
location_release(exprasmlist,left.location);
allocate_tempparaloc;
cg64.a_param64_loc(exprasmlist,left.location,tempparaloc);
location_release(exprasmlist,left.location);
end
else
begin
location_release(exprasmlist,left.location);
allocate_tempparaloc;
inc(tcgcallnode(aktcallnode).pushedparasize,align(tcgsize2size[tempparaloc.size],tempparaloc.alignment));
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
begin
size:=align(p.resulttype.def.size,alignment);
cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false)
end
else
cg.a_load_loc_ref(exprasmlist,left.location.size,left.location,href);
end
else
*)
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
end;
end;
{$ifdef SUPPORT_MMX}
@ -310,15 +256,7 @@ implementation
location_release(exprasmlist,left.location);
allocate_tempparaloc;
inc(tcgcallnode(aktcallnode).pushedparasize,8);
(*
if calloption=pocall_inline then
begin
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize);
cg.a_loadmm_reg_ref(exprasmlist,left.location.register,href);
end
else
*)
cg.a_parammm_reg(exprasmlist,left.location.register);
cg.a_parammm_reg(exprasmlist,left.location.register);
end;
{$endif SUPPORT_MMX}
else
@ -639,12 +577,11 @@ implementation
pushedother : tpushedsavedother;
oldpushedparasize : longint;
{ adress returned from an I/O-error }
iolabel : tasmlabel;
{ help reference pointer }
href : treference;
pop_size : longint;
pvreg,
vmtreg,vmtreg2 : tregister;
vmtreg : tregister;
oldaktcallnode : tcallnode;
procedure pushparas;
@ -714,7 +651,6 @@ implementation
if assigned(varargsparas) then
paramanager.create_varargs_paraloc_info(procdefinition,varargsparas);
iolabel:=nil;
rg.saveunusedstate(unusedstate);
if not assigned(funcretnode) then
@ -805,13 +741,6 @@ implementation
{ release self }
rg.ungetaddressregister(exprasmlist,vmtreg);
(*
vmtreg2:=rg.getabtregisterint(exprasmlist,OS_ADDR);
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,vmtreg,vmtreg2);
{ load virtual method (procvar) }
rg.ungetregisterint(exprasmlist,vmtreg2);
*)
pvreg:=rg.getabtregisterint(exprasmlist,OS_ADDR);
reference_reset_base(href,vmtreg,
tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
@ -988,32 +917,18 @@ implementation
procedure tcgcallnode.inlined_pass_2;
var
regs_to_push_int : Tsuperregisterset;
regs_to_push_other : totherregisterset;
unusedstate: pointer;
pushedother : tpushedsavedother;
oldpushedparasize : longint;
oldaktcallnode : tcallnode;
i : longint;
oldprocinfo : tprocinfo;
oldinlining_procedure : boolean;
inlineentrycode,inlineexitcode : TAAsmoutput;
oldregstate: pointer;
old_local_fixup,
old_para_fixup : longint;
usesacc,usesacchi,usesfpu : boolean;
pararef,
localsref : treference;
{$ifdef GDB}
startlabel,endlabel : tasmlabel;
pp : pchar;
mangled_length : longint;
{$endif GDB}
begin
{$warning TODO Fix inlining}
internalerror(200309211);
if not(assigned(procdefinition) and (procdefinition.deftype=procdef)) then
internalerror(200305262);
@ -1025,69 +940,10 @@ implementation
{ calculate registers to pass the parameters }
paramanager.create_inline_paraloc_info(procdefinition);
(*
{ deallocate the registers used for the current procedure's regvars }
if assigned(current_procinfo.procdef.regvarinfo) then
begin
with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
for i := 1 to maxvarregs do
if assigned(regvars[i]) then
store_regvar(exprasmlist,regvars[i].localloc.register);
rg.saveStateForInline(oldregstate);
{ make sure the register allocator knows what the regvars in the }
{ inlined code block are (JM) }
rg.resetusableregisters;
rg.clearregistercount;
if assigned(tprocdef(procdefinition).regvarinfo) then
with pregvarinfo(tprocdef(procdefinition).regvarinfo)^ do
for i := 1 to maxvarregs do
if assigned(regvars[i]) then
begin
{Fix me!!}
{tmpreg:=rg.makeregsize(regvars[i].reg,OS_INT);
rg.makeregvar(tmpreg);}
internalerror(200301232);
end;
end;
*)
{ create temp procinfo }
current_procinfo:=cprocinfo.create(nil);
current_procinfo.procdef:=tprocdef(procdefinition);
(*
{ Localsymtable }
current_procinfo.procdef.localst.symtablelevel:=oldprocdef.localst.symtablelevel;
if current_procinfo.procdef.localst.datasize>0 then
begin
old_local_fixup:=current_procinfo.procdef.localst.address_fixup;
tg.GetTemp(exprasmlist,current_procinfo.procdef.localst.datasize,tt_persistent,localsref);
if tg.direction>0 then
current_procinfo.procdef.localst.address_fixup:=localsref.offset
else
current_procinfo.procdef.localst.address_fixup:=localsref.offset+current_procinfo.procdef.localst.datasize;
{$ifdef extdebug}
Comment(V_debug,'inlined local symtable ('+tostr(current_procinfo.procdef.localst.datasize)+' bytes) is at offset '+tostr(current_procinfo.procdef.localst.address_fixup));
exprasmList.concat(tai_comment.Create(strpnew(
'inlined local symtable ('+tostr(current_procinfo.procdef.localst.datasize)+' bytes) is at offset '+tostr(current_procinfo.procdef.localst.address_fixup))));
{$endif extdebug}
end;
{ Parasymtable }
current_procinfo.procdef.parast.symtablelevel:=oldprocdef.localst.symtablelevel;
if current_procinfo.procdef.parast.datasize>0 then
begin
old_para_fixup:=current_procinfo.procdef.parast.address_fixup;
tg.GetTemp(exprasmlist,current_procinfo.procdef.parast.datasize,tt_persistent,pararef);
current_procinfo.procdef.parast.address_fixup:=pararef.offset;
{$ifdef extdebug}
Comment(V_debug,'inlined para symtable ('+tostr(current_procinfo.procdef.parast.datasize)+' bytes) is at offset '+tostr(current_procinfo.procdef.parast.address_fixup));
exprasmList.concat(tai_comment.Create(strpnew(
'inlined para symtable ('+tostr(current_procinfo.procdef.parast.datasize)+' bytes) is at offset '+tostr(current_procinfo.procdef.parast.address_fixup))));
{$endif extdebug}
end;
*)
{ Add inling start }
exprasmList.concat(Tai_Marker.Create(InlineStart));
{$ifdef extdebug}
@ -1095,7 +951,7 @@ implementation
{$endif extdebug}
{ Allocate parameters and locals }
gen_alloc_parast(exprasmlist,tparasymtable(current_procinfo.procdef.parast));
gen_alloc_inline_parast(exprasmlist,tparasymtable(current_procinfo.procdef.parast));
if current_procinfo.procdef.localst.symtabletype=localsymtable then
gen_alloc_localst(exprasmlist,tlocalsymtable(current_procinfo.procdef.localst));
@ -1105,16 +961,10 @@ implementation
objectlibrary.getaddrlabel(startlabel);
objectlibrary.getaddrlabel(endlabel);
cg.a_label(exprasmlist,startlabel);
// tprocdef(procdefinition).localst.symtabletype:=inlinelocalsymtable;
// procdefinition.parast.symtabletype:=inlineparasymtable;
{ Here we must include the para and local symtable info }
procdefinition.concatstabto(withdebuglist);
{ set it back for safety }
// tprocdef(procdefinition).localst.symtabletype:=localsymtable;
// procdefinition.parast.symtabletype:=parasymtable;
mangled_length:=length(oldprocinfo.procdef.mangledname);
getmem(pp,mangled_length+50);
strpcopy(pp,'192,0,0,'+startlabel.name);
@ -1142,36 +992,6 @@ implementation
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end;
(*
{ save all used registers and possible registers
used for the return value }
regs_to_push_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
regs_to_push_other:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
if (not is_void(resulttype.def)) then
begin
case procdefinition.funcret_paraloc[callerside].loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
begin
include(regs_to_push_int,getsupreg(procdefinition.funcret_paraloc[callerside].registerlow));
include(regs_to_push_int,getsupreg(procdefinition.funcret_paraloc[callerside].registerhigh));
end
else
{$endif cpu64bit}
include(regs_to_push_int,getsupreg(procdefinition.funcret_paraloc[callerside].register));
end;
end;
end;
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
*)
{ Initialize for pushing the parameters }
// oldpushedparasize:=pushedparasize;
// pushedparasize:=0;
{ Push parameters }
oldaktcallnode:=aktcallnode;
aktcallnode:=self;
@ -1179,12 +999,11 @@ implementation
tcallparanode(left).secondcallparan;
aktcallnode:=oldaktcallnode;
// rg.saveotherregvars(exprasmlist,regs_to_push_other);
{ takes care of local data initialization }
inlineentrycode:=TAAsmoutput.Create;
inlineexitcode:=TAAsmoutput.Create;
gen_load_para_value(inlineentrycode);
gen_initialize_code(inlineentrycode,true);
if po_assembler in current_procinfo.procdef.procoptions then
inlineentrycode.insert(Tai_marker.Create(asmblockstart));
@ -1193,13 +1012,6 @@ implementation
{ process the inline code }
secondpass(inlinecode);
{ Reserve space for storing parameters that will be pushed }
// current_procinfo.allocate_push_parasize(pushedparasize);
{ Restore }
// pushedparasize:=oldpushedparasize;
// rg.restoreunusedstate(unusedstate);
gen_finalize_code(inlineexitcode,true);
gen_load_return_value(inlineexitcode,usesacc,usesacchi,usesfpu);
if po_assembler in current_procinfo.procdef.procoptions then
@ -1213,21 +1025,6 @@ implementation
{$endif extdebug}
exprasmList.concat(Tai_Marker.Create(InlineEnd));
(*
{we can free the local data now, reset also the fixup address }
if current_procinfo.procdef.localst.datasize>0 then
begin
tg.UnGetTemp(exprasmlist,localsref);
current_procinfo.procdef.localst.address_fixup:=old_local_fixup;
end;
{we can free the para data now, reset also the fixup address }
if current_procinfo.procdef.parast.datasize>0 then
begin
tg.UnGetTemp(exprasmlist,pararef);
current_procinfo.procdef.parast.address_fixup:=old_para_fixup;
end;
*)
{ handle function results }
if (not is_void(resulttype.def)) then
handle_return_value
@ -1247,9 +1044,6 @@ implementation
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
end;
{ restore registers }
// rg.restoreusedotherregisters(exprasmlist,pushedother);
{ release temps of paras }
release_para_temps;
@ -1278,6 +1072,11 @@ implementation
end;
end;
{ Release parameters and locals }
gen_free_parast(exprasmlist,tparasymtable(current_procinfo.procdef.parast));
if current_procinfo.procdef.localst.symtabletype=localsymtable then
gen_free_localst(exprasmlist,tlocalsymtable(current_procinfo.procdef.localst));
{ release procinfo }
current_procinfo.free;
current_procinfo:=oldprocinfo;
@ -1324,7 +1123,13 @@ begin
end.
{
$Log$
Revision 1.125 2003-10-05 21:21:52 peter
Revision 1.126 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.125 2003/10/05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes

14
compiler/ncgld.pas
View File

@ -216,9 +216,7 @@ implementation
begin
case symtabletype of
localsymtable,
parasymtable,
inlinelocalsymtable,
inlineparasymtable :
parasymtable :
begin
if tvarsym(symtableentry).localloc.loc<>LOC_REFERENCE then
internalerror(2003091816);
@ -246,7 +244,7 @@ implementation
{ handle call by reference variables when they are not
alreayd copied to local copies. Also ignore the reference
when we need to load the self pointer for objects }
if (symtabletype in [parasymtable,inlineparasymtable]) and
if (symtabletype=parasymtable) and
not(vo_has_local_copy in tvarsym(symtableentry).varoptions) and
not(nf_load_self_pointer in flags) and
paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption) then
@ -885,7 +883,13 @@ begin
end.
{
$Log$
Revision 1.90 2003-10-05 21:21:52 peter
Revision 1.91 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.90 2003/10/05 21:21:52 peter
* c style array of const generates callparanodes
* varargs paraloc fixes

295
compiler/ncgutil.pas
View File

@ -44,9 +44,9 @@ interface
procedure maketojumpbool(list:TAAsmoutput; p : tnode; loadregvars: tloadregvars);
procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset);
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
@ -54,16 +54,18 @@ interface
procedure gen_proc_symbol_end(list:Taasmoutput);
procedure gen_stackalloc_code(list:Taasmoutput);
procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
procedure gen_save_used_regs(list : TAAsmoutput);
procedure gen_restore_used_regs(list : TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
procedure gen_save_used_regs(list:TAAsmoutput);
procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
procedure gen_finalize_code(list : TAAsmoutput;inlined:boolean);
procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
procedure gen_entry_code(list:TAAsmoutput);
procedure gen_exit_code(list:TAAsmoutput);
procedure gen_load_para_value(list:TAAsmoutput);
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
(*
procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
*)
{#
@ -81,18 +83,19 @@ interface
be modified, all temps should be allocated on the heap instead of the
stack.
}
procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
procedure insertconstdata(sym : ttypedconstsym);
procedure insertbssdata(sym : tvarsym);
procedure gen_alloc_localst(list: taasmoutput;st:tlocalsymtable);
procedure gen_free_localst(list: taasmoutput;st:tlocalsymtable);
procedure gen_alloc_parast(list: taasmoutput;st:tparasymtable);
procedure gen_free_parast(list: taasmoutput;st:tparasymtable);
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
implementation
@ -259,7 +262,7 @@ implementation
EXCEPTION MANAGEMENT
*****************************************************************************}
procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
procedure new_exception(list:TAAsmoutput;const jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
var
@ -294,7 +297,7 @@ implementation
end;
procedure free_exception(list : taasmoutput;const jmpbuf, envbuf, href : treference;
procedure free_exception(list:TAAsmoutput;const jmpbuf, envbuf, href : treference;
a : aword ; endexceptlabel : tasmlabel; onlyfree : boolean);
begin
@ -316,7 +319,7 @@ implementation
{$ifndef cpu64bit}
{ 32-bit version }
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
var
hregister,
hregisterhi : tregister;
@ -479,7 +482,7 @@ implementation
{$else cpu64bit}
{ 64-bit version }
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_reg(list:TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
var
hregister : tregister;
hl : tasmlabel;
@ -597,7 +600,7 @@ implementation
{$endif cpu64bit}
procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
procedure location_force_fpureg(list:TAAsmoutput;var l: tlocation;maybeconst:boolean);
var
reg : tregister;
begin
@ -614,7 +617,7 @@ implementation
end;
procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
procedure location_force_mem(list:TAAsmoutput;var l:tlocation);
var
r : treference;
begin
@ -678,7 +681,7 @@ implementation
procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
var
href1,href2 : treference;
list : taasmoutput;
list:TAAsmoutput;
hsym : tvarsym;
l : longint;
loadref : boolean;
@ -750,7 +753,7 @@ implementation
procedure initialize_data(p : tnamedindexitem;arg:pointer);
var
href : treference;
list : taasmoutput;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
@ -761,7 +764,7 @@ implementation
begin
if (cs_implicit_exceptions in aktmoduleswitches) then
include(current_procinfo.flags,pi_needs_implicit_finally);
if tvarsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
if tvarsym(p).owner.symtabletype=localsymtable then
begin
case tvarsym(p).localloc.loc of
LOC_REFERENCE :
@ -781,7 +784,7 @@ implementation
procedure finalize_data(p : tnamedindexitem;arg:pointer);
var
href : treference;
list : taasmoutput;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
case tsym(p).typ of
@ -793,7 +796,7 @@ implementation
not(is_class(tvarsym(p).vartype.def)) and
tvarsym(p).vartype.def.needs_inittable then
begin
if tvarsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
if tvarsym(p).owner.symtabletype=localsymtable then
begin
case tvarsym(p).localloc.loc of
LOC_REFERENCE :
@ -826,7 +829,7 @@ implementation
var
href : treference;
tmpreg : tregister;
list : taasmoutput;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
@ -866,7 +869,7 @@ implementation
procedure final_paras(p : tnamedindexitem;arg:pointer);
var
href : treference;
list : taasmoutput;
list:TAAsmoutput;
begin
list:=taasmoutput(arg);
if (tsym(p).typ=varsym) and
@ -1116,6 +1119,28 @@ implementation
begin
if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
begin
if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
begin
{$ifndef cpu64bit}
if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
begin
rg.getexplicitregisterint(list,hp.paraloc[calleeside].registerlow);
rg.getexplicitregisterint(list,hp.paraloc[calleeside].registerhigh);
end
else
{$endif cpu64bit}
rg.getexplicitregisterint(list,hp.paraloc[calleeside].register);
end;
{ Release parameter register }
{$ifndef cpu64bit}
if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
begin
rg.ungetregisterint(list,hp.paraloc[calleeside].registerlow);
rg.ungetregisterint(list,hp.paraloc[calleeside].registerhigh);
end
else
{$endif cpu64bit}
rg.ungetregisterint(list,hp.paraloc[calleeside].register);
reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
cg.a_load_param_ref(list,hp.paraloc[calleeside],href);
end;
@ -1147,28 +1172,7 @@ implementation
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
var
href : treference;
paraloc1,
paraloc2 : tparalocation;
begin
{ the actual profile code can clobber some registers,
therefore if the context must be saved, do it before
the actual call to the profile code
}
if (cs_profile in aktmoduleswitches) and
not(po_assembler in current_procinfo.procdef.procoptions) and
not(inlined) then
begin
{ non-win32 can call mcout even in main }
if not (target_info.system in [system_i386_win32,system_i386_wdosx]) then
cg.g_profilecode(list)
else
{ wdosx, and win32 should not call mcount before monstartup has been called }
if not (current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.g_profilecode(list);
end;
{ initialize local data like ansistrings }
case current_procinfo.procdef.proctypeoption of
potype_unitinit:
@ -1193,50 +1197,12 @@ implementation
{ initialize ansi/widesstring para's }
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
if (not inlined) then
begin
{ call startup helpers from main program }
if (current_procinfo.procdef.proctypeoption=potype_proginit) then
begin
{ initialize profiling for win32 }
if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
(cs_profile in aktmoduleswitches) then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,href,paraloc2);
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
cg.a_call_name(list,'_monstartup');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
end;
{ initialize units }
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
end;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list.concat(Tai_force_line.Create);
{$endif GDB}
end;
load_regvars(list,nil);
end;
procedure gen_finalize_code(list : TAAsmoutput;inlined:boolean);
procedure gen_finalize_code(list:TAAsmoutput;inlined:boolean);
begin
cg.a_label(list,current_procinfo.aktexitlabel);
cleanup_regvars(list);
{ finalize temporary data }
@ -1263,14 +1229,74 @@ implementation
{ finalize paras data }
if assigned(current_procinfo.procdef.parast) then
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
end;
procedure gen_entry_code(list:TAAsmoutput);
var
href : treference;
paraloc1,
paraloc2 : tparalocation;
begin
{ the actual profile code can clobber some registers,
therefore if the context must be saved, do it before
the actual call to the profile code
}
if (cs_profile in aktmoduleswitches) and
not(po_assembler in current_procinfo.procdef.procoptions) then
begin
{ non-win32 can call mcout even in main }
if not (target_info.system in [system_i386_win32,system_i386_wdosx]) then
cg.g_profilecode(list)
else
{ wdosx, and win32 should not call mcount before monstartup has been called }
if not (current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.g_profilecode(list);
end;
{ call startup helpers from main program }
if (current_procinfo.procdef.proctypeoption=potype_proginit) then
begin
{ initialize profiling for win32 }
if (target_info.system in [system_i386_win32,system_i386_wdosx]) and
(cs_profile in aktmoduleswitches) then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,href,paraloc2);
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
cg.a_call_name(list,'_monstartup');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
end;
{ initialize units }
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
end;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list.concat(Tai_force_line.Create);
{$endif GDB}
load_regvars(list,nil);
end;
procedure gen_exit_code(list:TAAsmoutput);
begin
{ call __EXIT for main program }
if (not DLLsource) and
(not inlined) and
(current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.a_call_name(list,'FPC_DO_EXIT');
cleanup_regvars(list);
end;
@ -1463,7 +1489,7 @@ implementation
end;
procedure gen_save_used_regs(list : TAAsmoutput);
procedure gen_save_used_regs(list:TAAsmoutput);
begin
{ Pure assembler routines need to save the registers themselves }
if (po_assembler in current_procinfo.procdef.procoptions) then
@ -1479,7 +1505,7 @@ implementation
end;
procedure gen_restore_used_regs(list : TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
procedure gen_restore_used_regs(list:TAAsmoutput;usesacc,usesacchi,usesfpu:boolean);
begin
{ Pure assembler routines need to save the registers themselves }
if (po_assembler in current_procinfo.procdef.procoptions) then
@ -1581,7 +1607,7 @@ implementation
end;
procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
begin
{ initialize return value }
initretvalue(list);
@ -1603,7 +1629,7 @@ implementation
end;
procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
procedure geninlineexitcode(list:TAAsmoutput;inlined:boolean);
var
usesacc,
usesacchi,
@ -1714,7 +1740,7 @@ implementation
end;
procedure gen_alloc_localst(list: taasmoutput;st:tlocalsymtable);
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable);
var
sym : tsym;
begin
@ -1730,6 +1756,9 @@ implementation
{$warning TODO Add support for register variables}
localloc.loc:=LOC_REFERENCE;
tg.GetLocal(list,getvaluesize,localloc.reference);
if cs_asm_source in aktglobalswitches then
list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
end;
end;
sym:=tsym(sym.indexnext);
@ -1737,7 +1766,7 @@ implementation
end;
procedure gen_free_localst(list: taasmoutput;st:tlocalsymtable);
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable);
var
sym : tsym;
begin
@ -1775,7 +1804,7 @@ implementation
end;
procedure gen_alloc_parast(list: taasmoutput;st:tparasymtable);
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
@ -1786,13 +1815,25 @@ implementation
begin
with tvarsym(sym) do
begin
{ Allocate imaginary register for register parameters,
this is not required when the parameter is already an
imaginary register }
if (paraitem.paraloc[calleeside].loc=LOC_REGISTER) and
(getsupreg(paraitem.paraloc[calleeside].register)<first_int_imreg) then
if (paraitem.paraloc[calleeside].loc=LOC_REGISTER) then
begin
(*
if paraitem.paraloc[calleeside].register=NR_NO then
begin
paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
{$ifndef cpu64bit}
if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
begin
paraitem.paraloc[calleeside].registerlow:=rg.getregisterint(list,OS_32);
paraitem.paraloc[calleeside].registerhigh:=rg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
paraitem.paraloc[calleeside].register:=rg.getregisterint(list,localloc.size);
end;
*)
(*
{$warning TODO Allocate register paras}
localloc.loc:=LOC_REGISTER;
localloc.size:=paraitem.paraloc[calleeside].size;
@ -1812,6 +1853,14 @@ implementation
end
else
localloc:=paraitem.paraloc[calleeside];
if cs_asm_source in aktglobalswitches then
begin
case localloc.loc of
LOC_REFERENCE :
list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
end;
end;
end;
end;
sym:=tsym(sym.indexnext);
@ -1819,7 +1868,39 @@ implementation
end;
procedure gen_free_parast(list: taasmoutput;st:tparasymtable);
procedure gen_alloc_inline_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
{$warning TODO Allocate register paras}
localloc.loc:=LOC_REFERENCE;
localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
tg.GetLocal(list,tcgsize2size[localloc.size],localloc.reference);
if cs_asm_source in aktglobalswitches then
begin
case localloc.loc of
LOC_REFERENCE :
list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+
std_regname(localloc.reference.index)+tostr_with_plus(localloc.reference.offset))));
end;
end;
paraitem.paraloc[callerside]:=localloc;
paraitem.paraloc[calleeside]:=localloc;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
@ -1859,7 +1940,13 @@ implementation
end.
{
$Log$
Revision 1.154 2003-10-01 20:34:48 peter
Revision 1.155 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.154 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

36
compiler/psub.pas
View File

@ -38,6 +38,7 @@ interface
{ code for the subroutine as tree }
code : tnode;
{ positions in the tree for init/final }
exitlabelasmnode,
initasmnode,
finalasmnode : tnode;
{ list to store the procinfo's of the nested procedures }
@ -72,7 +73,7 @@ implementation
globtype,tokens,verbose,comphook,
systems,
{ aasm }
aasmtai,
cpubase,aasmtai,
{ symtable }
symconst,symbase,symsym,symtype,symtable,defutil,
paramgr,
@ -364,6 +365,14 @@ implementation
end;
function generate_exitlabel_block:tnode;
begin
{ exit label will be inserted here }
tcgprocinfo(current_procinfo).exitlabelasmnode:=casmnode.create_get_position;
result:=tcgprocinfo(current_procinfo).exitlabelasmnode;
end;
function generate_entry_block:tnode;
begin
result:=cnothingnode.create;
@ -496,6 +505,7 @@ implementation
var
initializecode,
finalizecode,
exitlabelcode,
entrycode,
exitcode,
exceptcode : tnode;
@ -514,6 +524,7 @@ implementation
exitcode:=generate_exit_block;
finalizecode:=generate_finalize_block;
exceptcode:=generate_except_block;
exitlabelcode:=generate_exitlabel_block;
{ Generate body of the procedure by combining entry+body+exit }
codeblock:=internalstatements(codestatement,true);
@ -535,11 +546,13 @@ implementation
codeblock,
finalizecode,
exceptcode));
addstatement(newstatement,exitlabelcode);
end
else
begin
addstatement(newstatement,initializecode);
addstatement(newstatement,codeblock);
addstatement(newstatement,exitlabelcode);
addstatement(newstatement,finalizecode);
end;
resulttypepass(newblock);
@ -620,6 +633,9 @@ implementation
gen_alloc_parast(aktproccode,tparasymtable(current_procinfo.procdef.parast));
if current_procinfo.procdef.localst.symtabletype=localsymtable then
gen_alloc_localst(aktproccode,tlocalsymtable(current_procinfo.procdef.localst));
if (cs_asm_source in aktglobalswitches) then
exprasmlist.concat(Tai_comment.Create(strpnew('Temps start at '+std_regname(current_procinfo.framepointer)+
tostr_with_plus(tg.lasttemp))));
{ Load register parameters in temps and insert local copies
for values parameters. This must be done before the body is parsed
@ -649,6 +665,7 @@ implementation
position and switches }
aktfilepos:=entrypos;
aktlocalswitches:=entryswitches;
gen_entry_code(templist);
gen_initialize_code(templist,false);
aktproccode.insertlistafter(tasmnode(initasmnode).currenttai,templist);
@ -664,6 +681,15 @@ implementation
aktproccode.insertlistafter(tasmnode(finalasmnode).currenttai,templist)
else
aktproccode.concatlist(templist);
{ insert exit label at the correct position }
cg.a_label(templist,current_procinfo.aktexitlabel);
if assigned(tasmnode(exitlabelasmnode).currenttai) then
aktproccode.insertlistafter(tasmnode(exitlabelasmnode).currenttai,templist)
else
aktproccode.concatlist(templist);
{ exit code }
gen_exit_code(templist);
aktproccode.concatlist(templist);
{ note: this must be done only after as much code as possible has }
{ been generated. The result is that when you ungetregister() a }
@ -1290,7 +1316,13 @@ begin
end.
{
$Log$
Revision 1.158 2003-10-06 22:23:41 florian
Revision 1.159 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.158 2003/10/06 22:23:41 florian
+ added basic olevariant support
Revision 1.157 2003/10/03 14:45:09 peter

12
compiler/symconst.pas
View File

@ -271,9 +271,7 @@ type
globalsymtable,staticsymtable,
objectsymtable,recordsymtable,
localsymtable,parasymtable,
withsymtable,stt_exceptsymtable,
{ used for inline detection }
inlineparasymtable,inlinelocalsymtable
withsymtable,stt_exceptsymtable
);
@ -379,7 +377,13 @@ implementation
end.
{
$Log$
Revision 1.66 2003-10-06 22:23:41 florian
Revision 1.67 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.66 2003/10/06 22:23:41 florian
+ added basic olevariant support
Revision 1.65 2003/09/28 17:55:04 peter

20
compiler/symsym.pas
View File

@ -1852,12 +1852,10 @@ implementation
','+mangledname+threadvaroffset);
end;
parasymtable,
localsymtable,
inlineparasymtable,
inlinelocalsymtable :
localsymtable :
begin
{ There is no space allocated for not referenced locals }
if (owner.symtabletype in [localsymtable,inlinelocalsymtable]) and
if (owner.symtabletype=localsymtable) and
(refs=0) then
begin
exit;
@ -1869,7 +1867,7 @@ implementation
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
exit;
end;
if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
if (owner.symtabletype=parasymtable) and
paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
@ -1909,7 +1907,7 @@ implementation
stab_str : pchar;
c : char;
begin
if (owner.symtabletype in [parasymtable,inlineparasymtable]) and
if (owner.symtabletype=parasymtable) and
(copy(name,1,6)='hidden') then
exit;
if (vo_is_self in varoptions) then
@ -1956,7 +1954,7 @@ implementation
_vartype := newtype;
{ can we load the value into a register ? }
if not assigned(owner) or
(owner.symtabletype in [localsymtable,parasymtable,inlineparasymtable,inlinelocalsymtable]) then
(owner.symtabletype in [localsymtable,parasymtable]) then
begin
if tstoreddef(vartype.def).is_intregable then
include(varoptions,vo_regable)
@ -2678,7 +2676,13 @@ implementation
end.
{
$Log$
Revision 1.122 2003-10-01 20:34:49 peter
Revision 1.123 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.122 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

11
compiler/symtable.pas
View File

@ -916,9 +916,6 @@ implementation
{$ifdef GDB}
procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
begin
if symtabletype in [inlineparasymtable,inlinelocalsymtable] then
foreach({$ifdef FPCPROCVAR}@{$endif}resetstab,nil);
foreach({$ifdef FPCPROCVAR}@{$endif}concatstab,asmlist);
end;
{$endif}
@ -2259,7 +2256,13 @@ implementation
end.
{
$Log$
Revision 1.113 2003-10-03 14:43:29 peter
Revision 1.114 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.113 2003/10/03 14:43:29 peter
* don't report unused hidden parameters
Revision 1.112 2003/10/02 21:13:46 peter

241
compiler/x86/cgx86.pas
View File

@ -338,61 +338,55 @@ unit cgx86;
procedure tcgx86.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
begin
check_register_size(size,r);
case locpara.loc of
LOC_REGISTER :
cg.a_load_reg_reg(list,size,locpara.size,r,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,
OS_16,OS_S16:
begin
if locpara.alignment = 2 then
list.concat(taicpu.op_reg(A_PUSH,S_W,rg.makeregsize(r,OS_16)))
else
list.concat(taicpu.op_reg(A_PUSH,S_L,rg.makeregsize(r,OS_32)));
end;
OS_32,OS_S32:
begin
if getsubreg(r)<>R_SUBD then
internalerror(7843);
list.concat(taicpu.op_reg(A_PUSH,S_L,r));
end
else
internalerror(2002032212);
end;
if (locpara.loc=LOC_REFERENCE) and
(locpara.reference.index=NR_STACK_POINTER_REG) then
begin
case size of
OS_8,OS_S8,
OS_16,OS_S16:
begin
if locpara.alignment = 2 then
list.concat(taicpu.op_reg(A_PUSH,S_W,rg.makeregsize(r,OS_16)))
else
list.concat(taicpu.op_reg(A_PUSH,S_L,rg.makeregsize(r,OS_32)));
end;
OS_32,OS_S32:
begin
if getsubreg(r)<>R_SUBD then
internalerror(7843);
list.concat(taicpu.op_reg(A_PUSH,S_L,r));
end
else
internalerror(2002032212);
end;
else
internalerror(200309082);
end;
end
else
inherited a_param_reg(list,size,r,locpara);
end;
procedure tcgx86.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
begin
case locpara.loc of
LOC_REGISTER :
cg.a_load_const_reg(list,locpara.size,a,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,OS_16,OS_S16:
begin
if locpara.alignment = 2 then
list.concat(taicpu.op_const(A_PUSH,S_W,a))
else
list.concat(taicpu.op_const(A_PUSH,S_L,a));
end;
OS_32,OS_S32:
list.concat(taicpu.op_const(A_PUSH,S_L,a));
else
internalerror(2002032213);
end;
if (locpara.loc=LOC_REFERENCE) and
(locpara.reference.index=NR_STACK_POINTER_REG) then
begin
case size of
OS_8,OS_S8,OS_16,OS_S16:
begin
if locpara.alignment = 2 then
list.concat(taicpu.op_const(A_PUSH,S_W,a))
else
list.concat(taicpu.op_const(A_PUSH,S_L,a));
end;
OS_32,OS_S32:
list.concat(taicpu.op_const(A_PUSH,S_L,a));
else
internalerror(2002032213);
end;
else
internalerror(200309082);
end;
end
else
inherited a_param_const(list,size,a,locpara);
end;
@ -403,37 +397,34 @@ unit cgx86;
tmpreg : tregister;
begin
case locpara.loc of
LOC_REGISTER :
cg.a_load_ref_reg(list,size,locpara.size,r,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,
OS_16,OS_S16:
begin
if locpara.alignment = 2 then
pushsize:=OS_16
else
pushsize:=OS_32;
tmpreg:=rg.getregisterint(list,pushsize);
a_load_ref_reg(list,size,pushsize,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
OS_32,OS_S32:
list.concat(taicpu.op_ref(A_PUSH,S_L,r));
if (locpara.loc=LOC_REFERENCE) and
(locpara.reference.index=NR_STACK_POINTER_REG) then
begin
case size of
OS_8,OS_S8,
OS_16,OS_S16:
begin
if locpara.alignment = 2 then
pushsize:=OS_16
else
pushsize:=OS_32;
tmpreg:=rg.getregisterint(list,pushsize);
a_load_ref_reg(list,size,pushsize,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
OS_32,OS_S32:
list.concat(taicpu.op_ref(A_PUSH,S_L,r));
{$ifdef cpu64bit}
OS_64,OS_S64:
list.concat(taicpu.op_ref(A_PUSH,S_Q,r));
OS_64,OS_S64:
list.concat(taicpu.op_ref(A_PUSH,S_Q,r));
{$endif cpu64bit}
else
internalerror(2002032214);
end;
else
internalerror(2002032214);
end;
else
internalerror(200309083);
end;
end
else
inherited a_param_ref(list,size,r,locpara);
end;
@ -443,51 +434,32 @@ unit cgx86;
begin
if (r.segment<>NR_NO) then
CGMessage(cg_e_cant_use_far_pointer_there);
case locpara.loc of
LOC_REGISTER :
begin
if (r.base=NR_NO) and (r.index=NR_NO) then
begin
if assigned(r.symbol) then
list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,r.symbol,r.offset,locpara.register))
else
a_load_const_reg(list,OS_INT,r.offset,locpara.register);
end
else if (r.base=NR_NO) and (r.index<>NR_NO) and
(r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,r.index,locpara.register)
else if (r.base<>NR_NO) and (r.index=NR_NO) and
(r.offset=0) and (r.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,r.base,locpara.register)
else
a_loadaddr_ref_reg(list,r,locpara.register);
end;
LOC_REFERENCE :
begin
if (r.base=NR_NO) and (r.index=NR_NO) then
begin
if assigned(r.symbol) then
list.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,r.symbol,r.offset))
else
list.concat(Taicpu.Op_const(A_PUSH,S_L,r.offset));
end
else if (r.base=NR_NO) and (r.index<>NR_NO) and
(r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.index))
else if (r.base<>NR_NO) and (r.index=NR_NO) and
(r.offset=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
else
begin
tmpreg:=rg.getaddressregister(list);
a_loadaddr_ref_reg(list,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
end;
else
internalerror(200309084);
end;
if (locpara.loc=LOC_REFERENCE) and
(locpara.reference.index=NR_STACK_POINTER_REG) then
begin
if (r.base=NR_NO) and (r.index=NR_NO) then
begin
if assigned(r.symbol) then
list.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,r.symbol,r.offset))
else
list.concat(Taicpu.Op_const(A_PUSH,S_L,r.offset));
end
else if (r.base=NR_NO) and (r.index<>NR_NO) and
(r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.index))
else if (r.base<>NR_NO) and (r.index=NR_NO) and
(r.offset=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
else
begin
tmpreg:=rg.getaddressregister(list);
a_loadaddr_ref_reg(list,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
rg.ungetregisterint(list,tmpreg);
end;
end
else
inherited a_paramaddr_ref(list,r,locpara);
end;
@ -571,16 +543,23 @@ unit cgx86;
end;
procedure tcgx86.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
begin
if assigned(ref.symbol) and
(ref.base=NR_NO) and
(ref.index=NR_NO) then
list.concat(taicpu.op_sym_ofs_reg(A_MOV,S_L,ref.symbol,ref.offset,r))
if (ref.base=NR_NO) and (ref.index=NR_NO) then
begin
if assigned(ref.symbol) then
list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,ref.symbol,ref.offset,r))
else
a_load_const_reg(list,OS_INT,ref.offset,r);
end
else if (ref.base=NR_NO) and (ref.index<>NR_NO) and
(ref.offset=0) and (ref.scalefactor=0) and (ref.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,ref.index,r)
else if (ref.base<>NR_NO) and (ref.index=NR_NO) and
(ref.offset=0) and (ref.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,ref.base,r)
else
list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r));
list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r));
end;
@ -1601,7 +1580,13 @@ unit cgx86;
end.
{
$Log$
Revision 1.72 2003-10-03 22:00:33 peter
Revision 1.73 2003-10-07 15:17:07 peter
* inline supported again, LOC_REFERENCEs are used to pass the
parameters
* inlineparasymtable,inlinelocalsymtable removed
* exitlabel inserting fixed
Revision 1.72 2003/10/03 22:00:33 peter
* parameter alignment fixes
Revision 1.71 2003/10/03 14:45:37 peter