2 * Copyright © 2001 Novell, Inc. All Rights Reserved.
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.
10 * FILENAME : nwperlsys.c
11 * DESCRIPTION : Contains the platform specific functions calls
14 * Date Created : June 12th 2001.
27 //Including this is giving premature end-of-file error during compilation
30 #ifdef PERL_IMPLICIT_SYS
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);
46 //Includes iperlsys.h and function definitions
47 #include "nwperlsys.h"
49 /* IPerlStdio - Stdio functions - Begin ================================================*/
52 PerlStdIOStdin(struct IPerlStdIO* piPerl)
58 PerlStdIOStdout(struct IPerlStdIO* piPerl)
64 PerlStdIOStderr(struct IPerlStdIO* piPerl)
70 PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
72 return nw_fopen(path, mode);
76 PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
82 PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
88 PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
94 PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
100 PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
106 PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
117 PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
121 return FILE_bufsiz(f);
128 PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
139 PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
150 PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
152 return nw_fgets(s, n, pf);
156 PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
158 return nw_fputc(c, pf);
162 PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
164 return nw_fputs(s, pf);
168 PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
170 return nw_fflush(pf);
174 PerlStdIOUngetc(struct IPerlStdIO* piPerl, int c, FILE* pf)
176 return nw_ungetc(c, pf);
180 PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
182 return nw_fileno(pf);
186 PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
188 return nw_fdopen(fd, mode);
192 PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
194 return nw_freopen(path, mode, pf);
198 PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
200 return nw_fread(buffer, size, count, pf);
204 PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
206 return nw_fwrite(buffer, size, count, pf);
210 PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
212 nw_setbuf(pf, buffer);
216 PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
218 return nw_setvbuf(pf, buffer, type, size);
222 PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
224 #ifdef STDIO_CNT_LVALUE
231 PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
233 #ifdef STDIO_PTR_LVALUE
240 PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
242 nw_setvbuf(pf, NULL, _IOLBF, 0);
246 PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
249 va_start(arglist, format);
250 return nw_vfprintf(pf, format, arglist);
254 PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
256 return nw_vfprintf(pf, format, arglist);
260 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
266 PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
268 return nw_fseek(pf, offset, origin);
272 PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
278 PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
284 PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
286 return nw_fgetpos(pf, p);
290 PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
292 return nw_fsetpos(pf, p);
296 PerlStdIOInit(struct IPerlStdIO* piPerl)
301 PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
303 Perl_init_os_extras();
308 PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
310 return nw_open_osfhandle(osfhandle, flags);
314 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
316 return nw_get_osfhandle(filenum);
320 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
325 int fileno = nw_dup(nw_fileno(pf));
327 /* open the file in the same mode */
328 if(((FILE*)pf)->_flag & _IOREAD) {
332 else if(((FILE*)pf)->_flag & _IOWRT) {
336 else if(((FILE*)pf)->_flag & _IORW) {
342 /* it appears that the binmode is attached to the
343 * file descriptor so binmode files will be handled
346 pfdup = nw_fdopen(fileno, mode);
348 /* move the file pointer to the same position */
349 if (!fgetpos(pf, &pos)) {
350 fsetpos(pfdup, &pos);
355 /* IPerlStdio - Stdio functions - End ================================================*/
357 /* IPerlDir - Directory Manipulation functions - Begin ===================================*/
360 PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
362 return mkdir(dirname);
366 PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
368 return nw_chdir(dirname);
372 PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
374 return nw_rmdir(dirname);
378 PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
380 return nw_closedir(dirp);
384 PerlDirOpen(struct IPerlDir* piPerl, char *filename)
386 return nw_opendir(filename);
390 PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
392 return nw_readdir(dirp);
396 PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
402 PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
404 nw_seekdir(dirp, loc);
408 PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
410 return nw_telldir(dirp);
413 /* IPerlDir - Directory Manipulation functions - End ===================================*/
415 /* IPerlEnv - Environment related functions - Begin ======================================*/
418 PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
420 return(getenv(varname));
424 PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
426 return(putenv(envstring));
430 PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
433 char *e = getenv(varname);
440 PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
442 return nw_uname(name);
446 PerlEnvClearenv(struct IPerlEnv* piPerl)
451 /* IPerlEnv - Environment related functions - End ======================================*/
453 /* IPerlLIO - Low-level IO functions - Begin =============================================*/
456 PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
458 return nw_access(path, mode);
462 PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
464 return nw_chmod(filename, pmode);
468 PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
471 Perl_croak(aTHX_ "chown not implemented!\n");
476 PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
478 return (nw_chsize(handle,size));
482 PerlLIOClose(struct IPerlLIO* piPerl, int handle)
484 return nw_close(handle);
488 PerlLIODup(struct IPerlLIO* piPerl, int handle)
490 return nw_dup(handle);
494 PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
496 return nw_dup2(handle1, handle2);
500 PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
502 //On NetWare simulate flock by locking a range on the file
503 return nw_flock(fd, oper);
507 PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
509 return fstat(handle, buffer);
513 PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
519 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
521 return nw_isatty(fd);
525 PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
527 return nw_link(oldname, newname);
531 PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
533 return nw_lseek(handle, offset, origin);
537 PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
539 return nw_stat(path, buffer);
543 PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
545 return(nw_mktemp(Template));
549 PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
551 return nw_open(filename, oflag);
555 PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
557 return nw_open(filename, oflag, pmode);
561 PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
563 return nw_read(handle, buffer, count);
567 PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
569 return nw_rename(OldFileName, newname);
573 PerlLIOSetmode(struct IPerlLIO* piPerl, FILE *fp, int mode)
575 return nw_setmode(fp, mode);
579 PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
581 return nw_stat(path, buffer);
585 PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
587 return tmpnam(string);
591 PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
597 PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
599 return nw_unlink(filename);
603 PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
605 return nw_utime(filename, times);
609 PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
611 return nw_write(handle, buffer, count);
614 /* IPerlLIO - Low-level IO functions - End =============================================*/
616 /* IPerlMem - Memory management functions - Begin ========================================*/
619 PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
625 BOOL m_dontTouchHashLists;
626 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
628 WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr;
629 (WCValHashTable<void*>*)m_allocList->insert(ptr);
637 PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
640 WCValHashTable<void*>* m_allocList;
642 newptr = realloc(ptr, size);
647 BOOL m_dontTouchHashLists;
648 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
649 m_allocList= (WCValHashTable<void*>*)listptr;
650 (WCValHashTable<void*>*)m_allocList->remove(ptr);
656 (WCValHashTable<void*>*)m_allocList->insert(newptr);
663 PerlMemFree(struct IPerlMem* piPerl, void* ptr)
665 BOOL m_dontTouchHashLists;
666 WCValHashTable<void*>* m_allocList;
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)
682 if(ptr && m_allocList)
684 if ((WCValHashTable<void*>*)m_allocList->remove(ptr))
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.
702 PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
706 ptr = calloc(num, size);
709 BOOL m_dontTouchHashLists;
710 if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
712 WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr;
713 (WCValHashTable<void*>*)m_allocList->insert(ptr);
720 /* IPerlMem - Memory management functions - End ========================================*/
722 /* IPerlProc - Process control functions - Begin =========================================*/
725 #define EXECF_SPAWN 2
728 PerlProcAbort(struct IPerlProc* piPerl)
734 PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
736 return nw_crypt(clear, salt);
740 PerlProcExit(struct IPerlProc* piPerl, int status)
749 PerlProc_Exit(struct IPerlProc* piPerl, int status)
758 PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
761 Perl_croak(aTHX_ "execl not implemented!\n");
766 PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
768 return nw_execvp((char *)cmdname, (char **)argv);
772 PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
774 return nw_execvp((char *)cmdname, (char **)argv);
778 PerlProcGetuid(struct IPerlProc* piPerl)
784 PerlProcGeteuid(struct IPerlProc* piPerl)
790 PerlProcGetgid(struct IPerlProc* piPerl)
796 PerlProcGetegid(struct IPerlProc* piPerl)
802 PerlProcGetlogin(struct IPerlProc* piPerl)
808 PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
810 return nw_kill(pid, sig);
814 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
817 Perl_croak(aTHX_ "killpg not implemented!\n");
822 PerlProcPauseProc(struct IPerlProc* piPerl)
824 return nw_sleep((32767L << 16) + 32767);
828 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
831 PERL_FLUSHALL_FOR_CHILD;
833 return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno);
837 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
839 return nw_Pclose((FILE*)stream, (int *)errno);
843 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
845 return nw_Pipe((int *)phandles, (int *)errno);
849 PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
855 PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
861 PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
867 PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
869 return nw_times(timebuf);
873 PerlProcWait(struct IPerlProc* piPerl, int *status)
875 return nw_wait(status);
879 PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
881 return nw_waitpid(pid, status, flags);
885 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
891 PerlProcFork(struct IPerlProc* piPerl)
897 PerlProcGetpid(struct IPerlProc* piPerl)
903 PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
905 do_spawn2(cmd, EXECF_EXEC);
910 PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
912 return do_spawn2(cmds, EXECF_SPAWN);
916 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
918 return nw_spawnvp(mode, (char *)cmdname, (char **)argv);
922 PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
924 return do_aspawn(vreally, vmark, vsp);
927 /* IPerlProc - Process control functions - End =========================================*/
929 /* IPerlSock - Socket functions - Begin ==================================================*/
932 PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
934 return(nw_htonl(hostlong));
938 PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
940 return(nw_htons(hostshort));
944 PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
946 return nw_ntohl(netlong);
950 PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
952 return nw_ntohs(netshort);
955 SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
957 return nw_accept(s, addr, addrlen);
961 PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
963 return nw_bind(s, name, namelen);
967 PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
969 return nw_connect(s, name, namelen);
973 PerlSockEndhostent(struct IPerlSock* piPerl)
979 PerlSockEndnetent(struct IPerlSock* piPerl)
985 PerlSockEndprotoent(struct IPerlSock* piPerl)
991 PerlSockEndservent(struct IPerlSock* piPerl)
997 PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
999 return(nw_gethostbyaddr(addr,len,type));
1003 PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1005 return nw_gethostbyname(name);
1009 PerlSockGethostent(struct IPerlSock* piPerl)
1011 return(nw_gethostent());
1015 PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1017 return nw_gethostname(name,namelen);
1021 PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1023 return nw_getnetbyaddr(net, type);
1027 PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1029 return nw_getnetbyname((char*)name);
1033 PerlSockGetnetent(struct IPerlSock* piPerl)
1035 return nw_getnetent();
1038 int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1040 return nw_getpeername(s, name, namelen);
1044 PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1046 return nw_getprotobyname(name);
1050 PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1052 return nw_getprotobynumber(number);
1056 PerlSockGetprotoent(struct IPerlSock* piPerl)
1058 return nw_getprotoent();
1062 PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1064 return nw_getservbyname((char*)name, (char*)proto);
1068 PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1070 return nw_getservbyport(port, proto);
1074 PerlSockGetservent(struct IPerlSock* piPerl)
1076 return nw_getservent();
1080 PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1082 return nw_getsockname(s, name, namelen);
1086 PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1088 return nw_getsockopt(s, level, optname, optval, optlen);
1092 PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1094 return(nw_inet_addr(cp));
1098 PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1104 PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1106 return (nw_listen(s, backlog));
1110 PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1112 return (nw_recv(s, buffer, len, flags));
1116 PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1118 return nw_recvfrom(s, buffer, len, flags, from, fromlen);
1122 PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1124 return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout);
1128 PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1130 return (nw_send(s, buffer, len, flags));
1134 PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1136 return(nw_sendto(s, buffer, len, flags, to, tolen));
1140 PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1142 nw_sethostent(stayopen);
1146 PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1148 nw_setnetent(stayopen);
1152 PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1154 nw_setprotoent(stayopen);
1158 PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1160 nw_setservent(stayopen);
1164 PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1167 Perl_croak(aTHX_ "setsockopt not implemented!\n");
1172 PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1174 return nw_shutdown(s, how);
1178 PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1180 return nw_socket(af, type, protocol);
1184 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1187 Perl_croak(aTHX_ "socketpair not implemented!\n");
1192 PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1195 Perl_croak(aTHX_ "ioctlsocket not implemented!\n");
1199 /* IPerlSock - Socket functions - End ==================================================*/
1201 /*============================================================================================
1203 Function : fnFreeMemEntry
1205 Description : Called for each outstanding memory allocation at the end of a script run.
1206 Frees the outstanding allocations
1208 Parameters : ptr (IN).
1213 ==============================================================================================*/
1215 void fnFreeMemEntry(void* ptr, void* context)
1219 PerlMemFree(NULL, ptr);
1222 /*============================================================================================
1224 Function : fnAllocListHash
1226 Description : Hashing function for hash table of memory allocations.
1228 Parameters : invalue (IN).
1232 ==============================================================================================*/
1234 unsigned fnAllocListHash(void* const& invalue)
1236 return (((unsigned) invalue & 0x0000ff00) >> 8);
1239 /*============================================================================================
1241 Function : perl_alloc
1243 Description : creates a Perl interpreter variable and initializes
1247 Returns : Pointer to Perl interpreter
1249 ==============================================================================================*/
1251 EXTERN_C PerlInterpreter*
1254 PerlInterpreter* my_perl = NULL;
1256 WCValHashTable<void*>* m_allocList;
1257 m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
1258 fnInsertHashListAddrs(m_allocList, FALSE);
1260 my_perl = perl_alloc_using(&perlMem,
1271 CPerlObj* pPerl = (CPerlObj*)my_perl;
1273 //w32_internal_host = m_allocList;
1278 /*============================================================================================
1280 Function : nw5_delete_internal_host
1282 Description : Deletes the alloc_list pointer
1284 Parameters : alloc_list pointer
1288 ==============================================================================================*/
1291 nw5_delete_internal_host(void *h)
1293 WCValHashTable<void*>* m_allocList;
1295 BOOL m_dontTouchHashLists;
1296 if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) {
1297 m_allocList = (WCValHashTable<void*>*)listptr;
1298 fnInsertHashListAddrs(m_allocList, TRUE);
1301 m_allocList->forAll(fnFreeMemEntry, NULL);
1302 fnInsertHashListAddrs(NULL, FALSE);
1308 #endif /* PERL_IMPLICIT_SYS */