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