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_rename(ATerm oldname, ATerm newname) { if(!t_is_string(oldname) || !t_is_string(newname)) _fail(oldname); if(rename(ATgetName(ATgetSymbol(oldname)),ATgetName(ATgetSymbol(newname))) != 0) _fail(oldname); return newname; }
ATerm SSL_link(ATerm existingpath, ATerm newpath) { if(!t_is_string(existingpath) || !t_is_string(newpath)) _fail(existingpath); if(link(ATgetName(ATgetSymbol(existingpath)), ATgetName(ATgetSymbol(newpath))) != 0) _fail(existingpath); return newpath; }
ATerm SSL_setenv(ATerm name, ATerm value, ATerm overwrite) { if(!t_is_string(name)) _fail(name); if(!t_is_string(value)) _fail(value); if(!ATisInt(overwrite)) _fail(overwrite); setenv(ATgetName(ATgetSymbol(name)), ATgetName(ATgetSymbol(value)), ATgetInt((ATermInt)overwrite)); return (ATerm)ATempty; }
void CAESAR_PRINT_LABEL(CAESAR_TYPE_FILE f,CAESAR_TYPE_LABEL l) { /* fprintf(stderr,"CAESAR_PRINT_LABEL\n"); */ if (l->label==MCRLterm_tau) fprintf(f,"i"); else fprintf(f,"\"%s\"",ATgetName(ATgetSymbol(l->label))); }
void CAESAR_PRINT_STATE_HEADER(CAESAR_TYPE_FILE fp) { ATerm l = (ATerm)MCRLgetListOfPars(); ATerm v,s; while (ATmatch(l,"[v(<term>,<term>),<list>]", &v,&s,&l)) ATfprintf(fp,"%t:%s \n",MCRLprint(v),ATgetName(ATgetSymbol(s))); }
static void writeNode(A2PWriter writer, A2PType expected, ATermAppl node){ AFun fun = ATgetAFun(node); int arity = ATgetArity(fun); char *name = ATgetName(fun); int i; unsigned int hash = hashString(name); int nodeNameId = ISstore(writer->nameSharingMap, (void*) name, hash); if(nodeNameId == -1){ int nameLength = dataArraySize(name); writeByteToBuffer(writer->buffer, PDB_NODE_HEADER); printInteger(writer->buffer, nameLength); writeDataToBuffer(writer->buffer, name, nameLength); }else{ writeByteToBuffer(writer->buffer, PDB_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)); } }
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)); } }
static void writeString(A2PWriter writer, ATermAppl string){ char *stringValue = ATgetName(ATgetAFun(string)); int stringValueLength = dataArraySize(stringValue); writeByteToBuffer(writer->buffer, PDB_STRING_HEADER); printInteger(writer->buffer, stringValueLength); writeDataToBuffer(writer->buffer, stringValue, stringValueLength); }
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)); }
/** * Note: mandatory in C89 and C99, not in BSD */ ATerm SSL_remove(ATerm pathname) { if(!t_is_string(pathname)) _fail(pathname); if(remove(ATgetName(ATgetSymbol(pathname))) != 0) _fail(pathname); return (ATerm) ATempty; }
ATerm SSL_modification_time(ATerm file) { struct stat buf; if(!t_is_string(file)) _fail(file); stat(ATgetName(ATgetSymbol(file)), &buf); return (ATerm)ATmakeInt(buf.st_mtime); }
ATerm funcAbstraction(ATerm func, ATerm dstSort){ ATermList argSorts; ATerm newTerm, newTermSort; ATerm arg, argSort, fSort, argSortAux; ATbool modified; int i, j; char *fName; AFun fun; argSorts = getFuncSortList(func); fSort = getTermSort(func); fun = ATgetAFun(func); fName = ATgetName(fun); if(reservedFunc(fun)) return func; do{ modified = ATfalse; for(i=0; i< ATgetArity(ATgetAFun(func)); i++){ arg = ATgetArgument((ATermAppl) func, i); argSort = ATelementAt(argSorts, i); if(toAbstractArg(argSort, argSorts, fSort)) argSort = liftSort(abstractSort(getUnLifted(argSort))); newTerm = termAbstraction(arg, argSort); newTermSort = getTermSort(newTerm); if(newTerm != arg) modified = ATtrue; func = (ATerm) ATsetArgument((ATermAppl) func, newTerm, i); argSorts = ATreplace(argSorts, newTermSort, i); if(toAbstractTarget(newTermSort, fSort)) fSort = liftSort(abstractSort(getUnLifted(fSort))); if(toLiftTarget(newTermSort, fSort)) fSort = liftSort(fSort); if(modified) break; } } while(modified); if(toAbstractSort(fSort) && abstractedSorts(argSorts)) fSort = liftSort(abstractSort(getUnLifted(fSort))); func = createNewFuncTerm(func, argSorts, fSort); return func; }
ATerm getTermSort(ATerm term){ ATerm sort; if(isVariable(term)){ sort = ATtableGet(var_tab, term); } else if(isParameter(term)){ sort = ATtableGet(par_tab, term); } else { sort = (ATerm) ATmake("<str>",ATgetName(MCRLgetSort(term))); } if(!strcmp("\"<int>\"", ATwriteToString(sort))){ PP("ERROR: "); PP(ATgetName(MCRLgetSort(term))); fprintf(stderr, " %d ", nSum); pTerm(term); exit(0); } return sort; }
static void writeBool(A2PWriter writer, ATermAppl boolean){ char *boolName = ATgetName(ATgetAFun(boolean)); writeByteToBuffer(writer->buffer, PDB_BOOL_HEADER); if(strncmp(boolName, "true", 4) == 0){ printInteger(writer->buffer, 1); }else{ printInteger(writer->buffer, 0); } }
/** * Note: mandatory in C89 and C99 */ ATerm SSL_getenv(ATerm name) { char *value; if(!t_is_string(name)) _fail(name); value = getenv(ATgetName(ATgetSymbol(name))); if(value == NULL) _fail(name); return (ATerm)ATmakeString(value); }
FILE *find_file(char *name) { char file[1024]; ATermList i; yyin = NULL; for(i = includes; !ATisEmpty(i); i = ATgetNext(i)) { sprintf(file, "%s/%s", ATgetName(ATgetSymbol(ATgetFirst(i))), name); yyin = fopen(file, "r"); if(yyin) { sprintf(file_name, "%s", file); break; } } return yyin; }
ATerm get_new_module_name(int cid, ATerm searchPaths, const char *path, const char* id) { ATermList search = (ATermList) searchPaths; char chosenPath[PATH_LEN] = ""; int chosenPathLen = 0; char chosenId[PATH_LEN]; /* We will choose the longest search path that matches the path of * the chosen module. */ for (; !ATisEmpty(search); search = ATgetNext(search)) { char *current = ATgetName(ATgetAFun((ATermAppl) ATgetArgument(ATgetFirst(search), 1))); int currentLen = strlen(current); if (strncmp(current, path, currentLen) == 0) { if (currentLen > chosenPathLen) { strcpy(chosenPath, current); chosenPathLen = currentLen; } } } /* Now construct a compound module id to complete * the filename. */ if (chosenPathLen > 0) { int i = chosenPathLen; while (path[i] == SEP) { i++; } if (strcmp(chosenPath, path) == 0) { strcpy(chosenId, id); } else { sprintf(chosenId, "%s%c%s", path+i, SEP, id); } return ATmake("snd-value(new-module-name(<str>,<str>))", chosenPath, chosenId); } else { return ATmake("snd-value(module-name-inconsistent)"); } }
int ACR_NatConToInt(ANK_NatCon natcon) { char *s = ATgetName(ATgetAFun(natcon)); int len = strlen(s); char *buf; int n; #ifdef DEBUG ATwarning("s = %s\n",s); ATwarning("len = %d\n",len); #endif buf = alloca(len+1); strncpy(buf,s, len); n = atoi(buf); #ifdef DEBUG ATwarning("n = %d\n",n); #endif return n; }
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); }
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. */ }
CAESAR_TYPE_STRING CAESAR_STRING_LABEL(CAESAR_TYPE_LABEL l) { // fprintf(stderr,"CAESAR_STRING_LABEL\n"); char* L; static char *a = NULL; static int siz = 0; if (l->label==MCRLterm_tau) L="i"; else { L=ATgetName(ATgetSymbol(l->label)); if (!a || strlen(L)>siz) { siz = strlen(L); a = realloc(a, siz+5); } sprintf(a,"\"%s\"",L); return a; } return L; }
ATerm SSL_readdir(ATerm t) { DIR *dir = NULL; ATermList entries = ATempty; struct dirent *entry = NULL; if(!t_is_string(t)) _fail(t); dir = opendir(ATgetName(ATgetSymbol(t))); if(dir == NULL) _fail(t); while((entry = readdir(dir)) != NULL) { entries = ATinsert(entries, ATmakeString(entry->d_name)); } closedir(dir); return (ATerm) entries; }
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; }
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('}'); } }
/** * @TODO bug in glibc: functions not under control of features.h */ ATerm SSL_copy(ATerm oldname, ATerm newname) // copy file oldname to file newname using read and write { #ifndef XT_STD_DISABLE_POSIX_XSI int fdin, fdout; int n; char buf[SSL_COPY_BUFSIZE]; if(ATmatch(oldname, "stdin")) fdin = STDIN_FILENO; else if(!t_is_string(oldname)) _fail(oldname); else if((fdin = open(ATgetName(ATgetSymbol(oldname)), O_RDONLY)) < 0 ) { perror("SSL_copy"); ATfprintf(stderr, "SSL_copy: cannot open inputfile %t\n", oldname); _fail(oldname); } if(ATmatch(newname, "stdout")) { fdout = STDOUT_FILENO; } else if(ATmatch(newname, "stderr")) { fdout = STDERR_FILENO; } else if(!t_is_string(newname)) { _fail(newname); } else if((fdout = open(ATgetName(ATgetSymbol(newname)), O_RDWR | O_CREAT | O_TRUNC, S_IRUSR | S_IWUSR)) < 0 ) { perror("SSL_copy"); ATfprintf(stderr, "SSL_copy: cannot create output file %t\n", newname); _fail(newname); } while( (n = read(fdin, buf, SSL_COPY_BUFSIZE)) > 0 ) if(write(fdout, buf, n) != n) { perror("SSL_copy: write error"); close(fdin); close(fdout); _fail(newname); } if(n < 0) { perror("SSL_copy: read error"); close(fdin); close(fdout); _fail(oldname); } close(fdin); close(fdout); return newname; #else FILE *fin, *fout; char ch; if(ATmatch(oldname, "stdin")) { fin = stdin; } else if(!t_is_string(oldname)) { _fail(oldname); } else if((fin = fopen(ATgetName(ATgetSymbol(oldname)), "r")) == NULL) { perror("SSL_copy"); ATfprintf(stderr, "SSL_copy: cannot open input file %t\n", oldname); _fail(oldname); } if(ATmatch(newname, "stdout")) { fout = stdout; } else if(ATmatch(newname, "stderr")) { fout = stderr; } else if(!t_is_string(newname)) { _fail(newname); } else if((fout = fopen(ATgetName(ATgetSymbol(newname)), "w")) == NULL) { perror("SSL_copy"); ATfprintf(stderr, "SSL_copy: cannot create output file %t\n", newname); _fail(newname); } while(!feof(fin)) { ch = fgetc(fin); if(ferror(fin)) { ATfprintf(stderr, "SSL_copy: error reading input file %t\n", oldname); _fail(newname); } if(ch != EOF) fputc(ch, fout); if(ferror(fout)) { ATfprintf(stderr, "SSL_copy: error writing output file %t\n", newname); _fail(newname); } } if(fclose(fin) == EOF) { ATfprintf(stderr, "SSL_copy: error closing input file %t\n", oldname); _fail(newname); } if(fclose(fout) == EOF) { ATfprintf(stderr, "SSL_copy: error closing output file %t\n", oldname); _fail(newname); } return newname; #endif }
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; }