ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/c/num_rand.c

This is num_rand.c in view mode; [Download] [Up]

/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/

/*
	Random numbers
*/

#include "include.h"
#include "num_include.h"

#ifdef AOSVS

#endif

object
rando(x, rs)
object x, rs;
{
	enum type tx;
	object z;
	double d;
	
	tx = type_of(x);
	if (number_compare(x, small_fixnum(0)) != 1)
		FEwrong_type_argument(TSpositive_number, x);
	d = (double)(rs->rnd.rnd_value>>1) / (4294967296.0/2.0);
	d = number_to_double(x) * d;
	if (tx == t_fixnum) {
		z = make_fixnum((int)d);
		return(z);
	} else if (tx == t_bignum) {
		z = double_to_integer(d);
		return(z);
	} else if (tx == t_shortfloat) {
		z = alloc_object(t_shortfloat);
		sf(z) = (float)d;
		return(z);
	} else if (tx == t_longfloat) {
		z = alloc_object(t_longfloat);
		lf(z) = d;
		return(z);
	} else
		FEerror("~S is not an integer nor a floating-point number.",
			1, x);
}

object
make_random_state(rs)
object rs;
{
        object z;
#ifdef AOSVS

#endif

	if (rs == Cnil) {
		z = alloc_object(t_random);
		z->rnd.rnd_value = symbol_value(Vrandom_state)->rnd.rnd_value;
		return(z);
	} else if (rs == Ct) {
		z = alloc_object(t_random);
#ifdef UNIX
		z->rnd.rnd_value = time(0);
#endif
#ifdef AOSVS




#endif
		return(z);
	} else if (type_of(rs) != t_random)
   		FEwrong_type_argument(Srandom_state, rs);
	else {
		z =alloc_object(t_random);
		z->rnd.rnd_value = rs->rnd.rnd_value;
		return(z);
	}
}

advance_random_state(rs)
object rs;
{
	rs->rnd.rnd_value
	= rs->rnd.rnd_value
	+ (rs->rnd.rnd_value<<2)
	+ (rs->rnd.rnd_value<<17)
	+ (rs->rnd.rnd_value<<27);
}


Lrandom()
{
	int j;
        object x;
	object rs;
	
	j = vs_top - vs_base;
	if (j == 1)
		vs_push(symbol_value(Vrandom_state));
	check_arg(2);
	check_type_random_state(&vs_base[1]);
	advance_random_state(vs_base[1]);
	x = rando(vs_base[0], vs_base[1]);
	vs_top = vs_base;
	vs_push(x);
}

Lmake_random_state()
{
	int j;
	object x;

	j = vs_top - vs_base;
	if (j == 0)
		vs_push(Cnil);
	check_arg(1);
	x = make_random_state(vs_head);
	vs_top = vs_base;
	vs_push(x);
}

Lrandom_state_p()
{
	check_arg(1);
	if (type_of(vs_pop) == t_random)
		vs_push(Ct);
	else
		vs_push(Cnil);
}

init_num_rand()
{
        Vrandom_state = make_special("*RANDOM-STATE*",
				     make_random_state(Ct));

	make_function("RANDOM", Lrandom);
	make_function("MAKE-RANDOM-STATE", Lmake_random_state);
	make_function("RANDOM-STATE-P", Lrandom_state_p);
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.