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