paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 17:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Make compilerwidestring a class using dyn array, rework tstringconstnode: value_str -> valueas, valuews

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-03-20 15:47:56 +01:00
parent f7edf0355a
commit 8c5a48da2b
34 changed files with 415 additions and 294 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/aasmcnst.pas
View File

@ -27,7 +27,7 @@ unit aasmcnst;
interface
uses
cclasses,globtype,constexp,
cclasses,globtype,constexp,widestr,
aasmbase,aasmdata,aasmtai,
symconst,symbase,symtype,symdef,symsym;
@ -351,7 +351,7 @@ type
{ the datalist parameter specifies where the data for the string constant
will be emitted (via an internal data builder) }
function emit_ansistring_const(datalist: TAsmList; data: pchar; len: asizeint; encoding: tstringencoding): tasmlabofs;
function emit_unicodestring_const(datalist: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
function emit_unicodestring_const(datalist: TAsmList; data: tcompilerwidestring; encoding: tstringencoding; winlike: boolean):tasmlabofs;
{ emits a tasmlabofs as returned by emit_*string_const }
procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
@ -524,7 +524,7 @@ implementation
uses
cutils,
verbose,globals,systems,widestr,
verbose,globals,systems,
fmodule,
symtable,symutil,defutil;
@ -1709,24 +1709,23 @@ implementation
ansistrrecdef: trecorddef;
datadef: tdef;
datatcb: ttai_typedconstbuilder;
ts : Tai_string;
begin
start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
result:=datatcb.emit_string_const_common(st_ansistring,len,encoding,startlab);
getmem(s,len+1);
move(data^,s^,len);
s[len]:=#0;
{ terminating zero included }
datadef:=carraydef.getreusable(cansichartype,len+1);
datatcb.maybe_begin_aggregate(datadef);
datatcb.emit_tai(tai_string.create_pchar(s,len+1),datadef);
ts:=tai_string.create_pchar(data,len);
datatcb.emit_tai(ts,datadef);
datatcb.maybe_end_aggregate(datadef);
ansistrrecdef:=datatcb.end_anonymous_record;
finish_internal_data_builder(datatcb,startlab,ansistrrecdef,const_align(voidpointertype.alignment));
end;
function ttai_typedconstbuilder.emit_unicodestring_const(datalist: TAsmList; data: pointer; encoding: tstringencoding; winlike: boolean):tasmlabofs;
function ttai_typedconstbuilder.emit_unicodestring_const(datalist: TAsmList; data: tcompilerwidestring; encoding: tstringencoding; winlike: boolean):tasmlabofs;
var
i, strlength: longint;
string_symofs: asizeint;
@ -1736,7 +1735,7 @@ implementation
unicodestrrecdef: trecorddef;
begin
start_internal_data_builder(datalist,sec_rodata_norel,'',datatcb,startlab);
strlength:=getlengthwidestring(pcompilerwidestring(data));
strlength:=getlengthwidestring(data);
if winlike then
begin
result.lab:=startlab;
@ -1768,7 +1767,7 @@ implementation
datadef:=carraydef.getreusable(cwidechartype,strlength+1);
datatcb.maybe_begin_aggregate(datadef);
for i:=0 to strlength-1 do
datatcb.emit_tai(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i]),cwidechartype);
datatcb.emit_tai(Tai_const.Create_16bit(data.data[i]),cwidechartype);
{ ending #0 }
datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
datatcb.maybe_end_aggregate(datadef);

9
compiler/aasmtai.pas
View File

@ -544,7 +544,7 @@ interface
top_single : (sval:single);
top_double : (dval:double);
top_string : (pcvallen: aint; pcval: pchar);
top_wstring : (pwstrval: pcompilerwidestring);
top_wstring : (pwstrval: tcompilerwidestring);
{$endif jvm}
{$ifdef llvm}
top_single : (sval:single);
@ -2450,8 +2450,9 @@ implementation
inherited Create;
typ:=ait_string;
setlength(str,length+1);
move(_str^,str[0],length);
str[length]:=#0;
if length>0 then
move(_str^,str[0],length);
end;
@ -2468,7 +2469,7 @@ implementation
inherited ppuload(t,ppufile);
lNewLen:=ppufile.getlongint;
setlength(str,lNewLen+1);
ppufile.getdata(str);
ppufile.getdata(str[0],lnewlen);
str[lNewLen]:=#0;
end;
@ -2478,7 +2479,7 @@ implementation
lWriteLen : integer;
begin
inherited ppuwrite(ppufile);
lWriteLen:=length(str);
lWriteLen:=length(str)-1;
ppufile.putlongint(lWriteLen);
ppufile.putdata(str[0],lWriteLen);
end;

2
compiler/aggas.pas
View File

@ -874,8 +874,8 @@ implementation
i,pos,l : longint;
InlineLevel : cardinal;
last_align : longint;
do_line : boolean;
do_line : boolean;
sepChar : char;
replaceforbidden: boolean;
begin

20
compiler/cresstr.pas
View File

@ -45,7 +45,7 @@ uses
Sym : TConstSym;
Name : String;
AValue : TAnsiCharDynArray;
WValue : pcompilerwidestring; // just a reference, do not free.
WValue : tcompilerwidestring; // just a reference, do not free.
Len : Longint; // in bytes, not characters
hash : Cardinal;
isUnicode : Boolean;
@ -75,7 +75,7 @@ uses
constructor TResourceStringItem.Create(asym:TConstsym);
var
pw : pcompilerwidestring;
pw : tcompilerwidestring;
t : TDef;
begin
@ -86,8 +86,8 @@ uses
if IsUnicode then
begin
T:=aSym.constdef;
WValue:=pcompilerwidestring(asym.value.valueptr);
Len:=WValue^.len*sizeOf(tcompilerwidechar);
WValue:=asym.value.valuews;
Len:=WValue.len*sizeOf(tcompilerwidechar);
end
else
begin
@ -119,9 +119,9 @@ uses
if IsUnicode then
begin
// Need to calculate hash on UTF8 encoded string, GNU gettext.
llen:=UnicodeToUtf8(nil,0,PUnicodeChar(wValue^.data),wValue^.len);
llen:=UnicodeToUtf8(nil,0,PUnicodeChar(wValue.data),wValue.len);
getmem(pc,llen);
UnicodeToUtf8(PC,llen,PUnicodeChar(wValue^.data),len);
UnicodeToUtf8(PC,llen,wValue.asconstpunicodechar,len);
P:=PByte(pc);
llen:=llen-1; // Take of terminating #0
end
@ -255,7 +255,7 @@ uses
ResFileName: string;
I,Len: Integer;
C: tcompilerwidechar;
W: pcompilerwidestring;
W: tcompilerwidestring;
P : PByte;
begin
@ -280,7 +280,7 @@ uses
begin
write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","sourcebytes":[');
if R.isUnicode then
P:=PByte(R.WValue^.data)
P:=PByte(R.WValue.asconstpunicodechar)
else
P:=PByte(R.AValue);
for i:=0 to R.Len-1 do
@ -299,9 +299,9 @@ uses
begin
W:=R.WValue;
end;
for I := 0 to W^.len - 1 do
for I := 0 to W.len - 1 do
begin
C := W^.Data[I];
C := W.Data[I];
case C of
Ord('"'), Ord('\'), Ord('/'):
write(f, '\', Chr(C));

8
compiler/jvm/aasmcpu.pas
View File

@ -56,12 +56,12 @@ uses
constructor op_single(op : tasmop;_op1 : single);
constructor op_double(op : tasmop;_op1 : double);
constructor op_string(op : tasmop;_op1len : aint;_op1 : pchar);
constructor op_wstring(op : tasmop;_op1 : pcompilerwidestring);
constructor op_wstring(op : tasmop;_op1 : tcompilerwidestring);
procedure loadsingle(opidx:longint;f:single);
procedure loaddouble(opidx:longint;d:double);
procedure loadstr(opidx:longint;vallen: aint;pc: pchar);
procedure loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
procedure loadpwstr(opidx:longint;pwstr: tcompilerwidestring);
{ register allocation }
@ -159,7 +159,7 @@ implementation
loadstr(0,_op1len,_op1);
end;
constructor taicpu.op_wstring(op: tasmop; _op1: pcompilerwidestring);
constructor taicpu.op_wstring(op: tasmop; _op1: tcompilerwidestring);
begin
inherited create(op);
ops:=1;
@ -207,7 +207,7 @@ implementation
end;
procedure taicpu.loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
procedure taicpu.loadpwstr(opidx:longint;pwstr:tcompilerwidestring);
begin
allocate_oper(opidx+1);
with oper[opidx]^ do

4
compiler/jvm/agjasmin.pas
View File

@ -777,7 +777,7 @@ implementation
constresourcestring:
result:='TODO: add support for constant resource strings';
constwstring:
result:=constwstr(pcompilerwidestring(csym.value.valueptr)^.data,pcompilerwidestring(csym.value.valueptr)^.len);
result:=constwstr(pcompilerwidechar(csym.value.valuews.data),csym.value.valuews.len);
constguid:
result:='TODO: add support for constant guids';
else
@ -1153,7 +1153,7 @@ implementation
end;
top_wstring:
begin
result:=constwstr(o.pwstrval^.data,getlengthwidestring(o.pwstrval));
result:=constwstr(pcompilerwidechar(o.pwstrval.data),getlengthwidestring(o.pwstrval));
end
else
internalerror(2010122802);

12
compiler/jvm/njvmcon.pas
View File

@ -164,7 +164,6 @@ implementation
function tjvmstringconstnode.pass_1: tnode;
var
strclass: tobjectdef;
pw: pcompilerwidestring;
paras: tcallparanode;
wasansi: boolean;
begin
@ -181,10 +180,9 @@ implementation
exit;
{ convert the constant into a widestring representation without any
code page conversion }
initwidestring(pw);
ascii2unicode(value_str,len,current_settings.sourcecodepage,pw,false);
ansistringdispose(value_str,len);
pcompilerwidestring(value_str):=pw;
initwidestring(valuews);
ascii2unicode(asconstpchar,len,current_settings.sourcecodepage,valuews,false);
setlength(valueas,0);
{ and now add a node to convert the data into ansistring format at
run time }
wasansi:=false;
@ -239,7 +237,7 @@ implementation
internalerror(2012052601);
cst_unicodestring,
cst_widestring:
current_asmdata.CurrAsmList.concat(taicpu.op_wstring(a_ldc,pcompilerwidestring(value_str)));
current_asmdata.CurrAsmList.concat(taicpu.op_wstring(a_ldc,valuews));
else
internalerror(2012052602);
end;
@ -259,7 +257,7 @@ implementation
function tjvmsetconstnode.buildsetfromstring(const helpername: string; otherparas: tcallparanode): tnode;
var
pw: pcompilerwidestring;
pw: tcompilerwidestring;
wc: tcompilerwidechar;
i, j, bit, nulls: longint;
begin

4
compiler/jvm/njvmtcon.pas
View File

@ -72,7 +72,7 @@ implementation
procedure tjvmtypedconstbuilder.tc_flush_arr_strconst(def: tdef);
var
wstr: pcompilerwidestring;
wstr: tcompilerwidestring;
wc: tcompilerwidechar;
i: longint;
procvariant: string[8];
@ -198,7 +198,7 @@ implementation
inserttypeconv(n,getansistringdef);
if n.nodetype<>stringconstn then
internalerror(2010033010);
ca:=pbyte(tstringconstnode(n).value_str);
ca:=pbyte(tstringconstnode(n).asconstpchar);
{ For tp7 the maximum lentgh can be 255 }
if (m_tp7 in current_settings.modeswitches) and
(len>255) then

20
compiler/nadd.pas
View File

@ -672,10 +672,10 @@ const
rd,ld , inttype: tdef;
rv,lv,v : tconstexprint;
rvd,lvd : bestreal;
ws1,ws2 : pcompilerwidestring;
ws1,ws2 : tcompilerwidestring;
concatstrings : boolean;
c1,c2 : array[0..1] of char;
s1,s2 : pchar;
s1,s2,stmp : pchar;
l1,l2 : longint;
resultset : Tconstset;
res,
@ -1231,8 +1231,8 @@ const
begin
initwidestring(ws1);
initwidestring(ws2);
copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1);
copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2);
copywidestring(tstringconstnode(left).valuews,ws1);
copywidestring(tstringconstnode(right).valuews,ws2);
case nodetype of
addn :
begin
@ -1278,8 +1278,8 @@ const
end
else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
begin
s1:=tstringconstnode(left).value_str;
l1:=tstringconstnode(left).len;
s1:=tstringconstnode(left).asconstpchar;
c2[0]:=char(int64(tordconstnode(right).value));
c2[1]:=#0;
s2:=@c2[0];
@ -1292,15 +1292,15 @@ const
c1[1]:=#0;
l1:=1;
s1:=@c1[0];
s2:=tstringconstnode(right).value_str;
s2:=tstringconstnode(right).asconstpchar;
l2:=tstringconstnode(right).len;
concatstrings:=true;
end
else if (lt=stringconstn) and (rt=stringconstn) then
begin
s1:=tstringconstnode(left).value_str;
s1:=tstringconstnode(left).asconstpchar;
l1:=tstringconstnode(left).len;
s2:=tstringconstnode(right).value_str;
s2:=tstringconstnode(right).asconstpchar;
l2:=tstringconstnode(right).len;
concatstrings:=true;
end;
@ -1309,7 +1309,9 @@ const
case nodetype of
addn :
begin
t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,nil);
stmp:=concatansistrings(s1,s2,l1,l2);
t:=cstringconstnode.createpchar(stmp,l1+l2,nil);
Freemem(stmp);
typecheckpass(t);
if not is_ansistring(resultdef) or
(tstringdef(resultdef).encoding<>globals.CP_NONE) then

18
compiler/ncal.pas
View File

@ -544,7 +544,7 @@ implementation
if assigned(para.parametername) then
begin
if para.parametername.nodetype=stringconstn then
names:=names+tstringconstnode(para.parametername).value_str+#0
names:=names+tstringconstnode(para.parametername).asconstpchar+#0
else
internalerror(200611041);
end;
@ -2939,45 +2939,45 @@ implementation
1:
if ValOutput.signed then
begin
Val(TStringConstNode(valnode).value_str, si, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, si, ValCode);
ValOutput.svalue:=si;
end
else
begin
Val(TStringConstNode(valnode).value_str, b, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, b, ValCode);
ValOutput.uvalue:=b;
end;
2:
if ValOutput.signed then
begin
Val(TStringConstNode(valnode).value_str, i, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, i, ValCode);
ValOutput.svalue:=i;
end
else
begin
Val(TStringConstNode(valnode).value_str, w, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, w, ValCode);
ValOutput.uvalue:=w;
end;
4:
if ValOutput.signed then
begin
Val(TStringConstNode(valnode).value_str, li, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, li, ValCode);
ValOutput.svalue:=li;
end
else
begin
Val(TStringConstNode(valnode).value_str, dw, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, dw, ValCode);
ValOutput.uvalue:=dw;
end;
8:
if ValOutput.signed then
begin
Val(TStringConstNode(valnode).value_str, i64, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, i64, ValCode);
ValOutput.svalue:=i64;
end
else
begin
Val(TStringConstNode(valnode).value_str, qw, ValCode);
Val(TStringConstNode(valnode).asrawbytestring, qw, ValCode);
ValOutput.uvalue:=qw;
end;
else

25
compiler/ncgcon.pas
View File

@ -229,6 +229,8 @@ implementation
strpointerdef: tdef;
datatcb: ttai_typedconstbuilder;
datadef: tdef;
t : tai_string;
const
PoolMap: array[tconststringtype] of TConstPoolType = (
@ -271,12 +273,12 @@ implementation
pool := current_asmdata.ConstPools[PoolMap[cst_type]];
if cst_type in [cst_widestring, cst_unicodestring] then
entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data,len*cwidechartype.size)
entry := pool.FindOrAdd(pointer(valuews.data),len*cwidechartype.size)
else
if cst_type = cst_ansistring then
entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(value_str,len,tstringdef(resultdef).encoding))
entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(pointer(valueas),len,tstringdef(resultdef).encoding))
else
entry := pool.FindOrAdd(value_str,len);
entry := pool.FindOrAdd(pointer(valueas),len);
lab_str := TAsmLabel(entry^.Data); // is it needed anymore?
@ -291,7 +293,7 @@ implementation
InternalError(2008032301) { empty string should be handled above }
else
begin
lastlabel:=datatcb.emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding);
lastlabel:=datatcb.emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],asconstpchar,len,tstringdef(resultdef).encoding);
{ because we hardcode the offset below due to it
not being stored in the hashset, check here }
if lastlabel.ofs<>datatcb.get_string_symofs(st_ansistring,false) then
@ -309,7 +311,7 @@ implementation
else
begin
lastlabel:=datatcb.emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts],
value_str,
valuews,
tstringdef(resultdef).encoding,
winlikewidestring);
{ because we hardcode the offset below due to it
@ -332,12 +334,14 @@ implementation
l:=len;
{ include length and terminating zero for quick conversion to pchar }
getmem(pc,l+2);
move(value_str^,pc[1],l);
if l>0 then
move(asconstpchar^,pc[1],l);
pc[0]:=chr(l);
pc[l+1]:=#0;
datadef:=carraydef.getreusable(cansichartype,l+2);
datatcb.maybe_begin_aggregate(datadef);
datatcb.emit_tai(Tai_string.Create_pchar(pc,l+2),datadef);
t:=Tai_string.Create_pchar(pc,l+2);
datatcb.emit_tai(t,datadef);
datatcb.maybe_end_aggregate(datadef);
current_asmdata.asmlists[al_typedconsts].concatList(
datatcb.get_final_asmlist(lastlabel.lab,datadef,sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)))
@ -349,7 +353,8 @@ implementation
{ include terminating zero }
getmem(pc,len+1);
move(value_str^,pc[0],len);
if len>0 then
move(asconstpchar^,pc[0],len);
pc[len]:=#0;
{ the data includes the terminating #0 because this
string can be used for pchar assignments (but it's
@ -357,7 +362,9 @@ implementation
case the terminating #0 is not part of the data) }
datadef:=carraydef.getreusable(cansichartype,len+1);
datatcb.maybe_begin_aggregate(datadef);
datatcb.emit_tai(Tai_string.Create_pchar(pc,len+1),datadef);
t:=Tai_string.Create_pchar(pc,len+1);
datatcb.emit_tai(t,datadef);
freemem(pc);
datatcb.maybe_end_aggregate(datadef);
current_asmdata.asmlists[al_typedconsts].concatList(
datatcb.get_final_asmlist(lastlabel.lab,datadef,sec_rodata_norel,lastlabel.lab.name,const_align(sizeof(pint)))

2
compiler/ncgobjc.pas
View File

@ -72,7 +72,7 @@ procedure tcgobjcselectornode.pass_generate_code;
end;
stringconstn:
begin
entry:=pool.FindOrAdd(tstringconstnode(left).value_str,tstringconstnode(left).len);
entry:=pool.FindOrAdd(pointer(tstringconstnode(left).valueas),tstringconstnode(left).len);
end;
else
internalerror(2009030701);

10
compiler/ncnv.pas
View File

@ -1190,6 +1190,7 @@ implementation
pchtemp : pchar;
arrsize : tcgint;
chartype : string[8];
begin
result := nil;
with tarraydef(resultdef) do
@ -1213,9 +1214,10 @@ implementation
{ (2.0.x compatible) }
if (arrsize>tstringconstnode(left).len) then
begin
pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
pchtemp:=concatansistrings(tstringconstnode(left).asconstpchar,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
left.free;
left:=cstringconstnode.createpchar(pchtemp,arrsize,nil);
freemem(pchtemp);
typecheckpass(left);
end;
exit;
@ -1253,7 +1255,7 @@ implementation
procname: string[31];
para : tcallparanode;
hp : tstringconstnode;
ws : pcompilerwidestring;
ws : tcompilerwidestring;
sa : ansistring;
cw : tcompilerwidechar;
l : SizeUInt;
@ -1426,7 +1428,7 @@ implementation
(tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and
(tstringdef(resultdef).stringtype=st_shortstring) then
begin
if not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)) then
if not hasnonasciichars(tstringconstnode(left).valuews) then
begin
tstringconstnode(left).changestringtype(resultdef);
Result:=left;
@ -1713,7 +1715,7 @@ implementation
(tstringconstnode(left).cst_type=cst_conststring) and
(tstringconstnode(left).len=4) then
begin
pb:=pbyte(tstringconstnode(left).value_str);
pb:=pbyte(tstringconstnode(left).asconstpchar);
fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3];
result:=cordconstnode.create(fcc,u32inttype,false);
end

175
compiler/ncon.pas
View File

@ -118,8 +118,11 @@ interface
cst_unicodestring
);
{ tstringconstnode }
tstringconstnode = class(tconstnode)
value_str : pchar;
valueas : TAnsiCharDynArray;
valuews : tcompilerwidestring;
len : longint;
lab_str : tasmlabel;
astringdef : tdef;
@ -127,7 +130,7 @@ interface
cst_type : tconststringtype;
constructor createstr(const s : string);virtual;
constructor createpchar(s: pchar; l: longint; def: tdef);virtual;
constructor createunistr(w : pcompilerwidestring);virtual;
constructor createunistr(w : tcompilerwidestring);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderefimpl;override;
@ -141,6 +144,8 @@ interface
procedure changestringtype(def:tdef);
function fullcompare(p: tstringconstnode): longint;
function emit_data(tcb:ttai_typedconstbuilder):sizeint; override;
function asrawbytestring: rawbytestring;
function asconstpchar : pchar; inline;
{ returns whether this platform uses the nil pointer to represent
empty dynamic strings }
class function emptydynstrnil: boolean; virtual;
@ -274,7 +279,7 @@ implementation
function get_string_value(p: tnode; def: tstringdef): tstringconstnode;
var
stringVal: string;
pWideStringVal: pcompilerwidestring;
pWideStringVal: tcompilerwidestring;
begin
stringVal:='';
if is_constcharnode(p) then
@ -347,7 +352,7 @@ implementation
p1:=cstringconstnode.createpchar(pc,len,p.constdef);
end;
constwstring :
p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
p1:=cstringconstnode.createunistr(p.value.valuews);
constreal :
begin
if (sp_generic_para in p.symoptions) and not (sp_generic_const in p.symoptions) then
@ -829,20 +834,21 @@ implementation
l:=length(s);
len:=l;
{ stringdup write even past a #0 }
getmem(value_str,l+1);
move(s[1],value_str^,l);
value_str[l]:=#0;
setlength(valueas,l+1);
valueas[l]:=#0;
if l>0 then
move(s[1],valueas[0],l);
lab_str:=nil;
cst_type:=cst_conststring;
end;
constructor tstringconstnode.createunistr(w : pcompilerwidestring);
constructor tstringconstnode.createunistr(w : tcompilerwidestring);
begin
inherited create(stringconstn);
len:=getlengthwidestring(w);
initwidestring(pcompilerwidestring(value_str));
copywidestring(w,pcompilerwidestring(value_str));
initwidestring(valuews);
copywidestring(w,valuews);
lab_str:=nil;
cst_type:=cst_unicodestring;
end;
@ -852,7 +858,10 @@ implementation
begin
inherited create(stringconstn);
len:=l;
value_str:=s;
setlength(valueas,l+1);
valueas[l]:=#0;
if l>0 then
move(s[0],valueas[0],l);
if assigned(def) and
is_ansistring(def) then
begin
@ -868,16 +877,15 @@ implementation
destructor tstringconstnode.destroy;
begin
if cst_type in [cst_widestring,cst_unicodestring] then
donewidestring(pcompilerwidestring(value_str))
donewidestring(valuews)
else
ansistringdispose(value_str,len);
valueas:=nil;
inherited destroy;
end;
constructor tstringconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
var
pw : pcompilerwidestring;
i : longint;
begin
inherited ppuload(t,ppufile);
@ -885,27 +893,27 @@ implementation
len:=ppufile.getlongint;
if cst_type in [cst_widestring,cst_unicodestring] then
begin
initwidestring(pw);
setlengthwidestring(pw,len);
initwidestring(valuews);
setlengthwidestring(valuews,len);
{ don't use getdata, because the compilerwidechars may have to
be byteswapped
}
{$if sizeof(tcompilerwidechar) = 2}
for i:=0 to pw^.len-1 do
pw^.data[i]:=ppufile.getword;
for i:=0 to valuews.len-1 do
valuews.data[i]:=ppufile.getword;
{$elseif sizeof(tcompilerwidechar) = 4}
for i:=0 to pw^.len-1 do
pw^.data[i]:=cardinal(ppufile.getlongint);
for i:=0 to valuews.len-1 do
valuews.data[i]:=cardinal(ppufile.getlongint);
{$else}
{$error Unsupported tcompilerwidechar size}
{$endif}
pcompilerwidestring(value_str):=pw
end
else
begin
getmem(value_str,len+1);
ppufile.getdata(value_str^,len);
value_str[len]:=#0;
setlength(valueas,len+1);
valueas[len]:=#0;
if len>0 then
ppufile.getdata(valueas[0],len);
end;
lab_str:=tasmlabel(ppufile.getasmsymbol);
if cst_type=cst_ansistring then
@ -918,10 +926,11 @@ implementation
inherited ppuwrite(ppufile);
ppufile.putbyte(byte(cst_type));
ppufile.putlongint(len);
if cst_type in [cst_widestring,cst_unicodestring] then
ppufile.putdata(pcompilerwidestring(value_str)^.data^,len*sizeof(tcompilerwidechar))
else
ppufile.putdata(value_str^,len);
if len>0 then
if cst_type in [cst_widestring,cst_unicodestring] then
ppufile.putdata(valuews.data[0],len*sizeof(tcompilerwidechar))
else
ppufile.putdata(valueas[0],len);
ppufile.putasmsymbol(lab_str);
if cst_type=cst_ansistring then
ppufile.putderef(astringdefderef);
@ -956,11 +965,16 @@ implementation
n.lab_str:=lab_str;
if cst_type in [cst_widestring,cst_unicodestring] then
begin
initwidestring(pcompilerwidestring(n.value_str));
copywidestring(pcompilerwidestring(value_str),pcompilerwidestring(n.value_str));
initwidestring(n.valuews);
copywidestring(valuews,n.valuews);
end
else
n.value_str:=getpcharcopy;
begin
setlength(n.valueas,len+1);
n.valueas[len]:=#0;
if len>0 then
move(valueas[0],n.valueas[0],len);
end;
n.astringdef:=astringdef;
dogetcopy:=n;
end;
@ -1017,7 +1031,9 @@ implementation
getmem(pc,len+1);
if pc=nil then
Message(general_f_no_memory_left);
move(value_str^,pc^,len+1);
pc[len]:=#0;
if len>0 then
move(valueas[0],pc^,len);
getpcharcopy:=pc;
end;
@ -1041,7 +1057,7 @@ implementation
st2cst : array[tstringtype] of tconststringtype = (
cst_shortstring,cst_longstring,cst_ansistring,cst_widestring,cst_unicodestring);
var
pw : pcompilerwidestring;
pw : tcompilerwidestring;
pc : pchar;
cp1 : tstringencoding;
cp2 : tstringencoding;
@ -1053,10 +1069,8 @@ implementation
if (tstringdef(def).stringtype in [st_widestring,st_unicodestring]) and
not(cst_type in [cst_widestring,cst_unicodestring]) then
begin
initwidestring(pw);
ascii2unicode(value_str,len,current_settings.sourcecodepage,pw);
ansistringdispose(value_str,len);
pcompilerwidestring(value_str):=pw;
initwidestring(valuews);
ascii2unicode(asconstpchar,len,current_settings.sourcecodepage,valuews);
end
else
{ convert unicode 2 ascii }
@ -1068,22 +1082,21 @@ implementation
cp1:=current_settings.sourcecodepage;
if (cp1=CP_UTF8) then
begin
pw:=pcompilerwidestring(value_str);
l2:=len;
l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),l2);
getmem(pc,l);
UnicodeToUtf8(pc,l,PUnicodeChar(pw^.data),l2);
l:=UnicodeToUtf8(nil,0,valuews.asconstpunicodechar,l2);
setlength(valueas,l+1);
valueas[l]:=#0;
if l>0 then
UnicodeToUtf8(asconstpchar,l,valuews.asconstpunicodechar,l2);
len:=l-1;
donewidestring(pw);
value_str:=pc;
donewidestring(valuews);
end
else
begin
pw:=pcompilerwidestring(value_str);
getmem(pc,getlengthwidestring(pw)+1);
unicode2ascii(pw,pc,cp1);
donewidestring(pw);
value_str:=pc;
setlength(valueas,getlengthwidestring(valuews)+1);
len:=Length(valueas)-1;
unicode2ascii(valuews,asconstpchar,cp1);
donewidestring(valuews);
end;
end
else
@ -1107,7 +1120,7 @@ implementation
if (cp1<>cp2) and (len>0) then
begin
if cpavailable(cp1) and cpavailable(cp2) then
changecodepage(value_str,len,cp2,value_str,cp1)
changecodepage(asconstpchar,len,cp2,asconstpchar,cp1)
else if (cp1 <> globals.CP_NONE) and (cp2 <> globals.CP_NONE) then
begin
{ if source encoding is UTF8 convert using UTF8->UTF16->destination encoding }
@ -1121,13 +1134,17 @@ implementation
initwidestring(pw);
setlengthwidestring(pw,len);
{ returns room for terminating 0 }
l:=Utf8ToUnicode(PUnicodeChar(pw^.data),len,value_str,len);
if len>0 then
l:=Utf8ToUnicode(pw.asconstpunicodechar,len,asconstpchar,len)
else
l:=1;
if (l<>getlengthwidestring(pw)) then
begin
setlengthwidestring(pw,l);
ReAllocMem(value_str,l);
setlength(valueas,l);
valueas[l-1]:=#0;
end;
unicode2ascii(pw,value_str,cp1);
unicode2ascii(pw,valueas,cp1);
len:=l-1;
donewidestring(pw);
end
@ -1142,12 +1159,15 @@ implementation
end;
initwidestring(pw);
setlengthwidestring(pw,len);
ascii2unicode(value_str,len,cp2,pw);
ascii2unicode(asconstpchar,len,cp2,pw);
{ returns room for terminating 0 }
l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),len);
l:=UnicodeToUtf8(nil,0,pw.asconstpunicodechar,len);
if l<>len then
ReAllocMem(value_str,l);
UnicodeToUtf8(value_str,l,PUnicodeChar(pw^.data),len);
begin
setlength(valueas,l);
valueas[l-1]:=#0;
end;
UnicodeToUtf8(asconstpchar,l,pw.asconstpunicodechar,len);
len:=l-1;
donewidestring(pw);
end
@ -1171,9 +1191,9 @@ implementation
if cst_type<>p.cst_type then
InternalError(2009121701);
if cst_type in [cst_widestring,cst_unicodestring] then
result:=comparewidestrings(pcompilerwidestring(value_str),pcompilerwidestring(p.value_str))
result:=comparewidestrings(valuews,p.valuews)
else
result:=compareansistrings(value_str,p.value_str,len,p.len);
result:=compareansistrings(asconstpchar,p.asconstpchar,len,p.len);
end;
function tstringconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
@ -1186,7 +1206,8 @@ implementation
st_shortstring:
begin
setlength(ss,len);
move(value_str^,ss[1],len);
if len>0 then
move(valueas[0],ss[1],len);
tcb.emit_shortstring_const(ss);
result:=len+1;
end;
@ -1194,7 +1215,7 @@ implementation
internalerror(2019070801);
st_ansistring:
begin
labofs:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding);
labofs:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_typedconsts],asconstpchar,len,tstringdef(resultdef).encoding);
tcb.emit_string_offset(labofs,len,tstringdef(resultdef).stringtype,false,charpointertype);
result:=voidpointertype.size;
end;
@ -1202,22 +1223,52 @@ implementation
st_unicodestring:
begin
winlikewidestring:=(cst_type=cst_widestring) and (tf_winlikewidestring in target_info.flags);
labofs:=tcb.emit_unicodestring_const(current_asmdata.asmlists[al_typedconsts],value_str,tstringdef(resultdef).encoding,winlikewidestring);
labofs:=tcb.emit_unicodestring_const(current_asmdata.asmlists[al_typedconsts],valuews,tstringdef(resultdef).encoding,winlikewidestring);
tcb.emit_string_offset(labofs,len,tstringdef(resultdef).stringtype,false,widecharpointertype);
result:=voidpointertype.size;
end;
end;
end;
function tstringconstnode.asrawbytestring: rawbytestring;
begin
Result:='';
if Length(valueas)>0 then
Result:=pchar(@valueas[0]);
end;
var
cEmptyString : ansichar = #0;
function tstringconstnode.asconstpchar: pchar;
begin
if len>0 then
Result:=@valueas[0]
else
Result:=@cEmptyString;
end;
class function tstringconstnode.emptydynstrnil: boolean;
begin
result:=true;
end;
procedure tstringconstnode.printnodedata(var T: Text);
var
u : unicodestring;
begin
inherited printnodedata(t);
writeln(t,printnodeindention,'value = "',value_str,'"');
if length(valueas)>0 then
writeln(t,printnodeindention,'value = "',pAnsichar(@valueas[0]),'"')
else if assigned(valuews) and (valuews.len>0) then
begin
setlength(u,valuews.len);
move(valuews.data[0],u[1],valuews.len*sizeof(unicodechar));
writeln(t,printnodeindention,'value = "',u,'"');
end
else
writeln(t,printnodeindention,'value = ""');
end;
{$ifdef DEBUG_NODE_XML}

28
compiler/ngtcon.pas
View File

@ -500,13 +500,13 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
is_constcharnode(node) then
begin
{ convert to the expected string type so that
for widestrings strval is a pcompilerwidestring }
for widestrings strval is a tcompilerwidestring }
inserttypeconv(node,def);
if (not codegenerror) and
(node.nodetype=stringconstn) then
begin
strlength:=tstringconstnode(node).len;
strval:=tstringconstnode(node).value_str;
strval:=tstringconstnode(node).asconstpchar;
{ the def may have changed from e.g. RawByteString to
AnsiString(CP_ACP) }
if node.resultdef.typ=stringdef then
@ -600,7 +600,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
begin
winlike:=(def.stringtype=st_widestring) and (tf_winlikewidestring in target_info.flags);
ll:=ftcb.emit_unicodestring_const(fdatalist,
strval,
tstringconstnode(node).valuews,
def.encoding,
winlike);
@ -780,7 +780,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
srsym : tsym;
pd : tprocdef;
ca : pchar;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
i,len : longint;
ll : tasmlabel;
varalign : shortint;
@ -874,7 +874,9 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
(len>255) then
len:=255;
getmem(ca,len+1);
move(tstringconstnode(node).value_str^,ca^,len+1);
ca[len]:=#0;
if len>0 then
move(tstringconstnode(node).valueas[0],ca^,len);
datadef:=carraydef.getreusable(cansichartype,len+1);
datatcb.maybe_begin_aggregate(datadef);
datatcb.emit_tai(Tai_string.Create_pchar(ca,len+1),datadef);
@ -917,12 +919,12 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
asmlist) }
ftcb.start_internal_data_builder(fdatalist,sec_rodata,'',datatcb,ll);
datatcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
pw:=pcompilerwidestring(tstringconstnode(node).value_str);
pw:=tstringconstnode(node).valuews;
{ include terminating #0 }
datadef:=carraydef.getreusable(cwidechartype,tstringconstnode(node).len+1);
datatcb.maybe_begin_aggregate(datadef);
for i:=0 to tstringconstnode(node).len-1 do
datatcb.emit_tai(Tai_const.Create_16bit(pw^.data[i]),cwidechartype);
datatcb.emit_tai(Tai_const.Create_16bit(pw.data[i]),cwidechartype);
{ ending #0 }
datatcb.emit_tai(Tai_const.Create_16bit(0),cwidechartype);
datatcb.maybe_end_aggregate(datadef);
@ -1376,14 +1378,17 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
inserttypeconv(n,getansistringdef);
if n.nodetype<>stringconstn then
internalerror(2010033003);
ca:=pointer(tstringconstnode(n).value_str);
ca:=pointer(tstringconstnode(n).valueas);
end;
2:
begin
inserttypeconv(n,cunicodestringtype);
if n.nodetype<>stringconstn then
internalerror(2010033009);
ca:=pointer(pcompilerwidestring(tstringconstnode(n).value_str)^.data)
if tstringconstnode(n).valuews.len>0 then
ca:=pointer(@tstringconstnode(n).valuews.data[0])
else
ca:=nil;
end;
else
internalerror(2010033005);
@ -1620,7 +1625,10 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
procedure handle_stringconstn;
begin
hs:=strpas(tstringconstnode(n).value_str);
if length(tstringconstnode(n).valueas)>0 then
hs:=strpas(@tstringconstnode(n).valueas[0])
else
hs:='';
if string2guid(hs,tmpguid) then
ftcb.emit_guid_const(tmpguid)
else

2
compiler/ninl.pas
View File

@ -3343,7 +3343,7 @@ implementation
encodedtype:='';
if not objctryencodetype(left.resultdef,encodedtype,errordef) then
Message1(type_e_objc_type_unsupported,errordef.typename);
result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype),nil);
result:=cstringconstnode.createpchar(pchar(encodedtype),length(encodedtype),nil);
end;
var

4
compiler/nmem.pas
View File

@ -1460,7 +1460,7 @@ implementation
it does not matter as a 32 bit host cannot handle such long strings anyways due to memory limitations
}
Result := COrdConstNode.create(
PCompilerWideString(TStringConstNode(left).value_str)^.data[PtrUInt(TOrdConstNode(right).value.uvalue) - 1],
TStringConstNode(left).valuews.data[PtrUInt(TOrdConstNode(right).value.uvalue) - 1],
resultdef,
False
);
@ -1470,7 +1470,7 @@ implementation
it does not matter as a 32 bit host cannot handle such long strings anyways due to memory limitations
}
Result := COrdConstNode.create(
Byte(TStringConstNode(left).value_str[PtrUInt(TOrdConstNode(right).value.uvalue) - 1]),
Byte(TStringConstNode(left).valueas[PtrUInt(TOrdConstNode(right).value.uvalue) - 1]),
resultdef,
False
);

5
compiler/nobjc.pas
View File

@ -102,14 +102,15 @@ function tobjcselectornode.pass_typecheck: tnode;
end;
stringconstn:
begin
if not objcvalidselectorname(tstringconstnode(left).value_str,
if not objcvalidselectorname(tstringconstnode(left).asconstpchar,
tstringconstnode(left).len) then
begin
len:=tstringconstnode(left).len;
if (len>255) then
len:=255;
setlength(s,len);
move(tstringconstnode(left).value_str^,s[1],len);
if len>0 then
move(tstringconstnode(left).valueas[0],s[1],len);
CGMessage1(type_e_invalid_objc_selector_name,s);
exit;
end;

18
compiler/pdecl.pas
View File

@ -88,7 +88,7 @@ implementation
pd : pbestreal;
pg : pguid;
sp : pchar;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
storetokenpos : tfileposinfo;
begin
readconstant:=nil;
@ -112,13 +112,15 @@ implementation
if is_wide_or_unicode_string(p.resultdef) then
begin
initwidestring(pw);
copywidestring(pcompilerwidestring(tstringconstnode(p).value_str),pw);
copywidestring(tstringconstnode(p).valuews,pw);
hp:=cconstsym.create_wstring(orgname,constwstring,pw);
end
else
begin
getmem(sp,tstringconstnode(p).len+1);
move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1);
sp[tstringconstnode(p).len]:=#0;
if tstringconstnode(p).len>0 then
move(tstringconstnode(p).valueas[0],sp^,tstringconstnode(p).len+1);
{ if a non-default ansistring code page has been specified,
keep it }
if is_ansistring(p.resultdef) and
@ -1309,7 +1311,7 @@ implementation
sym : tsym;
first,
isgeneric : boolean;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
begin
if target_info.system in systems_managed_vm then
@ -1350,7 +1352,7 @@ implementation
begin
initwidestring(pw);
setlengthwidestring(pw,1);
pw^.data^:=tordconstnode(p).value.svalue;
pw.data[0]:=tordconstnode(p).value.svalue;
sym:=cconstsym.create_wstring(orgname,constwresourcestring,pw);
end;
end
@ -1365,7 +1367,9 @@ implementation
if cst_type in [cst_widestring,cst_unicodestring] then
changestringtype(getansistringdef);
getmem(sp,len+1);
move(value_str^,sp^,len+1);
sp[len]:=#0;
if len>0 then
move(valueas[0],sp^,len);
sym:=cconstsym.create_string(orgname,constresourcestring,sp,len,nil);
end
else
@ -1374,7 +1378,7 @@ implementation
if cst_type in [cst_conststring,cst_longstring, cst_shortstring,cst_ansistring] then
changestringtype(cunicodestringtype);
initwidestring(pw);
copywidestring(pcompilerwidestring(value_str),pw);
copywidestring(valuews,pw);
sym:=cconstsym.create_wstring(orgname,constwresourcestring,pw);
end;
end;

2
compiler/pdecobj.pas
View File

@ -413,7 +413,7 @@ implementation
if p.nodetype=stringconstn then
begin
stringdispose(current_objectdef.iidstr);
current_objectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str));
current_objectdef.iidstr:=stringdup(tstringconstnode(p).asrawbytestring);
valid:=string2guid(current_objectdef.iidstr^,current_objectdef.iidguid^);
if (current_objectdef.objecttype in [odt_interfacecom,odt_dispinterface]) and
not valid then

2
compiler/pdecsub.pas
View File

@ -2179,7 +2179,7 @@ begin
include(pd.procoptions,po_msgstr);
if (tstringconstnode(pt).len>255) then
Message(parser_e_message_string_too_long);
tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).value_str);
tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).asconstpchar);
end
else
if is_constintnode(pt) and

2
compiler/pdecvar.pas
View File

@ -1211,7 +1211,7 @@ implementation
abssym:=cabsolutevarsym.create(vs.realname,vs.vardef);
abssym.fileinfo:=vs.fileinfo;
if pt.nodetype=stringconstn then
abssym.asmname:=stringdup(strpas(tstringconstnode(pt).value_str))
abssym.asmname:=stringdup(tstringconstnode(pt).asrawbytestring)
else
abssym.asmname:=stringdup(chr(tordconstnode(pt).value.svalue));
abssym.abstyp:=toasm;

2
compiler/pexports.pas
View File

@ -162,7 +162,7 @@ implementation
begin
pt:=comp_expr([ef_accept_equal]);
if pt.nodetype=stringconstn then
hpname:=strpas(tstringconstnode(pt).value_str)
hpname:=strpas(pchar(@tstringconstnode(pt).valueas[0]))
else if is_constcharnode(pt) then
hpname:=chr(tordconstnode(pt).value.svalue and $ff)
else

10
compiler/pexpr.pas
View File

@ -4148,7 +4148,7 @@ implementation
_CSTRING :
begin
p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern),nil);
p1:=cstringconstnode.createpchar(pchar(cstringpattern),length(cstringpattern),nil);
consume(_CSTRING);
if token in postfixoperator_tokens then
begin
@ -5085,7 +5085,7 @@ implementation
p:tnode;
snode : tstringconstnode absolute p;
s : string;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
pc : pansichar;
len : Integer;
@ -5095,13 +5095,13 @@ implementation
if p.nodetype<>stringconstn then
begin
if (p.nodetype=ordconstn) and is_char(p.resultdef) then
get_stringconst:=char(int64(tordconstnode(p).value))
get_stringconst:=char(tordconstnode(p).value.svalue)
else
Message(parser_e_illegal_expression);
end
else if (tstringconstnode(p).cst_type in [cst_unicodestring,cst_widestring]) then
begin
pw:=pcompilerwideString(tstringconstnode(p).value_str);
pw:=snode.valuews;
len:=getlengthwidestring(pw);
pc:=getmem(Len+1);
pc[len]:=#0;
@ -5110,7 +5110,7 @@ implementation
freemem(pc);
end
else
get_stringconst:=strpas(snode.value_str);
get_stringconst:=snode.asrawbytestring;
p.free;
end;

22
compiler/pgenutil.pas
View File

@ -187,7 +187,7 @@ uses
sp : pchar;
ps : ^tconstset;
pd : ^bestreal;
i : integer;
i,l : integer;
begin
if node=nil then
internalerror(2020011401);
@ -199,10 +199,22 @@ uses
end;
stringconstn:
begin
getmem(sp,tstringconstnode(node).len+1);
move(tstringconstnode(node).value_str^,sp^,tstringconstnode(node).len+1);
sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
prettyname:=''''+tstringconstnode(node).value_str+'''';
// unicode, convert to utf8
if tstringconstnode(node).cst_type in [cst_widestring,cst_unicodestring] then
begin
l:=UnicodeToUtf8(nil,0,tstringconstnode(node).valuews.asconstpunicodechar,tstringconstnode(node).valuews.len);
getmem(sp,l);
UnicodeToUtf8(sp,l,tstringconstnode(node).valuews.asconstpunicodechar,tstringconstnode(node).valuews.len);
sym:=cconstsym.create_string(undefinedname,conststring,sp,l,fromdef);
prettyname:=''''+sp+'''';
end
else
begin
getmem(sp,tstringconstnode(node).len+1);
move(tstringconstnode(node).asconstpchar,sp^,tstringconstnode(node).len+1);
sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
prettyname:=''''+tstringconstnode(node).asconstpchar+'''';
end;
end;
realconstn:
begin

18
compiler/ppcjvm.lpi
View File

@ -21,9 +21,18 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="-Ur -Tandroid -Pjvm -Ur -Xs -O2 -n -Fi..\..\inc -Fi..\..\jvm -Fi..\..\java -FE. -FU\home\tixeo\FPC\FPC\src\rtl\units\jvm-android -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -djvm -dRELEASE -Us -Sg @rtl.cfg ..\..\java\system.pp"/>
<WorkingDirectory Value="\home\tixeo\FPC\FPC\src\rtl\android\jvm"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
<Mode0 Name="default">
<local>
<CommandLineParams Value="-Ur -Tandroid -Pjvm -Ur -Xs -O2 -n -Fi..\..\inc -Fi..\..\jvm -Fi..\..\java -FE. -FU\home\tixeo\FPC\FPC\src\rtl\units\jvm-android -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -djvm -dRELEASE -Us -Sg @rtl.cfg ..\..\java\system.pp"/>
<WorkingDirectory Value="\home\tixeo\FPC\FPC\src\rtl\android\jvm"/>
</local>
</Mode0>
</Modes>
</RunParams>
<Units Count="1">
@ -48,10 +57,15 @@
<SyntaxOptions>
<CStyleOperator Value="False"/>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<Verbosity>
<ShowWarn Value="False"/>

9
compiler/ppcwasm32.lpi
View File

@ -63,13 +63,8 @@
<StopAfterErrCount Value="50"/>
</ConfigFile>
<CustomOptions Value="-dwasm32
-dEXTDEBUG"/>
<OtherDefines Count="4">
<Define0 Value="wasm32"/>
<Define1 Value="noopt"/>
<Define2 Value="EXTDEBUG"/>
<Define3 Value="FPC_WASM_THREADS_INTERNAL_LINKER"/>
</OtherDefines>
-dEXTDEBUG
-dSKIP_INTERNAL20231102"/>
</Other>
</CompilerOptions>
</CONFIG>

13
compiler/ppcx64.lpi
View File

@ -22,15 +22,17 @@
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="-Tlinux -tunicodertl -FUrtl-objpas\units\x86_64-linux-unicodertl\ -Fu\home\tixeo\FPC\FPC\src\rtl\units\x86_64-linux-unicodertl\ -Furtl-objpas\src\inc -Furtl-objpas\src\common -Firtl-objpas\src\inc -Firtl-objpas\src\linux -Firtl-objpas\src\x86_64 -Firtl-objpas\src\common -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -tunicodertl -Cg -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -gl -dx86_64 -Sc -viq rtl-objpas\BuildUnit_rtl_objpas.pp"/>
<CommandLineParams Value="-Fi..\inc -Fi..\x86_64 -Fi..\unix -Fix86_64 -FE. -FU..\..\rtl\units\x86_64-linux -Cg -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -DD2025\03\18 -dx86_64 -Us -Sg system.pp"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
<WorkingDirectory Value="\home\tixeo\fpc\packages"/>
<WorkingDirectory Value="\home\tixeo\FPC\FPC\src\rtl\linux"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<CommandLineParams Value="-Fi..\inc -Fi..\x86_64 -Fi..\unix -Fix86_64 -FE. -FU..\..\rtl\units\x86_64-linux -Cg -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -DD2025\03\18 -dx86_64 -Us -Sg system.pp"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
<WorkingDirectory Value="\home\tixeo\FPC\FPC\src\rtl\linux"/>
</local>
</Mode0>
</Modes>
@ -61,10 +63,15 @@
<SyntaxOptions>
<CStyleOperator Value="False"/>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
<UseAnsiStrings Value="False"/>
<CPPInline Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
</Linking>
<Other>
<Verbosity>
<ShowWarn Value="False"/>

30
compiler/scanner.pas
View File

@ -85,7 +85,7 @@ interface
orgpattern,
pattern : string;
cstringpattern: ansistring;
patternw : pcompilerwidestring;
patternw : tcompilerwidestring;
settings : tsettings;
tokenbuf : tdynamicarray;
tokenbuf_needs_swapping : boolean;
@ -94,7 +94,7 @@ interface
verbosity : longint;
constructor Create(atoken: ttoken;aidtoken:ttoken;
const aorgpattern,apattern:string;const acstringpattern:ansistring;
apatternw:pcompilerwidestring;asettings:tsettings;
apatternw:tcompilerwidestring;asettings:tsettings;
atokenbuf:tdynamicarray;change_endian:boolean;const apending:tpendingstate;
averbosity:longint;anext:treplaystack);
destructor destroy;override;
@ -286,7 +286,7 @@ interface
orgpattern,
pattern : string;
cstringpattern : ansistring;
patternw : pcompilerwidestring;
patternw : tcompilerwidestring;
{ token }
token, { current token being parsed }
@ -1108,8 +1108,8 @@ type
constwstring,
constwresourcestring:
begin
initwidestring(value.valueptr);
copywidestring(c.value.valueptr,value.valueptr);
initwidestring(value.valuews);
copywidestring(c.value.valuews,value.valuews);
end;
constreal:
begin
@ -1576,7 +1576,7 @@ type
freemem(value.valueptr,value.len+1);
constwstring,
constwresourcestring:
donewidestring(pcompilerwidestring(value.valueptr));
donewidestring(value.valuews);
constreal :
dispose(pbestreal(value.valueptr));
constset :
@ -2978,7 +2978,7 @@ type
*****************************************************************************}
constructor treplaystack.Create(atoken:ttoken;aidtoken:ttoken;
const aorgpattern,apattern:string;const acstringpattern:ansistring;
apatternw:pcompilerwidestring;asettings:tsettings;
apatternw:tcompilerwidestring;asettings:tsettings;
atokenbuf:tdynamicarray;change_endian:boolean;const apending:tpendingstate;
averbosity:longint;anext:treplaystack);
begin
@ -2990,8 +2990,7 @@ type
initwidestring(patternw);
if assigned(apatternw) then
begin
setlengthwidestring(patternw,apatternw^.len);
move(apatternw^.data^,patternw^.data^,apatternw^.len*sizeof(tcompilerwidechar));
copywidestring(patternw,apatternw);
end;
settings:=asettings;
pending:=apending;
@ -3681,9 +3680,9 @@ type
_CWCHAR,
_CWSTRING :
begin
tokenwritesizeint(patternw^.len);
if patternw^.len>0 then
recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
tokenwritesizeint(patternw.len);
if patternw.len>0 then
recordtokenbuf.write(patternw.data[0],patternw.len*sizeof(tcompilerwidechar));
end;
_CSTRING:
begin
@ -3781,8 +3780,7 @@ type
idtoken:=replaystack.idtoken;
pattern:=replaystack.pattern;
orgpattern:=replaystack.orgpattern;
setlengthwidestring(patternw,replaystack.patternw^.len);
move(replaystack.patternw^.data^,patternw^.data^,replaystack.patternw^.len*sizeof(tcompilerwidechar));
copywidestring(replaystack.patternw,patternw);
cstringpattern:=replaystack.cstringpattern;
replaytokenbuf:=replaystack.tokenbuf;
change_endian_for_replay:=replaystack.tokenbuf_needs_swapping;
@ -3824,7 +3822,7 @@ type
wlen:=tokenreadsizeint;
setlengthwidestring(patternw,wlen);
if wlen>0 then
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
replaytokenbuf.read(patternw.data[0],patternw.len*sizeof(tcompilerwidechar));
orgpattern:='';
pattern:='';
cstringpattern:='';
@ -5947,7 +5945,7 @@ type
{ strings with length 1 become const chars }
if iswidestring then
begin
if patternw^.len=1 then
if patternw.len=1 then
token:=_CWCHAR
else
token:=_CWSTRING;

12
compiler/symdef.pas
View File

@ -5938,14 +5938,14 @@ implementation
constwresourcestring,
constwstring:
begin
if pcompilerwidestring(hpc.value.valueptr)^.len>0 then
if hpc.value.valuews.len>0 then
begin
setlength(hs,pcompilerwidestring(hpc.value.valueptr)^.len);
for j:=0 to pcompilerwidestring(hpc.value.valueptr)^.len-1 do
setlength(hs,hpc.value.valuews.len);
for j:=0 to hpc.value.valuews.len-1 do
begin
if (ord(pcompilerwidestring(hpc.value.valueptr)^.data[j])<127) and
not(byte(pcompilerwidestring(hpc.value.valueptr)^.data[j]) in [0,10,13]) then
hs[j+1]:=char(pcompilerwidestring(hpc.value.valueptr)^.data[j])
if (ord(hpc.value.valuews.data[j])<127) and
not(byte(hpc.value.valuews.data[j]) in [0,10,13]) then
hs[j+1]:=char(hpc.value.valuews.data[j])
else
hs[j+1]:='.';
end;

31
compiler/symsym.pas
View File

@ -412,6 +412,7 @@ interface
0: (valueord : tconstexprint);
1: (valueordptr : tconstptruint);
2: (valueptr : pointer; len : longint);
3: (valuews : tcompilerwidestring);
end;
tconstsym = class(tstoredsym)
@ -423,7 +424,7 @@ interface
constructor create_ordptr(const n : TSymStr;t : tconsttyp;v : tconstptruint;def:tdef);virtual;
constructor create_ptr(const n : TSymStr;t : tconsttyp;v : pointer;def:tdef);virtual;
constructor create_string(const n : TSymStr;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
constructor create_wstring(const n : TSymStr;t : tconsttyp;pw:pcompilerwidestring);virtual;
constructor create_wstring(const n : TSymStr;t : tconsttyp;pw:tcompilerwidestring);virtual;
constructor create_undefined(const n : TSymStr;def:tdef);virtual;
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -2658,12 +2659,12 @@ implementation
end;
constructor tconstsym.create_wstring(const n : TSymStr;t : tconsttyp;pw:pcompilerwidestring);
constructor tconstsym.create_wstring(const n : TSymStr;t : tconsttyp;pw:tcompilerwidestring);
begin
inherited create(constsym,n);
fillchar(value, sizeof(value), #0);
consttyp:=t;
pcompilerwidestring(value.valueptr):=pw;
value.valuews:=pw;
constdef:=carraydef.getreusable(cwidechartype,getlengthwidestring(pw));
constdefderef.reset;
value.len:=getlengthwidestring(pw);
@ -2684,7 +2685,7 @@ implementation
pd : pbestreal;
ps : pnormalset;
pc : pchar;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
i : longint;
procedure do_widestring_const;
@ -2697,15 +2698,15 @@ implementation
be byteswapped
}
{$if sizeof(tcompilerwidechar) = 2}
for i:=0 to pw^.len-1 do
pw^.data[i]:=ppufile.getword;
for i:=0 to pw.len-1 do
pw.data[i]:=ppufile.getword;
{$elseif sizeof(tcompilerwidechar) = 4}
for i:=0 to pw^.len-1 do
pw^.data[i]:=cardinal(ppufile.getlongint);
for i:=0 to pw.len-1 do
pw.data[i]:=cardinal(ppufile.getlongint);
{$else}
{$error Unsupported tcompilerwidechar size}
{$endif}
pcompilerwidestring(value.valueptr):=pw;
value.valuews:=pw;
end;
begin
@ -2785,7 +2786,7 @@ implementation
freemem(pchar(value.valueptr),value.len+1);
constwstring,
constwresourcestring:
donewidestring(pcompilerwidestring(value.valueptr));
donewidestring(value.valuews);
constreal :
dispose(pbestreal(value.valueptr));
constset :
@ -2817,7 +2818,7 @@ implementation
constnil,constord,constreal,constpointer,constset,conststring,constresourcestring,constwresourcestring,constguid:
constdef:=tdef(constdefderef.resolve);
constwstring:
constdef:=carraydef.getreusable(cwidechartype,getlengthwidestring(pcompilerwidestring(value.valueptr)));
constdef:=carraydef.getreusable(cwidechartype,getlengthwidestring(value.valuews));
else
internalerror(2015120801);
end
@ -2828,9 +2829,13 @@ implementation
procedure do_widestring_const;
var
len : integer;
begin
ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
len:=getlengthwidestring(value.valuews);
ppufile.putlongint(len);
if len>0 then
ppufile.putdata(value.valuews.data[0],value.valuews.len*sizeof(tcompilerwidechar));
end;

3
compiler/symutil.pas
View File

@ -87,8 +87,7 @@ implementation
end;
constwstring :
begin
if (sym1.value.len=sym2.value.len) and
(comparewidestrings(sym1.value.valueptr,sym2.value.valueptr)=0) then
if (comparewidestrings(sym1.value.valuews,sym2.value.valuews)=0) then
equal_constsym:=true;
end;
constreal :

18
compiler/utils/ppuutils/ppudump.pp
View File

@ -3708,7 +3708,7 @@ var
singlevalue : single;
realstr : shortstring;
extended : TSplit80bitReal;
pw : pcompilerwidestring;
pw : tcompilerwidestring;
varoptions : tvaroptions;
propoptions : tpropertyoptions;
iexp: Tconstexprint;
@ -3897,16 +3897,16 @@ begin
be byteswapped
}
begin
for i:=0 to pw^.len-1 do
pw^.data[i]:=ppufile.getword;
SetString(ws, PWideChar(pw^.data), pw^.len);
for i:=0 to pw.len-1 do
pw.data[i]:=ppufile.getword;
SetString(ws, PWideChar(pw.data), pw.len);
constdef.VStr:=UTF8Encode(ws);
constdef.ConstType:=ctStr;
end
else if widecharsize=4 then
begin
for i:=0 to pw^.len-1 do
pw^.data[i]:=cardinal(ppufile.getlongint);
for i:=0 to pw.len-1 do
pw.data[i]:=cardinal(ppufile.getlongint);
end
else
begin
@ -3914,7 +3914,7 @@ begin
end;
Write([space,'Wide string type']);
startnewline:=true;
for i:=0 to pw^.len-1 do
for i:=0 to pw.len-1 do
begin
if startnewline then
begin
@ -3922,7 +3922,7 @@ begin
write(space);
startnewline:=false;
end;
ch:=pw^.data[i];
ch:=pw.data[i];
if widecharsize=2 then
write(hexstr(ch,4))
else
@ -3930,7 +3930,7 @@ begin
if ((i + 1) mod 8)= 0 then
startnewline:=true
else
if i <> pw^.len-1 then
if i <> pw.len-1 then
write(', ');
end;
donewidestring(pw);

150
compiler/widestr.pas
View File

@ -35,27 +35,29 @@ unit widestr;
tcompilerwidechar = word;
tcompilerwidecharptr = ^tcompilerwidechar;
pcompilerwidechar = ^tcompilerwidechar;
tcompilerwidechararray = array of tcompilerwidechar;
pcompilerwidestring = ^_tcompilerwidestring;
_tcompilerwidestring = record
data : pcompilerwidechar;
tcompilerwidestring = class
data : tcompilerwidechararray;
maxlen,len : SizeInt;
function asconstpunicodechar : PUnicodeChar;
end;
procedure initwidestring(out r : pcompilerwidestring);
procedure donewidestring(var r : pcompilerwidestring);
procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt);
function getlengthwidestring(r : pcompilerwidestring) : SizeInt;
procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar);
procedure concatwidestrings(s1,s2 : pcompilerwidestring);
function comparewidestrings(s1,s2 : pcompilerwidestring) : SizeInt;
procedure copywidestring(s,d : pcompilerwidestring);
procedure initwidestring(out r : tcompilerwidestring);
procedure donewidestring(var r : tcompilerwidestring);
procedure setlengthwidestring(r : tcompilerwidestring;l : SizeInt);
function getlengthwidestring(r : tcompilerwidestring) : SizeInt;
procedure concatwidestringchar(r : tcompilerwidestring;c : tcompilerwidechar);
procedure concatwidestrings(s1,s2 : tcompilerwidestring);
function comparewidestrings(s1,s2 : tcompilerwidestring) : SizeInt;
procedure copywidestring(s,d : tcompilerwidestring);
function asciichar2unicode(c : char) : tcompilerwidechar;
function unicode2asciichar(c : tcompilerwidechar) : char;
procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : pcompilerwidestring;codepagetranslation : boolean = true);
procedure unicode2ascii(r : pcompilerwidestring;p : pchar;cp : tstringencoding);
function hasnonasciichars(const p: pcompilerwidestring): boolean;
function getcharwidestring(r : pcompilerwidestring;l : SizeInt) : tcompilerwidechar;
procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : tcompilerwidestring;codepagetranslation : boolean = true);
procedure unicode2ascii(r : tcompilerwidestring;p : pchar;cp : tstringencoding);
procedure unicode2ascii(r : tcompilerwidestring;arr:TAnsiCharDynArray;cp : tstringencoding);
function hasnonasciichars(const p: tcompilerwidestring): boolean;
function getcharwidestring(r : tcompilerwidestring;l : SizeInt) : tcompilerwidechar;
function cpavailable(const s: string) : boolean;
function cpavailable(cp: word) : boolean;
procedure changecodepage(
@ -83,80 +85,77 @@ unit widestr;
globals,cutils;
procedure initwidestring(out r : pcompilerwidestring);
procedure initwidestring(out r : tcompilerwidestring);
begin
new(r);
r^.data:=nil;
r^.len:=0;
r^.maxlen:=0;
R:=tcompilerwidestring.create;
r.data:=nil;
r.len:=0;
r.maxlen:=0;
end;
procedure donewidestring(var r : pcompilerwidestring);
procedure donewidestring(var r : tcompilerwidestring);
begin
if assigned(r^.data) then
freemem(r^.data);
dispose(r);
r.Free;
r:=nil;
end;
function getcharwidestring(r : pcompilerwidestring;l : SizeInt) : tcompilerwidechar;
function getcharwidestring(r : tcompilerwidestring;l : SizeInt) : tcompilerwidechar;
begin
getcharwidestring:=r^.data[l];
getcharwidestring:=r.data[l];
end;
function getlengthwidestring(r : pcompilerwidestring) : SizeInt;
function getlengthwidestring(r : tcompilerwidestring) : SizeInt;
begin
getlengthwidestring:=r^.len;
getlengthwidestring:=r.len;
end;
procedure growwidestring(r : pcompilerwidestring;l : SizeInt);
procedure growwidestring(r : tcompilerwidestring;l : SizeInt);
begin
if r^.maxlen>=l then
if r.maxlen>=l then
exit;
if assigned(r^.data) then
reallocmem(r^.data,sizeof(tcompilerwidechar)*l)
else
getmem(r^.data,sizeof(tcompilerwidechar)*l);
r^.maxlen:=l;
setlength(r.data,l);
r.maxlen:=l;
end;
procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt);
procedure setlengthwidestring(r : tcompilerwidestring;l : SizeInt);
begin
r^.len:=l;
if l>r^.maxlen then
r.len:=l;
if l>r.maxlen then
growwidestring(r,l);
end;
procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar);
procedure concatwidestringchar(r : tcompilerwidestring;c : tcompilerwidechar);
begin
if r^.len>=r^.maxlen then
growwidestring(r,r^.len+16);
r^.data[r^.len]:=c;
inc(r^.len);
if r.len>=r.maxlen then
growwidestring(r,r.len+16);
r.data[r.len]:=c;
inc(r.len);
end;
procedure concatwidestrings(s1,s2 : pcompilerwidestring);
procedure concatwidestrings(s1,s2 : tcompilerwidestring);
begin
growwidestring(s1,s1^.len+s2^.len);
move(s2^.data^,s1^.data[s1^.len],s2^.len*sizeof(tcompilerwidechar));
inc(s1^.len,s2^.len);
growwidestring(s1,s1.len+s2.len);
if s2.len>0 then
move(s2.data[0],s1.data[s1.len],s2.len*sizeof(tcompilerwidechar));
inc(s1.len,s2.len);
end;
procedure copywidestring(s,d : pcompilerwidestring);
procedure copywidestring(s,d : tcompilerwidestring);
begin
setlengthwidestring(d,s^.len);
move(s^.data^,d^.data^,s^.len*sizeof(tcompilerwidechar));
setlengthwidestring(d,s.len);
if s.len>0 then
move(s.data[0],d.data[0],s.len*sizeof(tcompilerwidechar));
end;
function comparewidestrings(s1,s2 : pcompilerwidestring) : SizeInt;
function comparewidestrings(s1,s2 : tcompilerwidestring) : SizeInt;
var
maxi,temp : SizeInt;
begin
@ -165,13 +164,13 @@ unit widestr;
comparewidestrings:=0;
exit;
end;
maxi:=s1^.len;
temp:=s2^.len;
maxi:=s1.len;
temp:=s2.len;
if maxi>temp then
maxi:=Temp;
temp:=compareword(s1^.data^,s2^.data^,maxi);
temp:=compareword(s1.data[0],s2.data[0],maxi);
if temp=0 then
temp:=s1^.len-s2^.len;
temp:=s1.len-s2.len;
comparewidestrings:=temp;
end;
@ -200,7 +199,7 @@ unit widestr;
end;
procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : pcompilerwidestring;codepagetranslation : boolean = true);
procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : tcompilerwidestring;codepagetranslation : boolean = true);
var
source : pchar;
dest : tcompilerwidecharptr;
@ -210,7 +209,7 @@ unit widestr;
m:=getmap(cp);
setlengthwidestring(r,l);
source:=p;
dest:=tcompilerwidecharptr(r^.data);
dest:=tcompilerwidecharptr(r.data);
if codepagetranslation then
begin
if cp<>CP_UTF8 then
@ -224,11 +223,11 @@ unit widestr;
end
else
begin
r^.len:=Utf8ToUnicode(punicodechar(r^.data),r^.maxlen,p,l);
r.len:=Utf8ToUnicode(punicodechar(r.data),r.maxlen,p,l);
{ -1, because utf8tounicode includes room for a terminating 0 in
its result count }
if r^.len>0 then
dec(r^.len);
if r.len>0 then
dec(r.len);
end;
end
else
@ -243,7 +242,14 @@ unit widestr;
end;
procedure unicode2ascii(r : pcompilerwidestring;p:pchar;cp : tstringencoding);
procedure unicode2ascii(r : tcompilerwidestring;arr:TAnsiCharDynArray;cp : tstringencoding);
begin
if (r.len=0) or (length(arr)=0) then
exit;
unicode2ascii(r,Pchar(@arr[0]),cp);
end;
procedure unicode2ascii(r : tcompilerwidestring;p:pchar;cp : tstringencoding);
var
m : punicodemap;
source : tcompilerwidecharptr;
@ -259,9 +265,9 @@ unit widestr;
m:=getmap(current_settings.sourcecodepage)
else
m:=getmap(cp);
source:=tcompilerwidecharptr(r^.data);
source:=tcompilerwidecharptr(r.data);
dest:=p;
for i:=1 to r^.len do
for i:=1 to r.len do
begin
dest^ := getascii(source^,m)[1];
inc(dest);
@ -270,14 +276,14 @@ unit widestr;
end;
function hasnonasciichars(const p: pcompilerwidestring): boolean;
function hasnonasciichars(const p: tcompilerwidestring): boolean;
var
source : tcompilerwidecharptr;
i : longint;
begin
source:=tcompilerwidecharptr(p^.data);
source:=tcompilerwidecharptr(p.data);
result:=true;
for i:=1 to p^.len do
for i:=1 to p.len do
begin
if word(source^)>=128 then
exit;
@ -377,4 +383,16 @@ unit widestr;
result:=charlength(@s[1],length(s));
end;
{ tcompilerwidestring }
const
cEmptyUnicodeChar : UnicodeChar = #0;
function tcompilerwidestring.asconstpunicodechar: PUnicodeChar;
begin
if length(data)>0 then
result:=@Data[0]
else
result:=@cEmptyUnicodeChar;
end;
end.