-static void
-print_compiled_function_internal (CONST char *start, CONST char *end,
- Lisp_Object obj,
- Lisp_Object printcharfun, int escapeflag)
-{
- /* This function can GC */
- struct Lisp_Compiled_Function *b =
- XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
- int docp = b->flags.documentationp;
- int intp = b->flags.interactivep;
- struct gcpro gcpro1, gcpro2;
- char buf[100];
- GCPRO2 (obj, printcharfun);
-
- write_c_string (start, printcharfun);
-#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
- if (!print_readably)
- {
- Lisp_Object ann = compiled_function_annotation (b);
- if (!NILP (ann))
- {
- write_c_string ("(from ", printcharfun);
- print_internal (ann, printcharfun, 1);
- write_c_string (") ", printcharfun);
- }
- }
-#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
- /* COMPILED_ARGLIST = 0 */
- print_internal (b->arglist, printcharfun, escapeflag);
- /* COMPILED_BYTECODE = 1 */
- write_char_internal (" ", printcharfun);
- /* we don't really want to see that junk in the bytecode instructions. */
- if (STRINGP (b->bytecodes) && !print_readably)
- {
- sprintf (buf, "\"...(%ld)\"", (long) XSTRING_LENGTH (b->bytecodes));
- write_c_string (buf, printcharfun);
- }
- else
- print_internal (b->bytecodes, printcharfun, escapeflag);
- /* COMPILED_CONSTANTS = 2 */
- write_char_internal (" ", printcharfun);
- print_internal (b->constants, printcharfun, escapeflag);
- /* COMPILED_STACK_DEPTH = 3 */
- sprintf (buf, " %d", b->maxdepth);
- write_c_string (buf, printcharfun);
- /* COMPILED_DOC_STRING = 4 */
- if (docp || intp)
- {
- write_char_internal (" ", printcharfun);
- print_internal (compiled_function_documentation (b), printcharfun,
- escapeflag);
- }
- /* COMPILED_INTERACTIVE = 5 */
- if (intp)
- {
- write_char_internal (" ", printcharfun);
- print_internal (compiled_function_interactive (b), printcharfun,
- escapeflag);
- }
- UNGCPRO;
- write_c_string (end, printcharfun);
-}
-
-void
-print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
- int escapeflag)
-{
- /* This function can GC */
- print_compiled_function_internal (((print_readably) ? "#[" :
- "#<compiled-function "),
- ((print_readably) ? "]" : ">"),
- obj, printcharfun, escapeflag);
-}