diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 9c3e92057cda857320babe6d2df8ea217141d3aa..4713d93f3f0cb86eee88dcce4cae81e61bce7e08 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -26,7 +26,7 @@ (in-package 'c) -(proclaim '(special *compiler-error-bailout* *template-names*)) +(proclaim '(special *compiler-error-bailout*)) ;;; The lexical environment we are currently converting in. See the LEXENV @@ -2248,7 +2248,7 @@ (translator (gethash name *primitive-translators*))) (if translator (ir1-convert start cont (funcall translator (cdr form))) - (let* ((template (or (gethash name *template-names*) + (let* ((template (or (gethash name (backend-template-names *backend*)) (compiler-error "Undefined primitive name: ~A." name))) (required (length (template-arg-types template))) diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index b8d538cc64d1c6cbb53e001fe5456bc93ee856d8..ff085d12963046e1684cf39a4a0492e27187da92 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.23 1990/10/17 19:18:06 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.24 1990/11/03 03:14:41 wlott Exp $ ;;; ;;; This file contains the virtual machine independent parts of the code ;;; which does the actual translation of nodes to VOPs. @@ -242,7 +242,7 @@ ((:special :global) (assert (symbolp (leaf-name leaf))) (vop set node block (emit-constant (leaf-name leaf)) val - (make-normal-tn *any-primitive-type*)))))) + (make-normal-tn (backend-any-primitive-type *backend*))))))) (when locs (emit-move node block val (first locs)) @@ -570,8 +570,10 @@ (let ((nvals (length rtypes)) (ntypes (length types))) (cond ((< ntypes nvals) - (append types (make-list (- nvals ntypes) - :initial-element *any-primitive-type*))) + (append types + (make-list (- nvals ntypes) + :initial-element + (backend-any-primitive-type *backend*)))) ((> ntypes nvals) (subseq types 0 nvals)) (t @@ -717,7 +719,8 @@ (when actual (cond ((lambda-var-indirect var) - (let ((temp (make-normal-tn *any-primitive-type*))) + (let ((temp + (make-normal-tn (backend-any-primitive-type *backend*)))) (vop make-value-cell node block actual temp) (temps temp))) ((member actual (locs)) @@ -1088,7 +1091,8 @@ (vop copy-more-arg node block (optional-dispatch-max-args ef)))) (if (ir2-environment-environment env) - (let ((closure (make-normal-tn *any-primitive-type*))) + (let ((closure + (make-normal-tn (backend-any-primitive-type *backend*)))) (vop setup-closure-environment node block start-label closure) (let ((n -1)) (dolist (loc (ir2-environment-environment env)) @@ -1565,7 +1569,9 @@ (defoptimizer (%slot-accessor ir2-convert) ((str) node block) (let* ((cont (node-cont node)) - (res (continuation-result-tns cont (list *any-primitive-type*)))) + (res (continuation-result-tns cont + (list (backend-any-primitive-type + *backend*))))) (vop structure-ref node block (continuation-tn node block str) (dsd-index diff --git a/compiler/ltn.lisp b/compiler/ltn.lisp index 86019f4cb6190aaaa718f85d6ef00c1015d1f740..c34c7492dffc3a39057f992f9b278e7f9fe9e023 100644 --- a/compiler/ltn.lisp +++ b/compiler/ltn.lisp @@ -282,7 +282,7 @@ ((< num-proven num-types) (append proven (make-n-tns (- num-types num-proven) - *any-primitive-type*))) + (backend-any-primitive-type *backend*)))) ((> num-proven num-types) (subseq proven 0 num-types)) (t @@ -535,7 +535,7 @@ (ecase (first restr) (:or (dolist (mem (rest restr) nil) - (when (or (and t-ok (eq mem *any-primitive-type*)) + (when (or (and t-ok (eq mem (backend-any-primitive-type *backend*))) (eq mem type)) (return t)))) (:constant diff --git a/compiler/main.lisp b/compiler/main.lisp index ffc20724fe576aaa7637ac927784bd987fd658dc..464f4cb27a2019433e3f4584c60268a1f1c87bab 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -22,7 +22,7 @@ *seen-blocks* *seen-functions* *list-conflicts-table* *continuation-number* *continuation-numbers* *number-continuations* *tn-id* *tn-ids* *id-tns* - *label-ids* *label-id* *id-labels* *sb-list* + *label-ids* *label-id* *id-labels* *undefined-warnings* *compiler-error-count* *compiler-warning-count* *compiler-note-count* *compiler-error-output* *compiler-error-bailout* @@ -428,7 +428,7 @@ (setq *label-id* 0)) ;; ;; Clear some Pack data structures (for GC purposes only.) - (dolist (sb *sb-list*) + (dolist (sb (backend-sb-list *backend*)) (when (finite-sb-p sb) (fill (finite-sb-live-tns sb) nil))) ;; @@ -542,7 +542,7 @@ ;; ;; If a file, the truename of the corresponding source file. If from a Lisp ;; form, :LISP, if from a stream, :STREAM. - (name nil :type (or pathname (member :lisp :stream))) + (name (required-argument) :type (or pathname (member :lisp :stream))) ;; ;; The file's write date (if relevant.) (write-date nil :type (or unsigned-byte null)) @@ -1201,7 +1201,7 @@ (defun start-error-output (source-info) (declare (type source-info source-info)) (compiler-mumble "~2&Python version ~A, VM version ~A on ~A.~%" - compiler-version vm-version + compiler-version (backend-version *backend*) (ext:format-universal-time nil (get-universal-time) :style :government :print-weekday nil @@ -1280,7 +1280,8 @@ (when output-file (setq output-file-name - (frob output-file vm:target-fasl-file-type)) + (frob output-file + (backend-fasl-file-type *backend*))) (setq fasl-file (open-fasl-file output-file-name (namestring (first source))))) diff --git a/compiler/pack.lisp b/compiler/pack.lisp index 175a1fb533b93c61b883210ab959494fa0523ebc..b0beaebc9ec29cf527ef56eb9e23c106498cec11 100644 --- a/compiler/pack.lisp +++ b/compiler/pack.lisp @@ -148,7 +148,7 @@ ;;; (defun init-sb-vectors (component) (let ((nblocks (ir2-block-count component))) - (dolist (sb *sb-list*) + (dolist (sb (backend-sb-list *backend*)) (unless (eq (sb-kind sb) :non-packed) (let* ((conflicts (finite-sb-conflicts sb)) (always-live (finite-sb-always-live sb)) @@ -243,7 +243,7 @@ ;;; (defun pack-before-gc-hook () (unless *in-pack* - (dolist (sb *sb-list*) + (dolist (sb (backend-sb-list *backend*)) (unless (eq (sb-kind sb) :non-packed) (let ((size (sb-size sb))) (fill nil (finite-sb-always-live sb)) @@ -723,7 +723,7 @@ ((null vop)) (when (eq (vop-info-save-p (vop-info vop)) t) (do-live-tns (tn (vop-save-set vop) block) - (decf (tn-cost tn) register-save-penalty))))) + (decf (tn-cost tn) (backend-register-save-penalty *backend*)))))) (do ((tn (ir2-component-normal-tns (component-info component)) (tn-next tn))) @@ -881,7 +881,7 @@ ;;; the end of Block. ;;; (defun init-live-tns (block) - (dolist (sb *sb-list*) + (dolist (sb (backend-sb-list *backend*)) (when (eq (sb-kind sb) :finite) (fill (finite-sb-live-tns sb) nil))) @@ -1140,7 +1140,7 @@ (unless allowed (no-load-scs-allowed-by-primitive-type-error op)) (return (spill-and-pack-load-tn allowed op))) - (let ((sc (svref *sc-numbers* (pop scs)))) + (let ((sc (svref (backend-sc-numbers *backend*) (pop scs)))) (when (sc-allowed-by-primitive-type sc ptype) (setq allowed sc) (let ((loc (or (find-load-tn-target op sc) diff --git a/compiler/represent.lisp b/compiler/represent.lisp index 0fd71270fcebc1178c67ae5e743e35615a23263f..0fede9dd06c45aee3138a1b3a44fe7cd7f640389 100644 --- a/compiler/represent.lisp +++ b/compiler/represent.lisp @@ -90,7 +90,7 @@ (collect ((res)) (dotimes (i sc-number-limit) (when (eq (svref restr i) t) - (res (svref *sc-numbers* i)))) + (res (svref (backend-sc-numbers *backend*) i)))) (res))) @@ -108,7 +108,7 @@ (collect ((losers)) (dolist (scn (primitive-type-scs ptype)) (unless (svref costs scn) - (losers (svref *sc-numbers* scn)))) + (losers (svref (backend-sc-numbers *backend*) scn)))) (unless (losers) (error "Representation selection flamed out for no obvious reason.~@ @@ -147,7 +147,7 @@ (collect ((load-lose) (move-lose)) (dotimes (i sc-number-limit) - (let ((i-sc (svref *sc-numbers* i))) + (let ((i-sc (svref (backend-sc-numbers *backend*) i))) (when (eq (svref load-scs i) t) (cond ((not (sc-allowed-by-primitive-type i-sc ptype)) (load-lose i-sc)) @@ -200,7 +200,7 @@ ;;; (defun check-move-function-consistency () (dotimes (i sc-number-limit) - (let ((sc (svref *sc-numbers* i))) + (let ((sc (svref (backend-sc-numbers *backend*) i))) (when sc (let ((moves (sc-move-functions sc))) (dolist (const (sc-constant-scs sc)) @@ -272,7 +272,7 @@ (setq min cost) (setq min-scn scn)))) - (svref *sc-numbers* min-scn))) + (svref (backend-sc-numbers *backend*) min-scn))) ;;; NOTE-NUMBER-STACK-TN -- Internal @@ -389,7 +389,7 @@ (node (vop-node vop)) (block (vop-block vop))) (dotimes (i sc-number-limit (bad-coerce-error op)) - (let ((i-sc (svref *sc-numbers* i))) + (let ((i-sc (svref (backend-sc-numbers *backend*) i))) (when (and (eq (svref scs i) t) (sc-allowed-by-primitive-type i-sc ptype)) (let ((res (if write-p @@ -483,7 +483,7 @@ (assert (eq how :known-return)) (setq nfp-tn (make-number-stack-pointer-tn)) (setf (tn-sc nfp-tn) - (svref *sc-numbers* + (svref (backend-sc-numbers *backend*) (first (primitive-type-scs (tn-primitive-type nfp-tn))))) (emit-context-template @@ -577,7 +577,7 @@ (let* ((scs (primitive-type-scs (tn-primitive-type tn))) (sc (if (rest scs) (select-tn-representation tn scs costs) - (svref *sc-numbers* (first scs))))) + (svref (backend-sc-numbers *backend*) (first scs))))) (assert sc) (setf (tn-sc tn) sc))))