Commit | Line | Data |
---|---|---|
2de7ddb7 MG |
1 | /* examples/box-module/box.c |
2 | * | |
3 | * Copyright (C) 1998,2001 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., 59 Temple Place, Suite 330, | |
18 | * Boston, MA 02111-1307 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. */ | |
9bf80644 | 28 | static scm_t_bits scm_tc16_box; |
2de7ddb7 MG |
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 | |
8779d595 | 37 | and the caller will mark it. */ |
2de7ddb7 MG |
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. */ |