NetWare/nwperlsys.c

   1 /*
   2  * Copyright © 2001 Novell, Inc. All Rights Reserved.
   3  *
   4  * You may distribute under the terms of either the GNU General Public
   5  * License or the Artistic License, as specified in the README file.
   6  *
   7  */
   8
   9 /*
  10  * FILENAME             :       nwperlsys.c
  11  * DESCRIPTION  :       Contains the platform specific functions calls
  12  *
  13  * Author               :       SGP
  14  * Date Created :       June 12th 2001.
  15  * Date Modified:
  16  */
  17
  18 #include "EXTERN.h"
  19 #include "perl.h"
  20
  21
  22 #ifdef PERL_OBJECT
  23 #define NO_XSLOCKS
  24 #endif
  25
  26 //CHKSGP
  27 //Including this is giving premature end-of-file error during compilation
  28 //#include "XSUB.h"
  29
  30 #ifdef PERL_IMPLICIT_SYS
  31
  32 #include "nw5iop.h"
  33 #include <fcntl.h>
  34
  35
  36 #include "win32ish.h"
  37
  38 START_EXTERN_C
  39 extern int do_spawn2(char *cmd, int exectype);
  40 extern int do_aspawn(void *vreally, void **vmark, void **vsp);
  41 extern void Perl_init_os_extras(void);
  42 extern BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList);
  43 extern BOOL fnGetHashListAddrs(void *addrs, BOOL *dontTouchHashList);
  44 END_EXTERN_C
  45
  46 //Includes iperlsys.h and function definitions
  47 #include "nwperlsys.h"
  48
  49 /* IPerlStdio   - Stdio functions - Begin ================================================*/
  50
  51 FILE*
  52 PerlStdIOStdin(struct IPerlStdIO* piPerl)
  53 {
  54     return nw_stdin();
  55 }
  56
  57 FILE*
  58 PerlStdIOStdout(struct IPerlStdIO* piPerl)
  59 {
  60     return nw_stdout();
  61 }
  62
  63 FILE*
  64 PerlStdIOStderr(struct IPerlStdIO* piPerl)
  65 {
  66     return nw_stderr();
  67 }
  68
  69 FILE*
  70 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
  71 {
  72     return nw_fopen(path, mode);
  73 }
  74
  75 int
  76 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
  77 {
  78     return nw_fclose(pf);
  79 }
  80
  81 int
  82 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
  83 {
  84     return nw_feof(pf);
  85 }
  86
  87 int
  88 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
  89 {
  90     return nw_ferror(pf);
  91 }
  92
  93 void
  94 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
  95 {
  96     nw_clearerr(pf);
  97 }
  98
  99 int
 100 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
 101 {
 102     return nw_getc(pf);
 103 }
 104
 105 char*
 106 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
 107 {
 108 #ifdef FILE_base
 109     FILE *f = pf;
 110     return FILE_base(f);
 111 #else
 112     return Nullch;
 113 #endif
 114 }
 115
 116 int
 117 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
 118 {
 119 #ifdef FILE_bufsiz
 120     FILE *f = pf;
 121     return FILE_bufsiz(f);
 122 #else
 123     return (-1);
 124 #endif
 125 }
 126
 127 int
 128 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
 129 {
 130 #ifdef USE_STDIO_PTR
 131     FILE *f = pf;
 132     return FILE_cnt(f);
 133 #else
 134     return (-1);
 135 #endif
 136 }
 137
 138 char*
 139 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
 140 {
 141 #ifdef USE_STDIO_PTR
 142     FILE *f = pf;
 143     return FILE_ptr(f);
 144 #else
 145     return Nullch;
 146 #endif
 147 }
 148
 149 char*
 150 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
 151 {
 152     return nw_fgets(s, n, pf);
 153 }
 154
 155 int
 156 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
 157 {
 158     return nw_fputc(c, pf);
 159 }
 160
 161 int
 162 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
 163 {
 164     return nw_fputs(s, pf);
 165 }
 166
 167 int
 168 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
 169 {
 170     return nw_fflush(pf);
 171 }
 172
 173 int
 174 PerlStdIOUngetc(struct IPerlStdIO* piPerl, int c, FILE* pf)
 175 {
 176     return nw_ungetc(c, pf);
 177 }
 178
 179 int
 180 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
 181 {
 182     return nw_fileno(pf);
 183 }
 184
 185 FILE*
 186 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
 187 {
 188     return nw_fdopen(fd, mode);
 189 }
 190
 191 FILE*
 192 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
 193 {
 194     return nw_freopen(path, mode, pf);
 195 }
 196
 197 SSize_t
 198 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
 199 {
 200     return nw_fread(buffer, size, count, pf);
 201 }
 202
 203 SSize_t
 204 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
 205 {
 206     return nw_fwrite(buffer, size, count, pf);
 207 }
 208
 209 void
 210 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
 211 {
 212     nw_setbuf(pf, buffer);
 213 }
 214
 215 int
 216 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
 217 {
 218     return nw_setvbuf(pf, buffer, type, size);
 219 }
 220
 221 void
 222 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
 223 {
 224 #ifdef STDIO_CNT_LVALUE
 225     FILE *f = pf;
 226     FILE_cnt(f) = n;
 227 #endif
 228 }
 229
 230 void
 231 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
 232 {
 233 #ifdef STDIO_PTR_LVALUE
 234     FILE *f = pf;
 235     FILE_ptr(f) = ptr;
 236 #endif
 237 }
 238
 239 void
 240 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
 241 {
 242     nw_setvbuf(pf, NULL, _IOLBF, 0);
 243 }
 244
 245 int
 246 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
 247 {
 248     va_list(arglist);
 249     va_start(arglist, format);
 250     return nw_vfprintf(pf, format, arglist);
 251 }
 252
 253 int
 254 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
 255 {
 256     return nw_vfprintf(pf, format, arglist);
 257 }
 258
 259 long
 260 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
 261 {
 262     return nw_ftell(pf);
 263 }
 264
 265 int
 266 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
 267 {
 268     return nw_fseek(pf, offset, origin);
 269 }
 270
 271 void
 272 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
 273 {
 274     nw_rewind(pf);
 275 }
 276
 277 FILE*
 278 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
 279 {
 280     return nw_tmpfile();
 281 }
 282
 283 int
 284 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
 285 {
 286     return nw_fgetpos(pf, p);
 287 }
 288
 289 int
 290 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
 291 {
 292     return nw_fsetpos(pf, p);
 293 }
 294
 295 void
 296 PerlStdIOInit(struct IPerlStdIO* piPerl)
 297 {
 298 }
 299
 300 void
 301 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
 302 {
 303     Perl_init_os_extras();
 304 }
 305
 306
 307 int
 308 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
 309 {
 310     return nw_open_osfhandle(osfhandle, flags);
 311 }
 312
 313 int
 314 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
 315 {
 316     return nw_get_osfhandle(filenum);
 317 }
 318
 319 FILE*
 320 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
 321 {
 322     FILE* pfdup=NULL;
 323     fpos_t pos=0;
 324     char mode[3]={'\0'};
 325     int fileno = nw_dup(nw_fileno(pf));
 326
 327     /* open the file in the same mode */
 328     if(((FILE*)pf)->_flag & _IOREAD) {
 329         mode[0] = 'r';
 330         mode[1] = 0;
 331     }
 332     else if(((FILE*)pf)->_flag & _IOWRT) {
 333         mode[0] = 'a';
 334         mode[1] = 0;
 335     }
 336     else if(((FILE*)pf)->_flag & _IORW) {
 337         mode[0] = 'r';
 338         mode[1] = '+';
 339         mode[2] = 0;
 340     }
 341
 342     /* it appears that the binmode is attached to the
 343      * file descriptor so binmode files will be handled
 344      * correctly
 345      */
 346     pfdup = nw_fdopen(fileno, mode);
 347
 348     /* move the file pointer to the same position */
 349     if (!fgetpos(pf, &pos)) {
 350         fsetpos(pfdup, &pos);
 351     }
 352     return pfdup;
 353 }
 354
 355 /* IPerlStdio   - Stdio functions - End   ================================================*/
 356
 357 /* IPerlDir     - Directory Manipulation functions - Begin ===================================*/
 358
 359 int
 360 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
 361 {
 362         return mkdir(dirname);
 363 }
 364
 365 int
 366 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
 367 {
 368         return nw_chdir(dirname);
 369 }
 370
 371 int
 372 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
 373 {
 374         return nw_rmdir(dirname);
 375 }
 376
 377 int
 378 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
 379 {
 380         return nw_closedir(dirp);
 381 }
 382
 383 DIR*
 384 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
 385 {
 386         return nw_opendir(filename);
 387 }
 388
 389 struct direct *
 390 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
 391 {
 392         return nw_readdir(dirp);
 393 }
 394
 395 void
 396 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
 397 {
 398     nw_rewinddir(dirp);
 399 }
 400
 401 void
 402 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
 403 {
 404     nw_seekdir(dirp, loc);
 405 }
 406
 407 long
 408 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
 409 {
 410     return nw_telldir(dirp);
 411 }
 412
 413 /* IPerlDir     - Directory Manipulation functions - End   ===================================*/
 414
 415 /* IPerlEnv     - Environment related functions - Begin ======================================*/
 416
 417 char*
 418 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
 419 {
 420         return(getenv(varname));
 421 };
 422
 423 int
 424 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
 425 {
 426         return(putenv(envstring));
 427 };
 428
 429 char*
 430 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
 431 {
 432         *len = 0;
 433         char *e = getenv(varname);
 434         if (e)
 435             *len = strlen(e);
 436         return e;
 437 }
 438
 439 int
 440 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
 441 {
 442     return nw_uname(name);
 443 }
 444
 445 void
 446 PerlEnvClearenv(struct IPerlEnv* piPerl)
 447 {
 448
 449 }
 450
 451 /* IPerlEnv     - Environment related functions - End   ======================================*/
 452
 453 /* IPerlLIO     - Low-level IO functions - Begin =============================================*/
 454
 455 int
 456 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
 457 {
 458     return nw_access(path, mode);
 459 }
 460
 461 int
 462 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
 463 {
 464     return nw_chmod(filename, pmode);
 465 }
 466
 467 int
 468 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
 469 {
 470         dTHXo;
 471     Perl_croak(aTHX_ "chown not implemented!\n");
 472         return 0;
 473 }
 474
 475 int
 476 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
 477 {
 478         return (nw_chsize(handle,size));
 479 }
 480
 481 int
 482 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
 483 {
 484     return nw_close(handle);
 485 }
 486
 487 int
 488 PerlLIODup(struct IPerlLIO* piPerl, int handle)
 489 {
 490     return nw_dup(handle);
 491 }
 492
 493 int
 494 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
 495 {
 496     return nw_dup2(handle1, handle2);
 497 }
 498
 499 int
 500 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
 501 {
 502         //On NetWare simulate flock by locking a range on the file
 503     return nw_flock(fd, oper);
 504 }
 505
 506 int
 507 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
 508 {
 509     return fstat(handle, buffer);
 510 }
 511
 512 int
 513 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 514 {
 515         return 0;
 516 }
 517
 518 int
 519 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 520 {
 521     return nw_isatty(fd);
 522 }
 523
 524 int
 525 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
 526 {
 527     return nw_link(oldname, newname);
 528 }
 529
 530 long
 531 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
 532 {
 533     return nw_lseek(handle, offset, origin);
 534 }
 535
 536 int
 537 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
 538 {
 539     return nw_stat(path, buffer);
 540 }
 541
 542 char*
 543 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
 544 {
 545         return(nw_mktemp(Template));
 546 }
 547
 548 int
 549 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
 550 {
 551     return nw_open(filename, oflag);
 552 }
 553
 554 int
 555 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
 556 {
 557     return nw_open(filename, oflag, pmode);
 558 }
 559
 560 int
 561 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
 562 {
 563     return nw_read(handle, buffer, count);
 564 }
 565
 566 int
 567 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
 568 {
 569     return nw_rename(OldFileName, newname);
 570 }
 571
 572 int
 573 PerlLIOSetmode(struct IPerlLIO* piPerl, FILE *fp, int mode)
 574 {
 575     return nw_setmode(fp, mode);
 576 }
 577
 578 int
 579 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
 580 {
 581     return nw_stat(path, buffer);
 582 }
 583
 584 char*
 585 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
 586 {
 587     return tmpnam(string);
 588 }
 589
 590 int
 591 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
 592 {
 593     return umask(pmode);
 594 }
 595
 596 int
 597 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
 598 {
 599     return nw_unlink(filename);
 600 }
 601
 602 int
 603 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
 604 {
 605     return nw_utime(filename, times);
 606 }
 607
 608 int
 609 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
 610 {
 611     return nw_write(handle, buffer, count);
 612 }
 613
 614 /* IPerlLIO     - Low-level IO functions - End   =============================================*/
 615
 616 /* IPerlMem - Memory management functions - Begin ========================================*/
 617
 618 void*
 619 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
 620 {
 621         void *ptr = NULL;
 622         ptr = malloc(size);
 623         if (ptr) {
 624                 void **listptr;
 625                 BOOL m_dontTouchHashLists;
 626                 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 627                         if (listptr) {
 628                                 WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr;
 629                                 (WCValHashTable<void*>*)m_allocList->insert(ptr);
 630                         }
 631                 }
 632         }
 633         return(ptr);
 634 }
 635
 636 void*
 637 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
 638 {
 639         void *newptr = NULL;
 640         WCValHashTable<void*>* m_allocList;
 641
 642         newptr = realloc(ptr, size);
 643
 644         if (ptr)
 645         {
 646                 void **listptr;
 647                 BOOL m_dontTouchHashLists;
 648                 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 649                         m_allocList= (WCValHashTable<void*>*)listptr;
 650                         (WCValHashTable<void*>*)m_allocList->remove(ptr);
 651                 }
 652         }
 653         if (newptr)
 654         {
 655                 if (m_allocList)
 656                         (WCValHashTable<void*>*)m_allocList->insert(newptr);
 657         }
 658
 659         return(newptr);
 660 }
 661
 662 void
 663 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
 664 {
 665         BOOL m_dontTouchHashLists;
 666         WCValHashTable<void*>* m_allocList;
 667
 668         void **listptr;
 669         if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 670                 m_allocList= (WCValHashTable<void*>*)listptr;
 671                 // Final clean up, free all the nodes from the hash list
 672                 if (m_dontTouchHashLists)
 673                 {
 674                         if(ptr)
 675                         {
 676                                 free(ptr);
 677                                 ptr = NULL;
 678                         }
 679                 }
 680                 else
 681                 {
 682                         if(ptr && m_allocList)
 683                         {
 684                                 if ((WCValHashTable<void*>*)m_allocList->remove(ptr))
 685                                 {
 686                                         free(ptr);
 687                                         ptr = NULL;
 688                                 }
 689                                 else
 690                                 {
 691                                         // If it comes here, that means that the memory pointer is not contained in the hash list.
 692                                         // But no need to free now, since if is deleted here, it will result in an abend!!
 693                                         // If the memory is still there, it will be cleaned during final cleanup anyway.
 694                                 }
 695                         }
 696                 }
 697         }
 698         return;
 699 }
 700
 701 void*
 702 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
 703 {
 704         void *ptr = NULL;
 705
 706         ptr = calloc(num, size);
 707         if (ptr) {
 708                 void **listptr;
 709                 BOOL m_dontTouchHashLists;
 710                 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
 711                         if (listptr) {
 712                                 WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr;
 713                                 (WCValHashTable<void*>*)m_allocList->insert(ptr);
 714                         }
 715                 }
 716         }
 717         return(ptr);
 718 }
 719
 720 /* IPerlMem - Memory management functions - End   ========================================*/
 721
 722 /* IPerlProc - Process control functions - Begin =========================================*/
 723
 724 #define EXECF_EXEC 1
 725 #define EXECF_SPAWN 2
 726
 727 void
 728 PerlProcAbort(struct IPerlProc* piPerl)
 729 {
 730     nw_abort();
 731 }
 732
 733 char *
 734 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
 735 {
 736     return nw_crypt(clear, salt);
 737 }
 738
 739 void
 740 PerlProcExit(struct IPerlProc* piPerl, int status)
 741 {
 742 //    exit(status);
 743         dTHX;
 744         dJMPENV;
 745         JMPENV_JUMP(2);
 746 }
 747
 748 void
 749 PerlProc_Exit(struct IPerlProc* piPerl, int status)
 750 {
 751 //    _exit(status);
 752         dTHX;
 753         dJMPENV;
 754         JMPENV_JUMP(2);
 755 }
 756
 757 int
 758 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
 759 {
 760         dTHXo;
 761     Perl_croak(aTHX_ "execl not implemented!\n");
 762         return 0;
 763 }
 764
 765 int
 766 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
 767 {
 768     return nw_execvp((char *)cmdname, (char **)argv);
 769 }
 770
 771 int
 772 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
 773 {
 774     return nw_execvp((char *)cmdname, (char **)argv);
 775 }
 776
 777 uid_t
 778 PerlProcGetuid(struct IPerlProc* piPerl)
 779 {
 780         return 0;
 781 }
 782
 783 uid_t
 784 PerlProcGeteuid(struct IPerlProc* piPerl)
 785 {
 786         return 0;
 787 }
 788
 789 gid_t
 790 PerlProcGetgid(struct IPerlProc* piPerl)
 791 {
 792         return 0;
 793 }
 794
 795 gid_t
 796 PerlProcGetegid(struct IPerlProc* piPerl)
 797 {
 798         return 0;
 799 }
 800
 801 char *
 802 PerlProcGetlogin(struct IPerlProc* piPerl)
 803 {
 804         return NULL;
 805 }
 806
 807 int
 808 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
 809 {
 810     return nw_kill(pid, sig);
 811 }
 812
 813 int
 814 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
 815 {
 816     dTHXo;
 817     Perl_croak(aTHX_ "killpg not implemented!\n");
 818     return 0;
 819 }
 820
 821 int
 822 PerlProcPauseProc(struct IPerlProc* piPerl)
 823 {
 824     return nw_sleep((32767L << 16) + 32767);
 825 }
 826
 827 PerlIO*
 828 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
 829 {
 830     dTHXo;
 831     PERL_FLUSHALL_FOR_CHILD;
 832
 833         return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno);
 834 }
 835
 836 int
 837 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
 838 {
 839     return nw_Pclose((FILE*)stream, (int *)errno);
 840 }
 841
 842 int
 843 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
 844 {
 845     return nw_Pipe((int *)phandles, (int *)errno);
 846 }
 847
 848 int
 849 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
 850 {
 851         return 0;
 852 }
 853
 854 int
 855 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
 856 {
 857         return 0;
 858 }
 859
 860 int
 861 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
 862 {
 863     return nw_sleep(s);
 864 }
 865
 866 int
 867 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
 868 {
 869     return nw_times(timebuf);
 870 }
 871
 872 int
 873 PerlProcWait(struct IPerlProc* piPerl, int *status)
 874 {
 875     return nw_wait(status);
 876 }
 877
 878 int
 879 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
 880 {
 881     return nw_waitpid(pid, status, flags);
 882 }
 883
 884 Sighandler_t
 885 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
 886 {
 887     return 0;
 888 }
 889
 890 int
 891 PerlProcFork(struct IPerlProc* piPerl)
 892 {
 893         return 0;
 894 }
 895
 896 int
 897 PerlProcGetpid(struct IPerlProc* piPerl)
 898 {
 899     return nw_getpid();
 900 }
 901
 902 /*BOOL
 903 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
 904 {
 905     do_spawn2(cmd, EXECF_EXEC);
 906     return FALSE;
 907 }*/
 908
 909 int
 910 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
 911 {
 912     return do_spawn2(cmds, EXECF_SPAWN);
 913 }
 914
 915 int
 916 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
 917 {
 918     return nw_spawnvp(mode, (char *)cmdname, (char **)argv);
 919 }
 920
 921 int
 922 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
 923 {
 924     return do_aspawn(vreally, vmark, vsp);
 925 }
 926
 927 /* IPerlProc - Process control functions - End   =========================================*/
 928
 929 /* IPerlSock - Socket functions - Begin ==================================================*/
 930
 931 u_long
 932 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
 933 {
 934         return(nw_htonl(hostlong));
 935 }
 936
 937 u_short
 938 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
 939 {
 940         return(nw_htons(hostshort));
 941 }
 942
 943 u_long
 944 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
 945 {
 946         return nw_ntohl(netlong);
 947 }
 948
 949 u_short
 950 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
 951 {
 952         return nw_ntohs(netshort);
 953 }
 954
 955 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
 956 {
 957         return nw_accept(s, addr, addrlen);
 958 }
 959
 960 int
 961 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
 962 {
 963         return nw_bind(s, name, namelen);
 964 }
 965
 966 int
 967 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
 968 {
 969         return nw_connect(s, name, namelen);
 970 }
 971
 972 void
 973 PerlSockEndhostent(struct IPerlSock* piPerl)
 974 {
 975     nw_endhostent();
 976 }
 977
 978 void
 979 PerlSockEndnetent(struct IPerlSock* piPerl)
 980 {
 981     nw_endnetent();
 982 }
 983
 984 void
 985 PerlSockEndprotoent(struct IPerlSock* piPerl)
 986 {
 987     nw_endprotoent();
 988 }
 989
 990 void
 991 PerlSockEndservent(struct IPerlSock* piPerl)
 992 {
 993     nw_endservent();
 994 }
 995
 996 struct hostent*
 997 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
 998 {
 999         return(nw_gethostbyaddr(addr,len,type));
1000 }
1001
1002 struct hostent*
1003 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1004 {
1005     return nw_gethostbyname(name);
1006 }
1007
1008 struct hostent*
1009 PerlSockGethostent(struct IPerlSock* piPerl)
1010 {
1011         return(nw_gethostent());
1012 }
1013
1014 int
1015 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1016 {
1017         return nw_gethostname(name,namelen);
1018 }
1019
1020 struct netent *
1021 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1022 {
1023     return nw_getnetbyaddr(net, type);
1024 }
1025
1026 struct netent *
1027 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1028 {
1029     return nw_getnetbyname((char*)name);
1030 }
1031
1032 struct netent *
1033 PerlSockGetnetent(struct IPerlSock* piPerl)
1034 {
1035     return nw_getnetent();
1036 }
1037
1038 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1039 {
1040     return nw_getpeername(s, name, namelen);
1041 }
1042
1043 struct protoent*
1044 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1045 {
1046     return nw_getprotobyname(name);
1047 }
1048
1049 struct protoent*
1050 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1051 {
1052     return nw_getprotobynumber(number);
1053 }
1054
1055 struct protoent*
1056 PerlSockGetprotoent(struct IPerlSock* piPerl)
1057 {
1058     return nw_getprotoent();
1059 }
1060
1061 struct servent*
1062 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1063 {
1064     return nw_getservbyname((char*)name, (char*)proto);
1065 }
1066
1067 struct servent*
1068 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1069 {
1070         return nw_getservbyport(port, proto);
1071 }
1072
1073 struct servent*
1074 PerlSockGetservent(struct IPerlSock* piPerl)
1075 {
1076         return nw_getservent();
1077 }
1078
1079 int
1080 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1081 {
1082         return nw_getsockname(s, name, namelen);
1083 }
1084
1085 int
1086 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1087 {
1088         return nw_getsockopt(s, level, optname, optval, optlen);
1089 }
1090
1091 unsigned long
1092 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1093 {
1094         return(nw_inet_addr(cp));
1095 }
1096
1097 char*
1098 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1099 {
1100         return NULL;
1101 }
1102
1103 int
1104 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1105 {
1106         return (nw_listen(s, backlog));
1107 }
1108
1109 int
1110 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1111 {
1112         return (nw_recv(s, buffer, len, flags));
1113 }
1114
1115 int
1116 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1117 {
1118         return nw_recvfrom(s, buffer, len, flags, from, fromlen);
1119 }
1120
1121 int
1122 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1123 {
1124         return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout);
1125 }
1126
1127 int
1128 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1129 {
1130         return (nw_send(s, buffer, len, flags));
1131 }
1132
1133 int
1134 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1135 {
1136         return(nw_sendto(s, buffer, len, flags, to, tolen));
1137 }
1138
1139 void
1140 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1141 {
1142         nw_sethostent(stayopen);
1143 }
1144
1145 void
1146 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1147 {
1148         nw_setnetent(stayopen);
1149 }
1150
1151 void
1152 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1153 {
1154         nw_setprotoent(stayopen);
1155 }
1156
1157 void
1158 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1159 {
1160         nw_setservent(stayopen);
1161 }
1162
1163 int
1164 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1165 {
1166         dTHXo;
1167     Perl_croak(aTHX_ "setsockopt not implemented!\n");
1168         return 0;
1169 }
1170
1171 int
1172 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1173 {
1174         return nw_shutdown(s, how);
1175 }
1176
1177 SOCKET
1178 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1179 {
1180         return nw_socket(af, type, protocol);
1181 }
1182
1183 int
1184 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1185 {
1186     dTHXo;
1187     Perl_croak(aTHX_ "socketpair not implemented!\n");
1188     return 0;
1189 }
1190
1191 int
1192 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1193 {
1194         dTHXo;
1195     Perl_croak(aTHX_ "ioctlsocket not implemented!\n");
1196         return 0;
1197 }
1198
1199 /* IPerlSock - Socket functions - End ==================================================*/
1200
1201 /*============================================================================================
1202
1203  Function               :       fnFreeMemEntry
1204
1205  Description    :       Called for each outstanding memory allocation at the end of a script run.
1206                                         Frees the outstanding allocations
1207
1208  Parameters     :       ptr     (IN).
1209                                         context (IN)
1210
1211  Returns                :       Nothing.
1212
1213 ==============================================================================================*/
1214
1215 void fnFreeMemEntry(void* ptr, void* context)
1216 {
1217         if(ptr)
1218         {
1219                 PerlMemFree(NULL, ptr);
1220         }
1221 }
1222 /*============================================================================================
1223
1224  Function               :       fnAllocListHash
1225
1226  Description    :       Hashing function for hash table of memory allocations.
1227
1228  Parameters     :       invalue (IN).
1229
1230  Returns                :       unsigned.
1231
1232 ==============================================================================================*/
1233
1234 unsigned fnAllocListHash(void* const& invalue)
1235 {
1236     return (((unsigned) invalue & 0x0000ff00) >> 8);
1237 }
1238
1239 /*============================================================================================
1240
1241  Function               :       perl_alloc
1242
1243  Description    :       creates a Perl interpreter variable and initializes
1244
1245  Parameters     :       none
1246
1247  Returns                :       Pointer to Perl interpreter
1248
1249 ==============================================================================================*/
1250
1251 EXTERN_C PerlInterpreter*
1252 perl_alloc(void)
1253 {
1254     PerlInterpreter* my_perl = NULL;
1255
1256         WCValHashTable<void*>*  m_allocList;
1257         m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
1258         fnInsertHashListAddrs(m_allocList, FALSE);
1259
1260         my_perl = perl_alloc_using(&perlMem,
1261                                    NULL,
1262                                    NULL,
1263                                    &perlEnv,
1264                                    &perlStdIO,
1265                                    &perlLIO,
1266                                    &perlDir,
1267                                    &perlSock,
1268                                    &perlProc);
1269         if (my_perl) {
1270 #ifdef PERL_OBJECT
1271             CPerlObj* pPerl = (CPerlObj*)my_perl;
1272 #endif
1273                 //w32_internal_host = m_allocList;
1274         }
1275     return my_perl;
1276 }
1277
1278 /*============================================================================================
1279
1280  Function               :       nw5_delete_internal_host
1281
1282  Description    :       Deletes the alloc_list pointer
1283
1284  Parameters     :       alloc_list pointer
1285
1286  Returns                :       none
1287
1288 ==============================================================================================*/
1289
1290 EXTERN_C void
1291 nw5_delete_internal_host(void *h)
1292 {
1293         WCValHashTable<void*>*  m_allocList;
1294         void **listptr;
1295         BOOL m_dontTouchHashLists;
1296         if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
1297                 m_allocList = (WCValHashTable<void*>*)listptr;
1298                 fnInsertHashListAddrs(m_allocList, TRUE);
1299                 if (m_allocList)
1300                 {
1301                         m_allocList->forAll(fnFreeMemEntry, NULL);
1302                         fnInsertHashListAddrs(NULL, FALSE);
1303                         delete m_allocList;
1304                 }
1305         }
1306 }
1307
1308 #endif /* PERL_IMPLICIT_SYS */