--- /dev/null
+-*- 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.
+\f
+ 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.
+\f
+ 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!
+\f
+ 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 | | | |
+ | | | |
+ | | | |
+ \ | | /
+ \--->----------------------------------------<----------/
+\f
+ 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.
+\f
+ 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".
+\f
+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.
+\f
+ 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.
+\f
+As an example, consider the code generated for
+
+(sort <some list> <some predicate>)
+
+where sort is the "global" procedure sort.
+
+The code in the code section would be
+
+ <compute some predicate>
+ push <some predicate>
+ <compute some list>
+ push <some list>
+ 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.
--- /dev/null
+/* -*-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"
+\f
+/* 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
+\f
+/*
+ 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); \
+}
+\f
+/* 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))
+\f
+/* 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))
+\f
+/* 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))))
--- /dev/null
+/* -*-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 .
+ *
+ */
+\f
+/*
+ * 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
+\f
+#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();
+\f
+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));
+}
+\f
+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));
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+ }
+\f
+ 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);
+ }
+}
+\f
+/*
+ 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 *** */
+}
+\f
+Pointer
+ Registers[REGBLOCK_MINIMUM_LENGTH],
+ compiler_utilities,
+ return_to_interpreter;
+
+long
+ compiler_interface_version,
+ compiler_processor_type;
+\f
+/* 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*/
+}
+\f
+#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)
+\f
+/* 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);
+}
--- /dev/null
+/* -*-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 .
+ *
+ */
+\f
+/*
+ * 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
+\f
+#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();
+\f
+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));
+}
+\f
+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));
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+ }
+\f
+ 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);
+ }
+}
+\f
+/*
+ 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 *** */
+}
+\f
+Pointer
+ Registers[REGBLOCK_MINIMUM_LENGTH],
+ compiler_utilities,
+ return_to_interpreter;
+
+long
+ compiler_interface_version,
+ compiler_processor_type;
+\f
+/* 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*/
+}
+\f
+#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)
+\f
+/* 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);
+}
projects / mit-scheme.git / commitdiff