| 1 | /* examples/box-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 | /* Create and initialize the new smob type, and register the |
| 111 | primitives withe the interpreter library. |
| 112 | |
| 113 | This function must be declared a bit different from the example in |
| 114 | the ../box directory, because it will be called by |
| 115 | `scm_c_define_module', called from below. */ |
| 116 | static void |
| 117 | init_box_type (void * unused) |
| 118 | { |
| 119 | scm_tc16_box = scm_make_smob_type ("box", 0); |
| 120 | scm_set_smob_mark (scm_tc16_box, mark_box); |
| 121 | scm_set_smob_print (scm_tc16_box, print_box); |
| 122 | |
| 123 | scm_c_define_gsubr ("make-box", 0, 0, 0, make_box); |
| 124 | scm_c_define_gsubr ("box-set!", 2, 0, 0, box_set_x); |
| 125 | scm_c_define_gsubr ("box-ref", 1, 0, 0, box_ref); |
| 126 | |
| 127 | /* This is new too: Since the procedures are now in a module, we |
| 128 | have to explicitly export them before they can be used. */ |
| 129 | scm_c_export ("make-box", "box-set!", "box-ref", NULL); |
| 130 | } |
| 131 | |
| 132 | |
| 133 | /* This is the function which gets called by scm_boot_guile after the |
| 134 | Guile library is completely initialized. */ |
| 135 | static void |
| 136 | inner_main (void *closure, int argc, char **argv) |
| 137 | { |
| 138 | /* Unlike the example in ../box, init_box_type is not called |
| 139 | directly, but by scm_c_define_module, which will create a module |
| 140 | named (box-module) and make this module current while called |
| 141 | init_box_type, thus placing the definitions into that module. */ |
| 142 | scm_c_define_module ("box-module", init_box_type, NULL); |
| 143 | |
| 144 | /* ... then we start a shell, in which the box data type can be |
| 145 | used (after using the module (box-module)). */ |
| 146 | scm_shell (argc, argv); |
| 147 | } |
| 148 | |
| 149 | |
| 150 | /* Main program. */ |
| 151 | int |
| 152 | main (int argc, char **argv) |
| 153 | { |
| 154 | /* Initialize Guile, then call `inner_main' with the arguments 0, |
| 155 | argc and argv. */ |
| 156 | scm_boot_guile (argc, argv, inner_main, 0); |
| 157 | return 0; /* Never reached. */ |
| 158 | } |
| 159 | |
| 160 | /* End of file. */ |