static SDF_Attribute PTAttrToSDFAttribute(PT_Attr ptAttr)
{
SDF_Attribute result;
if (PT_isAttrAssoc(ptAttr)) {
PT_Associativity ptAssoc = PT_getAttrAssoc(ptAttr);
SDF_Associativity sdfAssoc;
if (PT_isAssociativityLeft(ptAssoc)) {
sdfAssoc = SDF_makeAssociativityLeft();
}
else if (PT_isAssociativityRight(ptAssoc)) {
sdfAssoc = SDF_makeAssociativityRight();
}
else if (PT_isAssociativityAssoc(ptAssoc)) {
sdfAssoc = SDF_makeAssociativityAssoc();
}
else {
sdfAssoc = SDF_makeAssociativityNonAssoc();
}
result = SDF_makeAttributeAssoc(sdfAssoc);
}
else if (PT_isAttrTerm(ptAttr)) {
ATerm term = PT_getAttrTerm(ptAttr);
ATabort("Conversion of plain ATerm not yet implemented: %t\n", term);
result = NULL;
}
else if (PT_isAttrId(ptAttr)) {
char *str = PT_getAttrModuleName(ptAttr);
SDF_ModuleId sdfModuleId;
SDF_ModuleName sdfModuleName;
sdfModuleId = SDF_makeModuleIdWord(SDF_makeCHARLISTString(str));
sdfModuleName = SDF_makeModuleNameUnparameterized(sdfModuleId);
result = SDF_makeAttributeId(SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty(),
sdfModuleName,
SDF_makeLayoutEmpty());
}
else if (PT_isAttrBracket(ptAttr)) {
result = SDF_makeAttributeBracket();
}
else if (PT_isAttrReject(ptAttr)) {
result = SDF_makeAttributeReject();
}
else if (PT_isAttrPrefer(ptAttr)) {
result = SDF_makeAttributePrefer();
}
else if (PT_isAttrAvoid(ptAttr)) {
result = SDF_makeAttributeAvoid();
}
else {
ATabort("Unsupported attribute: %t\n", ptAttr);
result = NULL;
}
return result;
}
AN2Type ACR_dataSortToAN2Type(ANK_DataSort ds) {
//if (ANK_isValidDataSort(ds) == ATfalse)
// ATabort("Invalid datasort: %t.\n", (ATerm)ds);
if (ANK_isDataSortSortname(ds) == ATtrue) {
ANK_SortName sort = ANK_getDataSortSortName(ds);
#ifdef DEBUG
ATwarning("sort = %t\n",sort);
#endif
if (ANK_isSortNameData(sort))
return AN2_DATA_CASTABLE_TYPE;
if (ANK_isSortNameDatum(sort))
return AN2_DATUM_CASTABLE_TYPE;
if (ANK_isSortNameBindable(sort))
return AN2_DATUM_CASTABLE_TYPE;
if (ANK_isSortNameBindings(sort))
return AN2_BINDINGS_TYPE;
if (ANK_isSortNameAgent(sort))
return AN2_AGENT_TYPE;
if (ANK_isSortNameCell(sort))
return AN2_CELL_TYPE;
if (ANK_isSortNameStorable(sort))
return AN2_DATUM_CASTABLE_TYPE;
if (ANK_isSortNameAction(sort))
return AN2_ACTION_TYPE;
if (ANK_isSortNameToken(sort))
return AN2_TOKEN_TYPE;
if (ANK_isSortNameString(sort))
return AN2_STRING_TYPE;
if (ANK_isSortNameMessage(sort))
return AN2_DATUM_CASTABLE_TYPE;
if (ANK_isSortNameMessageTag(sort))
return AN2_MESSAGETAG_TYPE;
if (ANK_isSortNameList(sort))
return AN2_LIST_TYPE;
if (ANK_isSortNameBool(sort))
return AN2_BOOL_TYPE;
if (ANK_isSortNameNat(sort))
return AN2_INT_TYPE;
if (ANK_isSortNamePos(sort))
return AN2_INT_TYPE;
if (ANK_isSortNameInt(sort))
return AN2_INT_TYPE;
ATabort("SortName %t not supported.\n", (ATerm)sort);
}
if (ANK_isDataSortOutcome(ds) == ATtrue)
return AN2_ACTION_TYPE;
ATabort("Datasort %t not supported.\n", (ATerm)ds);
return (AN2Type)NULL;
}
void addTable(const char *name, const char * valueType)
{
int i;
if (!TS_tableExists(name)) {
for (i = 0; i < MAX_NR_OF_TABLES; i++) {
if (tableStore[i].name == NULL) {
tableStore[i].name = strdup(name);
tableStore[i].valueType = strdup(valueType);
tableStore[i].table = T_createTable();
return;
}
}
}
else {
if (!streq(tableStore[TS_findTable(name)].valueType, valueType)) {
ATabort("Table %s already exists with different value type than %s\n",
name, valueType);
}
return;
}
ATerror("addTable: table store exhausted.\n");
}
funcptr lookup_func(ATerm prod)
{
funcptr f = basic_lookup_func(prod);
if(!f) {
ATabort("unknown function: %t\n", prod);
return (funcptr) NULL; /* silence the compiler, we never get here. */
}
else return f;
}
void TS_initTableStore()
{
if (tableStore == NULL) {
tableStore = (TableEntry*) calloc(MAX_NR_OF_TABLES,
sizeof(TableEntry));
if (tableStore == NULL) {
ATabort("initTableStore: out of memory\n");
}
}
}
void register_prod(ATerm prod, funcptr func, Symbol sym)
{
unsigned int hnr; /* hash number */
bucket *b; /* single bucket */
/* Heuristics for deciding when to rehash */
if((nr_entries*100)/table_size > MAX_LOAD) {
c_rehash(table_size*2);
}
#ifdef NO_SHARING
/* calc_hash is recursive, so no mod included */
hnr = calc_hash(prod);
hnr %= table_size;
#else
hnr = HASH_PROD(prod, table_size);
#endif
/* Find out if this function has already been registered */
b = prod_table[hnr];
while(b && !ATisEqual(b->prod, prod))
b = b->next_prod;
/* if already registered, we are done */
if(b)
return;
/* Else we should add a new bucket */
b = malloc(sizeof(bucket));
if(!b)
ATabort("out of memory in register.\n");
b->next_prod = prod_table[hnr];
prod_table[hnr] = b;
/* Add it to the sym table also. */
hnr = HASH_SYM(sym, table_size);
b->next_sym = sym_table[hnr];
sym_table[hnr] = b;
/* The prod field of the bucket is protected against
* the gc.
*/
b->prod = prod;
ATprotect((ATerm*)&(b->prod));
b->func = func;
b->sym = sym;
}
ATerm lookup_prod(Symbol sym)
{
bucket *b;
unsigned int hnr;
hnr = HASH_SYM(sym, table_size);
b = sym_table[hnr];
while(b) {
if(b->sym == sym)
return b->prod;
b = b->next_sym;
}
ATabort("unknown symbol: %s\n", ATgetName(sym));
return (ATerm) NULL; /* silence the compiler, we never get here. */
}
void delete_session(int cid, ATerm sid) {
EM_Session session = getSession(sid);
if (session != NULL) {
int referenceCount = EM_getSessionReferenceCount(session);
if (referenceCount == 0) {
ATtableRemove(sessions, sid);
ATtableRemove(bindings, sid);
}
else {
putSession(EM_setSessionStatus(session, EM_makeSessionStatusZombie()));
}
}
else {
ATabort("delete_session: no such session: %t\n", sid);
}
}
int main(int argc, char **argv) {
int i;
ATerm bos;
ATermList list;
ATinit(argc,argv,&bos);
list = ATempty;
for (i = 1; i < argc; i++) {
FILE *f = fopen(argv[i], "r");
ATwarning("Adding %s.\n", argv[i]);
if (!f) ATabort("Error opening file %s.\n", argv[i]);
list = ATconcat(list,(ATermList)ATreadFromTextFile(f));
fclose(f);
}
ATwriteToTextFile((ATerm)list,stdout);
return 0;
}
void register_editor(int cid, ATerm sid, ATerm editorType) {
EM_Session session;
session = getSession(sid);
if (session != NULL) {
EM_EditorType type = EM_EditorTypeFromTerm(editorType);
EM_EditorTypeList types = EM_getSessionList(session);
while (!EM_isEditorTypeListEmpty(types)) {
EM_EditorType cur = EM_getEditorTypeListHead(types);
if (EM_isEqualEditorType(cur, type)) {
ATabort("register_editor: type already registered: %t\n", editorType);
}
types = EM_getEditorTypeListTail(types);
}
types = EM_makeEditorTypeListMany(type, EM_getSessionList(session));
putSession(EM_setSessionList(session, types));
}
}
void c_rehash(int newsize)
{
int i;
unsigned int hnr;
bucket **newprodtable, **newsymtable, *b, *next;
/* Allocate new hash tables */
newprodtable = (bucket **)calloc(newsize, sizeof(bucket *));
newsymtable = (bucket **)calloc(newsize, sizeof(bucket *));
if(!newsymtable || !newprodtable) {
ATabort("out of memory in c_rehash(%d)", newsize);
}
/* Rehash all the old buckets. */
if(prod_table) {
for(i=0; i<table_size; i++) {
b = prod_table[i];
while(b) {
next = b->next_prod;
hnr = HASH_PROD(b->prod, newsize);
b->next_prod = newprodtable[hnr];
newprodtable[hnr] = b;
b = next;
}
b = sym_table[i];
while(b) {
next = b->next_sym;
hnr = HASH_SYM(b->sym, newsize);
b->next_sym = newsymtable[hnr];
newsymtable[hnr] = b;
b = next;
}
}
}
if(prod_table) {
free(prod_table);
free(sym_table);
}
prod_table = newprodtable;
sym_table = newsymtable;
table_size = newsize;
}
ATerm bind_session(int cid, ATerm sid, ATerm moduleId) {
assert(sid != NULL);
assert(moduleId != NULL);
if (getSession(sid) == NULL) {
return sndValue(ATmake("no-such-session"));
}
else {
EM_ModuleId id = getModuleId(sid);
EM_ModuleId module = EM_ModuleIdFromTerm(moduleId);
if (id != NULL && EM_isEqualModuleId(module, id) != 0) {
ATabort("editor-manager:bind_session: attempt to rebind %t (%t)\n",
sid, moduleId);
}
putModuleId(sid, module);
return sndValue(ATmake("session-bound"));
}
}
void unregister_editor(int cid, ATerm sid, ATerm editorType) {
EM_Session session;
session = getSession(sid);
if (session != NULL) {
EM_EditorType type = EM_EditorTypeFromTerm(editorType);
EM_EditorTypeList types = EM_getSessionList(session);
EM_EditorTypeList stripped = EM_makeEditorTypeListEmpty();
while (!EM_isEditorTypeListEmpty(types)) {
EM_EditorType cur = EM_getEditorTypeListHead(types);
if (!EM_isEqualEditorType(cur, type)) {
stripped = EM_makeEditorTypeListMany(cur, stripped);
}
types = EM_getEditorTypeListTail(types);
}
if (EM_isEqualEditorTypeList(stripped, EM_getSessionList(session))) {
ATabort("unregister_editor: no such registered type: %t\n", editorType);
}
putSession(EM_setSessionList(session, stripped));
}
}
Symbol lookup_sym(ATerm prod)
{
bucket *b;
unsigned int hnr;
#ifdef NO_SHARING
hnr = calc_hash(prod);
hnr %= table_size;
#else
hnr = HASH_PROD(prod, table_size);
#endif
b = prod_table[hnr];
while(b) {
if(ATisEqual(b->prod, prod))
return b->sym;
b = b->next_prod;
}
ATabort("Unknown function: %t\n", prod);
return (Symbol) 0; /* silence the compiler, we never get here. */
}
void end_transaction(int cid, ATerm sid) {
EM_Session session = getSession(sid);
if (session != NULL) {
int referenceCount = EM_getSessionReferenceCount(session);
assert(referenceCount > 0);
referenceCount--;
session = EM_setSessionReferenceCount(session, referenceCount);
putSession(session);
if (referenceCount == 0) {
EM_SessionStatus status = EM_getSessionStatus(session);
if (EM_isSessionStatusZombie(status)) {
ATtableRemove(sessions, sid);
}
}
}
else {
ATabort("editor-manager.c:end_transaction: no such session %t\n", sid);
}
}
static void reclaim_empty_block(Block **blocks, int size, Block *removed_block, Block *prev_block)
{
nb_reclaimed_blocks_during_last_gc[size]++;
/*
* Step 1:
*
* remove cells from at_freelist[size]
* remove the block from at_blocks[size]
*
*/
#ifdef GC_VERBOSE
fprintf(stdout,"block %x is empty\n",(unsigned int)removed_block);
#endif
at_nrblocks[size]--;
removed_block->size = 0;
if(prev_block == NULL) {
/*fprintf(stderr,"restore_block: remove first\n");*/
blocks[size] = removed_block->next_by_size;
if(blocks==at_blocks && at_blocks[size]) {
top_at_blocks[size] = at_blocks[size]->end;
}
} else {
/*fprintf(stderr,"restore_block: remove middle\n");*/
prev_block->next_by_size = removed_block->next_by_size;
}
/*
* Step 2:
*
* put the block into at_freeblocklist
*
*/
removed_block->next_by_size = at_freeblocklist;
at_freeblocklist = removed_block;
at_freeblocklist_size++;
/*
* Step 3:
*
* remove the block from block_table
* free the memory
*
*/
if(at_freeblocklist_size > max_freeblocklist_size) {
int idx, next_idx;
Block *cur;
Block *prev = NULL;
assert(removed_block != NULL);
idx = ADDR_TO_BLOCK_IDX(removed_block);
next_idx = (idx+1)%BLOCK_TABLE_SIZE;
for(cur=block_table[idx].first_after; cur ; prev=cur, cur=cur->next_after) {
if(removed_block == cur) {
break;
}
}
if(!cur) {
ATabort("### block %d not found\n",removed_block);
}
if(prev==NULL) {
block_table[idx].first_after = removed_block->next_after;
block_table[next_idx].first_before = removed_block->next_after;
} else {
prev->next_after = removed_block->next_after;
prev->next_before = removed_block->next_before;
}
at_freeblocklist_size--;
at_freeblocklist = at_freeblocklist->next_by_size;
#ifdef GC_VERBOSE
fprintf(stderr,"free block %d\n",(int)removed_block);
#endif
free(removed_block);
}
}
static void term2buf(ATerm t)
{
ATerm annos = AT_getAnnotations(t);
if(annos != NULL) {
char2buf('{');
}
switch(ATgetType(t)) {
case AT_INT:
wprintf("%d", ATgetInt((ATermInt)t));
break;
case AT_REAL:
wprintf("%f", ATgetReal((ATermReal)t));
break;
case AT_APPL:
{
int cur_arg, arity;
ATermAppl appl = (ATermAppl)t;
AFun sym = ATgetSymbol(appl);
if(ATisQuoted(sym))
qstr2buf(ATgetName(sym));
else
str2buf(ATgetName(sym));
arity = ATgetArity(sym);
if(arity > 0) {
char2buf('(');
for(cur_arg=0; cur_arg<arity; cur_arg++) {
term2buf(ATgetArgument(appl, cur_arg));
if(cur_arg < (arity-1))
char2buf(',');
}
char2buf(')');
}
}
break;
case AT_LIST:
{
ATermList l = (ATermList)t;
char2buf('{');
while(!ATisEmpty(l)) {
ATerm el = ATgetFirst(l);
l = ATgetNext(l);
term2buf(el);
if(!ATisEmpty(l))
char2buf(' ');
}
char2buf('}');
}
break;
case AT_PLACEHOLDER:
{
char2buf('<');
term2buf(ATgetPlaceholder((ATermPlaceholder)t));
char2buf('>');
}
break;
case AT_BLOB:
ATerror("blobs are not supported by tcltk-adapter!\n");
default:
ATabort("illegal term type!\n");
}
if(annos != NULL) {
char2buf(' ');
term2buf(annos);
char2buf('}');
}
}
AN2Data ACR_dataToAN2Data(ANK_Data data) {
if (an2_is_valid_data((AN2Data)data))
return (AN2Data)data;
#ifdef DEBUG
ATwarning("data: %t\n",data);
#endif
if (ANK_isDataDatum(data)) {
ANK_Datum u = ANK_getDataDatum(data);
#ifdef DEBUG
ATwarning("datum: %t\n",u);
#endif
if (ANK_isDatumAgent(u)) {
ATabort("Non-supported datum: %t.\n", (ATerm)u);
}
if (ANK_isDatumCell(u)) {
ATabort("Non-supported datum: %t.\n", (ATerm)u);
}
if (ANK_isDatumAction(u)) {
ANK_Action a = ANK_getDatumAction(u);
/* We don't want a Blob here. */
return (AN2Data)an2_set_type(a,AN2_ACTION_TYPE);
}
if (ANK_isDatumToken(u)) {
ANK_Token tk = ANK_getDatumToken(u);
ANK_String s = ANK_getTokenString(tk);
AN2Data d; char *str;
#ifdef DEBUG
ATwarning("token: %t\n",tk);
#endif
str = ANK_StringToStr(s);
#ifdef DEBUG
ATwarning("string: %s\n",str);
#endif
d = an2_make_token(str);
#ifdef DEBUG
ATwarning("d: %t\n",d);
#endif
return (AN2Data)d;
}
if (ANK_isDatumMessageTag(u)) {
ANK_MessageTag mt = ANK_getDatumMessageTag(u);
ANK_Token tk = ANK_getMessageTagToken(mt);
ANK_String s = ANK_getTokenString(tk);
return (AN2Data)an2_make_messagetag(an2_make_token(ANK_StringToStr(s)));
}
if (ANK_isDatumList(u)) {
ATabort("Non-supported datum: %t.\n", (ATerm)u);
}
if (ANK_isDatumInt(u)) {
ANK_Int n = ANK_getDatumInt(u);
if (ANK_hasIntNat(n)) {
ANK_Nat nat = ANK_getIntNat(n);
ANK_Numeral num = ANK_getNatNumeral(nat);
ANK_NatCon natcon = ANK_getNumeralNatCon(num);
int i = ACR_NatConToInt(natcon);
if (ANK_isIntUnaryMinus(n))
return an2_make_int(-i);
return an2_make_int(i);
}
ATabort("Non-supported Int: %t.\n", (ATerm)n);
}
}
if (ANK_isDataDataconst(data)) {
ANK_DataConst c = ANK_getDataDataConst(data);
if (ANK_isDataConstTrue(c))
return an2_make_bool(1);
if (ANK_isDataConstFalse(c))
return an2_make_bool(0);
if (ANK_isDataConstNoBindings(c))
return an2_make_no_bindings();
ATabort("Invalid DataConst: %t.\n", (ATerm)c);
}
if (ANK_isDataEmpty(data)) {
return an2_make_empty();
}
if (ANK_isDataTuple(data)) {
AN2Tuple tuple = an2_empty_tuple();
ANK_Data head = ANK_getDataHead(data);
ANK_DataTail tail = ANK_getDataTail(data);
tuple = an2_insert_in_tuple(tuple, ACR_dataToAN2Data(head));
#ifdef DEBUG
ATwarning("tuple: %t\n",tuple);
#endif
head = ANK_getDataTailHead(tail);
tuple = an2_append_to_tuple(tuple, ACR_dataToAN2Data(head));
#ifdef DEBUG
ATwarning("\n\n\n\n\ntuple: %t\n",tuple);
#endif
tail = ANK_getDataTailTail(tail);
#ifdef DEBUG
ATwarning("\n\n\n\ntail: %t\n",tail);
#endif
while (ANK_hasDataTailTail(tail) == ATtrue) {
head = ANK_getDataTailHead(tail);
tuple = an2_append_to_tuple(tuple, ACR_dataToAN2Data(head));
tail = ANK_getDataTailTail(tail);
}
return (AN2Data)tuple;
}
ATabort("Invalid Data: %t.\n", (ATerm)data);
return (AN2Data)NULL;
}
void minor_sweep_phase_young()
{
int size, perc;
int reclaiming = 0;
int alive = 0;
old_bytes_in_young_blocks_since_last_major = 0;
for(size=MIN_TERM_SIZE; size<MAX_TERM_SIZE; size++) {
Block *prev_block = NULL;
Block *next_block;
ATerm old_freelist;
Block *block = at_blocks[size];
header_type *end = top_at_blocks[size];
/* empty the freelist*/
at_freelist[size] = NULL;
while(block) {
/* set empty = 0 to avoid recycling*/
int empty = 1;
int alive_in_block = 0;
int dead_in_block = 0;
int free_in_block = 0;
int old_in_block = 0;
int capacity = (end-(block->data))/size;
header_type *cur;
assert(block->size == size);
old_freelist = at_freelist[size];
for(cur=block->data ; cur<end ; cur+=size) {
ATerm t = (ATerm)cur;
if(IS_MARKED(t->header) || IS_OLD(t->header)) {
if(IS_OLD(t->header)) {
old_in_block++;
}
CLR_MARK(t->header);
alive_in_block++;
empty = 0;
assert(!IS_MARKED(t->header));
} else {
switch(ATgetType(t)) {
case AT_FREE:
/* AT_freelist[size] is not empty: so DO NOT ADD t*/
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
free_in_block++;
break;
case AT_INT:
case AT_REAL:
case AT_APPL:
case AT_LIST:
case AT_PLACEHOLDER:
case AT_BLOB:
AT_freeTerm(size, t);
t->header = FREE_HEADER;
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
dead_in_block++;
break;
case AT_SYMBOL:
AT_freeSymbol((SymEntry)t);
t->header = FREE_HEADER;
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
dead_in_block++;
break;
default:
ATabort("panic in sweep phase\n");
}
assert(!IS_MARKED(t->header));
}
}
assert(alive_in_block + dead_in_block + free_in_block == capacity);
next_block = block->next_by_size;
#ifndef NDEBUG
if(empty) {
for(cur=block->data; cur<end; cur+=size) {
assert(ATgetType((ATerm)cur) == AT_FREE);
}
}
#endif
/* Do not reclaim frozen blocks */
if(IS_FROZEN(block)) {
at_freelist[size] = old_freelist;
}
/* TODO: create freeList Old*/
if(0 && empty) {
at_freelist[size] = old_freelist;
reclaim_empty_block(at_blocks, size, block, prev_block);
} else if(0 && 100*old_in_block/capacity >= TO_OLD_RATIO) {
promote_block_to_old(size, block, prev_block);
} else {
old_bytes_in_young_blocks_since_last_major += (old_in_block*SIZE_TO_BYTES(size));
prev_block = block;
}
block = next_block;
if(block) {
end = block->end;
}
alive += alive_in_block;
reclaiming += dead_in_block;
}
#ifndef NDEBUG
if(at_freelist[size]) {
ATerm data;
/*fprintf(stderr,"minor_sweep_phase_young: ensure empty freelist[%d]\n",size);*/
for(data = at_freelist[size] ; data ; data=data->aterm.next) {
if(!EQUAL_HEADER(data->header,FREE_HEADER)) {
fprintf(stderr,"data = %p header = %x\n",data,(unsigned int) data->header);
}
assert(EQUAL_HEADER(data->header,FREE_HEADER));
assert(ATgetType(data) == AT_FREE);
}
}
#endif
}
if(alive) {
perc = (100*reclaiming)/alive;
STATS(reclaim_perc, perc);
}
}
void major_sweep_phase_old()
{
int size, perc;
int reclaiming = 0;
int alive = 0;
for(size=MIN_TERM_SIZE; size<MAX_TERM_SIZE; size++) {
Block *prev_block = NULL;
Block *next_block;
Block *block = at_old_blocks[size];
while(block) {
/* set empty = 0 to avoid recycling*/
int empty = 1;
int alive_in_block = 0;
int dead_in_block = 0;
int free_in_block = 0;
int capacity = ((block->end)-(block->data))/size;
header_type *cur;
assert(block->size == size);
for(cur=block->data ; cur<block->end ; cur+=size) {
/* TODO: Optimisation*/
ATerm t = (ATerm)cur;
if(IS_MARKED(t->header)) {
CLR_MARK(t->header);
alive_in_block++;
empty = 0;
assert(IS_OLD(t->header));
} else {
switch(ATgetType(t)) {
case AT_FREE:
assert(IS_YOUNG(t->header));
free_in_block++;
break;
case AT_INT:
case AT_REAL:
case AT_APPL:
case AT_LIST:
case AT_PLACEHOLDER:
case AT_BLOB:
assert(IS_OLD(t->header));
AT_freeTerm(size, t);
t->header=FREE_HEADER;
dead_in_block++;
break;
case AT_SYMBOL:
assert(IS_OLD(t->header));
AT_freeSymbol((SymEntry)t);
t->header=FREE_HEADER;
dead_in_block++;
break;
default:
ATabort("panic in sweep phase\n");
}
}
}
assert(alive_in_block + dead_in_block + free_in_block == capacity);
next_block = block->next_by_size;
#ifndef NDEBUG
if(empty) {
for(cur=block->data; cur<block->end; cur+=size) {
assert(ATgetType((ATerm)cur) == AT_FREE);
}
}
#endif
if(empty) {
/* DO NOT RESTORE THE FREE LIST: free cells have not been inserted*/
/* at_freelist[size] = old_freelist;*/
assert(top_at_blocks[size] < block->data || top_at_blocks[size] > block->end);
#ifdef GC_VERBOSE
fprintf(stderr,"MAJOR OLD: reclaim empty block %p\n",block);
#endif
reclaim_empty_block(at_old_blocks, size, block, prev_block);
} else if(0 && 100*alive_in_block/capacity <= TO_YOUNG_RATIO) {
promote_block_to_young(size, block, prev_block);
old_bytes_in_young_blocks_after_last_major += (alive_in_block*SIZE_TO_BYTES(size));
} else {
old_bytes_in_old_blocks_after_last_major += (alive_in_block*SIZE_TO_BYTES(size));
/* DO NOT FORGET THIS LINE*/
/* update the previous block*/
prev_block = block;
}
block = next_block;
alive += alive_in_block;
reclaiming += dead_in_block;
}
}
if(alive) {
perc = (100*reclaiming)/alive;
STATS(reclaim_perc, perc);
}
}
void major_sweep_phase_young()
{
int perc;
int reclaiming = 0;
int alive = 0;
int size;
old_bytes_in_young_blocks_since_last_major = 0;
for(size=MIN_TERM_SIZE; size<MAX_TERM_SIZE; size++) {
Block *prev_block = NULL;
Block *next_block;
ATerm old_freelist;
Block *block = at_blocks[size];
header_type *end = top_at_blocks[size];
while(block) {
int empty = 1;
int alive_in_block = 0;
int dead_in_block = 0;
int free_in_block = 0;
int old_in_block = 0;
int young_in_block = 0;
int capacity = (end-(block->data))/size;
header_type *cur;
assert(block->size == size);
old_freelist = at_freelist[size];
for(cur=block->data ; cur<end ; cur+=size) {
ATerm t = (ATerm)cur;
if(IS_MARKED(t->header)) {
CLR_MARK(t->header);
alive_in_block++;
empty = 0;
if(IS_OLD(t->header)) {
old_in_block++;
} else {
young_in_block++;
}
} else {
switch(ATgetType(t)) {
case AT_FREE:
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
free_in_block++;
break;
case AT_INT:
case AT_REAL:
case AT_APPL:
case AT_LIST:
case AT_PLACEHOLDER:
case AT_BLOB:
AT_freeTerm(size, t);
t->header = FREE_HEADER;
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
dead_in_block++;
break;
case AT_SYMBOL:
AT_freeSymbol((SymEntry)t);
t->header = FREE_HEADER;
t->aterm.next = at_freelist[size];
at_freelist[size] = t;
dead_in_block++;
break;
default:
ATabort("panic in sweep phase\n");
}
}
}
assert(alive_in_block + dead_in_block + free_in_block == capacity);
next_block = block->next_by_size;
#ifndef NDEBUG
if(empty) {
for(cur=block->data; cur<end; cur+=size) {
assert(ATgetType((ATerm)cur) == AT_FREE);
}
}
#endif
#ifdef GC_VERBOSE
/*fprintf(stderr,"old_cell_in_young_block ratio = %d\n",100*old_in_block/capacity);*/
#endif
if(end==block->end && empty) {
#ifdef GC_VERBOSE
fprintf(stderr,"MAJOR YOUNG: reclaim empty block %p\n",block);
#endif
at_freelist[size] = old_freelist;
reclaim_empty_block(at_blocks, size, block, prev_block);
} else if(end==block->end && 100*old_in_block/capacity >= TO_OLD_RATIO) {
if(young_in_block == 0) {
#ifdef GC_VERBOSE
fprintf(stderr,"MAJOR YOUNG: promote block %p to old\n",block);
#endif
at_freelist[size] = old_freelist;
promote_block_to_old(size, block, prev_block);
old_bytes_in_old_blocks_after_last_major += (old_in_block*SIZE_TO_BYTES(size));
} else {
#ifdef GC_VERBOSE
fprintf(stderr,"MAJOR YOUNG: freeze block %p\n",block);
#endif
SET_FROZEN(block);
old_bytes_in_young_blocks_after_last_major += (old_in_block*SIZE_TO_BYTES(size));
at_freelist[size] = old_freelist;
prev_block = block;
}
} else {
old_bytes_in_young_blocks_after_last_major += (old_in_block*SIZE_TO_BYTES(size));
prev_block = block;
}
block = next_block;
if(block) {
end = block->end;
}
alive += alive_in_block;
reclaiming += dead_in_block;
}
#ifndef NDEBUG
if(at_freelist[size]) {
ATerm data;
for(data = at_freelist[size] ; data ; data=data->aterm.next) {
assert(EQUAL_HEADER(data->header,FREE_HEADER));
assert(ATgetType(data) == AT_FREE);
}
}
#endif
}
if(alive) {
perc = (100*reclaiming)/alive;
STATS(reclaim_perc, perc);
}
}
static void doSerialize(A2PWriter writer, A2PType expected, ATerm value){
DKISIndexedSet sharedValues = writer->valueSharingMap;
int valueHash = hashValue(value);
int valueId = DKISget(sharedValues, (void*) value, (void*) expected, valueHash); /* TODO: Fix sharing (check types). */
if(valueId != -1){
writeByteToBuffer(writer->buffer, PDB_SHARED_FLAG);
printInteger(writer->buffer, valueId);
return;
}
switch(expected->id){
case PDB_VALUE_TYPE_HEADER:
serializeUntypedTerm(writer, value);
break;
case PDB_BOOL_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Boolean didn't have AT_APPL type.\n"); exit(1); }
writeBool(writer, (ATermAppl) value);
break;
case PDB_INTEGER_TYPE_HEADER:
if(ATgetType(value) != AT_INT){ fprintf(stderr, "Integer didn't have AT_INT type.\n"); exit(1); }
writeInteger(writer, (ATermInt) value);
break;
case PDB_DOUBLE_TYPE_HEADER:
if(ATgetType(value) != AT_REAL){ fprintf(stderr, "Double didn't have AT_REAL type.\n"); exit(1); }
writeDouble(writer, (ATermReal) value);
break;
case PDB_STRING_TYPE_HEADER:
if(ATgetType(value) != AT_APPL || ATisQuoted(ATgetAFun((ATermAppl) value)) == ATfalse){ fprintf(stderr, "String didn't have 'quoted' AT_APPL type.\n"); ATabort(""); exit(1); }
writeString(writer, (ATermAppl) value);
break;
case PDB_SOURCE_LOCATION_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Source location didn't have AT_APPL type.\n"); exit(1); }
writeSourceLocation(writer, (ATermAppl) value);
break;
case PDB_NODE_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Node didn't have AT_APPL type.\n"); exit(1); }
{
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeNode(writer, expected, (ATermAppl) value);
}else{
if(((A2PNodeType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Node term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedNode(writer, expected, (ATermAppl) value, annotations);
}
}
break;
case PDB_TUPLE_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Tuple didn't have AT_APPL type.\n"); exit(1); }
writeTuple(writer, expected, (ATermAppl) value);
break;
case PDB_LIST_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "List didn't have AT_LIST type.\n"); exit(1); }
writeList(writer, expected, (ATermList) value);
break;
case PDB_SET_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Set didn't have AT_LIST type.\n"); exit(1); }
writeSet(writer, expected, (ATermList) value);
break;
case PDB_RELATION_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Relation didn't have AT_LIST type.\n"); exit(1); }
writeRelation(writer, expected, (ATermList) value);
break;
case PDB_MAP_TYPE_HEADER:
if(ATgetType(value) != AT_LIST){ fprintf(stderr, "Map didn't have AT_LIST type.\n"); exit(1); }
writeMap(writer, expected, (ATermList) value);
break;
case PDB_CONSTRUCTOR_TYPE_HEADER:
if(ATgetType(value) != AT_APPL){ fprintf(stderr, "Constructor didn't have AT_APPL type.\n"); exit(1); }
{
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeConstructor(writer, expected, (ATermAppl) value);
}else{
if(((A2PConstructorType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Constructor term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedConstructor(writer, expected, (ATermAppl) value, annotations);
}
}
break;
case PDB_ADT_TYPE_HEADER:
writeADT(writer, expected, value);
break;
default:
fprintf(stderr, "Unserializable type: %d\n.", expected->id);
exit(1);
}
DKISstore(sharedValues, (void*) value, (void*) expected, valueHash);
}
static void check_type_is_int_else_abort(ATerm t, char *msg) {
if (!ATgetType(t) == AT_INT)
ATabort("Invalid set type to %s!\n", msg);
}
SDF_Symbol PTSymbolToSDFSymbol(PT_Symbol ptSymbol)
{
SDF_Symbol result;
if (PT_isSymbolLit(ptSymbol)) {
char *str = PT_getSymbolString(ptSymbol);
char *qstr = escape(str, "\"\\", QUOTED);
SDF_Literal lit = SDF_makeLiteralQlit(SDF_makeQLiteralQuoted(SDF_makeCHARLISTString(qstr)));
free(qstr);
result = SDF_makeSymbolLit(lit);
}
else if (PT_isSymbolCf(ptSymbol)
|| PT_isSymbolLex(ptSymbol)
|| PT_isSymbolVarSym(ptSymbol)) {
result = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
}
else if (PT_isSymbolEmpty(ptSymbol)) {
result = SDF_makeSymbolEmpty(SDF_makeLayoutEmpty());
}
else if (PT_isSymbolSeq(ptSymbol)) {
PT_Symbols ptSymbols = PT_getSymbolSymbols(ptSymbol);
PT_Symbol ptHead = PT_getSymbolsHead(ptSymbols);
SDF_Symbol sdfHead = PTSymbolToSDFSymbol(ptHead);
PT_Symbols ptTail = PT_getSymbolsTail(ptSymbols);
if (PT_isSymbolsEmpty(ptTail)) {
ATabort("PTSymbolToSDFSymbol: empty tail in %s\n",
PT_yieldSymbol(ptSymbol));
result = NULL;
}
else {
SDF_SymbolTail sdfSymbolTail =
(SDF_SymbolTail)PTSymbolsToSDFSymbolList(ptTail);
result = SDF_makeSymbolSeq(SDF_makeLayoutEmpty(),
sdfHead,
SDF_makeLayoutSpace(),
sdfSymbolTail,
SDF_makeLayoutEmpty());
}
}
else if (PT_isSymbolOpt(ptSymbol)) {
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
result = SDF_makeSymbolOpt(sdfSymbol, SDF_makeLayoutEmpty());
}
else if (PT_isSymbolAlt(ptSymbol)) {
SDF_Symbol sdfLhs = PTSymbolToSDFSymbol(PT_getSymbolLhs(ptSymbol));
SDF_Symbol sdfRhs = PTSymbolToSDFSymbol(PT_getSymbolRhs(ptSymbol));
result = SDF_makeSymbolAlt(sdfLhs,
SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty(),
sdfRhs);
}
else if (PT_isSymbolTuple(ptSymbol)) {
SDF_Symbol sdfHead = PTSymbolToSDFSymbol(PT_getSymbolHead(ptSymbol));
SDF_SymbolRest sdfRest = PTSymbolsToSDFSymbolRest(PT_getSymbolRest(ptSymbol));
result = SDF_makeSymbolTuple(SDF_makeLayoutEmpty(),
sdfHead,
SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty(),
sdfRest,
SDF_makeLayoutEmpty());
}
else if (PT_isSymbolSort(ptSymbol)) {
char *str = PT_getSymbolSort(ptSymbol);
SDF_Sort sort = SDF_makeSortMoreChars(SDF_makeCHARLISTString(str));
result = SDF_makeSymbolSort(sort);
}
else if (PT_isSymbolIterPlus(ptSymbol)) {
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
result = SDF_makeSymbolIter(sdfSymbol, SDF_makeLayoutEmpty());
}
else if (PT_isSymbolIterStar(ptSymbol)) {
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
result = SDF_makeSymbolIterStar(sdfSymbol, SDF_makeLayoutEmpty());
}
else if (PT_isSymbolIterPlusSep(ptSymbol)) {
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
SDF_Symbol sdfSep = PTSymbolToSDFSymbol(PT_getSymbolSeparator(ptSymbol));
result = SDF_makeSymbolIterSep(SDF_makeLayoutEmpty(),
sdfSymbol,
SDF_makeLayoutSpace(),
sdfSep,
SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty());
}
else if (PT_isSymbolIterStarSep(ptSymbol)) {
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
SDF_Symbol sdfSep = PTSymbolToSDFSymbol(PT_getSymbolSeparator(ptSymbol));
result = SDF_makeSymbolIterStarSep(SDF_makeLayoutEmpty(),
sdfSymbol,
SDF_makeLayoutSpace(),
sdfSep,
SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty());
}
else if (PT_isSymbolIterN(ptSymbol)) {
char str[BUFSIZ];
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
int nr = PT_getSymbolNumber(ptSymbol);
SDF_NatCon sdfNatCon;
sprintf(str, "%d", nr);
sdfNatCon = SDF_makeNatConDigits(SDF_makeCHARLISTString(str));
result = SDF_makeSymbolIterN(sdfSymbol,
SDF_makeLayoutSpace(),
sdfNatCon,
SDF_makeLayoutEmpty());
}
else if (PT_isSymbolIterSepN(ptSymbol)) {
char str[BUFSIZ];
SDF_Symbol sdfSymbol = PTSymbolToSDFSymbol(PT_getSymbolSymbol(ptSymbol));
SDF_Symbol sdfSep = PTSymbolToSDFSymbol(PT_getSymbolSeparator(ptSymbol));
int nr = PT_getSymbolNumber(ptSymbol);
SDF_NatCon sdfNatCon;
sprintf(str, "%d", nr);
sdfNatCon = SDF_makeNatConDigits(SDF_makeCHARLISTString(str));
result = SDF_makeSymbolIterSepN(SDF_makeLayoutEmpty(),
sdfSymbol,
SDF_makeLayoutSpace(),
sdfSep,
SDF_makeLayoutEmpty(),
SDF_makeLayoutEmpty(),
sdfNatCon,
SDF_makeLayoutEmpty());
}
else if (PT_isSymbolLayout(ptSymbol)) {
ATabort("PTSymbolToSDFSymbol: layout.\n");
result = NULL;
}
else {
ATabort("PTSymbolToSDFSymbol: unable to convert symbol %t: %s\n",
ptSymbol, PT_yieldSymbol(ptSymbol));
result = NULL;
}
return result;
}
