[Git][cmucl/cmucl][issue-168-no-negated-forms-for-jmp] 3 commits: Fix #166: integer-decode-float has incorrect type for exponent

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-168-no-negated-forms-for-jmp at cmucl / cmucl


Commits:
cb945c68 by Raymond Toy at 2023-02-27T15:33:25+00:00
Fix #166: integer-decode-float has incorrect type for exponent

- - - - -
bb43504b by Raymond Toy at 2023-02-27T15:33:25+00:00
Merge branch 'issue-166-integer-decode-float-min-float' into 'master'

Fix #166: integer-decode-float has incorrect type for exponent

Closes #166

See merge request cmucl/cmucl!117
- - - - -
af8179e5 by Raymond Toy at 2023-02-27T07:45:42-08:00
Merge branch 'master' into issue-168-no-negated-forms-for-jmp

- - - - -


6 changed files:

- .gitlab-ci.yml
- + src/bootfiles/21d/boot-2021-07-1.lisp
- src/code/exports.lisp
- src/compiler/fndb.lisp
- src/compiler/generic/vm-type.lisp
- tests/issues.lisp


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -1,7 +1,7 @@
 variables:
   download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2021/07"
   version: "2021-07-x86"
-  bootstrap: "-B boot-2021-07-2"
+  bootstrap: "-B boot-2021-07-1 -B boot-2021-07-2"
 
 stages:
   - install


=====================================
src/bootfiles/21d/boot-2021-07-1.lisp
=====================================
@@ -0,0 +1,17 @@
+;; Bootstrap file
+;;
+;; Use "bin/build.sh -B boot-2021-07-1" to build this.
+;;
+;; We want to export the symbols from the KERNEL package which also
+;; exists in the C package, so we unintern the conflicting symbols from
+;; the C package.
+
+(in-package "KERNEL")
+(ext:without-package-locks
+  (handler-bind
+      ((error (lambda (c)
+		(declare (ignore c))
+		(invoke-restart 'lisp::unintern-conflicting-symbols))))
+    (export '(DOUBLE-FLOAT-INT-EXPONENT
+	      SINGLE-FLOAT-INT-EXPONENT))))
+


=====================================
src/code/exports.lisp
=====================================
@@ -2329,10 +2329,11 @@
 	   "DOUBLE-FLOAT-EXPONENT"
 	   "DOUBLE-FLOAT-BITS"
 	   "DOUBLE-FLOAT-HIGH-BITS"
+	   "DOUBLE-FLOAT-INT-EXPONENT"
 	   "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT"
 	   "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME"
 	   "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS"
-	   "FLOAT-FORMAT-MAX" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P"
+	   "FLOAT-FORMAT-MAX" "FLOAT-INT-EXPONENT" "FLOAT-RADIX" "FORM" "FUNCALLABLE-INSTANCE-P"
 	   "FUNCTION-CODE-HEADER" "FUNCTION-TYPE" "FUNCTION-TYPE-ALLOWP"
 	   "FUNCTION-TYPE-KEYP" "FUNCTION-TYPE-KEYWORDS"
 	   "FUNCTION-TYPE-NARGS" "FUNCTION-TYPE-OPTIONAL" "FUNCTION-TYPE-P"
@@ -2426,6 +2427,7 @@
  	   "SIMPLE-ARRAY-SIGNED-BYTE-16-P" "SIMPLE-ARRAY-SIGNED-BYTE-30-P"
 	   "SIMPLE-ARRAY-SIGNED-BYTE-32-P" "SIMPLE-ARRAY-SIGNED-BYTE-8-P" 
 	   "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT"
+	   "SINGLE-FLOAT-INT-EXPONENT"
 	   "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF"
 	   "STD-COMPUTE-CLASS-PRECEDENCE-LIST"
 	   "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE"


=====================================
src/compiler/fndb.lisp
=====================================
@@ -319,7 +319,7 @@
 (defknown (float-digits float-precision) (float) float-digits
   (movable foldable flushable explicit-check))
 (defknown integer-decode-float (float)
-	  (values integer float-exponent (member -1 1))
+	  (values integer float-int-exponent (member -1 1))
 	  (movable foldable flushable explicit-check))
 
 (defknown complex (real &optional real) number


=====================================
src/compiler/generic/vm-type.lisp
=====================================
@@ -50,6 +50,8 @@
 (deftype float-exponent ()
   #-long-float 'double-float-exponent
   #+long-float 'long-float-exponent)
+(deftype float-int-exponent ()
+  'double-float-int-exponent)
 (deftype float-digits ()
   #-long-float `(integer 0 ,vm:double-float-digits)
   #+long-float `(integer 0 ,vm:long-float-digits))


=====================================
tests/issues.lisp
=====================================
@@ -829,3 +829,14 @@
 	(*compile-print* nil))
     (assert-true (stream::find-external-format :euckr))
     (assert-true (stream::find-external-format :cp949))))
+
+
+
+(define-test issue.166
+    (:tag :issues)
+  ;; While this tests for the correct return value, the problem was
+  ;; that the compiler was miscompiling the function below and causing
+  ;; an error when the function run.
+  (let ((f (compile nil #'(lambda ()
+			    (nth-value 1 (integer-decode-float least-positive-double-float))))))
+    (assert-equal -1126 (funcall f))))



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/963104015b369a7c835bc70330e24ace0975429c...af8179e5f55b1a79e853a405e9ff99e98a897137

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/963104015b369a7c835bc70330e24ace0975429c...af8179e5f55b1a79e853a405e9ff99e98a897137
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230227/85264827/attachment-0001.html>