mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-19 16:31:50 +02:00
* some fixes in compilerprocs for chararray to string conversions
* conversion from string to chararray is now also done via compilerprocs
This commit is contained in:
Jonas Maebe
parent
cecfe5dd49
commit
06f9cd4c96
@ -265,19 +265,10 @@ implementation
|
||||
|
||||
procedure ti386typeconvnode.second_string_to_chararray;
|
||||
var
|
||||
pushedregs: tpushed;
|
||||
//l1 : tasmlabel;
|
||||
//hr : preference;
|
||||
arrsize, strtype: longint;
|
||||
regstopush: byte;
|
||||
arrsize: longint;
|
||||
begin
|
||||
with tarraydef(resulttype.def) do
|
||||
begin
|
||||
if highrange<lowrange then
|
||||
internalerror(75432653);
|
||||
arrsize := highrange-lowrange+1;
|
||||
end;
|
||||
|
||||
arrsize := highrange-lowrange+1;
|
||||
if (left.nodetype = stringconstn) and
|
||||
{ left.length+1 since there's always a terminating #0 character (JM) }
|
||||
(tstringconstnode(left).len+1 >= arrsize) and
|
||||
@ -285,67 +276,10 @@ implementation
|
||||
begin
|
||||
inc(location.reference.offset);
|
||||
exit;
|
||||
end;
|
||||
clear_location(location);
|
||||
location.loc := LOC_REFERENCE;
|
||||
gettempofsizereference(arrsize,location.reference);
|
||||
|
||||
regstopush := $ff;
|
||||
remove_non_regvars_from_loc(left.location,regstopush);
|
||||
pushusedregisters(pushedregs,regstopush);
|
||||
|
||||
emit_push_lea_loc(location,false);
|
||||
|
||||
case tstringdef(left.resulttype.def).string_typ of
|
||||
st_shortstring :
|
||||
begin
|
||||
{ 0 means shortstring }
|
||||
strtype := 0;
|
||||
del_reference(left.location.reference);
|
||||
emit_push_lea_loc(left.location,true);
|
||||
ungetiftemp(left.location.reference);
|
||||
end;
|
||||
st_ansistring :
|
||||
begin
|
||||
{ 1 means ansistring }
|
||||
strtype := 1;
|
||||
case left.location.loc of
|
||||
LOC_CREGISTER,LOC_REGISTER:
|
||||
begin
|
||||
ungetregister(left.location.register);
|
||||
emit_push_loc(left.location);
|
||||
end;
|
||||
LOC_MEM,LOC_REFERENCE:
|
||||
begin
|
||||
del_reference(left.location.reference);
|
||||
emit_push_loc(left.location);
|
||||
ungetiftemp(left.location.reference);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
st_longstring:
|
||||
begin
|
||||
{!!!!!!!}
|
||||
{ 2 means longstring, but still needs support in FPC_STR_TO_CHARARRAY,
|
||||
which is in i386.inc and/or generic.inc (JM) }
|
||||
strtype := 2;
|
||||
|
||||
internalerror(8888);
|
||||
end;
|
||||
st_widestring:
|
||||
begin
|
||||
{!!!!!!!}
|
||||
{ 3 means widestring, but still needs support in FPC_STR_TO_CHARARRAY,
|
||||
which is in i386.inc and/or generic.inc (JM) }
|
||||
strtype := 3;
|
||||
internalerror(8888);
|
||||
end;
|
||||
end;
|
||||
push_int(arrsize);
|
||||
push_int(strtype);
|
||||
saveregvars(regstopush);
|
||||
emitcall('FPC_STR_TO_CHARARRAY');
|
||||
popusedregisters(pushedregs);
|
||||
end
|
||||
else
|
||||
{ should be handled already in resulttype pass (JM) }
|
||||
internalerror(200108292);
|
||||
end;
|
||||
|
||||
|
||||
@ -1066,7 +1000,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2001-08-28 13:24:47 jonas
|
||||
Revision 1.22 2001-08-29 19:49:03 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.21 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -43,6 +43,7 @@ interface
|
||||
private
|
||||
function resulttype_cord_to_pointer : tnode;
|
||||
function resulttype_chararray_to_string : tnode;
|
||||
function resulttype_string_to_chararray : tnode;
|
||||
function resulttype_string_to_string : tnode;
|
||||
function resulttype_char_to_string : tnode;
|
||||
function resulttype_int_to_real : tnode;
|
||||
@ -57,7 +58,6 @@ interface
|
||||
function first_int_to_int : tnode;virtual;
|
||||
function first_cstring_to_pchar : tnode;virtual;
|
||||
function first_string_to_chararray : tnode;virtual;
|
||||
function first_string_to_string : tnode;virtual;
|
||||
function first_char_to_string : tnode;virtual;
|
||||
function first_nothing : tnode;virtual;
|
||||
function first_array_to_pointer : tnode;virtual;
|
||||
@ -430,6 +430,32 @@ implementation
|
||||
resulttypepass(result);
|
||||
end;
|
||||
|
||||
function ttypeconvnode.resulttype_string_to_chararray : tnode;
|
||||
var
|
||||
arrsize: longint;
|
||||
begin
|
||||
with tarraydef(resulttype.def) do
|
||||
begin
|
||||
if highrange<lowrange then
|
||||
internalerror(75432653);
|
||||
arrsize := highrange-lowrange+1;
|
||||
end;
|
||||
if (left.nodetype = stringconstn) and
|
||||
{ left.length+1 since there's always a terminating #0 character (JM) }
|
||||
(tstringconstnode(left).len+1 >= arrsize) and
|
||||
(tstringdef(left.resulttype.def).string_typ=st_shortstring) then
|
||||
begin
|
||||
{ handled separately }
|
||||
result := nil;
|
||||
exit;
|
||||
end;
|
||||
result := ccallnode.createinternres(
|
||||
'fpc_'+lower(tstringdef(left.resulttype.def).stringtypname)+
|
||||
'_to_chararray',ccallparanode.create(left,ccallparanode.create(
|
||||
cordconstnode.create(arrsize,s32bittype),nil)),resulttype);
|
||||
left := nil;
|
||||
resulttypepass(result);
|
||||
end;
|
||||
|
||||
function ttypeconvnode.resulttype_string_to_string : tnode;
|
||||
var
|
||||
@ -653,7 +679,7 @@ implementation
|
||||
{ cchar_2_pchar } @ttypeconvnode.resulttype_cchar_to_pchar,
|
||||
{ cstring_2_pchar } @ttypeconvnode.resulttype_cstring_to_pchar,
|
||||
{ ansistring_2_pchar } nil,
|
||||
{ string_2_chararray } nil,
|
||||
{ string_2_chararray } @ttypeconvnode.resulttype_string_to_chararray,
|
||||
{ chararray_2_string } @ttypeconvnode.resulttype_chararray_to_string,
|
||||
{ array_2_pointer } nil,
|
||||
{ pointer_2_array } nil,
|
||||
@ -1068,23 +1094,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.first_string_to_string : tnode;
|
||||
begin
|
||||
first_string_to_string:=nil;
|
||||
if tstringdef(resulttype.def).string_typ<>
|
||||
tstringdef(left.resulttype.def).string_typ then
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
||||
end;
|
||||
{ for simplicity lets first keep all ansistrings
|
||||
as LOC_MEM, could also become LOC_REGISTER }
|
||||
if tstringdef(resulttype.def).string_typ in [st_ansistring,st_widestring] then
|
||||
{ we may use ansistrings so no fast exit here }
|
||||
procinfo^.no_fast_exit:=true;
|
||||
location.loc:=LOC_MEM;
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.first_char_to_string : tnode;
|
||||
begin
|
||||
first_char_to_string:=nil;
|
||||
@ -1262,14 +1271,14 @@ implementation
|
||||
firstconvert : array[tconverttype] of pointer = (
|
||||
@ttypeconvnode.first_nothing, {equal}
|
||||
@ttypeconvnode.first_nothing, {not_possible}
|
||||
@ttypeconvnode.first_string_to_string,
|
||||
nil, { removed in resulttype_string_to_string }
|
||||
@ttypeconvnode.first_char_to_string,
|
||||
@ttypeconvnode.first_nothing, { removed in resulttype_chararray_to_string }
|
||||
nil, { removed in resulttype_chararray_to_string }
|
||||
@ttypeconvnode.first_cchar_to_pchar,
|
||||
@ttypeconvnode.first_cstring_to_pchar,
|
||||
@ttypeconvnode.first_ansistring_to_pchar,
|
||||
@ttypeconvnode.first_string_to_chararray,
|
||||
@ttypeconvnode.first_nothing, { removed in resulttype_chararray_to_string }
|
||||
nil, { removed in resulttype_chararray_to_string }
|
||||
@ttypeconvnode.first_array_to_pointer,
|
||||
@ttypeconvnode.first_pointer_to_array,
|
||||
@ttypeconvnode.first_int_to_int,
|
||||
@ -1477,7 +1486,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 2001-08-29 12:18:07 jonas
|
||||
Revision 1.35 2001-08-29 19:49:03 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.34 2001/08/29 12:18:07 jonas
|
||||
+ new createinternres() constructor for tcallnode to support setting a
|
||||
custom resulttype
|
||||
* compilerproc typeconversions now set the resulttype from the type
|
||||
|
||||
@ -888,6 +888,11 @@ begin
|
||||
cld
|
||||
movl arr,%esi
|
||||
movl arr+4,%ecx
|
||||
{$ifdef hascompilerproc}
|
||||
{ previous implementations passed length(arr), with compilerproc }
|
||||
{ we only have high(arr), so add one (JM) }
|
||||
incl %ecx
|
||||
{$endif hascompilerproc}
|
||||
orl %esi,%esi
|
||||
jnz .LStrCharArrayNotNil
|
||||
movl $0,%ecx
|
||||
@ -1139,7 +1144,11 @@ procedure inclocked(var l : longint);assembler;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2001-08-28 13:24:47 jonas
|
||||
Revision 1.16 2001-08-29 19:49:04 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.15 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -314,6 +314,8 @@ begin
|
||||
{ result is automatically set to '' }
|
||||
exit;
|
||||
i:=IndexChar(arr,high(arr)+1,#0);
|
||||
if i = -1 then
|
||||
i := high(arr)+1;
|
||||
SetLength(fpc_CharArray_To_AnsiStr,i);
|
||||
Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
|
||||
end;
|
||||
@ -321,13 +323,46 @@ end;
|
||||
{ old style helper }
|
||||
{$ifndef hascompilerproc}
|
||||
{ the declaration below is the same as }
|
||||
{ Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; p: pointer; len: longint); }
|
||||
{ which is what the old helper was (we need the parameter as "array of char" type }
|
||||
{ so we can pass it to the new style helper (JM) }
|
||||
Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; const arr: array of char);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
Procedure fpc_CharArray_To_AnsiStr(var a : ansistring; p: pointer; len: longint);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
var
|
||||
src: pchar;
|
||||
i: longint;
|
||||
begin
|
||||
pointer(a) := pointer(fpc_CharArray_To_AnsiStr(arr));
|
||||
src := pchar(p);
|
||||
if src[0]=#0 Then
|
||||
{ result is automatically set to '' }
|
||||
begin
|
||||
pointer(a) := nil;
|
||||
exit;
|
||||
end;
|
||||
i:=IndexChar(src^,len,#0);
|
||||
if i = -1 then
|
||||
i := len;
|
||||
pointer(a) := NewAnsiString(i);
|
||||
Move (src^,a[1],i);
|
||||
end;
|
||||
{$endif not hascompilerproc}
|
||||
|
||||
|
||||
{$ifdef hascompilerproc}
|
||||
|
||||
{ note: inside the compiler, the resulttype is modified to be the length }
|
||||
{ of the actual chararray to which we convert (JM) }
|
||||
function fpc_ansistr_to_chararray(arraysize: longint; const src: ansistring): fpc_big_chararray; [public, alias: 'FPC_ANSISTR_TO_CHARARRAY']; compilerproc;
|
||||
var
|
||||
len: longint;
|
||||
begin
|
||||
len := length(src);
|
||||
if len > arraysize then
|
||||
len := arraysize;
|
||||
{ make sure we don't try to access element 1 of the ansistring if it's nil }
|
||||
if len > 0 then
|
||||
move(src[1],fpc_ansistr_to_chararray[0],len);
|
||||
fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
|
||||
end;
|
||||
|
||||
{$endif hascompilerproc}
|
||||
|
||||
|
||||
@ -759,7 +794,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2001-08-28 13:24:47 jonas
|
||||
Revision 1.20 2001-08-29 19:49:04 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.19 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -24,6 +24,9 @@
|
||||
|
||||
{$ifdef hascompilerproc}
|
||||
|
||||
type
|
||||
fpc_big_chararray = array[0..maxlongint] of char;
|
||||
|
||||
procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc;
|
||||
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
|
||||
procedure fpc_shortstr_concat(const s1,s2:shortstring); compilerproc;
|
||||
@ -31,7 +34,8 @@ function fpc_shortstr_compare(const dstr,sstr:shortstring) : longint; compilerpr
|
||||
function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
|
||||
|
||||
function fpc_chararray_to_shortstr(const arr: array of char):shortstring; compilerproc;
|
||||
procedure fpc_str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);compilerproc;
|
||||
function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
|
||||
|
||||
|
||||
function fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
|
||||
function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
|
||||
@ -61,6 +65,7 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerp
|
||||
Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
|
||||
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
|
||||
Function fpc_CharArray_To_AnsiStr(const arr: array of char): ansistring; compilerproc;
|
||||
function fpc_ansistr_to_chararray(arraysize: longint; const src: ansistring): fpc_big_chararray; compilerproc;
|
||||
Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
|
||||
Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
|
||||
Procedure fpc_AnsiStr_CheckRange(len,index : longint); compilerproc;
|
||||
@ -81,6 +86,7 @@ Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc;
|
||||
Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
|
||||
Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
|
||||
Function fpc_CharArray_To_WideStr(const arr: array of char): WideString; compilerproc;
|
||||
function fpc_widestr_to_chararray(arraysize: longint; const src: WideString): fpc_big_chararray; compilerproc;
|
||||
Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint; compilerproc;
|
||||
Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
|
||||
Procedure fpc_WideStr_CheckRange(len,index : longint); compilerproc;
|
||||
@ -231,7 +237,11 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2001-08-28 13:24:47 jonas
|
||||
Revision 1.6 2001-08-29 19:49:04 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.5 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -614,21 +614,50 @@ function strpas(p:pchar):shortstring; [external name 'FPC_PCHAR_TO_SHORTSTR'];
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
|
||||
|
||||
function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
{$ifdef hascompilerproc}
|
||||
function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
|
||||
var
|
||||
s: shortstring;
|
||||
l: longint;
|
||||
{$else hascompilerproc}
|
||||
function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
|
||||
{$endif hascompilerproc}
|
||||
begin
|
||||
{$ifdef hascompilerproc}
|
||||
l := high(arr)+1;
|
||||
{$endif hascompilerproc}
|
||||
if l>=256 then
|
||||
l:=255
|
||||
else if l<0 then
|
||||
l:=0;
|
||||
move(p^,s[1],l);
|
||||
s[0]:=chr(l);
|
||||
strchararray := s;
|
||||
move(arr[0],fpc_chararray_to_shortstr[1],l);
|
||||
fpc_chararray_to_shortstr[0]:=chr(l);
|
||||
end;
|
||||
|
||||
{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
|
||||
|
||||
{$ifdef hascompilerproc}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
|
||||
|
||||
{ inside the compiler, the resulttype is modified to that of the actual }
|
||||
{ chararray we're converting to (JM) }
|
||||
function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
|
||||
var
|
||||
len: longint;
|
||||
begin
|
||||
len := length(src);
|
||||
if len > arraysize then
|
||||
len := arraysize;
|
||||
{ make sure we don't access char 1 if length is 0 (JM) }
|
||||
if len > 0 then
|
||||
move(src[1],fpc_shortstr_to_chararray[0],len);
|
||||
fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
|
||||
end;
|
||||
|
||||
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
|
||||
|
||||
{$else hascompilerproc}
|
||||
|
||||
{$ifopt r+}
|
||||
{$define rangeon}
|
||||
{$r-}
|
||||
@ -664,6 +693,7 @@ begin
|
||||
move(src^,dest^,len);
|
||||
fillchar(dest[len],arraysize-len,0);
|
||||
end;
|
||||
|
||||
{$endif FPC_SYSTEM_HAS_FPC_STR_TO_CHARARRAY}
|
||||
|
||||
{$ifdef rangeon}
|
||||
@ -671,6 +701,8 @@ end;
|
||||
{undef rangeon}
|
||||
{$endif rangeon}
|
||||
|
||||
{$endif hascompilerproc}
|
||||
|
||||
{$ifndef FPC_SYSTEM_HAS_STRLEN}
|
||||
|
||||
function strlen(p:pchar):longint;
|
||||
@ -857,7 +889,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 2001-08-28 13:24:47 jonas
|
||||
Revision 1.19 2001-08-29 19:49:04 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.18 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
@ -402,19 +402,47 @@ begin
|
||||
{ result is automatically set to '' }
|
||||
exit;
|
||||
i:=IndexChar(arr,high(arr)+1,#0);
|
||||
if i = -1 then
|
||||
i := high(arr)+1;
|
||||
SetLength(fpc_CharArray_To_WideStr,i);
|
||||
Ansi2WideMoveProc (pchar(@arr),PWideChar(Pointer(fpc_CharArray_To_WideStr)),i);
|
||||
end;
|
||||
|
||||
{ old style helper }
|
||||
{$ifndef hascompilerproc}
|
||||
{ the declaration below is the same as }
|
||||
{ Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: longint); }
|
||||
{ which is what the old helper was (we need the parameter as "array of char" type }
|
||||
{ so we can pass it to the new style helper (JM) }
|
||||
Procedure fpc_CharArray_To_WideStr(var a : WideString; const arr: array of char);[Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
Procedure fpc_CharArray_To_WideStr(var a : WideString; p: pointer; len: longint); [Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
var
|
||||
src: pchar;
|
||||
i: longint;
|
||||
begin
|
||||
pointer(a) := pointer(fpc_CharArray_To_WideStr(arr));
|
||||
src := pchar(p);
|
||||
if src[0]=#0 Then
|
||||
begin
|
||||
pointer(a) := nil;
|
||||
exit;
|
||||
end;
|
||||
i:=IndexChar(src^,len,#0);
|
||||
if i = -1 then
|
||||
i := len;
|
||||
pointer(a) := NewWideString(i);
|
||||
Ansi2WideMoveProc (src,PWideChar(Pointer(@a[1])),i);
|
||||
end;
|
||||
{$endif not hascompilerproc}
|
||||
|
||||
{$ifdef hascompilerproc}
|
||||
{ inside the compiler, the resulttype is modified to that of the actual }
|
||||
{ chararray we're converting to (JM) }
|
||||
function fpc_widestr_to_chararray(arraysize: longint; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
|
||||
var
|
||||
len: longint;
|
||||
begin
|
||||
len := length(src);
|
||||
if len > arraysize then
|
||||
len := arraysize;
|
||||
{ make sure we don't dereference src if it can be nil (JM) }
|
||||
if len > 0 then
|
||||
wide2ansimoveproc(pwidechar(@src[1]),pchar(@fpc_widestr_to_chararray[0]),len);
|
||||
fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
|
||||
end;
|
||||
{$endif hascompilerproc}
|
||||
|
||||
@ -812,7 +840,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2001-08-28 13:24:47 jonas
|
||||
Revision 1.14 2001-08-29 19:49:04 jonas
|
||||
* some fixes in compilerprocs for chararray to string conversions
|
||||
* conversion from string to chararray is now also done via compilerprocs
|
||||
|
||||
Revision 1.13 2001/08/28 13:24:47 jonas
|
||||
+ compilerproc implementation of most string-related type conversions
|
||||
- removed all code from the compiler which has been replaced by
|
||||
compilerproc implementations (using {$ifdef hascompilerproc} is not
|
||||
|
||||
Loading…
Reference in New Issue
Block a user