174 lines
6.0 KiB
Diff
174 lines
6.0 KiB
Diff
ENSURE-DIRECTORIES-EXIST ignores the host and device from the original
|
|
pathname when creating the directories.
|
|
|
|
diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp
|
|
index 0f6eb45..9b37225 100644
|
|
--- a/src/lsp/mislib.lsp
|
|
+++ b/src/lsp/mislib.lsp
|
|
@@ -282,7 +282,7 @@ where CREATED is true only if we succeeded on creating all directories."
|
|
:defaults full-pathname)))
|
|
(dolist (item (pathname-directory full-pathname))
|
|
(setf d (nconc d (list item)))
|
|
- (let* ((p (make-pathname :directory d)))
|
|
+ (let* ((p (make-pathname :directory d :defaults *default-pathname-defaults*)))
|
|
(unless (or (symbolp item) (si::file-kind p nil))
|
|
(setf created t)
|
|
(let ((ps (namestring p)))
|
|
|
|
ffi:definline referenced a symbol from the C package without package prefix.
|
|
|
|
diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp
|
|
index a38288c..8b66a2e 100644
|
|
--- a/src/lsp/ffi.lsp
|
|
+++ b/src/lsp/ffi.lsp
|
|
@@ -681,7 +681,7 @@ the actual arguments are of the specified type."
|
|
;; defCbody must go first, because it clears symbol-plist of fun
|
|
(defCbody ,fun ,arg-types ,type ,code)
|
|
(declaim (ftype (function ,arg-types ,type) ,fun))
|
|
- (def-inline ,fun :always ,arg-types ,type ,code)))
|
|
+ (c::def-inline ,fun :always ,arg-types ,type ,code)))
|
|
|
|
(defmacro defla (&rest body)
|
|
"Syntax: (defla name lambda-list &body body)" "
|
|
|
|
Write SCALE-FLOAT so that it cannot lead to infinite loops.
|
|
|
|
diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp
|
|
index a44b810..d18054f 100644
|
|
--- a/src/lsp/format.lsp
|
|
+++ b/src/lsp/format.lsp
|
|
@@ -196,6 +196,20 @@
|
|
;; Note that we have to compute the exponential _every_ _time_ in the loop
|
|
;; because multiplying just by 10.0l0 every time would lead to a greater
|
|
;; loss of precission.
|
|
+ (let ((ex (round (* exponent #.(log 2l0 10)))))
|
|
+ (declare (fixnum ex))
|
|
+ (if (minusp ex)
|
|
+ (loop for y of-type long-float
|
|
+ = (* x (the long-float (expt 10.0l0 (- ex))))
|
|
+ while (<= y 0.1l0)
|
|
+ do (decf ex)
|
|
+ finally (return (values y (the fixnum (+ delta ex)))))
|
|
+ (loop for y of-type long-float
|
|
+ = (/ x (the long-float (expt 10.0l0 ex)))
|
|
+ while (> y 1.0l0)
|
|
+ do (incf ex)
|
|
+ finally (return (values y (the fixnum (+ delta ex)))))))
|
|
+ #+(or)
|
|
(loop with ex of-type fixnum
|
|
= (round (* exponent #.(log 2l0 10)))
|
|
for y of-type long-float
|
|
|
|
(CONCATENATE 'SIMPLE-BASE-STRING ...) returns an ordinary string.
|
|
|
|
diff --git a/src/lsp/seq.lsp b/src/lsp/seq.lsp
|
|
index ee24580..16ff41f 100644
|
|
--- a/src/lsp/seq.lsp
|
|
+++ b/src/lsp/seq.lsp
|
|
@@ -72,7 +72,7 @@
|
|
(setq elt-type 'BASE-CHAR
|
|
length (if (endp args) '* (first args))))
|
|
#+unicode
|
|
- ((BASE-STRING BASE-SIMPLE-STRING)
|
|
+ ((BASE-STRING SIMPLE-BASE-STRING)
|
|
(setq elt-type 'BASE-CHAR
|
|
length (if (endp args) '* (first args))))
|
|
#+unicode
|
|
|
|
Null terminate the base-strings created by make-array.
|
|
|
|
diff --git a/src/c/array.d b/src/c/array.d
|
|
index d844602..e6b8e76 100644
|
|
--- a/src/c/array.d
|
|
+++ b/src/c/array.d
|
|
@@ -552,6 +552,13 @@ ecl_array_allocself(cl_object x)
|
|
return;
|
|
}
|
|
#endif
|
|
+ case ecl_aet_bc: {
|
|
+ cl_index elt_size = 1;
|
|
+ x->vector.self.bc = (ecl_base_char *)ecl_alloc_atomic(d+1);
|
|
+ /* Null terminate the string */
|
|
+ x->vector.self.bc[d] = 0;
|
|
+ break;
|
|
+ }
|
|
case ecl_aet_bit:
|
|
d = (d + (CHAR_BIT-1)) / CHAR_BIT;
|
|
x->vector.self.bit = (byte *)ecl_alloc_atomic(d);
|
|
@@ -574,7 +581,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet)
|
|
case ecl_aet_bc:
|
|
x = ecl_alloc_compact_object(t_base_string, l+1);
|
|
x->base_string.self = ECL_COMPACT_OBJECT_EXTRA(x);
|
|
- memset(x->base_string.self, 0, l+1);
|
|
+ x->base_string.self[l] = 0;
|
|
break;
|
|
#ifdef ECL_UNICODE
|
|
case ecl_aet_ch:
|
|
|
|
In type propagators, the function name is rarely use: declare it ignorable.
|
|
|
|
diff --git a/src/cmp/cmptype-prop.lsp b/src/cmp/cmptype-prop.lsp
|
|
index f266ef0..0b6ae1d 100644
|
|
--- a/src/cmp/cmptype-prop.lsp
|
|
+++ b/src/cmp/cmptype-prop.lsp
|
|
@@ -71,7 +71,7 @@
|
|
(setf lambda-list (append lambda-list (list '&rest var))
|
|
body (list* `(declare (ignorable ,var)) body))))
|
|
`(setf (gethash ',fname *p0-dispatch-table*)
|
|
- #'(lambda ,lambda-list ,@body)))
|
|
+ #'(lambda ,lambda-list (declare (ignorable ,(first lambda-list))) ,@body)))
|
|
|
|
(defun copy-type-propagator (orig dest-list)
|
|
(loop with function = (gethash orig *p0-dispatch-table*)
|
|
|
|
Missing argument to LOGAND.
|
|
|
|
diff --git a/src/cmp/cmpopt-bits.lsp b/src/cmp/cmpopt-bits.lsp
|
|
index f097e19..0e27fbc 100644
|
|
--- a/src/cmp/cmpopt-bits.lsp
|
|
+++ b/src/cmp/cmpopt-bits.lsp
|
|
@@ -75,7 +75,7 @@
|
|
;;; TYPE PROPAGATION
|
|
;;;
|
|
|
|
-(def-type-propagator logand (&rest args)
|
|
+(def-type-propagator logand (fname &rest args)
|
|
(values args
|
|
(if args
|
|
(dolist (int-type '((UNSIGNED-BYTE 8) FIXNUM) 'integer)
|
|
|
|
Some statements from si::bc-disassemble were written to the wrong stream.
|
|
|
|
diff --git a/src/c/disassembler.d b/src/c/disassembler.d
|
|
index c45bc29..4680982 100644
|
|
--- a/src/c/disassembler.d
|
|
+++ b/src/c/disassembler.d
|
|
@@ -156,10 +156,10 @@ disassemble_tagbody(cl_object bytecodes, cl_opcode *vector) {
|
|
print_noarg("TAGBODY");
|
|
for (i=0; i<ntags; i++) {
|
|
GET_LABEL(destination, vector);
|
|
- ecl_princ_str("\n\tTAG\t", ECL_T);
|
|
- ecl_princ(ecl_make_fixnum(i), ECL_T);
|
|
- ecl_princ_str(" @@ ", ECL_T);
|
|
- ecl_princ(ecl_make_fixnum(destination - base), ECL_T);
|
|
+ ecl_princ_str("\n\tTAG\t", ECL_NIL);
|
|
+ ecl_princ(ecl_make_fixnum(i), ECL_NIL);
|
|
+ ecl_princ_str(" @@ ", ECL_NIL);
|
|
+ ecl_princ(ecl_make_fixnum(destination - base), ECL_NIL);
|
|
}
|
|
vector = disassemble(bytecodes, vector);
|
|
print_noarg("\t\t; tagbody");
|
|
@@ -189,9 +189,9 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
|
|
if (line_format != ECL_NIL) {
|
|
cl_format(3, ECL_T, line_format, line_no);
|
|
} else {
|
|
- ecl_princ_char('\n', ECL_T);
|
|
- ecl_princ(line_no, ECL_T);
|
|
- ecl_princ_char('\t', ECL_T);
|
|
+ ecl_princ_char('\n', ECL_NIL);
|
|
+ ecl_princ(line_no, ECL_NIL);
|
|
+ ecl_princ_char('\t', ECL_NIL);
|
|
}
|
|
switch (GET_OPCODE(vector)) {
|
|
|