From be79c3326e43d9f855959aa169249dd99e904be9 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 12 Feb 2011 14:14:12 +0000 Subject: [PATCH] first pass at open/ and friends. --- C/iopreds.c | 515 ++------------------------------ H/dhstruct.h | 1 + H/hstruct.h | 3 +- H/ihstruct.h | 1 + H/rheap.h | 5 + H/rhstruct.h | 1 + H/sshift.h | 1 + library/dialect/swi/fli/blobs.c | 50 +++- misc/HEAPFIELDS | 3 +- pl/boot.yap | 27 +- pl/consult.yap | 12 +- pl/yio.yap | 269 ----------------- 12 files changed, 115 insertions(+), 773 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index 7f1236d39..9a04d709b 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -123,8 +123,6 @@ STATIC_PROTO (int ReadlinePutc, (int,int)); STATIC_PROTO (int PlUnGetc, (int)); STATIC_PROTO (Term MkStream, (int)); STATIC_PROTO (Int p_stream_flags, (void)); -STATIC_PROTO (int find_csult_file, (char *, char *, StreamDesc *, char *)); -STATIC_PROTO (Int p_open, (void)); STATIC_PROTO (int AddAlias, (Atom, int)); STATIC_PROTO (void SetAlias, (Atom, int)); STATIC_PROTO (void PurgeAlias, (int)); @@ -159,7 +157,6 @@ STATIC_PROTO (Int p_skip, (void)); STATIC_PROTO (Int p_flush, (void)); STATIC_PROTO (Int p_flush_all_streams, (void)); STATIC_PROTO (Int p_write_depth, (void)); -STATIC_PROTO (Int p_open_null_stream, (void)); STATIC_PROTO (Int p_user_file_name, (void)); STATIC_PROTO (Int p_line_position, (void)); STATIC_PROTO (Int p_character_count, (void)); @@ -2149,26 +2146,6 @@ p_stream_flags (void) return (Yap_unify_constant (ARG2, MkIntTerm (Stream[IntOfTerm (trm)].status))); } -static int -find_csult_file (char *source, char *buf, StreamDesc * st, char *io_mode) -{ - - char *cp = source, ch; - while (*cp++); - while ((ch = *--cp) != '.' && !Yap_dir_separator((int)ch) && cp != source); - if (ch == '.') - return (FALSE); - strncpy (buf, source, YAP_FILENAME_MAX); - strncat (buf, ".yap", YAP_FILENAME_MAX); - if ((st->u.file.file = YP_fopen (buf, io_mode)) != YAP_ERROR) - return (TRUE); - strncpy (buf, source, YAP_FILENAME_MAX); - strncat (buf, ".pl", YAP_FILENAME_MAX); - if ((st->u.file.file = YP_fopen (buf, io_mode)) != YAP_ERROR) - return (TRUE); - return (FALSE); -} - /* given a stream index, get the corresponding fd */ static Int GetStreamFd(int sno) @@ -2286,204 +2263,6 @@ Yap_UpdateSocketStream(int sno, socket_info flags, socket_domain domain) { #endif /* USE_SOCKET */ -static int -binary_file(char *file_name) -{ -#if HAVE_STAT -#if _MSC_VER || defined(__MINGW32__) - struct _stat ss; - if (_stat(file_name, &ss) != 0) { -#else - struct stat ss; - if (stat(file_name, &ss) != 0) { -#endif - /* ignore errors while checking a file */ - return(FALSE); - } - return (S_ISDIR(ss.st_mode)); -#else - return(FALSE); -#endif -} - -static int -write_bom(int sno, StreamDesc *st) -{ - /* dump encoding */ - switch (st->encoding) { - case ENC_ISO_UTF8: - if (st->stream_putc(sno,0xEF)<0) - return FALSE; - if (st->stream_putc(sno,0xBB)<0) - return FALSE; - if (st->stream_putc(sno,0xBF)<0) - return FALSE; - st->status |= HAS_BOM_f; - return TRUE; - case ENC_UNICODE_BE: - if (st->stream_putc(sno,0xFE)<0) - return FALSE; - if (st->stream_putc(sno,0xFF)<0) - return FALSE; - st->status |= HAS_BOM_f; - return TRUE; - case ENC_UNICODE_LE: - if (st->stream_putc(sno,0xFF)<0) - return FALSE; - if (st->stream_putc(sno,0xFE)<0) - return FALSE; - case ENC_ISO_UTF32_BE: - if (st->stream_putc(sno,0x00)<0) - return FALSE; - if (st->stream_putc(sno,0x00)<0) - return FALSE; - if (st->stream_putc(sno,0xFE)<0) - return FALSE; - if (st->stream_putc(sno,0xFF)<0) - return FALSE; - case ENC_ISO_UTF32_LE: - if (st->stream_putc(sno,0xFF)<0) - return FALSE; - if (st->stream_putc(sno,0xFE)<0) - return FALSE; - if (st->stream_putc(sno,0x00)<0) - return FALSE; - if (st->stream_putc(sno,0x00)<0) - return FALSE; - default: - return TRUE; - } -} - - -static int -check_bom(int sno, StreamDesc *st) -{ - - int ch; - - ch = st->stream_getc(sno); - if (ch == EOFCHAR) { - st->och = ch; - st->stream_getc = PlUnGetc; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } - switch(ch) { - case 0x00: - { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc00; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0xFE) { - st->och = ch; - st->stream_getc = PlUnGetc0000; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0xFF) { - st->och = ch; - st->stream_getc = PlUnGetc0000fe; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF32_BE; - return TRUE; - } - } - } - } - case 0xFE: - { - ch = st->stream_getc(sno); - if (ch != 0xFF) { - st->och = ch; - st->stream_getc = PlUnGetc376; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - st->status |= HAS_BOM_f; - st->encoding = ENC_UNICODE_BE; - return TRUE; - } - } - case 0xFF: - { - ch = st->stream_getc(sno); - if (ch != 0xFE) { - st->och = ch; - st->stream_getc = PlUnGetc377; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc377376; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - } else { - ch = st->stream_getc(sno); - if (ch == EOFCHAR || ch != 0x00) { - st->och = ch; - st->stream_getc = PlUnGetc37737600; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - } else { - st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF32_LE; - return TRUE; - } - } - st->status |= HAS_BOM_f; - st->encoding = ENC_UNICODE_LE; - return TRUE; - } - } - case 0xEF: - ch = st->stream_getc(sno); - if (ch != 0xBB) { - st->och = ch; - st->stream_getc = PlUnGetc357; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - ch = st->stream_getc(sno); - if (ch != 0xBF) { - st->och = ch; - st->stream_getc = PlUnGetc357273; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } else { - st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF8; - return TRUE; - } - } - default: - st->och = ch; - st->stream_getc = PlUnGetc; - st->stream_wgetc = get_wchar; - st->stream_gets = DefaultGets; - return TRUE; - } -} - #if _MSC_VER || defined(__MINGW32__) #define SYSTEM_STAT _stat #else @@ -2546,217 +2325,6 @@ p_exists_directory(void) } } -static Int -p_open (void) -{ /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - Term file_name, t, t2, topts, tenc; - Atom open_mode; - int sno; - SMALLUNSGN s; - char io_mode[8]; - StreamDesc *st; - Int opts; - UInt encoding; - int needs_bom = FALSE, avoid_bom = FALSE; - - file_name = Deref(ARG1); - /* we know file_name is bound */ - if (!IsAtomTerm (file_name)) { - Yap_Error(DOMAIN_ERROR_SOURCE_SINK,file_name, "open/3"); - return(FALSE); - } - t2 = Deref (ARG2); - if (!IsAtomTerm (t2)) { - Yap_Error(TYPE_ERROR_ATOM,t2, "open/3"); - return(FALSE); - } - open_mode = AtomOfTerm (t2); - if (open_mode == AtomRead || open_mode == AtomCsult) { - if (open_mode == AtomCsult && AtomOfTerm(file_name) == AtomUserIn) { - return(Yap_unify(MkStream(FileAliases[0].alias_stream), ARG3)); - } - strncpy(io_mode,"rb", 8); - s = Input_Stream_f; - } else if (open_mode == AtomWrite) { - strncpy(io_mode,"w",8); - s = Output_Stream_f; - } else if (open_mode == AtomAppend) { - strncpy(io_mode,"a",8); - s = Append_Stream_f | Output_Stream_f; - } else { - Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3"); - return(FALSE); - } - /* can never happen */ - topts = Deref(ARG4); - if (IsVarTerm(topts) || !IsIntegerTerm(topts)) - return(FALSE); - opts = IntegerOfTerm(topts); - if (!strncpy(Yap_FileNameBuf, RepAtom (AtomOfTerm (file_name))->StrOfAE, YAP_FILENAME_MAX)) - return (PlIOError (SYSTEM_ERROR,file_name,"file name is too long in open/3")); - sno = GetFreeStreamD(); - if (sno < 0) - return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "open/3")); - st = &Stream[sno]; - /* can never happen */ - tenc = Deref(ARG5); - if (IsVarTerm(tenc) || !IsIntegerTerm(tenc)) { - UNLOCK(st->streamlock); - return FALSE; - } - encoding = IntegerOfTerm(tenc); -#ifdef _WIN32 - if (opts & 2) { - strncat(io_mode, "b", 8); - } else { - strncat(io_mode, "t", 8); - } -#endif - if ((st->u.file.file = YP_fopen (Yap_FileNameBuf, io_mode)) == YAP_ERROR || - (!(opts & 2 /* binary */) && binary_file(Yap_FileNameBuf))) - { - UNLOCK(st->streamlock); - if (open_mode == AtomCsult) - { - if (!find_csult_file (Yap_FileNameBuf, Yap_FileNameBuf2, st, io_mode)) - return (PlIOError (EXISTENCE_ERROR_SOURCE_SINK, ARG6, "open/3")); - strncpy (Yap_FileNameBuf, Yap_FileNameBuf2, YAP_FILENAME_MAX); - } - else { - if (errno == ENOENT) - return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK,ARG6,"open/3")); - else - return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK,file_name,"open/3")); - } - } -#if MAC - if (open_mode == AtomWrite) - { - Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE); - } -#endif - st->status = s; - st->charcount = 0; - st->linecount = 1; - st->linepos = 0; - st->u.file.name = Yap_LookupAtom (Yap_FileNameBuf); - if (IsAtomTerm(Deref(ARG6))) - st->u.file.user_name = Deref(ARG6); - else - st->u.file.user_name = file_name; - st->stream_putc = FilePutc; - st->stream_wputc = put_wchar; - st->stream_getc = PlGetc; - st->stream_gets = PlGetsFunc(); - if (st->status & Binary_Stream_f) { - st->encoding = ENC_OCTET; - } else { - st->encoding = encoding; - } - unix_upd_stream_info (st); - if (opts != 0) { - if (opts & 2) { - st->status |= Binary_Stream_f; - /* we should not search for a byter order mark on a binary file */ - avoid_bom = TRUE; - } - if (opts & 4) { - if (st->status & (Tty_Stream_f|Socket_Stream_f|InMemory_Stream_f)) { - Term ta[1], t; - -#if USE_SOCKET - if (st->status & Socket_Stream_f) { - st->stream_putc = SocketPutc; - st->stream_wputc = put_wchar; - st->stream_getc = SocketGetc; - st->stream_gets = DefaultGets; - } else -#endif - if (st->status & Pipe_Stream_f) { - st->stream_putc = PipePutc; - st->stream_wputc = put_wchar; - st->stream_getc = PipeGetc; - st->stream_gets = DefaultGets; - } else if (st->status & InMemory_Stream_f) { - st->stream_putc = MemPutc; - st->stream_wputc = put_wchar; - st->stream_getc = MemGetc; - st->stream_gets = DefaultGets; - } else { - st->stream_putc = ConsolePutc; - st->stream_wputc = put_wchar; - st->stream_getc = PlGetc; - st->stream_gets = PlGetsFunc(); - } - UNLOCK(st->streamlock); - ta[1] = MkAtomTerm(AtomTrue); - t = Yap_MkApplTerm(Yap_MkFunctor(AtomReposition,1),1,ta); - Yap_Error(PERMISSION_ERROR_OPEN_SOURCE_SINK,t,"open/4"); - return FALSE; - } - /* useless crap */ - st->status |= Seekable_Stream_f; - } - if (opts & 8) { - /* There may be one reason why one wouldn't want to seek in a - file, maybe .... */ - st->status &= ~Seekable_Stream_f; - } - if (opts & 16) { - st->status &= ~Reset_Eof_Stream_f; - st->status |= Eof_Error_Stream_f; - } - if (opts & 32) { - st->status &= ~Reset_Eof_Stream_f; - st->status &= ~Eof_Error_Stream_f; - } - if (opts & 64) { - st->status &= ~Eof_Error_Stream_f; - st->status |= Reset_Eof_Stream_f; - } - if (opts & 128) { - needs_bom = TRUE; - } - if (opts & 256) { - avoid_bom = TRUE; - } - if (opts & 512) { - st->status |= RepError_Prolog_f; - } - if (opts & 1024) { - st->status |= RepError_Xml_f; - } - } - st->stream_wgetc = get_wchar; - if (CharConversionTable != NULL) - st->stream_wgetc_for_read = ISOWGetc; - else - st->stream_wgetc_for_read = st->stream_wgetc; - UNLOCK(st->streamlock); - t = MkStream (sno); - if (open_mode == AtomWrite ) { - if (needs_bom && !write_bom(sno,st)) - return FALSE; - } else if ((open_mode == AtomRead || open_mode == AtomCsult) && - !avoid_bom && - (needs_bom || (st->status & Seekable_Stream_f))) { - if (!check_bom(sno, st)) - return FALSE; - /* - if (st->encoding == ENC_ISO_UTF32_BE) { - Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (BE) stream encoding unsupported"); - return FALSE; - } else if (st->encoding == ENC_ISO_UTF32_LE) { - Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (LE) stream encoding unsupported"); - return FALSE; - } - */ - } - st->status &= ~(Free_Stream_f); - return (Yap_unify (ARG3, t)); -} - - static Int p_file_expansion (void) { /* '$file_expansion'(+File,-Name) */ @@ -2878,31 +2446,6 @@ p_fetch_stream_alias (void) } } -static Int -p_open_null_stream (void) -{ - Term t; - StreamDesc *st; - int sno = GetFreeStreamD(); - if (sno < 0) - return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1")); - st = &Stream[sno]; - st->status = Append_Stream_f | Output_Stream_f | Null_Stream_f; - st->linepos = 0; - st->charcount = 0; - st->linecount = 1; - st->stream_putc = NullPutc; - st->stream_wputc = put_wchar; - st->stream_getc = PlGetc; - st->stream_gets = PlGetsFunc(); - st->stream_wgetc = get_wchar; - st->stream_wgetc_for_read = get_wchar; - st->u.file.user_name = MkAtomTerm (st->u.file.name = AtomDevNull); - UNLOCK(st->streamlock); - t = MkStream (sno); - return (Yap_unify (ARG1, t)); -} - Term Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) { @@ -3405,6 +2948,13 @@ LookupSWIStream (struct io_stream *swi_s) return i; } +typedef struct stream_ref +{ struct io_stream *read; + struct io_stream *write; +} stream_ref; + +extern stream_ref *PL_blob_data(Atom, void *, void *); + static int CheckStream (Term arg, int kind, char *msg) { @@ -3436,6 +2986,24 @@ CheckStream (Term arg, int kind, char *msg) return sno; } } + if (IsBlob (sname)) { + struct io_stream *s; + stream_ref *ref; + + ref = PL_blob_data(sname, NULL, NULL); + { + if ( ref->read ) + { + if ( ref->write && (kind&Output_Stream_f) ) + s = ref->write; + else + s = ref->read; + } else + s = ref->write; + } + sno = LookupSWIStream(s); + return sno; + } if ((sno = CheckAlias(sname)) == -1) { Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); return -1; @@ -3450,10 +3018,6 @@ CheckStream (Term arg, int kind, char *msg) sno = xsno; } } - } else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FSWIStream) { - arg = ArgOfTerm (1, arg); - if (!IsVarTerm (arg) && IsIntegerTerm (arg)) - sno = LookupSWIStream((struct io_stream *)IntegerOfTerm (arg)); } if (sno < 0) { @@ -4563,28 +4127,6 @@ p_user_file_name (void) return (Yap_unify_constant (ARG2, tout)); } -static Int -p_file_name (void) -{ - Term tout; - int sno = CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"file_name/2"); - if (sno < 0) - return (FALSE); -#if USE_SOCKET - if (Stream[sno].status & Socket_Stream_f) - tout = MkAtomTerm(AtomSocket); - else -#endif - if (Stream[sno].status & Pipe_Stream_f) - tout = MkAtomTerm(AtomPipe); - else if (Stream[sno].status & InMemory_Stream_f) - tout = MkAtomTerm(AtomCharsio); - else - tout = MkAtomTerm(Stream[sno].u.file.name); - UNLOCK(Stream[sno].streamlock); - return Yap_unify_constant (ARG2, tout); -} - static Int p_cur_line_no (void) { /* '$current_line_number'(+Stream,-N) */ @@ -6659,9 +6201,7 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$get_byte", 2, p_get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$access", 1, p_access, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("exists_directory", 1, p_exists_directory, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$open", 6, p_open, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$file_expansion", 2, p_file_expansion, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$open_null_stream", 1, p_open_null_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$open_pipe_stream", 2, p_open_pipe_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag); CurrentModule = CHARSIO_MODULE; Yap_InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag); @@ -6672,8 +6212,8 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag); - Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag); + Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag); Yap_InitCPred ("$set_input", 1, p_set_input, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_output", 1, p_set_output, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag); @@ -6691,7 +6231,6 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$set_stream_position", 2, p_set_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag), - Yap_InitCPred ("$file_name", 2, p_file_name, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$past_eof", 1, p_past_eof, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$peek", 2, p_peek, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$peek_byte", 2, p_peek_byte, SafePredFlag|SyncPredFlag), diff --git a/H/dhstruct.h b/H/dhstruct.h index 4e8f34a96..336420a40 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -304,4 +304,5 @@ #define SWI_Functors Yap_heap_regs->swi_functors #define SWI_ReverseHash Yap_heap_regs->swi_reverse_hash +#define SWI_BlobTypes Yap_heap_regs->swi_blob_types #define SWI_Blobs Yap_heap_regs->swi_blobs diff --git a/H/hstruct.h b/H/hstruct.h index 21e8c2765..f0ca068a7 100644 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -304,4 +304,5 @@ Functor swi_functors[N_SWI_FUNCTORS]; struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH]; - struct PL_blob_t *swi_blobs; + struct PL_blob_t *swi_blob_types; + struct AtomEntryStruct *swi_blobs; diff --git a/H/ihstruct.h b/H/ihstruct.h index 3589fa71e..ea18a2020 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -304,4 +304,5 @@ + Yap_heap_regs->swi_blob_types = NULL; Yap_heap_regs->swi_blobs = NULL; diff --git a/H/rheap.h b/H/rheap.h index deb009324..36703f510 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -676,6 +676,11 @@ RestoreSWIAtoms(void) RestoreSWIHash(); } +static void +RestoreSWIBlobTypes(void) +{ +} + static void RestoreSWIBlobs(void) { diff --git a/H/rhstruct.h b/H/rhstruct.h index 383728d95..9023c5e33 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -304,4 +304,5 @@ + RestoreSWIBlobTypes(); RestoreSWIBlobs(); diff --git a/H/sshift.h b/H/sshift.h index 9263b366c..8e776cb39 100755 --- a/H/sshift.h +++ b/H/sshift.h @@ -661,6 +661,7 @@ PtoOpAdjust (yamop * ptr) { if (ptr) return (yamop *) (CharP (ptr) + HDiff); + return ptr; } inline EXTERN struct operator_entry *OpListAdjust (struct operator_entry *); diff --git a/library/dialect/swi/fli/blobs.c b/library/dialect/swi/fli/blobs.c index ef35c7a21..eeb98b937 100644 --- a/library/dialect/swi/fli/blobs.c +++ b/library/dialect/swi/fli/blobs.c @@ -50,11 +50,53 @@ PL_is_blob(term_t t, PL_blob_t **type) return TRUE; } +static AtomEntry * +lookupBlob(void *blob, size_t len, PL_blob_t *type) +{ + BlobPropEntry *b; + AtomEntry *ae; + + if (type->flags & PL_BLOB_UNIQUE) { + /* just keep a linked chain for now */ + ae = SWI_Blobs; + while (ae) { + if (RepBlobProp(ae->PropsOfAE)->blob_t == type && + ae->rep.blob->length == len && + !memcmp(ae->rep.blob->data, blob, len)) + return ae; + ae = RepAtom(ae->NextOfAE); + } + } + b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry)); + if (!b) + return NULL; + b->NextOfPE = NIL; + b->KindOfPE = BlobProperty; + b->blob_t = type; + ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len); + if (!ae) + return NULL; + INIT_RWLOCK(ae->ARWLock); + ae->PropsOfAE = AbsBlobProp(b); + ae->NextOfAE = AbsAtom(SWI_Blobs); + ae->rep.blob->length = len; + memcpy(ae->rep.blob->data, blob, len); + SWI_Blobs = ae; + return ae; +} + PL_EXPORT(int) PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type) { - fprintf(stderr,"PL_unify_blob not implemented yet\n"); - return FALSE; + AtomEntry *ae; + + if (!blob) + return FALSE; + ae = lookupBlob(blob, len, type); + if (!ae) { + return FALSE; + } + return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(AbsAtom(ae))); } PL_EXPORT(int) @@ -101,8 +143,8 @@ PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type) PL_EXPORT(void) PL_register_blob_type(PL_blob_t *type) { - type->next = SWI_Blobs; - SWI_Blobs = type; + type->next = SWI_BlobTypes; + SWI_BlobTypes = type; } PL_EXPORT(PL_blob_t*) diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index a5ddebc25..686baf9c6 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -348,4 +348,5 @@ Functor swi_functors[N_SWI_FUNCTORS] SWI_Functors void void struct swi_reverse_hash swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash void void /* SWI blobs */ -struct PL_blob_t *swi_blobs SWI_Blobs =NULL RestoreSWIBlobs() +struct PL_blob_t *swi_blob_types SWI_BlobTypes =NULL RestoreSWIBlobTypes() +struct AtomEntryStruct *swi_blobs SWI_Blobs =NULL RestoreSWIBlobs() diff --git a/pl/boot.yap b/pl/boot.yap index 94a1175e2..12f3bc7b3 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1077,8 +1077,10 @@ break :- set_value('$lf_verbose', OldSilent). bootstrap(F) :- - '$open'(F, '$csult', Stream, 0, 0, F), - '$file_name'(Stream,File), +% '$open'(F, '$csult', Stream, 0, 0, F), +% '$file_name'(Stream,File), + open(F, read, Stream), + stream_property(Stream, file_name(File)), '$start_consult'(consult, File, LC), file_directory_name(File, Dir), getcwd(OldD), @@ -1108,11 +1110,11 @@ bootstrap(F) :- '$loop'(Stream,Status) :- - '$change_alias_to_stream'('$loop_stream',Stream), +%VSC '$change_alias_to_stream'('$loop_stream',Stream), repeat, - ( '$current_stream'(_,_,Stream) -> true - ; '$abort_loop'(Stream) - ), +%VSC ( '$current_stream'(_,_,Stream) -> true +%VSC ; '$abort_loop'(Stream) +%VSC ), prompt('| '), prompt(_,'| '), '$current_module'(OldModule), '$system_catch'('$enter_command'(Stream,Status), OldModule, Error, @@ -1378,7 +1380,16 @@ time_file(File, Time) :- working_directory(OLD, NEW) :- swi_working_directory(OLD, NEW). -cd(Dir) :- working_directory(_, NEW). +cd(Dir) :- working_directory(_, Dir). -getcwd(Dir) :- working_directory(OLD, OLD). +getcwd(Dir) :- working_directory(Dir, Dir). + +open(File, Type, Stream) :- + swi_open(File, Type, Stream). +open(File, Type, Opts, Stream) :- + swi_open(File, Type, Opts, Stream). +open_null_stream(S) :- + swi_open_null_stream(S). +stream_property(Stream, Property) :- + swi_stream_property(Stream, Property). diff --git a/pl/consult.yap b/pl/consult.yap index f176e55e6..0a91786ab 100755 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -159,7 +159,8 @@ load_files(Files,Opts) :- '$do_lf'(Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,CompMode,Reconsult,UseModule). '$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Enc,SkipUnixComments,CompMode,Reconsult,UseModule) :- '$find_in_path'(X, Y, Call), - '$open'(Y, '$csult', Stream, 0, Enc, X), !, + '$valid_encoding'(Encoding, Enc), + open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Enc, X) '$set_changed_lfmode'(Changed), '$start_lf'(X, Mod, Stream, InfLevel, CompilationMode, Imports, Changed,SkipUnixComments,CompMode,Reconsult,UseModule), '$close'(Stream). @@ -430,7 +431,7 @@ initialization(G,OPT) :- '$current_module'(Mod), H0 is heapused, '$cputime'(T0,_), '$default_encoding'(Encoding), - ( '$open'(Y, '$csult', Stream, 0, Encoding, X), !, + ( open(Y, read, Stream, [encoding(Encoding)]), !, % '$open'(Y, '$csult', Stream, 0, Encoding, X), !, print_message(Verbosity, loading(including, Y)), '$loop'(Stream,Status), '$close'(Stream) ; @@ -1030,3 +1031,10 @@ make :- fail. make. +'$file_name'(Stream,F) :- + stream_property(Stream, file_name(F)), !. +'$file_name'(user_input,user_output). +'$file_name'(user_output,user_ouput). +'$file_name'(user_error,user_error). + + diff --git a/pl/yio.yap b/pl/yio.yap index bec79d50f..b517fe060 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -17,18 +17,6 @@ /* stream predicates */ -open(Source,M,T) :- var(Source), !, - '$do_error'(instantiation_error,open(Source,M,T)). -open(Source,M,T) :- var(M), !, - '$do_error'(instantiation_error,open(Source,M,T)). -open(Source,M,T) :- nonvar(T), !, - '$do_error'(uninstantiation_error(T),open(Source,M,T)). -open(File0,Mode,Stream) :- - '$default_encoding'(Encoding), - '$default_expand'(Expansion), - '$expand_filename'(Expansion, File0, File), - '$open'(File, Mode, Stream, 16, Encoding, File0). - close(V) :- var(V), !, '$do_error'(instantiation_error,close(V)). close(File) :- @@ -52,101 +40,6 @@ close(S,Opts) :- /* YAP ignores the force/1 flag */ close(S). -open(F,T,S,Opts) :- - '$check_io_opts'(Opts,open(F,T,S,Opts)), - '$process_open_opts'(Opts, 0, N, Aliases, E, BOM, Expand), - '$expand_filename'(Expand, F, NF), - '$open2'(NF, T, S, N, E, F), - '$process_bom'(S, BOM), - '$process_open_aliases'(Aliases,S). - -'$expand_filename'(false, F, F) :- !. -'$expand_filename'(true, F, NF) :- - operating_system_support:true_file_name(F, NF). - -'$open2'(Source,M,T,N,_,_) :- var(Source), !, - '$do_error'(instantiation_error,open(Source,M,T,N)). -'$open2'(Source,M,T,N,_,_) :- var(M), !, - '$do_error'(instantiation_error,open(Source,M,T,N)). -'$open2'(Source,M,T,N,_,_) :- nonvar(T), !, - '$do_error'(uninstantiation_error(T),open(Source,M,T,N)). -'$open2'(File, Mode, Stream, N, Encoding, F0) :- - '$open'(File, Mode, Stream, N, Encoding, F0). - -'$process_bom'(S, BOM) :- - var(BOM), !, ( '$has_bom'(S) -> BOM = true ; BOM = false ). -'$process_bom'(_, _). - - -'$process_open_aliases'([],_). -'$process_open_aliases'([Alias|Aliases],S) :- - '$add_alias_to_stream'(Alias, S), - '$process_open_aliases'(Aliases,S). - -'$process_open_opts'([], N, N, [], DefaultEncoding, [], DefaultExpand) :- - '$default_encoding'(DefaultEncoding), - '$default_expand'(DefaultExpand). -'$process_open_opts'([type(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- - '$value_open_opt'(T,type,I1,I2), - N1 is I1\/N0, - N2 is I2/\N1, - '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). -'$process_open_opts'([expand_filename(T)|L], N0, N, Aliases, Encoding, BOM, Expand) :- - '$valid_expand'(T, Expand), - '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, _). -'$process_open_opts'([reposition(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- - '$value_open_opt'(T,reposition,I1,I2), - N1 is I1\/N0, - N2 is I2/\N1, - '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). -'$process_open_opts'([encoding(Enc)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- - '$valid_encoding'(Enc, EncCode), - '$process_open_opts'(L, N0, N, Aliases, _, BOM, DefaultExpand). -'$process_open_opts'([representation_errors(Mode)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- - '$valid_reperrorhandler'(Mode, Flag), - NI is N0 \/ Flag, - '$process_open_opts'(L, NI, N, Aliases, EncCode, BOM, DefaultExpand). -'$process_open_opts'([bom(BOM)|L], N0, N, Aliases, EncCode, BOM, DefaultExpand) :- - ( - var(BOM) - -> - true - ; - '$valid_bom'(BOM, Flag), - NI is N0 \/ Flag - ), - '$process_open_opts'(L, NI, N, Aliases, EncCode, _, DefaultExpand). -'$process_open_opts'([eof_action(T)|L], N0, N, Aliases, Encoding, BOM, DefaultExpand) :- - '$value_open_opt'(T,eof_action,I1,I2), - N1 is I1\/N0, - N2 is I2/\N1, - '$process_open_opts'(L,N2,N, Aliases, Encoding, BOM, DefaultExpand). -'$process_open_opts'([alias(Alias)|L], N0, N, [Alias|Aliases], Encoding, BOM, DefaultExpand) :- - '$process_open_opts'(L,N0,N, Aliases, Encoding, BOM, DefaultExpand). - - -'$value_open_opt'(text,_,1,X) :- X is 0xffff-2. % default -'$value_open_opt'(binary,_,2, X) :- X is 0xffff-1. -'$value_open_opt'(true,_,4, X) :- X is 0xffff-8. -'$value_open_opt'(false,_,8, X) :- X is 0xffff-4. -'$value_open_opt'(error,_,16, X) :- X is 0xffff-0x0060. -'$value_open_opt'(eof_code,_,32, X) :- X is 0xffff-0x0050. -'$value_open_opt'(reset, _, 64, X) :- X is 0xffff-0x0030. -%128 -> use bom -%256 -> do not use bom -%512 -> do prolog on unrepresentable char -%1024 -> do XML on unrepresentable char - -'$valid_bom'(true, 128). -'$valid_bom'(false, 256). - -'$valid_reperrorhandler'(error, 0). % default. -'$valid_reperrorhandler'(prolog, 512). -'$valid_reperrorhandler'(xml, 1024). - -'$valid_expand'(true, true). -'$valid_expand'(false, false). - /* check whether a list of options is valid */ '$check_io_opts'(V,G) :- var(V), !, '$do_error'(instantiation_error,G). @@ -164,8 +57,6 @@ open(F,T,S,Opts) :- '$check_force_opt_arg'(X,G) ; '$do_error'(domain_error(close_option,Opt),G) ). -'$check_opt'(open(_,_,_,_),Opt,G) :- - '$check_opt_open'(Opt, G). '$check_opt'(read_term(_,_),Opt,G) :- '$check_opt_read'(Opt, G). '$check_opt'(stream_property(_,_),Opt,G) :- @@ -175,24 +66,6 @@ open(F,T,S,Opts) :- '$check_opt'(yap_flag(_,_),Opt,G) :- '$check_opt_write'(Opt, G). - -'$check_opt_open'(type(T), G) :- !, - '$check_open_type_arg'(T, G). -'$check_opt_open'(reposition(T), G) :- !, - '$check_open_reposition_arg'(T, G). -'$check_opt_open'(alias(T), G) :- !, - '$check_open_alias_arg'(T, G). -'$check_opt_open'(eof_action(T), G) :- !, - '$check_open_eof_action_arg'(T, G). -'$check_opt_open'(encoding(T), G) :- !, - '$check_open_encoding'(T, G). -'$check_opt_open'(representation_errors(M), G) :- !, - '$check_open_representation_errors'(M, G). -'$check_opt_open'(bom(T), G) :- !, - '$check_open_bom_arg'(T, G). -'$check_opt_open'(A, G) :- - '$do_error'(domain_error(stream_option,A),G). - '$check_opt_read'(variables(_), _) :- !. '$check_opt_read'(variable_names(_), _) :- !. '$check_opt_read'(singletons(_), _) :- !. @@ -252,60 +125,6 @@ open(F,T,S,Opts) :- '$check_force_opt_arg'(X,G) :- '$do_error'(domain_error(close_option,force(X)),G). -'$check_open_type_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_type_arg'(text,_) :- !. -'$check_open_type_arg'(binary,_) :- !. -'$check_open_opt_arg'(X,G) :- - '$do_error'(domain_error(io_mode,type(X)),G). - -'$check_open_reposition_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_reposition_arg'(true,_) :- !. -'$check_open_reposition_arg'(false,_) :- !. -'$check_open_reposition_arg'(X,G) :- - '$do_error'(domain_error(io_mode,reposition(X)),G). - -'$check_open_bom_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_bom_arg'(true,_) :- !. -'$check_open_bom_arg'(false,_) :- !. -'$check_open_bom_arg'(X,G) :- - '$do_error'(domain_error(io_mode,bom(X)),G). - -'$check_open_alias_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_alias_arg'(X,G) :- atom(X), !, - ( '$check_if_valid_new_alias'(X), X \= user -> - true ; - '$do_error'(permission_error(open, source_sink, alias(X)),G) - ). -'$check_open_alias_arg'(X,G) :- - '$do_error'(domain_error(io_mode,alias(X)),G). - - -'$check_open_eof_action_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_eof_action_arg'(error,_) :- !. -'$check_open_eof_action_arg'(eof_code,_) :- !. -'$check_open_eof_action_arg'(reset,_) :- !. -'$check_open_eof_action_arg'(X,G) :- - '$do_error'(domain_error(io_mode,eof_action(X)),G). - -'$check_open_encoding'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_encoding'(Encoding,_) :- - '$valid_encoding'(Encoding,_), !. -'$check_open_encoding'(Encoding,G) :- - '$do_error'(domain_error(io_mode,encoding(Encoding)),G). - -'$check_open_representation_errors'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_open_representation_errors'(RepErrorHandler,_) :- - '$valid_reperrorhandler'(RepErrorHandler,_), !. -'$check_open_representation_errors'(Handler,G) :- - '$do_error'(domain_error(io_mode,representation_errors(Handler)),G). - '$check_read_syntax_errors_arg'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). '$check_read_syntax_errors_arg'(dec10,_) :- !. @@ -883,94 +702,6 @@ set_stream_position(A,N) :- set_stream_position(S,N) :- '$set_stream_position'(S,N). -stream_property(Stream, Prop) :- var(Prop), !, - (var(Stream) -> '$current_stream'(_,_,Stream) ; true), - '$generate_prop'(Prop), - '$stream_property'(Stream, Prop). -stream_property(Stream, Props) :- var(Stream), !, - '$current_stream'(_,_,Stream), - '$stream_property'(Stream, Props). -stream_property(Stream, Props) :- - '$current_stream'(_,_,Stream), !, - '$stream_property'(Stream, Props). -stream_property(Stream, Props) :- - '$do_error'(domain_error(stream,Stream),stream_property(Stream, Props)). - -'$generate_prop'(file_name(_F)). -'$generate_prop'(mode(_M)). -'$generate_prop'(input). -'$generate_prop'(output). -'$generate_prop'(position(_P)). -%'$generate_prop'(end_of_stream(_E)). -'$generate_prop'(eof_action(_E)). -%'$generate_prop'(reposition(_R)). -'$generate_prop'(type(_T)). -'$generate_prop'(alias(_A)). -'$generate_prop'(bom(_B)). -'$generate_prop'(encoding(_E)). -'$generate_prop'(representation_errors(_E)). - -'$stream_property'(Stream, Props) :- - var(Props), !, - '$do_error'(instantiation_error, stream_properties(Stream, Props)). -'$stream_property'(Stream, Props0) :- - '$check_stream_props'(Props0, Props), - '$check_io_opts'(Props, stream_property(Stream, Props)), - '$current_stream'(F,Mode,Stream), - '$process_stream_properties'(Props, Stream, F, Mode). - -'$check_stream_props'([], []) :- !. -'$check_stream_props'([H|T], [H|T]) :- !. -'$check_stream_props'(Prop, [Prop]). - - -% - -'$process_stream_properties'([], _, _, _). -'$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :- - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :- - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([input|Props], Stream, F, read) :- - '$process_stream_properties'(Props, Stream, F, read). -'$process_stream_properties'([output|Props], Stream, F, append) :- - '$process_stream_properties'(Props, Stream, F, append). -'$process_stream_properties'([output|Props], Stream, F, write) :- - '$process_stream_properties'(Props, Stream, F, write). -'$process_stream_properties'([position(P)|Props], Stream, F, Mode) :- - '$show_stream_position'(Stream,P), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([encoding(Enc)|Props], Stream, F, Mode) :- - % make sure this runs first, with EncCode unbound. - '$encoding'(Stream, EncCode), - '$valid_encoding'(Enc, EncCode), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([bom(B)|Props], Stream, F, Mode) :- - '$show_stream_bom'(Stream, B), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([end_of_stream(P)|Props], Stream, F, Mode) :- - '$show_stream_eof'(Stream, P), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([eof_action(P)|Props], Stream, F, Mode) :- - '$show_stream_flags'(Stream, Fl), - '$show_stream_eof_action'(Fl, P), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([reposition(P)|Props], Stream, F, Mode) :- - '$show_stream_flags'(Stream, Fl), - '$show_stream_reposition'(Fl, P), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([representation_errors(B)|Props], Stream, F, Mode) :- - '$stream_representation_error'(Stream, ErrorHandler), - '$valid_reperrorhandler'(B, ErrorHandler), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([type(P)|Props], Stream, F, Mode) :- - '$show_stream_flags'(Stream, Fl), - '$show_stream_type'(Fl, P), - '$process_stream_properties'(Props, Stream, F, Mode). -'$process_stream_properties'([alias(Alias)|Props], Stream, F, Mode) :- - '$fetch_stream_alias'(Stream, Alias), - '$process_stream_properties'(Props, Stream, F, Mode). - '$show_stream_eof'(Stream, past) :- '$past_eof'(Stream), !. '$show_stream_eof'(Stream, at) :-