Custom Query (1030 matches)

This problem is low priority, but since it may occur in more pressing situations, you may be interested in having a look at it.

- /Users is a local home dir on MacOSX system (where ~/.cache/common-lisp is located).
- /home is a NFS mount from a Linux workstation (where project sources are located).
- ccl is running on MacOSX system (AppStore version).
- swank server is created in ccl on MacOSX.
- slime is used on Linux workstation to connect to ccl on MacOSX.
- project in /home is loaded via quicklisp.
- an error occurs while compiling a file.
- slime debugger is entered.
- file is edited on linux workstation.
- 1: [retry-compile-file] restart is selected in sldb.

and this produces:

Stale NFS file handle : "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp"
   [Condition of type ccl::simple-file-error]

Restarts:
 0: [retry-open] Retry opening "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp"
 1: [retry-compile-file] Retry compiling "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp"
 2: [skip-compile-file] Skip compiling "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp"
 3: [retry-load] Retry loading #P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl"
 4: [skip-load] Skip loading #P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl"
 5: [load-other] Load other file instead of #P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl"
 --more--

Backtrace:
  0: (ccl::make-file-stream "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" :input base-char :ignored :error file-stream :default :private t)
  1: (open "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" :direction :input :element-type base-char :if-exists :error :if-does-not-exist :error :external-format :default :class file-stream :sharing :private :basic t)
  2: (ccl::fcomp-read-loop "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" 0 #<ccl::lexical-environment #x302002AB5A3D> :not-compile-time)
  3: (ccl::fcomp-file "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" 0 #<ccl::lexical-environment #x302002AB5A3D>)
  4: (ccl::%compile-file "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" "/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl" nil nil t t nil t :defer nil #<backend darwinx8664 #x3020001C427D> :default nil 0)
  5: (compile-file "/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.lisp" :output-file "/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl" :verbose nil :print nil :load nil :features nil :target :darwinx8664 :save-local-symbols t :save-doc-strings t :save-definitions nil :save-source-locations t :external-format :default :force nil :compile-file-original-truename nil :compile-file-original-buffer-offset 0 :break-on-program-errors :defer)
  6: (ccl::%load #P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl" nil nil :error :default)
  7: (load #P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl" :verbose nil :print nil :if-does-not-exist :error :external-format :default)
  8: (map nil #<Compiled-function load #x300000128B4F> (#P"/Users/pjb/.cache/common-lisp/ccl-1.8-f95-macosx-x64/home/pjb/works/patchwork/patchwork/src/pw-kernel/pw-graphics/window+menu/pw-menu.dx64fsl"))
  9: (ccl::%%before-and-after-combined-method-dcode (nil #<standard-method asdf:perform (asdf:load-op asdf:cl-source-file)> . 20824481))
 10: (ccl::%%standard-combined-method-dcode (nil (#<standard-method asdf:perform :after (asdf:operation asdf:component)>) #<standard-method asdf:perform (asdf:load-op asdf:cl-source-file)>) 20824481)
 11: (nil #<Unknown Arguments>)
 12: (ccl::%call-next-method (nil #<standard-method asdf::perform-with-restarts (t t)> . 20824550))
 13: (#<standard-method asdf::perform-with-restarts (asdf:load-op asdf:cl-source-file)> #<load-op (:verbose nil) #x3020028E2BFD> #<cl-source-file "patchwork" "pw-kernel/pw-graphics/window+menu/pw-menu">)
 14: (ccl::%call-next-method (nil #<standard-method asdf::perform-with-restarts (t t)> . 20824550))
 15: (#<standard-method asdf::perform-with-restarts :around (t t)> #<load-op (:verbose nil) #x3020028E2BFD> #<cl-source-file "patchwork" "pw-kernel/pw-graphics/window+menu/pw-menu">)
 16: (ccl::%%standard-combined-method-dcode (#<standard-method asdf::perform-with-restarts :around (t t)> #<standard-method asdf::perform-with-restarts (asdf:load-op asdf:cl-source-file)> #<standard-method asdf::perform-with-restarts (t t)>) 20824550)
 17: (nil #<Unknown Arguments>)
 18: ((:internal ccl::with-compilation-unit-body (asdf::perform-plan (list))))
 19: (ccl::call-with-compilation-unit #<ccl:compiled-lexical-closure (:internal ccl::with-compilation-unit-body (asdf::perform-plan (list))) #xA003BFF> :override nil)
 20: (#<standard-method asdf::perform-plan (list)> ((#1=#<load-op (:verbose nil) #x3020028E05DD> . #<cl-source-file #2="patchwork" "pw-kernel/environment/lelisp-macros">) (#1# . #<cl-source-file #2# "patchwork-package">) (#6=#<compile-op (:verbose nil) #x3020028D891D> . #3=#<cl-source-file #2# "pw-kernel/pw-graphics/window+menu/pw-menu">) (#<load-op (:verbose nil) #x3020028E2BFD> . #3#) (#4=#<load-op (:verbose nil) #x3020028E1F6D> . #<cl-source-file #2# "pw-kernel/environment/clpf-utils">) (#4# . #<cl-source-file #2# "pw-macosx/reader-macros">) (#4# . #<cl-source-file #2# "pw-kernel/pw-graphics/controls/pw-graphics">) (#5=#<load-op (:verbose nil) #x3020028E127D> . #<cl-source-file #2# "pw-kernel/pw-graphics/controls/pw-controls">) (#5# . #<cl-source-file #2# "pw-kernel/types/pw-type-scheme">) (#5# . #<cl-source-file #2# "pw-kernel/box-creation/resize+extend-patch">) (#5# . #<cl-source-file #2# "pw-kernel/types/pw-types">) (#5# . #<cl-source-file #2# "pw-kernel/environment/pw-symbolic-types"..
 21: (ccl::%%check-keywords #(1 #() #<ccl:method-function asdf::perform-plan (list)>) 20824593)
 22: (nil #<Unknown Arguments>)
 23: ((:internal (asdf:operate (t t))))
 24: (asdf::call-with-system-definitions #<ccl:compiled-lexical-closure (:internal (asdf:operate (t t))) #x3020028D924F>)
 25: (#<standard-method asdf:operate (t t)> asdf:load-op "patchwork" :verbose nil)
 26: (ccl::%%standard-combined-method-dcode ((#<standard-method asdf:operate :before (t t)>) nil #<standard-method asdf:operate (t t)>) 20824644)
 27: (nil #<Unknown Arguments>)
 28: ((:internal quicklisp-client::apply-load-strategy))
 29: (quicklisp-client::call-with-macroexpand-progress #<ccl:compiled-lexical-closure (:internal quicklisp-client::apply-load-strategy) #x3020028D935F>)
 30: (quicklisp-client::apply-load-strategy #<load-strategy "patchwork" (1 asdf, 0 quicklisp)>)
 31: (quicklisp-client::autoload-system-and-dependencies "patchwork" :prompt nil)
 32: ((:internal quicklisp-client::ql (quicklisp-client:quickload (t))))
 33: (#<standard-method ql-impl-util::%call-with-quiet-compilation (t t)> #<ql-impl:ccl #x302000E64D6D> #<ccl:compiled-lexical-closure (:internal quicklisp-client::ql (quicklisp-client:quickload (t))) #x30200288C92F>)
 34: (ql-impl-util:call-with-quiet-compilation #<ccl:compiled-lexical-closure (:internal quicklisp-client::ql (quicklisp-client:quickload (t))) #x30200288C92F>)
 35: (#<standard-method quicklisp-client:quickload (t)> (:patchwork) :prompt nil :verbose nil)
 36: (ccl::%call-next-method ((nil) #<standard-method quicklisp-client:quickload (t)> :patchwork))
 37: ((:internal (quicklisp-client:quickload :around (t))))
 38: (ql-dist::call-with-consistent-dists #<ccl:compiled-lexical-closure (:internal (quicklisp-client:quickload :around (t))) #x3020028711BF>)
 39: (#<standard-method quicklisp-client:quickload :around (t)> :patchwork :verbose nil :prompt nil :explain nil)
 40: (ccl::%%standard-combined-method-dcode (#<standard-method quicklisp-client:quickload :around (t)> #<standard-method quicklisp-client:quickload (t)>) 20824781)
 41: (nil #<Unknown Arguments>)
 42: (ccl::call-check-regs quicklisp-client:quickload :patchwork)
 43: (ccl::cheap-eval (quicklisp-client:quickload :patchwork))
 44: (swank::eval-region "(ql:quickload :patchwork)
     ")
 45: ((:internal swank::repl-eval))
 46: (swank::track-package #<ccl:compiled-lexical-closure (:internal swank::repl-eval) #x3020028714BF>)
 47: ((:internal swank::repl-eval))
 48: (swank::call-with-retry-restart "Retry SLIME REPL evaluation request." #<ccl:compiled-lexical-closure (:internal swank::repl-eval) #x30200287159F>)
 49: ((:internal swank::repl-eval))
 50: (#<Anonymous Function #x302001F3CB8F> #<ccl:compiled-lexical-closure (:internal swank::repl-eval) #x3020028715DF>)
 51: (swank-backend:call-with-syntax-hooks #<ccl:compiled-lexical-closure (:internal swank::repl-eval) #x3020028715DF>)
 52: (swank::call-with-buffer-syntax nil #<ccl:compiled-lexical-closure (:internal swank::repl-eval) #x3020028715DF>)
 53: (swank::repl-eval "(ql:quickload :patchwork)
     ")
 54: (swank:listener-eval "(ql:quickload :patchwork)
     ")
 55: (ccl::call-check-regs swank:listener-eval "(ql:quickload :patchwork)
     ")
 56: (ccl::cheap-eval (swank:listener-eval "(ql:quickload :patchwork)
     "))
 57: (swank:eval-for-emacs (swank:listener-eval "(ql:quickload :patchwork)
     ") "MCLGUI" 11)
 58: (swank::process-requests nil)
 59: ((:internal swank::handle-requests))
 60: ((:internal swank::handle-requests))
 61: (swank-backend:call-with-debugger-hook #<Compiled-function swank:swank-debugger-hook #x30200210B44F> #<ccl:compiled-lexical-closure (:internal swank::handle-requests) #x30200231367F>)
 62: (swank-backend:call-with-debugger-hook #<Compiled-function swank:swank-debugger-hook #x30200210B44F> #<ccl:compiled-lexical-closure (:internal swank::handle-requests) #x30200231367F>)
 63: ((:internal swank::handle-requests))
 64: (swank::call-with-bindings ((*standard-output* . #1=#<swank-backend::slime-output-stream #x302002311ACD>) (*standard-input* . #2=#<swank-backend::slime-input-stream #x302002311E3D>) (*trace-output* . #1#) (*error-output* . #1#) (*debug-io* . #3=#<two-way-stream input #2#, output #1# #x3020023099CD>) (*query-io* . #3#) (*terminal-io* . #3#)) #<ccl:compiled-lexical-closure (:internal swank::handle-requests) #x3020023135EF>)
 65: (swank::handle-requests #<multithreaded-connection  #x3020021AFE5D> nil)
 66: (swank::repl-loop #<multithreaded-connection  #x3020021AFE5D>)
 67: ((:internal swank::spawn-repl-thread))
 68: (swank::call-with-bindings ((*print-pretty*) (*print-level*) (*print-length*) (*print-circle* . t) (*print-case* . :downcase) (*print-readably*) (*print-gensym* . t) (*print-base* . 10) (*print-radix*) (*print-array* . t) (*print-lines*) (*print-escape* . t) (*print-right-margin* . 1000) (*random-state* . #.(ccl::initialize-mrg31k3p-state 1671441915 243261705 587616156 1996668199 2126887465 12325974)) (swank::*sldb-bitvector-length*) (swank::*sldb-string-length*)) #<ccl:compiled-lexical-closure (:internal swank::spawn-repl-thread) #x3020023139CF>)
 69: ((:internal swank::spawn-repl-thread))
 70: (ccl::run-process-initial-form #<process repl-thread(18) [Active] #x302002312ACD> (#<ccl:compiled-lexical-closure (:internal ccl::%process-run-function) #x30200231285F>))
 71: ((:internal (ccl::%process-preset-internal (ccl:process))) #<process repl-thread(18) [Active] #x302002312ACD> (#<ccl:compiled-lexical-closure (:internal ccl::%process-run-function) #x30200231285F>))
 72: ((:internal ccl::thread-make-startup-function))

Problem: CCL should print symbols with escaping (single escape slash or multiple escape pipe) when *print-escape* is T in if it needs to do so to ensure that symbol names can be read back in again and result in the same symbol. Currently it does not do this for readtable-case :preserve or :invert.

Solution: Fix level-1/l1-io.lisp so that in print-escape mode in, for all readtable-case modes, escaping is carried out for symbol name characters which might not be read back in correctly otherwise. This includes the "invalid", "asterisked", and "package marker" characters on section 2.1.4.2 Constituent Traits.

The following lisp forms point out the problem:

(readtable-case *readtable*)
(setf a (read-from-string "|HiThere|"))
(setf b (read-from-string "|:|"))
(eq a (read-from-string (prin1-to-string a)))
(eq b (read-from-string (prin1-to-string b)))
(setf (readtable-case *readtable*) :preserve)
(EQ A (READ-FROM-STRING (PRIN1-TO-STRING A)))
(EQ B (READ-FROM-STRING (PRIN1-TO-STRING B)))

First we read in some symbols using the multiple escape delimiter |. We confirm that they can can be printed in an print-escape environment (prin1) and read back in, and are eq. In this case, we should get back the same symbol, thus the eq test.

If we try this on the current 1.9 trunk (version shown below), we receive an error on the final line, as shown below:

[epearson@archie ccl]$ ccl64
Welcome to Clozure Common Lisp Version 1.9-dev-r15376M-trunk  (LinuxX8664)!
? (readtable-case *readtable*)
:UPCASE
? (setf a (read-from-string "|HiThere|"))
|HiThere|
? (setf b (read-from-string "|:|"))
\:
? (read-from-string (prin1-to-string a))
|HiThere|
9
? (read-from-string (prin1-to-string b))
\:
2
? (setf (readtable-case *readtable*) :preserve)
:PRESERVE
? (READ-FROM-STRING (PRIN1-TO-STRING A))
HiThere
7
? (READ-FROM-STRING (PRIN1-TO-STRING B))
> Error: Unexpected end of file on #<STRING-INPUT-STREAM  #x3020006EFDDD>, near position 1, within ":"
> While executing: CCL::READ-CHAR-INTERNAL, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
1 >

If we look at the printed form of B, we can see why:

? (PRIN1-TO-STRING B)
":"

The single colon is printed. The lisp reader will not like a single colon -- it is not a valid form. PRIN1-TO-STRING should rather print "
:" or "|:|". Indeed after fixing the problem (more below), the value printed is:

? (PRIN1-TO-STRING B)
"\\:"

The flaw that is exposed is that the prin1 function is not satisfying the condition that in escape mode it must print symbols so that they can be read back in the same readtable and become the same symbol. Although it is safe for certain symbols (such as alphabetical) to be printed without escaping in :preserve readtable-case (because lower and upper case will be kept even without escaping), it is not so for special characters like colon. Such characters must always be escaped, because otherwise mayhem ensues.

Although such symbols are not very common, they are valid. One less contrived example is a symbol with spaces:

? (setf x (read-from-string "|Hi there erik|"))
|Hi there erik|
? (prin1-to-string x)
"|Hi there erik|"
? (setf (readtable-case *readtable*) :preserve)
:PRESERVE
? (PRIN1-TO-STRING X)
"Hi there erik"
? (READ-FROM-STRING (PRIN1-TO-STRING X))
Hi
3
? 

The problem exists in level-l/l1-io.lisp in function write-pname. First, at line 1060 there is a form meant to count the number of "slashes" (single escape character) in the symbol name and possibly switch to using the multiple escape character (well, the spec says you can do it!). This chunk of code specifically excludes handling the case of a readtable-case of :invert or :preserve. Although there is a comment noting that "these nevery slashify alpha-p", the test excludes all cases of symbol name characters not just alphabetical.

The fix is to ensure that the if the readtable-case is :invert or :preserve, the "slashify" is excluded for alphabetical characters, but applied otherwise. This can be accomplished by passing the readcase variable to slashify?, and handling the readtable-case condition there. This is possible because the slashify? function already contains a test both for whether a character is alphabetic and whether it is one of the "safe" non-alphabetic characters (i.e. not normally syntatically relevant).

FWIW this came up in the context of trying to get Shen working in CCL. There were a few minor problems with undeclared globals, but the big issue was figuring this out. Shen has at least one point where there is a comparison to the colon as a symbol. The shen compiler (goes from shen kl -> fixed kl -> common lisp -> compiled cl) attempts to make the colon character safe by wrapping it in pipes, |:|, when it creates the fixed kl file. Shen puts the reader into :preserve case. The Shen kl code is not common lisp but it is s-expressions so shen uses the lisp reader to read in the fixed kl file (that is why it is fixed first, to make it safe for the reader), processes the kl to translate to common lisp, and then writes out common lisp.

NSWindow and a number of other Objective-C classes are mapped to symbols in the NS package in ccl::*lisp-classname-table*:

cl-user> (apropos "NS-WINDOW")
ns:+ns-window,  Value: #<objc:objc-metaclass ns:+ns-window (#x1D7D7A8)>
 ns:ns-window,  Value: #<objc:objc-class ns:ns-window (#x1D7D7D0)>
ns:+ns-window-controller,  Value: #<objc:objc-metaclass ns:+ns-window-controller (#x1D7D988)>
 ns:ns-window-controller,  Value: #<objc:objc-class ns:ns-window-controller (#x1D7D9B0)>
; No value
cl-user> (gethash "NSWindow" ccl::*lisp-classname-table*)
ns:ns-window
t

but not NSColorPanel:

cl-user> (apropos "NS-COLOR-PANEL")
 ns:ns-color-panel,  Value: #<objc:objc-class ns:ns-color-panel (#x1D73280)>
ns:+ns-color-panel,  Value: #<objc:objc-metaclass ns:+ns-color-panel (#x1D73258)>
; No value
cl-user> (gethash "NSColorPanel" ccl::*lisp-classname-table*)
"NS-COLOR-PANEL"
t

even after instantiating a NSColorPanel:

cl-user> (#/sharedColorPanel ns:ns-color-panel)
#<ns-color-panel <NSColorPanel: 0x31ae720> (#x31AE720)>
cl-user> (gethash "NSColorPanel" ccl::*lisp-classname-table*)
"NS-COLOR-PANEL"
t