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