OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tcl/] [unix/] [tclLoadDld.c] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
2
 * tclLoadDld.c --
3
 *
4
 *      This procedure provides a version of the TclLoadFile that
5
 *      works with the "dld_link" and "dld_get_func" library procedures
6
 *      for dynamic loading.  It has been tested on Linux 1.1.95 and
7
 *      dld-3.2.7.  This file probably isn't needed anymore, since it
8
 *      makes more sense to use "dl_open" etc.
9
 *
10
 * Copyright (c) 1995 Sun Microsystems, Inc.
11
 *
12
 * See the file "license.terms" for information on usage and redistribution
13
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14
 *
15
 * RCS: @(#) $Id: tclLoadDld.c,v 1.1.1.1 2002-01-16 10:25:37 markom Exp $
16
 */
17
 
18
#include "tclInt.h"
19
#include "dld.h"
20
 
21
/*
22
 * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
23
 * and this argument to dlopen must always be 1.
24
 */
25
 
26
#ifndef RTLD_NOW
27
#   define RTLD_NOW 1
28
#endif
29
 
30
/*
31
 *----------------------------------------------------------------------
32
 *
33
 * TclLoadFile --
34
 *
35
 *      Dynamically loads a binary code file into memory and returns
36
 *      the addresses of two procedures within that file, if they
37
 *      are defined.
38
 *
39
 * Results:
40
 *      A standard Tcl completion code.  If an error occurs, an error
41
 *      message is left in interp->result.  *proc1Ptr and *proc2Ptr
42
 *      are filled in with the addresses of the symbols given by
43
 *      *sym1 and *sym2, or NULL if those symbols can't be found.
44
 *
45
 * Side effects:
46
 *      New code suddenly appears in memory.
47
 *
48
 *----------------------------------------------------------------------
49
 */
50
 
51
int
52
TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
53
    Tcl_Interp *interp;         /* Used for error reporting. */
54
    char *fileName;             /* Name of the file containing the desired
55
                                 * code. */
56
    char *sym1, *sym2;          /* Names of two procedures to look up in
57
                                 * the file's symbol table. */
58
    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
59
                                /* Where to return the addresses corresponding
60
                                 * to sym1 and sym2. */
61
{
62
    static int firstTime = 1;
63
    int returnCode;
64
 
65
    /*
66
     *  The dld package needs to know the pathname to the tcl binary.
67
     *  If that's not know, return an error.
68
     */
69
 
70
    if (firstTime) {
71
        if (tclExecutableName == NULL) {
72
            Tcl_SetResult(interp,
73
                    "don't know name of application binary file, so can't initialize dynamic loader",
74
                    TCL_STATIC);
75
            return TCL_ERROR;
76
        }
77
        returnCode = dld_init(tclExecutableName);
78
        if (returnCode != 0) {
79
            Tcl_AppendResult(interp,
80
                    "initialization failed for dynamic loader: ",
81
                    dld_strerror(returnCode), (char *) NULL);
82
            return TCL_ERROR;
83
        }
84
        firstTime = 0;
85
    }
86
 
87
    if ((returnCode = dld_link(fileName)) != 0) {
88
        Tcl_AppendResult(interp, "couldn't load file \"", fileName,
89
            "\": ", dld_strerror(returnCode), (char *) NULL);
90
        return TCL_ERROR;
91
    }
92
    *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1);
93
    *proc2Ptr = (Tcl_PackageInitProc *) dld_get_func(sym2);
94
    return TCL_OK;
95
}
96
 
97
/*
98
 *----------------------------------------------------------------------
99
 *
100
 * TclGuessPackageName --
101
 *
102
 *      If the "load" command is invoked without providing a package
103
 *      name, this procedure is invoked to try to figure it out.
104
 *
105
 * Results:
106
 *      Always returns 0 to indicate that we couldn't figure out a
107
 *      package name;  generic code will then try to guess the package
108
 *      from the file name.  A return value of 1 would have meant that
109
 *      we figured out the package name and put it in bufPtr.
110
 *
111
 * Side effects:
112
 *      None.
113
 *
114
 *----------------------------------------------------------------------
115
 */
116
 
117
int
118
TclGuessPackageName(fileName, bufPtr)
119
    char *fileName;             /* Name of file containing package (already
120
                                 * translated to local form if needed). */
121
    Tcl_DString *bufPtr;        /* Initialized empty dstring.  Append
122
                                 * package name to this if possible. */
123
{
124
    return 0;
125
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.