support copying registers in SWI code.

This commit is contained in:
Vítor Santos Costa 2011-03-03 11:41:21 +00:00
parent da1df3d851
commit 9c3041f1e3
14 changed files with 171 additions and 53 deletions

View File

@ -751,7 +751,7 @@ p_read (void)
return do_read(NULL, 6); return do_read(NULL, 6);
} }
extern int getInputStream(Int, IOSTREAM **); extern int Yap_getInputStream(Int, IOSTREAM **);
static Int static Int
p_read2 (void) p_read2 (void)
@ -759,7 +759,7 @@ p_read2 (void)
IOSTREAM *inp_stream; IOSTREAM *inp_stream;
Int out; Int out;
if (!getInputStream(Yap_InitSlot(Deref(ARG7)), &inp_stream)) { if (!Yap_getInputStream(Yap_InitSlot(Deref(ARG7)), &inp_stream)) {
return(FALSE); return(FALSE);
} }
out = do_read(inp_stream, 7); out = do_read(inp_stream, 7);

View File

@ -171,10 +171,19 @@ extern Term Yap_XREGS[MaxTemps]; /* 29 */
extern pthread_key_t Yap_yaamregs_key; extern pthread_key_t Yap_yaamregs_key;
#if CACHE_REGS
#define ENTER_FUNC REGSTORE *regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
#define Yap_regp ->((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
#else
#define Yap_regp ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key)) #define Yap_regp ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
#endif #endif
#endif
#define Yap_REGS (*Yap_regp) #define Yap_REGS (*Yap_regp)
#else /* !PUSH_REGS */ #else /* !PUSH_REGS */

View File

@ -470,6 +470,8 @@ Term STD_PROTO(Yap_get_stream_position,(void *));
/* opt.preds.c */ /* opt.preds.c */
void STD_PROTO(Yap_init_optyap_preds,(void)); void STD_PROTO(Yap_init_optyap_preds,(void));
/* pl-file.c */
struct PL_local_data *Yap_InitThreadIO(int wid);
static inline static inline
yamop * yamop *

View File

@ -148,7 +148,7 @@
#define Yap_LabelFirstArray WL->label_first_array #define Yap_LabelFirstArray WL->label_first_array
#define Yap_LabelFirstArraySz WL->label_first_array_sz #define Yap_LabelFirstArraySz WL->label_first_array_sz
#define LD WL->Yap_ld_ #define PL_local_data_p WL->Yap_ld_
#define execution WL->_execution #define execution WL->_execution
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS) #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)

View File

@ -148,7 +148,7 @@ static void InitWorker(int wid) {
FOREIGN_WL(wid)->label_first_array = NULL; FOREIGN_WL(wid)->label_first_array = NULL;
FOREIGN_WL(wid)->label_first_array_sz = 0L; FOREIGN_WL(wid)->label_first_array_sz = 0L;
FOREIGN_WL(wid)->Yap_ld_ = NULL; FOREIGN_WL(wid)->Yap_ld_ = Yap_InitThreadIO(wid);
FOREIGN_WL(wid)->_execution = NULL; FOREIGN_WL(wid)->_execution = NULL;
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS) #if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)

View File

@ -163,7 +163,7 @@ Int* label_first_array Yap_LabelFirstArray =NULL
UInt label_first_array_sz Yap_LabelFirstArraySz =0L UInt label_first_array_sz Yap_LabelFirstArraySz =0L
// Thread Local Area for SWI-Prolog emulation routines. // Thread Local Area for SWI-Prolog emulation routines.
struct PL_local_data *Yap_ld_ LD =NULL struct PL_local_data *Yap_ld_ PL_local_data_p =Yap_InitThreadIO(wid)
struct open_query_struct* _execution execution =NULL struct open_query_struct* _execution execution =NULL

View File

@ -31,7 +31,7 @@ PL_get_chars_ex(term_t t, char **s, unsigned int flags)
int int
PL_get_atom_ex(term_t t, atom_t *a) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD)
{ if ( PL_get_atom(t, a) ) { if ( PL_get_atom(t, a) )
succeed; succeed;
@ -170,7 +170,8 @@ PL_get_module_ex(term_t name, module_t *m)
int int
PL_unify_bool_ex(term_t t, bool val) PL_unify_bool_ex(term_t t, bool val)
{ bool v; { GET_LD
bool v;
if ( PL_is_variable(t) ) if ( PL_is_variable(t) )
return PL_unify_atom(t, val ? ATOM_true : ATOM_false); return PL_unify_atom(t, val ? ATOM_true : ATOM_false);
@ -190,6 +191,7 @@ notImplemented(char *name, int arity)
X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...) X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
{ {
GET_LD
term_t formal, swi, predterm, msgterm, except; term_t formal, swi, predterm, msgterm, except;
va_list args; va_list args;

View File

@ -331,7 +331,9 @@ initIO()
streamAliases = newHTable(16); streamAliases = newHTable(16);
streamContext = newHTable(16); streamContext = newHTable(16);
PL_register_blob_type(&stream_blob); PL_register_blob_type(&stream_blob);
#if __YAP_PROLOG__
init_yap(); init_yap();
#endif
#ifdef __unix__ #ifdef __unix__
{ int fd; { int fd;
@ -4692,10 +4694,19 @@ static const PL_extension foreigns[] = {
LFRG((char *)NULL, 0, NULL, 0) LFRG((char *)NULL, 0, NULL, 0)
}; };
struct PL_local_data *Yap_InitThreadIO(int wid)
{
struct PL_local_data *p = (struct PL_local_data *)malloc(sizeof(struct PL_local_data));
if (!p) {
Yap_Error(OUT_OF_HEAP_ERROR, 0L, "Creating thread %d\n", wid);
}
return p;
}
static void static void
init_yap(void) init_yap(void)
{ {
LD = (struct PL_local_data *)malloc(sizeof(struct PL_local_data)); GET_LD
setPrologFlagMask(PLFLAG_TTY_CONTROL); setPrologFlagMask(PLFLAG_TTY_CONTROL);
initCharTypes(); initCharTypes();
initFiles(); initFiles();

View File

@ -986,12 +986,13 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0)
static static
PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0) PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0)
{ PRED_LD {
term_t pl = A1; term_t pl = A1;
term_t os = A2; term_t os = A2;
#ifdef O_XOS #ifdef O_XOS
PRED_LD
wchar_t *wn; wchar_t *wn;
if ( !PL_is_variable(pl) ) if ( !PL_is_variable(pl) )

View File

@ -150,8 +150,6 @@ typedef struct {
extern gds_t gds; extern gds_t gds;
#define GD (&gds) #define GD (&gds)
#define GLOBAL_LD (&gds)
/* The LD macro layer */ /* The LD macro layer */
typedef struct PL_local_data { typedef struct PL_local_data {
@ -251,13 +249,33 @@ extern PL_local_data_t lds;
// THIS HAS TO BE ABSTRACTED // THIS HAS TO BE ABSTRACTED
#define LOCAL_LD (WL->Yap_ld_) #define GLOBAL_LD (PL_local_data_p)
#undef LD
#if !defined(O_PLMT) && !defined(YAPOR)
#define LOCAL_LD (PL_local_data_p)
#define ARG1_LD void
#define ARG_LD #define ARG_LD
#define GET_LD #define GET_LD
#define PRED_LD #define PRED_LD
#define PASS_LD #define PASS_LD
#else
#define LOCAL_LD (__PL_ld)
#define LD LOCAL_LD
#define GET_LD PL_local_data_t *__PL_ld = GLOBAL_LD;
#define ARG1_LD PL_local_data_t *__PL_ld
#define ARG_LD , ARG1_LD
#define PASS_LD1 LD
#define PASS_LD , LD
#define PRED_LD GET_LD
#endif
#define Suser_input (LD->IO.streams[0]) #define Suser_input (LD->IO.streams[0])
#define Suser_output (LD->IO.streams[1]) #define Suser_output (LD->IO.streams[1])
#define Suser_error (LD->IO.streams[2]) #define Suser_error (LD->IO.streams[2])

View File

@ -597,7 +597,6 @@ typedef double real;
extern int PL_unify_char(term_t chr, int c, int how); extern int PL_unify_char(term_t chr, int c, int how);
extern int PL_get_char(term_t chr, int *c, int eof); extern int PL_get_char(term_t chr, int *c, int eof);
extern int PL_get_text(term_t l, PL_chars_t *text, int flags);
extern void PL_cleanup_fork(void); extern void PL_cleanup_fork(void);
extern int PL_rethrow(void); extern int PL_rethrow(void);
extern void PL_get_number(term_t l, number *n); extern void PL_get_number(term_t l, number *n);
@ -608,10 +607,8 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern IOSTREAM ** /* provide access to Suser_input, */ extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */ _PL_streams(void); /* Suser_output and Suser_error */
#define PL_get_text__LD PL_get_text
#define getInputStream__LD getInputStream
extern int get_atom_text(atom_t atom, PL_chars_t *text); extern int get_atom_text(atom_t atom, PL_chars_t *text);
extern int get_string_text(word w, PL_chars_t *text); COMMON(int) get_string_text(atom_t atom, PL_chars_t *text ARG_LD);
extern char *format_float(double f, char *buf); extern char *format_float(double f, char *buf);
/**** stuff from pl-ctype.c ****/ /**** stuff from pl-ctype.c ****/
@ -621,7 +618,6 @@ extern IOENC initEncoding(void);
extern int PL_get_bool_ex(term_t t, int *i); extern int PL_get_bool_ex(term_t t, int *i);
extern int PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags); extern int PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags);
extern int PL_get_chars_ex(term_t t, char **s, unsigned int flags); extern int PL_get_chars_ex(term_t t, char **s, unsigned int flags);
extern int PL_get_atom_ex(term_t t, atom_t *a);
extern int PL_get_integer_ex(term_t t, int *i); extern int PL_get_integer_ex(term_t t, int *i);
extern int PL_get_long_ex(term_t t, long *i); extern int PL_get_long_ex(term_t t, long *i);
extern int PL_get_int64_ex(term_t t, int64_t *i); extern int PL_get_int64_ex(term_t t, int64_t *i);
@ -687,8 +683,6 @@ COMMON(atom_t) fileNameStream(IOSTREAM *s);
COMMON(int) streamStatus(IOSTREAM *s); COMMON(int) streamStatus(IOSTREAM *s);
COMMON(int) getOutputStream(term_t t, IOSTREAM **s); COMMON(int) getOutputStream(term_t t, IOSTREAM **s);
COMMON(int) getInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
#define getInputStream(t, s) getInputStream__LD(t, s PASS_LD)
COMMON(void) pushOutputContext(void); COMMON(void) pushOutputContext(void);
COMMON(void) popOutputContext(void); COMMON(void) popOutputContext(void);
COMMON(int) getSingleChar(IOSTREAM *s, int signals); COMMON(int) getSingleChar(IOSTREAM *s, int signals);
@ -793,7 +787,6 @@ extern install_t PL_install_readline(void);
COMMON(int) saveWakeup(wakeup_state *state, int forceframe ARG_LD); COMMON(int) saveWakeup(wakeup_state *state, int forceframe ARG_LD);
COMMON(void) restoreWakeup(wakeup_state *state ARG_LD); COMMON(void) restoreWakeup(wakeup_state *state ARG_LD);
COMMON(int) skip_list(Word l, Word *tailp ARG_LD);
COMMON(int) priorityOperator(Module m, atom_t atom); COMMON(int) priorityOperator(Module m, atom_t atom);
COMMON(int) currentOperator(Module m, atom_t name, int kind, COMMON(int) currentOperator(Module m, atom_t name, int kind,
int *type, int *priority); int *type, int *priority);
@ -813,15 +806,40 @@ setBoolean(int *flag, term_t old, term_t new)
succeed; succeed;
} }
static inline word COMMON(int) getInputStream__LD(term_t t, IOSTREAM **s ARG_LD);
setInteger(int *flag, term_t old, term_t new)
{ if ( !PL_unify_integer(old, *flag) ||
!PL_get_integer_ex(new, flag) )
fail;
succeed; COMMON(int) PL_get_atom__LD(term_t t1, atom_t *a ARG_LD);
COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
COMMON(int) PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD);
COMMON(int) PL_is_variable__LD(term_t t ARG_LD);
COMMON(term_t) PL_new_term_ref__LD(ARG1_LD);
COMMON(void) PL_put_term__LD(term_t t1, term_t t2 ARG_LD);
COMMON(int) PL_unify_atom__LD(term_t t, atom_t a ARG_LD);
COMMON(int) PL_unify_integer__LD(term_t t1, intptr_t i ARG_LD);
/* inlines that need ARG_LD */
static inline intptr_t
skip_list(Word l, Word *tailp ARG_LD) {
return (intptr_t)YAP_SkipList(l, tailp);
} }
static inline word
valHandle__LD(term_t r ARG_LD)
{
return (word)YAP_GetFromSlot(r);
}
static inline void *allocHeap__LD(size_t n ARG_LD)
{
return YAP_AllocSpaceFromYap(n);
}
static inline void freeHeap__LD(void *mem, size_t n ARG_LD)
{
YAP_FreeSpaceFromYap(mem);
}
extern const PL_extension PL_predicates_from_ctype[]; extern const PL_extension PL_predicates_from_ctype[];
extern const PL_extension PL_predicates_from_file[]; extern const PL_extension PL_predicates_from_file[];
extern const PL_extension PL_predicates_from_files[]; extern const PL_extension PL_predicates_from_files[];
@ -829,5 +847,3 @@ extern const PL_extension PL_predicates_from_glob[];
extern const PL_extension PL_predicates_from_write[]; extern const PL_extension PL_predicates_from_write[];
extern const PL_extension PL_predicates_from_read[]; extern const PL_extension PL_predicates_from_read[];

View File

@ -67,8 +67,8 @@ static bool writeArgTerm(term_t t, int prec,
#if __YAP_PROLOG__ #if __YAP_PROLOG__
static Word static Word
address_of(term_t t) address_of(term_t t)
{ GET_LD {
return YAP_AddressFromSlot(t); /* non-recursive structure */ return YAP_AddressFromSlot(t); /* non-recursive structure */
} }
#else #else
static Word static Word

View File

@ -110,8 +110,9 @@ restoreWakeup(wakeup_state *state ARG_LD)
} }
int int
callProlog(module_t module, term_t goal, int flags, term_t *ex) callProlog(module_t module, term_t goal, int flags, term_t *ex )
{ term_t g = PL_new_term_ref(); { GET_LD
term_t g = PL_new_term_ref();
functor_t fd; functor_t fd;
predicate_t proc; predicate_t proc;
@ -160,12 +161,14 @@ Yap_Eval(YAP_Term t)
IOENC IOENC
Yap_DefaultEncoding(void) Yap_DefaultEncoding(void)
{ {
GET_LD
return LD->encoding; return LD->encoding;
} }
void void
Yap_SetDefaultEncoding(IOENC new_encoding) Yap_SetDefaultEncoding(IOENC new_encoding)
{ {
GET_LD
LD->encoding = new_encoding; LD->encoding = new_encoding;
} }
@ -275,6 +278,7 @@ switch(n->type)
int int
_PL_unify_atomic(term_t t, PL_atomic_t a) _PL_unify_atomic(term_t t, PL_atomic_t a)
{ {
GET_LD
return PL_unify_atom(t, a); return PL_unify_atom(t, a);
} }
@ -378,6 +382,7 @@ get_string_text(word w, PL_chars_t *text ARG_LD)
void void
PL_get_number(term_t l, number *n) { PL_get_number(term_t l, number *n) {
GET_LD
YAP_Term t = valHandle(l); YAP_Term t = valHandle(l);
if (YAP_IsIntTerm(t)) { if (YAP_IsIntTerm(t)) {
n->type = V_INTEGER; n->type = V_INTEGER;
@ -477,6 +482,7 @@ PL_unify_chars(term_t t, int flags, size_t len, const char *s)
X_API int PL_handle_signals(void) X_API int PL_handle_signals(void)
{ {
GET_LD
if ( !LD || LD->critical || !LD->signal.pending ) if ( !LD || LD->critical || !LD->signal.pending )
return 0; return 0;
fprintf(stderr,"PL_handle_signals not implemented\n"); fprintf(stderr,"PL_handle_signals not implemented\n");
@ -823,10 +829,62 @@ PL_dispatch(int fd, int wait)
return TRUE; return TRUE;
} }
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD)
{
YAP_Term t = Yap_GetFromSlot(ts);
if ( !IsAtomTerm(t))
return 0;
*a = YAP_SWIAtomFromAtom(AtomOfTerm(t));
return 1;
}
void PL_put_term__LD(term_t d, term_t s ARG_LD)
{
Yap_PutInSlot(d,Yap_GetFromSlot(s));
}
term_t PL_new_term_ref__LD(ARG1_LD)
{
term_t to = Yap_NewSlots(1);
return to;
}
int PL_is_variable__LD(term_t ts ARG_LD)
{
YAP_Term t = Yap_GetFromSlot(ts);
return YAP_IsVarTerm(t);
}
int PL_unify_atom__LD(term_t t, atom_t at ARG_LD)
{
YAP_Term cterm = MkAtomTerm(YAP_AtomFromSWIAtom(at));
return YAP_Unify(Yap_GetFromSlot(t),cterm);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */
int PL_unify_integer__LD(term_t t, long n ARG_LD)
{
Term iterm = MkIntegerTerm(n);
return Yap_unify(Yap_GetFromSlot(t),iterm);
}
extern int Yap_getInputStream(term_t t, IOSTREAM **s);
int Yap_getInputStream(term_t t, IOSTREAM **s)
{
GET_LD
return getInputStream(t, s);
}
#ifdef _WIN32 #ifdef _WIN32
#include <windows.h> #include <windows.h>
#if O_PLMT #if O_PLMT
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PL_w32thread_raise(DWORD id, int sig) PL_w32thread_raise(DWORD id, int sig)
@ -875,14 +933,13 @@ PL_w32thread_raise(DWORD id, int sig)
X_API int X_API int
PL_raise(int sig) PL_raise(int sig)
{ GET_LD {
if (sig == SIG_PLABORT) {
if (sig == SIG_PLABORT) { YAP_signal(0x40); /* YAP_INT_SIGNAL */
YAP_signal(0x40); /* YAP_INT_SIGNAL */ return 1;
return 1; } else {
} else { return 0;
return 0; }
}
} }
extern size_t PL_utf8_strlen(const char *s, size_t len); extern size_t PL_utf8_strlen(const char *s, size_t len);
@ -906,9 +963,8 @@ PL_license(const char *license, const char *module)
bool bool
systemMode(bool accept) systemMode(bool accept)
{ GET_LD {
return FALSE;
return FALSE;
} }
term_t term_t

View File

@ -60,10 +60,6 @@ COMMON(char *) Getenv(const char *, char *buf, size_t buflen);
/*** memory allocation stuff: SWI wraps around malloc */ /*** memory allocation stuff: SWI wraps around malloc */
#define allocHeap(X) YAP_AllocSpaceFromYap(X)
#define freeHeap(X,Size) YAP_FreeSpaceFromYap(X)
#define stopItimer() #define stopItimer()
COMMON(word) pl_print(term_t term); COMMON(word) pl_print(term_t term);
@ -103,11 +99,10 @@ COMMON(int) IsAbsolutePath(const char *spec);
extern word globalString(size_t size, char *s); extern word globalString(size_t size, char *s);
extern word globalWString(size_t size, wchar_t *s); extern word globalWString(size_t size, wchar_t *s);
static inline word #define allocHeap(n) allocHeap__LD(n PASS_LD)
valHandle(term_t tt) #define freeHeap(p, n) freeHeap__LD(p, n PASS_LD)
{
return (word)YAP_GetFromSlot(tt); #define valHandle(r) valHandle__LD(r PASS_LD)
}
YAP_Int YAP_PLArityOfSWIFunctor(functor_t f); YAP_Int YAP_PLArityOfSWIFunctor(functor_t f);
YAP_Atom YAP_AtomFromSWIAtom(atom_t at); YAP_Atom YAP_AtomFromSWIAtom(atom_t at);
@ -144,7 +139,6 @@ void PL_license(const char *license, const char *module);
#define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0) #define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
#define lookupModule(A) ((Module)PL_new_module(A)) #define lookupModule(A) ((Module)PL_new_module(A))
#define charEscapeWriteOption(A) FALSE // VSC: to implement #define charEscapeWriteOption(A) FALSE // VSC: to implement
#define skip_list(A,B) YAP_SkipList(A,B)
#define wordToTermRef(A) YAP_InitSlot(*(A)) #define wordToTermRef(A) YAP_InitSlot(*(A))
#define isTaggedInt(A) YAP_IsIntTerm(A) #define isTaggedInt(A) YAP_IsIntTerm(A)
#define valInt(A) YAP_IntOfTerm(A) #define valInt(A) YAP_IntOfTerm(A)
@ -169,7 +163,16 @@ charCode(Term w)
return -1; return -1;
} }
#define getInputStream(t, s) getInputStream__LD(t, s PASS_LD)
#define PL_get_atom(t, a) PL_get_atom__LD(t, a PASS_LD)
#define PL_get_atom_ex(t, a) PL_get_atom_ex__LD(t, a PASS_LD)
#define PL_get_text(l, t, f) PL_get_text__LD(l, t, f PASS_LD)
#define PL_is_variable(t) PL_is_variable__LD(t PASS_LD)
#define PL_new_term_ref() PL_new_term_ref__LD(PASS_LD1)
#define PL_put_term(t1, t2) PL_put_term__LD(t1, t2 PASS_LD)
#define PL_unify_atom(t, a) PL_unify_atom__LD(t, a PASS_LD)
#define PL_unify_integer(t, i) PL_unify_integer__LD(t, i PASS_LD)
#endif /* __YAP_PROLOG__ */ #endif /* __YAP_PROLOG__ */