Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 5140:e5380fdaf8f1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 05:38:34 -0600
parents 7be849cb8828
children 88bd4f3ef8e4
comparison
equal deleted inserted replaced
5139:a48ef26d87ee 5140:e5380fdaf8f1
1 /* Execution of byte code produced by bytecomp.el. 1 /* Execution of byte code produced by bytecomp.el.
2 Implementation of compiled-function objects. 2 Implementation of compiled-function objects.
3 Copyright (C) 1992, 1993 Free Software Foundation, Inc. 3 Copyright (C) 1992, 1993 Free Software Foundation, Inc.
4 Copyright (C) 1995, 2002 Ben Wing. 4 Copyright (C) 1995, 2002, 2010 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
63 #ifdef NEW_GC 63 #ifdef NEW_GC
64 static Lisp_Object 64 static Lisp_Object
65 make_compiled_function_args (int totalargs) 65 make_compiled_function_args (int totalargs)
66 { 66 {
67 Lisp_Compiled_Function_Args *args; 67 Lisp_Compiled_Function_Args *args;
68 args = (Lisp_Compiled_Function_Args *) 68 args = XCOMPILED_FUNCTION_ARGS
69 alloc_lrecord 69 (ALLOC_SIZED_LISP_OBJECT
70 (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, 70 (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
71 Lisp_Object, args, totalargs), 71 Lisp_Object, args, totalargs),
72 &lrecord_compiled_function_args); 72 compiled_function_args));
73 args->size = totalargs; 73 args->size = totalargs;
74 return wrap_compiled_function_args (args); 74 return wrap_compiled_function_args (args);
75 } 75 }
76 76
77 static Bytecount 77 static Bytecount
78 size_compiled_function_args (const void *lheader) 78 size_compiled_function_args (Lisp_Object obj)
79 { 79 {
80 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args, 80 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
81 Lisp_Object, args, 81 Lisp_Object, args,
82 ((Lisp_Compiled_Function_Args *) 82 XCOMPILED_FUNCTION_ARGS (obj)->size);
83 lheader)->size);
84 } 83 }
85 84
86 static const struct memory_description compiled_function_args_description[] = { 85 static const struct memory_description compiled_function_args_description[] = {
87 { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) }, 86 { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) },
88 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args), 87 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args),
89 XD_INDIRECT(0, 0) }, 88 XD_INDIRECT(0, 0) },
90 { XD_END } 89 { XD_END }
91 }; 90 };
92 91
93 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args", 92 DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("compiled-function-args",
94 compiled_function_args, 93 compiled_function_args,
95 1, /*dumpable-flag*/ 94 0,
96 0, 0, 0, 0, 0, 95 compiled_function_args_description,
97 compiled_function_args_description, 96 size_compiled_function_args,
98 size_compiled_function_args, 97 Lisp_Compiled_Function_Args);
99 Lisp_Compiled_Function_Args);
100 #endif /* NEW_GC */ 98 #endif /* NEW_GC */
101 99
102 EXFUN (Ffetch_bytecode, 1); 100 EXFUN (Ffetch_bytecode, 1);
103 101
104 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; 102 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
2372 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) }, 2370 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
2373 #endif 2371 #endif
2374 { XD_END } 2372 { XD_END }
2375 }; 2373 };
2376 2374
2377 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, 2375 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("compiled-function", compiled_function,
2378 1, /*dumpable_flag*/ 2376 mark_compiled_function,
2379 mark_compiled_function, 2377 print_compiled_function, 0,
2380 print_compiled_function, 0, 2378 compiled_function_equal,
2381 compiled_function_equal, 2379 compiled_function_hash,
2382 compiled_function_hash, 2380 compiled_function_description,
2383 compiled_function_description, 2381 Lisp_Compiled_Function);
2384 Lisp_Compiled_Function);
2385 2382
2386 2383
2387 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* 2384 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
2388 Return t if OBJECT is a byte-compiled function object. 2385 Return t if OBJECT is a byte-compiled function object.
2389 */ 2386 */
2754 2751
2755 2752
2756 void 2753 void
2757 syms_of_bytecode (void) 2754 syms_of_bytecode (void)
2758 { 2755 {
2759 INIT_LRECORD_IMPLEMENTATION (compiled_function); 2756 INIT_LISP_OBJECT (compiled_function);
2760 #ifdef NEW_GC 2757 #ifdef NEW_GC
2761 INIT_LRECORD_IMPLEMENTATION (compiled_function_args); 2758 INIT_LISP_OBJECT (compiled_function_args);
2762 #endif /* NEW_GC */ 2759 #endif /* NEW_GC */
2763 2760
2764 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state); 2761 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
2765 DEFSYMBOL (Qbyte_code); 2762 DEFSYMBOL (Qbyte_code);
2766 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp); 2763 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);