mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-07 15:01:27 +01:00
+ some widestring stuff added
This commit is contained in:
florian
parent
23b3c24a01
commit
fb40dcd0bb
@ -2001,7 +2001,9 @@ implementation
|
||||
hp:=templist;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if hp^.temptype in [tt_ansistring,tt_freeansistring,tt_interfacecom] then
|
||||
if hp^.temptype in [tt_ansistring,tt_freeansistring,
|
||||
tt_widestring,tt_freewidestring,
|
||||
tt_interfacecom] then
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
|
||||
new(r);
|
||||
@ -2032,6 +2034,15 @@ implementation
|
||||
emitpushreferenceaddr(hr);
|
||||
emitcall('FPC_ANSISTR_DECR_REF');
|
||||
end
|
||||
else if hp^.temptype in [tt_widestring,tt_freewidestring] then
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
|
||||
reset_reference(hr);
|
||||
hr.base:=procinfo^.framepointer;
|
||||
hr.offset:=hp^.pos;
|
||||
emitpushreferenceaddr(hr);
|
||||
emitcall('FPC_WIDESTR_DECR_REF');
|
||||
end
|
||||
else if hp^.temptype=tt_interfacecom then
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
|
||||
@ -2986,7 +2997,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 2001-04-21 13:33:16 peter
|
||||
Revision 1.24 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.23 2001/04/21 13:33:16 peter
|
||||
* move winstackpagesize const to cgai386 to remove uses t_win32
|
||||
|
||||
Revision 1.22 2001/04/21 12:05:32 peter
|
||||
|
||||
@ -42,7 +42,7 @@ interface
|
||||
|
||||
uses
|
||||
globtype,systems,
|
||||
cutils,verbose,globals,
|
||||
cutils,verbose,globals,widestr,
|
||||
symconst,symdef,aasm,types,
|
||||
hcodegen,temp_gen,pass_2,
|
||||
cpuasm,
|
||||
@ -143,6 +143,7 @@ interface
|
||||
if nf_swaped in flags then
|
||||
swapleftright;
|
||||
case tstringdef(left.resulttype.def).string_typ of
|
||||
st_widestring,
|
||||
st_ansistring:
|
||||
begin
|
||||
case nodetype of
|
||||
@ -176,11 +177,12 @@ interface
|
||||
emit_push_loc(right.location);
|
||||
emit_push_loc(left.location);
|
||||
saveregvars($ff);
|
||||
emitcall('FPC_ANSISTR_CONCAT');
|
||||
if tstringdef(left.resulttype.def).string_typ=st_widestring then
|
||||
emitcall('FPC_WIDESTR_CONCAT')
|
||||
else
|
||||
emitcall('FPC_ANSISTR_CONCAT');
|
||||
popusedregisters(pushedregs);
|
||||
maybe_loadself;
|
||||
ungetiftempansi(left.location.reference);
|
||||
ungetiftempansi(right.location.reference);
|
||||
end;
|
||||
ltn,lten,gtn,gten,
|
||||
equaln,unequaln:
|
||||
@ -200,8 +202,6 @@ interface
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
emit_const_reg(A_CMP,S_L,0,right.location.register);
|
||||
end;
|
||||
ungetiftempansi(left.location.reference);
|
||||
ungetiftempansi(right.location.reference);
|
||||
end
|
||||
else if (nodetype in [equaln,unequaln]) and
|
||||
(right.nodetype=stringconstn) and
|
||||
@ -217,8 +217,6 @@ interface
|
||||
LOC_REGISTER,LOC_CREGISTER:
|
||||
emit_const_reg(A_CMP,S_L,0,left.location.register);
|
||||
end;
|
||||
ungetiftempansi(left.location.reference);
|
||||
ungetiftempansi(right.location.reference);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -246,16 +244,27 @@ interface
|
||||
emit_reg(A_PUSH,S_L,left.location.register);
|
||||
end;
|
||||
saveregvars($ff);
|
||||
emitcall('FPC_ANSISTR_COMPARE');
|
||||
if tstringdef(left.resulttype.def).string_typ=st_widestring then
|
||||
emitcall('FPC_WIDESTR_COMPARE')
|
||||
else
|
||||
emitcall('FPC_ANSISTR_COMPARE');
|
||||
emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
|
||||
popusedregisters(pushedregs);
|
||||
maybe_loadself;
|
||||
ungetiftempansi(left.location.reference);
|
||||
ungetiftempansi(right.location.reference);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{ the result of ansicompare is signed }
|
||||
if tstringdef(left.resulttype.def).string_typ=st_widestring then
|
||||
begin
|
||||
ungetiftempwidestr(left.location.reference);
|
||||
ungetiftempwidestr(right.location.reference);
|
||||
end
|
||||
else
|
||||
begin
|
||||
ungetiftempansi(left.location.reference);
|
||||
ungetiftempansi(right.location.reference);
|
||||
end;
|
||||
{ the result of wide/ansicompare is signed :/ }
|
||||
SetResultLocation(cmpop,false);
|
||||
end;
|
||||
st_shortstring:
|
||||
@ -2276,7 +2285,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2001-05-06 17:12:14 jonas
|
||||
Revision 1.13 2001-05-27 14:30:56 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.12 2001/05/06 17:12:14 jonas
|
||||
* fixed an IE10 and another bug with [var1..var2] construct
|
||||
|
||||
Revision 1.11 2001/04/13 01:22:18 peter
|
||||
|
||||
@ -479,7 +479,8 @@ implementation
|
||||
{$endif test_dest_loc}
|
||||
if left.resulttype.def.deftype=stringdef then
|
||||
begin
|
||||
if is_ansistring(left.resulttype.def) then
|
||||
if is_ansistring(left.resulttype.def) or
|
||||
is_widestring(left.resulttype.def) then
|
||||
begin
|
||||
{ before pushing any parameter, we have to save all used }
|
||||
{ registers, but before that we have to release the }
|
||||
@ -516,7 +517,10 @@ implementation
|
||||
emitpushreferenceaddr(left.location.reference);
|
||||
del_reference(left.location.reference);
|
||||
saveregvars($ff);
|
||||
emitcall('FPC_ANSISTR_ASSIGN');
|
||||
if is_ansistring(left.resulttype.def) then
|
||||
emitcall('FPC_ANSISTR_ASSIGN')
|
||||
else
|
||||
emitcall('FPC_WIDESTR_ASSIGN');
|
||||
maybe_loadself;
|
||||
popusedregisters(regspushed);
|
||||
if ungettemp then
|
||||
@ -550,6 +554,7 @@ implementation
|
||||
end
|
||||
else if is_longstring(left.resulttype.def) then
|
||||
begin
|
||||
internalerror(200105261);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -1068,7 +1073,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-04-13 01:22:19 peter
|
||||
Revision 1.14 2001-05-27 14:30:56 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.13 2001/04/13 01:22:19 peter
|
||||
* symtable change to classes
|
||||
* range check generation and errors fixed, make cycle DEBUG=1 works
|
||||
* memory leaks fixed
|
||||
|
||||
@ -54,6 +54,7 @@ type
|
||||
procedure CreateIdx;
|
||||
function GetPChar(nr:longint):pchar;
|
||||
function Get(nr:longint):string;
|
||||
function Get4(nr:longint;const s1,s2,s3,s4:string):string;
|
||||
function Get3(nr:longint;const s1,s2,s3:string):string;
|
||||
function Get2(nr:longint;const s1,s2:string):string;
|
||||
function Get1(nr:longint;const s1:string):string;
|
||||
@ -405,6 +406,19 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TMessage.Get4(nr:longint;const s1,s2,s3,s4:string):string;
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
s:=Get(nr);
|
||||
Replace(s,'$1',s1);
|
||||
Replace(s,'$2',s2);
|
||||
Replace(s,'$3',s3);
|
||||
Replace(s,'$4',s3);
|
||||
Get4:=s;
|
||||
end;
|
||||
|
||||
|
||||
function TMessage.Get2(nr:longint;const s1,s2:string):string;
|
||||
var
|
||||
s : string;
|
||||
@ -429,7 +443,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2001-04-21 13:32:07 peter
|
||||
Revision 1.9 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.8 2001/04/21 13:32:07 peter
|
||||
* remove endless loop with replacements (merged)
|
||||
|
||||
Revision 1.7 2001/04/14 16:05:41 jonas
|
||||
|
||||
@ -47,7 +47,7 @@ implementation
|
||||
|
||||
uses
|
||||
globtype,systems,
|
||||
cutils,verbose,globals,
|
||||
cutils,verbose,globals,widestr,
|
||||
symconst,symtype,symdef,types,
|
||||
cpuinfo,
|
||||
{$ifdef newcg}
|
||||
@ -86,6 +86,8 @@ implementation
|
||||
i : longint;
|
||||
b : boolean;
|
||||
s1,s2 : pchar;
|
||||
ws1,ws2,
|
||||
ws3 : tcompilerwidestring;
|
||||
l1,l2 : longint;
|
||||
rv,lv : tconstexprint;
|
||||
rvd,lvd : bestreal;
|
||||
@ -133,6 +135,18 @@ implementation
|
||||
inserttypeconv(left,pbestrealtype^);
|
||||
end;
|
||||
|
||||
{ if one operand is a widechar or a widestring, both operands }
|
||||
{ are converted to widestring. This must be done before constant }
|
||||
{ folding to allow char+widechar etc. }
|
||||
if is_widestring(right.resulttype.def) or
|
||||
is_widestring(left.resulttype.def) or
|
||||
is_widechar(right.resulttype.def) or
|
||||
is_widechar(left.resulttype.def) then
|
||||
begin
|
||||
inserttypeconv(right,cwidestringtype);
|
||||
inserttypeconv(left,cwidestringtype);
|
||||
end;
|
||||
|
||||
{ load easier access variables }
|
||||
rd:=right.resulttype.def;
|
||||
ld:=left.resulttype.def;
|
||||
@ -294,10 +308,53 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ concating strings ? }
|
||||
{ first, we handle widestrings, so we can check later for }
|
||||
{ stringconstn only }
|
||||
|
||||
{ widechars are converted above to widestrings too }
|
||||
{ this isn't veryy efficient, but I don't think }
|
||||
{ that it does matter that much (FK) }
|
||||
if (lt=stringconstn) and (rt=stringconstn) and
|
||||
(tstringconstnode(left).st_type=st_widestring) and
|
||||
(tstringconstnode(right).st_type=st_widestring) then
|
||||
begin
|
||||
initwidestring(ws1);
|
||||
initwidestring(ws2);
|
||||
copywidestring(pcompilerwidestring(tstringconstnode(left).value_str)^,ws1);
|
||||
copywidestring(pcompilerwidestring(tstringconstnode(right).value_str)^,ws2);
|
||||
case nodetype of
|
||||
addn :
|
||||
begin
|
||||
initwidestring(ws3);
|
||||
concatwidestrings(ws1,ws2,ws3);
|
||||
t:=cstringconstnode.createwstr(ws3);
|
||||
donewidestring(ws3);
|
||||
end;
|
||||
ltn :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype);
|
||||
lten :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype);
|
||||
gtn :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype);
|
||||
gten :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype);
|
||||
equaln :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype);
|
||||
unequaln :
|
||||
t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype);
|
||||
end;
|
||||
donewidestring(ws1);
|
||||
donewidestring(ws2);
|
||||
resulttypepass(t);
|
||||
result:=t;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ concating strings ? }
|
||||
concatstrings:=false;
|
||||
s1:=nil;
|
||||
s2:=nil;
|
||||
|
||||
if (lt=ordconstn) and (rt=ordconstn) and
|
||||
is_char(ld) and is_char(rd) then
|
||||
begin
|
||||
@ -1217,7 +1274,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 2001-05-19 21:11:50 peter
|
||||
Revision 1.28 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.27 2001/05/19 21:11:50 peter
|
||||
* first check for overloaded operator before doing inserting any
|
||||
typeconvs
|
||||
|
||||
|
||||
@ -44,6 +44,7 @@ interface
|
||||
|
||||
pmacrobuffer = ^tmacrobuffer;
|
||||
tmacrobuffer = array[0..maxmacrolen-1] of char;
|
||||
tscannerfile = class;
|
||||
|
||||
tmacro = class(TNamedIndexItem)
|
||||
defined,
|
||||
@ -63,6 +64,7 @@ interface
|
||||
next : tpreprocstack;
|
||||
name : stringid;
|
||||
line_nb : longint;
|
||||
owner : tscannerfile;
|
||||
constructor Create(atyp:preproctyp;a:boolean;n:tpreprocstack);
|
||||
end;
|
||||
|
||||
@ -1198,7 +1200,8 @@ implementation
|
||||
{ check for missing ifdefs }
|
||||
while assigned(preprocstack) do
|
||||
begin
|
||||
Message3(scan_e_endif_expected,preprocstring[preprocstack.typ],preprocstack.name,tostr(preprocstack.line_nb));
|
||||
Message4(scan_e_endif_expected,preprocstring[preprocstack.typ],preprocstack.name,
|
||||
preprocstack.owner.inputfile.name^,tostr(preprocstack.line_nb));
|
||||
poppreprocstack;
|
||||
end;
|
||||
end;
|
||||
@ -1225,6 +1228,7 @@ implementation
|
||||
preprocstack:=tpreprocstack.create(atyp,((preprocstack=nil) or preprocstack.accept) and a,preprocstack);
|
||||
preprocstack.name:=s;
|
||||
preprocstack.line_nb:=line_no;
|
||||
preprocstack.owner:=self;
|
||||
if preprocstack.accept then
|
||||
Message2(w,preprocstack.name,'accepted')
|
||||
else
|
||||
@ -2589,7 +2593,10 @@ exit_label:
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 2001-04-13 22:12:34 peter
|
||||
Revision 1.17 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.16 2001/04/13 22:12:34 peter
|
||||
* fixed comment after comment parsing in assembler blocks
|
||||
|
||||
Revision 1.15 2001/04/13 18:00:36 peter
|
||||
|
||||
@ -41,6 +41,7 @@ interface
|
||||
ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,
|
||||
tt_ansistring,tt_freeansistring,tt_widestring,tt_freewidestring,
|
||||
tt_interfacecom,tt_freeinterfacecom);
|
||||
|
||||
ttemptypeset = set of ttemptype;
|
||||
|
||||
ptemprecord = ^ttemprecord;
|
||||
@ -91,6 +92,9 @@ interface
|
||||
function ungetiftempansi(const ref : treference) : boolean;
|
||||
procedure gettempansistringreference(var ref : treference);
|
||||
|
||||
function ungetiftempwidestr(const ref : treference) : boolean;
|
||||
procedure gettempwidestringreference(var ref : treference);
|
||||
|
||||
function ungetiftempintfcom(const ref : treference) : boolean;
|
||||
procedure gettempintfcomreference(var ref : treference);
|
||||
|
||||
@ -384,11 +388,21 @@ const
|
||||
gettemppointerreferencefortype(ref,tt_ansistring,tt_freeansistring);
|
||||
end;
|
||||
|
||||
procedure gettempwidestringreference(var ref : treference);
|
||||
begin
|
||||
gettemppointerreferencefortype(ref,tt_widestring,tt_freewidestring);
|
||||
end;
|
||||
|
||||
function ungetiftempansi(const ref : treference) : boolean;
|
||||
begin
|
||||
ungetiftempansi:=ungettemppointeriftype(ref,tt_ansistring,tt_freeansistring);
|
||||
end;
|
||||
|
||||
function ungetiftempwidestr(const ref : treference) : boolean;
|
||||
begin
|
||||
ungetiftempwidestr:=ungettemppointeriftype(ref,tt_widestring,tt_widestring);
|
||||
end;
|
||||
|
||||
|
||||
procedure gettempintfcomreference(var ref : treference);
|
||||
begin
|
||||
@ -591,7 +605,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-04-18 22:02:00 peter
|
||||
Revision 1.14 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.13 2001/04/18 22:02:00 peter
|
||||
* registration of targets and assemblers
|
||||
|
||||
Revision 1.12 2001/04/13 01:22:17 peter
|
||||
|
||||
@ -86,10 +86,12 @@ procedure Message(w:longint);
|
||||
procedure Message1(w:longint;const s1:string);
|
||||
procedure Message2(w:longint;const s1,s2:string);
|
||||
procedure Message3(w:longint;const s1,s2,s3:string);
|
||||
procedure Message4(w:longint;const s1,s2,s3,s4:string);
|
||||
procedure MessagePos(const pos:tfileposinfo;w:longint);
|
||||
procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string);
|
||||
procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string);
|
||||
procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string);
|
||||
procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string);
|
||||
|
||||
procedure InitVerbose;
|
||||
procedure DoneVerbose;
|
||||
@ -568,6 +570,13 @@ var
|
||||
end;
|
||||
|
||||
|
||||
procedure Message4(w:longint;const s1,s2,s3,s4:string);
|
||||
begin
|
||||
MaybeLoadMessageFile;
|
||||
Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
|
||||
end;
|
||||
|
||||
|
||||
procedure MessagePos(const pos:tfileposinfo;w:longint);
|
||||
var
|
||||
oldpos : tfileposinfo;
|
||||
@ -616,6 +625,18 @@ var
|
||||
end;
|
||||
|
||||
|
||||
procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string);
|
||||
var
|
||||
oldpos : tfileposinfo;
|
||||
begin
|
||||
oldpos:=aktfilepos;
|
||||
aktfilepos:=pos;
|
||||
MaybeLoadMessageFile;
|
||||
Msg2Comment(msg^.Get4(w,s1,s2,s3,s4));
|
||||
aktfilepos:=oldpos;
|
||||
end;
|
||||
|
||||
|
||||
procedure InitVerbose;
|
||||
begin
|
||||
{ Init }
|
||||
@ -651,7 +672,10 @@ var
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-04-13 01:22:17 peter
|
||||
Revision 1.14 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.13 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
|
||||
|
||||
@ -51,8 +51,9 @@ unit widestr;
|
||||
procedure setlengthwidestring(var r : tcompilerwidestring;l : longint);
|
||||
function getlengthwidestring(const r : tcompilerwidestring) : longint;
|
||||
procedure concatwidestringchar(var r : tcompilerwidestring;c : tcompilerwidechar);
|
||||
procedure concatwidestringwidestring(const s1,s2 : tcompilerwidestring;
|
||||
procedure concatwidestrings(const s1,s2 : tcompilerwidestring;
|
||||
var r : tcompilerwidestring);
|
||||
function comparewidestrings(const s1,s2 : tcompilerwidestring) : shortint;
|
||||
procedure copywidestring(const s : tcompilerwidestring;var d : tcompilerwidestring);
|
||||
function asciichar2unicode(c : char) : tcompilerwidechar;
|
||||
function unicode2asciichar(c : tcompilerwidechar) : char;
|
||||
@ -118,14 +119,14 @@ unit widestr;
|
||||
inc(r.len);
|
||||
end;
|
||||
|
||||
procedure concatwidestringwidestring(const s1,s2 : tcompilerwidestring;
|
||||
procedure concatwidestrings(const s1,s2 : tcompilerwidestring;
|
||||
var r : tcompilerwidestring);
|
||||
|
||||
begin
|
||||
setlengthwidestring(r,s1.len+s2.len);
|
||||
r.len:=s1.len+s2.len;
|
||||
move(s1.data^,r.data^,s1.len);
|
||||
move(s2.data^,r.data[s1.len],s2.len);
|
||||
move(s1.data^,r.data^,s1.len*2);
|
||||
move(s2.data^,r.data[s1.len],s2.len*2);
|
||||
end;
|
||||
|
||||
function comparewidestringwidestring(const s1,s2 : tcompilerwidestring) : longint;
|
||||
@ -143,6 +144,13 @@ unit widestr;
|
||||
move(s.data^,d.data^,s.len);
|
||||
end;
|
||||
|
||||
function comparewidestrings(const s1,s2 : tcompilerwidestring) : shortint;
|
||||
|
||||
begin
|
||||
{!!!!!! FIXME }
|
||||
comparewidestrings:=0;
|
||||
end;
|
||||
|
||||
function asciichar2unicode(c : char) : tcompilerwidechar;
|
||||
{!!!!!!!!
|
||||
var
|
||||
@ -196,7 +204,10 @@ unit widestr;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2001-05-08 21:06:33 florian
|
||||
Revision 1.5 2001-05-27 14:30:55 florian
|
||||
+ some widestring stuff added
|
||||
|
||||
Revision 1.4 2001/05/08 21:06:33 florian
|
||||
* some more support for widechars commited especially
|
||||
regarding type casting and constants
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user