mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-22 02:19:37 +01:00
* almost all second pass typeconvnode helpers are now processor independent
* fixed converting boolean to int64/qword
* fixed register allocation bugs which could cause internalerror 10
* isnode and asnode are completely processor indepent now as well
* fpc_do_as now returns its class argument (necessary to be able to use it
properly with compilerproc)
This commit is contained in:
Jonas Maebe
parent
fac1fb3d6c
commit
fc6d300a95
@ -29,7 +29,7 @@ unit cpunode;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
ncgbas,ncgflw,
|
ncgbas,ncgflw,ncgcnv,
|
||||||
n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
|
n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
|
||||||
n386set,n386inl,n386opt,
|
n386set,n386inl,n386opt,
|
||||||
{ this not really a node }
|
{ this not really a node }
|
||||||
@ -38,7 +38,15 @@ unit cpunode;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.5 2001-09-28 20:39:33 jonas
|
Revision 1.6 2001-09-29 21:32:47 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
Revision 1.5 2001/09/28 20:39:33 jonas
|
||||||
* changed all flow control structures (except for exception handling
|
* changed all flow control structures (except for exception handling
|
||||||
related things) to processor independent code (in new ncgflw unit)
|
related things) to processor independent code (in new ncgflw unit)
|
||||||
+ generic cgobj unit which contains lots of code generator helpers with
|
+ generic cgobj unit which contains lots of code generator helpers with
|
||||||
|
|||||||
@ -27,30 +27,30 @@ unit n386cnv;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
node,ncnv,types;
|
node,ncnv,ncgcnv,types;
|
||||||
|
|
||||||
type
|
type
|
||||||
ti386typeconvnode = class(ttypeconvnode)
|
ti386typeconvnode = class(tcgtypeconvnode)
|
||||||
procedure second_int_to_int;virtual;
|
protected
|
||||||
{ procedure second_string_to_string;virtual; }
|
procedure second_int_to_int;override;
|
||||||
procedure second_cstring_to_pchar;virtual;
|
{ procedure second_string_to_string;override; }
|
||||||
procedure second_string_to_chararray;virtual;
|
{ procedure second_cstring_to_pchar;override; }
|
||||||
procedure second_array_to_pointer;virtual;
|
{ procedure second_string_to_chararray;override; }
|
||||||
procedure second_pointer_to_array;virtual;
|
{ procedure second_array_to_pointer;override; }
|
||||||
{ procedure second_chararray_to_string;virtual; }
|
{ procedure second_pointer_to_array;override; }
|
||||||
procedure second_char_to_string;virtual;
|
{ procedure second_chararray_to_string;override; }
|
||||||
procedure second_int_to_real;virtual;
|
{ procedure second_char_to_string;override; }
|
||||||
procedure second_real_to_real;virtual;
|
procedure second_int_to_real;override;
|
||||||
procedure second_cord_to_pointer;virtual;
|
{ procedure second_real_to_real;override; }
|
||||||
procedure second_proc_to_procvar;virtual;
|
{ procedure second_cord_to_pointer;override; }
|
||||||
procedure second_bool_to_int;virtual;
|
{ procedure second_proc_to_procvar;override; }
|
||||||
procedure second_int_to_bool;virtual;
|
{ procedure second_bool_to_int;override; }
|
||||||
procedure second_load_smallset;virtual;
|
procedure second_int_to_bool;override;
|
||||||
procedure second_ansistring_to_pchar;virtual;
|
{ procedure second_load_smallset;override; }
|
||||||
{ procedure second_pchar_to_string;virtual; }
|
{ procedure second_ansistring_to_pchar;override; }
|
||||||
procedure second_class_to_intf;virtual;
|
{ procedure second_pchar_to_string;override; }
|
||||||
procedure second_char_to_char;virtual;
|
{ procedure second_class_to_intf;override; }
|
||||||
procedure second_nothing;virtual;
|
{ procedure second_char_to_char;override; }
|
||||||
procedure pass_2;override;
|
procedure pass_2;override;
|
||||||
procedure second_call_helper(c : tconverttype);
|
procedure second_call_helper(c : tconverttype);
|
||||||
end;
|
end;
|
||||||
@ -201,141 +201,6 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_cstring_to_pchar;
|
|
||||||
var
|
|
||||||
hr : preference;
|
|
||||||
begin
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
case tstringdef(left.resulttype.def).string_typ of
|
|
||||||
st_shortstring :
|
|
||||||
begin
|
|
||||||
inc(left.location.reference.offset);
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
|
|
||||||
location.register);
|
|
||||||
end;
|
|
||||||
st_ansistring :
|
|
||||||
begin
|
|
||||||
if (left.nodetype=stringconstn) and
|
|
||||||
(str_length(left)=0) then
|
|
||||||
begin
|
|
||||||
new(hr);
|
|
||||||
reset_reference(hr^);
|
|
||||||
hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_LEA,S_L,hr,location.register);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
|
|
||||||
location.register);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
st_longstring:
|
|
||||||
begin
|
|
||||||
{!!!!!!!}
|
|
||||||
internalerror(8888);
|
|
||||||
end;
|
|
||||||
st_widestring:
|
|
||||||
begin
|
|
||||||
if (left.nodetype=stringconstn) and
|
|
||||||
(str_length(left)=0) then
|
|
||||||
begin
|
|
||||||
new(hr);
|
|
||||||
reset_reference(hr^);
|
|
||||||
hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_LEA,S_L,hr,location.register);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
|
|
||||||
location.register);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_string_to_chararray;
|
|
||||||
var
|
|
||||||
arrsize: longint;
|
|
||||||
begin
|
|
||||||
with tarraydef(resulttype.def) do
|
|
||||||
arrsize := highrange-lowrange+1;
|
|
||||||
if (left.nodetype = stringconstn) and
|
|
||||||
{ left.length+1 since there's always a terminating #0 character (JM) }
|
|
||||||
(tstringconstnode(left).len+1 >= arrsize) and
|
|
||||||
(tstringdef(left.resulttype.def).string_typ=st_shortstring) then
|
|
||||||
begin
|
|
||||||
inc(location.reference.offset);
|
|
||||||
exit;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ should be handled already in resulttype pass (JM) }
|
|
||||||
internalerror(200108292);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_array_to_pointer;
|
|
||||||
begin
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_LEA,S_L,newreference(left.location.reference),
|
|
||||||
location.register);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_pointer_to_array;
|
|
||||||
begin
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REFERENCE;
|
|
||||||
reset_reference(location.reference);
|
|
||||||
case left.location.loc of
|
|
||||||
LOC_REGISTER :
|
|
||||||
location.reference.base:=left.location.register;
|
|
||||||
LOC_CREGISTER :
|
|
||||||
begin
|
|
||||||
location.reference.base:=getregister32;
|
|
||||||
emit_reg_reg(A_MOV,S_L,left.location.register,location.reference.base);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
location.reference.base:=getregister32;
|
|
||||||
emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
|
|
||||||
location.reference.base);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_char_to_string;
|
|
||||||
|
|
||||||
begin
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_MEM;
|
|
||||||
case tstringdef(resulttype.def).string_typ of
|
|
||||||
st_shortstring :
|
|
||||||
begin
|
|
||||||
gettempofsizereference(256,location.reference);
|
|
||||||
loadshortstring(left,self);
|
|
||||||
end;
|
|
||||||
{ the rest is removed in the resulttype pass and coverted to compilerprocs }
|
|
||||||
else
|
|
||||||
internalerror(4179);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_int_to_real;
|
procedure ti386typeconvnode.second_int_to_real;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -454,175 +319,6 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_real_to_real;
|
|
||||||
begin
|
|
||||||
case left.location.loc of
|
|
||||||
LOC_FPU : ;
|
|
||||||
LOC_CFPUREGISTER:
|
|
||||||
begin
|
|
||||||
location:=left.location;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
LOC_MEM,
|
|
||||||
LOC_REFERENCE:
|
|
||||||
begin
|
|
||||||
floatload(tfloatdef(left.resulttype.def).typ,
|
|
||||||
left.location.reference);
|
|
||||||
{ we have to free the reference }
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_FPU;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_cord_to_pointer;
|
|
||||||
begin
|
|
||||||
{ this can't happend, because constants are already processed in
|
|
||||||
pass 1 }
|
|
||||||
internalerror(47423985);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_proc_to_procvar;
|
|
||||||
begin
|
|
||||||
{ method pointer ? }
|
|
||||||
if assigned(tcallnode(left).left) then
|
|
||||||
begin
|
|
||||||
set_location(location,left.location);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
location.register:=getregister32;
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
emit_ref_reg(A_LEA,S_L,
|
|
||||||
newreference(left.location.reference),location.register);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_bool_to_int;
|
|
||||||
var
|
|
||||||
oldtruelabel,oldfalselabel,hlabel : tasmlabel;
|
|
||||||
hregister : tregister;
|
|
||||||
newsize,
|
|
||||||
opsize : topsize;
|
|
||||||
op : tasmop;
|
|
||||||
begin
|
|
||||||
oldtruelabel:=truelabel;
|
|
||||||
oldfalselabel:=falselabel;
|
|
||||||
getlabel(truelabel);
|
|
||||||
getlabel(falselabel);
|
|
||||||
secondpass(left);
|
|
||||||
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
|
||||||
be accepted for var parameters }
|
|
||||||
if (nf_explizit in flags) and
|
|
||||||
(left.resulttype.def.size=resulttype.def.size) and
|
|
||||||
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
|
||||||
begin
|
|
||||||
set_location(location,left.location);
|
|
||||||
truelabel:=oldtruelabel;
|
|
||||||
falselabel:=oldfalselabel;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
case left.resulttype.def.size of
|
|
||||||
1 : begin
|
|
||||||
case resulttype.def.size of
|
|
||||||
1 : opsize:=S_B;
|
|
||||||
2 : opsize:=S_BW;
|
|
||||||
4 : opsize:=S_BL;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
2 : begin
|
|
||||||
case resulttype.def.size of
|
|
||||||
1 : begin
|
|
||||||
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
||||||
left.location.register:=reg16toreg8(left.location.register);
|
|
||||||
opsize:=S_B;
|
|
||||||
end;
|
|
||||||
2 : opsize:=S_W;
|
|
||||||
4 : opsize:=S_WL;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
4 : begin
|
|
||||||
case resulttype.def.size of
|
|
||||||
1 : begin
|
|
||||||
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
||||||
left.location.register:=reg32toreg8(left.location.register);
|
|
||||||
opsize:=S_B;
|
|
||||||
end;
|
|
||||||
2 : begin
|
|
||||||
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
||||||
left.location.register:=reg32toreg16(left.location.register);
|
|
||||||
opsize:=S_W;
|
|
||||||
end;
|
|
||||||
4 : opsize:=S_L;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if opsize in [S_B,S_W,S_L] then
|
|
||||||
op:=A_MOV
|
|
||||||
else
|
|
||||||
if is_signed(resulttype.def) then
|
|
||||||
op:=A_MOVSX
|
|
||||||
else
|
|
||||||
op:=A_MOVZX;
|
|
||||||
hregister:=getregister32;
|
|
||||||
case resulttype.def.size of
|
|
||||||
1 : begin
|
|
||||||
location.register:=reg32toreg8(hregister);
|
|
||||||
newsize:=S_B;
|
|
||||||
end;
|
|
||||||
2 : begin
|
|
||||||
location.register:=reg32toreg16(hregister);
|
|
||||||
newsize:=S_W;
|
|
||||||
end;
|
|
||||||
4 : begin
|
|
||||||
location.register:=hregister;
|
|
||||||
newsize:=S_L;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
internalerror(10060);
|
|
||||||
end;
|
|
||||||
|
|
||||||
case left.location.loc of
|
|
||||||
LOC_MEM,
|
|
||||||
LOC_REFERENCE : emit_ref_reg(op,opsize,
|
|
||||||
newreference(left.location.reference),location.register);
|
|
||||||
LOC_REGISTER,
|
|
||||||
LOC_CREGISTER : begin
|
|
||||||
{ remove things like movb %al,%al }
|
|
||||||
if left.location.register<>location.register then
|
|
||||||
emit_reg_reg(op,opsize,
|
|
||||||
left.location.register,location.register);
|
|
||||||
end;
|
|
||||||
LOC_FLAGS : begin
|
|
||||||
emit_flag2reg(left.location.resflags,location.register);
|
|
||||||
end;
|
|
||||||
LOC_JUMP : begin
|
|
||||||
getlabel(hlabel);
|
|
||||||
emitlab(truelabel);
|
|
||||||
emit_const_reg(A_MOV,newsize,1,location.register);
|
|
||||||
emitjmp(C_None,hlabel);
|
|
||||||
emitlab(falselabel);
|
|
||||||
emit_reg_reg(A_XOR,newsize,location.register,
|
|
||||||
location.register);
|
|
||||||
emitlab(hlabel);
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
internalerror(10061);
|
|
||||||
end;
|
|
||||||
truelabel:=oldtruelabel;
|
|
||||||
falselabel:=oldfalselabel;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_int_to_bool;
|
procedure ti386typeconvnode.second_int_to_bool;
|
||||||
var
|
var
|
||||||
hregister : tregister;
|
hregister : tregister;
|
||||||
@ -630,8 +326,8 @@ implementation
|
|||||||
opsize : topsize;
|
opsize : topsize;
|
||||||
begin
|
begin
|
||||||
clear_location(location);
|
clear_location(location);
|
||||||
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
{ byte(boolean) or word(wordbool) or longint(longbool) must }
|
||||||
be accepted for var parameters }
|
{ be accepted for var parameters }
|
||||||
if (nf_explizit in flags) and
|
if (nf_explizit in flags) and
|
||||||
(left.resulttype.def.size=resulttype.def.size) and
|
(left.resulttype.def.size=resulttype.def.size) and
|
||||||
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
||||||
@ -640,7 +336,7 @@ implementation
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
location.loc:=LOC_REGISTER;
|
location.loc:=LOC_REGISTER;
|
||||||
del_reference(left.location.reference);
|
del_location(left.location);
|
||||||
opsize:=def_opsize(left.resulttype.def);
|
opsize:=def_opsize(left.resulttype.def);
|
||||||
case left.location.loc of
|
case left.location.loc of
|
||||||
LOC_MEM,LOC_REFERENCE :
|
LOC_MEM,LOC_REFERENCE :
|
||||||
@ -676,103 +372,6 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_load_smallset;
|
|
||||||
var
|
|
||||||
href : treference;
|
|
||||||
pushedregs : tpushed;
|
|
||||||
begin
|
|
||||||
href.symbol:=nil;
|
|
||||||
pushusedregisters(pushedregs,$ff);
|
|
||||||
gettempofsizereference(32,href);
|
|
||||||
emit_push_mem_size(left.location.reference,4);
|
|
||||||
emitpushreferenceaddr(href);
|
|
||||||
saveregvars($ff);
|
|
||||||
emitcall('FPC_SET_LOAD_SMALL');
|
|
||||||
maybe_loadself;
|
|
||||||
popusedregisters(pushedregs);
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_MEM;
|
|
||||||
location.reference:=href;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_ansistring_to_pchar;
|
|
||||||
var
|
|
||||||
l1 : tasmlabel;
|
|
||||||
hr : preference;
|
|
||||||
begin
|
|
||||||
clear_location(location);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
getlabel(l1);
|
|
||||||
case left.location.loc of
|
|
||||||
LOC_CREGISTER,LOC_REGISTER:
|
|
||||||
location.register:=left.location.register;
|
|
||||||
LOC_MEM,LOC_REFERENCE:
|
|
||||||
begin
|
|
||||||
location.register:=getregister32;
|
|
||||||
emit_ref_reg(A_MOV,S_L,newreference(left.location.reference),
|
|
||||||
location.register);
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
emit_const_reg(A_CMP,S_L,0,location.register);
|
|
||||||
emitjmp(C_NZ,l1);
|
|
||||||
new(hr);
|
|
||||||
reset_reference(hr^);
|
|
||||||
hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
|
||||||
emit_ref_reg(A_LEA,S_L,hr,location.register);
|
|
||||||
emitlab(l1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_class_to_intf;
|
|
||||||
var
|
|
||||||
hreg : tregister;
|
|
||||||
l1 : tasmlabel;
|
|
||||||
begin
|
|
||||||
case left.location.loc of
|
|
||||||
LOC_MEM,
|
|
||||||
LOC_REFERENCE:
|
|
||||||
begin
|
|
||||||
del_reference(left.location.reference);
|
|
||||||
hreg:=getregister32;
|
|
||||||
exprasmList.concat(Taicpu.Op_ref_reg(
|
|
||||||
A_MOV,S_L,newreference(left.location.reference),hreg));
|
|
||||||
end;
|
|
||||||
LOC_CREGISTER:
|
|
||||||
begin
|
|
||||||
hreg:=getregister32;
|
|
||||||
exprasmList.concat(Taicpu.Op_reg_reg(
|
|
||||||
A_MOV,S_L,left.location.register,hreg));
|
|
||||||
end;
|
|
||||||
LOC_REGISTER:
|
|
||||||
hreg:=left.location.register;
|
|
||||||
else internalerror(121120001);
|
|
||||||
end;
|
|
||||||
emit_reg_reg(A_TEST,S_L,hreg,hreg);
|
|
||||||
getlabel(l1);
|
|
||||||
emitjmp(C_Z,l1);
|
|
||||||
emit_const_reg(A_ADD,S_L,tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
|
|
||||||
tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(resulttype.def))^,hreg);
|
|
||||||
emitlab(l1);
|
|
||||||
location.loc:=LOC_REGISTER;
|
|
||||||
location.register:=hreg;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_char_to_char;
|
|
||||||
begin
|
|
||||||
{$warning todo: add RTL routine for widechar-char conversion }
|
|
||||||
{ Quick hack to atleast generate 'working' code (PFV) }
|
|
||||||
second_int_to_int;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure ti386typeconvnode.second_nothing;
|
|
||||||
begin
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
TI386TYPECONVNODE
|
TI386TYPECONVNODE
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
@ -781,33 +380,33 @@ implementation
|
|||||||
|
|
||||||
const
|
const
|
||||||
secondconvert : array[tconverttype] of pointer = (
|
secondconvert : array[tconverttype] of pointer = (
|
||||||
@ti386typeconvnode.second_nothing, {equal}
|
@second_nothing, {equal}
|
||||||
@ti386typeconvnode.second_nothing, {not_possible}
|
@second_nothing, {not_possible}
|
||||||
@ti386typeconvnode.second_nothing, {second_string_to_string, handled in resulttype pass }
|
@second_nothing, {second_string_to_string, handled in resulttype pass }
|
||||||
@ti386typeconvnode.second_char_to_string,
|
@second_char_to_string,
|
||||||
@ti386typeconvnode.second_nothing, { pchar_to_string, handled in resulttype pass }
|
@second_nothing, { pchar_to_string, handled in resulttype pass }
|
||||||
@ti386typeconvnode.second_nothing, {cchar_to_pchar}
|
@second_nothing, {cchar_to_pchar}
|
||||||
@ti386typeconvnode.second_cstring_to_pchar,
|
@second_cstring_to_pchar,
|
||||||
@ti386typeconvnode.second_ansistring_to_pchar,
|
@second_ansistring_to_pchar,
|
||||||
@ti386typeconvnode.second_string_to_chararray,
|
@second_string_to_chararray,
|
||||||
@ti386typeconvnode.second_nothing, { chararray_to_string, handled in resulttype pass }
|
@second_nothing, { chararray_to_string, handled in resulttype pass }
|
||||||
@ti386typeconvnode.second_array_to_pointer,
|
@second_array_to_pointer,
|
||||||
@ti386typeconvnode.second_pointer_to_array,
|
@second_pointer_to_array,
|
||||||
@ti386typeconvnode.second_int_to_int,
|
@second_int_to_int,
|
||||||
@ti386typeconvnode.second_int_to_bool,
|
@second_int_to_bool,
|
||||||
@ti386typeconvnode.second_bool_to_int, { bool_to_bool }
|
@second_bool_to_int, { bool_to_bool }
|
||||||
@ti386typeconvnode.second_bool_to_int,
|
@second_bool_to_int,
|
||||||
@ti386typeconvnode.second_real_to_real,
|
@second_real_to_real,
|
||||||
@ti386typeconvnode.second_int_to_real,
|
@second_int_to_real,
|
||||||
@ti386typeconvnode.second_proc_to_procvar,
|
@second_proc_to_procvar,
|
||||||
@ti386typeconvnode.second_nothing, {arrayconstructor_to_set}
|
@second_nothing, { arrayconstructor_to_set }
|
||||||
@ti386typeconvnode.second_load_smallset,
|
@second_nothing, { second_load_smallset, handled in first pass }
|
||||||
@ti386typeconvnode.second_cord_to_pointer,
|
@second_cord_to_pointer,
|
||||||
@ti386typeconvnode.second_nothing, { interface 2 string }
|
@second_nothing, { interface 2 string }
|
||||||
@ti386typeconvnode.second_nothing, { interface 2 guid }
|
@second_nothing, { interface 2 guid }
|
||||||
@ti386typeconvnode.second_class_to_intf,
|
@second_class_to_intf,
|
||||||
@ti386typeconvnode.second_char_to_char,
|
@second_char_to_char,
|
||||||
@ti386typeconvnode.second_nothing { normal_2_smallset }
|
@second_nothing { normal_2_smallset }
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
tprocedureofobject = procedure of object;
|
tprocedureofobject = procedure of object;
|
||||||
@ -1001,7 +600,15 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.23 2001-09-03 13:27:42 jonas
|
Revision 1.24 2001-09-29 21:32:47 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
Revision 1.23 2001/09/03 13:27:42 jonas
|
||||||
* compilerproc implementation of set addition/substraction/...
|
* compilerproc implementation of set addition/substraction/...
|
||||||
* changed the declaration of some set helpers somewhat to accomodate the
|
* changed the declaration of some set helpers somewhat to accomodate the
|
||||||
above change
|
above change
|
||||||
|
|||||||
436
compiler/ncgcnv.pas
Normal file
436
compiler/ncgcnv.pas
Normal file
@ -0,0 +1,436 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 2000 by Florian Klaempfl
|
||||||
|
|
||||||
|
Generate assembler for nodes that handle type conversions which are
|
||||||
|
the same for all (most) processors
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
****************************************************************************
|
||||||
|
}
|
||||||
|
unit ncgcnv;
|
||||||
|
|
||||||
|
{$i defines.inc}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
node,ncnv;
|
||||||
|
|
||||||
|
type
|
||||||
|
tcgtypeconvnode = class(ttypeconvnode)
|
||||||
|
procedure second_cstring_to_pchar;override;
|
||||||
|
procedure second_string_to_chararray;override;
|
||||||
|
procedure second_array_to_pointer;override;
|
||||||
|
procedure second_pointer_to_array;override;
|
||||||
|
procedure second_char_to_string;override;
|
||||||
|
procedure second_real_to_real;override;
|
||||||
|
procedure second_cord_to_pointer;override;
|
||||||
|
procedure second_proc_to_procvar;override;
|
||||||
|
procedure second_bool_to_int;override;
|
||||||
|
procedure second_ansistring_to_pchar;override;
|
||||||
|
procedure second_class_to_intf;override;
|
||||||
|
procedure second_char_to_char;override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
globtype,
|
||||||
|
cutils,cclasses,globals,verbose,
|
||||||
|
aasm,symconst,symsym,symtable,symdef,symtype,types,
|
||||||
|
ncon,ncal,
|
||||||
|
htypechk,
|
||||||
|
cpubase,cpuasm,
|
||||||
|
pass_2,
|
||||||
|
cgbase,
|
||||||
|
cga,cgobj,cgcpu,
|
||||||
|
{$ifdef i386}
|
||||||
|
n386util,
|
||||||
|
{$endif i386}
|
||||||
|
tgcpu,temp_gen
|
||||||
|
;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_cstring_to_pchar;
|
||||||
|
|
||||||
|
var
|
||||||
|
hr : treference;
|
||||||
|
|
||||||
|
begin
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
case tstringdef(left.resulttype.def).string_typ of
|
||||||
|
st_shortstring :
|
||||||
|
begin
|
||||||
|
inc(left.location.reference.offset);
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
st_ansistring :
|
||||||
|
begin
|
||||||
|
if (left.nodetype=stringconstn) and
|
||||||
|
(str_length(left)=0) then
|
||||||
|
begin
|
||||||
|
reset_reference(hr);
|
||||||
|
hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
st_longstring:
|
||||||
|
begin
|
||||||
|
{!!!!!!!}
|
||||||
|
internalerror(8888);
|
||||||
|
end;
|
||||||
|
st_widestring:
|
||||||
|
begin
|
||||||
|
if (left.nodetype=stringconstn) and
|
||||||
|
(str_length(left)=0) then
|
||||||
|
begin
|
||||||
|
reset_reference(hr);
|
||||||
|
hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.register:=getregister32;
|
||||||
|
{$warning Todo: convert widestrings to ascii when typecasting them to pchars}
|
||||||
|
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_string_to_chararray;
|
||||||
|
|
||||||
|
var
|
||||||
|
arrsize: longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
with tarraydef(resulttype.def) do
|
||||||
|
arrsize := highrange-lowrange+1;
|
||||||
|
if (left.nodetype = stringconstn) and
|
||||||
|
{ left.length+1 since there's always a terminating #0 character (JM) }
|
||||||
|
(tstringconstnode(left).len+1 >= arrsize) and
|
||||||
|
(tstringdef(left.resulttype.def).string_typ=st_shortstring) then
|
||||||
|
begin
|
||||||
|
inc(location.reference.offset);
|
||||||
|
exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ should be handled already in resulttype pass (JM) }
|
||||||
|
internalerror(200108292);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_array_to_pointer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_pointer_to_array;
|
||||||
|
|
||||||
|
begin
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REFERENCE;
|
||||||
|
reset_reference(location.reference);
|
||||||
|
case left.location.loc of
|
||||||
|
LOC_REGISTER :
|
||||||
|
location.reference.base:=left.location.register;
|
||||||
|
LOC_CREGISTER :
|
||||||
|
begin
|
||||||
|
location.reference.base:=getregister32;
|
||||||
|
cg.a_load_reg_reg(exprasmlist,OS_32,left.location.register,
|
||||||
|
location.reference.base);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.reference.base:=getregister32;
|
||||||
|
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
|
||||||
|
location.reference.base);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_char_to_string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_MEM;
|
||||||
|
case tstringdef(resulttype.def).string_typ of
|
||||||
|
st_shortstring :
|
||||||
|
begin
|
||||||
|
gettempofsizereference(256,location.reference);
|
||||||
|
loadshortstring(left,self);
|
||||||
|
end;
|
||||||
|
{ the rest is removed in the resulttype pass and converted to compilerprocs }
|
||||||
|
else
|
||||||
|
internalerror(4179);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_real_to_real;
|
||||||
|
begin
|
||||||
|
case left.location.loc of
|
||||||
|
LOC_FPU : ;
|
||||||
|
LOC_CFPUREGISTER:
|
||||||
|
begin
|
||||||
|
location:=left.location;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
LOC_MEM,
|
||||||
|
LOC_REFERENCE:
|
||||||
|
begin
|
||||||
|
floatload(tfloatdef(left.resulttype.def).typ,
|
||||||
|
left.location.reference);
|
||||||
|
{ we have to free the reference }
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_FPU;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_cord_to_pointer;
|
||||||
|
begin
|
||||||
|
{ this can't happen because constants are already processed in
|
||||||
|
pass 1 }
|
||||||
|
internalerror(47423985);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_proc_to_procvar;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ method pointer ? }
|
||||||
|
if assigned(tcallnode(left).left) then
|
||||||
|
begin
|
||||||
|
set_location(location,left.location);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_bool_to_int;
|
||||||
|
|
||||||
|
var
|
||||||
|
oldtruelabel,oldfalselabel,hlabel : tasmlabel;
|
||||||
|
newsize,
|
||||||
|
opsize : tcgsize;
|
||||||
|
|
||||||
|
begin
|
||||||
|
oldtruelabel:=truelabel;
|
||||||
|
oldfalselabel:=falselabel;
|
||||||
|
getlabel(truelabel);
|
||||||
|
getlabel(falselabel);
|
||||||
|
secondpass(left);
|
||||||
|
{ byte(boolean) or word(wordbool) or longint(longbool) must }
|
||||||
|
{ be accepted for var parameters }
|
||||||
|
if (nf_explizit in flags) and
|
||||||
|
(left.resulttype.def.size=resulttype.def.size) and
|
||||||
|
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
||||||
|
begin
|
||||||
|
set_location(location,left.location);
|
||||||
|
truelabel:=oldtruelabel;
|
||||||
|
falselabel:=oldfalselabel;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
del_location(left.location);
|
||||||
|
location.register:=getregister32;
|
||||||
|
{ size of the boolean we're converting }
|
||||||
|
opsize := def_cgsize(left.resulttype.def);
|
||||||
|
{ size of the destination }
|
||||||
|
newsize := def_cgsize(resulttype.def);
|
||||||
|
{ the the source size is bigger than the destination, we can }
|
||||||
|
{ simply decrease the sources size (since wordbool(true) = }
|
||||||
|
{ boolean(true) etc... (JM) }
|
||||||
|
case newsize of
|
||||||
|
OS_8,OS_S8:
|
||||||
|
begin
|
||||||
|
opsize := OS_8;
|
||||||
|
{$ifdef i386}
|
||||||
|
location.register := makereg8(location.register);
|
||||||
|
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
||||||
|
makereg8(left.location.register);
|
||||||
|
{$endif i386}
|
||||||
|
end;
|
||||||
|
OS_16,OS_S16:
|
||||||
|
begin
|
||||||
|
{$ifdef i386}
|
||||||
|
location.register := makereg16(location.register);
|
||||||
|
{$endif i386}
|
||||||
|
if opsize in [OS_32,OS_S32] then
|
||||||
|
begin
|
||||||
|
opsize := OS_16;
|
||||||
|
{$ifdef i386}
|
||||||
|
if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
|
||||||
|
makereg16(left.location.register);
|
||||||
|
{$endif i386}
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
case left.location.loc of
|
||||||
|
LOC_MEM,
|
||||||
|
LOC_REFERENCE :
|
||||||
|
cg.a_load_ref_reg(exprasmlist,opsize,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
LOC_REGISTER,
|
||||||
|
LOC_CREGISTER :
|
||||||
|
if left.location.register<>location.register then
|
||||||
|
cg.a_load_reg_reg(exprasmlist,opsize,left.location.register,
|
||||||
|
location.register);
|
||||||
|
LOC_FLAGS :
|
||||||
|
cg.g_flags2reg(exprasmlist,left.location.resflags,location.register);
|
||||||
|
LOC_JUMP :
|
||||||
|
begin
|
||||||
|
getlabel(hlabel);
|
||||||
|
cg.a_label(exprasmlist,truelabel);
|
||||||
|
cg.a_load_const_reg(exprasmlist,newsize,1,location.register);
|
||||||
|
cg.a_jmp_cond(exprasmlist,OC_NONE,hlabel);
|
||||||
|
cg.a_label(exprasmlist,falselabel);
|
||||||
|
cg.a_load_const_reg(exprasmlist,newsize,0,location.register);
|
||||||
|
cg.a_label(exprasmlist,hlabel);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
internalerror(10061);
|
||||||
|
end;
|
||||||
|
truelabel:=oldtruelabel;
|
||||||
|
falselabel:=oldfalselabel;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_ansistring_to_pchar;
|
||||||
|
var
|
||||||
|
l1 : tasmlabel;
|
||||||
|
hr : treference;
|
||||||
|
begin
|
||||||
|
clear_location(location);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
getlabel(l1);
|
||||||
|
case left.location.loc of
|
||||||
|
LOC_CREGISTER,LOC_REGISTER:
|
||||||
|
location.register:=left.location.register;
|
||||||
|
LOC_MEM,LOC_REFERENCE:
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
location.register:=getregister32;
|
||||||
|
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
|
||||||
|
location.register);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_NE,0,location.register,
|
||||||
|
l1);
|
||||||
|
reset_reference(hr);
|
||||||
|
hr.symbol:=newasmsymbol('FPC_EMPTYCHAR');
|
||||||
|
cg.a_loadaddress_ref_reg(exprasmlist,hr,location.register);
|
||||||
|
cg.a_label(exprasmlist,l1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_class_to_intf;
|
||||||
|
var
|
||||||
|
hreg : tregister;
|
||||||
|
l1 : tasmlabel;
|
||||||
|
begin
|
||||||
|
case left.location.loc of
|
||||||
|
LOC_MEM,
|
||||||
|
LOC_REFERENCE:
|
||||||
|
begin
|
||||||
|
del_reference(left.location.reference);
|
||||||
|
hreg:=getregister32;
|
||||||
|
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
|
||||||
|
hreg);
|
||||||
|
end;
|
||||||
|
LOC_CREGISTER:
|
||||||
|
begin
|
||||||
|
hreg:=getregister32;
|
||||||
|
cg.a_load_reg_reg(exprasmlist,OS_32,left.location.register,
|
||||||
|
hreg);
|
||||||
|
end;
|
||||||
|
LOC_REGISTER:
|
||||||
|
hreg:=left.location.register;
|
||||||
|
else internalerror(121120001);
|
||||||
|
end;
|
||||||
|
getlabel(l1);
|
||||||
|
cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_EQ,0,hreg,l1);
|
||||||
|
cg.a_op_const_reg(exprasmlist,OP_ADD,
|
||||||
|
tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
|
||||||
|
tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(
|
||||||
|
resulttype.def))^,hreg);
|
||||||
|
cg.a_label(exprasmlist,l1);
|
||||||
|
location.loc:=LOC_REGISTER;
|
||||||
|
location.register:=hreg;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure tcgtypeconvnode.second_char_to_char;
|
||||||
|
begin
|
||||||
|
{$warning todo: add RTL routine for widechar-char conversion }
|
||||||
|
{ Quick hack to atleast generate 'working' code (PFV) }
|
||||||
|
second_int_to_int;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ctypeconvnode := tcgtypeconvnode;
|
||||||
|
end.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2001-09-29 21:32:47 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
@ -76,6 +76,28 @@ interface
|
|||||||
function first_class_to_intf : tnode;virtual;
|
function first_class_to_intf : tnode;virtual;
|
||||||
function first_char_to_char : tnode;virtual;
|
function first_char_to_char : tnode;virtual;
|
||||||
function first_call_helper(c : tconverttype) : tnode;
|
function first_call_helper(c : tconverttype) : tnode;
|
||||||
|
|
||||||
|
procedure second_int_to_int;virtual;abstract;
|
||||||
|
procedure second_string_to_string;virtual;abstract;
|
||||||
|
procedure second_cstring_to_pchar;virtual;abstract;
|
||||||
|
procedure second_string_to_chararray;virtual;abstract;
|
||||||
|
procedure second_array_to_pointer;virtual;abstract;
|
||||||
|
procedure second_pointer_to_array;virtual;abstract;
|
||||||
|
procedure second_chararray_to_string;virtual;abstract;
|
||||||
|
procedure second_char_to_string;virtual;abstract;
|
||||||
|
procedure second_int_to_real;virtual;abstract;
|
||||||
|
procedure second_real_to_real;virtual;abstract;
|
||||||
|
procedure second_cord_to_pointer;virtual;abstract;
|
||||||
|
procedure second_proc_to_procvar;virtual;abstract;
|
||||||
|
procedure second_bool_to_int;virtual;abstract;
|
||||||
|
procedure second_int_to_bool;virtual;abstract;
|
||||||
|
procedure second_load_smallset;virtual;abstract;
|
||||||
|
procedure second_ansistring_to_pchar;virtual;abstract;
|
||||||
|
procedure second_pchar_to_string;virtual;abstract;
|
||||||
|
procedure second_class_to_intf;virtual;abstract;
|
||||||
|
procedure second_char_to_char;virtual;abstract;
|
||||||
|
procedure second_nothing; virtual;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
ttypeconvnodeclass = class of ttypeconvnode;
|
ttypeconvnodeclass = class of ttypeconvnode;
|
||||||
|
|
||||||
@ -117,6 +139,7 @@ implementation
|
|||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
procedure inserttypeconv(var p:tnode;const t:ttype);
|
procedure inserttypeconv(var p:tnode;const t:ttype);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not assigned(p.resulttype.def) then
|
if not assigned(p.resulttype.def) then
|
||||||
begin
|
begin
|
||||||
@ -397,8 +420,10 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_cord_to_pointer : tnode;
|
function ttypeconvnode.resulttype_cord_to_pointer : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
t : tnode;
|
t : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=ordconstn then
|
if left.nodetype=ordconstn then
|
||||||
@ -427,6 +452,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_chararray_to_string : tnode;
|
function ttypeconvnode.resulttype_chararray_to_string : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result := ccallnode.createinternres(
|
result := ccallnode.createinternres(
|
||||||
'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
||||||
@ -435,8 +461,10 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_string_to_chararray : tnode;
|
function ttypeconvnode.resulttype_string_to_chararray : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
arrsize: longint;
|
arrsize: longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
with tarraydef(resulttype.def) do
|
with tarraydef(resulttype.def) do
|
||||||
begin
|
begin
|
||||||
@ -460,12 +488,15 @@ implementation
|
|||||||
left := nil;
|
left := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_string_to_string : tnode;
|
function ttypeconvnode.resulttype_string_to_string : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
procname: string[31];
|
procname: string[31];
|
||||||
stringpara : tcallparanode;
|
stringpara : tcallparanode;
|
||||||
pw : pcompilerwidestring;
|
pw : pcompilerwidestring;
|
||||||
pc : pchar;
|
pc : pchar;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=stringconstn then
|
if left.nodetype=stringconstn then
|
||||||
@ -520,11 +551,13 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_char_to_string : tnode;
|
function ttypeconvnode.resulttype_char_to_string : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
procname: string[31];
|
procname: string[31];
|
||||||
para : tcallparanode;
|
para : tcallparanode;
|
||||||
hp : tstringconstnode;
|
hp : tstringconstnode;
|
||||||
ws : pcompilerwidestring;
|
ws : pcompilerwidestring;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=ordconstn then
|
if left.nodetype=ordconstn then
|
||||||
@ -559,8 +592,10 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_char_to_char : tnode;
|
function ttypeconvnode.resulttype_char_to_char : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
hp : tordconstnode;
|
hp : tordconstnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=ordconstn then
|
if left.nodetype=ordconstn then
|
||||||
@ -587,8 +622,10 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_int_to_real : tnode;
|
function ttypeconvnode.resulttype_int_to_real : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
t : trealconstnode;
|
t : trealconstnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=ordconstn then
|
if left.nodetype=ordconstn then
|
||||||
@ -601,8 +638,10 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_real_to_real : tnode;
|
function ttypeconvnode.resulttype_real_to_real : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
t : tnode;
|
t : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype=realconstn then
|
if left.nodetype=realconstn then
|
||||||
@ -614,6 +653,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_cchar_to_pchar : tnode;
|
function ttypeconvnode.resulttype_cchar_to_pchar : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if is_pwidechar(resulttype.def) then
|
if is_pwidechar(resulttype.def) then
|
||||||
@ -628,6 +668,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_cstring_to_pchar : tnode;
|
function ttypeconvnode.resulttype_cstring_to_pchar : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if is_pwidechar(resulttype.def) then
|
if is_pwidechar(resulttype.def) then
|
||||||
@ -636,8 +677,10 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_arrayconstructor_to_set : tnode;
|
function ttypeconvnode.resulttype_arrayconstructor_to_set : tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
hp : tnode;
|
hp : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
if left.nodetype<>arrayconstructorn then
|
if left.nodetype<>arrayconstructorn then
|
||||||
@ -652,6 +695,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.resulttype_pchar_to_string : tnode;
|
function ttypeconvnode.resulttype_pchar_to_string : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result := ccallnode.createinternres(
|
result := ccallnode.createinternres(
|
||||||
'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
||||||
@ -711,9 +755,11 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.det_resulttype:tnode;
|
function ttypeconvnode.det_resulttype:tnode;
|
||||||
|
|
||||||
var
|
var
|
||||||
hp : tnode;
|
hp : tnode;
|
||||||
aprocdef : tprocdef;
|
aprocdef : tprocdef;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
resulttype:=totype;
|
resulttype:=totype;
|
||||||
@ -1048,6 +1094,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_cord_to_pointer : tnode;
|
function ttypeconvnode.first_cord_to_pointer : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
result:=nil;
|
||||||
internalerror(200104043);
|
internalerror(200104043);
|
||||||
@ -1055,6 +1102,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_int_to_int : tnode;
|
function ttypeconvnode.first_int_to_int : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_int_to_int:=nil;
|
first_int_to_int:=nil;
|
||||||
if (left.location.loc<>LOC_REGISTER) and
|
if (left.location.loc<>LOC_REGISTER) and
|
||||||
@ -1068,6 +1116,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_cstring_to_pchar : tnode;
|
function ttypeconvnode.first_cstring_to_pchar : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_cstring_to_pchar:=nil;
|
first_cstring_to_pchar:=nil;
|
||||||
registers32:=1;
|
registers32:=1;
|
||||||
@ -1076,6 +1125,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_string_to_chararray : tnode;
|
function ttypeconvnode.first_string_to_chararray : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_string_to_chararray:=nil;
|
first_string_to_chararray:=nil;
|
||||||
registers32:=1;
|
registers32:=1;
|
||||||
@ -1084,6 +1134,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_char_to_string : tnode;
|
function ttypeconvnode.first_char_to_string : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_char_to_string:=nil;
|
first_char_to_string:=nil;
|
||||||
location.loc:=LOC_MEM;
|
location.loc:=LOC_MEM;
|
||||||
@ -1098,6 +1149,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_array_to_pointer : tnode;
|
function ttypeconvnode.first_array_to_pointer : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_array_to_pointer:=nil;
|
first_array_to_pointer:=nil;
|
||||||
if registers32<1 then
|
if registers32<1 then
|
||||||
@ -1107,6 +1159,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_int_to_real : tnode;
|
function ttypeconvnode.first_int_to_real : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_int_to_real:=nil;
|
first_int_to_real:=nil;
|
||||||
{$ifdef m68k}
|
{$ifdef m68k}
|
||||||
@ -1144,6 +1197,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_pointer_to_array : tnode;
|
function ttypeconvnode.first_pointer_to_array : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_pointer_to_array:=nil;
|
first_pointer_to_array:=nil;
|
||||||
if registers32<1 then
|
if registers32<1 then
|
||||||
@ -1153,6 +1207,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_cchar_to_pchar : tnode;
|
function ttypeconvnode.first_cchar_to_pchar : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_cchar_to_pchar:=nil;
|
first_cchar_to_pchar:=nil;
|
||||||
internalerror(200104021);
|
internalerror(200104021);
|
||||||
@ -1160,6 +1215,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_bool_to_int : tnode;
|
function ttypeconvnode.first_bool_to_int : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_bool_to_int:=nil;
|
first_bool_to_int:=nil;
|
||||||
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
||||||
@ -1168,6 +1224,17 @@ implementation
|
|||||||
(left.resulttype.def.size=resulttype.def.size) and
|
(left.resulttype.def.size=resulttype.def.size) and
|
||||||
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
|
||||||
exit;
|
exit;
|
||||||
|
{ when converting to 64bit, first convert to a 32bit int and then }
|
||||||
|
{ convert to a 64bit int (only necessary for 32bit processors) (JM) }
|
||||||
|
if resulttype.def.size > sizeof(aword) then
|
||||||
|
begin
|
||||||
|
result := ctypeconvnode.create(left,u32bittype);
|
||||||
|
result.toggleflag(nf_explizit);
|
||||||
|
result := ctypeconvnode.create(result,resulttype);
|
||||||
|
left := nil;
|
||||||
|
firstpass(result);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
location.loc:=LOC_REGISTER;
|
location.loc:=LOC_REGISTER;
|
||||||
if registers32<1 then
|
if registers32<1 then
|
||||||
registers32:=1;
|
registers32:=1;
|
||||||
@ -1175,6 +1242,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_int_to_bool : tnode;
|
function ttypeconvnode.first_int_to_bool : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_int_to_bool:=nil;
|
first_int_to_bool:=nil;
|
||||||
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
{ byte(boolean) or word(wordbool) or longint(longbool) must
|
||||||
@ -1204,6 +1272,7 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_char_to_char : tnode;
|
function ttypeconvnode.first_char_to_char : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_char_to_char:=nil;
|
first_char_to_char:=nil;
|
||||||
location.loc:=LOC_REGISTER;
|
location.loc:=LOC_REGISTER;
|
||||||
@ -1225,12 +1294,29 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_load_smallset : tnode;
|
function ttypeconvnode.first_load_smallset : tnode;
|
||||||
|
|
||||||
|
var
|
||||||
|
srsym: ttypesym;
|
||||||
|
p: tcallparanode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_load_smallset:=nil;
|
if not searchsystype('FPC_SMALL_SET',srsym) then
|
||||||
|
internalerror(200108313);
|
||||||
|
p := ccallparanode.create(left,nil);
|
||||||
|
{ reused }
|
||||||
|
left := nil;
|
||||||
|
{ convert parameter explicitely to fpc_small_set }
|
||||||
|
p.left := ctypeconvnode.create(p.left,srsym.restype);
|
||||||
|
p.left.toggleflag(nf_explizit);
|
||||||
|
{ create call, adjust resulttype }
|
||||||
|
result :=
|
||||||
|
ccallnode.createinternres('fpc_set_load_small',p,resulttype);
|
||||||
|
firstpass(result);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_ansistring_to_pchar : tnode;
|
function ttypeconvnode.first_ansistring_to_pchar : tnode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
first_ansistring_to_pchar:=nil;
|
first_ansistring_to_pchar:=nil;
|
||||||
location.loc:=LOC_REGISTER;
|
location.loc:=LOC_REGISTER;
|
||||||
@ -1254,6 +1340,7 @@ implementation
|
|||||||
registers32:=1;
|
registers32:=1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
|
function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
|
||||||
|
|
||||||
const
|
const
|
||||||
@ -1345,6 +1432,19 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ttypeconvnode.docompare(p: tnode) : boolean;
|
||||||
|
begin
|
||||||
|
docompare :=
|
||||||
|
inherited docompare(p) and
|
||||||
|
(convtype = ttypeconvnode(p).convtype);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ttypeconvnode.second_nothing;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
TISNODE
|
TISNODE
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -1391,16 +1491,16 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tisnode.pass_1 : tnode;
|
function tisnode.pass_1 : tnode;
|
||||||
|
|
||||||
|
var
|
||||||
|
paras: tcallparanode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
paras := ccallparanode.create(left,ccallparanode.create(right,nil));
|
||||||
firstpass(left);
|
left := nil;
|
||||||
firstpass(right);
|
right := nil;
|
||||||
if codegenerror then
|
result := ccallnode.createintern('fpc_do_is',paras);
|
||||||
exit;
|
firstpass(result);
|
||||||
|
|
||||||
left_right_max;
|
|
||||||
|
|
||||||
location.loc:=LOC_FLAGS;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -1449,26 +1549,20 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tasnode.pass_1 : tnode;
|
function tasnode.pass_1 : tnode;
|
||||||
|
|
||||||
|
var
|
||||||
|
paras: tcallparanode;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
result:=nil;
|
paras := ccallparanode.create(left,ccallparanode.create(right,nil));
|
||||||
firstpass(right);
|
left := nil;
|
||||||
firstpass(left);
|
right := nil;
|
||||||
if codegenerror then
|
result := ccallnode.createinternres('fpc_do_as',paras,
|
||||||
exit;
|
resulttype);
|
||||||
|
firstpass(result);
|
||||||
left_right_max;
|
|
||||||
|
|
||||||
set_location(location,left.location);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.docompare(p: tnode) : boolean;
|
|
||||||
begin
|
|
||||||
docompare :=
|
|
||||||
inherited docompare(p) and
|
|
||||||
(convtype = ttypeconvnode(p).convtype);
|
|
||||||
end;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
ctypeconvnode:=ttypeconvnode;
|
ctypeconvnode:=ttypeconvnode;
|
||||||
casnode:=tasnode;
|
casnode:=tasnode;
|
||||||
@ -1476,7 +1570,15 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.37 2001-09-03 13:27:42 jonas
|
Revision 1.38 2001-09-29 21:32:46 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
Revision 1.37 2001/09/03 13:27:42 jonas
|
||||||
* compilerproc implementation of set addition/substraction/...
|
* compilerproc implementation of set addition/substraction/...
|
||||||
* changed the declaration of some set helpers somewhat to accomodate the
|
* changed the declaration of some set helpers somewhat to accomodate the
|
||||||
above change
|
above change
|
||||||
|
|||||||
@ -99,7 +99,7 @@ Procedure fpc_widestr_Unique(Var S : WideString); compilerproc;
|
|||||||
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; compilerproc;
|
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; compilerproc;
|
||||||
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; compilerproc;
|
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; compilerproc;
|
||||||
Function fpc_Val_SInt_AnsiStr (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; compilerproc;
|
Function fpc_Val_SInt_AnsiStr (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; compilerproc;
|
||||||
Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc;
|
Function fpc_Val_qword_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc;
|
||||||
Function fpc_Val_int64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; compilerproc;
|
Function fpc_Val_int64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; compilerproc;
|
||||||
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring); compilerproc;
|
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring); compilerproc;
|
||||||
Procedure fpc_AnsiStr_Cardinal(C : Cardinal;Len : Longint; Var S : AnsiString); compilerproc;
|
Procedure fpc_AnsiStr_Cardinal(C : Cardinal;Len : Longint; Var S : AnsiString); compilerproc;
|
||||||
@ -165,7 +165,7 @@ function fpc_mul_qword(f1,f2 : qword;checkoverflow : longbool) : qword; compiler
|
|||||||
function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
|
function fpc_mul_int64(f1,f2 : int64;checkoverflow : longbool) : int64; compilerproc;
|
||||||
|
|
||||||
function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
|
function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
|
||||||
procedure fpc_do_as(aclass : tclass;aobject : tobject); compilerproc;
|
function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
|
||||||
procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
|
procedure fpc_intf_decr_ref(var i: pointer); compilerproc;
|
||||||
procedure fpc_intf_incr_ref(const i: pointer); compilerproc;
|
procedure fpc_intf_incr_ref(const i: pointer); compilerproc;
|
||||||
procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
|
procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc;
|
||||||
@ -247,7 +247,15 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.10 2001-09-05 15:22:09 jonas
|
Revision 1.11 2001-09-29 21:32:47 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
Revision 1.10 2001/09/05 15:22:09 jonas
|
||||||
* made multiplying, dividing and mod'ing of int64 and qword processor
|
* made multiplying, dividing and mod'ing of int64 and qword processor
|
||||||
independent with compilerprocs (+ small optimizations by using shift/and
|
independent with compilerprocs (+ small optimizations by using shift/and
|
||||||
where possible)
|
where possible)
|
||||||
|
|||||||
@ -27,10 +27,11 @@
|
|||||||
|
|
||||||
|
|
||||||
{ the reverse order of the parameters make code generation easier }
|
{ the reverse order of the parameters make code generation easier }
|
||||||
procedure fpc_do_as(aclass : tclass;aobject : tobject);[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
function fpc_do_as(aclass : tclass;aobject : tobject): tobject;[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||||
begin
|
begin
|
||||||
if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
|
if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then
|
||||||
handleerror(219);
|
handleerrorframe(219,get_frame);
|
||||||
|
result := aobject;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifndef HASINTF}
|
{$ifndef HASINTF}
|
||||||
@ -692,7 +693,15 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.16 2001-08-01 15:00:10 jonas
|
Revision 1.17 2001-09-29 21:32:47 jonas
|
||||||
|
* almost all second pass typeconvnode helpers are now processor independent
|
||||||
|
* fixed converting boolean to int64/qword
|
||||||
|
* fixed register allocation bugs which could cause internalerror 10
|
||||||
|
* isnode and asnode are completely processor indepent now as well
|
||||||
|
* fpc_do_as now returns its class argument (necessary to be able to use it
|
||||||
|
properly with compilerproc)
|
||||||
|
|
||||||
|
Revision 1.16 2001/08/01 15:00:10 jonas
|
||||||
+ "compproc" helpers
|
+ "compproc" helpers
|
||||||
* renamed several helpers so that their name is the same as their
|
* renamed several helpers so that their name is the same as their
|
||||||
"public alias", which should facilitate the conversion of processor
|
"public alias", which should facilitate the conversion of processor
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user