| File: | os_dyn.c |
| Location: | line 511, column 3 |
| Description: | Value stored to 'i' is never read |
| 1 | /* File: "os_dyn.c" */ |
| 2 | |
| 3 | /* Copyright (c) 1994-2013 by Marc Feeley, All Rights Reserved. */ |
| 4 | |
| 5 | /* |
| 6 | * This module implements the operating system specific routines |
| 7 | * related to dynamic code (loading, C closures). |
| 8 | */ |
| 9 | |
| 10 | #define ___INCLUDED_FROM_OS_DYN |
| 11 | #define ___VERSION407000 407000 |
| 12 | #include "gambit.h" |
| 13 | |
| 14 | #include "os_base.h" |
| 15 | #include "os_dyn.h" |
| 16 | #include "os_shell.h" |
| 17 | |
| 18 | |
| 19 | /*---------------------------------------------------------------------------*/ |
| 20 | |
| 21 | |
| 22 | ___dyn_module ___dyn_mod = |
| 23 | { |
| 24 | 0 |
| 25 | |
| 26 | #ifdef ___DYN_MODULE_INIT, 0 |
| 27 | ___DYN_MODULE_INIT, 0 |
| 28 | #endif |
| 29 | }; |
| 30 | |
| 31 | |
| 32 | /*---------------------------------------------------------------------------*/ |
| 33 | |
| 34 | /* Dynamic code loading. */ |
| 35 | |
| 36 | |
| 37 | ___HIDDENstatic void setup_dynamic_load ___PVOID(void) |
| 38 | { |
| 39 | #ifdef ___DL_DESCRvoid * |
| 40 | |
| 41 | ___dyn_mod.dl_list = 0; |
| 42 | |
| 43 | #endif |
| 44 | } |
| 45 | |
| 46 | |
| 47 | ___HIDDENstatic ___SCMOBJlong dynamic_load_module |
| 48 | ___P((___STRING_TYPE(___DL_PATH_CE_SELECT) cpath,(char* cpath, char* cmodname, void **linker) |
| 49 | ___STRING_TYPE(___DL_MODNAME_CE_SELECT) cmodname,(char* cpath, char* cmodname, void **linker) |
| 50 | void **linker),(char* cpath, char* cmodname, void **linker) |
| 51 | (cpath,(char* cpath, char* cmodname, void **linker) |
| 52 | cmodname,(char* cpath, char* cmodname, void **linker) |
| 53 | linker)(char* cpath, char* cmodname, void **linker) |
| 54 | ___STRING_TYPE(___DL_PATH_CE_SELECT) cpath;(char* cpath, char* cmodname, void **linker) |
| 55 | ___STRING_TYPE(___DL_MODNAME_CE_SELECT) cmodname;(char* cpath, char* cmodname, void **linker) |
| 56 | void **linker;)(char* cpath, char* cmodname, void **linker) |
| 57 | { |
| 58 | ___SCMOBJlong e; |
| 59 | ___SCMOBJlong result = ___FIX(___UNIMPL_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+4)))<<2); |
| 60 | |
| 61 | #ifndef ___DL_DESCRvoid * |
| 62 | |
| 63 | result = ___FIX(___DYNAMIC_LOADING_NOT_AVAILABLE_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+11)))<<2); |
| 64 | |
| 65 | #else |
| 66 | |
| 67 | ___dl_entry *p; |
| 68 | |
| 69 | p = ___CAST(___dl_entry*,((___dl_entry*)(___alloc_mem (sizeof (___dl_entry)))) |
| 70 | ___alloc_mem (sizeof (___dl_entry)))((___dl_entry*)(___alloc_mem (sizeof (___dl_entry)))); |
| 71 | |
| 72 | if (p == 0) |
| 73 | return ___FIX(___HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+5)))<<2); |
| 74 | |
| 75 | #ifdef USE_shl_load |
| 76 | |
| 77 | p->descr = shl_load (cpath, BIND_IMMEDIATE, 0); |
| 78 | |
| 79 | if (p->descr == 0) |
| 80 | result = err_code_from_errno ()___err_code_from_errno(); |
| 81 | else if (!shl_findsym (&p->descr, cmodname, TYPE_PROCEDURE, linker) && |
| 82 | *linker != 0) |
| 83 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 84 | else |
| 85 | { |
| 86 | result = ___FIX(___DYNAMIC_LOADING_LOOKUP_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+12)))<<2); |
| 87 | shl_unload (p->descr); |
| 88 | } |
| 89 | |
| 90 | #endif |
| 91 | |
| 92 | #ifdef USE_LoadLibrary |
| 93 | |
| 94 | p->descr = LoadLibrary (cpath); |
| 95 | |
| 96 | if (p->descr != 0 && |
| 97 | (*linker = ___CAST(void*,GetProcAddress (p->descr, cmodname))((void*)(GetProcAddress (p->descr, cmodname)))) != 0) |
| 98 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 99 | else |
| 100 | { |
| 101 | result = err_code_from_GetLastError ()___err_code_from_GetLastError(); |
| 102 | |
| 103 | if (p->descr != 0) |
| 104 | FreeLibrary (p->descr); |
| 105 | } |
| 106 | |
| 107 | #endif |
| 108 | |
| 109 | #ifdef USE_DosLoadModule |
| 110 | |
| 111 | { |
| 112 | HMODULE hmodule; |
| 113 | APIRET rc; |
| 114 | char real_path[280]; |
| 115 | int i; |
| 116 | |
| 117 | e = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 118 | |
| 119 | i = 0; |
| 120 | while (cpath[i] != '\0') |
| 121 | i++; |
| 122 | |
| 123 | if (i <= 4 || |
| 124 | cpath[i-1] != 'l' && cpath[i-1] != 'L' || |
| 125 | cpath[i-2] != 'l' && cpath[i-2] != 'L' || |
| 126 | cpath[i-3] != 'd' && cpath[i-3] != 'D' || |
| 127 | cpath[i-4] != '.') |
| 128 | { |
| 129 | /* if path doesn't end in ".dll" we must find the real ".dll" path */ |
| 130 | |
| 131 | FILE *f = fopen (cpath, "r"); |
| 132 | |
| 133 | if (f == 0 || !fgets (real_path, 280, f)) |
| 134 | e = err_code_from_errno ()___err_code_from_errno(); |
| 135 | else |
| 136 | cpath = real_path; |
| 137 | |
| 138 | if (f != 0) |
| 139 | fclose (f); |
| 140 | } |
| 141 | |
| 142 | if (e != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 143 | result = e; |
| 144 | else |
| 145 | { |
| 146 | char *errmsg = 0; |
| 147 | char errbuf[256]; |
| 148 | |
| 149 | if (DosLoadModule (errbuf, 256, cpath, &hmodule) != NO_ERROR) |
| 150 | errmsg = errbuf; |
| 151 | else |
| 152 | { |
| 153 | p->descr = hmodule; |
| 154 | |
| 155 | rc = DosQueryProcAddr (hmodule, 0L, cmodname, linker); |
| 156 | |
| 157 | if (rc != NO_ERROR || *linker == 0) |
| 158 | { |
| 159 | switch (rc) |
| 160 | { |
| 161 | case ERROR_INVALID_HANDLE: |
| 162 | errmsg = "Invalid handle"; |
| 163 | break; |
| 164 | case ERROR_INVALID_NAME: |
| 165 | errmsg = "Invalid name"; |
| 166 | break; |
| 167 | case ERROR_INVALID_ORDINAL: |
| 168 | errmsg = "Invalid ordinal"; |
| 169 | break; |
| 170 | case ERROR_ENTRY_IS_CALLGATE: |
| 171 | errmsg = "Entry is callgate"; |
| 172 | break; |
| 173 | default: |
| 174 | errmsg = "Unknown error"; |
| 175 | break; |
| 176 | } |
| 177 | |
| 178 | DosFreeModule (hmodule); |
| 179 | } |
| 180 | } |
| 181 | |
| 182 | if (errmsg != 0) |
| 183 | { |
| 184 | if ((e = ___NONNULLCHARSTRING_to_SCMOBJ |
| 185 | (errmsg, |
| 186 | &result, |
| 187 | ___RETURN_POS127)) |
| 188 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 189 | result = e; |
| 190 | } |
| 191 | } |
| 192 | } |
| 193 | |
| 194 | #endif |
| 195 | |
| 196 | #ifdef USE_dxe_load |
| 197 | |
| 198 | p->descr = _dxe_load (cpath); |
| 199 | |
| 200 | if ((*linker = p->descr) != 0) |
| 201 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 202 | else |
| 203 | result = ___FIX(___DYNAMIC_LOADING_LOOKUP_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+12)))<<2); |
| 204 | |
| 205 | #endif |
| 206 | |
| 207 | #ifdef USE_GetDiskFragment |
| 208 | |
| 209 | { |
| 210 | OSErr err; |
| 211 | Ptr mainadr, procadr; |
| 212 | Str63 ppath; |
| 213 | Str255 pmodname; |
| 214 | Str255 pmsg; |
| 215 | char msg[256]; |
| 216 | FSSpec spec; |
| 217 | |
| 218 | if (!c2pascal (cpath, ppath, sizeof(ppath)-1)) |
| 219 | *errmsg = "Path is too long"; |
| 220 | else if (!c2pascal (cmodname, pmodname, sizeof(pmodname)-1)) |
| 221 | *errmsg = "Module name is too long"; |
| 222 | else if (make_ResolvedFSSpec (0, 0, ppath, &spec) != noErr) |
| 223 | *errmsg = "Invalid path"; |
| 224 | else |
| 225 | { |
| 226 | err = GetDiskFragment (&spec, 0, kCFragGoesToEOF, ppath, |
| 227 | kPrivateCFragCopy, &p->descr, &mainadr, pmsg); |
| 228 | if (err != noErr) |
| 229 | { |
| 230 | pascal2c (pmsg, msg, 255); |
| 231 | sprintf (dl_error_buffer, |
| 232 | "GetDiskFragment failed with error code %d on \"%s\"", |
| 233 | err, |
| 234 | msg); |
| 235 | *errmsg = dl_error_buffer; |
| 236 | } |
| 237 | else |
| 238 | { |
| 239 | if (FindSymbol (p->descr, pmodname, &procadr, kCodeCFragSymbol) |
| 240 | != noErr) |
| 241 | { |
| 242 | *errmsg = "FindSymbol failed"; |
| 243 | CloseConnection (&p->descr); |
| 244 | } |
| 245 | else |
| 246 | *linker = ___CAST(void*,procadr)((void*)(procadr)); |
| 247 | } |
| 248 | } |
| 249 | } |
| 250 | |
| 251 | #endif |
| 252 | |
| 253 | #ifdef USE_dlopen |
| 254 | |
| 255 | #ifdef RTLD_NOW0x00002 |
| 256 | p->descr = dlopen (cpath, RTLD_NOW0x00002); |
| 257 | #else |
| 258 | p->descr = dlopen (cpath, 1); |
| 259 | #endif |
| 260 | |
| 261 | if (p->descr != 0 && |
| 262 | (*linker = dlsym (p->descr, cmodname)) != 0) |
| 263 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 264 | else |
| 265 | { |
| 266 | if ((e = ___NONNULLCHARSTRING_to_SCMOBJ |
| 267 | (___CAST(char*,dlerror ())((char*)(dlerror ())), |
| 268 | &result, |
| 269 | ___RETURN_POS127)) |
| 270 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 271 | result = e; |
| 272 | |
| 273 | if (p->descr != 0) |
| 274 | dlclose (p->descr); |
| 275 | } |
| 276 | |
| 277 | #endif |
| 278 | |
| 279 | #ifdef USE_NSLinkModule |
| 280 | |
| 281 | { |
| 282 | NSSymbol sym; |
| 283 | |
| 284 | if (NSIsSymbolNameDefined (cmodname)) |
| 285 | { |
| 286 | sym = NSLookupAndBindSymbol (cmodname); |
| 287 | |
| 288 | if ((*linker = NSAddressOfSymbol (sym)) != 0) |
| 289 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 290 | else |
| 291 | result = ___FIX(___DYNAMIC_LOADING_LOOKUP_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+12)))<<2); |
| 292 | } |
| 293 | else |
| 294 | { |
| 295 | NSObjectFileImage img; |
| 296 | NSObjectFileImageReturnCode code; |
| 297 | |
| 298 | if ((code = NSCreateObjectFileImageFromFile (cpath, &img)) |
| 299 | == NSObjectFileImageSuccess) |
| 300 | { |
| 301 | p->descr = NSLinkModule (img, cpath, NSLINKMODULE_OPTION_BINDNOW); |
| 302 | |
| 303 | if (p->descr != 0 && |
| 304 | (sym = NSLookupSymbolInModule (p->descr, cmodname)) != 0 && |
| 305 | (*linker = NSAddressOfSymbol (sym)) != 0) |
| 306 | result = ___FIX(___NO_ERR)(((long)(0))<<2); |
| 307 | else |
| 308 | { |
| 309 | result = ___FIX(___DYNAMIC_LOADING_LOOKUP_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+12)))<<2); |
| 310 | |
| 311 | if (p->descr != 0) |
| 312 | NSUnLinkModule (p->descr, NSUNLINKMODULE_OPTION_NONE); |
| 313 | } |
| 314 | |
| 315 | NSDestroyObjectFileImage (img); |
| 316 | } |
| 317 | else |
| 318 | { |
| 319 | char *errmsg = 0; |
| 320 | |
| 321 | switch (code) |
| 322 | { |
| 323 | case NSObjectFileImageFailure: |
| 324 | errmsg = "(NSObjectFileImageFailure) The operation was not successfully completed"; |
| 325 | break; |
| 326 | |
| 327 | case NSObjectFileImageInappropriateFile: |
| 328 | errmsg = "(NSObjectFileImageInappropriateFile) The specified Mach-O file is not of a type this function can operate upon"; |
| 329 | break; |
| 330 | |
| 331 | case NSObjectFileImageArch: |
| 332 | errmsg = "(NSObjectFileImageArch) The specified Mach-O file is for a different CPU architecture"; |
| 333 | break; |
| 334 | |
| 335 | case NSObjectFileImageFormat: |
| 336 | errmsg = "(NSObjectFileImageFormat) The specified file does not appear to be a Mach-O file"; |
| 337 | break; |
| 338 | |
| 339 | case NSObjectFileImageAccess: |
| 340 | errmsg = "(NSObjectFileImageAccess) The access permissions for the specified file do not permit the creation of the image"; |
| 341 | break; |
| 342 | |
| 343 | default: |
| 344 | errmsg = "unknown error returned from NSCreateObjectFileImageFromFile"; |
| 345 | break; |
| 346 | } |
| 347 | |
| 348 | if (errmsg != 0) |
| 349 | { |
| 350 | if ((e = ___NONNULLCHARSTRING_to_SCMOBJ |
| 351 | (errmsg, |
| 352 | &result, |
| 353 | ___RETURN_POS127)) |
| 354 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 355 | result = e; |
| 356 | } |
| 357 | } |
| 358 | } |
| 359 | } |
| 360 | |
| 361 | #endif |
| 362 | |
| 363 | if (result != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 364 | ___free_mem (p); |
| 365 | else |
| 366 | { |
| 367 | p->next = ___dyn_mod.dl_list; |
| 368 | ___dyn_mod.dl_list = p; |
| 369 | } |
| 370 | |
| 371 | #endif |
| 372 | |
| 373 | if (result != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 374 | { |
| 375 | ___SCMOBJlong r = ___make_vector (2, ___FAL((((long)(-1))<<2)+2), ___STILL5); |
| 376 | |
| 377 | if (!___FIXNUMP(r)(((r)&((1<<2)-1))==(0))) |
| 378 | { |
| 379 | ___SCMOBJlong modname; |
| 380 | |
| 381 | if ((e = ___NONNULLSTRING_to_SCMOBJ |
| 382 | (cmodname, |
| 383 | &modname, |
| 384 | ___RETURN_POS127, |
| 385 | ___CE(___DL_MODNAME_CE_SELECT)(20<<0))) |
| 386 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 387 | ___release_scmobj (r); |
| 388 | else |
| 389 | { |
| 390 | ___VECTORSET(r,___FIX(0),result)*(long*)(((long)(((long*)((r)-(1)))+1))+(((((long)(0))<< 2))<<(3 -2)))=result; |
| 391 | ___VECTORSET(r,___FIX(1),modname)*(long*)(((long)(((long*)((r)-(1)))+1))+(((((long)(1))<< 2))<<(3 -2)))=modname; |
| 392 | ___release_scmobj (result); |
| 393 | ___release_scmobj (modname); |
| 394 | result = r; |
| 395 | } |
| 396 | } |
| 397 | } |
| 398 | |
| 399 | return result; |
| 400 | } |
| 401 | |
| 402 | |
| 403 | ___HIDDENstatic void cleanup_dynamic_load ___PVOID(void) |
| 404 | { |
| 405 | #ifndef ___DONT_UNLOAD_DYN_CODE |
| 406 | |
| 407 | /* |
| 408 | * When the --fprofile-arcs option of gcc is used, shared libraries |
| 409 | * must not be unloaded, otherwise a segmentation fault occurs on |
| 410 | * program exit (specifically when gcov_exit is called). |
| 411 | */ |
| 412 | |
| 413 | #ifdef ___DL_DESCRvoid * |
| 414 | |
| 415 | ___dl_entry *p = ___dyn_mod.dl_list; |
| 416 | while (p != 0) |
| 417 | { |
| 418 | ___dl_entry *next = p->next; |
| 419 | |
| 420 | #ifdef USE_shl_load |
| 421 | shl_unload (p->descr); |
| 422 | #endif |
| 423 | |
| 424 | #ifdef USE_LoadLibrary |
| 425 | FreeLibrary (p->descr); |
| 426 | #endif |
| 427 | |
| 428 | #ifdef USE_DosLoadModule |
| 429 | DosFreeModule (p->descr); |
| 430 | #endif |
| 431 | |
| 432 | #ifdef USE_dxe_load |
| 433 | #endif |
| 434 | |
| 435 | #ifdef USE_GetDiskFragment |
| 436 | CloseConnection (&p->descr); |
| 437 | #endif |
| 438 | |
| 439 | #ifdef USE_dlopen |
| 440 | dlclose (p->descr); |
| 441 | #endif |
| 442 | |
| 443 | #ifdef USE_NSLinkModule |
| 444 | NSUnLinkModule (p->descr, NSUNLINKMODULE_OPTION_NONE); |
| 445 | #endif |
| 446 | |
| 447 | ___free_mem (p); |
| 448 | p = next; |
| 449 | } |
| 450 | |
| 451 | ___dyn_mod.dl_list = 0; |
| 452 | |
| 453 | #endif |
| 454 | |
| 455 | #endif |
| 456 | } |
| 457 | |
| 458 | |
| 459 | ___HIDDENstatic char c_id_prefix[] = |
| 460 | #ifdef ___IMPORTED_ID_PREFIX |
| 461 | ___IMPORTED_ID_PREFIX |
| 462 | #endif |
| 463 | ___C_ID_PREFIX"___"; |
| 464 | |
| 465 | #define c_id_prefix_length(sizeof (c_id_prefix) - 1) (sizeof (c_id_prefix) - 1) |
| 466 | |
| 467 | ___HIDDENstatic char c_id_suffix[] = |
| 468 | #ifdef ___IMPORTED_ID_SUFFIX |
| 469 | ___IMPORTED_ID_SUFFIX |
| 470 | #endif |
| 471 | ""; |
| 472 | |
| 473 | #define c_id_suffix_length(sizeof (c_id_suffix) - 1) (sizeof (c_id_suffix) - 1) |
| 474 | |
| 475 | ___HIDDENstatic char hex_digits[] = "0123456789abcdef"; |
| 476 | |
| 477 | #define c_id_subsequent(c)(((c)>='A'&&(c)<='Z') || ((c)>='a'&& (c)<='z') || ((c)>='0'&&(c)<='9') || ((c)=='_' )) \ |
| 478 | (((c)>='A'&&(c)<='Z') || \ |
| 479 | ((c)>='a'&&(c)<='z') || \ |
| 480 | ((c)>='0'&&(c)<='9') || \ |
| 481 | ((c)=='_')) |
| 482 | |
| 483 | |
| 484 | ___HIDDENstatic ___SCMOBJlong ___SCMOBJ_to_MODNAMESTRING |
| 485 | ___P((___SCMOBJ obj,(long obj, void **x, int arg_num) |
| 486 | void **x,(long obj, void **x, int arg_num) |
| 487 | int arg_num),(long obj, void **x, int arg_num) |
| 488 | (obj,(long obj, void **x, int arg_num) |
| 489 | x,(long obj, void **x, int arg_num) |
| 490 | arg_num)(long obj, void **x, int arg_num) |
| 491 | ___SCMOBJ obj;(long obj, void **x, int arg_num) |
| 492 | void **x;(long obj, void **x, int arg_num) |
| 493 | int arg_num;)(long obj, void **x, int arg_num) |
| 494 | { |
| 495 | ___STRING_TYPE(___DL_MODNAME_CE_SELECT)char* r; |
| 496 | int len; |
| 497 | int i; |
| 498 | int j; |
| 499 | ___SCMOBJlong ___temp; /* used by ___STRINGP */ |
| 500 | |
| 501 | if (!___STRINGP(obj)((((___temp=(obj)))&((1<<2)-1))==1&&((((*(( long*)((___temp)-(1)))))&(((1<<5)-1)<<3))==(( (19))<<3)))) |
| 502 | return ___FIX(___DL_MODNAME_CE_SELECT(___STOC_NONNULLISO_8859_1STRING_ERR,(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 503 | ___STOC_NONNULLUTF_8STRING_ERR,(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 504 | ___STOC_NONNULLUCS_2STRING_ERR,(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 505 | ___STOC_NONNULLUCS_4STRING_ERR,(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 506 | ___STOC_NONNULLWCHARSTRING_ERR,(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 507 | ___STOC_NONNULLCHARSTRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2) |
| 508 | + arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(40<<7)) + arg_num))<<2); |
| 509 | |
| 510 | len = ___INT(___STRINGLENGTH(obj))(((((long)(((((unsigned long)((*((long*)((obj)-(1))))))>> (3 +5))>>2)))<<2))>>2); |
| 511 | i = len - 1; |
Value stored to 'i' is never read | |
| 512 | j = c_id_prefix_length(sizeof (c_id_prefix) - 1) + c_id_suffix_length(sizeof (c_id_suffix) - 1); |
| 513 | |
| 514 | for (i=len-1; i>=0; i--) |
| 515 | { |
| 516 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); |
| 517 | if (c == '_') |
| 518 | j += 2; |
| 519 | else if (c_id_subsequent(c)(((c)>='A'&&(c)<='Z') || ((c)>='a'&& (c)<='z') || ((c)>='0'&&(c)<='9') || ((c)=='_' ))) |
| 520 | j++; |
| 521 | else |
| 522 | { |
| 523 | j += 3; |
| 524 | while (c > 15) |
| 525 | { |
| 526 | c >>= 4; |
| 527 | j++; |
| 528 | } |
| 529 | } |
| 530 | } |
| 531 | |
| 532 | r = ___CAST(___STRING_TYPE(___DL_MODNAME_CE_SELECT),((char*)(___alloc_mem ((j+1) * sizeof (char)))) |
| 533 | ___alloc_mem ((j+1) *((char*)(___alloc_mem ((j+1) * sizeof (char)))) |
| 534 | sizeof (___CHAR_TYPE(___DL_MODNAME_CE_SELECT))))((char*)(___alloc_mem ((j+1) * sizeof (char)))); |
| 535 | |
| 536 | if (r == 0) |
| 537 | return ___FIX(___STOC_HEAP_OVERFLOW_ERR+arg_num)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(61<<7))+arg_num))<<2); |
| 538 | |
| 539 | r[j--] = '\0'; |
| 540 | |
| 541 | i = c_id_suffix_length(sizeof (c_id_suffix) - 1); |
| 542 | |
| 543 | while (i > 0) |
| 544 | r[j--] = c_id_suffix[--i]; |
| 545 | |
| 546 | for (i=len-1; i>=0; i--) |
| 547 | { |
| 548 | ___UCS_4unsigned int c = ___INT(___STRINGREF(obj,___FIX(i)))((((((long)(((unsigned int)(*(((unsigned int*)((((long*)((obj )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2); |
| 549 | if (c == '_') |
| 550 | { |
| 551 | r[j--] = '_'; |
| 552 | r[j--] = '_'; |
| 553 | } |
| 554 | else if (c_id_subsequent(c)(((c)>='A'&&(c)<='Z') || ((c)>='a'&& (c)<='z') || ((c)>='0'&&(c)<='9') || ((c)=='_' ))) |
| 555 | r[j--] = c; |
| 556 | else |
| 557 | { |
| 558 | r[j--] = '_'; |
| 559 | do |
| 560 | { |
| 561 | r[j--] = hex_digits[c & 15]; |
| 562 | c >>= 4; |
| 563 | } while (c != 0); |
| 564 | r[j--] = '_'; |
| 565 | } |
| 566 | } |
| 567 | |
| 568 | for (i=c_id_prefix_length(sizeof (c_id_prefix) - 1)-1; i>=0; i--) |
| 569 | r[j--] = c_id_prefix[i]; |
| 570 | |
| 571 | *x = r; |
| 572 | |
| 573 | return ___FIX(___NO_ERR)(((long)(0))<<2); |
| 574 | } |
| 575 | |
| 576 | |
| 577 | ___SCMOBJlong ___dynamic_load |
| 578 | ___P((___SCMOBJ path,(long path, long modname, void **linker) |
| 579 | ___SCMOBJ modname,(long path, long modname, void **linker) |
| 580 | void **linker),(long path, long modname, void **linker) |
| 581 | (path,(long path, long modname, void **linker) |
| 582 | modname,(long path, long modname, void **linker) |
| 583 | linker)(long path, long modname, void **linker) |
| 584 | ___SCMOBJ path;(long path, long modname, void **linker) |
| 585 | ___SCMOBJ modname;(long path, long modname, void **linker) |
| 586 | void **linker;)(long path, long modname, void **linker) |
| 587 | { |
| 588 | ___SCMOBJlong e; |
| 589 | ___SCMOBJlong result; |
| 590 | void *cpath; |
| 591 | void *cmodname; |
| 592 | |
| 593 | if ((e = ___SCMOBJ_to_NONNULLSTRING |
| 594 | (path, |
| 595 | &cpath, |
| 596 | 1, |
| 597 | ___CE(___DL_PATH_CE_SELECT)(20<<0), |
| 598 | 0)) |
| 599 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 600 | result = e; |
| 601 | else |
| 602 | { |
| 603 | if ((e = ___SCMOBJ_to_MODNAMESTRING |
| 604 | (modname, |
| 605 | &cmodname, |
| 606 | 2)) |
| 607 | != ___FIX(___NO_ERR)(((long)(0))<<2)) |
| 608 | result = e; |
| 609 | else |
| 610 | { |
| 611 | result = dynamic_load_module |
| 612 | (___CAST(___STRING_TYPE(___DL_PATH_CE_SELECT),cpath)((char*)(cpath)), |
| 613 | ___CAST(___STRING_TYPE(___DL_MODNAME_CE_SELECT),cmodname)((char*)(cmodname)), |
| 614 | linker); |
| 615 | |
| 616 | ___free_mem (cmodname); |
| 617 | } |
| 618 | |
| 619 | ___release_string (cpath); |
| 620 | } |
| 621 | |
| 622 | return result; |
| 623 | } |
| 624 | |
| 625 | |
| 626 | /*---------------------------------------------------------------------------*/ |
| 627 | |
| 628 | /* Allocation of C closures. */ |
| 629 | |
| 630 | |
| 631 | #ifdef USE_dynamic_code_gen |
| 632 | |
| 633 | #ifdef ___CPU_x86 |
| 634 | #if ___WORD_SIZE == 32 |
| 635 | #define C_CLOSURE_CODE_SIZE 16 |
| 636 | #endif |
| 637 | #endif |
| 638 | |
| 639 | #ifdef ___CPU_ppc |
| 640 | #if ___WORD_SIZE == 32 |
| 641 | #define C_CLOSURE_CODE_SIZE (9*4) |
| 642 | #endif |
| 643 | #ifndef __GNUC__4 |
| 644 | #undef C_CLOSURE_CODE_SIZE |
| 645 | #endif |
| 646 | #ifndef __GNUC__4 |
| 647 | #ifndef USE_CLASSIC_MACOS |
| 648 | #undef C_CLOSURE_CODE_SIZE |
| 649 | #endif |
| 650 | #endif |
| 651 | #endif |
| 652 | |
| 653 | #ifdef ___CPU_sparc |
| 654 | #if ___WORD_SIZE == 32 |
| 655 | #define C_CLOSURE_CODE_SIZE (7*4) |
| 656 | #else |
| 657 | #define C_CLOSURE_CODE_SIZE (19*4) |
| 658 | #endif |
| 659 | #ifndef __GNUC__4 |
| 660 | #undef C_CLOSURE_CODE_SIZE |
| 661 | #endif |
| 662 | #endif |
| 663 | |
| 664 | #endif |
| 665 | |
| 666 | |
| 667 | #ifdef C_CLOSURE_CODE_SIZE |
| 668 | |
| 669 | ___LOCALstatic void sync_icache_and_dcache (void *start, int length) |
| 670 | { |
| 671 | #ifdef ___CPU_x86 |
| 672 | |
| 673 | /* |
| 674 | * The x86 processor automatically keeps the icache and dcache in |
| 675 | * sync, as long as there's a jump instruction between the code |
| 676 | * modification and the use of the modified code. |
| 677 | */ |
| 678 | |
| 679 | #endif |
| 680 | |
| 681 | #ifdef ___CPU_ppc |
| 682 | |
| 683 | #ifdef __GNUC__4 |
| 684 | |
| 685 | #define CACHE_BLOCK_SIZE 4 /* we are conservative! */ |
| 686 | |
| 687 | ___U8unsigned char *s = ___CAST(___U8*,___CAST(___SIZE_TS,start) & -CACHE_BLOCK_SIZE)((unsigned char*)(((long)(start)) & -CACHE_BLOCK_SIZE)); |
| 688 | |
| 689 | do |
| 690 | { |
| 691 | __asm__ __volatile__ ("dcbf 0,%0" : : "r" (s) : "memory"); |
| 692 | __asm__ __volatile__ ("sync" : : : "memory"); |
| 693 | __asm__ __volatile__ ("icbi 0,%0" : : "r" (s) : "memory"); |
| 694 | s += CACHE_BLOCK_SIZE; |
| 695 | length -= CACHE_BLOCK_SIZE; |
| 696 | } while (length > 0); |
| 697 | |
| 698 | __asm__ __volatile__ ("sync" : : : "memory"); |
| 699 | __asm__ __volatile__ ("isync" : : : "memory"); |
| 700 | |
| 701 | #else |
| 702 | |
| 703 | #ifdef USE_CLASSIC_MACOS |
| 704 | |
| 705 | MakeDataExecutable (start, length); |
| 706 | |
| 707 | #endif |
| 708 | |
| 709 | #endif |
| 710 | |
| 711 | #ifdef ___CPU_sparc |
| 712 | |
| 713 | #ifdef __GNUC__4 |
| 714 | |
| 715 | #define MACHINE_WORD_SIZE 4 |
| 716 | |
| 717 | ___U8unsigned char *s = ___CAST(___U8*,___CAST(___SIZE_TS,start) & -MACHINE_WORD_SIZE)((unsigned char*)(((long)(start)) & -MACHINE_WORD_SIZE)); |
| 718 | |
| 719 | do |
| 720 | { |
| 721 | __asm__ __volatile__ ("flush %0" : : "g" (s) : "memory"); |
| 722 | s += MACHINE_WORD_SIZE; |
| 723 | length -= MACHINE_WORD_SIZE; |
| 724 | } while (length > 0); |
| 725 | |
| 726 | #endif |
| 727 | |
| 728 | #endif |
| 729 | |
| 730 | #endif |
| 731 | } |
| 732 | |
| 733 | #endif |
| 734 | |
| 735 | |
| 736 | ___LOCALstatic void *c_closure_self; /* set by the C closure trampoline code */ |
| 737 | |
| 738 | |
| 739 | void *___make_c_closure |
| 740 | ___P((___SCMOBJ proc,(long proc, void *converter) |
| 741 | void *converter),(long proc, void *converter) |
| 742 | (proc,(long proc, void *converter) |
| 743 | converter)(long proc, void *converter) |
| 744 | ___SCMOBJ proc;(long proc, void *converter) |
| 745 | void *converter;)(long proc, void *converter) |
| 746 | { |
| 747 | void *c_closure; |
| 748 | |
| 749 | #ifndef C_CLOSURE_CODE_SIZE |
| 750 | |
| 751 | c_closure = 0; |
| 752 | |
| 753 | #else |
| 754 | |
| 755 | if ((c_closure = ___alloc_rc (C_CLOSURE_CODE_SIZE)) == 0) |
| 756 | return 0; |
| 757 | |
| 758 | ___set_data_rc (c_closure, proc); |
| 759 | |
| 760 | /* Generate the trampoline code of the C closure. */ |
| 761 | |
| 762 | /* |
| 763 | * A "C closure" is a short piece of machine code that does the following: |
| 764 | * |
| 765 | * 1) stores its own address in the global variable "c_closure_self" |
| 766 | * 2) jumps to the "converter" function (which is a C function generated |
| 767 | * by the Gambit-C compiler's C-interface) |
| 768 | * |
| 769 | * The code must not change any processor register or stack location |
| 770 | * that is used in the C calling convention. In this way, the |
| 771 | * converter function will think that it received the parameters |
| 772 | * directly from the caller. The only side-effect of the C closure |
| 773 | * code is that the global variable "c_closure_self" will point to |
| 774 | * the C closure, allowing the converter function to access other |
| 775 | * data stored with the C closure (namely a reference to the Scheme |
| 776 | * procedure that the converter function needs to call). |
| 777 | * |
| 778 | * After generating the trampoline code of the C closure, it is |
| 779 | * important to synchronize the instruction and data caches so that |
| 780 | * the processor does not execute stale instructions in the instruction |
| 781 | * cache. |
| 782 | */ |
| 783 | |
| 784 | #ifdef ___CPU_x86 |
| 785 | |
| 786 | { |
| 787 | ___U8unsigned char *p = ___CAST(___U8*,c_closure)((unsigned char*)(c_closure)); |
| 788 | |
| 789 | /* x86 machine code */ |
| 790 | |
| 791 | p[ 0] = 0x68; /* pushl $p */ |
| 792 | p[ 1] = ___CAST_U8(___CAST_U32(p))(unsigned char)(((unsigned int)(p))); |
| 793 | p[ 2] = ___CAST_U8(___CAST_U32(p)>>8)(unsigned char)(((unsigned int)(p))>>8); |
| 794 | p[ 3] = ___CAST_U8(___CAST_U32(p)>>16)(unsigned char)(((unsigned int)(p))>>16); |
| 795 | p[ 4] = ___CAST_U8(___CAST_U32(p)>>24)(unsigned char)(((unsigned int)(p))>>24); |
| 796 | p[ 5] = 0x8f; /* popl c_closure_self */ |
| 797 | p[ 6] = 0x05; |
| 798 | p[ 7] = ___CAST_U8(___CAST_U32(&c_closure_self))(unsigned char)(((unsigned int)(&c_closure_self))); |
| 799 | p[ 8] = ___CAST_U8(___CAST_U32(&c_closure_self)>>8)(unsigned char)(((unsigned int)(&c_closure_self))>> 8); |
| 800 | p[ 9] = ___CAST_U8(___CAST_U32(&c_closure_self)>>16)(unsigned char)(((unsigned int)(&c_closure_self))>> 16); |
| 801 | p[10] = ___CAST_U8(___CAST_U32(&c_closure_self)>>24)(unsigned char)(((unsigned int)(&c_closure_self))>> 24); |
| 802 | p[11] = 0xe9; /* jmp converter */ |
| 803 | p[12] = ___CAST_U8(___CAST_U32(___CAST(___U8*,converter)-(p+16)))(unsigned char)(((unsigned int)(((unsigned char*)(converter)) -(p+16)))); |
| 804 | p[13] = ___CAST_U8(___CAST_U32(___CAST(___U8*,converter)-(p+16))>>8)(unsigned char)(((unsigned int)(((unsigned char*)(converter)) -(p+16)))>>8); |
| 805 | p[14] = ___CAST_U8(___CAST_U32(___CAST(___U8*,converter)-(p+16))>>16)(unsigned char)(((unsigned int)(((unsigned char*)(converter)) -(p+16)))>>16); |
| 806 | p[15] = ___CAST_U8(___CAST_U32(___CAST(___U8*,converter)-(p+16))>>24)(unsigned char)(((unsigned int)(((unsigned char*)(converter)) -(p+16)))>>24); |
| 807 | } |
| 808 | |
| 809 | #endif |
| 810 | |
| 811 | #ifdef ___CPU_ppc |
| 812 | |
| 813 | { |
| 814 | ___U32unsigned int *p = ___CAST(___U32*,c_closure)((unsigned int*)(c_closure)); |
| 815 | |
| 816 | /* PowerPC machine code */ |
| 817 | |
| 818 | p[0] = 0x39600000 /* li r11,LO16(converter) */ |
| 819 | + ___CAST_U32(___CAST_U16(___CAST_U32(converter)))((unsigned int)(((unsigned short)(((unsigned int)(converter)) )))); |
| 820 | p[1] = 0x3d6b0000 /* addis r11,r11,HI16(converter) */ |
| 821 | + (___CAST_U32(converter)((unsigned int)(converter)) >> 16) |
| 822 | + ((___CAST_U32(converter)((unsigned int)(converter)) & 0x8000) ? 1 : 0); |
| 823 | p[2] = 0x7d6903a6; /* mtspr ctr,r11 */ |
| 824 | p[3] = 0x39600000 /* li r11,LO16(p) */ |
| 825 | + ___CAST_U32(___CAST_U16(___CAST_U32(p)))((unsigned int)(((unsigned short)(((unsigned int)(p)))))); |
| 826 | p[4] = 0x3d6b0000 /* addis r11,r11,HI16(p) */ |
| 827 | + (___CAST_U32(p)((unsigned int)(p)) >> 16) |
| 828 | + ((___CAST_U32(p)((unsigned int)(p)) & 0x8000) ? 1 : 0); |
| 829 | p[5] = 0x380b0000; /* addi r0,r11,0 */ |
| 830 | p[6] = 0x3d600000 /* lis r11,HI16(c_closure_self) */ |
| 831 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) >> 16) |
| 832 | + ((___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) & 0x8000) ? 1 : 0); |
| 833 | p[7] = 0x900b0000 /* stw r0,LO16(c_closure_self)(r11) */ |
| 834 | + ___CAST_U32(___CAST_U16(___CAST_U32(&c_closure_self)))((unsigned int)(((unsigned short)(((unsigned int)(&c_closure_self )))))); |
| 835 | p[8] = 0x4e800420; /* bctr */ |
| 836 | } |
| 837 | |
| 838 | #endif |
| 839 | |
| 840 | #ifdef ___CPU_sparc |
| 841 | |
| 842 | { |
| 843 | ___U32unsigned int *p = ___CAST(___U32*,c_closure)((unsigned int*)(c_closure)); |
| 844 | |
| 845 | /* SPARC machine code */ |
| 846 | |
| 847 | #if ___WORD_WIDTH64 == 32 |
| 848 | |
| 849 | p[0] = 0x07000000 /* sethi HI22(p),%g3 */ |
| 850 | + (___CAST_U32(p)((unsigned int)(p)) >> 10); |
| 851 | p[1] = 0x8610E000 /* or %g3,LO10(p),%g3 */ |
| 852 | + (___CAST_U32(p)((unsigned int)(p)) & 0x3ff); |
| 853 | p[2] = 0x05000000 /* sethi HI22(c_closure_self),%g2 */ |
| 854 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) >> 10); |
| 855 | p[3] = 0xC620A000 /* st %g3,[%g2+LO10(c_closure_self)] */ |
| 856 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) & 0x3ff); |
| 857 | p[4] = 0x05000000 /* sethi HI22(converter),%g2 */ |
| 858 | + (___CAST_U32(converter)((unsigned int)(converter)) >> 10); |
| 859 | p[5] = 0x81C0A000 /* jmp %g2+LO10(converter) */ |
| 860 | + (___CAST_U32(converter)((unsigned int)(converter)) & 0x3ff); |
| 861 | p[6] = 0x01000000; /* nop */ |
| 862 | |
| 863 | #else |
| 864 | |
| 865 | p[ 0] = 0x07000000 /* sethi HHI22(p),%g3 */ |
| 866 | + (___CAST_U64(p)((unsigned long)(p)) >> (10+32)); |
| 867 | p[ 1] = 0x8610E000 /* or %g3,HLO10(p),%g3 */ |
| 868 | + ((___CAST_U64(p)((unsigned long)(p)) >> 32) & 0x3ff); |
| 869 | p[ 2] = 0x8728F020; /* sllx %g3,32,%g3 */ |
| 870 | p[ 3] = 0x03000000 /* sethi LHI22(p),%g1 */ |
| 871 | + ((___CAST_U64(p)((unsigned long)(p)) >> 10) & 0x3fffff); |
| 872 | p[ 4] = 0x82106000 /* or %g1,LLO10(p),%g1 */ |
| 873 | + (___CAST_U64(p)((unsigned long)(p)) & 0x3ff); |
| 874 | p[ 5] = 0x8600C001; /* add %g3,%g1,%g3 */ |
| 875 | p[ 6] = 0x05000000 /* sethi HHI22(c_closure_self),%g2 */ |
| 876 | + (___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> (10+32)); |
| 877 | p[ 7] = 0x8410A000 /* or %g2,HLO10(c_closure_self),%g2 */ |
| 878 | + ((___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> 32) & 0x3ff); |
| 879 | p[ 8] = 0x8528B020; /* sllx %g2,32,%g2 */ |
| 880 | p[ 9] = 0x03000000 /* sethi LHI22(c_closure_self),%g1 */ |
| 881 | + ((___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> 10) & 0x3fffff); |
| 882 | p[10] = 0x84008001; /* add %g2,%g1,%g2 */ |
| 883 | p[11] = 0xC670A000 /* stx %g3,[%g2+LLO10(c_closure_self)]*/ |
| 884 | + (___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) & 0x3ff); |
| 885 | p[12] = 0x05000000 /* sethi HHI22(converter),%g2 */ |
| 886 | + (___CAST_U64(converter)((unsigned long)(converter)) >> (10+32)); |
| 887 | p[13] = 0x8410A000 /* or %g2,HLO10(converter),%g2 */ |
| 888 | + ((___CAST_U64(converter)((unsigned long)(converter)) >> 32) & 0x3ff); |
| 889 | p[14] = 0x8528B020; /* sllx %g2,32,%g2 */ |
| 890 | p[15] = 0x03000000 /* sethi LHI22(converter),%g1 */ |
| 891 | + ((___CAST_U64(converter)((unsigned long)(converter)) >> 10) & 0x3fffff); |
| 892 | p[16] = 0x84008001; /* add %g2,%g1,%g2 */ |
| 893 | p[17] = 0x81C0A000 /* jmp %g2+LLO10(converter) */ |
| 894 | + (___CAST_U64(converter)((unsigned long)(converter)) & 0x3ff); |
| 895 | p[18] = 0x01000000; /* nop */ |
| 896 | |
| 897 | #endif |
| 898 | } |
| 899 | |
| 900 | #endif |
| 901 | |
| 902 | sync_icache_and_dcache (c_closure, C_CLOSURE_CODE_SIZE); |
| 903 | |
| 904 | #endif |
| 905 | |
| 906 | return c_closure; |
| 907 | } |
| 908 | |
| 909 | |
| 910 | ___BOOLint ___is_a_c_closure |
| 911 | ___P((void *fn),(void *fn) |
| 912 | (fn)(void *fn) |
| 913 | void *fn;)(void *fn) |
| 914 | { |
| 915 | #ifndef C_CLOSURE_CODE_SIZE |
| 916 | |
| 917 | return 0; |
| 918 | |
| 919 | #else |
| 920 | |
| 921 | /* |
| 922 | * We check that the function's code contains the same sequence that |
| 923 | * is generated by ___make_c_closure. If there is a match, we are |
| 924 | * sure that the function was generated by ___make_c_closure because |
| 925 | * it is impossible for the C compiler to have generated this code |
| 926 | * for a valid C function. |
| 927 | */ |
| 928 | |
| 929 | #ifdef ___CPU_x86 |
| 930 | |
| 931 | { |
| 932 | ___U8unsigned char *p = ___CAST(___U8*,fn)((unsigned char*)(fn)); |
| 933 | |
| 934 | return p != 0 && |
| 935 | p[ 0] == 0x68 && |
| 936 | p[ 1] == ___CAST_U8(___CAST_U32(p))(unsigned char)(((unsigned int)(p))) && |
| 937 | p[ 2] == ___CAST_U8(___CAST_U32(p)>>8)(unsigned char)(((unsigned int)(p))>>8) && |
| 938 | p[ 3] == ___CAST_U8(___CAST_U32(p)>>16)(unsigned char)(((unsigned int)(p))>>16) && |
| 939 | p[ 4] == ___CAST_U8(___CAST_U32(p)>>24)(unsigned char)(((unsigned int)(p))>>24) && |
| 940 | p[ 5] == 0x8f && |
| 941 | p[ 6] == 0x05 && |
| 942 | p[ 7] == ___CAST_U8(___CAST_U32(&c_closure_self))(unsigned char)(((unsigned int)(&c_closure_self))) && |
| 943 | p[ 8] == ___CAST_U8(___CAST_U32(&c_closure_self)>>8)(unsigned char)(((unsigned int)(&c_closure_self))>> 8) && |
| 944 | p[ 9] == ___CAST_U8(___CAST_U32(&c_closure_self)>>16)(unsigned char)(((unsigned int)(&c_closure_self))>> 16) && |
| 945 | p[10] == ___CAST_U8(___CAST_U32(&c_closure_self)>>24)(unsigned char)(((unsigned int)(&c_closure_self))>> 24) && |
| 946 | p[12] == 0xe9; |
| 947 | } |
| 948 | |
| 949 | #endif |
| 950 | |
| 951 | #ifdef ___CPU_ppc |
| 952 | |
| 953 | { |
| 954 | ___U32unsigned int *p = ___CAST(___U32*,fn)((unsigned int*)(fn)); |
| 955 | |
| 956 | return p != 0 && |
| 957 | (p[0] >> 16) == 0x3d6b && |
| 958 | p[1] == 0x7d6903a6 && |
| 959 | (p[2] >> 16) == 0x3960 && |
| 960 | p[3] == 0x39600000 |
| 961 | + ___CAST_U32(___CAST_U16(___CAST_U32(p)))((unsigned int)(((unsigned short)(((unsigned int)(p)))))) && |
| 962 | p[4] == 0x3d6b0000 |
| 963 | + (___CAST_U32(p)((unsigned int)(p)) >> 16) |
| 964 | + ((___CAST_U32(p)((unsigned int)(p)) & 0x8000) ? 1 : 0) && |
| 965 | p[5] == 0x380b0000 && |
| 966 | p[6] == 0x3d600000 |
| 967 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) >> 16) |
| 968 | + ((___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) & 0x8000) ? 1 : 0) && |
| 969 | p[7] == 0x900b0000 |
| 970 | + ___CAST_U32(___CAST_U16(___CAST_U32(&c_closure_self)))((unsigned int)(((unsigned short)(((unsigned int)(&c_closure_self )))))) && |
| 971 | p[8] == 0x4e800420; |
| 972 | } |
| 973 | |
| 974 | #endif |
| 975 | |
| 976 | #ifdef ___CPU_sparc |
| 977 | |
| 978 | { |
| 979 | ___U32unsigned int *p = ___CAST(___U32*,fn)((unsigned int*)(fn)); |
| 980 | |
| 981 | #if ___WORD_WIDTH64 == 32 |
| 982 | |
| 983 | return p != 0 && |
| 984 | p[0] == 0x07000000 |
| 985 | + (___CAST_U32(p)((unsigned int)(p)) >> 10) && |
| 986 | p[1] == 0x8610E000 |
| 987 | + (___CAST_U32(p)((unsigned int)(p)) & 0x3ff) && |
| 988 | p[2] == 0x05000000 |
| 989 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) >> 10) && |
| 990 | p[3] == 0xC620A000 |
| 991 | + (___CAST_U32(&c_closure_self)((unsigned int)(&c_closure_self)) & 0x3ff) && |
| 992 | (p[4] >> 22) == (0x05000000 >> 22) && |
| 993 | (p[5] >> 10) == (0x81C0A000 >> 10) && |
| 994 | p[6] == 0x01000000; |
| 995 | |
| 996 | #else |
| 997 | |
| 998 | return p != 0 && |
| 999 | p[ 0] == 0x07000000 |
| 1000 | + (___CAST_U64(p)((unsigned long)(p)) >> (10+32)) && |
| 1001 | p[ 1] == 0x8610E000 |
| 1002 | + ((___CAST_U64(p)((unsigned long)(p)) >> 32) & 0x3ff) && |
| 1003 | p[ 2] == 0x8728F020 && |
| 1004 | p[ 3] == 0x03000000 |
| 1005 | + ((___CAST_U64(p)((unsigned long)(p)) >> 10) & 0x3fffff) && |
| 1006 | p[ 4] == 0x82106000 |
| 1007 | + (___CAST_U64(p)((unsigned long)(p)) & 0x3ff) && |
| 1008 | p[ 5] == 0x8600C001 && |
| 1009 | p[ 6] == 0x05000000 |
| 1010 | + (___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> (10+32)) && |
| 1011 | p[ 7] == 0x8410A000 |
| 1012 | + ((___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> 32) & 0x3ff) && |
| 1013 | p[ 8] == 0x8528B020 && |
| 1014 | p[ 9] == 0x03000000 |
| 1015 | + ((___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) >> 10) & 0x3fffff) && |
| 1016 | p[10] == 0x84008001 && |
| 1017 | p[11] == 0xC670A000 |
| 1018 | + (___CAST_U64(&c_closure_self)((unsigned long)(&c_closure_self)) & 0x3ff) && |
| 1019 | (p[12] >> 22) == (0x05000000 >> 22) && |
| 1020 | (p[13] >> 10) == (0x8410A000 >> 10) && |
| 1021 | p[14] == 0x8528B020 && |
| 1022 | (p[15] >> 22) == (0x03000000 >> 22) && |
| 1023 | p[16] == 0x84008001 && |
| 1024 | (p[17] >> 10) == (0x81C0A000 >> 10) && |
| 1025 | p[18] == 0x01000000; |
| 1026 | |
| 1027 | #endif |
| 1028 | } |
| 1029 | |
| 1030 | #endif |
| 1031 | |
| 1032 | #endif |
| 1033 | } |
| 1034 | |
| 1035 | |
| 1036 | void ___c_closure_release |
| 1037 | ___P((void *c_closure),(void *c_closure) |
| 1038 | (c_closure)(void *c_closure) |
| 1039 | void *c_closure;)(void *c_closure) |
| 1040 | { |
| 1041 | ___release_rc (c_closure); |
| 1042 | } |
| 1043 | |
| 1044 | |
| 1045 | void *___c_closure_self ___PVOID(void) |
| 1046 | { |
| 1047 | return c_closure_self; |
| 1048 | } |
| 1049 | |
| 1050 | |
| 1051 | /*---------------------------------------------------------------------------*/ |
| 1052 | |
| 1053 | /* Dynamic code module initialization/finalization. */ |
| 1054 | |
| 1055 | |
| 1056 | ___SCMOBJlong ___setup_dyn_module ___PVOID(void) |
| 1057 | { |
| 1058 | if (!___dyn_mod.setup) |
| 1059 | { |
| 1060 | setup_dynamic_load (); |
| 1061 | ___dyn_mod.setup = 1; |
| 1062 | return ___FIX(___NO_ERR)(((long)(0))<<2); |
| 1063 | } |
| 1064 | |
| 1065 | return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2); |
| 1066 | } |
| 1067 | |
| 1068 | |
| 1069 | void ___cleanup_dyn_module ___PVOID(void) |
| 1070 | { |
| 1071 | if (___dyn_mod.setup) |
| 1072 | { |
| 1073 | cleanup_dynamic_load (); |
| 1074 | ___dyn_mod.setup = 0; |
| 1075 | } |
| 1076 | } |
| 1077 | |
| 1078 | |
| 1079 | /*---------------------------------------------------------------------------*/ |