From a2c9c75e979186646aeb94403ab49bd021a78947 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 3 Jun 2016 21:25:49 +0000 Subject: [PATCH] Convert Insert() and Delete() to intrinsics in preparation for dynamic array support for these two procedures. Since overloading compilerprocs does not work each procedure got its own unique name, but they are using the new compilerproc extension to map them to the Insert and Delete symbol so that error messages can be shown with the respective name for the procedure declarations instead of fpc_shortstr_delete for example. git-svn-id: trunk@33895 - --- compiler/compinnr.inc | 2 ++ compiler/ninl.pas | 76 +++++++++++++++++++++++++++++++++++++++++++ compiler/pexpr.pas | 10 ++++++ compiler/pinline.pas | 27 +++++++++++++-- compiler/psystem.pas | 2 ++ rtl/inc/astrings.inc | 4 +-- rtl/inc/compproc.inc | 17 ++++++++++ rtl/inc/sstrings.inc | 6 ++-- rtl/inc/systemh.inc | 4 +++ rtl/inc/ustringh.inc | 2 ++ rtl/inc/ustrings.inc | 4 +-- rtl/inc/wstringh.inc | 2 ++ rtl/inc/wstrings.inc | 4 +-- 13 files changed, 148 insertions(+), 12 deletions(-) diff --git a/compiler/compinnr.inc b/compiler/compinnr.inc index 65515d1fd8..a553b3205b 100644 --- a/compiler/compinnr.inc +++ b/compiler/compinnr.inc @@ -89,6 +89,8 @@ const in_popcnt_x = 79; in_aligned_x = 80; in_setstring_x_y_z = 81; + in_insert_x_y_z = 82; + in_delete_x_y_z = 83; { Internal constant functions } in_const_sqr = 100; diff --git a/compiler/ninl.pas b/compiler/ninl.pas index b1db495145..a1e0772215 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -99,6 +99,8 @@ interface function handle_copy: tnode; function handle_box: tnode; function handle_unbox: tnode; + function handle_insert:tnode; + function handle_delete:tnode; end; tinlinenodeclass = class of tinlinenode; @@ -3286,6 +3288,14 @@ implementation set_varstate(tcallparanode(tcallparanode(tcallparanode(left).right).right).left,vs_read,[vsf_must_be_valid]); resultdef:=tcallparanode(left).left.resultdef; end; + in_delete_x_y_z: + begin + result:=handle_delete; + end; + in_insert_x_y_z: + begin + result:=handle_insert; + end; else internalerror(8); end; @@ -4255,6 +4265,72 @@ implementation resultdef:=tcallparanode(left).left.resultdef; end; + function tinlinenode.handle_insert: tnode; + var + procname : String; + first, + second : tdef; + begin + { determine the correct function based on the second parameter } + first:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef; + second:=tcallparanode(tcallparanode(left).right).left.resultdef; + if is_shortstring(second) then + begin + if is_char(first) then + procname:='fpc_shortstr_insert_char' + else + procname:='fpc_shortstr_insert'; + end + else if is_unicodestring(second) then + procname:='fpc_unicodestr_insert' + else if is_widestring(second) then + procname:='fpc_widestr_insert' + else if is_ansistring(second) then + procname:='fpc_ansistr_insert' + else + begin + CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Insert'); + write_system_parameter_lists('fpc_shortstr_insert'); + write_system_parameter_lists('fpc_shortstr_insert_char'); + write_system_parameter_lists('fpc_unicodestr_insert'); + if target_info.system in systems_windows then + write_system_parameter_lists('fpc_widestr_insert'); + write_system_parameter_lists('fpc_ansistr_insert'); + exit(cerrornode.create); + end; + result:=ccallnode.createintern(procname,left); + left:=nil; + end; + + function tinlinenode.handle_delete: tnode; + var + procname : String; + first : tdef; + begin + { determine the correct function based on the first parameter } + first:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef; + if is_shortstring(first) then + procname:='fpc_shortstr_delete' + else if is_unicodestring(first) then + procname:='fpc_unicodestr_delete' + else if is_widestring(first) then + procname:='fpc_widestr_delete' + else if is_ansistring(first) then + procname:='fpc_ansistr_delete' + else + begin + CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Delete'); + write_system_parameter_lists('fpc_shortstr_delete'); + write_system_parameter_lists('fpc_unicodestr_delete'); + if target_info.system in systems_windows then + write_system_parameter_lists('fpc_widestr_delete'); + write_system_parameter_lists('fpc_ansistr_delete'); + exit(cerrornode.create); + end; + result:=ccallnode.createintern(procname,left); + left:=nil; + end; + function tinlinenode.first_pack_unpack: tnode; var diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 47c96cebd0..6f5bb788f9 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -914,6 +914,16 @@ implementation begin statement_syssym := inline_setstring; end; + + in_delete_x_y_z: + begin + statement_syssym:=inline_delete; + end; + + in_insert_x_y_z: + begin + statement_syssym:=inline_insert; + end; else internalerror(15); diff --git a/compiler/pinline.pas b/compiler/pinline.pas index 8b1733fae2..ec76c9836a 100644 --- a/compiler/pinline.pas +++ b/compiler/pinline.pas @@ -39,6 +39,8 @@ interface function inline_initialize : tnode; function inline_finalize : tnode; function inline_copy : tnode; + function inline_insert : tnode; + function inline_delete : tnode; implementation @@ -636,7 +638,7 @@ implementation end; - function inline_copy : tnode; + function inline_copy_insert_delete(nr:byte;name:string) : tnode; var paras : tnode; { for easy exiting if something goes wrong } @@ -648,11 +650,30 @@ implementation consume(_RKLAMMER); if not assigned(paras) then begin - CGMessage1(parser_e_wrong_parameter_size,'Copy'); + CGMessage1(parser_e_wrong_parameter_size,name); exit; end; result.free; - result:=cinlinenode.create(in_copy_x,false,paras); + result:=cinlinenode.create(nr,false,paras); end; + + function inline_copy: tnode; + begin + result:=inline_copy_insert_delete(in_copy_x,'Copy'); + end; + + + function inline_insert: tnode; + begin + result:=inline_copy_insert_delete(in_insert_x_y_z,'Insert'); + end; + + + function inline_delete: tnode; + begin + result:=inline_copy_insert_delete(in_delete_x_y_z,'Delete'); + end; + + end. diff --git a/compiler/psystem.pas b/compiler/psystem.pas index d7bd1d54a9..b85c10a510 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -105,6 +105,8 @@ implementation systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only } systemunit.insert(csyssym.create('Default',in_default_x)); systemunit.insert(csyssym.create('SetString',in_setstring_x_y_z)); + systemunit.insert(csyssym.create('Insert',in_insert_x_y_z)); + systemunit.insert(csyssym.create('Delete',in_delete_x_y_z)); systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool8type)); systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool8type)); end; diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index 311ee78aba..b70d02c2a7 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -1350,7 +1350,7 @@ begin end; {$endif CPU16 or CPU8} -Procedure Delete(Var S : RawByteString; Index,Size: SizeInt); +Procedure {$ifdef VER3_0}Delete{$else}fpc_ansistr_delete{$endif}(Var S : RawByteString; Index,Size: SizeInt); Var LS : SizeInt; begin @@ -1369,7 +1369,7 @@ begin end; -Procedure Insert(Const Source : RawByteString; Var S : RawByteString; Index : SizeInt); +Procedure {$ifdef VER3_0}Insert{$else}fpc_ansistr_insert{$endif}(Const Source : RawByteString; Var S : RawByteString; Index : SizeInt); var Temp : RawByteString; LS : SizeInt; diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 14da974f00..cb5cff9d88 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -60,6 +60,11 @@ procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortStri Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc; function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc; +{$ifndef VER3_0} +Procedure fpc_shortstr_delete(var s:shortstring;index:SizeInt;count:SizeInt); compilerproc:83; +Procedure fpc_shortstr_insert(const source:shortstring;var s:shortstring;index:SizeInt); compilerproc:82; +Procedure fpc_shortstr_insert_char(source:Char;var s:shortstring;index:SizeInt); compilerproc:82; +{$endif VER3_0} {$ifdef FPC_HAS_FEATURE_DYNARRAYS} function fpc_dynarray_copy(psrc : pointer;ti : pointer; @@ -307,6 +312,10 @@ Procedure fpc_AnsiStr_RangeCheck(p : Pointer; index : SizeInt); compilerproc; Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc; Function fpc_ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt): RawByteString;compilerproc; +{$ifndef VER3_0} +Procedure fpc_ansistr_insert (const Source : RawByteString; var S : RawByteString; Index : SizeInt); compilerproc:82; rtlproc; +Procedure fpc_ansistr_delete (var S : RawByteString; Index,Size: SizeInt); compilerproc:83; rtlproc; +{$endif VER3_0} {$ifdef EXTRAANSISHORT} Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc; {$endif EXTRAANSISHORT} @@ -342,6 +351,10 @@ Procedure fpc_WideStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc; Procedure fpc_WideStr_SetLength (Var S : WideString; l : SizeInt); compilerproc; Function fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideString;compilerproc; +{$ifndef VER3_0} +Procedure fpc_widestr_insert (Const Source : WideString; Var S : WideString; Index : SizeInt); compilerproc:82; +Procedure fpc_widestr_delete (Var S : WideString; Index,Size: SizeInt); compilerproc:83; +{$endif VER3_0} {$ifndef FPC_WINLIKEWIDESTRING} function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc; {$endif FPC_WINLIKEWIDESTRING} @@ -386,6 +399,10 @@ Procedure fpc_UnicodeStr_RangeCheck(p: Pointer; index : SizeInt); compilerproc; Procedure fpc_UnicodeStr_SetLength (Var S : UnicodeString; l : SizeInt); compilerproc; Function fpc_unicodestr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc; +{$ifndef VER3_0} +Procedure fpc_unicodestr_insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); compilerproc:82; +Procedure fpc_unicodestr_delete (Var S : UnicodeString; Index,Size: SizeInt); compilerproc:83; +{$endif VER3_0} function fpc_unicodestr_Unique(Var S : Pointer): Pointer; compilerproc; Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc; Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc; diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 31c9899b87..64c0ad7914 100644 --- a/rtl/inc/sstrings.inc +++ b/rtl/inc/sstrings.inc @@ -49,7 +49,7 @@ end; {$ifndef FPC_HAS_SHORTSTR_DELETE} {$define FPC_HAS_SHORTSTR_DELETE} -procedure delete(var s : shortstring;index : SizeInt;count : SizeInt); +procedure {$ifdef VER3_0}delete{$else}fpc_shortstr_delete{$endif}(var s : shortstring;index : SizeInt;count : SizeInt); begin if index<=0 then exit; @@ -67,7 +67,7 @@ end; {$ifndef FPC_HAS_SHORTSTR_INSERT} {$define FPC_HAS_SHORTSTR_INSERT} -procedure insert(const source : shortstring;var s : shortstring;index : SizeInt); +procedure {$ifdef ver3_0}insert{$else}fpc_shortstr_insert{$endif}(const source : shortstring;var s : shortstring;index : SizeInt); var cut,srclen,indexlen : SizeInt; begin @@ -101,7 +101,7 @@ end; {$ifndef FPC_HAS_SHORTSTR_INSERT_CHAR} {$define FPC_HAS_SHORTSTR_INSERT_CHAR} -procedure insert(source : Char;var s : shortstring;index : SizeInt); +procedure {$ifdef ver3_0}insert{$else}fpc_shortstr_insert_char{$endif}(source : Char;var s : shortstring;index : SizeInt); var indexlen : SizeInt; begin diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 5d330375ec..e224e8195f 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -1127,9 +1127,11 @@ function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH'; function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningDiacriticalMarks: Boolean): SizeInt; { Shortstring functions } +{$ifdef VER3_0} Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt); Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt); Procedure Insert(source:Char;var s:shortstring;index:SizeInt); +{$endif VER3_0} Function Pos(const substr:shortstring;const s:shortstring; Offset: Sizeint = 1):SizeInt; Function Pos(C:Char;const s:shortstring; Offset: Sizeint = 1):SizeInt; {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} @@ -1180,8 +1182,10 @@ function pos(const substr : shortstring;c:char; Offset: Sizeint = 1): SizeInt; Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE'; Function Pos (const Substr : RawByteString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt; Function Pos (c : AnsiChar; const s : RawByteString; Offset: Sizeint = 1) : SizeInt; +{$ifdef VER3_0} Procedure Insert (const Source : RawByteString; var S : RawByteString; Index : SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING} Procedure Delete (var S : RawByteString; Index,Size: SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING} +{$endif VER3_0} Function StringOfChar(c : Ansichar;l : SizeInt) : AnsiString; function upcase(const s : ansistring) : ansistring; function lowercase(const s : ansistring) : ansistring; diff --git a/rtl/inc/ustringh.inc b/rtl/inc/ustringh.inc index ac1b0b8c08..16a1ab8389 100644 --- a/rtl/inc/ustringh.inc +++ b/rtl/inc/ustringh.inc @@ -28,8 +28,10 @@ Function UpCase(c:UnicodeChar):UnicodeChar; Function LowerCase(const s : UnicodeString) : UnicodeString; Function LowerCase(c:UnicodeChar):UnicodeChar; +{$ifdef VER3_0} Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt); +{$endif VER3_0} Procedure {$ifdef FPC_HAS_CPSTRING}fpc_setstring_unicodestr_pwidechar{$else}SetString{$endif}(Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt); {$ifdef FPC_HAS_CPSTRING} compilerproc; {$endif FPC_HAS_CPSTRING} Procedure {$ifdef FPC_HAS_CPSTRING}fpc_setstring_unicodestr_pansichar{$else}SetString{$endif}(Out S : UnicodeString; Buf : PChar; Len : SizeInt); {$ifdef FPC_HAS_CPSTRING} compilerproc; {$endif FPC_HAS_CPSTRING} diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index e90d18f928..f8944e3fd1 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -1265,7 +1265,7 @@ end; {$ifndef FPC_HAS_DELETE_UNICODESTR} {$define FPC_HAS_DELETE_UNICODESTR} -Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt); +Procedure {$ifdef VER3_0}Delete{$else}fpc_unicodestr_delete{$endif}(Var S : UnicodeString; Index,Size: SizeInt); Var LS : SizeInt; begin @@ -1289,7 +1289,7 @@ end; {$ifndef FPC_HAS_INSERT_UNICODESTR} {$define FPC_HAS_INSERT_UNICODESTR} -Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); +Procedure {$ifdef VER3_0}Insert{$else}fpc_unicodestr_insert{$endif}(Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt); var Temp : UnicodeString; LS : SizeInt; diff --git a/rtl/inc/wstringh.inc b/rtl/inc/wstringh.inc index 38eb418cf0..9ed46b11cf 100644 --- a/rtl/inc/wstringh.inc +++ b/rtl/inc/wstringh.inc @@ -26,8 +26,10 @@ Function Pos (const c : ShortString; Const s : WideString; Offset : SizeInt = 1) Function UpCase(const s : WideString) : WideString; +{$ifdef VER3_0} Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt); Procedure Delete (Var S : WideString; Index,Size: SizeInt); +{$endif VER3_0} Procedure {$ifdef FPC_HAS_CPSTRING}fpc_setstring_widestr_pwidechar{$else}SetString{$endif}(Out S : WideString; Buf : PWideChar; Len : SizeInt); {$ifdef FPC_HAS_CPSTRING} compilerproc; {$endif FPC_HAS_CPSTRING} Procedure {$ifdef FPC_HAS_CPSTRING}fpc_setstring_widestr_pansichar{$else}SetString{$endif}(Out S : WideString; Buf : PChar; Len : SizeInt); {$ifdef FPC_HAS_CPSTRING} compilerproc; {$endif FPC_HAS_CPSTRING} diff --git a/rtl/inc/wstrings.inc b/rtl/inc/wstrings.inc index 8081cfc352..dde4d3b787 100644 --- a/rtl/inc/wstrings.inc +++ b/rtl/inc/wstrings.inc @@ -679,7 +679,7 @@ end; -Procedure Delete (Var S : WideString; Index,Size: SizeInt); +Procedure {$ifdef VER3_0}Delete{$else}fpc_widestr_delete{$endif}(Var S : WideString; Index,Size: SizeInt); Var LS : SizeInt; begin @@ -699,7 +699,7 @@ begin end; -Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt); +Procedure {$ifdef VER3_0}Insert{$else}fpc_widestr_insert{$endif}(Const Source : WideString; Var S : WideString; Index : SizeInt); var Temp : WideString; LS : SizeInt;