but not any more.
of the list are separated by semicolons, and the default value is
@file{c:\scheme\lib}.
-@item --utabmd @var{filename}
-@opindex --utabmd
-@opindex --utab
-@nvindex MITSCHEME_UTABMD_FILE
-Specifies that @var{filename} contains the microcode tables (the
-microcode tables are information that informs the runtime system about
-the microcode's structure). @var{Filename} is searched for in the
-working directory and the library directories. If this option isn't
-given, the filename is the value of the environment variable
-@env{MITSCHEME_UTABMD_FILE}, or if that isn't defined,
-@file{utabmd.bin}; in these cases the library directories are searched,
-but not the working directory.
-
-@option{--utab} is an alternate name for the @option{--utabmd} option;
-at most one of these options may be given.
-
@item --fasl @var{filename}
@opindex --fasl
Specifies that a @dfn{cold load} should be performed, using
The size of the stack, in 1024-word blocks, if the size options are not
given. Overridden by @option{--stack}, @option{--large},
@option{--compiler}, or @option{--edwin}.
-
-@item @env{MITSCHEME_UTABMD_FILE} (default: @file{utabmd.bin} in the library path)
-@nvindex MITSCHEME_UTABMD_FILE
-The file containing the microcode tables. Overridden by
-@option{--utabmd} and @option{--utab}.
@end table
@node Bchscheme Environment Variables, Runtime Environment Variables, Microcode Environment Variables, Environment Variables
echo "mkdir psb/lib"
mkdir psb/lib
fi
-echo "Bintopsb lib/utabmd.bin"
-./microcode/Bintopsb < microcode/utabmd.bin > psb/lib/utabmd.bin
for i in runtime sf cref
do
(sf "$scheme/etc/direct")
(load "$scheme/etc/direct" system-global-environment)
-(sf "$scheme/microcode/utabmd" "$scheme/runtime/")
-
(sf (directory-read "$scheme/runtime/*.scm"))
(%cd "$scheme/sf")
+++ /dev/null
-#!/bin/csh -f
-#
-# This file is a script to allow Scheme to be run out of a
-# non-standard directory without recompiling the microcode. After
-# editing the following line to indicate where Scheme directories are,
-# this script can be used to invoke Scheme.
-set base="${HOME}/dist-7.0"
-
-set program="$0"
-set scheme="${base}/microcode/scheme"
-
-set seen_utab="0"
-set utab="${base}/lib/utabmd.bin"
-
-set seen_band="0"
-set band_option="-band"
-set band="${base}/lib/runtime.bin"
-
-set extra=()
-
-while ($#argv != 0)
-
- switch ($argv[1])
- case "-fasl":
- case "-band":
- set band_option="$argv[1]"
- if ($#argv == 1) then
- echo "${program}: $band_option requires an argument"
- exit 1
- endif
- if ("$seen_band" != "0") then
- echo "${program}: Too many image specifiers"
- exit 1
- endif
- set seen_band="1"
- set band="$argv[2]"
- shift
- breaksw
-
- case "-utabmd":
- case "-utab":
- if ($#argv == 1) then
- echo "${program}: $argv[1] requires an argument"
- exit 1
- endif
- if ("$seen_utab" != "0") then
- echo "${program}: Too many utab specifiers"
- exit 1
- endif
- set seen_utab="1"
- set utab="$argv[2]"
- shift
- breaksw
-
- default:
- set extra=($extra $argv[1])
- breaksw
- endsw
-
- shift
-end
-
-# echo "$scheme" -utab "$utab" "$band_option" "$band" $extra
-exec "$scheme" -utab "$utab" "$band_option" "$band" $extra
In a nutshell, both the "./Setup.sh" command and the "make" invocation
prescribed earlier require the availability of: 1) _some_ executable
MIT/GNU Scheme ``microcode'' file (usually named "scheme"), as well as
-2) the base companion MIT/GNU Scheme microcode table ("utabmd.bin")
-and run-time band for that microcode release. (named "runtime.com").
+2) the run-time band for that microcode release. (named "runtime.com").
Moreover, in the case of the "make" invocation, we also require an
MIT/GNU Scheme run-time compiler band ("compiler.com" or "all.com")
The first step is to obtain the base "runtime.com" and "all.com"
run-time bands, the "scheme" executable (``microcode'') that
corresponds to the release we wish to build from the CVS sources,
- and the microcode table ("utabmd.bin") and sundry other MIT/GNU
- Scheme library support files (in `lib/mit-scheme/').
+ and sundry other MIT/GNU Scheme library support files (in
+ `lib/mit-scheme/').
For instance, if the CVS sources are for the Scheme release 7.7.1
branch, then you require `mit-scheme-7.7.1-<cpu>-<ostype>.tar.gz'
the underlying microcode versions atop which they run but the
run-time bands do not link directly into the microcode file (nor
vice versa) so they are functionally coupled but not bit-wise
- coupled nor directly linked at the object code level. This is
- the purpose of the "utabmd.bin" file in `lib/'.
+ coupled nor directly linked at the object code level.
Together, these tell the build scripts where the new CVS "scheme"
microcode file will be made, how to invoke it with a very large
and OS configuration from the ``ucode'' source distribution
and it will still work with the pre-compiled binary release
of the matching runtime library from the binary releases.
- (By the way, this flexible linkage is accomplished courtesy
- of the "utabmd.bin" file in `lib/'. Thank you, "utabmd"!)
Details: Following is a bit more context and detail followed by the
instructions for building just the MIT/GNU Scheme microcode
maybe_link lib/include ../microcode
maybe_link lib/optiondb.scm ../etc/optiondb.scm
maybe_link lib/runtime ../runtime
-maybe_link lib/utabmd.bin ../microcode/utabmd.bin
for SUBDIR in ${INSTALLED_SUBDIRS} ${OTHER_SUBDIRS}; do
echo "setting up ${SUBDIR}"
(load "make")))
(in-liarc
(lambda ()
- (compile-boot-dirs c-compile-dir)
- (cf-conditionally "microcode/utabmd"))))
+ (compile-boot-dirs c-compile-dir))))
(define (native-prepare)
(load-option 'SF)
(load "compiler.so")
(load make-file))))
(fluid-let ((compiler:cross-compiling? #t))
- (compile-boot-dirs compile-dir)
- (sf-conditionally "microcode/utabmd")))
+ (compile-boot-dirs compile-dir)))
(define (compiler-make-file)
(string-append
(in-liarc
(lambda ()
(compile-all-dirs c-compile-dir)
- (cf-conditionally "microcode/utabmd")
(cbf-conditionally "edwin/edwin.bld"))))
(define (in-liarc thunk)
#include "prims.h"
#include "option.h"
#include "ostop.h"
-#include "ostty.h"
extern void init_exit_scheme (void);
extern void OS_announcement (void);
-extern void OS_syscall_names (unsigned long *, const char ***);
-extern void OS_syserr_names (unsigned long *, const char ***);
-extern SCHEME_OBJECT initialize_history (void);
-extern SCHEME_OBJECT initialize_interrupt_handler_vector (void);
-extern SCHEME_OBJECT initialize_interrupt_mask_vector (void);
+extern void initialize_fixed_objects_vector (void);
extern SCHEME_OBJECT Re_Enter_Interpreter (void);
+extern SCHEME_OBJECT make_microcode_identification_vector (void);
#ifdef __WIN32__
extern void NT_initialize_win32_system_utilities (void);
\f
static void start_scheme (void);
static void Enter_Interpreter (void);
-static const char * cc_arch_name (void);
const char * scheme_program_name;
const char * OS_Name;
return (0);
}
\f
-static SCHEME_OBJECT
-names_to_vector (unsigned long length, const char ** names)
-{
- SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, length, true));
- unsigned long i;
- for (i = 0; (i < length); i += 1)
- VECTOR_SET (v, i, (char_pointer_to_symbol (names[i])));
- return (v);
-}
-
-static SCHEME_OBJECT
-fixed_objects_syscall_names (void)
-{
- unsigned long length;
- const char ** names;
- OS_syscall_names ((&length), (&names));
- return (names_to_vector (length, names));
-}
-
-static SCHEME_OBJECT
-fixed_objects_syserr_names (void)
-{
- unsigned long length;
- const char ** names;
- OS_syserr_names ((&length), (&names));
- return (names_to_vector (length, names));
-}
-
-void
-initialize_fixed_objects_vector (void)
-{
- fixed_objects = (make_vector (N_FIXED_OBJECTS, SHARP_F, false));
- VECTOR_SET (fixed_objects, NON_OBJECT, (MAKE_OBJECT (TC_CONSTANT, 2)));
- VECTOR_SET (fixed_objects, SYSTEM_INTERRUPT_VECTOR,
- (initialize_interrupt_handler_vector ()));
- VECTOR_SET (fixed_objects, FIXOBJ_INTERRUPT_MASK_VECTOR,
- (initialize_interrupt_mask_vector ()));
- /* Error vector is not needed at boot time */
- VECTOR_SET (fixed_objects, SYSTEM_ERROR_VECTOR, SHARP_F);
- VECTOR_SET (fixed_objects, OBARRAY,
- (make_vector (OBARRAY_SIZE, EMPTY_LIST, false)));
- VECTOR_SET (fixed_objects, DUMMY_HISTORY, (initialize_history ()));
- VECTOR_SET (fixed_objects, State_Space_Tag, SHARP_T);
- VECTOR_SET (fixed_objects, Bignum_One, (long_to_bignum (1)));
- VECTOR_SET (fixed_objects, FIXOBJ_EDWIN_AUTO_SAVE, EMPTY_LIST);
- VECTOR_SET (fixed_objects, FIXOBJ_FILES_TO_DELETE, EMPTY_LIST);
- VECTOR_SET (fixed_objects, FIXOBJ_SYSTEM_CALL_NAMES,
- (fixed_objects_syscall_names ()));
- VECTOR_SET (fixed_objects, FIXOBJ_SYSTEM_CALL_ERRORS,
- (fixed_objects_syserr_names ()));
-
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_ZERO_P,
- (make_primitive ("INTEGER-ZERO?", 1)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_POSITIVE_P,
- (make_primitive ("INTEGER-POSITIVE?", 1)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_NEGATIVE_P,
- (make_primitive ("INTEGER-NEGATIVE?", 1)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_SUCCESSOR,
- (make_primitive ("INTEGER-ADD-1", 1)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_PREDECESSOR,
- (make_primitive ("INTEGER-SUBTRACT-1", 1)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_EQUAL_P,
- (make_primitive ("INTEGER-EQUAL?", 2)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_LESS_P,
- (make_primitive ("INTEGER-LESS?", 2)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_GREATER_P,
- (make_primitive ("INTEGER-GREATER?", 2)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_ADD,
- (make_primitive ("INTEGER-ADD", 2)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_SUBTRACT,
- (make_primitive ("INTEGER-SUBTRACT", 2)));
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_MULTIPLY,
- (make_primitive ("INTEGER-MULTIPLY", 2)));
-
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_DIVIDE, SHARP_F);
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_QUOTIENT, SHARP_F);
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_REMAINDER, SHARP_F);
- VECTOR_SET (fixed_objects, GENERIC_TRAMPOLINE_MODULO, SHARP_F);
-
- VECTOR_SET (fixed_objects, ARITY_DISPATCHER_TAG,
- (char_pointer_to_symbol ("#[(microcode)arity-dispatcher-tag]")));
-
-#ifdef __WIN32__
- NT_initialize_fov (fixed_objects);
-#endif
-}
-\f
/* Boot Scheme */
#ifndef ENTRY_HOOK
\f
/* Utility primitives. */
-#define IDENTITY_LENGTH 20 /* Plenty of room */
-#define ID_RELEASE 0 /* System release (string) */
-#define ID_MICRO_VERSION 1 /* Microcode version (fixnum) */
-/* 2 unused */
-#define ID_PRINTER_WIDTH 3 /* TTY width (# chars) */
-#define ID_PRINTER_LENGTH 4 /* TTY height (# chars) */
-#define ID_NEW_LINE_CHARACTER 5 /* #\Newline */
-#define ID_FLONUM_PRECISION 6 /* Flonum mantissa (# bits) */
-#define ID_FLONUM_EPSILON 7 /* Flonum epsilon (flonum) */
-#define ID_OS_NAME 8 /* OS name (string) */
-#define ID_OS_VARIANT 9 /* OS variant (string) */
-#define ID_STACK_TYPE 10 /* Scheme stack type (string) */
-#define ID_MACHINE_TYPE 11 /* Machine type (string) */
-#define ID_CC_ARCH 12 /* Compiled-code support (string) */
-
DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_microcode_identify, 0, 0, 0)
-{
- SCHEME_OBJECT v;
- PRIMITIVE_HEADER (0);
-
- v = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
- VECTOR_SET (v, ID_RELEASE, SHARP_F);
- VECTOR_SET (v, ID_MICRO_VERSION, (char_pointer_to_string (PACKAGE_VERSION)));
- VECTOR_SET (v, ID_PRINTER_WIDTH, (ULONG_TO_FIXNUM (OS_tty_x_size ())));
- VECTOR_SET (v, ID_PRINTER_LENGTH, (ULONG_TO_FIXNUM (OS_tty_y_size ())));
- VECTOR_SET (v, ID_NEW_LINE_CHARACTER, (ASCII_TO_CHAR ('\n')));
- VECTOR_SET (v, ID_FLONUM_PRECISION, (ULONG_TO_FIXNUM (DBL_MANT_DIG)));
- VECTOR_SET (v, ID_FLONUM_EPSILON, (double_to_flonum ((double) DBL_EPSILON)));
- VECTOR_SET (v, ID_OS_NAME, (char_pointer_to_string (OS_Name)));
- VECTOR_SET (v, ID_OS_VARIANT, (char_pointer_to_string (OS_Variant)));
- VECTOR_SET (v, ID_STACK_TYPE, (char_pointer_to_string ("standard")));
- VECTOR_SET (v, ID_MACHINE_TYPE, (char_pointer_to_string (MACHINE_TYPE)));
- {
- const char * name = (cc_arch_name ());
- if (name != 0)
- VECTOR_SET (v, ID_CC_ARCH, (char_pointer_to_string (name)));
- }
- PRIMITIVE_RETURN (v);
-}
-
-static const char *
-cc_arch_name (void)
-{
- switch (compiler_processor_type)
- {
- case COMPILER_NONE_TYPE: return ("none");
- case COMPILER_MC68020_TYPE: return ("mc68k");
- case COMPILER_VAX_TYPE: return ("vax");
- case COMPILER_SPECTRUM_TYPE: return ("hppa");
- case COMPILER_MC68040_TYPE: return ("mc68k");
- case COMPILER_SPARC_TYPE: return ("sparc");
- case COMPILER_IA32_TYPE: return ("i386");
- case COMPILER_ALPHA_TYPE: return ("alpha");
- case COMPILER_MIPS_TYPE: return ("mips");
- case COMPILER_C_TYPE: return ("c");
- case COMPILER_SVM_TYPE: return ("svm1");
- default: return (0);
- }
-}
-
-DEFINE_PRIMITIVE ("MICROCODE-SYSTEM-CALL-NAMES", Prim_microcode_syscall_names, 0, 0, 0)
-{
- PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (fixed_objects_syscall_names ());
-}
-
-DEFINE_PRIMITIVE ("MICROCODE-SYSTEM-ERROR-NAMES", Prim_microcode_syserr_names, 0, 0, 0)
-{
- PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (fixed_objects_syserr_names ());
-}
-\f
-DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_microcode_tables_filename, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (option_utabmd_file));
+ PRIMITIVE_RETURN (make_microcode_identification_vector ());
}
DEFINE_PRIMITIVE ("MICROCODE-LIBRARY-PATH", Prim_microcode_library_path, 0, 0, 0)
LIARC_VARS=/dev/null
LIARC_RULES=/dev/null
AUX_PROGRAMS=
-AUX_DATA=utabmd.bin
+AUX_DATA=
AUXDIR_NAME=mit-scheme
EXE_NAME=mit-scheme-native
INSTALL_INCLUDE=
LIARC_VARS=liarc-vars
LIARC_RULES=liarc-rules
AUX_PROGRAMS="gen-nonce extract-liarc-decls"
- AUX_DATA=
AUXDIR_NAME=mit-scheme-c
EXE_NAME=mit-scheme-c
INSTALL_INCLUDE=install-include
#define ERR_STACK_HAS_SLIPPED 0x3D
#define ERR_CANNOT_RECURSE 0x3E
-/* If you add any error codes here, add them to the table below and to
- utabmd.scm as well. */
+/* If you add any error codes here, add them to the table below. */
#define MAX_ERROR 0x3E
\f
#define ERROR_NAME_TABLE \
{ \
-/* 0x00 */ "BAD-ERROR-CODE", \
-/* 0x01 */ "UNBOUND-VARIABLE", \
-/* 0x02 */ "UNASSIGNED-VARIABLE", \
-/* 0x03 */ "INAPPLICABLE-OBJECT", \
-/* 0x04 */ "ERROR-IN-SYSTEM-CALL", \
-/* 0x05 */ "ERROR-WITH-ARGUMENT", \
-/* 0x06 */ "BAD-FRAME", \
-/* 0x07 */ "BROKEN-COMPILED-VARIABLE", \
-/* 0x08 */ "UNDEFINED-USER-TYPE", \
-/* 0x09 */ "UNDEFINED-PRIMITIVE", \
-/* 0x0A */ "EXTERNAL-RETURN", \
-/* 0x0B */ "EXECUTE-MANIFEST-VECTOR", \
-/* 0x0C */ "WRONG-NUMBER-OF-ARGUMENTS", \
-/* 0x0D */ "ARG-1-WRONG-TYPE", \
-/* 0x0E */ "ARG-2-WRONG-TYPE", \
-/* 0x0F */ "ARG-3-WRONG-TYPE", \
-/* 0x10 */ "ARG-1-BAD-RANGE", \
-/* 0x11 */ "ARG-2-BAD-RANGE", \
-/* 0x12 */ "ARG-3-BAD-RANGE", \
-/* 0x13 */ "MACRO-BINDING", \
-/* 0x14 */ "FASDUMP-OBJECT-TOO-LARGE", \
+/* 0x00 */ "bad-error-code", \
+/* 0x01 */ "unbound-variable", \
+/* 0x02 */ "unassigned-variable", \
+/* 0x03 */ "undefined-procedure", \
+/* 0x04 */ "system-call", \
+/* 0x05 */ "error-with-argument", \
+/* 0x06 */ "bad-frame", \
+/* 0x07 */ "broken-compiled-variable", \
+/* 0x08 */ "undefined-user-type", \
+/* 0x09 */ "undefined-primitive-operation", \
+/* 0x0a */ "external-return", \
+/* 0x0b */ "execute-manifest-vector", \
+/* 0x0c */ "wrong-number-of-arguments", \
+/* 0x0d */ "wrong-type-argument-0", \
+/* 0x0e */ "wrong-type-argument-1", \
+/* 0x0f */ "wrong-type-argument-2", \
+/* 0x10 */ "bad-range-argument-0", \
+/* 0x11 */ "bad-range-argument-1", \
+/* 0x12 */ "bad-range-argument-2", \
+/* 0x13 */ "macro-binding", \
+/* 0x14 */ "fasdump-object-too-large", \
/* 0x15 */ 0, \
/* 0x16 */ 0, \
-/* 0x17 */ "FASL-FILE-TOO-BIG", \
-/* 0x18 */ "FASL-FILE-BAD-DATA", \
+/* 0x17 */ "fasl-file-too-big", \
+/* 0x18 */ "fasl-file-bad-data", \
/* 0x19 */ 0, \
-/* 0x1A */ "WRITE-INTO-PURE-SPACE", \
-/* 0x1B */ 0, \
-/* 0x1C */ 0, \
-/* 0x1D */ "BAD-SET", \
-/* 0x1E */ "ARG-1-FAILED-COERCION", \
-/* 0x1F */ "ARG-2-FAILED-COERCION", \
-/* 0x20 */ "OUT-OF-FILE-HANDLES", \
+/* 0x1a */ 0, \
+/* 0x1b */ 0, \
+/* 0x1c */ 0, \
+/* 0x1d */ "bad-assignment", \
+/* 0x1e */ "failed-arg-1-coercion", \
+/* 0x1f */ "failed-arg-2-coercion", \
+/* 0x20 */ "out-of-file-handles", \
/* 0x21 */ 0, \
-/* 0x22 */ "ARG-4-BAD-RANGE", \
-/* 0x23 */ "ARG-5-BAD-RANGE", \
-/* 0x24 */ "ARG-6-BAD-RANGE", \
-/* 0x25 */ "ARG-7-BAD-RANGE", \
-/* 0x26 */ "ARG-8-BAD-RANGE", \
-/* 0x27 */ "ARG-9-BAD-RANGE", \
-/* 0x28 */ "ARG-10-BAD-RANGE", \
-/* 0x29 */ "ARG-4-WRONG-TYPE", \
-/* 0x2A */ "ARG-5-WRONG-TYPE", \
-/* 0x2B */ "ARG-6-WRONG-TYPE", \
-/* 0x2C */ "ARG-7-WRONG-TYPE", \
-/* 0x2D */ "ARG-8-WRONG-TYPE", \
-/* 0x2E */ "ARG-9-WRONG-TYPE", \
-/* 0x2F */ "ARG-10-WRONG-TYPE", \
-/* 0x30 */ "INAPPLICABLE-CONTINUATION", \
-/* 0x31 */ "COMPILED-CODE-ERROR", \
-/* 0x32 */ "FLOATING-OVERFLOW", \
-/* 0x33 */ "UNIMPLEMENTED-PRIMITIVE", \
-/* 0x34 */ "ILLEGAL-REFERENCE-TRAP", \
-/* 0x35 */ "BROKEN-VARIABLE-CACHE", \
-/* 0x36 */ "WRONG-ARITY-PRIMITIVES", \
-/* 0x37 */ "IO-ERROR", \
-/* 0x38 */ "FASDUMP-ENVIRONMENT", \
-/* 0x39 */ "FASLOAD-BAND", \
-/* 0x3A */ "FASLOAD-COMPILED-MISMATCH", \
-/* 0x3B */ "UNKNOWN-PRIMITIVE-CONTINUATION", \
-/* 0x3C */ "ILLEGAL-CONTINUATION", \
-/* 0x3D */ "STACK-HAS-SLIPPED", \
-/* 0x3E */ "CANNOT-RECURSE" \
+/* 0x22 */ "bad-range-argument-3", \
+/* 0x23 */ "bad-range-argument-4", \
+/* 0x24 */ "bad-range-argument-5", \
+/* 0x25 */ "bad-range-argument-6", \
+/* 0x26 */ "bad-range-argument-7", \
+/* 0x27 */ "bad-range-argument-8", \
+/* 0x28 */ "bad-range-argument-9", \
+/* 0x29 */ "wrong-type-argument-3", \
+/* 0x2a */ "wrong-type-argument-4", \
+/* 0x2b */ "wrong-type-argument-5", \
+/* 0x2c */ "wrong-type-argument-6", \
+/* 0x2d */ "wrong-type-argument-7", \
+/* 0x2e */ "wrong-type-argument-8", \
+/* 0x2f */ "wrong-type-argument-9", \
+/* 0x30 */ "inapplicable-continuation", \
+/* 0x31 */ "compiled-code-error", \
+/* 0x32 */ "floating-overflow", \
+/* 0x33 */ "unimplemented-primitive", \
+/* 0x34 */ "illegal-reference-trap", \
+/* 0x35 */ "broken-variable-cache", \
+/* 0x36 */ "wrong-arity-primitives", \
+/* 0x37 */ "io-error", \
+/* 0x38 */ "fasdump-environment", \
+/* 0x39 */ "fasload-band", \
+/* 0x3a */ "fasload-compiled-mismatch", \
+/* 0x3b */ "unknown-primitive-continuation", \
+/* 0x3c */ "illegal-continuation", \
+/* 0x3d */ "stack-has-slipped", \
+/* 0x3e */ "cannot-recurse" \
}
\f
/* Termination codes: the interpreter halts on these */
\f
#define TERM_NAME_TABLE \
{ \
-/* 0x00 */ "HALT", \
-/* 0x01 */ "DISK-RESTORE", \
-/* 0x02 */ "BROKEN-HEART", \
-/* 0x03 */ "NON-POINTER-RELOCATION", \
-/* 0x04 */ "BAD-ROOT", \
-/* 0x05 */ "NON-EXISTENT-CONTINUATION", \
-/* 0x06 */ "BAD-STACK", \
-/* 0x07 */ "STACK-OVERFLOW", \
-/* 0x08 */ "STACK-ALLOCATION-FAILED", \
-/* 0x09 */ "NO-ERROR-HANDLER", \
-/* 0x0A */ "NO-INTERRUPT-HANDLER", \
-/* 0x0B */ "UNIMPLEMENTED-CONTINUATION", \
-/* 0x0C */ "EXIT", \
-/* 0x0D */ "BAD-PRIMITIVE-DURING-ERROR", \
-/* 0x0E */ "EOF", \
-/* 0x0F */ "BAD-PRIMITIVE", \
-/* 0x10 */ "HANDLER", \
-/* 0x11 */ "END-OF-COMPUTATION", \
-/* 0x12 */ "INVALID-TYPE-CODE", \
-/* 0x13 */ "COMPILER-DEATH", \
-/* 0x14 */ "GC-OUT-OF-SPACE", \
-/* 0x15 */ "NO-SPACE", \
-/* 0x16 */ "SIGNAL", \
-/* 0x17 */ "TOUCH", \
-/* 0x18 */ "SAVE-AND-EXIT", \
-/* 0x19 */ "TERM_TRAP", \
-/* 0x1a */ "BAD_BACK_OUT" \
+/* 0x00 */ "halt", \
+/* 0x01 */ "disk-restore", \
+/* 0x02 */ "broken-heart", \
+/* 0x03 */ "non-pointer-relocation", \
+/* 0x04 */ "bad-root", \
+/* 0x05 */ "non-existent-continuation", \
+/* 0x06 */ "bad-stack", \
+/* 0x07 */ "stack-overflow", \
+/* 0x08 */ "stack-allocation-failed", \
+/* 0x09 */ "no-error-handler", \
+/* 0x0a */ "no-interrupt-handler", \
+/* 0x0b */ "unimplemented-continuation", \
+/* 0x0c */ "exit", \
+/* 0x0d */ "bad-primitive-during-error", \
+/* 0x0e */ "eof", \
+/* 0x0f */ "bad-primitive", \
+/* 0x10 */ "termination-handler", \
+/* 0x11 */ "end-of-computation", \
+/* 0x12 */ "invalid-type-code", \
+/* 0x13 */ "compiler-death", \
+/* 0x14 */ "gc-out-of-space", \
+/* 0x15 */ "no-space", \
+/* 0x16 */ "signal", \
+/* 0x17 */ 0, \
+/* 0x18 */ "save-and-exit", \
+/* 0x19 */ "trap", \
+/* 0x1a */ "bad-back-out" \
}
\f
#define TERM_MESSAGE_TABLE \
extern const char * Error_Names [];
extern const char * Term_Names [];
extern const char * term_messages [];
+extern const char * fixed_objects_names [];
extern bool trapping;
*/
-/* Declarations of user offsets into the Fixed Objects Vector.
- This should correspond to the file "utabmd.scm". */
+/* Declarations of user offsets into the Fixed Objects Vector. */
\f
#define NON_OBJECT 0x00 /* Used for unassigned variables. */
#define SYSTEM_INTERRUPT_VECTOR 0x01 /* Handlers for interrupts. */
/* #define UNUSED 0x19 */
/* #define UNUSED 0x1A */
/* #define UNUSED 0x1B */
-#define Precious_Objects 0x1C /* Objects that should not be lost! */
+/* #define UNUSED 0x1C */
#define Error_Procedure 0x1D /* User invoked error handler. */
/* #define UNUSED 0x1E */
/* #define UNUSED 0x1F */
#define CC_ERROR_PROCEDURE 0x20 /* Error handler for compiled code. */
-#define Lost_Objects_Base 0x21 /* Free at the end of the "real" gc. */
+/* #define UNUSED 0x21 */
#define State_Space_Root 0x22 /* Root of state space. */
#define Primitive_Profiling_Table 0x23 /* Table of profile counts for
primitives. */
/* 4 extra slots for expansion and debugging. */
#define N_FIXED_OBJECTS 0x45
+\f
+#define FIXED_OBJECTS_NAMES \
+{ \
+ /* 0x00 */ "non-object", \
+ /* 0x01 */ "system-interrupt-vector", \
+ /* 0x02 */ "system-error-vector", \
+ /* 0x03 */ "obarray", \
+ /* 0x04 */ "microcode-types-vector", \
+ /* 0x05 */ "microcode-returns-vector", \
+ /* 0x06 */ "interrupt-mask-vector", \
+ /* 0x07 */ "microcode-errors-vector", \
+ /* 0x08 */ "microcode-identification-vector", \
+ /* 0x09 */ "system-call-names", \
+ /* 0x0A */ "system-call-errors", \
+ /* 0x0B */ "gc-daemon", \
+ /* 0x0C */ "trap-handler", \
+ /* 0x0D */ "edwin-auto-save", \
+ /* 0x0E */ "stepper-state", \
+ /* 0x0F */ "microcode-fixed-objects-slots", \
+ /* 0x10 */ "files-to-delete", \
+ /* 0x11 */ "state-space-tag", \
+ /* 0x12 */ "state-point-tag", \
+ /* 0x13 */ "dummy-history", \
+ /* 0x14 */ "bignum-one", \
+ /* 0x15 */ 0, \
+ /* 0x16 */ "microcode-terminations-vector", \
+ /* 0x17 */ "microcode-terminations-procedures", \
+ /* 0x18 */ 0, \
+ /* 0x19 */ 0, \
+ /* 0x1A */ 0, \
+ /* 0x1B */ 0, \
+ /* 0x1C */ 0, \
+ /* 0x1D */ "error-procedure", \
+ /* 0x1E */ 0, \
+ /* 0x1F */ 0, \
+ /* 0x20 */ "compiler-error-procedure", \
+ /* 0x21 */ 0, \
+ /* 0x22 */ "state-space-root", \
+ /* 0x23 */ "primitive-profiling-table", \
+ /* 0x24 */ "generic-trampoline-zero?", \
+ /* 0x25 */ "generic-trampoline-positive?", \
+ /* 0x26 */ "generic-trampoline-negative?", \
+ /* 0x27 */ "generic-trampoline-add-1", \
+ /* 0x28 */ "generic-trampoline-subtract-1", \
+ /* 0x29 */ "generic-trampoline-equal?", \
+ /* 0x2A */ "generic-trampoline-less?", \
+ /* 0x2B */ "generic-trampoline-greater?", \
+ /* 0x2C */ "generic-trampoline-add", \
+ /* 0x2D */ "generic-trampoline-subtract", \
+ /* 0x2E */ "generic-trampoline-multiply", \
+ /* 0x2F */ "generic-trampoline-divide", \
+ /* 0x30 */ "generic-trampoline-quotient", \
+ /* 0x31 */ "generic-trampoline-remainder", \
+ /* 0x32 */ "generic-trampoline-modulo", \
+ /* 0x33 */ "arity-dispatcher-tag", \
+ /* 0x34 */ "pc-sample/builtin-table" \
+ /* 0x35 */ "pc-sample/utility-table", \
+ /* 0x36 */ "pc-sample/primitive-table", \
+ /* 0x37 */ "pc-sample/code-block-table", \
+ /* 0x38 */ "pc-sample/purified-code-block-block-buffer", \
+ /* 0x39 */ "pc-sample/purified-code-block-offset-buffer", \
+ /* 0x3A */ "pc-sample/heathen-code-block-block-buffer", \
+ /* 0x3B */ "pc-sample/heathen-code-block-offset-buffer", \
+ /* 0x3C */ "pc-sample/interp-proc-buffer", \
+ /* 0x3D */ "pc-sample/prob-comp-table", \
+ /* 0x3E */ "pc-sample/ufo-table", \
+ /* 0x3F */ "compiled-code-bkpt-handler", \
+ /* 0x40 */ "gc-wabbit-descwiptor", \
+ /* 0x41 */ 0, \
+ /* 0x42 */ 0, \
+ /* 0x43 */ 0, \
+ /* 0x44 */ 0, \
+ /* 0x45 */ 0 \
+}
MOSTLYCLEAN_FILES = *.o usrdef.c compinit.c compinit.h cmpauxmd.s \
$(LIARC_OBJECTS)
-CLEAN_FILES = $(ALL_PROGRAMS) $(ALL_LIBS) $(ALL_DATA) $(EXTRA_PROGRAMS) \
- utabmd.bin
+CLEAN_FILES = $(ALL_PROGRAMS) $(ALL_LIBS) $(ALL_DATA) $(EXTRA_PROGRAMS)
DISTCLEAN_FILES = Makefile config.h config.cache config.log config.status \
cmpauxmd.m4 cmpauxmd.c cmpintmd.h makegen-cc \
MAINTAINER_CLEAN_FILES = Makefile.in Makefile.deps liarc-vars liarc-rules \
config.h.in configure TAGS
-C_CLEAN_FILES = utabmd.c utabmd.bci
-
# **** Implicit rules ****
.SUFFIXES:
# **** Main rules ****
-default-target: $(ALL_PROGRAMS) $(ALL_LIBS)
-
all: $(ALL_PROGRAMS) $(ALL_LIBS) $(ALL_DATA)
scheme: $(scheme_OBJECTS) $(scheme_DEPENDENCIES)
macosx-starter: macosx-starter.o
$(LINK) macosx-starter.o
-utabmd.bin: utabmd.scm
- ./utabmd.sh
-
prbfish.so: prbfish.o scheme
$(LINK_MODULE) prbfish.o $(PRBFISH_LIBS) $(MODULE_LIBS)
"term"
"transact"
"tterm"
+"utabmd"
"utils"
"vector"
"wind"
(loop))))))))))
(define (liarc-static-files)
- (append '("utabmd")
- (append-map package-description-files
+ (append (append-map package-description-files
(read-file "makegen/pkds-liarc.scm"))
(enumerate-directories (read-file "makegen/dirs-liarc.scm"))))
static bool option_summary;
static const char * option_raw_library;
-static const char * option_raw_utabmd;
static const char * option_raw_band;
static const char * option_raw_heap;
static const char * option_raw_constant;
const char ** option_library_path = 0;
const char * option_band_file = 0;
const char * option_fasl_file = 0;
-const char * option_utabmd_file = 0;
/* Numeric options */
unsigned long option_heap_size;
load is performed instead. This option may not be used together\n\
with the \"--band\" option.\n\
\n\
---utabmd FILENAME\n\
- Specifies the name of the microcode tables file. The file is\n\
- searched for in the working directory and the library directories.\n\
- If this option isn't given, the filename is the value of the\n\
- environment variable MITSCHEME_UTABMD_FILE, or if that isn't\n\
- defined, \"utabmd.bin\"; in these cases the library directories are\n\
- searched, but not the working directory.\n\
-\n\
--heap BLOCKS\n\
Specifies the size of the heap in 1024-word blocks. Overrides any\n\
default.\n\
# define DEFAULT_STD_BAND "all.com"
#endif
-#ifndef UTABMD_FILE_VARIABLE
-# define UTABMD_FILE_VARIABLE "MITSCHEME_UTABMD_FILE"
-#endif
-
-#ifndef DEFAULT_UTABMD_FILE
-# define DEFAULT_UTABMD_FILE "utabmd.bin"
-#endif
-
#ifndef DEFAULT_HEAP_SIZE
# define DEFAULT_HEAP_SIZE 4096
#endif
option_argument ("quiet", false, (&option_batch_mode));
option_argument ("silent", false, (&option_batch_mode));
option_argument ("stack", true, (&option_raw_stack));
- option_argument ("utabmd", true, (&option_raw_utabmd));
option_argument ("version", false, (&option_show_version));
/* These are deprecated: */
option_argument ("compiler", false, 0);
option_argument ("edwin", false, 0);
option_argument ("large", false, 0);
- option_argument ("utab", true, (&option_raw_utabmd));
+ option_argument ("utab", true, 0);
+ option_argument ("utabmd", true, 0);
parse_options (argc, argv);
}
describe_string_option ("FASL file", option_fasl_file);
else
describe_string_option ("band", option_band_file);
- describe_string_option ("microcode tables", option_utabmd_file);
describe_boolean_option ("emacs subprocess", option_emacs_subprocess);
describe_boolean_option ("force interactive", option_force_interactive);
describe_boolean_option ("disable core dump", option_disable_core_dump);
option_raw_stack,
STACK_SIZE_VARIABLE,
DEFAULT_STACK_SIZE));
- if (option_utabmd_file != 0)
- {
- xfree (option_utabmd_file);
- option_utabmd_file = 0;
- }
- option_utabmd_file
- = (standard_filename_option ("utabmd",
- option_raw_utabmd,
- UTABMD_FILE_VARIABLE,
- DEFAULT_UTABMD_FILE,
-#ifdef CC_IS_C
- /* FIXME: This should check if we
- have "microcode_utabmd"
- compiled */
- false
-#else
- (option_fasl_file != 0)
-#endif
- ));
-
if (option_show_version)
outf_console ("%s", PACKAGE_STRING);
if (option_show_help)
extern const char ** option_library_path;
extern const char * option_band_file;
extern const char * option_fasl_file;
-extern const char * option_utabmd_file;
/* Numeric options */
extern unsigned long option_heap_size;
if (bundle == 0)
return (0);
- url = (CFBundleCopyResourceURL
- (bundle, (CFSTR ("utabmd")), (CFSTR ("bin")), 0));
+ url = (CFBundleCopyResourceURL (bundle, (CFSTR ("all")), (CFSTR ("com")), 0));
if (url == 0)
return (0);
interpreter operation needs to operate in several phases. */
\f
#define RC_END_OF_COMPUTATION 0x00
-/* RC_RESTORE_CONTROL_POINT 0x01 */
#define RC_JOIN_STACKLETS 0x01
-/* RC_RESTORE_CONTINUATION 0x02 */
+/* unused 0x02 */
#define RC_INTERNAL_APPLY 0x03
-/* RC_BAD_INTERRUPT_CONTINUE 0x04 */
+/* unused 0x04 */
#define RC_RESTORE_HISTORY 0x05
#define RC_INVOKE_STACK_THREAD 0x06
-/* RC_RESTART_EXECUTION 0x07 */
+/* unused 0x07 */
#define RC_EXECUTE_ASSIGNMENT_FINISH 0x08
#define RC_EXECUTE_DEFINITION_FINISH 0x09
#define RC_EXECUTE_ACCESS_FINISH 0x0A
#define RC_PCOMB3_APPLY 0x1B
#define RC_SNAP_NEED_THUNK 0x1C
#define RC_REENTER_COMPILED_CODE 0x1D
-/* RC_GET_CHAR_REPEAT 0x1E */
-/* RC_COMP_REFERENCE_RESTART 0x1F */
+/* unused 0x1E */
+/* unused 0x1F */
#define RC_NORMAL_GC_DONE 0x20
-/* RC_COMPLETE_GC_DONE 0x21 */
+/* unused 0x21 */
#define RC_PURIFY_GC_1 0x22
#define RC_PURIFY_GC_2 0x23
-/* RC_AFTER_MEMORY_UPDATE 0x24 */
-/* RC_RESTARTABLE_EXIT 0x25 */
-/* RC_GET_CHAR 0x26 */
-/* RC_GET_CHAR_IMMEDIATE 0x27 */
-/* RC_COMP_ASSIGNMENT_RESTART 0x28 */
+/* unused 0x24 through 0x28 */
#define RC_POP_FROM_COMPILED_CODE 0x29
#define RC_RETURN_TRAP_POINT 0x2A
-/* RC_RESTORE_STEPPER 0x2B */
+/* unused 0x2B */
#define RC_RESTORE_TO_STATE_POINT 0x2C
#define RC_MOVE_TO_ADJACENT_POINT 0x2D
#define RC_RESTORE_VALUE 0x2E
#define RC_RESTORE_DONT_COPY_HISTORY 0x2F
-
+/* unused 0x30 through 0x3F */
#define RC_POP_RETURN_ERROR 0x40
#define RC_EVAL_ERROR 0x41
#define RC_STACK_MARKER 0x42
#define RC_COMP_INTERRUPT_RESTART 0x43
-/* RC_COMP_RECURSION_GC 0x44 */
+/* unused 0x44 */
#define RC_RESTORE_INT_MASK 0x45
#define RC_HALT 0x46
-/* RC_FINISH_GLOBAL_INT 0x47 */
+/* unused 0x47 */
#define RC_REPEAT_DISPATCH 0x48
#define RC_GC_CHECK 0x49
-/* RC_RESTORE_FLUIDS 0x4A */
-/* RC_COMP_LOOKUP_APPLY_RESTART 0x4B */
-/* RC_COMP_ACCESS_RESTART 0x4C */
-/* RC_COMP_UNASSIGNED_P_RESTART 0x4D */
-/* RC_COMP_UNBOUND_P_RESTART 0x4E */
-/* RC_COMP_DEFINITION_RESTART 0x4F */
-/* RC_COMP_LEXPR_INTERRUPT_RESTART 0x50 */
-/* RC_COMP_SAFE_REFERENCE_RESTART 0x51 */
-/* RC_COMP_CACHE_LOOKUP_RESTART 0x52 */
+/* unused 0x4A through 0x52 */
#define RC_COMP_LOOKUP_TRAP_RESTART 0x53
#define RC_COMP_ASSIGNMENT_TRAP_RESTART 0x54
-/* RC_COMP_CACHE_OPERATOR_RESTART 0x55 */
+/* unused 0x55 */
#define RC_COMP_OP_REF_TRAP_RESTART 0x56
#define RC_COMP_CACHE_REF_APPLY_RESTART 0x57
#define RC_COMP_SAFE_REF_TRAP_RESTART 0x58
#define RC_COMP_UNASSIGNED_TRAP_RESTART 0x59
-/* RC_COMP_CACHE_ASSIGN_RESTART 0x5A */
+/* unused 0x5A */
#define RC_COMP_LINK_CACHES_RESTART 0x5B
#define RC_HARDWARE_TRAP 0x5C
#define RC_INTERNAL_APPLY_VAL 0x5D
\f
#define RETURN_NAME_TABLE \
{ \
-/* 0x00 */ "END_OF_COMPUTATION", \
-/* 0x01 */ "JOIN_STACKLETS", \
-/* 0x02 */ "RESTORE_CONTINUATION", \
-/* 0x03 */ "INTERNAL_APPLY", \
-/* 0x04 */ "", \
-/* 0x05 */ "RESTORE_HISTORY", \
-/* 0x06 */ "INVOKE_STACK_THREAD", \
-/* 0x07 */ "", \
-/* 0x08 */ "EXECUTE_ASSIGNMENT_FINISH", \
-/* 0x09 */ "EXECUTE_DEFINITION_FINISH", \
-/* 0x0A */ "EXECUTE_ACCESS_FINISH", \
-/* 0x0b */ "EXECUTE_IN_PACKAGE_CONTINUE", \
-/* 0x0C */ "SEQ_2_DO_2", \
-/* 0x0d */ "SEQ_3_DO_2", \
-/* 0x0E */ "SEQ_3_DO_3", \
-/* 0x0f */ "CONDITIONAL_DECIDE", \
-/* 0x10 */ "DISJUNCTION_DECIDE", \
-/* 0x11 */ "COMB_1_PROCEDURE", \
-/* 0x12 */ "COMB_APPLY_FUNCTION", \
-/* 0x13 */ "COMB_2_FIRST_OPERAND", \
-/* 0x14 */ "COMB_2_PROCEDURE", \
-/* 0x15 */ "COMB_SAVE_VALUE", \
-/* 0x16 */ "PCOMB1_APPLY", \
-/* 0x17 */ "PCOMB2_DO_1", \
-/* 0x18 */ "PCOMB2_APPLY", \
-/* 0x19 */ "PCOMB3_DO_2", \
-/* 0x1A */ "PCOMB3_DO_1", \
-/* 0x1B */ "PCOMB3_APPLY", \
-/* 0x1C */ "SNAP_NEED_THUNK", \
-/* 0x1D */ "REENTER_COMPILED_CODE", \
-/* 0x1E */ "", \
-/* 0x1F */ "COMP_REFERENCE_RESTART", \
-/* 0x20 */ "NORMAL_GC_DONE", \
-/* 0x21 */ "" , \
-/* 0x22 */ "PURIFY_GC_1", \
-/* 0x23 */ "PURIFY_GC_2", \
-/* 0x24 */ "AFTER_MEMORY_UPDATE", \
-/* 0x25 */ "RESTARTABLE_EXIT", \
-/* 0x26 */ "", \
-/* 0x27 */ "", \
-/* 0x28 */ "COMP_ASSIGNMENT_RESTART", \
-/* 0x29 */ "POP_FROM_COMPILED_CODE", \
-/* 0x2A */ "RETURN_TRAP_POINT", \
-/* 0x2B */ "", \
-/* 0x2C */ "RESTORE_TO_STATE_POINT", \
-/* 0x2D */ "MOVE_TO_ADJACENT_POINT", \
-/* 0x2E */ "RESTORE_VALUE", \
-/* 0x2F */ "RESTORE_DONT_COPY_HISTORY", \
-/* 0x30 */ "", \
-/* 0x31 */ "", \
-/* 0x32 */ "", \
-/* 0x33 */ "", \
-/* 0x34 */ "", \
-/* 0x35 */ "", \
-/* 0x36 */ "", \
-/* 0x37 */ "", \
-/* 0x38 */ "", \
-/* 0x39 */ "", \
-/* 0x3A */ "", \
-/* 0x3B */ "", \
-/* 0x3C */ "", \
-/* 0x3D */ "", \
-/* 0x3E */ "", \
-/* 0x3F */ "", \
-/* 0x40 */ "POP_RETURN_ERROR", \
-/* 0x41 */ "EVAL_ERROR", \
-/* 0x42 */ "STACK_MARKER", \
-/* 0x43 */ "COMPILER_INTERRUPT_RESTART", \
-/* 0x44 */ "", \
-/* 0x45 */ "RESTORE_INT_MASK", \
-/* 0x46 */ "HALT", \
-/* 0x47 */ "", \
-/* 0x48 */ "REPEAT_DISPATCH", \
-/* 0x49 */ "GC_CHECK", \
-/* 0x4A */ "", \
-/* 0x4B */ "COMPILER_LOOKUP_APPLY_RESTART", \
-/* 0x4C */ "COMPILER_ACCESS_RESTART", \
-/* 0x4D */ "COMPILER_UNASSIGNED_P_RESTART", \
-/* 0x4E */ "COMPILER_UNBOUND_P_RESTART", \
-/* 0x4F */ "COMPILER_DEFINITION_RESTART", \
-/* 0x50 */ "", \
-/* 0x51 */ "COMPILER_SAFE_REFERENCE_RESTART", \
-/* 0x52 */ "", \
-/* 0x53 */ "COMPILER_LOOKUP_TRAP_RESTART", \
-/* 0x54 */ "COMPILER_ASSIGNMENT_TRAP_RESTART", \
-/* 0X55 */ "", \
-/* 0x56 */ "COMPILER_OPERATOR_REFERENCE_TRAP_RESTART", \
-/* 0x57 */ "COMPILER_CACHE_REFERENCE_APPLY_RESTART", \
-/* 0x58 */ "COMPILER_SAFE_REFERENCE_TRAP_RESTART", \
-/* 0x59 */ "COMPILER_UNASSIGNED_P_TRAP_RESTART", \
-/* 0x5A */ "", \
-/* 0x5B */ "COMPILER_LINK_CACHES_RESTART", \
-/* 0x5C */ "HARDWARE_TRAP", \
-/* 0x5D */ "INTERNAL_APPLY_VAL", \
-/* 0x5E */ "COMPILER_ERROR_RESTART", \
-/* 0x5F */ "PRIMITIVE_CONTINUE" \
+/* 0x00 */ "non-existent-continuation", \
+/* 0x01 */ "join-stacklets", \
+/* 0x02 */ 0, \
+/* 0x03 */ "internal-apply", \
+/* 0x04 */ 0, \
+/* 0x05 */ "restore-history", \
+/* 0x06 */ "invoke-stack-thread", \
+/* 0x07 */ 0, \
+/* 0x08 */ "assignment-continue", \
+/* 0x09 */ "definition-continue", \
+/* 0x0a */ "access-continue", \
+/* 0x0b */ "in-package-continue", \
+/* 0x0c */ "sequence-2-second", \
+/* 0x0d */ "sequence-3-second", \
+/* 0x0e */ "sequence-3-third", \
+/* 0x0f */ "conditional-decide", \
+/* 0x10 */ "disjunction-decide", \
+/* 0x11 */ "combination-1-procedure", \
+/* 0x12 */ "combination-apply", \
+/* 0x13 */ "combination-2-first-operand", \
+/* 0x14 */ "combination-2-procedure", \
+/* 0x15 */ "combination-save-value", \
+/* 0x16 */ "primitive-combination-1-apply", \
+/* 0x17 */ "primitive-combination-2-first-operand", \
+/* 0x18 */ "primitive-combination-2-apply", \
+/* 0x19 */ "primitive-combination-3-second-operand", \
+/* 0x1a */ "primitive-combination-3-first-operand", \
+/* 0x1b */ "primitive-combination-3-apply", \
+/* 0x1c */ "force-snap-thunk", \
+/* 0x1d */ "reenter-compiled-code", \
+/* 0x1e */ 0, \
+/* 0x1f */ 0, \
+/* 0x20 */ "normal-garbage-collect-done", \
+/* 0x21 */ 0, \
+/* 0x22 */ "purify-after-first-gc", \
+/* 0x23 */ "purify-after-second-gc", \
+/* 0x24 */ 0, \
+/* 0x25 */ 0, \
+/* 0x26 */ 0, \
+/* 0x27 */ 0, \
+/* 0x28 */ 0, \
+/* 0x29 */ "pop-from-compiled-code", \
+/* 0x2a */ "return-trap-point", \
+/* 0x2b */ 0, \
+/* 0x2c */ "restore-to-state-point", \
+/* 0x2d */ "move-to-adjacent-point", \
+/* 0x2e */ "restore-value", \
+/* 0x2f */ "restore-dont-copy-history", \
+/* 0x30 */ 0, \
+/* 0x31 */ 0, \
+/* 0x32 */ 0, \
+/* 0x33 */ 0, \
+/* 0x34 */ 0, \
+/* 0x35 */ 0, \
+/* 0x36 */ 0, \
+/* 0x37 */ 0, \
+/* 0x38 */ 0, \
+/* 0x39 */ 0, \
+/* 0x3a */ 0, \
+/* 0x3b */ 0, \
+/* 0x3c */ 0, \
+/* 0x3d */ 0, \
+/* 0x3e */ 0, \
+/* 0x3f */ 0, \
+/* 0x40 */ "pop-return-error", \
+/* 0x41 */ "eval-error", \
+/* 0x42 */ "stack-marker", \
+/* 0x43 */ "compiler-interrupt-restart", \
+/* 0x44 */ 0, \
+/* 0x45 */ "restore-interrupt-mask", \
+/* 0x46 */ "halt", \
+/* 0x47 */ 0, \
+/* 0x48 */ "repeat-dispatch", \
+/* 0x49 */ "gc-check", \
+/* 0x4a */ 0, \
+/* 0x4b */ 0, \
+/* 0x4c */ 0, \
+/* 0x4d */ 0, \
+/* 0x4e */ 0, \
+/* 0x4f */ 0, \
+/* 0x50 */ 0, \
+/* 0x51 */ 0, \
+/* 0x52 */ 0, \
+/* 0x53 */ "compiler-reference-trap-restart", \
+/* 0x54 */ "compiler-assignment-trap-restart", \
+/* 0x55 */ 0, \
+/* 0x56 */ "compiler-operator-lookup-trap-restart", \
+/* 0x57 */ "compiler-lookup-apply-trap-restart", \
+/* 0x58 */ "compiler-safe-reference-trap-restart", \
+/* 0x59 */ "compiler-unassigned?-trap-restart", \
+/* 0x5a */ 0, \
+/* 0x5b */ "compiler-link-caches-restart", \
+/* 0x5c */ "hardware-trap", \
+/* 0x5d */ "internal-apply-val", \
+/* 0x5e */ "compiler-error-restart", \
+/* 0x5f */ "primitive-continue" \
}
const char * Error_Names [] = ERROR_NAME_TABLE; /* in errors.h */
const char * Term_Names [] = TERM_NAME_TABLE; /* in errors.h */
const char * term_messages [] = TERM_MESSAGE_TABLE; /* in errors.h */
+const char * fixed_objects_names [] = FIXED_OBJECTS_NAMES; /* in fixobj.h */
/* Type code definitions */
\f
-#define TC_NULL 0x00
+#define TC_NULL 0x00
#define TC_LIST 0x01
#define TC_CHARACTER 0x02
-#define TC_SCODE_QUOTE 0x03
+#define TC_SCODE_QUOTE 0x03
#define TC_PCOMB2 0x04
#define TC_UNINTERNED_SYMBOL 0x05
#define TC_BIG_FLONUM 0x06
#define TC_CONSTANT 0x08
#define TC_EXTENDED_PROCEDURE 0x09
#define TC_VECTOR 0x0A
-#define TC_RETURN_CODE 0x0B
+#define TC_RETURN_CODE 0x0B
#define TC_COMBINATION_2 0x0C
#define TC_MANIFEST_CLOSURE 0x0D
#define TC_BIG_FIXNUM 0x0E
#define TC_MANIFEST_NM_VECTOR 0x27
#define TC_COMPILED_ENTRY 0x28
#define TC_LEXPR 0x29
-#define TC_PCOMB3 0x2A
+#define TC_PCOMB3 0x2A
/* #define TC_UNUSED 0x2B */
#define TC_VARIABLE 0x2C
#define TC_THE_ENVIRONMENT 0x2D
\f
#define TYPE_NAME_TABLE \
{ \
- /* 0x00 */ "NULL", \
- /* 0x01 */ "LIST", \
- /* 0x02 */ "CHARACTER", \
- /* 0x03 */ "SCODE-QUOTE", \
- /* 0x04 */ "PCOMB2", \
- /* 0x05 */ "UNINTERNED-SYMBOL", \
- /* 0x06 */ "BIG-FLONUM", \
- /* 0x07 */ "COMBINATION-1", \
- /* 0x08 */ "TRUE", \
- /* 0x09 */ "EXTENDED-PROCEDURE", \
- /* 0x0A */ "VECTOR", \
- /* 0x0B */ "RETURN-CODE", \
- /* 0x0C */ "COMBINATION-2", \
- /* 0x0D */ "MANIFEST-CLOSURE", \
- /* 0x0E */ "BIG-FIXNUM", \
- /* 0x0F */ "PROCEDURE", \
- /* 0x10 */ "ENTITY", \
- /* 0x11 */ "DELAY", \
- /* 0x12 */ "ENVIRONMENT", \
- /* 0x13 */ "DELAYED", \
- /* 0x14 */ "EXTENDED-LAMBDA", \
- /* 0x15 */ "COMMENT", \
- /* 0x16 */ "NON-MARKED-VECTOR", \
- /* 0x17 */ "LAMBDA", \
- /* 0x18 */ "PRIMITIVE", \
- /* 0x19 */ "SEQUENCE-2", \
- /* 0x1A */ "FIXNUM", \
- /* 0x1B */ "PCOMB1", \
- /* 0x1C */ "CONTROL-POINT", \
- /* 0x1D */ "INTERNED-SYMBOL", \
- /* 0x1E */ "CHARACTER-STRING", \
- /* 0x1F */ "ACCESS", \
- /* 0x20 */ "HUNK3-A", \
- /* 0x21 */ "DEFINITION", \
- /* 0x22 */ "BROKEN-HEART", \
- /* 0x23 */ "ASSIGNMENT", \
- /* 0x24 */ "HUNK3-B", \
- /* 0x25 */ "IN-PACKAGE", \
- /* 0x26 */ "COMBINATION", \
- /* 0x27 */ "MANIFEST-NM-VECTOR", \
- /* 0x28 */ "COMPILED-ENTRY", \
- /* 0x29 */ "LEXPR", \
- /* 0x2A */ "PCOMB3", \
- /* 0x2B */ 0, \
- /* 0x2C */ "VARIABLE", \
- /* 0x2D */ "THE-ENVIRONMENT", \
- /* 0x2E */ 0, \
- /* 0x2F */ "VECTOR-1B", \
- /* 0x30 */ "PCOMB0", \
- /* 0x31 */ "VECTOR-16B", \
- /* 0x32 */ "REFERENCE-TRAP", \
- /* 0x33 */ "SEQUENCE-3", \
- /* 0x34 */ "CONDITIONAL", \
- /* 0x35 */ "DISJUNCTION", \
- /* 0x36 */ "CELL", \
- /* 0x37 */ "WEAK-CONS", \
- /* 0x38 */ "QUAD", \
- /* 0x39 */ "LINKAGE-SECTION", \
- /* 0x3A */ "RATNUM", \
- /* 0x3B */ "STACK-ENVIRONMENT", \
- /* 0x3C */ "COMPLEX", \
- /* 0x3D */ "COMPILED-CODE-BLOCK", \
- /* 0x3E */ "RECORD", \
- /* 0x3F */ 0 \
+ /* 0x00 */ "false", \
+ /* 0x01 */ "pair", \
+ /* 0x02 */ "character", \
+ /* 0x03 */ "quotation", \
+ /* 0x04 */ "primitive-combination-2", \
+ /* 0x05 */ "uninterned-symbol", \
+ /* 0x06 */ "flonum", \
+ /* 0x07 */ "combination-1", \
+ /* 0x08 */ "constant", \
+ /* 0x09 */ "extended-procedure", \
+ /* 0x0A */ "vector", \
+ /* 0x0B */ "return-code", \
+ /* 0x0C */ "combination-2", \
+ /* 0x0D */ "manifest-closure", \
+ /* 0x0E */ "bignum", \
+ /* 0x0F */ "procedure", \
+ /* 0x10 */ "entity", \
+ /* 0x11 */ "delay", \
+ /* 0x12 */ "environment", \
+ /* 0x13 */ "promise", \
+ /* 0x14 */ "extended-lambda", \
+ /* 0x15 */ "comment", \
+ /* 0x16 */ "non-marked-vector", \
+ /* 0x17 */ "lambda", \
+ /* 0x18 */ "primitive", \
+ /* 0x19 */ "sequence-2", \
+ /* 0x1A */ "fixnum", \
+ /* 0x1B */ "primitive-combination-1", \
+ /* 0x1C */ "control-point", \
+ /* 0x1D */ "interned-symbol", \
+ /* 0x1e */ "string", \
+ /* 0x1f */ "access", \
+ /* 0x20 */ "hunk3-a", \
+ /* 0x21 */ "definition", \
+ /* 0x22 */ "broken-heart", \
+ /* 0x23 */ "assignment", \
+ /* 0x24 */ "triple", \
+ /* 0x25 */ "in-package", \
+ /* 0x26 */ "combination", \
+ /* 0x27 */ "manifest-nm-vector", \
+ /* 0x28 */ "compiled-entry", \
+ /* 0x29 */ "lexpr", \
+ /* 0x2a */ "primitive-combination-3", \
+ /* 0x2b */ 0, \
+ /* 0x2c */ "variable", \
+ /* 0x2d */ "the-environment", \
+ /* 0x2e */ 0, \
+ /* 0x2f */ "vector-1b", \
+ /* 0x30 */ "primitive-combination-0", \
+ /* 0x31 */ "vector-16b", \
+ /* 0x32 */ "reference-trap", \
+ /* 0x33 */ "sequence-3", \
+ /* 0x34 */ "conditional", \
+ /* 0x35 */ "disjunction", \
+ /* 0x36 */ "cell", \
+ /* 0x37 */ "weak-cons", \
+ /* 0x38 */ "quad", \
+ /* 0x39 */ "linkage-section", \
+ /* 0x3a */ "ratnum", \
+ /* 0x3b */ "stack-environment", \
+ /* 0x3c */ "recnum", \
+ /* 0x3d */ "compiled-code-block", \
+ /* 0x3e */ "record", \
+ /* 0x3f */ 0 \
}
/* Aliases */
-#define TC_FALSE TC_NULL
+#define TC_FALSE TC_NULL
#define TC_MANIFEST_VECTOR TC_NULL
#define TC_BIT_STRING TC_VECTOR_1B
#define TC_VECTOR_8B TC_CHARACTER_STRING
--- /dev/null
+/* -*-C-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+MIT/GNU Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+*/
+
+/* The "microcode tables" that provide information to the runtime
+ system about the microcode. */
+
+#include "scheme.h"
+#include "ostop.h"
+#include "ostty.h"
+
+#ifdef __WIN32__
+ extern void NT_initialize_fov (SCHEME_OBJECT);
+#endif
+
+extern void OS_syscall_names (unsigned long *, const char ***);
+extern void OS_syserr_names (unsigned long *, const char ***);
+extern SCHEME_OBJECT initialize_history (void);
+extern SCHEME_OBJECT initialize_interrupt_handler_vector (void);
+extern SCHEME_OBJECT initialize_interrupt_mask_vector (void);
+
+static const char * cc_arch_name (void);
+static SCHEME_OBJECT fixed_objects_syscall_names (void);
+static SCHEME_OBJECT fixed_objects_syserr_names (void);
+static SCHEME_OBJECT names_to_vector (unsigned long, const char **);
+\f
+#define IDENTITY_LENGTH 20 /* Plenty of room */
+#define ID_RELEASE 0 /* System release (string) */
+#define ID_MICRO_VERSION 1 /* Microcode version (fixnum) */
+/* 2 unused */
+#define ID_PRINTER_WIDTH 3 /* TTY width (# chars) */
+#define ID_PRINTER_LENGTH 4 /* TTY height (# chars) */
+#define ID_NEW_LINE_CHARACTER 5 /* #\Newline */
+#define ID_FLONUM_PRECISION 6 /* Flonum mantissa (# bits) */
+#define ID_FLONUM_EPSILON 7 /* Flonum epsilon (flonum) */
+#define ID_OS_NAME 8 /* OS name (string) */
+#define ID_OS_VARIANT 9 /* OS variant (string) */
+#define ID_STACK_TYPE 10 /* Scheme stack type (string) */
+#define ID_MACHINE_TYPE 11 /* Machine type (string) */
+#define ID_CC_ARCH 12 /* Compiled-code support (string) */
+
+#define N_IDENTITY_NAMES 0x0D
+static const char * identity_names [] =
+{
+ /* 0x00 */ "system-release-string",
+ /* 0x01 */ "microcode-version",
+ /* 0x02 */ 0,
+ /* 0x03 */ "console-width",
+ /* 0x04 */ "console-height",
+ /* 0x05 */ "newline-char",
+ /* 0x06 */ "flonum-mantissa-length",
+ /* 0x07 */ "flonum-epsilon",
+ /* 0x08 */ "os-name-string",
+ /* 0x09 */ "os-variant-string",
+ /* 0x0A */ "stack-type-string",
+ /* 0x0B */ "machine-type-string",
+ /* 0x0C */ "cc-arch-string"
+};
+
+SCHEME_OBJECT
+make_microcode_identification_vector (void)
+{
+ SCHEME_OBJECT v = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
+ VECTOR_SET (v, ID_RELEASE, SHARP_F);
+ VECTOR_SET (v, ID_MICRO_VERSION, (char_pointer_to_string (PACKAGE_VERSION)));
+ VECTOR_SET (v, ID_PRINTER_WIDTH, (ULONG_TO_FIXNUM (OS_tty_x_size ())));
+ VECTOR_SET (v, ID_PRINTER_LENGTH, (ULONG_TO_FIXNUM (OS_tty_y_size ())));
+ VECTOR_SET (v, ID_NEW_LINE_CHARACTER, (ASCII_TO_CHAR ('\n')));
+ VECTOR_SET (v, ID_FLONUM_PRECISION, (ULONG_TO_FIXNUM (DBL_MANT_DIG)));
+ VECTOR_SET (v, ID_FLONUM_EPSILON, (double_to_flonum ((double) DBL_EPSILON)));
+ VECTOR_SET (v, ID_OS_NAME, (char_pointer_to_string (OS_Name)));
+ VECTOR_SET (v, ID_OS_VARIANT, (char_pointer_to_string (OS_Variant)));
+ VECTOR_SET (v, ID_STACK_TYPE, (char_pointer_to_string ("standard")));
+ VECTOR_SET (v, ID_MACHINE_TYPE, (char_pointer_to_string (MACHINE_TYPE)));
+ {
+ const char * name = (cc_arch_name ());
+ if (name != 0)
+ VECTOR_SET (v, ID_CC_ARCH, (char_pointer_to_string (name)));
+ }
+ return (v);
+}
+
+static const char *
+cc_arch_name (void)
+{
+ switch (compiler_processor_type)
+ {
+ case COMPILER_NONE_TYPE: return ("none");
+ case COMPILER_MC68020_TYPE: return ("mc68k");
+ case COMPILER_VAX_TYPE: return ("vax");
+ case COMPILER_SPECTRUM_TYPE: return ("hppa");
+ case COMPILER_MC68040_TYPE: return ("mc68k");
+ case COMPILER_SPARC_TYPE: return ("sparc");
+ case COMPILER_IA32_TYPE: return ("i386");
+ case COMPILER_ALPHA_TYPE: return ("alpha");
+ case COMPILER_MIPS_TYPE: return ("mips");
+ case COMPILER_C_TYPE: return ("c");
+ case COMPILER_SVM_TYPE: return ("svm1");
+ default: return (0);
+ }
+}
+\f
+#define STORE_FIXOBJ(slot, object) \
+ VECTOR_SET (fixed_objects, slot, object)
+
+#define STORE_NAME_VECTOR(slot, names, length) \
+ STORE_FIXOBJ (slot, (names_to_vector (length, names)))
+
+#define STORE_GENERIC(slot, name, arity) \
+ STORE_FIXOBJ (slot, (make_primitive (name, arity)))
+
+void
+initialize_fixed_objects_vector (void)
+{
+ fixed_objects = (make_vector (N_FIXED_OBJECTS, SHARP_F, false));
+ STORE_FIXOBJ (NON_OBJECT, (MAKE_OBJECT (TC_CONSTANT, 2)));
+ STORE_FIXOBJ (SYSTEM_INTERRUPT_VECTOR,
+ (initialize_interrupt_handler_vector ()));
+ STORE_FIXOBJ (FIXOBJ_INTERRUPT_MASK_VECTOR,
+ (initialize_interrupt_mask_vector ()));
+ /* Error vector is not needed at boot time */
+ STORE_FIXOBJ (SYSTEM_ERROR_VECTOR, SHARP_F);
+
+ /* This must happen before we initialize name vectors. */
+ STORE_FIXOBJ (OBARRAY, (make_vector (OBARRAY_SIZE, EMPTY_LIST, false)));
+
+ STORE_NAME_VECTOR (TYPES_VECTOR, type_names, TYPE_CODE_LIMIT);
+ STORE_NAME_VECTOR (RETURNS_VECTOR, Return_Names, (MAX_RETURN_CODE + 1));
+ STORE_NAME_VECTOR (ERRORS_VECTOR, Error_Names, (MAX_ERROR + 1));
+ STORE_NAME_VECTOR (Termination_Vector, Term_Names, (MAX_TERMINATION + 1));
+ STORE_NAME_VECTOR (FIXED_OBJECTS_SLOTS,
+ fixed_objects_names, (N_FIXED_OBJECTS + 1));
+ STORE_NAME_VECTOR (IDENTIFICATION_VECTOR, identity_names, N_IDENTITY_NAMES);
+
+ STORE_FIXOBJ (DUMMY_HISTORY, (initialize_history ()));
+ STORE_FIXOBJ (State_Space_Tag, SHARP_T);
+ STORE_FIXOBJ (Bignum_One, (long_to_bignum (1)));
+ STORE_FIXOBJ (FIXOBJ_EDWIN_AUTO_SAVE, EMPTY_LIST);
+ STORE_FIXOBJ (FIXOBJ_FILES_TO_DELETE, EMPTY_LIST);
+ STORE_FIXOBJ (FIXOBJ_SYSTEM_CALL_NAMES, (fixed_objects_syscall_names ()));
+ STORE_FIXOBJ (FIXOBJ_SYSTEM_CALL_ERRORS, (fixed_objects_syserr_names ()));
+
+ STORE_GENERIC (GENERIC_TRAMPOLINE_ZERO_P, "INTEGER-ZERO?", 1);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_POSITIVE_P, "INTEGER-POSITIVE?", 1);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_NEGATIVE_P, "INTEGER-NEGATIVE?", 1);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_SUCCESSOR, "INTEGER-ADD-1", 1);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_PREDECESSOR, "INTEGER-SUBTRACT-1", 1);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_EQUAL_P, "INTEGER-EQUAL?", 2);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_LESS_P, "INTEGER-LESS?", 2);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_GREATER_P, "INTEGER-GREATER?", 2);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_ADD, "INTEGER-ADD", 2);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_SUBTRACT, "INTEGER-SUBTRACT", 2);
+ STORE_GENERIC (GENERIC_TRAMPOLINE_MULTIPLY, "INTEGER-MULTIPLY", 2);
+
+ STORE_FIXOBJ (GENERIC_TRAMPOLINE_DIVIDE, SHARP_F);
+ STORE_FIXOBJ (GENERIC_TRAMPOLINE_QUOTIENT, SHARP_F);
+ STORE_FIXOBJ (GENERIC_TRAMPOLINE_REMAINDER, SHARP_F);
+ STORE_FIXOBJ (GENERIC_TRAMPOLINE_MODULO, SHARP_F);
+
+ STORE_FIXOBJ (ARITY_DISPATCHER_TAG,
+ (char_pointer_to_symbol
+ ("#[(microcode)arity-dispatcher-tag]")));
+
+#ifdef __WIN32__
+ NT_initialize_fov (fixed_objects);
+#endif
+}
+
+static SCHEME_OBJECT
+fixed_objects_syscall_names (void)
+{
+ unsigned long length;
+ const char ** names;
+ OS_syscall_names ((&length), (&names));
+ return (names_to_vector (length, names));
+}
+
+static SCHEME_OBJECT
+fixed_objects_syserr_names (void)
+{
+ unsigned long length;
+ const char ** names;
+ OS_syserr_names ((&length), (&names));
+ return (names_to_vector (length, names));
+}
+
+static SCHEME_OBJECT
+names_to_vector (unsigned long length, const char ** names)
+{
+ SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, length, true));
+ unsigned long i;
+ for (i = 0; (i < length); i += 1)
+ VECTOR_SET (v, i,
+ (((names[i]) == 0)
+ ? SHARP_F
+ : (char_pointer_to_symbol (names[i]))));
+ return (v);
+}
+++ /dev/null
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008, 2009 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Machine Dependent Type Tables
-
-(declare (usual-integrations))
-
-;;; For quick access to any given table,
-;;; search for the following strings:
-;;;
-;;; [] Fixed
-;;; [] Types
-;;; [] Returns
-;;; [] Errors
-;;; [] Terminations
-;;; [] System-call names
-;;; [] System-call errors
-;;; [] Identification
-\f
-;;; [] Fixed
-
-(vector-set! (get-fixed-objects-vector)
- #x0F ;(fixed-objects-vector-slot 'MICROCODE-FIXED-OBJECTS-SLOTS)
- #(NON-OBJECT ;00
- SYSTEM-INTERRUPT-VECTOR ;01
- SYSTEM-ERROR-VECTOR ;02
- OBARRAY ;03
- MICROCODE-TYPES-VECTOR ;04
- MICROCODE-RETURNS-VECTOR ;05
- INTERRUPT-MASK-VECTOR ;06
- MICROCODE-ERRORS-VECTOR ;07
- MICROCODE-IDENTIFICATION-VECTOR ;08
- SYSTEM-CALL-NAMES ;09
- SYSTEM-CALL-ERRORS ;0A
- GC-DAEMON ;0B
- TRAP-HANDLER ;0C
- EDWIN-AUTO-SAVE ;0D
- STEPPER-STATE ;0E
- MICROCODE-FIXED-OBJECTS-SLOTS ;0F
- FILES-TO-DELETE ;10
- STATE-SPACE-TAG ;11
- STATE-POINT-TAG ;12
- DUMMY-HISTORY ;13
- BIGNUM-ONE ;14
- SCHEDULER ;15
- MICROCODE-TERMINATIONS-VECTOR ;16
- MICROCODE-TERMINATIONS-PROCEDURES ;17
- FIXED-OBJECTS-VECTOR ;18
- THE-WORK-QUEUE ;19
- FUTURE-READS-LOGGER ;1A
- TOUCHED-FUTURES-VECTOR ;1B
- #F #| PRECIOUS-OBJECTS |# ;1C
- ERROR-PROCEDURE ;1D
- #F #| UNSNAPPED-LINK |# ;1E
- #F #| MICROCODE-UTILITIES-VECTOR |# ;1F
- COMPILER-ERROR-PROCEDURE ;20
- #F #| LOST-OBJECT-BASE |# ;21
- STATE-SPACE-ROOT ;22
- PRIMITIVE-PROFILING-TABLE ;23
- GENERIC-TRAMPOLINE-ZERO? ;24
- GENERIC-TRAMPOLINE-POSITIVE? ;25
- GENERIC-TRAMPOLINE-NEGATIVE? ;26
- GENERIC-TRAMPOLINE-ADD-1 ;27
- GENERIC-TRAMPOLINE-SUBTRACT-1 ;28
- GENERIC-TRAMPOLINE-EQUAL? ;29
- GENERIC-TRAMPOLINE-LESS? ;2A
- GENERIC-TRAMPOLINE-GREATER? ;2B
- GENERIC-TRAMPOLINE-ADD ;2C
- GENERIC-TRAMPOLINE-SUBTRACT ;2D
- GENERIC-TRAMPOLINE-MULTIPLY ;2E
- GENERIC-TRAMPOLINE-DIVIDE ;2F
- GENERIC-TRAMPOLINE-QUOTIENT ;30
- GENERIC-TRAMPOLINE-REMAINDER ;31
- GENERIC-TRAMPOLINE-MODULO ;32
- ARITY-DISPATCHER-TAG ;33
- PC-Sample/Builtin-Table ;34
- PC-Sample/Utility-Table ;35
- PC-Sample/Primitive-Table ;36
- PC-Sample/Code-Block-Table ;37
- PC-Sample/Purified-Code-Block-Block-Buffer ;38
- PC-Sample/Purified-Code-Block-Offset-Buffer ;39
- PC-Sample/Heathen-Code-Block-Block-Buffer ;3A
- PC-Sample/Heathen-Code-Block-Offset-Buffer ;3B
- PC-Sample/Interp-Proc-Buffer ;3C
- PC-Sample/Prob-Comp-Table ;3D
- PC-Sample/UFO-Table ;3E
- COMPILED-CODE-BKPT-HANDLER ;3F
- GC-WABBIT-DESCWIPTOR ;40
- ))
-\f
-;;; [] Types
-
-(vector-set! (get-fixed-objects-vector)
- 4 ;(fixed-objects-vector-slot 'MICROCODE-TYPES-VECTOR)
- #((FALSE MANIFEST-VECTOR GLOBAL-ENVIRONMENT) ;00
- (PAIR LIST) ;01
- CHARACTER ;02
- QUOTATION ;03
- PRIMITIVE-COMBINATION-2 ;04
- UNINTERNED-SYMBOL ;05
- (FLONUM BIG-FLONUM) ;06
- COMBINATION-1 ;07
- (TRUE CONSTANT) ;08
- EXTENDED-PROCEDURE ;09
- VECTOR ;0A
- (RETURN-CODE RETURN-ADDRESS) ;0B
- COMBINATION-2 ;0C
- MANIFEST-CLOSURE ;0D
- (BIGNUM BIG-FIXNUM) ;0E
- PROCEDURE ;0F
- (ENTITY) ;10
- DELAY ;11
- ENVIRONMENT ;12
- (PROMISE DELAYED) ;13
- EXTENDED-LAMBDA ;14
- COMMENT ;15
- NON-MARKED-VECTOR ;16
- LAMBDA ;17
- PRIMITIVE ;18
- SEQUENCE-2 ;19
- (FIXNUM ADDRESS POSITIVE-FIXNUM NEGATIVE-FIXNUM) ;1A
- PRIMITIVE-COMBINATION-1 ;1B
- CONTROL-POINT ;1C
- INTERNED-SYMBOL ;1D
- (STRING CHARACTER-STRING VECTOR-8B) ;1E
- ACCESS ;1F
- (HUNK3-A UNMARKED-HISTORY) ;20
- DEFINITION ;21
- BROKEN-HEART ;22
- ASSIGNMENT ;23
- (TRIPLE HUNK3 HUNK3-B MARKED-HISTORY) ;24
- IN-PACKAGE ;25
- COMBINATION ;26
- MANIFEST-NM-VECTOR ;27
- COMPILED-ENTRY ;28
- LEXPR ;29
- PRIMITIVE-COMBINATION-3 ;2A
- #F ;2B
- VARIABLE ;2C
- THE-ENVIRONMENT ;2D
- #F ;2E
- VECTOR-1B ;2F
- PRIMITIVE-COMBINATION-0 ;30
- VECTOR-16B ;31
- (REFERENCE-TRAP UNASSIGNED) ;32
- SEQUENCE-3 ;33
- CONDITIONAL ;34
- DISJUNCTION ;35
- CELL ;36
- WEAK-CONS ;37
- QUAD ;38
- LINKAGE-SECTION ;39
- RATNUM ;3A
- STACK-ENVIRONMENT ;3B
- (RECNUM COMPLEX) ;3C
- COMPILED-CODE-BLOCK ;3D
- RECORD ;3E
- #F ;3F
- #F ;40
- #F ;41
- #F ;42
- #F ;43
- #F ;44
- #F ;45
- #F ;46
- #F ;47
- #F ;48
- #F ;49
- #F ;4A
- #F ;4B
- #F ;4C
- #F ;4D
- #F ;4E
- #F ;4F
- #F ;50
- #F ;51
- #F ;52
- #F ;53
- #F ;54
- #F ;55
- #F ;56
- #F ;57
- #F ;58
- #F ;59
- #F ;5A
- #F ;5B
- #F ;5C
- #F ;5D
- #F ;5E
- #F ;5F
- #F ;60
- #F ;61
- #F ;62
- #F ;63
- #F ;64
- #F ;65
- #F ;66
- #F ;67
- #F ;68
- #F ;69
- #F ;6A
- #F ;6B
- #F ;6C
- #F ;6D
- #F ;6E
- #F ;6F
- #F ;70
- #F ;71
- #F ;72
- #F ;73
- #F ;74
- #F ;75
- #F ;76
- #F ;77
- #F ;78
- #F ;79
- #F ;7A
- #F ;7B
- #F ;7C
- #F ;7D
- #F ;7E
- #F ;7F
- #F ;80
- #F ;81
- #F ;82
- #F ;83
- #F ;84
- #F ;85
- #F ;86
- #F ;87
- #F ;88
- #F ;89
- #F ;8A
- #F ;8B
- #F ;8C
- #F ;8D
- #F ;8E
- #F ;8F
- #F ;90
- #F ;91
- #F ;92
- #F ;93
- #F ;94
- #F ;95
- #F ;96
- #F ;97
- #F ;98
- #F ;99
- #F ;9A
- #F ;9B
- #F ;9C
- #F ;9D
- #F ;9E
- #F ;9F
- #F ;A0
- #F ;A1
- #F ;A2
- #F ;A3
- #F ;A4
- #F ;A5
- #F ;A6
- #F ;A7
- #F ;A8
- #F ;A9
- #F ;AA
- #F ;AB
- #F ;AC
- #F ;AD
- #F ;AE
- #F ;AF
- #F ;B0
- #F ;B1
- #F ;B2
- #F ;B3
- #F ;B4
- #F ;B5
- #F ;B6
- #F ;B7
- #F ;B8
- #F ;B9
- #F ;BA
- #F ;BB
- #F ;BC
- #F ;BD
- #F ;BE
- #F ;BF
- #F ;C0
- #F ;C1
- #F ;C2
- #F ;C3
- #F ;C4
- #F ;C5
- #F ;C6
- #F ;C7
- #F ;C8
- #F ;C9
- #F ;CA
- #F ;CB
- #F ;CC
- #F ;CD
- #F ;CE
- #F ;CF
- #F ;D0
- #F ;D1
- #F ;D2
- #F ;D3
- #F ;D4
- #F ;D5
- #F ;D6
- #F ;D7
- #F ;D8
- #F ;D9
- #F ;DA
- #F ;DB
- #F ;DC
- #F ;DD
- #F ;DE
- #F ;DF
- #F ;E0
- #F ;E1
- #F ;E2
- #F ;E3
- #F ;E4
- #F ;E5
- #F ;E6
- #F ;E7
- #F ;E8
- #F ;E9
- #F ;EA
- #F ;EB
- #F ;EC
- #F ;ED
- #F ;EE
- #F ;EF
- #F ;F0
- #F ;F1
- #F ;F2
- #F ;F3
- #F ;F4
- #F ;F5
- #F ;F6
- #F ;F7
- #F ;F8
- #F ;F9
- #F ;FA
- #F ;FB
- #F ;FC
- #F ;FD
- #F ;FE
- #F ;FF
- ))
-\f
-;;; [] Returns
-
-(vector-set! (get-fixed-objects-vector)
- 5 ;(fixed-objects-vector-slot 'MICROCODE-RETURNS-VECTOR)
- #(NON-EXISTENT-CONTINUATION ;00
- JOIN-STACKLETS ;01
- RESTORE-CONTINUATION ;02
- INTERNAL-APPLY ;03
- BAD-INTERRUPT-CONTINUE ;04
- RESTORE-HISTORY ;05
- INVOKE-STACK-THREAD ;06
- RESTART-EXECUTION ;07
- ASSIGNMENT-CONTINUE ;08
- DEFINITION-CONTINUE ;09
- ACCESS-CONTINUE ;0A
- IN-PACKAGE-CONTINUE ;0B
- SEQUENCE-2-SECOND ;0C
- SEQUENCE-3-SECOND ;0D
- SEQUENCE-3-THIRD ;0E
- CONDITIONAL-DECIDE ;0F
- DISJUNCTION-DECIDE ;10
- COMBINATION-1-PROCEDURE ;11
- COMBINATION-APPLY ;12
- COMBINATION-2-FIRST-OPERAND ;13
- COMBINATION-2-PROCEDURE ;14
- COMBINATION-SAVE-VALUE ;15
- PRIMITIVE-COMBINATION-1-APPLY ;16
- PRIMITIVE-COMBINATION-2-FIRST-OPERAND ;17
- PRIMITIVE-COMBINATION-2-APPLY ;18
- PRIMITIVE-COMBINATION-3-SECOND-OPERAND ;19
- PRIMITIVE-COMBINATION-3-FIRST-OPERAND ;1A
- PRIMITIVE-COMBINATION-3-APPLY ;1B
- FORCE-SNAP-THUNK ;1C
- REENTER-COMPILED-CODE ;1D
- #F ;1E
- COMPILER-REFERENCE-RESTART ;1F
- NORMAL-GARBAGE-COLLECT-DONE ;20
- COMPLETE-GARBAGE-COLLECT-DONE ;21
- PURIFY-AFTER-FIRST-GC ;22
- PURIFY-AFTER-SECOND-GC ;23
- AFTER-MEMORY-UPDATE ;24
- RETRY-MICROCODE-TERMINATION-RESTARTABLE ;25
- #F ;26
- #F ;27
- COMPILER-ASSIGNMENT-RESTART ;28
- POP-FROM-COMPILED-CODE ;29
- RETURN-TRAP-POINT ;2A
- RESTORE-STEPPER ;2B
- RESTORE-TO-STATE-POINT ;2C
- MOVE-TO-ADJACENT-POINT ;2D
- RESTORE-VALUE ;2E
- RESTORE-DONT-COPY-HISTORY ;2F
- #F ;30
- #F ;31
- #F ;32
- #F ;33
- #F ;34
- #F ;35
- #F ;36
- #F ;37
- #F ;38
- #F ;39
- #F ;3A
- #F ;3B
- #F ;3C
- #F ;3D
- #F ;3E
- #F ;3F
- POP-RETURN-ERROR ;40
- EVAL-ERROR ;41
- STACK-MARKER ;42
- COMPILER-INTERRUPT-RESTART ;43
- #F ;44
- RESTORE-INTERRUPT-MASK ;45
- HALT ;46
- FINISH-GLOBAL-INTERRUPT ;47
- REPEAT-DISPATCH ;48
- GC-CHECK ;49
- RESTORE-FLUIDS ;4A
- COMPILER-LOOKUP-APPLY-RESTART ;4B
- COMPILER-ACCESS-RESTART ;4C
- COMPILER-UNASSIGNED?-RESTART ;4D
- COMPILER-UNBOUND?-RESTART ;4E
- COMPILER-DEFINITION-RESTART ;4F
- #F ;50
- COMPILER-SAFE-REFERENCE-RESTART ;51
- #F ;52
- COMPILER-REFERENCE-TRAP-RESTART ;53
- COMPILER-ASSIGNMENT-TRAP-RESTART ;54
- #F ;55
- COMPILER-OPERATOR-LOOKUP-TRAP-RESTART ;56
- COMPILER-LOOKUP-APPLY-TRAP-RESTART ;57
- COMPILER-SAFE-REFERENCE-TRAP-RESTART ;58
- COMPILER-UNASSIGNED?-TRAP-RESTART ;59
- #F ;5A
- COMPILER-LINK-CACHES-RESTART ;5B
- HARDWARE-TRAP ;5C
- INTERNAL-APPLY-VAL ;5D
- COMPILER-ERROR-RESTART ;5E
- PRIMITIVE-CONTINUE ;5F
- ))
-\f
-;;; [] Errors
-
-(vector-set! (get-fixed-objects-vector)
- 7 ;(fixed-objects-vector-slot 'MICROCODE-ERRORS-VECTOR)
- #(BAD-ERROR-CODE ;00
- UNBOUND-VARIABLE ;01
- UNASSIGNED-VARIABLE ;02
- UNDEFINED-PROCEDURE ;03
- SYSTEM-CALL ;04
- ERROR-WITH-ARGUMENT ;05
- BAD-FRAME ;06
- BROKEN-CVARIABLE ;07
- UNDEFINED-USER-TYPE ;08
- UNDEFINED-PRIMITIVE-OPERATION ;09
- EXTERNAL-RETURN ;0A
- EXECUTE-MANIFEST-VECTOR ;0B
- WRONG-NUMBER-OF-ARGUMENTS ;0C
- WRONG-TYPE-ARGUMENT-0 ;0D
- WRONG-TYPE-ARGUMENT-1 ;0E
- WRONG-TYPE-ARGUMENT-2 ;0F
- BAD-RANGE-ARGUMENT-0 ;10
- BAD-RANGE-ARGUMENT-1 ;11
- BAD-RANGE-ARGUMENT-2 ;12
- MACRO-BINDING ;13
- FASDUMP-OBJECT-TOO-LARGE ;14
- BAD-INTERRUPT-CODE ;15
- #F ;16
- FASL-FILE-TOO-BIG ;17
- FASL-FILE-BAD-DATA ;18
- #F ;19
- #F ;1A
- #F ;1B
- #F ;1C
- BAD-ASSIGNMENT ;1D
- FAILED-ARG-1-COERCION ;1E
- FAILED-ARG-2-COERCION ;1F
- OUT-OF-FILE-HANDLES ;20
- #F ;21
- BAD-RANGE-ARGUMENT-3 ;22
- BAD-RANGE-ARGUMENT-4 ;23
- BAD-RANGE-ARGUMENT-5 ;24
- BAD-RANGE-ARGUMENT-6 ;25
- BAD-RANGE-ARGUMENT-7 ;26
- BAD-RANGE-ARGUMENT-8 ;27
- BAD-RANGE-ARGUMENT-9 ;28
- WRONG-TYPE-ARGUMENT-3 ;29
- WRONG-TYPE-ARGUMENT-4 ;2A
- WRONG-TYPE-ARGUMENT-5 ;2B
- WRONG-TYPE-ARGUMENT-6 ;2C
- WRONG-TYPE-ARGUMENT-7 ;2D
- WRONG-TYPE-ARGUMENT-8 ;2E
- WRONG-TYPE-ARGUMENT-9 ;2F
- INAPPLICABLE-CONTINUATION ;30
- COMPILED-CODE-ERROR ;31
- FLOATING-OVERFLOW ;32
- UNIMPLEMENTED-PRIMITIVE ;33
- ILLEGAL-REFERENCE-TRAP ;34
- BROKEN-VARIABLE-CACHE ;35
- WRONG-ARITY-PRIMITIVES ;36
- IO-ERROR ;37
- FASDUMP-ENVIRONMENT ;38
- FASLOAD-BAND ;39
- FASLOAD-COMPILED-MISMATCH ;3A
- UNKNOWN-PRIMITIVE-CONTINUATION ;3B
- ILLEGAL-CONTINUATION ;3C
- STACK-HAS-SLIPPED ;3D
- CANNOT-RECURSE ;3E
- ))
-\f
-;;; [] Terminations
-
-(vector-set! (get-fixed-objects-vector)
- 22 ;(fixed-objects-vector-slot 'MICROCODE-TERMINATIONS-VECTOR)
- #(HALT ;00
- DISK-RESTORE ;01
- BROKEN-HEART ;02
- NON-POINTER-RELOCATION ;03
- BAD-ROOT ;04
- NON-EXISTENT-CONTINUATION ;05
- BAD-STACK ;06
- STACK-OVERFLOW ;07
- STACK-ALLOCATION-FAILED ;08
- NO-ERROR-HANDLER ;09
- NO-INTERRUPT-HANDLER ;0A
- UNIMPLEMENTED-CONTINUATION ;0B
- EXIT ;0C
- BAD-PRIMITIVE-DURING-ERROR ;0D
- EOF ;0E
- BAD-PRIMITIVE ;0F
- TERMINATION-HANDLER ;10
- END-OF-CONTINUATION ;11
- INVALID-TYPE-CODE ;12
- COMPILER-DEATH ;13
- GC-OUT-OF-SPACE ;14
- NO-SPACE ;15
- SIGNAL ;16
- TOUCH ;17
- SAVE-AND-EXIT ;18
- TRAP ;19
- BAD-BACK-OUT ;20
- ))
-\f
-;;; [] System-call names and errors
-
-(let-syntax
- ((ucode-primitive
- (sc-macro-transformer
- (lambda (form environment)
- environment
- (apply make-primitive-procedure (cdr form))))))
- (vector-set! (get-fixed-objects-vector)
- #x09 ;(fixed-objects-vector-slot 'SYSTEM-CALL-NAMES)
- ((ucode-primitive microcode-system-call-names 0)))
- (vector-set! (get-fixed-objects-vector)
- #x0A ;(fixed-objects-vector-slot 'SYSTEM-CALL-ERRORS)
- ((ucode-primitive microcode-system-error-names 0))))
-\f
-;;; [] Identification
-
-(vector-set! (get-fixed-objects-vector)
- 8 ;(fixed-objects-vector-slot 'MICROCODE-IDENTIFICATION-VECTOR)
- #(SYSTEM-RELEASE-STRING ;00
- MICROCODE-VERSION ;01
- MICROCODE-MODIFICATION ;02
- CONSOLE-WIDTH ;03
- CONSOLE-HEIGHT ;04
- NEWLINE-CHAR ;05
- FLONUM-MANTISSA-LENGTH ;06
- FLONUM-EPSILON ;07
- OS-NAME-STRING ;08
- OS-VARIANT-STRING ;09
- STACK-TYPE-STRING ;0A
- MACHINE-TYPE-STRING ;0B
- CC-ARCH-STRING ;0C
- ))
\ No newline at end of file
+++ /dev/null
-#!/bin/sh
-#
-# Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-# 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-# 2005, 2006, 2007, 2008, 2009 Massachusetts Institute of
-# Technology
-#
-# This file is part of MIT/GNU Scheme.
-#
-# MIT/GNU Scheme is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; either version 2 of the
-# License, or (at your option) any later version.
-#
-# MIT/GNU Scheme is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with MIT/GNU Scheme; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-# 02110-1301, USA.
-
-if [ -z "${SCHEME_COMPILER}" ]; then
- SCHEME_COMPILER="scheme --compiler --heap 3000"
-fi
-echo '(sf "utabmd")' | ${SCHEME_COMPILER}
(compiler-frame 'COMPILER-LINK-CACHES-RESTART 8)
(compiler-frame 'REENTER-COMPILED-CODE 2)
- (compiler-subproblem 'COMPILER-ACCESS-RESTART 4)
- (compiler-subproblem 'COMPILER-ASSIGNMENT-RESTART 5)
(compiler-subproblem 'COMPILER-ASSIGNMENT-TRAP-RESTART 5)
- (compiler-subproblem 'COMPILER-DEFINITION-RESTART 5)
- (compiler-subproblem 'COMPILER-LOOKUP-APPLY-RESTART
- (length/application-frame 4 1))
- (compiler-subproblem 'COMPILER-REFERENCE-RESTART 4)
(compiler-subproblem 'COMPILER-REFERENCE-TRAP-RESTART 4)
- (compiler-subproblem 'COMPILER-SAFE-REFERENCE-RESTART 4)
(compiler-subproblem 'COMPILER-SAFE-REFERENCE-TRAP-RESTART 4)
- (compiler-subproblem 'COMPILER-UNASSIGNED?-RESTART 4)
(compiler-subproblem 'COMPILER-UNASSIGNED?-TRAP-RESTART 4)
- (compiler-subproblem 'COMPILER-UNBOUND?-RESTART 4)
(compiler-subproblem 'COMPILER-ERROR-RESTART 3))
undefined-environment
undefined-expression))
\f
-(define ((method/compiler-reference scode-maker) frame)
- (values (scode-maker (stack-frame/ref frame 3))
- (stack-frame/ref frame 2)
- undefined-expression))
-
-(define ((method/compiler-assignment scode-maker) frame)
- (values (scode-maker (stack-frame/ref frame 3)
- (make-evaluated-object (stack-frame/ref frame 4)))
- (stack-frame/ref frame 2)
- undefined-expression))
-
(define ((method/compiler-reference-trap scode-maker) frame)
(values (scode-maker (stack-frame/ref frame 2))
(stack-frame/ref frame 3)
(stack-frame/ref frame 3)
undefined-expression))
-(define (method/compiler-lookup-apply-restart frame)
- (values (%make-combination (stack-frame/ref frame 3)
- (stack-frame-list frame 5))
- undefined-environment
- undefined-expression))
-
(define (method/compiler-lookup-apply-trap-restart frame)
(values (%make-combination (make-variable (stack-frame/ref frame 2))
(stack-frame-list frame 6))
(let ((method (method/application-frame 3)))
(record-method 'INTERNAL-APPLY method)
(record-method 'INTERNAL-APPLY-VAL method))
- (let ((method (method/compiler-reference identity-procedure)))
- (record-method 'COMPILER-REFERENCE-RESTART method)
- (record-method 'COMPILER-SAFE-REFERENCE-RESTART method))
- (record-method 'COMPILER-ACCESS-RESTART
- (method/compiler-reference make-variable))
- (record-method 'COMPILER-UNASSIGNED?-RESTART
- (method/compiler-reference make-unassigned?))
- (record-method 'COMPILER-UNBOUND?-RESTART
- (method/compiler-reference
- (lambda (name)
- (%make-combination (ucode-primitive lexical-unbound?)
- (list (make-the-environment) name)))))
- (record-method 'COMPILER-ASSIGNMENT-RESTART
- (method/compiler-assignment make-assignment-from-variable))
- (record-method 'COMPILER-DEFINITION-RESTART
- (method/compiler-assignment make-definition))
(let ((method (method/compiler-reference-trap make-variable)))
(record-method 'COMPILER-REFERENCE-TRAP-RESTART method)
(record-method 'COMPILER-SAFE-REFERENCE-TRAP-RESTART method))
(method/compiler-reference-trap make-unassigned?))
(record-method 'COMPILER-ASSIGNMENT-TRAP-RESTART
(method/compiler-assignment-trap make-assignment))
- (record-method 'COMPILER-LOOKUP-APPLY-RESTART
- method/compiler-lookup-apply-restart)
(record-method 'COMPILER-LOOKUP-APPLY-TRAP-RESTART
method/compiler-lookup-apply-trap-restart)
(record-method 'COMPILER-OPERATOR-LOOKUP-TRAP-RESTART
(if (if (default-object? required?) #t required?)
(or (%find-library-file pathname)
(system-library-pathname
- (error:file-operation pathname*
+ (error:file-operation pathname
"find"
"file"
"no such file in system library path"
;;; package: (runtime microcode-tables)
(declare (usual-integrations))
-
-(define (re-read-microcode-tables!)
- (let ((file-name ((ucode-primitive microcode-tables-filename))))
- (if (file-exists? file-name)
- (read-microcode-tables! file-name)
- (let ((new-identification ((ucode-primitive microcode-identify))))
- (let ((new-vector (vector-copy new-identification))
- (old-vector (vector-copy identification-vector)))
- (let loop ((fields '(CONSOLE-WIDTH CONSOLE-HEIGHT)))
- (if (pair? fields)
- (let ((slot
- (microcode-identification-vector-slot (car fields))))
- (vector-set! old-vector slot #f)
- (vector-set! new-vector slot #f)
- (loop (cdr fields)))))
- (if (not (equal? new-vector old-vector))
- (error "Missing microcode description:" file-name))
- (set! identification-vector new-identification)
- (set! microcode-id/tty-x-size
- (microcode-identification-item 'CONSOLE-WIDTH))
- (set! microcode-id/tty-y-size
- (microcode-identification-item 'CONSOLE-HEIGHT))
- unspecific)))))
\f
-(define (read-microcode-tables! #!optional filename)
- (scode-eval
- (or ((ucode-primitive initialize-c-compiled-block 1)
- "http://www.gnu.org/software/mit-scheme/lib/microcode/utabmd.so")
- ((ucode-primitive binary-fasload)
- (if (default-object? filename)
- ((ucode-primitive microcode-tables-filename))
- filename)))
- system-global-environment)
+(define (read-microcode-tables!)
(set! identification-vector ((ucode-primitive microcode-identify)))
(set! errors-slot (fixed-object/name->code 'MICROCODE-ERRORS-VECTOR))
(set! identifications-slot
(microcode-identification-item 'CONSOLE-HEIGHT))
unspecific)
+(define (re-read-microcode-tables!)
+ (set! identification-vector ((ucode-primitive microcode-identify)))
+ (set! microcode-id/tty-x-size
+ (microcode-identification-item 'CONSOLE-WIDTH))
+ (set! microcode-id/tty-y-size
+ (microcode-identification-item 'CONSOLE-HEIGHT))
+ unspecific)
+
(define (intern string)
((ucode-primitive string->symbol)
(let ((size (string-length string)))
(define (microcode-termination/code-limit)
(vector-length (vector-ref (get-fixed-objects-vector) terminations-slot)))
-(define types-slot)
-
-(define (microcode-type/name->code name)
- (microcode-table-search types-slot name))
-
-(define (microcode-type/code->name code)
- (microcode-table-ref types-slot code))
-
-(define (microcode-type/code->names code)
- (let ((entry (microcode-table-entry types-slot code)))
- (cond ((not entry) '())
- ((list? entry) entry)
- (else (list entry)))))
-
-(define (microcode-type/code-limit)
- (vector-length (vector-ref (get-fixed-objects-vector) types-slot)))
-
(define identifications-slot)
(define identification-vector)
(microcode-table-search system-call-errors-slot name))
(define (microcode-system-call-error/code->name code)
- (microcode-table-ref system-call-errors-slot code))
\ No newline at end of file
+ (microcode-table-ref system-call-errors-slot code))
+\f
+(define types-slot)
+
+(define (microcode-type/name->code name)
+ (microcode-table-search types-slot
+ (let ((p
+ (find (lambda (p)
+ (memq name (cdr p)))
+ type-aliases)))
+ (if p
+ (car p)
+ name))))
+
+(define (microcode-type/code->name code)
+ (microcode-table-ref types-slot code))
+
+(define (microcode-type/code->names code)
+ (let ((name (microcode-table-entry types-slot code)))
+ (if name
+ (or (assq name type-aliases)
+ (list name))
+ '())))
+
+(define (microcode-type/code-limit)
+ (vector-length (vector-ref (get-fixed-objects-vector) types-slot)))
+
+(define type-aliases
+ '((FALSE MANIFEST-VECTOR GLOBAL-ENVIRONMENT)
+ (PAIR LIST)
+ (FLONUM BIG-FLONUM)
+ (CONSTANT TRUE)
+ (RETURN-CODE RETURN-ADDRESS)
+ (BIGNUM BIG-FIXNUM)
+ (PROMISE DELAYED)
+ (FIXNUM ADDRESS POSITIVE-FIXNUM NEGATIVE-FIXNUM)
+ (STRING CHARACTER-STRING VECTOR-8B)
+ (HUNK3-A UNMARKED-HISTORY)
+ (TRIPLE HUNK3 HUNK3-B MARKED-HISTORY)
+ (REFERENCE-TRAP UNASSIGNED)
+ (RECNUM COMPLEX)))
\ No newline at end of file
(object-type object))
'(BIGNUM
CHARACTER
+ CONSTANT
FALSE
FIXNUM
FLONUM
INTERNED-SYMBOL
RATNUM
RECNUM
- TRUE
UNINTERNED-SYMBOL)))
(error "USUAL-INTEGRATIONS: not a constant" name))
(constant->integration-info object)))
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
-/* Declarations of user offsets into the Fixed Objects Vector.
- This should correspond to the file "utabmd.scm". */
+/* Declarations of user offsets into the Fixed Objects Vector. */
\f
#define Non_Object 0x00 /* Used for unassigned variables. */
#define System_Interrupt_Vector 0x01 /* Handlers for interrupts. */
projects / mit-scheme.git / commitdiff