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