Back to index

plt-scheme  4.2.1
Classes | Defines | Functions | Variables
bitmatrix.c File Reference
#include "escheme.h"

Go to the source code of this file.

Classes

struct  Bitmatrix

Defines

#define LONG_SIZE   32
#define LOG_LONG_SIZE   5
#define LONG_SIZE_PER_BYTE   4
#define FIND_BIT(p)   (1 << (p & (LONG_SIZE - 1)))

Functions

static int negative (Scheme_Object *o)
Scheme_Objectmake_bit_matrix (int argc, Scheme_Object **argv)
static void range_check_one (char *name, char *which, int l, int h, int startpos, int argc, Scheme_Object **argv)
static Scheme_Objectdo_bit_matrix (char *name, int get, int argc, Scheme_Object **argv)
Scheme_Objectbit_matrix_get (int argc, Scheme_Object **argv)
Scheme_Objectbit_matrix_set (int argc, Scheme_Object **argv)
Scheme_Objectbit_matrix_invert (int argc, Scheme_Object **argv)
Scheme_Objectbit_matrix_clear (int argc, Scheme_Object **argv)
Scheme_Objectscheme_reload (Scheme_Env *env)
Scheme_Objectscheme_initialize (Scheme_Env *env)
Scheme_Objectscheme_module_name ()

Variables

static Scheme_Objectmult
static Scheme_Objectadd
static Scheme_Objectsub
static Scheme_Objectmodulo
static Scheme_Objectneg
static Scheme_Type bitmatrix_type

Class Documentation

struct Bitmatrix

Definition at line 22 of file bitmatrix.c.

Collaboration diagram for Bitmatrix:
Class Members
unsigned long h
unsigned long l
unsigned long * matrix
Scheme_Object so
unsigned long w

Define Documentation

#define FIND_BIT (   p)    (1 << (p & (LONG_SIZE - 1)))

Definition at line 59 of file bitmatrix.c.

#define LOG_LONG_SIZE   5

Definition at line 56 of file bitmatrix.c.

#define LONG_SIZE   32

Definition at line 55 of file bitmatrix.c.

#define LONG_SIZE_PER_BYTE   4

Definition at line 57 of file bitmatrix.c.


Function Documentation

Scheme_Object* bit_matrix_clear ( int  argc,
Scheme_Object **  argv 
)

Definition at line 240 of file bitmatrix.c.

{
  char *name = "bit-matrix-clear!";
  Bitmatrix *bm;
  unsigned long i;

  if (SCHEME_TYPE(argv[0]) != bitmatrix_type)
    scheme_wrong_type(name, "bit-matrix", 0, argc, argv);

  bm = (Bitmatrix *)argv[0];

  i = (bm->l * bm->h) >> LOG_LONG_SIZE;
  while (i--) {
    bm->matrix[i] = 0;
  }

  return scheme_void;
}

Here is the caller graph for this function:

Scheme_Object* bit_matrix_get ( int  argc,
Scheme_Object **  argv 
)

Definition at line 209 of file bitmatrix.c.

{
  return do_bit_matrix("bit-matrix-get", 1, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 221 of file bitmatrix.c.

{
  Bitmatrix *bm;
  unsigned long i;

  if (SCHEME_TYPE(argv[0]) != bitmatrix_type)
    scheme_wrong_type("bit-matrix-invert!", "bit-matrix", 0, argc, argv);

  bm = (Bitmatrix *)argv[0];
  
  i = (bm->l * bm->h) >> LOG_LONG_SIZE;
  while (i--) {
    bm->matrix[i] = ~bm->matrix[i];
  }

  return scheme_void;
}

Here is the caller graph for this function:

Scheme_Object* bit_matrix_set ( int  argc,
Scheme_Object **  argv 
)

Definition at line 215 of file bitmatrix.c.

{
  return do_bit_matrix("bit-matrix-set!", 0, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_bit_matrix ( char *  name,
int  get,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 172 of file bitmatrix.c.

{
  Bitmatrix *bm;
  unsigned long x, y, p, v, m;

  if (SCHEME_TYPE(argv[0]) != bitmatrix_type)
    scheme_wrong_type(name, "bit-matrix", 0, argc, argv);
  if (!SCHEME_INTP(argv[1])  && !SCHEME_BIGNUMP(argv[1]))
    scheme_wrong_type(name, "integer", 1, argc, argv);
  if (!SCHEME_INTP(argv[2])  && !SCHEME_BIGNUMP(argv[2]))
    scheme_wrong_type(name, "integer", 2, argc, argv);

  /* After checking that argv[0] has te bitmatrix_type tag, we can safely perform
     a cast to Bitmatrix*: */
  bm = (Bitmatrix *)argv[0];

  range_check_one(name, "first", 0, bm->w - 1, 1, argc, argv);
  range_check_one(name, "second", 0, bm->h - 1, 2, argc, argv);

  x = SCHEME_INT_VAL(argv[1]);
  y = SCHEME_INT_VAL(argv[2]);

  p = y * bm->l + x;
  m = FIND_BIT(p);
  v = bm->matrix[p >> LOG_LONG_SIZE];
  if (get) {
    return (v & m) ? scheme_true : scheme_false;
  } else {
    if (SCHEME_TRUEP(argv[3]))
      bm->matrix[p >> LOG_LONG_SIZE] = (v | m);
    else
      bm->matrix[p >> LOG_LONG_SIZE] = (v - (v & m));
    return scheme_void;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* make_bit_matrix ( int  argc,
Scheme_Object **  argv 
)

Definition at line 69 of file bitmatrix.c.

{
  Scheme_Object *size, *rowlength, *a[2];
  unsigned long w, h, s, l, *lp;
  Bitmatrix *bm;

  /* Really fancy: we allow any kind of positive integer for
     specifying the size of a bit matrix. If we get a bignum (or the
     resulting matrix size is a bignum), we'll signal an out-of-memory
     exception. */
  if ((!SCHEME_INTP(argv[0])  && !SCHEME_BIGNUMP(argv[0]))
      || negative(argv[0]))
    scheme_wrong_type("make-bit-matrix", "positive integer", 0, argc, argv);
  if ((!SCHEME_INTP(argv[1])  && !SCHEME_BIGNUMP(argv[1]))
      || (negative(argv[1])))
    scheme_wrong_type("make-bit-matrix", "positive integer", 1, argc, argv);

  a[0] = argv[0];
  a[1] = scheme_make_integer(LONG_SIZE - 1);
  /* Apply the Scheme `add' procedure to argv[0] and argv[1]. Note the
     "_" in "_scheme_apply"; that's a lot faster than "scheme_apply",
     and we know that no continuation jumps will occur (although it
     would be fine if one did. */
  a[0] = _scheme_apply(add, 2, a);
  a[1] = scheme_make_integer(LONG_SIZE);
  a[1] = _scheme_apply(modulo, 2, a);
  a[0] = _scheme_apply(sub, 2, a);
  rowlength = a[0];
  a[1] = argv[1];
  size = _scheme_apply(mult, 2, a);
  if (SCHEME_BIGNUMP(size))
    /* Use scheme_raise_exn to raise exceptions. The first argument
       describes the type of the exception. After an exception-specific
       number of Scheme values (none in this case), the rest of the
       arguments are like printf. */
    scheme_raise_exn(MZEXN_FAIL, "make-bit-matrix: out of memory");
  
  s = SCHEME_INT_VAL(size);
  w = SCHEME_INT_VAL(argv[0]);
  h = SCHEME_INT_VAL(argv[1]);
  l = SCHEME_INT_VAL(rowlength);

  /* Malloc the bit matrix structure. Since we use scheme_malloc, the
     bit matrix value is GC-able. */
  bm = (Bitmatrix *)scheme_malloc_tagged(sizeof(Bitmatrix));
  bm->so.type = bitmatrix_type;

  /* Try to allocate the bit matrix. Handle failure gracefully. Note
     that we use scheme_malloc_atomic since the allocated memory will
     never contain pointers to GC-allocated memory. */
  s = ((s + LONG_SIZE - 1) >> LOG_LONG_SIZE);
  lp = (unsigned long *)scheme_malloc_fail_ok(scheme_malloc_atomic, 
                                         sizeof(long) * s);
  if (!lp)
    scheme_raise_exn(MZEXN_FAIL, "make-bit-matrix: out of memory");
  bm->matrix = lp;

  bm->w = w;
  bm->h = h;
  bm->l = l;

  /* Init matirx to all 0s: */
  while (s--) {
    bm->matrix[s] = 0;
  }

  return (Scheme_Object *)bm;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int negative ( Scheme_Object o) [static]

Definition at line 63 of file bitmatrix.c.

{
  return SCHEME_TRUEP(_scheme_apply(neg, 1, &o));
}

Here is the caller graph for this function:

static void range_check_one ( char *  name,
char *  which,
int  l,
int  h,
int  startpos,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 140 of file bitmatrix.c.

{
  int bad1;

  if (SCHEME_BIGNUMP(argv[startpos])) {
    bad1 = 1;
  } else {
    int v = SCHEME_INT_VAL(argv[startpos]);
    bad1 = ((v < l) || (v > h));
  }

  if (bad1) {
    /* A mismatch exception requires one Scheme value, so we provide
       it before the printf string: */
    char *args;
    long argslen;

    args = scheme_make_args_string("other ", startpos, argc, argv, &argslen);
    scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                   "%s: %s index %s is not in the range [%d,%d]%t",
                   name, which,
                   scheme_make_provided_string(argv[startpos], 1, NULL),
                   l, h,
                   args,
                   argslen);
  }
}

Here is the caller graph for this function:

Definition at line 296 of file bitmatrix.c.

{
  bitmatrix_type = scheme_make_type("<bit-matrix>");

#ifdef MZ_PRECISE_GC
  /* Register traversal procedures: */
  GC_register_traversers(bitmatrix_type, bm_size, bm_mark, bm_fixup, 1, 0);
#endif

  /* Get some Scheme primitives. Conservative garbage collection sees
     any local variables we use within a function, but we have to register
     static variables: */

  scheme_register_extension_global(&mult, sizeof(Scheme_Object*));
  mult = scheme_builtin_value("*");

  scheme_register_extension_global(&add, sizeof(Scheme_Object*));
  add = scheme_builtin_value("+");

  scheme_register_extension_global(&sub, sizeof(Scheme_Object*));
  sub = scheme_builtin_value("-");

  scheme_register_extension_global(&modulo, sizeof(Scheme_Object*));
  modulo = scheme_builtin_value("modulo");

  scheme_register_extension_global(&neg, sizeof(Scheme_Object*));
  neg = scheme_builtin_value("negative?");

  return scheme_reload(env);
}

Definition at line 328 of file bitmatrix.c.

{
  /* This extension doesn't define a module: */
  return scheme_false;
}

Definition at line 259 of file bitmatrix.c.

{
  /* Define our new primitives: */

  scheme_add_global("make-bit-matrix",
                  scheme_make_prim_w_arity(make_bit_matrix,
                                        "make-bit-matrix",
                                        2, 2),
                  env);

  scheme_add_global("bit-matrix-get",
                  scheme_make_prim_w_arity(bit_matrix_get,
                                        "bit-matrix-get",
                                        3, 3),
                  env);

  scheme_add_global("bit-matrix-set!",
                  scheme_make_prim_w_arity(bit_matrix_set,
                                        "bit-matrix-set!",
                                        4, 4),
                  env);

  scheme_add_global("bit-matrix-invert!",
                  scheme_make_prim_w_arity(bit_matrix_invert,
                                        "bit-matrix-invert!",
                                        1, 1),
                  env);

  scheme_add_global("bit-matrix-clear!",
                  scheme_make_prim_w_arity(bit_matrix_clear,
                                        "bit-matrix-clear!",
                                        1, 1),
                  env);

  return scheme_void;
}

Here is the caller graph for this function:


Variable Documentation

Scheme_Object * add [static]

Definition at line 50 of file bitmatrix.c.

Definition at line 53 of file bitmatrix.c.

Scheme_Object * modulo [static]

Definition at line 50 of file bitmatrix.c.

Scheme_Object* mult [static]

Definition at line 50 of file bitmatrix.c.

Scheme_Object * neg [static]

Definition at line 50 of file bitmatrix.c.

Scheme_Object * sub [static]

Definition at line 50 of file bitmatrix.c.