libextl/luaextl.c

   1 /*
   2  * libextl/luaextl.c
   3  *
   4  * Copyright (c) Tuomo Valkonen 1999-2005.
   5  *
   6  * This library is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU Lesser General Public
   8  * License as published by the Free Software Foundation; either
   9  * version 2.1 of the License, or (at your option) any later version.
  10  */
  11
  12 #include <time.h>
  13 #include <errno.h>
  14 #include <stdlib.h>
  15 #include <stdarg.h>
  16 #include <math.h>
  17 #include <string.h>
  18 #include <limits.h>
  19 #include <assert.h>
  20
  21 #include <lua.h>
  22 #include <lualib.h>
  23 #include <lauxlib.h>
  24
  25 #include <libtu/obj.h>
  26 #include <libtu/objp.h>
  27 #include <libtu/dlist.h>
  28
  29 #include "readconfig.h"
  30 #include "luaextl.h"
  31 #include "private.h"
  32
  33 #define MAGIC 0xf00ba7
  34
  35 /* Maximum number of parameters and return values for calls from Lua
  36  * and (if va_copy is not available) return value from Lua functions.
  37  */
  38 #define MAX_PARAMS 16
  39
  40 static lua_State *l_st=NULL;
  41
  42 static bool extl_stack_get(lua_State *st, int pos, char type,
  43                            bool copystring, bool *wasdeadobject,
  44                            void *valret);
  45
  46 static int extl_protected(lua_State *st);
  47
  48 #ifdef EXTL_LOG_ERRORS
  49 static void flushtrace();
  50 #else
  51 #define flushtrace()
  52 #endif
  53
  54
  55 /*{{{ Safer rawget/set/getn */
  56
  57
  58 #define CHECK_TABLE(ST, INDEX) luaL_checktype(ST, INDEX, LUA_TTABLE)
  59
  60 static int luaL_getn_check(lua_State *st, int index)
  61 {
  62     CHECK_TABLE(st, index);
  63     return luaL_getn(st, index);
  64 }
  65
  66
  67 static void lua_rawset_check(lua_State *st, int index)
  68 {
  69     CHECK_TABLE(st, index);
  70     lua_rawset(st, index);
  71 }
  72
  73
  74 static void lua_rawseti_check(lua_State *st, int index, int n)
  75 {
  76     CHECK_TABLE(st, index);
  77     lua_rawseti(st, index, n);
  78 }
  79
  80
  81 static void lua_rawget_check(lua_State *st, int index)
  82 {
  83     CHECK_TABLE(st, index);
  84     lua_rawget(st, index);
  85 }
  86
  87
  88 static void lua_rawgeti_check(lua_State *st, int index, int n)
  89 {
  90     CHECK_TABLE(st, index);
  91     lua_rawgeti(st, index, n);
  92 }
  93
  94
  95 /*}}}*/
  96
  97
  98 /*{{{ A cpcall wrapper */
  99
 100
 101 typedef bool ExtlCPCallFn(lua_State *st, void *ptr);
 102
 103
 104 typedef struct{
 105     ExtlCPCallFn *fn;
 106     void *udata;
 107     bool retval;
 108 } ExtlCPCallParam;
 109
 110
 111 static int extl_docpcall(lua_State *st)
 112 {
 113     ExtlCPCallParam *param=(ExtlCPCallParam*)lua_touserdata(st, -1);
 114
 115     /* Should be enough for most things */
 116     if(!lua_checkstack(st, 8)){
 117         extl_warn(TR("Lua stack full."));
 118         return 0;
 119     }
 120
 121     param->retval=param->fn(st, param->udata);
 122     return 0;
 123 }
 124
 125
 126 static bool extl_cpcall(lua_State *st, ExtlCPCallFn *fn, void *ptr)
 127 {
 128     ExtlCPCallParam param;
 129     int oldtop=lua_gettop(st);
 130     int err;
 131
 132     param.fn=fn;
 133     param.udata=ptr;
 134     param.retval=FALSE;
 135
 136
 137     err=lua_cpcall(st, extl_docpcall, &param);
 138     if(err==LUA_ERRRUN){
 139         extl_warn("%s", lua_tostring(st, -1));
 140     }else if(err==LUA_ERRMEM){
 141         extl_warn("%s", strerror(ENOMEM));
 142     }else if(err!=0){
 143         extl_warn(TR("Unknown Lua error."));
 144     }
 145
 146     lua_settop(st, oldtop);
 147
 148     return param.retval;
 149 }
 150
 151
 152 /*}}}*/
 153
 154
 155 /*{{{ Obj userdata handling -- unsafe */
 156
 157
 158 static int owned_cache_ref=LUA_NOREF;
 159
 160
 161 static Obj *extl_get_obj(lua_State *st, int pos,
 162                          bool *invalid, bool *dead)
 163 {
 164     int val;
 165
 166     *dead=FALSE;
 167     *invalid=TRUE;
 168
 169     if(!lua_isuserdata(st, pos)){
 170         *invalid=!lua_isnil(st, pos);
 171         return NULL;
 172     }
 173
 174     if(!lua_getmetatable(st, pos))
 175         return NULL;
 176
 177     /* If the userdata object is a proper Obj, metatable[MAGIC] must
 178      * have been set to MAGIC.
 179      */
 180     lua_pushnumber(st, MAGIC);
 181     lua_gettable(st, -2);
 182     val=lua_tonumber(st, -1);
 183     lua_pop(st, 2);
 184
 185     if(val==MAGIC){
 186         ExtlProxy *proxy=(ExtlProxy*)lua_touserdata(st, pos);
 187
 188         *invalid=FALSE;
 189
 190         if(proxy!=NULL){
 191             Obj *obj=EXTL_PROXY_OBJ(proxy);
 192             if(obj==NULL){
 193                 *dead=TRUE;
 194                 *invalid=TRUE;
 195             }
 196             return obj;
 197         }
 198     }
 199
 200     return NULL;
 201 }
 202
 203
 204 static void extl_uncache_(lua_State *st, Obj *obj)
 205 {
 206     if(EXTL_OBJ_OWNED(obj)){
 207         lua_rawgeti(st, LUA_REGISTRYINDEX, owned_cache_ref);
 208         lua_pushlightuserdata(st, obj);
 209         lua_pushnil(st);
 210         lua_rawset(st, -3);
 211     }else{
 212         lua_pushlightuserdata(st, obj);
 213         lua_pushnil(st);
 214         lua_rawset(st, LUA_REGISTRYINDEX);
 215     }
 216 }
 217
 218
 219 void extl_uncache(Obj *obj)
 220 {
 221     extl_cpcall(l_st, (ExtlCPCallFn*)extl_uncache_, obj);
 222 }
 223
 224
 225 static void extl_push_obj(lua_State *st, Obj *obj)
 226 {
 227     ExtlProxy *proxy;
 228
 229     if(obj==NULL){
 230         lua_pushnil(st);
 231         return;
 232     }
 233
 234     if(EXTL_OBJ_CACHED(obj)){
 235         if(EXTL_OBJ_OWNED(obj)){
 236             lua_rawgeti(st, LUA_REGISTRYINDEX, owned_cache_ref);
 237             lua_pushlightuserdata(st, obj);
 238             lua_rawget(st, -2);
 239             lua_remove(st, -2); /* owned_cache */
 240         }else{
 241             lua_pushlightuserdata(st, obj);
 242             lua_rawget(st, LUA_REGISTRYINDEX);
 243         }
 244         if(lua_isuserdata(st, -1)){
 245             D(fprintf(stderr, "found %p cached\n", obj));
 246             return;
 247         }
 248         lua_pop(st, 1);
 249     }
 250
 251     D(fprintf(stderr, "Creating %p\n", obj));
 252
 253     proxy=(ExtlProxy*)lua_newuserdata(st, sizeof(ExtlProxy));
 254
 255     /* Lua shouldn't return if the allocation fails */
 256
 257     lua_pushfstring(st, "luaextl_%s_metatable", OBJ_TYPESTR(obj));
 258     lua_gettable(st, LUA_REGISTRYINDEX);
 259     if(lua_isnil(st, -1)){
 260         lua_pop(st, 2);
 261         lua_pushnil(st);
 262     }else{
 263         lua_setmetatable(st, -2);
 264
 265         /* Store in cache */
 266         if(EXTL_OBJ_OWNED(obj)){
 267             lua_rawgeti(st, LUA_REGISTRYINDEX, owned_cache_ref);
 268             lua_pushlightuserdata(st, obj);
 269             lua_pushvalue(st, -3);  /* the WWatch */
 270             lua_rawset_check(st, -3);
 271             lua_pop(st, 1); /* owned_cache */
 272         }else{
 273             lua_pushlightuserdata(st, obj);
 274             lua_pushvalue(st, -2); /* the WWatch */
 275             lua_rawset_check(st, LUA_REGISTRYINDEX);
 276         }
 277         EXTL_BEGIN_PROXY_OBJ(proxy, obj);
 278     }
 279 }
 280
 281
 282 /*{{{ Functions available to Lua code */
 283
 284
 285 static int extl_obj_gc_handler(lua_State *st)
 286 {
 287     ExtlProxy *proxy;
 288     bool dead=FALSE, invalid=FALSE;
 289     Obj *obj;
 290
 291     obj=extl_get_obj(st, 1, &invalid, &dead);
 292
 293     if(obj==NULL){
 294         /* This should not happen, actually. Our object cache should
 295          * hold references to all objects seen on the Lua side until
 296          * they are destroyed.
 297          */
 298         return 0;
 299     }
 300
 301     proxy=(ExtlProxy*)lua_touserdata(st, 1);
 302
 303     if(proxy!=NULL)
 304         EXTL_END_PROXY_OBJ(proxy, obj);
 305
 306     if(EXTL_OBJ_OWNED(obj))
 307         EXTL_DESTROY_OWNED_OBJ(obj);
 308
 309     return 0;
 310 }
 311
 312
 313 static int extl_obj_typename(lua_State *st)
 314 {
 315     Obj *obj=NULL;
 316
 317     if(!extl_stack_get(st, 1, 'o', FALSE, NULL, &obj) || obj==NULL)
 318         return 0;
 319
 320     lua_pushstring(st, EXTL_OBJ_TYPENAME(obj));
 321     return 1;
 322 }
 323
 324 /* Dummy code for documentation generation. */
 325
 326 /*EXTL_DOC
 327  * Return type name of \var{obj}.
 328  */
 329 EXTL_EXPORT_AS(global, obj_typename)
 330 const char *__obj_typename(Obj *obj);
 331
 332
 333 static int extl_obj_exists(lua_State *st)
 334 {
 335     Obj *obj=NULL;
 336
 337     extl_stack_get(st, 1, 'o', FALSE, NULL, &obj);
 338
 339     lua_pushboolean(st, obj!=NULL);
 340
 341     return 1;
 342 }
 343
 344 /* Dummy code for documentation generation. */
 345
 346 /*EXTL_DOC
 347  * Does \var{obj} still exist on the C side of Ion?
 348  */
 349 EXTL_EXPORT_AS(global, obj_exists)
 350 bool __obj_exists(Obj *obj);
 351
 352
 353 static int extl_obj_is(lua_State *st)
 354 {
 355     Obj *obj=NULL;
 356     const char *tn;
 357
 358     extl_stack_get(st, 1, 'o', FALSE, NULL, &obj);
 359
 360     if(obj==NULL){
 361         lua_pushboolean(st, 0);
 362     }else{
 363         tn=lua_tostring(st, 2);
 364         lua_pushboolean(st, EXTL_OBJ_IS(obj, tn));
 365     }
 366
 367     return 1;
 368 }
 369
 370 /* Dummy code for documentation generation. */
 371
 372 /*EXTL_DOC
 373  * Is \var{obj} of type \var{typename}.
 374  */
 375 EXTL_EXPORT_AS(global, obj_is)
 376 bool __obj_is(Obj *obj, const char *typename);
 377
 378
 379 static int extl_current_file_or_dir(lua_State *st, bool dir)
 380 {
 381     int r;
 382     lua_Debug ar;
 383     const char *s, *p;
 384
 385     if(lua_getstack(st, 1, &ar)!=1)
 386         goto err;
 387     if(lua_getinfo(st, "S", &ar)==0)
 388         goto err;
 389
 390     if(ar.source==NULL || ar.source[0]!='@')
 391         return 0; /* not a file */
 392
 393     s=ar.source+1;
 394
 395     if(!dir){
 396         lua_pushstring(st, s);
 397     }else{
 398         p=strrchr(s, '/');
 399         if(p==NULL){
 400             lua_pushstring(st, ".");
 401         }else{
 402             lua_pushlstring(st, s, p-s);
 403         }
 404     }
 405     return 1;
 406
 407 err:
 408     extl_warn("Unable to get caller file from stack.");
 409     return 0;
 410 }
 411
 412
 413 static int extl_dopath(lua_State *st)
 414 {
 415     const char *toincl, *cfdir;
 416     bool res, complain;
 417
 418     toincl=luaL_checkstring(st, 1);
 419     complain=!lua_toboolean(st, 2);
 420
 421     if(extl_current_file_or_dir(st, TRUE)!=1){
 422         res=extl_read_config(toincl, NULL, complain);
 423     }else{
 424         cfdir=lua_tostring(st, -1);
 425         res=extl_read_config(toincl, cfdir, complain);
 426         lua_pop(st, 1);
 427     }
 428     lua_pushboolean(st, res);
 429     return 1;
 430 }
 431
 432 /* Dummy code for documentation generation. */
 433
 434 /*EXTL_DOC
 435  * Look up and execute another file with Lua code.
 436  */
 437 EXTL_EXPORT_AS(global, dopath)
 438 bool dopath(const char *what);
 439
 440
 441 /*}}}*/
 442
 443
 444 static bool extl_init_obj_info(lua_State *st)
 445 {
 446     static ExtlExportedFnSpec dummy[]={
 447         {NULL, NULL, NULL, NULL, NULL, FALSE, FALSE, FALSE}
 448     };
 449
 450     extl_register_class("Obj", dummy, NULL);
 451
 452     /* Create cache for proxies to objects owned by Lua-side.
 453      * These need to be in a weak table to ever be collected.
 454      */
 455     lua_newtable(st);
 456     lua_newtable(st);
 457     lua_pushstring(st, "__mode");
 458     lua_pushstring(st, "v");
 459     lua_rawset_check(st, -3);
 460     lua_setmetatable(st, -2);
 461     owned_cache_ref=lua_ref(st, -1);
 462
 463     lua_pushcfunction(st, extl_obj_typename);
 464     lua_setglobal(st, "obj_typename");
 465     lua_pushcfunction(st, extl_obj_is);
 466     lua_setglobal(st, "obj_is");
 467     lua_pushcfunction(st, extl_obj_exists);
 468     lua_setglobal(st, "obj_exists");
 469     lua_pushcfunction(st, extl_dopath);
 470     lua_setglobal(st, "dopath");
 471     lua_pushcfunction(st, extl_protected);
 472     lua_setglobal(st, "protected");
 473
 474     return TRUE;
 475 }
 476
 477
 478 /*}}}*/
 479
 480
 481 /*{{{ Error handling and reporting -- unsafe */
 482
 483
 484 static int extl_stack_trace(lua_State *st)
 485 {
 486     lua_Debug ar;
 487     int lvl=0;
 488     int n_skip=0;
 489
 490     lua_pushstring(st, TR("Stack trace:"));
 491
 492     for( ; lua_getstack(st, lvl, &ar); lvl++){
 493         bool is_c=FALSE;
 494
 495         if(lua_getinfo(st, "Sln", &ar)==0){
 496             lua_pushfstring(st,
 497                             TR("\n(Unable to get debug info for level %d)"),
 498                             lvl);
 499             lua_concat(st, 2);
 500             continue;
 501         }
 502
 503         is_c=(ar.what!=NULL && strcmp(ar.what, "C")==0);
 504
 505         if(!is_c || ar.name!=NULL){
 506             lua_pushfstring(st, "\n%d %s", lvl, ar.short_src);
 507             if(ar.currentline!=-1)
 508                 lua_pushfstring(st, ":%d", ar.currentline);
 509             if(ar.name!=NULL)
 510                 lua_pushfstring(st, ": in '%s'", ar.name);
 511             lua_concat(st, 2+(ar.currentline!=-1)+(ar.name!=NULL));
 512             n_skip=0;
 513         }else{
 514             if(n_skip==0){
 515                 lua_pushstring(st, TR("\n  [Skipping unnamed C functions.]"));
 516                 /*lua_pushstring(st, "\n...skipping...");*/
 517                 lua_concat(st, 2);
 518             }
 519             n_skip++;
 520         }
 521     }
 522     return 1;
 523 }
 524
 525
 526 #ifdef EXTL_LOG_ERRORS
 527
 528 static int extl_do_collect_errors(lua_State *st)
 529 {
 530     int n, err;
 531     ErrorLog *el=(ErrorLog*)lua_touserdata(st, -1);
 532
 533     lua_pop(st, 1);
 534
 535     n=lua_gettop(st)-1;
 536     err=lua_pcall(st, n, 0, 0);
 537
 538     if(err!=0)
 539         extl_warn("%s", lua_tostring(st, -1));
 540
 541     if(el->msgs_len==0)
 542         return 0;
 543     lua_pushstring(st, el->msgs);
 544     return 1;
 545 }
 546
 547
 548 int extl_collect_errors(lua_State *st)
 549 {
 550     ErrorLog el;
 551     int n=lua_gettop(st);
 552     int err;
 553
 554     lua_pushcfunction(st, extl_do_collect_errors);
 555     lua_insert(st, 1);
 556     lua_pushlightuserdata(st, &el);
 557
 558     errorlog_begin(&el);
 559
 560     err=lua_pcall(st, n+1, 1, 0);
 561
 562     errorlog_end(&el);
 563     errorlog_deinit(&el);
 564
 565     if(err!=0)
 566         extl_warn(TR("Internal error."));
 567
 568     return 1;
 569 }
 570
 571 #endif
 572
 573
 574 /*}}}*/
 575
 576
 577 /*{{{ Init -- unsafe, but it doesn't matter at this point */
 578
 579
 580 bool extl_init()
 581 {
 582     l_st=luaL_newstate();
 583
 584     if(l_st==NULL){
 585         extl_warn(TR("Unable to initialize Lua."));
 586         return FALSE;
 587     }
 588
 589     /* This is equivalent to calling all the ones below but it also includes
 590      * the debug library, so I went with those in case there was a reason not
 591      * to include the debug library.
 592     luaL_openlibs(l_st);
 593     */
 594
 595     lua_pushcfunction(l_st, luaopen_base);
 596     lua_call(l_st, 0, 0);
 597
 598     lua_pushcfunction(l_st, luaopen_table);
 599     lua_call(l_st, 0, 0);
 600
 601     lua_pushcfunction(l_st, luaopen_io);
 602     lua_call(l_st, 0, 0);
 603
 604     lua_pushcfunction(l_st, luaopen_os);
 605     lua_call(l_st, 0, 0);
 606
 607     lua_pushcfunction(l_st, luaopen_string);
 608     lua_call(l_st, 0, 0);
 609
 610     lua_pushcfunction(l_st, luaopen_math);
 611     lua_call(l_st, 0, 0);
 612
 613     lua_pushcfunction(l_st, luaopen_package);
 614     lua_call(l_st, 0, 0);
 615
 616     if(!extl_init_obj_info(l_st)){
 617         lua_close(l_st);
 618         return FALSE;
 619     }
 620
 621 #ifdef EXTL_LOG_ERRORS
 622     lua_pushcfunction(l_st, extl_collect_errors);
 623     lua_setglobal(l_st, "collect_errors");
 624 #endif
 625
 626     return TRUE;
 627 }
 628
 629
 630 void extl_deinit()
 631 {
 632     lua_close(l_st);
 633     l_st=NULL;
 634 }
 635
 636
 637 /*}}}*/
 638
 639
 640 /*{{{ Stack get/push -- all unsafe */
 641
 642
 643 static bool extl_stack_get(lua_State *st, int pos, char type,
 644                            bool copystring, bool *wasdeadobject,
 645                            void *valret)
 646 {
 647     double d=0;
 648     const char *str;
 649
 650     if(wasdeadobject!=NULL)
 651         *wasdeadobject=FALSE;
 652
 653     if(type=='i' || type=='d'){
 654         if(lua_type(st, pos)!=LUA_TNUMBER)
 655             return FALSE;
 656
 657         d=lua_tonumber(st, pos);
 658
 659         if(type=='i'){
 660             if(d-floor(d)!=0)
 661                 return FALSE;
 662             if(valret)
 663                 *((int*)valret)=d;
 664         }else{
 665             if(valret)
 666                 *((double*)valret)=d;
 667         }
 668         return TRUE;
 669     }
 670
 671     if(type=='b'){
 672         if(valret)
 673             *((bool*)valret)=lua_toboolean(st, pos);
 674         return TRUE;
 675     }
 676
 677     if(lua_type(st, pos)==LUA_TNIL || lua_type(st, pos)==LUA_TNONE){
 678         if(type=='t' || type=='f'){
 679             if(valret)
 680                 *((int*)valret)=LUA_NOREF;
 681         }else if(type=='s' || type=='S'){
 682             if(valret)
 683                 *((char**)valret)=NULL;
 684         }else if(type=='o'){
 685             if(valret)
 686                 *((Obj**)valret)=NULL;
 687         }else{
 688             return FALSE;
 689         }
 690         return TRUE;
 691     }
 692
 693     if(type=='s' || type=='S'){
 694         if(lua_type(st, pos)!=LUA_TSTRING)
 695             return FALSE;
 696         if(valret){
 697             str=lua_tostring(st, pos);
 698             if(str!=NULL && copystring){
 699                 str=extl_scopy(str);
 700                 if(str==NULL)
 701                     return FALSE;
 702             }
 703             *((const char**)valret)=str;
 704         }
 705         return TRUE;
 706     }
 707
 708     if(type=='f'){
 709         if(!lua_isfunction(st, pos))
 710             return FALSE;
 711         if(valret){
 712             lua_pushvalue(st, pos);
 713             *((int*)valret)=lua_ref(st, 1);
 714         }
 715         return TRUE;
 716     }
 717
 718     if(type=='t'){
 719         if(!lua_istable(st, pos))
 720             return FALSE;
 721         if(valret){
 722             lua_pushvalue(st, pos);
 723             *((int*)valret)=lua_ref(st, 1);
 724         }
 725         return TRUE;
 726     }
 727
 728     if(type=='o'){
 729         bool invalid=FALSE, dead=FALSE;
 730         Obj *obj=extl_get_obj(st, pos, &invalid, &dead);
 731         if(wasdeadobject!=NULL)
 732             *wasdeadobject=dead;
 733         if(valret){
 734             *((Obj**)valret)=obj;
 735             D(fprintf(stderr, "Got obj %p, ", obj);
 736               fprintf(stderr, "%s\n", OBJ_TYPESTR(obj)));
 737         }
 738         return !invalid;
 739     }
 740
 741     return FALSE;
 742 }
 743
 744
 745 static void extl_stack_push(lua_State *st, char spec, void *ptr)
 746 {
 747     if(spec=='i'){
 748         lua_pushnumber(st, *(int*)ptr);
 749     }else if(spec=='d'){
 750         lua_pushnumber(st, *(double*)ptr);
 751     }else if(spec=='b'){
 752         lua_pushboolean(st, *(bool*)ptr);
 753     }else if(spec=='o'){
 754         extl_push_obj(st, *(Obj**)ptr);
 755     }else if(spec=='s' || spec=='S'){
 756         lua_pushstring(st, *(char**)ptr);
 757     }else if(spec=='t' || spec=='f'){
 758         lua_rawgeti(st, LUA_REGISTRYINDEX, *(int*)ptr);
 759     }else{
 760         lua_pushnil(st);
 761     }
 762 }
 763
 764
 765 static bool extl_stack_push_vararg(lua_State *st, char spec, va_list *argsp)
 766 {
 767     switch(spec){
 768     case 'i':
 769         lua_pushnumber(st, (double)va_arg(*argsp, int));
 770         break;
 771     case 'd':
 772         lua_pushnumber(st, va_arg(*argsp, double));
 773         break;
 774     case 'b':
 775         lua_pushboolean(st, va_arg(*argsp, bool));
 776         break;
 777     case 'o':
 778         extl_push_obj(st, va_arg(*argsp, Obj*));
 779         break;
 780     case 'S':
 781     case 's':
 782         lua_pushstring(st, va_arg(*argsp, char*));
 783         break;
 784     case 'f':
 785     case 't':
 786         lua_rawgeti(st, LUA_REGISTRYINDEX, va_arg(*argsp, int));
 787         break;
 788     default:
 789         return FALSE;
 790     }
 791
 792     return TRUE;
 793 }
 794
 795
 796 /*}}}*/
 797
 798
 799 /*{{{ Free */
 800
 801
 802 enum{STRINGS_NONE, STRINGS_NONCONST, STRINGS_ALL};
 803
 804
 805 static void extl_free(void *ptr, char spec, int strings)
 806 {
 807     if(((spec=='s' && strings!=STRINGS_NONE) ||
 808         (spec=='S' && strings==STRINGS_ALL)) && *(char**)ptr!=NULL){
 809         if(*(char**)ptr!=NULL)
 810             free(*(char**)ptr);
 811         *(char**)ptr=NULL;
 812     }else if(spec=='t'){
 813         extl_unref_table(*(ExtlTab*)ptr);
 814     }else if(spec=='f'){
 815         extl_unref_fn(*(ExtlFn*)ptr);
 816     }
 817 }
 818
 819
 820 /*}}}*/
 821
 822
 823 /*{{{ Table and function references. */
 824
 825
 826 static bool extl_getref(lua_State *st, int ref)
 827 {
 828     lua_rawgeti(st, LUA_REGISTRYINDEX, ref);
 829     if(lua_isnil(st, -1)){
 830         lua_pop(st, 1);
 831         return FALSE;
 832     }
 833     return TRUE;
 834 }
 835
 836 /* Unref */
 837
 838 static bool extl_do_unref(lua_State *st, int *refp)
 839 {
 840     lua_unref(st, *refp);
 841     return TRUE;
 842 }
 843
 844
 845 ExtlFn extl_unref_fn(ExtlFn ref)
 846 {
 847     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unref, &ref);
 848     return LUA_NOREF;
 849 }
 850
 851
 852 ExtlFn extl_unref_table(ExtlTab ref)
 853 {
 854     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unref, &ref);
 855     return LUA_NOREF;
 856 }
 857
 858
 859 /* noref */
 860
 861 ExtlFn extl_fn_none()
 862 {
 863     return LUA_NOREF;
 864 }
 865
 866
 867 ExtlTab extl_table_none()
 868 {
 869     return LUA_NOREF;
 870 }
 871
 872
 873 /* ref */
 874
 875 static bool extl_do_ref(lua_State *st, int *refp)
 876 {
 877     if(!extl_getref(st, *refp))
 878         return FALSE;
 879     *refp=lua_ref(st, 1);
 880     return TRUE;
 881 }
 882
 883
 884 ExtlTab extl_ref_table(ExtlTab ref)
 885 {
 886     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_ref, &ref))
 887         return ref;
 888     return LUA_NOREF;
 889 }
 890
 891
 892 ExtlFn extl_ref_fn(ExtlFn ref)
 893 {
 894     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_ref, &ref))
 895         return ref;
 896     return LUA_NOREF;
 897 }
 898
 899
 900 /* create_table */
 901
 902 static bool extl_do_create_table(lua_State *st, int *refp)
 903 {
 904     lua_newtable(st);
 905     *refp=lua_ref(st, 1);
 906     return TRUE;
 907 }
 908
 909
 910 ExtlTab extl_create_table()
 911 {
 912     ExtlTab ref;
 913     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_create_table, &ref))
 914         return ref;
 915     return LUA_NOREF;
 916 }
 917
 918
 919 /* eq */
 920
 921 typedef struct{
 922     int o1, o2;
 923     bool ret;
 924 } EqParams;
 925
 926
 927 static bool extl_do_eq(lua_State *st, EqParams *ep)
 928 {
 929     if(!extl_getref(st, ep->o1))
 930         return FALSE;
 931     if(!extl_getref(st, ep->o2))
 932         return FALSE;
 933     ep->ret=lua_equal(st, -1, -2);
 934     return TRUE;
 935 }
 936
 937
 938 bool extl_fn_eq(ExtlFn fn1, ExtlFn fn2)
 939 {
 940     EqParams ep;
 941     ep.o1=fn1;
 942     ep.o2=fn2;
 943     ep.ret=FALSE;
 944     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_eq, &ep);
 945     return ep.ret;
 946 }
 947
 948
 949 bool extl_table_eq(ExtlTab t1, ExtlTab t2)
 950 {
 951     EqParams ep;
 952     ep.o1=t1;
 953     ep.o2=t2;
 954     ep.ret=FALSE;
 955     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_eq, &ep);
 956     return ep.ret;
 957 }
 958
 959
 960 /*}}}*/
 961
 962
 963 /*{{{ Table/get */
 964
 965
 966 typedef struct{
 967     ExtlTab ref;
 968     char type;
 969     char itype;
 970     va_list *argsp;
 971 } TableParams2;
 972
 973
 974 static bool extl_table_dodo_get2(lua_State *st, TableParams2 *params)
 975 {
 976     if(params->ref<0)
 977         return FALSE;
 978
 979     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
 980     extl_stack_push_vararg(st, params->itype, params->argsp);
 981     lua_gettable(st, -2);
 982     if(lua_isnil(st, -1))
 983         return FALSE;
 984
 985     return extl_stack_get(st, -1, params->type, TRUE, NULL,
 986                           va_arg(*(params->argsp), void*));
 987 }
 988
 989
 990 bool extl_table_get_vararg(ExtlTab ref, char itype, char type, va_list *args)
 991 {
 992     TableParams2 params;
 993
 994     params.ref=ref;
 995     params.itype=itype;
 996     params.type=type;
 997     params.argsp=args;
 998
 999     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_get2, &params);
1000 }
1001
1002
1003 bool extl_table_get(ExtlTab ref, char itype, char type, ...)
1004 {
1005     va_list args;
1006     bool retval;
1007
1008     va_start(args, type);
1009     retval=extl_table_get_vararg(ref, itype, type, &args);
1010     va_end(args);
1011
1012     return retval;
1013 }
1014
1015
1016 static bool extl_table_do_gets(ExtlTab ref, const char *entry,
1017                                char type, void *valret)
1018 {
1019     return extl_table_get(ref, 's', type, entry, valret);
1020 }
1021
1022 bool extl_table_gets_o(ExtlTab ref, const char *entry, Obj **ret)
1023 {
1024     return extl_table_do_gets(ref, entry, 'o', (void*)ret);
1025 }
1026
1027 bool extl_table_gets_i(ExtlTab ref, const char *entry, int *ret)
1028 {
1029     return extl_table_do_gets(ref, entry, 'i', (void*)ret);
1030 }
1031
1032 bool extl_table_gets_d(ExtlTab ref, const char *entry, double *ret)
1033 {
1034     return extl_table_do_gets(ref, entry, 'd', (void*)ret);
1035 }
1036
1037 bool extl_table_gets_b(ExtlTab ref, const char *entry, bool *ret)
1038 {
1039     return extl_table_do_gets(ref, entry, 'b', (void*)ret);
1040 }
1041
1042 bool extl_table_gets_s(ExtlTab ref, const char *entry, char **ret)
1043 {
1044     return extl_table_do_gets(ref, entry, 's', (void*)ret);
1045 }
1046
1047 bool extl_table_gets_f(ExtlTab ref, const char *entry, ExtlFn *ret)
1048 {
1049     return extl_table_do_gets(ref, entry, 'f', (void*)ret);
1050 }
1051
1052 bool extl_table_gets_t(ExtlTab ref, const char *entry, ExtlTab *ret)
1053 {
1054     return extl_table_do_gets(ref, entry, 't', (void*)ret);
1055 }
1056
1057
1058 static bool extl_table_do_geti(ExtlTab ref, int entry, char type, void *valret)
1059 {
1060     return extl_table_get(ref, 'i', type, entry, valret);
1061 }
1062
1063 bool extl_table_geti_o(ExtlTab ref, int entry, Obj **ret)
1064 {
1065     return extl_table_do_geti(ref, entry, 'o', (void*)ret);
1066 }
1067
1068 bool extl_table_geti_i(ExtlTab ref, int entry, int *ret)
1069 {
1070     return extl_table_do_geti(ref, entry, 'i', (void*)ret);
1071 }
1072
1073 bool extl_table_geti_d(ExtlTab ref, int entry, double *ret)
1074 {
1075     return extl_table_do_geti(ref, entry, 'd', (void*)ret);
1076 }
1077
1078 bool extl_table_geti_b(ExtlTab ref, int entry, bool *ret)
1079 {
1080     return extl_table_do_geti(ref, entry, 'b', (void*)ret);
1081 }
1082
1083 bool extl_table_geti_s(ExtlTab ref, int entry, char **ret)
1084 {
1085     return extl_table_do_geti(ref, entry, 's', (void*)ret);
1086 }
1087
1088 bool extl_table_geti_f(ExtlTab ref, int entry, ExtlFn *ret)
1089 {
1090     return extl_table_do_geti(ref, entry, 'f', (void*)ret);
1091 }
1092
1093 bool extl_table_geti_t(ExtlTab ref, int entry, ExtlTab *ret)
1094 {
1095     return extl_table_do_geti(ref, entry, 't', (void*)ret);
1096 }
1097
1098
1099 typedef struct{
1100     int ref;
1101     int n;
1102 } GetNParams;
1103
1104
1105 static bool extl_table_do_get_n(lua_State *st, GetNParams *params)
1106 {
1107     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1108     params->n=luaL_getn_check(st, -1);
1109     return TRUE;
1110 }
1111
1112
1113 int extl_table_get_n(ExtlTab ref)
1114 {
1115     GetNParams params;
1116     int oldtop;
1117
1118     params.ref=ref;
1119     params.n=0;
1120
1121     extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_do_get_n, &params);
1122
1123     return params.n;
1124 }
1125
1126
1127 /*}}}*/
1128
1129
1130 /*{{{ Table/set */
1131
1132
1133 static bool extl_table_dodo_set2(lua_State *st, TableParams2 *params)
1134 {
1135     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1136     extl_stack_push_vararg(st, params->itype, params->argsp);
1137     extl_stack_push_vararg(st, params->type, params->argsp);
1138     lua_rawset_check(st, -3);
1139     return TRUE;
1140 }
1141
1142
1143 bool extl_table_set_vararg(ExtlTab ref, char itype, char type, va_list *args)
1144 {
1145     TableParams2 params;
1146
1147     params.ref=ref;
1148     params.itype=itype;
1149     params.type=type;
1150     params.argsp=args;
1151
1152     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_set2, &params);
1153 }
1154
1155
1156 bool extl_table_set(ExtlTab ref, char itype, char type, ...)
1157 {
1158     va_list args;
1159     bool retval;
1160
1161     va_start(args, type);
1162     retval=extl_table_set_vararg(ref, itype, type, &args);
1163     va_end(args);
1164
1165     return retval;
1166 }
1167
1168
1169 bool extl_table_sets_o(ExtlTab ref, const char *entry, Obj *val)
1170 {
1171     return extl_table_set(ref, 's', 'o', entry, val);
1172 }
1173
1174 bool extl_table_sets_i(ExtlTab ref, const char *entry, int val)
1175 {
1176     return extl_table_set(ref, 's', 'i', entry, val);
1177 }
1178
1179 bool extl_table_sets_d(ExtlTab ref, const char *entry, double val)
1180 {
1181     return extl_table_set(ref, 's', 'd', entry, val);
1182 }
1183
1184 bool extl_table_sets_b(ExtlTab ref, const char *entry, bool val)
1185 {
1186     return extl_table_set(ref, 's', 'b', entry, val);
1187 }
1188
1189 bool extl_table_sets_s(ExtlTab ref, const char *entry, const char *val)
1190 {
1191     return extl_table_set(ref, 's', 'S', entry, val);
1192 }
1193
1194 bool extl_table_sets_f(ExtlTab ref, const char *entry, ExtlFn val)
1195 {
1196     return extl_table_set(ref, 's', 'f', entry, val);
1197 }
1198
1199 bool extl_table_sets_t(ExtlTab ref, const char *entry, ExtlTab val)
1200 {
1201     return extl_table_set(ref, 's', 't', entry, val);
1202 }
1203
1204
1205 bool extl_table_seti_o(ExtlTab ref, int entry, Obj *val)
1206 {
1207     return extl_table_set(ref, 'i', 'o', entry, val);
1208 }
1209
1210 bool extl_table_seti_i(ExtlTab ref, int entry, int val)
1211 {
1212     return extl_table_set(ref, 'i', 'i', entry, val);
1213 }
1214
1215 bool extl_table_seti_d(ExtlTab ref, int entry, double val)
1216 {
1217     return extl_table_set(ref, 'i', 'd', entry, val);
1218 }
1219
1220 bool extl_table_seti_b(ExtlTab ref, int entry, bool val)
1221 {
1222     return extl_table_set(ref, 'i', 'b', entry, val);
1223 }
1224
1225 bool extl_table_seti_s(ExtlTab ref, int entry, const char *val)
1226 {
1227     return extl_table_set(ref, 'i', 'S', entry, val);
1228 }
1229
1230 bool extl_table_seti_f(ExtlTab ref, int entry, ExtlFn val)
1231 {
1232     return extl_table_set(ref, 'i', 'f', entry, val);
1233 }
1234
1235 bool extl_table_seti_t(ExtlTab ref, int entry, ExtlTab val)
1236 {
1237     return extl_table_set(ref, 'i', 't', entry, val);
1238 }
1239
1240
1241 /*}}}*/
1242
1243
1244 /*{{{ Table/clear entry */
1245
1246
1247 static bool extl_table_dodo_clear2(lua_State *st, TableParams2 *params)
1248 {
1249     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1250     extl_stack_push_vararg(st, params->itype, params->argsp);
1251     lua_pushnil(st);
1252     lua_rawset_check(st, -3);
1253     return TRUE;
1254 }
1255
1256 bool extl_table_clear_vararg(ExtlTab ref, char itype, va_list *args)
1257 {
1258     TableParams2 params;
1259
1260     params.ref=ref;
1261     params.itype=itype;
1262     /*params.type='?';*/
1263     params.argsp=args;
1264
1265     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_clear2, &params);
1266 }
1267
1268 bool extl_table_clear(ExtlTab ref, char itype, ...)
1269 {
1270     va_list args;
1271     bool retval;
1272
1273     va_start(args, itype);
1274     retval=extl_table_clear_vararg(ref, itype, &args);
1275     va_end(args);
1276
1277     return retval;
1278 }
1279
1280
1281 bool extl_table_clears(ExtlTab ref, const char *entry)
1282 {
1283     return extl_table_clear(ref, 's', entry);
1284 }
1285
1286 bool extl_table_cleari(ExtlTab ref, int entry)
1287 {
1288     return extl_table_clear(ref, 'i', entry);
1289 }
1290
1291
1292
1293 /*}}}*/
1294
1295
1296 /*{{{ Function calls to Lua */
1297
1298
1299 static bool extl_push_args(lua_State *st, const char *spec, va_list *argsp)
1300 {
1301     int i=1;
1302
1303     while(*spec!='\0'){
1304         if(!extl_stack_push_vararg(st, *spec, argsp))
1305             return FALSE;
1306         i++;
1307         spec++;
1308     }
1309
1310     return TRUE;
1311 }
1312
1313
1314 typedef struct{
1315     const char *spec;
1316     const char *rspec;
1317     va_list *args;
1318     void *misc;
1319     int nret;
1320 #ifndef CF_HAS_VA_COPY
1321     void *ret_ptrs[MAX_PARAMS];
1322 #endif
1323 } ExtlDoCallParam;
1324
1325
1326 static bool extl_get_retvals(lua_State *st, int m, ExtlDoCallParam *param)
1327 {
1328     void *ptr;
1329     const char *spec=param->rspec;
1330
1331 #ifdef CF_HAS_VA_COPY
1332     va_list args;
1333     va_copy(args, *(param->args));
1334 #else
1335     if(m>MAX_PARAMS){
1336         extl_warn(TR("Too many return values. Use a C compiler that has "
1337                      "va_copy to support more."));
1338         return FALSE;
1339     }
1340 #endif
1341
1342     while(m>0){
1343         bool dead=FALSE;
1344 #ifdef CF_HAS_VA_COPY
1345         ptr=va_arg(args, void*);
1346 #else
1347         ptr=va_arg(*(param->args), void*);
1348         param->ret_ptrs[param->nret]=ptr;
1349 #endif
1350         if(!extl_stack_get(st, -m, *spec, TRUE, &dead, ptr)){
1351             /* This is the only place where we allow nil-objects */
1352             /*if(*spec=='o' && lua_isnil(st, -m)){
1353                 *(Obj**)ptr=NULL;
1354             }else*/
1355             if(dead){
1356                 extl_warn(TR("Returned dead object."));
1357                 return FALSE;
1358             }else{
1359                 extl_warn(TR("Invalid return value (expected '%c', "
1360                              "got lua type \"%s\")."),
1361                      *spec, lua_typename(st, lua_type(st, -m)));
1362                 return FALSE;
1363             }
1364         }
1365
1366         (param->nret)++;
1367         spec++;
1368         m--;
1369     }
1370
1371 #ifdef CF_HAS_VA_COPY
1372     va_end(args);
1373 #endif
1374
1375     return TRUE;
1376 }
1377
1378
1379 /* The function to be called is expected on the top of stack st.
1380  * This function should be cpcalled through extl_cpcall_call (below), which
1381  * will take care that we don't leak anything in case of error.
1382  */
1383 static bool extl_dodo_call_vararg(lua_State *st, ExtlDoCallParam *param)
1384 {
1385     bool ret=TRUE;
1386     int n=0, m=0;
1387
1388     if(lua_isnil(st, -1))
1389         return FALSE;
1390
1391     if(param->spec!=NULL)
1392         n=strlen(param->spec);
1393
1394     if(!lua_checkstack(st, n+8)){
1395         extl_warn(TR("Stack full."));
1396         return FALSE;
1397     }
1398
1399     if(n>0){
1400         if(!extl_push_args(st, param->spec, param->args))
1401             return FALSE;
1402     }
1403
1404     if(param->rspec!=NULL)
1405         m=strlen(param->rspec);
1406
1407     flushtrace();
1408
1409     if(lua_pcall(st, n, m, 0)!=0){
1410         extl_warn("%s", lua_tostring(st, -1));
1411         return FALSE;
1412     }
1413
1414     if(m>0)
1415         return extl_get_retvals(st, m, param);
1416
1417     return TRUE;
1418 }
1419
1420
1421 static bool extl_cpcall_call(lua_State *st, ExtlCPCallFn *fn,
1422                              ExtlDoCallParam *param)
1423 {
1424     void *ptr;
1425     int i;
1426
1427     param->nret=0;
1428
1429     if(extl_cpcall(st, fn, param))
1430         return TRUE;
1431
1432     /* If param.nret>0, there was an error getting some return value and
1433      * we must free what we got.
1434      */
1435
1436     for(i=0; i<param->nret; i++){
1437 #ifdef CF_HAS_VA_COPY
1438         ptr=va_arg(*(param->args), void*);
1439 #else
1440         ptr=param->ret_ptrs[i];
1441 #endif
1442         extl_free(ptr, *(param->rspec+i), STRINGS_ALL);
1443     }
1444
1445     return FALSE;
1446 }
1447
1448
1449 static bool extl_do_call_vararg(lua_State *st, ExtlDoCallParam *param)
1450 {
1451     if(!extl_getref(st, *(ExtlFn*)(param->misc)))
1452         return FALSE;
1453     return extl_dodo_call_vararg(st, param);
1454 }
1455
1456
1457 bool extl_call_vararg(ExtlFn fnref, const char *spec,
1458                       const char *rspec, va_list *args)
1459 {
1460     ExtlDoCallParam param;
1461
1462     if(fnref==LUA_NOREF || fnref==LUA_REFNIL)
1463         return FALSE;
1464
1465     param.spec=spec;
1466     param.rspec=rspec;
1467     param.args=args;
1468     param.misc=(void*)&fnref;
1469
1470     return extl_cpcall_call(l_st, (ExtlCPCallFn*)extl_do_call_vararg, &param);
1471 }
1472
1473
1474 bool extl_call(ExtlFn fnref, const char *spec, const char *rspec, ...)
1475 {
1476     bool retval;
1477     va_list args;
1478
1479     va_start(args, rspec);
1480     retval=extl_call_vararg(fnref, spec, rspec, &args);
1481     va_end(args);
1482
1483     return retval;
1484 }
1485
1486
1487 /*}}}*/
1488
1489
1490 /*{{{ extl_loadfile/string */
1491
1492
1493 static int call_loaded(lua_State *st)
1494 {
1495     int i, nargs=lua_gettop(st);
1496
1497     /* Get the loaded file/string as function */
1498     lua_pushvalue(st, lua_upvalueindex(1));
1499
1500     /* Fill 'arg' */
1501     lua_getfenv(st, -1);
1502     lua_pushstring(st, "arg");
1503
1504     if(nargs>0){
1505         lua_newtable(st);
1506         for(i=1; i<=nargs; i++){
1507             lua_pushvalue(st, i);
1508             lua_rawseti_check(st, -2, i);
1509         }
1510     }else{
1511         lua_pushnil(st);
1512     }
1513
1514     lua_rawset_check(st, -3);
1515     lua_pop(st, 1);
1516     lua_call(st, 0, LUA_MULTRET);
1517     return (lua_gettop(st)-nargs);
1518 }
1519
1520
1521 typedef struct{
1522     const char *src;
1523     bool isfile;
1524     ExtlFn *resptr;
1525 } ExtlLoadParam;
1526
1527
1528 static bool extl_do_load(lua_State *st, ExtlLoadParam *param)
1529 {
1530     int res=0;
1531
1532     if(param->isfile){
1533         res=luaL_loadfile(st, param->src);
1534     }else{
1535         res=luaL_loadbuffer(st, param->src, strlen(param->src), param->src);
1536     }
1537
1538     if(res!=0){
1539         extl_warn("%s", lua_tostring(st, -1));
1540         return FALSE;
1541     }
1542
1543     lua_newtable(st); /* Create new environment */
1544     /* Now there's fn, newenv in stack */
1545     lua_newtable(st); /* Create metatable */
1546     lua_pushstring(st, "__index");
1547     lua_getfenv(st, -4); /* Get old environment */
1548     lua_rawset_check(st, -3); /* Set metatable.__index */
1549     lua_pushstring(st, "__newindex");
1550     lua_getfenv(st, -4); /* Get old environment */
1551     lua_rawset_check(st, -3); /* Set metatable.__newindex */
1552     /* Now there's fn, newenv, meta in stack */
1553     lua_setmetatable(st, -2); /* Set metatable for new environment */
1554     lua_setfenv(st, -2);
1555     /* Now there should be just fn in stack */
1556
1557     /* Callloaded will put any parameters it gets in the table 'arg' in
1558      * the newly created environment.
1559      */
1560     lua_pushcclosure(st, call_loaded, 1);
1561     *(param->resptr)=lua_ref(st, -1);
1562
1563     return TRUE;
1564 }
1565
1566
1567 bool extl_loadfile(const char *file, ExtlFn *ret)
1568 {
1569     ExtlLoadParam param;
1570     param.src=file;
1571     param.isfile=TRUE;
1572     param.resptr=ret;
1573
1574     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_load, &param);
1575 }
1576
1577
1578 bool extl_loadstring(const char *str, ExtlFn *ret)
1579 {
1580     ExtlLoadParam param;
1581     param.src=str;
1582     param.isfile=FALSE;
1583     param.resptr=ret;
1584
1585     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_load, &param);
1586 }
1587
1588
1589 /*}}}*/
1590
1591
1592 /*{{{ L1 CH error logging */
1593
1594 #ifdef EXTL_LOG_ERRORS
1595
1596 INTRSTRUCT(WarnChain);
1597 DECLSTRUCT(WarnChain){
1598     bool need_trace;
1599     lua_State *st;
1600     WarnHandler *old_handler;
1601     WarnChain *prev;
1602 };
1603
1604
1605 static WarnChain *warnchain=NULL;
1606 static int notrace=0;
1607
1608
1609 static void l1_warn_handler(const char *message)
1610 {
1611     WarnChain *ch=warnchain;
1612     static int called=0;
1613
1614     assert(warnchain!=NULL);
1615
1616     if(called==0 && notrace==0)
1617         ch->need_trace=TRUE;
1618
1619     called++;
1620     warnchain=ch->prev;
1621     ch->old_handler(message);
1622     warnchain=ch;
1623     called--;
1624 }
1625
1626
1627 static void do_trace(WarnChain *ch)
1628 {
1629     const char *p;
1630
1631     if(notrace!=0)
1632         return;
1633
1634     extl_stack_trace(ch->st);
1635     p=lua_tostring(ch->st, -1);
1636     notrace++;
1637     extl_warn(p);
1638     notrace--;
1639     ch->need_trace=FALSE;
1640     lua_pop(ch->st, 1);
1641 }
1642
1643 static void flushtrace()
1644 {
1645     if(warnchain && warnchain->need_trace)
1646         do_trace(warnchain);
1647 }
1648
1649 #endif
1650
1651 /*}}}*/
1652
1653
1654 /*{{{ L1-CH safe functions */
1655
1656
1657 static int protect_count=0;
1658 static ExtlSafelist *safelists=NULL;
1659
1660
1661 void extl_protect(ExtlSafelist *l)
1662 {
1663     protect_count++;
1664     if(l!=NULL){
1665         if(l->count==0){
1666             LINK_ITEM(safelists, l, next, prev);
1667         }
1668         l->count++;
1669     }
1670 }
1671
1672
1673 void extl_unprotect(ExtlSafelist *l)
1674 {
1675     assert(protect_count>0);
1676     protect_count--;
1677
1678     if(l!=NULL){
1679         assert(l->count>0);
1680         l->count--;
1681         if(l->count==0){
1682             UNLINK_ITEM(safelists, l, next, prev);
1683         }
1684     }
1685 }
1686
1687
1688 static bool extl_check_protected(ExtlExportedFnSpec *spec)
1689 {
1690     ExtlSafelist *l;
1691     bool ok=FALSE;
1692     int j;
1693
1694     if(protect_count>0 && !spec->safe){
1695         for(l=safelists; l!=NULL; l=l->next){
1696             ok=TRUE;
1697             for(j=0; l->list[j]!=NULL; j++){
1698                 if(l->list[j]==spec->fn)
1699                     break;
1700             }
1701             if(l->list[j]==NULL){
1702                 ok=FALSE;
1703                 break;
1704             }
1705         }
1706     }else{
1707         ok=TRUE;
1708     }
1709
1710     return ok;
1711 }
1712
1713
1714 /*}}}*/
1715
1716
1717 /*{{{ L1 call handler */
1718
1719 /* To get around potential memory leaks and corruption that could be caused
1720  * by Lua's longjmp-on-error lameness, The L1 call handler is divided into
1721  * two steps. In the first step we first setup a call to the second step.
1722  * At this point it is still fine if Lua raises an error. Then we set up
1723  * our warning handlers and stuff--at which point Lua's raising an error
1724  * would corrupt our data--and finally call the second step with lua_pcall.
1725  * Now the second step can safely call Lua's functions and do what is needed.
1726  * When the second step returns, we deallocate our data in the L1Param
1727  * structure that was passed to the second step and reset warning handlers.
1728  * After that it is again safe to call Lua's functions.
1729  */
1730
1731 typedef struct{
1732     ExtlL2Param ip[MAX_PARAMS];
1733     ExtlL2Param op[MAX_PARAMS];
1734     ExtlExportedFnSpec *spec;
1735     int ii, ni,  no;
1736 } L1Param;
1737
1738 static L1Param *current_param=NULL;
1739
1740
1741 static int extl_l1_call_handler2(lua_State *st)
1742 {
1743     L1Param *param=current_param;
1744     ExtlExportedFnSpec *spec=param->spec;
1745     int i;
1746
1747     D(fprintf(stderr, "%s called\n", spec->name));
1748
1749     if(!lua_checkstack(st, MAX_PARAMS+1)){
1750         extl_warn(TR("Stack full."));
1751         return 0;
1752     }
1753
1754     param->ni=(spec->ispec==NULL ? 0 : strlen(spec->ispec));
1755
1756     for(i=0; i<param->ni; i++){
1757         bool dead=FALSE;
1758         if(!extl_stack_get(st, i+1, spec->ispec[i], FALSE, &dead,
1759                            (void*)&(param->ip[i]))){
1760             if(dead){
1761                 extl_warn(TR("Argument %d to %s is a dead object."),
1762                           i+1, spec->name);
1763             }else{
1764                 extl_warn(TR("Argument %d to %s is of invalid type. "
1765                              "(Argument template is '%s', got lua type %s)."),
1766                           i+1, spec->name, spec->ispec,
1767                           lua_typename(st, lua_type(st, i+1)));
1768             }
1769             return 0;
1770         }
1771
1772         param->ii=i+1;
1773     }
1774
1775     if(spec->untraced)
1776         notrace++;
1777
1778     if(!spec->l2handler(spec->fn, param->ip, param->op))
1779         return 0;
1780
1781     if(spec->untraced)
1782         notrace--;
1783
1784     param->no=(spec->ospec==NULL ? 0 : strlen(spec->ospec));
1785
1786     for(i=0; i<param->no; i++)
1787         extl_stack_push(st, spec->ospec[i], (void*)&(param->op[i]));
1788
1789     return param->no;
1790 }
1791
1792
1793 static void extl_l1_finalize(L1Param *param)
1794 {
1795     ExtlExportedFnSpec *spec=param->spec;
1796     int i;
1797
1798     for(i=0; i<param->ii; i++)
1799         extl_free((void*)&(param->ip[i]), spec->ispec[i], STRINGS_NONE);
1800
1801     for(i=0; i<param->no; i++)
1802         extl_free((void*)&(param->op[i]), spec->ospec[i], STRINGS_NONCONST);
1803 }
1804
1805
1806
1807 static bool extl_l1_just_check_protected=FALSE;
1808
1809
1810 static int extl_l1_call_handler(lua_State *st)
1811 {
1812 #ifdef EXTL_LOG_ERRORS
1813     WarnChain ch;
1814 #endif
1815     L1Param param={{NULL, }, {NULL, }, NULL, 0, 0, 0};
1816     L1Param *old_param;
1817     int ret;
1818     int n=lua_gettop(st);
1819
1820
1821     /* Get the info we need on the function, check it's ok, and then set
1822      * up a safe environment for extl_l1_call_handler2.
1823      */
1824     param.spec=(ExtlExportedFnSpec*)lua_touserdata(st, lua_upvalueindex(1));
1825
1826     if(param.spec==NULL){
1827         extl_warn(TR("L1 call handler upvalues corrupt."));
1828         return 0;
1829     }
1830
1831     if(!param.spec->registered){
1832         extl_warn(TR("Called function has been unregistered."));
1833         return 0;
1834     }
1835
1836     if(extl_l1_just_check_protected){
1837         /* Just checking whether the function may be called. */
1838         lua_pushboolean(st, !extl_check_protected(param.spec));
1839         return 1;
1840     }
1841
1842     if(!extl_check_protected(param.spec)){
1843         extl_warn(TR("Attempt to call an unsafe function \"%s\" in "
1844                      "restricted mode."), param.spec->name);
1845         return 0;
1846     }
1847
1848
1849     lua_pushcfunction(st, extl_l1_call_handler2);
1850     lua_insert(st, 1);
1851
1852     old_param=current_param;
1853     current_param=&param;
1854
1855 #ifdef EXTL_LOG_ERRORS
1856     ch.old_handler=set_warn_handler(l1_warn_handler);
1857     ch.need_trace=FALSE;
1858     ch.st=st;
1859     ch.prev=warnchain;
1860     warnchain=&ch;
1861 #endif
1862
1863     /* Ok, Lua may now freely fail in extl_l1_call_handler2, we can handle
1864      * that.
1865      */
1866     ret=lua_pcall(st, n, LUA_MULTRET, 0);
1867
1868     /* Now that the actual call handler has returned, we need to free
1869      * any of our data before calling Lua again.
1870      */
1871     current_param=old_param;
1872     extl_l1_finalize(&param);
1873
1874 #ifdef EXTL_LOG_ERRORS
1875     warnchain=ch.prev;
1876     set_warn_handler(ch.old_handler);
1877
1878     /* Ok, we can now safely use Lua functions again without fear of
1879      * leaking.
1880      */
1881     if(ret!=0){
1882         const char *p;
1883         param.no=0;
1884         p=lua_tostring(st, -1);
1885         notrace++;
1886         extl_warn("%s", p);
1887         notrace--;
1888     }
1889
1890     if(ret!=0 || ch.need_trace)
1891         do_trace(&ch);
1892 #else
1893     if(ret!=0)
1894         lua_error(st);
1895 #endif
1896
1897     return param.no;
1898 }
1899
1900
1901 /*EXTL_DOC
1902  * Is calling the function \var{fn} not allowed now? If \var{fn} is nil,
1903  * tells if some functions are not allowed to be called now due to
1904  * protected mode.
1905  */
1906 EXTL_EXPORT_AS(global, protected)
1907 bool __protected(ExtlFn fn);
1908
1909 static int extl_protected(lua_State *st)
1910 {
1911     int ret;
1912
1913     if(lua_isnil(st, 1)){
1914         lua_pushboolean(st, protect_count>0);
1915         return 1;
1916     }
1917
1918     if(!lua_isfunction(st, 1)){
1919         lua_pushboolean(st, TRUE);
1920         return 1;
1921     }
1922
1923     if(lua_tocfunction(st, 1)!=(lua_CFunction)extl_l1_call_handler){
1924         lua_pushboolean(st, FALSE);
1925         return 1;
1926     }
1927
1928     extl_l1_just_check_protected=TRUE;
1929     ret=lua_pcall(st, 0, 1, 0);
1930     extl_l1_just_check_protected=FALSE;
1931     if(ret!=0)
1932         lua_pushboolean(st, TRUE);
1933     return 1;
1934 }
1935
1936 /*}}}*/
1937
1938
1939 /*{{{ Function registration */
1940
1941
1942 typedef struct{
1943     ExtlExportedFnSpec *spec;
1944     const char *cls;
1945     ExtlTab table;
1946 } RegData;
1947
1948
1949 static bool extl_do_register_function(lua_State *st, RegData *data)
1950 {
1951     ExtlExportedFnSpec *spec=data->spec, *spec2;
1952     int ind=LUA_GLOBALSINDEX;
1953
1954     if((spec->ispec!=NULL && strlen(spec->ispec)>MAX_PARAMS) ||
1955        (spec->ospec!=NULL && strlen(spec->ospec)>MAX_PARAMS)){
1956         extl_warn(TR("Function '%s' has more parameters than the level 1 "
1957                      "call handler can handle"), spec->name);
1958         return FALSE;
1959     }
1960
1961     if(data->table!=LUA_NOREF){
1962         lua_rawgeti(st, LUA_REGISTRYINDEX, data->table);
1963         ind=-3;
1964     }
1965
1966     lua_pushstring(st, spec->name);
1967
1968     lua_pushlightuserdata(st, spec);
1969     lua_pushcclosure(st, extl_l1_call_handler, 1);
1970
1971     lua_rawset_check(st, ind);
1972
1973     return TRUE;
1974 }
1975
1976
1977 static bool extl_do_register_functions(ExtlExportedFnSpec *spec, int max,
1978                                        const char *cls, int table)
1979 {
1980     int i;
1981
1982     RegData regdata;
1983     regdata.spec=spec;
1984     regdata.cls=cls;
1985     regdata.table=table;
1986
1987     for(i=0; spec[i].name && i<max; i++){
1988         regdata.spec=&(spec[i]);
1989         if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_function,
1990                         &regdata)){
1991             return FALSE;
1992         }
1993         spec[i].registered=TRUE;
1994     }
1995
1996     return TRUE;
1997 }
1998
1999
2000 bool extl_register_function(ExtlExportedFnSpec *spec)
2001 {
2002     return extl_do_register_functions(spec, 1, "", LUA_NOREF);
2003 }
2004
2005
2006 bool extl_register_functions(ExtlExportedFnSpec *spec)
2007 {
2008     return extl_do_register_functions(spec, INT_MAX, "", LUA_NOREF);
2009 }
2010
2011
2012 static bool extl_do_unregister_function(lua_State *st, RegData *data)
2013 {
2014     ExtlExportedFnSpec *spec=data->spec;
2015     int ind=LUA_GLOBALSINDEX;
2016
2017     if(data->table!=LUA_NOREF){
2018         lua_rawgeti(st, LUA_REGISTRYINDEX, data->table);
2019         ind=-3;
2020     }
2021
2022     /* Clear table.fn */
2023     lua_pushstring(st, spec->name);
2024     lua_pushnil(st);
2025     lua_rawset_check(st, ind);
2026
2027     return TRUE;
2028 }
2029
2030
2031 static void extl_do_unregister_functions(ExtlExportedFnSpec *spec, int max,
2032                                          const char *cls, int table)
2033 {
2034     int i;
2035
2036     RegData regdata;
2037     regdata.spec=spec;
2038     regdata.cls=cls;
2039     regdata.table=table;
2040
2041     for(i=0; spec[i].name && i<max; i++){
2042         regdata.spec=&(spec[i]);
2043         extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_function,
2044                     &regdata);
2045         spec[i].registered=FALSE;
2046     }
2047 }
2048
2049 void extl_unregister_function(ExtlExportedFnSpec *spec)
2050 {
2051     extl_do_unregister_functions(spec, 1, "", LUA_NOREF);
2052 }
2053
2054
2055 void extl_unregister_functions(ExtlExportedFnSpec *spec)
2056 {
2057     extl_do_unregister_functions(spec, INT_MAX, "", LUA_NOREF);
2058 }
2059
2060
2061 /*}}}*/
2062
2063
2064 /*{{{ Class registration */
2065
2066
2067 typedef struct{
2068     const char *cls, *parent;
2069     int refret;
2070     bool hide;
2071 } ClassData;
2072
2073
2074 static bool extl_do_register_class(lua_State *st, ClassData *data)
2075 {
2076     /* Create the globally visible WFoobar table in which the function
2077      * references reside.
2078      */
2079     lua_newtable(st);
2080
2081     /* Set type information.
2082      */
2083     lua_pushstring(st, "__typename");
2084     lua_pushstring(st, data->cls);
2085     lua_settable(st, -3);
2086
2087     /* If we have a parent class (i.e. class!=Obj), we want also the parent's
2088      * functions visible in this table so set up a metatable to do so.
2089      */
2090     if(data->parent!=NULL){
2091         /* Get luaextl_ParentClass_metatable */
2092         lua_pushfstring(st, "luaextl_%s_metatable", data->parent);
2093         lua_gettable(st, LUA_REGISTRYINDEX);
2094         if(!lua_istable(st, -1)){
2095             extl_warn("Could not find metatable for parent class %s of %s.\n",
2096                       data->parent, data->cls);
2097             return FALSE;
2098         }
2099         /* Create our metatable */
2100         lua_newtable(st);
2101         /* Get parent_metatable.__index */
2102         lua_pushstring(st, "__index");
2103         lua_pushvalue(st, -1);
2104         /* Stack: cls, parent_meta, meta, "__index", "__index" */
2105         lua_gettable(st, -4);
2106         /* Stack: cls, parent_meta, meta, "__index", parent_meta.__index */
2107         lua_pushvalue(st, -1);
2108         lua_insert(st, -3);
2109         /* Stack: cls, parent_meta, meta, parent_meta.__index, "__index", parent_meta.__index */
2110         lua_rawset_check(st, -4);
2111         /* Stack: cls, parent_meta, meta, parent_meta.__index */
2112         lua_pushstring(st, "__parentclass");
2113         lua_insert(st, -2);
2114         /* Stack: cls, parent_meta, meta, "__parentclass", parent_meta.__index */
2115         lua_settable(st, -5);
2116         /* Stack: cls, parent_meta, meta, */
2117         lua_setmetatable(st, -3);
2118         lua_pop(st, 1);
2119         /* Stack: cls */
2120     }
2121
2122     /* Set the global WFoobar */
2123     lua_pushvalue(st, -1);
2124     data->refret=lua_ref(st, 1); /* TODO: free on failure */
2125     if(!data->hide){
2126         lua_pushstring(st, data->cls);
2127         lua_pushvalue(st, -2);
2128         lua_rawset(st, LUA_GLOBALSINDEX);
2129     }
2130
2131     /* New we create a metatable for the actual objects with __gc metamethod
2132      * and __index pointing to the table created above. The MAGIC entry is
2133      * used to check that userdatas passed to us really are Watches with a
2134      * high likelihood.
2135      */
2136     lua_newtable(st);
2137
2138     lua_pushnumber(st, MAGIC);
2139     lua_pushnumber(st, MAGIC);
2140     lua_rawset_check(st, -3);
2141
2142     lua_pushstring(st, "__index");
2143     lua_pushvalue(st, -3);
2144     lua_rawset_check(st, -3); /* set metatable.__index=WFoobar created above */
2145     lua_pushstring(st, "__gc");
2146     lua_pushcfunction(st, extl_obj_gc_handler);
2147     lua_rawset_check(st, -3); /* set metatable.__gc=extl_obj_gc_handler */
2148     lua_pushfstring(st, "luaextl_%s_metatable", data->cls);
2149     lua_insert(st, -2);
2150     lua_rawset(st, LUA_REGISTRYINDEX);
2151
2152     return TRUE;
2153 }
2154
2155
2156 bool extl_register_class(const char *cls, ExtlExportedFnSpec *fns,
2157                          const char *parent)
2158 {
2159     ClassData clsdata;
2160     clsdata.cls=cls;
2161     clsdata.parent=parent;
2162     clsdata.refret=LUA_NOREF;
2163     clsdata.hide=(strcmp(cls, "Obj")==0);/*(fns==NULL);*/
2164
2165     D(assert(strcmp(cls, "Obj")==0 || parent!=NULL));
2166
2167     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_class, &clsdata))
2168         return FALSE;
2169
2170     if(fns==NULL)
2171         return TRUE;
2172
2173     return extl_do_register_functions(fns, INT_MAX, cls, clsdata.refret);
2174 }
2175
2176
2177 static void extl_do_unregister_class(lua_State *st, ClassData *data)
2178 {
2179     /* Get reference from registry to the metatable. */
2180     lua_pushfstring(st, "luaextl_%s_metatable", data->cls);
2181     lua_pushvalue(st, -1);
2182     lua_gettable(st, LUA_REGISTRYINDEX);
2183     /* Get __index and return it for resetting the functions. */
2184     lua_pushstring(st, "__index");
2185     lua_gettable(st, -2);
2186     data->refret=lua_ref(st, -1);
2187     lua_pop(st, 1);
2188     /* Set the entry from registry to nil. */
2189     lua_pushnil(st);
2190     lua_rawset(st, LUA_REGISTRYINDEX);
2191
2192     /* Reset the global reference to the class to nil. */
2193     lua_pushstring(st, data->cls);
2194     lua_pushnil(st);
2195     lua_rawset(st, LUA_GLOBALSINDEX);
2196 }
2197
2198
2199 void extl_unregister_class(const char *cls, ExtlExportedFnSpec *fns)
2200 {
2201     ClassData clsdata;
2202     clsdata.cls=cls;
2203     clsdata.parent=NULL;
2204     clsdata.refret=LUA_NOREF;
2205     clsdata.hide=FALSE; /* unused, but initialise */
2206
2207     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_class,
2208                     &clsdata))
2209         return;
2210
2211     /* We still need to reset function upvalues. */
2212     if(fns!=NULL)
2213         extl_do_unregister_functions(fns, INT_MAX, cls, clsdata.refret);
2214 }
2215
2216
2217 /*}}}*/
2218
2219
2220 /*{{{ Module registration */
2221
2222
2223 static bool extl_do_register_module(lua_State *st, ClassData *clsdata)
2224 {
2225     lua_getglobal(st, clsdata->cls);
2226
2227     if(!lua_istable(st, -1)){
2228         lua_newtable(st);
2229         lua_pushvalue(st, -1);
2230         lua_setglobal(st, clsdata->cls);
2231     }
2232     lua_pushfstring(st, "luaextl_module_%s", clsdata->cls);
2233     lua_pushvalue(st, -2);
2234     lua_rawset(st, LUA_REGISTRYINDEX);
2235
2236     clsdata->refret=lua_ref(st, -1);
2237
2238     return TRUE;
2239 }
2240
2241
2242 bool extl_register_module(const char *mdl, ExtlExportedFnSpec *fns)
2243 {
2244     ClassData clsdata;
2245
2246     clsdata.cls=mdl;
2247     clsdata.parent=NULL;
2248     clsdata.refret=LUA_NOREF;
2249     clsdata.hide=FALSE; /* unused, but initialise */
2250
2251     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_module, &clsdata))
2252         return FALSE;
2253
2254     if(fns==NULL)
2255         return TRUE;
2256
2257     return extl_do_register_functions(fns, INT_MAX, mdl, clsdata.refret);
2258 }
2259
2260
2261 static bool extl_do_unregister_module(lua_State *st, ClassData *clsdata)
2262 {
2263     lua_pushfstring(st, "luaextl_module_%s", clsdata->cls);
2264     lua_pushvalue(st, -1);
2265     lua_pushnil(st);
2266     lua_rawset(st, LUA_REGISTRYINDEX);
2267     clsdata->refret=lua_ref(st, -1);
2268
2269     return TRUE;
2270 }
2271
2272
2273 void extl_unregister_module(const char *mdl, ExtlExportedFnSpec *fns)
2274 {
2275     ClassData clsdata;
2276
2277     clsdata.cls=mdl;
2278     clsdata.parent=NULL;
2279     clsdata.refret=LUA_NOREF;
2280     clsdata.hide=FALSE; /* unused, but initialise */
2281
2282     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_module, &clsdata))
2283         return;
2284
2285     if(fns!=NULL)
2286         extl_do_unregister_functions(fns, INT_MAX, mdl, clsdata.refret);
2287 }
2288
2289
2290 /*}}}*/
2291
2292
2293 /*{{{ Serialise */
2294
2295 typedef struct{
2296     FILE *f;
2297     ExtlTab tab;
2298 } SerData;
2299
2300
2301 static void write_escaped_string(FILE *f, const char *str)
2302 {
2303     fputc('"', f);
2304
2305     while(str && *str){
2306         if(((*str)&0x7f)<32 || *str=='"' || *str=='\\'){
2307             /* Lua uses decimal in escapes */
2308             fprintf(f, "\\%03d", (int)(uchar)(*str));
2309         }else{
2310             fputc(*str, f);
2311         }
2312         str++;
2313     }
2314
2315     fputc('"', f);
2316 }
2317
2318
2319 static void indent(FILE *f, int lvl)
2320 {
2321     int i;
2322     for(i=0; i<lvl; i++)
2323         fprintf(f, "    ");
2324 }
2325
2326
2327 static bool ser(lua_State *st, FILE *f, int lvl)
2328 {
2329
2330     lua_checkstack(st, 5);
2331
2332     switch(lua_type(st, -1)){
2333     case LUA_TBOOLEAN:
2334         fprintf(f, "%s", lua_toboolean(st, -1) ? "true" : "false");
2335         break;
2336     case LUA_TNUMBER:
2337         fprintf(f, "%s", lua_tostring(st, -1));
2338         break;
2339     case LUA_TNIL:
2340         fprintf(f, "nil");
2341         break;
2342     case LUA_TSTRING:
2343         write_escaped_string(f, lua_tostring(st, -1));
2344         break;
2345     case LUA_TTABLE:
2346         if(lvl+1>=EXTL_MAX_SERIALISE_DEPTH){
2347             extl_warn(TR("Maximal serialisation depth reached."));
2348             fprintf(f, "nil");
2349             lua_pop(st, 1);
2350             return FALSE;
2351         }
2352
2353         fprintf(f, "{\n");
2354         lua_pushnil(st);
2355         while(lua_next(st, -2)!=0){
2356             lua_pushvalue(st, -2);
2357             indent(f, lvl+1);
2358             fprintf(f, "[");
2359             ser(st, f, lvl+1);
2360             fprintf(f, "] = ");
2361             ser(st, f, lvl+1);
2362             fprintf(f, ",\n");
2363         }
2364         indent(f, lvl);
2365         fprintf(f, "}");
2366         break;
2367     default:
2368         extl_warn(TR("Unable to serialise type %s."),
2369                   lua_typename(st, lua_type(st, -1)));
2370     }
2371     lua_pop(st, 1);
2372     return TRUE;
2373 }
2374
2375
2376 static bool extl_do_serialise(lua_State *st, SerData *d)
2377 {
2378     if(!extl_getref(st, d->tab))
2379         return FALSE;
2380
2381     return ser(st, d->f, 0);
2382 }
2383
2384
2385 /* Tab must not contain recursive references! */
2386 extern bool extl_serialise(const char *file, ExtlTab tab)
2387 {
2388     SerData d;
2389     bool ret;
2390
2391     d.tab=tab;
2392     d.f=fopen(file, "w");
2393
2394     if(d.f==NULL){
2395         extl_warn_err_obj(file);
2396         return FALSE;
2397     }
2398
2399     fprintf(d.f, TR("-- This file has been generated by Ion. Do not edit.\n"));
2400     fprintf(d.f, "return ");
2401
2402     ret=extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_serialise, &d);
2403
2404     fprintf(d.f, "\n\n");
2405
2406     fclose(d.f);
2407
2408     return ret;
2409 }
2410
2411
2412 /*}}}*/
2413