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=='b'){
 654         if(valret)
 655             *((bool*)valret)=lua_toboolean(st, pos);
 656         return TRUE;
 657     }
 658
 659     switch(lua_type(st, pos)){
 660     case LUA_TNUMBER:
 661         if(type!='i' && type!='d' && type!='a')
 662             return FALSE;
 663
 664         d=lua_tonumber(st, pos);
 665
 666         if(type=='i'){
 667             if(d-floor(d)!=0)
 668                 return FALSE;
 669             if(valret)
 670                 *((int*)valret)=d;
 671         }else if(type=='a'){
 672             if(valret){
 673                 ((ExtlAny*)valret)->type='d';
 674                 ((ExtlAny*)valret)->value.d=d;
 675             }
 676         }else{
 677             if(valret)
 678                 *((double*)valret)=d;
 679         }
 680         return TRUE;
 681
 682     case LUA_TNIL:
 683     case LUA_TNONE:
 684         if(type=='a'){
 685             if(valret)
 686                 ((ExtlAny*)valret)->type='v';
 687         }else if(type=='t' || type=='f'){
 688             if(valret)
 689                 *((int*)valret)=LUA_NOREF;
 690         }else if(type=='s' || type=='S'){
 691             if(valret)
 692                 *((char**)valret)=NULL;
 693         }else if(type=='o'){
 694             if(valret)
 695                 *((Obj**)valret)=NULL;
 696         }else{
 697             return FALSE;
 698         }
 699         return TRUE;
 700
 701     case LUA_TSTRING:
 702         if(type!='s' && type!='S' && type!='a')
 703             return FALSE;
 704         if(valret){
 705             str=lua_tostring(st, pos);
 706             if(str!=NULL && copystring){
 707                 str=extl_scopy(str);
 708                 if(str==NULL)
 709                     return FALSE;
 710             }
 711             if(type=='a'){
 712                 ((ExtlAny*)valret)->type=(copystring ? 's' : 'S');
 713                 ((ExtlAny*)valret)->value.s=str;
 714             }else{
 715                 *((const char**)valret)=str;
 716             }
 717         }
 718         return TRUE;
 719
 720     case LUA_TFUNCTION:
 721         if(type!='f' && type!='a')
 722             return FALSE;
 723         if(valret){
 724             lua_pushvalue(st, pos);
 725             if(type=='a'){
 726                 ((ExtlAny*)valret)->type='f';
 727                 ((ExtlAny*)valret)->value.f=lua_ref(st, 1);
 728             }else{
 729                 *((int*)valret)=lua_ref(st, 1);
 730             }
 731         }
 732         return TRUE;
 733
 734     case LUA_TTABLE:
 735         if(type!='t' && type!='a')
 736             return FALSE;
 737         if(valret){
 738             lua_pushvalue(st, pos);
 739             if(type=='a'){
 740                 ((ExtlAny*)valret)->type='t';
 741                 ((ExtlAny*)valret)->value.f=lua_ref(st, 1);
 742             }else{
 743                 *((int*)valret)=lua_ref(st, 1);
 744             }
 745         }
 746         return TRUE;
 747
 748     case LUA_TUSERDATA:
 749         if(type=='o'|| type=='a'){
 750             bool invalid=FALSE, dead=FALSE;
 751             Obj *obj=extl_get_obj(st, pos, &invalid, &dead);
 752             if(wasdeadobject!=NULL)
 753                 *wasdeadobject=dead;
 754             if(valret){
 755                 if(type=='a'){
 756                     ((ExtlAny*)valret)->type='o';
 757                     ((ExtlAny*)valret)->value.o=obj;
 758                 }else{
 759                     *((Obj**)valret)=obj;
 760                 }
 761             }
 762             return !invalid;
 763         }
 764     }
 765
 766     return FALSE;
 767 }
 768
 769
 770 static void extl_to_any(ExtlAny *a, char type, void *ptr)
 771 {
 772     if(type=='a'){
 773         *a=*(ExtlAny*)ptr;
 774         return;
 775     }
 776
 777     a->type=type;
 778
 779     switch(type){
 780     case 'i': a->value.i=*(int*)ptr; break;
 781     case 'd': a->value.d=*(double*)ptr; break;
 782     case 'b': a->value.b=*(bool*)ptr; break;
 783     case 'o': a->value.o=*(Obj**)ptr; break;
 784     case 's':
 785     case 'S': a->value.s=*(char**)ptr; break;
 786     case 't': a->value.t=*(ExtlTab*)ptr; break;
 787     case 'f': a->value.f=*(ExtlFn*)ptr; break;
 788     }
 789 }
 790
 791
 792 static void extl_to_any_vararg(ExtlAny *a, char type, va_list *argsp)
 793 {
 794     if(type=='a'){
 795         *a=va_arg(*argsp, ExtlAny);
 796         return;
 797     }
 798
 799     a->type=type;
 800
 801     switch(type){
 802     case 'i': a->value.i=va_arg(*argsp, int); break;
 803     case 'd': a->value.d=va_arg(*argsp, double); break;
 804     case 'b': a->value.b=va_arg(*argsp, bool); break;
 805     case 'o': a->value.o=va_arg(*argsp, Obj*); break;
 806     case 's':
 807     case 'S': a->value.s=va_arg(*argsp, char*); break;
 808     case 't': a->value.t=va_arg(*argsp, ExtlTab); break;
 809     case 'f': a->value.f=va_arg(*argsp, ExtlFn); break;
 810     }
 811 }
 812
 813
 814 static void extl_stack_pusha(lua_State *st, ExtlAny *a)
 815 {
 816     switch(a->type){
 817     case 'i': lua_pushnumber(st, a->value.i); break;
 818     case 'd': lua_pushnumber(st, a->value.d); break;
 819     case 'b': lua_pushboolean(st, a->value.b); break;
 820     case 'o': extl_push_obj(st, a->value.o); break;
 821     case 's':
 822     case 'S': lua_pushstring(st, a->value.s); break;
 823     case 't': lua_rawgeti(st, LUA_REGISTRYINDEX, a->value.t); break;
 824     case 'f': lua_rawgeti(st, LUA_REGISTRYINDEX, a->value.f); break;
 825     default: lua_pushnil(st);
 826     }
 827 }
 828
 829
 830 static void extl_stack_push(lua_State *st, char spec, void *ptr)
 831 {
 832     ExtlAny a;
 833
 834     extl_to_any(&a, spec, ptr);
 835     extl_stack_pusha(st, &a);
 836 }
 837
 838
 839 static bool extl_stack_push_vararg(lua_State *st, char spec, va_list *argsp)
 840 {
 841     ExtlAny a;
 842
 843     extl_to_any_vararg(&a, spec, argsp);
 844     extl_stack_pusha(st, &a);
 845
 846     return TRUE;
 847 }
 848
 849
 850 /*}}}*/
 851
 852
 853 /*{{{ Free */
 854
 855
 856 enum{STRINGS_NONE, STRINGS_NONCONST, STRINGS_ALL};
 857
 858
 859 static void extl_any_free(ExtlAny *a, int strings)
 860 {
 861     if((a->type=='s' && strings!=STRINGS_NONE) ||
 862        (a->type=='S' && strings==STRINGS_ALL)){
 863         if(a->value.s!=NULL)
 864             free((char*)a->value.s);
 865     }else if(a->type=='t'){
 866         extl_unref_table(a->value.t);
 867     }else if(a->type=='f'){
 868         extl_unref_fn(a->value.f);
 869     }
 870 }
 871
 872
 873 static void extl_free(void *ptr, char spec, int strings)
 874 {
 875     ExtlAny a;
 876
 877     extl_to_any(&a, spec, ptr);
 878     extl_any_free(&a, strings);
 879 }
 880
 881
 882 /*}}}*/
 883
 884
 885 /*{{{ Table and function references. */
 886
 887
 888 static bool extl_getref(lua_State *st, int ref)
 889 {
 890     lua_rawgeti(st, LUA_REGISTRYINDEX, ref);
 891     if(lua_isnil(st, -1)){
 892         lua_pop(st, 1);
 893         return FALSE;
 894     }
 895     return TRUE;
 896 }
 897
 898 /* Unref */
 899
 900 static bool extl_do_unref(lua_State *st, int *refp)
 901 {
 902     lua_unref(st, *refp);
 903     return TRUE;
 904 }
 905
 906
 907 ExtlFn extl_unref_fn(ExtlFn ref)
 908 {
 909     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unref, &ref);
 910     return LUA_NOREF;
 911 }
 912
 913
 914 ExtlFn extl_unref_table(ExtlTab ref)
 915 {
 916     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unref, &ref);
 917     return LUA_NOREF;
 918 }
 919
 920
 921 /* noref */
 922
 923 ExtlFn extl_fn_none()
 924 {
 925     return LUA_NOREF;
 926 }
 927
 928
 929 ExtlTab extl_table_none()
 930 {
 931     return LUA_NOREF;
 932 }
 933
 934
 935 /* ref */
 936
 937 static bool extl_do_ref(lua_State *st, int *refp)
 938 {
 939     if(!extl_getref(st, *refp))
 940         return FALSE;
 941     *refp=lua_ref(st, 1);
 942     return TRUE;
 943 }
 944
 945
 946 ExtlTab extl_ref_table(ExtlTab ref)
 947 {
 948     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_ref, &ref))
 949         return ref;
 950     return LUA_NOREF;
 951 }
 952
 953
 954 ExtlFn extl_ref_fn(ExtlFn ref)
 955 {
 956     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_ref, &ref))
 957         return ref;
 958     return LUA_NOREF;
 959 }
 960
 961
 962 /* create_table */
 963
 964 static bool extl_do_create_table(lua_State *st, int *refp)
 965 {
 966     lua_newtable(st);
 967     *refp=lua_ref(st, 1);
 968     return TRUE;
 969 }
 970
 971
 972 ExtlTab extl_create_table()
 973 {
 974     ExtlTab ref;
 975     if(extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_create_table, &ref))
 976         return ref;
 977     return LUA_NOREF;
 978 }
 979
 980
 981 /* eq */
 982
 983 typedef struct{
 984     int o1, o2;
 985     bool ret;
 986 } EqParams;
 987
 988
 989 static bool extl_do_eq(lua_State *st, EqParams *ep)
 990 {
 991     if(!extl_getref(st, ep->o1))
 992         return FALSE;
 993     if(!extl_getref(st, ep->o2))
 994         return FALSE;
 995     ep->ret=lua_equal(st, -1, -2);
 996     return TRUE;
 997 }
 998
 999
1000 bool extl_fn_eq(ExtlFn fn1, ExtlFn fn2)
1001 {
1002     EqParams ep;
1003     ep.o1=fn1;
1004     ep.o2=fn2;
1005     ep.ret=FALSE;
1006     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_eq, &ep);
1007     return ep.ret;
1008 }
1009
1010
1011 bool extl_table_eq(ExtlTab t1, ExtlTab t2)
1012 {
1013     EqParams ep;
1014     ep.o1=t1;
1015     ep.o2=t2;
1016     ep.ret=FALSE;
1017     extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_eq, &ep);
1018     return ep.ret;
1019 }
1020
1021
1022 /*}}}*/
1023
1024
1025 /*{{{ Table/get */
1026
1027
1028 typedef struct{
1029     ExtlTab ref;
1030     char type;
1031     char itype;
1032     va_list *argsp;
1033 } TableParams2;
1034
1035
1036 static bool extl_table_dodo_get2(lua_State *st, TableParams2 *params)
1037 {
1038     if(params->ref<0)
1039         return FALSE;
1040
1041     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1042     extl_stack_push_vararg(st, params->itype, params->argsp);
1043     lua_gettable(st, -2);
1044     if(lua_isnil(st, -1))
1045         return FALSE;
1046
1047     return extl_stack_get(st, -1, params->type, TRUE, NULL,
1048                           va_arg(*(params->argsp), void*));
1049 }
1050
1051
1052 bool extl_table_get_vararg(ExtlTab ref, char itype, char type, va_list *args)
1053 {
1054     TableParams2 params;
1055
1056     params.ref=ref;
1057     params.itype=itype;
1058     params.type=type;
1059     params.argsp=args;
1060
1061     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_get2, &params);
1062 }
1063
1064
1065 bool extl_table_get(ExtlTab ref, char itype, char type, ...)
1066 {
1067     va_list args;
1068     bool retval;
1069
1070     va_start(args, type);
1071     retval=extl_table_get_vararg(ref, itype, type, &args);
1072     va_end(args);
1073
1074     return retval;
1075 }
1076
1077
1078 static bool extl_table_do_gets(ExtlTab ref, const char *entry,
1079                                char type, void *valret)
1080 {
1081     return extl_table_get(ref, 's', type, entry, valret);
1082 }
1083
1084 bool extl_table_gets_a(ExtlTab ref, const char *entry, ExtlAny *ret)
1085 {
1086     return extl_table_do_gets(ref, entry, 'a', (void*)ret);
1087 }
1088
1089 bool extl_table_gets_o(ExtlTab ref, const char *entry, Obj **ret)
1090 {
1091     return extl_table_do_gets(ref, entry, 'o', (void*)ret);
1092 }
1093
1094 bool extl_table_gets_i(ExtlTab ref, const char *entry, int *ret)
1095 {
1096     return extl_table_do_gets(ref, entry, 'i', (void*)ret);
1097 }
1098
1099 bool extl_table_gets_d(ExtlTab ref, const char *entry, double *ret)
1100 {
1101     return extl_table_do_gets(ref, entry, 'd', (void*)ret);
1102 }
1103
1104 bool extl_table_gets_b(ExtlTab ref, const char *entry, bool *ret)
1105 {
1106     return extl_table_do_gets(ref, entry, 'b', (void*)ret);
1107 }
1108
1109 bool extl_table_gets_s(ExtlTab ref, const char *entry, char **ret)
1110 {
1111     return extl_table_do_gets(ref, entry, 's', (void*)ret);
1112 }
1113
1114 bool extl_table_gets_f(ExtlTab ref, const char *entry, ExtlFn *ret)
1115 {
1116     return extl_table_do_gets(ref, entry, 'f', (void*)ret);
1117 }
1118
1119 bool extl_table_gets_t(ExtlTab ref, const char *entry, ExtlTab *ret)
1120 {
1121     return extl_table_do_gets(ref, entry, 't', (void*)ret);
1122 }
1123
1124
1125 static bool extl_table_do_geti(ExtlTab ref, int entry, char type, void *valret)
1126 {
1127     return extl_table_get(ref, 'i', type, entry, valret);
1128 }
1129
1130 bool extl_table_geti_a(ExtlTab ref, int entry, ExtlAny *ret)
1131 {
1132     return extl_table_do_geti(ref, entry, 'a', (void*)ret);
1133 }
1134
1135 bool extl_table_geti_o(ExtlTab ref, int entry, Obj **ret)
1136 {
1137     return extl_table_do_geti(ref, entry, 'o', (void*)ret);
1138 }
1139
1140 bool extl_table_geti_i(ExtlTab ref, int entry, int *ret)
1141 {
1142     return extl_table_do_geti(ref, entry, 'i', (void*)ret);
1143 }
1144
1145 bool extl_table_geti_d(ExtlTab ref, int entry, double *ret)
1146 {
1147     return extl_table_do_geti(ref, entry, 'd', (void*)ret);
1148 }
1149
1150 bool extl_table_geti_b(ExtlTab ref, int entry, bool *ret)
1151 {
1152     return extl_table_do_geti(ref, entry, 'b', (void*)ret);
1153 }
1154
1155 bool extl_table_geti_s(ExtlTab ref, int entry, char **ret)
1156 {
1157     return extl_table_do_geti(ref, entry, 's', (void*)ret);
1158 }
1159
1160 bool extl_table_geti_f(ExtlTab ref, int entry, ExtlFn *ret)
1161 {
1162     return extl_table_do_geti(ref, entry, 'f', (void*)ret);
1163 }
1164
1165 bool extl_table_geti_t(ExtlTab ref, int entry, ExtlTab *ret)
1166 {
1167     return extl_table_do_geti(ref, entry, 't', (void*)ret);
1168 }
1169
1170
1171 typedef struct{
1172     int ref;
1173     int n;
1174 } GetNParams;
1175
1176
1177 static bool extl_table_do_get_n(lua_State *st, GetNParams *params)
1178 {
1179     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1180     params->n=luaL_getn_check(st, -1);
1181     return TRUE;
1182 }
1183
1184
1185 int extl_table_get_n(ExtlTab ref)
1186 {
1187     GetNParams params;
1188     int oldtop;
1189
1190     params.ref=ref;
1191     params.n=0;
1192
1193     extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_do_get_n, &params);
1194
1195     return params.n;
1196 }
1197
1198
1199 /*}}}*/
1200
1201
1202 /*{{{ Table/set */
1203
1204
1205 static bool extl_table_dodo_set2(lua_State *st, TableParams2 *params)
1206 {
1207     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1208     extl_stack_push_vararg(st, params->itype, params->argsp);
1209     extl_stack_push_vararg(st, params->type, params->argsp);
1210     lua_rawset_check(st, -3);
1211     return TRUE;
1212 }
1213
1214
1215 bool extl_table_set_vararg(ExtlTab ref, char itype, char type, va_list *args)
1216 {
1217     TableParams2 params;
1218
1219     params.ref=ref;
1220     params.itype=itype;
1221     params.type=type;
1222     params.argsp=args;
1223
1224     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_set2, &params);
1225 }
1226
1227
1228 bool extl_table_set(ExtlTab ref, char itype, char type, ...)
1229 {
1230     va_list args;
1231     bool retval;
1232
1233     va_start(args, type);
1234     retval=extl_table_set_vararg(ref, itype, type, &args);
1235     va_end(args);
1236
1237     return retval;
1238 }
1239
1240 bool extl_table_sets_a(ExtlTab ref, const char *entry, const ExtlAny *val)
1241 {
1242     return extl_table_set(ref, 's', 'a', entry, val);
1243 }
1244
1245 bool extl_table_sets_o(ExtlTab ref, const char *entry, Obj *val)
1246 {
1247     return extl_table_set(ref, 's', 'o', entry, val);
1248 }
1249
1250 bool extl_table_sets_i(ExtlTab ref, const char *entry, int val)
1251 {
1252     return extl_table_set(ref, 's', 'i', entry, val);
1253 }
1254
1255 bool extl_table_sets_d(ExtlTab ref, const char *entry, double val)
1256 {
1257     return extl_table_set(ref, 's', 'd', entry, val);
1258 }
1259
1260 bool extl_table_sets_b(ExtlTab ref, const char *entry, bool val)
1261 {
1262     return extl_table_set(ref, 's', 'b', entry, val);
1263 }
1264
1265 bool extl_table_sets_s(ExtlTab ref, const char *entry, const char *val)
1266 {
1267     return extl_table_set(ref, 's', 'S', entry, val);
1268 }
1269
1270 bool extl_table_sets_f(ExtlTab ref, const char *entry, ExtlFn val)
1271 {
1272     return extl_table_set(ref, 's', 'f', entry, val);
1273 }
1274
1275 bool extl_table_sets_t(ExtlTab ref, const char *entry, ExtlTab val)
1276 {
1277     return extl_table_set(ref, 's', 't', entry, val);
1278 }
1279
1280
1281 bool extl_table_seti_a(ExtlTab ref, int entry, const ExtlAny *val)
1282 {
1283     return extl_table_set(ref, 'i', 'a', entry, val);
1284 }
1285
1286 bool extl_table_seti_o(ExtlTab ref, int entry, Obj *val)
1287 {
1288     return extl_table_set(ref, 'i', 'o', entry, val);
1289 }
1290
1291 bool extl_table_seti_i(ExtlTab ref, int entry, int val)
1292 {
1293     return extl_table_set(ref, 'i', 'i', entry, val);
1294 }
1295
1296 bool extl_table_seti_d(ExtlTab ref, int entry, double val)
1297 {
1298     return extl_table_set(ref, 'i', 'd', entry, val);
1299 }
1300
1301 bool extl_table_seti_b(ExtlTab ref, int entry, bool val)
1302 {
1303     return extl_table_set(ref, 'i', 'b', entry, val);
1304 }
1305
1306 bool extl_table_seti_s(ExtlTab ref, int entry, const char *val)
1307 {
1308     return extl_table_set(ref, 'i', 'S', entry, val);
1309 }
1310
1311 bool extl_table_seti_f(ExtlTab ref, int entry, ExtlFn val)
1312 {
1313     return extl_table_set(ref, 'i', 'f', entry, val);
1314 }
1315
1316 bool extl_table_seti_t(ExtlTab ref, int entry, ExtlTab val)
1317 {
1318     return extl_table_set(ref, 'i', 't', entry, val);
1319 }
1320
1321
1322 /*}}}*/
1323
1324
1325 /*{{{ Table/clear entry */
1326
1327
1328 static bool extl_table_dodo_clear2(lua_State *st, TableParams2 *params)
1329 {
1330     lua_rawgeti(st, LUA_REGISTRYINDEX, params->ref);
1331     extl_stack_push_vararg(st, params->itype, params->argsp);
1332     lua_pushnil(st);
1333     lua_rawset_check(st, -3);
1334     return TRUE;
1335 }
1336
1337 bool extl_table_clear_vararg(ExtlTab ref, char itype, va_list *args)
1338 {
1339     TableParams2 params;
1340
1341     params.ref=ref;
1342     params.itype=itype;
1343     /*params.type='?';*/
1344     params.argsp=args;
1345
1346     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_dodo_clear2, &params);
1347 }
1348
1349 bool extl_table_clear(ExtlTab ref, char itype, ...)
1350 {
1351     va_list args;
1352     bool retval;
1353
1354     va_start(args, itype);
1355     retval=extl_table_clear_vararg(ref, itype, &args);
1356     va_end(args);
1357
1358     return retval;
1359 }
1360
1361
1362 bool extl_table_clears(ExtlTab ref, const char *entry)
1363 {
1364     return extl_table_clear(ref, 's', entry);
1365 }
1366
1367 bool extl_table_cleari(ExtlTab ref, int entry)
1368 {
1369     return extl_table_clear(ref, 'i', entry);
1370 }
1371
1372
1373
1374 /*}}}*/
1375
1376
1377 /*{{{ Table iteration */
1378
1379
1380 typedef struct{
1381     ExtlTab ref;
1382     ExtlIterFn *fn;
1383     void *d;
1384 } IterP;
1385
1386
1387 int extl_table_iter_do(lua_State *st, IterP *par)
1388 {
1389     lua_rawgeti(st, LUA_REGISTRYINDEX, par->ref);
1390
1391     lua_pushnil(st);
1392
1393     while(lua_next(st, -2)!=0){
1394         ExtlAny k, v;
1395
1396         if(extl_stack_get(st, -2, 'a', FALSE, NULL, &k)){
1397             bool ret=TRUE;
1398             if(extl_stack_get(st, -1, 'a', FALSE, NULL, &v)){
1399                 ret=par->fn(k, v, par->d);
1400                 extl_any_free(&v, STRINGS_NONE);
1401             }
1402             extl_any_free(&k, STRINGS_NONE);
1403             if(!ret)
1404                 return 0;
1405         }
1406
1407         lua_pop(st, 1);
1408     }
1409
1410     return 0;
1411 }
1412
1413
1414 void extl_table_iter(ExtlTab ref, ExtlIterFn *fn, void *d)
1415 {
1416     IterP par;
1417
1418     par.ref=ref;
1419     par.fn=fn;
1420     par.d=d;
1421
1422     extl_cpcall(l_st, (ExtlCPCallFn*)extl_table_iter_do, &par);
1423 }
1424
1425
1426 /*}}}*/
1427
1428
1429 /*{{{ Function calls to Lua */
1430
1431
1432 static bool extl_push_args(lua_State *st, const char *spec, va_list *argsp)
1433 {
1434     int i=1;
1435
1436     while(*spec!='\0'){
1437         if(!extl_stack_push_vararg(st, *spec, argsp))
1438             return FALSE;
1439         i++;
1440         spec++;
1441     }
1442
1443     return TRUE;
1444 }
1445
1446
1447 typedef struct{
1448     const char *spec;
1449     const char *rspec;
1450     va_list *args;
1451     void *misc;
1452     int nret;
1453 #ifndef CF_HAS_VA_COPY
1454     void *ret_ptrs[MAX_PARAMS];
1455 #endif
1456 } ExtlDoCallParam;
1457
1458
1459 static bool extl_get_retvals(lua_State *st, int m, ExtlDoCallParam *param)
1460 {
1461     void *ptr;
1462     const char *spec=param->rspec;
1463
1464 #ifdef CF_HAS_VA_COPY
1465     va_list args;
1466     va_copy(args, *(param->args));
1467 #else
1468     if(m>MAX_PARAMS){
1469         extl_warn(TR("Too many return values. Use a C compiler that has "
1470                      "va_copy to support more."));
1471         return FALSE;
1472     }
1473 #endif
1474
1475     while(m>0){
1476         bool dead=FALSE;
1477 #ifdef CF_HAS_VA_COPY
1478         ptr=va_arg(args, void*);
1479 #else
1480         ptr=va_arg(*(param->args), void*);
1481         param->ret_ptrs[param->nret]=ptr;
1482 #endif
1483         if(!extl_stack_get(st, -m, *spec, TRUE, &dead, ptr)){
1484             /* This is the only place where we allow nil-objects */
1485             /*if(*spec=='o' && lua_isnil(st, -m)){
1486                 *(Obj**)ptr=NULL;
1487             }else*/
1488             if(dead){
1489                 extl_warn(TR("Returned dead object."));
1490                 return FALSE;
1491             }else{
1492                 extl_warn(TR("Invalid return value (expected '%c', "
1493                              "got lua type \"%s\")."),
1494                      *spec, lua_typename(st, lua_type(st, -m)));
1495                 return FALSE;
1496             }
1497         }
1498
1499         (param->nret)++;
1500         spec++;
1501         m--;
1502     }
1503
1504 #ifdef CF_HAS_VA_COPY
1505     va_end(args);
1506 #endif
1507
1508     return TRUE;
1509 }
1510
1511
1512 /* The function to be called is expected on the top of stack st.
1513  * This function should be cpcalled through extl_cpcall_call (below), which
1514  * will take care that we don't leak anything in case of error.
1515  */
1516 static bool extl_dodo_call_vararg(lua_State *st, ExtlDoCallParam *param)
1517 {
1518     bool ret=TRUE;
1519     int n=0, m=0;
1520
1521     if(lua_isnil(st, -1))
1522         return FALSE;
1523
1524     if(param->spec!=NULL)
1525         n=strlen(param->spec);
1526
1527     if(!lua_checkstack(st, n+8)){
1528         extl_warn(TR("Stack full."));
1529         return FALSE;
1530     }
1531
1532     if(n>0){
1533         if(!extl_push_args(st, param->spec, param->args))
1534             return FALSE;
1535     }
1536
1537     if(param->rspec!=NULL)
1538         m=strlen(param->rspec);
1539
1540     flushtrace();
1541
1542     if(lua_pcall(st, n, m, 0)!=0){
1543         extl_warn("%s", lua_tostring(st, -1));
1544         return FALSE;
1545     }
1546
1547     if(m>0)
1548         return extl_get_retvals(st, m, param);
1549
1550     return TRUE;
1551 }
1552
1553
1554 static bool extl_cpcall_call(lua_State *st, ExtlCPCallFn *fn,
1555                              ExtlDoCallParam *param)
1556 {
1557     void *ptr;
1558     int i;
1559
1560     param->nret=0;
1561
1562     if(extl_cpcall(st, fn, param))
1563         return TRUE;
1564
1565     /* If param.nret>0, there was an error getting some return value and
1566      * we must free what we got.
1567      */
1568
1569     for(i=0; i<param->nret; i++){
1570 #ifdef CF_HAS_VA_COPY
1571         ptr=va_arg(*(param->args), void*);
1572 #else
1573         ptr=param->ret_ptrs[i];
1574 #endif
1575         extl_free(ptr, *(param->rspec+i), STRINGS_ALL);
1576     }
1577
1578     return FALSE;
1579 }
1580
1581
1582 static bool extl_do_call_vararg(lua_State *st, ExtlDoCallParam *param)
1583 {
1584     if(!extl_getref(st, *(ExtlFn*)(param->misc)))
1585         return FALSE;
1586     return extl_dodo_call_vararg(st, param);
1587 }
1588
1589
1590 bool extl_call_vararg(ExtlFn fnref, const char *spec,
1591                       const char *rspec, va_list *args)
1592 {
1593     ExtlDoCallParam param;
1594
1595     if(fnref==LUA_NOREF || fnref==LUA_REFNIL)
1596         return FALSE;
1597
1598     param.spec=spec;
1599     param.rspec=rspec;
1600     param.args=args;
1601     param.misc=(void*)&fnref;
1602
1603     return extl_cpcall_call(l_st, (ExtlCPCallFn*)extl_do_call_vararg, &param);
1604 }
1605
1606
1607 bool extl_call(ExtlFn fnref, const char *spec, const char *rspec, ...)
1608 {
1609     bool retval;
1610     va_list args;
1611
1612     va_start(args, rspec);
1613     retval=extl_call_vararg(fnref, spec, rspec, &args);
1614     va_end(args);
1615
1616     return retval;
1617 }
1618
1619
1620 /*}}}*/
1621
1622
1623 /*{{{ extl_loadfile/string */
1624
1625
1626 static int call_loaded(lua_State *st)
1627 {
1628     int i, nargs=lua_gettop(st);
1629
1630     /* Get the loaded file/string as function */
1631     lua_pushvalue(st, lua_upvalueindex(1));
1632
1633     /* Fill 'arg' */
1634     lua_getfenv(st, -1);
1635     lua_pushstring(st, "arg");
1636
1637     if(nargs>0){
1638         lua_newtable(st);
1639         for(i=1; i<=nargs; i++){
1640             lua_pushvalue(st, i);
1641             lua_rawseti_check(st, -2, i);
1642         }
1643     }else{
1644         lua_pushnil(st);
1645     }
1646
1647     lua_rawset_check(st, -3);
1648     lua_pop(st, 1);
1649     lua_call(st, 0, LUA_MULTRET);
1650     return (lua_gettop(st)-nargs);
1651 }
1652
1653
1654 typedef struct{
1655     const char *src;
1656     bool isfile;
1657     ExtlFn *resptr;
1658 } ExtlLoadParam;
1659
1660
1661 static bool extl_do_load(lua_State *st, ExtlLoadParam *param)
1662 {
1663     int res=0;
1664
1665     if(param->isfile){
1666         res=luaL_loadfile(st, param->src);
1667     }else{
1668         res=luaL_loadbuffer(st, param->src, strlen(param->src), param->src);
1669     }
1670
1671     if(res!=0){
1672         extl_warn("%s", lua_tostring(st, -1));
1673         return FALSE;
1674     }
1675
1676     lua_newtable(st); /* Create new environment */
1677     /* Now there's fn, newenv in stack */
1678     lua_newtable(st); /* Create metatable */
1679     lua_pushstring(st, "__index");
1680     lua_getfenv(st, -4); /* Get old environment */
1681     lua_rawset_check(st, -3); /* Set metatable.__index */
1682     lua_pushstring(st, "__newindex");
1683     lua_getfenv(st, -4); /* Get old environment */
1684     lua_rawset_check(st, -3); /* Set metatable.__newindex */
1685     /* Now there's fn, newenv, meta in stack */
1686     lua_setmetatable(st, -2); /* Set metatable for new environment */
1687     lua_setfenv(st, -2);
1688     /* Now there should be just fn in stack */
1689
1690     /* Callloaded will put any parameters it gets in the table 'arg' in
1691      * the newly created environment.
1692      */
1693     lua_pushcclosure(st, call_loaded, 1);
1694     *(param->resptr)=lua_ref(st, -1);
1695
1696     return TRUE;
1697 }
1698
1699
1700 bool extl_loadfile(const char *file, ExtlFn *ret)
1701 {
1702     ExtlLoadParam param;
1703     param.src=file;
1704     param.isfile=TRUE;
1705     param.resptr=ret;
1706
1707     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_load, &param);
1708 }
1709
1710
1711 bool extl_loadstring(const char *str, ExtlFn *ret)
1712 {
1713     ExtlLoadParam param;
1714     param.src=str;
1715     param.isfile=FALSE;
1716     param.resptr=ret;
1717
1718     return extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_load, &param);
1719 }
1720
1721
1722 /*}}}*/
1723
1724
1725 /*{{{ L1 CH error logging */
1726
1727 #ifdef EXTL_LOG_ERRORS
1728
1729 INTRSTRUCT(WarnChain);
1730 DECLSTRUCT(WarnChain){
1731     bool need_trace;
1732     lua_State *st;
1733     WarnHandler *old_handler;
1734     WarnChain *prev;
1735 };
1736
1737
1738 static WarnChain *warnchain=NULL;
1739 static int notrace=0;
1740
1741
1742 static void l1_warn_handler(const char *message)
1743 {
1744     WarnChain *ch=warnchain;
1745     static int called=0;
1746
1747     assert(warnchain!=NULL);
1748
1749     if(called==0 && notrace==0)
1750         ch->need_trace=TRUE;
1751
1752     called++;
1753     warnchain=ch->prev;
1754     ch->old_handler(message);
1755     warnchain=ch;
1756     called--;
1757 }
1758
1759
1760 static void do_trace(WarnChain *ch)
1761 {
1762     const char *p;
1763
1764     if(notrace!=0)
1765         return;
1766
1767     extl_stack_trace(ch->st);
1768     p=lua_tostring(ch->st, -1);
1769     notrace++;
1770     extl_warn(p);
1771     notrace--;
1772     ch->need_trace=FALSE;
1773     lua_pop(ch->st, 1);
1774 }
1775
1776 static void flushtrace()
1777 {
1778     if(warnchain && warnchain->need_trace)
1779         do_trace(warnchain);
1780 }
1781
1782 #endif
1783
1784 /*}}}*/
1785
1786
1787 /*{{{ L1-CH safe functions */
1788
1789
1790 static int protect_count=0;
1791 static ExtlSafelist *safelists=NULL;
1792
1793
1794 void extl_protect(ExtlSafelist *l)
1795 {
1796     protect_count++;
1797     if(l!=NULL){
1798         if(l->count==0){
1799             LINK_ITEM(safelists, l, next, prev);
1800         }
1801         l->count++;
1802     }
1803 }
1804
1805
1806 void extl_unprotect(ExtlSafelist *l)
1807 {
1808     assert(protect_count>0);
1809     protect_count--;
1810
1811     if(l!=NULL){
1812         assert(l->count>0);
1813         l->count--;
1814         if(l->count==0){
1815             UNLINK_ITEM(safelists, l, next, prev);
1816         }
1817     }
1818 }
1819
1820
1821 static bool extl_check_protected(ExtlExportedFnSpec *spec)
1822 {
1823     ExtlSafelist *l;
1824     bool ok=FALSE;
1825     int j;
1826
1827     if(protect_count>0 && !spec->safe){
1828         for(l=safelists; l!=NULL; l=l->next){
1829             ok=TRUE;
1830             for(j=0; l->list[j]!=NULL; j++){
1831                 if(l->list[j]==spec->fn)
1832                     break;
1833             }
1834             if(l->list[j]==NULL){
1835                 ok=FALSE;
1836                 break;
1837             }
1838         }
1839     }else{
1840         ok=TRUE;
1841     }
1842
1843     return ok;
1844 }
1845
1846
1847 /*}}}*/
1848
1849
1850 /*{{{ L1 call handler */
1851
1852 /* To get around potential memory leaks and corruption that could be caused
1853  * by Lua's longjmp-on-error lameness, The L1 call handler is divided into
1854  * two steps. In the first step we first setup a call to the second step.
1855  * At this point it is still fine if Lua raises an error. Then we set up
1856  * our warning handlers and stuff--at which point Lua's raising an error
1857  * would corrupt our data--and finally call the second step with lua_pcall.
1858  * Now the second step can safely call Lua's functions and do what is needed.
1859  * When the second step returns, we deallocate our data in the L1Param
1860  * structure that was passed to the second step and reset warning handlers.
1861  * After that it is again safe to call Lua's functions.
1862  */
1863
1864 typedef struct{
1865     ExtlL2Param ip[MAX_PARAMS];
1866     ExtlL2Param op[MAX_PARAMS];
1867     ExtlExportedFnSpec *spec;
1868     int ii, ni,  no;
1869 } L1Param;
1870
1871 static L1Param *current_param=NULL;
1872
1873
1874 static int extl_l1_call_handler2(lua_State *st)
1875 {
1876     L1Param *param=current_param;
1877     ExtlExportedFnSpec *spec=param->spec;
1878     int i;
1879
1880     D(fprintf(stderr, "%s called\n", spec->name));
1881
1882     if(!lua_checkstack(st, MAX_PARAMS+1)){
1883         extl_warn(TR("Stack full."));
1884         return 0;
1885     }
1886
1887     param->ni=(spec->ispec==NULL ? 0 : strlen(spec->ispec));
1888
1889     for(i=0; i<param->ni; i++){
1890         bool dead=FALSE;
1891         if(!extl_stack_get(st, i+1, spec->ispec[i], FALSE, &dead,
1892                            (void*)&(param->ip[i]))){
1893             if(dead){
1894                 extl_warn(TR("Argument %d to %s is a dead object."),
1895                           i+1, spec->name);
1896             }else{
1897                 extl_warn(TR("Argument %d to %s is of invalid type. "
1898                              "(Argument template is '%s', got lua type %s)."),
1899                           i+1, spec->name, spec->ispec,
1900                           lua_typename(st, lua_type(st, i+1)));
1901             }
1902             return 0;
1903         }
1904
1905         param->ii=i+1;
1906     }
1907
1908     if(spec->untraced)
1909         notrace++;
1910
1911     if(!spec->l2handler(spec->fn, param->ip, param->op))
1912         return 0;
1913
1914     if(spec->untraced)
1915         notrace--;
1916
1917     param->no=(spec->ospec==NULL ? 0 : strlen(spec->ospec));
1918
1919     for(i=0; i<param->no; i++)
1920         extl_stack_push(st, spec->ospec[i], (void*)&(param->op[i]));
1921
1922     return param->no;
1923 }
1924
1925
1926 static void extl_l1_finalize(L1Param *param)
1927 {
1928     ExtlExportedFnSpec *spec=param->spec;
1929     int i;
1930
1931     for(i=0; i<param->ii; i++)
1932         extl_free((void*)&(param->ip[i]), spec->ispec[i], STRINGS_NONE);
1933
1934     for(i=0; i<param->no; i++)
1935         extl_free((void*)&(param->op[i]), spec->ospec[i], STRINGS_NONCONST);
1936 }
1937
1938
1939
1940 static bool extl_l1_just_check_protected=FALSE;
1941
1942
1943 static int extl_l1_call_handler(lua_State *st)
1944 {
1945 #ifdef EXTL_LOG_ERRORS
1946     WarnChain ch;
1947 #endif
1948     L1Param param={{NULL, }, {NULL, }, NULL, 0, 0, 0};
1949     L1Param *old_param;
1950     int ret;
1951     int n=lua_gettop(st);
1952
1953
1954     /* Get the info we need on the function, check it's ok, and then set
1955      * up a safe environment for extl_l1_call_handler2.
1956      */
1957     param.spec=(ExtlExportedFnSpec*)lua_touserdata(st, lua_upvalueindex(1));
1958
1959     if(param.spec==NULL){
1960         extl_warn(TR("L1 call handler upvalues corrupt."));
1961         return 0;
1962     }
1963
1964     if(!param.spec->registered){
1965         extl_warn(TR("Called function has been unregistered."));
1966         return 0;
1967     }
1968
1969     if(extl_l1_just_check_protected){
1970         /* Just checking whether the function may be called. */
1971         lua_pushboolean(st, !extl_check_protected(param.spec));
1972         return 1;
1973     }
1974
1975     if(!extl_check_protected(param.spec)){
1976         extl_warn(TR("Attempt to call an unsafe function \"%s\" in "
1977                      "restricted mode."), param.spec->name);
1978         return 0;
1979     }
1980
1981
1982     lua_pushcfunction(st, extl_l1_call_handler2);
1983     lua_insert(st, 1);
1984
1985     old_param=current_param;
1986     current_param=&param;
1987
1988 #ifdef EXTL_LOG_ERRORS
1989     ch.old_handler=set_warn_handler(l1_warn_handler);
1990     ch.need_trace=FALSE;
1991     ch.st=st;
1992     ch.prev=warnchain;
1993     warnchain=&ch;
1994 #endif
1995
1996     /* Ok, Lua may now freely fail in extl_l1_call_handler2, we can handle
1997      * that.
1998      */
1999     ret=lua_pcall(st, n, LUA_MULTRET, 0);
2000
2001     /* Now that the actual call handler has returned, we need to free
2002      * any of our data before calling Lua again.
2003      */
2004     current_param=old_param;
2005     extl_l1_finalize(&param);
2006
2007 #ifdef EXTL_LOG_ERRORS
2008     warnchain=ch.prev;
2009     set_warn_handler(ch.old_handler);
2010
2011     /* Ok, we can now safely use Lua functions again without fear of
2012      * leaking.
2013      */
2014     if(ret!=0){
2015         const char *p;
2016         param.no=0;
2017         p=lua_tostring(st, -1);
2018         notrace++;
2019         extl_warn("%s", p);
2020         notrace--;
2021     }
2022
2023     if(ret!=0 || ch.need_trace)
2024         do_trace(&ch);
2025 #else
2026     if(ret!=0)
2027         lua_error(st);
2028 #endif
2029
2030     return param.no;
2031 }
2032
2033
2034 /*EXTL_DOC
2035  * Is calling the function \var{fn} not allowed now? If \var{fn} is nil,
2036  * tells if some functions are not allowed to be called now due to
2037  * protected mode.
2038  */
2039 EXTL_EXPORT_AS(global, protected)
2040 bool __protected(ExtlFn fn);
2041
2042 static int extl_protected(lua_State *st)
2043 {
2044     int ret;
2045
2046     if(lua_isnil(st, 1)){
2047         lua_pushboolean(st, protect_count>0);
2048         return 1;
2049     }
2050
2051     if(!lua_isfunction(st, 1)){
2052         lua_pushboolean(st, TRUE);
2053         return 1;
2054     }
2055
2056     if(lua_tocfunction(st, 1)!=(lua_CFunction)extl_l1_call_handler){
2057         lua_pushboolean(st, FALSE);
2058         return 1;
2059     }
2060
2061     extl_l1_just_check_protected=TRUE;
2062     ret=lua_pcall(st, 0, 1, 0);
2063     extl_l1_just_check_protected=FALSE;
2064     if(ret!=0)
2065         lua_pushboolean(st, TRUE);
2066     return 1;
2067 }
2068
2069 /*}}}*/
2070
2071
2072 /*{{{ Function registration */
2073
2074
2075 typedef struct{
2076     ExtlExportedFnSpec *spec;
2077     const char *cls;
2078     ExtlTab table;
2079 } RegData;
2080
2081
2082 static bool extl_do_register_function(lua_State *st, RegData *data)
2083 {
2084     ExtlExportedFnSpec *spec=data->spec, *spec2;
2085     int ind=LUA_GLOBALSINDEX;
2086
2087     if((spec->ispec!=NULL && strlen(spec->ispec)>MAX_PARAMS) ||
2088        (spec->ospec!=NULL && strlen(spec->ospec)>MAX_PARAMS)){
2089         extl_warn(TR("Function '%s' has more parameters than the level 1 "
2090                      "call handler can handle"), spec->name);
2091         return FALSE;
2092     }
2093
2094     if(data->table!=LUA_NOREF){
2095         lua_rawgeti(st, LUA_REGISTRYINDEX, data->table);
2096         ind=-3;
2097     }
2098
2099     lua_pushstring(st, spec->name);
2100
2101     lua_pushlightuserdata(st, spec);
2102     lua_pushcclosure(st, extl_l1_call_handler, 1);
2103
2104     lua_rawset_check(st, ind);
2105
2106     return TRUE;
2107 }
2108
2109
2110 static bool extl_do_register_functions(ExtlExportedFnSpec *spec, int max,
2111                                        const char *cls, int table)
2112 {
2113     int i;
2114
2115     RegData regdata;
2116     regdata.spec=spec;
2117     regdata.cls=cls;
2118     regdata.table=table;
2119
2120     for(i=0; spec[i].name && i<max; i++){
2121         regdata.spec=&(spec[i]);
2122         if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_function,
2123                         &regdata)){
2124             return FALSE;
2125         }
2126         spec[i].registered=TRUE;
2127     }
2128
2129     return TRUE;
2130 }
2131
2132
2133 bool extl_register_function(ExtlExportedFnSpec *spec)
2134 {
2135     return extl_do_register_functions(spec, 1, "", LUA_NOREF);
2136 }
2137
2138
2139 bool extl_register_functions(ExtlExportedFnSpec *spec)
2140 {
2141     return extl_do_register_functions(spec, INT_MAX, "", LUA_NOREF);
2142 }
2143
2144
2145 static bool extl_do_unregister_function(lua_State *st, RegData *data)
2146 {
2147     ExtlExportedFnSpec *spec=data->spec;
2148     int ind=LUA_GLOBALSINDEX;
2149
2150     if(data->table!=LUA_NOREF){
2151         lua_rawgeti(st, LUA_REGISTRYINDEX, data->table);
2152         ind=-3;
2153     }
2154
2155     /* Clear table.fn */
2156     lua_pushstring(st, spec->name);
2157     lua_pushnil(st);
2158     lua_rawset_check(st, ind);
2159
2160     return TRUE;
2161 }
2162
2163
2164 static void extl_do_unregister_functions(ExtlExportedFnSpec *spec, int max,
2165                                          const char *cls, int table)
2166 {
2167     int i;
2168
2169     RegData regdata;
2170     regdata.spec=spec;
2171     regdata.cls=cls;
2172     regdata.table=table;
2173
2174     for(i=0; spec[i].name && i<max; i++){
2175         regdata.spec=&(spec[i]);
2176         extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_function,
2177                     &regdata);
2178         spec[i].registered=FALSE;
2179     }
2180 }
2181
2182 void extl_unregister_function(ExtlExportedFnSpec *spec)
2183 {
2184     extl_do_unregister_functions(spec, 1, "", LUA_NOREF);
2185 }
2186
2187
2188 void extl_unregister_functions(ExtlExportedFnSpec *spec)
2189 {
2190     extl_do_unregister_functions(spec, INT_MAX, "", LUA_NOREF);
2191 }
2192
2193
2194 /*}}}*/
2195
2196
2197 /*{{{ Class registration */
2198
2199
2200 typedef struct{
2201     const char *cls, *parent;
2202     int refret;
2203     bool hide;
2204 } ClassData;
2205
2206
2207 static bool extl_do_register_class(lua_State *st, ClassData *data)
2208 {
2209     /* Create the globally visible WFoobar table in which the function
2210      * references reside.
2211      */
2212     lua_newtable(st);
2213
2214     /* Set type information.
2215      */
2216     lua_pushstring(st, "__typename");
2217     lua_pushstring(st, data->cls);
2218     lua_settable(st, -3);
2219
2220     /* If we have a parent class (i.e. class!=Obj), we want also the parent's
2221      * functions visible in this table so set up a metatable to do so.
2222      */
2223     if(data->parent!=NULL){
2224         /* Get luaextl_ParentClass_metatable */
2225         lua_pushfstring(st, "luaextl_%s_metatable", data->parent);
2226         lua_gettable(st, LUA_REGISTRYINDEX);
2227         if(!lua_istable(st, -1)){
2228             extl_warn("Could not find metatable for parent class %s of %s.\n",
2229                       data->parent, data->cls);
2230             return FALSE;
2231         }
2232         /* Create our metatable */
2233         lua_newtable(st);
2234         /* Get parent_metatable.__index */
2235         lua_pushstring(st, "__index");
2236         lua_pushvalue(st, -1);
2237         /* Stack: cls, parent_meta, meta, "__index", "__index" */
2238         lua_gettable(st, -4);
2239         /* Stack: cls, parent_meta, meta, "__index", parent_meta.__index */
2240         lua_pushvalue(st, -1);
2241         lua_insert(st, -3);
2242         /* Stack: cls, parent_meta, meta, parent_meta.__index, "__index", parent_meta.__index */
2243         lua_rawset_check(st, -4);
2244         /* Stack: cls, parent_meta, meta, parent_meta.__index */
2245         lua_pushstring(st, "__parentclass");
2246         lua_insert(st, -2);
2247         /* Stack: cls, parent_meta, meta, "__parentclass", parent_meta.__index */
2248         lua_settable(st, -5);
2249         /* Stack: cls, parent_meta, meta, */
2250         lua_setmetatable(st, -3);
2251         lua_pop(st, 1);
2252         /* Stack: cls */
2253     }
2254
2255     /* Set the global WFoobar */
2256     lua_pushvalue(st, -1);
2257     data->refret=lua_ref(st, 1); /* TODO: free on failure */
2258     if(!data->hide){
2259         lua_pushstring(st, data->cls);
2260         lua_pushvalue(st, -2);
2261         lua_rawset(st, LUA_GLOBALSINDEX);
2262     }
2263
2264     /* New we create a metatable for the actual objects with __gc metamethod
2265      * and __index pointing to the table created above. The MAGIC entry is
2266      * used to check that userdatas passed to us really are Watches with a
2267      * high likelihood.
2268      */
2269     lua_newtable(st);
2270
2271     lua_pushnumber(st, MAGIC);
2272     lua_pushnumber(st, MAGIC);
2273     lua_rawset_check(st, -3);
2274
2275     lua_pushstring(st, "__index");
2276     lua_pushvalue(st, -3);
2277     lua_rawset_check(st, -3); /* set metatable.__index=WFoobar created above */
2278     lua_pushstring(st, "__gc");
2279     lua_pushcfunction(st, extl_obj_gc_handler);
2280     lua_rawset_check(st, -3); /* set metatable.__gc=extl_obj_gc_handler */
2281     lua_pushfstring(st, "luaextl_%s_metatable", data->cls);
2282     lua_insert(st, -2);
2283     lua_rawset(st, LUA_REGISTRYINDEX);
2284
2285     return TRUE;
2286 }
2287
2288
2289 bool extl_register_class(const char *cls, ExtlExportedFnSpec *fns,
2290                          const char *parent)
2291 {
2292     ClassData clsdata;
2293     clsdata.cls=cls;
2294     clsdata.parent=parent;
2295     clsdata.refret=LUA_NOREF;
2296     clsdata.hide=(strcmp(cls, "Obj")==0);/*(fns==NULL);*/
2297
2298     D(assert(strcmp(cls, "Obj")==0 || parent!=NULL));
2299
2300     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_class, &clsdata))
2301         return FALSE;
2302
2303     if(fns==NULL)
2304         return TRUE;
2305
2306     return extl_do_register_functions(fns, INT_MAX, cls, clsdata.refret);
2307 }
2308
2309
2310 static void extl_do_unregister_class(lua_State *st, ClassData *data)
2311 {
2312     /* Get reference from registry to the metatable. */
2313     lua_pushfstring(st, "luaextl_%s_metatable", data->cls);
2314     lua_pushvalue(st, -1);
2315     lua_gettable(st, LUA_REGISTRYINDEX);
2316     /* Get __index and return it for resetting the functions. */
2317     lua_pushstring(st, "__index");
2318     lua_gettable(st, -2);
2319     data->refret=lua_ref(st, -1);
2320     lua_pop(st, 1);
2321     /* Set the entry from registry to nil. */
2322     lua_pushnil(st);
2323     lua_rawset(st, LUA_REGISTRYINDEX);
2324
2325     /* Reset the global reference to the class to nil. */
2326     lua_pushstring(st, data->cls);
2327     lua_pushnil(st);
2328     lua_rawset(st, LUA_GLOBALSINDEX);
2329 }
2330
2331
2332 void extl_unregister_class(const char *cls, ExtlExportedFnSpec *fns)
2333 {
2334     ClassData clsdata;
2335     clsdata.cls=cls;
2336     clsdata.parent=NULL;
2337     clsdata.refret=LUA_NOREF;
2338     clsdata.hide=FALSE; /* unused, but initialise */
2339
2340     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_class,
2341                     &clsdata))
2342         return;
2343
2344     /* We still need to reset function upvalues. */
2345     if(fns!=NULL)
2346         extl_do_unregister_functions(fns, INT_MAX, cls, clsdata.refret);
2347 }
2348
2349
2350 /*}}}*/
2351
2352
2353 /*{{{ Module registration */
2354
2355
2356 static bool extl_do_register_module(lua_State *st, ClassData *clsdata)
2357 {
2358     lua_getglobal(st, clsdata->cls);
2359
2360     if(!lua_istable(st, -1)){
2361         lua_newtable(st);
2362         lua_pushvalue(st, -1);
2363         lua_setglobal(st, clsdata->cls);
2364     }
2365     lua_pushfstring(st, "luaextl_module_%s", clsdata->cls);
2366     lua_pushvalue(st, -2);
2367     lua_rawset(st, LUA_REGISTRYINDEX);
2368
2369     clsdata->refret=lua_ref(st, -1);
2370
2371     return TRUE;
2372 }
2373
2374
2375 bool extl_register_module(const char *mdl, ExtlExportedFnSpec *fns)
2376 {
2377     ClassData clsdata;
2378
2379     clsdata.cls=mdl;
2380     clsdata.parent=NULL;
2381     clsdata.refret=LUA_NOREF;
2382     clsdata.hide=FALSE; /* unused, but initialise */
2383
2384     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_register_module, &clsdata))
2385         return FALSE;
2386
2387     if(fns==NULL)
2388         return TRUE;
2389
2390     return extl_do_register_functions(fns, INT_MAX, mdl, clsdata.refret);
2391 }
2392
2393
2394 static bool extl_do_unregister_module(lua_State *st, ClassData *clsdata)
2395 {
2396     lua_pushfstring(st, "luaextl_module_%s", clsdata->cls);
2397     lua_pushvalue(st, -1);
2398     lua_pushnil(st);
2399     lua_rawset(st, LUA_REGISTRYINDEX);
2400     clsdata->refret=lua_ref(st, -1);
2401
2402     return TRUE;
2403 }
2404
2405
2406 void extl_unregister_module(const char *mdl, ExtlExportedFnSpec *fns)
2407 {
2408     ClassData clsdata;
2409
2410     clsdata.cls=mdl;
2411     clsdata.parent=NULL;
2412     clsdata.refret=LUA_NOREF;
2413     clsdata.hide=FALSE; /* unused, but initialise */
2414
2415     if(!extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_unregister_module, &clsdata))
2416         return;
2417
2418     if(fns!=NULL)
2419         extl_do_unregister_functions(fns, INT_MAX, mdl, clsdata.refret);
2420 }
2421
2422
2423 /*}}}*/
2424
2425
2426 /*{{{ Serialise */
2427
2428 typedef struct{
2429     FILE *f;
2430     ExtlTab tab;
2431 } SerData;
2432
2433
2434 static void write_escaped_string(FILE *f, const char *str)
2435 {
2436     fputc('"', f);
2437
2438     while(str && *str){
2439         if(((*str)&0x7f)<32 || *str=='"' || *str=='\\'){
2440             /* Lua uses decimal in escapes */
2441             fprintf(f, "\\%03d", (int)(uchar)(*str));
2442         }else{
2443             fputc(*str, f);
2444         }
2445         str++;
2446     }
2447
2448     fputc('"', f);
2449 }
2450
2451
2452 static void indent(FILE *f, int lvl)
2453 {
2454     int i;
2455     for(i=0; i<lvl; i++)
2456         fprintf(f, "    ");
2457 }
2458
2459
2460 static bool ser(lua_State *st, FILE *f, int lvl)
2461 {
2462
2463     lua_checkstack(st, 5);
2464
2465     switch(lua_type(st, -1)){
2466     case LUA_TBOOLEAN:
2467         fprintf(f, "%s", lua_toboolean(st, -1) ? "true" : "false");
2468         break;
2469     case LUA_TNUMBER:
2470         fprintf(f, "%s", lua_tostring(st, -1));
2471         break;
2472     case LUA_TNIL:
2473         fprintf(f, "nil");
2474         break;
2475     case LUA_TSTRING:
2476         write_escaped_string(f, lua_tostring(st, -1));
2477         break;
2478     case LUA_TTABLE:
2479         if(lvl+1>=EXTL_MAX_SERIALISE_DEPTH){
2480             extl_warn(TR("Maximal serialisation depth reached."));
2481             fprintf(f, "nil");
2482             lua_pop(st, 1);
2483             return FALSE;
2484         }
2485
2486         fprintf(f, "{\n");
2487         lua_pushnil(st);
2488         while(lua_next(st, -2)!=0){
2489             lua_pushvalue(st, -2);
2490             indent(f, lvl+1);
2491             fprintf(f, "[");
2492             ser(st, f, lvl+1);
2493             fprintf(f, "] = ");
2494             ser(st, f, lvl+1);
2495             fprintf(f, ",\n");
2496         }
2497         indent(f, lvl);
2498         fprintf(f, "}");
2499         break;
2500     default:
2501         extl_warn(TR("Unable to serialise type %s."),
2502                   lua_typename(st, lua_type(st, -1)));
2503     }
2504     lua_pop(st, 1);
2505     return TRUE;
2506 }
2507
2508
2509 static bool extl_do_serialise(lua_State *st, SerData *d)
2510 {
2511     if(!extl_getref(st, d->tab))
2512         return FALSE;
2513
2514     return ser(st, d->f, 0);
2515 }
2516
2517
2518 /* Tab must not contain recursive references! */
2519 extern bool extl_serialise(const char *file, ExtlTab tab)
2520 {
2521     SerData d;
2522     bool ret;
2523
2524     d.tab=tab;
2525     d.f=fopen(file, "w");
2526
2527     if(d.f==NULL){
2528         extl_warn_err_obj(file);
2529         return FALSE;
2530     }
2531
2532     fprintf(d.f, TR("-- This file has been generated by Ion. Do not edit.\n"));
2533     fprintf(d.f, "return ");
2534
2535     ret=extl_cpcall(l_st, (ExtlCPCallFn*)extl_do_serialise, &d);
2536
2537     fprintf(d.f, "\n\n");
2538
2539     fclose(d.f);
2540
2541     return ret;
2542 }
2543
2544
2545 /*}}}*/
2546