home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / sys.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  5.8 KB  |  287 lines  |  [TEXT/R*ch]
  1. /* Basic system calls */
  2.  
  3. #include <errno.h>
  4. #include <sys/types.h>
  5. #include <fcntl.h>
  6. #include <signal.h>
  7. #include "config.h"
  8. #include "alloc.h"
  9. #include "fail.h"
  10. #include "globals.h"
  11. #include "instruct.h"
  12. #include "mlvalues.h"
  13. #include "signals.h"
  14. #include "stacks.h"
  15. #include "io.h"
  16.  
  17. #ifdef HAS_STRERROR
  18.  
  19. extern char * strerror();
  20.  
  21. char * error_message()
  22. {
  23.   return strerror(errno);
  24. }
  25.  
  26. #else
  27.  
  28. extern int sys_nerr;
  29. extern char * sys_errlist [];
  30.  
  31. char * error_message()
  32. {
  33.   if (errno < 0 || errno >= sys_nerr)
  34.     return "unknown error";
  35.   else
  36.     return sys_errlist[errno];
  37. }
  38.  
  39. #endif /* HAS_STRERROR */
  40.  
  41. void sys_error(arg)
  42.      char * arg;
  43. {
  44.   char * err = error_message();
  45.   value exnarg;
  46.  
  47.   /* Raise SysErr with argument (err, SOME errno) */
  48.  
  49.   Push_roots(r, 2);
  50.   r[0] = copy_string(err);    /* The error message string    */
  51.  
  52.   r[1] = alloc(1, SOMEtag);    /* The SOME errno object    */
  53.   Field(r[1], 0) = Val_long(errno);
  54.  
  55.   exnarg = alloc_tuple(2);    /* The argument tuple        */
  56.   Field(exnarg, 0) = r[0];
  57.   Field(exnarg, 1) = r[1];
  58.   Pop_roots();
  59.  
  60.   raise_with_arg(SYS_ERROR_EXN, exnarg);
  61. }
  62.  
  63. void sys_exit(retcode)          /* ML */
  64.      value retcode;
  65. {
  66.   flush_stdouterr();
  67.   exit(Int_val(retcode));
  68. }
  69.  
  70. #ifndef O_BINARY
  71. #define O_BINARY 0
  72. #endif
  73. #ifndef O_TEXT
  74. #define O_TEXT 0
  75. #endif
  76.  
  77. static int sys_open_flags[] = {
  78.   O_RDONLY, O_WRONLY, O_RDWR, O_APPEND, O_CREAT, O_TRUNC, O_EXCL,
  79.   O_BINARY, O_TEXT
  80. };
  81. #ifdef macintosh
  82. static int sys_text_flags []  = { 0, 0, 0, 0, 0, 0, 0, 0, 1 };
  83. static int sys_write_flags [] = { 0, 1, 1, 0, 0, 0, 0, 0, 0 };
  84. #endif
  85.  
  86. value sys_open(path, flags, perm) /* ML */
  87.      value path, flags, perm;
  88. {
  89.   int ret;
  90. #ifdef macintosh
  91.   extern void set_file_type (char *name, long type);
  92. #if defined(THINK_C) || defined(__MWERKS__)
  93. # define FILE_NAME_SIZE 256
  94.   char filename_temp[FILE_NAME_SIZE];
  95.   char *expanded;
  96.   extern char *unix_to_mac_filename(char *, char *, int);
  97.   expanded = unix_to_mac_filename(String_val(path), filename_temp, FILE_NAME_SIZE);
  98.   if (expanded == NULL)
  99.     ret = -1;
  100.   else
  101.     ret = open(expanded, convert_flag_list(flags, sys_open_flags));
  102.   if ( ret != -1 && convert_flag_list (flags, sys_text_flags)
  103.                    && convert_flag_list (flags, sys_write_flags))
  104.     set_file_type (expanded, 'TEXT');
  105. #else
  106.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags));
  107.   if (ret != -1 && convert_flag_list (flags, sys_text_flags))
  108.     set_file_type (String_val (path), 'TEXT');
  109. #endif
  110. #else
  111.   ret = open(String_val(path), convert_flag_list(flags, sys_open_flags),
  112.              Int_val(perm));
  113. #endif
  114.   if (ret == -1) sys_error(String_val(path));
  115.   return Val_long(ret);
  116. }
  117.  
  118. value sys_close(fd)             /* ML */
  119.      value fd;
  120. {
  121.   if (close(Int_val(fd)) != 0) sys_error(NULL);
  122.   return Atom(0);
  123. }
  124.  
  125. value sys_remove(name)          /* ML */
  126.      value name;
  127. {
  128.   int ret;
  129.   ret = unlink(String_val(name));
  130.   if (ret != 0) sys_error(String_val(name));
  131.   return Atom(0);
  132. }
  133.  
  134. value sys_rename(oldname, newname) /* ML */
  135.      value oldname, newname;
  136. {
  137. #ifdef HAS_RENAME
  138.   if (rename(String_val(oldname), String_val(newname)) != 0) 
  139.     sys_error(String_val(oldname));
  140. #else
  141.   invalid_argument("rename: not implemented");
  142. #endif
  143.   return Atom(0);
  144. }
  145.  
  146. value sys_chdir(dirname)        /* ML */
  147.      value dirname;
  148. {
  149.   if (chdir(String_val(dirname)) != 0) sys_error(String_val(dirname));
  150.   return Atom(0);
  151. }
  152.  
  153. extern char * getenv();
  154.  
  155. value sys_getenv(var)           /* ML */
  156.      value var;
  157. {
  158.   char * res;
  159.  
  160.   res = getenv(String_val(var));
  161.   if (res == 0) {
  162.     mlraise(Atom(NOT_FOUND_EXN));
  163.   }
  164.   return copy_string(res);
  165. }
  166.  
  167. value sys_system_command(command)   /* ML */
  168.      value command;
  169. {
  170.   int retcode = system(String_val(command));
  171.   if (retcode == -1) sys_error(String_val(command));
  172.   return Val_int(retcode);
  173. }
  174.  
  175. static int sys_var_init[] = {
  176.   0400, 0200, 0100,
  177.   0040, 0020, 0010,
  178.   0004, 0002, 0001,
  179.   04000, 02000,
  180.   0444, 0222, 0111
  181. };
  182.  
  183. void sys_init(argv)
  184.      char ** argv;
  185. {
  186.   value v;
  187.   int i;
  188.  
  189.   #ifndef MSDOS
  190.   void init_float_handler();
  191.   init_float_handler();
  192.   #endif
  193.  
  194.   v = copy_string_array(argv);
  195.   modify(&Field(global_data, SYS__COMMAND_LINE), v);
  196.   for (i = SYS__S_IRUSR; i <= SYS__S_IXALL; i++)
  197.     Field(global_data, i) = Val_long(sys_var_init[i - SYS__S_IRUSR]);
  198.   Field(global_data, SYS__INTERACTIVE) = Val_false;
  199.   Field(global_data, SYS__MAX_VECT_LENGTH) = Val_long(Max_wosize);
  200.   Field(global_data, SYS__MAX_STRING_LENGTH) =
  201.     Val_long(Max_wosize * sizeof(value) - 2);
  202. }
  203.  
  204. /* Handling of user interrupts and floating-point errors */
  205.  
  206. #ifndef MSDOS
  207.  
  208. unsigned char raise_break_exn[] = { ATOM, BREAK_EXN, RAISE };
  209.  
  210. sighandler_return_type intr_handler(sig)
  211.      int sig;
  212. {
  213. #ifndef BSD_SIGNALS
  214.   signal (SIGINT, intr_handler);
  215. #endif
  216.   signal_handler = raise_break_exn;
  217.   signal_number = 0;
  218.   execute_signal();
  219. }
  220.  
  221. value sys_catch_break(onoff)    /* ML */
  222.      value onoff;
  223. {
  224.   if (Tag_val(onoff))
  225.     signal(SIGINT, intr_handler);
  226.   else
  227.     signal(SIGINT, SIG_DFL);
  228.   return Atom(0);
  229. }
  230.  
  231. sighandler_return_type float_handler(sig)
  232.      int sig;
  233. {
  234. #ifndef BSD_SIGNALS
  235.   signal (SIGFPE, float_handler);
  236. #endif
  237.   if (float_exn == FAILURE_EXN)
  238.     failwith("floating point error");
  239.   else
  240.     mlraise(Atom(float_exn));
  241. }
  242.  
  243. void init_float_handler()
  244. {
  245.   signal(SIGFPE, float_handler);
  246. }
  247. #endif
  248.  
  249. /* Search path function */
  250.  
  251. #ifndef MSDOS
  252. #ifndef macintosh
  253.  
  254. char * searchpath(name)
  255.      char * name;
  256. {
  257.   static char fullname[512];
  258.   char * path;
  259.   char * p;
  260.   char * q;
  261.  
  262.   for (p = name; *p != 0; p++) {
  263.     if (*p == '/') return name;
  264.   }
  265.   path = getenv("PATH");
  266.   if (path == 0) return 0;
  267.   while(1) {
  268.     p = fullname;
  269.     while (*path != 0 && *path != ':') {
  270.       *p++ = *path++;
  271.     }
  272.     if (p != fullname) *p++ = '/';
  273.     q = name;
  274.     while (*q != 0) {
  275.       *p++ = *q++;
  276.     }
  277.     *p = 0;
  278.     if (access(fullname, 1) == 0) return fullname;
  279.     if (*path == 0) return 0;
  280.     path++;
  281.   }
  282. }
  283.  
  284. #endif
  285. #endif
  286.  
  287.