diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more fixes to SWI emulation

Browse Source 
integrate in main binary
This commit is contained in:
Vitor Santos Costa
2011-02-10 21:14:38 +00:00
parent 841f6eb1e5
commit 3fe9b923cb
12 changed files with 462 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
packages/PLStream/pl-file.c
View File

@@ -313,6 +313,9 @@ fileNameStream(IOSTREAM *s)
return name;
}
#if __YAP_PROLOG__
static void init_yap(void);
#endif
void
initIO()
@@ -323,6 +326,7 @@ initIO()
streamAliases = newHTable(16);
streamContext = newHTable(16);
PL_register_blob_type(&stream_blob);
init_yap();
#ifdef __unix__
{ int fd;
@@ -4654,3 +4658,74 @@ BeginPredDefs(file)
PRED_DEF("$pop_input_context", 0, pop_input_context, 0)
PRED_DEF("$size_stream", 2, size_stream, 0)
EndPredDefs
#if __YAP_PROLOG__
static const PL_extension foreigns[] = {
FRG("nl", 0, pl_nl, ISO),
FRG("write_canonical", 1, pl_write_canonical, ISO),
FRG("write_term", 2, pl_write_term, ISO),
FRG("write_term", 3, pl_write_term3, ISO),
FRG("write", 1, pl_write, ISO),
FRG("writeq", 1, pl_writeq, ISO),
FRG("print", 1, pl_print, 0),
FRG("nl", 1, pl_nl1, ISO),
FRG("write", 2, pl_write2, ISO),
FRG("writeq", 2, pl_writeq2, ISO),
FRG("print", 2, pl_print2, 0),
FRG("write_canonical", 2, pl_write_canonical2, ISO),
FRG("format", 3, pl_format3, META),
FRG("format_predicate", 2, pl_format_predicate, META),
FRG("current_format_predicate", 2, pl_current_format_predicate,
META|NDET),
/* DO NOT ADD ENTRIES BELOW THIS ONE */
LFRG((char *)NULL, 0, NULL, 0)
};
static int
get_stream_handle_no_errors(term_t t, int read, int write, IOSTREAM **s)
{ GET_LD
if ( t == 0 )
{ if (write) *s = getStream(Scurout);
else *s = getStream(Scurin);
return TRUE;
}
return get_stream_handle(t, s, SH_ALIAS);
}
static int
get_stream_position(IOSTREAM *s, term_t t)
{ GET_LD
return stream_position_prop(s, t);
}
static void
init_yap(void)
{
swi_io_struct swiio;
swiio.f = FUNCTOR_dstream1;
swiio.get_c = Sfgetc;
swiio.put_c = Sputc;
swiio.get_w = Sgetcode;
swiio.put_w = Sputcode;
swiio.flush_s = Sflush;
swiio.close_s = closeStream;
swiio.get_stream_handle = get_stream_handle_no_errors;
swiio.get_stream_position = get_stream_position;
PL_YAP_InitSWIIO(&swiio);
initCharTypes();
initFiles();
PL_register_extensions(PL_predicates_from_ctype);
PL_register_extensions(PL_predicates_from_file);
PL_register_extensions(PL_predicates_from_files);
PL_register_extensions(PL_predicates_from_glob);
PL_register_extensions(PL_predicates_from_write);
PL_register_extensions(foreigns);
fileerrors = TRUE;
SinitStreams();
}
#endif

39
packages/PLStream/pl-incl.h
View File

@@ -1,6 +1,10 @@
#include "config.h"
#if USE_GMP
#define O_GMP 1
#endif
#define PL_KERNEL 1
#ifdef __MINGW32__
@@ -218,6 +222,28 @@ typedef struct
} nv_options;
/*******************************
* GET-PROCEDURE *
*******************************/
#define GP_FIND 0 /* find anywhere */
#define GP_FINDHERE 1 /* find in this module */
#define GP_CREATE 2 /* create (in this module) */
#define GP_DEFINE 4 /* define a procedure */
#define GP_RESOLVE 5 /* find defenition */
#define GP_HOW_MASK 0x0ff
#define GP_NAMEARITY 0x100 /* or'ed mask */
#define GP_HIDESYSTEM 0x200 /* hide system module */
#define GP_TYPE_QUIET 0x400 /* don't throw errors on wrong types */
#define GP_EXISTENCE_ERROR 0x800 /* throw error if proc is not found */
#define GP_QUALIFY 0x1000 /* Always module-qualify */
/* get_functor() */
#define GF_EXISTING 1
#define GF_PROCEDURE 2 /* check for max arity */
/*******************************
* LIST BUILDING *
*******************************/
@@ -603,6 +629,13 @@ typedef struct PL_local_data {
int _current_buffer_id;
} fli;
#ifdef O_GMP
struct
{
int persistent; /* do persistent operations */
} gmp;
#endif
} PL_local_data_t;
#define usedStack(D) 0
@@ -1060,3 +1093,9 @@ setInteger(int *flag, term_t old, term_t new)
succeed;
}
extern const PL_extension PL_predicates_from_ctype[];
extern const PL_extension PL_predicates_from_file[];
extern const PL_extension PL_predicates_from_files[];
extern const PL_extension PL_predicates_from_glob[];
extern const PL_extension PL_predicates_from_write[];

129
packages/PLStream/pl-yap.c
View File

@@ -3,6 +3,9 @@
#include <stdio.h>
#include "pl-incl.h"
#if HAVE_MATH_H
#include <math.h>
#endif
#define Quote_illegal_f 1
#define Ignore_ops_f 2
@@ -319,7 +322,7 @@ PL_get_number(term_t l, number *n) {
#ifdef O_GMP
} else {
n->type = V_MPZ;
n->value.mpz = YAP_BigNumOfTerm(t);
YAP_BigNumOfTerm(t, &n->value.mpz);
#endif
}
}
@@ -420,13 +423,62 @@ outOfCore()
int
priorityOperator(Module m, atom_t atom)
{
return 0;
YAP_Term mod = (YAP_Term)m;
if (!m)
mod = YAP_CurrentModule();
return YAP_MaxOpPriority(YAP_AtomFromSWIAtom(atom), mod);
}
int
currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
{
return 0;
YAP_Term mod = (YAP_Term)m;
YAP_Atom at;
int opkind, yap_type;
if (!m)
mod = YAP_CurrentModule();
at = YAP_AtomFromSWIAtom(name);
switch (kind) {
case OP_PREFIX:
opkind = 2;
break;
case OP_INFIX:
opkind = 0;
break;
case OP_POSTFIX:
default:
opkind = 1;
}
if (!YAP_OpInfo(YAP_AtomFromSWIAtom(name), mod, opkind, &yap_type, priority))
return FALSE;
switch(yap_type) {
case 1:
*type = OP_XFX;
break;
case 2:
*type = OP_XFY;
break;
case 3:
*type = OP_YFX;
break;
case 4:
*type = OP_XFX;
break;
case 5:
*type = OP_XF;
break;
case 6:
*type = OP_YF;
break;
case 7:
*type = OP_FX;
break;
default:
*type = OP_FY;
break;
}
return 1;
}
int
@@ -438,25 +490,64 @@ numberVars(term_t t, nv_options *opts, int n ARG_LD) {
* PROMOTION *
*******************************/
#ifdef O_GMP
void
clearGMPNumber(Number n)
{ switch(n->type)
{ case V_MPZ:
if ( n->value.mpz->_mp_alloc )
mpz_clear(n->value.mpz);
static int
check_float(double f)
{
#ifdef HAVE_FPCLASSIFY
switch(fpclassify(f))
{ case FP_NAN:
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
break;
case V_MPQ:
if ( mpq_numref(n->value.mpq)->_mp_alloc )
mpz_clear(mpq_numref(n->value.mpq));
if ( mpq_denref(n->value.mpq)->_mp_alloc )
mpz_clear(mpq_denref(n->value.mpq));
break;
default:
case FP_INFINITE:
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
break;
}
}
#else
#ifdef HAVE_FPCLASS
switch(fpclass(f))
{ case FP_SNAN:
case FP_QNAN:
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
break;
case FP_NINF:
case FP_PINF:
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
break;
case FP_NDENORM: /* pos/neg denormalized non-zero */
case FP_PDENORM:
case FP_NNORM: /* pos/neg normalized non-zero */
case FP_PNORM:
case FP_NZERO: /* pos/neg zero */
case FP_PZERO:
break;
}
#else
#ifdef HAVE__FPCLASS
switch(_fpclass(f))
{ case _FPCLASS_SNAN:
case _FPCLASS_QNAN:
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
break;
case _FPCLASS_NINF:
case _FPCLASS_PINF:
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
break;
}
#else
#ifdef HAVE_ISNAN
if ( isnan(f) )
return PL_error(NULL, 0, NULL, ERR_AR_UNDEF);
#endif
#ifdef HAVE_ISINF
if ( isinf(f) )
return PL_error(NULL, 0, NULL, ERR_AR_OVERFLOW);
#endif
#endif /*HAVE__FPCLASS*/
#endif /*HAVE_FPCLASS*/
#endif /*HAVE_FPCLASSIFY*/
return TRUE;
}
int
promoteToFloatNumber(Number n)
@@ -629,7 +720,7 @@ PL_w32thread_raise(DWORD id, int sig)
#endif /*__WINDOWS__*/
int
X_API int
PL_raise(int sig)
{ GET_LD

1
packages/PLStream/pl-yap.h
View File

@@ -103,6 +103,7 @@ valHandle(term_t tt)
}
YAP_Int YAP_PLArityOfSWIFunctor(functor_t f);
YAP_Atom YAP_AtomFromSWIAtom(atom_t at);
PL_blob_t* YAP_find_blob_type(YAP_Atom at);