Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
PolyORB-HI-Ada
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
TASTE
PolyORB-HI-Ada
Commits
270f0633
Commit
270f0633
authored
Mar 06, 2018
by
yoogx
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
* Use pragma Debug variant to remove the overhead of building
debug strings that may not be printed For openaadl/ocarina#133
parent
d7dc76c2
Changes
41
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
41 changed files
with
537 additions
and
657 deletions
+537
-657
examples/aadlv1/d3.1.3-1_extended/probe.adb
examples/aadlv1/d3.1.3-1_extended/probe.adb
+13
-13
examples/aadlv1/import/ping_body.adb
examples/aadlv1/import/ping_body.adb
+2
-2
examples/aadlv1/mpc/mpc.adb
examples/aadlv1/mpc/mpc.adb
+1
-13
examples/aadlv1/ping/msgs.adb
examples/aadlv1/ping/msgs.adb
+2
-2
examples/aadlv1/ping/ping.adb
examples/aadlv1/ping/ping.adb
+5
-5
examples/aadlv1/ping/pinged.adb
examples/aadlv1/ping/pinged.adb
+2
-2
examples/aadlv1/producer_consumer/producer_consumer.adb
examples/aadlv1/producer_consumer/producer_consumer.adb
+3
-3
examples/aadlv1/some_types/some_types_pkg.adb
examples/aadlv1/some_types/some_types_pkg.adb
+21
-31
examples/aadlv1/sunseeker/sunseeker_controller_pkg.adb
examples/aadlv1/sunseeker/sunseeker_controller_pkg.adb
+3
-5
examples/aadlv1/sunseeker/sunseeker_plant_pkg.adb
examples/aadlv1/sunseeker/sunseeker_plant_pkg.adb
+3
-5
examples/aadlv2/d3.1.3-1_extended/probe.adb
examples/aadlv2/d3.1.3-1_extended/probe.adb
+14
-14
examples/aadlv2/device_drivers/ping.adb
examples/aadlv2/device_drivers/ping.adb
+2
-2
examples/aadlv2/device_drivers/pinged.adb
examples/aadlv2/device_drivers/pinged.adb
+2
-2
examples/aadlv2/import/ping_body.adb
examples/aadlv2/import/ping_body.adb
+2
-2
examples/aadlv2/mpc/mpc.adb
examples/aadlv2/mpc/mpc.adb
+2
-16
examples/aadlv2/ping/msgs.adb
examples/aadlv2/ping/msgs.adb
+2
-2
examples/aadlv2/ping/ping.adb
examples/aadlv2/ping/ping.adb
+5
-5
examples/aadlv2/ping/pinged.adb
examples/aadlv2/ping/pinged.adb
+2
-2
examples/aadlv2/ping_overflow/msgs.adb
examples/aadlv2/ping_overflow/msgs.adb
+2
-2
examples/aadlv2/ping_overflow/ping.adb
examples/aadlv2/ping_overflow/ping.adb
+6
-6
examples/aadlv2/ping_overflow/pinged.adb
examples/aadlv2/ping_overflow/pinged.adb
+2
-2
examples/aadlv2/producer_consumer/producer_consumer.adb
examples/aadlv2/producer_consumer/producer_consumer.adb
+3
-3
examples/aadlv2/rasta/ping.adb
examples/aadlv2/rasta/ping.adb
+2
-2
examples/aadlv2/rasta/pinged.adb
examples/aadlv2/rasta/pinged.adb
+2
-2
examples/aadlv2/rma/hello.adb
examples/aadlv2/rma/hello.adb
+3
-3
examples/aadlv2/some_types/some_types_pkg.adb
examples/aadlv2/some_types/some_types_pkg.adb
+19
-27
examples/aadlv2/sunseeker/sunseeker_controller_pkg.adb
examples/aadlv2/sunseeker/sunseeker_controller_pkg.adb
+7
-9
examples/aadlv2/sunseeker/sunseeker_plant_pkg.adb
examples/aadlv2/sunseeker/sunseeker_plant_pkg.adb
+7
-9
src/drivers/polyorb_hi_drivers_native_tcp_ip.adb
src/drivers/polyorb_hi_drivers_native_tcp_ip.adb
+39
-43
src/gnat.adc
src/gnat.adc
+1
-0
src/native.adc
src/native.adc
+1
-0
src/polyorb_hi-aperiodic_task.adb
src/polyorb_hi-aperiodic_task.adb
+15
-22
src/polyorb_hi-background_task.adb
src/polyorb_hi-background_task.adb
+11
-17
src/polyorb_hi-output.adb
src/polyorb_hi-output.adb
+18
-42
src/polyorb_hi-output.ads
src/polyorb_hi-output.ads
+10
-13
src/polyorb_hi-periodic_task.adb
src/polyorb_hi-periodic_task.adb
+10
-14
src/polyorb_hi-sporadic_task.adb
src/polyorb_hi-sporadic_task.adb
+15
-22
src/polyorb_hi-thread_interrogators.adb
src/polyorb_hi-thread_interrogators.adb
+57
-69
src/polyorb_hi-transport_low_level_sockets.adb
src/polyorb_hi-transport_low_level_sockets.adb
+44
-45
src/polyorb_hi-unprotected_queue.adb
src/polyorb_hi-unprotected_queue.adb
+175
-177
src/polyorb_hi-utils.adb
src/polyorb_hi-utils.adb
+2
-2
No files found.
examples/aadlv1/d3.1.3-1_extended/probe.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -86,7 +86,7 @@ package body Probe is
-- To kill warning "mode could be "in" instead of "in out"
begin
Read_Value
:=
Field
;
Put_Line
(
Normal
,
"Value Read: "
&
POS_Internal_Type
'
Image
(
Field
));
Put_Line
(
"Value Read: "
&
POS_Internal_Type
'
Image
(
Field
));
end
Read
;
------------
...
...
@@ -96,7 +96,7 @@ package body Probe is
procedure
Update
(
Field
:
in
out
POS_Internal_Type
)
is
begin
Field
:=
Field
+
1
;
Put_Line
(
Normal
,
"Value Updated: "
&
POS_Internal_Type
'
Image
(
Field
));
Put_Line
(
"Value Updated: "
&
POS_Internal_Type
'
Image
(
Field
));
end
Update
;
-------------
...
...
@@ -105,9 +105,9 @@ package body Probe is
procedure
GNC_Job
is
begin
Put_Line
(
Normal
,
"Begin computing: GNC"
);
Put_Line
(
"Begin computing: GNC"
);
Compute_During_N_Times_1ms
(
600
);
Put_Line
(
Normal
,
"End computing: GNC"
);
Put_Line
(
"End computing: GNC"
);
end
GNC_Job
;
--------------
...
...
@@ -116,9 +116,9 @@ package body Probe is
procedure
TMTC_Job
is
begin
Put_Line
(
Normal
,
"Begin computing: TMTC"
);
Put_Line
(
"Begin computing: TMTC"
);
Compute_During_N_Times_1ms
(
50
);
Put_Line
(
Normal
,
"End computing: TMTC"
);
Put_Line
(
"End computing: TMTC"
);
end
TMTC_Job
;
------------------
...
...
@@ -128,9 +128,9 @@ package body Probe is
procedure
GNC_Identity
is
begin
if
GNC_Welcome
then
Put_Line
(
Normal
,
"Welcome GNC!"
);
Put_Line
(
"Welcome GNC!"
);
else
Put_Line
(
Normal
,
"Good bye GNC!"
);
Put_Line
(
"Good bye GNC!"
);
end
if
;
GNC_Welcome
:=
not
GNC_Welcome
;
...
...
@@ -143,9 +143,9 @@ package body Probe is
procedure
TMTC_Identity
is
begin
if
TMTC_Welcome
then
Put_Line
(
Normal
,
"Welcome TMTC!"
);
Put_Line
(
"Welcome TMTC!"
);
else
Put_Line
(
Normal
,
"Good bye TMTC!"
);
Put_Line
(
"Good bye TMTC!"
);
end
if
;
TMTC_Welcome
:=
not
TMTC_Welcome
;
...
...
@@ -161,7 +161,7 @@ package body Probe is
is
begin
Data_Source
:=
Sent_Data
;
Put_Line
(
Normal
,
"Sending Data"
Put_Line
(
"Sending Data"
&
POS_Internal_Type
'
Image
(
Data_Source
));
end
Send_Spg
;
...
...
@@ -171,7 +171,7 @@ package body Probe is
procedure
Receive_Spg
(
Data_Sink
:
POS_Internal_Type
)
is
begin
Put_Line
(
Normal
,
"*** RECEIVED DATA ***"
Put_Line
(
"*** RECEIVED DATA ***"
&
POS_Internal_Type
'
Image
(
Data_Sink
));
end
Receive_Spg
;
...
...
examples/aadlv1/import/ping_body.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -74,7 +74,7 @@ package body Ping is
begin
Var
:=
Var
+
1
;
Data_Source
:=
Var
;
Put_Line
(
Normal
,
"Sending PING"
&
Image
(
Var
));
Put_Line
(
"Sending PING"
&
Image
(
Var
));
end
Do_Ping_Spg
;
end
Ping
;
examples/aadlv1/mpc/mpc.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -42,9 +42,6 @@ package body MPC is
function
Get_Node
return
String
;
pragma
Inline
(
Get_Node
);
procedure
Put_Line
(
M
:
String
);
pragma
Inline
(
Put_Line
);
function
Image
(
X
:
Component_Type
)
return
String
;
pragma
Inline
(
Image
);
...
...
@@ -60,15 +57,6 @@ package body MPC is
return
Node_Image
(
My_Node
);
end
Get_Node
;
--------------
-- Put_Line --
--------------
procedure
Put_Line
(
M
:
String
)
is
begin
Put_Line
(
Normal
,
Get_Node
&
": "
&
M
);
end
Put_Line
;
-----------
-- Image --
-----------
...
...
examples/aadlv1/ping/msgs.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -41,7 +41,7 @@ package body Msgs is
procedure
Welcome_Pinger
is
begin
Put_Line
(
Normal
,
"Hello! This is the pinger thread starting"
);
Put_Line
(
"Hello! This is the pinger thread starting"
);
end
Welcome_Pinger
;
end
Msgs
;
examples/aadlv1/ping/ping.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -48,7 +48,7 @@ package body Ping is
begin
Order
:=
not
Order
;
Data_Source
:=
Order
;
Put_Line
(
Normal
,
"Sending ORDER: "
&
Opaque_Type
'
Image
(
Order
));
Put_Line
(
"Sending ORDER: "
&
Opaque_Type
'
Image
(
Order
));
end
Do_Ping_Spg
;
--------------------
...
...
@@ -60,14 +60,14 @@ package body Ping is
Data_Source
:
out
Simple_type
)
is
begin
Put_Line
(
Normal
,
"ORDER: "
&
Opaque_Type
'
Image
(
Data_Sink
));
Put_Line
(
"ORDER: "
&
Opaque_Type
'
Image
(
Data_Sink
));
if
Data_Sink
then
Var
:=
Var
+
1
;
Put_Line
(
Normal
,
"Sending (+1) PING"
&
Simple_Type
'
Image
(
Var
));
Put_Line
(
"Sending (+1) PING"
&
Simple_Type
'
Image
(
Var
));
else
Var
:=
Var
+
5
;
Put_Line
(
Normal
,
"Sending (+5) PING"
&
Simple_Type
'
Image
(
Var
));
Put_Line
(
"Sending (+5) PING"
&
Simple_Type
'
Image
(
Var
));
end
if
;
Data_Source
:=
Var
;
...
...
examples/aadlv1/ping/pinged.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2008-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2008-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -41,7 +41,7 @@ package body Pinged is
procedure
Ping_Spg
(
Data_Sink
:
Simple_Type
)
is
begin
Put_Line
(
Normal
,
"*** PING ***"
&
Simple_Type
'
Image
(
Data_Sink
));
Put_Line
(
"*** PING ***"
&
Simple_Type
'
Image
(
Data_Sink
));
end
Ping_Spg
;
end
Pinged
;
examples/aadlv1/producer_consumer/producer_consumer.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -60,7 +60,7 @@ package body Producer_Consumer is
Data_Source
:=
The_Data
;
The_Data
:=
The_Data
+
1
;
Put_Line
(
Normal
,
Get_Node
Put_Line
(
Get_Node
&
": produced "
&
Alpha_Type
'
Image
(
Data_Source
));
end
Produce_Spg
;
...
...
@@ -71,7 +71,7 @@ package body Producer_Consumer is
procedure
Consume_Spg
(
Data_Sink
:
Alpha_Type
)
is
begin
Put_Line
(
Normal
,
Get_Node
Put_Line
(
Get_Node
&
" : consumed "
&
Alpha_Type
'
Image
(
Data_Sink
));
end
Consume_Spg
;
...
...
examples/aadlv1/some_types/some_types_pkg.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2006-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -56,8 +56,7 @@ package body Some_Types_Pkg is
Boolean_Type_Var
:=
not
Boolean_Type_Var
;
Data_Source
:=
Boolean_Type_Var
;
Put_Line
(
Normal
,
"***** Emitting Boolean_Type: "
&
Boolean_Type
'
Image
(
Data_Source
));
(
"***** Emitting Boolean_Type: "
&
Boolean_Type
'
Image
(
Data_Source
));
end
Emit_Boolean
;
---------------------
...
...
@@ -67,8 +66,7 @@ package body Some_Types_Pkg is
procedure
Receive_Boolean
(
Data_Sink
:
in
Boolean_Type
)
is
begin
Put_Line
(
Normal
,
"***** Received Boolean_Type: "
&
Boolean_Type
'
Image
(
Data_Sink
));
(
"***** Received Boolean_Type: "
&
Boolean_Type
'
Image
(
Data_Sink
));
end
Receive_Boolean
;
---------------
...
...
@@ -84,8 +82,7 @@ package body Some_Types_Pkg is
end
if
;
Data_Source
:=
Enum_Type_Var
;
Put_Line
(
Normal
,
"***** Emitting Enum_Type: "
&
Enum_Type
'
Image
(
Data_Source
));
(
"***** Emitting Enum_Type: "
&
Enum_Type
'
Image
(
Data_Source
));
end
Emit_Enum
;
------------------
...
...
@@ -95,8 +92,7 @@ package body Some_Types_Pkg is
procedure
Receive_Enum
(
Data_Sink
:
in
Enum_Type
)
is
begin
Put_Line
(
Normal
,
"***** Received Enum_Type: "
&
Enum_Type
'
Image
(
Data_Sink
));
(
"***** Received Enum_Type: "
&
Enum_Type
'
Image
(
Data_Sink
));
end
Receive_Enum
;
------------------
...
...
@@ -108,8 +104,7 @@ package body Some_Types_Pkg is
Integer_Type_Var
:=
Integer_Type_Var
+
1
;
Data_Source
:=
Integer_Type_Var
;
Put_Line
(
Normal
,
"***** Emitting Integer_Type: "
&
Integer_Type
'
Image
(
Data_Source
));
(
"***** Emitting Integer_Type: "
&
Integer_Type
'
Image
(
Data_Source
));
end
Emit_Integer
;
---------------------
...
...
@@ -119,8 +114,7 @@ package body Some_Types_Pkg is
procedure
Receive_Integer
(
Data_Sink
:
in
Integer_Type
)
is
begin
Put_Line
(
Normal
,
"***** Received Integer_Type: "
&
Integer_Type
'
Image
(
Data_Sink
));
(
"***** Received Integer_Type: "
&
Integer_Type
'
Image
(
Data_Sink
));
end
Receive_Integer
;
----------------
...
...
@@ -135,13 +129,12 @@ package body Some_Types_Pkg is
Array_Type_I_Var
(
4
),
Array_Type_I_Var
(
1
));
Put_Line
(
Normal
,
"***** Emitting Array : ("
&
Integer_Type
'
Image
(
Data_Source
(
1
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
2
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
3
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
4
))
&
")"
);
(
"***** Emitting Array : ("
&
Integer_Type
'
Image
(
Data_Source
(
1
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
2
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
3
))
&
", "
&
Integer_Type
'
Image
(
Data_Source
(
4
))
&
")"
);
end
Emit_Array
;
-------------------
...
...
@@ -151,13 +144,12 @@ package body Some_Types_Pkg is
procedure
Receive_Array
(
Data_Sink
:
in
Array_Type_I
)
is
begin
Put_Line
(
Normal
,
"***** Receivinng Array : ("
&
Integer_Type
'
Image
(
Data_Sink
(
1
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
2
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
3
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
4
))
&
")"
);
(
"***** Receivinng Array : ("
&
Integer_Type
'
Image
(
Data_Sink
(
1
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
2
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
3
))
&
", "
&
Integer_Type
'
Image
(
Data_Sink
(
4
))
&
")"
);
end
Receive_Array
;
-----------------
...
...
@@ -175,8 +167,7 @@ package body Some_Types_Pkg is
end
if
;
Put_Line
(
Normal
,
"***** Emitting String_Type: "
&
To_String
(
Data_Source
));
(
"***** Emitting String_Type: "
&
To_String
(
Data_Source
));
end
Emit_String
;
--------------------
...
...
@@ -186,8 +177,7 @@ package body Some_Types_Pkg is
procedure
Receive_String
(
Data_Sink
:
in
String_Type
)
is
begin
Put_Line
(
Normal
,
"***** Received String_Type:
""
"
&
To_String
(
Data_Sink
)
&
"
""
"
);
(
"***** Received String_Type:
""
"
&
To_String
(
Data_Sink
)
&
"
""
"
);
end
Receive_String
;
end
Some_Types_Pkg
;
examples/aadlv1/sunseeker/sunseeker_controller_pkg.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -58,8 +58,7 @@ package body Sunseeker_Controller_Pkg is
Gain_Error
:
Single_Float
;
Transfer_Fcn_Update
:
Single_Float
;
begin
Put_Line
(
Normal
,
Node_Image
(
My_Node
)
Put_Line
(
Node_Image
(
My_Node
)
&
" CONSTROLLER INPUT:"
&
Single_Float
'
Image
(
Outputfeedback
));
...
...
@@ -87,8 +86,7 @@ package body Sunseeker_Controller_Pkg is
Clock
:=
Clock
+
Period
;
Put_Line
(
Normal
,
Node_Image
(
My_Node
)
Put_Line
(
Node_Image
(
My_Node
)
&
" CONSTROLLER OUTPUT:"
&
Single_Float
'
Image
(
Controllerinput
));
end
Sunseekercontroller_Subprogram_Impl
;
...
...
examples/aadlv1/sunseeker/sunseeker_plant_pkg.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2007-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -60,8 +60,7 @@ package body Sunseeker_Plant_Pkg is
Transfer_Fcn_update
:
Single_Float
;
begin
Put_Line
(
Normal
,
Node_Image
(
My_Node
)
Put_Line
(
Node_Image
(
My_Node
)
&
" PLANT INPUT:"
&
Single_Float
'
Image
(
Controllerinput
));
...
...
@@ -85,8 +84,7 @@ package body Sunseeker_Plant_Pkg is
sunseekerplant_Transfer_Fcn
:=
Sunseekerplant_Transfer_Fcn
+
Period
*
Transfer_Fcn_Update
;
Put_Line
(
Normal
,
Node_Image
(
My_Node
)
Put_Line
(
Node_Image
(
My_Node
)
&
" PLANT OUTPUT:"
&
Single_Float
'
Image
(
Outputfeedback
)
&
" ERROR:"
...
...
examples/aadlv2/d3.1.3-1_extended/probe.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--
Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE.
--
--
Copyright (C) 2006-2009 Telecom ParisTech, 2010-2018 ESA & ISAE.
--
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- $Id: probe.adb
6273 2009-03-25 17:36:51Z lasnier
$
-- $Id: probe.adb
5381 2007-12-23 12:39:41Z zalila
$
with
Ada
.
Real_Time
;
use
Ada
.
Real_Time
;
...
...
@@ -86,7 +86,7 @@ package body Probe is
-- To kill warning "mode could be "in" instead of "in out"
begin
Read_Value
:=
Field
;
Put_Line
(
Normal
,
"Value Read: "
&
POS_Internal_Type
'
Image
(
Field
));
Put_Line
(
"Value Read: "
&
POS_Internal_Type
'
Image
(
Field
));
end
Read
;
------------
...
...
@@ -96,7 +96,7 @@ package body Probe is
procedure
Update
(
Field
:
in
out
POS_Internal_Type
)
is
begin
Field
:=
Field
+
1
;
Put_Line
(
Normal
,
"Value Updated: "
&
POS_Internal_Type
'
Image
(
Field
));
Put_Line
(
"Value Updated: "
&
POS_Internal_Type
'
Image
(
Field
));
end
Update
;
-------------
...
...
@@ -105,9 +105,9 @@ package body Probe is
procedure
GNC_Job
is
begin
Put_Line
(
Normal
,
"Begin computing: GNC"
);
Put_Line
(
"Begin computing: GNC"
);
Compute_During_N_Times_1ms
(
600
);
Put_Line
(
Normal
,
"End computing: GNC"
);
Put_Line
(
"End computing: GNC"
);
end
GNC_Job
;
--------------
...
...
@@ -116,9 +116,9 @@ package body Probe is
procedure
TMTC_Job
is
begin
Put_Line
(
Normal
,
"Begin computing: TMTC"
);
Put_Line
(
"Begin computing: TMTC"
);
Compute_During_N_Times_1ms
(
50
);
Put_Line
(
Normal
,
"End computing: TMTC"
);
Put_Line
(
"End computing: TMTC"
);
end
TMTC_Job
;
------------------
...
...
@@ -128,9 +128,9 @@ package body Probe is
procedure
GNC_Identity
is
begin
if
GNC_Welcome
then
Put_Line
(
Normal
,
"Welcome GNC!"
);
Put_Line
(
"Welcome GNC!"
);
else
Put_Line
(
Normal
,
"Good bye GNC!"
);
Put_Line
(
"Good bye GNC!"
);
end
if
;
GNC_Welcome
:=
not
GNC_Welcome
;
...
...
@@ -143,9 +143,9 @@ package body Probe is
procedure
TMTC_Identity
is
begin
if
TMTC_Welcome
then
Put_Line
(
Normal
,
"Welcome TMTC!"
);
Put_Line
(
"Welcome TMTC!"
);
else
Put_Line
(
Normal
,
"Good bye TMTC!"
);
Put_Line
(
"Good bye TMTC!"
);
end
if
;
TMTC_Welcome
:=
not
TMTC_Welcome
;
...
...
@@ -161,7 +161,7 @@ package body Probe is
is
begin
Data_Source
:=
Sent_Data
;
Put_Line
(
Normal
,
"Sending Data"
Put_Line
(
"Sending Data"
&
POS_Internal_Type
'
Image
(
Data_Source
));
end
Send_Spg
;
...
...
@@ -171,7 +171,7 @@ package body Probe is
procedure
Receive_Spg
(
Data_Sink
:
POS_Internal_Type
)
is
begin
Put_Line
(
Normal
,
"*** RECEIVED DATA ***"
Put_Line
(
"*** RECEIVED DATA ***"
&
POS_Internal_Type
'
Image
(
Data_Sink
));
end
Receive_Spg
;
...
...
examples/aadlv2/device_drivers/ping.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--
Copyright (C) 2015 ESA & ISAE.
--
--
Copyright (C) 2015-2018 ESA & ISAE.
--
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -44,7 +44,7 @@ package body Ping is
procedure
Do_Ping_Spg
(
Data_Source
:
out
Simple_Type
)
is
begin
Data_Source
:=
Var
;
Put_Line
(
Normal
,
"Sending ORDER: "
&
Simple_Type
'
Image
(
Var
));
Put_Line
(
"Sending ORDER: "
&
Simple_Type
'
Image
(
Var
));
Var
:=
Var
+
1
;
end
Do_Ping_Spg
;
...
...
examples/aadlv2/device_drivers/pinged.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--
Copyright (C) 2015 ESA & ISAE.
--
--
Copyright (C) 2015-2018 ESA & ISAE.
--
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -41,7 +41,7 @@ package body Pinged is
procedure
Ping_Spg
(
Data_Sink
:
Simple_Type
)
is
begin
Put_Line
(
Normal
,
"*** PING ***"
&
Simple_Type
'
Image
(
Data_Sink
));
Put_Line
(
"*** PING ***"
&
Simple_Type
'
Image
(
Data_Sink
));
end
Ping_Spg
;
end
Pinged
;
examples/aadlv2/import/ping_body.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -76,7 +76,7 @@ package body Ping is
begin
Var
:=
Var
+
1
;
Data_Source
:=
Var
;
Put_Line
(
Normal
,
"Sending PING"
&
Image
(
Var
));
Put_Line
(
"Sending PING"
&
Image
(
Var
));
end
Do_Ping_Spg
;
end
Ping
;
examples/aadlv2/mpc/mpc.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--
Copyright (C) 2009 Telecom ParisTech, 2010-2015 ESA & ISAE.
--
--
Copyright (C) 2007-2009 Telecom ParisTech, 2010-2018 ESA & ISAE.
--
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -29,8 +29,6 @@
-- --
------------------------------------------------------------------------------
-- $Id: mpc.adb 6273 2009-03-25 17:36:51Z lasnier $
with
PolyORB_HI
.
Output
;
with
PolyORB_HI_Generated
.
Deployment
;
...
...
@@ -44,9 +42,6 @@ package body MPC is
function
Get_Node
return
String
;
pragma
Inline
(
Get_Node
);
procedure
Put_Line
(
M
:
String
);
pragma
Inline
(
Put_Line
);
function
Image
(
X
:
Component_Type
)
return
String
;
pragma
Inline
(
Image
);
...
...
@@ -59,18 +54,9 @@ package body MPC is
function
Get_Node
return
String
is
begin
return
Node_
Type
'
Image
(
My_Node
);
return
Node_Image
(
My_Node
);
end
Get_Node
;
--------------
-- Put_Line --
--------------
procedure
Put_Line
(
M
:
String
)
is
begin
Put_Line
(
Normal
,
Get_Node
&
": "
&
M
);
end
Put_Line
;
-----------
-- Image --
-----------
...
...
examples/aadlv2/ping/msgs.adb
View file @
270f0633
...
...
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2008-2009 Telecom ParisTech, 2010-201
5
ESA & ISAE. --
-- Copyright (C) 2008-2009 Telecom ParisTech, 2010-201
8
ESA & ISAE. --
-- --
-- PolyORB-HI is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
...
...
@@ -43,7 +43,7 @@ package body Msgs is
procedure
Welcome_Pinger
is
begin
Put_Line
(
Normal
,
"Hello! This is the pinger thread starting"
);
Put_Line
(
"Hello! This is the pinger thread starting"
);
end
Welcome_Pinger
;
-------------
...
...
examples/aadlv2/ping/ping.adb