Permalink
Browse files

0.8.18.14:

	Merge x86-64-again branch onto HEAD.

	Many, many, many 64-bit cleanups in code/, runtime/, compiler/,
	compiler/generic/

	New SAP-REF-WORD and friends.

	Various fixes to the x86-64 backends (and addition of assembly/
	and runtime/ files necessary).  Implementation of Unicode-related
	stuff by CSR.  Signed modular arithmetic has not yet been
	implemented.

	A number of tests fail:
	... alien.impure.lisp: enum <-> integer array conversion
	... exhaust.impure.lisp: "deferred gubbins"
	... float.pure.lisp: float infinities
	... foreign.test.sh: "deferred gubbins"

	It's possible that this merge will cause alpha32 to break in an
	interesting way, probably related to undefined-alien.  Needs
	debugging.  Other architectures have been tested, but of course
	it's possible that something has gone wrong.

	Though I (CSR) am merging this, the vast majority of the work was
	done by Juho Snellman (building on Dan Barlow's initial work to
	get it into executing lisp code in cold-init), with guest appearances
	by Cheuksan Edward Wang and Vincent Arkesteijn.
  • Loading branch information...
csrhodes committed Jan 6, 2005
1 parent 77d94d3 commit 78fa16bf55be44cc16845be84d98023e83fb14bc
Showing with 5,368 additions and 4,245 deletions.
  1. +13 −8 CREDITS
  2. +43 −43 contrib/sb-bsd-sockets/constants.lisp
  3. +4 −4 contrib/sb-bsd-sockets/sockopt.lisp
  4. +1 −3 contrib/sb-posix/interface.lisp
  5. +9 −1 contrib/sb-posix/posix-tests.lisp
  6. +5 −5 contrib/sb-sprof/sb-sprof.lisp
  7. +4 −1 make-config.sh
  8. +9 −7 package-data-list.lisp-expr
  9. +59 −0 src/assembly/x86-64/alloc.lisp
  10. +303 −0 src/assembly/x86-64/arith.lisp
  11. +39 −0 src/assembly/x86-64/array.lisp
  12. +263 −0 src/assembly/x86-64/assem-rtns.lisp
  13. +12 −0 src/assembly/x86-64/bit-bash.lisp
  14. +46 −0 src/assembly/x86-64/support.lisp
  15. +11 −10 src/code/bignum.lisp
  16. +10 −7 src/code/bit-bash.lisp
  17. +2 −2 src/code/cold-init.lisp
  18. +2 −2 src/code/cross-misc.lisp
  19. +5 −1 src/code/cross-sap.lisp
  20. +61 −56 src/code/debug-int.lisp
  21. +4 −4 src/code/defsetfs.lisp
  22. +5 −4 src/code/defstruct.lisp
  23. +5 −5 src/code/fop.lisp
  24. +1 −2 src/code/foreign.lisp
  25. +6 −3 src/code/hash-table.lisp
  26. +2 −11 src/code/kernel.lisp
  27. +2 −2 src/code/numbers.lisp
  28. +16 −10 src/code/room.lisp
  29. +7 −4 src/code/run-program.lisp
  30. +2 −2 src/code/target-c-call.lisp
  31. +2 −2 src/code/target-defstruct.lisp
  32. +8 −6 src/code/target-hash-table.lisp
  33. +1 −2 src/code/target-random.lisp
  34. +24 −0 src/code/target-sap.lisp
  35. +14 −22 src/code/target-sxhash.lisp
  36. +8 −4 src/code/target-thread.lisp
  37. +2 −2 src/code/target-unithread.lisp
  38. +5 −5 src/code/toplevel.lisp
  39. +341 −0 src/code/x86-64-vm.lisp
  40. +7 −7 src/compiler/aliencomp.lisp
  41. +12 −4 src/compiler/disassem.lisp
  42. +1 −1 src/compiler/generic/core.lisp
  43. +3 −1 src/compiler/generic/early-objdef.lisp
  44. +34 −48 src/compiler/generic/genesis.lisp
  45. +13 −13 src/compiler/generic/objdef.lisp
  46. +73 −53 src/compiler/generic/primtype.lisp
  47. +2 −2 src/compiler/generic/vm-fndb.lisp
  48. +2 −2 src/compiler/pack.lisp
  49. +33 −3 src/compiler/saptran.lisp
  50. +61 −21 src/compiler/target-disassem.lisp
  51. +1 −1 src/compiler/x86-64/alloc.lisp
  52. +16 −9 src/compiler/x86-64/arith.lisp
  53. +356 −357 src/compiler/x86-64/array.lisp
  54. +1 −1 src/compiler/x86-64/backend-parms.lisp
  55. +80 −67 src/compiler/x86-64/c-call.lisp
  56. +24 −9 src/compiler/x86-64/call.lisp
  57. +17 −20 src/compiler/x86-64/cell.lisp
  58. +107 −66 src/compiler/x86-64/char.lisp
  59. +324 −2,104 src/compiler/x86-64/float.lisp
  60. +670 −158 src/compiler/x86-64/insts.lisp
  61. +63 −5 src/compiler/x86-64/macros.lisp
  62. +13 −17 src/compiler/x86-64/memory.lisp
  63. +31 −46 src/compiler/x86-64/move.lisp
  64. +5 −5 src/compiler/x86-64/nlx.lisp
  65. +11 −7 src/compiler/x86-64/parms.lisp
  66. +17 −4 src/compiler/x86-64/pred.lisp
  67. +15 −3 src/compiler/x86-64/sap.lisp
  68. +6 −1 src/compiler/x86-64/show.lisp
  69. +9 −3 src/compiler/x86-64/static-fn.lisp
  70. +2 −2 src/compiler/x86-64/system.lisp
  71. +137 −44 src/compiler/x86-64/type-vops.lisp
  72. +29 −0 src/compiler/x86-64/values.lisp
  73. +92 −56 src/compiler/x86-64/vm.lisp
  74. +3 −319 src/compiler/x86/array.lisp
  75. +20 −4 src/runtime/Config.x86_64-linux
  76. +1 −1 src/runtime/backtrace.c
  77. +6 −44 src/runtime/cheneygc.c
  78. +1 −0 src/runtime/dynbind.c
  79. +119 −117 src/runtime/gc-common.c
  80. +21 −10 src/runtime/gc-internal.h
  81. +3 −3 src/runtime/gencgc-alloc-region.h
  82. +8 −8 src/runtime/gencgc-internal.h
  83. +279 −205 src/runtime/gencgc.c
  84. +7 −5 src/runtime/interrupt.c
  85. +4 −4 src/runtime/monitor.c
  86. +1 −1 src/runtime/parse.c
  87. +154 −99 src/runtime/purify.c
  88. +2 −5 src/runtime/runtime.h
  89. +24 −18 src/runtime/save.c
  90. +4 −4 src/runtime/thread.c
  91. +4 −4 src/runtime/thread.h
  92. +393 −0 src/runtime/x86-64-arch.c
  93. +38 −0 src/runtime/x86-64-arch.h
  94. +335 −0 src/runtime/x86-64-assem.S
  95. +229 −0 src/runtime/x86-64-linux-os.c
  96. +14 −0 src/runtime/x86-64-linux-os.h
  97. +58 −0 src/runtime/x86-64-lispregs.h
  98. +5 −5 tests/arith.pure.lisp
  99. +2 −0 tests/bit-vector.impure-cload.lisp
  100. +1 −1 tests/compiler.impure.lisp
  101. +1 −0 tests/compiler.pure-cload.lisp
  102. +6 −6 tests/debug.impure.lisp
  103. +1 −1 tools-for-build/ldso-stubs.lisp
  104. +1 −1 version.lisp-expr
View
21 CREDITS
@@ -509,13 +509,14 @@ Martin Atzmueller:
Daniel Barlow:
His contributions have included support for shared object loading
(from CMUCL), the Cheney GC for non-x86 ports (from CMUCL), Alpha
- and PPC ports (from CMUCL), control stack exhaustion checking (new)
- and native threads support for x86 Linux (new). He also refactored
- the garbage collectors for understandability, wrote code
- (e.g. grovel-headers.c and stat_wrapper stuff) to find
- machine-dependent and OS-dependent constants automatically, and was
- original author of the asdf, asdf-install, sb-bsd-sockets,
- sb-executable, sb-grovel and sb-posix contrib packages.
+ and PPC ports (from CMUCL), control stack exhaustion checking (new),
+ native threads support for x86 Linux (new), and the initial x86-64
+ backend (new). He also refactored the garbage collectors for
+ understandability, wrote code (e.g. grovel-headers.c and
+ stat_wrapper stuff) to find machine-dependent and OS-dependent
+ constants automatically, and was original author of the asdf,
+ asdf-install, sb-bsd-sockets, sb-executable, sb-grovel and sb-posix
+ contrib packages.
Robert E. Brown:
He has reported various bugs and submitted several patches,
@@ -697,7 +698,8 @@ Juho Snellman:
function on strings, removal of unneccessary bounds checks, and
multiple improvements to performance of common operations on
bignums. He ported and enhanced the statistical profiler written by
- Gerd Moellmann for CMU CL.
+ Gerd Moellmann for CMU CL. He completed the work on the x86-64 port
+ of SBCL.
Brian Spilsbury:
He wrote Unicode-capable versions of SBCL's character, string, and
@@ -725,6 +727,9 @@ Colin Walters:
cmucl-imp@cons.org mailing list, was the inspiration for similar MAP
code added in sbcl-0.6.8.
+Cheuksan Edward Wang:
+ He assisted in debugging the SBCL x86-64 backend.
+
Raymond Wiker:
He ported sbcl-0.6.3 back to FreeBSD, restoring the ancestral
CMU CL support for FreeBSD and updating it for the changes made
@@ -133,62 +133,62 @@
(integer type "int" "h_addrtype")
(integer length "int" "h_length")
((* (* (unsigned 8))) addresses "char **" "h_addr_list")))
- (:function socket ("socket" integer
- (domain integer)
- (type integer)
- (protocol integer)))
- (:function bind ("bind" integer
- (sockfd integer)
+ (:function socket ("socket" int
+ (domain int)
+ (type int)
+ (protocol int)))
+ (:function bind ("bind" int
+ (sockfd int)
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
- (addrlen integer)))
- (:function listen ("listen" integer
- (socket integer)
- (backlog integer)))
- (:function accept ("accept" integer
- (socket integer)
+ (addrlen int)))
+ (:function listen ("listen" int
+ (socket int)
+ (backlog int)))
+ (:function accept ("accept" int
+ (socket int)
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
- (addrlen integer :in-out)))
- (:function getpeername ("getpeername" integer
- (socket integer)
+ (addrlen int :in-out)))
+ (:function getpeername ("getpeername" int
+ (socket int)
(her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
- (addrlen integer :in-out)))
- (:function getsockname ("getsockname" integer
- (socket integer)
+ (addrlen int :in-out)))
+ (:function getsockname ("getsockname" int
+ (socket int)
(my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
- (addrlen integer :in-out)))
- (:function connect ("connect" integer
- (socket integer)
+ (addrlen int :in-out)))
+ (:function connect ("connect" int
+ (socket int)
(his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
- (addrlen integer )))
+ (addrlen int )))
- (:function close ("close" integer
- (fd integer)))
- (:function recvfrom ("recvfrom" integer
- (socket integer)
+ (:function close ("close" int
+ (fd int)))
+ (:function recvfrom ("recvfrom" int
+ (socket int)
(buf (* t))
(len integer)
- (flags integer)
+ (flags int)
(sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un?
(socklen (* socklen-t))))
(:function gethostbyname ("gethostbyname" (* hostent) (name c-string)))
(:function gethostbyaddr ("gethostbyaddr" (* hostent)
(addr (* t))
- (len integer)
- (af integer)))
- (:function setsockopt ("setsockopt" integer
- (socket integer)
- (level integer)
- (optname integer)
+ (len int)
+ (af int)))
+ (:function setsockopt ("setsockopt" int
+ (socket int)
+ (level int)
+ (optname int)
(optval (* t))
- (optlen integer)))
- (:function fcntl ("fcntl" integer
- (fd integer)
- (cmd integer)
- (arg integer)))
- (:function getsockopt ("getsockopt" integer
- (socket integer)
- (level integer)
- (optname integer)
+ (optlen int)))
+ (:function fcntl ("fcntl" int
+ (fd int)
+ (cmd int)
+ (arg long)))
+ (:function getsockopt ("getsockopt" int
+ (socket int)
+ (level int)
+ (optname int)
(optval (* t))
- (optlen (* integer)))))
+ (optlen (* int)))))
)
@@ -49,7 +49,7 @@ Code for options that not every system has should be conditionalised:
(defun ,lisp-name (socket)
,@(when documentation (list (concatenate 'string documentation " " info)))
,(if supportedp
- `(sb-alien:with-alien ((size sb-alien:integer)
+ `(sb-alien:with-alien ((size sb-alien:int)
(buffer ,buffer-type))
(setf size (sb-alien:alien-size ,buffer-type :bytes))
(if (= -1 (sockint::getsockopt (socket-file-descriptor socket)
@@ -81,12 +81,12 @@ Code for options that not every system has should be conditionalised:
;;; sockopts that have integer arguments
(defun foreign-int-to-integer (buffer size)
- (assert (= size (sb-alien:alien-size sb-alien:integer :bytes)))
+ (assert (= size (sb-alien:alien-size sb-alien:int :bytes)))
buffer)
(defmacro define-socket-option-int (name level number &optional features (info ""))
`(define-socket-option ,name nil ,level ,number
- sb-alien:integer nil foreign-int-to-integer sb-alien:addr ,features ,info))
+ sb-alien:int nil foreign-int-to-integer sb-alien:addr ,features ,info))
(define-socket-option-int
sockopt-receive-low-water sockint::sol-socket sockint::so-rcvlowat)
@@ -118,7 +118,7 @@ Code for options that not every system has should be conditionalised:
This can also be updated with SETF.~:@>"
(symbol-name c-name))
,level ,c-name
- sb-alien:integer bool-to-foreign-int foreign-int-to-bool sb-alien:addr
+ sb-alien:int bool-to-foreign-int foreign-int-to-bool sb-alien:addr
,features ,info))
(define-socket-option-bool
@@ -219,10 +219,8 @@
;;; mmap, msync
(define-call "mmap" sb-sys:system-area-pointer
- ;; KLUDGE: #XFFFFFFFF is (void *)-1, which is the charming return
- ;; value of mmap on failure. Except on 64 bit systems ...
(lambda (res)
- (= (sb-sys:sap-int res) #-alpha #XFFFFFFFF #+alpha #xffffffffffffffff))
+ (= (sb-sys:sap-int res) #.(1- (expt 2 sb-vm::n-machine-word-bits))))
(addr sap-or-nil) (length unsigned) (prot unsigned)
(flags unsigned) (fd file-descriptor) (offset sb-posix::off-t))
@@ -355,11 +355,19 @@
(sb-posix:syscall-errno c)))
#.sb-posix::eisdir)
+#-(and x86-64 linux)
(deftest fcntl.1
(let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
(= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))
t)
-
+;; On AMD64/Linux O_LARGEFILE is always set, even though the whole
+;; flag makes no sense.
+#+(and x86-64 linux)
+(deftest fcntl.1
+ (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
+ (/= 0 (logand (sb-posix:fcntl fd sb-posix::f-getfl)
+ sb-posix::o-nonblock)))
+ t)
(deftest opendir.1
(let ((dir (sb-posix:opendir "/")))
@@ -423,7 +423,7 @@
(deftype address ()
"Type used for addresses, for instance, program counters,
code start/end locations etc."
- '(unsigned-byte #+alpha 64 #-alpha 32))
+ '(unsigned-byte #.sb-vm::n-machine-word-bits))
(defconstant +unknown-address+ 0
"Constant representing an address that cannot be determined.")
@@ -580,9 +580,9 @@
(locally (declare (optimize (inhibit-warnings 2)))
(let* ((pc-ptr (sb-vm:context-pc scp))
(fp (sb-vm::context-register scp #.sb-vm::ebp-offset))
- (ra (sap-ref-32 (int-sap fp)
- (- (* (1+ sb-vm::return-pc-save-offset)
- sb-vm::n-word-bytes)))))
+ (ra (sap-ref-word (int-sap fp)
+ (- (* (1+ sb-vm::return-pc-save-offset)
+ sb-vm::n-word-bytes)))))
(record (sap-int pc-ptr))
(record ra)))))))
@@ -596,7 +596,7 @@
(locally (declare (optimize (inhibit-warnings 2)))
(let* ((pc-ptr (sb-vm:context-pc scp))
(fp (sb-vm::context-register scp #.sb-vm::cfp-offset))
- (ra (sap-ref-32
+ (ra (sap-ref-word
(int-sap fp)
(* sb-vm::lra-save-offset sb-vm::n-word-bytes))))
(record (sap-int pc-ptr))
View
@@ -30,7 +30,8 @@ printf '(' >> $ltf
echo //guessing default target CPU architecture from host architecture
case `uname -m` in
- *86|x86_64) guessed_sbcl_arch=x86 ;;
+ *86) guessed_sbcl_arch=x86 ;;
+ *x86_64) guessed_sbcl_arch=x86-64 ;;
[Aa]lpha) guessed_sbcl_arch=alpha ;;
sparc*) guessed_sbcl_arch=sparc ;;
sun*) guessed_sbcl_arch=sparc ;;
@@ -189,6 +190,8 @@ if [ "$sbcl_arch" = "x86" ]; then
if [ "$sbcl_os" = "linux" ] || [ "$sbcl_os" = "freebsd" ] || [ "$sbcl_os" = "netbsd" ]; then
printf ' :linkage-table' >> $ltf
fi
+elif [ "$sbcl_arch" = "x86-64" ]; then
+ printf ' :gencgc :stack-grows-downward-not-upward :c-stack-is-control-stack :linkage-table' >> $ltf
elif [ "$sbcl_arch" = "mips" ]; then
# Use a little C program to try to guess the endianness. Ware
# cross-compilers!
@@ -1098,11 +1098,12 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
"%SET-ARRAY-DIMENSION" "%SET-FUNCALLABLE-INSTANCE-FUN"
"%SET-FUNCALLABLE-INSTANCE-INFO" "%SET-RAW-BITS"
"%SET-SAP-REF-16" "%SET-SAP-REF-32" "%SET-SAP-REF-64"
- "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE"
+ "%SET-SAP-REF-WORD" "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE"
"%SET-SAP-REF-LONG" "%SET-SAP-REF-SAP"
"%SET-SAP-REF-SINGLE" "%SET-SIGNED-SAP-REF-16"
"%SET-SIGNED-SAP-REF-32" "%SET-SIGNED-SAP-REF-64"
- "%SET-SIGNED-SAP-REF-8" "%SET-STACK-REF"
+ "%SET-SIGNED-SAP-REF-WORD"
+ "%SET-SIGNED-SAP-REF-8" "%SET-STACK-REF"
"%SET-SYMBOL-HASH" "%SIN" "%SIN-QUICK" "%SINGLE-FLOAT"
"%SINH" "%SQRT" "%SXHASH-SIMPLE-STRING"
"%SXHASH-SIMPLE-SUBSTRING" "%TAN" "%TAN-QUICK" "%TANH"
@@ -1204,7 +1205,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
"IRRATIONAL" "JUST-DUMP-IT-NORMALLY" "KEY-INFO"
"KEY-INFO-NAME" "KEY-INFO-P" "KEY-INFO-TYPE"
"LAYOUT-DEPTHOID" "LAYOUT-INVALID-ERROR"
- #!+x86 "%LEA"
+ #!+(or x86-64 x86) "%LEA"
"LEXENV" "LEXENV-DESIGNATOR" "LINE-LENGTH" "ANSI-STREAM"
"ANSI-STREAM-BIN" "ANSI-STREAM-BOUT" "ANSI-STREAM-CLOSE"
"ANSI-STREAM-ELEMENT-TYPE" "ANSI-STREAM-IN"
@@ -1329,8 +1330,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
"PACKAGE-INTERNAL-SYMBOLS" "PACKAGE-EXTERNAL-SYMBOLS"
"PARSE-DEFMACRO" "PARSE-UNKNOWN-TYPE"
"PARSE-UNKNOWN-TYPE-SPECIFIER" "PATHNAME-DESIGNATOR"
- #!+x86 "*PSEUDO-ATOMIC-ATOMIC*"
- #!+x86 "*PSEUDO-ATOMIC-INTERRUPTED*"
+ #!+(or x86 x86-64) "*PSEUDO-ATOMIC-ATOMIC*"
+ #!+(or x86 x86-64) "*PSEUDO-ATOMIC-INTERRUPTED*"
"PUNT-PRINT-IF-TOO-LONG" "READER-IMPOSSIBLE-NUMBER-ERROR"
"READER-PACKAGE-ERROR" "READER-EOF-ERROR"
"RESTART-DESIGNATOR" "SCALE-DOUBLE-FLOAT"
@@ -1823,15 +1824,16 @@ SB-KERNEL) have been undone, but probably more remain."
"REOPEN-SHARED-OBJECTS"
"RESOLVE-LOADED-ASSEMBLER-REFERENCES"
"SAP+" "SAP-" "SAP-INT"
- "SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-8"
+ "SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-WORD"
+ "SAP-REF-8"
"SAP-REF-DESCRIPTOR"
"SAP-REF-DOUBLE" "SAP-REF-LONG"
"SAP-REF-SAP" "SAP-REF-SINGLE"
"SAP<" "SAP<=" "SAP=" "SAP>" "SAP>="
"SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS"
"SERVE-EVENT" "SERVER" "SERVER-MESSAGE"
"SIGNED-SAP-REF-16" "SIGNED-SAP-REF-32"
- "SIGNED-SAP-REF-64" "SIGNED-SAP-REF-8"
+ "SIGNED-SAP-REF-64" "SIGNED-SAP-REF-WORD" "SIGNED-SAP-REF-8"
;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL.
"STRUCTURE!OBJECT" "STRUCTURE!OBJECT-MAKE-LOAD-FORM"
"SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P"
@@ -0,0 +1,59 @@
+;;;; allocating simple objects
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!VM")
+
+;;;; from signed/unsigned
+
+;;; KLUDGE: Why don't we want vops for this one and the next
+;;; one? -- WHN 19990916
+#+sb-assembling ; We don't want a vop for this one.
+(define-assembly-routine
+ (move-from-signed)
+ ((:temp eax unsigned-reg eax-offset)
+ (:temp ebx unsigned-reg ebx-offset))
+ (inst mov ebx eax)
+ (inst shl ebx 1)
+ (inst jmp :o bignum)
+ (inst shl ebx 1)
+ (inst jmp :o bignum)
+ (inst shl ebx 1)
+ (inst jmp :o bignum)
+ (inst ret)
+ BIGNUM
+
+ (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 1))
+ (storew eax ebx bignum-digits-offset other-pointer-lowtag))
+
+ (inst ret))
+
+#+sb-assembling ; We don't want a vop for this one either.
+(define-assembly-routine
+ (move-from-unsigned)
+ ((:temp eax unsigned-reg eax-offset)
+ (:temp ebx unsigned-reg ebx-offset))
+
+ (inst bsr ebx eax)
+ (inst cmp ebx 61)
+ (inst jmp :z DONE)
+ (inst jmp :ge BIGNUM)
+ ;; Fixnum
+ (inst mov ebx eax)
+ (inst shl ebx 3)
+ DONE
+ (inst ret)
+
+ BIGNUM
+ (with-fixed-allocation (ebx bignum-widetag (+ bignum-digits-offset 2))
+ (storew eax ebx bignum-digits-offset other-pointer-lowtag))
+ (inst ret))
+
+
Oops, something went wrong.

0 comments on commit 78fa16b

Please sign in to comment.