This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
NetWare tweaks from Guruprasad.
[perl5.git] / 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 ioctl(i, (int) u, (void *) data);
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     return nw_setsockopt(s, level, optname, optval, optlen);
1167 }
1168
1169 int
1170 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1171 {
1172         return nw_shutdown(s, how);
1173 }
1174
1175 SOCKET
1176 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1177 {
1178         return nw_socket(af, type, protocol);
1179 }
1180
1181 int
1182 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1183 {
1184     dTHXo;
1185     Perl_croak(aTHX_ "socketpair not implemented!\n");
1186     return 0;
1187 }
1188
1189 int
1190 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1191 {
1192         dTHXo;
1193     Perl_croak(aTHX_ "ioctlsocket not implemented!\n");
1194         return 0;
1195 }
1196
1197 /* IPerlSock - Socket functions - End ==================================================*/
1198
1199 /*============================================================================================
1200
1201  Function               :       fnFreeMemEntry
1202
1203  Description    :       Called for each outstanding memory allocation at the end of a script run.
1204                                         Frees the outstanding allocations
1205
1206  Parameters     :       ptr     (IN).
1207                                         context (IN)
1208
1209  Returns                :       Nothing.
1210
1211 ==============================================================================================*/
1212
1213 void fnFreeMemEntry(void* ptr, void* context)
1214 {
1215         if(ptr)
1216         {
1217                 PerlMemFree(NULL, ptr);
1218         }
1219 }
1220 /*============================================================================================
1221
1222  Function               :       fnAllocListHash
1223
1224  Description    :       Hashing function for hash table of memory allocations.
1225
1226  Parameters     :       invalue (IN).
1227
1228  Returns                :       unsigned.
1229
1230 ==============================================================================================*/
1231
1232 unsigned fnAllocListHash(void* const& invalue)
1233 {
1234     return (((unsigned) invalue & 0x0000ff00) >> 8);
1235 }
1236
1237 /*============================================================================================
1238
1239  Function               :       perl_alloc
1240
1241  Description    :       creates a Perl interpreter variable and initializes
1242
1243  Parameters     :       none
1244
1245  Returns                :       Pointer to Perl interpreter
1246
1247 ==============================================================================================*/
1248
1249 EXTERN_C PerlInterpreter*
1250 perl_alloc(void)
1251 {
1252     PerlInterpreter* my_perl = NULL;
1253
1254         WCValHashTable<void*>*  m_allocList;
1255         m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
1256         fnInsertHashListAddrs(m_allocList, FALSE);
1257
1258         my_perl = perl_alloc_using(&perlMem,
1259                                    NULL,
1260                                    NULL,
1261                                    &perlEnv,
1262                                    &perlStdIO,
1263                                    &perlLIO,
1264                                    &perlDir,
1265                                    &perlSock,
1266                                    &perlProc);
1267         if (my_perl) {
1268 #ifdef PERL_OBJECT
1269             CPerlObj* pPerl = (CPerlObj*)my_perl;
1270 #endif
1271                 //w32_internal_host = m_allocList;
1272         }
1273     return my_perl;
1274 }
1275
1276 /*============================================================================================
1277
1278  Function               :       nw5_delete_internal_host
1279
1280  Description    :       Deletes the alloc_list pointer
1281
1282  Parameters     :       alloc_list pointer
1283
1284  Returns                :       none
1285
1286 ==============================================================================================*/
1287
1288 EXTERN_C void
1289 nw5_delete_internal_host(void *h)
1290 {
1291         WCValHashTable<void*>*  m_allocList;
1292         void **listptr;
1293         BOOL m_dontTouchHashLists;
1294         if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
1295                 m_allocList = (WCValHashTable<void*>*)listptr;
1296                 fnInsertHashListAddrs(m_allocList, TRUE);
1297                 if (m_allocList)
1298                 {
1299                         m_allocList->forAll(fnFreeMemEntry, NULL);
1300                         fnInsertHashListAddrs(NULL, FALSE);
1301                         delete m_allocList;
1302                 }
1303         }
1304 }
1305
1306 #endif /* PERL_IMPLICIT_SYS */