paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 09:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* array of char support for Str()

Browse Source
This commit is contained in:
peter 2002-09-02 19:24:41 +00:00
parent 36481b72bb
commit a17291b2d4
4 changed files with 77 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/ncnv.pas
View File

@ -1232,7 +1232,8 @@ implementation
begin
if not(
(left.resulttype.def.deftype=formaldef) or
(left.resulttype.def.size=resulttype.def.size) or
(not(is_open_array(left.resulttype.def)) and
(left.resulttype.def.size=resulttype.def.size)) or
(is_void(left.resulttype.def) and
(left.nodetype=derefn))
) then
@ -2026,7 +2027,10 @@ begin
end.
{
$Log$
Revision 1.74 2002-09-01 08:01:16 daniel
Revision 1.75 2002-09-02 19:24:42 peter
* array of char support for Str()
Revision 1.74 2002/09/01 08:01:16 daniel
* Removed sets from Tcallnode.det_resulttype
+ Added read/write notifications of variables. These will be usefull
for providing information for several optimizations. For example

13
compiler/ninl.pas
View File

@ -154,7 +154,8 @@ implementation
is_real := source.resulttype.def.deftype = floatdef;
if not assigned(dest) or
(dest.left.resulttype.def.deftype<>stringdef) or
((dest.left.resulttype.def.deftype<>stringdef) and
not(is_chararray(dest.left.resulttype.def))) or
not(is_real or
(source.left.resulttype.def.deftype = orddef)) then
begin
@ -230,7 +231,10 @@ implementation
left := nil;
{ create procedure name }
procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
if is_chararray(dest.resulttype.def) then
procname:='fpc_chararray_'
else
procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
if is_real then
procname := procname + 'float'
else
@ -2362,7 +2366,10 @@ begin
end.
{
$Log$
Revision 1.84 2002-08-19 19:36:43 peter
Revision 1.85 2002-09-02 19:24:42 peter
* array of char support for Str()
Revision 1.84 2002/08/19 19:36:43 peter
* More fixes for cross unit inlining, all tnodes are now implemented
* Moved pocall_internconst to po_internconst because it is not a
calling type at all and it conflicted when inlining of these small

8
rtl/inc/compproc.inc
View File

@ -61,6 +61,9 @@ function fpc_dynarray_copy(var p : pointer;ti : pointer;
procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring); compilerproc;
procedure fpc_ShortStr_Longint(v : longint;len : longint;var s : shortstring); compilerproc;
procedure fpc_shortstr_cardinal(v : cardinal;len : longint;var s : shortstring); compilerproc;
procedure fpc_chararray_Float(d : ValReal;len,fr,rt : longint;var a : array of char); compilerproc;
procedure fpc_chararray_Longint(v : longint;len : longint;var a : array of char); compilerproc;
procedure fpc_chararray_cardinal(v : cardinal;len : longint;var a : array of char); compilerproc;
Function fpc_Val_SInt_ShortStr(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; compilerproc;
Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; compilerproc;
Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; compilerproc;
@ -262,7 +265,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{
$Log$
Revision 1.19 2002-08-20 18:24:05 jonas
Revision 1.20 2002-09-02 19:24:41 peter
* array of char support for Str()
Revision 1.19 2002/08/20 18:24:05 jonas
* interface "as" helpers converted from procedures to functions
Revision 1.18 2002/07/31 16:58:12 jonas

56
rtl/inc/sstrings.inc
View File

@ -361,6 +361,55 @@ begin
end;
{
Array Of Char Str() helpers
}
procedure fpc_chararray_longint(v : longint;len : longint;var a:array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
var
ss : shortstring;
maxlen : longint;
begin
int_str(v,ss);
if length(ss)<len then
ss:=space(len-length(ss))+ss;
if length(ss)<high(a)+1 then
maxlen:=length(ss)
else
maxlen:=high(a)+1;
move(ss[1],pchar(@a)^,maxlen);
end;
procedure fpc_chararray_cardinal(v : cardinal;len : longint;var a : array of char);{$ifdef hascompilerproc} compilerproc; {$endif}
var
ss : shortstring;
maxlen : longint;
begin
int_str(v,ss);
if length(ss)<len then
ss:=space(len-length(ss))+ss;
if length(ss)<high(a)+1 then
maxlen:=length(ss)
else
maxlen:=high(a)+1;
move(ss[1],pchar(@a)^,maxlen);
end;
procedure fpc_chararray_Float(d : ValReal;len,fr,rt : longint;var a : array of char);{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
var
ss : shortstring;
maxlen : longint;
begin
str_real(len,fr,d,treal_type(rt),ss);
if length(ss)<high(a)+1 then
maxlen:=length(ss)
else
maxlen:=high(a)+1;
move(ss[1],pchar(@a)^,maxlen);
end;
{*****************************************************************************
Val() Functions
@ -403,7 +452,7 @@ begin
repeat
inc(code);
until (code>=length(s)) or (s[code]<>'0');
end;
end;
end;
end;
InitVal:=code;
@ -611,7 +660,10 @@ end;
{
$Log$
Revision 1.19 2002-08-06 20:53:38 michael
Revision 1.20 2002-09-02 19:24:41 peter
* array of char support for Str()
Revision 1.19 2002/08/06 20:53:38 michael
+ Added support for octal strings (using &)
Revision 1.18 2002/01/24 18:27:06 peter