1 /* $NetBSD: lobject.c,v 1.4 2015/02/02 14:03:05 lneto Exp $ */ 2 3 /* 4 ** Id: lobject.c,v 2.101 2014/12/26 14:43:45 roberto Exp 5 ** Some generic functions over Lua objects 6 ** See Copyright Notice in lua.h 7 */ 8 9 #define lobject_c 10 #define LUA_CORE 11 12 #include "lprefix.h" 13 14 15 #ifndef _KERNEL 16 #include <stdarg.h> 17 #include <stdio.h> 18 #include <stdlib.h> 19 #include <string.h> 20 #endif 21 22 #include "lua.h" 23 24 #include "lctype.h" 25 #include "ldebug.h" 26 #include "ldo.h" 27 #include "lmem.h" 28 #include "lobject.h" 29 #include "lstate.h" 30 #include "lstring.h" 31 #include "lvm.h" 32 33 34 35 LUAI_DDEF const TValue luaO_nilobject_ = {NILCONSTANT}; 36 37 38 /* 39 ** converts an integer to a "floating point byte", represented as 40 ** (eeeeexxx), where the real value is (1xxx) * 2^(eeeee - 1) if 41 ** eeeee != 0 and (xxx) otherwise. 42 */ 43 int luaO_int2fb (unsigned int x) { 44 int e = 0; /* exponent */ 45 if (x < 8) return x; 46 while (x >= 0x10) { 47 x = (x+1) >> 1; 48 e++; 49 } 50 return ((e+1) << 3) | (cast_int(x) - 8); 51 } 52 53 54 /* converts back */ 55 int luaO_fb2int (int x) { 56 int e = (x >> 3) & 0x1f; 57 if (e == 0) return x; 58 else return ((x & 7) + 8) << (e - 1); 59 } 60 61 62 int luaO_ceillog2 (unsigned int x) { 63 static const lu_byte log_2[256] = { 64 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5, 65 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6, 66 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 67 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 68 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 69 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 70 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8, 71 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8 72 }; 73 int l = 0; 74 x--; 75 while (x >= 256) { l += 8; x >>= 8; } 76 return l + log_2[x]; 77 } 78 79 80 static lua_Integer intarith (lua_State *L, int op, lua_Integer v1, 81 lua_Integer v2) { 82 switch (op) { 83 case LUA_OPADD: return intop(+, v1, v2); 84 case LUA_OPSUB:return intop(-, v1, v2); 85 case LUA_OPMUL:return intop(*, v1, v2); 86 case LUA_OPMOD: return luaV_mod(L, v1, v2); 87 case LUA_OPIDIV: return luaV_div(L, v1, v2); 88 case LUA_OPBAND: return intop(&, v1, v2); 89 case LUA_OPBOR: return intop(|, v1, v2); 90 case LUA_OPBXOR: return intop(^, v1, v2); 91 case LUA_OPSHL: return luaV_shiftl(v1, v2); 92 case LUA_OPSHR: return luaV_shiftl(v1, -v2); 93 case LUA_OPUNM: return intop(-, 0, v1); 94 case LUA_OPBNOT: return intop(^, ~l_castS2U(0), v1); 95 default: lua_assert(0); return 0; 96 } 97 } 98 99 100 #ifndef _KERNEL 101 static lua_Number numarith (lua_State *L, int op, lua_Number v1, 102 lua_Number v2) { 103 switch (op) { 104 case LUA_OPADD: return luai_numadd(L, v1, v2); 105 case LUA_OPSUB: return luai_numsub(L, v1, v2); 106 case LUA_OPMUL: return luai_nummul(L, v1, v2); 107 case LUA_OPDIV: return luai_numdiv(L, v1, v2); 108 case LUA_OPPOW: return luai_numpow(L, v1, v2); 109 case LUA_OPIDIV: return luai_numidiv(L, v1, v2); 110 case LUA_OPUNM: return luai_numunm(L, v1); 111 case LUA_OPMOD: { 112 lua_Number m; 113 luai_nummod(L, v1, v2, m); 114 return m; 115 } 116 default: lua_assert(0); return 0; 117 } 118 } 119 #endif 120 121 122 void luaO_arith (lua_State *L, int op, const TValue *p1, const TValue *p2, 123 TValue *res) { 124 switch (op) { 125 case LUA_OPBAND: case LUA_OPBOR: case LUA_OPBXOR: 126 case LUA_OPSHL: case LUA_OPSHR: 127 case LUA_OPBNOT: { /* operate only on integers */ 128 lua_Integer i1; lua_Integer i2; 129 if (tointeger(p1, &i1) && tointeger(p2, &i2)) { 130 setivalue(res, intarith(L, op, i1, i2)); 131 return; 132 } 133 else break; /* go to the end */ 134 } 135 #ifndef _KERNEL 136 case LUA_OPDIV: case LUA_OPPOW: { /* operate only on floats */ 137 lua_Number n1; lua_Number n2; 138 if (tonumber(p1, &n1) && tonumber(p2, &n2)) { 139 setfltvalue(res, numarith(L, op, n1, n2)); 140 return; 141 } 142 else break; /* go to the end */ 143 } 144 #endif 145 default: { /* other operations */ 146 #ifndef _KERNEL 147 lua_Number n1; lua_Number n2; 148 if (ttisinteger(p1) && ttisinteger(p2)) { 149 setivalue(res, intarith(L, op, ivalue(p1), ivalue(p2))); 150 return; 151 } 152 else if (tonumber(p1, &n1) && tonumber(p2, &n2)) { 153 setfltvalue(res, numarith(L, op, n1, n2)); 154 return; 155 } 156 #else /* _KERNEL */ 157 lua_Integer i1; lua_Integer i2; 158 if (tointeger(p1, &i1) && tointeger(p2, &i2)) { 159 setivalue(res, intarith(L, op, i1, i2)); 160 return; 161 } 162 #endif 163 else break; /* go to the end */ 164 } 165 } 166 /* could not perform raw operation; try metamethod */ 167 lua_assert(L != NULL); /* should not fail when folding (compile time) */ 168 luaT_trybinTM(L, p1, p2, res, cast(TMS, op - LUA_OPADD + TM_ADD)); 169 } 170 171 172 int luaO_hexavalue (int c) { 173 if (lisdigit(c)) return c - '0'; 174 else return ltolower(c) - 'a' + 10; 175 } 176 177 178 static int isneg (const char **s) { 179 if (**s == '-') { (*s)++; return 1; } 180 else if (**s == '+') (*s)++; 181 return 0; 182 } 183 184 185 186 #ifndef _KERNEL 187 /* 188 ** {================================================================== 189 ** Lua's implementation for 'lua_strx2number' 190 ** =================================================================== 191 */ 192 #if !defined(lua_strx2number) 193 194 #include <math.h> 195 196 /* maximum number of significant digits to read (to avoid overflows 197 even with single floats) */ 198 #define MAXSIGDIG 30 199 200 /* 201 ** convert an hexadecimal numeric string to a number, following 202 ** C99 specification for 'strtod' 203 */ 204 static lua_Number lua_strx2number (const char *s, char **endptr) { 205 lua_Number r = 0.0; /* result (accumulator) */ 206 int sigdig = 0; /* number of significant digits */ 207 int nosigdig = 0; /* number of non-significant digits */ 208 int e = 0; /* exponent correction */ 209 int neg; /* 1 if number is negative */ 210 int dot = 0; /* true after seen a dot */ 211 *endptr = cast(char *, s); /* nothing is valid yet */ 212 while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */ 213 neg = isneg(&s); /* check signal */ 214 if (!(*s == '0' && (*(s + 1) == 'x' || *(s + 1) == 'X'))) /* check '0x' */ 215 return 0.0; /* invalid format (no '0x') */ 216 for (s += 2; ; s++) { /* skip '0x' and read numeral */ 217 if (*s == '.') { 218 if (dot) break; /* second dot? stop loop */ 219 else dot = 1; 220 } 221 else if (lisxdigit(cast_uchar(*s))) { 222 if (sigdig == 0 && *s == '0') /* non-significant digit (zero)? */ 223 nosigdig++; 224 else if (++sigdig <= MAXSIGDIG) /* can read it without overflow? */ 225 r = (r * cast_num(16.0)) + luaO_hexavalue(*s); 226 else e++; /* too many digits; ignore, but still count for exponent */ 227 if (dot) e--; /* decimal digit? correct exponent */ 228 } 229 else break; /* neither a dot nor a digit */ 230 } 231 if (nosigdig + sigdig == 0) /* no digits? */ 232 return 0.0; /* invalid format */ 233 *endptr = cast(char *, s); /* valid up to here */ 234 e *= 4; /* each digit multiplies/divides value by 2^4 */ 235 if (*s == 'p' || *s == 'P') { /* exponent part? */ 236 int exp1 = 0; /* exponent value */ 237 int neg1; /* exponent signal */ 238 s++; /* skip 'p' */ 239 neg1 = isneg(&s); /* signal */ 240 if (!lisdigit(cast_uchar(*s))) 241 return 0.0; /* invalid; must have at least one digit */ 242 while (lisdigit(cast_uchar(*s))) /* read exponent */ 243 exp1 = exp1 * 10 + *(s++) - '0'; 244 if (neg1) exp1 = -exp1; 245 e += exp1; 246 *endptr = cast(char *, s); /* valid up to here */ 247 } 248 if (neg) r = -r; 249 return l_mathop(ldexp)(r, e); 250 } 251 252 #endif 253 /* }====================================================== */ 254 255 256 static const char *l_str2d (const char *s, lua_Number *result) { 257 char *endptr; 258 if (strpbrk(s, "nN")) /* reject 'inf' and 'nan' */ 259 return NULL; 260 else if (strpbrk(s, "xX")) /* hex? */ 261 *result = lua_strx2number(s, &endptr); 262 else 263 *result = lua_str2number(s, &endptr); 264 if (endptr == s) return 0; /* nothing recognized */ 265 while (lisspace(cast_uchar(*endptr))) endptr++; 266 return (*endptr == '\0' ? endptr : NULL); /* OK if no trailing characters */ 267 } 268 #endif /* _KERNEL */ 269 270 271 static const char *l_str2int (const char *s, lua_Integer *result) { 272 lua_Unsigned a = 0; 273 int empty = 1; 274 int neg; 275 while (lisspace(cast_uchar(*s))) s++; /* skip initial spaces */ 276 neg = isneg(&s); 277 if (s[0] == '0' && 278 (s[1] == 'x' || s[1] == 'X')) { /* hex? */ 279 s += 2; /* skip '0x' */ 280 for (; lisxdigit(cast_uchar(*s)); s++) { 281 a = a * 16 + luaO_hexavalue(*s); 282 empty = 0; 283 } 284 } 285 else { /* decimal */ 286 for (; lisdigit(cast_uchar(*s)); s++) { 287 a = a * 10 + *s - '0'; 288 empty = 0; 289 } 290 } 291 while (lisspace(cast_uchar(*s))) s++; /* skip trailing spaces */ 292 if (empty || *s != '\0') return NULL; /* something wrong in the numeral */ 293 else { 294 *result = l_castU2S((neg) ? 0u - a : a); 295 return s; 296 } 297 } 298 299 300 size_t luaO_str2num (const char *s, TValue *o) { 301 #ifndef _KERNEL 302 lua_Integer i; lua_Number n; 303 #else /* _KERNEL */ 304 lua_Integer i; 305 #endif 306 const char *e; 307 if ((e = l_str2int(s, &i)) != NULL) { /* try as an integer */ 308 setivalue(o, i); 309 } 310 #ifndef _KERNEL 311 else if ((e = l_str2d(s, &n)) != NULL) { /* else try as a float */ 312 setfltvalue(o, n); 313 } 314 #endif 315 else 316 return 0; /* conversion failed */ 317 return (e - s + 1); /* success; return string size */ 318 } 319 320 321 int luaO_utf8esc (char *buff, unsigned long x) { 322 int n = 1; /* number of bytes put in buffer (backwards) */ 323 lua_assert(x <= 0x10FFFF); 324 if (x < 0x80) /* ascii? */ 325 buff[UTF8BUFFSZ - 1] = cast(char, x); 326 else { /* need continuation bytes */ 327 unsigned int mfb = 0x3f; /* maximum that fits in first byte */ 328 do { /* add continuation bytes */ 329 buff[UTF8BUFFSZ - (n++)] = cast(char, 0x80 | (x & 0x3f)); 330 x >>= 6; /* remove added bits */ 331 mfb >>= 1; /* now there is one less bit available in first byte */ 332 } while (x > mfb); /* still needs continuation byte? */ 333 buff[UTF8BUFFSZ - n] = cast(char, (~mfb << 1) | x); /* add first byte */ 334 } 335 return n; 336 } 337 338 339 /* maximum length of the conversion of a number to a string */ 340 #define MAXNUMBER2STR 50 341 342 343 /* 344 ** Convert a number object to a string 345 */ 346 void luaO_tostring (lua_State *L, StkId obj) { 347 char buff[MAXNUMBER2STR]; 348 size_t len; 349 lua_assert(ttisnumber(obj)); 350 #ifndef _KERNEL 351 if (ttisinteger(obj)) 352 len = lua_integer2str(buff, ivalue(obj)); 353 else { 354 len = lua_number2str(buff, fltvalue(obj)); 355 #if !defined(LUA_COMPAT_FLOATSTRING) 356 if (buff[strspn(buff, "-0123456789")] == '\0') { /* looks like an int? */ 357 buff[len++] = '.'; 358 buff[len++] = '0'; /* adds '.0' to result */ 359 } 360 #endif 361 } 362 #else /* _KERNEL */ 363 lua_assert(ttisinteger(obj)); 364 len = lua_integer2str(buff, ivalue(obj)); 365 #endif 366 setsvalue2s(L, obj, luaS_newlstr(L, buff, len)); 367 } 368 369 370 static void pushstr (lua_State *L, const char *str, size_t l) { 371 setsvalue2s(L, L->top++, luaS_newlstr(L, str, l)); 372 } 373 374 375 /* this function handles only '%d', '%c', '%f', '%p', and '%s' 376 conventional formats, plus Lua-specific '%I' and '%U' */ 377 const char *luaO_pushvfstring (lua_State *L, const char *fmt, va_list argp) { 378 int n = 0; 379 for (;;) { 380 const char *e = strchr(fmt, '%'); 381 if (e == NULL) break; 382 luaD_checkstack(L, 2); /* fmt + item */ 383 pushstr(L, fmt, e - fmt); 384 switch (*(e+1)) { 385 case 's': { 386 const char *s = va_arg(argp, char *); 387 if (s == NULL) s = "(null)"; 388 pushstr(L, s, strlen(s)); 389 break; 390 } 391 case 'c': { 392 char buff = cast(char, va_arg(argp, int)); 393 if (lisprint(cast_uchar(buff))) 394 pushstr(L, &buff, 1); 395 else /* non-printable character; print its code */ 396 luaO_pushfstring(L, "<\\%d>", cast_uchar(buff)); 397 break; 398 } 399 case 'd': { 400 setivalue(L->top++, va_arg(argp, int)); 401 luaO_tostring(L, L->top - 1); 402 break; 403 } 404 case 'I': { 405 setivalue(L->top++, cast(lua_Integer, va_arg(argp, l_uacInt))); 406 luaO_tostring(L, L->top - 1); 407 break; 408 } 409 #ifndef _KERNEL 410 case 'f': { 411 setfltvalue(L->top++, cast_num(va_arg(argp, l_uacNumber))); 412 luaO_tostring(L, L->top - 1); 413 break; 414 } 415 #endif 416 case 'p': { 417 char buff[4*sizeof(void *) + 8]; /* should be enough space for a '%p' */ 418 int l = sprintf(buff, "%p", va_arg(argp, void *)); 419 pushstr(L, buff, l); 420 break; 421 } 422 case 'U': { 423 char buff[UTF8BUFFSZ]; 424 int l = luaO_utf8esc(buff, cast(long, va_arg(argp, long))); 425 pushstr(L, buff + UTF8BUFFSZ - l, l); 426 break; 427 } 428 case '%': { 429 pushstr(L, "%", 1); 430 break; 431 } 432 default: { 433 luaG_runerror(L, "invalid option '%%%c' to 'lua_pushfstring'", 434 *(e + 1)); 435 } 436 } 437 n += 2; 438 fmt = e+2; 439 } 440 luaD_checkstack(L, 1); 441 pushstr(L, fmt, strlen(fmt)); 442 if (n > 0) luaV_concat(L, n + 1); 443 return svalue(L->top - 1); 444 } 445 446 447 const char *luaO_pushfstring (lua_State *L, const char *fmt, ...) { 448 const char *msg; 449 va_list argp; 450 va_start(argp, fmt); 451 msg = luaO_pushvfstring(L, fmt, argp); 452 va_end(argp); 453 return msg; 454 } 455 456 457 /* number of chars of a literal string without the ending \0 */ 458 #define LL(x) (sizeof(x)/sizeof(char) - 1) 459 460 #define RETS "..." 461 #define PRE "[string \"" 462 #define POS "\"]" 463 464 #define addstr(a,b,l) ( memcpy(a,b,(l) * sizeof(char)), a += (l) ) 465 466 void luaO_chunkid (char *out, const char *source, size_t bufflen) { 467 size_t l = strlen(source); 468 if (*source == '=') { /* 'literal' source */ 469 if (l <= bufflen) /* small enough? */ 470 memcpy(out, source + 1, l * sizeof(char)); 471 else { /* truncate it */ 472 addstr(out, source + 1, bufflen - 1); 473 *out = '\0'; 474 } 475 } 476 else if (*source == '@') { /* file name */ 477 if (l <= bufflen) /* small enough? */ 478 memcpy(out, source + 1, l * sizeof(char)); 479 else { /* add '...' before rest of name */ 480 addstr(out, RETS, LL(RETS)); 481 bufflen -= LL(RETS); 482 memcpy(out, source + 1 + l - bufflen, bufflen * sizeof(char)); 483 } 484 } 485 else { /* string; format as [string "source"] */ 486 const char *nl = strchr(source, '\n'); /* find first new line (if any) */ 487 addstr(out, PRE, LL(PRE)); /* add prefix */ 488 bufflen -= LL(PRE RETS POS) + 1; /* save space for prefix+suffix+'\0' */ 489 if (l < bufflen && nl == NULL) { /* small one-line source? */ 490 addstr(out, source, l); /* keep it */ 491 } 492 else { 493 if (nl != NULL) l = nl - source; /* stop at first newline */ 494 if (l > bufflen) l = bufflen; 495 addstr(out, source, l); 496 addstr(out, RETS, LL(RETS)); 497 } 498 memcpy(out, POS, (LL(POS) + 1) * sizeof(char)); 499 } 500 } 501 502