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('}'); } }