From: David S. W. <dw...@us...> - 2009-11-25 16:52:10
|
Update of /cvsroot/xsb/XSB/emu In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv6647 Modified Files: emuloop.c loader_xsb.c psc_defs.h psc_xsb.c psc_xsb.h Log Message: Changes to runtime to support import-as, as in: :- import member/2 from basics as mymember/2. This creates a new psc for mymember/2 in the current module that is tied to the definition of member/2 in basics. Dynamic loading is supported. This supports declarations such as: :- export member/2. :- import member/2 from basics as member/2. in a file named listutils.P This would allow member to be imported from listutils, but remain defined in basics. (The cost is an extra branch when calling it through listutils.) Index: emuloop.c =================================================================== RCS file: /cvsroot/xsb/XSB/emu/emuloop.c,v retrieving revision 1.200 retrieving revision 1.201 diff -u -r1.200 -r1.201 --- emuloop.c 17 Nov 2009 14:59:34 -0000 1.200 +++ emuloop.c 25 Nov 2009 16:51:57 -0000 1.201 @@ -2553,39 +2553,31 @@ XSB_End_Instr() XSB_Start_Instr(load_pred,_load_pred) /* PPP-S */ + /* Executing this instruction causes itself to be changed to + jump or load_forn by the predicate loading process. */ Def1op Psc psc; Op1(get_xxxs); + psc = (Psc)op1; /* before getting lock, since may be changed by other loader in MT */ +#ifdef MULTI_THREAD SYS_MUTEX_LOCK(MUTEX_LOAD_UNDEF); - ADVANCE_PC(size_xxxX); - psc = (Psc)op1; - /* check env or type to give (better) error msgs? */ - switch (get_type(psc)) { - case T_PRED: - case T_DYNA: - case T_FORN: -#ifndef MULTI_THREAD - xsb_abort("[EMULOOP] Trying to load an already loaded pred"); -#else - /* predicate was loaded by another thread */ - /* fprintf(stderr,"Predicate loaded by other thread\n"); - fflush(stderr); - */ + if (*lpcreg == load_pred) { /* not loaded, so call interrupt routine to load it */ +#endif + + bld_cs(reg+1, build_call(CTXTc psc)); /* put call-term in r1 */ + /* get psc of undef handler */ + psc = (Psc)pflags[MYSIG_UNDEF+INT_HANDLERS_FLAGS_START]; + bld_int(reg+2, MYSIG_UNDEF); /* undef-pred code */ +#ifdef MULTI_THREAD + } else { /* someone else loaded it, just release lock and go to it */ SYS_MUTEX_UNLOCK(MUTEX_LOAD_UNDEF); - lpcreg = get_ep(psc); /* new ep of predicate */ - break; + } #endif - default: - bld_cs(reg+1, build_call(CTXTc psc)); /* put call-term in r1 */ - /* get psc of undef handler */ - psc = (Psc)pflags[MYSIG_UNDEF+INT_HANDLERS_FLAGS_START]; - bld_int(reg+2, MYSIG_UNDEF); /* undef-pred code */ - lpcreg = get_ep(psc); /* ep of undef handler */ - break; - } + lpcreg = get_ep(psc); /* ep of undef handler */ XSB_End_Instr() + XSB_Start_Instr(allocate_gc,_allocate_gc) /* PAA */ Def3ops Op2(get_xax); Index: loader_xsb.c =================================================================== RCS file: /cvsroot/xsb/XSB/emu/loader_xsb.c,v retrieving revision 1.82 retrieving revision 1.83 diff -u -r1.82 -r1.83 --- loader_xsb.c 17 Nov 2009 14:59:34 -0000 1.82 +++ loader_xsb.c 25 Nov 2009 16:51:57 -0000 1.83 @@ -682,9 +682,9 @@ static xsbBool load_one_sym(FILE *fd, Psc cur_mod, int count, int exp) { static XSB_StrDefine(str); - int is_new; - byte t_arity, t_type, t_env, t_defined; - Pair temp_pair; + int is_new, def_is_new; + byte t_arity, t_type, t_env, t_defined, t_definedas; + Pair temp_pair, defas_pair = NULL; Psc mod; get_obj_byte(&t_env); @@ -694,12 +694,13 @@ cur_mod->nameptr, XSB_OBJ_EXTENSION_STRING); get_obj_byte(&t_type); t_defined = t_type & T_DEFI; t_type = t_type & ~T_DEFI; + t_definedas = t_type & T_DEFA; t_type = t_type & ~T_DEFA; get_obj_byte(&t_arity); get_obj_atom(fd, &str); if (t_type == T_MODU) temp_pair = insert_module(0, str.string); else { - if ((t_env&0x7) == T_IMPORTED) { + if ((t_env&0x7) == T_IMPORTED || t_definedas) { byte t_modlen; char modname[MAXNAME+1]; @@ -708,12 +709,31 @@ modname[t_modlen] = '\0'; temp_pair = insert_module(0, modname); mod = temp_pair->psc_ptr; + if (t_definedas) { + byte t_defaslen; + char defasname[MAXNAME+1]; + get_obj_byte(&t_defaslen); + get_obj_string(defasname, t_defaslen); + defasname[t_defaslen] = '\0'; + defas_pair = insert(defasname, t_arity, mod, &def_is_new); + if (def_is_new) { + set_data(defas_pair->psc_ptr, mod); + set_env(defas_pair->psc_ptr, T_UNLOADED); + set_type(defas_pair->psc_ptr, T_ORDI); + } + mod = cur_mod; /* mod of this symbol is cur_mod */ + } } else if ((t_env&0x7) == T_GLOBAL) mod = global_mod; else mod = cur_mod; temp_pair = insert(str.string, t_arity, mod, &is_new); -/* if (is_new && (t_env & 0x7)==T_IMPORTED) */ + + if (t_definedas) { + set_psc_ep_to_psc(temp_pair->psc_ptr,defas_pair->psc_ptr); + t_type = T_PRED; + } + /* make sure all data fields of predicates PSCs point to their corresponding module */ if (is_new || @@ -743,11 +763,9 @@ so perhaps this code should be refactored. */ if (t_env&T_SHARED_DET) { set_shared(temp_pair->psc_ptr, (t_env&(T_SHARED|T_SHARED_DET))); - // printf("%s %x \n",get_name(temp_pair->psc_ptr),(temp_pair->psc_ptr)->env); } else if (!(((temp_pair->psc_ptr)->env)&T_SHARED_DET)) { set_shared(temp_pair->psc_ptr, (T_SHARED)); - // printf("setting shared %s %x \n",get_name(temp_pair->psc_ptr),(temp_pair->psc_ptr)->env); } } } @@ -939,6 +957,8 @@ /* 1st inst of file */ /* set the entry point of the predicate */ ptr = insert(name, arity, cur_mod, &is_new); + // printf("created setep %s:%s/%d n=%d, psc=%p\n",get_name(cur_mod),get_name(ptr->psc_ptr),get_arity(ptr->psc_ptr),is_new,ptr->psc_ptr); + switch (get_type(ptr->psc_ptr)) { case T_ORDI: case T_UDEF: Index: psc_defs.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/psc_defs.h,v retrieving revision 1.12 retrieving revision 1.13 diff -u -r1.12 -r1.13 --- psc_defs.h 1 Nov 2007 23:46:59 -0000 1.12 +++ psc_defs.h 25 Nov 2009 16:51:57 -0000 1.13 @@ -61,6 +61,7 @@ #define T_FORN 13 /* predicate in foreign language */ #define T_DEFI 128 /* bit to pass from compiler to loader that pred has clauses */ +#define T_DEFA 64 /* bit to pass from compiler to loader for import-as (defined-as) */ /* === loader definitions (module information) ==================== */ #define T_EXPORTED 0 Index: psc_xsb.c =================================================================== RCS file: /cvsroot/xsb/XSB/emu/psc_xsb.c,v retrieving revision 1.45 retrieving revision 1.46 diff -u -r1.45 -r1.46 --- psc_xsb.c 17 Nov 2009 14:59:34 -0000 1.45 +++ psc_xsb.c 25 Nov 2009 16:51:57 -0000 1.46 @@ -151,7 +151,7 @@ xsb_warn("Psc to set must not already be defined: %s/%d\n", get_name(psc_to_set),get_arity(psc_to_set)); } else { - set_ep(psc_to_set,get_ep(target_psc)); + set_ep(psc_to_set,(byte *)&(target_psc->load_inst)); } } Index: psc_xsb.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/psc_xsb.h,v retrieving revision 1.34 retrieving revision 1.35 diff -u -r1.34 -r1.35 --- psc_xsb.h 19 Oct 2009 16:51:14 -0000 1.34 +++ psc_xsb.h 25 Nov 2009 16:51:57 -0000 1.35 @@ -82,8 +82,8 @@ char *nameptr; struct psc_rec *data; /* psc of module, if pred; otw data */ byte *ep; /* entry point (initted to next word) */ - word load_inst; /* byte-code load_pred, or call_forn */ - struct psc_rec *this_psc; /* BC arg: this psc or foreign entry point */ + word load_inst; /* byte-code load_pred, or jump, or call_forn */ + struct psc_rec *this_psc; /* BC arg: entry-point or foreign entry point */ }; typedef struct psc_rec *Psc; @@ -132,7 +132,9 @@ #define set_incr(psc,val) ((psc)->incr = ((psc)->incr & 3) | val) /* incremental */ #define set_arity(psc, ari) ((psc)->arity = ari) #define set_length(psc, len) ((psc)->length = len) -#define set_ep(psc, val) ((psc)->ep = val) +#define set_ep(psc, val) do {(psc)->ep = val; \ + cell_opcode(&((psc)->load_inst)) = jump; \ + (psc)->this_psc = (void *)val;} while(0) #define set_data(psc, val) ((psc)->data = val) #define set_name(psc, name) ((psc)->nameptr = name) |