1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
/*
* tclMacLoad.c --
*
* This procedure provides a version of the TclLoadFile for use
* on the Macintosh. This procedure will only work with systems
* that use the Code Fragment Manager.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclMacLoad.c 1.20 97/11/20 18:39:20
*/
#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include <FSpCompat.h>
/*
* Seems that the 3.0.1 Universal headers leave this define out. So we
* define it here...
*/
#ifndef fragNoErr
#define fragNoErr noErr
#endif
#include "tclPort.h"
#include "tclInt.h"
#include "tclMacInt.h"
#if GENERATINGPOWERPC
#define OUR_ARCH_TYPE kPowerPCCFragArch
#else
#define OUR_ARCH_TYPE kMotorola68KCFragArch
#endif
/*
* The following data structure defines the structure of a code fragment
* resource. We can cast the resource to be of this type to access
* any fields we need to see.
*/
struct CfrgHeader {
long res1;
long res2;
long version;
long res3;
long res4;
long filler1;
long filler2;
long itemCount;
char arrayStart; /* Array of externalItems begins here. */
};
typedef struct CfrgHeader CfrgHeader, *CfrgHeaderPtr, **CfrgHeaderPtrHand;
/*
* The below structure defines a cfrag item within the cfrag resource.
*/
struct CfrgItem {
OSType archType;
long updateLevel;
long currVersion;
long oldDefVersion;
long appStackSize;
short appSubFolder;
char usage;
char location;
long codeOffset;
long codeLength;
long res1;
long res2;
short itemSize;
Str255 name; /* This is actually variable sized. */
};
typedef struct CfrgItem CfrgItem;
/*
*----------------------------------------------------------------------
*
* TclLoadFile --
*
* This procedure is called to carry out dynamic loading of binary
* code for the Macintosh. This implementation is based on the
* Code Fragment Manager & will not work on other systems.
*
* Results:
* The result is TCL_ERROR, and an error message is left in
* interp->result.
*
* Side effects:
* New binary code is loaded.
*
*----------------------------------------------------------------------
*/
int
TclLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
char *fileName, /* Name of the file containing the desired
* code. */
char *sym1, char *sym2, /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr)
/* Where to return the addresses corresponding
* to sym1 and sym2. */
{
CFragConnectionID connID;
Ptr dummy;
OSErr err;
CFragSymbolClass symClass;
FSSpec fileSpec;
short fragFileRef, saveFileRef;
Handle fragResource;
UInt32 offset = 0;
UInt32 length = kCFragGoesToEOF;
char packageName[255];
Str255 errName;
/*
* First thing we must do is infer the package name from the sym1
* variable. This is kind of dumb since the caller actually knows
* this value, it just doesn't give it to us.
*/
strcpy(packageName, sym1);
*packageName = (char) tolower(*packageName);
packageName[strlen(packageName) - 5] = NULL;
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if (err != noErr) {
interp->result = "could not locate shared library";
return TCL_ERROR;
}
/*
* See if this fragment has a 'cfrg' resource. It will tell us were
* to look for the fragment in the file. If it doesn't exist we will
* assume we have a ppc frag using the whole data fork. If it does
* exist we find the frag that matches the one we are looking for and
* get the offset and size from the resource.
*/
saveFileRef = CurResFile();
SetResLoad(false);
fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
UseResFile(fragFileRef);
fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
HLock(fragResource);
if (ResError() == noErr) {
CfrgItem* srcItem;
long itemCount, index;
Ptr itemStart;
itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
for (index = 0; index < itemCount;
index++, itemStart += srcItem->itemSize) {
srcItem = (CfrgItem*)itemStart;
if (srcItem->archType != OUR_ARCH_TYPE) continue;
if (!strncasecmp(packageName, (char *) srcItem->name + 1,
srcItem->name[0])) {
offset = srcItem->codeOffset;
length = srcItem->codeLength;
}
}
}
/*
* Close the resource file. If the extension wants to reopen the
* resource fork it should use the tclMacLibrary.c file during it's
* construction.
*/
HUnlock(fragResource);
ReleaseResource(fragResource);
CloseResFile(fragFileRef);
UseResFile(saveFileRef);
}
/*
* Now we can attempt to load the fragement using the offset & length
* obtained from the resource. We don't worry about the main entry point
* as we are going to search for specific entry points passed to us.
*/
c2pstr(packageName);
err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
kLoadCFrag, &connID, &dummy, errName);
if (err != fragNoErr) {
p2cstr(errName);
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", errName, (char *) NULL);
return TCL_ERROR;
}
c2pstr(sym1);
err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
p2cstr((StringPtr) sym1);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
interp->result =
"could not find Initialization routine in library";
return TCL_ERROR;
}
c2pstr(sym2);
err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
p2cstr((StringPtr) sym2);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
*proc2Ptr = NULL;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
* name, this procedure is invoked to try to figure it out.
*
* Results:
* Always returns 0 to indicate that we couldn't figure out a
* package name; generic code will then try to guess the package
* from the file name. A return value of 1 would have meant that
* we figured out the package name and put it in bufPtr.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclGuessPackageName(
char *fileName, /* Name of file containing package (already
* translated to local form if needed). */
Tcl_DString *bufPtr) /* Initialized empty dstring. Append
* package name to this if possible. */
{
return 0;
}
|
