/[cmucl]/src/compiler/meta-vmdef.lisp
ViewVC logotype

Diff of /src/compiler/meta-vmdef.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by rtoy, Mon Apr 19 15:08:20 2010 UTC revision 1.12 by rtoy, Tue Apr 20 17:57:46 2010 UTC
# Line 50  Line 50 
50    (ecase kind    (ecase kind
51      (:non-packed      (:non-packed
52       (when size       (when size
53         (error _"Size specification meaningless in a ~S SB." kind)))         (error (intl:gettext "Size specification meaningless in a ~S SB.") kind)))
54      ((:finite :unbounded)      ((:finite :unbounded)
55       (unless size (error _"Size not specified in a ~S SB." kind))       (unless size (error (intl:gettext "Size not specified in a ~S SB.") kind))
56       (check-type size unsigned-byte)))       (check-type size unsigned-byte)))
57    
58    (let ((res (if (eq kind :non-packed)    (let ((res (if (eq kind :non-packed)
# Line 133  Line 133 
133    (check-type alternate-scs list)    (check-type alternate-scs list)
134    (check-type constant-scs list)    (check-type constant-scs list)
135    (unless (= (logcount alignment) 1)    (unless (= (logcount alignment) 1)
136      (error _"Alignment is not a power of two: ~S" alignment))      (error (intl:gettext "Alignment is not a power of two: ~S") alignment))
137    
138    (let ((sb (meta-sb-or-lose sb-name)))    (let ((sb (meta-sb-or-lose sb-name)))
139      (if (eq (sb-kind sb) :finite)      (if (eq (sb-kind sb) :finite)
# Line 143  Line 143 
143            (dolist (el locations)            (dolist (el locations)
144              (check-type el unsigned-byte)              (check-type el unsigned-byte)
145              (unless (<= 1 (+ el element-size) size)              (unless (<= 1 (+ el element-size) size)
146                (error _"SC element ~D out of bounds for ~S." el sb))))                (error (intl:gettext "SC element ~D out of bounds for ~S.") el sb))))
147          (when locations          (when locations
148            (error _":Locations is meaningless in a ~S SB." (sb-kind sb))))            (error (intl:gettext ":Locations is meaningless in a ~S SB.") (sb-kind sb))))
149    
150      (unless (subsetp reserve-locations locations)      (unless (subsetp reserve-locations locations)
151        (error _"Reserve-Locations not a subset of Locations."))        (error (intl:gettext "Reserve-Locations not a subset of Locations.")))
152    
153      (when (and (or alternate-scs constant-scs)      (when (and (or alternate-scs constant-scs)
154                 (eq (sb-kind sb) :non-packed))                 (eq (sb-kind sb) :non-packed))
155        (error _"Meaningless to specify alternate or constant SCs in a ~S SB."        (error (intl:gettext "Meaningless to specify alternate or constant SCs in a ~S SB.")
156               (sb-kind sb))))               (sb-kind sb))))
157    
158    (let ((nstack-p    (let ((nstack-p
# Line 183  Line 183 
183    
184         (let ((old (svref (backend-sc-numbers *target-backend*) ',number)))         (let ((old (svref (backend-sc-numbers *target-backend*) ',number)))
185           (when (and old (not (eq (sc-name old) ',name)))           (when (and old (not (eq (sc-name old) ',name)))
186             (warn _"Redefining SC number ~D from ~S to ~S." ',number             (warn (intl:gettext "Redefining SC number ~D from ~S to ~S.") ',number
187                   (sc-name old) ',name)))                   (sc-name old) ',name)))
188    
189         (setf (svref (backend-sc-numbers *target-backend*) ',number)         (setf (svref (backend-sc-numbers *target-backend*) ',number)
# Line 223  Line 223 
223    All uses of DEFINE-MOVE-FUNCTION should be compiled before any uses of    All uses of DEFINE-MOVE-FUNCTION should be compiled before any uses of
224    DEFINE-VOP."    DEFINE-VOP."
225    (when (or (oddp (length scs)) (null scs))    (when (or (oddp (length scs)) (null scs))
226      (error _"Malformed SCs spec: ~S." scs))      (error (intl:gettext "Malformed SCs spec: ~S.") scs))
227    (check-type cost index)    (check-type cost index)
228    `(progn    `(progn
229       (eval-when (compile load eval)       (eval-when (compile load eval)
# Line 252  Line 252 
252    representation of the To-SCs.  If kind is :Move-Argument, then the VOP takes    representation of the To-SCs.  If kind is :Move-Argument, then the VOP takes
253    an extra argument, which is the frame pointer of the frame to move into."    an extra argument, which is the frame pointer of the frame to move into."
254    (when (or (oddp (length scs)) (null scs))    (when (or (oddp (length scs)) (null scs))
255      (error _"Malformed SCs spec: ~S." scs))      (error (intl:gettext "Malformed SCs spec: ~S.") scs))
256    (let ((accessor (or (cdr (assoc kind sc-vop-slots))    (let ((accessor (or (cdr (assoc kind sc-vop-slots))
257                        (error _"Unknown kind ~S." kind))))                        (error (intl:gettext "Unknown kind ~S.") kind))))
258      `(progn      `(progn
259         ,@(when (eq kind :move)         ,@(when (eq kind :move)
260             `((eval-when (compile load eval)             `((eval-when (compile load eval)
# Line 284  Line 284 
284  (defun meta-primitive-type-or-lose (name)  (defun meta-primitive-type-or-lose (name)
285    (the primitive-type    (the primitive-type
286         (or (gethash name (backend-meta-primitive-type-names *target-backend*))         (or (gethash name (backend-meta-primitive-type-names *target-backend*))
287             (error _"~S is not a defined primitive type." name))))             (error (intl:gettext "~S is not a defined primitive type.") name))))
288    
289  ;;; Def-Primitive-Type  --  Public  ;;; Def-Primitive-Type  --  Public
290  ;;;  ;;;
# Line 363  Line 363 
363                      #'(lambda (kind)                      #'(lambda (kind)
364                          (let ((slot (or (cdr (assoc kind                          (let ((slot (or (cdr (assoc kind
365                                                      primitive-type-slot-alist))                                                      primitive-type-slot-alist))
366                                          (error _"Unknown kind: ~S." kind))))                                          (error (intl:gettext "Unknown kind: ~S.") kind))))
367                            `(setf (,slot ,n-type) ,n-vop)))                            `(setf (,slot ,n-type) ,n-vop)))
368                      kinds)))                      kinds)))
369            types)            types)
# Line 579  Line 579 
579                       :key #'operand-parse-name)))                       :key #'operand-parse-name)))
580      (if found      (if found
581          (unless (member (operand-parse-kind found) kinds)          (unless (member (operand-parse-kind found) kinds)
582            (error _"Operand ~S isn't one of these kinds: ~S." name kinds))            (error (intl:gettext "Operand ~S isn't one of these kinds: ~S.") name kinds))
583          (when error-p          (when error-p
584            (error _"~S is not an operand to ~S." name (vop-parse-name parse))))            (error (intl:gettext "~S is not an operand to ~S.") name (vop-parse-name parse))))
585      found))      found))
586    
587    
# Line 594  Line 594 
594  (defun vop-parse-or-lose (name &optional (backend *target-backend*))  (defun vop-parse-or-lose (name &optional (backend *target-backend*))
595    (the vop-parse    (the vop-parse
596         (or (gethash name (backend-parsed-vops backend))         (or (gethash name (backend-parsed-vops backend))
597             (error _"~S is not the name of a defined VOP." name))))             (error (intl:gettext "~S is not the name of a defined VOP.") name))))
598    
599    
600  ;;; Access-Operands  --  Internal  ;;; Access-Operands  --  Internal
# Line 636  Line 636 
636  (defun vop-spec-arg (spec type &optional (n 1) (last t))  (defun vop-spec-arg (spec type &optional (n 1) (last t))
637    (let ((len (length spec)))    (let ((len (length spec)))
638      (when (<= len n)      (when (<= len n)
639        (error _"~:R argument missing: ~S." n spec))        (error (intl:gettext "~:R argument missing: ~S.") n spec))
640      (when (and last (> len (1+ n)))      (when (and last (> len (1+ n)))
641        (error _"Extra junk at end of ~S." spec))        (error (intl:gettext "Extra junk at end of ~S.") spec))
642      (let ((thing (elt spec n)))      (let ((thing (elt spec n)))
643        (unless (typep thing type)        (unless (typep thing type)
644          (error _"~:R argument is not a ~S: ~S." n type spec))          (error (intl:gettext "~:R argument is not a ~S: ~S.") n type spec))
645        thing)))        thing)))
646    
647    
# Line 658  Line 658 
658    (let ((dspec (if (atom spec) (list spec 0) spec)))    (let ((dspec (if (atom spec) (list spec 0) spec)))
659      (unless (and (= (length dspec) 2)      (unless (and (= (length dspec) 2)
660                   (typep (second dspec) 'unsigned-byte))                   (typep (second dspec) 'unsigned-byte))
661        (error _"Malformed time specifier: ~S." spec))        (error (intl:gettext "Malformed time specifier: ~S.") spec))
662    
663      (cons (case (first dspec)      (cons (case (first dspec)
664              (:load 0)              (:load 0)
# Line 667  Line 667 
667              (:result 3)              (:result 3)
668              (:save 4)              (:save 4)
669              (t              (t
670               (error _"Unknown phase in time specifier: ~S." spec)))               (error (intl:gettext "Unknown phase in time specifier: ~S.") spec)))
671            (second dspec))))            (second dspec))))
672    
673    
# Line 713  Line 713 
713        (dolist (op (vop-parse-operands parse))        (dolist (op (vop-parse-operands parse))
714          (when (operand-parse-target op)          (when (operand-parse-target op)
715            (unless (member (operand-parse-kind op) '(:argument :temporary))            (unless (member (operand-parse-kind op) '(:argument :temporary))
716              (error _"Cannot target a ~S operand: ~S." (operand-parse-kind op)              (error (intl:gettext "Cannot target a ~S operand: ~S.") (operand-parse-kind op)
717                     (operand-parse-name op)))                     (operand-parse-name op)))
718            (let ((target (find-operand (operand-parse-target op) parse            (let ((target (find-operand (operand-parse-target op) parse
719                                        '(:temporary :result))))                                        '(:temporary :result))))
# Line 802  Line 802 
802                       (found (or (assoc alt (funs) :test #'member)                       (found (or (assoc alt (funs) :test #'member)
803                                  (rassoc name (funs)))))                                  (rassoc name (funs)))))
804                  (unless name                  (unless name
805                    (error _"No move function defined to ~:[save~;load~] SC ~S~                    (error (intl:gettext "No move function defined to ~:[save~;load~] SC ~S~
806                            ~:[to~;from~] from SC ~S."                            ~:[to~;from~] from SC ~S.")
807                           load-p sc-name load-p (sc-name alt)))                           load-p sc-name load-p (sc-name alt)))
808    
809                  (cond (found                  (cond (found
810                         (unless (eq (cdr found) name)                         (unless (eq (cdr found) name)
811                           (error _"Can't tell whether to ~:[save~;load~] with ~S~@                           (error (intl:gettext "Can't tell whether to ~:[save~;load~] with ~S~@
812                                   or ~S when operand is in SC ~S."                                   or ~S when operand is in SC ~S.")
813                                  load-p name (cdr found) (sc-name alt)))                                  load-p name (cdr found) (sc-name alt)))
814                         (pushnew alt (car found)))                         (pushnew alt (car found)))
815                        (t                        (t
816                         (funs (cons (list alt) name))))))))                         (funs (cons (list alt) name))))))))
817           ((member (sb-kind (sc-sb sc)) '(:non-packed :unbounded)))           ((member (sb-kind (sc-sb sc)) '(:non-packed :unbounded)))
818           (t           (t
819            (error _"SC ~S has no alternate~:[~; or constant~] SCs, yet it is~@            (error (intl:gettext "SC ~S has no alternate~:[~; or constant~] SCs, yet it is~@
820                    mentioned in the restriction for operand ~S."                    mentioned in the restriction for operand ~S.")
821                   sc-name load-p (operand-parse-name op))))))                   sc-name load-p (operand-parse-name op))))))
822      (funs)))      (funs)))
823    
# Line 855  Line 855 
855                `(when (eq ,load-tn ,(operand-parse-name op))                `(when (eq ,load-tn ,(operand-parse-name op))
856                   ,form)))                   ,form)))
857          `(when ,load-tn          `(when ,load-tn
858             (error _"Load TN allocated, but no move function?~@             (error (intl:gettext "Load TN allocated, but no move function?~@
859                     VM definition inconsistent, recompile and try again.")))))                     VM definition inconsistent, recompile and try again."))))))
860    
861  ;;; DECIDE-TO-LOAD  --  Internal  ;;; DECIDE-TO-LOAD  --  Internal
862  ;;;  ;;;
# Line 957  Line 957 
957      (collect ((operands))      (collect ((operands))
958        (dolist (spec specs)        (dolist (spec specs)
959          (unless (and (consp spec) (symbolp (first spec)) (oddp (length spec)))          (unless (and (consp spec) (symbolp (first spec)) (oddp (length spec)))
960            (error _"Malformed operand specifier: ~S." spec))            (error (intl:gettext "Malformed operand specifier: ~S.") spec))
961          (when more          (when more
962            (error _"More operand isn't last: ~S." specs))            (error (intl:gettext "More operand isn't last: ~S.") specs))
963          (let* ((name (first spec))          (let* ((name (first spec))
964                 (old (if (vop-parse-inherits parse)                 (old (if (vop-parse-inherits parse)
965                          (find-operand name                          (find-operand name
# Line 1012  Line 1012 
1012                   (setf (operand-parse-target res) value))                   (setf (operand-parse-target res) value))
1013                  (:from                  (:from
1014                   (unless (eq kind :result)                   (unless (eq kind :result)
1015                     (error _"Can only specify :FROM in a result: ~S" spec))                     (error (intl:gettext "Can only specify :FROM in a result: ~S") spec))
1016                   (setf (operand-parse-born res) (parse-time-spec value)))                   (setf (operand-parse-born res) (parse-time-spec value)))
1017                  (:to                  (:to
1018                   (unless (eq kind :argument)                   (unless (eq kind :argument)
1019                     (error _"Can only specify :TO in an argument: ~S" spec))                     (error (intl:gettext "Can only specify :TO in an argument: ~S") spec))
1020                   (setf (operand-parse-dies res) (parse-time-spec value)))                   (setf (operand-parse-dies res) (parse-time-spec value)))
1021                  (t                  (t
1022                   (error _"Unknown keyword in operand specifier: ~S." spec)))))                   (error (intl:gettext "Unknown keyword in operand specifier: ~S.") spec)))))
1023    
1024            (cond ((not more)            (cond ((not more)
1025                   (operands res))                   (operands res))
1026                  ((operand-parse-target more)                  ((operand-parse-target more)
1027                   (error _"Cannot specify :TARGET in a :MORE operand."))                   (error (intl:gettext "Cannot specify :TARGET in a :MORE operand.")))
1028                  ((operand-parse-load more)                  ((operand-parse-load more)
1029                   (error _"Cannot specify :LOAD-IF in a :MORE operand.")))))                   (error (intl:gettext "Cannot specify :LOAD-IF in a :MORE operand."))))))
1030        (values (the list (operands)) more))))        (values (the list (operands)) more))))
1031    
1032    
# Line 1040  Line 1040 
1040             (type vop-parse parse))             (type vop-parse parse))
1041    (let ((len (length spec)))    (let ((len (length spec)))
1042      (unless (>= len 2)      (unless (>= len 2)
1043        (error _"Malformed temporary spec: ~S." spec))        (error (intl:gettext "Malformed temporary spec: ~S.") spec))
1044      (unless (listp (second spec))      (unless (listp (second spec))
1045        (error _"Malformed options list: ~S." (second spec)))        (error (intl:gettext "Malformed options list: ~S.") (second spec)))
1046      (unless (evenp (length (second spec)))      (unless (evenp (length (second spec)))
1047        (error _"Odd number of arguments in keyword options: ~S." spec))        (error (intl:gettext "Odd number of arguments in keyword options: ~S.") spec))
1048      (unless (consp (cddr spec))      (unless (consp (cddr spec))
1049        (warn _"Temporary spec allocates no temps:~%  ~S" spec))        (warn (intl:gettext "Temporary spec allocates no temps:~%  ~S") spec))
1050      (dolist (name (cddr spec))      (dolist (name (cddr spec))
1051        (unless (symbolp name)        (unless (symbolp name)
1052          (error _"Bad temporary name: ~S." name))          (error (intl:gettext "Bad temporary name: ~S.") name))
1053        (let ((res (make-operand-parse :name name  :kind :temporary        (let ((res (make-operand-parse :name name  :kind :temporary
1054                                       :temp-temp (gensym)                                       :temp-temp (gensym)
1055                                       :born (parse-time-spec :load)                                       :born (parse-time-spec :load)
# Line 1076  Line 1076 
1076              (:scs              (:scs
1077               (let ((scs (vop-spec-arg opt 'list 1 nil)))               (let ((scs (vop-spec-arg opt 'list 1 nil)))
1078                 (unless (= (length scs) 1)                 (unless (= (length scs) 1)
1079                   (error _"Must specify exactly one SC for a temporary."))                   (error (intl:gettext "Must specify exactly one SC for a temporary.")))
1080                 (setf (operand-parse-sc res) (first scs))))                 (setf (operand-parse-sc res) (first scs))))
1081              (:type)              (:type)
1082              (t              (t
1083               (error _"Unknown temporary option: ~S." opt))))               (error (intl:gettext "Unknown temporary option: ~S.") opt))))
1084    
1085          (unless (and (time-spec-order (operand-parse-dies res)          (unless (and (time-spec-order (operand-parse-dies res)
1086                                        (operand-parse-born res))                                        (operand-parse-born res))
1087                       (not (time-spec-order (operand-parse-born res)                       (not (time-spec-order (operand-parse-born res)
1088                                             (operand-parse-dies res))))                                             (operand-parse-dies res))))
1089            (error _"Temporary lifetime doesn't begin before it ends: ~S." spec))            (error (intl:gettext "Temporary lifetime doesn't begin before it ends: ~S.") spec))
1090    
1091          (unless (operand-parse-sc res)          (unless (operand-parse-sc res)
1092            (error _"Must specifiy :SC for all temporaries: ~S" spec))            (error (intl:gettext "Must specifiy :SC for all temporaries: ~S") spec))
1093    
1094          (setf (vop-parse-temps parse)          (setf (vop-parse-temps parse)
1095                (cons res                (cons res
# Line 1107  Line 1107 
1107    (declare (type vop-parse parse) (list specs))    (declare (type vop-parse parse) (list specs))
1108    (dolist (spec specs)    (dolist (spec specs)
1109      (unless (consp spec)      (unless (consp spec)
1110        (error _"Malformed option specification: ~S." spec))        (error (intl:gettext "Malformed option specification: ~S.") spec))
1111      (case (first spec)      (case (first spec)
1112        (:args        (:args
1113         (multiple-value-bind         (multiple-value-bind
# Line 1177  Line 1177 
1177               (vop-spec-arg spec               (vop-spec-arg spec
1178                             '(member t nil :compute-only :force-to-stack))))                             '(member t nil :compute-only :force-to-stack))))
1179        (t        (t
1180         (error _"Unknown option specifier: ~S." (first spec)))))         (error (intl:gettext "Unknown option specifier: ~S.") (first spec)))))
1181    (undefined-value))    (undefined-value))
1182    
1183    
# Line 1212  Line 1212 
1212                             (aref (sc-load-costs load-sc) op-scn)                             (aref (sc-load-costs load-sc) op-scn)
1213                             (aref (sc-load-costs op-sc) load-scn))))                             (aref (sc-load-costs op-sc) load-scn))))
1214              (unless load              (unless load
1215                (error _"No move function defined to move ~:[from~;to~] SC ~                (error (intl:gettext "No move function defined to move ~:[from~;to~] SC ~
1216                        ~S~%~:[to~;from~] alternate or constant SC ~S."                        ~S~%~:[to~;from~] alternate or constant SC ~S.")
1217                       load-p sc-name load-p (sc-name op-sc)))                       load-p sc-name load-p (sc-name op-sc)))
1218    
1219              (let ((op-cost (svref costs op-scn)))              (let ((op-cost (svref costs op-scn)))
# Line 1313  Line 1313 
1313                            (parse-operand-type alias)                            (parse-operand-type alias)
1314                            `(:or ,spec))))                            `(:or ,spec))))
1315                     ((atom spec)                     ((atom spec)
1316                      (error _"Bad thing to be a operand type: ~S." spec))                      (error (intl:gettext "Bad thing to be a operand type: ~S.") spec))
1317                     (t                     (t
1318                      (case (first spec)                      (case (first spec)
1319                        (:or                        (:or
# Line 1321  Line 1321 
1321                           (results :or)                           (results :or)
1322                           (dolist (item (cdr spec))                           (dolist (item (cdr spec))
1323                             (unless (symbolp item)                             (unless (symbolp item)
1324                               (error _"Bad PRIMITIVE-TYPE name in ~S: ~S"                               (error (intl:gettext "Bad PRIMITIVE-TYPE name in ~S: ~S")
1325                                      spec item))                                      spec item))
1326                             (let ((alias                             (let ((alias
1327                                    (gethash item                                    (gethash item
# Line 1330  Line 1330 
1330                               (if alias                               (if alias
1331                                   (let ((alias (parse-operand-type alias)))                                   (let ((alias (parse-operand-type alias)))
1332                                     (unless (eq (car alias) :or)                                     (unless (eq (car alias) :or)
1333                                       (error _"Can't include primitive-type ~                                       (error (intl:gettext "Can't include primitive-type ~
1334                                               alias ~S in a :OR restriction: ~S."                                               alias ~S in a :OR restriction: ~S.")
1335                                              item spec))                                              item spec))
1336                                     (dolist (x (cdr alias))                                     (dolist (x (cdr alias))
1337                                       (results x)))                                       (results x)))
# Line 1341  Line 1341 
1341                                              :start 1)))                                              :start 1)))
1342                        (:constant                        (:constant
1343                         (unless args-p                         (unless args-p
1344                           (error _"Can't :CONSTANT for a result."))                           (error (intl:gettext "Can't :CONSTANT for a result.")))
1345                         (unless (= (length spec) 2)                         (unless (= (length spec) 2)
1346                           (error _"Bad :CONSTANT argument type spec: ~S." spec))                           (error (intl:gettext "Bad :CONSTANT argument type spec: ~S.") spec))
1347                         spec)                         spec)
1348                        (t                        (t
1349                         (error _"Bad thing to be a operand type: ~S." spec)))))))                         (error (intl:gettext "Bad thing to be a operand type: ~S.") spec)))))))
1350      (mapcar #'parse-operand-type specs)))      (mapcar #'parse-operand-type specs)))
1351    
1352    
# Line 1374  Line 1374 
1374                                  (meta-primitive-type-or-lose ptype))                                  (meta-primitive-type-or-lose ptype))
1375                                 nil)                                 nil)
1376                      (when (svref load-scs rep) (return t)))                      (when (svref load-scs rep) (return t)))
1377              (error _"In the ~A ~:[result~;argument~] to VOP ~S,~@              (error (intl:gettext "In the ~A ~:[result~;argument~] to VOP ~S,~@
1378                      none of the SCs allowed by the operand type ~S can ~                      none of the SCs allowed by the operand type ~S can ~
1379                      directly be loaded~@                      directly be loaded~@
1380                      into any of the restriction's SCs:~%  ~S~:[~;~@                      into any of the restriction's SCs:~%  ~S~:[~;~@
1381                      [* type operand must allow T's SCs.]~]"                      [* type operand must allow T's SCs.]~]")
1382                     (operand-parse-name op) load-p (vop-parse-name parse)                     (operand-parse-name op) load-p (vop-parse-name parse)
1383                     ptype                     ptype
1384                     scs (eq type '*)))))                     scs (eq type '*)))))
# Line 1390  Line 1390 
1390                               (meta-sc-or-lose sc)                               (meta-sc-or-lose sc)
1391                               (meta-primitive-type-or-lose ptype))                               (meta-primitive-type-or-lose ptype))
1392                          (return t))))                          (return t))))
1393            (warn _"~:[Result~;Argument~] ~A to VOP ~S~@            (warn (intl:gettext "~:[Result~;Argument~] ~A to VOP ~S~@
1394                   has SC restriction ~S which is ~                   has SC restriction ~S which is ~
1395                   not allowed by the operand type:~%  ~S"                   not allowed by the operand type:~%  ~S")
1396                  load-p (operand-parse-name op) (vop-parse-name parse)                  load-p (operand-parse-name op) (vop-parse-name parse)
1397                  sc type)))))                  sc type)))))
1398    
# Line 1422  Line 1422 
1422      (when more-op      (when more-op
1423        (let ((mtype (car (last types))))        (let ((mtype (car (last types))))
1424          (when (and (consp mtype) (eq (first mtype) :constant))          (when (and (consp mtype) (eq (first mtype) :constant))
1425            (error _"Can't use :CONSTANT on VOP more args.")))))            (error (intl:gettext "Can't use :CONSTANT on VOP more args."))))))
1426    
1427    (when (vop-parse-translate parse)    (when (vop-parse-translate parse)
1428      (let ((types (specify-operand-types types ops more-op)))      (let ((types (specify-operand-types types ops more-op)))
# Line 1593  Line 1593 
1593    
1594      (let ((nvars (length (vop-parse-variant-vars parse))))      (let ((nvars (length (vop-parse-variant-vars parse))))
1595        (unless (= (length variant) nvars)        (unless (= (length variant) nvars)
1596          (error _"Expected ~D variant values: ~S." nvars variant)))          (error (intl:gettext "Expected ~D variant values: ~S.") nvars variant)))
1597    
1598      `(make-vop-info      `(make-vop-info
1599        :name ',(vop-parse-name parse)        :name ',(vop-parse-name parse)
# Line 1883  Line 1883 
1883           (n-template (gensym)))           (n-template (gensym)))
1884    
1885      (when (or (vop-parse-more-args parse) (vop-parse-more-results parse))      (when (or (vop-parse-more-args parse) (vop-parse-more-results parse))
1886        (error _"Cannot use VOP with variable operand count templates."))        (error (intl:gettext "Cannot use VOP with variable operand count templates.")))
1887      (unless (= noperands (length operands))      (unless (= noperands (length operands))
1888        (error _"Called with ~D operands, but was expecting ~D."        (error (intl:gettext "Called with ~D operands, but was expecting ~D.")
1889               (length operands) noperands))               (length operands) noperands))
1890    
1891      (multiple-value-bind      (multiple-value-bind
# Line 1946  Line 1946 
1946    
1947      (unless (or (vop-parse-more-args parse)      (unless (or (vop-parse-more-args parse)
1948                  (<= (length fixed-args) arg-count))                  (<= (length fixed-args) arg-count))
1949        (error _"Too many fixed arguments."))        (error (intl:gettext "Too many fixed arguments.")))
1950      (unless (or (vop-parse-more-results parse)      (unless (or (vop-parse-more-results parse)
1951                  (<= (length fixed-results) result-count))                  (<= (length fixed-results) result-count))
1952        (error _"Too many fixed results."))        (error (intl:gettext "Too many fixed results.")))
1953      (unless (= (length info) info-count)      (unless (= (length info) info-count)
1954        (error _"Expected ~D info args." info-count))        (error (intl:gettext "Expected ~D info args.") info-count))
1955    
1956      (multiple-value-bind      (multiple-value-bind
1957          (acode abinds n-args)          (acode abinds n-args)
# Line 1988  Line 1988 
1988      (collect ((clauses))      (collect ((clauses))
1989        (do ((cases forms (rest cases)))        (do ((cases forms (rest cases)))
1990            ((null cases)            ((null cases)
1991             (clauses `(t (error _"Unknown SC to SC-Case for ~S:~%  ~S" ,n-tn             (clauses `(t (error (intl:gettext "Unknown SC to SC-Case for ~S:~%  ~S") ,n-tn
1992                                 (sc-name (tn-sc ,n-tn))))))                                 (sc-name (tn-sc ,n-tn))))))
1993          (let ((case (first cases)))          (let ((case (first cases)))
1994            (when (atom case)            (when (atom case)
1995              (error _"Illegal SC-Case clause: ~S." case))              (error (intl:gettext "Illegal SC-Case clause: ~S.") case))
1996            (let ((head (first case)))            (let ((head (first case)))
1997              (when (eq head t)              (when (eq head t)
1998                (when (rest cases)                (when (rest cases)
1999                  (error _"T case is not last in SC-Case."))                  (error (intl:gettext "T case is not last in SC-Case.")))
2000                (clauses `(t nil ,@(rest case)))                (clauses `(t nil ,@(rest case)))
2001                (return))                (return))
2002              (clauses `((or ,@(mapcar #'(lambda (x)              (clauses `((or ,@(mapcar #'(lambda (x)

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

  ViewVC Help
Powered by ViewVC 1.1.5