gcc/ada/a-textio.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME COMPONENTS                          --
   4 --                                                                          --
   5 --                          A D A . T E X T _ I O                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- As a special exception,  if other files  instantiate  generics from this --
  24 -- unit, or you link  this unit with other files  to produce an executable, --
  25 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  26 -- covered  by the  GNU  General  Public  License.  This exception does not --
  27 -- however invalidate  any other reasons why  the executable file  might be --
  28 -- covered by the  GNU Public License.                                      --
  29 --                                                                          --
  30 -- GNAT was originally developed  by the GNAT team at  New York University. --
  31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  32 --                                                                          --
  33 ------------------------------------------------------------------------------
  34
  35 with Ada.Streams;          use Ada.Streams;
  36 with Interfaces.C_Streams; use Interfaces.C_Streams;
  37 with System;
  38 with System.File_IO;
  39 with Unchecked_Conversion;
  40 with Unchecked_Deallocation;
  41
  42 pragma Elaborate_All (System.File_IO);
  43 --  Needed because of calls to Chain_File in package body elaboration
  44
  45 package body Ada.Text_IO is
  46
  47    package FIO renames System.File_IO;
  48
  49    subtype AP is FCB.AFCB_Ptr;
  50
  51    function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
  52    function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
  53    use type FCB.File_Mode;
  54
  55    -------------------
  56    -- AFCB_Allocate --
  57    -------------------
  58
  59    function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr is
  60       pragma Warnings (Off, Control_Block);
  61
  62    begin
  63       return new Text_AFCB;
  64    end AFCB_Allocate;
  65
  66    ----------------
  67    -- AFCB_Close --
  68    ----------------
  69
  70    procedure AFCB_Close (File : access Text_AFCB) is
  71    begin
  72       --  If the file being closed is one of the current files, then close
  73       --  the corresponding current file. It is not clear that this action
  74       --  is required (RM A.10.3(23)) but it seems reasonable, and besides
  75       --  ACVC test CE3208A expects this behavior.
  76
  77       if File_Type (File) = Current_In then
  78          Current_In := null;
  79       elsif File_Type (File) = Current_Out then
  80          Current_Out := null;
  81       elsif File_Type (File) = Current_Err then
  82          Current_Err := null;
  83       end if;
  84
  85       Terminate_Line (File_Type (File));
  86    end AFCB_Close;
  87
  88    ---------------
  89    -- AFCB_Free --
  90    ---------------
  91
  92    procedure AFCB_Free (File : access Text_AFCB) is
  93       type FCB_Ptr is access all Text_AFCB;
  94       FT : FCB_Ptr := FCB_Ptr (File);
  95
  96       procedure Free is new Unchecked_Deallocation (Text_AFCB, FCB_Ptr);
  97
  98    begin
  99       Free (FT);
 100    end AFCB_Free;
 101
 102    -----------
 103    -- Close --
 104    -----------
 105
 106    procedure Close (File : in out File_Type) is
 107    begin
 108       FIO.Close (AP (File));
 109    end Close;
 110
 111    ---------
 112    -- Col --
 113    ---------
 114
 115    --  Note: we assume that it is impossible in practice for the column
 116    --  to exceed the value of Count'Last, i.e. no check is required for
 117    --  overflow raising layout error.
 118
 119    function Col (File : in File_Type) return Positive_Count is
 120    begin
 121       FIO.Check_File_Open (AP (File));
 122       return File.Col;
 123    end Col;
 124
 125    function Col return Positive_Count is
 126    begin
 127       return Col (Current_Out);
 128    end Col;
 129
 130    ------------
 131    -- Create --
 132    ------------
 133
 134    procedure Create
 135      (File : in out File_Type;
 136       Mode : in File_Mode := Out_File;
 137       Name : in String := "";
 138       Form : in String := "")
 139    is
 140       File_Control_Block : Text_AFCB;
 141
 142    begin
 143       FIO.Open (File_Ptr  => AP (File),
 144                 Dummy_FCB => File_Control_Block,
 145                 Mode      => To_FCB (Mode),
 146                 Name      => Name,
 147                 Form      => Form,
 148                 Amethod   => 'T',
 149                 Creat     => True,
 150                 Text      => True);
 151
 152       File.Self := File;
 153    end Create;
 154
 155    -------------------
 156    -- Current_Error --
 157    -------------------
 158
 159    function Current_Error return File_Type is
 160    begin
 161       return Current_Err;
 162    end Current_Error;
 163
 164    function Current_Error return File_Access is
 165    begin
 166       return Current_Err.Self'Access;
 167    end Current_Error;
 168
 169    -------------------
 170    -- Current_Input --
 171    -------------------
 172
 173    function Current_Input return File_Type is
 174    begin
 175       return Current_In;
 176    end Current_Input;
 177
 178    function Current_Input return File_Access is
 179    begin
 180       return Current_In.Self'Access;
 181    end Current_Input;
 182
 183    --------------------
 184    -- Current_Output --
 185    --------------------
 186
 187    function Current_Output return File_Type is
 188    begin
 189       return Current_Out;
 190    end Current_Output;
 191
 192    function Current_Output return File_Access is
 193    begin
 194       return Current_Out.Self'Access;
 195    end Current_Output;
 196
 197    ------------
 198    -- Delete --
 199    ------------
 200
 201    procedure Delete (File : in out File_Type) is
 202    begin
 203       FIO.Delete (AP (File));
 204    end Delete;
 205
 206    -----------------
 207    -- End_Of_File --
 208    -----------------
 209
 210    function End_Of_File (File : in File_Type) return Boolean is
 211       ch  : int;
 212
 213    begin
 214       FIO.Check_Read_Status (AP (File));
 215
 216       if File.Before_LM then
 217
 218          if File.Before_LM_PM then
 219             return Nextc (File) = EOF;
 220          end if;
 221
 222       else
 223          ch := Getc (File);
 224
 225          if ch = EOF then
 226             return True;
 227
 228          elsif ch /= LM then
 229             Ungetc (ch, File);
 230             return False;
 231
 232          else -- ch = LM
 233             File.Before_LM := True;
 234          end if;
 235       end if;
 236
 237       --  Here we are just past the line mark with Before_LM set so that we
 238       --  do not have to try to back up past the LM, thus avoiding the need
 239       --  to back up more than one character.
 240
 241       ch := Getc (File);
 242
 243       if ch = EOF then
 244          return True;
 245
 246       elsif ch = PM and then File.Is_Regular_File then
 247          File.Before_LM_PM := True;
 248          return Nextc (File) = EOF;
 249
 250       --  Here if neither EOF nor PM followed end of line
 251
 252       else
 253          Ungetc (ch, File);
 254          return False;
 255       end if;
 256
 257    end End_Of_File;
 258
 259    function End_Of_File return Boolean is
 260    begin
 261       return End_Of_File (Current_In);
 262    end End_Of_File;
 263
 264    -----------------
 265    -- End_Of_Line --
 266    -----------------
 267
 268    function End_Of_Line (File : in File_Type) return Boolean is
 269       ch : int;
 270
 271    begin
 272       FIO.Check_Read_Status (AP (File));
 273
 274       if File.Before_LM then
 275          return True;
 276
 277       else
 278          ch := Getc (File);
 279
 280          if ch = EOF then
 281             return True;
 282
 283          else
 284             Ungetc (ch, File);
 285             return (ch = LM);
 286          end if;
 287       end if;
 288    end End_Of_Line;
 289
 290    function End_Of_Line return Boolean is
 291    begin
 292       return End_Of_Line (Current_In);
 293    end End_Of_Line;
 294
 295    -----------------
 296    -- End_Of_Page --
 297    -----------------
 298
 299    function End_Of_Page (File : in File_Type) return Boolean is
 300       ch  : int;
 301
 302    begin
 303       FIO.Check_Read_Status (AP (File));
 304
 305       if not File.Is_Regular_File then
 306          return False;
 307
 308       elsif File.Before_LM then
 309          if File.Before_LM_PM then
 310             return True;
 311          end if;
 312
 313       else
 314          ch := Getc (File);
 315
 316          if ch = EOF then
 317             return True;
 318
 319          elsif ch /= LM then
 320             Ungetc (ch, File);
 321             return False;
 322
 323          else -- ch = LM
 324             File.Before_LM := True;
 325          end if;
 326       end if;
 327
 328       --  Here we are just past the line mark with Before_LM set so that we
 329       --  do not have to try to back up past the LM, thus avoiding the need
 330       --  to back up more than one character.
 331
 332       ch := Nextc (File);
 333
 334       return ch = PM or else ch = EOF;
 335    end End_Of_Page;
 336
 337    function End_Of_Page return Boolean is
 338    begin
 339       return End_Of_Page (Current_In);
 340    end End_Of_Page;
 341
 342    -----------
 343    -- Flush --
 344    -----------
 345
 346    procedure Flush (File : in File_Type) is
 347    begin
 348       FIO.Flush (AP (File));
 349    end Flush;
 350
 351    procedure Flush is
 352    begin
 353       Flush (Current_Out);
 354    end Flush;
 355
 356    ----------
 357    -- Form --
 358    ----------
 359
 360    function Form (File : in File_Type) return String is
 361    begin
 362       return FIO.Form (AP (File));
 363    end Form;
 364
 365    ---------
 366    -- Get --
 367    ---------
 368
 369    procedure Get
 370      (File : in File_Type;
 371       Item : out Character)
 372    is
 373       ch : int;
 374
 375    begin
 376       FIO.Check_Read_Status (AP (File));
 377
 378       if File.Before_LM then
 379          File.Before_LM := False;
 380          File.Col := 1;
 381
 382          if File.Before_LM_PM then
 383             File.Line := 1;
 384             File.Page := File.Page + 1;
 385             File.Before_LM_PM := False;
 386          else
 387             File.Line := File.Line + 1;
 388          end if;
 389       end if;
 390
 391       loop
 392          ch := Getc (File);
 393
 394          if ch = EOF then
 395             raise End_Error;
 396
 397          elsif ch = LM then
 398             File.Line := File.Line + 1;
 399             File.Col := 1;
 400
 401          elsif ch = PM and then File.Is_Regular_File then
 402             File.Page := File.Page + 1;
 403             File.Line := 1;
 404
 405          else
 406             Item := Character'Val (ch);
 407             File.Col := File.Col + 1;
 408             return;
 409          end if;
 410       end loop;
 411    end Get;
 412
 413    procedure Get (Item : out Character) is
 414    begin
 415       Get (Current_In, Item);
 416    end Get;
 417
 418    procedure Get
 419      (File : in File_Type;
 420       Item : out String)
 421    is
 422       ch : int;
 423       J  : Natural;
 424
 425    begin
 426       FIO.Check_Read_Status (AP (File));
 427
 428       if File.Before_LM then
 429          File.Before_LM := False;
 430          File.Before_LM_PM := False;
 431          File.Col := 1;
 432
 433          if File.Before_LM_PM then
 434             File.Line := 1;
 435             File.Page := File.Page + 1;
 436             File.Before_LM_PM := False;
 437
 438          else
 439             File.Line := File.Line + 1;
 440          end if;
 441       end if;
 442
 443       J := Item'First;
 444       while J <= Item'Last loop
 445          ch := Getc (File);
 446
 447          if ch = EOF then
 448             raise End_Error;
 449
 450          elsif ch = LM then
 451             File.Line := File.Line + 1;
 452             File.Col := 1;
 453
 454          elsif ch = PM and then File.Is_Regular_File then
 455             File.Page := File.Page + 1;
 456             File.Line := 1;
 457
 458          else
 459             Item (J) := Character'Val (ch);
 460             J := J + 1;
 461             File.Col := File.Col + 1;
 462          end if;
 463       end loop;
 464    end Get;
 465
 466    procedure Get (Item : out String) is
 467    begin
 468       Get (Current_In, Item);
 469    end Get;
 470
 471    -------------------
 472    -- Get_Immediate --
 473    -------------------
 474
 475    --  More work required here ???
 476
 477    procedure Get_Immediate
 478      (File : in File_Type;
 479       Item : out Character)
 480    is
 481       ch          : int;
 482       end_of_file : int;
 483
 484       procedure getc_immediate
 485         (stream : FILEs; ch : out int; end_of_file : out int);
 486       pragma Import (C, getc_immediate, "getc_immediate");
 487
 488    begin
 489       FIO.Check_Read_Status (AP (File));
 490
 491       if File.Before_LM then
 492          File.Before_LM := False;
 493          File.Before_LM_PM := False;
 494          ch := LM;
 495
 496       else
 497          getc_immediate (File.Stream, ch, end_of_file);
 498
 499          if ferror (File.Stream) /= 0 then
 500             raise Device_Error;
 501          elsif end_of_file /= 0 then
 502             raise End_Error;
 503          end if;
 504       end if;
 505
 506       Item := Character'Val (ch);
 507
 508    end Get_Immediate;
 509
 510    procedure Get_Immediate
 511      (Item : out Character)
 512    is
 513    begin
 514       Get_Immediate (Current_In, Item);
 515    end Get_Immediate;
 516
 517    procedure Get_Immediate
 518      (File      : in File_Type;
 519       Item      : out Character;
 520       Available : out Boolean)
 521    is
 522       ch          : int;
 523       end_of_file : int;
 524       avail       : int;
 525
 526       procedure getc_immediate_nowait
 527         (stream      : FILEs;
 528          ch          : out int;
 529          end_of_file : out int;
 530          avail       : out int);
 531       pragma Import (C, getc_immediate_nowait, "getc_immediate_nowait");
 532
 533    begin
 534       FIO.Check_Read_Status (AP (File));
 535
 536       --  If we are logically before an end of line, but physically after it,
 537       --  then we just return the end of line character, no I/O is necessary.
 538
 539       if File.Before_LM then
 540          File.Before_LM := False;
 541          File.Before_LM_PM := False;
 542
 543          Available := True;
 544          Item := Character'Val (LM);
 545
 546       --  Normal case where a read operation is required
 547
 548       else
 549          getc_immediate_nowait (File.Stream, ch, end_of_file, avail);
 550
 551          if ferror (File.Stream) /= 0 then
 552             raise Device_Error;
 553
 554          elsif end_of_file /= 0 then
 555             raise End_Error;
 556
 557          elsif avail = 0 then
 558             Available := False;
 559             Item := ASCII.NUL;
 560
 561          else
 562             Available := True;
 563             Item := Character'Val (ch);
 564          end if;
 565       end if;
 566
 567    end Get_Immediate;
 568
 569    procedure Get_Immediate
 570      (Item      : out Character;
 571       Available : out Boolean)
 572    is
 573    begin
 574       Get_Immediate (Current_In, Item, Available);
 575    end Get_Immediate;
 576
 577    --------------
 578    -- Get_Line --
 579    --------------
 580
 581    procedure Get_Line
 582      (File : in File_Type;
 583       Item : out String;
 584       Last : out Natural)
 585    is
 586       ch : int;
 587
 588    begin
 589       FIO.Check_Read_Status (AP (File));
 590       Last := Item'First - 1;
 591
 592       --  Immediate exit for null string, this is a case in which we do not
 593       --  need to test for end of file and we do not skip a line mark under
 594       --  any circumstances.
 595
 596       if Last >= Item'Last then
 597          return;
 598       end if;
 599
 600       --  Here we have at least one character, if we are immediately before
 601       --  a line mark, then we will just skip past it storing no characters.
 602
 603       if File.Before_LM then
 604          File.Before_LM := False;
 605          File.Before_LM_PM := False;
 606
 607       --  Otherwise we need to read some characters
 608
 609       else
 610          ch := Getc (File);
 611
 612          --  If we are at the end of file now, it means we are trying to
 613          --  skip a file terminator and we raise End_Error (RM A.10.7(20))
 614
 615          if ch = EOF then
 616             raise End_Error;
 617          end if;
 618
 619          --  Loop through characters. Don't bother if we hit a page mark,
 620          --  since in normal files, page marks can only follow line marks
 621          --  in any case and we only promise to treat the page nonsense
 622          --  correctly in the absense of such rogue page marks.
 623
 624          loop
 625             --  Exit the loop if read is terminated by encountering line mark
 626
 627             exit when ch = LM;
 628
 629             --  Otherwise store the character, note that we know that ch is
 630             --  something other than LM or EOF. It could possibly be a page
 631             --  mark if there is a stray page mark in the middle of a line,
 632             --  but this is not an official page mark in any case, since
 633             --  official page marks can only follow a line mark. The whole
 634             --  page business is pretty much nonsense anyway, so we do not
 635             --  want to waste time trying to make sense out of non-standard
 636             --  page marks in the file! This means that the behavior of
 637             --  Get_Line is different from repeated Get of a character, but
 638             --  that's too bad. We only promise that page numbers etc make
 639             --  sense if the file is formatted in a standard manner.
 640
 641             --  Note: we do not adjust the column number because it is quicker
 642             --  to adjust it once at the end of the operation than incrementing
 643             --  it each time around the loop.
 644
 645             Last := Last + 1;
 646             Item (Last) := Character'Val (ch);
 647
 648             --  All done if the string is full, this is the case in which
 649             --  we do not skip the following line mark. We need to adjust
 650             --  the column number in this case.
 651
 652             if Last = Item'Last then
 653                File.Col := File.Col + Count (Item'Length);
 654                return;
 655             end if;
 656
 657             --  Otherwise read next character. We also exit from the loop if
 658             --  we read an end of file. This is the case where the last line
 659             --  is not terminated with a line mark, and we consider that there
 660             --  is an implied line mark in this case (this is a non-standard
 661             --  file, but it is nice to treat it reasonably).
 662
 663             ch := Getc (File);
 664             exit when ch = EOF;
 665          end loop;
 666       end if;
 667
 668       --  We have skipped past, but not stored, a line mark. Skip following
 669       --  page mark if one follows, but do not do this for a non-regular
 670       --  file (since otherwise we get annoying wait for an extra character)
 671
 672       File.Line := File.Line + 1;
 673       File.Col := 1;
 674
 675       if File.Before_LM_PM then
 676          File.Line := 1;
 677          File.Before_LM_PM := False;
 678          File.Page := File.Page + 1;
 679
 680       elsif File.Is_Regular_File then
 681          ch := Getc (File);
 682
 683          if ch = PM and then File.Is_Regular_File then
 684             File.Line := 1;
 685             File.Page := File.Page + 1;
 686          else
 687             Ungetc (ch, File);
 688          end if;
 689       end if;
 690    end Get_Line;
 691
 692    procedure Get_Line
 693      (Item : out String;
 694       Last : out Natural)
 695    is
 696    begin
 697       Get_Line (Current_In, Item, Last);
 698    end Get_Line;
 699
 700    ----------
 701    -- Getc --
 702    ----------
 703
 704    function Getc (File : File_Type) return int is
 705       ch : int;
 706
 707    begin
 708       ch := fgetc (File.Stream);
 709
 710       if ch = EOF and then ferror (File.Stream) /= 0 then
 711          raise Device_Error;
 712       else
 713          return ch;
 714       end if;
 715    end Getc;
 716
 717    -------------
 718    -- Is_Open --
 719    -------------
 720
 721    function Is_Open (File : in File_Type) return Boolean is
 722    begin
 723       return FIO.Is_Open (AP (File));
 724    end Is_Open;
 725
 726    ----------
 727    -- Line --
 728    ----------
 729
 730    --  Note: we assume that it is impossible in practice for the line
 731    --  to exceed the value of Count'Last, i.e. no check is required for
 732    --  overflow raising layout error.
 733
 734    function Line (File : in File_Type) return Positive_Count is
 735    begin
 736       FIO.Check_File_Open (AP (File));
 737       return File.Line;
 738    end Line;
 739
 740    function Line return Positive_Count is
 741    begin
 742       return Line (Current_Out);
 743    end Line;
 744
 745    -----------------
 746    -- Line_Length --
 747    -----------------
 748
 749    function Line_Length (File : in File_Type) return Count is
 750    begin
 751       FIO.Check_Write_Status (AP (File));
 752       return File.Line_Length;
 753    end Line_Length;
 754
 755    function Line_Length return Count is
 756    begin
 757       return Line_Length (Current_Out);
 758    end Line_Length;
 759
 760    ----------------
 761    -- Look_Ahead --
 762    ----------------
 763
 764    procedure Look_Ahead
 765      (File        : in File_Type;
 766       Item        : out Character;
 767       End_Of_Line : out Boolean)
 768    is
 769       ch : int;
 770
 771    begin
 772       FIO.Check_Read_Status (AP (File));
 773
 774       if File.Before_LM then
 775          End_Of_Line := True;
 776          Item := ASCII.NUL;
 777
 778       else
 779          ch := Nextc (File);
 780
 781          if ch = LM
 782            or else ch = EOF
 783            or else (ch = PM and then File.Is_Regular_File)
 784          then
 785             End_Of_Line := True;
 786             Item := ASCII.NUL;
 787          else
 788             End_Of_Line := False;
 789             Item := Character'Val (ch);
 790          end if;
 791       end if;
 792    end Look_Ahead;
 793
 794    procedure Look_Ahead
 795      (Item        : out Character;
 796       End_Of_Line : out Boolean)
 797    is
 798    begin
 799       Look_Ahead (Current_In, Item, End_Of_Line);
 800    end Look_Ahead;
 801
 802    ----------
 803    -- Mode --
 804    ----------
 805
 806    function Mode (File : in File_Type) return File_Mode is
 807    begin
 808       return To_TIO (FIO.Mode (AP (File)));
 809    end Mode;
 810
 811    ----------
 812    -- Name --
 813    ----------
 814
 815    function Name (File : in File_Type) return String is
 816    begin
 817       return FIO.Name (AP (File));
 818    end Name;
 819
 820    --------------
 821    -- New_Line --
 822    --------------
 823
 824    procedure New_Line
 825      (File    : in File_Type;
 826       Spacing : in Positive_Count := 1)
 827    is
 828    begin
 829       --  Raise Constraint_Error if out of range value. The reason for this
 830       --  explicit test is that we don't want junk values around, even if
 831       --  checks are off in the caller.
 832
 833       if Spacing not in Positive_Count then
 834          raise Constraint_Error;
 835       end if;
 836
 837       FIO.Check_Write_Status (AP (File));
 838
 839       for K in 1 .. Spacing loop
 840          Putc (LM, File);
 841          File.Line := File.Line + 1;
 842
 843          if File.Page_Length /= 0
 844            and then File.Line > File.Page_Length
 845          then
 846             Putc (PM, File);
 847             File.Line := 1;
 848             File.Page := File.Page + 1;
 849          end if;
 850       end loop;
 851
 852       File.Col := 1;
 853    end New_Line;
 854
 855    procedure New_Line (Spacing : in Positive_Count := 1) is
 856    begin
 857       New_Line (Current_Out, Spacing);
 858    end New_Line;
 859
 860    --------------
 861    -- New_Page --
 862    --------------
 863
 864    procedure New_Page (File : in File_Type) is
 865    begin
 866       FIO.Check_Write_Status (AP (File));
 867
 868       if File.Col /= 1 or else File.Line = 1 then
 869          Putc (LM, File);
 870       end if;
 871
 872       Putc (PM, File);
 873       File.Page := File.Page + 1;
 874       File.Line := 1;
 875       File.Col := 1;
 876    end New_Page;
 877
 878    procedure New_Page is
 879    begin
 880       New_Page (Current_Out);
 881    end New_Page;
 882
 883    -----------
 884    -- Nextc --
 885    -----------
 886
 887    function Nextc (File : File_Type) return int is
 888       ch : int;
 889
 890    begin
 891       ch := fgetc (File.Stream);
 892
 893       if ch = EOF then
 894          if ferror (File.Stream) /= 0 then
 895             raise Device_Error;
 896          end if;
 897
 898       else
 899          if ungetc (ch, File.Stream) = EOF then
 900             raise Device_Error;
 901          end if;
 902       end if;
 903
 904       return ch;
 905    end Nextc;
 906
 907    ----------
 908    -- Open --
 909    ----------
 910
 911    procedure Open
 912      (File : in out File_Type;
 913       Mode : in File_Mode;
 914       Name : in String;
 915       Form : in String := "")
 916    is
 917       File_Control_Block : Text_AFCB;
 918
 919    begin
 920       FIO.Open (File_Ptr  => AP (File),
 921                 Dummy_FCB => File_Control_Block,
 922                 Mode      => To_FCB (Mode),
 923                 Name      => Name,
 924                 Form      => Form,
 925                 Amethod   => 'T',
 926                 Creat     => False,
 927                 Text      => True);
 928
 929       File.Self := File;
 930    end Open;
 931
 932    ----------
 933    -- Page --
 934    ----------
 935
 936    --  Note: we assume that it is impossible in practice for the page
 937    --  to exceed the value of Count'Last, i.e. no check is required for
 938    --  overflow raising layout error.
 939
 940    function Page (File : in File_Type) return Positive_Count is
 941    begin
 942       FIO.Check_File_Open (AP (File));
 943       return File.Page;
 944    end Page;
 945
 946    function Page return Positive_Count is
 947    begin
 948       return Page (Current_Out);
 949    end Page;
 950
 951    -----------------
 952    -- Page_Length --
 953    -----------------
 954
 955    function Page_Length (File : in File_Type) return Count is
 956    begin
 957       FIO.Check_Write_Status (AP (File));
 958       return File.Page_Length;
 959    end Page_Length;
 960
 961    function Page_Length return Count is
 962    begin
 963       return Page_Length (Current_Out);
 964    end Page_Length;
 965
 966    ---------
 967    -- Put --
 968    ---------
 969
 970    procedure Put
 971      (File : in File_Type;
 972       Item : in Character)
 973    is
 974    begin
 975       FIO.Check_Write_Status (AP (File));
 976
 977       if File.Line_Length /= 0 and then File.Col > File.Line_Length then
 978          New_Line (File);
 979       end if;
 980
 981       if fputc (Character'Pos (Item), File.Stream) = EOF then
 982          raise Device_Error;
 983       end if;
 984
 985       File.Col := File.Col + 1;
 986    end Put;
 987
 988    procedure Put (Item : in Character) is
 989    begin
 990       FIO.Check_Write_Status (AP (Current_Out));
 991
 992       if Current_Out.Line_Length /= 0
 993         and then Current_Out.Col > Current_Out.Line_Length
 994       then
 995          New_Line (Current_Out);
 996       end if;
 997
 998       if fputc (Character'Pos (Item), Current_Out.Stream) = EOF then
 999          raise Device_Error;
1000       end if;
1001
1002       Current_Out.Col := Current_Out.Col + 1;
1003    end Put;
1004
1005    ---------
1006    -- Put --
1007    ---------
1008
1009    procedure Put
1010      (File : in File_Type;
1011       Item : in String)
1012    is
1013    begin
1014       FIO.Check_Write_Status (AP (File));
1015
1016       if Item'Length > 0 then
1017
1018          --  If we have bounded lines, then do things character by
1019          --  character (this seems a rare case anyway!)
1020
1021          if File.Line_Length /= 0 then
1022             for J in Item'Range loop
1023                Put (File, Item (J));
1024             end loop;
1025
1026          --  Otherwise we can output the entire string at once. Note that if
1027          --  there are LF or FF characters in the string, we do not bother to
1028          --  count them as line or page terminators.
1029
1030          else
1031             FIO.Write_Buf (AP (File), Item'Address, Item'Length);
1032             File.Col := File.Col + Item'Length;
1033          end if;
1034       end if;
1035    end Put;
1036
1037    procedure Put (Item : in String) is
1038    begin
1039       Put (Current_Out, Item);
1040    end Put;
1041
1042    --------------
1043    -- Put_Line --
1044    --------------
1045
1046    procedure Put_Line
1047      (File : in File_Type;
1048       Item : in String)
1049    is
1050    begin
1051       FIO.Check_Write_Status (AP (File));
1052
1053       --  If we have bounded lines, then just do a put and a new line. In
1054       --  this case we will end up doing things character by character in
1055       --  any case, and it is a rare situation.
1056
1057       if File.Line_Length /= 0 then
1058          Put (File, Item);
1059          New_Line (File);
1060          return;
1061       end if;
1062
1063       --  We setup a single string that has the necessary terminators and
1064       --  then write it with a single call. The reason for doing this is
1065       --  that it gives better behavior for the use of Put_Line in multi-
1066       --  tasking programs, since often the OS will treat the entire put
1067       --  operation as an atomic operation.
1068
1069       declare
1070          Ilen   : constant Natural := Item'Length;
1071          Buffer : String (1 .. Ilen + 2);
1072          Plen   : size_t;
1073
1074       begin
1075          Buffer (1 .. Ilen) := Item;
1076          Buffer (Ilen + 1) := Character'Val (LM);
1077
1078          if File.Page_Length /= 0
1079            and then File.Line > File.Page_Length
1080          then
1081             Buffer (Ilen + 2) := Character'Val (PM);
1082             Plen := size_t (Ilen) + 2;
1083             File.Line := 1;
1084             File.Page := File.Page + 1;
1085
1086          else
1087             Plen := size_t (Ilen) + 1;
1088             File.Line := File.Line + 1;
1089          end if;
1090
1091          FIO.Write_Buf (AP (File), Buffer'Address, Plen);
1092
1093          File.Col := 1;
1094       end;
1095    end Put_Line;
1096
1097    procedure Put_Line (Item : in String) is
1098    begin
1099       Put_Line (Current_Out, Item);
1100    end Put_Line;
1101
1102    ----------
1103    -- Putc --
1104    ----------
1105
1106    procedure Putc (ch : int; File : File_Type) is
1107    begin
1108       if fputc (ch, File.Stream) = EOF then
1109          raise Device_Error;
1110       end if;
1111    end Putc;
1112
1113    ----------
1114    -- Read --
1115    ----------
1116
1117    --  This is the primitive Stream Read routine, used when a Text_IO file
1118    --  is treated directly as a stream using Text_IO.Streams.Stream.
1119
1120    procedure Read
1121      (File : in out Text_AFCB;
1122       Item : out Stream_Element_Array;
1123       Last : out Stream_Element_Offset)
1124    is
1125       ch : int;
1126
1127    begin
1128       if File.Mode /= FCB.In_File then
1129          raise Mode_Error;
1130       end if;
1131
1132       --  Deal with case where our logical and physical position do not match
1133       --  because of being after an LM or LM-PM sequence when in fact we are
1134       --  logically positioned before it.
1135
1136       if File.Before_LM then
1137
1138          --  If we are before a PM, then it is possible for a stream read
1139          --  to leave us after the LM and before the PM, which is a bit
1140          --  odd. The easiest way to deal with this is to unget the PM,
1141          --  so we are indeed positioned between the characters. This way
1142          --  further stream read operations will work correctly, and the
1143          --  effect on text processing is a little weird, but what can
1144          --  be expected if stream and text input are mixed this way?
1145
1146          if File.Before_LM_PM then
1147             ch := ungetc (PM, File.Stream);
1148             File.Before_LM_PM := False;
1149          end if;
1150
1151          File.Before_LM := False;
1152
1153          Item (Item'First) := Stream_Element (Character'Pos (ASCII.LF));
1154
1155          if Item'Length = 1 then
1156             Last := Item'Last;
1157
1158          else
1159             Last :=
1160               Item'First +
1161                 Stream_Element_Offset
1162                   (fread (buffer => Item'Address,
1163                           index  => size_t (Item'First + 1),
1164                           size   => 1,
1165                           count  => Item'Length - 1,
1166                           stream => File.Stream));
1167          end if;
1168
1169          return;
1170       end if;
1171
1172       --  Now we do the read. Since this is a text file, it is normally in
1173       --  text mode, but stream data must be read in binary mode, so we
1174       --  temporarily set binary mode for the read, resetting it after.
1175       --  These calls have no effect in a system (like Unix) where there is
1176       --  no distinction between text and binary files.
1177
1178       set_binary_mode (fileno (File.Stream));
1179
1180       Last :=
1181         Item'First +
1182           Stream_Element_Offset
1183             (fread (Item'Address, 1, Item'Length, File.Stream)) - 1;
1184
1185       if Last < Item'Last then
1186          if ferror (File.Stream) /= 0 then
1187             raise Device_Error;
1188          end if;
1189       end if;
1190
1191       set_text_mode (fileno (File.Stream));
1192    end Read;
1193
1194    -----------
1195    -- Reset --
1196    -----------
1197
1198    procedure Reset
1199      (File : in out File_Type;
1200       Mode : in File_Mode)
1201    is
1202    begin
1203       --  Don't allow change of mode for current file (RM A.10.2(5))
1204
1205       if (File = Current_In or else
1206           File = Current_Out  or else
1207           File = Current_Error)
1208         and then To_FCB (Mode) /= File.Mode
1209       then
1210          raise Mode_Error;
1211       end if;
1212
1213       Terminate_Line (File);
1214       FIO.Reset (AP (File), To_FCB (Mode));
1215       File.Page := 1;
1216       File.Line := 1;
1217       File.Col  := 1;
1218       File.Line_Length := 0;
1219       File.Page_Length := 0;
1220       File.Before_LM := False;
1221       File.Before_LM_PM := False;
1222    end Reset;
1223
1224    procedure Reset (File : in out File_Type) is
1225    begin
1226       Terminate_Line (File);
1227       FIO.Reset (AP (File));
1228       File.Page := 1;
1229       File.Line := 1;
1230       File.Col  := 1;
1231       File.Line_Length := 0;
1232       File.Page_Length := 0;
1233       File.Before_LM := False;
1234       File.Before_LM_PM := False;
1235    end Reset;
1236
1237    -------------
1238    -- Set_Col --
1239    -------------
1240
1241    procedure Set_Col
1242      (File : in File_Type;
1243       To   : in Positive_Count)
1244    is
1245       ch : int;
1246
1247    begin
1248       --  Raise Constraint_Error if out of range value. The reason for this
1249       --  explicit test is that we don't want junk values around, even if
1250       --  checks are off in the caller.
1251
1252       if To not in Positive_Count then
1253          raise Constraint_Error;
1254       end if;
1255
1256       FIO.Check_File_Open (AP (File));
1257
1258       if To = File.Col then
1259          return;
1260       end if;
1261
1262       if Mode (File) >= Out_File then
1263          if File.Line_Length /= 0 and then To > File.Line_Length then
1264             raise Layout_Error;
1265          end if;
1266
1267          if To < File.Col then
1268             New_Line (File);
1269          end if;
1270
1271          while File.Col < To loop
1272             Put (File, ' ');
1273          end loop;
1274
1275       else
1276          loop
1277             ch := Getc (File);
1278
1279             if ch = EOF then
1280                raise End_Error;
1281
1282             elsif ch = LM then
1283                File.Line := File.Line + 1;
1284                File.Col := 1;
1285
1286             elsif ch = PM and then File.Is_Regular_File then
1287                File.Page := File.Page + 1;
1288                File.Line := 1;
1289                File.Col := 1;
1290
1291             elsif To = File.Col then
1292                Ungetc (ch, File);
1293                return;
1294
1295             else
1296                File.Col := File.Col + 1;
1297             end if;
1298          end loop;
1299       end if;
1300    end Set_Col;
1301
1302    procedure Set_Col (To : in Positive_Count) is
1303    begin
1304       Set_Col (Current_Out, To);
1305    end Set_Col;
1306
1307    ---------------
1308    -- Set_Error --
1309    ---------------
1310
1311    procedure Set_Error (File : in File_Type) is
1312    begin
1313       FIO.Check_Write_Status (AP (File));
1314       Current_Err := File;
1315    end Set_Error;
1316
1317    ---------------
1318    -- Set_Input --
1319    ---------------
1320
1321    procedure Set_Input (File : in File_Type) is
1322    begin
1323       FIO.Check_Read_Status (AP (File));
1324       Current_In := File;
1325    end Set_Input;
1326
1327    --------------
1328    -- Set_Line --
1329    --------------
1330
1331    procedure Set_Line
1332      (File : in File_Type;
1333       To   : in Positive_Count)
1334    is
1335    begin
1336       --  Raise Constraint_Error if out of range value. The reason for this
1337       --  explicit test is that we don't want junk values around, even if
1338       --  checks are off in the caller.
1339
1340       if To not in Positive_Count then
1341          raise Constraint_Error;
1342       end if;
1343
1344       FIO.Check_File_Open (AP (File));
1345
1346       if To = File.Line then
1347          return;
1348       end if;
1349
1350       if Mode (File) >= Out_File then
1351          if File.Page_Length /= 0 and then To > File.Page_Length then
1352             raise Layout_Error;
1353          end if;
1354
1355          if To < File.Line then
1356             New_Page (File);
1357          end if;
1358
1359          while File.Line < To loop
1360             New_Line (File);
1361          end loop;
1362
1363       else
1364          while To /= File.Line loop
1365             Skip_Line (File);
1366          end loop;
1367       end if;
1368    end Set_Line;
1369
1370    procedure Set_Line (To : in Positive_Count) is
1371    begin
1372       Set_Line (Current_Out, To);
1373    end Set_Line;
1374
1375    ---------------------
1376    -- Set_Line_Length --
1377    ---------------------
1378
1379    procedure Set_Line_Length (File : in File_Type; To : in Count) is
1380    begin
1381       --  Raise Constraint_Error if out of range value. The reason for this
1382       --  explicit test is that we don't want junk values around, even if
1383       --  checks are off in the caller.
1384
1385       if To not in Count then
1386          raise Constraint_Error;
1387       end if;
1388
1389       FIO.Check_Write_Status (AP (File));
1390       File.Line_Length := To;
1391    end Set_Line_Length;
1392
1393    procedure Set_Line_Length (To : in Count) is
1394    begin
1395       Set_Line_Length (Current_Out, To);
1396    end Set_Line_Length;
1397
1398    ----------------
1399    -- Set_Output --
1400    ----------------
1401
1402    procedure Set_Output (File : in File_Type) is
1403    begin
1404       FIO.Check_Write_Status (AP (File));
1405       Current_Out := File;
1406    end Set_Output;
1407
1408    ---------------------
1409    -- Set_Page_Length --
1410    ---------------------
1411
1412    procedure Set_Page_Length (File : in File_Type; To : in Count) is
1413    begin
1414       --  Raise Constraint_Error if out of range value. The reason for this
1415       --  explicit test is that we don't want junk values around, even if
1416       --  checks are off in the caller.
1417
1418       if To not in Count then
1419          raise Constraint_Error;
1420       end if;
1421
1422       FIO.Check_Write_Status (AP (File));
1423       File.Page_Length := To;
1424    end Set_Page_Length;
1425
1426    procedure Set_Page_Length (To : in Count) is
1427    begin
1428       Set_Page_Length (Current_Out, To);
1429    end Set_Page_Length;
1430
1431    ---------------
1432    -- Skip_Line --
1433    ---------------
1434
1435    procedure Skip_Line
1436      (File    : in File_Type;
1437       Spacing : in Positive_Count := 1)
1438    is
1439       ch : int;
1440
1441    begin
1442       --  Raise Constraint_Error if out of range value. The reason for this
1443       --  explicit test is that we don't want junk values around, even if
1444       --  checks are off in the caller.
1445
1446       if Spacing not in Positive_Count then
1447          raise Constraint_Error;
1448       end if;
1449
1450       FIO.Check_Read_Status (AP (File));
1451
1452       for L in 1 .. Spacing loop
1453          if File.Before_LM then
1454             File.Before_LM := False;
1455             File.Before_LM_PM := False;
1456
1457          else
1458             ch := Getc (File);
1459
1460             --  If at end of file now, then immediately raise End_Error. Note
1461             --  that we can never be positioned between a line mark and a page
1462             --  mark, so if we are at the end of file, we cannot logically be
1463             --  before the implicit page mark that is at the end of the file.
1464
1465             --  For the same reason, we do not need an explicit check for a
1466             --  page mark. If there is a FF in the middle of a line, the file
1467             --  is not in canonical format and we do not care about the page
1468             --  numbers for files other than ones in canonical format.
1469
1470             if ch = EOF then
1471                raise End_Error;
1472             end if;
1473
1474             --  If not at end of file, then loop till we get to an LM or EOF.
1475             --  The latter case happens only in non-canonical files where the
1476             --  last line is not terminated by LM, but we don't want to blow
1477             --  up for such files, so we assume an implicit LM in this case.
1478
1479             loop
1480                exit when ch = LM or ch = EOF;
1481                ch := Getc (File);
1482             end loop;
1483          end if;
1484
1485          --  We have got past a line mark, now, for a regular file only,
1486          --  see if a page mark immediately follows this line mark and
1487          --  if so, skip past the page mark as well. We do not do this
1488          --  for non-regular files, since it would cause an undesirable
1489          --  wait for an additional character.
1490
1491          File.Col := 1;
1492          File.Line := File.Line + 1;
1493
1494          if File.Before_LM_PM then
1495             File.Page := File.Page + 1;
1496             File.Line := 1;
1497             File.Before_LM_PM := False;
1498
1499          elsif File.Is_Regular_File then
1500             ch := Getc (File);
1501
1502             --  Page mark can be explicit, or implied at the end of the file
1503
1504             if (ch = PM or else ch = EOF)
1505               and then File.Is_Regular_File
1506             then
1507                File.Page := File.Page + 1;
1508                File.Line := 1;
1509             else
1510                Ungetc (ch, File);
1511             end if;
1512          end if;
1513
1514       end loop;
1515    end Skip_Line;
1516
1517    procedure Skip_Line (Spacing : in Positive_Count := 1) is
1518    begin
1519       Skip_Line (Current_In, Spacing);
1520    end Skip_Line;
1521
1522    ---------------
1523    -- Skip_Page --
1524    ---------------
1525
1526    procedure Skip_Page (File : in File_Type) is
1527       ch : int;
1528
1529    begin
1530       FIO.Check_Read_Status (AP (File));
1531
1532       --  If at page mark already, just skip it
1533
1534       if File.Before_LM_PM then
1535          File.Before_LM := False;
1536          File.Before_LM_PM := False;
1537          File.Page := File.Page + 1;
1538          File.Line := 1;
1539          File.Col  := 1;
1540          return;
1541       end if;
1542
1543       --  This is a bit tricky, if we are logically before an LM then
1544       --  it is not an error if we are at an end of file now, since we
1545       --  are not really at it.
1546
1547       if File.Before_LM then
1548          File.Before_LM := False;
1549          File.Before_LM_PM := False;
1550          ch := Getc (File);
1551
1552       --  Otherwise we do raise End_Error if we are at the end of file now
1553
1554       else
1555          ch := Getc (File);
1556
1557          if ch = EOF then
1558             raise End_Error;
1559          end if;
1560       end if;
1561
1562       --  Now we can just rumble along to the next page mark, or to the
1563       --  end of file, if that comes first. The latter case happens when
1564       --  the page mark is implied at the end of file.
1565
1566       loop
1567          exit when ch = EOF
1568            or else (ch = PM and then File.Is_Regular_File);
1569          ch := Getc (File);
1570       end loop;
1571
1572       File.Page := File.Page + 1;
1573       File.Line := 1;
1574       File.Col  := 1;
1575    end Skip_Page;
1576
1577    procedure Skip_Page is
1578    begin
1579       Skip_Page (Current_In);
1580    end Skip_Page;
1581
1582    --------------------
1583    -- Standard_Error --
1584    --------------------
1585
1586    function Standard_Error return File_Type is
1587    begin
1588       return Standard_Err;
1589    end Standard_Error;
1590
1591    function Standard_Error return File_Access is
1592    begin
1593       return Standard_Err'Access;
1594    end Standard_Error;
1595
1596    --------------------
1597    -- Standard_Input --
1598    --------------------
1599
1600    function Standard_Input return File_Type is
1601    begin
1602       return Standard_In;
1603    end Standard_Input;
1604
1605    function Standard_Input return File_Access is
1606    begin
1607       return Standard_In'Access;
1608    end Standard_Input;
1609
1610    ---------------------
1611    -- Standard_Output --
1612    ---------------------
1613
1614    function Standard_Output return File_Type is
1615    begin
1616       return Standard_Out;
1617    end Standard_Output;
1618
1619    function Standard_Output return File_Access is
1620    begin
1621       return Standard_Out'Access;
1622    end Standard_Output;
1623
1624    --------------------
1625    -- Terminate_Line --
1626    --------------------
1627
1628    procedure Terminate_Line (File : File_Type) is
1629    begin
1630       FIO.Check_File_Open (AP (File));
1631
1632       --  For file other than In_File, test for needing to terminate last line
1633
1634       if Mode (File) /= In_File then
1635
1636          --  If not at start of line definition need new line
1637
1638          if File.Col /= 1 then
1639             New_Line (File);
1640
1641          --  For files other than standard error and standard output, we
1642          --  make sure that an empty file has a single line feed, so that
1643          --  it is properly formatted. We avoid this for the standard files
1644          --  because it is too much of a nuisance to have these odd line
1645          --  feeds when nothing has been written to the file.
1646
1647          elsif (File /= Standard_Err and then File /= Standard_Out)
1648            and then (File.Line = 1 and then File.Page = 1)
1649          then
1650             New_Line (File);
1651          end if;
1652       end if;
1653    end Terminate_Line;
1654
1655    ------------
1656    -- Ungetc --
1657    ------------
1658
1659    procedure Ungetc (ch : int; File : File_Type) is
1660    begin
1661       if ch /= EOF then
1662          if ungetc (ch, File.Stream) = EOF then
1663             raise Device_Error;
1664          end if;
1665       end if;
1666    end Ungetc;
1667
1668    -----------
1669    -- Write --
1670    -----------
1671
1672    --  This is the primitive Stream Write routine, used when a Text_IO file
1673    --  is treated directly as a stream using Text_IO.Streams.Stream.
1674
1675    procedure Write
1676      (File : in out Text_AFCB;
1677       Item : in Stream_Element_Array)
1678    is
1679
1680       function Has_Translated_Characters return Boolean;
1681       --  return True if Item array contains a character which will be
1682       --  translated under the text file mode. There is only one such
1683       --  character under DOS based systems which is character 10.
1684
1685       text_translation_required : Boolean;
1686       pragma Import (C, text_translation_required,
1687                      "__gnat_text_translation_required");
1688
1689       Siz : constant size_t := Item'Length;
1690
1691       function Has_Translated_Characters return Boolean is
1692       begin
1693          for K in Item'Range loop
1694             if Item (K) = 10 then
1695                return True;
1696             end if;
1697          end loop;
1698          return False;
1699       end Has_Translated_Characters;
1700
1701       Needs_Binary_Write : constant Boolean :=
1702         text_translation_required and then Has_Translated_Characters;
1703
1704    begin
1705       if File.Mode = FCB.In_File then
1706          raise Mode_Error;
1707       end if;
1708
1709       --  Now we do the write. Since this is a text file, it is normally in
1710       --  text mode, but stream data must be written in binary mode, so we
1711       --  temporarily set binary mode for the write, resetting it after. This
1712       --  is done only if needed (i.e. there is some characters in Item which
1713       --  needs to be written using the binary mode).
1714       --  These calls have no effect in a system (like Unix) where there is
1715       --  no distinction between text and binary files.
1716
1717       --  Since the character translation is done at the time the buffer is
1718       --  written (this is true under Windows) we first flush current buffer
1719       --  with text mode if needed.
1720
1721       if Needs_Binary_Write then
1722
1723          if fflush (File.Stream) = -1 then
1724             raise Device_Error;
1725          end if;
1726
1727          set_binary_mode (fileno (File.Stream));
1728       end if;
1729
1730       if fwrite (Item'Address, 1, Siz, File.Stream) /= Siz then
1731          raise Device_Error;
1732       end if;
1733
1734       --  At this point we need to flush the buffer using the binary mode then
1735       --  we reset to text mode.
1736
1737       if Needs_Binary_Write then
1738
1739          if fflush (File.Stream) = -1 then
1740             raise Device_Error;
1741          end if;
1742
1743          set_text_mode (fileno (File.Stream));
1744       end if;
1745    end Write;
1746
1747    --  Use "preallocated" strings to avoid calling "new" during the
1748    --  elaboration of the run time. This is needed in the tasking case to
1749    --  avoid calling Task_Lock too early. A filename is expected to end with a
1750    --  null character in the runtime, here the null characters are added just
1751    --  to have a correct filename length.
1752
1753    Err_Name : aliased String := "*stderr" & ASCII.Nul;
1754    In_Name  : aliased String := "*stdin" & ASCII.Nul;
1755    Out_Name : aliased String := "*stdout" & ASCII.Nul;
1756 begin
1757    -------------------------------
1758    -- Initialize Standard Files --
1759    -------------------------------
1760
1761    --  Note: the names in these files are bogus, and probably it would be
1762    --  better for these files to have no names, but the ACVC test insist!
1763    --  We use names that are bound to fail in open etc.
1764
1765    Standard_Err.Stream            := stderr;
1766    Standard_Err.Name              := Err_Name'Access;
1767    Standard_Err.Form              := Null_Str'Unrestricted_Access;
1768    Standard_Err.Mode              := FCB.Out_File;
1769    Standard_Err.Is_Regular_File   := is_regular_file (fileno (stderr)) /= 0;
1770    Standard_Err.Is_Temporary_File := False;
1771    Standard_Err.Is_System_File    := True;
1772    Standard_Err.Is_Text_File      := True;
1773    Standard_Err.Access_Method     := 'T';
1774    Standard_Err.Self              := Standard_Err;
1775
1776    Standard_In.Stream             := stdin;
1777    Standard_In.Name               := In_Name'Access;
1778    Standard_In.Form               := Null_Str'Unrestricted_Access;
1779    Standard_In.Mode               := FCB.In_File;
1780    Standard_In.Is_Regular_File    := is_regular_file (fileno (stdin)) /= 0;
1781    Standard_In.Is_Temporary_File  := False;
1782    Standard_In.Is_System_File     := True;
1783    Standard_In.Is_Text_File       := True;
1784    Standard_In.Access_Method      := 'T';
1785    Standard_In.Self               := Standard_In;
1786
1787    Standard_Out.Stream            := stdout;
1788    Standard_Out.Name              := Out_Name'Access;
1789    Standard_Out.Form              := Null_Str'Unrestricted_Access;
1790    Standard_Out.Mode              := FCB.Out_File;
1791    Standard_Out.Is_Regular_File   := is_regular_file (fileno (stdout)) /= 0;
1792    Standard_Out.Is_Temporary_File := False;
1793    Standard_Out.Is_System_File    := True;
1794    Standard_Out.Is_Text_File      := True;
1795    Standard_Out.Access_Method     := 'T';
1796    Standard_Out.Self              := Standard_Out;
1797
1798    FIO.Chain_File (AP (Standard_In));
1799    FIO.Chain_File (AP (Standard_Out));
1800    FIO.Chain_File (AP (Standard_Err));
1801
1802    FIO.Make_Unbuffered (AP (Standard_Out));
1803    FIO.Make_Unbuffered (AP (Standard_Err));
1804
1805 end Ada.Text_IO;