3
$Id: rulfix.scm,v 1.39 2008/01/30 20:01:50 cph Exp $
5
3
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
6
4
1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
7
2006, 2007, 2008 Massachusetts Institute of Technology
5
2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
9
7
This file is part of MIT/GNU Scheme.
482
480
(SAR W ,target (& ,scheme-type-width))
483
481
(IMUL W ,target ,temp))))))))
483
;;; This calls an out-of-line assembly hook because it requires a lot
484
;;; of hair to deal with shift counts that exceed the datum width, and
485
;;; with negative arguments.
485
487
(define-arithmetic-method 'FIXNUM-LSH fixnum-methods/2-args
487
(lambda (target source2)
488
;; SOURCE2 is guaranteed not to be ECX because of the
489
;; require-register! used below.
490
;; TARGET can be ECX only if the rule has machine register
491
;; ECX as the target, unlikely, but it must be handled!
494
(let ((jlabel (generate-label 'SHIFT-JOIN))
495
(slabel (generate-label 'SHIFT-NEGATIVE)))
496
(LAP (MOV W (R ,ecx) ,source2)
497
(SAR W (R ,ecx) (& ,scheme-type-width))
498
(JS B (@PCR ,slabel))
499
(SHL W ,target (R ,ecx))
500
(JMP B (@PCR ,jlabel))
503
(SHR W ,target (R ,ecx))
504
,@(word->fixnum target)
507
(if (not (equal? target (INST-EA (R ,ecx))))
509
(let ((temp (temporary-register-reference)))
510
(LAP (MOV W ,temp ,target)
512
(MOV W ,target ,temp))))))))
513
(lambda (target source1 source2 overflow?)
515
(require-register! ecx)
516
(two-arg-register-operation operate
488
(lambda (target source1 source2 overflow?)
490
;++ This is suboptimal in the cases when SOURCE1 is stored only in
491
;++ ecx or when SOURCE2 is stored only in eax, and either one is
492
;++ dead (which is often the case). In such cases, this generates
493
;++ code to needlessly save the dead pseudo-registers into their
494
;++ homes simply because they were stored in eax and ecx. It'd be
495
;++ nice to have a variant of LOAD-MACHINE-REGISTER! for multiple
496
;++ sources and targets, which would compute a parallel assignment
497
;++ using machine registers if available for temporaries, or the
498
;++ homes of pseudo-registers if not.
499
(let* ((load-eax (load-machine-register! source1 eax))
500
(load-ecx (load-machine-register! source2 ecx)))
501
(delete-dead-registers!)
502
(rtl-target:=machine-register! target eax)
505
;; Clearing the map is not necessary because the hook uses
506
;; only eax and ecx. If the hook were changed, it would be
507
;; necessary to clear the map first.
508
,@(invoke-hook/call entry:compiler-fixnum-shift)))))
522
510
(define (do-division target source1 source2 result-reg)
523
511
(prefix-instructions! (load-machine-register! source1 eax))
added
removed
src/compiler/machines/i386/rulfix.scm
