← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/inc/text.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/inc/text.inc
1
1
{
2
 
    $Id: text.inc,v 1.1.2.1 2000/11/23 13:12:30 jonas Exp $
 
2
    $Id: text.inc,v 1.23 2004/05/01 20:52:50 peter Exp $
3
3
    This file is part of the Free Pascal Run time library.
4
4
    Copyright (c) 1999-2000 by the Free Pascal development team
5
5
 
17
17
 
18
18
  EOF_CTRLZ       Is Ctrl-Z (#26) a EOF mark for textfiles
19
19
  SHORT_LINEBREAK Use short Linebreaks #10 instead of #10#13
 
20
  MAC_LINEBREAK   Use Mac Linebreaks: #13 instead of #10 or #10#13
20
21
 
21
22
  SHORT_LINEBREAK is defined in the Linux system unit (syslinux.pp)
 
23
 
22
24
}
23
25
 
24
26
{****************************************************************************
25
27
                    subroutines For TextFile handling
26
28
****************************************************************************}
27
29
 
28
 
 
29
30
Procedure FileCloseFunc(Var t:TextRec);
30
31
Begin
31
32
  Do_Close(t.Handle);
34
35
 
35
36
Procedure FileReadFunc(var t:TextRec);
36
37
Begin
37
 
  t.BufEnd:=Do_Read(t.Handle,Longint(t.Bufptr),t.BufSize);
 
38
  t.BufEnd:=Do_Read(t.Handle,t.Bufptr,t.BufSize);
38
39
  t.BufPos:=0;
39
40
End;
40
41
 
43
44
var
44
45
  i : longint;
45
46
Begin
46
 
  i:=Do_Write(t.Handle,Longint(t.Bufptr),t.BufPos);
 
47
  i:=Do_Write(t.Handle,t.Bufptr,t.BufPos);
47
48
  if i<>t.BufPos then
48
49
    InOutRes:=101;
49
50
  t.BufPos:=0;
211
212
  If TextRec(t).mode=fmClosed Then
212
213
   Begin
213
214
     Do_Rename(PChar(@TextRec(t).Name),p);
214
 
     Move(p^,TextRec(t).Name,StrLen(p)+1);
 
215
     { check error code of do_rename }
 
216
     If InOutRes = 0 then
 
217
         Move(p^,TextRec(t).Name,StrLen(p)+1);
215
218
   End;
216
219
End;
217
220
 
273
276
 
274
277
 
275
278
Function SeekEof (Var t : Text) : Boolean;
 
279
var
 
280
  oldfilepos, oldbufpos, oldbufend, reads: longint;
 
281
  isdevice: boolean;
276
282
Begin
277
283
  If (InOutRes<>0) then
278
284
   exit(true);
284
290
      InOutRes:=103;
285
291
     exit(true);
286
292
   end;
 
293
  { try to save the current position in the file, seekeof() should not move }
 
294
  { the current file position (JM)                                          }
 
295
  oldbufpos := TextRec(t).BufPos;
 
296
  oldbufend := TextRec(t).BufEnd;
 
297
  reads := 0;
 
298
  oldfilepos := -1;
 
299
  isdevice := Do_IsDevice(TextRec(t).handle);
287
300
  repeat
288
301
    If TextRec(t).BufPos>=TextRec(t).BufEnd Then
289
302
     begin
 
303
       { signal that the we will have to do a seek }
 
304
       inc(reads);
 
305
       if not isdevice and
 
306
          (reads = 1) then
 
307
         begin
 
308
           oldfilepos := Do_FilePos(TextRec(t).handle) - TextRec(t).BufEnd;
 
309
           InOutRes:=0;
 
310
         end;
290
311
       FileFunc(TextRec(t).InOutFunc)(TextRec(t));
291
312
       If TextRec(t).BufPos>=TextRec(t).BufEnd Then
292
 
        exit(true);
 
313
        begin
 
314
          { if we only did a read in which we didn't read anything, the }
 
315
          { old buffer is still valid and we can simply restore the     }
 
316
          { pointers (JM)                                               }
 
317
          dec(reads);
 
318
          SeekEof := true;
 
319
          break;
 
320
        end;
293
321
     end;
294
322
    case TextRec(t).Bufptr^[TextRec(t).BufPos] of
295
 
         #26 : exit(true);
 
323
{$ifdef EOF_CTRLZ}
 
324
         #26 :
 
325
           begin
 
326
             SeekEof := true;
 
327
             break;
 
328
           end;
 
329
{$endif EOF_CTRLZ}
296
330
     #10,#13,
297
331
      #9,' ' : ;
298
332
    else
299
 
     exit(false);
 
333
     begin
 
334
       SeekEof := false;
 
335
       break;
 
336
     end;
300
337
    end;
301
 
    inc(TextRec(t).BufPos);
 
338
   inc(TextRec(t).BufPos);
302
339
  until false;
 
340
  { restore file position if not working with a device }
 
341
  if not isdevice then
 
342
    { if we didn't modify the buffer, simply restore the BufPos and BufEnd  }
 
343
    { (the latter becuase it's now probably set to zero because nothing was }
 
344
    {  was read anymore)                                                    }
 
345
    if (reads = 0) then
 
346
      begin
 
347
        TextRec(t).BufPos:=oldbufpos;
 
348
        TextRec(t).BufEnd:=oldbufend;
 
349
      end
 
350
    { otherwise return to the old filepos and reset the buffer }
 
351
    else
 
352
      begin
 
353
        do_seek(TextRec(t).handle,oldfilepos);
 
354
        InOutRes:=0;
 
355
        FileFunc(TextRec(t).InOutFunc)(TextRec(t));
 
356
        TextRec(t).BufPos:=oldbufpos;
 
357
      end;
303
358
End;
304
359
 
305
360
 
390
445
                               Write(Ln)
391
446
*****************************************************************************}
392
447
 
393
 
Procedure WriteBuffer(var f:TextRec;var b;len:longint);
 
448
Procedure WriteBuffer(var f:Text;const b;len:longint);
394
449
var
395
450
  p   : pchar;
396
451
  left,
398
453
begin
399
454
  p:=pchar(@b);
400
455
  idx:=0;
401
 
  left:=f.BufSize-f.BufPos;
 
456
  left:=TextRec(f).BufSize-TextRec(f).BufPos;
402
457
  while len>left do
403
458
   begin
404
 
     move(p[idx],f.Bufptr^[f.BufPos],left);
 
459
     move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],left);
405
460
     dec(len,left);
406
461
     inc(idx,left);
407
 
     inc(f.BufPos,left);
408
 
     FileFunc(f.InOutFunc)(f);
409
 
     left:=f.BufSize-f.BufPos;
 
462
     inc(TextRec(f).BufPos,left);
 
463
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
464
     left:=TextRec(f).BufSize-TextRec(f).BufPos;
410
465
   end;
411
 
  move(p[idx],f.Bufptr^[f.BufPos],len);
412
 
  inc(f.BufPos,len);
 
466
  move(p[idx],TextRec(f).Bufptr^[TextRec(f).BufPos],len);
 
467
  inc(TextRec(f).BufPos,len);
413
468
end;
414
469
 
415
470
 
416
 
Procedure WriteBlanks(var f:TextRec;len:longint);
 
471
Procedure WriteBlanks(var f:Text;len:longint);
417
472
var
418
473
  left : longint;
419
474
begin
420
 
  left:=f.BufSize-f.BufPos;
 
475
  left:=TextRec(f).BufSize-TextRec(f).BufPos;
421
476
  while len>left do
422
477
   begin
423
 
     FillChar(f.Bufptr^[f.BufPos],left,' ');
 
478
     FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],left,' ');
424
479
     dec(len,left);
425
 
     inc(f.BufPos,left);
426
 
     FileFunc(f.InOutFunc)(f);
427
 
     left:=f.BufSize-f.BufPos;
 
480
     inc(TextRec(f).BufPos,left);
 
481
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
482
     left:=TextRec(f).BufSize-TextRec(f).BufPos;
428
483
   end;
429
 
  FillChar(f.Bufptr^[f.BufPos],len,' ');
430
 
  inc(f.BufPos,len);
 
484
  FillChar(TextRec(f).Bufptr^[TextRec(f).BufPos],len,' ');
 
485
  inc(TextRec(f).BufPos,len);
431
486
end;
432
487
 
433
488
 
434
 
Procedure Write_End(var f:TextRec);[Public,Alias:'FPC_WRITE_END'];
 
489
Procedure fpc_Write_End(var f:Text);[Public,Alias:'FPC_WRITE_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
435
490
begin
436
 
  if f.FlushFunc<>nil then
437
 
   FileFunc(f.FlushFunc)(f);
 
491
  if TextRec(f).FlushFunc<>nil then
 
492
   FileFunc(TextRec(f).FlushFunc)(TextRec(f));
438
493
end;
439
494
 
440
495
 
441
 
Procedure Writeln_End(var f:TextRec);[Public,Alias:'FPC_WRITELN_END'];
442
 
const
443
 
{$IFDEF SHORT_LINEBREAK}
444
 
  eollen=1;
445
 
  eol : array[0..0] of char=(#10);
446
 
{$ELSE SHORT_LINEBREAK}
447
 
  eollen=2;
448
 
  eol : array[0..1] of char=(#13,#10);
449
 
{$ENDIF SHORT_LINEBREAK}
 
496
Procedure fpc_Writeln_End(var f:Text);[Public,Alias:'FPC_WRITELN_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
 
497
var
 
498
  eol : array[0..3] of char;
450
499
begin
451
500
  If InOutRes <> 0 then exit;
452
 
  case f.mode of
 
501
  case TextRec(f).mode of
453
502
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
454
503
      begin
 
504
        eol:=sLineBreak;
455
505
        { Write EOL }
456
 
        WriteBuffer(f,eol,eollen);
 
506
        WriteBuffer(f,eol,length(sLineBreak));
457
507
        { Flush }
458
 
        if f.FlushFunc<>nil then
459
 
          FileFunc(f.FlushFunc)(f);
 
508
        if TextRec(f).FlushFunc<>nil then
 
509
          FileFunc(TextRec(f).FlushFunc)(TextRec(f));
460
510
      end;
461
511
    fmInput: InOutRes:=105
462
512
    else InOutRes:=103;
464
514
end;
465
515
 
466
516
 
467
 
Procedure Write_Str(Len : Longint;var f : TextRec;const s : String);[Public,Alias:'FPC_WRITE_TEXT_SHORTSTR'];
 
517
Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
468
518
Begin
469
519
  If (InOutRes<>0) then
470
520
   exit;
471
 
  case f.mode of
 
521
  case TextRec(f).mode of
472
522
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
473
523
      begin
474
524
        If Len>Length(s) Then
480
530
  end;
481
531
End;
482
532
 
483
 
 
484
 
Procedure Write_Array(Len : Longint;var f : TextRec;const s : array of char);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY'];
 
533
{ provide local access to write_str }
 
534
procedure Write_Str(Len : Longint;var f : Text;const s : String); iocheck; [external name 'FPC_WRITE_TEXT_SHORTSTR'];
 
535
 
 
536
 
 
537
Procedure fpc_Write_Text_Pchar_as_Array(Len : Longint;var f : Text;const s : array of char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_ARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
485
538
var
486
539
  ArrayLen : longint;
487
540
  p : pchar;
488
541
Begin
489
542
  If (InOutRes<>0) then
490
543
   exit;
491
 
  case f.mode of
 
544
  case TextRec(f).mode of
492
545
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
493
546
      begin
494
547
        p:=pchar(@s);
495
 
        ArrayLen:=StrLen(p);
496
 
        if ArrayLen>sizeof(s) then
497
 
          ArrayLen:=sizeof(s);
 
548
        { can't use StrLen, since that one could try to read past the end }
 
549
        { of the heap (JM)                                                }
 
550
        ArrayLen:=IndexByte(p^,high(s)+1,0);
 
551
        { IndexByte returns -1 if not found (JM) }
 
552
        if ArrayLen = -1 then
 
553
          ArrayLen := high(s)+1;
498
554
        If Len>ArrayLen Then
499
555
          WriteBlanks(f,Len-ArrayLen);
500
556
        WriteBuffer(f,p^,ArrayLen);
505
561
End;
506
562
 
507
563
 
508
 
Procedure Write_PChar(Len : Longint;var f : TextRec;p : PChar);[Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_POINTER'];
 
564
Procedure fpc_Write_Text_PChar_As_Pointer(Len : Longint;var f : Text;p : PChar); iocheck; [Public,Alias:'FPC_WRITE_TEXT_PCHAR_AS_POINTER']; {$ifdef hascompilerproc} compilerproc; {$endif}
509
565
var
510
566
  PCharLen : longint;
511
567
Begin
512
568
  If (p=nil) or (InOutRes<>0) then
513
569
   exit;
514
 
  case f.mode of
 
570
  case TextRec(f).mode of
515
571
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
516
572
      begin
517
573
        PCharLen:=StrLen(p);
525
581
End;
526
582
 
527
583
 
528
 
Procedure Write_Text_AnsiString (Len : Longint; Var f : TextRec; S : AnsiString);[Public,alias:'FPC_WRITE_TEXT_ANSISTR'];
 
584
Procedure fpc_Write_Text_AnsiStr (Len : Longint; Var f : Text; S : AnsiString); iocheck; [Public,alias:'FPC_WRITE_TEXT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
529
585
{
530
586
 Writes a AnsiString to the Text file T
531
587
}
532
588
var
533
589
  SLen : longint;
534
590
begin
 
591
  If (InOutRes<>0) then
 
592
   exit;
 
593
  case TextRec(f).mode of
 
594
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
 
595
      begin
 
596
        SLen:=Length(s);
 
597
        If Len>SLen Then
 
598
          WriteBlanks(f,Len-SLen);
 
599
        if slen > 0 then
 
600
          WriteBuffer(f,PChar(S)^,SLen);
 
601
      end;
 
602
    fmInput: InOutRes:=105
 
603
    else InOutRes:=103;
 
604
  end;
 
605
end;
 
606
 
 
607
 
 
608
{$ifdef HASWIDESTRING}
 
609
Procedure fpc_Write_Text_WideStr (Len : Longint; Var f : Text; S : WideString); iocheck; [Public,alias:'FPC_WRITE_TEXT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
610
{
 
611
 Writes a WideString to the Text file T
 
612
}
 
613
var
 
614
  SLen : longint;
 
615
begin
535
616
  If (pointer(S)=nil) or (InOutRes<>0) then
536
617
   exit;
537
 
  case f.mode of
 
618
  case TextRec(f).mode of
538
619
    fmOutput { fmAppend gets changed to fmOutPut in do_open (JM) }:
539
620
      begin
540
621
        SLen:=Length(s);
541
622
        If Len>SLen Then
542
623
          WriteBlanks(f,Len-SLen);
543
 
        WriteBuffer(f,PChar(S)^,SLen);
 
624
        WriteBuffer(f,PChar(AnsiString(S))^,SLen);
544
625
      end;
545
626
    fmInput: InOutRes:=105
546
627
    else InOutRes:=103;
547
628
  end;
548
629
end;
549
 
 
550
 
 
551
 
Procedure Write_SInt(Len : Longint;var t : TextRec;l : ValSInt);[Public,Alias:'FPC_WRITE_TEXT_SINT'];
 
630
{$endif HASWIDESTRING}
 
631
 
 
632
Procedure fpc_Write_Text_SInt(Len : Longint;var t : Text;l : ValSInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_SINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
552
633
var
553
634
  s : String;
554
635
Begin
559
640
End;
560
641
 
561
642
 
562
 
Procedure Write_UInt(Len : Longint;var t : TextRec;l : ValUInt);[Public,Alias:'FPC_WRITE_TEXT_UINT'];
 
643
Procedure fpc_Write_Text_UInt(Len : Longint;var t : Text;l : ValUInt); iocheck; [Public,Alias:'FPC_WRITE_TEXT_UINT']; {$ifdef hascompilerproc} compilerproc; {$endif}
563
644
var
564
645
  s : String;
565
646
Begin
570
651
End;
571
652
 
572
653
 
573
 
{$ifdef INT64}
574
 
procedure write_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_WRITE_TEXT_QWORD'];
575
 
var
576
 
  s : string;
577
 
begin
578
 
  if (InOutRes<>0) then
579
 
   exit;
580
 
  qword_str(q,s);
581
 
  write_str(len,t,s);
582
 
end;
583
 
 
584
 
procedure write_int64(len : longint;var t : textrec;i : int64);[public,alias:'FPC_WRITE_TEXT_INT64'];
585
 
var
586
 
  s : string;
587
 
begin
588
 
  if (InOutRes<>0) then
589
 
   exit;
590
 
  int64_str(i,s);
591
 
  write_str(len,t,s);
592
 
end;
593
 
{$endif INT64}
594
 
 
595
 
 
596
 
Procedure Write_Float(rt,fixkomma,Len : Longint;var t : TextRec;r : ValReal);[Public,Alias:'FPC_WRITE_TEXT_FLOAT'];
 
654
{$ifndef CPU64}
 
655
 
 
656
procedure fpc_write_text_qword(len : longint;var t : text;q : qword); iocheck; [public,alias:'FPC_WRITE_TEXT_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
657
var
 
658
  s : string;
 
659
begin
 
660
  if (InOutRes<>0) then
 
661
   exit;
 
662
  str(q,s); 
 
663
  write_str(len,t,s);
 
664
end;
 
665
 
 
666
procedure fpc_write_text_int64(len : longint;var t : text;i : int64); iocheck; [public,alias:'FPC_WRITE_TEXT_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
667
var
 
668
  s : string;
 
669
begin
 
670
  if (InOutRes<>0) then
 
671
   exit;
 
672
  str(i,s);
 
673
  write_str(len,t,s);
 
674
end;
 
675
 
 
676
{$endif CPU64}
 
677
 
 
678
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); iocheck; [Public,Alias:'FPC_WRITE_TEXT_FLOAT']; {$ifdef hascompilerproc} compilerproc; {$endif}
597
679
var
598
680
  s : String;
599
681
Begin
604
686
End;
605
687
 
606
688
 
607
 
Procedure Write_Boolean(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias:'FPC_WRITE_TEXT_BOOLEAN'];
 
689
Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); iocheck; [Public,Alias:'FPC_WRITE_TEXT_BOOLEAN']; {$ifdef hascompilerproc} compilerproc; {$endif}
608
690
Begin
609
691
  If (InOutRes<>0) then
610
692
   exit;
616
698
End;
617
699
 
618
700
 
619
 
Procedure Write_Char(Len : Longint;var t : TextRec;c : Char);[Public,Alias:'FPC_WRITE_TEXT_CHAR'];
620
 
Begin
621
 
  If (InOutRes<>0) then
622
 
   exit;
623
 
  if (TextRec(t).mode<>fmOutput) Then
624
 
   begin
625
 
     if TextRec(t).mode=fmClosed then
626
 
      InOutRes:=103
627
 
     else
628
 
      InOutRes:=105;
629
 
     exit;
630
 
   end;
631
 
  If Len>1 Then
632
 
   WriteBlanks(t,Len-1);
633
 
  If t.BufPos+1>=t.BufSize Then
634
 
   FileFunc(t.InOutFunc)(t);
635
 
  t.Bufptr^[t.BufPos]:=c;
636
 
  Inc(t.BufPos);
637
 
End;
 
701
Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); iocheck; [Public,Alias:'FPC_WRITE_TEXT_CHAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
702
Begin
 
703
  If (InOutRes<>0) then
 
704
   exit;
 
705
  if (TextRec(t).mode<>fmOutput) Then
 
706
   begin
 
707
     if TextRec(t).mode=fmClosed then
 
708
      InOutRes:=103
 
709
     else
 
710
      InOutRes:=105;
 
711
     exit;
 
712
   end;
 
713
  If Len>1 Then
 
714
   WriteBlanks(t,Len-1);
 
715
  If TextRec(t).BufPos+1>=TextRec(t).BufSize Then
 
716
   FileFunc(TextRec(t).InOutFunc)(TextRec(t));
 
717
  TextRec(t).Bufptr^[TextRec(t).BufPos]:=c;
 
718
  Inc(TextRec(t).BufPos);
 
719
End;
 
720
 
 
721
 
 
722
{$ifdef HASWIDECHAR}
 
723
Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); iocheck; [Public,Alias:'FPC_WRITE_TEXT_WIDECHAR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
724
var
 
725
  ch : char;
 
726
Begin
 
727
  If (InOutRes<>0) then
 
728
   exit;
 
729
  if (TextRec(t).mode<>fmOutput) Then
 
730
   begin
 
731
     if TextRec(t).mode=fmClosed then
 
732
      InOutRes:=103
 
733
     else
 
734
      InOutRes:=105;
 
735
     exit;
 
736
   end;
 
737
  If Len>1 Then
 
738
   WriteBlanks(t,Len-1);
 
739
  If TextRec(t).BufPos+1>=TextRec(t).BufSize Then
 
740
   FileFunc(TextRec(t).InOutFunc)(TextRec(t));
 
741
  ch:=c;
 
742
  TextRec(t).Bufptr^[TextRec(t).BufPos]:=ch;
 
743
  Inc(TextRec(t).BufPos);
 
744
End;
 
745
{$endif HASWIDECHAR}
638
746
 
639
747
 
640
748
{*****************************************************************************
641
749
                                Read(Ln)
642
750
*****************************************************************************}
643
751
 
644
 
Function NextChar(var f:TextRec;var s:string):Boolean;
 
752
Function NextChar(var f:Text;var s:string):Boolean;
645
753
begin
646
 
  if f.BufPos<f.BufEnd then
 
754
  if TextRec(f).BufPos<TextRec(f).BufEnd then
647
755
   begin
648
756
     if length(s)<high(s) then
649
757
      begin
650
758
        inc(s[0]);
651
 
        s[length(s)]:=f.BufPtr^[f.BufPos];
 
759
        s[length(s)]:=TextRec(f).BufPtr^[TextRec(f).BufPos];
652
760
      end;
653
 
     Inc(f.BufPos);
654
 
     If f.BufPos>=f.BufEnd Then
655
 
      FileFunc(f.InOutFunc)(f);
 
761
     Inc(TextRec(f).BufPos);
 
762
     If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
763
      FileFunc(TextRec(f).InOutFunc)(TextRec(f));
656
764
     NextChar:=true;
657
765
   end
658
766
  else
660
768
end;
661
769
 
662
770
 
663
 
Function IgnoreSpaces(var f:TextRec):Boolean;
 
771
Function IgnoreSpaces(var f:Text):Boolean;
664
772
{
665
773
  Removes all leading spaces,tab,eols from the input buffer, returns true if
666
774
  the buffer is empty
670
778
begin
671
779
  s:='';
672
780
  IgnoreSpaces:=false;
673
 
  while f.Bufptr^[f.BufPos] in [#9,#10,#13,' '] do
674
 
   if not NextChar(f,s) then
675
 
    exit;
 
781
  { Return false when already at EOF }
 
782
  if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
783
   exit;
 
784
  while (TextRec(f).Bufptr^[TextRec(f).BufPos] in [#9,#10,#13,' ']) do
 
785
   begin
 
786
     if not NextChar(f,s) then
 
787
      exit;
 
788
     { EOF? }
 
789
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
790
      break;
 
791
   end;
676
792
  IgnoreSpaces:=true;
677
793
end;
678
794
 
679
795
 
680
 
procedure ReadNumeric(var f:TextRec;var s:string);
 
796
procedure ReadNumeric(var f:Text;var s:string);
681
797
{
682
798
  Read numeric input, if buffer is empty then return True
683
799
}
685
801
  repeat
686
802
    if not NextChar(f,s) then
687
803
      exit;
688
 
  until (length(s)=high(s)) or (f.BufPtr^[f.BufPos] in [#9,#10,#13,' ']);
 
804
  until (length(s)=high(s)) or (TextRec(f).BufPtr^[TextRec(f).BufPos] in [#9,#10,#13,' ']);
689
805
end;
690
806
 
691
807
 
692
 
Procedure Read_End(var f:TextRec);[Public,Alias:'FPC_READ_END'];
 
808
Procedure fpc_Read_End(var f:Text);[Public,Alias:'FPC_READ_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
693
809
begin
694
 
  if f.FlushFunc<>nil then
695
 
   FileFunc(f.FlushFunc)(f);
 
810
  if TextRec(f).FlushFunc<>nil then
 
811
   FileFunc(TextRec(f).FlushFunc)(TextRec(f));
696
812
end;
697
813
 
698
814
 
699
 
Procedure ReadLn_End(var f : TextRec);[Public,Alias:'FPC_READLN_END'];
 
815
Procedure fpc_ReadLn_End(var f : Text);[Public,Alias:'FPC_READLN_END']; iocheck; {$ifdef hascompilerproc} compilerproc; {$endif}
700
816
var prev: char;
701
817
Begin
702
818
{ Check error and if file is open and load buf if empty }
703
819
  If (InOutRes<>0) then
704
820
   exit;
705
 
  if (f.mode<>fmInput) Then
 
821
  if (TextRec(f).mode<>fmInput) Then
706
822
   begin
707
823
     case TextRec(f).mode of
708
824
      fmOutPut,fmAppend:
712
828
     end;
713
829
     exit;
714
830
   end;
715
 
  if f.BufPos>=f.BufEnd Then
 
831
  if TextRec(f).BufPos>=TextRec(f).BufEnd Then
716
832
   begin
717
 
     FileFunc(f.InOutFunc)(f);
718
 
     if (f.BufPos>=f.BufEnd) then
 
833
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
834
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
719
835
       { Flush if set }
720
836
       begin
721
 
         if (f.FlushFunc<>nil) then
722
 
           FileFunc(f.FlushFunc)(f);
 
837
         if (TextRec(f).FlushFunc<>nil) then
 
838
           FileFunc(TextRec(f).FlushFunc)(TextRec(f));
723
839
         exit;
724
840
       end;
725
841
   end;
726
842
  repeat
727
 
    prev := f.BufPtr^[f.BufPos];
728
 
    inc(f.BufPos);
 
843
    prev := TextRec(f).BufPtr^[TextRec(f).BufPos];
 
844
    inc(TextRec(f).BufPos);
729
845
{ no system uses #10#13 as line seperator (#10 = *nix, #13 = Mac, }
730
846
{ #13#10 = Dos), so if we've got #10, we can safely exit          }
731
847
    if prev = #10 then
732
848
      exit;
733
 
    if f.BufPos>=f.BufEnd Then
 
849
    if TextRec(f).BufPos>=TextRec(f).BufEnd Then
734
850
      begin
735
 
        FileFunc(f.InOutFunc)(f);
736
 
        if (f.BufPos>=f.BufEnd) then
 
851
        FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
852
        if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
737
853
          { Flush if set }
738
854
          begin
739
 
           if (f.FlushFunc<>nil) then
740
 
             FileFunc(f.FlushFunc)(f);
 
855
           if (TextRec(f).FlushFunc<>nil) then
 
856
             FileFunc(TextRec(f).FlushFunc)(TextRec(f));
741
857
           exit;
742
858
         end;
743
859
      end;
744
860
   if (prev=#13) then
745
861
     { is there also a #10 after it? }
746
862
     begin
747
 
       if (f.BufPtr^[f.BufPos]=#10) then
 
863
       if (TextRec(f).BufPtr^[TextRec(f).BufPos]=#10) then
748
864
         { yes, skip that one as well }
749
 
         inc(f.BufPos);
 
865
         inc(TextRec(f).BufPos);
750
866
       exit;
751
867
     end;
752
868
  until false;
753
869
End;
754
870
 
755
871
 
756
 
Function ReadPCharLen(var f:TextRec;s:pchar;maxlen:longint):longint;
 
872
Function ReadPCharLen(var f:Text;s:pchar;maxlen:longint):longint;
757
873
var
758
874
  sPos,len : Longint;
759
875
  p,startp,maxp : pchar;
762
878
{ Check error and if file is open }
763
879
  If (InOutRes<>0) then
764
880
   exit;
765
 
  if (f.mode<>fmInput) Then
 
881
  if (TextRec(f).mode<>fmInput) Then
766
882
   begin
767
883
     case TextRec(f).mode of
768
884
       fmOutPut,fmAppend:
775
891
{ Read maximal until Maxlen is reached }
776
892
  sPos:=0;
777
893
  repeat
778
 
    If f.BufPos>=f.BufEnd Then
 
894
    If TextRec(f).BufPos>=TextRec(f).BufEnd Then
779
895
     begin
780
 
       FileFunc(f.InOutFunc)(f);
781
 
       If f.BufPos>=f.BufEnd Then
 
896
       FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
897
       If TextRec(f).BufPos>=TextRec(f).BufEnd Then
782
898
         break;
783
899
     end;
784
 
    p:=@f.Bufptr^[f.BufPos];
785
 
    if SPos+f.BufEnd-f.BufPos>MaxLen then
786
 
     maxp:=@f.BufPtr^[f.BufPos+MaxLen-SPos]
 
900
    p:=@TextRec(f).Bufptr^[TextRec(f).BufPos];
 
901
    if SPos+TextRec(f).BufEnd-TextRec(f).BufPos>MaxLen then
 
902
     maxp:=@TextRec(f).BufPtr^[TextRec(f).BufPos+MaxLen-SPos]
787
903
    else
788
 
     maxp:=@f.Bufptr^[f.BufEnd];
 
904
     maxp:=@TextRec(f).Bufptr^[TextRec(f).BufEnd];
789
905
    startp:=p;
790
906
  { search linefeed }
791
907
    while (p<maxp) and not(P^ in [#10,#13]) do
792
908
     inc(p);
793
909
  { calculate read bytes }
794
910
    len:=p-startp;
795
 
    inc(f.BufPos,Len);
 
911
    inc(TextRec(f).BufPos,Len);
796
912
    Move(startp^,s[sPos],Len);
797
913
    inc(sPos,Len);
798
914
  { was it a LF or CR? then leave }
804
920
End;
805
921
 
806
922
 
807
 
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:'FPC_READ_TEXT_SHORTSTR'];
 
923
Procedure fpc_Read_Text_ShortStr(var f : Text;var s : String); iocheck; [Public,Alias:'FPC_READ_TEXT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
808
924
Begin
809
925
  s[0]:=chr(ReadPCharLen(f,pchar(@s[1]),high(s)));
810
926
End;
811
927
 
812
928
 
813
 
Procedure Read_PChar(var f : TextRec;var s : PChar);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER'];
 
929
Procedure fpc_Read_Text_PChar_As_Pointer(var f : Text;var s : PChar); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_POINTER']; {$ifdef hascompilerproc} compilerproc; {$endif}
814
930
Begin
815
931
  pchar(s+ReadPCharLen(f,s,$7fffffff))^:=#0;
816
932
End;
817
933
 
818
934
 
819
 
Procedure Read_Array(var f : TextRec;var s : array of char);[Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY'];
 
935
Procedure fpc_Read_Text_PChar_As_Array(var f : Text;var s : array of char); iocheck; [Public,Alias:'FPC_READ_TEXT_PCHAR_AS_ARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
936
var
 
937
  len: longint;
820
938
Begin
821
 
  pchar(pchar(@s)+ReadPCharLen(f,pchar(@s),high(s)))^:=#0;
 
939
  len := ReadPCharLen(f,pchar(@s),high(s)+1);
 
940
  if len <= high(s) then
 
941
    s[len] := #0;
822
942
End;
823
943
 
824
944
 
825
 
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias:'FPC_READ_TEXT_ANSISTR'];
 
945
Procedure fpc_Read_Text_AnsiStr(var f : Text;var s : AnsiString); iocheck; [Public,Alias:'FPC_READ_TEXT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
826
946
var
827
947
  slen,len : longint;
828
948
Begin
837
957
  SetLength(S,Slen);
838
958
End;
839
959
 
840
 
 
841
 
Function Read_Char(var f : TextRec):char;[Public,Alias:'FPC_READ_TEXT_CHAR'];
 
960
{$ifdef hascompilerproc}
 
961
procedure fpc_Read_Text_Char(var f : Text; var c: char); iocheck; [Public,Alias:'FPC_READ_TEXT_CHAR'];compilerproc;
 
962
{$else hascompilerproc}
 
963
Function fpc_Read_Text_Char(var f : Text):char;[Public,Alias:'FPC_READ_TEXT_CHAR'];
 
964
{$endif hascompilerproc}
842
965
Begin
843
 
  Read_Char:=#0;
 
966
{$ifdef hascompilerproc}
 
967
  c:=#0;
 
968
{$else hascompilerproc}
 
969
  fpc_Read_Text_Char:=#0;
 
970
{$endif hascompilerproc}
844
971
{ Check error and if file is open }
845
972
  If (InOutRes<>0) then
846
973
   exit;
847
 
  if (f.mode<>fmInput) Then
 
974
  if (TextRec(f).mode<>fmInput) Then
848
975
   begin
849
976
     case TextRec(f).mode of
850
977
       fmOutPut,fmAppend:
855
982
     exit;
856
983
   end;
857
984
{ Read next char or EOF }
858
 
  If f.BufPos>=f.BufEnd Then
 
985
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
859
986
   begin
860
 
     FileFunc(f.InOutFunc)(f);
861
 
     If f.BufPos>=f.BufEnd Then
 
987
     FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
988
     If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
989
{$ifdef hascompilerproc}
 
990
       begin
 
991
         c := #26;
 
992
         exit;
 
993
       end;
 
994
{$else hascompilerproc}
862
995
       exit(#26);
 
996
{$endif hascompilerproc}
863
997
   end;
864
 
  Read_Char:=f.Bufptr^[f.BufPos];
865
 
  inc(f.BufPos);
 
998
{$ifdef hascompilerproc}
 
999
  c:=TextRec(f).Bufptr^[TextRec(f).BufPos];
 
1000
{$else hascompilerproc}
 
1001
  fpc_Read_Text_Char:=TextRec(f).Bufptr^[TextRec(f).BufPos];
 
1002
{$endif hascompilerproc}
 
1003
  inc(TextRec(f).BufPos);
866
1004
end;
867
1005
 
868
1006
 
869
 
Function Read_SInt(var f : TextRec):ValSInt;[Public,Alias:'FPC_READ_TEXT_SINT'];
870
 
var
871
 
  hs   : String;
872
 
  code : Longint;
873
 
Begin
874
 
  Read_SInt:=0;
875
 
{ Leave if error or not open file, else check for empty buf }
876
 
  If (InOutRes<>0) then
877
 
   exit;
878
 
  if (f.mode<>fmInput) Then
879
 
   begin
880
 
     case TextRec(f).mode of
881
 
       fmOutPut,fmAppend:
882
 
         InOutRes:=104
883
 
       else
884
 
         InOutRes:=103;
885
 
     end;
886
 
     exit;
887
 
   end;
888
 
  If f.BufPos>=f.BufEnd Then
889
 
   FileFunc(f.InOutFunc)(f);
890
 
  hs:='';
891
 
  if IgnoreSpaces(f) then
892
 
   ReadNumeric(f,hs);
893
 
  Val(hs,Read_SInt,code);
894
 
  If code<>0 Then
895
 
   InOutRes:=106;
896
 
End;
897
 
 
898
 
 
899
 
Function Read_UInt(var f : TextRec):ValUInt;[Public,Alias:'FPC_READ_TEXT_UINT'];
900
 
var
901
 
  hs   : String;
902
 
  code : longint;
903
 
Begin
904
 
  Read_UInt:=0;
905
 
{ Leave if error or not open file, else check for empty buf }
906
 
  If (InOutRes<>0) then
907
 
   exit;
908
 
  if (f.mode<>fmInput) Then
909
 
   begin
910
 
     case TextRec(f).mode of
911
 
       fmOutPut,fmAppend:
912
 
         InOutRes:=104
913
 
       else
914
 
         InOutRes:=103;
915
 
     end;
916
 
     exit;
917
 
   end;
918
 
  If f.BufPos>=f.BufEnd Then
919
 
   FileFunc(f.InOutFunc)(f);
920
 
  hs:='';
921
 
  if IgnoreSpaces(f) then
922
 
   ReadNumeric(f,hs);
923
 
  val(hs,Read_UInt,code);
924
 
  If code<>0 Then
925
 
   InOutRes:=106;
926
 
End;
927
 
 
928
 
 
929
 
Function Read_Float(var f : TextRec):ValReal;[Public,Alias:'FPC_READ_TEXT_FLOAT'];
 
1007
{$ifdef hascompilerproc}
 
1008
Procedure fpc_Read_Text_SInt(var f : Text; var l : ValSInt); iocheck; [Public,Alias:'FPC_READ_TEXT_SINT']; compilerproc;
 
1009
{$else hascompilerproc}
 
1010
Function fpc_Read_Text_SInt(var f : Text):ValSInt;[Public,Alias:'FPC_READ_TEXT_SINT'];
 
1011
{$endif hascompilerproc}
 
1012
var
 
1013
  hs   : String;
 
1014
  code : longint;
 
1015
Begin
 
1016
{$ifdef hascompilerproc}
 
1017
  l:=0;
 
1018
{$else hascompilerproc}
 
1019
  fpc_Read_Text_SInt:=0;
 
1020
{$endif hascompilerproc}
 
1021
{ Leave if error or not open file, else check for empty buf }
 
1022
  If (InOutRes<>0) then
 
1023
   exit;
 
1024
  if (TextRec(f).mode<>fmInput) Then
 
1025
   begin
 
1026
     case TextRec(f).mode of
 
1027
       fmOutPut,fmAppend:
 
1028
         InOutRes:=104
 
1029
       else
 
1030
         InOutRes:=103;
 
1031
     end;
 
1032
     exit;
 
1033
   end;
 
1034
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
1035
   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
1036
  hs:='';
 
1037
  if IgnoreSpaces(f) then
 
1038
   begin
 
1039
     { When spaces were found and we are now at EOF,
 
1040
       then we return 0 }
 
1041
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
1042
      exit;
 
1043
     ReadNumeric(f,hs);
 
1044
   end;
 
1045
{$ifdef hascompilerproc}
 
1046
  Val(hs,l,code);
 
1047
{$else hascompilerproc}
 
1048
  Val(hs,fpc_Read_Text_SInt,code);
 
1049
{$endif hascompilerproc}
 
1050
  If code<>0 Then
 
1051
   InOutRes:=106;
 
1052
End;
 
1053
 
 
1054
 
 
1055
{$ifdef hascompilerproc}
 
1056
Procedure fpc_Read_Text_UInt(var f : Text; var u : ValUInt);  iocheck; [Public,Alias:'FPC_READ_TEXT_UINT']; compilerproc;
 
1057
{$else hascompilerproc}
 
1058
Function fpc_Read_Text_UInt(var f : Text):ValUInt;[Public,Alias:'FPC_READ_TEXT_UINT'];
 
1059
{$endif hascompilerproc}
 
1060
var
 
1061
  hs   : String;
 
1062
  code : longint;
 
1063
Begin
 
1064
{$ifdef hascompilerproc}
 
1065
  u:=0;
 
1066
{$else hascompilerproc}
 
1067
  fpc_Read_Text_UInt:=0;
 
1068
{$endif hascompilerproc}
 
1069
{ Leave if error or not open file, else check for empty buf }
 
1070
  If (InOutRes<>0) then
 
1071
   exit;
 
1072
  if (TextRec(f).mode<>fmInput) Then
 
1073
   begin
 
1074
     case TextRec(f).mode of
 
1075
       fmOutPut,fmAppend:
 
1076
         InOutRes:=104
 
1077
       else
 
1078
         InOutRes:=103;
 
1079
     end;
 
1080
     exit;
 
1081
   end;
 
1082
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
1083
   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
 
1084
  hs:='';
 
1085
  if IgnoreSpaces(f) then
 
1086
   begin
 
1087
     { When spaces were found and we are now at EOF,
 
1088
       then we return 0 }
 
1089
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
1090
      exit;
 
1091
     ReadNumeric(f,hs);
 
1092
   end;
 
1093
{$ifdef hascompilerproc}
 
1094
  val(hs,u,code);
 
1095
{$else hascompilerproc}
 
1096
  val(hs,fpc_Read_Text_UInt,code);
 
1097
{$endif hascompilerproc}
 
1098
  If code<>0 Then
 
1099
   InOutRes:=106;
 
1100
End;
 
1101
 
 
1102
 
 
1103
{$ifdef hascompilerproc}
 
1104
procedure fpc_Read_Text_Float(var f : Text; var v : ValReal); iocheck; [Public,Alias:'FPC_READ_TEXT_FLOAT']; compilerproc;
 
1105
{$else hascompilerproc}
 
1106
Function fpc_Read_Text_Float(var f : Text):ValReal;[Public,Alias:'FPC_READ_TEXT_FLOAT'];
 
1107
{$endif hascompilerproc}
930
1108
var
931
1109
  hs : string;
932
1110
  code : Word;
933
1111
begin
934
 
  Read_Float:=0.0;
 
1112
{$ifdef hascompilerproc}
 
1113
  v:=0.0;
 
1114
{$else hascompilerproc}
 
1115
  fpc_Read_Text_Float:=0.0;
 
1116
{$endif hascompilerproc}
935
1117
{ Leave if error or not open file, else check for empty buf }
936
1118
  If (InOutRes<>0) then
937
1119
   exit;
938
 
  if (f.mode<>fmInput) Then
 
1120
  if (TextRec(f).mode<>fmInput) Then
939
1121
   begin
940
1122
     case TextRec(f).mode of
941
1123
       fmOutPut,fmAppend:
945
1127
     end;
946
1128
     exit;
947
1129
   end;
948
 
  If f.BufPos>=f.BufEnd Then
949
 
   FileFunc(f.InOutFunc)(f);
 
1130
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
1131
   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
950
1132
  hs:='';
951
1133
  if IgnoreSpaces(f) then
952
 
    ReadNumeric(f,hs);
953
 
  val(hs,Read_Float,code);
 
1134
   begin
 
1135
     { When spaces were found and we are now at EOF,
 
1136
       then we return 0 }
 
1137
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
1138
      exit;
 
1139
     ReadNumeric(f,hs);
 
1140
   end;
 
1141
{$ifdef hascompilerproc}
 
1142
  val(hs,v,code);
 
1143
{$else hascompilerproc}
 
1144
  val(hs,fpc_Read_Text_Float,code);
 
1145
{$endif hascompilerproc}
954
1146
  If code<>0 Then
955
1147
   InOutRes:=106;
956
1148
end;
957
1149
 
958
1150
 
959
 
{$ifdef INT64}
960
 
function Read_QWord(var f : textrec) : qword;[public,alias:'FPC_READ_TEXT_QWORD'];
 
1151
{$ifndef cpu64}
 
1152
 
 
1153
{$ifdef hascompilerproc}
 
1154
procedure fpc_Read_Text_QWord(var f : text; var q : qword); iocheck; [public,alias:'FPC_READ_TEXT_QWORD']; compilerproc;
 
1155
{$else hascompilerproc}
 
1156
function fpc_Read_Text_QWord(var f : text) : qword;[public,alias:'FPC_READ_TEXT_QWORD'];
 
1157
{$endif hascompilerproc}
961
1158
var
962
1159
  hs   : String;
963
1160
  code : longint;
964
1161
Begin
965
 
  Read_QWord:=0;
 
1162
{$ifdef hascompilerproc}
 
1163
  q:=0;
 
1164
{$else hascompilerproc}
 
1165
  fpc_Read_Text_QWord:=0;
 
1166
{$endif hascompilerproc}
966
1167
  { Leave if error or not open file, else check for empty buf }
967
1168
  If (InOutRes<>0) then
968
1169
   exit;
969
 
  if (f.mode<>fmInput) Then
 
1170
  if (TextRec(f).mode<>fmInput) Then
970
1171
   begin
971
1172
     case TextRec(f).mode of
972
1173
       fmOutPut,fmAppend:
976
1177
     end;
977
1178
     exit;
978
1179
   end;
979
 
  If f.BufPos>=f.BufEnd Then
980
 
   FileFunc(f.InOutFunc)(f);
 
1180
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
1181
   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
981
1182
  hs:='';
982
1183
  if IgnoreSpaces(f) then
983
 
   ReadNumeric(f,hs);
984
 
  val(hs,Read_QWord,code);
 
1184
   begin
 
1185
     { When spaces were found and we are now at EOF,
 
1186
       then we return 0 }
 
1187
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
1188
      exit;
 
1189
     ReadNumeric(f,hs);
 
1190
   end;
 
1191
{$ifdef hascompilerproc}
 
1192
  val(hs,q,code);
 
1193
{$else hascompilerproc}
 
1194
  val(hs,fpc_Read_Text_QWord,code);
 
1195
{$endif hascompilerproc}
985
1196
  If code<>0 Then
986
1197
   InOutRes:=106;
987
1198
End;
988
1199
 
989
 
function Read_Int64(var f : textrec) : int64;[public,alias:'FPC_READ_TEXT_INT64'];
 
1200
{$ifdef hascompilerproc}
 
1201
procedure fpc_Read_Text_Int64(var f : text; var i : int64); iocheck; [public,alias:'FPC_READ_TEXT_INT64']; compilerproc;
 
1202
{$else hascompilerproc}
 
1203
function fpc_Read_Text_Int64(var f : text) : int64;[public,alias:'FPC_READ_TEXT_INT64']; {$ifdef hascompilerproc} compilerproc; {$endif}
 
1204
{$endif hascompilerproc}
990
1205
var
991
1206
  hs   : String;
992
1207
  code : Longint;
993
1208
Begin
994
 
  Read_Int64:=0;
 
1209
{$ifdef hascompilerproc}
 
1210
  i:=0;
 
1211
{$else hascompilerproc}
 
1212
  fpc_Read_Text_Int64:=0;
 
1213
{$endif hascompilerproc}
995
1214
{ Leave if error or not open file, else check for empty buf }
996
1215
  If (InOutRes<>0) then
997
1216
   exit;
998
 
  if (f.mode<>fmInput) Then
 
1217
  if (TextRec(f).mode<>fmInput) Then
999
1218
   begin
1000
1219
     case TextRec(f).mode of
1001
1220
       fmOutPut,fmAppend:
1005
1224
     end;
1006
1225
     exit;
1007
1226
   end;
1008
 
  If f.BufPos>=f.BufEnd Then
1009
 
   FileFunc(f.InOutFunc)(f);
 
1227
  If TextRec(f).BufPos>=TextRec(f).BufEnd Then
 
1228
   FileFunc(TextRec(f).InOutFunc)(TextRec(f));
1010
1229
  hs:='';
1011
1230
  if IgnoreSpaces(f) then
1012
 
   ReadNumeric(f,hs);
1013
 
  Val(hs,Read_Int64,code);
 
1231
   begin
 
1232
     { When spaces were found and we are now at EOF,
 
1233
       then we return 0 }
 
1234
     if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
 
1235
      exit;
 
1236
     ReadNumeric(f,hs);
 
1237
   end;
 
1238
{$ifdef hascompilerproc}
 
1239
  Val(hs,i,code);
 
1240
{$else hascompilerproc}
 
1241
  Val(hs,fpc_Read_Text_Int64,code);
 
1242
{$endif hascompilerproc}
1014
1243
  If code<>0 Then
1015
1244
   InOutRes:=106;
1016
1245
End;
1017
 
{$endif INT64}
 
1246
 
 
1247
{$endif CPU64}
1018
1248
 
1019
1249
 
1020
1250
{*****************************************************************************
1043
1273
 
1044
1274
{
1045
1275
  $Log: text.inc,v $
1046
 
  Revision 1.1.2.1  2000/11/23 13:12:30  jonas
1047
 
    * fix for web bug 1210 from Peter
1048
 
 
1049
 
  Revision 1.1  2000/07/13 06:30:49  michael
1050
 
  + Initial import
1051
 
 
1052
 
  Revision 1.72  2000/03/24 10:26:18  jonas
1053
 
    * changed a lot of "if fm.mode = fmClosed then" to case statements,
1054
 
      because if f is not yet initialized, the mode is invalid and can
1055
 
      contain another value even though the file is closed
1056
 
    + check if a file is open in writeln_end (caused crash if used on
1057
 
      not opened files)
1058
 
 
1059
 
  Revision 1.71  2000/03/19 08:36:41  peter
1060
 
    * length check for readnumeric
1061
 
 
1062
 
  Revision 1.70  2000/03/17 21:27:56  jonas
1063
 
    * fixed declaration of val_int64 (removed destsize parameter)
1064
 
    * fixed val_int64 and val_qword so they reject invalid input
1065
 
      (u >= base)
1066
 
    * when reading a number, invalid input is removed from the input
1067
 
      buffer (+ it should be faster as well)
1068
 
 
1069
 
  Revision 1.69  2000/02/09 16:59:31  peter
1070
 
    * truncated log
1071
 
 
1072
 
  Revision 1.68  2000/01/31 12:11:53  jonas
1073
 
    * committed the rest of my fix :)
1074
 
 
1075
 
  Revision 1.67  2000/01/31 10:15:43  pierre
1076
 
   * Jonas' fix for bug811
1077
 
 
1078
 
  Revision 1.66  2000/01/23 12:22:37  florian
1079
 
    * reading of 64 bit type implemented
1080
 
 
1081
 
  Revision 1.65  2000/01/20 20:19:37  florian
1082
 
   * writing of int64/qword fixed
1083
 
 
1084
 
  Revision 1.64  2000/01/08 17:08:36  jonas
1085
 
    + Mac linebreak (#13) support for readln
1086
 
 
1087
 
  Revision 1.63  2000/01/07 16:41:36  daniel
1088
 
    * copyright 2000
1089
 
 
1090
 
  Revision 1.62  2000/01/07 16:32:25  daniel
1091
 
    * copyright 2000 added
1092
 
 
1093
 
  Revision 1.61  1999/12/02 17:40:06  peter
1094
 
    * read_int64 dummy added
1095
 
 
1096
 
  Revision 1.60  1999/11/06 14:35:39  peter
1097
 
    * truncated log
1098
 
 
1099
 
  Revision 1.59  1999/10/26 12:25:19  peter
1100
 
    * inoutres 103 for closed files, just like delphi
1101
 
 
1102
 
  Revision 1.58  1999/10/04 20:42:45  peter
1103
 
    * read ansistring speedup (no length(s) calls anymore)
1104
 
 
1105
 
  Revision 1.57  1999/09/10 17:14:43  peter
1106
 
    * remove CR when reading one char less then size
1107
 
 
1108
 
  Revision 1.56  1999/09/10 15:40:33  peter
1109
 
    * fixed do_open flags to be > $100, becuase filemode can be upto 255
1110
 
 
1111
 
  Revision 1.55  1999/09/08 16:12:24  peter
1112
 
    * fixed inoutres for diskfull
1113
 
 
1114
 
  Revision 1.54  1999/09/07 07:44:58  peter
1115
 
    * fixed array of char writing which didn't write the last char
1116
 
 
1117
 
  Revision 1.53  1999/08/19 11:16:14  peter
1118
 
    * settextbuf size is now longint
1119
 
 
1120
 
  Revision 1.52  1999/08/03 21:58:45  peter
1121
 
    * small speed improvements
1122
 
 
1123
 
  Revision 1.51  1999/07/26 09:43:24  florian
1124
 
    + write helper routine for in64 implemented
 
1276
  Revision 1.23  2004/05/01 20:52:50  peter
 
1277
    * ValSInt fixed for 64 bit
 
1278
 
 
1279
  Revision 1.22  2004/04/29 18:59:43  peter
 
1280
    * str() helpers now also use valint/valuint
 
1281
    * int64/qword helpers disabled for cpu64
 
1282
 
 
1283
  Revision 1.21  2004/04/22 21:10:56  peter
 
1284
    * do_read/do_write addr argument changed to pointer
 
1285
 
 
1286
  Revision 1.20  2002/11/29 16:26:52  peter
 
1287
    * fixed ignorespaces which was broken by the previous commit
 
1288
      when a line started with spaces
 
1289
 
 
1290
  Revision 1.19  2002/11/29 15:50:27  peter
 
1291
    * fix for tw1896
 
1292
 
 
1293
  Revision 1.18  2002/09/07 15:07:46  peter
 
1294
    * old logs removed and tabs fixed
 
1295
 
 
1296
  Revision 1.17  2002/07/01 16:29:05  peter
 
1297
    * sLineBreak changed to normal constant like Kylix
1125
1298
 
1126
1299
}