paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 02:28:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ tllvmtypeconvnode.second_int_to_bool() implementation

Browse Source 
git-svn-id: branches/hlcgllvm@28370 -
This commit is contained in:
Jonas Maebe 2014-08-10 19:40:13 +00:00
parent f4cdf13d54
commit 0aab46b97f
1 changed files with 57 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
compiler/llvm/nllvmcnv.pas
View File

@ -32,6 +32,7 @@ interface
tllvmtypeconvnode = class(tcgtypeconvnode)
protected
function first_int_to_real: tnode; override;
function first_int_to_bool: tnode; override;
procedure second_int_to_int;override;
{ procedure second_string_to_string;override; }
{ procedure second_cstring_to_pchar;override; }
@ -45,7 +46,7 @@ interface
{ procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; }
{ procedure second_bool_to_int;override; }
{ procedure second_int_to_bool;override; }
procedure second_int_to_bool;override;
{ procedure second_load_smallset;override; }
{ procedure second_ansistring_to_pchar;override; }
{ procedure second_pchar_to_string;override; }
@ -57,11 +58,12 @@ interface
implementation
uses
globtype,verbose,
aasmdata,
globtype,globals,verbose,
aasmbase,aasmdata,
llvmbase,aasmllvm,
procinfo,
symconst,symdef,defutil,
cgbase,cgutils,hlcgobj;
cgbase,cgutils,hlcgobj,pass_2;
{ tllvmtypeconvnode }
@ -71,6 +73,15 @@ function tllvmtypeconvnode.first_int_to_real: tnode;
result:=nil;
end;
function tllvmtypeconvnode.first_int_to_bool: tnode;
begin
result:=inherited;
if not assigned(result) then
expectloc:=LOC_JUMP;
end;
procedure tllvmtypeconvnode.second_int_to_int;
var
fromsize, tosize: tcgint;
@ -123,6 +134,48 @@ procedure tllvmtypeconvnode.second_int_to_real;
end;
procedure tllvmtypeconvnode.second_int_to_bool;
var
newsize : tcgsize;
begin
secondpass(left);
if codegenerror then
exit;
{ Explicit typecasts from any ordinal type to a boolean type }
{ must not change the ordinal value }
if (nf_explicit in flags) and
not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then
begin
location_copy(location,left.location);
newsize:=def_cgsize(resultdef);
{ change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
else
location.size:=newsize;
exit;
end;
location_reset(location,LOC_JUMP,OS_NO);
case left.location.loc of
LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF,
LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
begin
hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,current_procinfo.CurrFalseLabel);
hlcg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
end;
LOC_JUMP :
begin
{ nothing to do, jumps already go to the right labels }
end;
else
internalerror(10062);
end;
end;
procedure tllvmtypeconvnode.second_nothing;
var
hreg: tregister;