Mercurial > vba-clojure

annotate src/lua/lbaselib.c @ 545:2b6cdea9bcdb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
audio now syncs properly, but moves no longer sync with main display.
author Robert McIntyre <rlm@mit.edu>
date Wed, 27 Jun 2012 13:41:01 -0500
parents 27763b933818
children
rev   line source
rlm@1 1 /*
rlm@1 2 ** $Id: lbaselib.c,v 1.191.1.6 2008/02/14 16:46:22 roberto Exp $
rlm@1 3 ** Basic library
rlm@1 4 ** See Copyright Notice in lua.h
rlm@1 5 */
rlm@1 6
rlm@1 7
rlm@1 8
rlm@1 9 #include <ctype.h>
rlm@1 10 #include <stdio.h>
rlm@1 11 #include <stdlib.h>
rlm@1 12 #include <string.h>
rlm@1 13
rlm@1 14 #define lbaselib_c
rlm@1 15 #define LUA_LIB
rlm@1 16
rlm@1 17 #include "lua.h"
rlm@1 18
rlm@1 19 #include "lauxlib.h"
rlm@1 20 #include "lualib.h"
rlm@1 21
rlm@1 22
rlm@1 23
rlm@1 24
rlm@1 25 /*
rlm@1 26 ** If your system does not support `stdout', you can just remove this function.
rlm@1 27 ** If you need, you can define your own `print' function, following this
rlm@1 28 ** model but changing `fputs' to put the strings at a proper place
rlm@1 29 ** (a console window or a log file, for instance).
rlm@1 30 */
rlm@1 31 static int luaB_print (lua_State *L) {
rlm@1 32 int n = lua_gettop(L); /* number of arguments */
rlm@1 33 int i;
rlm@1 34 lua_getglobal(L, "tostring");
rlm@1 35 for (i=1; i<=n; i++) {
rlm@1 36 const char *s;
rlm@1 37 lua_pushvalue(L, -1); /* function to be called */
rlm@1 38 lua_pushvalue(L, i); /* value to print */
rlm@1 39 lua_call(L, 1, 1);
rlm@1 40 s = lua_tostring(L, -1); /* get result */
rlm@1 41 if (s == NULL)
rlm@1 42 return luaL_error(L, LUA_QL("tostring") " must return a string to "
rlm@1 43 LUA_QL("print"));
rlm@1 44 if (i>1) fputs("\t", stdout);
rlm@1 45 fputs(s, stdout);
rlm@1 46 lua_pop(L, 1); /* pop result */
rlm@1 47 }
rlm@1 48 fputs("\n", stdout);
rlm@1 49 return 0;
rlm@1 50 }
rlm@1 51
rlm@1 52
rlm@1 53 static int luaB_tonumber (lua_State *L) {
rlm@1 54 int base = luaL_optint(L, 2, 10);
rlm@1 55 if (base == 10) { /* standard conversion */
rlm@1 56 luaL_checkany(L, 1);
rlm@1 57 if (lua_isnumber(L, 1)) {
rlm@1 58 lua_pushnumber(L, lua_tonumber(L, 1));
rlm@1 59 return 1;
rlm@1 60 }
rlm@1 61 }
rlm@1 62 else {
rlm@1 63 const char *s1 = luaL_checkstring(L, 1);
rlm@1 64 char *s2;
rlm@1 65 unsigned long n;
rlm@1 66 luaL_argcheck(L, 2 <= base && base <= 36, 2, "base out of range");
rlm@1 67 n = strtoul(s1, &s2, base);
rlm@1 68 if (s1 != s2) { /* at least one valid digit? */
rlm@1 69 while (isspace((unsigned char)(*s2))) s2++; /* skip trailing spaces */
rlm@1 70 if (*s2 == '\0') { /* no invalid trailing characters? */
rlm@1 71 lua_pushnumber(L, (lua_Number)n);
rlm@1 72 return 1;
rlm@1 73 }
rlm@1 74 }
rlm@1 75 }
rlm@1 76 lua_pushnil(L); /* else not a number */
rlm@1 77 return 1;
rlm@1 78 }
rlm@1 79
rlm@1 80
rlm@1 81 static int luaB_error (lua_State *L) {
rlm@1 82 int level = luaL_optint(L, 2, 1);
rlm@1 83 lua_settop(L, 1);
rlm@1 84 if (lua_isstring(L, 1) && level > 0) { /* add extra information? */
rlm@1 85 luaL_where(L, level);
rlm@1 86 lua_pushvalue(L, 1);
rlm@1 87 lua_concat(L, 2);
rlm@1 88 }
rlm@1 89 return lua_error(L);
rlm@1 90 }
rlm@1 91
rlm@1 92
rlm@1 93 static int luaB_getmetatable (lua_State *L) {
rlm@1 94 luaL_checkany(L, 1);
rlm@1 95 if (!lua_getmetatable(L, 1)) {
rlm@1 96 lua_pushnil(L);
rlm@1 97 return 1; /* no metatable */
rlm@1 98 }
rlm@1 99 luaL_getmetafield(L, 1, "__metatable");
rlm@1 100 return 1; /* returns either __metatable field (if present) or metatable */
rlm@1 101 }
rlm@1 102
rlm@1 103
rlm@1 104 static int luaB_setmetatable (lua_State *L) {
rlm@1 105 int t = lua_type(L, 2);
rlm@1 106 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 107 luaL_argcheck(L, t == LUA_TNIL || t == LUA_TTABLE, 2,
rlm@1 108 "nil or table expected");
rlm@1 109 if (luaL_getmetafield(L, 1, "__metatable"))
rlm@1 110 luaL_error(L, "cannot change a protected metatable");
rlm@1 111 lua_settop(L, 2);
rlm@1 112 lua_setmetatable(L, 1);
rlm@1 113 return 1;
rlm@1 114 }
rlm@1 115
rlm@1 116
rlm@1 117 static void getfunc (lua_State *L, int opt) {
rlm@1 118 if (lua_isfunction(L, 1)) lua_pushvalue(L, 1);
rlm@1 119 else {
rlm@1 120 lua_Debug ar;
rlm@1 121 int level = opt ? luaL_optint(L, 1, 1) : luaL_checkint(L, 1);
rlm@1 122 luaL_argcheck(L, level >= 0, 1, "level must be non-negative");
rlm@1 123 if (lua_getstack(L, level, &ar) == 0)
rlm@1 124 luaL_argerror(L, 1, "invalid level");
rlm@1 125 lua_getinfo(L, "f", &ar);
rlm@1 126 if (lua_isnil(L, -1))
rlm@1 127 luaL_error(L, "no function environment for tail call at level %d",
rlm@1 128 level);
rlm@1 129 }
rlm@1 130 }
rlm@1 131
rlm@1 132
rlm@1 133 static int luaB_getfenv (lua_State *L) {
rlm@1 134 getfunc(L, 1);
rlm@1 135 if (lua_iscfunction(L, -1)) /* is a C function? */
rlm@1 136 lua_pushvalue(L, LUA_GLOBALSINDEX); /* return the thread's global env. */
rlm@1 137 else
rlm@1 138 lua_getfenv(L, -1);
rlm@1 139 return 1;
rlm@1 140 }
rlm@1 141
rlm@1 142
rlm@1 143 static int luaB_setfenv (lua_State *L) {
rlm@1 144 luaL_checktype(L, 2, LUA_TTABLE);
rlm@1 145 getfunc(L, 0);
rlm@1 146 lua_pushvalue(L, 2);
rlm@1 147 if (lua_isnumber(L, 1) && lua_tonumber(L, 1) == 0) {
rlm@1 148 /* change environment of current thread */
rlm@1 149 lua_pushthread(L);
rlm@1 150 lua_insert(L, -2);
rlm@1 151 lua_setfenv(L, -2);
rlm@1 152 return 0;
rlm@1 153 }
rlm@1 154 else if (lua_iscfunction(L, -2) || lua_setfenv(L, -2) == 0)
rlm@1 155 luaL_error(L,
rlm@1 156 LUA_QL("setfenv") " cannot change environment of given object");
rlm@1 157 return 1;
rlm@1 158 }
rlm@1 159
rlm@1 160
rlm@1 161 static int luaB_rawequal (lua_State *L) {
rlm@1 162 luaL_checkany(L, 1);
rlm@1 163 luaL_checkany(L, 2);
rlm@1 164 lua_pushboolean(L, lua_rawequal(L, 1, 2));
rlm@1 165 return 1;
rlm@1 166 }
rlm@1 167
rlm@1 168
rlm@1 169 static int luaB_rawget (lua_State *L) {
rlm@1 170 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 171 luaL_checkany(L, 2);
rlm@1 172 lua_settop(L, 2);
rlm@1 173 lua_rawget(L, 1);
rlm@1 174 return 1;
rlm@1 175 }
rlm@1 176
rlm@1 177 static int luaB_rawset (lua_State *L) {
rlm@1 178 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 179 luaL_checkany(L, 2);
rlm@1 180 luaL_checkany(L, 3);
rlm@1 181 lua_settop(L, 3);
rlm@1 182 lua_rawset(L, 1);
rlm@1 183 return 1;
rlm@1 184 }
rlm@1 185
rlm@1 186
rlm@1 187 static int luaB_gcinfo (lua_State *L) {
rlm@1 188 lua_pushinteger(L, lua_getgccount(L));
rlm@1 189 return 1;
rlm@1 190 }
rlm@1 191
rlm@1 192
rlm@1 193 static int luaB_collectgarbage (lua_State *L) {
rlm@1 194 static const char *const opts[] = {"stop", "restart", "collect",
rlm@1 195 "count", "step", "setpause", "setstepmul", NULL};
rlm@1 196 static const int optsnum[] = {LUA_GCSTOP, LUA_GCRESTART, LUA_GCCOLLECT,
rlm@1 197 LUA_GCCOUNT, LUA_GCSTEP, LUA_GCSETPAUSE, LUA_GCSETSTEPMUL};
rlm@1 198 int o = luaL_checkoption(L, 1, "collect", opts);
rlm@1 199 int ex = luaL_optint(L, 2, 0);
rlm@1 200 int res = lua_gc(L, optsnum[o], ex);
rlm@1 201 switch (optsnum[o]) {
rlm@1 202 case LUA_GCCOUNT: {
rlm@1 203 int b = lua_gc(L, LUA_GCCOUNTB, 0);
rlm@1 204 lua_pushnumber(L, res + ((lua_Number)b/1024));
rlm@1 205 return 1;
rlm@1 206 }
rlm@1 207 case LUA_GCSTEP: {
rlm@1 208 lua_pushboolean(L, res);
rlm@1 209 return 1;
rlm@1 210 }
rlm@1 211 default: {
rlm@1 212 lua_pushnumber(L, res);
rlm@1 213 return 1;
rlm@1 214 }
rlm@1 215 }
rlm@1 216 }
rlm@1 217
rlm@1 218
rlm@1 219 static int luaB_type (lua_State *L) {
rlm@1 220 luaL_checkany(L, 1);
rlm@1 221 lua_pushstring(L, luaL_typename(L, 1));
rlm@1 222 return 1;
rlm@1 223 }
rlm@1 224
rlm@1 225
rlm@1 226 static int luaB_next (lua_State *L) {
rlm@1 227 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 228 lua_settop(L, 2); /* create a 2nd argument if there isn't one */
rlm@1 229 if (lua_next(L, 1))
rlm@1 230 return 2;
rlm@1 231 else {
rlm@1 232 lua_pushnil(L);
rlm@1 233 return 1;
rlm@1 234 }
rlm@1 235 }
rlm@1 236
rlm@1 237
rlm@1 238 static int luaB_pairs (lua_State *L) {
rlm@1 239 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 240 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
rlm@1 241 lua_pushvalue(L, 1); /* state, */
rlm@1 242 lua_pushnil(L); /* and initial value */
rlm@1 243 return 3;
rlm@1 244 }
rlm@1 245
rlm@1 246
rlm@1 247 static int ipairsaux (lua_State *L) {
rlm@1 248 int i = luaL_checkint(L, 2);
rlm@1 249 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 250 i++; /* next value */
rlm@1 251 lua_pushinteger(L, i);
rlm@1 252 lua_rawgeti(L, 1, i);
rlm@1 253 return (lua_isnil(L, -1)) ? 0 : 2;
rlm@1 254 }
rlm@1 255
rlm@1 256
rlm@1 257 static int luaB_ipairs (lua_State *L) {
rlm@1 258 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 259 lua_pushvalue(L, lua_upvalueindex(1)); /* return generator, */
rlm@1 260 lua_pushvalue(L, 1); /* state, */
rlm@1 261 lua_pushinteger(L, 0); /* and initial value */
rlm@1 262 return 3;
rlm@1 263 }
rlm@1 264
rlm@1 265
rlm@1 266 static int load_aux (lua_State *L, int status) {
rlm@1 267 if (status == 0) /* OK? */
rlm@1 268 return 1;
rlm@1 269 else {
rlm@1 270 lua_pushnil(L);
rlm@1 271 lua_insert(L, -2); /* put before error message */
rlm@1 272 return 2; /* return nil plus error message */
rlm@1 273 }
rlm@1 274 }
rlm@1 275
rlm@1 276
rlm@1 277 static int luaB_loadstring (lua_State *L) {
rlm@1 278 size_t l;
rlm@1 279 const char *s = luaL_checklstring(L, 1, &l);
rlm@1 280 const char *chunkname = luaL_optstring(L, 2, s);
rlm@1 281 return load_aux(L, luaL_loadbuffer(L, s, l, chunkname));
rlm@1 282 }
rlm@1 283
rlm@1 284
rlm@1 285 static int luaB_loadfile (lua_State *L) {
rlm@1 286 const char *fname = luaL_optstring(L, 1, NULL);
rlm@1 287 return load_aux(L, luaL_loadfile(L, fname));
rlm@1 288 }
rlm@1 289
rlm@1 290
rlm@1 291 /*
rlm@1 292 ** Reader for generic `load' function: `lua_load' uses the
rlm@1 293 ** stack for internal stuff, so the reader cannot change the
rlm@1 294 ** stack top. Instead, it keeps its resulting string in a
rlm@1 295 ** reserved slot inside the stack.
rlm@1 296 */
rlm@1 297 static const char *generic_reader (lua_State *L, void *ud, size_t *size) {
rlm@1 298 (void)ud; /* to avoid warnings */
rlm@1 299 luaL_checkstack(L, 2, "too many nested functions");
rlm@1 300 lua_pushvalue(L, 1); /* get function */
rlm@1 301 lua_call(L, 0, 1); /* call it */
rlm@1 302 if (lua_isnil(L, -1)) {
rlm@1 303 *size = 0;
rlm@1 304 return NULL;
rlm@1 305 }
rlm@1 306 else if (lua_isstring(L, -1)) {
rlm@1 307 lua_replace(L, 3); /* save string in a reserved stack slot */
rlm@1 308 return lua_tolstring(L, 3, size);
rlm@1 309 }
rlm@1 310 else luaL_error(L, "reader function must return a string");
rlm@1 311 return NULL; /* to avoid warnings */
rlm@1 312 }
rlm@1 313
rlm@1 314
rlm@1 315 static int luaB_load (lua_State *L) {
rlm@1 316 int status;
rlm@1 317 const char *cname = luaL_optstring(L, 2, "=(load)");
rlm@1 318 luaL_checktype(L, 1, LUA_TFUNCTION);
rlm@1 319 lua_settop(L, 3); /* function, eventual name, plus one reserved slot */
rlm@1 320 status = lua_load(L, generic_reader, NULL, cname);
rlm@1 321 return load_aux(L, status);
rlm@1 322 }
rlm@1 323
rlm@1 324
rlm@1 325 static int luaB_dofile (lua_State *L) {
rlm@1 326 const char *fname = luaL_optstring(L, 1, NULL);
rlm@1 327 int n = lua_gettop(L);
rlm@1 328 if (luaL_loadfile(L, fname) != 0) lua_error(L);
rlm@1 329 lua_call(L, 0, LUA_MULTRET);
rlm@1 330 return lua_gettop(L) - n;
rlm@1 331 }
rlm@1 332
rlm@1 333
rlm@1 334 static int luaB_assert (lua_State *L) {
rlm@1 335 luaL_checkany(L, 1);
rlm@1 336 if (!lua_toboolean(L, 1))
rlm@1 337 return luaL_error(L, "%s", luaL_optstring(L, 2, "assertion failed!"));
rlm@1 338 return lua_gettop(L);
rlm@1 339 }
rlm@1 340
rlm@1 341
rlm@1 342 static int luaB_unpack (lua_State *L) {
rlm@1 343 int i, e, n;
rlm@1 344 luaL_checktype(L, 1, LUA_TTABLE);
rlm@1 345 i = luaL_optint(L, 2, 1);
rlm@1 346 e = luaL_opt(L, luaL_checkint, 3, luaL_getn(L, 1));
rlm@1 347 if (i > e) return 0; /* empty range */
rlm@1 348 n = e - i + 1; /* number of elements */
rlm@1 349 if (n <= 0 || !lua_checkstack(L, n)) /* n <= 0 means arith. overflow */
rlm@1 350 return luaL_error(L, "too many results to unpack");
rlm@1 351 lua_rawgeti(L, 1, i); /* push arg[i] (avoiding overflow problems) */
rlm@1 352 while (i++ < e) /* push arg[i + 1...e] */
rlm@1 353 lua_rawgeti(L, 1, i);
rlm@1 354 return n;
rlm@1 355 }
rlm@1 356
rlm@1 357
rlm@1 358 static int luaB_select (lua_State *L) {
rlm@1 359 int n = lua_gettop(L);
rlm@1 360 if (lua_type(L, 1) == LUA_TSTRING && *lua_tostring(L, 1) == '#') {
rlm@1 361 lua_pushinteger(L, n-1);
rlm@1 362 return 1;
rlm@1 363 }
rlm@1 364 else {
rlm@1 365 int i = luaL_checkint(L, 1);
rlm@1 366 if (i < 0) i = n + i;
rlm@1 367 else if (i > n) i = n;
rlm@1 368 luaL_argcheck(L, 1 <= i, 1, "index out of range");
rlm@1 369 return n - i;
rlm@1 370 }
rlm@1 371 }
rlm@1 372
rlm@1 373
rlm@1 374 static int luaB_pcall (lua_State *L) {
rlm@1 375 int status;
rlm@1 376 luaL_checkany(L, 1);
rlm@1 377 status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
rlm@1 378 lua_pushboolean(L, (status == 0));
rlm@1 379 lua_insert(L, 1);
rlm@1 380 return lua_gettop(L); /* return status + all results */
rlm@1 381 }
rlm@1 382
rlm@1 383
rlm@1 384 static int luaB_xpcall (lua_State *L) {
rlm@1 385 int status;
rlm@1 386 luaL_checkany(L, 2);
rlm@1 387 lua_settop(L, 2);
rlm@1 388 lua_insert(L, 1); /* put error function under function to be called */
rlm@1 389 status = lua_pcall(L, 0, LUA_MULTRET, 1);
rlm@1 390 lua_pushboolean(L, (status == 0));
rlm@1 391 lua_replace(L, 1);
rlm@1 392 return lua_gettop(L); /* return status + all results */
rlm@1 393 }
rlm@1 394
rlm@1 395
rlm@1 396 static int luaB_tostring (lua_State *L) {
rlm@1 397 luaL_checkany(L, 1);
rlm@1 398 if (luaL_callmeta(L, 1, "__tostring")) /* is there a metafield? */
rlm@1 399 return 1; /* use its value */
rlm@1 400 switch (lua_type(L, 1)) {
rlm@1 401 case LUA_TNUMBER:
rlm@1 402 lua_pushstring(L, lua_tostring(L, 1));
rlm@1 403 break;
rlm@1 404 case LUA_TSTRING:
rlm@1 405 lua_pushvalue(L, 1);
rlm@1 406 break;
rlm@1 407 case LUA_TBOOLEAN:
rlm@1 408 lua_pushstring(L, (lua_toboolean(L, 1) ? "true" : "false"));
rlm@1 409 break;
rlm@1 410 case LUA_TNIL:
rlm@1 411 lua_pushliteral(L, "nil");
rlm@1 412 break;
rlm@1 413 default:
rlm@1 414 lua_pushfstring(L, "%s: %p", luaL_typename(L, 1), lua_topointer(L, 1));
rlm@1 415 break;
rlm@1 416 }
rlm@1 417 return 1;
rlm@1 418 }
rlm@1 419
rlm@1 420
rlm@1 421 static int luaB_newproxy (lua_State *L) {
rlm@1 422 lua_settop(L, 1);
rlm@1 423 lua_newuserdata(L, 0); /* create proxy */
rlm@1 424 if (lua_toboolean(L, 1) == 0)
rlm@1 425 return 1; /* no metatable */
rlm@1 426 else if (lua_isboolean(L, 1)) {
rlm@1 427 lua_newtable(L); /* create a new metatable `m' ... */
rlm@1 428 lua_pushvalue(L, -1); /* ... and mark `m' as a valid metatable */
rlm@1 429 lua_pushboolean(L, 1);
rlm@1 430 lua_rawset(L, lua_upvalueindex(1)); /* weaktable[m] = true */
rlm@1 431 }
rlm@1 432 else {
rlm@1 433 int validproxy = 0; /* to check if weaktable[metatable(u)] == true */
rlm@1 434 if (lua_getmetatable(L, 1)) {
rlm@1 435 lua_rawget(L, lua_upvalueindex(1));
rlm@1 436 validproxy = lua_toboolean(L, -1);
rlm@1 437 lua_pop(L, 1); /* remove value */
rlm@1 438 }
rlm@1 439 luaL_argcheck(L, validproxy, 1, "boolean or proxy expected");
rlm@1 440 lua_getmetatable(L, 1); /* metatable is valid; get it */
rlm@1 441 }
rlm@1 442 lua_setmetatable(L, 2);
rlm@1 443 return 1;
rlm@1 444 }
rlm@1 445
rlm@1 446
rlm@1 447 static const luaL_Reg base_funcs[] = {
rlm@1 448 {"assert", luaB_assert},
rlm@1 449 {"collectgarbage", luaB_collectgarbage},
rlm@1 450 {"dofile", luaB_dofile},
rlm@1 451 {"error", luaB_error},
rlm@1 452 {"gcinfo", luaB_gcinfo},
rlm@1 453 {"getfenv", luaB_getfenv},
rlm@1 454 {"getmetatable", luaB_getmetatable},
rlm@1 455 {"loadfile", luaB_loadfile},
rlm@1 456 {"load", luaB_load},
rlm@1 457 {"loadstring", luaB_loadstring},
rlm@1 458 {"next", luaB_next},
rlm@1 459 {"pcall", luaB_pcall},
rlm@1 460 {"print", luaB_print},
rlm@1 461 {"rawequal", luaB_rawequal},
rlm@1 462 {"rawget", luaB_rawget},
rlm@1 463 {"rawset", luaB_rawset},
rlm@1 464 {"select", luaB_select},
rlm@1 465 {"setfenv", luaB_setfenv},
rlm@1 466 {"setmetatable", luaB_setmetatable},
rlm@1 467 {"tonumber", luaB_tonumber},
rlm@1 468 {"tostring", luaB_tostring},
rlm@1 469 {"type", luaB_type},
rlm@1 470 {"unpack", luaB_unpack},
rlm@1 471 {"xpcall", luaB_xpcall},
rlm@1 472 {NULL, NULL}
rlm@1 473 };
rlm@1 474
rlm@1 475
rlm@1 476 /*
rlm@1 477 ** {======================================================
rlm@1 478 ** Coroutine library
rlm@1 479 ** =======================================================
rlm@1 480 */
rlm@1 481
rlm@1 482 #define CO_RUN 0 /* running */
rlm@1 483 #define CO_SUS 1 /* suspended */
rlm@1 484 #define CO_NOR 2 /* 'normal' (it resumed another coroutine) */
rlm@1 485 #define CO_DEAD 3
rlm@1 486
rlm@1 487 static const char *const statnames[] =
rlm@1 488 {"running", "suspended", "normal", "dead"};
rlm@1 489
rlm@1 490 static int costatus (lua_State *L, lua_State *co) {
rlm@1 491 if (L == co) return CO_RUN;
rlm@1 492 switch (lua_status(co)) {
rlm@1 493 case LUA_YIELD:
rlm@1 494 return CO_SUS;
rlm@1 495 case 0: {
rlm@1 496 lua_Debug ar;
rlm@1 497 if (lua_getstack(co, 0, &ar) > 0) /* does it have frames? */
rlm@1 498 return CO_NOR; /* it is running */
rlm@1 499 else if (lua_gettop(co) == 0)
rlm@1 500 return CO_DEAD;
rlm@1 501 else
rlm@1 502 return CO_SUS; /* initial state */
rlm@1 503 }
rlm@1 504 default: /* some error occured */
rlm@1 505 return CO_DEAD;
rlm@1 506 }
rlm@1 507 }
rlm@1 508
rlm@1 509
rlm@1 510 static int luaB_costatus (lua_State *L) {
rlm@1 511 lua_State *co = lua_tothread(L, 1);
rlm@1 512 luaL_argcheck(L, co, 1, "coroutine expected");
rlm@1 513 lua_pushstring(L, statnames[costatus(L, co)]);
rlm@1 514 return 1;
rlm@1 515 }
rlm@1 516
rlm@1 517
rlm@1 518 static int auxresume (lua_State *L, lua_State *co, int narg) {
rlm@1 519 int status = costatus(L, co);
rlm@1 520 if (!lua_checkstack(co, narg))
rlm@1 521 luaL_error(L, "too many arguments to resume");
rlm@1 522 if (status != CO_SUS) {
rlm@1 523 lua_pushfstring(L, "cannot resume %s coroutine", statnames[status]);
rlm@1 524 return -1; /* error flag */
rlm@1 525 }
rlm@1 526 lua_xmove(L, co, narg);
rlm@1 527 lua_setlevel(L, co);
rlm@1 528 status = lua_resume(co, narg);
rlm@1 529 if (status == 0 || status == LUA_YIELD) {
rlm@1 530 int nres = lua_gettop(co);
rlm@1 531 if (!lua_checkstack(L, nres + 1))
rlm@1 532 luaL_error(L, "too many results to resume");
rlm@1 533 lua_xmove(co, L, nres); /* move yielded values */
rlm@1 534 return nres;
rlm@1 535 }
rlm@1 536 else {
rlm@1 537 lua_xmove(co, L, 1); /* move error message */
rlm@1 538 return -1; /* error flag */
rlm@1 539 }
rlm@1 540 }
rlm@1 541
rlm@1 542
rlm@1 543 static int luaB_coresume (lua_State *L) {
rlm@1 544 lua_State *co = lua_tothread(L, 1);
rlm@1 545 int r;
rlm@1 546 luaL_argcheck(L, co, 1, "coroutine expected");
rlm@1 547 r = auxresume(L, co, lua_gettop(L) - 1);
rlm@1 548 if (r < 0) {
rlm@1 549 lua_pushboolean(L, 0);
rlm@1 550 lua_insert(L, -2);
rlm@1 551 return 2; /* return false + error message */
rlm@1 552 }
rlm@1 553 else {
rlm@1 554 lua_pushboolean(L, 1);
rlm@1 555 lua_insert(L, -(r + 1));
rlm@1 556 return r + 1; /* return true + `resume' returns */
rlm@1 557 }
rlm@1 558 }
rlm@1 559
rlm@1 560
rlm@1 561 static int luaB_auxwrap (lua_State *L) {
rlm@1 562 lua_State *co = lua_tothread(L, lua_upvalueindex(1));
rlm@1 563 int r = auxresume(L, co, lua_gettop(L));
rlm@1 564 if (r < 0) {
rlm@1 565 if (lua_isstring(L, -1)) { /* error object is a string? */
rlm@1 566 luaL_where(L, 1); /* add extra info */
rlm@1 567 lua_insert(L, -2);
rlm@1 568 lua_concat(L, 2);
rlm@1 569 }
rlm@1 570 lua_error(L); /* propagate error */
rlm@1 571 }
rlm@1 572 return r;
rlm@1 573 }
rlm@1 574
rlm@1 575
rlm@1 576 static int luaB_cocreate (lua_State *L) {
rlm@1 577 lua_State *NL = lua_newthread(L);
rlm@1 578 luaL_argcheck(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
rlm@1 579 "Lua function expected");
rlm@1 580 lua_pushvalue(L, 1); /* move function to top */
rlm@1 581 lua_xmove(L, NL, 1); /* move function from L to NL */
rlm@1 582 return 1;
rlm@1 583 }
rlm@1 584
rlm@1 585
rlm@1 586 static int luaB_cowrap (lua_State *L) {
rlm@1 587 luaB_cocreate(L);
rlm@1 588 lua_pushcclosure(L, luaB_auxwrap, 1);
rlm@1 589 return 1;
rlm@1 590 }
rlm@1 591
rlm@1 592
rlm@1 593 static int luaB_yield (lua_State *L) {
rlm@1 594 return lua_yield(L, lua_gettop(L));
rlm@1 595 }
rlm@1 596
rlm@1 597
rlm@1 598 static int luaB_corunning (lua_State *L) {
rlm@1 599 if (lua_pushthread(L))
rlm@1 600 lua_pushnil(L); /* main thread is not a coroutine */
rlm@1 601 return 1;
rlm@1 602 }
rlm@1 603
rlm@1 604
rlm@1 605 static const luaL_Reg co_funcs[] = {
rlm@1 606 {"create", luaB_cocreate},
rlm@1 607 {"resume", luaB_coresume},
rlm@1 608 {"running", luaB_corunning},
rlm@1 609 {"status", luaB_costatus},
rlm@1 610 {"wrap", luaB_cowrap},
rlm@1 611 {"yield", luaB_yield},
rlm@1 612 {NULL, NULL}
rlm@1 613 };
rlm@1 614
rlm@1 615 /* }====================================================== */
rlm@1 616
rlm@1 617
rlm@1 618 static void auxopen (lua_State *L, const char *name,
rlm@1 619 lua_CFunction f, lua_CFunction u) {
rlm@1 620 lua_pushcfunction(L, u);
rlm@1 621 lua_pushcclosure(L, f, 1);
rlm@1 622 lua_setfield(L, -2, name);
rlm@1 623 }
rlm@1 624
rlm@1 625
rlm@1 626 static void base_open (lua_State *L) {
rlm@1 627 /* set global _G */
rlm@1 628 lua_pushvalue(L, LUA_GLOBALSINDEX);
rlm@1 629 lua_setglobal(L, "_G");
rlm@1 630 /* open lib into global table */
rlm@1 631 luaL_register(L, "_G", base_funcs);
rlm@1 632 lua_pushliteral(L, LUA_VERSION);
rlm@1 633 lua_setglobal(L, "_VERSION"); /* set global _VERSION */
rlm@1 634 /* `ipairs' and `pairs' need auxliliary functions as upvalues */
rlm@1 635 auxopen(L, "ipairs", luaB_ipairs, ipairsaux);
rlm@1 636 auxopen(L, "pairs", luaB_pairs, luaB_next);
rlm@1 637 /* `newproxy' needs a weaktable as upvalue */
rlm@1 638 lua_createtable(L, 0, 1); /* new table `w' */
rlm@1 639 lua_pushvalue(L, -1); /* `w' will be its own metatable */
rlm@1 640 lua_setmetatable(L, -2);
rlm@1 641 lua_pushliteral(L, "kv");
rlm@1 642 lua_setfield(L, -2, "__mode"); /* metatable(w).__mode = "kv" */
rlm@1 643 lua_pushcclosure(L, luaB_newproxy, 1);
rlm@1 644 lua_setglobal(L, "newproxy"); /* set global `newproxy' */
rlm@1 645 }
rlm@1 646
rlm@1 647
rlm@1 648 LUALIB_API int luaopen_base (lua_State *L) {
rlm@1 649 base_open(L);
rlm@1 650 luaL_register(L, LUA_COLIBNAME, co_funcs);
rlm@1 651 return 2;
rlm@1 652 }
rlm@1 653