[armedbear-cvs] r11824 - trunk/abcl/src/org/armedbear/lisp

[Ville Voutilainen]

Author: vvoutilainen
Date: Sun May  3 15:27:26 2009
New Revision: 11824

Log:
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.


Removed:
   trunk/abcl/src/org/armedbear/lisp/Primitive0R.java
   trunk/abcl/src/org/armedbear/lisp/Primitive1R.java
   trunk/abcl/src/org/armedbear/lisp/Primitive2R.java
Modified:
   trunk/abcl/src/org/armedbear/lisp/Load.java
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java	Sun May  3 15:27:26 2009
@@ -341,7 +341,7 @@
     // ### *fasl-version*
     // internal symbol
     private static final Symbol _FASL_VERSION_ =
-        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(29));
+        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(30));
 
     // ### *fasl-anonymous-package*
     // internal symbol

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun May  3 15:27:26 2009
@@ -1826,21 +1826,6 @@
            (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)))
           ((equal super +lisp-ctf-class+)
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 1)))
@@ -8183,39 +8168,6 @@
          (label-END (gensym))
          (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*))