diff options
| author | Peter Drahoš <drahosp@gmail.com> | 2010-10-01 03:22:32 +0200 |
|---|---|---|
| committer | Peter Drahoš <drahosp@gmail.com> | 2010-10-01 03:22:32 +0200 |
| commit | 89d9c98af1ac352ba4d49d660e61b0853d6e1a86 (patch) | |
| tree | 15c56d2ce66b4ab147171c0f674cdb4a435ff13f /src | |
| download | lanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.tar.gz lanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.tar.bz2 lanes-89d9c98af1ac352ba4d49d660e61b0853d6e1a86.zip | |
Import to git
Diffstat (limited to 'src')
| -rw-r--r-- | src/Makefile | 176 | ||||
| -rw-r--r-- | src/keeper.lua | 244 | ||||
| -rw-r--r-- | src/lanes.c | 1849 | ||||
| -rw-r--r-- | src/lanes.lua | 611 | ||||
| -rw-r--r-- | src/threading.c | 721 | ||||
| -rw-r--r-- | src/threading.h | 196 | ||||
| -rw-r--r-- | src/tools.c | 1198 | ||||
| -rw-r--r-- | src/tools.h | 72 |
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 | |||
| 8 | MODULE=lanes | ||
| 9 | |||
| 10 | SRC=lanes.c threading.c tools.c | ||
| 11 | |||
| 12 | OBJ=$(SRC:.c=.o) | ||
| 13 | |||
| 14 | # LuaRocks gives 'LIBFLAG' from the outside | ||
| 15 | # | ||
| 16 | LIBFLAG=-shared | ||
| 17 | |||
| 18 | OPT_FLAGS=-O2 | ||
| 19 | # -O0 -g | ||
| 20 | |||
| 21 | LUA=lua | ||
| 22 | LUAC=luac | ||
| 23 | |||
| 24 | _SO=.so | ||
| 25 | ifeq "$(findstring MINGW32,$(shell uname -s))" "MINGW32" | ||
| 26 | _SO=.dll | ||
| 27 | endif | ||
| 28 | |||
| 29 | ifeq "$(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) | ||
| 99 | endif | ||
| 100 | |||
| 101 | #--- | ||
| 102 | # PThread platform specifics | ||
| 103 | # | ||
| 104 | ifeq "$(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 | ||
| 113 | endif | ||
| 114 | |||
| 115 | ifeq "$(shell uname -s)" "BSD" | ||
| 116 | LIBS += -lpthread | ||
| 117 | endif | ||
| 118 | |||
| 119 | #--- | ||
| 120 | all: 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 | # | ||
| 126 | lua51-$(MODULE)$(_SO): $(OBJ) | ||
| 127 | $(CC) $(LIBFLAG) $(LIBS) $^ $(LUA_LIBS) -o $@ | ||
| 128 | |||
| 129 | clean: | ||
| 130 | -rm -rf lua51-$(MODULE)$(_SO) *.lch *.o *.tmp *.map | ||
| 131 | |||
| 132 | lanes.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 | # | ||
| 145 | nslu2: | ||
| 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 | # | ||
| 158 | MINGW_GCC=mingw32-gcc | ||
| 159 | # i686-pc-mingw32-gcc | ||
| 160 | |||
| 161 | win32: $(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 | |||
| 14 | Copyright (C) 2008 Asko Kauppi <akauppi@gmail.com> | ||
| 15 | |||
| 16 | Permission is hereby granted, free of charge, to any person obtaining a copy | ||
| 17 | of this software and associated documentation files (the "Software"), to deal | ||
| 18 | in the Software without restriction, including without limitation the rights | ||
| 19 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | ||
| 20 | copies of the Software, and to permit persons to whom the Software is | ||
| 21 | furnished to do so, subject to the following conditions: | ||
| 22 | |||
| 23 | The above copyright notice and this permission notice shall be included in | ||
| 24 | all copies or substantial portions of the Software. | ||
| 25 | |||
| 26 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||
| 27 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||
| 28 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||
| 29 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||
| 30 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | ||
| 31 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | ||
| 32 | THE SOFTWARE. | ||
| 33 | |||
| 34 | =============================================================================== | ||
| 35 | ]]-- | ||
| 36 | |||
| 37 | -- unique key instead of 'nil' in queues | ||
| 38 | -- | ||
| 39 | assert( nil_sentinel ) | ||
| 40 | |||
| 41 | -- We only need to have base and table libraries (and io for debugging) | ||
| 42 | -- | ||
| 43 | local table_remove= assert( table.remove ) | ||
| 44 | local table_concat= assert( table.concat ) | ||
| 45 | |||
| 46 | local function WR(...) | ||
| 47 | if io then | ||
| 48 | io.stderr:write( table_concat({...},'\t').."\n" ) | ||
| 49 | end | ||
| 50 | end | ||
| 51 | |||
| 52 | ----- | ||
| 53 | -- Actual data store | ||
| 54 | -- | ||
| 55 | -- { [linda_deep_ud]= { key= val [, ...] } | ||
| 56 | -- ... | ||
| 57 | -- } | ||
| 58 | -- | ||
| 59 | local _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 | -- | ||
| 68 | local _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 | -- | ||
| 77 | local _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 | -- | ||
| 84 | local 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] | ||
| 93 | end | ||
| 94 | |||
| 95 | |||
| 96 | local 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 ) | ||
| 106 | end | ||
| 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 | -- | ||
| 121 | function 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 | ||
| 158 | end | ||
| 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 | -- | ||
| 167 | function 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 | ||
| 189 | end | ||
| 190 | |||
| 191 | |||
| 192 | ----- | ||
| 193 | -- = limit( linda_deep_ud, key, uint ) | ||
| 194 | -- | ||
| 195 | function limit( ud, key, n ) | ||
| 196 | |||
| 197 | local _,_,limits= tables(ud) | ||
| 198 | |||
| 199 | limits[key]= n | ||
| 200 | end | ||
| 201 | |||
| 202 | |||
| 203 | ----- | ||
| 204 | -- void= set( linda_deep_ud, key, [val] ) | ||
| 205 | -- | ||
| 206 | function 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 | ||
| 214 | end | ||
| 215 | |||
| 216 | |||
| 217 | ----- | ||
| 218 | -- [val]= get( linda_deep_ud, key ) | ||
| 219 | -- | ||
| 220 | function 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 | ||
| 229 | end | ||
| 230 | |||
| 231 | |||
| 232 | ----- | ||
| 233 | -- void= clear( linda_deep_ud ) | ||
| 234 | -- | ||
| 235 | -- Clear the data structures used for a Linda (at its destructor) | ||
| 236 | -- | ||
| 237 | function clear( ud ) | ||
| 238 | |||
| 239 | _data[ud]= nil | ||
| 240 | _incoming[ud]= nil | ||
| 241 | _limits[ud]= nil | ||
| 242 | end | ||
| 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 | |||
| 60 | const char *VERSION= "2.0.3"; | ||
| 61 | |||
| 62 | /* | ||
| 63 | =============================================================================== | ||
| 64 | |||
| 65 | Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com> | ||
| 66 | |||
| 67 | Permission is hereby granted, free of charge, to any person obtaining a copy | ||
| 68 | of this software and associated documentation files (the "Software"), to deal | ||
| 69 | in the Software without restriction, including without limitation the rights | ||
| 70 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | ||
| 71 | copies of the Software, and to permit persons to whom the Software is | ||
| 72 | furnished to do so, subject to the following conditions: | ||
| 73 | |||
| 74 | The above copyright notice and this permission notice shall be included in | ||
| 75 | all copies or substantial portions of the Software. | ||
| 76 | |||
| 77 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||
| 78 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||
| 79 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||
| 80 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||
| 81 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | ||
| 82 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | ||
| 83 | THE 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 | */ | ||
| 127 | static char keeper_chunk[]= | ||
| 128 | #include "keeper.lch" | ||
| 129 | |||
| 130 | struct s_lane; | ||
| 131 | static bool_t cancel_test( lua_State *L ); | ||
| 132 | static 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 | |||
| 147 | struct 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 | |||
| 163 | static 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 | */ | ||
| 174 | static 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 | |||
| 200 | static 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 | // | ||
| 209 | static 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 | */ | ||
| 239 | static | ||
| 240 | void 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 | */ | ||
| 273 | struct 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 | */ | ||
| 281 | static 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 | */ | ||
| 292 | static 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 | |||
| 326 | static | ||
| 327 | struct 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 | |||
| 341 | static | ||
| 342 | void 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 | */ | ||
| 355 | static | ||
| 356 | int 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 | */ | ||
| 386 | struct s_Linda { | ||
| 387 | SIGNAL_T read_happened; | ||
| 388 | SIGNAL_T write_happened; | ||
| 389 | }; | ||
| 390 | |||
| 391 | static 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 | */ | ||
| 404 | LUAG_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' | ||
| 426 | STACK_CHECK(KL) | ||
| 427 | while(TRUE) { | ||
| 428 | int pushed; | ||
| 429 | |||
| 430 | STACK_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 | } | ||
| 458 | STACK_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 | */ | ||
| 478 | LUAG_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 | */ | ||
| 535 | LUAG_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 | */ | ||
| 561 | LUAG_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 | */ | ||
| 581 | LUAG_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 | */ | ||
| 605 | LUAG_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 | */ | ||
| 631 | LUAG_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 | // | ||
| 724 | LUAG_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 | // | ||
| 754 | static 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 | // | ||
| 811 | struct 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 | |||
| 859 | static 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 | |||
| 868 | struct 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 | */ | ||
| 874 | static 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 | */ | ||
| 889 | static 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 | */ | ||
| 919 | static 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 | */ | ||
| 1030 | static 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 | |||
| 1047 | static 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 | |||
| 1053 | static 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 | // | ||
| 1065 | LUAG_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 | |||
| 1103 | static 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 | // | ||
| 1291 | LUAG_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) { | ||
| 1323 | STACK_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 ); | ||
| 1336 | STACK_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 | // | ||
| 1350 | STACK_CHECK(L) | ||
| 1351 | lua_pushvalue( L, 1 ); | ||
| 1352 | luaG_inter_move( L,L2, 1 ); // L->L2 | ||
| 1353 | STACK_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 | ||
| 1361 | STACK_MID(L,0) | ||
| 1362 | |||
| 1363 | ASSERT_L( (uint_t)lua_gettop(L2) == 1+args ); | ||
| 1364 | ASSERT_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 ); | ||
| 1391 | STACK_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 ); | ||
| 1405 | STACK_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 | // | ||
| 1431 | LUAG_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 | ||
| 1451 | fprintf( 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 | ||
| 1457 | fprintf( 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 | // | ||
| 1490 | LUAG_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 | |||
| 1517 | static 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 | // | ||
| 1549 | LUAG_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 | // | ||
| 1579 | LUAG_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 | */ | ||
| 1637 | static | ||
| 1638 | void 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 | */ | ||
| 1676 | LUAG_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 | */ | ||
| 1685 | LUAG_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 | |||
| 1748 | int | ||
| 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 | |||
| 18 | Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com> | ||
| 19 | |||
| 20 | Permission is hereby granted, free of charge, to any person obtaining a copy | ||
| 21 | of this software and associated documentation files (the "Software"), to deal | ||
| 22 | in the Software without restriction, including without limitation the rights | ||
| 23 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | ||
| 24 | copies of the Software, and to permit persons to whom the Software is | ||
| 25 | furnished to do so, subject to the following conditions: | ||
| 26 | |||
| 27 | The above copyright notice and this permission notice shall be included in | ||
| 28 | all copies or substantial portions of the Software. | ||
| 29 | |||
| 30 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||
| 31 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||
| 32 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||
| 33 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||
| 34 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | ||
| 35 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | ||
| 36 | THE SOFTWARE. | ||
| 37 | |||
| 38 | =============================================================================== | ||
| 39 | ]]-- | ||
| 40 | |||
| 41 | module( "lanes", package.seeall ) | ||
| 42 | |||
| 43 | require "lua51-lanes" | ||
| 44 | assert( type(lanes)=="table" ) | ||
| 45 | |||
| 46 | local mm= lanes | ||
| 47 | |||
| 48 | local linda_id= assert( mm.linda_id ) | ||
| 49 | |||
| 50 | local thread_new= assert(mm.thread_new) | ||
| 51 | local thread_status= assert(mm.thread_status) | ||
| 52 | local thread_join= assert(mm.thread_join) | ||
| 53 | local thread_cancel= assert(mm.thread_cancel) | ||
| 54 | |||
| 55 | local _single= assert(mm._single) | ||
| 56 | local _version= assert(mm._version) | ||
| 57 | |||
| 58 | local _deep_userdata= assert(mm._deep_userdata) | ||
| 59 | |||
| 60 | local now_secs= assert( mm.now_secs ) | ||
| 61 | local wakeup_conv= assert( mm.wakeup_conv ) | ||
| 62 | local timer_gateway= assert( mm.timer_gateway ) | ||
| 63 | |||
| 64 | local 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 | -- | ||
| 70 | if not string then | ||
| 71 | error( "To use 'lanes', you will also need to have 'string' available.", 2 ) | ||
| 72 | end | ||
| 73 | |||
| 74 | -- | ||
| 75 | -- Cache globals for code that might run under sandboxing | ||
| 76 | -- | ||
| 77 | local assert= assert | ||
| 78 | local string_gmatch= assert( string.gmatch ) | ||
| 79 | local select= assert( select ) | ||
| 80 | local type= assert( type ) | ||
| 81 | local pairs= assert( pairs ) | ||
| 82 | local tostring= assert( tostring ) | ||
| 83 | local error= assert( error ) | ||
| 84 | local setmetatable= assert( setmetatable ) | ||
| 85 | local rawget= assert( rawget ) | ||
| 86 | |||
| 87 | ABOUT= | ||
| 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 | -- | ||
| 101 | local function WR(str) | ||
| 102 | io.stderr:write( str.."\n" ) | ||
| 103 | end | ||
| 104 | |||
| 105 | local 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) | ||
| 112 | end | ||
| 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 | -- | ||
| 126 | local 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 | -- | ||
| 220 | local lane_proxy | ||
| 221 | |||
| 222 | local 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 | |||
| 236 | function 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 | ||
| 299 | end | ||
| 300 | |||
| 301 | lane_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 | ||
| 319 | end | ||
| 320 | |||
| 321 | |||
| 322 | ---=== Lindas ===--- | ||
| 323 | |||
| 324 | -- We let the C code attach methods to userdata directly | ||
| 325 | |||
| 326 | ----- | ||
| 327 | -- linda_ud= lanes.linda() | ||
| 328 | -- | ||
| 329 | function linda() | ||
| 330 | local proxy= _deep_userdata( linda_id ) | ||
| 331 | assert( (type(proxy) == "userdata") and getmetatable(proxy) ) | ||
| 332 | return proxy | ||
| 333 | end | ||
| 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 | -- | ||
| 348 | local TGW_KEY= "(timer control)" -- the key does not matter, a 'weird' key may help debugging | ||
| 349 | local first_time_key= "first time" | ||
| 350 | |||
| 351 | local first_time= timer_gateway:get(first_time_key) == nil | ||
| 352 | timer_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 | -- | ||
| 358 | if 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 )() | ||
| 518 | end | ||
| 519 | |||
| 520 | ----- | ||
| 521 | -- = timer( linda_h, key_val, date_tbl|first_secs [,period_secs] ) | ||
| 522 | -- | ||
| 523 | function 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 ) | ||
| 545 | end | ||
| 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 | -- | ||
| 563 | function 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 | ||
| 585 | end | ||
| 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 | -- | ||
| 596 | function 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 | ||
| 608 | end | ||
| 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 | |||
| 13 | Copyright (C) 2007-08 Asko Kauppi <akauppi@gmail.com> | ||
| 14 | |||
| 15 | Permission is hereby granted, free of charge, to any person obtaining a copy | ||
| 16 | of this software and associated documentation files (the "Software"), to deal | ||
| 17 | in the Software without restriction, including without limitation the rights | ||
| 18 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | ||
| 19 | copies of the Software, and to permit persons to whom the Software is | ||
| 20 | furnished to do so, subject to the following conditions: | ||
| 21 | |||
| 22 | The above copyright notice and this permission notice shall be included in | ||
| 23 | all copies or substantial portions of the Software. | ||
| 24 | |||
| 25 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||
| 26 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||
| 27 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||
| 28 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||
| 29 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | ||
| 30 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | ||
| 31 | THE 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) | ||
| 75 | static 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 | */ | ||
| 88 | time_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 | */ | ||
| 162 | time_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 | */ | ||
| 172 | static 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 | |||
| 721 | static 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 | |||
| 27 | typedef int bool_t; | ||
| 28 | #ifndef FALSE | ||
| 29 | # define FALSE 0 | ||
| 30 | # define TRUE 1 | ||
| 31 | #endif | ||
| 32 | |||
| 33 | typedef 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 | */ | ||
| 46 | enum 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 | |||
| 119 | void SIGNAL_INIT( SIGNAL_T *ref ); | ||
| 120 | void SIGNAL_FREE( SIGNAL_T *ref ); | ||
| 121 | void 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 | */ | ||
| 128 | typedef double time_d; | ||
| 129 | time_d now_secs(void); | ||
| 130 | |||
| 131 | time_d SIGNAL_TIMEOUT_PREPARE( double rel_secs ); | ||
| 132 | |||
| 133 | bool_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 | |||
| 193 | void 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 | |||
| 10 | Copyright (C) 2002-08 Asko Kauppi <akauppi@gmail.com> | ||
| 11 | |||
| 12 | Permission is hereby granted, free of charge, to any person obtaining a copy | ||
| 13 | of this software and associated documentation files (the "Software"), to deal | ||
| 14 | in the Software without restriction, including without limitation the rights | ||
| 15 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | ||
| 16 | copies of the Software, and to permit persons to whom the Software is | ||
| 17 | furnished to do so, subject to the following conditions: | ||
| 18 | |||
| 19 | The above copyright notice and this permission notice shall be included in | ||
| 20 | all copies or substantial portions of the Software. | ||
| 21 | |||
| 22 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | ||
| 23 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | ||
| 24 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | ||
| 25 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | ||
| 26 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | ||
| 27 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | ||
| 28 | THE 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 | |||
| 43 | static volatile lua_CFunction hijacked_tostring; // = NULL | ||
| 44 | |||
| 45 | MUTEX_T deep_lock; | ||
| 46 | MUTEX_T mtid_lock; | ||
| 47 | |||
| 48 | /*---=== luaG_dump ===---*/ | ||
| 49 | |||
| 50 | void 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 | |||
| 97 | static 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 | |||
| 111 | static 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 | |||
| 144 | const 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 | |||
| 193 | static 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 | */ | ||
| 199 | void 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 | */ | ||
| 250 | void 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 | */ | ||
| 277 | static | ||
| 278 | lua_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 | */ | ||
| 308 | static | ||
| 309 | int 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 | */ | ||
| 352 | void 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 | */ | ||
| 445 | int 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 | */ | ||
| 490 | void *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 | */ | ||
| 511 | static | ||
| 512 | lua_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 | */ | ||
| 552 | static | ||
| 553 | void 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 | */ | ||
| 586 | static | ||
| 587 | uint_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 | |||
| 630 | static 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 | */ | ||
| 647 | static | ||
| 648 | bool_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 | */ | ||
| 723 | static void inter_copy_func( lua_State *L2, uint_t L2_cache_i, lua_State *L, uint_t i ); | ||
| 724 | |||
| 725 | static | ||
| 726 | void 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 | */ | ||
| 807 | enum e_vt { | ||
| 808 | VT_NORMAL, VT_KEY, VT_METATABLE | ||
| 809 | }; | ||
| 810 | static 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 | |||
| 812 | static 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 | */ | ||
| 923 | static 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); | ||
| 1070 | ASSERT_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 | */ | ||
| 1134 | void 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 | |||
| 1194 | void 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 | |||
| 49 | void luaG_dump( lua_State* L ); | ||
| 50 | |||
| 51 | const char *luaG_openlibs( lua_State *L, const char *libs ); | ||
| 52 | |||
| 53 | int luaG_deep_userdata( lua_State *L ); | ||
| 54 | void *luaG_todeep( lua_State *L, lua_CFunction idfunc, int index ); | ||
| 55 | |||
| 56 | typedef struct { | ||
| 57 | volatile int refcount; | ||
| 58 | void *deep; | ||
| 59 | } DEEP_PRELUDE; | ||
| 60 | |||
| 61 | void luaG_push_proxy( lua_State *L, lua_CFunction idfunc, DEEP_PRELUDE *deep_userdata ); | ||
| 62 | |||
| 63 | void luaG_inter_copy( lua_State *L, lua_State *L2, uint_t n ); | ||
| 64 | void 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 | // | ||
| 68 | extern MUTEX_T deep_lock; | ||
| 69 | extern MUTEX_T mtid_lock; | ||
| 70 | |||
| 71 | #endif | ||
| 72 | // TOOLS_H | ||
