Changeset 229

Show
Ignore:
Timestamp:
08/18/11 05:48:21 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lispm
Files:
4 modified

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lispm/ltop.lisp

    r228 r229  
    260260;;; ONCE        Use the once-only list 
    261261;;; SYSTEM      Use the system list 
     262;;; BEFORE-COLD The list that gets done before disk-save'ing out 
    262263;;; If neither WARM nor COLD are specified, warm is assumed.  If a fourth argument 
    263264;;; is given, then it is the list to use.  WARM and COLD will override the fourth argument. 
     
    275276            ((STRING-EQUAL "WARM" V) (SETQ LIST-NAME 'WARM-INITIALIZATION-LIST)) 
    276277            ((STRING-EQUAL "COLD" V) (SETQ LIST-NAME 'COLD-INITIALIZATION-LIST)) 
    277             ((STRING-EQUAL "SYSTEM" V) 
     278            ((STRING-EQUAL "BEFORE-COLD" V) (SETQ LIST-NAME 'BEFORE-COLD-INITIALIZATION-LIST)) 
     279            ((STRING-EQUAL "SYSTEM" V) 
    278280             (SETQ LIST-NAME 'SYSTEM-INITIALIZATION-LIST) 
    279281             (SETQ WHEN 'FIRST)) 
     
    304306;;; ONCE        Use the once-only list 
    305307;;; SYSTEM      Use the system list 
     308;;; BEFORE-COLD The list that gets done before disk-save'ing out 
    306309;;; If neither WARM nor COLD are specified, warm is assumed.  If a third argument 
    307310;;; is given, then it is the list to use.  WARM and COLD will override the third argument. 
     
    314317      (COND ((STRING-EQUAL "WARM" V) (SETQ LIST-NAME 'WARM-INITIALIZATION-LIST)) 
    315318            ((STRING-EQUAL "COLD" V) (SETQ LIST-NAME 'COLD-INITIALIZATION-LIST)) 
     319            ((STRING-EQUAL "BEFORE-COLD" V) (SETQ LIST-NAME 'BEFORE-COLD-INITIALIZATION-LIST)) 
    316320            ((STRING-EQUAL "ONCE" V) (SETQ LIST-NAME 'ONCE-ONLY-INITIALIZATION-LIST)) 
    317321            ((STRING-EQUAL "SYSTEM" V) (SETQ LIST-NAME 'SYSTEM-INITIALIZATION-LIST)) 
     
    327331      ((NULL L)) 
    328332      (SETF (INIT-FLAG (CAR L)) NIL))) 
    329  
    330 (ADD-INITIALIZATION "LTOP-CLEAR-SCREEN" '(FUNCALL COLD-LOAD-STREAM ':CLEAR-SCREEN) '(COLD)) 
    331  
    332333 
    333334;Small version of FSET-CAREFULLY to be used until all the full 
  • trunk/lisp/lispm/pkgdcl.lisp

    r228 r229  
    129129;         ("AI: LISPM; LFL QFASL") ;ACTUALLY, IS IN COLD LOAD therefore in SI like it or not 
    130130          ("AI: LISPM; DEFMIC >") ;MUST BE AFTER QCFILE 
    131           ("AI: LISPM; DOCMIC >")) 
     131          ("AI: LISPM; DOCMIC >") 
     132          ("AI: LISPM; UCINIT QFASL"))  ;Contains MCLAP properties for initially 
     133                                        ;microcompiled functions.  There is no 
     134                                        ;source for this file! 
    132135         (EXTERNAL COMPILE LOAD FASLOAD COMPILE-FILE-ALIST COMPILE-FILE-ALIST-MAP 
    133136                   LOAD-FILE-ALIST QC-FILE 
  • trunk/lisp/lispm/qfctns.lisp

    r228 r229  
    15381538            ((ZEROP N)) 
    15391539          (SETF (ARRAY-LEADER NEW-ARRAY I) (ARRAY-LEADER ARRAY I))) 
     1540 
     1541        ;; Check for zero-size array, which the code below doesn't handle correctly 
     1542        (AND (DO ((L DIMENSIONS (CDR L)) (L1 OLD-DIMS (CDR L1))) ((NULL L) NIL) 
     1543               (AND (OR (ZEROP (CAR L)) (ZEROP (CAR L1))) 
     1544                    (RETURN T))) 
     1545             (GO DONE)) 
    15401546 
    15411547        ;; Create a vector of fixnums to use as subscripts to step thru the arrays. 
  • trunk/lisp/lispm/qmisc.lisp

    r228 r229  
    13491349            
    13501350           ;Cause cold boot initializations to happen when rebooted 
     1351           ;and do the BEFORE-COLD initializations now 
     1352           (INITIALIZATIONS 'BEFORE-COLD-INITIALIZATION-LIST T) 
    13511353           (RESET-INITIALIZATIONS 'COLD-INITIALIZATION-LIST) 
    13521354           (SETQ WHO-LINE-JUST-COLD-BOOTED-P T)