home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / C / Archimedes next >
Encoding:
Text File  |  1990-11-11  |  9.4 KB  |  545 lines
  1. /* $Header: archimedes.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
  2.  *
  3.  *    (C) Copyright 1989, 1990 Paul Moore.
  4.  *
  5.  *    You may distribute under the terms of the GNU General Public License
  6.  *    as specified in the README file that comes with the perl 3.0 kit.
  7.  *
  8.  * $Log:    archimedes.c,v $
  9.  * Revision 3.0.1.1  90/03/27  16:10:41  lwall
  10.  * patch16: MSDOS support
  11.  * 
  12.  * Revision 1.1  90/03/18  20:32:01  dds
  13.  * Initial revision
  14.  *
  15.  */
  16.  
  17. /*
  18.  * Various Unix compatibility functions for Archimedes RISC OS.
  19.  */
  20.  
  21. #include <limits.h>
  22.  
  23. #include "EXTERN.h"
  24. #include "perl.h"
  25.  
  26. /*
  27.  * Sleep function.
  28.  */
  29. void
  30. sleep(unsigned len)
  31. {
  32.     time_t end;
  33.  
  34.     end = time((time_t *)0) + len;
  35.     while (time((time_t *)0) < end)
  36.         ;
  37. }
  38.  
  39. /*
  40.  * Make and remove directories
  41.  */
  42. int
  43. mkdir(char *dir)
  44. {
  45.     int retval = 0;
  46.     int type;
  47.     _kernel_osfile_block blk;
  48.  
  49.     if ((type = _kernel_osfile(17,dir,&blk)) != 0)
  50.     {
  51.         err_no = 215;
  52.         sprintf(err_mess, "%s '%s' already exists",
  53.             type == 1 ? "File" : "Directory", dir);
  54.         retval = -1;
  55.     }
  56.  
  57.     blk.start = 0;
  58.     if (_kernel_osfile(8,dir,&blk) == _kernel_ERROR)
  59.     {
  60.         retval = -1;
  61.         save_err();
  62.     }
  63.  
  64.     return retval;
  65. }
  66.  
  67. int
  68. rmdir(char *dir)
  69. {
  70.     int retval = 0;
  71.     int type;
  72.     _kernel_osfile_block blk;
  73.  
  74.     /* Check that it's a directory */
  75.     if ((type = _kernel_osfile(17,dir,&blk)) != 2)
  76.     {
  77.         blk.load = type;
  78.         _kernel_osfile(19,dir,&blk);
  79.         retval = -1;
  80.     }
  81.     else if (_kernel_osfile(6,dir,&blk) == _kernel_ERROR)
  82.     {
  83.         retval = -1;
  84.     }
  85.  
  86.     if (retval == -1)
  87.         save_err();
  88.  
  89.     return retval;
  90. }
  91.  
  92. int
  93. unlink(char *file)
  94. {
  95.     int retval = 0;
  96.     _kernel_osfile_block blk;
  97.  
  98.     if (_kernel_osfile(6,file,&blk) == _kernel_ERROR)
  99.     {
  100.         save_err();
  101.         retval = -1;
  102.     }
  103.  
  104.     return retval;
  105. }
  106.  
  107. /*
  108.  * Set the timestamp for a file
  109.  */
  110. void
  111. stamp (char *file)
  112. {
  113.     _kernel_osfile_block blk;
  114.  
  115.     _kernel_osfile(9,file,&blk);
  116. }
  117.  
  118. /*
  119.  * Set environment variables
  120.  */
  121. void
  122. setenv(char *var, char *val)
  123. {
  124.     if (val)
  125.         _kernel_setenv(var,val);
  126.     else
  127.     {
  128.         _kernel_swi_regs regs;
  129.  
  130.         regs.r[0] = (int)var;
  131.         regs.r[1] = 0;
  132.         regs.r[2] = -1;
  133.         regs.r[3] = 0;
  134.         regs.r[4] = 0;
  135.         
  136.         _kernel_swi(OS_SetVarVal,®s,®s);
  137.     }
  138. }
  139.  
  140. /*
  141.  * The following code is based on the do_exec and do_aexec functions
  142.  * in file doio.c
  143.  */
  144. int
  145. do_aspawn(really,arglast)
  146. STR *really;
  147. int *arglast;
  148. {
  149.     USE(really);
  150.     return exec_cmdv(0, arglast);
  151. }
  152.  
  153. int
  154. do_spawn(cmd)
  155. char *cmd;
  156. {
  157.     register STR *str;
  158.     register int status;
  159.  
  160.     _kernel_setenv("Sys$ReturnCode","0");
  161.  
  162.     if (*cmd == '\0')
  163.     return 0;
  164.  
  165.     str = str_make("Call:",5);
  166.     str_cat(str,cmd);
  167.     status = system(str->str_ptr);
  168.     str_free(str);
  169.  
  170.     if (status == _kernel_ERROR)
  171.     save_err();
  172.  
  173.     return status;
  174. }
  175.  
  176. /*
  177.  * Generic exec- or spawn-type command execution.
  178.  */
  179. int
  180. exec_cmdv(chain,arglast)
  181. int chain;
  182. int *arglast;
  183. {
  184.     register STR **st = stack->ary_array;
  185.     register int sp = arglast[1];
  186.     register int items = arglast[2] - sp;
  187.     register char *a;
  188.     register char *arg;
  189.     STR *tmps;
  190.     int quotes;
  191.     int status = 0;
  192.  
  193.     if (items) {
  194.     st += ++sp;
  195.  
  196.     /* First, insert "Call:" */
  197.     tmps = str_make("Call:", 5);
  198.  
  199.     /* Now add the command name */
  200.     str_scat(tmps,*st);
  201.  
  202.     /* Now add each argument in turn */
  203.     for (--items, ++st; items > 0; --items, ++st) {
  204.         if (!*st)
  205.         continue;
  206.  
  207.         /* Separate with spaces */
  208.         str_ncat(tmps, " ", 1);
  209.  
  210.         arg = str_get(*st);
  211.  
  212.         /* Do we need to quote this arg? */
  213.         quotes = (index(arg,'"') || index(arg,' ') || index(arg,'\t'));
  214.  
  215.         if (!quotes)
  216.             str_scat(tmps, *st);
  217.         else {
  218.         str_ncat(tmps, "\"", 1);
  219.  
  220.         /* Add the argument string, backslashing " and \ */
  221.         while ((a = strpbrk(arg,"\"\\")) != Nullch) {
  222.             str_ncat(tmps, arg, a - arg);
  223.             str_ncat(tmps, "\\", 1);
  224.             str_ncat(tmps, a, 1);
  225.             arg = a + 1;
  226.         }
  227.  
  228.         str_cat(tmps, arg);
  229.         str_ncat(tmps, "\"", 1);
  230.         }
  231.     }
  232.  
  233.     _kernel_setenv("Sys$ReturnCode","0");
  234.     status = system(str_get(tmps));
  235.  
  236.     str_free(tmps);
  237.  
  238.     if (status == _kernel_ERROR)
  239.         save_err();
  240.     else if (chain)
  241.         exit(0);
  242.     }
  243.  
  244.     return status;
  245. }
  246.  
  247. /*
  248.  * Execute a new command, based on an argv array
  249.  */
  250. void
  251. execv(cmd,argv)
  252. char *cmd;
  253. char **argv;
  254. {
  255.     register char *a;
  256.     register char *arg;
  257.     STR *tmps;
  258.     int quotes;
  259.     int result;
  260.  
  261.     /* First, insert "Call:" */
  262.     tmps = str_make("Call:", 5);
  263.  
  264.     /* Now add the command name */
  265.     str_cat(tmps, cmd);
  266.  
  267.     /* Now add each argument in turn */
  268.     for (++argv; *argv; ++argv)
  269.     {
  270.     if (!**argv)
  271.         continue;
  272.  
  273.     /* Separate with spaces */
  274.     str_ncat(tmps, " ", 1);
  275.  
  276.     arg = *argv;
  277.  
  278.     /* Do we need to quote this arg? */
  279.     quotes = (index(arg,'"') || index(arg,' ') || index(arg,'\t'));
  280.  
  281.     if (!quotes)
  282.         str_cat(tmps, arg);
  283.     else {
  284.         str_ncat(tmps, "\"", 1);
  285.  
  286.         /* Add the argument string, backslashing " and \ */
  287.         while ((a = strpbrk(arg,"\"\\")) != Nullch) {
  288.         str_ncat(tmps, arg, a - arg);
  289.         str_ncat(tmps, "\\", 1);
  290.         str_ncat(tmps, a, 1);
  291.         arg = a + 1;
  292.         }
  293.  
  294.         str_cat(tmps, arg);
  295.         str_ncat(tmps, "\"", 1);
  296.     }
  297.     }
  298.  
  299.     _kernel_setenv("Sys$ReturnCode","0");
  300.  
  301.     result = system(str_get(tmps));
  302.     str_free(tmps);
  303.  
  304.     if (result != _kernel_ERROR)
  305.     exit(0);
  306.     else
  307.     save_err();
  308. }
  309.  
  310. #define SECS1970 2208988800.0 /* Number of seconds from 1/1/1900 to 1/1/1970 */
  311.  
  312. /*
  313.  * Get a file's catalogue information
  314.  */
  315. int
  316. stat (char *file, struct stat *buf)
  317. {
  318.     int res;
  319.     _kernel_osfile_block blk;
  320.  
  321.     res = _kernel_osfile(5,file,&blk);
  322.  
  323.     if (res == _kernel_ERROR || res == 0)
  324.         return -1;
  325.  
  326.     buf->st_type = res;
  327.     buf->st_load = blk.load;
  328.     buf->st_exec = blk.exec;
  329.     buf->st_length = blk.start;
  330.     buf->st_attr = blk.end;
  331.  
  332.     if ((blk.load & 0xFFF00000) != 0xFFF00000)
  333.     {
  334.         buf->st_ftype = -1;
  335.         buf->st_time = 0.0;
  336.         buf->st_utime = 0;
  337.     }
  338.     else
  339.     {
  340.         double n;
  341.         buf->st_ftype = ((blk.load >> 8) & 0xFFF);
  342.         n = (double)((unsigned)(blk.load & 0xFF));
  343.         n *= 4294967296.0;    /* 2^32 */
  344.         n += (double)((unsigned)blk.exec);
  345.         buf->st_time = n;
  346.         n /= 100.0;
  347.         n -= SECS1970;
  348.  
  349.         if (n < 0.0)
  350.         {
  351.             n = 0.0;
  352.             if (dowarn)
  353.                 warn("Timestamp too small in stat (%s): set to %d\n",
  354.                     file, n);
  355.         }
  356.         else if (n > (double)UINT_MAX)
  357.         {
  358.             n = (double)UINT_MAX;
  359.             if (dowarn)
  360.                 warn("Timestamp too large in stat (%s): set to %d\n",
  361.                     file, n);
  362.         }
  363.  
  364.         buf->st_utime = (time_t)n;
  365.     }
  366.  
  367.     return 0;
  368. }
  369.  
  370. /*
  371.  * Scan through the OS variables selected by a pattern
  372.  */
  373. char *
  374. getenvar (char *pat, char **val)
  375. {
  376.     static char buffer[255];
  377.     static char *pattern;
  378.     static char *name_ptr;
  379.     _kernel_swi_regs regs;
  380.  
  381.     if (pat)
  382.     {
  383.         pattern = pat;
  384.         name_ptr = 0;
  385.     }
  386.  
  387.     regs.r[0] = (int)pattern;
  388.     regs.r[1] = (int)buffer;
  389.     regs.r[2] = 255;
  390.     regs.r[3] = (int)name_ptr;
  391.     regs.r[4] = 3;
  392.  
  393.     if (_kernel_swi(OS_ReadVarVal,®s,®s))
  394.         return 0;
  395.  
  396.     name_ptr = (char *)regs.r[3];
  397.     buffer[regs.r[2]] = '\0';
  398.  
  399.     *val = buffer;
  400.     return name_ptr;
  401. }
  402.  
  403. /*
  404.  * Save the last OS error return value
  405.  */
  406. void
  407. save_err (void)
  408. {
  409.     _kernel_oserror *err = _kernel_last_oserror();
  410.  
  411.     if (err)
  412.     {
  413.         err_no = err->errnum;
  414.         strcpy(err_mess, err->errmess);
  415.     }
  416.     else
  417.     {
  418.         err_no = 0;
  419.         strcpy(err_mess, "");
  420.     }
  421. }
  422.  
  423. /*
  424.  * Get the program start time (as a double)
  425.  */
  426. void os_starttime (double *dp)
  427. {
  428.     int i;
  429.     double tmp;
  430.     unsigned char *time;
  431.  
  432.     _kernel_swi_regs regs;
  433.     _kernel_oserror *err = _kernel_swi(OS_GetEnv, ®s, ®s);
  434.  
  435.     if (err)
  436.     {
  437.         err_no = err->errnum;
  438.         strcpy(err_mess, err->errmess);
  439.         *dp = 0.0;
  440.         return;
  441.     }
  442.  
  443.     time = (unsigned char *) regs.r[2];
  444.     tmp = 0.0;
  445.  
  446.     for (i = 4; i >= 0; --i)
  447.     {
  448.         tmp *= 256.0;
  449.         tmp += (double)(time[i]);
  450.     }
  451.  
  452.     *dp = tmp;
  453. }
  454.  
  455. /* Rename a file. If a simple OS rename fails, the file is copied.
  456.  * This allows renames across filing system boundaries.
  457.  * If the destination filename exists, the function deletes it (even
  458.  * if locked) first.
  459.  * This function does its best to be totally paranoid about errors, and
  460.  * returns failure if the rename does not work.
  461.  * Returns 0 on success, 1 on failure.
  462.  */
  463. int frename(const char *old, const char *new)
  464. {
  465.     register int result;
  466.     register int n;
  467.     FILE *in, *out;
  468.     _kernel_osfile_block blk;
  469.     char buf[BUFSIZ];
  470.  
  471.     /* Check the new file. If it exists, and is not a directory,
  472.      * unlock it (if necessary) and delete it.
  473.      */
  474.     result = _kernel_osfile (17, new, &blk);
  475.  
  476.     /* If the file is a directory, or an error occurred, return failure */
  477.     if (result == 2 || result == _kernel_ERROR)
  478.         return 1;
  479.  
  480.     /* If the file exists and is locked, unlock it */
  481.     if (result == 1 && (blk.end & 0x0008) != 0)
  482.     {
  483.         blk.end &= ~0x0008;
  484.         if (_kernel_osfile(4, new, &blk) == _kernel_ERROR)
  485.             return 1;
  486.     }
  487.  
  488.     /* If the file exists, delete it */
  489.     if (result == 1 && _kernel_osfile(6, new, &blk) == _kernel_ERROR)
  490.         return 1;
  491.  
  492.     /* Now try a simple OS rename */
  493.     if (rename(old, new) == 0)
  494.         return 0;
  495.  
  496.     /* No luck. Get the old file attributes (to ensure that it exists,
  497.      * and is not locked, and for later copying to the new file).
  498.      */
  499.     result = _kernel_osfile (17, old, &blk);
  500.  
  501.     /* If the file is not a simple file, or an error occurred,
  502.      * or the file is locked, return failure.
  503.      */
  504.     if (result != 1 || (blk.end & 0x0008) != 0)
  505.         return 1;
  506.     
  507.     /* Now prepare to copy the file */
  508.     if ((in = fopen(old, "rb")) == NULL)
  509.         return 1;
  510.  
  511.     if ((out = fopen(new, "wb")) == NULL)
  512.     {
  513.         fclose(in);
  514.         return 1;
  515.     }
  516.  
  517.     /* Copy the file */
  518.     while (!feof(in))
  519.     {
  520.         n = fread(buf, 1, BUFSIZ, in);
  521.         if (ferror(in) || fwrite(buf, 1, n, out) != n)
  522.         {
  523.             fclose(in);
  524.             fclose(out);
  525.             remove(new);
  526.             return 1;
  527.         }
  528.     }
  529.  
  530.     if (ferror(in) || fclose(in) == EOF || ferror(out) || fclose(out) == EOF)
  531.     {
  532.         remove(new);
  533.         return 1;
  534.     }
  535.  
  536.     /* Now copy the file attributes across, and delete the old
  537.      * file. Don't worry about errors - they're not too serious,
  538.      * and it's too late to do much anyway.
  539.      */
  540.     _kernel_osfile(1, new, &blk);
  541.     _kernel_osfile(6, old, &blk);
  542.  
  543.     return 0;
  544. }
  545.