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

+ type cast variant<->enum

Browse Source 
* cnv. node second pass uses now as well helper wrappers
This commit is contained in:
florian 2003-11-04 22:30:15 +00:00
parent 573315745d
commit 8b337fb5ef
7 changed files with 330 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
compiler/arm/narmcnv.pas
View File

@ -53,7 +53,6 @@ interface
{ procedure second_pchar_to_string;override; }
{ procedure second_class_to_intf;override; }
{ procedure second_char_to_char;override; }
procedure second_call_helper(c : tconverttype); override;
end;
implementation
@ -124,67 +123,16 @@ implementation
end;
procedure tarmtypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_int, { bool_to_bool }
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_nothing, { real_to_currency, handled in resulttype pass }
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing,
@second_nothing, { variant_2_dynarray }
@second_nothing { dynarray_2_variant}
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
end;
begin
ctypeconvnode:=tarmtypeconvnode;
end.
{
$Log$
Revision 1.5 2003-11-02 14:30:03 florian
Revision 1.6 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.5 2003/11/02 14:30:03 florian
* fixed ARM for new reg. allocation scheme
Revision 1.4 2003/09/01 15:11:16 florian

37
compiler/defcmp.pas
View File

@ -72,7 +72,9 @@ interface
tc_dynarray_2_openarray,
tc_pwchar_2_string,
tc_variant_2_dynarray,
tc_dynarray_2_variant
tc_dynarray_2_variant,
tc_variant_2_enum,
tc_enum_2_variant
);
function compare_defs_ext(def_from,def_to : tdef;
@ -442,6 +444,11 @@ implementation
doconv:=tc_int_2_int;
end;
end;
variantdef :
begin
eq:=te_convert_l1;
doconv:=tc_variant_2_enum;
end;
end;
end;
@ -606,6 +613,24 @@ implementation
end;
end;
end;
variantdef :
begin
case def_from.deftype of
enumdef :
begin
doconv:=tc_enum_2_variant;
eq:=te_convert_l1;
end;
arraydef :
begin
if is_dynamic_array(def_from) then
begin
doconv:=tc_dynarray_2_variant;
eq:=te_convert_l1;
end;
end;
end;
end;
pointerdef :
begin
@ -983,8 +1008,8 @@ implementation
end;
end;
{ if we didn't find an appropriate type conversion yet and
there is a variant involved then we search also the := operator }
{ if we didn't find an appropriate type conversion yet
then we search also the := operator }
if (eq=te_incompatible) and
check_operator and
((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
@ -1223,7 +1248,11 @@ implementation
end.
{
$Log$
Revision 1.35 2003-10-30 16:23:13 peter
Revision 1.36 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.35 2003/10/30 16:23:13 peter
* don't search for overloads in parents for constructors
Revision 1.34 2003/10/26 14:11:35 florian

102
compiler/i386/n386cnv.pas
View File

@ -55,7 +55,6 @@ interface
{$ifdef TESTOBJEXT2}
procedure checkobject;override;
{$endif TESTOBJEXT2}
procedure second_call_helper(c : tconverttype);override;
end;
@ -232,107 +231,16 @@ implementation
{$endif TESTOBJEXT2}
procedure ti386typeconvnode.second_call_helper(c : tconverttype);
{$ifdef fpc}
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_bool,
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_nothing, { real_to_currency, handled in resulttype pass }
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing, { pwchar_2_string }
@second_nothing, { variant_2_dynarray }
@second_nothing { dynarray_2_variant}
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r)();
end;
{$else fpc}
begin
case c of
tc_equal,
tc_not_possible,
tc_string_2_string : second_nothing;
tc_char_2_string : second_char_to_string;
tc_char_2_chararray : second_nothing;
tc_pchar_2_string : second_nothing;
tc_cchar_2_pchar : second_nothing;
tc_cstring_2_pchar : second_cstring_to_pchar;
tc_ansistring_2_pchar : second_ansistring_to_pchar;
tc_string_2_chararray : second_string_to_chararray;
tc_chararray_2_string : second_nothing;
tc_array_2_pointer : second_array_to_pointer;
tc_pointer_2_array : second_pointer_to_array;
tc_int_2_int : second_int_to_int;
tc_int_2_bool : second_int_to_bool;
tc_bool_2_bool : second_bool_to_bool;
tc_bool_2_int : second_bool_to_int;
tc_real_2_real : second_real_to_real;
tc_int_2_real : second_int_to_real;
tc_real_2_currency : second_nothing;
tc_proc_2_procvar : second_proc_to_procvar;
tc_arrayconstructor_2_set : second_nothing;
tc_load_smallset : second_nothing;
tc_cord_2_pointer : second_cord_to_pointer;
tc_intf_2_string : second_nothing;
tc_intf_2_guid : second_nothing;
tc_class_2_intf : second_class_to_intf;
tc_char_2_char : second_char_to_char;
tc_normal_2_smallset : second_nothing;
tc_dynarray_2_openarray : second_nothing;
tc_pwchar_2_string : second_nothing;
tc_variant_2_dynarray : second_nothing;
tc_dynarray_2_variant : second_nothing;
else internalerror(2002101101);
end;
end;
{$endif fpc}
begin
ctypeconvnode:=ti386typeconvnode;
end.
{
$Log$
Revision 1.67 2003-10-10 17:48:14 peter
Revision 1.68 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.67 2003/10/10 17:48:14 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

7
compiler/ncgcnv.pas
View File

@ -50,7 +50,6 @@ interface
{$ifdef TESTOBJEXT2}
procedure checkobject;virtual;
{$endif TESTOBJEXT2}
procedure second_call_helper(c : tconverttype);virtual;abstract;
procedure pass_2;override;
end;
@ -515,7 +514,11 @@ end.
{
$Log$
Revision 1.49 2003-10-10 17:48:13 peter
Revision 1.50 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.49 2003/10/10 17:48:13 peter
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
* tregisteralloctor renamed to trgobj
* removed rgobj from a lot of units

274
compiler/ncnv.pas
View File

@ -51,6 +51,7 @@ interface
function det_resulttype:tnode;override;
procedure mark_write;override;
function docompare(p: tnode) : boolean; override;
procedure second_call_helper(c : tconverttype);
private
function resulttype_int_to_int : tnode;
function resulttype_cord_to_pointer : tnode;
@ -73,6 +74,8 @@ interface
function resulttype_variant_to_dynarray : tnode;
function resulttype_dynarray_to_variant : tnode;
function resulttype_call_helper(c : tconverttype) : tnode;
function resulttype_variant_to_enum : tnode;
function resulttype_enum_to_variant : tnode;
protected
function first_int_to_int : tnode;virtual;
function first_cstring_to_pchar : tnode;virtual;
@ -120,6 +123,27 @@ interface
function _first_class_to_intf : tnode;
function _first_char_to_char : tnode;
procedure _second_int_to_int;virtual;
procedure _second_string_to_string;virtual;
procedure _second_cstring_to_pchar;virtual;
procedure _second_string_to_chararray;virtual;
procedure _second_array_to_pointer;virtual;
procedure _second_pointer_to_array;virtual;
procedure _second_chararray_to_string;virtual;
procedure _second_char_to_string;virtual;
procedure _second_int_to_real;virtual;
procedure _second_real_to_real;virtual;
procedure _second_cord_to_pointer;virtual;
procedure _second_proc_to_procvar;virtual;
procedure _second_bool_to_int;virtual;
procedure _second_int_to_bool;virtual;
procedure _second_bool_to_bool;virtual;
procedure _second_load_smallset;virtual;
procedure _second_ansistring_to_pchar;virtual;
procedure _second_class_to_intf;virtual;
procedure _second_char_to_char;virtual;
procedure _second_nothing; virtual;
procedure second_int_to_int;virtual;abstract;
procedure second_string_to_string;virtual;abstract;
procedure second_cstring_to_pchar;virtual;abstract;
@ -984,6 +1008,28 @@ implementation
end;
function ttypeconvnode.resulttype_variant_to_enum : tnode;
begin
result := ctypeconvnode.create_explicit(left,defaultordconsttype);
result := ctypeconvnode.create_explicit(result,resulttype);
resulttypepass(result);
{ left is reused }
left := nil;
end;
function ttypeconvnode.resulttype_enum_to_variant : tnode;
begin
result := ctypeconvnode.create_explicit(left,defaultordconsttype);
result := ctypeconvnode.create_explicit(result,cvarianttype);
resulttypepass(result);
{ left is reused }
left := nil;
end;
function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
{$ifdef fpc}
const
@ -1020,7 +1066,9 @@ implementation
{ dynarray_2_openarray} @resulttype_dynarray_to_openarray,
{ pwchar_2_string} @resulttype_pwchar_to_string,
{ variant_2_dynarray} @resulttype_variant_to_dynarray,
{ dynarray_2_variant} @resulttype_dynarray_to_variant
{ dynarray_2_variant} @resulttype_dynarray_to_variant,
{ variant_2_enum} @resulttype_variant_to_enum,
{ enum_2_variant} @resulttype_enum_to_variant
);
type
tprocedureofobject = function : tnode of object;
@ -1801,6 +1849,8 @@ implementation
@ttypeconvnode._first_nothing,
nil,
nil,
nil,
nil,
nil
);
type
@ -1857,6 +1907,222 @@ implementation
end;
procedure ttypeconvnode._second_int_to_int;
begin
second_int_to_int;
end;
procedure ttypeconvnode._second_string_to_string;
begin
second_string_to_string;
end;
procedure ttypeconvnode._second_cstring_to_pchar;
begin
second_cstring_to_pchar;
end;
procedure ttypeconvnode._second_string_to_chararray;
begin
second_string_to_chararray;
end;
procedure ttypeconvnode._second_array_to_pointer;
begin
second_array_to_pointer;
end;
procedure ttypeconvnode._second_pointer_to_array;
begin
second_pointer_to_array;
end;
procedure ttypeconvnode._second_chararray_to_string;
begin
second_chararray_to_string;
end;
procedure ttypeconvnode._second_char_to_string;
begin
second_char_to_string;
end;
procedure ttypeconvnode._second_int_to_real;
begin
second_int_to_real;
end;
procedure ttypeconvnode._second_real_to_real;
begin
second_real_to_real;
end;
procedure ttypeconvnode._second_cord_to_pointer;
begin
second_cord_to_pointer;
end;
procedure ttypeconvnode._second_proc_to_procvar;
begin
second_proc_to_procvar;
end;
procedure ttypeconvnode._second_bool_to_int;
begin
second_bool_to_int;
end;
procedure ttypeconvnode._second_int_to_bool;
begin
second_int_to_bool;
end;
procedure ttypeconvnode._second_bool_to_bool;
begin
second_bool_to_bool;
end;
procedure ttypeconvnode._second_load_smallset;
begin
second_load_smallset;
end;
procedure ttypeconvnode._second_ansistring_to_pchar;
begin
second_ansistring_to_pchar;
end;
procedure ttypeconvnode._second_class_to_intf;
begin
second_class_to_intf;
end;
procedure ttypeconvnode._second_char_to_char;
begin
second_char_to_char;
end;
procedure ttypeconvnode._second_nothing;
begin
second_nothing;
end;
procedure ttypeconvnode.second_call_helper(c : tconverttype);
{$ifdef fpc}
const
secondconvert : array[tconverttype] of pointer = (
@_second_nothing, {equal}
@_second_nothing, {not_possible}
@_second_nothing, {second_string_to_string, handled in resulttype pass }
@_second_char_to_string,
@_second_nothing, {char_to_charray}
@_second_nothing, { pchar_to_string, handled in resulttype pass }
@_second_nothing, {cchar_to_pchar}
@_second_cstring_to_pchar,
@_second_ansistring_to_pchar,
@_second_string_to_chararray,
@_second_nothing, { chararray_to_string, handled in resulttype pass }
@_second_array_to_pointer,
@_second_pointer_to_array,
@_second_int_to_int,
@_second_int_to_bool,
@_second_bool_to_bool,
@_second_bool_to_int,
@_second_real_to_real,
@_second_int_to_real,
@_second_nothing, { real_to_currency, handled in resulttype pass }
@_second_proc_to_procvar,
@_second_nothing, { arrayconstructor_to_set }
@_second_nothing, { second_load_smallset, handled in first pass }
@_second_cord_to_pointer,
@_second_nothing, { interface 2 string }
@_second_nothing, { interface 2 guid }
@_second_class_to_intf,
@_second_char_to_char,
@_second_nothing, { normal_2_smallset }
@_second_nothing, { dynarray_2_openarray }
@_second_nothing, { pwchar_2_string }
@_second_nothing, { variant_2_dynarray }
@_second_nothing, { dynarray_2_variant}
@_second_nothing, { variant_2_enum }
@_second_nothing { enum_2_variant }
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r)();
end;
{$else fpc}
begin
case c of
tc_equal,
tc_not_possible,
tc_string_2_string : second_nothing;
tc_char_2_string : second_char_to_string;
tc_char_2_chararray : second_nothing;
tc_pchar_2_string : second_nothing;
tc_cchar_2_pchar : second_nothing;
tc_cstring_2_pchar : second_cstring_to_pchar;
tc_ansistring_2_pchar : second_ansistring_to_pchar;
tc_string_2_chararray : second_string_to_chararray;
tc_chararray_2_string : second_nothing;
tc_array_2_pointer : second_array_to_pointer;
tc_pointer_2_array : second_pointer_to_array;
tc_int_2_int : second_int_to_int;
tc_int_2_bool : second_int_to_bool;
tc_bool_2_bool : second_bool_to_bool;
tc_bool_2_int : second_bool_to_int;
tc_real_2_real : second_real_to_real;
tc_int_2_real : second_int_to_real;
tc_real_2_currency : second_nothing;
tc_proc_2_procvar : second_proc_to_procvar;
tc_arrayconstructor_2_set : second_nothing;
tc_load_smallset : second_nothing;
tc_cord_2_pointer : second_cord_to_pointer;
tc_intf_2_string : second_nothing;
tc_intf_2_guid : second_nothing;
tc_class_2_intf : second_class_to_intf;
tc_char_2_char : second_char_to_char;
tc_normal_2_smallset : second_nothing;
tc_dynarray_2_openarray : second_nothing;
tc_pwchar_2_string : second_nothing;
tc_variant_2_dynarray : second_nothing;
tc_dynarray_2_variant : second_nothing;
else internalerror(2002101101);
end;
end;
{$endif fpc}
{*****************************************************************************
TISNODE
*****************************************************************************}
@ -2122,7 +2388,11 @@ begin
end.
{
$Log$
Revision 1.129 2003-10-31 18:42:03 peter
Revision 1.130 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.129 2003/10/31 18:42:03 peter
* don't call proc_to_procvar for explicit typecasts
Revision 1.128 2003/10/29 22:01:20 florian

63
compiler/powerpc/nppccnv.pas
View File

@ -53,7 +53,6 @@ interface
{ procedure second_class_to_intf;override; }
{ procedure second_char_to_char;override; }
procedure pass_2;override;
procedure second_call_helper(c : tconverttype); override;
end;
implementation
@ -349,62 +348,6 @@ implementation
end;
procedure tppctypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_int, { bool_to_bool }
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_nothing, { real_to_currency, handled in resulttype pass }
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing,
{$ifdef fpc}@{$endif}second_nothing, { variant_2_dynarray }
{$ifdef fpc}@{$endif}second_nothing { dynarray_2_variant}
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
end;
procedure tppctypeconvnode.pass_2;
{$ifdef TESTOBJEXT2}
var
@ -431,7 +374,11 @@ begin
end.
{
$Log$
Revision 1.44 2003-10-17 01:22:08 florian
Revision 1.45 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.44 2003/10/17 01:22:08 florian
* compilation of the powerpc compiler fixed
Revision 1.43 2003/10/01 20:34:49 peter

58
compiler/sparc/ncpucnv.pas
View File

@ -51,7 +51,6 @@ interface
{ procedure second_class_to_intf;override; }
{ procedure second_char_to_char;override; }
procedure pass_2;override;
procedure second_call_helper(c : tconverttype); override;
end;
implementation
@ -175,57 +174,6 @@ procedure TSparctypeconvnode.second_int_to_bool;
end;
procedure TSparctypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_int, { bool_to_bool }
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_nothing, { currency_to_real, handled in resulttype pass }
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing,
{$ifdef fpc}@{$endif}second_nothing, { variant_2_dynarray }
{$ifdef fpc}@{$endif}second_nothing { dynarray_2_variant}
);
type
tprocedureofobject = procedure of object;
var
r:packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
end;
procedure TSparctypeconvnode.pass_2;
{$ifdef TESTOBJEXT2}
var
@ -251,7 +199,11 @@ begin
end.
{
$Log$
Revision 1.20 2003-10-24 11:31:43 mazen
Revision 1.21 2003-11-04 22:30:15 florian
+ type cast variant<->enum
* cnv. node second pass uses now as well helper wrappers
Revision 1.20 2003/10/24 11:31:43 mazen
*fixes related to removal of rg
Revision 1.19 2003/10/01 20:34:50 peter