ycl

Check-in [9863ad3990]
Login

Check-in [9863ad3990]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:interp process change [call] to [eval]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 9863ad3990f1e7582b9e7daddb692ff3c314bc11
User & Date: pooryorick 2019-10-15 14:14:21.378
Context
2019-10-15
20:17
var new routine
constant
 check-in: ced523f891 user: pooryorick tags: trunk
14:14
interp process change [call] to [eval] check-in: 9863ad3990 user: pooryorick tags: trunk
14:03
list deep replace "struct" with "deep"

interp process

new package
 check-in: 37c510501f user: pooryorick tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to packages/interp/lib/process.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49























50
51
52
53
54
55
56

#! /usr/bin/env tclsh

package require Thread

package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
alias [yclprefix]::proc::optswitch

package require {ycl list}
alias [yclprefix]::list::take


proc call {process cmd} {
	set call [namespace current]::processes::${process}::calls::[info cmdcount]
	namespace eval $call {}
	set varname ${call}::response
	set cmdprefix [::list ::apply [
		::list {coroutine process call args} {

		::tailcall $coroutine done $process $call
	} [namespace current]] [info coroutine] $process $call]
	set trace [::list $varname write $cmdprefix]
	set ${call}::trace $trace
	trace add variable {*}$trace
	set ${call}::caller [info coroutine]
	thread::send -async $process $cmd $varname
	yield
}


proc calls process {
	lsort -dictionary [namespace children processes::${process}::calls]
}


proc calls_interrupt {reason callers process status} {
	foreach caller $callers {
		$caller $reason $process $status
	}
}


proc cleanup {process reason status} {
	set callers [lmap call [calls $process] {
		namespace upvar $call caller caller
		set caller
	}]
	namespace delete processes::$process
	calls_interrupt $reason $callers $process $status























}


proc exited {process status} {
	cleanup $process exited $status
}














<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|







|
|



|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12























13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

#! /usr/bin/env tclsh

package require Thread

package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
alias [yclprefix]::proc::optswitch

package require {ycl list}
alias [yclprefix]::list::take

























proc evals_interrupt {reason callers process status} {
	foreach caller $callers {
		$caller $reason $process $status
	}
}


proc cleanup {process reason status} {
	set callers [lmap eval [evals $process] {
		namespace upvar $eval caller caller
		set caller
	}]
	namespace delete processes::$process
	evals_interrupt $reason $callers $process $status
}


proc eval {process cmd} {
	set eval [namespace current]::processes::${process}::evals::[info cmdcount]
	namespace eval $eval {}
	set varname ${eval}::response
	set cmdprefix [::list ::apply [
		::list {coroutine process eval args} {

		::tailcall $coroutine done $process $eval
	} [namespace current]] [info coroutine] $process $eval]
	set trace [::list $varname write $cmdprefix]
	set ${eval}::trace $trace
	trace add variable {*}$trace
	set ${eval}::caller [info coroutine]
	thread::send -async $process $cmd $varname
	yield
}


proc evals process {
	lsort -dictionary [namespace children processes::${process}::evals]
}


proc exited {process status} {
	cleanup $process exited $status
}
︙︙
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138


		::rename ::exit {}
		proc ::exit status {
			thread::send -async @controller@ "@command@ [thread::id] $status"
			thread::release
		}
	}]
	namespace eval processes::${thread}::calls {}
	if {[info exists config]} {
		call $thread $config
	}
	set res [call $thread $cmd]
	if {$kill} {
		kill $thread
	}
	return $res
}


proc yield {} {
	set args [lassign [::yieldto return -level 0 [info coroutine]] cstatus]
	switch $cstatus {
		done {
			lassign $args process call
			namespace upvar $call response response trace trace
			trace remove variable {*}$trace
			set res $response
			namespace delete $call
			return $res
		}
		exited - killed {
			lassign $args process status
			error [::list [::list process $cstatus] \
				process $process status $status]
		}
		default {
			error [::list {unknown call status} $cstatus]
		}
	}
}


namespace eval processes {}










|

|

|











|
|


|








|









94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138


		::rename ::exit {}
		proc ::exit status {
			thread::send -async @controller@ "@command@ [thread::id] $status"
			thread::release
		}
	}]
	namespace eval processes::${thread}::evals {}
	if {[info exists config]} {
		eval $thread $config
	}
	set res [eval $thread $cmd]
	if {$kill} {
		kill $thread
	}
	return $res
}


proc yield {} {
	set args [lassign [::yieldto return -level 0 [info coroutine]] cstatus]
	switch $cstatus {
		done {
			lassign $args process eval
			namespace upvar $eval response response trace trace
			trace remove variable {*}$trace
			set res $response
			namespace delete $eval
			return $res
		}
		exited - killed {
			lassign $args process status
			error [::list [::list process $cstatus] \
				process $process status $status]
		}
		default {
			error [::list {unknown eval status} $cstatus]
		}
	}
}


namespace eval processes {}