/* -*-C-*- $Id: cmpgc.h,v 1.34 2003/02/14 18:28:18 cph Exp $ Copyright (c) 1989-2001 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. MIT/GNU Scheme is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with MIT/GNU Scheme; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Utilities to relocate compiled code in garbage collection-like processes. This file is included by gccode.h. See cmpint.txt, cmpint.c, cmpint-md.h, and cmpaux-md.m4 for more details. */ #ifndef CMPGC_H_INCLUDED #define CMPGC_H_INCLUDED #define NOP() do {} while (0) /* A useful macro */ /* These are needed whether or not there is a compiler, so their definition must be outside the HAS_COMPILER_SUPPORT ifdef. */ #define OPERATOR_LINKAGE_KIND 0x000000 #define REFERENCE_LINKAGE_KIND 0x010000 #define ASSIGNMENT_LINKAGE_KIND 0x020000 #define GLOBAL_OPERATOR_LINKAGE_KIND 0x030000 #define CLOSURE_PATTERN_LINKAGE_KIND 0x040000 #ifdef HAS_COMPILER_SUPPORT #include "cmpintmd.h" /* The following is a kludge which is used to get return_to_interpreter to work. The return to interpreter block is never dumped on normal bin files, but is dumped in complete bands. As long as it does not change in position with respect to the beginning of constant space, it will be relocated correctly on reload. */ #ifndef In_Fasdump #define COMPILED_CODE_PRE_TEST(then_what) #else extern SCHEME_OBJECT compiler_utilities; #define COMPILED_CODE_PRE_TEST(then_what) \ if (Old == (OBJECT_ADDRESS (compiler_utilities))) \ then_what; \ else #endif /* The following code handles compiled entry points, where the addresses point to the "middle" of the code vector. From the entry address, the offset word can be extracted, and this offset allows us to find the beginning of the block, so it can be copied as a whole. The broken heart for the whole block lives in its usual place (first word in the vector). The offset word contains an encoding of the offset and an encoding of whether the resulting pointer points to the beginning of the block or is another entry, so the process may have to be repeated. Pointers to char are used here because compiled entry points do not in general point to Pointer boundaries. */ #define Get_Compiled_Block(var, address) \ { \ long offset_word; \ \ var = (address); \ \ do \ { \ offset_word = (COMPILED_ENTRY_OFFSET_WORD(var)); \ var = ((SCHEME_OBJECT *) \ (((char *) (var)) \ - ((long) (OFFSET_WORD_TO_BYTE_OFFSET(offset_word))))); \ } while (OFFSET_WORD_CONTINUATION_P (offset_word)); \ } #define RELOCATE_COMPILED_INTERNAL(addr, new_block, old_block) \ ((SCHEME_OBJECT *) \ (((char *) new_block) \ + (((char *) (addr)) - ((char *) old_block)))) #define RELOCATE_COMPILED_RAW_ADDRESS(addr, new_block, old_block) \ (ADDR_TO_SCHEME_ADDR \ (RELOCATE_COMPILED_INTERNAL ((SCHEME_ADDR_TO_ADDR (addr)), \ new_block, old_block))) #define RELOCATE_COMPILED_ADDRESS(object, new_block, old_block) \ ((SCHEME_OBJECT *) \ (RELOCATE_COMPILED_INTERNAL ((OBJECT_ADDRESS (object)), \ new_block, old_block))) #define RELOCATE_COMPILED(object, new_block, old_block) \ MAKE_POINTER_OBJECT ((OBJECT_TYPE (object)), \ (RELOCATE_COMPILED_ADDRESS (object, new_block, \ old_block))) #define Compiled_BH(In_GC, then_what) \ { \ /* Has it already been relocated? */ \ \ Get_Compiled_Block (Old, Old); \ COMPILED_CODE_PRE_TEST (then_what) \ if (BROKEN_HEART_P (* Old)) \ { \ Temp = (RELOCATE_COMPILED (Temp, (OBJECT_ADDRESS (* Old)), Old)); \ then_what; \ } \ } #define RAW_COMPILED_BH(In_GC, then_what) \ { \ Get_Compiled_Block (Old, Old); \ COMPILED_CODE_PRE_TEST (then_what) \ if (BROKEN_HEART_P (* Old)) \ { \ Temp = (RELOCATE_COMPILED_RAW_ADDRESS (Temp, \ (OBJECT_ADDRESS (* Old)), \ Old)); \ then_what; \ } \ } #ifdef AUTOCLOBBER_BUG # define AUTOCLOBBER_BUMP(Old, To) do \ { \ if ((OBJECT_TYPE (* Old)) == TC_MANIFEST_VECTOR) \ { \ *To = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, \ ((PAGE_SIZE / (sizeof (SCHEME_OBJECT))) \ - 1))); \ To += (PAGE_SIZE / (sizeof (SCHEME_OBJECT))); \ } \ } while (0) #else # define AUTOCLOBBER_BUMP(Old, To) do { } while (0) #endif #define Transport_Compiled() do \ { \ SCHEME_OBJECT * Saved_Old = Old; \ \ Real_Transport_Vector (); \ AUTOCLOBBER_BUMP (Saved_Old, To); \ *Saved_Old = New_Address; \ Temp = (RELOCATE_COMPILED (Temp, \ (OBJECT_ADDRESS (New_Address)), \ Saved_Old)); \ } while (0) #define TRANSPORT_RAW_COMPILED() do \ { \ SCHEME_OBJECT * Saved_Old = Old; \ \ Real_Transport_Vector (); \ AUTOCLOBBER_BUMP (Saved_Old, To); \ *Saved_Old = New_Address; \ Temp = (RELOCATE_COMPILED_RAW_ADDRESS \ (Temp, \ (OBJECT_ADDRESS (New_Address)), \ Saved_Old)); \ } while (0) /* Manifest and implied types */ /* Manifest closures */ /* A manifest closure header is followed by one or more closure entry points. Each entry point consist of a pair of machine words (16 bits each) that contain a format word and a GC offset followed by the machine code for the closure (typically a jsr-type instruction). If there is only one entry point to a closure, the GC offset will be 8 bytes, pointing back to the manifest closure header itself. Otherwise what would have been the first GC offset is 0, and what would have been the first format word is the count in entry points. The format word and GC offset for the first entry follow this additional word. After the entry points there are the values of the variables closed over: >=1 Entry Point =1 Entry Point (offset in bytes from 1st instruction of 1st (only) entry) -12: Manifest Closure | tot. length - 8: Count format word (with 0 GC) Manifest Closure | tot. length - 4: Format word, 1st entry Format word, only entry - 2: GC offset to -12 GC offset to -8 0: jsr instr., 1st entry jsr instr. xx: more instructions if needed same : Format word, 2nd entry closed over variable values : GC offset to -16 ...: etc. ...: closed over variable values The following five macros are the only ones used outside of this file to deal with closures. They can be overridden for specific machines that use different formats. MANIFEST_CLOSURE_COUNT receives the address of the word past the manifest closure header and extracts the count of entry points in the closure block. FIRST_MANIFEST_CLOSURE_ENTRY receives the address of the word past the manifest closure header (-4 for single entry point closures in the above picture). It bumps it to the first entry point (i.e. to 0 above), past the format word and the gc offset and the count formart word if present. NEXT_MANIFEST_CLOSURE_ENTRY given an entry point in a multiclosure, bump to the immediately following entry point CLOSURE_ENTRY_END given an entry point, return the address of the first byte past the code in this entry point. MANIFEST_CLOSURE_END receives the address of the word past the manifest closure header (-4 for single entry point closures in the above picture). Returns the address of the word that precedes the first free variable in the closure. CLOSURE_HEADER_TO_ENTRY is the distance (in bytes) from the manifest closure header to the 1st instruction of the (1st) entry. */ #define CLOSURE_HEADER_TO_ENTRY \ ((sizeof (SCHEME_OBJECT)) + (2 * (sizeof (format_word)))) #define CLOSURE_HEADER_TO_ENTRY_WORD \ ((format_word) (BYTE_OFFSET_TO_OFFSET_WORD (CLOSURE_HEADER_TO_ENTRY))) #ifndef MANIFEST_CLOSURE_COUNT #define MANIFEST_CLOSURE_COUNT(scan) \ (((((format_word *) (scan))[1]) == \ CLOSURE_HEADER_TO_ENTRY_WORD) ? \ 1 : \ ((long) (((format_word *) (scan))[0]))) #endif #ifndef FIRST_MANIFEST_CLOSURE_ENTRY #define FIRST_MANIFEST_CLOSURE_ENTRY(scan) \ (((((format_word *) (scan))[1]) == CLOSURE_HEADER_TO_ENTRY_WORD) \ ? (((char *) (scan)) + (2 * (sizeof (format_word)))) \ : (((char *) (scan)) + (4 * (sizeof (format_word))))) #endif #ifndef NEXT_MANIFEST_CLOSURE_ENTRY #define NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr) \ (((char *) (word_ptr)) + (COMPILED_CLOSURE_ENTRY_SIZE)) #endif /* Where this closure entry ends with respect to the entry point. Since an entry point is preceded by a format word and a gc offset, it is the address of the next entry minus these two words. */ #ifndef CLOSURE_ENTRY_END #define CLOSURE_ENTRY_END(word_ptr) \ (((char *) (word_ptr)) + \ ((COMPILED_CLOSURE_ENTRY_SIZE) - (2 * (sizeof (format_word))))) #endif #define CHAR_TO_SCHEME_OBJECT(chars) \ (((chars) + ((sizeof (SCHEME_OBJECT)) - 1)) / (sizeof (SCHEME_OBJECT))) /* This assumes that closures with exactly one entry point are always represented in short format. */ #ifndef MANIFEST_CLOSURE_END #define MANIFEST_CLOSURE_END(start, count) \ (((SCHEME_OBJECT *) (start)) \ + (CHAR_TO_SCHEME_OBJECT (((count) * COMPILED_CLOSURE_ENTRY_SIZE) \ + (((count) == 1) \ ? 0 \ : (2 * sizeof(format_word)))))) #endif /* Linkage sections */ #define READ_LINKAGE_KIND(header) \ ((header) & 0xff0000) #define READ_CACHE_LINKAGE_COUNT(header) \ ((header) & 0xffff) #ifndef FIRST_OPERATOR_LINKAGE_OFFSET # define FIRST_OPERATOR_LINKAGE_OFFSET 1 #endif #define READ_OPERATOR_LINKAGE_COUNT(header) \ (EXECUTE_CACHE_COUNT_TO_ENTRIES \ (((header) & 0xffff) - (FIRST_OPERATOR_LINKAGE_OFFSET - 1))) #define MAKE_LINKAGE_SECTION_HEADER(kind, count) \ (MAKE_OBJECT(TC_LINKAGE_SECTION, \ ((kind) \ | ((((kind) == OPERATOR_LINKAGE_KIND) \ || ((kind) == GLOBAL_OPERATOR_LINKAGE_KIND)) \ ? ((EXECUTE_CACHE_ENTRIES_TO_COUNT (count)) \ + (FIRST_OPERATOR_LINKAGE_OFFSET - 1)) \ : (count))))) /* This takes into account the 1 added by the main loop of the relocators. */ #ifndef END_OPERATOR_LINKAGE_AREA # define END_OPERATOR_LINKAGE_AREA(scan, count) \ (((SCHEME_OBJECT *) (scan)) \ + (((count) * EXECUTE_CACHE_ENTRY_SIZE)) \ + (FIRST_OPERATOR_LINKAGE_OFFSET - 1)) #endif #define FIRST_OPERATOR_LINKAGE_ENTRY(scan) \ ((char *) (((SCHEME_OBJECT *) (scan)) + FIRST_OPERATOR_LINKAGE_OFFSET)) #define NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr) \ ((char *) (((SCHEME_OBJECT *) (word_ptr)) + \ EXECUTE_CACHE_ENTRY_SIZE)) #ifndef EXTRACT_OPERATOR_LINKAGE_ADDRESS # define EXTRACT_OPERATOR_LINKAGE_ADDRESS(target, source) \ { \ EXTRACT_EXECUTE_CACHE_ADDRESS (target, source); \ } #endif #ifndef STORE_OPERATOR_LINKAGE_ADDRESS # define STORE_OPERATOR_LINKAGE_ADDRESS(source, target) \ { \ STORE_EXECUTE_CACHE_ADDRESS (target, source); \ } #endif /* Heuristic recovery aid. See uxtrap.c for its use. block is the address of a vector header followed by a non-marked header (the way that compiled blocks start). PLAUSIBLE_CC_BLOCK_P returns true if it is likely that compiled code is contained in the header. This is done by checking whether an entry is the first thing in the compiled code section. There are two kinds of "possible entries": expressions (first thing in the block) and procedures/continuations, which follow an interrupt check. */ #define PLAUSIBLE_CC_BLOCK_P(block) \ (((PLAUSIBLE_BLOCK_START_P((block), CC_BLOCK_FIRST_ENTRY_OFFSET)) || \ (PLAUSIBLE_BLOCK_START_P((block), \ (CC_BLOCK_FIRST_ENTRY_OFFSET + \ ENTRY_PREFIX_LENGTH)))) \ && \ (PLAUSIBLE_BLOCK_SPAN_AND_END_P(block, \ (VECTOR_LOC((SCHEME_OBJECT)block, \ ((VECTOR_LENGTH((SCHEME_OBJECT)block)) - 1)))))) #define PLAUSIBLE_BLOCK_START_P(addr, offset) \ ((*((format_word *) \ (((char *) (addr)) + ((offset) - (sizeof (format_word)))))) == \ ((BYTE_OFFSET_TO_OFFSET_WORD(offset)))) #define PLAUSIBLE_BLOCK_SPAN_AND_END_P(addr,end) \ (((ADDRESS_HEAP_P(addr) && ADDRESS_HEAP_P(end)) || \ (ADDRESS_CONSTANT_P(addr) && ADDRESS_CONSTANT_P(end))) \ && \ (ENVIRONMENT_P (*(SCHEME_OBJECT *) end))) #else /* not HAS_COMPILER_SUPPORT */ /* This can be anything. */ typedef unsigned short format_word; /* Is there anything else that can be done here? */ #define GC_NO_COMPILER_STMT() \ gc_death \ (TERM_COMPILER_DEATH, \ "relocate_compiled: No compiler support!", \ 0, 0) #define GC_NO_COMPILER_EXPR(value_type) \ ((GC_NO_COMPILER_STMT ()), (value_type 0)) #define RELOCATE_COMPILED(obj, nb, ob) \ (GC_NO_COMPILER_EXPR ((SCHEME_OBJECT))) #define RELOCATE_COMPILED_INTERNAL(ad,nb,ob) \ (GC_NO_COMPILER_EXPR ((SCHEME_OBJECT))) #define RELOCATE_COMPILED_RAW_ADDRESS(ad,nb,ob) \ (GC_NO_COMPILER_EXPR ((SCHEME_OBJECT))) #define Transport_Compiled() (GC_NO_COMPILER_STMT ()) #define TRANSPORT_RAW_COMPILED() (GC_NO_COMPILER_STMT ()) #define Compiled_BH(flag, then_what) (GC_NO_COMPILER_STMT ()) #define RAW_COMPILED_BH(flag, then_what) (GC_NO_COMPILER_STMT ()) #define Get_Compiled_Block(var, address) (GC_NO_COMPILER_STMT ()) #define FIRST_MANIFEST_CLOSURE_ENTRY(scan) \ (GC_NO_COMPILER_EXPR ((char *))) #define MANIFEST_CLOSURE_COUNT(scan) \ (GC_NO_COMPILER_EXPR ((long))) #define NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr) \ (GC_NO_COMPILER_EXPR ((char *))) #define CLOSURE_ENTRY_END(word_ptr) \ (GC_NO_COMPILER_EXPR ((char *))) #define MANIFEST_CLOSURE_END(end, start) \ (GC_NO_COMPILER_EXPR ((SCHEME_OBJECT *))) #define EXTRACT_CLOSURE_ENTRY_ADDRESS(target, source) \ (GC_NO_COMPILER_STMT ()) #define STORE_CLOSURE_ENTRY_ADDRESS(source, target) \ (GC_NO_COMPILER_STMT ()) #define READ_LINKAGE_KIND(header) \ (GC_NO_COMPILER_EXPR ((int))) #define READ_CACHE_LINKAGE_COUNT(header) \ (GC_NO_COMPILER_EXPR ((int))) #define READ_OPERATOR_LINKAGE_COUNT(header) \ (GC_NO_COMPILER_EXPR ((int))) #define END_OPERATOR_LINKAGE_AREA(scan, count) \ (GC_NO_COMPILER_EXPR ((SCHEME_OBJECT *))) #define FIRST_OPERATOR_LINKAGE_ENTRY(scan) \ (GC_NO_COMPILER_EXPR ((char *))) #define NEXT_LINKAGE_OPERATOR_ENTRY(ptr) \ (GC_NO_COMPILER_EXPR ((char *))) #define EXTRACT_OPERATOR_LINKAGE_ADDRESS(target, source) \ (GC_NO_COMPILER_STMT ()) #define STORE_OPERATOR_LINKAGE_ADDRESS(source, target) \ (GC_NO_COMPILER_STMT ()) #endif /* HAS_COMPILER_SUPPORT */ #ifndef FLUSH_I_CACHE # define FLUSH_I_CACHE() do {} while (0) #endif #if !defined(PUSH_D_CACHE_REGION) && defined(FLUSH_I_CACHE_REGION) # define PUSH_D_CACHE_REGION(addr, nwords) FLUSH_I_CACHE_REGION(addr, nwords) #endif #ifndef COMPILER_TRANSPORT_END # define COMPILER_TRANSPORT_END() do \ { \ Registers[REGBLOCK_CLOSURE_SPACE] = ((SCHEME_OBJECT) 0); \ Registers[REGBLOCK_CLOSURE_FREE] = ((SCHEME_OBJECT) NULL); \ FLUSH_I_CACHE (); \ } while (0) #endif /* COMPILER_TRANSPORT_END */ #ifndef START_CLOSURE_RELOCATION # define START_CLOSURE_RELOCATION(scan) do { } while (0) #endif #ifndef END_CLOSURE_RELOCATION # define END_CLOSURE_RELOCATION(scan) do { } while (0) #endif #ifndef START_OPERATOR_RELOCATION # define START_OPERATOR_RELOCATION(scan) do { } while (0) #endif #ifndef END_OPERATOR_RELOCATION # define END_OPERATOR_RELOCATION(scan) do { } while (0) #endif #endif /* CMPGC_H_INCLUDED */