win32/perllib.c

   1 /*
   2  * "The Road goes ever on and on, down from the door where it began."
   3  */
   4
   5
   6 #include "EXTERN.h"
   7 #include "perl.h"
   8
   9 #ifdef PERL_OBJECT
  10 #define NO_XSLOCKS
  11 #endif
  12
  13 #include "XSUB.h"
  14
  15 #ifdef PERL_OBJECT
  16 #include "win32iop.h"
  17 #include <fcntl.h>
  18 #endif
  19
  20
  21 /* Register any extra external extensions */
  22 char *staticlinkmodules[] = {
  23     "DynaLoader",
  24     NULL,
  25 };
  26
  27 EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv);
  28
  29 static void
  30 xs_init(pTHXo)
  31 {
  32     char *file = __FILE__;
  33     dXSUB_SYS;
  34     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  35 }
  36
  37 #ifdef PERL_OBJECT
  38 // IPerlMem
  39 void*
  40 PerlMemMalloc(struct IPerlMem*, size_t size)
  41 {
  42     return win32_malloc(size);
  43 }
  44 void*
  45 PerlMemRealloc(struct IPerlMem*, void* ptr, size_t size)
  46 {
  47     return win32_realloc(ptr, size);
  48 }
  49 void
  50 PerlMemFree(struct IPerlMem*, void* ptr)
  51 {
  52     win32_free(ptr);
  53 }
  54
  55 struct IPerlMem perlMem =
  56 {
  57     PerlMemMalloc,
  58     PerlMemRealloc,
  59     PerlMemFree,
  60 };
  61
  62
  63 // IPerlEnv
  64 extern char *           g_win32_get_privlib(char *pl);
  65 extern char *           g_win32_get_sitelib(char *pl);
  66
  67
  68 char*
  69 PerlEnvGetenv(struct IPerlEnv*, const char *varname)
  70 {
  71     return win32_getenv(varname);
  72 };
  73 int
  74 PerlEnvPutenv(struct IPerlEnv*, const char *envstring)
  75 {
  76     return win32_putenv(envstring);
  77 };
  78
  79 char*
  80 PerlEnvGetenv_len(struct IPerlEnv*, const char* varname, unsigned long* len)
  81 {
  82     char *e = win32_getenv(varname);
  83     if (e)
  84         *len = strlen(e);
  85     return e;
  86 }
  87
  88 int
  89 PerlEnvUname(struct IPerlEnv*, struct utsname *name)
  90 {
  91     return win32_uname(name);
  92 }
  93
  94 void
  95 PerlEnvClearenv(struct IPerlEnv*)
  96 {
  97     dTHXo;
  98     char *envv = GetEnvironmentStrings();
  99     char *cur = envv;
 100     STRLEN len;
 101     while (*cur) {
 102         char *end = strchr(cur,'=');
 103         if (end && end != cur) {
 104             *end = '\0';
 105             my_setenv(cur,Nullch);
 106             *end = '=';
 107             cur = end + strlen(end+1)+2;
 108         }
 109         else if ((len = strlen(cur)))
 110             cur += len+1;
 111     }
 112     FreeEnvironmentStrings(envv);
 113 }
 114
 115 void*
 116 PerlEnvGetChildEnv(struct IPerlEnv*)
 117 {
 118     return NULL;
 119 }
 120
 121 void
 122 PerlEnvFreeChildEnv(struct IPerlEnv*, void* env)
 123 {
 124 }
 125
 126 char*
 127 PerlEnvGetChildDir(struct IPerlEnv*)
 128 {
 129     return NULL;
 130 }
 131
 132 void
 133 PerlEnvFreeChildDir(struct IPerlEnv*, char* dir)
 134 {
 135 }
 136
 137 unsigned long
 138 PerlEnvOsId(struct IPerlEnv*)
 139 {
 140     return win32_os_id();
 141 }
 142
 143 char*
 144 PerlEnvLibPath(struct IPerlEnv*, char *pl)
 145 {
 146     return g_win32_get_privlib(pl);
 147 }
 148
 149 char*
 150 PerlEnvSiteLibPath(struct IPerlEnv*, char *pl)
 151 {
 152     return g_win32_get_sitelib(pl);
 153 }
 154
 155 struct IPerlEnv perlEnv =
 156 {
 157     PerlEnvGetenv,
 158     PerlEnvPutenv,
 159     PerlEnvGetenv_len,
 160     PerlEnvUname,
 161     PerlEnvClearenv,
 162     PerlEnvGetChildEnv,
 163     PerlEnvFreeChildEnv,
 164     PerlEnvGetChildDir,
 165     PerlEnvFreeChildDir,
 166     PerlEnvOsId,
 167     PerlEnvLibPath,
 168     PerlEnvSiteLibPath,
 169 };
 170
 171
 172 // PerlStdIO
 173 PerlIO*
 174 PerlStdIOStdin(struct IPerlStdIO*)
 175 {
 176     return (PerlIO*)win32_stdin();
 177 }
 178
 179 PerlIO*
 180 PerlStdIOStdout(struct IPerlStdIO*)
 181 {
 182     return (PerlIO*)win32_stdout();
 183 }
 184
 185 PerlIO*
 186 PerlStdIOStderr(struct IPerlStdIO*)
 187 {
 188     return (PerlIO*)win32_stderr();
 189 }
 190
 191 PerlIO*
 192 PerlStdIOOpen(struct IPerlStdIO*, const char *path, const char *mode)
 193 {
 194     return (PerlIO*)win32_fopen(path, mode);
 195 }
 196
 197 int
 198 PerlStdIOClose(struct IPerlStdIO*, PerlIO* pf)
 199 {
 200     return win32_fclose(((FILE*)pf));
 201 }
 202
 203 int
 204 PerlStdIOEof(struct IPerlStdIO*, PerlIO* pf)
 205 {
 206     return win32_feof((FILE*)pf);
 207 }
 208
 209 int
 210 PerlStdIOError(struct IPerlStdIO*, PerlIO* pf)
 211 {
 212     return win32_ferror((FILE*)pf);
 213 }
 214
 215 void
 216 PerlStdIOClearerr(struct IPerlStdIO*, PerlIO* pf)
 217 {
 218     win32_clearerr((FILE*)pf);
 219 }
 220
 221 int
 222 PerlStdIOGetc(struct IPerlStdIO*, PerlIO* pf)
 223 {
 224     return win32_getc((FILE*)pf);
 225 }
 226
 227 char*
 228 PerlStdIOGetBase(struct IPerlStdIO*, PerlIO* pf)
 229 {
 230 #ifdef FILE_base
 231     FILE *f = (FILE*)pf;
 232     return FILE_base(f);
 233 #else
 234     return Nullch;
 235 #endif
 236 }
 237
 238 int
 239 PerlStdIOGetBufsiz(struct IPerlStdIO*, PerlIO* pf)
 240 {
 241 #ifdef FILE_bufsiz
 242     FILE *f = (FILE*)pf;
 243     return FILE_bufsiz(f);
 244 #else
 245     return (-1);
 246 #endif
 247 }
 248
 249 int
 250 PerlStdIOGetCnt(struct IPerlStdIO*, PerlIO* pf)
 251 {
 252 #ifdef USE_STDIO_PTR
 253     FILE *f = (FILE*)pf;
 254     return FILE_cnt(f);
 255 #else
 256     return (-1);
 257 #endif
 258 }
 259
 260 char*
 261 PerlStdIOGetPtr(struct IPerlStdIO*, PerlIO* pf)
 262 {
 263 #ifdef USE_STDIO_PTR
 264     FILE *f = (FILE*)pf;
 265     return FILE_ptr(f);
 266 #else
 267     return Nullch;
 268 #endif
 269 }
 270
 271 char*
 272 PerlStdIOGets(struct IPerlStdIO*, PerlIO* pf, char* s, int n)
 273 {
 274     return win32_fgets(s, n, (FILE*)pf);
 275 }
 276
 277 int
 278 PerlStdIOPutc(struct IPerlStdIO*, PerlIO* pf, int c)
 279 {
 280     return win32_fputc(c, (FILE*)pf);
 281 }
 282
 283 int
 284 PerlStdIOPuts(struct IPerlStdIO*, PerlIO* pf, const char *s)
 285 {
 286     return win32_fputs(s, (FILE*)pf);
 287 }
 288
 289 int
 290 PerlStdIOFlush(struct IPerlStdIO*, PerlIO* pf)
 291 {
 292     return win32_fflush((FILE*)pf);
 293 }
 294
 295 int
 296 PerlStdIOUngetc(struct IPerlStdIO*, PerlIO* pf,int c)
 297 {
 298     return win32_ungetc(c, (FILE*)pf);
 299 }
 300
 301 int
 302 PerlStdIOFileno(struct IPerlStdIO*, PerlIO* pf)
 303 {
 304     return win32_fileno((FILE*)pf);
 305 }
 306
 307 PerlIO*
 308 PerlStdIOFdopen(struct IPerlStdIO*, int fd, const char *mode)
 309 {
 310     return (PerlIO*)win32_fdopen(fd, mode);
 311 }
 312
 313 PerlIO*
 314 PerlStdIOReopen(struct IPerlStdIO*, const char*path, const char*mode, PerlIO* pf)
 315 {
 316     return (PerlIO*)win32_freopen(path, mode, (FILE*)pf);
 317 }
 318
 319 SSize_t
 320 PerlStdIORead(struct IPerlStdIO*, PerlIO* pf, void *buffer, Size_t size)
 321 {
 322     return win32_fread(buffer, 1, size, (FILE*)pf);
 323 }
 324
 325 SSize_t
 326 PerlStdIOWrite(struct IPerlStdIO*, PerlIO* pf, const void *buffer, Size_t size)
 327 {
 328     return win32_fwrite(buffer, 1, size, (FILE*)pf);
 329 }
 330
 331 void
 332 PerlStdIOSetBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer)
 333 {
 334     win32_setbuf((FILE*)pf, buffer);
 335 }
 336
 337 int
 338 PerlStdIOSetVBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer, int type, Size_t size)
 339 {
 340     return win32_setvbuf((FILE*)pf, buffer, type, size);
 341 }
 342
 343 void
 344 PerlStdIOSetCnt(struct IPerlStdIO*, PerlIO* pf, int n)
 345 {
 346 #ifdef STDIO_CNT_LVALUE
 347     FILE *f = (FILE*)pf;
 348     FILE_cnt(f) = n;
 349 #endif
 350 }
 351
 352 void
 353 PerlStdIOSetPtrCnt(struct IPerlStdIO*, PerlIO* pf, char * ptr, int n)
 354 {
 355 #ifdef STDIO_PTR_LVALUE
 356     FILE *f = (FILE*)pf;
 357     FILE_ptr(f) = ptr;
 358     FILE_cnt(f) = n;
 359 #endif
 360 }
 361
 362 void
 363 PerlStdIOSetlinebuf(struct IPerlStdIO*, PerlIO* pf)
 364 {
 365     win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0);
 366 }
 367
 368 int
 369 PerlStdIOPrintf(struct IPerlStdIO*, PerlIO* pf, const char *format,...)
 370 {
 371     va_list(arglist);
 372     va_start(arglist, format);
 373     return win32_vfprintf((FILE*)pf, format, arglist);
 374 }
 375
 376 int
 377 PerlStdIOVprintf(struct IPerlStdIO*, PerlIO* pf, const char *format, va_list arglist)
 378 {
 379     return win32_vfprintf((FILE*)pf, format, arglist);
 380 }
 381
 382 long
 383 PerlStdIOTell(struct IPerlStdIO*, PerlIO* pf)
 384 {
 385     return win32_ftell((FILE*)pf);
 386 }
 387
 388 int
 389 PerlStdIOSeek(struct IPerlStdIO*, PerlIO* pf, off_t offset, int origin)
 390 {
 391     return win32_fseek((FILE*)pf, offset, origin);
 392 }
 393
 394 void
 395 PerlStdIORewind(struct IPerlStdIO*, PerlIO* pf)
 396 {
 397     win32_rewind((FILE*)pf);
 398 }
 399
 400 PerlIO*
 401 PerlStdIOTmpfile(struct IPerlStdIO*)
 402 {
 403     return (PerlIO*)win32_tmpfile();
 404 }
 405
 406 int
 407 PerlStdIOGetpos(struct IPerlStdIO*, PerlIO* pf, Fpos_t *p)
 408 {
 409     return win32_fgetpos((FILE*)pf, p);
 410 }
 411
 412 int
 413 PerlStdIOSetpos(struct IPerlStdIO*, PerlIO* pf, const Fpos_t *p)
 414 {
 415     return win32_fsetpos((FILE*)pf, p);
 416 }
 417 void
 418 PerlStdIOInit(struct IPerlStdIO*)
 419 {
 420 }
 421
 422 void
 423 PerlStdIOInitOSExtras(struct IPerlStdIO*)
 424 {
 425     dTHXo;
 426     xs_init(pPerl);
 427     Perl_init_os_extras();
 428 }
 429
 430 int
 431 PerlStdIOOpenOSfhandle(struct IPerlStdIO*, long osfhandle, int flags)
 432 {
 433     return win32_open_osfhandle(osfhandle, flags);
 434 }
 435
 436 int
 437 PerlStdIOGetOSfhandle(struct IPerlStdIO*, int filenum)
 438 {
 439     return win32_get_osfhandle(filenum);
 440 }
 441
 442
 443 struct IPerlStdIO perlStdIO =
 444 {
 445     PerlStdIOStdin,
 446     PerlStdIOStdout,
 447     PerlStdIOStderr,
 448     PerlStdIOOpen,
 449     PerlStdIOClose,
 450     PerlStdIOEof,
 451     PerlStdIOError,
 452     PerlStdIOClearerr,
 453     PerlStdIOGetc,
 454     PerlStdIOGetBase,
 455     PerlStdIOGetBufsiz,
 456     PerlStdIOGetCnt,
 457     PerlStdIOGetPtr,
 458     PerlStdIOGets,
 459     PerlStdIOPutc,
 460     PerlStdIOPuts,
 461     PerlStdIOFlush,
 462     PerlStdIOUngetc,
 463     PerlStdIOFileno,
 464     PerlStdIOFdopen,
 465     PerlStdIOReopen,
 466     PerlStdIORead,
 467     PerlStdIOWrite,
 468     PerlStdIOSetBuf,
 469     PerlStdIOSetVBuf,
 470     PerlStdIOSetCnt,
 471     PerlStdIOSetPtrCnt,
 472     PerlStdIOSetlinebuf,
 473     PerlStdIOPrintf,
 474     PerlStdIOVprintf,
 475     PerlStdIOTell,
 476     PerlStdIOSeek,
 477     PerlStdIORewind,
 478     PerlStdIOTmpfile,
 479     PerlStdIOGetpos,
 480     PerlStdIOSetpos,
 481     PerlStdIOInit,
 482     PerlStdIOInitOSExtras,
 483 };
 484
 485
 486 // IPerlLIO
 487 int
 488 PerlLIOAccess(struct IPerlLIO*, const char *path, int mode)
 489 {
 490     return access(path, mode);
 491 }
 492
 493 int
 494 PerlLIOChmod(struct IPerlLIO*, const char *filename, int pmode)
 495 {
 496     return chmod(filename, pmode);
 497 }
 498
 499 int
 500 PerlLIOChown(struct IPerlLIO*, const char *filename, uid_t owner, gid_t group)
 501 {
 502     return chown(filename, owner, group);
 503 }
 504
 505 int
 506 PerlLIOChsize(struct IPerlLIO*, int handle, long size)
 507 {
 508     return chsize(handle, size);
 509 }
 510
 511 int
 512 PerlLIOClose(struct IPerlLIO*, int handle)
 513 {
 514     return win32_close(handle);
 515 }
 516
 517 int
 518 PerlLIODup(struct IPerlLIO*, int handle)
 519 {
 520     return win32_dup(handle);
 521 }
 522
 523 int
 524 PerlLIODup2(struct IPerlLIO*, int handle1, int handle2)
 525 {
 526     return win32_dup2(handle1, handle2);
 527 }
 528
 529 int
 530 PerlLIOFlock(struct IPerlLIO*, int fd, int oper)
 531 {
 532     return win32_flock(fd, oper);
 533 }
 534
 535 int
 536 PerlLIOFileStat(struct IPerlLIO*, int handle, struct stat *buffer)
 537 {
 538     return fstat(handle, buffer);
 539 }
 540
 541 int
 542 PerlLIOIOCtl(struct IPerlLIO*, int i, unsigned int u, char *data)
 543 {
 544     return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
 545 }
 546
 547 int
 548 PerlLIOIsatty(struct IPerlLIO*, int fd)
 549 {
 550     return isatty(fd);
 551 }
 552
 553 long
 554 PerlLIOLseek(struct IPerlLIO*, int handle, long offset, int origin)
 555 {
 556     return win32_lseek(handle, offset, origin);
 557 }
 558
 559 int
 560 PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer)
 561 {
 562     return win32_stat(path, buffer);
 563 }
 564
 565 char*
 566 PerlLIOMktemp(struct IPerlLIO*, char *Template)
 567 {
 568     return mktemp(Template);
 569 }
 570
 571 int
 572 PerlLIOOpen(struct IPerlLIO*, const char *filename, int oflag)
 573 {
 574     return win32_open(filename, oflag);
 575 }
 576
 577 int
 578 PerlLIOOpen3(struct IPerlLIO*, const char *filename, int oflag, int pmode)
 579 {
 580     int ret;
 581     if(stricmp(filename, "/dev/null") == 0)
 582         ret = open("NUL", oflag, pmode);
 583     else
 584         ret = open(filename, oflag, pmode);
 585
 586     return ret;
 587 }
 588
 589 int
 590 PerlLIORead(struct IPerlLIO*, int handle, void *buffer, unsigned int count)
 591 {
 592     return win32_read(handle, buffer, count);
 593 }
 594
 595 int
 596 PerlLIORename(struct IPerlLIO*, const char *OldFileName, const char *newname)
 597 {
 598     return win32_rename(OldFileName, newname);
 599 }
 600
 601 int
 602 PerlLIOSetmode(struct IPerlLIO*, int handle, int mode)
 603 {
 604     return win32_setmode(handle, mode);
 605 }
 606
 607 int
 608 PerlLIONameStat(struct IPerlLIO*, const char *path, struct stat *buffer)
 609 {
 610     return win32_stat(path, buffer);
 611 }
 612
 613 char*
 614 PerlLIOTmpnam(struct IPerlLIO*, char *string)
 615 {
 616     return tmpnam(string);
 617 }
 618
 619 int
 620 PerlLIOUmask(struct IPerlLIO*, int pmode)
 621 {
 622     return umask(pmode);
 623 }
 624
 625 int
 626 PerlLIOUnlink(struct IPerlLIO*, const char *filename)
 627 {
 628     chmod(filename, S_IREAD | S_IWRITE);
 629     return unlink(filename);
 630 }
 631
 632 int
 633 PerlLIOUtime(struct IPerlLIO*, char *filename, struct utimbuf *times)
 634 {
 635     return win32_utime(filename, times);
 636 }
 637
 638 int
 639 PerlLIOWrite(struct IPerlLIO*, int handle, const void *buffer, unsigned int count)
 640 {
 641     return win32_write(handle, buffer, count);
 642 }
 643
 644 struct IPerlLIO perlLIO =
 645 {
 646     PerlLIOAccess,
 647     PerlLIOChmod,
 648     PerlLIOChown,
 649     PerlLIOChsize,
 650     PerlLIOClose,
 651     PerlLIODup,
 652     PerlLIODup2,
 653     PerlLIOFlock,
 654     PerlLIOFileStat,
 655     PerlLIOIOCtl,
 656     PerlLIOIsatty,
 657     PerlLIOLseek,
 658     PerlLIOLstat,
 659     PerlLIOMktemp,
 660     PerlLIOOpen,
 661     PerlLIOOpen3,
 662     PerlLIORead,
 663     PerlLIORename,
 664     PerlLIOSetmode,
 665     PerlLIONameStat,
 666     PerlLIOTmpnam,
 667     PerlLIOUmask,
 668     PerlLIOUnlink,
 669     PerlLIOUtime,
 670     PerlLIOWrite,
 671 };
 672
 673 // IPerlDIR
 674 int
 675 PerlDirMakedir(struct IPerlDir*, const char *dirname, int mode)
 676 {
 677     return win32_mkdir(dirname, mode);
 678 }
 679
 680 int
 681 PerlDirChdir(struct IPerlDir*, const char *dirname)
 682 {
 683     return win32_chdir(dirname);
 684 }
 685
 686 int
 687 PerlDirRmdir(struct IPerlDir*, const char *dirname)
 688 {
 689     return win32_rmdir(dirname);
 690 }
 691
 692 int
 693 PerlDirClose(struct IPerlDir*, DIR *dirp)
 694 {
 695     return win32_closedir(dirp);
 696 }
 697
 698 DIR*
 699 PerlDirOpen(struct IPerlDir*, char *filename)
 700 {
 701     return win32_opendir(filename);
 702 }
 703
 704 struct direct *
 705 PerlDirRead(struct IPerlDir*, DIR *dirp)
 706 {
 707     return win32_readdir(dirp);
 708 }
 709
 710 void
 711 PerlDirRewind(struct IPerlDir*, DIR *dirp)
 712 {
 713     win32_rewinddir(dirp);
 714 }
 715
 716 void
 717 PerlDirSeek(struct IPerlDir*, DIR *dirp, long loc)
 718 {
 719     win32_seekdir(dirp, loc);
 720 }
 721
 722 long
 723 PerlDirTell(struct IPerlDir*, DIR *dirp)
 724 {
 725     return win32_telldir(dirp);
 726 }
 727
 728 struct IPerlDir perlDir =
 729 {
 730     PerlDirMakedir,
 731     PerlDirChdir,
 732     PerlDirRmdir,
 733     PerlDirClose,
 734     PerlDirOpen,
 735     PerlDirRead,
 736     PerlDirRewind,
 737     PerlDirSeek,
 738     PerlDirTell,
 739 };
 740
 741
 742 // IPerlSock
 743 u_long
 744 PerlSockHtonl(struct IPerlSock*, u_long hostlong)
 745 {
 746     return win32_htonl(hostlong);
 747 }
 748
 749 u_short
 750 PerlSockHtons(struct IPerlSock*, u_short hostshort)
 751 {
 752     return win32_htons(hostshort);
 753 }
 754
 755 u_long
 756 PerlSockNtohl(struct IPerlSock*, u_long netlong)
 757 {
 758     return win32_ntohl(netlong);
 759 }
 760
 761 u_short
 762 PerlSockNtohs(struct IPerlSock*, u_short netshort)
 763 {
 764     return win32_ntohs(netshort);
 765 }
 766
 767 SOCKET PerlSockAccept(struct IPerlSock*, SOCKET s, struct sockaddr* addr, int* addrlen)
 768 {
 769     return win32_accept(s, addr, addrlen);
 770 }
 771
 772 int
 773 PerlSockBind(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen)
 774 {
 775     return win32_bind(s, name, namelen);
 776 }
 777
 778 int
 779 PerlSockConnect(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen)
 780 {
 781     return win32_connect(s, name, namelen);
 782 }
 783
 784 void
 785 PerlSockEndhostent(struct IPerlSock*)
 786 {
 787     win32_endhostent();
 788 }
 789
 790 void
 791 PerlSockEndnetent(struct IPerlSock*)
 792 {
 793     win32_endnetent();
 794 }
 795
 796 void
 797 PerlSockEndprotoent(struct IPerlSock*)
 798 {
 799     win32_endprotoent();
 800 }
 801
 802 void
 803 PerlSockEndservent(struct IPerlSock*)
 804 {
 805     win32_endservent();
 806 }
 807
 808 struct hostent*
 809 PerlSockGethostbyaddr(struct IPerlSock*, const char* addr, int len, int type)
 810 {
 811     return win32_gethostbyaddr(addr, len, type);
 812 }
 813
 814 struct hostent*
 815 PerlSockGethostbyname(struct IPerlSock*, const char* name)
 816 {
 817     return win32_gethostbyname(name);
 818 }
 819
 820 struct hostent*
 821 PerlSockGethostent(struct IPerlSock*)
 822 {
 823     dTHXo;
 824     croak("gethostent not implemented!\n");
 825     return NULL;
 826 }
 827
 828 int
 829 PerlSockGethostname(struct IPerlSock*, char* name, int namelen)
 830 {
 831     return win32_gethostname(name, namelen);
 832 }
 833
 834 struct netent *
 835 PerlSockGetnetbyaddr(struct IPerlSock*, long net, int type)
 836 {
 837     return win32_getnetbyaddr(net, type);
 838 }
 839
 840 struct netent *
 841 PerlSockGetnetbyname(struct IPerlSock*, const char *name)
 842 {
 843     return win32_getnetbyname((char*)name);
 844 }
 845
 846 struct netent *
 847 PerlSockGetnetent(struct IPerlSock*)
 848 {
 849     return win32_getnetent();
 850 }
 851
 852 int PerlSockGetpeername(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen)
 853 {
 854     return win32_getpeername(s, name, namelen);
 855 }
 856
 857 struct protoent*
 858 PerlSockGetprotobyname(struct IPerlSock*, const char* name)
 859 {
 860     return win32_getprotobyname(name);
 861 }
 862
 863 struct protoent*
 864 PerlSockGetprotobynumber(struct IPerlSock*, int number)
 865 {
 866     return win32_getprotobynumber(number);
 867 }
 868
 869 struct protoent*
 870 PerlSockGetprotoent(struct IPerlSock*)
 871 {
 872     return win32_getprotoent();
 873 }
 874
 875 struct servent*
 876 PerlSockGetservbyname(struct IPerlSock*, const char* name, const char* proto)
 877 {
 878     return win32_getservbyname(name, proto);
 879 }
 880
 881 struct servent*
 882 PerlSockGetservbyport(struct IPerlSock*, int port, const char* proto)
 883 {
 884     return win32_getservbyport(port, proto);
 885 }
 886
 887 struct servent*
 888 PerlSockGetservent(struct IPerlSock*)
 889 {
 890     return win32_getservent();
 891 }
 892
 893 int
 894 PerlSockGetsockname(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen)
 895 {
 896     return win32_getsockname(s, name, namelen);
 897 }
 898
 899 int
 900 PerlSockGetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, char* optval, int* optlen)
 901 {
 902     return win32_getsockopt(s, level, optname, optval, optlen);
 903 }
 904
 905 unsigned long
 906 PerlSockInetAddr(struct IPerlSock*, const char* cp)
 907 {
 908     return win32_inet_addr(cp);
 909 }
 910
 911 char*
 912 PerlSockInetNtoa(struct IPerlSock*, struct in_addr in)
 913 {
 914     return win32_inet_ntoa(in);
 915 }
 916
 917 int
 918 PerlSockListen(struct IPerlSock*, SOCKET s, int backlog)
 919 {
 920     return win32_listen(s, backlog);
 921 }
 922
 923 int
 924 PerlSockRecv(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags)
 925 {
 926     return win32_recv(s, buffer, len, flags);
 927 }
 928
 929 int
 930 PerlSockRecvfrom(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
 931 {
 932     return win32_recvfrom(s, buffer, len, flags, from, fromlen);
 933 }
 934
 935 int
 936 PerlSockSelect(struct IPerlSock*, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
 937 {
 938     return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
 939 }
 940
 941 int
 942 PerlSockSend(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags)
 943 {
 944     return win32_send(s, buffer, len, flags);
 945 }
 946
 947 int
 948 PerlSockSendto(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
 949 {
 950     return win32_sendto(s, buffer, len, flags, to, tolen);
 951 }
 952
 953 void
 954 PerlSockSethostent(struct IPerlSock*, int stayopen)
 955 {
 956     win32_sethostent(stayopen);
 957 }
 958
 959 void
 960 PerlSockSetnetent(struct IPerlSock*, int stayopen)
 961 {
 962     win32_setnetent(stayopen);
 963 }
 964
 965 void
 966 PerlSockSetprotoent(struct IPerlSock*, int stayopen)
 967 {
 968     win32_setprotoent(stayopen);
 969 }
 970
 971 void
 972 PerlSockSetservent(struct IPerlSock*, int stayopen)
 973 {
 974     win32_setservent(stayopen);
 975 }
 976
 977 int
 978 PerlSockSetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, const char* optval, int optlen)
 979 {
 980     return win32_setsockopt(s, level, optname, optval, optlen);
 981 }
 982
 983 int
 984 PerlSockShutdown(struct IPerlSock*, SOCKET s, int how)
 985 {
 986     return win32_shutdown(s, how);
 987 }
 988
 989 SOCKET
 990 PerlSockSocket(struct IPerlSock*, int af, int type, int protocol)
 991 {
 992     return win32_socket(af, type, protocol);
 993 }
 994
 995 int
 996 PerlSockSocketpair(struct IPerlSock*, int domain, int type, int protocol, int* fds)
 997 {
 998     dTHXo;
 999     croak("socketpair not implemented!\n");
1000     return 0;
1001 }
1002
1003 int
1004 PerlSockClosesocket(struct IPerlSock*, SOCKET s)
1005 {
1006     return win32_closesocket(s);
1007 }
1008
1009 int
1010 PerlSockIoctlsocket(struct IPerlSock*, SOCKET s, long cmd, u_long *argp)
1011 {
1012     return win32_ioctlsocket(s, cmd, argp);
1013 }
1014
1015 struct IPerlSock perlSock =
1016 {
1017     PerlSockHtonl,
1018     PerlSockHtons,
1019     PerlSockNtohl,
1020     PerlSockNtohs,
1021     PerlSockAccept,
1022     PerlSockBind,
1023     PerlSockConnect,
1024     PerlSockEndhostent,
1025     PerlSockEndnetent,
1026     PerlSockEndprotoent,
1027     PerlSockEndservent,
1028     PerlSockGethostname,
1029     PerlSockGetpeername,
1030     PerlSockGethostbyaddr,
1031     PerlSockGethostbyname,
1032     PerlSockGethostent,
1033     PerlSockGetnetbyaddr,
1034     PerlSockGetnetbyname,
1035     PerlSockGetnetent,
1036     PerlSockGetprotobyname,
1037     PerlSockGetprotobynumber,
1038     PerlSockGetprotoent,
1039     PerlSockGetservbyname,
1040     PerlSockGetservbyport,
1041     PerlSockGetservent,
1042     PerlSockGetsockname,
1043     PerlSockGetsockopt,
1044     PerlSockInetAddr,
1045     PerlSockInetNtoa,
1046     PerlSockListen,
1047     PerlSockRecv,
1048     PerlSockRecvfrom,
1049     PerlSockSelect,
1050     PerlSockSend,
1051     PerlSockSendto,
1052     PerlSockSethostent,
1053     PerlSockSetnetent,
1054     PerlSockSetprotoent,
1055     PerlSockSetservent,
1056     PerlSockSetsockopt,
1057     PerlSockShutdown,
1058     PerlSockSocket,
1059     PerlSockSocketpair,
1060     PerlSockClosesocket,
1061 };
1062
1063
1064 // IPerlProc
1065
1066 #define EXECF_EXEC 1
1067 #define EXECF_SPAWN 2
1068
1069 extern char *           g_getlogin(void);
1070 extern int              do_spawn2(char *cmd, int exectype);
1071 extern int              g_do_aspawn(void *vreally, void **vmark, void **vsp);
1072
1073 void
1074 PerlProcAbort(struct IPerlProc*)
1075 {
1076     win32_abort();
1077 }
1078
1079 char *
1080 PerlProcCrypt(struct IPerlProc*, const char* clear, const char* salt)
1081 {
1082     return win32_crypt(clear, salt);
1083 }
1084
1085 void
1086 PerlProcExit(struct IPerlProc*, int status)
1087 {
1088     exit(status);
1089 }
1090
1091 void
1092 PerlProc_Exit(struct IPerlProc*, int status)
1093 {
1094     _exit(status);
1095 }
1096
1097 int
1098 PerlProcExecl(struct IPerlProc*, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1099 {
1100     return execl(cmdname, arg0, arg1, arg2, arg3);
1101 }
1102
1103 int
1104 PerlProcExecv(struct IPerlProc*, const char *cmdname, const char *const *argv)
1105 {
1106     return win32_execvp(cmdname, argv);
1107 }
1108
1109 int
1110 PerlProcExecvp(struct IPerlProc*, const char *cmdname, const char *const *argv)
1111 {
1112     return win32_execvp(cmdname, argv);
1113 }
1114
1115 uid_t
1116 PerlProcGetuid(struct IPerlProc*)
1117 {
1118     return getuid();
1119 }
1120
1121 uid_t
1122 PerlProcGeteuid(struct IPerlProc*)
1123 {
1124     return geteuid();
1125 }
1126
1127 gid_t
1128 PerlProcGetgid(struct IPerlProc*)
1129 {
1130     return getgid();
1131 }
1132
1133 gid_t
1134 PerlProcGetegid(struct IPerlProc*)
1135 {
1136     return getegid();
1137 }
1138
1139 char *
1140 PerlProcGetlogin(struct IPerlProc*)
1141 {
1142     return g_getlogin();
1143 }
1144
1145 int
1146 PerlProcKill(struct IPerlProc*, int pid, int sig)
1147 {
1148     return win32_kill(pid, sig);
1149 }
1150
1151 int
1152 PerlProcKillpg(struct IPerlProc*, int pid, int sig)
1153 {
1154     dTHXo;
1155     croak("killpg not implemented!\n");
1156     return 0;
1157 }
1158
1159 int
1160 PerlProcPauseProc(struct IPerlProc*)
1161 {
1162     return win32_sleep((32767L << 16) + 32767);
1163 }
1164
1165 PerlIO*
1166 PerlProcPopen(struct IPerlProc*, const char *command, const char *mode)
1167 {
1168     win32_fflush(stdout);
1169     win32_fflush(stderr);
1170     return (PerlIO*)win32_popen(command, mode);
1171 }
1172
1173 int
1174 PerlProcPclose(struct IPerlProc*, PerlIO *stream)
1175 {
1176     return win32_pclose((FILE*)stream);
1177 }
1178
1179 int
1180 PerlProcPipe(struct IPerlProc*, int *phandles)
1181 {
1182     return win32_pipe(phandles, 512, O_BINARY);
1183 }
1184
1185 int
1186 PerlProcSetuid(struct IPerlProc*, uid_t u)
1187 {
1188     return setuid(u);
1189 }
1190
1191 int
1192 PerlProcSetgid(struct IPerlProc*, gid_t g)
1193 {
1194     return setgid(g);
1195 }
1196
1197 int
1198 PerlProcSleep(struct IPerlProc*, unsigned int s)
1199 {
1200     return win32_sleep(s);
1201 }
1202
1203 int
1204 PerlProcTimes(struct IPerlProc*, struct tms *timebuf)
1205 {
1206     return win32_times(timebuf);
1207 }
1208
1209 int
1210 PerlProcWait(struct IPerlProc*, int *status)
1211 {
1212     return win32_wait(status);
1213 }
1214
1215 int
1216 PerlProcWaitpid(struct IPerlProc*, int pid, int *status, int flags)
1217 {
1218     return win32_waitpid(pid, status, flags);
1219 }
1220
1221 Sighandler_t
1222 PerlProcSignal(struct IPerlProc*, int sig, Sighandler_t subcode)
1223 {
1224     return 0;
1225 }
1226
1227 void*
1228 PerlProcDynaLoader(struct IPerlProc*, const char* filename)
1229 {
1230     return win32_dynaload(filename);
1231 }
1232
1233 void
1234 PerlProcGetOSError(struct IPerlProc*, SV* sv, DWORD dwErr)
1235 {
1236     win32_str_os_error(aTHX_ sv, dwErr);
1237 }
1238
1239 BOOL
1240 PerlProcDoCmd(struct IPerlProc*, char *cmd)
1241 {
1242     do_spawn2(cmd, EXECF_EXEC);
1243     return FALSE;
1244 }
1245
1246 int
1247 PerlProcSpawn(struct IPerlProc*, char* cmds)
1248 {
1249     return do_spawn2(cmds, EXECF_SPAWN);
1250 }
1251
1252 int
1253 PerlProcSpawnvp(struct IPerlProc*, int mode, const char *cmdname, const char *const *argv)
1254 {
1255     return win32_spawnvp(mode, cmdname, argv);
1256 }
1257
1258 int
1259 PerlProcASpawn(struct IPerlProc*, void *vreally, void **vmark, void **vsp)
1260 {
1261     return g_do_aspawn(vreally, vmark, vsp);
1262 }
1263
1264 struct IPerlProc perlProc =
1265 {
1266     PerlProcAbort,
1267     PerlProcCrypt,
1268     PerlProcExit,
1269     PerlProc_Exit,
1270     PerlProcExecl,
1271     PerlProcExecv,
1272     PerlProcExecvp,
1273     PerlProcGetuid,
1274     PerlProcGeteuid,
1275     PerlProcGetgid,
1276     PerlProcGetegid,
1277     PerlProcGetlogin,
1278     PerlProcKill,
1279     PerlProcKillpg,
1280     PerlProcPauseProc,
1281     PerlProcPopen,
1282     PerlProcPclose,
1283     PerlProcPipe,
1284     PerlProcSetuid,
1285     PerlProcSetgid,
1286     PerlProcSleep,
1287     PerlProcTimes,
1288     PerlProcWait,
1289     PerlProcWaitpid,
1290     PerlProcSignal,
1291     PerlProcDynaLoader,
1292     PerlProcGetOSError,
1293     PerlProcDoCmd,
1294     PerlProcSpawn,
1295     PerlProcSpawnvp,
1296     PerlProcASpawn,
1297 };
1298
1299 //#include "perlhost.h"
1300
1301
1302 EXTERN_C void perl_get_host_info(IPerlMemInfo* perlMemInfo,
1303                         IPerlEnvInfo* perlEnvInfo, IPerlStdIOInfo* perlStdIOInfo,
1304                         IPerlLIOInfo* perlLIOInfo, IPerlDirInfo* perlDirInfo,
1305                         IPerlSockInfo* perlSockInfo, IPerlProcInfo* perlProcInfo)
1306 {
1307     if(perlMemInfo) {
1308         Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*);
1309         perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*));
1310     }
1311     if(perlEnvInfo) {
1312         Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*);
1313         perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*));
1314     }
1315     if(perlStdIOInfo) {
1316         Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*);
1317         perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*));
1318     }
1319     if(perlLIOInfo) {
1320         Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*);
1321         perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*));
1322     }
1323     if(perlDirInfo) {
1324         Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*);
1325         perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*));
1326     }
1327     if(perlSockInfo) {
1328         Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*);
1329         perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*));
1330     }
1331     if(perlProcInfo) {
1332         Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*);
1333         perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*));
1334     }
1335 }
1336
1337 EXTERN_C PerlInterpreter* perl_alloc_using(IPerlMem* pMem,
1338                         IPerlEnv* pEnv, IPerlStdIO* pStdIO,
1339                         IPerlLIO* pLIO, IPerlDir* pDir,
1340                         IPerlSock* pSock, IPerlProc* pProc)
1341 {
1342     CPerlObj* pPerl = NULL;
1343     try
1344     {
1345         pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc);
1346     }
1347     catch(...)
1348     {
1349         win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1350         pPerl = NULL;
1351     }
1352     if(pPerl)
1353     {
1354         SetPerlInterpreter(pPerl);
1355         return (PerlInterpreter*)pPerl;
1356     }
1357     SetPerlInterpreter(NULL);
1358     return NULL;
1359 }
1360
1361 #undef perl_alloc
1362 #undef perl_construct
1363 #undef perl_destruct
1364 #undef perl_free
1365 #undef perl_run
1366 #undef perl_parse
1367 EXTERN_C PerlInterpreter* perl_alloc(void)
1368 {
1369     CPerlObj* pPerl = NULL;
1370     try
1371     {
1372         pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO,
1373                            &perlDir, &perlSock, &perlProc);
1374     }
1375     catch(...)
1376     {
1377         win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory");
1378         pPerl = NULL;
1379     }
1380     if(pPerl)
1381     {
1382         SetPerlInterpreter(pPerl);
1383         return (PerlInterpreter*)pPerl;
1384     }
1385     SetPerlInterpreter(NULL);
1386     return NULL;
1387 }
1388
1389 EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
1390 {
1391     CPerlObj* pPerl = (CPerlObj*)sv_interp;
1392     try
1393     {
1394         pPerl->perl_construct();
1395     }
1396     catch(...)
1397     {
1398         win32_fprintf(stderr, "%s\n",
1399                       "Error: Unable to construct data structures");
1400         pPerl->perl_free();
1401         SetPerlInterpreter(NULL);
1402     }
1403 }
1404
1405 EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
1406 {
1407     CPerlObj* pPerl = (CPerlObj*)sv_interp;
1408     try
1409     {
1410         pPerl->perl_destruct();
1411     }
1412     catch(...)
1413     {
1414     }
1415 }
1416
1417 EXTERN_C void perl_free(PerlInterpreter* sv_interp)
1418 {
1419     CPerlObj* pPerl = (CPerlObj*)sv_interp;
1420     try
1421     {
1422         pPerl->perl_free();
1423     }
1424     catch(...)
1425     {
1426     }
1427     SetPerlInterpreter(NULL);
1428 }
1429
1430 EXTERN_C int perl_run(PerlInterpreter* sv_interp)
1431 {
1432     CPerlObj* pPerl = (CPerlObj*)sv_interp;
1433     int retVal;
1434     try
1435     {
1436         retVal = pPerl->perl_run();
1437     }
1438 /*
1439     catch(int x)
1440     {
1441         // this is where exit() should arrive
1442         retVal = x;
1443     }
1444 */
1445     catch(...)
1446     {
1447         win32_fprintf(stderr, "Error: Runtime exception\n");
1448         retVal = -1;
1449     }
1450     return retVal;
1451 }
1452
1453 EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
1454 {
1455     int retVal;
1456     CPerlObj* pPerl = (CPerlObj*)sv_interp;
1457     try
1458     {
1459         retVal = pPerl->perl_parse(xsinit, argc, argv, env);
1460     }
1461 /*
1462     catch(int x)
1463     {
1464         // this is where exit() should arrive
1465         retVal = x;
1466     }
1467 */
1468     catch(...)
1469     {
1470         win32_fprintf(stderr, "Error: Parse exception\n");
1471         retVal = -1;
1472     }
1473     *win32_errno() = 0;
1474     return retVal;
1475 }
1476
1477 #undef PL_perl_destruct_level
1478 #define PL_perl_destruct_level int dummy
1479 #endif /* PERL_OBJECT */
1480
1481 extern HANDLE w32_perldll_handle;
1482 static DWORD g_TlsAllocIndex;
1483
1484 EXTERN_C DllExport bool
1485 SetPerlInterpreter(void *interp)
1486 {
1487     return TlsSetValue(g_TlsAllocIndex, interp);
1488 }
1489
1490 EXTERN_C DllExport void*
1491 GetPerlInterpreter(void)
1492 {
1493     return TlsGetValue(g_TlsAllocIndex);
1494 }
1495
1496 EXTERN_C DllExport int
1497 RunPerl(int argc, char **argv, char **env)
1498 {
1499     int exitstatus;
1500     PerlInterpreter *my_perl;
1501     struct perl_thread *thr;
1502
1503 #ifndef __BORLANDC__
1504     /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
1505      * want to free() argv after main() returns.  As luck would have it,
1506      * Borland's CRT does the right thing to argv[0] already. */
1507     char szModuleName[MAX_PATH];
1508     char *ptr;
1509
1510     GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
1511     (void)win32_longpath(szModuleName);
1512     argv[0] = szModuleName;
1513 #endif
1514
1515 #ifdef PERL_GLOBAL_STRUCT
1516 #define PERLVAR(var,type) /**/
1517 #define PERLVARA(var,type) /**/
1518 #define PERLVARI(var,type,init) PL_Vars.var = init;
1519 #define PERLVARIC(var,type,init) PL_Vars.var = init;
1520 #include "perlvars.h"
1521 #undef PERLVAR
1522 #undef PERLVARA
1523 #undef PERLVARI
1524 #undef PERLVARIC
1525 #endif
1526
1527     PERL_SYS_INIT(&argc,&argv);
1528
1529     if (!(my_perl = perl_alloc()))
1530         return (1);
1531     perl_construct( my_perl );
1532     PL_perl_destruct_level = 0;
1533
1534 #ifdef PERL_OBJECT
1535     /* PERL_OBJECT build sets Dynaloader in PerlStdIOInitOSExtras */
1536     exitstatus = perl_parse(my_perl, NULL, argc, argv, env);
1537 #else
1538     exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
1539 #endif
1540     if (!exitstatus) {
1541         exitstatus = perl_run( my_perl );
1542     }
1543
1544     perl_destruct( my_perl );
1545     perl_free( my_perl );
1546
1547     PERL_SYS_TERM();
1548
1549     return (exitstatus);
1550 }
1551
1552 BOOL APIENTRY
1553 DllMain(HANDLE hModule,         /* DLL module handle */
1554         DWORD fdwReason,        /* reason called */
1555         LPVOID lpvReserved)     /* reserved */
1556 {
1557     switch (fdwReason) {
1558         /* The DLL is attaching to a process due to process
1559          * initialization or a call to LoadLibrary.
1560          */
1561     case DLL_PROCESS_ATTACH:
1562 /* #define DEFAULT_BINMODE */
1563 #ifdef DEFAULT_BINMODE
1564         setmode( fileno( stdin  ), O_BINARY );
1565         setmode( fileno( stdout ), O_BINARY );
1566         setmode( fileno( stderr ), O_BINARY );
1567         _fmode = O_BINARY;
1568 #endif
1569         g_TlsAllocIndex = TlsAlloc();
1570         DisableThreadLibraryCalls(hModule);
1571         w32_perldll_handle = hModule;
1572         break;
1573
1574         /* The DLL is detaching from a process due to
1575          * process termination or call to FreeLibrary.
1576          */
1577     case DLL_PROCESS_DETACH:
1578         TlsFree(g_TlsAllocIndex);
1579         break;
1580
1581         /* The attached process creates a new thread. */
1582     case DLL_THREAD_ATTACH:
1583         break;
1584
1585         /* The thread of the attached process terminates. */
1586     case DLL_THREAD_DETACH:
1587         break;
1588
1589     default:
1590         break;
1591     }
1592     return TRUE;
1593 }
1594