guile18/examples/box-dynamic-module/box.c

   1 /* examples/box-dynamic-module/box.c
   2  *
   3  *      Copyright (C) 1998,2001, 2006 Free Software Foundation, Inc.
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 2, or (at your option)
   8  * any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this software; see the file COPYING.  If not, write to
  17  * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  18  * Boston, MA 02110-1301 USA
  19  */
  20
  21 /* Include all needed declarations.  */
  22 #include <libguile.h>
  23
  24
  25 /* The type code for the newly created smob type will be stored into
  26    this variable.  It has the prefix `scm_tc16_' to make it usable
  27    with the SCM_VALIDATE_SMOB macro below.  */
  28 static scm_t_bits scm_tc16_box;
  29
  30
  31 /* This function is responsible for marking all SCM objects included
  32    in the smob.  */
  33 static SCM
  34 mark_box (SCM b)
  35 {
  36   /* Since we have only one SCM object to protect, we simply return it
  37      and the caller will mark it.  */
  38   return SCM_CELL_OBJECT_1 (b);
  39 }
  40
  41
  42 /* Print a textual represenation of the smob to a given port.  */
  43 static int
  44 print_box (SCM b, SCM port, scm_print_state *pstate)
  45 {
  46   SCM value = SCM_CELL_OBJECT_1 (b);
  47
  48   scm_puts ("#<box ", port);
  49   scm_write (value, port);
  50   scm_puts (">", port);
  51
  52   /* Non-zero means success.  */
  53   return 1;
  54 }
  55
  56
  57 /* This defines the primitve `make-box', which returns a new smob of
  58    type `box', initialized to `#f'.  */
  59 static SCM
  60 #define FUNC_NAME "make-box"
  61 make_box (void)
  62 {
  63   /* This macro creates the new objects, stores the value `#f' into it
  64      and returns it to the caller.  */
  65   SCM_RETURN_NEWSMOB (scm_tc16_box, SCM_BOOL_F);
  66 }
  67 #undef FUNC_NAME
  68
  69
  70 /* This is the primitive `box-ref' which returns the object stored in
  71    the box.  */
  72 static SCM
  73 box_ref (SCM b)
  74 #define FUNC_NAME "box-ref"
  75 {
  76   /* First, we have to ensure that the user really gave us a box
  77      objects.  The macro SCM_VALIDATE_SMOB will do all what is needed.
  78      The parameters are interpreted as follows:
  79
  80      1: The position of the checked variable in the parameter list.
  81      b: The passed parameter.
  82      box: Concatenated with the fixed prefix scm_tc16_, names the type
  83           code for the expected smob type.  */
  84   SCM_VALIDATE_SMOB (1, b, box);
  85
  86   /* Fetch the object from the box and return it.  */
  87   return SCM_CELL_OBJECT_1 (b);
  88 }
  89 #undef FUNC_NAME
  90
  91
  92 /* Primitive which stores an arbitrary value into a box.  */
  93 static SCM
  94 box_set_x (SCM b, SCM value)
  95 #define FUNC_NAME "box-set!"
  96 {
  97   SCM_VALIDATE_SMOB (1, b, box);
  98
  99   /* Set the cell number 1 of the smob to the given value.  */
 100   SCM_SET_CELL_OBJECT_1 (b, value);
 101
 102   /* When this constant is returned, the REPL will not print the
 103      returned value.  All procedures in Guile which are documented as
 104      returning `and unspecified value' actually return this value.  */
 105   return SCM_UNSPECIFIED;
 106 }
 107 #undef FUNC_NAME
 108
 109
 110 /* This is the function which must be given to `load-extension' as the
 111    second argument.  In this example, the Scheme file box-module.scm
 112    (or box-mixed.scm) is responsible for doing the load-extension
 113    call.  The Scheme modules are also responsible for placing the
 114    procedure definitions in the correct module. */
 115 void
 116 scm_init_box ()
 117 {
 118   scm_tc16_box = scm_make_smob_type ("box", 0);
 119   scm_set_smob_mark (scm_tc16_box, mark_box);
 120   scm_set_smob_print (scm_tc16_box, print_box);
 121
 122   scm_c_define_gsubr ("make-box", 0, 0, 0, make_box);
 123   scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x);
 124   scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref);
 125 }
 126
 127 /* End of file.  */