Mercurial > vba-clojure

annotate src/lua/lbaselib.c @ 613:e1dcad3ce967

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
misc. fixes.
author Robert McIntyre <rlm@mit.edu>
date Thu, 22 Nov 2012 11:36:07 -0600
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