Changeset 13912
- Timestamp:
- 04/15/12 16:24:45 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
r13604 r13912 86 86 (declaim (ftype (function (t) t) verify-load)) 87 87 (defun verify-load (classfile) 88 #|(if (> *safety* 0)89 88 (and classfile 90 (let ((*load-truename* *output-file-pathname*)) 91 (report-error 92 (load-compiled-function classfile)))) 93 t)|# 94 (declare (ignore classfile)) 95 t) 89 (unless 90 (> (file-length (open classfile :direction :input)) 91 0) 92 ;;; TODO hook into a real ABCL compiler condition hierarchy 93 (signal "Internal compiler error detected: Fasl contains ~ 94 zero-length jvm classfile corresponding to ~A." classfile))) 95 (if (> *safety* *speed*) 96 (progn 97 (warn "Because(> *safety* *speed*): Testing fasl via ~ 98 the potentially slow loading of its JVM bytecode." ) 99 (let ((*load-truename* *output-file-pathname*)) 100 (report-error 101 (load-compiled-function classfile)))) 102 t)) 96 103 97 104 (declaim (ftype (function (t) t) note-toplevel-form)) … … 151 158 (return-from convert-toplevel-form 152 159 (precompiler:precompile-form form nil *compile-file-environment*))) 153 (let* ((expr `(lambda () ,form)) 160 (let* ((toplevel-form (third form)) 161 (expr `(lambda () ,form)) 154 162 (saved-class-number *class-number*) 155 163 (classfile (next-classfile-name)) … … 162 170 (report-error (jvm:compile-defun nil 163 171 expr *compile-file-environment* 164 classfile f declare-inline)))) 165 (compiled-function (verify-load classfile))) 172 classfile f 173 declare-inline)))) 174 (compiled-function (handler-case (verify-load classfile) 175 (t (c) 176 (error "Compilation failed for JVM class number ~A 177 corresponding to form ~A~&with condition ~A" 178 saved-class-number toplevel-form c))))) 166 179 (declare (ignore result)) 167 (setf form 168 (if compiled-function 169 `(funcall (sys::get-fasl-function *fasl-loader* 170 ,saved-class-number)) 171 (precompiler:precompile-form form nil 172 *compile-file-environment*))))) 173 174 180 (progn 181 (when (> *debug* 0) 182 ;;; ??? define an API by perhaps exporting these symbols? 183 (setf (getf form 'form-source) 184 toplevel-form 185 186 (getf form 'classfile) 187 classfile 188 189 (getf form 'compiled-function) 190 compiled-function 191 192 (getf form 'class-number) 193 saved-class-number)) 194 (setf form 195 (if compiled-function 196 `(funcall (sys::get-fasl-function *fasl-loader* 197 ,saved-class-number)) 198 (precompiler:precompile-form form nil 199 *compile-file-environment*)))))) 175 200 176 201
Note: See TracChangeset
for help on using the changeset viewer.