Changeset 13154


Ignore:
Timestamp:
01/17/11 21:19:33 (11 years ago)
Author:
ehuelsmann
Message:

Provide better infrastructure for operand accumulation.

File:
1 edited

Legend:

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

    r13153 r13154  
    668668
    669669(declaim (special *saved-operands* *operand-representations*))
    670 (defmacro with-operand-accumulation ((&body argument-buildup-body)
    671              &body funcall-body)
     670(defmacro with-operand-accumulation ((&body argument-accumulation-body)
     671                                     &body call-body)
     672  "Macro used to operand-stack-safely collect arguments in the
     673`argument-accumulation-body' to be available on the stack upon entry of the
     674`call-body'. The argument-accumulation-body code may not assume arguments
     675are actually on the stack while accumulating.
     676
     677This macro closes over a code-generating block. Operands can be collected
     678using the `accumulate-operand', `compile-operand', `emit-variable-operand'
     679and `emit-load-externalized-object-operand'."
    672680  `(let (*saved-operands*
    673   *operand-representations*
    674   (*register* *register*)
     681        *operand-representations*
     682        (*register* *register*)
    675683         ) ;; hmm can we do this?? either body
    676684                                  ;; could allocate registers ...
    677      ,@argument-buildup-body
     685     ,@argument-accumulation-body
    678686     (load-saved-operands)
    679687     ,@funcall-body))
     688
     689(defmacro accumulate-operand ((representation &key unsafe-p)
     690                              &body body)
     691  "Macro used to collect a single operand.
     692
     693This macro closes over a code-generating block. The generated code should
     694leave a single operand on the stack, with representation `representation'.
     695The value `unsafe-p', when provided, is an expression evaluated at run time
     696to indicate if the body is opstack unsafe."
     697  `(progn
     698     ,@(when unsafe-p
     699         `((when ,unsafe-p
     700             (save-existing-operands))))
     701     ,@body
     702     (save-operand ,representation)))
    680703
    681704(defun load-saved-operands ()
     
    689712  "If any operands have been compiled to the stack,
    690713save them in registers."
    691   (dolist (representation *operand-representations*)
     714  (when (null *saved-operands*)
     715    (dolist (representation *operand-representations*)
     716      (let ((register (allocate-register)))
     717        (push register *saved-operands*)
     718        (emit-move-from-stack register representation)))
     719
     720    (setf *saved-operands* (nreverse *saved-operands*))))
     721
     722(defun save-operand (representation)
     723  "Saves an operand from the stack (with `representation') to
     724a register and updates associated operand collection variables."
     725  (push representation *operand-representations*)
     726
     727  (when *saved-operands*
    692728    (let ((register (allocate-register)))
    693729      (push register *saved-operands*)
    694       (emit-move-from-stack register representation)))
    695 
    696   (setf *saved-operands* (nreverse *saved-operands*)))
     730      (emit-move-from-stack register representation))))
    697731
    698732(defun compile-operand (form representation &optional cast)
    699   "Compiles `form` into `representation`, storing the resulting value
     733  "Compiles `form' into `representation', storing the resulting value
    700734on the operand stack, if it's safe to do so. Otherwise stores the value
    701735in a register"
    702736  (let ((unsafe (or *saved-operands*
    703         (some-nested-block #'node-opstack-unsafe-p
    704                (find-enclosed-blocks form)))))
     737                    (some-nested-block #'node-opstack-unsafe-p
     738                                       (find-enclosed-blocks form)))))
    705739    (when (and unsafe (null *saved-operands*))
    706740      (save-existing-operands))
    707    
     741
    708742    (compile-form form 'stack representation)
    709743    (when cast
     
    711745    (when unsafe
    712746      (let ((register (allocate-register)))
    713   (push register *saved-operands*)
    714   (emit-move-from-stack register representation)))
    715    
     747        (push register *saved-operands*)
     748        (emit-move-from-stack register representation)))
     749
    716750  (push representation *operand-representations*)))
    717751
     
    722756  (cond
    723757   ((and *saved-operands*
    724   (variable-register variable))
     758        (variable-register variable))
    725759    ;; we're in 'safe mode' and the  variable is in a register,
    726760    ;; instead of binding a new register, just load the existing one
     
    730764    (when *saved-operands* ;; safe-mode
    731765      (let ((register (allocate-register)))
    732   (push register *saved-operands*)
    733   (assert (null (variable-representation variable)))
    734   (emit 'astore register))))))
     766        (push register *saved-operands*)
     767        (emit-move-from-stack register (variable-representation variable)))))))
    735768
    736769(defun emit-thread-operand ()
     
    739772  (when *saved-operands*
    740773    (let ((register (allocate-register)))
    741   (push register *saved-operands*)
    742   (emit 'astore register))))
    743  
     774      (push register *saved-operands*)
     775      (emit 'astore register))))
    744776
    745777(defun emit-load-externalized-object-operand (object)
     
    748780  (when *saved-operands* ;; safe-mode
    749781    (let ((register (allocate-register)))
    750   (push register *saved-operands*)
    751   (emit 'astore register))))
     782      (push register *saved-operands*)
     783      (emit 'astore register))))
    752784
    753785(defknown emit-unbox-fixnum () t)
     
    19291961                     (setf must-clear-values t)))))
    19301962              (t
    1931                (let (;(*register* *register*) ;; ### FIXME: this doesn't work, but why not?
     1963               (let* ((*register* *register*) ;; ### FIXME: this doesn't work, but why not?
    19321964                     (array-register (allocate-register))
    19331965                     saved-stack)
Note: See TracChangeset for help on using the changeset viewer.