+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- O U T P U T --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
-package body Output is
-
- Current_FD : File_Descriptor := Standout;
- -- File descriptor for current output
-
- -----------------------
- -- Local_Subprograms --
- -----------------------
-
- procedure Flush_Buffer;
- -- Flush buffer if non-empty and reset column counter
-
- ------------------
- -- Flush_Buffer --
- ------------------
-
- procedure Flush_Buffer is
- Len : constant Natural := Natural (Column - 1);
-
- begin
- if Len /= 0 then
- if Len /= Write (Current_FD, Buffer'Address, Len) then
- Set_Standard_Error;
- Write_Line ("fatal error: disk full");
- OS_Exit (2);
- end if;
-
- Column := 1;
- end if;
- end Flush_Buffer;
-
- ------------------------
- -- Set_Standard_Error --
- ------------------------
-
- procedure Set_Standard_Error is
- begin
- Flush_Buffer;
- Current_FD := Standerr;
- Column := 1;
- end Set_Standard_Error;
-
- -------------------------
- -- Set_Standard_Output --
- -------------------------
-
- procedure Set_Standard_Output is
- begin
- Flush_Buffer;
- Current_FD := Standout;
- Column := 1;
- end Set_Standard_Output;
-
- -------
- -- w --
- -------
-
- procedure w (C : Character) is
- begin
- Write_Char (''');
- Write_Char (C);
- Write_Char (''');
- Write_Eol;
- end w;
-
- procedure w (S : String) is
- begin
- Write_Str (S);
- Write_Eol;
- end w;
-
- procedure w (V : Int) is
- begin
- Write_Int (V);
- Write_Eol;
- end w;
-
- procedure w (B : Boolean) is
- begin
- if B then
- w ("True");
- else
- w ("False");
- end if;
- end w;
-
- procedure w (L : String; C : Character) is
- begin
- Write_Str (L);
- Write_Char (' ');
- w (C);
- end w;
-
- procedure w (L : String; S : String) is
- begin
- Write_Str (L);
- Write_Char (' ');
- w (S);
- end w;
-
- procedure w (L : String; V : Int) is
- begin
- Write_Str (L);
- Write_Char (' ');
- w (V);
- end w;
-
- procedure w (L : String; B : Boolean) is
- begin
- Write_Str (L);
- Write_Char (' ');
- w (B);
- end w;
-
- ----------------
- -- Write_Char --
- ----------------
-
- procedure Write_Char (C : Character) is
- begin
- if Column < Buffer'Length then
- Buffer (Natural (Column)) := C;
- Column := Column + 1;
- end if;
- end Write_Char;
-
- ---------------
- -- Write_Eol --
- ---------------
-
- procedure Write_Eol is
- begin
- Buffer (Natural (Column)) := ASCII.LF;
- Column := Column + 1;
- Flush_Buffer;
- end Write_Eol;
-
- ---------------
- -- Write_Int --
- ---------------
-
- procedure Write_Int (Val : Int) is
- begin
- if Val < 0 then
- Write_Char ('-');
- Write_Int (-Val);
-
- else
- if Val > 9 then
- Write_Int (Val / 10);
- end if;
-
- Write_Char (Character'Val ((Val mod 10) + Character'Pos ('0')));
- end if;
- end Write_Int;
-
- ----------------
- -- Write_Line --
- ----------------
-
- procedure Write_Line (S : String) is
- begin
- Write_Str (S);
- Write_Eol;
- end Write_Line;
-
- ---------------
- -- Write_Str --
- ---------------
-
- procedure Write_Str (S : String) is
- begin
- for J in S'Range loop
- Write_Char (S (J));
- end loop;
- end Write_Str;
-
-end Output;
projects / msp430-gcc.git / blobdiff