From 463bbd70bde645ff174435602cb27dcdc72db150 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Thu, 20 Aug 1992 01:12:39 +0000 Subject: [PATCH] New MIPS closure code. Works on newer R3000 systems (with larger cache-line sizes) and on R4000 systems in 32-bit mode. --- v7/src/microcode/cmpintmd/mips.h | 186 ++++++++++++++++++++++++++----- 1 file changed, 156 insertions(+), 30 deletions(-) diff --git a/v7/src/microcode/cmpintmd/mips.h b/v7/src/microcode/cmpintmd/mips.h index d770d1ce0..b9ff3bb4a 100644 --- a/v7/src/microcode/cmpintmd/mips.h +++ b/v7/src/microcode/cmpintmd/mips.h @@ -1,6 +1,6 @@ /* -*-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 @@ -44,6 +44,18 @@ MIT in each case. */ #ifndef CMPINT2_H_INCLUDED #define CMPINT2_H_INCLUDED +#ifdef _IRIX4 + +#include + +/* 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 @@ -78,18 +90,20 @@ extern void syscall(); #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 /* Machine parameters to be set by the user. */ @@ -126,7 +140,7 @@ typedef unsigned short format_word; 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); \ @@ -139,7 +153,7 @@ typedef unsigned short format_word; #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)); \ @@ -148,7 +162,7 @@ typedef unsigned short format_word; || ((((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); \ @@ -169,9 +183,11 @@ typedef unsigned short format_word; #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 @@ -197,20 +213,20 @@ procedures and continuations differ from closures) */ /* 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. */ @@ -225,10 +241,27 @@ do { \ 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 @@ -238,25 +271,26 @@ do { \ 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) /* Trampolines @@ -408,7 +442,7 @@ do { \ #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. @@ -418,7 +452,7 @@ do { \ #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 @@ -436,8 +470,6 @@ do { \ (*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 @@ -469,11 +501,105 @@ extern void EXFUN (interface_initialize, (void)); 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 */ /* Derived parameters and macros. -- 2.25.1