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 }