Kaynağa Gözat

* some internal procedures take now an pointer instead of a
ansistring

florian 27 yıl önce
ebeveyn
işleme
5be9c5724b
1 değiştirilmiş dosya ile 59 ekleme ve 38 silme
  1. 59 38
      rtl/inc/astrings.pp

+ 59 - 38
rtl/inc/astrings.pp

@@ -38,7 +38,7 @@
 Type shortstring=string;
 
 Function  NewAnsiString (Len : Longint) : AnsiString; forward;
-Procedure DisposeAnsiString (Var S : AnsiString); forward;
+Procedure DisposeAnsiString (Var P : Pointer); forward;
 Procedure Decr_Ansi_Ref (Var S : AnsiString); forward;
 Procedure Incr_Ansi_Ref (Var S : AnsiString); forward;
 Procedure AssignAnsiString (Var S1 : AnsiString; S2 : Pointer); forward;
@@ -50,8 +50,6 @@ Function  AnsiCompare (Var S1,S2 : AnsiString): Longint; forward;
 Function  AnsiCompare (var S1 : AnsiString; Var S2 : ShortString): Longint; forward;
 Procedure SetCharAtIndex (Var S : AnsiString; Index : Longint; C : CHar); forward;
 
-{ Public functions, Will end up in systemh.inc }
-
 {$PACKRECORDS 1}
 Type TAnsiRec = Record
       Maxlen, len, ref :  Longint;
@@ -66,15 +64,14 @@ Const AnsiRecLen = SizeOf(TAnsiRec);
   Internal functions, not in interface.
   ---------------------------------------------------------------------}
 
-
-Procedure DumpAnsiRec (Var S : Ansistring);
+Procedure DumpAnsiRec(S : Pointer);
 
 begin
-  If Pointer(S)=Nil then
+  If S=Nil then
     Writeln ('String is nil')
   Else
     Begin
-    With PAnsiRec(Pointer(S)-Firstoff)^ do
+    With PAnsiRec(S-Firstoff)^ do
       begin
       Writeln ('Maxlen : ',maxlen);
       Writeln ('Len    : ',len);
@@ -83,9 +80,7 @@ begin
     end;
 end;
 
-
-
-Function  NewAnsiString (Len : Longint) : AnsiString;
+Function NewAnsiString(Len : Longint) : Pointer;
 {
   Allocate a new AnsiString on the heap.
   initialize it to zero length and reference count 1.
@@ -102,59 +97,60 @@ begin
      PAnsiRec(P)^.First:=#0;      { Terminating #0 }
      P:=P+FirstOff;               { Points to string now }
      end;
-  Pointer(NewAnsiString):=P;
+  NewAnsiString:=P;
 end;
 
-Procedure DisposeAnsiString (Var S : AnsiString);
+Procedure DisposeAnsiString(Var S : Pointer);
 {
   Deallocates a AnsiString From the heap.
 }
 begin
 //  Writeln ('In disposeAnsiSTring');
-  If Pointer(S)=Nil then exit;
+  If S=Nil
+    then exit;
   Dec (Longint(S),FirstOff);
-  FreeMem (Pointer(S),PAnsiRec(Pointer(S))^.Maxlen+AnsiRecLen);
-  Pointer(S):=Nil;
+  FreeMem (S,PAnsiRec(S)^.Maxlen+AnsiRecLen);
+  S:=Nil;
 end;
 
 
-Procedure Decr_Ansi_Ref (Var S : AnsiString);[Alias : 'FPC_DECR_ANSI_REF'];
+Procedure Decr_Ansi_Ref (P : Pointer);[Alias : 'FPC_DECR_ANSI_REF'];
 {
  Decreases the ReferenceCount of a non constant ansistring;
  If the reference count is zero, deallocate the string;
 }
 Type plongint = ^longint;
-
 Var l : plongint;
-
-
 Begin
 //  dumpansirec(s);
-  If Pointer(S)=Nil then exit; { Zero string }
+  { Zero string }
+  If S=Nil then
+    exit;
 
   { check for constant strings ...}
-  l:=Pointer(S)-FirstOff+8;
+  l:=S-FirstOff+8;
   If l^<0 then exit;
-  l^:=l^-1;
+  Dec(l^);
 //  dumpansirec(s);
   If l^=0 then
     { Ref count dropped to zero }
     begin
-//    Writeln ('CAlling disposestring');
+//    Writeln ('Calling disposestring');
     DisposeAnsiString (S);        { Remove...}
     end
 end;
 
-Procedure Incr_Ansi_Ref (Var S : AnsiString);[Alias : 'FPC_INCR_ANSI_REF'];
+Procedure Incr_Ansi_Ref (S : Pointer);[Alias : 'FPC_INCR_ANSI_REF'];
 
 Begin
-  If Pointer(S)=Nil then exit;
+  If S=Nil then
+    exit;
   { Let's be paranoid : Constant string ??}
-  If PansiRec(Pointer(S)-FirstOff)^.Ref<0 then exit;
-  inc(PAnsiRec(Pointer(S)-FirstOff)^.Ref);
+  If PAnsiRec(S-FirstOff)^.Ref<0 then exit;
+  Inc(PAnsiRec(S-FirstOff)^.Ref);
 end;
 
-Procedure UniqueAnsiString (Var S : AnsiString);
+Procedure UniqueAnsiString (Var S : Pointer);
 {
   Make sure reference count of S is 1,
   using copy-on-write semantics.
@@ -163,20 +159,20 @@ Procedure UniqueAnsiString (Var S : AnsiString);
 Var SNew : Pointer;
 
 begin
-  If Pointer(S)=Nil then exit;
-  if PAnsiRec(Pointer(S)-Firstoff)^.Ref>1 then
+  If S=Nil
+    then exit;
+  if PAnsiRec(S-Firstoff)^.Ref>1 then
     begin
-    SNew:=Pointer(NewAnsiString (PAnsiRec(Pointer(S)-FirstOff)^.len));
-    Move (Pointer(S)^,SNew^,PAnsiRec(Pointer(S)-FirstOff)^.len+1);
-    PAnsiRec(SNew-8)^.len:=PAnsiRec(Pchar(S)-FirstOff)^.len;
+       SNew:=Pointer(NewAnsiString (PAnsiRec(S-FirstOff)^.len));
+       Move (Pointer(S)^,SNew^,PAnsiRec(S-FirstOff)^.len+1);
+    PAnsiRec(SNew-8)^.len:=PAnsiRec(S-FirstOff)^.len;
     Decr_Ansi_Ref (S);  { Thread safe }
-    Pchar(S):=Pchar(SNew);
+    S:=SNew;
     end;
 end;
 
+Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer); [Public, Alias : 'FPC_ASSIGN_ANSI_STRING'];
 
-
-Procedure AssignAnsiString (Var S1 : AnsiString; S2 : Pointer); [Public, Alias : 'FPC_ASSIGN_ANSI_STRING'];
 {
  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
  If S2 is a constant string, a new S1 is allocated on the heap.
@@ -202,7 +198,7 @@ begin
   { Decrease the reference count on the old S1 }
   Decr_Ansi_Ref (S1);
   { And finally, have S1 pointing to S2 (or its copy) }
-  Pointer(S1):=Temp;
+  S1:=Temp;
 end;
 
 Procedure Ansi_String_Concat (Var S1 : AnsiString; Var S2 : AnsiString);
@@ -281,6 +277,17 @@ begin
 end;
 
 
+Function PChar2Ansi(p : pchar) : pointer;[Public,Alias : 'FPC_ANSI2PCHAR'];
+
+  begin
+     if p^=#0
+       PChar2Ansi:=nil
+     else
+
+  end;
+
+{ the compiler generates inline code for that
+
 Const EmptyChar : char = #0;
 
 Function Ansi2pchar (S : Pointer) : Pchar; [Alias : 'FPC_ANSI2PCHAR'];
@@ -291,6 +298,16 @@ begin
   else
     Ansi2Pchar:=@emptychar;
 end;
+}
+
+{ stupid solution, could be done with public,name in later versions }
+procedure dummy;assembler;
+
+  asm
+     .globl FPC_EMPTYCHAR
+     FPC_EMPTYCHAR:
+     .byte 0
+  end;
 
 Function AnsiCompare (Var S1,S2 : AnsiString): Longint;
 {
@@ -683,7 +700,11 @@ end;
 
 {
   $Log$
-  Revision 1.14  1998-09-14 10:48:14  peter
+  Revision 1.15  1998-09-19 08:33:17  florian
+    * some internal procedures take now an pointer instead of a
+      ansistring
+
+  Revision 1.14  1998/09/14 10:48:14  peter
     * FPC_ names
     * Heap manager is now system independent