1 /*
2 * Abuse - dark 2D side-scrolling platform game
3 * Copyright (c) 1995 Crack dot Com
4 * Copyright (c) 2005-2011 Sam Hocevar <sam@hocevar.net>
5 *
6 * This software was released into the Public Domain. As with most public
7 * domain software, no warranty is made or implied by Crack dot Com, by
8 * Jonathan Clark, or by Sam Hocevar.
9 */
10
11 #ifndef __LISP_HPP_
12 #define __LISP_HPP_
13
14 #include <cstdlib>
15 #include <stdint.h>
16
17 #ifdef L_PROFILE
18 #include "timing.h"
19 #endif
20
21 #define Cell void
22 #define MAX_LISP_TOKEN_LEN 200
23 enum { PERM_SPACE,
24 TMP_SPACE,
25 USER_SPACE,
26 GC_SPACE };
27
28 #define FIXED_TRIG_SIZE 360 // 360 degrees stored in table
29 extern int32_t sin_table[FIXED_TRIG_SIZE]; // this should be filled in by external module
30 #define TBS 1662 // atan table granularity
31 extern uint16_t atan_table[TBS];
32 #define NILP(x) (x==NULL)
33 #define DEFINEDP(x) (x!=l_undefined)
34 class bFILE;
35 extern int current_space;
36 extern bFILE *current_print_file;
37
38
39 enum { L_BAD_CELL, // error catching type
40 L_CONS_CELL, L_NUMBER, L_SYMBOL, L_SYS_FUNCTION, L_USER_FUNCTION,
41 L_STRING, L_CHARACTER, L_C_FUNCTION, L_C_BOOL, L_L_FUNCTION, L_POINTER,
42 L_OBJECT_VAR, L_1D_ARRAY,
43 L_FIXED_POINT, L_COLLECTED_OBJECT };
44
45 typedef uint32_t ltype; // make sure structures aren't packed differently on various compiler
46 // and sure that word, etc are word aligned
47
48 struct LObject
49 {
50 /* Factories */
51 static LObject *Compile(char const *&s);
52
53 /* Methods */
54 LObject *Eval();
55 void Print();
56
57 /* Members */
58 ltype type;
59 };
60
61 struct LObjectVar : LObject
62 {
63 /* Factories */
64 static LObjectVar *Create(int index);
65
66 /* Members */
67 int index;
68 };
69
70 struct LList : LObject
71 {
72 /* Factories */
73 static LList *Create();
74
75 /* Methods */
76 size_t GetLength();
77
78 /* Members */
79 LObject *cdr, *car;
80 };
81
82 struct LNumber : LObject
83 {
84 /* Factories */
85 static LNumber *Create(long num);
86
87 /* Members */
88 long num;
89 };
90
91 struct LRedirect : LObject
92 {
93 /* Members */
94 LObject *ref;
95 };
96
97 struct LString : LObject
98 {
99 /* Factories */
100 static LString *Create(char const *string);
101 static LString *Create(char const *string, int length);
102 static LString *Create(int length);
103
104 /* Methods */
105 char *GetString();
106
107 /* Members */
108 private:
109 char str[1]; /* Can be allocated much larger than 1 */
110 };
111
112 struct LSymbol : LObject
113 {
114 /* Factories */
115 static LSymbol *Find(char const *name);
116 static LSymbol *FindOrCreate(char const *name);
117
118 /* Methods */
119 LObject *EvalFunction(void *arg_list);
120 LObject *EvalUserFunction(LList *arg_list);
121
122 LString *GetName();
123 LObject *GetFunction();
124 LObject *GetValue();
125
126 void SetFunction(LObject *fun);
127 void SetValue(LObject *value);
128 void SetNumber(long num);
129
130 /* Members */
131 #ifdef L_PROFILE
132 float time_taken;
133 #endif
134 LObject *value;
135 LObject *function;
136 LString *name;
137 LSymbol *left, *right; // tree structure
138
139 /* Static members */
140 static LSymbol *root;
141 static size_t count;
142 };
143
144 struct LSysFunction : LObject
145 {
146 /* Methods */
147 LObject *EvalFunction(LList *arg_list);
148
149 /* Members */
150 short min_args, max_args;
151 short fun_number;
152 };
153
154 struct LUserFunction : LObject
155 {
156 LList *arg_list, *block_list;
157 };
158
159 struct LArray : LObject
160 {
161 /* Factories */
162 static LArray *Create(size_t len, void *rest);
163
164 /* Methods */
GetDataLArray165 inline LObject **GetData() { return data; }
166 LObject *Get(int x);
167
168 /* Members */
169 size_t len;
170
171 private:
172 LObject *data[1]; /* Can be allocated much larger than 1 */
173 };
174
175 struct LChar : LObject
176 {
177 /* Factories */
178 static LChar *Create(uint16_t ch);
179
180 /* Members */
181 uint16_t ch;
182 };
183
184 struct LPointer : LObject
185 {
186 /* Factories */
187 static LPointer *Create(void *addr);
188
189 /* Members */
190 void *addr;
191 };
192
193 struct LFixedPoint : LObject
194 {
195 /* Factories */
196 static LFixedPoint *Create(int32_t x);
197
198 /* Members */
199 int32_t x;
200 };
201
CAR(void * x)202 static inline LObject *&CAR(void *x) { return ((LList *)x)->car; }
CDR(void * x)203 static inline LObject *&CDR(void *x) { return ((LList *)x)->cdr; }
item_type(void * x)204 static inline ltype item_type(void *x) { if (x) return *(ltype *)x; return L_CONS_CELL; }
205
206 void perm_space();
207 void tmp_space();
208 void use_user_space(void *addr, long size);
209 void *lpointer_value(void *lpointer);
210 int32_t lnumber_value(void *lnumber);
211 unsigned short lcharacter_value(void *c);
212 long lfixed_point_value(void *c);
213 void *lisp_atom(void *i);
214 LObject *lcdr(void *c);
215 LObject *lcar(void *c);
216 void *lisp_eq(void *n1, void *n2);
217 void *lisp_equal(void *n1, void *n2);
218 void *eval_block(void *list);
219 void *assoc(void *item, void *list);
220 void resize_tmp(size_t new_size);
221 void resize_perm(size_t new_size);
222
223 void push_onto_list(void *object, void *&list);
224 LSymbol *add_c_object(void *symbol, int index);
225 LSymbol *add_c_function(char const *name, short min_args, short max_args, short number);
226 LSymbol *add_c_bool_fun(char const *name, short min_args, short max_args, short number);
227 LSymbol *add_lisp_function(char const *name, short min_args, short max_args, short number);
228 int read_ltoken(char *&s, char *buffer);
229 void print_trace_stack(int max_levels);
230
231
232 LSysFunction *new_lisp_sys_function(int min_args, int max_args, int fun_number);
233 LSysFunction *new_lisp_c_function(int min_args, int max_args, int fun_number);
234 LSysFunction *new_lisp_c_bool(int min_args, int max_args, int fun_number);
235
236 LUserFunction *new_lisp_user_function(LList *arg_list, LList *block_list);
237
238 LSysFunction *new_user_lisp_function(int min_args, int max_args, int fun_number);
239
240 int end_of_program(char *s);
241 void clear_tmp();
242 void lisp_init();
243 void lisp_uninit();
244
245 extern uint8_t *space[4], *free_space[4];
246 extern size_t space_size[4];
247 void *nth(int num, void *list);
248 int32_t lisp_atan2(int32_t dy, int32_t dx);
249 int32_t lisp_sin(int32_t x);
250 int32_t lisp_cos(int32_t x);
251 void restore_heap(void *val, int heap);
252 void *mark_heap(int heap);
253
254 extern "C" {
255 void lbreak(const char *format, ...);
256 } ;
257
258 extern void clisp_init(); // external initalizer call by lisp_init()
259 extern long c_caller(long number, void *arg); // exten c function switches on number
260 extern void *l_caller(long number, void *arg); // exten lisp function switches on number
261
262 extern void *l_obj_get(long number); // exten lisp function switches on number
263 extern void l_obj_set(long number, void *arg); // exten lisp function switches on number
264 extern void l_obj_print(long number); // exten lisp function switches on number
265
266 // FIXME: get rid of this later
symbol_value(void * sym)267 static inline void *symbol_value(void *sym) { return ((LSymbol *)sym)->GetValue(); }
lstring_value(void * str)268 static inline char *lstring_value(void *str) { return ((LString *)str)->GetString(); }
269
270 #include "lisp_opt.h"
271
272 #endif
273