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;
}
