Changeset 229

Timestamp:

08/18/11 05:48:21 (21 months ago)

Author:

rjs

Message:

Update.

Location:

trunk/lisp/lispm

Files:

• ltop.lisp (modified) (5 diffs)
• pkgdcl.lisp (modified) (1 diff)
• qfctns.lisp (modified) (1 diff)
• qmisc.lisp (modified) (1 diff)

trunk/lisp/lispm/ltop.lisp

@@ -260 +260 @@
 ;;; ONCE        Use the once-only list
 ;;; SYSTEM      Use the system list
+;;; BEFORE-COLD The list that gets done before disk-save'ing out
 ;;; If neither WARM nor COLD are specified, warm is assumed.  If a fourth argument
 ;;; is given, then it is the list to use.  WARM and COLD will override the fourth argument.
@@ -275 +276 @@
             ((STRING-EQUAL "WARM" V) (SETQ LIST-NAME 'WARM-INITIALIZATION-LIST))
             ((STRING-EQUAL "COLD" V) (SETQ LIST-NAME 'COLD-INITIALIZATION-LIST))
-            ((STRING-EQUAL "SYSTEM" V)
+            ((STRING-EQUAL "BEFORE-COLD" V) (SETQ LIST-NAME 'BEFORE-COLD-INITIALIZATION-LIST))
+            ((STRING-EQUAL "SYSTEM" V)
              (SETQ LIST-NAME 'SYSTEM-INITIALIZATION-LIST)
              (SETQ WHEN 'FIRST))
@@ -304 +306 @@
 ;;; ONCE        Use the once-only list
 ;;; SYSTEM      Use the system list
+;;; BEFORE-COLD The list that gets done before disk-save'ing out
 ;;; If neither WARM nor COLD are specified, warm is assumed.  If a third argument
 ;;; is given, then it is the list to use.  WARM and COLD will override the third argument.
@@ -314 +317 @@
       (COND ((STRING-EQUAL "WARM" V) (SETQ LIST-NAME 'WARM-INITIALIZATION-LIST))
             ((STRING-EQUAL "COLD" V) (SETQ LIST-NAME 'COLD-INITIALIZATION-LIST))
+            ((STRING-EQUAL "BEFORE-COLD" V) (SETQ LIST-NAME 'BEFORE-COLD-INITIALIZATION-LIST))
             ((STRING-EQUAL "ONCE" V) (SETQ LIST-NAME 'ONCE-ONLY-INITIALIZATION-LIST))
             ((STRING-EQUAL "SYSTEM" V) (SETQ LIST-NAME 'SYSTEM-INITIALIZATION-LIST))
@@ -327 +331 @@
       ((NULL L))
       (SETF (INIT-FLAG (CAR L)) NIL)))
-
-(ADD-INITIALIZATION "LTOP-CLEAR-SCREEN" '(FUNCALL COLD-LOAD-STREAM ':CLEAR-SCREEN) '(COLD))
-
 
 ;Small version of FSET-CAREFULLY to be used until all the full

trunk/lisp/lispm/pkgdcl.lisp

@@ -129 +129 @@
 ;         ("AI: LISPM; LFL QFASL") ;ACTUALLY, IS IN COLD LOAD therefore in SI like it or not
           ("AI: LISPM; DEFMIC >") ;MUST BE AFTER QCFILE
-          ("AI: LISPM; DOCMIC >"))
+          ("AI: LISPM; DOCMIC >")
+          ("AI: LISPM; UCINIT QFASL"))  ;Contains MCLAP properties for initially
+                                        ;microcompiled functions.  There is no
+                                        ;source for this file!
          (EXTERNAL COMPILE LOAD FASLOAD COMPILE-FILE-ALIST COMPILE-FILE-ALIST-MAP
                    LOAD-FILE-ALIST QC-FILE

trunk/lisp/lispm/qfctns.lisp

@@ -1538 +1538 @@
             ((ZEROP N))
           (SETF (ARRAY-LEADER NEW-ARRAY I) (ARRAY-LEADER ARRAY I)))
+
+        ;; Check for zero-size array, which the code below doesn't handle correctly
+        (AND (DO ((L DIMENSIONS (CDR L)) (L1 OLD-DIMS (CDR L1))) ((NULL L) NIL)
+               (AND (OR (ZEROP (CAR L)) (ZEROP (CAR L1)))
+                    (RETURN T)))
+             (GO DONE))
 
         ;; Create a vector of fixnums to use as subscripts to step thru the arrays.

trunk/lisp/lispm/qmisc.lisp

@@ -1349 +1349 @@
            
            ;Cause cold boot initializations to happen when rebooted
+           ;and do the BEFORE-COLD initializations now
+           (INITIALIZATIONS 'BEFORE-COLD-INITIALIZATION-LIST T)
            (RESET-INITIALIZATIONS 'COLD-INITIALIZATION-LIST)
            (SETQ WHO-LINE-JUST-COLD-BOOTED-P T)