Commit 5ced0fdf authored by ram's avatar ram
Browse files

source kit 1.03.7

parent c0c98ded
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/alloc.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; Stuff to handle allocating simple objects.
;;;
;;; Written by William Lott.
;;;
;;; Debugged by Paul F. Werkowski -- Spring 1995.
;;;
(in-package :x86)
;;;; From from signed/unsigned
#+assembler ; we don't want a vop for this one.
(define-assembly-routine
(move-from-signed)
((:temp eax dword-reg eax-offset)
(:temp ebx dword-reg ebx-offset)
(:temp ecx dword-reg ecx-offset))
(inst mov ebx eax)
(inst shl ebx 1)
(inst jmp :o bignum)
(inst shl ebx 1)
(inst jmp :o bignum)
(inst ret)
BIGNUM
(with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
(storew eax ebx bignum-digits-offset other-pointer-type))
(inst ret))
#+assembler ; we don't want a vop for this one either.
(define-assembly-routine
(move-from-unsigned)
((:temp eax dword-reg eax-offset)
(:temp ebx dword-reg ebx-offset)
(:temp ecx dword-reg ecx-offset))
(inst test eax #xe0000000)
(inst jmp :nz bignum)
;; Fixnum
(inst mov ebx eax)
(inst shl ebx 2)
(inst ret)
BIGNUM
(inst jmp :ns one-word-bignum)
(inst mov ebx eax)
;; Two word bignum
(with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 2))
(storew eax ebx bignum-digits-offset other-pointer-type))
(inst ret)
ONE-WORD-BIGNUM
(with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
(storew eax ebx bignum-digits-offset other-pointer-type))
(inst ret))
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; Stuff to handle simple cases for generic arithmetic.
;;;
;;; Written by William Lott.
;;; Debugged by Paul Werkowski -- Spring/Summer 1995.
;;;
(in-package :x86)
(eval-when (compile eval)
;;;; Addition, Subtraction, and Multiplication
(defmacro define-generic-arith-routine ((fun cost) &body body)
`(define-assembly-routine (,(symbolicate "GENERIC-" fun)
(:cost ,cost)
(:return-style :full-call)
(:translate ,fun)
(:policy :safe)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg)
;; this seems wrong esi-offset
edi-offset)
(:res res (descriptor-reg any-reg) edx-offset)
(:temp eax dword-reg eax-offset)
(:temp ebx dword-reg ebx-offset)
(:temp ecx dword-reg ecx-offset))
;; for now, pass this off
;; (inst jmp DO-STATIC-FUN)
;; ebx ; ignorable
(inst test x 3) ; fixnum?
(inst jmp :nz DO-STATIC-FUN) ; no - do generic
(inst test y 3) ; fixnum?
(inst jmp :z DO-BODY) ; yes - doit here
DO-STATIC-FUN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
(inst sub esp-tn (fixnum 3)) ; pw -- was 2
(inst push eax) ; callers return addr
(inst mov ecx (fixnum 2)) ; arg count
(inst mov ebx
(make-ea :dword
:disp (+ nil-value (static-function-offset
',(symbolicate "TWO-ARG-" fun)))))
(inst jmp ebx)
DO-BODY
,@body))
); eval-when
(define-generic-arith-routine (+ 10)
(move res x)
(inst add res y)
(inst jmp :no OKAY)
(inst rcr res 1) ; carry has correct sign
(inst sar res 1) ; remove type bits
(move ecx res)
(with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-type))
OKAY)
(define-generic-arith-routine (- 10)
;;; I can't figure out the flags on subtract. Overflow never gets
;;; set and carry always does. (- 0 most-negative-fixnum) can't be
;;; easily detected so just let the upper level stuff do it.
(inst jmp DO-STATIC-FUN)
(move res x)
(inst sub res y)
(inst jmp :no OKAY)
(inst rcr res 1)
(inst sar res 1) ; remove type bits
(move ecx res)
(with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-type))
OKAY)
(define-generic-arith-routine (* 30)
(move eax x) ; must use eax for 64-bit result
(inst sar eax 2) ; remove *4 fixnum bias
(inst imul y) ; result in edx:eax
(inst jmp :no okay) ; still fixnum
;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
;; pfw says that loses big -- edx is target for arg x and result res
;; note that 'edx' is not defined -- using x
(inst shrd eax x 2) ; high bits from edx
(inst sar x 2) ; now shift edx too
(move ecx x) ; save high bits from cdq
(inst cdq) ; edx:eax <- sign-extend of eax
(inst cmp x ecx)
(inst jmp :e SINGLE-WORD-BIGNUM)
(with-fixed-allocation (res ebx bignum-type (+ bignum-digits-offset 2))
(storew eax res bignum-digits-offset other-pointer-type)
(storew ecx res (1+ bignum-digits-offset) other-pointer-type))
(inst jmp DONE)
SINGLE-WORD-BIGNUM
(with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
(storew eax res bignum-digits-offset other-pointer-type))
(inst jmp DONE)
OKAY
(move res eax)
DONE)
(define-assembly-routine (generic-negate
(:cost 10)
(:return-style :full-call)
(:policy :safe)
(:translate %negate)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:res res (descriptor-reg any-reg) edx-offset)
(:temp eax dword-reg eax-offset)
(:temp ecx dword-reg ecx-offset))
(inst test x 3)
(inst jmp :z FIXNUM)
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
(inst sub esp-tn (fixnum 3)) ; pw -- was 2
(inst push eax)
(inst mov ecx (fixnum 1)) ; arg count
(inst mov eax (make-ea
:dword
:disp (+ nil-value (static-function-offset '%negate))))
(inst jmp eax)
FIXNUM
(move res x)
(inst neg res) ; (- most-negative-fixnum) is BIGNUM
(inst jmp :no OKAY)
(inst shr res 2) ; sign bit is data - remove type bits
(move ecx res)
(with-fixed-allocation (res eax bignum-type (1+ bignum-digits-offset))
(storew ecx res bignum-digits-offset other-pointer-type))
OKAY)
;;;; Comparison routines.
(eval-when (compile eval)
(defmacro define-cond-assem-rtn (name translate static-fn test)
`(define-assembly-routine (,name
(:cost 10)
(:return-style :full-call)
(:policy :safe)
(:translate ,translate)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg)
#+nil esi-offset
edi-offset)
(:res res descriptor-reg edx-offset)
(:temp eax dword-reg eax-offset)
(:temp ecx dword-reg ecx-offset)
)
(inst test x 3)
(inst jmp :nz DO-STATIC-FN)
(inst test y 3)
(inst jmp :z DO-COMPARE)
DO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
(inst sub esp-tn (fixnum 3)) ; pw -- was 2
(inst push eax)
(inst mov ecx (fixnum 2))
(inst mov eax (make-ea
:dword
:disp (+ nil-value (static-function-offset ',static-fn))))
(inst jmp eax)
DO-COMPARE
(inst cmp x y)
(inst jmp ,test TRUE)
(inst mov res nil-value)
(inst pop eax)
(inst add eax 2)
(inst jmp eax)
TRUE
(inst mov res t-value)))
); eval-when
(define-cond-assem-rtn generic-< < two-arg-< :l)
(define-cond-assem-rtn generic-> > two-arg-> :g)
#+pfw-obsolete????
(define-assembly-routine (generic-eql
(:cost 10)
(:return-style :full-call)
(:policy :safe)
(:translate eql)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg) esi-offset)
(:res res descriptor-reg edx-offset)
(:temp eax dword-reg eax-offset) ; zzz added by jrd
(:temp ecx dword-reg ecx-offset) ; zzz added by jrd
)
(inst cmp x y)
(inst jmp :e RETURN-T)
(inst test x 3)
(inst jmp :z RETURN-NIL)
(inst test y 3)
(inst jmp :nz DO-STATIC-FN)
RETURN-NIL
(inst mov res nil-value)
(inst pop eax)
(inst add eax 2)
(inst jmp eax)
DO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
(inst sub esp-tn (fixnum 3)) ; pw -- was 2
(inst push eax)
(inst mov ecx (fixnum 2))
(inst mov eax (make-ea :dword
:disp (+ nil-value
(static-function-offset 'two-arg-eql))))
(inst jmp eax)
RETURN-T
(inst mov res t-value))
(define-assembly-routine (generic-=
(:cost 10)
(:return-style :full-call)
(:policy :safe)
(:translate =)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg)
#+nil esi-offset
edi-offset)
(:res res descriptor-reg edx-offset)
(:temp eax dword-reg eax-offset)
(:temp ecx dword-reg ecx-offset)
)
(inst test x 3) ; descriptor?
(inst jmp :nz DO-STATIC-FN) ; yes do it here
(inst test y 3) ; descriptor?
(inst jmp :nz DO-STATIC-FN)
(inst cmp x y)
(inst jmp :e RETURN-T) ; ok
(inst mov res nil-value)
(inst pop eax)
(inst add eax 2)
(inst jmp eax)
DO-STATIC-FN
(inst pop eax)
(inst push ebp-tn)
(inst lea ebp-tn (make-ea :dword :base esp-tn :disp word-bytes))
(inst sub esp-tn (fixnum 3)) ; pw -- was 2
(inst push eax)
(inst mov ecx (fixnum 2))
(inst mov eax (make-ea
:dword
:disp (+ nil-value (static-function-offset 'two-arg-=))))
(inst jmp eax)
RETURN-T
(load-symbol res t))
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; This file contains various array operations that are too expensive
;;; (in space) to do inline.
;;;
;;; Written by William Lott.
;;;
;;; Debugged by Paul F. Werkowski -- Spring 1995.
;;;
(in-package :x86)
;;;; Allocation
(define-assembly-routine (allocate-vector
(:policy :fast-safe)
(:translate allocate-vector)
(:arg-types positive-fixnum
positive-fixnum
positive-fixnum))
((:arg type unsigned-reg eax-offset)
(:arg length any-reg ebx-offset)
(:arg words any-reg ecx-offset)
(:res result descriptor-reg edx-offset)
(:temp alloc dword-reg edi-offset))
#-cgc
(with-allocation (alloc)
(inst lea result (make-ea :byte :base alloc :disp other-pointer-type))
(inst add alloc
(+ (1- (ash 1 lowtag-bits)) (* vector-data-offset word-bytes)))
(inst add alloc words)
(inst and alloc (lognot vm:lowtag-mask)))
#+cgc
(progn
(inst mov alloc (+ (1- (ash 1 lowtag-bits))
(* vector-data-offset word-bytes)))
(inst add alloc words)
(inst and alloc (lognot vm:lowtag-mask))
(with-cgc-allocation(alloc alloc)
(inst lea result (make-ea :byte :base alloc :disp other-pointer-type))))
(storew type result 0 other-pointer-type)
(storew length result vector-length-slot other-pointer-type)
(inst ret))
;;;; Hash primitives
(define-assembly-routine (sxhash-simple-string
(:translate %sxhash-simple-string)
(:policy :fast-safe)
(:result-types positive-fixnum))
((:arg string descriptor-reg ebx-offset)
(:res result any-reg edx-offset)
(:temp length any-reg edi-offset)
(:temp esi dword-reg esi-offset)
(:temp ecx dword-reg ecx-offset)
(:temp eax dword-reg eax-offset))
(declare (ignore result esi ecx eax))
(loadw length string vector-length-slot other-pointer-type)
;; zzzzz this appears to be busted
;; (inst jmp nil (make-fixup 'sxhash-simple-substring :assembly-routine))
;; just fall through???
)
(define-assembly-routine (sxhash-simple-substring
(:translate %sxhash-simple-substring)
(:policy :fast-safe)
(:arg-types * positive-fixnum)
(:result-types positive-fixnum))
((:arg string descriptor-reg ebx-offset)
(:arg length any-reg edi-offset)
(:res result any-reg edx-offset)
(:temp esi dword-reg esi-offset)
(:temp ecx dword-reg ecx-offset)
(:temp eax dword-reg eax-offset))
;; Compute a pointer to where we are going to be extracting the bits.
(inst lea esi
(make-ea :byte :base string
:disp (- (* vector-data-offset word-bytes)
other-pointer-type)))
;; Initialize the result.
(inst mov result 0)
;; Get the count. If it's zero, blow out.
(inst mov ecx length)
(inst jecxz done)
;; Convert it into count of the number of full words. If zero, then skip
;; to the part that handles the tail.
(inst shr ecx 4)
(inst jecxz do-extra)
;; Clear the direction flag, so we advance through memory.
(inst cld)
LOOP
;; Merge each successive word with the result.
;; ZZZZZ undef inst???
(inst lods eax) ; load 32-bits into eax and (+4 esi)
(inst rol result 5)
(inst xor result eax)
(inst loop loop)
DO-EXTRA
;; Now we have to take care of any bytes that don't make up a full word.
;; First, check to see how many of them there are. If zero, blow out of
;; here. Otherwise, multiply by 8.
(inst mov ecx length)
(inst and ecx (fixnum 3))
(inst jecxz done)
(inst shl ecx 1)
;; Grab the last word.
;; ZZZZZ undef isnt?
(inst lods eax)
;; Convert the count into a mask. The count is multiplied by 8, so we just
;; shift -1 left, which shifts count*8 zeros into the low order end. We
;; then invert that, ending up with a mask of count*8 ones.
(inst mov esi -1)
(inst shl esi :cl)
(inst not esi)
;; Use the mask to strip off the bits we arn't interested in, and merge
;; the remaining bits with the result.
(inst and eax esi)
(inst rol result 5)
(inst xor result eax)
DONE
;; Force result to be a positive fixnum.
(inst and result #x7ffffffc)
(inst ret))
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; This file contains the machine specific support routines needed by
;;; the file assembler.
;;;
;;; Written by William Lott
;;;
;;; Debugged by Paul F. Werkowski -- Spring/Summer 1995.
;;;
(in-package :x86)
;;;; Return-multiple
;;; For return-multiple, we have to move the results from the end of the
;;; frame for the function that is returning to the end of the frame for
;;; the function being returned to.
#+assembler ;; we don't want a vop for this one.
(define-assembly-routine
(return-multiple (:return-style :none))
(;; These four are really arguments.
(:temp eax dword-reg eax-offset)
(:temp ebx dword-reg ebx-offset)
(:temp ecx dword-reg ecx-offset)
(:temp esi dword-reg esi-offset)
;; These we need as temporaries.
(:temp edx dword-reg edx-offset)
(:temp edi dword-reg edi-offset))
;; Pick off the cases where everything fits in register args.
(inst jecxz zero-values)
(inst cmp ecx (fixnum 1))
(inst jmp :e one-value)
(inst cmp ecx (fixnum 2))
(inst jmp :e two-values)
(inst cmp ecx (fixnum 3))
(inst jmp :e three-values)
;; Save the count, because the loop is going to destroy it.
(inst mov edx ecx)
;; Blit the values down the stack. Note: there might be overlap, so we have
;; to be careful not to clobber values before we've read them. Because the
;; stack builds down, we are coping to a larger address. Therefore, we need
;; to iterate from larger addresses to smaller addresses.
;; pfw-this says copy ecx words from esi to edi counting down.
(inst shr ecx 2) ; fixnum to raw word count
(inst std) ; count down
(inst sub esi 4) ; ?
(inst lea edi (make-ea :dword :base ebx :disp (- word-bytes)))
(inst rep)
(inst movs :dword)
;; Restore the count.
(inst mov ecx edx)
;; Set the stack top to the last result.
(inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))
;; Load the register args.
(loadw edx ebx -1)
(loadw edi ebx -2)
(loadw esi ebx -3)
;; And back we go.
(inst jmp eax)