home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / src / pl-sys.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  5KB  |  239 lines
  1. /*  pl-sys.c,v 1.2 1993/02/23 13:16:47 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6. */
  7.  
  8. #include "pl-incl.h"
  9.  
  10. word
  11. pl_shell(command, status)
  12. Word command, status;
  13. { char *cmd = primitiveToString(*command, FALSE);
  14.  
  15.   if ( cmd == (char *) NULL )
  16.     return warning("shell/1: instantiation fault");
  17.  
  18.   return unifyAtomic(status, consNum(System(cmd)) );
  19. }
  20.  
  21. word
  22. pl_getenv(var, value)
  23. Word var, value;
  24. { char *n, *v;
  25.  
  26.   if ( (n = primitiveToString(*var, FALSE)) == (char *) NULL )
  27.     return warning("getenv/2: instantiation fault");
  28.  
  29.   if ((v = getenv(n)) == (char *) NULL)
  30.     fail;
  31.  
  32.   return unifyAtomic(value, lookupAtom(v));
  33. }  
  34.  
  35. word
  36. pl_setenv(var, value)
  37. Word var, value;
  38. { char *n, *v;
  39.  
  40.   initAllocLocal();
  41.   n = primitiveToString(*var, TRUE);
  42.   v = primitiveToString(*value, TRUE);
  43.   stopAllocLocal();
  44.  
  45.   if ( n == (char *)NULL || v == (char *) NULL )
  46.     return warning("setenv/2: instantiation fault");
  47.  
  48.   Setenv(n, v);
  49.  
  50.   succeed;
  51. }
  52.  
  53. word
  54. pl_unsetenv(var)
  55. Word var;
  56. { char *n;
  57.  
  58.   if ( (n = primitiveToString(*var, FALSE)) == (char *) NULL )
  59.     return warning("unsetenv/1: instantiation fault");
  60.  
  61.   Unsetenv(n);
  62.  
  63.   succeed;
  64. }
  65.  
  66. word
  67. pl_argv(list)
  68. Word list;
  69. { int n;
  70.   word w;
  71.  
  72.   for(n=0; n<mainArgc; n++)
  73.   { w = (word) lookupAtom(mainArgv[n]);
  74.     APPENDLIST(list, &w);
  75.   }
  76.   CLOSELIST(list);
  77.  
  78.   succeed;
  79. }
  80.  
  81. #if LINK_THIEF
  82. #define    POSTFIX    0
  83. #define    PREFIX    1
  84. #define    INFIX    2
  85.  
  86. int
  87. GetOp(token, type, lhs, op, rhs)
  88. char *token;
  89. int type, *lhs, *op, *rhs;
  90. { Atom name = lookupAtom(token);
  91.   int subtype;
  92.  
  93.   switch(type)
  94.   { case PREFIX:
  95.     if ( isPrefixOperator(name, &subtype, op) )
  96.     { *lhs = *rhs = (subtype == OP_FX ? *op - 1 : *op);
  97.       succeed;
  98.     }
  99.     fail;
  100.     case POSTFIX:
  101.     if ( isPostfixOperator(name, &subtype, op) )
  102.     { *lhs = *rhs = (subtype == OP_XF ? *op - 1 : *op);
  103.       succeed;
  104.     }
  105.     fail;
  106.     case INFIX:
  107.     if ( isInfixOperator(name, &subtype, op) )
  108.     { *lhs = (subtype == OP_XFY || subtype == OP_XFX ? *op - 1 : *op);
  109.       *rhs = (subtype == OP_XFX || subtype == OP_YFX ? *op - 1 : *op);
  110.       succeed;
  111.     }
  112.     fail;
  113.   }
  114.   return fatalError("Unknown operator type request from thief: %d", type);
  115. }
  116.  
  117. word
  118. pl_thief(args)
  119. Word args;
  120. { int argc = 0;
  121.   char *argv[50];
  122.   extern int thief();
  123.  
  124.   argv[argc++] = "top";
  125.  
  126.   while( isList(*args) )
  127.   { Word a = argTermP(*args, 0);
  128.     deRef(a);
  129.     if ( !isAtom(*a) )
  130.       return warning("thief/1: illegal argument list");
  131.     argv[argc++] = stringAtom(*a);
  132.     args = argTermP(*args, 1);
  133.     deRef(args);
  134.   }
  135.   if ( !isNil(*args) )
  136.     return warning("thief/1: illegal argument list");
  137.  
  138.   if ( thief(argc, argv) == 0 )
  139.     succeed;
  140.   fail;
  141. }
  142. #endif /* LINK_THIEF */
  143.  
  144. word
  145. pl_grep(file, search, line, h)
  146. Word file, search, line;
  147. word h;
  148. { char *fn;
  149.   FILE *fd;
  150.  
  151.   switch( ForeignControl(h) )
  152.   { case FRG_FIRST_CALL:
  153.       { if ( (fn = primitiveToString(*file, FALSE)) == (char *) NULL )
  154.       return warning("$grep/3: instantiation fault");
  155.     if ( (fn = ExpandOneFile(fn)) == (char *)NULL )
  156.       fail;
  157.     if ( (fd = Fopen(fn, "r")) == (FILE *) NULL )
  158.       return warning("$grep/3: cannot open %s: %s", fn, OsError());
  159.       }
  160.       goto redo;
  161.     case FRG_REDO:
  162.       { char buf[1024];
  163.     char *s;
  164.  
  165.     fd = (FILE *) ForeignContextAddress(h);
  166.       redo:
  167.     if ( (s = primitiveToString(*search, FALSE)) == (char *) NULL )
  168.       return warning("$grep/3: instantiation fault");
  169.     while( fgets(buf, 1023, fd) != (char *) NULL )
  170.     { if ( (*s == '^' && strprefix(buf, &s[1])) ||
  171.            strsub(buf, s) )
  172.       { for( s = buf; *s; s++ )    /* get rid of final newline */
  173.         { if ( *s == '\n' )
  174.           { *s = EOS;
  175.             break;
  176.           }
  177.         }          
  178.  
  179.         if ( unifyAtomic(line, globalString(buf)) == FALSE )
  180.           continue;
  181.  
  182.         ForeignRedo(fd);
  183.       }
  184.     }         
  185.     fclose(fd);
  186.  
  187.     fail;
  188.       }
  189.     case FRG_CUTTED:
  190.     default:;
  191.     fclose((FILE *)ForeignContextAddress(h));
  192.     succeed;
  193.   }
  194. }
  195.  
  196. word
  197. pl_convert_time(time, year, month, day, hour, minute, second, usec)
  198. Word time, year, month, day, hour, minute, second, usec;
  199. { if ( isReal(*time) )
  200.   { double tf = valReal(*time);
  201.     long t    = (long) tf;
  202.     long us   = (long)((tf - (double) t) * 1000.0);
  203.     struct tm *tm = LocalTime(&t);
  204.  
  205.     TRY(unifyAtomic(year,     consNum(tm->tm_year + 1900) ));
  206.     TRY(unifyAtomic(month,     consNum(tm->tm_mon + 1) ));
  207.     TRY(unifyAtomic(day,     consNum(tm->tm_mday) ));
  208.     TRY(unifyAtomic(hour,     consNum(tm->tm_hour) ));
  209.     TRY(unifyAtomic(minute,     consNum(tm->tm_min) ));
  210.     TRY(unifyAtomic(second,     consNum(tm->tm_sec) ));
  211.     TRY(unifyAtomic(usec,     consNum(us) ));
  212.     succeed;
  213.   } else
  214.     return warning("convert_time/8: instantiation fault");
  215. }
  216.  
  217. word
  218. pl_get_time(t)
  219. Word t;
  220. { struct timeval tp;
  221.   real time;
  222.  
  223.   gettimeofday(&tp, NULL);
  224.   time = (real)tp.tv_sec + (real)tp.tv_usec/1000000.0;
  225.   
  226.   return unifyAtomic(t, globalReal(time));
  227. }
  228.  
  229. word
  230. pl_sleep(time)
  231. Word time;
  232. { real t;
  233.  
  234.   TRY( wordToReal(*time, &t) );
  235.   Sleep(t);
  236.   
  237.   succeed;
  238. }
  239.