mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 22:01:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

Update ECL's old implementation of FORMAT to make it work (J. Jaakkola)

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-11-21 21:54:10 +01:00
parent f3f7947f5d
commit f1b60b9de9
5 changed files with 263 additions and 253 deletions
Download patch file Download diff file Expand all files Collapse all files

488
src/c/format.d
View file

File diff suppressed because it is too large Load diff

3
src/c/main.d
View file

@ -138,9 +138,6 @@ ecl_init_env(cl_env_ptr env)
ecl_stack_set_size(env, ecl_get_option(ECL_OPT_LISP_STACK_SIZE));
#if !defined(ECL_CMU_FORMAT)
env->print_pretty = FALSE;
env->queue = ecl_alloc_atomic(ECL_PPRINT_QUEUE_SIZE * sizeof(short));
env->indent_stack = ecl_alloc_atomic(ECL_PPRINT_INDENTATION_STACK_SIZE * sizeof(short));
env->fmt_aux_stream = ecl_make_string_output_stream(64, 1);
#endif
#ifdef HAVE_LIBFFI

2
src/c/printer/write_object.d
View file

@ -88,6 +88,7 @@ cl_object
si_write_object(cl_object x, cl_object stream)
{
bool circle;
#ifdef CMU_FORMAT
if (ecl_symbol_value(@'*print-pretty*') != Cnil) {
cl_object f = funcall(2, @'pprint-dispatch', x);
if (VALUES(1) != Cnil) {
@ -95,6 +96,7 @@ si_write_object(cl_object x, cl_object stream)
goto OUTPUT;
}
}
#endif /* CMU_FORMAT */
circle = ecl_print_circle();
if (circle && !Null(x) && !FIXNUMP(x) && !CHARACTERP(x) &&
(LISTP(x) || (x->d.t != t_symbol) || (Null(x->symbol.hpack))))

21
src/cmp/cmputil.lsp
View file

@ -17,10 +17,18 @@
#+new-cmp
(in-package "C-LOG")
(defconstant +note-format+ "~&~@< ~;~?~;~:@>")
(defconstant +warn-format+ "~&~@< ! ~;~?~;~:@>")
(defconstant +error-format+ "~&~@< * ~;~?~;~:@>")
(defconstant +fatal-format+ "~&~@< ** ~;~?~;~:@>")
#+cmu-format
(progn
(defconstant +note-format+ "~&~@< ~;~?~;~:@>")
(defconstant +warn-format+ "~&~@< ! ~;~?~;~:@>")
(defconstant +error-format+ "~&~@< * ~;~?~;~:@>")
(defconstant +fatal-format+ "~&~@< ** ~;~?~;~:@>"))
#-cmu-format
(progn
(defconstant +note-format+ "~& ~?")
(defconstant +warn-format+ "~& ! ~?")
(defconstant +error-format+ "~& * ~?")
(defconstant +fatal-format+ "~& ** ~?"))
;; Return a namestring for a path that is sufficiently
;; unambiguous (hopefully) for the C compiler (and associates)
@ -112,7 +120,10 @@
(defun print-compiler-message (c stream)
(unless (typep c *suppress-compiler-messages*)
(format stream "~&~@<;;; ~@;~A~:>" c)))
#+cmu-format
(format stream "~&~@<;;; ~@;~A~:>" c)
#-cmu-format
(format stream "~&;;; ~A" c)))
;;; A few notes about the following handlers. We want the user to be
;;; able to capture, collect and perhaps abort on the different

2
src/h/config.h.in
View file

@ -155,6 +155,8 @@
#define FIXNUM_BITS @CL_FIXNUM_BITS@
#define MOST_POSITIVE_FIXNUM ((cl_fixnum)@CL_FIXNUM_MAX@)
#define MOST_NEGATIVE_FIXNUM ((cl_fixnum)@CL_FIXNUM_MIN@)
#define MOST_POSITIVE_FIXNUM_VAL @CL_FIXNUM_MAX@
#define MOST_NEGATIVE_FIXNUM_VAL @CL_FIXNUM_MIN@
typedef @CL_FIXNUM_TYPE@ cl_fixnum;
typedef unsigned @CL_FIXNUM_TYPE@ cl_index;