From 45a0bc7aef82253ed612b314bc6c753289d33ae7 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Thu, 29 Nov 2001 20:29:52 +0000
Subject: [PATCH] fix ; -> and ! in meta-call (again) fix peek and read

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@207 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/dbase.c      |  4 +++-
 C/heapgc.c     |  2 ++
 C/iopreds.c    |  6 +++++-
 pl/boot.yap    | 15 +++++++++------
 pl/consult.yap |  1 +
 5 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/C/dbase.c b/C/dbase.c
index c84ec10fe..a6c929238 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -140,6 +140,8 @@ typedef struct idb_queue
 #define FunctorHash(t)  (Unsigned(t)>>4)
 #define NumberHash(t)   (Unsigned(IntOfTerm(t)))
 
+#define LARGE_IDB_LINK_TABLE 1
+
 /* traditionally, YAP used a link table to recover IDB terms*/
 #define IDB_LINK_TABLE 1
 #if LARGE_IDB_LINK_TABLE
@@ -1371,7 +1373,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 	nar = pp->Contents + Unsigned(NOfCells);
       }
 #ifdef IDB_LINK_TABLE
-      woar = WordPtr(nar);
+      woar = (link_entry *)nar;
       memcpy((void *)woar,(const void *)LinkAr,(size_t)(NOfLinks*sizeof(link_entry)));
       woar += NOfLinks;
 #ifdef ALIGN_LONGS
diff --git a/C/heapgc.c b/C/heapgc.c
index 778baff81..79426b789 100644
--- a/C/heapgc.c
+++ b/C/heapgc.c
@@ -2603,6 +2603,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
     old_vars = new_vars = 0;
     TrueHB = HB;
     num_bs = 0;
+    printf("vsc: Starting with %p: %x vs %p->%p %p->\n", (CELL *)0x90da350, *(CELL *)0x90da350, AtomBase, HeapTop, H0);
   }
 #endif
 #ifdef DEBUG
@@ -2694,6 +2695,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
 	       (unsigned long int)(ASP-H));
   }
 #ifdef DEBUG
+printf("vsc: Finishing with %p: %x vs %p->%p %p->\n", (CELL *)0x90da350, *(CELL *)0x90da350, AtomBase, HeapTop, H0);
   check_global();
 #endif
   return(effectiveness);
diff --git a/C/iopreds.c b/C/iopreds.c
index ec13d8969..917ba1f7e 100644
--- a/C/iopreds.c
+++ b/C/iopreds.c
@@ -1296,6 +1296,8 @@ PlUnGetc (int sno)
   register StreamDesc *s = &Stream[sno];
   Int ch;
 
+  if (s->stream_getc != PlUnGetc)
+    return(s->stream_getc(sno));
   ch = s->och;
   if (s->status & InMemory_Stream_f) {
     s->stream_getc = MemGetc;
@@ -2778,7 +2780,9 @@ p_read (void)
 
     /* Scans the term using stack space */
     eot_before_eof = FALSE;
-    if ((Stream[c_input_stream].status & (Promptable_Stream_f|Pipe_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) || CharConversionTable != NULL)
+    if ((Stream[c_input_stream].status & (Promptable_Stream_f|Pipe_Stream_f|Socket_Stream_f|Eof_Stream_f|InMemory_Stream_f)) ||
+	CharConversionTable != NULL ||
+	Stream[c_input_stream].stream_getc != PlGetc)
       tokstart = tokptr = toktide = tokenizer (Stream[c_input_stream].stream_getc_for_read, Stream[c_input_stream].stream_getc);
     else {
       tokstart = tokptr = toktide = fast_tokenizer ();
diff --git a/pl/boot.yap b/pl/boot.yap
index c39330d66..89ae5dc33 100644
--- a/pl/boot.yap
+++ b/pl/boot.yap
@@ -652,13 +652,16 @@ incore(G) :- '$execute'(G).
 	'$execute_within'(A),
 	'$last_execute_within'(B).
 
-';'(A,B) :- ((A = ( T->G) -> '$execute_within'(T), !, '$execute_within'(G) ;
-             '$execute_within'(A) );
-	     '$execute_within'(B) ).
+% Be careful with -> cutting through
+';'(A,B) :- (A = ( T->G) ->
+	     ( '$execute_within'(T) ->  '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) )
+	    ;
+	     ( '$execute_within'(A) ; '$execute_within'(B) ) ).
 
-'|'(A,B) :- ((A = ( T->G) -> '$execute_within'(T), !, '$execute_within'(G) ;
-             '$execute_within'(A) );
-	     '$execute_within'(B) ).
+'|'(A,B) :- (A = ( T->G) ->
+	     ( '$execute_within'(T) ->  '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) )
+	    ;
+	     ( '$execute_within'(A) ; '$execute_within'(B) ) ).
 
 
 '->'(A,B) :-
diff --git a/pl/consult.yap b/pl/consult.yap
index 24cc96530..97df9c751 100644
--- a/pl/consult.yap
+++ b/pl/consult.yap
@@ -246,6 +246,7 @@ reconsult(Fs) :-
 	( '$access_yap_flags'(15, 0) -> true ; halt).
 
 '$skip_unix_comments'(Stream) :-
+write(hello), nl,
 	'$peek_byte'(Stream, 0'#), !, % 35 is ASCII for #
 	'$get0_line_codes'(Stream, _),
 	'$skip_unix_comments'(Stream).