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