mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 22:11:12 +01:00 
			
		
		
		
	 25999ad8ff
			
		
	
	
		25999ad8ff
		
	
	
	
	
		
			
			Will be the default starting with LLVM 15, and required with LLVM 16. Tested with LLVM 14 and '-mllvm -opaque-pointers'. See https://releases.llvm.org/14.0.0/docs/OpaquePointers.html for more information.
		
			
				
	
	
		
			818 lines
		
	
	
		
			29 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			818 lines
		
	
	
		
			29 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     Copyright (c) 2008,2015 by Peter Vreman, Florian Klaempfl and Jonas Maebe
 | |
| 
 | |
|     This units contains support for generating LLVM type info
 | |
| 
 | |
|     This program is free software; you can redistribute it and/or modify
 | |
|     it under the terms of the GNU General Public License as published by
 | |
|     the Free Software Foundation; either version 2 of the License, or
 | |
|     (at your option) any later version.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | |
|     GNU General Public License for more details.
 | |
| 
 | |
|     You should have received a copy of the GNU General Public License
 | |
|     along with this program; if not, write to the Free Software
 | |
|     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| {
 | |
|   This units contains support for LLVM type info generation.
 | |
| 
 | |
|   It's based on the debug info system, since it's quite similar
 | |
| }
 | |
| unit llvmtype;
 | |
| 
 | |
| {$i fpcdefs.inc}
 | |
| {$h+}
 | |
| 
 | |
| interface
 | |
| 
 | |
|     uses
 | |
|       cclasses,globtype,
 | |
|       aasmbase,aasmtai,aasmdata,
 | |
|       symbase,symtype,symdef,symsym,
 | |
|       aasmllvm,aasmcnst,
 | |
|       finput,
 | |
|       dbgbase;
 | |
| 
 | |
| 
 | |
|     { TLLVMTypeInfo }
 | |
|     type
 | |
|       TLLVMTypeInfo = class(TDebugInfo)
 | |
|       protected
 | |
|         { using alias/external declarations it's possible to refer to the same
 | |
|           assembler symbol using multiple types:
 | |
|             function f(p: pointer): pointer; [public, alias: 'FPC_FUNC'];
 | |
|             procedure test(p: pointer); external name 'FPC_FUNC';
 | |
| 
 | |
|           We have to insert the appropriate typecasts (per module) for LLVM in
 | |
|           this case. That can only be done after all code for a module has been
 | |
|           generated, as these alias declarations can appear anywhere }
 | |
|         asmsymtypes: THashSet;
 | |
| 
 | |
|         function check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
 | |
|         procedure record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
 | |
|         function  get_asmsym_def(sym: TAsmSymbol): tdef;
 | |
| 
 | |
|         function record_def(def:tdef): tdef;
 | |
| 
 | |
|         procedure appenddef_array(list:TAsmList;def:tarraydef);override;
 | |
|         procedure appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
 | |
|         procedure appenddef_record(list:TAsmList;def:trecorddef);override;
 | |
|         procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
 | |
|         procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
 | |
|         procedure appendprocdef(list:TAsmList;def:tprocdef);override;
 | |
|         procedure appenddef_object(list:TAsmList;def: tobjectdef);override;
 | |
|         procedure appenddef_classref(list: TAsmList; def: tclassrefdef);override;
 | |
|         procedure appenddef_variant(list:TAsmList;def: tvariantdef);override;
 | |
|         procedure appenddef_file(list:TasmList;def:tfiledef);override;
 | |
| 
 | |
|         procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
 | |
|         procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
 | |
|         procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
 | |
|         procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
 | |
|         procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
 | |
|         procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
 | |
|         procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
 | |
| 
 | |
|         procedure afterappenddef(list: TAsmList; def: tdef); override;
 | |
| 
 | |
|         procedure enum_membersyms_callback(p:TObject;arg:pointer);
 | |
| 
 | |
|         procedure collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
 | |
|         procedure collect_tai_info(deftypelist: tasmlist; p: tai);
 | |
|         procedure collect_asmlist_info(deftypelist, asmlist: tasmlist);
 | |
| 
 | |
|         procedure insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
 | |
|         procedure insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
 | |
|         procedure insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
 | |
|         procedure insert_asmlist_typeconversions(toplevellist, list: tasmlist);
 | |
|         procedure maybe_insert_extern_sym_decl(toplevellist: tasmlist; asmsym: tasmsymbol; def: tdef);
 | |
|         procedure update_asmlist_alias_types(list: tasmlist);
 | |
| 
 | |
|       public
 | |
|         constructor Create;override;
 | |
|         destructor Destroy;override;
 | |
|         procedure inserttypeinfo;override;
 | |
|       end;
 | |
| 
 | |
| implementation
 | |
| 
 | |
|     uses
 | |
|       cutils,cfileutl,constexp,
 | |
|       version,globals,verbose,systems,
 | |
|       cpubase,cgbase,paramgr,
 | |
|       fmodule,nobj,
 | |
|       defutil,defcmp,symconst,symtable,
 | |
|       llvminfo,llvmbase,llvmdef
 | |
|       ;
 | |
| 
 | |
| {****************************************************************************
 | |
|                               TLLVMTypeInfo
 | |
| ****************************************************************************}
 | |
| 
 | |
|     procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
 | |
|       var
 | |
|         res: PHashSetItem;
 | |
|       begin
 | |
|         record_def(def);
 | |
|         res:=asmsymtypes.FindOrAdd(@sym,sizeof(sym));
 | |
|         { due to internal aliases with different signatures, we may end up with
 | |
|           multiple defs for the same symbol -> use the one from the declaration,
 | |
|           and insert typecasts as necessary elsewhere }
 | |
|         if redefine or
 | |
|            not assigned(res^.Data) then
 | |
|           res^.Data:=def;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function equal_llvm_defs(def1, def2: tdef): boolean;
 | |
|       var
 | |
|         def1str, def2str: TSymStr;
 | |
|       begin
 | |
|         if def1=def2 then
 | |
|           exit(true);
 | |
|         { this function is only used to the pointees of pointer types, to know
 | |
|           whether the pointer types are equal. With opaque pointers, all
 | |
|           pointers are represented by "ptr" and hence by definition equal,
 | |
|           regardless of what they point to (there is one exception related to
 | |
|           arrays, but that is already handled during code generation in
 | |
|           thlcgllvm.g_ptrtypecast_ref) }
 | |
|         if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
 | |
|           exit(true);
 | |
|         def1str:=llvmencodetypename(def1);
 | |
|         def2str:=llvmencodetypename(def2);
 | |
|         { normalise both type representations in case one is a procdef
 | |
|           and the other is a procvardef}
 | |
|         if def1.typ=procdef then
 | |
|           def1str:=def1str+'*';
 | |
|         if def2.typ=procdef then
 | |
|           def2str:=def2str+'*';
 | |
|         result:=def1str=def2str;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TLLVMTypeInfo.check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
 | |
|       var
 | |
|         opcmpdef: tdef;
 | |
|         symdef: tdef;
 | |
|       begin
 | |
|         result:=nil;
 | |
|         case opdef.typ of
 | |
|           pointerdef:
 | |
|             opcmpdef:=tpointerdef(opdef).pointeddef;
 | |
|           procvardef,
 | |
|           procdef:
 | |
|             opcmpdef:=opdef;
 | |
|           else
 | |
|             internalerror(2015073101);
 | |
|         end;
 | |
|         maybe_insert_extern_sym_decl(toplevellist, sym, opcmpdef);
 | |
|         symdef:=get_asmsym_def(sym);
 | |
|         if not equal_llvm_defs(symdef, opcmpdef) then
 | |
|           begin
 | |
|             if symdef.typ=procdef then
 | |
|               symdef:=cpointerdef.getreusable(symdef);
 | |
|             result:=taillvm.op_reg_size_sym_size(la_bitcast, NR_NO, cpointerdef.getreusable(symdef), sym, opdef);
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TLLVMTypeInfo.get_asmsym_def(sym: TAsmSymbol): tdef;
 | |
|       var
 | |
|         res: PHashSetItem;
 | |
|       begin
 | |
|         res:=asmsymtypes.Find(@sym,sizeof(sym));
 | |
|         { we must have a def for every used asmsym }
 | |
|         if not assigned(res) or
 | |
|            not assigned(res^.data) then
 | |
|           internalerror(2015042701);
 | |
|         result:=tdef(res^.Data);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TLLVMTypeInfo.record_def(def:tdef): tdef;
 | |
|       var
 | |
|         i: longint;
 | |
|       begin
 | |
|         result:=def;
 | |
|         if def.stab_number<>0 then
 | |
|           exit;
 | |
|         { the external symbol may never be called, in which case the types
 | |
|           of its parameters will never be process -> do it here }
 | |
|         if (def.typ=procdef) then
 | |
|           begin
 | |
|             { can't use this condition to determine whether or not we need
 | |
|               to generate the argument defs, because this information does
 | |
|               not get reset when multiple units are compiled during a
 | |
|               single compiler invocation }
 | |
|             tprocdef(def).init_paraloc_info(callerside);
 | |
|             for i:=0 to tprocdef(def).paras.count-1 do
 | |
|               record_def(llvmgetcgparadef(tparavarsym(tprocdef(def).paras[i]).paraloc[callerside],true,calleeside));
 | |
|             record_def(llvmgetcgparadef(tprocdef(def).funcretloc[callerside],true,calleeside));
 | |
|           end;
 | |
|         def.stab_number:=1;
 | |
|         { this is an internal llvm type }
 | |
|         if def=llvm_metadatatype then
 | |
|           exit;
 | |
|         if def.dbg_state=dbg_state_unused then
 | |
|           begin
 | |
|             def.dbg_state:=dbg_state_used;
 | |
|             deftowritelist.Add(def);
 | |
|           end;
 | |
|         defnumberlist.Add(def);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     constructor TLLVMTypeInfo.Create;
 | |
|       begin
 | |
|         inherited Create;
 | |
|         asmsymtypes:=THashSet.Create(current_asmdata.AsmSymbolDict.Count,true,false);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     destructor TLLVMTypeInfo.Destroy;
 | |
|       begin
 | |
|         asmsymtypes.free;
 | |
|         inherited destroy;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.enum_membersyms_callback(p:TObject; arg: pointer);
 | |
|       begin
 | |
|         case tsym(p).typ of
 | |
|           fieldvarsym:
 | |
|             appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
 | |
|           else
 | |
|             ;
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
 | |
|       var
 | |
|         opidx, paraidx: longint;
 | |
|         callpara: pllvmcallpara;
 | |
|       begin
 | |
|         for opidx:=0 to p.ops-1 do
 | |
|           case p.oper[opidx]^.typ of
 | |
|             top_def:
 | |
|               record_def(p.oper[opidx]^.def);
 | |
|             top_tai:
 | |
|               collect_tai_info(deftypelist,p.oper[opidx]^.ai);
 | |
|             top_ref:
 | |
|               begin
 | |
|                 if (p.llvmopcode<>la_br) and
 | |
|                    assigned(p.oper[opidx]^.ref^.symbol) and
 | |
|                    (p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
 | |
|                   begin
 | |
|                     if (opidx=4) and
 | |
|                        (p.llvmopcode in [la_call,la_invoke]) then
 | |
|                       record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef,false)
 | |
|                     { not a named register }
 | |
|                     else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
 | |
|                       record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
 | |
|                   end;
 | |
|               end;
 | |
|             top_para:
 | |
|               for paraidx:=0 to p.oper[opidx]^.paras.count-1 do
 | |
|                 begin
 | |
|                   callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
 | |
|                   record_def(callpara^.def);
 | |
|                   if callpara^.val.typ=top_tai then
 | |
|                     collect_tai_info(deftypelist,callpara^.val.ai);
 | |
|                 end;
 | |
|             else
 | |
|               ;
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.collect_tai_info(deftypelist: tasmlist; p: tai);
 | |
|       var
 | |
|         value: tai_abstracttypedconst;
 | |
|       begin
 | |
|         if not assigned(p) then
 | |
|           exit;
 | |
|         case p.typ of
 | |
|           ait_llvmalias:
 | |
|             begin
 | |
|               record_asmsym_def(taillvmalias(p).newsym,taillvmalias(p).def,true);
 | |
|             end;
 | |
|           ait_llvmdecl:
 | |
|             begin
 | |
|               record_asmsym_def(taillvmdecl(p).namesym,taillvmdecl(p).def,true);
 | |
|               collect_asmlist_info(deftypelist,taillvmdecl(p).initdata);
 | |
|             end;
 | |
|           ait_llvmins:
 | |
|             collect_llvmins_info(deftypelist,taillvm(p));
 | |
|           ait_typedconst:
 | |
|             begin
 | |
|               record_def(tai_abstracttypedconst(p).def);
 | |
|               case tai_abstracttypedconst(p).adetyp of
 | |
|                 tck_simple:
 | |
|                   collect_tai_info(deftypelist,tai_simpletypedconst(p).val);
 | |
|                 tck_array,tck_record:
 | |
|                   for value in tai_aggregatetypedconst(p) do
 | |
|                     collect_tai_info(deftypelist,value);
 | |
|               end;
 | |
|             end;
 | |
|           else
 | |
|             ;
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.collect_asmlist_info(deftypelist, asmlist: tasmlist);
 | |
|       var
 | |
|         hp: tai;
 | |
|       begin
 | |
|         if not assigned(asmlist) then
 | |
|           exit;
 | |
|         hp:=tai(asmlist.first);
 | |
|         while assigned(hp) do
 | |
|           begin
 | |
|             collect_tai_info(deftypelist,hp);
 | |
|             hp:=tai(hp.next);
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
 | |
|       var
 | |
|         symdef,
 | |
|         opdef: tdef;
 | |
|         callpara: pllvmcallpara;
 | |
|         cnv: taillvm;
 | |
|         i, paraidx: longint;
 | |
|       begin
 | |
|         case p.llvmopcode of
 | |
|           la_call,
 | |
|           la_invoke:
 | |
|             begin
 | |
|               if p.oper[4]^.typ=top_ref then
 | |
|                 begin
 | |
|                   maybe_insert_extern_sym_decl(toplevellist,p.oper[4]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef);
 | |
|                   symdef:=get_asmsym_def(p.oper[4]^.ref^.symbol);
 | |
|                   { the type used in the call is different from the type used to
 | |
|                     declare the symbol -> insert a typecast }
 | |
|                   if not equal_llvm_defs(symdef,p.oper[3]^.def) then
 | |
|                     begin
 | |
|                       if symdef.typ=procdef then
 | |
|                         { ugly, but can't use getcopyas(procvardef) due to the
 | |
|                           symtablestack not being available here (cpointerdef.getreusable
 | |
|                           is hardcoded to put things in the current module's
 | |
|                           symtable) and "pointer to procedure" results in the
 | |
|                           correct llvm type }
 | |
|                         symdef:=cpointerdef.getreusable(tprocdef(symdef));
 | |
|                       cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[4]^.ref^.symbol,p.oper[3]^.def);
 | |
|                       p.loadtai(4,cnv);
 | |
|                     end;
 | |
|                 end;
 | |
|               for i:=0 to p.ops-1 do
 | |
|                 begin
 | |
|                   if p.oper[i]^.typ=top_para then
 | |
|                     begin
 | |
|                       for paraidx:=0 to p.oper[i]^.paras.count-1 do
 | |
|                         begin
 | |
|                           callpara:=pllvmcallpara(p.oper[i]^.paras[paraidx]);
 | |
|                           case callpara^.val.typ of
 | |
|                             top_tai:
 | |
|                               insert_tai_typeconversions(toplevellist,callpara^.val.ai);
 | |
|                             top_ref:
 | |
|                               begin
 | |
|                                 cnv:=check_insert_bitcast(toplevellist,callpara^.val.sym,callpara^.def);
 | |
|                                 if assigned(cnv) then
 | |
|                                   begin
 | |
|                                     callpara^.loadtai(cnv);
 | |
|                                   end;
 | |
|                               end;
 | |
|                             else
 | |
|                               ;
 | |
|                           end;
 | |
|                         end;
 | |
|                     end;
 | |
|                 end;
 | |
|             end
 | |
|           else if p.llvmopcode<>la_br then
 | |
|             begin
 | |
|               { check the types of all symbolic operands }
 | |
|               for i:=0 to p.ops-1 do
 | |
|                 case p.oper[i]^.typ of
 | |
|                   top_ref:
 | |
|                     if (p.oper[i]^.ref^.refaddr<>addr_full) and
 | |
|                        assigned(p.oper[i]^.ref^.symbol) and
 | |
|                        (p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
 | |
|                       begin
 | |
|                         opdef:=p.spilling_get_reg_type(i);
 | |
|                         cnv:=check_insert_bitcast(toplevellist,p.oper[i]^.ref^.symbol, opdef);
 | |
|                         if assigned(cnv) then
 | |
|                           p.loadtai(i, cnv);
 | |
|                       end;
 | |
|                   top_tai:
 | |
|                     insert_tai_typeconversions(toplevellist,p.oper[i]^.ai);
 | |
|                   else
 | |
|                     ;
 | |
|                 end;
 | |
|             end;
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
 | |
|       var
 | |
|         symdef: tdef;
 | |
|         cnv: taillvm;
 | |
|         elementp: tai_abstracttypedconst;
 | |
|       begin
 | |
|         case p.adetyp of
 | |
|           tck_simple:
 | |
|             begin
 | |
|               case tai_simpletypedconst(p).val.typ of
 | |
|                 ait_const:
 | |
|                   if assigned(tai_const(tai_simpletypedconst(p).val).sym) and
 | |
|                      not assigned(tai_const(tai_simpletypedconst(p).val).endsym) then
 | |
|                     begin
 | |
|                       maybe_insert_extern_sym_decl(toplevellist,tai_const(tai_simpletypedconst(p).val).sym,p.def);
 | |
|                       symdef:=get_asmsym_def(tai_const(tai_simpletypedconst(p).val).sym);
 | |
|                       { all references to symbols in typed constants are
 | |
|                         references to the address of a global symbol (you can't
 | |
|                         refer to the data itself, just like you can't initialise
 | |
|                         a Pascal (typed) constant with the contents of another
 | |
|                         typed constant) }
 | |
|                       symdef:=cpointerdef.getreusable(symdef);
 | |
|                       if not equal_llvm_defs(symdef,p.def) then
 | |
|                         begin
 | |
|                           cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(symdef,tai_simpletypedconst(p).val),p.def);
 | |
|                           tai_simpletypedconst(p).val:=cnv;
 | |
|                         end;
 | |
|                     end;
 | |
|                 else
 | |
|                   insert_tai_typeconversions(toplevellist,tai_simpletypedconst(p).val);
 | |
|               end;
 | |
|             end;
 | |
|           tck_array,
 | |
|           tck_record:
 | |
|             begin
 | |
|               for elementp in tai_aggregatetypedconst(p) do
 | |
|                 insert_typedconst_typeconversion(toplevellist,elementp);
 | |
|             end;
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
 | |
|       begin
 | |
|         if not assigned(p) then
 | |
|           exit;
 | |
|         case p.typ of
 | |
|           ait_llvmins:
 | |
|             insert_llvmins_typeconversions(toplevellist,taillvm(p));
 | |
|           { can also be necessary in case someone initialises a typed const with
 | |
|             the address of an external symbol aliasing one declared with a
 | |
|             different type in the same mmodule. }
 | |
|           ait_typedconst:
 | |
|             insert_typedconst_typeconversion(toplevellist,tai_abstracttypedconst(p));
 | |
|           ait_llvmdecl:
 | |
|             begin
 | |
|               if (ldf_definition in taillvmdecl(p).flags) and
 | |
|                  (taillvmdecl(p).def.typ=procdef) and
 | |
|                  assigned(tprocdef(taillvmdecl(p).def).personality) then
 | |
|                 maybe_insert_extern_sym_decl(toplevellist,
 | |
|                   current_asmdata.RefAsmSymbol(tprocdef(taillvmdecl(p).def).personality.mangledname,AT_FUNCTION,false),
 | |
|                   tprocdef(taillvmdecl(p).def).personality);
 | |
|               insert_asmlist_typeconversions(toplevellist,taillvmdecl(p).initdata);
 | |
|             end;
 | |
|           else
 | |
|             ;
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.insert_asmlist_typeconversions(toplevellist, list: tasmlist);
 | |
|       var
 | |
|         hp: tai;
 | |
|       begin
 | |
|         if not assigned(list) then
 | |
|           exit;
 | |
|         hp:=tai(list.first);
 | |
|         while assigned(hp) do
 | |
|           begin
 | |
|             insert_tai_typeconversions(toplevellist,hp);
 | |
|             hp:=tai(hp.next);
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.maybe_insert_extern_sym_decl(toplevellist: tasmlist; asmsym: tasmsymbol; def: tdef);
 | |
|       var
 | |
|         sec: tasmsectiontype;
 | |
|         i: longint;
 | |
|       begin
 | |
|         { Necessery for "external" declarations for symbols not declared in the
 | |
|           current unit. We can't create these declarations when the alias is
 | |
|           initially generated, because the symbol may still be defined later at
 | |
|           that point.
 | |
| 
 | |
|           We also do it for all other external symbol references (e.g.
 | |
|           references to symbols declared in other units), because then this
 | |
|           handling is centralised in one place. }
 | |
|         if not(asmsym.declared) then
 | |
|           begin
 | |
|             if def.typ=procdef then
 | |
|               sec:=sec_code
 | |
|             else
 | |
|               sec:=sec_data;
 | |
|             toplevellist.Concat(taillvmdecl.createdecl(asmsym,nil,def,nil,sec,def.alignment));
 | |
|             record_asmsym_def(asmsym,def,true);
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.update_asmlist_alias_types(list: tasmlist);
 | |
|       var
 | |
|         hp: tai;
 | |
|         def: tdef;
 | |
|       begin
 | |
|         if not assigned(list) then
 | |
|           exit;
 | |
|         hp:=tai(list.first);
 | |
|         while assigned(hp) do
 | |
|           begin
 | |
|             case hp.typ of
 | |
|               ait_llvmalias:
 | |
|                 begin
 | |
|                   { replace the def of the alias declaration with the def of
 | |
|                     the aliased symbol -> we'll insert the appropriate type
 | |
|                     conversions for all uses of this symbol in the code (since
 | |
|                     every use also specifies the used type) }
 | |
|                   record_asmsym_def(taillvmalias(hp).oldsym,taillvmalias(hp).def,false);
 | |
|                   def:=get_asmsym_def(taillvmalias(hp).oldsym);
 | |
|                   if taillvmalias(hp).def<>def then
 | |
|                     begin
 | |
|                       taillvmalias(hp).def:=def;
 | |
|                       record_asmsym_def(taillvmalias(hp).newsym,def,true);
 | |
|                     end;
 | |
|                 end;
 | |
|               ait_llvmdecl:
 | |
|                 update_asmlist_alias_types(taillvmdecl(hp).initdata);
 | |
|               else
 | |
|                 ;
 | |
|             end;
 | |
|             hp:=tai(hp.next);
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_array(list:TAsmList;def:tarraydef);
 | |
|       begin
 | |
|         appenddef(list,def.elementdef);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
 | |
|       var
 | |
|         symdeflist: tfpobjectlist;
 | |
|         i: longint;
 | |
|       begin
 | |
|         symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
 | |
|         for i:=0 to symdeflist.Count-1 do
 | |
|           record_def(tllvmshadowsymtableentry(symdeflist[i]).def);
 | |
|         list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_record(list:TAsmList;def:trecorddef);
 | |
|       begin
 | |
|         appenddef_abstractrecord(list,def);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_pointer(list:TAsmList;def:tpointerdef);
 | |
|       begin
 | |
|         appenddef(list,def.pointeddef);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_procvar(list:TAsmList;def:tprocvardef);
 | |
|       var
 | |
|         i: longint;
 | |
|       begin
 | |
|         { todo: handle mantis #25551; there is no way to create a symbolic
 | |
|           la_type for a procvardef (unless it's a procedure of object/record),
 | |
|           which means that recursive references should become plain "procedure"
 | |
|           types that are then casted to the real type when they are used }
 | |
|         def.init_paraloc_info(callerside);
 | |
|         for i:=0 to def.paras.count-1 do
 | |
|           appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true,calleeside));
 | |
|         appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true,calleeside));
 | |
|         if not def.is_addressonly then
 | |
|           list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendprocdef(list:TAsmList;def:tprocdef);
 | |
|       begin
 | |
|         { the procdef itself is already written by appendprocdef_implicit }
 | |
|       
 | |
|         { last write the types from this procdef }
 | |
|         if assigned(def.parast) then
 | |
|           write_symtable_defs(current_asmdata.asmlists[al_start],def.parast);
 | |
|         if assigned(def.localst) and
 | |
|            (def.localst.symtabletype=localsymtable) then
 | |
|           write_symtable_defs(current_asmdata.asmlists[al_start],def.localst);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
 | |
|       begin
 | |
|         appenddef(list,sym.vardef);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
 | |
|       begin
 | |
|         appendsym_var(list,sym);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
 | |
|       begin
 | |
|         appendsym_var(list,sym);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_paravar(list:TAsmList;sym:tparavarsym);
 | |
|       begin
 | |
|         appendsym_var(list,sym);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
 | |
|       begin
 | |
|         appenddef(list,sym.vardef);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_const(list:TAsmList;sym:tconstsym);
 | |
|       begin
 | |
|         appenddef(list,sym.constdef);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
 | |
|       begin
 | |
|         appenddef(list,sym.vardef);
 | |
|       end;
 | |
| 
 | |
|     procedure TLLVMTypeInfo.afterappenddef(list: TAsmList; def: tdef);
 | |
|     begin
 | |
|       record_def(def);
 | |
|       inherited;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.inserttypeinfo;
 | |
| 
 | |
|       procedure write_defs_to_write;
 | |
|         var
 | |
|           n       : integer;
 | |
|           looplist,
 | |
|           templist: TFPObjectList;
 | |
|           def     : tdef;
 | |
|         begin
 | |
|           templist := TFPObjectList.Create(False);
 | |
|           looplist := deftowritelist;
 | |
|           while looplist.count > 0 do
 | |
|             begin
 | |
|               deftowritelist := templist;
 | |
|               for n := 0 to looplist.count - 1 do
 | |
|                 begin
 | |
|                   def := tdef(looplist[n]);
 | |
|                   case def.dbg_state of
 | |
|                     dbg_state_written:
 | |
|                       continue;
 | |
|                     dbg_state_writing:
 | |
|                       internalerror(2006100501);
 | |
|                     dbg_state_unused:
 | |
|                       internalerror(2006100505);
 | |
|                     dbg_state_used:
 | |
|                       appenddef(current_asmdata.asmlists[al_start],def)
 | |
|                   else
 | |
|                     internalerror(200610054);
 | |
|                   end;
 | |
|                 end;
 | |
|               looplist.clear;
 | |
|               templist := looplist;
 | |
|               looplist := deftowritelist;
 | |
|             end;
 | |
|           templist.free;
 | |
|         end;
 | |
| 
 | |
| 
 | |
|       var
 | |
|         storefilepos: tfileposinfo;
 | |
|         def: tdef;
 | |
|         i: longint;
 | |
|         hal: tasmlisttype;
 | |
|       begin
 | |
|         if cs_no_regalloc in current_settings.globalswitches then
 | |
|           exit;
 | |
|         storefilepos:=current_filepos;
 | |
|         current_filepos:=current_module.mainfilepos;
 | |
| 
 | |
|         defnumberlist:=TFPObjectList.create(false);
 | |
|         deftowritelist:=TFPObjectList.create(false);
 | |
| 
 | |
|         { write all global/static variables, part of flagging all required tdefs  }
 | |
|         if assigned(current_module.globalsymtable) then
 | |
|           write_symtable_syms(current_asmdata.asmlists[al_start],current_module.globalsymtable);
 | |
|         if assigned(current_module.localsymtable) then
 | |
|           write_symtable_syms(current_asmdata.asmlists[al_start],current_module.localsymtable);
 | |
| 
 | |
|         { write all procedures and methods, part of flagging all required tdefs }
 | |
|         if assigned(current_module.globalsymtable) then
 | |
|           write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.globalsymtable);
 | |
|         if assigned(current_module.localsymtable) then
 | |
|           write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.localsymtable);
 | |
| 
 | |
|         { process all llvm instructions, part of flagging all required tdefs }
 | |
|         for hal:=low(TasmlistType) to high(TasmlistType) do
 | |
|           if hal<>al_start then
 | |
|             collect_asmlist_info(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
 | |
| 
 | |
|         { update the defs of all alias declarations so they match those of the
 | |
|           declarations of the symbols they alias }
 | |
|         for hal:=low(TasmlistType) to high(TasmlistType) do
 | |
|           if hal<>al_start then
 | |
|             update_asmlist_alias_types(current_asmdata.asmlists[hal]);
 | |
| 
 | |
|         { and insert the necessary type conversions }
 | |
|         for hal:=low(TasmlistType) to high(TasmlistType) do
 | |
|           if hal<>al_start then
 | |
|             insert_asmlist_typeconversions(
 | |
|               current_asmdata.asmlists[hal],
 | |
|               current_asmdata.asmlists[hal]);
 | |
| 
 | |
|         { write all used defs }
 | |
|         write_defs_to_write;
 | |
| 
 | |
|         { reset all def labels }
 | |
|         for i:=0 to defnumberlist.count-1 do
 | |
|           begin
 | |
|             def:=tdef(defnumberlist[i]);
 | |
|             def.dbg_state:=dbg_state_unused;
 | |
|             def.stab_number:=0;
 | |
|           end;
 | |
| 
 | |
|         defnumberlist.free;
 | |
|         defnumberlist:=nil;
 | |
|         deftowritelist.free;
 | |
|         deftowritelist:=nil;
 | |
| 
 | |
|         current_filepos:=storefilepos;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_object(list:TAsmList;def: tobjectdef);
 | |
|       begin
 | |
|         if is_interface(def) then
 | |
|           begin
 | |
|             record_def(def.vmt_def);
 | |
|           end
 | |
|         else
 | |
|           appenddef_abstractrecord(list,def);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_classref(list: TAsmList; def: tclassrefdef);
 | |
|       begin
 | |
|         { can also be an objcclass, which doesn't have a vmt }
 | |
|         if is_class(tclassrefdef(def).pointeddef) then
 | |
|           record_def(tobjectdef(tclassrefdef(def).pointeddef).vmt_def);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_variant(list:TAsmList;def: tvariantdef);
 | |
|       begin
 | |
|         appenddef(list,tabstractrecorddef(search_system_type('TVARDATA').typedef));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TLLVMTypeInfo.appenddef_file(list: TasmList; def: tfiledef);
 | |
|       begin
 | |
|         case tfiledef(def).filetyp of
 | |
|           ft_text    :
 | |
|             appenddef(list,tabstractrecorddef(search_system_type('TEXTREC').typedef));
 | |
|           ft_typed,
 | |
|           ft_untyped :
 | |
|             appenddef(list,tabstractrecorddef(search_system_type('FILEREC').typedef));
 | |
|         end;
 | |
|       end;
 | |
| 
 | |
| end.
 |