Skip to content
Snippets Groups Projects
backend.lisp 6.9 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice 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 Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC). 
;;; **********************************************************************
;;;
;;; This file isolates all the backend specific data so that we can compile
;;; and use different backends.
;;; 
;;; Written by William Lott.
;;;
(in-package "C")

wlott's avatar
wlott committed
(export '(def-vm-support-routine *backend* *target-backend* *native-backend*
wlott's avatar
wlott committed
	   backend-name backend-version backend-fasl-file-type
	   backend-fasl-file-implementation backend-fasl-file-version
	   backend-register-save-penalty backend-byte-order
	   backend-any-primitive-type

	   ;; The various backends need to call these support routines
	   make-stack-pointer-tn primitive-type primitive-type-of))
wlott's avatar
wlott committed


;;;; VM support routine stuff.

(eval-when (compile load eval)
  (defvar *vm-support-routines* nil))

(defmacro def-vm-support-routine (name ll &body body)
  (unless (member (string name) *vm-support-routines*
		  :test #'string=)
    (warn "Unknown VM support routine: ~A" name))
  (let ((local-name (symbolicate (backend-name *backend*) "-" name)))
    `(progn
       (defun ,local-name ,ll ,@body)
       (setf (,(intern (concatenate 'simple-string "BACKEND-" (string name))
		       (symbol-package 'foo))
	      *backend*)
	     #',local-name))))

(eval-when (compile eval)

(defmacro def-vm-support-routine-stub (name)
  `(progn
     #-bootstrap-backend
     (defun ,name (&rest args)
       (apply (or (,(symbolicate "BACKEND-" name) *backend*)
		  (error "Machine specific support routine ~S undefined for ~S"
			 ',name *backend*))
	      args))
     (eval-when (compile load eval)
       (pushnew ,(string name) *vm-support-routines*
		:test #'string=))))

); eval-when (compile eval)

;;; From VM.LISP
(def-vm-support-routine-stub immediate-constant-sc)
(def-vm-support-routine-stub location-print-name)

;;; From PRIMTYPE.LISP
(def-vm-support-routine-stub primitive-type-of)
(def-vm-support-routine-stub primitive-type)

;;; From C-CALL.LISP
(def-vm-support-routine-stub make-call-out-nsp-tn)
(def-vm-support-routine-stub make-call-out-argument-tns)
(def-vm-support-routine-stub make-call-out-result-tn)

;;; From CALL.LISP
(def-vm-support-routine-stub standard-argument-location)
(def-vm-support-routine-stub make-return-pc-passing-location)
(def-vm-support-routine-stub make-old-fp-passing-location)
(def-vm-support-routine-stub make-old-fp-save-location)
(def-vm-support-routine-stub make-return-pc-save-location)
(def-vm-support-routine-stub make-argument-count-location)
(def-vm-support-routine-stub make-nfp-tn)
(def-vm-support-routine-stub make-stack-pointer-tn)
(def-vm-support-routine-stub make-number-stack-pointer-tn)
(def-vm-support-routine-stub make-unknown-values-locations)
(def-vm-support-routine-stub select-component-format)

;;; From NLX.LISP
(def-vm-support-routine-stub make-nlx-sp-tn)
(def-vm-support-routine-stub make-dynamic-state-tns)

;;; From SUPPORT.LISP
(def-vm-support-routine-stub generate-call-sequence)
(def-vm-support-routine-stub generate-return-sequence)



;;;; The actual backend structure.

(defstruct (backend
	    (:print-function %print-backend))
  ;; The name of this backend.  Something like ``PMAX''
  (name nil)

  ;; The version string for this backend.
  ;; Something like ``DECstation 3100/Mach 0.0''
  (version nil)

  ;; Information about fasl files for this backend.
  (fasl-file-type nil)
  (fasl-file-implementation nil)
  (fasl-file-version nil)

  ;; The number of references that a TN must have to offset the overhead of
  ;; saving the TN across a call.
  (register-save-penalty 0)

  ;; The byte order of the target machine.  Should either be :big-endian
  ;; which has the MSB first (RT) or :little-endian which has the MSB last
  ;; (VAX).
  (byte-order nil :type (or null (member :little-endian :big-endian)))

  ;; Translates from SC numbers to SC info structures.  SC numbers are always
  ;; used instead of names at run time, so changing this vector changes all the
  ;; references.
  (sc-numbers (make-array sc-number-limit) :type sc-vector)

  ;; A list of all the SBs defined, so that we can easily iterate over them.
  (sb-list () :type list)

  ;; Translates from template names to template structures.
  (template-names (make-hash-table :test #'eq) :type hash-table)

  ;; Hashtable from SC and SB names the corresponding structures.  The META
  ;; versions are only used at meta-compile and load times, so the defining
  ;; macros can change these at meta-compile time without breaking the
  ;; compiler.
  (sc-names (make-hash-table :test #'eq) :type hash-table)
  (sb-names (make-hash-table :test #'eq) :type hash-table)
  (meta-sc-names (make-hash-table :test #'eq) :type hash-table)
  (meta-sb-names (make-hash-table :test #'eq) :type hash-table)

  ;; Like *SC-Numbers*, but is updated at meta-compile time.
  (meta-sc-numbers (make-array sc-number-limit) :type sc-vector)

  ;; Translates from primitive type names to the corresponding primitive-type
  ;; structure.
  (primitive-type-names (make-hash-table :test #'eq) :type hash-table)

  ;; Establishes a convenient handle on primitive type unions, or whatever.
  ;; These names can only be used as the :arg-types or :result-types for VOPs
  ;; and can map to anything else that can be used as :arg-types or
  ;; :result-types (e.g. :or, :constant).
  (primitive-type-aliases (make-hash-table :test #'eq) :type hash-table)

  ;; Meta-compile time translation from names to primitive types.
  (meta-primitive-type-names (make-hash-table :test #'eq) :type hash-table)

  ;; The primitive type T is somewhat magical, in that it is the only
  ;; primitive type that overlaps with other primitive types.  An object
  ;; of primitive-type T is in the canonical descriptor (boxed or pointer)
  ;; representation.
  ;;
  ;; We stick the T primitive-type in a variable so that people who have to
  ;; special-case it can get at it conveniently.  This is done by the machine
  ;; specific VM definition, since the DEF-PRIMITIVE-TYPE for T must specify
  ;; the SCs that boxed objects can be allocated in.
  (any-primitive-type nil :type (or null primitive-type))

  ;; Hashtable translating from VOP names to the corresponding VOP-Parse
  ;; structures.  This information is only used at meta-compile time.
  (parsed-vops (make-hash-table :test #'eq) :type hash-table)

  . #.(mapcar #'(lambda (slot)
		  `(,(intern slot) nil :type (or null function)))
	      (sort (copy-list *vm-support-routines*) #'string<)))

(defprinter backend
  name)


(defvar *native-backend* (make-backend)
  "The backend for the machine we are running on. Do not change this.")
(defvar *target-backend* *native-backend*
  "The backend we are attempting to compile.")
(defvar *backend* *native-backend*
  "The backend we are using to compile.")