/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/mips.h,v 1.11 1992/02/12 15:31:02 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/mips.h,v 1.12 1992/08/20 01:12:39 jinx Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
#ifndef CMPINT2_H_INCLUDED
#define CMPINT2_H_INCLUDED
+#ifdef _IRIX4
+
+#include <sys/cachectl.h>
+
+/* This assumes a write-through cache. Otherwise BCACHE should be used,
+ and PUSH_D_CACHE_REGION should be separated and use DCACHE.
+ */
+
+#define ICACHEFLUSH(addr, nbytes) \
+ cacheflush ((addr), (nbytes), ICACHE)
+
+#else /* not _IRIX4 */
#ifdef sonyrisc
#include <sys/syscall.h>
#define ICACHEFLUSH(addr, nbytes) cacheflush ((addr), (nbytes), ICACHE)
#endif /* not sonyrisc */
+#endif /* not _IRIX4 */
#define COMPILER_NONE_TYPE 0
#define COMPILER_MC68020_TYPE 1
#define COMPILER_VAX_TYPE 2
#define COMPILER_SPECTRUM_TYPE 3
-#define COMPILER_MIPS_TYPE 4
+#define COMPILER_OLD_MIPS_TYPE 4
#define COMPILER_MC68040_TYPE 5
#define COMPILER_SPARC_TYPE 6
#define COMPILER_RS6000_TYPE 7
#define COMPILER_MC88K_TYPE 8
#define COMPILER_I386_TYPE 9
#define COMPILER_ALPHA_TYPE 10
+#define COMPILER_MIPS_TYPE 11
\f
/* Machine parameters to be set by the user. */
top 4 bits of the address.
*/
-#define EXTRACT_ABSOLUTE_ADDRESS(target, address) \
+#define EXTRACT_FROM_JAL_INSTR(target, address) \
{ \
unsigned long * addr = ((unsigned long *) (address)); \
unsigned long jal_instr = (*addr); \
#define JAL_OP (003 << 26)
#define JAL_INSTR(dest) (JAL_OP | ((dest) >> 2))
-#define STORE_ABSOLUTE_ADDRESS(entry_point, address) \
+#define STORE_JAL_INSTR(entry_point, address) \
{ \
unsigned long ep = ((unsigned long) (entry_point)); \
unsigned long * addr = ((unsigned long *) (address)); \
|| ((((long) addr) & 0x3) != 0)) \
{ \
fprintf (stderr, \
- "\nSTORE_ABSOLUTE_ADDRESS: Bad addr in JAL 0x%x, 0x%x\n", \
+ "\nSTORE_JAL_INSTR: Bad addr in JAL 0x%x, 0x%x\n", \
addr, ep); \
} \
(*addr) = JAL_INSTR (ep & 0x0FFFFFFF); \
#define COMP_REG_SCHEME_TO_INTERFACE 10
#define COMP_REG_DYNAMIC_LINK 11
+#define COMP_REG_CLOSURE_FREE 19
#define COMP_REG_ADDRESS_MASK 20
#define COMP_REG_REGISTERS 21
#define COMP_REG_QUAD_MASK 22
+#define COMP_REG_CLOSURE_HOOK 23
#define COMP_REG_TRAMP_INDEX 25
#define COMP_REG_KERNEL_RESERVED_1 26
/*
The instructions for a normal entry should be something like
- SLT $at,FREE,MEMTOP
- BEQ $at,0,interrupt
- LW MEMTOP,REG_BLOCK
+ SLT $at,$FREE,$MEMTOP
+ BEQ $at,$0,interrupt
+ LW $MEMTOP,REG_BLOCK
For a closure
- LUI $at,TC_CLOSURE ; temp <- closure tag
- XOR 31,31,$at ; 31 <- tagged value
- ADDI SP,SP,-4 ; push closure
- SW 31,-4(SP)
- SLT $at,FREE,MEMTOP
- BEQ $at,0,interrupt
- LW MEMTOP,REG_BLOCK
- */
+ LUI $at,FROB(TC_CLOSURE) ; temp <- closure tag
+ XOR $31,$31,$at ; 31 <- tagged value
+ ADDI $SP,$SP,-4 ; push closure
+ SW $31,0($SP)
+ SLT $at,$FREE,$MEMTOP
+ BEQ $at,$0,interrupt
+ LW $MEMTOP,REG_BLOCK
+*/
/* A NOP on machines where instructions are longword-aligned. */
TC_MANIFEST_CLOSURE header.
On the MIPS this is 2 format_words for the format word and gc
- offset words, and 8 more bytes for 2 instructions:
+ offset words, and 8 more bytes for 2 instructions.
+
+ The two instructions are
JAL destination
ADDI LINKAGE,LINKAGE,-8
+
+ However, there is some trickery involved. Because of cache-line
+ sizes and prefetch buffers, the straight-forward allocation does
+ not always work, thus closures are allocated from a pre-initialized
+ pool where the entries have been initialized to contain
+ the following instructions.
+
+ JALR LINKAGE,CLOSURE_HOOK
+ ADDI LINKAGE,LINKAGE,-8
+
+ Note that the JALR instruction is overwritten with the JAL
+ instruction, thus although the I-cache may have a stale instruction,
+ execution will be correct, since the stale instruction will jump
+ to an out-of-line handler which will fetch the correct destination
+ from the return-address (through the D cache) and jump there.
*/
#define COMPILED_CLOSURE_ENTRY_SIZE 12
Given the entry point of a closure, extract the `real entry point'
(the address of the real code of the procedure, ie. one indirection)
from the closure.
- On the MIPS, the real entry point is constructed from the JAL
- instruction (low 26 bits) and the address of the closure (top 4
- bits).
+ On the MIPS, the real entry point is stored directly 8 bytes from
+ the closure's address (address of JAL or JALR instruction).
+ When using the JAL format, it is also the target address encoded
+ in the instruction.
*/
-#define EXTRACT_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point) \
+#define EXTRACT_CLOSURE_ENTRY_ADDRESS(extracted_ep, clos_addr) do \
{ \
- EXTRACT_ABSOLUTE_ADDRESS (real_entry_point, entry_point); \
-}
+ EXTRACT_FROM_JAL_INSTR (extracted_ep, clos_addr); \
+} while (0)
/* This is the inverse of EXTRACT_CLOSURE_ENTRY_ADDRESS.
Given a closure's entry point and a code entry point, store the
code entry point in the closure.
*/
-#define STORE_CLOSURE_ENTRY_ADDRESS(real_entry_point, entry_point) \
+#define STORE_CLOSURE_ENTRY_ADDRESS(ep_to_store, clos_addr) do \
{ \
- STORE_ABSOLUTE_ADDRESS (real_entry_point, entry_point); \
-}
+ STORE_JAL_INSTR (ep_to_store, clos_addr); \
+} while (0)
\f
/* Trampolines
#define EXTRACT_EXECUTE_CACHE_ADDRESS(target, address) \
{ \
- EXTRACT_ABSOLUTE_ADDRESS (target, address); \
+ EXTRACT_FROM_JAL_INSTR (target, address); \
}
/* This is the inverse of EXTRACT_EXECUTE_CACHE_ADDRESS.
#define STORE_EXECUTE_CACHE_ADDRESS(address, entry) \
{ \
- STORE_ABSOLUTE_ADDRESS (entry, address); \
+ STORE_JAL_INSTR (entry, address); \
}
/* This stores the fixed part of the instructions leaving the
(*opcode_addr) = (ADDI_OPCODE << 2); \
}
-extern void EXFUN (interface_initialize, (void));
-
/* This flushes the Scheme portion of the I-cache.
It is used after a GC or disk-restore.
It's needed because the GC has moved code around, and closures
ICACHEFLUSH ((address), ((sizeof (long)) * (nwords))); \
} while (0)
+#define PUSH_D_CACHE_REGION FLUSH_I_CACHE_REGION
+
+/* The following is misnamed.
+ It should really be called STORE_BACK_D_CACHE.
+ Neither the R2000 nor the R3000 systems have them.
+ I don't know about the R4000 or R6000.
+ */
+
+/* #define SPLIT_CACHES */
#ifdef IN_CMPINT_C
#define ASM_RESET_HOOK interface_initialize
+#define CLOSURE_ENTRY_WORDS \
+ (COMPILED_CLOSURE_ENTRY_SIZE / (sizeof (SCHEME_OBJECT)))
+
+static long closure_chunk = (1024 * CLOSURE_ENTRY_WORDS);
+
+#define REGBLOCK_CLOSURE_LIMIT REGBLOCK_CLOSURE_SPACE
+
+/* The apparently random instances of the number 3 below arise from
+ the convention that free_closure always points to a JAL instruction
+ with (at least) 3 unused words preceding it.
+ In this way, if there is enough space, we can use free_closure
+ as the address of a new uni- or multi-closure.
+
+ The code below (in the initialization loop) depends on knowing that
+ CLOSURE_ENTRY_WORDS is 3.
+
+ Random hack: ADDI instructions look like TC_TRUE objects, thus of the
+ pre-initialized words, only the JALR looks like a pointer object
+ (an SCODE-QUOTE). Since there is exactly one JALR of waste between
+ closures, and it is always 3 words before free_closure,
+ the code for uni-closure allocation (in mips.m4) bashes that word
+ with 0 (SHARP_F) to make the heap parseable.
+ */
+
+/* size in Scheme objects of the block we need to allocate. */
+
+void
+DEFUN (allocate_closure, (size), long size)
+{
+ long space;
+ SCHEME_OBJECT * free_closure, * limit;
+
+ free_closure = ((SCHEME_OBJECT *) Registers[REGBLOCK_CLOSURE_FREE]);
+ limit = ((SCHEME_OBJECT *) Registers[REGBLOCK_CLOSURE_LIMIT]);
+ space = ((limit - free_closure) + 3);
+
+ if (size > space)
+ {
+ long chunk_size;
+ SCHEME_OBJECT *ptr;
+
+ /* Make the heap be parseable forward by protecting the waste
+ in the last chunk.
+ */
+
+ if ((space > 0) && (free_closure != ((SCHEME_OBJECT) NULL)))
+ free_closure[-3] = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (space - 1)));
+
+ free_closure = Free;
+ if ((size <= closure_chunk) && (!(GC_Check (closure_chunk))))
+ limit = (free_closure + closure_chunk);
+ else
+ {
+ if (GC_Check (size))
+ {
+ if ((Heap_Top - Free) < size)
+ {
+ /* No way to back out -- die. */
+ fprintf (stderr, "\nC_allocate_closure (%d): No space.\n", size);
+ Microcode_Termination (TERM_NO_SPACE);
+ /* NOTREACHED */
+ }
+ Request_GC (0);
+ }
+ else if (size <= closure_chunk)
+ Request_GC (0);
+ limit = (free_closure + size);
+ }
+ Free = limit;
+ chunk_size = (limit - free_closure);
+
+ ptr = free_closure;
+ while (ptr < limit)
+ {
+ *ptr++ = (JALR (COMP_REG_LINKAGE, COMP_REG_CLOSURE_HOOK));
+ *ptr++ = (ADDI (COMP_REG_LINKAGE, COMP_REG_LINKAGE, -8));
+ *ptr++ = SHARP_F;
+ }
+ PUSH_D_CACHE_REGION (free_closure, chunk_size);
+ Registers[REGBLOCK_CLOSURE_LIMIT] = ((SCHEME_OBJECT) limit);
+ Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) (free_closure + 3));
+ }
+ return;
+}
+
#endif /* IN_CMPINT_C */
\f
/* Derived parameters and macros.
projects / mit-scheme.git / commitdiff