static char RCSid[] =

"$Header: d:/cvsroot/tads/tads3/VMBIFTAD.CPP,v 1.3 1999/07/11 00:46:58 MJRoberts Exp $";

#endif

/* 

 *   Copyright (c) 1999, 2002 Michael J. Roberts.  All Rights Reserved.

 *   

 *   Please see the accompanying license file, LICENSE.TXT, for information

 *   on using and copying this software.  

 */

/*

Name

  vmbiftad.cpp - TADS built-in function set for T3 VM

Function

Notes

Modified

  04/05/99 MJRoberts  - Creation

*/

#include <stdio.h>

#include <string.h>

#include <time.h>

#include "t3std.h"

#include "os.h"

#include "utf8.h"

#include "vmuni.h"

#include "vmbiftad.h"

#include "vmstack.h"

#include "vmerr.h"

#include "vmerrnum.h"

#include "vmglob.h"

#include "vmpool.h"

#include "vmobj.h"

#include "vmstr.h"

#include "vmlst.h"

#include "vmrun.h"

#include "vmregex.h"

#include "vmundo.h"

#include "vmfile.h"

#include "vmsave.h"

#include "vmbignum.h"

#include "vmfunc.h"

#include "vmpat.h"

#include "vmtobj.h"

#include "vmvec.h"

#include "vmpredef.h"

/* ------------------------------------------------------------------------ */

/*

 *   forward statics 

 */

#ifdef VMBIFTADS_RNG_ISAAC

static void isaac_init(isaacctx *ctx, int flag);

#endif /* VMBIFTADS_RNG_ISAAC */

/* ------------------------------------------------------------------------ */

/*

 *   Initialize the TADS intrinsics global state 

 */

CVmBifTADSGlobals::CVmBifTADSGlobals(VMG0_)

{

    /* allocate our regular expression parser */

    rex_parser = new CRegexParser();

    rex_searcher = new CRegexSearcherSimple(rex_parser);

    /* 

     *   Allocate a global variable to hold the most recent regular

     *   expression search string.  We need this in a global so that the last

     *   search string is always protected from garbage collection; we must

     *   keep the string because we might need it to extract a group-match

     *   substring.  

     */

    last_rex_str = G_obj_table->create_global_var();

#ifdef VMBIFTADS_RNG_LCG

    /* 

     *   Set the random number seed to a fixed starting value (this value

     *   is arbitrary; we chose it by throwing dice).  If the program

     *   wants another sequence, it can manually change this by calling

     *   the randomize() intrinsic in our function set, which seeds the

     *   generator with an OS-dependent starting value (usually based on

     *   the system's real-time clock, to ensure that each run will use a

     *   different starting value).  

     */

    rand_seed = 024136543305;

#endif

#ifdef VMBIFTADS_RNG_ISAAC

    /* create the ISAAC context structure */

    isaac_ctx = (struct isaacctx *)t3malloc(sizeof(struct isaacctx));

    /* initialize with a fixed seed vector */

    isaac_init(isaac_ctx, FALSE);

#endif

}

/*

 *   delete the TADS intrinsics global state 

 */

CVmBifTADSGlobals::~CVmBifTADSGlobals()

{

    /* delete our regular expression searcher and parser */

    delete rex_searcher;

    delete rex_parser;

    /* 

     *   note that we leave our last_rex_str global variable undeleted here,

     *   as we don't have access to G_obj_table (as there's no VMG_ to a

     *   destructor); this is okay, since the object table will take care of

     *   deleting the variable for us when the object table itself is deleted

     */

#ifdef VMBIFTADS_RNG_ISAAC

    /* delete the ISAAC context */

    t3free(isaac_ctx);

#endif

}

/* ------------------------------------------------------------------------ */

/*

 *   datatype - get the datatype of a given value

 */

void CVmBifTADS::datatype(VMG_ uint argc)

{

    vm_val_t val;

    vm_val_t retval;

    /* check arguments */

    check_argc(vmg_ argc, 1);

    /* pop the value */

    G_stk->pop(&val);

    /* return the appropriate value for this type */

    retval.set_datatype(vmg_ &val);

    retval_int(vmg_ retval.val.intval);

}

/* ------------------------------------------------------------------------ */

/*

 *   getarg - get the given argument to the current procedure 

 */

void CVmBifTADS::getarg(VMG_ uint argc)

{

    int idx;

    /* check arguments */

    check_argc(vmg_ argc, 1);

    /* get the argument index value */

    idx = pop_int_val(vmg0_);

    /* if the argument index is out of range, throw an error */

    if (idx < 1 || idx > G_interpreter->get_cur_argc(vmg0_))

        err_throw(VMERR_BAD_VAL_BIF);

    /* push the parameter value */

    *G_interpreter->get_r0() = *G_interpreter->get_param(vmg_ idx - 1);

}

/* ------------------------------------------------------------------------ */

/*

 *   firstobj - get the first object instance

 */

void CVmBifTADS::firstobj(VMG_ uint argc)

{

    /* check arguments */

    check_argc_range(vmg_ argc, 0, 2);

    /* enumerate objects starting with object 1 in the master object table */

    enum_objects(vmg_ argc, (vm_obj_id_t)1);

}

/*

 *   nextobj - get the next object instance after a given object

 */

void CVmBifTADS::nextobj(VMG_ uint argc)

{

    vm_val_t val;

    vm_obj_id_t prv_obj;

    /* check arguments */

    check_argc_range(vmg_ argc, 1, 3);

    /* get the previous object */

    G_interpreter->pop_obj(vmg_ &val);

    prv_obj = val.val.obj;

    /* 

     *   Enumerate objects starting with the next object in the master

     *   object table after the given object.  Reduce the argument count by

     *   one, since we've removed the preceding object.  

     */

    enum_objects(vmg_ argc - 1, prv_obj + 1);

}

/* enum_objects flags */

#define VMBIFTADS_ENUM_INSTANCES  0x0001

#define VMBIFTADS_ENUM_CLASSES    0x0002

/*

 *   Common handler for firstobj/nextobj object iteration

 */

void CVmBifTADS::enum_objects(VMG_ uint argc, vm_obj_id_t start_obj)

{

    vm_val_t val;

    vm_obj_id_t sc;

    vm_obj_id_t obj;

    unsigned long flags;

    /* presume no superclass filter will be specified */

    sc = VM_INVALID_OBJ;

    /* presume we're enumerating instances only */

    flags = VMBIFTADS_ENUM_INSTANCES;

    /* 

     *   check arguments - we can optionally have two more arguments: a

     *   superclass whose instances/subclasses we are to enumerate, and an

     *   integer giving flag bits 

     */

    if (argc == 2)

    {

        /* pop the object */

        G_interpreter->pop_obj(vmg_ &val);

        sc = val.val.obj;

        /* pop the flags */

        flags = pop_long_val(vmg0_);

    }

    else if (argc == 1)

    {

        /* check to see if it's an object or the flags integer */

        switch (G_stk->get(0)->typ)

        {

        case VM_INT:

            /* it's the flags */

            flags = pop_long_val(vmg0_);

            break;

        case VM_OBJ:

            /* it's the superclass filter */

            G_interpreter->pop_obj(vmg_ &val);

            sc = val.val.obj;

            break;

        default:

            /* invalid argument type */

            err_throw(VMERR_BAD_TYPE_BIF);

        }

    }

    /* presume we won't find anything */

    retval_nil(vmg0_);

    /* 

     *   starting with the given object, scan objects until we find one

     *   that's valid and matches our superclass, if one was provided 

     */

    for (obj = start_obj ; obj < G_obj_table->get_max_used_obj_id() ; ++obj)

    {

        /* 

         *   If it's valid, and it's not an intrinsic class modifier object,

         *   consider it further.  Skip intrinsic class modifiers, since

         *   they're not really separate objects; they're really part of the

         *   intrinsic class they modify, and all of the properties and

         *   methods of a modifier object are reachable through the base

         *   intrinsic class.  

         */

        if (G_obj_table->is_obj_id_valid(obj)

            && !CVmObjIntClsMod::is_intcls_mod_obj(vmg_ obj))

        {

            /* 

             *   if it's a class, skip it if the flags indicate classes are

             *   not wanted; if it's an instance, skip it if the flags

             *   indicate that instances are not wanted 

             */

            if (vm_objp(vmg_ obj)->is_class_object(vmg_ obj))

            {

                /* it's a class - skip it if classes are not wanted */

                if ((flags & VMBIFTADS_ENUM_CLASSES) == 0)

                    continue;

            }

            else

            {

                /* it's an instance - skip it if instances are not wanted */

                if ((flags & VMBIFTADS_ENUM_INSTANCES) == 0)

                    continue;

            }

            /* 

             *   if a superclass was specified, and it matches, we have a

             *   winner 

             */

            if (sc != VM_INVALID_OBJ)

            {

                /* if the object matches, return it */

                if (vm_objp(vmg_ obj)->is_instance_of(vmg_ sc))

                {

                    retval_obj(vmg_ obj);

                    break;

                }

            }

            else

            {

                /* 

                 *   We're enumerating all objects - but skip List and String

                 *   object, as we expose these are special types.  

                 */

                if (vm_objp(vmg_ obj)->get_as_list() == 0

                    && vm_objp(vmg_ obj)->get_as_string(vmg0_) == 0)

                {

                    retval_obj(vmg_ obj);

                    break;

                }

            }

        }

    }

}

/* ------------------------------------------------------------------------ */

/*

 *   Random number generators.  Define one of the following configuration

 *   variables to select a random number generation algorithm:

 *   

 *   VMBIFTADS_RNG_LCG - linear congruential generator

 *.  VMBIFTADS_RNG_ISAAC - ISAAC (cryptographic hash generator) 

 */

/* ------------------------------------------------------------------------ */

/*

 *   Linear Congruential Random-Number Generator.  This generator uses an

 *   algorithm from Knuth, The Art of Computer Programming, Volume 2, p.

 *   170, with parameters chosen from the same book for their good

 *   statistical properties and efficiency on 32-bit hardware.  

 */

#ifdef VMBIFTADS_RNG_LCG

/*

 *   randomize - seed the random-number generator 

 */

void CVmBifTADS::randomize(VMG_ uint argc)

{

    /* check arguments */

    check_argc(vmg_ argc, 0);

    /* seed the generator */

    os_rand(&G_bif_tads_globals->rand_seed);

}

/*

 *   generate the next random number - linear congruential generator 

 */

static ulong rng_next(VMG0_)

{

    const ulong a = 1664525L;

    const ulong c = 1;

    /* 

     *   Generate the next random value using the linear congruential

     *   method described in Knuth, The Art of Computer Programming,

     *   volume 2, p170.

     *   

     *   Use 2^32 as m, hence (n mod m) == (n & 0xFFFFFFFF).  This is

     *   efficient and is well-suited to 32-bit machines, works fine on

     *   larger machines, and will even work on 16-bit machines as long as

     *   the compiler can provide us with 32-bit arithmetic (which we

     *   assume extensively elsewhere anyway).

     *   

     *   We use a = 1664525, a multiplier which has very good results with

     *   the Spectral Test (see Knuth p102) with our choice of m.

     *   

     *   Use c = 1, since this trivially satisfies Knuth's requirements

     *   about common factors.

     *   

     *   Note that the result of the multiplication might overflow a

     *   32-bit ulong for values of rand_seed that are not small.  This

     *   doesn't matter, since if it does, the machine will naturally

     *   truncate high-order bits to yield the result mod 2^32.  So, on a

     *   32-bit machine, the (&0xFFFFFFFF) part is superfluous, but it's

     *   harmless and is needed for machines with a larger word size.  

     */

    G_bif_tads_globals->rand_seed =

        (long)(((a * (ulong)G_bif_tads_globals->rand_seed) + 1) & 0xFFFFFFFF);

    return (ulong)G_bif_tads_globals->rand_seed;

}

#endif /* VMBIFTADS_RNG_LCG */

/* ------------------------------------------------------------------------ */

/*

 *   ISAAC random number generator. 

 */

#ifdef VMBIFTADS_RNG_ISAAC

/* service macros for ISAAC random number generator */

#define isaac_ind(mm,x)  ((mm)[(x>>2)&(ISAAC_RANDSIZ-1)])

#define isaac_step(mix,a,b,mm,m,m2,r,x) \

{ \

    x = *m;  \

    a = ((a^(mix)) + *(m2++)) & 0xffffffff; \

    *(m++) = y = (isaac_ind(mm,x) + a + b) & 0xffffffff; \

    *(r++) = b = (isaac_ind(mm,y>>ISAAC_RANDSIZL) + x) & 0xffffffff; \

}

#define isaac_rand(r) \

    ((r)->cnt-- == 0 ? \

    (isaac_gen_group(r), (r)->cnt=ISAAC_RANDSIZ-1, (r)->rsl[(r)->cnt]) : \

    (r)->rsl[(r)->cnt])

#define isaac_mix(a,b,c,d,e,f,g,h) \

{ \

    a^=b<<11; d+=a; b+=c; \

    b^=c>>2;  e+=b; c+=d; \

    c^=d<<8;  f+=c; d+=e; \

    d^=e>>16; g+=d; e+=f; \

    e^=f<<10; h+=e; f+=g; \

    f^=g>>4;  a+=f; g+=h; \

    g^=h<<8;  b+=g; h+=a; \

    h^=a>>9;  c+=h; a+=b; \

}

/* generate the group of numbers */

static void isaac_gen_group(isaacctx *ctx)

{

    ulong a;

    ulong b;

    ulong x;

    ulong y;

    ulong *m;

    ulong *mm;

    ulong *m2;

    ulong *r;

    ulong *mend;

    mm = ctx->mem;

    r = ctx->rsl;

    a = ctx->a;

    b = (ctx->b + (++ctx->c)) & 0xffffffff;

    for (m = mm, mend = m2 = m + (ISAAC_RANDSIZ/2) ; m<mend ; )

    {

        isaac_step(a<<13, a, b, mm, m, m2, r, x);

        isaac_step(a>>6,  a, b, mm, m, m2, r, x);

        isaac_step(a<<2,  a, b, mm, m, m2, r, x);

        isaac_step(a>>16, a, b, mm, m, m2, r, x);

    }

    for (m2 = mm; m2<mend; )

    {

        isaac_step(a<<13, a, b, mm, m, m2, r, x);

        isaac_step(a>>6,  a, b, mm, m, m2, r, x);

        isaac_step(a<<2,  a, b, mm, m, m2, r, x);

        isaac_step(a>>16, a, b, mm, m, m2, r, x);

    }

    ctx->b = b;

    ctx->a = a;

}

/* 

 *   Initialize.  If flag is true, then use the contents of ctx->rsl[] to

 *   initialize ctx->mm[]; otherwise, we'll use a fixed starting

 *   configuration.  

 */

static void isaac_init(isaacctx *ctx, int flag)

{

    int i;

    ulong a;

    ulong b;

    ulong c;

    ulong d;

    ulong e;

    ulong f;

    ulong g;

    ulong h;

    ulong *m;

    ulong *r;

    ctx->a = ctx->b = ctx->c = 0;

    m = ctx->mem;

    r = ctx->rsl;

    a = b = c = d = e = f = g = h = 0x9e3779b9;         /* the golden ratio */

    /* scramble the initial settings */

    for (i = 0 ; i < 4 ; ++i)

    {

        isaac_mix(a, b, c, d, e, f, g, h);

    }

    if (flag) 

    {

        /* initialize using the contents of ctx->rsl[] as the seed */

        for (i = 0 ; i < ISAAC_RANDSIZ ; i += 8)

        {

            a += r[i];   b += r[i+1]; c += r[i+2]; d += r[i+3];

            e += r[i+4]; f += r[i+5]; g += r[i+6]; h += r[i+7];

            isaac_mix(a, b, c, d, e, f, g, h);

            m[i] = a;   m[i+1] = b; m[i+2] = c; m[i+3] = d;

            m[i+4] = e; m[i+5] = f; m[i+6] = g; m[i+7] = h;

        }

        /* do a second pass to make all of the seed affect all of m */

        for (i = 0 ; i < ISAAC_RANDSIZ ; i += 8)

        {

            a += m[i];   b += m[i+1]; c += m[i+2]; d += m[i+3];

            e += m[i+4]; f += m[i+5]; g += m[i+6]; h += m[i+7];

            isaac_mix(a, b, c, d, e, f, g, h);

            m[i] = a;   m[i+1] = b; m[i+2] = c; m[i+3] = d;

            m[i+4] = e; m[i+5] = f; m[i+6] = g; m[i+7] = h;

        }

    }

    else

    {

        /* initialize using fixed initial settings */

        for (i = 0 ; i < ISAAC_RANDSIZ ; i += 8)

        {

            isaac_mix(a, b, c, d, e, f, g, h);

            m[i] = a; m[i+1] = b; m[i+2] = c; m[i+3] = d;

            m[i+4] = e; m[i+5] = f; m[i+6] = g; m[i+7] = h;

        }

    }

    /* fill in the first set of results */

    isaac_gen_group(ctx);

    /* prepare to use the first set of results */    

    ctx->cnt = ISAAC_RANDSIZ;

}

/*

 *   seed the rng 

 */

void CVmBifTADS::randomize(VMG_ uint argc)

{

    int i;

    long seed;

    /* check arguments */

    check_argc(vmg_ argc, 0);

    /* seed the generator */

    os_rand(&seed);

    /* 

     *   Fill in rsl[] with the seed. It doesn't do a lot of good to call

     *   os_rand() repeatedly, since this function might simply return the

     *   real-time clock value.  So, use the os_rand() seed value as the

     *   first rsl[] value, then use a simple linear congruential

     *   generator to fill in the rest of rsl[].  

     */

    for (i = 0 ; i < ISAAC_RANDSIZ ; ++i)

    {

        const ulong a = 1664525L;

        /* fill in this value from the previous seed value */

        G_bif_tads_globals->isaac_ctx->rsl[i] = (ulong)seed;

        /* generate the next lcg value */

        seed = (long)(((a * (ulong)seed) + 1) & 0xFFFFFFFF);

    }

    /* initialize with this rsl[] array */

    isaac_init(G_bif_tads_globals->isaac_ctx, TRUE);

}

/*

 *   generate the next random number - ISAAC (by Bob Jenkins,

 *   http://ourworld.compuserve.com/homepages/bob_jenkins/isaacafa.htm) 

 */

static ulong rng_next(VMG0_)

{

    /* return the next number */

    return isaac_rand(G_bif_tads_globals->isaac_ctx);

}

#endif /* VMBIFTADS_RNG_ISAAC */

/* ------------------------------------------------------------------------ */

/*

 *   rand - generate a random number, or choose an element randomly from a

 *   list of values or from our list of arguments.

 *   

 *   With one integer argument N, we choose a random number from 0 to N-1.

 *   

 *   With one list argument, we choose a random element of the list.

 *   

 *   With multiple arguments, we choose one argument at random and return

 *   its value.  Note that, because this is an ordinary built-in function,

 *   all of our arguments will be fully evaluated.  

 */

void CVmBifTADS::rand(VMG_ uint argc)

{

    ulong range;

    int use_range;

    int choose_an_arg;

    const char *listp;

    ulong rand_val;

    CVmObjVector *vec = 0;

    vm_obj_id_t vecid = VM_INVALID_OBJ;

    /* presume we're not going to choose from our arguments or from a list */

    choose_an_arg = FALSE;

    listp = 0;

    /* determine the desired range of values based on the arguments */

    if (argc == 0)

    {

        /* 

         *   if no argument is given, produce a random number in our full

         *   range - clear the 'use_range' flag to so indicate

         */

        use_range = FALSE;

    }

    else if (argc == 1 && G_stk->get(0)->typ == VM_INT)

    {

        /* we're returning a number in the range 0..(arg-1) */

        range = G_stk->get(0)->val.intval;

        use_range = TRUE;

        /* discard the argument */

        G_stk->discard();

    }

    else if (argc == 1)

    {

        /* check for a vector or a list */

        if (G_stk->get(0)->typ == VM_OBJ

            && CVmObjVector::is_vector_obj(vmg_ G_stk->get(0)->val.obj))

        {

            /* 

             *   it's a vector - get the object pointer, but leave it on the

             *   stack for GC protection for now 

             */

            vecid = G_stk->get(0)->val.obj;

            vec = (CVmObjVector *)vm_objp(vmg_ vecid);

            /* the range is 0..(vector_length-1) */

            range = vec->get_element_count();

            use_range = TRUE;

        }

        else

        {

            /* it must be a list - pop the list value */

            listp = pop_list_val(vmg0_);

            /* our range is 0..(list_element_count-1) */

            range = vmb_get_len(listp);

            use_range = TRUE;

        }

    }

    else

    {

        /* 

         *   produce a random number in the range 0..(argc-1) so that we

         *   can select one of our arguments 

         */

        range = argc;

        use_range = TRUE;

        /* note that we should choose an argument value */

        choose_an_arg = TRUE;

    }

    /* get the next random number */

    rand_val = rng_next(vmg0_);

    /*

     *   Calculate our random value in the range 0..(range-1).  If range

     *   == 0, simply choose a value across our full range.  

     */

    if (use_range)

    {

        unsigned long hi;

        unsigned long lo;

        /* 

         *   A range was specified, so choose in our range.  As Knuth

         *   suggests, don't simply take the low-order bits from the value,

         *   since these are the least random part.  Instead, use the method

         *   Knuth describes in TAOCP Vol 2 section 3.4.2.

         *   

         *   Avoid floating point arithmetic - use an integer calculation

         *   instead.  This code performs a 64-bit fixed-point calculation

         *   using 32-bit values.

         *   

         *   The calculation we're really performing is this:

         *   

         *   rand_val = (ulong)((((double)rand_val) / 4294967296.0)

         *.             * (double)range); 

         */

        /* calculate the high-order 32 bits of (rand_val / 2^32 * range) */

        hi = (((rand_val >> 16) & 0xffff) * ((range >> 16) & 0xffff))

             + ((((rand_val >> 16) & 0xffff) * (range & 0xffff)) >> 16)

             + (((rand_val & 0xffff) * ((range >> 16) & 0xffff)) >> 16);

        /* calculate the low-order 32 bits */

        lo = ((((rand_val >> 16) & 0xffff) * (range & 0xffff)) & 0xffff)

             + (((rand_val & 0xffff) * ((range >> 16) & 0xffff)) & 0xffff)

             + ((((rand_val & 0xffff) * (range & 0xffff)) >> 16) & 0xffff);

        /* 

         *   add the carry from the low part into the high part to get the

         *   result 

         */

        rand_val = hi + (lo >> 16);

    }

    /*

     *   Return the appropriate value, depending on our argument list 

     */

    if (choose_an_arg)

    {

        /* return the selected argument */

        retval(vmg_ G_stk->get((int)rand_val));

        /* discard all of the arguments */

        G_stk->discard(argc);

    }

    else if (vec != 0)

    {

        vm_val_t val;

        /* get the selected element */

        if (range == 0)

        {

            /* there are no elements to choose from, so return nil */

            val.set_nil();

        }

        else

        {

            vm_val_t idxval;

            /* get the selected vector element */

            idxval.set_int(rand_val + 1);

            vec->index_val(vmg_ &val, vecid, &idxval);

        }

        /* set the result */

        retval(vmg_ &val);

        /* discard our gc protection */

        G_stk->discard();

    }

    else if (listp != 0)

    {

        vm_val_t val;

        /* as a special case, if the list has zero elements, return nil */

        if (vmb_get_len(listp) == 0)

        {

            /* there are no elements to choose from, so return nil */

            val.set_nil();

        }

        else

        {

            /* get the selected list element */

            vmb_get_dh(listp + VMB_LEN

                       + (size_t)((rand_val * VMB_DATAHOLDER)), &val);

        }

        /* set the result */

        retval(vmg_ &val);

    }

    else

    {

        /* simply return the random number */

        retval_int(vmg_ (long)rand_val);

    }

}

/* ------------------------------------------------------------------------ */

/*

 *   Bit-shift generator.  This is from Knuth, The Art of Computer

 *   Programming, volume 2.  This generator is designed to produce random

 *   strings of bits and is not suitable for use as a general-purpose RNG.

 *   

 *   Linear congruential generators are not ideal for generating random

 *   bits; their statistical properties seem better suited for generating

 *   values over a wider range.  This generator is specially designed to

 *   produce random bits, so it could be a useful complement to an LCG RNG.

 *   

 *   This code should not be enabled in its present state; it's retained

 *   in case we want in the future to implement a generator exclusively

 *   for random bits.  The ISAAC generator seems to be a good source of

 *   random bits as well as random numbers, so it seems unlikely that

 *   we'll need a separate random bit generator.  

 */

#ifdef VMBIFTADS_RNG_BITSHIFT

void CVmBifTADS::randbit(VMG_ uint argc)

{

    int top_bit;

    /* check arguments */

    check_argc(vmg_ argc, 0);

    top_bit = (G_bif_tads_globals->rand_seed & 0x8000000);

    G_bif_tads_globals->rand_seed <<= 1;

    if (top_bit)

        G_bif_tads_globals->rand_seed ^= 035604231625;

    retval_int(vmg_ (long)(G_bif_tads_globals->rand_seed & 1));

}

#endif /* VMBIFTADS_RNG_BITSHIFT */

/* ------------------------------------------------------------------------ */

/*

 *   cvtstr (toString) - convert to string 

 */

void CVmBifTADS::cvtstr(VMG_ uint argc)

{

    const char *p;

    char buf[50];

    vm_val_t val;

    int radix;

    vm_val_t new_str;

    /* check arguments */

    check_argc_range(vmg_ argc, 1, 2);

    /* pop the argument */

    G_stk->pop(&val);

    /* if there's a radix specified, pop it as well */

    if (argc == 2)

    {

        /* get the radix from the stack */

        radix = pop_int_val(vmg0_);

    }

    else

    {

        /* use decimal by default */

        radix = 10;

    }

    /* convert the value */

    p = CVmObjString::cvt_to_str(vmg_ &new_str,

                                 buf, sizeof(buf), &val, radix);

    /* save the new string on the stack to protect from garbage collection */

    G_stk->push(&new_str);

    /* create and return a string from our new value */

    retval_obj(vmg_ CVmObjString::create(vmg_ FALSE,

                                         p + VMB_LEN, vmb_get_len(p)));

    /* done with the new string */

    G_stk->discard();

}

/*

 *   cvtnum (toInteger) - convert to an integer

 */

void CVmBifTADS::cvtnum(VMG_ uint argc)

{

    const char *strp;

    size_t len;

    int radix;

    vm_val_t *valp;

    /* check arguments */

    check_argc_range(vmg_ argc, 1, 2);

    /* 

     *   check for a BigNumber and convert it (not very object-oriented,

     *   but this is a type-conversion routine, so special awareness of

     *   individual types isn't that weird) 

     */

    valp = G_stk->get(0);

    if (valp->typ == VM_OBJ

        && CVmObjBigNum::is_bignum_obj(vmg_ valp->val.obj))

    {

        long intval;

        /* convert it as a BigNumber */