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

* some more support for widechars commited especially

Browse Source 
regarding type casting and constants
This commit is contained in:
florian 2001-05-08 21:06:30 +00:00
parent 6d71c9dcdc
commit 05cfc07952
10 changed files with 180 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/fppu.pas
View File

@ -1143,11 +1143,14 @@ uses
end.
{
$Log$
Revision 1.2 2001-05-07 11:53:21 jonas
Revision 1.3 2001-05-08 21:06:30 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.2 2001/05/07 11:53:21 jonas
* fix from Peter for short_on_file_handles code
Revision 1.1 2001/05/06 14:49:17 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu
}

27
compiler/i386/n386cnv.pas
View File

@ -49,6 +49,7 @@ interface
procedure second_ansistring_to_pchar;virtual;
procedure second_pchar_to_string;virtual;
procedure second_class_to_intf;virtual;
procedure second_char_to_char;virtual;
procedure second_nothing;virtual;
procedure pass_2;override;
procedure second_call_helper(c : tconverttype);
@ -1081,6 +1082,23 @@ implementation
end;
procedure ti386typeconvnode.second_char_to_char;
var
hreg : tregister;
begin
case torddef(resulttype.def).typ of
uwidechar:
begin
internalerror(200105021);
end;
uchar:
begin
internalerror(200105022);
end;
end;
end;
procedure ti386typeconvnode.second_nothing;
begin
end;
@ -1118,7 +1136,8 @@ implementation
@ti386typeconvnode.second_cord_to_pointer,
@ti386typeconvnode.second_nothing, { interface 2 string }
@ti386typeconvnode.second_nothing, { interface 2 guid }
@ti386typeconvnode.second_class_to_intf
@ti386typeconvnode.second_class_to_intf,
@ti386typeconvnode.second_char_to_char
);
type
tprocedureofobject = procedure of object;
@ -1312,7 +1331,11 @@ begin
end.
{
$Log$
Revision 1.14 2001-04-13 01:22:18 peter
Revision 1.15 2001-05-08 21:06:33 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.14 2001/04/13 01:22:18 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed

86
compiler/ncnv.pas
View File

@ -47,6 +47,7 @@ interface
function resulttype_int_to_real : tnode;
function resulttype_real_to_real : tnode;
function resulttype_cchar_to_pchar : tnode;
function resulttype_char_to_char : tnode;
function resulttype_arrayconstructor_to_set : tnode;
function resulttype_call_helper(c : tconverttype) : tnode;
protected
@ -72,6 +73,7 @@ interface
function first_ansistring_to_pchar : tnode;virtual;
function first_arrayconstructor_to_set : tnode;virtual;
function first_class_to_intf : tnode;virtual;
function first_char_to_char : tnode;virtual;
function first_call_helper(c : tconverttype) : tnode;
end;
@ -99,7 +101,7 @@ implementation
uses
globtype,systems,tokens,
cutils,verbose,globals,
cutils,verbose,globals,widestr,
symconst,symdef,symsym,symtable,
ncon,ncal,nset,nadd,
{$ifdef newcg}
@ -450,6 +452,28 @@ implementation
end;
function ttypeconvnode.resulttype_char_to_char : tnode;
var
hp : tordconstnode;
begin
result:=nil;
if torddef(resulttype.def).typ=uchar then
begin
hp:=cordconstnode.create(
ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value))),cchartype);
resulttypepass(hp);
result:=hp;
end
else
begin
hp:=cordconstnode.create(
asciichar2unicode(chr(tordconstnode(left).value)),cwidechartype);
resulttypepass(hp);
result:=hp;
end;
end;
function ttypeconvnode.resulttype_int_to_real : tnode;
var
t : trealconstnode;
@ -535,7 +559,8 @@ implementation
{ cord_2_pointer } @ttypeconvnode.resulttype_cord_to_pointer,
{ intf_2_string } nil,
{ intf_2_guid } nil,
{ class_2_intf } nil
{ class_2_intf } nil,
{ char_2_char } @ttypeconvnode.resulttype_char_to_char
);
type
tprocedureofobject = function : tnode of object;
@ -750,6 +775,25 @@ implementation
end;
end
{Are we typecasting an ordconst to a wchar?}
else
if is_widechar(resulttype.def) and
is_ordinal(left.resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,resulttype);
resulttypepass(hp);
result:=hp;
exit;
end
else
begin
if IsConvertable(left.resulttype.def,u16bittype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ char to ordinal }
else
if is_char(left.resulttype.def) and
@ -768,6 +812,24 @@ implementation
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ widechar to ordinal }
else
if is_widechar(left.resulttype.def) and
is_ordinal(resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,resulttype);
resulttypepass(hp);
result:=hp;
exit;
end
else
begin
if IsConvertable(u16bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ only if the same size or formal def }
{ why do we allow typecasting of voiddef ?? (PM) }
@ -788,7 +850,7 @@ implementation
end;
{ the conversion into a strutured type is only }
{ possible, if the source is no register }
{ possible, if the source is not a register }
if ((resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
((resulttype.def.deftype=objectdef) and not(is_class(resulttype.def)))
) and (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
@ -1022,6 +1084,15 @@ implementation
end;
function ttypeconvnode.first_char_to_char : tnode;
begin
first_char_to_char:=nil;
location.loc:=LOC_REGISTER;
if registers32<1 then
registers32:=1;
end;
function ttypeconvnode.first_proc_to_procvar : tnode;
begin
first_proc_to_procvar:=nil;
@ -1099,7 +1170,8 @@ implementation
@ttypeconvnode.first_cord_to_pointer,
@ttypeconvnode.first_nothing,
@ttypeconvnode.first_nothing,
@ttypeconvnode.first_class_to_intf
@ttypeconvnode.first_class_to_intf,
@ttypeconvnode.first_char_to_char
);
type
tprocedureofobject = function : tnode of object;
@ -1291,7 +1363,11 @@ begin
end.
{
$Log$
Revision 1.26 2001-05-04 15:52:03 florian
Revision 1.27 2001-05-08 21:06:30 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.26 2001/05/04 15:52:03 florian
* some Delphi incompatibilities fixed:
- out, dispose and new can be used as idenfiers now
- const p = apointerype(nil); is supported now

14
compiler/ncon.pas
View File

@ -121,6 +121,7 @@ interface
function is_constrealnode(p : tnode) : boolean;
function is_constboolnode(p : tnode) : boolean;
function is_constresourcestringnode(p : tnode) : boolean;
function is_constwidecharnode(p : tnode) : boolean;
function str_length(p : tnode) : longint;
function is_emptyset(p : tnode):boolean;
function genconstsymtree(p : tconstsym) : tnode;
@ -194,6 +195,13 @@ implementation
end;
function is_constwidecharnode(p : tnode) : boolean;
begin
is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resulttype.def);
end;
function is_constrealnode(p : tnode) : boolean;
begin
@ -644,7 +652,11 @@ begin
end.
{
$Log$
Revision 1.17 2001-04-13 01:22:09 peter
Revision 1.18 2001-05-08 21:06:30 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.17 2001/04/13 01:22:09 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed

8
compiler/pdecl.pas
View File

@ -87,6 +87,8 @@ implementation
hp:=tconstsym.create(name,constchar,tordconstnode(p).value)
else if is_constboolnode(p) then
hp:=tconstsym.create(name,constbool,tordconstnode(p).value)
else if is_constwidecharnode(p) then
hp:=tconstsym.create(name,constwchar,tordconstnode(p).value)
else if p.resulttype.def.deftype=enumdef then
hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype)
else if p.resulttype.def.deftype=pointerdef then
@ -541,7 +543,11 @@ implementation
end.
{
$Log$
Revision 1.29 2001-04-13 01:22:11 peter
Revision 1.30 2001-05-08 21:06:31 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.29 2001/04/13 01:22:11 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed

8
compiler/pdecsub.pas
View File

@ -115,7 +115,7 @@ implementation
{ Delphi/Kylix supports nonsense like }
{ procedure p(); }
if try_to_consume(_RKLAMMER) and
not(m_tp in aktmodeswitches) then
not(m_tp7 in aktmodeswitches) then
exit;
inc(testcurobject);
repeat
@ -1851,7 +1851,11 @@ const
end.
{
$Log$
Revision 1.23 2001-05-08 14:32:58 jonas
Revision 1.24 2001-05-08 21:06:31 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.23 2001/05/08 14:32:58 jonas
* fixed bug for overloaded operators with a return type that has a size
which isn't a multiple of the target_os.stackalignment (main branch
patch from Peter)

8
compiler/symconst.pas
View File

@ -405,7 +405,7 @@ type
tconsttyp = (constnone,
constord,conststring,constreal,constbool,
constint,constchar,constset,constpointer,constnil,
constresourcestring
constresourcestring,constwstring,constwchar
);
{$ifdef GDB}
@ -451,7 +451,11 @@ implementation
end.
{
$Log$
Revision 1.16 2001-04-13 01:22:15 peter
Revision 1.17 2001-05-08 21:06:31 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.16 2001/04/13 01:22:15 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed

7
compiler/symsym.pas
View File

@ -1931,6 +1931,7 @@ implementation
end
else
value:=ppufile.getlongint;
constwchar,
constbool,
constchar :
value:=ppufile.getlongint;
@ -2328,7 +2329,11 @@ implementation
end.
{
$Log$
Revision 1.12 2001-05-06 14:49:17 peter
Revision 1.13 2001-05-08 21:06:32 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.12 2001/05/06 14:49:17 peter
* ppu object to class rewrite
* move ppu read and write stuff to fppu

24
compiler/types.pas
View File

@ -59,6 +59,9 @@ interface
{ true if p is a char }
function is_char(def : tdef) : boolean;
{ true if p is a widechar }
function is_widechar(def : tdef) : boolean;
{ true if p is a void}
function is_void(def : tdef) : boolean;
@ -180,7 +183,8 @@ interface
tc_cord_2_pointer,
tc_intf_2_string,
tc_intf_2_guid,
tc_class_2_intf
tc_class_2_intf,
tc_char_2_char
);
function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
@ -516,6 +520,14 @@ implementation
end;
{ true if p is a wchar }
function is_widechar(def : tdef) : boolean;
begin
is_widechar:=(def.deftype=orddef) and
(torddef(def).typ=uwidechar);
end;
{ true if p is signed (integer) }
function is_signed(def : tdef) : boolean;
var
@ -1217,7 +1229,7 @@ implementation
u8bit,u16bit,u32bit,
s8bit,s16bit,s32,
bool8bit,bool16bit,bool32bit,
u64bit,s64bitint }
u64bit,s64bitint,uwidechar }
type
tbasedef=(bvoid,bchar,bint,bbool);
const
@ -1229,7 +1241,7 @@ implementation
basedefconverts : array[tbasedef,tbasedef] of tconverttype =
((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_char_2_char,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
(tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
@ -1733,7 +1745,11 @@ implementation
end.
{
$Log$
Revision 1.41 2001-04-22 22:46:49 florian
Revision 1.42 2001-05-08 21:06:33 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.41 2001/04/22 22:46:49 florian
* more variant support
Revision 1.40 2001/04/18 22:02:00 peter

12
compiler/widestr.pas
View File

@ -55,6 +55,7 @@ unit widestr;
var r : tcompilerwidestring);
procedure copywidestring(const s : tcompilerwidestring;var d : tcompilerwidestring);
function asciichar2unicode(c : char) : tcompilerwidechar;
function unicode2asciichar(c : tcompilerwidechar) : char;
procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
function getcharwidestring(const r : tcompilerwidestring;l : longint) : tcompilerwidechar;
function cpavailable(const s : string) : boolean;
@ -157,6 +158,11 @@ unit widestr;
asciichar2unicode:=0;
end;
function unicode2asciichar(c : tcompilerwidechar) : char;
begin
end;
procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
(*
var
@ -190,7 +196,11 @@ unit widestr;
end.
{
$Log$
Revision 1.3 2001-04-13 01:22:17 peter
Revision 1.4 2001-05-08 21:06:33 florian
* some more support for widechars commited especially
regarding type casting and constants
Revision 1.3 2001/04/13 01:22:17 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed