home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-file.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  33KB  |  1,684 lines
  1. /*  pl-file.c,v 1.11 1993/02/23 13:16:30 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: file system i/o
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. This module is far too big.  It defines a layer around open(), etc.   to
  12. get  opening  and  closing  of  files to the symbolic level required for
  13. Prolog.  It also defines basic I/O  predicates,  stream  based  I/O  and
  14. finally  a  bundle  of  operations  on  files,  such  as name expansion,
  15. renaming, deleting, etc.  Most of this module is rather straightforward.
  16.  
  17. If time is there I will have a look at all this to  clean  it.   Notably
  18. handling times must be cleaned, but that not only holds for this module.
  19. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  20.  
  21. #include "pl-incl.h"
  22. #include "pl-ctype.h"
  23. #if unix || EMX
  24. #include <sys/time.h>
  25. #include <sys/file.h>
  26. #endif
  27.  
  28. #define MAXSTRINGNEST    20        /* tellString --- Told nesting */
  29.  
  30. #if AIX || hpux
  31. #define file prolog_file
  32. #define File PrologFile
  33. #endif
  34.  
  35. typedef struct file *    File;
  36.  
  37. static struct file
  38. { Atom        name;            /* name of file */
  39.   Atom        stream_name;        /* stream identifier name */
  40.   FILE *    fd;            /* Unix file descriptor */
  41.   int        lineno;            /* current line no */
  42.   long        charno;            /* character count */
  43.   int        linepos;        /* position in line */
  44.   int        status;            /* opened, how ? */
  45.   bool        pipe;            /* opened as a pipe ? */
  46.   bool        isatty;            /* Stream connects to a terminal */
  47. } *fileTable = (File) NULL;        /* Our file table */
  48.  
  49. int     Input;                /* current input */
  50. int    Output;                /* current output */
  51.  
  52. ttybuf    ttytab;                /* saved terminal status on entry */
  53. int    ttymode;            /* Current tty mode */
  54.  
  55. static Atom prompt_atom;        /* current prompt */
  56. int    protocolStream = -1;        /* doing protocolling on stream <n> */
  57.  
  58. static struct
  59. { char *string;
  60.   long  left;
  61. } outStringStack[MAXSTRINGNEST];    /* maximum depth to nest string i/o */
  62. int outStringDepth = 0;            /* depth of nesting */
  63. static char *inString;            /* string for reading */
  64.  
  65. static int   maxfiles;            /* maximum file index */
  66. static int   ttyLinePos;            /* current column on tty */
  67. static int   ttyLineNo;            /* terminal line number count */
  68. static int   ttyCharNo;            /* terminal character count */
  69. static bool  fileerrors = TRUE;        /* give warning on open errors? */
  70. #if O_FOLD
  71. static int   fold = O_FOLD;        /* default line folding */
  72. #else
  73. static int   fold = -1;            /* line folding */
  74. #endif
  75.  
  76. #ifdef SIGSTOP
  77. #define JOBCONTROL 1
  78. #endif
  79.  
  80. #if JOBCONTROL
  81. forwards void    stopHandler P((void));
  82. #endif
  83. forwards void    pipeHandler P((void));
  84. forwards void    protocol P((Char c, int mode));
  85. forwards bool    openStream P((word file, int mode, int fresh));
  86. forwards bool    flush P((void));
  87. forwards bool    openProtocol P((Atom, bool appnd));
  88. forwards bool    closeProtocol P((void));
  89. forwards bool    closeStream P((int));
  90. forwards void    updateCounts P((Char, File));
  91. forwards bool    unifyStreamName P((Word, int));
  92. forwards bool    unifyStreamNo P((Word, int));
  93. forwards bool    setUnifyStreamNo P((Word, int));
  94. forwards bool    unifyStreamMode P((Word, int));
  95.  
  96.  
  97. #if JOBCONTROL
  98. /*  Signal handler for SIGTSTP (user typing  ^Z).  Restores the  terminal
  99.     flags  to when Prolog was started and restores them to their current
  100.     setting after the continue.
  101.  
  102.  ** Sun Jun 19 16:32:30 1988  jan@swivax.UUCP (Jan Wielemaker)  */
  103.  
  104. static
  105. void
  106. stopHandler()
  107. { ttybuf tab;
  108.  
  109.   if (novice == TRUE)
  110.   { warning("Job control (^Z) disabled");
  111.     return;
  112.   }
  113.  
  114.   PushTty(&tab, TTY_SAVE);
  115.   PopTty(&ttytab);
  116.   kill(getpid(), SIGSTOP);        /* Who has SISSTOP probably also */
  117.   PopTty(&tab);                /* has kill() and getpid() */
  118. }
  119. #endif /* JOBCONTROL */
  120.  
  121. #if PIPE
  122. static void
  123. pipeHandler()
  124. { Putf("Broken pipe\n");
  125.   pl_abort();
  126.  
  127.   signal(SIGPIPE, SIG_DFL);        /* should abort fail. */
  128.   kill(getpid(), SIGPIPE);        /* Unix has both pipes and kill() */
  129. }
  130. #endif /* PIPE */
  131.  
  132. void
  133. initIO()
  134. { int n;
  135.  
  136.   if ( maxfiles != GetDTableSize() )
  137.   { if ( fileTable != (File) NULL )
  138.       freeHeap(fileTable, (File) allocHeap(sizeof(struct file) * maxfiles));
  139.     maxfiles = GetDTableSize();
  140.     fileTable = (File) allocHeap(sizeof(struct file) * maxfiles);
  141.   }
  142.   inString = (char *) NULL;
  143.   outStringDepth = 0;
  144.  
  145.   for(n=0; n<maxfiles; n++)
  146.   { fileTable[n].name = (Atom) NULL;
  147.     fileTable[n].status = F_CLOSED;
  148.     fileTable[n].fd = (FILE *) NULL;
  149.     fileTable[n].lineno = 1;
  150.     fileTable[n].linepos = 0;
  151.     fileTable[n].charno = 0L;
  152.     fileTable[n].pipe = FALSE;
  153.   }
  154.  
  155.   ttyCharNo = ttyLinePos = 0;
  156.   ttyLineNo = 1;
  157.  
  158. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  159. Initilise user input, output and error stream.  How to do this neat without
  160. the Unix assumptions?
  161. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  162.  
  163.   for(n=0; n<3; n++)
  164.   { if ( OpenStream(n) )
  165.     { fileTable[n].isatty = IsaTty(n);
  166.  
  167.       switch(n)
  168.       { case 0:
  169.       if ( fileTable[n].isatty == FALSE )
  170.         status.notty = TRUE;
  171.       fileTable[n].name = ATOM_user;
  172.       fileTable[n].stream_name = ATOM_user_input;
  173.       fileTable[n].status = F_READ;
  174.       fileTable[n].fd = stdin;
  175.       break;
  176.     case 1:
  177.       fileTable[n].name = ATOM_user;
  178.       fileTable[n].stream_name = ATOM_user_output;
  179.       fileTable[n].status = F_WRITE;
  180.       fileTable[n].fd = stdout;
  181.       break;
  182.     case 2:
  183.       fileTable[n].name = ATOM_stderr;
  184.       fileTable[n].stream_name = ATOM_user_error;
  185.       fileTable[n].status = F_WRITE;
  186.       fileTable[n].fd = stderr;
  187.       break;
  188.       }
  189.     } else
  190.       warning("Stream %d is not open", n);
  191.   }
  192.  
  193.   ttymode = TTY_COOKED;            /* initial tty mode */
  194.   PushTty(&ttytab, TTY_COOKED);
  195. #if O_LINE_EDIT
  196.   stdin_driver.eol = ttytab.tab.c_cc[ VEOF ] ;
  197. #endif /* O_LINE_EDIT */
  198.   ResetTty();
  199. #if JOBCONTROL
  200.   signal(SIGTSTP, stopHandler);
  201. #endif
  202.  
  203.   Input = 0;
  204.   Output = 1;
  205.  
  206.   if ( prompt_atom == (Atom) NULL )
  207.     prompt_atom = ATOM_prompt;
  208. }
  209.  
  210. void
  211. dieIO()
  212. { if ( status.io_initialised == TRUE )
  213.   { closeProtocol();
  214.     closeFiles();
  215.     PopTty(&ttytab);
  216.   }
  217. }
  218.  
  219. static bool
  220. closeStream(n)
  221. int n;
  222. { if ( n < 3 || fileTable[n].status == F_CLOSED )
  223.     succeed;
  224.  
  225. #if PIPE
  226.   if (fileTable[n].pipe == TRUE)
  227.     Pclose(fileTable[n].fd);
  228.   else
  229. #endif /* PIPE */
  230.     Fclose(fileTable[n].fd);
  231.   fileTable[n].status = F_CLOSED;
  232.   fileTable[n].name = fileTable[n].stream_name = (Atom) NULL;
  233.   fileTable[n].pipe = FALSE;
  234.  
  235.   succeed;
  236. }
  237.  
  238. void
  239. closeFiles()
  240. { int n;
  241. #if O_PCE
  242.   extern int read_nesting;
  243.   read_nesting = 0;
  244. #endif
  245.  
  246.   for(n=3; n<maxfiles; n++)
  247.   { if ( n != protocolStream )
  248.       closeStream(n);
  249.   }
  250.  
  251.   Input = 0;
  252.   Output = 1;
  253. }
  254.  
  255. static void
  256. protocol(c, mode)
  257. register Char c;
  258. int mode;
  259. { if ( mode == F_READ && ttymode >= TTY_RAW ) /* Non-echo mode: do not log */
  260.     return;
  261.  
  262.   ttyCharNo++;
  263.  
  264.   switch(c)
  265.   { case '\n':    ttyLinePos = 0;
  266.         ttyLineNo++;
  267.         break;
  268.     case '\t':    ttyLinePos |= 7;
  269.         ttyLinePos++;
  270.         break;
  271.     case '\b':    if (ttyLinePos > 0)
  272.           ttyLinePos--;
  273.         break;
  274.     case EOF:    return;
  275.     default:    ttyLinePos++;
  276.         break;
  277.   }
  278.  
  279.   if ( protocolStream >= 0 )
  280.   { int out;
  281.   
  282.     out = Output;
  283.     Output = protocolStream;
  284.     Put(c);
  285.     Output = out;
  286.   }
  287. }
  288.  
  289. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  290. read() first checks the input stream and calls  getc(fd)  directly  when
  291. reading from a file.  This procedure checks whether this is possible and
  292. returns the file descriptor.
  293. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  294.  
  295. void
  296. newLineInput()
  297. { fileTable[Input].lineno++;
  298.   fileTable[Input].linepos = 0;
  299. }
  300.  
  301. FILE *
  302. checkInput(stream)
  303. int stream;
  304. { if ( inString ||
  305.        fileTable[stream].status != F_READ ||
  306.        stream == 0)
  307.     return (FILE *) NULL;
  308.  
  309.   return fileTable[Input].fd;
  310. }
  311.        
  312. static void
  313. updateCounts(c, f)
  314. register Char c;
  315. register File f;
  316. { f->charno++;
  317.   switch(c)
  318.   { case '\n':  f->lineno++;
  319.         f->linepos = 0;
  320.         break;
  321.     case '\t':  f->linepos |= 7;
  322.         f->linepos++;
  323.         break;
  324.     case '\b':  if ( f->linepos > 0 )
  325.           f->linepos--;
  326.         break;
  327.     default:    f->linepos++;
  328.   }
  329. }
  330.  
  331.  
  332. int
  333. currentLinePosition()
  334. { if ( outStringDepth > 0 )
  335.   { return 0;                /* TBD */
  336.   } else
  337.     return fileTable[Output].isatty ? ttyLinePos : fileTable[Output].linepos;
  338. }
  339.  
  340.  
  341. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  342. Get a character from the current input stream, which is either a file or
  343. a string.  Reading from strings is used to implement predicates such  as
  344. atom_to_term/2.   This  function  is  of  type `Char' (an int) to ensure
  345. portable transfer of EOF.
  346.  
  347. This function is normally called via the macro Get0().
  348. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  349.  
  350. Char
  351. get_character()
  352. { Char c;
  353.  
  354.   if ( inString )
  355.   { if ( *inString == EOS )
  356.       return EOF;
  357.     return (Char) *inString++;
  358.   }
  359.  
  360.   if (fileTable[Input].status != F_READ)
  361.   { warning("No current input stream");
  362.     return (Char) EOF;
  363.   }
  364.  
  365.   if ( fileTable[Input].isatty )
  366.   { if ( ttyLinePos != 0 )
  367.       pl_ttyflush();
  368.     c = (Input == 0 ? GetChar() : Getc(fileTable[Input].fd));
  369.     protocol(c, F_READ);
  370.   } else
  371.   { c = Getc(fileTable[Input].fd);
  372.     updateCounts(c, &fileTable[Input]);
  373.   }
  374.       
  375.   return c;
  376. }
  377.  
  378. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  379. Get a single character from the terminal without waiting for  a  return.
  380. The  character  should  not  be  echoed.   If  status.notty is true this
  381. function will read the first character and then skip all character  upto
  382. and including the newline.
  383. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  384.  
  385. Char
  386. getSingleChar()
  387. { Char c;
  388.   int OldIn = Input;
  389.  
  390.   Input = 0;
  391.   debugstatus.suspendTrace++;
  392.   
  393.   if ( status.notty )
  394.   { Char c2;
  395.  
  396.     c2 = Get0();
  397.     while( c2 == ' ' || c2 == '\t' )    /* skip blanks */
  398.       c2 = Get0();
  399.     c = c2;
  400.     while( c2 != EOF && c2 != '\n' )    /* read upto newline */
  401.       c2 = Get0();
  402.   } else
  403.   { ttybuf buf;
  404.     
  405.     PushTty(&buf, TTY_RAW);        /* switch to raw mode */
  406.     c = Get0();
  407.     PopTty(&buf);            /* restore tty */
  408.   }
  409.  
  410.   Input = OldIn;
  411.   debugstatus.suspendTrace--;
  412.  
  413.   return c;
  414. }
  415.  
  416. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  417. The central character output function.  Normally called  via  the  macro
  418. Put(c) which includes automatic casting of the argument to `Char', so no
  419. problems  arise  on  machines with different argument passing for `char'
  420. and `int'
  421. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  422.  
  423. bool
  424. put_character(c)
  425. Char c;
  426. { if ( outStringDepth > 0 )
  427.   { if ( outStringStack[outStringDepth].left-- <= 0 )
  428.       fail;
  429.     *outStringStack[outStringDepth].string++ = (char) c;
  430.  
  431.     succeed;
  432.   }
  433.  
  434.   if ( fileTable[Output].status != F_WRITE )
  435.     return warning("No current output stream");
  436.  
  437.   Putc(c, fileTable[Output].fd);
  438.  
  439.   if ( fileTable[Output].isatty )
  440.   { protocol(c, F_WRITE);
  441.     if ( fold > 0 && ttyLinePos > fold )
  442.       Put('\n');
  443.     if ( ttyLinePos == 0 )            /* just put a newline */
  444.     { Fflush(fileTable[Output].fd);
  445.     }
  446.   } else
  447.   { updateCounts(c, &fileTable[Output]);
  448.   }
  449.  
  450.   succeed;
  451. }
  452.  
  453. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  454. Formated put.  It would be better to define our own formated  write  for
  455. this  which  accepts  both  Prolog data structures (ints, floats, atoms,
  456. etc) and C data structures.
  457. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  458.  
  459. /*VARARGS1*/
  460. word
  461. #if ANSI && !AIX
  462. Putf(char *fm, ...)
  463. { va_list args;
  464.  
  465.   va_start(args, fm);
  466.   vPutf(fm, args);
  467.   va_end(args);
  468.  
  469.   succeed;
  470. }
  471.  
  472. #else
  473.  
  474. Putf(va_alist)
  475. va_dcl
  476. { va_list args;
  477.   char *fm;
  478.  
  479.   va_start(args);
  480.   fm = va_arg(args, char *);
  481.   vPutf(fm, args);
  482.   va_end(args);
  483.  
  484.   succeed;
  485. }
  486. #endif
  487.  
  488. word
  489. vPutf(fm, args)
  490. char *fm;
  491. va_list args;
  492. { char tmp[10240];
  493.   char *s;
  494.  
  495.   vsprintf(tmp, fm, args);
  496.  
  497.   for(s=tmp; *s; s++)
  498.     TRY(Put(*s) );
  499.  
  500.   succeed;
  501. }
  502.  
  503. bool
  504. readLine(buf, stream)
  505. char *buf;
  506. int stream;
  507. { int oldin = Input;
  508.   Char c;
  509.  
  510.   Input = stream;
  511.   while( (c=Get0()) != EOF && c != '\n' && c != '\r' )
  512.     *buf++ = c;
  513.  
  514.   *buf++ = EOS;
  515.   Input = oldin;
  516.  
  517.   return c == EOF ? FALSE : TRUE;
  518. }
  519.  
  520. int
  521. currentInputLine()
  522. { return fileTable[Input].isatty ? ttyLineNo : fileTable[Input].lineno;
  523. }
  524.  
  525. static bool
  526. openStream(file, mode, fresh)
  527. word file;
  528. int mode;
  529. bool fresh;
  530. { int n;
  531.   FILE *fd;
  532.   char *cmode;
  533.   Atom f;
  534.   bool pipe;
  535.  
  536.   DEBUG(2, printf("openStream file=0x%lx, mode=%d\n", file, mode));
  537.   if (isAtom(file))
  538.   { pipe = FALSE;
  539.     f = (Atom) file;
  540.   } else if (isTerm(file) && functorTerm(file) == FUNCTOR_pipe1)
  541.   {
  542. #if PIPE
  543.     pipe = TRUE;
  544.     f = (Atom) argTerm(file, 0);
  545.     signal(SIGPIPE, pipeHandler);
  546. #else
  547.     return warning("Pipes are not supported on this OS");
  548. #endif /* PIPE */
  549.   } else
  550.     return warning("Illegal stream specification");
  551.  
  552.   DEBUG(3, printf("File/command name = %s\n", stringAtom(f)));
  553.   if ( pipe == FALSE )
  554.   { if ( mode == F_READ )
  555.     { if ( f == ATOM_user || f == ATOM_user_input )
  556.       { Input = 0;
  557.     succeed;
  558.       }
  559.     } else
  560.     { if ( f == ATOM_user || f == ATOM_user_output )
  561.       { Output = 1;
  562.         succeed;
  563.       }
  564.       if ( f == ATOM_user_error || f == ATOM_stderr )
  565.       { Output = 2;
  566.     succeed;
  567.       }
  568.     }
  569.   } else
  570.   { if ( mode == F_APPEND )
  571.       return warning("Cannot open a pipe in `append' mode");
  572.   }
  573.     
  574.   if ( !fresh )
  575.   { for(n=0; n<maxfiles; n++)
  576.     { if (fileTable[n].name == f && fileTable[n].pipe == pipe)
  577.       { if (fileTable[n].status == mode)
  578.     { switch(mode)
  579.       { case F_READ:    Input = n; break;
  580.         case F_WRITE:
  581.         case F_APPEND:    Output = n; break;
  582.       }
  583.       DEBUG(3, printf("Switched back to already open stream %d\n", n));
  584.       succeed;
  585.     } else
  586.     { closeStream(n);
  587.     }
  588.     break;
  589.       }
  590.     }
  591.   }
  592.  
  593.   DEBUG(2, printf("Starting Unix open\n"));
  594.   cmode = (mode == F_READ ? "r" : mode == F_WRITE ? "w" : "a");
  595.  
  596. #if PIPE
  597.   if (pipe)
  598.   { if ((fd=Popen(stringAtom(f), cmode)) == (FILE *) NULL)
  599.     { if (fileerrors)
  600.     warning("Cannot open pipe %s: %s", stringAtom(f), OsError());
  601.       fail;
  602.     }
  603.   } else
  604. #endif
  605.   { char *name = ExpandOneFile(stringAtom(f));
  606.  
  607.     if ( name == (char *)NULL )
  608.       fail;
  609.  
  610.     if ((fd=Fopen(name, cmode)) == (FILE *) NULL)
  611.     { if (fileerrors)
  612.     warning("Cannot open %s: %s", stringAtom(f), OsError());
  613.       fail;
  614.     }
  615.   }
  616.  
  617.   DEBUG(2, printf("Unix open succeeded in fd=%d\n", n));
  618.  
  619.   n = fileno(fd);
  620.   fileTable[n].name = f;
  621.   fileTable[n].stream_name = NULL;
  622.   fileTable[n].pipe = pipe;
  623.   fileTable[n].fd = fd;
  624.   fileTable[n].status = (mode == F_APPEND ? F_WRITE : mode);
  625.   fileTable[n].lineno = 1;
  626.   fileTable[n].charno = fileTable[n].linepos = 0;
  627.   fileTable[n].isatty = IsaTty(n);
  628.  
  629.   switch(mode)
  630.   { case F_READ:        Input = n; break;
  631.     case F_WRITE:
  632.     case F_APPEND:        Output = n; break;
  633.   }
  634.  
  635.   DEBUG(2, printf("Prolog fileTable[] updated\n"));
  636.  
  637.   succeed;
  638. }
  639.  
  640. static bool
  641. unifyStreamName(f, n)
  642. Word f;
  643. int n;
  644. { if ( fileTable[n].status == F_CLOSED )
  645.     fail;
  646. #if PIPE
  647.   if (fileTable[n].pipe)
  648.   { TRY( unifyFunctor(f, FUNCTOR_pipe1) );
  649.     f = argTermP(*f, 0);
  650.   }
  651. #endif
  652.   return unifyAtomic(f, fileTable[n].name);
  653. }
  654.  
  655. static bool
  656. unifyStreamMode(m, n)
  657. Word m;
  658. int n;
  659. { if ( fileTable[n].status == F_CLOSED )
  660.     fail;
  661.   return unifyAtomic(m, fileTable[n].status == F_READ ? ATOM_read : ATOM_write);
  662. }
  663.  
  664. static bool
  665. unifyStreamNo(stream, n)
  666. Word stream;
  667. int n;
  668. { switch( n )
  669.   { case 0:    return unifyAtomic(stream, ATOM_user_input);
  670.     case 1:    return unifyAtomic(stream, ATOM_user_output);
  671.     case 2:    return unifyAtomic(stream, ATOM_user_error);
  672.     default:    if ( fileTable[n].stream_name != NULL )
  673.           return unifyAtomic(stream, fileTable[n].stream_name);
  674.         return unifyAtomic(stream, consNum(n));
  675.   }
  676. }
  677.  
  678. bool
  679. told()
  680. { if ( fileTable[Output].status != F_WRITE )
  681.     succeed;
  682.  
  683.   closeStream(Output);
  684.  
  685.   Output = 1;
  686.   succeed;
  687. }  
  688.  
  689. static bool
  690. flush()
  691. { if ( fileTable[Output].status == F_WRITE )
  692.     Fflush(fileTable[Output].fd);
  693.  
  694.   succeed;
  695. }
  696.  
  697. bool
  698. see(f)
  699. word f;
  700. { return openStream(f, F_READ, FALSE);
  701. }
  702.  
  703. bool
  704. seen()
  705. { if ( fileTable[Input].status != F_READ )
  706.     succeed;
  707.  
  708.   closeStream(Input);
  709.  
  710.   Input = 0;  
  711.  
  712.   succeed;
  713. }
  714.  
  715. static bool
  716. openProtocol(f, appnd)
  717. Atom f;
  718. bool appnd;
  719. { int out = Output;
  720.  
  721.   closeProtocol();
  722.  
  723.   if ( openStream((word)f, appnd ? F_APPEND : F_WRITE, TRUE) == TRUE )
  724.   { protocolStream = Output;
  725.     Output = out;
  726.  
  727.     succeed;
  728.   }
  729.   Output = out;
  730.  
  731.   fail;
  732. }
  733.  
  734. static bool
  735. closeProtocol()
  736. { if (protocolStream >= 0)
  737.   { closeStream(protocolStream);
  738.     protocolStream = -1;
  739.   }
  740.  
  741.   succeed;
  742. }
  743.  
  744. void
  745. prompt(always)
  746. bool always;
  747. { if ( Input == 0 &&
  748.        inString == (char *) NULL &&
  749.        fileTable[Input].isatty &&
  750.        (always || ttyLinePos == 0))
  751.   { int oldOut = Output;
  752.  
  753.     Output = 1;
  754.     Putf("%s", stringAtom(prompt_atom));
  755.     flush();
  756.     Output = oldOut;
  757.   }
  758. }
  759.  
  760.  
  761.         /********************************
  762.         *          STRING I/O           *
  763.         *********************************/
  764.  
  765. bool
  766. seeString(s)
  767. char *s;
  768. { inString = s;
  769.  
  770.   succeed;
  771. }
  772.  
  773. bool
  774. seeingString()
  775. { return inString == (char *)NULL ? FALSE : TRUE;
  776. }
  777.  
  778. bool
  779. seenString()
  780. { inString = (char *) NULL;
  781.  
  782.   succeed;
  783. }
  784.  
  785. bool
  786. tellString(s, n)
  787. char *s;
  788. long n;
  789. { outStringDepth++;
  790.   if ( outStringDepth >= MAXSTRINGNEST )
  791.   { warning("Exeeded maximum string based i/o nesting");
  792.     pl_abort();
  793.   }
  794.   outStringStack[outStringDepth].string = s;
  795.   outStringStack[outStringDepth].left = n - 1;        /* 1 for the EOS */
  796.  
  797.   succeed;
  798. }
  799.  
  800. bool
  801. toldString()
  802. { if ( outStringDepth > 0 )
  803.   { *outStringStack[outStringDepth].string = EOS;
  804.     outStringDepth--;
  805.   }
  806.  
  807.   succeed;
  808. }
  809.  
  810.         /********************************
  811.         *        INPUT FILE NAME        *
  812.         *********************************/
  813.  
  814. Atom
  815. currentStreamName()
  816. { if ( inString )
  817.     return NULL;
  818.  
  819.   return fileTable[Input].name;
  820. }
  821.  
  822.         /********************************
  823.         *       WAITING FOR INPUT    *
  824.         ********************************/
  825.  
  826. #if unix || EMX
  827.  
  828. word
  829. pl_wait_for_input(streams, available, timeout)
  830. Word streams, available, timeout;
  831. { fd_set fds;
  832.   struct timeval t, *to;
  833.   real time;
  834.   int n, max = 0;
  835.   extern int select();
  836.  
  837.   FD_ZERO(&fds);
  838.   while( isList(*streams) )
  839.   { Word head = HeadList(streams);
  840.     int fd;
  841.  
  842.     deRef(head);
  843.     fd = streamNo(head, F_READ);
  844.  
  845.     if ( fd < 0 )
  846.       fail;
  847.     FD_SET(fd, &fds);
  848.     if (fd > max) max = fd;
  849.     streams = TailList(streams);
  850.     deRef(streams);
  851.   }
  852.   if ( !isNil(*streams) || wordToReal(*timeout, &time) == FALSE )
  853.     return warning("wait_for_input/3: instantiation fault");
  854.   
  855.   if ( time > 0.0 )
  856.   { t.tv_sec  = (int)time;
  857.     t.tv_usec = ((int)(time * 1000000) % 1000000);
  858.     to = &t;
  859.   } else
  860.     to = NULL;
  861.  
  862.   select(max, &fds, NULL, NULL, to);
  863.  
  864.   for(n=0; n <= max; n++)
  865.   { if ( FD_ISSET(n, &fds) )
  866.     { TRY(unifyFunctor(available, FUNCTOR_dot2) );
  867.       TRY(unifyStreamName(HeadList(available), n));
  868.       available = TailList(available);
  869.       deRef(available);
  870.     }
  871.   }
  872.   CLOSELIST(available);
  873.  
  874.   succeed;
  875. }
  876.  
  877. #else
  878.  
  879. word
  880. pl_wait_for_input(streams, available, timeout)
  881. Word streams, available, timeout;
  882. { return notImplemented("wait_for_input", 3);
  883. }
  884.  
  885. #endif /* unix */
  886.  
  887.         /********************************
  888.         *      PROLOG CONNECTION        *
  889.         *********************************/
  890.  
  891. word
  892. pl_tty_fold(old, new)
  893. Word old, new;
  894. { TRY( unifyAtomic(old, consNum(fold)) );
  895.   if ( !isInteger(*new) )
  896.     return warning("tty_fold/2: instantiation fault");
  897.   fold = (int) valNum(*new);
  898.  
  899.   succeed;
  900. }
  901.  
  902.  
  903. word
  904. pl_put(c)
  905. Word c;
  906. { Char chr;
  907.   char *s;
  908.  
  909.   if (isInteger(*c))
  910.   { chr = (int) valNum(*c);
  911.     if (chr < 0 || chr > 255)
  912.       return warning("put/1: argument is not an ascii character");
  913.     Put(chr);
  914.     succeed;
  915.   }
  916.   if ( isAtom(*c) )
  917.   { s = stringAtom(*c);
  918.     if (s[0] != '\0' && s[1] == '\0')
  919.     { Put(s[0]);
  920.       succeed;
  921.     }
  922.   }
  923.   if ( isList(*c) )        /* accept put("a"), but also put("hello") */
  924.   { while ( isList(*c) )
  925.     { Word p = HeadList(c);
  926.       deRef(p);
  927.       if ( isInteger(*p) && valNum(*p) >= 0 && valNum(*p) < 256 )
  928.         Put((int)valNum(*p));
  929.       else
  930.         goto error;
  931.       c = TailList(c);
  932.       deRef(c);
  933.     }
  934.     if ( isNil(*c) )
  935.       succeed;
  936.   }
  937.  
  938. error:
  939.   return warning("put/1: instantiation fault");
  940. }
  941.  
  942. word
  943. pl_put2(stream, chr)
  944. Word stream, chr;
  945. { streamOutput(stream, pl_put(chr));
  946. }
  947.  
  948. word
  949. pl_get(chr)
  950. Word chr;
  951. { Char c;
  952.  
  953.   do
  954.   { if ( (c = Get0()) == EOF )
  955.       return unifyAtomic(chr, consNum(c));
  956.   } while( isBlank(c) );
  957.  
  958.   return unifyAtomic(chr, consNum(c));
  959. }
  960.  
  961. word
  962. pl_get2(stream, chr)
  963. Word stream, chr;
  964. { streamInput(stream, pl_get(chr));
  965. }
  966.  
  967. word
  968. pl_tty()                /* $tty/0 */
  969. { if ( status.notty )
  970.     fail;
  971.   succeed;
  972. }
  973.  
  974. word
  975. pl_get_single_char(c)
  976. Word c;
  977. { return unifyAtomic(c, consNum(getSingleChar()));
  978. }
  979.  
  980. word
  981. pl_get0(c)
  982. Word c;
  983. { return unifyAtomic(c, consNum(Get0()));
  984. }
  985.  
  986. word
  987. pl_get02(stream, c)
  988. Word stream, c;
  989. { streamInput(stream, pl_get0(c))
  990. }
  991.  
  992. word
  993. pl_seeing(f)
  994. Word f;
  995. { return unifyStreamName(f, Input);
  996. }
  997.  
  998. word
  999. pl_telling(f)
  1000. Word f;
  1001. { return unifyStreamName(f, Output);
  1002. }
  1003.  
  1004. word
  1005. pl_seen()
  1006. { return seen();
  1007. }
  1008.  
  1009. word
  1010. pl_told()
  1011. { return told();
  1012. }
  1013.  
  1014. word
  1015. pl_see(f)
  1016. Word f;
  1017. { return see(*f);
  1018. }
  1019.  
  1020. word
  1021. pl_tell(f)
  1022. Word f;
  1023. { return openStream(*f, F_WRITE, FALSE);
  1024. }
  1025.  
  1026. word
  1027. pl_append(f)
  1028. Word f;
  1029. { return openStream(*f, F_APPEND, FALSE);
  1030. }
  1031.  
  1032. word
  1033. pl_ttyflush()
  1034. { int OldOut = Output;
  1035.   bool rval;
  1036.  
  1037.   Output = 1;
  1038.   rval = flush();
  1039.   Output = OldOut;
  1040.  
  1041.   return rval;
  1042. }
  1043.  
  1044. word
  1045. pl_flush()
  1046. { return flush();
  1047. }
  1048.  
  1049. word
  1050. pl_protocol(file)
  1051. Word file;
  1052. { if (!isAtom(*file))
  1053.     return warning("protocol/1: argument should be an atom");
  1054.  
  1055.   return openProtocol((Atom) *file, FALSE);
  1056. }
  1057.  
  1058. word
  1059. pl_protocola(file)
  1060. Word file;
  1061. { if (!isAtom(*file))
  1062.     return warning("protocola/1: argument should be an atom");
  1063.  
  1064.   return openProtocol((Atom) *file, TRUE);
  1065. }
  1066.  
  1067. word
  1068. pl_noprotocol()
  1069. { return closeProtocol();
  1070. }
  1071.  
  1072. word
  1073. pl_protocolling(file)
  1074. Word file;
  1075. { if (protocolStream >= 0)
  1076.     return unifyAtomic(file, fileTable[protocolStream].name);
  1077.  
  1078.   fail;
  1079. }
  1080.  
  1081. word
  1082. pl_prompt(old, new)
  1083. Word old, new;
  1084. { TRY( unifyAtomic(old, prompt_atom) )
  1085.  
  1086.   if (!isAtom(*new) )
  1087.     return warning("prompt/2: instantiation fault");
  1088.  
  1089.   prompt_atom = (Atom) *new;
  1090.  
  1091.   succeed;
  1092. }
  1093.  
  1094. word
  1095. pl_tab(n)
  1096. Word n;
  1097. { word val = evaluate(n);
  1098.   int m;
  1099.  
  1100.   if (!isInteger(val))
  1101.     return warning("tab/1: instantiation fault");
  1102.   m = (int) valNum(val);
  1103.  
  1104.   while(m-- > 0)
  1105.     Put(' ');
  1106.  
  1107.   succeed;
  1108. }
  1109.  
  1110. word
  1111. pl_tab2(stream, n)
  1112. Word stream, n;
  1113. { streamOutput(stream, pl_tab(n));
  1114. }
  1115.  
  1116.         /********************************
  1117.         *       STREAM BASED I/O        *
  1118.         *********************************/
  1119.  
  1120. static bool
  1121. setUnifyStreamNo(stream, n)
  1122. Word stream;
  1123. int n;
  1124. { if ( isAtom(*stream) )
  1125.   { register int i;
  1126.  
  1127.     for(i = 0; i < maxfiles; i++ )
  1128.     { if ( fileTable[i].status != F_CLOSED &&
  1129.        fileTable[i].stream_name == (Atom)*stream )
  1130.     return warning("Stream name %s already in use", stringAtom(*stream));
  1131.     }
  1132.     fileTable[n].stream_name = (Atom) *stream;
  1133.     succeed;
  1134.   }
  1135.  
  1136.   return unifyStreamNo(stream, n);
  1137. }
  1138.       
  1139. word
  1140. pl_open(file, mode, stream)
  1141. Word file, mode, stream;
  1142. { int m;
  1143.  
  1144.   if ( *mode == (word) ATOM_write )
  1145.     m = F_WRITE;
  1146.   else if ( *mode == (word) ATOM_append )
  1147.     m = F_APPEND;
  1148.   else if ( *mode == (word) ATOM_read )
  1149.     m = F_READ;
  1150.   else
  1151.     return warning("open/3: Invalid mode specification");
  1152.  
  1153.   if ( m == F_READ )
  1154.   { int in = Input;
  1155.     if ( openStream(*file, m, TRUE) )
  1156.     { if ( setUnifyStreamNo(stream, Input) == TRUE )
  1157.       { Input = in;
  1158.         succeed;
  1159.       }
  1160.       closeStream(Input);
  1161.       Input = in;
  1162.  
  1163.       fail;
  1164.     }
  1165.     Input = in;
  1166.     fail;
  1167.   } else
  1168.   { int out = Output;
  1169.     if ( openStream(*file, m, TRUE) )
  1170.     { if ( setUnifyStreamNo(stream, Output) == TRUE )
  1171.       { Output = out;
  1172.         succeed;
  1173.       }
  1174.       closeStream(Output);
  1175.       Output = out;
  1176.       
  1177.       fail;
  1178.     }
  1179.     Output = out;
  1180.     fail;
  1181.   }
  1182. }
  1183.  
  1184. #ifndef DEVNULL
  1185. #define DEVNULL "/dev/null"
  1186. #endif
  1187.  
  1188. word
  1189. pl_open_null_stream(stream)
  1190. Word stream;
  1191. { static word mode = (word) ATOM_write;
  1192.   word file = (word) lookupAtom(DEVNULL);
  1193.  
  1194.   return pl_open(&file, &mode, stream);
  1195. }
  1196.  
  1197. int
  1198. streamNo(spec, mode)
  1199. Word spec;
  1200. int mode;
  1201. { int n = -1;
  1202.   
  1203.   if ( isInteger(*spec) )
  1204.   { n = (int) valNum(*spec);
  1205.   } else if ( isAtom(*spec) )
  1206.   { Atom k = (Atom) *spec;
  1207.  
  1208.     if ( k == ATOM_user )
  1209.       n = (mode == F_READ ? 0 : 1);
  1210.     else if ( k == ATOM_user_input )
  1211.       n = 0;
  1212.     else if ( k == ATOM_user_output )
  1213.       n = 1;
  1214.     else if ( k == ATOM_user_error )
  1215.       n = 2;
  1216.     else
  1217.     { register int i;
  1218.  
  1219.       for(i = 3; i < maxfiles; i++)
  1220.       { if ( fileTable[i].stream_name == k )
  1221.         { n = i;
  1222.           break;
  1223.     }
  1224.       }
  1225.     }
  1226.   }
  1227.   
  1228.   if ( n < 0 || n >= maxfiles || fileTable[n].status == F_CLOSED )
  1229.   { warning("Illegal I/O stream specification");
  1230.     return -1;
  1231.   }
  1232.  
  1233.   switch(mode)
  1234.   { case F_READ|F_WRITE:
  1235.       return n;
  1236.     case F_READ:
  1237.       if ( fileTable[n].status != F_READ )
  1238.     return warning("Stream is not open for reading");
  1239.       break;
  1240.     case F_APPEND:
  1241.     case F_WRITE:    
  1242.       if ( fileTable[n].status != F_WRITE )
  1243.       { warning("Stream is not open for writing");
  1244.         return -1;
  1245.       }
  1246.   }
  1247.  
  1248.   return n;
  1249. }
  1250.   
  1251. word
  1252. pl_close(stream)
  1253. Word stream;
  1254. { int n;
  1255.  
  1256.   if ( (n = streamNo(stream, F_READ|F_WRITE)) < 0 )
  1257.     fail;
  1258.  
  1259.   TRY( closeStream(n) );
  1260.   if ( n == Output )
  1261.     Output = 1;
  1262.   if ( n == Input )
  1263.     Input = 0;
  1264.  
  1265.   succeed;
  1266. }
  1267.  
  1268. word
  1269. pl_current_stream(file, mode, stream, h)
  1270. Word file, mode, stream;
  1271. word h;
  1272. { int n;
  1273.  
  1274.   switch( ForeignControl(h) )
  1275.   { case FRG_FIRST_CALL:
  1276.       n = 3;
  1277.       break;
  1278.     case FRG_REDO:
  1279.       n = (int) ForeignContext(h);
  1280.       break;
  1281.     case FRG_CUTTED:
  1282.     default:
  1283.       succeed;
  1284.   }
  1285.   
  1286.   for( ; n < maxfiles; n++)
  1287.   { if ( unifyStreamName(file, n) == FALSE ||
  1288.      unifyStreamMode(mode, n) == FALSE ||
  1289.      unifyStreamNo(stream, n) == FALSE )
  1290.       continue;
  1291.     if ( ++n < maxfiles )
  1292.       ForeignRedo(n);
  1293.     succeed;
  1294.   }
  1295.   
  1296.   fail;
  1297. }      
  1298.  
  1299. word
  1300. pl_flush_output(stream)
  1301. Word stream;
  1302. { int n;
  1303.  
  1304.   if ( (n = streamNo(stream, F_WRITE)) < 0 )
  1305.     fail;
  1306.   Fflush(fileTable[n].fd);
  1307.  
  1308.   succeed;
  1309. }
  1310.  
  1311. word
  1312. pl_stream_position(stream, old, new)
  1313. Word stream, old, new;
  1314. { int n;
  1315.   long oldcharno, charno, linepos, lineno;
  1316.   extern int fseek();
  1317.  
  1318.   if ( (n = streamNo(stream, F_READ|F_WRITE)) < 0 )
  1319.     fail;
  1320.  
  1321.   TRY( unifyFunctor(old, FUNCTOR_stream_position3) );
  1322.   if ( fileTable[n].isatty )
  1323.   { charno  = ttyCharNo;
  1324.     lineno  = ttyLineNo;
  1325.     linepos = ttyLinePos;
  1326.   } else
  1327.   { charno  = fileTable[n].charno;
  1328.     lineno  = fileTable[n].lineno;
  1329.     linepos = fileTable[n].linepos;
  1330.   }
  1331.   oldcharno = charno;
  1332.   TRY( unifyAtomic(argTermP(*old, 0), consNum(charno)) );
  1333.   TRY( unifyAtomic(argTermP(*old, 1), consNum(lineno)) );
  1334.   TRY( unifyAtomic(argTermP(*old, 2), consNum(linepos)) );
  1335.  
  1336.   deRef(new);
  1337.   if ( !isTerm(*new) ||
  1338.        functorTerm(*new) != FUNCTOR_stream_position3 ||
  1339.        !isInteger(argTerm(*new, 0)) ||
  1340.        !isInteger(argTerm(*new, 1)) ||
  1341.        !isInteger(argTerm(*new, 2)) )
  1342.     return warning("stream_position/3: Invalid position specifier");
  1343.  
  1344.   charno = valNum(argTerm(*new, 0));
  1345.   lineno = valNum(argTerm(*new, 1));
  1346.   linepos= valNum(argTerm(*new, 2));
  1347.  
  1348.   if ( charno != oldcharno && fseek(fileTable[n].fd, charno, 0) < 0 )
  1349.     return warning("Failed to set stream position: %s", OsError());
  1350.   fileTable[n].charno = charno;
  1351.   fileTable[n].lineno = (int) lineno;
  1352.   fileTable[n].linepos = (int) linepos;
  1353.   
  1354.   succeed;
  1355. }
  1356.  
  1357. word
  1358. pl_set_input(stream)
  1359. Word stream;
  1360. { int n;
  1361.  
  1362.   if ( (n = streamNo(stream, F_READ)) < 0 )
  1363.     fail;
  1364.  
  1365.   Input = n;
  1366.   succeed;
  1367. }
  1368.  
  1369. word
  1370. pl_set_output(stream)
  1371. Word stream;
  1372. { int n;
  1373.  
  1374.   if ( (n = streamNo(stream, F_WRITE)) < 0 )
  1375.     fail;
  1376.  
  1377.   Output = n;
  1378.   succeed;
  1379. }
  1380.  
  1381. word
  1382. pl_current_input(stream)
  1383. Word stream;
  1384. { return unifyStreamNo(stream, Input);
  1385. }
  1386.  
  1387. word
  1388. pl_current_output(stream)
  1389. Word stream;
  1390. { return unifyStreamNo(stream, Output);
  1391. }
  1392.  
  1393. word
  1394. pl_character_count(stream, count)
  1395. Word stream, count;
  1396. { int n;
  1397.   long c;
  1398.  
  1399.   if ( (n = streamNo(stream, F_WRITE|F_READ)) < 0 )
  1400.     fail;
  1401.   c = fileTable[n].isatty ? ttyCharNo : fileTable[n].charno;
  1402.  
  1403.   return unifyAtomic(count, consNum(c));
  1404. }
  1405.  
  1406. word
  1407. pl_line_count(stream, count)
  1408. Word stream, count;
  1409. { int n;
  1410.   long c;
  1411.  
  1412.   if ( (n = streamNo(stream, F_WRITE|F_READ)) < 0 )
  1413.     fail;
  1414.   c = fileTable[n].isatty ? ttyLineNo : fileTable[n].lineno;
  1415.  
  1416.   return unifyAtomic(count, consNum(c));
  1417. }
  1418.  
  1419. word
  1420. pl_line_position(stream, count)
  1421. Word stream, count;
  1422. { int n;
  1423.   long c;
  1424.  
  1425.   if ( (n = streamNo(stream, F_WRITE|F_READ)) < 0 )
  1426.     fail;
  1427.   c = fileTable[n].isatty ? ttyLinePos : fileTable[n].linepos;
  1428.  
  1429.   return unifyAtomic(count, consNum(c));
  1430. }
  1431.  
  1432.  
  1433. word
  1434. pl_source_location(file, line)
  1435. Word file, line;
  1436. { if ( ReadingSource )
  1437.   { char *s = AbsoluteFile(stringAtom(source_file_name));
  1438.  
  1439.     if ( s != NULL )
  1440.     { TRY( unifyAtomic(file, lookupAtom(s)) );
  1441.       TRY( unifyAtomic(line, consNum(source_line_no)) );
  1442.       
  1443.       succeed;
  1444.     }
  1445.   }
  1446.   
  1447.   fail;
  1448. }
  1449.  
  1450.  
  1451.         /********************************
  1452.         *             FILES             *
  1453.         *********************************/
  1454.  
  1455. bool
  1456. unifyTime(t, time)
  1457. Word t;
  1458. long time;
  1459. { return unifyAtomic(t, globalReal((real)time));
  1460. }
  1461.  
  1462.  
  1463. word
  1464. pl_time_file(name, t)
  1465. Word name, t;
  1466. { char *n;
  1467.   long time;
  1468.  
  1469.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1470.     return warning("time_file/2: instantiation fault");
  1471.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1472.     fail;
  1473.  
  1474.   if ( (time = LastModifiedFile(n)) == -1 )
  1475.     fail;
  1476.  
  1477.   return unifyTime(t, time);
  1478. }
  1479.  
  1480.  
  1481. word
  1482. pl_size_file(name, len)
  1483. Word name, len;
  1484. { char *n;
  1485.   long size;
  1486.  
  1487.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1488.     return warning("exists_file/1: instantiation fault");
  1489.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1490.     fail;
  1491.   
  1492.   if ( (size = SizeFile(n)) < 0 )
  1493.     return warning("size_file/2: %s", OsError());
  1494.  
  1495.   return unifyAtomic(len, consNum(size));
  1496. }
  1497.  
  1498.  
  1499. word
  1500. pl_access_file(name, mode)
  1501. Word name, mode;
  1502. { char *n;
  1503.   int md;
  1504.  
  1505.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1506.     return warning("access_file/2: instantiation fault");
  1507.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1508.     fail;
  1509.   
  1510.   if      ( *mode == (word) ATOM_write )
  1511.     md = ACCESS_WRITE;
  1512.   else if ( *mode == (word) ATOM_read )
  1513.     md = ACCESS_READ;
  1514.   else if ( *mode == (word) ATOM_execute )
  1515.     md = ACCESS_EXECUTE;
  1516.   else
  1517.     return warning("access_file/2: mode is one of {read, write, execute}");
  1518.  
  1519.   return AccessFile(n, md);
  1520. }
  1521.  
  1522.  
  1523. word
  1524. pl_exists_file(name)
  1525. Word name;
  1526. { char *n;
  1527.  
  1528.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1529.     return warning("exists_file/1: instantiation fault");
  1530.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1531.     fail;
  1532.   
  1533.   return ExistsFile(n);
  1534. }
  1535.  
  1536.  
  1537. word
  1538. pl_exists_directory(name)
  1539. Word name;
  1540. { char *n;
  1541.  
  1542.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1543.     return warning("exists_directory/1: instantiation fault");
  1544.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1545.     fail;
  1546.   
  1547.   return ExistsDirectory(n);
  1548. }
  1549.  
  1550.  
  1551. word
  1552. pl_tmp_file(base, name)
  1553. Word base, name;
  1554. { char *n;
  1555.  
  1556.   if ( (n = primitiveToString(*base, FALSE)) == (char *)NULL )
  1557.     return warning("tmp_file/2: instantiation fault");
  1558.  
  1559.   return unifyAtomic(name, TemporaryFile(n));
  1560. }
  1561.  
  1562.  
  1563. word
  1564. pl_delete_file(name)
  1565. Word name;
  1566. { char *n;
  1567.  
  1568.   if ( (n = primitiveToString(*name, FALSE)) == (char *)NULL )
  1569.     return warning("delete_file/1: instantiation fault");
  1570.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1571.     fail;
  1572.   
  1573.   return DeleteFile(n);
  1574. }
  1575.  
  1576.  
  1577. word
  1578. pl_same_file(file1, file2)
  1579. Word file1, file2;
  1580. { char *n1, *n2;
  1581.  
  1582.   initAllocLocal();
  1583.   if ( (n1 = primitiveToString(*file1, TRUE)) == NULL ||
  1584.        (n2 = primitiveToString(*file2, TRUE)) == NULL )
  1585.     return warning("same_file/2: instantiation fault");
  1586.  
  1587.   if ( (n1 = ExpandOneFile(n1)) == NULL )
  1588.     fail;
  1589.   n1 = store_string_local(n1);
  1590.   if ( (n2 = ExpandOneFile(n2)) == NULL )
  1591.     fail;
  1592.   stopAllocLocal();
  1593.  
  1594.   return SameFile(n1, n2);
  1595. }
  1596.  
  1597.  
  1598. word
  1599. pl_rename_file(old, new)
  1600. Word old, new;
  1601. { char *o, *n;
  1602.  
  1603.   initAllocLocal();
  1604.   o = primitiveToString(*old, TRUE);
  1605.   n = primitiveToString(*new, TRUE);
  1606.   if ( o == (char *) NULL || n == (char *) NULL )
  1607.   { stopAllocLocal();
  1608.     return warning("rename_file/2: instantiation fault");
  1609.   }
  1610.   
  1611.   if ( (o = ExpandOneFile(o)) == (char *)NULL )
  1612.     fail;
  1613.   o = store_string_local(o);
  1614.   if ( (n = ExpandOneFile(n)) == (char *)NULL )
  1615.     fail;
  1616.   n = store_string_local(n);
  1617.   stopAllocLocal();
  1618.  
  1619.   return RenameFile(o, n);
  1620. }
  1621.  
  1622.  
  1623. word
  1624. pl_fileerrors(old, new)
  1625. Word old, new;
  1626. { TRY(unifyAtomic(old, (fileerrors ? ATOM_on : ATOM_off)) );
  1627.  
  1628.   if ( *new == (word) ATOM_on )       fileerrors = TRUE;
  1629.   else if ( *new == (word) ATOM_off ) fileerrors = FALSE;
  1630.   else                                fail;
  1631.  
  1632.   succeed;
  1633. }
  1634.  
  1635.  
  1636. word
  1637. pl_absolute_file_name(name, expanded)
  1638. Word name, expanded;
  1639. { char *s = primitiveToString(*name, FALSE);
  1640.  
  1641.   if ( s == (char *) NULL || (s = AbsoluteFile(s)) == (char *) NULL)
  1642.     return warning("Invalid file specification");
  1643.  
  1644.   return unifyAtomic(expanded, lookupAtom(s));
  1645. }
  1646.  
  1647.  
  1648. word
  1649. pl_chdir(dir)
  1650. Word dir;
  1651. { char *s = primitiveToString(*dir, FALSE);
  1652.  
  1653.   if ( s == (char *)NULL )
  1654.     return warning("chdir/1: instantiation fault");
  1655.   if ( (s = ExpandOneFile(s)) == (char *)NULL )
  1656.     fail;
  1657.   
  1658.   if ( ChDir(s) )
  1659.     succeed;
  1660.  
  1661.   return warning("chdir/1: cannot change directory to %s", s);
  1662. }
  1663.  
  1664.  
  1665. word
  1666. pl_file_base_name(f, b)
  1667. Word f, b;
  1668. { if (!isAtom(*f))
  1669.     return warning("file_base_name/2: instantiation fault");
  1670.  
  1671.   return unifyAtomic(b, lookupAtom(BaseName(stringAtom(*f))));
  1672. }
  1673.  
  1674.  
  1675. word
  1676. pl_file_dir_name(f, b)
  1677. Word f, b;
  1678. { if (!isAtom(*f))
  1679.     return warning("file_dir_name/2: instantiation fault");
  1680.  
  1681.   return unifyAtomic(b, lookupAtom(DirName(stringAtom(*f))));
  1682. }
  1683.  
  1684.