1 /* externs.h Copyright (C) Codemist 1989-2010 */ 2 3 /* 4 * Main batch of extern declarations. 5 * 6 */ 7 8 9 10 /************************************************************************** 11 * Copyright (C) 2010, Codemist Ltd. A C Norman * 12 * * 13 * Redistribution and use in source and binary forms, with or without * 14 * modification, are permitted provided that the following conditions are * 15 * met: * 16 * * 17 * * Redistributions of source code must retain the relevant * 18 * copyright notice, this list of conditions and the following * 19 * disclaimer. * 20 * * Redistributions in binary form must reproduce the above * 21 * copyright notice, this list of conditions and the following * 22 * disclaimer in the documentation and/or other materials provided * 23 * with the distribution. * 24 * * 25 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS * 26 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT * 27 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS * 28 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE * 29 * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, * 30 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, * 31 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS * 32 * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * 33 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR * 34 * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF * 35 * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * 36 * DAMAGE. * 37 *************************************************************************/ 38 39 40 41 /* Signature: 1d605e16 20-Aug-2010 */ 42 43 #ifndef header_externs_h 44 #define header_externs_h 1 45 46 #ifdef __cplusplus 47 extern "C" { 48 #endif 49 50 #ifdef USE_MPI 51 #include "mpi.h" 52 extern int32_t mpi_rank,mpi_size; 53 #endif 54 55 /* 56 * I have a bunch of macros that I use for desparation-mode debugging, 57 * and in particular when I have bugs that wriggle back into their lairs 58 * when I try running under "gdb" or whatever. These print dull messages 59 * to stderr. The "do..while" idiom is to keep C syntax safe with regard to 60 * semicolons. 61 */ 62 63 #define D do { \ 64 char *fffff = strrchr(__FILE__, '/'); \ 65 if (fffff == NULL) fffff = strrchr(__FILE__, '\\'); \ 66 if (fffff == NULL) fffff = __FILE__; else fffff++; \ 67 fprintf(stderr, "Line %d File %s\n", __LINE__, fffff); \ 68 fflush(stderr); \ 69 } while (0) 70 71 #define DS(s) do { \ 72 char *fffff = strrchr(__FILE__, '/'); \ 73 if (fffff == NULL) fffff = strrchr(__FILE__, '\\'); \ 74 if (fffff == NULL) fffff = __FILE__; else fffff++; \ 75 fprintf(stderr, "Line %d File %s: %s\n", __LINE__, fffff, (s)); \ 76 fflush(stderr); \ 77 } while (0) 78 79 #define DX(s) do { \ 80 char *fffff = strrchr(__FILE__, '/'); \ 81 if (fffff == NULL) fffff = strrchr(__FILE__, '\\'); \ 82 if (fffff == NULL) fffff = __FILE__; else fffff++; \ 83 fprintf(stderr, "Line %d File %s: %llx\n", __LINE__, fffff, \ 84 (long long unsigned)(s)); \ 85 fflush(stderr); \ 86 } while (0) 87 88 extern void **pages, 89 **heap_pages, **vheap_pages, 90 **bps_pages, **native_pages; 91 92 extern void **new_heap_pages, **new_vheap_pages, 93 **new_bps_pages, **new_native_pages; 94 95 #ifdef CONSERVATIVE 96 97 #define PAGE_TYPE_CONS 0 98 #define PAGE_TYPE_VECTOR 1 99 #define PAGE_TYPE_BPS 2 100 #define PAGE_TYPE_NATIVE 3 101 102 typedef struct page_map_t 103 { 104 void *start; 105 void *end; 106 int type; 107 } page_map_t; 108 109 #endif 110 111 extern int32_t pages_count, 112 heap_pages_count, vheap_pages_count, 113 bps_pages_count, native_pages_count; 114 115 extern int32_t new_heap_pages_count, new_vheap_pages_count, 116 new_bps_pages_count, new_native_pages_count; 117 118 extern int32_t native_pages_changed; 119 extern int32_t native_fringe; 120 121 extern Lisp_Object *nilsegment, *stacksegment; 122 extern Lisp_Object *stackbase; 123 extern int32_t stack_segsize; /* measured in units of one CSL page */ 124 extern Lisp_Object *C_stack; 125 #define stack C_stack 126 127 extern char *big_chunk_start, *big_chunk_end; 128 129 #ifdef CONSERVATIVE 130 extern Lisp_Object *C_stackbase, *C_stacktop; 131 #endif 132 133 #ifdef MEMORY_TRACE 134 135 #define push(a) do { \ 136 *++stack = (a); \ 137 memory_reference((intptr_t)stack); } while (0) 138 /* push2 etc are just like push, but grouped together */ 139 #define push2(a,b) do { \ 140 *++stack = (a); \ 141 memory_reference((intptr_t)stack); \ 142 *++stack = (b); \ 143 memory_reference((intptr_t)stack); } while (0) 144 #define push3(a,b,c) do { \ 145 *++stack = (a); \ 146 memory_reference((intptr_t)stack); \ 147 *++stack = (b); \ 148 memory_reference((intptr_t)stack); \ 149 *++stack = (c); \ 150 memory_reference((intptr_t)stack); } while (0) 151 #define push4(a,b,c,d) do { \ 152 *++stack = (a); \ 153 memory_reference((intptr_t)stack); \ 154 *++stack = (b); \ 155 memory_reference((intptr_t)stack); \ 156 *++stack = (c); \ 157 memory_reference((intptr_t)stack); \ 158 *++stack = (d); \ 159 memory_reference((intptr_t)stack); } while (0) 160 #define push5(a,b,c,d,e)do { \ 161 *++stack = (a); \ 162 memory_reference((intptr_t)stack); \ 163 *++stack = (b); \ 164 memory_reference((intptr_t)stack); \ 165 *++stack = (c); \ 166 memory_reference((intptr_t)stack); \ 167 *++stack = (d); \ 168 memory_reference((intptr_t)stack); \ 169 *++stack = (e); \ 170 memory_reference((intptr_t)stack); } while (0) 171 #define push6(a,b,c,d,e,f) do {push3(a,b,c); push3(d,e,f); } while (0) 172 173 #define my_pop() (memory_reference((int32_t)stack), (*stack--)) 174 #define pop(a) { memory_reference((intptr_t)stack); (a) = *stack--; } 175 #define pop2(a,b) { memory_reference((intptr_t)stack); (a) = *stack--; memory_reference((intptr_t)stack); (b) = *stack--; } 176 #define pop3(a,b,c) { memory_reference((intptr_t)stack); (a) = *stack--; memory_reference((intptr_t)stack); (b) = *stack--; memory_reference((intptr_t)stack); (c) = *stack--; } 177 #define pop4(a,b,c,d) { memory_reference((intptr_t)stack); (a) = *stack--; memory_reference((intptr_t)stack); (b) = *stack--; memory_reference((intptr_t)stack); (c) = *stack--; \ 178 memory_reference((intptr_t)stack); (d) = *stack--; } 179 #define pop5(a,b,c,d,e) { memory_reference((intptr_t)stack); (a) = *stack--; memory_reference((intptr_t)stack); (b) = *stack--; memory_reference((intptr_t)stack); (c) = *stack--; \ 180 memory_reference((intptr_t)stack); (d) = *stack--; memory_reference((intptr_t)stack); (e) = *stack--; } 181 #define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)} 182 #define popv(n) stack -= (n) 183 184 #else /* MEMORY_TRACE */ 185 186 #define push(a) { *++stack = (a); } 187 /* push2 etc are just like push, but grouped together */ 188 #define push2(a,b) { stack[1] = (a); stack[2] = (b); stack += 2; } 189 #define push3(a,b,c) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ 190 stack += 3; } 191 #define push4(a,b,c,d) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \ 192 stack[4] = (d); stack += 4; } 193 #define push5(a,b,c,d,e){ stack[1] = (a); stack[2] = (b); stack[3] = (c); \ 194 stack[4] = (d); stack[5] = (e); stack += 5; } 195 #define push6(a,b,c,d,e,f) { \ 196 stack[1] = (a); stack[2] = (b); stack[3] = (c); \ 197 stack[4] = (d); stack[5] = (e); stack[6] = (f); \ 198 stack += 6; } 199 200 #define pop(a) { (a) = *stack--; } 201 #define pop2(a,b) { stack -= 2; (a) = stack[2]; (b) = stack[1]; } 202 #define pop3(a,b,c) { stack -= 3; (a) = stack[3]; (b) = stack[2]; \ 203 (c) = stack[1]; } 204 #define pop4(a,b,c,d) { stack -= 4; (a) = stack[4]; (b) = stack[3]; \ 205 (c) = stack[2]; (d) = stack[1]; } 206 #define pop5(a,b,c,d,e) { stack -= 5; (a) = stack[5]; (b) = stack[4]; \ 207 (c) = stack[3]; (d) = stack[2]; (e) = stack[1]; } 208 #define pop6(a,b,c,d,e, f) { stack -= 6; \ 209 (a) = stack[6]; (b) = stack[5]; (c) = stack[4]; \ 210 (d) = stack[3]; (e) = stack[2]; (f) = stack[1]; } 211 #define popv(n) stack -= (n) 212 #endif /* MEMORY_TRACE*/ 213 214 #define errexit() { nil = C_nil; if (exception_pending()) return nil; } 215 #define errexitn(n) { nil = C_nil; \ 216 if (exception_pending()) { popv(n); return nil; } } 217 #define errexitv() { nil = C_nil; if (exception_pending()) return; } 218 #define errexitvn(n) { nil = C_nil; \ 219 if (exception_pending()) { popv(n); return; } } 220 221 #define GC_USER_SOFT 0 222 #define GC_USER_HARD 1 223 #define GC_STACK 2 224 #define GC_CONS 3 225 #define GC_VEC 4 226 #define GC_BPS 5 227 #define GC_PRESERVE 6 228 #define GC_NATIVE 7 229 230 231 #ifdef CHECK_STACK 232 extern int check_stack(char *file, int line); 233 #define if_check_stack \ 234 if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); 235 #else 236 #define if_check_stack 237 #endif 238 239 extern int32_t software_ticks, countdown; 240 241 #define stackcheck0(k) \ 242 if_check_stack \ 243 if ((--countdown < 0 && deal_with_tick()) || \ 244 stack >= stacklimit) \ 245 { reclaim(nil, "stack", GC_STACK, 0); \ 246 nil = C_nil; \ 247 if (exception_pending()) { popv(k); return nil; } \ 248 } 249 250 #define stackcheck1(k, a1) \ 251 if_check_stack \ 252 if ((--countdown < 0 && deal_with_tick()) || \ 253 stack >= stacklimit) \ 254 { a1 = reclaim(a1, "stack", GC_STACK, 0); \ 255 nil = C_nil; \ 256 if (exception_pending()) { popv(k); return nil; } \ 257 } 258 259 #define stackcheck2(k, a1, a2) \ 260 if_check_stack \ 261 if ((--countdown < 0 && deal_with_tick()) || \ 262 stack >= stacklimit) \ 263 { push(a2); \ 264 a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \ 265 nil = C_nil; \ 266 if (exception_pending()) { popv(k); return nil; } \ 267 } 268 269 #define stackcheck3(k, a1, a2, a3) \ 270 if_check_stack \ 271 if ((--countdown < 0 && deal_with_tick()) || \ 272 stack >= stacklimit) \ 273 { push2(a2, a3); \ 274 a1 = reclaim(a1, "stack", GC_STACK, 0); \ 275 pop2(a3, a2); \ 276 nil = C_nil; \ 277 if (exception_pending()) { popv(k); return nil; } \ 278 } 279 280 #define stackcheck4(k, a1, a2, a3, a4) \ 281 if_check_stack \ 282 if ((--countdown < 0 && deal_with_tick()) || \ 283 stack >= stacklimit) \ 284 { push3(a2, a3, a4); \ 285 a1 = reclaim(a1, "stack", GC_STACK, 0); \ 286 pop3(a4, a3, a2); \ 287 nil = C_nil; \ 288 if (exception_pending()) { popv(k); return nil; } \ 289 } 290 291 /* 292 * As well as being used to point directly to the major Lisp item NIL, 293 * this register is used as a base for a table of other critically 294 * important other Lisp values. Offsets for at least some of these are 295 * defined here. 296 * I also need a proper C external variable holding the value of NIL since 297 * when called from the C library (e.g. in a signal handler) the global 298 * register variable will not be available! 299 */ 300 301 extern Lisp_Object C_nil; 302 303 /* 304 * In COMMON mode the symbol-head for NIL uses the first few offsets 305 * from NIL here, so I start storing system variables at offset 12 so 306 * that even if at some stage I expand the size of all identifiers from the 307 * present state I will be safe. 308 */ 309 310 #define first_nil_offset 50 /* GC collector marks from here up */ 311 312 /* 313 * A vector of 50 words is used by the interpreter when preparing args 314 * for functions and when handling multiple values. 315 */ 316 317 #define work_0_offset 200 318 319 /* Garbage collector marks up to but not including last_nil_offset */ 320 #define last_nil_offset 251 321 322 /* 323 * NIL_SEGMENT_SIZE must be over-large by enough to allow for 324 * space lost while rounding nil up to be a multiple of 8. Also in the 325 * Common Lisp case I need to give myself a spare word BEFORE the place 326 * where C_nil points. 327 */ 328 #define NIL_SEGMENT_SIZE (last_nil_offset*sizeof(Lisp_Object) + 32) 329 330 /* 331 * I give myself a margin of SPARE bytes at the end of a page so that I can 332 * always CONS that amount (even without a garbage collection check) and not 333 * corrupt anything. The main use for this is that sometimes I need to 334 * convert a set of multiple values or of arguments from values on the 335 * (C-) stack or wherever va_arg() can find them into a list structure, and 336 * to avoid horrible potential problems with a garbage collection spotting] 337 * an exception (notably a ^C interrupt), running arbitrary code in an 338 * exception ghandler and then continuing, I need to cons those things up 339 * without any possible GC. The function cons_no_gc does that, and 340 * I should then call cons_gc_test() afterwards to regularise the situation. 341 * 512 bytes here leaves room for 64 conses, and I support at most 50 342 * (multiple-) values so I hope this is safe. 343 */ 344 345 #define SPARE 512 346 347 /* 348 * I want my table of addresses here to be 8-byte aligned on 64-bit 349 * machines... 350 */ 351 352 /* 353 * !COMMON COMMON 354 * 32-bit nil nil 355 * 64-bit nil+4 nil 356 */ 357 358 #ifdef COMMON 359 #define BASE ((Lisp_Object *)nil) 360 #else 361 #define BASE (SIXTY_FOUR_BIT ? ((Lisp_Object *)(nil+4)): ((Lisp_Object *)nil)) 362 #endif 363 364 #ifdef NILSEG_EXTERNS 365 /* 366 * One some computers (ones with plenty of registers, and where the 367 * main addressing mode is register-indexed, and where optimising 368 * an compiler can keep variables in registers all the time, it will 369 * be most efficient to put major system variables addressed as offsets 370 * from NIL, where I expect to keep nil in a register variable pretty 371 * well always. On other machines (notable the Intel 80286) that policy 372 * gives pretty disasterous code, and the use of direct simple external 373 * variables will win. In PRESERVE and RESTORE I will have to copy 374 * all the separate external variables into a compact block for 375 * transfer to and from files. Actually on many (most?) machines the 376 * choice of whether this option should be enabled or not will be pretty 377 * marginal and should really be sorted out by building once with 378 * NILSEG_EXTERNS and once without, and comparing the performance of the 379 * two resulting systems. Since I believe the performance effects will 380 * be small and I expect use of a debugger to be easier if all the key 381 * variables are available as external symbols that is what I will make 382 * my default right now. I can imagine that if at some stage I move to 383 * more creation of native code that the references relative to NIL provide 384 * easier code to generate and less effort needing to relocate it, so I may 385 * then switch back. 386 */ 387 388 #define nil_as_base 389 390 extern intptr_t byteflip; 391 392 extern Lisp_Object codefringe; 393 extern Lisp_Object volatile codelimit; 394 395 extern Lisp_Object * volatile stacklimit; 396 397 extern Lisp_Object fringe; 398 extern Lisp_Object volatile heaplimit; 399 400 extern Lisp_Object volatile vheaplimit; 401 extern Lisp_Object vfringe; 402 403 extern intptr_t nwork; 404 405 extern intptr_t exit_count; 406 extern intptr_t gensym_ser, print_precision, miscflags; 407 extern intptr_t current_modulus, fastget_size, package_bits; 408 409 extern Lisp_Object lisp_true, lambda, funarg, unset_var, opt_key, rest_key; 410 extern Lisp_Object quote_symbol, function_symbol, comma_symbol; 411 extern Lisp_Object comma_at_symbol, cons_symbol, eval_symbol; 412 extern Lisp_Object work_symbol, evalhook, applyhook, macroexpand_hook; 413 extern Lisp_Object append_symbol, exit_tag, exit_value, catch_tags; 414 extern Lisp_Object current_package, startfn; 415 extern Lisp_Object gensym_base, string_char_sym, boffo; 416 extern Lisp_Object err_table; 417 extern Lisp_Object progn_symbol; 418 extern Lisp_Object lisp_work_stream, charvec, raise_symbol, lower_symbol; 419 extern Lisp_Object echo_symbol, codevec, litvec, supervisor, B_reg; 420 extern Lisp_Object savedef, comp_symbol, compiler_symbol, faslvec; 421 extern Lisp_Object tracedfn, lisp_terminal_io; 422 extern Lisp_Object lisp_standard_output, lisp_standard_input, lisp_error_output; 423 extern Lisp_Object lisp_trace_output, lisp_debug_io, lisp_query_io; 424 extern Lisp_Object prompt_thing, faslgensyms; 425 extern Lisp_Object prinl_symbol, emsg_star, redef_msg; 426 extern Lisp_Object expr_symbol, fexpr_symbol, macro_symbol; 427 extern Lisp_Object cl_symbols, active_stream, current_module; 428 extern Lisp_Object native_defs, features_symbol, lisp_package; 429 extern Lisp_Object sys_hash_table, help_index, cfunarg, lex_words; 430 extern Lisp_Object get_counts, fastget_names, input_libraries; 431 extern Lisp_Object output_library, current_file, break_function; 432 extern Lisp_Object standard_output, standard_input, debug_io; 433 extern Lisp_Object error_output, query_io, terminal_io; 434 extern Lisp_Object trace_output, fasl_stream; 435 extern Lisp_Object native_code, native_symbol, traceprint_symbol; 436 extern Lisp_Object loadsource_symbol; 437 extern Lisp_Object hankaku_symbol, bytecoded_symbol, nativecoded_symbol; 438 extern Lisp_Object gchook, resources, callstack, procstack, procmem; 439 440 #ifdef COMMON 441 extern Lisp_Object keyword_package; 442 extern Lisp_Object all_packages, package_symbol, internal_symbol; 443 extern Lisp_Object external_symbol, inherited_symbol; 444 extern Lisp_Object key_key, allow_other_keys, aux_key; 445 extern Lisp_Object format_symbol; 446 extern Lisp_Object expand_def_symbol, allow_key_key; 447 #endif 448 449 extern Lisp_Object declare_symbol, special_symbol; 450 451 #ifdef OPENMATH 452 extern Lisp_Object MS_CDECL om_openFileDev(Lisp_Object env, int nargs, ...); 453 extern Lisp_Object om_openStringDev(Lisp_Object nil, Lisp_Object lstr, Lisp_Object lenc); 454 extern Lisp_Object om_closeDev(Lisp_Object env, Lisp_Object dev); 455 extern Lisp_Object om_setDevEncoding(Lisp_Object nil, Lisp_Object ldev, Lisp_Object lenc); 456 extern Lisp_Object om_makeConn(Lisp_Object nil, Lisp_Object ltimeout); 457 extern Lisp_Object om_closeConn(Lisp_Object nil, Lisp_Object lconn); 458 extern Lisp_Object om_getConnInDevice(Lisp_Object nil, Lisp_Object lconn); 459 extern Lisp_Object om_getConnOutDevice(Lisp_Object nil, Lisp_Object lconn); 460 extern Lisp_Object MS_CDECL om_connectTCP(Lisp_Object nil, int nargs, ...); 461 extern Lisp_Object om_bindTCP(Lisp_Object nil, Lisp_Object lconn, Lisp_Object lport); 462 extern Lisp_Object om_putApp(Lisp_Object nil, Lisp_Object ldev); 463 extern Lisp_Object om_putEndApp(Lisp_Object nil, Lisp_Object ldev); 464 extern Lisp_Object om_putAtp(Lisp_Object nil, Lisp_Object ldev); 465 extern Lisp_Object om_putEndAtp(Lisp_Object nil, Lisp_Object ldev); 466 extern Lisp_Object om_putAttr(Lisp_Object nil, Lisp_Object ldev); 467 extern Lisp_Object om_putEndAttr(Lisp_Object nil, Lisp_Object ldev); 468 extern Lisp_Object om_putBind(Lisp_Object nil, Lisp_Object ldev); 469 extern Lisp_Object om_putEndBind(Lisp_Object nil, Lisp_Object ldev); 470 extern Lisp_Object om_putBVar(Lisp_Object nil, Lisp_Object ldev); 471 extern Lisp_Object om_putEndBVar(Lisp_Object nil, Lisp_Object ldev); 472 extern Lisp_Object om_putError(Lisp_Object nil, Lisp_Object ldev); 473 extern Lisp_Object om_putEndError(Lisp_Object nil, Lisp_Object ldev); 474 extern Lisp_Object om_putObject(Lisp_Object nil, Lisp_Object ldev); 475 extern Lisp_Object om_putEndObject(Lisp_Object nil, Lisp_Object ldev); 476 extern Lisp_Object om_putInt(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 477 extern Lisp_Object om_putFloat(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 478 extern Lisp_Object om_putByteArray(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 479 extern Lisp_Object om_putVar(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 480 extern Lisp_Object om_putString(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 481 extern Lisp_Object om_putSymbol(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val); 482 extern Lisp_Object MS_CDECL om_putSymbol2(Lisp_Object nil, int nargs, ...); 483 extern Lisp_Object om_getApp(Lisp_Object nil, Lisp_Object ldev); 484 extern Lisp_Object om_getEndApp(Lisp_Object nil, Lisp_Object ldev); 485 extern Lisp_Object om_getAtp(Lisp_Object nil, Lisp_Object ldev); 486 extern Lisp_Object om_getEndAtp(Lisp_Object nil, Lisp_Object ldev); 487 extern Lisp_Object om_getAttr(Lisp_Object nil, Lisp_Object ldev); 488 extern Lisp_Object om_getEndAttr(Lisp_Object nil, Lisp_Object ldev); 489 extern Lisp_Object om_getBind(Lisp_Object nil, Lisp_Object ldev); 490 extern Lisp_Object om_getEndBind(Lisp_Object nil, Lisp_Object ldev); 491 extern Lisp_Object om_getBVar(Lisp_Object nil, Lisp_Object ldev); 492 extern Lisp_Object om_getEndBVar(Lisp_Object nil, Lisp_Object ldev); 493 extern Lisp_Object om_getError(Lisp_Object nil, Lisp_Object ldev); 494 extern Lisp_Object om_getEndError(Lisp_Object nil, Lisp_Object ldev); 495 extern Lisp_Object om_getObject(Lisp_Object nil, Lisp_Object ldev); 496 extern Lisp_Object om_getEndObject(Lisp_Object nil, Lisp_Object ldev); 497 extern Lisp_Object om_getInt(Lisp_Object nil, Lisp_Object ldev); 498 extern Lisp_Object om_getFloat(Lisp_Object nil, Lisp_Object ldev); 499 extern Lisp_Object om_getByteArray(Lisp_Object nil, Lisp_Object ldev); 500 extern Lisp_Object om_getVar(Lisp_Object nil, Lisp_Object ldev); 501 extern Lisp_Object om_getString(Lisp_Object nil, Lisp_Object ldev); 502 extern Lisp_Object om_getSymbol(Lisp_Object nil, Lisp_Object ldev); 503 extern Lisp_Object om_getType(Lisp_Object nil, Lisp_Object ldev); 504 505 extern Lisp_Object om_stringToStringPtr(Lisp_Object nil, Lisp_Object lstr); 506 extern Lisp_Object om_stringPtrToString(Lisp_Object nil, Lisp_Object lpstr); 507 508 extern Lisp_Object om_read(Lisp_Object nil, Lisp_Object dev); 509 extern Lisp_Object om_supportsCD(Lisp_Object nil, Lisp_Object lcd); 510 extern Lisp_Object om_supportsSymbol(Lisp_Object nil, Lisp_Object lcd, Lisp_Object lsym); 511 extern Lisp_Object MS_CDECL om_listCDs(Lisp_Object nil, int nargs, ...); 512 extern Lisp_Object om_listSymbols(Lisp_Object nil, Lisp_Object lcd); 513 extern Lisp_Object om_whichCDs(Lisp_Object nil, Lisp_Object lsym); 514 #endif 515 516 extern Lisp_Object workbase[51]; 517 518 extern Lisp_Object user_base_0, user_base_1, user_base_2; 519 extern Lisp_Object user_base_3, user_base_4, user_base_5; 520 extern Lisp_Object user_base_6, user_base_7, user_base_8; 521 extern Lisp_Object user_base_9; 522 523 #define work_0 workbase[0] 524 #define work_1 workbase[1] 525 #define mv_1 workbase[1] 526 #define mv_2 workbase[2] 527 #define mv_3 workbase[3] 528 #define work_50 workbase[50] 529 530 #else /* NILSEG_EXTERNS */ 531 532 #define nil_as_base Lisp_Object nil = C_nil; 533 534 #define byteflip BASE[12] 535 #define codefringe BASE[13] 536 #define codelimit (*(Lisp_Object volatile *)&BASE[14]) 537 /* 538 * On a machine where sizeof(void *)=8 and alignment matters I need to arrange for 539 * stacklimit to be properly aligned. Also I MUST do the address calculation 540 * in a way that does not get muddled by the "sizeof(void *)" issue. I 541 * reserve nilseg offsets 15, 16 and 17 for this. However the value 542 * stacklimit still generally lives in a simple variable. 543 */ 544 extern Lisp_Object * volatile stacklimit; 545 /* 546 * #ifdef COMMON 547 * #define stacklimit (*(Lisp_Object * volatile *) \ 548 * &BASE[16]) 549 * #else 550 * #define stacklimit (*(Lisp_Object * volatile *)&BASE[15]) 551 * #endif 552 */ 553 #define fringe BASE[18] 554 #define heaplimit (*(Lisp_Object volatile *)&BASE[19]) 555 #define vheaplimit (*(Lisp_Object volatile *)&BASE[20]) 556 #define vfringe BASE[21] 557 558 #define miscflags BASE[22] 559 560 #define nwork BASE[24] 561 /* #define exit_reason BASE[25] */ 562 #define exit_count BASE[26] 563 #define gensym_ser BASE[27] 564 #define print_precision BASE[28] 565 #define current_modulus BASE[29] 566 #define fastget_size BASE[30] 567 #define package_bits BASE[31] 568 /* offsets 32-49 spare at present */ 569 570 /* Offset 50 used for EQ hash table list */ 571 /* Offset 51 used for EQUAL hash table list */ 572 #define current_package BASE[52] 573 /* current_package is treated specially by the garbage collector */ 574 575 #define B_reg BASE[53] 576 #define codevec BASE[54] 577 #define litvec BASE[55] 578 #define exit_tag BASE[56] 579 #define exit_value BASE[57] 580 #define catch_tags BASE[58] 581 #define lisp_package BASE[59] 582 #define boffo BASE[60] 583 #define charvec BASE[61] 584 #define sys_hash_table BASE[62] 585 #define help_index BASE[63] 586 #define gensym_base BASE[64] 587 #define err_table BASE[65] 588 #define supervisor BASE[66] 589 #define startfn BASE[67] 590 #define faslvec BASE[68] 591 #define tracedfn BASE[69] 592 #define prompt_thing BASE[70] 593 #define faslgensyms BASE[71] 594 #define cl_symbols BASE[72] 595 #define active_stream BASE[73] 596 #define current_module BASE[74] 597 #define native_defs BASE[75] 598 /* 599 * 76-89 spare for workspace-style locations 600 */ 601 #define append_symbol BASE[90] 602 #define applyhook BASE[91] 603 #define cfunarg BASE[92] 604 #define comma_at_symbol BASE[93] 605 #define comma_symbol BASE[94] 606 #define compiler_symbol BASE[95] 607 #define comp_symbol BASE[96] 608 #define cons_symbol BASE[97] 609 #define echo_symbol BASE[98] 610 #define emsg_star BASE[99] 611 #define evalhook BASE[100] 612 #define eval_symbol BASE[101] 613 #define expr_symbol BASE[102] 614 #define features_symbol BASE[103] 615 #define fexpr_symbol BASE[104] 616 #define funarg BASE[105] 617 #define function_symbol BASE[106] 618 #define lambda BASE[107] 619 #define lisp_true BASE[108] 620 #define lower_symbol BASE[109] 621 #define macroexpand_hook BASE[110] 622 #define macro_symbol BASE[111] 623 #define opt_key BASE[112] 624 #define prinl_symbol BASE[113] 625 #define progn_symbol BASE[114] 626 #define quote_symbol BASE[115] 627 #define raise_symbol BASE[116] 628 #define redef_msg BASE[117] 629 #define rest_key BASE[118] 630 #define savedef BASE[119] 631 #define string_char_sym BASE[120] 632 #define unset_var BASE[121] 633 #define work_symbol BASE[122] 634 #define lex_words BASE[123] 635 #define get_counts BASE[124] 636 #define fastget_names BASE[125] 637 #define input_libraries BASE[126] 638 #define output_library BASE[127] 639 #define current_file BASE[128] 640 #define break_function BASE[129] 641 642 #define lisp_work_stream BASE[130] 643 #define lisp_standard_output BASE[131] 644 #define lisp_standard_input BASE[132] 645 #define lisp_debug_io BASE[133] 646 #define lisp_error_output BASE[134] 647 #define lisp_query_io BASE[135] 648 #define lisp_terminal_io BASE[136] 649 #define lisp_trace_output BASE[137] 650 #define standard_output BASE[138] 651 #define standard_input BASE[139] 652 #define debug_io BASE[140] 653 #define error_output BASE[141] 654 #define query_io BASE[142] 655 #define terminal_io BASE[143] 656 #define trace_output BASE[144] 657 #define fasl_stream BASE[145] 658 #define native_code BASE[146] 659 #define native_symbol BASE[147] 660 #define traceprint_symbol BASE[148] 661 #define loadsource_symbol BASE[149] 662 #define hankaku_symbol BASE[150] 663 #define bytecoded_symbol BASE[151] 664 #define nativecoded_symbol BASE[152] 665 #define gchook BASE[153] 666 #define resources BASE[154] 667 #define callstack BASE[155] 668 #define procstack BASE[156] 669 #define procmem BASE[157] 670 671 #ifdef COMMON 672 #define keyword_package BASE[170] 673 #define all_packages BASE[171] 674 #define package_symbol BASE[172] 675 #define internal_symbol BASE[173] 676 #define external_symbol BASE[174] 677 #define inherited_symbol BASE[175] 678 #define key_key BASE[176] 679 #define allow_other_keys BASE[177] 680 #define aux_key BASE[178] 681 #define format_symbol BASE[179] 682 #define expand_def_symbol BASE[180] 683 #define allow_key_key BASE[181] 684 #endif 685 686 #define declare_symbol BASE[182] 687 #define special_symbol BASE[183] 688 689 /* 690 * The next are intended for use by people building custom versions 691 * of CSL. They are always handled as if NILSEG_EXTERNS had been set, 692 * even if it had not, since that gives the user direct access to them as 693 * simple C variables. Note that they must ALWAYS be kept with proper 694 * valid Lisp objects in them. 695 */ 696 /* #define user_base_0 BASE[190] */ 697 /* #define user_base_1 BASE[191] */ 698 /* #define user_base_2 BASE[192] */ 699 /* #define user_base_3 BASE[193] */ 700 /* #define user_base_4 BASE[194] */ 701 /* #define user_base_5 BASE[195] */ 702 /* #define user_base_6 BASE[196] */ 703 /* #define user_base_7 BASE[197] */ 704 /* #define user_base_8 BASE[198] */ 705 /* #define user_base_9 BASE[199] */ 706 707 extern Lisp_Object user_base_0, user_base_1, user_base_2; 708 extern Lisp_Object user_base_3, user_base_4, user_base_5; 709 extern Lisp_Object user_base_6, user_base_7, user_base_8; 710 extern Lisp_Object user_base_9; 711 712 #define work_0 BASE[200] 713 #define work_1 BASE[201] 714 #define mv_1 work_1 715 #define mv_2 BASE[202] 716 #define mv_3 BASE[203] 717 #define work_50 BASE[250] 718 719 #endif /*NILSEG_EXTERNS */ 720 721 extern void copy_into_nilseg(int fg); 722 extern void copy_out_of_nilseg(int fg); 723 724 #define eq_hash_table_list BASE[50] /* In heap image */ 725 #define equal_hash_table_list BASE[51] /* In heap image */ 726 #define current_package_offset 52 727 728 extern void rehash_this_table(Lisp_Object v); 729 extern Lisp_Object eq_hash_tables, equal_hash_tables; 730 731 /* 732 * The following are used to help <escape> processing. 733 */ 734 extern Lisp_Object volatile savecodelimit; 735 extern Lisp_Object * volatile savestacklimit; 736 extern Lisp_Object volatile saveheaplimit; 737 extern Lisp_Object volatile savevheaplimit; 738 extern char *exit_charvec; 739 740 /* 741 * There is no reason to preserve this across restarts etc so making it a 742 * simple C variable makes it easier for me to initialise it early. 743 */ 744 extern intptr_t exit_reason; 745 746 extern int procstackp; 747 748 #ifdef DEBUG 749 extern int trace_all; 750 #endif 751 752 extern int garbage_collection_permitted; 753 754 #define MAX_INPUT_FILES 40 /* limit on command-line length */ 755 #define MAX_SYMBOLS_TO_DEFINE 40 756 #define MAX_FASL_PATHS 20 757 758 extern char *files_to_read[MAX_INPUT_FILES], 759 *symbols_to_define[MAX_SYMBOLS_TO_DEFINE], 760 *fasl_paths[MAX_FASL_PATHS]; 761 extern int fasl_output_file, output_directory; 762 extern FILE *binary_read_file; 763 764 extern int boffop; 765 extern void packbyte(int c); 766 767 #ifndef COMMON 768 #ifdef HAVE_FWIN 769 extern char **loadable_packages; 770 extern char **switches; 771 extern void review_switch_settings(); 772 #endif 773 #endif 774 775 #ifdef SOCKETS 776 extern int sockets_ready; 777 extern void flush_socket(void); 778 #endif 779 780 extern void report_file(const char *s); 781 782 extern CSLbool undefine_this_one[MAX_SYMBOLS_TO_DEFINE]; 783 extern CSLbool always_noisy; 784 785 extern int number_of_input_files, 786 number_of_symbols_to_define, 787 number_of_fasl_paths, 788 init_flags; 789 790 extern int native_code_tag; 791 792 extern char *standard_directory; 793 794 extern int gc_number; 795 extern CSLbool gc_method_is_copying; 796 797 #define INIT_QUIET 1 798 #define INIT_VERBOSE 2 799 #define INIT_EXPANDABLE 4 800 801 #define Lispify_predicate(p) ((p) ? lisp_true : nil) 802 803 /* 804 * variables used by the IO system. 805 */ 806 807 extern int tty_count; 808 extern FILE *spool_file; 809 extern char spool_file_name[32]; 810 811 typedef struct Ihandle 812 { 813 FILE *f; /* File within which this sub-file lives */ 814 long int o; /* Offset (as returned by ftell) */ 815 long int n; /* Number of bytes remaining unread here */ 816 uint32_t chk; /* Checksum */ 817 int status; /* Reading or Writing */ 818 int nativedir; /* true if a system directory not my own PDS */ 819 } Ihandle; 820 821 /* 822 * If there is no more than 100 bytes of data then I will deem 823 * file compression frivolous. The compression code assumes that 824 * it has at least 2 bytes to work on, so do NOT cut this limit down to zero. 825 * Indeed more than that the limit must be greater than the length of 826 * the initial header record (112 bytes). 827 */ 828 829 extern int32_t compression_worth_while; 830 #define CODESIZE 0x1000 831 832 typedef struct entry_point1 833 { 834 one_args *p; 835 char *s; 836 } entry_point1; 837 838 typedef struct entry_point2 839 { 840 two_args *p; 841 char *s; 842 } entry_point2; 843 844 typedef struct entry_pointn 845 { 846 n_args *p; 847 char *s; 848 } entry_pointn; 849 850 extern entry_point1 entries_table1[]; 851 extern entry_point2 entries_table2[]; 852 extern entry_pointn entries_tablen[]; 853 extern entry_pointn entries_table_io[]; 854 855 extern void set_up_entry_lookup(void); 856 extern int32_t code_up_fn1(one_args *e); 857 extern int32_t code_up_fn2(two_args *e); 858 extern int32_t code_up_fnn(n_args *e); 859 extern int32_t code_up_io(void *e); 860 861 extern int doubled_execution; 862 863 extern char *linker_type; 864 extern char *compiler_command[], *import_data[], 865 *config_header[], *csl_headers[]; 866 867 extern Lisp_Object encapsulate_pointer(void *); 868 typedef void initfn(Lisp_Object *, Lisp_Object **, Lisp_Object * volatile *); 869 extern int load_dynamic(char *objname, char *modname, 870 Lisp_Object name, Lisp_Object fns); 871 extern Lisp_Object Linstate_c_code(Lisp_Object nil, 872 Lisp_Object name, Lisp_Object fns); 873 874 #ifdef MEMORY_TRACE 875 extern intptr_t memory_base, memory_size; 876 extern unsigned char *memory_map; 877 extern FILE *memory_file; 878 extern void memory_comment(int n); 879 #endif 880 881 #define ARG_CUT_OFF 25 882 extern void push_args(va_list a, int nargs); 883 extern void push_args_1(va_list a, int nargs); 884 885 extern void Iinit(void); 886 extern void IreInit(void); 887 extern void Icontext(Ihandle *); 888 extern void Irestore_context(Ihandle); 889 extern void Ilist(void); 890 extern CSLbool open_output(char *s, int len); 891 #define IOPEN_OUT 0 892 #define IOPEN_UNCHECKED 1 893 #define IOPEN_CHECKED 2 894 extern CSLbool Iopen(char *name, int len, int dirn, char *expanded_name); 895 extern CSLbool Iopen_from_stdin(void), Iopen_to_stdout(void); 896 extern CSLbool IopenRoot(char *expanded_name, int hard, int sixtyfour); 897 extern CSLbool Iwriterootp(char *expanded); 898 extern CSLbool Iopen_help(int32_t offset); 899 extern CSLbool Iopen_banner(int code); 900 extern CSLbool Imodulep(char *name, int len, char *datestamp, int32_t *size, 901 char *expanded_name); 902 extern CSLbool Icopy(char *name, int len); 903 extern CSLbool Idelete(char *name, int len); 904 extern CSLbool IcloseInput(int check_checksum); 905 extern CSLbool IcloseOutput(int write_checksum); 906 extern CSLbool Ifinished(void); 907 extern int Igetc(void); 908 extern int32_t Iread(void *buff, int32_t size); 909 extern CSLbool Iputc(int ch); 910 extern CSLbool Iwrite(void *buff, int32_t size); 911 extern long int Ioutsize(void); 912 extern char *CSLtmpnam(char *suffix, int32_t suffixlen); 913 extern int Cmkdir(char *s); 914 extern char *look_in_lisp_variable(char *o, int prefix); 915 916 extern void CSL_MD5_Init(void); 917 extern void CSL_MD5_Update(unsigned char *data, int len); 918 extern void CSL_MD5_Final(unsigned char *md); 919 extern CSLbool CSL_MD5_busy; 920 extern unsigned char *CSL_MD5(unsigned char *data, int n, unsigned char *md); 921 extern void checksum(Lisp_Object a); 922 extern unsigned char unpredictable[256]; 923 extern void inject_randomness(int n); 924 925 extern void ensure_screen(void); 926 extern int window_heading; 927 extern void my_exit(int n); 928 extern void *my_malloc(size_t n); 929 930 extern clock_t base_time; 931 extern double *clock_stack; 932 extern void push_clock(void); 933 extern double pop_clock(void); 934 extern double consolidated_time[10], gc_time; 935 extern CSLbool volatile already_in_gc, tick_on_gc_exit; 936 extern CSLbool volatile interrupt_pending, tick_pending; 937 extern int deal_with_tick(void); 938 extern int current_fp_rep; 939 #ifndef __cplusplus 940 #ifdef USE_SIGALTSTACK 941 extern sigjmp_buf *errorset_buffer; 942 extern sigjmp_buf my_exit_buffer; 943 #else 944 extern jmp_buf *errorset_buffer; 945 extern jmp_buf my_exit_buffer; 946 #endif 947 #endif 948 extern char *errorset_msg; 949 extern int errorset_code; 950 extern void unwind_stack(Lisp_Object *, CSLbool findcatch); 951 extern CSLbool segvtrap; 952 extern CSLbool batch_flag; 953 extern int escaped_printing; 954 extern void MS_CDECL low_level_signal_handler(int code); 955 extern int async_interrupt(int a); 956 extern void MS_CDECL sigint_handler(int code); 957 958 extern void record_get(Lisp_Object tag, CSLbool found); 959 960 /* 961 * Functions used internally - not to be installed in Lisp function 962 * cells, but some of these may end up getting called using special 963 * non-standard conventions when the Lisp compiler has been at work. 964 */ 965 966 extern int primep(int32_t); 967 extern void adjust_all(void); 968 extern void set_up_functions(CSLbool restartp); 969 extern void get_user_files_checksum(unsigned char *); 970 extern Lisp_Object acons(Lisp_Object a, Lisp_Object b, Lisp_Object c); 971 extern Lisp_Object ash(Lisp_Object a, Lisp_Object b); 972 extern Lisp_Object bytestream_interpret(Lisp_Object code, Lisp_Object lit, 973 Lisp_Object *entry_stack); 974 extern CSLbool complex_stringp(Lisp_Object a); 975 extern void freshline_trace(void); 976 extern void freshline_debug(void); 977 extern Lisp_Object cons(Lisp_Object a, Lisp_Object b); 978 extern Lisp_Object cons_no_gc(Lisp_Object a, Lisp_Object b); 979 extern Lisp_Object cons_gc_test(Lisp_Object a); 980 extern void convert_fp_rep(void *p, int old_rep, int new_rep, int type); 981 extern Lisp_Object Ceval(Lisp_Object u, Lisp_Object env); 982 extern uint32_t Crand(void); 983 extern Lisp_Object Cremainder(Lisp_Object a, Lisp_Object b); 984 extern void Csrand(uint32_t a, uint32_t b); 985 extern void discard(Lisp_Object a); 986 extern CSLbool eql_fn(Lisp_Object a, Lisp_Object b); 987 extern CSLbool cl_equal_fn(Lisp_Object a, Lisp_Object b); 988 extern CSLbool equal_fn(Lisp_Object a, Lisp_Object b); 989 #ifdef TRACED_EQUAL 990 extern CSLbool traced_equal_fn(Lisp_Object a, Lisp_Object b, 991 char *, int, int); 992 #define equal_fn(a, b) traced_equal_fn(a, b, __FILE__, __LINE__, 0) 993 extern void dump_equals(); 994 #endif 995 extern CSLbool equalp(Lisp_Object a, Lisp_Object b); 996 extern Lisp_Object apply(Lisp_Object fn, int nargs, 997 Lisp_Object env, Lisp_Object fname); 998 extern Lisp_Object apply_lambda(Lisp_Object def, int nargs, 999 Lisp_Object env, Lisp_Object name); 1000 extern void deallocate_pages(void); 1001 extern void drop_heap_segments(void); 1002 extern Lisp_Object gcd(Lisp_Object a, Lisp_Object b); 1003 extern Lisp_Object get_pname(Lisp_Object a); 1004 #ifdef COMMON 1005 extern Lisp_Object get(Lisp_Object a, Lisp_Object b, Lisp_Object c); 1006 #else 1007 extern Lisp_Object get(Lisp_Object a, Lisp_Object b); 1008 #endif 1009 extern Lisp_Object getvector(int tag, int type, int32_t length); 1010 extern Lisp_Object getvector_init(int32_t n, Lisp_Object v); 1011 extern Lisp_Object getcodevector(int type, int32_t size); 1012 extern uint32_t hash_lisp_string(Lisp_Object s); 1013 extern void lose_C_def(Lisp_Object a); 1014 extern CSLbool geq2(Lisp_Object a, Lisp_Object b); 1015 extern CSLbool greaterp2(Lisp_Object a, Lisp_Object b); 1016 extern CSLbool lesseq2(Lisp_Object a, Lisp_Object b); 1017 extern CSLbool lessp2(Lisp_Object a, Lisp_Object b); 1018 extern Lisp_Object list2(Lisp_Object a, Lisp_Object b); 1019 extern Lisp_Object list2star(Lisp_Object a, Lisp_Object b, Lisp_Object c); 1020 extern Lisp_Object list3(Lisp_Object a, Lisp_Object b, Lisp_Object c); 1021 extern Lisp_Object list3star(Lisp_Object a, Lisp_Object b, 1022 Lisp_Object c, Lisp_Object d); 1023 extern Lisp_Object list4(Lisp_Object a, Lisp_Object b, 1024 Lisp_Object c, Lisp_Object d); 1025 extern Lisp_Object lognot(Lisp_Object a); 1026 extern Lisp_Object macroexpand(Lisp_Object form, Lisp_Object env); 1027 extern Lisp_Object make_one_word_bignum(int32_t n); 1028 extern Lisp_Object make_package(Lisp_Object name); 1029 extern Lisp_Object make_string(const char *b); 1030 extern Lisp_Object make_nstring(char *b, int32_t n); 1031 extern Lisp_Object make_undefined_symbol(char const *s); 1032 extern Lisp_Object make_symbol(char const *s, int restartp, 1033 one_args *f1, two_args *f2, n_args *fn); 1034 extern void MS_CDECL stdout_printf(char *fmt, ...); 1035 extern void MS_CDECL term_printf(char *fmt, ...); 1036 extern void MS_CDECL err_printf(char *fmt, ...); 1037 extern void MS_CDECL debug_printf(char *fmt, ...); 1038 extern void MS_CDECL trace_printf(char *fmt, ...); 1039 extern char *my_getenv(char *name); 1040 extern Lisp_Object ncons(Lisp_Object a); 1041 extern Lisp_Object ndelete(Lisp_Object a, Lisp_Object b); 1042 extern Lisp_Object negate(Lisp_Object a); 1043 extern Lisp_Object nreverse(Lisp_Object a); 1044 extern FILE *open_file(char *filename, char *original_name, 1045 size_t n, char *dirn, FILE *old_file); 1046 extern Lisp_Object plus2(Lisp_Object a, Lisp_Object b); 1047 extern void preserve(char *msg, int len); 1048 extern void preserve_native_code(void); 1049 extern void relocate_native_function(unsigned char *bps); 1050 extern Lisp_Object prin(Lisp_Object u); 1051 extern char *get_string_data(Lisp_Object a, char *why, int32_t *len); 1052 extern void prin_to_stdout(Lisp_Object u); 1053 extern void prin_to_terminal(Lisp_Object u); 1054 extern void prin_to_debug(Lisp_Object u); 1055 extern void prin_to_query(Lisp_Object u); 1056 extern void prin_to_trace(Lisp_Object u); 1057 extern void prin_to_error(Lisp_Object u); 1058 extern void loop_print_stdout(Lisp_Object o); 1059 extern void loop_print_terminal(Lisp_Object o); 1060 extern void loop_print_debug(Lisp_Object o); 1061 extern void loop_print_query(Lisp_Object o); 1062 extern void loop_print_trace(Lisp_Object o); 1063 extern void loop_print_error(Lisp_Object o); 1064 extern void internal_prin(Lisp_Object u, int prefix); 1065 extern Lisp_Object princ(Lisp_Object u); 1066 extern Lisp_Object print(Lisp_Object u); 1067 extern Lisp_Object printc(Lisp_Object u); 1068 extern void print_bignum(Lisp_Object u, CSLbool blankp, int nobreak); 1069 extern void print_bighexoctbin(Lisp_Object u, 1070 int radix, int width, CSLbool blankp, int nobreak); 1071 extern Lisp_Object putprop(Lisp_Object a, Lisp_Object b, 1072 Lisp_Object c); 1073 extern Lisp_Object quot2(Lisp_Object a, Lisp_Object b); 1074 extern Lisp_Object rational(Lisp_Object a); 1075 extern void read_eval_print(int noisy); 1076 extern Lisp_Object reclaim(Lisp_Object value_to_return, char *why, 1077 int stg_class, intptr_t size); 1078 #ifdef DEBUG 1079 extern void validate_all(char *why, int line, char *file); 1080 extern int check_env(Lisp_Object env); 1081 #endif 1082 extern CSLbool do_not_kill_native_code; 1083 extern void set_fns(Lisp_Object sym, one_args *f1, 1084 two_args *f2, n_args *fn); 1085 extern void setup(int restartp, double storesize); 1086 extern Lisp_Object simplify_string(Lisp_Object s); 1087 extern CSLbool stringp(Lisp_Object a); 1088 extern Lisp_Object times2(Lisp_Object a, Lisp_Object b); 1089 extern int32_t thirty_two_bits(Lisp_Object a); 1090 #ifdef HAVE_INT64_T 1091 extern int64_t sixty_four_bits(Lisp_Object a); 1092 #endif 1093 1094 #ifdef DEBUG 1095 extern void validate_string_fn(Lisp_Object a, char *f, int l); 1096 #define validate_string(a) validate_string_fn(a, __FILE__, __LINE__) 1097 #else 1098 #define validate_string(a) 0 1099 #endif 1100 1101 /* 1102 * The next few provide support for multiple values. 1103 */ 1104 #ifdef COMMON 1105 #define onevalue(r) (exit_count=1, (r)) 1106 #define nvalues(r, n) (exit_count=(n), (r)) 1107 #else 1108 #define onevalue(r) (r) 1109 #define nvalues(r, n) (r) 1110 #endif 1111 1112 #ifdef COMMON 1113 #define eval(a, b) Ceval(a, b) 1114 #define voideval(a, b) Ceval(a, b) 1115 #else 1116 /* 1117 * I lift the top test from eval out to be in-line so that I can 1118 * (rather often) avoid the overhead of a procedure call when return from 1119 * it will be almost immediate. The effect is that in CSL mode Ceval is 1120 * only ever called on a list. NB the first arg to eval gets evaluated 1121 * several times here - maybe I will just hope that CSE optimisation picks 1122 * up this sort of repetition... 1123 */ 1124 #define eval(a, b) \ 1125 (is_cons(a) ? Ceval(a, b) : \ 1126 is_symbol(a) ? (qvalue(a) == unset_var ? error(1, err_unset_var, a) : \ 1127 onevalue(qvalue(a))) : \ 1128 onevalue(a)) 1129 /* voideval(a, b) is like (void)eval(a, b) */ 1130 #define voideval(a, b) \ 1131 if (is_cons(a)) Ceval(a, b) /* Beware "else" after this */ 1132 #endif 1133 1134 /* 1135 * The function "equal" seems to be pretty critical (certainly for Standard 1136 * Lisp mode and Reduce). So I write out the top-level part of it in-line 1137 * and only call the (messy) function in cases where it might be worth-while. 1138 * For Common Lisp I will presumably look at eql and cl_equal as well. 1139 * The test here says: 1140 * If a and b are EQ then they are EQUAL, 1141 * else if a and b have different types they are not EQUAL 1142 * else if a has type 1, 2, 3 or 4 (ie fixnum, odds, sfloat, symbol) 1143 * then they are not EQUAL (those types need to be EQ to be EQUAL) 1144 * otherwise call equal_fn(a, b) to decide the issue. 1145 */ 1146 #define equal(a, b) \ 1147 ((a) == (b) || \ 1148 (((((a) ^ (b)) & TAG_BITS) == 0) && \ 1149 ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ 1150 equal_fn(a, b))) 1151 1152 #define cl_equal(a, b) \ 1153 ((a) == (b) || \ 1154 (((((a) ^ (b)) & TAG_BITS) == 0) && \ 1155 ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ 1156 cl_equal_fn(a, b))) 1157 1158 #define eql(a, b) \ 1159 ((a) == (b) || \ 1160 (((((a) ^ (b)) & TAG_BITS) == 0) && \ 1161 ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \ 1162 eql_fn(a, b))) 1163 1164 /* 1165 * Helpers for the bignum arithmetic code... 1166 */ 1167 1168 #ifndef IMULTIPLY 1169 extern uint32_t Imultiply(uint32_t *rlow, uint32_t a, 1170 uint32_t b, uint32_t c); 1171 #endif 1172 #ifndef IDIVIDE 1173 extern uint32_t Idivide(uint32_t *qp, uint32_t a, 1174 uint32_t b, uint32_t c); 1175 extern uint32_t Idiv10_9(uint32_t *qp, uint32_t a, uint32_t b); 1176 #endif 1177 1178 #define argcheck(var, n, msg) if ((var)!=(n)) return aerror(msg); 1179 1180 extern n_args *zero_arg_functions[]; 1181 extern one_args *one_arg_functions[]; 1182 extern two_args *two_arg_functions[]; 1183 extern n_args *three_arg_functions[]; 1184 extern void *useful_functions[]; 1185 extern char *address_of_var(int n); 1186 1187 typedef struct setup_type 1188 { 1189 char *name; 1190 one_args *one; 1191 two_args *two; 1192 n_args *n; 1193 } setup_type; 1194 1195 typedef struct setup_type_1 1196 { 1197 char *name; 1198 one_args *one; 1199 two_args *two; 1200 n_args *n; 1201 uint32_t c1; 1202 uint32_t c2; 1203 } setup_type_1; 1204 1205 extern setup_type const 1206 arith06_setup[], arith08_setup[], arith10_setup[], arith12_setup[], 1207 char_setup[], eval1_setup[], eval2_setup[], eval3_setup[], 1208 funcs1_setup[], funcs2_setup[], funcs3_setup[], print_setup[], 1209 read_setup[], mpi_setup[]; 1210 extern setup_type const 1211 u01_setup[], u02_setup[], u03_setup[], u04_setup[], 1212 u05_setup[], u06_setup[], u07_setup[], u08_setup[], u09_setup[], 1213 u10_setup[], u11_setup[], u12_setup[], u13_setup[], u14_setup[], 1214 u15_setup[], u16_setup[], u17_setup[], u18_setup[], u19_setup[], 1215 u20_setup[], u21_setup[], u22_setup[], u23_setup[], u24_setup[], 1216 u25_setup[], u26_setup[], u27_setup[], u28_setup[], u29_setup[], 1217 u30_setup[], u31_setup[], u32_setup[], u33_setup[], u34_setup[], 1218 u35_setup[], u36_setup[], u37_setup[], u38_setup[], u39_setup[], 1219 u40_setup[], u41_setup[], u42_setup[], u43_setup[], u44_setup[], 1220 u45_setup[], u46_setup[], u47_setup[], u48_setup[], u49_setup[], 1221 u50_setup[], u51_setup[], u52_setup[], u53_setup[], u54_setup[], 1222 u55_setup[], u56_setup[], u57_setup[], u58_setup[], u59_setup[], 1223 u60_setup[]; 1224 1225 extern setup_type const *setup_tables[]; 1226 1227 #ifdef NAG 1228 extern setup_type const nag_setup[], asp_setup[]; 1229 extern setup_type const socket_setup[], xdr_setup[], grep_setup[]; 1230 extern setup_type const gr_setup[], axfns_setup[]; 1231 #endif 1232 1233 #ifdef OPENMATH 1234 extern setup_type const om_setup[]; 1235 extern setup_type const om_parse_setup[]; 1236 #endif 1237 1238 extern char *find_image_directory(int argc, char *argv[]); 1239 extern char program_name[64]; 1240 extern Lisp_Object declare_fn(Lisp_Object args, Lisp_Object env); 1241 extern Lisp_Object function_fn(Lisp_Object args, Lisp_Object env); 1242 extern Lisp_Object let_fn_1(Lisp_Object bvl, Lisp_Object body, 1243 Lisp_Object env, int compilerp); 1244 extern Lisp_Object mv_call_fn(Lisp_Object args, Lisp_Object env); 1245 extern Lisp_Object progn_fn(Lisp_Object args, Lisp_Object env); 1246 extern Lisp_Object quote_fn(Lisp_Object args, Lisp_Object env); 1247 extern Lisp_Object tagbody_fn(Lisp_Object args, Lisp_Object env); 1248 1249 /* 1250 * The variables here are always extern - they never survive in an image 1251 * file. 1252 */ 1253 extern Lisp_Object resource_exceeded(); 1254 extern int time_base, space_base, io_base, errors_base; 1255 extern int time_now, space_now, io_now, errors_now; 1256 extern int time_limit, space_limit, io_limit, errors_limit; 1257 1258 /* 1259 * Flags used to toggle the protection or otherwise of symbols, and 1260 * whether to warn about attempts to redefine them. 1261 */ 1262 extern CSLbool symbol_protect_flag, warn_about_protected_symbols; 1263 1264 #ifdef JIT 1265 extern char *Jcompile(Lisp_Object def, Lisp_Object env); 1266 extern unsigned long jit_size; 1267 #define JIT_INIT_SIZE 8192 1268 #endif 1269 1270 #ifdef __cplusplus 1271 } 1272 #endif 1273 1274 #endif /* header_externs_h */ 1275 1276 /* end of externs.h */ 1277