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