aboutsummaryrefslogtreecommitdiffstats
path: root/tmk_core/common/util.c
blob: 7e0d542993a955be815c2dbb495793f40ed68dd1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
/*
Copyright 2011 Jun Wako <wakojun@gmail.com>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT 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
along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include "util.h"

// bit population - return number of on-bit
uint8_t bitpop(uint8_t bits)
{
    uint8_t c;
    for (c = 0; bits; c++)
        bits &= bits - 1;
    return c;
/*
    const uint8_t bit_count[] = { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4 };
    return bit_count[bits>>4] + bit_count[bits&0x0F]
*/
}

uint8_t bitpop16(uint16_t bits)
{
    uint8_t c;
    for (c = 0; bits; c++)
        bits &= bits - 1;
    return c;
}

uint8_t bitpop32(uint32_t bits)
{
    uint8_t c;
    for (c = 0; bits; c++)
        bits &= bits - 1;
    return c;
}

// most significant on-bit - return highest location of on-bit
// NOTE: return 0 when bit0 is on or all bits are off
uint8_t biton(uint8_t bits)
{
    uint8_t n = 0;
    if (bits >> 4) { bits >>= 4; n += 4;}
    if (bits >> 2) { bits >>= 2; n += 2;}
    if (bits >> 1) { bits >>= 1; n += 1;}
    return n;
}

uint8_t biton16(uint16_t bits)
{
    uint8_t n = 0;
    if (bits >> 8) { bits >>= 8; n += 8;}
    if (bits >> 4) { bits >>= 4; n += 4;}
    if (bits >> 2) { bits >>= 2; n += 2;}
    if (bits >> 1) { bits >>= 1; n += 1;}
    return n;
}

uint8_t biton32(uint32_t bits)
{
    uint8_t n = 0;
    if (bits >>16) { bits >>=16; n +=16;}
    if (bits >> 8) { bits >>= 8; n += 8;}
    if (bits >> 4) { bits >>= 4; n += 4;}
    if (bits >> 2) { bits >>= 2; n += 2;}
    if (bits >> 1) { bits >>= 1; n += 1;}
    return n;
}



uint8_t bitrev(uint8_t bits)
{
    bits = (bits & 0x0f)<<4 | (bits & 0xf0)>>4;
    bits = (bits & 0b00110011)<<2 | (bits & 0b11001100)>>2;
    bits = (bits & 0b01010101)<<1 | (bits & 0b10101010)>>1;
    return bits;
}

uint16_t bitrev16(uint16_t bits)
{
    bits = bitrev(bits & 0x00ff)<<8 | bitrev((bits & 0xff00)>>8);
    return bits;
}

uint32_t bitrev32(uint32_t bits)
{
    bits = (uint32_t)bitrev16(bits & 0x0000ffff)<<16 | bitrev16((bits & 0xffff0000)>>16);
    return bits;
}
; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation; either version 2, or (at your option) any later -- version. -- -- GHDL is distributed in the hope that it will be useful, but WITHOUT 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 -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Command_Line; with Ada.Command_Line.Response_File; with Simple_IO; with Version; with Bug; with Types; use Types; with Errorout; use Errorout; with Errorout.Console; with Default_Paths; package body Ghdlmain is procedure Init (Cmd : in out Command_Type) is pragma Unreferenced (Cmd); begin null; end Init; procedure Decode_Option (Cmd : in out Command_Type; Option : String; Arg : String; Res : out Option_State) is pragma Unreferenced (Cmd); pragma Unreferenced (Option); pragma Unreferenced (Arg); begin Res := Option_Unknown; end Decode_Option; procedure Disp_Long_Help (Cmd : Command_Type) is pragma Unreferenced (Cmd); use Simple_IO; begin Put_Line ("This command does not accept options."); end Disp_Long_Help; First_Cmd : Command_Acc := null; Last_Cmd : Command_Acc := null; procedure Register_Command (Cmd : Command_Acc) is begin if First_Cmd = null then First_Cmd := Cmd; else Last_Cmd.Next := Cmd; end if; Last_Cmd := Cmd; end Register_Command; -- Find the command. function Find_Command (Action : String) return Command_Acc is Cmd : Command_Acc; begin Cmd := First_Cmd; while Cmd /= null loop if Decode_Command (Cmd.all, Action) then return Cmd; end if; Cmd := Cmd.Next; end loop; return null; end Find_Command; function Decode_Command (Cmd : Command_Str_Type; Name : String) return Boolean is begin return Name = Cmd.Cmd_Str.all; end Decode_Command; function Get_Short_Help (Cmd : Command_Str_Type) return String is begin return Cmd.Help_Str.all; end Get_Short_Help; procedure Perform_Action (Cmd : Command_Str_Disp; Args : Argument_List) is pragma Unreferenced (Args); begin Simple_IO.Put_Line (Cmd.Disp.all); end Perform_Action; -- Command help. type Command_Help is new Command_Type with null record; function Decode_Command (Cmd : Command_Help; Name : String) return Boolean; procedure Decode_Option (Cmd : in out Command_Help; Option : String; Arg : String; Res : out Option_State); function Get_Short_Help (Cmd : Command_Help) return String; procedure Perform_Action (Cmd : Command_Help; Args : Argument_List); function Decode_Command (Cmd : Command_Help; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "-h" or else Name = "--help"; end Decode_Command; procedure Decode_Option (Cmd : in out Command_Help; Option : String; Arg : String; Res : out Option_State) is pragma Unreferenced (Cmd); pragma Unreferenced (Option); pragma Unreferenced (Arg); begin Res := Option_End; end Decode_Option; function Get_Short_Help (Cmd : Command_Help) return String is pragma Unreferenced (Cmd); begin return "-h or --help [CMD] Disp this help or [help on CMD]"; end Get_Short_Help; procedure Perform_Action (Cmd : Command_Help; Args : Argument_List) is pragma Unreferenced (Cmd); use Simple_IO; use Ada.Command_Line; C : Command_Acc; begin if Args'Length = 0 then Put_Line ("usage: " & Command_Name & " COMMAND [OPTIONS] ..."); Put_Line ("COMMAND is one of:"); C := First_Cmd; while C /= null loop declare S : constant String := Get_Short_Help (C.all); begin if S'Length > 1 and then S (S'First) /= '!' then Put_Line (S); end if; end; C := C.Next; end loop; New_Line; Put_Line ("To display the options of a GHDL program,"); Put_Line (" run your program with the --help option."); Put_Line ("Also see --options-help for analyzer options."); New_Line; Put_Line ("Please, refer to the GHDL manual for more information."); Put_Line ("Report issues on https://github.com/ghdl/ghdl"); elsif Args'Length = 1 then C := Find_Command (Args (1).all); if C = null then Error ("Command '" & Args (1).all & "' is unknown."); raise Option_Error; end if; Put_Line (Get_Short_Help (C.all)); Disp_Long_Help (C.all); else Error ("Command '--help' accepts at most one argument."); raise Option_Error; end if; end Perform_Action; -- Command options help. type Command_Option_Help is new Command_Type with null record; function Decode_Command (Cmd : Command_Option_Help; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Option_Help) return String; procedure Perform_Action (Cmd : Command_Option_Help; Args : Argument_List); function Decode_Command (Cmd : Command_Option_Help; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--options-help"; end Decode_Command; function Get_Short_Help (Cmd : Command_Option_Help) return String is pragma Unreferenced (Cmd); begin return "--options-help Disp help for analyzer options"; end Get_Short_Help; procedure Perform_Action (Cmd : Command_Option_Help; Args : Argument_List) is pragma Unreferenced (Cmd); begin if Args'Length /= 0 then Error ("warning: command '--option-help' does not accept any argument"); end if; Options.Disp_Options_Help; end Perform_Action; -- Command Version type Command_Version is new Command_Type with null record; function Decode_Command (Cmd : Command_Version; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Version) return String; procedure Perform_Action (Cmd : Command_Version; Args : Argument_List); function Decode_Command (Cmd : Command_Version; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "-v" or Name = "--version"; end Decode_Command; function Get_Short_Help (Cmd : Command_Version) return String is pragma Unreferenced (Cmd); begin return "-v or --version Disp ghdl version"; end Get_Short_Help; procedure Perform_Action (Cmd : Command_Version; Args : Argument_List) is pragma Unreferenced (Cmd); use Simple_IO; begin Put ("GHDL "); Put (Version.Ghdl_Ver); Put (' '); Put_Line (Version.Ghdl_Release); Put_Line (" Compiled with " & Bug.Get_Gnat_Version); if Version_String /= null then Put (" "); Put (Version_String.all); end if; New_Line; Put_Line ("Written by Tristan Gingold."); New_Line; -- Display copyright. Assume 80 cols terminal. Put_Line ("Copyright (C) 2003 - 2019 Tristan Gingold."); Put_Line ("GHDL is free software, covered by the " & "GNU General Public License. There is NO"); Put_Line ("warranty; not even for MERCHANTABILITY or" & " FITNESS FOR A PARTICULAR PURPOSE."); if Args'Length /= 0 then Error ("warning: command '--version' does not accept any argument"); end if; end Perform_Action; -- Disp MSG on the standard output with the command name. procedure Error (Msg : String)is begin Report_Msg (Msgid_Error, Option, No_Source_Coord, Msg); end Error; procedure Warning (Msg : String) is begin Report_Msg (Msgid_Warning, Option, No_Source_Coord, Msg); end Warning; function Index (Str : String; C : Character) return Natural is begin for I in Str'Range loop if Str (I) = C then return I; end if; end loop; return 0; end Index; -- Decode command CMD_NAME and options from ARGS. -- Return the index of the first non-option argument. procedure Decode_Command_Options (Cmd_Name : String; Cmd : out Command_Acc; Args : Argument_List; First_Arg : out Natural) is Arg_Index : Natural; begin -- Decode command. Cmd := Find_Command (Cmd_Name); if Cmd = null then Error ("unknown command '" & Cmd_Name & "', try --help"); raise Option_Error; end if; Init (Cmd.all); -- Decode options. First_Arg := 0; Arg_Index := Args'First; while Arg_Index <= Args'Last loop declare Arg : constant String_Access := Args (Arg_Index); Res : Option_State; begin if Arg (1) = '-' then -- Argument is an option. if First_Arg > 0 then Error ("options after file"); raise Option_Error; end if; Decode_Option (Cmd.all, Arg.all, "", Res); case Res is when Option_Unknown => Error ("unknown option '" & Arg.all & "' for command '" & Cmd_Name & "'"); raise Option_Error; when Option_Err => raise Option_Error; when Option_Ok => Arg_Index := Arg_Index + 1; when Option_Arg_Req => if Arg_Index + 1 > Args'Last then Error ("option '" & Arg.all & "' requires an argument"); raise Option_Error; end if; Decode_Option (Cmd.all, Arg.all, Args (Arg_Index + 1).all, Res); if Res /= Option_Arg then raise Program_Error; end if; Arg_Index := Arg_Index + 2; when Option_Arg => raise Program_Error; when Option_End => First_Arg := Arg_Index; exit; end case; else First_Arg := Arg_Index; exit; end if; end; end loop; if First_Arg = 0 then First_Arg := Args'Last + 1; end if; end Decode_Command_Options; Is_Windows : constant Boolean := Default_Paths.Shared_Library_Extension = ".dll"; function Convert_Path_To_Unix (Path : String) return String is begin if Is_Windows then declare Res : String := Path; begin -- Convert path separators. for I in Res'Range loop if Res (I) = '\' then Res (I) := '/'; end if; end loop; -- Convert C: to /C/ if Res'Length > 2 and then (Res (Res'First) in 'a' .. 'z' or else Res (Res'First) in 'A' .. 'Z') and then Res (Res'First + 1) = ':' then Res (Res'First + 1) := '/'; return '/' & Res; end if; return Res; end; else return Path; end if; end Convert_Path_To_Unix; procedure Main is use Ada.Command_Line; Args : String_List_Access; Arg_Index : Natural; begin -- Set program name for error message. Errorout.Console.Set_Program_Name (Command_Name); Errorout.Console.Install_Handler; -- Handle case of no argument if Argument_Count = 0 then Error ("missing command, try " & Command_Name & " --help"); raise Option_Error; end if; Args := new String_List (1 .. Argument_Count); for I in Args'Range loop Args (I) := new String'(Argument (I)); pragma Assert (Args (I)'First = 1); if Args (I)'Last < 1 then Error ("empty argument on the command line (#" & Natural'Image (I) & ")"); raise Option_Error; end if; end loop; -- Expand response files Arg_Index := 1; while Arg_Index <= Args'Last loop if Args (Arg_Index).all (1) = '@' then declare Rsp_Arg : constant String_Access := Args (Arg_Index); Rsp_File : constant String := Rsp_Arg (2 .. Rsp_Arg'Last); begin -- Need a second declare block so that the exception handler -- can use Rsp_File. declare Exp_Args : constant GNAT.OS_Lib.Argument_List := Response_File.Arguments_From (Rsp_File); Exp_Length : constant Natural := Exp_Args'Length; New_Args : String_List_Access; begin New_Args := new String_List (1 .. Args'Last + Exp_Length - 1); -- Copy arguments from the response file. New_Args (1 .. Arg_Index - 1) := Args (1 .. Arg_Index - 1); New_Args (Arg_Index .. Arg_Index + Exp_Length - 1) := Exp_Args; New_Args (Arg_Index + Exp_Length .. New_Args'Last) := Args (Arg_Index + 1 .. Args'Last); -- Free array. Note: Free deallocates both the array and -- its elements. But we need to keep the elements. Args.all := (others => null); Args (Arg_Index) := Rsp_Arg; Free (Args); Args := New_Args; Arg_Index := Arg_Index + Exp_Length; end; exception when Response_File.File_Does_Not_Exist => Error ("cannot open response file '" & Rsp_File & "'"); raise Option_Error; end; else Arg_Index := Arg_Index + 1; end if; end loop; declare Cmd : Command_Acc; First_Arg : Natural; begin Decode_Command_Options (Args (1).all, Cmd, Args (2 .. Args'Last), First_Arg); -- Set before running the action, so that it can be changed. Set_Exit_Status (Success); declare Cmd_Args : Argument_List (1 .. Args'Last - First_Arg + 1); begin for I in Cmd_Args'Range loop Cmd_Args (I) := Args (First_Arg + I - 1); end loop; Perform_Action (Cmd.all, Cmd_Args); end; end; -- Free args. This frees both the array and the strings. Free (Args); --if Flags.Dump_Stats then -- Name_Table.Disp_Stats; -- Iirs.Disp_Stats; --end if; exception when Option_Error | Compile_Error | Errorout.Compilation_Error => Set_Exit_Status (Failure); when Exec_Error => Set_Exit_Status (3); when E: others => Bug.Disp_Bug_Box (E); Set_Exit_Status (2); end Main; procedure Register_Commands is begin Register_Command (new Command_Help); Register_Command (new Command_Version); Register_Command (new Command_Option_Help); end Register_Commands; end Ghdlmain;