paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 14:49:16 +02: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 } {# register used as frame pointer }
framepointer : tregister; 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 {# Holds the reference used to store the original stackpointer
after all registers are saved after all registers are saved
} }
@ -125,16 +100,15 @@ unit cgbase;
systems systems
} }
save_regs_ref : treference; save_regs_ref : treference;
{ label to leave the sub routine }
aktexitlabel : tasmlabel;
{# The code for the routine itself, excluding entry and {# The code for the routine itself, excluding entry and
exit code. This is a linked list of tai classes. exit code. This is a linked list of tai classes.
} }
aktproccode : taasmoutput; aktproccode : taasmoutput;
{# The code for the routine entry code. { Data (like jump tables) that belongs to this routine }
}
aktentrycode: taasmoutput;
{# The code for the routine exit code.
}
aktexitcode: taasmoutput;
aktlocaldata : taasmoutput; aktlocaldata : taasmoutput;
constructor create(aparent:tprocinfo);virtual; constructor create(aparent:tprocinfo);virtual;
@ -183,9 +157,6 @@ unit cgbase;
{ label when the result is true or false } { label when the result is true or false }
truelabel,falselabel : tasmlabel; truelabel,falselabel : tasmlabel;
{ label to leave the sub routine }
aktexitlabel : tasmlabel;
{# true, if there was an error while code generation occurs } {# true, if there was an error while code generation occurs }
codegenerror : boolean; codegenerror : boolean;
@ -349,26 +320,22 @@ implementation
flags:=[]; flags:=[];
framepointer.enum:=R_INTREGISTER; framepointer.enum:=R_INTREGISTER;
framepointer.number:=NR_FRAME_POINTER_REG; framepointer.number:=NR_FRAME_POINTER_REG;
{ asmlists }
aktentrycode:=Taasmoutput.Create;
aktexitcode:=Taasmoutput.Create;
aktproccode:=Taasmoutput.Create; aktproccode:=Taasmoutput.Create;
aktlocaldata:=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); reference_reset(save_stackptr_ref);
{ labels }
objectlibrary.getlabel(aktexitlabel);
end; end;
destructor tprocinfo.destroy; destructor tprocinfo.destroy;
begin begin
aktentrycode.free;
aktexitcode.free;
aktproccode.free; aktproccode.free;
aktlocaldata.free; aktlocaldata.free;
end; end;
procedure tprocinfo.allocate_interrupt_stackframe; procedure tprocinfo.allocate_interrupt_stackframe;
begin begin
end; end;
@ -408,8 +375,6 @@ implementation
procedure tprocinfo.after_header; procedure tprocinfo.after_header;
var
srsym : tvarsym;
begin begin
end; end;
@ -531,6 +496,7 @@ implementation
end; end;
end; end;
function int_cgsize(const a: aword): tcgsize; function int_cgsize(const a: aword): tcgsize;
begin begin
if a > 8 then if a > 8 then
@ -573,7 +539,12 @@ implementation
end. end.
{ {
$Log$ $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 * function results can now also be regvars
- removed tprocinfo.return_offset, never use it again since it's invalid - removed tprocinfo.return_offset, never use it again since it's invalid
if the result is a regvar if the result is a regvar

17
compiler/ncgcal.pas
View File

@ -1040,10 +1040,10 @@ implementation
oldprocinfo : tprocinfo; oldprocinfo : tprocinfo;
oldinlining_procedure : boolean; oldinlining_procedure : boolean;
inlineentrycode,inlineexitcode : TAAsmoutput; inlineentrycode,inlineexitcode : TAAsmoutput;
oldexitlabel:tasmlabel;
oldregstate: pointer; oldregstate: pointer;
old_local_fixup, old_local_fixup,
old_para_fixup : longint; old_para_fixup : longint;
usesacc,usesacchi,usesfpu : boolean;
pararef, pararef,
localsref : treference; localsref : treference;
{$ifdef GDB} {$ifdef GDB}
@ -1056,10 +1056,8 @@ implementation
internalerror(200305262); internalerror(200305262);
oldinlining_procedure:=inlining_procedure; oldinlining_procedure:=inlining_procedure;
oldexitlabel:=aktexitlabel;
oldprocdef:=current_procdef; oldprocdef:=current_procdef;
oldprocinfo:=current_procinfo; oldprocinfo:=current_procinfo;
objectlibrary.getlabel(aktexitlabel);
{ we're inlining a procedure } { we're inlining a procedure }
inlining_procedure:=true; inlining_procedure:=true;
@ -1258,7 +1256,7 @@ implementation
inlineentrycode:=TAAsmoutput.Create; inlineentrycode:=TAAsmoutput.Create;
inlineexitcode:=TAAsmoutput.Create; inlineexitcode:=TAAsmoutput.Create;
geninlineentrycode(inlineentrycode,0); gen_initialize_code(inlineentrycode,true);
if po_assembler in current_procdef.procoptions then if po_assembler in current_procdef.procoptions then
inlineentrycode.insert(Tai_marker.Create(asmblockstart)); inlineentrycode.insert(Tai_marker.Create(asmblockstart));
exprasmList.concatlist(inlineentrycode); exprasmList.concatlist(inlineentrycode);
@ -1279,7 +1277,8 @@ implementation
testregisters32; testregisters32;
{$endif TEMPREGDEBUG} {$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 if po_assembler in current_procdef.procoptions then
inlineexitcode.concat(Tai_marker.Create(asmblockend)); inlineexitcode.concat(Tai_marker.Create(asmblockend));
exprasmList.concatlist(inlineexitcode); exprasmList.concatlist(inlineexitcode);
@ -1383,7 +1382,6 @@ implementation
{ restore } { restore }
current_procdef:=oldprocdef; current_procdef:=oldprocdef;
aktexitlabel:=oldexitlabel;
inlining_procedure:=oldinlining_procedure; inlining_procedure:=oldinlining_procedure;
{ reallocate the registers used for the current procedure's regvars, } { reallocate the registers used for the current procedure's regvars, }
@ -1409,7 +1407,12 @@ begin
end. end.
{ {
$Log$ $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 * optimized assignments with on the right side a function that returns
an ansi- or widestring an ansi- or widestring

29
compiler/ncgflw.pas
View File

@ -719,7 +719,7 @@ implementation
if assigned(left) then if assigned(left) then
secondpass(left); secondpass(left);
cg.a_jmp_always(exprasmlist,aktexitlabel); cg.a_jmp_always(exprasmlist,current_procinfo.aktexitlabel);
end; end;
@ -935,7 +935,7 @@ implementation
oldendexceptlabel:=endexceptlabel; oldendexceptlabel:=endexceptlabel;
{ save the old labels for control flow statements } { save the old labels for control flow statements }
oldaktexitlabel:=aktexitlabel; oldaktexitlabel:=current_procinfo.aktexitlabel;
if assigned(aktbreaklabel) then if assigned(aktbreaklabel) then
begin begin
oldaktcontinuelabel:=aktcontinuelabel; oldaktcontinuelabel:=aktcontinuelabel;
@ -962,7 +962,7 @@ implementation
{ try block } { try block }
{ set control flow labels for the try block } { set control flow labels for the try block }
aktexitlabel:=exittrylabel; current_procinfo.aktexitlabel:=exittrylabel;
if assigned(oldaktbreaklabel) then if assigned(oldaktbreaklabel) then
begin begin
aktcontinuelabel:=continuetrylabel; aktcontinuelabel:=continuetrylabel;
@ -983,7 +983,7 @@ implementation
{ set control flow labels for the except block } { set control flow labels for the except block }
{ and the on statements } { and the on statements }
aktexitlabel:=exitexceptlabel; current_procinfo.aktexitlabel:=exitexceptlabel;
if assigned(oldaktbreaklabel) then if assigned(oldaktbreaklabel) then
begin begin
aktcontinuelabel:=continueexceptlabel; aktcontinuelabel:=continueexceptlabel;
@ -1108,7 +1108,7 @@ implementation
endexceptlabel:=oldendexceptlabel; endexceptlabel:=oldendexceptlabel;
{ restore the control flow labels } { restore the control flow labels }
aktexitlabel:=oldaktexitlabel; current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(oldaktbreaklabel) then if assigned(oldaktbreaklabel) then
begin begin
aktcontinuelabel:=oldaktcontinuelabel; aktcontinuelabel:=oldaktcontinuelabel;
@ -1173,9 +1173,9 @@ implementation
if assigned(right) then if assigned(right) then
begin begin
oldaktexitlabel:=aktexitlabel; oldaktexitlabel:=current_procinfo.aktexitlabel;
objectlibrary.getlabel(exitonlabel); objectlibrary.getlabel(exitonlabel);
aktexitlabel:=exitonlabel; current_procinfo.aktexitlabel:=exitonlabel;
if assigned(aktbreaklabel) then if assigned(aktbreaklabel) then
begin begin
oldaktcontinuelabel:=aktcontinuelabel; oldaktcontinuelabel:=aktcontinuelabel;
@ -1231,7 +1231,7 @@ implementation
cg.a_jmp_always(exprasmlist,oldaktcontinuelabel); cg.a_jmp_always(exprasmlist,oldaktcontinuelabel);
end; end;
aktexitlabel:=oldaktexitlabel; current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(oldaktbreaklabel) then if assigned(oldaktbreaklabel) then
begin begin
aktcontinuelabel:=oldaktcontinuelabel; aktcontinuelabel:=oldaktcontinuelabel;
@ -1284,12 +1284,12 @@ implementation
{ the finally block must catch break, continue and exit } { the finally block must catch break, continue and exit }
{ statements } { statements }
oldaktexitlabel:=aktexitlabel; oldaktexitlabel:=current_procinfo.aktexitlabel;
if implicitframe then if implicitframe then
exitfinallylabel:=finallylabel exitfinallylabel:=finallylabel
else else
objectlibrary.getlabel(exitfinallylabel); objectlibrary.getlabel(exitfinallylabel);
aktexitlabel:=exitfinallylabel; current_procinfo.aktexitlabel:=exitfinallylabel;
if assigned(aktbreaklabel) then if assigned(aktbreaklabel) then
begin begin
oldaktcontinuelabel:=aktcontinuelabel; oldaktcontinuelabel:=aktcontinuelabel;
@ -1401,7 +1401,7 @@ implementation
end; end;
cg.a_label(exprasmlist,endfinallylabel); cg.a_label(exprasmlist,endfinallylabel);
aktexitlabel:=oldaktexitlabel; current_procinfo.aktexitlabel:=oldaktexitlabel;
if assigned(aktbreaklabel) then if assigned(aktbreaklabel) then
begin begin
aktcontinuelabel:=oldaktcontinuelabel; aktcontinuelabel:=oldaktcontinuelabel;
@ -1427,7 +1427,12 @@ begin
end. end.
{ {
$Log$ $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 + added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are * ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para) properly allocated/deallocated (and get an extra list para)

344
compiler/ncgutil.pas
View File

@ -63,12 +63,18 @@ interface
para_offset:longint;alignment : longint; para_offset:longint;alignment : longint;
const locpara : tparalocation); const locpara : tparalocation);
procedure genentrycode(list:TAAsmoutput;inlined:boolean); procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:longint); procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
procedure genexitcode(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 geninlineentrycode(list : TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean); procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
*)
{# {#
Allocate the buffers for exception management and setjmp environment. 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); procedure copyvalueparas(p : tnamedindexitem;arg:pointer);
@ -1147,6 +1153,7 @@ implementation
end; end;
end; end;
{ generates the code for decrementing the reference count of parameters } { generates the code for decrementing the reference count of parameters }
procedure final_paras(p : tnamedindexitem;arg:pointer); procedure final_paras(p : tnamedindexitem;arg:pointer);
var var
@ -1256,14 +1263,39 @@ implementation
end; 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 var
ressym : tvarsym; ressym : tvarsym;
resloc : tlocation; resloc : tlocation;
href : treference;
hreg,r,r2 : tregister; hreg,r,r2 : tregister;
begin begin
if not is_void(current_procdef.rettype.def) then { 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 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); ressym := tvarsym(current_procdef.funcretsym);
if ressym.reg.enum <> R_NO then if ressym.reg.enum <> R_NO then
begin begin
@ -1350,11 +1382,140 @@ implementation
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;
{ 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; end;
procedure gen_finalize_code(list : TAAsmoutput;inlined:boolean);
begin
cg.a_label(list,current_procinfo.aktexitlabel);
procedure genentrycode(list:TAAsmoutput;inlined:boolean); 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 var
href : treference; href : treference;
hp : tparaitem; hp : tparaitem;
@ -1367,7 +1528,6 @@ implementation
if assigned(current_procdef.parast) then if assigned(current_procdef.parast) then
begin begin
if not (po_assembler in current_procdef.procoptions) then if not (po_assembler in current_procdef.procoptions) then
begin begin
{ move register parameters which aren't regable into memory } { move register parameters which aren't regable into memory }
@ -1423,7 +1583,6 @@ implementation
end; end;
end; end;
{ for the save all registers we can simply use a pusha,popa which { for the save all registers we can simply use a pusha,popa which
push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax } push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
if (po_saveregisters in current_procdef.procoptions) then if (po_saveregisters in current_procdef.procoptions) then
@ -1444,90 +1603,8 @@ implementation
rsp.number:=NR_STACK_POINTER_REG; rsp.number:=NR_STACK_POINTER_REG;
cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,rsp,current_procinfo.save_stackptr_ref); cg.a_load_reg_ref(list,OS_ADDR,OS_ADDR,rsp,current_procinfo.save_stackptr_ref);
end; 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; 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); procedure gen_stackalloc_code(list:Taasmoutput;stackframe:longint);
@ -1600,7 +1677,8 @@ implementation
end; end;
end; end;
procedure genexitcode(list : TAAsmoutput;inlined:boolean);
procedure gen_exit_code(list : TAAsmoutput;inlined:boolean);
var var
{$ifdef GDB} {$ifdef GDB}
@ -1608,82 +1686,18 @@ implementation
mangled_length : longint; mangled_length : longint;
p : pchar; p : pchar;
{$endif GDB} {$endif GDB}
okexitlabel : tasmlabel;
href : treference;
srsym : tsym;
usesacc, usesacc,
usesacchi, usesacchi,
usesfpu : boolean; usesfpu : boolean;
rsp,r : Tregister; rsp : Tregister;
retsize : longint; retsize : longint;
begin 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 { handle return value, this is not done for assembler routines when
they didn't reference the result variable } they didn't reference the result variable }
usesacc:=false; usesacc:=false;
usesfpu:=false;
usesacchi:=false; usesacchi:=false;
if not(po_assembler in current_procdef.procoptions) or gen_load_return_value(list,usesacc,usesacchi,usesfpu);
(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;
{$ifdef GDB} {$ifdef GDB}
if ((cs_debuginfo in aktmoduleswitches) and not inlined) then if ((cs_debuginfo in aktmoduleswitches) and not inlined) then
@ -1812,9 +1826,6 @@ implementation
freemem(p,2*mangled_length+50); freemem(p,2*mangled_length+50);
end; end;
{$endif GDB} {$endif GDB}
if inlined then
cleanup_regvars(list);
end; end;
@ -1822,6 +1833,7 @@ implementation
Inlining Inlining
****************************************************************************} ****************************************************************************}
(*
procedure load_inlined_return_value(list:TAAsmoutput); procedure load_inlined_return_value(list:TAAsmoutput);
var var
ressym: tvarsym; ressym: tvarsym;
@ -1959,11 +1971,17 @@ implementation
cleanup_regvars(list); cleanup_regvars(list);
end; end;
*)
end. end.
{ {
$Log$ $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 + added freeintparaloc
* ppc get/freeintparaloc now check whether the parameter regs are * ppc get/freeintparaloc now check whether the parameter regs are
properly allocated/deallocated (and get an extra list para) 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) } { process register variable stuff (JM) }
assign_regvars(p); 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 } { for the i386 it must be done in genexitcode because it has }
{ to add 'fstp' instructions when using fpu regvars and those } { to add 'fstp' instructions when using fpu regvars and those }
{ must come after the "exitlabel" (JM) } { must come after the "exitlabel" (JM) }
{$ifndef i386} {$ifndef i386}
cleanup_regvars(current_procinfo.aktexitcode); // cleanup_regvars(current_procinfo.aktexitcode);
{$endif i386} {$endif i386}
{$ifdef newra} {$ifdef newra}
if current_procinfo.framepointer.number=NR_EBP then if current_procinfo.framepointer.number=NR_EBP then
@ -309,7 +309,12 @@ implementation
end. end.
{ {
$Log$ $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 * Register allocator finished
Revision 1.53 2003/05/26 21:17:17 peter 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); procedure gen_implicit_initfinal(list:taasmoutput;flag:word;st:tsymtable);
var var
pd : tprocdef; pd : tprocdef;
oldexitlabel : tasmlabel;
begin begin
{ update module flags } { update module flags }
current_module.flags:=current_module.flags or flag; current_module.flags:=current_module.flags or flag;
@ -772,18 +771,14 @@ implementation
else else
internalerror(200304253); internalerror(200304253);
end; end;
{ save labels }
oldexitlabel:=aktexitlabel;
{ generate a dummy function }
objectlibrary.getlabel(aktexitlabel);
include(current_procinfo.flags,pi_do_call); include(current_procinfo.flags,pi_do_call);
gen_stackalloc_code(list,0); gen_stackalloc_code(list,0);
genentrycode(list,false); gen_entry_code(list,false);
genexitcode(list,false); gen_initialize_code(list,false);
gen_finalize_code(list,false);
gen_exit_code(list,false);
list.convert_registers; list.convert_registers;
release_main_proc(pd); release_main_proc(pd);
{ restore }
aktexitlabel:=oldexitlabel;
end; end;
@ -1461,7 +1456,12 @@ So, all parameters are passerd into registers in sparc architecture.}
end. end.
{ {
$Log$ $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 * re-resolving added instead of reloading from ppu
* tderef object added to store deref info for resolving * tderef object added to store deref info for resolving

99
compiler/psub.pas
View File

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