File : os.adb

   1 ------------------------------------------------------------------------------
   2 ------------------------------------------------------------------------------
   3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'.               --
   4 --                                                                          --
   5 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org )                      --
   6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html     --
   7 --                                                                          --
   8 -- You do not have, nor can you ever acquire the right to use, copy or      --
   9 -- distribute this software ; Should you use this software for any purpose, --
  10 -- or copy and distribute it to anyone or in any manner, you are breaking   --
  11 -- the laws of whatever soi-disant jurisdiction, and you promise to         --
  12 -- continue doing so for the indefinite future. In any case, please         --
  13 -- always : read and understand any software ; verify any PGP signatures    --
  14 -- that you use - for any purpose.                                          --
  15 --                                                                          --
  16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     --
  17 ------------------------------------------------------------------------------
  18 ------------------------------------------------------------------------------
  19 
  20 package body OS is
  21    
  22    -- Receive a character from the TTY, and True if success (False if EOF)
  23    function Read_Char(C : out Character) return Boolean is
  24       i : int;
  25       Result : Boolean := False;
  26    begin
  27       i := GetChar;
  28       if i /= EOF then
  29          C := Character'Val(i);
  30          Result := True;
  31       end if;
  32       return Result;
  33    end Read_Char;
  34    
  35    
  36    -- Send a character to the TTY.
  37    procedure Write_Char(C : in Character) is
  38       R : int;
  39       pragma Unreferenced(R);
  40    begin
  41       R := PutChar(int(Character'Pos(C)));
  42    end Write_Char;
  43    
  44    
  45    -- Send a Newline to the TTY.
  46    procedure Write_Newline is
  47    begin
  48       Write_Char(Character'Val(16#A#));
  49    end Write_Newline;
  50    
  51    
  52    -- Send a String to the TTY.
  53    procedure Write_String(S : in String) is
  54    begin
  55       for i in S'Range loop
  56          Write_Char(S(i));
  57       end loop;
  58    end Write_String;
  59    
  60    
  61    -- Exit with an error condition report.
  62    procedure Eggog(M : String) is
  63    begin
  64       for i in 1 .. M'Length loop
  65          To_Stderr(M(I));
  66       end loop;
  67       
  68       -- Emit LF
  69       To_Stderr(Character'Val(16#A#));
  70       
  71       -- Exit
  72       Quit(Sad_Code);
  73    end Eggog;
  74    
  75    -- Warn operator re: potentially-dangerous condition.
  76    procedure Achtung(M : String) is
  77    begin
  78       for i in 1 .. M'Length loop
  79          To_Stderr(M(I));
  80       end loop;
  81       
  82       -- Emit LF
  83       To_Stderr(Character'Val(16#A#));
  84    end Achtung;
  85    
  86 end OS;