source: branches/1.1.x/src/org/armedbear/lisp/Load.java

Last change on this file was 14194, checked in by Mark Evenson, 12 years ago

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