From: Guillermo J. Rozas Date: Fri, 2 Jun 1989 14:49:59 +0000 (+0000) Subject: Initial revision X-Git-Tag: 20090517-FFI~12031 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=90626bcd5c45c7bfa06549c7e5beb2faed780906;p=mit-scheme.git Initial revision --- diff --git a/v7/src/compiler/documentation/cmpint.txt b/v7/src/compiler/documentation/cmpint.txt new file mode 100644 index 000000000..c7ce7943c --- /dev/null +++ b/v7/src/compiler/documentation/cmpint.txt @@ -0,0 +1,490 @@ +-*- Text -*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/documentation/cmpint.txt,v 1.1 1989/06/02 14:48:51 jinx Exp $ + + Remarks: + +This file describes the compiled code data structures and the macros +defined in cmpint.h and required by cmpint.c and cmpgc.h . +The "settable" fields in the various files are described in the +paragraphs marked with "=>". + + Description of compiled code objects and relevant types: + +The Scheme compiler compiles scode expressions (including procedure +definitions) into native code. As its output, it produces compiled +expression Scheme objects. These expression can be given to +scode-eval with an environment, and the compiled code corresponding +to the expressions will be executed. + +Typically these expressions will construct some pointers to compiled +procedures and define them in the environment. These procedures can +then be invoked normally from the read-eval-print loop, from +interpreted code or from other compiled code. + +In the course of their computation, these procedures will need to +call other procedures and then proceed the computation. In order to +accomplish this, they will push compiled return addresses on the +stack, and these will eventually be popped and "jumped through" to +return. + +Compiled code and objects referenced by it are collected into +"vector-like" objects called compiled code blocks. + +The above four classes of objects (compiled expressions, compiled +procedures, compiled return addresses, and compiled code blocks) are +implemented using two microcode types: + +TC_COMPILED_CODE_BLOCK is used to implement compiled code blocks. It +is a vector type, that is, it is a pointer type, the word addressed by +the pointer contains the length of the vector (not including the +length header word), and the rest of the words (length) follow at +increasing addresses in memory. Typically the first word after the +header is a non-marked-vector header, and the instructions follow it. +The length field of this non-marked-vector covers all of the +instructions, but may leave space for objects at the end of the +compiled code block. This additional space at the end of the block is +called the "constants" section, since it is used, among other things, +to keep copies of constant objects used by the compiled code. See the +picture below for a diagram of the typical layout. + +TC_COMPILED_ENTRY is used to implement compiled expressions, +compiled return addresses, compiled procedures, and some other entry +points that the compiler and the compiled code interface need. A +compiled entry is a non-standard pointer type described below. + + Description of compiled entries: + +The address portion of a compiled entry object points to an +instruction in the "middle" of a compiled code block. + +In order for the garbage collector to be able to move the whole +block as a unit it must be able to determine the address of the +first word. Note that this word contains the length of the whole +block, so this need not be specified again. + +The address of the first word of the block can be found from the +address of the instruction, and a few bytes (currently a halfword) +preceding the instruction. These bytes are called the offset field of +a compiled entry object, and typically encode the distance (in bytes) +between the beginning of the block and the compiled entry. + +A few bytes preceding the offset field are called the format field +and encode the type of compiled entry (procedure vs. expression, +etc) and some type-specific information (number of arguments, offset +to next return address on the stack, etc.). + + Encoding of the offset field: + +Typically the offset field is two bytes long (one halfword) and is +decoded as follows: + +If the low order bit is 0 the offset is a simple offset, ie. +subtracting the offset from the address of the compiled entry +results in the address of the compiled code block that contains the +entry. + +If the low order bit is 1, it is a continued offset, ie. subtracting +the offset from the address of the compiled entry results in the +address of another compiled entry whose offset may or may not have a +low bit of 0. + +The rest of the bits (typically 15) are some encoding of the offset: + +- If instructions can appear at arbitrary byte addresses (including +odd addresses), this field is the offset itself. + +- If instructions have alignment constraints (ie. halfword alignment +on MC68K, or longword alignment on many RISCs), this field shifted +appropriately is the offset. In this way, no bits are wasted, and +the range of offsets is increased. + +For example, + +The DEC VAX can have instructions at any byte location. The 15 bits +are the offset. + +The MC68020 can have instructions only at halfword boundaries. The +15 bit field shifted left by 1 is the real offset. Note that in +this case, if the low bit of the word is 0, the word is the real offset. + +The HP Precision Architecture, and many other RISCs, can have +instructions only at longword boundaries. The 15 bit field shifted +left by 2 is the real offset. + + Encoding of the format field: + +The preceding bytes (typically 2) encode the kind of object in the +following way: + +- For compiled expressions it is always 0xffff (-1). + +- For compiled entries it is always 0xfff[d-e] (-3 or -2). +It is 0xfffe for compiler generated entries, 0xfffd for +compiler-interface generated entries. + +- For compiled code return addresses which have saved dynamic +links it is always 0xfffc (-4). The next item on the stack is +then a dynamic link. + +- For the special return address `return_to_interpreter' it is +always 0xfffb (-5). + +- For all other compiled code return addresses the low order byte is +between 0x80 and 0xdf inclusive, and the high order byte is between +0x80 and 0xff inclusive. In this case, the least significant 7 bits +of the high order byte and the least significant 6 bits of the low +order byte are combined to form the offset in the stack to the +previous (earlier) return address. The combination is actually +reversed with the bits from the high order byte being the low order +bits in the result. This information is used by the debugger to +"parse" the stack into frames. + +- For compiled procedures, the format word describes the arity (number +of parameters) and the format of the frame on the stack: + +The high order byte is (1+ REQ) where REQ is the number of +required arguments. Note that REQ must be less than 127! + +The low order byte is given by the expression +(* (EXPT -1 REST?) FRAME-SIZE) +where FRAME-SIZE is (+ 1 REQ OPT REST?), REQ is as above, OPT +is the number of named optional arguments, and REST? is 1 if +the procedure has a rest parameter (ie. it is a "lexpr"), or 0 +otherwise. Note that FRAME-SIZE must be less than 127! + + Picture of typical compiled code block and entry: + + + ---------------------------------------- + start_address | MANIFEST-VECTOR | tl | + ----------------------------------------<---------\ + | NM-HEADER | il | \ + ----------------------------------------<---\ | + | | \ | + | | | | + | | | | + | | | | + | some instructions | | | + | | | | + | | | | + | | | | + | | | | + ---------------------------------------- | | + | format_word_1 | offset_word_1 | | | + ---------------------------------------- | | + entry_address_1 | movel arg0,reg0 | | | + ---------------------------------------- | | + | | | | + | | | | + | | > il | + | | | | + | more instructions | | | + | | | | + | | | | + | | | | + ---------------------------------------- | > tl + | format_word_2 | offset_word_2 | | | + ---------------------------------------- | | + entry_address_2 | andl pointer_mask,arg0,reg0 | | | + ---------------------------------------- | | + | | | | + | | | | + | | | | + | | | | + | more instructions | | | + | | | | + | | | | + | | / | + /--->----------------------------------------<---/ | + / | Scheme object | | + | ---------------------------------------- | + "cons- | | | | + tants" | | | | + | | | | + < | | | + | | more Scheme objects | | + section | | | | + | | | | + | | | | + \ | | / + \--->----------------------------------------<----------/ + + Description of picture: + +[TC_COMPILED_CODE_BLOCK | start_address] would be the object +representing the compiled code block. + +[TC_COMPILED_ENTRY | entry_address_1] would represent entry1. + +[TC_COMPILED_ENTRY | entry_address_2] would represent entry2. + +1) Assuming that instructions are longword aligned and that +entry_address_1 is close enough to start_address not to need an +extension, but entry_address_2 is not, then + +offset_word_1 = ((entry_address_1 - start_address) >> 1) +offset_word_2 = (((entry_address_2 - entry_address_1) >> 1) | 1) + +note that entry_address_1 - start_address is a multiple of 4 because +of the alignment assumption. + +2) Assuming that instructions are halfword aligned and that +entry_address_1 is close enough to start_address not to need an +extension, but entry_address_2 is not, then + +offset_word_1 = (entry_address_1 - start_address) +offset_word_2 = ((entry_address_2 - entry_address_1) | 1) + +note that entry_address_1 - start_address is a multiple of 2 because +of the alignment assumption. + +3) Assuming that instructions are byte aligned and that +entry_address_1 is close enough to start_address not to need an +extension, but entry_address_2 is not, then + +offset_word_1 = ((entry_address_1 - start_address) << 1) +offset_word_2 = (((entry_address_2 - entry_address_1) << 1) | 1) + +The length of the "constants" section is (tl - il). +There are (tl + 1) total words in the object. + +=> In cmpint.h PC_ZERO_BITS should be defined to be the number of bits +in instruction addresses which are always 0 (0 if no alignment +constraints, 1 if halfword, etc.). + +=> In cmpint.h machine_word should be 'typedefd' to be the size of the +descriptor fields. It is assumed that the offset word and the format +word are the same size. + + Compiled closures: + +Most compiled procedures are represented as a simple compiled entry +pointing to the compiled code block generated by the compiler. + +Some procedures, called closures, have free variables whose locations +cannot be allocated statically at compiled time. The compiler will +generate code to construct a tiny compiled code block on the fly and +make the compiled procedure be an entry point pointing to this +dynamically allocated compiled code block. + +For example, consider the following code, + +(define foo + (lambda (x) + (lambda (y) (+ x y)))) + +The outer LAMBDA will be represented as a compiled entry pointing to +the appropriate block. The inner LAMBDA cannot be since there can be +more than one copy, each with its independent value for X: + +(define foo1 (foo 1)) +(define foo2 (foo 2)) + +Compiled closures are implemented in the following way: The entry +corresponding to the procedure points to a jump-to-subroutine (or +branch-and-link) instruction. The target of this jump is the code +corresponding to the body of the procedure. This code resides in the +compiled code block that the compiler generated. The free variables +follow the jump-to-subroutine instruction (after aligning to +longword). + +Using this representation, the caller need not know whether it is +invoking a "normal" compiled procedure or a compiled closure. When +the closure is invoked normally, it jumps to the real code for the +procedure, after leaving a "return address" into the closure object in +a standard place (stack or link register). This "return address" is +the address of the free variables of the procedure, so the code can +reference them by using indirect loads through the "return address". + +Conceptually the code above would be compiled as (see cmpaux.m4 for a +description of the abstract assembly language) + +foo: + movl rfree,reg0 + movl &[TC_MANIFEST_CLOSURE | 4],reg1 ; gc header + movl reg1,0(reg0) + movl &[format_word | gc_offset],reg1 ; entry descriptor + movl reg1,NEXT_WORD(reg0) + movl &[jsr opcode],reg1 ; jsr absolute opcode/prefix + movl reg1,2*NEXT_WORD(reg0) + mova lambda-1,reg1 ; entry point + movl reg1,3*NEXT_WORD(reg0) + movl arg1,4*NEXT_WORD(reg0) ; x + movl 5*NEXT_WORD,reg1 + addl reg0,reg1,rfree + movl &[tc_compiled_entry | 2*NEXT_WORD],reg1 + addl reg0,reg1,retval + ret + +lambda-1: + movl arg1,reg0 ; y + movl x_offset(retlnk),reg1 ; x + addl reg1,reg0,reg0 + movl reg0,retval + ret + +Thus the closure would look like + + ---------------------------------------- + | MANIFEST_CLOSURE | 4 | + ---------------------------------------- + | format_word | offset_word | + ---------------------------------------- +entry | jsr opcode | + ---------------------------------------- + | address of lambda-1 | + ---------------------------------------- +retadd | value of x | + ---------------------------------------- + +and retlnk would get the address of retadd at runtime. Thus x_offset +would be 0. + +=> The macro COMPILED_CLOSURE_ENTRY_SIZE in cmpint.h specifies how +many words there are in a compiled closure before the first free +variable and after the MANIFEST_CLOSURE header. + +=> The macro COMPILED_CLOSURE_ENTRY_ADDRESS in cmpint.h returns the +address of the location where the real entry point is stored when +given the address of the first word in the closure object. + +IMPORTANT: The macros and code in cmpgc.h assume that each closure has +exactly one entry point. That is, different procedures closed in the +same environment do not share closure structure. This may not be true +in the future, at which point these macros may have to be changed. +A possibility which allows the macros not to be changed is to put +multiple manifest closure headers in the closure (one per entry +point). All the gc offsets would point to the first header, but the +other headers would be there to determine how many entry points the +closure contained. + +IMPORTANT: The current macros and code assume that the address of the +entry point is contained in a (long)word by itself. If it is encoded +in an instruction or various instructions, some of the macros (and +code in the garbage collector) will have to be rewritten. + + External calls from compiled code: + +Many calls in scheme code (and particularly in large programs) are +calls to independently compiled procedures or procedures appearing at +the top level of a file. All these calls are calls to potentially +unknown procedures since the names to which they are bound can be +redefined dynamically at run time. + +The code issued by the compiler for such an external call must take +into account the possibility of runtime redefinition or assignment. +This is done as follows: + +For each external procedure called with a fixed number of arguments +(more on this below), a small contiguous space is allocated in the +"constants" section of the compiled code block. + +This space initially contains the name of the external variable +whose value is being invoked, and the number of arguments (+ 1 for +technical reasons) being passed to the procedure. + +These locations will be replaced at load time by an absolute jump to +the correct entry point of the called procedure if the number of +arguments matches and the callee (target procedure) is compiled, or by +an an absolute jump to some utility code generated on the fly to +interface the caller and the callee (usually called a trampoline +procedure). Note that both procedures need not be in the same +compiled code block. + +The fixed code in the code section of the compiled code block contains +a branch instruction to this space allocated in the "constants" +section. + +When the compiled code block is loaded, a linker is invoked which +resolves these references and replaces the name and arguments with +machine-specific code to do the absolute jump. It also remembers the +locations of all such jump instructions so that a subsequent +redefinition or assigment of the same name will cause the jump +instruction to be replaced by a new one to the correct value. +Note that the number of arguments needs to be checked only by the +linker, so no instructions are issued to check it at run time. It is +for this reason that the number of arguments is part of the +information left by the compiler in the "constants" section. + +These entries in the "constants" section are called "UUO" links for +historical reasons. They must be large enough to contain the +instructions required for an absolute jump (and possibly some delay +slot instructions in a RISC-style machine), and the number of +arguments passed in the call. This number of arguments is not used in +the call sequence, but is used by the linker when initially linking +and when relinking because of redefinition or assignment. + +All such "UUO" links are contiguous in the "constants" section, and +the whole lot is preceded by a GC header of type TC_LINKAGE_SECTION +which contains two fields: + +The least significant half word of the header contains the size in +long words of the "UUO" section (note that each link may take up more +than one longword). The remaining bits (excepting the type code) MUST +be 0. Note that if a file makes enough external calls that this +halfword field cannot hold the size, the links must be separated into +multiple blocks each with its own header. + +Occasionally a procedure is called with more than one number of +arguments within the same file. For example, the LIST procedure may +be called with three and seven arguments in the same file. In this +case there would be two "UUO" links to LIST. One would correspond to +the argument count of three, and the other to seven. + +As an example, consider the code generated for + +(sort ) + +where sort is the "global" procedure sort. + +The code in the code section would be + + + push + + push + branch sort-uuo-link + + +In the constants section there would be a label +which would contain the following after linking + +sort-uuo-link: + jump sort ; Absolute address for sort + 3 ; Number of arguments + 1 + +Before linking it would contain + +sort-uuo-link: + SORT ; The symbol SORT + 3 ; Number of arguments + 1 + +This assumes that the absolute jump instruction takes one word. If it +takes more, the appropriate padding would have to be inserted between +the symbol SORT and the number 3. On machines where instructions are +not necessarily longword aligned (MC68020 and VAX, for example), the +padding bits for the instruction can be used to contain the argument +count. + +=> In cmpint.h the macro OPERATOR_LINK_ENTRY_SIZE specifies how long +(in longwords) each "UUO" link entry is. This includes the size of +the instruction(s) and the argument count. For the example above this +would be 3, assuming that the jump instruction and the absolute +address take two words together (the third is for the argument count). +Note that on RISC machines, this size may have to include the size of +the branch delay slot instruction. This branach delay slot +instruction need not be a NOP. By choosing the instructions for the +procedure entry header consistenly with this, this slot can be used in +most cases. + +=> In cmpint.h the macro OPERATOR_LINK_ENTRY_ADDRESS specifies where +the absolute address of the called procedure's entry point is stored +when given the address of the first word in the UUO link. The code +currently assumes that this address is not "spread" into multiple +words, and that no bits must be cleared from the word that contains +this address. This will be fixed soon, since on many RISC machines, +there are no full address space absolute jump instructions, and the +opcode bits are part of the word. On many machines a two instruction +sequence must be used, with some of the bits of the absolute address +appearing in each of the instructions. diff --git a/v7/src/microcode/cmpgc.h b/v7/src/microcode/cmpgc.h new file mode 100644 index 000000000..01a773ed4 --- /dev/null +++ b/v7/src/microcode/cmpgc.h @@ -0,0 +1,199 @@ +/* -*-C-*- + +Copyright (c) 1989 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpgc.h,v 1.1 1989/06/02 14:49:36 jinx Exp $ + $MC68020-Header: cmp68kgc.h,v 9.30 89/03/27 23:14:31 GMT jinx Exp $ + +Utilities to relocate compiled code in garbage collection-like processes. + +This file is conditionally included by gccode.h. + +See cmpint.txt, cmpint.h, cmpint.c, and cmpaux.m4 for more details. +*/ + +#include "cmpint.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 Pointer compiler_utilities; + +#define Compiled_Code_Pre_Test(then_what) \ +if (Old == Get_Pointer(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) \ +{ \ + machine_word offset_word; \ + \ + var = (address); \ + \ + do \ + { \ + offset_word = (COMPILED_ENTRY_OFFSET_WORD(var)); \ + var = ((Pointer *) (((char *) (var)) - \ + (OFFSET_WORD_TO_BYTE_OFFSET(offset_word)))); \ + } while (OFFSET_WORD_CONTINUATION_P(offset_word)); \ +} + +#define RELOCATE_COMPILED_ADDRESS(object, new_block, old_block) \ +((Pointer *) (((char *) new_block) + \ + (((char *) Get_Pointer(object)) - \ + ((char *) old_block)))) + +#define Relocate_Compiled(object, new_block, old_block) \ +Make_Pointer(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 (OBJECT_TYPE(*Old) == TC_BROKEN_HEART) \ + { \ + *Scan = Relocate_Compiled(Temp, Get_Pointer(*Old), Old); \ + then_what; \ + } \ +} + +#define Transport_Compiled() \ +{ \ + Pointer *Saved_Old = Old; \ + \ + Real_Transport_Vector(); \ + *Saved_Old = New_Address; \ + *Scan = Relocate_Compiled(Temp, \ + Get_Pointer(New_Address), \ + Saved_Old); \ +} + +/* Manifest and implied types */ + +/* Manifest closures */ + +/* Bump back to header. */ + +#define FIRST_MANIFEST_CLOSURE_ENTRY(scan) \ + ((machine_word *) (((Pointer *) scan) - 1)) + +#define VALID_MANIFEST_CLOSURE_ENTRY(word_ptr) \ + ((OBJECT_TYPE(*((Pointer *) word_ptr))) == TC_MANIFEST_CLOSURE) + +#define MANIFEST_CLOSURE_ENTRY_ADDRESS(word_ptr) \ + (COMPILED_CLOSURE_ENTRY_ADDRESS(word_ptr)) + +#define NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr) \ + ((machine_word *) \ + (((Pointer *) word_ptr) + \ + (COMPILED_CLOSURE_ENTRY_SIZE + 1))) + +/* This takes into account the fact that the relocation loop increments + by 1 on each major iteration. + */ + +#define MANIFEST_CLOSURE_END(end_ptr, start_ptr) \ + (((Pointer *) end_ptr) - 1) + +#define MANIFEST_CLOSURE_VALID_FITS_P(word_ptr, top) \ + ((NEXT_MANIFEST_CLOSURE_ENTRY(word_ptr)) <= \ + ((machine_word *) top)) + +/* Linkage sections */ + +#define OPERATOR_LINKAGE_KIND 0x000000 +#define REFERENCE_LINKAGE_KIND 0x010000 +#define ASSIGNMENT_LINKAGE_KIND 0x020000 + +#define READ_LINKAGE_KIND(header) \ + ((header) & 0xff0000) + +#define READ_CACHE_LINKAGE_COUNT(header) \ + ((header) & 0xffff) + +#define READ_OPERATOR_LINKAGE_COUNT(header) \ + (OPERATOR_LINK_COUNT_TO_ENTRIES((header) & 0xffff)) + +/* This takes into account the 1 added by the main loop of the + relocators. + */ + +#define END_OPERATOR_LINKAGE_AREA(scan, count) \ + (((Pointer *) (scan)) + ((count) * OPERATOR_LINK_ENTRY_SIZE)) + +#define FIRST_OPERATOR_LINKAGE_ENTRY(scan) \ + ((machine_word *) (((Pointer *) (scan)) + 1)) + +#define OPERATOR_LINKAGE_ENTRY_ADDRESS(word_ptr) \ + (OPERATOR_LINK_ENTRY_ADDRESS(word_ptr)) + +#define NEXT_LINKAGE_OPERATOR_ENTRY(word_ptr) \ + ((machine_word *) (((Pointer *) (word_ptr)) + OPERATOR_LINK_ENTRY_SIZE)) + +/* Heuristic recovery aid. See unix.c for details. */ + +#define CC_BLOCK_FIRST_GC_OFFSET \ + (CC_BLOCK_FIRST_ENTRY_OFFSET - (sizeof(machine_word))) + +#define PLAUSIBLE_CC_BLOCK_P(block) \ + ((*((machine_word *) (((char *) block) + CC_BLOCK_FIRST_GC_OFFSET))) == \ + ((BYTE_OFFSET_TO_OFFSET_WORD(CC_BLOCK_FIRST_ENTRY_OFFSET)))) diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c new file mode 100644 index 000000000..9bd2fae67 --- /dev/null +++ b/v7/src/microcode/cmpint.c @@ -0,0 +1,559 @@ +/* -*-C-*- + +Copyright (c) 1989 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.c,v 1.1 1989/06/02 14:49:59 jinx Exp $ + * + * This file corresponds to + * $COMPILER-Header: compiler.c,v 9.35 88/10/26 20:02:13 GMT cph Exp $ + * $MC68020-Header: cmp68020.m4,v 9.86 89/04/19 02:24:19 GMT arthur Exp $ + * + * Compiled code interface. Portable version. + * This file requires a bit of assembly language described in cmpaux.m4 + * See also the files cmpint.h, cmpgc.h, and cmpint.txt . + * + */ + +/* + * Procedures in this file divide into the following categories: + * + * 0: local C procedures. These are static procedures used only by + * this file. They are called by the other procedures in this file, + * and have been separated only for modularity reasons. They are + * tagged with the C keyword `static'. + * + * 1: C interface entries. These procedures are called from C and + * ultimately enter the Scheme compiled code world by using the + * assembly language utility `enter_compiled_code'. They are tagged + * with the noise word `C_TO_SCHEME'. + * + * 2: C utility procedures. These procedures are called from C and + * never leave the C world. They constitute the compiled code data + * abstraction as far as other C parts of the Scheme system are + * concerned. They are tagged with the noise word `C_UTILITY'. + * + * 3: Scheme interface utilities. These procedures are called from + * the assembly language interface and return to it. They never leave + * the Scheme compiled code world. If an error occurs or an interrupt + * must be processed, they return an exit code to the assembly language + * code that calls them. They are tagged with the noise word + * `SCHEME_UTILITY'. + * + */ + +/* Make noise words invisible to the C compiler. */ + +#define C_UTILITY +#define C_TO_SCHEME +#define SCHEME_UTILITY + +#include "config.h" /* Pointer type declaration */ +#include "object.h" /* Making pointers */ +#include "sdata.h" /* Needed by const.h */ +#include "types.h" /* Needed by const.h */ +#include "errors.h" /* Error codes and Termination codes */ +#include "const.h" /* REGBLOCK_MINIMUM_LENGTH */ +#include "returns.h" /* RC_POP_FROM_COMPILED_CODE */ +#include "trap.h" /* UNASSIGNED_OBJECT */ +#include "cmpint.h" + +/* Exports */ + +extern long + compiler_interface_version, + compiler_processor_type; + +extern Pointer + Registers[], + compiler_utilities, + return_to_interpreter; + +extern long + enter_compiled_expression(), + apply_compiled_procedure(), + return_to_compiled_code(), + make_fake_uuo_link(), + make_uuo_link(), + compiled_block_manifest_closure_p(), + compiled_entry_manifest_closure_p(), + compiled_entry_to_block_offset(); + +extern Pointer + extract_uuo_link(), + extract_variable_cache(), + compiled_block_debugging_info(), + compiled_block_environment(), + compiled_closure_to_entry(), + *compiled_entry_to_block_address(); + +extern void + store_variable_cache(), + compiled_entry_type(), + Microcode_Termination(); + +/* Imports from assembly language */ + +extern long + enter_compiled_code(); + +C_TO_SCHEME long +enter_compiled_expression() +{ + Pointer compiled_entry_address; + + compiled_entry_address = (Get_Pointer(Fetch_Expression ())); + if ((COMPILED_ENTRY_FORMAT_WORD (compiled_entry)) != + (EXPRESSION_FORMAT_WORD)) + { + /* It self evaluates. */ + Val = (Fetch_Expression ()); + return (PRIM_DONE); + } + return (enter_compiled_code (compiled_entry_address)); +} + +C_TO_SCHEME long +apply_compiled_procedure() +{ + static long setup_compiled_application(); + Pointer nactuals, procedure; + machine_word *procedure_entry; + long result; + + nactuals = (Pop ()); + procedure = (Pop ()); + procedure_entry = ((machine_word *) (Get_Pointer(procedure))); + result = setup_compiled_application ((OBJECT_DATUM (nactuals)), + procedure_entry); + if (result == PRIM_DONE) + { + /* Go into compiled code. */ + return (enter_compiled_code (procedure_entry)); + } + else + { + Push (procedure); + Push (nactuals); + return (result); + } +} + +C_TO_SCHEME long +return_to_compiled_code () +{ + register Pointer *compiled_entry_address; + + compiled_entry_address = (Get_Pointer (Pop ())); + /* *** No checking here? *** */ + return (enter_compiled_code (compiled_entry_address)); +} + +static long +setup_compiled_application (nactuals, compiled_entry_address) + register long nactuals; + register machine_word *compiled_entry_address; +{ + static long setup_lexpr_application(); + static Pointer *open_gap(); + register long nmin, nmax, delta; /* all +1 */ + + nmax = (COMPILED_ENTRY_MAXIMUM_ARITY (compiled_entry_address)); + if (nactuals == nmax) + { + /* Either the procedure takes exactly the number of arguments + given, or it has optional arguments, no rest argument, and + all the optional arguments have been provided. Thus the + frame is in the right format and we are done. + */ + return (PRIM_DONE); + } + nmin = (COMPILED_ENTRY_MINIMUM_ARITY (compiled_entry_address)); + if (nmin < 0) + { + /* Not a procedure. */ + return (ERR_INAPPLICABLE_OBJECT); + } + if (nactuals < nmin) + { + /* Too few arguments. */ + return (ERR_WRONG_NUMBER_OF_ARGUMENTS); + } + delta = (nactuals - nmax); + if (delta <= 0) + { + /* The procedure takes optional arguments but no rest argument + and not all the optional arguments have been provided. + They must be defaulted. + */ + ((void) (open_gap(nactuals, delta))); + return (PRIM_DONE); + } + if (nmax > 0) + { + /* Too many arguments */ + return (ERR_WRONG_NUMBER_OF_ARGUMENTS); + } + /* The procedure can take arbitrarily many arguments, ie. + it is a lexpr. + */ + return (setup_lexpr_application (nactuals, nmin, nmax)); +} + +/* Default some optional parameters, and return the location + of the return address (one past the last actual argument location). + */ + +static Pointer * +open_gap (nactuals, delta) + register long nactuals, delta; +{ + register Pointer *gap_location, *source_location; + + /* Need to fill in optionals */ + + gap_location = STACK_LOC(delta); + source_location = STACK_LOC(0); + Stack_Pointer = gap_location; + while ((--nactuals) > 0) + { + STACK_LOCATIVE_POP(gap_location) = STACK_LOCATIVE_POP(source_location); + } + delta = (- delta); + while ((--delta) >= 0) + { + STACK_LOCATIVE_POP(source_location) = UNASSIGNED_OBJECT; + } + return (source_location); +} + +/* Setup a rest argument as appropriate. */ + +static long +setup_lexpr_application (nactuals, nmin, nmax) + register long nactuals, nmin, nmax; +{ + register long delta; + + /* nmax is negative! */ + + delta = (nactuals + nmax); + + if (delta < 0) + { + /* Not enough arguments have been passed to allocate a list. + The missing optional arguments must be defaulted, and the + rest parameter needs to be set to the empty list. + */ + + Pointer *last_loc; + + last_loc = open_gap(nactuals, delta); + (STACK_LOCATIVE_PUSH(last_loc)) = NIL; + return (PRIM_DONE); + } + else if (delta == 0) + { + /* The number of arguments passed matches exactly the number of + formal paramters. The last argument needs to be replaced by + a list containing it, but there is no need to pop anything + since the frame has the right size. + This does not check for gc! + The procedure should (and currently will) on entry. + */ + + register Pointer temp, *gap_location; + + gap_location = STACK_LOC(nactuals - 2); + temp = *gap_location; + *gap_location = (Make_Pointer (TC_LIST, Free)); + *Free++ = temp; + *Free++ = NIL; + return (PRIM_DONE); + } + + else /* (delta > 0) */ + { + /* The number of arguments passed is greater than the number of + formal parameters named by the procedure. Excess arguments + need to be placed in a list passed at the last parameter + location. The extra arguments must then be popped from the stack. + */ + register Pointer *gap_location, *source_location; + + /* Allocate the list, and GC if necessary. */ + + gap_location = &Free[2 * (delta + 1)]; + if (GC_Check (gap_location - Free)) + { + Request_GC (gap_location - Free); + return (PRIM_APPLY_INTERRUPT); + } + + /* Place the arguments in the list, and link it. */ + + source_location = (STACK_LOC(nactuals - 1)); + (*(--gap_location)) = NIL; + + while ((--delta) >= 0) + { + gap_location -= 2; + (*(gap_location + 1)) = (STACK_LOCATIVE_PUSH(source_location)); + (*(gap_location)) = (Make_Pointer(TC_LIST, (gap_location + 1))); + } + + (*(--gap_location)) = (STACK_LOCATIVE_PUSH(source_location)); + + /* Place the list at the appropriate location in the stack. */ + + STACK_LOCATIVE_REFERENCE(source_location, 0) = + (Make_Pointer(TC_LIST, (gap_location))); + + /* Now move the arguments into their correct location in the stack + popping any unneeded locations. + */ + + gap_location = (STACK_LOC(nactuals - 1)); + STACK_LOCATIVE_INCREMENT(source_location); + nmin -= 1; + while ((--nmin) >= 0) + { + STACK_LOCATIVE_PUSH(gap_location) = STACK_LOCATIVE_PUSH(source_location); + } + Stack_Pointer = gap_location; + return (PRIM_DONE); + } +} + +/* + This entry point is invoked to reformat the frame when compiled code + calls a known lexpr. + Important: This assumes that it is always invoked with a valid + number of arguments (the compiler checked it), and will not check. + */ + +SCHEME_UTILITY long +invoke_lexpr (nactuals, compiled_entry_address) + register long nactuals; + register machine_word *compiled_entry_address; +{ + /* Use setup_lexpr_application */ +/* *** HERE *** */ +} + +Pointer + Registers[REGBLOCK_MINIMUM_LENGTH], + compiler_utilities, + return_to_interpreter; + +long + compiler_interface_version, + compiler_processor_type; + +/* Bad entry points. */ + +long +make_fake_uuo_link(extension, block, offset) + Pointer extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +make_uuo_link(value, extension, block, offset) + Pointer value, extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +extract_uuo_link(block, offset) + Pointer block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +void +store_variable_cache(extension, block, offset) + Pointer extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +extract_variable_cache(block, offset) + Pointer block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_block_debugging_info(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_block_environment(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_block_manifest_closure_p(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer * +compiled_entry_to_block_address(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_entry_to_block_offset(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +void +compiled_entry_type(entry, buffer) + Pointer entry, *buffer; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_entry_manifest_closure_p(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_closure_to_entry(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +#define losing_return_address(name) \ +extern long name(); \ +long \ +name() \ +{ \ + Microcode_Termination (TERM_COMPILER_DEATH); \ + /*NOTREACHED*/ \ +} + +losing_return_address (comp_interrupt_restart) +losing_return_address (comp_lookup_apply_restart) +losing_return_address (comp_reference_restart) +losing_return_address (comp_access_restart) +losing_return_address (comp_unassigned_p_restart) +losing_return_address (comp_unbound_p_restart) +losing_return_address (comp_assignment_restart) +losing_return_address (comp_definition_restart) +losing_return_address (comp_safe_reference_restart) +losing_return_address (comp_lookup_trap_restart) +losing_return_address (comp_assignment_trap_restart) +losing_return_address (comp_op_lookup_trap_restart) +losing_return_address (comp_cache_lookup_apply_restart) +losing_return_address (comp_safe_lookup_trap_restart) +losing_return_address (comp_unassigned_p_trap_restart) +losing_return_address (comp_link_caches_restart) + +/* NOP entry points */ + +extern void + compiler_reset(), + compiler_initialize(); + +extern long + coerce_to_compiled(); + +void +compiler_reset (new_block) + Pointer new_block; +{ + extern void compiler_reset_error(); + + if (new_block != NIL) + { + compiler_reset_error(); + } + return; +} + +void +compiler_initialize () +{ + compiler_processor_type = 0; + compiler_interface_version = 0; + compiler_utilities = NIL; + return_to_interpreter = + (Make_Non_Pointer (TC_RETURN_CODE, RC_POP_FROM_COMPILED_CODE)); + return; +} + +/* Identity procedure */ + +long +coerce_to_compiled(object, arity, location) + Pointer object, *location; + long arity; +{ + *location = object; + return (PRIM_DONE); +} diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c new file mode 100644 index 000000000..6c49ad3ad --- /dev/null +++ b/v8/src/microcode/cmpint.c @@ -0,0 +1,559 @@ +/* -*-C-*- + +Copyright (c) 1989 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. */ + +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpint.c,v 1.1 1989/06/02 14:49:59 jinx Exp $ + * + * This file corresponds to + * $COMPILER-Header: compiler.c,v 9.35 88/10/26 20:02:13 GMT cph Exp $ + * $MC68020-Header: cmp68020.m4,v 9.86 89/04/19 02:24:19 GMT arthur Exp $ + * + * Compiled code interface. Portable version. + * This file requires a bit of assembly language described in cmpaux.m4 + * See also the files cmpint.h, cmpgc.h, and cmpint.txt . + * + */ + +/* + * Procedures in this file divide into the following categories: + * + * 0: local C procedures. These are static procedures used only by + * this file. They are called by the other procedures in this file, + * and have been separated only for modularity reasons. They are + * tagged with the C keyword `static'. + * + * 1: C interface entries. These procedures are called from C and + * ultimately enter the Scheme compiled code world by using the + * assembly language utility `enter_compiled_code'. They are tagged + * with the noise word `C_TO_SCHEME'. + * + * 2: C utility procedures. These procedures are called from C and + * never leave the C world. They constitute the compiled code data + * abstraction as far as other C parts of the Scheme system are + * concerned. They are tagged with the noise word `C_UTILITY'. + * + * 3: Scheme interface utilities. These procedures are called from + * the assembly language interface and return to it. They never leave + * the Scheme compiled code world. If an error occurs or an interrupt + * must be processed, they return an exit code to the assembly language + * code that calls them. They are tagged with the noise word + * `SCHEME_UTILITY'. + * + */ + +/* Make noise words invisible to the C compiler. */ + +#define C_UTILITY +#define C_TO_SCHEME +#define SCHEME_UTILITY + +#include "config.h" /* Pointer type declaration */ +#include "object.h" /* Making pointers */ +#include "sdata.h" /* Needed by const.h */ +#include "types.h" /* Needed by const.h */ +#include "errors.h" /* Error codes and Termination codes */ +#include "const.h" /* REGBLOCK_MINIMUM_LENGTH */ +#include "returns.h" /* RC_POP_FROM_COMPILED_CODE */ +#include "trap.h" /* UNASSIGNED_OBJECT */ +#include "cmpint.h" + +/* Exports */ + +extern long + compiler_interface_version, + compiler_processor_type; + +extern Pointer + Registers[], + compiler_utilities, + return_to_interpreter; + +extern long + enter_compiled_expression(), + apply_compiled_procedure(), + return_to_compiled_code(), + make_fake_uuo_link(), + make_uuo_link(), + compiled_block_manifest_closure_p(), + compiled_entry_manifest_closure_p(), + compiled_entry_to_block_offset(); + +extern Pointer + extract_uuo_link(), + extract_variable_cache(), + compiled_block_debugging_info(), + compiled_block_environment(), + compiled_closure_to_entry(), + *compiled_entry_to_block_address(); + +extern void + store_variable_cache(), + compiled_entry_type(), + Microcode_Termination(); + +/* Imports from assembly language */ + +extern long + enter_compiled_code(); + +C_TO_SCHEME long +enter_compiled_expression() +{ + Pointer compiled_entry_address; + + compiled_entry_address = (Get_Pointer(Fetch_Expression ())); + if ((COMPILED_ENTRY_FORMAT_WORD (compiled_entry)) != + (EXPRESSION_FORMAT_WORD)) + { + /* It self evaluates. */ + Val = (Fetch_Expression ()); + return (PRIM_DONE); + } + return (enter_compiled_code (compiled_entry_address)); +} + +C_TO_SCHEME long +apply_compiled_procedure() +{ + static long setup_compiled_application(); + Pointer nactuals, procedure; + machine_word *procedure_entry; + long result; + + nactuals = (Pop ()); + procedure = (Pop ()); + procedure_entry = ((machine_word *) (Get_Pointer(procedure))); + result = setup_compiled_application ((OBJECT_DATUM (nactuals)), + procedure_entry); + if (result == PRIM_DONE) + { + /* Go into compiled code. */ + return (enter_compiled_code (procedure_entry)); + } + else + { + Push (procedure); + Push (nactuals); + return (result); + } +} + +C_TO_SCHEME long +return_to_compiled_code () +{ + register Pointer *compiled_entry_address; + + compiled_entry_address = (Get_Pointer (Pop ())); + /* *** No checking here? *** */ + return (enter_compiled_code (compiled_entry_address)); +} + +static long +setup_compiled_application (nactuals, compiled_entry_address) + register long nactuals; + register machine_word *compiled_entry_address; +{ + static long setup_lexpr_application(); + static Pointer *open_gap(); + register long nmin, nmax, delta; /* all +1 */ + + nmax = (COMPILED_ENTRY_MAXIMUM_ARITY (compiled_entry_address)); + if (nactuals == nmax) + { + /* Either the procedure takes exactly the number of arguments + given, or it has optional arguments, no rest argument, and + all the optional arguments have been provided. Thus the + frame is in the right format and we are done. + */ + return (PRIM_DONE); + } + nmin = (COMPILED_ENTRY_MINIMUM_ARITY (compiled_entry_address)); + if (nmin < 0) + { + /* Not a procedure. */ + return (ERR_INAPPLICABLE_OBJECT); + } + if (nactuals < nmin) + { + /* Too few arguments. */ + return (ERR_WRONG_NUMBER_OF_ARGUMENTS); + } + delta = (nactuals - nmax); + if (delta <= 0) + { + /* The procedure takes optional arguments but no rest argument + and not all the optional arguments have been provided. + They must be defaulted. + */ + ((void) (open_gap(nactuals, delta))); + return (PRIM_DONE); + } + if (nmax > 0) + { + /* Too many arguments */ + return (ERR_WRONG_NUMBER_OF_ARGUMENTS); + } + /* The procedure can take arbitrarily many arguments, ie. + it is a lexpr. + */ + return (setup_lexpr_application (nactuals, nmin, nmax)); +} + +/* Default some optional parameters, and return the location + of the return address (one past the last actual argument location). + */ + +static Pointer * +open_gap (nactuals, delta) + register long nactuals, delta; +{ + register Pointer *gap_location, *source_location; + + /* Need to fill in optionals */ + + gap_location = STACK_LOC(delta); + source_location = STACK_LOC(0); + Stack_Pointer = gap_location; + while ((--nactuals) > 0) + { + STACK_LOCATIVE_POP(gap_location) = STACK_LOCATIVE_POP(source_location); + } + delta = (- delta); + while ((--delta) >= 0) + { + STACK_LOCATIVE_POP(source_location) = UNASSIGNED_OBJECT; + } + return (source_location); +} + +/* Setup a rest argument as appropriate. */ + +static long +setup_lexpr_application (nactuals, nmin, nmax) + register long nactuals, nmin, nmax; +{ + register long delta; + + /* nmax is negative! */ + + delta = (nactuals + nmax); + + if (delta < 0) + { + /* Not enough arguments have been passed to allocate a list. + The missing optional arguments must be defaulted, and the + rest parameter needs to be set to the empty list. + */ + + Pointer *last_loc; + + last_loc = open_gap(nactuals, delta); + (STACK_LOCATIVE_PUSH(last_loc)) = NIL; + return (PRIM_DONE); + } + else if (delta == 0) + { + /* The number of arguments passed matches exactly the number of + formal paramters. The last argument needs to be replaced by + a list containing it, but there is no need to pop anything + since the frame has the right size. + This does not check for gc! + The procedure should (and currently will) on entry. + */ + + register Pointer temp, *gap_location; + + gap_location = STACK_LOC(nactuals - 2); + temp = *gap_location; + *gap_location = (Make_Pointer (TC_LIST, Free)); + *Free++ = temp; + *Free++ = NIL; + return (PRIM_DONE); + } + + else /* (delta > 0) */ + { + /* The number of arguments passed is greater than the number of + formal parameters named by the procedure. Excess arguments + need to be placed in a list passed at the last parameter + location. The extra arguments must then be popped from the stack. + */ + register Pointer *gap_location, *source_location; + + /* Allocate the list, and GC if necessary. */ + + gap_location = &Free[2 * (delta + 1)]; + if (GC_Check (gap_location - Free)) + { + Request_GC (gap_location - Free); + return (PRIM_APPLY_INTERRUPT); + } + + /* Place the arguments in the list, and link it. */ + + source_location = (STACK_LOC(nactuals - 1)); + (*(--gap_location)) = NIL; + + while ((--delta) >= 0) + { + gap_location -= 2; + (*(gap_location + 1)) = (STACK_LOCATIVE_PUSH(source_location)); + (*(gap_location)) = (Make_Pointer(TC_LIST, (gap_location + 1))); + } + + (*(--gap_location)) = (STACK_LOCATIVE_PUSH(source_location)); + + /* Place the list at the appropriate location in the stack. */ + + STACK_LOCATIVE_REFERENCE(source_location, 0) = + (Make_Pointer(TC_LIST, (gap_location))); + + /* Now move the arguments into their correct location in the stack + popping any unneeded locations. + */ + + gap_location = (STACK_LOC(nactuals - 1)); + STACK_LOCATIVE_INCREMENT(source_location); + nmin -= 1; + while ((--nmin) >= 0) + { + STACK_LOCATIVE_PUSH(gap_location) = STACK_LOCATIVE_PUSH(source_location); + } + Stack_Pointer = gap_location; + return (PRIM_DONE); + } +} + +/* + This entry point is invoked to reformat the frame when compiled code + calls a known lexpr. + Important: This assumes that it is always invoked with a valid + number of arguments (the compiler checked it), and will not check. + */ + +SCHEME_UTILITY long +invoke_lexpr (nactuals, compiled_entry_address) + register long nactuals; + register machine_word *compiled_entry_address; +{ + /* Use setup_lexpr_application */ +/* *** HERE *** */ +} + +Pointer + Registers[REGBLOCK_MINIMUM_LENGTH], + compiler_utilities, + return_to_interpreter; + +long + compiler_interface_version, + compiler_processor_type; + +/* Bad entry points. */ + +long +make_fake_uuo_link(extension, block, offset) + Pointer extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +make_uuo_link(value, extension, block, offset) + Pointer value, extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +extract_uuo_link(block, offset) + Pointer block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +void +store_variable_cache(extension, block, offset) + Pointer extension, block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +extract_variable_cache(block, offset) + Pointer block; + long offset; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_block_debugging_info(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_block_environment(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_block_manifest_closure_p(block) + Pointer block; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer * +compiled_entry_to_block_address(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_entry_to_block_offset(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +void +compiled_entry_type(entry, buffer) + Pointer entry, *buffer; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +long +compiled_entry_manifest_closure_p(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +Pointer +compiled_closure_to_entry(entry) + Pointer entry; +{ + Microcode_Termination (TERM_COMPILER_DEATH); + /*NOTREACHED*/ +} + +#define losing_return_address(name) \ +extern long name(); \ +long \ +name() \ +{ \ + Microcode_Termination (TERM_COMPILER_DEATH); \ + /*NOTREACHED*/ \ +} + +losing_return_address (comp_interrupt_restart) +losing_return_address (comp_lookup_apply_restart) +losing_return_address (comp_reference_restart) +losing_return_address (comp_access_restart) +losing_return_address (comp_unassigned_p_restart) +losing_return_address (comp_unbound_p_restart) +losing_return_address (comp_assignment_restart) +losing_return_address (comp_definition_restart) +losing_return_address (comp_safe_reference_restart) +losing_return_address (comp_lookup_trap_restart) +losing_return_address (comp_assignment_trap_restart) +losing_return_address (comp_op_lookup_trap_restart) +losing_return_address (comp_cache_lookup_apply_restart) +losing_return_address (comp_safe_lookup_trap_restart) +losing_return_address (comp_unassigned_p_trap_restart) +losing_return_address (comp_link_caches_restart) + +/* NOP entry points */ + +extern void + compiler_reset(), + compiler_initialize(); + +extern long + coerce_to_compiled(); + +void +compiler_reset (new_block) + Pointer new_block; +{ + extern void compiler_reset_error(); + + if (new_block != NIL) + { + compiler_reset_error(); + } + return; +} + +void +compiler_initialize () +{ + compiler_processor_type = 0; + compiler_interface_version = 0; + compiler_utilities = NIL; + return_to_interpreter = + (Make_Non_Pointer (TC_RETURN_CODE, RC_POP_FROM_COMPILED_CODE)); + return; +} + +/* Identity procedure */ + +long +coerce_to_compiled(object, arity, location) + Pointer object, *location; + long arity; +{ + *location = object; + return (PRIM_DONE); +}