libextl/luaextl.c

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