Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

C/amasm.c

@@ -259,7 +259,6 @@ static yamop *a_try(op_numbers, CELL, CELL, yamop *, int, struct intermediates *
 static yamop *a_either(op_numbers, CELL, CELL, yamop *,  int, struct intermediates *);
 #endif	/* YAPOR */
 static yamop *a_gl(op_numbers, yamop *, int, struct PSEUDO *, struct intermediates * CACHE_TYPE);
-static yamop *a_bfunc(CELL, clause_info *, yamop *, int, struct intermediates *);
 static 
 COUNT compile_cmp_flags(char *);
 static yamop *a_igl(CELL, op_numbers, yamop *, int, struct intermediates *);
@@ -1622,65 +1621,63 @@ Yap_compile_cmp_flags(PredEntry *pred)
 }
 
 static yamop *
-a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
+a_bfunc(CELL a1, CELL a2, PredEntry *pred, clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
 {
-  Ventry *ve = (Ventry *) cip->cpc->rnd1;
+  Ventry *ve1 = (Ventry *)a1;
-  OPREG var_offset;
+  Ventry *ve2 = (Ventry *)a2;
-  int is_y_var = (ve->KindOfVE == PermVar);
+  OPREG var_offset1;
-  
+  int is_y_var = (ve1->KindOfVE == PermVar);
-  var_offset = Var_Ref(ve, is_y_var);
+ 
-  if (ve->KindOfVE == PermVar) {
+  var_offset1 = Var_Ref(ve1, is_y_var);
-    yslot v1 = emit_yreg(var_offset);
+  if (ve1->KindOfVE == PermVar) {
-    cip->cpc = cip->cpc->nextInst;
+    yslot v1 = emit_yreg(var_offset1);
-    ve = (Ventry *) cip->cpc->rnd1;
+    bool is_y_var2 = (ve2->KindOfVE == PermVar);
-    is_y_var = (ve->KindOfVE == PermVar);
+    OPREG var_offset2 = Var_Ref(ve2, is_y_var2);
-    var_offset = Var_Ref(ve, is_y_var);
+    if (is_y_var2) {
-    if (is_y_var) {
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_yy);
-	code_p->y_u.plyys.p = RepPredProp(((Prop)pred));
+	code_p->y_u.plyys.p = pred;
 	code_p->y_u.plyys.f = emit_fail(cip);
 	code_p->y_u.plyys.y1 = v1;
-	code_p->y_u.plyys.y2 = emit_yreg(var_offset);
+	code_p->y_u.plyys.y2 = emit_yreg(var_offset2);
 	code_p->y_u.plyys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
       GONEXT(plyys);
     } else {
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_yx);
-	code_p->y_u.plxys.p = RepPredProp(((Prop)pred));
+	code_p->y_u.plxys.p = pred;
 	code_p->y_u.plxys.f = emit_fail(cip);
-	code_p->y_u.plxys.x = emit_xreg(var_offset);
+	code_p->y_u.plxys.x = emit_xreg(var_offset2);
 	code_p->y_u.plxys.y = v1;
-	code_p->y_u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
+ 	code_p->y_u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
       GONEXT(plxys);
     }
   } else {
-    wamreg x1 = emit_xreg(var_offset);
+    wamreg x1 = emit_xreg(var_offset1);
-    OPREG var_offset;
+    OPREG var_offset2;
 
-    cip->cpc = cip->cpc->nextInst;
+    bool is_y_var2 = (ve2->KindOfVE == PermVar);
-    ve = (Ventry *) cip->cpc->rnd1;
+    var_offset2 = Var_Ref(ve2, is_y_var2);
-    is_y_var = (ve->KindOfVE == PermVar);
+    if (is_y_var2) {
-    var_offset = Var_Ref(ve, is_y_var);
-    if (is_y_var) {
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_xy);
-	code_p->y_u.plxys.p = RepPredProp(((Prop)pred));
+	code_p->y_u.plxys.p = pred;
 	code_p->y_u.plxys.f = emit_fail(cip);
 	code_p->y_u.plxys.x = x1;
-	code_p->y_u.plxys.y = emit_yreg(var_offset);
+	code_p->y_u.plxys.y = emit_yreg(var_offset2);
 	code_p->y_u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
       GONEXT(plxys);
     } else {
       if (pass_no) {
+	//	printf(" %p --- %p\n", x1, emit_xreg(var_offset2) );
 	code_p->opc = emit_op(_call_bfunc_xx);
-	code_p->y_u.plxxs.p = RepPredProp(((Prop)pred));
+	code_p->y_u.plxxs.p = pred;
 	code_p->y_u.plxxs.f = emit_fail(cip);
 	code_p->y_u.plxxs.x1 = x1;
-	code_p->y_u.plxxs.x2 = emit_xreg(var_offset);
+	code_p->y_u.plxxs.x2 = emit_xreg(var_offset2);
 	code_p->y_u.plxxs.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
       GONEXT(plxxs);
@@ -3685,13 +3682,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case count_retry_op:
       code_p = a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
       break;
-    case fetch_args_for_bccall_op:
+    case bccall_op:
-      if (cip->cpc->nextInst->op != bccall_op) {
+      code_p = a_bfunc(cip->cpc->rnd1, cip->cpc->rnd3,  (PredEntry *)(cip->cpc->rnd5), &clinfo, code_p, pass_no, cip);
-	Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "compiling binary test", (int) cip->cpc->op);
-	save_machine_regs();
-	siglongjmp(cip->CompilerBotch, 1);
-      }
-      code_p = a_bfunc(cip->cpc->nextInst->rnd2, &clinfo, code_p, pass_no, cip);
       break;
     case align_float_op:
       /* install a blob */
@@ -3888,6 +3880,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
     DBTerm *x;
     StaticClause *cl;
     UInt osize;
+
     if(!(x = fetch_clause_space(&t, size, cip, &osize PASS_REGS))) {
       return NULL;
     }

C/cdmgr.c

@@ -1651,6 +1651,7 @@ source_pred(PredEntry *p, yamop *q)
 static void 
 add_first_static(PredEntry *p, yamop *cp, int spy_flag)
 {
+  CACHE_REGS
   yamop *pt = cp;
 
   if (is_logupd(p)) {
@@ -1701,12 +1702,17 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
   if (source_pred(p, cp)) {
     p->PredFlags |= SourcePredFlag;
   }
+  if (!(p->PredFlags & MultiFileFlag) &&
+      p->src.OwnerFile == AtomNil)
+    p->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
+
 }
 
 /* p is already locked */
 static void 
 add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
 {
+  CACHE_REGS
   yamop    *ncp = ((DynamicClause *)NULL)->ClCode;
   DynamicClause   *cl;
   if (p == PredGoalExpansion || p->FunctorOfPred == FunctorGoalExpansion2) {
@@ -1797,6 +1803,10 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
   ncp = NEXTOP(ncp,e);
   ncp->opc = Yap_opcode(_Ystop);
   ncp->y_u.l.l = cl->ClCode;
+  if (!(p->PredFlags & MultiFileFlag) &&
+      p->src.OwnerFile == AtomNil)
+    p->src.OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
+
 }
 
 /* p is already locked */
@@ -3264,6 +3274,28 @@ p_owner_file( USES_REGS1 )
   return Yap_unify(ARG3, MkAtomTerm(owner));
 }
 
+static Int 
+p_set_owner_file( USES_REGS1 )
+{				/* '$owner_file'(+P,M,F)	 */
+  PredEntry      *pe;
+
+  pe = get_pred(Deref(ARG1),  Deref(ARG2), "$is_source");
+  if (EndOfPAEntr(pe))
+    return FALSE;
+  PELOCK(29,pe);
+  if (pe->ModuleOfPred == IDB_MODULE) {
+    UNLOCKPE(47,pe);
+    return FALSE;
+  }
+  if (pe->PredFlags & MultiFileFlag) {
+    UNLOCKPE(48,pe);
+    return FALSE;
+  }
+  pe->src.OwnerFile = AtomOfTerm(Deref(ARG3));
+  UNLOCKPE(49,pe);
+  return TRUE;
+}
+
 static Int 
 p_mk_d( USES_REGS1 )
 {				/* '$is_dynamic'(+P)	 */
@@ -6664,6 +6696,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag);
+  Yap_InitCPred("$set_owner_file", 3, p_set_owner_file, SafePredFlag);
   Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag);
   Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);

C/cmppreds.c

@@ -794,7 +794,9 @@ a_eq(Term t1, Term t2)
 {
   CACHE_REGS
   /* A =:= B		 */
-  int out;
+  Int out;
+  t1 = Deref(t1);
+  t2 = Deref(t2);
 
   if (IsVarTerm(t1)) {
     Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");

C/compiler.c

@@ -236,7 +236,7 @@ static void c_bifun(basic_preds, Term, Term, Term, Term, Term, compiler_struct *
 static void c_goal(Term, Term, compiler_struct *);
 static void c_body(Term, Term, compiler_struct *);
 static void c_head(Term, compiler_struct *);
-static int usesvar(compiler_vm_op);
+static bool usesvar(compiler_vm_op);
 static CELL *init_bvarray(int, compiler_struct *);
 #ifdef DEBUG
 static void clear_bvarray(int, CELL *, compiler_struct *);
@@ -446,12 +446,6 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct
       Yap_emit(f_val_op, t, (CELL)arity, &cglobs->cint);
     }
     break;
-  case bt1_flag:
-    Yap_emit(fetch_args_for_bccall_op, t, 0, &cglobs->cint);
-    break;
-  case bt2_flag:
-    Yap_emit(bccall_op, t, (CELL)cglobs->current_p0, &cglobs->cint);
-    break;
   default:
 #ifdef SFUNC
     if (argno < 0) {
@@ -483,6 +477,24 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct
   tag_var(t, new, cglobs);
 }
 
+// built-in like X >= Y.
+static void
+c_2vars(int op, Term t1, Int argno1, Term t2, Int argno2, CELL extra, unsigned int arity, unsigned int level, compiler_struct *cglobs)
+{
+  int new1 = check_var((t1 = Deref(t1)), level, argno1, cglobs);
+  int new2 = check_var((t2 = Deref(t2)), level, argno2, cglobs);
+
+  switch (op) {
+  case bt_flag:
+    Yap_emit_5ops(bccall_op, t1, argno1, t2, argno2, extra, &cglobs->cint);
+    break;
+  default:
+    return;
+  }
+  tag_var(t1, new1, cglobs);
+  tag_var(t2, new2, cglobs);
+}
+
 static void
 reset_vars(Ventry *vtable)
 {
@@ -1876,9 +1888,8 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
       v->FlagsOfVE |= SafeVar;
       return;
     }
-    else if (p->PredFlags & AsmPredFlag) {
+    else if (p->PredFlags & (AsmPredFlag)) {
       basic_preds op = p->PredFlags & 0x7f;
-
       if (profiling)
 	Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);
       else if (call_counting)
@@ -1941,7 +1952,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
 #ifdef BEAM
     else if (p->PredFlags & BinaryPredFlag && !EAM) {
 #else
-    else if (p->PredFlags & BinaryPredFlag) {
+    else if (p->PredFlags & BinaryPredFlag ) {
 #endif
       CACHE_REGS
       Term a1 = ArgOfTerm(1,Goal);
@@ -1949,33 +1960,25 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
       if (IsVarTerm(a1) && !IsNewVar(a1)) {
 	Term a2 = ArgOfTerm(2,Goal);
 	if (IsVarTerm(a2) && !IsNewVar(a2)) {
-	  if (IsNewVar(a2))  {
-	    LOCAL_Error_TYPE = INSTANTIATION_ERROR;
-	    LOCAL_Error_Term = a2;
-	    LOCAL_ErrorMessage = LOCAL_ErrorSay;
-	    sprintf(LOCAL_ErrorMessage, "compiling %s/2 with second arg unbound",  RepAtom(NameOfFunctor(p->FunctorOfPred))->StrOfAE);
-	    save_machine_regs();
-	    siglongjmp(cglobs->cint.CompilerBotch,1);
-	  }
-	  c_var(a1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
-	  c_var(a2, bt2_flag, 2, 0, cglobs);
+	  c_2vars(bt_flag, a1, 0, a2, 0, (CELL)p0, 0, 0, cglobs);
 	}
 	else {
 	  Term t2 = MkVarTerm();
+	  //c_var(t2, --cglobs->tmpreg, 0, 0, cglobs);
 	  if (HR == (CELL *)cglobs->cint.freep0) {
 	    /* oops, too many new variables */
 	    save_machine_regs();
 	    siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	  }
-	  c_eq(t2, a2, cglobs);
-	  c_var(a1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
-	  c_var(t2, bt2_flag, 2, 0, cglobs);
+	  c_eq(t2, a2, cglobs);
+	  c_2vars(bt_flag, a1, 0, t2, 0, (CELL)p0, 0, 0, cglobs);
 	}
       } else {
 	Term a2 = ArgOfTerm(2,Goal);
 	Term t1 = MkVarTerm();
+	//c_var(t1, --cglobs->tmpreg, 0, 0, cglobs);
 	if (HR == (CELL *)cglobs->cint.freep0) {
 	  /* oops, too many new variables */
 	  save_machine_regs();
@@ -1984,21 +1987,20 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
 	c_eq(t1, a1, cglobs);
 
 	if (IsVarTerm(a2) && !IsNewVar(a2)) {
-	  c_var(t1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
-	  c_var(a2, bt2_flag, 2, 0, cglobs);
+	  c_2vars(bt_flag, t1, 0, a2, 0, (CELL)p0, 0, 0, cglobs);
 	}
 	else {
 	  Term t2 = MkVarTerm();
+	  //	  c_var(t2, --cglobs->tmpreg, 0, 0, cglobs);
 	  if (HR == (CELL *)cglobs->cint.freep0) {
 	    /* oops, too many new variables */
 	    save_machine_regs();
 	    siglongjmp(cglobs->cint.CompilerBotch,OUT_OF_TEMPS_BOTCH);
 	  }
 	  c_eq(t2, a2, cglobs);
-	  c_var(t1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
-	  c_var(t2, bt2_flag, 2, 0, cglobs);
+	  c_2vars(bt_flag, t1, 0, t2, 0, (CELL)p0, 0, 0, cglobs);
 	}
       }
       if (cglobs->onlast) {
@@ -2183,11 +2185,11 @@ c_head(Term t, compiler_struct *cglobs)
 }
 
 
-inline static int
+inline static bool
 usesvar(compiler_vm_op ic)
 {
   if (ic >= get_var_op && ic <= put_val_op)
-    return TRUE;
+    return true;
   switch (ic) {
   case save_b_op:
   case commit_b_op:
@@ -2196,21 +2198,36 @@ usesvar(compiler_vm_op ic)
   case save_pair_op:
   case f_val_op:
   case f_var_op:
-  case fetch_args_for_bccall_op:
   case bccall_op:
-    return TRUE;
+    return true;
   default:
     break;
   }
 #ifdef SFUNC
   if (ic >= unify_s_var_op && ic <= write_s_val_op)
-    return TRUE;
+    return true;
 #endif
   return ((ic >= unify_var_op && ic <= write_val_op)
 	  ||
 	  (ic >= unify_last_var_op && ic <= unify_last_val_op));
 }
 
+inline static bool
+  uses_this_var(PInstr *pc, Term arg)
+{
+  compiler_vm_op ic = pc->op;
+
+  if (pc->rnd1 != arg)
+    return arg == pc->rnd3 && ic == bccall_op;
+  return usesvar( ic );
+}
+
+inline static bool
+usesvar2(compiler_vm_op ic)
+{
+  return ic == bccall_op;
+}
+
 /*
  * Do as in the traditional WAM and make sure voids are in
  * environments
@@ -2224,6 +2241,34 @@ typedef  struct env_tmp {
 }  EnvTmp;
 #endif
 
+
+static void
+  tag_use(Ventry *v USES_REGS) 
+{ 
+#ifdef BEAM
+   if (EAM) {
+      if (v->NoOfVE == Unassigned || v->KindOfVE!=PermVar) {
+	v->NoOfVE = PermVar | (LOCAL_nperm++);
+	v->KindOfVE = PermVar;
+	v->FlagsOfVE |= PermFlag;	
+      }
+   }
+#endif
+      if (v->NoOfVE == Unassigned) {
+	if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
+	    || v->KindOfVE == PermVar	/*
+					 * * || (v->FlagsOfVE & NonVoid && !(v->FlagsOfVE &
+					 * * OnHeadFlag)) 
+					 */ ) {
+	  v->NoOfVE = PermVar | (LOCAL_nperm++);
+	  v->KindOfVE = PermVar;
+	  v->FlagsOfVE |= PermFlag;
+	} else {
+	  v->NoOfVE = v->KindOfVE = TempVar;
+	}
+      }
+}
+
 static void
 AssignPerm(PInstr *pc, compiler_struct *cglobs)
 {
@@ -2277,28 +2322,12 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
     if (uses_var) {
       Ventry *v = (Ventry *) (pc->rnd1);
 
-#ifdef BEAM
+      tag_use(v PASS_REGS); 
-   if (EAM) {
+      if (usesvar2(pc->op) ) {
-      if (v->NoOfVE == Unassigned || v->KindOfVE!=PermVar) {
+	Ventry *v2 = (Ventry *) (pc->rnd3);
-	v->NoOfVE = PermVar | (LOCAL_nperm++);
+	tag_use(v2 PASS_REGS); 
-	v->KindOfVE = PermVar;
-	v->FlagsOfVE |= PermFlag;	
-      }
-   }
-#endif
-      if (v->NoOfVE == Unassigned) {
-	if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
-	    || v->KindOfVE == PermVar	/*
-					 * * || (v->FlagsOfVE & NonVoid && !(v->FlagsOfVE &
-					 * * OnHeadFlag)) 
-					 */ ) {
-	  v->NoOfVE = PermVar | (LOCAL_nperm++);
-	  v->KindOfVE = PermVar;
-	  v->FlagsOfVE |= PermFlag;
-	} else {
-	  v->NoOfVE = v->KindOfVE = TempVar;
-	}
       }
+
     } else if (pc->op == empty_call_op) {
       pc->rnd2 = LOCAL_nperm;
     } else if (pc->op == call_op || pc->op == either_op || pc->op == orelse_op || pc->op == push_or_op) {
@@ -2357,7 +2386,6 @@ clear_bvarray(int var, CELL *bvarray
     LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR;
     LOCAL_Error_Term = TermNil;
     LOCAL_ErrorMessage = "compiler internal error: variable initialised twice";
- fprintf(stderr," vsc: compiling7\n");
     save_machine_regs();
     siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
   }
@@ -2488,6 +2516,22 @@ CheckUnsafe(PInstr *pc, compiler_struct *cglobs)
 	}
 	break;
       }
+    case bccall_op:
+      {
+	Ventry *v = (Ventry *) (pc->rnd1),
+	  *v3 = (Ventry *) (pc->rnd3);
+
+	if ( (v->FlagsOfVE & PermFlag && pc == v->FirstOpForV) ||
+	     (v3->FlagsOfVE & PermFlag && pc == v3->FirstOpForV) ) {
+	  CACHE_REGS
+	    LOCAL_Error_TYPE = INTERNAL_COMPILER_ERROR;
+	  LOCAL_Error_Term = TermNil;
+	  LOCAL_ErrorMessage = "comparison should not have first instance of variables";
+	  save_machine_regs();
+	  siglongjmp(cglobs->cint.CompilerBotch, COMPILER_ERR_BOTCH);
+	}
+      }
+      break;
     case put_var_op:
     case get_var_op:
     case save_b_op:
@@ -2625,6 +2669,10 @@ CheckVoids(compiler_struct *cglobs)
     case get_list_op:
     case get_struct_op:
       cglobs->Uses[cpc->rnd2] = 1;
+      break;
+    case bccall_op:
+      cglobs->Uses[cpc->rnd2] = 1;
+      cglobs->Uses[cpc->rnd4] = 1;
     default:
       break;
     }
@@ -2676,7 +2724,9 @@ checktemp(Int arg, Int rn, compiler_vm_op ic, compiler_struct *cglobs)
   n = v->RCountOfVE - 1;
   while (q != v->LastOpForV && (q = q->nextInst) != NIL) {
     if (q->rnd2 <= 0); /* don't try to reuse REGISTER 0 */
-    else if (usesvar(ic = q->op) && arg == q->rnd1) {
+    else if ((usesvar(ic = q->op) && arg == q->rnd1) ||
+	     (ic == bccall_op && arg == q->rnd3)/*uses_this_var(q, arg)*/) {
+      ic = q->op;
       --n;
       if (ic == put_val_op) {
 	if (target1 == cglobs->MaxCTemps && Needed[q->rnd2] == 0)
@@ -2963,9 +3013,11 @@ c_layout(compiler_struct *cglobs)
     case unify_s_var_op:
     case unify_s_val_op:
 #endif
-    case fetch_args_for_bccall_op:
+      checktemp(arg, rn, ic, cglobs);
+      break;
     case bccall_op:
       checktemp(arg, rn, ic, cglobs);
+      checktemp(cglobs->cint.cpc->rnd3, cglobs->cint.cpc->rnd4, ic, cglobs);
       break;
     case get_atom_op:
     case get_num_op:

C/computils.c

@@ -66,9 +66,6 @@ static char SccsId[] = "%W% %G%";
 #include <string.h>
 #endif
 
-#ifdef DEBUG
-static void ShowOp(const char *, struct PSEUDO *);
-#endif /* DEBUG */
 
 /*
  * The compiler creates an instruction chain which will be assembled after
@@ -288,6 +285,72 @@ Yap_emit_4ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4, struct inte
     }
 }
 
+void
+Yap_emit_5ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4, CELL r5, struct intermediates *cip)
+{
+  PInstr *p;
+  p = (PInstr *) AllocCMem (sizeof (*p)+3*sizeof(CELL), cip);
+  p->op = o;
+  p->rnd1 = r1;
+  p->rnd2 = r2;
+  p->rnd3 = r3;
+  p->rnd4 = r4;
+  p->rnd5 = r5;
+  p->nextInst = NIL;
+  if (cip->cpc == NIL)
+    cip->cpc = cip->CodeStart = p;
+  else
+    {
+      cip->cpc->nextInst = p;
+      cip->cpc = p;
+    }
+}
+
+void
+Yap_emit_6ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4, CELL r5, CELL r6, struct intermediates *cip)
+{
+  PInstr *p;
+  p = (PInstr *) AllocCMem (sizeof (*p)+4*sizeof(CELL), cip);
+  p->op = o;
+  p->rnd1 = r1;
+  p->rnd2 = r2;
+  p->rnd3 = r3;
+  p->rnd4 = r4; 
+  p->rnd5 = r5;
+  p->rnd6 = r6;
+  p->nextInst = NIL;
+  if (cip->cpc == NIL)
+    cip->cpc = cip->CodeStart = p;
+  else
+    {
+      cip->cpc->nextInst = p;
+      cip->cpc = p;
+    }
+}
+
+void
+Yap_emit_7ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4, CELL r5, CELL r6, CELL r7, struct intermediates *cip)
+{
+  PInstr *p;
+  p = (PInstr *) AllocCMem (sizeof (*p)+5*sizeof(CELL), cip);
+  p->op = o;
+  p->rnd1 = r1;
+  p->rnd2 = r2;
+  p->rnd3 = r3;
+  p->rnd4 = r4; 
+  p->rnd5 = r5;
+  p->rnd6 = r6;
+  p->rnd7 = r7;
+  p->nextInst = NIL;
+  if (cip->cpc == NIL)
+    cip->cpc = cip->CodeStart = p;
+  else
+    {
+      cip->cpc->nextInst = p;
+      cip->cpc = p;
+    }
+}
+
 CELL *
 Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size, struct intermediates *cip)
 {
@@ -415,14 +478,51 @@ write_address(CELL address)
     sprintf(buf,"%p",(void *)address);
 #endif
     p[31] = '\0'; /* so that I don't have to worry */
-    Yap_DebugErrorPutc('0');
+    //Yap_DebugErrorPutc('0');
-    Yap_DebugErrorPutc('x');
+    //Yap_DebugErrorPutc('x');
     while (*p != '\0') {
       Yap_DebugErrorPutc(*p++);
     }
   }
 }
 
+static void
+write_special_label(special_label_op arg, special_label_id rn, UInt lab)
+{
+  switch (arg) {
+  case SPECIAL_LABEL_INIT:
+    Yap_DebugErrorPuts("init,");
+    switch (rn) {
+    case SPECIAL_LABEL_EXCEPTION:
+      Yap_DebugErrorPuts("exception,");
+      break;
+    case SPECIAL_LABEL_SUCCESS:
+       Yap_DebugErrorPuts("success,");
+      break;
+    case SPECIAL_LABEL_FAILURE:
+      Yap_DebugErrorPuts("fail,");
+      break;
+    }
+    write_address(lab);
+  case SPECIAL_LABEL_SET:
+    Yap_DebugErrorPuts("set,");
+    break;
+  case SPECIAL_LABEL_CLEAR:
+    Yap_DebugErrorPuts("clear,");
+    switch (rn) {
+    case SPECIAL_LABEL_EXCEPTION:
+      Yap_DebugErrorPuts("exception");
+      break;
+    case SPECIAL_LABEL_SUCCESS:
+       Yap_DebugErrorPuts("success");
+      break;
+    case SPECIAL_LABEL_FAILURE:
+      Yap_DebugErrorPuts("fail");
+      break;
+    }
+  }    
+}
+
 static void
 write_functor(Functor f)
 {
@@ -445,14 +545,38 @@ write_functor(Functor f)
   }
 }
 
-static void
+char *opDesc[] = { mklist(f_arr) };
-ShowOp (const char *f, struct PSEUDO *cpc)
+
+static void send_pred(PredEntry *p)
 {
+  Functor f = p->FunctorOfPred;
+  UInt arity = p->ArityOfPE;
+             Term mod = TermProlog;
+
+            if (p->ModuleOfPred) mod = p->ModuleOfPred;
+             Yap_DebugPlWrite (mod);
+             Yap_DebugErrorPutc (':');
+             if (arity == 0)
+               Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
+            else
+              Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
+             Yap_DebugErrorPutc ('/');
+            Yap_DebugPlWrite (MkIntTerm (arity));
+}
+
+
+static void
+ShowOp (compiler_vm_op ic, const char *f, struct PSEUDO *cpc)
+{
+  CACHE_REGS
   char ch;
   Int arg = cpc->rnd1;
   Int rn = cpc->rnd2;
   CELL *cptr = cpc->arnds;
 
+  if (ic != label_op && ic != label_ctl_op && ic != name_op) {
+    Yap_DebugErrorPutc ('\t');
+  }
   while ((ch = *f++) != 0)
     {
       if (ch == '%')
@@ -466,6 +590,19 @@ ShowOp (const char *f, struct PSEUDO *cpc)
 		Yap_DebugPlWrite(MkIntTerm(arg));
 		break;
 #endif
+	  case '2':
+	    {
+	      Ventry *v = (Ventry *) cpc->rnd3;
+	      Yap_DebugErrorPutc (v->KindOfVE == PermVar ? 'Y' : 'X');
+	      Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs));
+	      Yap_DebugErrorPutc (',');
+	      Yap_DebugErrorPutc ('A');
+	      Yap_DebugPlWrite (MkIntegerTerm (cpc->rnd4));
+	      Yap_DebugErrorPutc (',');
+	      send_pred( RepPredProp((Prop)(cpc->rnd5)) );
+	    }
+	    break;
+
 	  case 'a':
 	  case 'n':
 	  case 'S':
@@ -474,7 +611,6 @@ ShowOp (const char *f, struct PSEUDO *cpc)
 	  case 'b':
 	    /* write a variable bitmap for a call */
 	    {
-	      CACHE_REGS
 	      int max = arg/(8*sizeof(CELL)), i;
 	      CELL *ptr = cptr;
 	      for (i = 0; i <= max; i++) {
@@ -485,6 +621,9 @@ ShowOp (const char *f, struct PSEUDO *cpc)
 	  case 'l':
 	    write_address (arg);
 	    break;
+	  case 'L':
+	    write_special_label (arg, rn, cpc->rnd3);
+	    break;
 	  case 'B':
 	    {
 	      char s[32];
@@ -494,10 +633,7 @@ ShowOp (const char *f, struct PSEUDO *cpc)
 	    }
 	    break;
 	  case 'd':
-	    {
+	    Yap_DebugPlWrite (MkIntegerTerm (arg));
-	      CACHE_REGS
-	      Yap_DebugPlWrite (MkIntegerTerm (arg));
-	    }
 	    break;
 	  case 'z':
 	    Yap_DebugPlWrite (MkIntTerm (cpc->rnd3));
@@ -520,50 +656,17 @@ ShowOp (const char *f, struct PSEUDO *cpc)
 	      Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs));
 	    }
 	    break;
-	  case 'm':
+         case 'm':
-	    Yap_DebugPlWrite (MkAtomTerm ((Atom) arg));
+           Yap_DebugPlWrite (MkAtomTerm ((Atom) arg));
-	    Yap_DebugErrorPutc ('/');
+           Yap_DebugErrorPutc ('/');
-	    Yap_DebugPlWrite (MkIntTerm (rn));
+           Yap_DebugPlWrite (MkIntTerm (rn));
-	    break;
+           break;
 	  case 'p':
-	    {
+	   send_pred( RepPredProp((Prop)(arg) ));
-	      PredEntry *p = RepPredProp ((Prop) arg);
+           break;
-	      Functor f = p->FunctorOfPred;
+         case 'P':
-	      UInt arity = p->ArityOfPE;
+	   send_pred( RepPredProp((Prop)(rn) ));
-	      Term mod;
+           break;
-
-	      if (p->ModuleOfPred)
-		mod = p->ModuleOfPred;
-	      else
-		mod = TermProlog;
-	      Yap_DebugPlWrite (mod);
-	      Yap_DebugErrorPutc (':');
-	      if (arity == 0)
-		Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
-	      else
-		Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
-	      Yap_DebugErrorPutc ('/');
-	      Yap_DebugPlWrite (MkIntTerm (arity));
-	    }
-	    break;
-	  case 'P':
-	    {
-	      PredEntry *p = RepPredProp((Prop) rn);
-	      Functor f = p->FunctorOfPred;
-	      UInt arity = p->ArityOfPE;
-	      Term mod = TermProlog;
-
-	      if (p->ModuleOfPred) mod = p->ModuleOfPred;
-	      Yap_DebugPlWrite (mod);
-	      Yap_DebugErrorPutc (':');
-	      if (arity == 0)
-		Yap_DebugPlWrite (MkAtomTerm ((Atom)f));
-	      else
-		Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f)));
-	      Yap_DebugErrorPutc ('/');
-	      Yap_DebugPlWrite (MkIntTerm (arity));
-	    }
-	    break;
 	  case 'f':
 	    write_functor((Functor)arg);
 	    break;
@@ -667,342 +770,6 @@ ShowOp (const char *f, struct PSEUDO *cpc)
   Yap_DebugErrorPutc ('\n');
 }
 
-static const char *
-getFormat(compiler_vm_op ic) {
-  switch( ic ) {
-  case nop_op:
-    return "nop";
-  case get_var_op:
-    return "get_var\t\t%v,%r";
-  case put_var_op:
-    return  "put_var\t\t%v,%r";
-  case get_val_op:
-    return "get_val\t\t%v,%r";
-  case put_val_op:
-    return "put_val\t\t%v,%r";
-  case get_atom_op:
-    return "get_atom\t%a,%r";
-  case put_atom_op:
-    return "put_atom\t%a,%r";
-  case get_num_op:
-    return "get_num\t\t%n,%r";
-  case put_num_op:
-    return "put_num\t\t%n,%r";
-  case get_float_op:
-    return "get_float\t\t%w,%r";
-  case put_float_op:
-    return "put_float\t\t%w,%r";
-  case get_string_op:
-    return "get_string\t\t%w,%S";
-  case put_string_op:
-    return "put_string\t\t%w,%S";
-  case get_dbterm_op:
-    return "get_dbterm\t%w,%r";
-  case put_dbterm_op:
-    return "put_dbterm\t%w,%r";
-  case get_longint_op:
-    return "get_longint\t\t%w,%r";
-  case put_longint_op:
-    return "put_longint\t\t%w,%r";
-  case get_bigint_op:
-    return "get_bigint\t\t%l,%r";
-  case put_bigint_op:
-    return "put_bigint\t\t%l,%r";
-  case get_list_op:
-    return "get_list\t%r";
-  case put_list_op:
-    return "put_list\t%r";
-  case get_struct_op:
-    return "get_struct\t%f,%r";
-  case put_struct_op:
-    return "put_struct\t%f,%r";
-  case put_unsafe_op:
-    return "put_unsafe\t%v,%r";
-  case unify_var_op:
-    return "unify_var\t%v";
-  case write_var_op:
-    return "write_var\t%v";
-  case unify_val_op:
-    return "unify_val\t%v";
-  case write_val_op:
-    return "write_val\t%v";
-  case unify_atom_op:
-    return "unify_atom\t%a";
-  case write_atom_op:
-    return "write_atom\t%a";
-  case unify_num_op:
-    return "unify_num\t%n";
-  case write_num_op:
-    return "write_num\t%n";
-  case unify_float_op:
-    return "unify_float\t%w";
-  case write_float_op:
-    return "write_float\t%w";
-  case unify_string_op:
-    return "unify_string\t%S";
-  case write_string_op:
-    return "write_string\t%S";
-  case unify_dbterm_op:
-    return "unify_dbterm\t%w";
-  case write_dbterm_op:
-    return "write_dbterm\t%w";
-  case unify_longint_op:
-    return "unify_longint\t%w";
-  case write_longint_op:
-    return "write_longint\t%w";
-  case unify_bigint_op:
-    return "unify_bigint\t%l";
-  case write_bigint_op:
-    return "write_bigint\t%l";
-  case unify_list_op:
-    return "unify_list";
-  case write_list_op:
-    return "write_list";
-  case unify_struct_op:
-    return "unify_struct\t%f";
-  case write_struct_op:
-    return "write_struct\t%f";
-  case write_unsafe_op:
-    return "write_unsafe\t%v";
-  case unify_local_op:
-    return "unify_local\t%v";
-  case write_local_op:
-    return "write local\t%v";
-  case unify_last_list_op:
-    return "unify_last_list";
-  case write_last_list_op:
-    return "write_last_list";
-  case unify_last_struct_op:
-    return "unify_last_struct\t%f";
-  case write_last_struct_op:
-    return "write_last_struct\t%f";
-  case unify_last_var_op:
-    return "unify_last_var\t%v";
-  case unify_last_val_op:
-    return "unify_last_val\t%v";
-  case unify_last_local_op:
-    return "unify_last_local\t%v";
-  case unify_last_atom_op:
-    return "unify_last_atom\t%a";
-  case unify_last_num_op:
-    return "unify_last_num\t%n";
-  case unify_last_float_op:
-     return "unify_last_float\t%w";
-  case unify_last_string_op:
-     return "unify_last_string\t%S";
-  case unify_last_dbterm_op:
-    return "unify_last_dbterm\t%w";
-  case unify_last_longint_op:
-    return "unify_last_longint\t%w";
-  case unify_last_bigint_op:
-    return "unify_last_bigint\t%l";
-  case ensure_space_op:
-    return "ensure_space";
-  case native_op:
-    return "native_code";
-  case f_var_op:
-    return "function_to_var\t%v,%B";
-  case f_val_op:
-    return "function_to_val\t%v,%B";
-  case f_0_op:
-    return "function_to_0\t%B";
-  case align_float_op:
-    return "align_float";
-  case fail_op:
-    return "fail";
-  case cut_op:
-    return "cut";
-  case cutexit_op:
-    return "cutexit";
-  case allocate_op:
-    return "allocate";
-  case deallocate_op:
-    return "deallocate";
-  case tryme_op:
-    return "try_me_else\t\t%l\t%x";
-  case jump_op:
-    return "jump\t\t%l";
-  case jumpi_op:
-    return "jump_in_indexing\t\t%i";
-  case procceed_op:
-    return "proceed";
-  case call_op:
-    return "call\t\t%p,%d,%z";
-  case execute_op:
-    return "execute\t\t%p";
-  case safe_call_op:
-    return "sys\t\t%p";
-  case label_op:
-    return "%l:";
-  case name_op:
-    return "name\t\t%m,%d";
-  case pop_op:
-    return "pop\t\t%l";
-  case retryme_op:
-    return "retry_me_else\t\t%l\t%x";
-  case trustme_op:
-    return "trust_me_else_fail\t%x";
-  case either_op:
-    return "either_me\t\t%l,%d,%z";
-  case orelse_op:
-    return "or_else\t\t%l,%z";
-  case orlast_op:
-    return "or_last";
-  case push_or_op:
-    return "push_or";
-  case pop_or_op:
-    return "pop_or";
-  case pushpop_or_op:
-    return "pushpop_or";
-  case save_b_op:
-    return "save_by\t\t%v";
-  case commit_b_op:
-    return "commit_by\t\t%v";
-  case patch_b_op:
-    return "patch_by\t\t%v";
-  case try_op:
-    return "try\t\t%g\t%x";
-  case retry_op:
-    return "retry\t\t%g\t%x";
-  case trust_op:
-    return "trust\t\t%g\t%x";
-  case try_in_op:
-    return "try_in\t\t%g\t%x";
-  case jump_v_op:
-    return "jump_if_var\t\t%g";
-  case jump_nv_op:
-    return "jump_if_nonvar\t\t%g";
-  case cache_arg_op:
-    return "cache_arg\t%r";
-  case cache_sub_arg_op:
-    return "cache_sub_arg\t%d";
-  case user_switch_op:
-    return "user_switch";
-  case switch_on_type_op:
-    return "switch_on_type\t%h\t%h\t%h\t%h";
-  case switch_c_op:
-    return "switch_on_constant\t%i\n%c";
-  case if_c_op:
-    return "if_constant\t%i\n%c";
-  case switch_f_op:
-    return "switch_on_functor\t%i\n%e";
-  case if_f_op:
-    return "if_functor\t%i\n%e";
-  case if_not_op:
-    return "if_not_then\t%i\t%h\t%h\t%h";
-  case index_dbref_op:
-    return "index_on_dbref";
-  case index_blob_op:
-    return "index_on_blob";
-  case index_long_op:
-    return "index_on_blob";
-  case index_string_op:
-    return "index_on_string";
-  case 	if_nonvar_op:
-    return "check_var\t %r";
-  case save_pair_op:
-    return "save_pair\t%v";
-  case save_appl_op:
-    return "save_appl\t%v";
-  case mark_initialised_pvars_op:
-    return "pvar_bitmap\t%l,%b";
-  case mark_live_regs_op:
-    return "pvar_live_regs\t%l,%b";
-  case fetch_args_vv_op:
-    return "fetch_reg1_reg2\t%N,%N";
-  case fetch_args_cv_op:
-    return "fetch_constant_reg\t%l,%N";
-  case fetch_args_vc_op:
-    return "fetch_reg_constant\t%l,%N";
-  case fetch_args_iv_op:
-    return "fetch_integer_reg\t%d,%N";
-  case fetch_args_vi_op:
-    return "fetch_reg_integer\t%d,%N";
-  case enter_profiling_op:
-    return "enter_profiling\t\t%g";
-  case retry_profiled_op:
-    return "retry_profiled\t\t%g";
-  case count_call_op:
-    return "count_call_op\t\t%g";
-  case count_retry_op:
-    return "count_retry_op\t\t%g";
-  case restore_tmps_op:
-    return "restore_temps\t\t%l";
-  case restore_tmps_and_skip_op:
-    return "restore_temps_and_skip\t\t%l";
-  case enter_lu_op:
-    return "enter_lu";
-  case empty_call_op:
-    return "empty_call\t\t%l,%d";
-#ifdef YAPOR
-  case sync_op:
-    return "sync";
-#endif /* YAPOR */
-#ifdef TABLING
-  case table_new_answer_op:
-    return "table_new_answer";
-  case table_try_single_op:
-    return "table_try_single\t%g\t%x";
-#endif /* TABLING */
-#ifdef TABLING_INNER_CUTS
-  case "clause_with_cut":
-    return clause_with_cut_op;
-#endif /* TABLING_INNER_CUTS */
-#ifdef BEAM
-  "run_op %1,%4",
-  "body_op %1",
-  "endgoal_op",
-  "try_me_op %1,%4",
-  "retry_me_op %1,%4",
-  "trust_me_op %1,%4",
-  "only_1_clause_op %1,%4",
-  "create_first_box_op %1,%4",
-  "create_box_op %1,%4",
-  "create_last_box_op %1,%4",
-  "remove_box_op %1,%4",
-  "remove_last_box_op %1,%4",
-  "prepare_tries",
-  "std_base_op %1,%4",
-  "direct_safe_call",
-  "skip_while_var_op",
-  "wait_while_var_op",
-  "force_wait_op",
-  "write_op",
-  "is_op",
-  "equal_op",
-  "exit",
-#endif
-  case fetch_args_for_bccall_op:
-    return "fetch_args_for_bccall\t%v";
-  case bccall_op:
-    return "binary_cfunc\t\t%v,%P";
-  case blob_op:
-    return "blob\t%O";
-  case string_op:
-    return "string\t%O";
-  case label_ctl_op:
-    return "label_control\t";
-#ifdef SFUNC
-  ,
-  "get_s_f_op\t%f,%r",
-  "put_s_f_op\t%f,%r",
-  "unify_s_f_op\t%f",
-  "write_s_f_op\t%f",
-  "unify_s_var\t%v,%r",
-  "write_s_var\t%v,%r",
-  "unify_s_val\t%v,%r",
-  "write_s_val\t%v,%r",
-  "unify_s_a\t%a,%r",
-  "write_s_a\t%a,%r",
-  "get_s_end",
-  "put_s_end",
-  "unify_s_end",
-  "write_s_end"
-#endif
-    }
-  return NULL;
-}
-
 void
 Yap_ShowCode (struct intermediates *cint)
 {
@@ -1015,8 +782,8 @@ Yap_ShowCode (struct intermediates *cint)
   while (cpc) {
     compiler_vm_op ic = cpc->op;
     if (ic != nop_op) {
-      }
+      ShowOp (ic, opDesc[ic], cpc);
-    ShowOp (getFormat(ic), cpc);
+    }
     cpc = cpc->nextInst;
   }
   Yap_DebugErrorPutc ('\n');

C/dbase.c

@@ -2117,6 +2117,14 @@ p_rcdap( USES_REGS1 )
 }
 
 /* recorda_at(+DBRef,+Term,-Ref) */
+/** @pred  recorda_at(+ _R0_, _T_,- _R_) 
+
+
+Makes term  _T_ the record preceding record with reference
+ _R0_, and unifies  _R_ with its reference.
+
+ 
+*/
 static Int 
 p_rcda_at( USES_REGS1 )
 {
@@ -2159,6 +2167,12 @@ p_rcda_at( USES_REGS1 )
 }
 
 /* recordz(+Functor,+Term,-Ref) */
+/** @pred  recordz(+ _K_, _T_,- _R_) 
+
+Makes term  _T_ the last record under key  _K_ and unifies  _R_
+with its reference.
+ 
+*/
 static Int 
 p_rcdz( USES_REGS1 )
 {
@@ -2255,6 +2269,14 @@ p_rcdzp( USES_REGS1 )
 }
 
 /* recordz_at(+Functor,+Term,-Ref) */
+/** @pred  recordz_at(+ _R0_, _T_,- _R_) 
+
+
+Makes term  _T_ the record following record with reference
+ _R0_, and unifies  _R_ with its reference.
+
+ 
+*/
 static Int 
 p_rcdz_at( USES_REGS1 )
 {
@@ -3747,7 +3769,16 @@ lu_statistics(PredEntry *pe USES_REGS)
     Yap_unify(ARG4,MkIntegerTerm(isz));
 }
 
+/** @pred  key_statistics(+ _K_,- _Entries_,- _Size_,- _IndexSize_) 
 
+
+Returns several statistics for a key  _K_. Currently, it says how
+many entries we have for that key,  _Entries_, what is the
+total size spent on entries,  _Size_, and what is the amount of
+space spent in indices.
+
+ 
+*/
 static Int
 p_key_statistics( USES_REGS1 )
 {
@@ -4434,6 +4465,14 @@ p_decrease_reference_counter( USES_REGS1 )
 }
 
 /* erase(+Ref)	 */
+/** @pred  erase(+ _R_) 
+
+
+The term referred to by  _R_ is erased from the internal database. If
+reference  _R_ does not exist in the database, `erase` just fails.
+
+ 
+*/
 static Int 
 p_current_reference_counter( USES_REGS1 )
 {
@@ -4487,6 +4526,12 @@ p_erase_clause( USES_REGS1 )
 }
  
 /* eraseall(+Key)	 */
+/** @pred  eraseall(+ _K_) 
+
+All terms belonging to the key `K` are erased from the internal
+database. The predicate always succeeds.
+ 
+*/
 static Int 
 p_eraseall( USES_REGS1 )
 {
@@ -4549,6 +4594,14 @@ p_eraseall( USES_REGS1 )
 
 
 /* erased(+Ref) */
+/** @pred  erased(+ _R_) 
+
+
+Succeeds if the object whose database reference is  _R_ has been
+erased.
+
+ 
+*/
 static Int 
 p_erased( USES_REGS1 )
 {
@@ -4678,6 +4731,17 @@ mega_instance(yamop *code, PredEntry *ap USES_REGS)
 }
 
 /* instance(+Ref,?Term) */
+/** @pred  instance(+ _R_,- _T_) 
+
+
+If  _R_ refers to a clause or a recorded term,  _T_ is unified
+with its most general instance. If  _R_ refers to an unit clause
+ _C_, then  _T_ is unified with ` _C_ :- true`. When
+ _R_ is not a reference to an existing clause or to a recorded term,
+this goal fails.
+
+ 
+*/
 static Int 
 p_instance( USES_REGS1 )
 {
@@ -5581,81 +5645,22 @@ with its reference.
  
 */
   Yap_InitCPred("recordz", 3, p_rcdz, SyncPredFlag);
-/** @pred  recordz(+ _K_, _T_,- _R_) 
-
-
-Makes term  _T_ the last record under key  _K_ and unifies  _R_
-with its reference.
-
- 
-*/
   Yap_InitCPred("$still_variant", 2, p_still_variant, SyncPredFlag);
   Yap_InitCPred("recorda_at", 3, p_rcda_at, SyncPredFlag);
-/** @pred  recorda_at(+ _R0_, _T_,- _R_) 
-
-
-Makes term  _T_ the record preceding record with reference
- _R0_, and unifies  _R_ with its reference.
-
- 
-*/
   Yap_InitCPred("recordz_at", 3, p_rcdz_at, SyncPredFlag);
-/** @pred  recordz_at(+ _R0_, _T_,- _R_) 
-
-
-Makes term  _T_ the record following record with reference
- _R0_, and unifies  _R_ with its reference.
-
- 
-*/
   Yap_InitCPred("$recordap", 3, p_rcdap, SyncPredFlag);
   Yap_InitCPred("$recordzp", 3, p_rcdzp, SyncPredFlag);
   Yap_InitCPred("$recordap", 4, p_drcdap, SyncPredFlag);
   Yap_InitCPred("$recordzp", 4, p_drcdzp, SyncPredFlag);
   Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
-/** @pred  erase(+ _R_) 
-
-
-The term referred to by  _R_ is erased from the internal database. If
-reference  _R_ does not exist in the database, `erase` just fails.
-
- 
-*/
   Yap_InitCPred("$erase_clause", 2, p_erase_clause, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("increase_reference_count", 1, p_increase_reference_counter, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("decrease_reference_count", 1, p_decrease_reference_counter, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("current_reference_count", 2, p_current_reference_counter, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
-/** @pred  erased(+ _R_) 
-
-
-Succeeds if the object whose database reference is  _R_ has been
-erased.
-
- 
-*/
   Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
-/** @pred  instance(+ _R_,- _T_) 
-
-
-If  _R_ refers to a clause or a recorded term,  _T_ is unified
-with its most general instance. If  _R_ refers to an unit clause
- _C_, then  _T_ is unified with ` _C_ :- true`. When
- _R_ is not a reference to an existing clause or to a recorded term,
-this goal fails.
-
- 
-*/
   Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag);
   Yap_InitCPred("eraseall", 1, p_eraseall, SafePredFlag|SyncPredFlag);
-/** @pred  eraseall(+ _K_) 
-
-
-All terms belonging to the key `K` are erased from the internal
-database. The predicate always succeeds.
-
- 
-*/
   Yap_InitCPred("$record_stat_source", 4, p_rcdstatp, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$some_recordedp", 1, p_somercdedp, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$first_instance", 3, p_first_instance, SafePredFlag|SyncPredFlag);
@@ -5673,16 +5678,6 @@ database. The predicate always succeeds.
   Yap_InitCPred("$fetch_reference_from_index", 3, p_fetch_reference_from_index, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("key_statistics", 4, p_key_statistics, SyncPredFlag);
-/** @pred  key_statistics(+ _K_,- _Entries_,- _Size_,- _IndexSize_) 
-
-
-Returns several statistics for a key  _K_. Currently, it says how
-many entries we have for that key,  _Entries_, what is the
-total size spent on entries,  _Size_, and what is the amount of
-space spent in indices.
-
- 
-*/
   Yap_InitCPred("$lu_statistics", 5, p_lu_statistics, SyncPredFlag);
   Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag);
   Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag);

C/globals.c

@@ -1370,7 +1370,15 @@ p_nb_getval( USES_REGS1 )
   }
   ge = FindGlobalEntry(AtomOfTerm(t) PASS_REGS);
   if (!ge) {
-    return Yap_unify(TermNil, ARG3);
+    Term t3 = Deref(ARG3);
+    if (IsVarTerm(t3)) 
+      return FALSE;
+    if (IsApplTerm(t3)) {
+      if (FunctorOfTerm(t3) == FunctorEq)
+	return Yap_unify( ArgOfTerm(1, t3) , ArgOfTerm(2, t3) );
+      return FALSE;
+    }
+    return Yap_unify(t3, MkAtomTerm(AtomTrue));
   }
   READ_LOCK(ge->GRWLock);
   to = ge->global;

C/grow.c

@@ -1079,8 +1079,6 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
     case write_local_op:
     case f_var_op:
     case f_val_op:
-    case fetch_args_for_bccall_op:
-    case bccall_op:
     case save_pair_op:
     case save_appl_op:
     case save_b_op:
@@ -1090,6 +1088,10 @@ fix_compiler_instructions(PInstr *pcpc USES_REGS)
     case fetch_args_vc_op:
       pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
       break;
+    case bccall_op:
+      pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
+      pcpc->rnd3 = GlobalAdjust(pcpc->rnd3);
+      break;
     case get_float_op:
     case put_float_op:
     case get_longint_op:

C/init.c

@@ -627,7 +627,7 @@ Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, UInt flags)
       return;
     }
   } 
-  if (pe->PredFlags & CPredFlag) {
+  if (pe->PredFlags & BinaryPredFlag) {
     flags = update_flags_from_prolog(flags, pe);
     p_code = pe->CodeOfPred;
     /* already exists */
@@ -651,7 +651,7 @@ Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, UInt flags)
       }
     }
   }
-  pe->PredFlags = flags | StandardPredFlag | CPredFlag;
+  //pe->PredFlags = flags | StandardPredFlag;
   pe->CodeOfPred = p_code;
   pe->cs.d_code = cmp_code;
   pe->ModuleOfPred = CurrentModule;
@@ -1054,6 +1054,7 @@ InitSWIAtoms(void)
   int j=0;
   MaxAtomTranslations = 2*N_SWI_ATOMS ;
   SWI_Atoms = (Atom *)malloc(sizeof(Atom)*MaxAtomTranslations);
+  SWI_Functors = (Functor *)malloc(sizeof(Functor)*2*N_SWI_ATOMS);
 #include "iswiatoms.h"
   Yap_InitSWIHash();
   ATOM_ = PL_new_atom("");

C/iopreds.c

@@ -199,6 +199,14 @@ Yap_DebugPutc(int sno, wchar_t ch)
   return (Sputc(ch, GLOBAL_stderr));
 }
 
+static int 
+Yap_DebugPuts(int sno, const char * s)
+{
+  if (GLOBAL_Option['l' - 96])
+    (void) fputs(s, GLOBAL_logfile);
+  return (Sfputs(s, GLOBAL_stderr));
+}
+
 void
 Yap_DebugPlWrite(Term t)
 {
@@ -212,6 +220,13 @@ Yap_DebugErrorPutc(int c)
    Yap_DebugPutc (LOCAL_c_error_stream, c);
 }
 
+void 
+Yap_DebugErrorPuts(const char *s)
+{
+  CACHE_REGS
+   Yap_DebugPuts (LOCAL_c_error_stream, s);
+}
+
 #endif
 
 

C/qlyr.c

@@ -44,7 +44,8 @@ typedef enum {
   BAD_ATOM = 8,
   MISMATCH = 9,
   INCONSISTENT_CPRED = 10,
-  BAD_READ = 11
+  BAD_READ = 11,
+  BAD_HEADER = 12
 } qlfr_err_t;
 
 static char *
@@ -77,7 +78,7 @@ static void
 QLYR_ERROR(qlfr_err_t my_err)
 {
   Yap_Error(SAVED_STATE_ERROR,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); 
-  exit(1);
+  Yap_exit(1);
 }
 
 static Atom
@@ -691,11 +692,56 @@ read_tag(IOSTREAM *stream)
   return ch;
 }
 
-static void
+static bool
-read_header(IOSTREAM *stream)
+checkChars(IOSTREAM *stream, char s[])
 {
-  int ch;
+  int ch, c;
+  char *p = s;
+  
+  while ((ch = *p++)) {
+    if ((c  = read_byte(stream)) != ch ) {
+      return false;
+    }
+  }
+  return TRUE;
+}
+
+static Atom
+get_header(IOSTREAM *stream)
+{
+  char s[256], *p = s, ch;
+  Atom at;
+
+  if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" ))
+    return NIL;
+  while ((ch = read_byte(stream)) != '\n');
+  if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " ))
+    return NIL;
+  while ((ch = read_byte(stream)) != ',')
+    *p++ = ch;
+  *p++ = '\0';
+  at = Yap_LookupAtom( s );
   while ((ch = read_byte(stream)));
+  return at;
+}
+
+static Int
+p_get_header( USES_REGS1 )
+{
+  IOSTREAM *stream;
+  Term t1 = Deref(ARG1);
+  Atom at;
+
+  if (IsVarTerm(t1)) {
+    Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
+    return FALSE;
+  }
+  if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
+    return FALSE;
+  }
+  if ((at = get_header( stream )) == NIL)
+    return FALSE;
+  return Yap_unify( ARG2, MkAtomTerm( at ) );
 }
 
 static void
@@ -801,6 +847,7 @@ ReadHash(IOSTREAM *stream)
 	pe = RepPredProp(PredPropByAtomAndMod(a,mod));
       }
     } else {
+      /* IDB */
       if (arity == (UInt)-1) {
 	UInt i = read_UInt(stream);
 	pe = Yap_FindLUIntKey(i);
@@ -808,12 +855,18 @@ ReadHash(IOSTREAM *stream)
 	Atom oa = (Atom)read_UInt(stream);
 	Atom a = LookupAtom(oa);
 	pe = RepPredProp(PredPropByAtomAndMod(a,mod));
+	pe->PredFlags |= AtomDBPredFlag;
       } else {
 	Functor of = (Functor)read_UInt(stream);
 	Functor f = LookupFunctor(of);
 	pe = RepPredProp(PredPropByFuncAndMod(f,mod));
       }
+      pe->PredFlags |= LogUpdatePredFlag;
       pe->ArityOfPE = 3;
+      if (pe->OpcodeOfPred == UNDEF_OPCODE) {
+	pe->OpcodeOfPred = Yap_opcode(_op_fail);
+	pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
+      }
     }
     InsertPredEntry(ope, pe);
   }
@@ -959,7 +1012,10 @@ read_pred(IOSTREAM *stream, Term mod) {
   if (ap->PredFlags & IndexedPredFlag) {
     Yap_RemoveIndexation(ap);
   }
-
+  //if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
+  //  printf("   %s/%ld\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE);
+  //else if (ap->ModuleOfPred != IDB_MODULE)
+  //  printf("   %s/%ld\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE);
 #if SIZEOF_INT_P==4
   fl1 = flags & ((UInt)STATIC_PRED_FLAGS);
   ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS);
@@ -1013,7 +1069,6 @@ static void
 read_module(IOSTREAM *stream) {
   qlf_tag_t x;
 
-  read_header(stream);
   InitHash();
   ReadHash(stream);
   while ((x = read_tag(stream)) == QLY_START_MODULE) {
@@ -1070,14 +1125,12 @@ p_read_program( USES_REGS1 )
     Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3");
     return FALSE;
   }
-  if (!IsAtomTerm(t1)) {
+  if ((stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
-    Yap_Error(TYPE_ERROR_ATOM,t1,"read_program/3");
-    return(FALSE);
-  }
-  if (!(stream = Yap_GetInputStream(AtomOfTerm(t1))) ) {
     return FALSE;
   }
   YAP_Reset( YAP_RESET_FROM_RESTORE );
+  if (get_header( stream ) == NIL)
+    return FALSE;
   read_module(stream);
   Sclose( stream );
   /* back to the top level we go */
@@ -1092,6 +1145,8 @@ Yap_Restore(char *s, char *lib_dir)
   if (!stream) 
     return -1;
   GLOBAL_RestoreFile = s;
+  if (get_header( stream ) == NIL)
+    return FALSE;
   read_module(stream);
   Sclose( stream );
   GLOBAL_RestoreFile = NULL;
@@ -1102,7 +1157,9 @@ Yap_Restore(char *s, char *lib_dir)
 void Yap_InitQLYR(void)
 {
   Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag);
+  Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag);
   Yap_InitCPred("$qload_program", 1, p_read_program, SyncPredFlag|UserCPredFlag);
+  Yap_InitCPred("$q_header", 2, p_get_header, SyncPredFlag|UserCPredFlag);
   if (FALSE) {
     restore_codes();
   }

C/qlyw.c

@@ -771,18 +771,18 @@ save_ops(IOSTREAM *stream, Term mod) {
 }
 
 static int
-save_header(IOSTREAM *stream)
+save_header(IOSTREAM *stream, char type[])
 {
   char     msg[256];
 
-  sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s", YAP_BINDIR, YAP_FULL_VERSION);
+  sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%s %s\n", YAP_BINDIR, type, YAP_FULL_VERSION);
   return save_bytes(stream, msg, strlen(msg)+1);
 }
 
 static size_t
 save_module(IOSTREAM *stream, Term mod) {
   PredEntry *ap = Yap_ModulePred(mod);
-  save_header( stream );
+  save_header( stream, "saved module," );
   InitHash();
   ModuleAdjust(mod);
   while (ap) {
@@ -813,7 +813,7 @@ save_program(IOSTREAM *stream) {
   ModEntry *me = CurrentModules;
 
   InitHash();
-  save_header( stream );
+  save_header( stream, "saved state," );
   /* should we allow the user to see hidden predicates? */
   while (me) {
     PredEntry *pp;
@@ -855,7 +855,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
   ModEntry *me = CurrentModules;
 
   InitHash();
-  save_header( stream );
+  save_header( stream, "saved file," );
   /* should we allow the user to see hidden predicates? */
   while (me) {
     PredEntry *pp;
@@ -865,6 +865,7 @@ save_file(IOSTREAM *stream, Atom FileName) {
       pp = PredEntryAdjust(pp);
       if (pp &&
 	  !(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
+	  pp->ModuleOfPred != IDB_MODULE &&
 	  pp->src.OwnerFile == FileName) {
 	CHECK(mark_pred(pp));
       }
@@ -883,8 +884,12 @@ save_file(IOSTREAM *stream, Atom FileName) {
     CHECK(save_tag(stream, QLY_START_MODULE));
     CHECK(save_UInt(stream, (UInt)MkAtomTerm(me->AtomOfME)));
     while (pp != NULL) {
-      CHECK(save_tag(stream, QLY_START_PREDICATE));
+      if (pp &&
-      CHECK(save_pred(stream, pp));
+	  !(pp->PredFlags & (MultiFileFlag|NumberDBPredFlag|AtomDBPredFlag|CPredFlag|AsmPredFlag|UserCPredFlag)) &&
+	  pp->src.OwnerFile == FileName) {
+	CHECK(save_tag(stream, QLY_START_PREDICATE));
+	CHECK(save_pred(stream, pp));
+      }
       pp = pp->NextPredOfModule;
     }
     CHECK(save_tag(stream, QLY_END_PREDICATES));
@@ -966,9 +971,6 @@ p_save_file( USES_REGS1 )
   if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
     return FALSE;
   }
-  if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
-    return FALSE;
-  }
   if (IsVarTerm(tfile)) {
     Yap_Error(INSTANTIATION_ERROR,tfile,"save_file/2");
     return FALSE;
@@ -984,7 +986,7 @@ void Yap_InitQLY(void)
 {
   Yap_InitCPred("$qsave_module_preds", 2, p_save_module_preds, SyncPredFlag|UserCPredFlag);
   Yap_InitCPred("$qsave_program", 1, p_save_program, SyncPredFlag|UserCPredFlag);
-  Yap_InitCPred("$qsave_file", 2, p_save_file, SyncPredFlag|UserCPredFlag);
+  Yap_InitCPred("$qsave_file_preds", 2, p_save_file, SyncPredFlag|UserCPredFlag);
   if (FALSE) {
     restore_codes();
   }

CXX/yapi.cpp

@@ -509,9 +509,8 @@ bool YAPQuery::next()
   if (q_state == 0) {
     // extern void toggle_low_level_trace(void);
       //toggle_low_level_trace();
-	  { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR,  __FUNCTION__, "next %p", HR) ; }
       result = (bool)YAP_EnterGoal((YAP_PredEntryPtr)ap, q_g, &q_h);
-      { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR,  __FUNCTION__, "done") ; }
+
   } else {
       LOCAL_AllowRestart = this->q_open;
       result = (bool)YAP_RetryGoal(&q_h);

H/Yapproto.h

@@ -283,6 +283,7 @@ void   *Yap_GetOutputStream(Atom at);
 #ifdef DEBUG
 extern void Yap_DebugPlWrite (Term t);
 extern void Yap_DebugErrorPutc (int n);
+extern void Yap_DebugErrorPuts (const char *s);
 #endif
 void    Yap_PlWriteToStream(Term, int, int);
 /* depth_lim.c */

H/compile.h

@@ -18,197 +18,222 @@
 /* consult stack management */
 
 /* virtual machine instruction op-codes					*/
-typedef enum compiler_op {
+#define mklist0(f) \
-  nop_op,
+    f( nop_op, "nop") \
-  get_var_op,
+    f( get_var_op, "get_var\t\t%v,%r") \
-  put_var_op,
+    f( put_var_op, "put_var\t\t%v,%r") \
-  get_val_op,
+    f( get_val_op, "get_val\t\t%v,%r") \
-  put_val_op,
+    f( put_val_op, "put_val\t\t%v,%r") \
-  get_atom_op,
+    f( get_atom_op, "get_atom\t%a,%r") \
-  put_atom_op,
+    f( put_atom_op, "put_atom\t%a,%r") \
-  get_num_op,
+    f( get_num_op, "get_num\t\t%n,%r") \
-  put_num_op,
+    f( put_num_op, "put_num\t\t%n,%r") \
-  get_float_op,
+    f( get_float_op,"get_float\t\t%w,%r" ) \
-  put_float_op,
+    f( put_float_op, "put_float\t\t%w,%r") \
-  get_dbterm_op,
+    f( get_dbterm_op, "get_dbterm\t%w,%r") \
-  put_dbterm_op,
+    f( put_dbterm_op, "put_dbterm\t%w,%r") \
-  get_longint_op,
+    f( get_longint_op, "get_longint\t\t%w,%r") \
-  put_longint_op,
+    f( put_longint_op, "put_longint\t\t%w,%r") \
-  get_string_op,
+    f( get_string_op, "get_string\t\t%w,%S") \
-  put_string_op,
+    f( put_string_op, "put_string\t\t%w,%S") \
-  get_bigint_op,
+    f( get_bigint_op, "get_bigint\t\t%l,%r") \
-  put_bigint_op,
+    f( put_bigint_op, "put_bigint\t\t%l,%r") \
-  get_list_op,
+    f( get_list_op, "get_list\t%r") \
-  put_list_op,
+    f( put_list_op, "put_list\t%r") \
-  get_struct_op,
+    f( get_struct_op, "get_struct\t%f,%r") \
-  put_struct_op,
+    f( put_struct_op, "put_struct\t%f,%r") \
-  put_unsafe_op,
+    f( put_unsafe_op, "put_unsafe\t%v,%r") \
-  unify_var_op,
+    f( unify_var_op, "unify_var\t%v") \
-  write_var_op,
+    f( write_var_op, "write_var\t%v") \
-  unify_val_op,
+    f( unify_val_op, "unify_val\t%v") \
-  write_val_op,
+    f( write_val_op, "write_val\t%v") \
-  unify_atom_op,
+    f( unify_atom_op, "unify_atom\t%a") \
-  write_atom_op,
+    f( write_atom_op, "write_atom\t%a") \
-  unify_num_op,
+    f( unify_num_op, "unify_num\t%n") \
-  write_num_op,
+    f( write_num_op, "write_num\t%n") \
-  unify_float_op,
+    f( unify_float_op, "unify_float\t%w") \
-  write_float_op,
+    f( write_float_op, "write_float\t%w") \
-  unify_dbterm_op,
+    f( unify_dbterm_op, "unify_dbterm\t%w") \
-  write_dbterm_op,
+    f( write_dbterm_op, "write_dbterm\t%w") \
-  unify_longint_op,
+    f( unify_longint_op, "unify_longint\t%w") \
-  write_longint_op,
+    f( write_longint_op, "write_longint\t%w") \
-  unify_string_op,
+    f( unify_string_op, "unify_string\t%S") \
-  write_string_op,
+      f( write_string_op, "write_string\t%S")	\
-  unify_bigint_op,
+      f( unify_bigint_op, "unify_bigint\t%l")	\
-  write_bigint_op,
+    f( write_bigint_op, "write_bigint\t%l") \
-  unify_list_op,
+    f( unify_list_op, "unify_list") \
-  write_list_op,
+    f( write_list_op, "write_list") \
-  unify_struct_op,
+    f( unify_struct_op, "unify_struct\t%f") \
-  write_struct_op,
+    f( write_struct_op, "write_struct\t%f") \
-  write_unsafe_op,
+    f( write_unsafe_op, "write_unsafe\t%v") \
-  unify_local_op,
+    f( unify_local_op, "unify_local\t%v") \
-  write_local_op,
+    f( write_local_op, "write local\t%v") \
-  unify_last_list_op,
+    f( unify_last_list_op, "unify_last_list") \
-  write_last_list_op,
+    f( write_last_list_op, "write_last_list") \
-  unify_last_struct_op,
+    f( unify_last_struct_op, "unify_last_struct\t%f") \
-  write_last_struct_op,
+    f( write_last_struct_op, "write_last_struct\t%f") \
-  unify_last_var_op,
+    f( unify_last_var_op, "unify_last_var\t%v") \
-  unify_last_val_op,
+    f( unify_last_val_op, "unify_last_val\t%v") \
-  unify_last_local_op,
+    f( unify_last_local_op, "unify_last_local\t%v") \
-  unify_last_atom_op,
+    f( unify_last_atom_op, "unify_last_atom\t%a") \
-  unify_last_num_op,
+    f( unify_last_num_op, "unify_last_num\t%n") \
-  unify_last_float_op,
+    f( unify_last_float_op, "unify_last_float\t%w") \
-  unify_last_dbterm_op,
+    f( unify_last_dbterm_op, "unify_last_dbterm\t%w") \
-  unify_last_longint_op,
+    f( unify_last_longint_op, "unify_last_longint\t%w") \
-  unify_last_string_op,
+    f( unify_last_string_op, "unify_last_string\t%S") \
-  unify_last_bigint_op,
+    f( unify_last_bigint_op, "unify_last_bigint\t%l") \
-  ensure_space_op,
+    f( ensure_space_op, "ensure_space") \
-  native_op,
+    f( native_op, "native_code") \
-  f_var_op,
+    f( f_var_op, "function_to_var\t%v,%B") \
-  f_val_op,
+    f( f_val_op, "function_to_val\t%v,%B") \
-  f_0_op,
+    f( f_0_op, "function_to_0\t%B") \
-  align_float_op,
+    f( align_float_op, "align_float") \
-  fail_op,
+    f( fail_op, "fail") \
-  cut_op,
+    f( cut_op, "cut") \
-  cutexit_op,
+    f( cutexit_op, "cutexit") \
-  allocate_op,
+    f( allocate_op, "allocate") \
-  deallocate_op,
+    f( deallocate_op, "deallocate") \
-  tryme_op,
+    f( tryme_op, "try_me_else\t\t%l\t%x") \
-  jump_op,
+    f( jump_op, "jump\t\t%l") \
-  jumpi_op,
+    f( jumpi_op, "jump_in_indexing\t\t%i") \
-  procceed_op,
+    f( procceed_op, "proceed") \
-  call_op,
+    f( call_op, "call\t\t%p,%d,%z") \
-  execute_op,
+    f( execute_op, "execute\t\t%p") \
-  safe_call_op,
+    f( safe_call_op, "sys\t\t%p") \
-  label_op,
+    f( label_op, "%l:") \
-  name_op,
+    f( name_op, "name\t\t%m,%d") \
-  pop_op,
+    f( pop_op, "pop\t\t%l") \
-  retryme_op,
+    f( retryme_op, "retry_me_else\t\t%l\t%x") \
-  trustme_op,
+    f( trustme_op, "trust_me_else_fail\t%x") \
-  either_op,
+    f( either_op, "either_me\t\t%l,%d,%z") \
-  orelse_op,
+    f( orelse_op, "or_else\t\t%l,%z") \
-  orlast_op,
+    f( orlast_op, "or_last") \
-  push_or_op,
+    f( push_or_op, "push_or") \
-  pushpop_or_op,
+    f( pushpop_or_op, "pushpop_or") \
-  pop_or_op,
+    f( pop_or_op, "pop_or") \
-  save_b_op,
+    f( save_b_op, "save_by\t\t%v") \
-  commit_b_op,
+    f( commit_b_op, "commit_by\t\t%v") \
-  patch_b_op,
+    f( patch_b_op, "patch_by\t\t%v") \
-  try_op,
+    f( try_op, "try\t\t%g\t%x") \
-  retry_op,
+    f( retry_op, "retry\t\t%g\t%x") \
-  trust_op,
+    f( trust_op, "trust\t\t%g\t%x") \
-  try_in_op,
+    f( try_in_op, "try_in\t\t%g\t%x") \
-  jump_v_op,
+    f( jump_v_op, "jump_if_var\t\t%g") \
-  jump_nv_op,
+    f( jump_nv_op, "jump_if_nonvar\t\t%g") \
-  cache_arg_op,
+    f( cache_arg_op, "cache_arg\t%r") \
-  cache_sub_arg_op,
+    f( cache_sub_arg_op, "cache_sub_arg\t%d") \
-  user_switch_op,
+    f( user_switch_op, "user_switch") \
-  switch_on_type_op,
+    f( switch_on_type_op, "switch_on_type\t%h\t%h\t%h\t%h") \
-  switch_c_op,
+    f( switch_c_op, "switch_on_constant\t%i\n%c") \
-  if_c_op,
+    f( if_c_op, "if_constant\t%i\n%c") \
-  switch_f_op,
+    f( switch_f_op, "switch_on_functor\t%i\n%e") \
-  if_f_op,
+    f( if_f_op, "if_functor\t%i\n%e") \
-  if_not_op,
+    f( if_not_op, "if_not_then\t%i\t%h\t%h\t%h") \
-  index_dbref_op,
+    f( index_dbref_op, "index_on_dbref") \
-  index_blob_op,
+    f( index_blob_op, "index_on_blob") \
-  index_string_op,
+    f( index_string_op, "index_on_string") \
-  index_long_op,
+    f( index_long_op, "index_on_blob") \
-  if_nonvar_op,
+    f( if_nonvar_op, "check_var\t %r") \
-  save_pair_op,
+    f( save_pair_op, "save_pair\t%v") \
-  save_appl_op,
+    f( save_appl_op, "save_appl\t%v") \
-  mark_initialised_pvars_op,
+    f( mark_initialised_pvars_op, "pvar_bitmap\t%l,%b") \
-  mark_live_regs_op,
+    f( mark_live_regs_op, "pvar_live_regs\t%l,%b") \
-  fetch_args_vv_op,
+    f( fetch_args_vv_op, "fetch_reg1_reg2\t%N,%N") \
-  fetch_args_cv_op,
+    f( fetch_args_cv_op, "fetch_constant_reg\t%l,%N") \
-  fetch_args_vc_op,
+    f( fetch_args_vc_op, "fetch_reg_constant\t%l,%N") \
-  fetch_args_iv_op,
+    f( fetch_args_iv_op, "fetch_integer_reg\t%d,%N") \
-  fetch_args_vi_op,
+    f( fetch_args_vi_op, "fetch_reg_integer\t%d,%N") \
-  enter_profiling_op,
+    f( enter_profiling_op, "enter_profiling\t\t%g") \
-  retry_profiled_op,
+    f( retry_profiled_op, "retry_profiled\t\t%g") \
-  count_call_op,
+    f( count_call_op, "count_call_op\t\t%g") \
-  count_retry_op,
+    f( count_retry_op, "count_retry_op\t\t%g") \
-  restore_tmps_op,
+    f( restore_tmps_op, "restore_temps\t\t%l") \
-  restore_tmps_and_skip_op,
+    f( restore_tmps_and_skip_op, "restore_temps_and_skip\t\t%l") \
-  enter_lu_op,
+    f( enter_lu_op, "enter_lu") \
-  empty_call_op,
+    f( empty_call_op, "empty_call\t\t%l,%d") \
+    f( bccall_op, "binary_cfunc\t\t%v,%r,%2") \
+    f( blob_op, "blob\t%O") \
+    f( string_op, "string\t%O") \
+    f( label_ctl_op, "label_control\t")
 #ifdef YAPOR
-  sync_op,
+#define mklist1(f) \
+    mklist0(f) \
+    f( sync_op, "sync")
+#else
+#define mklist1(f) mklist0(f)
 #endif /* YAPOR */
 #ifdef TABLING
-  table_new_answer_op,
+#define mklist2(f) \
-  table_try_single_op,
+    mklist1(f) \
+    f( table_new_answer_op, "table_new_answer") \
+    f( table_try_single_op, "table_try_single\t%g\t%x")
+#else
+#define mklist2(f) mklist1(f)
 #endif /* TABLING */
 #ifdef TABLING_INNER_CUTS
-  clause_with_cut_op,
+#define mklist3(f) \
+    mklist2(f) \
+    f( clause_with_cut_op, "clause_with_cut")
+#else
+#define mklist3(f) mklist2(f)
 #endif /* TABLING_INNER_CUTS */
 #ifdef BEAM
-  run_op,
+#define mklist4(f) \
-  body_op,
+    mklist3(f) \
-  endgoal_op,
+    f( run_op, "run_op %1,%4") \
-  try_me_op,
+    f( body_op, "body_op %1") \
-  retry_me_op,
+    f( endgoal_op, "endgoal_op") \
-  trust_me_op,
+    f( try_me_op, "try_me_op %1,%4") \
-  only_1_clause_op,
+    f( retry_me_op, "retry_me_op %1,%4") \
-  create_first_box_op,
+    f( trust_me_op, "trust_me_op %1,%4") \
-  create_box_op,
+    f( only_1_clause_op, "only_1_clause_op %1,%4") \
-  create_last_box_op,
+    f( create_first_box_op, "create_first_box_op %1,%4") \
-  remove_box_op,
+    f( create_box_op, "create_box_op %1,%4") \
-  remove_last_box_op,
+    f( create_last_box_op, "create_last_box_op %1,%4") \
-  prepare_tries,
+    f( remove_box_op, "remove_box_op %1,%4") \
-  std_base_op,
+    f( remove_last_box_op, "remove_last_box_op %1,%4" ) \
-  direct_safe_call_op,
+    f( prepare_tries, "prepare_tries") \
-  commit_op,
+    f( std_base_op, "std_base_op %1,%4") \
-  skip_while_var_op,
+    f( direct_safe_call_op, "direct_safe_call") \
-  wait_while_var_op,
+    f( commit_op, ) \
-  force_wait_op,
+    f( skip_while_var_op, "skip_while_var_op") \
-  write_op,
+    f( wait_while_var_op, "wait_while_var_op") \
-  equal_op,
+    f( force_wait_op, "force_wait_op") \
-  exit_op, 
+    f( is_op, "is_op") \
+    f( write_op, "write_op") \
+    f( equal_op, "equal_op") \
+    f( exit_op, "exit")
+#else
+#define mklist4(f) mklist3(f)
 #endif
-  fetch_args_for_bccall_op,
-  bccall_op,
-  blob_op,
-  string_op,
-  label_ctl_op
 #ifdef SFUNC
-  ,
+#define mklist(f) \
-  get_s_f_op,
+    mklist4(f) \
-  put_s_f_op,
+    f( get_s_f_op, "get_s_f_op\t%f,%r") \
-  unify_s_f_op,
+    f( put_s_f_op, "put_s_f_op\t%f,%r") \
-  write_s_f_op,
+    f( unify_s_f_op, "unify_s_f_op\t%f") \
-  unify_s_var_op,
+    f( write_s_f_op, "write_s_f_op\t%f") \
-  write_s_var_op,
+    f( unify_s_var_op, "unify_s_var\t%v,%r") \
-  unify_s_val_op,
+    f( write_s_var_op, "write_s_var\t%v,%r") \
-  write_s_val_op,
+    f( unify_s_val_op, "unify_s_val\t%v,%r") \
-  unify_s_a_op,
+    f( write_s_val_op, "write_s_val\t%v,%r") \
-  write_s_a_op,
+    f( unify_s_a_op, "unify_s_a\t%a,%r") \
-  get_s_end_op,
+    f( write_s_a_op, "write_s_a\t%a,%r") \
-  put_s_end_op,
+    f( get_s_end_op, "get_s_end") \
-  unify_s_end_op,
+    f( put_s_end_op, "put_s_end") \
-  write_s_end_op,
+    f( unify_s_end_op, "unify_s_end") \
+    f( write_s_end_op, "write_s_end")
+#else
+#define mklist(f) mklist4(f)
 #endif
 
-} compiler_vm_op;
+#define f_enum(x, y) x,
+#define f_arr(x, y)  y,
+
+enum compiler_op { mklist(f_enum) };
+
+typedef enum compiler_op compiler_vm_op;
+
 
 typedef struct PSEUDO {
 	struct PSEUDO *nextInst;
@@ -228,6 +253,10 @@ typedef struct PSEUDO {
 #define rnd2  ops.oprnd2
 #define rnd3  ops.opseqt[1]
 #define rnd4  ops.opseqt[2]
+#define rnd5  ops.opseqt[3]
+#define rnd6  ops.opseqt[4]
+#define rnd7  ops.opseqt[5]
+#define rnd8  ops.opseqt[6]
 
 typedef struct VENTRY {
   CELL SelfOfVE;
@@ -325,8 +354,8 @@ typedef enum special_label_op_enum {
 #define save_appl_flag	   0x10002
 #define save_pair_flag	   0x10004
 #define f_flag		   0x10008
-#define bt1_flag	   0x10010
+#define bt_flag		   0x10010
-#define bt2_flag	   0x10020
+#define bt2_flag	   0x10020 // unused
 #define patch_b_flag	   0x10040
 #define init_v_flag	   0x10080
 
@@ -340,6 +369,9 @@ yamop  *Yap_assemble(int,Term,struct pred_entry *,int, struct intermediates *, U
 void	Yap_emit(compiler_vm_op,Int,CELL, struct intermediates *);
 void	Yap_emit_3ops(compiler_vm_op,CELL,CELL,CELL, struct intermediates *);
 void	Yap_emit_4ops(compiler_vm_op,CELL,CELL,CELL,CELL, struct intermediates *);
+void	Yap_emit_5ops(compiler_vm_op,CELL,CELL,CELL,CELL,CELL, struct intermediates *);
+void	Yap_emit_6ops(compiler_vm_op,CELL,CELL,CELL,CELL,CELL,CELL, struct intermediates *);
+void	Yap_emit_7ops(compiler_vm_op,CELL,CELL,CELL,CELL,CELL,CELL,CELL, struct intermediates *);
 CELL   *Yap_emit_extra_size(compiler_vm_op,CELL,int, struct intermediates *);
 char   *Yap_AllocCMem(UInt, struct intermediates *);
 void    Yap_ReleaseCMem(struct intermediates *);

H/hstruct.h

@@ -288,7 +288,7 @@
   struct record_list  *yap_records;
 
   Atom  *swi_atoms;
-  Functor  swi_functors[N_SWI_FUNCTORS];
+  Functor  *swi_functors;
   struct swi_reverse_hash  swi_reverse_hash[N_SWI_HASH];
 
   Int  atom_translations;

library/expand_macros.yap

@@ -5,429 +5,16 @@
 %%
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-:- module(expand_macros, []).
-
 :- use_module(library(lists), [append/3]).
 :- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
 :- use_module(library(error), [must_be/2]).
 :- use_module(library(occurs), [sub_term/2]).
 
-:- multifile user:goal_expansion/3.
-
 :- dynamic number_of_expansions/1.
 
 number_of_expansions(0).
 
-user:goal_expansion(checklist(Meta, List), Mod, Goal) :-
-	goal_expansion_allowed(checklist(Meta, List), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(checklist, 2, Proto, GoalName),
-	append(MetaVars, [List], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],
-	append_args(HeadPrefix, [[]], Base),
-	append_args(HeadPrefix, [[In|Ins]], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
 
-user:goal_expansion(maplist(Meta, List), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, List), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(maplist, 2, Proto, GoalName),
-	append(MetaVars, [List], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],
-	append_args(HeadPrefix, [[]], Base),
-	append_args(HeadPrefix, [[In|Ins]], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(maplist(Meta, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, ListIn, ListOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(maplist, 3, Proto, GoalName),
-	append(MetaVars, [ListIn, ListOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
-	append_args(Pred, [In, Out], Apply),
-	append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(maplist(Meta, L1, L2, L3), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, L1, L2, L3), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(maplist, 4, Proto, GoalName),
-	append(MetaVars, [L1, L2, L3], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], [], []], Base),
-	append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s]], RecursionHead),
-	append_args(Pred, [A1, A2, A3], Apply),
-	append_args(HeadPrefix, [A1s, A2s, A3s], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(maplist(Meta, L1, L2, L3, L4), Mod, Goal) :-
-	goal_expansion_allowed(maplist(Meta, L1, L2, L3, L4), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(maplist, 5, Proto, GoalName),
-	append(MetaVars, [L1, L2, L3, L4], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], [], [], []], Base),
-	append_args(HeadPrefix, [[A1|A1s], [A2|A2s], [A3|A3s], [A4|A4s]], RecursionHead),
-	append_args(Pred, [A1, A2, A3, A4], Apply),
-	append_args(HeadPrefix, [A1s, A2s, A3s, A4s], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(selectlist(Meta, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(selectlist(Meta, ListIn, ListOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(selectlist, 3, Proto, GoalName),
-	append(MetaVars, [ListIn, ListOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         (Apply -> Outs = [In|NOuts]; Outs = NOuts),
-			 RecursiveCall)
-		    ], Module).
-
-% same as selectlist
-user:goal_expansion(include(Meta, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(include(Meta, ListIn, ListOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(include, 3, Proto, GoalName),
-	append(MetaVars, [ListIn, ListOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         (Apply -> Outs = [In|NOuts]; Outs = NOuts),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(exclude(Meta, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(exclude(Meta, ListIn, ListOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(exclude, 3, Proto, GoalName),
-	append(MetaVars, [ListIn, ListOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         (Apply -> Outs = [In|NOuts]; Outs = NOuts),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(partition(Meta, ListIn, List1, List2), Mod, Goal) :-
-	goal_expansion_allowed(partition(Meta, ListIn, List1, List2), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(partition, 4, Proto, GoalName),
-	append(MetaVars, [ListIn, List1, List2], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], [], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         (Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod, Goal) :-
-	goal_expansion_allowed(partition(Meta, ListIn, List1, List2, List3), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(partition2, 5, Proto, GoalName),
-	append(MetaVars, [ListIn, List1, List2, List3], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], [], [], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead),
-	append_args(Pred, [In,Diff], Apply),
-	append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         Apply,
-		         (Diff == (<)  ->
-	                   Outs1 = [In|NOuts1],
-	                   Outs2 = NOuts2,
-	                   Outs3 = NOuts3
-			 ;
-			  Diff == (=)  ->
-			  Outs1 = NOuts1,
-			  Outs2 = [In|NOuts2],
-			  Outs3 = NOuts3
-			 ;
-			  Diff == (>)  ->
-			  Outs1 = NOuts1,
-			  Outs2 = NOuts2,
-			  Outs3 = [In|NOuts3]
-			 ;
-			  error:must_be(oneof([<,=,>]), Diff)
-			 ),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(convlist(Meta, ListIn, ListOut), Mod, Goal) :-
-	goal_expansion_allowed(convlist(Meta, ListIn, ListOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(convlist, 3, Proto, GoalName),
-	append(MetaVars, [ListIn, ListOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
-	append_args(Pred, [In, Out], Apply),
-	append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         (Apply -> Outs = [Out|NOuts]; Outs = NOuts),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod, Goal) :-
-	goal_expansion_allowed(sumlist(Meta, List, AccIn, AccOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(sumlist, 4, Proto, GoalName),
-	append(MetaVars, [List, AccIn, AccOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], Acc, Acc], Base),
-	append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
-	append_args(Pred, [In, Acc1, Acc3], Apply),
-	append_args(HeadPrefix, [Ins, Acc3, Acc2], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :- Apply, RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(mapargs(Meta, In, Out), Module, NewGoal) :-
-	goal_expansion_allowed(mapargs(Meta, In, Out), Module),
-	( var(Out)
-	->
-	    NewGoal = (
-			In =.. [F|InArgs],
-			maplist(Meta, InArgs, OutArgs),
-			Out =.. [F|OutArgs]
-		      )
-	;
-	    NewGoal = (
-			Out =.. [F|OutArgs],
-			maplist(Meta, InArgs, OutArgs),
-			In =.. [F|InArgs]
-		      )
-	).	    
-
-user:goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Module, Goal) :-
-	goal_expansion_allowed(sumargs(Meta, Term, AccIn, AccOut), Module),
-	Goal = (
-		 Term =.. [_|TermArgs],
-		 sumlist(Meta, TermArgs, AccIn, AccOut)
-	       ).
-
-user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod, Goal) :-
-	goal_expansion_allowed(mapnodes(Meta, InTerm, OutTerm), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(mapnodes, 3, Proto, GoalName),
-	append(MetaVars, [[InTerm], [OutTerm]], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],
-	append_args(HeadPrefix, [[], []], Base),
-	append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
-	append_args(Pred, [In, Temp], Apply),
-	append_args(HeadPrefix, [InArgs, OutArgs], SubRecursiveCall),
-	append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         Apply,
-			 (compound(Temp)
-			 ->
-			     Temp =.. [F|InArgs],
-			     SubRecursiveCall,
-			     Out =.. [F|OutArgs]
-			 ;
-			     Out = Temp
-			 ),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(checknodes(Meta, Term), Mod, Goal) :-
-	goal_expansion_allowed(checknodes(Meta, Term), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(checknodes, 2, Proto, GoalName),
-	append(MetaVars, [[Term]], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],
-	append_args(HeadPrefix, [[]], Base),
-	append_args(HeadPrefix, [[In|Ins]], RecursionHead),
-	append_args(Pred, [In], Apply),
-	append_args(HeadPrefix, [Args], SubRecursiveCall),
-	append_args(HeadPrefix, [Ins], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         Apply,
-			 (compound(In)
-			 ->
-			     In =.. [_|Args],SubRecursiveCall
-			 ;
-			     true
-			 ),
-			 RecursiveCall)
-		    ], Module).
-
-user:goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod, Goal) :-
-	goal_expansion_allowed(sumnodes(Meta, Term, AccIn, AccOut), Mod),
-	callable(Meta),
-	!,
-	aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
-	% the new goal
-	pred_name(sumnodes, 4, Proto, GoalName),
-	append(MetaVars, [[Term], AccIn, AccOut], GoalArgs),
-	Goal =.. [GoalName|GoalArgs],
-	% the new predicate declaration
-	HeadPrefix =.. [GoalName|PredVars],	
-	append_args(HeadPrefix, [[], Acc, Acc], Base),
-	append_args(HeadPrefix, [[In|Ins], Acc1, Acc2], RecursionHead),
-	append_args(Pred, [In, Acc1, Acc3], Apply),
-	append_args(HeadPrefix, [Args, Acc3, Acc4], SubRecursiveCall),
-	append_args(HeadPrefix, [Ins, Acc4, Acc2], RecursiveCall),
-	compile_aux([
-		     Base,
-		     (RecursionHead :-
-		         Apply,
-			 (compound(In)
-			 ->
-			     In =.. [_|Args],SubRecursiveCall
-			 ;
-			     Acc3 = Acc4
-			 ),
-			 RecursiveCall)
-		    ], Module).
-
-:- unhide('$translate_rule').
-% stolen from SWI-Prolog
-user:goal_expansion(phrase(NT,Xs), Mod, NTXsNil) :-
-	user:goal_expansion(phrase(NT,Xs,[]), Mod, NTXsNil).
-user:goal_expansion(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
-	goal_expansion_allowed(phrase(NT,Xs0,Xs), Mod),
-	Goal = phrase(NT,Xs0,Xs),
-	nonvar(NT),
-	catch('$translate_rule'((pseudo_nt --> NT), Rule),
-	      error(Pat,ImplDep),
-	      ( \+ harmless_dcgexception(Pat), 
-		throw(error(Pat,ImplDep))
-	      )),
-	Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
-	Goal \== NewGoal0,
-	% apply translation only if we are safe
-	\+ contains_illegal_dcgnt(NT), !,
-	(   var(Xsc), Xsc \== Xs0c
-	->  Xs = Xsc, NewGoal1 = NewGoal0
-	;   NewGoal1 = (NewGoal0, Xsc = Xs)
-	),
-	(   var(Xs0c)
-	-> Xs0 = Xs0c,
-	   NewGoal = NewGoal1
-	;  ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
-	).
-:- hide('$translate_rule').
 
 %%%%%%%%%%%%%%%%%%%%
 % utilities
@@ -487,18 +74,6 @@ harmless_dcgexception(instantiation_error).	% ex: phrase(([1],x:X,[3]),L)
 harmless_dcgexception(type_error(callable,_)).	% ex: phrase(27,L)
 
 
-%%	contains_illegal_dcgnt(+Term) is semidet.
-%
-%	True if Term contains a non-terminal   we cannot deal with using
-%	goal-expansion. The test is too general approximation, but safe.
-
-contains_illegal_dcgnt(NT) :-
-	sub_term(I, NT),
-	nonvar(I),
-	( I = ! ; I = phrase(_,_,_) ), !.
-%	write(contains_illegal_nt(NT)),		% JW: we do not want to write
-%	nl.
-
 '$expand':allowed_expansion(QExpand) :-
     strip_module(QExpand, Mod, Pred),
     goal_expansion_allowed(Pred, Mod).

library/lineutils.yap

@@ -32,7 +32,7 @@ available by loading the
 :- meta_predicate
 	filter(+,+,2),
 	file_filter(+,+,2),
-	file_filter_with_init(+,+,2,+,:),
+	file_filter_with_initialization(+,+,2,+,:),
 	process(+,1).
 
 :- use_module(library(lists),

library/maplist.yap

@@ -1248,36 +1248,6 @@ goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod:Goal) :-
 			 RecursiveCall)
 		    ], Mod).
 
-/*
-:- unhide('$translate_rule').
-% stolen from SWI-Prolog
-user:goal_expansion(phrase(NT,Xs), Mod, NTXsNil) :-
-	user:goal_expansion(phrase(NT,Xs,[]), Mod, NTXsNil).
-user:goal_expansion(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
-	goal_expansion_allowed,
-	Goal = phrase(NT,Xs0,Xs),
-	nonvar(NT),
-	catch('$translate_rule'((pseudo_nt --> NT), Rule),
-	      error(Pat,ImplDep),
-	      ( \+ harmless_dcgexception(Pat), 
-		throw(error(Pat,ImplDep))
-	      )),
-	Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
-	Goal \== NewGoal0,
-	% apply translation only if we are safe
-	\+ contains_illegal_dcgnt(NT), !,
-	(   var(Xsc), Xsc \== Xs0c
-	->  Xs = Xsc, NewGoal1 = NewGoal0
-	;   NewGoal1 = (NewGoal0, Xsc = Xs)
-	),
-	(   var(Xs0c)
-	-> Xs0 = Xs0c,
-	   NewGoal = NewGoal1
-	;  ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
-	).
-:- hide('$translate_rule').
-*/
-
 /**
 @}
 */

library/maputils.yap

@@ -24,6 +24,9 @@
 
 number_of_expansions(0).
 
+%
+% compile auxiliary routines for term expansion
+%
 compile_aux([Clause|Clauses], Module) :-
 	% compile the predicate declaration if needed
 	( Clause = (Head :- _)
@@ -83,22 +86,6 @@ transformation_id(Id) :-
 	Id1 is Id+1,
 	assert(number_of_expansions(Id1)).
 
-harmless_dcgexception(instantiation_error).	% ex: phrase(([1],x:X,[3]),L)
-harmless_dcgexception(type_error(callable,_)).	% ex: phrase(27,L)
-
-
-%%	contains_illegal_dcgnt(+ Term) is semidet.
-%
-%	`True` if _Term_ contains a non-terminal   we cannot deal with using
-%	goal-expansion. The test is too general approximation, but safe.
-
-contains_illegal_dcgnt(NT) :-
-	sub_term(I, NT),
-	nonvar(I),
-	( I = ! ; I = phrase(_,_,_) ), !.
-%	write(contains_illegal_nt(NT)),		% JW: we do not want to write
-%	nl.
-
 %%	goal_expansion_allowed is semidet.
 %
 %	`True` if we can use

misc/HEAPFIELDS

@@ -325,7 +325,7 @@ struct record_list *yap_records		Yap_Records		=NULL		RestoreYapRecords()
 
 /* SWI atoms and functors */
 Atom		*swi_atoms	SWI_Atoms		InitSWIAtoms() RestoreSWIAtoms()
-Functor		swi_functors[N_SWI_FUNCTORS] SWI_Functors	void void
+Functor		*swi_functors   SWI_Functors	void void
 
 struct swi_reverse_hash	swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash	void void
 

misc/buildheap

@@ -1,6 +1,6 @@
 
 :- use_module(library(lineutils),
-	[file_filter_with_init/5,
+	[file_filter_with_initialization/5,
 	 split/3,
 	 glue/3]).
 
@@ -18,18 +18,18 @@
 
 main :-
 	warning(Warning),
-	file_filter_with_init('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']),
+	file_filter_with_initialization('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']),
-	file_filter_with_init('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']),
+	file_filter_with_initialization('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']),
-	file_filter_with_init('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']),
+	file_filter_with_initialization('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']),
-	file_filter_with_init('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']).
+	file_filter_with_initialization('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']).
-	%file_filter_with_init('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
+	%file_filter_with_initialization('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
-	%file_filter_with_init('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
+	%file_filter_with_initialization('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
-	%file_filter_with_init('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']),
+	%file_filter_with_initialization('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']),
-	%file_filter_with_init('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']),
+	%file_filter_with_initialization('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']),
-	%file_filter_with_init('misc/LOCALS','H/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']),
+	%file_filter_with_initialization('misc/LOCALS','H/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']),
-	%file_filter_with_init('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
+	%file_filter_with_initialization('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
-	%file_filter_with_init('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),
+	%file_filter_with_initialization('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),
-	%file_filter_with_init('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']).
+	%file_filter_with_initialization('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']).
 	
 warning('~n  /* This file, ~a, was generated automatically by \"yap -L misc/buildheap\"~n     please do not update, update misc/~a instead */~n~n').
 

os/SWI-Stream.h

@@ -112,8 +112,8 @@ typedef struct io_functions
 typedef struct io_position
 { int64_t		byteno;		/* byte-position in file */
   int64_t		charno;		/* character position in file */
-  int			lineno;		/* lineno in file */
+  long int		lineno;		/* lineno in file */
-  int			linepos;	/* position in line */
+  long int		linepos;	        /* position in line */
   intptr_t		reserved[2];	/* future extensions */
 } IOPOS;
 

os/pl-read.c

@@ -1570,6 +1570,24 @@ PRED_IMPL("term_to_atom", 2, term_to_atom, 0)
 { return atom_to_term(A2, A1, 0);
 }
 
+static
+PRED_IMPL("$set_source", 2, set_source, 0)
+{ 
+  GET_LD
+  atom_t at;
+  term_t a = PL_new_term_ref();
+
+  if (!PL_get_atom(A1, &at))
+    return FALSE;
+  source_file_name = at;
+  if (!PL_get_arg(1, A2, a) || !PL_get_int64(a, &source_char_no) ||
+      !PL_get_arg(2, A2, a) || !PL_get_long(a, &source_line_no) ||
+      !PL_get_arg(3, A2, a) || !PL_get_long(a, &source_line_pos) ||
+      !PL_get_arg(4, A2, a) || !PL_get_int64(a, &source_byte_no) ) {
+    return FALSE;
+  }
+  return TRUE;
+}
 
 int
 PL_chars_to_term(const char *s, term_t t)
@@ -1600,6 +1618,7 @@ PRED_DEF("read_term",		  2, read_term,		  PL_FA_ISO)
 PRED_DEF("read_clause",         3, read_clause,         0)
 PRED_DEF("atom_to_term", 3, atom_to_term, 0)
 PRED_DEF("term_to_atom", 2, term_to_atom, 0)
+PRED_DEF("$set_source",  2, set_source, 0)
 #ifdef O_QUASIQUOTATIONS
 PRED_DEF("$qq_open",            2, qq_open,             0)
 #endif

pl/absf.yap

@@ -30,7 +30,6 @@
         remove_from_path/1], ['$full_filename'/3,
         '$system_library_directories'/2]).
 
-
 :- use_system_module( '$_boot', ['$system_catch'/4]).
 
 :- use_system_module( '$_errors', ['$do_error'/2]).
@@ -134,10 +133,8 @@ absolute_file_name(user,user) :- !.
 absolute_file_name(File0,File) :-
 	'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
 
-'$full_filename'(F0,F,G) :-
+'$full_filename'(F0, F, G) :-
-	'$absolute_file_name'(F0,[access(read),file_type(source),file_errors(fail),solutions(first),expand(true)],F,G).
+    '$absolute_file_name'(F0,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F,G).
-
-
 
 '$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
 	'$do_error'(instantiation_error, G).
@@ -591,7 +588,6 @@ user:prolog_file_type(A, prolog) :-
 	A \== prolog,
 	A \==pl,
 	A \== yap.
-user:prolog_file_type(qly, prolog).
 user:prolog_file_type(qly, qly).
 user:prolog_file_type(A, executable) :-
 	current_prolog_flag(shared_object_extension, A).

pl/arith.yap

@@ -28,7 +28,6 @@
 	     expand_expr/5,
 	     expand_expr/6] ).
 		   
-
 :- use_system_module( '$_errors', ['$do_error'/2]).
 
 :- use_system_module( '$_modules', ['$clean_cuts'/2]).
@@ -60,8 +59,7 @@
 
 */
 
-/**
+/** @pred expand_exprs(- _O_,+ _N_) 
-  @pred expand_exprs(- _O_,+ _N_) 
 	Control term expansion during compilation.
 
 Enables low-level optimizations. It reports the current state by
@@ -86,6 +84,7 @@ expand_exprs(Old,New) :-
 After a call to this predicate, arithmetical expressions will be compiled.
 (see example below). This is the default behavior.
 */
+
 compile_expressions :- set_value('$c_arith',true).
 
 /**  @pred do_not_compile_expressions
@@ -198,6 +197,31 @@ do_c_built_in(Comp0, _, R) :-		% now, do it for comparisons
 	expand_expr(F, Q, V),
 	'$do_and'(P, Q, R0),
 	'$do_and'(R0, Comp, R).
+do_c_built_in(phrase(NT,Xs), NTXsNil) :-
+	'$_arith':do_c_built_in(phrase(NT,Xs,[]), NTXsNil).
+
+do_c_built_in(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
+	'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
+	Goal = phrase(NT,Xs0,Xs),
+	callable(NT),
+	catch('$translate_rule'((pseudo_nt --> NT), Rule),
+	      error(Pat,ImplDep),
+	      ( \+ '$harmless_dcgexception'(Pat), 
+		throw(error(Pat,ImplDep))
+	      )),
+	Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
+	Goal \== NewGoal0,
+	% apply translation only if we are safe
+	\+ '$contains_illegal_dcgnt'(NT), !,
+	(   var(Xsc), Xsc \== Xs0c
+	->  Xs = Xsc, NewGoal1 = NewGoal0
+	;   NewGoal1 = (NewGoal0, Xsc = Xs)
+	),
+	(   var(Xs0c)
+	-> Xs0 = Xs0c,
+	   NewGoal = NewGoal1
+	;  ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
+	).
 do_c_built_in(P, _, P).
 
 do_c_built_metacall(G1, Mod, '$execute_wo_mod'(G1,Mod)) :- 
@@ -369,6 +393,54 @@ expand_expr(Op, X, Y, O, Q, P) :-
 '$preprocess_args_for_non_commutative'(X, Y, Z, W, E) :-
 	'$do_and'(Z = X, Y = W, E).
 
+
+do_c_built_in(phrase(NT,Xs), NTXsNil) :-
+	'$_arith':do_c_built_in(phrase(NT,Xs,[]), NTXsNil).
+
+do_c_built_in(phrase(NT,Xs0,Xs), Mod, NewGoal) :-
+	'$goal_expansion_allowed'(phrase(NT,Xs0,Xs), Mod),
+	Goal = phrase(NT,Xs0,Xs),
+	callable(NT),
+	catch('$translate_rule'((pseudo_nt --> NT), Rule),
+	      error(Pat,ImplDep),
+	      ( \+ '$harmless_dcgexception'(Pat), 
+		throw(error(Pat,ImplDep))
+	      )),
+	Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
+	Goal \== NewGoal0,
+	% apply translation only if we are safe
+	\+ '$contains_illegal_dcgnt'(NT), !,
+	(   var(Xsc), Xsc \== Xs0c
+	->  Xs = Xsc, NewGoal1 = NewGoal0
+	;   NewGoal1 = (NewGoal0, Xsc = Xs)
+	),
+	(   var(Xs0c)
+	-> Xs0 = Xs0c,
+	   NewGoal = NewGoal1
+	;  ( Xs0 = Xs0c, NewGoal1 ) = NewGoal
+	).
+
+'$goal_expansion_allowed'(phrase(_NT,_Xs0,_Xs), _Mod).
+
+%%	contains_illegal_dcgnt(+Term) is semidet.
+%
+%	True if Term contains a non-terminal   we cannot deal with using
+%	goal-expansion. The test is too general approximation, but safe.
+
+'$contains_illegal_dcgnt'(NT) :-
+    functor(NT, _, A),
+    between(1, A, I),
+    arg(I, NT),
+    nonvar(I),
+    ( I = ! ; I = phrase(_,_,_) ), !.
+%	write(contains_illegal_nt(NT)),		% JW: we do not want to write
+%	nl.
+
+'$harmless_dcgexception'(instantiation_error).	% ex: phrase(([1],x:X,[3]),L)
+'$harmless_dcgexception'(type_error(callable,_)).	% ex: phrase(27,L)
+
+
+
 /**	
 
 @}

pl/boot.yap

@@ -688,8 +688,17 @@ number of steps.
  %
  % but YAP and SICStus does.
  %
- '$process_directive'(G, _, M, VL, Pos) :-
+ '$process_directive'(G, Mode, M, VL, Pos) :-
-	 ( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
+     ( '$undefined'('$save_directive'(G, Mode, M, VL, Pos),prolog) ->
+	   true
+	       ;
+	  '$save_directive'(G, Mode, M, VL, Pos)
+	  ->
+	   true
+	   ;
+	   true
+     ),
+     ( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
 
 '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !,
 	  '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).

pl/consult.yap

@@ -157,6 +157,23 @@ following flags:
     If true, raise an error if the file is not a module file. Used by
     ` use_module/1 and use_module/2.
 
++ qcompile(+ _Value_)
+  
+    SWI-Prolog flag that controls whether loaded files should be also
+    compiled into `qly` files. The default value is obtained from the flag
+    `qcompile`:
+
+   `never`, no `qly` file is generated unless the user calls
+ qsave_file/1 and friends, or sets the qcompile option in
+ load_files/2; 
+
+  `auto`, all files are qcompiled.
+
+  `large`, files above 100KB are qcompiled.
+
+  `part`, not supported in YAP.
+
+
 + autoload(+ _Autoload_)
   
     SWI-compatible option where if _Autoload_ is `true` undefined
@@ -175,7 +192,7 @@ following flags:
 				% expand(true,false)
 % if(changed,true,not_loaded) => implemented
 % imports(all,List) => implemented
-% qcompile(true,false)
+% qcompile() => implemented
 % silent(true,false)  => implemented
 % stream(Stream)  => implemented
 % consult(consult,reconsult,exo,db) => implemented
@@ -191,7 +208,8 @@ load_files(Files,Opts) :-
 '$lf_option'(expand, 4, false).
 '$lf_option'(if, 5, true).
 '$lf_option'(imports, 6, all).
-'$lf_option'(qcompile, 7, never).
+'$lf_option'(qcompile, 7, Current) :-
+    '$nb_getval'('$qcompile', Current, Current = never).
 '$lf_option'(silent, 8, _).
 '$lf_option'(skip_unix_header, 9, false).
 '$lf_option'(compilation_mode, 10, source).
@@ -315,9 +333,11 @@ load_files(Files,Opts) :-
 	    is_list(Val) -> ( ground(Val) -> true ; '$do_error'(instantiation_error,Call) ) ;
 	    '$do_error'(domain_error(unimplemented_option,imports(Val)),Call) ).
 '$process_lf_opt'(qcompile, Val,Call) :-
-	( Val == true -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
+	( Val == part -> '$do_error'(domain_error(unimplemented_option,expand),Call) ;
-	    Val == false -> true ;
+	    Val == never -> true ;
-	    '$do_error'(domain_error(unimplemented_option,expand(Val)),Call) ).
+	    Val == auto -> true ;
+	    Val == large -> true ;
+	    '$do_error'(domain_error(unknown_option,qcompile(Val)),Call) ).
 '$process_lf_opt'(silent, Val, Call) :-
 	( Val == false -> true ;
 	    Val == true -> true ;
@@ -327,19 +347,19 @@ load_files(Files,Opts) :-
 	    Val == true -> true ;
 	    '$do_error'(domain_error(unimplemented_option,skip_unix_header(Val)),Call) ).
 '$process_lf_opt'(compilation_mode, Val, Call) :-
-( Val == source -> true ;
+    ( Val == source -> true ;
-	    Val == compact -> true ;
+      Val == compact -> true ;
-	    Val == assert_all -> true ;
+      Val == assert_all -> true ;
-	    '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
+      '$do_error'(domain_error(unimplemented_option,compilation_mode(Val)),Call) ).
 '$process_lf_opt'(consult, Val , Call) :-
-	( Val == reconsult -> true ;
+    ( Val == reconsult -> true ;
-	    Val == consult -> true ;
+      Val == consult -> true ;
-	    Val == exo -> true ;
+      Val == exo -> true ;
-	    Val == db -> true ;
+      Val == db -> true ;
-	    '$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
+      '$do_error'(domain_error(unimplemented_option,consult(Val)),Call) ).
 '$process_lf_opt'(reexport, Val , Call) :-
 	( Val == true -> true ;
-	    Val == false -> true ;
+	  Val == false -> true ;
 	    '$do_error'(domain_error(unimplemented_option,reexport(Val)),Call) ).
 '$process_lf_opt'(must_be_module, Val , Call) :-
 	( Val == true -> true ;
@@ -396,23 +416,54 @@ load_files(Files,Opts) :-
 	b_setval('$source_file', user_input),
 	'$do_lf'(Mod, user_input, user_input, TOpts).
 '$lf'(File, Mod, Call, TOpts) :-
-	'$lf_opt'(stream, TOpts, Stream),
+    '$lf_opt'(stream, TOpts, Stream),
-	b_setval('$source_file', File),
+    var( Stream ),
-	( var(Stream) ->
+    H0 is heapused, '$cputime'(T0,_),
+    % check if there is a qly files
+    '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,load_files(File)),
+    open( F, read, Stream , [type(binary)] ),
+    ( '$q_header'( Stream, Type ),
+       Type == file
+    ->
+       time_file64(F, T0F), 
+       '$absolute_file_name'(File,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],FilePl,load_files(File)),
+       time_file64(FilePl, T0Fl),
+       T0F >= T0Fl,
+       !,
+       file_directory_name(F, Dir),
+       working_directory(OldD, Dir),
+       '$msg_level'( TOpts, Verbosity),
+       '$lf_opt'(imports, TOpts, ImportList),
+       '$qload_file'(Stream, Mod, F, FilePl, File, ImportList),
+       close( Stream ),
+       H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
+       '$current_module'(M, Mod),
+       working_directory( _, OldD),
+       print_message(Verbosity, loaded( loaded, F, M, T, H)),
+       '$exec_initialisation_goals'
+    ;
+       close( Stream),
+       fail
+    ).
+'$lf'(File, Mod, Call, TOpts) :-
+    '$lf_opt'(stream, TOpts, Stream),
+    b_setval('$source_file', File),
+    ( var(Stream) ->
 	  /* need_to_open_file */
 	  '$full_filename'(File, Y, Call),
 	  open(Y, read, Stream)
         ;
-	  true
+	stream_property(Stream, file_name(Y))
-        ), !,
+    ), !,
-	'$lf_opt'(reexport, TOpts, Reexport),
+    '$lf_opt'(reexport, TOpts, Reexport),
-	'$lf_opt'(if, TOpts, If),
+    '$lf_opt'(if, TOpts, If),
-	( var(If) -> If = true ; true ),
+    ( var(If) -> If = true ; true ),
-	'$lf_opt'(imports, TOpts, Imports),
+    '$lf_opt'(imports, TOpts, Imports),
-	'$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
+    '$start_lf'(If, Mod, Stream, TOpts, File, Reexport, Imports),
-	close(Stream).
+    character_count(Stream, Pos),
+    close(Stream). 
 '$lf'(X, _, Call, _) :-
-	'$do_error'(permission_error(input,stream,X),Call).
+    '$do_error'(permission_error(input,stream,X),Call).
 
 '$start_lf'(not_loaded, Mod, Stream, TOpts, UserFile, Reexport,Imports) :-
 	'$file_loaded'(Stream, Mod, Imports, TOpts), !,
@@ -587,6 +638,9 @@ db_files(Fs) :-
 	'$lf_opt'('$context_module', TOpts, ContextModule),
 	'$lf_opt'(reexport, TOpts, Reexport),
 	'$msg_level'( TOpts, Verbosity),
+	'$lf_opt'(qcompile, TOpts, QCompiling),
+	'$nb_getval'('$qcompile', ContextQCompiling, ContextQCompiling = never),
+	nb_setval('$qcompile', QCompiling),
 %	format( 'I=~w~n', [Verbosity=UserFile] ),
 	'$lf_opt'(encoding, TOpts, Encoding),
 	'$set_encoding'(Stream, Encoding),
@@ -618,18 +672,22 @@ db_files(Fs) :-
 	    StartMsg = consulting,
 	    EndMsg = consulted
 	),
-	print_message(Verbosity, loading(StartMsg, File)),
+	print_message(Verbosity, loading(StartMsg, UserFile)),
 	'$lf_opt'(skip_unix_header , TOpts, SkipUnixHeader),
-	( SkipUnixHeader == true->
+	( SkipUnixHeader == true
+	    ->
 	    '$skip_unix_header'(Stream)
-	;
+	  ;
 	    true
-	),
+	  ),
-	'$loop'(Stream,Reconsult),
+	 '$loop'(Stream,Reconsult),
+	 '$lf_opt'(imports, TOpts, Imports),
+	 '$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
+	 '$end_consult',
+	 '$q_do_save_file'(File, UserFile, ContextModule, TOpts ),
 	H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
 	'$current_module'(Mod, SourceModule),
 	print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
-	'$end_consult',
 	( 
 	    Reconsult = reconsult ->
 	    '$clear_reconsulting'
@@ -646,14 +704,21 @@ db_files(Fs) :-
 	nb_setval('$if_level',OldIfLevel),
 	'$lf_opt'('$use_module', TOpts, UseModule),
 	'$bind_module'(Mod, UseModule),
-	'$lf_opt'(imports, TOpts, Imports),
-	'$import_to_current_module'(File, ContextModule, Imports, _, TOpts),
 	'$reexport'( TOpts, ParentF, Reexport, Imports, File ),
+	nb_setval('$qcompile', ContextQCompiling),
 	( LC == 0 -> prompt(_,'   |: ') ; true),
 	'$exec_initialisation_goals',
 	% format( 'O=~w~n', [Mod=UserFile] ),
 	!.
 
+'$q_do_save_file'(File, UserF, ContextModule, TOpts ) :-
+    '$lf_opt'(qcompile, TOpts, QComp), 
+    ( QComp ==  auto ; QComp == large,  Pos > 100*1024),
+    '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)),
+    !,
+    '$qsave_file_'( File, UserF, F ).
+'$q_do_save_file'(_File, _, _ContextModule, _TOpts ).
+
 % are we in autoload and autoload_flag is false?
 '$msg_level'( TOpts, Verbosity) :-
 	'$lf_opt'(autoload, TOpts, AutoLoad),
@@ -687,12 +752,11 @@ db_files(Fs) :-
 '$bind_module'(Mod, use_module(Mod)).
 
 '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
-	\+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_),
+	\+ recorded('$module','$module'(File, _Module, _, _ModExports, _),_),
 	% enable loading C-predicates from a different file
 	recorded( '$load_foreign_done', [File, M0], _),
 	'$import_foreign'(File, M0, ContextModule ),
 	fail.
-
 '$import_to_current_module'(File, ContextModule, Imports, RemainingImports, TOpts) :-
 	recorded('$module','$module'(File, Module, _Source, ModExports, _),_),
 	Module \= ContextModule, !,
@@ -836,59 +900,50 @@ source_file(Mod:Pred, FileName) :-
 Obtain information on what is going on in the compilation process. The
 following keys are available:
 
++ directory  (prolog_load_context/2 option)
 
-
+    Full name for the directory where YAP is currently consulting the
-+ directory 
-
-
-
-Full name for the directory where YAP is currently consulting the
 file.
 
-+ file 
++ file  (prolog_load_context/2 option)
 
-
+    Full name for the file currently being consulted. Notice that included
-
-Full name for the file currently being consulted. Notice that included
 filed are ignored.
 
-+ module 
++ module  (prolog_load_context/2 option)
 
-
+    Current source module.
-
-Current source module.
 
 + `source` (prolog_load_context/2 option) 
 
     Full name for the file currently being read in, which may be consulted,
 reconsulted, or included.
 
-+ `stream` 
++ `stream`  (prolog_load_context/2 option)
 
     Stream currently being read in.
 
-+ `term_position` 
++ `term_position`  (prolog_load_context/2 option)
 
     Stream position at the stream currently being read in. For SWI
 compatibility, it is a term of the form
-'$stream_position'(0,Line,0,0,0).
+'$stream_position'(0,Line,0,0).
 
-
++ `source_location(? _FileName_, ? _Line_)`   (prolog_load_context/2 option)
-+ `source_location(? _FileName_, ? _Line_)` 
 
     SWI-compatible predicate. If the last term has been read from a physical file (i.e., not from the file user or a string), unify File with an absolute path to the file and Line with the line-number in the file. Please use prolog_load_context/2.
 
-+ `source_file(? _File_)`
++ `source_file(? _File_)`  (prolog_load_context/2 option)
 
     SWI-compatible predicate. True if  _File_ is a loaded Prolog source file.
 
-+ `source_file(? _ModuleAndPred_,? _File_)`
++ `source_file(? _ModuleAndPred_,? _File_)`  (prolog_load_context/2 option)
 
     SWI-compatible predicate. True if the predicate specified by  _ModuleAndPred_ was loaded from file  _File_, where  _File_ is an absolute path name (see `absolute_file_name/2`).
 
+*/
 
-
+/** @addgroup YAPLibraries Library Predicates
-@section YAPLibraries Library Predicates
 
 Library files reside in the library_directory path (set by the
 `LIBDIR` variable in the Makefile for YAP). Currently,
@@ -919,7 +974,14 @@ prolog_load_context(term_position, Position) :-
 % if the file exports a module, then we can
 % be imported from any module.
 '$file_loaded'(Stream, M, Imports, TOpts) :-
-	'$file_name'(Stream, F),
+	'$file_name'(Stream, F0),
+	( 
+	    atom_concat(Prefix, '.qly', F0 )
+	->
+            '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F,load_files(Prefix))
+        ;
+           F0 = F
+        ),
 	'$ensure_file_loaded'(F, M, F1),
 %	format( 'IL=~w~n', [(F1:Imports->M)] ),
 	'$import_to_current_module'(F1, M, Imports, _, TOpts).
@@ -960,7 +1022,8 @@ prolog_load_context(term_position, Position) :-
 % inform the file has been loaded and is now available.
 '$loaded'(Stream, UserFile, M, OldF, Line, Reconsult, F, Dir, Opts) :-
 	'$file_name'(Stream, F0),
-	( F0 == user_input, nonvar(UserFile) -> UserFile = F ; F = F0 ),
+	( F0 == user_input, nonvar(UserFile) -> UserFile = F 
+	  ; F = F0 ),
 	( F == user_input -> working_directory(Dir,Dir) ; file_directory_name(F, Dir) ),
 	nb_setval('$consulting_file', F ),
 	( Reconsult \== consult, Reconsult \== not_loaded, Reconsult \== changed, recorded('$lf_loaded','$lf_loaded'(F, _,_),R), erase(R), fail ; var(Reconsult) -> Reconsult = consult ; true ),
@@ -1071,6 +1134,52 @@ source_file_property( File0, Prop) :-
 '$source_file_property'( F, module(M)) :-
 	recorded('$module','$module'(F,M,_,_,_),_).
 
+unload_file( F0 ) :-
+    absolute_file_name( F0, F1, [expand(true),file_type(prolog)] ),
+    '$unload_file'( F1, F0 ).
+
+% eliminate multi-files;
+% get rid of file-only predicataes.
+'$unload_file'( FileName, _F0 ) :-
+    '$current_predicate_var'(A,Mod,P).
+    '$owner_file'(P,Mod,FileName),
+    \+ '$is_multifile'(P,Mod),
+    functor( P, Na, Ar),
+    abolish(Mod:Na/Ar),
+    fail.
+%next multi-file.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$lf_loaded','$lf_loaded'( F, Age, _), R),
+    erase(R),
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), R),
+    erase(R),
+    erase(ClauseRef),
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,FFileName,R), R1),
+    erase(R1),
+    erase(R),
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R),
+    erase(R),
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), R),
+    erase(R),
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$module','$module'( FileName, Mod, _SourceF, _, _), R),
+    erase( R ),
+    unload_module(Mod),	
+    fail.
+'$unload_file'( FileName, _F0 ) :-
+    recorded('$directive','$d'( FileName, _M:_G, _Mode,  _VL, _Pos ), R),
+    erase(R),
+    fail.
+
 
 /**
 
@@ -1370,12 +1479,6 @@ part of the code due to different capabilities.
 
     Realise different configuration options for your software.
 
-
-
-
-
-
-
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 :- if(test1).
 section_1.

pl/dbload.yap

@@ -87,7 +87,7 @@ dbload(F, _, G) :-
 	'$do_error'(type_error(atom,F),G).
 
 do_dbload(F0, M0, G) :-
-	'$full_filename'(F0,F,G),
+	'$full_filename'(F0, F, G),
 	assert(dbprocess(F, M0)),
 	open(F, read, R),
 	check_dbload_stream(R, M0),

pl/directives.yap

@@ -93,16 +93,17 @@
 '$directive'(use_module(_,_,_)).
 '$directive'(wait(_)).
 
-'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- !,
+'$exec_directives'((G1,G2), Mode, M, VL, Pos) :- 
-	'$exec_directives'(G1, Mode, M, VL, Pos),
+    !,
-	'$exec_directives'(G2, Mode, M, VL, Pos).
+    '$exec_directives'(G1, Mode, M, VL, Pos),
+    '$exec_directives'(G2, Mode, M, VL, Pos).
 '$exec_directives'(G, Mode, M, VL, Pos) :-
     '$save_directive'(G, Mode, M, VL, Pos),
     '$exec_directive'(G, Mode, M, VL, Pos).
 
 '$save_directive'(G, Mode, M, VL, Pos) :-
     prolog_load_context(file, FileName), !,
-    recorda('$directive', directive(File,M:G, Mode, VL, Pos),_).
+    recordz('$directive', directive(FileName,M:G, Mode, VL, Pos),_).
 
 '$exec_directive'(multifile(D), _, M, _, _) :-
 	'$system_catch'('$multifile'(D, M), M,

pl/flags.yap

@@ -279,6 +279,21 @@ profile_data/3 built-in.
 
     SWI-Compatible option, determines prompting for alternatives in the Prolog toplevel. Default is <tt>groundness</tt>, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is <tt>determinism</tt> which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints.
 
++ `qcompile(+{never, auto, large, part}, changeable)`
+
+    SWI-Prolog flag that controls whether loaded files should be also
+    compiled into qfiles. The default value is `never`.
+
+ `never`, no qcompile file is generated unless the user calls
+ qsave_file/1 and friends, or sets the qcompile option in
+ load_files/2; 
+
+  `auto`, all files are qcompiled.
+
+  `large`, files above 100KB are qcompiled.
+
+  `part`, not supported in YAP.
+
 + `redefine_warnings `
 
     If  _Value_ is unbound, tell whether warnings for procedures defined
@@ -873,13 +888,22 @@ yap_flag(chr_toplevel_show_store,X) :-
 yap_flag(chr_toplevel_show_store,X) :-
 	'$do_error'(domain_error(flag_value,chr_toplevel_show_store+X),yap_flag(chr_toplevel_show_store,X)).
 
+yap_flag(qcompile,X) :-
+	var(X), !,
+	'$nb_getval'('$qcompile', X, X=never).
+yap_flag(qcompile,X) :-
+	(X == never ; X == auto ; X == large ; X == part), !,
+	nb_setval('$qcompile',X).
+yap_flag(qcompile,X) :-
+	'$do_error'(domain_error(flag_value,qcompile+X),yap_flag(qcompile,X)).
+
 yap_flag(source,X) :-
 	var(X), !,
 	source_mode( X, X ).
 yap_flag(source,X) :-
 	(X == off -> true ; X == on), !,
 	source_mode( _, X ).
-yap_flag(chr_toplevel_show_store,X) :-
+yap_flag(source,X) :-
 	'$do_error'(domain_error(flag_value,source+X),yap_flag(source,X)).
 
 yap_flag(open_expands_filename,Expand) :-
@@ -1375,8 +1399,8 @@ create_prolog_flag(Name, Value, Options) :-
 '$flag_domain_from_value'(_, term).
 
 
-/**
+/** 
-    @pred source_mode(- _O_,+ _N_) 
+   @pred source_mode(- _O_,+ _N_) 
 
 The state of source mode can either be on or off. When the source mode
 is on, all clauses are kept both as compiled code and in a "hidden"

pl/grammar.yap

@@ -61,19 +61,19 @@ Grammar related built-in predicates:
 */
 
 
-:- system_module( '$_grammar', [!/2,
+:- module( '$_grammar', [!/2,
-        (',')/4,
+-        (',')/4,
-        (->)/4,
+-        (->)/4,
-        ('.')/4,
+-        ('.')/4,
-        (;)/4,
+-        (;)/4,
-        'C'/3,
+-        'C'/3,
-        []/2,
+-        []/2,
-        []/4,
+-        []/4,
-        (\+)/3,
+-        (\+)/3,
-        phrase/2,
+-        phrase/2,
-        phrase/3,
+-        phrase/3,
-        {}/3,
+-        {}/3,
-        ('|')/4], ['$translate_rule'/2]).
+-        ('|')/4]).
 
 :- use_system_module( '$_errors', ['$do_error'/2]).
 
@@ -89,41 +89,41 @@ Grammar related built-in predicates:
     Also, phrase/2-3 check their first argument.
 */
 
-'$translate_rule'((LP-->RP), (NH:-B)) :-
+prolog:'$translate_rule'((LP-->RP), (NH:-B)) :-
-	'$t_head'(LP, NH, NGs, S, SR, (LP-->RP)),
+	t_head(LP, NH, NGs, S, SR, (LP-->RP)),
 	 (var(NGs) ->
-	     '$t_body'(RP, _, last, S, SR, B1)
+	     t_body(RP, _, last, S, SR, B1)
 	 ;
-	     '$t_body'((RP,{NGs}), _, last, S, SR, B1)
+	     t_body((RP,{NGs}), _, last, S, SR, B1)
 	 ),
-	'$t_tidy'(B1, B).
+	t_tidy(B1, B).
 
 
-'$t_head'(V, _, _, _, _, G0) :- var(V), !,
+t_head(V, _, _, _, _, G0) :- var(V), !,
 	'$do_error'(instantiation_error,G0).
-'$t_head'((H,List), NH, NGs, S, S1, G0) :- !,
+t_head((H,List), NH, NGs, S, S1, G0) :- !,
-	'$t_hgoal'(H, NH, S, SR, G0),
+	t_hgoal(H, NH, S, SR, G0),
-	'$t_hlist'(List, S1, SR, NGs, G0).
+	t_hlist(List, S1, SR, NGs, G0).
-'$t_head'(H, NH, _, S, SR, G0) :-
+t_head(H, NH, _, S, SR, G0) :-
-	'$t_hgoal'(H, NH, S, SR, G0).
+	t_hgoal(H, NH, S, SR, G0).
 	
-'$t_hgoal'(V, _, _, _, G0) :- var(V), !,
+t_hgoal(V, _, _, _, G0) :- var(V), !,
 	'$do_error'(instantiation_error,G0).
-'$t_hgoal'(M:H, M:NH, S, SR, G0) :- !,
+t_hgoal(M:H, M:NH, S, SR, G0) :- !,
-	'$t_hgoal'(H, NH, S, SR, G0).
+	t_hgoal(H, NH, S, SR, G0).
-'$t_hgoal'(H, NH, S, SR, _) :-
+t_hgoal(H, NH, S, SR, _) :-
-	'$extend'([S,SR],H,NH).
+	extend([S,SR],H,NH).
 
-'$t_hlist'(V, _, _, _, G0) :- var(V), !,
+t_hlist(V, _, _, _, G0) :- var(V), !,
 	'$do_error'(instantiation_error,G0).
-'$t_hlist'([], _, _, true, _).
+t_hlist([], _, _, true, _).
-'$t_hlist'(String, S0, SR, SF, G0) :- string(String), !,
+t_hlist(String, S0, SR, SF, G0) :- string(String), !,
 	string_codes( String, X ),
-	'$t_hlist'( X, S0, SR, SF, G0).
+	t_hlist( X, S0, SR, SF, G0).
-'$t_hlist'([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
+t_hlist([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
-'$t_hlist'([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
+t_hlist([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
-	'$t_hlist'(List, S0, S1, G0, Goal).
+	t_hlist(List, S0, S1, G0, Goal).
-'$t_hlist'(T, _, _, _, Goal) :-
+t_hlist(T, _, _, _, Goal) :-
 	'$do_error'(type_error(list,T),Goal).
 
 
@@ -133,77 +133,73 @@ Grammar related built-in predicates:
 % variables.
 % Last tells whether we are the ones who should close that chain.
 %
-'$t_body'(Var, filled_in, _, S, S1, phrase(Var,S,S1)) :-
+t_body(Var, filled_in, _, S, S1, phrase(Var,S,S1)) :-
 	var(Var),
 	!.
-'$t_body'(!, to_fill, last, S, S1, (!, S1 = S)) :- !.
+t_body(!, to_fill, last, S, S1, (!, S1 = S)) :- !.
-'$t_body'(!, _, _, S, S, !) :- !.
+t_body(!, _, _, S, S, !) :- !.
-'$t_body'([], to_fill, last, S, S1, S1=S) :- !.
+t_body([], to_fill, last, S, S1, S1=S) :- !.
-'$t_body'([], _, _, S, S, true) :- !.
+t_body([], _, _, S, S, true) :- !.
-'$t_body'(X, FilledIn, Last, S, SR, OS) :- string(X), !,
+t_body(X, FilledIn, Last, S, SR, OS) :- string(X), !,
 	string_codes( X, Codes),
-	'$t_body'(Codes, FilledIn, Last, S, SR, OS).
+	t_body(Codes, FilledIn, Last, S, SR, OS).
-'$t_body'([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !.
+t_body([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !.
-'$t_body'([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !,
+t_body([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !,
-	'$t_body'(R, filled_in, Last, SR1, SR, RB).
+	t_body(R, filled_in, Last, SR1, SR, RB).
-'$t_body'({T}, to_fill, last, S, S1, (T, S1=S)) :- !.
+t_body({T}, to_fill, last, S, S1, (T, S1=S)) :- !.
-'$t_body'({T}, _, _, S, S, T) :- !.
+t_body({T}, _, _, S, S, T) :- !.
-'$t_body'((T,R), ToFill, Last, S, SR, (Tt,Rt)) :- !,
+t_body((T,R), ToFill, Last, S, SR, (Tt,Rt)) :- !,
-	'$t_body'(T, ToFill, not_last, S, SR1, Tt),
+	t_body(T, ToFill, not_last, S, SR1, Tt),
-	'$t_body'(R, ToFill, Last, SR1, SR, Rt).
+	t_body(R, ToFill, Last, SR1, SR, Rt).
-'$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
+t_body((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
-	'$t_body'(T, ToFill, not_last, S, SR1, Tt),
+	t_body(T, ToFill, not_last, S, SR1, Tt),
-	'$t_body'(R, ToFill, Last, SR1, SR, Rt).
+	t_body(R, ToFill, Last, SR1, SR, Rt).
-'$t_body'(\+T, ToFill, _, S, SR, (Tt->fail ; S=SR)) :- !,
+t_body(\+T, ToFill, _, S, SR, (Tt->fail ; S=SR)) :- !,
-	'$t_body'(T, ToFill, not_last, S, _, Tt).
+	t_body(T, ToFill, not_last, S, _, Tt).
-'$t_body'((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
+t_body((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
-	'$t_body'(T, _, last, S, SR, Tt),
+	t_body(T, _, last, S, SR, Tt),
-	'$t_body'(R, _, last, S, SR, Rt).
+	t_body(R, _, last, S, SR, Rt).
-'$t_body'((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
+t_body((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
-       '$t_body'(T, _, last, S, SR, Tt),
+       t_body(T, _, last, S, SR, Tt),
-       '$t_body'(R, _, last, S, SR, Rt).
+       t_body(R, _, last, S, SR, Rt).
-'$t_body'(M:G, ToFill, Last, S, SR, M:NG) :- !,
+t_body(M:G, ToFill, Last, S, SR, M:NG) :- !,
-	'$t_body'(G, ToFill, Last, S, SR, NG).
+	t_body(G, ToFill, Last, S, SR, NG).
-'$t_body'(T, filled_in, _, S, SR, Tt) :-
+t_body(T, filled_in, _, S, SR, Tt) :-
-	'$extend'([S,SR], T, Tt).
+	extend([S,SR], T, Tt).
 
 
 
-'$extend'(More, OldT, NewT) :-
+extend(More, OldT, NewT) :-
 	OldT =.. OldL,
 	lists:append(OldL, More, NewL),
 	NewT =.. NewL.
 
 
-'$t_tidy'(P,P) :- var(P), !.
+t_tidy(P,P) :- var(P), !.
-'$t_tidy'((P1;P2), (Q1;Q2)) :- !,
+t_tidy((P1;P2), (Q1;Q2)) :- !,
-	'$t_tidy'(P1, Q1),
+	t_tidy(P1, Q1),
-	'$t_tidy'(P2, Q2).
+	t_tidy(P2, Q2).
-'$t_tidy'((P1->P2), (Q1->Q2)) :- !,
+t_tidy((P1->P2), (Q1->Q2)) :- !,
-	'$t_tidy'(P1, Q1),
+	t_tidy(P1, Q1),
-	'$t_tidy'(P2, Q2).
+	t_tidy(P2, Q2).
-'$t_tidy'(((P1,P2),P3), Q) :-
+t_tidy(((P1,P2),P3), Q) :-
-	'$t_tidy'((P1,(P2,P3)), Q).
+	t_tidy((P1,(P2,P3)), Q).
-'$t_tidy'((true,P1), Q1) :- !,
+t_tidy((true,P1), Q1) :- !,
-	'$t_tidy'(P1, Q1).
+	t_tidy(P1, Q1).
-'$t_tidy'((P1,true), Q1) :- !,
+t_tidy((P1,true), Q1) :- !,
-	'$t_tidy'(P1, Q1).
+	t_tidy(P1, Q1).
-'$t_tidy'((P1,P2), (Q1,Q2)) :- !,
+t_tidy((P1,P2), (Q1,Q2)) :- !,
-	'$t_tidy'(P1, Q1),
+	t_tidy(P1, Q1),
-	'$t_tidy'(P2, Q2).
+	t_tidy(P2, Q2).
-'$t_tidy'(A, A).
+t_tidy(A, A).
 
 /** @pred  `C`( _S1_, _T_, _S2_) 
 
 
 This predicate is used by the grammar rules compiler and is defined as
 `C`([H|T],H,T)`.
-
-
-
-
  */
-'C'([X|S],X,S).
+prolog:'C'([X|S],X,S).
 
 
 /** @pred  phrase(+ _P_, _L_)
@@ -213,10 +209,8 @@ same as `phrase(P,L,[])`.
 
 Both this predicate and the previous are used as a convenient way to
 start execution of grammar rules.
-
- 
 */
-phrase(PhraseDef, WordList) :-
+prolog:phrase(PhraseDef, WordList) :-
 	phrase(PhraseDef, WordList, []).
 
 /** @pred  phrase(+ _P_, _L_, _R_) 
@@ -224,45 +218,47 @@ phrase(PhraseDef, WordList) :-
 
 This predicate succeeds when the difference list ` _L_- _R_`
 is a phrase of type  _P_.
-
- 
 */
-phrase(P, S0, S) :-
+prolog:phrase(P, S0, S) :-
 	call(P, S0, S).
 
-!(S, S).
+prolog:!(S, S).
 
-[](S, S).
+prolog:[](S, S).
 
-[](H, T, S0, S) :- lists:append([H|T], S, S0).
+prolog:[](H, T, S0, S) :- lists:append([H|T], S, S0).
 
-'.'(H,T, S0, S) :-
+prolog:'.'(H,T, S0, S) :-
 	lists:append([H|T], S, S0).
 
-{}(Goal, S0, S) :-
+prolog:{}(Goal, S0, S) :-
 	Goal,
 	S0 = S.
 
-','(A,B, S0, S) :-
+prolog:','(A,B, S0, S) :-
-	 '$t_body'((A,B), _, last, S0, S, Goal),
+	 t_body((A,B), _, last, S0, S, Goal),
 	 '$execute'(Goal).
 
-;(A,B, S0, S) :-
+prolog:;(A,B, S0, S) :-
-	 '$t_body'((A;B), _, last, S0, S, Goal),
+	 t_body((A;B), _, last, S0, S, Goal),
 	 '$execute'(Goal).
 
-'|'(A,B, S0, S) :-
+prolog:'|'(A,B, S0, S) :-
-	 '$t_body'((A|B), _, last, S0, S, Goal),
+	 t_body((A|B), _, last, S0, S, Goal),
 	 '$execute'(Goal).
 
-->(A,B, S0, S) :-
+prolog:->(A,B, S0, S) :-
-	 '$t_body'((A->B), _, last, S0, S, Goal),
+	 t_body((A->B), _, last, S0, S, Goal),
 	 '$execute'(Goal).
 
-\+(A, S0, S) :-
+prolog:\+(A, S0, S) :-
-	 '$t_body'(\+ A, _, last, S0, S, Goal),
+	 t_body(\+ A, _, last, S0, S, Goal),
 	 '$execute'(Goal).
 
+% stolen from SWI-Prolog
+
+
+
 /**
 @}
 */

pl/init.yap

@@ -118,10 +118,10 @@ otherwise.
 :- bootstrap('os.yap').
 :- bootstrap('absf.yap').
 
-:- [	 'utils.yap',
+:- [	 'directives.yap',
+	 'utils.yap',
 	 'control.yap',
 	 'arith.yap',
-	 'directives.yap',
 	 'flags.yap'
    ].
 

pl/load_foreign.yap

@@ -61,15 +61,15 @@ load_foreign_files(Objs,Libs,Entry) :-
     '$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
     '$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)),
     '$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
+    '$current_module'( M ),
     '$load_foreign_files'(NewObjs,NewLibs,Entry),
     ignore( recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _) ),
     (
-	prolog_load_context(file, F),
+	prolog_load_context(file, F)
-	prolog_load_context(module, M)
 	->
-    ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
+	    ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
-   ;
+	;
-    true
+	true
     ), !.
 
 '$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,

pl/messages.yap

@@ -97,8 +97,8 @@ generate_message('$abort') --> !,
 generate_message(abort(user)) --> !,
 	['YAP execution aborted'].
 generate_message(loading(_,F)) --> F == user, !.
-generate_message(loading(What,AbsoluteFileName)) --> !,
+generate_message(loading(What,FileName)) --> !,
-	[ '~a ~a...' - [What, AbsoluteFileName] ].
+	[ '~a ~w...' - [What, FileName] ].
 generate_message(loaded(_,user,_,_,_)) --> !.
 generate_message(loaded(included,AbsoluteFileName,Mod,Time,Space)) --> !,
 	[ '~a included in module ~a, ~d msec ~d bytes' - [AbsoluteFileName,Mod,Time,Space] ].

pl/modules.yap

@@ -705,8 +705,10 @@ expand_goal(G, G).
 	
 '$do_expand'(G, _, _, _, G) :- var(G), !.
 '$do_expand'(M:G, _CurMod, SM, HVars, M:GI) :- !,
+	 nonvar(M),
 	'$do_expand'(G, M, SM, HVars, GI).
 '$do_expand'(G, CurMod, _SM, _HVars, GI) :-
+	 nonvar(G),
 	(
 	 '$pred_exists'(goal_expansion(G,GI), CurMod),
 	 call(CurMod:goal_expansion(G, GI))
@@ -1567,7 +1569,6 @@ unload_module(Mod) :-
     op(X, 0, Mod:Op),
     fail.
 unload_module(Mod) :-
-    fail,
     current_predicate(Mod:P),
     abolish(P),
     fail.

pl/qly.yap

@@ -387,46 +387,54 @@ save_program(File, _Goal) :-
 	 call(db_import(myddas,Table,Table)),
 	 fail.
  '$myddas_import_all'.
-	 
+
+qsave_file(F0) :-
+    ensure_loaded(  F0 ),
+    absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
+    absolute_file_name( F0, State, [expand(true),file_type(qly)]),
+    '$qsave_file_'(File, State). 
+
 /** @pred qsave_file(+ _File_, +_State_)
 
 Saves an image of all the information compiled by the system from file _F_ to _State_. 
-This includes modules and predicatees eventually including multi-predicates.
+This includes modules and predicates eventually including multi-predicates.
 **/
 qsave_file(F0, State) :-
-    absolute_file_name( F0, File, [expand(true),file_type(qly)]),
+    ensure_loaded(  F0 ),
+    absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
     '$qsave_file_'(File, State).  
 
-'$qsave_file_'(File, _State) :-  
+'$qsave_file_'(File, UserF, _State) :- 
-   '$recorded'('$directive','$d'( File, M:G, Mode,  VL, Pos ), _),
+    ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
-    assert(prolog:'$file_property'( directive( M:G, Mode,  VL, Pos ) ) ),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
     fail.
-'$qsave_file_'(File, _State) :-
+'$qsave_file_'(File, UserF, State) :- 
-    recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
+    recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
-    '$fetch_parents_module'(Mod, Parents),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
-    '$fetch_imports_module'(Mod, Imps),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
-    assert(prolog:'$file_property'( module( Mod, Exps, L, Parents, Imps ) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
     fail.
-'$qsave_file_'(File, _State) :-
+'$qsave_file_'(File, _UserF, _State) :-  
+    recorded('$directive',directive( File, M:G, Mode,  VL, Pos ), _),
+    assert(user:'$file_property'( directive( M:G, Mode,  VL, Pos ) ) ),
+    '$set_owner_file'('$file_property'( _ ), user, File ),
+    fail.
+'$qsave_file_'(File, _UserF, _State) :-
     '$fetch_multi_files_file'(File, MultiFiles),
-    assert(prolog:'$file_property'( multifile(MultiFiles  ) ) ),
+    assert(user:'$file_property'( multifile(MultiFiles  ) ) ),
-    '$set_owner_file'(prolog:'$file_property'( _ ), File ),
+    '$set_owner_file'('$file_property'( _ ), user, File ),
     fail.
-'$qsave_file_'( File, State ) :-
+'$qsave_file_'( File, _UserF, State ) :-
     (
 	is_stream( State )
     ->
-	stream_property(Stream, file_name(File)),
+	'$qsave_file_preds'(State, File)
-	S = Stream,
-	'$qsave_file_preds'(S, File)
 	;
-        absolute_file_name( F0, File, [expand(true),file_type(qly)]),
 	open(State, write, S, [type(binary)]),
         '$qsave_file_preds'(S, File),
         close(S)
-    ), abolish(prolog:'$file_property'/2).
+    ), 
+    abolish(user:'$file_property'/1).
 
 '$fetch_multi_files_file'(File, Multi_Files) :-
 	setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files).
@@ -443,7 +451,7 @@ Saves an image of all the information compiled by the systemm on module _F_ to _
 **/
 
 qsave_module(Mod, OF) :- 
-	recorded('$module', '$module'(F,Mod,S,Exps,L), _),
+	recorded('$module', '$module'(F,Mod,Source,Exps,L), _),
 	'$fetch_parents_module'(Mod, Parents),
 	'$fetch_imports_module'(Mod, Imps),
 	'$fetch_multi_files_module'(Mod, MFs),
@@ -451,11 +459,11 @@ qsave_module(Mod, OF) :-
 	'$fetch_module_transparents_module'(Mod, ModTransps),
 	'$fetch_term_expansions_module'(Mod, TEs),
 	'$fetch_foreigns_module'(Mod, Foreigns),
-	asserta(Mod:'@mod_info'(S, Exps, MFs, L, Parents, Imps, Metas, ModTransps, Foreigns, TEs)),
+	asserta(Mod:'@mod_info'(Source, Exps, MFs, L, Parents, Imps, Metas, ModTransps, Foreigns, TEs)),
 	open(OF, write, S, [type(binary)]),
 	'$qsave_module_preds'(S, Mod),
 	close(S),
-	abolish(Mod:'@mod_info'/8),
+	abolish(Mod:'@mod_info'/10),
 	fail.
 qsave_module(_, _).
 
@@ -512,20 +520,34 @@ qload_module(Mod) :-
     '$current_module'(_, SourceModule),
     working_directory(_, OldD).
 
-'$qload_module'(Mod, File, _SourceModule) :-
+'$qload_module'(Mod, S, SourceModule) :-
-    unload_module( Mod ),
+    is_stream( S ), !,
-    fail.
+    '$q_header'( S, Type ),
-'$qload_module'(Mod, File, _SourceModule) :-
+    stream_property( S, file_name( File )),
-    open(File, read, S, [type(binary)]),
+    ( Type == module ->
-    '$qload_module_preds'(S),
+	  '$qload_module'(S , Mod, File, SourceModule)
-    close(S),
+    ;
-    fail.
+      Type == file ->
+	  '$qload_file'(S, File)	  
+    ).
 '$qload_module'(Mod, File, SourceModule) :-
-    '$complete_read_module'(Mod, File, SourceModule).
+    open(File, read, S, [type(binary)]),
+    '$q_header'( S, Type ),
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	  '$qload_file'(S, File)	  
+    ),
+    close(S).
 
-'$complete_read_module'(Mod, File, CurrentModule) :-
+'$qload_module'(_S, Mod, _File, _SourceModule) :-
+    unload_module( Mod ), fail.
+'$qload_module'(S, _Mod, _File, _SourceModule) :-
+    '$qload_module_preds'(S), fail.
+'$qload_module'(_S, Mod, File, SourceModule) :-
     Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs),
-    abolish(Mod:'@mod_info'/9),
+    abolish(Mod:'@mod_info'/10),
     recorda('$module', '$module'(File, Mod, F, Exps, Line), _),
     '$install_parents_module'(Mod, Parents),
     '$install_imports_module'(Mod, Imps, []),
@@ -536,8 +558,8 @@ qload_module(Mod) :-
     '$install_term_expansions_module'(Mod, TEs),
     % last, export everything to the host: if the loading crashed you didn't actually do
     % no evil.
-    '$convert_for_export'(all, Exps, Mod, CurrentModule, TranslationTab, AllExports0, qload_module),
+    '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, AllExports0, qload_module),
-    '$add_to_imports'(TranslationTab, Mod, CurrentModule), % insert ops, at least for now
+    '$add_to_imports'(TranslationTab, Mod, SourceModule), % insert ops, at least for now
     sort( AllExports0, AllExports ).
 
 '$fetch_imports_module'(Mod, Imports) :-
@@ -551,7 +573,7 @@ qload_module(Mod) :-
 '$fetch_parents_module'(Mod, Parents) :-
 	findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents).
 
-'$fetch_module_transparents_module'(Mod, Module_Transparents) :-
+'$fetch_module_transparents_module'(Mod, Mmodule_Transparents) :-
 	findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents).
 
 % detect an module_transparenterator that is local to the module.
@@ -571,9 +593,12 @@ qload_module(Mod) :-
 % detect an multi_file that is local to the module.
 '$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :-
 	recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
+'$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,_Module,Clause), _) :-
+    recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef), _),
+    instance(R, Clause ).
 
-'$fetch_term_expansions_module'(Mod, Term_Expansions) :-
+'$fetch_term_expansions_module'(Mod, TEs) :-
-	findall(Info, '$fetch_term_expansion_module'(Mod, Info), Term_Expansions).
+	findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
 
 % detect an term_expansionerator that is local to the module.
 '$fetch_term_expansion_module'(Mod, ( user:term_expansion(G, GI) :- Bd )) :-
@@ -673,41 +698,78 @@ qload_module(Mod) :-
 Restores a previously saved state of YAP contaianing a qly file  _F_.
 
 */
-qload_file(F0) :-
+qload_file( F0 ) :-
-    H0 is heapused, '$cputime'(T0,_),
+    ( '$swi_current_prolog_flag'(verbose_load, false)
-    ( is_strean( F0 ) 
+      ->
+	Verbosity = silent
+	;
+	Verbosity = informational
+    ),
+    StartMsg = loading_module,
+    '$current_module'( SourceModule ),
+    H0 is heapused, 
+    '$cputime'(T0,_),
+    ( is_stream( F0 ) 
       ->
       stream_property(F0, file_name(File) ),
-      S = F0
+      File = FilePl,
+      S = File
     ;
       absolute_file_name( F0, File, [expand(true),file_type(qly)]),
+      absolute_file_name( F0, FilePl, [expand(true),file_type(prolog)]),
+      unload_file( FilePl ),
       open(File, read, S, [type(binary)])
     ),
-    '$qload_file_preds'(S, File),
+    print_message(Verbosity, loading(StartMsg, File)),
-    close(S),
-    fail 
-    ;
-    '$complete_read_file'(File).
-
-'$complete_read_file'(File) :-
     file_directory_name(File, DirName),
-    working_directory(OldD, Dir),
+    working_directory(OldD, DirName),
-    '$process_directives'( File ),
+    '$q_header'( S, Type ),
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	  '$qload_file'(S, SourceModule, File, FilePl, F0, all)	  
+    ),
+    close(S),
     working_directory( _, OldD),
     H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
-    '$current_module'(Mod, SourceModule),
+    '$current_module'(Mod, Mod ),
-    fail.
+    print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
+    '$exec_initialisation_goals'.
 
-'$process_directives' :-
+'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
-    prolog:'$file_property'( multifile( List ) ),
+    recorded('$lf_loaded','$lf_loaded'( F, _Age, SourceModule), _),
+   !.
+'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList) :-
+    '$qload_file_preds'(S),
+    fail.
+'$qload_file'(S, SourceModule, F, FilePl, _F0, _ImportList) :-
+    user:'$file_property'( '$lf_loaded'( _, Age, _ ) ),
+    recordaifnot('$lf_loaded','$lf_loaded'( F, Age, SourceModule), _),
+    fail.
+'$qload_file'(_S, SourceModule, _File, FilePl, F0, _ImportList) :-
+    b_setval('$source_file', F0 ),
+    '$process_directives'( FilePl ),
+    fail.
+'$qload_file'(_S, SourceModule, _File,  FilePl, _F0, ImportList) :-
+    '$import_to_current_module'(FilePl, SourceModule, ImportList, _, _TOpts).
+
+'$process_directives'( FilePl ) :-
+    user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ),
+    recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _),
+    fail.
+'$process_directives'( _FilePl ) :-
+    user:'$file_property'( multifile( List ) ),
     lists:member( Clause, List ),
     assert( Clause ),
     fail.
-'$process_directives' :-
+'$process_directives'( FilePl ) :-
-    prolog:'$file_property'( directive( M:G, Mode,  VL, Pos  ) ),
+    user:'$file_property'( directive( MG, Mode,  VL, Pos  ) ),
-    '$exec_directive'(G, Mode, M, VL, Pos),
+    '$set_source'( FilePl, Pos ),
+    strip_module(MG, M, G),
+    '$process_directive'(G, reconsult, M, VL, Pos),
     fail.
-'$process_directives' :-
+'$process_directives'( _FilePl ) :-
-    abolish(prolog:'$file_property'/1).
+    abolish(user:'$file_property'/1).