mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-03 11:01:03 -08:00
FORMATTER implemented. FORMAT ported from CMUCL and optionally included when --with-cmuformat is used at configuration time.
This commit is contained in:
jjgarcia
parent
e5072a82d9
commit
8417f93d2e
27 changed files with 3266 additions and 133 deletions
|
|
@ -1496,6 +1496,10 @@ ECLS 0.9b
|
|||
the file is not found using SEARCH-LIST, then the current
|
||||
directory is tried.
|
||||
|
||||
- Two implementations of FORMAT are supplied: the old one written in
|
||||
C and a port of the code in CMUCL. The last one is selected with
|
||||
the flag --with-cmuformat.
|
||||
|
||||
* ANSI compatibility:
|
||||
|
||||
- DIRECTORY now understands :WILD, :UP, :WILD-INFERIORS, and, as an
|
||||
|
|
@ -1543,6 +1547,9 @@ ECLS 0.9b
|
|||
been almost fully implemented. Still missing are the class
|
||||
redefinition and instance obsolence protocols.
|
||||
|
||||
- FORMATTER has been implemented, and ERROR/CERROR now accept as
|
||||
"datum" the functions produced by FORMATTER.
|
||||
|
||||
TODO:
|
||||
=====
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
;;; * Load Common-Lisp base library
|
||||
;;;
|
||||
(if (member "ECL-MIN" *features* :test #'string-equal)
|
||||
(load "@abs_builddir@/lsp/load.lsp"))
|
||||
(load "@abs_builddir@/lsp/load.lsp" :verbose nil))
|
||||
(defun si::process-command-args () )
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@ mangle_name(cl_object output, char *source, int l)
|
|||
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));
|
||||
output = cl_format(3, Cnil,
|
||||
make_constant_string("((cl_object)(cl_symbols+~A))"),
|
||||
MAKE_FIXNUM(p));
|
||||
@(return found output maxarg)
|
||||
}
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -260,11 +260,13 @@ disassemble_msetq(cl_object *vector)
|
|||
} else
|
||||
newline = TRUE;
|
||||
if (FIXNUMP(var)) {
|
||||
@format(4, Ct, make_constant_string("MSETQ\t~D,VALUES(~D)"),
|
||||
var, MAKE_FIXNUM(i));
|
||||
cl_format(4, Ct,
|
||||
make_constant_string("MSETQ\t~D,VALUES(~D)"),
|
||||
var, MAKE_FIXNUM(i));
|
||||
} else {
|
||||
@format(4, Ct, make_constant_string("MSETQS\t~A,VALUES(~D)"),
|
||||
var, MAKE_FIXNUM(i));
|
||||
cl_format(4, Ct,
|
||||
make_constant_string("MSETQS\t~A,VALUES(~D)"),
|
||||
var, MAKE_FIXNUM(i));
|
||||
}
|
||||
}
|
||||
return vector;
|
||||
|
|
@ -307,8 +309,9 @@ disassemble_tagbody(cl_object *vector) {
|
|||
|
||||
print_noarg("TAGBODY");
|
||||
for (i=0; i<ntags; i++, vector++) {
|
||||
@format(4, Ct, make_constant_string("\n\tTAG\t~D @@ ~D"),
|
||||
MAKE_FIXNUM(i), MAKE_FIXNUM(simple_label(vector)));
|
||||
cl_format(4, Ct,
|
||||
make_constant_string("\n\tTAG\t~D @@ ~D"),
|
||||
MAKE_FIXNUM(i), MAKE_FIXNUM(simple_label(vector)));
|
||||
}
|
||||
vector = disassemble(vector);
|
||||
print_noarg("\t\t; tagbody");
|
||||
|
|
@ -326,7 +329,7 @@ disassemble(cl_object *vector) {
|
|||
cl_object line_format = make_constant_string("~%~4d\t");
|
||||
|
||||
BEGIN:
|
||||
@format(3, Ct, line_format, MAKE_FIXNUM(vector-base));
|
||||
cl_format(3, Ct, line_format, MAKE_FIXNUM(vector-base));
|
||||
s = next_code(vector);
|
||||
t = type_of(s);
|
||||
if (t == t_symbol) {
|
||||
|
|
|
|||
|
|
@ -1346,6 +1346,12 @@ BEGIN:
|
|||
}
|
||||
}
|
||||
|
||||
cl_object si_file_column(cl_object strm)
|
||||
{
|
||||
int c = file_column(strm);
|
||||
@(return (c < 0? Cnil : MAKE_FIXNUM(c)))
|
||||
}
|
||||
|
||||
int
|
||||
file_column(cl_object strm)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@
|
|||
#include <ctype.h>
|
||||
#include "internal.h"
|
||||
|
||||
#ifndef ECL_CMU_FORMAT
|
||||
#define FMT_MAX_PARAM 8
|
||||
typedef struct format_stack_struct {
|
||||
cl_object stream;
|
||||
|
|
@ -89,15 +90,16 @@ get_aux_stream(void)
|
|||
}
|
||||
end_critical_section();
|
||||
return stream;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
fmt_error(format_stack fmt, const char *s)
|
||||
{
|
||||
FEerror("Format error: ~A.~%~V@@TV~%\"~A\"~%",
|
||||
3, make_constant_string(s),
|
||||
MAKE_FIXNUM(&fmt->ctl_str[fmt->ctl_index] - (char *)fmt->string->string.self),
|
||||
fmt->string);
|
||||
cl_error(7, @'si::format-error',
|
||||
@':format-control', make_constant_string(s),
|
||||
@':control-string', fmt->string,
|
||||
@':offset', MAKE_FIXNUM(&fmt->ctl_str[fmt->ctl_index] -
|
||||
(char *)fmt->string->string.self));
|
||||
}
|
||||
|
||||
static int
|
||||
|
|
@ -1770,25 +1772,18 @@ fmt_semicolon(format_stack fmt, bool colon, bool atsign)
|
|||
fmt->line_length = set_param(fmt, 1, INT, 72);
|
||||
}
|
||||
|
||||
@(defun format (strm string &rest args)
|
||||
cl_object x = OBJNULL;
|
||||
@(defun si::formatter-aux (strm string &rest args)
|
||||
@
|
||||
@(return doformat(narg, strm, string, args, TRUE))
|
||||
@)
|
||||
|
||||
|
||||
static cl_object
|
||||
doformat(int narg, cl_object strm, cl_object string, cl_va_list args, bool in_formatter)
|
||||
{
|
||||
struct format_stack_struct fmt;
|
||||
jmp_buf fmt_jmp_buf0;
|
||||
int colon;
|
||||
@
|
||||
if (Null(strm)) {
|
||||
strm = make_string_output_stream(64);
|
||||
x = strm->stream.object0;
|
||||
} else if (strm == Ct)
|
||||
strm = symbol_value(@'*standard-output*');
|
||||
else if (type_of(strm) == t_string) {
|
||||
x = strm;
|
||||
if (!x->string.hasfillp)
|
||||
FEerror("The string ~S doesn't have a fill-pointer.", 1, x);
|
||||
strm = make_string_output_stream(0);
|
||||
strm->stream.object0 = x;
|
||||
x = OBJNULL;
|
||||
}
|
||||
assert_type_string(string);
|
||||
fmt.stream = strm;
|
||||
fmt.base = cl_stack_index();
|
||||
|
|
@ -1813,8 +1808,15 @@ fmt_semicolon(format_stack fmt, bool colon, bool atsign)
|
|||
}
|
||||
cl_stack_set_index(fmt.base);
|
||||
fmt_aux_stream = fmt.aux_stream;
|
||||
@(return (x == OBJNULL? Cnil : x))
|
||||
@)
|
||||
args = Cnil;
|
||||
if (in_formatter) {
|
||||
while (fmt.index < fmt.end) {
|
||||
args = CONS(cl_stack[fmt.index++], args);
|
||||
}
|
||||
args = cl_nreverse(args);
|
||||
}
|
||||
return args;
|
||||
}
|
||||
|
||||
static void
|
||||
format(format_stack fmt, const char *str, cl_index end)
|
||||
|
|
@ -2046,3 +2048,38 @@ init_format(void)
|
|||
|
||||
SYM_VAL(@'si::*indent-formatted-output*') = Cnil;
|
||||
}
|
||||
#endif /* !ECL_CMU_FORMAT */
|
||||
|
||||
@(defun format (strm string &rest args)
|
||||
cl_object output = Cnil;
|
||||
@
|
||||
if (Null(strm)) {
|
||||
strm = cl_alloc_adjustable_string(64);
|
||||
} else if (strm == Ct) {
|
||||
strm = symbol_value(@'*standard-output*');
|
||||
}
|
||||
if (type_of(strm) == t_string) {
|
||||
output = strm;
|
||||
if (!output->string.hasfillp) {
|
||||
cl_error(7, @'si::format-error',
|
||||
@':format-control',
|
||||
make_constant_string(
|
||||
"Cannot output to a non adjustable string."),
|
||||
@':control-string', string,
|
||||
@':offset', MAKE_FIXNUM(0));
|
||||
}
|
||||
strm = make_string_output_stream(0);
|
||||
strm->stream.object0 = output;
|
||||
}
|
||||
if (!Null(cl_functionp(string))) {
|
||||
cl_apply(3, string, strm, cl_grab_rest_args(args));
|
||||
} else {
|
||||
#ifdef ECL_CMU_FORMAT
|
||||
cl_funcall(4, @'si::formatter-aux', strm, string,
|
||||
cl_grab_rest_args(args));
|
||||
#else
|
||||
doformat(narg, strm, string, args, FALSE);
|
||||
#endif
|
||||
}
|
||||
@(return output)
|
||||
@)
|
||||
|
|
|
|||
|
|
@ -182,8 +182,8 @@ si_load_source(cl_object source, cl_object verbose, cl_object print)
|
|||
}
|
||||
NOT_A_FILENAME:
|
||||
if (verbose != Cnil) {
|
||||
@fresh-line(0);
|
||||
@format(3, Ct, make_simple_string(";;; Loading ~s~%"), filename);
|
||||
cl_format(3, Ct, make_simple_string("~&;;; Loading ~s~%"),
|
||||
filename);
|
||||
}
|
||||
bds_bind(@'*package*', symbol_value(@'*package*'));
|
||||
bds_bind(@'*load-pathname*', pathname);
|
||||
|
|
@ -197,8 +197,8 @@ NOT_A_FILENAME:
|
|||
FEerror("LOAD: Could not load file ~S (Error: ~S)",
|
||||
2, filename, ok);
|
||||
if (print != Cnil) {
|
||||
@fresh-line(0);
|
||||
@format(3, Ct, make_simple_string(";;; Loading ~s~%"), filename);
|
||||
cl_format(3, Ct, make_simple_string("~&;;; Loading ~s~%"),
|
||||
filename);
|
||||
}
|
||||
@(return pathname)
|
||||
@)
|
||||
|
|
|
|||
11
src/c/main.d
11
src/c/main.d
|
|
@ -116,7 +116,9 @@ cl_boot(int argc, char **argv)
|
|||
init_multival();
|
||||
init_cmpaux();
|
||||
init_main();
|
||||
#ifndef ECL_CMU_FORMAT
|
||||
init_format();
|
||||
#endif
|
||||
init_interrupt();
|
||||
#ifdef RUNTIME
|
||||
SYM_VAL(@'*features*') = CONS(make_keyword("RUNTIME"), SYM_VAL(@'*features*'));
|
||||
|
|
@ -217,8 +219,8 @@ si_setenv(cl_object var, cl_object value)
|
|||
ret_val = setenv(var->string.self, value->string.self, 1);
|
||||
#else
|
||||
cl_object temp =
|
||||
cl_format(4, Cnil, make_simple_string("~A=~A"),
|
||||
var, value);
|
||||
cl_format(4, Cnil, make_simple_string("~A=~A"), var,
|
||||
value);
|
||||
putenv(temp->string.self);
|
||||
#endif
|
||||
}
|
||||
|
|
@ -267,11 +269,9 @@ init_main(void)
|
|||
#ifdef PDE
|
||||
ADD_FEATURE("PDE");
|
||||
#endif
|
||||
|
||||
#ifdef ECL_FFI
|
||||
ADD_FEATURE("FFI");
|
||||
#endif
|
||||
|
||||
#ifdef unix
|
||||
ADD_FEATURE("UNIX");
|
||||
#endif
|
||||
|
|
@ -284,6 +284,9 @@ init_main(void)
|
|||
#ifdef MSDOS
|
||||
ADD_FEATURE("MS-DOS");
|
||||
#endif
|
||||
#ifdef ECL_CMU_FORMAT
|
||||
ADD_FEATURE("CMU-FORMAT");
|
||||
#endif
|
||||
|
||||
/* This is assumed in all systems */
|
||||
ADD_FEATURE("IEEE-FLOATING-POINT");
|
||||
|
|
|
|||
|
|
@ -722,7 +722,7 @@ cl_decode_float(cl_object x)
|
|||
s = 0;
|
||||
}
|
||||
d = frexp(d, &e);
|
||||
x = make_shortfloat(d);
|
||||
x = make_longfloat(d);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
|
|
@ -760,7 +760,7 @@ cl_float_radix(cl_object x)
|
|||
|
||||
if (t != t_shortfloat && t != t_longfloat)
|
||||
FEtype_error_float(x);
|
||||
@(return MAKE_FIXNUM(2))
|
||||
@(return MAKE_FIXNUM(FLT_RADIX))
|
||||
}
|
||||
|
||||
@(defun float_sign (x &optional (y x))
|
||||
|
|
@ -793,10 +793,10 @@ cl_float_digits(cl_object x)
|
|||
{
|
||||
switch (type_of(x)) {
|
||||
case t_shortfloat:
|
||||
x = MAKE_FIXNUM(6);
|
||||
x = MAKE_FIXNUM(FLT_MANT_DIG);
|
||||
break;
|
||||
case t_longfloat:
|
||||
x = MAKE_FIXNUM(14);
|
||||
x = MAKE_FIXNUM(DBL_MANT_DIG);
|
||||
break;
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
|
|
@ -810,8 +810,10 @@ cl_float_precision(cl_object x)
|
|||
switch (type_of(x)) {
|
||||
case t_shortfloat:
|
||||
x = (sf(x) == 0.0) ? MAKE_FIXNUM(0) : MAKE_FIXNUM(24);
|
||||
break;
|
||||
case t_longfloat:
|
||||
x = (lf(x) == 0.0) ? MAKE_FIXNUM(0) : MAKE_FIXNUM(53);
|
||||
break;
|
||||
default:
|
||||
FEtype_error_float(x);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -5,6 +5,9 @@ struct {
|
|||
const char *name, *translation;
|
||||
}
|
||||
#else
|
||||
#ifndef ECL_CMU_FORMAT
|
||||
extern cl_object si_formatter_aux _ARGS((int narg, cl_object strm, cl_object string, ...));
|
||||
#endif
|
||||
#define SYS_
|
||||
#define KEY_
|
||||
cl_symbol_initializer
|
||||
|
|
@ -395,6 +398,7 @@ cl_symbols[] = {
|
|||
{"FMAKUNBOUND", CL_ORDINARY, cl_fmakunbound, 1},
|
||||
{"FORCE-OUTPUT", CL_ORDINARY, cl_force_output, -1},
|
||||
{"FORMAT", CL_ORDINARY, cl_format, -1},
|
||||
{"FORMATTER", CL_ORDINARY, NULL, -1},
|
||||
{"FOURTH", CL_ORDINARY, cl_cadddr, 1},
|
||||
{"FRESH-LINE", CL_ORDINARY, cl_fresh_line, -1},
|
||||
{"FROUND", CL_ORDINARY, NULL, -1},
|
||||
|
|
@ -1052,6 +1056,8 @@ cl_symbols[] = {
|
|||
{SYS_ "FILE-KIND", SI_ORDINARY, si_file_kind, 2},
|
||||
{SYS_ "FILL-POINTER-SET", SI_ORDINARY, si_fill_pointer_set, 2},
|
||||
{SYS_ "FIXNUMP", SI_ORDINARY, si_fixnump, 1},
|
||||
{SYS_ "FORMAT-ERROR", SI_ORDINARY, NULL, -1},
|
||||
{SYS_ "FORMATTER-AUX", SI_ORDINARY, si_formatter_aux, -1},
|
||||
{SYS_ "FRS-BDS", SI_ORDINARY, si_frs_bds, 1},
|
||||
{SYS_ "FRS-CLASS", SI_ORDINARY, si_frs_class, 1},
|
||||
{SYS_ "FRS-IHS", SI_ORDINARY, si_frs_ihs, 1},
|
||||
|
|
@ -1256,6 +1262,7 @@ cl_symbols[] = {
|
|||
{KEY_ "CATCHALL", KEYWORD, NULL, -1},
|
||||
{KEY_ "CIRCLE", KEYWORD, NULL, -1},
|
||||
{KEY_ "COMPILE-TOPLEVEL", KEYWORD, NULL, -1},
|
||||
{KEY_ "CONTROL-STRING", CL_ORDINARY, NULL, -1},
|
||||
{KEY_ "CREATE", KEYWORD, NULL, -1},
|
||||
{KEY_ "DATUM", KEYWORD, NULL, -1},
|
||||
{KEY_ "DEFAULT", KEYWORD, NULL, -1},
|
||||
|
|
@ -1297,6 +1304,7 @@ cl_symbols[] = {
|
|||
{KEY_ "NEWEST", KEYWORD, NULL, -1},
|
||||
{KEY_ "NICKNAMES", KEYWORD, NULL, -1},
|
||||
{KEY_ "OBJECT", KEYWORD, NULL, -1},
|
||||
{KEY_ "OFFSET", KEYWORD, NULL, -1},
|
||||
{KEY_ "OUTPUT", KEYWORD, NULL, -1},
|
||||
{KEY_ "OVERWRITE", KEYWORD, NULL, -1},
|
||||
{KEY_ "PACKAGE", KEYWORD, NULL, -1},
|
||||
|
|
@ -1367,6 +1375,8 @@ cl_symbols[] = {
|
|||
{KEY_ "LINK", KEYWORD, NULL, -1},
|
||||
{KEY_ "SPECIAL", KEYWORD, NULL, -1},
|
||||
|
||||
{SYS_ "FILE-COLUMN", SI_ORDINARY, si_file_column, 1},
|
||||
|
||||
/* Tag for end of list */
|
||||
{NULL, CL_ORDINARY, NULL, -1}};
|
||||
|
||||
|
|
|
|||
|
|
@ -25,8 +25,8 @@ si_system(cl_object cmd)
|
|||
volatile int code;
|
||||
|
||||
assert_type_string(cmd);
|
||||
s = cmd->string.self;
|
||||
code = system((const char *)s);
|
||||
cmd = copy_simple_string(cmd);
|
||||
code = system((const char *)(cmd->string.self));
|
||||
/* FIXME! Are there any limits for system()? */
|
||||
/* if (cmd->string.fillp >= 1024)
|
||||
FEerror("Too long command line: ~S.", 1, cmd);*/
|
||||
|
|
|
|||
|
|
@ -326,7 +326,6 @@
|
|||
(defun define-simple-method-combination (name &key documentation
|
||||
identity-with-one-argument
|
||||
(operator name))
|
||||
(declare (si::c-local))
|
||||
`(define-method-combination
|
||||
,name (&optional (order :MOST-SPECIFIC-FIRST))
|
||||
((around (:AROUND))
|
||||
|
|
@ -349,7 +348,7 @@
|
|||
(declare (si::c-local))
|
||||
(flet ((syntax-error ()
|
||||
(error "~S is not a valid DEFINE-METHOD-COMBINATION form"
|
||||
whole)))
|
||||
form)))
|
||||
(destructuring-bind (name lambda-list method-groups &rest body &aux
|
||||
(group-names '())
|
||||
(group-checks '())
|
||||
|
|
|
|||
|
|
@ -435,7 +435,7 @@ strings."
|
|||
datum)
|
||||
((symbolp datum) ;roughly, (subtypep datum 'CONDITION)
|
||||
(apply #'make-condition datum arguments))
|
||||
((stringp datum)
|
||||
((or (stringp datum) (functionp datum))
|
||||
(make-condition default-type
|
||||
:FORMAT-CONTROL datum
|
||||
:FORMAT-ARGUMENTS arguments))
|
||||
|
|
@ -608,6 +608,25 @@ returns with NIL."
|
|||
;;;
|
||||
(define-condition simple-program-error (simple-condition program-error) ())
|
||||
|
||||
(define-condition format-error (error)
|
||||
((control-string :reader format-error-control-string
|
||||
:initarg :control-string
|
||||
#+cmu-format :initform
|
||||
#+cmu-format *default-format-error-control-string*)
|
||||
(offset :reader format-error-offset :initarg :offset
|
||||
#+cmu-format :initform
|
||||
#+cmu-format *default-format-error-offset*)
|
||||
(print-banner :reader format-error-print-banner :initarg :print-banner
|
||||
:initform t))
|
||||
(:report (lambda (condition stream)
|
||||
(cl:format stream
|
||||
"~:[~;Error in format: ~]~
|
||||
~?~@[~% ~A~% ~V@T^~]"
|
||||
(format-error-print-banner condition)
|
||||
(simple-error-format-control condition)
|
||||
(simple-error-format-arguments condition)
|
||||
(format-error-control-string condition)
|
||||
(format-error-offset condition)))))
|
||||
|
||||
|
||||
(defmacro handler-case (form &rest cases)
|
||||
|
|
|
|||
|
|
@ -215,7 +215,7 @@
|
|||
option" l)))))
|
||||
|
||||
(defun parse-legal-declaration (decl)
|
||||
(declare (si::c-local))
|
||||
;(declare (si::c-local))
|
||||
(unless (eq (first decl) 'OPTIMIZE)
|
||||
(error "The only declaration allowed is optimize"))
|
||||
(dolist (first (rest decl))
|
||||
|
|
|
|||
|
|
@ -261,7 +261,6 @@ a class metaobject, use REDEFINE-CLASS instead."))
|
|||
(defun help-ensure-class (&rest options
|
||||
&key (metaclass 'standard-class) direct-superclasses
|
||||
&allow-other-keys)
|
||||
(declare (si::c-local))
|
||||
(remf options :metaclass)
|
||||
(remf options :direct-superclasses)
|
||||
(setf metaclass (coerce-to-class metaclass)
|
||||
|
|
|
|||
|
|
@ -286,7 +286,7 @@ The default value is NIL.")
|
|||
;;; though &optional, &rest, and &key return types are simply ignored.
|
||||
;;;
|
||||
(defvar *function-declarations* nil)
|
||||
(defvar *allow-c-local-declaration* nil)
|
||||
(defvar *allow-c-local-declaration* t)
|
||||
(defvar *alien-declarations* nil)
|
||||
(defvar *notinline* nil)
|
||||
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
;;;
|
||||
;;; * Ensure that we have the whole of Common-Lisp to compile
|
||||
;;;
|
||||
(load "bare.lsp")
|
||||
(load "bare.lsp" :verbose nil)
|
||||
|
||||
;;;
|
||||
;;; * Dump documentation
|
||||
|
|
|
|||
14
src/configure
vendored
14
src/configure
vendored
|
|
@ -869,6 +869,7 @@ Optional Packages:
|
|||
--with-gmp=args Configure supplied GMP library with arguments.
|
||||
--with-config-file=f Supply configuration for a cross compiler.
|
||||
--with-oldloop Use the old MIT LOOP macro.
|
||||
--with-cmuformat Use the FORMAT routine from CMUCL.
|
||||
--with-clos-streams Allow user defined stream objects.
|
||||
--with-ffi Run-time foreign data manipulation.
|
||||
--with-x use the X Window System
|
||||
|
|
@ -1454,6 +1455,12 @@ if test "${with_oldloop+set}" = set; then
|
|||
oldloop="yes"
|
||||
fi;
|
||||
|
||||
# Check whether --with-cmuformat or --without-cmuformat was given.
|
||||
if test "${with_cmuformat+set}" = set; then
|
||||
withval="$with_cmuformat"
|
||||
cmuformat="yes"
|
||||
fi;
|
||||
|
||||
# Check whether --with-clos-streams or --without-clos-streams was given.
|
||||
if test "${with_clos_streams+set}" = set; then
|
||||
withval="$with_clos_streams"
|
||||
|
|
@ -3860,7 +3867,6 @@ case "${host_os}" in
|
|||
;;
|
||||
esac
|
||||
CFLAGS="${CFLAGS} -D${thehost}"
|
||||
echo ${CFLAGS}
|
||||
echo "$as_me:$LINENO: checking for ld flags when building shared libraries" >&5
|
||||
echo $ECHO_N "checking for ld flags when building shared libraries... $ECHO_C" >&6
|
||||
if test "${shared}" = "yes"; then
|
||||
|
|
@ -4133,6 +4139,12 @@ if test "${oldloop}"; then
|
|||
#define ECL_OLD_LOOP 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
if test "${cmuformat}"; then
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
#define ECL_CMU_FORMAT 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
if test "${closstreams}"; then
|
||||
cat >>confdefs.h <<\_ACEOF
|
||||
|
|
|
|||
|
|
@ -85,6 +85,9 @@ AC_ARG_ENABLE(shared,
|
|||
AC_ARG_WITH(oldloop,
|
||||
[--with-oldloop Use the old MIT LOOP macro.],
|
||||
oldloop="yes")
|
||||
AC_ARG_WITH(cmuformat,
|
||||
[--with-cmuformat Use the FORMAT routine from CMUCL.],
|
||||
cmuformat="yes")
|
||||
AC_ARG_WITH(clos-streams,
|
||||
[--with-clos-streams Allow user defined stream objects.],
|
||||
closstreams="yes")
|
||||
|
|
@ -208,6 +211,9 @@ fi
|
|||
if test "${oldloop}"; then
|
||||
AC_DEFINE(ECL_OLD_LOOP)
|
||||
fi
|
||||
if test "${cmuformat}"; then
|
||||
AC_DEFINE(ECL_CMU_FORMAT)
|
||||
fi
|
||||
if test "${closstreams}"; then
|
||||
AC_DEFINE(ECL_CLOS_STREAMS)
|
||||
fi
|
||||
|
|
|
|||
|
|
@ -122,6 +122,9 @@ typedef unsigned @CL_FIXNUM_TYPE@ cl_hashkey;
|
|||
/* Allow STREAM operations to work on arbitrary objects */
|
||||
#undef ECL_CLOS_STREAMS
|
||||
|
||||
/* Use CMU Common-Lisp's FORMAT routine */
|
||||
#undef ECL_CMU_FORMAT
|
||||
|
||||
/*
|
||||
* SYSTEM FEATURES:
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -55,7 +55,6 @@ extern void *cl_alloc_align(cl_index size, cl_index align);
|
|||
#define cl_alloc_atomic_align(x,s) cl_alloc_align(x,s)
|
||||
#define ecl_register_static_root(x) ecl_register_root(x);
|
||||
#endif /* GBC_BOEHM */
|
||||
extern void init_alloc(void);
|
||||
|
||||
/* all_symbols */
|
||||
|
||||
|
|
@ -72,7 +71,6 @@ typedef union {
|
|||
} cl_symbol_initializer;
|
||||
extern cl_symbol_initializer cl_symbols[];
|
||||
extern cl_index cl_num_symbols_in_core;
|
||||
extern void init_all_symbols(void);
|
||||
|
||||
/* apply.c */
|
||||
|
||||
|
|
@ -111,7 +109,6 @@ extern void array_allocself(cl_object x);
|
|||
extern void adjust_displaced(cl_object x, ptrdiff_t diff);
|
||||
extern cl_elttype array_elttype(cl_object x);
|
||||
extern cl_elttype get_elttype(cl_object x);
|
||||
extern void init_array(void);
|
||||
|
||||
|
||||
/* assignment.c */
|
||||
|
|
@ -125,13 +122,6 @@ extern cl_object si_put_sysprop(cl_object sym, cl_object prop, cl_object value);
|
|||
extern cl_object si_rem_sysprop(cl_object sym, cl_object prop);
|
||||
|
||||
extern void clear_compiler_properties(cl_object sym);
|
||||
extern void init_assignment(void);
|
||||
|
||||
|
||||
/* backq.c */
|
||||
|
||||
extern void init_backq(void);
|
||||
|
||||
|
||||
/* big.c */
|
||||
|
||||
|
|
@ -150,7 +140,6 @@ extern cl_object big_plus(cl_object x, cl_object y);
|
|||
extern cl_object big_normalize(cl_object x);
|
||||
extern double big_to_double(cl_object x);
|
||||
extern long big_to_long(cl_object x);
|
||||
extern void init_big(void);
|
||||
|
||||
|
||||
/* cfun.c */
|
||||
|
|
@ -208,7 +197,6 @@ extern int char_cmp(cl_object x, cl_object y);
|
|||
extern bool char_equal(cl_object x, cl_object y);
|
||||
extern int char_compare(cl_object x, cl_object y);
|
||||
extern short digit_weight(int w, int r);
|
||||
extern void init_character(void);
|
||||
|
||||
/* clos.c */
|
||||
|
||||
|
|
@ -218,7 +206,6 @@ extern cl_object cl_find_class _ARGS((int narg, cl_object name, ...));
|
|||
extern cl_object class_class;
|
||||
extern cl_object class_object;
|
||||
extern cl_object class_built_in;
|
||||
extern void init_clos(void);
|
||||
#endif
|
||||
|
||||
/* cmpaux.c */
|
||||
|
|
@ -239,7 +226,6 @@ extern void cl_go(cl_object tag_id, cl_object label) __attribute__((noreturn,reg
|
|||
extern void cl_parse_key(cl_va_list args, int nkey, cl_object *keys, cl_object *vars, cl_object *rest, bool allow_other_keys);
|
||||
extern cl_object cl_grab_rest_args(cl_va_list args);
|
||||
extern void check_other_key(cl_object l, int n, ...);
|
||||
extern void init_cmpaux(void);
|
||||
|
||||
/* compiler.c */
|
||||
|
||||
|
|
@ -252,7 +238,6 @@ extern cl_object si_process_declarations _ARGS((int narg, cl_object body, ...));
|
|||
|
||||
extern cl_object make_lambda(cl_object name, cl_object lambda);
|
||||
extern cl_object eval(cl_object form, cl_object *bytecodes, cl_object env);
|
||||
extern void init_compiler(void);
|
||||
|
||||
/* interpreter.c */
|
||||
|
||||
|
|
@ -273,7 +258,6 @@ extern void cl_stack_pop_values(int n);
|
|||
extern cl_object lex_env;
|
||||
extern cl_object lambda_apply(int narg, cl_object fun);
|
||||
extern cl_object *interpret(cl_object *memory);
|
||||
extern void init_interpreter(void);
|
||||
|
||||
/* disassembler.c */
|
||||
|
||||
|
|
@ -311,7 +295,6 @@ extern cl_object CEerror(char *err_str, int narg, ...);
|
|||
extern void illegal_index(cl_object x, cl_object i);
|
||||
extern void FEtype_error_symbol(cl_object obj) __attribute__((noreturn,regparm(2)));
|
||||
extern void FElibc_error(const char *msg, int narg, ...) __attribute__((noreturn));
|
||||
extern void init_error(void);
|
||||
|
||||
/* eval.c */
|
||||
|
||||
|
|
@ -332,7 +315,6 @@ extern cl_object cl_constantp(int narg, cl_object arg, ...);
|
|||
extern cl_object cl_apply_from_stack(cl_index narg, cl_object fun);
|
||||
extern cl_object link_call(cl_object sym, cl_objectfn *pLK, int narg, cl_va_list args);
|
||||
extern cl_object cl_safe_eval(cl_object form, cl_object *bytecodes, cl_object env, cl_object err_value);
|
||||
extern void init_eval(void);
|
||||
|
||||
/* ffi.c */
|
||||
|
||||
|
|
@ -368,6 +350,7 @@ extern cl_object cl_open _ARGS((int narg, cl_object filename, ...));
|
|||
extern cl_object cl_file_position _ARGS((int narg, cl_object file_stream, ...));
|
||||
extern cl_object si_do_write_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
|
||||
extern cl_object si_do_read_sequence(cl_object string, cl_object stream, cl_object start, cl_object end);
|
||||
extern cl_object si_file_column(cl_object strm);
|
||||
|
||||
extern bool input_stream_p(cl_object strm);
|
||||
extern bool output_stream_p(cl_object strm);
|
||||
|
|
@ -394,14 +377,11 @@ extern long file_position(cl_object strm);
|
|||
extern long file_position_set(cl_object strm, long disp);
|
||||
extern long file_length(cl_object strm);
|
||||
extern int file_column(cl_object strm);
|
||||
extern void init_file(void);
|
||||
|
||||
|
||||
/* format.c */
|
||||
|
||||
extern cl_object cl_format _ARGS((int narg, volatile cl_object strm, cl_object string, ...));
|
||||
extern void init_format(void);
|
||||
|
||||
extern cl_object cl_format _ARGS((int narg, cl_object stream, cl_object string, ...));
|
||||
|
||||
/* gbc.c */
|
||||
|
||||
|
|
@ -418,7 +398,6 @@ extern cl_object (*GC_enter_hook)(void);
|
|||
extern cl_object (*GC_exit_hook)(void);
|
||||
extern void ecl_register_root(cl_object *p);
|
||||
extern void ecl_gc(cl_type t);
|
||||
extern void init_GC(void);
|
||||
#endif
|
||||
|
||||
#ifdef GBC_BOEHM
|
||||
|
|
@ -462,7 +441,6 @@ extern cl_hashkey hash_eql(cl_object x);
|
|||
extern cl_hashkey hash_equal(cl_object x);
|
||||
extern void sethash(cl_object key, cl_object hashtable, cl_object value);
|
||||
extern void extend_hashtable(cl_object hashtable);
|
||||
extern void init_hash(void);
|
||||
extern cl_object gethash(cl_object key, cl_object hash);
|
||||
extern cl_object gethash_safe(cl_object key, cl_object hash, cl_object def);
|
||||
extern bool remhash(cl_object key, cl_object hash);
|
||||
|
|
@ -594,8 +572,6 @@ extern cl_object si_load_source(cl_object file, cl_object verbose, cl_object pri
|
|||
extern cl_object si_load_binary(cl_object file, cl_object verbose, cl_object print);
|
||||
extern cl_object cl_load _ARGS((int narg, cl_object pathname, ...));
|
||||
|
||||
extern void init_load(void);
|
||||
|
||||
|
||||
/* lwp.c */
|
||||
#ifdef THREADS
|
||||
|
|
@ -641,7 +617,6 @@ extern cl_object cl_macroexpand_1 _ARGS((int narg, cl_object form, ...));
|
|||
extern cl_object search_macro(cl_object name, cl_object env);
|
||||
extern cl_object macro_expand1(cl_object form, cl_object env);
|
||||
extern cl_object macro_expand(cl_object form, cl_object env);
|
||||
extern void init_macros(void);
|
||||
|
||||
|
||||
/* main.c */
|
||||
|
|
@ -672,7 +647,6 @@ extern cl_object cl_mapcon _ARGS((int narg, cl_object fun, ...));
|
|||
|
||||
extern cl_object cl_values_list(cl_object list);
|
||||
extern cl_object cl_values _ARGS((int narg, ...));
|
||||
extern void init_multival(void);
|
||||
|
||||
|
||||
/* num_arith.c */
|
||||
|
|
@ -713,8 +687,6 @@ extern cl_object make_shortfloat(float f);
|
|||
extern cl_object make_longfloat(double f);
|
||||
extern cl_object make_complex(cl_object r, cl_object i);
|
||||
extern double number_to_double(cl_object x);
|
||||
extern void init_number(void);
|
||||
|
||||
|
||||
/* num_co.c */
|
||||
|
||||
|
|
@ -748,7 +720,6 @@ extern cl_object floor2(cl_object x, cl_object y);
|
|||
extern cl_object ceiling2(cl_object x, cl_object y);
|
||||
extern cl_object truncate2(cl_object x, cl_object y);
|
||||
extern cl_object round2(cl_object x, cl_object y);
|
||||
extern void init_num_co(void);
|
||||
|
||||
|
||||
/* num_comp.c */
|
||||
|
|
@ -764,7 +735,6 @@ extern cl_object cl_min _ARGS((int narg, cl_object min, ...));
|
|||
|
||||
extern int number_equalp(cl_object x, cl_object y);
|
||||
extern int number_compare(cl_object x, cl_object y);
|
||||
extern void init_num_comp(void);
|
||||
|
||||
|
||||
/* num_log.c */
|
||||
|
|
@ -788,7 +758,6 @@ extern cl_object cl_logand _ARGS((int narg, ...));
|
|||
extern cl_object cl_logeqv _ARGS((int narg, ...));
|
||||
|
||||
extern cl_object ecl_ash(cl_object x, cl_fixnum w);
|
||||
extern void init_num_log(void);
|
||||
|
||||
|
||||
/* num_pred.c */
|
||||
|
|
@ -812,7 +781,6 @@ extern cl_object cl_random_state_p(cl_object x);
|
|||
extern cl_object cl_random _ARGS((int narg, cl_object x, ...));
|
||||
extern cl_object cl_make_random_state _ARGS((int narg, ...));
|
||||
extern cl_object make_random_state(cl_object rs);
|
||||
extern void init_num_rand(void);
|
||||
|
||||
|
||||
/* num_sfun.c */
|
||||
|
|
@ -836,7 +804,6 @@ extern cl_object cl_cosh(cl_object x);
|
|||
extern cl_object cl_tanh(cl_object x);
|
||||
extern cl_object cl_atan _ARGS((int narg, cl_object x, ...));
|
||||
extern cl_object cl_log _ARGS((int narg, cl_object x, ...));
|
||||
extern void init_num_sfun(void);
|
||||
|
||||
|
||||
/* package.c */
|
||||
|
|
@ -886,7 +853,6 @@ extern void shadowing_import(cl_object s, cl_object p);
|
|||
extern void shadow(cl_object s, cl_object p);
|
||||
extern void use_package(cl_object x0, cl_object p);
|
||||
extern void unuse_package(cl_object x0, cl_object p);
|
||||
extern void init_package(void);
|
||||
|
||||
|
||||
/* pathname.c */
|
||||
|
|
@ -922,7 +888,6 @@ extern cl_object coerce_to_file_pathname(cl_object pathname);
|
|||
extern cl_object coerce_to_filename(cl_object pathname);
|
||||
extern cl_object merge_pathnames(cl_object path, cl_object defaults, cl_object default_version);
|
||||
extern bool logical_hostname_p(cl_object host);
|
||||
extern void init_pathname(void);
|
||||
|
||||
|
||||
/* predicate.c */
|
||||
|
|
@ -988,7 +953,6 @@ extern cl_object terpri(cl_object strm);
|
|||
extern void write_string(cl_object strng, cl_object strm);
|
||||
extern void princ_str(const char *s, cl_object sym);
|
||||
extern void princ_char(int c, cl_object sym);
|
||||
extern void init_print(void);
|
||||
|
||||
|
||||
/* profile.c */
|
||||
|
|
@ -1039,7 +1003,6 @@ extern cl_object ecl_current_readtable(void);
|
|||
extern int ecl_current_read_base(void);
|
||||
extern char ecl_current_read_default_float_format(void);
|
||||
extern cl_object c_string_to_object(const char *s);
|
||||
extern void init_read(void);
|
||||
extern cl_object read_VV(cl_object block, void *entry);
|
||||
|
||||
|
||||
|
|
@ -1098,7 +1061,6 @@ extern void unwind(frame_ptr fr) __attribute__((noreturn,regparm(2)));
|
|||
extern frame_ptr frs_sch(cl_object frame_id);
|
||||
extern frame_ptr frs_sch_catch(cl_object frame_id);
|
||||
extern cl_object new_frame_id(void);
|
||||
extern void init_stacks(int *);
|
||||
|
||||
/* string.c */
|
||||
|
||||
|
|
@ -1195,7 +1157,6 @@ extern cl_object symbol_value(cl_object s);
|
|||
extern cl_object ecl_getf(cl_object place, cl_object indicator, cl_object deflt);
|
||||
extern cl_object ecl_get(cl_object s, cl_object p, cl_object d);
|
||||
extern bool keywordp(cl_object s);
|
||||
extern void init_symbol(void);
|
||||
|
||||
|
||||
/* tclBasic.c */
|
||||
|
|
@ -1254,7 +1215,6 @@ extern cl_object si_get_local_time_zone();
|
|||
extern cl_object si_daylight_saving_time_p _ARGS((int narg, ...));
|
||||
|
||||
extern cl_object UTC_time_to_universal_time(cl_fixnum i);
|
||||
extern void init_unixtime(void);
|
||||
|
||||
|
||||
/* tkMain.c */
|
||||
|
|
@ -1292,7 +1252,6 @@ extern void assert_type_vector(cl_object p);
|
|||
extern void assert_type_list(cl_object p);
|
||||
extern void assert_type_proper_list(cl_object p);
|
||||
extern cl_object cl_type_of(cl_object x);
|
||||
extern void init_typespec(void);
|
||||
|
||||
extern void FEtype_error_character(cl_object x) __attribute__((noreturn,regparm(2)));
|
||||
extern void FEtype_error_cons(cl_object x) __attribute__((noreturn,regparm(2)));
|
||||
|
|
@ -1338,7 +1297,6 @@ extern int interrupt_enable;
|
|||
extern int interrupt_flag;
|
||||
extern void signal_catcher(int sig, int code, int scp);
|
||||
extern void enable_interrupt(void);
|
||||
extern void init_interrupt(void);
|
||||
|
||||
|
||||
/* unixsys.c */
|
||||
|
|
|
|||
|
|
@ -20,6 +20,50 @@ extern "C" {
|
|||
* FUNCTIONS, VARIABLES AND TYPES NOT FOR GENERAL USE *
|
||||
* -------------------------------------------------------------------- */
|
||||
|
||||
/* booting */
|
||||
extern void init_all_symbols(void);
|
||||
extern void init_alloc(void);
|
||||
extern void init_array(void);
|
||||
extern void init_assignment(void);
|
||||
extern void init_backq(void);
|
||||
extern void init_big(void);
|
||||
extern void init_character(void);
|
||||
#ifdef CLOS
|
||||
extern void init_clos(void);
|
||||
#endif
|
||||
extern void init_cmpaux(void);
|
||||
extern void init_compiler(void);
|
||||
extern void init_error(void);
|
||||
extern void init_eval(void);
|
||||
extern void init_file(void);
|
||||
#ifndef ECL_CMU_FORMAT
|
||||
extern void init_format(void);
|
||||
#endif
|
||||
#ifndef GBC_BOEHM
|
||||
extern void init_GC(void);
|
||||
#endif
|
||||
extern void init_hash(void);
|
||||
extern void init_interpreter(void);
|
||||
extern void init_load(void);
|
||||
extern void init_macros(void);
|
||||
extern void init_multival(void);
|
||||
extern void init_number(void);
|
||||
extern void init_num_co(void);
|
||||
extern void init_num_comp(void);
|
||||
extern void init_num_log(void);
|
||||
extern void init_num_rand(void);
|
||||
extern void init_num_sfun(void);
|
||||
extern void init_package(void);
|
||||
extern void init_pathname(void);
|
||||
extern void init_print(void);
|
||||
extern void init_read(void);
|
||||
extern void init_stacks(int *);
|
||||
extern void init_symbol(void);
|
||||
extern void init_unixtime(void);
|
||||
extern void init_typespec(void);
|
||||
extern void init_interrupt(void);
|
||||
|
||||
|
||||
/* all_symbols.d */
|
||||
|
||||
extern cl_index cl_num_symbols_in_core;
|
||||
|
|
|
|||
|
|
@ -32,6 +32,8 @@
|
|||
(loop () () ())
|
||||
#-old-loop
|
||||
(loop2 () () ())
|
||||
#+cmu-format
|
||||
(format () () ())
|
||||
(defpackage () () ())
|
||||
(ffi () () ())
|
||||
#-runtime
|
||||
|
|
|
|||
3017
src/lsp/format.lsp
Normal file
3017
src/lsp/format.lsp
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -249,3 +249,8 @@ the one defined in the ANSI standard. *print-base* is 10, *print-array* is t,
|
|||
(*read-suppress* nil)
|
||||
(*readtable* (copy-readtable (si::standard-readtable))))
|
||||
,@body))
|
||||
|
||||
#-formatter
|
||||
(defmacro formatter (control-string)
|
||||
`#'(lambda (*standard-output* &rest args)
|
||||
(si::formatter-aux *standard-output* ,control-string args)))
|
||||
|
|
|
|||
|
|
@ -1,36 +1,38 @@
|
|||
|
||||
(load "@abs_srcdir@/export.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/defmacro.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/helpfile.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/evalmacros.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/module.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/autoload.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/describe.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/setf.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/predlib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/arraylib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/assert.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/defstruct.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/iolib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/listlib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/mislib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/numlib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/packlib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/seq.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/seqlib.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/trace.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/ansi.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/export.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/defmacro.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/helpfile.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/evalmacros.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/module.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/autoload.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/describe.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/setf.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/predlib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/arraylib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/assert.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/defstruct.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/iolib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/listlib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/mislib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/numlib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/packlib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/seq.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/seqlib.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/trace.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/ansi.lsp" :verbose nil)
|
||||
#+old-loop
|
||||
(load "@abs_srcdir@/loop.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/loop.lsp" :verbose nil)
|
||||
#-old-loop
|
||||
(load "@abs_srcdir@/loop2.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/defpackage.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/ffi.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/loop2.lsp" :verbose nil)
|
||||
#+cmu-format
|
||||
(load "@abs_srcdir@/format.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/defpackage.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/ffi.lsp" :verbose nil)
|
||||
#+ffi
|
||||
(load "@abs_srcdir@/ffi-objects.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/ffi-objects.lsp" :verbose nil)
|
||||
#+threads
|
||||
(load "@abs_srcdir@/thread.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/thread.lsp" :verbose nil)
|
||||
#+tk
|
||||
(load "@abs_srcdir@/tk-init.lsp" :verbose t)
|
||||
(load "@abs_builddir@/config.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/top.lsp" :verbose t)
|
||||
(load "@abs_srcdir@/tk-init.lsp" :verbose nil)
|
||||
(load "@abs_builddir@/config.lsp" :verbose nil)
|
||||
(load "@abs_srcdir@/top.lsp" :verbose nil)
|
||||
|
|
|
|||
|
|
@ -608,7 +608,7 @@ if not possible."
|
|||
;; and tag all types to which it belongs.
|
||||
;;
|
||||
(defun register-member-type (object)
|
||||
(declare (si::c-local))
|
||||
;(declare (si::c-local))
|
||||
(let ((pos (assoc object *member-types*)))
|
||||
(or (and pos (cdr pos))
|
||||
;; We convert number into intervals, so that (AND INTEGER (NOT
|
||||
|
|
@ -870,8 +870,7 @@ if not possible."
|
|||
;; *ELEMENTARY-TYPES* and *MEMBER-TYPES*.
|
||||
;;
|
||||
(defun canonical-type (type)
|
||||
(declare (notinline clos::classp)
|
||||
(si::c-local))
|
||||
(declare (notinline clos::classp))
|
||||
(cond ((find-registered-tag type))
|
||||
((eq type 'T) -1)
|
||||
((eq type 'NIL) 0)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue