From 51ea20683f23a55b24d31e5ea86b7a69f6456c1d Mon Sep 17 00:00:00 2001 From: vsc Date: Mon, 24 Feb 2003 11:01:01 +0000 Subject: [PATCH] fix setof to use catch instead of trying to do its own thing; fix unnecessary white lines when outputting solutions. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@788 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/arith2.c | 2 +- C/dbase.c | 58 ++++++++-------------------------------------------- C/init.c | 2 -- C/iopreds.c | 13 ++++++++++++ C/scanner.c | 2 +- H/Heap.h | 5 +---- H/rheap.h | 9 -------- pl/boot.yap | 27 ++++++++++++++++-------- pl/setof.yap | 9 +++++--- 9 files changed, 48 insertions(+), 79 deletions(-) diff --git a/C/arith2.c b/C/arith2.c index 5824ba1c0..1a60f1369 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -313,7 +313,7 @@ p_fdiv(Term t1, Term t2 E_ARGS) { Int i1 = IntegerOfTerm(t1); Float f2 = mpz_get_d(Yap_BigIntOfTerm(t2)); - RFLOAT(i1/f2); + RFLOAT(((Float)i1/f2)); } #endif default: diff --git a/C/dbase.c b/C/dbase.c index ace14141a..e42953b9b 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -113,8 +113,6 @@ typedef struct idb_queue rwlock_t QRWLock; /* a simple lock to protect this entry */ #endif DBRef FirstInQueue, LastInQueue; - Int age; /* the number of catches when we created the queue */ - struct idb_queue *next, *prev; } db_queue; #define HashFieldMask ((CELL)0xffL) @@ -4287,24 +4285,15 @@ p_init_queue(void) db_queue *dbq; Term t; - if (DBQueuesCache) { - dbq = DBQueuesCache; - DBQueuesCache = dbq->next; - } else { - while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) { - if (!Yap_growheap(FALSE)) { - Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); - return(FALSE); - } + while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) { + if (!Yap_growheap(FALSE)) { + Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); + return(FALSE); } - dbq->id = FunctorDBRef; - dbq->Flags = DBClMask; - dbq->FirstInQueue = dbq->LastInQueue = NULL; - dbq->prev = NULL; } - dbq->next = DBQueues; - DBQueues = dbq; - dbq->age = IntOfTerm(Yap_GetValue(AtomCatch)); + dbq->id = FunctorDBRef; + dbq->Flags = DBClMask; + dbq->FirstInQueue = dbq->LastInQueue = NULL; INIT_RWLOCK(dbq->QRWLock); t = MkDBRefTerm((DBRef)dbq); return(Yap_unify(ARG1, t)); @@ -4388,15 +4377,8 @@ p_dequeue(void) WRITE_LOCK(father_key->QRWLock); if ((cur_instance = father_key->FirstInQueue) == NULL) { /* an empty queue automatically goes away */ - if (father_key == DBQueues) - DBQueues = father_key->next; - else - father_key->prev->next = father_key->next; - if (father_key->next != NULL) - father_key->next->prev = father_key->prev; - father_key->next = DBQueuesCache; - DBQueuesCache = father_key; WRITE_UNLOCK(father_key->QRWLock); + FreeDBSpace((char *)father_key); return(FALSE); } else { Term TDB; @@ -4418,30 +4400,6 @@ p_dequeue(void) static Int p_clean_queues(void) { - Int myage = IntOfTerm(ARG1); - db_queue *ptr; - YAPEnterCriticalSection(); - ptr = DBQueues; - while (ptr) { - if (ptr->age >= myage) { - DBRef cur_instance; - db_queue *optr = ptr; - - while ((cur_instance = ptr->FirstInQueue)) { - /* release space for cur_instance */ - ptr->FirstInQueue = (DBRef)(cur_instance->Parent); - ErasePendingRefs(cur_instance); - FreeDBSpace((char *) cur_instance); - } - ptr = ptr->next; - FreeDBSpace((char *) optr); - } else - break; - } - if (ptr) - ptr->prev = NULL; - DBQueues = ptr; - YAPLeaveCriticalSection(); return(TRUE); } diff --git a/C/init.c b/C/init.c index 6a268d362..062af8b9e 100644 --- a/C/init.c +++ b/C/init.c @@ -794,8 +794,6 @@ InitCodes(void) */ heap_regs->primitives_module = 0; heap_regs->user_module = 1; - heap_regs->db_queues = NULL; - heap_regs->db_queues_cache = NULL; heap_regs->atom_abol = Yap_LookupAtom("$abol"); AtomAltNot = Yap_LookupAtom("not"); heap_regs->atom_append = Yap_LookupAtom ("append"); diff --git a/C/iopreds.c b/C/iopreds.c index 44d7feac4..542039596 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -788,6 +788,18 @@ p_setprompt (void) return (TRUE); } +static Int +p_is_same_tty (void) +{ /* 'prompt(Atom) */ + int sni = CheckStream (ARG1, Input_Stream_f, "put/2"); + int sno = CheckStream (ARG2, Output_Stream_f, "put/2"); + return ( + (Stream[sni].status & Tty_Stream_f) && + (Stream[sno].status & Tty_Stream_f) && + is_same_tty(Stream[sno].u.file.file,Stream[sni].u.file.file) + ); +} + static Int p_prompt (void) { /* prompt(Old,New) */ @@ -5071,6 +5083,7 @@ Yap_InitIOPreds(void) Yap_InitCPred ("current_input", 1, p_current_input, SafePredFlag|SyncPredFlag); Yap_InitCPred ("current_output", 1, p_current_output, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt", 1, p_setprompt, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$is_same_tty", 2, p_is_same_tty, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt", 2, p_prompt, SafePredFlag|SyncPredFlag); Yap_InitCPred ("always_prompt_user", 0, p_always_prompt_user, SafePredFlag|SyncPredFlag); Yap_InitCPred ("write_depth", 2, p_write_depth, SafePredFlag|SyncPredFlag); diff --git a/C/scanner.c b/C/scanner.c index 19ea3cf3f..9b546eae9 100644 --- a/C/scanner.c +++ b/C/scanner.c @@ -457,7 +457,7 @@ get_num(int *chp, int *chbuffp, int inp_stream, int (*Nxtch) (int), int (*Quoted if (ch - '0' >= base) return (MkIntegerTerm(val)); val = val * base + ch - '0'; - if (oval >= val && oval != 0) /* overflow */ + if (val/base != oval || val -oval*base != ch-'0') /* overflow */ has_overflow = (has_overflow || TRUE); ch = Nxtch(inp_stream); } diff --git a/H/Heap.h b/H/Heap.h index 4bd468c7c..7032fee89 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.37 2003-01-29 14:47:12 vsc Exp $ * +* version: $Id: Heap.h,v 1.38 2003-02-24 11:00:58 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -162,7 +162,6 @@ typedef struct various_codes { struct clause_struct *dead_clauses; int primitives_module; int user_module; - struct idb_queue *db_queues, *db_queues_cache; Atom atom_abol, atom_alarm, @@ -392,8 +391,6 @@ typedef struct various_codes { #define ModulePred heap_regs->module_pred #define PrimitivesModule heap_regs->primitives_module #define UserModule heap_regs->user_module -#define DBQueues heap_regs->db_queues -#define DBQueuesCache heap_regs->db_queues_cache #define NoOfModules heap_regs->no_of_modules #define AtomAbol heap_regs->atom_abol #define AtomAlarm heap_regs->atom_alarm diff --git a/H/rheap.h b/H/rheap.h index efeded36a..d94342ae2 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -134,15 +134,6 @@ restore_codes(void) heap_regs->dead_clauses = (Clause *) AddrAdjust((ADDR)(heap_regs->dead_clauses)); } - /* vsc: FIXME !!!!! */ - if (heap_regs->db_queues != NULL) { - heap_regs->db_queues = (struct idb_queue *) - AddrAdjust((ADDR)(heap_regs->db_queues)); - } - if (heap_regs->db_queues_cache != NULL) { - heap_regs->db_queues_cache = (struct idb_queue *) - AddrAdjust((ADDR)(heap_regs->db_queues_cache)); - } heap_regs->retry_recorded_code = PtoOpAdjust(heap_regs->retry_recorded_code); heap_regs->retry_recorded_k_code = diff --git a/pl/boot.yap b/pl/boot.yap index 7d2b49391..4014a30c9 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -97,6 +97,7 @@ read_sig. true ) ), + '$db_clean_queues'(0), '$startup_reconsult', '$startup_goals' ; @@ -515,7 +516,6 @@ repeat :- '$repeat'. '$flush_all_streams', fail. '$present_answer'((?-), Answ) :- - '$format'(user_error,"~n", []), '$get_value'('$break',BL), ( BL \= 0 -> '$format'(user_error, "[~p] ",[BL]) ; true ), @@ -528,15 +528,25 @@ repeat :- '$repeat'. '$another' :- '$format'(user_error," ? ",[]), '$get0'(user_input,C), - ( C== 0'; -> '$skip'(user_input,10), fail + ( C== 0'; -> '$skip'(user_input,10), + '$add_nl_outside_console', + fail ; - C== 10 -> '$format'(user_error,"~n", []) + C== 10 -> '$add_nl_outside_console', + '$format'(user_error,"yes~n", []) ; C== -1 -> halt ; '$skip'(user_input,10), '$ask_again_for_another' ). +'$add_nl_outside_console' :- + '$is_same_tty'(user_input, user_error), !. +'$add_nl_outside_console' :- + '$format'(user_error,"~n",[]). + + + '$ask_again_for_another' :- '$format'(user_error,"Action (\";\" for more choices, for exit)", []), '$another'. @@ -545,7 +555,8 @@ repeat :- '$repeat'. '$flush_all_streams', fail. '$write_answer'(Vs, LBlk, LAnsw) :- - '$purge_dontcares'(Vs,NVs), + '$purge_dontcares'(Vs,IVs), + '$sort'(IVs, NVs), '$prep_answer_var_by_var'(NVs, LAnsw, LBlk), '$name_vars_in_goals'(LAnsw, Vs, NLAnsw), '$write_vars_and_goals'(NLAnsw). @@ -594,24 +605,22 @@ repeat :- '$repeat'. '$write_remaining_vars_and_goals'([]). '$write_remaining_vars_and_goals'([G1|LG]) :- - '$format'(user_error,",",[]), + '$format'(user_error,",~n",[]), '$write_goal_output'(G1), '$write_remaining_vars_and_goals'(LG). '$write_goal_output'(var([V|VL])) :- - '$format'(user_error,"~n~s",[V]), + '$format'(user_error,"~s",[V]), '$write_output_vars'(VL). '$write_goal_output'(nonvar([V|VL],B)) :- - '$format'(user_error,"~n~s",[V]), + '$format'(user_error,"~s",[V]), '$write_output_vars'(VL), '$format'(user_error," = ", []), ( '$recorded'('$print_options','$toplevel'(Opts),_) -> write_term(user_error,B,Opts) ; '$format'(user_error,"~w",[B]) ). - '$write_goal_output'(_-G) :- - '$format'(user_error,"~n",[]), ( '$recorded'('$print_options','$toplevel'(Opts),_) -> write_term(user_error,G,Opts) ; '$format'(user_error,"~w",[G]) diff --git a/pl/setof.yap b/pl/setof.yap index d8219837b..5f76047e0 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -53,9 +53,12 @@ findall(Template, Generator, Answers, SoFar) :- '$findall'(_, _, Ref, SoFar, Answers) :- '$collect_for_findall'(Ref, SoFar, Answers). -'$clean_findall'(Ref,_) :- - '$db_dequeue'(Ref,_), - fail. +% error handling: be careful to recover all the space we used up +% in implementing findall. +% +'$clean_findall'(Ref,Ball) :- + '$db_dequeue'(Ref,_), !, + '$clean_findall'(Ref,Ball). '$clean_findall'(_,Ball) :- % get this off the unwound computation. copy_term(Ball,NewBall),