3 #define INCL_DOSFILEMGR
9 * Various Unix compatibility functions for OS/2
21 /*****************************************************************************/
22 /* 2.1 would not resolve symbols on demand, and has no ExtLIBPATH. */
23 static PFN ExtFCN[2]; /* Labeled by ord below. */
24 static USHORT loadOrd[2] = { 874, 873 }; /* Query=874, Set=873. */
25 #define ORD_QUERY_ELP 0
31 if (ExtFCN[ord] == NULL) {
32 static HMODULE hdosc = 0;
37 if ((!hdosc && CheckOSError(DosLoadModule(buf, sizeof buf,
39 || CheckOSError(DosQueryProcAddr(hdosc, loadOrd[ord], NULL, &fcn)))
40 die("This version of OS/2 does not support doscalls.%i",
44 if ((long)ExtFCN[ord] == -1) die("panic queryaddr");
48 static signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged,
50 #define QSS_INI_BUFFER 1024
53 get_sysinfo(ULONG pid, ULONG flags)
56 ULONG rc, buf_len = QSS_INI_BUFFER;
58 New(1022, pbuffer, buf_len, char);
59 /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */
60 rc = QuerySysState(flags, pid, pbuffer, buf_len);
61 while (rc == ERROR_BUFFER_OVERFLOW) {
62 Renew(pbuffer, buf_len *= 2, char);
63 rc = QuerySysState(flags, pid, pbuffer, buf_len);
70 return (PQTOPLEVEL)pbuffer;
73 #define PRIO_ERR 0x1111
81 psi = get_sysinfo(pid, QSS_PROCESS);
85 if (pid != psi->procdata->pid) {
87 croak("panic: wrong pid in sysinfo");
89 prio = psi->procdata->threads->priority;
95 setpriority(int which, int pid, int val)
100 prio = sys_prio(pid);
102 if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
103 if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) {
104 /* Do not change class. */
105 return CheckOSError(DosSetPriority((pid < 0)
106 ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
108 (32 - val) % 32 - (prio & 0xFF),
111 } else /* if ((32 - val) % 32 == (prio & 0xFF)) */ {
112 /* Documentation claims one can change both class and basevalue,
113 * but I find it wrong. */
114 /* Change class, but since delta == 0 denotes absolute 0, correct. */
115 if (CheckOSError(DosSetPriority((pid < 0)
116 ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
117 priors[(32 - val) >> 5] + 1,
121 if ( ((32 - val) % 32) == 0 ) return 0;
122 return CheckOSError(DosSetPriority((pid < 0)
123 ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
129 /* else return CheckOSError(DosSetPriority((pid < 0) */
130 /* ? PRTYS_PROCESSTREE : PRTYS_PROCESS, */
131 /* priors[(32 - val) >> 5] + 1, */
132 /* (32 - val) % 32 - (prio & 0xFF), */
138 getpriority(int which /* ignored */, int pid)
144 if (!(_emx_env & 0x200)) return 0; /* Nop if not OS/2. */
145 /* DosGetInfoBlocks has old priority! */
146 /* if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) return -1; */
147 /* if (pid != pib->pib_ulpid) { */
149 if (ret == PRIO_ERR) {
153 /* ret = tib->tib_ptib2->tib2_ulpri; */
154 return (1 - priors[((ret >> 8) - 1)])*32 - (ret & 0xFF);
157 /*****************************************************************************/
159 typedef void (*Sigfunc) _((int));
162 result(int flag, int pid)
165 Signal_t (*ihand)(); /* place to save signal during system() */
166 Signal_t (*qhand)(); /* place to save signal during system() */
172 if (pid < 0 || flag != 0)
176 ihand = rsignal(SIGINT, SIG_IGN);
177 qhand = rsignal(SIGQUIT, SIG_IGN);
179 r = wait4pid(pid, &status, 0);
180 } while (r == -1 && errno == EINTR);
181 rsignal(SIGINT, ihand);
182 rsignal(SIGQUIT, qhand);
184 statusvalue = (U16)status;
187 return status & 0xFFFF;
189 ihand = rsignal(SIGINT, SIG_IGN);
190 r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid);
191 rsignal(SIGINT, ihand);
192 statusvalue = res.codeResult << 8 | res.codeTerminate;
200 do_aspawn(really,mark,sp)
208 int flag = P_WAIT, trueflag;
211 New(401,Argv, sp - mark + 1, char*);
214 if (mark < sp && SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
219 while (++mark <= sp) {
221 *a++ = SvPVx(*mark, na);
231 if (strEQ(Argv[0],"/bin/sh")) Argv[0] = sh_path;
233 if (Argv[0][0] != '/' && Argv[0][0] != '\\'
234 && !(Argv[0][0] && Argv[0][1] == ':'
235 && (Argv[0][2] == '/' || Argv[0][2] != '\\'))
236 ) /* will swawnvp use PATH? */
237 TAINT_ENV(); /* testing IFS here is overkill, probably */
238 /* We should check PERL_SH* and PERLLIB_* as well? */
239 if (really && *(tmps = SvPV(really, na)))
240 rc = result(trueflag, spawnvp(flag,tmps,Argv));
242 rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
244 if (rc < 0 && dowarn)
245 warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
246 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
253 #define EXECF_SPAWN 0
255 #define EXECF_TRUEEXEC 2
256 #define EXECF_SPAWN_NOWAIT 3
259 do_spawn2(cmd, execf)
266 char *shell, *copt, *news = NULL;
270 if ((shell = getenv("EMXSHELL")) != NULL)
272 else if ((shell = getenv("SHELL")) != NULL)
274 else if ((shell = getenv("COMSPEC")) != NULL)
279 /* Consensus on perl5-porters is that it is _very_ important to
280 have a shell which will not change between computers with the
281 same architecture, to avoid "action on a distance".
282 And to have simple build, this shell should be sh. */
287 while (*cmd && isSPACE(*cmd))
290 if (strnEQ(cmd,"/bin/sh",7) && isSPACE(cmd[7])) {
291 STRLEN l = strlen(sh_path);
293 New(4545, news, strlen(cmd) - 7 + l, char);
294 strcpy(news, sh_path);
295 strcpy(news + l, cmd + 7);
299 /* save an extra exec if possible */
300 /* see if there are shell metacharacters in it */
302 if (*cmd == '.' && isSPACE(cmd[1]))
305 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
308 for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */
312 for (s = cmd; *s; s++) {
313 if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
314 if (*s == '\n' && s[1] == '\0') {
319 if (execf == EXECF_TRUEEXEC)
320 return execl(shell,shell,copt,cmd,(char*)0);
321 else if (execf == EXECF_EXEC)
322 return spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0);
323 else if (execf == EXECF_SPAWN_NOWAIT)
324 return spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0);
325 /* In the ak code internal P_NOWAIT is P_WAIT ??? */
327 spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
328 if (rc < 0 && dowarn)
329 warn("Can't %s \"%s\": %s",
330 (execf == EXECF_SPAWN ? "spawn" : "exec"),
331 shell, Strerror(errno));
332 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
333 if (news) Safefree(news);
338 New(402,Argv, (s - cmd) / 2 + 2, char*);
339 Cmd = savepvn(cmd, s-cmd);
342 while (*s && isSPACE(*s)) s++;
345 while (*s && !isSPACE(*s)) s++;
351 if (execf == EXECF_TRUEEXEC)
352 rc = execvp(Argv[0],Argv);
353 else if (execf == EXECF_EXEC)
354 rc = spawnvp(P_OVERLAY,Argv[0],Argv);
355 else if (execf == EXECF_SPAWN_NOWAIT)
356 rc = spawnvp(P_NOWAIT,Argv[0],Argv);
358 rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
359 if (rc < 0 && dowarn)
360 warn("Can't %s \"%s\": %s",
361 (execf == EXECF_SPAWN ? "spawn" : "exec"),
362 Argv[0], Strerror(errno));
363 if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
366 if (news) Safefree(news);
375 return do_spawn2(cmd, EXECF_SPAWN);
382 return do_spawn2(cmd, EXECF_SPAWN_NOWAIT);
389 return do_spawn2(cmd, EXECF_EXEC);
396 return do_spawn2(cmd, EXECF_TRUEEXEC);
400 my_syspopen(cmd,mode)
407 register I32 this, that, newfd;
408 register I32 pid, rc;
414 /* `this' is what we use in the parent, `that' in the child. */
415 this = (*mode == 'w');
419 taint_proper("Insecure %s%s", "EXEC");
421 /* Now we need to spawn the child. */
422 newfd = dup(*mode == 'r'); /* Preserve std* */
423 if (p[that] != (*mode == 'r')) {
424 dup2(p[that], *mode == 'r');
427 /* Where is `this' and newfd now? */
428 fcntl(p[this], F_SETFD, FD_CLOEXEC);
429 fcntl(newfd, F_SETFD, FD_CLOEXEC);
430 pid = do_spawn_nowait(cmd);
431 if (newfd != (*mode == 'r')) {
432 dup2(newfd, *mode == 'r'); /* Return std* back. */
440 if (p[that] < p[this]) {
441 dup2(p[this], p[that]);
445 sv = *av_fetch(fdpid,p[this],TRUE);
446 (void)SvUPGRADE(sv,SVt_IV);
449 return PerlIO_fdopen(p[this], mode);
451 #else /* USE_POPEN */
457 res = popen(cmd, mode);
459 char *shell = getenv("EMXSHELL");
461 my_setenv("EMXSHELL", sh_path);
462 res = popen(cmd, mode);
463 my_setenv("EMXSHELL", shell);
465 sv = *av_fetch(fdpid, PerlIO_fileno(res), TRUE);
466 (void)SvUPGRADE(sv,SVt_IV);
467 SvIVX(sv) = -1; /* A cooky. */
470 #endif /* USE_POPEN */
474 /******************************************************************/
480 die(no_func, "Unsupported function fork");
486 /*******************************************************************/
487 /* not implemented in EMX 0.9a */
489 void * ctermid(x) { return 0; }
491 #ifdef MYTTYNAME /* was not in emx0.9a */
492 void * ttyname(x) { return 0; }
495 /******************************************************************/
496 /* my socket forwarders - EMX lib only provides static forwarders */
498 static HMODULE htcp = 0;
506 if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */
508 DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
509 if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
510 return (void *) ((void * (*)(void)) fcn) ();
515 tcp1(char *name, int arg)
520 if (!(_emx_env & 0x200)) croak("%s requires OS/2", name); /* Die if not OS/2. */
522 DosLoadModule(buf, sizeof buf, "tcp32dll", &htcp);
523 if (htcp && DosQueryProcAddr(htcp, 0, name, &fcn) == 0)
524 ((void (*)(int)) fcn) (arg);
527 void * gethostent() { return tcp0("GETHOSTENT"); }
528 void * getnetent() { return tcp0("GETNETENT"); }
529 void * getprotoent() { return tcp0("GETPROTOENT"); }
530 void * getservent() { return tcp0("GETSERVENT"); }
531 void sethostent(x) { tcp1("SETHOSTENT", x); }
532 void setnetent(x) { tcp1("SETNETENT", x); }
533 void setprotoent(x) { tcp1("SETPROTOENT", x); }
534 void setservent(x) { tcp1("SETSERVENT", x); }
535 void endhostent() { tcp0("ENDHOSTENT"); }
536 void endnetent() { tcp0("ENDNETENT"); }
537 void endprotoent() { tcp0("ENDPROTOENT"); }
538 void endservent() { tcp0("ENDSERVENT"); }
540 /*****************************************************************************/
541 /* not implemented in C Set++ */
544 int setuid(x) { errno = EINVAL; return -1; }
545 int setgid(x) { errno = EINVAL; return -1; }
548 /*****************************************************************************/
549 /* stat() hack for char/block device */
553 /* First attempt used DosQueryFSAttach which crashed the system when
554 used with 5.001. Now just look for /dev/. */
557 os2_stat(char *name, struct stat *st)
559 static int ino = SHRT_MAX;
561 if (stricmp(name, "/dev/con") != 0
562 && stricmp(name, "/dev/tty") != 0)
563 return stat(name, st);
565 memset(st, 0, sizeof *st);
566 st->st_mode = S_IFCHR|0666;
567 st->st_ino = (ino-- & 0x7FFF);
576 /* SBRK() emulation, mostly moved to malloc.c. */
579 sys_alloc(int size) {
581 APIRET rc = DosAllocMem(&got, size, PAG_COMMIT | PAG_WRITE);
583 if (rc == ERROR_NOT_ENOUGH_MEMORY) {
585 } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
589 #endif /* USE_PERL_SBRK */
593 char *tmppath = TMPPATH1;
598 char *p = getenv("TMP"), *tpath;
601 if (!p) p = getenv("TEMP");
604 tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
607 strcpy(tpath + len + 1, TMPPATH1);
613 XS(XS_File__Copy_syscopy)
616 if (items < 2 || items > 3)
617 croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
619 char * src = (char *)SvPV(ST(0),na);
620 char * dst = (char *)SvPV(ST(1),na);
627 flag = (unsigned long)SvIV(ST(2));
630 RETVAL = !CheckOSError(DosCopy(src, dst, flag));
631 ST(0) = sv_newmortal();
632 sv_setiv(ST(0), (IV)RETVAL);
641 static char fname[9];
642 int pos = 6, len, avlen;
643 unsigned int sum = 0;
648 if (!SvROK(sv)) croak("Not a reference given to mod2fname");
650 if (SvTYPE(sv) != SVt_PVAV)
651 croak("Not array reference given to mod2fname");
653 avlen = av_len((AV*)sv);
655 croak("Empty array reference given to mod2fname");
657 s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
658 strncpy(fname, s, 8);
660 if (len < 6) pos = len;
662 sum = 33 * sum + *(s++); /* Checksumming first chars to
663 * get the capitalization into c.s. */
667 s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), na);
669 sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
673 fname[pos] = 'A' + (sum % 26);
674 fname[pos + 1] = 'A' + (sum / 26 % 26);
675 fname[pos + 2] = '\0';
676 return (char *)fname;
679 XS(XS_DynaLoader_mod2fname)
683 croak("Usage: DynaLoader::mod2fname(sv)");
688 RETVAL = mod2fname(sv);
689 ST(0) = sv_newmortal();
690 sv_setpv((SV*)ST(0), RETVAL);
698 static char buf[300];
701 if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */
704 if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, rc, "OSO001.MSG", &len))
705 sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
712 perllib_mangle(char *s, unsigned int l)
714 static char *newp, *oldp;
715 static int newl, oldl, notfound;
716 static char ret[STATIC_FILE_LENGTH+1];
718 if (!newp && !notfound) {
719 newp = getenv("PERLLIB_PREFIX");
724 while (*newp && !isSPACE(*newp) && *newp != ';') {
725 newp++; oldl++; /* Skip digits. */
727 while (*newp && (isSPACE(*newp) || *newp == ';')) {
728 newp++; /* Skip whitespace. */
731 if (newl == 0 || oldl == 0) {
732 die("Malformed PERLLIB_PREFIX");
737 if (*s == '\\') *s = '/';
750 if (l < oldl || strnicmp(oldp, s, oldl) != 0) {
753 if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) {
754 die("Malformed PERLLIB_PREFIX");
756 strcpy(ret + newl, s + oldl);
760 extern void dlopen();
761 void *fakedl = &dlopen; /* Pull in dynaloading part. */
763 #define sys_is_absolute(path) ( isALPHA((path)[0]) && (path)[1] == ':' \
764 && ((path)[2] == '/' || (path)[2] == '\\'))
765 #define sys_is_rooted _fnisabs
766 #define sys_is_relative _fnisrel
767 #define current_drive _getdrive
769 #undef chdir /* Was _chdir2. */
770 #define sys_chdir(p) (chdir(p) == 0)
771 #define change_drive(d) (_chdrive(d), (current_drive() == toupper(d)))
773 XS(XS_Cwd_current_drive)
777 croak("Usage: Cwd::current_drive()");
781 RETVAL = current_drive();
782 ST(0) = sv_newmortal();
783 sv_setpvn(ST(0), (char *)&RETVAL, 1);
792 croak("Usage: Cwd::sys_chdir(path)");
794 char * path = (char *)SvPV(ST(0),na);
797 RETVAL = sys_chdir(path);
798 ST(0) = RETVAL ? &sv_yes : &sv_no;
799 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
804 XS(XS_Cwd_change_drive)
808 croak("Usage: Cwd::change_drive(d)");
810 char d = (char)*SvPV(ST(0),na);
813 RETVAL = change_drive(d);
814 ST(0) = RETVAL ? &sv_yes : &sv_no;
815 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
820 XS(XS_Cwd_sys_is_absolute)
824 croak("Usage: Cwd::sys_is_absolute(path)");
826 char * path = (char *)SvPV(ST(0),na);
829 RETVAL = sys_is_absolute(path);
830 ST(0) = RETVAL ? &sv_yes : &sv_no;
831 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
836 XS(XS_Cwd_sys_is_rooted)
840 croak("Usage: Cwd::sys_is_rooted(path)");
842 char * path = (char *)SvPV(ST(0),na);
845 RETVAL = sys_is_rooted(path);
846 ST(0) = RETVAL ? &sv_yes : &sv_no;
847 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
852 XS(XS_Cwd_sys_is_relative)
856 croak("Usage: Cwd::sys_is_relative(path)");
858 char * path = (char *)SvPV(ST(0),na);
861 RETVAL = sys_is_relative(path);
862 ST(0) = RETVAL ? &sv_yes : &sv_no;
863 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
872 croak("Usage: Cwd::sys_cwd()");
876 RETVAL = _getcwd2(p, MAXPATHLEN);
877 ST(0) = sv_newmortal();
878 sv_setpv((SV*)ST(0), RETVAL);
883 XS(XS_Cwd_sys_abspath)
886 if (items < 1 || items > 2)
887 croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
889 char * path = (char *)SvPV(ST(0),na);
897 dir = (char *)SvPV(ST(1),na);
899 if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
903 if (_abspath(p, path, MAXPATHLEN) == 0) {
909 /* Absolute with drive: */
910 if ( sys_is_absolute(path) ) {
911 if (_abspath(p, path, MAXPATHLEN) == 0) {
916 } else if (path[0] == '/' || path[0] == '\\') {
917 /* Rooted, but maybe on different drive. */
918 if (isALPHA(dir[0]) && dir[1] == ':' ) {
921 /* Need to prepend the drive. */
924 Copy(path, p1 + 2, strlen(path) + 1, char);
926 if (_abspath(p, p1, MAXPATHLEN) == 0) {
931 } else if (_abspath(p, path, MAXPATHLEN) == 0) {
937 /* Either path is relative, or starts with a drive letter. */
938 /* If the path starts with a drive letter, then dir is
940 a/b) it is absolute/x:relative on the same drive.
941 c) path is on current drive, and dir is rooted
942 In all the cases it is safe to drop the drive part
944 if ( !sys_is_relative(path) ) {
947 if ( ( ( sys_is_absolute(dir)
948 || (isALPHA(dir[0]) && dir[1] == ':'
949 && strnicmp(dir, path,1) == 0))
950 && strnicmp(dir, path,1) == 0)
951 || ( !(isALPHA(dir[0]) && dir[1] == ':')
952 && toupper(path[0]) == current_drive())) {
954 } else if (_abspath(p, path, MAXPATHLEN) == 0) {
955 RETVAL = p; goto done;
957 RETVAL = NULL; goto done;
961 /* Need to prepend the absolute path of dir. */
964 if (_abspath(p1, dir, MAXPATHLEN) == 0) {
967 if (p1[ l - 1 ] != '/') {
971 Copy(path, p1 + l, strlen(path) + 1, char);
972 if (_abspath(p, p1, MAXPATHLEN) == 0) {
984 ST(0) = sv_newmortal();
985 sv_setpv((SV*)ST(0), RETVAL);
989 typedef APIRET (*PELP)(PSZ path, ULONG type);
992 ExtLIBPATH(ULONG ord, PSZ path, ULONG type)
994 loadByOrd(ord); /* Guarantied to load or die! */
995 return (*(PELP)ExtFCN[ord])(path, type);
998 #define extLibpath(type) \
999 (CheckOSError(ExtLIBPATH(ORD_QUERY_ELP, to, ((type) ? END_LIBPATH \
1000 : BEGIN_LIBPATH))) \
1003 #define extLibpath_set(p,type) \
1004 (!CheckOSError(ExtLIBPATH(ORD_SET_ELP, (p), ((type) ? END_LIBPATH \
1007 XS(XS_Cwd_extLibpath)
1010 if (items < 0 || items > 1)
1011 croak("Usage: Cwd::extLibpath(type = 0)");
1021 type = (int)SvIV(ST(0));
1024 RETVAL = extLibpath(type);
1025 ST(0) = sv_newmortal();
1026 sv_setpv((SV*)ST(0), RETVAL);
1031 XS(XS_Cwd_extLibpath_set)
1034 if (items < 1 || items > 2)
1035 croak("Usage: Cwd::extLibpath_set(s, type = 0)");
1037 char * s = (char *)SvPV(ST(0),na);
1045 type = (int)SvIV(ST(1));
1048 RETVAL = extLibpath_set(s, type);
1049 ST(0) = RETVAL ? &sv_yes : &sv_no;
1050 if (SvREFCNT(ST(0))) sv_2mortal(ST(0));
1058 char *file = __FILE__;
1062 if (_emx_env & 0x200) { /* OS/2 */
1063 newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
1064 newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file);
1065 newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file);
1067 newXS("DynaLoader::mod2fname", XS_DynaLoader_mod2fname, file);
1068 newXS("Cwd::current_drive", XS_Cwd_current_drive, file);
1069 newXS("Cwd::sys_chdir", XS_Cwd_sys_chdir, file);
1070 newXS("Cwd::change_drive", XS_Cwd_change_drive, file);
1071 newXS("Cwd::sys_is_absolute", XS_Cwd_sys_is_absolute, file);
1072 newXS("Cwd::sys_is_rooted", XS_Cwd_sys_is_rooted, file);
1073 newXS("Cwd::sys_is_relative", XS_Cwd_sys_is_relative, file);
1074 newXS("Cwd::sys_cwd", XS_Cwd_sys_cwd, file);
1075 newXS("Cwd::sys_abspath", XS_Cwd_sys_abspath, file);
1076 gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV);
1079 sv_setiv(GvSV(gv), 1);
1084 OS2_Perl_data_t OS2_Perl_data;
1092 OS2_Perl_data.xs_init = &Xs_OS2_init;
1093 if ( (shell = getenv("PERL_SH_DRIVE")) ) {
1094 New(404, sh_path, strlen(SH_PATH) + 1, char);
1095 strcpy(sh_path, SH_PATH);
1096 sh_path[0] = shell[0];
1097 } else if ( (shell = getenv("PERL_SH_DIR")) ) {
1098 int l = strlen(shell), i;
1099 if (shell[l-1] == '/' || shell[l-1] == '\\') {
1102 New(404, sh_path, l + 8, char);
1103 strncpy(sh_path, shell, l);
1104 strcpy(sh_path + l, "/sh.exe");
1105 for (i = 0; i < l; i++) {
1106 if (sh_path[i] == '\\') sh_path[i] = '/';
1115 my_tmpnam (char *str)
1117 char *p = getenv("TMP"), *tpath;
1120 if (!p) p = getenv("TEMP");
1121 tpath = tempnam(p, "pltmp");
1135 if (s.st_mode & S_IWOTH) {
1138 return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but