Changeset 11824 for trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

05/03/09 19:27:26 (14 years ago)

Author:

vvoutilainen

Message:

Get rid of Primitive[012]R, we don't truly need it. Also
increment fasl-version, because this removes three classes
and thus fasls become incompatible.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (2 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -1825 +1825 @@
           ((equal super +lisp-primitive-class+)
            (emit-constructor-lambda-name lambda-name)
-           (emit-constructor-lambda-list args)
-           (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super "org/armedbear/lisp/Primitive0R")
-           (emit-constructor-lambda-name lambda-name)
-           (push '&REST args)
-           (emit-constructor-lambda-list args)
-           (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super "org/armedbear/lisp/Primitive1R")
-           (emit-constructor-lambda-name lambda-name)
-           (setf args (list (first args) '&REST (second args)))
-           (emit-constructor-lambda-list args)
-           (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super "org/armedbear/lisp/Primitive2R")
-           (emit-constructor-lambda-name lambda-name)
-           (setf args (list (first args) (second args) '&REST (third args)))
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 2)))
@@ -8184 +8169 @@
          (label-EXIT (gensym)))
 
-    (unless *child-p*
-      (when (memq '&REST args)
-        (unless (or (memq '&OPTIONAL args) (memq '&KEY args))
-          (let ((arg-count (length args)))
-      (when 
-    (cond ((and (= arg-count 2) (eq (%car args) '&REST))
-           (setf descriptor (get-descriptor 
-           (lisp-object-arg-types 1)
-           +lisp-object+)
-           super "org/armedbear/lisp/Primitive0R"
-           args (cdr args)))
-          ((and (= arg-count 3) (eq (%cadr args) '&REST))
-           (setf descriptor (get-descriptor 
-           (lisp-object-arg-types 2)
-           +lisp-object+)
-           super "org/armedbear/lisp/Primitive1R"
-           args (list (first args) (third args))))
-          ((and (= arg-count 4) (eq (%caddr args) '&REST))
-           (setf descriptor (get-descriptor 
-           (list +lisp-object+ 
-                 +lisp-object+ +lisp-object+)
-           +lisp-object+)
-           super "org/armedbear/lisp/Primitive2R"
-           args (list (first args) 
-          (second args) (fourth args)))))
-        (setf *using-arg-array* nil
-        *hairy-arglist-p* nil
-        (compiland-kind compiland) :internal
-        execute-method-name "_execute"
-        execute-method (make-method 
-            :name execute-method-name
-            :descriptor descriptor)))))))
-
     (dolist (var (compiland-arg-vars compiland))
       (push var *visible-variables*))