* Things work better if we restore the old stack pointer in the
inline version...
* Make sure foreign tests test both fast and small code-paths.
Note: our allocation routines also call out to C, ending up in
alloc(), so they may need looking at too.
Note: out-of-line call_into_c does call + jmp, getting it to
to call + ret should not be too hard, should it?
:from :eval :to :result) ecx)
(:temporary (:sc unsigned-reg :offset edx-offset
:from :eval :to :result) edx)
:from :eval :to :result) ecx)
(:temporary (:sc unsigned-reg :offset edx-offset
:from :eval :to :result) edx)
+ (:temporary (:sc unsigned-reg :offset esi-offset) prev-esp)
(:node-var node)
(:vop-var vop)
(:save-p t)
(:node-var node)
(:vop-var vop)
(:save-p t)
#!+darwin
;; Align stack for C.
#!+darwin
;; Align stack for C.
- (inst and esp-tn #xfffffff0)
+ (progn
+ (move prev-esp esp-tn)
+ (inst and esp-tn -16))
(inst call function)
;; To give the debugger a clue. XX not really internal-error?
(note-this-location vop :internal-error)
(inst call function)
;; To give the debugger a clue. XX not really internal-error?
(note-this-location vop :internal-error)
+ #!+darwin
+ ;; Restore
+ (move esp-tn prev-esp)
+
;; Restore the NPX for lisp; ensure no regs are empty
(dotimes (i 7)
(inst fldz))
;; Restore the NPX for lisp; ensure no regs are empty
(dotimes (i 7)
(inst fldz))
## Foreign definitions & load
## Foreign definitions & load
-cat > $testfilestem.def.lisp <<EOF
+cat > $testfilestem.base.lisp <<EOF
(define-alien-variable environ (* c-string))
(defvar *environ* environ)
(eval-when (:compile-toplevel :load-toplevel :execute)
(define-alien-variable environ (* c-string))
(defvar *environ* environ)
(eval-when (:compile-toplevel :load-toplevel :execute)
;; that the location will be the same.
(assert (= (sb-sys:sap-int (alien-sap *environ*))
(sb-sys:sap-int (alien-sap environ))))
;; that the location will be the same.
(assert (= (sb-sys:sap-int (alien-sap *environ*))
(sb-sys:sap-int (alien-sap environ))))
(enable-debugger)
;; automagic restarts
(setf *debugger-hook*
(lambda (condition hook)
(enable-debugger)
;; automagic restarts
(setf *debugger-hook*
(lambda (condition hook)
- (print (list :debugger-hook condition))
(let ((cont (find-restart 'continue condition)))
(when cont
(invoke-restart cont)))
(let ((cont (find-restart 'continue condition)))
(when cont
(invoke-restart cont)))
(invoke-debugger condition)))
EOF
(invoke-debugger condition)))
EOF
+echo "(declaim (optimize speed))" > $testfilestem.fast.lisp
+cat $testfilestem.base.lisp >> $testfilestem.fast.lisp
+
+echo "(declaim (optimize space))" > $testfilestem.small.lisp
+cat $testfilestem.base.lisp >> $testfilestem.small.lisp
+
# Test code
cat > $testfilestem.test.lisp <<EOF
# Test code
cat > $testfilestem.test.lisp <<EOF
- (assert (= (summish 10 20) 31))
+ (assert (= 31 (summish 10 20)))
(assert (= 42 numberish))
(setf numberish 13)
(assert (= 13 numberish))
(assert (= 42 numberish))
(setf numberish 13)
(assert (= 13 numberish))
(sb-ext:quit :unix-status 52) ; success convention for Lisp program
EOF
(sb-ext:quit :unix-status 52) ; success convention for Lisp program
EOF
-${SBCL:-sbcl} --eval "(progn (load (compile-file #p\"$testfilestem.def.lisp\")) (sb-ext:quit :unix-status 52))"
-if [ $? = 52 ]; then
- true # nop
-else
- # we can't compile the test file. something's wrong.
- # rm $testfilestem.*
- echo test failed: $?
- exit 1
-fi
-
-echo compile ok
+test_compile() {
+ ${SBCL:-sbcl} --eval "(progn (load (compile-file #p\"$testfilestem.$1.lisp\")) (sb-ext:quit :unix-status 52))"
+ if [ $? = 52 ]; then
+ echo test compile $1 ok
+ else
+ # we can't compile the test file. something's wrong.
+ # rm $testfilestem.*
+ echo test compile $1 failed: $?
+ exit 1
+ fi
+}
-${SBCL:-sbcl} --load $testfilestem.def.fasl --load $testfilestem.test.lisp
-RET=$?
-if [ $RET = 22 ]; then
- rm $testfilestem.*
- exit $PUNT # success -- load-shared-object not supported
-elif [ $RET != 52 ]; then
- rm $testfilestem.*
- echo test failed: $?
- exit 1
-fi
+test_compile fast
+test_compile small
+
+test_use() {
+ ${SBCL:-sbcl} --load $testfilestem.$1.fasl --load $testfilestem.test.lisp
+ RET=$?
+ if [ $RET = 22 ]; then
+ rm $testfilestem.*
+ exit $PUNT # success -- load-shared-object not supported
+ elif [ $RET != 52 ]; then
+ rm $testfilestem.*
+ echo test use $1 failed: $?
+ exit 1
+ else
+ echo test use $1 ok
+ fi
+}
+test_use small
+test_use fast
-${SBCL:-sbcl} --load $testfilestem.def.fasl --eval "(when (member :linkage-table *features*) (save-lisp-and-die \"$testfilestem.core\"))" <<EOF
+test_save() {
+ ${SBCL:-sbcl} --load $testfilestem.$1.fasl --eval "(when (member :linkage-table *features*) (save-lisp-and-die \"$testfilestem.$1.core\"))" <<EOF
(sb-ext:quit :unix-status 22) ; catch this
EOF
(sb-ext:quit :unix-status 22) ; catch this
EOF
-if [ $? = 22 ]; then
- rm $testfilestem.*
- exit $PUNT # success -- linkage-table not available
-fi
-
-echo table ok
+ if [ $? = 22 ]; then
+ rm $testfilestem.*
+ exit $PUNT # success -- linkage-table not available
+ else
+ echo save $1 ok
+ fi
+}
-${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.core --sysinit /dev/null --userinit /dev/null --load $testfilestem.test.lisp
-if [ $? != 52 ]; then
- rm $testfilestem.*
- echo test failed: $?
- exit 1 # Failure
-fi
+test_save small
+test_save fast
+
+test_start() {
+ ${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.$1.core --sysinit /dev/null --userinit /dev/null --load $testfilestem.test.lisp
+ if [ $? != 52 ]; then
+ rm $testfilestem.*
+ echo test failed: $?
+ exit 1 # Failure
+ else
+ echo test start $1 ok
+ fi
+}
+test_start fast
+test_start small
# missing object file
rm $testfilestem-b.so $testfilestem-b2.so
# missing object file
rm $testfilestem-b.so $testfilestem-b2.so
-${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.core --sysinit /dev/null --userinit /dev/null <<EOF
+${SBCL_ALLOWING_CORE:-sbcl} --core $testfilestem.fast.core --sysinit /dev/null --userinit /dev/null <<EOF
(assert (= 22 (summish 10 11)))
(multiple-value-bind (val err) (ignore-errors (eval 'foo))
(assert (not val))
(assert (= 22 (summish 10 11)))
(multiple-value-bind (val err) (ignore-errors (eval 'foo))
(assert (not val))
rm -f $testfilestem.* $testfilestem-*
rm -f $testfilestem.* $testfilestem-*
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)