15.4.165  src/lib/c-glue-lib/ram/linkage-dlopen.pkg

## linkage-dlopen.pkg
#
# This module implements a high-level interface for dlopen.
#   While addresses (those obtained by applying function "address" below
#   or addresses derived from those) will not remain valid across
#   (fork|spawn)_to_disk/restart, handles *will* stay valid.

# Compiled by:
#     src/lib/c-glue-lib/ram/memory.lib

stipulate
    package at  =  runtime_internals::at;                                               # runtime_internals     is from   src/lib/std/src/nj/runtime-internals.pkg
    package ci  =  unsafe::mythryl_callable_c_library_interface;                        # unsafe                is from   src/lib/std/src/unsafe/unsafe.pkg
herein

    package dynamic_linkage
    :       Dynamic_Linkage                                                             # Dynamic_Linkage       is from   src/lib/c-glue-lib/ram/linkage.api
    {
        #
        exception DYNAMIC_LINK_ERROR  String;

        stipulate
            Era = Ref( Void );
            Addr = one_word_unt::Unt;



            # A handle remembers an address and the era of its creation as
            # well as a function to re-create the address when necessary:

            Handle = (Ref( (Addr, Era) ), (Void -> Addr));
        herein
            Lib_Handle = Handle;
            Addr_Handle = Handle;
        end;

        stipulate


            # Low-level linkage via dlopen/dlsym 

            my dlopen:   (Null_Or( String ), Bool, Bool) -> one_word_unt::Unt  =  ci::find_c_function { lib_name => "dynamic_loading", fun_name => "dlopen"  };
            my dlsym:       (one_word_unt::Unt, String) -> one_word_unt::Unt   =  ci::find_c_function { lib_name => "dynamic_loading", fun_name => "dlsym"   };
            my dlerror:                             Void ->  Null_Or( String ) =  ci::find_c_function { lib_name => "dynamic_loading", fun_name => "dlerror" };
            my dlclose:                             one_word_unt::Unt -> Void  =  ci::find_c_function { lib_name => "dynamic_loading", fun_name => "dlclose" };

            #  Label used for clean up:
            label = "DynLinkNewEra";

            # Generate a new "era" indicator:
            fun new_era () = REF ();

            # The current era:
            now = REF (new_era ());

            # Make a handle, remember era of creation of its current value 
            fun make_handle f
                =
                (REF (f (), *now), f);



            # Fetch from a handle.
            #   
            # Use the stored address if it was created
            # in the current era, otherwise regenerate the address:
            #
            fun get (r as REF (a, e), f)
                =
                if (e == *now)
                    #
                    a;
                else
                    a = f ();
                    r := (a, *now);
                    a;
                fi;



            # Call a dl-function and check for errors:
            #
            fun checked dlf x
                =
                {   r = dlf x;
                    #
                    case (dlerror ())
                        #                 
                        NULL  =>   r;
                        THE s =>   raise exception DYNAMIC_LINK_ERROR s;
                    esac;
                };


            # Add a startup/shutdown fn that causes a new era to start
            # every time the runtime system is started anew:
            #
            my _ =  at::schedule (
                        label,                                                                  # Arbitrary human-readable descriptive string for debugging displays.
                        [ at::STARTUP_PHASE_10_START_NEW_DLOPEN_ERA ],                          # When to run the function.
                        \\ _ =   now := new_era ()                                              # Function to run.
                    );
        herein

            main_lib
                =
                make_handle   (\\ () =  checked dlopen (NULL, TRUE, TRUE) );

            fun open_lib' { name, lazy, global, dependencies }
                =
                make_handle (\\ () =    {       apply (ignore o get) dependencies;
                                            checked dlopen (THE name, lazy, global);
                                        }
                          );

            fun open_lib { name, lazy, global }
                =
                open_lib' { name, lazy, global, dependencies => [] };

            fun lib_symbol (lh, s)
                =
                make_handle   (\\ () =   checked dlsym (get lh, s) );

            address = get;

            fun close_lib lh
                =
                dlclose (get lh);
        end;
    };
end;