1--  GHDL Run Time (GRT) - VHPI implementation for Ada.
2--  Copyright (C) 2002 - 2014 Tristan Gingold
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--  As a special exception, if other files instantiate generics from this
18--  unit, or you link this unit with other files to produce an executable,
19--  this unit does not by itself cause the resulting executable to be
20--  covered by the GNU General Public License. This exception does not
21--  however invalidate any other reasons why the executable file might be
22--  covered by the GNU Public License.
23
24--  Ada oriented implementation of VHPI.
25--  This doesn't follow exactly what VHPI defined, but:
26--  * it should be easy to write a VHPI interface from this implementation.
27--  * this implementation is thread-safe (no global storage).
28--  * this implementation never allocates memory.
29with System; use System;
30with Grt.Types; use Grt.Types;
31with Grt.Rtis; use Grt.Rtis;
32with Grt.Rtis_Addr; use Grt.Rtis_Addr;
33
34package Grt.Avhpi is
35   --  Object Kinds.
36   type VhpiClassKindT is
37     (
38      VhpiUndefined,
39      VhpiAccessTypeDeclK,
40      VhpiAggregateK,
41      VhpiAliasDeclK,
42      VhpiAllLiteralK,
43      VhpiAllocatorK,
44      VhpiAnyCollectionK,
45      VhpiArchBodyK,
46      VhpiArgvK,
47      VhpiArrayTypeDeclK,
48      VhpiAssertStmtK,
49      VhpiAssocElemK,
50      VhpiAttrDeclK,
51      VhpiAttrSpecK,
52      VhpiBinaryExprK,
53      VhpiBitStringLiteralK,
54      VhpiBlockConfigK,
55      VhpiBlockStmtK,
56      VhpiBranchK,
57      VhpiCallbackK,
58      VhpiCaseStmtK,
59      VhpiCharLiteralK,
60      VhpiCompConfigK,
61      VhpiCompDeclK,
62      VhpiCompInstStmtK,
63      VhpiCondSigAssignStmtK,
64      VhpiCondWaveformK,
65      VhpiConfigDeclK,
66      VhpiConstDeclK,
67      VhpiConstParamDeclK,
68      VhpiConvFuncK,
69      VhpiDeRefObjK,
70      VhpiDisconnectSpecK,
71      VhpiDriverK,
72      VhpiDriverCollectionK,
73      VhpiElemAssocK,
74      VhpiElemDeclK,
75      VhpiEntityClassEntryK,
76      VhpiEntityDeclK,
77      VhpiEnumLiteralK,
78      VhpiEnumRangeK,
79      VhpiEnumTypeDeclK,
80      VhpiExitStmtK,
81      VhpiFileDeclK,
82      VhpiFileParamDeclK,
83      VhpiFileTypeDeclK,
84      VhpiFloatRangeK,
85      VhpiFloatTypeDeclK,
86      VhpiForGenerateK,
87      VhpiForLoopK,
88      VhpiForeignfK,
89      VhpiFuncCallK,
90      VhpiFuncDeclK,
91      VhpiGenericDeclK,
92      VhpiGroupDeclK,
93      VhpiGroupTempDeclK,
94      VhpiIfGenerateK,
95      VhpiIfStmtK,
96      VhpiInPortK,
97      VhpiIndexedNameK,
98      VhpiIntLiteralK,
99      VhpiIntRangeK,
100      VhpiIntTypeDeclK,
101      VhpiIteratorK,
102      VhpiLibraryDeclK,
103      VhpiLoopStmtK,
104      VhpiNextStmtK,
105      VhpiNullLiteralK,
106      VhpiNullStmtK,
107      VhpiOperatorK,
108      VhpiOthersLiteralK,
109      VhpiOutPortK,
110      VhpiPackBodyK,
111      VhpiPackDeclK,
112      VhpiPackInstK,
113      VhpiParamAttrNameK,
114      VhpiPhysLiteralK,
115      VhpiPhysRangeK,
116      VhpiPhysTypeDeclK,
117      VhpiPortDeclK,
118      VhpiProcCallStmtK,
119      VhpiProcDeclK,
120      VhpiProcessStmtK,
121      VhpiProtectedTypeK,
122      VhpiProtectedTypeBodyK,
123      VhpiProtectedTypeDeclK,
124      VhpiRealLiteralK,
125      VhpiRecordTypeDeclK,
126      VhpiReportStmtK,
127      VhpiReturnStmtK,
128      VhpiRootInstK,
129      VhpiSelectSigAssignStmtK,
130      VhpiSelectWaveformK,
131      VhpiSelectedNameK,
132      VhpiSigDeclK,
133      VhpiSigParamDeclK,
134      VhpiSimpAttrNameK,
135      VhpiSimpleSigAssignStmtK,
136      VhpiSliceNameK,
137      VhpiStringLiteralK,
138      VhpiSubpBodyK,
139      VhpiSubtypeDeclK,
140      VhpiSubtypeIndicK,
141      VhpiToolK,
142      VhpiTransactionK,
143      VhpiTypeConvK,
144      VhpiUnaryExprK,
145      VhpiUnitDeclK,
146      VhpiUserAttrNameK,
147      VhpiVarAssignStmtK,
148      VhpiVarDeclK,
149      VhpiVarParamDeclK,
150      VhpiWaitStmtK,
151      VhpiWaveformElemK,
152      VhpiWhileLoopK,
153
154      --  Iterator, but on a name.
155      AvhpiNameIteratorK,
156
157      --  Root scope that contains the top entity.  For vpi.
158      AvhpiRootScopeK,
159      AvhpiRootScopeIteratorK
160     );
161
162   type VhpiOneToOneT is
163     (
164      VhpiAbstractLiteral,
165      VhpiActual,
166      VhpiAllLiteral,
167      VhpiAttrDecl,
168      VhpiAttrSpec,
169      VhpiBaseType,
170      VhpiBaseUnit,
171      VhpiBasicSignal,
172      VhpiBlockConfig,
173      VhpiCaseExpr,
174      VhpiCondExpr,
175      VhpiConfigDecl,
176      VhpiConfigSpec,
177      VhpiConstraint,
178      VhpiContributor,
179      VhpiCurCallback,
180      VhpiCurEqProcess,
181      VhpiCurStackFrame,
182      VhpiDeRefObj,
183      VhpiDecl,
184      VhpiDesignUnit,
185      VhpiDownStack,
186      VhpiElemSubtype,
187      VhpiEntityAspect,
188      VhpiEntityDecl,
189      VhpiEqProcessStmt,
190      VhpiExpr,
191      VhpiFormal,
192      VhpiFuncDecl,
193      VhpiGroupTempDecl,
194      VhpiGuardExpr,
195      VhpiGuardSig,
196      VhpiImmRegion,
197      VhpiInPort,
198      VhpiInitExpr,
199      VhpiIterScheme,
200      VhpiLeftExpr,
201      VhpiLexicalScope,
202      VhpiLhsExpr,
203      VhpiLocal,
204      VhpiLogicalExpr,
205      VhpiName,
206      VhpiOperator,
207      VhpiOthersLiteral,
208      VhpiOutPort,
209      VhpiParamDecl,
210      VhpiParamExpr,
211      VhpiParent,
212      VhpiPhysLiteral,
213      VhpiPrefix,
214      VhpiPrimaryUnit,
215      VhpiProtectedTypeBody,
216      VhpiProtectedTypeDecl,
217      VhpiRejectTime,
218      VhpiReportExpr,
219      VhpiResolFunc,
220      VhpiReturnExpr,
221      VhpiReturnTypeMark,
222      VhpiRhsExpr,
223      VhpiRightExpr,
224      VhpiRootInst,
225      VhpiSelectExpr,
226      VhpiSeverityExpr,
227      VhpiSimpleName,
228      VhpiSubpBody,
229      VhpiSubpDecl,
230      VhpiSubtype,
231      VhpiSuffix,
232      VhpiTimeExpr,
233      VhpiTimeOutExpr,
234      VhpiTool,
235      VhpiTypeMark,
236      VhpiUnitDecl,
237      VhpiUpStack,
238      VhpiUpperRegion,
239      VhpiValExpr,
240      VhpiValSubtype
241     );
242
243   --  Methods used to traverse 1 to many relationships.
244   type VhpiOneToManyT is
245     (
246      VhpiAliasDecls,
247      VhpiArgvs,
248      VhpiAttrDecls,
249      VhpiAttrSpecs,
250      VhpiBasicSignals,
251      VhpiBlockStmts,
252      VhpiBranchs,
253      VhpiCallbacks,
254      VhpiChoices,
255      VhpiCompInstStmts,
256      VhpiCondExprs,
257      VhpiCondWaveforms,
258      VhpiConfigItems,
259      VhpiConfigSpecs,
260      VhpiConstDecls,
261      VhpiConstraints,
262      VhpiContributors,
263      VhpiCurRegions,
264      VhpiDecls,
265      VhpiDepUnits,
266      VhpiDesignUnits,
267      VhpiDrivenSigs,
268      VhpiDrivers,
269      VhpiElemAssocs,
270      VhpiEntityClassEntrys,
271      VhpiEntityDesignators,
272      VhpiEnumLiterals,
273      VhpiForeignfs,
274      VhpiGenericAssocs,
275      VhpiGenericDecls,
276      VhpiIndexExprs,
277      VhpiIndexedNames,
278      VhpiInternalRegions,
279      VhpiMembers,
280      VhpiPackInsts,
281      VhpiParamAssocs,
282      VhpiParamDecls,
283      VhpiPortAssocs,
284      VhpiPortDecls,
285      VhpiRecordElems,
286      VhpiSelectWaveforms,
287      VhpiSelectedNames,
288      VhpiSensitivitys,
289      VhpiSeqStmts,
290      VhpiSigAttrs,
291      VhpiSigDecls,
292      VhpiSigNames,
293      VhpiSignals,
294      VhpiSpecNames,
295      VhpiSpecs,
296      VhpiStmts,
297      VhpiTransactions,
298      VhpiTypeMarks,
299      VhpiUnitDecls,
300      VhpiUses,
301      VhpiVarDecls,
302      VhpiWaveformElems,
303      VhpiLibraryDecls
304     );
305
306   type VhpiIntPropertyT is
307     (
308      VhpiAccessP,
309      VhpiArgcP,
310      VhpiAttrKindP,
311      VhpiBaseIndexP,
312      VhpiBeginLineNoP,
313      VhpiEndLineNoP,
314      VhpiEntityClassP,
315      VhpiForeignKindP,
316      VhpiFrameLevelP,
317      VhpiGenerateIndexP,
318      VhpiIntValP,
319      VhpiIsAnonymousP,
320      VhpiIsBasicP,
321      VhpiIsCompositeP,
322      VhpiIsDefaultP,
323      VhpiIsDeferredP,
324      VhpiIsDiscreteP,
325      VhpiIsForcedP,
326      VhpiIsForeignP,
327      VhpiIsGuardedP,
328      VhpiIsImplicitDeclP,
329      VhpiIsInvalidP_DEPRECATED,
330      VhpiIsLocalP,
331      VhpiIsNamedP,
332      VhpiIsNullP,
333      VhpiIsOpenP,
334      VhpiIsPLIP,
335      VhpiIsPassiveP,
336      VhpiIsPostponedP,
337      VhpiIsProtectedTypeP,
338      VhpiIsPureP,
339      VhpiIsResolvedP,
340      VhpiIsScalarP,
341      VhpiIsSeqStmtP,
342      VhpiIsSharedP,
343      VhpiIsTransportP,
344      VhpiIsUnaffectedP,
345      VhpiIsUnconstrainedP,
346      VhpiIsUninstantiatedP,
347      VhpiIsUpP,
348      VhpiIsVitalP,
349      VhpiIteratorTypeP,
350      VhpiKindP,
351      VhpiLeftBoundP,
352      VhpiLevelP_DEPRECATED,
353      VhpiLineNoP,
354      VhpiLineOffsetP,
355      VhpiLoopIndexP,
356      VhpiModeP,
357      VhpiNumDimensionsP,
358      VhpiNumFieldsP_DEPRECATED,
359      VhpiNumGensP,
360      VhpiNumLiteralsP,
361      VhpiNumMembersP,
362      VhpiNumParamsP,
363      VhpiNumPortsP,
364      VhpiOpenModeP,
365      VhpiPhaseP,
366      VhpiPositionP,
367      VhpiPredefAttrP,
368      VhpiReasonP,
369      VhpiRightBoundP,
370      VhpiSigKindP,
371      VhpiSizeP,
372      VhpiStartLineNoP,
373      VhpiStateP,
374      VhpiStaticnessP,
375      VhpiVHDLversionP,
376      VhpiIdP,
377      VhpiCapabilitiesP
378     );
379
380   --  String properties.
381   type VhpiStrPropertyT is
382     (
383      VhpiCaseNameP,
384      VhpiCompNameP,
385      VhpiDefNameP,
386      VhpiFileNameP,
387      VhpiFullCaseNameP,
388      VhpiFullNameP,
389      VhpiKindStrP,
390      VhpiLabelNameP,
391      VhpiLibLogicalNameP,
392      VhpiLibPhysicalNameP,
393      VhpiLogicalNameP,
394      VhpiLoopLabelNameP,
395      VhpiNameP,
396      VhpiOpNameP,
397      VhpiStrValP,
398      VhpiToolVersionP,
399      VhpiUnitNameP
400     );
401
402   --  Possible Errors.
403   type AvhpiErrorT is
404     (
405      AvhpiErrorOk,
406      AvhpiErrorBadRel,
407      AvhpiErrorHandle,
408      AvhpiErrorNotImplemented,
409      AvhpiErrorIteratorEnd,
410      AvhpiErrorBadIndex
411     );
412
413   type VhpiHandleT is private;
414
415   --  A null handle.
416   Null_Handle : constant VhpiHandleT;
417
418   --  Get the root instance.
419   procedure Get_Root_Inst (Res : out VhpiHandleT);
420
421   --  For vpi: the scope that contains the root instance.
422   procedure Get_Root_Scope (Res : out VhpiHandleT);
423
424   --  Get the instanciated packages.
425   procedure Get_Package_Inst (Res : out VhpiHandleT);
426
427   procedure Vhpi_Handle (Rel : VhpiOneToOneT;
428                          Ref : VhpiHandleT;
429                          Res : out VhpiHandleT;
430                          Error : out AvhpiErrorT);
431
432   procedure Vhpi_Handle_By_Index (Rel : VhpiOneToManyT;
433                                   Ref : VhpiHandleT;
434                                   Index : Natural;
435                                   Res : out VhpiHandleT;
436                                   Error : out AvhpiErrorT);
437
438   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
439                            Ref : VhpiHandleT;
440                            Res : out VhpiHandleT;
441                            Error : out AvhpiErrorT);
442   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;
443                        Res : out VhpiHandleT;
444                        Error : out AvhpiErrorT);
445
446   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
447                           Obj : VhpiHandleT;
448                           Res : out String;
449                           Len : out Natural);
450
451   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
452                           Obj : VhpiHandleT;
453                           Res : out Ghdl_C_String);
454
455   subtype VhpiIntT is Ghdl_I32;
456
457   procedure Vhpi_Get (Property : VhpiIntPropertyT;
458                       Obj : VhpiHandleT;
459                       Res : out VhpiIntT;
460                       Error : out AvhpiErrorT);
461   procedure Vhpi_Get (Property : VhpiIntPropertyT;
462                       Obj : VhpiHandleT;
463                       Res : out Boolean;
464                       Error : out AvhpiErrorT);
465
466   --  Almost the same as Vhpi_Get_Str (VhpiName, OBJ), but there is not
467   --  indexes for generate stmt.
468   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String;
469
470   --  Return TRUE iff HDL1 and HDL2 are equivalent.
471   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)
472                                 return Boolean;
473
474--    procedure Vhpi_Handle_By_Simple_Name (Ref : VhpiHandleT;
475--                                          Res : out VhpiHandleT;
476--                                          Error : out AvhpiErrorT);
477
478   type VhpiEntityClassT is
479     (
480      VhpiErrorEC,
481      VhpiEntityEC,
482      VhpiArchitectureEC,
483      VhpiConfigurationEC,
484      VhpiProcedureEC,
485      VhpiFunctionEC,
486      VhpiPackageEC,
487      VhpiTypeEC,
488      VhpiSubtypeEC,
489      VhpiConstantEC,
490      VhpiSignalEC,
491      VhpiVariableEC,
492      VhpiComponentEC,
493      VhpiLabelEC,
494      VhpiLiteralEC,
495      VhpiUnitsEC,
496      VhpiFileEC,
497      VhpiGroupEC
498     );
499
500   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
501                                 return VhpiEntityClassT;
502
503   type VhpiModeT is
504     (
505      VhpiErrorMode,
506      VhpiInMode,
507      VhpiOutMode,
508      VhpiInoutMode,
509      VhpiBufferMode,
510      VhpiLinkageMode
511     );
512   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeT;
513
514   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access;
515
516   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address;
517
518   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context;
519
520   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT;
521
522   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)
523                           return AvhpiErrorT;
524private
525   type VhpiHandleT (Kind : VhpiClassKindT := VhpiUndefined) is record
526      --  Context.
527      Ctxt : Rti_Context;
528
529      case Kind is
530         when VhpiIteratorK
531           | AvhpiRootScopeIteratorK =>
532            Rel : VhpiOneToManyT;
533            It_Cur : Ghdl_Index_Type;
534            It2 : Ghdl_Index_Type;
535            Max2 : Ghdl_Index_Type;
536         when AvhpiNameIteratorK
537           | VhpiIndexedNameK =>
538            N_Addr : Address;
539            N_Type : Ghdl_Rti_Access;
540            N_Idx : Ghdl_Index_Type;
541            N_Obj : Ghdl_Rtin_Object_Acc;
542         when VhpiSigDeclK
543           | VhpiPortDeclK
544           | VhpiGenericDeclK
545           | VhpiConstDeclK =>
546            Obj : Ghdl_Rtin_Object_Acc;
547         when VhpiSubtypeIndicK
548           | VhpiSubtypeDeclK
549           | VhpiArrayTypeDeclK
550           | VhpiEnumTypeDeclK
551           | VhpiPhysTypeDeclK
552           | VhpiIntTypeDeclK =>
553            Atype : Ghdl_Rti_Access;
554         when VhpiCompInstStmtK =>
555            Inst : Ghdl_Rtin_Instance_Acc;
556         when VhpiIntRangeK
557           | VhpiEnumRangeK
558           | VhpiFloatRangeK
559           | VhpiPhysRangeK =>
560            Rng_Type : Ghdl_Rti_Access;
561            Rng_Addr : Ghdl_Range_Ptr;
562         when others =>
563            null;
564      end case;
565      --  Current Object.
566      --Obj : Ghdl_Rti_Access;
567   end record;
568
569   Null_Handle : constant VhpiHandleT := (Kind => VhpiUndefined,
570                                          Ctxt => (Base => Null_Address,
571                                                   Block => null));
572end Grt.Avhpi;
573