source: golgotha/src/i4/lisp/li_types.hh @ 80

Last change on this file since 80 was 80, checked in by Sam Hocevar, 12 years ago
  • Adding the Golgotha source code. Not sure what's going to be interesting in there, but since it's all public domain, there's certainly stuff to pick up.
File size: 10.2 KB
Line 
1/********************************************************************** <BR>
2  This file is part of Crack dot Com's free source code release of
3  Golgotha. <a href="http://www.crack.com/golgotha_release"> <BR> for
4  information about compiling & licensing issues visit this URL</a>
5  <PRE> If that doesn't help, contact Jonathan Clark at
6  golgotha_source@usa.net (Subject should have "GOLG" in it)
7***********************************************************************/
8
9#ifndef LI_TYPES_HH
10#define LI_TYPES_HH
11
12
13
14#include "error/error.hh"
15#include "lisp/li_alloc.hh"
16#include "string/string.hh"
17#include "lisp/li_error.hh"
18
19#undef new
20
21#ifdef DEBUG
22#define LI_TYPE_CHECK
23#endif
24
25
26// default types available, type numbers for these types shouldn't be changed
27enum {
28  LI_INVALID_TYPE,
29  LI_SYMBOL,
30  LI_STRING,
31  LI_INT,
32  LI_FLOAT,
33  LI_LIST,
34  LI_CHARACTER,
35  LI_FUNCTION,
36  LI_ENVIROMENT,
37  LI_TYPE,
38  LI_LAST_TYPE
39};
40
41
42class li_environment;
43class i4_loader_class;
44class i4_saver_class;
45typedef w32 li_type_number;
46
47char *li_get_type_name(li_type_number type);
48
49// base object from which all object instances in li_ should be derived
50// all objects derived should add 4 bytes to the structure.  li_objects cannot
51// contain virtual functions.
52
53class li_object
54
55protected:
56  li_type_number _type;
57  enum { GC_FLAG=1<<31 };
58public:
59  i4_bool is_marked() const { if (_type & GC_FLAG) return i4_T; else return i4_F; }
60  void mark(int set) { if (set) _type |= GC_FLAG; else _type &= ~GC_FLAG; }
61  void mark_free() { _type=LI_INVALID_TYPE; }
62
63  li_object(li_type_number type) { _type=type; }
64  li_type_number type() const { return _type; }
65  li_type_number unmarked_type() const { return _type & (~GC_FLAG); }
66
67  static void check_type(li_object *o, li_type_number type, li_environment *env)
68  {
69#ifdef LI_TYPE_CHECK
70    if (o->type()!=type)
71      li_error(env, "expecting type %s, but got %O",
72               li_get_type_name(type),o);
73#endif
74  }
75
76  void *operator new(size_t size)
77  {
78#ifdef DEBUG
79    if (size!=8)
80      i4_error(0, "li_objects should be 8 bytes");
81#endif
82    return li_cell8_alloc();
83  }
84
85  void *operator new(size_t size, char *file, int line)
86  {
87#ifdef DEBUG
88    if (size!=8)
89      i4_error(0, "li_objects should be 8 bytes");
90#endif
91    return li_cell8_alloc();
92  }
93
94  void operator delete(void *ptr);
95};
96
97
98// the li_ system does not know about gui stuff directly, it goes through this type_edit_class
99// which can be added to each type later
100class i4_window_class;   
101class li_type_edit_class;
102
103// if you want to add a new type into the system, implement one of these
104// and call li_add_type
105class li_type_function_table
106{
107public:
108  li_type_edit_class *editor;
109
110  // mark any data you the type have
111  virtual void mark(int set) { ; }
112
113  // mark any data an instance of this type has
114  virtual void mark(li_object   *o, int set) { o->mark(set); }
115
116  // free data associated with an instance of this type
117  virtual void free(li_object   *o) { ; } // during free, you will not be marked
118
119  virtual int equal(li_object  *o1, li_object *o2) { return o1==o2; }
120  virtual void print(li_object  *o, i4_file_class *stream) = 0;
121  virtual char *name() = 0;   // name is used to sync types across a network & saves
122
123  virtual li_object *create(li_object *params, li_environment *env) { return 0; }
124
125  // these load and save type information
126  virtual void save(i4_saver_class *fp, li_environment *env) { ; }
127  virtual void load(i4_loader_class *fp, li_type_number *type_remap, li_environment *env) { ; }
128  virtual void load_done() { ; }
129
130  // load & save type instance information
131  virtual void save_object(i4_saver_class *fp, li_object *o, li_environment *env) = 0;
132  virtual li_object *load_object(i4_loader_class *fp, li_type_number *type_remap,
133                                 li_environment *env) = 0;
134
135  li_type_function_table() { editor=0; }
136  virtual ~li_type_function_table() { ; }
137};
138
139extern li_type_function_table **li_types;
140
141// return type number for type
142// if type is not anonymous it's name's symbol value will be set to the type number
143int li_add_type(li_type_function_table *type_functions,
144                li_environment *env=0,
145                int anonymous=0);
146
147void li_remove_type(int type_num);
148void li_cleanup_types();
149
150li_type_function_table *li_get_type(li_type_number type_num);
151li_type_number li_find_type(char *name, li_environment *env=0);
152li_type_number li_find_type(char *name, li_environment *env, li_type_number &cache_to);
153i4_bool li_valid_type(li_type_number type_number);
154int li_max_types();    // returns the highest type number currently registered
155
156
157inline void li_object::operator delete(void *ptr)
158
159  li_object *o = (li_object *)ptr;
160
161  li_get_type(o->type())->free(o);
162  li_cell8_free(o);
163}
164
165class li_string : public li_object
166{
167  char *_name;
168public:
169  li_string(i4_file_class *fp);
170
171  li_string(char *name);
172  li_string(int len);
173  li_string(const i4_const_str &str);
174
175  char *value() const { return _name; }
176
177  static li_string *get(li_object *o, li_environment *env)
178  { check_type(o, LI_STRING, env); return ((li_string *)o); }
179};
180
181
182
183
184class li_symbol : public li_object
185{
186public:
187  struct symbol_data
188  {
189    li_object *_value;
190    li_object *_fun;
191    li_string *_name;
192    li_symbol *left, *right;
193   
194    symbol_data(li_string *name) { _value=0; _fun=0; _name=name; left=0; right=0; }
195  };
196
197private:
198  symbol_data *data;
199
200public: 
201  void free();
202  li_symbol *left() { return data->left; }
203  li_symbol *right() { return data->right; }
204  li_symbol *set_left(li_symbol *left) { return data->left=left; }
205  li_symbol *set_right(li_symbol *right) { return data->right=right; }
206
207  li_symbol(li_string *name) : li_object(LI_SYMBOL), data(new symbol_data(name)) {}
208
209  li_object *fun() const { return data->_fun; }
210  li_object *value() const { return data->_value; }
211  li_string *name() const { return data->_name; }
212  void set_value(li_object *value) { data->_value=value; }
213  void set_fun(li_object *fun) { data->_fun=fun; }
214
215  static li_symbol *get(li_object *o, li_environment *env)
216  { check_type(o, LI_SYMBOL, env); return ((li_symbol *)o); }
217
218  int compare(const li_symbol *a) const { return strcmp(name()->value(), a->name()->value()); }
219
220};
221
222
223typedef li_object *(*li_function_type)(li_object *o, li_environment *env);
224
225class li_function : public li_object
226{
227  li_function_type _fun;
228public:
229  li_function(li_function_type fun)  : li_object(LI_FUNCTION), _fun(fun) {}
230  li_function_type value() { return _fun; }
231  static li_function *get(li_object *o, li_environment *env)
232  { check_type(o, LI_FUNCTION, env); return (li_function *)o; }
233};
234
235class li_int : public li_object
236{
237  int _x;
238public:
239  li_int(int x) : li_object(LI_INT) { _x=x; }
240  int value() { return _x; } 
241  static li_int *get(li_object *o, li_environment *env)
242  { check_type(o, LI_INT, env); return ((li_int *)o); }
243} ;
244
245
246class li_type : public li_object
247{
248  li_type_number _x;
249public:
250  li_type(li_type_number x) : li_object(LI_TYPE) { _x=x; }
251  li_type_number value() { return _x; } 
252  static li_type *get(li_object *o, li_environment *env)
253  { check_type(o, LI_TYPE, env); return ((li_type *)o); }
254} ;
255
256
257class li_float : public li_object
258{
259  float _x;
260public:
261  li_float(float x) : li_object(LI_FLOAT) { _x=x; }
262  float value() { return _x; } 
263  static li_float *get(li_object *o, li_environment *env)
264  { check_type(o, LI_FLOAT, env); return ((li_float *)o); }
265} ;
266
267class li_character : public li_object
268{
269  w32 _ch;
270public:
271  li_character(w8 ch) : li_object(LI_CHARACTER) {  _ch=ch; }
272  w8 value() { return _ch; } 
273  static li_character *get(li_object *o, li_environment *env)
274  {
275    check_type(o, LI_CHARACTER, env);
276    return ((li_character *)o);
277  }
278} ;
279
280
281class li_list : public li_object
282{
283  friend class li_memory_manager_class;
284
285  struct list_data
286  {
287    li_object *_data, *_next;
288    list_data(li_object *data, li_object *next) : _data(data), _next(next) {}
289  } *_data;
290
291  li_list *get_next_free() { return (li_list *)_data; }
292  void set_next_free(li_list *next_free) { _data=(list_data *)next_free; }
293
294public:
295  void cleanup() { delete _data; }
296
297 
298
299  li_list(li_object *data, li_object *next=0)
300    : li_object(LI_LIST), _data(new list_data(data,next)) {}
301
302  li_object *data() { return _data->_data; }
303  li_object *next() { return _data->_next; }
304
305  void set_next(li_object *next) { _data->_next=next; }
306  void set_data(li_object *data) { _data->_data=data; }
307
308  static li_list *get(li_object *o, li_environment *env)
309  { check_type(o, LI_LIST,env); return (li_list *)o; }
310};
311
312
313class li_environment : public li_object
314{
315  struct value_data
316  {
317    li_symbol *symbol;
318    li_object *value;
319    value_data *next;
320  };
321
322  struct fun_data
323  {
324    li_symbol *symbol;
325    li_object *fun;
326    fun_data  *next;
327  };
328
329  struct env_data
330  {
331    value_data     *value_list;
332    fun_data       *fun_list;
333    li_environment *next;
334    li_symbol      *current_function;   // set by li_call
335    li_object      *current_args;
336    i4_bool        local_namespace;
337
338
339    env_data(li_environment *top_env, i4_bool local_namespace)
340      : next(top_env), local_namespace(local_namespace)
341   
342    { value_list=0; fun_list=0; current_function=0; current_args=0; }
343
344  } *data;
345
346
347public:
348  li_symbol *&current_function();
349  li_object *&current_arguments();
350
351
352  li_environment(li_environment *top_env, i4_bool local_namespace)
353    : li_object(LI_ENVIROMENT), data(new env_data(top_env, local_namespace)) {}
354
355  li_object *value(li_symbol *s);
356  li_object *fun(li_symbol *s);
357
358  void set_value(li_symbol *s, li_object *value);
359  void set_fun(li_symbol *s, li_object *fun);
360
361
362  // don't call these functions directly!
363  void mark(int set);
364  void print(i4_file_class *stream);
365  void free();
366
367  static li_environment *get(li_object *o, li_environment *env)
368  { check_type(o, LI_ENVIROMENT, env); return (li_environment *)o; }
369
370  void print_call_stack(i4_file_class *fp);
371};
372
373
374#include "memory/new.hh"      // make sure old definition of new is redeclared
375
376#endif
Note: See TracBrowser for help on using the repository browser.