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-os.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  60KB  |  2,789 lines
  1. /*  pl-os.c,v 1.18 1993/02/23 13:16:39 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.     Purpose: Operating System Dependencies
  8. */
  9.  
  10. /*  Modified (M) 1993 Dave Sherratt  */
  11.  
  12. #if __TOS__
  13. #include <tos.h>        /* before pl-os.h due to Fopen, ... */
  14. static long    wait_ticks;    /* clock ticks not CPU time */
  15. #endif
  16. #if OS2 && EMX
  17. #include <os2.h>                /* this has to appear before pl-incl.h */
  18. #endif
  19. #include "pl-incl.h"
  20. #include "pl-ctype.h"
  21. #include "pl-itf.h"
  22.  
  23. #if unix || EMX
  24. #include <sys/param.h>
  25. #include <sys/stat.h>
  26. #include <pwd.h>
  27. #include <sys/file.h>
  28. #include <unistd.h>
  29. #endif
  30.  
  31. #if sun
  32. extern int fstat(/*int, struct stat **/);
  33. extern int stat(/*char *, struct stat**/);
  34. extern int unlink(/*char **/);
  35. extern int link(/*char **/);
  36. extern int select(/*int *, int*, int*, struct timeval **/);
  37. extern int ioctl(/*int, int, Void*/);
  38. extern int execl(/*char *, ... */);
  39. extern int srandom P((long));
  40. extern int random P((void));
  41. #endif
  42.  
  43. #if OS2 && EMX
  44. static real initial_time;
  45. #endif /* OS2 */
  46.  
  47. forwards void    initExpand P((void));
  48. forwards void    initRandom P((void));
  49. forwards void    initEnviron P((void));
  50. forwards char *    okToExec P((char *));
  51. forwards char *    Which P((char *));
  52. forwards Char    do_get_char P((void));
  53.  
  54. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  55. This module is a contraction of functions that used to be all  over  the
  56. place.   together  with  pl-os.h  (included  by  pl-incl.h) this file
  57. should define a basic  layer  around  the  OS,  on  which  the  rest  of
  58. SWI-Prolog  is  based.   SWI-Prolog  has  been developed on SUN, running
  59. SunOs 3.4 and later 4.0.
  60.  
  61. Unfortunately some OS's simply do not offer  an  equivalent  to  SUN  os
  62. features.   In  most  cases part of the functionality of the system will
  63. have to be dropped. See the header of pl-incl.h for details.
  64. - - - - - - - - - - -  - - - - - */
  65.  
  66.         /********************************
  67.         *         INITIALISATION        *
  68.         *********************************/
  69.  
  70. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  71.     bool initOs()
  72.  
  73.     Initialise the OS dependant functions.
  74. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  75.  
  76. bool
  77. initOs()
  78. { DEBUG(1, printf("OS:initExpand() ...\n"));
  79.   initExpand();
  80.   DEBUG(1, printf("OS:initRandom() ...\n"));
  81.   initRandom();
  82.   DEBUG(1, printf("OS:initEnviron() ...\n"));
  83.   initEnviron();
  84.  
  85. #if tos
  86.   wait_ticks = clock();
  87. #endif
  88. #if OS2
  89.   {
  90.     DATETIME i;
  91.     DosGetDateTime((PDATETIME)&i);
  92.     initial_time = (i.hours * 3600.0) 
  93.                    + (i.minutes * 60.0) 
  94.            + i.seconds
  95.            + (i.hundredths / 100.0);
  96.   }
  97. #endif /* OS2 */
  98.   DEBUG(1, printf("OS:done\n"));
  99.  
  100.   succeed;
  101. }
  102.  
  103.  
  104. typedef void (*halt_function) P((int, Void));
  105. typedef struct on_halt *OnHalt;
  106.  
  107. struct on_halt
  108. { halt_function    function;
  109.   Void        argument;
  110.   OnHalt    next;
  111. };
  112.  
  113. static OnHalt on_halt_list;
  114.  
  115. void
  116. PL_on_halt(f, arg)
  117. halt_function f;
  118. Void arg;
  119. { OnHalt h = allocHeap(sizeof(struct on_halt));
  120.  
  121.   h->function = f;
  122.   h->argument = arg;
  123.   h->next = on_halt_list;
  124.   on_halt_list = h;
  125. }
  126.  
  127.  
  128. volatile void
  129. Halt(status)
  130. int status;
  131. { OnHalt h;
  132.  
  133.   for(h = on_halt_list; h; h = h->next)
  134.     (*h->function)(status, h->argument);
  135.  
  136.   dieIO();
  137.   RemoveTemporaryFiles();
  138.  
  139.   exit(status);
  140.   /*NOTREACHED*/
  141. }
  142.  
  143.         /********************************
  144.         *            OS ERRORS          *
  145.         *********************************/
  146.  
  147. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  148.     char *OsError()
  149.     Return a char *, holding a description of the last OS call error.
  150. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  151.  
  152. char *
  153. OsError()
  154. { static char errmsg[64];
  155.  
  156. #if unix
  157.   extern int sys_nerr;
  158. #if !EMX
  159.   extern char *sys_errlist[];
  160. #endif
  161.   extern int errno;
  162.  
  163.   if ( errno < sys_nerr )
  164.     return sys_errlist[errno];
  165. #endif
  166.  
  167. #if tos
  168.   if ( errno < sys_nerr )
  169.     return strerror(errno);
  170. #endif
  171.  
  172.   sprintf(errmsg, "Unknown Error (%d)", errno);
  173.   return errmsg;
  174. }
  175.  
  176.         /********************************
  177.         *    PROCESS CHARACTERISTICS    *
  178.         *********************************/
  179.  
  180. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  181.     real CpuTime()
  182.  
  183.     Returns a floating point number, representing the amount  of  (user)
  184.     CPU-seconds  used  by the process Prolog is in.  For systems that do
  185.     not allow you to obtain this information  you  may  wish  to  return
  186.     elapsed  time  since Prolog was started, as this function is used to
  187.     by consult/1 and time/1 to determine the amount of CPU time used  to
  188.     consult a file or to execute a query.
  189. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  190.  
  191. #if unix
  192. #ifdef HZ
  193. #  define Hz HZ
  194. #else
  195. #  define Hz        60
  196. #endif
  197. #include <sys/times.h>
  198. #endif
  199.  
  200.  
  201. real
  202. CpuTime()
  203. {
  204. #if unix
  205.   struct tms t;
  206.  
  207.   times(&t);
  208.  
  209.   return t.tms_utime / ( real )( Hz ) ;
  210. #endif
  211.  
  212. #if OS2 && EMX
  213.   DATETIME i;
  214.  
  215.   DosGetDateTime((PDATETIME)&i);
  216.   return (((i.hours * 3600) 
  217.                  + (i.minutes * 60) 
  218.          + i.seconds
  219.              + (i.hundredths / 100.0)) - initial_time);
  220. #endif
  221.  
  222. #if tos
  223.   return (real) (clock() - wait_ticks) / 200.0;
  224. #endif
  225. }
  226.  
  227.         /********************************
  228.         *       MEMORY MANAGEMENT       *
  229.         *********************************/
  230.  
  231. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  232.     long *Allocate(n)
  233.       long n;
  234.  
  235.     Allocate a memory area of `n' bytes from the operating system.   `n'
  236.     is a long as we need to allocate one uniform array of longs for both
  237.     the  local  stack  and  global  stack,  which  implies  it should be
  238.     possible to allocate at least a few hundred Kbytes.  If  you  cannot
  239.     implement  this  function  you  are in deep trouble.  You either can
  240.     decide to redesign large part of the data representation, or  forget
  241.     about  SWI-Prolog.   Memory  is never returned to the system.  As it
  242.     would only concern small areas,  all  over  SWI-Prolog's  memory  no
  243.     currently  available operating system (I'm aware of) will be able to
  244.     handle it anyway.  THE RETURN VALUE SHOULD BE ROUNDED TO BE A  VALID
  245.     POINTER FOR LONGS AND STRUCTURES AND AT LEAST A MULTIPLE OF 4.
  246. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  247.  
  248. Void
  249. Allocate(n)
  250. long n;
  251. { Void mem = Malloc(n);
  252.  
  253.   SECURE(assert(malloc_verify() == 1));
  254.  
  255.   return (Void) mem;
  256. }
  257.  
  258. #if hpux
  259. #include <a.out.h>
  260. int
  261. getpagesize()
  262. {  
  263. #ifdef EXEC_PAGESIZE
  264.   return EXEC_PAGESIZE;
  265. #else
  266.   return 4096;                /* not that important */
  267. #endif
  268. }
  269. #endif
  270.  
  271. #if hpux || tos
  272. void
  273. bzero(p, n)
  274. Void p;
  275. register size_t n;
  276. { char *s = p;
  277.  
  278.   while( n-- > 0 )
  279.     *s++ = '\0';
  280. }
  281. #endif
  282.  
  283.  
  284.         /********************************
  285.         *             PRINT             *
  286.         *********************************/
  287.  
  288. #if gould
  289. char *
  290. vsprintf(buf, fm, args)
  291. char *buf, *fm;
  292. va_list args;
  293. { FILE f;
  294. #define BIGBUF 10000000
  295.  
  296.   f._cnt    = BIGBUF;        /* Hack oh dear hack!!! */
  297.   f._ptr    = f._base = buf;    /* down with gould (they are in military */
  298.   f._bufsiz = BIGBUF;        /* bussiness anyway!) */
  299.   f._flag   = 0;         /* was _IOLBF; */
  300.   f._file   = '\0';
  301.   
  302.   DEBUG(9, printf("calling _doprnt(%s, ...)\n", fm));
  303.   _doprnt(fm, args, &f);
  304.   *f._ptr++ = '\0';
  305.  
  306.   return buf;
  307. }
  308.  
  309. int
  310. vfprintf(fd, fm, args)
  311. FILE *fd;
  312. char *fm;
  313. va_list args;
  314. { return _doprnt(fm, args, fd);
  315. }
  316. #endif
  317.  
  318.         /********************************
  319.         *     STRING MANIPULATION    *
  320.         ********************************/
  321.  
  322. #if sun
  323. int
  324. strcmp(s1, s2)
  325. unsigned char *s1, *s2;
  326. { while(*s1 && *s1 == *s2)
  327.     s1++, s2++;
  328.  
  329.   return *s1 - *s2;
  330. }
  331. #endif
  332.  
  333.  
  334.         /********************************
  335.         *           ARITHMETIC          *
  336.         *********************************/
  337.  
  338. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  339.     long Random()
  340.  
  341.     Return a random number. Used for arithmetic only.
  342. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  343.  
  344. static void
  345. initRandom()
  346. {
  347. #ifdef SRANDOM
  348.   SRANDOM(Time());
  349. #else
  350.   srand((unsigned)Time());
  351. #endif
  352. }
  353.  
  354. long
  355. Random()
  356. { 
  357. #ifdef RANDOM
  358.   return RANDOM();
  359. #else
  360.   return rand();
  361. #endif
  362. }
  363.  
  364.         /********************************
  365.         *             FILES             *
  366.         *********************************/
  367.  
  368.       /* (Everything you always wanted to know about files ...) */
  369.  
  370. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  371. Generation and administration of temporary files.  Currently  only  used
  372. by  the foreign language linker.  It might be useful to make a predicate
  373. available to the Prolog user based on these functions.  These  functions
  374. are  in  this  module as non-UNIX OS probably don't have getpid() or put
  375. temporaries on /tmp.
  376.  
  377.     Atom TemporaryFile(id)
  378.      char *id;
  379.  
  380.     The return value of this call is an atom,  whose  string  represents
  381.     the  path  name of a unique file that can be used as temporary file.
  382.     `id' is a char * that can be used to make it easier to identify  the
  383.     file as a specific kind of SWI-Prolog intermediate file.
  384.  
  385.     void RemoveTemporaryFiles()
  386.  
  387.     Remove all temporary files.  This function should be  aware  of  the
  388.     fact  that some of the file names generated by TemporaryFile() might
  389.     not be created at all, or might already have been deleted.
  390. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  391.  
  392. typedef struct tempfile * TempFile;
  393.  
  394. static struct tempfile
  395. { Atom         name;
  396.   TempFile    next;
  397. } *tempfiles, *temptail;        /* chain of temporary files */
  398.  
  399. Atom
  400. TemporaryFile(id)
  401. char *id;
  402. { static char temp[MAXPATHLEN];
  403.   TempFile tf = (TempFile) allocHeap(sizeof(struct tempfile));
  404.  
  405. #if unix
  406.   static int temp_counter = 0;
  407.   sprintf(temp, "/tmp/pl_%s_%d_%d", id, getpid(), temp_counter++);
  408. #endif
  409.  
  410. #if EMX
  411.   static int temp_counter = 0;
  412.   char *foo;
  413.  
  414.   if ( (foo = tempnam(".", (const char *)id)) )
  415.   { strcpy(temp, foo);
  416.     free(foo);
  417.   } else
  418.     sprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++);
  419. #endif
  420.  
  421. #if tos
  422.   tmpnam(temp);
  423. #endif
  424.  
  425.   tf->name = lookupAtom(temp);
  426.   tf->next = (TempFile) NULL;
  427.   
  428.   if ( temptail == (TempFile) NULL )
  429.   { tempfiles = temptail = tf;
  430.   } else
  431.   { temptail->next = tf;
  432.     temptail = tf;
  433.   }
  434.  
  435.   return tf->name;
  436. }
  437.  
  438. void
  439. RemoveTemporaryFiles()
  440. { TempFile tf, tf2;  
  441.  
  442.   for(tf = tempfiles; tf; tf = tf2)
  443.   { DeleteFile(stringAtom(tf->name));
  444.     tf2 = tf->next;
  445.     freeHeap(tf, sizeof(struct tempfile));
  446.   }
  447.  
  448.   tempfiles = temptail = (TempFile) NULL;
  449. }
  450.  
  451. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  452. Fortunately most C-compilers  are  sold  with  a  library  that  defines
  453. Unix-style  access  to  the  file system.  The standard functions go via
  454. macros to deal with 16-bit machines, but are not  defined  as  functions
  455. here.   Some  more  specific things SWI-Prolog wants to know about files
  456. are defined here:
  457.  
  458.     int  GetDTableSize()
  459.  
  460.     SWI-Prolog assumes it can refer to open i/o streams via  read()  and
  461.     write() by small integers, returned by open(). These integers should
  462.     be  in  the range [0, ..., GetDTableSize()). If your system does not
  463.     do this you better redefine the Open(), Read() and Write() macros so
  464.     they  do  meat  this  requirement.   Prolog  allocates  a  table  of
  465.     structures with GetDTableSize entries.
  466.  
  467.     long LastModifiedFile(path)
  468.      char *path;
  469.  
  470.     Returns the last time `path' has been modified.  Used by the  source
  471.     file administration to implement make/0.
  472.  
  473.     bool ExistsFile(path)
  474.      char *path;
  475.  
  476.     Succeeds if `path' refers to the pathname of a regular file  (not  a
  477.     directory).
  478.  
  479.     bool AccessFile(path, mode)
  480.      char *path;
  481.      int mode;
  482.  
  483.     Succeeds if `path' is the pathname of an existing file and it can
  484.     be accessed in any of the inclusive or constructed argument `mode'.
  485.  
  486.     bool ExistsDirectory(path)
  487.      char *path;
  488.  
  489.     Succeeds if `path' refers to the pathname  of  a  directory.
  490.  
  491.     bool DeleteFile(path)
  492.      char *path;
  493.  
  494.     Removes a (regular) file from the  file  system.   Returns  TRUE  if
  495.     succesful FALSE otherwise.
  496.  
  497.     bool RenameFile(old, new)
  498.      char *old, *new;
  499.  
  500.     Rename file from name `old' to name `new'. If new already exists, it is
  501.     deleted. Returns TRUE if succesful, FALSE otherwise.
  502.  
  503.     bool OpenStream(stream)
  504.      int stream;
  505.  
  506.     Succeeds if `stream' refers to an open i/o stream.
  507.  
  508.     bool MarkExecutable(path)
  509.      char *path;
  510.  
  511.     Mark `path' as an executable program.  Used by the intermediate code
  512.     compiler and the creation of stand-alone executables.
  513. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  514.  
  515. int
  516. GetDTableSize()
  517. {
  518. #ifdef DESCRIPTOR_TABLE_SIZE
  519.   return DESCRIPTOR_TABLE_SIZE;
  520. #else
  521. #  if hpux
  522. #    include <sys/resource.h>
  523.      struct rlimit rlp;
  524.      (void) getrlimit(RLIMIT_NOFILE,&rlp);
  525.      return (rlp.rlim_cur);
  526. #  else
  527.      extern int getdtablesize P((void));
  528.  
  529.      return getdtablesize();
  530. #  endif
  531. #endif
  532. }
  533.  
  534. /* ********************************************************************
  535.    Design Note -- atoenne@mpi-sb.mpg.de --
  536.  
  537.    Beware! OsPath() and PrologPath() are insecure functions.
  538.    Make sure that you copy the result of these functions to a proper location
  539.    before you call the functions again. Otherwise you will write over the
  540.    former result.
  541.    ******************************************************************** */
  542.  
  543. #if tos
  544. char *
  545. PrologPath(char *tospath)
  546. { static char path[MAXPATHLEN];
  547.   register char *s = tospath, *p = path;
  548.  
  549.   for(; *s; s++, p++)
  550.     *p = (*s == '\\' ? '/' : makeLower(*s));
  551.   *p = EOS;
  552.  
  553.   return path;
  554. }
  555.  
  556.  
  557. char *
  558. OsPath(char *unixpath)
  559. { static char path[MAXPATHLEN];
  560.   register char *s = unixpath, *p = path;
  561.  
  562.   if ( isLetter(s[0]) && s[1] == ':' )        /* drive indicator */
  563.   { *p++ = *s++;
  564.     *p++ = *s++;
  565.   }
  566.  
  567.   while(*s)
  568.   { int i, dotseen;
  569.  
  570.     for(i=0, dotseen=0; *s && !IS_DIR_SEPARATOR(*s); s++)
  571.     { if ( dotseen > 0 )        /* copy after dot */
  572.       { if ( dotseen++ <= 3 )
  573.           p[i++] = *s;
  574.       } else
  575.       { if ( *s == '.' )        /* dot; possibly backup */
  576.     { dotseen = 1;
  577.       if ( i > 8 )
  578.         i = 8;
  579.       p[i++] = '.';
  580.     } else if ( i < 12 )
  581.     { p[i++] = *s;
  582.       if ( i == 8 )
  583.         p[i++] = '.';
  584.     }
  585.       }
  586.     }
  587.  
  588.     p += i;
  589.     if ( IS_DIR_SEPARATOR(*s) )
  590.     { s++;
  591.       *p++ = '\\';
  592.     }
  593.   }
  594.  
  595.   *p = EOS;
  596.  
  597.   return path;
  598. } 
  599. #endif
  600.  
  601. #if OS2 && EMX
  602.  
  603. /* 
  604.    Conversion rules Prolog <-> OS/2 (using HPFS)
  605.    / <-> \
  606.    /x:/ <-> x:\  (embedded drive letter)
  607.    No length restrictions up to MAXPATHLEN, no case conversions.
  608. */
  609.  
  610. char *
  611. PrologPath(char *ospath)
  612. { static char path[MAXPATHLEN];
  613.   register char *s = ospath, *p = path;
  614.   register int limit = MAXPATHLEN-1;
  615.  
  616.   if (isLetter(s[0]) && s[1] == ':')
  617.   { *p++ = '/';
  618.     *p++ = *s++;
  619.     *p++ = *s++;
  620.     limit -= 3;
  621.   }
  622.   for(; *s && limit; s++, p++, limit--)
  623.     *p = (*s == '\\' ? '/' : *s);
  624.   *p = EOS;
  625.  
  626.   return path;
  627. }
  628.  
  629.  
  630. char *
  631. OsPath(char *unixpath)
  632. { static char path[MAXPATHLEN];
  633.   register char *s = unixpath, *p = path;
  634.   register int limit = MAXPATHLEN-1;
  635.  
  636.   if ( s[0] == '/' && isLetter(s[1]) && s[2] == ':') /* embedded drive letter*/
  637.   { s++;
  638.     *p++ = *s++;
  639.     *p++ = *s++;
  640.     if ( *s != '/' )
  641.       *p++ = '\\';
  642.     limit -= 2;
  643.   }
  644.  
  645.   for(; *s && limit; s++, p++, limit--)
  646.     *p = (*s == '/' ? '\\' : *s);
  647.   *p = EOS;
  648.  
  649.   return path;
  650. } 
  651. #endif /* OS2 */
  652.  
  653. #if unix
  654. char *PrologPath(p)
  655. char *p;
  656. { return p;
  657. }
  658.  
  659. char *
  660. OsPath(p)
  661. char *p;
  662. { return p;
  663. }
  664. #endif
  665.  
  666. long
  667. LastModifiedFile(f)
  668. char *f;
  669. {
  670. #if unix || EMX
  671.   struct stat buf;
  672.  
  673.   if ( stat(OsPath(f), &buf) < 0 )
  674.     return -1;
  675.  
  676.   return (long)buf.st_mtime;
  677. #endif
  678.  
  679. #if tos
  680. #define DAY    (24*60*60L)
  681.   static int msize[] = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31};
  682.   long t;
  683.   int n;
  684.   struct ffblk buf;
  685.   struct dz
  686.   { unsigned int hour : 5;    /* hour (0-23) */
  687.     unsigned int min  : 6;    /* minute (0-59) */
  688.     unsigned int sec  : 5;    /* seconds in steps of 2 */
  689.     unsigned int year : 7;    /* year (0=1980) */
  690.     unsigned int mon  : 4;    /* month (1-12) */
  691.     unsigned int day  : 5;    /* day (1-31) */
  692.   } *dz;
  693.  
  694.   if ( findfirst(OsPath(f), &buf, FA_HIDDEN) != 0 )
  695.     return -1;
  696.   dz = (struct dz *) &buf.ff_ftime;
  697.   DEBUG(2, printf("%d/%d/%d %d:%d:%d\n",
  698.        dz->day, dz->mon, dz->year+1980, dz->hour, dz->min, dz->sec));
  699.  
  700.   t = (10*365+2) * DAY;        /* Start of 1980 */
  701.   for(n=0; n < dz->year; n++)
  702.     t += ((n % 4) == 0 ? 366 : 365) * DAY;
  703.   for(n=1; n < dz->mon; n++)
  704.     t += msize[n+1] * DAY;
  705.   t += (dz->sec * 2) + (dz->min * 60) + (dz->hour *60*60L);
  706.  
  707.   return t;
  708. #endif
  709. }  
  710.  
  711.  
  712. bool
  713. ExistsFile(path)
  714. char *path;
  715. {
  716. #if unix || EMX
  717.   struct stat buf;
  718.  
  719.   if ( stat(OsPath(path), &buf) == -1 || (buf.st_mode & S_IFMT) != S_IFREG )
  720.     fail;
  721.   succeed;
  722. #endif
  723.  
  724. #if tos
  725.   struct ffblk buf;
  726.  
  727.   if ( findfirst(OsPath(path), &buf, FA_HIDDEN) == 0 )
  728.   { DEBUG(2, printf("%s (%s) exists\n", path, OsPath(path)));
  729.     succeed;
  730.   }
  731.   DEBUG(2, printf("%s (%s) does not exist\n", path, OsPath(path)));
  732.   fail;
  733. #endif
  734. }
  735.  
  736. bool
  737. AccessFile(path, mode)
  738. char *path;
  739. int mode;
  740. {
  741. #if unix || EMX
  742.   int m = 0;
  743.  
  744.   if ( mode & ACCESS_READ    ) m |= R_OK;
  745.   if ( mode & ACCESS_WRITE   ) m |= W_OK;
  746.   if ( mode & ACCESS_EXECUTE ) m |= X_OK;
  747.  
  748.   return access(OsPath(path), m) == 0 ? TRUE : FALSE;
  749. #endif
  750.  
  751. #if tos
  752.   struct ffblk buf;
  753.  
  754.   if ( findfirst(OsPath(path), &buf, FA_DIREC|FA_HIDDEN) != 0 )
  755.     fail;            /* does not exists */
  756.   if ( (mode & ACCESS_WRITE) && (buf.ff_attrib & FA_RDONLY) )
  757.     fail;            /* readonly file */
  758.  
  759.   succeed;
  760. #endif
  761. }
  762.  
  763. bool
  764. ExistsDirectory(path)
  765. char *path;
  766. {
  767. #if unix || EMX
  768.   struct stat buf;
  769.  
  770.   if ( stat(OsPath(path), &buf) == -1 || (buf.st_mode & S_IFMT) != S_IFDIR )
  771.     fail;
  772.   succeed;
  773. #endif
  774.  
  775. #if tos
  776.   struct ffblk buf;
  777.  
  778.   if ( findfirst(OsPath(path), &buf, FA_DIREC|FA_HIDDEN) == 0 &&
  779.        buf.ff_attrib & FA_DIREC )
  780.     succeed;
  781.   if ( streq(path, ".") || streq(path, "..") )    /* hack */
  782.     succeed;
  783.   fail;
  784. #endif
  785. }
  786.  
  787.  
  788. long
  789. SizeFile(path)
  790. char *path;
  791. { struct stat buf;
  792.   if ( stat(OsPath(path), &buf) == -1 )
  793.     return -1;
  794.  
  795.   return buf.st_size;
  796. }
  797.  
  798.  
  799. bool
  800. DeleteFile(path)
  801. char *path;
  802. {
  803. #if unix || EMX
  804.   return unlink(OsPath(path)) == 0 ? TRUE : FALSE;
  805. #endif
  806.  
  807. #if tos
  808.   return remove(OsPath(path)) == 0 ? TRUE : FALSE;
  809. #endif
  810. }
  811.  
  812.  
  813. bool
  814. RenameFile(old, new)
  815. char *old, *new;
  816. {
  817.   char os_old[MAXPATHLEN];
  818.   char os_new[MAXPATHLEN];
  819. #if unix
  820.   int rval;
  821.  
  822.   strcpy(os_old, OsPath(old));
  823.   strcpy(os_new, OsPath(new));
  824.  
  825.   unlink(new);
  826.   if ((rval = link(os_old, os_new)) == 0 
  827.               && (rval = unlink(os_old)) != 0)
  828.     unlink(new);
  829.  
  830.   if (rval == 0)
  831.     succeed;
  832.  
  833.   fail;
  834. #endif
  835.  
  836. #if tos || EMX
  837.   return rename(os_old, os_new) == 0 ? TRUE : FALSE;
  838. #endif
  839. }
  840.  
  841.  
  842. bool
  843. SameFile(f1, f2)
  844. char *f1, *f2;
  845. { if ( streq(f1, f2) == FALSE )
  846.   { 
  847. #if unix
  848.     struct stat buf1;
  849.     struct stat buf2;
  850.  
  851.     if ( stat(OsPath(f1), &buf1) != 0 || stat(OsPath(f2), &buf2) != 0 )
  852.       fail;
  853.     if ( buf1.st_ino == buf2.st_ino && buf1.st_dev == buf2.st_dev )
  854.       succeed;
  855. #endif
  856. #if OS2 && EMX
  857.     /* Amazing! There is no simple way to check two files for identity. */
  858.     /* stat() and fstat() both return dummy values for inode and device. */
  859. #endif /* OS2 */
  860.  
  861.     fail;
  862.   }
  863.  
  864.   succeed;
  865. }
  866.  
  867.  
  868. bool
  869. OpenStream(fd)
  870. int fd;
  871. {
  872. #if unix || EMX
  873.   struct stat buf;
  874.  
  875.   return fstat(fd, &buf) == 0 ? TRUE : FALSE;
  876. #endif
  877.  
  878. #if tos
  879.   return fd < 3 ? TRUE : FALSE;    /* stdin, stdout and stderr are open */
  880. #endif
  881. }
  882.  
  883.  
  884. bool
  885. MarkExecutable(name)
  886. char *name;
  887. {
  888. #if unix
  889.   struct stat buf;
  890.   int um;
  891.  
  892.   um = umask(0777);
  893.   umask(um);
  894.   if ( stat(name, &buf) == -1 )
  895.     return warning("Can't stat(2) `%s': %s", name, OsError());
  896.  
  897.   if ( (buf.st_mode & 0111) == (~um & 0111) )
  898.     succeed;
  899.  
  900.   buf.st_mode |= 0111 & ~um;
  901.   if ( chmod(name, buf.st_mode) == -1 )
  902.     return warning("Couldn't turn %s into an executable: %s", name, OsError());
  903.  
  904.   succeed;
  905. #endif
  906.  
  907. #if tos || OS2
  908.   succeed;        /* determined by extension */
  909. #endif
  910. }
  911.  
  912. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  913.     char *AbsoluteFile(file)
  914.        char *file;
  915.  
  916.     Expand a file specification to a system-wide unique  description  of
  917.     the  file  that can be passed to the file functions that take a path
  918.     as argument.  Path should refer to the same file, regardless of  the
  919.     current  working  directory.   On  Unix absolute file names are used
  920.     for this purpose.
  921.  
  922.     This  function  is  based  on  a  similar  (primitive)  function  in
  923.     Edinburgh C-Prolog.
  924.  
  925.     char *BaseName(path)
  926.      char *path;
  927.  
  928.     Return the basic file name for a file having path `path'.
  929.  
  930.     char *DirName(path)
  931.      char *path;
  932.     
  933.     Return the directory name for a file having path `path'.
  934. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  935.  
  936. #if unix
  937. typedef struct canonical_dir *CanonicalDir;
  938.  
  939. static struct canonical_dir
  940. { char *    name;            /* name of directory */
  941.   char *    canonical;        /* canonical name of directory */
  942.   dev_t        device;            /* device number */
  943.   ino_t        inode;            /* inode number */
  944.   CanonicalDir  next;            /* next in chain */
  945. } *canonical_dirlist = NULL;            /* initialization -- atoenne -- */
  946.  
  947. forwards char    *canonisePath P((char *)); /* canonise a path-name */
  948. forwards char   *canoniseDir P((char *));
  949. #endif
  950.  
  951. static  char    CWDdir[MAXPATHLEN];       /* current directory */
  952.  
  953.  
  954. static void
  955. initExpand()
  956. { 
  957. #if unix
  958.   char *dir;
  959.   char *cpaths;
  960. #endif
  961.  
  962.   CWDdir[0] = EOS;
  963.  
  964. #if unix
  965.   if ( (cpaths = getenv("CANONICAL_PATHS")) )
  966.   { char buf[MAXPATHLEN];
  967.  
  968.     while(*cpaths)
  969.     { char *e;
  970.  
  971.       if ( (e = index(cpaths, ':')) )
  972.       { int l = e-cpaths;
  973.  
  974.     strncpy(buf, cpaths, l);
  975.     buf[l] = EOS;
  976.     cpaths += l+1;
  977.     canoniseDir(buf);
  978.       } else
  979.       { canoniseDir(cpaths);
  980.     break;
  981.       }
  982.     }
  983.   }
  984.  
  985.   if ( (dir = getenv("HOME")) ) canoniseDir(dir);
  986.   if ( (dir = getenv("PWD"))  ) canoniseDir(dir);
  987. #endif
  988. }
  989.  
  990. #if unix
  991.  
  992. static char *
  993. canoniseDir(path)
  994. char *path;
  995. { CanonicalDir d;
  996.   struct stat buf;
  997.  
  998.   DEBUG(1, printf("canoniseDir(%s) --> ", path); fflush(stdout));
  999.  
  1000.   for(d = canonical_dirlist; d; d = d->next)
  1001.   { if ( streq(d->name, path) )
  1002.     { if ( d->name != d->canonical )
  1003.     strcpy(path, d->canonical);
  1004.  
  1005.       DEBUG(1, printf("(lookup) %s\n", path));
  1006.       return path;
  1007.     }
  1008.   }
  1009.  
  1010.   if ( stat(OsPath(path), &buf) == 0 )
  1011.   { CanonicalDir dn = allocHeap(sizeof(struct canonical_dir));
  1012.     char dirname[MAXPATHLEN];
  1013.     char *e = path + strlen(path);
  1014.  
  1015.     dn->next   = canonical_dirlist;
  1016.     dn->name   = store_string(path);
  1017.     dn->inode  = buf.st_ino;
  1018.     dn->device = buf.st_dev;
  1019.  
  1020.     do
  1021.     { strncpy(dirname, path, e-path);
  1022.       dirname[e-path] = EOS;
  1023.       if ( stat(OsPath(dirname), &buf) < 0 )
  1024.     break;
  1025.  
  1026.       for(d = canonical_dirlist; d; d = d->next)
  1027.       { if ( d->inode == buf.st_ino && d->device == buf.st_dev )
  1028.     { canonical_dirlist = dn;
  1029.  
  1030.       strcpy(dirname, d->canonical);
  1031.       strcat(dirname, e);
  1032.       strcpy(path, dirname);
  1033.       dn->canonical = store_string(path);
  1034.       DEBUG(1, printf("(replace) %s\n", path));
  1035.       return path;
  1036.     }
  1037.       }
  1038.  
  1039.       for(e--; *e != '/' && e > path + 1; e-- )
  1040.     ;
  1041.  
  1042.     } while( e > path );
  1043.  
  1044.     dn->canonical = dn->name;
  1045.     canonical_dirlist = dn;
  1046.  
  1047.     DEBUG(1, printf("(new, existing) %s\n", path));
  1048.     return path;
  1049.   }
  1050.  
  1051.   DEBUG(1, printf("(nonexisting) %s\n", path));
  1052.   return path;
  1053. }
  1054.  
  1055. #else
  1056.  
  1057. #define canoniseDir(d)
  1058.  
  1059. #endif
  1060.  
  1061.  
  1062. static char *
  1063. canonisePath(path)
  1064. register char *path;
  1065. { register char *out = path;
  1066.   char *osave[100];
  1067.   int  osavep = 0;
  1068.   char *bsave = out;
  1069.  
  1070.   while( path[0] == '/' && path[1] == '.' &&
  1071.      path[2] == '.' && path[3] == '/')
  1072.     path += 3;
  1073.  
  1074.   while(*path)
  1075.   { if (*path == '/')
  1076.     { while(path[1] == '/')
  1077.     path++;
  1078.       while (path[1] == '.' && path[2] == '/')
  1079.     path += 2;
  1080.       while (path[1] == '.' && path[2] == '.' && path[3] == '/')
  1081.       { out = osave[--osavep];
  1082.     path += 3;
  1083.       }
  1084.       osave[osavep++] = out;
  1085.       *out++ = *path++;
  1086.     } else
  1087.       *out++ = *path++;
  1088.   }
  1089.   *out++ = *path++;
  1090.  
  1091. #if unix
  1092. { char *e;
  1093.   char dirname[MAXPATHLEN];
  1094.  
  1095.   e = bsave + strlen(bsave) - 1;
  1096.   for( ; *e != '/' && e > bsave; e-- )
  1097.     ;
  1098.   strncpy(dirname, bsave, e-bsave);
  1099.   dirname[e-bsave] = EOS;
  1100.   canoniseDir(dirname);
  1101.   strcat(dirname, e);
  1102.   strcpy(bsave, dirname);
  1103. }
  1104. #endif
  1105.  
  1106.   return bsave;
  1107. }
  1108.  
  1109. #include <ctype.h>
  1110.  
  1111. forwards char    *takeWord P((char **));
  1112. forwards int    ExpandFile P((char *, char **));
  1113.  
  1114. static char *
  1115. takeWord(string)
  1116. char **string;
  1117. { static char wrd[MAXPATHLEN];
  1118.   register char *s = *string;
  1119.   register char *q = wrd;
  1120.   register int left = MAXPATHLEN-1;
  1121.  
  1122.   while( isalnum(*s) || *s == '_' )
  1123.   { if ( --left < 0 )
  1124.     { warning("Variable or user name too long");
  1125.       return (char *) NULL;
  1126.     }
  1127.     *q++ = *s++;
  1128.   }
  1129.   *q = EOS;
  1130.   
  1131.   *string = s;
  1132.   return wrd;
  1133. }
  1134.  
  1135.  
  1136. bool
  1137. expandVars(pattern, expanded)
  1138. char *pattern, *expanded;
  1139. { int size = 0;
  1140.   char c;
  1141.  
  1142.   if ( *pattern == '~' )
  1143.   {
  1144. #if unix
  1145.     static char fred[20];
  1146.     static char fredLogin[MAXPATHLEN];
  1147.     extern struct passwd *getpwnam();
  1148. #endif
  1149.     char *user;
  1150.     char *value;
  1151.     int l;
  1152.  
  1153.     pattern++;
  1154.     user = takeWord(&pattern);
  1155.  
  1156. #if unix
  1157.     if ( user[0] != EOS || (value = getenv("HOME")) == (char *) NULL )
  1158.     { struct passwd *pwent;
  1159.  
  1160.       if ( !streq(fred, user) )
  1161.       { if ( (pwent = getpwnam(user)) == (struct passwd *) NULL )
  1162.       return warning("%s: Unknown user");
  1163.     strcpy(fred, user);
  1164.     strcpy(fredLogin, pwent->pw_dir);
  1165.       }
  1166.       value = fredLogin;
  1167.     }      
  1168. #endif
  1169. #if tos || OS2
  1170.     if ( user[0] != EOS || (value = getenv("HOME")) == (char *) NULL )
  1171.     { value = "/";    /* top directory of current drive */
  1172.     } else
  1173.     { value = PrologPath(value);
  1174.     }
  1175. #endif
  1176.     size += (l = (int) strlen(value));
  1177.     if ( size >= MAXPATHLEN )
  1178.       return warning("Path name too long");
  1179.     strcpy(expanded, value);
  1180.     expanded += l;
  1181.   }
  1182.  
  1183.   for( ;; )
  1184.   { switch( c = *pattern++ )
  1185.     { case EOS:
  1186.     break;
  1187.       case '$':
  1188.     { char *var = takeWord(&pattern);
  1189.       char *value = getenv(var);
  1190.       int l;
  1191.  
  1192.       if ( value == (char *) NULL )
  1193.         return warning("%s: Undefined variable", var);
  1194.       size += (l = (int)strlen(value));
  1195.       if ( size >= MAXPATHLEN )
  1196.         return warning("Path name too long");
  1197.       strcpy(expanded, value);
  1198.       expanded += l;
  1199.  
  1200.       continue;
  1201.     }
  1202.       default:
  1203.     if ( ++size >= MAXPATHLEN )
  1204.       return warning("Path name too long");
  1205.     *expanded++ = c;
  1206.  
  1207.     continue;
  1208.     }
  1209.     break;
  1210.   }
  1211.  
  1212.   if ( ++size >= MAXPATHLEN )
  1213.     return warning("Path name too long");
  1214.   *expanded++ = EOS;
  1215.  
  1216.   succeed;
  1217. }
  1218.  
  1219.  
  1220. static int
  1221. ExpandFile(pattern, vector)
  1222. char *pattern;
  1223. char **vector;
  1224. { static char expanded[MAXPATHLEN];
  1225.   int matches = 0;
  1226.  
  1227.   if ( expandVars(pattern, expanded) == FALSE )
  1228.     return -1;
  1229.   
  1230.   vector[matches++] = expanded;
  1231.  
  1232.   return matches;
  1233. }
  1234.  
  1235.  
  1236. char *
  1237. ExpandOneFile(spec)
  1238. char *spec;
  1239. { static char file[MAXPATHLEN];
  1240.   char *vector[256];
  1241.   
  1242.   switch( ExpandFile(spec, vector) )
  1243.   { case -1:
  1244.     return (char *) NULL;
  1245.     case 0:
  1246.     warning("%s: No match", spec);
  1247.     return (char *) NULL;
  1248.     case 1:
  1249.     strcpy(file, vector[0]);
  1250.     return file;
  1251.     default:
  1252.     warning("%s: Ambiguous", spec);
  1253.     return (char *) NULL;
  1254.   }
  1255. }
  1256.  
  1257.  
  1258. #if unix            /* convert the names to PrologPath before use !! */
  1259. #if hpux || LINUX
  1260. char    *getwd P((char *));
  1261.  
  1262. char *
  1263. getwd(buf)
  1264. char *buf;
  1265. { extern char *getcwd();
  1266.  
  1267.   return getcwd(buf, MAXPATHLEN);
  1268. }
  1269. #else
  1270. extern char *getwd P((char *));
  1271. #endif /* hpux */
  1272. #endif
  1273.  
  1274. #if OS2 && EMX
  1275. char *getwd P((char *));
  1276.  
  1277. char *getwd(buf)       /* the current directory INCLUDING the current drive */
  1278. char *buf;
  1279. { strcpy(buf, PrologPath(_getcwd2(buf, MAXPATHLEN)));
  1280.   return buf;
  1281. }
  1282. #endif /* OS2 */
  1283.  
  1284.  
  1285. #if tos
  1286. char    *getwd P((char *));
  1287.  
  1288. char *
  1289. getwd(buf)
  1290. char *buf;
  1291. { char path[MAXPATHLEN];
  1292.  
  1293.   if ( Dgetpath(path, 0) != 0 )
  1294.   { warning("Can't get current directory: %s", OsError());
  1295.     strcpy(path, "");
  1296.   }
  1297.   sprintf(buf, "%c:%s", Dgetdrv()+'a', PrologPath(path));
  1298.  
  1299.   return buf;
  1300. }
  1301. #endif
  1302.  
  1303. #if unix
  1304. #define isAbsolutePath(p) ( p[0] == '/' )
  1305. #define isRelativePath(p) ( p[0] == '.' )
  1306. #endif
  1307. #if tos
  1308. #define isAbsolutePath(p) ( isLetter(p[0]) && p[1] == ':' )
  1309. #define isRelativePath(p) ( p[0] == '.' || p[0] == '/' || p[0] == '\\' )
  1310. #endif
  1311. #if OS2
  1312. #define isAbsolutePath(p) (p[0] == '/' && isLetter(p[1]) && \
  1313.                p[2] == ':' && p[3] == '/' )
  1314. #define isDriveRelativePath(p) (p[0] == '/' && p[2] != ':')
  1315. #define isRootlessPath(p) (p[0] == '/' && isLetter(p[1]) && \
  1316.                p[2] == ':' && p[3] != '/')
  1317. #define isRelativePath(p) (p[0] == '.')
  1318. #endif /* OS2 */
  1319.  
  1320. /*
  1321.   Design Note -- atoenne --
  1322.   AbsoluteFile may only be called with a proper PrologPath. Otherwise the
  1323.   canonisePath will not work.
  1324. */
  1325.  
  1326. char *
  1327. AbsoluteFile(spec)
  1328. char *spec;
  1329. { static char path[MAXPATHLEN];
  1330.   char *file;  
  1331.  
  1332.   if ( (file = ExpandOneFile(spec)) == (char *) NULL )
  1333.     return (char *) NULL;
  1334.  
  1335.   if ( isAbsolutePath(file) )
  1336.   { strcpy(path, file);
  1337.  
  1338.     return canonisePath(path);
  1339.   }
  1340. #if OS2 && EMX
  1341.   if (isDriveRelativePath(file))
  1342.   {
  1343.     if ((strlen(file) + 4) > MAXPATHLEN)
  1344.     {
  1345.       warning("path name too long");
  1346.       return (char *) NULL;
  1347.     }
  1348.     path[0] = '/';
  1349.     path[1] = (char) _getdrive();
  1350.     path[2] = ':';
  1351.     strcpy(&path[3], file);
  1352.     return canonisePath(path);
  1353.   }
  1354. #endif /* OS2 */
  1355.   if ( CWDdir[0] == EOS )
  1356.   {
  1357.     getwd(CWDdir);
  1358.   }
  1359.  
  1360. #if OS2 && EMX
  1361.   if (isRootlessPath(file))
  1362.   {
  1363.     if ((strlen(CWDdir) + strlen(file) - 2) >= MAXPATHLEN)
  1364.     {
  1365.       warning("path name too long");
  1366.       return (char *) NULL;
  1367.     }
  1368.     strcpy(path, CWDdir);
  1369.     strcat(path, "/");
  1370.     strcat(path, &file[3]);
  1371.     return canonisePath(path);
  1372.   }
  1373. #endif /* OS2 */
  1374.   if ( (strlen(CWDdir) + strlen(file) + 2) >= MAXPATHLEN )
  1375.   { warning("path name too long");
  1376.     return (char *) NULL;
  1377.   }
  1378.   
  1379.   strcpy(path, CWDdir);
  1380.   strcat(path, "/");
  1381.   strcat(path, file);
  1382.  
  1383.   return canonisePath(path);
  1384. }
  1385.  
  1386.  
  1387. char *
  1388. BaseName(f)
  1389. register char *f;
  1390. { register char *base;
  1391.  
  1392.   for(base = f; *f; f++)
  1393.     if (*f == '/')
  1394.       base = f+1;
  1395.  
  1396.   return base;
  1397. }
  1398.  
  1399. char *
  1400. DirName(f)
  1401. char *f;
  1402. { static char dir[MAXPATHLEN];
  1403.   char *base, *p;
  1404.  
  1405.   for(base = p = f; *p; p++)
  1406.     if (*p == '/' && p[1] != EOS )
  1407.       base = p;
  1408.   strncpy(dir, f, base-f);
  1409.   dir[base-f] = EOS;
  1410.   
  1411.   return dir;
  1412. }
  1413.  
  1414. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1415.     bool ChDir(path)
  1416.      char *path;
  1417.  
  1418.     Change the current working directory to `path'.  File names may depend
  1419.     on `path'.
  1420. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1421.  
  1422. bool
  1423. ChDir(path)
  1424. char *path;
  1425. { extern int chdir(/*char**/);
  1426.   char *ospath = OsPath(path);
  1427.  
  1428.   if ( ospath[0] == EOS ||
  1429.        streq(ospath, CWDdir) ||
  1430.        streq(ospath, ".") )        /* Same directory */
  1431.     succeed;
  1432.  
  1433.   if ( chdir(ospath) == 0 )
  1434.   { CWDdir[0] = EOS;
  1435.     succeed;
  1436.   }
  1437.  
  1438.   fail;
  1439. }
  1440.  
  1441. #if minix || tos
  1442. long
  1443. getw(fd)
  1444. register FILE *fd;
  1445. { register ulong r;
  1446.  
  1447.   r = getc(fd);
  1448.   r = (r << 8) | getc(fd);
  1449.   r = (r << 8) | getc(fd);
  1450.   r = (r << 8) | getc(fd);
  1451.  
  1452.   return r;
  1453. }
  1454.  
  1455. long
  1456. putw(l, fd)
  1457. long l;
  1458. FILE *fd;
  1459. { putc((char)((l >> 24) & 0xff), fd);
  1460.   putc((char)((l >> 16) & 0xff), fd);
  1461.   putc((char)((l >>  8) & 0xff), fd);
  1462.   putc((char)((l)       & 0xff), fd);
  1463.  
  1464.   return l;
  1465. }
  1466. #endif /* minix || tos */
  1467.  
  1468.         /********************************
  1469.         *        TIME CONVERSION        *
  1470.         *********************************/
  1471.  
  1472. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1473.     struct tm *LocalTime(time)
  1474.           long *time;
  1475.  
  1476.     Convert time in Unix internal form (seconds since Jan 1 1970) into a
  1477.     structure providing easier access to the time.
  1478.  
  1479.     For non-Unix systems: struct time is supposed  to  look  like  this.
  1480.     Move  This  definition to pl-os.h and write the conversion functions
  1481.     here.
  1482.  
  1483.     struct tm {
  1484.     int    tm_sec;        / * second in the minute (0-59)* /
  1485.     int    tm_min;        / * minute in the hour (0-59) * /
  1486.     int    tm_hour;    / * hour of the day (0-23) * /
  1487.     int    tm_mday;    / * day of the month (1-31) * /
  1488.     int    tm_mon;        / * month of the year (1-12) * /
  1489.     int    tm_year;    / * year (0 = 1900) * /
  1490.     int    tm_wday;    / * day in the week (1-7, 1 = sunday) * /
  1491.     int    tm_yday;    / * day in the year (0-365) * /
  1492.     int    tm_isdst;    / * daylight saving time info * /
  1493.     };
  1494.  
  1495.     long Time()
  1496.  
  1497.     Return time in seconds after Jan 1 1970 (Unix' time notion).
  1498. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1499.  
  1500. struct tm *
  1501. LocalTime(t)
  1502. long *t;
  1503. { extern struct tm *localtime();
  1504.  
  1505.   return localtime(t);
  1506. }
  1507.  
  1508. long
  1509. Time()
  1510. {
  1511. #if !EMX
  1512. extern long time();
  1513. #endif
  1514.  
  1515.   return (long)time((time_t *) NULL);
  1516. }
  1517.  
  1518. #if tos
  1519. void
  1520. gettimeofday(tz, p)
  1521. struct timeval *tz;
  1522. void *p;
  1523. { tz->tv_usec = 0;
  1524.   tz->tv_sec  = Time();
  1525. }
  1526. #endif
  1527.  
  1528.         /********************************
  1529.         *        TERMINAL CONTROL       *
  1530.         *********************************/
  1531.  
  1532. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1533. Terminal control probably is the biggest mess.  One day (v7) things used
  1534. to be simple.  New features made a mess of it.  System V then defined  a
  1535. much  more powerful terminal interface using a single control structure.
  1536. Unfortunately at this moment every Unix system seems  to  have  its  own
  1537. driver:  v7  drivers, various extended versions of this and the System V
  1538. drivers.
  1539.  
  1540. SWI-Prolog uses the following terminal modes:
  1541.  
  1542.   - If it wants to know what action to perform when in trace mode or has
  1543.     trapped a signal (^C). In this  case  it  wants  the  input  without
  1544.     waiting for a return and without echoing.
  1545.  
  1546.   - If it is reading a Prolog term from the terminal.  In this  case  it
  1547.     wants  to  trap ESC and EOF without waiting for a return in order to
  1548.     do `atom-completion': finishing atoms after a unique prefix has been
  1549.     typed by the user.  This mode askes for some sub-modes to let Prolog
  1550.     act as if the characters are typed by the user.
  1551.  
  1552.   - Prolog assumes the terminal is initialy in  `COOKED'  mode:  the  OS
  1553.     reads  the characters from the terminal and allows for line editing.
  1554.     The line is passed as a whole if the user hits return.
  1555.  
  1556. As we usualy want to go back to the previous mode two  functions  should
  1557. be provided by this layer of the terminal driver:
  1558.  
  1559.     void PushTty(buf, mode)
  1560.      ttybuf *buf;
  1561.      int mode;
  1562.  
  1563.     Save the current settings in `buf' and switch to mode  `mode'.   The
  1564.     type ttybuf should be defined in pl-os.h. Modes:
  1565.  
  1566.      TTY_SAVE        Only save current setting: do not change
  1567.      TTY_RAW        Non-Echoing, not waiting for return
  1568.      TTY_COOKED        Initial mode (asumes echo)
  1569.      TTY_EXTEND_ATOMS    Tty flushes on ESC, EOF and NL. Used by
  1570.                 read/1.
  1571.      TTY_RETYPE        Push back characters without showing them
  1572.                 on the terminal.
  1573.      TTY_APPEND        Push back characters, showing them on the
  1574.                 terminal.
  1575.  
  1576.     The  last  three  serve  for  the  atom-completion.   This  is  only
  1577.     interesting  if  you  can  provide a function to fake input from the
  1578.     user by the program.  if this cannot be done you may wish to include
  1579.     the O_LINE_EDIT option, which  makes  Prolog  defines  it's  own  line
  1580.     editing cababilities.
  1581.  
  1582.     void PopTty(buf)
  1583.      ttybuf *buf;
  1584.  
  1585.     Restore the terminal into the mode saved in buf by a PushTty() call.
  1586. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1587.  
  1588. #if O_LINE_EDIT
  1589. #define CRLF        (0x0001)    /* map CR -> LF */
  1590. #define Empty(d)    ( (d)->in == (d)->out )
  1591. #define Advance(p)    { if ( ++(p) == QSIZE ) (p) = 0; }
  1592. #define Retreat(p)    { if ( --(p) < 0 ) (p) = QSIZE-1; }
  1593.  
  1594. struct tty_driver stdin_driver =
  1595. { Control('W'), Control('U'), Control('?'), Control('H'),
  1596.   Control('D'), Control('['), Control('R'), Control('C'),
  1597.   TTY_EXTEND_ATOMS,        /* mode */
  1598.   0,            /* no lines yet */
  1599.   TRUE,            /* line 0 is a tty */
  1600.   0, 0, 0,        /* colunm, in, out */
  1601.   CRLF            /* flags */
  1602. };
  1603. #endif /* O_LINE_EDIT */
  1604.  
  1605. #if O_TERMIOS                /* System V termio system */
  1606.  
  1607. bool
  1608. PushTty(buf, mode)
  1609. ttybuf *buf;
  1610. int mode;
  1611. { struct termio tio;
  1612.  
  1613.   if ( status.notty )
  1614.     succeed;
  1615.  
  1616.   if ( ioctl(0, TCGETA, &buf->tab) )    /* save the old one */
  1617.     fail;
  1618.   tio = buf->tab;
  1619.   buf->mode = ttymode;
  1620.  
  1621.   if ( mode != TTY_SAVE )
  1622.     ttymode = mode;
  1623.  
  1624. #if O_LINE_EDIT
  1625.   stdin_driver.mode = mode;
  1626. #endif
  1627.  
  1628.   switch( mode )
  1629.   { case TTY_SAVE:
  1630.     succeed;
  1631. #if O_EXTEND_ATOMS
  1632. #if O_LINE_EDIT
  1633.     case TTY_COOKED:
  1634.     case TTY_RAW:
  1635.     tio.c_lflag &= ~(ECHO|ICANON);
  1636.     tio.c_cc[VTIME] = 0, tio.c_cc[VMIN] = 1;
  1637.     break;
  1638.     case TTY_EXTEND_ATOMS:
  1639.     tio.c_lflag &= ~(ICANON|ECHO|ECHOE);
  1640.     tio.c_cc[VTIME] = 0, tio.c_cc[VMIN] = 1;
  1641.     stdin_driver.erase  = tio.c_cc[VERASE];
  1642.     stdin_driver.kill   = tio.c_cc[VKILL];
  1643.     break;
  1644.     case TTY_RETYPE:
  1645.     break;
  1646.     case TTY_APPEND:
  1647.     break;
  1648. #else /* O_LINE_EDIT */
  1649.     case TTY_RAW:
  1650.     tio.c_lflag &= ~(ECHO|ICANON);
  1651.     tio.c_cc[VTIME] = 0, tio.c_cc[VMIN] = 1;
  1652.     break;
  1653.     case TTY_EXTEND_ATOMS:
  1654.     tio.c_cc[VEOF]    = 0;             /* disable EOF */
  1655.     tio.c_cc[VEOL]  = ttytab.tab.c_cc[VEOF]; /* EOF: give alternatives */
  1656.     tio.c_cc[VEOL2]    = ESC;             /* ESC: complete */
  1657.     break;
  1658.     case TTY_RETYPE:
  1659.     tio.c_lflag &= ~ECHO;
  1660.     break;
  1661.     case TTY_APPEND:
  1662.     tio.c_lflag |= ECHO;
  1663.     break;
  1664. #endif /* O_LINE_EDIT */
  1665. #endif /* O_EXTEND_ATOMS */
  1666.     default:
  1667.     sysError("Unknown PushTty() mode: %d", mode);
  1668.     /*NOTREACHED*/
  1669.   }
  1670.  
  1671.   if ( ioctl(0, TCSETA, &tio) )
  1672.     fail;
  1673.  
  1674.   succeed;
  1675. }
  1676.  
  1677.  
  1678. bool
  1679. PopTty(buf)
  1680. ttybuf *buf;
  1681. {
  1682.   if ( status.notty )
  1683.     succeed;
  1684. #if O_LINE_EDIT
  1685.   stdin_driver.mode = buf->mode;
  1686. #endif
  1687.   if ( ioctl(0, TCSETA, &buf->tab) )
  1688.     fail;
  1689.   ttymode = buf->mode;
  1690.  
  1691.   succeed;
  1692. }
  1693.  
  1694. #endif
  1695.  
  1696. #if !O_TERMIOS && unix            /* Unix with (old) sgtty() driver */
  1697.  
  1698. bool
  1699. PushTty(buf, mode)
  1700. ttybuf *buf;
  1701. int mode;
  1702. { struct tchars chrs;
  1703.   struct sgttyb flgs;
  1704.   bool flags_set = FALSE;
  1705.   bool chars_set = FALSE;
  1706.  
  1707.   if ( status.notty )
  1708.     succeed;
  1709.  
  1710.   DEBUG(1, printf("PushTty(0x%x, %d)\n", buf, mode));
  1711.  
  1712.   if ( ioctl(0, TIOCGETP, &buf->tab) ||
  1713.        ioctl(0, TIOCGETC, &buf->chars) )
  1714.   { DEBUG(1, printf("Failed to get terminal parameters: %s\n", OsError()));
  1715.     fail;
  1716.   }
  1717.  
  1718.   flgs = buf->tab;
  1719.   chrs = buf->chars;
  1720.   buf->mode = ttymode;
  1721.  
  1722.   if ( mode != TTY_SAVE )
  1723.     ttymode = mode;
  1724.  
  1725. #if O_LINE_EDIT
  1726.   stdin_driver.mode = mode;
  1727. #endif
  1728.  
  1729.   switch( mode )
  1730.   { case TTY_SAVE:
  1731. #if !O_LINE_EDIT
  1732.     case TTY_COOKED:
  1733. #endif
  1734.     succeed;
  1735. #if O_LINE_EDIT
  1736.     case TTY_COOKED:
  1737. #endif
  1738.     case TTY_RAW:
  1739.     flgs.sg_flags &= ~(ECHO);
  1740.     flgs.sg_flags |= CBREAK;
  1741.     flags_set = TRUE;
  1742.     break;
  1743. #if O_LINE_EDIT
  1744.     case TTY_EXTEND_ATOMS:
  1745.     flgs.sg_flags &= ~(ECHO);
  1746.     flgs.sg_flags |= CBREAK;
  1747.     stdin_driver.erase = flgs.sg_erase;
  1748.     stdin_driver.kill  = flgs.sg_kill;
  1749.     flags_set = TRUE;
  1750.     break;
  1751.     case TTY_RETYPE:
  1752.     case TTY_APPEND:
  1753.     break;
  1754. #else /* O_LINE_EDIT */
  1755.     case TTY_EXTEND_ATOMS:
  1756.     chrs.t_brkc = ESC;        /* ESC, EOF already on 04 */
  1757.     chars_set = TRUE;
  1758.     break;
  1759.     case TTY_RETYPE:
  1760.     flgs.sg_flags &= ~ECHO;
  1761.     flags_set = TRUE;
  1762.     break;
  1763.     case TTY_APPEND:
  1764.     flgs.sg_flags |= ECHO;
  1765.     flags_set = TRUE;
  1766.     break;
  1767. #endif /* O_LINE_EDIT */
  1768.     default:
  1769.     sysError("Unknown PushTty() mode: %d", mode);
  1770.     /*NOTREACHED*/
  1771.   }
  1772.  
  1773.   if ( flags_set )
  1774.     if ( ioctl(0, TIOCSETN, &flgs) != 0 )
  1775.       return warning("Failed to set terminal flags: %s", OsError());
  1776.   if ( chars_set )
  1777.     if ( ioctl(0, TIOCSETC, &chrs) != 0 )
  1778.       return warning("Failed to set terminal characters: %s", OsError());
  1779.  
  1780.   succeed;
  1781. }
  1782.  
  1783.  
  1784. bool
  1785. PopTty(buf)
  1786. ttybuf *buf;
  1787. { if ( status.notty )
  1788.     succeed;
  1789.  
  1790.   if ( ioctl(0, TIOCSETN, &buf->tab) ||
  1791.        ioctl(0, TIOCSETC, &buf->chars) )
  1792.     fail;
  1793.   ttymode = buf->mode;
  1794.  
  1795.   succeed;
  1796. }
  1797. #endif /* unix && !O_TERMIOS */
  1798.  
  1799. #if tos                    /* ATARI_ST, running TOS */
  1800. bool
  1801. PushTty(buf, mode)
  1802. ttybuf *buf;
  1803. int mode;
  1804. { if ( mode != TTY_SAVE )
  1805.     ttymode = mode;
  1806.  
  1807.   switch( mode )
  1808.   { case TTY_SAVE:
  1809.     buf->mode = stdin_driver.mode;
  1810.     succeed;
  1811.     case TTY_RAW:
  1812.     case TTY_EXTEND_ATOMS:
  1813.     case TTY_RETYPE:
  1814.     case TTY_APPEND:
  1815.     stdin_driver.mode = mode;
  1816.     succeed;            /* to be implemented later */
  1817.     default:
  1818.     return sysError("Unknown PushTty() mode: %d", mode);
  1819.     /*NOTREACHED*/
  1820.   }
  1821. }
  1822.  
  1823. bool
  1824. PopTty(buf)
  1825. ttybuf *buf;
  1826. { stdin_driver.mode = buf->mode;
  1827.   ttymode = buf->mode;
  1828.   succeed;
  1829. }
  1830. #endif /* tos */
  1831.  
  1832. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1833.     void ResetTty()
  1834.  
  1835.     Reset terminal to a sensible state after an abort ore restore()
  1836. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1837.  
  1838. void
  1839. ResetTty()
  1840. {
  1841. #ifdef RESET_STDIN
  1842.   RESET_STDIN;
  1843. #else
  1844. #if unix && !LINUX
  1845.   stdin->_ptr = stdin->_base;
  1846.   stdin->_cnt = 0;
  1847. #endif
  1848. #if EMX
  1849.   stdin->ptr = stdin->buffer;
  1850.   stdin->rcount = 0;
  1851.   stdin->wcount = 0;
  1852. #endif
  1853.   clearerr(stdin);
  1854. #endif
  1855.  
  1856. #if O_LINE_EDIT
  1857.   stdin_driver.in = stdin_driver.out = 0;
  1858.   stdin_driver.emitting = 0;
  1859. #if unix || EMX
  1860.   stdin_driver.isatty = isatty(fileno(stdin));
  1861. #endif
  1862. #if tos
  1863.   stdin_driver.isatty = TRUE;        /* how to find out? */
  1864. #endif
  1865. #endif /* O_LINE_EDIT */
  1866. }
  1867.  
  1868. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1869.     void PretendTyped(c)
  1870.          char c;
  1871.  
  1872.     Pretend the user typed character `c'. If the tty mode is  TTY_RETYPE
  1873.     the  character  should  just  be  pushed  in  the  input buffer.  If
  1874.     TTY_APPEND it should also be echoed to the user.
  1875. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1876.  
  1877. #if O_EXTEND_ATOMS && !O_LINE_EDIT
  1878. void
  1879. PretendTyped(c)
  1880. char c;
  1881. { ioctl(0, TIOCSTI, &c);
  1882. }
  1883. #endif /* O_EXTEND_ATOMS */
  1884.  
  1885. #if O_LINE_EDIT
  1886.         /********************************
  1887.         *         LINE EDITING          *
  1888.         *********************************/
  1889.  
  1890. forwards bool    tty_erase P((struct tty_driver *));
  1891. forwards void    tty_werase P((struct tty_driver *));
  1892. forwards void    tty_kill P((struct tty_driver *));
  1893. forwards void    tty_reprint P((struct tty_driver *));
  1894. forwards bool    tty_insert P((struct tty_driver *, Char));
  1895. forwards void    add_char P((struct tty_driver *, Char));
  1896. forwards Char    get_edit_char P((struct tty_driver *));
  1897. forwards bool    tty_endsline P((struct tty_driver *, Char));
  1898. forwards void    tty_putc P((Char));
  1899. forwards void    tty_putstr P((char *));
  1900.  
  1901. #define isPrint(c) ((c >= ' ' && c < 127) || c == '\t' || c == '\n')
  1902.  
  1903. static void
  1904. tty_putc(c)
  1905. Char c;
  1906. {
  1907. #if OS2 && EMX
  1908.   if (c == '\n')
  1909.     putchar('\r');
  1910. #endif
  1911.  
  1912. #if unix || EMX
  1913.   putchar(c);
  1914. #endif
  1915.  
  1916. #if tos
  1917.   if ( c == '\n' )
  1918.     putch('\r');
  1919.   putch(c);
  1920. #endif
  1921. }
  1922.  
  1923. static void
  1924. tty_putstr(s)
  1925. char *s;
  1926. { for( ; *s; s++ )
  1927.     tty_putc(*s);
  1928. }
  1929.  
  1930. static bool
  1931. tty_erase(d)
  1932. register struct tty_driver *d;
  1933. { Char c;
  1934.  
  1935.   if ( Empty(d) )
  1936.     fail;
  1937.  
  1938.   Retreat(d->in);
  1939.   switch( c = d->queue[d->in] )
  1940.   { case '\t':        do
  1941.             { tty_putc('\b');
  1942.               d->column--;
  1943.             } while( d->column % 8 );
  1944.             break;
  1945.     default:        if ( c < ' ' || c == 127 )
  1946.             { tty_putstr("\b\b  \b\b");
  1947.               d->column -= 2;
  1948.             } else if ( c < 127 )
  1949.             { d->column--;
  1950.               tty_putstr("\b \b");
  1951.               break;
  1952.             }
  1953.   }  
  1954.  
  1955.   succeed;
  1956. }
  1957.  
  1958. static void
  1959. tty_werase(d)
  1960. register struct tty_driver *d;
  1961. { int last;
  1962.  
  1963.   do
  1964.   { last = d->in;
  1965.     Retreat(last);
  1966.   } while( isBlank(d->queue[last]) && tty_erase(d) );
  1967.  
  1968.   do
  1969.   { last = d->in;
  1970.     Retreat(last);
  1971.   } while( !isBlank(d->queue[last]) && tty_erase(d) );
  1972. }
  1973.  
  1974. static void
  1975. tty_kill(d)
  1976. register struct tty_driver *d;
  1977. { while( tty_erase(d) )
  1978.    ;
  1979. }
  1980.  
  1981. static bool
  1982. tty_endsline(d, c)
  1983. register struct tty_driver *d;
  1984. Char c;
  1985. { return c == '\n' || c == d->eol || c == d->eol2;
  1986. }
  1987.  
  1988. static bool
  1989. tty_insert(d, c)
  1990. register struct tty_driver *d;
  1991. Char c;
  1992. { d->queue[d->in] = c;
  1993.   Advance(d->in);
  1994.  
  1995.   if ( tty_endsline(d, c) )
  1996.     d->emitting++;
  1997.  
  1998.   if ( d->mode != TTY_RETYPE )
  1999.   { switch(c)
  2000.     { case '\t':
  2001.       tty_putc(c);
  2002.       d->column = ((d->column + 8)/8)*8;
  2003.       break;
  2004.       case '\n':
  2005.       tty_putc(c);
  2006.       d->column = 0;
  2007.       break;
  2008.       default:
  2009.       if ( c < ' ' || c == 127 )
  2010.       { tty_putc('^');
  2011.         tty_putc(c < ' ' ? c + '@' : '?');
  2012.         d->column += 2;
  2013.       } else if ( c < 127 )
  2014.       { tty_putc(c);
  2015.         d->column++;
  2016.       }
  2017.     }
  2018.   }
  2019.  
  2020.   succeed;
  2021. }
  2022.  
  2023. static void
  2024. tty_reprint(d)
  2025. register struct tty_driver *d;
  2026. { int n;
  2027.  
  2028.   tty_putc('\n');
  2029.   for(n = d->out; n != d->in; )
  2030.   { tty_putc(d->queue[n]);
  2031.     Advance(n)
  2032.   }
  2033. }
  2034.  
  2035. void
  2036. TtyAddChar(c)
  2037. Char c;
  2038. { add_char(&stdin_driver, c);
  2039. }
  2040.  
  2041. static void
  2042. add_char(d, c)
  2043. register struct tty_driver *d;
  2044. Char c;
  2045. { if ( d->flags & CRLF && c == '\r' )
  2046.     c = '\n';
  2047.  
  2048.   if ( c == d->werase )
  2049.     tty_werase(d);
  2050.   else if ( c == d->erase || c == d->erase2 )
  2051.     tty_erase(d);
  2052.   else if ( c == d->kill )
  2053.     tty_kill(d);
  2054.   else if ( c == d->reprint )
  2055.     tty_reprint(d);
  2056.   else if ( c == d->intr )
  2057.   { d->in = d->out = 0;        /* empty queue */
  2058.     d->emitting = 0;
  2059.     interruptHandler();
  2060.   }
  2061.   else
  2062.     tty_insert(d, c);
  2063.  
  2064.   fflush(stdout);        /* needed to get unbuffered output after a */
  2065.                       /* dump on hpux */
  2066. }
  2067.  
  2068. #if unix || EMX
  2069. #define GETC()    do_get_char()
  2070. #endif
  2071. #if tos
  2072. #define GETC()    tos_getch()
  2073.  
  2074. static Char
  2075. tos_getch(void)
  2076. { long t = clock();
  2077.   Char c = getch();
  2078.   wait_ticks += clock() - t;
  2079.  
  2080.   return c == '\r' ? '\n' : c;
  2081. }
  2082. #endif
  2083.  
  2084. static Char
  2085. GetCMap()
  2086. { Char c = GETC();
  2087.  
  2088. #if O_MAP_TAB_ON_ESC
  2089.   if ( c == '\t' )
  2090.     c = ESC;
  2091. #endif
  2092.  
  2093.   return c;
  2094. }
  2095.  
  2096.  
  2097. static Char
  2098. get_edit_char(d)
  2099. register struct tty_driver *d;
  2100. { Char c;
  2101.   
  2102.   if ( status.notty || !d->isatty )
  2103.     return do_get_char();
  2104.  
  2105.   DEBUG(3, printf("entering get_edit_char(); d->in = %d, d->out = %d\n",
  2106.           d->in, d->out));
  2107.   if ( d->mode == TTY_RAW )
  2108.   { if ( Empty(d) )
  2109.       return GetCMap();
  2110.   } else
  2111.   { while( d->emitting == 0 )
  2112.       add_char(d, GetCMap());
  2113.   }
  2114.   
  2115.   c = d->queue[d->out];
  2116.   DEBUG(3, printf("Returning %d (%c) from %d\n", c, c, d->out));
  2117.   Advance(d->out);
  2118.   if ( tty_endsline(d, c) )
  2119.     d->emitting--;    
  2120.  
  2121.   return c;
  2122. }
  2123.  
  2124. #if PROTO
  2125. void
  2126. PretendTyped(char c)
  2127. #else
  2128. void
  2129. PretendTyped(c)
  2130. char c;
  2131. #endif
  2132. { struct tty_driver *d = &stdin_driver;
  2133.  
  2134.   tty_insert(d, c);  
  2135.   d->emitting = FALSE;
  2136. }
  2137.  
  2138. #endif /* O_LINE_EDIT */
  2139.  
  2140. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2141. Read a character.   When using PCE  we  should be  prepared to  handle
  2142. notification correctly here.  Otherwise live is simple.
  2143. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2144.  
  2145. int (*PL_dispatch_events)() = NULL;
  2146.  
  2147. static Char
  2148. do_get_char()
  2149. { Char c;
  2150.  
  2151.   if ( PL_dispatch_events != NULL )
  2152.   { Atom sfn = source_file_name;    /* save over call-back */
  2153.     int  sln = source_line_no;
  2154.  
  2155.     DEBUG(3, printf("do_get_char() --> "));
  2156.     for(;;)
  2157.     { if ( (*PL_dispatch_events)() == PL_DISPATCH_INPUT )
  2158.       { char chr;
  2159.  
  2160.     if (read(0, &chr, 1) == 0)
  2161.       c = EOF;
  2162.     else
  2163.       c = (Char) chr;
  2164.     break;
  2165.       }
  2166.     }
  2167.  
  2168.     source_line_no   = sln;
  2169.     source_file_name = sfn;
  2170.     DEBUG(3, printf("%d (%c) --> ", c, c));
  2171.   } else
  2172.     c = (Char) getchar();
  2173.  
  2174.   return c;
  2175. }
  2176.  
  2177.  
  2178. Char
  2179. GetChar()
  2180. {
  2181. #if O_LINE_EDIT
  2182.   return (Char) get_edit_char(&stdin_driver);
  2183. #else
  2184.   return do_get_char();
  2185. #endif
  2186. }
  2187.  
  2188.         /********************************
  2189.         *      ENVIRONMENT CONTROL      *
  2190.         *********************************/
  2191.  
  2192. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2193. Simple  library  to  manipulate  the  Unix  environment.   The  modified
  2194. environment  will  be  passed  to  child  processes  and the can also be
  2195. requested via getenv/2 from Prolog.  Functions
  2196.  
  2197.     char *Setenv(name, value)
  2198.          char *name, *value;
  2199.     
  2200.     Set the Unix environment variable with name `name'.   If  it  exists
  2201.     its  value  is  changed, otherwise a new entry in the environment is
  2202.     created.  The return value is a pointer to the old value, or NULL if
  2203.     the variable is new.
  2204.  
  2205.     char *Unsetenv(name)
  2206.          char *name;
  2207.  
  2208.     Delete a variable from the environment.  Return  value  is  the  old
  2209.     value, or NULL if the variable did not exist.
  2210. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2211.  
  2212. #if tos
  2213. char **environ;
  2214. #else
  2215. extern char **environ;        /* Unix predefined environment */
  2216. #endif
  2217.  
  2218. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2219. Grow the environment array by one and return the (possibly  moved)  base
  2220. pointer to the new environment.
  2221. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2222.  
  2223. forwards char    **growEnviron P((char**, int));
  2224. forwards char    *matchName P((char *, char *));
  2225. forwards void    setEntry P((char **, char *, char *));
  2226.  
  2227. static char **
  2228. growEnviron(e, amount)
  2229. char **e;
  2230. int amount;
  2231. { static int filled;
  2232.   static int size = -1;
  2233.  
  2234.   if ( amount == 0 )            /* reset after a dump */
  2235.   { size = -1;
  2236.     return e;
  2237.   }
  2238.  
  2239.   if ( size < 0 )
  2240.   { register char **env, **e1, **e2;
  2241.  
  2242.     for(e1=e, filled=0; *e1; e1++, filled++)
  2243.       ;
  2244.     size = ROUND(filled+10+amount, 32);
  2245.     env = (char **)malloc(size * sizeof(char *));
  2246.     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
  2247.       ;
  2248.     *e2 = (char *) NULL;
  2249.     filled += amount;
  2250.  
  2251.     return env;
  2252.   }
  2253.  
  2254.   filled += amount;
  2255.   if ( filled + 1 > size )
  2256.   { register char **env, **e1, **e2;
  2257.   
  2258.     size += 32;
  2259.     env = (char **)realloc(e, size * sizeof(char *));
  2260.     for ( e1=e, e2=env; *e1; *e2++ = *e1++ )
  2261.       ;
  2262.     *e2 = (char *) NULL;
  2263.     
  2264.     return env;
  2265.   }
  2266.  
  2267.   return e;
  2268. }
  2269.  
  2270. static void
  2271. initEnviron()
  2272. {
  2273. #if tos
  2274.   environ = mainEnv;
  2275. #endif
  2276.   growEnviron(environ, 0);
  2277. }
  2278.  
  2279.  
  2280. static char *
  2281. matchName(e, name)
  2282. register char *e, *name;
  2283. { while( *name && *e == *name )
  2284.     e++, name++;
  2285.  
  2286.   if ( (*e == '=' || *e == EOS) && *name == EOS )
  2287.     return (*e == '=' ? e+1 : e);
  2288.  
  2289.   return (char *) NULL;
  2290. }
  2291.  
  2292.  
  2293. static void
  2294. setEntry(e, name, value)      
  2295. char **e;
  2296. char *name, *value;
  2297. { int l = (int)strlen(name);
  2298.  
  2299.   *e = (char *) malloc(l + strlen(value) + 2);
  2300.   strcpy(*e, name);
  2301.   e[0][l++] = '=';
  2302.   strcpy(&e[0][l], value);
  2303. }
  2304.  
  2305.   
  2306. char *
  2307. Setenv(name, value)
  2308. char *name, *value;
  2309. { char **e;
  2310.   char *v;
  2311.   int n;
  2312.  
  2313.   for(n=0, e=environ; *e; e++, n++)
  2314.   { if ( (v=matchName(*e, name)) != NULL )
  2315.     { if ( !streq(v, value) )
  2316.         setEntry(e, name, value);
  2317.       return v;
  2318.     }
  2319.   }
  2320.   environ = growEnviron(environ, 1);
  2321.   setEntry(&environ[n], name, value);
  2322.   environ[n+1] = (char *) NULL;
  2323.  
  2324.   return (char *) NULL;
  2325. }
  2326.  
  2327.  
  2328. char *
  2329. Unsetenv(name)
  2330. char *name;
  2331. { char **e;
  2332.   char *v;
  2333.   int n;
  2334.  
  2335.   for(n=0, e=environ; *e; e++, n++)
  2336.   { if ( (v=matchName(*e, name)) != NULL )
  2337.     { environ = growEnviron(environ, -1);
  2338.       e = &environ[n];
  2339.       do
  2340.       { e[0] = e[1];
  2341.         e++;
  2342.       } while(*e);
  2343.  
  2344.       return v;
  2345.     }
  2346.   }
  2347.  
  2348.   return (char *) NULL;
  2349. }
  2350.  
  2351.         /********************************
  2352.         *       SYSTEM PROCESSES        *
  2353.         *********************************/
  2354.  
  2355. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2356. Invokation of system commands.  We could have used Unix system() library
  2357. call.  The reason I implemented  it  using  lower  level  primitives  is
  2358. twofold.   First I want to set the environment PROLOGCHILD, which allows
  2359. us to block novice users from invoking ?-  shell.   %  pl,  ....  (which
  2360. happens  often  with new students).  Second I want to close non-terminal
  2361. related I/O in the child process.
  2362.  
  2363.     int System(command)
  2364.     char *command;
  2365.  
  2366.     Invoke a command on the operating system.  The return value  is  the
  2367.     exit  status  of  the  command.   Return  value  0 implies succesful
  2368.     completion. If you are not running Unix your C-library might provide
  2369.     an alternative.
  2370. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2371.  
  2372. #if unix
  2373. #if !v7
  2374. #include <sys/wait.h>
  2375. #endif
  2376.  
  2377. int
  2378. System(cmd)
  2379. char *cmd;
  2380. { int pid;
  2381.   char *shell;
  2382.   ttybuf buf;
  2383.   int rval;
  2384.   void (*old_int)();
  2385.   void (*old_stop)();
  2386.  
  2387.   Setenv("PROLOGCHILD", "yes");
  2388.  
  2389. /*if ((shell = getenv("SHELL")) == (char *)NULL) bourne shell for speed now */
  2390.     shell = "/bin/sh";
  2391.  
  2392.   PushTty(&buf, TTY_SAVE);
  2393.   PopTty(&ttytab);            /* restore cooked mode */
  2394.  
  2395.   if ( (pid = vfork()) == -1 )
  2396.   { return warning("Fork failed: %s\n", OsError());
  2397.   } else if ( pid == 0 )        /* The child */
  2398.   { int i;
  2399.  
  2400.     for(i = 3; i < GetDTableSize(); i++)
  2401.       close(i);
  2402.     stopItimer();
  2403.  
  2404.     execl(shell, BaseName(shell), "-c", cmd, (char *)0);
  2405.     fatalError("Failed to execute %s: %s", shell, OsError());
  2406.     fail;
  2407.     /*NOTREACHED*/
  2408.   } else
  2409. #if v7 || hpux
  2410.   { int waitstat, retstat;        /* the parent */
  2411.  
  2412.     old_int  = signal(SIGINT,  SIG_IGN);
  2413.     old_stop = signal(SIGTSTP, SIG_DFL);
  2414.  
  2415.     while( (waitstat = Wait(&retstat)) != pid && waitstat != -1 )
  2416.       ;
  2417.     if ( waitstat == -1 )
  2418.     {  warning("Failed to execute %s", cmd);
  2419.        rval = 1;
  2420.     }
  2421.  
  2422.     rval = retstat;
  2423.   }
  2424. #else /* v7 */
  2425.   { union wait status;            /* the parent */
  2426.     int n;
  2427.  
  2428.     old_int  = signal(SIGINT,  SIG_IGN);
  2429.     old_stop = signal(SIGTSTP, SIG_DFL);
  2430.  
  2431.     while((n = Wait(&status)) != -1 && n != pid);
  2432.     if (n == -1)
  2433.     { warning("Failed to execute %s", cmd);
  2434.       rval = 1;
  2435.     } else if (WIFEXITED(status))
  2436.     { rval = status.w_retcode;
  2437.     } else if (WIFSIGNALED(status))
  2438.     { warning("Child %s catched signal %d\n", cmd, status.w_termsig);
  2439.       rval = 1;
  2440.     } else
  2441.     { rval = 1;                /* make gcc happy */
  2442.       fatalError("Unknown return code from wait(3)");
  2443.       /*NOTREACHED*/
  2444.     }
  2445.   }
  2446. #endif /* v7 */
  2447.  
  2448.   signal(SIGINT,  old_int);        /* restore signal handlers */
  2449.   signal(SIGTSTP, old_stop);
  2450.   PopTty(&buf);
  2451.  
  2452.   return rval;
  2453. }
  2454. #endif /* unix */
  2455.  
  2456. #if tos
  2457. #include <aes.h>
  2458.  
  2459. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2460. The routine system_via_shell() has been written by Tom Demeijer.  Thanks!
  2461. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2462.  
  2463. #define _SHELL_P ((long *)0x4f6L)
  2464. #define SHELL_OK (do_sys != 0)
  2465.  
  2466. int cdecl (*do_sys)(const char *cmd); /* Parameter on stack ! */
  2467.  
  2468. static int
  2469. system_via_shell(const char *cmd)
  2470. { long oldssp;
  2471.  
  2472.   oldssp = Super((void *)0L);
  2473.   do_sys = (void (*))*_SHELL_P;
  2474.   Super((void *)oldssp);
  2475.  
  2476.   if(cmd==NULL && SHELL_OK)
  2477.     return 0;
  2478.  
  2479.   if (SHELL_OK)
  2480.     return do_sys(cmd);
  2481.  
  2482.   return -1;
  2483. }
  2484.  
  2485. int
  2486. System(command)
  2487. char *command;
  2488. { char       path[MAXPATHLEN];
  2489.   char       *cmd_path;
  2490.   COMMAND  commandline;
  2491.   char       *s, *q;
  2492.   int       status, l;
  2493.   char       *cmd = command;
  2494.  
  2495.   if ( (status = system_via_shell(command)) != -1 )
  2496.   { printf("\033e");        /* get cursor back */
  2497.  
  2498.     return status;
  2499.   }
  2500.  
  2501.     /* get the name of the executable and store in path */
  2502.   for(s=path; *cmd != EOS && !isBlank(*cmd); *s++ = *cmd++)
  2503.     ;
  2504.   *s = EOS;
  2505.   if ( (cmd_path = Which(path)) == NULL )
  2506.   { warning("%s: command not found", path);
  2507.     return 1;
  2508.   }
  2509.  
  2510.     /* copy the command in commandline */
  2511.   while( isBlank(*cmd) )
  2512.     cmd++;
  2513.  
  2514.   for(l = 0, s = cmd, q = commandline.command_tail; *s && l <= 126; s++ )
  2515.   { if ( *s != '\'' )
  2516.     { *q++ = (*s == '/' ? '\\' : *s);
  2517.       l++;
  2518.     }
  2519.   }
  2520.   commandline.length = l;
  2521.   *q = EOS;
  2522.   
  2523.     /* execute the command */
  2524.   if ( (status = (int) Pexec(0, OsPath(cmd_path), &commandline, NULL)) < 0 )
  2525.   { warning("Failed to execute %s: %s", command, OsError());
  2526.     return 1;
  2527.   }
  2528.  
  2529.     /* clean up after a graphics application */
  2530.   if ( strpostfix(cmd_path, ".prg") || strpostfix(cmd_path, ".tos") )
  2531.   { graf_mouse(M_OFF, NULL);        /* get rid of the mouse */
  2532.     printf("\033e\033E");        /* clear screen and get cursor */
  2533.   }  
  2534.  
  2535.   return status;
  2536. }
  2537. #endif
  2538.  
  2539. /* OS/2 does not have the same problems as Unix(tm). We simply fire up a
  2540.    shell that does the job.
  2541. */
  2542.  
  2543. #if OS2 && EMX
  2544. int
  2545. System(command)
  2546. char *command;
  2547. {
  2548.   return system(command);
  2549. }
  2550. #endif /* OS2 */
  2551.  
  2552. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2553.     char *Symbols()
  2554.  
  2555.     Return the path name of the executable of SWI-Prolog. Used by the -c
  2556.     compiler to generate the #!<path> header line and by the incremental
  2557.     loader, who gives this path to ld, using ld -A <path>.
  2558. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2559.  
  2560. #if unix || EMX
  2561. char *
  2562. Symbols()
  2563. { return Which(PrologPath(mainArgv[0]));
  2564. }
  2565. #endif
  2566.  
  2567. #if tos
  2568. char *
  2569. Symbols()
  2570. { return "pl1.5";
  2571. }
  2572. #endif
  2573.  
  2574. #if unix
  2575. static char *
  2576. okToExec(s)
  2577. char *s;
  2578. { struct stat stbuff;
  2579. #if !LINUX
  2580.   extern int access(/*char *, int*/);
  2581. #endif
  2582.  
  2583.   if (stat(s, &stbuff) == 0 &&            /* stat it */
  2584.      (stbuff.st_mode & S_IFMT) == S_IFREG &&    /* check for file */
  2585.      access(s, X_OK) == 0)            /* can be executed? */
  2586.     return s;
  2587.   else
  2588.     return (char *) NULL;
  2589. }
  2590.  
  2591. #define PATHSEP    ':'
  2592. #endif /* unix */
  2593.  
  2594. #if tos
  2595. static char *
  2596. okToExec(s)
  2597. char *s;
  2598. { static char path[MAXPATHLEN];
  2599.  
  2600.   DEBUG(2, printf("Checking %s\n", s));
  2601.   if ( strpostfix(s, ".ttp" ) || strpostfix(s, ".prg") )
  2602.     return ExistsFile(s) ? s : (char *) NULL;
  2603.  
  2604.   strcpy(path, s);
  2605.   strcat(path, ".ttp");
  2606.   DEBUG(2, printf("Checking %s\n", path));
  2607.   if ( ExistsFile(path) == TRUE )
  2608.     return path;
  2609.   strcpy(path, s);
  2610.   strcat(path, ".prg");
  2611.   DEBUG(2, printf("Checking %s\n", path));
  2612.   if ( ExistsFile(path) == TRUE )
  2613.     return path;
  2614.   return (char *) NULL;
  2615. }
  2616.  
  2617. #define PATHSEP ','
  2618. #endif /* tos */
  2619.  
  2620. #if OS2 && EMX
  2621. static char *
  2622. okToExec(s)
  2623. char *s;
  2624. { static char path[MAXPATHLEN];
  2625.  
  2626.   DEBUG(2, printf("Checking %s\n", s));
  2627.   if (strpostfix(s, ".exe") ||
  2628.       strpostfix(s, ".com") ||
  2629.       strpostfix(s, ".bat") ||
  2630.       strpostfix(s, ".cmd"))
  2631.     return ExistsFile(s) ? s : (char *) NULL;
  2632.  
  2633.   strcpy(path, s);
  2634.   strcat(path, ".exe");
  2635.   DEBUG(2, printf("Checking %s\n", path));
  2636.   if ( ExistsFile(path) == TRUE )
  2637.     return path;
  2638.   strcpy(path, s);
  2639.   strcat(path, ".com");
  2640.   DEBUG(2, printf("Checking %s\n", path));
  2641.   if ( ExistsFile(path) == TRUE )
  2642.     return path;
  2643.   strcpy(path, s);
  2644.   strcat(path, ".cmd");
  2645.   DEBUG(2, printf("Checking %s\n", path));
  2646.   if ( ExistsFile(path) == TRUE )
  2647.     return path;
  2648.   strcpy(path, s);
  2649.   strcat(path, ".bat");
  2650.   DEBUG(2, printf("Checking %s\n", path));
  2651.   if ( ExistsFile(path) == TRUE )
  2652.     return path;
  2653.   return (char *) NULL;
  2654. }
  2655.  
  2656. #define PATHSEP ';'
  2657. #endif /* OS2 */
  2658.  
  2659. static char *
  2660. Which(program)
  2661. char *program;
  2662. { static char fullname[MAXPATHLEN];
  2663.   char *path, *dir;
  2664.   char *e;
  2665.  
  2666.   if ( isAbsolutePath(program) ||
  2667. #if OS2 && EMX
  2668.        isDriveRelativePath(program) ||
  2669. #endif /* OS2 */
  2670.        isRelativePath(program) ||
  2671.        index(program, '/') )
  2672.   { if ( (e = okToExec(program)) != NULL )
  2673.     { strcpy(fullname, e);
  2674.       
  2675.       return fullname;
  2676.     }
  2677.  
  2678.     return NULL;
  2679.   }
  2680.  
  2681. #if OS2 && EMX
  2682.   if ((e = okToExec(program)) != NULL)
  2683.   {
  2684.     getwd(fullname);
  2685.     strcat(fullname, "/");
  2686.     strcat(fullname, e);
  2687.     return fullname;
  2688.   }
  2689. #endif /* OS2 */
  2690.   if  ((path = getenv("PATH") ) == 0)
  2691.     path = DEFAULT_PATH;
  2692.  
  2693.   while(*path)
  2694.   { if ( *path == PATHSEP )
  2695.     { if ( (e = okToExec(program)) != NULL)
  2696.       { strcpy(fullname, e);
  2697.  
  2698.         return fullname;
  2699.       } else
  2700.         return NULL;
  2701.     } else
  2702.     { for(dir = fullname; *path && *path != PATHSEP; *dir++ = *path++)
  2703.     ;
  2704.       if (*path)
  2705.     path++;                        /* skip : */
  2706.       if (strlen(fullname) + strlen(program)+2 > MAXPATHLEN)
  2707.         continue;
  2708.       *dir++ = '/';
  2709.       *dir = EOS;
  2710.       strcpy(dir, program);
  2711.       if ( (e = okToExec(OsPath(fullname))) != NULL )
  2712.     return e;
  2713.     }
  2714.   }
  2715.  
  2716.   return NULL;
  2717. }
  2718.  
  2719.  
  2720. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  2721.     void Sleep(time)
  2722.      real time;
  2723.  
  2724.     Suspend execution `time' seconds.   Time  is  given  as  a  floating
  2725.     point,  expressing  the  time  to sleep in seconds.
  2726. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  2727.  
  2728. #if unix
  2729. #if minix            /* v7 unix does not have fine granularity */
  2730. void                /* timer. Just use sleep() */
  2731. Sleep(time)
  2732. real time;
  2733. { if ( time < 0.5 )
  2734.     return;
  2735.   sleep( (int)(time+0.5) );
  2736. }
  2737.  
  2738. #else /* has select() */
  2739.  
  2740. void
  2741. Sleep(time)            /* system has select() */
  2742. real time;
  2743. { struct timeval timeout;
  2744.  
  2745.   if ( time <= 0.0 )
  2746.     return;
  2747.  
  2748.   if ( time < 60.0 )        /* select() is expensive. Does it make sense */
  2749.   { timeout.tv_sec = (int) time;
  2750.     timeout.tv_usec = (int)(time * 1000000) % 1000000;
  2751.     select(32, NULL, NULL, NULL, &timeout);
  2752.   } else
  2753.     sleep( (int)(time+0.5) );
  2754. }
  2755. #endif /* has select() */
  2756. #endif /* unix */
  2757.  
  2758. #if OS2 && EMX                  /* the OS/2 API call for DosSleep allows */
  2759. void                            /* a millisecond granualrity. */
  2760. Sleep(time)                     /* the EMX function sleep uses a seconds */
  2761. real time;                      /* granularity only. */
  2762. {                               /* the select() trick does not work at all. */
  2763.   if ( time <= 0.0 )
  2764.     return;
  2765.  
  2766.   DosSleep((ULONG)(time * 1000));
  2767. }
  2768. #endif /* OS2 */
  2769.  
  2770. #if tos
  2771. void
  2772. Sleep(t)
  2773. real t;
  2774. { long wait = (long)(t * 200.0);
  2775.   long start_tick = clock();
  2776.   long end_tick = wait + start_tick;
  2777.  
  2778.   while( clock() < end_tick )
  2779.   { if ( kbhit() )
  2780.     { wait_ticks += clock() - start_tick;
  2781.       start_tick = clock();
  2782.       TtyAddChar(getch());
  2783.     }
  2784.   }
  2785.  
  2786.   wait_ticks += end_tick - start_tick;
  2787. }
  2788. #endif
  2789.