Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.

Close

[39bc14]: src / c / cinit.d Maximize Restore History

Download this file

cinit.d    211 lines (181 with data), 6.1 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
201
202
203
204
205
206
207
208
209
210
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
init.c -- Lisp Initialization.
*/
/*
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <stdio.h>
#include <ecl/ecl.h>
#include <ecl/internal.h>
/*
* HOOKS.
*
* The following functions are only used to bootstrap ECL. They divert
* the calls to the interpreted code which is loaded by bare.lsp. Once
* the whole of ECL is built, the file cinit.o will be replaced by the
* actual initialization code, and the compiled function will be
* called instead.
*/
extern cl_object
cl_upgraded_array_element_type(cl_narg narg, cl_object type, ...)
{
return _ecl_funcall2(@'upgraded-array-element-type', type);
}
extern cl_object
si_safe_eval(cl_narg narg, cl_object form, cl_object env, ...)
{
if (narg == 3) {
cl_object err_value;
va_list args; va_start(args, env);
err_value = va_arg(args, cl_object);
return _ecl_funcall4(@'ext::safe-eval', form, env, err_value);
}
return _ecl_funcall3(@'ext::safe-eval', form, env);
}
extern cl_object
cl_slot_value(cl_object instance, cl_object name)
{
return _ecl_funcall3(@'slot-value', instance, name);
}
extern cl_object
clos_slot_value_set(cl_object value, cl_object instance, cl_object name)
{
return _ecl_funcall4(@'clos::slot-value-set', value, instance, name);
}
extern cl_object
clos_std_compute_applicable_methods(cl_object gf, cl_object arglist)
{
return _ecl_funcall3(@'clos::std-compute-applicable-methods', gf, arglist);
}
extern cl_object
si_bind_simple_restarts(cl_object tag, cl_object names)
{
if (ECL_SYM_FUN(@'si::bind-simple-restarts') != Cnil)
return _ecl_funcall3(@'si::bind-simple-restarts', tag, names);
else
return ECL_SYM_VAL(ecl_process_env(), @'si::*restart-clusters*');
}
extern cl_object
si_bind_simple_handlers(cl_object tag, cl_object names)
{
if (ECL_SYM_FUN(@'si::bind-simple-handlers') != Cnil)
return _ecl_funcall3(@'si::bind-simple-handlers', tag, names);
else
return ECL_SYM_VAL(ecl_process_env(), @'si::*handler-clusters*');
}
extern cl_object
clos_std_compute_effective_method(cl_object gf, cl_object combination, cl_object methods_list)
{
return _ecl_funcall4(@'clos::std-compute-effective-method', gf, combination, methods_list);
}
extern cl_object
clos_compute_effective_method_function(cl_object gf, cl_object combination, cl_object methods_list)
{
return _ecl_funcall4(@'clos::compute-effective-method-function', gf, combination, methods_list);
}
extern cl_object
si_string_to_object(cl_narg narg, cl_object string, ...)
{
if (narg == 2) {
cl_object err_value;
va_list args; va_start(args, string);
err_value = va_arg(args, cl_object);
return _ecl_funcall3(@'si::string-to-object', string, err_value);
}
return _ecl_funcall2(@'si::string-to-object', string);
}
extern cl_object
si_signal_simple_error(cl_narg narg, cl_object condition, cl_object continuable, cl_object format, cl_object format_args, ...)
{
ecl_va_list args;
cl_object rest;
ecl_va_start(args, format_args, narg, 4);
rest = cl_grab_rest_args(args);
return cl_apply(6, @'si::signal-simple-error', condition, continuable,
format, format_args, rest);
}
extern cl_object
cl_set_difference(cl_narg narg, cl_object l1, cl_object l2, ...)
{
@(return l1)
}
extern cl_object
cl_array_dimensions(cl_object array)
{
return _ecl_funcall2(@'ARRAY-DIMENSIONS', array);
}
extern cl_object
si_find_relative_package(cl_narg narg, cl_object package, ...)
{
@(return ECL_NIL);
}
extern cl_object
si_wrong_type_argument(cl_narg narg, cl_object object, cl_object type, ...)
{
return _ecl_funcall3(@'si::wrong-type-argument', object, type);
}
extern cl_object
si_make_encoding(cl_object mapping)
{
return _ecl_funcall2(@'ext::make-encoding', mapping);
}
static cl_object si_simple_toplevel ()
{
cl_env_ptr env = ecl_process_env();
cl_object output = cl_core.standard_output;
cl_object sentence;
int i;
/* Simple minded top level loop */
ECL_CATCH_ALL_BEGIN(env) {
writestr_stream(";*** Lisp core booted ****\n"
"ECL (Embeddable Common Lisp)\n",
output);
ecl_force_output(output);
for (i = 1; i<ecl_fixnum(si_argc()); i++) {
cl_object arg = si_argv(ecl_make_fixnum(i));
cl_load(1, arg);
}
while (1) {
writestr_stream("\n> ", output);
sentence = @read(3, ECL_NIL, ECL_NIL, OBJNULL);
if (sentence == OBJNULL)
@(return);
sentence = si_eval_with_env(1, sentence);
ecl_prin1(sentence, output);
}
} ECL_CATCH_ALL_END;
}
int
main(int argc, char **args)
{
cl_object top_level, features;
/* This should be always the first call */
cl_boot(argc, args);
/* We are computing unnormalized numbers at some point */
si_trap_fpe(ECL_T, ECL_NIL);
#ifdef ECL_CMU_FORMAT
ECL_SET(@'*load-verbose*', ECL_NIL);
#endif
ECL_SET(@'*package*', cl_core.system_package);
features = ecl_symbol_value(@'*features*');
features = CONS(ecl_make_keyword("ECL-MIN"), features);
#ifdef HAVE_UNAME
features = CONS(ecl_make_keyword("UNAME"), features);
#endif
ECL_SET(@'*features*', features);
top_level = _ecl_intern("TOP-LEVEL", cl_core.system_package);
ecl_def_c_function(top_level, si_simple_toplevel, 0);
_ecl_funcall1(top_level);
return(0);
}
#ifdef __cplusplus
extern "C" void init_lib_LSP(cl_object);
#endif
void init_lib_LSP(cl_object o) {}