gcc/ada/s-tfsetr-vxworks.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --                     S Y S T E M . T R A C E S . S E N D                  --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --           Copyright (C) 2001-2009, Free Software Foundation, Inc.        --
  10 --                                                                          --
  11 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  This version is for VxWorks targets
  33
  34 --  Trace information is sent to WindView using the wvEvent function
  35
  36 --  Note that wvEvent is from the VxWorks API
  37
  38 --  When adding a new event, just give an Id to then event, and then modify
  39 --  the WindView events database.
  40
  41 --  Refer to WindView User's Guide for more details on how to add new events
  42 --  to the events database.
  43
  44 ----------------
  45 -- Send_Trace --
  46 ----------------
  47
  48 --  This procedure formats the string, maps the event Id to an Id
  49 --  recognized by WindView, and send the event using wvEvent
  50
  51 separate (System.Traces.Format)
  52 procedure Send_Trace (Id : Trace_T; Info : String) is
  53
  54    procedure Wv_Event
  55      (Id : Integer;
  56       Buffer : System.Address;
  57       Size : Integer);
  58    pragma Import (C, Wv_Event, "wvEvent");
  59
  60    Info_Trace : String_Trace;
  61    Id_Event   : Integer;
  62
  63 begin
  64    Info_Trace := Format_Trace (Info);
  65
  66    case Id is
  67       when M_Accept_Complete => Id_Event := 30000;
  68       when M_Select_Else     => Id_Event := 30001;
  69       when M_RDV_Complete    => Id_Event := 30002;
  70       when M_Call_Complete   => Id_Event := 30003;
  71       when M_Delay           => Id_Event := 30004;
  72       when E_Kill            => Id_Event := 30005;
  73       when E_Missed          => Id_Event := 30006;
  74       when E_Timeout         => Id_Event := 30007;
  75
  76       when W_Call            => Id_Event := 30010;
  77       when W_Accept          => Id_Event := 30011;
  78       when W_Select          => Id_Event := 30012;
  79       when W_Completion      => Id_Event := 30013;
  80       when W_Delay           => Id_Event := 30014;
  81       when WT_Select         => Id_Event := 30015;
  82       when WT_Call           => Id_Event := 30016;
  83       when WT_Completion     => Id_Event := 30017;
  84       when WU_Delay          => Id_Event := 30018;
  85
  86       when PO_Call           => Id_Event := 30020;
  87       when POT_Call          => Id_Event := 30021;
  88       when PO_Run            => Id_Event := 30022;
  89       when PO_Lock           => Id_Event := 30023;
  90       when PO_Unlock         => Id_Event := 30024;
  91       when PO_Done           => Id_Event := 30025;
  92
  93       when T_Create          => Id_Event := 30030;
  94       when T_Activate        => Id_Event := 30031;
  95       when T_Abort           => Id_Event := 30032;
  96       when T_Terminate       => Id_Event := 30033;
  97
  98       --  Unrecognized events are given the special Id_Event value 29999
  99
 100       when others            => Id_Event := 29999;
 101
 102    end case;
 103
 104    Wv_Event (Id_Event, Info_Trace'Address, Max_Size);
 105 end Send_Trace;