ATerm SSL_fdcopy(ATerm fdinA, ATerm fdoutA)
{
int fdin, fdout;
int n;
char buf[SSL_COPY_BUFSIZE];
if(ATgetType(fdinA) != AT_INT || ATgetType(fdinA) != AT_INT)
_fail(fdinA);
fdin = ATgetInt((ATermInt)fdinA);
fdout = ATgetInt((ATermInt)fdoutA);
while( (n = read(fdin, buf, SSL_COPY_BUFSIZE)) > 0 )
if(write(fdout, buf, n) != n)
{
ATfprintf(stderr, "SSL_fdcopy: write error\n");
_fail((ATerm) ATempty);
}
if(n < 0)
{
ATfprintf(stderr, "SSL_fdcopy: read error\n");
_fail((ATerm) ATempty);
}
return (ATerm) ATempty;
}
ATerm STR_REALS_ceil(ATerm t)
{
double r;
if(ATgetType(t) != AT_REAL && ATgetType(t) != AT_INT)
return NULL;
NUMERIC_ATERM_TO_REAL(r, t);
return (ATerm) ATmakeReal(ceil(r));
}
ATerm SSL_int(ATerm t)
{
if(ATgetType(t) == AT_INT)
return(t);
else if(ATgetType(t) == AT_REAL)
return((ATerm) ATmakeInt((int)ATgetReal((ATermReal) t)));
else
_fail(t);
return(t);
}
static void args2buf(ATermList args)
{
while(!ATisEmpty(args)) {
ATerm arg = ATgetFirst(args);
args = ATgetNext(args);
if(ATgetType(arg) != AT_LIST)
char2buf('{');
term2buf(arg);
if(ATgetType(arg) != AT_LIST)
char2buf('}');
char2buf(' ');
}
}
static void writeADT(A2PWriter writer, A2PType expected, ATerm value){
int termType = ATgetType(value);
if(termType == AT_APPL){
ATermAppl appl = (ATermAppl) value;
AFun fun = ATgetAFun(appl);
char *name = ATgetName(fun);
int arity = ATgetArity(fun);
A2PType constructorType = A2PlookupConstructorType(expected, name, arity);
if(constructorType == NULL){ fprintf(stderr, "Unable to find a constructor that matches the given ADT type. Name: %s, arity: %d, ADT name: %s.\n", name, arity, ((A2PAbstractDataType) expected->theType)->name); exit(1); }
writeConstructor(writer, constructorType, appl);
}else{
A2PType wrapper;
switch(termType){
case AT_INT:
wrapper = A2PlookupConstructorWrapper(expected, A2PintegerType());
break;
case AT_REAL:
wrapper = A2PlookupConstructorWrapper(expected, A2PrealType());
break;
default:
fprintf(stderr, "The given ATerm of type: %d, can not be a constructor.\n", termType);
exit(1);
}
if(wrapper == NULL){ fprintf(stderr, "Unable to find constructor wrapper for ATerm with type : %d.\n", termType); exit(1);}
writeConstructor(writer, wrapper, ATmakeAppl1(ATmakeAFun(((A2PConstructorType) wrapper->theType)->name, 1, ATfalse), value));
}
}
void *_is_real(void)
{ if(ATgetType(Ttop()) == AT_REAL)
{
return NULL;
}
else return fail_address;
}
void *_is_int(void)
{ if(ATgetType(Ttop()) == AT_INT)
{
return NULL;
}
else return fail_address;
}
static void checkAFun(ATerm afun)
{
if (ATgetType(afun) != AT_APPL) {
ATfprintf(stderr, "wrong afun spec: %t\n", afun);
exit(1);
}
}
static void writeAnnotatedNode(A2PWriter writer, A2PType expected, ATermAppl node, ATermList annotations){
A2PNodeType t = (A2PNodeType) expected->theType;
AFun fun = ATgetAFun(node);
int arity = ATgetArity(fun);
char *name = ATgetName(fun);
int nrOfAnnotations = ATgetLength(annotations);
int i;
ATerm annotationLabel;
ATerm annotationValue;
unsigned int hash = hashString(name);
int nodeNameId = ISstore(writer->nameSharingMap, (void*) name, hash);
if(nodeNameId == -1){
int nameLength = dataArraySize(name);
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_NODE_HEADER);
printInteger(writer->buffer, nameLength);
writeDataToBuffer(writer->buffer, name, nameLength);
}else{
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_NODE_HEADER | PDB_NAME_SHARED_FLAG);
printInteger(writer->buffer, nodeNameId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, A2PvalueType(), ATgetArgument(node, i));
}
/* Annotations. */
if((nrOfAnnotations % 2) == 1){ fprintf(stderr, "Detected corrupt annotations (Unbalanced).\n"); exit(1); }
printInteger(writer->buffer, nrOfAnnotations);
do{
char *label;
int labelLength;
A2PType annotationType;
annotationLabel = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
annotationValue = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
if(ATgetType(annotationLabel) != AT_APPL){ fprintf(stderr, "Detected corrupt annotation; label term is not a 'string'.\n"); exit(1); }
label = ATgetName(ATgetAFun((ATermAppl) annotationLabel));
labelLength = dataArraySize(label);
printInteger(writer->buffer, labelLength);
writeDataToBuffer(writer->buffer, label, labelLength);
annotationType = (A2PType) HTget(t->declaredAnnotations, (void*) label, hashString(label));
doSerialize(writer, annotationType, annotationValue);
}while(!ATisEmpty(annotations));
}
ATerm SSL_is_int(ATerm t)
{
if(ATgetType(t) == AT_INT)
return(t);
else
_fail(t);
return(t);
}
ATerm SSL_isPlaceholder(ATerm t) {
int type = ATgetType(t);
if(type == AT_PLACEHOLDER) {
return t;
} else {
_fail(t);
}
}
static void writeAnnotatedConstructor(A2PWriter writer, A2PType expected, ATermAppl constructor, ATermList annotations){
A2PConstructorType t = (A2PConstructorType) expected->theType;
ISIndexedSet sharedTypes = writer->typeSharingMap;
int typeHash = hashType(expected);
int constructorTypeId = ISget(sharedTypes, (void*) expected, typeHash);
int arity = ATgetArity(ATgetAFun(constructor));
int nrOfAnnotations = ATgetLength(annotations);
int i;
ATerm annotationLabel;
ATerm annotationValue;
if(constructorTypeId == -1){
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_CONSTRUCTOR_HEADER);
doWriteType(writer, expected);
ISstore(sharedTypes, (void*) expected, typeHash);
}else{
writeByteToBuffer(writer->buffer, PDB_ANNOTATED_CONSTRUCTOR_HEADER | PDB_TYPE_SHARED_FLAG);
printInteger(writer->buffer, constructorTypeId);
}
printInteger(writer->buffer, arity);
for(i = 0; i < arity; i++){
doSerialize(writer, ((A2PTupleType) t->children->theType)->fieldTypes[i], ATgetArgument(constructor, i));
}
/* Annotations. */
if((nrOfAnnotations % 2) == 1){ fprintf(stderr, "Detected corrupt annotations (Unbalanced).\n"); exit(1); }
printInteger(writer->buffer, nrOfAnnotations);
do{
char *label;
int labelLength;
A2PType annotationType;
annotationLabel = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
annotationValue = ATgetFirst(annotations);
annotations = ATgetNext(annotations);
if(ATgetType(annotationLabel) != AT_APPL){ fprintf(stderr, "Detected corrupt annotation; label term is not a 'string'.\n"); exit(1); }
label = ATgetName(ATgetAFun((ATermAppl) annotationLabel));
labelLength = dataArraySize(label);
printInteger(writer->buffer, labelLength);
writeDataToBuffer(writer->buffer, label, labelLength);
annotationType = (A2PType) HTget(t->declaredAnnotations, (void*) label, hashString(label));
doSerialize(writer, annotationType, annotationValue);
}while(!ATisEmpty(annotations));
}
ATerm SSL_getPlaceholder(ATerm t) {
int type = ATgetType(t);
if(type != AT_PLACEHOLDER) {
ATfprintf(stderr, "[error] SSL_getPlaceholder: not a placeholder: %t \n", t);
_fail(t);
} else {
ATermPlaceholder ph = (ATermPlaceholder) t;
ATerm result = ATgetPlaceholder(ph);
return result;
}
}
static void checkAlias(ATerm alias)
{
if (ATgetType(alias) == AT_APPL) {
ATermAppl appl = (ATermAppl)alias;
AFun afun = ATgetAFun(appl);
if (ATgetArity(afun) == 0 && !ATisQuoted(afun)) {
return;
}
}
ATfprintf(stderr, "incorrect alias: %t\n", alias);
exit(1);
}
ATSet ATR_fromList(ATermList list) {
ATSet set = ATR_empty();
while (!ATisEmpty(list)) {
ATerm first = ATgetFirst(list);
if (ATgetType(first) == AT_LIST) {
set = ATR_insert(set, ATR_fromList((ATermList)first));
}
else {
set = ATR_insert(set, first);
}
list = ATgetNext(list);
}
return set;
}
ATerm CO_unquoteAppl(ATerm appl)
{
AFun fun;
int arity;
char *name = NULL;
ATermList args = NULL;
assert(ATgetType(appl) == AT_APPL);
fun = ATgetAFun((ATermAppl) appl);
arity = ATgetArity(fun);
name = ATgetName(fun);
args = ATgetArguments((ATermAppl) appl);
fun = ATmakeAFun(name, arity, ATfalse);
return (ATerm) ATmakeApplList(fun, args);
}
static void serializeUntypedTerm(A2PWriter writer, ATerm value){
int type = ATgetType(value);
switch(type){
case AT_INT:
writeInteger(writer, (ATermInt) value);
break;
case AT_REAL:
writeDouble(writer, (ATermReal) value);
break;
case AT_APPL:
{
ATermAppl appl = (ATermAppl) value;
AFun fun = ATgetAFun(appl);
if(ATisQuoted(fun) == ATfalse){
A2PType expected = A2PnodeType();
ATermList annotations = (ATermList) ATgetAnnotations(value);
if(annotations == NULL){
writeNode(writer, expected, appl);
}else{
if(((A2PNodeType) expected->theType)->declaredAnnotations == NULL){ fprintf(stderr, "Node term has annotations, but none are declared.\n"); exit(1); }
writeAnnotatedNode(writer, expected, appl, annotations);
}
}else{
if(ATgetArity(fun) != 0){ fprintf(stderr, "Quoted appl (assumed to be a string) has a non-zero arity.\n"); exit(1);}
writeString(writer, appl);
}
}
break;
case AT_LIST:
writeList(writer, A2PlistType(A2PvalueType()), (ATermList) value);
break;
default:
fprintf(stderr, "Encountered unwriteable type: %d.\n", type);
exit(1);
}
}
unsigned int calc_hash(ATerm t)
{
unsigned int hnr = 0;
switch(ATgetType(t)) {
case AT_APPL:
{
ATermAppl appl = (ATermAppl)t;
AFun sym = ATgetAFun(appl);
int i, arity = ATgetArity(sym);
hnr = AT_hashSymbol(ATgetName(sym), arity);
for(i=0; i<arity; i++) {
hnr = hnr * MAGIC_HASH_CONST_APPL + calc_hash(ATgetArgument(appl, i));
}
}
break;
case AT_INT:
hnr = ATgetInt((ATermInt)t);
break;
case AT_LIST:
{
ATermList list = (ATermList)t;
hnr = 123;
while(!ATisEmpty(list)) {
hnr = hnr * MAGIC_HASH_CONST_LIST +
calc_hash(ATgetFirst(list));
list = ATgetNext(list);
}
}
break;
}
return hnr;
}
ATSet ATR_fromString(char *string) {
ATerm aterm = ATparse(string);
if (ATgetType(aterm) == AT_LIST)
return ATR_fromList((ATermList)aterm);
return (ATSet)aterm;
}
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);
}
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_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);
}
}
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);
}
}
ATerm toolbus_start(int conn, const char *script, ATerm args)
{
int i, pid, cid;
char *argv[MAX_ARGS];
char sockets[2][BUFSIZ];
WellKnownSocketPort = TB_PORT;
if (mk_server_ports(0) == TB_ERROR) {
ATerror("cannot create server ports, giving up!\n");
} else {
fprintf(stderr, "server ports created at %d\n", WellKnownSocketPort);
}
pid = fork();
if (pid == -1) {
ATerror("cannot fork toolbus-adapter, giving up!\n");
} else if (pid > 0) {
/* Parent */
/* connect to child toolbus! */
int attempts = 0;
do {
cid = ATBconnect(NULL, NULL, WellKnownSocketPort,
toolbus_adapter_handler);
if (cid < 0) {
tb_sleep(0, 500000);
}
} while (cid < 0 && attempts++ < MAX_ATTEMPTS);
if (cid < 0) {
return ATparse("snd-value(toolbus-error)");
} else {
if (cid > max_cid) {
max_cid = cid;
}
return ATmake("snd-value(toolbus-started(<int>))", cid);
}
} else {
/* Child */
/*{{{ setup arguments */
int argc = 0;
ATermList arg_list;
sprintf(sockets[0], "%d", WellKnownLocalSocket);
sprintf(sockets[1], "%d", WellKnownGlobalSocket);
argv[argc++] = TBPROG;
argv[argc++] = "-TB_USE_SOCKETS";
argv[argc++] = sockets[0];
argv[argc++] = sockets[1];
assert(ATgetType(args) == AT_LIST);
arg_list = (ATermList)args;
while (!ATisEmpty(arg_list)) {
ATerm arg = ATgetFirst(arg_list);
arg_list = ATgetNext(arg_list);
if (ATgetType(arg) == AT_APPL) {
argv[argc++] = ATgetName(ATgetAFun((ATermAppl)arg));
} else {
argv[argc] = strdup(ATwriteToString(arg));
assert(argv[argc]);
argc++;
}
}
/* Jurgen added this (char*) cast to prevent a compiler warning.
* But this code has more problems: we know that updating
* argv[] arrays is not portable, so the following code is actually
* wrong:
*/
argv[argc++] = (char*) script;
argv[argc] = NULL;
for (i=0; i<argc; i++) {
fprintf(stderr, "argv[%d] = %s\n", i, argv[i]);
}
/*}}} */
if (execv(TBPROG, argv) < 0) {
perror(TBPROG);
ATerror("cannot execute toolbus executable, giving up!\n");
}
}
return NULL;
}
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);
}
ATbool ATisVariable(ATerm t) {
/* internally, variables are represented by integers */
return ATgetType(t)==AT_INT;
}
int
main (int argc, char **argv)
{
int c; /* option character */
ATerm bottomOfStack;
char *inputs[MAX_MODULES] = { "-" };
int nInputs = 0;
char *output = "-";
ATbool module = ATfalse;
ATermList list;
ASF_ASFConditionalEquationList alleqs;
int i;
if(argc == 1) { /* no arguments */
usage();
exit(1);
}
while ((c = getopt(argc, argv, myarguments)) != EOF) {
switch (c) {
case 'h':
usage();
exit(0);
case 'm':
module = ATtrue;
break;
case 'o':
output = strdup(optarg);
break;
case 'V': fprintf(stderr, "%s %s\n", myname, myversion);
exit(0);
default:
usage();
exit(1);
}
}
/* The optind variable indicates where getopt has stopped */
for(i = optind; i < argc; i++) {
if (nInputs < MAX_MODULES) {
inputs[nInputs++] = strdup(argv[i]);
} else {
ATerror("Maximum number of %d modules exceeded.\n", MAX_MODULES);
exit(1);
}
}
if (nInputs == 0) {
nInputs = 1;
inputs[0] = strdup("-");
}
ATinit(argc, argv, &bottomOfStack);
PT_initMEPTApi();
ASF_initASFMEApi();
list = ATempty;
for (--nInputs; nInputs >= 0; nInputs--) {
ATerm p = ATreadFromNamedFile(inputs[nInputs]);
if (p == NULL) {
ATwarning("concat-asf: Unable to read anything from %s\n",
inputs[nInputs]);
}
else {
list = ATinsert(list, p);
}
free(inputs[nInputs]);
}
alleqs = ASF_makeASFConditionalEquationListEmpty();
for(;!ATisEmpty(list); list = ATgetNext(list)) {
ATerm head = ATgetFirst(list);
ASF_ASFConditionalEquationList list;
if (ATgetType(head) == AT_LIST) {
list = ASF_ASFConditionalEquationListFromTerm(head);
}
else {
ASF_ASFModule module = ASF_getStartTopASFModule(ASF_StartFromTerm(head));
list = ASF_getASFModuleEquationList(module);
}
ATwarning("Adding %d equations\n", ASF_getASFConditionalEquationListLength(list));
alleqs = ASF_unionASFConditionalEquationList(alleqs, ASF_makeLayoutNewline(), list);
}
if (module) {
ASF_OptLayout l = ASF_makeLayoutNewline();
ASF_ASFSection sec = ASF_makeASFSectionEquations(l, alleqs);
ASF_ASFModule mod = ASF_makeASFModuleDefault(ASF_makeASFSectionListSingle(sec));
/*PT_ParseTree pt = PT_makeValidParseTreeFromTree((PT_Tree) mod);*/
ATwriteToNamedBinaryFile((ATerm) mod, output);
}
else {
ATwriteToNamedBinaryFile(ASF_ASFConditionalEquationListToTerm(alleqs),
output);
}
return 0;
}
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('}');
}
}
