← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to unixport/ansi_cl.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
unixport/ansi_cl.lisp
 
1
(setq clcs_shadow
 
2
 '(CONDITIONS::BREAK
 
3
   CONDITIONS::ERROR
 
4
   CONDITIONS::CERROR
 
5
   CONDITIONS::WARN
 
6
   CONDITIONS::CHECK-TYPE
 
7
   CONDITIONS::ASSERT
 
8
   CONDITIONS::ETYPECASE
 
9
   CONDITIONS::CTYPECASE
 
10
   CONDITIONS::ECASE
 
11
   CONDITIONS::CCASE ))
 
12
 
 
13
(setq lisp_unexport
 
14
 '(LISP::LAMBDA-BLOCK-CLOSURE
 
15
   LISP::BYE
 
16
   LISP::QUIT
 
17
   LISP::EXIT
 
18
   LISP::IEEE-FLOATING-POINT
 
19
   LISP::DEFENTRY
 
20
   LISP::VOID
 
21
   LISP::ALLOCATE-CONTIGUOUS-PAGES
 
22
   LISP::UNSIGNED-SHORT
 
23
   LISP::DOUBLE
 
24
   LISP::BY
 
25
   LISP::GBC
 
26
   LISP::DEFCFUN
 
27
   LISP::SAVE
 
28
   LISP::MAXIMUM-CONTIGUOUS-PAGES
 
29
   LISP::SPICE
 
30
   LISP::DEFLA
 
31
   LISP::ALLOCATED-PAGES
 
32
   LISP::SUN
 
33
   LISP::INT
 
34
   LISP::USE-FAST-LINKS
 
35
   LISP::CFUN
 
36
   LISP::UNSIGNED-CHAR
 
37
   LISP::HELP
 
38
   LISP::HELP*
 
39
   LISP::MACRO
 
40
   LISP::*BREAK-ENABLE*
 
41
   LISP::CLINES
 
42
   LISP::LAMBDA-CLOSURE
 
43
   LISP::OBJECT
 
44
   LISP::FAT-STRING
 
45
   LISP::SIGNED-SHORT
 
46
   LISP::MC68020
 
47
   LISP::LAMBDA-BLOCK
 
48
   LISP::TAG
 
49
   LISP::PROCLAMATION
 
50
   LISP::ALLOCATED-CONTIGUOUS-PAGES
 
51
   LISP::*EVAL-WHEN-COMPILE*
 
52
   LISP::SIGNED-CHAR
 
53
   LISP::*IGNORE-MAXIMUM-PAGES*
 
54
   LISP::*LINK-ARRAY*
 
55
   LISP::KCL
 
56
   LISP::BSD
 
57
   LISP::ALLOCATE-RELOCATABLE-PAGES
 
58
   LISP::ALLOCATE
 
59
   LISP::UNIX
 
60
   LISP::MAXIMUM-ALLOCATABLE-PAGES
 
61
   LISP::ALLOCATED-RELOCATABLE-PAGES
 
62
   LISP::SYSTEM
 
63
   LISP::KYOTO
 
64
   LISP::CCLOSURE))
 
65
 
 
66
;(dolist (s '(*compile-file-pathname* *compile-file-truename*
 
67
;*compile-print* *compile-verbose* *load-pathname* *load-print*
 
68
;*load-truename* *print-lines* *print-miser-width*
 
69
;*print-pprint-dispatch* *print-right-margin* *read-eval*))
 
70
;       (import (list s) "COMMON-LISP"))
 
71
 
 
72
;anything in "SYSTEM" which should go in "COMMON-LISP"
 
73
;can be added to shadow-system
 
74
(setf shadow-system '(system::copy-structure))
 
75
 
 
76
(do-external-symbols (s "SYSTEM")
 
77
                     (when (member s shadow-system)
 
78
                       (shadowing-import (list s) "COMMON-LISP")
 
79
                       (shadowing-import (list s) "USER")))
 
80
                         
 
81
 
 
82
(do-external-symbols (s "LISP")
 
83
  (if (not(member s lisp_unexport))
 
84
      (progn 
 
85
        (import (list s) "COMMON-LISP")
 
86
        (import (list s) "USER")) ))
 
87
 
 
88
(do-external-symbols (s "PCL")
 
89
  (import (list s) "COMMON-LISP")
 
90
  (import (list s) "USER"))
 
91
 
 
92
;(shadowing-import (list 'pcl::classp) "SYSTEM")
 
93
;(defun pcl::find-class-no-error (object)
 
94
;  (ignore-errors (find-class object)))
 
95
(setf (symbol-function 'si::classp) (symbol-function 'pcl::classp))
 
96
(setf (symbol-function 'si::class-of) (symbol-function 'pcl::class-of))
 
97
(setf (symbol-function 'si::class-precedence-list) 
 
98
        (symbol-function 'pcl::class-precedence-list))
 
99
(setf (symbol-function 'si::find-class) 
 
100
        (symbol-function 'pcl::find-class))
 
101
;(setf (symbol-function 'si::find-class-no-error) 
 
102
;       (symbol-function 'pcl::find-class-no-error))
 
103
 
 
104
(do-external-symbols (s "CONDITIONS")
 
105
  (if (member s clcs_shadow)
 
106
      (progn 
 
107
        (shadowing-import (list s) "COMMON-LISP")
 
108
        (shadowing-import (list s) "USER"))
 
109
      (progn
 
110
        (import (list s) "COMMON-LISP")
 
111
        (import (list s) "USER"))))
 
112
 
 
113
(dolist (s '(*compile-file-pathname* *compile-file-truename*
 
114
*compile-print* *compile-verbose* *load-pathname* *load-print*
 
115
*load-truename* *print-lines* *print-miser-width*
 
116
*print-pprint-dispatch* *print-right-margin* *read-eval*
 
117
lisp::arithmetic-error broadcast-stream-streams cell-error
 
118
cell-error-name compile compile-file compiler-macro
 
119
compiler-macro-function complement concatenated-stream-streams
 
120
condition control-error copy-pprint-dispatch copy-structure count
 
121
debug define-compiler-macro define-setf-expander define-symbol-macro
 
122
defpackage describe describe-object division-by-zero dynamic-extent
 
123
echo-stream-input-stream echo-stream-output-stream
 
124
ensure-directories-exist fdefinition file-string-length formatter
 
125
function-lambda-expression get-setf-expansion hash-table-rehash-size
 
126
hash-table-rehash-threshold ignorable interactive-stream-p
 
127
load-logical-pathname-translations load-time-value
 
128
logical-pathname-translations make-load-form
 
129
make-load-form-saving-slots make-method open-stream-p pathname-match-p
 
130
pprint-dispatch pprint-exit-if-list-exhausted pprint-fill
 
131
pprint-indent pprint-linear pprint-logical-block pprint-newline
 
132
pprint-pop pprint-tab pprint-tabular print-not-readable-object
 
133
print-unreadable-object read-sequence readtable-case row-major-aref
 
134
set-pprint-dispatch simple-condition-format-control
 
135
stream-external-format synonym-stream-symbol
 
136
translate-logical-pathname translate-pathname
 
137
two-way-stream-input-stream two-way-stream-output-stream
 
138
unbound-slot-instance 
 
139
upgraded-complex-part-type wild-pathname-p with-compilation-unit
 
140
with-condition-restarts with-package-iterator with-standard-io-syntax
 
141
write-sequence ))
 
142
        (shadowing-import (list s) "COMMON-LISP"))
 
143
 
 
144
(use-package "ANSI-LOOP" "COMMON-LISP")
 
145
(use-package "ANSI-LOOP" "USER")
 
146
 
 
147
(do-symbols (s "COMMON-LISP")
 
148
  (export (list s) "COMMON-LISP"))
 
149
  
 
150
(makunbound 'clcs_shadow)
 
151
(makunbound 'lisp_unexport)
 
152
(makunbound 'shadow-system)
 
153
(unintern 'clcs_shadow)
 
154
(unintern 'lisp_unexport)
 
155
(unintern 'int)
 
156
(unintern 'shadow-system)
 
157
 
 
158
(push :common-lisp *features*)
 
159
(push :ansi-cl *features*)
 
160
 
 
161
(rename-package 'common-lisp 'common-lisp '(cl))
 
162
(rename-package 'user 'common-lisp-user '(cl-user user))
 
163