[Openmcl-cvs-notifications] r11928 - in /release/1.3/source: cocoa-ide/ cocoa-ide/hemlock/src/ cocoa-ide/ide-contents/Resources/English.lproj/preferences.nib/ compiler/ doc/src/ level-0/ level-1/ lisp-kernel/ lisp-kernel/darwinx8632/ lisp-kernel/darwinx8664/
rme at clozure.com
rme at clozure.com
Thu Apr 9 19:04:16 EDT 2009
Author: rme
Date: Thu Apr 9 19:04:15 2009
New Revision: 11928
Log:
Merge trunk changes r11900 through r11919.
Modified:
release/1.3/source/cocoa-ide/cocoa-editor.lisp
release/1.3/source/cocoa-ide/file-dialogs.lisp
release/1.3/source/cocoa-ide/hemlock/src/views.lisp
release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj/prefe=
rences.nib/info.nib
release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj/prefe=
rences.nib/keyedobjects.nib
release/1.3/source/compiler/nx-basic.lisp
release/1.3/source/compiler/nx0.lisp
release/1.3/source/doc/src/ffi.xml
release/1.3/source/level-0/l0-cfm-support.lisp
release/1.3/source/level-1/l1-files.lisp
release/1.3/source/level-1/l1-readloop.lisp
release/1.3/source/lisp-kernel/darwinx8632/Makefile
release/1.3/source/lisp-kernel/darwinx8664/Makefile
release/1.3/source/lisp-kernel/memprotect.h
release/1.3/source/lisp-kernel/x86-asmutils32.s
release/1.3/source/lisp-kernel/x86-asmutils64.s
release/1.3/source/lisp-kernel/x86-spentry64.s
Modified: release/1.3/source/cocoa-ide/cocoa-editor.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/cocoa-ide/cocoa-editor.lisp (original)
+++ release/1.3/source/cocoa-ide/cocoa-editor.lisp Thu Apr 9 19:04:15 2009
@@ -26,6 +26,7 @@
=
(def-cocoa-default *use-screen-fonts* :bool t "Use bitmap screen fonts whe=
n available")
=
+(def-cocoa-default *option-is-meta* :bool t "Use option key as meta?")
=
(defgeneric hemlock-view (ns-object))
=
@@ -781,9 +782,13 @@
(lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring stri=
ng)))
(view (front-view-for-buffer buffer)))
(when view
- (hi::handle-hemlock-event view #'(lambda ()
- (hi:paste-characters position length
- lisp-string))))))
+ (let* ((edit-count (slot-value self 'edit-count)))
+ (dotimes (i edit-count) (#/endEditing self))
+ (hi::handle-hemlock-event view #'(lambda ()
+ (hi:paste-characters position l=
ength
+ lisp-strin=
g)))
+ (dotimes (i edit-count)
+ (#/beginEditing self))))))
=
(objc:defmethod (#/setAttributes:range: :void) ((self hemlock-text-storage)
attributes
@@ -898,16 +903,20 @@
#+debug (#_NSLog #@"Key down event =3D %@" :address event)
(let* ((view (hemlock-view self))
;; quote-p means handle characters natively
- (quote-p (and view (hi::hemlock-view-quote-next-p view))))
+ (quote-p (and view (hi::hemlock-view-quote-next-p view)))
+ (flags (#/modifierFlags event)))
#+debug (log-debug "~"e-p ~s event ~s" quote-p event)
- (if (or (null view)
- (#/hasMarkedText self)
- (and quote-p (zerop (#/length (#/characters event))))) ;; dead key, e=
.g. option-E
- (call-next-method event)
- (unless (eventqueue-abort-pending-p self)
- (let ((hemlock-key (nsevent-to-key-event event quote-p)))
- (when hemlock-key
- (hi::handle-hemlock-event view hemlock-key)))))))
+ (cond ((and (not *option-is-meta*)
+ (logtest #$NSAlternateKeyMask flags))
+ (call-next-method event))
+ ((or (null view)
+ (#/hasMarkedText self)
+ (and quote-p (zerop (#/length (#/characters event)))))
+ (call-next-method event))
+ ((not (eventqueue-abort-pending-p self))
+ (let ((hemlock-key (nsevent-to-key-event event quote-p)))
+ (when hemlock-key
+ (hi::handle-hemlock-event view hemlock-key)))))))
=
(defmethod hi::handle-hemlock-event :around ((view hi:hemlock-view) event)
(declare (ignore event))
@@ -2952,9 +2961,9 @@
;; of #/replaceCharactersInRange:withString: calls code that
;; asserts that editing isn't in progress. Once that's
;; fixed, this should be fixed as well.
- #+not-broken (#/beginEditing textstorage)
+ (#/beginEditing textstorage)
(#/replaceCharactersInRange:withString: textstorage selectedrange strin=
g)
- #+not-broken (#/endEditing self))))))
+ (#/endEditing textstorage))))))
=
=
(objc:defmethod (#/hyperSpecLookUp: :void)
Modified: release/1.3/source/cocoa-ide/file-dialogs.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/cocoa-ide/file-dialogs.lisp (original)
+++ release/1.3/source/cocoa-ide/file-dialogs.lisp Thu Apr 9 19:04:15 2009
@@ -9,9 +9,9 @@
;; Maybe support multiple file selection later.
(#/setAllowsMultipleSelection: open-panel #$NO)
(when directory
- (setq directory (#/autorelease (%make-nsstring (namestring directory=
)))))
+ (setq directory (#/autorelease (%make-nsstring directory))))
(when file
- (setq file (#/autorelease (%make-nsstring (namestring file)))))
+ (setq file (#/autorelease (%make-nsstring file))))
(when file-types
(setq types-array (make-instance 'ns:ns-mutable-array))
(dolist (type file-types)
@@ -31,14 +31,15 @@
(error "couldn't run the open panel: error code ~d" result))))))
=
(defun cocoa-choose-file-dialog (&key directory file-types file button-str=
ing)
- (when (and directory (not (directoryp directory)))
- (error "~s doesn't designate a directory." directory))
+ (when directory
+ (setq directory (directory-namestring directory)))
(when file-types
(unless (and (listp file-types)
(every #'stringp file-types))
(error "~s is not a list of strings." file-types)))
- (when (and file (not (probe-file file)))
- (error "~s doesn't designate a file." file))
+ (when file
+ (setq file (file-namestring file)))
+ (check-type button-string (or null string))
(execute-in-gui #'(lambda () (%cocoa-choose-file-dialog directory file-t=
ypes file button-string))))
=
(defun %cocoa-choose-new-file-dialog (directory file-types file)
@@ -47,9 +48,9 @@
(types-array +null-ptr+))
(#/setCanSelectHiddenExtension: save-panel t)
(when directory
- (setq directory (#/autorelease (%make-nsstring (namestring directory=
)))))
+ (setq directory (#/autorelease (%make-nsstring directory))))
(when file
- (setq file (#/autorelease (%make-nsstring (namestring file)))))
+ (setq file (#/autorelease (%make-nsstring file))))
(when file-types
(setq types-array (make-instance 'ns:ns-mutable-array))
(dolist (type file-types)
@@ -67,14 +68,14 @@
(error "couldn't run the save panel: error code ~d" result))))))
=
(defun cocoa-choose-new-file-dialog (&key directory file-types file)
- (when (and directory (not (directoryp directory)))
- (error "~s doesn't designate a directory." directory))
+ (when directory
+ (setq directory (directory-namestring directory)))
+ (when file
+ (setq file (file-namestring file)))
(when file-types
(unless (and (listp file-types)
(every #'stringp file-types))
(error "~s is not a list of strings." file-types)))
- (when (and file (not (probe-file file)))
- (error "~s doesn't designate a file." file))
(execute-in-gui #'(lambda () (%cocoa-choose-new-file-dialog directory fi=
le-types file))))
=
(defun cocoa-choose-file-dialog-hook-function (must-exist prompt file-type=
s)
@@ -94,7 +95,7 @@
(#/setTitle: open-panel #@"Choose Directory")
(#/setPrompt: open-panel #@"Choose")
(when directory
- (setq directory (#/autorelease (%make-nsstring (namestring directory=
)))))
+ (setq directory (#/autorelease (%make-nsstring directory))))
(let ((result (#/runModalForDirectory:file:types: open-panel directory
nil nil)))
(cond ((=3D result #$NSOKButton)
@@ -106,6 +107,6 @@
(error "couldn't run the open panel: error code ~d" result))))))
=
(defun cocoa-choose-directory-dialog (&key directory)
- (when (and directory (not (directoryp directory)))
- (error "~s doesn't designate a directory." directory))
+ (when directory
+ (setq directory (directory-namestring directory)))
(execute-in-gui #'(lambda () (%cocoa-choose-directory-dialog directory))=
))
Modified: release/1.3/source/cocoa-ide/hemlock/src/views.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/cocoa-ide/hemlock/src/views.lisp (original)
+++ release/1.3/source/cocoa-ide/hemlock/src/views.lisp Thu Apr 9 19:04:15=
2009
@@ -189,6 +189,15 @@
(get-command-binding-for-key view key)
#+debug (log-debug "~& binding ~s ~s" main-binding transparent-bin=
dings)
(ring-push key *key-event-history*)
+ ;; If the key represents an "alphabetic" character (of which there
+ ;; are about 94000), and the event has no modifiers or only a shift
+ ;; modifier, treat it if it were bound to "Self Insert".
+ (when (eq main-binding (get-default-command))
+ (let ((modifiers (key-event-bits-modifiers (key-event-bits key))))
+ (when (and (alpha-char-p (key-event-char key))
+ (or (null modifiers)
+ (equal '("Shift") modifiers)))
+ (setq main-binding (get-self-insert-command)))))
(when main-binding
(let* ((*last-last-command-type* (shiftf (hemlock-last-command-ty=
pe view) nil))
(*last-prefix-argument* (hemlock::prefix-argument-resettin=
g-state)))
Modified: release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj=
/preferences.nib/info.nib
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj/prefe=
rences.nib/info.nib (original)
+++ release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj/prefe=
rences.nib/info.nib Thu Apr 9 19:04:15 2009
@@ -7,13 +7,9 @@
<key>IBOldestOS</key>
<integer>4</integer>
<key>IBOpenObjects</key>
- <array>
- <integer>1500903</integer>
- <integer>1500915</integer>
- <integer>1500856</integer>
- </array>
+ <array/>
<key>IBSystem Version</key>
- <string>9F33</string>
+ <string>9G55</string>
<key>targetFramework</key>
<string>IBCocoaFramework</string>
</dict>
Modified: release/1.3/source/cocoa-ide/ide-contents/Resources/English.lproj=
/preferences.nib/keyedobjects.nib
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
Binary files - no diff available.
Modified: release/1.3/source/compiler/nx-basic.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/compiler/nx-basic.lisp (original)
+++ release/1.3/source/compiler/nx-basic.lisp Thu Apr 9 19:04:15 2009
@@ -54,12 +54,6 @@
(assert *nx-acode-note-map*)
(setf (gethash acode *nx-acode-note-map*) note)))
=
-
-(defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
- (when source-notes
- (when (or (consp form) (vectorp form) (pathnamep form))
- (let ((note (gethash form source-notes)))
- (unless (listp note) note)))))
=
(defstruct (code-note (:constructor %make-code-note))
;; Code coverage state. This MUST be the first slot - see nx2-code-cove=
rage.
@@ -115,7 +109,6 @@
(setq sn (gethash original source-notes))
(not (gethash new source-notes)))
(setf (gethash new source-notes) sn)))
-
=
=
(defvar *nx1-alphatizers* (make-hash-table :size 180 :test #'eq))
Modified: release/1.3/source/compiler/nx0.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/compiler/nx0.lisp (original)
+++ release/1.3/source/compiler/nx0.lisp Thu Apr 9 19:04:15 2009
@@ -2162,6 +2162,12 @@
(values form nil))
=
)
+
+(defun nx-source-note (form &aux (source-notes *nx-source-note-map*))
+ (when source-notes
+ (when (or (consp form) (vectorp form) (pathnamep form))
+ (let ((note (gethash form source-notes)))
+ (unless (listp note) note)))))
=
(defun nx-transform (form &optional (environment *nx-lexical-environment*)=
(source-note-map *nx-source-note-map*))
(macrolet ((form-changed (form)
Modified: release/1.3/source/doc/src/ffi.xml
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/doc/src/ffi.xml (original)
+++ release/1.3/source/doc/src/ffi.xml Thu Apr 9 19:04:15 2009
@@ -2038,7 +2038,7 @@
<para>Create the file typetest.c, and put the following code
into it:</para>
<programlisting>
-#include <stdio.>
+#include <stdio.h>
=
void
void_void_test(void)
Modified: release/1.3/source/level-0/l0-cfm-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-0/l0-cfm-support.lisp (original)
+++ release/1.3/source/level-0/l0-cfm-support.lisp Thu Apr 9 19:04:15 2009
@@ -881,7 +881,7 @@
(shlib.pathname lib) nil
(shlib.base lib) nil)
(let* ((soname (shlib.soname lib))
- (last-dot (if soname (1+ (last-dot-pos soname)))))
+ (last-dot (if soname (last-dot-pos soname))))
(when soname
(with-cstrs ((soname soname))
(let* ((map (block found
@@ -893,7 +893,7 @@
(unless (%null-ptr-p libname)
(when (or (%cstrcmp soname libname)
(and last-dot
- (%cnstrcmp soname libname =
last-dot)))
+ (%cnstrcmp soname libname =
(1+ last-dot))))
(return-from found m)))))))))
(when map
;;; Sigh. We can't reliably lookup symbols in the library
Modified: release/1.3/source/level-1/l1-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/l1-files.lisp (original)
+++ release/1.3/source/level-1/l1-files.lisp Thu Apr 9 19:04:15 2009
@@ -1321,9 +1321,21 @@
=
(defun load-from-stream (stream print &aux (eof-val (list ())) val)
(with-compilation-unit (:override nil) ; try this for included files
- (let ((env (new-lexical-environment (new-definition-environment 'eval)=
)))
+ (let ((env (new-lexical-environment (new-definition-environment 'eval)=
))
+ ;; source note map to use with any compilations.
+ (*nx-source-note-map* (and *save-source-locations*
+ (make-hash-table :test #'eq :shared =
nil)))
+ (*loading-toplevel-location* nil))
(%rplacd (defenv.type (lexenv.parent-env env)) *outstanding-deferred=
-warnings*)
- (while (neq eof-val (setq val (read stream nil eof-val)))
+ (loop
+ (multiple-value-setq (val *loading-toplevel-location*)
+ (read-recording-source stream
+ :eofval eof-val
+ :file-name *loading-file-source-file*
+ :map *nx-source-note-map*
+ :save-source-text (neq *save-source-locat=
ions* :no-text)))
+ (when (eq eof-val val)
+ (return))
(when (eq print :source) (format t "~&Source: ~S~%" val))
(setq val (cheap-eval-in-environment val env))
(when print
Modified: release/1.3/source/level-1/l1-readloop.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/level-1/l1-readloop.lisp (original)
+++ release/1.3/source/level-1/l1-readloop.lisp Thu Apr 9 19:04:15 2009
@@ -553,19 +553,47 @@
(dolist (decl-spec (cdr declaration))
(setq decl-specs (nconc decl-specs (list decl-spec)))))))
=
+(defun cheap-eval-macroexpand-1 (form env)
+ (multiple-value-bind (new win) (macroexpand-1 form env)
+ (when win
+ (note-source-transformation form new))
+ (values new win)))
+
+(defun cheap-eval-transform (original new)
+ (note-source-transformation original new)
+ new)
+
+(defun cheap-eval-function (name lambda env)
+ (multiple-value-bind (lfun warnings)
+ (compile-named-function lambda
+ :name name
+ :env env
+ :function-note *loading-top=
level-location*
+ :keep-lambda *save-definiti=
ons*
+ :keep-symbols *save-local-s=
ymbols*
+ :source-notes *nx-source-no=
te-map*)
+ (signal-or-defer-warnings warnings env)
+ lfun))
+
+(fset 'nx-source-note (nlambda bootstrapping-source-note (form) (declare (=
ignore form)) nil))
+
(defun cheap-eval-in-environment (form env &aux sym)
(declare (resident))
+ ;; records source locations if *nx-source-note-map* is bound by caller
+ (setq *loading-toplevel-location* (or (nx-source-note form) *loading-top=
level-location*))
(flet ((progn-in-env (body&decls parse-env base-env)
(multiple-value-bind (body decls) (parse-body body&decls parse-=
env)
(setq base-env (augment-environment base-env :declare (decl-s=
pecs-from-declarations decls)))
- (while (cdr body)
- (cheap-eval-in-environment (pop body) base-env))
+ (loop with default-location =3D *loading-toplevel-location*
+ while (cdr body) as form =3D (pop body)
+ do (cheap-eval-in-environment form base-env)
+ do (setq *loading-toplevel-location* default-location))
(cheap-eval-in-environment (car body) base-env))))
(if form
(cond ((symbolp form) =
- (multiple-value-bind (expansion win) (macroexpand-1 form env)
+ (multiple-value-bind (expansion win) (cheap-eval-macroexpand-=
1 form env)
(if win =
- (cheap-eval-in-environment expansion env) =
+ (cheap-eval-in-environment expansion env)
(let* ((defenv (definition-environment env))
(constant (if defenv (assq form (defenv.constants =
defenv))))
(constval (%cdr constant)))
@@ -594,22 +622,25 @@
(if (and local-p (eq kind :macro))
(error "~s can't be used to reference lexically de=
fined macro ~S" 'function sym)))
(%function (setf-function-name (%cadr sym))))
- (t (%make-function nil sym env))))
+ (t (cheap-eval-function nil sym env))))
((eq sym 'nfunction)
(verify-arg-count form 2 2)
- (%make-function (%cadr form) (%caddr form) env))
+ (cheap-eval-function (%cadr form) (%caddr form) env))
((eq sym 'progn) (progn-in-env (%cdr form) env env))
((eq sym 'setq)
(if (not (%ilogbitp 0 (list-length form)))
(verify-arg-count form 0 0)) ;Invoke a "Too many args" erro=
r.
(let* ((sym nil)
- (val nil))
+ (val nil)
+ (original form))
(while (setq form (%cdr form))
(setq sym (require-type (pop form) 'symbol))
(multiple-value-bind (expansion expanded)
- (macroexpand-1 sym env)
+ (cheap-eval-macroexpand-1 sym env)
(if expanded
- (setq val (cheap-eval-in-environment `(setf ,expansio=
n ,(%car form)) env))
+ (setq val (cheap-eval-in-environment
+ (cheap-eval-transform original `(setf ,exp=
ansion ,(%car form)))
+ env))
(set sym (setq val (cheap-eval-in-environment (%car f=
orm) env))))))
val))
((eq sym 'eval-when)
@@ -617,7 +648,9 @@
(when (or (memq 'eval when) (memq :execute when)) (progn-in=
-env body env env))))
((eq sym 'if)
(destructuring-bind (test true &optional false) (%cdr form)
- (cheap-eval-in-environment (if (cheap-eval-in-environment t=
est env) true false) env)))
+ (setq test (let ((*loading-toplevel-location* *loading-topl=
evel-location*))
+ (cheap-eval-in-environment test env)))
+ (cheap-eval-in-environment (if test true false) env)))
((eq sym 'locally) (progn-in-env (%cdr form) env env))
((eq sym 'symbol-macrolet)
(multiple-value-bind (body decls) (parse-body (cddr form) env)
@@ -637,19 +670,19 @@
(if (eq sym 'unwind-protect)
(destructuring-bind (protected-form . cleanup-forms) (cdr f=
orm)
(unwind-protect
- (cheap-eval-in-environment protected-form env)
+ (let ((*loading-toplevel-location* *loading-toplevel-=
location*))
+ (cheap-eval-in-environment protected-form env))
(progn-in-env cleanup-forms env env)))
- (funcall (%make-function nil `(lambda () (progn ,form)) env=
))))
+ (funcall (cheap-eval-function nil (cheap-eval-transform for=
m `(lambda () (progn ,form))) env))))
((and (symbolp sym) (macro-function sym env))
- (if (eq sym 'step)
- (let ((*compile-definitions* nil))
- (cheap-eval-in-environment (macroexpand-1 form env) e=
nv))
- (cheap-eval-in-environment (macroexpand-1 form env) env)))
+ (cheap-eval-in-environment (cheap-eval-macroexpand-1 form env=
) env))
((or (symbolp sym)
(and (consp sym) (eq (%car sym) 'lambda)))
- (let ((args nil))
- (dolist (elt (%cdr form)) (push (cheap-eval-in-environment =
elt env) args))
- (apply #'call-check-regs (if (symbolp sym) sym (%make-funct=
ion nil sym env))
+ (let ((args nil) (form-location *loading-toplevel-location*))
+ (dolist (elt (%cdr form))
+ (push (cheap-eval-in-environment elt env) args)
+ (setq *loading-toplevel-location* form-location))
+ (apply #'call-check-regs (if (symbolp sym) sym (cheap-eval-=
function nil sym env))
(nreverse args))))
(t (signal-simple-condition 'simple-program-error "Car of ~S i=
s not a function name or lambda-expression." form))))))
=
Modified: release/1.3/source/lisp-kernel/darwinx8632/Makefile
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/darwinx8632/Makefile (original)
+++ release/1.3/source/lisp-kernel/darwinx8632/Makefile Thu Apr 9 19:04:15=
2009
@@ -27,6 +27,7 @@
CDEFINES =3D -DDARWIN -DX86 -DX8632 #-DGC_INTEGRITY_CHECKING -DFORCE_DWS_M=
ARK -DDISABLE_EGC -DDEBUG_MACH_EXCEPTIONS
CDEBUG =3D -g
COPT =3D #-O2
+CC=3Dgcc-4.0
=
.s.o:
$(M4) $(M4FLAGS) -I../ $< | $(AS) $(ASFLAGS) -o $@
Modified: release/1.3/source/lisp-kernel/darwinx8664/Makefile
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/darwinx8664/Makefile (original)
+++ release/1.3/source/lisp-kernel/darwinx8664/Makefile Thu Apr 9 19:04:15=
2009
@@ -21,8 +21,8 @@
=
VPATH =3D ..
RM =3D /bin/rm
-LD =3D ld64
-
+LD =3D ld
+CC=3Dgcc-4.0
=
### Current ld64 bugs include the claim that 0x1000 isn't a power of 2.
### Gosh. I always thought that it was. Go know, right ?
Modified: release/1.3/source/lisp-kernel/memprotect.h
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/memprotect.h (original)
+++ release/1.3/source/lisp-kernel/memprotect.h Thu Apr 9 19:04:15 2009
@@ -25,7 +25,11 @@
#endif
#include <signal.h>
#ifndef WINDOWS
+#ifdef DARWIN
+#include <sys/ucontext.h>
+#else
#include <ucontext.h>
+#endif
#endif
=
#ifdef WINDOWS
Modified: release/1.3/source/lisp-kernel/x86-asmutils32.s
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-asmutils32.s (original)
+++ release/1.3/source/lisp-kernel/x86-asmutils32.s Thu Apr 9 19:04:15 2009
@@ -180,12 +180,10 @@
undocumented. On x8632 Darwin, sigtramp() sets it to 0x1e, and
since we're trying to do what sigtramp() would do if we'd returned
to it ... */
- .globl C(sigreturn)
__(movl $0x1e,8(%esp))
- __(jmp *jsigreturn)
- .data
-jsigreturn: .long C(sigreturn)
- .text
+ __(movl $0xb8,%eax) /* SYS_sigreturn */
+ __(int $0x80)
+ __(ret) /* shouldn't return */
=
_endfn
__endif =
Modified: release/1.3/source/lisp-kernel/x86-asmutils64.s
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-asmutils64.s (original)
+++ release/1.3/source/lisp-kernel/x86-asmutils64.s Thu Apr 9 19:04:15 2009
@@ -166,6 +166,7 @@
_exportfn(C(freebsd_sigreturn))
__(movl $417,%eax) /* SYS_sigreturn */
__(syscall) =
+ =
_exportfn(C(get_vector_registers))
_endfn
=
@@ -177,7 +178,9 @@
since we're trying to do what sigtramp() would do if we'd returned
to it ... */
__(movl $0x1e,%esi)
- __(jmp C(sigreturn))
+ __(movl $0x20000b8,%eax)
+ __(syscall)
+ __(ret)
_endfn
__endif
=
Modified: release/1.3/source/lisp-kernel/x86-spentry64.s
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.3/source/lisp-kernel/x86-spentry64.s (original)
+++ release/1.3/source/lisp-kernel/x86-spentry64.s Thu Apr 9 19:04:15 2009
@@ -4268,10 +4268,10 @@
/* %rax/%rdx contains the return value (maybe), %save0 still
contains the linear tcr address. Preserve %rax/%rdx here. */
__(set_gs_base(%csave1))
- __(movq (%csave3),%rax)
- __(movq 8(%csave3),%rdx)
- __(movsd 16(%csave3),%xmm0)
- __(movsd 24(%csave3),%xmm1)
+ __(movq (%csave0),%rax)
+ __(movq 8(%csave0),%rdx)
+ __(movsd 16(%csave0),%xmm0)
+ __(movsd 24(%csave0),%xmm1)
__endif
__ifdef([WINDOWS])
__(movq %csave1, %rcontext_reg)
@@ -5087,6 +5087,10 @@
=
__ifdef([DARWIN])
.if 1
+ .globl C(lisp_objc_personality)
+C(lisp_objc_personality):
+ jmp *lisp_global(objc_2_personality)
+ =
.section __TEXT,__eh_frame,coalesced,no_toc+strip_static_syms+live_support
EH_frame1:
.set L$set$12,LECIE1-LSCIE1
@@ -5098,9 +5102,9 @@
.byte 0x1 /* uleb128 0x1; CIE Code Alignment Factor */
.byte 0x78 /* sleb128 -8; CIE Data Alignment Factor */
.byte 0x10 /* CIE RA Column */
- .byte 0xb /* uleb128 0xb; Augmentation size */
- .byte 0x8c /* Personality (indirect sdata8) */
- .quad lisp_global(objc_2_personality)
+ .byte 0x7
+ .byte 0x9b
+ .long _lisp_objc_personality+4 at GOTPCREL
.byte 0x10 /* LSDA Encoding (pcrel) */
.byte 0x10 /* FDE Encoding (pcrel) */
.byte 0xc /* DW_CFA_def_cfa */
More information about the Openmcl-cvs-notifications
mailing list