Custom Query (1030 matches)

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]

After doing (rebuild-ccl :full t) on an OS X 10.11 system, (require 'cocoa) will fail by crashing into the lisp kernel debugger. A slightly simpler test case is (require 'objc-support), but that doesn't fully exercise things.

As I mentioned earlier today, I believe that this is (at least in part) because Objective-C isa pointers are not necessarily pointers any more.

Starting the lisp with the environment variable OBJC_DISABLE_NONPOINTER_ISA set to YES will enable the (require 'cocoa) to succeed.

$ env OBJC_DISABLE_NONPOINTER_ISA=YES ccl

(I found this out on ​http://www.sealiesoftware.com/blog/archive/2013/09/24/objc_explain_Non-pointer_isa.html)

Using Clozure Common Lisp-Version 1.11-RC1-r16620 (DarwinX8664) to define functions within function groups, the functions defined must have unique names that can be traced back to the group in which they were defined. In the code snippet below the macro defop-environment sets up a name as a special variable that is used in defop, partly to get the intended name, partly to ensure defop was used within a defop-environment. The code below is as short as I could make it. It works in Clisp and ABCL but does not work in CCL (or SBCL for that matter).

(unless (find-package :wondering)
  (defpackage wondering
    (:use :cl)))

(in-package :wondering)

(defvar *environments*
  (make-hash-table :test 'eq))

(let ((defop-prefix "OP-FN%"))

  (defmacro defop-environment (name &rest defops)
    "(defop-environment <name> &rest <defops>)
 Define a new operator environment with name <name> and operators
 defined by <defops>."
    (let ((new-table (make-hash-table :test 'eq)))
      `(let ((*name-prefix* ,(concatenate 'string defop-prefix (string name) "%"))
	     (*operator-table* ,new-table))
	 (declare (special *environments* *operator-table* *name-prefix*))
	 (format *trace-output* "Before defop *name-prefix* ~S~%" *name-prefix*)
	 ,@defops
	 (setf (gethash ',name *environments*) *operator-table*)
	 ',name)))

  (defmacro defop (name lambda-list &body body)
    "Define an operator.  Error unless used within a
 defop-environment."
    (declare (special *name-prefix*))
    (format *trace-output* "(defwalk ~A ~A~%  ~{~S~})~%"name lambda-list body)
    (unless (and (boundp '*name-prefix*) (stringp *name-prefix*))
      (error "Only use defop inside a defop-environmemt."))
    (let ((fname (values (intern
			  (concatenate 'string *name-prefix*
				       (string (if (symbolp name) name (car name))))
			  *package*))))
      (format *trace-output* "In defop *name-prefix* ~S, fname: ~S~%"
	      *name-prefix* fname)
      `(locally
	   (declare (special *operator-table*))
	 (defun ,fname ,lambda-list ,@body)
	 (setf (gethash ',name *operator-table*) ',fname)
	 ',name))))

Evaluating (defop-environment env0 (defop fn0 (x y) (fn x y))) directly makes CCL unhappy:

Only use defop inside a defop-environmemt.

[Condition of type SIMPLE-ERROR]

Could you please look into this? A workaround is also very welcome.

Thank you very much,

Ernst van Waning