Exemplo n.º 1
0
static Code
chainMetaPredicateSupervisor(Definition def, Code post)
{ if ( true(def, P_META) && true(def, P_TRANSPARENT) )
  { tmp_buffer buf;
    unsigned int i;
    int count = 0;
    Code codes;

    initBuffer(&buf);
    for(i=0; i < def->functor->arity; i++)
    { int ma = def->impl.any.args[i].meta;

      if ( MA_NEEDS_TRANSPARENT(ma) )
      { addBuffer(&buf, encode(S_MQUAL), code);
	addBuffer(&buf, VAROFFSET(i), code);
	count++;
      }
    }

    if ( count > 0 )
    { baseBuffer(&buf, code)[(count-1)*2] = encode(S_LMQUAL);

      copySuperVisorCode((Buffer)&buf, post);
      freeCodes(post);
      codes = allocCodes(entriesBuffer(&buf, code));
      copyCodes(codes, baseBuffer(&buf, code), entriesBuffer(&buf, code));

      return codes;
    } else
    { discardBuffer(&buf);
    }
  }

  return post;
}
Exemplo n.º 2
0
void
PL_register_blob_type(PL_blob_t *type)
{ PL_LOCK(L_MISC);			/* cannot use L_ATOM */

  if ( !type->registered )
  { if ( !GD->atoms.types )
    { GD->atoms.types = type;
    } else
    { PL_blob_t *t = GD->atoms.types;

      while(t->next)
	t = t->next;

      t->next = type;
      type->rank = t->rank+1;
    }
    type->registered = TRUE;
    if ( !type->atom_name )
      type->atom_name = PL_new_atom(type->name);

    if ( true(type, PL_BLOB_TEXT) )
    { if ( true(type, PL_BLOB_WCHAR) )
	type->padding = sizeof(pl_wchar_t);
      else
	type->padding = sizeof(char);
    }
  }

  PL_UNLOCK(L_MISC);
}
Exemplo n.º 3
0
static Code
chainMetaPredicateSupervisor(Definition def, Code post)
{ if ( true(def, P_META) && true(def, P_TRANSPARENT) )
  { tmp_buffer buf;
    unsigned int i;
    int count = 0;
    Code codes;

    initBuffer(&buf);
    for(i=0; i < def->functor->arity; i++)
    { int ma = MA_INFO(def, i);

      if ( ma <= 9 || ma == MA_META || ma == MA_HAT || ma == MA_DCG ) /* 0..9, :, ^ or // */
      { addBuffer(&buf, encode(S_MQUAL), code);
	addBuffer(&buf, VAROFFSET(i), code);
	count++;
      }
    }

    if ( count > 0 )
    { baseBuffer(&buf, code)[(count-1)*2] = encode(S_LMQUAL);

      copySuperVisorCode((Buffer)&buf, post);
      freeCodes(post);
      codes = allocCodes(entriesBuffer(&buf, code));
      copyCodes(codes, baseBuffer(&buf, code), entriesBuffer(&buf, code));

      return codes;
    } else
    { discardBuffer(&buf);
    }
  }

  return post;
}
Exemplo n.º 4
0
static size_t
paddingBlob(PL_blob_t *type)
{ if ( true(type, PL_BLOB_TEXT) )
  { return true(type, PL_BLOB_WCHAR) ? sizeof(pl_wchar_t) : sizeof(char);
  } else
  { return 0;
  }
}
Exemplo n.º 5
0
static Code
multifileSupervisor(Definition def)
{ if ( true(def, (P_DYNAMIC|P_MULTIFILE)) )
  { if ( true(def, P_DYNAMIC) )
      return SUPERVISOR(dynamic);
    else
      return SUPERVISOR(multifile);
  }

  return NULL;
}
Exemplo n.º 6
0
int
createForeignSupervisor(Definition def, Func f)
{ assert(true(def, P_FOREIGN));

  if ( false(def, P_VARARG) )
  { if ( def->functor->arity > MAX_FLI_ARGS )
      sysError("Too many arguments to foreign function %s (>%d)", \
	       predicateName(def), MAX_FLI_ARGS); \
  }

  if ( false(def, P_NONDET) )
  { Code codes = allocCodes(4);

    codes[0] = encode(I_FOPEN);
    if ( true(def, P_VARARG) )
      codes[1] = encode(I_FCALLDETVA);
    else
      codes[1] = encode(I_FCALLDET0+def->functor->arity);
    codes[2] = (code)f;
    codes[3] = encode(I_FEXITDET);

    def->codes = codes;
  } else
  { Code codes = allocCodes(5);

    codes[0] = encode(I_FOPENNDET);
    if ( true(def, P_VARARG) )
      codes[1] = encode(I_FCALLNDETVA);
    else
      codes[1] = encode(I_FCALLNDET0+def->functor->arity);
    codes[2] = (code)f;
    codes[3] = encode(I_FEXITNDET);
    codes[4] = encode(I_FREDO);

    def->codes = codes;
  }

#ifdef O_PROF_PENTIUM
  assert(prof_foreign_index < MAXPROF);
  def->prof_index = prof_foreign_index++;
  def->prof_name  = strdup(predicateName(def));
#endif

  succeed;
}
Exemplo n.º 7
0
static int
release_clause(atom_t aref)
{ clref *ref = PL_blob_data(aref, NULL, NULL);

  clear(ref->clause, DBREF_CLAUSE);
  if ( true(ref->clause, DBREF_ERASED_CLAUSE) )
    unallocClause(ref->clause);

  return TRUE;
}
Exemplo n.º 8
0
int
hasProcedureSourceFile(SourceFile sf, Procedure proc)
{ ListCell cell;

  if ( true(proc->definition, FILE_ASSIGNED) )
  { for(cell=sf->procedures; cell; cell = cell->next)
    { if ( cell->value == proc )
	succeed;
    }
  }

  fail;
}
Exemplo n.º 9
0
int
PL_get_clref(term_t t, Clause *cl)
{ struct clref *ref;
  PL_blob_t *type;

  if ( !PL_get_blob(t, (void**)&ref, NULL, &type) ||
       type != &clause_blob )
    return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_db_reference, t);

  *cl = ref->clause;

  if ( true(ref->clause, CL_ERASED) )
    return -1;

  return TRUE;
}
Exemplo n.º 10
0
int demo_test_pass()
{
	tf_assert(true(), "This demo_test should pass silently");
	tf_passed();
}