15.4.1200  src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkg

## mythryl-callable-c-library-interface.pkg
#
# See also:
#     src/c/h/mythryl-callable-c-libraries.h

# Compiled by:
#     src/lib/std/src/standard-core.sublib

stipulate
    package sg =  string_guts;                                  # string_guts   is from   src/lib/std/src/string-guts.pkg
herein
    package   mythryl_callable_c_library_interface
    :         Mythryl_Callable_C_Library_Interface              # Mythryl_Callable_C_Library_Interface  is from   src/lib/std/src/unsafe/mythryl-callable-c-library-interface.api
    {
                                                                # inline_t      is from   src/lib/core/init/built-in.pkg

                                                # for runtime see
                                                #     src/lib/core/init/core.pkg
                                                #     src/lib/core/init/runtime.pkg
                                                #     src/c/machine-dependent/prim.intel32.asm

        Cfunction = runtime::asm::Cfunction;

        find_cfun = runtime::asm::find_cfun;                    # Maps ultimately to    find_cfun               in    src/c/lib/mythryl-callable-c-libraries.c

        exception  CFUN_NOT_FOUND String;

                                                # inline_t              is from   src/lib/core/init/built-in.pkg        

        fun find_c_function  { lib_name, fun_name }
            =
            {   cfun =  find_cfun (lib_name, fun_name);

                if (inline_t::cast cfun  !=  0)
                    #               
                    fn x =  (runtime::asm::call_cfun (cfun, x));
                else
                    raise exception  CFUN_NOT_FOUND (sg::cat [lib_name, "::", fun_name]);
                fi;
            };


        System_Constant
            =
            (Int, String);

        exception  SYSTEM_CONSTANT_NOT_FOUND String;

        # Linear scan down list,
        # checking for string equality
        # on (#2 listelement):
        #
        fun find_system_constant (name, l)
            =
            get l
            where
                fun get []
                        =>
                        NULL;

                    get ((system_constant:  System_Constant) ! r)
                        =>
                        if (#2 system_constant  ==  name)
                            #  
                            THE system_constant;
                        else
                            get r;
                        fi;
                end;
            end;

        fun bind_system_constant (name, l)
            =
            case (find_system_constant (name, l))
                #             
                THE sc =>   sc;
                NULL   =>   raise exception  SYSTEM_CONSTANT_NOT_FOUND name;
            esac;

    }; #  package mythryl_callable_c_library_interface 
end;



## COPYRIGHT (c) 1994 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.