1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 1999-2000 by Michael Van Canneyt, 4 member of the Free Pascal development team 5 6 See the file COPYING.FPC, included in this distribution, 7 for details about the copyright. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 12 13 **********************************************************************} 14{ 15 This file contains the implementation of the LongString type, 16 and all things that are needed for it. 17 LongSTring is defined as a 'silent' pchar : 18 a pchar that points to : 19 20 @ : Longint for size 21 @+4 : Unused byte; 22 @+5 : String; 23 So LS[i] is converted to the address @LS+4+i. 24 25 pchar[0]-pchar[3] : Longint Size 26 pchar [4] : Unused 27 pchar[5] : String; 28 29} 30 31{$ifdef lstrings_unit} 32{ Compile as a separate unit - development only} 33unit lstrings; 34 35Interface 36 37Type longstring = pchar; 38 ShortString = string; 39 40{ Internal functions, will not appear in systemh.inc } 41 42Function NewLongString (Len : Longint) : LongString; 43Procedure DisposeLongString (Var S : LongString; Len : Longint); 44Procedure Long_String_Concat (Var S1 : LongString; Const S2 : LongString; maxlen : Longint); 45Procedure Long_ShortString_Concat (Var S1: LongString; Const S2 : ShortString; maxlen : Longint); 46Procedure Long_To_ShortString (Var S1 : ShortString; Const S2 : LongString; Maxlen : Longint); 47Procedure Short_To_LongString (Var S1 : LongString; Const S2 : ShortString; Maxlen : Longint); 48Function LongCompare (Const S1,S2 : Longstring): Longint; 49Function LongCompare (Const S1 : LongString; Const S2 : ShortString): Longint; 50 51{ Public functions, Will end up in systemh.inc } 52 53Procedure SetLength (Var S : LongString; l : Longint); 54Procedure Write_Text_LongString (Len : Longint; T : Textrec; Var S : LongString); 55Function Length (Const S : LongString) : Longint; 56Function Copy (Const S : LongString; Index,Size : Longint) : LongString; 57Function Pos (Const Substr : LongString; Const Source : Longstring) : Longint; 58Procedure Insert (Const Source : LongString; Var S : LongString; Index : Longint); 59Procedure Delete (Var S : LongString; Index,Size: Longint); 60Procedure Val (Const S : LongString; var R : real; Var Code : Integer); 61{Procedure Val (Const S : LongString; var D : Double; Var Code : Integer);} 62Procedure Val (Const S : LongString; var E : Extended; Code : Integer); 63Procedure Val (Const S : LongString; var C : Cardinal; Code : Integer); 64Procedure Val (Const S : LongString; var L : Longint; Var Code : Integer); 65Procedure Val (Const S : LongString; var W : Word; Var Code : Integer); 66Procedure Val (Const S : LongString; var I : Integer; Var Code : Integer); 67Procedure Val (Const S : LongString; var B : Byte; Var Code : Integer); 68Procedure Val (Const S : LongString; var SI : ShortInt; Var Code : Integer); 69Procedure Str (Const R : Real;Len, fr : longint; Var S : LongString); 70{Procedure Str (Const D : Double;Len,fr : longint; Var S : LongString);} 71Procedure Str (Const E : Extended;Len,fr : longint; Var S : LongString); 72Procedure Str (Const C : Cardinal;len : Longint; Var S : LongString); 73Procedure Str (Const L : LongInt;len : longint; Var S : LongString); 74Procedure Str (Const W : Word;len : longint; Var S : LongString); 75Procedure Str (Const I : Integer;len : Longint; Var S : LongString); 76Procedure Str (Const B : Byte; Len : longint; Var S : LongString); 77Procedure Str (Const SI : ShortInt; Len : longint; Var S : LongString); 78 79Implementation 80 81{$endif} 82 83Type PLongint = ^Longint; 84 85{ --------------------------------------------------------------------- 86 Internal functions, not in interface. 87 ---------------------------------------------------------------------} 88 89Function NewLongString (Len : Longint) : LongString; 90{ 91 Allocate a new string on the heap. 92 initialize it to zero length 93} 94Var P : Pointer; 95 96begin 97 GetMem(P,Len+5); 98 If P<>Nil then 99 begin 100 PLongint(P)^:=0; 101 pchar(P+4)^:=#0; 102 end; 103 NewLongString:=P; 104end; 105 106 107 108Procedure DisposeLongString (Var S : LongString; Len : Longint); 109{ 110 DeAllocates a LongString From the heap. 111} 112begin 113 FreeMem (Pointer(S),Len+5); 114end; 115 116 117 118Procedure Long_String_Concat (Var S1 : LongString; Const S2 : LongString; maxlen : Longint); 119{ 120 Concatenates 2 LongStrings : S1+S2 121 If maxlen<>-1 then the result has maximal length maxlen. 122} 123Var Size : Longint; 124 125begin 126 Size:=PLongint(S2)^; 127 If maxlen<>-1 then 128 if Size+PLongint(S1)^>MaxLen then 129 Size:=Maxlen-PLongint(S1)^; 130 If Size<=0 then exit; 131 Move (pchar(S2)[5],pchar(S1)[PLongint(S1)^+5],Size); 132 PLongint(S1)^:=PLongint(S1)^+Size; 133end; 134 135 136 137Procedure Long_ShortString_Concat (Var S1: LongString; Const S2 : ShortString; maxlen : Longint); 138{ 139 Concatenates a long with a short string; : S2 + S2 140 If maxlen<>-1 then the result has maximal length maxlen. 141} 142Var Size : Longint; 143 144begin 145 Size:=Byte(S2[0]); 146 if MaxLen<>-1 then 147 if Size+PLongint(S1)^>Maxlen then 148 Size:=Maxlen-PLongint(S1)^; 149 If Size<=0 then exit; 150 Move (S2[1],Pchar(S1)[PLongint(S1)^+5],Size); 151 PLongint(S1)^:=PLongint(S1)^+Size; 152end; 153 154 155 156Procedure Long_To_ShortString (Var S1 : ShortString; Const S2 : LongString; Maxlen : Longint); 157{ 158 Converts a LongString to a longstring; 159 if maxlen<>-1, the resulting string has maximal length maxlen 160 else a default length of 255 is taken. 161} 162Var Size : Longint; 163 164begin 165 Size:=PLongint(S2)^; 166 if maxlen=-1 then maxlen:=255; 167 If Size>maxlen then Size:=maxlen; 168 Move (Pchar(S2)[5],S1[1],Size); 169 S1[0]:=chr(Size); 170end; 171 172 173 174Procedure Short_To_LongString (Var S1 : LongString; Const S2 : ShortString; Maxlen : Longint); 175{ 176 Converts a ShortString to a LongString; 177 if maxlen<>-1 then the resulting string has length maxlen. 178} 179Var Size : Longint; 180 181begin 182 Size:=Byte(S2[0]); 183 if maxlen=-1 then maxlen:=255; 184 If Size>maxlen then Size:=maxlen; 185 Move (S2[1],pchar(S1)[5],Size); 186 PLongint(S1)^:=Size; 187end; 188 189 190 191Function LongCompare (Const S1,S2 : Longstring): Longint; 192{ 193 Compares 2 longStrings; 194 The result is 195 <0 if S1<S2 196 0 if S1=S2 197 >0 if S1>S2 198} 199Var i,MaxI,Temp : Longint; 200 201begin 202 Temp:=0; 203 i:=1; 204 MaxI:=PLongint(S1)^; 205 if MaxI>PLOngint(S2)^ then MaxI:=PLongint(S2)^; 206 While (i<=MaxI) and (Temp=0) do 207 begin 208 Temp:= Byte( Pchar(S1)[i+4] ) - Byte( Pchar(S2)[I+4] ); 209 inc(i); 210 end; 211 if temp=0 then temp:=Plongint(S1)^-PLongint(S2)^; 212 LongCompare:=Temp; 213end; 214 215 216 217Function LongCompare (Const S1 : LongString; Const S2 : ShortString): Longint; 218{ 219 Compares a longString with a ShortString; 220 The result is 221 <0 if S1<S2 222 0 if S1=S2 223 >0 if S1>S2 224} 225Var i,MaxI,Temp : Longint; 226 227begin 228 Temp:=0; 229 i:=1; 230 MaxI:=PLongint(S1)^; 231 if MaxI>byte(S2[0]) then MaxI:=Byte(S2[0]); 232 While (i<=MaxI) and (Temp=0) do 233 begin 234 Temp:=(Byte(Pchar(S1)[i+4])-Byte(S2[I])); 235 inc(i); 236 end; 237 LongCompare:=Temp; 238end; 239 240 241 242Procedure Write_Text_LongString (Len : Longint; T : TextRec; Var S : LongString); 243{ 244 Writes a LongString to the Text file T 245} 246begin 247end; 248 249 250{ --------------------------------------------------------------------- 251 Public functions, In interface. 252 ---------------------------------------------------------------------} 253 254Function Length (Const S : LongString) : Longint; 255 256begin 257 Length:=PLongint(S)^; 258end; 259 260 261 262Procedure SetLength (Var S : LongString; l : Longint); 263 264begin 265 PLongint(S)^:=l; 266end; 267 268Function Copy (Const S : LongString; Index,Size : Longint) : LongString; 269 270var ResultAddress : pchar; 271 272begin 273 ResultAddress:=NewLongString (Size); 274 if ResultAddress=Nil then 275 {We're in deep shit here !!} 276 exit; 277 dec(index); 278 if PLongint(S)^<Index+Size then 279 Size:=PLongint(S)^-Index; 280 if Size>0 then 281 Move (Pchar(S)[Index+5],ResultAddress[5],Size) 282 Else 283 Size:=0; 284 PLongint(ResultAddress)^:=Size; 285 Copy:=ResultAddress 286end; 287 288 289 290Function Pos (Const Substr : LongString; Const Source : Longstring) : Longint; 291 292var i,j : longint; 293 e : boolean; 294 s : longstring; 295 296begin 297 i := 0; 298 j := 0; 299 e := true; 300 if Plongint(substr)^=0 then e := false; 301 while (e) and (i <= length (Source) - length (substr)) do 302 begin 303 inc (i); 304 s :=copy(Source,i,length(Substr)); 305 if LongCompare(substr,s)=0 then 306 begin 307 j := i; 308 e := false; 309 end; 310 DisposeLongString(s,length(Substr)); 311 end; 312 pos := j; 313end; 314 315 316 317Procedure Val (Const S : LongString; var R : real; Var Code : Integer); 318 319Var SS : String; 320 321begin 322 Long_To_ShortString (SS,S,255); 323 System.Val(SS,R,Code); 324end; 325 326 327{ 328Procedure Val (Const S : LongString; var D : Double; Var Code : Integer); 329 330Var SS : ShortString; 331 332begin 333 Long_To_ShortString (SS,S,255); 334 Val(SS,D,Code); 335end; 336} 337 338 339Procedure Val (Const S : LongString; var E : Extended; Code : Integer); 340 341Var SS : ShortString; 342 343begin 344 Long_To_ShortString (SS,S,255); 345 System.Val(SS,E,Code); 346end; 347 348 349 350Procedure Val (Const S : LongString; var C : Cardinal; Code : Integer); 351 352Var SS : ShortString; 353 354begin 355 Long_To_ShortString (SS,S,255); 356 System.Val(SS,C,Code); 357end; 358 359 360 361Procedure Val (Const S : LongString; var L : Longint; Var Code : Integer); 362 363Var SS : ShortString; 364 365begin 366 Long_To_ShortString (SS,S,255); 367 System.Val(SS,L,Code); 368end; 369 370 371 372Procedure Val (Const S : LongString; var W : Word; Var Code : Integer); 373 374Var SS : ShortString; 375 376begin 377 Long_To_ShortString (SS,S,255); 378 System.Val(SS,W,Code); 379end; 380 381 382 383Procedure Val (Const S : LongString; var I : Integer; Var Code : Integer); 384 385Var SS : ShortString; 386 387begin 388 Long_To_ShortString (SS,S,255); 389 System.Val(SS,I,Code); 390end; 391 392 393 394Procedure Val (Const S : LongString; var B : Byte; Var Code : Integer); 395 396Var SS : ShortString; 397 398begin 399 Long_To_ShortString (SS,S,255); 400 System.Val(SS,B,Code); 401end; 402 403 404 405Procedure Val (Const S : LongString; var SI : ShortInt; Var Code : Integer); 406 407Var SS : ShortString; 408 409begin 410 Long_To_ShortString (SS,S,255); 411 System.Val(SS,SI,Code); 412end; 413 414 415Procedure Str (Const R : Real;Len,fr : Longint; Var S : LongString); 416 417Var SS : ShortString; 418 419begin 420 {int_Str_Real (R,Len,fr,SS);} 421 Short_To_LongString (S,SS,255); 422end; 423 424 425{ 426Procedure Str (Const D : Double;Len,fr: Longint; Var S : LongString); 427 428Var SS : ShortString; 429 430begin 431 {int_Str_Double (D,Len,fr,SS);} 432 Short_To_LongString (S,SS,255); 433end; 434} 435 436 437Procedure Str (Const E : Extended;Lenf,Fr: Longint; Var S : LongString); 438 439Var SS : ShortString; 440 441begin 442 {int_Str_Extended (E,Len,fr,SS);} 443 Short_To_LongString (S,SS,255); 444end; 445 446 447 448Procedure Str (Const C : Cardinal;Len : Longint; Var S : LongString); 449 450begin 451end; 452 453 454 455Procedure Str (Const L : Longint; Len : Longint; Var S : LongString); 456 457Var SS : ShortString; 458 459begin 460 {int_Str_Longint (L,Len,fr,SS);} 461 Short_To_LongString (S,SS,255); 462end; 463 464 465 466Procedure Str (Const W : Word;Len : Longint; Var S : LongString); 467 468begin 469end; 470 471 472 473Procedure Str (Const I : Integer;Len : Longint; Var S : LongString); 474 475begin 476end; 477 478 479 480Procedure Str (Const B : Byte; Len : Longint; Var S : LongString); 481 482begin 483end; 484 485 486 487Procedure Str (Const SI : ShortInt; Len : Longint; Var S : LongString); 488 489begin 490end; 491 492 493 494Procedure Delete (Var S : LongString; Index,Size: Longint); 495 496begin 497 if index<=0 then 498 begin 499 Size:=Size+index-1; 500 index:=1; 501 end; 502 if (Index<=PLongint(s)^) and (Size>0) then 503 begin 504 if Size+Index>PLongint(s)^ then 505 Size:=PLongint(s)^-Index+1; 506 PLongint(s)^:=PLongint(s)^-Size; 507 if Index<=Length(s) then 508 Move(pchar(s)[Index+Size+4],pchar(s)[Index+4],Length(s)-Index+1); 509 end; 510end; 511 512Procedure Insert (Const Source : LongString; Var S : LongString; Index : Longint); 513 514var s3,s4 : pchar; 515 516begin 517 if index <= 0 then index := 1; 518 s3 := longString(copy (s, index, length(s))); 519 if index > PLongint(s)^ then index := PLongint(S)^+1; 520 PLongint(s)^ := index - 1; 521 s4 :=Pchar ( NewLongString (Plongint(Source)^) ); 522 Long_String_Concat(LongString(s4),Source,-1); 523 Long_String_Concat(LongString(S4),LongString(s3),-1); 524 Long_String_Concat(S,LongString(S4),-1); 525 DisposeLongstring(LongString(S3),PLongint(S3)^); 526 DisposeLongString(LongString(S4),PLongint(S4)^); 527end; 528 529{$ifdef lstrings_unit} 530end. 531