From 76ee19ab590c5ce93c7648bc924519c7fbea3199 Mon Sep 17 00:00:00 2001 From: Paulo Moura Date: Thu, 9 Dec 2010 18:21:26 +0000 Subject: [PATCH 1/7] Corrected the meta_predicate/1 directive for the built-in tabling predicate tabling_mode/2. --- pl/tabling.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pl/tabling.yap b/pl/tabling.yap index 20f694b2c..53b15ed78 100644 --- a/pl/tabling.yap +++ b/pl/tabling.yap @@ -14,7 +14,7 @@ :- meta_predicate table(:), is_tabled(:), - tabling_mode(:), + tabling_mode(:,?), abolish_table(:), show_table(:), table_statistics(:), From 378035a4b0e0e67cef3fd7726fa5c54ad35e11b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 12 Dec 2010 16:45:39 +0000 Subject: [PATCH 2/7] fix bad marking of dbterms (obs from Ines Dutra). --- C/agc.c | 18 +++++++++++++++++- C/cdmgr.c | 8 +++++--- H/rheap.h | 8 +++++--- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/C/agc.c b/C/agc.c index 24e31e88b..fe13d64bb 100755 --- a/C/agc.c +++ b/C/agc.c @@ -74,6 +74,7 @@ CleanAtomMarkedBit(Atom a) return (Atom)c; } + static inline Functor FuncAdjust(Functor f) { @@ -111,6 +112,22 @@ AtomAdjust(Atom a) return(a); } +static Term AdjustDBTerm(Term, Term *); + +static Term +CodeComposedTermAdjust(Term t) +{ + Term *base; + + if (IsApplTerm(t)) { + base = RepAppl(t); + } else { + base = RepPair(t); + } + return AdjustDBTerm(t, base); +} + + #define IsOldCode(P) FALSE #define IsOldCodeCellPtr(P) FALSE #define IsOldDelay(P) FALSE @@ -145,7 +162,6 @@ AtomAdjust(Atom a) #define AtomEntryAdjust(P) (P) #define GlobalEntryAdjust(P) (P) #define BlobTermAdjust(P) (P) -#define CodeComposedTermAdjust(P) (P) #define CellPtoHeapAdjust(P) (P) #define PtoAtomHashEntryAdjust(P) (P) #define CellPtoHeapCellAdjust(P) (P) diff --git a/C/cdmgr.c b/C/cdmgr.c index 17128c49d..b8c7cd038 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -792,11 +792,13 @@ ConstantTermAdjust (Term t) return AtomTermAdjust(t); else if (IsIntTerm(t)) return t; - else if (IsApplTerm(t)) + else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) { return BlobTermAdjust(t); - else if (IsPairTerm(t)) + } else if (IsApplTerm(t) || IsPairTerm(t)) { return CodeComposedTermAdjust(t); - else return t; + } else { + return t; + } } diff --git a/H/rheap.h b/H/rheap.h index 06176cd68..33b96b1ea 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -246,11 +246,13 @@ ConstantTermAdjust (Term t) return AtomTermAdjust(t); else if (IsIntTerm(t)) return t; - else if (IsApplTerm(t)) + else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) { return BlobTermAdjust(t); - else if (IsPairTerm(t)) + } else if (IsApplTerm(t) || IsPairTerm(t)) { return CodeComposedTermAdjust(t); - else return t; + } else { + return t; + } } /* Now, everything on its place so you must adjust the pointers */ From 2e319c50baa0e81cc244da721530c3b93541aaae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 12 Dec 2010 18:28:55 +0000 Subject: [PATCH 3/7] make sure that atom garbage collector knows about foreign function names. --- C/load_aix.c | 2 +- C/load_aout.c | 4 ++-- C/load_coff.c | 4 ++-- C/load_dl.c | 6 +++--- C/load_dld.c | 2 +- C/load_dll.c | 9 +++++---- C/load_dyld.c | 11 ++++++----- C/load_foreign.c | 4 ++-- C/load_shl.c | 11 ++++++----- H/Foreign.h | 2 +- H/rheap.h | 6 ++---- 11 files changed, 31 insertions(+), 30 deletions(-) diff --git a/C/load_aix.c b/C/load_aix.c index a8051bb72..654d30b90 100644 --- a/C/load_aix.c +++ b/C/load_aix.c @@ -68,7 +68,7 @@ LoadForeign(StringList ofiles, StringList libs, strcpy(Yap_ErrorSay," Load Failed: in AIX you must load a single object file"); return LOAD_FAILLED; } - if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { strcpy(Yap_ErrorSay, " Trying to open unexisting file in LoadForeign "); return LOAD_FAILLED; } diff --git a/C/load_aout.c b/C/load_aout.c index c6ad6b8cb..0c2e2c1b6 100644 --- a/C/load_aout.c +++ b/C/load_aout.c @@ -154,7 +154,7 @@ LoadForeign(StringList ofiles, while(tmp != NULL) { strcat(o_files," "); - strcat(o_files,tmp->s); + strcat(o_files,AtomName(tmp->name)); tmp = tmp->next; } } @@ -165,7 +165,7 @@ LoadForeign(StringList ofiles, while(tmp != NULL) { strcat(l_files," "); - strcat(l_files,tmp->s); + strcat(l_files,AtomName(tmp->name)); tmp = tmp->next; } } diff --git a/C/load_coff.c b/C/load_coff.c index f64ed7669..bb090f131 100644 --- a/C/load_coff.c +++ b/C/load_coff.c @@ -155,7 +155,7 @@ LoadForeign(StringList ofiles, while(tmp != NULL) { strcat(o_files," "); - strcat(o_files,tmp->s); + strcat(o_files,AtomName(tmp->name)); tmp = tmp->next; } } @@ -166,7 +166,7 @@ LoadForeign(StringList ofiles, while(tmp != NULL) { strcat(l_files," "); - strcat(l_files,tmp->s); + strcat(l_files,AtomName(tmp->name)); tmp = tmp->next; } } diff --git a/C/load_dl.c b/C/load_dl.c index 10b2b0e50..cc419101c 100755 --- a/C/load_dl.c +++ b/C/load_dl.c @@ -92,9 +92,9 @@ LoadForeign(StringList ofiles, StringList libs, while (libs) { - if (!Yap_TrueFileName(libs->s, Yap_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName(AtomName(libs->name), Yap_FileNameBuf, TRUE)) { /* use LD_LIBRARY_PATH */ - strncpy(Yap_FileNameBuf, libs->s, YAP_FILENAME_MAX); + strncpy(Yap_FileNameBuf, AtomName(libs->name), YAP_FILENAME_MAX); } #ifdef __osf__ @@ -116,7 +116,7 @@ LoadForeign(StringList ofiles, StringList libs, other routines */ /* dlopen wants to follow the LD_CONFIG_PATH */ - if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); return LOAD_FAILLED; } diff --git a/C/load_dld.c b/C/load_dld.c index 288cfd882..94f279539 100644 --- a/C/load_dld.c +++ b/C/load_dld.c @@ -80,7 +80,7 @@ LoadForeign(StringList ofiles, StringList libs, } while (ofiles) { - if((error=dld_link(ofiles->s)) !=0) { + if((error=dld_link(AtomName(ofiles->name))) !=0) { strcpy(Yap_ErrorSay,dld_strerror(error)); return LOAD_FAILLED; } diff --git a/C/load_dll.c b/C/load_dll.c index 676386f71..972ec0ec5 100755 --- a/C/load_dll.c +++ b/C/load_dll.c @@ -66,7 +66,7 @@ LoadForeign(StringList ofiles, StringList libs, while (ofiles) { HINSTANCE handle; - if (Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE) && + if (Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE) && (handle=LoadLibrary(Yap_FileNameBuf)) != 0) { Yap_ErrorSay[0]=~'\0'; @@ -84,12 +84,13 @@ LoadForeign(StringList ofiles, StringList libs, other routines */ while (libs) { HINSTANCE handle; + char * s = AtomName(libs->name); - if (libs->s[0] == '-') { - strcat(Yap_FileNameBuf,libs->s+2); + if (s[0] == '-') { + strcat(Yap_FileNameBuf,s+2); strcat(Yap_FileNameBuf,".dll"); } else { - strcpy(Yap_FileNameBuf,libs->s); + strcpy(Yap_FileNameBuf,s); } if((handle=LoadLibrary(Yap_FileNameBuf)) == 0) diff --git a/C/load_dyld.c b/C/load_dyld.c index 088089524..8e7b47b25 100644 --- a/C/load_dyld.c +++ b/C/load_dyld.c @@ -145,7 +145,7 @@ LoadForeign(StringList ofiles, StringList libs, void *handle; /* mydlopen wants to follow the LD_CONFIG_PATH */ - if (!Yap_TrueFileName(ofiles->s, Yap_FileNameBuf, TRUE)) { + if (!Yap_TrueFileName(AtomName(ofiles->name), Yap_FileNameBuf, TRUE)) { strcpy(Yap_ErrorSay, "%% Trying to open unexisting file in LoadForeign"); return LOAD_FAILLED; } @@ -163,13 +163,14 @@ LoadForeign(StringList ofiles, StringList libs, /* load libraries first so that their symbols are available to other routines */ while (libs) { - - if (libs->s[0] == '-') { + char *s = AtomName(lib->name); + + if (ls[0] == '-') { strcpy(Yap_FileNameBuf,"lib"); - strcat(Yap_FileNameBuf,libs->s+2); + strcat(Yap_FileNameBuf,s+2); strcat(Yap_FileNameBuf,".so"); } else { - strcpy(Yap_FileNameBuf,libs->s); + strcpy(Yap_FileNameBuf,s); } if((libs->handle=mydlopen(Yap_FileNameBuf)) == NULL) diff --git a/C/load_foreign.c b/C/load_foreign.c index 1ab27d057..eae3a8f31 100755 --- a/C/load_foreign.c +++ b/C/load_foreign.c @@ -57,7 +57,7 @@ p_load_foreign(void) t = TailOfTerm(t); new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem)); new->next = ofiles; - new->s = RepAtom(AtomOfTerm(t1))->StrOfAE; + new->name = AtomOfTerm(t1); ofiles = new; } @@ -69,7 +69,7 @@ p_load_foreign(void) t = TailOfTerm(t); new = (StringList) Yap_AllocCodeSpace(sizeof(StringListItem)); new->next = libs; - new->s = RepAtom(AtomOfTerm(t1))->StrOfAE; + new->name = AtomOfTerm(t1); libs = new; } diff --git a/C/load_shl.c b/C/load_shl.c index 43b6721b1..0ff8799d4 100644 --- a/C/load_shl.c +++ b/C/load_shl.c @@ -61,7 +61,7 @@ LoadForeign( StringList ofiles, StringList libs, int valid_fname; /* shl_load wants to follow the LD_CONFIG_PATH */ - valid_fname = Yap_TrueFileName( ofiles->s, Yap_FileNameBuf, TRUE ); + valid_fname = Yap_TrueFileName( AtomName(ofiles->name), Yap_FileNameBuf, TRUE ); if( !valid_fname ) { strcpy( Yap_ErrorSay, "%% Trying to open non-existing file in LoadForeign" ); @@ -89,14 +89,15 @@ LoadForeign( StringList ofiles, StringList libs, } while( libs ) { - - if( libs->s[0] == '-' ) { + char *s = AtomName(lib->s); + + if( s[0] == '-' ) { strcpy( Yap_FileNameBuf, "lib" ); - strcat( Yap_FileNameBuf, libs->s+2 ); + strcat( Yap_FileNameBuf, s+2 ); strcat( Yap_FileNameBuf, ".sl" ); } else { - strcpy( Yap_FileNameBuf, libs->s ); + strcpy( Yap_FileNameBuf, s ); } *(shl_t *)libs->handle = shl_load( Yap_FileNameBuf, BIND_DEFERRED, 0 ); diff --git a/H/Foreign.h b/H/Foreign.h index df29c989e..c4a649cb4 100644 --- a/H/Foreign.h +++ b/H/Foreign.h @@ -84,7 +84,7 @@ #define LOAD_FAILLED -1 typedef struct StringListItem { - char *s; + Atom name; void *handle; struct StringListItem *next; } StringListItem, *StringList; diff --git a/H/rheap.h b/H/rheap.h index 33b96b1ea..e38d189e7 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -960,8 +960,7 @@ RestoreForeignCode(void) while (objs != NULL) { if (objs->next != NULL) objs->next = (StringList)AddrAdjust((ADDR)objs->next); - if (objs->s != NULL) - objs->s = (char *)AddrAdjust((ADDR)objs->s); + objs->name = AtomAdjust(objs->name); objs = objs->next; } if (f_code->libs != NULL) @@ -970,8 +969,7 @@ RestoreForeignCode(void) while (libs != NULL) { if (libs->next != NULL) libs->next = (StringList)AddrAdjust((ADDR)libs->next); - if (libs->s != NULL) - libs->s = (char *)AddrAdjust((ADDR)libs->s); + libs->name = AtomAdjust(libs->name); libs = libs->next; } if (f_code->f != NULL) From 2d1ece71c8d11fe6a64fa0d7f6946d1069be3d23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 12 Dec 2010 19:05:49 +0000 Subject: [PATCH 4/7] iget rid of message. --- C/tracer.c | 1 - 1 file changed, 1 deletion(-) diff --git a/C/tracer.c b/C/tracer.c index e98c81b8e..4f1a68986 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -391,7 +391,6 @@ static Int p_stop_low_level_trace(void) { Yap_do_low_level_trace = FALSE; do_trace_primitives = TRUE; - fprintf(stderr,"vsc_count = %I64d\n",vsc_count); return(TRUE); } From 51e9cb14a7acd375a0bc8fcf8140c6518f6e0285 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 12 Dec 2010 19:07:24 +0000 Subject: [PATCH 5/7] nl should be in the SWI IO (obs from Roberto Bagnara). --- library/dialect/swi.yap | 2 ++ packages/PLStream/pl-file.c | 30 +++++++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 69474c30f..65a9e3417 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -225,6 +225,8 @@ goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io. goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io. goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io. goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io. +goal_expansion(nl(A),system:swi_nl(A)) :- swi_io. +goal_expansion(nl,system:swi_nl) :- swi_io. % make sure we also use diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index 6ab14d059..ae4aa4cfe 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -4215,6 +4215,7 @@ PRED_IMPL("copy_stream_data", 2, copy_stream_data2, 0) } + /******************************* * PUBLISH PREDICATES * *******************************/ @@ -4312,8 +4313,34 @@ static pl_Sgetc(IOSTREAM *s) return Sgetc(s); } +/* copied by VSC */ + +static word +pl_nl1(term_t stream) +{ IOSTREAM *s; + + if ( getOutputStream(stream, &s) ) + { Sputcode('\n', s); + return streamStatus(s); + } + + fail; +} + +static word +pl_nl() +{ return pl_nl1(0); +} + +static const PL_extension foreigns[] = { + FRG("swi_nl", 0, pl_nl, ISO), + FRG("swi_nl", 1, pl_nl1, ISO), + /* DO NOT ADD ENTRIES BELOW THIS ONE */ + FRG((char *)NULL, 0, NULL, 0) +}; + static void -init_yap_extras() +init_yap_extras(void) { swi_io_struct swiio; @@ -4329,6 +4356,7 @@ init_yap_extras() initFiles(); initGlob(); PL_register_extensions(PL_predicates_from_file); + PL_register_extensions(foreigns); fileerrors = TRUE; SinitStreams(); } From 7c2c3febe524a23512d81f0beea2f503fc97b770 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 12 Dec 2010 19:19:49 +0000 Subject: [PATCH 6/7] checker should be called after preprocessing (obs from Roberto Bagnara). --- pl/boot.yap | 11 ++++++++--- pl/checker.yap | 14 ++++++++------ 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/pl/boot.yap b/pl/boot.yap index 3b240c7cf..bbe4e19a3 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -461,9 +461,14 @@ true :- true. '$$compile'(G1, G0, N, HeadMod). '$prepare_term'(G, V, Pos, G0, G1, BodyMod, SourceMod, Source) :- - ( get_value('$syntaxcheckflag',on) -> - '$check_term'(Source, V, Pos, BodyMod) ; true ), - '$precompile_term'(G, G0, G1, BodyMod, SourceMod). + '$precompile_term'(G, G0, G1, BodyMod, SourceMod), + ( + get_value('$syntaxcheckflag',on) + -> + '$check_term'(G0, V, Pos, Source, BodyMod) + ; + true + ). % process an input clause '$$compile'(G, G0, L, Mod) :- diff --git a/pl/checker.yap b/pl/checker.yap index 05a3ee24e..3405c2b17 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -120,20 +120,22 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$values'('$syntaxcheckmultiple',O,N). -'$check_term'(T,_,P,M) :- +'$check_term'(T,_,P,_Source,M) :- get_value('$syntaxcheckdiscontiguous',on), '$xtract_head'(T,M,NM,_,F,A), '$handle_discontiguous'(F,A,NM), fail. -'$check_term'(T,_,P,M) :- +'$check_term'(T,_,P,_Source,M) :- get_value('$syntaxcheckmultiple',on), '$xtract_head'(T,M,NM,_,F,A), '$handle_multiple'(F,A,NM), fail. -'$check_term'(T,VL,P,_) :- +'$check_term'(T,VL,P,_Source,_) :- get_value('$syntaxchecksinglevar',on), ( '$chk_binding_vars'(T), - '$sv_list'(VL,Sv) -> - '$sv_warning'(Sv,T) ), fail. -'$check_term'(_,_,_,_). + '$sv_list'(VL,Sv) + -> + '$sv_warning'(Sv,T) + ), fail. +'$check_term'(_,_,_,_,_). '$chk_binding_vars'(V) :- var(V), !, V = '$V'(_). '$chk_binding_vars'('$V'(off)) :- !. From 3c4da56af2fe818cdb7bf7f82bc360790a977162 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 13 Dec 2010 12:38:37 +0000 Subject: [PATCH 7/7] allow write to find out about SWI streams in SWI mode. --- C/iopreds.c | 22 +++++- H/YapHeap.h | 1 + H/Yapproto.h | 1 + H/dglobals.h | 1 + H/hglobals.h | 1 + H/iglobals.h | 1 + H/rglobals.h | 1 + H/yapio.h | 13 ++-- include/SWI-Prolog.h | 1 + library/dialect/swi.yap | 12 +++ library/dialect/swi/fli/swi.c | 10 +++ misc/GLOBALS | 1 + packages/PLStream/pl-file.c | 18 +++-- pl/yio.yap | 139 ++++++++++++++-------------------- 14 files changed, 126 insertions(+), 96 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index 61e884450..923bfb4a0 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -3487,9 +3487,17 @@ CheckStream (Term arg, int kind, char *msg) sname = AtomUserOut; } } + if (kind & SWI_Stream_f) { + struct io_stream *swi_stream; + + if (Yap_get_stream_handle(arg, &swi_stream)) { + sno = LookupSWIStream(swi_stream); + return sno; + } + } if ((sno = CheckAlias(sname)) == -1) { Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); - return(-1); + return -1; } } else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) { arg = ArgOfTerm (1, arg); @@ -4087,7 +4095,15 @@ static Int p_write2_prio (void) { /* '$write'(+Stream,+Flags,?Term) */ int old_output_stream = Yap_c_output_stream; - Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2"); + Int flags = IntegerOfTerm(Deref(ARG2)); + int stream_f; + + if (flags & Use_SWI_Stream_f) { + stream_f = Output_Stream_f|SWI_Stream_f; + } else { + stream_f = Output_Stream_f; + } + Yap_c_output_stream = CheckStream (ARG1, stream_f, "write/2"); if (Yap_c_output_stream == -1) { Yap_c_output_stream = old_output_stream; return(FALSE); @@ -4096,7 +4112,7 @@ p_write2_prio (void) /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ Yap_StartSlots(); - Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) IntOfTerm (Deref (ARG2)), (int) IntOfTerm (Deref (ARG3))); + Yap_plwrite (ARG4, Stream[Yap_c_output_stream].stream_wputc, (int) flags, (int) IntOfTerm (Deref (ARG3))); Yap_CloseSlots(); Yap_c_output_stream = old_output_stream; if (EX != 0L) { diff --git a/H/YapHeap.h b/H/YapHeap.h index ec52098d2..fe815007a 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -28,6 +28,7 @@ typedef int (*SWI_PutWideFunction)(int, void *); typedef int (*SWI_GetWideFunction)(void *); typedef int (*SWI_CloseFunction)(void *); typedef int (*SWI_FlushFunction)(void *); +typedef int (*SWI_PLGetStreamFunction)(void *); #include "../include/dswiatoms.h" diff --git a/H/Yapproto.h b/H/Yapproto.h index f5e0812c0..055075eca 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -461,6 +461,7 @@ void STD_PROTO(Yap_InitMYDDAS_TopLevelPreds,(void)); /* yap2swi.c */ void STD_PROTO(Yap_swi_install,(void)); void STD_PROTO(Yap_InitSWIHash,(void)); +int STD_PROTO(Yap_get_stream_handle,(Term, void *)); /* ypsocks.c */ void STD_PROTO(Yap_InitSockets,(void)); diff --git a/H/dglobals.h b/H/dglobals.h index b65cf8a51..36d72d2b4 100644 --- a/H/dglobals.h +++ b/H/dglobals.h @@ -187,6 +187,7 @@ #define SWIWidePutc Yap_global->swi_wputc #define SWIClose Yap_global->swi_close #define SWIFlush Yap_global->swi_flush +#define SWIGetStream Yap_global->swi_get_stream_f #define Yap_AllowLocalExpansion Yap_global->allow_local_expansion #define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion diff --git a/H/hglobals.h b/H/hglobals.h index c14707c6f..1e60fbbf0 100644 --- a/H/hglobals.h +++ b/H/hglobals.h @@ -189,6 +189,7 @@ typedef struct worker_shared { SWI_PutWideFunction swi_wputc; SWI_CloseFunction swi_close; SWI_FlushFunction swi_flush; + SWI_PLGetStreamFunction swi_get_stream_f; int allow_local_expansion; int allow_global_expansion; diff --git a/H/iglobals.h b/H/iglobals.h index 24e0db95d..978c91658 100644 --- a/H/iglobals.h +++ b/H/iglobals.h @@ -187,6 +187,7 @@ static void InitGlobal(void) { Yap_global->swi_wputc = NULL; Yap_global->swi_close = NULL; Yap_global->swi_flush = NULL; + Yap_global->swi_get_stream_f = NULL; Yap_global->allow_local_expansion = TRUE; Yap_global->allow_global_expansion = TRUE; diff --git a/H/rglobals.h b/H/rglobals.h index 304992160..81d3bb0e2 100644 --- a/H/rglobals.h +++ b/H/rglobals.h @@ -198,6 +198,7 @@ static void RestoreGlobal(void) { + #if HAVE_LIBREADLINE diff --git a/H/yapio.h b/H/yapio.h index 6cb463f09..6483a0b34 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -334,12 +334,13 @@ Atom STD_PROTO(Yap_LookupWideAtom,(wchar_t *)); #define YAP_SEEKABLE_STREAM 0x80 -#define Quote_illegal_f 1 -#define Ignore_ops_f 2 -#define Handle_vars_f 4 -#define Use_portray_f 8 -#define To_heap_f 16 -#define Unfold_cyclics_f 32 +#define Quote_illegal_f 0x01 +#define Ignore_ops_f 0x02 +#define Handle_vars_f 0x04 +#define Use_portray_f 0x08 +#define To_heap_f 0x10 +#define Unfold_cyclics_f 0x20 +#define Use_SWI_Stream_f 0x40 /* write.c */ void STD_PROTO(Yap_plwrite,(Term,int (*)(int, wchar_t), int, int)); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 6c2863b30..a3b301169 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -698,6 +698,7 @@ typedef struct SWI_IO { void *put_w; void *flush_s; void *close_s; + void *get_stream_handle; } swi_io_struct; /* SWI stream info */ diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 65a9e3417..a31997aa7 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -227,6 +227,18 @@ goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io. goal_expansion(nl(A),system:swi_nl(A)) :- swi_io. goal_expansion(nl,system:swi_nl) :- swi_io. +goal_expansion(write(A),write_term(user_output,A,[swi(true)])) :- swi_io. +goal_expansion(write(S,A),write_term(S,A,[swi(true)])) :- swi_io. +goal_expansion(writeq(A),write_term(user_output,A,[swi(true),quoted(true)])) :- swi_io. +goal_expansion(writeq(S,A),write_term(S,A,[swi(true),quoted(true)])) :- swi_io. +goal_expansion(display(A),write_term(user_output,A,[swi(true),ignore_ops(true)])) :- swi_io. +goal_expansion(display(S,A),write_term(S,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io. +goal_expansion(write_canonical(A),write_term(user_output,A,[swi(true),ignore_ops(true),quoted(true)])) :- swi_io. +goal_expansion(write_canonical(S,A),write_term(S,A,[swi(true),ignore_ops(true)])) :- swi_io. +goal_expansion(print(A),write_term(user_output,A,[swi(true),portray(true),numbervars(true)])) :- swi_io. +goal_expansion(print(S,A),write_term(S,A,[swi(true),portray(true),numbervars(true)])) :- swi_io. +goal_expansion(write_term(A,Opts),write_term(user_output,A,Opts,[swi(true)|Opts])) :- swi_io. +goal_expansion(write_term(S,A,Opts),write_term(S,A,[swi(true)|Opts])) :- swi_io, \+ member(swi(_), Opts). % make sure we also use diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 337c797ff..fd4a45264 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -3103,6 +3103,16 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio) SWIWidePutc = swio->put_w; SWIFlush = swio->flush_s; SWIClose = swio->close_s; + SWIGetStream = swio->get_stream_handle; +} + +typedef int (*GetStreamF)(term_t, IOSTREAM **s); + +int +Yap_get_stream_handle(Term t0, void *s){ + term_t t = (term_t)YAP_InitSlot(t0); + GetStreamF f = (GetStreamF)SWIGetStream; + return (*f)(t,s); } diff --git a/misc/GLOBALS b/misc/GLOBALS index c1df5ec57..4313b1f87 100644 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -210,6 +210,7 @@ SWI_GetWideFunction swi_wgetc SWIWideGetc =NULL SWI_PutWideFunction swi_wputc SWIWidePutc =NULL SWI_CloseFunction swi_close SWIClose =NULL SWI_FlushFunction swi_flush SWIFlush =NULL +SWI_PLGetStreamFunction swi_get_stream_f SWIGetStream =NULL // stack overflow expansion/gc control int allow_local_expansion Yap_AllowLocalExpansion =TRUE diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index ae4aa4cfe..c36e064b7 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -509,14 +509,13 @@ noent: #define get_stream_handle(t, sp, flags) \ get_stream_handle__LD(t, sp, flags PASS_LD) -int +X_API int PL_get_stream_handle(term_t t, IOSTREAM **s) { GET_LD return get_stream_handle(t, s, SH_ERRORS|SH_ALIAS); } - -int +X_API int PL_unify_stream_or_alias(term_t t, IOSTREAM *s) { GET_LD int rval; @@ -4308,7 +4307,8 @@ BeginPredDefs(file) EndPredDefs #if __YAP_PROLOG__ -static pl_Sgetc(IOSTREAM *s) +static int +pl_Sgetc(IOSTREAM *s) { return Sgetc(s); } @@ -4328,7 +4328,7 @@ pl_nl1(term_t stream) } static word -pl_nl() +pl_nl(void) { return pl_nl1(0); } @@ -4339,6 +4339,13 @@ static const PL_extension foreigns[] = { FRG((char *)NULL, 0, NULL, 0) }; +static int +get_stream_handle_no_errors(term_t t, IOSTREAM **s) +{ GET_LD + return get_stream_handle(t, s, SH_ALIAS); +} + + static void init_yap_extras(void) { @@ -4351,6 +4358,7 @@ init_yap_extras(void) swiio.put_w = Sputcode; swiio.flush_s = Sflush; swiio.close_s = Sclose; + swiio.get_stream_handle = get_stream_handle_no_errors; PL_YAP_InitSWIIO(&swiio); initCharTypes(); initFiles(); diff --git a/pl/yio.yap b/pl/yio.yap index 9472e01f2..200e185b0 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -29,13 +29,6 @@ open(File0,Mode,Stream) :- '$expand_filename'(Expansion, File0, File), '$open'(File, Mode, Stream, 16, Encoding, File0). -/* meaning of flags for '$write' is - 1 quote illegal atoms - 2 ignore operator declarations - 4 output '$VAR'(N) terms as A, B, C, ... - 8 use portray(_) -*/ - close(V) :- var(V), !, '$do_error'(instantiation_error,close(V)). close(File) :- @@ -229,21 +222,23 @@ open(F,T,S,Opts) :- '$check_opt_write'(attributes(T), G) :- !, '$check_write_attributes'(T, G). '$check_opt_write'(cycles(T), G) :- !, - '$check_cycles_arg'(T, G). + '$check_boolean'(T, write_option, cycles(T), G). '$check_opt_write'(quoted(T), G) :- !, - '$check_write_quoted_arg'(T, G). + '$check_boolean'(T, write_option, quoted(T), G). '$check_opt_write'(ignore_ops(T), G) :- !, - '$check_write_ignore_ops_arg'(T, G). -'$check_opt_write'(numbervars(T), G) :- !, - '$check_write_numbervars_arg'(T, G). -'$check_opt_write'(portrayed(T), G) :- !, - '$check_write_portrayed'(T, G). -'$check_opt_write'(portray(T), G) :- !, - '$check_write_portrayed'(T, G). -'$check_opt_write'(priority(T), G) :- !, - '$check_priority_arg'(T, G). + '$check_boolean'(T, write_option, ignore_ops(T), G). '$check_opt_write'(max_depth(T), G) :- !, '$check_write_max_depth'(T, G). +'$check_opt_write'(numbervars(T), G) :- !, + '$check_boolean'(T, write_option, ignore_ops(T), G). +'$check_opt_write'(portrayed(T), G) :- !, + '$check_boolean'(T, write_option, portrayed(T), G). +'$check_opt_write'(portray(T), G) :- !, + '$check_boolean'(T, write_option, portray(T), G). +'$check_opt_write'(priority(T), G) :- !, + '$check_priority_arg'(T, G). +'$check_opt_write'(swi(T), G) :- !, + '$check_boolean'(T, write_option, swi(T), G). '$check_opt_write'(A, G) :- '$do_error'(domain_error(write_option,A),G). @@ -329,40 +324,12 @@ open(F,T,S,Opts) :- '$check_write_attributes'(X,G) :- '$do_error'(domain_error(write_option,attributes(X)),G). -'$check_write_quoted_arg'(X, G) :- var(X), !, +'$check_boolean'(X, _, _, G) :- var(X), !, '$do_error'(instantiation_error,G). -'$check_write_quoted_arg'(true,_) :- !. -'$check_write_quoted_arg'(false,_) :- !. -'$check_write_quoted_arg'(X,G) :- - '$do_error'(domain_error(write_option,write_quoted(X)),G). - -'$check_cycles_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_cycles_arg'(true,_) :- !. -'$check_cycles_arg'(false,_) :- !. -'$check_cycles_arg'(X,G) :- - '$do_error'(domain_error(write_option,cycles(X)),G). - -'$check_write_ignore_ops_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_write_ignore_ops_arg'(true,_) :- !. -'$check_write_ignore_ops_arg'(false,_) :- !. -'$check_write_ignore_ops_arg'(X,G) :- - '$do_error'(domain_error(write_option,ignore_ops(X)),G). - -'$check_write_numbervars_arg'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_write_numbervars_arg'(true,_) :- !. -'$check_write_numbervars_arg'(false,_) :- !. -'$check_write_numbervars_arg'(X,G) :- - '$do_error'(domain_error(write_option,numbervars(X)),G). - -'$check_write_portrayed'(X, G) :- var(X), !, - '$do_error'(instantiation_error,G). -'$check_write_portrayed'(true,_) :- !. -'$check_write_portrayed'(false,_) :- !. -'$check_write_portrayed'(X,G) :- - '$do_error'(domain_error(write_option,portrayed(X)),G). +'$check_boolean'(true,_,_,_) :- !. +'$check_boolean'(false,_,_,_) :- !. +'$check_boolean'(X,B,T,G) :- + '$do_error'(domain_error(B,T),G). '$check_write_max_depth'(X, G) :- var(X), !, '$do_error'(instantiation_error,G). @@ -520,19 +487,20 @@ read_term(Stream, T, Options) :- '$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :- atom_codes(Name, Na). +nl(Stream) :- '$put'(Stream,10). + +nl :- current_output(Stream), '$put'(Stream,10), fail. +nl. + /* meaning of flags for '$write' is 1 quote illegal atoms 2 ignore operator declarations 4 output '$VAR'(N) terms as A, B, C, ... 8 use portray(_) + + flags are defined in yapio.h */ - -nl(Stream) :- '$put'(Stream,10). - -nl :- current_output(Stream), '$put'(Stream,10), fail. -nl. - write(T) :- '$write'(4, T). writeln(T) :- @@ -563,6 +531,15 @@ write_canonical(Stream,T) :- fail. write_canonical(_,_). +print(T) :- '$write'(12,T), fail. +print(_). + +print(Stream,T) :- + '$write'(Stream,12,T), + fail. +print(_,_). + + write_term(T,Opts) :- '$check_io_opts'(Opts, write_term(T,Opts)), '$process_wt_opts'(Opts, 0, Flag, Priority, Callbacks), @@ -579,42 +556,49 @@ write_term(S, T, Opts) :- fail. write_term(_,_,_). + '$process_wt_opts'([], Flag, Flag, 1200, []). '$process_wt_opts'([quoted(true)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 1, + FlagI is Flag0 \/ 0x01, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 30, - '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). -'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 16, - '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). -'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 15, + FlagI is Flag0 /\ \0x01, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 2, + FlagI is Flag0 \/ 0x02, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 39, + FlagI is Flag0 /\ \0x02, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 4, + FlagI is Flag0 \/ 0x04, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 27, + FlagI is Flag0 /\ \0x04, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 8, + FlagI is Flag0 \/ 0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 23, + FlagI is Flag0 /\ \0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portray(true)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 \/ 8, + FlagI is Flag0 \/ 0x08, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([portray(false)|Opts], Flag0, Flag, Priority, CallBacks) :- - FlagI is Flag0 /\ 23, + FlagI is Flag0 /\ \0x08, + '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). +'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- + FlagI is Flag0 \/ 0x20, + '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). +'$process_wt_opts'([cycles(false)|Opts], Flag0, Flag, Priority, CallBacks) :- + FlagI is Flag0 /\ \0x20, + '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). +'$process_wt_opts'([swi(true)|Opts], Flag0, Flag, Priority, CallBacks) :- + FlagI is Flag0 \/ 0x40, + '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). +'$process_wt_opts'([swi(false)|Opts], Flag0, Flag, Priority, CallBacks) :- + FlagI is Flag0 /\ \0x40, '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). '$process_wt_opts'([attributes(_)|Opts], Flag0, Flag, Priority, CallBacks) :- '$process_wt_opts'(Opts, FlagI, Flag, Priority, CallBacks). @@ -632,15 +616,6 @@ write_term(_,_,_). '$process_wt_callbacks'(Cs). -print(T) :- '$write'(12,T), fail. -print(_). - -print(Stream,T) :- - '$write'(Stream,12,T), - fail. -print(_,_). - - format(T) :- format(T, []).