Changeset 542c12b in tol


Ignore:
Timestamp:
Mar 11, 2010, 11:40:22 AM (17 years ago)
Author:
Liván Ramírez Dorta <livanr68@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
2ef94a4
Parents:
a4e3c41
Message:

refs#873: Improve TolServer process structure

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2052 be4846ae-f051-483a-831f-b64e7d08527f

Location:
tolsh
Files:
6 added
4 edited

Legend:

Unmodified
Added
Removed

  • tolsh/build.bat

    ra4e3c41 r542c12b  
    1 Windows\tclkitsh sdx.kit wrap tolsh.exe -runtime Windows\tclkit-rt.exe
     1set tclkitsh=tclkitsh858
     2copy windows\%tclkitsh%.exe windows\%tclkitsh%-rt
     3Windows\%tclkitsh% sdx.kit wrap tolsh.exe -runtime Windows\%tclkitsh%-rt
     4del windows\%tclkitsh%-rt
    25

  • tolsh/tolsh.vfs/lib/app-tolsh/tolsh.tcl

    ra4e3c41 r542c12b  
    157157          exit
    158158        }
     159      } elseif {$opt eq "slave"} {
     160        # the next argument is the port number
     161        set options(server,port) [lindex $cmdline [expr {$i+1}]]
     162        incr i
     163        if {$options(runmode) ne "" && $options(runmode) ne "slave"} {
     164          puts "Replacing previous run mode '$options(runmode)' with 'slave'"
     165        }
     166        set options(runmode) "slave"
     167      } elseif {$opt eq "shared"} {
     168        if {$options(runmode) ne "" && $options(runmode) ne "shared"} {
     169          puts "Replacing previous run mode '$options(runmode)' with 'shared'"
     170        }
     171        set options(runmode) "shared"
    159172      } else {
    160173        append delayed_msg "\nignoring unknown option: '$item'"
    … …  
    302315  setup_pkg tolcomm
    303316  setup_pkg tlogger
     317  setup_pkg tequila
     318  setup_pkg tequilas
    304319
    305320  logtmp "auto_path = $::auto_path"
    306321  logtmp "leaving ::tolsh::setup_autopath" 
     322}
     323
     324proc GetHomeDir { } {
     325  global env
     326  # Check if we're using windows
     327  if { $::tcl_platform(platform) eq "windows" } {
     328    package require registry 1.0
     329    set key1 {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders}
     330    set key2 {Personal}
     331    set env_home [ registry get $key1 $key2 ]
     332    if {[string match %USERPROFILE%* $env_home]} {
     333      set env_home [string replace $env_home 0 12 $env(USERPROFILE)]
     334    }
     335  } else {
     336    set env_home $env(HOME)
     337  }
     338  return $env_home
    307339}
    308340
    … …  
    333365  setup_autopath
    334366
    335   # Load Toltcl (+tol)
    336   #
    337   package require -exact Toltcl 2.0.1
    338   tol::initkernel $options(lang) $options(vmode)
    339 
    340   # Load initLibrary if required
    341   #
    342   if {$options(initlib)} {
    343     tol::initlibrary
    344   }
    345 
    346   set appdata [string trim \
     367  # Load Toltcl (+tol) and initLibrary if required
     368  #
     369  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
     370    package require -exact Toltcl 2.0.1
     371    tol::initkernel $options(lang) $options(vmode)
     372
     373    if {$options(initlib)} {
     374      tol::initlibrary
     375    }
     376
     377    set appdata [string trim \
    347378               [lindex [::tol::info var [list Text TolAppDataPath]] 2] \"]
    348 
    349   logtmp "appdata = $appdata"
    350 
    351   set tolcomm_dir [file join $appdata tolcomm]
     379    logtmp "appdata = $appdata"
     380  }
     381
     382  set tolcomm_dir [file join [GetHomeDir] tolcomm]
    352383  file mkdir $tolcomm_dir
    353384
    354   # load rmtps_client
    355   #
    356   if {[catch {package require rmtps_client} msg]} {
    357     std "could not load rmtps_client: $msg"
    358   } else {
    359     ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
    360     if {[catch rmtps_client::define_TOLAPI msg]} {
    361       std "could not load tol code for rmtps_client: $msg"
     385  # load rmtps_client and tolclient if required
     386  #
     387  if {$options(runmode) != "server" && $options(runmode) != "shared"} {
     388 
     389    if {[catch {package require rmtps_client} msg]} {
     390      std "could not load rmtps_client: $msg"
     391    } else {
     392      ::rmtps_client::init [file join $tolcomm_dir "rmtps_client.log"]
     393      if {[catch rmtps_client::define_TOLAPI msg]} {
     394        std "could not load tol code for rmtps_client: $msg"
     395      }
    362396    }
    363   }
    364397 
    365   # load tolclient
    366   #
    367   if {[catch {package require tolclient} msg]} {
    368     std "could not load tolclient: $msg"
    369   } else {
    370     ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
    371     if {[catch ::tolclient::define_TOLAPI msg]} {
    372       std "could not load tol code for rmtps_client: $msg"
     398    if {[catch {package require tolclient} msg]} {
     399      std "could not load tolclient: $msg"
     400    } else {
     401      ::tolclient::init [file join $tolcomm_dir "tolclient.log"]
     402      if {[catch ::tolclient::define_TOLAPI msg]} {
     403        std "could not load tol code for rmtps_client: $msg"
     404      }
    373405    }
    374   }
    375 
    376   # Compile expression and tol file provided in the command line
    377   #
    378   foreach item $options(compile) {
    379     if {[lindex $item 0] eq "expr"} {
    380       tol::console eval [lindex $item 1]
    381     } elseif {[lindex $item 0] eq "file"} {
    382       tol::include [lindex $item 1]
     406   
     407  }
     408
     409  # Compile expression and tol file provided in the command line if required
     410  #
     411  if {$options(runmode) != "server" && $options(runmode) != "shared" \
     412                                    && $options(runmode) != "slave" } {
     413
     414    foreach item $options(compile) {
     415      if {[lindex $item 0] eq "expr"} {
     416        tol::console eval [lindex $item 1]
     417      } elseif {[lindex $item 0] eq "file"} {
     418        tol::include [lindex $item 1]
     419      }
    383420    }
     421
    384422  }
    385423 
    … …  
    392430    # enter the tcl event loop
    393431    vwait __forever__
     432   
    394433  } elseif {$options(runmode) eq "server"} {
    395     package require tolserver
    396     tolserver::start -port $options(server,port) \
    397         -logfile [file join $tolcomm_dir "tolserver.log"]
    398     vwait __forever__
    399   }
    400 }
     434    puts "runmode=server"
     435    run_as_server $tolcomm_dir
     436   
     437  } elseif {$options(runmode) eq "shared"} {
     438    puts "runmode=shared"
     439    run_as_shared   
     440 
     441  } elseif {$options(runmode) eq "slave"} {
     442    puts "runmode=slave"
     443    run_as_slave $tolcomm_dir   
     444  }
     445}
     446
     447proc ::tolsh::run_as_server {tolcomm_dir} {
     448  variable options
     449  package require tolserver
     450
     451  clone
     452  tolserver::start -port $options(server,port) \
     453    -logfile [file join $tolcomm_dir "tolserver.log"] \
     454    -compile $options(compile)
     455  vwait __forever__
     456}   
     457
     458proc ::tolsh::clone {} {
     459  variable options
     460
     461  puts "::tolsh::clone"
     462  set tolsh [info nameofexecutable]
     463  puts "exec shared"
     464  exec $tolsh -shared &
     465  after 5000            ;# wait for data sharing are created by 'shared'
     466  puts "exec slave"
     467  exec $tolsh -slave $options(server,port) &
     468}
     469
     470proc ::tolsh::run_as_shared {} {
     471  package require tolshared
     472
     473  tolshared::start
     474}   
     475
     476proc ::tolsh::run_as_slave {tolcomm_dir} {
     477  variable options
     478  package require tolslave
     479
     480  tolslave::start -port $options(server,port) \
     481    -logfile [file join $tolcomm_dir "tolslave.log"]
     482  vwait __forever__
     483}   
    401484
    402485proc ::tolsh::console_cmd { cmd } {

  • tolsh/tolsh.vfs/lib/tolcomm/pkgIndex.tcl

    ra4e3c41 r542c12b  
    11
    22  package ifneeded tolserver 1.0 [list source [file join $dir tolserver.tcl]]
     3  package ifneeded tolshared 1.0 [list source [file join $dir tolshared.tcl]]
     4  package ifneeded tolslave 1.0 [list source [file join $dir tolslave.tcl]]
    35  package ifneeded tolclient 1.0 [list source [file join $dir tolclient.tcl]]
    46  package ifneeded rmtps_client 1.0 [list source [file join $dir rmtps_client.tcl]]

  • tolsh/tolsh.vfs/lib/tolcomm/tolserver.tcl

    ra4e3c41 r542c12b  
    2929    queue,cancel ""
    3030  }
    31 }
     31 
     32  variable trace_active
     33 
     34  set trace_active 0
     35}
     36
     37global shared_data
     38set shared_data(request) ""
     39set shared_data(init) ""
     40set shared_data(server_init) 0
    3241
    3342###############################################################################
    … …  
    288297  set idtask [insert_expr $chan $idrq $cmd]
    289298  send_to_client $chan "TSTART" "$idrq $idtask"
    290   schedule_queue
     299  after idle ::tolserver::dispatch_to_slave
    291300 
    292301  log "debug" "leave, on_toleval"
    … …  
    440449###############################################################################
    441450proc ::tolserver::start { args } {
    442   variable data
     451  global shared_data
    443452
    444453  array set options {
    445454    -port 6669
    446455    -logfile ""
     456    -compile ""
    447457  }
    448458  array set options $args
    449459
    450460  ::tlogger::init tolserver $options(-logfile)
    451   ::tlogger::level tolserver "error"
    452 
    453   # redirect the log
    454   ::tol::console eval [string map "%P $options(-port)" {
    455     Text {
    456       Text srv_root = TolAppDataPath+"/server";
    457       Real OSDirMake(srv_root);
    458       Text PutDumpFile(srv_root+"/start.%P.log")
    459     }
    460   }]
     461  ::tlogger::level tolserver "debug"
     462
    461463  if {[catch {open_socket $options(-port)} msgerr]} {
    462464    log emergency "::tolserver::start '$msgerr'"
    … …  
    465467    log "notice" "started"
    466468  }
     469 
     470  server_attach_data
     471
     472  log "debug" "shared_data(init)=$options(-compile)"
     473  set shared_data(init) $options(-compile) 
     474  set shared_data(server_init) 1
     475}
     476
     477proc ::tolserver::server_attach_data {} {
     478  package require tequila
     479  global shared_data
     480
     481  tequila::open localhost 20458
     482  tequila::attach shared_data
     483  trace add var shared_data write tolserver::server_listen
     484}   
     485
     486proc tolserver::server_listen {name index op} {
     487  global shared_data
     488
     489  log "debug" "server_listen:index=$index"
     490  log "debug" "[array get shared_data]"
    467491}
    468492
    … …  
    508532  set client [get_client_id $chan]
    509533  set idtask "${client}:$data(queue,id)"
    510   lappend data(queue,tasks) [list $idtask $idrq $chan $tol_expr]
    511 
     534  push_queue_tasks [list $idtask $idrq $chan $tol_expr]
    512535  log "debug" "leave, insert_expr, $idtask"
    513536  set idtask
    514537}
    515538
    516 proc ::tolserver::process_queue { } {
    517   variable data
    518 
    519   log "debug" "enter, process_queue"
    520 
    521   if {[llength $data(queue,tasks)]} {
    522     set item [lindex $data(queue,tasks) 0]
    523     set data(queue,tasks) [lrange data(queue,tasks) 1 end]
    524     foreach {idtask idrq chan tol_expr} $item break
    525     set idx [lsearch $data(queue,cancel) $idrq]
    526     if {$idx != -1} {
    527       log debug "canceling task $idtask"
    528       # remove idrq from the cancel list
    529       set data(queue,cancel) [lreplace $data(queue,cancel) $idx $idx]
    530     } else {
    531       log debug "processing task $idtask"
    532       ::tol::console eval $tol_expr
    533       # inform client this request has being finished
    534       after idle [namespace code "send_to_client $chan TFINISH $idtask"]
    535     }
    536     schedule_queue
    537   }
    538 
    539   log "debug" "leave, process_queue"
    540 }
    541 
    542 ###########################################################################
    543 #
    544 #
    545 #
    546 ###########################################################################
    547 proc ::tolserver::schedule_queue { } {
    548 
    549   variable data
    550 
    551   if {[llength $data(queue,tasks)]} {
    552     after idle [namespace code process_queue]
    553   }
    554 }
     539proc ::tolserver::push_queue_tasks {item} {
     540  variable data
     541
     542  log "debug" "tolserver::push_queue_tasks:item=$item"
     543  lappend data(queue,tasks) $item
     544}
     545
     546proc ::tolserver::dispatch_to_slave {} {
     547  global shared_data
     548  variable trace_active
     549
     550  log "debug" "tolserver::dispatch_to_slave"
     551  if {$shared_data(slave_status) eq "ready"} {
     552    send_tasks_to_slave
     553  } else {
     554    set trace_active 1
     555    trace add var shared_data(slave_status) write ::tolserver::send_tasks_to_slave
     556  }
     557}
     558
     559proc ::tolserver::send_tasks_to_slave {} {
     560  global shared_data
     561  variable trace_active
     562
     563  if {$trace_active == 1} {
     564    trace remove var shared_data(slave_status) write ::tolserver::send_tasks_to_slave
     565    set trace_active 0
     566  }
     567  log "debug" "tolserver::send_tasks_to_slave"
     568  set t_list [get_queue_tasks]
     569  set_queue_shared $t_list
     570  if {$shared_data(ack) eq 0} {
     571    vwait shared_data(ack)
     572  }
     573}
     574
     575proc ::tolserver::get_queue_tasks {} {
     576  variable data
     577
     578  set t_list $data(queue,tasks)
     579  set data(queue,tasks) [list]
     580  log "debug" "tolserver::get_queue_tasks:t_list=$t_list"
     581  return $t_list
     582}
     583
     584proc ::tolserver::set_queue_shared {t_list} {
     585  global shared_data
     586 
     587  log "debug" "tolserver::set_queue_shared:t_list=$t_list"
     588  set shared_data(request) $t_list
     589}
Note: See TracChangeset for help on using the changeset viewer.