tree checksum vpatch file split hunks
all signers:
antecedents: tinyscheme_genesis_fixed
press order:
| tinyscheme_genesis_fixed | |
| asciilifeform_tinyscheme_snip_crud_fixed |
patch:
(1 . 146)(0 . 0)
5 /* dynload.c Dynamic Loader for TinyScheme */
6 /* Original Copyright (c) 1999 Alexander Shendi */
7 /* Modifications for NT and dl_* interface, scm_load_ext: D. Souflis */
8 /* Refurbished by Stephen Gildea */
9
10 #define _SCHEME_SOURCE
11 #include "dynload.h"
12 #include <string.h>
13 #include <stdio.h>
14 #include <stdlib.h>
15
16 #ifndef MAXPATHLEN
17 # define MAXPATHLEN 1024
18 #endif
19
20 static void make_filename(const char *name, char *filename);
21 static void make_init_fn(const char *name, char *init_fn);
22
23 #ifdef _WIN32
24 # include <windows.h>
25 #else
26 typedef void *HMODULE;
27 typedef void (*FARPROC)();
28 #define SUN_DL
29 #include <dlfcn.h>
30 #endif
31
32 #ifdef _WIN32
33
34 #define PREFIX ""
35 #define SUFFIX ".dll"
36
37 static void display_w32_error_msg(const char *additional_message)
38 {
39 LPVOID msg_buf;
40
41 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
42 NULL, GetLastError(), 0,
43 (LPTSTR)&msg_buf, 0, NULL);
44 fprintf(stderr, "scheme load-extension: %s: %s", additional_message, msg_buf);
45 LocalFree(msg_buf);
46 }
47
48 static HMODULE dl_attach(const char *module) {
49 HMODULE dll = LoadLibrary(module);
50 if (!dll) display_w32_error_msg(module);
51 return dll;
52 }
53
54 static FARPROC dl_proc(HMODULE mo, const char *proc) {
55 FARPROC procedure = GetProcAddress(mo,proc);
56 if (!procedure) display_w32_error_msg(proc);
57 return procedure;
58 }
59
60 static void dl_detach(HMODULE mo) {
61 (void)FreeLibrary(mo);
62 }
63
64 #elif defined(SUN_DL)
65
66 #include <dlfcn.h>
67
68 #define PREFIX "lib"
69 #define SUFFIX ".so"
70
71 static HMODULE dl_attach(const char *module) {
72 HMODULE so=dlopen(module,RTLD_LAZY);
73 if(!so) {
74 fprintf(stderr, "Error loading scheme extension \"%s\": %s\n", module, dlerror());
75 }
76 return so;
77 }
78
79 static FARPROC dl_proc(HMODULE mo, const char *proc) {
80 const char *errmsg;
81 FARPROC fp=(FARPROC)dlsym(mo,proc);
82 if ((errmsg = dlerror()) == 0) {
83 return fp;
84 }
85 fprintf(stderr, "Error initializing scheme module \"%s\": %s\n", proc, errmsg);
86 return 0;
87 }
88
89 static void dl_detach(HMODULE mo) {
90 (void)dlclose(mo);
91 }
92 #endif
93
94 pointer scm_load_ext(scheme *sc, pointer args)
95 {
96 pointer first_arg;
97 pointer retval;
98 char filename[MAXPATHLEN], init_fn[MAXPATHLEN+6];
99 char *name;
100 HMODULE dll_handle;
101 void (*module_init)(scheme *sc);
102
103 if ((args != sc->NIL) && is_string((first_arg = pair_car(args)))) {
104 name = string_value(first_arg);
105 make_filename(name,filename);
106 make_init_fn(name,init_fn);
107 dll_handle = dl_attach(filename);
108 if (dll_handle == 0) {
109 retval = sc -> F;
110 }
111 else {
112 module_init = (void(*)(scheme *))dl_proc(dll_handle, init_fn);
113 if (module_init != 0) {
114 (*module_init)(sc);
115 retval = sc -> T;
116 }
117 else {
118 retval = sc->F;
119 }
120 }
121 }
122 else {
123 retval = sc -> F;
124 }
125
126 return(retval);
127 }
128
129 static void make_filename(const char *name, char *filename) {
130 strcpy(filename,name);
131 strcat(filename,SUFFIX);
132 }
133
134 static void make_init_fn(const char *name, char *init_fn) {
135 const char *p=strrchr(name,'/');
136 if(p==0) {
137 p=name;
138 } else {
139 p++;
140 }
141 strcpy(init_fn,"init_");
142 strcat(init_fn,p);
143 }
144
145
146 /*
147 Local variables:
148 c-file-style: "k&r"
149 End:
150 */
- 7EF337502C279674A3670DD8CB64C844879BBA7835EF9E9DA2A443B009CC33AAC9CA091A16CCDC8D2A82D2828085BA30AFDEB612FE5363E6D5F5FE970735AAB8(1 . 12)(0 . 0)
155 /* dynload.h */
156 /* Original Copyright (c) 1999 Alexander Shendi */
157 /* Modifications for NT and dl_* interface: D. Souflis */
158
159 #ifndef DYNLOAD_H
160 #define DYNLOAD_H
161
162 #include "scheme-private.h"
163
164 SCHEME_EXPORT pointer scm_load_ext(scheme *sc, pointer arglist);
165
166 #endif
- 4FDBB560FFAD230F967EA20050F505E86F9B0E4837E23EA4A4CF7191FB9A9BAF2063F7832B790ADB30EE408B510D4F4092F52325AD45A620A95ED2F6748E5DCD(1 . 98)(0 . 0)
171 # Makefile for TinyScheme
172 # Time-stamp: <2002-06-24 14:13:27 gildea>
173
174 # Windows/2000
175 #CC = cl -nologo
176 #DEBUG= -W3 -Z7 -MD
177 #DL_FLAGS=
178 #SYS_LIBS=
179 #Osuf=obj
180 #SOsuf=dll
181 #LIBsuf=.lib
182 #EXE_EXT=.exe
183 #LD = link -nologo
184 #LDFLAGS = -debug -map -dll -incremental:no
185 #LIBPREFIX =
186 #OUT = -out:$@
187 #RM= -del
188 #AR= echo
189
190 # Unix, generally
191 CC = gcc -fpic -pedantic
192 DEBUG=-g -Wall -Wno-char-subscripts -O
193 Osuf=o
194 SOsuf=so
195 LIBsuf=a
196 EXE_EXT=
197 LIBPREFIX=lib
198 OUT = -o $@
199 RM= -rm -f
200 AR= ar crs
201
202 # Linux
203 LD = gcc
204 LDFLAGS = -shared
205 DEBUG=-g -Wno-char-subscripts -O
206 SYS_LIBS= -ldl -lm
207 PLATFORM_FEATURES= -DSUN_DL=1
208
209 # Cygwin
210 #PLATFORM_FEATURES = -DUSE_STRLWR=0
211
212 # MinGW/MSYS
213 #SOsuf=dll
214 #PLATFORM_FEATURES = -DUSE_STRLWR=0
215
216 # Mac OS X
217 #LD = gcc
218 #LDFLAGS = --dynamiclib
219 #DEBUG=-g -Wno-char-subscripts -O
220 #SYS_LIBS= -ldl
221 #PLATFORM_FEATURES= -DUSE_STRLWR=1 -D__APPLE__=1 -DOSX=1
222
223
224 # Solaris
225 #SYS_LIBS= -ldl -lc
226 #Osuf=o
227 #SOsuf=so
228 #EXE_EXT=
229 #LD = ld
230 #LDFLAGS = -G -Bsymbolic -z text
231 #LIBPREFIX = lib
232 #OUT = -o $@
233
234 FEATURES = $(PLATFORM_FEATURES) -DUSE_DL=1 -DUSE_MATH=1 -DUSE_ASCII_NAMES=0
235
236 OBJS = scheme.$(Osuf) dynload.$(Osuf)
237
238 LIBTARGET = $(LIBPREFIX)tinyscheme.$(SOsuf)
239 STATICLIBTARGET = $(LIBPREFIX)tinyscheme.$(LIBsuf)
240
241 all: $(LIBTARGET) $(STATICLIBTARGET) scheme$(EXE_EXT)
242
243 %.$(Osuf): %.c
244 $(CC) -I. -c $(DEBUG) $(FEATURES) $(DL_FLAGS) $<
245
246 $(LIBTARGET): $(OBJS)
247 $(LD) $(LDFLAGS) $(OUT) $(OBJS) $(SYS_LIBS)
248
249 scheme$(EXE_EXT): $(OBJS)
250 $(CC) -o $@ $(DEBUG) $(OBJS) $(SYS_LIBS)
251
252 $(STATICLIBTARGET): $(OBJS)
253 $(AR) $@ $(OBJS)
254
255 $(OBJS): scheme.h scheme-private.h opdefines.h
256 dynload.$(Osuf): dynload.h
257
258 clean:
259 $(RM) $(OBJS) $(LIBTARGET) $(STATICLIBTARGET) scheme$(EXE_EXT)
260 $(RM) tinyscheme.ilk tinyscheme.map tinyscheme.pdb tinyscheme.exp
261 $(RM) scheme.ilk scheme.map scheme.pdb scheme.lib scheme.exp
262 $(RM) *~
263
264 TAGS_SRCS = scheme.h scheme.c dynload.h dynload.c
265
266 tags: TAGS
267 TAGS: $(TAGS_SRCS)
268 etags $(TAGS_SRCS)
- 5BE4B621D85F9CF8C659EBE622983AC737B8953C664C8B0EAE805155E90374AB63FF49D1731584E447A73AEB6A9DFA83B6F294E1330E8E8A16352BB1DD952345(20 . 9)(20 . 6)- 282012705842DD4C1341549F5E82BF092274697D51F5DD6B557E9F0D6E25AB16DEA0A1825C19329CE72A5F85511D25BCF636D015CB6926F381348EF9A372DC8C
273 #ifdef WIN32
274 #define snprintf _snprintf
275 #endif
276 #if USE_DL
277 # include "dynload.h"
278 #endif
279 #if USE_MATH
280 # include <math.h>
281 #endif
(4982 . 9)(4979 . 6)
283 }
284 scheme_set_input_port_file(&sc, stdin);
285 scheme_set_output_port_file(&sc, stdout);
286 #if USE_DL
287 scheme_define(&sc,sc.global_env,mk_symbol(&sc,"load-extension"),mk_foreign_func(&sc, scm_load_ext));
288 #endif
289 argv++;
290 if(access(file_name,0)!=0) {
291 char *p=getenv("TINYSCHEMEINIT");
(40 . 7)(40 . 6)
296 # define USE_ERROR_HOOK 0
297 # define USE_TRACING 0
298 # define USE_COLON_HOOK 0
299 # define USE_DL 0
300 # define USE_PLIST 0
301 #endif
302
(50 . 11)(49 . 6)
304 */
305 #define USE_SCHEME_STACK
306
307 #if USE_DL
308 # define USE_INTERFACE 1
309 #endif
310
311
312 #ifndef USE_MATH /* If math support is needed */
313 # define USE_MATH 1
314 #endif