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

more cleanups

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-11-15 15:45:55 +00:00
parent 45f91c9d42
commit 9eb07a8c8a
16 changed files with 87 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/atoms.c
View File

@ -30,6 +30,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "eval.h"
#include "yapio.h"
#include "pl-shared.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
@ -656,8 +657,9 @@ p_atom_chars( USES_REGS1 )
return(FALSE);
}
{
LD_FROM_REGS
/* ISO Prolog Mode */
int has_atoms = yap_flags[STRICT_ISO_FLAG];
int has_atoms = truePrologFlag(PLFLAG_ISO);
int has_ints = FALSE;
while (t != TermNil) {
@ -1308,7 +1310,8 @@ p_atom_length( USES_REGS1 )
}
return Yap_unify(ARG2, MkIntegerTerm(len));
} else if (!IsAtomTerm(t1)) {
if (!yap_flags[STRICT_ISO_FLAG]) {
LD_FROM_REGS
if (!truePrologFlag(PLFLAG_ISO)) {
char *String;
if (IsIntegerTerm(t1)) {
@ -1547,7 +1550,8 @@ p_number_chars( USES_REGS1 )
s = String;
{
/* ISO code */
int has_atoms = yap_flags[STRICT_ISO_FLAG];
LD_FROM_REGS
int has_atoms = truePrologFlag(PLFLAG_ISO);
int has_ints = FALSE;
while (t != TermNil) {

9
C/init.c
View File

@ -169,7 +169,8 @@ OpDec(int p, char *type, Atom a, Term m)
WRITE_UNLOCK(ae->ARWLock);
}
if (i <= 3) {
if (yap_flags[STRICT_ISO_FLAG] &&
GET_LD
if (truePrologFlag(PLFLAG_ISO) &&
info->Posfix != 0) /* there is a posfix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
@ -178,7 +179,8 @@ OpDec(int p, char *type, Atom a, Term m)
}
info->Infix = p;
} else if (i <= 5) {
if (yap_flags[STRICT_ISO_FLAG] &&
GET_LD
if (truePrologFlag(PLFLAG_ISO) &&
info->Infix != 0) /* there is an infix operator */ {
/* ISO dictates */
WRITE_UNLOCK(info->OpRWLock);
@ -902,7 +904,6 @@ InitFlags(void)
/* note that Yap_heap_regs must be set first */
yap_flags[LANGUAGE_MODE_FLAG] = 0;
yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
/* we do not garantee safe assert in parallel mode */
@ -995,8 +996,6 @@ InitLogDBErasedMarker(void)
INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker);
}
#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1]
static void
InitSWIAtoms(void)
{

29
C/pl-yap.c
View File

@ -1034,6 +1034,28 @@ PL_dispatch(int fd, int wait)
return TRUE;
}
/* SWI: int PL_get_arg(int index, term_t t, term_t a)
YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/
X_API int _PL_get_arg__LD(int index, term_t ts, term_t a ARG_LD)
{
REGS_FROM_LD
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !YAP_IsApplTerm(t) ) {
if (YAP_IsPairTerm(t)) {
if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1;
} else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1;
}
}
return 0;
}
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
/* 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)
@ -1046,6 +1068,13 @@ int PL_get_atom__LD(term_t ts, atom_t *a ARG_LD)
return 1;
}
X_API int PL_put_atom__LD(term_t t, atom_t a ARG_LD)
{
REGS_FROM_LD
Yap_PutInSlot(t,MkAtomTerm(SWIAtomToAtom(a)) PASS_REGS);
return TRUE;
}
void PL_put_term__LD(term_t d, term_t s ARG_LD)
{
REGS_FROM_LD

16
C/scanner.c
View File

@ -232,12 +232,11 @@ extern double atof(const char *);
static Term
float_send(char *s, int sign)
{
CACHE_REGS
GET_LD
Float f = (Float)atof(s);
#if HAVE_FINITE
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
if (truePrologFlag(PLFLAG_ISO)) { /* iso */
if (!finite(f)) {
CACHE_REGS
LOCAL_ErrorMessage = "Float overflow while scanning";
return(MkEvalFl(0.0));
}
@ -279,6 +278,7 @@ send_error_message(char s[])
static wchar_t
read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
{
GET_LD
int ch;
/* escape sequence */
@ -359,7 +359,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case '`':
return '`';
case '^':
if (FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) {
if (truePrologFlag(PLFLAG_ISO)) {
return send_error_message("invalid escape sequence");
} else {
ch = getchrq(inp_stream);
@ -458,7 +458,7 @@ num_send_error_message(char s[])
static Term
get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, int sign)
{
CACHE_REGS
GET_LD
char *sp = s;
int ch = *chp;
Int val = 0L, base = ch - '0';
@ -574,7 +574,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
ch = getchr(inp_stream);
}
if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) {
if (yap_flags[STRICT_ISO_FLAG] && (ch == 'e' || ch == 'E')) {
if (truePrologFlag(PLFLAG_ISO) && (ch == 'e' || ch == 'E')) {
return num_send_error_message("Float format not allowed in ISO mode");
}
if (ch == '.') {
@ -796,7 +796,7 @@ ch_to_wide(char *base, char *charp)
TokEntry *
Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
{
CACHE_REGS
GET_LD
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
@ -1076,7 +1076,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break;
}
if (ch == 10 && FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) {
if (ch == 10 && truePrologFlag(PLFLAG_ISO)) {
/* in ISO a new line terminates a string */
LOCAL_ErrorMessage = "layout character \n inside quotes";
break;

28
C/stdpreds.c
View File

@ -273,6 +273,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "eval.h"
#include "yapio.h"
#include "pl-shared.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
@ -330,6 +331,7 @@ static Int p_runtime( USES_REGS1 );
static Int p_walltime( USES_REGS1 );
static Int p_access_yap_flags( USES_REGS1 );
static Int p_set_yap_flags( USES_REGS1 );
static Int p_break( USES_REGS1 );
#ifdef BEAM
Int use_eam( USES_REGS1 );
@ -1659,11 +1661,6 @@ p_set_yap_flags( USES_REGS1 )
}
yap_flags[LANGUAGE_MODE_FLAG] = value;
break;
case STRICT_ISO_FLAG:
if (value != 0 && value != 1)
return(FALSE);
yap_flags[STRICT_ISO_FLAG] = value;
break;
case SOURCE_MODE_FLAG:
if (value != 0 && value != 1)
return(FALSE);
@ -1837,13 +1834,17 @@ p_loop( USES_REGS1 ) {
static Int
p_max_tagged_integer( USES_REGS1 ) {
return Yap_unify(ARG1, MkIntTerm(MAX_ABS_INT-((CELL)1)));
}
static Int
p_min_tagged_integer( USES_REGS1 ) {
return Yap_unify(ARG1, MkIntTerm(-MAX_ABS_INT));
p_break( USES_REGS1 ) {
Atom at = AtomOfTerm(Deref( ARG1 ));
if (at == AtomTrue) {
LOCAL_PL_local_data_p->break_level++;
return TRUE;
}
if (at == AtomFalse) {
LOCAL_PL_local_data_p->break_level--;
return TRUE;
}
return FALSE;
}
void
@ -1922,8 +1923,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$p_system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag);
Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag);
Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag);
Yap_InitCPred("$break", 1, p_break, SafePredFlag);
#ifdef BEAM
Yap_InitCPred("@", 0, eager_split, SafePredFlag);
Yap_InitCPred(":", 0, force_wait, SafePredFlag);

1
H/Yap.h
View File

@ -343,7 +343,6 @@ typedef pthread_rwlock_t rwlock_t;
typedef enum
{
LANGUAGE_MODE_FLAG = 8,
STRICT_ISO_FLAG = 9,
SOURCE_MODE_FLAG = 11,
WRITE_QUOTED_STRING_FLAG = 13,
ALLOW_ASSERTING_STATIC_FLAG = 14,

3
H/eval.h
View File

@ -42,6 +42,9 @@
#define Int_MIN (-Int_MAX-(CELL)1)
#endif
#define PLMAXTAGGEDINT (MAX_ABS_INT-((CELL)1))
#define PLMINTAGGEDINT (-MAX_ABS_INT)
#define PLMAXINT Int_MAX
#define PLMININT Int_MIN

3
H/pl-basic.h
View File

@ -111,6 +111,8 @@ typedef void *pl_function_t;
#define IGNORE_LD
#define REGS_FROM_LD
#define LD_FROM_CACHE
#else
#define LOCAL_LD (__PL_ld)
@ -126,6 +128,7 @@ typedef void *pl_function_t;
#define IGNORE_LD (void)__PL_ld;
#define REGS_FROM_LD struct regstore_t *regcache = __PL_ld->reg_cache;
#define LD_FROM_REGS struct PL_local_data *__PL_ld = LOCAL_PL_local_data_p;
#endif

5
H/pl-incl.h
View File

@ -173,6 +173,7 @@ typedef enum
#endif
#if __YAP_PROLOG__
#include "pl-yap.h"
#if _WIN32
#define __WINDOWS__ 1
#else
@ -533,8 +534,6 @@ extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
extern IOSTREAM ** /* provide access to Suser_input, */
_PL_streams(void); /* Suser_output and Suser_error */
@ -781,12 +780,14 @@ COMMON(int) f_is_prolog_atom_start(wint_t c);
COMMON(int) f_is_prolog_identifier_continue(wint_t c);
COMMON(int) f_is_prolog_symbol(wint_t c);
COMMON(int) _PL_get_arg__LD(int index, term_t t, term_t a ARG_LD);
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(int) PL_put_atom__LD(term_t t, atom_t a ARG_LD);
COMMON(void) PL_put_term__LD(term_t t1, term_t t2 ARG_LD);
COMMON(int) PL_unify__LD(term_t t1, term_t t2 ARG_LD);
COMMON(int) PL_unify_atom__LD(term_t t, atom_t a ARG_LD);

3
H/pl-shared.h
View File

@ -147,5 +147,8 @@ getUnknownModule(module_t m);
COMMON(int) debugmode(debug_type new, debug_type *old);
COMMON(int) tracemode(debug_type new, debug_type *old);
COMMON(void) Yap_setCurrentSourceLocation(IOSTREAM **s);
#define SWIAtomToAtom(X) SWI_Atoms[(X)>>1]
#endif /* PL_SHARED_INCLUDE */

3
H/pl-yap.h
View File

@ -193,10 +193,13 @@ charCode(Term w)
#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_atom(t, a) PL_put_atom__LD(t, a PASS_LD)
#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)
#define _PL_get_arg(i, t, a) _PL_get_arg__LD(i, t, a PASS_LD);
#endif /* __YAP_PROLOG__ */
unsigned int getUnknownModule(module_t m);

22
library/dialect/swi/fli/swi.c
View File

@ -207,28 +207,6 @@ X_API int PL_get_arg(int index, term_t ts, term_t a)
return 1;
}
/* SWI: int PL_get_arg(int index, term_t t, term_t a)
YAP: YAP_Term YAP_ArgOfTerm(int argno, YAP_Term t)*/
X_API int _PL_get_arg(int index, term_t ts, term_t a)
{
CACHE_REGS
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if ( !YAP_IsApplTerm(t) ) {
if (YAP_IsPairTerm(t)) {
if (index == 1){
Yap_PutInSlot(a,HeadOfTerm(t) PASS_REGS);
return 1;
} else if (index == 2) {
Yap_PutInSlot(a,TailOfTerm(t) PASS_REGS);
return 1;
}
}
return 0;
}
Yap_PutInSlot(a,ArgOfTerm(index, t) PASS_REGS);
return 1;
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
YAP: YAP_Atom YAP_AtomOfTerm(Term) */
X_API int PL_get_atom(term_t ts, atom_t *a)

5
os/pl-prologflag.c
View File

@ -1174,13 +1174,8 @@ initPrologFlags(void)
setPrologFlag("max_integer", FT_INT64|FF_READONLY, PLMAXINT);
setPrologFlag("min_integer", FT_INT64|FF_READONLY, PLMININT);
#endif
#ifndef __YAP_PROLOG__
setPrologFlag("max_tagged_integer", FT_INTEGER|FF_READONLY, PLMAXTAGGEDINT);
setPrologFlag("min_tagged_integer", FT_INTEGER|FF_READONLY, PLMINTAGGEDINT);
#else
setPrologFlag("max_tagged_integer", FT_INTEGER|FF_READONLY, Int_MAX);
setPrologFlag("min_tagged_integer", FT_INTEGER|FF_READONLY, Int_MIN);
#endif
#ifdef O_GMP
setPrologFlag("bounded", FT_BOOL|FF_READONLY, FALSE, 0);
#ifdef __GNU_MP__

14
pl/boot.yap
View File

@ -93,7 +93,7 @@ true :- true.
'$init_globals' :-
'$init_consult',
nb_setval('$break',0),
% '$swi_set_prolog_flag'(break_level, 0),
% '$set_read_error_handler'(error), let the user do that
nb_setval('$system_mode',off),
nb_setval('$chr_toplevel_show_store',false).
@ -189,7 +189,7 @@ true :- true.
'$clean_up_dead_clauses',
fail.
'$enter_top_level' :-
'$nb_getval'('$break',BreakLevel,fail),
'$swi_current_prolog_flag'(break_level, BreakLevel),
'$swi_current_prolog_flag'(debug, DBON),
(
'$nb_getval'('$trace', on, fail)
@ -208,8 +208,8 @@ true :- true.
get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]),
'$run_atom_goal'(GA),
'$nb_getval'('$break',BreakLevel,fail),
( BreakLevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
'$swi_current_prolog_flag'(break_level, BreakLevel),
( Breaklevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
'$enter_top_level' :-
'$run_toplevel_hooks',
prompt1(' ?- '),
@ -219,7 +219,7 @@ true :- true.
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'$command'(Command,Varnames,_Pos,top),
'$nb_getval'('$break',BreakLevel,fail),
'$swi_current_prolog_flag'(break_level, BreakLevel),
( BreakLevel \= 0 -> true ; '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
@ -559,7 +559,7 @@ true :- true.
flush_output,
fail.
'$present_answer'((?-), Answ) :-
'$nb_getval'('$break',BL,fail),
'$swi_current_prolog_flag'(break_level, BL ),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ),
( recorded('$print_options','$toplevel'(Opts),_) ->
@ -1221,7 +1221,7 @@ catch_ball(Ball, V) :-
catch_ball(C, C).
'$run_toplevel_hooks' :-
'$nb_getval'('$break', 0, fail),
'$swi_current_prolog_flag'(break_level, 0 ),
recorded('$toplevel_hooks',H,_),
H \= fail, !,
( call(user:H1) -> true ; true).

6
pl/control.yap
View File

@ -273,12 +273,12 @@ break :-
nb_getval('$debug_run',Run),
'$swi_current_prolog_flag'(debug, Debug),
'$swi_set_prolog_flag'(debug, false),
nb_getval('$break',BL), NBL is BL+1,
'$break'( true ),
nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList),
b_setval('$spy_glist',[]),
nb_setval('$break',NBL),
current_output(OutStream), current_input(InpStream),
'$swi_current_prolog_flag'(break_level, NBL ),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!,
@ -291,7 +291,7 @@ break :-
nb_setval('$debug_jump',Jump),
nb_setval('$debug_run',Run),
nb_setval('$trace',Trace),
nb_setval('$break',BL),
'$break'( false ),
nb_setval('$system_mode',SystemMode).

2
pl/flags.yap
View File

@ -506,12 +506,10 @@ yap_flag(max_threads,X) :-
'$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)).
'$yap_system_flag'(agc_margin).
'$yap_system_flag'(answer_format).
'$yap_system_flag'(chr_toplevel_show_store).
'$yap_system_flag'(debugger_print_options).
'$yap_system_flag'(discontiguous_warnings).
'$yap_system_flag'(dollar_as_lower_case).
'$yap_system_flag'(double_quotes).
% V = fast ;
% '$yap_system_flag'(file_name_variables).
% '$yap_system_flag'(fileerrors ).