gcc/ada/a-ztexio.adb

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