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