rearrange vm.lisp again

This mess of circular dependencies where everything wants to be
evaluated at compile-time (and so everything it depends on needs to be
ready at read-time, ew) is horrible.  But it needs to be this way, at
least for now, so that we can give some locations to the various
register storage classes.

We now get beyond packing, and fail to emit a block header, and
subsequently fail to support type tests.  Some more platform-specific
development looms in our future...

src/compiler/rv32/vm.lisp

@@ -11,6 +11,46 @@

(in-package "SB!VM")

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *register-names* (make-array 32 :initial-element nil)))

(macrolet ((defreg (name offset)
             (let ((offset-sym (symbolicate name "-OFFSET")))
               `(eval-when (:compile-toplevel :load-toplevel :execute)
                  (defconstant ,offset-sym ,offset)
                  (setf (svref *register-names* ,offset-sym) ,(symbol-name name)))))
           (defregset (name &rest regs)
             (flet ((offset-namify (n) (symbolicate n "-OFFSET")))
               `(eval-when (:compile-toplevel :load-toplevel :execute)
                  (defparameter ,name
                    (list ,@(mapcar #'offset-namify regs))))))
           (define-argument-register-set (&rest args)
             `(progn
                (defregset *register-arg-offsets* ,@args)
                (defconstant register-arg-count ,(length args)))))
  (defreg zero 0)
  (defreg lr 1)
  (defreg nsp 2)
  (defreg lra 5) ; alternate link register
  (defreg cfp 6)
  (defreg ocfp 7)
  (defreg nfp 8)
  (defreg csp 9)
  (defreg a0 10)
  (defreg nl0 11)
  (defreg a1 12)
  (defreg nl1 13)
  (defreg a2 14)
  (defreg nl2 15)
  (defreg a3 16)
  (defreg nl3 17)
  (defreg nargs 31)

  (defregset non-descriptor-regs nl0 nl1 nl2 nl3 nargs nfp)
  (defregset descriptor-regs a0 a1 a2 a3 ocfp lra)

  (define-argument-register-set a0 a1 a2 a3))

(!define-storage-bases
 (define-storage-base registers :finite :size 32)
 (define-storage-base control-stack :unbounded :size 8)
@@ -28,9 +68,10 @@
 (zero immediate-constant)

 (control-stack control-stack)
 (any-reg registers :alternate-scs (control-stack) :constant-scs (immediate))
 (descriptor-reg registers :alternate-scs (control-stack))
 (non-descriptor-reg registers)
 (any-reg registers :locations #.(append non-descriptor-regs descriptor-regs)
          :alternate-scs (control-stack) :constant-scs (immediate))
 (descriptor-reg registers :locations #.descriptor-regs :alternate-scs (control-stack))
 (non-descriptor-reg registers :locations #.non-descriptor-regs)

 (character-stack non-descriptor-stack)
 (character-reg registers :alternate-scs (character-stack))
@@ -54,49 +95,6 @@
 (catch-block control-stack :element-size catch-block-size)
 (unwind-block control-stack :element-size unwind-block-size)
 )

(defvar *register-names* (make-array 32 :initial-element nil))

(macrolet ((defreg (name offset)
             (let ((offset-sym (symbolicate name "-OFFSET")))
               `(progn
                  (defconstant ,offset-sym ,offset)
                  (setf (svref *register-names* ,offset-sym) ,(symbol-name name)))))
           (defregset (name &rest regs)
             (flet ((offset-namify (n) (symbolicate n "-OFFSET")))
               `(defparameter ,name
                  (list ,@(mapcar #'offset-namify regs)))))
           (define-argument-register-set (&rest args)
             `(progn
                (defregset *register-arg-offsets* ,@args)
                (defconstant register-arg-count ,(length args))
                (defparameter *register-arg-tns*
                  (let ((drsc (sc-or-lose 'descriptor-reg)))
                    (flet ((make (n) (make-random-tn :kind :normal :sc drsc :offset n)))
                      (mapcar #'make *register-arg-offsets*)))))))
  (defreg zero 0)
  (defreg lr 1)
  (defreg nsp 2)
  (defreg lra 5) ; alternate link register
  (defreg cfp 6)
  (defreg ocfp 7)
  (defreg nfp 8)
  (defreg csp 9)
  (defreg a0 10)
  (defreg nl0 11)
  (defreg a1 12)
  (defreg nl1 13)
  (defreg a2 14)
  (defreg nl2 15)
  (defreg a3 16)
  (defreg nl3 17)
  (defreg nargs 31)

  (defregset non-descriptor-regs nl0 nl1 nl2 nl3 nargs nfp)
  (defregset descriptor-regs a0 a1 a2 a3 ocfp lra)

  (define-argument-register-set a0 a1 a2 a3))

(defun immediate-constant-sc (value)
  (typecase value
    ((integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) immediate-sc-number)))
@@ -112,6 +110,11 @@
(defconstant lra-save-offset 1)
(defconstant nfp-save-offset 2)

(defparameter *register-arg-tns*
  (let ((drsc (sc-or-lose 'descriptor-reg)))
    (flet ((make (n) (make-random-tn :kind :normal :sc drsc :offset n)))
      (mapcar #'make *register-arg-offsets*))))

(defun location-print-name (tn)
  (declare (type tn tn))
  (let ((sb (sb-name (sc-sb (tn-sc tn))))