/[guile]/guile/guile-core/libguile/deprecated.c
ViewVC logotype

Diff of /guile/guile-core/libguile/deprecated.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by mvo, Wed Mar 26 17:02:31 2003 UTC revision 1.2 by mvo, Wed Mar 26 17:59:55 2003 UTC
# Line 45  Line 45 
45    
46  #include "libguile/_scm.h"  #include "libguile/_scm.h"
47  #include "libguile/deprecated.h"  #include "libguile/deprecated.h"
48    #include "libguile/deprecation.h"
49  #include "libguile/snarf.h"  #include "libguile/snarf.h"
50  #include "libguile/validate.h"  #include "libguile/validate.h"
51  #include "libguile/strings.h"  #include "libguile/strings.h"
52  #include "libguile/strop.h"  #include "libguile/strop.h"
53    
54    #include <stdio.h>
55    #include <string.h>
56    
57  #if (SCM_ENABLE_DEPRECATED == 1)  #if (SCM_ENABLE_DEPRECATED == 1)
58    
59  SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x);  SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x);
60    
61  SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x);  SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x);
62    
63    SCM
64    scm_wta (SCM arg, const char *pos, const char *s_subr)
65    {
66      if (!s_subr || !*s_subr)
67        s_subr = NULL;
68      if ((~0x1fL) & (long) pos)
69        {
70          /* error string supplied.  */
71          scm_misc_error (s_subr, pos, scm_list_1 (arg));
72        }
73      else
74        {
75          /* numerical error code.  */
76          scm_t_bits error = (scm_t_bits) pos;
77    
78          switch (error)
79            {
80            case SCM_ARGn:
81              scm_wrong_type_arg (s_subr, 0, arg);
82            case SCM_ARG1:
83              scm_wrong_type_arg (s_subr, 1, arg);
84            case SCM_ARG2:
85              scm_wrong_type_arg (s_subr, 2, arg);
86            case SCM_ARG3:
87              scm_wrong_type_arg (s_subr, 3, arg);
88            case SCM_ARG4:
89              scm_wrong_type_arg (s_subr, 4, arg);
90            case SCM_ARG5:
91              scm_wrong_type_arg (s_subr, 5, arg);
92            case SCM_ARG6:
93              scm_wrong_type_arg (s_subr, 6, arg);
94            case SCM_ARG7:
95              scm_wrong_type_arg (s_subr, 7, arg);
96            case SCM_WNA:
97              scm_wrong_num_args (arg);
98            case SCM_OUTOFRANGE:
99              scm_out_of_range (s_subr, arg);
100            case SCM_NALLOC:
101              scm_memory_error (s_subr);
102            default:
103              /* this shouldn't happen.  */
104              scm_misc_error (s_subr, "Unknown error", SCM_EOL);
105            }
106        }
107      return SCM_UNSPECIFIED;
108    }
109    
110    /* Module registry
111     */
112    
113    /* We can't use SCM objects here. One should be able to call
114       SCM_REGISTER_MODULE from a C++ constructor for a static
115       object. This happens before main and thus before libguile is
116       initialized. */
117    
118    struct moddata {
119      struct moddata *link;
120      char *module_name;
121      void *init_func;
122    };
123    
124    static struct moddata *registered_mods = NULL;
125    
126    void
127    scm_register_module_xxx (char *module_name, void *init_func)
128    {
129      struct moddata *md;
130    
131      scm_c_issue_deprecation_warning
132        ("`scm_register_module_xxx' is deprecated.  Use extensions instead.");
133    
134      /* XXX - should we (and can we) DEFER_INTS here? */
135    
136      for (md = registered_mods; md; md = md->link)
137        if (!strcmp (md->module_name, module_name))
138          {
139            md->init_func = init_func;
140            return;
141          }
142    
143      md = (struct moddata *) malloc (sizeof (struct moddata));
144      if (md == NULL)
145        {
146          fprintf (stderr,
147                   "guile: can't register module (%s): not enough memory",
148                   module_name);
149          return;
150        }
151    
152      md->module_name = module_name;
153      md->init_func = init_func;
154      md->link = registered_mods;
155      registered_mods = md;
156    }
157    
158    SCM_DEFINE (scm_registered_modules, "c-registered-modules", 0, 0, 0,
159                (),
160                "Return a list of the object code modules that have been imported into\n"
161                "the current Guile process.  Each element of the list is a pair whose\n"
162                "car is the name of the module, and whose cdr is the function handle\n"
163                "for that module's initializer function.  The name is the string that\n"
164                "has been passed to scm_register_module_xxx.")
165    #define FUNC_NAME s_scm_registered_modules
166    {
167      SCM res;
168      struct moddata *md;
169    
170      res = SCM_EOL;
171      for (md = registered_mods; md; md = md->link)
172        res = scm_cons (scm_cons (scm_makfrom0str (md->module_name),
173                                  scm_ulong2num ((unsigned long) md->init_func)),
174                        res);
175      return res;
176    }
177    #undef FUNC_NAME
178    
179    SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
180                (),
181                "Destroy the list of modules registered with the current Guile process.\n"
182                "The return value is unspecified.  @strong{Warning:} this function does\n"
183                "not actually unlink or deallocate these modules, but only destroys the\n"
184                "records of which modules have been loaded.  It should therefore be used\n"
185                "only by module bookkeeping operations.")
186    #define FUNC_NAME s_scm_clear_registered_modules
187    {
188      struct moddata *md1, *md2;
189    
190      SCM_DEFER_INTS;
191    
192      for (md1 = registered_mods; md1; md1 = md2)
193        {
194          md2 = md1->link;
195          free (md1);
196        }
197      registered_mods = NULL;
198    
199      SCM_ALLOW_INTS;
200      return SCM_UNSPECIFIED;
201    }
202    #undef FUNC_NAME
203    
204    
205  void  void
206  scm_i_init_deprecated ()  scm_i_init_deprecated ()
207  {  {

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26