clib package

2010-06-17 00:40:25 +01:00
parent a180e48cfa
commit 40febfdf9b
163 changed files with 57246 additions and 0 deletions
--- a/packages/clib/random.c
+++ b/packages/clib/random.c
@@ -0,0 +1,155 @@
+/*  $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);
+}
+