gcc/ada/a-witeio.adb

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