gcc/ada/a-textio.adb

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