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/packages/clib/random.c

156 lines
3.5 KiB
C
Raw Normal View History

2010-06-17 00:40:25 +01:00
/* $Id$
Part of SWI-Prolog
Author: L.Damas, V.S.Costa, Jan Wielemaker
E-mail: wielemak@science.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): Universidade do Porto, University of Amsterdam
Original code create for YAP under Artistic license. As this
license is compatible (but less restrictive than) the SWI-Prolog
license we keep the Artistic license.
*/
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: random.c *
* Last rev: *
* mods: *
* comments: Random number generation *
* *
*************************************************************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Ported to SWI-Prolog by Jan Wielemaker
To compile:
plld -o random -shared -fpic random.c
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#include <SWI-Prolog.h>
#include <math.h>
#include <limits.h>
static functor_t FUNCTOR_rand3;
static short a1 = 27314, b1 = 9213, c1 = 17773;
static int
type_error(term_t actual, const char *expected)
{ term_t ex;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR_CHARS, "error", 2,
PL_FUNCTOR_CHARS, "type_error", 2,
PL_CHARS, expected,
PL_TERM, actual,
PL_VARIABLE) )
return PL_raise_exception(ex);
return FALSE;
}
static int
domain_error(term_t actual, const char *expected)
{ term_t ex;
if ( (ex = PL_new_term_ref()) &&
PL_unify_term(ex,
PL_FUNCTOR_CHARS, "error", 2,
PL_FUNCTOR_CHARS, "domain_error", 2,
PL_CHARS, expected,
PL_TERM, actual,
PL_VARIABLE) )
return PL_raise_exception(ex);
return FALSE;
}
static int
get_short_ex(term_t t, short *p)
{ long v;
if ( !PL_get_long(t, &v) )
return type_error(t, "integer");
if ( v < SHRT_MIN || v > SHRT_MAX )
return domain_error(t, "short integer");
*p = (short)v;
return TRUE;
}
static int
get_short_arg_ex(int a, term_t state, short *p)
{ term_t arg = PL_new_term_ref();
_PL_get_arg(a, state, arg);
return get_short_ex(arg, p);
}
static foreign_t
p_random(term_t rnd)
{
double fli;
long int t1, t2, t3;
t1 = (a1 * 171) % 30269;
t2 = (b1 * 172) % 30307;
t3 = (c1 * 170) % 30323;
fli = (t1/30269.0) + (t2/30307.0) + (t3/30323.0);
a1 = (short)t1;
b1 = (short)t2;
c1 = (short)t3;
return PL_unify_float(rnd, fli-(int)(fli));
}
static foreign_t
p_setrand(term_t state)
{ if ( !PL_is_functor(state, FUNCTOR_rand3) )
return type_error(state, "rand_state");
if ( !get_short_arg_ex(1, state, &a1) ||
!get_short_arg_ex(2, state, &b1) ||
!get_short_arg_ex(3, state, &c1) )
return FALSE;
return TRUE;
}
static foreign_t
p_getrand(term_t state)
{ return PL_unify_term(state,
PL_FUNCTOR, FUNCTOR_rand3,
PL_INTEGER, a1,
PL_INTEGER, b1,
PL_INTEGER, c1);
}
install_t
install_random()
{ FUNCTOR_rand3 = PL_new_functor(PL_new_atom("rand"), 3);
PL_register_foreign("random", 1, p_random, 0);
PL_register_foreign("setrand", 1, p_setrand, 0);
PL_register_foreign("getrand", 1, p_getrand, 0);
}