Builds all LISP; * FASL files that are on autoload properties when

the lisp interpreter is first booted.

Redumps lisp compiler with updated FASL files built from source.

src/lspsrc/extbas.39

@@ -0,0 +1,85 @@
+;;;   EXTBAS			-*-Mode:Lisp;Package:SI;Lowercase:T-*-
+;;;   ****************************************************************
+;;;   *** MacLISP **** EXTended datatype scheme, BASic functions *****
+;;;   ****************************************************************
+;;;   ** (c) Copyright 1981 Massachusetts Institute of Technology ****
+;;;   ****************************************************************
+
+(herald EXTBAS /39)
+
+
+(eval-when (eval compile)
+  (or (get 'SUBLOAD 'VERSION)
+      (load '((lisp) subload)))
+  (subload EXTMAC)
+  (subload DEFSETF)
+ )
+
+
+;; Be careful about circular dependencies!  Luckily this one is minor,
+;;  and can be patched, if necessary.  (EXTEND has some SETFs in it.)
+;; DEFSETF -> DEFVST -> EXTEND -> EXTMAC -> DEFSETF
+
+(defsetf SI:XREF ((() h n) val) () `(SI:XSET ,h ,n ,val))
+
+
+;; Used by typical NIL-compatibility functions
+(defun SI:NON-NEG-FIXNUMP (n) (and (fixnump n) (>= N 0)))
+;; Used by extend conser error checking
+(defun SI:MAX-EXTEND-SIZEP (n) (and (fixnump n) (>= N 0) (< n 510.)))
+
+
+
+
+;;;; Regular DEFUNitions of XREF, XSET, MAKE-EXTEND, EXTEND-LENGTH etc.
+
+;;; SOURCE-TRAN's for XREF, XSET, MAKE-EXTEND, EXTEND-LENGTH etc.
+;;;  come in from exthuk file
+(eval-when (eval compile load)
+  (if (status feature COMPLR)
+      (subload EXTHUK))
+)
+
+;; Pass the buck to the CXR function on error checking for these guys.
+(defun SI:XREF (h n) 
+  (subrcall T #,(get 'CXR 'SUBR) (+ #.si:extend-q-overhead n) h))
+(defun SI:XSET (h n val) 
+  (subrcall T #,(get 'RPLACX 'SUBR) (+ #.si:extend-q-overhead n) h val))
+
+(defun SI:MAKE-EXTEND (n clss)
+  (if (or (or (not (fixnump n)) (< n 0) (> n 510.))
+	  (not (classp clss)))
+      (cond ((fboundp 'SI:CHECK-TYPER)
+	      (check-type n #'SI:MAX-EXTEND-SIZEP 'SI:MAKE-EXTEND)
+	      (check-type clss #'CLASSP 'SI:MAKE-EXTEND))
+	    ('T (error '|Bad args to SI:MAKE-EXTEND| (list n clss)))))
+   ;;Note that this must be open-compiled, either because it has a
+   ;; MACRO definition, or a SOURCE-TRANS property (from EXTHUK file).
+  (si:make-extend n clss))
+
+(defun SI:make-random-extend (n &optional clss)
+  (si:make-extend n clss))
+
+
+(defun SI:EXTEND-LENGTH (x) 
+  (if (and *RSET (not (extendp x)))
+      (cond ((fboundp 'SI:CHECK-TYPER) 
+	      (check-type x #'EXTENDP 'SI:EXTEND-LENGTH))
+	    ('T (error '|Not an EXTEND| x))))
+   ;;Note that this must be open-compiled, either because it has a
+   ;; MACRO definition, or a SOURCE-TRANS property (from EXTHUK file).
+  (si:extend-length x))
+
+(let ((x (getl 'SI:EXTEND-LENGTH '(EXPR SUBR))))
+  (putprop 'EXTEND-LENGTH (cadr x) (car x)))
+
+(defun SI:EXTEND n 
+  (let ((size (1- n)) 
+	(clss (if (>= n 1) (arg 1))))
+    (declare (fixnum size))
+    (do ((obj (si:make-extend size clss))
+	 (i 0 (1+ i)))
+	((>= i size) obj)
+      (declare (fixnum i))
+        ;;(ARG 1) is class obj, (ARG 2) is first elt
+      (si:xset obj i (arg (+ i 2))))))