fix bugs

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1073 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -10,8 +10,12 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2004-06-05 03:36:59 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-09 03:32:02 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.134  2004/06/05 03:36:59  vsc
+* coroutining is now a part of attvars.
+* some more fixes.
+*
 * Revision 1.133  2004/05/13 20:54:57  vsc
 * debugger fixes
 * make sure we always go back to current module, even during initizlization.
@@ -2208,7 +2212,7 @@ Yap_absmi(int inp)
 #endif
 	ENV = E_YREG;
 	/* Try to preserve the environment */
-	E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
+	E_YREG = (CELL *) (((char *) E_YREG) + PREG->u.sla.s);
 	CPREG = NEXTOP(PREG, sla);
 	ALWAYS_LOOKAHEAD(pt->OpcodeOfPred);
 	PREG = pt->CodeOfPred;
@@ -6292,8 +6296,8 @@ Yap_absmi(int inp)
 	CPredicate f = PREG->u.sdl.p->cs.f_code;
 	saveregs();
 	SREG = (CELL *)((f)());
+	setregs();
       }
-      setregs();
       if (!SREG)
 	PREG = PREG->u.sdl.l;
       else
@@ -6419,7 +6423,6 @@ Yap_absmi(int inp)
 \************************************************************************/
 
       BOp(index_pred, e);
-      saveregs();
       {
 	PredEntry *ap = PredFromDefCode(PREG);
  	WRITE_LOCK(ap->PRWLock);
@@ -6440,6 +6443,7 @@ Yap_absmi(int inp)
 	if (ASP > (CELL *) B) {
 	  ASP = (CELL *) B;
 	}
+	saveregs();
 	Yap_IPred(ap);
       /* IPred can generate errors, it thus must get rid of the lock itself */
 	setregs();
@@ -11852,22 +11856,6 @@ Yap_absmi(int inp)
 	    goto execute_after_comma;
 	  }
 	}
-	if (ActiveSignals & YAP_CDOVF_SIGNAL) {
-	  saveregs_and_ycache();
-	  if (!Yap_growheap(FALSE, 0, NULL)) {
-	    Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
-	    setregs_and_ycache();
-	    FAIL();
-	  }
-	  setregs_and_ycache();
-	  LOCK(SignalLock);
-	  ActiveSignals &= ~YAP_CDOVF_SIGNAL;
-	  CFREG = CalculateStackGap();
-	  UNLOCK(SignalLock);
-	  if (!ActiveSignals) {
-	    goto execute_after_comma;
-	  }
-	}
 	if (ActiveSignals & YAP_TROVF_SIGNAL) {
 	  saveregs_and_ycache();
 	  if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.49 2004-04-22 20:07:03 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.50 2004-06-09 03:32:02 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -1191,11 +1191,6 @@ InitHeap(void *heap_addr)
   /* reserve space for specially allocated functors and atoms so that
      their values can be known statically */
   HeapTop = Yap_HeapBase + AdjustSize(sizeof(all_heap_codes));
-#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
-  /* guarantee blocks always start at even addresses */
-  HeapTop += sizeof(YAP_SEG_SIZE);
-#endif
-
   HeapMax = HeapUsed = HeapTop-Yap_HeapBase;
 
   /* notice that this forces odd addresses */

C/c_interface.c

@@ -10,8 +10,12 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2004-06-05 03:36:59 $,$Author: vsc $						 *
+* Last rev:	$Date: 2004-06-09 03:32:02 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.48  2004/06/05 03:36:59  vsc
+* coroutining is now a part of attvars.
+* some more fixes.
+*
 * Revision 1.47  2004/05/17 21:42:08  vsc
 * misc fixes
 *
@@ -867,10 +871,8 @@ YAP_Read(int (*mygetc)(void))
 
   do_getf = mygetc;
   old_TR = TR;
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = Yap_GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0) {
-      break;
-  if (sno == MaxStreams) {
     Yap_Error(SYSTEM_ERROR,TermNil, "new stream not available for YAP_Read");
     return TermNil;
   }

C/iopreds.c

@@ -165,6 +165,27 @@ STATIC_PROTO (Int p_change_type_of_char, (void));
 STATIC_PROTO (Int p_type_of_char, (void));
 STATIC_PROTO (void CloseStream, (int));
 
+static int
+GetFreeStreamD(void)
+{
+  int sno;
+
+  for (sno = 0; sno < MaxStreams; ++sno)
+    if (Stream[sno].status & Free_Stream_f)
+      break;
+  if (sno == MaxStreams) {
+    return -1;
+  }
+  return sno;
+}
+
+int
+Yap_GetFreeStreamD(void)
+{
+  return GetFreeStreamD();
+}
+
+
 static int
 yap_fflush(int sno)
 {
@@ -1487,10 +1508,8 @@ Yap_InitSocketStream(int fd, socket_info flags, socket_domain domain) {
   StreamDesc *st;
   int sno;
 
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0) {
-      break;
-  if (sno == MaxStreams) {
     PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for socket/4");
     return(TermNil);
   }
@@ -1618,10 +1637,8 @@ p_open (void)
   }
   if (!Yap_TrueFileName (RepAtom (AtomOfTerm (file_name))->StrOfAE, Yap_FileNameBuf, FALSE))
     return (PlIOError (EXISTENCE_ERROR_SOURCE_SINK,file_name,"open/3"));
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0)
-      break;
-  if (sno == MaxStreams)
     return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open/3"));
   st = &Stream[sno];
   /* can never happen */
@@ -1840,11 +1857,8 @@ p_open_null_stream (void)
 {
   Term t;
   StreamDesc *st;
-  int sno;
+  int sno = GetFreeStreamD();
-  for (sno = 0; sno < MaxStreams; ++sno)
+  if (sno < 0)
-    if (Stream[sno].status & Free_Stream_f)
-      break;
-  if (sno == MaxStreams)
     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;
@@ -1866,10 +1880,8 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
   StreamDesc *st;
   int sno;
 
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno  < 0)
-      break;
-  if (sno == MaxStreams)
     return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1"));
   st = &Stream[sno];
   st->status = 0;
@@ -1942,10 +1954,8 @@ p_open_pipe_stream (void)
       return (PlIOError (SYSTEM_ERROR,TermNil, "open_pipe_stream/2 could not create pipe"));
     }
 #endif
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0)
-      break;
-  if (sno == MaxStreams)
     return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
   st = &Stream[sno];
   st->status = Input_Stream_f | Pipe_Stream_f;
@@ -1963,12 +1973,10 @@ p_open_pipe_stream (void)
 #else
   st->u.pipe.fd = filedes[0];
 #endif
-  t1 = MkStream (sno);
+  sno = GetFreeStreamD();
-  for (; sno < MaxStreams; ++sno)
+  if (sno < 0)
-    if (Stream[sno].status & Free_Stream_f)
-      break;
-  if (sno == MaxStreams)
     return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_pipe_stream/2"));
+  t1 = MkStream (sno);
   st = &Stream[sno];
   st->status = Output_Stream_f | Pipe_Stream_f;
   st->linepos = 0;
@@ -1996,10 +2004,8 @@ open_buf_read_stream(char *nbuf, Int nchars)
   StreamDesc *st;
  
 
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0)
-      break;
-  if (sno == MaxStreams)
     return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_mem_read_stream/1"));
   st = &Stream[sno];
   /* currently these streams are not seekable */
@@ -2072,10 +2078,8 @@ open_buf_write_stream(char *nbuf, UInt  sz)
   int sno;
   StreamDesc *st;
 
-  for (sno = 0; sno < MaxStreams; ++sno)
+  sno = GetFreeStreamD();
-    if (Stream[sno].status & Free_Stream_f)
+  if (sno < 0)
-      break;
-  if (sno == MaxStreams)
     return -1;
   st = &Stream[sno];
   /* currently these streams are not seekable */

C/tracer.c

@@ -170,6 +170,19 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
     printf("Here I go\n");
   } 
   if (gc_calls < 1) return;
+ {
+  CELL *env_ptr = ENV;
+  PredEntry *p;
+      while (env_ptr) {
+	PredEntry *pe = EnvPreg(env_ptr[E_CP]);
+	printf("%p->",env_ptr,pe);
+	if (vsc_count == 52LL) printf("\n");
+	if (p == pe) return(TRUE);
+	if (env_ptr != NULL)
+	  env_ptr = (CELL *)(env_ptr[E_E]);
+      }
+	printf("\n");
+ }
 #endif
   fprintf(Yap_stderr,"%lld ", vsc_count);
 #if defined(THREADS) || defined(YAPOR)

H/yapio.h

@@ -276,6 +276,7 @@ int   STD_PROTO(Yap_StreamToFileNo,(Term));
 Term  STD_PROTO(Yap_OpenStream,(FILE *,char *,Term,int));
 Term  STD_PROTO(Yap_StringToTerm,(char *,Term *));
 Term  STD_PROTO(Yap_TermToString,(Term,char *,unsigned int,int));
+int   STD_PROTO(Yap_GetFreeStreamD,(void));
 
 extern int
   Yap_c_input_stream,

pl/errors.yap

@@ -11,8 +11,11 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2004-04-27 16:21:25 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-09 03:32:03 $,$Author: vsc $						 *
-* $Log: not supported by cvs2svn $									 *
+* $Log: not supported by cvs2svn $
+* Revision 1.50  2004/04/27 16:21:25  vsc
+* stupid bug
+*									 *
 *									 *
 *************************************************************************/
 
@@ -669,4 +672,3 @@ print_message(Level, Mss) :-
 '$dump_error_token'(A) :-
 	'$format'(user_error," ~a", [A]).
 
-