void *mk_scon(char *s)
{
unsigned nbytes = strlen(s);
unsigned header = RML_STRINGHDR(nbytes);
unsigned nwords = RML_HDRSLOTS(header) + 1;
struct rml_string *p = alloc_words(nwords);
p->header = header;
memcpy(p->data, s, nbytes+1); /* including terminating '\0' */
return RML_TAGPTR(p);
}
RML_END_LABEL
RML_BEGIN_LABEL(BackendDAEEXT__setAssignment)
{
int nelts=0;
int nass1 = RML_UNTAGFIXNUM(rmlA0);
int nass2 = RML_UNTAGFIXNUM(rmlA1);
int i=0;
nelts = RML_HDRSLOTS(RML_GETHDR(rmlA2));
if (nelts > 0) {
n = nass1;
if(match) {
free(match);
}
match = (int*) malloc(n * sizeof(int));
memset(match,-1,n * sizeof(int));
for(i=0; i<n; ++i) {
match[i] = RML_UNTAGFIXNUM(RML_STRUCTDATA(rmlA2)[i])-1;
if (match[i]<0) match[i] = -1;
}
}
nelts = RML_HDRSLOTS(RML_GETHDR(rmlA3));
if (nelts > 0) {
m = nass2;
if(row_match) {
free(row_match);
}
row_match = (int*) malloc(m * sizeof(int));
memset(row_match,-1,m * sizeof(int));
for(i=0; i<m; ++i) {
row_match[i] = RML_UNTAGFIXNUM(RML_STRUCTDATA(rmlA3)[i])-1;
if (row_match[i]<0) row_match[i] = -1;
}
}
rmlA0 = mk_bcon(1);
RML_TAILCALLK(rmlSC);
}
/*
* p_equal.c -- implements polymorphic equality for RML
* (This is the reason why reference nodes must still be distinguishable
* from all other values.)
*/
void *rml_prim_equal(void *p, void *q)
{
tail_recur:
/* INV: ISIMM(p) <==> ISIMM(q) */
if( p == q ) {
/* Identical objects are always equal. */
return RML_TRUE;
} else if( RML_ISIMM(p) ) {
/* Different immediate values. */
return RML_FALSE;
} else {
/* Non-identical boxed values. */
rml_uint_t phdr = RML_GETHDR(p);
rml_uint_t qhdr = RML_GETHDR(q);
if( phdr == qhdr ) {
if( phdr == RML_REALHDR ) {
return (rml_prim_get_real(p) == rml_prim_get_real(q))
? RML_TRUE
: RML_FALSE;
} else if( RML_HDRISSTRING(phdr) ) {
if( !memcmp(RML_STRINGDATA(p), RML_STRINGDATA(q), RML_HDRSTRLEN(phdr)) )
return RML_TRUE;
else
return RML_FALSE;
} else if( RML_HDRISSTRUCT(phdr) ) {
rml_uint_t slots = RML_HDRSLOTS(phdr);
void **pp = RML_STRUCTDATA(p);
void **qq = RML_STRUCTDATA(q);
if( slots == 0 )
return RML_TRUE;
while( --slots > 0 )
if( rml_prim_equal(*pp++, *qq++) == RML_FALSE )
return RML_FALSE;
p = *pp;
q = *qq;
goto tail_recur;
} else {
/* Non-identical reference nodes. */
return RML_FALSE;
}
} else {
/* Different sized strings, different constructors of some datatype,
* or reference nodes with different instantiation states.
*/
return RML_FALSE;
}
}
}
void *mk_scon(char *s) {
rml_uint_t nbytes = strlen(s);
rml_uint_t header= RML_STRINGHDR(nbytes);
rml_uint_t nwords= RML_HDRSLOTS(header) + 1;
if (!rml_string_cache_index) /* no string in the cache */
{
struct rml_string *p = alloc_words(nwords);
p->header = header;
memcpy(p->data, s, nbytes+1); /* including terminating '\0' */
if (rml_string_cache_index < RML_STRING_CACHE_MAX &&
nbytes < RML_SHARED_STRING_MAX) /* add to sharing only if less than RML_SHARED_STRING_MAX */
rml_string_cache[rml_string_cache_index++] = p;
return RML_TAGPTR(p);
}
/* else, try to find if we already have the same string in the heap */
{
unsigned int i;
struct rml_string *p;
for (i = 0; i < rml_string_cache_index; i++)
{
p = rml_string_cache[i];
if (strcmp(p->data,s) == 0)
{
rml_total_shared_strings++;
rml_total_shared_strings_words += nwords;
return RML_TAGPTR(p);
}
}
/* no string found in cache */
{
struct rml_string *p = alloc_words(nwords);
p->header = header;
memcpy(p->data, s, nbytes+1); /* including terminating '\0' */
if (rml_string_cache_index < RML_STRING_CACHE_MAX &&
nbytes < RML_SHARED_STRING_MAX) /* add to sharing only if less than RML_SHARED_STRING_MAX */
rml_string_cache[rml_string_cache_index++] = p;
return RML_TAGPTR(p);
}
}
}
RML_END_LABEL
void rmldb_var_print(void *p)
{
/* printf("[%p]", p); */
if (!p) { printf ("NIL"); fflush(stdout); return; }
if( RML_ISIMM(p) )
{
printf ("%d", RML_UNTAGFIXNUM(p));
}
else
{
rml_uint_t phdr = RML_GETHDR(p);
if( phdr == RML_REALHDR )
{
printf ("%f", rml_prim_get_real(p));
fflush(stdout);
} else
if( RML_HDRISSTRING(phdr) )
{
printf ("\"%s\"", RML_STRINGDATA(p));
fflush(stdout);
/* use if neccesarry RML_HDRSTRLEN(phdr) */
} else
if( RML_HDRISSTRUCT(phdr) )
{
rml_uint_t slots = RML_HDRSLOTS(phdr);
rml_uint_t constr = RML_HDRCTOR(phdr);
void **pp = NULL;
if (slots == 0)
{
printf ("{S(%d)[%d]=NIL}", constr, slots);
fflush(stdout);
return;
}
printf ("S(%d)[%d](", constr, slots);
pp = RML_STRUCTDATA(p);
fflush(stdout);
// function definition
if ((constr == 64 || constr==13) &&
slots > 1000000) return;
if( slots != 0 )
{
// printf ("\n\t");
while( --slots > 0 )
{
rmldb_var_print(*pp++);
printf (",");
fflush(stdout);
}
p = *pp;
rmldb_var_print(*pp); printf (")"); fflush(stdout);
// goto tail_recur_debug;
}
}
else
{
printf ("UNKNOWN"); fflush(stdout);
}
}
}
