/[cmucl]/src/code/foreign.lisp
ViewVC logotype

Diff of /src/code/foreign.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by pw, Sat Aug 23 15:59:59 1997 UTC revision 1.25 by pw, Sat Oct 25 16:31:55 1997 UTC
# Line 394  Line 394 
394  (defconstant rtld-lazy 1)  (defconstant rtld-lazy 1)
395  (defconstant rtld-now 2)  (defconstant rtld-now 2)
396  (defconstant rtld-global #-irix #o400 #+irix 4)  (defconstant rtld-global #-irix #o400 #+irix 4)
397    ;; Dynamically loaded stuff isn't there upon restoring from a save--this is
398    ;;primarily for irix, which resolves tzname at runtime, resulting in
399    ;;*global-table* being set in the saved core image, resulting in havoc upon
400    ;;restart.
401    (pushnew #'(lambda () (setq *global-table* nil))
402             ext:*after-save-initializations*)
403  (defvar *global-table* NIL)  (defvar *global-table* NIL)
404  (defvar *dso-linker*  (defvar *dso-linker*
405    #+solaris "/usr/ccs/bin/ld"    #+solaris "/usr/ccs/bin/ld"
# Line 407  Line 413 
413  (alien:def-alien-routine dlclose void (lib system-area-pointer))  (alien:def-alien-routine dlclose void (lib system-area-pointer))
414  (alien:def-alien-routine dlerror c-call:c-string)  (alien:def-alien-routine dlerror c-call:c-string)
415    
416    ;; Ensure we've opened our own binary so can resolve global variables in the
417    ;;lisp image that come from libraries. This used to happen only in
418    ;;alternate-get-global-address, and only if no libraries were dlopened already,
419    ;;but that didn't work if something was dlopened before any problem global vars
420    ;;were used. So now we do this in any function that can add to the global-table,
421    ;;as well as in a-g-g-a.
422    (defun ensure-lisp-table-opened ()
423      (unless *global-table*
424        ;; Prevent recursive call if dlopen isn't defined
425        (setf *global-table* (int-sap 0))
426        (setf *global-table* (list (dlopen nil rtld-lazy)))
427        (when (zerop (system:sap-int (car *global-table*)))
428          (error "Can't open global symbol table: ~S" (dlerror)))))
429    
430  (defun load-object-file (file)  (defun load-object-file (file)
431      (ensure-lisp-table-opened)
432    ; rtld global: so it can find all the symbols previously loaded    ; rtld global: so it can find all the symbols previously loaded
433    ; rtld now: that way dlopen will fail if not all symbols are defined.    ; rtld now: that way dlopen will fail if not all symbols are defined.
434    (let ((sap (dlopen file (logior rtld-now rtld-global))))    (let ((sap (dlopen file (logior rtld-now rtld-global))))
# Line 416  Line 437 
437             (pushnew sap *global-table* :test #'sap=))))             (pushnew sap *global-table* :test #'sap=))))
438    
439  (defun alternate-get-global-address (symbol)  (defun alternate-get-global-address (symbol)
440    (unless *global-table*    (ensure-lisp-table-opened)
           ;; Prevent recursive call when dlopen isn't defined.  
           (setq *global-table* (int-sap 0))  
           ;; Load standard object  
           (setq *global-table* (list (dlopen nil rtld-lazy)))  
           (if (zerop (system:sap-int (car *global-table*)))  
               (error "Can't open global symbol table: ~S" (dlerror))))  
441    ;; find the symbol in any of the loaded obbjects,    ;; find the symbol in any of the loaded obbjects,
442    ;; search in reverse order of loading, later loadings    ;; search in reverse order of loading, later loadings
443    ;; take precedence    ;; take precedence

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5