This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlapi: Remove per-thread section; move to real scns
[perl5.git] / amigaos4 / amigaos.c
CommitLineData
a83a2cd1
AB
1/* amigaos.c uses only amigaos APIs,
2 * as opposed to amigaio.c which mixes amigaos and perl APIs */
3
4#include <string.h>
5
6#include <sys/stat.h>
7#include <unistd.h>
8#include <assert.h>
9
10#include <errno.h>
11#include <stdio.h>
12#include <stdlib.h>
13#if defined(__CLIB2__)
14# include <dos.h>
15#endif
16#if defined(__NEWLIB__)
17# include <amiga_platform.h>
18#endif
19#include <fcntl.h>
20#include <ctype.h>
21#include <stdarg.h>
738ab09f
AB
22#include <stdbool.h>
23#undef WORD
24#define WORD int16
a83a2cd1
AB
25
26#include <dos/dos.h>
27#include <proto/dos.h>
28#include <proto/exec.h>
29#include <proto/utility.h>
30
31#include "amigaos.h"
32
33struct UtilityIFace *IUtility = NULL;
34
35/***************************************************************************/
36
37struct Interface *OpenInterface(CONST_STRPTR libname, uint32 libver)
38{
6c47084d
JH
39 struct Library *base = IExec->OpenLibrary(libname, libver);
40 struct Interface *iface = IExec->GetInterface(base, "main", 1, NULL);
41 if (iface == NULL)
42 {
43 // We should probably post some kind of error message here.
a83a2cd1 44
6c47084d
JH
45 IExec->CloseLibrary(base);
46 }
a83a2cd1 47
6c47084d 48 return iface;
a83a2cd1
AB
49}
50
51/***************************************************************************/
52
53void CloseInterface(struct Interface *iface)
54{
6c47084d
JH
55 if (iface != NULL)
56 {
57 struct Library *base = iface->Data.LibBase;
58 IExec->DropInterface(iface);
59 IExec->CloseLibrary(base);
60 }
a83a2cd1
AB
61}
62
63BOOL __unlink_retries = FALSE;
64
65void ___makeenviron() __attribute__((constructor));
66void ___freeenviron() __attribute__((destructor));
67
68void ___openinterfaces() __attribute__((constructor));
69void ___closeinterfaces() __attribute__((destructor));
70
71void ___openinterfaces()
72{
6c47084d
JH
73 if (!IDOS)
74 IDOS = (struct DOSIFace *)OpenInterface("dos.library", 53);
75 if (!IUtility)
76 IUtility =
77 (struct UtilityIFace *)OpenInterface("utility.library", 53);
a83a2cd1
AB
78}
79
80void ___closeinterfaces()
81{
6c47084d
JH
82 CloseInterface((struct Interface *)IDOS);
83 CloseInterface((struct Interface *)IUtility);
a83a2cd1
AB
84}
85int VARARGS68K araddebug(UBYTE *fmt, ...);
86int VARARGS68K adebug(UBYTE *fmt, ...);
87
88#define __USE_RUNCOMMAND__
89
90char **myenviron = NULL;
91char **origenviron = NULL;
92
a83a2cd1
AB
93static void createvars(char **envp);
94
95struct args
96{
6c47084d
JH
97 BPTR seglist;
98 int stack;
99 char *command;
100 int length;
101 int result;
102 char **envp;
a83a2cd1
AB
103};
104
03b66f6d 105int __myrc(__attribute__((unused))char *arg)
a83a2cd1 106{
6c47084d
JH
107 struct Task *thisTask = IExec->FindTask(0);
108 struct args *myargs = (struct args *)thisTask->tc_UserData;
109 if (myargs->envp)
110 createvars(myargs->envp);
111 // adebug("%s %ld %s \n",__FUNCTION__,__LINE__,myargs->command);
112 myargs->result = IDOS->RunCommand(myargs->seglist, myargs->stack,
113 myargs->command, myargs->length);
114 return 0;
a83a2cd1
AB
115}
116
117int32 myruncommand(
118 BPTR seglist, int stack, char *command, int length, char **envp)
119{
6c47084d
JH
120 struct args myargs;
121 struct Task *thisTask = IExec->FindTask(0);
122 struct Process *proc;
123
124 // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,command?command:"NULL");
125
126 myargs.seglist = seglist;
127 myargs.stack = stack;
128 myargs.command = command;
129 myargs.length = length;
130 myargs.result = -1;
131 myargs.envp = envp;
132
133 if ((proc = IDOS->CreateNewProcTags(
134 NP_Entry, __myrc, NP_Child, TRUE, NP_Input, IDOS->Input(),
135 NP_Output, IDOS->Output(), NP_Error, IDOS->ErrorOutput(),
136 NP_CloseInput, FALSE, NP_CloseOutput, FALSE, NP_CloseError,
137 FALSE, NP_CopyVars, FALSE,
138
139 // NP_StackSize, ((struct Process
140 // *)myargs.parent)->pr_StackSize,
141 NP_Cli, TRUE, NP_UserData, (int)&myargs,
142 NP_NotifyOnDeathSigTask, thisTask, TAG_DONE)))
143
144 {
145 IExec->Wait(SIGF_CHILD);
146 }
147 return myargs.result;
a83a2cd1
AB
148}
149
738ab09f 150char *mystrdup(const char *s)
a83a2cd1 151{
6c47084d
JH
152 char *result = NULL;
153 size_t size;
a83a2cd1 154
6c47084d 155 size = strlen(s) + 1;
a83a2cd1 156
03b66f6d 157 if ((result = (char *)IExec->AllocVecTags(size, TAG_DONE)))
6c47084d
JH
158 {
159 memmove(result, s, size);
160 }
161 return result;
a83a2cd1
AB
162}
163
47718690 164unsigned int pipenum = 0;
a83a2cd1
AB
165
166int pipe(int filedes[2])
167{
6c47084d 168 char pipe_name[1024];
a83a2cd1
AB
169
170// adebug("%s %ld \n",__FUNCTION__,__LINE__);
171#ifdef USE_TEMPFILES
6c47084d 172 sprintf(pipe_name, "/T/%x.%08lx", pipenum++, IUtility->GetUniqueID());
a83a2cd1 173#else
6c47084d
JH
174 sprintf(pipe_name, "/PIPE/%x%08lx/4096/0", pipenum++,
175 IUtility->GetUniqueID());
a83a2cd1
AB
176#endif
177
6c47084d
JH
178 /* printf("pipe: %s \n", pipe_name);*/
179
180 filedes[1] = open(pipe_name, O_WRONLY | O_CREAT);
181 filedes[0] = open(pipe_name, O_RDONLY);
182 if (filedes[0] == -1 || filedes[1] == -1)
183 {
184 if (filedes[0] != -1)
185 close(filedes[0]);
186 if (filedes[1] != -1)
187 close(filedes[1]);
188 return -1;
189 }
190 /* printf("filedes %d %d\n", filedes[0],
191 * filedes[1]);fflush(stdout);*/
192
193 return 0;
a83a2cd1
AB
194}
195
196int fork(void)
197{
6c47084d
JH
198 fprintf(stderr, "Can not bloody fork\n");
199 errno = ENOMEM;
200 return -1;
a83a2cd1
AB
201}
202
03b66f6d 203int wait(__attribute__((unused))int *status)
a83a2cd1 204{
6c47084d
JH
205 fprintf(stderr, "No wait try waitpid instead\n");
206 errno = ECHILD;
207 return -1;
a83a2cd1
AB
208}
209
210char *convert_path_a2u(const char *filename)
211{
6c47084d 212 struct NameTranslationInfo nti;
a83a2cd1 213
6c47084d
JH
214 if (!filename)
215 {
216 return 0;
217 }
a83a2cd1 218
6c47084d 219 __translate_amiga_to_unix_path_name(&filename, &nti);
a83a2cd1 220
6c47084d 221 return mystrdup(filename);
a83a2cd1
AB
222}
223char *convert_path_u2a(const char *filename)
224{
6c47084d 225 struct NameTranslationInfo nti;
a83a2cd1 226
6c47084d
JH
227 if (!filename)
228 {
229 return 0;
230 }
a83a2cd1 231
6c47084d
JH
232 if (strcmp(filename, "/dev/tty") == 0)
233 {
234 return mystrdup("CONSOLE:");
235 ;
236 }
a83a2cd1 237
6c47084d 238 __translate_unix_to_amiga_path_name(&filename, &nti);
a83a2cd1 239
6c47084d 240 return mystrdup(filename);
a83a2cd1
AB
241}
242
47718690
AB
243struct SignalSemaphore environ_sema;
244struct SignalSemaphore popen_sema;
6de23f80 245
a83a2cd1 246
6c47084d
JH
247void amigaos4_init_environ_sema()
248{
249 IExec->InitSemaphore(&environ_sema);
6de23f80 250 IExec->InitSemaphore(&popen_sema);
6c47084d 251}
a83a2cd1 252
6c47084d
JH
253void amigaos4_obtain_environ()
254{
255 IExec->ObtainSemaphore(&environ_sema);
256}
a83a2cd1 257
6c47084d
JH
258void amigaos4_release_environ()
259{
260 IExec->ReleaseSemaphore(&environ_sema);
261}
a83a2cd1
AB
262
263static void createvars(char **envp)
264{
6c47084d
JH
265 if (envp)
266 {
267 /* Set a local var to indicate to any subsequent sh that it is
268 * not
269 * the top level shell and so should only inherit local amigaos
270 * vars */
271 IDOS->SetVar("ABCSH_IMPORT_LOCAL", "TRUE", 5, GVF_LOCAL_ONLY);
272
273 amigaos4_obtain_environ();
274
275 envp = myenviron;
276
277 while ((envp != NULL) && (*envp != NULL))
278 {
279 int len;
280 char *var;
281 char *val;
282 if ((len = strlen(*envp)))
283 {
03b66f6d 284 if ((var = (char *)IExec->AllocVecTags(len + 1, AVT_ClearWithValue,0,TAG_DONE)))
6c47084d
JH
285 {
286 strcpy(var, *envp);
287
288 val = strchr(var, '=');
289 if (val)
290 {
291 *val++ = '\0';
292 if (*val)
293 {
294 IDOS->SetVar(
295 var, val,
296 strlen(val) + 1,
297 GVF_LOCAL_ONLY);
298 }
299 }
300 IExec->FreeVec(var);
301 }
302 }
303 envp++;
304 }
305 amigaos4_release_environ();
306 }
a83a2cd1
AB
307}
308
a83a2cd1
AB
309struct command_data
310{
6c47084d
JH
311 STRPTR args;
312 BPTR seglist;
313 struct Task *parent;
a83a2cd1
AB
314};
315
6de23f80 316
738ab09f 317int myexecvp(bool isperlthread, const char *filename, char *argv[])
a83a2cd1 318{
6c47084d
JH
319 // adebug("%s %ld
320 //%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL");
321 /* if there's a slash or a colon consider filename a path and skip
322 * search */
323 int res;
b80d8775
AB
324 char *name = NULL;
325 char *pathpart = NULL;
6c47084d
JH
326 if ((strchr(filename, '/') == NULL) && (strchr(filename, ':') == NULL))
327 {
03b66f6d 328 const char *path;
03b66f6d 329 const char *p;
6c47084d
JH
330 size_t len;
331 struct stat st;
332
333 if (!(path = getenv("PATH")))
334 {
335 path = ".:/bin:/usr/bin:/c";
336 }
337
338 len = strlen(filename) + 1;
b80d8775
AB
339 name = (char *)IExec->AllocVecTags(strlen(path) + len, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE);
340 pathpart = (char *)IExec->AllocVecTags(strlen(path) + 1, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE);
6c47084d
JH
341 p = path;
342 do
343 {
344 path = p;
345
346 if (!(p = strchr(path, ':')))
347 {
348 p = strchr(path, '\0');
349 }
350
351 memcpy(pathpart, path, p - path);
352 pathpart[p - path] = '\0';
353 if (!(strlen(pathpart) == 0))
354 {
355 sprintf(name, "%s/%s", pathpart, filename);
356 }
357 else
358 sprintf(name, "%s", filename);
359
360 if ((stat(name, &st) == 0) && (S_ISREG(st.st_mode)))
361 {
362 /* we stated it and it's a regular file */
363 /* let's boogie! */
364 filename = name;
365 break;
366 }
367
368 }
369 while (*p++ != '\0');
370 }
b80d8775 371
6c47084d 372 res = myexecve(isperlthread, filename, argv, myenviron);
b80d8775
AB
373
374 if(name)
375 {
376 IExec->FreeVec((APTR)name);
377 name = NULL;
378 }
379 if(pathpart)
380 {
381 IExec->FreeVec((APTR)pathpart);
382 pathpart = NULL;
383 }
6c47084d 384 return res;
a83a2cd1
AB
385}
386
738ab09f 387int myexecv(bool isperlthread, const char *path, char *argv[])
a83a2cd1 388{
6c47084d 389 return myexecve(isperlthread, path, argv, myenviron);
a83a2cd1
AB
390}
391
738ab09f 392int myexecl(bool isperlthread, const char *path, ...)
a83a2cd1 393{
6c47084d
JH
394 va_list va;
395 char *argv[1024]; /* 1024 enough? let's hope so! */
396 int i = 0;
397 // adebug("%s %ld\n",__FUNCTION__,__LINE__);
398
399 va_start(va, path);
400 i = 0;
401
402 do
403 {
404 argv[i] = va_arg(va, char *);
405 }
406 while (argv[i++] != NULL);
407
408 va_end(va);
409 return myexecve(isperlthread, path, argv, myenviron);
a83a2cd1
AB
410}
411
a83a2cd1
AB
412int pause(void)
413{
6c47084d 414 fprintf(stderr, "Pause not implemented\n");
a83a2cd1 415
6c47084d
JH
416 errno = EINTR;
417 return -1;
a83a2cd1
AB
418}
419
03b66f6d 420uint32 size_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message)
a83a2cd1 421{
6c47084d
JH
422 if (strlen(message->sv_GDir) <= 4)
423 {
424 hook->h_Data = (APTR)(((uint32)hook->h_Data) + 1);
425 }
426 return 0;
a83a2cd1
AB
427}
428
03b66f6d 429uint32 copy_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message)
a83a2cd1 430{
6c47084d
JH
431 if (strlen(message->sv_GDir) <= 4)
432 {
433 char **env = (char **)hook->h_Data;
434 uint32 size =
435 strlen(message->sv_Name) + 1 + message->sv_VarLen + 1 + 1;
03b66f6d
AB
436 char *buffer = (char *)IExec->AllocVecTags((uint32)size,AVT_ClearWithValue,0,TAG_DONE);
437
6c47084d
JH
438
439 snprintf(buffer, size - 1, "%s=%s", message->sv_Name,
440 message->sv_Var);
441
442 *env = buffer;
443 env++;
444 hook->h_Data = env;
445 }
446 return 0;
a83a2cd1
AB
447}
448
449void ___makeenviron()
450{
03b66f6d 451 struct Hook *hook = (struct Hook *)IExec->AllocSysObjectTags(ASOT_HOOK,TAG_DONE);
6c47084d 452
03b66f6d 453 if(hook)
6c47084d 454 {
03b66f6d
AB
455 char varbuf[8];
456 uint32 flags = 0;
457
458 struct DOSIFace *myIDOS =
459 (struct DOSIFace *)OpenInterface("dos.library", 53);
460 if (myIDOS)
6c47084d 461 {
03b66f6d
AB
462 uint32 size = 0;
463 if (myIDOS->GetVar("ABCSH_IMPORT_LOCAL", varbuf, 8,
464 GVF_LOCAL_ONLY) > 0)
465 {
466 flags = GVF_LOCAL_ONLY;
467 }
468 else
469 {
470 flags = GVF_GLOBAL_ONLY;
471 }
6c47084d 472
03b66f6d
AB
473 hook->h_Entry = size_env;
474 hook->h_Data = 0;
6c47084d 475
03b66f6d
AB
476 myIDOS->ScanVars(hook, flags, 0);
477 size = ((uint32)hook->h_Data) + 1;
6c47084d 478
03b66f6d
AB
479 myenviron = (char **)IExec->AllocVecTags(size *
480 sizeof(char **),
481 AVT_ClearWithValue,0,TAG_DONE);
482 origenviron = myenviron;
483 if (!myenviron)
484 {
485 IExec->FreeSysObject(ASOT_HOOK,hook);
486 CloseInterface((struct Interface *)myIDOS);
487 return;
488 }
489 hook->h_Entry = copy_env;
490 hook->h_Data = myenviron;
6c47084d 491
03b66f6d
AB
492 myIDOS->ScanVars(hook, flags, 0);
493 IExec->FreeSysObject(ASOT_HOOK,hook);
494 CloseInterface((struct Interface *)myIDOS);
495 }
6c47084d 496 }
a83a2cd1
AB
497}
498
499void ___freeenviron()
500{
6c47084d
JH
501 char **i;
502 /* perl might change environ, it puts it back except for ctrl-c */
503 /* so restore our own copy here */
504 struct DOSIFace *myIDOS =
505 (struct DOSIFace *)OpenInterface("dos.library", 53);
506 if (myIDOS)
507 {
508 myenviron = origenviron;
509
510 if (myenviron)
511 {
512 for (i = myenviron; *i != NULL; i++)
513 {
514 IExec->FreeVec(*i);
515 }
516 IExec->FreeVec(myenviron);
517 myenviron = NULL;
518 }
519 CloseInterface((struct Interface *)myIDOS);
520 }
a83a2cd1
AB
521}
522
6de23f80
AB
523
524/* Work arround for clib2 fstat */
a83a2cd1
AB
525#ifndef S_IFCHR
526#define S_IFCHR 0x0020000
527#endif
528
529#define SET_FLAG(u, v) ((void)((u) |= (v)))
530
531int afstat(int fd, struct stat *statb)
532{
6c47084d
JH
533 int result;
534 BPTR fh;
535 int mode;
536 BOOL input;
537 /* In the first instance pass it to fstat */
538 // adebug("fd %ld ad %ld\n",fd,amigaos_get_file(fd));
a83a2cd1 539
6c47084d
JH
540 if ((result = fstat(fd, statb) >= 0))
541 return result;
a83a2cd1 542
6c47084d
JH
543 /* Now we've got a file descriptor but we failed to stat it */
544 /* Could be a nil: or could be a std#? */
a83a2cd1 545
6c47084d 546 /* if get_default_file fails we had a dud fd so return failure */
a83a2cd1
AB
547#if !defined(__CLIB2__)
548
6c47084d
JH
549 fh = amigaos_get_file(fd);
550
551 /* if nil: return failure*/
552 if (fh == 0)
553 return -1;
554
555 /* Now compare with our process Input() Output() etc */
556 /* if these were regular files sockets or pipes we had already
557 * succeeded */
558 /* so we can guess they a character special console.... I hope */
559
560 struct ExamineData *data;
561 char name[120];
562 name[0] = '\0';
563
564 data = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, TAG_END);
565 if (data != NULL)
566 {
567
568 IUtility->Strlcpy(name, data->Name, sizeof(name));
569
570 IDOS->FreeDosObject(DOS_EXAMINEDATA, data);
571 }
572
573 // adebug("ad %ld '%s'\n",amigaos_get_file(fd),name);
574 mode = S_IFCHR;
575
576 if (fh == IDOS->Input())
577 {
578 input = TRUE;
579 SET_FLAG(mode, S_IRUSR);
580 SET_FLAG(mode, S_IRGRP);
581 SET_FLAG(mode, S_IROTH);
582 }
583 else if (fh == IDOS->Output() || fh == IDOS->ErrorOutput())
584 {
585 input = FALSE;
586 SET_FLAG(mode, S_IWUSR);
587 SET_FLAG(mode, S_IWGRP);
588 SET_FLAG(mode, S_IWOTH);
589 }
590 else
591 {
592 /* we got a filehandle not handle by fstat or the above */
593 /* most likely it's NIL: but lets check */
594 struct ExamineData *exd = NULL;
595 if ((exd = IDOS->ExamineObjectTags(EX_FileHandleInput, fh,
596 TAG_DONE)))
597 {
598 BOOL isnil = FALSE;
599 if (exd->Type ==
600 (20060920)) // Ugh yes I know nasty.....
601 {
602 isnil = TRUE;
603 }
604 IDOS->FreeDosObject(DOS_EXAMINEDATA, exd);
605 if (isnil)
606 {
607 /* yep we got NIL: */
608 SET_FLAG(mode, S_IRUSR);
609 SET_FLAG(mode, S_IRGRP);
610 SET_FLAG(mode, S_IROTH);
611 SET_FLAG(mode, S_IWUSR);
612 SET_FLAG(mode, S_IWGRP);
613 SET_FLAG(mode, S_IWOTH);
614 }
615 else
616 {
617 IExec->DebugPrintF(
618 "unhandled filehandle in afstat()\n");
619 return -1;
620 }
621 }
622 }
623
624 memset(statb, 0, sizeof(statb));
625
626 statb->st_mode = mode;
a83a2cd1
AB
627
628#endif
6c47084d 629 return 0;
a83a2cd1
AB
630}
631
632BPTR amigaos_get_file(int fd)
633{
6c47084d
JH
634 BPTR fh = (BPTR)NULL;
635 if (!(fh = _get_osfhandle(fd)))
636 {
637 switch (fd)
638 {
639 case 0:
640 fh = IDOS->Input();
641 break;
642 case 1:
643 fh = IDOS->Output();
644 break;
645 case 2:
646 fh = IDOS->ErrorOutput();
647 break;
648 default:
649 break;
650 }
651 }
652 return fh;
a83a2cd1 653}
1cd70adf
AB
654
655/*########################################################################*/
656
657#define LOCK_START 0xFFFFFFFFFFFFFFFELL
658#define LOCK_LENGTH 1LL
659
660// No wait forever option so lets wait for a loooong time.
661#define TIMEOUT 0x7FFFFFFF
662
663int amigaos_flock(int fd, int oper)
664{
6c47084d
JH
665 BPTR fh;
666 int32 success = -1;
667
668 if (!(fh = amigaos_get_file(fd)))
669 {
670 errno = EBADF;
671 return -1;
672 }
673
674 switch (oper)
675 {
676 case LOCK_SH:
677 {
678 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
679 REC_SHARED | RECF_DOS_METHOD_ONLY,
680 TIMEOUT))
681 {
682 success = 0;
683 }
684 break;
685 }
686 case LOCK_EX:
687 {
688 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
689 REC_EXCLUSIVE | RECF_DOS_METHOD_ONLY,
690 TIMEOUT))
691 {
692 success = 0;
693 }
694 break;
695 }
696 case LOCK_SH | LOCK_NB:
697 {
698 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
699 REC_SHARED_IMMED | RECF_DOS_METHOD_ONLY,
700 TIMEOUT))
701 {
702 success = 0;
703 }
704 else
705 {
706 errno = EWOULDBLOCK;
707 }
708 break;
709 }
710 case LOCK_EX | LOCK_NB:
711 {
712 if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH,
713 REC_EXCLUSIVE_IMMED | RECF_DOS_METHOD_ONLY,
714 TIMEOUT))
715 {
716 success = 0;
717 }
718 else
719 {
720 errno = EWOULDBLOCK;
721 }
722 break;
723 }
724 case LOCK_UN:
725 {
726 if (IDOS->UnLockRecord(fh, LOCK_START, LOCK_LENGTH))
727 {
728 success = 0;
729 }
730 break;
731 }
732 default:
733 {
734 errno = EINVAL;
735 return -1;
736 }
737 }
738 return success;
1cd70adf 739}