← Back to branch summary

~ubuntu-branches/debian/stretch/tcl-fitstcl/stretch

« back to all changes in this revision

Viewing changes to .pc/set_installdir.patch/fitsInit.c

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2015-06-10 17:35:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20150610173543-37jifpt0bjuocrr0
Tags: 2.4-1
New upstream version

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/set_installdir.patch/fitsInit.c
6
6
 */
7
7
 
8
8
#include "fitsTclInt.h"
 
9
static Tcl_HashTable interpTokenMap;
 
10
static int interpTokenMapInitialised = 0;
9
11
 
10
12
FitsFD FitsOpenFiles[FITS_MAX_OPEN_FILES];
11
13
Tcl_HashTable *FitsDataStore;
14
16
 
15
17
fitsTclOptions userOptions;
16
18
 
 
19
Tcl_Command *
 
20
FitsTclInterpToTokens(
 
21
    Tcl_Interp *interp)
 
22
{
 
23
    int newEntry;
 
24
    Tcl_Command *cmdTokens;
 
25
    Tcl_HashEntry *entryPtr =
 
26
            Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry);
 
27
 
 
28
    if (newEntry) {
 
29
        cmdTokens = (Tcl_Command *)
 
30
                Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS+1));
 
31
        for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) {
 
32
            cmdTokens[newEntry] = NULL;
 
33
        }
 
34
        Tcl_SetHashValue(entryPtr, (ClientData) cmdTokens);
 
35
    } else {
 
36
        cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr);
 
37
    }
 
38
    return cmdTokens;
 
39
}
 
40
 
 
41
void
 
42
FitsTclFreeTokensHashTable(void)
 
43
{
 
44
    Tcl_HashSearch search;
 
45
    Tcl_HashEntry *entryPtr;
 
46
 
 
47
    for (entryPtr = Tcl_FirstHashEntry(&interpTokenMap, &search);
 
48
            entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
 
49
        Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
 
50
    }
 
51
    interpTokenMapInitialised = 0;
 
52
}
 
53
 
 
54
int
 
55
Fits_SafeInit (interp)
 
56
    Tcl_Interp *interp;     /* The Tcl Interpreter to initialize */
 
57
{
 
58
    return Fits_Init(interp);
 
59
}
 
60
 
 
61
void
 
62
FitsTclDeleteTokens(
 
63
    Tcl_Interp *interp)
 
64
{
 
65
    Tcl_HashEntry *entryPtr =
 
66
            Tcl_FindHashEntry(&interpTokenMap, (char *) interp);
 
67
 
 
68
    if (entryPtr) {
 
69
        Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
 
70
        Tcl_DeleteHashEntry(entryPtr);
 
71
    }
 
72
}
 
73
 
 
74
/*
 
75
 *----------------------------------------------------------------------
 
76
 *
 
77
 * FitsTcl_Unload --
 
78
 *
 
79
 *      This is a package unloading initialization procedure, which is called
 
80
 *      by Tcl when this package is to be unloaded from an interpreter.
 
81
 *
 
82
 * Results:
 
83
 *      None.
 
84
 *
 
85
 * Side effects:
 
86
 *      None.
 
87
 *
 
88
 *----------------------------------------------------------------------
 
89
 */
 
90
 
 
91
int
 
92
FitsTcl_Unload(
 
93
    Tcl_Interp *interp,         /* Interpreter from which the package is to be
 
94
                                 * unloaded. */
 
95
    int flags)                  /* Flags passed by the unloading mechanism */
 
96
{
 
97
    int code, cmdIndex;
 
98
    Tcl_Command *cmdTokens = FitsTclInterpToTokens(interp);
 
99
 
 
100
    for (cmdIndex=0 ; cmdIndex<MAX_REGISTERED_COMMANDS ; cmdIndex++) {
 
101
        if (cmdTokens[cmdIndex] == NULL) {
 
102
            continue;
 
103
        }
 
104
        code = Tcl_DeleteCommandFromToken(interp, cmdTokens[cmdIndex]);
 
105
        if (code != TCL_OK) {
 
106
            return code;
 
107
        }
 
108
    }
 
109
 
 
110
    FitsTclDeleteTokens(interp);
 
111
 
 
112
    Tcl_SetVar(interp, "::FitsTcl_detached", ".", TCL_APPEND_VALUE);
 
113
 
 
114
    if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
 
115
        /*
 
116
         * Tcl is ready to detach this library from the running application.
 
117
         * We should free all the memory that is not related to any
 
118
         * interpreter.
 
119
         */
 
120
 
 
121
        FitsTclFreeTokensHashTable();
 
122
        Tcl_SetVar(interp, "::FitsTcl_unloaded", ".", TCL_APPEND_VALUE);
 
123
    }
 
124
    return TCL_OK;
 
125
}
 
126
 
 
127
/*
 
128
 *----------------------------------------------------------------------
 
129
 *
 
130
 * FitsTcl_SafeUnload --
 
131
 *
 
132
 *      This is a package unloading initialization procedure, which is called
 
133
 *      by Tcl when this package is to be unloaded from an interpreter.
 
134
 *
 
135
 * Results:
 
136
 *      None.
 
137
 *
 
138
 * Side effects:
 
139
 *      None.
 
140
 *
 
141
 *----------------------------------------------------------------------
 
142
 */
 
143
 
 
144
int
 
145
FitsTcl_SafeUnload(
 
146
    Tcl_Interp *interp,         /* Interpreter from which the package is to be
 
147
                                 * unloaded. */
 
148
    int flags)                  /* Flags passed by the unloading mechanism */
 
149
{
 
150
    return FitsTcl_Unload(interp, flags);
 
151
}
 
152
 
17
153
int
18
154
Fits_Init (interp)
19
155
    Tcl_Interp *interp;     /* The Tcl Interpreter to initialize */