diff --git a/compiler/i386/cgai386.pas b/compiler/i386/cgai386.pas index 961f19db08..7bf05d6549 100644 --- a/compiler/i386/cgai386.pas +++ b/compiler/i386/cgai386.pas @@ -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 diff --git a/compiler/i386/n386add.pas b/compiler/i386/n386add.pas index bf2dd04714..5bd067ff5a 100644 --- a/compiler/i386/n386add.pas +++ b/compiler/i386/n386add.pas @@ -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 diff --git a/compiler/i386/n386ld.pas b/compiler/i386/n386ld.pas index a5e1102980..1533c69181 100644 --- a/compiler/i386/n386ld.pas +++ b/compiler/i386/n386ld.pas @@ -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 diff --git a/compiler/messages.pas b/compiler/messages.pas index 8c470e6c9a..0f52b44439 100644 --- a/compiler/messages.pas +++ b/compiler/messages.pas @@ -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 diff --git a/compiler/nadd.pas b/compiler/nadd.pas index ed7a245524..f4568cb5d8 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 8b985df1a8..29b028e2a9 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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 diff --git a/compiler/temp_gen.pas b/compiler/temp_gen.pas index 99f88cbf5d..64030ec121 100644 --- a/compiler/temp_gen.pas +++ b/compiler/temp_gen.pas @@ -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 diff --git a/compiler/verbose.pas b/compiler/verbose.pas index 5708cffdfa..cc82afd0e6 100644 --- a/compiler/verbose.pas +++ b/compiler/verbose.pas @@ -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 diff --git a/compiler/widestr.pas b/compiler/widestr.pas index f62d9239a8..5c3901dfec 100644 --- a/compiler/widestr.pas +++ b/compiler/widestr.pas @@ -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