Class ::xotcl::THREAD (public)

 ::xotcl::Class ::xotcl::THREAD

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xotcl {}
::nsf::object::alloc ::xotcl::Class ::xotcl::THREAD {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xotcl::THREAD proc recreate {obj args} {
  :log "recreating [self] $obj, tid [$obj exists tid]"
  if {![string match "::*" $obj]} { set obj ::$obj }
  $obj set recreate 1
  next
  $obj init [lindex $args 0]
  if {[nsv_exists [self] $obj] && [$obj exists initcmd]} {
    set tid [nsv_get [self] $obj]
    ::thread::send $tid [$obj set initcmd]
    $obj set tid $tid
    :log "+++ content of thread $obj ($tid) redefined"
  }
}
::xotcl::THREAD instproc init cmd {
  if {$cmd eq "-noinit"} {return}
  #ns_log notice "+++ THREAD cmd='$cmd', epoch=[ns_ictl epoch]"
  if {![ns_ictl epoch]} {
    #ns_log notice "--THREAD init [self] no epoch"

    # We are during initialization. For some unknown reasons, XOTcl
    # is not available in newly created threads, so we have to care for it.
    # We need only a partial initialization, to allow the exit handler
    # to be defined.
    set :initcmd {
      package req XOTcl
      namespace import -force ::xotcl::*
    }
  }
  append :initcmd {
    ns_thread name SELF
  }
  append :initcmd [subst {
    ::xotcl::Object setExitHandler [list [:exithandler]]
  }]
  regsub -all SELF ${:initcmd} [self] :initcmd
  append :initcmd \n [list set ::xotcl::currentScript [info script]] \n [list set ::xotcl::currentThread [self]] \n $cmd
  set :mutex [ns_mutex create ns_mutex[self]]
  ns_log notice "mutex ${:mutex} created"
  next
}
::xotcl::THREAD instproc get_tid {} {
  if {[nsv_exists [self class] [self]]} {
    # the thread was already started
    return [nsv_get [self class] [self]]
  }
  # start a small command in the thread
  :do info exists x
  # now we have the thread and can return the tid
  return ${:tid}
}
::xotcl::THREAD instproc check_blueprint {} {
  if {![[self class] exists __blueprint_checked]} {
    if {[string first ::xotcl::THREAD [ns_ictl get]] == -1} {
      _ns_savenamespaces
    }
    [self class] set __blueprint_checked 1
  }
}
::xotcl::THREAD instproc destroy {} {
  :log "destroy called"
  if {!${:persistent} &&
      [nsv_exists [self class] [self]]} {
    set tid [nsv_get [self class] [self]]
    set refcount [::thread::release $tid]
    :log "destroying thread object tid=$tid cnt=$refcount"
    if {$refcount == 0} {
      :log "thread terminated"
      nsv_unset [self class] [self]
      ns_mutex destroy ${:mutex}
      ns_log notice "mutex ${:mutex} destroyed"
    }
  }
  next
}
::xotcl::THREAD instproc do {-async:switch args} {
  if {![nsv_exists [self class] [self]]} {
    # lazy creation of a new slave thread

    ad_mutex_eval ${:mutex} {
      #:check_blueprint
      #:log "after lock"
      if {![nsv_exists [self class] [self]]} {
        if {${:lightweight}} {
          :log "CREATE lightweight thread"
          set tid [::thread::create -thin]
        } else {
          set tid [::thread::create]
        }
        nsv_set [self class] [self] $tid
        if {${:persistent}} {
          :log "--created new persistent [self class] as $tid pid=[pid]"
        } else {
          :log "--created new [self class] as $tid pid=[pid]"
        }
        #:log "--THREAD DO send [self] epoch = [ns_ictl epoch]"
        if {${:lightweight}} {
        } elseif {![ns_ictl epoch]} {
          #ns_log notice "--THREAD send [self] no epoch"
          # We are during initialization. For some unknown reasons, XOTcl
          # is not available in newly created threads, so we have to care
          # for full initialization, including xotcl blueprint.
          _ns_savenamespaces
          set initcmd [ns_ictl get]
        }
        append initcmd ${:initcmd}
        #ns_log notice "INIT $initcmd"
        ::thread::send $tid $initcmd

        #
        # There is a potential race condition during startup on a very
        # slow/busy system, where the throttle thread can receive
        # commands, although it is not full initialized. One approach
        # would be to move the nsv setting of the pid here, where the
        # thread is fully initialized, .... but unfortunately, this
        # leads to problems as well. This needs deeper investing,
        # ... but is not very important, since it is very hard to
        # reconstruct the problem case.
        #
        #nsv_set [self class] [self] $tid
      } else {
        set tid [nsv_get [self class] [self]]
      }
    }
  } else {
    #
    # Target thread is already up and running.
    #
    set tid [nsv_get [self class] [self]]
  }
  if {![info exists :tid]} {
    #
    # This is the first call.
    #
    if {!${:persistent} && ![info exists :recreate]} {
      #
      # For a shared thread, we do ref-counting through preserve.
      #
      set tid [nsv_get [self class] [self]]
      :log "THREAD::PRESERVE must preserve for sharing request-thread [pid] tid $tid"
      ::thread::preserve $tid
    }
    set :tid $tid
  }
  if {[ns_info shutdownpending]} {
    :log "thread send operation ignored due to pending shutdown: $args"
  } elseif {$async} {
    return [thread::send -async $tid $args]
  } else {
    return [thread::send $tid $args]
  }
}
::xotcl::THREAD instparametercmd exithandler
::xotcl::THREAD instparametercmd lightweight
::xotcl::THREAD instparametercmd persistent

::nx::slotObj -container slot ::xotcl::THREAD
::xotcl::THREAD::slot eval {set :__parameter {
      {persistent 0}
      {lightweight 0}
      {exithandler {ns_log notice "EXITHANDLER of slave thread SELF [pid]"}}
    }}

::nsf::object::alloc ::xotcl::Class ::xotcl::THREAD::Client {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xotcl::THREAD::Client instproc do args {
  ${:server} do ${:serverobj} {*}$args
}
::xotcl::THREAD::Client instparametercmd serverobj
::xotcl::THREAD::Client instparametercmd server

::nsf::object::alloc ::xotcl::Attribute ::xotcl::THREAD::slot::lightweight {set :accessor public
   set :configurable true
   set :convert false
   set :default 0
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::THREAD
   set :incremental 0
   set :manager ::xotcl::THREAD::slot::lightweight
   set :methodname lightweight
   set :multiplicity 1..1
   set :name lightweight
   set :parameterSpec {-lightweight:substdefault 0}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xotcl::THREAD::slot::exithandler {set :accessor public
   set :configurable true
   set :convert false
   set :default {ns_log notice "EXITHANDLER of slave thread SELF [pid]"}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::THREAD
   set :incremental 0
   set :manager ::xotcl::THREAD::slot::exithandler
   set :methodname exithandler
   set :multiplicity 1..1
   set :name exithandler
   set :parameterSpec {-exithandler:substdefault {ns_log notice "EXITHANDLER of slave thread SELF [pid]"}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xotcl::THREAD::slot::persistent {set :accessor public
   set :configurable true
   set :convert false
   set :default 0
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::THREAD
   set :incremental 0
   set :manager ::xotcl::THREAD::slot::persistent
   set :methodname persistent
   set :multiplicity 1..1
   set :name persistent
   set :parameterSpec {-persistent:substdefault 0}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nx::slotObj -container slot ::xotcl::THREAD::Client
::xotcl::THREAD::Client::slot eval {set :__parameter {server {serverobj [self]}}}

::nsf::object::alloc ::xotcl::Attribute ::xotcl::THREAD::Client::slot::serverobj {set :accessor public
   set :configurable true
   set :convert false
   set :default {[self]}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::THREAD::Client
   set :incremental 0
   set :manager ::xotcl::THREAD::Client::slot::serverobj
   set :methodname serverobj
   set :multiplicity 1..1
   set :name serverobj
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xotcl::THREAD::Client::slot::server {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::THREAD::Client
   set :incremental 0
   set :manager ::xotcl::THREAD::Client::slot::server
   set :methodname server
   set :multiplicity 1..1
   set :name server
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

namespace eval ::xotcl {::namespace export Object Class Attribute myproc myvar my self next @}

XQL Not present:

Generic, PostgreSQL, Oracle