source: branches/streams/abcl/src/org/armedbear/lisp/Load.java

Last change on this file was 14634, checked in by Mark Evenson, 11 years ago

Methods to load Lisp code directly from an InputStream?.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 33.4 KB
Line 
1/*
2 * Load.java
3 *
4 * Copyright (C) 2002-2007 Peter Graves
5 * $Id: Load.java 14634 2014-03-03 19:14:04Z 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, Keyword.DEFAULT);
129    }
130 
131    public static final LispObject load(InputStream in) 
132    {
133      return load(in, new SimpleString("UTF-8"));
134    }
135 
136    public static  final LispObject load(InputStream in, LispObject format) {
137        Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER, 
138                                   format);
139        final LispThread thread = LispThread.currentThread();
140        return loadFileFromStream(null, 
141                                  null,
142                                  stream,
143                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
144                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
145                                  false);
146    }
147
148
149    public static final LispObject load(final Pathname pathname,
150                                        boolean verbose,
151                                        boolean print,
152                                        boolean ifDoesNotExist,
153                                        boolean returnLastResult,
154                                        LispObject externalFormat)
155    {
156        Pathname mergedPathname = null;
157        if (!pathname.isAbsolute() && !pathname.isJar()) {
158            Pathname pathnameDefaults
159                = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
160            mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults);
161        }
162        Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
163        Pathname truename = coercePathnameOrNull(Pathname.truename(loadableFile));
164
165        if (truename == null || truename.equals(NIL)) {
166            if (ifDoesNotExist) {
167                return error(new FileError("File not found: " + pathname.princToString(), pathname));
168            } else {
169                Debug.warn("Failed to load " + pathname.getNamestring());
170                return NIL;
171            }
172        }
173
174        if (Utilities.checkZipFile(truename)) {
175            String n = truename.getNamestring();
176            String name = Pathname.uriEncode(truename.name.getStringValue());
177            if (n.startsWith("jar:")) {
178                n = "jar:" + n + "!/" + name + "."
179                    + COMPILE_FILE_INIT_FASL_TYPE;
180      } else if (n.startsWith("zip:")) {
181                n = "zip:" + n + "!/" + name + "."
182                    + COMPILE_FILE_INIT_FASL_TYPE;
183            } else {
184                n = "jar:file:" + Pathname.uriEncode(n) + "!/" + name + "."
185                    + COMPILE_FILE_INIT_FASL_TYPE;
186            }
187            if (!((mergedPathname = new Pathname(n)) instanceof Pathname)) {
188              return error(new FileError((MessageFormat.format("Failed to address JAR-PATHNAME truename {0} for name {1}", truename.princToString(), name)), truename));
189            }
190
191            LispObject initTruename = coercePathnameOrNull(Pathname.truename(mergedPathname));
192            if (initTruename == null || initTruename.equals(NIL)) {
193                // Maybe the enclosing JAR has been renamed?
194                Pathname p = new Pathname(mergedPathname);
195                p.name = Keyword.WILD;
196                p.invalidateNamestring();
197                LispObject result = Pathname.MATCH_WILD_JAR_PATHNAME.execute(p);
198
199                if      (result instanceof Cons
200                    && ((Cons)result).length() == 1
201                    && ((Cons)result).car() instanceof Pathname) {
202                    initTruename = (Pathname)result.car();
203                } else {
204                  String errorMessage
205                      = "Loadable FASL not found for "
206                      + "'" + pathname.printObject() + "'"
207                      + " in "
208                      + "'" + mergedPathname.printObject() + "'";
209                  if (ifDoesNotExist) {
210                      return error(new FileError(errorMessage, mergedPathname));
211                  } else {
212                      Debug.trace(errorMessage);
213                      return NIL;
214                  }
215                }
216            }
217            truename = (Pathname)initTruename;
218        } 
219       
220        InputStream in = truename.getInputStream();
221        Debug.assertTrue(in != null);
222   
223        try {
224            return loadFileFromStream(pathname, truename,
225                                      new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER, externalFormat),
226                                      verbose, print, false, returnLastResult);
227        }
228        finally {
229            if (in != null) {
230                try {
231                   in.close();
232                }
233                catch (IOException e) {
234                    return error(new LispError(e.getMessage()));
235                }
236            }
237        }
238    }
239
240    public static LispObject loadSystemFile(String filename, boolean auto)
241    {
242        LispThread thread = LispThread.currentThread();
243        if (auto) {
244            final SpecialBindingsMark mark = thread.markSpecialBindings();
245            // Due to autoloading, we're not sure about the loader state.
246            // Make sure that all reader relevant variables have known state.
247            thread.bindSpecial(Symbol.CURRENT_READTABLE,
248                               STANDARD_READTABLE.symbolValue(thread));
249            thread.bindSpecial(Symbol.READ_BASE, Fixnum.constants[10]);
250            thread.bindSpecial(Symbol.READ_SUPPRESS, NIL);
251            thread.bindSpecial(Symbol.READ_EVAL, T);
252            thread.bindSpecial(Symbol.READ_DEFAULT_FLOAT_FORMAT, Symbol.SINGLE_FLOAT);
253            thread.bindSpecial(Symbol._PACKAGE_, PACKAGE_CL_USER);
254            try {
255                return loadSystemFile(filename,
256                                      _AUTOLOAD_VERBOSE_.symbolValue(thread) != NIL,
257                                      Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
258                                      auto);
259            }
260            finally {
261                thread.resetSpecialBindings(mark);
262            }
263        } else {
264            return loadSystemFile(filename,
265                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL,
266                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
267                                  auto);
268        }
269    }
270
271    private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
272    static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
273
274    private static final Pathname coercePathnameOrNull(LispObject p) {
275        if (p == null) {
276            return null;
277        }
278        Pathname result = null;
279        try {
280            result = (Pathname)p;
281        } catch (Throwable t) { // XXX narrow me!
282            return null;
283        }
284        return result;
285    }
286       
287
288    public static final LispObject loadSystemFile(final String filename,
289                                                  boolean verbose,
290                                                  boolean print,
291                                                  boolean auto)
292    {
293        InputStream in = null;
294        Pathname pathname = null;
295        Pathname truename = null;
296        pathname = new Pathname(filename);
297        LispObject bootPath = Site.getLispHome();
298        Pathname mergedPathname;
299        if (bootPath instanceof Pathname) {
300            mergedPathname = Pathname.mergePathnames(pathname, (Pathname)bootPath);
301        } else {
302            mergedPathname = pathname;
303        }
304        URL url = null;
305        Pathname loadableFile = findLoadableFile(mergedPathname);
306        truename = coercePathnameOrNull(Pathname.truename(loadableFile));
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 = new Pathname(url);
328                loadableFile = findLoadableFile(urlPathname);
329                truename = (Pathname)Pathname.truename(loadableFile);
330                if (truename == null) {
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.type.princToString().equals(COMPILE_FILE_TYPE) && Utilities.checkZipFile(truename))  {
342            Pathname init = new Pathname(truename.getNamestring());
343            init.type = COMPILE_FILE_INIT_FASL_TYPE;
344            init.name = new SimpleString("__loader__");
345            LispObject t = Pathname.truename(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(42));
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                    truePathname = new Pathname((Pathname)truename);
529                } else if (truename instanceof AbstractString) {
530                    truePathname = new Pathname(truename.getStringValue());
531                } else {
532                    Debug.assertTrue(false);
533                }
534                String type = truePathname.type.getStringValue();
535                if (type.equals(Lisp._COMPILE_FILE_TYPE_.symbolValue(thread).getStringValue())
536                    || type.equals(COMPILE_FILE_INIT_FASL_TYPE.toString())) {
537                    Pathname truenameFasl = new Pathname(truePathname);
538                    thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truenameFasl);
539                }
540                if (truePathname.type.getStringValue()
541                    .equals(COMPILE_FILE_INIT_FASL_TYPE.getStringValue())
542                    && truePathname.isJar()) {
543                    if (truePathname.device.cdr() != NIL ) {
544                        // We set *LOAD-TRUENAME* to the argument that
545                        // a user would pass to LOAD.
546                        Pathname enclosingJar = (Pathname)truePathname.device.cdr().car();
547                        truePathname.device = new Cons(truePathname.device.car(), NIL);
548                        truePathname.host = NIL;
549                        truePathname.directory = enclosingJar.directory;
550                        if (truePathname.directory.car().equals(Keyword.RELATIVE)) {
551                            truePathname.directory.setCar(Keyword.ABSOLUTE);
552                        }
553                        truePathname.name = enclosingJar.name;
554                        truePathname.type = enclosingJar.type;
555                        truePathname.invalidateNamestring();
556                    } else {
557                        // XXX There is something fishy in the asymmetry
558                        // between the "jar:jar:http:" and "jar:jar:file:"
559                        // cases but this currently passes the tests.
560                        if (!(truePathname.device.car() instanceof AbstractString)) {
561                          assert truePathname.device.car() instanceof Pathname;
562                          Pathname p = new Pathname((Pathname)truePathname.device.car());
563                          truePathname
564                            = (Pathname) probe_file.PROBE_FILE.execute(p);
565                          truePathname.invalidateNamestring();
566                        }
567                    }
568                    thread.bindSpecial(Symbol.LOAD_TRUENAME, truePathname);
569                } else {
570                    thread.bindSpecial(Symbol.LOAD_TRUENAME, truename);
571                }
572            } else {
573                thread.bindSpecial(Symbol.LOAD_TRUENAME, truename);
574            }
575            thread.bindSpecial(_SOURCE_,
576                               pathname != null ? pathname : NIL);
577            if (verbose) {
578                Stream out = getStandardOutput();
579                out.freshLine();
580                out._writeString(prefix);
581                out._writeString(auto ? " Autoloading " : " Loading ");
582                out._writeString(!truename.equals(NIL) ? truePathname.princToString() : "stream");
583                out._writeLine(" ...");
584                out._finishOutput();
585                LispObject result = loadStream(in, print, thread, returnLastResult);
586                long elapsed = System.currentTimeMillis() - start;
587                out.freshLine();
588                out._writeString(prefix);
589                out._writeString(auto ? " Autoloaded " : " Loaded ");
590                out._writeString(!truename.equals(NIL) ? truePathname.princToString() : "stream");
591                out._writeString(" (");
592                out._writeString(String.valueOf(((float)elapsed)/1000));
593                out._writeLine(" seconds)");
594                out._finishOutput();
595                return result;
596            } else
597                return loadStream(in, print, thread, returnLastResult);
598        }
599        finally {
600            thread.resetSpecialBindings(mark);
601        }
602    }
603
604    public static String getLoadVerbosePrefix(int loadDepth)
605    {
606        StringBuilder sb = new StringBuilder(";");
607        for (int i = loadDepth - 1; i-- > 0;)
608            sb.append(' ');
609        return sb.toString();
610    }
611
612    private static final LispObject loadStream(Stream in, boolean print,
613                                               LispThread thread, boolean returnLastResult)
614
615    {
616        final SpecialBindingsMark mark = thread.markSpecialBindings();
617        thread.bindSpecial(_LOAD_STREAM_, in);
618        SpecialBinding sourcePositionBinding =
619            thread.bindSpecial(_SOURCE_POSITION_, Fixnum.ZERO);
620        try {
621            final Environment env = new Environment();
622            LispObject result = NIL;
623            while (true) {
624                sourcePositionBinding.value = Fixnum.getInstance(in.getOffset());
625                LispObject obj = in.read(false, EOF, false,
626                                         thread, Stream.currentReadtable);
627                if (obj == EOF)
628                    break;
629    result = eval(obj, env, thread);
630                if (print) {
631                    Stream out =
632                        checkCharacterOutputStream(Symbol.STANDARD_OUTPUT.symbolValue(thread));
633                    out._writeLine(result.printObject());
634                    out._finishOutput();
635                }
636            }
637            if(returnLastResult) {
638                return result;
639            } else {
640                return T;
641            }
642        }
643        finally {
644            thread.resetSpecialBindings(mark);
645        }
646    }
647
648    static final LispObject faslLoadStream(LispThread thread)
649    {
650        Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread);
651        final Environment env = new Environment();
652        final SpecialBindingsMark mark = thread.markSpecialBindings();
653        LispObject result = NIL;
654        try {
655            // Same bindings are established in Lisp.readObjectFromString()
656            thread.bindSpecial(Symbol.READ_BASE, LispInteger.getInstance(10));
657            thread.bindSpecial(Symbol.READ_EVAL, Symbol.T);
658            thread.bindSpecial(Symbol.READ_SUPPRESS, Nil.NIL);
659
660            in.setExternalFormat(_FASL_EXTERNAL_FORMAT_.symbolValue(thread));
661            while (true) {
662                LispObject obj = in.read(false, EOF, false,  // should be 'true' once we
663                                                             // have a FASL wide object table
664                                         thread, Stream.faslReadtable);
665                if (obj == EOF)
666                    break;
667                result = eval(obj, env, thread);
668            }
669        }
670        finally {
671            thread.resetSpecialBindings(mark);
672        }
673        return result;
674        //There's no point in using here the returnLastResult flag like in
675        //loadStream(): this function is only called from init-fasl, which is
676        //only called from load, which already has its own policy for choosing
677        //whether to return T or the last value.
678    }
679
680
681    // ### %load filespec verbose print if-does-not-exist external-format=> generalized-boolean
682    private static final Primitive _LOAD = new _load();
683    private static class _load extends Primitive {
684        _load() {
685            super("%load", PACKAGE_SYS, false,
686                  "filespec verbose print if-does-not-exist external-format");
687        }
688        @Override
689        public LispObject execute(LispObject filespec, LispObject verbose,
690                                  LispObject print, LispObject ifDoesNotExist, 
691                                  LispObject externalFormat)
692        {
693            return load(filespec, verbose, print, ifDoesNotExist, NIL, externalFormat);
694        }
695    }
696
697    // ### %load-returning-last-result filespec verbose print if-does-not-exist external-format => object
698    private static final Primitive _LOAD_RETURNING_LAST_RESULT = new _load_returning_last_result();
699    private static class _load_returning_last_result extends Primitive {
700        _load_returning_last_result() {
701            super("%load-returning-last-result", PACKAGE_SYS, false,
702                  "filespec verbose print if-does-not-exist external-format");
703        }
704        @Override
705        public LispObject execute(LispObject filespec, LispObject verbose,
706                                  LispObject print, LispObject ifDoesNotExist, 
707                                  LispObject externalFormat) {
708             return load(filespec, verbose, print, ifDoesNotExist, T, externalFormat);
709        }
710    }
711
712    static final LispObject load(LispObject filespec,
713                                 LispObject verbose,
714                                 LispObject print,
715                                 LispObject ifDoesNotExist,
716                                 LispObject returnLastResult,
717                                 LispObject externalFormat)
718        {
719        if (filespec instanceof Stream) {
720            if (((Stream)filespec).isOpen()) {
721                // !?! in this case the external-format specifier is ignored:  warn user?
722                LispObject pathname;
723                if (filespec instanceof FileStream)
724                    pathname = ((FileStream)filespec).getPathname();
725                else
726                    pathname = NIL;
727                LispObject truename;
728                if (pathname instanceof Pathname)
729                    truename = pathname;
730                else
731                    truename = NIL;
732                return loadFileFromStream(pathname,
733                                          truename,
734                                          (Stream) filespec,
735                                          verbose != NIL,
736                                          print != NIL,
737                                          false,
738                                          returnLastResult != NIL);
739            }
740            // If stream is closed, fall through...
741        }
742        Pathname pathname = coerceToPathname(filespec);
743        if (pathname instanceof LogicalPathname)
744            pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname);
745        return load(pathname,
746                    verbose != NIL,
747                    print != NIL,
748                    ifDoesNotExist != NIL,
749                    returnLastResult != NIL,
750                    externalFormat);
751    }
752
753    // ### load-system-file
754    private static final Primitive LOAD_SYSTEM_FILE = new load_system_file();
755    private static class load_system_file extends Primitive {
756        load_system_file () {
757            super("load-system-file", PACKAGE_SYS, true);
758        }
759        @Override
760        public LispObject execute(LispObject arg)
761        {
762            final LispThread thread = LispThread.currentThread();
763            return loadSystemFile(arg.getStringValue(),
764                                  Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL
765                                  || System.getProperty("abcl.autoload.verbose") != null,
766                                  Symbol.LOAD_PRINT.symbolValue(thread) != NIL,
767                                  false);
768        }
769    }
770}
Note: See TracBrowser for help on using the repository browser.