1--  GHDL Run Time (GRT) - VPI interface.
2--  Copyright (C) 2002 - 2014 Tristan Gingold & Felix Bertram
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16
17-- Description: VPI interface for GRT runtime
18--              the main purpose of this code is to interface with the
19--              Icarus Verilog Interactive (IVI) simulator GUI
20
21with System; use System;
22with Interfaces; use Interfaces;
23with Ada.Unchecked_Conversion;
24with Grt.Types; use Grt.Types;
25with Grt.Avhpi; use Grt.Avhpi;
26with Grt.Vcd;
27with Grt.Callbacks;
28
29package Grt.Vpi is
30
31   --  Properties, see vpi_user.h
32   vpiUndefined :     constant Integer := -1;
33   vpiType :          constant Integer :=  1;
34   vpiName :          constant Integer :=  2;
35   vpiFullName :      constant Integer :=  3;
36   vpiSize :          constant Integer :=  4;
37   vpiFile :          constant Integer :=  5;
38   vpiLineNo :        constant Integer :=  6;
39   vpiConstant :      constant Integer :=  7;
40
41   vpiDefName :       constant Integer :=  9;
42   vpiTimePrecision : constant Integer := 12;
43   vpiDefFile :       constant Integer := 15;
44
45   vpiScalar :        constant Integer := 17;
46   vpiVector :        constant Integer := 18;
47
48   -- object codes, see vpi_user.h
49   vpiModule :        constant Integer := 32;
50   vpiNet :           constant Integer := 36;
51   vpiPort :          constant Integer := 44;
52   --
53   vpiDirection :     constant Integer := 20;
54   vpiInput :         constant Integer :=  1;
55   vpiOutput :        constant Integer :=  2;
56   vpiInout :         constant Integer :=  3;
57   vpiMixedIO :       constant Integer :=  4;
58   vpiNoDirection :   constant Integer :=  5;
59
60   vpiParameter :     constant Integer := 41;
61   vpiLeftRange :     constant Integer := 79;
62   vpiRightRange :    constant Integer := 83;
63   vpiScope :         constant Integer := 84;
64   vpiInternalScope : constant Integer := 92;
65
66   vpiStop :          constant := 66;
67   vpiFinish :        constant := 67;
68   vpiReset :         constant := 68;
69
70   --  Additionnal constants.
71   vpiCallback :     constant Integer := 200;
72
73   -- codes for the format tag of the vpi_value structure
74   vpiBinStrVal:     constant Integer :=  1;
75   vpiOctStrVal:     constant Integer :=  2;
76   vpiDecStrVal:     constant Integer :=  3;
77   vpiHexStrVal:     constant Integer :=  4;
78   vpiScalarVal:     constant Integer :=  5;
79   vpiIntVal:        constant Integer :=  6;
80   vpiRealVal:       constant Integer :=  7;
81   vpiStringVal:     constant Integer :=  8;
82   vpiVectorVal:     constant Integer :=  9;
83   vpiStrengthVal:   constant Integer := 10;
84   vpiTimeVal:       constant Integer := 11;
85   vpiObjTypeVal:    constant Integer := 12;
86   vpiSuppressVal:   constant Integer := 13;
87
88   -- codes for type tag of vpi_time structure
89   vpiSimTime:       constant Integer :=  2;
90
91   -- codes for the reason tag of cb_data structure
92   cbValueChange       : constant := 1;
93   cbReadWriteSynch    : constant := 6;
94   cbReadOnlySynch     : constant := 7;
95   cbNextSimTime       : constant := 8;
96   cbAfterDelay        : constant := 9;
97   cbEndOfCompile      : constant := 10;
98   cbStartOfSimulation : constant := 11;
99   cbEndOfSimulation   : constant := 12;
100
101   --  Error types.
102   vpiCompile : constant := 1;
103   vpiPLI     : constant := 2;
104   vpiRun     : constant := 3;
105
106   --  Error severity levels.
107   vpiNotive   : constant := 1;
108   vpiWarning  : constant := 2;
109   vpiError    : constant := 3;
110   vpiSystem   : constant := 4;
111   vpiInternal : constant := 5;
112
113   type struct_vpiHandle (<>) is private;
114   type vpiHandle is access struct_vpiHandle;
115   pragma No_Strict_Aliasing (vpiHandle);
116
117   -- typedef struct t_vpi_time {
118   --   int type;
119   --   unsigned int high;
120   --   unsigned int low;
121   --   double real;
122   -- } s_vpi_time, *p_vpi_time;
123   type s_vpi_time is record
124      mType : Integer;
125      mHigh : Unsigned_32;
126      mLow :  Unsigned_32;
127      mReal : Long_Float;
128   end record;
129   pragma Convention (C, s_vpi_time);
130   type p_vpi_time is access s_vpi_time;
131
132   -- typedef struct t_vpi_value
133   -- { int format;
134   --   union
135   --   {       char*str;
136   --           int scalar;
137   --           int integer;
138   --           double real;
139   --           struct t_vpi_time *time;
140   --           struct t_vpi_vecval *vector;
141   --           struct t_vpi_strengthval *strength;
142   --           char*misc;
143   --   } value;
144   -- } s_vpi_value, *p_vpi_value;
145   type s_vpi_value (Format : Integer) is record
146      case Format is
147         when vpiBinStrVal
148           | vpiOctStrVal
149           | vpiDecStrVal
150           | vpiHexStrVal
151           | vpiStringVal =>
152            Str : Ghdl_C_String;
153         when vpiScalarVal =>
154            Scalar : Integer;
155         when vpiIntVal =>
156            Integer_m : Integer;
157         when vpiRealVal=>
158            Real_M : Ghdl_F64;
159            --when vpiTimeVal=>     mTime:     p_vpi_time;
160            --when vpiVectorVal=>   mVector:   p_vpi_vecval;
161            --when vpiStrengthVal=> mStrength: p_vpi_strengthval;
162         when others =>
163            null;
164         end case;
165   end record;
166   --  No use of convention C, as there is no direct equivalent in the norm.
167   type p_vpi_value is access s_vpi_value;
168
169   --typedef struct t_cb_data {
170   --      int reason;
171   --      int (*cb_rtn)(struct t_cb_data*cb);
172   --      vpiHandle obj;
173   --      p_vpi_time time;
174   --      p_vpi_value value;
175   --      int index;
176   --      char *user_data;
177   --} s_cb_data, *p_cb_data;
178   type s_cb_data;
179
180   type p_cb_data is access all s_cb_data;
181   pragma Convention (C, p_cb_data);
182   function To_p_cb_data is new Ada.Unchecked_Conversion
183     (Source => Address, Target => p_cb_data);
184
185   type cb_rtn_type is access function (Cb : p_cb_data) return Integer;
186   pragma Convention (C, cb_rtn_type);
187
188   type s_cb_data is record
189      Reason : Integer;
190      Cb_Rtn : cb_rtn_type;
191      Obj : vpiHandle;
192      Time : p_vpi_time;
193      Value : p_vpi_value;
194      Index : Integer;
195      User_Data : Address;
196   end record;
197   pragma Convention (C, s_cb_data);
198
199   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
200   function vpi_iterate (aType : Integer; Ref : vpiHandle) return vpiHandle;
201   pragma Export (C, vpi_iterate, "vpi_iterate");
202
203   -- int vpi_get(int property, vpiHandle ref)
204   function vpi_get (Property : Integer; Ref : vpiHandle) return Integer;
205   pragma Export (C, vpi_get, "vpi_get");
206
207   -- vpiHandle  vpi_scan(vpiHandle iter)
208   function vpi_scan (Iter : vpiHandle) return vpiHandle;
209   pragma Export (C, vpi_scan, "vpi_scan");
210
211   -- char *vpi_get_str(int property, vpiHandle ref)
212   function vpi_get_str (Property : Integer; Ref : vpiHandle)
213                       return Ghdl_C_String;
214   pragma Export (C, vpi_get_str, "vpi_get_str");
215
216   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
217   function vpi_handle (aType: Integer; Ref: vpiHandle)
218                       return vpiHandle;
219   pragma Export (C, vpi_handle, "vpi_handle");
220
221   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
222   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value);
223   pragma Export (C, vpi_get_value, "vpi_get_value");
224
225   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
226   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time);
227   pragma Export (C, vpi_get_time, "vpi_get_time");
228
229   -- vpiHandle vpi_register_cb(p_cb_data data)
230   function vpi_register_cb (Data : p_cb_data) return vpiHandle;
231   pragma Export (C, vpi_register_cb, "vpi_register_cb");
232
233-------------------------------------------------------------------------------
234-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
235-------------------------------------------------------------------------------
236
237   -- int vpi_free_object(vpiHandle ref)
238   function vpi_free_object(aRef: vpiHandle) return Integer;
239   pragma Export (C, vpi_free_object, "vpi_free_object");
240
241   type s_vpi_vlog_info is record
242      Argc : Integer;
243      Argv : System.Address;
244      Product : Ghdl_C_String;
245      Version : Ghdl_C_String;
246   end record;
247   pragma Convention (C, s_vpi_vlog_info);
248
249   type p_vpi_vlog_info is access all s_vpi_vlog_info;
250   pragma Convention (C, p_vpi_vlog_info);
251
252   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
253   function vpi_get_vlog_info(info : p_vpi_vlog_info) return Integer;
254   pragma Export (C, vpi_get_vlog_info, "vpi_get_vlog_info");
255
256
257   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
258   function vpi_handle_by_index(aRef: vpiHandle; aIndex: Integer)
259                               return vpiHandle;
260   pragma Export (C, vpi_handle_by_index, "vpi_handle_by_index");
261
262   function vpi_handle_by_name(Name : Ghdl_C_String; Scope : vpiHandle)
263                              return vpiHandle;
264   pragma Export (C, vpi_handle_by_name, "vpi_handle_by_name");
265
266   -- unsigned int vpi_mcd_close(unsigned int mcd)
267   function vpi_mcd_close (Mcd : Integer) return Integer;
268   pragma Export (C, vpi_mcd_close, "vpi_mcd_close");
269
270   -- char *vpi_mcd_name(unsigned int mcd)
271   function vpi_mcd_name (Mcd : Integer) return Integer;
272   pragma Export (C, vpi_mcd_name, "vpi_mcd_name");
273
274   -- unsigned int vpi_mcd_open(char *name)
275   function vpi_mcd_open (Name : Ghdl_C_String) return Integer;
276   pragma Export (C, vpi_mcd_open, "vpi_mcd_open");
277
278   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
279   --                         p_vpi_time when, int flags)
280   function vpi_put_value (aObj : vpiHandle;
281                           aValue : p_vpi_value;
282                           aWhen : p_vpi_time;
283                           aFlags : Integer)
284                          return vpiHandle;
285   pragma Export (C, vpi_put_value, "vpi_put_value");
286
287   -- vpiHandle vpi_register_systf(const struct t_vpi_systf_data*ss)
288   function vpi_register_systf (aSs : Address) return vpiHandle;
289   pragma Export (C, vpi_register_systf, "vpi_register_systf");
290
291   -- int vpi_remove_cb(vpiHandle ref)
292   function vpi_remove_cb (Ref : vpiHandle) return Integer;
293   pragma Export (C, vpi_remove_cb, "vpi_remove_cb");
294
295   --  typedef struct t_vpi_error_info
296   --  {
297   --      int32_t state;
298   --      int32_t level;
299   --      char *message;
300   --      char *product;
301   --      char *code;
302   --      char *file;
303   --      int32_t line;
304   --  } s_vpi_error_info, *p_vpi_error_info;
305   type s_vpi_error_info is record
306      State : Integer;
307      Level : Integer;
308      Message : Ghdl_C_String;
309      Product : Ghdl_C_String;
310      Code : Ghdl_C_String;
311      File : Ghdl_C_String;
312      Line : Integer;
313   end record;
314   type p_vpi_error_info is access all s_vpi_error_info;
315
316   function vpi_chk_error (Info : p_vpi_error_info) return Integer;
317   pragma Export (C, vpi_chk_error);
318
319   function vpi_control_np (Op : Integer; Status : Integer) return Integer;
320   pragma Export (C, vpi_control_np);
321
322-------------------------------------------------------------------------------
323-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
324-------------------------------------------------------------------------------
325
326   procedure Register;
327
328private
329   type struct_vpiHandle (mType : Integer) is record
330      case mType is
331         when vpiCallback =>
332            Cb : aliased s_cb_data;
333            Cb_Prev, Cb_Next : vpiHandle;
334            Cb_Wire : Grt.Vcd.Verilog_Wire_Info;
335            Cb_Handle : Callbacks.Callback_Handle;
336            --  Number of reference to the handler by the simulation kernel.
337            Cb_Refcnt : Natural;
338         when others =>
339            Ref : VhpiHandleT;
340      end case;
341   end record;
342end Grt.Vpi;
343