--  GHDL Run Time (GRT) - VHPI implementation for Ada.--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold----  GHDL 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, 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.--  Ada oriented implementation of VHPI.--  This doesn't follow exactly what VHPI defined, but:--  * it should be easy to write a VHPI interface from this implementation.--  * this implementation is thread-safe (no global storage).--  * this implementation never allocates memory.with System; use System;with Grt.Types; use Grt.Types;with Grt.Rtis; use Grt.Rtis;with Grt.Rtis_Addr; use Grt.Rtis_Addr;package Grt.Avhpi is   --  Object Kinds.   type VhpiClassKindT is     (      VhpiUndefined,      VhpiAccessTypeDeclK,      VhpiAggregateK,      VhpiAliasDeclK,      VhpiAllLiteralK,      VhpiAllocatorK,      VhpiAnyCollectionK,      VhpiArchBodyK,      VhpiArgvK,      VhpiArrayTypeDeclK,      VhpiAssertStmtK,      VhpiAssocElemK,      VhpiAttrDeclK,      VhpiAttrSpecK,      VhpiBinaryExprK,      VhpiBitStringLiteralK,      VhpiBlockConfigK,      VhpiBlockStmtK,      VhpiBranchK,      VhpiCallbackK,      VhpiCaseStmtK,      VhpiCharLiteralK,      VhpiCompConfigK,      VhpiCompDeclK,      VhpiCompInstStmtK,      VhpiCondSigAssignStmtK,      VhpiCondWaveformK,      VhpiConfigDeclK,      VhpiConstDeclK,      VhpiConstParamDeclK,      VhpiConvFuncK,      VhpiDeRefObjK,      VhpiDisconnectSpecK,      VhpiDriverK,      VhpiDriverCollectionK,      VhpiElemAssocK,      VhpiElemDeclK,      VhpiEntityClassEntryK,      VhpiEntityDeclK,      VhpiEnumLiteralK,      VhpiEnumRangeK,      VhpiEnumTypeDeclK,      VhpiExitStmtK,      VhpiFileDeclK,      VhpiFileParamDeclK,      VhpiFileTypeDeclK,      VhpiFloatRangeK,      VhpiFloatTypeDeclK,      VhpiForGenerateK,      VhpiForLoopK,      VhpiForeignfK,      VhpiFuncCallK,      VhpiFuncDeclK,      VhpiGenericDeclK,      VhpiGroupDeclK,      VhpiGroupTempDeclK,      VhpiIfGenerateK,      VhpiIfStmtK,      VhpiInPortK,      VhpiIndexedNameK,      VhpiIntLiteralK,      VhpiIntRangeK,      VhpiIntTypeDeclK,      VhpiIteratorK,      VhpiLibraryDeclK,      VhpiLoopStmtK,      VhpiNextStmtK,      VhpiNullLiteralK,      VhpiNullStmtK,      VhpiOperatorK,      VhpiOthersLiteralK,      VhpiOutPortK,      VhpiPackBodyK,      VhpiPackDeclK,      VhpiPackInstK,      VhpiParamAttrNameK,      VhpiPhysLiteralK,      VhpiPhysRangeK,      VhpiPhysTypeDeclK,      VhpiPortDeclK,      VhpiProcCallStmtK,      VhpiProcDeclK,      VhpiProcessStmtK,      VhpiProtectedTypeK,      VhpiProtectedTypeBodyK,      VhpiProtectedTypeDeclK,      VhpiRealLiteralK,      VhpiRecordTypeDeclK,      VhpiReportStmtK,      VhpiReturnStmtK,      VhpiRootInstK,      VhpiSelectSigAssignStmtK,      VhpiSelectWaveformK,      VhpiSelectedNameK,      VhpiSigDeclK,      VhpiSigParamDeclK,      VhpiSimpAttrNameK,      VhpiSimpleSigAssignStmtK,      VhpiSliceNameK,      VhpiStringLiteralK,      VhpiSubpBodyK,      VhpiSubtypeDeclK,      VhpiSubtypeIndicK,      VhpiToolK,      VhpiTransactionK,      VhpiTypeConvK,      VhpiUnaryExprK,      VhpiUnitDeclK,      VhpiUserAttrNameK,      VhpiVarAssignStmtK,      VhpiVarDeclK,      VhpiVarParamDeclK,      VhpiWaitStmtK,      VhpiWaveformElemK,      VhpiWhileLoopK,      --  Iterator, but on a name.      AvhpiNameIteratorK     );   type VhpiOneToOneT is     (      VhpiAbstractLiteral,      VhpiActual,      VhpiAllLiteral,      VhpiAttrDecl,      VhpiAttrSpec,      VhpiBaseType,      VhpiBaseUnit,      VhpiBasicSignal,      VhpiBlockConfig,      VhpiCaseExpr,      VhpiCondExpr,      VhpiConfigDecl,      VhpiConfigSpec,      VhpiConstraint,      VhpiContributor,      VhpiCurCallback,      VhpiCurEqProcess,      VhpiCurStackFrame,      VhpiDeRefObj,      VhpiDecl,      VhpiDesignUnit,      VhpiDownStack,      VhpiElemSubtype,      VhpiEntityAspect,      VhpiEntityDecl,      VhpiEqProcessStmt,      VhpiExpr,      VhpiFormal,      VhpiFuncDecl,      VhpiGroupTempDecl,      VhpiGuardExpr,      VhpiGuardSig,      VhpiImmRegion,      VhpiInPort,      VhpiInitExpr,      VhpiIterScheme,      VhpiLeftExpr,      VhpiLexicalScope,      VhpiLhsExpr,      VhpiLocal,      VhpiLogicalExpr,      VhpiName,      VhpiOperator,      VhpiOthersLiteral,      VhpiOutPort,      VhpiParamDecl,      VhpiParamExpr,      VhpiParent,      VhpiPhysLiteral,      VhpiPrefix,      VhpiPrimaryUnit,      VhpiProtectedTypeBody,      VhpiProtectedTypeDecl,      VhpiRejectTime,      VhpiReportExpr,      VhpiResolFunc,      VhpiReturnExpr,      VhpiReturnTypeMark,      VhpiRhsExpr,      VhpiRightExpr,      VhpiRootInst,      VhpiSelectExpr,      VhpiSeverityExpr,      VhpiSimpleName,      VhpiSubpBody,      VhpiSubpDecl,      VhpiSubtype,      VhpiSuffix,      VhpiTimeExpr,      VhpiTimeOutExpr,      VhpiTool,      VhpiTypeMark,      VhpiUnitDecl,      VhpiUpStack,      VhpiUpperRegion,      VhpiValExpr,      VhpiValSubtype     );   --  Methods used to traverse 1 to many relationships.   type VhpiOneToManyT is     (      VhpiAliasDecls,      VhpiArgvs,      VhpiAttrDecls,      VhpiAttrSpecs,      VhpiBasicSignals,      VhpiBlockStmts,      VhpiBranchs,      VhpiCallbacks,      VhpiChoices,      VhpiCompInstStmts,      VhpiCondExprs,      VhpiCondWaveforms,      VhpiConfigItems,      VhpiConfigSpecs,      VhpiConstDecls,      VhpiConstraints,      VhpiContributors,      VhpiCurRegions,      VhpiDecls,      VhpiDepUnits,      VhpiDesignUnits,      VhpiDrivenSigs,      VhpiDrivers,      VhpiElemAssocs,      VhpiEntityClassEntrys,      VhpiEntityDesignators,      VhpiEnumLiterals,      VhpiForeignfs,      VhpiGenericAssocs,      VhpiGenericDecls,      VhpiIndexExprs,      VhpiIndexedNames,      VhpiInternalRegions,      VhpiMembers,      VhpiPackInsts,      VhpiParamAssocs,      VhpiParamDecls,      VhpiPortAssocs,      VhpiPortDecls,      VhpiRecordElems,      VhpiSelectWaveforms,      VhpiSelectedNames,      VhpiSensitivitys,      VhpiSeqStmts,      VhpiSigAttrs,      VhpiSigDecls,      VhpiSigNames,      VhpiSignals,      VhpiSpecNames,      VhpiSpecs,      VhpiStmts,      VhpiTransactions,      VhpiTypeMarks,      VhpiUnitDecls,      VhpiUses,      VhpiVarDecls,      VhpiWaveformElems,      VhpiLibraryDecls     );   --  String properties.   type VhpiStrPropertyT is     (      VhpiCaseNameP,      VhpiCompNameP,      VhpiDefNameP,      VhpiFileNameP,      VhpiFullCaseNameP,      VhpiFullNameP,      VhpiKindStrP,      VhpiLabelNameP,      VhpiLibLogicalNameP,      VhpiLibPhysicalNameP,      VhpiLogicalNameP,      VhpiLoopLabelNameP,      VhpiNameP,      VhpiOpNameP,      VhpiStrValP,      VhpiToolVersionP,      VhpiUnitNameP     );   --  Possible Errors.   type AvhpiErrorT is     (      AvhpiErrorOk,      AvhpiErrorBadRel,      AvhpiErrorHandle,      AvhpiErrorNotImplemented,      AvhpiErrorIteratorEnd     );   type VhpiHandleT is private;   --  A null handle.   Null_Handle : constant VhpiHandleT;   --  Get the root instance.   procedure Get_Root_Inst (Res : out VhpiHandleT);   --  Get the instanciated packages.   procedure Get_Package_Inst (Res : out VhpiHandleT);   procedure Vhpi_Handle (Rel : VhpiOneToOneT;                          Ref : VhpiHandleT;                          Res : out VhpiHandleT;                          Error : out AvhpiErrorT);   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;                            Ref : VhpiHandleT;                            Res : out VhpiHandleT;                            Error : out AvhpiErrorT);   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;                        Res : out VhpiHandleT;                        Error : out AvhpiErrorT);   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;                           Obj : VhpiHandleT;                           Res : out String;                           Len : out Natural);   --  Almost the same as Vhpi_Get_Str (VhpiName, OBJ), but there is not   --  indexes for generate stmt.   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String;   --  Return TRUE iff HDL1 and HDL2 are equivalent.   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)                                 return Boolean;--    procedure Vhpi_Handle_By_Simple_Name (Ref : VhpiHandleT;--                                          Res : out VhpiHandleT;--                                          Error : out AvhpiErrorT);   type VhpiEntityClassT is     (      VhpiErrorEC,      VhpiEntityEC,      VhpiArchitectureEC,      VhpiConfigurationEC,      VhpiProcedureEC,      VhpiFunctionEC,      VhpiPackageEC,      VhpiTypeEC,      VhpiSubtypeEC,      VhpiConstantEC,      VhpiSignalEC,      VhpiVariableEC,      VhpiComponentEC,      VhpiLabelEC,      VhpiLiteralEC,      VhpiUnitsEC,      VhpiFileEC,      VhpiGroupEC     );   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)                                 return VhpiEntityClassT;   type VhpiModeP is     (      VhpiErrorMode,      VhpiInMode,      VhpiOutMode,      VhpiInoutMode,      VhpiBufferMode,      VhpiLinkageMode     );   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP;   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access;   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address;   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context;   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT;   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)                           return AvhpiErrorT;private   type VhpiHandleT (Kind : VhpiClassKindT := VhpiUndefined) is record      --  Context.      Ctxt : Rti_Context;      case Kind is         when VhpiIteratorK =>            Rel : VhpiOneToManyT;            It_Cur : Ghdl_Index_Type;            It2 : Ghdl_Index_Type;            Max2 : Ghdl_Index_Type;         when AvhpiNameIteratorK           | VhpiIndexedNameK =>            N_Addr : Address;            N_Type : Ghdl_Rti_Access;            N_Idx : Ghdl_Index_Type;            N_Obj : Ghdl_Rtin_Object_Acc;         when VhpiSigDeclK           | VhpiPortDeclK           | VhpiGenericDeclK           | VhpiConstDeclK =>            Obj : Ghdl_Rtin_Object_Acc;         when VhpiSubtypeIndicK           | VhpiSubtypeDeclK           | VhpiArrayTypeDeclK           | VhpiEnumTypeDeclK =>            Atype : Ghdl_Rti_Access;         when VhpiCompInstStmtK =>            Inst : Ghdl_Rtin_Instance_Acc;         when others =>            null;      end case;      --  Current Object.      --Obj : Ghdl_Rti_Access;   end record;   Null_Handle : constant VhpiHandleT := (Kind => VhpiUndefined,                                          Ctxt => (Base => Null_Address,                                                   Block => null));end Grt.Avhpi;