Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24737
Modified Files: primitive-functions.lisp Log Message: Starting to add some bignum support.
Date: Mon May 24 10:58:56 2004 Author: ffjeld
Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.17 movitz/losp/muerte/primitive-functions.lisp:1.18 --- movitz/losp/muerte/primitive-functions.lisp:1.17 Fri May 21 05:41:11 2004 +++ movitz/losp/muerte/primitive-functions.lisp Mon May 24 10:58:56 2004 @@ -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.17 2004/05/21 09:41:11 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.18 2004/05/24 14:58:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -441,8 +441,8 @@
(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 @@ 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 @@ (:globally (:movl (:edi (:edi-offset classes)) :ebx)) (:cmpl :edi :eax) (:je 'null) - (:movl (:ebx #.(movitz::class-object-offset 'illegal-object)) :eax) + (:movl (:ebx #.(movitz:class-object-offset 'illegal-object)) :eax) (:jmp 'not-null) null - (:movl (:ebx #.(movitz::class-object-offset 'null)) :eax) + (:movl (:ebx #.(movitz:class-object-offset 'null)) :eax) not-null (:ret)))
(define-primitive-function fast-class-of-other () "Return the class of an other object." - (with-inline-assembly (:returns :multiple-values) - (:movl (:eax #.movitz:+other-type-offset+) :ecx) - (:cmpb #.(movitz::tag :std-instance) :cl) - (:jne 'not-std-instance) - (:movl (:eax #.(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax) - (:ret) - not-std-instance - (:cmpw #.(cl:+ (movitz::tag :funobj) - (cl:ash (bt:enum-value 'movitz::movitz-funobj-type :generic-function) 8)) - :cx) - (:jne 'not-std-gf-instance) - (:movl (:eax #.(bt:slot-offset 'movitz::movitz-funobj-standard-gf 'movitz::standard-gf-class)) - :eax) - (:ret) - not-std-gf-instance - (:globally (:movl (:edi (:edi-offset complicated-class-of)) :esi)) - (:jmp (:esi #.(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op))))) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :multiple-values) + (:movl (:eax ,movitz:+other-type-offset+) :ecx) + (:cmpb ,(movitz:tag :std-instance) :cl) + (:jne 'not-std-instance) + (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax) + (:ret) + not-std-instance + (:cmpw ,(+ (movitz:tag :funobj) + (ash (bt:enum-value 'movitz::movitz-funobj-type :generic-function) 8)) + :cx) + (:jne 'not-std-gf-instance) + (:movl (:eax ,(bt:slot-offset 'movitz::movitz-funobj-standard-gf + 'movitz::standard-gf-class)) + :eax) + (:ret) + not-std-gf-instance + (:globally (:movl (:edi (:edi-offset classes)) :ebx)) + (:cmpb ,(movitz:tag :bignum) :cl) + (:jne 'not-bignum) + (:movl (:ebx ,(movitz:class-object-offset 'integer)) :eax) + (:ret) + not-bignum + (:globally (:movl (:edi (:edi-offset complicated-class-of)) :esi)) + (:jmp (:esi ,(bt:slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op)))))) + (do-it)))
(defun complicated-class-of (object) (typecase object