Extended support for SWI-Prolog C interface.
This commit is contained in:
parent
ffe1dfdfff
commit
1bfbe535da
@ -425,6 +425,7 @@ X_API PredEntry *STD_PROTO(YAP_FunctorToPred,(Functor));
|
||||
X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom));
|
||||
X_API Int STD_PROTO(YAP_CallProlog,(Term));
|
||||
X_API void *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
|
||||
X_API void *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
|
||||
X_API void STD_PROTO(YAP_FreeSpaceFromYap,(void *));
|
||||
X_API int STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
|
||||
X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *));
|
||||
@ -1292,6 +1293,19 @@ YAP_CallProlog(Term t)
|
||||
return(out);
|
||||
}
|
||||
|
||||
X_API void *
|
||||
YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
|
||||
void *new_ptr;
|
||||
BACKUP_MACHINE_REGS();
|
||||
while ((new_ptr = Yap_ExpandPreAllocCodeSpace(size,ptr,TRUE)) == NULL) {
|
||||
if (!Yap_growheap(FALSE, size, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
RECOVER_MACHINE_REGS();
|
||||
return new_ptr;
|
||||
}
|
||||
X_API void *
|
||||
YAP_AllocSpaceFromYap(unsigned int size)
|
||||
{
|
||||
|
@ -280,6 +280,47 @@ typedef struct foreign_context *control_t;
|
||||
|
||||
/* end from pl-itf.h */
|
||||
|
||||
/* Required by PL_error */
|
||||
#define ERR_NO_ERROR 0
|
||||
#define ERR_INSTANTIATION 1 /* void */
|
||||
#define ERR_TYPE 2 /* atom_t expected, term_t value */
|
||||
#define ERR_DOMAIN 3 /* atom_t domain, term_t value */
|
||||
#define ERR_REPRESENTATION 4 /* atom_t what */
|
||||
#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */
|
||||
#define ERR_EVALUATION 6 /* atom_t what */
|
||||
#define ERR_AR_TYPE 7 /* atom_t expected, Number value */
|
||||
#define ERR_NOT_EVALUABLE 8 /* functor_t func */
|
||||
#define ERR_DIV_BY_ZERO 9 /* void */
|
||||
#define ERR_FAILED 10 /* predicate_t proc */
|
||||
#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */
|
||||
#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/
|
||||
#define ERR_NOT_IMPLEMENTED 13 /* const char *what */
|
||||
#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */
|
||||
#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */
|
||||
#define ERR_RESOURCE 16 /* atom_t resource */
|
||||
#define ERR_NOMEM 17 /* void */
|
||||
#define ERR_SYSCALL 18 /* void */
|
||||
#define ERR_SHELL_FAILED 19 /* term_t command */
|
||||
#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */
|
||||
#define ERR_AR_UNDEF 21 /* void */
|
||||
#define ERR_AR_OVERFLOW 22 /* void */
|
||||
#define ERR_AR_UNDERFLOW 23 /* void */
|
||||
#define ERR_UNDEFINED_PROC 24 /* Definition def */
|
||||
#define ERR_SIGNALLED 25 /* int sig, char *name */
|
||||
#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */
|
||||
#define ERR_BUSY 27 /* mutexes */
|
||||
#define ERR_PERMISSION_PROC 28 /* op, type, Definition */
|
||||
#define ERR_DDE_OP 29 /* op, error */
|
||||
#define ERR_SYNTAX 30 /* what */
|
||||
#define ERR_SHARED_OBJECT_OP 31 /* op, error */
|
||||
#define ERR_TIMEOUT 32 /* op, object */
|
||||
#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */
|
||||
#define ERR_FORMAT 34 /* message */
|
||||
#define ERR_FORMAT_ARG 35 /* seq, term */
|
||||
#define ERR_OCCURS_CHECK 36 /* Word, Word */
|
||||
#define ERR_CHARS_TYPE 37 /* char *, term */
|
||||
#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */
|
||||
|
||||
/*******************************
|
||||
* CALL-BACK *
|
||||
*******************************/
|
||||
@ -431,6 +472,7 @@ extern X_API void PL_recorded(record_t, term_t);
|
||||
extern X_API void PL_erase(record_t);
|
||||
extern X_API int PL_action(int,...);
|
||||
extern X_API void *PL_malloc(int);
|
||||
extern X_API void *PL_realloc(void*,int);
|
||||
extern X_API void PL_free(void *);
|
||||
extern X_API int PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
|
||||
|
||||
@ -475,6 +517,7 @@ extern X_API const char *PL_cwd(void);
|
||||
void swi_install(void);
|
||||
|
||||
X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...);
|
||||
X_API int PL_warning(const char *msg, ...);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
|
@ -236,6 +236,9 @@ extern X_API void PROTO(YAP_cut_up,(void));
|
||||
/* void *AllocSpaceFromYAP_(int) */
|
||||
extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
|
||||
|
||||
/* void *ReallocSpaceFromYAP_(void*,int) */
|
||||
extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
|
||||
|
||||
/* void FreeSpaceFromYAP_(void *) */
|
||||
extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));
|
||||
|
||||
|
@ -900,45 +900,6 @@ X_API int PL_raise_exception(term_t exception)
|
||||
#define FUNCTOR_timeout_error2 FunctorToSWIFunctor(FunctorTimeoutError)
|
||||
#define FUNCTOR_type_error2 FunctorToSWIFunctor(FunctorTypeError)
|
||||
|
||||
#define ERR_NO_ERROR 0
|
||||
#define ERR_INSTANTIATION 1 /* void */
|
||||
#define ERR_TYPE 2 /* atom_t expected, term_t value */
|
||||
#define ERR_DOMAIN 3 /* atom_t domain, term_t value */
|
||||
#define ERR_REPRESENTATION 4 /* atom_t what */
|
||||
#define ERR_MODIFY_STATIC_PROC 5 /* predicate_t proc */
|
||||
#define ERR_EVALUATION 6 /* atom_t what */
|
||||
#define ERR_AR_TYPE 7 /* atom_t expected, Number value */
|
||||
#define ERR_NOT_EVALUABLE 8 /* functor_t func */
|
||||
#define ERR_DIV_BY_ZERO 9 /* void */
|
||||
#define ERR_FAILED 10 /* predicate_t proc */
|
||||
#define ERR_FILE_OPERATION 11 /* atom_t action, atom_t type, term_t */
|
||||
#define ERR_PERMISSION 12 /* atom_t type, atom_t op, term_t obj*/
|
||||
#define ERR_NOT_IMPLEMENTED 13 /* const char *what */
|
||||
#define ERR_EXISTENCE 14 /* atom_t type, term_t obj */
|
||||
#define ERR_STREAM_OP 15 /* atom_t action, term_t obj */
|
||||
#define ERR_RESOURCE 16 /* atom_t resource */
|
||||
#define ERR_NOMEM 17 /* void */
|
||||
#define ERR_SYSCALL 18 /* void */
|
||||
#define ERR_SHELL_FAILED 19 /* term_t command */
|
||||
#define ERR_SHELL_SIGNALLED 20 /* term_t command, int signal */
|
||||
#define ERR_AR_UNDEF 21 /* void */
|
||||
#define ERR_AR_OVERFLOW 22 /* void */
|
||||
#define ERR_AR_UNDERFLOW 23 /* void */
|
||||
#define ERR_UNDEFINED_PROC 24 /* Definition def */
|
||||
#define ERR_SIGNALLED 25 /* int sig, char *name */
|
||||
#define ERR_CLOSED_STREAM 26 /* IOSTREAM * */
|
||||
#define ERR_BUSY 27 /* mutexes */
|
||||
#define ERR_PERMISSION_PROC 28 /* op, type, Definition */
|
||||
#define ERR_DDE_OP 29 /* op, error */
|
||||
#define ERR_SYNTAX 30 /* what */
|
||||
#define ERR_SHARED_OBJECT_OP 31 /* op, error */
|
||||
#define ERR_TIMEOUT 32 /* op, object */
|
||||
#define ERR_NOT_IMPLEMENTED_PROC 33 /* name, arity */
|
||||
#define ERR_FORMAT 34 /* message */
|
||||
#define ERR_FORMAT_ARG 35 /* seq, term */
|
||||
#define ERR_OCCURS_CHECK 36 /* Word, Word */
|
||||
#define ERR_CHARS_TYPE 37 /* char *, term */
|
||||
#define ERR_MUST_BE_VAR 38 /* int argn, term_t term */
|
||||
|
||||
static char *
|
||||
OsError(void)
|
||||
@ -968,6 +929,17 @@ static char errmsg[64];
|
||||
#endif /*HAVE_STRERROR*/
|
||||
}
|
||||
|
||||
X_API int PL_warning(const char *msg, ...) {
|
||||
va_list args;
|
||||
va_start(args, msg);
|
||||
// just print the warning message and return?
|
||||
fprintf(stderr,"[Warning:");
|
||||
fprintf(stderr,msg,args);
|
||||
fprintf(stderr,"]\n");
|
||||
va_end(args);
|
||||
PL_fail;
|
||||
}
|
||||
|
||||
X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
|
||||
{
|
||||
term_t formal, swi, predterm, msgterm, except;
|
||||
@ -1142,6 +1114,7 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
|
||||
PL_ATOM, what);
|
||||
break;
|
||||
}
|
||||
|
||||
default:
|
||||
fprintf(stderr, "unimplemented SWI error %d\n",id);
|
||||
goto err_instantiation;
|
||||
@ -2193,6 +2166,12 @@ PL_malloc(int sz)
|
||||
return YAP_AllocSpaceFromYap(sz);
|
||||
}
|
||||
|
||||
X_API void *
|
||||
PL_realloc(void *ptr, int sz)
|
||||
{
|
||||
return YAP_ReallocSpaceFromYap(ptr,sz);
|
||||
}
|
||||
|
||||
X_API void
|
||||
PL_free(void *obj)
|
||||
{
|
||||
|
Reference in New Issue
Block a user