[e5072a]: src / c / all_symbols.d Maximize Restore History

Download this file

all_symbols.d    201 lines (189 with data), 4.7 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
#include <ctype.h>
#include "ecl.h"
#include "internal.h"
#define CL_ORDINARY 0
#define CL_SPECIAL 1
#define CL_CONSTANT 2
#define SI_ORDINARY 4
#define SI_SPECIAL 5
#define KEYWORD 10
#define FORM_ORDINARY 16
#include "symbols_list.h"
cl_index cl_num_symbols_in_core = 0;
static char *
mangle_name(cl_object output, char *source, int l)
{
char c;
while (l--) {
c = *(source++);
if (isalpha(c))
c = tolower(c);
else if (isdigit(c))
;
else if (c == '-' || c == '_') {
c = '_';
} else if (c == '&') {
c = 'A';
} else if (c == '*') {
c = 'X';
} else if (c == '+') {
c = 'P';
} else if (c == '<') {
c = 'L';
} else if (c == '>') {
c = 'G';
} else if (c == '=') {
c = 'E';
} else if (c == '/') {
c = 'N';
} else if (c == ':') {
c = 'X';
} else {
return NULL;
}
output->string.self[output->string.fillp++] = c;
}
return &output->string.self[output->string.fillp];
}
@(defun si::mangle-name (symbol &optional as_function)
cl_index l;
char c, *source, *dest;
cl_object output;
cl_object package;
cl_object found = Cnil;
cl_object maxarg = MAKE_FIXNUM(-1);
bool is_symbol;
@
assert_type_symbol(symbol);
is_symbol = Null(as_function);
if (is_symbol) {
cl_fixnum p;
if (symbol == Cnil)
@(return Ct make_simple_string("Cnil"))
else if (symbol == Ct)
@(return Ct make_simple_string("Ct"))
p = (cl_symbol_initializer*)symbol - cl_symbols;
if (p >= 0 && p <= cl_num_symbols_in_core) {
found = Ct;
output = @format(3, Cnil,
make_constant_string("((cl_object)(cl_symbols+~A))"),
MAKE_FIXNUM(p));
@(return found output maxarg)
}
} else {
cl_object fun;
fun = symbol->symbol.gfdef;
if (fun != OBJNULL && type_of(fun) == t_cfun &&
fun->cfun.block == OBJNULL) {
for (l = 0; l <= cl_num_symbols_in_core; l++) {
cl_object s = (cl_object)(cl_symbols + l);
if (fun == SYM_FUN(s)) {
symbol = s;
found = Ct;
maxarg = MAKE_FIXNUM(fun->cfun.narg);
break;
}
}
}
}
package= symbol->symbol.hpack;
if (package == lisp_package)
package = make_simple_string("cl");
else if (package == system_package)
package = make_simple_string("si");
else if (package == keyword_package)
package = Cnil;
else
package = package->pack.name;
symbol = symbol->symbol.name;
l = symbol->string.fillp;
source = symbol->string.self;
output = cl_alloc_simple_string(length(package) + l + 1);
if (is_symbol && source[0] == '*') {
if (l > 2 && source[l-1] == '*') l--;
c = 'V';
l--;
source++;
} else if (is_symbol && l > 2 && source[0] == '+' && source[l-1] == '+') {
c = 'C';
l-= 2;
source++;
} else if (!is_symbol) {
c = '_';
} else if (package == keyword_package) {
c = 'K';
} else {
c = 'S';
}
output->string.fillp = 0;
if (!Null(package))
if (!mangle_name(output, package->string.self, package->string.fillp))
@(return Cnil Cnil maxarg)
output->string.self[output->string.fillp++] = c;
if (!(dest = mangle_name(output, source, l)))
@(return Cnil Cnil maxarg)
if (dest[-1] == '_')
dest[-1] = 'M';
*(dest++) = '\0';
@(return found output maxarg)
@)
static void
make_this_symbol(int i, cl_object s, int code, const char *name,
cl_objectfn fun, int narg)
{
enum stype stp;
cl_object package;
switch (code & 3) {
case 0: stp = stp_ordinary; break;
case 1: stp = stp_special; break;
case 2: stp = stp_constant; break;
}
switch (code & 12) {
case 0: package = lisp_package; break;
case 4: package = system_package; break;
case 8: package = keyword_package; break;
}
s->symbol.t = t_symbol;
s->symbol.mflag = FALSE;
SYM_VAL(s) = OBJNULL;
SYM_FUN(s) = OBJNULL;
s->symbol.plist = Cnil;
s->symbol.hpack = Cnil;
s->symbol.stype = stp;
s->symbol.mflag = FALSE;
s->symbol.isform = FALSE;
s->symbol.hpack = package;
s->symbol.name = make_constant_string(name);
if (package == keyword_package) {
sethash(s->symbol.name, package->pack.external, s);
SYM_VAL(s) = s;
} else {
cl_import2(s, package);
cl_export2(s, package);
}
if (code == FORM_ORDINARY)
s->symbol.isform = TRUE;
else if (fun != NULL) {
cl_object f = cl_make_cfun_va(fun, s, NULL);
SYM_FUN(s) = f;
f->cfun.narg = narg;
}
cl_num_symbols_in_core = i + 1;
}
void
init_all_symbols(void)
{
int i, code, narg;
const char *name;
cl_object s;
cl_objectfn fun;
/* We skip NIL and T */
for (i = 2; cl_symbols[i].init.name != NULL; i++) {
s = (cl_object)(cl_symbols + i);
code = cl_symbols[i].init.type;
name = cl_symbols[i].init.name;
fun = (cl_objectfn)cl_symbols[i].init.fun;
narg = cl_symbols[i].init.narg;
make_this_symbol(i, s, code, name, fun, narg);
}
}