Commit deb98f82 authored by Frode Vatvedt Fjeld's avatar Frode Vatvedt Fjeld

Starting to add some bignum support.

parent 2d2a56f2
......@@ -8,7 +8,7 @@
;;;; Created at: Wed Oct 25 12:30:49 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: compiler.lisp,v 1.58 2004/04/21 15:06:16 ffjeld Exp $
;;;; $Id: compiler.lisp,v 1.59 2004/04/23 14:58:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -4786,12 +4786,9 @@ Return arg-init-code, need-normalized-ecx-p."
:provider provider))
(:untagged-fixnum-ecx
(case (result-mode-type desired-result)
((:eax :ebx :ecx :edx)
(values (append code `((:cmpl ,+movitz-most-positive-fixnum+ :ecx)
(:ja '(:sub-program ()
(:int 4)))
(:leal ((:ecx ,+movitz-fixnum-factor+) :edi ,(edi-offset))
,desired-result)))
((:eax :single-value)
(values (append code
`((:call (:edi ,(global-constant-offset 'normalize-u32-ecx)))))
desired-result))
(t (make-result-and-returns-glue desired-result :eax
(make-result-and-returns-glue :eax :untagged-fixnum-ecx code
......
......@@ -9,7 +9,7 @@
;;;; Created at: Sun Oct 22 00:22:43 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: image.lisp,v 1.28 2004/05/19 14:59:52 ffjeld Exp $
;;;; $Id: image.lisp,v 1.29 2004/05/21 09:38:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -226,6 +226,11 @@
:map-binary-write 'movitz-intern-code-vector
:map-binary-read-delayed 'movitz-word-code-vector
:binary-tag :primitive-function)
(normalize-u32-ecx
:binary-type code-vector-word
:map-binary-write 'movitz-intern-code-vector
:map-binary-read-delayed 'movitz-word-code-vector
:binary-tag :primitive-function)
(malloc
:binary-type code-vector-word
:map-binary-write 'movitz-intern-code-vector
......@@ -543,6 +548,7 @@
(defmethod image-classes-map ((image symbolic-image))
'(muerte.cl:null muerte.cl:cons muerte.cl:fixnum muerte.cl:symbol
muerte.cl:character muerte.cl:function muerte.cl:condition
muerte.cl:integer muerte.cl:ratio
muerte.cl:vector muerte.cl:string muerte.cl:array
muerte.cl:class muerte.cl:standard-class
muerte.cl:standard-generic-function
......@@ -553,9 +559,10 @@
muerte:illegal-object))
(defun class-object-offset (name)
(+ (bt:slot-offset 'movitz-vector 'data)
(* 4 (1+ (or (position name (image-classes-map *image*))
(error "No class named ~S in class-map." name))))))
(let ((name (translate-program name :cl :muerte.cl)))
(+ (bt:slot-offset 'movitz-vector 'data)
(* 4 (1+ (or (position name (image-classes-map *image*))
(error "No class named ~S in class-map." name)))))))
(defun unbound-value ()
(declare (special *image*))
......@@ -1361,7 +1368,7 @@ this image will not be Multiboot compatible."
(null *movitz-nil*)
((member t) (movitz-read 'muerte.cl:t))
(symbol (intern-movitz-symbol expr))
(integer (make-movitz-fixnum expr))
(integer (make-movitz-integer expr))
(character (make-movitz-character expr))
(string (or (gethash expr (image-string-constants *image*))
(setf (gethash expr (image-string-constants *image*))
......
......@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Sat Feb 21 17:48:32 2004
;;;;
;;;; $Id: los0-gc.lisp,v 1.9 2004/04/15 15:23:31 ffjeld Exp $
;;;; $Id: los0-gc.lisp,v 1.10 2004/04/16 14:44:42 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -72,6 +72,33 @@
(:movl :ecx (:edx 2))
(:ret)))
(define-primitive-function los0-normalize-u32-ecx ()
"Make u32 in ECX into a fixnum or bignum."
(macrolet
((do-it ()
`(with-inline-assembly (:returns :multiple-values)
(:cmpl ,movitz:+movitz-most-positive-fixnum+ :ecx)
(:ja 'not-fixnum)
(:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)
(:ret)
not-fixnum
retry-cons
(:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
(:movl (:edx 2) :eax)
(:cmpl #x3fff4 :eax)
(:jge '(:sub-program ()
(:int 113) ; This interrupt can be retried.
(:jmp 'retry-cons)))
(:movl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0))
(:edx :eax 2))
(:movl :ecx (:edx :eax 6))
(:addl 8 :eax)
(:movl :eax (:edx 2))
(:leal (:edx :eax) :eax)
(:ret)
(:int 107))))
(do-it)))
(defun los0-malloc-clumps (clumps)
(check-type clumps (integer 0 4000))
(with-inline-assembly (:returns :eax)
......@@ -130,6 +157,10 @@
(check-type conser vector)
(setf (%run-time-context-slot 'muerte::fast-cons)
conser))
(let ((conser (symbol-value 'los0-normalize-u32-ecx)))
(check-type conser vector)
(setf (%run-time-context-slot 'muerte::normalize-u32-ecx)
conser))
(let ((old-malloc (symbol-function 'muerte:malloc-clumps)))
(setf (symbol-function 'muerte:malloc-clumps)
(symbol-function 'los0-malloc-clumps))
......
......@@ -9,7 +9,7 @@
;;;; Created at: Fri Dec 1 18:08:32 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: los0.lisp,v 1.12 2004/04/23 13:00:08 ffjeld Exp $
;;;; $Id: los0.lisp,v 1.13 2004/04/23 15:04:07 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -263,6 +263,24 @@
(warn "exited: ~S" c)))
(defun test-bignum ()
123456789123456)
(defun ff32 ()
#xffffffff)
(defun one32 ()
#x100000000)
(defun test-nbignum ()
-123456789123456)
(defun gt5 (x)
(<= x 5))
(defun xplus (x)
(typep x '(integer 0 *)))
(defstruct xxx
x y (z 'init-z))
......
......@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Sun Feb 11 23:14:04 2001
;;;;
;;;; $Id: arrays.lisp,v 1.19 2004/05/20 17:41:46 ffjeld Exp $
;;;; $Id: arrays.lisp,v 1.20 2004/05/21 09:41:58 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -204,34 +204,34 @@
(:shrl ,movitz:+movitz-fixnum-shift+ :ebx)
(:movzxw (:eax ,movitz:+other-type-offset+) :ecx)
(:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx)
(:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx)
(:jae '(:sub-program ()
(:compile-form (:result-mode :ignore)
(error "Index ~D out of bounds ~D." index (length vector)))))
(:cmpl #.(movitz:vector-type-tag :any-t) :ecx)
(:cmpl ,(movitz:vector-type-tag :any-t) :ecx)
(:jne 'not-any-t)
(:movl (:eax (:ebx 4) 2) :eax)
(:jmp 'done)
not-any-t
(:cmpl #.(movitz:vector-type-tag :character) :ecx)
(:cmpl ,(movitz:vector-type-tag :character) :ecx)
(:jne 'not-character)
(:movb (:eax :ebx 2) :bl)
(:xorl :eax :eax)
(:movb :bl :ah)
(:movb #.(movitz::tag :character) :al) ; character
(:movb ,(movitz::tag :character) :al) ; character
(:jmp 'done)
not-character
(:cmpl #.(movitz:vector-type-tag :u8) :ecx)
(:cmpl ,(movitz:vector-type-tag :u8) :ecx)
(:jne 'not-u8)
(:movzxb (:eax :ebx 2) :eax) ; u8
(:shll #.movitz::+movitz-fixnum-shift+ :eax)
(:shll ,movitz::+movitz-fixnum-shift+ :eax)
(:jmp 'done)
not-u8
(:cmpl #.(movitz:vector-type-tag :u16) :ecx)
(:cmpl ,(movitz:vector-type-tag :u16) :ecx)
(:jne 'not-u16)
(:movzxw (:eax (:ebx 2) 2) :eax) ; u16
(:jmp 'done)
......@@ -265,7 +265,7 @@
(:compile-form (:result-mode :ebx) value)
(:compile-form (:result-mode :eax) vector)
(:leal (:eax #.(cl:- (movitz::tag :other))) :ecx)
(:leal (:eax ,(- (movitz:tag :other))) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program ()
(:compile-form (:result-mode :ignore)
......@@ -273,24 +273,24 @@
(:movzxw (:eax ,movitz:+other-type-offset+) :edx)
(:compile-form (:result-mode :ecx) index)
(:testb #.movitz::+movitz-fixnum-zmask+ :cl)
(:testb ,movitz::+movitz-fixnum-zmask+ :cl)
(:jnz '(:sub-program () (:int 107))) ; index not fixnum
(:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx)
(:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
(:andl ,(ash #xffff movitz::+movitz-fixnum-shift+) :ecx)
(:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
(:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx)
(:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx)
(:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds
(:cmpl #.(movitz:vector-type-tag :any-t) :edx)
(:cmpl ,(movitz:vector-type-tag :any-t) :edx)
(:jnz 'not-any-t)
(:movl :ebx (:eax (:ecx 4) 2))
(:jmp 'done)
not-any-t
(:cmpl #.(movitz:vector-type-tag :character) :edx)
(:cmpl ,(movitz:vector-type-tag :character) :edx)
(:jnz 'not-character)
(:cmpb #.(movitz:tag :character) :bl)
(:cmpb ,(movitz:tag :character) :bl)
(:jnz '(:sub-program (not-character-value)
(:compile-form (:result-mode :ignore)
(error "Value not character: ~S" value))))
......@@ -298,40 +298,46 @@
(:jmp 'done)
not-character
(:cmpl #.(movitz:vector-type-tag :u8) :edx)
(:cmpl ,(movitz:vector-type-tag :u8) :edx)
(:jnz 'not-u8)
(:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx)
(:testl ,(cl:ldb (cl:byte 32 0)
(- -1 (* #xff movitz:+movitz-fixnum-factor+)))
:ebx)
(:jnz '(:sub-program (not-u8-value)
(:compile-form (:result-mode :ignore)
(error "Value not (unsigned-byte 8): ~S" value))))
(:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
(:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ebx)
(:movb :bl (:eax (:ecx 1) ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx ,movitz:+movitz-fixnum-factor+)) :ebx)
(:jmp 'done)
not-u8
(:cmpl #.(movitz:vector-type-tag :u16) :edx)
(:cmpl ,(movitz:vector-type-tag :u16) :edx)
(:jnz 'not-u16)
(:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx)
(:testl ,(ldb (byte 32 0)
(- -1 (* #xffff movitz:+movitz-fixnum-factor+)))
:ebx)
(:jnz '(:sub-program (not-u16-value)
(:compile-form (:result-mode :ignore)
(error "Value not (unsigned-byte 16): ~S" value))))
(:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
(:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ebx)
(:movw :bx (:eax (:ecx 2) ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx ,movitz:+movitz-fixnum-factor+)) :ebx)
(:jmp 'done)
not-u16
(:cmpl #.(movitz:vector-type-tag :u32) :edx)
(:cmpl ,(movitz:vector-type-tag :u32) :edx)
(:jnz 'not-u32)
(:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx)
(:testl ,(ldb (byte 32 0)
(- -1 (* #xffffffff movitz:+movitz-fixnum-factor+)))
:ebx)
(:jnz '(:sub-program (not-u32-value)
(:compile-form (:result-mode :ignore)
(error "Value not (unsigned-byte 32): ~S" value))))
(:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
(:movl :ebx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ebx)
(:movl :ebx (:eax (:ecx 4) ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
(:leal ((:ebx ,movitz:+movitz-fixnum-factor+)) :ebx)
(:jmp 'done)
not-u32
......
......@@ -9,7 +9,7 @@
;;;; Created at: Wed Nov 8 18:44:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
;;;; $Id: integers.lisp,v 1.9 2004/05/19 15:09:05 ffjeld Exp $
;;;; $Id: integers.lisp,v 1.10 2004/05/19 15:42:08 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -22,6 +22,12 @@
(defconstant most-positive-fixnum #.movitz::+movitz-most-positive-fixnum+)
(defconstant most-negative-fixnum #.movitz::+movitz-most-negative-fixnum+)
(deftype positive-fixnum ()
`(integer 0 ,movitz:+movitz-most-positive-fixnum+))
(deftype positive-bignum ()
`(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *))
(defun fixnump (x)
(typep x 'fixnum))
......@@ -242,10 +248,26 @@
"Compare real <n1> with fixnum <n2>."
(with-inline-assembly (:returns :nothing) ; unspecified
(:testb #.movitz::+movitz-fixnum-zmask+ :al)
(:jnz 'not-fixnum)
(:cmpl :ebx :eax)
(:ret)
not-fixnum
(:leal (:eax #.(cl:- (movitz:tag :other))) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program (not-integer)
(:int 107)
(:jmp 'not-integer)))
(:cmpl :ebx :eax)
(:movl (:eax #.movitz:+other-type-offset+) :ecx)
(:cmpw #.(movitz:tag :bignum 0) :cx)
(:jne 'not-plusbignum)
;; compare ebx with something bigger
(:cmpl #x-10000000 :edi)
(:ret)
not-plusbignum
(:cmpw #.(movitz:tag :bignum #xff) :cx)
(:jne 'not-integer)
;; compare ebx with something bigger
(:cmpl #x10000000 :edi)
(:ret)))
;;;
......@@ -256,8 +278,8 @@
(movitz:movitz-constantp max env))
(let ((min (movitz:movitz-eval min env))
(max (movitz:movitz-eval max env)))
(check-type min integer)
(check-type max integer)
(check-type min fixnum)
(check-type max fixnum)
;; (warn "~D -- ~D" min max)
(cond
((movitz:movitz-constantp x env)
......@@ -296,7 +318,7 @@
#+ignore ; this is buggy.
((movitz:movitz-constantp min env)
(let ((min (movitz:movitz-eval min env)))
(check-type min integer)
(check-type min fixnum)
(cond
((minusp min)
`(let ((x ,x))
......@@ -372,7 +394,7 @@
(declare (dynamic-extent more-numbers))
(cond
((null more-numbers)
(check-type number integer)
(check-type number fixnum)
t)
((not (cdr more-numbers))
(,2op-name number (first more-numbers)))
......@@ -514,7 +536,7 @@
(if (< number1 number2)
number2 number1))
(let ((label (gensym)))
`(with-inline-assembly (:returns :eax :type integer)
`(with-inline-assembly (:returns :eax :type fixnum)
(:compile-two-forms (:eax :ebx) ,number1 ,number2)
(:movl :ebx :ecx)
(:orl :eax :ecx)
......@@ -650,7 +672,7 @@
`(*%2op ,(movitz:movitz-eval factor2 env) ,factor1))
((movitz:movitz-constantp factor1 env)
(let ((f1 (movitz:movitz-eval factor1 env)))
(check-type f1 integer)
(check-type f1 fixnum)
(case f1
(0 `(progn ,factor2 0))
(1 factor2)
......@@ -708,9 +730,9 @@
`(do-result-mode-case ()
(:plural
(no-macro-call ,@form))
(t (truncate%2ops%1ret ,number ,divisor))))
(t (truncate%1ret ,number ,divisor))))
(defun truncate%2ops%1ret (number divisor)
(defun truncate%1ret (number divisor)
(with-inline-assembly (:returns :multiple-values)
(:compile-form (:result-mode :eax) number)
(:compile-form (:result-mode :ebx) divisor)
......@@ -723,7 +745,7 @@
(:shll #.movitz::+movitz-fixnum-shift+ :eax)
(:clc)))
(define-compiler-macro truncate%2ops%1ret (&whole form &environment env number divisor)
(define-compiler-macro truncate%1ret (&whole form &environment env number divisor)
(cond
((movitz:movitz-constantp divisor env)
(let ((d (movitz:movitz-eval divisor env)))
......@@ -731,7 +753,7 @@
(case d
(0 (error "Truncate by zero."))
(1 number)
(t `(with-inline-assembly (:returns :eax :type integer)
(t `(with-inline-assembly (:returns :eax :type fixnum)
(:compile-form (:result-mode :eax) ,number)
(:compile-form (:result-mode :ebx) ,divisor)
(:testb #.movitz::+movitz-fixnum-zmask+ :al)
......@@ -741,26 +763,116 @@
(:shll #.movitz::+movitz-fixnum-shift+ :eax))))))
(t form)))
(defmacro number-double-dispatch ((x y) &rest clauses)
`(let ((x ,x) (y ,y))
(cond ,@(loop for ((x-type y-type) . then-body) in clauses
collect `((and (typep x ',x-type) (typep y ',y-type))
,@then-body))
(t (error "Not numbers: ~S or ~S." x y)))))
(defun truncate (number &optional (divisor 1))
(numargs-case
(1 (number)
(values number 0))
(t (number divisor)
(with-inline-assembly (:returns :multiple-values)
(:compile-form (:result-mode :eax) number)
(:compile-form (:result-mode :ebx) divisor)
(:movl :eax :ecx)
(:orl :ebx :ecx)
(:testb #.movitz::+movitz-fixnum-zmask+ :cl)
(:jnz '(:sub-program (not-integer) (:int 107)))
(:cdq :eax :edx)
(:idivl :ebx :eax :edx)
(:shll #.movitz::+movitz-fixnum-shift+ :eax)
(:movl :edx :ebx)
(:xorl :ecx :ecx)
(:movb 2 :cl) ; return values: qutient, remainder.
(:stc)))))
(number-double-dispatch (number divisor)
((fixnum fixnum)
(with-inline-assembly (:returns :multiple-values)
(:compile-form (:result-mode :eax) number)
(:compile-form (:result-mode :ebx) divisor)
(:std)
(:cdq :eax :edx)
(:idivl :ebx :eax :edx)
(:shll #.movitz::+movitz-fixnum-shift+ :eax)
(:cld)
(:movl :edx :ebx)
(:xorl :ecx :ecx)
(:movb 2 :cl) ; return values: qutient, remainder.
(:stc)))
((positive-bignum positive-fixnum)
(let (r n)
(with-inline-assembly (:returns :multiple-values)
(:compile-form (:result-mode :ebx) number)
(:movzxw (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx)
(:cmpl 1 :ecx)
(:jne 'not-size1)
(:compile-form (:result-mode :ecx) divisor)
(:shrl #.movitz:+movitz-fixnum-shift+ :ecx)
(:std)
(:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax)
(:xorl :edx :edx)
(:divl :ecx :eax :edx)
(:movl :eax :ecx)
(:shll #.movitz:+movitz-fixnum-shift+ :edx)
(:movl :edi :eax)
(:cld)
(:pushl :edx)
(:call-global-constant normalize-u32-ecx)
(:popl :ebx)
(:jmp 'done)
not-size1
(:cmpl 2 :ecx)
(:jne 'not-size2)
(:compile-form (:result-mode :ecx) divisor)
(:shrl #.movitz:+movitz-fixnum-shift+ :ecx)
(:std)
(:movl (:ebx #.(cl:+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)))
:edx)
(:cmpl :ecx :edx)
(:jae 'not-size2)
(:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax)
(:divl :ecx :eax :edx)
(:movl :eax :ecx)
(:shll #.movitz:+movitz-fixnum-shift+ :edx)
(:movl :edi :eax)
(:cld)
(:pushl :edx)
(:call-global-constant normalize-u32-ecx)
(:popl :ebx)
(:jmp 'done)
not-size2
(:cmpl :ecx (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)
-4 (:ecx 4)))
(:jc 'shrink-not-size2)
not-shrink
(:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax)
(:compile-form (:result-mode :eax)
(malloc-words (with-inline-assembly (:returns :eax))))
(:store-lexical (:lexical-binding r) :eax :type t)
(:compile-form (:result-mode :ebx) number)
(:movl (:ebx #.movitz:+other-type-offset+) :ecx)
(:movl :ecx (:eax #.movitz:+other-type-offset+))
(:shrl 16 :ecx)
(:xorl :edx :edx) ; edx=hi-digit=0
; eax=lo-digit=msd(number)
(:std)
(:compile-form (:result-mode :esi) divisor)
(:shrl #.movitz:+movitz-fixnum-shift+ :esi)
divide-loop
(:load-lexical (:lexical-binding number) :ebx)
(:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)
-4 (:ecx 4))
:eax)
(:divl :esi :eax :edx)
(:load-lexical (:lexical-binding r) :ebx)
(:movl :eax (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)
-4 (:ecx 4)))
(:subl 1 :ecx)
(:jnz 'divide-loop)
(:movl :ebx :eax)
(:leal ((:edx #.movitz:+movitz-fixnum-factor+)) :ebx)
(:movl :edi :edx)
(:movl (:ebp -4) :esi)
(:cld)
(:jmp 'done)
shrink-not-size2
(:int 107)
done
(:movl 2 :ecx)
(:stc))))
))))
(defun round (number &optional (divisor 1))
"Mathematical rounding."
......@@ -1147,4 +1259,4 @@
(values q 0))
(t (values (1- q) (+ r divisor))))))
(t (n &optional (divisor 1))
(floor n divisor))))
\ No newline at end of file
(floor n divisor))))
......@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Tue Jul 23 14:29:10 2002
;;;;
;;;; $Id: los-closette.lisp,v 1.9 2004/04/19 22:38:27 ffjeld Exp $
;;;; $Id: los-closette.lisp,v 1.10 2004/04/21 15:07:27 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -908,7 +908,7 @@ for a slot at position i.")
(assert slot (slot-name)
"No slot named ~S in class ~S." slot-name class)
(let ((slot-location (slot-definition-location slot)))
(check-type slot-location (integer 0 *))
(check-type slot-location (integer 0 #xffff))
(etypecase class
(standard-class
(if (and (< slot-location (length *standard-effective-slot-readers*))
......
......@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org>
;;;; Created at: Tue Oct 2 21:02:18 2001
;;;;
;;;; $Id: primitive-functions.lisp,v 1.16 2004/04/21 15:08:36 ffjeld Exp $
;;;; $Id: primitive-functions.lisp,v 1.17 2004/05/21 09:41:11 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
......@@ -441,8 +441,8 @@ Returns list in EAX and preserves numargs in ECX."
(defun malloc-initialize (buffer-start buffer-size)
"BUFFER-START: the (fixnum) 4K address. BUFFER-SIZE: The size in 4K units."
(check-type buffer-start integer)
(check-type buffer-size integer)
(check-type buffer-start fixnum)
(check-type buffer-size fixnum)
(with-inline-assembly (:returns :nothing)
(:compile-form (:result-mode :eax) buffer-start)
(:shll #.(cl:- 12 movitz::+movitz-fixnum-shift+) :eax)
......@@ -504,6 +504,17 @@ Returns list in EAX and preserves numargs in ECX."
return-ok
(:ret)))
(define-primitive-function normalize-u32-ecx ()
"Make u32 in ECX into a fixnum or bignum."
(with-inline-assembly (:returns :multiple-values)
(:cmpl #.movitz:+movitz-most-positive-fixnum+ :ecx)
(:ja 'not-fixnum)
(:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax)
(:ret)
not-fixnum
(:int 107))) ; not implemented by default!
;;;;
(define-primitive-function fast-class-of-even-fixnum ()
......@@ -566,32 +577,42 @@ Returns list in EAX and preserves numargs in ECX."
(:globally (:movl (:edi (:edi-offset classes)) :ebx))
(:cmpl :edi :eax)
(:je 'null)