src/lj_lib.c

   1 /*
   2 ** Library function support.
   3 ** Copyright (C) 2005-2023 Mike Pall. See Copyright Notice in luajit.h
   4 */
   5
   6 #define lj_lib_c
   7 #define LUA_CORE
   8
   9 #include "lauxlib.h"
  10
  11 #include "lj_obj.h"
  12 #include "lj_gc.h"
  13 #include "lj_err.h"
  14 #include "lj_str.h"
  15 #include "lj_tab.h"
  16 #include "lj_func.h"
  17 #include "lj_bc.h"
  18 #include "lj_dispatch.h"
  19 #if LJ_HASFFI
  20 #include "lj_ctype.h"
  21 #endif
  22 #include "lj_vm.h"
  23 #include "lj_strscan.h"
  24 #include "lj_strfmt.h"
  25 #include "lj_lex.h"
  26 #include "lj_bcdump.h"
  27 #include "lj_lib.h"
  28
  29 /* -- Library initialization ---------------------------------------------- */
  30
  31 static GCtab *lib_create_table(lua_State *L, const char *libname, int hsize)
  32 {
  33   if (libname) {
  34     luaL_findtable(L, LUA_REGISTRYINDEX, "_LOADED", 16);
  35     lua_getfield(L, -1, libname);
  36     if (!tvistab(L->top-1)) {
  37       L->top--;
  38       if (luaL_findtable(L, LUA_GLOBALSINDEX, libname, hsize) != NULL)
  39         lj_err_callerv(L, LJ_ERR_BADMODN, libname);
  40       settabV(L, L->top, tabV(L->top-1));
  41       L->top++;
  42       lua_setfield(L, -3, libname);  /* _LOADED[libname] = new table */
  43     }
  44     L->top--;
  45     settabV(L, L->top-1, tabV(L->top));
  46   } else {
  47     lua_createtable(L, 0, hsize);
  48   }
  49   return tabV(L->top-1);
  50 }
  51
  52 static const uint8_t *lib_read_lfunc(lua_State *L, const uint8_t *p, GCtab *tab)
  53 {
  54   int len = *p++;
  55   GCstr *name = lj_str_new(L, (const char *)p, len);
  56   LexState ls;
  57   GCproto *pt;
  58   GCfunc *fn;
  59   memset(&ls, 0, sizeof(ls));
  60   ls.L = L;
  61   ls.p = (const char *)(p+len);
  62   ls.pe = (const char *)~(uintptr_t)0;
  63   ls.c = -1;
  64   ls.level = (BCDUMP_F_STRIP|(LJ_BE*BCDUMP_F_BE));
  65   ls.fr2 = LJ_FR2;
  66   ls.chunkname = name;
  67   pt = lj_bcread_proto(&ls);
  68   pt->firstline = ~(BCLine)0;
  69   fn = lj_func_newL_empty(L, pt, tabref(L->env));
  70   /* NOBARRIER: See below for common barrier. */
  71   setfuncV(L, lj_tab_setstr(L, tab, name), fn);
  72   return (const uint8_t *)ls.p;
  73 }
  74
  75 void lj_lib_register(lua_State *L, const char *libname,
  76                      const uint8_t *p, const lua_CFunction *cf)
  77 {
  78   GCtab *env = tabref(L->env);
  79   GCfunc *ofn = NULL;
  80   int ffid = *p++;
  81   BCIns *bcff = &L2GG(L)->bcff[*p++];
  82   GCtab *tab = lib_create_table(L, libname, *p++);
  83   ptrdiff_t tpos = L->top - L->base;
  84
  85   /* Avoid barriers further down. */
  86   lj_gc_anybarriert(L, tab);
  87   tab->nomm = 0;
  88
  89   for (;;) {
  90     uint32_t tag = *p++;
  91     MSize len = tag & LIBINIT_LENMASK;
  92     tag &= LIBINIT_TAGMASK;
  93     if (tag != LIBINIT_STRING) {
  94       const char *name;
  95       MSize nuv = (MSize)(L->top - L->base - tpos);
  96       GCfunc *fn = lj_func_newC(L, nuv, env);
  97       if (nuv) {
  98         L->top = L->base + tpos;
  99         memcpy(fn->c.upvalue, L->top, sizeof(TValue)*nuv);
 100       }
 101       fn->c.ffid = (uint8_t)(ffid++);
 102       name = (const char *)p;
 103       p += len;
 104       if (tag == LIBINIT_CF)
 105         setmref(fn->c.pc, &G(L)->bc_cfunc_int);
 106       else
 107         setmref(fn->c.pc, bcff++);
 108       if (tag == LIBINIT_ASM_)
 109         fn->c.f = ofn->c.f;  /* Copy handler from previous function. */
 110       else
 111         fn->c.f = *cf++;  /* Get cf or handler from C function table. */
 112       if (len) {
 113         /* NOBARRIER: See above for common barrier. */
 114         setfuncV(L, lj_tab_setstr(L, tab, lj_str_new(L, name, len)), fn);
 115       }
 116       ofn = fn;
 117     } else {
 118       switch (tag | len) {
 119       case LIBINIT_LUA:
 120         p = lib_read_lfunc(L, p, tab);
 121         break;
 122       case LIBINIT_SET:
 123         L->top -= 2;
 124         if (tvisstr(L->top+1) && strV(L->top+1)->len == 0)
 125           env = tabV(L->top);
 126         else  /* NOBARRIER: See above for common barrier. */
 127           copyTV(L, lj_tab_set(L, tab, L->top+1), L->top);
 128         break;
 129       case LIBINIT_NUMBER:
 130         memcpy(&L->top->n, p, sizeof(double));
 131         L->top++;
 132         p += sizeof(double);
 133         break;
 134       case LIBINIT_COPY:
 135         copyTV(L, L->top, L->top - *p++);
 136         L->top++;
 137         break;
 138       case LIBINIT_LASTCL:
 139         setfuncV(L, L->top++, ofn);
 140         break;
 141       case LIBINIT_FFID:
 142         ffid++;
 143         break;
 144       case LIBINIT_END:
 145         return;
 146       default:
 147         setstrV(L, L->top++, lj_str_new(L, (const char *)p, len));
 148         p += len;
 149         break;
 150       }
 151     }
 152   }
 153 }
 154
 155 /* Push internal function on the stack. */
 156 GCfunc *lj_lib_pushcc(lua_State *L, lua_CFunction f, int id, int n)
 157 {
 158   GCfunc *fn;
 159   lua_pushcclosure(L, f, n);
 160   fn = funcV(L->top-1);
 161   fn->c.ffid = (uint8_t)id;
 162   setmref(fn->c.pc, &G(L)->bc_cfunc_int);
 163   return fn;
 164 }
 165
 166 void lj_lib_prereg(lua_State *L, const char *name, lua_CFunction f, GCtab *env)
 167 {
 168   luaL_findtable(L, LUA_REGISTRYINDEX, "_PRELOAD", 4);
 169   lua_pushcfunction(L, f);
 170   /* NOBARRIER: The function is new (marked white). */
 171   setgcref(funcV(L->top-1)->c.env, obj2gco(env));
 172   lua_setfield(L, -2, name);
 173   L->top--;
 174 }
 175
 176 int lj_lib_postreg(lua_State *L, lua_CFunction cf, int id, const char *name)
 177 {
 178   GCfunc *fn = lj_lib_pushcf(L, cf, id);
 179   GCtab *t = tabref(curr_func(L)->c.env);  /* Reference to parent table. */
 180   setfuncV(L, lj_tab_setstr(L, t, lj_str_newz(L, name)), fn);
 181   lj_gc_anybarriert(L, t);
 182   setfuncV(L, L->top++, fn);
 183   return 1;
 184 }
 185
 186 /* -- Type checks --------------------------------------------------------- */
 187
 188 TValue *lj_lib_checkany(lua_State *L, int narg)
 189 {
 190   TValue *o = L->base + narg-1;
 191   if (o >= L->top)
 192     lj_err_arg(L, narg, LJ_ERR_NOVAL);
 193   return o;
 194 }
 195
 196 GCstr *lj_lib_checkstr(lua_State *L, int narg)
 197 {
 198   TValue *o = L->base + narg-1;
 199   if (o < L->top) {
 200     if (LJ_LIKELY(tvisstr(o))) {
 201       return strV(o);
 202     } else if (tvisnumber(o)) {
 203       GCstr *s = lj_strfmt_number(L, o);
 204       setstrV(L, o, s);
 205       return s;
 206     }
 207   }
 208   lj_err_argt(L, narg, LUA_TSTRING);
 209   return NULL;  /* unreachable */
 210 }
 211
 212 GCstr *lj_lib_optstr(lua_State *L, int narg)
 213 {
 214   TValue *o = L->base + narg-1;
 215   return (o < L->top && !tvisnil(o)) ? lj_lib_checkstr(L, narg) : NULL;
 216 }
 217
 218 #if LJ_DUALNUM
 219 void lj_lib_checknumber(lua_State *L, int narg)
 220 {
 221   TValue *o = L->base + narg-1;
 222   if (!(o < L->top && lj_strscan_numberobj(o)))
 223     lj_err_argt(L, narg, LUA_TNUMBER);
 224 }
 225 #endif
 226
 227 lua_Number lj_lib_checknum(lua_State *L, int narg)
 228 {
 229   TValue *o = L->base + narg-1;
 230   if (!(o < L->top &&
 231         (tvisnumber(o) || (tvisstr(o) && lj_strscan_num(strV(o), o)))))
 232     lj_err_argt(L, narg, LUA_TNUMBER);
 233   if (LJ_UNLIKELY(tvisint(o))) {
 234     lua_Number n = (lua_Number)intV(o);
 235     setnumV(o, n);
 236     return n;
 237   } else {
 238     return numV(o);
 239   }
 240 }
 241
 242 int32_t lj_lib_checkint(lua_State *L, int narg)
 243 {
 244   TValue *o = L->base + narg-1;
 245   if (!(o < L->top && lj_strscan_numberobj(o)))
 246     lj_err_argt(L, narg, LUA_TNUMBER);
 247   if (LJ_LIKELY(tvisint(o))) {
 248     return intV(o);
 249   } else {
 250     int32_t i = lj_num2int(numV(o));
 251     if (LJ_DUALNUM) setintV(o, i);
 252     return i;
 253   }
 254 }
 255
 256 int32_t lj_lib_optint(lua_State *L, int narg, int32_t def)
 257 {
 258   TValue *o = L->base + narg-1;
 259   return (o < L->top && !tvisnil(o)) ? lj_lib_checkint(L, narg) : def;
 260 }
 261
 262 GCfunc *lj_lib_checkfunc(lua_State *L, int narg)
 263 {
 264   TValue *o = L->base + narg-1;
 265   if (!(o < L->top && tvisfunc(o)))
 266     lj_err_argt(L, narg, LUA_TFUNCTION);
 267   return funcV(o);
 268 }
 269
 270 GCproto *lj_lib_checkLproto(lua_State *L, int narg, int nolua)
 271 {
 272   TValue *o = L->base + narg-1;
 273   if (L->top > o) {
 274     if (tvisproto(o)) {
 275       return protoV(o);
 276     } else if (tvisfunc(o)) {
 277       if (isluafunc(funcV(o)))
 278         return funcproto(funcV(o));
 279       else if (nolua)
 280         return NULL;
 281     }
 282   }
 283   lj_err_argt(L, narg, LUA_TFUNCTION);
 284   return NULL;  /* unreachable */
 285 }
 286
 287 GCtab *lj_lib_checktab(lua_State *L, int narg)
 288 {
 289   TValue *o = L->base + narg-1;
 290   if (!(o < L->top && tvistab(o)))
 291     lj_err_argt(L, narg, LUA_TTABLE);
 292   return tabV(o);
 293 }
 294
 295 GCtab *lj_lib_checktabornil(lua_State *L, int narg)
 296 {
 297   TValue *o = L->base + narg-1;
 298   if (o < L->top) {
 299     if (tvistab(o))
 300       return tabV(o);
 301     else if (tvisnil(o))
 302       return NULL;
 303   }
 304   lj_err_arg(L, narg, LJ_ERR_NOTABN);
 305   return NULL;  /* unreachable */
 306 }
 307
 308 int lj_lib_checkopt(lua_State *L, int narg, int def, const char *lst)
 309 {
 310   GCstr *s = def >= 0 ? lj_lib_optstr(L, narg) : lj_lib_checkstr(L, narg);
 311   if (s) {
 312     const char *opt = strdata(s);
 313     MSize len = s->len;
 314     int i;
 315     for (i = 0; *(const uint8_t *)lst; i++) {
 316       if (*(const uint8_t *)lst == len && memcmp(opt, lst+1, len) == 0)
 317         return i;
 318       lst += 1+*(const uint8_t *)lst;
 319     }
 320     lj_err_argv(L, narg, LJ_ERR_INVOPTM, opt);
 321   }
 322   return def;
 323 }
 324
 325 /* -- Strict type checks -------------------------------------------------- */
 326
 327 /* The following type checks do not coerce between strings and numbers.
 328 ** And they handle plain int64_t/uint64_t FFI numbers, too.
 329 */
 330
 331 #if LJ_HASBUFFER
 332 GCstr *lj_lib_checkstrx(lua_State *L, int narg)
 333 {
 334   TValue *o = L->base + narg-1;
 335   if (!(o < L->top && tvisstr(o))) lj_err_argt(L, narg, LUA_TSTRING);
 336   return strV(o);
 337 }
 338
 339 int32_t lj_lib_checkintrange(lua_State *L, int narg, int32_t a, int32_t b)
 340 {
 341   TValue *o = L->base + narg-1;
 342   lj_assertL(b >= 0, "expected range must be non-negative");
 343   if (o < L->top) {
 344     if (LJ_LIKELY(tvisint(o))) {
 345       int32_t i = intV(o);
 346       if (i >= a && i <= b) return i;
 347     } else if (LJ_LIKELY(tvisnum(o))) {
 348       /* For performance reasons, this doesn't check for integerness or
 349       ** integer overflow. Overflow detection still works, since all FPUs
 350       ** return either MININT or MAXINT, which is then out of range.
 351       */
 352       int32_t i = (int32_t)numV(o);
 353       if (i >= a && i <= b) return i;
 354 #if LJ_HASFFI
 355     } else if (tviscdata(o)) {
 356       GCcdata *cd = cdataV(o);
 357       if (cd->ctypeid == CTID_INT64) {
 358         int64_t i = *(int64_t *)cdataptr(cd);
 359         if (i >= (int64_t)a && i <= (int64_t)b) return (int32_t)i;
 360       } else if (cd->ctypeid == CTID_UINT64) {
 361         uint64_t i = *(uint64_t *)cdataptr(cd);
 362         if ((a < 0 || i >= (uint64_t)a) && i <= (uint64_t)b) return (int32_t)i;
 363       } else {
 364         goto badtype;
 365       }
 366 #endif
 367     } else {
 368       goto badtype;
 369     }
 370     lj_err_arg(L, narg, LJ_ERR_NUMRNG);
 371   }
 372 badtype:
 373   lj_err_argt(L, narg, LUA_TNUMBER);
 374   return 0;  /* unreachable */
 375 }
 376 #endif
 377