1 /* -*-C-*-
2
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6 Institute of Technology
7
8 This file is part of MIT/GNU Scheme.
9
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 General Public License for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24
25 */
26
27 /*
28 *
29 * Compiled code interface macros.
30 *
31 * See cmpint.txt for a description of these fields.
32 *
33 * Specialized for the MIPS R2000/R3000
34 */
35
36 #ifndef SCM_CMPINTMD_H_INCLUDED
37 #define SCM_CMPINTMD_H_INCLUDED 1
38
39 #ifdef _IRIX
40
41 #include <sys/cachectl.h>
42 #include <unistd.h>
43
44 /* Define this to use the official method of flushing the cache: the
45 `mprotect' system call. When not defined, we use `cacheflush',
46 which is more efficient. The mprotect method is known to work on
47 IRIX 6.3. */
48 /* #define USE_MPROTECT_CACHE_FLUSH */
49
50 #else /* not _IRIX */
51 #ifdef sonyrisc
52
53 #include <sys/syscall.h>
54 #include <sys/sysmips.h>
55 #include <sys/cachectl.h>
56
57 extern void syscall ();
58
59 #define cacheflush(addr, nbytes, cache) \
60 syscall (SYS_sysmips, FLUSH_CACHE, (addr), (nbytes), cache)
61
62 #else /* not sonyrisc */
63
64 #if 0
65
66 /* advertised, but not provided */
67 extern void cacheflush();
68
69 #else /* not 0 */
70
71 #include <sys/syscall.h>
72 #include <sys/sysmips.h>
73 #include <mips/cachectl.h>
74
75 extern void syscall();
76
77 #define cacheflush(addr,nbytes,cache) \
78 syscall (SYS_sysmips, MIPS_CACHEFLUSH, (addr), (nbytes), (cache))
79
80 #endif /* not 0 */
81
82 #endif /* not sonyrisc */
83 #endif /* not _IRIX */
84
85 #ifdef USE_MPROTECT_CACHE_FLUSH
86 #define FLUSH_BOTH call_mprotect
87 #else
88 #define FLUSH_BOTH(addr, size) cacheflush ((addr), (size), BCACHE)
89 #endif
90
91 /* Machine parameters to be set by the user. */
92
93 /* Until cmpaux-mips.m4 is updated. */
94 #define CMPINT_USE_STRUCS
95
96 /* Processor type. Choose a number from the above list, or allocate your own. */
97
98 #define COMPILER_PROCESSOR_TYPE COMPILER_MIPS_TYPE
99
100 /* Size (in long words) of the contents of a floating point register if
101 different from a double. For example, an MC68881 saves registers
102 in 96 bit (3 longword) blocks.
103 Default is fine for MIPS.
104 define COMPILER_TEMP_SIZE 3
105 */
106
107 #define COMPILER_REGBLOCK_N_TEMPS 256
108
109 /* Descriptor size.
110 This is the size of the offset field, and of the format field.
111 This definition probably does not need to be changed.
112 */
113
114 typedef unsigned short format_word;
115
116 /* Utilities for manipulating absolute subroutine calls.
117 On the MIPS this is done with:
118 JAL destination
119 The low 26 bits of the instruction form the low 28 bits of address,
120 and the top 4 bits of the address of the JAL instruction form the
121 top 4 bits of the address.
122 */
123
124 #define EXTRACT_FROM_JAL_INSTR(target, address) \
125 { \
126 unsigned long * addr = ((unsigned long *) (address)); \
127 unsigned long jal_instr = (*addr); \
128 (target) = \
129 ((SCHEME_OBJECT) \
130 ((((long) (address)) & 0xF0000000) | \
131 ((jal_instr & 0x03FFFFFF) << 2))); \
132 }
133
134 #define JAL_OP (003 << 26)
135 #define JAL_INSTR(dest) (JAL_OP | ((dest) >> 2))
136
137 #define STORE_JAL_INSTR(entry_point, address) \
138 { \
139 unsigned long ep = ((unsigned long) (entry_point)); \
140 unsigned long * addr = ((unsigned long *) (address)); \
141 if (((((long) addr) & 0xF0000000) \
142 != (((long) entry_point) & 0xF0000000)) \
143 || ((((long) addr) & 0x3) != 0)) \
144 { \
145 fprintf (stderr, \
146 "\nSTORE_JAL_INSTR: Bad addr in JAL 0x%x, 0x%x\n", \
147 addr, ep); \
148 } \
149 (*addr) = JAL_INSTR (ep & 0x0FFFFFFF); \
150 }
151
152 /* Compiled Code Register Conventions */
153 /* This must match the compiler and cmpaux-mips.s */
154
155 #define COMP_REG_TEMPORARY 1
156 #define COMP_REG_RETURN 2
157 #define COMP_REG_STACK 3
158 #define COMP_REG_C_ARG_1 4
159 #define COMP_REG_C_ARG_2 5
160 #define COMP_REG_C_ARG_3 6
161 #define COMP_REG_C_ARG_4 7
162 #define COMP_REG_MEMTOP 8
163 #define COMP_REG_FREE 9
164 #define COMP_REG_SCHEME_TO_INTERFACE 10
165 #define COMP_REG_DYNAMIC_LINK 11
166
167 #define COMP_REG_CLOSURE_FREE 19
168 #define COMP_REG_ADDRESS_MASK 20
169 #define COMP_REG_REGISTERS 21
170 #define COMP_REG_QUAD_MASK 22
171 #define COMP_REG_CLOSURE_HOOK 23
172
173 #define COMP_REG_TRAMP_INDEX 25
174 #define COMP_REG_KERNEL_RESERVED_1 26
175 #define COMP_REG_KERNEL_RESERVED_2 27
176 #define COMP_REG_C_GLOBALS 28
177 #define COMP_REG_C_STACK 29
178 #define COMP_REG_LINKAGE 31
179
180 /* Interrupt/GC polling. */
181
182 /* The length of the GC recovery code that precedes an entry.
183 On the MIPS a "addi, jalr, addi" instruction sequence.
184 */
185
186 #define ENTRY_PREFIX_LENGTH 12
187
188 /*
189 The instructions for a normal entry should be something like
190
191 SLT $at,$FREE,$MEMTOP
192 BEQ $at,$0,interrupt
193 LW $MEMTOP,REG_BLOCK
194
195 For a closure
196
197 LUI $at,FROB(TC_CLOSURE) ; temp <- closure tag
198 XOR $31,$31,$at ; 31 <- tagged value
199 ADDI $SP,$SP,-4 ; push closure
200 SW $31,0($SP)
201 SLT $at,$FREE,$MEMTOP
202 BEQ $at,$0,interrupt
203 LW $MEMTOP,REG_BLOCK
204 */
205
206 /* A NOP on machines where instructions are longword-aligned. */
207
208 #define ADJUST_CLOSURE_AT_CALL(entry_point, location) \
209 do { \
210 } while (0)
211
212 /* Compiled closures */
213
214 /* Manifest closure entry block size.
215 Size in bytes of a compiled closure's header excluding the
216 TC_MANIFEST_CLOSURE header.
217
218 On the MIPS this is 2 format_words for the format word and gc
219 offset words, and 8 more bytes for 2 instructions.
220
221 The two instructions are
222
223 JAL destination
224 ADDI LINKAGE,LINKAGE,-8
225
226 However, there is some trickery involved. Because of cache-line
227 sizes and prefetch buffers, the straight-forward allocation does
228 not always work, thus closures are allocated from a pre-initialized
229 pool where the entries have been initialized to contain
230 the following instructions.
231
232 JALR LINKAGE,CLOSURE_HOOK
233 ADDI LINKAGE,LINKAGE,-8
234
235 Note that the JALR instruction is overwritten with the JAL
236 instruction, thus although the I-cache may have a stale instruction,
237 execution will be correct, since the stale instruction will jump
238 to an out-of-line handler which will fetch the correct destination
239 from the return-address (through the D cache) and jump there.
240 */
241
242 #define COMPILED_CLOSURE_ENTRY_SIZE 12
243
244 /* Manifest closure entry destructuring.
245
246 Given the entry point of a closure, extract the `real entry point'
247 (the address of the real code of the procedure, ie. one indirection)
248 from the closure.
249 On the MIPS, the real entry point is stored directly 8 bytes from
250 the closure's address (address of JAL or JALR instruction).
251 When using the JAL format, it is also the target address encoded
252 in the instruction.
253 */
254
255 #define EXTRACT_CLOSURE_ENTRY_ADDRESS(extracted_ep, clos_addr) do \
256 { \
257 EXTRACT_FROM_JAL_INSTR (extracted_ep, clos_addr); \
258 } while (0)
259
260 /* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
261 Given a closure's entry point and a code entry point, store the
262 code entry point in the closure.
263 */
264
265 #define STORE_CLOSURE_ENTRY_ADDRESS(ep_to_store, clos_addr) do \
266 { \
267 STORE_JAL_INSTR (ep_to_store, clos_addr); \
268 } while (0)
269
270 /* Trampolines
271
272 On the MIPS, here's a picture of a trampoline (offset in bytes from
273 entry point)
274
275 -12: MANIFEST vector header
276 - 8: NON_MARKED header
277 - 4: Format word
278 - 2: 0x6 (GC Offset to start of block from .+2)
279 Note the encoding -- divided by 2, low bit for
280 extended distances (see OFFSET_WORD_TO_BYTE_OFFSET)
281 0: ADDI TEMP,SCHEME_TO_INTERFACE,-96
282 4: JALR LINKAGE,TEMP
283 8: ADDI TRAMP_INDEX,0,index
284 12: trampoline dependent storage (0 - 3 longwords)
285
286 TRAMPOLINE_ENTRY_SIZE is the size in longwords of the machine
287 dependent portion of a trampoline, including the GC and format
288 headers. The code in the trampoline must store an index (used to
289 determine which C SCHEME_UTILITY procedure to invoke) in a
290 register, jump to "scheme_to_interface" and leave the address of
291 the storage following the code in a standard location.
292
293 TRAMPOLINE_ENTRY_POINT returns the address of the entry point of a
294 trampoline when given the address of the word containing
295 the manifest vector header. According to the above picture,
296 it would add 12 bytes to its argument.
297
298 TRAMPOLINE_STORAGE takes the address of the first instruction in a
299 trampoline (not the start of the trampoline block) and returns the
300 address of the first storage word in the trampoline.
301
302 STORE_TRAMPOLINE_ENTRY gets the address of the first instruction in
303 the trampoline and stores the instructions. It also receives the
304 index of the C SCHEME_UTILITY to be invoked.
305 */
306
307 #define TRAMPOLINE_ENTRY_SIZE 4
308 #define TRAMPOLINE_BLOCK_TO_ENTRY 3
309
310 #define TRAMPOLINE_ENTRY_POINT(tramp_block) \
311 (((SCHEME_OBJECT *) (tramp_block)) + TRAMPOLINE_BLOCK_TO_ENTRY)
312
313 #define TRAMPOLINE_STORAGE(tramp_entry) \
314 ((((SCHEME_OBJECT *) (tramp_entry)) - TRAMPOLINE_BLOCK_TO_ENTRY) + \
315 (2 + TRAMPOLINE_ENTRY_SIZE))
316
317 #define SPECIAL_OPCODE 000
318 #define ADDI_OPCODE 010
319
320 #define OP(OPCODE) (OPCODE << 26)
321 #define SPECIAL_OP OP(SPECIAL_OPCODE)
322 #define ADDI_OP OP(ADDI_OPCODE)
323
324 #define JALR_OP (SPECIAL_OP | (011))
325 #define JALR_SRC(n) ((n & 0x1F) << 21)
326 #define JALR_DST(n) ((n & 0x1F) << 11)
327 #define JALR(d,s) (JALR_OP|JALR_SRC(s)|JALR_DST(d))
328
329 #define ADDI_SRC(n) ((n & 0x1F) << 21)
330 #define ADDI_DST(n) ((n & 0x1F) << 16)
331 #define ADDI_IMMED(n) (n & 0xFFFF)
332 #define ADDI(d,s,imm) (ADDI_OP|ADDI_SRC(s)|ADDI_DST(d)|ADDI_IMMED(imm))
333
334 #define STORE_TRAMPOLINE_ENTRY(entry_address, index) \
335 { unsigned long *PC; \
336 PC = ((unsigned long *) (entry_address)); \
337 PC[0] = ADDI(COMP_REG_TEMPORARY, COMP_REG_SCHEME_TO_INTERFACE, -96); \
338 PC[1] = JALR(COMP_REG_LINKAGE, COMP_REG_TEMPORARY); \
339 PC[2] = ADDI(COMP_REG_TRAMP_INDEX, 0, (4*index)); \
340 /* assumes index fits in 16 bits */ \
341 FLUSH_BOTH (PC, (3 * sizeof (unsigned long))); \
342 }
343
344 /* Execute cache entries.
345
346 Execute cache entry size size in longwords. The cache itself
347 contains both the number of arguments provided by the caller and
348 code to jump to the destination address. Before linkage, the cache
349 contains the callee's name instead of the jump code.
350
351 On MIPS: 2 instructions, the last being a NO-OP (ADDI with
352 destination 0) containing a fixnum representing the number of
353 arguments in the lower 16 bits.
354 */
355
356 #define EXECUTE_CACHE_ENTRY_SIZE 2
357
358 /* Execute cache destructuring. */
359
360 /* Given a target location and the address of the first word of an
361 execute cache entry, extract from the cache cell the number of
362 arguments supplied by the caller and store it in target. */
363
364 /* For the MIPS (little endian), addresses in bytes from the start of
365 the cache:
366
367 Before linking
368 +0: TC_SYMBOL || symbol address
369 +4: number of supplied arguments, +1
370 +6: TC_FIXNUM || 0
371
372 After linking
373 +0: JAL destination
374 +4: (unchanged)
375 +6: ADDI 0, arg count
376
377 (big endian):
378
379 Before linking
380 +0: TC_SYMBOL || symbol address
381 +4: TC_FIXNUM || 0
382 +6: number of supplied arguments, +1
383
384 After linking
385 +0: JAL destination
386 +4: ADDI 0, arg count
387 +6: (unchanged)
388
389 */
390
391 #ifdef MIPSEL
392
393 /* Little-endian MIPS, i.e. DecStations. */
394
395 #define MIPS_CACHE_ARITY_OFFSET 2
396 #define MIPS_CACHE_CODE_OFFSET 7
397
398 #else /* not MIPSEL */
399
400 /* Big-endian MIPS, e.g. SGI and Sony. */
401
402 #define MIPS_CACHE_ARITY_OFFSET 3
403 #define MIPS_CACHE_CODE_OFFSET 4
404
405 #endif /* not MIPSEL */
406
407 #define EXTRACT_EXECUTE_CACHE_ARITY(target, address) \
408 { \
409 (target) = \
410 ((long) \
411 (((unsigned short *) (address)) [MIPS_CACHE_ARITY_OFFSET])); \
412 }
413
414 #define EXTRACT_EXECUTE_CACHE_SYMBOL(target, address) \
415 { \
416 (target) = (* (((SCHEME_OBJECT *) (address)))); \
417 }
418
419 /* Extract the target address (not the code to get there) from an
420 execute cache cell.
421 */
422
423 #define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address) \
424 { \
425 EXTRACT_FROM_JAL_INSTR (target, address); \
426 }
427
428 /* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS.
429 On the MIPS it must flush the I-cache, but there is no
430 need to flush the ADDI instruction, which is a NOP.
431 */
432
433 #define STORE_EXECUTE_CACHE_ADDRESS(address, entry) \
434 { \
435 STORE_JAL_INSTR (entry, address); \
436 }
437
438 /* This stores the fixed part of the instructions leaving the
439 destination address and the number of arguments intact. These are
440 split apart so the GC can call EXTRACT/STORE...ADDRESS but it does
441 NOT need to store the instructions back. On some architectures the
442 instructions may change due to GC and then STORE_EXECUTE_CACHE_CODE
443 should become a no-op and all of the work is done by
444 STORE_EXECUTE_CACHE_ADDRESS instead.
445 */
446
447 #define STORE_EXECUTE_CACHE_CODE(address) \
448 { \
449 char * opcode_addr = (((char *) (address)) + MIPS_CACHE_CODE_OFFSET); \
450 (*opcode_addr) = (ADDI_OPCODE << 2); \
451 }
452
453 /* This flushes the Scheme portion of the I-cache.
454 It is used after a GC or disk-restore.
455 It's needed because the GC has moved code around, and closures
456 and execute cache cells have absolute addresses that the
457 processor might have old copies of.
458 */
459
460 #define FLUSH_I_CACHE() do \
461 { \
462 FLUSH_BOTH (constant_start, \
463 (((unsigned long) heap_end) \
464 - ((unsigned long) constant_start))); \
465 } while (0)
466
467 /* This flushes a region of the I-cache.
468 It is used after updating an execute cache while running.
469 Not needed during GC because FLUSH_I_CACHE will be used.
470 */
471
472 #define FLUSH_I_CACHE_REGION(address, nwords) do \
473 { \
474 FLUSH_BOTH ((address), ((sizeof (long)) * (nwords))); \
475 } while (0)
476
477 /* This guarantees that a newly-written section of address space
478 has its values propagated to main memory so that i-stream fetches
479 will see the new values.
480 The first and last byte are flushed from the i-cache in case
481 the written region overlaps with already-executed areas.
482 */
483
484 #ifdef USE_MPROTECT_CACHE_FLUSH
485
486 #define PUSH_D_CACHE_REGION(address, nwords) do \
487 { \
488 FLUSH_BOTH ((address), ((sizeof (long)) * (nwords))); \
489 } while (0)
490
491 #else /* not USE_MPROTECT_CACHE_FLUSH */
492
493 #define PUSH_D_CACHE_REGION(address, nwords) do \
494 { \
495 unsigned long _addr = ((unsigned long) (address)); \
496 unsigned long _nbytes = ((sizeof (long)) * (nwords)); \
497 cacheflush (((void *) _addr), _nbytes, DCACHE); \
498 cacheflush (((void *) _addr), 1, ICACHE); \
499 cacheflush (((void *) (_addr + (_nbytes - 1))), 1, ICACHE); \
500 } while (0)
501
502 #endif /* not USE_MPROTECT_CACHE_FLUSH */
503
504 #ifdef IN_CMPINT_C
505
506 static void
interface_initialize_C(void)507 interface_initialize_C (void)
508 {
509 extern void interface_initialize (void);
510
511 /* Prevent the OS from "fixing" unaligned accesses.
512 Within Scheme, they are a BUG, and should fault.
513
514 Is this defined for all the OSs?
515 */
516 #ifdef MIPSEL
517 syscall (SYS_sysmips, MIPS_FIXADE, 0);
518 #endif
519 interface_initialize ();
520 return;
521 }
522
523 #ifdef _IRIX6
524
525 #include <sys/mman.h>
526 #include <sys/types.h>
527
528 #define VM_PROT_SCHEME (PROT_READ | PROT_WRITE | PROT_EXEC)
529
530 static void * mprotect_start;
531 static unsigned long mprotect_size;
532
533 static void
call_mprotect_1(void * start,unsigned long size)534 call_mprotect_1 (void * start, unsigned long size)
535 {
536 if ((mprotect (start, size, VM_PROT_SCHEME)) != 0)
537 {
538 perror ("unable to change memory protection");
539 fprintf (stderr, "mprotect(0x%lx, %d (0x%lx), 0x%lx)\n",
540 start, size, size, VM_PROT_SCHEME);
541 Microcode_Termination (TERM_EXIT);
542 /*NOTREACHED*/
543 }
544 }
545
546 #ifdef USE_MPROTECT_CACHE_FLUSH
547 void
call_mprotect(void * start,unsigned long size)548 call_mprotect (void * start, unsigned long size)
549 {
550 unsigned long pagesize = (getpagesize ());
551 unsigned long istart = ((unsigned long) start);
552 unsigned long pstart = ((istart / pagesize) * pagesize);
553 call_mprotect_1 (((void *) pstart), (istart - pstart));
554 }
555 #endif /* USE_MPROTECT_CACHE_FLUSH */
556
557 void *
irix_heap_malloc(long size)558 irix_heap_malloc (long size)
559 {
560 int pagesize = (getpagesize ());
561 void * area = (malloc (size + pagesize));
562 if (area == 0)
563 return (0);
564 mprotect_start
565 = ((void *)
566 (((((unsigned long) area) + (pagesize - 1)) / pagesize) * pagesize));
567 mprotect_size = size;
568 call_mprotect_1 (mprotect_start, mprotect_size);
569 return (mprotect_start);
570 }
571
572 #endif /* _IRIX6 */
573
574 #define ASM_RESET_HOOK interface_initialize_C
575
576 #define CLOSURE_ENTRY_WORDS \
577 (COMPILED_CLOSURE_ENTRY_SIZE / (sizeof (SCHEME_OBJECT)))
578
579 static long closure_chunk = (1024 * CLOSURE_ENTRY_WORDS);
580
581 /* The apparently random instances of the number 3 below arise from
582 the convention that free_closure always points to a JAL instruction
583 with (at least) 3 unused words preceding it.
584 In this way, if there is enough space, we can use free_closure
585 as the address of a new uni- or multi-closure.
586
587 The code below (in the initialization loop) depends on knowing that
588 CLOSURE_ENTRY_WORDS is 3.
589
590 Random hack: ADDI instructions look like TC_TRUE objects, thus of the
591 pre-initialized words, only the JALR looks like a pointer object
592 (an SCODE-QUOTE). Since there is exactly one JALR of waste between
593 closures, and it is always 3 words before free_closure,
594 the code for uni-closure allocation (in mips.m4) bashes that word
595 with 0 (SHARP_F) to make the heap parseable.
596 */
597
598 /* size in Scheme objects of the block we need to allocate. */
599
600 void
allocate_closure(long size)601 allocate_closure (long size)
602 {
603 long space;
604 SCHEME_OBJECT * free_closure, * limit;
605
606 free_closure = GET_CLOSURE_FREE;
607 limit = GET_CLOSURE_SPACE;
608 space = ((limit - free_closure) + 3);
609
610 /* Bump up to a multiple of CLOSURE_ENTRY_WORDS.
611 Otherwise clearing by the allocation code may clobber
612 a different word.
613 */
614 size = (CLOSURE_ENTRY_WORDS
615 * ((size + (CLOSURE_ENTRY_WORDS - 1))
616 / CLOSURE_ENTRY_WORDS));
617 if (size > space)
618 {
619 long chunk_size;
620 SCHEME_OBJECT *ptr;
621
622 /* Make the heap be parseable forward by protecting the waste
623 in the last chunk.
624 */
625
626 if ((space > 0) && (free_closure != ((SCHEME_OBJECT *) NULL)))
627 free_closure[-3] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (space - 1)));
628
629 free_closure = Free;
630 if ((size <= closure_chunk) && (!GC_NEEDED_P (closure_chunk)))
631 limit = (free_closure + closure_chunk);
632 else
633 {
634 if (GC_NEEDED_P (size))
635 {
636 if ((heap_end - Free) < size)
637 {
638 /* No way to back out -- die. */
639 fprintf (stderr, "\nC_allocate_closure (%d): No space.\n", size);
640 Microcode_Termination (TERM_NO_SPACE);
641 /* NOTREACHED */
642 }
643 REQUEST_GC (0);
644 }
645 else if (size <= closure_chunk)
646 REQUEST_GC (0);
647 limit = (free_closure + size);
648 }
649 Free = limit;
650 chunk_size = (limit - free_closure);
651
652 ptr = free_closure;
653 while (ptr < limit)
654 {
655 *ptr++ = (JALR (COMP_REG_LINKAGE, COMP_REG_CLOSURE_HOOK));
656 *ptr++ = (ADDI (COMP_REG_LINKAGE, COMP_REG_LINKAGE, -8));
657 *ptr++ = SHARP_F;
658 }
659 PUSH_D_CACHE_REGION (free_closure, chunk_size);
660 SET_CLOSURE_SPACE (limit);
661 SET_CLOSURE_FREE (free_closure + 3);
662 }
663 }
664
665 #endif /* IN_CMPINT_C */
666
667 /* Derived parameters and macros.
668
669 These macros expect the above definitions to be meaningful.
670 If they are not, the macros below may have to be changed as well.
671 */
672
673 #define COMPILED_ENTRY_OFFSET_WORD(entry) (((format_word *) (entry)) [-1])
674 #define COMPILED_ENTRY_FORMAT_WORD(entry) (((format_word *) (entry)) [-2])
675
676 /* The next one assumes 2's complement integers....*/
677 #define CLEAR_LOW_BIT(word) ((word) & ((unsigned long) -2))
678 #define OFFSET_WORD_CONTINUATION_P(word) (((word) & 1) != 0)
679
680 #define BYTE_OFFSET_TO_OFFSET_WORD(offset) ((offset) >> 1)
681 #define OFFSET_WORD_TO_BYTE_OFFSET(word) ((CLEAR_LOW_BIT (word)) << 1)
682
683 #define MAKE_OFFSET_WORD(entry, block, continue) \
684 ((BYTE_OFFSET_TO_OFFSET_WORD(((char *) (entry)) - \
685 ((char *) (block)))) | \
686 ((continue) ? 1 : 0))
687
688 #define EXECUTE_CACHE_COUNT_TO_ENTRIES(count) \
689 ((count) >> 1)
690 #define EXECUTE_CACHE_ENTRIES_TO_COUNT(entries) \
691 ((entries) << 1)
692
693 /* The first entry in a cc block is preceeded by 2 headers (block and nmv),
694 a format word and a gc offset word. See the early part of the
695 TRAMPOLINE picture, above.
696 */
697
698 #define CC_BLOCK_FIRST_ENTRY_OFFSET \
699 (2 * ((sizeof(SCHEME_OBJECT)) + (sizeof(format_word))))
700
701 /* Format words */
702
703 #define FORMAT_BYTE_EXPR 0xFF
704 #define FORMAT_BYTE_COMPLR 0xFE
705 #define FORMAT_BYTE_CMPINT 0xFD
706 #define FORMAT_BYTE_DLINK 0xFC
707 #define FORMAT_BYTE_RETURN 0xFB
708
709 #define FORMAT_WORD_EXPR (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_EXPR))
710 #define FORMAT_WORD_CMPINT (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_CMPINT))
711 #define FORMAT_WORD_RETURN (MAKE_FORMAT_WORD(0xFF, FORMAT_BYTE_RETURN))
712
713 /* This assumes that a format word is at least 16 bits,
714 and the low order field is always 8 bits.
715 */
716
717 #define MAKE_FORMAT_WORD(field1, field2) \
718 (((field1) << 8) | ((field2) & 0xff))
719
720 #define SIGN_EXTEND_FIELD(field, size) \
721 (((field) & ((1 << (size)) - 1)) | \
722 ((((field) & (1 << ((size) - 1))) == 0) ? 0 : \
723 ((-1) << (size))))
724
725 #define FORMAT_WORD_LOW_BYTE(word) \
726 (SIGN_EXTEND_FIELD ((((unsigned long) (word)) & 0xff), 8))
727
728 #define FORMAT_WORD_HIGH_BYTE(word) \
729 (SIGN_EXTEND_FIELD \
730 ((((unsigned long) (word)) >> 8), \
731 (((sizeof (format_word)) * CHAR_BIT) - 8)))
732
733 #define COMPILED_ENTRY_FORMAT_HIGH(addr) \
734 (FORMAT_WORD_HIGH_BYTE (COMPILED_ENTRY_FORMAT_WORD (addr)))
735
736 #define COMPILED_ENTRY_FORMAT_LOW(addr) \
737 (FORMAT_WORD_LOW_BYTE (COMPILED_ENTRY_FORMAT_WORD (addr)))
738
739 #define FORMAT_BYTE_FRAMEMAX 0x7f
740
741 #define COMPILED_ENTRY_MAXIMUM_ARITY COMPILED_ENTRY_FORMAT_LOW
742 #define COMPILED_ENTRY_MINIMUM_ARITY COMPILED_ENTRY_FORMAT_HIGH
743
744 #endif /* !SCM_CMPINTMD_H_INCLUDED */
745