aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorPeter Drahoš <drahosp@gmail.com>2010-10-01 03:22:32 +0200
committerPeter Drahoš <drahosp@gmail.com>2010-10-01 03:22:32 +0200
commit89d9c98af1ac352ba4d49d660e61b0853d6e1a86 (patch)
tree15c56d2ce66b4ab147171c0f674cdb4a435ff13f /src
downloadlanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.tar.gz
lanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.tar.bz2
lanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.zip
Import to git
Diffstat (limited to 'src')
-rw-r--r--src/Makefile176
-rw-r--r--src/keeper.lua244
-rw-r--r--src/lanes.c1849
-rw-r--r--src/lanes.lua611
-rw-r--r--src/threading.c721
-rw-r--r--src/threading.h196
-rw-r--r--src/tools.c1198
-rw-r--r--src/tools.h72
8 files changed, 5067 insertions, 0 deletions
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..a17e9cd
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,176 @@
1#
2# Lanes/src/Makefile
3#
4# make [LUA=... LUAC=...] Manual build
5# make LUAROCKS=1 CFLAGS=... LIBFLAG=... LUA=... LUAC=... LuaRocks automated build
6#
7
8MODULE=lanes
9
10SRC=lanes.c threading.c tools.c
11
12OBJ=$(SRC:.c=.o)
13
14# LuaRocks gives 'LIBFLAG' from the outside
15#
16LIBFLAG=-shared
17
18OPT_FLAGS=-O2
19 # -O0 -g
20
21LUA=lua
22LUAC=luac
23
24_SO=.so
25ifeq "$(findstring MINGW32,$(shell uname -s))" "MINGW32"
26 _SO=.dll
27endif
28
29ifeq "$(LUAROCKS)" ""
30 ifeq "$(findstring MINGW32,$(shell uname -s))" "MINGW32"
31 # MinGW MSYS on Windows
32 #
33 # - 'lua' and 'luac' expected to be on the path
34 # - %LUA_DEV% must lead to include files and libraries (Lua for Windows >= 5.1.3.14)
35 # - %MSCVR80% must be the full pathname of 'msvcr80.dll'
36 #
37 ifeq "$(LUA_DEV)" ""
38 $(error LUA_DEV not defined - try i.e. 'make LUA_DEV=/c/Program\ Files/Lua/5.1')
39 endif
40 ifeq "$(MSVCR80)" ""
41 MSVCR80:=$(LUA_DEV)/install/support/Microsoft.VC80.CRT.SP1/MSVCR80.DLL
42 ifneq '$(shell test -f "$(MSVCR80)" && echo found)' 'found'
43 $(error MSVCR80 not defined - set it to full path of msvcr80.dll')
44 endif
45 $(warning MSVCR80=$(MSVCR80))
46 endif
47 LUA_FLAGS:=-I "$(LUA_DEV)/include"
48 LUA_LIBS:="$(LUA_DEV)/lua5.1.dll" -lgcc -lmsvcr80 "$(MSVCR80)"
49 LIBFLAG=-shared -Wl,-Map,lanes.map
50 else
51 # Autodetect LUA_FLAGS and/or LUA_LIBS
52 #
53 ifneq "$(shell which pkg-config)" ""
54 ifeq "$(shell pkg-config --exists lua5.1 && echo 1)" "1"
55 LUA_FLAGS:=$(shell pkg-config --cflags lua5.1)
56 LUA_LIBS:=$(shell pkg-config --libs lua5.1)
57 #
58 # Ubuntu: -I/usr/include/lua5.1
59 # -llua5.1
60 else
61 ifeq "$(shell pkg-config --exists lua && echo 1)" "1"
62 LUA_FLAGS:=$(shell pkg-config --cflags lua)
63 LUA_LIBS:=$(shell pkg-config --libs lua)
64 #
65 # OS X fink with pkg-config:
66 # -I/sw/include
67 # -L/sw/lib -llua -lm
68 else
69 $(warning *** 'pkg-config' existed but did not know of 'lua[5.1]' - Good luck!)
70 LUA_FLAGS:=
71 LUA_LIBS:=-llua
72 endif
73 endif
74 else
75 # No 'pkg-config'; try defaults
76 #
77 ifeq "$(shell uname -s)" "Darwin"
78 $(warning *** Assuming 'fink' at default path)
79 LUA_FLAGS:=-I/sw/include
80 LUA_LIBS:=-L/sw/lib -llua
81 else
82 $(warning *** Assuming an arbitrary Lua installation; try installing 'pkg-config')
83 LUA_FLAGS:=
84 LUA_LIBS:=-llua
85 endif
86 endif
87 endif
88
89 ifeq "$(shell uname -s)" "Darwin"
90 # Some machines need 'MACOSX_DEPLOYMENT_TARGET=10.3' for using '-undefined dynamic_lookup'
91 # (at least PowerPC running 10.4.11); does not harm the others
92 #
93 CC = MACOSX_DEPLOYMENT_TARGET=10.3 gcc
94 LIBFLAG = -bundle -undefined dynamic_lookup
95 endif
96
97 CFLAGS=-Wall -Werror $(OPT_FLAGS) $(LUA_FLAGS)
98 LIBS=$(LUA_LIBS)
99endif
100
101#---
102# PThread platform specifics
103#
104ifeq "$(shell uname -s)" "Linux"
105 # -D_GNU_SOURCE needed for 'pthread_mutexattr_settype'
106 CFLAGS += -D_GNU_SOURCE -fPIC
107
108 # Use of -DUSE_PTHREAD_TIMEDJOIN is possible, but not recommended (slower & keeps threads
109 # unreleased somewhat longer)
110 #CFLAGS += -DUSE_PTHREAD_TIMEDJOIN
111
112 LIBS += -lpthread
113endif
114
115ifeq "$(shell uname -s)" "BSD"
116 LIBS += -lpthread
117endif
118
119#---
120all: lua51-$(MODULE)$(_SO)
121
122%.o: %.c *.h Makefile
123
124# Note: Don't put $(LUA_LIBS) ahead of $^; MSYS will not like that (I think)
125#
126lua51-$(MODULE)$(_SO): $(OBJ)
127 $(CC) $(LIBFLAG) $(LIBS) $^ $(LUA_LIBS) -o $@
128
129clean:
130 -rm -rf lua51-$(MODULE)$(_SO) *.lch *.o *.tmp *.map
131
132lanes.o: keeper.lch
133
134# Note: 'luac -o -' could be used on systems other than Windows (where pipes
135# are binary). We need to support MinGW as well, so a temporary file.
136#
137%.lch: %.lua
138 $(LUAC) -o $@.tmp $<
139 $(LUA) ../tools/bin2c.lua $@.tmp -o $@
140 -rm $@.tmp
141
142#---
143# NSLU2 "slug" Linux ARM
144#
145nslu2:
146 $(MAKE) all CFLAGS="$(CFLAGS) -I/opt/include -L/opt/lib -D_GNU_SOURCE -lpthread"
147
148#---
149# Cross compiling to Win32 (MinGW on OS X Intel)
150#
151# Point WIN32_LUA51 to an extraction of LuaBinaries dll8 and dev packages.
152#
153# Note: Only works on platforms with same endianess (i.e. not from PowerPC OS X,
154# since 'luac' uses the host endianess)
155#
156# EXPERIMENTAL; NOT TESTED OF LATE.
157#
158MINGW_GCC=mingw32-gcc
159 # i686-pc-mingw32-gcc
160
161win32: $(WIN32_LUA51)/include/lua.h
162 $(MAKE) build CC=$(MINGW_GCC) \
163 LUA_FLAGS=-I$(WIN32_LUA51)/include \
164 LUA_LIBS="-L$(WIN32_LUA51) -llua51" \
165 _SO=.dll \
166 SO_FLAGS=-shared \
167 LUA=lua51 \
168 LUAC=luac51
169
170$(WIN32_LUA51)/include/lua.h:
171 @echo "Usage: make win32 WIN32_LUA51=<path of extracted LuaBinaries dll8 and dev packages>"
172 @echo " [MINGW_GCC=...mingw32-gcc]"
173 @false
174
175.PROXY: all clean nslu2 win32
176
diff --git a/src/keeper.lua b/src/keeper.lua
new file mode 100644
index 0000000..f76173b
--- /dev/null
+++ b/src/keeper.lua
@@ -0,0 +1,244 @@
1--
2-- KEEPER.LUA
3--
4-- Keeper state logic
5--
6-- This code is read in for each "keeper state", which are the hidden, inter-
7-- mediate data stores used by Lanes inter-state communication objects.
8--
9-- Author: Asko Kauppi <akauppi@gmail.com>
10--
11--[[
12===============================================================================
13
14Copyright (C) 2008 Asko Kauppi <akauppi@gmail.com>
15
16Permission is hereby granted, free of charge, to any person obtaining a copy
17of this software and associated documentation files (the "Software"), to deal
18in the Software without restriction, including without limitation the rights
19to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
20copies of the Software, and to permit persons to whom the Software is
21furnished to do so, subject to the following conditions:
22
23The above copyright notice and this permission notice shall be included in
24all copies or substantial portions of the Software.
25
26THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
27IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
28FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
29AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
30LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
31OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
32THE SOFTWARE.
33
34===============================================================================
35]]--
36
37-- unique key instead of 'nil' in queues
38--
39assert( nil_sentinel )
40
41-- We only need to have base and table libraries (and io for debugging)
42--
43local table_remove= assert( table.remove )
44local table_concat= assert( table.concat )
45
46local function WR(...)
47 if io then
48 io.stderr:write( table_concat({...},'\t').."\n" )
49 end
50end
51
52-----
53-- Actual data store
54--
55-- { [linda_deep_ud]= { key= val [, ...] }
56-- ...
57-- }
58--
59local _data= {}
60
61-----
62-- Entries queued for use when the existing 'data[ud][key]' entry is consumed.
63--
64-- { [linda_deep_ud]= { key= { val [, ... } [, ...] }
65-- ...
66-- }
67--
68local _incoming= {}
69
70-----
71-- Length limits (if any) for queues
72--
73-- 0: don't queue values at all; ':send()' waits if the slot is not vacant
74-- N: allow N values to be queued (slot itself + N-1); wait if full
75-- nil: no limits, '_incoming' may grow endlessly
76--
77local _limits= {}
78
79-----
80-- data_tbl, incoming_tbl, limits_tbl = tables( linda_deep_ud )
81--
82-- Gives appropriate tables for a certain Linda (creates them if needed)
83--
84local function tables( ud )
85 -- tables are created either all or nothing
86 --
87 if not _data[ud] then
88 _data[ud]= {}
89 _incoming[ud]= {}
90 _limits[ud]= {}
91 end
92 return _data[ud], _incoming[ud], _limits[ud]
93end
94
95
96local function DEBUG(title,ud,key)
97 assert( title and ud and key )
98
99 local data,incoming,_= tables(ud)
100
101 local s= tostring(data[key])
102 for _,v in ipairs( incoming[key] or {} ) do
103 s= s..", "..tostring(v)
104 end
105 WR( "*** "..title.." ("..tostring(key).."): ", s )
106end
107
108
109-----
110-- bool= send( linda_deep_ud, key, ... )
111--
112-- Send new data (1..N) to 'key' slot. This send is atomic; all the values
113-- end up one after each other (this is why having possibility for sending
114-- multiple values in one call is deemed important).
115--
116-- If the queue has a limit, values are sent only if all of them fit in.
117--
118-- Returns: 'true' if all the values were placed
119-- 'false' if sending would exceed the queue limit (wait & retry)
120--
121function send( ud, key, ... )
122
123 local data,incoming,limits= tables(ud)
124
125 local n= select('#',...)
126 if n==0 then return true end -- nothing to send
127
128 -- Initialize queue for all keys that have been used with ':send()'
129 --
130 if incoming[key]==nil then
131 incoming[key]= {}
132 end
133
134 local len= data[key] and 1+#incoming[key] or 0
135 local m= limits[key]
136
137 if m and len+n > m then
138 return false -- would exceed the limit; try again later
139 end
140
141 for i=1,n do
142 local val= select(i,...)
143
144 -- 'nil' in the data replaced by sentinel
145 if val==nil then
146 val= nil_sentinel
147 end
148
149 if len==0 then
150 data[key]= val
151 len= 1
152 else
153 incoming[key][len]= val
154 len= len+1
155 end
156 end
157 return true
158end
159
160
161-----
162-- [val, key]= receive( linda_deep_ud, key [, ...] )
163--
164-- Read any of the given keys, consuming the data found. Keys are read in
165-- order.
166--
167function receive( ud, ... )
168
169 local data,incoming,_= tables(ud)
170
171 for i=1,select('#',...) do
172 local key= select(i,...)
173 local val= data[key]
174
175 if val~=nil then
176 if incoming[key] and incoming[key][1]~=nil then
177 -- pop [1] from 'incoming[key]' into the actual slot
178 data[key]= table_remove( incoming[key], 1 )
179 else
180 data[key]= nil -- empty the slot
181 end
182 if val==nil_sentinel then
183 val= nil
184 end
185 return val, key
186 end
187 end
188 --return nil
189end
190
191
192-----
193-- = limit( linda_deep_ud, key, uint )
194--
195function limit( ud, key, n )
196
197 local _,_,limits= tables(ud)
198
199 limits[key]= n
200end
201
202
203-----
204-- void= set( linda_deep_ud, key, [val] )
205--
206function set( ud, key, val )
207
208 local data,incoming,_= tables(ud)
209
210 -- Setting a key to 'nil' really clears it; only queing uses sentinels.
211 --
212 data[key]= val
213 incoming[key]= nil
214end
215
216
217-----
218-- [val]= get( linda_deep_ud, key )
219--
220function get( ud, key )
221
222 local data,_,_= tables(ud)
223
224 local val= data[key]
225 if val==nil_sentinel then
226 val= nil
227 end
228 return val
229end
230
231
232-----
233-- void= clear( linda_deep_ud )
234--
235-- Clear the data structures used for a Linda (at its destructor)
236--
237function clear( ud )
238
239 _data[ud]= nil
240 _incoming[ud]= nil
241 _limits[ud]= nil
242end
243
244
diff --git a/src/lanes.c b/src/lanes.c
new file mode 100644
index 0000000..9b36e4d
--- /dev/null
+++ b/src/lanes.c
@@ -0,0 +1,1849 @@
1/*
2 * LANES.C Copyright (c) 2007-08, Asko Kauppi
3 *
4 * Multithreading in Lua.
5 *
6 * History:
7 * 20-Oct-08 (2.0.2): Added closing of free-running threads, but it does
8 * not seem to eliminate the occasional segfaults at process
9 * exit.
10 * ...
11 * 24-Jun-08 .. 14-Aug-08 AKa: Major revise, Lanes 2008 version (2.0 rc1)
12 * ...
13 * 18-Sep-06 AKa: Started the module.
14 *
15 * Platforms (tested internally):
16 * OS X (10.5.4 PowerPC/Intel)
17 * Linux x86 (Ubuntu 8.04)
18 * Win32 (Windows XP Home SP2, Visual C++ 2005/2008 Express)
19 * PocketPC (TBD)
20 *
21 * Platforms (tested externally):
22 * Win32 (MSYS) by Ross Berteig.
23 *
24 * Platforms (testers appreciated):
25 * Win64 - should work???
26 * Linux x64 - should work
27 * FreeBSD - should work
28 * QNX - porting shouldn't be hard
29 * Sun Solaris - porting shouldn't be hard
30 *
31 * References:
32 * "Porting multithreaded applications from Win32 to Mac OS X":
33 * <http://developer.apple.com/macosx/multithreadedprogramming.html>
34 *
35 * Pthreads:
36 * <http://vergil.chemistry.gatech.edu/resources/programming/threads.html>
37 *
38 * MSDN: <http://msdn2.microsoft.com/en-us/library/ms686679.aspx>
39 *
40 * <http://ridiculousfish.com/blog/archives/2007/02/17/barrier>
41 *
42 * Defines:
43 * -DLINUX_SCHED_RR: all threads are lifted to SCHED_RR category, to
44 * allow negative priorities (-2,-1) be used. Even without this,
45 * using priorities will require 'sudo' privileges on Linux.
46 *
47 * -DUSE_PTHREAD_TIMEDJOIN: use 'pthread_timedjoin_np()' for waiting
48 * for threads with a timeout. This changes the thread cleanup
49 * mechanism slightly (cleans up at the join, not once the thread
50 * has finished). May or may not be a good idea to use it.
51 * Available only in selected operating systems (Linux).
52 *
53 * Bugs:
54 *
55 * To-do:
56 *
57 * ...
58 */
59
60const char *VERSION= "2.0.3";
61
62/*
63===============================================================================
64
65Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com>
66
67Permission is hereby granted, free of charge, to any person obtaining a copy
68of this software and associated documentation files (the "Software"), to deal
69in the Software without restriction, including without limitation the rights
70to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
71copies of the Software, and to permit persons to whom the Software is
72furnished to do so, subject to the following conditions:
73
74The above copyright notice and this permission notice shall be included in
75all copies or substantial portions of the Software.
76
77THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
78IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
79FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
80AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
81LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
82OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
83THE SOFTWARE.
84
85===============================================================================
86*/
87#include <string.h>
88#include <stdio.h>
89#include <ctype.h>
90#include <stdlib.h>
91
92#include "lua.h"
93#include "lauxlib.h"
94
95#include "threading.h"
96#include "tools.h"
97
98#if !((defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC))
99# include <sys/time.h>
100#endif
101
102/* geteuid() */
103#ifdef PLATFORM_LINUX
104# include <unistd.h>
105# include <sys/types.h>
106#endif
107
108/* The selected number is not optimal; needs to be tested. Even using just
109* one keeper state may be good enough (depends on the number of Lindas used
110* in the applications).
111*/
112#define KEEPER_STATES_N 1 // 6
113
114/* Do you want full call stacks, or just the line where the error happened?
115*
116* TBD: The full stack feature does not seem to work (try 'make error').
117*/
118#define ERROR_FULL_STACK
119
120#ifdef ERROR_FULL_STACK
121# define STACK_TRACE_KEY ((void*)lane_error) // used as registry key
122#endif
123
124/*
125* Lua code for the keeper states (baked in)
126*/
127static char keeper_chunk[]=
128#include "keeper.lch"
129
130struct s_lane;
131static bool_t cancel_test( lua_State *L );
132static void cancel_error( lua_State *L );
133
134#define CANCEL_TEST_KEY ((void*)cancel_test) // used as registry key
135#define CANCEL_ERROR ((void*)cancel_error) // 'cancel_error' sentinel
136
137/*
138* registry[FINALIZER_REG_KEY] is either nil (no finalizers) or a table
139* of functions that Lanes will call after the executing 'pcall' has ended.
140*
141* We're NOT using the GC system for finalizer mainly because providing the
142* error (and maybe stack trace) parameters to the finalizer functions would
143* anyways complicate that approach.
144*/
145#define FINALIZER_REG_KEY ((void*)LG_set_finalizer)
146
147struct s_Linda;
148
149#if 1
150# define DEBUG_SIGNAL( msg, signal_ref ) /* */
151#else
152# define DEBUG_SIGNAL( msg, signal_ref ) \
153 { int i; unsigned char *ptr; char buf[999]; \
154 sprintf( buf, ">>> " msg ": %p\t", (signal_ref) ); \
155 ptr= (unsigned char *)signal_ref; \
156 for( i=0; i<sizeof(*signal_ref); i++ ) { \
157 sprintf( strchr(buf,'\0'), "%02x %c ", ptr[i], ptr[i] ); \
158 } \
159 fprintf( stderr, "%s\n", buf ); \
160 }
161#endif
162
163static bool_t thread_cancel( struct s_lane *s, double secs, bool_t force );
164
165
166/*
167* Push a table stored in registry onto Lua stack.
168*
169* If there is no existing table, create one if 'create' is TRUE.
170*
171* Returns: TRUE if a table was pushed
172* FALSE if no table found, not created, and nothing pushed
173*/
174static bool_t push_registry_table( lua_State *L, void *key, bool_t create ) {
175
176 STACK_GROW(L,3);
177
178 lua_pushlightuserdata( L, key );
179 lua_gettable( L, LUA_REGISTRYINDEX );
180
181 if (lua_isnil(L,-1)) {
182 lua_pop(L,1);
183
184 if (!create) return FALSE; // nothing pushed
185
186 lua_newtable(L);
187 lua_pushlightuserdata( L, key );
188 lua_pushvalue(L,-2); // duplicate of the table
189 lua_settable( L, LUA_REGISTRYINDEX );
190
191 // [-1]: table that's also bound in registry
192 }
193 return TRUE; // table pushed
194}
195
196
197/*---=== Serialize require ===---
198*/
199
200static MUTEX_T require_cs;
201
202//---
203// [val]= new_require( ... )
204//
205// Call 'old_require' but only one lane at a time.
206//
207// Upvalues: [1]: original 'require' function
208//
209static int new_require( lua_State *L ) {
210 int rc;
211 int args= lua_gettop(L);
212
213 STACK_GROW(L,1);
214 STACK_CHECK(L)
215
216 // Using 'lua_pcall()' to catch errors; otherwise a failing 'require' would
217 // leave us locked, blocking any future 'require' calls from other lanes.
218 //
219 MUTEX_LOCK( &require_cs );
220 {
221 lua_pushvalue( L, lua_upvalueindex(1) );
222 lua_insert( L, 1 );
223
224 rc= lua_pcall( L, args, 1 /*retvals*/, 0 /*errfunc*/ );
225 //
226 // LUA_ERRRUN / LUA_ERRMEM
227 }
228 MUTEX_UNLOCK( &require_cs );
229
230 if (rc) lua_error(L); // error message already at [-1]
231
232 STACK_END(L,0)
233 return 1;
234}
235
236/*
237* Serialize calls to 'require', if it exists
238*/
239static
240void serialize_require( lua_State *L ) {
241
242 STACK_GROW(L,1);
243 STACK_CHECK(L)
244
245 // Check 'require' is there; if not, do nothing
246 //
247 lua_getglobal( L, "require" );
248 if (lua_isfunction( L, -1 )) {
249 // [-1]: original 'require' function
250
251 lua_pushcclosure( L, new_require, 1 /*upvalues*/ );
252 lua_setglobal( L, "require" );
253
254 } else {
255 // [-1]: nil
256 lua_pop(L,1);
257 }
258
259 STACK_END(L,0)
260}
261
262
263/*---=== Keeper states ===---
264*/
265
266/*
267* Pool of keeper states
268*
269* Access to keeper states is locked (only one OS thread at a time) so the
270* bigger the pool, the less chances of unnecessary waits. Lindas map to the
271* keepers randomly, by a hash.
272*/
273struct s_Keeper {
274 MUTEX_T lock_;
275 lua_State *L;
276} keeper[ KEEPER_STATES_N ];
277
278/* We could use an empty table in 'keeper.lua' as the sentinel, but maybe
279* checking for a lightuserdata is faster.
280*/
281static bool_t nil_sentinel;
282
283/*
284* Initialize keeper states
285*
286* If there is a problem, return an error message (NULL for okay).
287*
288* Note: Any problems would be design flaws; the created Lua state is left
289* unclosed, because it does not really matter. In production code, this
290* function never fails.
291*/
292static const char *init_keepers(void) {
293 unsigned int i;
294 for( i=0; i<KEEPER_STATES_N; i++ ) {
295
296 // Initialize Keeper states with bare minimum of libs (those required
297 // by 'keeper.lua')
298 //
299 lua_State *L= luaL_newstate();
300 if (!L) return "out of memory";
301
302 luaG_openlibs( L, "io,table" ); // 'io' for debugging messages
303
304 lua_pushlightuserdata( L, &nil_sentinel );
305 lua_setglobal( L, "nil_sentinel" );
306
307 // Read in the preloaded chunk (and run it)
308 //
309 if (luaL_loadbuffer( L, keeper_chunk, sizeof(keeper_chunk), "=lanes_keeper" ))
310 return "luaL_loadbuffer() failed"; // LUA_ERRMEM
311
312 if (lua_pcall( L, 0 /*args*/, 0 /*results*/, 0 /*errfunc*/ )) {
313 // LUA_ERRRUN / LUA_ERRMEM / LUA_ERRERR
314 //
315 const char *err= lua_tostring(L,-1);
316 assert(err);
317 return err;
318 }
319
320 MUTEX_INIT( &keeper[i].lock_ );
321 keeper[i].L= L;
322 }
323 return NULL; // ok
324}
325
326static
327struct s_Keeper *keeper_acquire( const void *ptr ) {
328 /*
329 * Any hashing will do that maps pointers to 0..KEEPER_STATES_N-1
330 * consistently.
331 *
332 * Pointers are often aligned by 8 or so - ignore the low order bits
333 */
334 unsigned int i= ((unsigned long)(ptr) >> 3) % KEEPER_STATES_N;
335 struct s_Keeper *K= &keeper[i];
336
337 MUTEX_LOCK( &K->lock_ );
338 return K;
339}
340
341static
342void keeper_release( struct s_Keeper *K ) {
343 MUTEX_UNLOCK( &K->lock_ );
344}
345
346/*
347* Call a function ('func_name') in the keeper state, and pass on the returned
348* values to 'L'.
349*
350* 'linda': deep Linda pointer (used only as a unique table key, first parameter)
351* 'starting_index': first of the rest of parameters (none if 0)
352*
353* Returns: number of return values (pushed to 'L')
354*/
355static
356int keeper_call( lua_State* K, const char *func_name,
357 lua_State *L, struct s_Linda *linda, uint_t starting_index ) {
358
359 int args= starting_index ? (lua_gettop(L) - starting_index +1) : 0;
360 int Ktos= lua_gettop(K);
361 int retvals;
362
363 lua_getglobal( K, func_name );
364 ASSERT_L( lua_isfunction(K,-1) );
365
366 STACK_GROW( K, 1 );
367 lua_pushlightuserdata( K, linda );
368
369 luaG_inter_copy( L,K, args ); // L->K
370 lua_call( K, 1+args, LUA_MULTRET );
371
372 retvals= lua_gettop(K) - Ktos;
373
374 luaG_inter_move( K,L, retvals ); // K->L
375 return retvals;
376}
377
378
379/*---=== Linda ===---
380*/
381
382/*
383* Actual data is kept within a keeper state, which is hashed by the 's_Linda'
384* pointer (which is same to all userdatas pointing to it).
385*/
386struct s_Linda {
387 SIGNAL_T read_happened;
388 SIGNAL_T write_happened;
389};
390
391static int LG_linda_id( lua_State* );
392
393#define lua_toLinda(L,n) ((struct s_Linda *)luaG_todeep( L, LG_linda_id, n ))
394
395
396/*
397* bool= linda_send( linda_ud, [timeout_secs=-1,] key_num|str|bool|lightuserdata, ... )
398*
399* Send one or more values to a Linda. If there is a limit, all values must fit.
400*
401* Returns: 'true' if the value was queued
402* 'false' for timeout (only happens when the queue size is limited)
403*/
404LUAG_FUNC( linda_send ) {
405 struct s_Linda *linda= lua_toLinda( L, 1 );
406 bool_t ret;
407 bool_t cancel= FALSE;
408 struct s_Keeper *K;
409 time_d timeout= -1.0;
410 uint_t key_i= 2; // index of first key, if timeout not there
411
412 if (lua_isnumber(L,2)) {
413 timeout= SIGNAL_TIMEOUT_PREPARE( lua_tonumber(L,2) );
414 key_i++;
415 } else if (lua_isnil(L,2))
416 key_i++;
417
418 if (lua_isnil(L,key_i))
419 luaL_error( L, "nil key" );
420
421 STACK_GROW(L,1);
422
423 K= keeper_acquire( linda );
424 {
425 lua_State *KL= K->L; // need to do this for 'STACK_CHECK'
426STACK_CHECK(KL)
427 while(TRUE) {
428 int pushed;
429
430STACK_MID(KL,0)
431 pushed= keeper_call( K->L, "send", L, linda, key_i );
432 ASSERT_L( pushed==1 );
433
434 ret= lua_toboolean(L,-1);
435 lua_pop(L,1);
436
437 if (ret) {
438 // Wake up ALL waiting threads
439 //
440 SIGNAL_ALL( &linda->write_happened );
441 break;
442
443 } else if (timeout==0.0) {
444 break; /* no wait; instant timeout */
445
446 } else {
447 /* limit faced; push until timeout */
448
449 cancel= cancel_test( L ); // testing here causes no delays
450 if (cancel) break;
451
452 // K lock will be released for the duration of wait and re-acquired
453 //
454 if (!SIGNAL_WAIT( &linda->read_happened, &K->lock_, timeout ))
455 break; // timeout
456 }
457 }
458STACK_END(KL,0)
459 }
460 keeper_release(K);
461
462 if (cancel)
463 cancel_error(L);
464
465 lua_pushboolean( L, ret );
466 return 1;
467}
468
469
470/*
471* [val, key]= linda_receive( linda_ud, [timeout_secs_num=-1], key_num|str|bool|lightuserdata [, ...] )
472*
473* Receive a value from Linda, consuming it.
474*
475* Returns: value received (which is consumed from the slot)
476* key which had it
477*/
478LUAG_FUNC( linda_receive ) {
479 struct s_Linda *linda= lua_toLinda( L, 1 );
480 int pushed;
481 bool_t cancel= FALSE;
482 struct s_Keeper *K;
483 time_d timeout= -1.0;
484 uint_t key_i= 2;
485
486 if (lua_isnumber(L,2)) {
487 timeout= SIGNAL_TIMEOUT_PREPARE( lua_tonumber(L,2) );
488 key_i++;
489 } else if (lua_isnil(L,2))
490 key_i++;
491
492 K= keeper_acquire( linda );
493 {
494 while(TRUE) {
495 pushed= keeper_call( K->L, "receive", L, linda, key_i );
496 if (pushed) {
497 ASSERT_L( pushed==2 );
498
499 // To be done from within the 'K' locking area
500 //
501 SIGNAL_ALL( &linda->read_happened );
502 break;
503
504 } else if (timeout==0.0) {
505 break; /* instant timeout */
506
507 } else { /* nothing received; wait until timeout */
508
509 cancel= cancel_test( L ); // testing here causes no delays
510 if (cancel) break;
511
512 // Release the K lock for the duration of wait, and re-acquire
513 //
514 if (!SIGNAL_WAIT( &linda->write_happened, &K->lock_, timeout ))
515 break;
516 }
517 }
518 }
519 keeper_release(K);
520
521 if (cancel)
522 cancel_error(L);
523
524 return pushed;
525}
526
527
528/*
529* = linda_set( linda_ud, key_num|str|bool|lightuserdata [,value] )
530*
531* Set a value to Linda.
532*
533* Existing slot value is replaced, and possible queue entries removed.
534*/
535LUAG_FUNC( linda_set ) {
536 struct s_Linda *linda= lua_toLinda( L, 1 );
537 bool_t has_value= !lua_isnil(L,3);
538
539 struct s_Keeper *K= keeper_acquire( linda );
540 {
541 int pushed= keeper_call( K->L, "set", L, linda, 2 );
542 ASSERT_L( pushed==0 );
543
544 /* Set the signal from within 'K' locking.
545 */
546 if (has_value) {
547 SIGNAL_ALL( &linda->write_happened );
548 }
549 }
550 keeper_release(K);
551
552 return 0;
553}
554
555
556/*
557* [val]= linda_get( linda_ud, key_num|str|bool|lightuserdata )
558*
559* Get a value from Linda.
560*/
561LUAG_FUNC( linda_get ) {
562 struct s_Linda *linda= lua_toLinda( L, 1 );
563 int pushed;
564
565 struct s_Keeper *K= keeper_acquire( linda );
566 {
567 pushed= keeper_call( K->L, "get", L, linda, 2 );
568 ASSERT_L( pushed==0 || pushed==1 );
569 }
570 keeper_release(K);
571
572 return pushed;
573}
574
575
576/*
577* = linda_limit( linda_ud, key_num|str|bool|lightuserdata, uint [, ...] )
578*
579* Set limits to 1 or more Linda keys.
580*/
581LUAG_FUNC( linda_limit ) {
582 struct s_Linda *linda= lua_toLinda( L, 1 );
583
584 struct s_Keeper *K= keeper_acquire( linda );
585 {
586 int pushed= keeper_call( K->L, "limit", L, linda, 2 );
587 ASSERT_L( pushed==0 );
588 }
589 keeper_release(K);
590
591 return 0;
592}
593
594
595/*
596* lightuserdata= linda_deep( linda_ud )
597*
598* Return the 'deep' userdata pointer, identifying the Linda.
599*
600* This is needed for using Lindas as key indices (timer system needs it);
601* separately created proxies of the same underlying deep object will have
602* different userdata and won't be known to be essentially the same deep one
603* without this.
604*/
605LUAG_FUNC( linda_deep ) {
606 struct s_Linda *linda= lua_toLinda( L, 1 );
607 lua_pushlightuserdata( L, linda ); // just the address
608 return 1;
609}
610
611
612/*
613* Identity function of a shared userdata object.
614*
615* lightuserdata= linda_id( "new" [, ...] )
616* = linda_id( "delete", lightuserdata )
617*
618* Creation and cleanup of actual 'deep' objects. 'luaG_...' will wrap them into
619* regular userdata proxies, per each state using the deep data.
620*
621* tbl= linda_id( "metatable" )
622*
623* Returns a metatable for the proxy objects ('__gc' method not needed; will
624* be added by 'luaG_...')
625*
626* = linda_id( str, ... )
627*
628* For any other strings, the ID function must not react at all. This allows
629* future extensions of the system.
630*/
631LUAG_FUNC( linda_id ) {
632 const char *which= lua_tostring(L,1);
633
634 if (strcmp( which, "new" )==0) {
635 struct s_Linda *s;
636
637 /* We don't use any parameters, but one could (they're at [2..TOS])
638 */
639 ASSERT_L( lua_gettop(L)==1 );
640
641 /* The deep data is allocated separately of Lua stack; we might no
642 * longer be around when last reference to it is being released.
643 * One can use any memory allocation scheme.
644 */
645 s= (struct s_Linda *) malloc( sizeof(struct s_Linda) );
646 ASSERT_L(s);
647
648 SIGNAL_INIT( &s->read_happened );
649 SIGNAL_INIT( &s->write_happened );
650
651 lua_pushlightuserdata( L, s );
652 return 1;
653
654 } else if (strcmp( which, "delete" )==0) {
655 struct s_Keeper *K;
656 struct s_Linda *s= lua_touserdata(L,2);
657 ASSERT_L(s);
658
659 /* Clean associated structures in the keeper state.
660 */
661 K= keeper_acquire(s);
662 {
663 keeper_call( K->L, "clear", L, s, 0 );
664 }
665 keeper_release(K);
666
667 /* There aren't any lanes waiting on these lindas, since all proxies
668 * have been gc'ed. Right?
669 */
670 SIGNAL_FREE( &s->read_happened );
671 SIGNAL_FREE( &s->write_happened );
672 free(s);
673
674 return 0;
675
676 } else if (strcmp( which, "metatable" )==0) {
677
678 STACK_CHECK(L)
679 lua_newtable(L);
680 lua_newtable(L);
681 //
682 // [-2]: linda metatable
683 // [-1]: metatable's to-be .__index table
684
685 lua_pushcfunction( L, LG_linda_send );
686 lua_setfield( L, -2, "send" );
687
688 lua_pushcfunction( L, LG_linda_receive );
689 lua_setfield( L, -2, "receive" );
690
691 lua_pushcfunction( L, LG_linda_limit );
692 lua_setfield( L, -2, "limit" );
693
694 lua_pushcfunction( L, LG_linda_set );
695 lua_setfield( L, -2, "set" );
696
697 lua_pushcfunction( L, LG_linda_get );
698 lua_setfield( L, -2, "get" );
699
700 lua_pushcfunction( L, LG_linda_deep );
701 lua_setfield( L, -2, "deep" );
702
703 lua_setfield( L, -2, "__index" );
704 STACK_END(L,1)
705
706 return 1;
707 }
708
709 return 0; // unknown request, be quiet
710}
711
712
713/*---=== Finalizer ===---
714*/
715
716//---
717// void= finalizer( finalizer_func )
718//
719// finalizer_func( [err, stack_tbl] )
720//
721// Add a function that will be called when exiting the lane, either via
722// normal return or an error.
723//
724LUAG_FUNC( set_finalizer )
725{
726 STACK_GROW(L,3);
727
728 // Get the current finalizer table (if any)
729 //
730 push_registry_table( L, FINALIZER_REG_KEY, TRUE /*do create if none*/ );
731
732 lua_pushinteger( L, lua_objlen(L,-1)+1 );
733 lua_pushvalue( L, 1 ); // copy of the function
734 lua_settable( L, -3 );
735
736 lua_pop(L,1);
737 return 0;
738}
739
740
741//---
742// Run finalizers - if any - with the given parameters
743//
744// If 'rc' is nonzero, error message and stack index are available as:
745// [-1]: stack trace (table)
746// [-2]: error message (any type)
747//
748// Returns:
749// 0 if finalizers were run without error (or there were none)
750// LUA_ERRxxx return code if any of the finalizers failed
751//
752// TBD: should we add stack trace on failing finalizer, wouldn't be hard..
753//
754static int run_finalizers( lua_State *L, int lua_rc )
755{
756 unsigned error_index, tbl_index;
757 unsigned n;
758 int rc= 0;
759
760 if (!push_registry_table(L, FINALIZER_REG_KEY, FALSE /*don't create one*/))
761 return 0; // no finalizers
762
763 tbl_index= lua_gettop(L);
764 error_index= (lua_rc!=0) ? tbl_index-1 : 0; // absolute indices
765
766 STACK_GROW(L,4);
767
768 // [-1]: { func [, ...] }
769 //
770 for( n= lua_objlen(L,-1); n>0; n-- ) {
771 unsigned args= 0;
772 lua_pushinteger( L,n );
773 lua_gettable( L, -2 );
774
775 // [-1]: function
776 // [-2]: finalizers table
777
778 if (error_index) {
779 lua_pushvalue( L, error_index );
780 lua_pushvalue( L, error_index+1 ); // stack trace
781 args= 2;
782 }
783
784 rc= lua_pcall( L, args, 0 /*retvals*/, 0 /*no errfunc*/ );
785 //
786 // LUA_ERRRUN / LUA_ERRMEM
787
788 if (rc!=0) {
789 // [-1]: error message
790 //
791 // If one finalizer fails, don't run the others. Return this
792 // as the 'real' error, preceding that we could have had (or not)
793 // from the actual code.
794 //
795 break;
796 }
797 }
798
799 lua_remove(L,tbl_index); // take finalizer table out of stack
800
801 return rc;
802}
803
804
805/*---=== Threads ===---
806*/
807
808// NOTE: values to be changed by either thread, during execution, without
809// locking, are marked "volatile"
810//
811struct s_lane {
812 THREAD_T thread;
813 //
814 // M: sub-thread OS thread
815 // S: not used
816
817 lua_State *L;
818 //
819 // M: prepares the state, and reads results
820 // S: while S is running, M must keep out of modifying the state
821
822 volatile enum e_status status;
823 //
824 // M: sets to PENDING (before launching)
825 // S: updates -> RUNNING/WAITING -> DONE/ERROR_ST/CANCELLED
826
827 volatile bool_t cancel_request;
828 //
829 // M: sets to FALSE, flags TRUE for cancel request
830 // S: reads to see if cancel is requested
831
832#if !( (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN) )
833 SIGNAL_T done_signal_;
834 //
835 // M: Waited upon at lane ending (if Posix with no PTHREAD_TIMEDJOIN)
836 // S: sets the signal once cancellation is noticed (avoids a kill)
837
838 MUTEX_T done_lock_;
839 //
840 // Lock required by 'done_signal' condition variable, protecting
841 // lane status changes to DONE/ERROR_ST/CANCELLED.
842#endif
843
844 volatile enum {
845 NORMAL, // normal master side state
846 KILLED // issued an OS kill
847 } mstatus;
848 //
849 // M: sets to NORMAL, if issued a kill changes to KILLED
850 // S: not used
851
852 struct s_lane * volatile selfdestruct_next;
853 //
854 // M: sets to non-NULL if facing lane handle '__gc' cycle but the lane
855 // is still running
856 // S: cleans up after itself if non-NULL at lane exit
857};
858
859static MUTEX_T selfdestruct_cs;
860 //
861 // Protects modifying the selfdestruct chain
862
863#define SELFDESTRUCT_END ((struct s_lane *)(-1))
864 //
865 // The chain is ended by '(struct s_lane*)(-1)', not NULL:
866 // 'selfdestruct_first -> ... -> ... -> (-1)'
867
868struct s_lane * volatile selfdestruct_first= SELFDESTRUCT_END;
869
870/*
871* Add the lane to selfdestruct chain; the ones still running at the end of the
872* whole process will be cancelled.
873*/
874static void selfdestruct_add( struct s_lane *s ) {
875
876 MUTEX_LOCK( &selfdestruct_cs );
877 {
878 assert( s->selfdestruct_next == NULL );
879
880 s->selfdestruct_next= selfdestruct_first;
881 selfdestruct_first= s;
882 }
883 MUTEX_UNLOCK( &selfdestruct_cs );
884}
885
886/*
887* A free-running lane has ended; remove it from selfdestruct chain
888*/
889static void selfdestruct_remove( struct s_lane *s ) {
890
891 MUTEX_LOCK( &selfdestruct_cs );
892 {
893 // Make sure (within the MUTEX) that we actually are in the chain
894 // still (at process exit they will remove us from chain and then
895 // cancel/kill).
896 //
897 if (s->selfdestruct_next != NULL) {
898 struct s_lane **ref= (struct s_lane **) &selfdestruct_first;
899 bool_t found= FALSE;
900
901 while( *ref != SELFDESTRUCT_END ) {
902 if (*ref == s) {
903 *ref= s->selfdestruct_next;
904 s->selfdestruct_next= NULL;
905 found= TRUE;
906 break;
907 }
908 ref= (struct s_lane **) &((*ref)->selfdestruct_next);
909 }
910 assert( found );
911 }
912 }
913 MUTEX_UNLOCK( &selfdestruct_cs );
914}
915
916/*
917* Process end; cancel any still free-running threads
918*/
919static void selfdestruct_atexit( void ) {
920
921 if (selfdestruct_first == SELFDESTRUCT_END) return; // no free-running threads
922
923 // Signal _all_ still running threads to exit
924 //
925 MUTEX_LOCK( &selfdestruct_cs );
926 {
927 struct s_lane *s= selfdestruct_first;
928 while( s != SELFDESTRUCT_END ) {
929 s->cancel_request= TRUE;
930 s= s->selfdestruct_next;
931 }
932 }
933 MUTEX_UNLOCK( &selfdestruct_cs );
934
935 // When noticing their cancel, the lanes will remove themselves from
936 // the selfdestruct chain.
937
938 // TBD: Not sure if Windows (multi core) will require the timed approach,
939 // or single Yield. I don't have machine to test that (so leaving
940 // for timed approach). -- AKa 25-Oct-2008
941
942#ifdef PLATFORM_LINUX
943 // It seems enough for Linux to have a single yield here, which allows
944 // other threads (timer lane) to proceed. Without the yield, there is
945 // segfault.
946 //
947 YIELD();
948#else
949 // OS X 10.5 (Intel) needs more to avoid segfaults.
950 //
951 // "make test" is okay. 100's of "make require" are okay.
952 //
953 // Tested on MacBook Core Duo 2GHz and 10.5.5:
954 // -- AKa 25-Oct-2008
955 //
956 #ifndef ATEXIT_WAIT_SECS
957 # define ATEXIT_WAIT_SECS (0.1)
958 #endif
959 {
960 double t_until= now_secs() + ATEXIT_WAIT_SECS;
961
962 while( selfdestruct_first != SELFDESTRUCT_END ) {
963 YIELD(); // give threads time to act on their cancel
964
965 if (now_secs() >= t_until) break;
966 }
967 }
968#endif
969
970 //---
971 // Kill the still free running threads
972 //
973 if ( selfdestruct_first != SELFDESTRUCT_END ) {
974 unsigned n=0;
975 MUTEX_LOCK( &selfdestruct_cs );
976 {
977 struct s_lane *s= selfdestruct_first;
978 while( s != SELFDESTRUCT_END ) {
979 n++;
980 s= s->selfdestruct_next;
981 }
982 }
983 MUTEX_UNLOCK( &selfdestruct_cs );
984
985 // Linux (at least 64-bit): CAUSES A SEGFAULT IF THIS BLOCK IS ENABLED
986 // and works without the block (so let's leave those lanes running)
987 //
988#if 1
989 // 2.0.2: at least timer lane is still here
990 //
991 //fprintf( stderr, "Left %d lane(s) with cancel request at process end.\n", n );
992#else
993 MUTEX_LOCK( &selfdestruct_cs );
994 {
995 struct s_lane *s= selfdestruct_first;
996 while( s != SELFDESTRUCT_END ) {
997 struct s_lane *next_s= s->selfdestruct_next;
998 s->selfdestruct_next= NULL; // detach from selfdestruct chain
999
1000 THREAD_KILL( &s->thread );
1001 s= next_s;
1002 n++;
1003 }
1004 selfdestruct_first= SELFDESTRUCT_END;
1005 }
1006 MUTEX_UNLOCK( &selfdestruct_cs );
1007
1008 fprintf( stderr, "Killed %d lane(s) at process end.\n", n );
1009#endif
1010 }
1011}
1012
1013
1014// To allow free-running threads (longer lifespan than the handle's)
1015// 'struct s_lane' are malloc/free'd and the handle only carries a pointer.
1016// This is not deep userdata since the handle's not portable among lanes.
1017//
1018#define lua_toLane(L,i) (* ((struct s_lane**) lua_touserdata(L,i)))
1019
1020
1021/*
1022* Check if the thread in question ('L') has been signalled for cancel.
1023*
1024* Called by cancellation hooks and/or pending Linda operations (because then
1025* the check won't affect performance).
1026*
1027* Returns TRUE if any locks are to be exited, and 'cancel_error()' called,
1028* to make execution of the lane end.
1029*/
1030static bool_t cancel_test( lua_State *L ) {
1031 struct s_lane *s;
1032
1033 STACK_GROW(L,1);
1034
1035 STACK_CHECK(L)
1036 lua_pushlightuserdata( L, CANCEL_TEST_KEY );
1037 lua_rawget( L, LUA_REGISTRYINDEX );
1038 s= lua_touserdata( L, -1 ); // lightuserdata (true 's_lane' pointer) / nil
1039 lua_pop(L,1);
1040 STACK_END(L,0)
1041
1042 // 's' is NULL for the original main state (no-one can cancel that)
1043 //
1044 return s && s->cancel_request;
1045}
1046
1047static void cancel_error( lua_State *L ) {
1048 STACK_GROW(L,1);
1049 lua_pushlightuserdata( L, CANCEL_ERROR ); // special error value
1050 lua_error(L); // no return
1051}
1052
1053static void cancel_hook( lua_State *L, lua_Debug *ar ) {
1054 (void)ar;
1055 if (cancel_test(L)) cancel_error(L);
1056}
1057
1058
1059//---
1060// = _single( [cores_uint=1] )
1061//
1062// Limits the process to use only 'cores' CPU cores. To be used for performance
1063// testing on multicore devices. DEBUGGING ONLY!
1064//
1065LUAG_FUNC( _single ) {
1066 uint_t cores= luaG_optunsigned(L,1,1);
1067
1068#ifdef PLATFORM_OSX
1069 #ifdef _UTILBINDTHREADTOCPU
1070 if (cores > 1) luaL_error( L, "Limiting to N>1 cores not possible." );
1071 // requires 'chudInitialize()'
1072 utilBindThreadToCPU(0); // # of CPU to run on (we cannot limit to 2..N CPUs?)
1073 #else
1074 luaL_error( L, "Not available: compile with _UTILBINDTHREADTOCPU" );
1075 #endif
1076#else
1077 luaL_error( L, "not implemented!" );
1078#endif
1079 (void)cores;
1080
1081 return 0;
1082}
1083
1084
1085/*
1086* str= lane_error( error_val|str )
1087*
1088* Called if there's an error in some lane; add call stack to error message
1089* just like 'lua.c' normally does.
1090*
1091* ".. will be called with the error message and its return value will be the
1092* message returned on the stack by lua_pcall."
1093*
1094* Note: Rather than modifying the error message itself, it would be better
1095* to provide the call stack (as string) completely separated. This would
1096* work great with non-string error values as well (current system does not).
1097* (This is NOT possible with the Lua 5.1 'lua_pcall()'; we could of course
1098* implement a Lanes-specific 'pcall' of our own that does this). TBD!!! :)
1099* --AKa 22-Jan-2009
1100*/
1101#ifdef ERROR_FULL_STACK
1102
1103static int lane_error( lua_State *L ) {
1104 lua_Debug ar;
1105 unsigned lev,n;
1106
1107 // [1]: error message (any type)
1108
1109 assert( lua_gettop(L)==1 );
1110
1111 // Don't do stack survey for cancelled lanes.
1112 //
1113#if 1
1114 if (lua_touserdata(L,1) == CANCEL_ERROR)
1115 return 1; // just pass on
1116#endif
1117
1118 // Place stack trace at 'registry[lane_error]' for the 'luc_pcall()'
1119 // caller to fetch. This bypasses the Lua 5.1 limitation of only one
1120 // return value from error handler to 'lua_pcall()' caller.
1121
1122 // It's adequate to push stack trace as a table. This gives the receiver
1123 // of the stack best means to format it to their liking. Also, it allows
1124 // us to add more stack info later, if needed.
1125 //
1126 // table of { "sourcefile.lua:<line>", ... }
1127 //
1128 STACK_GROW(L,3);
1129 lua_newtable(L);
1130
1131 // Best to start from level 1, but in some cases it might be a C function
1132 // and we don't get '.currentline' for that. It's okay - just keep level
1133 // and table index growing separate. --AKa 22-Jan-2009
1134 //
1135 lev= 0;
1136 n=1;
1137 while( lua_getstack(L, ++lev, &ar ) ) {
1138 lua_getinfo(L, "Sl", &ar);
1139 if (ar.currentline > 0) {
1140 lua_pushinteger( L, n++ );
1141 lua_pushfstring( L, "%s:%d", ar.short_src, ar.currentline );
1142 lua_settable( L, -3 );
1143 }
1144 }
1145
1146 lua_pushlightuserdata( L, STACK_TRACE_KEY );
1147 lua_insert(L,-2);
1148 lua_settable( L, LUA_REGISTRYINDEX );
1149
1150 assert( lua_gettop(L)== 1 );
1151
1152 return 1; // the untouched error value
1153}
1154#endif
1155
1156
1157//---
1158#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
1159 static THREAD_RETURN_T __stdcall lane_main( void *vs )
1160#else
1161 static THREAD_RETURN_T lane_main( void *vs )
1162#endif
1163{
1164 struct s_lane *s= (struct s_lane *)vs;
1165 int rc, rc2;
1166 lua_State *L= s->L;
1167
1168 s->status= RUNNING; // PENDING -> RUNNING
1169
1170 // Tie "set_finalizer()" to the state
1171 //
1172 lua_pushcfunction( L, LG_set_finalizer );
1173 lua_setglobal( L, "set_finalizer" );
1174
1175#ifdef ERROR_FULL_STACK
1176 STACK_GROW( L, 1 );
1177 lua_pushcfunction( L, lane_error );
1178 lua_insert( L, 1 );
1179
1180 // [1]: error handler
1181 // [2]: function to run
1182 // [3..top]: parameters
1183 //
1184 rc= lua_pcall( L, lua_gettop(L)-2, LUA_MULTRET, 1 /*error handler*/ );
1185 // 0: no error
1186 // LUA_ERRRUN: a runtime error (error pushed on stack)
1187 // LUA_ERRMEM: memory allocation error
1188 // LUA_ERRERR: error while running the error handler (if any)
1189
1190 assert( rc!=LUA_ERRERR ); // since we've authored it
1191
1192 lua_remove(L,1); // remove error handler
1193
1194 // Lua 5.1 error handler is limited to one return value; taking stack trace
1195 // via registry
1196 //
1197 if (rc!=0) {
1198 STACK_GROW(L,1);
1199 lua_pushlightuserdata( L, STACK_TRACE_KEY );
1200 lua_gettable(L, LUA_REGISTRYINDEX);
1201
1202 // For cancellation, a stack trace isn't placed
1203 //
1204 assert( lua_istable(L,2) || (lua_touserdata(L,1)==CANCEL_ERROR) );
1205
1206 // Just leaving the stack trace table on the stack is enough to get
1207 // it through to the master.
1208 }
1209
1210#else
1211 // This code does not use 'lane_error'
1212 //
1213 // [1]: function to run
1214 // [2..top]: parameters
1215 //
1216 rc= lua_pcall( L, lua_gettop(L)-1, LUA_MULTRET, 0 /*no error handler*/ );
1217 // 0: no error
1218 // LUA_ERRRUN: a runtime error (error pushed on stack)
1219 // LUA_ERRMEM: memory allocation error
1220#endif
1221
1222//STACK_DUMP(L);
1223 // Call finalizers, if the script has set them up.
1224 //
1225 rc2= run_finalizers(L,rc);
1226 if (rc2!=0) {
1227 // Error within a finalizer!
1228 //
1229 // [-1]: error message
1230
1231 rc= rc2; // we're overruling the earlier script error or normal return
1232
1233 lua_insert( L,1 ); // make error message [1]
1234 lua_settop( L,1 ); // remove all rest
1235
1236 // Place an empty stack table just to keep the API simple (always when
1237 // there's an error, there's also stack table - though it may be empty).
1238 //
1239 lua_newtable(L);
1240 }
1241
1242 if (s->selfdestruct_next != NULL) {
1243 // We're a free-running thread and no-one's there to clean us up.
1244 //
1245 lua_close( s->L );
1246 L= 0;
1247
1248 #if !( (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN) )
1249 SIGNAL_FREE( &s->done_signal_ );
1250 MUTEX_FREE( &s->done_lock_ );
1251 #endif
1252 selfdestruct_remove(s); // away from selfdestruct chain
1253 free(s);
1254
1255 } else {
1256 // leave results (1..top) or error message + stack trace (1..2) on the stack - master will copy them
1257
1258 enum e_status st=
1259 (rc==0) ? DONE
1260 : (lua_touserdata(L,1)==CANCEL_ERROR) ? CANCELLED
1261 : ERROR_ST;
1262
1263 // Posix no PTHREAD_TIMEDJOIN:
1264 // 'done_lock' protects the -> DONE|ERROR_ST|CANCELLED state change
1265 //
1266 #if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)
1267 s->status= st;
1268 #else
1269 MUTEX_LOCK( &s->done_lock_ );
1270 {
1271 s->status= st;
1272 SIGNAL_ONE( &s->done_signal_ ); // wake up master (while 's->done_lock' is on)
1273 }
1274 MUTEX_UNLOCK( &s->done_lock_ );
1275 #endif
1276 }
1277
1278 return 0; // ignored
1279}
1280
1281
1282//---
1283// lane_ud= thread_new( function, [libs_str],
1284// [cancelstep_uint=0],
1285// [prio_int=0],
1286// [globals_tbl],
1287// [... args ...] )
1288//
1289// Upvalues: metatable to use for 'lane_ud'
1290//
1291LUAG_FUNC( thread_new )
1292{
1293 lua_State *L2;
1294 struct s_lane *s;
1295 struct s_lane **ud;
1296
1297 const char *libs= lua_tostring( L, 2 );
1298 uint_t cs= luaG_optunsigned( L, 3,0);
1299 int prio= luaL_optinteger( L, 4,0);
1300 uint_t glob= luaG_isany(L,5) ? 5:0;
1301
1302 #define FIXED_ARGS (5)
1303 uint_t args= lua_gettop(L) - FIXED_ARGS;
1304
1305 if (prio < THREAD_PRIO_MIN || prio > THREAD_PRIO_MAX) {
1306 luaL_error( L, "Priority out of range: %d..+%d (%d)",
1307 THREAD_PRIO_MIN, THREAD_PRIO_MAX, prio );
1308 }
1309
1310 /* --- Create and prepare the sub state --- */
1311
1312 L2 = luaL_newstate(); // uses standard 'realloc()'-based allocator,
1313 // sets the panic callback
1314
1315 if (!L2) luaL_error( L, "'luaL_newstate()' failed; out of memory" );
1316
1317 STACK_GROW( L,2 );
1318
1319 // Setting the globals table (needs to be done before loading stdlibs,
1320 // and the lane function)
1321 //
1322 if (glob!=0) {
1323STACK_CHECK(L)
1324 if (!lua_istable(L,glob))
1325 luaL_error( L, "Expected table, got %s", luaG_typename(L,glob) );
1326
1327 lua_pushvalue( L, glob );
1328 luaG_inter_move( L,L2, 1 ); // moves the table to L2
1329
1330 // L2 [-1]: table of globals
1331
1332 // "You can change the global environment of a Lua thread using lua_replace"
1333 // (refman-5.0.pdf p. 30)
1334 //
1335 lua_replace( L2, LUA_GLOBALSINDEX );
1336STACK_END(L,0)
1337 }
1338
1339 // Selected libraries
1340 //
1341 if (libs) {
1342 const char *err= luaG_openlibs( L2, libs );
1343 ASSERT_L( !err ); // bad libs should have been noticed by 'lanes.lua'
1344
1345 serialize_require( L2 );
1346 }
1347
1348 // Lane main function
1349 //
1350STACK_CHECK(L)
1351 lua_pushvalue( L, 1 );
1352 luaG_inter_move( L,L2, 1 ); // L->L2
1353STACK_MID(L,0)
1354
1355 ASSERT_L( lua_gettop(L2) == 1 );
1356 ASSERT_L( lua_isfunction(L2,1) );
1357
1358 // revive arguments
1359 //
1360 if (args) luaG_inter_copy( L,L2, args ); // L->L2
1361STACK_MID(L,0)
1362
1363ASSERT_L( (uint_t)lua_gettop(L2) == 1+args );
1364ASSERT_L( lua_isfunction(L2,1) );
1365
1366 // 's' is allocated from heap, not Lua, since its life span may surpass
1367 // the handle's (if free running thread)
1368 //
1369 ud= lua_newuserdata( L, sizeof(struct s_lane*) );
1370 ASSERT_L(ud);
1371
1372 s= *ud= malloc( sizeof(struct s_lane) );
1373 ASSERT_L(s);
1374
1375 //memset( s, 0, sizeof(struct s_lane) );
1376 s->L= L2;
1377 s->status= PENDING;
1378 s->cancel_request= FALSE;
1379
1380#if !( (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN) )
1381 MUTEX_INIT( &s->done_lock_ );
1382 SIGNAL_INIT( &s->done_signal_ );
1383#endif
1384 s->mstatus= NORMAL;
1385 s->selfdestruct_next= NULL;
1386
1387 // Set metatable for the userdata
1388 //
1389 lua_pushvalue( L, lua_upvalueindex(1) );
1390 lua_setmetatable( L, -2 );
1391STACK_MID(L,1)
1392
1393 // Place 's' to registry, for 'cancel_test()' (even if 'cs'==0 we still
1394 // do cancel tests at pending send/receive).
1395 //
1396 lua_pushlightuserdata( L2, CANCEL_TEST_KEY );
1397 lua_pushlightuserdata( L2, s );
1398 lua_rawset( L2, LUA_REGISTRYINDEX );
1399
1400 if (cs) {
1401 lua_sethook( L2, cancel_hook, LUA_MASKCOUNT, cs );
1402 }
1403
1404 THREAD_CREATE( &s->thread, lane_main, s, prio );
1405STACK_END(L,1)
1406
1407 return 1;
1408}
1409
1410
1411//---
1412// = thread_gc( lane_ud )
1413//
1414// Cleanup for a thread userdata. If the thread is still executing, leave it
1415// alive as a free-running thread (will clean up itself).
1416//
1417// * Why NOT cancel/kill a loose thread:
1418//
1419// At least timer system uses a free-running thread, they should be handy
1420// and the issue of cancelling/killing threads at gc is not very nice, either
1421// (would easily cause waits at gc cycle, which we don't want).
1422//
1423// * Why YES kill a loose thread:
1424//
1425// Current way causes segfaults at program exit, if free-running threads are
1426// in certain stages. Details are not clear, but this is the core reason.
1427// If gc would kill threads then at process exit only one thread would remain.
1428//
1429// Todo: Maybe we should have a clear #define for selecting either behaviour.
1430//
1431LUAG_FUNC( thread_gc ) {
1432 struct s_lane *s= lua_toLane(L,1);
1433
1434 // We can read 's->status' without locks, but not wait for it
1435 //
1436 if (s->status < DONE) {
1437 //
1438 selfdestruct_add(s);
1439 assert( s->selfdestruct_next );
1440 return 0;
1441
1442 } else if (s->mstatus==KILLED) {
1443 // Make sure a kill has proceeded, before cleaning up the data structure.
1444 //
1445 // If not doing 'THREAD_WAIT()' we should close the Lua state here
1446 // (can it be out of order, since we killed the lane abruptly?)
1447 //
1448#if 0
1449 lua_close( s->L );
1450#else
1451fprintf( stderr, "** Joining with a killed thread (needs testing) **" );
1452#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)
1453 THREAD_WAIT( &s->thread, -1 );
1454#else
1455 THREAD_WAIT( &s->thread, &s->done_signal_, &s->done_lock_, &s->status, -1 );
1456#endif
1457fprintf( stderr, "** Joined ok **" );
1458#endif
1459 }
1460
1461 // Clean up after a (finished) thread
1462 //
1463#if (! ((defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)))
1464 SIGNAL_FREE( &s->done_signal_ );
1465 MUTEX_FREE( &s->done_lock_ );
1466 free(s);
1467#endif
1468
1469 return 0;
1470}
1471
1472
1473//---
1474// = thread_cancel( lane_ud [,timeout_secs=0.0] [,force_kill_bool=false] )
1475//
1476// The originator thread asking us specifically to cancel the other thread.
1477//
1478// 'timeout': <0: wait forever, until the lane is finished
1479// 0.0: just signal it to cancel, no time waited
1480// >0: time to wait for the lane to detect cancellation
1481//
1482// 'force_kill': if true, and lane does not detect cancellation within timeout,
1483// it is forcefully killed. Using this with 0.0 timeout means just kill
1484// (unless the lane is already finished).
1485//
1486// Returns: true if the lane was already finished (DONE/ERROR_ST/CANCELLED) or if we
1487// managed to cancel it.
1488// false if the cancellation timed out, or a kill was needed.
1489//
1490LUAG_FUNC( thread_cancel )
1491{
1492 struct s_lane *s= lua_toLane(L,1);
1493 double secs= 0.0;
1494 uint_t force_i=2;
1495 bool_t force, done= TRUE;
1496
1497 if (lua_isnumber(L,2)) {
1498 secs= lua_tonumber(L,2);
1499 force_i++;
1500 } else if (lua_isnil(L,2))
1501 force_i++;
1502
1503 force= lua_toboolean(L,force_i); // FALSE if nothing there
1504
1505 // We can read 's->status' without locks, but not wait for it (if Posix no PTHREAD_TIMEDJOIN)
1506 //
1507 if (s->status < DONE) {
1508 s->cancel_request= TRUE; // it's now signalled to stop
1509
1510 done= thread_cancel( s, secs, force );
1511 }
1512
1513 lua_pushboolean( L, done );
1514 return 1;
1515}
1516
1517static bool_t thread_cancel( struct s_lane *s, double secs, bool_t force )
1518{
1519 bool_t done=
1520#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)
1521 THREAD_WAIT( &s->thread, secs );
1522#else
1523 THREAD_WAIT( &s->thread, &s->done_signal_, &s->done_lock_, &s->status, secs );
1524#endif
1525
1526 if ((!done) && force) {
1527 // Killing is asynchronous; we _will_ wait for it to be done at
1528 // GC, to make sure the data structure can be released (alternative
1529 // would be use of "cancellation cleanup handlers" that at least
1530 // PThread seems to have).
1531 //
1532 THREAD_KILL( &s->thread );
1533 s->mstatus= KILLED; // mark 'gc' to wait for it
1534 }
1535 return done;
1536}
1537
1538
1539//---
1540// str= thread_status( lane_ud )
1541//
1542// Returns: "pending" not started yet
1543// -> "running" started, doing its work..
1544// <-> "waiting" blocked in a receive()
1545// -> "done" finished, results are there
1546// / "error" finished at an error, error value is there
1547// / "cancelled" execution cancelled by M (state gone)
1548//
1549LUAG_FUNC( thread_status )
1550{
1551 struct s_lane *s= lua_toLane(L,1);
1552 enum e_status st= s->status; // read just once (volatile)
1553 const char *str;
1554
1555 if (s->mstatus == KILLED)
1556 st= CANCELLED;
1557
1558 str= (st==PENDING) ? "pending" :
1559 (st==RUNNING) ? "running" : // like in 'co.status()'
1560 (st==WAITING) ? "waiting" :
1561 (st==DONE) ? "done" :
1562 (st==ERROR_ST) ? "error" :
1563 (st==CANCELLED) ? "cancelled" : NULL;
1564 ASSERT_L(str);
1565
1566 lua_pushstring( L, str );
1567 return 1;
1568}
1569
1570
1571//---
1572// [...] | [nil, err_any, stack_tbl]= thread_join( lane_ud [, wait_secs=-1] )
1573//
1574// timeout: returns nil
1575// done: returns return values (0..N)
1576// error: returns nil + error value + stack table
1577// cancelled: returns nil
1578//
1579LUAG_FUNC( thread_join )
1580{
1581 struct s_lane *s= lua_toLane(L,1);
1582 double wait_secs= luaL_optnumber(L,2,-1.0);
1583 lua_State *L2= s->L;
1584 int ret;
1585
1586 bool_t done=
1587#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)
1588 THREAD_WAIT( &s->thread, wait_secs );
1589#else
1590 THREAD_WAIT( &s->thread, &s->done_signal_, &s->done_lock_, &s->status, wait_secs );
1591#endif
1592 if (!done)
1593 return 0; // timeout: pushes none, leaves 'L2' alive
1594
1595 // Thread is DONE/ERROR_ST/CANCELLED; all ours now
1596
1597 STACK_GROW( L, 1 );
1598
1599 switch( s->status ) {
1600 case DONE: {
1601 uint_t n= lua_gettop(L2); // whole L2 stack
1602 luaG_inter_move( L2,L, n );
1603 ret= n;
1604 } break;
1605
1606 case ERROR_ST:
1607 lua_pushnil(L);
1608 luaG_inter_move( L2,L, 2 ); // error message at [-2], stack trace at [-1]
1609 ret= 3;
1610 break;
1611
1612 case CANCELLED:
1613 ret= 0;
1614 break;
1615
1616 default:
1617 fprintf( stderr, "Status: %d\n", s->status );
1618 ASSERT_L( FALSE ); ret= 0;
1619 }
1620 lua_close(L2);
1621
1622 return ret;
1623}
1624
1625
1626/*---=== Timer support ===---
1627*/
1628
1629/*
1630* Push a timer gateway Linda object; only one deep userdata is
1631* created for this, each lane will get its own proxy.
1632*
1633* Note: this needs to be done on the C side; Lua wouldn't be able
1634* to even see, when we've been initialized for the very first
1635* time (with us, they will be).
1636*/
1637static
1638void push_timer_gateway( lua_State *L ) {
1639
1640 /* No need to lock; 'static' is just fine
1641 */
1642 static DEEP_PRELUDE *p; // = NULL
1643
1644 STACK_CHECK(L)
1645 if (!p) {
1646 // Create the Linda (only on first time)
1647 //
1648 // proxy_ud= deep_userdata( idfunc )
1649 //
1650 lua_pushcfunction( L, luaG_deep_userdata );
1651 lua_pushcfunction( L, LG_linda_id );
1652 lua_call( L, 1 /*args*/, 1 /*retvals*/ );
1653
1654 ASSERT_L( lua_isuserdata(L,-1) );
1655
1656 // Proxy userdata contents is only a 'DEEP_PRELUDE*' pointer
1657 //
1658 p= * (DEEP_PRELUDE**) lua_touserdata( L, -1 );
1659 ASSERT_L(p && p->refcount==1 && p->deep);
1660
1661 // [-1]: proxy for accessing the Linda
1662
1663 } else {
1664 /* Push a proxy based on the deep userdata we stored.
1665 */
1666 luaG_push_proxy( L, LG_linda_id, p );
1667 }
1668 STACK_END(L,1)
1669}
1670
1671/*
1672* secs= now_secs()
1673*
1674* Returns the current time, as seconds (millisecond resolution).
1675*/
1676LUAG_FUNC( now_secs )
1677{
1678 lua_pushnumber( L, now_secs() );
1679 return 1;
1680}
1681
1682/*
1683* wakeup_at_secs= wakeup_conv( date_tbl )
1684*/
1685LUAG_FUNC( wakeup_conv )
1686{
1687 int year, month, day, hour, min, sec, isdst;
1688 struct tm tm= {0};
1689 //
1690 // .year (four digits)
1691 // .month (1..12)
1692 // .day (1..31)
1693 // .hour (0..23)
1694 // .min (0..59)
1695 // .sec (0..61)
1696 // .yday (day of the year)
1697 // .isdst (daylight saving on/off)
1698
1699 STACK_CHECK(L)
1700 lua_getfield( L, 1, "year" ); year= lua_tointeger(L,-1); lua_pop(L,1);
1701 lua_getfield( L, 1, "month" ); month= lua_tointeger(L,-1); lua_pop(L,1);
1702 lua_getfield( L, 1, "day" ); day= lua_tointeger(L,-1); lua_pop(L,1);
1703 lua_getfield( L, 1, "hour" ); hour= lua_tointeger(L,-1); lua_pop(L,1);
1704 lua_getfield( L, 1, "min" ); min= lua_tointeger(L,-1); lua_pop(L,1);
1705 lua_getfield( L, 1, "sec" ); sec= lua_tointeger(L,-1); lua_pop(L,1);
1706
1707 // If Lua table has '.isdst' we trust that. If it does not, we'll let
1708 // 'mktime' decide on whether the time is within DST or not (value -1).
1709 //
1710 lua_getfield( L, 1, "isdst" );
1711 isdst= lua_isboolean(L,-1) ? lua_toboolean(L,-1) : -1;
1712 lua_pop(L,1);
1713 STACK_END(L,0)
1714
1715 tm.tm_year= year-1900;
1716 tm.tm_mon= month-1; // 0..11
1717 tm.tm_mday= day; // 1..31
1718 tm.tm_hour= hour; // 0..23
1719 tm.tm_min= min; // 0..59
1720 tm.tm_sec= sec; // 0..60
1721 tm.tm_isdst= isdst; // 0/1/negative
1722
1723 lua_pushnumber( L, (double) mktime( &tm ) ); // ms=0
1724 return 1;
1725}
1726
1727
1728/*---=== Module linkage ===---
1729*/
1730
1731#define REG_FUNC( name ) \
1732 lua_pushcfunction( L, LG_##name ); \
1733 lua_setglobal( L, #name )
1734
1735#define REG_FUNC2( name, val ) \
1736 lua_pushcfunction( L, val ); \
1737 lua_setglobal( L, #name )
1738
1739#define REG_STR2( name, val ) \
1740 lua_pushstring( L, val ); \
1741 lua_setglobal( L, #name )
1742
1743#define REG_INT2( name, val ) \
1744 lua_pushinteger( L, val ); \
1745 lua_setglobal( L, #name )
1746
1747
1748int
1749#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
1750__declspec(dllexport)
1751#endif
1752 luaopen_lanes( lua_State *L ) {
1753 const char *err;
1754 static volatile char been_here; // =0
1755
1756 // One time initializations:
1757 //
1758 if (!been_here) {
1759 been_here= TRUE;
1760
1761#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
1762 now_secs(); // initialize 'now_secs()' internal offset
1763#endif
1764
1765#if (defined PLATFORM_OSX) && (defined _UTILBINDTHREADTOCPU)
1766 chudInitialize();
1767#endif
1768
1769 // Locks for 'tools.c' inc/dec counters
1770 //
1771 MUTEX_INIT( &deep_lock );
1772 MUTEX_INIT( &mtid_lock );
1773
1774 // Serialize calls to 'require' from now on, also in the primary state
1775 //
1776 MUTEX_RECURSIVE_INIT( &require_cs );
1777
1778 serialize_require( L );
1779
1780 // Selfdestruct chain handling
1781 //
1782 MUTEX_INIT( &selfdestruct_cs );
1783 atexit( selfdestruct_atexit );
1784
1785 //---
1786 // Linux needs SCHED_RR to change thread priorities, and that is only
1787 // allowed for sudo'ers. SCHED_OTHER (default) has no priorities.
1788 // SCHED_OTHER threads are always lower priority than SCHED_RR.
1789 //
1790 // ^-- those apply to 2.6 kernel. IF **wishful thinking** these
1791 // constraints will change in the future, non-sudo priorities can
1792 // be enabled also for Linux.
1793 //
1794#ifdef PLATFORM_LINUX
1795 sudo= geteuid()==0; // we are root?
1796
1797 // If lower priorities (-2..-1) are wanted, we need to lift the main
1798 // thread to SCHED_RR and 50 (medium) level. Otherwise, we're always below
1799 // the launched threads (even -2).
1800 //
1801 #ifdef LINUX_SCHED_RR
1802 if (sudo) {
1803 struct sched_param sp= {0}; sp.sched_priority= _PRIO_0;
1804 PT_CALL( pthread_setschedparam( pthread_self(), SCHED_RR, &sp) );
1805 }
1806 #endif
1807#endif
1808 err= init_keepers();
1809 if (err)
1810 luaL_error( L, "Unable to initialize: %s", err );
1811 }
1812
1813 // Linda identity function
1814 //
1815 REG_FUNC( linda_id );
1816
1817 // metatable for threads
1818 //
1819 lua_newtable( L );
1820 lua_pushcfunction( L, LG_thread_gc );
1821 lua_setfield( L, -2, "__gc" );
1822
1823 lua_pushcclosure( L, LG_thread_new, 1 ); // metatable as closure param
1824 lua_setglobal( L, "thread_new" );
1825
1826 REG_FUNC( thread_status );
1827 REG_FUNC( thread_join );
1828 REG_FUNC( thread_cancel );
1829
1830 REG_STR2( _version, VERSION );
1831 REG_FUNC( _single );
1832
1833 REG_FUNC2( _deep_userdata, luaG_deep_userdata );
1834
1835 REG_FUNC( now_secs );
1836 REG_FUNC( wakeup_conv );
1837
1838 push_timer_gateway(L);
1839 lua_setglobal( L, "timer_gateway" );
1840
1841 REG_INT2( max_prio, THREAD_PRIO_MAX );
1842
1843 lua_pushlightuserdata( L, CANCEL_ERROR );
1844 lua_setglobal( L, "cancel_error" );
1845
1846 return 0;
1847}
1848
1849
diff --git a/src/lanes.lua b/src/lanes.lua
new file mode 100644
index 0000000..c68506d
--- /dev/null
+++ b/src/lanes.lua
@@ -0,0 +1,611 @@
1--
2-- LANES.LUA
3--
4-- Multithreading and -core support for Lua
5--
6-- Author: Asko Kauppi <akauppi@gmail.com>
7--
8-- History:
9-- Jun-08 AKa: major revise
10-- 15-May-07 AKa: pthread_join():less version, some speedup & ability to
11-- handle more threads (~ 8000-9000, up from ~ 5000)
12-- 26-Feb-07 AKa: serialization working (C side)
13-- 17-Sep-06 AKa: started the module (serialization)
14--
15--[[
16===============================================================================
17
18Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com>
19
20Permission is hereby granted, free of charge, to any person obtaining a copy
21of this software and associated documentation files (the "Software"), to deal
22in the Software without restriction, including without limitation the rights
23to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
24copies of the Software, and to permit persons to whom the Software is
25furnished to do so, subject to the following conditions:
26
27The above copyright notice and this permission notice shall be included in
28all copies or substantial portions of the Software.
29
30THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
31IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
32FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
33AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
34LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
35OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
36THE SOFTWARE.
37
38===============================================================================
39]]--
40
41module( "lanes", package.seeall )
42
43require "lua51-lanes"
44assert( type(lanes)=="table" )
45
46local mm= lanes
47
48local linda_id= assert( mm.linda_id )
49
50local thread_new= assert(mm.thread_new)
51local thread_status= assert(mm.thread_status)
52local thread_join= assert(mm.thread_join)
53local thread_cancel= assert(mm.thread_cancel)
54
55local _single= assert(mm._single)
56local _version= assert(mm._version)
57
58local _deep_userdata= assert(mm._deep_userdata)
59
60local now_secs= assert( mm.now_secs )
61local wakeup_conv= assert( mm.wakeup_conv )
62local timer_gateway= assert( mm.timer_gateway )
63
64local max_prio= assert( mm.max_prio )
65
66-- This check is for sublanes requiring Lanes
67--
68-- TBD: We could also have the C level expose 'string.gmatch' for us. But this is simpler.
69--
70if not string then
71 error( "To use 'lanes', you will also need to have 'string' available.", 2 )
72end
73
74--
75-- Cache globals for code that might run under sandboxing
76--
77local assert= assert
78local string_gmatch= assert( string.gmatch )
79local select= assert( select )
80local type= assert( type )
81local pairs= assert( pairs )
82local tostring= assert( tostring )
83local error= assert( error )
84local setmetatable= assert( setmetatable )
85local rawget= assert( rawget )
86
87ABOUT=
88{
89 author= "Asko Kauppi <akauppi@gmail.com>",
90 description= "Running multiple Lua states in parallel",
91 license= "MIT/X11",
92 copyright= "Copyright (c) 2007-08, Asko Kauppi",
93 version= _version,
94}
95
96
97-- Making copies of necessary system libs will pass them on as upvalues;
98-- only the first state doing "require 'lanes'" will need to have 'string'
99-- and 'table' visible.
100--
101local function WR(str)
102 io.stderr:write( str.."\n" )
103end
104
105local function DUMP( tbl )
106 if not tbl then return end
107 local str=""
108 for k,v in pairs(tbl) do
109 str= str..k.."="..tostring(v).."\n"
110 end
111 WR(str)
112end
113
114
115---=== Laning ===---
116
117-- lane_h[1..n]: lane results, same as via 'lane_h:join()'
118-- lane_h[0]: can be read to make sure a thread has finished (always gives 'true')
119-- lane_h[-1]: error message, without propagating the error
120--
121-- Reading a Lane result (or [0]) propagates a possible error in the lane
122-- (and execution does not return). Cancelled lanes give 'nil' values.
123--
124-- lane_h.state: "pending"/"running"/"waiting"/"done"/"error"/"cancelled"
125--
126local lane_mt= {
127 __index= function( me, k )
128 if type(k) == "number" then
129 -- 'me[0]=true' marks we've already taken in the results
130 --
131 if not rawget( me, 0 ) then
132 -- Wait indefinately; either propagates an error or
133 -- returns the return values
134 --
135 me[0]= true -- marker, even on errors
136
137 local t= { thread_join(me._ud) } -- wait indefinate
138 --
139 -- { ... } "done": regular return, 0..N results
140 -- { } "cancelled"
141 -- { nil, err_str, stack_tbl } "error"
142
143 local st= thread_status(me._ud)
144 if st=="done" then
145 -- Use 'pairs' and not 'ipairs' so that nil holes in
146 -- the returned values are tolerated.
147 --
148 for i,v in pairs(t) do
149 me[i]= v
150 end
151 elseif st=="error" then
152 assert( t[1]==nil and t[2] and type(t[3])=="table" )
153 me[-1]= t[2]
154 -- me[-2] could carry the stack table, but even
155 -- me[-1] is rather unnecessary (and undocumented);
156 -- use ':join()' instead. --AKa 22-Jan-2009
157 elseif st=="cancelled" then
158 -- do nothing
159 else
160 error( "Unexpected status: "..st )
161 end
162 end
163
164 -- Check errors even if we'd first peeked them via [-1]
165 -- and then came for the actual results.
166 --
167 local err= rawget(me, -1)
168 if err~=nil and k~=-1 then
169 -- Note: Lua 5.1 interpreter is not prepared to show
170 -- non-string errors, so we use 'tostring()' here
171 -- to get meaningful output. --AKa 22-Jan-2009
172 --
173 -- Also, the stack dump we get is no good; it only
174 -- lists our internal Lanes functions. There seems
175 -- to be no way to switch it off, though.
176
177 -- Level 3 should show the line where 'h[x]' was read
178 -- but this only seems to work for string messages
179 -- (Lua 5.1.4). No idea, why. --AKa 22-Jan-2009
180 --
181 error( tostring(err), 3 ) -- level 3 should show the line where 'h[x]' was read
182 end
183 return rawget( me, k )
184 --
185 elseif k=="status" then -- me.status
186 return thread_status(me._ud)
187 --
188 else
189 error( "Unknown key: "..k )
190 end
191 end
192 }
193
194-----
195-- h= lanes.gen( [libs_str|opt_tbl [, ...],] lane_func ) ( [...] )
196--
197-- 'libs': nil: no libraries available (default)
198-- "": only base library ('assert', 'print', 'unpack' etc.)
199-- "math,os": math + os + base libraries (named ones + base)
200-- "*": all standard libraries available
201--
202-- 'opt': .priority: int (-2..+2) smaller is lower priority (0 = default)
203--
204-- .cancelstep: bool | uint
205-- false: cancellation check only at pending Linda operations
206-- (send/receive) so no runtime performance penalty (default)
207-- true: adequate cancellation check (same as 100)
208-- >0: cancellation check every x Lua lines (small number= faster
209-- reaction but more performance overhead)
210--
211-- .globals: table of globals to set for a new thread (passed by value)
212--
213-- ... (more options may be introduced later) ...
214--
215-- Calling with a function parameter ('lane_func') ends the string/table
216-- modifiers, and prepares a lane generator. One can either finish here,
217-- and call the generator later (maybe multiple times, with different parameters)
218-- or add on actual thread arguments to also ignite the thread on the same call.
219--
220local lane_proxy
221
222local valid_libs= {
223 ["package"]= true,
224 ["table"]= true,
225 ["io"]= true,
226 ["os"]= true,
227 ["string"]= true,
228 ["math"]= true,
229 ["debug"]= true,
230 --
231 ["base"]= true,
232 ["coroutine"]= true,
233 ["*"]= true
234}
235
236function gen( ... )
237 local opt= {}
238 local libs= nil
239 local lev= 2 -- level for errors
240
241 local n= select('#',...)
242
243 if n==0 then
244 error( "No parameters!" )
245 end
246
247 for i=1,n-1 do
248 local v= select(i,...)
249 if type(v)=="string" then
250 libs= libs and libs..","..v or v
251 elseif type(v)=="table" then
252 for k,vv in pairs(v) do
253 opt[k]= vv
254 end
255 elseif v==nil then
256 -- skip
257 else
258 error( "Bad parameter: "..tostring(v) )
259 end
260 end
261
262 local func= select(n,...)
263 if type(func)~="function" then
264 error( "Last parameter not function: "..tostring(func) )
265 end
266
267 -- Check 'libs' already here, so the error goes in the right place
268 -- (otherwise will be noticed only once the generator is called)
269 --
270 if libs then
271 for s in string_gmatch(libs, "[%a*]+") do
272 if not valid_libs[s] then
273 error( "Bad library name: "..s )
274 end
275 end
276 end
277
278 local prio, cs, g_tbl
279
280 for k,v in pairs(opt) do
281 if k=="priority" then prio= v
282 elseif k=="cancelstep" then cs= (v==true) and 100 or
283 (v==false) and 0 or
284 type(v)=="number" and v or
285 error( "Bad cancelstep: "..tostring(v), lev )
286 elseif k=="globals" then g_tbl= v
287 --..
288 elseif k==1 then error( "unkeyed option: ".. tostring(v), lev )
289 else error( "Bad option: ".. tostring(k), lev )
290 end
291 end
292
293 -- Lane generator
294 --
295 return function(...)
296 return lane_proxy( thread_new( func, libs, cs, prio, g_tbl,
297 ... ) ) -- args
298 end
299end
300
301lane_proxy= function( ud )
302 local proxy= {
303 _ud= ud,
304
305 -- void= me:cancel()
306 --
307 cancel= function(me) thread_cancel(me._ud) end,
308
309 -- [...] | [nil,err,stack_tbl]= me:join( [wait_secs=-1] )
310 --
311 join= function( me, wait )
312 return thread_join( me._ud, wait )
313 end,
314 }
315 assert( proxy._ud )
316 setmetatable( proxy, lane_mt )
317
318 return proxy
319end
320
321
322---=== Lindas ===---
323
324-- We let the C code attach methods to userdata directly
325
326-----
327-- linda_ud= lanes.linda()
328--
329function linda()
330 local proxy= _deep_userdata( linda_id )
331 assert( (type(proxy) == "userdata") and getmetatable(proxy) )
332 return proxy
333end
334
335
336---=== Timers ===---
337
338--
339-- On first 'require "lanes"', a timer lane is spawned that will maintain
340-- timer tables and sleep in between the timer events. All interaction with
341-- the timer lane happens via a 'timer_gateway' Linda, which is common to
342-- all that 'require "lanes"'.
343--
344-- Linda protocol to timer lane:
345--
346-- TGW_KEY: linda_h, key, [wakeup_at_secs], [repeat_secs]
347--
348local TGW_KEY= "(timer control)" -- the key does not matter, a 'weird' key may help debugging
349local first_time_key= "first time"
350
351local first_time= timer_gateway:get(first_time_key) == nil
352timer_gateway:set(first_time_key,true)
353
354--
355-- Timer lane; initialize only on the first 'require "lanes"' instance (which naturally
356-- has 'table' always declared)
357--
358if first_time then
359 local table_remove= assert( table.remove )
360 local table_insert= assert( table.insert )
361
362 --
363 -- { [deep_linda_lightuserdata]= { [deep_linda_lightuserdata]=linda_h,
364 -- [key]= { wakeup_secs [,period_secs] } [, ...] },
365 -- }
366 --
367 -- Collection of all running timers, indexed with linda's & key.
368 --
369 -- Note that we need to use the deep lightuserdata identifiers, instead
370 -- of 'linda_h' themselves as table indices. Otherwise, we'd get multiple
371 -- entries for the same timer.
372 --
373 -- The 'hidden' reference to Linda proxy is used in 'check_timers()' but
374 -- also important to keep the Linda alive, even if all outside world threw
375 -- away pointers to it (which would ruin uniqueness of the deep pointer).
376 -- Now we're safe.
377 --
378 local collection= {}
379
380 --
381 -- set_timer( linda_h, key [,wakeup_at_secs [,period_secs]] )
382 --
383 local function set_timer( linda, key, wakeup_at, period )
384
385 assert( wakeup_at==nil or wakeup_at>0.0 )
386 assert( period==nil or period>0.0 )
387
388 local linda_deep= linda:deep()
389 assert( linda_deep )
390
391 -- Find or make a lookup for this timer
392 --
393 local t1= collection[linda_deep]
394 if not t1 then
395 t1= { [linda_deep]= linda } -- proxy to use the Linda
396 collection[linda_deep]= t1
397 end
398
399 if wakeup_at==nil then
400 -- Clear the timer
401 --
402 t1[key]= nil
403
404 -- Remove empty tables from collection; speeds timer checks and
405 -- lets our 'safety reference' proxy be gc:ed as well.
406 --
407 local empty= true
408 for k,_ in pairs(t1) do
409 if k~= linda_deep then
410 empty= false; break
411 end
412 end
413 if empty then
414 collection[linda_deep]= nil
415 end
416
417 -- Note: any unread timer value is left at 'linda[key]' intensionally;
418 -- clearing a timer just stops it.
419 else
420 -- New timer or changing the timings
421 --
422 local t2= t1[key]
423 if not t2 then
424 t2= {}; t1[key]= t2
425 end
426
427 t2[1]= wakeup_at
428 t2[2]= period -- can be 'nil'
429 end
430 end
431
432 -----
433 -- [next_wakeup_at]= check_timers()
434 --
435 -- Check timers, and wake up the ones expired (if any)
436 --
437 -- Returns the closest upcoming (remaining) wakeup time (or 'nil' if none).
438 --
439 local function check_timers()
440
441 local now= now_secs()
442 local next_wakeup
443
444 for linda_deep,t1 in pairs(collection) do
445 for key,t2 in pairs(t1) do
446 --
447 if key==linda_deep then
448 -- no 'continue' in Lua :/
449 else
450 -- 't2': { wakeup_at_secs [,period_secs] }
451 --
452 local wakeup_at= t2[1]
453 local period= t2[2] -- may be 'nil'
454
455 if wakeup_at <= now then
456 local linda= t1[linda_deep]
457 assert(linda)
458
459 linda:set( key, now )
460
461 -- 'pairs()' allows the values to be modified (and even
462 -- removed) as far as keys are not touched
463
464 if not period then
465 -- one-time timer; gone
466 --
467 t1[key]= nil
468 wakeup_at= nil -- no 'continue' in Lua :/
469 else
470 -- repeating timer; find next wakeup (may jump multiple repeats)
471 --
472 repeat
473 wakeup_at= wakeup_at+period
474 until wakeup_at > now
475
476 t2[1]= wakeup_at
477 end
478 end
479
480 if wakeup_at and ((not next_wakeup) or (wakeup_at < next_wakeup)) then
481 next_wakeup= wakeup_at
482 end
483 end
484 end -- t2 loop
485 end -- t1 loop
486
487 return next_wakeup -- may be 'nil'
488 end
489
490 -----
491 -- Snore loop (run as a lane on the background)
492 --
493 -- High priority, to get trustworthy timings.
494 --
495 -- We let the timer lane be a "free running" thread; no handle to it
496 -- remains.
497 --
498 gen( "io", { priority=max_prio }, function()
499
500 while true do
501 local next_wakeup= check_timers()
502
503 -- Sleep until next timer to wake up, or a set/clear command
504 --
505 local secs= next_wakeup and (next_wakeup - now_secs()) or nil
506 local linda= timer_gateway:receive( secs, TGW_KEY )
507
508 if linda then
509 local key= timer_gateway:receive( 0.0, TGW_KEY )
510 local wakeup_at= timer_gateway:receive( 0.0, TGW_KEY )
511 local period= timer_gateway:receive( 0.0, TGW_KEY )
512 assert( key and wakeup_at and period )
513
514 set_timer( linda, key, wakeup_at, period>0 and period or nil )
515 end
516 end
517 end )()
518end
519
520-----
521-- = timer( linda_h, key_val, date_tbl|first_secs [,period_secs] )
522--
523function timer( linda, key, a, period )
524
525 if a==0.0 then
526 -- Caller expects to get current time stamp in Linda, on return
527 -- (like the timer had expired instantly); it would be good to set this
528 -- as late as possible (to give most current time) but also we want it
529 -- to precede any possible timers that might start striking.
530 --
531 linda:set( key, now_secs() )
532
533 if not period or period==0.0 then
534 timer_gateway:send( TGW_KEY, linda, key, nil, nil ) -- clear the timer
535 return -- nothing more to do
536 end
537 a= period
538 end
539
540 local wakeup_at= type(a)=="table" and wakeup_conv(a) -- given point of time
541 or now_secs()+a
542 -- queue to timer
543 --
544 timer_gateway:send( TGW_KEY, linda, key, wakeup_at, period )
545end
546
547
548---=== Lock & atomic generators ===---
549
550-- These functions are just surface sugar, but make solutions easier to read.
551-- Not many applications should even need explicit locks or atomic counters.
552
553--
554-- lock_f= lanes.genlock( linda_h, key [,N_uint=1] )
555--
556-- = lock_f( +M ) -- acquire M
557-- ...locked...
558-- = lock_f( -M ) -- release M
559--
560-- Returns an access function that allows 'N' simultaneous entries between
561-- acquire (+M) and release (-M). For binary locks, use M==1.
562--
563function genlock( linda, key, N )
564 linda:limit(key,N)
565 linda:set(key,nil) -- clears existing data
566
567 --
568 -- [true [, ...]= trues(uint)
569 --
570 local function trues(n)
571 if n>0 then return true,trues(n-1) end
572 end
573
574 return
575 function(M)
576 if M>0 then
577 -- 'nil' timeout allows 'key' to be numeric
578 linda:send( nil, key, trues(M) ) -- suspends until been able to push them
579 else
580 for i=1,-M do
581 linda:receive( key )
582 end
583 end
584 end
585end
586
587
588--
589-- atomic_f= lanes.genatomic( linda_h, key [,initial_num=0.0] )
590--
591-- int= atomic_f( [diff_num=1.0] )
592--
593-- Returns an access function that allows atomic increment/decrement of the
594-- number in 'key'.
595--
596function genatomic( linda, key, initial_val )
597 linda:limit(key,2) -- value [,true]
598 linda:set(key,initial_val or 0.0) -- clears existing data (also queue)
599
600 return
601 function(diff)
602 -- 'nil' allows 'key' to be numeric
603 linda:send( nil, key, true ) -- suspends until our 'true' is in
604 local val= linda:get(key) + (diff or 1.0)
605 linda:set( key, val ) -- releases the lock, by emptying queue
606 return val
607 end
608end
609
610
611--the end
diff --git a/src/threading.c b/src/threading.c
new file mode 100644
index 0000000..68d1e41
--- /dev/null
+++ b/src/threading.c
@@ -0,0 +1,721 @@
1/*
2 * THREADING.C Copyright (c) 2007-08, Asko Kauppi
3 *
4 * Lua Lanes OS threading specific code.
5 *
6 * References:
7 * <http://www.cse.wustl.edu/~schmidt/win32-cv-1.html>
8*/
9
10/*
11===============================================================================
12
13Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com>
14
15Permission is hereby granted, free of charge, to any person obtaining a copy
16of this software and associated documentation files (the "Software"), to deal
17in the Software without restriction, including without limitation the rights
18to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
19copies of the Software, and to permit persons to whom the Software is
20furnished to do so, subject to the following conditions:
21
22The above copyright notice and this permission notice shall be included in
23all copies or substantial portions of the Software.
24
25THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
26IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
27FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
28AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
29LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
30OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
31THE SOFTWARE.
32
33===============================================================================
34*/
35#include <stdio.h>
36#include <stdlib.h>
37#include <assert.h>
38#include <errno.h>
39#include <math.h>
40
41#include "threading.h"
42#include "lua.h"
43
44#if !((defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC))
45# include <sys/time.h>
46#endif
47
48
49#if defined(PLATFORM_LINUX) || defined(PLATFORM_CYGWIN)
50# include <sys/types.h>
51# include <unistd.h>
52#endif
53
54/* Linux needs to check, whether it's been run as root
55*/
56#ifdef PLATFORM_LINUX
57 volatile bool_t sudo;
58#endif
59
60#ifdef _MSC_VER
61// ".. selected for automatic inline expansion" (/O2 option)
62# pragma warning( disable : 4711 )
63// ".. type cast from function pointer ... to data pointer"
64# pragma warning( disable : 4054 )
65#endif
66
67//#define THREAD_CREATE_RETRIES_MAX 20
68 // loops (maybe retry forever?)
69
70/*
71* FAIL is for unexpected API return values - essentially programming
72* error in _this_ code.
73*/
74#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
75static void FAIL( const char *funcname, int rc ) {
76 fprintf( stderr, "%s() failed! (%d)\n", funcname, rc );
77 abort();
78}
79#endif
80
81
82/*
83* Returns millisecond timing (in seconds) for the current time.
84*
85* Note: This function should be called once in single-threaded mode in Win32,
86* to get it initialized.
87*/
88time_d now_secs(void) {
89
90#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
91 /*
92 * Windows FILETIME values are "100-nanosecond intervals since
93 * January 1, 1601 (UTC)" (MSDN). Well, we'd want Unix Epoch as
94 * the offset and it seems, so would they:
95 *
96 * <http://msdn.microsoft.com/en-us/library/ms724928(VS.85).aspx>
97 */
98 SYSTEMTIME st;
99 FILETIME ft;
100 ULARGE_INTEGER uli;
101 static ULARGE_INTEGER uli_epoch; // Jan 1st 1970 0:0:0
102
103 if (uli_epoch.HighPart==0) {
104 st.wYear= 1970;
105 st.wMonth= 1; // Jan
106 st.wDay= 1;
107 st.wHour= st.wMinute= st.wSecond= st.wMilliseconds= 0;
108
109 if (!SystemTimeToFileTime( &st, &ft ))
110 FAIL( "SystemTimeToFileTime", GetLastError() );
111
112 uli_epoch.LowPart= ft.dwLowDateTime;
113 uli_epoch.HighPart= ft.dwHighDateTime;
114 }
115
116 GetSystemTime( &st ); // current system date/time in UTC
117 if (!SystemTimeToFileTime( &st, &ft ))
118 FAIL( "SystemTimeToFileTime", GetLastError() );
119
120 uli.LowPart= ft.dwLowDateTime;
121 uli.HighPart= ft.dwHighDateTime;
122
123 /* 'double' has less accuracy than 64-bit int, but if it were to degrade,
124 * it would do so gracefully. In practise, the integer accuracy is not
125 * of the 100ns class but just 1ms (Windows XP).
126 */
127# if 1
128 // >= 2.0.3 code
129 return (double) ((uli.QuadPart - uli_epoch.QuadPart)/10000) / 1000.0;
130# elif 0
131 // fix from Kriss Daniels, see:
132 // <http://luaforge.net/forum/forum.php?thread_id=22704&forum_id=1781>
133 //
134 // "seem to be getting negative numbers from the old version, probably number
135 // conversion clipping, this fixes it and maintains ms resolution"
136 //
137 // This was a bad fix, and caused timer test 5 sec timers to disappear.
138 // --AKa 25-Jan-2009
139 //
140 return ((double)((signed)((uli.QuadPart/10000) - (uli_epoch.QuadPart/10000)))) / 1000.0;
141# else
142 // <= 2.0.2 code
143 return (double)(uli.QuadPart - uli_epoch.QuadPart) / 10000000.0;
144# endif
145#else
146 struct timeval tv;
147 // {
148 // time_t tv_sec; /* seconds since Jan. 1, 1970 */
149 // suseconds_t tv_usec; /* and microseconds */
150 // };
151
152 int rc= gettimeofday( &tv, NULL /*time zone not used any more (in Linux)*/ );
153 assert( rc==0 );
154
155 return ((double)tv.tv_sec) + ((tv.tv_usec)/1000) / 1000.0;
156#endif
157}
158
159
160/*
161*/
162time_d SIGNAL_TIMEOUT_PREPARE( double secs ) {
163 if (secs<=0.0) return secs;
164 else return now_secs() + secs;
165}
166
167
168#if !((defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC))
169/*
170* Prepare 'abs_secs' kind of timeout to 'timespec' format
171*/
172static void prepare_timeout( struct timespec *ts, time_d abs_secs ) {
173 assert(ts);
174 assert( abs_secs >= 0.0 );
175
176 if (abs_secs==0.0)
177 abs_secs= now_secs();
178
179 ts->tv_sec= floor( abs_secs );
180 ts->tv_nsec= ((long)((abs_secs - ts->tv_sec) * 1000.0 +0.5)) * 1000000UL; // 1ms = 1000000ns
181}
182#endif
183
184
185/*---=== Threading ===---*/
186
187//---
188// It may be meaningful to explicitly limit the new threads' C stack size.
189// We should know how much Lua needs in the C stack, all Lua side allocations
190// are done in heap so they don't count.
191//
192// Consequence of _not_ limiting the stack is running out of virtual memory
193// with 1000-5000 threads on 32-bit systems.
194//
195// Note: using external C modules may be affected by the stack size check.
196// if having problems, set back to '0' (default stack size of the system).
197//
198// Win32: 64K (?)
199// Win64: xxx
200//
201// Linux x86: 2MB Ubuntu 7.04 via 'pthread_getstacksize()'
202// Linux x64: xxx
203// Linux ARM: xxx
204//
205// OS X 10.4.9: 512K <http://developer.apple.com/qa/qa2005/qa1419.html>
206// valid values N * 4KB
207//
208#ifndef _THREAD_STACK_SIZE
209# if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PLATFORM_CYGWIN)
210# define _THREAD_STACK_SIZE 0
211 // Win32: does it work with less?
212# elif (defined PLATFORM_OSX)
213# define _THREAD_STACK_SIZE (524288/2) // 262144
214 // OS X: "make test" works on 65536 and even below
215 // "make perftest" works on >= 4*65536 == 262144 (not 3*65536)
216# elif (defined PLATFORM_LINUX) && (defined __i386)
217# define _THREAD_STACK_SIZE (2097152/16) // 131072
218 // Linux x86 (Ubuntu 7.04): "make perftest" works on /16 (not on /32)
219# elif (defined PLATFORM_BSD) && (defined __i386)
220# define _THREAD_STACK_SIZE (1048576/8) // 131072
221 // FreeBSD 6.2 SMP i386: ("gmake perftest" works on /8 (not on /16)
222# endif
223#endif
224
225#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
226 //
227 void MUTEX_INIT( MUTEX_T *ref ) {
228 *ref= CreateMutex( NULL /*security attr*/, FALSE /*not locked*/, NULL );
229 if (!ref) FAIL( "CreateMutex", GetLastError() );
230 }
231 void MUTEX_FREE( MUTEX_T *ref ) {
232 if (!CloseHandle(*ref)) FAIL( "CloseHandle (mutex)", GetLastError() );
233 *ref= NULL;
234 }
235 void MUTEX_LOCK( MUTEX_T *ref ) {
236 DWORD rc= WaitForSingleObject(*ref,INFINITE);
237 if (rc!=0) FAIL( "WaitForSingleObject", rc==WAIT_FAILED ? GetLastError() : rc );
238 }
239 void MUTEX_UNLOCK( MUTEX_T *ref ) {
240 if (!ReleaseMutex(*ref))
241 FAIL( "ReleaseMutex", GetLastError() );
242 }
243 /* MSDN: "If you would like to use the CRT in ThreadProc, use the
244 _beginthreadex function instead (of CreateThread)."
245 MSDN: "you can create at most 2028 threads"
246 */
247 void
248 THREAD_CREATE( THREAD_T *ref,
249 THREAD_RETURN_T (__stdcall *func)( void * ),
250 // Note: Visual C++ requires '__stdcall' where it is
251 void *data, int prio /* -3..+3 */ ) {
252
253 HANDLE h= (HANDLE)_beginthreadex( NULL, // security
254 _THREAD_STACK_SIZE,
255 func,
256 data,
257 0, // flags (0/CREATE_SUSPENDED)
258 NULL // thread id (not used)
259 );
260
261 if (h == INVALID_HANDLE_VALUE) FAIL( "CreateThread", GetLastError() );
262
263 if (prio!= 0) {
264 int win_prio= (prio == +3) ? THREAD_PRIORITY_TIME_CRITICAL :
265 (prio == +2) ? THREAD_PRIORITY_HIGHEST :
266 (prio == +1) ? THREAD_PRIORITY_ABOVE_NORMAL :
267 (prio == -1) ? THREAD_PRIORITY_BELOW_NORMAL :
268 (prio == -2) ? THREAD_PRIORITY_LOWEST :
269 THREAD_PRIORITY_IDLE; // -3
270
271 if (!SetThreadPriority( h, win_prio ))
272 FAIL( "SetThreadPriority", GetLastError() );
273 }
274 *ref= h;
275 }
276 //
277 bool_t THREAD_WAIT( THREAD_T *ref, double secs ) {
278 long ms= (long)((secs*1000.0)+0.5);
279
280 DWORD rc= WaitForSingleObject( *ref, ms<0 ? INFINITE:ms /*timeout*/ );
281 //
282 // (WAIT_ABANDONED)
283 // WAIT_OBJECT_0 success (0)
284 // WAIT_TIMEOUT
285 // WAIT_FAILED more info via GetLastError()
286
287 if (rc == WAIT_TIMEOUT) return FALSE;
288 if (rc != 0) FAIL( "WaitForSingleObject", rc );
289 *ref= NULL; // thread no longer usable
290 return TRUE;
291 }
292 //
293 void THREAD_KILL( THREAD_T *ref ) {
294 if (!TerminateThread( *ref, 0 )) FAIL("TerminateThread", GetLastError());
295 *ref= NULL;
296 }
297 //
298 void SIGNAL_INIT( SIGNAL_T *ref ) {
299 // 'manual reset' event type selected, to be able to wake up all the
300 // waiting threads.
301 //
302 HANDLE h= CreateEvent( NULL, // security attributes
303 TRUE, // TRUE: manual event
304 FALSE, // Initial state
305 NULL ); // name
306
307 if (h == NULL) FAIL( "CreateEvent", GetLastError() );
308 *ref= h;
309 }
310 void SIGNAL_FREE( SIGNAL_T *ref ) {
311 if (!CloseHandle(*ref)) FAIL( "CloseHandle (event)", GetLastError() );
312 *ref= NULL;
313 }
314 //
315 bool_t SIGNAL_WAIT( SIGNAL_T *ref, MUTEX_T *mu_ref, time_d abs_secs ) {
316 DWORD rc;
317 long ms;
318
319 if (abs_secs<0.0)
320 ms= INFINITE;
321 else if (abs_secs==0.0)
322 ms= 0;
323 else {
324 ms= (long) ((abs_secs - now_secs())*1000.0 + 0.5);
325
326 // If the time already passed, still try once (ms==0). A short timeout
327 // may have turned negative or 0 because of the two time samples done.
328 //
329 if (ms<0) ms= 0;
330 }
331
332 // Unlock and start a wait, atomically (like condition variables do)
333 //
334 rc= SignalObjectAndWait( *mu_ref, // "object to signal" (unlock)
335 *ref, // "object to wait on"
336 ms,
337 FALSE ); // not alertable
338
339 // All waiting locks are woken here; each competes for the lock in turn.
340 //
341 // Note: We must get the lock even if we've timed out; it makes upper
342 // level code equivalent to how PThread does it.
343 //
344 MUTEX_LOCK(mu_ref);
345
346 if (rc==WAIT_TIMEOUT) return FALSE;
347 if (rc!=0) FAIL( "SignalObjectAndWait", rc );
348 return TRUE;
349 }
350 void SIGNAL_ALL( SIGNAL_T *ref ) {
351/*
352 * MSDN tries to scare that 'PulseEvent' is bad, unreliable and should not be
353 * used. Use condition variables instead (wow, they have that!?!); which will
354 * ONLY WORK on Vista and 2008 Server, it seems... so MS, isn't it.
355 *
356 * I refuse to believe that; using 'PulseEvent' is probably just as good as
357 * using Windows (XP) in the first place. Just don't use APC's (asynchronous
358 * process calls) in your C side coding.
359 */
360 // PulseEvent on manual event:
361 //
362 // Release ALL threads waiting for it (and go instantly back to unsignalled
363 // status = future threads to start a wait will wait)
364 //
365 if (!PulseEvent( *ref ))
366 FAIL( "PulseEvent", GetLastError() );
367 }
368#else
369 // PThread (Linux, OS X, ...)
370 //
371 // On OS X, user processes seem to be able to change priorities.
372 // On Linux, SCHED_RR and su privileges are required.. !-(
373 //
374 #include <errno.h>
375 #include <sys/time.h>
376 //
377 static void _PT_FAIL( int rc, const char *name, const char *file, uint_t line ) {
378 const char *why= (rc==EINVAL) ? "EINVAL" :
379 (rc==EBUSY) ? "EBUSY" :
380 (rc==EPERM) ? "EPERM" :
381 (rc==ENOMEM) ? "ENOMEM" :
382 (rc==ESRCH) ? "ESRCH" :
383 //...
384 "";
385 fprintf( stderr, "%s %d: %s failed, %d %s\n", file, line, name, rc, why );
386 abort();
387 }
388 #define PT_CALL( call ) { int rc= call; if (rc!=0) _PT_FAIL( rc, #call, __FILE__, __LINE__ ); }
389 //
390 void SIGNAL_INIT( SIGNAL_T *ref ) {
391 PT_CALL( pthread_cond_init(ref,NULL /*attr*/) );
392 }
393 void SIGNAL_FREE( SIGNAL_T *ref ) {
394 PT_CALL( pthread_cond_destroy(ref) );
395 }
396 //
397 /*
398 * Timeout is given as absolute since we may have fake wakeups during
399 * a timed out sleep. A Linda with some other key read, or just because
400 * PThread cond vars can wake up unwantedly.
401 */
402 bool_t SIGNAL_WAIT( SIGNAL_T *ref, pthread_mutex_t *mu, time_d abs_secs ) {
403 if (abs_secs<0.0) {
404 PT_CALL( pthread_cond_wait( ref, mu ) ); // infinite
405 } else {
406 int rc;
407 struct timespec ts;
408
409 assert( abs_secs != 0.0 );
410 prepare_timeout( &ts, abs_secs );
411
412 rc= pthread_cond_timedwait( ref, mu, &ts );
413
414 if (rc==ETIMEDOUT) return FALSE;
415 if (rc) { _PT_FAIL( rc, "pthread_cond_timedwait()", __FILE__, __LINE__ ); }
416 }
417 return TRUE;
418 }
419 //
420 void SIGNAL_ONE( SIGNAL_T *ref ) {
421 PT_CALL( pthread_cond_signal(ref) ); // wake up ONE (or no) waiting thread
422 }
423 //
424 void SIGNAL_ALL( SIGNAL_T *ref ) {
425 PT_CALL( pthread_cond_broadcast(ref) ); // wake up ALL waiting threads
426 }
427 //
428 void THREAD_CREATE( THREAD_T* ref,
429 THREAD_RETURN_T (*func)( void * ),
430 void *data, int prio /* -2..+2 */ ) {
431 pthread_attr_t _a;
432 pthread_attr_t *a= &_a;
433 struct sched_param sp;
434
435 PT_CALL( pthread_attr_init(a) );
436
437#ifndef PTHREAD_TIMEDJOIN
438 // We create a NON-JOINABLE thread. This is mainly due to the lack of
439 // 'pthread_timedjoin()', but does offer other benefits (s.a. earlier
440 // freeing of the thread's resources).
441 //
442 PT_CALL( pthread_attr_setdetachstate(a,PTHREAD_CREATE_DETACHED) );
443#endif
444
445 // Use this to find a system's default stack size (DEBUG)
446#if 0
447 { size_t n; pthread_attr_getstacksize( a, &n );
448 fprintf( stderr, "Getstack: %u\n", (unsigned int)n ); }
449 // 524288 on OS X
450 // 2097152 on Linux x86 (Ubuntu 7.04)
451 // 1048576 on FreeBSD 6.2 SMP i386
452#endif
453
454#if (defined _THREAD_STACK_SIZE) && (_THREAD_STACK_SIZE > 0)
455 PT_CALL( pthread_attr_setstacksize( a, _THREAD_STACK_SIZE ) );
456#endif
457
458 bool_t normal=
459#if defined(PLATFORM_LINUX) && defined(LINUX_SCHED_RR)
460 !sudo; // with sudo, even normal thread must use SCHED_RR
461#else
462 prio == 0; // create a default thread if
463#endif
464 if (!normal) {
465 // NB: PThreads priority handling is about as twisty as one can get it
466 // (and then some). DON*T TRUST ANYTHING YOU READ ON THE NET!!!
467
468 // "The specified scheduling parameters are only used if the scheduling
469 // parameter inheritance attribute is PTHREAD_EXPLICIT_SCHED."
470 //
471 PT_CALL( pthread_attr_setinheritsched( a, PTHREAD_EXPLICIT_SCHED ) );
472
473 //---
474 // "Select the scheduling policy for the thread: one of SCHED_OTHER
475 // (regular, non-real-time scheduling), SCHED_RR (real-time,
476 // round-robin) or SCHED_FIFO (real-time, first-in first-out)."
477 //
478 // "Using the RR policy ensures that all threads having the same
479 // priority level will be scheduled equally, regardless of their activity."
480 //
481 // "For SCHED_FIFO and SCHED_RR, the only required member of the
482 // sched_param structure is the priority sched_priority. For SCHED_OTHER,
483 // the affected scheduling parameters are implementation-defined."
484 //
485 // "The priority of a thread is specified as a delta which is added to
486 // the priority of the process."
487 //
488 // ".. priority is an integer value, in the range from 1 to 127.
489 // 1 is the least-favored priority, 127 is the most-favored."
490 //
491 // "Priority level 0 cannot be used: it is reserved for the system."
492 //
493 // "When you use specify a priority of -99 in a call to
494 // pthread_setschedparam(), the priority of the target thread is
495 // lowered to the lowest possible value."
496 //
497 // ...
498
499 // ** CONCLUSION **
500 //
501 // PThread priorities are _hugely_ system specific, and we need at
502 // least OS specific settings. Hopefully, Linuxes and OS X versions
503 // are uniform enough, among each other...
504 //
505#ifdef PLATFORM_OSX
506 // AK 10-Apr-07 (OS X PowerPC 10.4.9):
507 //
508 // With SCHED_RR, 26 seems to be the "normal" priority, where setting
509 // it does not seem to affect the order of threads processed.
510 //
511 // With SCHED_OTHER, the range 25..32 is normal (maybe the same 26,
512 // but the difference is not so clear with OTHER).
513 //
514 // 'sched_get_priority_min()' and '..max()' give 15, 47 as the
515 // priority limits. This could imply, user mode applications won't
516 // be able to use values outside of that range.
517 //
518 #define _PRIO_MODE SCHED_OTHER
519
520 // OS X 10.4.9 (PowerPC) gives ENOTSUP for process scope
521 //#define _PRIO_SCOPE PTHREAD_SCOPE_PROCESS
522
523 #define _PRIO_HI 32 // seems to work (_carefully_ picked!)
524 #define _PRIO_0 26 // detected
525 #define _PRIO_LO 1 // seems to work (tested)
526
527#elif defined(PLATFORM_LINUX)
528 // (based on Ubuntu Linux 2.6.15 kernel)
529 //
530 // SCHED_OTHER is the default policy, but does not allow for priorities.
531 // SCHED_RR allows priorities, all of which (1..99) are higher than
532 // a thread with SCHED_OTHER policy.
533 //
534 // <http://kerneltrap.org/node/6080>
535 // <http://en.wikipedia.org/wiki/Native_POSIX_Thread_Library>
536 // <http://www.net.in.tum.de/~gregor/docs/pthread-scheduling.html>
537 //
538 // Manuals suggest checking #ifdef _POSIX_THREAD_PRIORITY_SCHEDULING,
539 // but even Ubuntu does not seem to define it.
540 //
541 #define _PRIO_MODE SCHED_RR
542
543 // NTLP 2.5: only system scope allowed (being the basic reason why
544 // root privileges are required..)
545 //#define _PRIO_SCOPE PTHREAD_SCOPE_PROCESS
546
547 #define _PRIO_HI 99
548 #define _PRIO_0 50
549 #define _PRIO_LO 1
550
551#elif defined(PLATFORM_BSD)
552 //
553 // <http://www.net.in.tum.de/~gregor/docs/pthread-scheduling.html>
554 //
555 // "When control over the thread scheduling is desired, then FreeBSD
556 // with the libpthread implementation is by far the best choice .."
557 //
558 #define _PRIO_MODE SCHED_OTHER
559 #define _PRIO_SCOPE PTHREAD_SCOPE_PROCESS
560 #define _PRIO_HI 31
561 #define _PRIO_0 15
562 #define _PRIO_LO 1
563
564#elif defined(PLATFORM_CYGWIN)
565 //
566 // TBD: Find right values for Cygwin
567 //
568#else
569 #error "Unknown OS: not implemented!"
570#endif
571
572#ifdef _PRIO_SCOPE
573 PT_CALL( pthread_attr_setscope( a, _PRIO_SCOPE ) );
574#endif
575 PT_CALL( pthread_attr_setschedpolicy( a, _PRIO_MODE ) );
576
577#define _PRIO_AN (_PRIO_0 + ((_PRIO_HI-_PRIO_0)/2) )
578#define _PRIO_BN (_PRIO_LO + ((_PRIO_0-_PRIO_LO)/2) )
579
580 sp.sched_priority=
581 (prio == +2) ? _PRIO_HI :
582 (prio == +1) ? _PRIO_AN :
583#if defined(PLATFORM_LINUX) && defined(LINUX_SCHED_RR)
584 (prio == 0) ? _PRIO_0 :
585#endif
586 (prio == -1) ? _PRIO_BN : _PRIO_LO;
587
588 PT_CALL( pthread_attr_setschedparam( a, &sp ) );
589 }
590
591 //---
592 // Seems on OS X, _POSIX_THREAD_THREADS_MAX is some kind of system
593 // thread limit (not userland thread). Actual limit for us is way higher.
594 // PTHREAD_THREADS_MAX is not defined (even though man page refers to it!)
595 //
596# ifndef THREAD_CREATE_RETRIES_MAX
597 // Don't bother with retries; a failure is a failure
598 //
599 {
600 int rc= pthread_create( ref, a, func, data );
601 if (rc) _PT_FAIL( rc, "pthread_create()", __FILE__, __LINE__-1 );
602 }
603# else
604# error "This code deprecated"
605/*
606 // Wait slightly if thread creation has exchausted the system
607 //
608 { uint_t retries;
609 for( retries=0; retries<THREAD_CREATE_RETRIES_MAX; retries++ ) {
610
611 int rc= pthread_create( ref, a, func, data );
612 //
613 // OS X / Linux:
614 // EAGAIN: ".. lacked the necessary resources to create
615 // another thread, or the system-imposed limit on the
616 // total number of threads in a process
617 // [PTHREAD_THREADS_MAX] would be exceeded."
618 // EINVAL: attr is invalid
619 // Linux:
620 // EPERM: no rights for given parameters or scheduling (no sudo)
621 // ENOMEM: (known to fail with this code, too - not listed in man)
622
623 if (rc==0) break; // ok!
624
625 // In practise, exhaustion seems to be coming from memory, not a
626 // maximum number of threads. Keep tuning... ;)
627 //
628 if (rc==EAGAIN) {
629//fprintf( stderr, "Looping (retries=%d) ", retries ); // DEBUG
630
631 // Try again, later.
632
633 Yield();
634 } else {
635 _PT_FAIL( rc, "pthread_create()", __FILE__, __LINE__ );
636 }
637 }
638 }
639*/
640# endif
641
642 if (a) {
643 PT_CALL( pthread_attr_destroy(a) );
644 }
645 }
646 //
647 /*
648 * Wait for a thread to finish.
649 *
650 * 'mu_ref' is a lock we should use for the waiting; initially unlocked.
651 * Same lock as passed to THREAD_EXIT.
652 *
653 * Returns TRUE for succesful wait, FALSE for timed out
654 */
655#ifdef PTHREAD_TIMEDJOIN
656 bool_t THREAD_WAIT( THREAD_T *ref, double secs )
657#else
658 bool_t THREAD_WAIT( THREAD_T *ref, SIGNAL_T *signal_ref, MUTEX_T *mu_ref, volatile enum e_status *st_ref, double secs )
659#endif
660{
661 struct timespec ts_store;
662 const struct timespec *timeout= NULL;
663 bool_t done;
664
665 // Do timeout counting before the locks
666 //
667#ifdef PTHREAD_TIMEDJOIN
668 if (secs>=0.0) {
669#else
670 if (secs>0.0) {
671#endif
672 prepare_timeout( &ts_store, now_secs()+secs );
673 timeout= &ts_store;
674 }
675
676#ifdef PTHREAD_TIMEDJOIN
677 /* Thread is joinable
678 */
679 if (!timeout) {
680 PT_CALL( pthread_join( *ref, NULL /*ignore exit value*/ ));
681 done= TRUE;
682 } else {
683 int rc= PTHREAD_TIMEDJOIN( *ref, NULL, timeout );
684 if ((rc!=0) && (rc!=ETIMEDOUT)) {
685 _PT_FAIL( rc, "PTHREAD_TIMEDJOIN", __FILE__, __LINE__-2 );
686 }
687 done= rc==0;
688 }
689#else
690 /* Since we've set the thread up as PTHREAD_CREATE_DETACHED, we cannot
691 * join with it. Use the cond.var.
692 */
693 MUTEX_LOCK( mu_ref );
694
695 // 'secs'==0.0 does not need to wait, just take the current status
696 // within the 'mu_ref' locks
697 //
698 if (secs != 0.0) {
699 while( *st_ref < DONE ) {
700 if (!timeout) {
701 PT_CALL( pthread_cond_wait( signal_ref, mu_ref ));
702 } else {
703 int rc= pthread_cond_timedwait( signal_ref, mu_ref, timeout );
704 if (rc==ETIMEDOUT) break;
705 if (rc!=0) _PT_FAIL( rc, "pthread_cond_timedwait", __FILE__, __LINE__-2 );
706 }
707 }
708 }
709 done= *st_ref >= DONE; // DONE|ERROR_ST|CANCELLED
710
711 MUTEX_UNLOCK( mu_ref );
712#endif
713 return done;
714 }
715 //
716 void THREAD_KILL( THREAD_T *ref ) {
717 pthread_cancel( *ref );
718 }
719#endif
720
721static const lua_Alloc alloc_f= 0;
diff --git a/src/threading.h b/src/threading.h
new file mode 100644
index 0000000..4a83229
--- /dev/null
+++ b/src/threading.h
@@ -0,0 +1,196 @@
1/*
2* THREADING.H
3*/
4#ifndef THREADING_H
5#define THREADING_H
6
7/* Platform detection
8*/
9#ifdef _WIN32_WCE
10 #define PLATFORM_POCKETPC
11#elif (defined _WIN32)
12 #define PLATFORM_WIN32
13#elif (defined __linux__)
14 #define PLATFORM_LINUX
15#elif (defined __APPLE__) && (defined __MACH__)
16 #define PLATFORM_OSX
17#elif (defined __NetBSD__) || (defined __FreeBSD__) || (defined BSD)
18 #define PLATFORM_BSD
19#elif (defined __QNX__)
20 #define PLATFORM_QNX
21#elif (defined __CYGWIN__)
22 #define PLATFORM_CYGWIN
23#else
24 #error "Unknown platform!"
25#endif
26
27typedef int bool_t;
28#ifndef FALSE
29# define FALSE 0
30# define TRUE 1
31#endif
32
33typedef unsigned int uint_t;
34
35#if defined(PLATFORM_WIN32) && defined(__GNUC__)
36/* MinGW with MSVCR80.DLL */
37/* Do this BEFORE including time.h so that it is declaring _mktime32()
38 * as it would have declared mktime().
39 */
40# define mktime _mktime32
41#endif
42#include <time.h>
43
44/* Note: ERROR is a defined entity on Win32
45*/
46enum e_status { PENDING, RUNNING, WAITING, DONE, ERROR_ST, CANCELLED };
47
48
49/*---=== Locks & Signals ===---
50*/
51
52#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
53 #define WIN32_LEAN_AND_MEAN
54 // 'SignalObjectAndWait' needs this (targets Windows 2000 and above)
55 #define _WIN32_WINNT 0x0400
56 #include <windows.h>
57 #include <process.h>
58
59 // MSDN: http://msdn2.microsoft.com/en-us/library/ms684254.aspx
60 //
61 // CRITICAL_SECTION can be used for simple code protection. Mutexes are
62 // needed for use with the SIGNAL system.
63 //
64 #define MUTEX_T HANDLE
65 void MUTEX_INIT( MUTEX_T *ref );
66 #define MUTEX_RECURSIVE_INIT(ref) MUTEX_INIT(ref) /* always recursive in Win32 */
67 void MUTEX_FREE( MUTEX_T *ref );
68 void MUTEX_LOCK( MUTEX_T *ref );
69 void MUTEX_UNLOCK( MUTEX_T *ref );
70
71 typedef unsigned THREAD_RETURN_T;
72
73 #define SIGNAL_T HANDLE
74
75 #define YIELD() Sleep(0)
76#else
77 // PThread (Linux, OS X, ...)
78 //
79 #include <pthread.h>
80
81 #ifdef PLATFORM_LINUX
82 # define _MUTEX_RECURSIVE PTHREAD_MUTEX_RECURSIVE_NP
83 #else
84 /* OS X, ... */
85 # define _MUTEX_RECURSIVE PTHREAD_MUTEX_RECURSIVE
86 #endif
87
88 #define MUTEX_T pthread_mutex_t
89 #define MUTEX_INIT(ref) pthread_mutex_init(ref,NULL)
90 #define MUTEX_RECURSIVE_INIT(ref) \
91 { pthread_mutexattr_t a; pthread_mutexattr_init( &a ); \
92 pthread_mutexattr_settype( &a, _MUTEX_RECURSIVE ); \
93 pthread_mutex_init(ref,&a); pthread_mutexattr_destroy( &a ); \
94 }
95 #define MUTEX_FREE(ref) pthread_mutex_destroy(ref)
96 #define MUTEX_LOCK(ref) pthread_mutex_lock(ref)
97 #define MUTEX_UNLOCK(ref) pthread_mutex_unlock(ref)
98
99 typedef void * THREAD_RETURN_T;
100
101 typedef pthread_cond_t SIGNAL_T;
102
103 void SIGNAL_ONE( SIGNAL_T *ref );
104
105 // Yield is non-portable:
106 //
107 // OS X 10.4.8/9 has pthread_yield_np()
108 // Linux 2.4 has pthread_yield() if _GNU_SOURCE is #defined
109 // FreeBSD 6.2 has pthread_yield()
110 // ...
111 //
112 #ifdef PLATFORM_OSX
113 #define YIELD() pthread_yield_np()
114 #else
115 #define YIELD() pthread_yield()
116 #endif
117#endif
118
119void SIGNAL_INIT( SIGNAL_T *ref );
120void SIGNAL_FREE( SIGNAL_T *ref );
121void SIGNAL_ALL( SIGNAL_T *ref );
122
123/*
124* 'time_d': <0.0 for no timeout
125* 0.0 for instant check
126* >0.0 absolute timeout in secs + ms
127*/
128typedef double time_d;
129time_d now_secs(void);
130
131time_d SIGNAL_TIMEOUT_PREPARE( double rel_secs );
132
133bool_t SIGNAL_WAIT( SIGNAL_T *ref, MUTEX_T *mu, time_d timeout );
134
135
136/*---=== Threading ===---
137*/
138
139#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC)
140
141 typedef HANDLE THREAD_T;
142 //
143 void THREAD_CREATE( THREAD_T *ref,
144 THREAD_RETURN_T (__stdcall *func)( void * ),
145 void *data, int prio /* -3..+3 */ );
146
147# define THREAD_PRIO_MIN (-3)
148# define THREAD_PRIO_MAX (+3)
149
150#else
151 /* Platforms that have a timed 'pthread_join()' can get away with a simpler
152 * implementation. Others will use a condition variable.
153 */
154# ifdef USE_PTHREAD_TIMEDJOIN
155# ifdef PLATFORM_OSX
156# error "No 'pthread_timedjoin()' on this system"
157# else
158 /* Linux, ... */
159# define PTHREAD_TIMEDJOIN pthread_timedjoin_np
160# endif
161# endif
162
163 typedef pthread_t THREAD_T;
164
165 void THREAD_CREATE( THREAD_T *ref,
166 THREAD_RETURN_T (*func)( void * ),
167 void *data, int prio /* -2..+2 */ );
168
169# if defined(PLATFORM_LINUX)
170 volatile bool_t sudo;
171# ifdef LINUX_SCHED_RR
172# define THREAD_PRIO_MIN (sudo ? -2 : 0)
173# else
174# define THREAD_PRIO_MIN (0)
175# endif
176# define THREAD_PRIO_MAX (sudo ? +2 : 0)
177# else
178# define THREAD_PRIO_MIN (-2)
179# define THREAD_PRIO_MAX (+2)
180# endif
181#endif
182
183/*
184* Win32 and PTHREAD_TIMEDJOIN allow waiting for a thread with a timeout.
185* Posix without PTHREAD_TIMEDJOIN needs to use a condition variable approach.
186*/
187#if (defined PLATFORM_WIN32) || (defined PLATFORM_POCKETPC) || (defined PTHREAD_TIMEDJOIN)
188 bool_t THREAD_WAIT( THREAD_T *ref, double secs );
189#else
190 bool_t THREAD_WAIT( THREAD_T *ref, SIGNAL_T *signal_ref, MUTEX_T *mu_ref, volatile enum e_status *st_ref, double secs );
191#endif
192
193void THREAD_KILL( THREAD_T *ref );
194
195#endif
196 // THREADING_H
diff --git a/src/tools.c b/src/tools.c
new file mode 100644
index 0000000..a2ec517
--- /dev/null
+++ b/src/tools.c
@@ -0,0 +1,1198 @@
1/*
2 * TOOLS.C Copyright (c) 2002-08, Asko Kauppi
3 *
4 * Lua tools to support Lanes.
5*/
6
7/*
8===============================================================================
9
10Copyright (C) 2002-08 Asko Kauppi <akauppi@gmail.com>
11
12Permission is hereby granted, free of charge, to any person obtaining a copy
13of this software and associated documentation files (the "Software"), to deal
14in the Software without restriction, including without limitation the rights
15to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
16copies of the Software, and to permit persons to whom the Software is
17furnished to do so, subject to the following conditions:
18
19The above copyright notice and this permission notice shall be included in
20all copies or substantial portions of the Software.
21
22THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
23IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
24FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
25AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
26LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
27OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
28THE SOFTWARE.
29
30===============================================================================
31*/
32
33#include "tools.h"
34
35#include "lualib.h"
36#include "lauxlib.h"
37
38#include <stdio.h>
39#include <string.h>
40#include <ctype.h>
41#include <stdlib.h>
42
43static volatile lua_CFunction hijacked_tostring; // = NULL
44
45MUTEX_T deep_lock;
46MUTEX_T mtid_lock;
47
48/*---=== luaG_dump ===---*/
49
50void luaG_dump( lua_State* L ) {
51
52 int top= lua_gettop(L);
53 int i;
54
55 fprintf( stderr, "\n\tDEBUG STACK:\n" );
56
57 if (top==0)
58 fprintf( stderr, "\t(none)\n" );
59
60 for( i=1; i<=top; i++ ) {
61 int type= lua_type( L, i );
62
63 fprintf( stderr, "\t[%d]= (%s) ", i, lua_typename(L,type) );
64
65 // Print item contents here...
66 //
67 // Note: this requires 'tostring()' to be defined. If it is NOT,
68 // enable it for more debugging.
69 //
70 STACK_CHECK(L)
71 STACK_GROW( L, 2 )
72
73 lua_getglobal( L, "tostring" );
74 //
75 // [-1]: tostring function, or nil
76
77 if (!lua_isfunction(L,-1)) {
78 fprintf( stderr, "('tostring' not available)" );
79 } else {
80 lua_pushvalue( L, i );
81 lua_call( L, 1 /*args*/, 1 /*retvals*/ );
82
83 // Don't trust the string contents
84 //
85 fprintf( stderr, "%s", lua_tostring(L,-1) );
86 }
87 lua_pop(L,1);
88 STACK_END(L,0)
89 fprintf( stderr, "\n" );
90 }
91 fprintf( stderr, "\n" );
92}
93
94
95/*---=== luaG_openlibs ===---*/
96
97static const luaL_Reg libs[] = {
98 { LUA_LOADLIBNAME, luaopen_package },
99 { LUA_TABLIBNAME, luaopen_table },
100 { LUA_IOLIBNAME, luaopen_io },
101 { LUA_OSLIBNAME, luaopen_os },
102 { LUA_STRLIBNAME, luaopen_string },
103 { LUA_MATHLIBNAME, luaopen_math },
104 { LUA_DBLIBNAME, luaopen_debug },
105 //
106 { "base", NULL }, // ignore "base" (already acquired it)
107 { "coroutine", NULL }, // part of Lua 5.1 base package
108 { NULL, NULL }
109};
110
111static bool_t openlib( lua_State *L, const char *name, size_t len ) {
112
113 unsigned i;
114 bool_t all= strncmp( name, "*", len ) == 0;
115
116 for( i=0; libs[i].name; i++ ) {
117 if (all || (strncmp(name, libs[i].name, len) ==0)) {
118 if (libs[i].func) {
119 STACK_GROW(L,2);
120 lua_pushcfunction( L, libs[i].func );
121 lua_pushstring( L, libs[i].name );
122 lua_call( L, 1, 0 );
123 }
124 if (!all) return TRUE;
125 }
126 }
127 return all;
128}
129
130/*
131* Like 'luaL_openlibs()' but allows the set of libraries be selected
132*
133* NULL no libraries, not even base
134* "" base library only
135* "io,string" named libraries
136* "*" all libraries
137*
138* Base ("unpack", "print" etc.) is always added, unless 'libs' is NULL.
139*
140* Returns NULL for ok, position of error within 'libs' on failure.
141*/
142#define is_name_char(c) (isalpha(c) || (c)=='*')
143
144const char *luaG_openlibs( lua_State *L, const char *libs ) {
145 const char *p;
146 unsigned len;
147
148 if (!libs) return NULL; // no libs, not even 'base'
149
150 // 'lua.c' stops GC during initialization so perhaps its a good idea. :)
151 //
152 lua_gc(L, LUA_GCSTOP, 0);
153
154 // Anything causes 'base' to be taken in
155 //
156 STACK_GROW(L,2);
157 lua_pushcfunction( L, luaopen_base );
158 lua_pushliteral( L, "" );
159 lua_call( L, 1, 0 );
160
161 for( p= libs; *p; p+=len ) {
162 len=0;
163 while (*p && !is_name_char(*p)) p++; // bypass delimiters
164 while (is_name_char(p[len])) len++; // bypass name
165 if (len && (!openlib( L, p, len )))
166 break;
167 }
168 lua_gc(L, LUA_GCRESTART, 0);
169
170 return *p ? p : NULL;
171}
172
173
174
175/*---=== Deep userdata ===---*/
176
177/* The deep portion must be allocated separately of any Lua state's; it's
178* lifespan may be longer than that of the creating state.
179*/
180#define DEEP_MALLOC malloc
181#define DEEP_FREE free
182
183/*
184* 'registry[REGKEY]' is a two-way lookup table for 'idfunc's and those type's
185* metatables:
186*
187* metatable -> idfunc
188* idfunc -> metatable
189*/
190#define DEEP_LOOKUP_KEY ((void*)set_deep_lookup)
191 // any unique light userdata
192
193static void push_registry_subtable( lua_State *L, void *token );
194
195/*
196* Sets up [-1]<->[-2] two-way lookups, and ensures the lookup table exists.
197* Pops the both values off the stack.
198*/
199void set_deep_lookup( lua_State *L ) {
200
201 STACK_GROW(L,3);
202
203 STACK_CHECK(L)
204#if 1
205 push_registry_subtable( L, DEEP_LOOKUP_KEY );
206#else
207 /* ..to be removed.. */
208 lua_pushlightuserdata( L, DEEP_LOOKUP_KEY );
209 lua_rawget( L, LUA_REGISTRYINDEX );
210
211 if (lua_isnil(L,-1)) {
212 // First time here; let's make the lookup
213 //
214 lua_pop(L,1);
215
216 lua_newtable(L);
217 lua_pushlightuserdata( L, DEEP_LOOKUP_KEY );
218 lua_pushvalue(L,-2);
219 //
220 // [-3]: {} (2nd ref)
221 // [-2]: DEEP_LOOKUP_KEY
222 // [-1]: {}
223
224 lua_rawset( L, LUA_REGISTRYINDEX );
225 //
226 // [-1]: lookup table (empty)
227 }
228#endif
229 STACK_MID(L,1)
230
231 lua_insert(L,-3);
232
233 // [-3]: lookup table
234 // [-2]: A
235 // [-1]: B
236
237 lua_pushvalue( L,-1 ); // B
238 lua_pushvalue( L,-3 ); // A
239 lua_rawset( L, -5 ); // B->A
240 lua_rawset( L, -3 ); // A->B
241 lua_pop( L,1 );
242
243 STACK_END(L,-2)
244}
245
246/*
247* Pops the key (metatable or idfunc) off the stack, and replaces with the
248* deep lookup value (idfunc/metatable/nil).
249*/
250void get_deep_lookup( lua_State *L ) {
251
252 STACK_GROW(L,1);
253
254 STACK_CHECK(L)
255 lua_pushlightuserdata( L, DEEP_LOOKUP_KEY );
256 lua_rawget( L, LUA_REGISTRYINDEX );
257
258 if (!lua_isnil(L,-1)) {
259 // [-2]: key (metatable or idfunc)
260 // [-1]: lookup table
261
262 lua_insert( L, -2 );
263 lua_rawget( L, -2 );
264
265 // [-2]: lookup table
266 // [-1]: value (metatable / idfunc / nil)
267 }
268 lua_remove(L,-2);
269 // remove lookup, or unused key
270 STACK_END(L,0)
271}
272
273/*
274* Return the registered ID function for 'index' (deep userdata proxy),
275* or NULL if 'index' is not a deep userdata proxy.
276*/
277static
278lua_CFunction get_idfunc( lua_State *L, int index ) {
279 lua_CFunction ret;
280
281 index= STACK_ABS(L,index);
282
283 STACK_GROW(L,1);
284
285 STACK_CHECK(L)
286 if (!lua_getmetatable( L, index ))
287 return NULL; // no metatable
288
289 // [-1]: metatable of [index]
290
291 get_deep_lookup(L);
292 //
293 // [-1]: idfunc/nil
294
295 ret= lua_tocfunction(L,-1);
296 lua_pop(L,1);
297 STACK_END(L,0)
298 return ret;
299}
300
301
302/*
303* void= mt.__gc( proxy_ud )
304*
305* End of life for a proxy object; reduce the deep reference count and clean
306* it up if reaches 0.
307*/
308static
309int deep_userdata_gc( lua_State *L ) {
310 DEEP_PRELUDE **proxy= (DEEP_PRELUDE**)lua_touserdata( L, 1 );
311 DEEP_PRELUDE *p= *proxy;
312 int v;
313
314 *proxy= 0; // make sure we don't use it any more
315
316 MUTEX_LOCK( &deep_lock );
317 v= --(p->refcount);
318 MUTEX_UNLOCK( &deep_lock );
319
320 if (v==0) {
321 int pushed;
322
323 // Call 'idfunc( "delete", deep_ptr )' to make deep cleanup
324 //
325 lua_CFunction idfunc= get_idfunc(L,1);
326 ASSERT_L(idfunc);
327
328 lua_settop(L,0); // clean stack so we can call 'idfunc' directly
329
330 // void= idfunc( "delete", lightuserdata )
331 //
332 lua_pushliteral( L, "delete" );
333 lua_pushlightuserdata( L, p->deep );
334 pushed= idfunc(L);
335
336 if (pushed)
337 luaL_error( L, "Bad idfunc on \"delete\": returned something" );
338
339 DEEP_FREE( (void*)p );
340 }
341 return 0;
342}
343
344
345/*
346* Push a proxy userdata on the stack.
347*
348* Initializes necessary structures if it's the first time 'idfunc' is being
349* used in this Lua state (metatable, registring it). Otherwise, increments the
350* reference count.
351*/
352void luaG_push_proxy( lua_State *L, lua_CFunction idfunc, DEEP_PRELUDE *prelude ) {
353 DEEP_PRELUDE **proxy;
354
355 MUTEX_LOCK( &deep_lock );
356 ++(prelude->refcount); // one more proxy pointing to this deep data
357 MUTEX_UNLOCK( &deep_lock );
358
359 STACK_GROW(L,4);
360
361 STACK_CHECK(L)
362
363 proxy= lua_newuserdata( L, sizeof( DEEP_PRELUDE* ) );
364 ASSERT_L(proxy);
365 *proxy= prelude;
366
367 // Get/create metatable for 'idfunc' (in this state)
368 //
369 lua_pushcfunction( L, idfunc ); // key
370 get_deep_lookup(L);
371 //
372 // [-2]: proxy
373 // [-1]: metatable / nil
374
375 if (lua_isnil(L,-1)) {
376 // No metatable yet; make one and register it
377 //
378 lua_pop(L,1);
379
380 // tbl= idfunc( "metatable" )
381 //
382 lua_pushcfunction( L, idfunc );
383 lua_pushliteral( L, "metatable" );
384 lua_call( L, 1 /*args*/, 1 /*results*/ );
385 //
386 // [-2]: proxy
387 // [-1]: metatable (returned by 'idfunc')
388
389 if (!lua_istable(L,-1))
390 luaL_error( L, "Bad idfunc on \"metatable\": did not return one" );
391
392 // Add '__gc' method
393 //
394 lua_pushcfunction( L, deep_userdata_gc );
395 lua_setfield( L, -2, "__gc" );
396
397 // Memorize for later rounds
398 //
399 lua_pushvalue( L,-1 );
400 lua_pushcfunction( L, idfunc );
401 //
402 // [-4]: proxy
403 // [-3]: metatable (2nd ref)
404 // [-2]: metatable
405 // [-1]: idfunc
406
407 set_deep_lookup(L);
408 }
409 STACK_MID(L,2)
410 ASSERT_L( lua_isuserdata(L,-2) );
411 ASSERT_L( lua_istable(L,-1) );
412
413 // [-2]: proxy userdata
414 // [-1]: metatable to use
415
416 lua_setmetatable( L, -2 );
417
418 STACK_END(L,1)
419 // [-1]: proxy userdata
420}
421
422
423/*
424* Create a deep userdata
425*
426* proxy_ud= deep_userdata( idfunc [, ...] )
427*
428* Creates a deep userdata entry of the type defined by 'idfunc'.
429* Other parameters are passed on to the 'idfunc' "new" invocation.
430*
431* 'idfunc' must fulfill the following features:
432*
433* lightuserdata= idfunc( "new" [, ...] ) -- creates a new deep data instance
434* void= idfunc( "delete", lightuserdata ) -- releases a deep data instance
435* tbl= idfunc( "metatable" ) -- gives metatable for userdata proxies
436*
437* Reference counting and true userdata proxying are taken care of for the
438* actual data type.
439*
440* Types using the deep userdata system (and only those!) can be passed between
441* separate Lua states via 'luaG_inter_move()'.
442*
443* Returns: 'proxy' userdata for accessing the deep data via 'luaG_todeep()'
444*/
445int luaG_deep_userdata( lua_State *L ) {
446 lua_CFunction idfunc= lua_tocfunction( L,1 );
447 int pushed;
448
449 DEEP_PRELUDE *prelude= DEEP_MALLOC( sizeof(DEEP_PRELUDE) );
450 ASSERT_L(prelude);
451
452 prelude->refcount= 0; // 'luaG_push_proxy' will lift it to 1
453
454 STACK_GROW(L,1);
455 STACK_CHECK(L)
456
457 // Replace 'idfunc' with "new" in the stack (keep possible other params)
458 //
459 lua_remove(L,1);
460 lua_pushliteral( L, "new" );
461 lua_insert(L,1);
462
463 // lightuserdata= idfunc( "new" [, ...] )
464 //
465 pushed= idfunc(L);
466
467 if ((pushed!=1) || lua_type(L,-1) != LUA_TLIGHTUSERDATA)
468 luaL_error( L, "Bad idfunc on \"new\": did not return light userdata" );
469
470 prelude->deep= lua_touserdata(L,-1);
471 ASSERT_L(prelude->deep);
472
473 lua_pop(L,1); // pop deep data
474
475 luaG_push_proxy( L, idfunc, prelude );
476 //
477 // [-1]: proxy userdata
478
479 STACK_END(L,1)
480 return 1;
481}
482
483
484/*
485* Access deep userdata through a proxy.
486*
487* Reference count is not changed, and access to the deep userdata is not
488* serialized. It is the module's responsibility to prevent conflicting usage.
489*/
490void *luaG_todeep( lua_State *L, lua_CFunction idfunc, int index ) {
491 DEEP_PRELUDE **proxy;
492
493 STACK_CHECK(L)
494 if (get_idfunc(L,index) != idfunc)
495 return NULL; // no metatable, or wrong kind
496
497 proxy= (DEEP_PRELUDE**)lua_touserdata( L, index );
498 STACK_END(L,0)
499
500 return (*proxy)->deep;
501}
502
503
504/*
505* Copy deep userdata between two separate Lua states.
506*
507* Returns:
508* the id function of the copied value, or NULL for non-deep userdata
509* (not copied)
510*/
511static
512lua_CFunction luaG_copydeep( lua_State *L, lua_State *L2, int index ) {
513 DEEP_PRELUDE **proxy;
514 DEEP_PRELUDE *p;
515
516 lua_CFunction idfunc;
517
518 idfunc= get_idfunc( L, index );
519 if (!idfunc) return NULL; // not a deep userdata
520
521 // Increment reference count
522 //
523 proxy= (DEEP_PRELUDE**)lua_touserdata( L, index );
524 p= *proxy;
525
526 luaG_push_proxy( L2, idfunc, p );
527 //
528 // L2 [-1]: proxy userdata
529
530 return idfunc;
531}
532
533
534
535/*---=== Inter-state copying ===---*/
536
537/*-- Metatable copying --*/
538
539/*
540 * 'reg[ REG_MT_KNOWN ]'= {
541 * [ table ]= id_uint,
542 * ...
543 * [ id_uint ]= table,
544 * ...
545 * }
546 */
547
548/*
549* Push a registry subtable (keyed by unique 'token') onto the stack.
550* If the subtable does not exist, it is created and chained.
551*/
552static
553void push_registry_subtable( lua_State *L, void *token ) {
554
555 STACK_GROW(L,3);
556
557 STACK_CHECK(L)
558
559 lua_pushlightuserdata( L, token );
560 lua_rawget( L, LUA_REGISTRYINDEX );
561 //
562 // [-1]: nil/subtable
563
564 if (lua_isnil(L,-1)) {
565 lua_pop(L,1);
566 lua_newtable(L); // value
567 lua_pushlightuserdata( L, token ); // key
568 lua_pushvalue(L,-2);
569 //
570 // [-3]: value (2nd ref)
571 // [-2]: key
572 // [-1]: value
573
574 lua_rawset( L, LUA_REGISTRYINDEX );
575 }
576 STACK_END(L,1)
577
578 ASSERT_L( lua_istable(L,-1) );
579}
580
581#define REG_MTID ( (void*) get_mt_id )
582
583/*
584* Get a unique ID for metatable at [i].
585*/
586static
587uint_t get_mt_id( lua_State *L, int i ) {
588 static uint_t last_id= 0;
589 uint_t id;
590
591 i= STACK_ABS(L,i);
592
593 STACK_GROW(L,3);
594
595 STACK_CHECK(L)
596 push_registry_subtable( L, REG_MTID );
597 lua_pushvalue(L, i);
598 lua_rawget( L, -2 );
599 //
600 // [-2]: reg[REG_MTID]
601 // [-1]: nil/uint
602
603 id= lua_tointeger(L,-1); // 0 for nil
604 lua_pop(L,1);
605 STACK_MID(L,1)
606
607 if (id==0) {
608 MUTEX_LOCK( &mtid_lock );
609 id= ++last_id;
610 MUTEX_UNLOCK( &mtid_lock );
611
612 /* Create two-way references: id_uint <-> table
613 */
614 lua_pushvalue(L,i);
615 lua_pushinteger(L,id);
616 lua_rawset( L, -3 );
617
618 lua_pushinteger(L,id);
619 lua_pushvalue(L,i);
620 lua_rawset( L, -3 );
621 }
622 lua_pop(L,1); // remove 'reg[REG_MTID]' reference
623
624 STACK_END(L,0)
625
626 return id;
627}
628
629
630static int buf_writer( lua_State *L, const void* b, size_t n, void* B ) {
631 (void)L;
632 luaL_addlstring((luaL_Buffer*) B, (const char *)b, n);
633 return 0;
634}
635
636
637/*
638 * Check if we've already copied the same table from 'L', and
639 * reuse the old copy. This allows table upvalues shared by multiple
640 * local functions to point to the same table, also in the target.
641 *
642 * Always pushes a table to 'L2'.
643 *
644 * Returns TRUE if the table was cached (no need to fill it!); FALSE if
645 * it's a virgin.
646 */
647static
648bool_t push_cached_table( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i ) {
649 bool_t ret;
650
651 ASSERT_L( hijacked_tostring );
652 ASSERT_L( L2_cache_i != 0 );
653
654 STACK_GROW(L,2);
655 STACK_GROW(L2,3);
656
657 // Create an identity string for table at [i]; it should stay unique at
658 // least during copying of the data (then we can clear the caches).
659 //
660 STACK_CHECK(L)
661 lua_pushcfunction( L, hijacked_tostring );
662 lua_pushvalue( L, i );
663 lua_call( L, 1 /*args*/, 1 /*retvals*/ );
664 //
665 // [-1]: "table: 0x...."
666
667 STACK_END(L,1)
668 ASSERT_L( lua_type(L,-1) == LUA_TSTRING );
669
670 // L2_cache[id_str]= [{...}]
671 //
672 STACK_CHECK(L2)
673
674 // We don't need to use the from state ('L') in ID since the life span
675 // is only for the duration of a copy (both states are locked).
676 //
677 lua_pushstring( L2, lua_tostring(L,-1) );
678 lua_pop(L,1); // remove the 'tostring(tbl)' value (in L!)
679
680//fprintf( stderr, "<< ID: %s >>\n", lua_tostring(L2,-1) );
681
682 lua_pushvalue( L2, -1 );
683 lua_rawget( L2, L2_cache_i );
684 //
685 // [-2]: identity string ("table: 0x...")
686 // [-1]: table|nil
687
688 if (lua_isnil(L2,-1)) {
689 lua_pop(L2,1);
690 lua_newtable(L2);
691 lua_pushvalue(L2,-1);
692 lua_insert(L2,-3);
693 //
694 // [-3]: new table (2nd ref)
695 // [-2]: identity string
696 // [-1]: new table
697
698 lua_rawset(L2, L2_cache_i);
699 //
700 // [-1]: new table (tied to 'L2_cache' table')
701
702 ret= FALSE; // brand new
703
704 } else {
705 lua_remove(L2,-2);
706 ret= TRUE; // from cache
707 }
708 STACK_END(L2,1)
709 //
710 // L2 [-1]: table to use as destination
711
712 ASSERT_L( lua_istable(L2,-1) );
713 return ret;
714}
715
716
717/*
718 * Check if we've already copied the same function from 'L', and reuse the old
719 * copy.
720 *
721 * Always pushes a function to 'L2'.
722 */
723static void inter_copy_func( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i );
724
725static
726void push_cached_func( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i ) {
727 // TBD: Merge this and same code for tables
728
729 ASSERT_L( hijacked_tostring );
730 ASSERT_L( L2_cache_i != 0 );
731
732 STACK_GROW(L,2);
733 STACK_GROW(L2,3);
734
735 STACK_CHECK(L)
736 lua_pushcfunction( L, hijacked_tostring );
737 lua_pushvalue( L, i );
738 lua_call( L, 1 /*args*/, 1 /*retvals*/ );
739 //
740 // [-1]: "function: 0x...."
741
742 STACK_END(L,1)
743 ASSERT_L( lua_type(L,-1) == LUA_TSTRING );
744
745 // L2_cache[id_str]= function
746 //
747 STACK_CHECK(L2)
748
749 // We don't need to use the from state ('L') in ID since the life span
750 // is only for the duration of a copy (both states are locked).
751 //
752 lua_pushstring( L2, lua_tostring(L,-1) );
753 lua_pop(L,1); // remove the 'tostring(tbl)' value (in L!)
754
755//fprintf( stderr, "<< ID: %s >>\n", lua_tostring(L2,-1) );
756
757 lua_pushvalue( L2, -1 );
758 lua_rawget( L2, L2_cache_i );
759 //
760 // [-2]: identity string ("function: 0x...")
761 // [-1]: function|nil|true (true means: we're working on it; recursive)
762
763 if (lua_isnil(L2,-1)) {
764 lua_pop(L2,1);
765
766 // Set to 'true' for the duration of creation; need to find self-references
767 // via upvalues
768 //
769 lua_pushboolean(L2,TRUE);
770 lua_setfield( L2, L2_cache_i, lua_tostring(L2,-2) );
771
772 inter_copy_func( L2, L2_cache_i, L, i ); // pushes a copy of the func
773
774 lua_pushvalue(L2,-1);
775 lua_insert(L2,-3);
776 //
777 // [-3]: function (2nd ref)
778 // [-2]: identity string
779 // [-1]: function
780
781 lua_rawset(L2,L2_cache_i);
782 //
783 // [-1]: function (tied to 'L2_cache' table')
784
785 } else if (lua_isboolean(L2,-1)) {
786 // Loop in preparing upvalues; either direct or via a table
787 //
788 // Note: This excludes the case where a function directly addresses
789 // itself as an upvalue (recursive lane creation).
790 //
791 luaL_error( L, "Recursive use of upvalues; cannot copy the function" );
792
793 } else {
794 lua_remove(L2,-2);
795 }
796 STACK_END(L2,1)
797 //
798 // L2 [-1]: function
799
800 ASSERT_L( lua_isfunction(L2,-1) );
801}
802
803
804/*
805* Copy a function over, which has not been found in the cache.
806*/
807enum e_vt {
808 VT_NORMAL, VT_KEY, VT_METATABLE
809};
810static bool_t inter_copy_one_( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i, enum e_vt value_type );
811
812static void inter_copy_func( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i ) {
813
814 lua_CFunction cfunc= lua_tocfunction( L,i );
815 unsigned n;
816
817 ASSERT_L( L2_cache_i != 0 );
818
819 STACK_GROW(L,2);
820
821 STACK_CHECK(L)
822 if (!cfunc) { // Lua function
823 luaL_Buffer b;
824 const char *s;
825 size_t sz;
826 int tmp;
827 const char *name= NULL;
828
829#if 0
830 // "To get information about a function you push it onto the
831 // stack and start the what string with the character '>'."
832 //
833 { lua_Debug ar;
834 lua_pushvalue( L, i );
835 lua_getinfo(L, ">n", &ar); // fills 'name' and 'namewhat', pops function
836 name= ar.namewhat;
837
838 fprintf( stderr, "NAME: %s\n", name ); // just gives NULL
839 }
840#endif
841 // 'lua_dump()' needs the function at top of stack
842 //
843 if (i!=-1) lua_pushvalue( L, i );
844
845 luaL_buffinit(L,&b);
846 tmp= lua_dump(L, buf_writer, &b);
847 ASSERT_L(tmp==0);
848 //
849 // "value returned is the error code returned by the last call
850 // to the writer" (and we only return 0)
851
852 luaL_pushresult(&b); // pushes dumped string on 'L'
853 s= lua_tolstring(L,-1,&sz);
854 ASSERT_L( s && sz );
855
856 if (i!=-1) lua_remove( L, -2 );
857
858 // Note: Line numbers seem to be taken precisely from the
859 // original function. 'name' is not used since the chunk
860 // is precompiled (it seems...).
861 //
862 // TBD: Can we get the function's original name through, as well?
863 //
864 if (luaL_loadbuffer(L2, s, sz, name) != 0) {
865 // chunk is precompiled so only LUA_ERRMEM can happen
866 // "Otherwise, it pushes an error message"
867 //
868 STACK_GROW( L,1 );
869 luaL_error( L, "%s", lua_tostring(L2,-1) );
870 }
871 lua_pop(L,1); // remove the dumped string
872 STACK_MID(L,0)
873 }
874
875 /* push over any upvalues; references to this function will come from
876 * cache so we don't end up in eternal loop.
877 */
878 for( n=0; lua_getupvalue( L, i, 1+n ) != NULL; n++ ) {
879 if ((!cfunc) && lua_equal(L,i,-1)) {
880 /* Lua closure that has a (recursive) upvalue to itself
881 */
882 lua_pushvalue( L2, -((int)n)-1 );
883 } else {
884 if (!inter_copy_one_( L2, L2_cache_i, L, lua_gettop(L), VT_NORMAL ))
885 luaL_error( L, "Cannot copy upvalue type '%s'", luaG_typename(L,-1) );
886 }
887 lua_pop(L,1);
888 }
889 // L2: function + 'n' upvalues (>=0)
890
891 STACK_MID(L,0)
892
893 if (cfunc) {
894 lua_pushcclosure( L2, cfunc, n ); // eats up upvalues
895 } else {
896 // Set upvalues (originally set to 'nil' by 'lua_load')
897 //
898 int func_index= lua_gettop(L2)-n;
899
900 for( ; n>0; n-- ) {
901 const char *rc= lua_setupvalue( L2, func_index, n );
902 //
903 // "assigns the value at the top of the stack to the upvalue and returns its name.
904 // It also pops the value from the stack."
905
906 ASSERT_L(rc); // not having enough slots?
907 }
908 }
909 STACK_END(L,0)
910}
911
912
913/*
914* Copies a value from 'L' state (at index 'i') to 'L2' state. Does not remove
915* the original value.
916*
917* NOTE: Both the states must be solely in the current OS thread's posession.
918*
919* 'i' is an absolute index (no -1, ...)
920*
921* Returns TRUE if value was pushed, FALSE if its type is non-supported.
922*/
923static bool_t inter_copy_one_( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i, enum e_vt vt )
924{
925 bool_t ret= TRUE;
926
927 STACK_GROW( L2, 1 );
928
929 STACK_CHECK(L2)
930
931 switch ( lua_type(L,i) ) {
932 /* Basic types allowed both as values, and as table keys */
933
934 case LUA_TBOOLEAN:
935 lua_pushboolean( L2, lua_toboolean(L, i) );
936 break;
937
938 case LUA_TNUMBER:
939 /* LNUM patch support (keeping integer accuracy) */
940#ifdef LUA_LNUM
941 if (lua_isinteger(L,i)) {
942 lua_pushinteger( L2, lua_tointeger(L, i) );
943 break;
944 }
945#endif
946 lua_pushnumber( L2, lua_tonumber(L, i) );
947 break;
948
949 case LUA_TSTRING: {
950 size_t len; const char *s = lua_tolstring( L, i, &len );
951 lua_pushlstring( L2, s, len );
952 } break;
953
954 case LUA_TLIGHTUSERDATA:
955 lua_pushlightuserdata( L2, lua_touserdata(L, i) );
956 break;
957
958 /* The following types are not allowed as table keys */
959
960 case LUA_TUSERDATA: if (vt==VT_KEY) { ret=FALSE; break; }
961 /* Allow only deep userdata entities to be copied across
962 */
963 if (!luaG_copydeep( L, L2, i )) {
964 // Cannot copy it full; copy as light userdata
965 //
966 lua_pushlightuserdata( L2, lua_touserdata(L, i) );
967 } break;
968
969 case LUA_TNIL: if (vt==VT_KEY) { ret=FALSE; break; }
970 lua_pushnil(L2);
971 break;
972
973 case LUA_TFUNCTION: if (vt==VT_KEY) { ret=FALSE; break; } {
974 /*
975 * Passing C functions is risky; if they refer to LUA_ENVIRONINDEX
976 * and/or LUA_REGISTRYINDEX they might work unintended (not work)
977 * at the target.
978 *
979 * On the other hand, NOT copying them causes many self tests not
980 * to work (timer, hangtest, ...)
981 *
982 * The trouble is, we cannot KNOW if the function at hand is safe
983 * or not. We cannot study it's behaviour. We could trust the user,
984 * but they might not even know they're sending lua_CFunction over
985 * (as upvalues etc.).
986 */
987#if 0
988 if (lua_iscfunction(L,i))
989 luaL_error( L, "Copying lua_CFunction between Lua states is risky, and currently disabled." );
990#endif
991 STACK_CHECK(L2)
992 push_cached_func( L2, L2_cache_i, L, i );
993 ASSERT_L( lua_isfunction(L2,-1) );
994 STACK_END(L2,1)
995 } break;
996
997 case LUA_TTABLE: if (vt==VT_KEY) { ret=FALSE; break; } {
998
999 STACK_CHECK(L)
1000 STACK_CHECK(L2)
1001
1002 /* Check if we've already copied the same table from 'L' (during this transmission), and
1003 * reuse the old copy. This allows table upvalues shared by multiple
1004 * local functions to point to the same table, also in the target.
1005 * Also, this takes care of cyclic tables and multiple references
1006 * to the same subtable.
1007 *
1008 * Note: Even metatables need to go through this test; to detect
1009 * loops s.a. those in required module tables (getmetatable(lanes).lanes == lanes)
1010 */
1011 if (push_cached_table( L2, L2_cache_i, L, i )) {
1012 ASSERT_L( lua_istable(L2, -1) ); // from cache
1013 break;
1014 }
1015 ASSERT_L( lua_istable(L2,-1) );
1016
1017 STACK_GROW( L, 2 );
1018 STACK_GROW( L2, 2 );
1019
1020 lua_pushnil(L); // start iteration
1021 while( lua_next( L, i ) ) {
1022 uint_t val_i= lua_gettop(L);
1023 uint_t key_i= val_i-1;
1024
1025 /* Only basic key types are copied over; others ignored
1026 */
1027 if (inter_copy_one_( L2, 0 /*key*/, L, key_i, VT_KEY )) {
1028 /*
1029 * Contents of metatables are copied with cache checking;
1030 * important to detect loops.
1031 */
1032 if (inter_copy_one_( L2, L2_cache_i, L, val_i, VT_NORMAL )) {
1033 ASSERT_L( lua_istable(L2,-3) );
1034 lua_rawset( L2, -3 ); // add to table (pops key & val)
1035 } else {
1036 luaL_error( L, "Unable to copy over type '%s' (in %s)",
1037 luaG_typename(L,val_i),
1038 vt==VT_NORMAL ? "table":"metatable" );
1039 }
1040 }
1041 lua_pop( L, 1 ); // pop value (next round)
1042 }
1043 STACK_MID(L,0)
1044 STACK_MID(L2,1)
1045
1046 /* Metatables are expected to be immutable, and copied only once.
1047 */
1048 if (lua_getmetatable( L, i )) {
1049 //
1050 // L [-1]: metatable
1051
1052 uint_t mt_id= get_mt_id( L, -1 ); // Unique id for the metatable
1053
1054 STACK_GROW(L2,4);
1055
1056 push_registry_subtable( L2, REG_MTID );
1057 STACK_MID(L2,2);
1058 lua_pushinteger( L2, mt_id );
1059 lua_rawget( L2, -2 );
1060 //
1061 // L2 ([-3]: copied table)
1062 // [-2]: reg[REG_MTID]
1063 // [-1]: nil/metatable pre-known in L2
1064
1065 STACK_MID(L2,3);
1066
1067 if (lua_isnil(L2,-1)) { /* L2 did not know the metatable */
1068 lua_pop(L2,1);
1069 STACK_MID(L2,2);
1070ASSERT_L( lua_istable(L,-1) );
1071 if (inter_copy_one_( L2, L2_cache_i /*for function cacheing*/, L, lua_gettop(L) /*[-1]*/, VT_METATABLE )) {
1072 //
1073 // L2 ([-3]: copied table)
1074 // [-2]: reg[REG_MTID]
1075 // [-1]: metatable (copied from L)
1076
1077 STACK_MID(L2,3);
1078 // mt_id -> metatable
1079 //
1080 lua_pushinteger(L2,mt_id);
1081 lua_pushvalue(L2,-2);
1082 lua_rawset(L2,-4);
1083
1084 // metatable -> mt_id
1085 //
1086 lua_pushvalue(L2,-1);
1087 lua_pushinteger(L2,mt_id);
1088 lua_rawset(L2,-4);
1089
1090 STACK_MID(L2,3);
1091 } else {
1092 luaL_error( L, "Error copying a metatable" );
1093 }
1094 STACK_MID(L2,3);
1095 }
1096 // L2 ([-3]: copied table)
1097 // [-2]: reg[REG_MTID]
1098 // [-1]: metatable (pre-known or copied from L)
1099
1100 lua_remove(L2,-2); // take away 'reg[REG_MTID]'
1101 //
1102 // L2: ([-2]: copied table)
1103 // [-1]: metatable for that table
1104
1105 lua_setmetatable( L2, -2 );
1106
1107 // L2: [-1]: copied table (with metatable set if source had it)
1108
1109 lua_pop(L,1); // remove source metatable (L, not L2!)
1110 }
1111 STACK_END(L2,1)
1112 STACK_END(L,0)
1113 } break;
1114
1115 /* The following types cannot be copied */
1116
1117 case LUA_TTHREAD:
1118 ret=FALSE; break;
1119 }
1120
1121 STACK_END(L2, ret? 1:0)
1122
1123 return ret;
1124}
1125
1126
1127/*
1128* Akin to 'lua_xmove' but copies values between _any_ Lua states.
1129*
1130* NOTE: Both the states must be solely in the current OS thread's posession.
1131*
1132* Note: Parameters are in this order ('L' = from first) to be same as 'lua_xmove'.
1133*/
1134void luaG_inter_copy( lua_State* L, lua_State *L2, uint_t n )
1135{
1136 uint_t top_L= lua_gettop(L);
1137 uint_t top_L2= lua_gettop(L2);
1138 uint_t i;
1139
1140 /* steal Lua library's 'luaB_tostring()' from the first call. Other calls
1141 * don't have to have access to it.
1142 *
1143 * Note: multiple threads won't come here at once; this function will
1144 * be called before there can be multiple threads (no locking needed).
1145 */
1146 if (!hijacked_tostring) {
1147 STACK_GROW( L,1 );
1148
1149 STACK_CHECK(L)
1150 lua_getglobal( L, "tostring" );
1151 //
1152 // [-1]: function|nil
1153
1154 hijacked_tostring= lua_tocfunction( L, -1 );
1155 lua_pop(L,1);
1156 STACK_END(L,0)
1157
1158 if (!hijacked_tostring) {
1159 luaL_error( L, "Need to see 'tostring()' once" );
1160 }
1161 }
1162
1163 if (n > top_L)
1164 luaL_error( L, "Not enough values: %d < %d", top_L, n );
1165
1166 STACK_GROW( L2, n+1 );
1167
1168 /*
1169 * Make a cache table for the duration of this copy. Collects tables and
1170 * function entries, avoiding the same entries to be passed on as multiple
1171 * copies. ESSENTIAL i.e. for handling upvalue tables in the right manner!
1172 */
1173 lua_newtable(L2);
1174
1175 for (i=top_L-n+1; i <= top_L; i++) {
1176 if (!inter_copy_one_( L2, top_L2+1, L, i, VT_NORMAL )) {
1177
1178 luaL_error( L, "Cannot copy type: %s", luaG_typename(L,i) );
1179 }
1180 }
1181
1182 /*
1183 * Remove the cache table. Persistant caching would cause i.e. multiple
1184 * messages passed in the same table to use the same table also in receiving
1185 * end.
1186 */
1187 lua_remove( L2, top_L2+1 );
1188
1189 ASSERT_L( (uint_t)lua_gettop(L) == top_L );
1190 ASSERT_L( (uint_t)lua_gettop(L2) == top_L2+n );
1191}
1192
1193
1194void luaG_inter_move( lua_State* L, lua_State *L2, uint_t n )
1195{
1196 luaG_inter_copy( L, L2, n );
1197 lua_pop( L,(int)n );
1198}
diff --git a/src/tools.h b/src/tools.h
new file mode 100644
index 0000000..d155c65
--- /dev/null
+++ b/src/tools.h
@@ -0,0 +1,72 @@
1/*
2* TOOLS.H
3*/
4#ifndef TOOLS_H
5#define TOOLS_H
6
7#include "lua.h"
8#include "threading.h"
9 // MUTEX_T
10
11#include <assert.h>
12
13// Note: The < -10000 test is to leave registry/global/upvalue indices untouched
14//
15#define /*int*/ STACK_ABS(L,n) \
16 ( ((n) >= 0 || (n) <= -10000) ? (n) : lua_gettop(L) +(n) +1 )
17
18#ifdef NDEBUG
19 #define _ASSERT_L(lua,c) /*nothing*/
20 #define STACK_CHECK(L) /*nothing*/
21 #define STACK_MID(L,c) /*nothing*/
22 #define STACK_END(L,c) /*nothing*/
23 #define STACK_DUMP(L) /*nothing*/
24 #define DEBUG() /*nothing*/
25#else
26 #define _ASSERT_L(lua,c) { if (!(c)) luaL_error( lua, "ASSERT failed: %s:%d '%s'", __FILE__, __LINE__, #c ); }
27 //
28 #define STACK_CHECK(L) { int _oldtop_##L = lua_gettop(L);
29 #define STACK_MID(L,change) { int a= lua_gettop(L)-_oldtop_##L; int b= (change); \
30 if (a != b) luaL_error( L, "STACK ASSERT failed (%d not %d): %s:%d", a, b, __FILE__, __LINE__ ); }
31 #define STACK_END(L,change) STACK_MID(L,change) }
32
33 #define STACK_DUMP(L) luaG_dump(L);
34 #define DEBUG() fprintf( stderr, "<<%s %d>>\n", __FILE__, __LINE__ );
35#endif
36#define ASSERT_L(c) _ASSERT_L(L,c)
37
38#define STACK_GROW(L,n) { if (!lua_checkstack(L,n)) luaL_error( L, "Cannot grow stack!" ); }
39
40#define LUAG_FUNC( func_name ) static int LG_##func_name( lua_State *L )
41
42#define luaG_optunsigned(L,i,d) ((uint_t) luaL_optinteger(L,i,d))
43#define luaG_tounsigned(L,i) ((uint_t) lua_tointeger(L,i))
44
45#define luaG_isany(L,i) (!lua_isnil(L,i))
46
47#define luaG_typename( L, index ) lua_typename( L, lua_type(L,index) )
48
49void luaG_dump( lua_State* L );
50
51const char *luaG_openlibs( lua_State *L, const char *libs );
52
53int luaG_deep_userdata( lua_State *L );
54void *luaG_todeep( lua_State *L, lua_CFunction idfunc, int index );
55
56typedef struct {
57 volatile int refcount;
58 void *deep;
59} DEEP_PRELUDE;
60
61void luaG_push_proxy( lua_State *L, lua_CFunction idfunc, DEEP_PRELUDE *deep_userdata );
62
63void luaG_inter_copy( lua_State *L, lua_State *L2, uint_t n );
64void luaG_inter_move( lua_State *L, lua_State *L2, uint_t n );
65
66// Lock for reference counter inc/dec locks (to be initialized by outside code)
67//
68extern MUTEX_T deep_lock;
69extern MUTEX_T mtid_lock;
70
71#endif
72 // TOOLS_H