|
From: Vitor S. C. <vs...@us...> - 2008-07-22 23:34:43
|
Update of /cvsroot/yap/C In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv25978/C Modified Files: cdmgr.c exec.c init.c iopreds.c Log Message: SWI and module fixes Index: cdmgr.c =================================================================== RCS file: /cvsroot/yap/C/cdmgr.c,v retrieving revision 1.230 retrieving revision 1.231 diff -u -r1.230 -r1.231 --- cdmgr.c 2 Jun 2008 17:20:28 -0000 1.230 +++ cdmgr.c 22 Jul 2008 23:34:44 -0000 1.231 @@ -13,6 +13,9 @@ * * * Last rev: $Date$,$Author$ * * $Log$ +* Revision 1.231 2008/07/22 23:34:44 vsc +* SWI and module fixes +* * Revision 1.230 2008/06/02 17:20:28 vsc * fix abolish bug * @@ -4788,6 +4791,13 @@ return FALSE; if (EndOfPAEntr(pe)) return FALSE; + if (pe->ModuleOfPred) { + if (!Yap_unify(ARG3,pe->ModuleOfPred)) + return FALSE; + } else { + if (!Yap_unify(ARG3,TermProlog)) + return FALSE; + } return(!pe->ModuleOfPred || /* any predicate in prolog module */ /* any C-pred */ pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) || @@ -4832,7 +4842,7 @@ } else return (FALSE); if (EndOfPAEntr(pe)) - return(FALSE); + return FALSE; pe->PredFlags |= HiddenPredFlag; return(TRUE); } @@ -6163,7 +6173,7 @@ Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag|HiddenPredFlag); - Yap_InitCPred("$all_system_predicate", 2, p_all_system_pred, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$all_system_predicate", 3, p_all_system_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag|HiddenPredFlag); Index: exec.c =================================================================== RCS file: /cvsroot/yap/C/exec.c,v retrieving revision 1.139 retrieving revision 1.140 diff -u -r1.139 -r1.140 --- exec.c 4 Jun 2008 14:47:18 -0000 1.139 +++ exec.c 22 Jul 2008 23:34:44 -0000 1.140 @@ -664,6 +664,7 @@ } } pe = PredPropByFunc(f, mod); + // Yap_DebugPlWrite(mod);fprintf(stderr,"\n"); arity = ArityOfFunctor(f); /* I cannot use the standard macro here because otherwise I would dereference the argument and Index: init.c =================================================================== RCS file: /cvsroot/yap/C/init.c,v retrieving revision 1.172 retrieving revision 1.173 diff -u -r1.172 -r1.173 --- init.c 10 May 2008 23:24:12 -0000 1.172 +++ init.c 22 Jul 2008 23:34:48 -0000 1.173 @@ -1212,6 +1212,7 @@ Yap_heap_regs->functor_arrow = Yap_MkFunctor(AtomArrow, 2); Yap_heap_regs->functor_assert = Yap_MkFunctor(AtomAssert, 2); Yap_heap_regs->functor_at_found_one = Yap_MkFunctor(AtomFoundVar, 2); + Yap_heap_regs->functor_atom = Yap_MkFunctor(Yap_LookupAtom("atom"), 1); #ifdef COROUTINING Yap_heap_regs->functor_att_goal = Yap_MkFunctor(Yap_FullLookupAtom("$att_do"),2); #endif Index: iopreds.c =================================================================== RCS file: /cvsroot/yap/C/iopreds.c,v retrieving revision 1.183 retrieving revision 1.184 diff -u -r1.183 -r1.184 --- iopreds.c 11 Jul 2008 17:02:07 -0000 1.183 +++ iopreds.c 22 Jul 2008 23:34:48 -0000 1.184 @@ -2781,21 +2781,29 @@ return sno; } -static Int -p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */ +static int +OpenBufWriteStream(void) { - Term t; - int sno; char *nbuf; extern int Yap_page_size; + while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) { if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); - return(FALSE); + return -1; } } - sno = open_buf_write_stream(nbuf, Yap_page_size); + return open_buf_write_stream(nbuf, Yap_page_size); +} + +static Int +p_open_mem_write_stream (void) /* $open_mem_write_stream(-Stream) */ +{ + Term t; + int sno; + + sno = OpenBufWriteStream(); if (sno == -1) return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_mem_read_stream/1")); t = MkStream (sno); @@ -5337,18 +5345,41 @@ p_format2(void) { /* 'format'(Stream,Control,Args) */ int old_c_stream = Yap_c_output_stream; + int mem_stream = FALSE; Int out; + Term tin = Deref(ARG1); - /* needs to change Yap_c_output_stream for write */ - Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3"); + if (IsVarTerm(tin)) { + Yap_Error(INSTANTIATION_ERROR,tin,"format/3"); + return FALSE; + } + if (IsApplTerm(tin) && FunctorOfTerm(tin) == FunctorAtom) { + Yap_c_output_stream = OpenBufWriteStream(); + mem_stream = TRUE; + } else { + /* needs to change Yap_c_output_stream for write */ + Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f, "format/3"); + } UNLOCK(Stream[Yap_c_output_stream].streamlock); if (Yap_c_output_stream == -1) { Yap_c_output_stream = old_c_stream; - return(FALSE); + return FALSE; } out = format(Deref(ARG2),Deref(ARG3),Yap_c_output_stream); - Yap_c_output_stream = old_c_stream; - return(out); + if (mem_stream) { + Term tat; + int stream = Yap_c_output_stream; + Yap_c_output_stream = old_c_stream; + if (out) { + tat = MkAtomTerm(Yap_LookupAtom(Stream[stream].u.mem_string.buf)); + CloseStream(stream); + if (!Yap_unify(tat,ArgOfTerm(1,ARG1))) + return FALSE; + } + } else { + Yap_c_output_stream = old_c_stream; + } + return out; } @@ -5421,7 +5452,7 @@ if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR,t1,"stream_select/3"); - return(FALSE); + return FALSE; } if (!IsPairTerm(t1)) { Yap_Error(TYPE_ERROR_LIST,t1,"stream_select/3"); |