Commit d8544caa authored by rtoy's avatar rtoy
Browse files

Merge intl-branch 2010-03-18 to HEAD. To build, you need to use

boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
parent a1482b8c
;; Bootstrap file for adding support for localization.
(setf lisp::*enable-package-locked-errors* nil)
(defvar lisp::*environment-list-initialized* nil)
(defpackage "INTL"
(:use "COMMON-LISP")
(:export "SETLOCALE" "TEXTDOMAIN" "GETTEXT" "DGETTEXT" "NGETTEXT" "DNGETTEXT"
"*TRANSLATABLE-DUMP-STREAM*" "READ-TRANSLATABLE-STRING"
"*LOCALE-DIRECTORIES*"))
(with-open-file (s "target:code/intl.lisp")
(compile-from-stream s))
(intl::install)
(in-package "C")
;; The textdomain for the documentation
(define-info-type function textdomain (or string null) nil)
(define-info-type variable textdomain (or string null) nil)
(define-info-type type textdomain (or string null) nil)
(define-info-type typed-structure textdomain (or string null) nil)
(define-info-type setf textdomain (or string null) nil)
;;;
;;; Like DEFSTRUCT, but silently clobber old definitions.
;;;
(defmacro defstruct! (name &rest stuff)
`(handler-bind ((error (lambda (c)
(declare (ignore c))
(invoke-restart 'kernel::clobber-it))))
(defstruct ,name ,@stuff)))
(defstruct! (template
(:print-function %print-template)
(:pure t))
;;
;; The symbol name of this VOP. This is used when printing the VOP and is
;; also used to provide a handle for definition and translation.
(name nil :type symbol)
;;
;; A Function-Type describing the arg/result type restrictions. We compute
;; this from the Primitive-Type restrictions to make life easier for IR1
;; phases that need to anticipate LTN's template selection.
(type (required-argument) :type function-type)
;;
;; Lists of restrictions on the argument and result types. A restriction may
;; take several forms:
;; -- The restriction * is no restriction at all.
;; -- A restriction (:OR <primitive-type>*) means that the operand must have
;; one of the specified primitive types.
;; -- A restriction (:CONSTANT <predicate> <type-spec>) means that the
;; argument (not a result) must be a compile-time constant that satisfies
;; the specified predicate function. In this case, the constant value
;; will be passed as an info argument rather than as a normal argument.
;; <type-spec> is a Lisp type specifier for the type tested by the
;; predicate, used when we want to represent the type constraint as a Lisp
;; function type.
;;
;; If Result-Types is :Conditional, then this is an IF-xxx style conditional
;; that yeilds its result as a control transfer. The emit function takes two
;; info arguments: the target label and a boolean flag indicating whether to
;; negate the sense of the test.
(arg-types nil :type list)
(result-types nil :type (or list (member :conditional)))
;;
;; The primitive type restriction applied to each extra argument or result
;; following the fixed operands. If NIL, no extra args/results are allowed.
;; Otherwise, either * or a (:OR ...) list as described for the
;; {ARG,RESULT}-TYPES.
(more-args-type nil :type (or (member nil *) cons))
(more-results-type nil :type (or (member nil *) cons))
;;
;; If true, this is a function that is called with no arguments to see if
;; this template can be emitted. This is used to conditionally compile for
;; different target hardware configuarations (e.g. FP hardware.)
(guard nil :type (or function null))
;;
;; The policy under which this template is the best translation. Note that
;; LTN might use this template under other policies if it can't figure our
;; anything better to do.
(policy (required-argument) :type policies)
;;
;; The base cost for this template, given optimistic assumptions such as no
;; operand loading, etc.
(cost (required-argument) :type index)
;;
;; If true, then a short noun-like phrase describing what this VOP "does",
;; i.e. the implementation strategy. This is for use in efficiency notes.
(note nil :type (or string null))
;;
;; The number of trailing arguments to VOP or %Primitive that we bundle into
;; a list and pass into the emit function. This provides a way to pass
;; uninterpreted stuff directly to the code generator.
(info-arg-count 0 :type index)
;;
;; A function that emits the VOPs for this template. Arguments:
;; 1] Node for source context.
;; 2] IR2-Block that we place the VOP in.
;; 3] This structure.
;; 4] Head of argument TN-Ref list.
;; 5] Head of result TN-Ref list.
;; 6] If Info-Arg-Count is non-zero, then a list of the magic arguments.
;;
;; Two values are returned: the first and last VOP emitted. This vop
;; sequence must be linked into the VOP Next/Prev chain for the block. At
;; least one VOP is always emitted.
(emit-function (required-argument) :type function)
;;
;; The text domain for the note.
(note-domain intl::*default-domain* :type (or string null)))
\ No newline at end of file
This diff is collapsed.
......@@ -5,11 +5,11 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alpha-vm.lisp,v 1.5 2009/06/11 16:03:57 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alpha-vm.lisp,v 1.6 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alpha-vm.lisp,v 1.5 2009/06/11 16:03:57 rtoy Rel $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alpha-vm.lisp,v 1.6 2010/03/19 15:18:58 rtoy Exp $
;;;
;;; This file contains the Alpha specific runtime stuff.
;;;
......@@ -19,6 +19,8 @@
(use-package "C-CALL")
(use-package "UNIX")
(intl:textdomain "cmucl")
(export '(fixup-code-object internal-error-arguments
sigcontext-program-counter sigcontext-register
sigcontext-float-register sigcontext-floating-point-modes
......@@ -60,11 +62,11 @@
;;;; MACHINE-TYPE and MACHINE-VERSION
(defun machine-type ()
"Returns a string describing the type of the local machine."
_N"Returns a string describing the type of the local machine."
"DECstation")
(defun machine-version ()
"Returns a string describing the version of the local machine."
_N"Returns a string describing the version of the local machine."
"DECstation")
......@@ -73,7 +75,7 @@
;;;
(defun fixup-code-object (code offset value kind)
(unless (zerop (rem offset word-bytes))
(error "Unaligned instruction? offset=#x~X." offset))
(error _"Unaligned instruction? offset=#x~X." offset))
(system:without-gcing
(let ((sap (truly-the system-area-pointer
(%primitive c::code-instructions code))))
......@@ -225,7 +227,7 @@
value
(let ((value (system:alternate-get-global-address name)))
(when (zerop value)
(error "Unknown foreign symbol: ~S" name))
(error _"Unknown foreign symbol: ~S" name))
value))))))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/amd64-vm.lisp,v 1.4 2009/10/10 03:00:03 agoncharov Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/amd64-vm.lisp,v 1.5 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -24,6 +24,8 @@
(use-package "UNIX")
(use-package "KERNEL")
(intl:textdomain "cmucl")
(export '(fixup-code-object internal-error-arguments
sigcontext-program-counter sigcontext-register
sigcontext-float-register sigcontext-floating-point-modes
......@@ -172,13 +174,13 @@
#-cross-compiler
(defun machine-type ()
"Returns a string describing the type of the local machine."
_N"Returns a string describing the type of the local machine."
"AMD x86-64")
#-cross-compiler
(defun machine-version ()
"Returns a string describing the version of the local machine."
_N"Returns a string describing the version of the local machine."
"AMD x86-64")
......@@ -228,7 +230,7 @@
(ncode-words (kernel:code-header-ref code 1))
(code-end-addr (+ code-start-addr (* ncode-words 8))))
(unless (member kind '(:absolute :relative))
(error "Unknown code-object-fixup kind ~s." kind))
(error _"Unknown code-object-fixup kind ~s." kind))
(ecase kind
(:absolute
;; Word at sap + offset contains a value to be replaced by
......@@ -468,7 +470,7 @@
value
(let ((value (system:alternate-get-global-address name)))
(when (zerop value)
(error "Unknown foreign symbol: ~S" name))
(error _"Unknown foreign symbol: ~S" name))
value))))))
......@@ -537,36 +539,36 @@
(defun %instance-set-conditional (object slot test-value new-value)
(declare (type instance object)
(type index slot))
"Atomically compare object's slot value to test-value and if EQ store
_N"Atomically compare object's slot value to test-value and if EQ store
new-value in the slot. The original value of the slot is returned."
(%instance-set-conditional object slot test-value new-value))
(defun set-symbol-value-conditional (symbol test-value new-value)
(declare (type symbol symbol))
"Atomically compare symbol's value to test-value and if EQ store
_N"Atomically compare symbol's value to test-value and if EQ store
new-value in symbol's value slot and return the original value."
(set-symbol-value-conditional symbol test-value new-value))
(defun rplaca-conditional (cons test-value new-value)
(declare (type cons cons))
"Atomically compare the car of CONS to test-value and if EQ store
_N"Atomically compare the car of CONS to test-value and if EQ store
new-value its car and return the original value."
(rplaca-conditional cons test-value new-value))
(defun rplacd-conditional (cons test-value new-value)
(declare (type cons cons))
"Atomically compare the cdr of CONS to test-value and if EQ store
_N"Atomically compare the cdr of CONS to test-value and if EQ store
new-value its cdr and return the original value."
(rplacd-conditional cons test-value new-value))
(defun data-vector-set-conditional (vector index test-value new-value)
(declare (type simple-vector vector))
"Atomically compare an element of vector to test-value and if EQ store
_N"Atomically compare an element of vector to test-value and if EQ store
new-value the element and return the original value."
(data-vector-set-conditional vector index test-value new-value))
(defmacro atomic-push-symbol-value (val symbol)
"Thread safe push of val onto the list in the symbol global value."
_N"Thread safe push of val onto the list in the symbol global value."
(ext:once-only ((n-val val))
(let ((new-list (gensym))
(old-list (gensym)))
......@@ -580,7 +582,7 @@
(return ,new-list))))))))
(defmacro atomic-pop-symbol-value (symbol)
"Thread safe pop from the list in the symbol global value."
_N"Thread safe pop from the list in the symbol global value."
(let ((new-list (gensym))
(old-list (gensym)))
`(loop
......@@ -592,7 +594,7 @@
(return (car ,old-list)))))))
(defmacro atomic-pusha (val cons)
"Thread safe push of val onto the list in the car of cons."
_N"Thread safe push of val onto the list in the car of cons."
(once-only ((n-val val)
(n-cons cons))
(let ((new-list (gensym))
......@@ -606,7 +608,7 @@
(return ,new-list))))))))
(defmacro atomic-pushd (val cons)
"Thread safe push of val onto the list in the cdr of cons."
_N"Thread safe push of val onto the list in the cdr of cons."
(once-only ((n-val val)
(n-cons cons))
(let ((new-list (gensym))
......@@ -620,7 +622,7 @@
(return ,new-list))))))))
(defmacro atomic-push-vector (val vect index)
"Thread safe push of val onto the list in the vector element."
_N"Thread safe push of val onto the list in the vector element."
(once-only ((n-val val)
(n-vect vect)
(n-index index))
......
This diff is collapsed.
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.14 2008/03/03 15:54:12 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.15 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -14,6 +14,8 @@
;;;
(in-package "LISP")
(intl:textdomain "cmucl")
;;; The flags passed back by BACKQUOTIFY can be interpreted as follows:
;;;
......@@ -43,7 +45,7 @@
;;;<hair> involves starting over again pretending you had read ".,a)" instead
;;; of ",@a)"
(defvar *backquote-count* 0 "How deep we are into backquotes")
(defvar *backquote-count* 0 _N"How deep we are into backquotes")
(defvar *bq-comma-flag* '(|,|))
(defvar *bq-at-flag* '(|,@|))
(defvar *bq-dot-flag* '(|,.|))
......@@ -59,9 +61,9 @@
(multiple-value-bind (flag thing)
(backquotify stream (read stream t nil t))
(if (eq flag *bq-at-flag*)
(%reader-error stream ",@ after backquote in ~S" thing))
(%reader-error stream _",@ after backquote in ~S" thing))
(if (eq flag *bq-dot-flag*)
(%reader-error stream ",. after backquote in ~S" thing))
(%reader-error stream _",. after backquote in ~S" thing))
(values (backquotify-1 flag thing) 'list))))
(defun comma-macro (stream ignore)
......@@ -69,7 +71,7 @@
(unless (> *backquote-count* 0)
(when *read-suppress*
(return-from comma-macro nil))
(%reader-error stream "Comma not inside a backquote."))
(%reader-error stream _"Comma not inside a backquote."))
(let ((c (read-char stream))
(*backquote-count* (1- *backquote-count*)))
(values
......@@ -110,9 +112,9 @@
(multiple-value-bind (dflag d) (backquotify stream (cdr code))
(if (eq dflag *bq-at-flag*)
;; get the errors later.
(%reader-error stream ",@ after dot in ~S" code))
(%reader-error stream _",@ after dot in ~S" code))
(if (eq dflag *bq-dot-flag*)
(%reader-error stream ",. after dot in ~S" code))
(%reader-error stream _",. after dot in ~S" code))
(cond
((eq aflag *bq-at-flag*)
(if (null dflag)
......@@ -236,7 +238,7 @@
))
(defun backq-unparse (form &optional splicing)
"Given a lisp form containing the magic functions BACKQ-LIST, BACKQ-LIST*,
_N"Given a lisp form containing the magic functions BACKQ-LIST, BACKQ-LIST*,
BACKQ-APPEND, etc. produced by the backquote reader macro, will return a
corresponding backquote input form. In this form, `,' `,@' and `,.' are
represented by lists whose cars are BACKQ-COMMA, BACKQ-COMMA-AT, and
......@@ -248,7 +250,7 @@
((atom form)
(backq-unparse-expr form splicing))
((not (null (cdr (last form))))
"### illegal dotted backquote form ###")
_"### illegal dotted backquote form ###")
(t
(case (car form)
(backq-list
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.47 2009/06/11 16:03:57 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.48 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -15,6 +15,8 @@
(in-package "BIGNUM")
(use-package "KERNEL")
(intl:textdomain "cmucl")
;;; These symbols define the interface to the number code.
(export '(add-bignums multiply-bignums negate-bignum subtract-bignum
......@@ -570,7 +572,7 @@
;; This might need some tuning
(declaim (fixnum *karatsuba-classical-cutoff*))
(defparameter *karatsuba-classical-cutoff* 10
"When the bignum pieces are smaller than this many words, we use the
_N"When the bignum pieces are smaller than this many words, we use the
classical multiplication algorithm instead of recursing all the way
down to individual words.")
......@@ -915,7 +917,7 @@ down to individual words.")
(%normalize-bignum res len-res)))
(defparameter *min-karatsuba-bits* 512
"Use Karatsuba if the bignums have at least this many bits")
_N"Use Karatsuba if the bignums have at least this many bits")
(defun multiply-bignums (a b)
(declare (type bignum-type a b))
......@@ -1135,7 +1137,7 @@ down to individual words.")
;;; Could do freelisting someday.
;;;
(defmacro with-bignum-buffers (specs &body body)
"WITH-BIGNUM-BUFFERS ({(var size [init])}*) Form*"
_N"WITH-BIGNUM-BUFFERS ({(var size [init])}*) Form*"
(ext:collect ((binds)
(inits))
(dolist (spec specs)
......@@ -1385,7 +1387,7 @@ down to individual words.")
(declare (type bignum-index len-a len-b) (type bignum-type a))
(do ((i 0 (1+ i))
(end (min len-a len-b)))
((= i end) (error "Unexpected zero bignums?"))
((= i end) (error _"Unexpected zero bignums?"))
(declare (type bignum-index i end))
(let ((or-digits (%logior (%bignum-ref a i) (%bignum-ref b i))))
(unless (zerop or-digits)
......@@ -1732,7 +1734,7 @@ down to individual words.")
(let* ((bignum-len (or bignum-len (%bignum-length bignum)))
(res-len (+ digits bignum-len 1)))
(when (> res-len maximum-bignum-length)
(error "Can't represent result of left shift."))
(error _"Can't represent result of left shift."))
(if (zerop n-bits)
(bignum-ashift-left-digits bignum bignum-len digits)
(bignum-ashift-left-unaligned bignum digits n-bits res-len)))))
......@@ -1959,7 +1961,7 @@ down to individual words.")
(when (> exp max)
(error 'simple-type-error
:datum x
:format-control "Too large to be represented as a ~S:~% ~S"
:format-control _"Too large to be represented as a ~S:~% ~S"
:format-arguments (list format x)
:expected-type format))
exp)))
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.25 2009/06/11 16:03:57 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.26 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -16,6 +16,7 @@
(in-package "VM")
(intl:textdomain "cmucl")
;;;; Constants and Types.
......@@ -24,10 +25,10 @@
(eval-when (compile load eval)
(defconstant unit-bits vm:word-bits
"The number of bits to process at a time.")
_N"The number of bits to process at a time.")
(defconstant max-bits (1- (ash 1 vm:word-bits))
"The maximum number of bits that can be dealt with during a single call.")
_N"The maximum number of bits that can be dealt with during a single call.")
(deftype unit ()
......@@ -78,7 +79,7 @@
(:little-endian little-endian))))
(defun shift-towards-start (number count)
"Shift NUMBER by COUNT bits, adding zero bits at the ``end'' and removing
_N"Shift NUMBER by COUNT bits, adding zero bits at the ``end'' and removing
bits from the ``start.'' On big-endian machines this is a left-shift and
on little-endian machines this is a right-shift. Note: only the low 5/6 bits
of count are significant."
......@@ -92,7 +93,7 @@
(ash number (- count))))))
(defun shift-towards-end (number count)
"Shift NUMBER by COUNT bits, adding zero bits at the ``start'' and removing
_N"Shift NUMBER by COUNT bits, adding zero bits at the ``start'' and removing
bits from the ``end.'' On big-endian machines this is a right-shift and
on little-endian machines this is a left-shift."
(declare (type unit number) (fixnum count))
......@@ -106,20 +107,20 @@
(declaim (inline start-mask end-mask fix-sap-and-offset))
(defun start-mask (count)
"Produce a mask that contains 1's for the COUNT ``start'' bits and 0's for
_N"Produce a mask that contains 1's for the COUNT ``start'' bits and 0's for
the remaining ``end'' bits. Only the lower 5 bits of COUNT are significant."
(declare (fixnum count))
(shift-towards-start (1- (ash 1 unit-bits)) (- count)))
(defun end-mask (count)
"Produce a mask that contains 1's for the COUNT ``end'' bits and 0's for
_N"Produce a mask that contains 1's for the COUNT ``end'' bits and 0's for
the remaining ``start'' bits. Only the lower 5 bits of COUNT are
significant."
(declare (fixnum count))
(shift-towards-end (1- (ash 1 unit-bits)) (- count)))
(defun fix-sap-and-offset (sap offset)
"Align the SAP to a word boundry, and update the offset accordingly."
_N"Align the SAP to a word boundry, and update the offset accordingly."
(declare (type system-area-pointer sap)
(type index offset)
(values system-area-pointer index))
......@@ -156,7 +157,7 @@
(declaim (inline do-constant-bit-bash))
(defun do-constant-bit-bash (dst dst-offset length value dst-ref-fn dst-set-fn)
"Fill DST with VALUE starting at DST-OFFSET and continuing for LENGTH bits."
_N"Fill DST with VALUE starting at DST-OFFSET and continuing for LENGTH bits."
(declare (type offset dst-offset) (type unit value)
(type function dst-ref-fn dst-set-fn))
(multiple-value-bind (dst-word-offset dst-bit-offset)
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bsd-os.lisp,v 1.13 2009/10/10 03:00:03 agoncharov Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bsd-os.lisp,v 1.14 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -21,6 +21,9 @@
(in-package "SYSTEM")
(use-package "EXTENSIONS")
(intl:textdomain "cmucl-bsd-os")
(export '(get-system-info get-page-size os-init))
(register-lisp-feature :bsd)
......@@ -45,10 +48,10 @@
#+Darwin "Darwin"
#-(or freebsd NetBSD OpenBSD Darwin) "BSD")
(defvar *software-version* nil "Version string for supporting software")
(defvar *software-version* nil _N"Version string for supporting software")
(defun software-version ()
"Returns a string describing version of the supporting software."
_N"Returns a string describing version of the supporting software."
(unless *software-version*
(setf *software-version*
(string-trim '(#\newline)
......@@ -76,7 +79,7 @@
(unix:unix-getrusage unix:rusage_self)
(declare (ignore maxrss ixrss idrss isrss minflt))
(unless err?
(error "Unix system call getrusage failed: ~A."
(error _"Unix system call getrusage failed: ~A."
(unix:get-unix-error-msg utime)))
(values utime stime majflt)))
......@@ -90,5 +93,5 @@
(multiple-value-bind (val err)
(unix:unix-getpagesize)
(unless val
(error "Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
(error _"Getpagesize failed: ~A" (unix:get-unix-error-msg err)))
val))
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.46 2009/06/11 16:03:57 rtoy Rel $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.47 2010/03/19 15:18:58 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -16,6 +16,9 @@
(in-package "C")
(in-package "KERNEL")
(intl:textdomain "cmucl")
(export '(byte-function byte-function-name initialize-byte-compiled-function
byte-closure byte-closure-function
byte-closure-data byte-function-or-closure
......@@ -188,11 +191,11 @@
;;;; The stack.
(defvar *eval-stack* (make-array 100)
"This is the interpreter's evaluation stack.")
_N"This is the interpreter's evaluation stack.")
(declaim (type simple-vector *eval-stack*))
(defvar *eval-stack-top* 0
"This is the next free element of the interpreter's evaluation stack.")
_N"This is the next free element of the interpreter's evaluation stack.")
(declaim (type index *eval-stack-top*))
(defmacro current-stack-pointer () '*eval-stack-top*)
......@@ -447,7 +450,7 @@
`(push-eval-stack ,res))
results)))
`(push-eval-stack ,func))))
`(error "Unknown inline function, id=~D" ,base)))
`(error _"Unknown inline function, id=~D" ,base)))
`(if (zerop (logand byte ,(ash 1 bit)))
,(build-dispatch (1- bit) base)
,(build-dispatch (1- bit) (+ base (ash 1 bit)))))))
......@@ -472,7 +475,7 @@
`(let ((x ,x))
(unless (boundp x)
(with-debugger-info (component pc fp)
(error "Unbound variable: ~S" x)))
(error _"Unbound variable: ~S" x)))
(symbol-value x)))
(defmacro %byte-car (x)
......@@ -480,7 +483,7 @@
(unless (listp x)
(with-debugger-info (component pc fp)
(error 'simple-type-error :datum x :expected-type 'list
:format-control "Non-list argument to CAR: ~S"
:format-control _"Non-list argument to CAR: ~S"
:format-arguments (list x))))
(car x)))
......@@ -489,7 +492,7 @@
(unless (listp x)
(with-debugger-info (component pc fp)
(error 'simple-type-error :datum x :expected-type 'list
:format-control "Non-list argument to CDR: ~S"
:format-control _"Non-list argument to CDR: ~S"