'm starting at the HLA world, and I'm trying to compile the example, CallingHLA, and HLA compile the code, I am getting the following error:
Error in file "hlaFunc.hla" at line 76 [errid:82229/hlaparse.bsn]:
Too few actual parameters.
Near: << ) >>
HLAPARSE assembly failed with 1 errors
the code is:
unit hlaFuncUnit;
#include( "stdlib.hhf" )
procedure hlaFunc( i:int32 ); #cdecl; #external( "_hlaFunc" );
procedure BuildExcepts; #external("BuildExcepts__hla_");
procedure HardwareException; #external( "HardwareException__hla_" );
procedure DefaultExceptionHandler; #external( "DefaultExceptionHandler__hla_" );
procedure HWexcept; #external( "HWexcept__hla_" );
procedure DfltExHndlr; #external( "DfltExHndlr__hla_" );
procedure QuitMain; #external( "QuitMain__hla_" );
procedure ExitProcess( rtnCode:dword ); #external( "_ExitProcess#4" );
static
MainPgmVMT: dword:= &QuitMain;
MainPgmCoroutine: dword[ 5 ]; #external( "MainPgmCoroutine__hla_" );
MainPgmCoroutine: dword; #nostorage;
dword &MainPgmVMT, 0, 0;
SaveSEHPointer: dword; #nostorage; // Still part of MainPgmCoroutine...
dword 0, 0;
procedure QuitMain;
begin QuitMain;
ExitProcess( 1 );
end QuitMain;
procedure HWexcept;
begin HWexcept;
jmp HardwareException;
end HWexcept;
procedure DfltExHndlr;
begin DfltExHndlr;
jmp DefaultExceptionHandler;
end DfltExHndlr;
procedure hlaFunc( i:int32 );
var
s:string;
begin hlaFunc;
call BuildExcepts;
try
stdout.put( "stdout.put called from HLA code, i = ", i, nl );
raise( 5 );
exception( 5 );
stdout.put( "Exception handled by HLA code" nl );
endtry;
try
stralloc( 16 );
mov( eax, s );
str.cpy( "Hello World", s );
stdout.put( "Successfully copied 'Hello World' to s: ", s, nl );
str.cpy( "0123456789abcdefghijklmnop", s );
stdout.put( "Shouldn't get here" nl );
anyexception
stdout.put( "Exception code: ", eax, nl );
ex.printExceptionError();
endtry;
strfree( s );
stdout.put( "Returning to C code" nl );
mov( SaveSEHPointer, eax );
#asm
mov fs:[0], eax
#endasm
end hlaFunc;
end hlaFuncUnit;
Where is the erro ( I know, the error is in TRY ), but, how I can solve that error ?
Thanks
The problem is printExceptionError, it should be something like this:
ex.printExceptionError( eax, ebx, ecx, edx, edi );
so, as the error says, you are missing the parameters.
Related
I'm creating a program with Ada 95 and I have a problem. Specifically, I'm trying to implement a class which executes functors given as parameters.
The behavior I want to achieve is:
Declare an interface IF with a procedure Execute.
Derive from IF with a class C and implement Execute.
Create a class D which has a field that is an array of IF. Since IF cannot be instantiated, I use an array of access IF.
Instantiate an object of class D giving it several instances of C as parameters.
Call Execute on every instance of C contained in the array of D.
I've been able to implement the above and compile it, but when I execute it I obtain the error accessibility check failed when trying to assign an object of class C to a component of the array in D.
I know that the error I obtain is because the assignment I'm doing can lead to a danging pointer error according to the Ada policies, so my question is what is the proper way to implement this in Ada 95?
The source code is below. The error is raised in the file elevators.adb, in the procedure Add_Event_Handler, I have commented the statement that causes it.
Functors.ads
package Functors is
type IFunctor is abstract tagged null record;
procedure Execute(Self : in out IFunctor) is abstract;
end Functors;
Elevators.ads
with Functors; use Functors;
package Elevators is
NOT_A_FLOOR : constant := -1;
MAX_EVENT_HANDLERS : constant := 255;
type Floor is new Integer range NOT_A_FLOOR .. 4;
type Elevator is private;
subtype Event_Handler is IFunctor'Class; --'
type Event_Handler_Index is new Integer range 0 .. MAX_EVENT_HANDLERS;
type Event_Handers is array(Event_Handler_Index) of access Event_Handler;
function Create_Elevator return Elevator;
procedure Add_Stop_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Moving_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Called_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Button_Pressed_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Run_Simulation(Self : in out Elevator);
private
type Elevator is
record
Current_Floor : Floor := 0;
Is_Moving : Boolean := False;
Next_Floor : Floor := NOT_A_FLOOR;
Stop : Event_Handers := (others => null);
Moving : Event_Handers := (others => null);
Called : Event_Handers := (others => null);
Button_Pressed : Event_Handers := (others => null);
end record;
procedure On_Stop(Self : in out Elevator);
procedure On_Moving(Self : in out Elevator);
procedure On_Called(Self : in out Elevator);
procedure On_Button_Pressed(Self : in out Elevator);
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler);
procedure Exec_All_Events(Self : in out Elevator; EH : in Event_Handers);
end Elevators;
Elevators.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Elevators is
function Create_Elevator return Elevator is
elev : Elevator;
begin
return elev;
end;
procedure Add_Stop_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Stop, Handler);
end;
procedure Add_Moving_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Moving, Handler);
end;
procedure Add_Called_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Called, Handler);
end;
procedure Add_Button_Pressed_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Button_Pressed, Handler);
end;
procedure Run_Simulation(self : in out Elevator) is
begin
Put_Line("Floor: " & Floor'Image(self.Current_Floor)); --'
self.Next_Floor := 3;
On_Called(self);
On_Moving(self);
On_Stop(self);
end;
procedure On_Stop(self : in out Elevator) is
begin
self.Current_Floor := self.Next_Floor;
self.Is_Moving := False;
self.Next_Floor := NOT_A_FLOOR;
Put_Line("Stopped. Current floor = " & Floor'Image(self.Current_Floor)); --'
Exec_All_Events(self, self.Stop);
end;
procedure On_Moving(self : in out Elevator) is
begin
self.Is_Moving := True;
self.Current_Floor := NOT_A_FLOOR;
Put_Line("Moving to floor " & Floor'Image(self.Next_Floor)); --'
Exec_All_Events(self, self.Moving);
end;
procedure On_Called(self : in out Elevator) is
begin
Put_Line("Calling button pressed (" & Floor'Image(self.Next_Floor) & ")..."); --'
Exec_All_Events(self, self.Moving);
end;
procedure On_Button_Pressed(self : in out Elevator) is
begin
null;
end;
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if Self(I) = null then
Self(I) := Handler; -- ======> The error is raised here <======
exit;
end if;
I := I + 1;
end loop;
end;
procedure Exec_All_Events(self : in out Elevator; EH : in Event_Handers) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if EH(I) /= null then
EH(I).Execute;
end if;
I := I + 1;
end loop;
end;
end Elevators;
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Functors; use Functors;
with Elevators; use Elevators;
procedure Main is
type My_Functor is new IFunctor with
record
I : Integer := 0;
end record;
overriding
procedure Execute(Self : in out My_Functor) is
begin
Put_Line("Executing functor, I is " & Integer'Image(Self.I)); --'
Self.I := Self.I + 1;
end;
Generic_Functor : aliased My_Functor;
Elev : Elevator := Create_Elevator;
begin
Add_Stop_Handler(elev, Generic_Functor'Access); --'
Add_Moving_Handler(elev, Generic_Functor'Access); --'
Add_Called_Handler(elev, Generic_Functor'Access); --'
Run_Simulation(Elev);
end;
EDIT
I have done the following changes in order to fix the mentioned runtime error, but I still obtain the accessibility check failed.
elevators.ads
...
type Event_Handler_Generic_Ptr is access all Event_Handler;
type Event_Handers is array(Event_Handler_Index) of Event_Handler_Generic_Ptr;
...
elevators.adb
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if Self(I) = null then
-- Notice the casting here
Self(I) := Event_Handler_Generic_Ptr(Handler); -- ======> The error is raised here <======
exit;
end if;
I := I + 1;
end loop;
end;
Since you store a pointer generated with 'Access in Event_Handlers, you must declare it with access all, so that it is a general access type:
type Event_Handers is array(Event_Handler_Index) of access all Event_Handler;
If you miss all, it is a pool-specific access type. See Ada 95 RM, 3.10 Access Types, (8) and (10). pool-specific access types may only hold pointers to objects allocated in a storage pool, which your object is not.
I'm following a tutorial from Oracle, and in the last step I'm trying to execute a SQL script where I get the errors from DECLARE and end-of-file. Any idea where I went wrong? The following is the script:
create or replace
PROCEDURE ENQUEUE_TEXT(
payload IN VARCHAR2 )
AS
enqueue_options DBMS_AQ.enqueue_options_t;
message_properties DBMS_AQ.message_properties_t;
message_handle RAW (16);
user_prop_array SYS.aq$_jms_userproparray;
AGENT SYS.aq$_agent;
header SYS.aq$_jms_header;
MESSAGE SYS.aq$_jms_message;
BEGIN
AGENT := SYS.aq$_agent ('', NULL, 0);
AGENT.protocol := 0;
user_prop_array := SYS.aq$_jms_userproparray ();
header := SYS.aq$_jms_header (AGENT, '', 'aq1', '', '', '', user_prop_array);
MESSAGE := SYS.aq$_jms_message.construct (0);
MESSAGE.set_text (payload);
MESSAGE.set_userid ('Userid_if_reqd');
MESSAGE.set_string_property ('JMS_OracleDeliveryMode', 2);
--(header, length(message_text), message_text, null);
DBMS_AQ.enqueue (queue_name => 'userQueue', enqueue_options => enqueue_options,
message_properties => message_properties, payload => MESSAGE, msgid => message_handle );
COMMIT;
END ENQUEUE_TEXT;
DECLARE
PAYLOAD varchar2(200);
BEGIN
PAYLOAD := 'Hello from AQ !';
ENQUEUE_TEXT(PAYLOAD => PAYLOAD);
END;
You have to put a / after the proc creation.
....
message_properties => message_properties, payload => MESSAGE, msgid => message_handle );
COMMIT;
END ENQUEUE_TEXT;
/
--COMMIT;
--/
DECLARE
PAYLOAD varchar2(200);
BEGIN
PAYLOAD := 'Hello from AQ !';
ENQUEUE_TEXT(PAYLOAD => PAYLOAD);
END;
And maybe a COMMIT; is missing.
Im trying to insert a row into a firebird database (embedded), but geting an exception when calling:
datamodule1.IBQuery1.prepare
Project xyz.exe raised exception class EIBInterBaseError with message
'Dynamic SQL Error SQL error code = -206 Column unknown INDEX_ At
line, column 25'.
with datamodule1.IBQuery1 do
begin
close;
With SQL do
begin
clear;
Add( 'INSERT INTO MST_EVENTS (eventindex, state_, event_, param_, date_, time_, devID_, gateway_)' );
Add( 'VALUES (:eventindex, :state_, :event_, :param_, :date_, :time_, :devid_, :gateway_') );
end;
//
GeneratorField.Field := 'Nr_';
GeneratorField.Generator := 'GEN_MST_EVENTS_ID';
//
Params[0].AsInteger := FMst.EventRecordIndex;
Params[1].AsSmallInt := FMst.EventRecordState;
Params[2].AsString := eventToStr(FMst.EventRecordEvent);
Params[3].AsSmallInt := 0;
Params[4].AsDate := FMst.EventRecordDate;
Params[5].AsTime := FMst.EventRecordTime;
Params[6].AsLongWord := FMst.EventRecordDevID;
Params[7].AsString := FMst.EventRecordIP;
//
if ( prepared = false ) then
prepare; //Throws an exception here (SOLVED)
execSQL; //Now getting exception here
end;
I have the following components tied together:
IBDatabase
IBTransaction
DataSource
IBQuery
Above problem solved - Edit >>
Ok, i have changed
Add( 'INSERT INTO MST_EVENTS (eventindex, state_, event_, param_, date_, time_, devID_, gateway_)' );
to
Add( 'INSERT INTO MST_EVENTS ("eventindex", "state_", "event_", "param_", "date_", "time_", "devID_", "gateway_")' );
... (so im using quotation marks) and now it finds the fields, but get another exception at line:
IBQuery1.execSQL:
Exception class EIBClientError with message 'Unsupported feature'
My fields are:
Nr_ : INTEGER
eventindex : INTEGER
state_ : SMALLINT
event_ : VARCHAR(50)
param_ : SMALLINT
date_ : DATE
time_ : TIME
devID_ : BIGINT
gateway_ : VARCHAR(50)
Firebird version is 2.5 embedded 32bit
I took out all the string and date/time parameters, yet i get the exception.
Using IBExpert and the same client/server .dll i can insert the row flawlessly (using all the values).
The solution was changing line
Params[6].AsLongWord := FMst.EventRecordDevID;
to
Params[6].AsLargeInt := FMst.EventRecordDevID;
But please how to auto-increment the field 'Nr_'?
with datamodule1.IBQuery1 do
begin
close;
With SQL do
begin
clear;
Add( 'INSERT INTO MST_EVENTS (eventindex, state_, event_, param_, date_, time_, devID_, gateway_)' );
Add( 'VALUES (:eventindex, :state_, :event_, :param_, :date_, :time_, :devid_, :gateway_') );
end;
//
GeneratorField.Field := 'Nr_';
GeneratorField.Generator := 'GEN_MST_EVENTS_ID';
//
Params[0].AsInteger := FMst.EventRecordIndex;
Params[1].AsSmallInt := FMst.EventRecordState;
Params[2].AsString := eventToStr(FMst.EventRecordEvent);
Params[3].AsSmallInt := 0;
Params[4].AsDate := FMst.EventRecordDate;
Params[5].AsTime := FMst.EventRecordTime;
Params[6].AsLargeInt := FMst.EventRecordDevID;
Params[7].AsString := FMst.EventRecordIP;
//
if ( prepared = false ) then
prepare; //Throws an exception here (SOLVED)
execSQL; //Now getting exception here
end;
I made the generator in flamerobin.
But getting exception (at calling 'execSQL'):
EDIT >>
I set up a generator and a BEFORE INSERT trigger in IBExpert:
And now its ok.
I am trying to execute the following query in PL/SQL developer:
DECLARE
P_FILENAME VARCHAR2(200):= 'file1.csv';
P_DIRECTORY VARCHAR2(200):= 'ORA_DIR';
P_IGNORE_HEADERLINES NUMBER := 1;
BEGIN
Load_file( P_FILENAME => P_FILENAME, P_DIRECTORY => P_DIRECTORY, P_IGNORE_HEADERLINES => P_IGNORE_HEADERLINES );
END
I get the error :
ORA-06550: line 9, column 0:
PLS-00103: Encountered the symbol "end-of-file" when expecting one of the following:
; <an identifier> <a double-quoted delimited-identifier>
The symbol ";" was substituted for "end-of-file" to continue.
Where am I going wrong here.
you are missing a semi colon on the end statement:
DECLARE
P_FILENAME VARCHAR2(200):= 'file1.csv';
P_DIRECTORY VARCHAR2(200):= 'ORA_DIR';
P_IGNORE_HEADERLINES NUMBER := 1;
BEGIN
Load_file( P_FILENAME => P_FILENAME, P_DIRECTORY => P_DIRECTORY,
P_IGNORE_HEADERLINES => P_IGNORE_HEADERLINES );
END;
/
I am having some trouble debugging this program. I was given an assignment to read test vectors from a text file to test a program. The program and test bench code is written below. I cannot figure out why my simulation is coming up blank. No errors, the simulation window comes up, but it is blank. Any idea what the problem may be?
Module:
library IEEE;
use IEEE.STD_LOGIC_1164.ALL;
entity PAR is
Port ( data : in STD_LOGIC_VECTOR (3 downto 0);
parity : out STD_LOGIC);
end PAR;
architecture Behavioral of PAR is
begin
proc: process
variable count: bit;
begin
for i in data'range loop
if data(i)='1' then
count:=not count;
end if;
end loop;
if count='0' then
parity<='0';
else
parity<='1';
end if;
wait;
end process;
end Behavioral;
Test Bench:
LIBRARY ieee;
USE ieee.std_logic_1164.ALL;
USE std.textio.all;
use ieee.std_logic_textio.all;
ENTITY PAR_test IS
END PAR_test;
ARCHITECTURE behavior OF PAR_test IS
-- Component Declaration for the Unit Under Test (UUT)
COMPONENT PAR
PORT(
data : IN std_logic_vector(3 downto 0);
parity : OUT std_logic
);
END COMPONENT;
--Inputs
signal data : std_logic_vector(3 downto 0) := (others => '0');
--Outputs
signal parity : std_logic;
-- No clocks detected in port list. Replace <clock> below with
-- appropriate port name
BEGIN
-- Instantiate the Unit Under Test (UUT)
uut: PAR PORT MAP (
data => data,
parity => parity
);
TB: process
file vec_file: text;
variable buf_in: line;
variable testv: std_logic_vector(0 to 4);
begin
file_open(vec_file,"PAR_file.txt,", read_mode);
while not endfile (vec_file) loop
readline (vec_file, buf_in);
read(buf_in,testv);
data(3) <= testv(0);
data(2) <= testv(1);
data(1) <= testv(2);
data(0) <= testv(3);
wait for 10 ns;
assert (parity=testv(4))
report "Test Failed" severity error;
end loop;
wait;
END process;
end;
in your "file_open.." line you have a "," that's not needed
wrong is:
file_open(vec_file,"PAR_file.txt,", read_mode);
correct is:
file_open(vec_file,"PAR_file.txt", read_mode);