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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [dltest/] [pkgd.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
/*
2 
 * pkgd.c --
3 
 *
4 
 *      This file contains a simple Tcl package "pkgd" that is intended
5 
 *      for testing the Tcl dynamic loading facilities.  It can be used
6 
 *      in both safe and unsafe interpreters.
7 
 *
8 
 * Copyright (c) 1995 Sun Microsystems, Inc.
9 
 *
10 
 * See the file "license.terms" for information on usage and redistribution
11 
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 
 *
13 
 * SCCS: @(#) pkgd.c 1.4 96/02/15 12:30:32
14 
 */
15 
 
16 
#include "tcl.h"
17 
 
18 
/*
19 
 * Prototypes for procedures defined later in this file:
20 
 */
21 
 
22 
static int      Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
23 
                    Tcl_Interp *interp, int argc, char **argv));
24 
static int      Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
25 
                    Tcl_Interp *interp, int argc, char **argv));
26 
 
27 
/*
28 
 *----------------------------------------------------------------------
29 
 *
30 
 * Pkgd_SubCmd --
31 
 *
32 
 *      This procedure is invoked to process the "pkgd_sub" Tcl command.
33 
 *      It expects two arguments and returns their difference.
34 
 *
35 
 * Results:
36 
 *      A standard Tcl result.
37 
 *
38 
 * Side effects:
39 
 *      See the user documentation.
40 
 *
41 
 *----------------------------------------------------------------------
42 
 */
43 
 
44 
static int
45 
Pkgd_SubCmd(dummy, interp, argc, argv)
46 
    ClientData dummy;                   /* Not used. */
47 
    Tcl_Interp *interp;                 /* Current interpreter. */
48 
    int argc;                           /* Number of arguments. */
49 
    char **argv;                        /* Argument strings. */
50 
{
51 
    int first, second;
52 
 
53 
    if (argc != 3) {
54 
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
55 
                " num num\"", (char *) NULL);
56 
        return TCL_ERROR;
57 
    }
58 
    if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
59 
            || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
60 
        return TCL_ERROR;
61 
    }
62 
    sprintf(interp->result, "%d", first - second);
63 
    return TCL_OK;
64 
}
65 
 
66 
/*
67 
 *----------------------------------------------------------------------
68 
 *
69 
 * Pkgd_UnsafeCmd --
70 
 *
71 
 *      This procedure is invoked to process the "pkgd_unsafe" Tcl command.
72 
 *      It just returns a constant string.
73 
 *
74 
 * Results:
75 
 *      A standard Tcl result.
76 
 *
77 
 * Side effects:
78 
 *      See the user documentation.
79 
 *
80 
 *----------------------------------------------------------------------
81 
 */
82 
 
83 
static int
84 
Pkgd_UnsafeCmd(dummy, interp, argc, argv)
85 
    ClientData dummy;                   /* Not used. */
86 
    Tcl_Interp *interp;                 /* Current interpreter. */
87 
    int argc;                           /* Number of arguments. */
88 
    char **argv;                        /* Argument strings. */
89 
{
90 
    interp->result = "unsafe command invoked";
91 
    return TCL_OK;
92 
}
93 
 
94 
/*
95 
 *----------------------------------------------------------------------
96 
 *
97 
 * Pkgd_Init --
98 
 *
99 
 *      This is a package initialization procedure, which is called
100 
 *      by Tcl when this package is to be added to an interpreter.
101 
 *
102 
 * Results:
103 
 *      None.
104 
 *
105 
 * Side effects:
106 
 *      None.
107 
 *
108 
 *----------------------------------------------------------------------
109 
 */
110 
 
111 
int
112 
Pkgd_Init(interp)
113 
    Tcl_Interp *interp;         /* Interpreter in which the package is
114 
                                 * to be made available. */
115 
{
116 
    int code;
117 
 
118 
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
119 
    if (code != TCL_OK) {
120 
        return code;
121 
    }
122 
    Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
123 
            (Tcl_CmdDeleteProc *) NULL);
124 
    Tcl_CreateCommand(interp, "pkgd_unsafe", Pkgd_UnsafeCmd, (ClientData) 0,
125 
            (Tcl_CmdDeleteProc *) NULL);
126 
    return TCL_OK;
127 
}
128 
 
129 
/*
130 
 *----------------------------------------------------------------------
131 
 *
132 
 * Pkgd_SafeInit --
133 
 *
134 
 *      This is a package initialization procedure, which is called
135 
 *      by Tcl when this package is to be added to an unsafe interpreter.
136 
 *
137 
 * Results:
138 
 *      None.
139 
 *
140 
 * Side effects:
141 
 *      None.
142 
 *
143 
 *----------------------------------------------------------------------
144 
 */
145 
 
146 
int
147 
Pkgd_SafeInit(interp)
148 
    Tcl_Interp *interp;         /* Interpreter in which the package is
149 
                                 * to be made available. */
150 
{
151 
    Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
152 
            (Tcl_CmdDeleteProc *) NULL);
153 
    return TCL_OK;
154 
}

powered by: WebSVN 2.1.0

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