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