paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-03 07:18:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed conversion of fpc_*str_unique to compilerproc

Browse Source
This commit is contained in:
Jonas Maebe 2003-06-17 19:24:08 +00:00
parent aa9f048e02
commit 4be7651aa2
5 changed files with 28 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
compiler/ncgmem.pas
View File

@ -582,37 +582,7 @@ implementation
is_widestring(left.resulttype.def) then
begin
if nf_callunique in flags then
begin
if left.location.loc<>LOC_REFERENCE then
internalerror(200304236);
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,VOLATILE_INTREGISTERS);
{$endif}
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,VOLATILE_INTREGISTERS);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
paramanager.freeintparaloc(exprasmlist,1);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end;
internalerror(200304236);
case left.location.loc of
LOC_REGISTER,
@ -954,7 +924,10 @@ begin
end.
{
$Log$
Revision 1.63 2003-06-17 16:34:44 jonas
Revision 1.64 2003-06-17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.63 2003/06/17 16:34:44 jonas
* lots of newra fixes (need getfuncretparaloc implementation for i386)!
* renamed all_intregisters to volatile_intregisters and made it
processor dependent

10
compiler/nmem.pas
View File

@ -699,9 +699,10 @@ implementation
(is_ansistring(left.resulttype.def) or
is_widestring(left.resulttype.def)) then
begin
left := ccallnode.createintern('fpc_'+tstringdef(left.resulttype.def).stringtypname+'_unique',
left := ctypeconvnode.create_explicit(ccallnode.createintern('fpc_'+tstringdef(left.resulttype.def).stringtypname+'_unique',
ccallparanode.create(
ctypeconvnode.create_explicit(left,voidpointertype),nil));
ctypeconvnode.create_explicit(left,voidpointertype),nil)),
left.resulttype);
firstpass(left);
{ double resulttype passes somwhere else may cause this to be }
{ reset though :/ }
@ -912,7 +913,10 @@ begin
end.
{
$Log$
Revision 1.58 2003-06-17 16:34:44 jonas
Revision 1.59 2003-06-17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.58 2003/06/17 16:34:44 jonas
* lots of newra fixes (need getfuncretparaloc implementation for i386)!
* renamed all_intregisters to volatile_intregisters and made it
processor dependent

7
rtl/inc/astrings.inc
View File

@ -512,7 +512,7 @@ end;
{ overloaded version of UniqueString for interface }
Procedure UniqueString(Var S : AnsiString); [external name 'FPC_ANSISTR_UNIQUE'];
Function fpc_ansistr_Unique(Var S : Pointer): Ansistring; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
{
Make sure reference count of S is 1,
using copy-on-write semantics.
@ -835,7 +835,10 @@ end;
{
$Log$
Revision 1.38 2003-06-17 16:38:53 jonas
Revision 1.39 2003-06-17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.38 2003/06/17 16:38:53 jonas
* fpc_{ansistr|widestr}_unique is now a function so it can be used as
compilerproc

9
rtl/inc/compproc.inc
View File

@ -103,7 +103,7 @@ Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString):
{ pointer argument because otherwise when calling this, we get }
{ an endless loop since a 'var s: ansistring' must be made }
{ unique as well }
Function fpc_ansistr_Unique(Var S : Pointer): Ansistring; compilerproc;
Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
Procedure fpc_WideStr_Incr_Ref (S : Pointer); compilerproc;
@ -121,7 +121,7 @@ Function fpc_WideStr_Compare(const S1,S2 : WideString): Longint; compilerproc;
Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;
Procedure fpc_WideStr_CheckRange(len,index : longint); compilerproc;
Procedure fpc_WideStr_SetLength (Var S : WideString; l : Longint); compilerproc;
function fpc_widestr_Unique(Var S : Pointer): Widestring; compilerproc;
function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
{$ifdef HASWIDECHAR}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
@ -294,7 +294,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
{
$Log$
Revision 1.44 2003-06-17 16:38:53 jonas
Revision 1.45 2003-06-17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.44 2003/06/17 16:38:53 jonas
* fpc_{ansistr|widestr}_unique is now a function so it can be used as
compilerproc

7
rtl/inc/wstrings.inc
View File

@ -674,7 +674,7 @@ end;
{ overloaded version of UniqueString for interface }
procedure UniqueString(Var S : WideString); [external name 'FPC_WIDESTR_UNIQUE'];
Function fpc_widestr_Unique(Var S : Pointer): Widestring; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
Function fpc_widestr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_WIDESTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif}
{
Make sure reference count of S is 1,
using copy-on-write semantics.
@ -993,7 +993,10 @@ end;
{
$Log$
Revision 1.30 2003-06-17 16:38:53 jonas
Revision 1.31 2003-06-17 19:24:08 jonas
* fixed conversion of fpc_*str_unique to compilerproc
Revision 1.30 2003/06/17 16:38:53 jonas
* fpc_{ansistr|widestr}_unique is now a function so it can be used as
compilerproc