<pre style='margin:0'>
Joshua Root (jmroot) pushed a commit to branch master
in repository macports-base.
</pre>
<p><a href="https://github.com/macports/macports-base/commit/f00bf8056bc3c9e807c5945a65c5941778e9cc6b">https://github.com/macports/macports-base/commit/f00bf8056bc3c9e807c5945a65c5941778e9cc6b</a></p>
<pre style="white-space: pre; background: #F8F8F8">The following commit(s) were added to refs/heads/master by this push:
<span style='display:block; white-space:pre;color:#404040;'> new f00bf8056 Add multithreading to portindex
</span>f00bf8056 is described below
<span style='display:block; white-space:pre;color:#808000;'>commit f00bf8056bc3c9e807c5945a65c5941778e9cc6b
</span>Author: Joshua Root <jmr@macports.org>
AuthorDate: Sun Oct 30 11:52:17 2022 +1100
<span style='display:block; white-space:pre;color:#404040;'> Add multithreading to portindex
</span>---
src/macports1.0/macports.tcl | 8 +-
src/port/portindex.tcl | 273 +++++++++++++++++++++++++++++--------------
2 files changed, 191 insertions(+), 90 deletions(-)
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index 932717464..4ff423886 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/macports1.0/macports.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1969,9 +1969,9 @@ proc mportopen {porturl {options {}} {variations {}} {nocache {}}} {
</span>
# Will download if remote and extract if tarball.
set portpath [macports::getportdir $porturl]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- ui_debug "Changing to port directory: $portpath"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- cd $portpath
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![file isfile Portfile]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_debug "Opening port in directory: $portpath"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portfilepath [file join $portpath Portfile]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {![file isfile $portfilepath]} {
</span> return -code error "Could not find Portfile in $portpath"
}
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -1988,7 +1988,7 @@ proc mportopen {porturl {options {}} {variations {}} {nocache {}}} {
</span>
macports::worker_init $workername $portpath $porturl [macports::getportbuildpath $portpath] $options $variations
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[catch {$workername eval {source Portfile}} result]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[catch {$workername eval [list source $portfilepath]} result]} {
</span> mportclose $mport
ui_debug $::errorInfo
error $result
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/port/portindex.tcl b/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;color:#808080;'>index a26ad115d..1b4582fc7 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/port/portindex.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -4,7 +4,7 @@
</span> # if requested
package require macports
<span style='display:block; white-space:pre;background:#ffe0e0;'>-package require Pextlib
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+package require Thread
</span>
# Globals
set full_reindex 0
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -23,8 +23,7 @@ mportinit ui_options global_options global_variations
</span>
# Standard procedures
proc print_usage args {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- global argv0
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "Usage: $argv0 \[-dfe\] \[-o output directory\] \[-p plat_ver_\[cxxlib_\]arch\] \[directory\]"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Usage: $::argv0 \[-dfe\] \[-o output directory\] \[-p plat_ver_\[cxxlib_\]arch\] \[directory\]"
</span> puts "-d:\tOutput debugging information"
puts "-f:\tDo a full re-index instead of updating"
puts "-e:\tExit code indicates if ports failed to parse"
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -33,34 +32,34 @@ proc print_usage args {
</span> puts "-x:\tInclude extra (optional) information in the PortIndex, like variant description and port notes."
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc _read_index {idx} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global qindex oldfd
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc _write_index {name len line} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts $::fd [list $name $len]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts $::fd $line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Code that runs in worker threads
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+set worker_init_script {
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set offset $qindex($idx)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- seek $oldfd $offset
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- gets $oldfd line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+package require macports
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+package require Thread
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc _read_index {idx} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set offset $::qindex($idx)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ seek $::oldfd $offset
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ gets $::oldfd line
</span>
set name [lindex $line 0]
set len [lindex $line 1]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set line [read $oldfd [expr {$len - 1}]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set line [read $::oldfd [expr {$len - 1}]]
</span>
return [list $name $len $line]
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc _write_index {name len line} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global fd
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts $fd [list $name $len]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts $fd $line
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-}
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-proc _write_index_from_portinfo {portinfoname {is_subport no}} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global keepkeys
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc _index_from_portinfo {portinfoname {is_subport no}} {
</span> upvar $portinfoname portinfo
array set keep_portinfo {}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach key [array names keepkeys] {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach key [array names ::keepkeys] {
</span> # filter keys
if {![info exists portinfo($key)]} {
continue
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -77,11 +76,10 @@ proc _write_index_from_portinfo {portinfoname {is_subport no}} {
</span>
set output [array get keep_portinfo]
set len [expr {[string length $output] + 1}]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- _write_index $portinfo(name) $len $output
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return [list $portinfo(name) $len $output]
</span> }
proc _open_port {portinfo_name portdir absportdir port_options_name {subport {}}} {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- global save_prefix
</span> upvar $portinfo_name portinfo
upvar $port_options_name port_options
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -97,93 +95,192 @@ proc _open_port {portinfo_name portdir absportdir port_options_name {subport {}}
</span> }
} finally {
# Restore prefix to the previous value
<span style='display:block; white-space:pre;background:#ffe0e0;'>- set macports::prefix $save_prefix
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set macports::prefix $::save_prefix
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[array exists portinfo]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array unset portinfo
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset portinfo
</span> array set portinfo [mportinfo $interp]
mportclose $interp
set portinfo(portdir) $portdir
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>-proc pindex {portdir} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- global oldmtime newest qindex directory stats full_reindex \
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- ui_options port_options
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set qname [string tolower [file tail $portdir]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set absportdir [file join $directory $portdir]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc pindex {portdir {subport {}}} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$subport eq ""} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set tsv_varname $portdir
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set is_subport 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set tsv_varname ${portdir}/${subport}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set is_subport 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set absportdir [file join $::directory $portdir]
</span> set portfile [file join $absportdir Portfile]
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # try to reuse the existing entry if it's still valid
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$full_reindex != 1 && [info exists qindex($qname)]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- macports_try -pass_signal {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set mtime [file mtime $portfile]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$oldmtime >= $mtime} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- lassign [_read_index $qname] name len line
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- array set portinfo $line
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- # reuse entry if it was made from the same portdir
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists portinfo(portdir)] && $portinfo(portdir) eq $portdir} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- _write_index $name $len $line
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(skipped)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "Reusing existing entry for $portdir"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ try {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$is_subport} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set qname [string tolower $subport]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set qname [string tolower [file tail $portdir]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # try to reuse the existing entry if it's still valid
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$::full_reindex != 1 && [info exists ::qindex($qname)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ macports_try -pass_signal {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set mtime [file mtime $portfile]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$::oldmtime >= $mtime} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ lassign [_read_index $qname] name len line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set portinfo $line
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # reuse entry if it was made from the same portdir
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists portinfo(portdir)] && $portinfo(portdir) eq $portdir} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname output [list $name $len $line]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {!$is_subport} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists ::ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Reusing existing entry for $portdir"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # report any subports
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists portinfo(subports)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname subports $portinfo(subports)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # also reuse the entries for its subports
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists portinfo(subports)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname status -1
</span> return
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach sub $portinfo(subports) {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- _write_index {*}[_read_index [string tolower $sub]]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(skipped)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>-
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- return
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } on error {} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- ui_warn "Failed to open old entry for ${portdir}, making a new one"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {[info exists ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "$::errorInfo"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } on error {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ ui_warn "Failed to open old entry for ${portdir}, making a new one"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists ::ui_options(ports_debug)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "$::errorInfo"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span> }
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(total)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- macports_try -pass_signal {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- _open_port portinfo $portdir $absportdir port_options
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "Adding port $portdir"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ macports_try -pass_signal {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ _open_port portinfo $portdir $absportdir ::port_options $subport
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$is_subport} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Adding subport $subport"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Adding port $portdir"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- _write_index_from_portinfo portinfo
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set mtime [file mtime $portfile]
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {$mtime > $newest} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- set newest $mtime
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname output [_index_from_portinfo portinfo $is_subport]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname mtime [file mtime $portfile]
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- # now index this portfile's subports (if any)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- if {![info exists portinfo(subports)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # report this portfile's subports (if any)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {!$is_subport && [info exists portinfo(subports)]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname subports $portinfo(subports)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } on error {eMessage} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$is_subport} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "Failed to parse file $portdir/Portfile with subport '${subport}': $eMessage"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "Failed to parse file $portdir/Portfile: $eMessage"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname status 1
</span> return
}
<span style='display:block; white-space:pre;background:#ffe0e0;'>- foreach sub $portinfo(subports) {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(total)
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- macports_try -pass_signal {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- _open_port portinfo $portdir $absportdir port_options $sub
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts "Adding subport $sub"
</span>
<span style='display:block; white-space:pre;background:#ffe0e0;'>- _write_index_from_portinfo portinfo yes
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- } on error {eMessage} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts stderr "Failed to parse file $portdir/Portfile with subport '${sub}': $eMessage"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(failed)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname status 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } trap {POSIX SIG SIGINT} {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "SIGINT received, terminating."
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname status 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } trap {POSIX SIG SIGTERM} {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts stderr "SIGTERM received, terminating."
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $tsv_varname status 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# End worker_init_script
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc init_threads {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append ::worker_init_script \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list array set qindex [array get ::qindex]] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list array set keepkeys [array get ::keepkeys]] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list array set ui_options [array get ::ui_options]] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set port_options $::port_options] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set save_prefix $::save_prefix] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set directory $::directory] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set full_reindex $::full_reindex] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list mportinit ui_options] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list signal default {TERM INT}]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists ::oldfd]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append ::worker_init_script \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set outpath $::outpath] \n \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ {set oldfd [open $outpath r]} \n
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[info exists ::oldmtime]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append ::worker_init_script \
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ [list set oldmtime $::oldmtime] \n
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::maxjobs [macports:get_parallel_jobs no]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::poolid [tpool::create -minworkers $::maxjobs -maxworkers $::maxjobs -initcmd $::worker_init_script]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array set ::pending_jobs {}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc handle_completed_jobs {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set completed_jobs [tpool::wait $::poolid [array names ::pending_jobs]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach completed_job $completed_jobs {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set portdir $::pending_jobs($completed_job)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ unset ::pending_jobs($completed_job)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::get $portdir status status
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # -1 = skipped, 0 = success, 1 = fail, 99 = exit
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$status == 99} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::exit_fail 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ array unset ::pending_jobs
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return -code break "Interrupt"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } elseif {$status == 1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr ::stats(failed)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # queue jobs for subports
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[tsv::exists $portdir subports]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach subport [tsv::get $portdir subports] {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set ${portdir}/${subport} status 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set jobid [tpool::post -nowait $::poolid [list pindex $portdir $subport]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::pending_jobs($jobid) ${portdir}/${subport}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr ::stats(total)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span> }
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$status == -1} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr ::stats(skipped)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::get $portdir mtime mtime
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$mtime > $::newest} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::newest $mtime
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ _write_index {*}[tsv::get $portdir output]
</span> }
<span style='display:block; white-space:pre;background:#ffe0e0;'>- } on error {eMessage} {
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- puts stderr "Failed to parse file $portdir/Portfile: $eMessage"
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>- incr stats(failed)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::unset $portdir
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# post new job to the pool
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc pindex_queue {portdir} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Wait for a free thread
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ while {[array size ::pending_jobs] >= $::maxjobs} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ handle_completed_jobs
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$::exit_fail} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ error "Interrupt"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Now queue the new job.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # Start with worst status so we get it when the thread
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # returns due to ctrl-c etc.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ tsv::set $portdir status 99
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set jobid [tpool::post -nowait $::poolid [list pindex $portdir {}]]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set ::pending_jobs($jobid) $portdir
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr ::stats(total)
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc process_remaining {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # let remaining jobs finish
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ while {[array size ::pending_jobs] > 0} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ handle_completed_jobs
</span> }
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ tpool::release $::poolid
</span> }
if {$argc > 8} {
<span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -322,7 +419,11 @@ if {$extended_mode eq 1 } {
</span>
set exit_fail 0
try {
<span style='display:block; white-space:pre;background:#ffe0e0;'>- mporttraverse pindex $directory
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ init_threads
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # process list of portdirs
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ mporttraverse pindex_queue $directory
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # handle completed jobs
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ process_remaining
</span> } trap {POSIX SIG SIGINT} {} {
puts stderr "SIGINT received, terminating."
set exit_fail 1
</pre><pre style='margin:0'>
</pre>