This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/os/pl-privitf.c

212 lines
4.6 KiB
C
Raw Normal View History

/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 2008, University of Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
2013-01-16 12:33:06 +00:00
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
#undef LD
#define LD LOCAL_LD
#ifdef __SWI_PROLOG__
#define setHandle(h, w) (*valTermRef(h) = (w))
#define valHandleP(h) valTermRef(h)
#define valHandle(r) valHandle__LD(r PASS_LD)
static inline word
valHandle__LD(term_t r ARG_LD)
{ Word p = valTermRef(r);
deRef(p);
return *p;
}
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module defines extensions to pl-fli.c that are used internally, but
not exported to the SWI-Prolog user. Most of them are too specific for
the public interface.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*******************************
* CHARACTER GET/UNIFY *
*******************************/
/** PL_get_char(term_t c, int *p, int eof)
Get a character code from a term and store in over p. Returns TRUE if
successful. On failure it returns a type error. If eof is TRUE, the
integer -1 or the atom end_of_file can used to specify and EOF character
code.
*/
int
PL_get_char(term_t c, int *p, int eof)
{ GET_LD
int chr;
atom_t name;
PL_chars_t text;
if ( PL_get_integer(c, &chr) )
{ if ( chr >= 0 )
{ *p = chr;
return TRUE;
}
if ( eof && chr == -1 )
{ *p = chr;
return TRUE;
}
} else if ( PL_get_text(c, &text, CVT_ATOM|CVT_STRING|CVT_LIST) &&
text.length == 1 )
{ *p = text.encoding == ENC_ISO_LATIN_1 ? text.text.t[0]&0xff
: text.text.w[0];
return TRUE;
} else if ( eof && PL_get_atom(c, &name) && name == ATOM_end_of_file )
{ *p = -1;
return TRUE;
}
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_character, c);
}
/** PL_unify_char(term_t chr, int c, int how)
Unify a character. Try to be as flexible as possible, only binding a
variable `chr' to a code or one-char-atom. E.g., this succeeds:
PL_unify_char('a', 97, PL_CODE)
*/
int
PL_unify_char(term_t chr, int c, int how)
{ GET_LD
int c2 = -1;
if ( PL_is_variable(chr) )
{ switch(how)
{ case PL_CHAR:
{ atom_t a = (c == -1 ? ATOM_end_of_file : codeToAtom(c));
return PL_unify_atom(chr, a);
}
case PL_CODE:
case PL_BYTE:
default:
return PL_unify_integer(chr, c);
}
} else if ( PL_get_char(chr, &c2, TRUE) )
return c == c2;
return FALSE;
}
/*******************************
* LIST BUILDING *
*******************************/
#if __YAP_PROLOG__
int
allocList(size_t maxcells, list_ctx *ctx)
{
2013-11-16 00:27:02 +00:00
CACHE_REGS
ctx->gstore = ctx->start = OpenList(maxcells PASS_REGS);
return (ctx->gstore != 0L);
}
int
unifyList(term_t term, list_ctx *ctx)
{
2013-11-16 00:27:02 +00:00
CACHE_REGS
if (!CloseList(ctx->gstore, TermNil))
return FALSE;
2013-11-16 00:27:02 +00:00
return Yap_unify(Yap_GetFromSlot(term PASS_REGS), ctx->start);
}
int
unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
{
2013-11-16 00:27:02 +00:00
CACHE_REGS
if (!CloseList(ctx->gstore, Yap_GetFromSlot(tail PASS_REGS)))
return FALSE;
2013-11-16 00:27:02 +00:00
return Yap_unify(Yap_GetFromSlot(head PASS_REGS), ctx->start);
}
#else
int
allocList(size_t maxcells, list_ctx *ctx)
{ GET_LD
ctx->lp = ctx->gstore = allocGlobal(1+maxcells*3);
return TRUE;
}
int
unifyList(term_t term, list_ctx *ctx)
{ GET_LD
Word a;
ctx->gstore[0] = ATOM_nil;
gTop = &ctx->gstore[1];
a = valTermRef(term);
deRef(a);
2013-01-16 12:33:06 +00:00
if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}
return TRUE;
}
int
unifyDiffList(term_t head, term_t tail, list_ctx *ctx)
{ GET_LD
Word a;
setVar(ctx->gstore[0]);
gTop = &ctx->gstore[1];
a = valTermRef(head);
deRef(a);
2013-01-16 12:33:06 +00:00
if ( !unify_ptrs(a, ctx->lp, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}
a = valTermRef(tail);
deRef(a);
2013-01-16 12:33:06 +00:00
if ( !unify_ptrs(a, ctx->gstore, 0 PASS_LD) )
{ gTop = ctx->lp;
return FALSE;
}
return TRUE;
}
#endif