/[cmucl]/src/bootfiles/20a/boot-2010-02-1.lisp
ViewVC logotype

Contents of /src/bootfiles/20a/boot-2010-02-1.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Wed Apr 21 00:53:05 2010 UTC (4 years ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, cross-sol-x86-base, sparc-tramp-assem-base, snapshot-2010-12, snapshot-2010-11, cross-sol-x86-merged, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-06, release-20b-pre1, release-20b-pre2, cross-sparc-branch-base, snapshot-2010-05, snapshot-2010-07, sparc-tramp-assem-2010-07-19, snapshot-2010-08, RELEASE_20b, cross-sol-x86-2010-12-20, HEAD
Branch point for: cross-sol-x86-branch, cross-sparc-branch, sparc-tramp-assem-branch, RELEASE-20B-BRANCH
Changes since 1.2: +1 -1 lines
Don't export *TRANSLATABLE-DUMP-STREAM*, which doesn't exist anymore.
1 ;; Bootstrap file for adding support for localization.
2
3 (setf lisp::*enable-package-locked-errors* nil)
4
5 (defvar lisp::*environment-list-initialized* nil)
6
7 (defpackage "INTL"
8 (:use "COMMON-LISP")
9 (:export "SETLOCALE" "TEXTDOMAIN" "GETTEXT" "DGETTEXT" "NGETTEXT" "DNGETTEXT"
10 "READ-TRANSLATABLE-STRING"
11 "*LOCALE-DIRECTORIES*"))
12
13 (with-open-file (s "target:code/intl.lisp")
14 (compile-from-stream s))
15
16 (intl::install)
17
18
19 (in-package "C")
20 ;; The textdomain for the documentation
21 (define-info-type function textdomain (or string null) nil)
22 (define-info-type variable textdomain (or string null) nil)
23 (define-info-type type textdomain (or string null) nil)
24 (define-info-type typed-structure textdomain (or string null) nil)
25 (define-info-type setf textdomain (or string null) nil)
26
27 ;;;
28 ;;; Like DEFSTRUCT, but silently clobber old definitions.
29 ;;;
30 (defmacro defstruct! (name &rest stuff)
31 `(handler-bind ((error (lambda (c)
32 (declare (ignore c))
33 (invoke-restart 'kernel::clobber-it))))
34 (defstruct ,name ,@stuff)))
35
36
37 (defstruct! (template
38 (:print-function %print-template)
39 (:pure t))
40 ;;
41 ;; The symbol name of this VOP. This is used when printing the VOP and is
42 ;; also used to provide a handle for definition and translation.
43 (name nil :type symbol)
44 ;;
45 ;; A Function-Type describing the arg/result type restrictions. We compute
46 ;; this from the Primitive-Type restrictions to make life easier for IR1
47 ;; phases that need to anticipate LTN's template selection.
48 (type (required-argument) :type function-type)
49 ;;
50 ;; Lists of restrictions on the argument and result types. A restriction may
51 ;; take several forms:
52 ;; -- The restriction * is no restriction at all.
53 ;; -- A restriction (:OR <primitive-type>*) means that the operand must have
54 ;; one of the specified primitive types.
55 ;; -- A restriction (:CONSTANT <predicate> <type-spec>) means that the
56 ;; argument (not a result) must be a compile-time constant that satisfies
57 ;; the specified predicate function. In this case, the constant value
58 ;; will be passed as an info argument rather than as a normal argument.
59 ;; <type-spec> is a Lisp type specifier for the type tested by the
60 ;; predicate, used when we want to represent the type constraint as a Lisp
61 ;; function type.
62 ;;
63 ;; If Result-Types is :Conditional, then this is an IF-xxx style conditional
64 ;; that yeilds its result as a control transfer. The emit function takes two
65 ;; info arguments: the target label and a boolean flag indicating whether to
66 ;; negate the sense of the test.
67 (arg-types nil :type list)
68 (result-types nil :type (or list (member :conditional)))
69 ;;
70 ;; The primitive type restriction applied to each extra argument or result
71 ;; following the fixed operands. If NIL, no extra args/results are allowed.
72 ;; Otherwise, either * or a (:OR ...) list as described for the
73 ;; {ARG,RESULT}-TYPES.
74 (more-args-type nil :type (or (member nil *) cons))
75 (more-results-type nil :type (or (member nil *) cons))
76 ;;
77 ;; If true, this is a function that is called with no arguments to see if
78 ;; this template can be emitted. This is used to conditionally compile for
79 ;; different target hardware configuarations (e.g. FP hardware.)
80 (guard nil :type (or function null))
81 ;;
82 ;; The policy under which this template is the best translation. Note that
83 ;; LTN might use this template under other policies if it can't figure our
84 ;; anything better to do.
85 (policy (required-argument) :type policies)
86 ;;
87 ;; The base cost for this template, given optimistic assumptions such as no
88 ;; operand loading, etc.
89 (cost (required-argument) :type index)
90 ;;
91 ;; If true, then a short noun-like phrase describing what this VOP "does",
92 ;; i.e. the implementation strategy. This is for use in efficiency notes.
93 (note nil :type (or string null))
94 ;;
95 ;; The number of trailing arguments to VOP or %Primitive that we bundle into
96 ;; a list and pass into the emit function. This provides a way to pass
97 ;; uninterpreted stuff directly to the code generator.
98 (info-arg-count 0 :type index)
99 ;;
100 ;; A function that emits the VOPs for this template. Arguments:
101 ;; 1] Node for source context.
102 ;; 2] IR2-Block that we place the VOP in.
103 ;; 3] This structure.
104 ;; 4] Head of argument TN-Ref list.
105 ;; 5] Head of result TN-Ref list.
106 ;; 6] If Info-Arg-Count is non-zero, then a list of the magic arguments.
107 ;;
108 ;; Two values are returned: the first and last VOP emitted. This vop
109 ;; sequence must be linked into the VOP Next/Prev chain for the block. At
110 ;; least one VOP is always emitted.
111 (emit-function (required-argument) :type function)
112 ;;
113 ;; The text domain for the note.
114 (note-domain intl::*default-domain* :type (or string null)))

  ViewVC Help
Powered by ViewVC 1.1.5