Changeset 13155


Ignore:
Timestamp:
01/17/11 22:07:31 (11 years ago)
Author:
ehuelsmann
Message:

Allocate registers based on the representation requested,
don't use two different functions to allocate.

Location:
branches/unsafe-p-removal/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r13154 r13155  
    345345                (compiler-subtypep the-type (make-compiler-type type)))
    346346        (return-from type-representation (caar types))))))
    347 
    348 (defun representation-size (representation)
    349   (ecase representation
    350     ((NIL :int :boolean :float :char) 1)
    351     ((:long :double) 2)))
    352 
    353347
    354348(defknown emit-unbox-boolean () t)
     
    685679     ,@argument-accumulation-body
    686680     (load-saved-operands)
    687      ,@funcall-body))
     681     ,@call-body))
    688682
    689683(defmacro accumulate-operand ((representation &key unsafe-p)
     
    714708  (when (null *saved-operands*)
    715709    (dolist (representation *operand-representations*)
    716       (let ((register (allocate-register)))
     710      (let ((register (allocate-register representation)))
    717711        (push register *saved-operands*)
    718712        (emit-move-from-stack register representation)))
     
    726720
    727721  (when *saved-operands*
    728     (let ((register (allocate-register)))
     722    (let ((register (allocate-register representation)))
    729723      (push register *saved-operands*)
    730724      (emit-move-from-stack register representation))))
     
    744738      (emit-checkcast cast))
    745739    (when unsafe
    746       (let ((register (allocate-register)))
     740      (let ((register (allocate-register representation)))
    747741        (push register *saved-operands*)
    748742        (emit-move-from-stack register representation)))
     
    763757    (emit-push-variable variable)
    764758    (when *saved-operands* ;; safe-mode
    765       (let ((register (allocate-register)))
     759      (let ((register (allocate-register (variable-representation variable))))
    766760        (push register *saved-operands*)
    767761        (emit-move-from-stack register (variable-representation variable)))))))
     
    771765  (emit-push-current-thread)
    772766  (when *saved-operands*
    773     (let ((register (allocate-register)))
     767    (let ((register (allocate-register nil)))
    774768      (push register *saved-operands*)
    775769      (emit 'astore register))))
     
    779773  (emit-load-externalized-object object)
    780774  (when *saved-operands* ;; safe-mode
    781     (let ((register (allocate-register)))
     775    (let ((register (allocate-register nil)))
    782776      (push register *saved-operands*)
    783777      (emit 'astore register))))
     
    959953         more-keys-p)
    960954    (with-code-to-method (class method)
    961       (allocate-register)
     955      (allocate-register nil)
    962956      (unless (eq super +lisp-compiled-primitive+)
    963957        (multiple-value-bind
     
    975969                      (emit-anewarray +lisp-closure-parameter+)
    976970                      (astore (setf ,register *registers-allocated*))
    977                       (allocate-register)
     971                      (allocate-register nil)
    978972                      (do* ((,count-sym 0 (1+ ,count-sym))
    979973                            (,params ,params (cdr ,params))
     
    19421936                     operand-registers)
    19431937                 (dolist (stack-item stack)
    1944                    (let ((register (allocate-register)))
     1938                   (let ((register (allocate-register nil)))
    19451939                     (push register operand-registers)
    19461940                     (emit-move-from-stack register stack-item)))
    19471941                 (setf operand-registers (reverse operand-registers))
    19481942                 (dolist (arg args)
    1949                    (push (allocate-register) operand-registers)
     1943                   (push (allocate-register nil) operand-registers)
    19501944                   (compile-form arg (car operand-registers) nil)
    19511945                   (unless must-clear-values
     
    19621956              (t
    19631957               (let* ((*register* *register*) ;; ### FIXME: this doesn't work, but why not?
    1964                      (array-register (allocate-register))
     1958                     (array-register (allocate-register nil))
    19651959                     saved-stack)
    19661960                 (when unsafe-args
    19671961                   (dolist (stack-item stack)
    1968                      (let ((register (allocate-register)))
     1962                     (let ((register (allocate-register nil)))
    19691963                       (push register saved-stack)
    19701964                       (emit-move-from-stack register stack-item))))
     
    21642158(defun duplicate-closure-array (compiland)
    21652159  (let* ((*register* *register*)
    2166          (register (allocate-register)))
     2160         (register (allocate-register nil)))
    21672161    (aload (compiland-closure-register compiland))        ;; src
    21682162    (emit-push-constant-int 0)                            ;; srcPos
     
    23272321                                  (var-ref-p arg2))
    23282322                              (node-constant-p arg3))
    2329                    (allocate-register)))
     2323                   (allocate-register nil)))
    23302324                (arg3-register
    2331                  (unless (node-constant-p arg3) (allocate-register))))
     2325                 (unless (node-constant-p arg3) (allocate-register nil))))
    23322326           (with-operand-accumulation
    23332327               ((compile-operand arg1 :int)
     
    30083002  (let ((first-subform (cadr form))
    30093003        (subforms (cddr form))
    3010         (result-register (allocate-register))
    3011         (values-register (allocate-register)))
     3004        (result-register (allocate-register nil))
     3005        (values-register (allocate-register nil)))
    30123006    ;; Make sure there are no leftover values from previous calls.
    30133007    (emit-clear-values)
     
    30403034    (3
    30413035     (let* ((*register* *register*)
    3042             (function-register (allocate-register)))
     3036            (function-register (allocate-register nil)))
    30433037       (compile-form (second form) function-register nil)
    30443038       (compile-form (third form) 'stack nil)
     
    30513045     ;; The general case.
    30523046     (let* ((*register* *register*)
    3053             (function-register (allocate-register))
    3054             (values-register (allocate-register)))
     3047            (function-register (allocate-register nil))
     3048            (values-register (allocate-register nil)))
    30553049       (compile-form (second form) 'stack nil)
    30563050       (emit-invokestatic +lisp+ "coerceToFunction"
     
    31953189              (t
    31963190               (unless (variable-closure-index variable)
    3197                  (setf (variable-register variable) (allocate-register)))))))
     3191                 (setf (variable-register variable)
     3192                       (allocate-register nil)))))))
    31983193    ;; If we're going to bind any special variables...
    31993194    (when bind-special-p
    32003195      (dformat t "p2-m-v-b-node lastSpecialBinding~%")
    32013196      ;; Save current dynamic environment.
    3202       (setf (m-v-b-environment-register block) (allocate-register))
     3197      (setf (m-v-b-environment-register block) (allocate-register nil))
    32033198      (save-dynamic-environment (m-v-b-environment-register block))
    32043199      (label label-START))
     
    32123207          (t
    32133208           (let* ((*register* *register*)
    3214                   (result-register (allocate-register))
    3215                   (values-register (allocate-register))
     3209                  (result-register (allocate-register nil))
     3210                  (values-register (allocate-register nil))
    32163211                  (LABEL1 (gensym))
    32173212                  (LABEL2 (gensym)))
     
    33683363(defun allocate-variable-register (variable)
    33693364  (setf (variable-register variable)
    3370         (if (= 2 (representation-size (variable-representation variable)))
    3371             (allocate-register-pair)
    3372             (allocate-register))))
     3365        (allocate-register (variable-representation variable))))
    33733366
    33743367(defun emit-move-to-variable (variable)
     
    34803473               (when (variable-special-p variable)
    34813474                 (setf (variable-binding-register variable)
    3482                        (allocate-register)))
     3475                       (allocate-register nil)))
    34833476               (cond ((variable-special-p variable)
    3484                       (let ((temp-register (allocate-register)))
     3477                      (let ((temp-register (allocate-register nil)))
    34853478                        ;; FIXME: this permanently allocates a register
    34863479                        ;; which has only a single local use
     
    35443537                             (eq (variable-declared-type variable) 'BOOLEAN))
    35453538                        (setf (variable-representation variable) :boolean)
    3546                         (setf (variable-register variable) (allocate-register))
     3539                        (setf (variable-register variable)
     3540                              (allocate-register nil))
    35473541                        (emit 'iconst_0)
    35483542                        (emit 'istore (variable-register variable))
     
    35743568          (unless (or (variable-closure-index variable)
    35753569                      (variable-register variable))
    3576             (setf (variable-register variable) (allocate-register))))
     3570            (setf (variable-register variable)
     3571                  (allocate-register nil))))
    35773572        (push variable *visible-variables*)
    35783573        (unless boundp
    35793574          (when (variable-special-p variable)
    3580             (setf (variable-binding-register variable) (allocate-register)))
     3575            (setf (variable-binding-register variable)
     3576                  (allocate-register nil)))
    35813577          (compile-binding variable))
    35823578        (maybe-generate-type-check variable)))
     
    36013597    (when specialp
    36023598      ;; We need to save current dynamic environment.
    3603       (setf (let-environment-register block) (allocate-register))
     3599      (setf (let-environment-register block) (allocate-register nil))
    36043600      (save-dynamic-environment (let-environment-register block))
    36053601      (label label-START))
     
    36443640         (must-clear-values nil)
    36453641         (specials-register (when (tagbody-non-local-go-p block)
    3646                               (allocate-register))))
     3642                              (allocate-register nil))))
    36473643    ;; Scan for tags.
    36483644    (dolist (tag (tagbody-tags block))
     
    36813677             (EXTENT-EXIT-HANDLER (gensym "HE"))
    36823678             (*register* *register*)
    3683              (go-register (allocate-register))
    3684              (tag-register (allocate-register)))
     3679             (go-register (allocate-register nil))
     3680             (tag-register (allocate-register nil)))
    36853681        (label HANDLER)
    36863682        ;; The Go object is on the runtime stack. Stack depth is 1.
     
    38443840         (BLOCK-EXIT (block-exit block))
    38453841         (specials-register (when (block-non-local-return-p block)
    3846                               (allocate-register))))
     3842                              (allocate-register nil))))
    38473843    (setf (block-target block) target)
    38483844    (when (block-id-variable block)
     
    39933989         (*register* *register*)
    39943990         (environment-register
    3995           (setf (progv-environment-register block) (allocate-register)))
     3991          (setf (progv-environment-register block) (allocate-register nil)))
    39963992         (label-START (gensym "F")))
    39973993    (with-operand-accumulation
     
    41714167        (aver (null (variable-register variable)))
    41724168        (unless (variable-closure-index variable)
    4173           (setf (variable-register variable) (allocate-register)))))
     4169          (setf (variable-register variable) (allocate-register nil)))))
    41744170    (dolist (local-function local-functions)
    41754171      (p2-labels-process-compiland local-function))
     
    48294825         (arg3 (third args))
    48304826         (*register* *register*)
    4831          (value-register (when target (allocate-register))))
     4827         (value-register (when target (allocate-register nil))))
    48324828    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    48334829                                               arg2 'stack nil
     
    58455841                (compiler-subtypep type3 'CHARACTER))
    58465842           (let* ((*register* *register*)
    5847                   (value-register (when target (allocate-register)))
     5843                  (value-register (when target (allocate-register nil)))
    58485844                  (class (if (eq op 'SCHAR)
    58495845                             +lisp-simple-string+
     
    58855881                (arg3 (fourth form))
    58865882                (*register* *register*)
    5887                 (value-register (when target (allocate-register))))
     5883                (value-register (when target (allocate-register nil))))
    58885884           (compile-form arg1 'stack nil) ;; vector
    58895885           (compile-form arg2 'stack :int) ;; index
     
    59785974                (type3 (derive-compiler-type arg3))
    59795975                (*register* *register*)
    5980                 (value-register (unless (null target) (allocate-register))))
     5976                (value-register (unless (null target) (allocate-register nil))))
    59815977           ;; array
    59825978           (compile-form arg1 'stack nil)
     
    60666062               (<= 0 arg2 3))
    60676063          (let* ((*register* *register*)
    6068                  (value-register (when target (allocate-register))))
     6064                 (value-register (when target (allocate-register nil))))
    60696065            (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    60706066                                                       arg3 'stack nil)
     
    60816077         ((fixnump arg2)
    60826078          (let* ((*register* *register*)
    6083                  (value-register (when target (allocate-register))))
     6079                 (value-register (when target (allocate-register nil))))
    60846080            (compile-form arg1 'stack nil)
    60856081            (emit-push-constant-int arg2)
     
    66796675  (let* ((form (synchronized-form block))
    66806676         (*register* *register*)
    6681          (object-register (allocate-register))
     6677         (object-register (allocate-register nil))
    66826678         (BEGIN-PROTECTED-RANGE (gensym "F"))
    66836679         (END-PROTECTED-RANGE (gensym "U"))
     
    67156711      (return-from p2-catch-node))
    67166712    (let* ((*register* *register*)
    6717            (tag-register (allocate-register))
     6713           (tag-register (allocate-register nil))
    67186714           (BEGIN-PROTECTED-RANGE (gensym "F"))
    67196715           (END-PROTECTED-RANGE (gensym "U"))
     
    67226718           (DEFAULT-HANDLER (gensym))
    67236719           (EXIT (gensym "E"))
    6724            (specials-register (allocate-register)))
     6720           (specials-register (allocate-register nil)))
    67256721      (compile-form (second form) tag-register nil) ; Tag.
    67266722      (emit-push-current-thread)
     
    68076803           (cleanup-forms (cdddr form))
    68086804           (*register* *register*)
    6809            (exception-register (allocate-register))
    6810            (result-register (allocate-register))
    6811            (values-register (allocate-register))
    6812            (specials-register (allocate-register))
     6805           (exception-register (allocate-register nil))
     6806           (result-register (allocate-register nil))
     6807           (values-register (allocate-register nil))
     6808           (specials-register (allocate-register nil))
    68136809           (BEGIN-PROTECTED-RANGE (gensym "F"))
    68146810           (END-PROTECTED-RANGE (gensym "U"))
     
    70807076
    70817077      (when *using-arg-array*
    7082         (setf (compiland-argument-register compiland) (allocate-register)))
     7078        (setf (compiland-argument-register compiland) (allocate-register nil)))
    70837079
    70847080      ;; Assign indices or registers, depending on where the args are
     
    70907086          (if *using-arg-array*
    70917087              (setf (variable-index variable) index)
    7092               (setf (variable-register variable) (allocate-register)))
     7088              (setf (variable-register variable) (allocate-register nil)))
    70937089          (incf index)))
    70947090
    70957091      ;; Reserve the next available slot for the thread register.
    7096       (setf *thread* (allocate-register))
     7092      (setf *thread* (allocate-register nil))
    70977093
    70987094      (when *closure-variables*
    7099         (setf (compiland-closure-register compiland) (allocate-register))
     7095        (setf (compiland-closure-register compiland) (allocate-register nil))
    71007096        (dformat t "p2-compiland 2 closure register = ~S~%"
    71017097                 (compiland-closure-register compiland)))
     
    71687164                      (< (+ (variable-reads variable)
    71697165                            (variable-writes variable)) 2))
    7170             (let ((register (allocate-register)))
     7166            (let ((register (allocate-register nil)))
    71717167              (aload (compiland-argument-register compiland))
    71727168              (emit-push-constant-int (variable-index variable))
     
    71877183        ;; Save the dynamic environment
    71887184        (setf (compiland-environment-register compiland)
    7189               (allocate-register))
     7185              (allocate-register nil))
    71907186        (save-dynamic-environment (compiland-environment-register compiland))
    71917187        (label label-START)
    71927188        (dolist (variable (compiland-arg-vars compiland))
    71937189          (when (variable-special-p variable)
    7194             (setf (variable-binding-register variable) (allocate-register))
     7190            (setf (variable-binding-register variable) (allocate-register nil))
    71957191            (emit-push-current-thread)
    71967192            (emit-push-variable-name variable)
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/jvm.lisp

    r13152 r13155  
    346346      (return variable))))
    347347
    348 (defknown allocate-register () (integer 0 65535))
    349 (defun allocate-register ()
    350   (let* ((register *register*)
    351          (next-register (1+ register)))
    352     (declare (type (unsigned-byte 16) register next-register))
    353     (setf *register* next-register)
    354     (when (< *registers-allocated* next-register)
    355       (setf *registers-allocated* next-register))
     348(defknown representation-size (t) (integer 0 65535))
     349(defun representation-size (representation)
     350  (ecase representation
     351    ((NIL :int :boolean :float :char) 1)
     352    ((:long :double) 2)))
     353
     354(defknown allocate-register (t) (integer 0 65535))
     355(defun allocate-register (representation)
     356  (let ((register *register*))
     357    (incf *register* (representation-size representation))
     358    (setf *registers-allocated*
     359          (max *registers-allocated* *register*))
    356360    register))
    357361
    358 (defknown allocate-register-pair () (integer 0 65535))
    359 (defun allocate-register-pair ()
    360   (let* ((register *register*)
    361          (next-register (+ register 2)))
    362     (declare (type (unsigned-byte 16) register next-register))
    363     (setf *register* next-register)
    364     (when (< *registers-allocated* next-register)
    365       (setf *registers-allocated* next-register))
    366     register))
    367362
    368363(defstruct local-function
Note: See TracChangeset for help on using the changeset viewer.