Custom Query (1030 matches)

I've noticed the problem that some perfectly valid numbers like #x40000000 weren't recognized as (SIGNED-BYTE 64) / (UNSIGNED-BYTE 64) when working with cl-sqlite. I've distilled the problem down to ccl::%%set-signed-longlong / ccl::%%set-unsigned-longlong (see attached test) and further down to .SPgetu64 / .SPgets64 implementations in ARM lisp kernel. The problem was that 'one-digit' bignums weren't taken into account by these subprims. My patch seems to fix this, but I don't often write ARM assembly, so please take a look at it before applying.

The following code works fine in ccl-1.9:

(in-package :cl-user)

(defun abc ()
  (let* ((body
           '(let ((cache (load-time-value (cons (cons nil nil) nil))))
             (let ((fn #'(lambda () t)))
               (setf (car cache) (cons fn t))
               (values (funcall (caar cache))))))
         (thunk (compile nil `(lambda () ,body))))
    (disassemble thunk)
    (funcall thunk)))

(print (abc))

but fails with "Error of type CCL::INVALID-MEMORY-ACCESS: Fault during read of memory address #x0" error on (funcall (caar cache)) form in trunk and ccl-1.10.

The code was distilled from a piece of code utilizing LOAD-TIME-VALUE cache pattern as in ​http://random-state.net/log/3507100003.html (I used it in a compiler macro)

The problem can be currently worked around by commenting out (multiple-value-bind ...) form in (def-acode-rewrite acode-rewrite-cxr ...) in compiler/acode-rewrite.lisp: http://trac.clozure.com/ccl/browser/trunk/source/compiler/acode-rewrite.lisp?rev=16571#L567

Disassembly output before applying the workaround. Looks like the compiler treats (load-time-value (cons (cons nil nil) nil)) as a read-only constant value that cannot be changed:

    (recover-fn-from-rip)                   ;     [7]
    (testl (% nargs) (% nargs))             ;    [14]
    (jne L149)                              ;    [16]
    (pushq (% rbp))                         ;    [22]
    (movq (% rsp) (% rbp))                  ;    [23]
    (movq (@ '#<Anonymous Function #x302000B53A9F> (% fn)) (% arg_z)) ;    [26]
    (pushq (% arg_z))                       ;    [33]
    (movq (@ '((NIL)) (% fn)) (% arg_y))    ;    [34]
    (pushq (% arg_y))                       ;    [41]
    (movq (@ -8 (% rbp)) (% arg_y))         ;    [42]
    (movl ($ #x1302E) (% arg_z.l))          ;    [46]
    (subq ($ 13) (@ (% gs) #xD8))           ;    [51]
    (movq (@ (% gs) #xD8) (% temp0))        ;    [61]
    (cmpq (@ (% gs) #xE0) (% temp0))        ;    [70]
    (ja L76)                                ;    [79]
    (uuo-alloc)                             ;    [81]
L76
    (andb ($ #xF0) (@ (% gs) #xD8))         ;    [83]
    (movq (% arg_y) (@ 5 (% temp0)))        ;    [92]
    (movq (% arg_z) (@ -3 (% temp0)))       ;    [96]
    (movq (% temp0) (% arg_z))              ;   [100]
    (popq (% arg_y))                        ;   [103]
    (lisp-call  (@ .SPRPLACA))              ;   [109]
    (recover-fn-from-rip)                   ;   [116]
    (xorl (% nargs) (% nargs))              ;   [123]
    (movq (@ 'NIL (% fn)) (% temp0))        ;   [125]
    (lisp-call (@ 10 (% temp0)))            ;   [137]
    (recover-fn-from-rip)                   ;   [140]
    (leaveq)                                ;   [147]
    (retq)                                  ;   [148]
L149
    (uuo-error-wrong-number-of-args)

Disassembly output after applying the workaround:

    (recover-fn-from-rip)                   ;     [7]
    (testl (% nargs) (% nargs))             ;    [14]
    (jne L193)                              ;    [16]
    (pushq (% rbp))                         ;    [22]
    (movq (% rsp) (% rbp))                  ;    [23]
    (movq (@ '#<Anonymous Function #x302000B0A71F> (% fn)) (% arg_z)) ;    [26]
    (pushq (% arg_z))                       ;    [33]
    (movq (@ '((NIL)) (% fn)) (% arg_y))    ;    [34]
    (pushq (% arg_y))                       ;    [41]
    (movq (@ -8 (% rbp)) (% arg_y))         ;    [42]
    (movl ($ #x1302E) (% arg_z.l))          ;    [46]
    (subq ($ 13) (@ (% gs) #xD8))           ;    [51]
    (movq (@ (% gs) #xD8) (% temp0))        ;    [61]
    (cmpq (@ (% gs) #xE0) (% temp0))        ;    [70]
    (ja L76)                                ;    [79]
    (uuo-alloc)                             ;    [81]
L76 
    (andb ($ #xF0) (@ (% gs) #xD8))         ;    [83]
    (movq (% arg_y) (@ 5 (% temp0)))        ;    [92]
    (movq (% arg_z) (@ -3 (% temp0)))       ;    [96]
    (movq (% temp0) (% arg_z))              ;   [100]
    (popq (% arg_y))                        ;   [103]
    (lisp-call  (@ .SPRPLACA))              ;   [109]
    (recover-fn-from-rip)                   ;   [116]
    (movq (@ '((NIL)) (% fn)) (% arg_z))    ;   [123]
    (movq (@ 5 (% arg_z)) (% arg_z))        ;   [130]
    (movl (% arg_z.l) (% imm0.l))           ;   [134]
    (andl ($ 7) (% imm0.l))                 ;   [136]
    (cmpl ($ 3) (% imm0.l))                 ;   [139]
    (jne L201)                              ;   [142]
    (movq (@ 5 (% arg_z)) (% arg_z))        ;   [144]
    (pushq (% arg_z))                       ;   [148]
    (movq (@ -16 (% rbp)) (% temp0))        ;   [149]
    (xorl (% nargs) (% nargs))              ;   [153]
    (movl (% temp0.l) (% imm0.l))           ;   [155]
    (andl ($ 15) (% imm0.l))                ;   [157]
    (cmpl ($ 14) (% imm0.l))                ;   [160]
    (cmovgq (% temp0) (% temp1))            ;   [163]
    (jl L209)                               ;   [167]
    (cmoveq (@ 10 (% temp0)) (% temp1))     ;   [169]
    (lisp-call (% temp1))                   ;   [177]
    (recover-fn-from-rip)                   ;   [180]
    (addq ($ 8) (% rsp))                    ;   [187]
    (leaveq)                                ;   [191]
    (retq)                                  ;   [192]
L193
    (uuo-error-wrong-number-of-args)        ;   [200]
L201
    (uuo-error-reg-not-list (% arg_z))      ;   [208]
L209
    (uuo-error-not-callable)                ;   [216]

CCL trunk, test:

(in-package :cl-user)

(let ((a (make-array 16 :element-type '(unsigned-byte 8) :fill-pointer 11))
      (b (make-array 16 :element-type '(unsigned-byte 8) :fill-pointer 10)))
  (replace a b :start1 1 :end1 11 :start2 0)
  (princ a))

Produces an error:

The value 16 is not of the expected type ARRAY.
[Condition of type TYPE-ERROR]

Restarts:
0: [RETRY] Retry SLIME interactive evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT-BREAK] Reset this thread
3: [ABORT] Kill this thread

Backtrace:
0: (CCL::%ARRAY-IS-HEADER 16)
Locals:
ARRAY = 16
1: (DISPLACED-ARRAY-P #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D>)
Locals:
ARRAY = #<error printing (VECTOR UNUSED 10) #x302004A7459D>
DISP = #(0 0 0 0 0 0 ...)
TARGET = 16
2: (CCL::WRITE-AN-ARRAY #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> #<SWANK/GRAY::SLIME-OUTPUT-STREAM #x302000B6D05D> 1152921504606846975)
3: (#<CCL::STANDARD-KERNEL-METHOD PRINT-OBJECT (T T)> #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> #<SWANK/GRAY::SLIME-OUTPUT-STREAM #x302000B6D05D>)
4: (CCL::%CALL-NEXT-METHOD (NIL #<CCL::STANDARD-KERNEL-METHOD PRINT-OBJECT (T T)> . 17592094079249))
5: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<CCL::STANDARD-KERNEL-METHOD PRINT-OBJECT :AROUND (T T)> #<CCL::STANDARD-KERNEL-METHOD PRINT-OBJECT (T T)>) 17592094079249)
6: (NIL #<Unknown Arguments>)
7: (CCL::WRITE-A-FROB #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> #<SWANK/GRAY::SLIME-OUTPUT-STREAM #x302000B6D05D> 1152921504606846975 NIL)
8: (CCL::WRITE-INTERNAL #<SWANK/GRAY::SLIME-OUTPUT-STREAM #x302000B6D05D> #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> 1152921504606846975 NIL)
9: (CCL::WRITE-1 #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> #<SWANK/GRAY::SLIME-OUTPUT-STREAM #x302000B6D05D> 1152921504606846975)
10: (PRINC #<error printing (VECTOR CCL::UNUSED 10) #x302004A7459D> NIL)
11: (CCL::CHEAP-EVAL (LET ((A (MAKE-ARRAY 16 :ELEMENT-TYPE '# :FILL-POINTER ...)) (B (MAKE-ARRAY 16 :ELEMENT-TYPE '# :FILL-POINTER ...))) (REPLACE A B :START1 1 :END1 ...) (PRINC A)))
12: ((:INTERNAL SWANK:INTERACTIVE-EVAL))

The culprit is %UVECTOR-REPLACE used in REPLACE function. It uses %SVREF which breaks on non-simple vectors.

Suggested patch is attached.