Skip to content

Instantly share code, notes, and snippets.

@ytomino

ytomino/.gitignore

Created April 9, 2012 06:46
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ytomino/2342019 to your computer and use it in GitHub Desktop.
Save ytomino/2342019 to your computer and use it in GitHub Desktop.
Download ZIP
Boost.Context in Ada
Raw
.gitignore
# This gist contains Ada version of Boost.Context and test.
/asm
/build
/b~*
/*.o
/import
/test_context
Raw
boost-contexts-detail.adb
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Address_To_Access_Conversions;
package body boost.contexts.detail is
use type Interfaces.Unsigned_16;
use type System.Address;
use type System.Storage_Elements.Integer_Address;
use type System.Storage_Elements.Storage_Offset;
package context_base_Conv is
new System.Address_To_Access_Conversions (context_base'Class);
procedure trampoline (vp : System.Storage_Elements.Integer_Address) is
pragma Assert (vp /= 0);
ctx : not null ptr_t := ptr_t (context_base_Conv.To_Pointer (
System.Storage_Elements.To_Address (vp)));
begin
begin
exec (ctx.all);
exception
when forced_unwind =>
ctx.flags := ctx.flags or flag_complete;
boost_fcontext_jump (
ctx.ctx_callee'Access,
ctx.ctx_caller'Access,
0);
end;
ctx.flags := ctx.flags or flag_complete;
if ctx.nxt /= null then
declare
nxt : ptr_t := ctx.nxt;
begin
pragma Assert (nxt /= null);
declare
Temp : boost_fcontext_t := nxt.ctx_caller;
begin
nxt.ctx_caller := ctx.ctx_caller;
ctx.ctx_caller := Temp;
end;
if 0 /= (nxt.flags and flag_do_return) then
nxt.ctx_callee.fc_link := detail_x86_64.boost_fcontext_t (
nxt.ctx_caller)'Unrestricted_Access;
end if;
nxt.flags := nxt.flags or flag_running;
nxt.flags := nxt.flags or flag_started;
end;
end if;
end trampoline;
procedure memset (
b : System.Address;
c : Integer;
len : System.Storage_Elements.Storage_Count);
pragma Import (C, memset);
package body context_base_Non_Primitives is
procedure Create (
Object : in out context_base'Class;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t) is
begin
Object.use_count := 1;
Object.base := System.Null_Address;
Object.nxt := null;
Object.flags := (
if stack_unwind = do_unwind then
flag_force_unwind
else
flag_dont_force_unwind);
System.Storage_Pools.Allocate (
alloc.all,
Object.base,
size,
16);
pragma Assert (Object.base /= System.Null_Address);
memset (
Object.ctx_caller'Address,
0,
Object.ctx_caller'Size / System.Storage_Unit);
memset (
Object.ctx_callee'Address,
0,
Object.ctx_callee'Size / System.Storage_Unit);
Object.ctx_callee.fc_stack.ss_base := Object.base;
Object.ctx_callee.fc_stack.ss_limit :=
Object.ctx_callee.fc_stack.ss_base - size;
if return_to_caller = do_return then
Object.flags := Object.flags or flag_do_return;
Object.ctx_callee.fc_link := detail_x86_64.boost_fcontext_t (
Object.ctx_caller)'Unrestricted_Access;
end if;
boost_fcontext_make (
Object.ctx_callee'Access,
trampoline'Access,
System.Storage_Elements.To_Integer (Object'Address));
end Create;
procedure Create (
Object : in out context_base'Class;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : ptr_t) is
begin
Object.use_count := 1;
Object.base := System.Null_Address;
Object.nxt := nxt;
intrusive_ptr_add_ref (nxt);
Object.flags := (
if stack_unwind = do_unwind then
flag_force_unwind
else
flag_dont_force_unwind);
System.Storage_Pools.Allocate (
alloc.all,
Object.base,
size,
16);
pragma Assert (Object.base /= System.Null_Address);
pragma Assert (not is_complete (nxt.all));
memset (
Object.ctx_caller'Address,
0,
Object.ctx_caller'Size / System.Storage_Unit);
memset (
Object.ctx_callee'Address,
0,
Object.ctx_callee'Size / System.Storage_Unit);
Object.ctx_callee.fc_stack.ss_base := Object.base;
Object.ctx_callee.fc_stack.ss_limit :=
Object.ctx_callee.fc_stack.ss_base - size;
Object.ctx_callee.fc_link := detail_x86_64.boost_fcontext_t (
nxt.ctx_callee)'Unrestricted_Access;
boost_fcontext_make (
Object.ctx_callee'Access,
trampoline'Access,
System.Storage_Elements.To_Integer (Object'Address));
end Create;
end context_base_Non_Primitives;
procedure cleanup (
Object : in out context_base;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class) is
begin
if not is_complete (Object)
and then (is_started (Object) or else is_resumed (Object))
and then unwind_requested (Object)
then
unwind_stack (Object);
end if;
declare
size : System.Storage_Elements.Storage_Count :=
System.Storage_Elements.Storage_Count (
System.Storage_Elements.To_Integer (
Object.ctx_callee.fc_stack.ss_base)
- System.Storage_Elements.To_Integer (
Object.ctx_callee.fc_stack.ss_limit));
begin
System.Storage_Pools.Deallocate (
alloc.all,
Object.base,
size,
16);
end;
end cleanup;
function unwind_requested (Object : context_base) return Boolean is
begin
return 0 /= (Object.flags and flag_force_unwind);
end unwind_requested;
function is_complete (Object : context_base) return Boolean is
begin
return 0 /= (Object.flags and flag_complete);
end is_complete;
function is_started (Object : context_base) return Boolean is
begin
return 0 /= (Object.flags and flag_started);
end is_started;
function is_resumed (Object : context_base) return Boolean is
begin
return 0 /= (Object.flags and flag_resumed);
end is_resumed;
function is_running (Object : context_base) return Boolean is
begin
return 0 /= (Object.flags and flag_running);
end is_running;
procedure start (
Object : in out context_base;
Result : out System.Storage_Elements.Integer_Address) is
begin
pragma Assert (not is_complete (Object));
pragma Assert (not is_started (Object));
pragma Assert (not is_running (Object));
Object.flags := Object.flags or flag_started;
Object.flags := Object.flags or flag_running;
Result := boost_fcontext_start (
Object.ctx_caller'Access,
Object.ctx_callee'Access);
end start;
procedure resume (
Object : in out context_base;
vp : System.Storage_Elements.Integer_Address;
Result : out System.Storage_Elements.Integer_Address) is
begin
pragma Assert (is_started (Object));
pragma Assert (not is_complete (Object));
pragma Assert (not is_running (Object));
Object.flags := Object.flags or flag_resumed;
Object.flags := Object.flags or flag_running;
Result := boost_fcontext_jump (
Object.ctx_caller'Access,
Object.ctx_callee'Access,
vp);
end resume;
procedure suspend (
Object : in out context_base;
vp : System.Storage_Elements.Integer_Address;
Result : out System.Storage_Elements.Integer_Address) is
begin
pragma Assert (not is_complete (Object));
pragma Assert (is_running (Object));
Object.flags := Object.flags and not flag_running;
Result := boost_fcontext_jump (
Object.ctx_callee'Access,
Object.ctx_caller'Access,
vp);
if 0 /= (Object.flags and flag_unwind_stack) then
raise forced_unwind;
end if;
end suspend;
procedure unwind_stack (Object : in out context_base) is
begin
pragma Assert (not is_complete (Object));
pragma Assert (not is_running (Object));
Object.flags := Object.flags or flag_unwind_stack;
boost_fcontext_jump (
Object.ctx_caller'Access,
Object.ctx_callee'Access,
0);
Object.flags := Object.flags and not flag_unwind_stack;
pragma Assert (is_complete (Object));
end unwind_stack;
procedure intrusive_ptr_add_ref (p : not null ptr_t) is
begin
p.use_count := p.use_count + 1;
end intrusive_ptr_add_ref;
procedure Free is new Ada.Unchecked_Deallocation (
context_base'Class,
ptr_t);
procedure intrusive_ptr_release (p : in out ptr_t) is
begin
if p /= null then
p.use_count := p.use_count - 1;
if p.use_count = 0 then
Free (p);
end if;
p := null;
end if;
end intrusive_ptr_release;
overriding procedure Finalize (Object : in out context_base) is
begin
intrusive_ptr_release (Object.nxt);
end Finalize;
type Outside is access procedure;
function Create (
fn : not null access procedure;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object
is
type Inside is access procedure;
function Cast is new Ada.Unchecked_Conversion (Inside, Outside);
begin
return Result : context_object do
Result.Fn := Cast (Fn);
Result.Allocator := alloc;
context_base_Non_Primitives.Create (
Result,
alloc,
size,
do_unwind,
do_return);
end return;
end Create;
overriding procedure Finalize (Object : in out context_object) is
pragma Suppress (Accessibility_Check);
begin
cleanup (Object, Object.Allocator);
Finalize (context_base (Object));
end Finalize;
overriding procedure exec (Object : in out context_object) is
begin
Object.Fn.all;
end exec;
package body A1 is
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object
is
type Inside is access procedure (A1 : A1_Type);
function Cast is new Ada.Unchecked_Conversion (Inside, Outside);
begin
return Result : context_object do
Result.Fn := Cast (fn);
Result.A1 := A1;
Result.Allocator := alloc;
context_base_Non_Primitives.Create (
Result,
alloc,
size,
do_unwind,
do_return);
end return;
end Create;
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : ptr_t)
return context_object
is
type Inside is access procedure (A1 : A1_Type);
function Cast is new Ada.Unchecked_Conversion (Inside, Outside);
begin
return Result : context_object do
Result.Fn := Cast (fn);
Result.A1 := A1;
Result.Allocator := alloc;
context_base_Non_Primitives.Create (
Result,
alloc,
size,
do_unwind,
nxt);
end return;
end Create;
procedure Finalize (Object : in out context_object) is
pragma Suppress (Accessibility_Check);
begin
cleanup (Object, Object.Allocator);
Finalize (context_base (Object));
end Finalize;
overriding procedure exec (Object : in out context_object) is
begin
Object.Fn.all (Object.A1);
end exec;
end A1;
package body A2 is
function Create (
fn : not null access procedure (A1 : A1_Type; A2 : A2_Type);
A1 : A1_Type;
A2 : A2_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object
is
type Inside is access procedure (A1 : A1_Type; A2 : A2_Type);
function Cast is new Ada.Unchecked_Conversion (Inside, Outside);
begin
return Result : context_object do
Result.Fn := Cast (fn);
Result.A1 := A1;
Result.A2 := A2;
Result.Allocator := alloc;
context_base_Non_Primitives.Create (
Result,
alloc,
size,
do_unwind,
do_return);
end return;
end Create;
procedure Finalize (Object : in out context_object) is
pragma Suppress (Accessibility_Check);
begin
cleanup (Object, Object.Allocator);
Finalize (context_base (Object));
end Finalize;
overriding procedure exec (Object : in out context_object) is
begin
Object.Fn.all (Object.A1, Object.A2);
end exec;
end A2;
end boost.contexts.detail;
Raw
boost-contexts-detail.ads
with Interfaces;
with boost.contexts.detail_x86_64; use boost.contexts.detail_x86_64;
package boost.contexts.detail
with Preelaborate
is
type boost_fcontext_t is new detail_x86_64.boost_fcontext_t;
---- context_base.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_DETAIL_CONTEXT_BASE_H
-- #define BOOST_CONTEXTS_DETAIL_CONTEXT_BASE_H
--
-- #include <algorithm>
-- #include <cstddef>
-- #include <cstdlib>
-- #include <cstring>
--
-- #include <boost/assert.hpp>
-- #include <boost/config.hpp>
-- #include <boost/cstdint.hpp>
-- #include <boost/intrusive_ptr.hpp>
-- #include <boost/utility.hpp>
--
-- #include <boost/context/detail/config.hpp>
-- #include <boost/context/fcontext.hpp>
-- #include <boost/context/flags.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
-- namespace detail {
--
-- struct forced_unwind {};
forced_unwind : exception;
--
-- template< typename Ctx >
-- void trampoline( intptr_t vp)
-- {
-- BOOST_ASSERT( vp);
--
-- Ctx * ctx( reinterpret_cast< Ctx * >( vp) );
--
-- try
-- { ctx->exec(); }
-- catch ( forced_unwind const&)
-- {
-- ctx->flags_ |= Ctx::flag_complete;
-- boost_fcontext_jump( & ctx->ctx_callee_, & ctx->ctx_caller_, 0);
-- }
-- catch (...)
-- { std::terminate(); }
--
-- ctx->flags_ |= Ctx::flag_complete;
--
-- // in order to return to the code invoked the context
-- // nxt_->caller_ hast to set to the first one
-- if ( ctx->nxt_)
-- {
-- Ctx * nxt( dynamic_cast< Ctx * >( ctx->nxt_.get() ) );
-- BOOST_ASSERT( nxt);
-- std::swap( nxt->ctx_caller_, ctx->ctx_caller_);
-- if ( 0 != ( nxt->flags_ & Ctx::flag_do_return) )
-- nxt->ctx_callee_.fc_link = & nxt->ctx_caller_;
-- nxt->flags_ |= Ctx::flag_running;
-- nxt->flags_ |= Ctx::flag_started;
-- }
-- }
procedure trampoline (vp : System.Storage_Elements.Integer_Address);
--
-- class context_base : private noncopyable
type context_base is tagged;
-- {
-- public:
-- typedef intrusive_ptr< context_base > ptr_t;
type ptr_t is access all context_base'Class;
--
-- template< typename Allocator >
-- context_base(
-- Allocator & alloc, std::size_t size,
-- flag_unwind_t do_unwind, flag_return_t do_return) :
-- use_count_( 0), base_( alloc.allocate( size) ), ctx_caller_(), ctx_callee_(), nxt_(),
-- flags_( stack_unwind == do_unwind ? flag_force_unwind : flag_dont_force_unwind)
-- {
-- BOOST_ASSERT( base_);
--
-- std::memset( & ctx_caller_, 0, sizeof( ctx_caller_) );
-- std::memset( & ctx_callee_, 0, sizeof( ctx_callee_) );
-- ctx_callee_.fc_stack.ss_base = base_;
-- ctx_callee_.fc_stack.ss_limit =
-- static_cast< char * >( ctx_callee_.fc_stack.ss_base) - size;
--
-- if ( return_to_caller == do_return)
-- {
-- flags_ |= flag_do_return;
-- ctx_callee_.fc_link = & ctx_caller_;
-- }
--
-- boost_fcontext_make(
-- & ctx_callee_, trampoline< context_base >, reinterpret_cast< intptr_t >( this) );
-- }
--
-- template< typename Allocator >
-- context_base( Allocator & alloc, std::size_t size, flag_unwind_t do_unwind, ptr_t nxt) :
-- use_count_( 0), base_( alloc.allocate( size) ), ctx_caller_(), ctx_callee_(), nxt_( nxt),
-- flags_( stack_unwind == do_unwind ? flag_force_unwind : flag_dont_force_unwind)
-- {
-- BOOST_ASSERT( base_);
-- BOOST_ASSERT( ! nxt_->is_complete() );
--
-- std::memset( & ctx_callee_, 0, sizeof( ctx_callee_) );
-- std::memset( & ctx_caller_, 0, sizeof( ctx_caller_) );
-- ctx_callee_.fc_stack.ss_base = base_;
-- ctx_callee_.fc_stack.ss_limit =
-- static_cast< char * >( ctx_callee_.fc_stack.ss_base) - size;
-- ctx_callee_.fc_link = & dynamic_pointer_cast< context_base >( nxt_)->ctx_callee_;
--
-- boost_fcontext_make(
-- & ctx_callee_, trampoline< context_base >, reinterpret_cast< intptr_t >( this) );
-- }
package context_base_Non_Primitives is
procedure Create (
Object : in out context_base'Class;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t);
procedure Create (
Object : in out context_base'Class;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : ptr_t);
end context_base_Non_Primitives;
--
-- virtual ~context_base() {}
--
-- template< typename Allocator >
-- void cleanup( Allocator & alloc)
-- {
-- if ( ! is_complete()
-- && ( is_started() || is_resumed() )
-- && ( unwind_requested() ) )
-- unwind_stack();
-- std::size_t size = static_cast< char * >( ctx_callee_.fc_stack.ss_base) -
-- static_cast< char * >( ctx_callee_.fc_stack.ss_limit);
-- alloc.deallocate( base_, size);
-- }
procedure cleanup (
Object : in out context_base;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class);
--
-- bool unwind_requested() const
-- { return 0 != ( flags_ & flag_force_unwind); }
function unwind_requested (Object : context_base) return Boolean;
--
-- bool is_complete() const
-- { return 0 != ( flags_ & flag_complete); }
function is_complete (Object : context_base) return Boolean;
--
-- bool is_started() const
-- { return 0 != ( flags_ & flag_started); }
function is_started (Object : context_base) return Boolean;
--
-- bool is_resumed() const
-- { return 0 != ( flags_ & flag_started); }
function is_resumed (Object : context_base) return Boolean;
--
-- bool is_running() const
-- { return 0 != ( flags_ & flag_running); }
function is_running (Object : context_base) return Boolean;
--
-- intptr_t start()
-- {
-- BOOST_ASSERT( ! is_complete() );
-- BOOST_ASSERT( ! is_started() );
-- BOOST_ASSERT( ! is_running() );
--
-- flags_ |= flag_started;
-- flags_ |= flag_running;
-- return boost_fcontext_start( & ctx_caller_, & ctx_callee_);
-- }
procedure start (
Object : in out context_base;
Result : out System.Storage_Elements.Integer_Address);
--
-- intptr_t resume( intptr_t vp)
-- {
-- BOOST_ASSERT( is_started() );
-- BOOST_ASSERT( ! is_complete() );
-- BOOST_ASSERT( ! is_running() );
--
-- flags_ |= flag_resumed;
-- flags_ |= flag_running;
-- return boost_fcontext_jump( & ctx_caller_, & ctx_callee_, vp);
-- }
procedure resume (
Object : in out context_base;
vp : System.Storage_Elements.Integer_Address;
Result : out System.Storage_Elements.Integer_Address);
--
-- intptr_t suspend( intptr_t vp)
-- {
-- BOOST_ASSERT( ! is_complete() );
-- BOOST_ASSERT( is_running() );
--
-- flags_ &= ~flag_running;
-- intptr_t res = boost_fcontext_jump( & ctx_callee_, & ctx_caller_, vp);
-- if ( 0 != ( flags_ & flag_unwind_stack) )
-- throw forced_unwind();
-- return res;
-- }
procedure suspend (
Object : in out context_base;
vp : System.Storage_Elements.Integer_Address;
Result : out System.Storage_Elements.Integer_Address);
--
-- void unwind_stack()
-- {
-- BOOST_ASSERT( ! is_complete() );
-- BOOST_ASSERT( ! is_running() );
--
-- flags_ |= flag_unwind_stack;
-- boost_fcontext_jump( & ctx_caller_, & ctx_callee_, 0);
-- flags_ &= ~flag_unwind_stack;
-- BOOST_ASSERT( is_complete() );
-- }
procedure unwind_stack (Object : in out context_base);
--
-- virtual void exec() = 0;
procedure exec (Object : in out context_base) is abstract;
--
-- friend inline void intrusive_ptr_add_ref( context_base * p)
-- { ++p->use_count_; }
procedure intrusive_ptr_add_ref (p : not null ptr_t);
--
-- friend inline void intrusive_ptr_release( context_base * p)
-- { if ( --p->use_count_ == 0) delete p; }
procedure intrusive_ptr_release (p : in out ptr_t);
--
-- private:
-- template< typename T >
-- friend void trampoline( intptr_t vp);
--
-- enum flag_t
-- {
-- flag_started = 1 << 1,
-- flag_resumed = 1 << 2,
-- flag_running = 1 << 3,
-- flag_complete = 1 << 4,
-- flag_unwind_stack = 1 << 5,
-- flag_force_unwind = 1 << 6,
-- flag_dont_force_unwind = 1 << 7,
-- flag_do_return = 1 << 8,
-- };
flag_started : constant := 2 ** 1;
flag_resumed : constant := 2 ** 2;
flag_running : constant := 2 ** 3;
flag_complete : constant := 2 ** 4;
flag_unwind_stack : constant := 2 ** 5;
flag_force_unwind : constant := 2 ** 6;
flag_dont_force_unwind : constant := 2 ** 7;
flag_do_return : constant := 2 ** 8;
--
-- std::size_t use_count_;
-- void * base_;
-- boost_fcontext_t ctx_caller_;
-- boost_fcontext_t ctx_callee_;
-- ptr_t nxt_;
-- short flags_;
-- };
type context_base is
abstract limited new Ada.Finalization.Limited_Controlled with
record
use_count : Natural;
base : System.Address;
ctx_caller : aliased boost_fcontext_t;
ctx_callee : aliased boost_fcontext_t;
nxt : ptr_t;
flags : Interfaces.Unsigned_16;
end record;
overriding procedure Finalize (Object : in out context_base);
--
-- }}}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_DETAIL_CONTEXT_BASE_H
---- context_object.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_DETAIL_CONTEXT_OBJECT_H
-- #define BOOST_CONTEXTS_DETAIL_CONTEXT_OBJECT_H
--
-- #include <cstddef>
--
-- #include <boost/assert.hpp>
-- #include <boost/config.hpp>
-- #include <boost/move/move.hpp>
-- #include <boost/type_traits/remove_reference.hpp>
-- #include <boost/utility/base_from_member.hpp>
--
-- #include <boost/context/detail/config.hpp>
-- #include <boost/context/detail/context_base.hpp>
-- #include <boost/context/flags.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
-- namespace detail {
--
-- template< typename Fn, typename Allocator >
-- class context_object : private base_from_member< Fn >,
-- private base_from_member< Allocator >,
-- public context_base
type context_object is tagged;
type context_object is new context_base with record
Fn : access procedure;
Allocator : access System.Storage_Pools.Root_Storage_Pool'Class;
end record;
-- {
-- private:
-- typedef base_from_member< Fn > fn_t;
-- typedef base_from_member< Allocator > alloc_t;
--
-- context_object( context_object &);
-- context_object & operator=( context_object const&);
--
-- public:
-- #ifndef BOOST_NO_RVALUE_REFERENCES
-- context_object( Fn & fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
--
-- context_object( Fn & fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
--
-- context_object( Fn && fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( static_cast< Fn && >( fn) ), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
--
-- context_object( Fn && fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( static_cast< Fn && >( fn) ), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
-- #else
-- context_object( Fn fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
function Create (
fn : not null access procedure;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object;
--
-- context_object( Fn fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
--
-- context_object( BOOST_RV_REF( Fn) fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
--
-- context_object( BOOST_RV_REF( Fn) fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
-- #endif
--
-- ~context_object()
-- { cleanup( alloc_t::member); }
overriding procedure Finalize (Object : in out context_object);
--
-- void exec()
-- { fn_t::member(); }
overriding procedure exec (Object : in out context_object);
-- };
--
-- template< typename Fn, typename Allocator >
-- class context_object< reference_wrapper< Fn >, Allocator > : private base_from_member< Fn & >,
-- private base_from_member< Allocator >,
-- public context_base
-- {
-- private:
-- typedef base_from_member< Fn & > fn_t;
-- typedef base_from_member< Allocator > alloc_t;
--
-- context_object( context_object &);
-- context_object & operator=( context_object const&);
--
-- public:
-- context_object( reference_wrapper< Fn > fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
--
-- context_object( reference_wrapper< Fn > fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
--
-- ~context_object()
-- { cleanup( alloc_t::member); }
--
-- void exec()
-- { fn_t::member(); }
-- };
--
-- template< typename Fn, typename Allocator >
-- class context_object< const reference_wrapper< Fn >, Allocator > : private base_from_member< Fn & >,
-- private base_from_member< Allocator >,
-- public context_base
-- {
-- private:
-- typedef base_from_member< Fn & > fn_t;
-- typedef base_from_member< Allocator > alloc_t;
--
-- context_object( context_object &);
-- context_object & operator=( context_object const&);
--
-- public:
-- context_object( const reference_wrapper< Fn > fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, do_return)
-- {}
--
-- context_object( const reference_wrapper< Fn > fn, Allocator const& alloc, std::size_t size, flag_unwind_t do_unwind, typename context_base::ptr_t nxt) :
-- fn_t( fn), alloc_t( alloc),
-- context_base( alloc_t::member, size, do_unwind, nxt)
-- {}
--
-- ~context_object()
-- { cleanup( alloc_t::member); }
--
-- void exec()
-- { fn_t::member(); }
-- };
generic
type A1_Type is private;
package A1 is
type Outside is access procedure (A1 : A1_Type);
type context_object is new context_base with record
Fn : Outside;
A1 : A1_Type;
Allocator : access System.Storage_Pools.Root_Storage_Pool'Class;
end record;
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object;
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : ptr_t)
return context_object;
overriding procedure Finalize (Object : in out context_object);
overriding procedure exec (Object : in out context_object);
end A1;
generic
type A1_Type is private;
type A2_Type is private;
package A2 is
type Outside is access procedure (A1 : A1_Type; A2 : A2_Type);
type context_object is new context_base with record
Fn : Outside;
A1 : A1_Type;
A2 : A2_Type;
Allocator : access System.Storage_Pools.Root_Storage_Pool'Class;
end record;
function Create (
fn : not null access procedure (A1 : A1_Type; A2 : A2_Type);
A1 : A1_Type;
A2 : A2_Type;
alloc : not null access System.Storage_Pools.Root_Storage_Pool'Class;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t)
return context_object;
overriding procedure Finalize (Object : in out context_object);
overriding procedure exec (Object : in out context_object);
end A2;
--
-- }}}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_DETAIL_CONTEXT_OBJECT_H
end boost.contexts.detail;
Raw
boost-contexts-detail_x86_64.ads
with Interfaces;
package boost.contexts.detail_x86_64
with Preelaborate
is
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_DETAIL_FCONTEXT_X86_64_H
-- #define BOOST_CONTEXTS_DETAIL_FCONTEXT_X86_64_H
--
-- #include <boost/config.hpp>
-- #include <boost/cstdint.hpp>
--
-- #include <boost/context/detail/config.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- extern "C" {
--
-- #define BOOST_CONTEXT_CALLDECL
--
-- typedef struct boost_fcontext_stack boost_fcontext_stack_t;
-- struct boost_fcontext_stack
-- {
-- void * ss_base;
-- void * ss_limit;
-- };
type boost_fcontext_stack_t is record
ss_base : System.Address;
ss_limit : System.Address;
end record;
--
-- typedef struct boost_fcontext boost_fcontext_t;
-- struct boost_fcontext
-- {
-- boost::uint64_t fc_greg[8];
-- boost::uint32_t fc_freg[2];
-- boost_fcontext_stack_t fc_stack;
-- boost_fcontext_t * fc_link;
-- };
type Unsigned_64_Array_8 is array (0 .. 7) of Interfaces.Unsigned_64;
type Unsigned_32_Array_2 is array (0 .. 1) of Interfaces.Unsigned_32;
type boost_fcontext_t is record
fc_greg : Unsigned_64_Array_8;
fc_freg : Unsigned_32_Array_2;
fc_stack : boost_fcontext_stack_t;
fc_link : access boost_fcontext_t;
end record;
--
-- }
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_DETAIL_FCONTEXT_X86_64_H
end boost.contexts.detail_x86_64;
Raw
boost-contexts-fcontext.adb
separate (boost.contexts)
package body fcontext is
use type System.Storage_Elements.Integer_Address;
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #define BOOST_CONTEXT_SOURCE
--
-- #include <boost/context/fcontext.hpp>
--
-- #include <cstddef>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
--
-- extern "C" BOOST_CONTEXT_DECL void * BOOST_CONTEXT_CALLDECL boost_fcontext_align( void * vp)
-- {
-- void * base = vp;
-- if ( 0 != ( ( ( uintptr_t) base) & 15) )
-- base = ( char * )(
-- ( ( ( ( uintptr_t) base) - 16) >> 4) << 4);
-- return base;
-- }
function boost_fcontext_align (vp : System.Address)
return System.Address is
begin
return base : System.Address := vp do
if 0 /= (System.Storage_Elements.To_Integer (base) and 15) then
base := System.Storage_Elements.To_Address (
System.Storage_Elements.To_Integer (base) and not 15);
-- "- 16" is noise.
end if;
end return;
end boost_fcontext_align;
--
-- # if !defined(__arm__) && !defined(__powerpc__)
-- extern "C" BOOST_CONTEXT_DECL intptr_t BOOST_CONTEXT_CALLDECL boost_fcontext_start( boost_fcontext_t * ofc, boost_fcontext_t const* nfc)
-- { return boost_fcontext_jump( ofc, nfc, 0); }
-- #endif
function boost_fcontext_start (
ofc : access detail.boost_fcontext_t;
nfc : access constant detail.boost_fcontext_t)
return System.Storage_Elements.Integer_Address is
begin
return boost_fcontext_jump (ofc, nfc, 0);
end boost_fcontext_start;
--
-- }}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
end fcontext;
Raw
boost-contexts-stack_allocator_posix.adb
with C.sys.mman;
separate (boost.contexts)
package body stack_allocator_posix is
use type System.Address;
use type System.Storage_Elements.Storage_Offset;
use type C.signed_int;
use type C.unsigned_int;
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #define BOOST_CONTEXT_SOURCE
--
-- #include <boost/context/stack_allocator.hpp>
--
-- extern "C" {
-- #include <fcntl.h>
-- #include <sys/mman.h>
-- #include <sys/stat.h>
-- #include <sys/types.h>
-- #include <unistd.h>
-- }
--
-- #include <stdexcept>
--
-- #include <boost/config.hpp>
-- #include <boost/assert.hpp>
-- #include <boost/format.hpp>
--
-- #include <boost/context/stack_utils.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
--
-- void *
-- stack_allocator::allocate( std::size_t size) const
-- {
-- if ( minimum_stacksize() > size)
-- throw std::invalid_argument(
-- boost::str( boost::format("invalid stack size: must be at least %d bytes")
-- % minimum_stacksize() ) );
--
-- if ( ! is_stack_unbound() && ( maximum_stacksize() < size) )
-- throw std::invalid_argument(
-- boost::str( boost::format("invalid stack size: must not be larger than %d bytes")
-- % maximum_stacksize() ) );
--
-- const std::size_t pages( page_count( size) + 1); // add +1 for guard page
-- std::size_t size_ = pages * pagesize();
--
-- const int fd( ::open("/dev/zero", O_RDONLY) );
-- BOOST_ASSERT( -1 != fd);
-- void * limit =
-- # if defined(macintosh) || defined(__APPLE__) || defined(__APPLE_CC__)
-- ::mmap( 0, size_, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0);
-- # else
-- ::mmap( 0, size_, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
-- # endif
-- ::close( fd);
-- if ( ! limit) throw std::bad_alloc();
--
-- const int result( ::mprotect( limit, pagesize(), PROT_NONE) );
-- BOOST_ASSERT( 0 == result);
--
-- return static_cast< char * >( limit) + size_;
-- }
function allocate (size : System.Storage_Elements.Storage_Count)
return System.Address is
begin
if minimum_stacksize > size then
raise Constraint_Error with
"invalid stack size: must be at least"
& System.Storage_Elements.Storage_Count'Image (minimum_stacksize)
& " bytes";
end if;
if not is_stack_unbound and then maximum_stacksize < size then
raise Constraint_Error with
"invalid stack size: must not be larger than"
& System.Storage_Elements.Storage_Count'Image (maximum_stacksize)
& " bytes";
end if;
declare
pages : System.Storage_Elements.Storage_Count :=
page_count(size) + 1;
Real_size : System.Storage_Elements.Storage_Count :=
pages * pagesize;
limit : System.Address := C.sys.mman.mmap (
System.Null_Address,
C.size_t (Real_size),
C.signed_int (C.unsigned_int'(
C.sys.mman.PROT_READ or C.sys.mman.PROT_WRITE)),
C.signed_int (C.unsigned_int'(
C.sys.mman.MAP_PRIVATE or C.sys.mman.MAP_ANON)),
-1,
0);
begin
if limit = System.Null_Address then
raise Storage_Error;
end if;
declare
result : C.signed_int := C.sys.mman.mprotect (
limit,
C.size_t (pagesize),
C.sys.mman.PROT_NONE);
begin
pragma Assert (0 = result);
end;
return limit + Real_size;
end;
end allocate;
--
-- void
-- stack_allocator::deallocate( void * vp, std::size_t size) const
-- {
-- if ( vp)
-- {
-- const std::size_t pages( page_count( size) + 1); // add +1 for guard page
-- std::size_t size_ = pages * pagesize();
-- BOOST_ASSERT( 0 < size && 0 < size_);
-- void * limit = static_cast< char * >( vp) - size_;
-- ::munmap( limit, size_);
-- }
-- }
procedure deallocate (
vp : System.Address;
size : System.Storage_Elements.Storage_Count) is
begin
if vp /= System.Null_Address then
declare
pages : System.Storage_Elements.Storage_Count :=
page_count(size) + 1;
Real_size : System.Storage_Elements.Storage_Count :=
pages * pagesize;
pragma Assert (0 < size and then 0 < Real_size);
limit : System.Address := vp - Real_size;
dummy : C.signed_int;
begin
dummy := C.sys.mman.munmap (limit, C.size_t (Real_size));
end;
end if;
end deallocate;
--
-- }}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
end stack_allocator_posix;
Raw
boost-contexts-stack_utils_posix.adb
with C.sys.resource;
with C.sys.signal;
with C.unistd;
separate (boost.contexts)
package body stack_utils_posix is
use type System.Storage_Elements.Storage_Offset;
use type C.signed_int;
use type C.unsigned_long_long;
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #define BOOST_CONTEXT_SOURCE
--
-- #include <boost/context/stack_utils.hpp>
--
-- extern "C" {
-- #include <sys/resource.h>
-- #include <sys/time.h>
-- #include <unistd.h>
-- }
--
-- #include <cmath>
-- #include <csignal>
--
-- #include <boost/assert.hpp>
--
-- namespace {
--
-- static rlimit stacksize_limit_()
-- {
-- rlimit limit;
-- const int result = ::getrlimit( RLIMIT_STACK, & limit);
-- BOOST_ASSERT( 0 == result);
-- return limit;
-- }
--
-- static rlimit stacksize_limit()
-- {
-- static rlimit limit = stacksize_limit_();
-- return limit;
-- }
limit : aliased C.sys.resource.struct_rlimit;
limit_Initialized : Boolean := False;
function stacksize_limit return C.sys.resource.struct_rlimit is
begin
if not limit_Initialized then
limit_Initialized := True;
declare
result : C.signed_int := C.sys.resource.getrlimit (
C.sys.resource.RLIMIT_STACK,
limit'Access);
begin
pragma Assert (0 = result);
end;
end if;
return limit;
end stacksize_limit;
--
-- }
--
-- namespace boost {
-- namespace contexts {
--
-- BOOST_CONTEXT_DECL
-- std::size_t default_stacksize()
-- {
-- static std::size_t size = 256 * 1024;
-- return size;
-- }
function default_stacksize return System.Storage_Elements.Storage_Count is
begin
return 256 * 1024;
end default_stacksize;
--
-- BOOST_CONTEXT_DECL
-- std::size_t minimum_stacksize()
-- { return SIGSTKSZ; }
function minimum_stacksize return System.Storage_Elements.Storage_Count is
begin
return C.sys.signal.SIGSTKSZ;
end minimum_stacksize;
--
-- BOOST_CONTEXT_DECL
-- std::size_t maximum_stacksize()
-- {
-- BOOST_ASSERT( ! is_stack_unbound() );
-- return static_cast< std::size_t >( stacksize_limit().rlim_max);
-- }
function maximum_stacksize return System.Storage_Elements.Storage_Count is
begin
pragma Assert (not is_stack_unbound);
return System.Storage_Elements.Storage_Count (stacksize_limit.rlim_max);
end maximum_stacksize;
--
-- BOOST_CONTEXT_DECL
-- bool is_stack_unbound()
-- { return RLIM_INFINITY == stacksize_limit().rlim_max; }
function is_stack_unbound return Boolean is
begin
return C.sys.resource.RLIM_INFINITY = stacksize_limit.rlim_max;
end is_stack_unbound;
--
-- BOOST_CONTEXT_DECL
-- std::size_t pagesize()
-- {
-- static std::size_t pagesize( ::getpagesize() );
-- return pagesize;
-- }
function pagesize return System.Storage_Elements.Storage_Count is
begin
return System.Storage_Elements.Storage_Count (C.unistd.getpagesize);
end pagesize;
--
-- BOOST_CONTEXT_DECL
-- std::size_t page_count( std::size_t stacksize)
-- {
-- return static_cast< std::size_t >(
-- std::ceil(
-- static_cast< float >( stacksize) / pagesize() ) );
-- }
--
-- }}
function page_count (stacksize : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count
is
Unit : System.Storage_Elements.Storage_Count := pagesize;
begin
return (stacksize + Unit - 1) / Unit; -- not float
end page_count;
end stack_utils_posix;
Raw
boost-contexts.adb
with boost.contexts.detail;
package body boost.contexts is
package fcontext is
function boost_fcontext_align (vp : System.Address)
return System.Address;
pragma Export (C, boost_fcontext_align);
function boost_fcontext_start (
ofc : access detail.boost_fcontext_t;
nfc : access constant detail.boost_fcontext_t)
return System.Storage_Elements.Integer_Address;
pragma Export (C, boost_fcontext_start);
end fcontext;
package body fcontext is separate;
package stack_allocator_posix is
function allocate (size : System.Storage_Elements.Storage_Count)
return System.Address;
procedure deallocate (
vp : System.Address;
size : System.Storage_Elements.Storage_Count);
end stack_allocator_posix;
package body stack_allocator_posix is separate;
package stack_allocator renames stack_allocator_posix;
overriding procedure Allocate (
Pool : in out stack_allocator_Type;
Storage_Address : out System.Address;
Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count) is
begin
Storage_Address := stack_allocator.allocate (Size_In_Storage_Elements);
end Allocate;
overriding procedure Deallocate (
Pool : in out stack_allocator_Type;
Storage_Address : System.Address;
Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count) is
begin
stack_allocator.deallocate (Storage_Address, Size_In_Storage_Elements);
end Deallocate;
Shared_stack_allocator : access stack_allocator_Type := null;
function Get_stack_allocator
return not null access stack_allocator_Type'Class is
begin
if Shared_stack_allocator = null then
Shared_stack_allocator := new stack_allocator_Type;
end if;
return Shared_stack_allocator;
end Get_stack_allocator;
package stack_utils_posix is
function default_stacksize return System.Storage_Elements.Storage_Count;
function minimum_stacksize return System.Storage_Elements.Storage_Count;
function maximum_stacksize return System.Storage_Elements.Storage_Count;
function pagesize return System.Storage_Elements.Storage_Count;
function page_count (stacksize : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count;
function is_stack_unbound return Boolean;
end stack_utils_posix;
package body stack_utils_posix is separate;
package stack_utils renames stack_utils_posix;
function default_stacksize return System.Storage_Elements.Storage_Count
renames stack_utils.default_stacksize;
function minimum_stacksize return System.Storage_Elements.Storage_Count
renames stack_utils.minimum_stacksize;
function maximum_stacksize return System.Storage_Elements.Storage_Count
renames stack_utils.maximum_stacksize;
function pagesize return System.Storage_Elements.Storage_Count
renames stack_utils.pagesize;
function page_count (stacksize : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count
renames stack_utils.page_count;
function is_stack_unbound return Boolean
renames stack_utils.is_stack_unbound;
function Create (
fn : not null access procedure;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class := Get_stack_allocator)
return context is
begin
return (Ada.Finalization.Limited_Controlled with
impl => new detail.context_object'(detail.Create (
fn,
Allocator,
size,
do_unwind,
do_return)));
end Create;
package body A1 is
package A1_detail is new detail.A1 (A1_Type);
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class :=
Get_stack_allocator)
return context
is
impl : access A1_detail.context_object :=
new A1_detail.context_object'(A1_detail.Create (
fn,
A1,
Allocator,
size,
do_unwind,
do_return));
begin
return (Ada.Finalization.Limited_Controlled with
impl => base_ptr_t (impl));
end Create;
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : context;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class :=
Get_stack_allocator)
return context
is
impl : access A1_detail.context_object :=
new A1_detail.context_object'(A1_detail.Create (
fn,
A1,
Allocator,
size,
do_unwind,
detail.ptr_t (nxt.impl)));
begin
return (Ada.Finalization.Limited_Controlled with
impl => base_ptr_t (impl));
end Create;
end A1;
package body A2 is
package A2_detail is new detail.A2 (A1_Type, A2_Type);
function Create (
fn : not null access procedure (A1 : A1_Type; A2 : A2_Type);
A1 : A1_Type;
A2 : A2_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class
:= Get_stack_allocator)
return context
is
impl : access A2_detail.context_object :=
new A2_detail.context_object'(A2_detail.Create (
fn,
A1,
A2,
Allocator,
size,
do_unwind,
do_return));
begin
return (Ada.Finalization.Limited_Controlled with
impl => base_ptr_t (impl));
end Create;
end A2;
procedure Move (Target, Source : in out context) is
begin
Finalize (Target);
Target.impl := Source.impl;
Source.impl := null;
end Move;
function Valid (Object : context) return Boolean is
begin
return Object.impl /= null;
end Valid;
procedure start (
Object : in out context;
Result : out System.Storage_Elements.Integer_Address) is
begin
detail.start (Object.impl.all, Result);
end start;
procedure start (
Object : in out context)
is
Dummy : System.Storage_Elements.Integer_Address;
begin
start (Object, Dummy);
end start;
procedure resume (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0;
Result : out System.Storage_Elements.Integer_Address) is
begin
detail.resume (Object.impl.all, vp, Result);
end resume;
procedure resume (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0)
is
Dummy : System.Storage_Elements.Integer_Address;
begin
resume (Object, vp, Dummy);
end resume;
procedure suspend (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0;
Result : out System.Storage_Elements.Integer_Address) is
begin
detail.suspend (Object.impl.all, vp, Result);
end suspend;
procedure suspend (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0)
is
Dummy : System.Storage_Elements.Integer_Address;
begin
suspend (Object, vp, Dummy);
end suspend;
procedure unwind_stack (Object : in out context) is
begin
detail.unwind_stack (Object.impl.all);
end unwind_stack;
function is_complete (Object : context) return Boolean is
begin
return detail.is_complete (Object.impl.all);
end is_complete;
-- static base_ptr_t make_context_(
-- void( * fn)(), std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc)
-- {
-- return base_ptr_t(
-- new detail::context_object< void(*)(), Allocator >(
-- fn, alloc, size, do_unwind, do_return) );
-- }
overriding procedure Finalize (Object : in out context) is
begin
detail.intrusive_ptr_release (detail.ptr_t (Object.impl));
end Finalize;
end boost.contexts;
Raw
boost-contexts.ads
with Ada.Finalization;
with System.Storage_Elements;
with System.Storage_Pools;
limited with boost.contexts.detail;
package boost.contexts
with Preelaborate
is
---- flags.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_FLAGS_H
-- #define BOOST_CONTEXTS_FLAGS_H
--
-- namespace boost {
-- namespace contexts {
--
-- enum flag_unwind_t
-- {
-- stack_unwind = 0,
-- no_stack_unwind
-- };
type flag_unwind_t is (stack_unwind, no_stack_unwind);
--
-- enum flag_return_t
-- {
-- return_to_caller = 0,
-- exit_application
-- };
type flag_return_t is (return_to_caller, exit_application);
--
-- }}
--
-- #endif // BOOST_CONTEXTS_FLAGS_H
---- stack_allocator.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_STACK_ALLOCATOR_H
-- #define BOOST_CONTEXTS_STACK_ALLOCATOR_H
--
-- #include <cstddef>
--
-- #include <boost/config.hpp>
--
-- #include <boost/context/detail/config.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
--
-- class BOOST_CONTEXT_DECL stack_allocator
-- {
-- public:
-- void * allocate( std::size_t) const;
--
-- void deallocate( void *, std::size_t) const;
-- };
--
-- }}
type stack_allocator_Type is new System.Storage_Pools.Root_Storage_Pool with
null record;
overriding procedure Allocate (
Pool : in out stack_allocator_Type;
Storage_Address : out System.Address;
Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
overriding procedure Deallocate (
Pool : in out stack_allocator_Type;
Storage_Address : System.Address;
Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
overriding function Storage_Size (Pool : stack_allocator_Type)
return System.Storage_Elements.Storage_Count
is (System.Storage_Elements.Storage_Count'Last);
function Get_stack_allocator
return not null access stack_allocator_Type'Class;
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_STACK_ALLOCATOR_H
---- stack_utils.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_STACK_UTILS_H
-- #define BOOST_CONTEXTS_STACK_UTILS_H
--
-- #include <cstddef>
--
-- #include <boost/config.hpp>
--
-- #include <boost/context/detail/config.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
--
-- BOOST_CONTEXT_DECL std::size_t default_stacksize();
function default_stacksize return System.Storage_Elements.Storage_Count;
--
-- BOOST_CONTEXT_DECL std::size_t minimum_stacksize();
function minimum_stacksize return System.Storage_Elements.Storage_Count;
--
-- BOOST_CONTEXT_DECL std::size_t maximum_stacksize();
function maximum_stacksize return System.Storage_Elements.Storage_Count;
--
-- BOOST_CONTEXT_DECL std::size_t pagesize();
function pagesize return System.Storage_Elements.Storage_Count;
--
-- BOOST_CONTEXT_DECL std::size_t page_count( std::size_t stacksize);
function page_count (stacksize : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count;
--
-- BOOST_CONTEXT_DECL bool is_stack_unbound();
function is_stack_unbound return Boolean;
--
-- }}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_STACK_UTILS_H
---- fcontext.hpp ---
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_FCONTEXT_H
-- #define BOOST_CONTEXTS_FCONTEXT_H
--
-- #include <boost/config.hpp>
-- #include <boost/cstdint.hpp>
--
-- #include <boost/context/detail/config.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- // Windows
-- #if defined(BOOST_WINDOWS)
-- // i386
-- # if defined(_WIN32) && ! defined(_WIN64)
-- # include <boost/context/detail/fcontext_i386_win.hpp>
-- // x86_64
-- # elif defined(_WIN32) && defined(_WIN64)
-- # include <boost/context/detail/fcontext_x86_64_win.hpp>
-- # else
-- # error "platform not supported"
-- # endif
-- // POSIX
-- #else
-- // i386
-- # if defined(__i386__)
-- # include <boost/context/detail/fcontext_i386.hpp>
-- // x86_64
-- # elif defined(__x86_64__)
-- # include <boost/context/detail/fcontext_x86_64.hpp>
-- // arm
-- # elif defined(__arm__)
-- # include <boost/context/detail/fcontext_arm.hpp>
-- // mips
-- # elif defined(__mips__)
-- # include <boost/context/detail/fcontext_mips.hpp>
-- // powerpc
-- # elif defined(__powerpc__)
-- # include <boost/context/detail/fcontext_ppc.hpp>
-- # else
-- # error "platform not supported"
-- # endif
-- #endif
--
-- extern "C" BOOST_CONTEXT_DECL void * BOOST_CONTEXT_CALLDECL boost_fcontext_align( void * vp);
-- extern "C" BOOST_CONTEXT_DECL intptr_t BOOST_CONTEXT_CALLDECL boost_fcontext_start( boost_fcontext_t * ofc, boost_fcontext_t const* nfc);
function boost_fcontext_start (
ofc : access detail.boost_fcontext_t;
nfc : access constant detail.boost_fcontext_t)
return System.Storage_Elements.Integer_Address;
pragma Import (C, boost_fcontext_start);
-- extern "C" BOOST_CONTEXT_DECL intptr_t BOOST_CONTEXT_CALLDECL boost_fcontext_jump( boost_fcontext_t * ofc, boost_fcontext_t const* nfc, intptr_t vp);
function boost_fcontext_jump (
ofc : access detail.boost_fcontext_t;
nfc : access constant detail.boost_fcontext_t;
vp : System.Storage_Elements.Integer_Address)
return System.Storage_Elements.Integer_Address;
procedure boost_fcontext_jump (
ofc : access detail.boost_fcontext_t;
nfc : access constant detail.boost_fcontext_t;
vp : System.Storage_Elements.Integer_Address);
pragma Import (C, boost_fcontext_jump);
-- extern "C" BOOST_CONTEXT_DECL void BOOST_CONTEXT_CALLDECL boost_fcontext_make( boost_fcontext_t * fc, void (* fn)( intptr_t), intptr_t vp);
procedure boost_fcontext_make (
fc : access detail.boost_fcontext_t;
fn : access procedure (A1 : System.Storage_Elements.Integer_Address);
vp : System.Storage_Elements.Integer_Address);
pragma Import (C, boost_fcontext_make);
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_FCONTEXT_H
---- context.hpp ----
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
-- #ifndef BOOST_CONTEXTS_CONTEXT_H
-- #define BOOST_CONTEXTS_CONTEXT_H
--
-- #include <boost/assert.hpp>
-- #include <boost/bind.hpp>
-- #include <boost/config.hpp>
-- #include <boost/cstdint.hpp>
-- #include <boost/move/move.hpp>
-- #include <boost/preprocessor/repetition.hpp>
-- #include <boost/type_traits/is_convertible.hpp>
-- #include <boost/type_traits/remove_reference.hpp>
-- #include <boost/utility/enable_if.hpp>
--
-- #include <boost/context/detail/context_base.hpp>
-- #include <boost/context/detail/context_object.hpp>
-- #include <boost/context/flags.hpp>
-- #include <boost/context/stack_allocator.hpp>
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_PREFIX
-- #endif
--
-- namespace boost {
-- namespace contexts {
--
-- class context
-- {
-- private:
-- typedef detail::context_base::ptr_t base_ptr_t;
type base_ptr_t is access all detail.context_base'Class;
--
-- base_ptr_t impl_;
--
-- BOOST_MOVABLE_BUT_NOT_COPYABLE( context);
type context is limited new Ada.Finalization.Limited_Controlled with record
impl : base_ptr_t := null;
end record;
--
-- #ifndef BOOST_NO_RVALUE_REFERENCES
-- template< typename Allocator >
-- static base_ptr_t make_context_(
-- void( * fn)(), std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc)
-- {
-- return base_ptr_t(
-- new detail::context_object< void(*)(), Allocator >(
-- fn, alloc, size, do_unwind, do_return) );
-- }
--
-- template< typename Allocator >
-- static base_ptr_t make_context_(
-- void( * fn)(), std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc)
-- {
-- BOOST_ASSERT( nxt);
-- return base_ptr_t(
-- new detail::context_object< void(*)(), Allocator >(
-- fn, alloc, size, do_unwind, nxt.impl_) );
-- }
--
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- Fn && fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc)
-- {
-- return base_ptr_t(
-- new detail::context_object< typename remove_reference< Fn >::type, Allocator >(
-- fn, alloc, size, do_unwind, do_return) );
-- }
--
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- Fn && fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc)
-- {
-- BOOST_ASSERT( nxt);
-- return base_ptr_t(
-- new detail::context_object< typename remove_reference< Fn >::type, Allocator >(
-- fn, alloc, size, do_unwind, nxt.impl_) );
-- }
-- #else
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- Fn fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc)
-- {
-- return base_ptr_t(
-- new detail::context_object< Fn, Allocator >(
-- fn, alloc, size, do_unwind, do_return) );
-- }
--
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- Fn fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc)
-- {
-- BOOST_ASSERT( nxt);
-- return base_ptr_t(
-- new detail::context_object< Fn, Allocator >(
-- fn, alloc, size, do_unwind, nxt.impl_) );
-- }
--
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc)
-- {
-- return base_ptr_t(
-- new detail::context_object< Fn, Allocator >(
-- fn, alloc, size, do_unwind, do_return) );
-- }
--
-- template< typename Fn, typename Allocator >
-- static base_ptr_t make_context_(
-- BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc)
-- {
-- BOOST_ASSERT( nxt);
-- return base_ptr_t(
-- new detail::context_object< Fn, Allocator >(
-- fn, alloc, size, do_unwind, nxt.impl_) );
-- }
-- #endif
--
-- public:
-- typedef void ( * unspecified_bool_type)( context ***);
--
-- static void unspecified_bool( context ***) {}
--
-- context() :
-- impl_()
-- {}
--
-- #ifndef BOOST_NO_RVALUE_REFERENCES
-- # ifdef BOOST_MSVC
-- template< typename Fn >
-- context( Fn & fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- impl_( make_context_( static_cast< Fn & >( fn), size, do_unwind, do_return, stack_allocator() ) )
-- {}
function Create (
fn : not null access procedure;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class := Get_stack_allocator)
return context;
--
-- template< typename Fn, typename Allocator >
-- context( Fn & fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc) :
-- impl_( make_context_( static_cast< Fn & >( fn), size, do_unwind, do_return, alloc) )
-- {}
--
-- template< typename Fn >
-- context( Fn & fn, std::size_t size, flag_unwind_t do_unwind, context & nxt) :
-- impl_( make_context_( static_cast< Fn & >( fn), size, do_unwind, nxt, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( Fn & fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc) :
-- impl_( make_context_( static_cast< Fn & >( fn), size, do_unwind, nxt, alloc) )
-- {}
-- # endif
-- template< typename Fn >
-- context( Fn && fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- impl_( make_context_( static_cast< Fn && >( fn), size, do_unwind, do_return, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( Fn && fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc) :
-- impl_( make_context_( static_cast< Fn && >( fn), size, do_unwind, do_return, alloc) )
-- {}
--
-- template< typename Fn >
-- context( Fn && fn, std::size_t size, flag_unwind_t do_unwind, context & nxt) :
-- impl_( make_context_( static_cast< Fn && >( fn), size, do_unwind, nxt, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( Fn && fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc) :
-- impl_( make_context_( static_cast< Fn && >( fn), size, do_unwind, nxt, alloc) )
-- {}
-- #else
-- template< typename Fn >
-- context( Fn fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- impl_( make_context_( fn, size, do_unwind, do_return, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( Fn fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc) :
-- impl_( make_context_( fn, size, do_unwind, do_return, alloc) )
-- {}
--
-- template< typename Fn >
-- context( Fn fn, std::size_t size, flag_unwind_t do_unwind, context & nxt) :
-- impl_( make_context_( fn, size, do_unwind, nxt, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( Fn fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc) :
-- impl_( make_context_( fn, size, do_unwind, nxt, alloc) )
-- {}
--
-- template< typename Fn >
-- context( BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) :
-- impl_( make_context_( fn, size, do_unwind, do_return, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc) :
-- impl_( make_context_( fn, size, do_unwind, do_return, alloc) )
-- {}
--
-- template< typename Fn >
-- context( BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, context & nxt) :
-- impl_( make_context_( fn, size, do_unwind, nxt, stack_allocator() ) )
-- {}
--
-- template< typename Fn, typename Allocator >
-- context( BOOST_RV_REF( Fn) fn, std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc) :
-- impl_( make_context_( fn, size, do_unwind, nxt, alloc) )
-- {}
-- #endif
--
-- #define BOOST_CONTEXT_ARG(z, n, unused) BOOST_PP_CAT(A, n) BOOST_PP_CAT(a, n)
--
-- #define BOOST_CONTEXT_ARGS(n) BOOST_PP_ENUM(n, BOOST_CONTEXT_ARG, ~)
--
-- #define BOOST_CONTEXT_CTOR(z, n, unused) \
-- template< typename Fn, BOOST_PP_ENUM_PARAMS(n, typename A) > \
-- context( Fn fn, BOOST_CONTEXT_ARGS(n), std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return) : \
-- impl_( \
-- make_context_( \
-- boost::bind( boost::type< void >(), fn, BOOST_PP_ENUM_PARAMS(n, a) ), \
-- size, do_unwind, do_return, stack_allocator() ) ) \
-- {} \
-- \
-- template< typename Fn, typename Allocator, BOOST_PP_ENUM_PARAMS(n, typename A) > \
-- context( Fn fn, BOOST_CONTEXT_ARGS(n), std::size_t size, flag_unwind_t do_unwind, flag_return_t do_return, Allocator const& alloc) : \
-- impl_( \
-- make_context_( \
-- boost::bind( boost::type< void >(), fn, BOOST_PP_ENUM_PARAMS(n, a) ), \
-- size, do_unwind, do_return, alloc) ) \
-- {} \
-- \
-- template< typename Fn, BOOST_PP_ENUM_PARAMS(n, typename A) > \
-- context( Fn fn, BOOST_CONTEXT_ARGS(n), std::size_t size, flag_unwind_t do_unwind, context & nxt) : \
-- impl_( \
-- make_context_( \
-- boost::bind( boost::type< void >(), fn, BOOST_PP_ENUM_PARAMS(n, a) ), \
-- size, do_unwind, nxt, stack_allocator() ) ) \
-- {} \
-- \
-- template< typename Fn, typename Allocator, BOOST_PP_ENUM_PARAMS(n, typename A) > \
-- context( Fn fn, BOOST_CONTEXT_ARGS(n), std::size_t size, flag_unwind_t do_unwind, context & nxt, Allocator const& alloc) : \
-- impl_( \
-- make_context_( \
-- boost::bind( boost::type< void >(), fn, BOOST_PP_ENUM_PARAMS(n, a) ), \
-- size, do_unwind, nxt, alloc) ) \
-- {} \
--
-- #ifndef BOOST_CONTEXT_ARITY
-- #define BOOST_CONTEXT_ARITY 10
-- #endif
--
-- BOOST_PP_REPEAT_FROM_TO( 1, BOOST_CONTEXT_ARITY, BOOST_CONTEXT_CTOR, ~)
generic
type A1_Type is private;
package A1 is
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class :=
Get_stack_allocator)
return context;
function Create (
fn : not null access procedure (A1 : A1_Type);
A1 : A1_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
nxt : context;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class :=
Get_stack_allocator)
return context;
end A1;
generic
type A1_Type is private;
type A2_Type is private;
package A2 is
function Create (
fn : not null access procedure (A1 : A1_Type; A2 : A2_Type);
A1 : A1_Type;
A2 : A2_Type;
size : System.Storage_Elements.Storage_Count;
do_unwind : flag_unwind_t;
do_return : flag_return_t;
Allocator : not null access
System.Storage_Pools.Root_Storage_Pool'Class :=
Get_stack_allocator)
return context;
end A2;
--
-- #undef BOOST_CONTEXT_CTOR
-- #undef BOOST_CONTEXT_ARGS
-- #undef BOOST_CONTEXT_ARG
--
-- context( BOOST_RV_REF( context) other) :
-- impl_()
-- { swap( other); }
--
-- context & operator=( BOOST_RV_REF( context) other)
-- {
-- if ( this == & other) return * this;
-- context tmp( boost::move( other) );
-- swap( tmp);
-- return * this;
-- }
procedure Move (Target, Source : in out context);
--
-- operator unspecified_bool_type() const
-- { return impl_ ? unspecified_bool : 0; }
function Valid (Object : context) return Boolean;
--
-- bool operator!() const
-- { return ! impl_; }
--
-- void swap( context & other)
-- { impl_.swap( other.impl_); }
--
-- intptr_t start()
-- {
-- BOOST_ASSERT( impl_);
-- return impl_->start();
-- }
procedure start (
Object : in out context;
Result : out System.Storage_Elements.Integer_Address);
procedure start (
Object : in out context);
--
-- intptr_t resume( intptr_t vp = 0)
-- {
-- BOOST_ASSERT( impl_);
-- return impl_->resume( vp);
-- }
procedure resume (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0;
Result : out System.Storage_Elements.Integer_Address);
procedure resume (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0);
--
-- intptr_t suspend( intptr_t vp = 0)
-- {
-- BOOST_ASSERT( impl_);
-- return impl_->suspend( vp);
-- }
procedure suspend (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0;
Result : out System.Storage_Elements.Integer_Address);
procedure suspend (
Object : in out context;
vp : System.Storage_Elements.Integer_Address := 0);
--
-- void unwind_stack()
-- {
-- BOOST_ASSERT( impl_);
-- impl_->unwind_stack();
-- }
procedure unwind_stack (Object : in out context);
--
-- bool is_complete() const
-- {
-- BOOST_ASSERT( impl_);
-- return impl_->is_complete();
-- }
function is_complete (Object : context) return Boolean;
-- };
--
-- inline
-- void swap( context & l, context & r)
-- { l.swap( r); }
--
-- }}
--
-- #ifdef BOOST_HAS_ABI_HEADERS
-- # include BOOST_ABI_SUFFIX
-- #endif
--
-- #endif // BOOST_CONTEXTS_CONTEXT_H
private
overriding procedure Finalize (Object : in out context);
end boost.contexts;
Raw
boost.ads
package boost
with Pure
is
end boost;
Raw
import.h
#include <fcntl.h>
#include <sys/mman.h>
#include <sys/stat.h>
#include <sys/signal.h>
#include <sys/resource.h>
#include <sys/types.h>
#include <unistd.h>
Raw
makefile
ASM_S=asm/fcontext_x86_64_sysv_macho_gas.S
ASM_O=$(notdir $(ASM_S:.S=.o))
all: test_context
test_context: test_context.adb $(wildcard boost*.ad?) $(ASM_O) import/c.ads
gnatmake -g -gnata -gnat2012 -D build -Iimport $< -bargs -E -largs $(ASM_O)
$(ASM_O): $(ASM_S)
as -arch x86_64 -o $@ $<
import/c.ads: import.h
headmaster -p -D import -t ada import.h
Raw
test_context.adb
--
-- // Copyright Oliver Kowalke 2009.
-- // Distributed under the Boost Software License, Version 1.0.
-- // (See accompanying file LICENSE_1_0.txt or copy at
-- // http://www.boost.org/LICENSE_1_0.txt)
--
with Ada.Exceptions;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with System.Storage_Elements;
-- #include <iostream>
-- #include <sstream>
-- #include <stdexcept>
-- #include <string>
--
-- #include <boost/assert.hpp>
-- #include <boost/test/unit_test.hpp>
-- #include <boost/utility.hpp>
--
-- #include <boost/context/all.hpp>
with boost.contexts;
procedure test_context is
use type Ada.Strings.Unbounded.Unbounded_String;
use type System.Storage_Elements.Integer_Address;
procedure Test (Name : String; Process : not null access procedure) is
begin
Ada.Text_IO.Put (Name & "...");
Process.all;
Ada.Text_IO.Put ("success.");
Ada.Text_IO.New_Line;
exception
when E : others =>
Ada.Text_IO.Put ("failure!");
Ada.Text_IO.New_Line;
Ada.Text_IO.Put (Ada.Exceptions.Exception_Information (E));
Ada.Text_IO.New_Line;
end Test;
package Context_With_Integer is new boost.contexts.A1 (Integer);
package Context_With_Long_Float is new boost.contexts.A1 (Long_Float);
package Context_With_Unbounded_String is
new boost.contexts.A1 (Ada.Strings.Unbounded.Unbounded_String);
package Context_With_Unbounded_String_x2 is new boost.contexts.A2 (
Ada.Strings.Unbounded.Unbounded_String,
Ada.Strings.Unbounded.Unbounded_String);
Runtime_Error : exception;
--
-- int value1 = 0;
value1 : Integer := 0;
-- std::string value2, value3;
value2, value3 : Ada.Strings.Unbounded.Unbounded_String;
--
-- class X : private boost::noncopyable
package Xs is
-- {
-- private:
-- std::string str_;
type X is new Ada.Finalization.Limited_Controlled with record
str : Ada.Strings.Unbounded.Unbounded_String;
end record;
--
-- public:
-- X( std::string const& str) :
-- str_( str)
-- {}
--
-- ~X()
-- { value3 = str_; }
overriding procedure Finalize (Object : in out X);
-- };
end Xs;
package body Xs is
overriding procedure Finalize (Object : in out X) is
begin
value3 := Object.str;
end Finalize;
end Xs;
--
-- boost::contexts::context gctx;
gctx : boost.contexts.context;
--
-- void fn0()
-- {}
procedure fn0 is null;
--
-- void fn1( int i)
procedure fn1 (i : Integer) is
-- { value1 = i; }
begin value1 := i; end fn1;
--
-- void fn2( std::string const& str)
procedure fn2 (str : Ada.Strings.Unbounded.Unbounded_String) is
-- {
begin
-- try
-- { throw std::runtime_error( str); }
raise Runtime_Error with Ada.Strings.Unbounded.To_String (str);
-- catch ( std::runtime_error const& e)
exception
when E : Runtime_Error =>
-- { value2 = e.what(); }
value2 := Ada.Strings.Unbounded.To_Unbounded_String (
Ada.Exceptions.Exception_Message (E));
-- }
end fn2;
--
-- void fn3( std::string const& str)
procedure fn3 (str : Ada.Strings.Unbounded.Unbounded_String) is
-- {
-- X x( str);
x : Xs.X := (Ada.Finalization.Limited_Controlled with str => str);
-- intptr_t vp = gctx.suspend( value1);
vp : System.Storage_Elements.Integer_Address;
begin
boost.contexts.suspend (
gctx,
System.Storage_Elements.Integer_Address (value1),
Result => vp);
-- value1 = vp;
value1 := Integer (vp);
-- gctx.suspend();
boost.contexts.suspend (gctx);
-- }
end fn3;
--
-- void fn4( std::string const& str1, std::string const& str2)
procedure fn4 (str1, str2 : Ada.Strings.Unbounded.Unbounded_String) is
-- {
begin
-- value2 = str1;
value2 := str1;
-- value3 = str2;
value3 := str2;
-- }
end fn4;
--
-- void fn5( double d)
procedure fn5 (d : Long_Float) is
-- {
Local_d : Long_Float := d;
begin
-- d += 3.45;
Local_d := Local_d + 3.45;
-- std::cout << "d == " << d << std::endl;
Ada.Text_IO.Put_Line ("d ==" & Long_Float'Image (Local_d));
-- }
end fn5;
--
-- void test_case_1()
procedure test_case_1 is
-- {
-- boost::contexts::context ctx1;
ctx1 : boost.contexts.context;
-- boost::contexts::context ctx2(
-- fn0,
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
ctx2 : boost.contexts.context := boost.contexts.Create (
fn0'Access,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
-- BOOST_CHECK( ! ctx1);
pragma Assert (not boost.contexts.Valid (ctx1));
-- BOOST_CHECK( ctx2);
pragma Assert (boost.contexts.Valid (ctx2));
-- ctx1 = boost::move( ctx2);
boost.contexts.Move (ctx1, ctx2);
-- BOOST_CHECK( ctx1);
pragma Assert (boost.contexts.Valid (ctx1));
-- BOOST_CHECK( ! ctx2);
pragma Assert (not boost.contexts.Valid (ctx2));
-- }
end test_case_1;
--
-- void test_case_2()
procedure test_case_2 is
-- {
-- boost::contexts::context ctx(
-- fn0,
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
ctx : boost.contexts.context := boost.contexts.Create (
fn0'Access,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
-- BOOST_CHECK( ! ctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx));
-- ctx.start();
boost.contexts.start (ctx);
-- BOOST_CHECK( ctx.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx));
-- }
end test_case_2;
--
-- void test_case_3()
procedure test_case_3 is
-- {
-- int i = 1;
i : Integer := 1;
-- BOOST_CHECK_EQUAL( 0, value1);
pragma Assert (0 = value1);
-- boost::contexts::context ctx(
-- fn1, i,
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
ctx : boost.contexts.context := Context_With_Integer.Create (
fn1'Access, i,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
-- BOOST_CHECK( ! ctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx));
-- ctx.start();
boost.contexts.start (ctx);
-- BOOST_CHECK( ctx.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx));
-- BOOST_CHECK_EQUAL( 1, value1);
pragma Assert (1 = value1);
-- }
end test_case_3;
--
-- void test_case_4()
procedure test_case_4 is
-- {
-- BOOST_CHECK_EQUAL( std::string(""), value2);
pragma Assert ("" = value2);
-- boost::contexts::context ctx(
-- fn2, "abc",
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
abc : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.To_Unbounded_String ("abc");
ctx : boost.contexts.context := Context_With_Unbounded_String.Create (
fn2'Access, abc,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
-- BOOST_CHECK( ! ctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx));
-- ctx.start();
boost.contexts.start (ctx);
-- BOOST_CHECK( ctx.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx));
-- BOOST_CHECK_EQUAL( std::string("abc"), value2);
pragma Assert ("abc" = value2);
-- }
end test_case_4;
--
-- void test_case_5()
procedure test_case_5 is
-- {
abc : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.To_Unbounded_String ("abc");
vp : System.Storage_Elements.Integer_Address;
x : Integer;
begin
-- value1 = 1;
value1 := 1;
-- BOOST_CHECK_EQUAL( 1, value1);
pragma Assert (1 = value1);
-- BOOST_CHECK_EQUAL( std::string(""), value3);
pragma Assert ("" = value3);
-- gctx = boost::contexts::context(
-- fn3, "abc",
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
declare
Source : boost.contexts.context :=
Context_With_Unbounded_String.Create (
fn3'Access, abc,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
boost.contexts.Move (gctx, Source);
end;
-- BOOST_CHECK( ! gctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (gctx));
-- intptr_t vp = gctx.start();
boost.contexts.start (gctx, Result => vp);
-- BOOST_CHECK_EQUAL( vp, value1);
pragma Assert (vp = System.Storage_Elements.Integer_Address (value1));
-- BOOST_CHECK_EQUAL( 1, value1);
pragma Assert (1 = value1);
-- BOOST_CHECK( ! gctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (gctx));
-- int x = 7;
x := 7;
-- vp = 0;
vp := 0;
-- vp = gctx.resume( x);
boost.contexts.resume (
gctx,
System.Storage_Elements.Integer_Address (x),
Result => vp);
-- BOOST_CHECK_EQUAL( 7, value1);
pragma Assert (7 = value1);
-- BOOST_CHECK( ! vp);
pragma Assert (vp = 0);
-- BOOST_CHECK( ! gctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (gctx));
-- BOOST_CHECK_EQUAL( std::string(""), value3);
pragma Assert ("" = value3);
-- gctx.unwind_stack();
boost.contexts.unwind_stack (gctx);
-- BOOST_CHECK( gctx.is_complete() );
pragma Assert (boost.contexts.is_complete (gctx));
-- BOOST_CHECK_EQUAL( std::string("abc"), value3);
pragma Assert ("abc" = value3);
-- }
end test_case_5;
--
-- void test_case_6()
procedure test_case_6 is
abc : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.To_Unbounded_String ("abc");
xyz : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.To_Unbounded_String ("xyz");
begin
-- {
-- value1 = 0;
value1 := 0;
-- value2 = "";
value2 := Ada.Strings.Unbounded.Null_Unbounded_String;
-- value3 = "";
value3 := Ada.Strings.Unbounded.Null_Unbounded_String;
-- BOOST_CHECK_EQUAL( 0, value1);
pragma Assert (0 = value1);
-- BOOST_CHECK_EQUAL( std::string(""), value2);
pragma Assert ("" = value2);
-- BOOST_CHECK_EQUAL( std::string(""), value3);
pragma Assert ("" = value3);
--
declare
-- boost::contexts::context ctx1(
-- fn4, "abc", "xyz",
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind,
-- boost::contexts::return_to_caller);
ctx1 : boost.contexts.context :=
Context_With_Unbounded_String_x2.Create (
fn4'Access, abc, xyz,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
-- boost::contexts::context ctx2(
-- fn1, 7,
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind,
-- ctx1);
ctx2 : boost.contexts.context :=
Context_With_Integer.Create (
fn1'Access, 7,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind,
ctx1);
begin
-- BOOST_CHECK( ! ctx1.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx1));
-- BOOST_CHECK( ! ctx2.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx2));
-- ctx2.start();
boost.contexts.start (ctx2);
-- BOOST_CHECK( ctx1.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx1));
-- BOOST_CHECK( ctx2.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx2));
--
-- BOOST_CHECK_EQUAL( 7, value1);
pragma Assert (7 = value1);
-- BOOST_CHECK_EQUAL( "abc", value2);
pragma Assert ("abc" = value2);
-- BOOST_CHECK_EQUAL( "xyz", value3);
pragma Assert ("xyz" = value3);
end;
-- }
end test_case_6;
--
-- void test_case_7()
procedure test_case_7 is
-- {
-- boost::contexts::context ctx(
-- fn5, 7.34,
-- boost::contexts::default_stacksize(),
-- boost::contexts::stack_unwind, boost::contexts::return_to_caller);
ctx : boost.contexts.context := Context_With_Long_Float.Create (
fn5'Access, 7.34,
boost.contexts.default_stacksize,
boost.contexts.stack_unwind, boost.contexts.return_to_caller);
begin
-- BOOST_CHECK( ! ctx.is_complete() );
pragma Assert (not boost.contexts.is_complete (ctx));
-- ctx.start();
boost.contexts.start (ctx);
-- BOOST_CHECK( ctx.is_complete() );
pragma Assert (boost.contexts.is_complete (ctx));
-- }
end test_case_7;
--
-- boost::unit_test::test_suite * init_unit_test_suite( int, char* [])
-- {
begin
-- boost::unit_test::test_suite * test =
-- BOOST_TEST_SUITE("Boost.Context: context test suite");
--
-- test->add( BOOST_TEST_CASE( & test_case_1) );
Test ("test_case_1", test_case_1'Access);
-- test->add( BOOST_TEST_CASE( & test_case_2) );
Test ("test_case_2", test_case_2'Access);
-- test->add( BOOST_TEST_CASE( & test_case_3) );
Test ("test_case_3", test_case_3'Access);
-- test->add( BOOST_TEST_CASE( & test_case_4) );
Test ("test_case_4", test_case_4'Access);
-- test->add( BOOST_TEST_CASE( & test_case_5) );
Test ("test_case_5", test_case_5'Access);
-- test->add( BOOST_TEST_CASE( & test_case_6) );
Test ("test_case_6", test_case_6'Access);
-- test->add( BOOST_TEST_CASE( & test_case_7) );
Test ("test_case_7", test_case_7'Access);
--
-- return test;
-- }
end test_context;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment