/* -*- mode: C++; c-file-style: "bsd" -*- */ #undef bool #define ENABLE_CLIENT_IR_SUPPORT #include #include #include #include #ifdef __cplusplus extern "C" { #endif #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #undef wait /* defined by win32iop.h */ #ifdef __cplusplus } #endif #if !defined(USE_ITHREADS) #error Unsupported threading model #endif // Encapsulates Perl/omniORB's knowledge about a particular interface struct POmniIfaceInfo { std::string pkg; // owned CORBA::InterfaceDef_var iface; // owned CORBA::InterfaceDef::FullInterfaceDescription *desc; // owned POmniIfaceInfo (std::string _pkg, CORBA::InterfaceDef_ptr _iface, CORBA::InterfaceDef::FullInterfaceDescription *_desc) : pkg(_pkg), iface(_iface), desc(_desc) { } ~POmniIfaceInfo() { delete desc; } }; // Information attached to a Perl stub or true object via PERL_MAGIC_ext magic struct POmniInstVars; // ==== From errors.cc ==== // Find the package given the repoid of an exception const char * pomni_find_exception (pTHX_ const char *repoid); // Set up a package for a given exception. parent is the base package // for this exception (CORBA::UserException or CORBA::SystemException void pomni_setup_exception (pTHX_ const char *repoid, const char *pkg, const char *parent); // Set up packages for all system exceptions void pomni_init_exceptions (pTHX); #ifdef MEMCHECK void pomni_clear_exceptions(pTHX); #endif // Create a system exception object SV * pomni_system_except (pTHX_ const char *repoid, CORBA::ULong minor, CORBA::CompletionStatus status); // Create a user exception object SV * pomni_user_except (pTHX_ const char *repoid, SV *value); // Create an exception object for some exception that we // are catching internally SV * pomni_builtin_except (pTHX_ CORBA::Exception *ex); // Throw a user exception object as a Perl exception void pomni_throw (pTHX_ SV *e) __attribute__((noreturn)); // Create an exception object for an exception thrown by the POA // ==== From interfaces.cc ==== // Given either a pointer to an IR object, or a repository ID, load // the definition of the IR object from the repository. _orb optionally // gives the orb to resolve the initial InterfaceRepository in // if iface is not specified POmniIfaceInfo * pomni_load_contained (pTHX_ CORBA::Contained_ptr _container, CORBA::ORB_ptr _orb, const char *_id); // Look up interface information for a given repoid POmniIfaceInfo * pomni_find_interface_description (pTHX_ const char *repo_id); #ifdef MEMCHECK void pomni_clear_interface (pTHX_ const char *repo_id); void pomni_clear_iface_repository(pTHX); #endif // Define an interface void pomni_define_interface(pTHX_ const char *pkg, CORBA::InterfaceDef::FullInterfaceDescription *desc); // Define an exception void pomni_define_exception(pTHX_ const char *pkg, const char *repoid); // Determine whether a given repoid is a subtype of another repoid bool pomni_is_a(pTHX_ const char *object_repoid, const char *interface_repoid); // Find or create a TypeCode object for the given object SV * pomni_lookup_typecode (pTHX_ const char *id); // Initialize typecodes for the standard types void pomni_init_typecodes (pTHX); // Clean up typecodes #ifdef MEMCHECK void pomni_clear_typecodes (pTHX); #endif // Duplicates typecode cache items for use within a new thread void pomni_clone_typecodes (pTHX); // ==== From types.cc ==== // Find or create a Perl object for a given CORBA::Object SV * pomni_objref_to_sv (pTHX_ CORBA::Object *obj, const char *repoid = 0); SV * pomni_local_objref_to_sv (pTHX_ CORBA::Object *obj, const char *classname, bool force = false); // Given a Perl object which is a descendant of CORBA::Object, find // the corresponding C++ CORBA::Object CORBA::Object_ptr pomni_sv_to_objref (pTHX_ SV *perl_obj); CORBA::Object_ptr pomni_sv_to_local_objref (pTHX_ SV *perlobj, char *classname); // Removes an object from the pin table void pomni_objref_destroy (pTHX_ CORBA::Object *obj); #ifdef MEMCHECK void pomni_clear_pins (pTHX); #endif // Duplicates object references for use within a new thread void pomni_clone_pins (pTHX); // Write the contents of sv into res, using res->type bool pomni_to_any (pTHX_ CORBA::Any *res, SV *sv); // Create a SV (perl data structure) from an Any SV * pomni_from_any (pTHX_ CORBA::Any *any); // Copy an Any from a "CORBA::Any" SV bool pomni_any_from_sv (pTHX_ CORBA::Any *res, SV *sv); // Create a "CORBA::Any" SV from an Any SV * pomni_any_to_sv (pTHX_ const CORBA::Any &any); // Create a "DynamicAny::DynAny" SV from an DynAny SV * pomni_dyn_any_to_sv (pTHX_ DynamicAny::DynAny *dynany); // Convert CORBA::TCKind to string representation const char* const TCKind_to_str( CORBA::TCKind kind ); // ==== From server.cc ==== #ifdef MEMCHECK void pomni_clear_servants (pTHX); #endif //------------------------------------------------------------------- void cm_log( const char* format, ... ); #ifdef NDEBUG #define CM_DEBUG(v) #else #define CM_DEBUG(v) cm_log v #endif //------------------------------------------------------------------- // C++-friendly croak() // Trampoline classes class POmniCroak { public: POmniCroak(pTHX_ const char *fmt, ...) { va_list ap; va_start(ap, fmt); SV *errsv = get_sv("@", TRUE); sv_vsetpvf(errsv, fmt, &ap); va_end(ap); } }; class POmniThrowable { SV *e_; public: POmniThrowable(SV *e) : e_(e) { } SV *exception_object(void) { return e_; } }; #define CATCH_POMNI_TRAMPOLINE \ catch (POmniCroak) { \ croak(Nullch); \ } \ catch (POmniThrowable &throwable) { \ pomni_throw(aTHX_ throwable.exception_object()); \ } #define CATCH_POMNI_SYSTEMEXCEPTION \ catch (CORBA::SystemException &sysex) { \ pomni_throw(aTHX_ pomni_system_except(aTHX_ \ sysex._rep_id(), \ sysex.minor(), \ sysex.completed())); \ } //------------------------------------------------------------------- /** Mutex to serialize servant calls from omniORB. Allows the mutex * to be temporarily released to allow callbacks with a deeper * recursion level to execute. */ class POmniRatchetLock { omni_mutex mutex_; volatile bool locked_; omni_condition entry_cond_; volatile unsigned awaiting_entry_; struct Entry { bool waiting; omni_condition *cond; Entry(omni_mutex *mutex) : waiting(false), cond(new omni_condition(mutex)) { } }; typedef std::vector _T; _T stack_; _T::iterator top_; // Stack top inline void grow() { _T::size_type top = top_ - stack_.begin(); stack_.push_back(Entry(&mutex_)); // Invalidates iterators top_ = stack_.begin() + top; } public: POmniRatchetLock(void) : locked_(true), entry_cond_(&mutex_), awaiting_entry_(0), top_(stack_.begin()) { grow(); // initial entry } ~POmniRatchetLock(void) { for(_T::iterator i = stack_.begin(); i != stack_.end(); ++i) { delete i->cond; } } //! Enter a new recursion level. void enter(void) { mutex_.lock(); ++awaiting_entry_; while(locked_) entry_cond_.wait(); --awaiting_entry_; ++top_; if(top_ == stack_.end()) grow(); locked_ = true; mutex_.unlock(); } //! Exit the current recursion level. void leave(void) { mutex_.lock(); locked_ = false; --top_; if(awaiting_entry_ > 0) entry_cond_.signal(); else if(top_->waiting) top_->cond->signal(); mutex_.unlock(); } //! Token used to indicate the current recursion level for later // resumption. typedef _T::size_type token; //! Release the lock for use by deeper recursion levels. token release(void) { mutex_.lock(); locked_ = false; if(awaiting_entry_ > 0) entry_cond_.signal(); token t = top_ - stack_.begin(); mutex_.unlock(); return t; } //! Resume the specified recursion level. void resume(token t) { mutex_.lock(); _T::iterator ti = stack_.begin() + t; ti->waiting = true; while(locked_ || ti != top_) { ti->cond->wait(); ti = stack_.begin() + t; } ti->waiting = false; locked_ = true; mutex_.unlock(); } }; // Return the entry lock for the current Perl interpreter POmniRatchetLock *pomni_entry_lock(pTHX); /** Object to temporarily unlock the Perl interpreter during a blocking * operation, allowing other threads to make use of the interpreter. * Usage should follow the pattern: * * PUTBACK; * { * POmniPerlEntryUnlocker ul(aTHX); * * } * SPAGAIN; */ class POmniPerlEntryUnlocker { POmniRatchetLock *entry_lock_; POmniRatchetLock::token t_; public: POmniPerlEntryUnlocker(pTHX) : entry_lock_(pomni_entry_lock(aTHX)), t_(entry_lock_ ? entry_lock_->release() : 0) { } ~POmniPerlEntryUnlocker(void) { if (entry_lock_) entry_lock_->resume(t_); } }; /*! * ORB instance */ extern CORBA::ORB_ptr pomni_orb;