src/shared/xparser.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit xparser;
  18
  19 interface
  20
  21 uses
  22   Classes;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 type
  27   TTextParser = class
  28   public
  29     const
  30       TTNone = -1;
  31       TTEOF = 0;
  32       TTId = 1;
  33       TTInt = 2;
  34       //TTFloat = 3; // not yet
  35       TTStr = 4; // string
  36       TTComma = 5; // ','
  37       TTColon = 6; // ':'
  38       TTSemi = 7; // ';'
  39       TTBegin = 8; // left curly
  40       TTEnd = 9; // right curly
  41       TTDelim = 10; // other delimiters
  42
  43   private
  44     mLine, mCol: Integer;
  45     mCurChar, mNextChar: AnsiChar;
  46
  47     mAllowSignedNumbers: Boolean; // internal control
  48
  49     mTokLine, mTokCol: Integer; // token start
  50     mTokType: Integer;
  51     mTokStr: AnsiString; // string or identifier
  52     mTokChar: AnsiChar; // for delimiters
  53     mTokInt: Integer;
  54
  55   protected
  56     procedure warmup (); virtual; // called in constructor to warm up the system
  57     procedure loadNextChar (); virtual; abstract; // loads next char into mNextChar; #0 means 'eof'
  58
  59   public
  60     constructor Create ();
  61     destructor Destroy (); override;
  62
  63     function isEOF (): Boolean; inline;
  64
  65     function skipChar (): Boolean; // returns `false` on eof
  66
  67     function skipBlanks (): Boolean; // ...and comments; returns `false` on eof
  68
  69     function skipToken (): Boolean; // returns `false` on eof
  70
  71     function expectId (): AnsiString;
  72     procedure expectId (const aid: AnsiString);
  73     function eatId (const aid: AnsiString): Boolean;
  74
  75     function expectStr (allowEmpty: Boolean=false): AnsiString;
  76     function expectInt (): Integer;
  77
  78     function expectStrOrId (allowEmpty: Boolean=false): AnsiString;
  79
  80     procedure expectTT (ttype: Integer);
  81     function eatTT (ttype: Integer): Boolean;
  82
  83     function expectDelim (const ch: AnsiChar): AnsiChar;
  84     function eatDelim (const ch: AnsiChar): Boolean;
  85
  86   public
  87     property col: Integer read mCol;
  88     property line: Integer read mLine;
  89
  90     property curChar: AnsiChar read mCurChar;
  91     property nextChar: AnsiChar read mNextChar;
  92
  93     // token start
  94     property tokCol: Integer read mTokCol;
  95     property tokLine: Integer read mTokLine;
  96
  97     property tokType: Integer read mTokType; // see TTXXX constants
  98     property tokStr: AnsiString read mTokStr; // string or identifier
  99     property tokChar: AnsiChar read mTokChar; // for delimiters
 100     property tokInt: Integer read mTokInt;
 101   end;
 102
 103
 104 // ////////////////////////////////////////////////////////////////////////// //
 105 type
 106   TFileTextParser = class(TTextParser)
 107   private
 108     const BufSize = 16384;
 109
 110   private
 111     mFile: TStream;
 112     mStreamOwned: Boolean;
 113     mBuffer: PChar;
 114     mBufLen: Integer;
 115     mBufPos: Integer;
 116
 117   protected
 118     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 119
 120   public
 121     constructor Create (const fname: AnsiString);
 122     constructor Create (st: TStream; astOwned: Boolean=true); // will take ownership on st by default
 123     destructor Destroy (); override;
 124   end;
 125
 126   TStrTextParser = class(TTextParser)
 127   private
 128     mStr: AnsiString;
 129     mPos: Integer;
 130
 131   protected
 132     procedure loadNextChar (); override; // loads next char into mNextChar; #0 means 'eof'
 133
 134   public
 135     constructor Create (const astr: AnsiString);
 136     destructor Destroy (); override;
 137   end;
 138
 139
 140 // ////////////////////////////////////////////////////////////////////////// //
 141 type
 142   TTextWriter = class
 143   protected
 144     mIndent: Integer;
 145
 146   protected
 147     procedure putBuf (constref buf; len: SizeUInt); virtual; abstract;
 148
 149   public
 150     constructor Create ();
 151
 152     procedure flush (); virtual;
 153
 154     procedure put (const s: AnsiString); overload;
 155     procedure put (v: Byte); overload;
 156     procedure put (v: Integer); overload;
 157     procedure put (const fmt: AnsiString; args: array of const); overload;
 158     procedure putIndent ();
 159     procedure indent ();
 160     procedure unindent ();
 161
 162   public
 163     property curIndent: Integer read mIndent;
 164   end;
 165
 166
 167 // ////////////////////////////////////////////////////////////////////////// //
 168 type
 169   TFileTextWriter = class(TTextWriter)
 170   private
 171     const BufSize = 16384;
 172
 173   private
 174     mFile: TStream;
 175     mStreamOwned: Boolean;
 176     mBuffer: PAnsiChar;
 177     mBufUsed: Integer;
 178
 179   protected
 180     procedure putBuf (constref buf; len: SizeUInt); override;
 181
 182   public
 183     constructor Create (const fname: AnsiString);
 184     constructor Create (ast: TStream; astOwned: Boolean=true); // will own the stream by default
 185     destructor Destroy (); override;
 186
 187     procedure flush (); override;
 188   end;
 189
 190   TStrTextWriter = class(TTextWriter)
 191   private
 192     mStr: AnsiString;
 193
 194   protected
 195     procedure putBuf (constref buf; len: SizeUInt); override;
 196
 197   public
 198     constructor Create ();
 199     destructor Destroy (); override;
 200
 201     property str: AnsiString read mStr;
 202   end;
 203
 204
 205 implementation
 206
 207 uses
 208   SysUtils, utils;
 209
 210
 211 // ////////////////////////////////////////////////////////////////////////// //
 212 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 213
 214
 215 // ////////////////////////////////////////////////////////////////////////// //
 216 constructor TTextParser.Create ();
 217 begin
 218   mLine := 1;
 219   mCol := 1;
 220   mCurChar := #0;
 221   mNextChar := #0;
 222   mTokType := TTNone;
 223   mTokStr := '';
 224   mTokChar := #0;
 225   mTokInt := 0;
 226   mAllowSignedNumbers := true;
 227   warmup(); // change `mAllowSignedNumbers` there, if necessary
 228   skipToken();
 229 end;
 230
 231
 232 destructor TTextParser.Destroy ();
 233 begin
 234   inherited;
 235 end;
 236
 237
 238 function TTextParser.isEOF (): Boolean; inline; begin result := (mCurChar = #0); end;
 239
 240
 241 procedure TTextParser.warmup ();
 242 begin
 243   mNextChar := ' ';
 244   loadNextChar();
 245   mCurChar := mNextChar;
 246   if (mNextChar <> #0) then loadNextChar();
 247 end;
 248
 249
 250 function TTextParser.skipChar (): Boolean;
 251 begin
 252   if (mCurChar = #0) then begin result := false; exit; end;
 253   if (mCurChar = #10) then begin mCol := 1; Inc(mLine); end else Inc(mCol);
 254   mCurChar := mNextChar;
 255   if (mCurChar = #0) then begin result := false; exit; end;
 256   loadNextChar();
 257   // skip CR in CR/LF
 258   if (mCurChar = #13) then
 259   begin
 260     if (mNextChar = #10) then loadNextChar();
 261     mCurChar := #10;
 262   end;
 263   result := true;
 264 end;
 265
 266
 267 function TTextParser.skipBlanks (): Boolean;
 268 var
 269   level: Integer;
 270 begin
 271   while not isEOF do
 272   begin
 273     if (curChar = '/') then
 274     begin
 275       // single-line comment
 276       if (nextChar = '/') then
 277       begin
 278         while not isEOF and (curChar <> #10) do skipChar();
 279         skipChar(); // skip EOL
 280         continue;
 281       end;
 282       // multline comment
 283       if (nextChar = '*') then
 284       begin
 285         // skip comment start
 286         skipChar();
 287         skipChar();
 288         while not isEOF do
 289         begin
 290           if (curChar = '*') and (nextChar = '/') then
 291           begin
 292             // skip comment end
 293             skipChar();
 294             skipChar();
 295             break;
 296           end;
 297           skipChar();
 298         end;
 299         continue;
 300       end;
 301       // nesting multline comment
 302       if (nextChar = '+') then
 303       begin
 304         // skip comment start
 305         skipChar();
 306         skipChar();
 307         level := 1;
 308         while not isEOF do
 309         begin
 310           if (curChar = '+') and (nextChar = '/') then
 311           begin
 312             // skip comment end
 313             skipChar();
 314             skipChar();
 315             Dec(level);
 316             if (level = 0) then break;
 317             continue;
 318           end;
 319           if (curChar = '/') and (nextChar = '+') then
 320           begin
 321             // skip comment start
 322             skipChar();
 323             skipChar();
 324             Inc(level);
 325             continue;
 326           end;
 327           skipChar();
 328         end;
 329         continue;
 330       end;
 331     end;
 332     if (curChar > ' ') then break;
 333     skipChar(); // skip blank
 334   end;
 335   result := not isEOF;
 336 end;
 337
 338
 339 function TTextParser.skipToken (): Boolean;
 340
 341   procedure parseInt ();
 342   var
 343     neg: Boolean = false;
 344     base: Integer = -1;
 345     n: Integer;
 346   begin
 347     if mAllowSignedNumbers then
 348     begin
 349       if (curChar = '+') or (curChar = '-') then
 350       begin
 351         neg := (curChar = '-');
 352         skipChar();
 353         if (curChar < '0') or (curChar > '9') then
 354         begin
 355           mTokType := TTDelim;
 356           if (neg) then mTokChar := '-' else mTokChar := '+';
 357           exit;
 358         end;
 359       end;
 360     end;
 361     if (curChar = '0') then
 362     begin
 363       case nextChar of
 364         'b','B': base := 2;
 365         'o','O': base := 8;
 366         'd','D': base := 10;
 367         'h','H': base := 16;
 368       end;
 369       if (base > 0) then
 370       begin
 371         // skip prefix
 372         skipChar();
 373         skipChar();
 374       end;
 375     end;
 376     // default base
 377     if (base < 0) then base := 10;
 378     if (digitInBase(curChar, base) < 0) then raise Exception.Create('invalid number');
 379     mTokType := TTInt;
 380     mTokInt := 0; // just in case
 381     while not isEOF do
 382     begin
 383       n := digitInBase(curChar, base);
 384       if (n < 0) then break;
 385       n := mTokInt*10+n;
 386       if (n < 0) or (n < mTokInt) then raise Exception.Create('integer overflow');
 387       mTokInt := n;
 388       skipChar();
 389     end;
 390     // check for valid number end
 391     if not isEOF then
 392     begin
 393       if (curChar = '.') then raise Exception.Create('floating numbers aren''t supported yet');
 394       if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then
 395       begin
 396         raise Exception.Create('invalid number');
 397       end;
 398     end;
 399     if neg then mTokInt := -mTokInt;
 400   end;
 401
 402   procedure parseString ();
 403   var
 404     qch, ch: AnsiChar;
 405     n: Integer;
 406   begin
 407     mTokType := TTStr;
 408     mTokStr := ''; // just in case
 409     qch := curChar;
 410     skipChar(); // skip starting quote
 411     while not isEOF do
 412     begin
 413       // escape
 414       if (qch = '"') and (curChar = '\') then
 415       begin
 416         if (nextChar = #0) then raise Exception.Create('unterminated string escape');
 417         ch := nextChar;
 418         // skip backslash and escape type
 419         skipChar();
 420         skipChar();
 421         case ch of
 422           't': mTokStr += #9;
 423           'n': mTokStr += #10;
 424           'r': mTokStr += #13;
 425           'z': mTokStr += #0;
 426           'e': mTokStr += #27;
 427           'x', 'X': // hex escape
 428             begin
 429               n := digitInBase(curChar, 16);
 430               if (n < 0) then raise Exception.Create('invalid hexstr escape');
 431               skipChar();
 432               if (digitInBase(curChar, 16) > 0) then
 433               begin
 434                 n := n*16+digitInBase(curChar, 16);
 435                 skipChar();
 436               end;
 437               mTokStr += AnsiChar(n);
 438             end;
 439           else mTokStr += ch;
 440         end;
 441         continue;
 442       end;
 443       // duplicate single quote (pascal style)
 444       if (qch = '''') and (curChar = '''') and (nextChar = '''') then
 445       begin
 446         // skip both quotes
 447         skipChar();
 448         skipChar();
 449         mTokStr += '''';
 450         continue;
 451       end;
 452       if (curChar = qch) then
 453       begin
 454         skipChar(); // skip ending quote
 455         break;
 456       end;
 457       mTokStr += curChar;
 458       skipChar();
 459     end;
 460   end;
 461
 462   procedure parseId ();
 463   begin
 464     mTokType := TTId;
 465     mTokStr := ''; // just in case
 466     while (curChar = '_') or ((curChar >= '0') and (curChar <= '9')) or
 467           ((curChar >= 'A') and (curChar <= 'Z')) or
 468           ((curChar >= 'a') and (curChar <= 'z')) or
 469           (curChar >= #128) do
 470     begin
 471       mTokStr += curChar;
 472       skipChar();
 473     end;
 474   end;
 475
 476 begin
 477   mTokType := TTEOF;
 478   mTokStr := '';
 479   mTokChar := #0;
 480   mTokInt := 0;
 481
 482   if not skipBlanks() then
 483   begin
 484     result := false;
 485     mTokLine := mLine;
 486     mTokCol := mCol;
 487     exit;
 488   end;
 489
 490   mTokLine := mLine;
 491   mTokCol := mCol;
 492
 493   result := true;
 494
 495   // number?
 496   if mAllowSignedNumbers and ((curChar = '+') or (curChar = '-')) then begin parseInt(); exit; end;
 497   if (curChar >= '0') and (curChar <= '9') then begin parseInt(); exit; end;
 498
 499   // string?
 500   if (curChar = '"') or (curChar = '''') then begin parseString(); exit; end;
 501
 502   // identifier?
 503   if (curChar = '_') or ((curChar >= 'A') and (curChar <= 'Z')) or ((curChar >= 'a') and (curChar <= 'z')) or (curChar >= #128) then begin parseId(); exit; end;
 504
 505   // known delimiters?
 506   case curChar of
 507     ',': mTokType := TTComma;
 508     ':': mTokType := TTColon;
 509     ';': mTokType := TTSemi;
 510     '{': mTokType := TTBegin;
 511     '}': mTokType := TTEnd;
 512     else mTokType := TTDelim;
 513   end;
 514   mTokChar := curChar;
 515   skipChar();
 516 end;
 517
 518
 519 function TTextParser.expectId (): AnsiString;
 520 begin
 521   if (mTokType <> TTId) then raise Exception.Create('identifier expected');
 522   result := mTokStr;
 523   skipToken();
 524 end;
 525
 526
 527 procedure TTextParser.expectId (const aid: AnsiString);
 528 begin
 529   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then raise Exception.Create('identifier '''+aid+''' expected');
 530   skipToken();
 531 end;
 532
 533
 534 function TTextParser.eatId (const aid: AnsiString): Boolean;
 535 begin
 536   result := false;
 537   if (mTokType <> TTId) or (not StrEqu(mTokStr, aid)) then exit;
 538   result := true;
 539   skipToken();
 540 end;
 541
 542
 543 function TTextParser.expectStr (allowEmpty: Boolean=false): AnsiString;
 544 begin
 545   if (mTokType <> TTStr) then raise Exception.Create('string expected');
 546   if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 547   result := mTokStr;
 548   skipToken();
 549 end;
 550
 551
 552 function TTextParser.expectStrOrId (allowEmpty: Boolean=false): AnsiString;
 553 begin
 554   case mTokType of
 555     TTStr:
 556       if (not allowEmpty) and (Length(mTokStr) = 0) then raise Exception.Create('non-empty string expected');
 557     TTId:
 558       begin end;
 559     else
 560       raise Exception.Create('string or identifier expected');
 561   end;
 562   result := mTokStr;
 563   skipToken();
 564 end;
 565
 566
 567 function TTextParser.expectInt (): Integer;
 568 begin
 569   if (mTokType <> TTInt) then raise Exception.Create('string expected');
 570   result := mTokInt;
 571   skipToken();
 572 end;
 573
 574
 575 procedure TTextParser.expectTT (ttype: Integer);
 576 begin
 577   if (mTokType <> ttype) then raise Exception.Create('unexpected token');
 578   skipToken();
 579 end;
 580
 581
 582 function TTextParser.eatTT (ttype: Integer): Boolean;
 583 begin
 584   result := (mTokType = ttype);
 585   if result then skipToken();
 586 end;
 587
 588
 589 function TTextParser.expectDelim (const ch: AnsiChar): AnsiChar;
 590 begin
 591   if (mTokType <> TTDelim) then raise Exception.Create(Format('delimiter ''%s'' expected', [ch]));
 592   result := mTokChar;
 593   skipToken();
 594 end;
 595
 596
 597 function TTextParser.eatDelim (const ch: AnsiChar): Boolean;
 598 begin
 599   result := false;
 600   if (mTokType <> TTDelim) or (mTokChar <> ch) then exit;
 601   result := true;
 602   skipToken();
 603 end;
 604
 605
 606 // ////////////////////////////////////////////////////////////////////////// //
 607 constructor TFileTextParser.Create (const fname: AnsiString);
 608 begin
 609   mBuffer := nil;
 610   mFile := openDiskFileRO(fname);
 611   mStreamOwned := true;
 612   GetMem(mBuffer, BufSize);
 613   mBufPos := 0;
 614   mBufLen := mFile.Read(mBuffer^, BufSize);
 615   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 616   inherited Create();
 617 end;
 618
 619
 620 constructor TFileTextParser.Create (st: TStream; astOwned: Boolean=true);
 621 begin
 622   if (st = nil) then raise Exception.Create('cannot create parser for nil stream');
 623   mFile := st;
 624   mStreamOwned := astOwned;
 625   GetMem(mBuffer, BufSize);
 626   mBufPos := 0;
 627   mBufLen := mFile.Read(mBuffer^, BufSize);
 628   if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 629   inherited Create();
 630 end;
 631
 632
 633 destructor TFileTextParser.Destroy ();
 634 begin
 635   if (mBuffer <> nil) then FreeMem(mBuffer);
 636   mBuffer := nil;
 637   mBufPos := 0;
 638   mBufLen := 0;
 639   if mStreamOwned then mFile.Free();
 640   mFile := nil;
 641   inherited;
 642 end;
 643
 644
 645 procedure TFileTextParser.loadNextChar ();
 646 begin
 647   if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 648   if (mBufPos >= mBufLen) then
 649   begin
 650     mBufLen := mFile.Read(mBuffer^, BufSize);
 651     if (mBufLen < 0) then raise Exception.Create('TFileTextParser: read error');
 652     if (mBufLen = 0) then begin mNextChar := #0; exit; end;
 653     mBufPos := 0;
 654   end;
 655   assert(mBufPos < mBufLen);
 656   mNextChar := mBuffer[mBufPos];
 657   Inc(mBufPos);
 658   if (mNextChar = #0) then mNextChar := ' ';
 659 end;
 660
 661
 662 // ////////////////////////////////////////////////////////////////////////// //
 663 constructor TStrTextParser.Create (const astr: AnsiString);
 664 begin
 665   mStr := astr;
 666   mPos := 1;
 667   inherited Create();
 668 end;
 669
 670
 671 destructor TStrTextParser.Destroy ();
 672 begin
 673   mStr := '';
 674   inherited;
 675 end;
 676
 677
 678 procedure TStrTextParser.loadNextChar ();
 679 begin
 680   mNextChar := #0;
 681   if (mPos > Length(mStr)) then exit;
 682   mNextChar := mStr[mPos]; Inc(mPos);
 683   if (mNextChar = #0) then mNextChar := ' ';
 684 end;
 685
 686
 687 // ////////////////////////////////////////////////////////////////////////// //
 688 constructor TTextWriter.Create (); begin mIndent := 0; end;
 689 procedure TTextWriter.flush (); begin end;
 690 procedure TTextWriter.put (const s: AnsiString); overload; begin if (Length(s) > 0) then putBuf((@(s[1]))^, Length(s)); end;
 691 procedure TTextWriter.put (v: Byte); overload; begin put('%d', [v]); end;
 692 procedure TTextWriter.put (v: Integer); overload; begin put('%d', [v]); end;
 693 procedure TTextWriter.put (const fmt: AnsiString; args: array of const); overload; begin put(formatstrf(fmt, args)); end;
 694 procedure TTextWriter.putIndent (); var f: Integer; begin for f := 1 to mIndent do put(' '); end;
 695 procedure TTextWriter.indent (); begin Inc(mIndent, 2); end;
 696 procedure TTextWriter.unindent (); begin Dec(mIndent, 2); end;
 697
 698
 699 // ////////////////////////////////////////////////////////////////////////// //
 700 constructor TFileTextWriter.Create (const fname: AnsiString);
 701 begin
 702   mFile := createDiskFile(fname);
 703   mStreamOwned := true;
 704   mBufUsed := 0;
 705   GetMem(mBuffer, BufSize);
 706   assert(mBuffer <> nil);
 707   inherited Create();
 708 end;
 709
 710
 711 constructor TFileTextWriter.Create (ast: TStream; astOwned: Boolean=true);
 712 begin
 713   if (ast = nil) then raise Exception.Create('cannot write to nil stream');
 714   mFile := ast;
 715   mStreamOwned := astOwned;
 716   mBufUsed := 0;
 717   GetMem(mBuffer, BufSize);
 718   assert(mBuffer <> nil);
 719 end;
 720
 721
 722 destructor TFileTextWriter.Destroy ();
 723 begin
 724   flush();
 725   if (mBuffer <> nil) then FreeMem(mBuffer);
 726   mBufUsed := 0;
 727   mBuffer := nil;
 728   if (mStreamOwned) then mFile.Free();
 729   mFile := nil;
 730   inherited;
 731 end;
 732
 733
 734 procedure TFileTextWriter.flush ();
 735 begin
 736   if (mFile <> nil) and (mBufUsed > 0) then
 737   begin
 738     mFile.WriteBuffer(mBuffer^, mBufUsed);
 739   end;
 740   mBufUsed := 0;
 741 end;
 742
 743
 744 procedure TFileTextWriter.putBuf (constref buf; len: SizeUInt);
 745 var
 746   pc: PChar;
 747   left: Integer;
 748 begin
 749   if (len = 0) then exit;
 750   pc := @buf;
 751   while (len > 0) do
 752   begin
 753     left := BufSize-mBufUsed;
 754     if (left = 0) then
 755     begin
 756       flush();
 757       left := BufSize-mBufUsed;
 758       assert(left > 0);
 759     end;
 760     if (left > len) then left := Integer(len);
 761     Move(pc^, (mBuffer+mBufUsed)^, left);
 762     Inc(mBufUsed, left);
 763     pc += left;
 764     len -= left;
 765   end;
 766 end;
 767
 768
 769 // ////////////////////////////////////////////////////////////////////////// //
 770 constructor TStrTextWriter.Create ();
 771 begin
 772   mStr := '';
 773 end;
 774
 775
 776 destructor TStrTextWriter.Destroy ();
 777 begin
 778   mStr := '';
 779   inherited;
 780 end;
 781
 782
 783 procedure TStrTextWriter.putBuf (constref buf; len: SizeUInt);
 784 var
 785   st: AnsiString = '';
 786 begin
 787   if (len > 0) then
 788   begin
 789     SetLength(st, Integer(len));
 790     Move(buf, PChar(st)^, Integer(len));
 791     mStr += st;
 792     st := '';
 793   end;
 794 end;
 795
 796
 797 end.