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

YAP updates.

Browse Source
This commit is contained in:
Vitor Santos Costa 2011-02-10 00:02:05 +00:00
parent 232a740d43
commit 841f6eb1e5
13 changed files with 357 additions and 825 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/PLStream/dtoa.c
View File

@ -1725,7 +1725,7 @@ increment(Bigint *b)
return b;
}
void
static void
#ifdef KR_headers
gethex(sp, rvp, rounding, sign)
CONST char **sp; U *rvp; int rounding, sign;
@ -2256,7 +2256,7 @@ bigcomp
#endif
{
Bigint *b, *d;
int b2, bbits, d2, dd, dig, dsign, i, j, nd, nd0, p2, p5, speccase;
int b2, bbits, d2, dd = 0, dig, dsign, i, j, nd, nd0, p2, p5, speccase;
dsign = bc->dsign;
nd = bc->nd;

42
packages/PLStream/pl-ctype.c
View File

@ -26,6 +26,36 @@
#include <ctype.h>
#include "pl-ctype.h"
#if __YAP_PROLOG__
/* support for blank space handling, stolen from pl-read.c */
#include <pl-umap.c>
/*******************************
* UNICODE CLASSIFIERS *
*******************************/
#define CharTypeW(c, t, w) \
((unsigned)(c) <= 0xff ? (_PL_char_types[(unsigned)(c)] t) \
: (uflagsW(c) & w))
#define PlBlankW(c) CharTypeW(c, <= SP, U_SEPARATOR)
#define PlUpperW(c) CharTypeW(c, == UC, U_UPPERCASE)
#define PlIdStartW(c) (c <= 0xff ? (isLower(c)||isUpper(c)||c=='_') \
: uflagsW(c) & U_ID_START)
#define PlIdContW(c) CharTypeW(c, >= UC, U_ID_CONTINUE)
#define PlSymbolW(c) CharTypeW(c, == SY, 0)
#define PlPunctW(c) CharTypeW(c, == PU, 0)
#define PlSoloW(c) CharTypeW(c, == SO, 0)
static int
unicode_separator(pl_wchar_t c)
{ return PlBlankW(c);
}
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module defines:
@ -770,12 +800,12 @@ PRED_IMPL("setlocale", 3, setlocale, 0)
*******************************/
BeginPredDefs(ctype)
PRED_DEF("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("setlocale", 3, setlocale, 0)
PRED_DEF("downcase_atom", 2, downcase_atom, 0)
PRED_DEF("upcase_atom", 2, upcase_atom, 0)
PRED_DEF("normalize_space", 2, normalize_space, 0)
PRED_DEF("swi_char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("swi_code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
PRED_DEF("swi_setlocale", 3, setlocale, 0)
PRED_DEF("swi_downcase_atom", 2, downcase_atom, 0)
PRED_DEF("swi_upcase_atom", 2, upcase_atom, 0)
PRED_DEF("swi_normalize_space", 2, normalize_space, 0)
EndPredDefs

967
packages/PLStream/pl-error.c
View File

File diff suppressed because it is too large Load Diff

41
packages/PLStream/pl-error.h
View File

@ -22,17 +22,6 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef COMMON
#ifndef SO_LOCAL
#ifdef HAVE_VISIBILITY_ATTRIBUTE
#define SO_LOCAL __attribute__((visibility("hidden")))
#else
#define SO_LOCAL
#endif
#endif
#define COMMON(type) SO_LOCAL type
#endif
typedef enum
{ ERR_NO_ERROR = 0,
/* Used in os-directory and maybe elsewhere */
@ -81,30 +70,6 @@ typedef enum
#define MSG_ERRNO ((char *)(-1))
COMMON(int) PL_error(const char *pred, int arity, const char *msg,
PL_error_code id, ...);
COMMON(char *) tostr(char *buf, const char *fmt, ...);
COMMON(int) printMessage(atom_t severity, ...);
COMMON(int) PL_get_nchars_ex(term_t t, size_t *len, char **s,
unsigned int flags);
COMMON(int) PL_get_chars_ex(term_t t, char **s, unsigned int flags);
COMMON(int) PL_get_atom_ex(term_t t, atom_t *a);
#ifdef ARG_LD
COMMON(int) PL_get_atom_ex__LD(term_t t, atom_t *a ARG_LD);
#endif
COMMON(int) PL_get_integer_ex(term_t t, int *i);
COMMON(int) PL_get_long_ex(term_t t, long *i);
COMMON(int) PL_get_int64_ex(term_t t, int64_t *i);
COMMON(int) PL_get_intptr_ex(term_t t, intptr_t *i);
COMMON(int) PL_get_size_ex(term_t t, size_t *i);
COMMON(int) PL_get_bool_ex(term_t t, int *i);
COMMON(int) PL_get_float_ex(term_t t, double *f);
COMMON(int) PL_get_char_ex(term_t t, int *p, int eof);
COMMON(int) PL_get_pointer_ex(term_t t, void **addrp);
COMMON(int) PL_unify_list_ex(term_t l, term_t h, term_t t);
COMMON(int) PL_unify_nil_ex(term_t l);
COMMON(int) PL_get_list_ex(term_t l, term_t h, term_t t);
COMMON(int) PL_get_nil_ex(term_t l);
COMMON(int) PL_unify_bool_ex(term_t t, int val);
COMMON(int) PL_get_arg_ex(int n, term_t term, term_t arg);
COMMON(int) PL_get_module_ex(term_t name, Module *m);
int PL_error(const char *pred, int arity, const char *msg, int id, ...);
int printMessage(atom_t severity, ...);
void unallocStream(IOSTREAM *s);

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

@ -1058,7 +1058,7 @@ protocol(const char *str, size_t n)
static int
push_input_context()
push_input_context(void)
{ GET_LD
InputContext c = allocHeap(sizeof(struct input_context));
@ -1073,7 +1073,7 @@ push_input_context()
static int
pop_input_context()
pop_input_context(void)
{ GET_LD
InputContext c = input_context_stack;
@ -1105,7 +1105,7 @@ PRED_IMPL("$pop_input_context", 0, pop_input_context, 0)
void
pushOutputContext()
pushOutputContext(void)
{ GET_LD
OutputContext c = allocHeap(sizeof(struct output_context));
@ -1116,7 +1116,7 @@ pushOutputContext()
void
popOutputContext()
popOutputContext(void)
{ GET_LD
OutputContext c = output_context_stack;
@ -1341,7 +1341,7 @@ getSingleChar(IOSTREAM *stream, int signals)
int c;
ttybuf buf;
debugstatus.suspendTrace++;
// debugstatus.suspendTrace++; VSC: to be replaced by macro
Slock(stream);
Sflush(stream);
PushTty(stream, &buf, TTY_RAW); /* just donot prompt */
@ -1368,7 +1368,7 @@ getSingleChar(IOSTREAM *stream, int signals)
c = -1;
PopTty(stream, &buf, TRUE);
debugstatus.suspendTrace--;
// debugstatus.suspendTrace--; VSC: to be replaced by macro
Sunlock(stream);
return c;
@ -3107,7 +3107,7 @@ ok:
}
int
pl_seen()
pl_seen(void)
{ GET_LD
IOSTREAM *s = getStream(Scurin);

2
packages/PLStream/pl-files.c
View File

@ -914,7 +914,7 @@ has_extension(const char *name, const char *ext)
static int
name_too_long()
name_too_long(void)
{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
}

20
packages/PLStream/pl-fmt.c
View File

@ -201,15 +201,17 @@ static int emit_rubber(format_state *state);
word
pl_format_predicate(term_t chr, term_t descr)
{ int c;
Procedure proc;
predicate_t proc;
Symbol s;
int arity;
if ( !PL_get_char_ex(chr, &c, FALSE) )
fail;
if ( !get_procedure(descr, &proc, 0, GP_CREATE) )
fail;
if ( proc->definition->functor->arity == 0 )
PL_predicate_info(proc, NULL, &arity, NULL);
if ( arity == 0 )
return PL_error(NULL, 0, "arity must be > 0", ERR_DOMAIN,
PL_new_atom("format_predicate"),
descr);
@ -255,8 +257,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
}
while( (s=advanceTableEnum(e)) )
{ if ( PL_unify_integer(chr, (intptr_t)s->name) &&
unify_definition(contextModule(LD->environment),
descr, ((Procedure)s->value)->definition, 0, 0) )
PL_unify_predicate(descr, (predicate_t)s->value, 0) )
{ PL_close_foreign_frame(fid);
ForeignRedoPtr(e);
}
@ -419,20 +420,23 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
/* Check for user defined format */
if ( format_predicates &&
(s = lookupHTable(format_predicates, (void*)((intptr_t)c))) )
{ Procedure proc = (Procedure) s->value;
FunctorDef fdef = proc->definition->functor;
term_t av = PL_new_term_refs(fdef->arity);
{ predicate_t proc = (predicate_t) s->value;
int arity;
term_t av;
char buf[BUFSIZE];
char *str = buf;
size_t bufsize = BUFSIZE;
unsigned int i;
PL_predicate_info(proc, NULL, &arity, NULL);
av = PL_new_term_refs(arity);
if ( arg == DEFAULT )
PL_put_atom(av+0, ATOM_default);
else
PL_put_integer(av+0, arg);
for(i=1; i<fdef->arity; i++)
for(i=1; i < arity; i++)
{ NEED_ARG;
PL_put_term(av+i, argv);
SHIFT;

4
packages/PLStream/pl-glob.c
View File

@ -390,7 +390,7 @@ add_path(const char *path, GlobInfo info)
}
const char *
static const char *
expand_str(GlobInfo info, int at)
{ char *s = &fetchBuffer(&info->strings, at, char);
@ -398,7 +398,7 @@ expand_str(GlobInfo info, int at)
}
const char *
static const char *
expand_entry(GlobInfo info, int idx)
{ int at = fetchBuffer(&info->files, idx, int);

15
packages/PLStream/pl-os.c
View File

@ -772,7 +772,7 @@ OsPath(const char *plpath, char *path)
}
#endif /* O_HPFS */
#ifdef __unix__
#if defined(__unix__) || defined(__APPLE__)
char *
PrologPath(const char *p, char *buf, size_t len)
{ strncpy(buf, p, len);
@ -1759,7 +1759,7 @@ PopTty(IOSTREAM *s, ttybuf *buf)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
ResetStdin()
ResetStdin(void)
{ Sinput->limitp = Sinput->bufp = Sinput->buffer;
if ( !GD->os.org_terminal.read )
GD->os.org_terminal = *Sinput->functions;
@ -2517,7 +2517,11 @@ findExecutable(const char *av0, char *buffer)
#endif /*__WINDOWS__*/
#ifdef __unix__
#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
#define PATHSEP ';'
#else
/* not Windows, must be a Linux-like thingy */
static char *
okToExec(const char *s)
{ statstruct stbuff;
@ -2530,11 +2534,6 @@ okToExec(const char *s)
return (char *) NULL;
}
#define PATHSEP ':'
#endif /* __unix__ */
#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__)
#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL }
#define PATHSEP ';'
#endif
#ifdef EXEC_EXTENSIONS

2
packages/PLStream/pl-table.c
View File

@ -123,7 +123,7 @@ exitTables(int status, void *arg)
void
initTables()
initTables(void)
{ static int done = FALSE;
if ( !done )

2
packages/PLStream/pl-table.h
View File

@ -54,7 +54,7 @@ struct table_enum
TableEnum next; /* More choice points */
};
COMMON(void) initTables();
COMMON(void) initTables(void);
COMMON(Table) newHTable(int size);
COMMON(void) destroyHTable(Table ht);
COMMON(Symbol) lookupHTable(Table ht, void *name);

4
packages/PLStream/pl-text.c
View File

@ -202,7 +202,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{ term_t culprit = PL_new_term_ref();
atom_t type;
#if __YAP_PROLOG__
YAP_PutInSlot(culprit, result.culprit);
#else
*valTermRef(culprit) = result.culprit;
#endif
if ( result.status == CVT_nocode )
type = ATOM_character_code;
else

65
packages/PLStream/pl-write.c
View File

@ -25,8 +25,8 @@
#include <math.h>
#include "pl-incl.h"
#include "os/pl-dtoa.h"
#include "os/pl-ctype.h"
#include "pl-dtoa.h"
#include "pl-ctype.h"
#include <stdio.h> /* sprintf() */
#ifdef HAVE_LOCALE_H
#include <locale.h>
@ -64,6 +64,13 @@ static bool writeTerm(term_t t, int prec,
static bool writeArgTerm(term_t t, int prec,
write_options *options, bool arg) WUNUSED;
#if __YAP_PROLOG__
static Word
address_of(term_t t)
{ GET_LD
return YAP_AddressFromSlot(t); /* non-recursive structure */
}
#else
static Word
address_of(term_t t)
{ GET_LD
@ -79,6 +86,7 @@ address_of(term_t t)
return NULL; /* non-recursive structure */
}
}
#endif
static int
@ -94,6 +102,18 @@ has_visited(visited *v, Word addr)
char *
varName(term_t t, char *name)
#if __YAP_PROLOG__
{
YAP_Int adr = YAP_VarSlotToNumber(t);
if (adr < 0)
Ssprintf(name, "_L%ld", -adr);
else
Ssprintf(name, "_G%ld", adr);
return name;
}
#else
{ GET_LD
Word adr = valTermRef(t);
@ -106,6 +126,7 @@ varName(term_t t, char *name)
return name;
}
#endif
#define AT_LOWER 0
@ -122,8 +143,8 @@ varName(term_t t, char *name)
static int
atomType(atom_t a, IOSTREAM *fd)
{ Atom atom = atomValue(a);
char *s = atom->name;
size_t len = atom->length;
char *s = atomName(atom);
size_t len = atomLength(atom);
if ( len == 0 )
return AT_QUOTE;
@ -442,8 +463,8 @@ writeBlob(atom_t a, write_options *options)
unsigned char const *s, *e;
TRY(PutString("<#", options->out));
s = (unsigned char const *)atom->name;
for (e = s + atom->length; s != e; s++)
s = (unsigned char const *)atomName(atom);
for (e = s + atomLength(atom); s != e; s++)
{ static char *digits = "0123456789abcdef";
TRY(Putc(digits[(*s >> 4) & 0xf], options->out));
@ -459,7 +480,7 @@ writeAtom(atom_t a, write_options *options)
{ Atom atom = atomValue(a);
if ( (options->flags & PL_WRT_BLOB_PORTRAY) &&
false(atom->type, PL_BLOB_TEXT) &&
false(atomBlobType(atom), PL_BLOB_TEXT) &&
GD->cleaning <= CLN_PROLOG )
{ GET_LD
int rc;
@ -486,9 +507,9 @@ writeAtom(atom_t a, write_options *options)
return TRUE;
}
if ( atom->type->write )
return (*atom->type->write)(options->out, a, options->flags);
if ( false(atom->type, PL_BLOB_TEXT) )
if ( atomBlobType(atom)->write )
return (*atomBlobType(atom)->write)(options->out, a, options->flags);
if ( false(atomBlobType(atom), PL_BLOB_TEXT) )
return writeBlob(a, options);
if ( true(options, PL_WRT_QUOTED) )
@ -497,7 +518,7 @@ writeAtom(atom_t a, write_options *options)
case AT_SYMBOL:
case AT_SOLO:
case AT_SPECIAL:
return PutToken(atom->name, options->out);
return PutToken(nameOfAtom(atom), options->out);
case AT_QUOTE:
case AT_FULLSTOP:
default:
@ -505,14 +526,14 @@ writeAtom(atom_t a, write_options *options)
TRY(rc=PutOpenToken('\'', options->out));
TRY(writeQuoted(options->out,
atom->name,
atom->length,
nameOfAtom(atom),
atomLength(atom),
'\'', options));
return rc;
}
}
} else
return PutTokenN(atom->name, atom->length, options->out);
return PutTokenN(nameOfAtom(atom), atomLength(atom), options->out);
}
@ -531,8 +552,8 @@ writeAtomToStream(IOSTREAM *s, atom_t atom)
int
writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags)
{ Atom a = atomValue(atom);
pl_wchar_t *s = (pl_wchar_t*)a->name;
size_t len = a->length/sizeof(pl_wchar_t);
pl_wchar_t *s = (pl_wchar_t*)atomName(a);
size_t len = atomLength(a)/sizeof(pl_wchar_t);
pl_wchar_t *e = &s[len];
if ( flags & PL_WRT_QUOTED )
@ -881,7 +902,7 @@ pl_nl1(term_t stream)
}
word
pl_nl()
pl_nl(void)
{ return pl_nl1(0);
}
@ -898,7 +919,7 @@ callPortray(term_t arg, write_options *options)
portray = _PL_predicate("portray", 1, "user", &GD->procedures.portray);
if ( portray->definition->definition.clauses )
if ( predicateHasClauses(portray) )
{ GET_LD
wakeup_state wstate;
IOSTREAM *old = Scurout;
@ -1045,7 +1066,7 @@ writeTerm2(term_t t, int prec, write_options *options, bool arg)
}
if ( PL_get_atom(t, &a) )
{ if ( !arg && prec < 1200 && priorityOperator(NULL, a) > 0 )
{ if ( !arg && prec < 1200 && priorityOperator((Module)NULL, a) > 0 )
{ if ( PutOpenBrace(out) &&
writeAtom(a, options) &&
PutCloseBrace(out) )
@ -1318,7 +1339,8 @@ pl_write_term3(term_t stream, term_t term, term_t opts)
options.module = lookupModule(mname);
if ( charescape == TRUE ||
(charescape == -1 && true(options.module, CHARESCAPE)) )
// (charescape == -1 && true(options.module, CHARESCAPE)) )
charEscapeWriteOption(options))
options.flags |= PL_WRT_CHARESCAPES;
if ( numbervars == -1 )
numbervars = (portray ? TRUE : FALSE);
@ -1377,7 +1399,8 @@ do_write2(term_t stream, term_t term, int flags)
options.flags = flags;
options.out = s;
options.module = MODULE_user;
if ( options.module && true(options.module, CHARESCAPE) )
// if ( options.module && true(options.module, CHARESCAPE) )
if (charEscapeWriteOption(options))
options.flags |= PL_WRT_CHARESCAPES;
if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
options.flags |= PL_WRT_BACKQUOTED_STRING;