@@ -1,1194 +1,1194 @@ -/* externs.h Copyright (C) Codemist 1989-99 */ - -/* - * Main batch of extern declarations. Must have tags.h loaded first. - * - */ - -/* Signature: 7754c8eb 07-Mar-2000 */ - -#ifndef header_externs_h -#define header_externs_h 1 - -#ifdef __cplusplus -extern "C" { -#endif - -#ifdef USE_MPI -#include "mpi.h" -extern int32 mpi_rank,mpi_size; - -#ifdef MEMORY_TRACE -#define my_pop() (memory_reference((int32)stack), (*stack--)) -#else -#define my_pop() (*stack--) -#endif - -#endif /* USE_MPI */ - - -extern void **pages, - **heap_pages, **vheap_pages, - **bps_pages, **native_pages; -#ifndef NO_COPYING_GC -extern void **new_heap_pages, **new_vheap_pages, - **new_bps_pages, **new_native_pages; -#endif -extern int32 pages_count, - heap_pages_count, vheap_pages_count, - bps_pages_count, native_pages_count; -#ifndef NO_COPYING_GC -extern int32 new_heap_pages_count, new_vheap_pages_count, - new_bps_pages_count, new_native_pages_count; -#endif - -extern int native_pages_changed; -extern int32 native_fringe; - -extern Lisp_Object *nilsegment, *stacksegment; -extern Lisp_Object *stackbase; -extern int32 stack_segsize; /* measured in units of one CSL page */ -extern DLLexport Lisp_Object *C_stack; -#define stack C_stack - -#ifdef MEMORY_TRACE - -#define push(a) { *++stack = (a); memory_reference((int32)stack); } -/* push2 etc are just like push, but grouped together */ -#define push2(a,b) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); } -#define push3(a,b,c) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); } -#define push4(a,b,c,d) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); \ - *++stack = (d); memory_reference((int32)stack); } -#define push5(a,b,c,d,e){ *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); \ - *++stack = (d); memory_reference((int32)stack); *++stack = (e); memory_reference((int32)stack); } -#define push6(a,b,c,d,e,f) {push3(a,b,c); push3(d,e,f)} - -#define pop(a) { memory_reference((int32)stack); (a) = *stack--; } -#define pop2(a,b) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; } -#define pop3(a,b,c) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; } -#define pop4(a,b,c,d) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; \ - memory_reference((int32)stack); (d) = *stack--; } -#define pop5(a,b,c,d,e) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; \ - memory_reference((int32)stack); (d) = *stack--; memory_reference((int32)stack); (e) = *stack--; } -#define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)} -#define popv(n) stack -= (n); - -#else /* MEMORY_TRACE */ - -#define push(a) { *++stack = (a); } -/* push2 etc are just like push, but grouped together */ -#ifdef USE_AUTOINDEX -/* - * Having inspected the code generated by one of the C compilers that - * is frequently used with this Lisp it emerges that the multiple - * push operations might sometimes be much better treated with - * the increment parts explicitly consolidated into one. To leave - * scope for fine-tuning to cmpiler and machine architecture the - * USE_AUTOINDEX macro could be pre-defined and I suspect that on - * VAX and ARM computers it may make good sense. - */ -#define push2(a,b) { *++stack = (a); *++stack = (b); } -#define push3(a,b,c) { *++stack = (a); *++stack = (b); *++stack = (c); } -#define push4(a,b,c,d) { *++stack = (a); *++stack = (b); *++stack = (c); \ - *++stack = (d); } -#define push5(a,b,c,d,e){ *++stack = (a); *++stack = (b); *++stack = (c); \ - *++stack = (d); *++stack = (e); } -#define push6(a,b,c,d,e,f) {push3(a,b,c); push3(d,e,f)} - -#define pop(a) { (a) = *stack--; } -#define pop2(a,b) { (a) = *stack--; (b) = *stack--; } -#define pop3(a,b,c) { (a) = *stack--; (b) = *stack--; (c) = *stack--; } -#define pop4(a,b,c,d) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \ - (d) = *stack--; } -#define pop5(a,b,c,d,e) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \ - (d) = *stack--; (e) = *stack--; } -#define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)} -#define popv(n) stack -= (n); -#else /* USE_AUTOINDEX */ -#define push2(a,b) { stack[1] = (a); stack[2] = (b); stack += 2; } -#define push3(a,b,c) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ - stack += 3; } -#define push4(a,b,c,d) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ - stack[4] = (d); stack += 4; } -#define push5(a,b,c,d,e){ stack[1] = (a); stack[2] = (b); stack[3] = (c); \ - stack[4] = (d); stack[5] = (e); stack += 5; } -#define push6(a,b,c,d,e,f) { \ - stack[1] = (a); stack[2] = (b); stack[3] = (c); \ - stack[4] = (d); stack[5] = (e); stack[6] = (f); \ - stack += 6; } - -#define pop(a) { (a) = *stack--; } -#define pop2(a,b) { stack -= 2; (a) = stack[2]; (b) = stack[1]; } -#define pop3(a,b,c) { stack -= 3; (a) = stack[3]; (b) = stack[2]; \ - (c) = stack[1]; } -#define pop4(a,b,c,d) { stack -= 4; (a) = stack[4]; (b) = stack[3]; \ - (c) = stack[2]; (d) = stack[1]; } -#define pop5(a,b,c,d,e) { stack -= 5; (a) = stack[5]; (b) = stack[4]; \ - (c) = stack[3]; (d) = stack[2]; (e) = stack[1]; } -#define pop6(a,b,c,d,e, f) { stack -= 6; \ - (a) = stack[6]; (b) = stack[5]; (c) = stack[4]; \ - (d) = stack[3]; (e) = stack[2]; (f) = stack[1]; } -#define popv(n) stack -= (n); -#endif /* USE_AUTOINDEX */ -#endif /* MEMORY_TRACE*/ - -#define errexit() { nil = C_nil; if (exception_pending()) return nil; } -#define errexitn(n) { nil = C_nil; \ - if (exception_pending()) { popv(n); return nil; } } -#define errexitv() { nil = C_nil; if (exception_pending()) return; } -#define errexitvn(n) { nil = C_nil; \ - if (exception_pending()) { popv(n); return; } } - -#define GC_USER_SOFT 0 -#define GC_USER_HARD 1 -#define GC_STACK 2 -#define GC_CONS 3 -#define GC_VEC 4 -#define GC_BPS 5 -#define GC_PRESERVE 6 -#define GC_NATIVE 7 - - -#ifdef CHECK_STACK - -#ifdef SOFTWARE_TICKS - -extern DLLexport int32 countdown; -#ifdef INITIAL_SOFTWARE_TICKS -extern DLLexport int32 software_ticks; -#endif -extern DLLexport int deal_with_tick(void); - -#define stackcheck0(k) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { reclaim(nil, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck1(k, a1) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { a1 = reclaim(a1, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck2(k, a1, a2) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push(a2); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck3(k, a1, a2, a3) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push2(a2, a3); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop2(a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck4(k, a1, a2, a3, a4) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push3(a2, a3, a4); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop3(a4, a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#else /* SOFTWARE_TICKS */ - -#define stackcheck0(k) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if (stack >= stacklimit) \ - { reclaim(nil, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck1(k, a1) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if (stack >= stacklimit) \ - { a1 = reclaim(a1, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck2(k, a1, a2) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if (stack >= stacklimit) \ - { push(a2); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck3(k, a1, a2, a3) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if (stack >= stacklimit) \ - { push2(a2, a3); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop2(a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck4(k, a1, a2, a3, a4) \ - if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ - if (stack >= stacklimit) \ - { push3(a2, a3, a4); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop3(a4, a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#endif /* SOFTWARE_TICKS */ - -#else /* CHECK_STACK */ - -#ifdef SOFTWARE_TICKS - -extern DLLexport int32 countdown; -#ifdef INITIAL_SOFTWARE_TICKS -extern DLLexport int32 software_ticks; -#endif -extern DLLexport int deal_with_tick(void); - -#define stackcheck0(k) \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { reclaim(nil, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck1(k, a1) \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { a1 = reclaim(a1, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck2(k, a1, a2) \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push(a2); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck3(k, a1, a2, a3) \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push2(a2, a3); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop2(a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck4(k, a1, a2, a3, a4) \ - if ((--countdown < 0 && deal_with_tick()) || \ - stack >= stacklimit) \ - { push3(a2, a3, a4); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop3(a4, a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#else /* SOFTWARE_TICKS */ - -#define stackcheck0(k) \ - if (stack >= stacklimit) \ - { reclaim(nil, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck1(k, a1) \ - if (stack >= stacklimit) \ - { a1 = reclaim(a1, "stack", GC_STACK, 0); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck2(k, a1, a2) \ - if (stack >= stacklimit) \ - { push(a2); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck3(k, a1, a2, a3) \ - if (stack >= stacklimit) \ - { push2(a2, a3); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop2(a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#define stackcheck4(k, a1, a2, a3, a4) \ - if (stack >= stacklimit) \ - { push3(a2, a3, a4); \ - a1 = reclaim(a1, "stack", GC_STACK, 0); \ - pop3(a4, a3, a2); \ - nil = C_nil; \ - if (exception_pending()) { popv(k); return nil; } \ - } - -#endif /* SOFTWARE_TICKS */ -#endif /* CHECK_STACK */ - -/* - * As well as being used to point directly to the major Lisp item NIL, - * this register is used as a base for a table of other critically - * important other Lisp values. Offsets for at least some of these are - * defined here. - * I also need a proper C external variable holding the value of NIL since - * when called from the C library (e.g. in a signal handler) the global - * register variable will not be available! - */ - -extern DLLexport Lisp_Object C_nil; - -/* - * In COMMON mode the symbol-head for NIL uses the first few offsets - * from NIL here, so I start storing system variables at offset 12 so - * that even if at some stage I expand the size of all identifiers from the - * present state I will be safe. - */ - -#define first_nil_offset 50 /* GC collector marks from here up */ - -/* - * A vector of 50 words is used by the interpreter when preparing args - * for functions and when handling multiple values. - */ - -#define work_0_offset 200 - -/* Garbage collector marks up to but not including last_nil_offset */ -#define last_nil_offset 251 - -/* - * NIL_SEGMENT_SIZE must be over-large by enough to allow for - * space lost while rounding nil up to be a multiple of 8. Also in the - * Common Lisp case I need to give myself a spare word BEFORE the place - * where C_nil points. - */ -#define NIL_SEGMENT_SIZE (last_nil_offset*sizeof(Lisp_Object) + 32) - -/* - * I give myself a margin of SPARE bytes at the end of a page so that I can - * always CONS that amount (even without a garbage collection check) and not - * corrupt anything. The main use for this is that sometimes I need to - * convert a set of multiple values or of arguments from values on the - * (C-) stack or wherever va_arg() can find them into a list structure, and - * to avoid horrible potential problems with a garbage collection spotting] - * an exception (notably a ^C interrupt), running arbitrary code in an - * exception ghandler and then continuing, I need to cons those things up - * without any possible GC. The function cons_no_gc does that, and - * I should then call cons_gc_test() afterwards to regularise the situation. - * 512 bytes here leaves room for 64 conses, and I support at most 50 - * (multiple-) values so I hope this is safe. - */ - -#define SPARE 512 - -#ifdef NILSEG_EXTERNS -/* - * One some computers (ones with plenty of registers, and where the - * main addressing mode is register-indexed, and where optimising - * an compiler can keep variables in registers all the time, it will - * be most efficient to put major system variables addressed as offsets - * from NIL, where I expect to keep nil in a register variable pretty - * well always. On other machines (notable the Intel 80286) that policy - * gives pretty disasterous code, and the use of direct simple external - * variables will win. In PRESERVE and RESTORE I will have to copy - * all the separate external variables into a compact block for - * transfer to and from files. Actually on many (most?) machines the - * choice of whether this option should be enabled or not will be pretty - * marginal and should really be sorted out by building once with - * NILSEG_EXTERNS and once without, and comparing the performance of the - * two resulting systems. - */ - -#define nil_as_base - -extern unsigned32 byteflip; - -extern Lisp_Object codefringe; -extern Lisp_Object volatile codelimit; - -extern Lisp_Object * volatile stacklimit; - -extern Lisp_Object fringe; -extern Lisp_Object volatile heaplimit; - -extern Lisp_Object volatile vheaplimit; -extern Lisp_Object vfringe; - -extern int32 nwork; - -extern int32 exit_reason; -extern DLLexport int32 exit_count; -extern unsigned32 gensym_ser, print_precision, miscflags; -extern int32 current_modulus, fastget_size, package_bits; - -extern DLLexport Lisp_Object lisp_true, lambda, funarg, unset_var, opt_key, rest_key; -extern DLLexport Lisp_Object quote_symbol, function_symbol, comma_symbol; -extern DLLexport Lisp_Object comma_at_symbol, cons_symbol, eval_symbol; -extern DLLexport Lisp_Object work_symbol, evalhook, applyhook, macroexpand_hook; -extern DLLexport Lisp_Object append_symbol, exit_tag, exit_value, catch_tags; -extern DLLexport Lisp_Object current_package, startfn; -extern DLLexport Lisp_Object gensym_base, string_char_sym, boffo; -extern DLLexport Lisp_Object err_table; -extern DLLexport Lisp_Object progn_symbol; -extern DLLexport Lisp_Object lisp_work_stream, charvec, raise_symbol, lower_symbol; -extern DLLexport Lisp_Object echo_symbol, codevec, litvec, supervisor, B_reg; -extern DLLexport Lisp_Object savedef, comp_symbol, compiler_symbol, faslvec; -extern DLLexport Lisp_Object tracedfn, lisp_terminal_io; -extern DLLexport Lisp_Object lisp_standard_output, lisp_standard_input, lisp_error_output; -extern DLLexport Lisp_Object lisp_trace_output, lisp_debug_io, lisp_query_io; -extern DLLexport Lisp_Object prompt_thing, faslgensyms; -extern DLLexport Lisp_Object prinl_symbol, emsg_star, redef_msg; -extern DLLexport Lisp_Object expr_symbol, fexpr_symbol, macro_symbol; -extern DLLexport Lisp_Object cl_symbols, active_stream, current_module; -extern DLLexport Lisp_Object features_symbol, lisp_package; -extern DLLexport Lisp_Object sys_hash_table, help_index, cfunarg, lex_words; -extern DLLexport Lisp_Object get_counts, fastget_names, input_libraries; -extern DLLexport Lisp_Object output_library, current_file, break_function; -extern DLLexport Lisp_Object standard_output, standard_input, debug_io; -extern DLLexport Lisp_Object error_output, query_io, terminal_io; -extern DLLexport Lisp_Object trace_output, fasl_stream; - -#ifdef COMMON -extern DLLexport Lisp_Object keyword_package; -extern DLLexport Lisp_Object all_packages, package_symbol, internal_symbol; -extern DLLexport Lisp_Object external_symbol, inherited_symbol; -extern DLLexport Lisp_Object key_key, allow_other_keys, aux_key; -extern DLLexport Lisp_Object format_symbol; -extern DLLexport Lisp_Object expand_def_symbol, allow_key_key, declare_symbol; -extern DLLexport Lisp_Object special_symbol; -#endif -extern DLLexport Lisp_Object native_code, native_symbol, traceprint_symbol; -extern DLLexport Lisp_Object loadsource_symbol; -extern DLLexport Lisp_Object hankaku_symbol; - -extern Lisp_Object workbase[51]; - -extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2; -extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5; -extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8; -extern DLLexport Lisp_Object user_base_9; - -#define work_0 workbase[0] -#define work_1 workbase[1] -#define mv_1 workbase[1] -#define mv_2 workbase[2] -#define mv_3 workbase[3] -#define work_50 workbase[50] - -#else /* NILSEG_EXTERNS */ - -#define nil_as_base Lisp_Object nil = C_nil; - -#define byteflip (*(unsigned32 *)&((Lisp_Object *)nil)[12]) -#define codefringe ((Lisp_Object *)nil)[13] -#define codelimit ((Lisp_Object volatile *)nil)[14] -/* - * On a machine where sizeof(void *)=8 and alignment matters I need to arrange for - * stacklimit to be properly aligned. Also I MUST do the address calculation - * in a way that does not get muddled by the "sizeof(void *)" issue. I - * reserve nilseg offsets 15, 16 and 17 for this. - */ -#ifdef COMMON -#define stacklimit (*(Lisp_Object * volatile *) \ - &((Lisp_Object *)nil)[16]) -#else -#define stacklimit (*(Lisp_Object * volatile *) \ - &((Lisp_Object *)nil)[15]) -#endif -#define fringe ((Lisp_Object *)nil)[18] -#define heaplimit ((Lisp_Object volatile *)nil)[19] -#define vheaplimit ((Lisp_Object volatile *)nil)[20] -#define vfringe ((Lisp_Object *)nil)[21] -#define miscflags (*(unsigned32 *)&((Lisp_Object *)nil)[22]) - -#define nwork (*(int32 *)&((Lisp_Object *)nil)[24]) -#define exit_reason (*(int32 *)&((Lisp_Object *)nil)[25]) -#define exit_count (*(int32 *)&((Lisp_Object *)nil)[26]) -#define gensym_ser (*(unsigned32 *)&((Lisp_Object *)nil)[27]) -#define print_precision (*(unsigned32 *)&((Lisp_Object *)nil)[28]) -#define current_modulus (*(int32 *)&((Lisp_Object *)nil)[29]) -#define fastget_size (*(int32 *)&((Lisp_Object *)nil)[30]) -#define package_bits (*(int32 *)&((Lisp_Object *)nil)[31]) -/* offsets 32-49 spare at present */ - -/* Offset 50 used for EQ hash table list */ -/* Offset 51 used for EQUAL hash table list */ -#define current_package ((Lisp_Object *)nil)[52] -/* current_package is treated specially by the garbage collector */ - -#define B_reg ((Lisp_Object *)nil)[53] -#define codevec ((Lisp_Object *)nil)[54] -#define litvec ((Lisp_Object *)nil)[55] -#define exit_tag ((Lisp_Object *)nil)[56] -#define exit_value ((Lisp_Object *)nil)[57] -#define catch_tags ((Lisp_Object *)nil)[58] -#define lisp_package ((Lisp_Object *)nil)[59] -#define boffo ((Lisp_Object *)nil)[60] -#define charvec ((Lisp_Object *)nil)[61] -#define sys_hash_table ((Lisp_Object *)nil)[62] -#define help_index ((Lisp_Object *)nil)[63] -#define gensym_base ((Lisp_Object *)nil)[64] -#define err_table ((Lisp_Object *)nil)[65] -#define supervisor ((Lisp_Object *)nil)[66] -#define startfn ((Lisp_Object *)nil)[67] -#define faslvec ((Lisp_Object *)nil)[68] -#define tracedfn ((Lisp_Object *)nil)[69] -#define prompt_thing ((Lisp_Object *)nil)[70] -#define faslgensyms ((Lisp_Object *)nil)[71] -#define cl_symbols ((Lisp_Object *)nil)[72] -#define active_stream ((Lisp_Object *)nil)[73] -#define current_module ((Lisp_Object *)nil)[74] -/* - * 75-89 spare for workspace-style locations - */ -#define append_symbol ((Lisp_Object *)nil)[90] -#define applyhook ((Lisp_Object *)nil)[91] -#define cfunarg ((Lisp_Object *)nil)[92] -#define comma_at_symbol ((Lisp_Object *)nil)[93] -#define comma_symbol ((Lisp_Object *)nil)[94] -#define compiler_symbol ((Lisp_Object *)nil)[95] -#define comp_symbol ((Lisp_Object *)nil)[96] -#define cons_symbol ((Lisp_Object *)nil)[97] -#define echo_symbol ((Lisp_Object *)nil)[98] -#define emsg_star ((Lisp_Object *)nil)[99] -#define evalhook ((Lisp_Object *)nil)[100] -#define eval_symbol ((Lisp_Object *)nil)[101] -#define expr_symbol ((Lisp_Object *)nil)[102] -#define features_symbol ((Lisp_Object *)nil)[103] -#define fexpr_symbol ((Lisp_Object *)nil)[104] -#define funarg ((Lisp_Object *)nil)[105] -#define function_symbol ((Lisp_Object *)nil)[106] -#define lambda ((Lisp_Object *)nil)[107] -#define lisp_true ((Lisp_Object *)nil)[108] -#define lower_symbol ((Lisp_Object *)nil)[109] -#define macroexpand_hook ((Lisp_Object *)nil)[110] -#define macro_symbol ((Lisp_Object *)nil)[111] -#define opt_key ((Lisp_Object *)nil)[112] -#define prinl_symbol ((Lisp_Object *)nil)[113] -#define progn_symbol ((Lisp_Object *)nil)[114] -#define quote_symbol ((Lisp_Object *)nil)[115] -#define raise_symbol ((Lisp_Object *)nil)[116] -#define redef_msg ((Lisp_Object *)nil)[117] -#define rest_key ((Lisp_Object *)nil)[118] -#define savedef ((Lisp_Object *)nil)[119] -#define string_char_sym ((Lisp_Object *)nil)[120] -#define unset_var ((Lisp_Object *)nil)[121] -#define work_symbol ((Lisp_Object *)nil)[122] -#define lex_words ((Lisp_Object *)nil)[123] -#define get_counts ((Lisp_Object *)nil)[124] -#define fastget_names ((Lisp_Object *)nil)[125] -#define input_libraries ((Lisp_Object *)nil)[126] -#define output_library ((Lisp_Object *)nil)[127] -#define current_file ((Lisp_Object *)nil)[128] -#define break_function ((Lisp_Object *)nil)[129] - -#define lisp_work_stream ((Lisp_Object *)nil)[130] -#define lisp_standard_output ((Lisp_Object *)nil)[131] -#define lisp_standard_input ((Lisp_Object *)nil)[132] -#define lisp_debug_io ((Lisp_Object *)nil)[133] -#define lisp_error_output ((Lisp_Object *)nil)[134] -#define lisp_query_io ((Lisp_Object *)nil)[135] -#define lisp_terminal_io ((Lisp_Object *)nil)[136] -#define lisp_trace_output ((Lisp_Object *)nil)[137] -#define standard_output ((Lisp_Object *)nil)[138] -#define standard_input ((Lisp_Object *)nil)[139] -#define debug_io ((Lisp_Object *)nil)[140] -#define error_output ((Lisp_Object *)nil)[141] -#define query_io ((Lisp_Object *)nil)[142] -#define terminal_io ((Lisp_Object *)nil)[143] -#define trace_output ((Lisp_Object *)nil)[144] -#define fasl_stream ((Lisp_Object *)nil)[145] -#define native_code ((Lisp_Object *)nil)[146] -#define native_symbol ((Lisp_Object *)nil)[147] -#define traceprint_symbol ((Lisp_Object *)nil)[148] -#define loadsource_symbol ((Lisp_Object *)nil)[149] -#define hankaku_symbol ((Lisp_Object *)nil)[150] - -#ifdef COMMON -#define keyword_package ((Lisp_Object *)nil)[170] -#define all_packages ((Lisp_Object *)nil)[171] -#define package_symbol ((Lisp_Object *)nil)[172] -#define internal_symbol ((Lisp_Object *)nil)[173] -#define external_symbol ((Lisp_Object *)nil)[174] -#define inherited_symbol ((Lisp_Object *)nil)[175] -#define key_key ((Lisp_Object *)nil)[176] -#define allow_other_keys ((Lisp_Object *)nil)[177] -#define aux_key ((Lisp_Object *)nil)[178] -#define format_symbol ((Lisp_Object *)nil)[179] -#define expand_def_symbol ((Lisp_Object *)nil)[180] -#define allow_key_key ((Lisp_Object *)nil)[181] -#define declare_symbol ((Lisp_Object *)nil)[182] -#define special_symbol ((Lisp_Object *)nil)[183] -#endif - - - -/* - * The next are intended for use by people building custom versions - * of CSL. They are always handled as if NILSEG_EXTERNS had been set, - * even if it had not, since that gives the user direct access to them as - * simple C variables. Note that they must ALWAYS be kept with proper - * valid Lisp objects in them. - */ -/* #define user_base_0 ((Lisp_Object *)nil)[190] */ -/* #define user_base_1 ((Lisp_Object *)nil)[191] */ -/* #define user_base_2 ((Lisp_Object *)nil)[192] */ -/* #define user_base_3 ((Lisp_Object *)nil)[193] */ -/* #define user_base_4 ((Lisp_Object *)nil)[194] */ -/* #define user_base_5 ((Lisp_Object *)nil)[195] */ -/* #define user_base_6 ((Lisp_Object *)nil)[196] */ -/* #define user_base_7 ((Lisp_Object *)nil)[197] */ -/* #define user_base_8 ((Lisp_Object *)nil)[198] */ -/* #define user_base_9 ((Lisp_Object *)nil)[199] */ - -extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2; -extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5; -extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8; -extern DLLexport Lisp_Object user_base_9; - -#define work_0 ((Lisp_Object *)nil)[200] -#define work_1 ((Lisp_Object *)nil)[201] -#define mv_1 work_1 -#define mv_2 ((Lisp_Object *)nil)[202] -#define mv_3 ((Lisp_Object *)nil)[203] -#define work_50 ((Lisp_Object *)nil)[250] - -#endif /*NILSEG_EXTERNS */ - -/* dummy_function_call is only used to patch around C compiler bugs! */ -extern void MS_CDECL dummy_function_call(char *why, ...); - -extern void copy_into_nilseg(int fg); -extern void copy_out_of_nilseg(int fg); - -#define eq_hash_table_list ((Lisp_Object *)nil)[50] /* In heap image */ -#define equal_hash_table_list ((Lisp_Object *)nil)[51] /* In heap image */ -#define current_package_offset 52 - -extern void rehash_this_table(Lisp_Object v); -extern Lisp_Object eq_hash_tables, equal_hash_tables; - -/* - * The following are used to help processing. - */ -extern Lisp_Object volatile savecodelimit; -extern Lisp_Object * volatile savestacklimit; -extern Lisp_Object volatile saveheaplimit; -extern Lisp_Object volatile savevheaplimit; -extern char *exit_charvec; - -#ifdef DEBUG -extern int trace_all; -#endif - -extern int trace_depth; - -#define MAX_INPUT_FILES 40 /* limit on command-line length */ -#define MAX_SYMBOLS_TO_DEFINE 40 -#define MAX_FASL_PATHS 20 - -extern char *files_to_read[MAX_INPUT_FILES], - *symbols_to_define[MAX_SYMBOLS_TO_DEFINE], - *fasl_paths[MAX_FASL_PATHS]; -extern int fasl_output_file, output_directory; -extern FILE *binary_read_file; - -#ifndef COMMON -#ifdef CWIN -extern char **loadable_packages; -extern char **switches; -#endif -#endif - -#ifdef SOCKETS -extern int sockets_ready; -extern void flush_socket(); -#endif - -extern CSLbool undefine_this_one[MAX_SYMBOLS_TO_DEFINE]; - -extern int number_of_input_files, - number_of_symbols_to_define, - number_of_fasl_paths, - init_flags; - -extern int native_code_tag; - -extern char *standard_directory; - -extern CSLbool gc_method; -extern int32 gc_number; - -#define INIT_QUIET 1 -#define INIT_VERBOSE 2 -#define INIT_EXPANDABLE 4 - -#define Lispify_predicate(p) ((p) ? lisp_true : nil) - -/* - * variables used by the IO system. - */ - -extern int tty_count; -extern FILE *spool_file; -extern char spool_file_name[32]; - -typedef struct Ihandle -{ - FILE *f; /* File within which this sub-file lives */ - long int o; /* Offset (as returned by ftell) */ - long int n; /* Number of bytes remaining unread here */ - unsigned32 chk; /* Checksum */ - int status; /* Reading or Writing */ -} Ihandle; - -/* - * If there is no more than 100 bytes of data then I will deem - * file compression frivolous. The compression code assumes that - * it has at least 2 bytes to work on, so do NOT cut this limit down to zero. - * Indeed more than that the limit must be greater than the length of - * the initial header record (112 bytes). - */ - -extern int32 compression_worth_while; -#define CODESIZE 0x1000 - -typedef struct entry_point -{ - void *p; - char *s; -} entry_point; - -#ifdef CJAVA -#define entry_table_size 132 -#else -#define entry_table_size 127 -#endif -extern entry_point entries_table[]; - -extern int doubled_execution; - -#ifdef MEMORY_TRACE -extern int32 memory_base, memory_size; -extern unsigned char *memory_map; -extern FILE *memory_file; -extern void memory_comment(int n); -#endif - -#define ARG_CUT_OFF 25 -extern void push_args(va_list a, int nargs); -extern void push_args_1(va_list a, int nargs); - -extern void Iinit(void); -extern void IreInit(void); -extern void Icontext(Ihandle *); -extern void Irestore_context(Ihandle); -extern void Ilist(void); -extern CSLbool Iopen(char *name, int len, CSLbool dirn, char *expanded_name); -extern CSLbool Iopen_from_stdin(); -extern CSLbool IopenRoot(char *expanded_name, int hard); -extern CSLbool Iwriterootp(char *expanded); -extern CSLbool Iopen_help(int32 offset); -extern CSLbool Iopen_banner(int code); -extern CSLbool Imodulep(char *name, int len, char *datestamp, int32 *size, - char *expanded_name); -extern CSLbool Icopy(char *name, int len); -extern CSLbool Idelete(char *name, int len); -extern CSLbool IcloseInput(int check_checksum); -extern CSLbool IcloseOutput(); -extern CSLbool Ifinished(void); -extern int Igetc(void); -extern int32 Iread(void *buff, int32 size); -extern CSLbool Iputc(int ch); -extern CSLbool Iwrite(void *buff, int32 size); -extern long int Ioutsize(void); - -/* - * I will allow myself 192 bytes to store registration information. - * In my initial implementation I will only use a fraction of that - * but it seems safer to design the structure with extra room for potential - * enhancements. I will keep a version code in the data so that I can update - * my methods but still preserve upwards compatibility when I do that. - */ -#define REGISTRATION_SIZE 192 -#define REGISTRATION_VERSION "r1.0" -extern unsigned char registration_data[REGISTRATION_SIZE]; -extern void MD5_Init(); -extern void MD5_Update(unsigned char *data, int len); -extern void MD5_Final(unsigned char *md); -extern CSLbool MD5_busy; -extern unsigned char *MD5(unsigned char *data, int n, unsigned char *md); -extern void checksum(Lisp_Object a); -extern unsigned char unpredictable[256]; -extern void inject_randomness(int n); -/* - * crypt_init() seeds the encryption engine that I used, and then - * crypt_get_block() gets a chunk of the sequence, which I can XOR with - * text to mess it up. - */ -extern void crypt_init(char *key); -#define CRYPT_BLOCK 128 -extern void crypt_get_block(unsigned char result[CRYPT_BLOCK]); -/* - * crypt_active is -ve if none is in use, otherwise it is a key identifier - * (to allow for possibly multiple keys). crypt_buffer & crypt_count are - * things filled in by crypt_get_block(). The encryption stuff here is just - * for protection of the software, and the code that does somewhat more - * serious encryption to create the keys used with this stream cipher live - * elsewhere. The crypto technology in CSL is only used on image files, ie - * chunks of compiled code etc, and no provision has been made to use it - * on user data-files. I can store up to CRYPT_KEYS different keys with - * a CSL system and have different modules protected by different ones of - * them. - */ -#define CRYPT_KEYS 10 -extern char *crypt_keys[CRYPT_KEYS]; -extern int crypt_active; -extern unsigned char *crypt_buffer; -extern int crypt_count; - -extern void ensure_screen(void); -extern int window_heading; -#ifndef WINDOW_SYSTEM -#ifdef BUFFERED_STDOUT -extern clock_t last_flush; -#endif -#define start_up_window_manager(a) {} -#endif -extern void my_exit(int n); -extern void *my_malloc(size_t n); - -extern clock_t base_time; -extern double *clock_stack; -extern void push_clock(void); -extern double pop_clock(void); -extern double consolidated_time[10], gc_time; -extern CSLbool volatile already_in_gc, tick_on_gc_exit; -extern CSLbool volatile interrupt_pending, tick_pending, polltick_pending; -extern int current_fp_rep; -#ifndef __cplusplus -extern jmp_buf *errorset_buffer; -#endif -extern char *errorset_msg; -extern int errorset_code; -extern void unwind_stack(Lisp_Object *, CSLbool findcatch); -extern CSLbool segvtrap; -extern CSLbool batch_flag; -extern int escaped_printing; -#ifdef __WATCOMC__ -extern void low_level_signal_handler(int code); -#else -extern void MS_CDECL low_level_signal_handler(int code); -#endif -extern void MS_CDECL sigint_handler(int code); -#ifdef CHECK_STACK -extern int check_stack(char *file, int line); -#endif - -#ifdef RECORD_GET -extern void record_get(Lisp_Object tag, CSLbool found); -#endif - -/* - * Functions used internally - not to be installed in Lisp function - * cells, but some of these may end up getting called using special - * non-standard conventions when the Lisp compiler has been at work. - */ - -extern void adjust_all(); -extern void set_up_functions(CSLbool restartp); -extern void get_user_files_checksum(unsigned char *); -extern DLLexport Lisp_Object acons(Lisp_Object a, Lisp_Object b, Lisp_Object c); -extern DLLexport Lisp_Object ash(Lisp_Object a, Lisp_Object b); -extern Lisp_Object bytestream_interpret(Lisp_Object code, Lisp_Object lit, - Lisp_Object *entry_stack); -extern CSLbool complex_stringp(Lisp_Object a); -extern void freshline_trace(); -extern void freshline_debug(); -extern DLLexport Lisp_Object cons(Lisp_Object a, Lisp_Object b); -extern Lisp_Object cons_no_gc(Lisp_Object a, Lisp_Object b); -extern Lisp_Object cons_gc_test(Lisp_Object a); -extern void convert_fp_rep(void *p, int old_rep, int new_rep, int type); -extern DLLexport Lisp_Object Ceval(Lisp_Object u, Lisp_Object env); -extern unsigned32 Crand(void); -extern DLLexport Lisp_Object Cremainder(Lisp_Object a, Lisp_Object b); -extern void Csrand(unsigned32 a, unsigned32 b); -extern void discard(Lisp_Object a); -extern DLLexport CSLbool eql_fn(Lisp_Object a, Lisp_Object b); -extern DLLexport CSLbool cl_equal_fn(Lisp_Object a, Lisp_Object b); -extern DLLexport CSLbool equal_fn(Lisp_Object a, Lisp_Object b); -#ifdef TRACED_EQUAL -extern DLLexport CSLbool traced_equal_fn(Lisp_Object a, Lisp_Object b, - char *, int, int); -#define equal_fn(a, b) traced_equal_fn(a, b, __FILE__, __LINE__, 0) -extern void dump_equals(); -#endif -extern DLLexport CSLbool equalp(Lisp_Object a, Lisp_Object b); -extern DLLexport Lisp_Object apply(Lisp_Object fn, int nargs, - Lisp_Object env, Lisp_Object fname); -extern DLLexport Lisp_Object apply_lambda(Lisp_Object def, int nargs, - Lisp_Object env, Lisp_Object name); -extern void deallocate_pages(void); -extern void drop_heap_segments(void); -extern DLLexport Lisp_Object gcd(Lisp_Object a, Lisp_Object b); -extern Lisp_Object get_pname(Lisp_Object a); -#ifdef COMMON -extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b, Lisp_Object c); -#else -extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b); -#endif -extern Lisp_Object getvector(int tag, int32 type, int32 length); -extern Lisp_Object getvector_init(int32 n, Lisp_Object v); -extern Lisp_Object getcodevector(int32 type, int32 size); -extern unsigned32 hash_lisp_string(Lisp_Object s); -extern void lose_C_def(Lisp_Object a); -extern DLLexport CSLbool geq2(Lisp_Object a, Lisp_Object b); -extern DLLexport CSLbool greaterp2(Lisp_Object a, Lisp_Object b); -extern DLLexport CSLbool lesseq2(Lisp_Object a, Lisp_Object b); -extern DLLexport CSLbool lessp2(Lisp_Object a, Lisp_Object b); -extern DLLexport Lisp_Object list2(Lisp_Object a, Lisp_Object b); -extern DLLexport Lisp_Object list2star(Lisp_Object a, Lisp_Object b, Lisp_Object c); -extern DLLexport Lisp_Object list3(Lisp_Object a, Lisp_Object b, Lisp_Object c); -extern DLLexport Lisp_Object lognot(Lisp_Object a); -extern DLLexport Lisp_Object macroexpand(Lisp_Object form, Lisp_Object env); -extern Lisp_Object make_one_word_bignum(int32 n); -extern Lisp_Object make_package(Lisp_Object name); -extern Lisp_Object make_string(char *b); -extern Lisp_Object make_nstring(char *b, int32 n); -extern Lisp_Object make_undefined_symbol(char const *s); -extern Lisp_Object make_symbol(char const *s, int restartp, - one_args *f1, two_args *f2, n_args *fn); -extern DLLexport void MS_CDECL stdout_printf(char *fmt, ...); -extern DLLexport void MS_CDECL term_printf(char *fmt, ...); -extern DLLexport void MS_CDECL err_printf(char *fmt, ...); -extern DLLexport void MS_CDECL debug_printf(char *fmt, ...); -extern DLLexport void MS_CDECL trace_printf(char *fmt, ...); -extern char *my_getenv(char *name); -extern DLLexport Lisp_Object ncons(Lisp_Object a); -extern DLLexport Lisp_Object ndelete(Lisp_Object a, Lisp_Object b); -extern DLLexport Lisp_Object negate(Lisp_Object a); -extern DLLexport Lisp_Object nreverse(Lisp_Object a); -extern FILE *open_file(char *filename, char *original_name, - size_t n, char *dirn, FILE *old_file); -extern DLLexport Lisp_Object plus2(Lisp_Object a, Lisp_Object b); -extern void preserve(char *msg); -extern void preserve_native_code(); -extern void relocate_native_function(unsigned char *bps); -extern Lisp_Object prin(Lisp_Object u); -extern char *get_string_data(Lisp_Object a, char *why, int32 *len); -extern DLLexport void prin_to_stdout(Lisp_Object u); -extern DLLexport void prin_to_terminal(Lisp_Object u); -extern DLLexport void prin_to_debug(Lisp_Object u); -extern DLLexport void prin_to_query(Lisp_Object u); -extern DLLexport void prin_to_trace(Lisp_Object u); -extern DLLexport void prin_to_error(Lisp_Object u); -extern DLLexport void loop_print_stdout(Lisp_Object o); -extern DLLexport void loop_print_terminal(Lisp_Object o); -extern DLLexport void loop_print_debug(Lisp_Object o); -extern DLLexport void loop_print_query(Lisp_Object o); -extern DLLexport void loop_print_trace(Lisp_Object o); -extern DLLexport void loop_print_error(Lisp_Object o); -extern void internal_prin(Lisp_Object u, int prefix); -extern DLLexport Lisp_Object princ(Lisp_Object u); -extern DLLexport Lisp_Object print(Lisp_Object u); -extern DLLexport Lisp_Object printc(Lisp_Object u); -extern void print_bignum(Lisp_Object u, CSLbool blankp, int nobreak); -extern void print_bighexoctbin(Lisp_Object u, - int radix, int width, CSLbool blankp, int nobreak); -extern DLLexport Lisp_Object putprop(Lisp_Object a, Lisp_Object b, - Lisp_Object c); -extern DLLexport Lisp_Object quot2(Lisp_Object a, Lisp_Object b); -extern DLLexport Lisp_Object rational(Lisp_Object a); -extern void read_eval_print(int noisy); -extern DLLexport Lisp_Object reclaim(Lisp_Object value_to_return, char *why, - int stg_class, int32 size); -extern CSLbool do_not_kill_native_code; -extern void set_fns(Lisp_Object sym, one_args *f1, - two_args *f2, n_args *fn); -extern void setup(int restartp, double storesize); -extern Lisp_Object simplify_string(Lisp_Object s); -extern CSLbool stringp(Lisp_Object a); -extern DLLexport Lisp_Object times2(Lisp_Object a, Lisp_Object b); -extern int32 thirty_two_bits(Lisp_Object a); - -#ifdef DEMO_MODE -extern void give_up(); -#endif -#ifdef DEMO_BUILD -extern int32 demo_key1, demo_key2; -#endif - -/* - * The next few provide support for multiple values. - */ -#ifdef COMMON -#define onevalue(r) (exit_count=1, (r)) -#define nvalues(r, n) (exit_count=(n), (r)) -#else -#define onevalue(r) (r) -#define nvalues(r, n) (r) -#endif - -#ifdef COMMON -#define eval(a, b) Ceval(a, b) -#define voideval(a, b) Ceval(a, b) -#else -/* - * I lift the top test from eval out to be in-line so that I can - * (rather often) avoid the overhead of a procedure call when return from - * it will be almost immediate. The effect is that in CSL mode Ceval is - * only ever called on a list. NB the first arg to eval gets evaluated - * several times here - maybe I will just hope that CSE optimisation picks - * up this sort of repetition... - */ -#define eval(a, b) \ - (is_cons(a) ? Ceval(a, b) : \ - is_symbol(a) ? (qvalue(a) == unset_var ? error(1, err_unset_var, a) : \ - onevalue(qvalue(a))) : \ - onevalue(a)) -/* voideval(a, b) is like (void)eval(a, b) */ -#define voideval(a, b) \ - if (is_cons(a)) Ceval(a, b) /* Beware "else" after this */ -#endif - -/* - * The function "equal" seems to be pretty critical (certainly for Standard - * Lisp mode and Reduce). So I write out the top-level part of it in-line - * and only call the (messy) function in cases where it might be worth-while. - * For Common Lisp I will presumably look at eql and cl_equal as well. - * The test here says: - * If a and b are EQ then they are EQUAL, - * else if a and b have different types they are not EQUAL - * else if a has type 1, 2, 3 or 4 (ie fixnum, odds, sfloat, symbol) - * then they are not EQUAL (those types need to be EQ to be EQUAL) - * otherwise call equal_fn(a, b) to decide the issue. - */ -#define equal(a, b) \ - ((a) == (b) || \ - (((((a) ^ (b)) & TAG_BITS) == 0) && \ - ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ - equal_fn(a, b))) - -#define cl_equal(a, b) \ - ((a) == (b) || \ - (((((a) ^ (b)) & TAG_BITS) == 0) && \ - ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ - cl_equal_fn(a, b))) - -#define eql(a, b) \ - ((a) == (b) || \ - (((((a) ^ (b)) & TAG_BITS) == 0) && \ - ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ - eql_fn(a, b))) - -/* - * Helpers for the bignum arithmetic code... - */ - -#ifndef IMULTIPLY -extern unsigned32 Imultiply(unsigned32 *rlow, unsigned32 a, - unsigned32 b, unsigned32 c); -#endif -#ifndef IDIVIDE -extern unsigned32 Idivide(unsigned32 *qp, unsigned32 a, - unsigned32 b, unsigned32 c); -extern unsigned32 Idiv10_9(unsigned32 *qp, unsigned32 a, unsigned32 b); -#endif - -/* - * UNSAFE removes some checks - but it does noy seem to make much difference - * so I rather strongly suggest that you do not enable it! - */ -#ifdef UNSAFE -# define argcheck(var, n, msg) (var) = (var); -#else -# define argcheck(var, n, msg) if ((var)!=(n)) return aerror(msg); -#endif - -extern n_args *zero_arg_functions[]; -extern one_args *one_arg_functions[]; -extern two_args *two_arg_functions[]; -extern n_args *three_arg_functions[]; -extern void *useful_functions[]; -extern char *address_of_var(int n); - -typedef struct setup_type -{ - char *name; - one_args *one; - two_args *two; - n_args *n; -} setup_type; - -extern setup_type const - arith06_setup[], arith08_setup[], arith10_setup[], arith12_setup[], - char_setup[], eval1_setup[], eval2_setup[], eval3_setup[], - funcs1_setup[], funcs2_setup[], funcs3_setup[], print_setup[], - read_setup[], mpi_setup[]; -extern setup_type const - u01_setup[], u02_setup[], u03_setup[], u04_setup[], - u05_setup[], u06_setup[], u07_setup[], u08_setup[], - u09_setup[], u10_setup[], u11_setup[], u12_setup[]; -#ifdef NAG -extern setup_type const nag_setup[], asp_setup[]; -extern setup_type const socket_setup[], xdr_setup[], grep_setup[]; -extern setup_type const gr_setup[], axfns_setup[]; -#endif - -extern char *find_image_directory(int argc, char *argv[]); -extern char program_name[64]; -extern Lisp_Object declare_fn(Lisp_Object args, Lisp_Object env); -extern Lisp_Object function_fn(Lisp_Object args, Lisp_Object env); -extern Lisp_Object let_fn_1(Lisp_Object bvl, Lisp_Object body, - Lisp_Object env, int compilerp); -extern Lisp_Object mv_call_fn(Lisp_Object args, Lisp_Object env); -extern Lisp_Object progn_fn(Lisp_Object args, Lisp_Object env); -extern Lisp_Object quote_fn(Lisp_Object args, Lisp_Object env); -extern Lisp_Object tagbody_fn(Lisp_Object args, Lisp_Object env); - -#ifdef __cplusplus -} -#endif - -/* - * Now declare entrypoints to machine-dependent code fragments... - */ - -#include "sys.h" - -#endif /* header_externs_h */ - -/* end of externs.h */ +/* externs.h Copyright (C) Codemist 1989-99 */ + +/* + * Main batch of extern declarations. Must have tags.h loaded first. + * + */ + +/* Signature: 7754c8eb 07-Mar-2000 */ + +#ifndef header_externs_h +#define header_externs_h 1 + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef USE_MPI +#include "mpi.h" +extern int32 mpi_rank,mpi_size; + +#ifdef MEMORY_TRACE +#define my_pop() (memory_reference((int32)stack), (*stack--)) +#else +#define my_pop() (*stack--) +#endif + +#endif /* USE_MPI */ + + +extern void **pages, + **heap_pages, **vheap_pages, + **bps_pages, **native_pages; +#ifndef NO_COPYING_GC +extern void **new_heap_pages, **new_vheap_pages, + **new_bps_pages, **new_native_pages; +#endif +extern int32 pages_count, + heap_pages_count, vheap_pages_count, + bps_pages_count, native_pages_count; +#ifndef NO_COPYING_GC +extern int32 new_heap_pages_count, new_vheap_pages_count, + new_bps_pages_count, new_native_pages_count; +#endif + +extern int native_pages_changed; +extern int32 native_fringe; + +extern Lisp_Object *nilsegment, *stacksegment; +extern Lisp_Object *stackbase; +extern int32 stack_segsize; /* measured in units of one CSL page */ +extern DLLexport Lisp_Object *C_stack; +#define stack C_stack + +#ifdef MEMORY_TRACE + +#define push(a) { *++stack = (a); memory_reference((int32)stack); } +/* push2 etc are just like push, but grouped together */ +#define push2(a,b) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); } +#define push3(a,b,c) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); } +#define push4(a,b,c,d) { *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); \ + *++stack = (d); memory_reference((int32)stack); } +#define push5(a,b,c,d,e){ *++stack = (a); memory_reference((int32)stack); *++stack = (b); memory_reference((int32)stack); *++stack = (c); memory_reference((int32)stack); \ + *++stack = (d); memory_reference((int32)stack); *++stack = (e); memory_reference((int32)stack); } +#define push6(a,b,c,d,e,f) {push3(a,b,c); push3(d,e,f)} + +#define pop(a) { memory_reference((int32)stack); (a) = *stack--; } +#define pop2(a,b) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; } +#define pop3(a,b,c) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; } +#define pop4(a,b,c,d) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; \ + memory_reference((int32)stack); (d) = *stack--; } +#define pop5(a,b,c,d,e) { memory_reference((int32)stack); (a) = *stack--; memory_reference((int32)stack); (b) = *stack--; memory_reference((int32)stack); (c) = *stack--; \ + memory_reference((int32)stack); (d) = *stack--; memory_reference((int32)stack); (e) = *stack--; } +#define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)} +#define popv(n) stack -= (n); + +#else /* MEMORY_TRACE */ + +#define push(a) { *++stack = (a); } +/* push2 etc are just like push, but grouped together */ +#ifdef USE_AUTOINDEX +/* + * Having inspected the code generated by one of the C compilers that + * is frequently used with this Lisp it emerges that the multiple + * push operations might sometimes be much better treated with + * the increment parts explicitly consolidated into one. To leave + * scope for fine-tuning to cmpiler and machine architecture the + * USE_AUTOINDEX macro could be pre-defined and I suspect that on + * VAX and ARM computers it may make good sense. + */ +#define push2(a,b) { *++stack = (a); *++stack = (b); } +#define push3(a,b,c) { *++stack = (a); *++stack = (b); *++stack = (c); } +#define push4(a,b,c,d) { *++stack = (a); *++stack = (b); *++stack = (c); \ + *++stack = (d); } +#define push5(a,b,c,d,e){ *++stack = (a); *++stack = (b); *++stack = (c); \ + *++stack = (d); *++stack = (e); } +#define push6(a,b,c,d,e,f) {push3(a,b,c); push3(d,e,f)} + +#define pop(a) { (a) = *stack--; } +#define pop2(a,b) { (a) = *stack--; (b) = *stack--; } +#define pop3(a,b,c) { (a) = *stack--; (b) = *stack--; (c) = *stack--; } +#define pop4(a,b,c,d) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \ + (d) = *stack--; } +#define pop5(a,b,c,d,e) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \ + (d) = *stack--; (e) = *stack--; } +#define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)} +#define popv(n) stack -= (n); +#else /* USE_AUTOINDEX */ +#define push2(a,b) { stack[1] = (a); stack[2] = (b); stack += 2; } +#define push3(a,b,c) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ + stack += 3; } +#define push4(a,b,c,d) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ + stack[4] = (d); stack += 4; } +#define push5(a,b,c,d,e){ stack[1] = (a); stack[2] = (b); stack[3] = (c); \ + stack[4] = (d); stack[5] = (e); stack += 5; } +#define push6(a,b,c,d,e,f) { \ + stack[1] = (a); stack[2] = (b); stack[3] = (c); \ + stack[4] = (d); stack[5] = (e); stack[6] = (f); \ + stack += 6; } + +#define pop(a) { (a) = *stack--; } +#define pop2(a,b) { stack -= 2; (a) = stack[2]; (b) = stack[1]; } +#define pop3(a,b,c) { stack -= 3; (a) = stack[3]; (b) = stack[2]; \ + (c) = stack[1]; } +#define pop4(a,b,c,d) { stack -= 4; (a) = stack[4]; (b) = stack[3]; \ + (c) = stack[2]; (d) = stack[1]; } +#define pop5(a,b,c,d,e) { stack -= 5; (a) = stack[5]; (b) = stack[4]; \ + (c) = stack[3]; (d) = stack[2]; (e) = stack[1]; } +#define pop6(a,b,c,d,e, f) { stack -= 6; \ + (a) = stack[6]; (b) = stack[5]; (c) = stack[4]; \ + (d) = stack[3]; (e) = stack[2]; (f) = stack[1]; } +#define popv(n) stack -= (n); +#endif /* USE_AUTOINDEX */ +#endif /* MEMORY_TRACE*/ + +#define errexit() { nil = C_nil; if (exception_pending()) return nil; } +#define errexitn(n) { nil = C_nil; \ + if (exception_pending()) { popv(n); return nil; } } +#define errexitv() { nil = C_nil; if (exception_pending()) return; } +#define errexitvn(n) { nil = C_nil; \ + if (exception_pending()) { popv(n); return; } } + +#define GC_USER_SOFT 0 +#define GC_USER_HARD 1 +#define GC_STACK 2 +#define GC_CONS 3 +#define GC_VEC 4 +#define GC_BPS 5 +#define GC_PRESERVE 6 +#define GC_NATIVE 7 + + +#ifdef CHECK_STACK + +#ifdef SOFTWARE_TICKS + +extern DLLexport int32 countdown; +#ifdef INITIAL_SOFTWARE_TICKS +extern DLLexport int32 software_ticks; +#endif +extern DLLexport int deal_with_tick(void); + +#define stackcheck0(k) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { reclaim(nil, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck1(k, a1) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { a1 = reclaim(a1, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck2(k, a1, a2) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push(a2); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck3(k, a1, a2, a3) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push2(a2, a3); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop2(a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck4(k, a1, a2, a3, a4) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push3(a2, a3, a4); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop3(a4, a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#else /* SOFTWARE_TICKS */ + +#define stackcheck0(k) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if (stack >= stacklimit) \ + { reclaim(nil, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck1(k, a1) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if (stack >= stacklimit) \ + { a1 = reclaim(a1, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck2(k, a1, a2) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if (stack >= stacklimit) \ + { push(a2); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck3(k, a1, a2, a3) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if (stack >= stacklimit) \ + { push2(a2, a3); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop2(a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck4(k, a1, a2, a3, a4) \ + if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \ + if (stack >= stacklimit) \ + { push3(a2, a3, a4); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop3(a4, a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#endif /* SOFTWARE_TICKS */ + +#else /* CHECK_STACK */ + +#ifdef SOFTWARE_TICKS + +extern DLLexport int32 countdown; +#ifdef INITIAL_SOFTWARE_TICKS +extern DLLexport int32 software_ticks; +#endif +extern DLLexport int deal_with_tick(void); + +#define stackcheck0(k) \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { reclaim(nil, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck1(k, a1) \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { a1 = reclaim(a1, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck2(k, a1, a2) \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push(a2); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck3(k, a1, a2, a3) \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push2(a2, a3); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop2(a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck4(k, a1, a2, a3, a4) \ + if ((--countdown < 0 && deal_with_tick()) || \ + stack >= stacklimit) \ + { push3(a2, a3, a4); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop3(a4, a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#else /* SOFTWARE_TICKS */ + +#define stackcheck0(k) \ + if (stack >= stacklimit) \ + { reclaim(nil, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck1(k, a1) \ + if (stack >= stacklimit) \ + { a1 = reclaim(a1, "stack", GC_STACK, 0); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck2(k, a1, a2) \ + if (stack >= stacklimit) \ + { push(a2); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck3(k, a1, a2, a3) \ + if (stack >= stacklimit) \ + { push2(a2, a3); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop2(a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#define stackcheck4(k, a1, a2, a3, a4) \ + if (stack >= stacklimit) \ + { push3(a2, a3, a4); \ + a1 = reclaim(a1, "stack", GC_STACK, 0); \ + pop3(a4, a3, a2); \ + nil = C_nil; \ + if (exception_pending()) { popv(k); return nil; } \ + } + +#endif /* SOFTWARE_TICKS */ +#endif /* CHECK_STACK */ + +/* + * As well as being used to point directly to the major Lisp item NIL, + * this register is used as a base for a table of other critically + * important other Lisp values. Offsets for at least some of these are + * defined here. + * I also need a proper C external variable holding the value of NIL since + * when called from the C library (e.g. in a signal handler) the global + * register variable will not be available! + */ + +extern DLLexport Lisp_Object C_nil; + +/* + * In COMMON mode the symbol-head for NIL uses the first few offsets + * from NIL here, so I start storing system variables at offset 12 so + * that even if at some stage I expand the size of all identifiers from the + * present state I will be safe. + */ + +#define first_nil_offset 50 /* GC collector marks from here up */ + +/* + * A vector of 50 words is used by the interpreter when preparing args + * for functions and when handling multiple values. + */ + +#define work_0_offset 200 + +/* Garbage collector marks up to but not including last_nil_offset */ +#define last_nil_offset 251 + +/* + * NIL_SEGMENT_SIZE must be over-large by enough to allow for + * space lost while rounding nil up to be a multiple of 8. Also in the + * Common Lisp case I need to give myself a spare word BEFORE the place + * where C_nil points. + */ +#define NIL_SEGMENT_SIZE (last_nil_offset*sizeof(Lisp_Object) + 32) + +/* + * I give myself a margin of SPARE bytes at the end of a page so that I can + * always CONS that amount (even without a garbage collection check) and not + * corrupt anything. The main use for this is that sometimes I need to + * convert a set of multiple values or of arguments from values on the + * (C-) stack or wherever va_arg() can find them into a list structure, and + * to avoid horrible potential problems with a garbage collection spotting] + * an exception (notably a ^C interrupt), running arbitrary code in an + * exception ghandler and then continuing, I need to cons those things up + * without any possible GC. The function cons_no_gc does that, and + * I should then call cons_gc_test() afterwards to regularise the situation. + * 512 bytes here leaves room for 64 conses, and I support at most 50 + * (multiple-) values so I hope this is safe. + */ + +#define SPARE 512 + +#ifdef NILSEG_EXTERNS +/* + * One some computers (ones with plenty of registers, and where the + * main addressing mode is register-indexed, and where optimising + * an compiler can keep variables in registers all the time, it will + * be most efficient to put major system variables addressed as offsets + * from NIL, where I expect to keep nil in a register variable pretty + * well always. On other machines (notable the Intel 80286) that policy + * gives pretty disasterous code, and the use of direct simple external + * variables will win. In PRESERVE and RESTORE I will have to copy + * all the separate external variables into a compact block for + * transfer to and from files. Actually on many (most?) machines the + * choice of whether this option should be enabled or not will be pretty + * marginal and should really be sorted out by building once with + * NILSEG_EXTERNS and once without, and comparing the performance of the + * two resulting systems. + */ + +#define nil_as_base + +extern unsigned32 byteflip; + +extern Lisp_Object codefringe; +extern Lisp_Object volatile codelimit; + +extern Lisp_Object * volatile stacklimit; + +extern Lisp_Object fringe; +extern Lisp_Object volatile heaplimit; + +extern Lisp_Object volatile vheaplimit; +extern Lisp_Object vfringe; + +extern int32 nwork; + +extern int32 exit_reason; +extern DLLexport int32 exit_count; +extern unsigned32 gensym_ser, print_precision, miscflags; +extern int32 current_modulus, fastget_size, package_bits; + +extern DLLexport Lisp_Object lisp_true, lambda, funarg, unset_var, opt_key, rest_key; +extern DLLexport Lisp_Object quote_symbol, function_symbol, comma_symbol; +extern DLLexport Lisp_Object comma_at_symbol, cons_symbol, eval_symbol; +extern DLLexport Lisp_Object work_symbol, evalhook, applyhook, macroexpand_hook; +extern DLLexport Lisp_Object append_symbol, exit_tag, exit_value, catch_tags; +extern DLLexport Lisp_Object current_package, startfn; +extern DLLexport Lisp_Object gensym_base, string_char_sym, boffo; +extern DLLexport Lisp_Object err_table; +extern DLLexport Lisp_Object progn_symbol; +extern DLLexport Lisp_Object lisp_work_stream, charvec, raise_symbol, lower_symbol; +extern DLLexport Lisp_Object echo_symbol, codevec, litvec, supervisor, B_reg; +extern DLLexport Lisp_Object savedef, comp_symbol, compiler_symbol, faslvec; +extern DLLexport Lisp_Object tracedfn, lisp_terminal_io; +extern DLLexport Lisp_Object lisp_standard_output, lisp_standard_input, lisp_error_output; +extern DLLexport Lisp_Object lisp_trace_output, lisp_debug_io, lisp_query_io; +extern DLLexport Lisp_Object prompt_thing, faslgensyms; +extern DLLexport Lisp_Object prinl_symbol, emsg_star, redef_msg; +extern DLLexport Lisp_Object expr_symbol, fexpr_symbol, macro_symbol; +extern DLLexport Lisp_Object cl_symbols, active_stream, current_module; +extern DLLexport Lisp_Object features_symbol, lisp_package; +extern DLLexport Lisp_Object sys_hash_table, help_index, cfunarg, lex_words; +extern DLLexport Lisp_Object get_counts, fastget_names, input_libraries; +extern DLLexport Lisp_Object output_library, current_file, break_function; +extern DLLexport Lisp_Object standard_output, standard_input, debug_io; +extern DLLexport Lisp_Object error_output, query_io, terminal_io; +extern DLLexport Lisp_Object trace_output, fasl_stream; + +#ifdef COMMON +extern DLLexport Lisp_Object keyword_package; +extern DLLexport Lisp_Object all_packages, package_symbol, internal_symbol; +extern DLLexport Lisp_Object external_symbol, inherited_symbol; +extern DLLexport Lisp_Object key_key, allow_other_keys, aux_key; +extern DLLexport Lisp_Object format_symbol; +extern DLLexport Lisp_Object expand_def_symbol, allow_key_key, declare_symbol; +extern DLLexport Lisp_Object special_symbol; +#endif +extern DLLexport Lisp_Object native_code, native_symbol, traceprint_symbol; +extern DLLexport Lisp_Object loadsource_symbol; +extern DLLexport Lisp_Object hankaku_symbol; + +extern Lisp_Object workbase[51]; + +extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2; +extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5; +extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8; +extern DLLexport Lisp_Object user_base_9; + +#define work_0 workbase[0] +#define work_1 workbase[1] +#define mv_1 workbase[1] +#define mv_2 workbase[2] +#define mv_3 workbase[3] +#define work_50 workbase[50] + +#else /* NILSEG_EXTERNS */ + +#define nil_as_base Lisp_Object nil = C_nil; + +#define byteflip (*(unsigned32 *)&((Lisp_Object *)nil)[12]) +#define codefringe ((Lisp_Object *)nil)[13] +#define codelimit ((Lisp_Object volatile *)nil)[14] +/* + * On a machine where sizeof(void *)=8 and alignment matters I need to arrange for + * stacklimit to be properly aligned. Also I MUST do the address calculation + * in a way that does not get muddled by the "sizeof(void *)" issue. I + * reserve nilseg offsets 15, 16 and 17 for this. + */ +#ifdef COMMON +#define stacklimit (*(Lisp_Object * volatile *) \ + &((Lisp_Object *)nil)[16]) +#else +#define stacklimit (*(Lisp_Object * volatile *) \ + &((Lisp_Object *)nil)[15]) +#endif +#define fringe ((Lisp_Object *)nil)[18] +#define heaplimit ((Lisp_Object volatile *)nil)[19] +#define vheaplimit ((Lisp_Object volatile *)nil)[20] +#define vfringe ((Lisp_Object *)nil)[21] +#define miscflags (*(unsigned32 *)&((Lisp_Object *)nil)[22]) + +#define nwork (*(int32 *)&((Lisp_Object *)nil)[24]) +#define exit_reason (*(int32 *)&((Lisp_Object *)nil)[25]) +#define exit_count (*(int32 *)&((Lisp_Object *)nil)[26]) +#define gensym_ser (*(unsigned32 *)&((Lisp_Object *)nil)[27]) +#define print_precision (*(unsigned32 *)&((Lisp_Object *)nil)[28]) +#define current_modulus (*(int32 *)&((Lisp_Object *)nil)[29]) +#define fastget_size (*(int32 *)&((Lisp_Object *)nil)[30]) +#define package_bits (*(int32 *)&((Lisp_Object *)nil)[31]) +/* offsets 32-49 spare at present */ + +/* Offset 50 used for EQ hash table list */ +/* Offset 51 used for EQUAL hash table list */ +#define current_package ((Lisp_Object *)nil)[52] +/* current_package is treated specially by the garbage collector */ + +#define B_reg ((Lisp_Object *)nil)[53] +#define codevec ((Lisp_Object *)nil)[54] +#define litvec ((Lisp_Object *)nil)[55] +#define exit_tag ((Lisp_Object *)nil)[56] +#define exit_value ((Lisp_Object *)nil)[57] +#define catch_tags ((Lisp_Object *)nil)[58] +#define lisp_package ((Lisp_Object *)nil)[59] +#define boffo ((Lisp_Object *)nil)[60] +#define charvec ((Lisp_Object *)nil)[61] +#define sys_hash_table ((Lisp_Object *)nil)[62] +#define help_index ((Lisp_Object *)nil)[63] +#define gensym_base ((Lisp_Object *)nil)[64] +#define err_table ((Lisp_Object *)nil)[65] +#define supervisor ((Lisp_Object *)nil)[66] +#define startfn ((Lisp_Object *)nil)[67] +#define faslvec ((Lisp_Object *)nil)[68] +#define tracedfn ((Lisp_Object *)nil)[69] +#define prompt_thing ((Lisp_Object *)nil)[70] +#define faslgensyms ((Lisp_Object *)nil)[71] +#define cl_symbols ((Lisp_Object *)nil)[72] +#define active_stream ((Lisp_Object *)nil)[73] +#define current_module ((Lisp_Object *)nil)[74] +/* + * 75-89 spare for workspace-style locations + */ +#define append_symbol ((Lisp_Object *)nil)[90] +#define applyhook ((Lisp_Object *)nil)[91] +#define cfunarg ((Lisp_Object *)nil)[92] +#define comma_at_symbol ((Lisp_Object *)nil)[93] +#define comma_symbol ((Lisp_Object *)nil)[94] +#define compiler_symbol ((Lisp_Object *)nil)[95] +#define comp_symbol ((Lisp_Object *)nil)[96] +#define cons_symbol ((Lisp_Object *)nil)[97] +#define echo_symbol ((Lisp_Object *)nil)[98] +#define emsg_star ((Lisp_Object *)nil)[99] +#define evalhook ((Lisp_Object *)nil)[100] +#define eval_symbol ((Lisp_Object *)nil)[101] +#define expr_symbol ((Lisp_Object *)nil)[102] +#define features_symbol ((Lisp_Object *)nil)[103] +#define fexpr_symbol ((Lisp_Object *)nil)[104] +#define funarg ((Lisp_Object *)nil)[105] +#define function_symbol ((Lisp_Object *)nil)[106] +#define lambda ((Lisp_Object *)nil)[107] +#define lisp_true ((Lisp_Object *)nil)[108] +#define lower_symbol ((Lisp_Object *)nil)[109] +#define macroexpand_hook ((Lisp_Object *)nil)[110] +#define macro_symbol ((Lisp_Object *)nil)[111] +#define opt_key ((Lisp_Object *)nil)[112] +#define prinl_symbol ((Lisp_Object *)nil)[113] +#define progn_symbol ((Lisp_Object *)nil)[114] +#define quote_symbol ((Lisp_Object *)nil)[115] +#define raise_symbol ((Lisp_Object *)nil)[116] +#define redef_msg ((Lisp_Object *)nil)[117] +#define rest_key ((Lisp_Object *)nil)[118] +#define savedef ((Lisp_Object *)nil)[119] +#define string_char_sym ((Lisp_Object *)nil)[120] +#define unset_var ((Lisp_Object *)nil)[121] +#define work_symbol ((Lisp_Object *)nil)[122] +#define lex_words ((Lisp_Object *)nil)[123] +#define get_counts ((Lisp_Object *)nil)[124] +#define fastget_names ((Lisp_Object *)nil)[125] +#define input_libraries ((Lisp_Object *)nil)[126] +#define output_library ((Lisp_Object *)nil)[127] +#define current_file ((Lisp_Object *)nil)[128] +#define break_function ((Lisp_Object *)nil)[129] + +#define lisp_work_stream ((Lisp_Object *)nil)[130] +#define lisp_standard_output ((Lisp_Object *)nil)[131] +#define lisp_standard_input ((Lisp_Object *)nil)[132] +#define lisp_debug_io ((Lisp_Object *)nil)[133] +#define lisp_error_output ((Lisp_Object *)nil)[134] +#define lisp_query_io ((Lisp_Object *)nil)[135] +#define lisp_terminal_io ((Lisp_Object *)nil)[136] +#define lisp_trace_output ((Lisp_Object *)nil)[137] +#define standard_output ((Lisp_Object *)nil)[138] +#define standard_input ((Lisp_Object *)nil)[139] +#define debug_io ((Lisp_Object *)nil)[140] +#define error_output ((Lisp_Object *)nil)[141] +#define query_io ((Lisp_Object *)nil)[142] +#define terminal_io ((Lisp_Object *)nil)[143] +#define trace_output ((Lisp_Object *)nil)[144] +#define fasl_stream ((Lisp_Object *)nil)[145] +#define native_code ((Lisp_Object *)nil)[146] +#define native_symbol ((Lisp_Object *)nil)[147] +#define traceprint_symbol ((Lisp_Object *)nil)[148] +#define loadsource_symbol ((Lisp_Object *)nil)[149] +#define hankaku_symbol ((Lisp_Object *)nil)[150] + +#ifdef COMMON +#define keyword_package ((Lisp_Object *)nil)[170] +#define all_packages ((Lisp_Object *)nil)[171] +#define package_symbol ((Lisp_Object *)nil)[172] +#define internal_symbol ((Lisp_Object *)nil)[173] +#define external_symbol ((Lisp_Object *)nil)[174] +#define inherited_symbol ((Lisp_Object *)nil)[175] +#define key_key ((Lisp_Object *)nil)[176] +#define allow_other_keys ((Lisp_Object *)nil)[177] +#define aux_key ((Lisp_Object *)nil)[178] +#define format_symbol ((Lisp_Object *)nil)[179] +#define expand_def_symbol ((Lisp_Object *)nil)[180] +#define allow_key_key ((Lisp_Object *)nil)[181] +#define declare_symbol ((Lisp_Object *)nil)[182] +#define special_symbol ((Lisp_Object *)nil)[183] +#endif + + + +/* + * The next are intended for use by people building custom versions + * of CSL. They are always handled as if NILSEG_EXTERNS had been set, + * even if it had not, since that gives the user direct access to them as + * simple C variables. Note that they must ALWAYS be kept with proper + * valid Lisp objects in them. + */ +/* #define user_base_0 ((Lisp_Object *)nil)[190] */ +/* #define user_base_1 ((Lisp_Object *)nil)[191] */ +/* #define user_base_2 ((Lisp_Object *)nil)[192] */ +/* #define user_base_3 ((Lisp_Object *)nil)[193] */ +/* #define user_base_4 ((Lisp_Object *)nil)[194] */ +/* #define user_base_5 ((Lisp_Object *)nil)[195] */ +/* #define user_base_6 ((Lisp_Object *)nil)[196] */ +/* #define user_base_7 ((Lisp_Object *)nil)[197] */ +/* #define user_base_8 ((Lisp_Object *)nil)[198] */ +/* #define user_base_9 ((Lisp_Object *)nil)[199] */ + +extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2; +extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5; +extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8; +extern DLLexport Lisp_Object user_base_9; + +#define work_0 ((Lisp_Object *)nil)[200] +#define work_1 ((Lisp_Object *)nil)[201] +#define mv_1 work_1 +#define mv_2 ((Lisp_Object *)nil)[202] +#define mv_3 ((Lisp_Object *)nil)[203] +#define work_50 ((Lisp_Object *)nil)[250] + +#endif /*NILSEG_EXTERNS */ + +/* dummy_function_call is only used to patch around C compiler bugs! */ +extern void MS_CDECL dummy_function_call(char *why, ...); + +extern void copy_into_nilseg(int fg); +extern void copy_out_of_nilseg(int fg); + +#define eq_hash_table_list ((Lisp_Object *)nil)[50] /* In heap image */ +#define equal_hash_table_list ((Lisp_Object *)nil)[51] /* In heap image */ +#define current_package_offset 52 + +extern void rehash_this_table(Lisp_Object v); +extern Lisp_Object eq_hash_tables, equal_hash_tables; + +/* + * The following are used to help processing. + */ +extern Lisp_Object volatile savecodelimit; +extern Lisp_Object * volatile savestacklimit; +extern Lisp_Object volatile saveheaplimit; +extern Lisp_Object volatile savevheaplimit; +extern char *exit_charvec; + +#ifdef DEBUG +extern int trace_all; +#endif + +extern int trace_depth; + +#define MAX_INPUT_FILES 40 /* limit on command-line length */ +#define MAX_SYMBOLS_TO_DEFINE 40 +#define MAX_FASL_PATHS 20 + +extern char *files_to_read[MAX_INPUT_FILES], + *symbols_to_define[MAX_SYMBOLS_TO_DEFINE], + *fasl_paths[MAX_FASL_PATHS]; +extern int fasl_output_file, output_directory; +extern FILE *binary_read_file; + +#ifndef COMMON +#ifdef CWIN +extern char **loadable_packages; +extern char **switches; +#endif +#endif + +#ifdef SOCKETS +extern int sockets_ready; +extern void flush_socket(); +#endif + +extern CSLbool undefine_this_one[MAX_SYMBOLS_TO_DEFINE]; + +extern int number_of_input_files, + number_of_symbols_to_define, + number_of_fasl_paths, + init_flags; + +extern int native_code_tag; + +extern char *standard_directory; + +extern CSLbool gc_method; +extern int32 gc_number; + +#define INIT_QUIET 1 +#define INIT_VERBOSE 2 +#define INIT_EXPANDABLE 4 + +#define Lispify_predicate(p) ((p) ? lisp_true : nil) + +/* + * variables used by the IO system. + */ + +extern int tty_count; +extern FILE *spool_file; +extern char spool_file_name[32]; + +typedef struct Ihandle +{ + FILE *f; /* File within which this sub-file lives */ + long int o; /* Offset (as returned by ftell) */ + long int n; /* Number of bytes remaining unread here */ + unsigned32 chk; /* Checksum */ + int status; /* Reading or Writing */ +} Ihandle; + +/* + * If there is no more than 100 bytes of data then I will deem + * file compression frivolous. The compression code assumes that + * it has at least 2 bytes to work on, so do NOT cut this limit down to zero. + * Indeed more than that the limit must be greater than the length of + * the initial header record (112 bytes). + */ + +extern int32 compression_worth_while; +#define CODESIZE 0x1000 + +typedef struct entry_point +{ + void *p; + char *s; +} entry_point; + +#ifdef CJAVA +#define entry_table_size 132 +#else +#define entry_table_size 127 +#endif +extern entry_point entries_table[]; + +extern int doubled_execution; + +#ifdef MEMORY_TRACE +extern int32 memory_base, memory_size; +extern unsigned char *memory_map; +extern FILE *memory_file; +extern void memory_comment(int n); +#endif + +#define ARG_CUT_OFF 25 +extern void push_args(va_list a, int nargs); +extern void push_args_1(va_list a, int nargs); + +extern void Iinit(void); +extern void IreInit(void); +extern void Icontext(Ihandle *); +extern void Irestore_context(Ihandle); +extern void Ilist(void); +extern CSLbool Iopen(char *name, int len, CSLbool dirn, char *expanded_name); +extern CSLbool Iopen_from_stdin(); +extern CSLbool IopenRoot(char *expanded_name, int hard); +extern CSLbool Iwriterootp(char *expanded); +extern CSLbool Iopen_help(int32 offset); +extern CSLbool Iopen_banner(int code); +extern CSLbool Imodulep(char *name, int len, char *datestamp, int32 *size, + char *expanded_name); +extern CSLbool Icopy(char *name, int len); +extern CSLbool Idelete(char *name, int len); +extern CSLbool IcloseInput(int check_checksum); +extern CSLbool IcloseOutput(); +extern CSLbool Ifinished(void); +extern int Igetc(void); +extern int32 Iread(void *buff, int32 size); +extern CSLbool Iputc(int ch); +extern CSLbool Iwrite(void *buff, int32 size); +extern long int Ioutsize(void); + +/* + * I will allow myself 192 bytes to store registration information. + * In my initial implementation I will only use a fraction of that + * but it seems safer to design the structure with extra room for potential + * enhancements. I will keep a version code in the data so that I can update + * my methods but still preserve upwards compatibility when I do that. + */ +#define REGISTRATION_SIZE 192 +#define REGISTRATION_VERSION "r1.0" +extern unsigned char registration_data[REGISTRATION_SIZE]; +extern void MD5_Init(); +extern void MD5_Update(unsigned char *data, int len); +extern void MD5_Final(unsigned char *md); +extern CSLbool MD5_busy; +extern unsigned char *MD5(unsigned char *data, int n, unsigned char *md); +extern void checksum(Lisp_Object a); +extern unsigned char unpredictable[256]; +extern void inject_randomness(int n); +/* + * crypt_init() seeds the encryption engine that I used, and then + * crypt_get_block() gets a chunk of the sequence, which I can XOR with + * text to mess it up. + */ +extern void crypt_init(char *key); +#define CRYPT_BLOCK 128 +extern void crypt_get_block(unsigned char result[CRYPT_BLOCK]); +/* + * crypt_active is -ve if none is in use, otherwise it is a key identifier + * (to allow for possibly multiple keys). crypt_buffer & crypt_count are + * things filled in by crypt_get_block(). The encryption stuff here is just + * for protection of the software, and the code that does somewhat more + * serious encryption to create the keys used with this stream cipher live + * elsewhere. The crypto technology in CSL is only used on image files, ie + * chunks of compiled code etc, and no provision has been made to use it + * on user data-files. I can store up to CRYPT_KEYS different keys with + * a CSL system and have different modules protected by different ones of + * them. + */ +#define CRYPT_KEYS 10 +extern char *crypt_keys[CRYPT_KEYS]; +extern int crypt_active; +extern unsigned char *crypt_buffer; +extern int crypt_count; + +extern void ensure_screen(void); +extern int window_heading; +#ifndef WINDOW_SYSTEM +#ifdef BUFFERED_STDOUT +extern clock_t last_flush; +#endif +#define start_up_window_manager(a) {} +#endif +extern void my_exit(int n); +extern void *my_malloc(size_t n); + +extern clock_t base_time; +extern double *clock_stack; +extern void push_clock(void); +extern double pop_clock(void); +extern double consolidated_time[10], gc_time; +extern CSLbool volatile already_in_gc, tick_on_gc_exit; +extern CSLbool volatile interrupt_pending, tick_pending, polltick_pending; +extern int current_fp_rep; +#ifndef __cplusplus +extern jmp_buf *errorset_buffer; +#endif +extern char *errorset_msg; +extern int errorset_code; +extern void unwind_stack(Lisp_Object *, CSLbool findcatch); +extern CSLbool segvtrap; +extern CSLbool batch_flag; +extern int escaped_printing; +#ifdef __WATCOMC__ +extern void low_level_signal_handler(int code); +#else +extern void MS_CDECL low_level_signal_handler(int code); +#endif +extern void MS_CDECL sigint_handler(int code); +#ifdef CHECK_STACK +extern int check_stack(char *file, int line); +#endif + +#ifdef RECORD_GET +extern void record_get(Lisp_Object tag, CSLbool found); +#endif + +/* + * Functions used internally - not to be installed in Lisp function + * cells, but some of these may end up getting called using special + * non-standard conventions when the Lisp compiler has been at work. + */ + +extern void adjust_all(); +extern void set_up_functions(CSLbool restartp); +extern void get_user_files_checksum(unsigned char *); +extern DLLexport Lisp_Object acons(Lisp_Object a, Lisp_Object b, Lisp_Object c); +extern DLLexport Lisp_Object ash(Lisp_Object a, Lisp_Object b); +extern Lisp_Object bytestream_interpret(Lisp_Object code, Lisp_Object lit, + Lisp_Object *entry_stack); +extern CSLbool complex_stringp(Lisp_Object a); +extern void freshline_trace(); +extern void freshline_debug(); +extern DLLexport Lisp_Object cons(Lisp_Object a, Lisp_Object b); +extern Lisp_Object cons_no_gc(Lisp_Object a, Lisp_Object b); +extern Lisp_Object cons_gc_test(Lisp_Object a); +extern void convert_fp_rep(void *p, int old_rep, int new_rep, int type); +extern DLLexport Lisp_Object Ceval(Lisp_Object u, Lisp_Object env); +extern unsigned32 Crand(void); +extern DLLexport Lisp_Object Cremainder(Lisp_Object a, Lisp_Object b); +extern void Csrand(unsigned32 a, unsigned32 b); +extern void discard(Lisp_Object a); +extern DLLexport CSLbool eql_fn(Lisp_Object a, Lisp_Object b); +extern DLLexport CSLbool cl_equal_fn(Lisp_Object a, Lisp_Object b); +extern DLLexport CSLbool equal_fn(Lisp_Object a, Lisp_Object b); +#ifdef TRACED_EQUAL +extern DLLexport CSLbool traced_equal_fn(Lisp_Object a, Lisp_Object b, + char *, int, int); +#define equal_fn(a, b) traced_equal_fn(a, b, __FILE__, __LINE__, 0) +extern void dump_equals(); +#endif +extern DLLexport CSLbool equalp(Lisp_Object a, Lisp_Object b); +extern DLLexport Lisp_Object apply(Lisp_Object fn, int nargs, + Lisp_Object env, Lisp_Object fname); +extern DLLexport Lisp_Object apply_lambda(Lisp_Object def, int nargs, + Lisp_Object env, Lisp_Object name); +extern void deallocate_pages(void); +extern void drop_heap_segments(void); +extern DLLexport Lisp_Object gcd(Lisp_Object a, Lisp_Object b); +extern Lisp_Object get_pname(Lisp_Object a); +#ifdef COMMON +extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b, Lisp_Object c); +#else +extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b); +#endif +extern Lisp_Object getvector(int tag, int32 type, int32 length); +extern Lisp_Object getvector_init(int32 n, Lisp_Object v); +extern Lisp_Object getcodevector(int32 type, int32 size); +extern unsigned32 hash_lisp_string(Lisp_Object s); +extern void lose_C_def(Lisp_Object a); +extern DLLexport CSLbool geq2(Lisp_Object a, Lisp_Object b); +extern DLLexport CSLbool greaterp2(Lisp_Object a, Lisp_Object b); +extern DLLexport CSLbool lesseq2(Lisp_Object a, Lisp_Object b); +extern DLLexport CSLbool lessp2(Lisp_Object a, Lisp_Object b); +extern DLLexport Lisp_Object list2(Lisp_Object a, Lisp_Object b); +extern DLLexport Lisp_Object list2star(Lisp_Object a, Lisp_Object b, Lisp_Object c); +extern DLLexport Lisp_Object list3(Lisp_Object a, Lisp_Object b, Lisp_Object c); +extern DLLexport Lisp_Object lognot(Lisp_Object a); +extern DLLexport Lisp_Object macroexpand(Lisp_Object form, Lisp_Object env); +extern Lisp_Object make_one_word_bignum(int32 n); +extern Lisp_Object make_package(Lisp_Object name); +extern Lisp_Object make_string(char *b); +extern Lisp_Object make_nstring(char *b, int32 n); +extern Lisp_Object make_undefined_symbol(char const *s); +extern Lisp_Object make_symbol(char const *s, int restartp, + one_args *f1, two_args *f2, n_args *fn); +extern DLLexport void MS_CDECL stdout_printf(char *fmt, ...); +extern DLLexport void MS_CDECL term_printf(char *fmt, ...); +extern DLLexport void MS_CDECL err_printf(char *fmt, ...); +extern DLLexport void MS_CDECL debug_printf(char *fmt, ...); +extern DLLexport void MS_CDECL trace_printf(char *fmt, ...); +extern char *my_getenv(char *name); +extern DLLexport Lisp_Object ncons(Lisp_Object a); +extern DLLexport Lisp_Object ndelete(Lisp_Object a, Lisp_Object b); +extern DLLexport Lisp_Object negate(Lisp_Object a); +extern DLLexport Lisp_Object nreverse(Lisp_Object a); +extern FILE *open_file(char *filename, char *original_name, + size_t n, char *dirn, FILE *old_file); +extern DLLexport Lisp_Object plus2(Lisp_Object a, Lisp_Object b); +extern void preserve(char *msg); +extern void preserve_native_code(); +extern void relocate_native_function(unsigned char *bps); +extern Lisp_Object prin(Lisp_Object u); +extern char *get_string_data(Lisp_Object a, char *why, int32 *len); +extern DLLexport void prin_to_stdout(Lisp_Object u); +extern DLLexport void prin_to_terminal(Lisp_Object u); +extern DLLexport void prin_to_debug(Lisp_Object u); +extern DLLexport void prin_to_query(Lisp_Object u); +extern DLLexport void prin_to_trace(Lisp_Object u); +extern DLLexport void prin_to_error(Lisp_Object u); +extern DLLexport void loop_print_stdout(Lisp_Object o); +extern DLLexport void loop_print_terminal(Lisp_Object o); +extern DLLexport void loop_print_debug(Lisp_Object o); +extern DLLexport void loop_print_query(Lisp_Object o); +extern DLLexport void loop_print_trace(Lisp_Object o); +extern DLLexport void loop_print_error(Lisp_Object o); +extern void internal_prin(Lisp_Object u, int prefix); +extern DLLexport Lisp_Object princ(Lisp_Object u); +extern DLLexport Lisp_Object print(Lisp_Object u); +extern DLLexport Lisp_Object printc(Lisp_Object u); +extern void print_bignum(Lisp_Object u, CSLbool blankp, int nobreak); +extern void print_bighexoctbin(Lisp_Object u, + int radix, int width, CSLbool blankp, int nobreak); +extern DLLexport Lisp_Object putprop(Lisp_Object a, Lisp_Object b, + Lisp_Object c); +extern DLLexport Lisp_Object quot2(Lisp_Object a, Lisp_Object b); +extern DLLexport Lisp_Object rational(Lisp_Object a); +extern void read_eval_print(int noisy); +extern DLLexport Lisp_Object reclaim(Lisp_Object value_to_return, char *why, + int stg_class, int32 size); +extern CSLbool do_not_kill_native_code; +extern void set_fns(Lisp_Object sym, one_args *f1, + two_args *f2, n_args *fn); +extern void setup(int restartp, double storesize); +extern Lisp_Object simplify_string(Lisp_Object s); +extern CSLbool stringp(Lisp_Object a); +extern DLLexport Lisp_Object times2(Lisp_Object a, Lisp_Object b); +extern int32 thirty_two_bits(Lisp_Object a); + +#ifdef DEMO_MODE +extern void give_up(); +#endif +#ifdef DEMO_BUILD +extern int32 demo_key1, demo_key2; +#endif + +/* + * The next few provide support for multiple values. + */ +#ifdef COMMON +#define onevalue(r) (exit_count=1, (r)) +#define nvalues(r, n) (exit_count=(n), (r)) +#else +#define onevalue(r) (r) +#define nvalues(r, n) (r) +#endif + +#ifdef COMMON +#define eval(a, b) Ceval(a, b) +#define voideval(a, b) Ceval(a, b) +#else +/* + * I lift the top test from eval out to be in-line so that I can + * (rather often) avoid the overhead of a procedure call when return from + * it will be almost immediate. The effect is that in CSL mode Ceval is + * only ever called on a list. NB the first arg to eval gets evaluated + * several times here - maybe I will just hope that CSE optimisation picks + * up this sort of repetition... + */ +#define eval(a, b) \ + (is_cons(a) ? Ceval(a, b) : \ + is_symbol(a) ? (qvalue(a) == unset_var ? error(1, err_unset_var, a) : \ + onevalue(qvalue(a))) : \ + onevalue(a)) +/* voideval(a, b) is like (void)eval(a, b) */ +#define voideval(a, b) \ + if (is_cons(a)) Ceval(a, b) /* Beware "else" after this */ +#endif + +/* + * The function "equal" seems to be pretty critical (certainly for Standard + * Lisp mode and Reduce). So I write out the top-level part of it in-line + * and only call the (messy) function in cases where it might be worth-while. + * For Common Lisp I will presumably look at eql and cl_equal as well. + * The test here says: + * If a and b are EQ then they are EQUAL, + * else if a and b have different types they are not EQUAL + * else if a has type 1, 2, 3 or 4 (ie fixnum, odds, sfloat, symbol) + * then they are not EQUAL (those types need to be EQ to be EQUAL) + * otherwise call equal_fn(a, b) to decide the issue. + */ +#define equal(a, b) \ + ((a) == (b) || \ + (((((a) ^ (b)) & TAG_BITS) == 0) && \ + ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ + equal_fn(a, b))) + +#define cl_equal(a, b) \ + ((a) == (b) || \ + (((((a) ^ (b)) & TAG_BITS) == 0) && \ + ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ + cl_equal_fn(a, b))) + +#define eql(a, b) \ + ((a) == (b) || \ + (((((a) ^ (b)) & TAG_BITS) == 0) && \ + ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ + eql_fn(a, b))) + +/* + * Helpers for the bignum arithmetic code... + */ + +#ifndef IMULTIPLY +extern unsigned32 Imultiply(unsigned32 *rlow, unsigned32 a, + unsigned32 b, unsigned32 c); +#endif +#ifndef IDIVIDE +extern unsigned32 Idivide(unsigned32 *qp, unsigned32 a, + unsigned32 b, unsigned32 c); +extern unsigned32 Idiv10_9(unsigned32 *qp, unsigned32 a, unsigned32 b); +#endif + +/* + * UNSAFE removes some checks - but it does noy seem to make much difference + * so I rather strongly suggest that you do not enable it! + */ +#ifdef UNSAFE +# define argcheck(var, n, msg) (var) = (var); +#else +# define argcheck(var, n, msg) if ((var)!=(n)) return aerror(msg); +#endif + +extern n_args *zero_arg_functions[]; +extern one_args *one_arg_functions[]; +extern two_args *two_arg_functions[]; +extern n_args *three_arg_functions[]; +extern void *useful_functions[]; +extern char *address_of_var(int n); + +typedef struct setup_type +{ + char *name; + one_args *one; + two_args *two; + n_args *n; +} setup_type; + +extern setup_type const + arith06_setup[], arith08_setup[], arith10_setup[], arith12_setup[], + char_setup[], eval1_setup[], eval2_setup[], eval3_setup[], + funcs1_setup[], funcs2_setup[], funcs3_setup[], print_setup[], + read_setup[], mpi_setup[]; +extern setup_type const + u01_setup[], u02_setup[], u03_setup[], u04_setup[], + u05_setup[], u06_setup[], u07_setup[], u08_setup[], + u09_setup[], u10_setup[], u11_setup[], u12_setup[]; +#ifdef NAG +extern setup_type const nag_setup[], asp_setup[]; +extern setup_type const socket_setup[], xdr_setup[], grep_setup[]; +extern setup_type const gr_setup[], axfns_setup[]; +#endif + +extern char *find_image_directory(int argc, char *argv[]); +extern char program_name[64]; +extern Lisp_Object declare_fn(Lisp_Object args, Lisp_Object env); +extern Lisp_Object function_fn(Lisp_Object args, Lisp_Object env); +extern Lisp_Object let_fn_1(Lisp_Object bvl, Lisp_Object body, + Lisp_Object env, int compilerp); +extern Lisp_Object mv_call_fn(Lisp_Object args, Lisp_Object env); +extern Lisp_Object progn_fn(Lisp_Object args, Lisp_Object env); +extern Lisp_Object quote_fn(Lisp_Object args, Lisp_Object env); +extern Lisp_Object tagbody_fn(Lisp_Object args, Lisp_Object env); + +#ifdef __cplusplus +} +#endif + +/* + * Now declare entrypoints to machine-dependent code fragments... + */ + +#include "sys.h" + +#endif /* header_externs_h */ + +/* end of externs.h */