paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 03:19:47 +01:00
Code Issues Packages Projects Releases Wiki Activity

* init/final of procedure data splitted from genentrycode

Browse Source 
* use asmnode getposition to insert final at the correct position
    als for the implicit try...finally
This commit is contained in:
peter 2003-06-09 12:23:29 +00:00
parent 47b691057b
commit 77d641fa2a
7 changed files with 370 additions and 353 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
compiler/cgbase.pas
View File

@ -89,31 +89,6 @@ unit cgbase;
{# register used as frame pointer }
framepointer : tregister;
{# Holds the environment reference for default exceptions
The exception reference is created when ansistrings
or classes are used. It holds buffer for exception
frames. It is allocted by g_new_exception.
}
exception_env_ref : treference;
{# Holds the environment reference for default exceptions
The exception reference is created when ansistrings
or classes are used. It holds buffer for setjmp
It is allocted by g_new_exception.
}
exception_jmp_ref :treference;
{# Holds the environment reference for default exceptions
The exception reference is created when ansistrings
or classes are used. It holds the location where
temporary storage of the setjmp result is stored.
This reference can be unused, if the result is instead
saved on the stack.
}
exception_result_ref :treference;
{# Holds the reference used to store the original stackpointer
after all registers are saved
}
@ -125,16 +100,15 @@ unit cgbase;
systems
}
save_regs_ref : treference;
{ label to leave the sub routine }
aktexitlabel : tasmlabel;
{# The code for the routine itself, excluding entry and
exit code. This is a linked list of tai classes.
}
aktproccode : taasmoutput;
{# The code for the routine entry code.
}
aktentrycode: taasmoutput;
{# The code for the routine exit code.
}
aktexitcode: taasmoutput;
{ Data (like jump tables) that belongs to this routine }
aktlocaldata : taasmoutput;
constructor create(aparent:tprocinfo);virtual;
@ -183,9 +157,6 @@ unit cgbase;
{ label when the result is true or false }
truelabel,falselabel : tasmlabel;
{ label to leave the sub routine }
aktexitlabel : tasmlabel;
{# true, if there was an error while code generation occurs }
codegenerror : boolean;
@ -349,26 +320,22 @@ implementation
flags:=[];
framepointer.enum:=R_INTREGISTER;
framepointer.number:=NR_FRAME_POINTER_REG;
aktentrycode:=Taasmoutput.Create;
aktexitcode:=Taasmoutput.Create;
{ asmlists }
aktproccode:=Taasmoutput.Create;
aktlocaldata:=Taasmoutput.Create;
reference_reset(exception_env_ref);
reference_reset(exception_jmp_ref);
reference_reset(exception_result_ref);
reference_reset(save_stackptr_ref);
{ labels }
objectlibrary.getlabel(aktexitlabel);
end;
destructor tprocinfo.destroy;
begin
aktentrycode.free;
aktexitcode.free;
aktproccode.free;
aktlocaldata.free;
end;
procedure tprocinfo.allocate_interrupt_stackframe;
begin
end;
@ -408,8 +375,6 @@ implementation
procedure tprocinfo.after_header;
var
srsym : tvarsym;
begin
end;
@ -531,6 +496,7 @@ implementation
end;
end;
function int_cgsize(const a: aword): tcgsize;
begin
if a > 8 then
@ -573,7 +539,12 @@ implementation
end.
{
$Log$
Revision 1.53 2003-06-02 21:42:05 jonas
Revision 1.54 2003-06-09 12:23:29 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.53 2003/06/02 21:42:05 jonas
* function results can now also be regvars
- removed tprocinfo.return_offset, never use it again since it's invalid
if the result is a regvar

17
compiler/ncgcal.pas
View File

@ -1040,10 +1040,10 @@ implementation
oldprocinfo : tprocinfo;
oldinlining_procedure : boolean;
inlineentrycode,inlineexitcode : TAAsmoutput;
oldexitlabel:tasmlabel;
oldregstate: pointer;
old_local_fixup,
old_para_fixup : longint;
usesacc,usesacchi,usesfpu : boolean;
pararef,
localsref : treference;
{$ifdef GDB}
@ -1056,10 +1056,8 @@ implementation
internalerror(200305262);
oldinlining_procedure:=inlining_procedure;
oldexitlabel:=aktexitlabel;
oldprocdef:=current_procdef;
oldprocinfo:=current_procinfo;
objectlibrary.getlabel(aktexitlabel);
{ we're inlining a procedure }
inlining_procedure:=true;
@ -1258,7 +1256,7 @@ implementation
inlineentrycode:=TAAsmoutput.Create;
inlineexitcode:=TAAsmoutput.Create;
geninlineentrycode(inlineentrycode,0);
gen_initialize_code(inlineentrycode,true);
if po_assembler in current_procdef.procoptions then
inlineentrycode.insert(Tai_marker.Create(asmblockstart));
exprasmList.concatlist(inlineentrycode);
@ -1279,7 +1277,8 @@ implementation
testregisters32;
{$endif TEMPREGDEBUG}
geninlineexitcode(inlineexitcode,true);
gen_finalize_code(inlineexitcode,true);
gen_load_return_value(inlineexitcode,usesacc,usesacchi,usesfpu);
if po_assembler in current_procdef.procoptions then
inlineexitcode.concat(Tai_marker.Create(asmblockend));
exprasmList.concatlist(inlineexitcode);
@ -1383,7 +1382,6 @@ implementation
{ restore }
current_procdef:=oldprocdef;
aktexitlabel:=oldexitlabel;
inlining_procedure:=oldinlining_procedure;
{ reallocate the registers used for the current procedure's regvars, }
@ -1409,7 +1407,12 @@ begin
end.
{
$Log$
Revision 1.88 2003-06-08 20:01:53 jonas
Revision 1.89 2003-06-09 12:23:29 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.88 2003/06/08 20:01:53 jonas
* optimized assignments with on the right side a function that returns
an ansi- or widestring

29
compiler/ncgflw.pas
View File

@ -719,7 +719,7 @@ implementation
if assigned(left) then
secondpass(left);
cg.a_jmp_always(exprasmlist,aktexitlabel);
cg.a_jmp_always(exprasmlist,current_procinfo.aktexitlabel);
end;
@ -935,7 +935,7 @@ implementation
oldendexceptlabel:=endexceptlabel;
{ save the old labels for control flow statements }
oldaktexitlabel:=aktexitlabel;
oldaktexitlabel:=current_procinfo.aktexitlabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
@ -962,7 +962,7 @@ implementation
{ try block }
{ set control flow labels for the try block }
aktexitlabel:=exittrylabel;
current_procinfo.aktexitlabel:=exittrylabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=continuetrylabel;
@ -983,7 +983,7 @@ implementation
{ set control flow labels for the except block }
{ and the on statements }
aktexitlabel:=exitexceptlabel;
current_procinfo.aktexitlabel:=exitexceptlabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=continueexceptlabel;
@ -1108,7 +1108,7 @@ implementation
endexceptlabel:=oldendexceptlabel;
{ restore the control flow labels }
aktexitlabel:=oldaktexitlabel;
current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
@ -1173,9 +1173,9 @@ implementation
if assigned(right) then
begin
oldaktexitlabel:=aktexitlabel;
oldaktexitlabel:=current_procinfo.aktexitlabel;
objectlibrary.getlabel(exitonlabel);
aktexitlabel:=exitonlabel;
current_procinfo.aktexitlabel:=exitonlabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
@ -1231,7 +1231,7 @@ implementation
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end;
aktexitlabel:=oldaktexitlabel;
current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(oldaktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
@ -1284,12 +1284,12 @@ implementation
{ the finally block must catch break, continue and exit }
{ statements }
oldaktexitlabel:=aktexitlabel;
oldaktexitlabel:=current_procinfo.aktexitlabel;
if implicitframe then
exitfinallylabel:=finallylabel
else
objectlibrary.getlabel(exitfinallylabel);
aktexitlabel:=exitfinallylabel;
current_procinfo.aktexitlabel:=exitfinallylabel;
if assigned(aktbreaklabel) then
begin
oldaktcontinuelabel:=aktcontinuelabel;
@ -1401,7 +1401,7 @@ implementation
end;
cg.a_label(exprasmlist,endfinallylabel);
aktexitlabel:=oldaktexitlabel;
current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(aktbreaklabel) then
begin
aktcontinuelabel:=oldaktcontinuelabel;
@ -1427,7 +1427,12 @@ begin
end.
{
$Log$
Revision 1.69 2003-06-07 18:57:04 jonas
Revision 1.70 2003-06-09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.69 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)

484
compiler/ncgutil.pas
View File

@ -63,12 +63,18 @@ interface
para_offset:longint;alignment : longint;
const locpara : tparalocation);
procedure genentrycode(list:TAAsmoutput;inlined:boolean);
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:longint);
procedure genexitcode(list:Taasmoutput;inlined:boolean);
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
procedure gen_finalize_code(list : TAAsmoutput;inlined:boolean);
procedure gen_entry_code(list:TAAsmoutput;inlined:boolean);
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:longint);
procedure gen_exit_code(list:Taasmoutput;inlined:boolean);
(*
procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
*)
{#
Allocate the buffers for exception management and setjmp environment.
@ -993,7 +999,7 @@ implementation
{****************************************************************************
Entry/Exit Code
Init/Finalize Code
****************************************************************************}
procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
@ -1147,6 +1153,7 @@ implementation
end;
end;
{ generates the code for decrementing the reference count of parameters }
procedure final_paras(p : tnamedindexitem;arg:pointer);
var
@ -1256,40 +1263,103 @@ implementation
end;
procedure load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
var
ressym: tvarsym;
resloc: tlocation;
ressym : tvarsym;
resloc : tlocation;
href : treference;
hreg,r,r2 : tregister;
begin
if not is_void(current_procdef.rettype.def) then
begin
ressym := tvarsym(current_procdef.funcretsym);
if ressym.reg.enum <> R_NO then
begin
if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
location_reset(resloc,LOC_CREGISTER,OS_ADDR)
else
if ressym.vartype.def.deftype = floatdef then
location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procdef.rettype.def))
else
location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procdef.rettype.def));
resloc.register := ressym.reg;
end
else
begin
location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procdef.rettype.def));
reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procdef.funcretsym).adjusted_address);
end;
{ Here, we return the function result. In most architectures, the value is
passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
function returns in a register and the caller receives it in an other one }
case current_procdef.rettype.def.deftype of
orddef,
enumdef :
{ Is the loading needed? }
if is_void(current_procdef.rettype.def) or
(
(po_assembler in current_procdef.procoptions) and
(not(assigned(current_procdef.funcretsym)) or
(tvarsym(current_procdef.funcretsym).refcount=0))
) then
exit;
{ Constructors need to return self }
if (current_procdef.proctypeoption=potype_constructor) then
begin
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RETURN_REG;
cg.a_reg_alloc(list,r);
{ return the self pointer }
ressym:=tvarsym(current_procdef.parast.search('self'));
if not assigned(ressym) then
internalerror(200305058);
reference_reset_base(href,current_procinfo.framepointer,tvarsym(ressym).adjusted_address);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,r);
cg.a_reg_dealloc(list,r);
uses_acc:=true;
exit;
end;
ressym := tvarsym(current_procdef.funcretsym);
if ressym.reg.enum <> R_NO then
begin
if paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
location_reset(resloc,LOC_CREGISTER,OS_ADDR)
else
if ressym.vartype.def.deftype = floatdef then
location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procdef.rettype.def))
else
location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procdef.rettype.def));
resloc.register := ressym.reg;
end
else
begin
location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procdef.rettype.def));
reference_reset_base(resloc.reference,current_procinfo.framepointer,tvarsym(current_procdef.funcretsym).adjusted_address);
end;
{ Here, we return the function result. In most architectures, the value is
passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
function returns in a register and the caller receives it in an other one }
case current_procdef.rettype.def.deftype of
orddef,
enumdef :
begin
uses_acc:=true;
{$ifndef cpu64bit}
if resloc.size in [OS_64,OS_S64] then
begin
uses_acchi:=true;
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RETURN64_LOW_REG;
cg.a_reg_alloc(list,r);
r2.enum:=R_INTREGISTER;
r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
cg.a_reg_alloc(list,r2);
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2){$ifdef newra},false{$endif});
end
else
{$endif cpu64bit}
begin
hreg.enum:=R_INTREGISTER;
hreg.number:=NR_FUNCTION_RETURN_REG;
hreg:=rg.makeregsize(hreg,resloc.size);
cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
end;
end;
floatdef :
begin
uses_fpu := true;
{$ifdef cpufpemu}
if cs_fp_emulation in aktmoduleswitches then
r.enum := FUNCTION_RETURN_REG
else
{$endif cpufpemu}
r.enum:=FPU_RESULT_REG;
cg.a_loadfpu_loc_reg(list,resloc,r);
end;
else
begin
if not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
begin
uses_acc:=true;
{$ifndef cpu64bit}
{ Win32 can return records in EAX:EDX }
if resloc.size in [OS_64,OS_S64] then
begin
uses_acchi:=true;
@ -1305,56 +1375,147 @@ implementation
{$endif cpu64bit}
begin
hreg.enum:=R_INTREGISTER;
hreg.number:=NR_FUNCTION_RETURN_REG;
hreg:=rg.makeregsize(hreg,resloc.size);
hreg.number:=(RS_FUNCTION_RETURN_REG shl 8) or cgsize2subreg(resloc.size);
cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
end;
end;
floatdef :
begin
uses_fpu := true;
{$ifdef cpufpemu}
if cs_fp_emulation in aktmoduleswitches then
r.enum := FUNCTION_RETURN_REG
else
{$endif cpufpemu}
r.enum:=FPU_RESULT_REG;
cg.a_loadfpu_loc_reg(list,resloc,r);
end;
else
begin
if not paramanager.ret_in_param(current_procdef.rettype.def,current_procdef.proccalloption) then
begin
uses_acc:=true;
{$ifndef cpu64bit}
{ Win32 can return records in EAX:EDX }
if resloc.size in [OS_64,OS_S64] then
begin
uses_acchi:=true;
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RETURN64_LOW_REG;
cg.a_reg_alloc(list,r);
r2.enum:=R_INTREGISTER;
r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
cg.a_reg_alloc(list,r2);
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2){$ifdef newra},false{$endif});
end
else
{$endif cpu64bit}
begin
hreg.enum:=R_INTREGISTER;
hreg.number:=(RS_FUNCTION_RETURN_REG shl 8) or cgsize2subreg(resloc.size);
cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
end;
end
end;
end;
end;
end
end;
end;
end;
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
var
href : treference;
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_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_procdef.proctypeoption=potype_proginit) then
cg.g_profilecode(list);
end;
procedure genentrycode(list:TAAsmoutput;inlined:boolean);
{ initialize return value }
initretvalue(list);
{ initialize local data like ansistrings }
case current_procdef.proctypeoption of
potype_unitinit:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ initialisizes temp. ansi/wide string data }
inittempvariables(list);
{ generate copies of call by value parameters, must be done before
the initialization because the refcounts are incremented using
the local copies }
if not(po_assembler in current_procdef.procoptions) then
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
{ initialize ansi/widesstring para's }
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
if (not inlined) then
begin
{ call startup helpers from main program }
if (current_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);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'_monstartup');
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
end;
{ initialize units }
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
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);
begin
cg.a_label(list,current_procinfo.aktexitlabel);
cleanup_regvars(list);
{ finalize temporary data }
finalizetempvariables(list);
{ finalize local data like ansistrings}
case current_procdef.proctypeoption of
potype_unitfinalize:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ units/progs have separate code for initialization and finalization }
potype_unitinit: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ finalize paras data }
if assigned(current_procdef.parast) then
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
{ call __EXIT for main program }
if (not DLLsource) and
(not inlined) and
(current_procdef.proctypeoption=potype_proginit) then
cg.a_call_name(list,'FPC_DO_EXIT');
cleanup_regvars(list);
end;
{****************************************************************************
Entry/Exit
****************************************************************************}
procedure gen_entry_code(list:TAAsmoutput;inlined:boolean);
var
href : treference;
hp : tparaitem;
@ -1367,7 +1528,6 @@ implementation
if assigned(current_procdef.parast) then
begin
if not (po_assembler in current_procdef.procoptions) then
begin
{ move register parameters which aren't regable into memory }
@ -1423,7 +1583,6 @@ implementation
end;
end;
{ 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
@ -1444,91 +1603,9 @@ implementation
rsp.number:=NR_STACK_POINTER_REG;
cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,rsp,current_procinfo.save_stackptr_ref);
end;
{ 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_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_procdef.proctypeoption=potype_proginit) then
cg.g_profilecode(list);
end;
{ initialize return value }
initretvalue(list);
{ initialize local data like ansistrings }
case current_procdef.proctypeoption of
potype_unitinit:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
end;
{ initialisizes temp. ansi/wide string data }
inittempvariables(list);
{ initialize ansi/widesstring para's }
if assigned(current_procdef.parast) then
begin
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras,list);
end;
{ generate copies of call by value parameters }
if not(po_assembler in current_procdef.procoptions) then
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
if (not inlined) then
begin
{ call startup helpers from main program }
if (current_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);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
cg.a_call_name(list,'_monstartup');
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
end;
{ initialize units }
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
end;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list.concat(Tai_force_line.Create);
{$endif GDB}
end;
if inlined then
load_regvars(list,nil);
end;
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:longint);
var hs:string;
@ -1600,7 +1677,8 @@ implementation
end;
end;
procedure genexitcode(list : TAAsmoutput;inlined:boolean);
procedure gen_exit_code(list : TAAsmoutput;inlined:boolean);
var
{$ifdef GDB}
@ -1608,82 +1686,18 @@ implementation
mangled_length : longint;
p : pchar;
{$endif GDB}
okexitlabel : tasmlabel;
href : treference;
srsym : tsym;
usesacc,
usesacchi,
usesfpu : boolean;
rsp,r : Tregister;
rsp : Tregister;
retsize : longint;
begin
if aktexitlabel.is_used then
cg.a_label(list,aktexitlabel);
cleanup_regvars(list);
{ finalize temporary data }
finalizetempvariables(list);
{ finalize local data like ansistrings}
case current_procdef.proctypeoption of
potype_unitfinalize:
begin
{ this is also used for initialization of variables in a
program which does not have a globalsymtable }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ units/progs have separate code for initialization and finalization }
potype_unitinit: ;
{ program init/final is generated in separate procedure }
potype_proginit: ;
else
current_procdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
end;
{ finalize paras data }
if assigned(current_procdef.parast) then
current_procdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras,list);
{ call __EXIT for main program }
if (not DLLsource) and
(not inlined) and
(current_procdef.proctypeoption=potype_proginit) then
begin
cg.a_call_name(list,'FPC_DO_EXIT');
end;
{ handle return value, this is not done for assembler routines when
they didn't reference the result variable }
usesacc:=false;
usesfpu:=false;
usesacchi:=false;
if not(po_assembler in current_procdef.procoptions) or
(assigned(current_procdef.funcretsym) and
(tvarsym(current_procdef.funcretsym).refcount>1)) then
begin
if (current_procdef.proctypeoption=potype_constructor) then
begin
objectlibrary.getlabel(okexitlabel);
cg.a_jmp_always(list,okexitlabel);
{ Success exit }
cg.a_label(list,okexitlabel);
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RETURN_REG;
cg.a_reg_alloc(list,r);
{ return the self pointer }
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,OS_ADDR,href,r);
cg.a_reg_dealloc(list,r);
usesacc:=true;
end
else
load_return_value(list,usesacc,usesacchi,usesfpu)
end;
gen_load_return_value(list,usesacc,usesacchi,usesfpu);
{$ifdef GDB}
if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
@ -1812,9 +1826,6 @@ implementation
freemem(p,2*mangled_length+50);
end;
{$endif GDB}
if inlined then
cleanup_regvars(list);
end;
@ -1822,6 +1833,7 @@ implementation
Inlining
****************************************************************************}
(*
procedure load_inlined_return_value(list:TAAsmoutput);
var
ressym: tvarsym;
@ -1959,11 +1971,17 @@ implementation
cleanup_regvars(list);
end;
*)
end.
{
$Log$
Revision 1.123 2003-06-07 18:57:04 jonas
Revision 1.124 2003-06-09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.123 2003/06/07 18:57:04 jonas
+ added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para)

11
compiler/pass_2.pas
View File

@ -279,13 +279,13 @@ implementation
{ process register variable stuff (JM) }
assign_regvars(p);
load_regvars(current_procinfo.aktentrycode,p);
// load_regvars(current_procinfo.aktentrycode,p);
{ for the i386 it must be done in genexitcode because it has }
{ to add 'fstp' instructions when using fpu regvars and those }
{ must come after the "exitlabel" (JM) }
{$ifndef i386}
cleanup_regvars(current_procinfo.aktexitcode);
// cleanup_regvars(current_procinfo.aktexitcode);
{$endif i386}
{$ifdef newra}
if current_procinfo.framepointer.number=NR_EBP then
@ -309,7 +309,12 @@ implementation
end.
{
$Log$
Revision 1.54 2003-06-03 13:01:59 daniel
Revision 1.55 2003-06-09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.54 2003/06/03 13:01:59 daniel
* Register allocator finished
Revision 1.53 2003/05/26 21:17:17 peter

20
compiler/pmodules.pas
View File

@ -753,7 +753,6 @@ implementation
procedure gen_implicit_initfinal(list:taasmoutput;flag:word;st:tsymtable);
var
pd : tprocdef;
oldexitlabel : tasmlabel;
begin
{ update module flags }
current_module.flags:=current_module.flags or flag;
@ -772,18 +771,14 @@ implementation
else
internalerror(200304253);
end;
{ save labels }
oldexitlabel:=aktexitlabel;
{ generate a dummy function }
objectlibrary.getlabel(aktexitlabel);
include(current_procinfo.flags,pi_do_call);
gen_stackalloc_code(list,0);
genentrycode(list,false);
genexitcode(list,false);
gen_entry_code(list,false);
gen_initialize_code(list,false);
gen_finalize_code(list,false);
gen_exit_code(list,false);
list.convert_registers;
release_main_proc(pd);
{ restore }
aktexitlabel:=oldexitlabel;
end;
@ -1461,7 +1456,12 @@ So, all parameters are passerd into registers in sparc architecture.}
end.
{
$Log$
Revision 1.112 2003-06-07 20:26:32 peter
Revision 1.113 2003-06-09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.112 2003/06/07 20:26:32 peter
* re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving

101
compiler/psub.pas
View File

@ -35,6 +35,9 @@ interface
tcgprocinfo=class(tprocinfo)
{ code for the subroutine as tree }
code : tnode;
{ positions in the tree for init/final }
initasmnode,
finalasmnode : tnode;
{ list to store the procinfo's of the nested procedures }
nestedprocs : tlinkedlist;
constructor create(aparent:tprocinfo);override;
@ -254,6 +257,10 @@ implementation
begin
result:=internalstatements(newstatement,true);
{ temp/para/locals initialize code will be inserted here }
tcgprocinfo(current_procinfo).initasmnode:=casmnode.create_get_position;
addstatement(newstatement,tcgprocinfo(current_procinfo).initasmnode);
if assigned(current_procdef._class) then
begin
{ a constructor needs a help procedure }
@ -347,7 +354,9 @@ implementation
function generate_finalize_block:tnode;
begin
result:=cnothingnode.create;
{ temp/para/locals finalize code will be inserted here }
tcgprocinfo(current_procinfo).finalasmnode:=casmnode.create_get_position;
result:=tcgprocinfo(current_procinfo).finalasmnode;
end;
@ -557,9 +566,9 @@ implementation
var
oldprocdef : tprocdef;
oldprocinfo : tprocinfo;
oldexitlabel : tasmlabel;
oldaktmaxfpuregisters : longint;
oldfilepos : tfileposinfo;
templist,
stackalloccode : Taasmoutput;
begin
@ -577,12 +586,10 @@ implementation
current_procinfo:=self;
current_procdef:=procdef;
{ save old labels }
oldexitlabel:=aktexitlabel;
{ get new labels }
objectlibrary.getlabel(aktexitlabel);
aktbreaklabel:=nil;
aktcontinuelabel:=nil;
templist:=Taasmoutput.create;
{ add parast/localst to symtablestack }
add_to_symtablestack;
@ -597,25 +604,34 @@ implementation
{$endif}
{ set the start offset to the start of the temp area in the stack }
tg.setfirsttemp(current_procinfo.firsttemp_offset);
tg.setfirsttemp(firsttemp_offset);
generatecode(code);
{ first generate entry code with the correct position and switches }
aktfilepos:=current_procinfo.entrypos;
aktlocalswitches:=current_procinfo.entryswitches;
genentrycode(current_procinfo.aktentrycode,false);
{ first generate entry and initialize code with the correct
position and switches }
aktfilepos:=entrypos;
aktlocalswitches:=entryswitches;
gen_initialize_code(templist,false);
aktproccode.insertlistafter(tasmnode(initasmnode).currenttai,templist);
gen_entry_code(templist,false);
aktproccode.insertlist(templist);
{ now generate exit code with the correct position and switches }
aktfilepos:=current_procinfo.exitpos;
aktlocalswitches:=current_procinfo.exitswitches;
genexitcode(current_procinfo.aktexitcode,false);
{ now generate finalize and exit code with the correct position
and switches }
aktfilepos:=exitpos;
aktlocalswitches:=exitswitches;
gen_finalize_code(templist,false);
{ the finalcode must be added if the was no position available,
using insertlistafter will result in an insert at the start
when currentai=nil }
if assigned(tasmnode(finalasmnode).currenttai) then
aktproccode.insertlistafter(tasmnode(finalasmnode).currenttai,templist)
else
aktproccode.concatlist(templist);
gen_exit_code(templist,false);
aktproccode.concatlist(templist);
{ now all the registers used are known }
{ current_procdef.usedintregisters:=rg.usedintinproc;
current_procdef.usedotherregisters:=rg.usedinproc;}
current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
{$ifdef newra}
{ rg.writegraph;}
{$endif}
@ -627,16 +643,16 @@ implementation
rg.prepare_colouring;
rg.colour_registers;
rg.epilogue_colouring;
until (rg.spillednodes='') or not rg.spill_registers(current_procinfo.aktproccode,rg.spillednodes);
current_procinfo.aktproccode.translate_registers(rg.colour);
current_procinfo.aktproccode.convert_registers;
until (rg.spillednodes='') or not rg.spill_registers(aktproccode,rg.spillednodes);
aktproccode.translate_registers(rg.colour);
aktproccode.convert_registers;
{$else newra}
current_procinfo.aktproccode.convert_registers;
aktproccode.convert_registers;
{$ifndef NoOpt}
if (cs_optimize in aktglobalswitches) and
{ do not optimize pure assembler procedures }
not(pi_is_assembler in current_procinfo.flags) then
optimize(current_procinfo.aktproccode);
optimize(aktproccode);
{$endif NoOpt}
{$endif newra}
end;
@ -644,31 +660,31 @@ implementation
stackalloccode:=Taasmoutput.create;
gen_stackalloc_code(stackalloccode,0);
stackalloccode.convert_registers;
current_procinfo.aktproccode.insertlist(stackalloccode);
aktproccode.insertlist(stackalloccode);
stackalloccode.destroy;
{ now all the registers used are known }
{ Remove all imaginary registers from the used list.}
{$ifdef newra}
current_procdef.usedintregisters:=rg.usedintinproc*ALL_INTREGISTERS-rg.savedbyproc;
procdef.usedintregisters:=rg.usedintinproc*ALL_INTREGISTERS-rg.savedbyproc;
{$else}
current_procdef.usedintregisters:=rg.usedintinproc;
procdef.usedintregisters:=rg.usedintinproc;
{$endif}
current_procdef.usedotherregisters:=rg.usedinproc;
procdef.usedotherregisters:=rg.usedinproc;
{ save local data (casetable) also in the same file }
if assigned(current_procinfo.aktlocaldata) and
(not current_procinfo.aktlocaldata.empty) then
if assigned(aktlocaldata) and
(not aktlocaldata.empty) then
begin
current_procinfo.aktproccode.concat(Tai_section.Create(sec_data));
current_procinfo.aktproccode.concatlist(current_procinfo.aktlocaldata);
current_procinfo.aktproccode.concat(Tai_section.Create(sec_code));
aktproccode.concat(Tai_section.Create(sec_data));
aktproccode.concatlist(aktlocaldata);
aktproccode.concat(Tai_section.Create(sec_code));
end;
{ add the procedure to the codesegment }
if (cs_create_smart in aktmoduleswitches) then
codesegment.concat(Tai_cut.Create);
codesegment.concatlist(current_procinfo.aktproccode);
codesegment.concat(Tai_cut.Create);
codesegment.concatlist(aktproccode);
{ all registers can be used again }
rg.resetusableregisters;
@ -678,10 +694,8 @@ implementation
{ restore symtablestack }
remove_from_symtablestack;
{ restore labels }
aktexitlabel:=oldexitlabel;
{ restore }
templist.free;
aktmaxfpuregisters:=oldaktmaxfpuregisters;
aktfilepos:=oldfilepos;
current_procdef:=oldprocdef;
@ -770,7 +784,6 @@ implementation
procedure tcgprocinfo.parse_body;
var
oldprocdef : tprocdef;
stackalloccode : Taasmoutput;
oldprocinfo : tprocinfo;
begin
oldprocdef:=current_procdef;
@ -922,9 +935,6 @@ implementation
procedure check_init_paras(p:tnamedindexitem;arg:pointer);
var
vs : tvarsym;
pd : tprocdef;
begin
if tsym(p).typ<>varsym then
exit;
@ -1259,7 +1269,12 @@ begin
end.
{
$Log$
Revision 1.124 2003-06-07 19:37:43 jonas
Revision 1.125 2003-06-09 12:23:30 peter
* init/final of procedure data splitted from genentrycode
* use asmnode getposition to insert final at the correct position
als for the implicit try...finally
Revision 1.124 2003/06/07 19:37:43 jonas
* pi_do_call must always be set for the main program, since it always
ends with a call to FPC_DO_EXIT