source: trunk/abcl/src/org/armedbear/lisp/Load.java

Last change on this file was 15705, checked in by Mark Evenson, 11 months ago

Rename and make public SYS:LOAD-SYSTEM-FILE implementation
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 33.5 KB
Line 
1/*
2 * Load.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves
5 * $Id: Load.java 15705 2023-06-06 06:38:45Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38import java.io.IOException;
39import java.io.InputStream;
40import java.net.URL;
41import java.text.MessageFormat;
42
43/* This file holds ABCL's (FASL and non-FASL) loading behaviours.
44 *
45 * The loading process works like this:
46 *   The loader associates the input filename with a special variable
47 *   and starts evaluating the forms in the file.
48 *
49 *   If one of the forms is (INIT-FASL :VERSION <version>), from that
50 *   point the file is taken to be a FASL.
51 *   The FASL loader takes over and retrieves the file being loaded
52 *   from the special variable and continues loading from there.
53 *
54 */
55public final class Load
56{
57    public static final LispObject load(String filename)
58    {
59        final LispThread thread = LispThread.currentThread();
60        return load((Pathname)Pathname.create(filename),
61                    Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
62                    Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
63                    true);
64    }
65 
66    /** @return Pathname of loadable file based on NAME, or null if
67     * none can be determined. */
68    private static final Pathname findLoadableFile(Pathname name) {
69      LispObject truename  = Symbol.PROBE_FILE.execute(name);
70      if (truename instanceof Pathname) {
71        Pathname t = (Pathname)truename;
72        if (t.getName() != NIL
73            && t.getName() != null) {
74          return t;
75        }
76      }
77      final String COMPILE_FILE_TYPE = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
78      if (name.getType() == NIL
79          && (name.getName() != NIL || name.getName() != null)) {
80        Pathname lispPathname = Pathname.create(name);
81        lispPathname.setType(new SimpleString("lisp"));
82        LispObject lisp = Symbol.PROBE_FILE.execute(lispPathname);
83        Pathname abclPathname = Pathname.create(name);
84        abclPathname.setType(new SimpleString(COMPILE_FILE_TYPE));
85        LispObject abcl = Symbol.PROBE_FILE.execute(abclPathname);
86        if (lisp instanceof Pathname && abcl instanceof Pathname) {
87          lispPathname = (Pathname)lisp;
88          abclPathname = (Pathname)abcl;
89          long lispLastModified = lispPathname.getLastModified();
90          long abclLastModified = abclPathname.getLastModified();
91          if (abclLastModified > lispLastModified) {
92            return abclPathname;  // fasl file is newer
93          } else {
94            return lispPathname;
95          }
96        } else if (abcl instanceof Pathname) {
97          return (Pathname) abcl;
98        } else if (lisp instanceof Pathname) { 
99          return (Pathname) lisp;
100        }
101      }
102      if (name.isJar()) {
103        if (name.getType().equals(NIL)) {
104          name.setType(COMPILE_FILE_INIT_FASL_TYPE);
105          Pathname result = findLoadableFile(name);
106          if (result != null) {
107            return result;
108          }
109          name.setType(new SimpleString(COMPILE_FILE_TYPE));
110          result = findLoadableFile(name);
111          if (result != null) {
112            return result;
113          }
114        }
115      }
116      return null;
117    }
118 
119    public static final LispObject load(Pathname pathname,
120                                        boolean verbose,
121                                        boolean print,
122                                        boolean ifDoesNotExist)
123    {
124        return load(pathname, verbose, print, ifDoesNotExist, false, Keyword.DEFAULT);
125    }
126 
127    public static final LispObject load(InputStream in) 
128    {
129      return load(in, new SimpleString("UTF-8"));
130    }
131 
132    public static  final LispObject load(InputStream in, LispObject format) {
133        Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER, 
134                                   format);
135        final LispThread thread = LispThread.currentThread();
136        return loadFileFromStream(null, 
137                                  null,
138                                  stream,
139                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
140                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
141                                  false);
142    }
143
144
145    public static final LispObject load(final Pathname pathname,
146                                        boolean verbose,
147                                        boolean print,
148                                        boolean ifDoesNotExist,
149                                        boolean returnLastResult,
150                                        LispObject externalFormat)
151    {
152        Pathname mergedPathname = null;
153        if (!pathname.isAbsolute() && !pathname.isJar()) {
154            Pathname pathnameDefaults
155                = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
156            mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults);
157        }
158        Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
159        Pathname truename = (loadableFile != null
160                             ? (Pathname)Symbol.PROBE_FILE.execute(loadableFile)
161                             : null);
162       
163        if (truename == null || truename.equals(NIL)) {
164          if (ifDoesNotExist) {
165            return error(new FileError("File not found: " + pathname.princToString(), pathname));
166          } else {
167            Debug.warn("Failed to load " + pathname.getNamestring());
168            return NIL;
169          }
170        }
171
172        if (ZipCache.checkZipFile(truename)) {
173          if (truename instanceof JarPathname) {
174            truename = JarPathname.createFromEntry((JarPathname)truename);
175          } else {
176            truename = JarPathname.createFromPathname(truename);
177          }
178          Pathname loader = Pathname.create("__loader__._"); // FIXME use constants
179          mergedPathname = (Pathname)Symbol.MERGE_PATHNAMES.execute(loader, truename);
180
181          LispObject initTruename = Symbol.PROBE_FILE.execute(mergedPathname);
182          if (initTruename.equals(NIL)) {
183            // Maybe the enclosing JAR has been renamed?
184            Pathname p = Pathname.create(mergedPathname);
185            p.setName(Keyword.WILD);
186            LispObject result = Symbol.MATCH_WILD_JAR_PATHNAME.execute(p);
187           
188            if (result instanceof Cons
189                && ((Cons)result).length() == 1
190                && ((Cons)result).car() instanceof Pathname) {
191              initTruename = (Pathname)result.car();
192            } else {
193              String errorMessage
194                = "Loadable FASL not found for "
195                + pathname.printObject() 
196                + " in "
197                + mergedPathname.printObject();
198              if (ifDoesNotExist) {
199                return error(new FileError(errorMessage, mergedPathname));
200              } else {
201                Debug.trace(errorMessage);
202                return NIL;
203              }
204            }
205          }
206          truename = (Pathname)initTruename;
207        } 
208                               
209        InputStream in = truename.getInputStream();
210        Debug.assertTrue(in != null);
211   
212        try {
213            return loadFileFromStream(pathname, truename,
214                                      new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER, externalFormat),
215                                      verbose, print, false, returnLastResult);
216        }
217        finally {
218            if (in != null) {
219                try {
220                   in.close();
221                }
222                catch (IOException e) {
223                    return error(new LispError(e.getMessage()));
224                }
225            }
226        }
227    }
228
229    public static LispObject loadSystemFile(String filename, boolean auto)
230    {
231        LispThread thread = LispThread.currentThread();
232        if (auto) {
233            final SpecialBindingsMark mark = thread.markSpecialBindings();
234            // Due to autoloading, we're not sure about the loader state.
235            // Make sure that all reader relevant variables have known state.
236            thread.bindSpecial(Symbol.CURRENT_READTABLE,
237                               STANDARD_READTABLE.symbolValue(thread));
238            thread.bindSpecial(Symbol.READ_BASE, Fixnum.constants[10]);
239            thread.bindSpecial(Symbol.READ_SUPPRESS, NIL);
240            thread.bindSpecial(Symbol.READ_EVAL, T);
241            thread.bindSpecial(Symbol.READ_DEFAULT_FLOAT_FORMAT, Symbol.SINGLE_FLOAT);
242            thread.bindSpecial(Symbol._PACKAGE_, PACKAGE_CL_USER);
243            try {
244                return loadSystemFile(filename,
245                                      _AUTOLOAD_VERBOSE_.symbolValue(thread) != NIL,
246                                      Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
247                                      auto);
248            }
249            finally {
250                thread.resetSpecialBindings(mark);
251            }
252        } else {
253            return loadSystemFile(filename,
254                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
255                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
256                                  auto);
257        }
258    }
259
260    private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
261  /** A file with this type in a packed FASL denotes the initial loader */
262    static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
263
264    private static final Pathname coercePathnameOrNull(LispObject p) {
265        if (p == null) {
266            return null;
267        }
268        Pathname result = null;
269        try {
270            result = (Pathname)p;
271        } catch (Throwable t) { // XXX narrow me!
272            return null;
273        }
274        return result;
275    }
276       
277
278    public static final LispObject loadSystemFile(final String filename,
279                                                  boolean verbose,
280                                                  boolean print,
281                                                  boolean auto)
282    {
283        InputStream in = null;
284        Pathname pathname = null;
285        Pathname truename = null;
286        pathname = (Pathname)Pathname.create(filename);
287        LispObject bootPath = Site.getLispHome();
288        Pathname mergedPathname;
289        if (bootPath instanceof Pathname) {
290          mergedPathname = (Pathname)Symbol.MERGE_PATHNAMES.execute(pathname, bootPath);
291          // So a PROBE-FILE won't attempt to merge when
292          // *DEFAULT-PATHNAME-DEFAULTS* is a JAR
293          if (mergedPathname.getDevice().equals(NIL)
294              && !Utilities.isPlatformWindows) {
295            mergedPathname.setDevice(Keyword.UNSPECIFIC);
296          }
297        } else {
298          mergedPathname = pathname;
299        }
300        URL url = null;
301        Pathname loadableFile = findLoadableFile(mergedPathname);
302        if (loadableFile == null) {
303          truename = null;
304        } else {
305          truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
306        }
307       
308        final String COMPILE_FILE_TYPE
309          = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
310
311        if (truename == null || truename.equals(NIL) || bootPath.equals(NIL)) {
312            // Make an attempt to use the boot classpath
313            String path = pathname.asEntryPath();
314            url = Lisp.class.getResource(path);           
315            if (url == null || url.toString().endsWith("/")) {
316                url = Lisp.class.getResource(path.replace('-', '_') + "." + COMPILE_FILE_TYPE);
317                if (url == null) {
318                    url = Lisp.class.getResource(path + ".lisp");
319                }
320            }
321            if (url == null) {
322                return error(new LispError("Failed to find loadable system file "
323                                           + "'" + path + "'"
324                                           + " in boot classpath."));
325            }               
326            if (!bootPath.equals(NIL)) {
327              Pathname urlPathname = (Pathname)URLPathname.create(url);
328              loadableFile = findLoadableFile(urlPathname);
329              truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
330              if (truename.equals(NIL)) {
331                return error(new LispError("Failed to find loadable system file in boot classpath "
332                                           + "'" + url + "'"));
333              }
334            } else {
335                truename = null; // We can't represent the FASL in a Pathname (q.v. OSGi)
336            }
337        }
338
339        // Look for a init FASL inside a packed FASL
340        if (truename != null
341            && truename.getType().princToString().equals(COMPILE_FILE_TYPE) && ZipCache.checkZipFile(truename))  {
342          Pathname init = (Pathname)Pathname.create(truename.getNamestring());
343            init.setType(COMPILE_FILE_INIT_FASL_TYPE);
344            init.setName(new SimpleString("__loader__"));
345            LispObject t = Symbol.PROBE_FILE.execute(init);
346            if (t instanceof Pathname) {
347                truename = (Pathname)t;
348            } else {
349                return error (new LispError("Failed to find loadable init FASL in "
350                                            + "'" + init.getNamestring() + "'"));
351            }
352        }
353
354        if (truename != null) {
355            in = truename.getInputStream();
356        } else { 
357            try {
358                Debug.assertTrue(url != null);
359                in = url.openStream();
360            } catch (IOException e) {
361                error(new FileError("Failed to load system file: " 
362                                    + "'" + filename + "'"
363                                    + " from URL: " 
364                                    + "'" + url + "'"));
365            } 
366        }
367
368        if (in != null) {
369            final LispThread thread = LispThread.currentThread();
370            final SpecialBindingsMark mark = thread.markSpecialBindings();
371            thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL);
372            thread.bindSpecial(FASL_LOADER, NIL);
373            try {
374                Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER);
375                return loadFileFromStream(pathname, truename, stream,
376                                          verbose, print, auto);
377            } finally {
378                thread.resetSpecialBindings(mark);
379                try {
380                    in.close();
381                }
382                catch (IOException e) {
383                    return error(new LispError(e.getMessage()));
384                }
385            }
386        }
387        return error(new FileError("Failed to load system file: " 
388                                   + "'" + filename + "'"
389                                   + " resolved as " 
390                                   + "'" + mergedPathname + "'" , 
391                                   truename));
392    }
393
394    // ### *fasl-version*
395    // internal symbol
396    static final Symbol _FASL_VERSION_ =
397        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(43));
398
399    // ### *fasl-external-format*
400    // internal symbol
401    private static final Symbol _FASL_EXTERNAL_FORMAT_ =
402        internConstant("*FASL-EXTERNAL-FORMAT*", PACKAGE_SYS,
403                       new SimpleString("UTF-8"));
404
405    // ### *fasl-uninterned-symbols*
406    // internal symbol
407    /**
408     * This variable gets bound to NIL upon loading a FASL, but
409     * gets set to a vector of symbols as one of the first actions
410     * by the FASL itself.
411     *
412     */
413    public static final Symbol _FASL_UNINTERNED_SYMBOLS_ =
414        internSpecial("*FASL-UNINTERNED-SYMBOLS*", PACKAGE_SYS, NIL);
415
416    // Function to access the uninterned symbols "array"
417    public final static LispObject getUninternedSymbol(int n) {
418        LispThread thread = LispThread.currentThread();
419        LispObject uninternedSymbols =
420            Load._FASL_UNINTERNED_SYMBOLS_.symbolValue(thread);
421
422        if (! (uninternedSymbols instanceof Cons)) // it must be a vector
423            return uninternedSymbols.AREF(n);
424
425        // During normal loading, we won't get to this bit, however,
426        // with eval-when processing, we may need to fall back to
427        // *FASL-UNINTERNED-SYMBOLS* being an alist structure
428        LispObject label = LispInteger.getInstance(n);
429        while (uninternedSymbols != NIL)
430            {
431                LispObject item = uninternedSymbols.car();
432                if (label.eql(item.cdr()))
433                  return item.car();
434
435                uninternedSymbols = uninternedSymbols.cdr();
436            }
437        return error(new LispError("No entry for uninterned symbol."));
438    }
439
440
441    // ### init-fasl &key version
442    private static final Primitive INIT_FASL = new init_fasl();
443    private static class init_fasl extends Primitive {
444        init_fasl() {
445            super("init-fasl", PACKAGE_SYS, true, "&key version");
446        }
447        @Override
448        public LispObject execute(LispObject first, LispObject second)
449
450        {
451            final LispThread thread = LispThread.currentThread();
452            if (first == Keyword.VERSION) {
453                if (second.eql(_FASL_VERSION_.getSymbolValue())) {
454                    // OK
455                    thread.bindSpecial(_FASL_UNINTERNED_SYMBOLS_, NIL);
456                    thread.bindSpecial(_SOURCE_, NIL);
457                    return faslLoadStream(thread);
458                }
459            }
460            return
461                error(new SimpleError("FASL version mismatch; found '"
462                        + second.princToString() + "' but expected '"
463                        + _FASL_VERSION_.getSymbolValue().princToString()
464                        + "' in "
465                        + Symbol.LOAD_PATHNAME.symbolValue(thread).princToString()
466                        + " (try recompiling the file)"));
467        }
468    }
469
470    private static final LispObject loadFileFromStream(Pathname pathname,
471                                                       Pathname truename,
472                                                       Stream in,
473                                                       boolean verbose,
474                                                       boolean print,
475                                                       boolean auto)
476        {
477            return loadFileFromStream(pathname == null ? NIL : pathname,
478                                      truename == null ? NIL : truename,
479                                      in, verbose, print, auto, false);
480    }
481
482    private static Symbol[] savedSpecials =
483        new Symbol[] { // CLHS Specified
484                       Symbol.CURRENT_READTABLE, Symbol._PACKAGE_,
485                       // Compiler policy
486                       _SPEED_, _SPACE_, _SAFETY_, _DEBUG_, _EXPLAIN_ };
487
488    // A nil TRUENAME signals a load from stream which has no possible path
489    private static final LispObject loadFileFromStream(LispObject pathname,
490                                                       LispObject truename,
491                                                       Stream in,
492                                                       boolean verbose,
493                                                       boolean print,
494                                                       boolean auto,
495                                                       boolean returnLastResult)
496
497    {
498        long start = System.currentTimeMillis();
499        final LispThread thread = LispThread.currentThread();
500        final SpecialBindingsMark mark = thread.markSpecialBindings();
501
502        for (Symbol special : savedSpecials)
503            thread.bindSpecialToCurrentValue(special);
504
505        thread.bindSpecial(_BACKQUOTE_COUNT_, Fixnum.getInstance(0));
506        int loadDepth = Fixnum.getValue(_LOAD_DEPTH_.symbolValue(thread));
507        thread.bindSpecial(_LOAD_DEPTH_, Fixnum.getInstance(++loadDepth));
508        final String prefix = getLoadVerbosePrefix(loadDepth);
509        try {
510            thread.bindSpecial(Symbol.LOAD_PATHNAME, pathname);
511
512            // The motivation behind the following piece of complexity
513            // is the need to preserve the semantics of
514            // *LOAD-TRUENAME* as always containing the truename of
515            // the current "Lisp file".  Since an ABCL packed FASL
516            // actually has a Lisp file (aka "the init FASL") and one
517            // or more Java classes from the compiler, we endeavor to
518            // make *LOAD-TRUENAME* refer to the "overall" truename so
519            // that a (LOAD *LOAD-TRUENAME*) would be equivalent to
520            // reloading the complete current "Lisp file".  If this
521            // value diverges from the "true" truename, we set the
522            // symbol SYS::*LOAD-TRUENAME-FASL* to that divergent
523            // value.  Currently the only code that uses this value is
524            // Lisp.readFunctionBytes().
525            Pathname truePathname = null;
526            if (!truename.equals(NIL)) {
527                if (truename instanceof Pathname) {
528                  if (truename instanceof JarPathname) {
529                    truePathname = new JarPathname();
530                  } else if (truename instanceof URLPathname) {
531                    truePathname = new URLPathname();
532                  } else {
533                    truePathname = new Pathname();
534                  }
535                  truePathname.copyFrom((Pathname)truename);
536                } else if (truename instanceof AbstractString) {
537                  truePathname = (Pathname)Pathname.create(truename.getStringValue());
538                } else {
539                    Debug.assertTrue(false);
540                }
541                if (truePathname.getType().equal(Lisp._COMPILE_FILE_TYPE_.symbolValue(thread))
542                    || truePathname.getType().equal(COMPILE_FILE_INIT_FASL_TYPE)) {
543                    Pathname truenameFasl = Pathname.create(truePathname);
544                    thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truenameFasl);
545                }
546                if (truePathname.getType().equal(COMPILE_FILE_INIT_FASL_TYPE)
547                    && truePathname.isJar()) {
548                  // We set *LOAD-TRUENAME* to the argument that a
549                  // user would pass to LOAD.
550                  LispObject possibleTruePathname = probe_file.PROBE_FILE.execute(pathname);
551                  if (!possibleTruePathname.equals(NIL)) {
552                    truePathname = (Pathname) possibleTruePathname;
553                  }
554                  /*
555                  if (truePathname.getDevice().cdr() != NIL ) {
556                    Pathname enclosingJar = (Pathname)truePathname.getDevice().cdr().car();
557                    truePathname.setDevice(new Cons(truePathname.getDevice().car(), NIL));
558                    truePathname.setHost(NIL);
559                    truePathname.setDirectory(enclosingJar.getDirectory());
560                    if (truePathname.getDirectory().car().equals(Keyword.RELATIVE)) {
561                      truePathname.getDirectory().setCar(Keyword.ABSOLUTE);
562                    }
563                    truePathname.setName(enclosingJar.getName());
564                    truePathname.setType(enclosingJar.getType());
565                    } else {
566                        // XXX There is something fishy in the asymmetry
567                        // between the "jar:jar:http:" and "jar:jar:file:"
568                        // cases but this currently passes the tests.
569                        if (!(truePathname.device.car() instanceof AbstractString)) {
570                          //                          assert truePathname.getDevice().car() instanceof Pathname;
571                          //                          Pathname p = Pathname.create((Pathname)truePathname.getDevice().car());
572                          truePathname
573                            = (Pathname) probe_file.PROBE_FILE.execute(pathname);
574                        }
575                    }
576                  */
577                  thread.bindSpecial(Symbol.LOAD_TRUENAME, truePathname);
578                } else {
579                    thread.bindSpecial(Symbol.LOAD_TRUENAME, truename);
580                }
581            } else {
582                thread.bindSpecial(Symbol.LOAD_TRUENAME, truename);
583            }
584            thread.bindSpecial(_SOURCE_,
585                               pathname != null ? pathname : NIL);
586            if (verbose) {
587                Stream out = getStandardOutput();
588                out.freshLine();
589                out._writeString(prefix);
590                out._writeString(auto ? " Autoloading " : " Loading ");
591                out._writeString(!truename.equals(NIL) ? truePathname.princToString() : "stream");
592                out._writeLine(" ...");
593                out._finishOutput();
594                LispObject result = loadStream(in, print, thread, returnLastResult);
595                long elapsed = System.currentTimeMillis() - start;
596                out.freshLine();
597                out._writeString(prefix);
598                out._writeString(auto ? " Autoloaded " : " Loaded ");
599                out._writeString(!truename.equals(NIL) ? truePathname.princToString() : "stream");
600                out._writeString(" (");
601                out._writeString(String.valueOf(((float)elapsed)/1000));
602                out._writeLine(" seconds)");
603                out._finishOutput();
604                return result;
605            } else
606                return loadStream(in, print, thread, returnLastResult);
607        }
608        finally {
609            thread.resetSpecialBindings(mark);
610        }
611    }
612
613    public static String getLoadVerbosePrefix(int loadDepth)
614    {
615        StringBuilder sb = new StringBuilder(";");
616        for (int i = loadDepth - 1; i-- > 0;)
617            sb.append(' ');
618        return sb.toString();
619    }
620
621    private static final LispObject loadStream(Stream in, boolean print,
622                                               LispThread thread, boolean returnLastResult)
623
624    {
625        final SpecialBindingsMark mark = thread.markSpecialBindings();
626        thread.bindSpecial(_LOAD_STREAM_, in);
627        SpecialBinding sourcePositionBinding =
628            thread.bindSpecial(_SOURCE_POSITION_, Fixnum.ZERO);
629        try {
630            final Environment env = new Environment();
631            LispObject result = NIL;
632            while (true) {
633                sourcePositionBinding.value = Fixnum.getInstance(in.getOffset());
634                LispObject obj = in.read(false, EOF, false,
635                                         thread, Stream.currentReadtable);
636                if (obj == EOF)
637                    break;
638                result = eval(obj, env, thread);
639                if (print) {
640                    Stream out =
641                        checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue(thread));
642                    out._writeLine(result.printObject());
643                    out._finishOutput();
644                }
645            }
646            if(returnLastResult) {
647                return result;
648            } else {
649                return T;
650            }
651        }
652        finally {
653            thread.resetSpecialBindings(mark);
654        }
655    }
656
657    static final LispObject faslLoadStream(LispThread thread)
658    {
659        Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
660        final Environment env = new Environment();
661        final SpecialBindingsMark mark = thread.markSpecialBindings();
662        LispObject result = NIL;
663        try {
664            // Same bindings are established in Lisp.readObjectFromString()
665            thread.bindSpecial(Symbol.READ_BASE, LispInteger.getInstance(10));
666            thread.bindSpecial(Symbol.READ_EVAL, Symbol.T);
667            thread.bindSpecial(Symbol.READ_SUPPRESS, Nil.NIL);
668
669            in.setExternalFormat(_FASL_EXTERNAL_FORMAT_.symbolValue(thread));
670            while (true) {
671                LispObject obj = in.read(false, EOF, false,  // should be 'true' once we
672                                                             // have a FASL wide object table
673                                         thread, Stream.faslReadtable);
674                if (obj == EOF)
675                    break;
676                result = eval(obj, env, thread);
677            }
678        }
679        finally {
680            thread.resetSpecialBindings(mark);
681        }
682        return result;
683        //There's no point in using here the returnLastResult flag like in
684        //loadStream(): this function is only called from init-fasl, which is
685        //only called from load, which already has its own policy for choosing
686        //whether to return T or the last value.
687    }
688
689
690    // ### %load filespec verbose print if-does-not-exist external-format=> generalized-boolean
691    private static final Primitive _LOAD = new _load();
692    private static class _load extends Primitive {
693        _load() {
694            super("%load", PACKAGE_SYS, false,
695                  "filespec verbose print if-does-not-exist external-format");
696        }
697        @Override
698        public LispObject execute(LispObject filespec, LispObject verbose,
699                                  LispObject print, LispObject ifDoesNotExist, 
700                                  LispObject externalFormat)
701        {
702            return load(filespec, verbose, print, ifDoesNotExist, NIL, externalFormat);
703        }
704    }
705
706    // ### %load-returning-last-result filespec verbose print if-does-not-exist external-format => object
707    private static final Primitive _LOAD_RETURNING_LAST_RESULT = new _load_returning_last_result();
708    private static class _load_returning_last_result extends Primitive {
709        _load_returning_last_result() {
710            super("%load-returning-last-result", PACKAGE_SYS, false,
711                  "filespec verbose print if-does-not-exist external-format");
712        }
713        @Override
714        public LispObject execute(LispObject filespec, LispObject verbose,
715                                  LispObject print, LispObject ifDoesNotExist, 
716                                  LispObject externalFormat) {
717             return load(filespec, verbose, print, ifDoesNotExist, T, externalFormat);
718        }
719    }
720
721    static final LispObject load(LispObject filespec,
722                                 LispObject verbose,
723                                 LispObject print,
724                                 LispObject ifDoesNotExist,
725                                 LispObject returnLastResult,
726                                 LispObject externalFormat)
727        {
728        if (filespec instanceof Stream) {
729            if (((Stream)filespec).isOpen()) {
730                // !?! in this case the external-format specifier is ignored:  warn user?
731                LispObject pathname;
732                if (filespec instanceof FileStream)
733                    pathname = ((FileStream)filespec).getPathname();
734                else
735                    pathname = NIL;
736                LispObject truename;
737                if (pathname instanceof Pathname)
738                    truename = pathname;
739                else
740                    truename = NIL;
741                return loadFileFromStream(pathname,
742                                          truename,
743                                          (Stream) filespec,
744                                          verbose != NIL,
745                                          print != NIL,
746                                          false,
747                                          returnLastResult != NIL);
748            }
749            // If stream is closed, fall through...
750        }
751        Pathname pathname = coerceToPathname(filespec);
752        if (pathname instanceof LogicalPathname)
753            pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
754        return load(pathname,
755                    verbose != NIL,
756                    print != NIL,
757                    ifDoesNotExist != NIL,
758                    returnLastResult != NIL,
759                    externalFormat);
760    }
761
762    // ### load-system-file
763    public static final Primitive LOAD_SYSTEM_FILE = new pf_load_system_file();
764    private static class pf_load_system_file extends Primitive {
765        pf_load_system_file () {
766            super("load-system-file", PACKAGE_SYS, true);
767        }
768        @Override
769        public LispObject execute(LispObject arg)
770        {
771            final LispThread thread = LispThread.currentThread();
772            return loadSystemFile(arg.getStringValue(),
773                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL
774                                  || System.getProperty("abcl.autoload.verbose") != null,
775                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
776                                  false);
777        }
778    }
779}
Note: See TracBrowser for help on using the repository browser.