mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 12:20:19 +02:00
+ first version, derived from old routines
This commit is contained in:
florian
parent
5da43943cd
commit
9c7239cfbe
322
compiler/new/cgobj.pas
Normal file
322
compiler/new/cgobj.pas
Normal file
@ -0,0 +1,322 @@
|
|||||||
|
unit cgobj;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
pcg = ^tcg;
|
||||||
|
|
||||||
|
tcg = object
|
||||||
|
procedure a_call_name_ext(list : paasmoutput;const s : string;
|
||||||
|
offset : longint;m : texternaltyp);
|
||||||
|
|
||||||
|
procedure g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
|
||||||
|
stackframe:longint;
|
||||||
|
var parasize:longint;var nostackframe:boolean;
|
||||||
|
inlined : boolean);
|
||||||
|
|
||||||
|
{ these methods must be overriden: }
|
||||||
|
procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
|
||||||
|
procedure a_call_name(list : paasmoutput;const s : string;
|
||||||
|
offset : longint);virtual;
|
||||||
|
|
||||||
|
procedure a_load_const8_ref(list : paasmoutput;b : byte;ref : treference);virtual;
|
||||||
|
procedure a_load_const16_ref(list : paasmoutput;w : word;ref : treference);virtual;
|
||||||
|
procedure a_load_const32_ref(list : paasmoutput;l : longint;ref : treference);virtual;
|
||||||
|
procedure a_load_const64_ref(list : paasmoutput;{ q : qword; }ref : treference);virtual;
|
||||||
|
|
||||||
|
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
|
||||||
|
|
||||||
|
{ these methods can be overriden for extra functionality }
|
||||||
|
|
||||||
|
{ the following do nothing: }
|
||||||
|
procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
|
||||||
|
procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
|
||||||
|
|
||||||
|
procedure g_profilecode(list : paasmoutput);virtual;
|
||||||
|
procedure g_stackcheck(list : paasmoutput);virtual;
|
||||||
|
|
||||||
|
{ passing parameters, per default the parameter is pushed }
|
||||||
|
{ nr gives the number of the parameter (enumerated from }
|
||||||
|
{ left to right), this allows to move the parameter to }
|
||||||
|
{ register, if the cpu supports register calling }
|
||||||
|
{ conventions }
|
||||||
|
procedure a_param_reg(list : paasmoutput;r : tregister;nr : longint);virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure tcg.g_interrupt_stackframe_entry(list : paasmoutput);
|
||||||
|
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tcg.g_interrupt_stackframe_exit(list : paasmoutput);
|
||||||
|
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tcg.a_param_reg(list : paasmoutput;r : tregister;nr : longint);
|
||||||
|
|
||||||
|
begin
|
||||||
|
a_push_reg(list,r);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tcg.g_stackcheck(list : paasmoutput);
|
||||||
|
|
||||||
|
begin
|
||||||
|
a_param_reg(list,stackframe,1);
|
||||||
|
a_call_name(list,'FPC_STACKCHECK',0,EXT_NEAR);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tcg.a_call_name_ext(list : paasmoutput;const s : string;
|
||||||
|
offset : longint;m : texternaltyp);
|
||||||
|
|
||||||
|
begin
|
||||||
|
a_call_name(list,s,offset);
|
||||||
|
concat_external(s,m);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ generates the entry code for a procedure }
|
||||||
|
procedure tcg.g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
|
||||||
|
stackframe:longint;var parasize:longint;var nostackframe:boolean;
|
||||||
|
inlined : boolean);
|
||||||
|
|
||||||
|
var
|
||||||
|
hs : string;
|
||||||
|
hp : Pused_unit;
|
||||||
|
unitinits,initcode : taasmoutput;
|
||||||
|
{$ifdef GDB}
|
||||||
|
stab_function_name : Pai_stab_function_name;
|
||||||
|
{$endif GDB}
|
||||||
|
hr : preference;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ Align }
|
||||||
|
if (not inlined) then
|
||||||
|
begin
|
||||||
|
{ gprof uses 16 byte granularity !! }
|
||||||
|
if (cs_profile in aktmoduleswitches) then
|
||||||
|
list^.insert(new(pai_align,init_op(16,$90)))
|
||||||
|
else
|
||||||
|
if not(cs_littlesize in aktglobalswitches) then
|
||||||
|
list^.insert(new(pai_align,init(4)));
|
||||||
|
end;
|
||||||
|
curlist:=list;
|
||||||
|
if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
|
||||||
|
begin
|
||||||
|
|
||||||
|
{ needs the target a console flags ? }
|
||||||
|
if tf_needs_isconsole in target_info.flags then
|
||||||
|
begin
|
||||||
|
new(hr);
|
||||||
|
reset_reference(hr^);
|
||||||
|
hr^.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE');
|
||||||
|
if apptype=at_cui then
|
||||||
|
a_load_const8_ref(list,1,hr);
|
||||||
|
else
|
||||||
|
a_load_const8_ref(list,0,hr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Call the unit init procedures }
|
||||||
|
unitinits.init;
|
||||||
|
|
||||||
|
hp:=pused_unit(usedunits.first);
|
||||||
|
while assigned(hp) do
|
||||||
|
begin
|
||||||
|
{ call the unit init code and make it external }
|
||||||
|
if (hp^.u^.flags and uf_init)<>0 then
|
||||||
|
a_call_name_ext(@unitinits,
|
||||||
|
'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR);
|
||||||
|
hp:=Pused_unit(hp^.next);
|
||||||
|
end;
|
||||||
|
list^.insertlist(@unitinits);
|
||||||
|
unitinits.done;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ a constructor needs a help procedure }
|
||||||
|
if (aktprocsym^.definition^.options and poconstructor)<>0 then
|
||||||
|
begin
|
||||||
|
if procinfo._class^.isclass then
|
||||||
|
begin
|
||||||
|
list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
|
||||||
|
list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
|
||||||
|
newcsymbol('FPC_NEW_CLASS',0))));
|
||||||
|
concat_external('FPC_NEW_CLASS',EXT_NEAR);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
|
||||||
|
list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
|
||||||
|
newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
|
||||||
|
list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
|
||||||
|
concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef GDB}
|
||||||
|
if (cs_debuginfo in aktmoduleswitches) then
|
||||||
|
list^.insert(new(pai_force_line,init));
|
||||||
|
{$endif GDB}
|
||||||
|
|
||||||
|
{ save registers on cdecl }
|
||||||
|
if ((aktprocsym^.definition^.options and pocdecl)<>0) then
|
||||||
|
begin
|
||||||
|
for r:=firstregister to lastregister do
|
||||||
|
begin
|
||||||
|
if (r in registers_saved_on_cdecl) then
|
||||||
|
if (r in general_registers) then
|
||||||
|
begin
|
||||||
|
if (r in usedregisters) then
|
||||||
|
a_push_reg(list,r)
|
||||||
|
end
|
||||||
|
else
|
||||||
|
a_push_reg(list,r);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ omit stack frame ? }
|
||||||
|
if not inlined then
|
||||||
|
if procinfo.framepointer=stack_pointer then
|
||||||
|
begin
|
||||||
|
CGMessage(cg_d_stackframe_omited);
|
||||||
|
nostackframe:=true;
|
||||||
|
if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
|
||||||
|
parasize:=0
|
||||||
|
else
|
||||||
|
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-4;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
|
||||||
|
parasize:=0
|
||||||
|
else
|
||||||
|
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
|
||||||
|
nostackframe:=false;
|
||||||
|
|
||||||
|
if (aktprocsym^.definition^.options and pointerrupt)<>0 then
|
||||||
|
generate_interrupt_stackframe_entry;
|
||||||
|
|
||||||
|
g_stackframe_entry(list,stackframe);
|
||||||
|
|
||||||
|
if (cs_check_stack in aktlocalswitches) and
|
||||||
|
(target_info.flags in tf_supports_stack_check) then
|
||||||
|
g_stackcheck(@initcode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if cs_profile in aktmoduleswitches then
|
||||||
|
g_profilecode(@initcode);
|
||||||
|
|
||||||
|
{ initialize return value }
|
||||||
|
if is_ansistring(procinfo.retdef) or
|
||||||
|
is_widestring(procinfo.retdef) then
|
||||||
|
begin
|
||||||
|
new(hr);
|
||||||
|
reset_reference(hr^);
|
||||||
|
hr^.offset:=procinfo.retoffset;
|
||||||
|
hr^.base:=procinfo.framepointer;
|
||||||
|
curlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,hr)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ generate copies of call by value parameters }
|
||||||
|
if (aktprocsym^.definition^.options and poassembler=0) then
|
||||||
|
begin
|
||||||
|
{$ifndef VALUEPARA}
|
||||||
|
aktprocsym^.definition^.parast^.foreach(copyopenarrays);
|
||||||
|
{$else}
|
||||||
|
aktprocsym^.definition^.parast^.foreach(copyvalueparas);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ initialisizes local data }
|
||||||
|
aktprocsym^.definition^.localst^.foreach(initialize_data);
|
||||||
|
{ add a reference to all call by value/const parameters }
|
||||||
|
aktprocsym^.definition^.parast^.foreach(incr_data);
|
||||||
|
|
||||||
|
if (cs_profile in aktmoduleswitches) or
|
||||||
|
(aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
|
||||||
|
(assigned(procinfo._class) and (procinfo._class^.owner^.symtabletype=globalsymtable)) then
|
||||||
|
make_global:=true;
|
||||||
|
if not inlined then
|
||||||
|
begin
|
||||||
|
hs:=proc_names.get;
|
||||||
|
|
||||||
|
{$ifdef GDB}
|
||||||
|
if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
|
||||||
|
stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
|
||||||
|
{$endif GDB}
|
||||||
|
|
||||||
|
{ insert the names for the procedure }
|
||||||
|
while hs<>'' do
|
||||||
|
begin
|
||||||
|
if make_global then
|
||||||
|
list^.insert(new(pai_symbol,init_global(hs)))
|
||||||
|
else
|
||||||
|
list^.insert(new(pai_symbol,init(hs)));
|
||||||
|
|
||||||
|
{$ifdef GDB}
|
||||||
|
if (cs_debuginfo in aktmoduleswitches) then
|
||||||
|
begin
|
||||||
|
if target_os.use_function_relative_addresses then
|
||||||
|
list^.insert(new(pai_stab_function_name,init(strpnew(hs))));
|
||||||
|
end;
|
||||||
|
{$endif GDB}
|
||||||
|
|
||||||
|
hs:=proc_names.get;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef GDB}
|
||||||
|
if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
|
||||||
|
begin
|
||||||
|
if target_os.use_function_relative_addresses then
|
||||||
|
list^.insert(stab_function_name);
|
||||||
|
if make_global or ((procinfo.flags and pi_is_global) <> 0) then
|
||||||
|
aktprocsym^.is_global := True;
|
||||||
|
list^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
|
||||||
|
aktprocsym^.isstabwritten:=true;
|
||||||
|
end;
|
||||||
|
{$endif GDB}
|
||||||
|
|
||||||
|
curlist:=nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if stackframe<>0 then
|
||||||
|
begin
|
||||||
|
if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then
|
||||||
|
begin
|
||||||
|
list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,stackframe,0)))
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
g_stackframe_entry(list,stackframe);
|
||||||
|
list^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
|
||||||
|
list^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
|
||||||
|
list^.insert(new(pai386,op_const_reg(A_SUB,S_L,stackframe,R_ESP)));
|
||||||
|
if (cs_check_stack in aktlocalswitches) and
|
||||||
|
(target_info.flags in tf_supports_stack_check) then
|
||||||
|
emit_stackcheck(@initcode);
|
||||||
|
|
||||||
|
end;
|
||||||
|
if (cs_check_stack in aktlocalswitches) and
|
||||||
|
(target_info.flags in tf_supports_stack_check) then
|
||||||
|
g_stackcheck(@initcode);
|
||||||
|
end { endif stackframe <> 0 }
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
list^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
|
||||||
|
list^.insert(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
unitinits.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol())));
|
||||||
|
concat_external('INIT$$'+hp^.u^.modulename^,EXT_NEAR);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1998-12-15 16:32:58 florian
|
||||||
|
+ first version, derived from old routines
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
1763
compiler/new/i386.pas
Normal file
1763
compiler/new/i386.pas
Normal file
File diff suppressed because it is too large
Load Diff
1233
compiler/new/systems.pas
Normal file
1233
compiler/new/systems.pas
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user