Re: Unifont static compiled and stack size...

[Micah Waddoups <micah.waddoups@gmail.com>]

On Monday, August 14, 2023 at 4:06:39 AM UTC-6, Jeffrey R.Carter wrote:
> On 2023-08-13 18:16, Micah Waddoups wrote: 
> > I tried to compile the Unifont hex file, converted with a script into variable Ada code, but it went on forever, gradually blowing up my memory. I used an .ads file and aimed for a static build, but I suspect I would have hit the stack size limit for executables if I succeeded
> As I understand it, the file in question is for code points 0 .. 16#FFFF#, with 
> a maximum of 32 bytes per code point. A straightforward representation of this is 
> 
> package Unifont is 
> type Byte is mod 2 ** 8 with Size => 8; 
> 
> type Line is array (1 .. 2) of Byte with Size => 16; 
> 
> type Bitmap is array (1 .. 16) of Line with Size => 256; 
> 
> function Width_8 (Map : in Bitmap) return Boolean is 
> (for all L of Map => L (2) = 0); 
> 
> type Code_Point is mod 16#FFFF# + 1; 
> 
> type Font_Map is array (Code_Point) of Bitmap with Size => 2 ** 24; 
> 
> Font : constant Font_Map := (others => (others => (others => 0) ) ); 
> end Unifont; 
> 
> Font will occupy 2 MB. 
> 
> We can test this with 
> 
> with Ada.Text_IO; 
> with Unifont; 
> 
> procedure Unifont_Test is 
> -- Empty 
> begin -- Unifont_Test 
> Ada.Text_IO.Put_Line (Item => Unifont.Font (0) (1) (1)'Image); 
> end Unifont_Test; 
> 
> and see what happens: 
> 
> $ gnatmake -m -j0 -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont_test.adb 
> x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check 
> unifont_test.adb 
> x86_64-linux-gnu-gcc-12 -c -gnat12 -gnatan -gnato2 -O2 -fstack-check unifont.ads 
> x86_64-linux-gnu-gnatbind-12 -x unifont_test.ali 
> x86_64-linux-gnu-gnatlink-12 unifont_test.ali -O2 -fstack-check 
> $ ./unifont_test 
> 0 
> 
> so this representation seems to be workable. It should be trivial to write a 
> program to read the file and produce the real array aggregate for Font. 
> 
> -- 
> Jeff Carter 
> "I wave my private parts at your aunties." 
> Monty Python & the Holy Grail 
> 13

Thank you all for replying while I was working away from home.  

Jeff, you missed a digit - it's five F's  16#FFFFF# because that is as high as Unifont goes in my copy of the hex file.  Of course the technique should be able to go higher if that changes, but Unicode is pretty exhaustive as it is and Unifont is meant to keep up with every version and addition to the Unicode code points, so I sincerely hope for no trouble for a while yet.  I checked, and it seem my system has about 8 megabytes as the stack size limit, so with the ranges left empty it is not 32 megabytes, but still pretty big.  Good looking code, by the way.  Very easy to read.  Mine is appended, but it was really a quick hack of a job with too little sleep.  I probably should have done a Z Shell script (maybe take 20 seconds?), but I thought the two second efficiency of writing a compiled composer was worth it ...somehow...

Niklas, I think you have the most actionable suggestions for me to test.  Thank you.

Dmitry, Thank you for trying to understand.  Since both methods of rendering fonts made available by GTK, I consider it GTK providing it.  I don't want any more imports than I can provide easily with a static compile or as accompanying dynamic modules (reason hereafter mentioned), and Licensing needs to be the most permissive possible.  The idea is to be able to create a shell or a variety of other programs using my library as a very focused kind of interface that supports more characters and more languages that my other most available options, so the font is important, even if I'm just drawing to the Linux frame buffer.  I meant a transfer of code from one platform to another.  Sometimes in a graphical window that acts like a text interface window, sometimes on the linux frame buffer, and in the extreme case some times on the text console without any particular font support.  The main collection of code is supposed to support all that with very limited modification  to say transfer from Linux to macOS or MS Windows?  I hope this s answered your questions.

Oh, and to all, I have already abandon the idea of using Boolean with Pack, since it no longer seems to work and was a bit *too* verbose

pragma Ada_2012;
pragma Wide_Character_Encoding (UTF8);


with Ada.Text_IO;
use Ada.Text_IO;


procedure Unifont_Hex_To_Ada is


   Target_Name: String := "./src/unifont.ads";
   Source_Name: String := "unifont_all-15.0.06.hex";
   Target: aliased File_Type;
   Source: aliased File_Type;
   Buffer: aliased String (1 .. 96) := (others=>' ');
   Index, F: Positive := 1;
   Previous, Current, Length, L: Natural := 0;
   Finished: aliased Boolean:= False;
   subtype Hex_Character is Character range '0' .. 'f'
     with Static_Predicate=> (Hex_Character in '0' .. '9') or (Hex_Character in 'A' .. 'F') or (Hex_Character in 'a' .. 'f');
   type Byte is mod 2 **8;
   type Bit is mod 8;
   --type Bytes is array (Natural range <>) of aliased Byte;
   Bit_X: Bit := 0;
   Byte_X: Byte := 0;
   function Find (Item: Character)
                  return Natural
   is
   begin
      for
        N in Buffer'Range
      loop
         if Item = Buffer(N)
         then return N;
         end if;
      end loop;
      return 0;
   end Find;
   function Enum return Natural
   is
      First: Positive := 1;
      Last: Natural := Integer'Max ((Find (':') -1), 0);
   begin
      return R: Natural
      do
         R := Natural'Value ("16#" &Buffer (First..Last) &'#');
      end return;
   end Enum;
   procedure Next_Byte
   is
      S: String renames Buffer (F .. L);
   begin
      loop
         if
           (Index in S'Range) and (Index +1 in S'Range)
         then
            exit;
         else
            Index := S'First;
            if
              (Index in S'Range) and (Index +1 in S'Range)
            then
               exit;
            else
               raise Program_Error with "Next_Byte-> Somehow there are no Hex codes in string... line " &Current'Img &", string => " & S;
            end if;
         end if;
      end loop;
      if
        S (Index) in Hex_Character
        and
          S (Index +1) in Hex_Character
      then
         Byte_X := Byte'Value ("16#" &S (Index..Index +1) &"#");
         Bit_X := 0;
         Index := Index +2;
      end if;
   end Next_Byte;
   procedure Next_Line
   is
   begin
      for
        N in Buffer'First .. Length
      loop
         Buffer (N):= ' ';
      end loop;
      begin
         Get_Line (Source, Buffer, Length);
      exception
         when others => null;
      end;
      if
        Length < 32
      then
         Put_Line (Standard_Error, "empty or incomplete line at code point " &Natural'Image (Enum) &" (" &Current'Img &" + 1)");
      else
         Previous:= Current;
         Current:= Enum;
         if
           ((Previous + 1) = Current)
           or else (Current = 0)
         then
            F:= Find (':') +1;
            L:= Length;
            Next_Byte;
         else
            F:= Find (':') +1;
            L:= Length;
            Next_Byte;
            Put_Line (Standard_Error, " Missing character range in Source: " &Previous'Img &" .. " &Current'Img);
         end if;
      end if;
   end Next_Line;


   subtype Index_Type is Natural range 0 .. 16#FFFFF#;
   subtype Y_Type is Integer range 1 .. 16;
   subtype X_Type is Integer range 1 .. 16;
   type Size_Type is
      record
         Y: aliased Y_Type:= Y_Type'First;
         X: aliased X_Type:= X_Type'First;
      end record;
   type Size_Set_Type is array (Index_Type) of aliased Size_Type;
   type Size_Set_Access is access all Size_Set_Type;
   function Dot return String is
   begin
      if
        1 = ((Byte_X / 2 **(7 - Natural(Bit_X))) and 1)
      then
         if
           Bit_X = Bit'Last
         then
            Next_Byte;
         else
            Bit_X := Bit_X +1;
         end if;
         return "True";
      else
         if
           Bit_X = Bit'Last
         then
            Next_Byte;
         else
            Bit_X := Bit_X +1;
         end if;
         return "False";
      end if;
   end Dot;
   Cache_Size: Size_Set_Access := new Size_Set_Type'(others => (16, 8));
   Size: Size_Set_Type renames Cache_Size.all;

begin

   begin
      Open (Source, In_File, Source_Name);
   exception
      when others =>
         raise Status_Error with " Source File not found: " &Source_Name;
   end;

   begin
      Create (Target, Out_File, Target_Name);
   exception
      when others =>
         Open (Target, Out_File, Target_Name);
   end;


   begin
      Put_Line (Target, "pragma Ada_2012;");
      Put_Line (Target, "pragma Wide_Character_Encoding (UTF8);");
      New_Line (Target, 2);
      --Put_Line (Target, "with ada.unchecked_conversion;");
      --New_Line (Target, 2);
      Put_Line (Target, "package Unifont is");
      Put_Line (Target, "subtype Index_Type is Wide_Wide_Character range Wide_Wide_Character'Val (0) .. Wide_Wide_Character'Val (16#FFFFF#);");
      Put_Line (Target, "subtype Y_Type is Integer range 1 .. 16;");
      Put_Line (Target, "subtype X_Type is Integer range 1 .. 16;");
      Put_Line (Target, "type Size_Type is record Y: aliased Y_Type := 1; X: aliased X_Type := 1; end record;");
      Put_Line (Target, "type Size_Set_Type is array (Index_Type) of aliased Size_Type;");
      Put_Line (Target, "type Glyph_Type is array (Y_Type, X_Type) of Boolean");
      Put_Line (Target, "with Pack, Size=> 256;");
      Put_Line (Target, "type Glyph_Set_Type is array (Index_Type) of aliased Glyph_Type;");
      Put_Line (Target, "Glyph: constant Glyph_Set_Type :=");
      Put (Target, "(");
      loop
         exit when End_Of_File (Source);
         Next_Line; -- Load Next Line and extract Code Point index
         if
           Length > 64
         then
            Size (Current) := (16, 16);
            Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
            Put (Target, "(");
            for Y in 1 .. 16
            loop
               Put_Line (Target, Y'Img &" =>");
               Put (Target, "(");
               for X in 1 .. 16
               loop
                  if
                    X < 16
                  then
                     Put (Target, Dot &", ");
                  else
                     Put (Target, Dot &")");
                  end if;
               end loop;
               if
                 Y < 16
               then
                  Put_Line (Target, ",");
               else
                  Put_Line (Target, "),");
               end if;
            end loop;
         elsif
           Length > 32
         then
            Put_Line (Target, "Wide_Wide_Character'Val (" &Integer'Image(Current) &") =>");
            Put (Target, "(");
            for Y in 1 .. 16
            loop
               Put_Line (Target, Y'Img &" =>");
               Put (Target, "(");
               for X in 1 .. 8
               loop
                  Put (Target, Dot &", ");
               end loop;
               for X in 9 .. 16
               loop
                  if
                    X < 16
                  then
                     Put (Target, "False, ");
                  else
                     Put (Target, "False)");
                  end if;
               end loop;
               if
                 Y < 16
               then
                  Put_Line (Target, ",");
               else
                  Put_Line (Target, "),");
               end if;
            end loop;
         end if;
      end loop;
      Close (Source);
      Put_Line (Target, "others => (others => (others => False)));");
      New_Line (Target);
      Put_Line (Target, "Size: constant Size_Set_Type :=");
      Put (Target, "(");
      for N in Index_Type'Range
      loop
         Put (Target, "Wide_Wide_Character'Val (" &Integer'Image(N) &") =>");
         Put (Target, "(" &Integer'Image(Size(N).Y) &", " &Integer'Image(Size(N).X) &")");
         if
           N < Index_Type'Last
         then
            Put_Line (Target, ",");
         else
            Put_Line (Target, ");");
         end if;
      end loop;
      Put_Line (Target, "end Unifont;");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Put_Line (Target, "");
      Close (Target);
   end;
end Unifont_Hex_To_Ada;