smob cleanup

[Keisuke Nishida]

Dirk Herrmann <address@hidden> writes:

> > I have made a patch as follows.  I'll check it again later on before
> > committing.
> 
> Very nice!  One small point, though:  I think that scm_bits_t _is_ the
> right type for the scm_tc16_* variables.  The reason is the
> following:  SCM_TYP16 (x) will deliver (SCM_CELL_TYPE (x) & 0xffff), and
> SCM_CELL_TYPE is of type scm_bits_t.  All the places where long was used
> are probably older, and the same is true for scm_make_smob_type.

Hmm, what about defining scm_type_t for clarify?

  typedef scm_bits_t scm_type_t;

And I think it would be great if there were some convention of smob type
definitions.  I have rewritten example-smob/image-type.[ch] in my style
as follows.  Is it a good thing to modify some of Guile's code in this
manner?

------------------------------------------------------------------------
/* image-type.h */

/*
 * Image type
 */

/* Type specifier */
extern scm_type_t scm_image_type;

/* Member structure */
struct scm_image {
  int width, height;
  char *pixels;

  SCM name;             /* The name of this image */

  SCM update_func;      /* A function to call when this image is
                           modified, e.g., to update the screen,
                           or SCM_BOOL_F if no action necessary */
};

/* Basic macros */
#define SCM_IMAGE_P(X)           SCM_SMOB_PREDICATE (scm_image_type, X)
#define SCM_VALIDATE_IMAGE(N,X)  SCM_MAKE_VALIDATE (N, X, IMAGE_P)
#define SCM_IMAGE_DATA(X)        ((struct scm_image *) SCM_SMOB_DATA (X))

/* Accessor macros */
#define SCM_IMAGE_WIDTH(X)       (SCM_IMAGE_DATA(X)->width)
#define SCM_IMAGE_HEIGHT(X)      (SCM_IMAGE_DATA(X)->height)
#define SCM_IMAGE_PIXELS(X)      (SCM_IMAGE_DATA(X)->pixels)
#define SCM_IMAGE_NAME(X)        (SCM_IMAGE_DATA(X)->name)
#define SCM_IMAGE_UPDATE_FUNC(X) (SCM_IMAGE_DATA(X)->update_func)

/* Function prototypes */
SCM scm_make_image (SCM name, SCM width, SCM height);
SCM scm_clear_image (SCM image);
void scm_init_image_type (void);

------------------------------------------------------------------------
/* image-type.c */

#include <string.h>
#include <libguile.h>
#include "image-type.h"

/*
 * Image type
 */

scm_bits_t scm_image_type;

static SCM
make_image (SCM name, int width, int height)
{
  struct scm_image *data =
    scm_must_malloc (sizeof (struct scm_image), "image");
  data->width = width;
  data->height = height;
  data->pixels = scm_must_malloc (width * height, "image pixels");
  data->name = name;
  data->update_func = SCM_BOOL_F;
  SCM_RETURN_NEWSMOB (scm_image_type, data);
}

static SCM
image_mark (SCM image)
{
  scm_gc_mark (SCM_IMAGE_NAME (image));
  return SCM_IMAGE_UPDATE_FUNC (image);
}

static scm_sizet
image_free (SCM image)
{
  struct scm_image *data = SCM_IMAGE_DATA (image);
  scm_sizet size = data->width * data->height + sizeof (struct scm_image);
  free (data->pixels);
  free (data);
  return size;
}

static int
image_print (SCM image, SCM port, scm_print_state *pstate)
{
  scm_puts ("#<image ", port);
  scm_display (SCM_IMAGE_NAME (image), port);
  scm_puts (">", port);
  return 1;     /* non-zero means success */
}

/* Scheme procedures */

SCM
scm_make_image (SCM name, SCM width, SCM height)
#define FUNC_NAME "make-image"
{
  SCM_VALIDATE_STRING (1, name);
  SCM_VALIDATE_INUM (2, width);
  SCM_VALIDATE_INUM (3, height);

  return make_image (name, SCM_INUM (width), SCM_INUM (height));
}
#undef FUNC_NAME

SCM
scm_clear_image (SCM image)
#define FUNC_NAME "clear-image"
{
  int area;

  SCM_VALIDATE_IMAGE (1, image);

  area = SCM_IMAGE_WIDTH (image) * SCM_IMAGE_HEIGHT (image);
  memset (SCM_IMAGE_PIXELS (image), 0, area);

  /* Invoke the image's update function.  */
  if (SCM_NFALSEP (SCM_IMAGE_UPDATE_FUNC (image)))
    return scm_apply (SCM_IMAGE_UPDATE_FUNC (image), SCM_EOL, SCM_EOL);

  return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

/* Initialization */

void
scm_init_image_type ()
{
  /* Create the image type */
  scm_image_type = scm_make_smob_type ("image", sizeof (struct scm_image));
  scm_set_smob_mark (scm_image_type, image_mark);
  scm_set_smob_free (scm_image_type, image_free);
  scm_set_smob_print (scm_image_type, image_print);

  /* Create Scheme procedures */
  scm_make_gsubr ("make-image", 3, 0, 0, scm_make_image);
  scm_make_gsubr ("clear-image", 1, 0, 0, scm_clear_image);
}