Custom Query (1030 matches)

? (lisp-implementation-version)
"Version 1.6-dev-r14231M  (LinuxX8632)"
? (defun diff (x)
  (- (locally
         (declare (type (integer 1000000000 2000000000) x))
       (lognor -10 x))
     (lognor -10 x)))
DIFF
? (diff 20)
-4294967296

I've discovered a problem with LOGIOR/LOGXOR/LOGAND on the ARM platform when I tried to run quicklisp under CCL on my Nokia N900. The following code based on minichipz from quicklisp causes the compiler to fail due to incorrect number of arguments passed to a vinsn:

(defstruct crc32
  (crc #xffffffff :type (unsigned-byte 32)))

(defun produce-crc32 (state)
  (logxor #xffffffff (crc32-crc state)))

I've managed to fix this problem, but then ran into another problem:

Nokia-N900:/home/user# ./armcl
Welcome to Clozure Common Lisp Version 1.6-dev  (LinuxARM32)!
? (defun zzz (x y)
  (declare (type (unsigned-byte 32) x))
  (declare (type (unsigned-byte 32) y))
  (logand x y))
ZZZ
? (zzz #xffffffff #xaa)
0
? (disassemble 'zzz)
;;; (defun zzz (x y) (declare (type (unsigned-byte 32) x)) (declare (type (unsigned-byte 32) y)) (logand
  (cmp nargs (:$ 8))
  (uuo-error-wrong-nargs (:? ne))
  (mov imm0 (:$ 19))
  (stmdb (:! sp) (imm0 vsp fn lr))
  (mov fn temp2)
  (stmdb (:! vsp) (arg_z arg_y))

;;; (logand x y)
  (tst arg_z (:$ #x80000003))
  (mov imm1 (:lsr arg_z (:$ 2)))
  (beq L104)
  (and imm0 arg_z (:$ 3))
  (cmp imm0 (:$ 2))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
  (ldr imm1 (:@ arg_z (:$ -6)))
  (movw imm0 (:$ #x107))
  (cmp imm1 imm0)
  (bne L80)
  (ldr imm1 (:@ arg_z (:$ -2)))
  (tst imm1 (:$ #x80000000))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
  (b L104)
L80
  (add imm0 imm0 (:$ #x100))
  (cmp imm1 imm0)
  (ldreq imm0 (:@ arg_z (:$ 2)))
  (cmpeq imm0 (:$ 0))
  (ldreq imm1 (:@ arg_z (:$ -2)))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
L104
  (mov arg_z arg_y)
  (tst arg_z (:$ #x80000003))
  (mov imm0 (:lsr arg_z (:$ 2)))
  (beq L188)
  (and imm1 arg_z (:$ 3))
  (cmp imm1 (:$ 2))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
  (ldr imm0 (:@ arg_z (:$ -6)))
  (movw imm1 (:$ #x107))
  (cmp imm0 imm1)
  (bne L164)
  (ldr imm0 (:@ arg_z (:$ -2)))
  (tst imm0 (:$ #x80000000))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
  (b L188)
L164
  (add imm1 imm1 (:$ #x100))
  (cmp imm0 imm1)
  (ldreq imm1 (:@ arg_z (:$ 2)))
  (cmpeq imm1 (:$ 0))
  (ldreq imm0 (:@ arg_z (:$ -2)))
  (uuo-error-reg-not-xtype (:? ne) arg_z (:$ 20))
L188
  (and imm0 imm0 imm1)
  (bla .SPmakeu32)
  (ldmia (:! sp) (imm0 vsp fn pc))

;;; #<no source text>
NIL

Here we see that the second argument is unboxed into imm1 which is reused as a temporary register when unboxing the first argument. The problem is due to the fact that when functions like ARM2-TWO-TARGETED-REG-FORMS see one of their arguments as 'const' (see e.g. aconst there) they assume that processing these arguments may not affect any registers besides directly specified. Vinsns like UNBOX-U32 though that can be generated even for such 'const' arguments may use temp registers for which 'target' registers are reused and thus become corrupted. As a workaround I've forced all *const vars in arm2-*-(un)targeted-reg-form(s) to be NIL which does solve the problem but may cause some slowdowns. Perhaps a better solution is necessary.

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]