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