Сопрограммы, их повадки и применение

Содержание

Поддержка сопрограмм — одно из самых важных нововведений, ожидающих нас в TCL 8.6. Добавление всего лишь пары команд, coroutine и yield, открывает новые способы написания программ и новые возможности совершения ошибок.

Сопрограммы можно рассматривать как реализацию кооперативной многопоточности (multithreading). Сопрограммы прерывают своё выполнение только в тех местах, где они явно этого потребуют. В отличие от потоков операционной системы, доступных через расширение Thread, сопрограммы могут выполняться в любом количестве в одном и том же интерпретаторе TCL.

Как это выглядит со стороны TCL

Ниже приведён пример, демонстрирующий выполнение сопрограмм:

Листинг coro_minimal.tcl

proc task {} {
    puts "Выполняется task в сопрограмме [info coroutine]"
    # надо позаботиться о собственном перезапуске.
    after idle [info coroutine]
    puts "Сейчас я прервусь"
    yield
    puts "Перезапущена сопрограмма [info coroutine]"
    puts "Конец работы task"
}
proc main {} {
    coroutine runner1 task
    coroutine runner2 task
    update idletask
}
main

Выполняется task в сопрограмме ::runner1
Сейчас я прервусь
Выполняется task в сопрограмме ::runner2
Сейчас я прервусь
Перезапущена сопрограмма ::runner1
Конец работы task
Перезапущена сопрограмма ::runner2
Конец работы task

В этом примере создаются две сопрограммы, runner1 и runner2, в которых выполняется одна и та же процедура task. При создании сопрограммы она гарантированно получает управление, а команда yield прерывает выполнение сопрограммы до следующего перезапуска.

Как известно, в TCL всё является строками, но не совсем. Штуковины, обладающие идентичностью и изменяемым состоянием, не могут быть строками, поэтому их делают командами. Сопрограмма, пока она выполняется, тоже представлена командой. Когда сопрограмма заканчивает работу, соответствующая ей команда самоуничтожается. Пока команда существует, она может быть использована для перезапуска прерванной сопрограммы.

В нашем примере сопрограммы сами заботятся о своём перезапуске: с помощью команды info coroutine процедура task получает имя сопрограммы, в которой она выполняется, и через after idle ставит её в очередь, так что она будет перезапущена при входе в цикл обработки событий. Обработка событий запускается через update idletasks, подбирая таким образом «хвосты» от обеих сопрограмм. Если бы наши сопрограммы отдавали управление через yield неопределённое количество раз, лучше было бы продолжать их с помощью вечного цикла обработки событий vwait forever.

Проблема вложенных циклов обработки событий

Тиклеры давно и успешно применяют цикл обработки событий во многих случаях, когда прочие программисты хватаются за потоки, но до сих пор ради этого иногда приходилось терпеть существенные неудобства.

Предположим, нам надо получить содержимое web-страницы по протоколу http, и при этом не блокировать графический интерфейс программы, сколь бы медленным ни был канал пользователя в интернет.

Рассмотрим следующий код:

package require http
proc check-page-start {} {
    set handle [http::geturl http://www.siftsoft.com/]
    # пока страница качается, всё работает. но всегда ли?
    set content [http::data $handle]
    # ... а здесь мы что-то делаем с полученными данными
    http::cleanup $handle
}

Если запустить подобный код при загруженном Tk, мы обнаружим, что GUI и так не блокируется, потому что http осуществляет обмен данными асинхронно и использует vwait для ожидания результата, а vwait запускает цикл обработки событий. Но на самом деле разработчики пакета http, решив очевидную проблему «застывшего GUI», обеспечили нам неочевидную, редкую и трудноуловимую проблему вложенных циклов обработки событий.

Пример её возникновения можно увидеть в следующем коде:

package require http
proc check-page {url} {
    set handle [http::geturl $url]
    # ...
    http::cleanup $handle
}
# ...
after idle {show-page http://fast.server.example.com/page.html}
after idle {show-page http://slow.server.example.com/page.html}
vwait forever

Предположим, что сервер fast.server.example.com отвечает быстро, а slow.server.example.com — существенно медленнее. Что же при этом происходит с нашим кодом?

Первая команда after idle поместит в очередь процедуру check-page для «быстрой» страницы, вторая команда — процедуру для медленной страницы, а vwait forever запустит «вечную» обработку событий. Первым будет запущено получение «быстрой» страницы. Но при выполнении http::geturl будет вызвана команда vwait, и из очереди событий запустится процедура получения «медленной» страницы. Она, в свою очередь, тоже выполнит vwait. В результате процедура получения «быстрой» страницы никогда не сможет завершиться прежде процедуры получения «медленной».

Именно поэтому опытные тиклеры почти не применяют vwait и родственный tkwait в пакетах расширения. Если многие станут нарушать это правило, любое большое приложение без всякого желания и контроля разработчика будет громоздить друг на друга вложенные вызовы vwait труднопредсказуемым образом.

Пакет http поддерживает способ использования, не требующий вложенных циклов обработки событий. Если вызвать http::geturl с опцией -command, управление вернётся к вызывающей процедуре, а указанная команда будет вызвана при готовности результата. Именно таким способом используют этот пакет программисты, которые беспокоятся о вложенных vwait.

package require http
proc check-page-start {} {
    http::geturl http://www.siftsoft.com/ -command check-page-continue
}
proc check-page-continue {handle} {
    set content [http::data $handle]
    # ... а здесь мы что-то делаем с полученными данными
    http::cleanup $handle
}

Разработчики пакета http создали один из лучших интерфейсов для асинхронной обработки результатов запроса. Несмотря на это, мы вынуждены терпеть неудобства, разбивая единую задачу на две и более процедур. Мы должны заботиться о сохранении промежуточных данных в нелокальных переменных, и, соответственно, об освобождении этих переменных при отмене запущенного асинхронного действия.

Если мы точно знаем, что наша процедура будет выполняться из сопрограммы, этих неудобств можно избежать.

Листинг coro_http.tcl

package require http

proc task-check-page {url} {
    # Здесь может быть всё, что угодно
    http::geturl $url -command [info coroutine]
    set handle [yield]
    set content [http::data $handle]
    puts "Веб-сервер по адресу $url ответил кодом [http::code $handle]"
    http::cleanup $handle
    set ::forever now
}

coroutine running task-check-page http://www.linux.org.ru/
vwait forever

Веб-сервер по адресу http://www.linux.org.ru/ ответил кодом HTTP/1.1 200 OK

В этом примере мы впервые встречаемся с передачей параметров сопрограмме через команду перезапуска. Правила передачи параметров очень просты: аргумент команды перезапуска становится возвращаемым значением yield в сопрограмме, а аргумент команды yield становится возвращаемым значением команды перезапуска (или запуска) сопрограммы.

Подобным образом можно обращаться к любому коду, который поддерживает асинхронное выполнение заданий. Так мы получаем одновременно преимущества, которые приносит асинхронная обработка данных, и простоту программирования, возможную до сих пор лишь для синхронной обработки.

Vwait, которого можно не бояться

Для кода, выполняющегося из сопрограммы, можно написать версию vwait, которая не будет создавать вышеописанной проблемы.

Листинг coro_vwait.tcl

namespace eval coutils {
    namespace export {[a-z]*}
}

## Реализация «безопасного» vwait
proc ::coutils::vwait {varName} {
    upvar $varName var
    set thisCoroutine [info coroutine]
    if {$thisCoroutine eq ""} {
        # Запуск не из сопрограммы.
        # Передадим управление обычному, опасному vwait.
        # Возможно, это не лучшая идея.
        tailcall ::vwait $varName
    } else {
        trace add variable var write [list apply [list args $thisCoroutine]]
        yield
        trace remove variable var write $thisCoroutine
    }
}

## Пример использования
package require http
namespace eval http {
    ## ХИТРЫЙ ПЛАН.
    ## воткнём в namespace http нашу реализацию vwait,
    ## чтобы этот пакет ей пользовался.
    namespace import ::coutils::vwait
    ## Вообще-то это невежливо. Берегитесь велоцираптора.
}

proc check-page {url} {
    set handle [::http::geturl $url]
    set code [::http::code $handle]
    puts "Для адреса $url сервер ответил кодом $code"
    ::http::cleanup $handle
    set ::forever now
}

coroutine running check-page http://www.linux.org.ru/
vwait forever

Для адреса http://www.linux.org.ru/ сервер ответил кодом HTTP/1.1 200 OK

В этом примере мы извращенным способом заставляем пакет http использовать нашу реализацию vwait. Так, конечно, делать нельзя: вдруг в пакете http вызывается ::vwait из глобального пространства имён? И хотя сейчас это не так, но в будущем может измениться. В общем, хорошие девочки так не поступают. Но найдётся ли хоть один тиклер, ни разу в жизни не применявший подобных трюков, и не радовавшийся при этом в глубине души, что они возможны?

Учим чужие пакеты асинхронной работе

Пакет http, с которым мы работали до сих пор, с самого начала написан для асинхронной работы с сетевыми соединениями. Многие пакеты, работающие с сетевыми протоколами, написаны не так: они используют сокеты в блокирующем режиме; цикл обработки событий при этом не выполняется, и проблема «застывшего GUI» встаёт в полный рост.

До появления сопрограмм добавление поддержки асинхронных операций в любой достаточно сложный пакет было трудной задачей. Теперь же такие задачи можно будет решать довольно просто, причём способ не зависит от логики протокола и существующего кода пакета: в них достаточно вникнуть лишь на самом поверхностном уровне. Рассмотрим, как решается такая задача, на примере пакета pop3 из стандартной библиотеки tcllib.

В то же пространство имён ::coutils, в котором мы реализовали свой безопасный vwait, добавим хитрую реализацию команд socket, gets, read и close.

Листинг coro_utils.tcl

# Written by Anton Kovalenko, 2009.
# Hereby I place this source into the public domain.

namespace eval coutils {
    namespace export {[a-z]*}
    namespace import ::tcl::mathop::*
    variable coroutineId 0
    namespace eval tasks {}
}

proc ::coutils::socket {args} {
    variable asynchronizedChannels

    lassign $args firstArg
    if {$firstArg eq "-server" ||
        "-async" in [lrange $args 0 end-2]} {
        tailcall ::socket {*}$args
    } else {
        set sockfd [ ::socket -async {*}$args ]
        dict set asynchronizedChannels $sockfd ""
        return $sockfd
    }
}

proc ::coutils::gets {chan args} {
    if {[ShouldDoSynchronously $chan]} {
        tailcall ::gets {*}$args
    }
    fconfigure $chan -blocking 0
    fileevent $chan readable [list ::coutils::DoGets [info coroutine] $chan]
    lassign [yield] returnCode returnOptions getsValue getsLine
    if {$returnCode != 0} {
        return -code $returnCode -options $returnOptions $getsValue
    } else {
        if {$args ne {}} {
            upvar [lindex $args 0] lineVar
            set lineVar $getsLine
            return $getsValue
        } else {
            return $getsLine
        }
    }
}

proc ::coutils::read {arg1 args} {
    if {$arg1 eq "-nonewline"} {
        lassign $args chan
        set charCount -1
        set noNewline 1
    } else {
        set chan $arg1
        set noNewline 0
        if {$args ne {}} {
            lassign $args charCount
        } else {
            set charCount -1
        }
    }
    if {[ShouldDoSynchronously $chan]} {
        tailcall ::read $arg1 {*}$args
    }
    ;# we are running in coroutine and should read
    ;# either until EOF or given number of bytes
    fconfigure $chan -blocking 0
    variable asynchronizedChannels
    dict set asynchronizedChannels $chan bufferedData ""
    fileevent $chan readable [list ::coutils::DoRead [info coroutine] $chan $charCount $noNewline]
    lassign [yield] returnCode returnOptions returnValue
    return -code $returnCode -options $returnOptions $returnValue
}

proc ::coutils::close {chan} {
    forget $chan
    tailcall close $chan
}

proc ::coutils::forget {chan} {
    variable asynchronizedChannels
    dict unset $asynchronizedChannels $chan
}


proc ::coutils::vwait {varName} {
    upvar $varName var
    set thisCoroutine [info coroutine]
    if {$thisCoroutine eq ""} {
        # Запуск не из сопрограммы.
        # Передадим управление обычному, опасному vwait.
        # Возможно, это не лучшая идея.
        tailcall ::vwait $varName
    } else {
        trace add variable var write [list apply [list args $thisCoroutine]]
        yield
        trace remove variable var write $thisCoroutine
    }
}

proc ::coutils::ShouldDoSynchronously {chan} {
    variable asynchronizedChannels
    if {![dict exists $asynchronizedChannels $chan]} {
        return 1
    } elseif {[info coroutine] eq ""} {
        fconfigure $chan -blocking 1
        return 1
    } else {
        return 0
    }
}

proc ::coutils::DoGets {restart chan} {
    set returnCode [ catch { ::gets $chan line } returnValue returnOptions ]
    if {$returnCode != 0} {
        fileevent $chan readable {}
        {*}$restart [list $returnCode $returnOptions $returnValue ""]
    } else {
        if {![fblocked $chan]} {
            fileevent $chan readable {}
            {*}$restart [list 0 {} $returnValue $line]
        }
    }
}

proc ::coutils::DoRead {restart chan charCount noNewline} {
    variable asynchronizedChannels
    dict with asynchronizedChannels $chan {}
    if {$charCount != -1} {
        set restCharCount [- $charCount [string length $bufferedData] ]
        set returnCode [ catch { read $chan $restCharCount } returnValue returnOptions]
        if {$returnCode != ""} {
            fileevent $chan readable {}
            {*}$restart [list $returnCode $returnOptions $returnValue]
        } else {
            dict unset asynchronizedChannels $chan bufferedData
            append bufferedData $returnValue
            if {![fblocked $chan]} {
                fileevent $chan readable {}
                {*}$restart [list $returnCode $returnOptions $bufferedData]
            } else {
                dict set asynchronizedChannels $chan bufferedData $bufferedData
                return
            }
        }
    } else {
        set returnCode [ catch { read $chan } returnValue returnOptions]
        if {$returnCode != ""} {
            fileevent $chan readable {}
            {*}$restart [list $returnCode $returnOptions $returnValue]
        } else {
            dict unset asynchronizedChannels $chan bufferedData
            append bufferedData $returnValue
            if {[eof $chan]} {
                fileevent $chan readable {}
                if {$noNewline} {
                    if {[string range $bufferedData end-1 end] eq "\r\n"} {
                        set bufferedData [string range bufferedData 0 end-2]
                    } elseif {[string index $bufferedData end] eq "\n"} {
                        set bufferedData [string range bufferedData 0 end-1]
                    }
                }
                {*}$restart [list $returnCode $returnOptions $bufferedData]
            } else {
                dict set asynchronizedChannels $chan bufferedData $bufferedData
                return
            }
        }
    }
}

Теперь можно заставить пакет pop3 использовать наши реализации упомянутых процедур, например, тем же способом, который мы безоговорочно осудили выше. К сожалению, с командой close фокус не пройдёт: пакет pop3 реализует собственную команду pop3::close, поэтому системную команду он вызывает как ::close. Впрочем, немного изоленты^W изобретательности позволит с этим справиться.

Листинг coro_popview.tcl

source coro_utils.tcl

package require pop3
package require mime

## It may be considered harmful to break into existing package.
## Let's do it in this proof-of-concept code,
## but it's better to fix a package than to hack it this way.
## May the fear of velociraptors be with you.
namespace eval pop3 {
    namespace import ::coutils::socket ::coutils::read ::coutils::gets
    rename close close.orig
    proc close {chan} {
        ::coutils::forget $chan
        tailcall close.orig $chan
    }
}


## Shorthand for "interp alias" in the current interp.
proc alias {sourceCommand destinationCommand args} {
    interp alias "" $sourceCommand "" $destinationCommand {*}$args
}

## enabled_by_variable globalVarName widget-constructor ...
## constructs a widget that is enabled and disabled according
## to a global variable.
proc enabled_by_variable {varName widgetType args} {
    set widget [ uplevel 1 [list $widgetType {*}$args ] ]
    upvar #0 $varName var
    set lambda {{varName widget name1 name2 op} {
        upvar #0 $varName var
        $widget configure -state [ expr { $var ? "normal" : "disabled" } ]
    }}
    trace add variable var write [list apply $lambda $varName $widget]
    return $widget
}


## do something when the caller's stack frame is destroy
## it's now _the only way_ to clean up things when a running coroutine is
## deleted
proc scope(exit) {args} {
    upvar {___ scope guard} guard
    set guard ""
    trace add variable guard unset \
        [list %scope(exit)onTrace [uplevel 1 {namespace current}] $args]
}
proc %scope(exit)onTrace {nativeNamespace command name1 name2 op} {
    namespace eval $nativeNamespace $command
}


## create POP3-fetcher demo GUI as pathName
proc popper-gui {pathName} {
    ::ttk::labelframe $pathName -text "POP3 mail fetching demo"
    foreach {name description} {
        host "Server name:"
        user "User name:"
        password "Password:"
    } {
        set label [::ttk::label $pathName.lab_$name -text $description]
        set entry [::ttk::entry $pathName.ent_$name -textvariable ::gui($name)]
        grid $label $entry -sticky nswe -padx 5 -pady 5
    }
    $pathName.ent_password configure -show "*"
    set ::gui(host) 127.0.0.1
    set ::gui(user) $::tcl_platform(user)

    set commands [::ttk::frame $pathName.commands]

    enabled_by_variable ::gui(can_retrieve) \
        ::ttk::button $commands.retrieve -command get-mail-start -text "Retrieve mail"

    enabled_by_variable ::gui(can_cancel) \
        ::ttk::button $commands.cancel -command get-mail-cancel -text "Cancel" \
        -state disabled

    ::ttk::frame $pathName.messageFrame
    ::ttk::scrollbar $pathName.messageFrame.vsb -orient vertical \
        -command [list $pathName.messages yview]

    alias w_progress [ ::ttk::progressbar $commands.progress ]
    alias w_messageview \
        [::ttk::treeview $pathName.messages -columns {size from subject} \
             -yscrollcommand [list $pathName.messageFrame.vsb set] ]

    foreach {cid cname coptions} {
        "#0" "Msg.#" {-width 50}
        size "Size" {-width 50}
        from "From" {-width 100}
        subject "Subject"
    } {
        $pathName.messages heading $cid -text $cname
        $pathName.messages column $cid {*}$coptions
    }
    grid $commands.retrieve $commands.cancel $commands.progress -padx 10 -pady 10 -sticky nswe
    grid columnconfigure $commands $commands.progress -weight 1
    grid $pathName.commands - -padx 0 -pady 0 -sticky nswe
    grid $pathName.messageFrame - -padx 10 -pady 10 -sticky nswe
    grid $pathName.messages $pathName.messageFrame.vsb -in $pathName.messageFrame -sticky nswe
    grid rowconfigure $pathName $pathName.messageFrame -weight 1
    grid columnconfigure $pathName $pathName.ent_password -weight 1
    grid rowconfigure $pathName.messageFrame $pathName.messages -weight 1
    grid columnconfigure $pathName.messageFrame $pathName.messages -weight 1
    return $pathName
}


## get mail (it's run in coroutine)
proc get-mail {} {
    puts "Mesa rrrrrunning! Mesa wishes yousa good luck!"
    set ::gui(can_retrieve) 0
    scope(exit) set ::gui(can_retrieve) 1
    set ::gui(can_cancel) 1
    scope(exit) set ::gui(can_cancel) 0
    scope(exit) puts "Mesa goodbye. Mesa stack frame cabooooom!"

    set pch [::pop3::open $::gui(host) $::gui(user) $::gui(password)]
    scope(exit) ::pop3::close $pch

    puts "Mesa open mailbox as $pch."
    set msgList [::pop3::list $pch]
    set totalSize 0
    w_messageview delete [w_messageview children {}]
    foreach {msgno size} $msgList {
        incr totalSize $size
        w_messageview insert {} end -id $msgno \
            -text $msgno -values [list $size "unknown" "unknown"]
    }
    if {[llength $msgList] != 0} {
        lappend msgList end 0
        set maxChunkSize 60000
        set currentChunkSize 0
        set startFrom next
        set totalDoneSize 0
        foreach {msgno size} $msgList {
            if {$startFrom eq "next"} {set startFrom $msgno}
            incr currentChunkSize $size
            if {$msgno eq "end" || $currentChunkSize > $maxChunkSize} {
                puts "retrieving $startFrom - $msgno"
                set retrieved $startFrom
                foreach body [::pop3::retrieve $pch $startFrom $msgno] {
                    set mimessage [::mime::initialize -string $body]
                    lassign [ ::mime::getheader $mimessage From ] from
                    lassign [ ::mime::getheader $mimessage Subject ] subject
                    w_messageview set $retrieved from $from
                    w_messageview set $retrieved subject $subject
                    ::mime::finalize $mimessage
                    incr retrieved
                }
                incr totalDoneSize $currentChunkSize
                w_progress configure -value [ expr {100*$totalDoneSize / $totalSize}]
                set currentChunkSize 0
                set startFrom next
            }
        }
    }
}

## cancel getting mail
proc get-mail-cancel {} {
    rename ::task.get-mail ""
}

## create the coroutine for getting mail
proc get-mail-start {} {
    if {[info commands task.get-mail] eq ""} {
        coroutine task.get-mail get-mail
    }
}


## simple demo code
package require Tk 8.6
if {[tk windowingsystem] eq "x11"} {
    ttk::setTheme alt ;# 'cause I like it this way
}

pack [popper-gui .popper] -fill both -expand yes

Настоящая адаптация пакетов к безопасному vwait и асинхронной работе ничуть не сложнее используемых нами извращений, хоть и менее эффектно выглядит. Для этого импорт команд из coutils нужно просто добавить в исходный текст самих пакетов, вместо того чтобы всовывать их сбоку. Но есть идея, которая может оказаться более продуктивной: заменить нашими хитрыми версиями соответствующие глобальные команды, чтобы все пакеты приобрели желаемое поведение. Естественно, подразумеваемая асинхронность сокета не годится для общесистемной версии команды socket, поэтому такая неожиданность должна срабатывать не автоматически, а по определённому флагу.

Мы обязательно вернёмся к этой задаче, когда будем рассматривать способы, опасности, преимущества и недостатки перехвата чужих команд. Интересно, что перехват команд не является чем-то осуждаемым или сомнительным в тиклерской среде, по крайней мере при его умеренном использовании. В числе уважаемых и стабильных пакетов, пользующихся этой техникой, можно упомянуть tkcon.

В нашем примере используется ещё одно свойство сопрограмм: возможность их принудительного удаления до того, как они завершатся. К сожалению, конструкции вроде scope(exit) на настоящий момент являются единственным способом освободить ресурсы, выделенные в сопрограмме, при её внезапном удалении.

Заглянем под капот: сопрограммы изнутри

Поддержка сопрограмм потребовала серьёзной работы над кодом интерпретатора TCL, причём некоторую часть этой работы только предстоит сделать. Разработчиками TCL был реализован механизм нерекурсивных вычислений, который стал частью публичного API. На ранних этапах работы над поддержкой сопрограмм было сформулировано следующее ограничение: уровень системного стека (Си) в момент выполнения yield должен совпадать с его уровнем в момент запуска того «кванта» сопрограммы, в котором yield выполняется.

Несоблюдение этого ограничения открыло бы два фронта работ и источника багов в дополнение к уже существующим. Во-первых, управление множеством аппаратных стеков — системно-зависимая и процессорно-зависимая задача. Такая задача решена, например, в библиотеке Tango для языка D, которая поддерживает кооперативные потоки (Fibers) для D и C; но Tango доступна на меньшем количестве платформ, чем TCL. Во-вторых, размышления о том, как разматывать системный стек для внезапно удаляемой сопрограммы, подскажут вам, что для этого есть два более-менее разумных пути, и оба из них нехороши.

Выполнение TCL-скриптов происходит с использованием двух механизмов, устроенных совершенно по-разному, но приводящих (в отсутствие багов, разумеется) к одинаковому результату. Скомпилированные в байт-код системные примитивы выполняются в цикле интерпретатором байт-кода, а все остальные команды выполняются путём вызова функций типа Tcl_ObjCmdProc через указатели.

Каждая системная команда, компилируемая в байт-код, имеет и классическую реализацию в виде функции типа Tcl_ObjCmdProc. Таким образом, у многих системных команд есть две реализации; некоторые обнаруженные ошибки в TCL выражались в том, что их поведение не совпадало.

Рассмотрим состояние C-стека в TCL 8.5 и ниже при выполнении цикла foreach с использованием некомпилированной версии этой команды.

В этом случае условие для yield не выполнено, и в классической реализации foreach оно выполнено быть не может. Аналогичная проблема существует, разумеется, и для остальных управляющих конструкций.

Чтобы сопрограмма могла прерываться изнутри управляющих конструкций, был принят новый подход к их реализации. Если команда, реализованная на Си, должна вызвать скрипт и при этом допускать yield изнутри этого скрипта, она должна вместо Tcl_EvalObj выполнить следующие действия:

• заказать отложенное вычисление скрипта через Tcl_NREvalObj;
• (опционально) заказать функцию постобработки результата через Tcl_NRAddCallback
• вернуть управление в вызывающую функцию.

Переделки, требуемые для функций на языке Си для поддержки NRE, очень похожи на то, что мы делали на уровне скриптов с пакетом http в одном из примеров: единая функция разбивается на части, реализующие несколько этапов задачи. Как мы видим, такая работа, проделанная разработчиками интерпретатора, позволяет нам избежать аналогичной работы на уровне скриптов. А это очень приятно, потому что интерпретатор пишут они, а скрипты пишем мы.

Ни одно из известных мне «внешних» расширений TCL не поддерживает NRE для обратных вызовов в настоящий момент. К счастью, это не мешает пользоваться yield во всех остальных местах, кроме непосредственного обратного вызова из неподдерживающего NRE расширения. Исполнять куски сопрограмм в обработчиках событий Tk это тоже не мешает.

Пакет TclOO (включённое в состав TCL объектно-ориентированное расширение) поддерживает NRE, так что yield из реализации методов допускается.

Сопрограммы как источник проблем

Благодаря кооперативным потокам мы получаем некоторые преимущества, свойственные потокам «настоящим», системным, но вместе с этим к нам приходят и некоторые проблемы, аналогичные проблемам «настоящих» потоков. Естественно, речь не идёт о том, что puts прервётся в середине строки, или о том, что значение переменной при dict set изменится между считыванием и записью. Но теперь каждый обратный вызов может таить в себе yield; а каждый yield может означать потенциальное прибитие сопрограммы, что может означать утечку ресурсов.

В наших примерах мы успешно предотвращаем утечку с помощью scope(exit), но пакеты, написанные без учёта существования сопрограмм, имеют моральное право ожидать, что catch или try ... finally будет для этого достаточно. Однако для текущей реализации уничтожения сопрограмм это не так.

До сих пор в TCL не было никакой необходимости в переменных с динамической областью видимости (как special variables в Common Lisp или все переменные в emacs lisp). Их роль с успехом выполняли глобальные переменные: можно было сохранить переменную, установить в нужное значение, выполнить скрипт под catch и восстановить переменную обратно. Проблемы возникают только тогда, когда скрипт обратного вызова выполняет vwait, tkwait или update. А при этом, как мы упоминали выше, проблемы будут в любом случае, так что можно просто попросить, чтобы никто так не делал.

Теперь же, в условиях, когда могут постоянно выполняться куски сопрограмм, необходимость в динамической области видимости непременно проявится. Я уже придумал пару способов (или, как выразятся тиклефобы, «костыликов») имитировать динамическую видимость чисто скриптовыми средствами, но всё же было бы приятнее иметь такие вещи в самом языке.