← Back to branch summary

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

« back to all changes in this revision

Viewing changes to pcl/impl/symbolics/rel-7-2-patches.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:
pcl/impl/symbolics/rel-7-2-patches.lisp
 
1
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ZL-USER; Base: 10; Patch-File: T -*-
 
2
 
 
3
;=====================================
 
4
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
 
5
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:l-COMPILER;OPTIMIZE.LISP.179")
 
6
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
 
7
  "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-")
 
8
 
 
9
;;; Does simple constant folding.  This works for everything that doesn't have
 
10
;;; side-effects.
 
11
;;; ALL operands must be constant.
 
12
;;; Note that commutative-constant-folder can hack this case perfectly well
 
13
;;; by himself for the functions he handles.
 
14
(defun constant-fold-optimizer (form)
 
15
  (let ((eval-when-load-p nil))
 
16
    (flet ((constant-form-p (x)
 
17
             (when (constant-form-p x)
 
18
               (cond ((and (listp x)
 
19
                           (eq (car x) 'quote)
 
20
                           (listp (cadr x))
 
21
                           (eq (caadr x) eval-at-load-time-marker))
 
22
                      (setq eval-when-load-p t)
 
23
                      (cdadr x))
 
24
                     (t x)))))
 
25
      (if (every (cdr form) #'constant-form-p)
 
26
          (if eval-when-load-p
 
27
              (list 'quote
 
28
                    (list* eval-at-load-time-marker
 
29
                           (car form)
 
30
                           (mapcar #'constant-form-p (cdr form))))
 
31
              (condition-case (error-object)
 
32
                   (multiple-value-call #'(lambda (&rest values)
 
33
                                            (if (= (length values) 1)
 
34
                                                `',(first values)
 
35
                                                `(values ,@(mapcar #'(lambda (x) `',x)
 
36
                                                                   values))))
 
37
                                        (eval form))
 
38
                 (error
 
39
                   (phase-1-warning "Constant form left unoptimized: ~S~%because: ~~A~"
 
40
                                    form error-object)
 
41
                   form)))
 
42
          form))))
 
43
 
 
44
 
 
45
;=====================================
 
46
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
 
47
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:L-COMPILER;COMFILE.LISP.85")
 
48
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
 
49
  "-*- Mode: Lisp; Package: Compiler; Lowercase: T; Base: 8 -*-")
 
50
 
 
51
;;;
 
52
;;; The damn compiler doesn't compile random forms that appear at top level.
 
53
;;; Its difficult to do because you have to get an associated function spec
 
54
;;; to go with those forms.  This handles that by defining a special form,
 
55
;;; top-level-form that compiles its body.  It takes a list of eval-when
 
56
;;; times just like eval when does.  It also takes a name which it uses
 
57
;;; to construct a function spec for the top-level-form function it has
 
58
;;; to create.
 
59
;;; 
 
60
;
 
61
;si::
 
62
;(defvar *top-level-form-fdefinitions* (cl:make-hash-table :test #'equal))
 
63
;
 
64
;si::
 
65
;(define-function-spec-handler pcl::top-level-form
 
66
;                             (operation fspec &optional arg1 arg2)
 
67
;  (let ((name (cadr fspec)))
 
68
;    (selectq operation
 
69
;      (validate-function-spec (and (= (length fspec) 2)
 
70
;                                  (or (symbolp name)
 
71
;                                      (listp name))))
 
72
;      (fdefine
 
73
;       (setf (gethash name *top-level-form-fdefinitions*) arg1))
 
74
;      ((fdefinition fdefinedp)
 
75
;       (gethash name *top-level-form-fdefinitions*)) 
 
76
;      (fdefinition-location 
 
77
;       (ferror "It is not possible to get the fdefinition-location of ~s."
 
78
;              fspec))
 
79
;      (fundefine (remhash name *top-level-form-fdefinitions*))
 
80
;      (otherwise (function-spec-default-handler operation fspec arg1 arg2)))))
 
81
;
 
82
;;;
 
83
;;; This is basically stolen from PROGN (surprised?)
 
84
;;; 
 
85
;(si:define-special-form pcl::top-level-form (name times
 
86
;                                                 &body body
 
87
;                                                 &environment env)
 
88
;  (declare lt:(arg-template . body) (ignore name))
 
89
;  (si:check-eval-when-times times)
 
90
;  (when (member 'eval times) (si:eval-body body env)))
 
91
;
 
92
;(defun (:property pcl::top-level-form lt:mapforms) (original-form form usage)
 
93
;  (lt::mapforms-list original-form form (cddr form) 'eval usage))
 
94
 
 
95
;;; This is the normal function for looking at each form read from the file and calling
 
96
;;; *COMPILE-FORM-FUNCTION* on the sub-forms of it.
 
97
;;; COMPILE-TIME-TOO means override the normal cases that eval at compile time.  It is
 
98
;;; used for recursive calls under (EVAL-WHEN (COMPILE LOAD) ...).
 
99
;(DEFUN COMPILE-FROM-STREAM-1 (FORM &OPTIONAL (COMPILE-TIME-TOO NIL))
 
100
;  (CATCH-ERROR-RESTART
 
101
;     (SYS:ERROR "Skip compiling form ~2,2\COMPILER:SHORT-S-FORMAT\" FORM)
 
102
;    (LET ((DEFAULT-CONS-AREA (FUNCALL *COMPILE-FUNCTION* ':CONS-AREA)))
 
103
;      (LET ((ERROR-MESSAGE-HOOK
 
104
;             #'(LAMBDA ()
 
105
;                 (DECLARE (SYS:DOWNWARD-FUNCTION))
 
106
;                 (FORMAT T "~&While processing ~V,V\COMPILER:SHORT-S-FORMAT\"
 
107
;                         DBG:*ERROR-MESSAGE-PRINLEVEL*
 
108
;                         DBG:*ERROR-MESSAGE-PRINLENGTH*
 
109
;                         FORM))))
 
110
;       (SETQ FORM (FUNCALL *COMPILE-FUNCTION* ':MACRO-EXPAND FORM)))
 
111
;      (WHEN (LISTP FORM)                       ;Ignore atoms at top-level
 
112
;       (LET ((FUNCTION (FIRST FORM)))
 
113
;         (SELECTQ FUNCTION
 
114
;           ((QUOTE))                           ;and quoted constants e.g. 'COMPILE
 
115
;           ((PROGN)
 
116
;            (DOLIST (FORM (CDR FORM))
 
117
;              (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO)))
 
118
;           ((EVAL-WHEN)
 
119
;            (SI:CHECK-EVAL-WHEN-TIMES (CADR FORM))
 
120
;            (LET ((COMPILE-P (OR (MEMQ 'COMPILE (CADR FORM))
 
121
;                                 (AND COMPILE-TIME-TOO (MEMQ 'EVAL (CADR FORM)))))
 
122
;                  (LOAD-P (OR (MEMQ 'LOAD (CADR FORM)) (MEMQ 'CL:LOAD (CADR FORM))))
 
123
;                  (FORMS (CDDR FORM)))
 
124
;              (COND (LOAD-P
 
125
;                     (DOLIST (FORM FORMS)
 
126
;                       (COMPILE-FROM-STREAM-1 FORM (AND COMPILE-P ':FORCE))))
 
127
;                    (COMPILE-P
 
128
;                     (DOLIST (FORM FORMS)
 
129
;                       (FUNCALL *COMPILE-FORM-FUNCTION* FORM ':FORCE NIL))))))
 
130
;           ((DEFUN)
 
131
;            (LET ((TEM (DEFUN-COMPATIBILITY (CDR FORM) :WARN-IF-OBSOLETE T)))
 
132
;              (IF (EQ (CDR TEM) (CDR FORM))
 
133
;                  (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T)
 
134
;                  (COMPILE-FROM-STREAM-1 TEM COMPILE-TIME-TOO))))
 
135
;           ((MACRO)
 
136
;            (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T) T))
 
137
;           ((DECLARE)
 
138
;            (DOLIST (FORM (CDR FORM))
 
139
;              (FUNCALL *COMPILE-FORM-FUNCTION* FORM (OR COMPILE-TIME-TOO T)
 
140
;                       ;; (DECLARE (SPECIAL ... has load-time action as well.
 
141
;                       ;; All other DECLARE's do not.
 
142
;                       (MEMQ (CAR FORM) '(SPECIAL ZL:UNSPECIAL)))))
 
143
;           ((COMPILER-LET)
 
144
;            (COMPILER-LET-INTERNAL (CADR FORM) (CDDR FORM)
 
145
;                                   #'COMPILE-FROM-STREAM-1 COMPILE-TIME-TOO))
 
146
;           ((SI:DEFINE-SPECIAL-FORM)
 
147
;            (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T))
 
148
;           ((MULTIPLE-DEFINITION)
 
149
;            (DESTRUCTURING-BIND (NAME TYPE . BODY) (CDR FORM)
 
150
;              (LET ((NAME-VALID (AND (NOT (NULL NAME))
 
151
;                                     (OR (SYMBOLP NAME)
 
152
;                                         (AND (LISTP NAME) (NEQ (CAR NAME) 'QUOTE)))))
 
153
;                    (TYPE-VALID (AND (NOT (NULL TYPE)) (SYMBOLP TYPE))))
 
154
;                (UNLESS (AND NAME-VALID TYPE-VALID)
 
155
;                  (WARN "(~S ~S ~S ...) is invalid because~@
 
156
;                         ~:[~S is not valid as a definition name~;~*~]~
 
157
;                         ~:[~&~S is not valid as a definition type~;~*~]"
 
158
;                        'MULTIPLE-DEFINITION NAME TYPE NAME-VALID NAME TYPE-VALID TYPE)))
 
159
;              (LET* ((COMPILED-BODY NIL)
 
160
;                     (COMPILE-FUNCTION *COMPILE-FUNCTION*)
 
161
;                     (*COMPILE-FUNCTION*
 
162
;                       (LAMBDA (OPERATION &REST ARGS)
 
163
;                         (DECLARE (SYS:DOWNWARD-FUNCTION))
 
164
;                         (SELECTQ OPERATION
 
165
;                           (:DUMP-FORM
 
166
;                            (PUSH (FUNCALL COMPILE-FUNCTION :OPTIMIZE-TOP-LEVEL-FORM
 
167
;                                           (FIRST ARGS))
 
168
;                                  COMPILED-BODY))
 
169
;                           (:INSTALL-DEFINITION
 
170
;                            (PUSH (FORM-FOR-DEFINE *COMPILER* (FIRST ARGS) (SECOND ARGS))
 
171
;                                  COMPILED-BODY))
 
172
;                           (OTHERWISE (CL:APPLY COMPILE-FUNCTION OPERATION ARGS)))))
 
173
;                     (LOCAL-DECLARATIONS `((FUNCTION-PARENT ,NAME ,TYPE)
 
174
;                                           ,@LOCAL-DECLARATIONS)))
 
175
;                (DOLIST (FORM BODY)
 
176
;                  (COMPILE-FROM-STREAM-1 FORM COMPILE-TIME-TOO))
 
177
;                (FUNCALL COMPILE-FUNCTION :DUMP-FORM
 
178
;                         `(LOAD-MULTIPLE-DEFINITION
 
179
;                            ',NAME ',TYPE ',(NREVERSE COMPILED-BODY) NIL)))))
 
180
;           ((pcl::top-level-form)
 
181
;            (destructuring-bind (name times . body)
 
182
;                                (cdr form)
 
183
;              (si:check-eval-when-times times)
 
184
;              (let ((compile-p (or (memq 'compile times)
 
185
;                                   (and compile-time-too (memq 'eval times))))
 
186
;                    (load-p (or (memq 'load times)
 
187
;                                (memq 'cl:load times)))
 
188
;                    (fspec `(pcl::top-level-form ,name)))
 
189
;                (cond (load-p
 
190
;                       (compile-from-stream-1
 
191
;                         `(progn (defun ,fspec () . ,body)
 
192
;                                 (funcall (function ,fspec)))
 
193
;                         (and compile-p ':force)))
 
194
;                      (compile-p
 
195
;                       (dolist (b body)
 
196
;                         (funcall *compile-form-function* form ':force nil)))))))
 
197
;           (OTHERWISE
 
198
;            (LET ((TEM (AND (SYMBOLP FUNCTION) (GET FUNCTION 'TOP-LEVEL-FORM))))
 
199
;              (IF TEM
 
200
;                  (FUNCALL *COMPILE-FORM-FUNCTION* (FUNCALL TEM FORM) COMPILE-TIME-TOO T)
 
201
;                  (FUNCALL *COMPILE-FORM-FUNCTION* FORM COMPILE-TIME-TOO T))))))))))
 
202
;
 
203
;
 
204
 
 
205
 
 
206
dw::
 
207
(defun symbol-flavor-or-cl-type (symbol)
 
208
  (declare (values flavor defstruct-p deftype-fun typep-fun atomic-subtype-parent
 
209
                   non-atomic-deftype))
 
210
  (multiple-value-bind (result foundp)
 
211
      (gethash symbol *flavor-or-cl-type-cache*)
 
212
    (let ((frob
 
213
            (if foundp result
 
214
              (setf (gethash symbol *flavor-or-cl-type-cache*)
 
215
                    (or (get symbol 'flavor:flavor)
 
216
                        (not (null (defstruct-type-p symbol)))
 
217
                        (let* ((deftype (get symbol 'deftype))
 
218
                               (descriptor (symbol-presentation-type-descriptor symbol))
 
219
                               (typep
 
220
                                 (unless (and descriptor
 
221
                                              (presentation-type-explicit-type-function
 
222
                                                descriptor))
 
223
                                   ;; Don't override the one defined in the presentation-type.
 
224
                                   (get symbol 'typep)))
 
225
                               (atomic-subtype-parent (find-atomic-subtype-parent symbol))
 
226
                               (non-atomic-deftype
 
227
                                 (when (and (not descriptor) deftype)
 
228
                                   (not (member (first (type-arglist symbol))
 
229
                                                '(&rest &key &optional))))))
 
230
                          (if (or typep (not (atom deftype))
 
231
                                  non-atomic-deftype
 
232
                                  ;; deftype overrides atomic-subtype-parent.
 
233
                                  (and (not deftype) atomic-subtype-parent))
 
234
                              (list-in-area *handler-dynamic-area*
 
235
                                            deftype typep atomic-subtype-parent
 
236
                                            non-atomic-deftype)
 
237
                            deftype)))))))
 
238
      (locally (declare (inline compiled-function-p))
 
239
        (etypecase frob
 
240
          (array (values frob))
 
241
          (null (values nil))
 
242
          ((member t) (values nil t))
 
243
          (compiled-function (values nil nil frob))
 
244
          (lexical-closure (values nil nil frob))
 
245
          (list (destructuring-bind (deftype typep atomic-subtype-parent non-atomic-deftype)
 
246
                    frob
 
247
                  (values nil nil deftype typep atomic-subtype-parent non-atomic-deftype)))
 
248
          (symbol (values nil nil nil nil frob)))))))
 
249
 
 
250
;;;
 
251
;;; The variable zwei::*sectionize-line-lookahead* controls how many lines the parser
 
252
;;;  is willing to look ahead while trying to parse a definition.  Even 2 lines is enough
 
253
;;;  for just about all cases, but there isn't much overhead, and 10 should be enough
 
254
;;;  to satisfy pretty much everyone... but feel free to change it.
 
255
;;;        - MT 880921
 
256
;;;
 
257
 
 
258
zwei:
 
259
(defvar *sectionize-line-lookahead* 3)
 
260
 
 
261
zwei:
 
262
(DEFMETHOD (:SECTIONIZE-BUFFER MAJOR-MODE :DEFAULT)
 
263
           (FIRST-BP LAST-BP BUFFER STREAM INT-STREAM ADDED-COMPLETIONS)
 
264
  ADDED-COMPLETIONS ;ignored, obsolete
 
265
  (WHEN STREAM
 
266
    (SEND-IF-HANDLES STREAM :SET-RETURN-DIAGRAMS-AS-LINES T))
 
267
  (INCF *SECTIONIZE-BUFFER*)
 
268
  (LET ((BUFFER-TICK (OR (SEND-IF-HANDLES BUFFER :SAVE-TICK) *TICK*))
 
269
        OLD-CHANGED-SECTIONS)
 
270
    (TICK)
 
271
    ;; Flush old section nodes.  Also collect the names of those that are modified, they are
 
272
    ;; the ones that will be modified again after a revert buffer.
 
273
    (DOLIST (NODE (NODE-INFERIORS BUFFER))
 
274
      (AND (> (NODE-TICK NODE) BUFFER-TICK)
 
275
           (PUSH (LIST (SECTION-NODE-FUNCTION-SPEC NODE)
 
276
                       (SECTION-NODE-DEFINITION-TYPE NODE))
 
277
                 OLD-CHANGED-SECTIONS))
 
278
      (FLUSH-BP (INTERVAL-FIRST-BP NODE))
 
279
      (FLUSH-BP (INTERVAL-LAST-BP NODE)))
 
280
    (DO ((LINE (BP-LINE FIRST-BP) (LINE-NEXT INT-LINE))
 
281
         (LIMIT (BP-LINE LAST-BP))
 
282
         (EOFFLG)
 
283
         (ABNORMAL T)
 
284
         (DEFINITION-LIST NIL)
 
285
         (BP (COPY-BP FIRST-BP))
 
286
         (FUNCTION-SPEC)
 
287
         (DEFINITION-TYPE)
 
288
         (STR)
 
289
         (INT-LINE)
 
290
         (first-time t)
 
291
         (future-line)                          ; we actually read into future line
 
292
         (future-int-line)
 
293
         (PREV-NODE-START-BP FIRST-BP)
 
294
         (PREV-NODE-DEFINITION-LINE NIL)
 
295
         (PREV-NODE-FUNCTION-SPEC NIL)
 
296
         (PREV-NODE-TYPE 'HEADER)
 
297
         (PREVIOUS-NODE NIL)
 
298
         (NODE-LIST NIL)
 
299
         (STATE (SEND SELF :INITIAL-SECTIONIZATION-STATE)))
 
300
        (NIL)
 
301
      ;; If we have a stream, read another line.
 
302
      (when (AND STREAM (NOT EOFFLG))
 
303
        (let ((lookahead (if future-line 1 *sectionize-line-lookahead*)))
 
304
          (dotimes (i lookahead)                ; startup lookahead
 
305
            (MULTIPLE-VALUE (future-LINE EOFFLG)
 
306
              (LET ((DEFAULT-CONS-AREA *LINE-AREA*))
 
307
                (SEND STREAM ':LINE-IN LINE-LEADER-SIZE)))
 
308
            (IF future-LINE (SETQ future-INT-LINE (FUNCALL INT-STREAM ':LINE-OUT future-LINE)))
 
309
            (when first-time
 
310
              (setq first-time nil)
 
311
              (setq line future-line)
 
312
              (setq int-line future-int-line))
 
313
            (when eofflg
 
314
              (return)))))
 
315
 
 
316
      (SETQ INT-LINE LINE)
 
317
 
 
318
      (when int-line
 
319
        (MOVE-BP BP INT-LINE 0))                ;Record as potentially start-bp for a section
 
320
 
 
321
      ;; See if the line is the start of a defun.
 
322
      (WHEN (AND LINE
 
323
                 (LET (ERR)
 
324
                   (MULTIPLE-VALUE (FUNCTION-SPEC DEFINITION-TYPE STR ERR STATE)
 
325
                     (SEND SELF ':SECTION-NAME INT-LINE BP STATE))
 
326
                   (NOT ERR)))
 
327
        (PUSH (LIST FUNCTION-SPEC DEFINITION-TYPE) DEFINITION-LIST)
 
328
        (SECTION-COMPLETION FUNCTION-SPEC STR NIL)
 
329
        ;; List methods under both names for user ease.
 
330
        (LET ((OTHER-COMPLETION (SEND SELF ':OTHER-SECTION-NAME-COMPLETION
 
331
                                      FUNCTION-SPEC INT-LINE)))
 
332
          (WHEN OTHER-COMPLETION
 
333
            (SECTION-COMPLETION FUNCTION-SPEC OTHER-COMPLETION NIL)))
 
334
        (LET ((PREV-NODE-END-BP (BACKWARD-OVER-COMMENT-LINES BP ':FORM-AS-BLANK)))
 
335
          ;; Don't make a section node if it's completely empty.  This avoids making
 
336
          ;; a useless Buffer Header section node. Just set all the PREV variables
 
337
          ;; so that the next definition provokes the *right thing*
 
338
          (UNLESS (BP-= PREV-NODE-END-BP PREV-NODE-START-BP)
 
339
            (SETQ PREVIOUS-NODE
 
340
                  (ADD-SECTION-NODE PREV-NODE-START-BP
 
341
                                    (SETQ PREV-NODE-START-BP PREV-NODE-END-BP)
 
342
                                    PREV-NODE-FUNCTION-SPEC PREV-NODE-TYPE
 
343
                                    PREV-NODE-DEFINITION-LINE BUFFER PREVIOUS-NODE
 
344
                                    (IF (LOOP FOR (FSPEC TYPE) IN OLD-CHANGED-SECTIONS
 
345
                                              THEREIS (AND (EQ PREV-NODE-FUNCTION-SPEC FSPEC)
 
346
                                                           (EQ PREV-NODE-TYPE TYPE)))
 
347
                                        *TICK* BUFFER-TICK)
 
348
                                    BUFFER-TICK))
 
349
            (PUSH PREVIOUS-NODE NODE-LIST)))
 
350
        (SETQ PREV-NODE-FUNCTION-SPEC FUNCTION-SPEC
 
351
              PREV-NODE-TYPE DEFINITION-TYPE
 
352
              PREV-NODE-DEFINITION-LINE INT-LINE))
 
353
      ;; After processing the last line, exit.
 
354
      (WHEN (OR #+ignore EOFFLG (null line) (AND (NULL STREAM) (EQ LINE LIMIT)))
 
355
        ;; If reading a stream, we should not have inserted a CR
 
356
        ;; after the eof line.
 
357
        (WHEN STREAM
 
358
          (DELETE-INTERVAL (FORWARD-CHAR LAST-BP -1 T) LAST-BP T))
 
359
        ;; The rest of the buffer is part of the last node
 
360
        (UNLESS (SEND SELF ':SECTION-NAME-TRIVIAL-P)
 
361
          ;; ---oh dear, what sort of section will this be? A non-empty HEADER
 
362
          ;; ---node.  Well, ok for now.
 
363
          (PUSH (ADD-SECTION-NODE PREV-NODE-START-BP LAST-BP
 
364
                                  PREV-NODE-FUNCTION-SPEC PREV-NODE-TYPE
 
365
                                  PREV-NODE-DEFINITION-LINE BUFFER PREVIOUS-NODE
 
366
                                  (IF (LOOP FOR (FSPEC TYPE) IN OLD-CHANGED-SECTIONS
 
367
                                            THEREIS (AND (EQ PREV-NODE-FUNCTION-SPEC FSPEC)
 
368
                                                         (EQ PREV-NODE-TYPE TYPE)))
 
369
                                      *TICK* BUFFER-TICK)
 
370
                                  BUFFER-TICK)
 
371
                NODE-LIST)
 
372
          (SETF (LINE-NODE (BP-LINE LAST-BP)) (CAR NODE-LIST)))
 
373
        (SETF (NODE-INFERIORS BUFFER) (NREVERSE NODE-LIST))
 
374
        (SETF (NAMED-BUFFER-WITH-SECTIONS-FIRST-SECTION BUFFER) (CAR (NODE-INFERIORS BUFFER)))
 
375
        (SETQ ABNORMAL NIL)                     ;timing windows here
 
376
        ;; Speed up completion if enabled.
 
377
        (WHEN SI:*ENABLE-AARRAY-SORTING-AFTER-LOADS*
 
378
          (SI:SORT-AARRAY *ZMACS-COMPLETION-AARRAY*))
 
379
        (SETQ *ZMACS-COMPLETION-AARRAY*
 
380
              (FOLLOW-STRUCTURE-FORWARDING *ZMACS-COMPLETION-AARRAY*))
 
381
        (RETURN
 
382
          (VALUES 
 
383
            (CL:SETF (ZMACS-SECTION-LIST BUFFER)
 
384
                     (NREVERSE DEFINITION-LIST))
 
385
            ABNORMAL))))))
 
386
 
 
387