intgen2.c

Audacity是一款用於錄音和編輯聲音的、免費的開放源碼軟體。它可以執行於Mac OS X、Microsoft Windows、GNU/Linux和其它作業系統

    boolean reading_parameters = false;	/* says we've got a routine, and
        we're skipping over parameter declarations */

    if (flag == no_include_prefix) fname++;

    strcpy(source_file, fname);	/* for error reporting */
    in = fopen(fname, "r");
    if (in == NULL) {
        fprintf(errfile, "couldn't open %s\n", fname);
        return;
    }

    /* first check out the first line: if the first two characters are
        "ih", then replace fname with file.ih so that the CLASS ".ih"
        file will be included instead of this ".h" file.  This is a 
        hack to allow calls into Andrew Tool Kit objects.
     */

    strcpy(incl_file, fname);
    if (fgets(current_line, line_max, in) != NULL) {
        if (current_line[0] == 'i' && current_line[1] == 'h') {
            cp = sindex(incl_file, ".h");
            if (cp != NULL) {
                strcpy(cp, ".ih");
            }
        }
    }

    /* strip off leading directory prefix, if any */
    cp = strrchr(incl_file, FILESEP);	/* find the last slash */
    if (cp) {
        strcpy(incl_file, cp + 1 /* skip the slash */);
    }

    if (flag != no_include_prefix) fprintf(out, "#include \"%s\"\n\n", incl_file);

    while (fgets(current_line, line_max, in) != NULL) {
        cp = sindex(current_line, "#define");
        if (cp != NULL) {
            cp += strlen("#define");
            if (!getarg(cp, routine_name, &cp)) {
                error();
                fprintf(errfile, "#define not followed by identifier\n");
            }
            /* watch out for multi-line macros: */
            while (sindex(current_line, "\\\n")) {
                if (fgets(current_line, line_max, in) == NULL) return;
            }
        } else if ((cp = sindex(current_line, "LISP:")) != NULL) {
            char type_str[ident_max];
            char routine_str[ident_max];
            if (!reading_parameters &&
                getarg(current_line, type_str, &pos) &&
                getarg(pos, routine_str, &pos) &&
                pos < cp) {
                routine_call(in, out, current_line, type_str, routine_str,
                     cp + strlen("LISP:"));
            } else if (getarg(cp + strlen("LISP:"), type_str, &pos)) {
                macro_call(in, out, current_line, routine_name,
                           cp + strlen("LISP:"));
            } else routine_call(in, out, current_line, type_name, routine_name,
                     cp + strlen("LISP:"));
        } else if ((cp = sindex(current_line, "LISP-SRC:")) != NULL) {
            lisp_code(in, cp + strlen("LISP-SRC:"));
        } else if (reading_parameters && sindex(current_line, ")")) {
            reading_parameters = false;
        } else if (reading_parameters) { /* skip */ ;
        } else if (getarg(current_line, type_name, &pos) &&
                   getarg(pos, routine_name, &pos)) {
            /* we grabbed the type and routine name.  Check to see if the
             * parameter list is open but not closed on this line: */
            printf("type_name %s, routine_name %s\n", type_name, routine_name);
            if (sindex(current_line, "(") && !sindex(current_line, ")")) {
                reading_parameters = true;
            }
            /* printf("saw %s %s\n", type_name, routine_name);*/
        } else {  /* wipe out names for safety: */
            type_name[0] = EOS;
            routine_name[0] = EOS;
        }
    }

    fclose(in);
}


/* routine_call -- generate xlisp interface for C routine */
/**/
static void routine_call(in, out, curline, type_name, routine_name, arg_loc)
    FILE *in;		/* input file */
    FILE *out;		/* output file */
    char *curline;	/* input line */
    char *type_name;	/* type id */
    char *routine_name;	/* routine id */
    char *arg_loc;	/* location after "LISP:" */
{

    if (*routine_name == EOS) {
        routine_name = type_name;
        type_name = "void";
    }
    if (*routine_name == '*') {
        char *r = routine_name;
        while (*r != EOS) {   /* shift left */
            *r = *(r+1);
            r++;
         }
        strcat(type_name, "*");
    }
    write_interface(in, out, type_name, routine_name, arg_loc, false);
}


/* sindex -- find substring */
/**/
static char *sindex(sup, sub)
  char *sup;	/* the containing string */
  char *sub;	/* the substring */
{
    int i;
    for ( ; *sup != EOS; sup++) {
        for (i = 0; true; i++) {
            if (*(sub+i) == EOS) return sup;
            if (*(sup+i) != *(sub+i)) break;
        }
    }
    return EOS;
}


/* write_interface -- write SUBR for xlisp */
/*
 * NOTE: if is_macro and there are no arguments, then
 *    do not write parens: e.g. "foo" instead of "foo()"
 */
static void write_interface(in, out, type_name, fn_name, arg_loc, is_macro)
    FILE *in;		/* input file */
    FILE *out;		/* output file */
    char *type_name;	/* c type for return value */
    char *fn_name;	/* c function to be called */
    char *arg_loc;	/* LISP arg type are described here */
    int is_macro;	/* true if this is a macro */
{
    char lispfn[ident_max];	/* lisp fn name */
    char *cp;		/* a temporary */
    int len;		/* a string length */
#define args_max 20
    struct {
        int index;	/* table location for this type */
        int res_flag;	/* is a result returned? */
    } args[args_max];
    char arg_type[ident_max];	/* the original type spec */
    char *c_type;	/* c type for an argument */
    char *c_str;	/* temp for a c code line */
    int argcnt = 0;	/* counts arguments */
    int i;		/* argument index */
    int result_flag = false;	/* true if there are result parameters */
    int result_x;	/* index of result type */
    char newline[line_max];	/* place to read continuation lines */


/*    printf("write_interface: %s %s %s", type_name, fn_name, arg_loc);*/
    if (*type_name == EOS || *fn_name == EOS) {
        error();
        fprintf(errfile, "Error: bad syntax, maybe missing type\n");
        return;
    }

    while (*arg_loc != '(' && *arg_loc != EOS) arg_loc++;
    if (*arg_loc == EOS) {
        error();
        fprintf(errfile, "Error: '(' expected after 'LISP:'\n");
        return;
    } else arg_loc++;
    if (!getarg(arg_loc, lispfn, &arg_loc)) {
        error();
        fprintf(stdout, "Error: lisp function name expected\n");
        return;
    }
    /* make it upper case: */
    for (cp = lispfn; *cp != EOS; cp++) {
        if (islower(*cp)) *cp = toupper(*cp);
    }

    /* save SUBR name */
    strcpy(subr_table[subr_table_x], lispfn);
    subr_table_x++;

    /* make lispfn lower case, dash, colon -> underscore: */
    for (cp = lispfn; *cp != EOS; cp++) {
        if (isupper(*cp)) *cp = tolower(*cp);
        if (*cp == '-' || *cp == ':') *cp = '_';
    }
    
    /* append continuation lines to arg_loc to handle multi-line specs */
    while (sindex(arg_loc, "*/") == NULL) {
        /* remove newline */
        if (strlen(arg_loc) > 0) 
            arg_loc[strlen(arg_loc) - 1] = EOS;
        if (fgets(newline, line_max, in) == NULL) {
            error();
            fprintf(stdout, "Error: end of file unexpected\n");
            exit(1);
        }
        if ((strlen(arg_loc) + strlen(newline)) > (3 * line_max)) {
            error();
            fprintf(stdout, 
                "Error: specification too long or missing end of comment.\n");
            exit(1);
        }
        strcat(arg_loc, newline);
    }

    fprintf(out, "/%c xlc_%s -- interface to C routine %s */\n/**/\n",
        '*', lispfn, fn_name);

    fprintf(out, "LVAL xlc_%s(void)\n{\n", lispfn);
    while (getarg(arg_loc, arg_type, &arg_loc)) {
        int result_only_flag = false;

        if (argcnt >= args_max) {
            error();
            fprintf(errfile, 
                "Internal error: too many args, increase args_max\n");
        }
        len = strlen(arg_type);
        if (arg_type[len-1] == '*') {
            arg_type[len-1] = EOS;
            args[argcnt].res_flag = true;
            result_flag = true;
        } else if (arg_type[len-1] == '^') {
            arg_type[len-1] = EOS;
            args[argcnt].res_flag = true;
            result_flag = true;
            result_only_flag = true;
        } else args[argcnt].res_flag = false;
        
        args[argcnt].index = lookup(arg_type, 'L');
        c_type = get_lisp_ctype(args[argcnt].index);

        if (c_type == NULL) {
            error();
            fprintf(errfile, "Error: %s undefined, using int.\n",
                arg_type);
            c_type = "int";
            args[argcnt].index = lookup("FIXNUM", 'L');
        }
        fprintf(out, "    %s arg%d = ", c_type,	argcnt+1);
        if (result_only_flag) {
            fprintf(out, "%s;\n",
                    get_lisp_initializer(args[argcnt].index));
         } else if (args[argcnt].index == any_index) {
            fprintf(out, "xlgetarg();\n");
        } else {
            c_str = "%s(%s());\n";
            fprintf(out,c_str,
                    get_lisp_extract(args[argcnt].index),
                    get_lisp_getarg(args[argcnt].index));
        }
        argcnt++;
    }

    if (*arg_loc != ')') {
        fprintf(errfile,
            "Warning: paren expected immediately after last arg of %s\n",
            lispfn);
    }

    /* check for close paren and close comment: */
    cp = sindex(arg_loc, ")");
    if (cp == NULL || sindex(cp+1, "*/") == NULL) {
        error();
        fprintf(errfile, "Warning: close paren and close comment expected\n");
    }

    /* lookup result type */
    result_x = lookup(type_name, 'C');
    if (result_x == 0) {
        fprintf(errfile, "Error: unknown type: %s, assuming void\n", 
            type_name);
        result_x = lookup("void", 'C');
    }

    /* if there are result parameters then return them rather than NIL
     * when the type is void
     */
    if (get_c_special(result_x) == 'v' && result_flag) {
        fprintf(out, "    LVAL result;\n");
    }

    if (get_c_special(result_x) != 'v') {
        /* declare result: */
        fprintf(out, "    %s result;\n", type_name);
    }

    /* check for end of argument list: */
    fprintf(out, "\n    xllastarg();\n");

    /* if there are results, we'll call cons, so
     * protect the result from garbage collection
     * if necessary
     */
    if (result_flag && strcmp(type_name, "LVAL") == 0) {
        fprintf(out, "    xlprot1(result);\n");
    }

    /* call the c routine */
    if (get_c_special(result_x) != 'v') {
        fprintf(out, "    result = ");
    } else fprintf(out, "    ");
    fprintf(out, "%s", fn_name);
    if (!is_macro || argcnt > 0) fprintf(out, "(");

    /* pass arguments: */
    for (i = 0; i < argcnt; i++) {
        if (i > 0) fprintf(out, ", ");
        if (args[i].res_flag) fprintf(out, "&");
        fprintf(out, "arg%d", i+1);
    }
    if (!is_macro || argcnt > 0) fprintf(out, ")");
    fprintf(out, ";\n");

    /* put results (if any) on *RSLT* */
    if (result_flag) {
        int wrote_one_flag = false;
        fprintf(out, "    {\tLVAL *next = &getvalue(RSLT_sym);\n");
        for (i = 0; i < argcnt; i++) {
            if (args[i].res_flag) {
                if (wrote_one_flag)
                    fprintf(out, "\tnext = &cdr(*next);\n");
                wrote_one_flag = true;
                fprintf(out, "\t*next = cons(NIL, NIL);\n");
                fprintf(out, "\tcar(*next) = %s(arg%d);",
                    get_lisp_makenode(args[i].index), i+1);
            }
        }
        fprintf(out, "\n    }\n");

        /* copy *RSLT* to result if appropriate */
        if (get_c_special(result_x) == 'v') {
            fprintf(out, "    result = getvalue(RSLT_sym);\n");
        }
    }


    /* generate xlpop() if there was an xlprot1() */
    if (result_flag && strcmp(type_name, "LVAL") == 0) {
        fprintf(out, "    xlpop();\n");
    }


    /* now return actual return value */
    if (get_c_special(result_x) == EOS) {
        error();
        fprintf(errfile, "Warning: unknown type from C, coercing to int.\n");
        fprintf(out, "    return cvfixnum((int) result);\n");
    } else if (get_c_special(result_x) == 'v' && !result_flag) {
        fprintf(out, "    return NIL;\n");
    } else if (get_c_special(result_x) == 'v' && result_flag) {
        fprintf(out, "    return result;\n");
    } else if (get_c_special(result_x) == 's') {
        fprintf(out, "    if (result == NULL) return NIL;\n");
        fprintf(out, "    else return %s(result);\n",
            get_c_conversion(result_x));
    } else {
        fprintf(out, "    return %s(result);\n",
            get_c_conversion(result_x));
    }
    fprintf(out, "}\n\n\n");
}


/* write_postlude -- write stuff at end of file */
/**/
static void write_postlude(out)
    FILE *out;
{
        /* nothing to do for version 2 */
}


/* write_ptrfile -- write function definition table */
/**/
static void write_ptrfile(pf, df)
  FILE *pf;
  FILE *df;
{
    int n;
    char *cp;
    char cname[ident_max];

    for (n = 0; n < subr_table_x; n++) {
        strcpy(cname, subr_table[n]);
        /* make cname lower case, dash,colon -> underscore: */
        for (cp = cname; *cp != EOS; cp++) {
            if (isupper(*cp)) *cp = tolower(*cp);
            if (*cp == '-' || *cp == ':') *cp = '_';
        }
        fprintf(df, "extern LVAL xlc_%s(void);\n", cname);
        fprintf(pf, "  { \"%s\",  S, xlc_%s}, \n", subr_table[n], cname);
    }
    printf("	Add %s to localdefs.h and add %s to localptrs.h\n",
        def_file, ptr_file);
}


/* write_prelude -- write stuff at head of file */
/**/
static void write_prelude(out, out_file)
    FILE *out;
    char *out_file;
{
    int i = 2;
    int col = strlen(out_file) + 21;
    char *s;
    fprintf(out, "/%c %s -- interface to  ",
         '*', out_file);
    while ((s = cl_arg(i)) != NULL) {
        if (i > 2) {
            fprintf(out, ", ");
            col += 2;
        }
        col += strlen(s) + 2;
        if (col > 65) {
            fprintf(out, "\n * ");
            col = 4 + strlen(s) + 2;
        }
        fprintf(out, "%s", s);
        i++;
    }
    fprintf(out, " */\n\n%cifndef mips\n%cinclude \"stdlib.h\"\n", '#', '#');
    fprintf(out, "%cendif\n%cinclude \"xlisp.h\"\n\n", '#', '#');
#ifdef S_TRUE
    fprintf(out, "extern LVAL s_true;\n");
    fprintf(out, "%cdefine cvboolean(i) ((i) ? s_true : NIL)\n", '#');
#else
    fprintf(out, "extern LVAL true;\n");
    fprintf(out, "%cdefine cvboolean(i) ((i) ? true : NIL)\n", '#');
#endif

    fprintf(out, "%c%s\n",
        '#',
        "define testarg2(e) (moreargs() ? (e) : (getflonum(xltoofew())))");

    fprintf(out, "%c%s\n%s\n%s\n",
        '#',
        "define xlgaanynum() (floatp(*xlargv) ? getflonum(nextarg()) : \\",
        "    (fixp(*xlargv) ? (double) getfixnum(nextarg()) : \\",
/* note: getflonum never gets called here, but this makes typechecking happy */
        "        getflonum(xlbadtype(*xlargv))))");
 
    fprintf(out, "%cdefine getboolean(lval) ((lval) != NIL)\n\n", '#');
    fprintf(out, "extern LVAL RSLT_sym;\n\n\n");
}