/* libsizzle/pointer.c - pointer handling primitive procedures
 
  Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <assert.h>

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "alloc.h"
#include "node.h"
#include "validate.h"
#include "capi.h"
#include "pointer.h"

/* Mark the pointer object @var{pointer} as being invalid, so that
   functions expecting valid pointer objects will barf when
   @var{pointer} is passed to them in the future.  */
void
zzz_invalidate_pointer (zzz_scm_t pointer)
{
  to_tagged_ptr (pointer)->fill[3] = 0;
}

/*:doc
  pointer?
  (pointer? obj) => boolean
  Return @code{#t} if @var{obj}is a pointer object.
  doc:*/
#define FUNC_NAME "pointer?"
static result_t
pointer_p_func (zzz_scm_t env, zzz_scm_t obj, zzz_scm_t * result)
{
  if (pointer_p (obj))
    *result = zzz_true_value;
  else
    *result = zzz_false_value;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  make-pointer
  (make-pointer n) => pointer
  Create a new pointer object.  @var{n} must be a non-negative
  integer, and a memory block big enough to hold @var{n} bytes will be
  allocated and the pointer will point to it.  If @var{n} is 0, then
  a null-pointer will be returned.
  doc:*/
#define FUNC_NAME "make-pointer"
static result_t
make_pointer (zzz_scm_t env, zzz_scm_t n, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  void * p;
  int cn;

  CHECK_TYPE (1, integer_p (n) && integer_val (n) >= 0,
	      zzz_non_negative_integer_type_name);
  cn = integer_val (n);
  if (cn > 0)
    p = zzz_malloc (cn);
  else
    p = NULL;
  *result = zzz_make_pointer_n (p, cn);
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

/*:doc
  invalidate-pointer!
  (invalidate-pointer! p) => *unspecified*
  Invalidate the pointer @var{p} by setting its @i{invalid} flag.
  doc:*/
#define FUNC_NAME "invalidate-pointer!"
static result_t
invalidate_pointer_x (zzz_scm_t env, zzz_scm_t p, zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;

  CHECK_TYPE (1, pointer_p (p) && pointer_valid (p),
	      _("valid pointer object"));
  zzz_invalidate_pointer (p);
  *result = zzz_unspecified;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_pointer (void)
{
  zzz_define_function ("pointer?", (zzz_prim_t) pointer_p_func, argv_1_0_0);
  zzz_define_function ("make-pointer", (zzz_prim_t) make_pointer, argv_1_0_0);
  zzz_define_function ("invalidate-pointer!",
		       (zzz_prim_t) invalidate_pointer_x,
		       argv_1_0_0);
  return RESULT_SUCCESS;
}
