with Ada.Strings.Fixed;

package body HAC_Sys.PCode.Interpreter.Exceptions is

  procedure Raise_Standard (
    ND                       : in out In_Defs.Interpreter_Data;
    SE                       :        Exception_Type;
    Msg                      :        String  := "";
    Stop_Current_Instruction :        Boolean := False
  )
  is
    EI : Exception_Propagation_Data renames ND.TCB (ND.CurTask).Exception_Info;
  begin
    EI.Currently_Raised  := (SE, 0);
    EI.Exception_Message := HAT.To_VString (Msg);
    ND.PS := In_Defs.Exception_Raised;
    if Stop_Current_Instruction then
      --  Skip the rest of what the current instruction
      --  does in the run-time library (e.g. I/O operations).
      raise VM_Raised_Exception;
    end if;
  end Raise_Standard;

  procedure Raise_VM_Exception_from_Constraint_Error (CE_Message : String) is
    --  We guess specialized kinds of "Constraint_Error"'s using
    --  the message provided by the host Ada system.
    --  For instance on an overflow check failure, GNAT issues CE with the message
    --  "raised CONSTRAINT_ERROR : xyz.adb:123 overflow check failed".
  begin
    if Ada.Strings.Fixed.Index (CE_Message, "overflow check") > 0 then
      raise VM_Overflow_Error;
    else
      raise VM_Constraint_Error;
    end if;
  end Raise_VM_Exception_from_Constraint_Error;

end HAC_Sys.PCode.Interpreter.Exceptions;