1 /*  Part of SWI-Prolog
2 
3     Author:        Jan Wielemaker
4     E-mail:        J.Wielemaker@vu.nl
5     WWW:           http://www.swi-prolog.org
6     Copyright (c)  2001-2015, University of Amsterdam
7                               VU University Amsterdam
8     All rights reserved.
9 
10     Redistribution and use in source and binary forms, with or without
11     modification, are permitted provided that the following conditions
12     are met:
13 
14     1. Redistributions of source code must retain the above copyright
15        notice, this list of conditions and the following disclaimer.
16 
17     2. Redistributions in binary form must reproduce the above copyright
18        notice, this list of conditions and the following disclaimer in
19        the documentation and/or other materials provided with the
20        distribution.
21 
22     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25     FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26     COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27     INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28     BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30     CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32     ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33     POSSIBILITY OF SUCH DAMAGE.
34 */
35 
36 #include <config.h>
37 #include <SWI-Stream.h>
38 #include <SWI-Prolog.h>
39 #include <string.h>
40 #include <stdlib.h>
41 #include <assert.h>
42 #include <errno.h>
43 #ifdef O_PLMT
44 #include <pthread.h>
45 #endif
46 #include "error.h"
47 
48 #ifdef O_PLMT
49 #define LOCK(mf)   pthread_mutex_lock(&(mf)->mutex)
50 #define UNLOCK(mf) pthread_mutex_unlock(&(mf)->mutex)
51 #else
52 #define LOCK(mf)
53 #define UNLOCK(mf)
54 #endif
55 
56 static atom_t ATOM_encoding;
57 static atom_t ATOM_unknown;
58 static atom_t ATOM_octet;
59 static atom_t ATOM_ascii;
60 static atom_t ATOM_iso_latin_1;
61 static atom_t ATOM_text;
62 static atom_t ATOM_utf8;
63 static atom_t ATOM_unicode_be;
64 static atom_t ATOM_unicode_le;
65 static atom_t ATOM_wchar_t;
66 static atom_t ATOM_read;
67 static atom_t ATOM_write;
68 static atom_t ATOM_append;
69 static atom_t ATOM_update;
70 static atom_t ATOM_insert;
71 static atom_t ATOM_free_on_close;
72 
73 #define MEMFILE_MAGIC	0x5624a6b3L
74 #define MEMFILE_CMAGIC	0x5624a6b7L
75 #define NOSIZE ((size_t)-1)
76 
77 #define	V_CHARCOUNT	0x01
78 #define	V_LINENO	0x02
79 #define	V_LINEPOS	0x04
80 #define V_ALL		0x07
81 
82 typedef struct
83 { size_t	byte_count;		/* Byte position in MF */
84   size_t	char_count;		/* Corresponding logical char */
85   size_t	line_no;		/* Line */
86   size_t	line_pos;		/* Line position */
87   unsigned int	valid;			/* Valid mask */
88 } pos_cache;
89 
90 
91 typedef struct
92 { char	       *data;			/* data of the file */
93   size_t	end;			/* End of buffer */
94   size_t	gap_start;		/* Insertion point */
95   size_t	gap_size;		/* Insertion hole */
96   size_t	char_count;		/* size in characters */
97   pos_cache	pcache;			/* Cached position */
98   size_t	here;			/* read pointer */
99   IOSTREAM     *stream;			/* Stream hanging onto it */
100   atom_t	symbol;			/* <memory_file>(%p) */
101   atom_t	atom;			/* Created from atom */
102   atom_t	mode;			/* current open mode */
103 #ifdef O_PLMT
104   pthread_mutex_t mutex;		/* Our lock */
105 #endif
106   int		magic;			/* MEMFILE_MAGIC */
107   int		free_on_close;		/* free if it is closed */
108   IOENC		encoding;		/* encoding of the data */
109 } memfile;
110 
111 static int	destroy_memory_file(memfile *m);
112 
113 
114 		 /*******************************
115 		 *	      SYMBOL		*
116 		 *******************************/
117 
118 static void
acquire_memfile_symbol(atom_t symbol)119 acquire_memfile_symbol(atom_t symbol)
120 { memfile *mf = PL_blob_data(symbol, NULL, NULL);
121   mf->symbol = symbol;
122 }
123 
124 static int
release_memfile_symbol(atom_t symbol)125 release_memfile_symbol(atom_t symbol)
126 { memfile *mf = PL_blob_data(symbol, NULL, NULL);
127 
128   destroy_memory_file(mf);
129   return TRUE;
130 }
131 
132 static int
compare_memfile_symbols(atom_t a,atom_t b)133 compare_memfile_symbols(atom_t a, atom_t b)
134 { memfile *mfa = PL_blob_data(a, NULL, NULL);
135   memfile *mfb = PL_blob_data(b, NULL, NULL);
136 
137   return ( mfa > mfb ?  1 :
138 	   mfa < mfb ? -1 : 0
139 	 );
140 }
141 
142 
143 static int
write_memfile_symbol(IOSTREAM * s,atom_t symbol,int flags)144 write_memfile_symbol(IOSTREAM *s, atom_t symbol, int flags)
145 { memfile *mf = PL_blob_data(symbol, NULL, NULL);
146 
147   Sfprintf(s, "<memory_file>(%p)", mf);
148   return TRUE;
149 }
150 
151 
152 static PL_blob_t memfile_blob =
153 { PL_BLOB_MAGIC,
154   PL_BLOB_NOCOPY,
155   "memory_file",
156   release_memfile_symbol,
157   compare_memfile_symbols,
158   write_memfile_symbol,
159   acquire_memfile_symbol
160 };
161 
162 
163 static int
unify_memfile(term_t handle,memfile * mf)164 unify_memfile(term_t handle, memfile *mf)
165 { if ( PL_unify_blob(handle, mf, sizeof(*mf), &memfile_blob) )
166     return TRUE;
167 
168   if ( !PL_is_variable(handle) )
169     return PL_uninstantiation_error(handle);
170 
171   return FALSE;					/* (resource) error */
172 }
173 
174 
175 static int
get_memfile(term_t handle,memfile ** mfp)176 get_memfile(term_t handle, memfile **mfp)
177 { PL_blob_t *type;
178   void *data;
179 
180   if ( PL_get_blob(handle, &data, NULL, &type) && type == &memfile_blob)
181   { memfile *mf = data;
182 
183     assert(mf->magic == MEMFILE_MAGIC);
184     LOCK(mf);
185 
186     if ( mf->symbol )
187     { *mfp = mf;
188 
189       return TRUE;
190     }
191 
192     UNLOCK(mf);
193     PL_permission_error("access", "freed_memory_file", handle);
194     return FALSE;
195   }
196 
197   return PL_type_error("memory_file", handle);
198 }
199 
200 
201 static void
release_memfile(memfile * mf)202 release_memfile(memfile *mf)
203 { UNLOCK(mf);
204 }
205 
206 
207 static void
empty_memory_file(memfile * m)208 empty_memory_file(memfile *m)
209 { if ( m->data )
210     free(m->data);
211 
212   m->encoding     = ENC_UTF8;
213   m->data         = NULL;
214   m->end          = 0;
215   m->gap_start    = 0;
216   m->gap_size     = 0;
217   m->char_count   = NOSIZE;
218   m->pcache.valid = 0;
219   m->here         = 0;
220 }
221 
222 
223 static foreign_t
new_memory_file(term_t handle)224 new_memory_file(term_t handle)
225 { memfile *m = calloc(1, sizeof(*m));
226 
227   if ( !m )
228     return PL_resource_error("memory");
229 
230   m->magic    = MEMFILE_MAGIC;
231   m->encoding = ENC_UTF8;
232   m->data     = NULL;
233   m->atom     = 0;
234   m->symbol   = 0;
235   m->stream   = NULL;
236 #ifdef O_PLMT
237   pthread_mutex_init(&m->mutex, NULL);
238 #endif
239 
240   if ( unify_memfile(handle, m) )
241     return TRUE;
242 
243   destroy_memory_file(m);
244   return FALSE;
245 }
246 
247 
248 static void
clean_memory_file(memfile * m)249 clean_memory_file(memfile *m)
250 { if ( m->stream )
251   { Sclose(m->stream);
252     m->stream = NULL;
253   }
254   if ( m->atom )
255   { PL_unregister_atom(m->atom);
256     m->atom = 0;
257     m->data = NULL;
258   } else if ( m->data )
259   { free(m->data);
260     m->data = NULL;
261   }
262 }
263 
264 
265 static int
destroy_memory_file(memfile * m)266 destroy_memory_file(memfile *m)
267 { clean_memory_file(m);
268 #ifdef O_PLMT
269   pthread_mutex_destroy(&m->mutex);
270 #endif
271   m->magic = MEMFILE_CMAGIC;
272   free(m);
273 
274   return TRUE;
275 }
276 
277 
278 static foreign_t
free_memory_file(term_t handle)279 free_memory_file(term_t handle)
280 { memfile *m;
281 
282   if ( get_memfile(handle, &m) )
283   { m->symbol = 0;
284     clean_memory_file(m);
285     release_memfile(m);
286     return TRUE;
287   }
288 
289   return FALSE;
290 }
291 
292 		 /*******************************
293 		 *	     CHECKING		*
294 		 *******************************/
295 
296 #define ISUTF8_CB(c)  (((c)&0xc0) == 0x80) /* Is continuation byte */
297 
298 #ifdef O_SECURE
299 
300 #define CONT(in,i)   (assert(ISUTF8_CB(in[i])),1)
301 #define IS_UTF8_2BYTE(in) \
302 	((in[0]&0xe0) == 0xc0 && CONT(in,1))
303 #define IS_UTF8_3BYTE(in) \
304 	((in[0]&0xf0) == 0xe0 && CONT(in,1)&&CONT(in,2))
305 #define IS_UTF8_4BYTE(in) \
306 	((in[0]&0xf8) == 0xf0 && CONT(in,1)&&CONT(in,2)&&CONT(in,3))
307 #define IS_UTF8_5BYTE(in) \
308 	((in[0]&0xfc) == 0xf8 && CONT(in,1)&&CONT(in,2)&&CONT(in,3)&&CONT(in,4))
309 #define IS_UTF8_6BYTE(in) \
310 	((in[0]&0xfe) == 0xfc && CONT(in,1)&&CONT(in,2)&&CONT(in,3)&&CONT(in,4)&&CONT(in,5))
311 
312 static size_t
check_utf8_seq(char * s,size_t len)313 check_utf8_seq(char *s, size_t len)
314 { size_t count = 0;
315   size_t skip;
316 
317   while(len > 0)
318   { if ( (*s&0x80) )
319     {      if ( IS_UTF8_2BYTE(s) ) skip = 2;
320       else if ( IS_UTF8_3BYTE(s) ) skip = 3;
321       else if ( IS_UTF8_4BYTE(s) ) skip = 4;
322       else if ( IS_UTF8_5BYTE(s) ) skip = 5;
323       else if ( IS_UTF8_6BYTE(s) ) skip = 6;
324       else assert(0);
325     } else
326       skip = 1;
327 
328     assert(len >= skip);
329     len -= skip;
330     s   += skip;
331 
332     count++;
333   }
334 
335   return count;
336 }
337 
338 
339 static void
check_memfile(memfile * mf)340 check_memfile(memfile *mf)
341 { size_t count = 0;
342 
343   count += check_utf8_seq(&mf->data[0],                          mf->gap_start);
344   count += check_utf8_seq(&mf->data[mf->gap_start+mf->gap_size],
345 			  mf->end-(mf->gap_size+mf->gap_start));
346 
347   assert(mf->char_count == NOSIZE || mf->char_count == count);
348 }
349 
350 #else /*O_SECURE*/
351 
352 #define check_memfile(mf) (void)0
353 
354 #endif /*O_SECURE*/
355 
356 		 /*******************************
357 		 *	 STREAM FUNCTIONS	*
358 		 *******************************/
359 
360 #define CHECK_MEMFILE(m) \
361 	if ( m->magic != MEMFILE_MAGIC ) \
362 	{ errno = EINVAL; \
363 	  return -1; \
364 	}
365 
366 static ssize_t
read_memfile(void * handle,char * buf,size_t size)367 read_memfile(void *handle, char *buf, size_t size)
368 { memfile *m = handle;
369   size_t done = 0;
370 
371   CHECK_MEMFILE(m);
372   if ( m->here < m->gap_start )
373   { size_t before_gap = m->gap_start - m->here;
374     if ( size <= before_gap )
375     { memcpy(buf, &m->data[m->here], size);
376       m->here += size;
377       return size;
378     } else
379     { memcpy(buf, &m->data[m->here], before_gap);
380       m->here += before_gap;
381       done = before_gap;
382     }
383   }
384 
385   /* we are now after the gap */
386   { size_t left = size - done;
387     size_t start = m->here + m->gap_size;
388     size_t avail = m->end - start;
389 
390     if ( avail < left )
391     { left = avail;
392       size = done + avail;
393     }
394     m->here += left;
395     memcpy(&buf[done], &m->data[start], left);
396     return size;
397   }
398 }
399 
400 
401 static size_t
memfile_nextsize(size_t needed)402 memfile_nextsize(size_t needed)
403 { size_t size = 512;
404 
405   while ( size < needed )
406     size *= 2;
407 
408   return size;
409 }
410 
411 
412 static int
ensure_gap_size(memfile * m,size_t size)413 ensure_gap_size(memfile *m, size_t size)
414 { if ( m->gap_size < size )
415   { size_t nextsize = memfile_nextsize(m->end+(size-m->gap_size));
416     void *ptr;
417 
418     if ( m->data )
419       ptr = realloc(m->data, nextsize);
420     else
421       ptr = malloc(nextsize);
422 
423     if ( ptr != NULL )
424     { size_t after_gap = m->end - (m->gap_start + m->gap_size);
425 
426       m->data = ptr;
427       memmove(&m->data[nextsize-after_gap], &m->data[m->end-after_gap], after_gap);
428       m->gap_size += nextsize - m->end;
429       m->end = nextsize;
430     } else
431     { return -1;
432     }
433   }
434 
435   return 0;
436 }
437 
438 
439 static void
move_gap_to(memfile * m,size_t to)440 move_gap_to(memfile *m, size_t to)
441 { assert(to <= m->end - m->gap_size);
442 
443   if ( to != m->gap_start )
444   { if ( to > m->gap_start )		/* move forwards */
445     { memmove(&m->data[m->gap_start],
446 	      &m->data[m->gap_start+m->gap_size],
447 	      to - m->gap_start);
448       m->gap_start = to;
449     } else				/* move backwards */
450     { memmove(&m->data[to+m->gap_size],
451 	      &m->data[to],
452 	      m->gap_start - to);
453       m->gap_start = to;
454     }
455   }
456 }
457 
458 
459 static ssize_t
write_memfile(void * handle,char * buf,size_t size)460 write_memfile(void *handle, char *buf, size_t size)
461 { memfile *m = handle;
462   int rc;
463 
464   CHECK_MEMFILE(m);
465   if ( size > 0 )
466   { m->char_count = NOSIZE;		/* TBD: Dynamically update? */
467     if ( m->gap_start < m->pcache.byte_count )
468       m->pcache.valid = 0;
469 
470     if ( m->mode == ATOM_update )
471     { size_t start = m->gap_start + m->gap_size;
472       size_t after = m->end - start;
473 
474       if ( size > after )
475       { if ( (rc=ensure_gap_size(m, size-after)) != 0 )
476 	  return rc;
477 	m->gap_size -= size-after;
478       }
479       memmove(&m->data[m->gap_start], buf, size);
480       m->gap_start += size;
481     } else
482     { if ( (rc=ensure_gap_size(m, size)) != 0 )
483 	return rc;
484       memcpy(&m->data[m->gap_start], buf, size);
485       m->gap_start += size;
486       m->gap_size  -= size;
487     }
488   }
489 
490   return size;
491 }
492 
493 static int64_t
seek64_memfile(void * handle,int64_t offset,int whence)494 seek64_memfile(void *handle, int64_t offset, int whence)
495 { memfile *m = handle;
496 
497   CHECK_MEMFILE(m);
498   switch(whence)
499   { case SIO_SEEK_SET:
500       break;
501     case SIO_SEEK_CUR:
502       offset += m->here;
503       break;
504     case SIO_SEEK_END:
505       offset = (m->end-m->gap_size) - offset;
506       break;
507     default:
508       errno = EINVAL;
509       return -1;
510   }
511   if ( offset < 0 || offset > (m->end - m->gap_size) )
512   { errno = EINVAL;
513     return -1;
514   }
515 
516   if ( (m->stream->flags & SIO_INPUT) )	/* reading */
517   { m->here = offset;
518   } else
519   { move_gap_to(m, offset);
520   }
521 
522   return offset;
523 }
524 
525 static long
seek_memfile(void * handle,long offset,int whence)526 seek_memfile(void *handle, long offset, int whence)
527 { return (long)seek64_memfile(handle, (int64_t)offset, whence);
528 }
529 
530 static int
close_memfile(void * handle)531 close_memfile(void *handle)
532 { memfile *m = handle;
533 
534   CHECK_MEMFILE(m);
535   m->stream = NULL;
536   m->mode = 0;
537   if ( m->free_on_close )
538     clean_memory_file(m);
539   PL_unregister_atom(m->symbol);
540 
541   return 0;
542 }
543 
544 
545 IOFUNCTIONS memfile_functions =
546 { read_memfile,
547   write_memfile,
548   seek_memfile,
549   close_memfile,
550   NULL,					/* control */
551   seek64_memfile
552 };
553 
554 
555 static foreign_t
alreadyOpen(term_t handle,const char * op)556 alreadyOpen(term_t handle, const char *op)
557 { return pl_error(NULL, 0, "already open",
558 		  ERR_PERMISSION, handle, op, "memory_file");
559 }
560 
561 
562 static struct encname
563 { IOENC  code;
564   atom_t *name;
565 } encoding_names[] =
566 { { ENC_UNKNOWN,     &ATOM_unknown },
567   { ENC_OCTET,       &ATOM_octet },
568   { ENC_ASCII,       &ATOM_ascii },
569   { ENC_ISO_LATIN_1, &ATOM_iso_latin_1 },
570   { ENC_ANSI,	     &ATOM_text },
571   { ENC_UTF8,        &ATOM_utf8 },
572   { ENC_UNICODE_BE,  &ATOM_unicode_be },
573   { ENC_UNICODE_LE,  &ATOM_unicode_le },
574   { ENC_WCHAR,	     &ATOM_wchar_t },
575   { ENC_UNKNOWN,     NULL },
576 };
577 
578 
579 static IOENC
atom_to_encoding(atom_t a)580 atom_to_encoding(atom_t a)
581 { struct encname *en;
582 
583   for(en=encoding_names; en->name; en++)
584   { if ( *en->name == a )
585       return en->code;
586   }
587 
588   return ENC_UNKNOWN;
589 }
590 
591 
592 static int
get_encoding(term_t t,IOENC * enc)593 get_encoding(term_t t, IOENC *enc)
594 { atom_t en;
595 
596   if ( PL_get_atom(t, &en) )
597   { IOENC encoding;
598 
599     if ( (encoding = atom_to_encoding(en)) == ENC_UNKNOWN )
600       return pl_error(NULL, 0, NULL, ERR_DOMAIN, t, "encoding");
601 
602     *enc = encoding;
603     return TRUE;
604   }
605 
606   return pl_error(NULL, 0, NULL, ERR_TYPE, t, "encoding");
607 }
608 
609 
610 static foreign_t
open_memory_file4(term_t handle,term_t mode,term_t stream,term_t options)611 open_memory_file4(term_t handle, term_t mode, term_t stream, term_t options)
612 { memfile *m;
613   int rc;
614 
615   if ( get_memfile(handle, &m) )
616   { int flags = SIO_FBUF|SIO_RECORDPOS|SIO_NOMUTEX;
617     atom_t iom;
618     IOSTREAM *fd;
619     IOENC encoding;
620     int free_on_close = FALSE;
621 
622     if ( m->stream )
623     { rc = alreadyOpen(handle, "open");
624       goto out;
625     }
626     if ( !PL_get_atom(mode, &iom) )
627     { rc = pl_error("open_memory_file", 3, NULL, ERR_ARGTYPE, 2,
628 		    mode, "io_mode");
629       goto out;
630     }
631 
632     encoding = m->encoding;
633 
634     if ( options )
635     { term_t tail = PL_copy_term_ref(options);
636       term_t head = PL_new_term_ref();
637 
638       while(PL_get_list(tail, head, tail))
639       { size_t arity;
640 	atom_t name;
641 
642 	if ( PL_get_name_arity(head, &name, &arity) && arity == 1 )
643 	{ term_t arg = PL_new_term_ref();
644 
645 	  _PL_get_arg(1, head, arg);
646 	  if ( name == ATOM_encoding )
647 	  { if ( !get_encoding(arg, &encoding) )
648 	    { rc = FALSE;
649 	      goto out;
650 	    }
651 	  } else if ( name == ATOM_free_on_close )
652 	  { if ( !PL_get_bool(arg, &free_on_close) )
653 	    { rc = pl_error("open_memory_file", 4, NULL, ERR_TYPE,
654 			    arg, "boolean");
655 	      goto out;
656 	    }
657 	  }
658 	} else
659 	{ rc = pl_error("open_memory_file", 4, NULL, ERR_TYPE, head, "option");
660 	  goto out;
661 	}
662       }
663       if ( !PL_get_nil(tail) )
664       { rc = pl_error("open_memory_file", 4, NULL, ERR_TYPE, tail, "list");
665 	goto out;
666       }
667     }
668 
669     if ( iom == ATOM_write  || iom == ATOM_append ||
670 	 iom == ATOM_update || iom == ATOM_insert )
671     { flags |= SIO_OUTPUT;
672       if ( m->atom )
673       { rc = pl_error("open_memory_file", 3, "read only",
674 		      ERR_PERMISSION, handle, "modify", "memory_file");
675 	goto out;
676       }
677 
678       if ( iom == ATOM_write )
679       { empty_memory_file(m);
680 	m->encoding   = encoding;
681       } else
682       { if ( m->encoding != encoding )
683 	{ rc = pl_error("open_memory_file", 3, "inconsistent encoding",
684 			ERR_PERMISSION, handle, PL_atom_chars(iom), "memory_file");
685 	  goto out;
686 	}
687 	if ( iom == ATOM_append )
688 	{ move_gap_to(m, m->end - m->gap_size);
689 	} else
690 	{ move_gap_to(m, 0);
691 	}
692       }
693 
694     } else if ( iom == ATOM_read )
695     { flags |= SIO_INPUT;
696       m->free_on_close = free_on_close;
697       m->here = 0;
698     } else
699     { rc = pl_error("open_memory_file", 3, NULL, ERR_DOMAIN,
700 		    mode, "io_mode");
701       goto out;
702     }
703 
704     if ( encoding != ENC_OCTET )
705       flags |= SIO_TEXT;
706 
707     if ( !(fd = Snew(m, flags, &memfile_functions)) )
708     { rc = pl_error("open_memory_file", 3, NULL, ERR_ERRNO, errno,
709 		    "create", "memory_file", handle);
710       goto out;
711     }
712 
713     if ( (rc=PL_unify_stream(stream, fd)) )
714     { fd->encoding = encoding;
715       fd->newline = SIO_NL_POSIX;
716       m->stream = fd;
717       m->mode = iom;
718       PL_register_atom(m->symbol);
719     } else
720     { Sclose(fd);
721     }
722 
723   out:
724     release_memfile(m);
725   } else
726     rc = FALSE;
727 
728   return rc;
729 }
730 
731 
732 static foreign_t
open_memory_file(term_t handle,term_t mode,term_t stream)733 open_memory_file(term_t handle, term_t mode, term_t stream)
734 { return open_memory_file4(handle, mode, stream, 0);
735 }
736 
737 
738 static int
get_size_mf(memfile * m,IOENC encoding,size_t * sizep)739 get_size_mf(memfile *m, IOENC encoding, size_t *sizep)
740 { size_t size;
741 
742   if ( m->char_count != NOSIZE && encoding == m->encoding )
743   { size = m->char_count;
744   } else
745   { size = m->end - m->gap_size;
746 
747     switch( encoding )
748     { case ENC_ISO_LATIN_1:
749       case ENC_OCTET:
750       case ENC_ASCII:
751 	break;
752       case ENC_UNICODE_BE:
753       case ENC_UNICODE_LE:
754 	size /= 2;
755         break;
756       case ENC_WCHAR:
757 	size /= sizeof(wchar_t);
758         break;
759       case ENC_UTF8:
760       { size_t gap_end = m->gap_start+m->gap_size;
761 
762 	/* assumes UTF-8 sequences are not broken over the gap */
763 	size  = PL_utf8_strlen(m->data, m->gap_start);
764 	size +=	PL_utf8_strlen(&m->data[gap_end], m->end-gap_end);
765 	break;
766       }
767       default:
768 	assert(0);
769         return FALSE;
770     }
771 
772     if ( encoding == m->encoding )
773       m->char_count = size;
774   }
775 
776   *sizep = size;
777   return TRUE;
778 }
779 
780 
781 
782 static foreign_t
size_memory_file(term_t handle,term_t sizeh,term_t encoding)783 size_memory_file(term_t handle, term_t sizeh, term_t encoding)
784 { memfile *m;
785   int rc;
786 
787   if ( get_memfile(handle, &m) )
788   { size_t size;
789     IOENC size_enc;
790 
791     if ( m->stream && !m->atom )
792     { rc = alreadyOpen(handle, "size");
793       goto out;
794     }
795 
796     if ( encoding )
797     { if ( !get_encoding(encoding, &size_enc) )
798       { rc = FALSE;
799 	goto out;
800       }
801     } else
802       size_enc = m->encoding;
803 
804     rc = ( get_size_mf(m, size_enc, &size) &&
805 	   PL_unify_int64(sizeh, size)
806 	 );
807   out:
808     release_memfile(m);
809   } else
810     rc = FALSE;
811 
812   return rc;
813 }
814 
815 
816 static foreign_t
size_memory_file2(term_t handle,term_t size)817 size_memory_file2(term_t handle, term_t size)
818 { return size_memory_file(handle, size, 0);
819 }
820 
821 
822 static foreign_t
size_memory_file3(term_t handle,term_t size,term_t encoding)823 size_memory_file3(term_t handle, term_t size, term_t encoding)
824 { return size_memory_file(handle, size, encoding);
825 }
826 
827 
828 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
829 utf8_position_memory_file(+MF, -Here, -Size)
830 
831 Given  MF  is  a  UTF-8  encoded  memory   file,  unify  here  with  the
832 byte-position of the read-pointer and Size with   the  total size of the
833 memory file in bytes. This is a bit hacky predicate, but the information
834 is easily available at low cost, while it is very valuable for producing
835 answers  in  content-length  computation  of    the   HTTP  server.  See
836 http_wrapper.pl
837 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
838 
839 static foreign_t
utf8_position(term_t handle,term_t here,term_t size)840 utf8_position(term_t handle, term_t here, term_t size)
841 { memfile *m;
842   int rc;
843 
844   if ( get_memfile(handle, &m) )
845   { if ( m->encoding != ENC_UTF8 )
846     { rc = pl_error(NULL, 0, "no UTF-8 encoding",
847 		    ERR_PERMISSION, handle, "utf8_position", "memory_file");
848       goto out;
849     }
850     if ( !PL_unify_integer(size, m->end - m->gap_size) )
851     { rc = FALSE;
852       goto out;
853     }
854 
855     if ( m->stream )
856     { IOPOS *op = m->stream->position;
857       long p;
858 
859       m->stream->position = NULL;
860       p = Stell(m->stream);
861       m->stream->position = op;
862 
863       rc = PL_unify_integer(here, p);
864     } else
865       rc = PL_unify_integer(here, 0);
866 
867   out:
868     release_memfile(m);
869   } else
870     rc = FALSE;
871 
872   return rc;
873 }
874 
875 
876 static foreign_t
atom_to_memory_file(term_t atom,term_t handle)877 atom_to_memory_file(term_t atom, term_t handle)
878 { atom_t a;
879 
880   if ( PL_get_atom(atom, &a) )
881   { memfile *m = calloc(1, sizeof(*m));
882 
883     if ( !m )
884       return pl_error(NULL, 0, NULL, ERR_ERRNO, errno,
885 		      "create", "memory_file", handle);
886 
887     m->atom = a;
888     PL_register_atom(m->atom);
889     m->magic = MEMFILE_MAGIC;
890 
891     if ( (m->data = (char *)PL_atom_nchars(a, &m->char_count)) )
892     { m->encoding  = ENC_ISO_LATIN_1;
893       m->end       = m->char_count;
894       m->gap_start = m->end;
895     } else if ( (m->data = (char *)PL_atom_wchars(a, &m->char_count)) )
896     { m->encoding = ENC_WCHAR;
897       m->end = m->char_count * sizeof(wchar_t);
898       m->gap_start = m->end;
899     } else if ( PL_blob_data(a, &m->char_count, NULL) )
900     { m->data = PL_blob_data(a, &m->end, NULL);
901       m->encoding = ENC_OCTET;
902       m->char_count = m->end;
903       m->gap_start  = m->end;
904     }
905 
906 #ifdef O_PLMT
907     pthread_mutex_init(&m->mutex, NULL);
908 #endif
909 
910     if ( unify_memfile(handle, m) )
911     { return TRUE;
912     } else
913     { destroy_memory_file(m);
914       return FALSE;
915     }
916   } else
917   { return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
918 		    atom, "atom");
919   }
920 }
921 
922 		 /*******************************
923 		 *	  DIRECT EXCHANGE	*
924 		 *******************************/
925 
926 static int
can_modify_memory_file(term_t handle,memfile * mf)927 can_modify_memory_file(term_t handle, memfile *mf)
928 { if ( mf->atom )
929     return pl_error(NULL, 0, "read only",
930 		    ERR_PERMISSION, handle, "modify", "memory_file");
931   if ( mf->stream )
932     return alreadyOpen(handle, "modify");
933 
934   return TRUE;
935 }
936 
937 
938 /* Get the byte offset for a character
939 */
940 
941 static char *
utf8_skip_char(const char * in,const char * e)942 utf8_skip_char(const char *in, const char *e)
943 { if ( !(in[0]&0x80) )
944   { return (char*)in+1;
945   } else
946   { in++;
947     while ( in < e && ISUTF8_CB(in[0]) )
948       in++;
949     return (char*)in;
950   }
951 }
952 
953 
954 /* Skip chars forward from a byte position, returning the new
955    byte position in the memory file or NOSIZE if we would skip
956    outside the limits of the memory file.  Returns:
957 
958      OUTOFRANGE if memfile is too small
959      FALSE      if the encoding is not supported
960      TRUE       if ok
961 */
962 
963 #define OUTOFRANGE -1
964 
965 static int
mf_skip(memfile * mf,IOENC encoding,size_t from,size_t chars,size_t * end)966 mf_skip(memfile *mf, IOENC encoding, size_t from, size_t chars, size_t *end)
967 { size_t to;
968 
969   switch(encoding)
970   { case ENC_OCTET:
971     case ENC_ASCII:
972     case ENC_ISO_LATIN_1:
973       to = from+chars;
974       break;
975     case ENC_UTF8:
976     { const char *start, *s, *e;
977       const size_t chars0 = (from == 0 ? chars : NOSIZE);
978 
979       if ( from == 0 &&
980 	   (mf->pcache.valid & V_CHARCOUNT) &&
981 	   chars >= mf->pcache.char_count )
982       { from   = mf->pcache.byte_count;
983 	chars -= mf->pcache.char_count;
984       }
985 
986       if ( from < mf->gap_start )
987       { start = s = &mf->data[from];
988 	e = &mf->data[mf->gap_start];
989 
990 	while(chars>0 && s<e)
991 	{ chars--;
992 	  s = utf8_skip_char(s, e);
993 	}
994 	from += s - start;
995 	if ( chars == 0 )
996 	{ utf8_out:
997 	  if ( chars0 != NOSIZE )
998 	  { mf->pcache.char_count = chars0;
999 	    mf->pcache.byte_count = from;
1000 	    mf->pcache.valid |= V_CHARCOUNT;
1001 	  }
1002 	  *end = from;
1003 	  return TRUE;
1004 	}
1005 	assert(s == e);
1006       }
1007 
1008       start = s = &mf->data[mf->gap_size+from];
1009       e = &mf->data[mf->end];
1010       while(chars>0 && s<e)
1011       { chars--;
1012 	s = utf8_skip_char(s, e);
1013       }
1014       from += s - start;
1015       if ( chars == 0 )
1016 	goto utf8_out;
1017       goto outofrange;
1018     }
1019     case ENC_UNICODE_BE:
1020     case ENC_UNICODE_LE:
1021       to = from + 2*chars;
1022       break;
1023     case ENC_WCHAR:
1024       to = from + sizeof(wchar_t) * chars;
1025       break;
1026     default:
1027       return PL_representation_error("encoding");
1028   }
1029 
1030   if ( to > mf->end - mf->gap_size )
1031   { outofrange:
1032     *end = mf->end - mf->gap_size;
1033     return OUTOFRANGE;
1034   }
1035 
1036   *end = to;
1037   return TRUE;
1038 }
1039 
1040 
1041 static int
get_offset(term_t where,memfile * mf,IOENC encoding,size_t * pos)1042 get_offset(term_t where, memfile *mf, IOENC encoding, size_t *pos)
1043 { size_t p;
1044 
1045   if ( PL_get_size_ex(where, &p) )
1046   { int rc = mf_skip(mf, encoding, 0, p, pos);
1047 
1048     if ( rc != OUTOFRANGE )
1049       return rc;
1050 
1051     return PL_domain_error("offset", where);
1052   }
1053 
1054   return FALSE;
1055 }
1056 
1057 
1058 static foreign_t
insert_memory_file(term_t handle,term_t where,term_t data)1059 insert_memory_file(term_t handle, term_t where, term_t data)
1060 { memfile *m;
1061   int rc;
1062 
1063   if ( get_memfile(handle, &m) )
1064   { size_t pos;
1065     int flags = CVT_ALL|CVT_WRITEQ|CVT_EXCEPTION;
1066 
1067     if ( can_modify_memory_file(handle, m) &&
1068 	 get_offset(where, m, m->encoding, &pos) )
1069     { move_gap_to(m, pos);
1070       switch(m->encoding)
1071       { case ENC_OCTET:
1072 	case ENC_ASCII:
1073 	case ENC_ISO_LATIN_1:
1074 	case ENC_ANSI:
1075 	case ENC_UTF8:
1076 	{ size_t len;
1077 	  char *buf;
1078 	  int rep = ( m->encoding == ENC_UTF8 ? REP_UTF8 :
1079 		      m->encoding == ENC_ANSI ? REP_MB :
1080 						REP_ISO_LATIN_1
1081 		    );
1082 
1083 	  if ( (rc=PL_get_nchars(data, &len, &buf, flags|rep)) )
1084 	  { if ( write_memfile(m, buf, len) < 0 )
1085 	      rc = PL_resource_error("memory");
1086 	    check_memfile(m);
1087 	  }
1088 	  break;
1089 	}
1090 	case ENC_WCHAR:
1091 	{ size_t len;
1092 	  wchar_t *buf;
1093 
1094 	  if ( (rc=PL_get_wchars(data, &len, &buf, flags)) )
1095 	  { if ( write_memfile(m, (void*)buf, len*sizeof(wchar_t)) < 0 )
1096 	      rc = PL_resource_error("memory");
1097 	  }
1098 	  break;
1099 	}
1100 	default:
1101 	  rc = PL_representation_error("encoding");
1102       }
1103     } else
1104       rc = FALSE;
1105 
1106     release_memfile(m);
1107   } else
1108     rc = FALSE;
1109 
1110   return rc;
1111 }
1112 
1113 
1114 static foreign_t
delete_memory_file(term_t handle,term_t where,term_t len)1115 delete_memory_file(term_t handle, term_t where, term_t len)
1116 { memfile *m;
1117   int rc;
1118 
1119   if ( get_memfile(handle, &m) )
1120   { size_t pos, end;
1121     size_t l;
1122 
1123     if ( can_modify_memory_file(handle, m) &&
1124 	 get_offset(where, m, m->encoding, &pos) &&
1125 	 PL_get_size_ex(len, &l) &&
1126 	 mf_skip(m, m->encoding, pos, l, &end) != FALSE )
1127     { if ( end > pos )
1128       { if ( pos < m->pcache.byte_count )
1129 	  m->pcache.valid = 0;
1130 
1131 	move_gap_to(m, pos);
1132 	m->gap_size += end-pos;
1133 	m->char_count = NOSIZE;
1134       }
1135       rc = TRUE;
1136     } else
1137       rc = FALSE;
1138 
1139     release_memfile(m);
1140   } else
1141     rc = FALSE;
1142 
1143   return rc;
1144 }
1145 
1146 
1147 static foreign_t
mf_to_text(term_t handle,memfile * m,size_t from,size_t len,term_t atom,term_t encoding,int flags)1148 mf_to_text(term_t handle, memfile *m, size_t from, size_t len,
1149 	   term_t atom, term_t encoding, int flags)
1150 { IOENC enc;
1151   size_t start, end;
1152 
1153   if ( m->stream && (m->stream->flags & SIO_OUTPUT))
1154     return alreadyOpen(handle, "to_atom");
1155 
1156   if ( encoding )
1157   { if ( !get_encoding(encoding, &enc) )
1158       return FALSE;
1159   } else
1160     enc = m->encoding;
1161 
1162   if ( from == NOSIZE )
1163   { start = 0;
1164   } else
1165   { if ( mf_skip(m, enc, 0, from, &start) != TRUE )
1166       return FALSE;
1167   }
1168 
1169   if ( len == NOSIZE )
1170   { end = m->end - m->gap_size;
1171   } else
1172   { if ( mf_skip(m, enc, start, len, &end) != TRUE )
1173       return FALSE;
1174   }
1175 
1176   if ( m->data )
1177   { size_t len = end-start;
1178     const char *data;
1179 
1180     if ( start <= m->gap_start && end <= m->gap_start )
1181     { data = &m->data[start];
1182     } else if ( start >= m->gap_start+m->gap_size )
1183     { data = &m->data[m->gap_size + (start-m->gap_start)];
1184     } else
1185     { move_gap_to(m, end);
1186       data = &m->data[start];
1187     }
1188 
1189     switch(enc)
1190     { case ENC_ISO_LATIN_1:
1191       case ENC_OCTET:
1192 	return PL_unify_chars(atom, flags, len, data);
1193       case ENC_WCHAR:
1194 	return PL_unify_wchars(atom, flags,
1195 			       len/sizeof(wchar_t),
1196 			       (pl_wchar_t*)data);
1197       case ENC_UTF8:
1198 	return PL_unify_chars(atom, flags|REP_UTF8, len, data);
1199       default:
1200 	assert(0);
1201     }
1202   } else
1203     return PL_unify_chars(atom, flags, 0, "");
1204 
1205   return FALSE;
1206 }
1207 
1208 
1209 static foreign_t
memory_file_to_text(term_t handle,term_t text,term_t encoding,int flags)1210 memory_file_to_text(term_t handle, term_t text, term_t encoding, int flags)
1211 { memfile *mf;
1212   int rc;
1213 
1214   if ( get_memfile(handle, &mf) )
1215   { rc = mf_to_text(handle, mf, NOSIZE, NOSIZE, text, encoding, flags);
1216     release_memfile(mf);
1217   } else
1218     rc = FALSE;
1219 
1220   return rc;
1221 }
1222 
1223 
1224 static foreign_t
memory_file_to_atom2(term_t handle,term_t atom)1225 memory_file_to_atom2(term_t handle, term_t atom)
1226 { return memory_file_to_text(handle, atom, 0, PL_ATOM);
1227 }
1228 
1229 
1230 static foreign_t
memory_file_to_atom3(term_t handle,term_t atom,term_t encoding)1231 memory_file_to_atom3(term_t handle, term_t atom, term_t encoding)
1232 { return memory_file_to_text(handle, atom, encoding, PL_ATOM);
1233 }
1234 
1235 
1236 static foreign_t
memory_file_to_codes2(term_t handle,term_t atom)1237 memory_file_to_codes2(term_t handle, term_t atom)
1238 { return memory_file_to_text(handle, atom, 0, PL_CODE_LIST);
1239 }
1240 
1241 
1242 static foreign_t
memory_file_to_codes3(term_t handle,term_t atom,term_t encoding)1243 memory_file_to_codes3(term_t handle, term_t atom, term_t encoding)
1244 { return memory_file_to_text(handle, atom, encoding, PL_CODE_LIST);
1245 }
1246 
1247 
1248 static foreign_t
memory_file_to_string2(term_t handle,term_t atom)1249 memory_file_to_string2(term_t handle, term_t atom)
1250 { return memory_file_to_text(handle, atom, 0, PL_STRING);
1251 }
1252 
1253 
1254 static foreign_t
memory_file_to_string3(term_t handle,term_t atom,term_t encoding)1255 memory_file_to_string3(term_t handle, term_t atom, term_t encoding)
1256 { return memory_file_to_text(handle, atom, encoding, PL_STRING);
1257 }
1258 
1259 
1260 static int
get_size_or_var(term_t t,size_t * sp)1261 get_size_or_var(term_t t, size_t *sp)
1262 { if ( PL_is_variable(t) )
1263   { *sp = NOSIZE;
1264     return TRUE;
1265   }
1266 
1267   return PL_get_size_ex(t, sp);
1268 }
1269 
1270 
1271 static foreign_t
memory_file_substring(term_t handle,term_t before,term_t len,term_t after,term_t string)1272 memory_file_substring(term_t handle,
1273 		      term_t before, term_t len, term_t after,
1274 		      term_t string)
1275 { memfile *mf;
1276   int rc;
1277 
1278   if ( (rc=get_memfile(handle, &mf)) )
1279   { size_t b, l, a, size;
1280 
1281     if ( get_size_or_var(before, &b) &&
1282 	 get_size_or_var(len, &l) &&
1283 	 get_size_or_var(after, &a) &&
1284 	 get_size_mf(mf, mf->encoding, &size) )
1285     { if ( b != NOSIZE && l != NOSIZE )
1286       { rc = ( mf_to_text(handle, mf, b, l, string, 0, PL_STRING) &&
1287 	       PL_unify_int64(after, size-(b+l)) );
1288       } else if ( b != NOSIZE && a != NOSIZE )
1289       {	rc = ( mf_to_text(handle, mf, b, size-(b+a), string, 0, PL_STRING) &&
1290 	       PL_unify_int64(len, size-(b+a)) );
1291       } else if ( l != NOSIZE && a != NOSIZE )
1292       { rc = ( mf_to_text(handle, mf, size-(l+a), l, string, 0, PL_STRING) &&
1293 	       PL_unify_int64(before, size-(l+a)) );
1294       } else
1295       { rc = PL_instantiation_error(b != NOSIZE ? before : len);
1296       }
1297     } else
1298       rc = FALSE;
1299 
1300     release_memfile(mf);
1301   }
1302 
1303   return rc;
1304 }
1305 
1306 /* skip lines from a given byte-offset, returning the byte-offset
1307    for the beginning of the next line and the logical character
1308    count that belongs to that.
1309 */
1310 
1311 static int
skip_lines(memfile * mf,size_t from,size_t lines,size_t * startp,size_t * chcountp)1312 skip_lines(memfile *mf, size_t from, size_t lines,
1313 	   size_t *startp, size_t *chcountp)
1314 { const char *start, *s, *e;
1315   size_t chcount = 0;
1316 
1317   if ( lines == 0 )
1318   { *startp = from;
1319     *chcountp = 0;
1320     return TRUE;
1321   }
1322 
1323   if ( from < mf->gap_start )
1324   { start = s = mf->data+from;
1325     e = &mf->data[mf->gap_start];
1326   } else
1327   { after_gap:
1328     start = s = &mf->data[mf->gap_size+from];
1329     e = &mf->data[mf->end];
1330   }
1331 
1332   switch(mf->encoding)
1333   { case ENC_OCTET:
1334     case ENC_ASCII:
1335     case ENC_ISO_LATIN_1:
1336       while( s < e )
1337       { if ( *s++ == '\n' )
1338 	{ if ( --lines == 0 )
1339 	  { *startp   = from + (s-start) + 1;
1340 	    *chcountp = chcount + (s-start) + 1;
1341 	    return TRUE;
1342 	  }
1343 	}
1344       }
1345       chcount += e-s;
1346       break;
1347     case ENC_UTF8:
1348       while( s < e )
1349       { chcount++;
1350 	if ( *s == '\n' )
1351 	{ if ( --lines == 0 )
1352 	  { *startp   = from + (s-start) + 1;
1353 	    *chcountp = chcount;
1354 	    return TRUE;
1355 	  }
1356 	}
1357 	s = utf8_skip_char(s, e);
1358       }
1359       break;
1360     case ENC_WCHAR:
1361     { const wchar_t *ws = (const wchar_t*)s;
1362       const wchar_t *we = (const wchar_t*)e;
1363       const wchar_t *wstart = ws;
1364 
1365       while( ws < we )
1366       { if ( *ws++ == '\n' )
1367 	{ if ( --lines == 0 )
1368 	  { *startp   = from + (ws-wstart) + 1;
1369 	    *chcountp = chcount + (ws-wstart) + 1;
1370 	    return TRUE;
1371 	  }
1372 	}
1373       }
1374       chcount += we-ws;
1375       break;
1376     }
1377     default:
1378       return PL_representation_error("encoding");
1379   }
1380 
1381   if ( from < mf->gap_start )
1382   { from = mf->gap_start;
1383     goto after_gap;
1384   }
1385 
1386   *startp   = mf->end;
1387   *chcountp = chcount;
1388 
1389   return OUTOFRANGE;
1390 }
1391 
1392 
1393 /** memory_file_line_position(+MF, +Line, +LinePos, -Offset) is det.
1394     memory_file_line_position(+MF, -Line, -LinePos, +Offset) is det.
1395 
1396 True when Offset is the character offset for Line:LinePos.
1397 */
1398 
1399 static foreign_t
memory_file_line_position(term_t handle,term_t line,term_t linepos,term_t offset)1400 memory_file_line_position(term_t handle,
1401 			  term_t line, term_t linepos, term_t offset)
1402 { memfile *mf;
1403   int rc;
1404 
1405   if ( get_memfile(handle, &mf) )
1406   { size_t l, lp, o;
1407 
1408     if ( get_size_or_var(line, &l) &&
1409 	 get_size_or_var(linepos, &lp) &&
1410 	 get_size_or_var(offset, &o) )
1411     { if ( l != NOSIZE && lp != NOSIZE )
1412       { size_t lstart, nstart;
1413 	size_t chcount;
1414 	size_t linelen;
1415 
1416 	if ( l == 0 )
1417 	{ rc = PL_domain_error("not_less_than_one", line);
1418 	  goto out;
1419 	}
1420 	l--;
1421 
1422 	if (     skip_lines(mf, 0,      l, &lstart, &chcount)  == TRUE &&
1423 	     (rc=skip_lines(mf, lstart, 1, &nstart, &linelen)) != FALSE &&
1424 	     (lp < linelen || (lp == linelen && rc == OUTOFRANGE)) )
1425 	  rc = PL_unify_int64(offset, chcount+lp);
1426 	else
1427 	  rc = FALSE;
1428       } else if ( o != NOSIZE )
1429       { size_t chcount = 0;
1430 	size_t lstart = 0;
1431 	size_t line_count = 1;
1432 
1433 	do
1434 	{ size_t linelen;
1435 
1436 	  if ( (rc=skip_lines(mf, lstart, 1, &lstart, &linelen)) != FALSE )
1437 	  { if (  chcount + linelen > o ||
1438 		 (chcount + linelen == o && rc == OUTOFRANGE)
1439 	       )
1440 	    { rc = ( PL_unify_int64(line, line_count) &&
1441 		     PL_unify_int64(linepos, o-chcount) );
1442 	      goto out;
1443 	    }
1444 	  }
1445 	  line_count++;
1446 	  chcount += linelen;
1447 	} while(chcount < o && rc == TRUE);
1448 
1449 	rc = FALSE;
1450       } else
1451       { rc = PL_instantiation_error(offset);
1452       }
1453     } else
1454       rc = FALSE;
1455 
1456   out:
1457     release_memfile(mf);
1458   } else
1459     rc = FALSE;
1460 
1461   return rc;
1462 }
1463 
1464 
1465 #define MKATOM(n) ATOM_ ## n = PL_new_atom(#n);
1466 
1467 install_t
install_memfile()1468 install_memfile()
1469 { MKATOM(encoding);
1470   MKATOM(unknown);
1471   MKATOM(octet);
1472   MKATOM(ascii);
1473   MKATOM(iso_latin_1);
1474   MKATOM(text);
1475   MKATOM(utf8);
1476   MKATOM(unicode_be);
1477   MKATOM(unicode_le);
1478   MKATOM(wchar_t);
1479   MKATOM(read);
1480   MKATOM(write);
1481   MKATOM(append);
1482   MKATOM(update);
1483   MKATOM(insert);
1484   MKATOM(free_on_close);
1485 
1486   PL_register_foreign("new_memory_file",	   1, new_memory_file,	      0);
1487   PL_register_foreign("free_memory_file",	   1, free_memory_file,	      0);
1488   PL_register_foreign("size_memory_file",	   2, size_memory_file2,      0);
1489   PL_register_foreign("size_memory_file",	   3, size_memory_file3,      0);
1490   PL_register_foreign("open_memory_file",	   3, open_memory_file,	      0);
1491   PL_register_foreign("open_memory_file",	   4, open_memory_file4,      0);
1492   PL_register_foreign("atom_to_memory_file",	   2, atom_to_memory_file,    0);
1493   PL_register_foreign("memory_file_to_atom",	   2, memory_file_to_atom2,   0);
1494   PL_register_foreign("memory_file_to_codes",	   2, memory_file_to_codes2,  0);
1495   PL_register_foreign("memory_file_to_string",	   2, memory_file_to_string2, 0);
1496   PL_register_foreign("memory_file_to_atom",	   3, memory_file_to_atom3,   0);
1497   PL_register_foreign("memory_file_to_codes",	   3, memory_file_to_codes3,  0);
1498   PL_register_foreign("memory_file_to_string",	   3, memory_file_to_string3, 0);
1499   PL_register_foreign("utf8_position_memory_file", 3, utf8_position,	      0);
1500   PL_register_foreign("insert_memory_file",	   3, insert_memory_file,     0);
1501   PL_register_foreign("delete_memory_file",	   3, delete_memory_file,     0);
1502   PL_register_foreign("memory_file_substring",     5, memory_file_substring,  0);
1503   PL_register_foreign("memory_file_line_position", 4, memory_file_line_position, 0);
1504 }
1505