From: Chris Hanson Date: Mon, 7 Sep 2009 09:57:52 +0000 (-0700) Subject: Eliminate "utabmd.scm". Maybe this was an OK idea once upon a time, X-Git-Tag: 20100708-Gtk~340^2 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=745a16218a43692d2c9ecdad72d1bab73fab0522;p=mit-scheme.git Eliminate "utabmd.scm". Maybe this was an OK idea once upon a time, but not any more. --- diff --git a/doc/user-manual/user.texinfo b/doc/user-manual/user.texinfo index 22bf71949..583b500db 100644 --- a/doc/user-manual/user.texinfo +++ b/doc/user-manual/user.texinfo @@ -743,22 +743,6 @@ default value is @file{/usr/local/lib/mit-scheme}. On PCs, the elements 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 @@ -1069,11 +1053,6 @@ given. Overridden by @option{--heap}, @option{--large}, 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 diff --git a/etc/make_psb b/etc/make_psb index 11a6b2479..086c89dec 100755 --- a/etc/make_psb +++ b/etc/make_psb @@ -18,8 +18,6 @@ then 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 diff --git a/etc/resyntax.scm b/etc/resyntax.scm index 1915a97ef..b16f8ebd3 100644 --- a/etc/resyntax.scm +++ b/etc/resyntax.scm @@ -3,8 +3,6 @@ (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") diff --git a/etc/run_scheme b/etc/run_scheme deleted file mode 100755 index 8464196b3..000000000 --- a/etc/run_scheme +++ /dev/null @@ -1,64 +0,0 @@ -#!/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 diff --git a/src/README.txt b/src/README.txt index c2b830358..b55d78b61 100644 --- a/src/README.txt +++ b/src/README.txt @@ -226,8 +226,7 @@ The Rub 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") @@ -289,8 +288,8 @@ We're optimistic that way. 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--.tar.gz' @@ -513,8 +512,7 @@ CVS build's bootstrapping process. The adventure continues! 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 @@ -628,8 +626,6 @@ Question: What can you do when the "scheme" microcode from a binary 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 diff --git a/src/Setup.sh b/src/Setup.sh index 2a9c93f95..459c63dc9 100755 --- a/src/Setup.sh +++ b/src/Setup.sh @@ -44,7 +44,6 @@ maybe_link lib/edwin ../edwin 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}" diff --git a/src/etc/compile.scm b/src/etc/compile.scm index 9c8437d91..62cd5c7d2 100644 --- a/src/etc/compile.scm +++ b/src/etc/compile.scm @@ -83,8 +83,7 @@ USA. (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) @@ -95,8 +94,7 @@ USA. (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 @@ -108,7 +106,6 @@ USA. (in-liarc (lambda () (compile-all-dirs c-compile-dir) - (cf-conditionally "microcode/utabmd") (cbf-conditionally "edwin/edwin.bld")))) (define (in-liarc thunk) diff --git a/src/microcode/boot.c b/src/microcode/boot.c index d515af0a1..6231d536c 100644 --- a/src/microcode/boot.c +++ b/src/microcode/boot.c @@ -29,16 +29,12 @@ USA. #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); @@ -59,7 +55,6 @@ extern SCHEME_OBJECT Re_Enter_Interpreter (void); 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; @@ -130,93 +125,6 @@ main_name (int argc, const char ** argv) return (0); } -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 -} - /* Boot Scheme */ #ifndef ENTRY_HOOK @@ -316,82 +224,10 @@ Re_Enter_Interpreter (void) /* 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 ()); -} - -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) diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac index cc7718b5c..4a07a653b 100644 --- a/src/microcode/configure.ac +++ b/src/microcode/configure.ac @@ -197,7 +197,7 @@ MODULE_LDFLAGS= 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= @@ -1029,7 +1029,6 @@ c) 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 diff --git a/src/microcode/errors.h b/src/microcode/errors.h index 2f83abba9..3fa1df27d 100644 --- a/src/microcode/errors.h +++ b/src/microcode/errors.h @@ -96,76 +96,75 @@ USA. #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 #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" \ } /* Termination codes: the interpreter halts on these */ @@ -207,33 +206,33 @@ USA. #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" \ } #define TERM_MESSAGE_TABLE \ diff --git a/src/microcode/extern.h b/src/microcode/extern.h index 78e78253a..e192cd18e 100644 --- a/src/microcode/extern.h +++ b/src/microcode/extern.h @@ -170,6 +170,7 @@ extern const char * Abort_Names []; extern const char * Error_Names []; extern const char * Term_Names []; extern const char * term_messages []; +extern const char * fixed_objects_names []; extern bool trapping; diff --git a/src/microcode/fixobj.h b/src/microcode/fixobj.h index 572029c3e..ef0174589 100644 --- a/src/microcode/fixobj.h +++ b/src/microcode/fixobj.h @@ -23,8 +23,7 @@ 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. */ #define NON_OBJECT 0x00 /* Used for unassigned variables. */ #define SYSTEM_INTERRUPT_VECTOR 0x01 /* Handlers for interrupts. */ @@ -58,12 +57,12 @@ USA. /* #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. */ @@ -122,3 +121,77 @@ USA. /* 4 extra slots for expansion and debugging. */ #define N_FIXED_OBJECTS 0x45 + +#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 \ +} diff --git a/src/microcode/makegen/Makefile.in.in b/src/microcode/makegen/Makefile.in.in index 8e1f0b725..e8fa8a418 100644 --- a/src/microcode/makegen/Makefile.in.in +++ b/src/microcode/makegen/Makefile.in.in @@ -143,8 +143,7 @@ ALL_DATA = $(aux_DATA) 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 \ @@ -153,8 +152,6 @@ DISTCLEAN_FILES = Makefile config.h config.cache config.log config.status \ 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: @@ -171,8 +168,6 @@ C_CLEAN_FILES = utabmd.c utabmd.bci # **** Main rules **** -default-target: $(ALL_PROGRAMS) $(ALL_LIBS) - all: $(ALL_PROGRAMS) $(ALL_LIBS) $(ALL_DATA) scheme: $(scheme_OBJECTS) $(scheme_DEPENDENCIES) @@ -196,9 +191,6 @@ extract-liarc-decls: extract-liarc-decls.o 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) diff --git a/src/microcode/makegen/files-core.scm b/src/microcode/makegen/files-core.scm index 892a9bd4e..89c09e1cd 100644 --- a/src/microcode/makegen/files-core.scm +++ b/src/microcode/makegen/files-core.scm @@ -75,6 +75,7 @@ USA. "term" "transact" "tterm" +"utabmd" "utils" "vector" "wind" diff --git a/src/microcode/makegen/makegen.scm b/src/microcode/makegen/makegen.scm index 05c4bda00..7fe763bfb 100644 --- a/src/microcode/makegen/makegen.scm +++ b/src/microcode/makegen/makegen.scm @@ -107,8 +107,7 @@ USA. (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")))) diff --git a/src/microcode/option.c b/src/microcode/option.c index ef0159d89..3d88fb119 100644 --- a/src/microcode/option.c +++ b/src/microcode/option.c @@ -81,7 +81,6 @@ USA. 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; @@ -105,7 +104,6 @@ bool option_show_help; 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; @@ -143,14 +141,6 @@ for the band.\n\ 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\ @@ -218,14 +208,6 @@ Additional options may be supported by the band (and described below).\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 @@ -410,14 +392,14 @@ parse_standard_options (int argc, const char ** argv) 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); } @@ -770,7 +752,6 @@ describe_options (void) 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); @@ -893,26 +874,6 @@ read_command_line_options (int argc, const char ** argv) 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) diff --git a/src/microcode/option.h b/src/microcode/option.h index c3eb9f99f..71596237d 100644 --- a/src/microcode/option.h +++ b/src/microcode/option.h @@ -45,7 +45,6 @@ extern bool option_show_version; 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; diff --git a/src/microcode/pruxenv.c b/src/microcode/pruxenv.c index 37baaddb3..29cc0f174 100644 --- a/src/microcode/pruxenv.c +++ b/src/microcode/pruxenv.c @@ -255,8 +255,7 @@ macosx_main_bundle_dir (void) 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); diff --git a/src/microcode/returns.h b/src/microcode/returns.h index 07fb67553..a73146104 100644 --- a/src/microcode/returns.h +++ b/src/microcode/returns.h @@ -27,14 +27,13 @@ USA. interpreter operation needs to operate in several phases. */ #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 @@ -57,52 +56,40 @@ USA. #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 @@ -115,100 +102,100 @@ USA. #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" \ } diff --git a/src/microcode/storage.c b/src/microcode/storage.c index dfcb235d4..21a514dfa 100644 --- a/src/microcode/storage.c +++ b/src/microcode/storage.c @@ -123,3 +123,4 @@ const char * Abort_Names [] = ABORT_NAME_TABLE; /* in const.h */ 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 */ diff --git a/src/microcode/types.h b/src/microcode/types.h index 1bcf1a7d9..2cea15d1e 100644 --- a/src/microcode/types.h +++ b/src/microcode/types.h @@ -25,10 +25,10 @@ USA. /* Type code definitions */ -#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 @@ -36,7 +36,7 @@ USA. #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 @@ -67,7 +67,7 @@ USA. #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 @@ -103,75 +103,75 @@ USA. #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 diff --git a/src/microcode/utabmd.c b/src/microcode/utabmd.c new file mode 100644 index 000000000..91fcb0d74 --- /dev/null +++ b/src/microcode/utabmd.c @@ -0,0 +1,219 @@ +/* -*-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 **); + +#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); + } +} + +#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); +} diff --git a/src/microcode/utabmd.scm b/src/microcode/utabmd.scm deleted file mode 100644 index 513bedc39..000000000 --- a/src/microcode/utabmd.scm +++ /dev/null @@ -1,611 +0,0 @@ -#| -*-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 - -;;; [] 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 - )) - -;;; [] 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 - )) - -;;; [] 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 - )) - -;;; [] 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 - )) - -;;; [] 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 - )) - -;;; [] 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)))) - -;;; [] 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 diff --git a/src/microcode/utabmd.sh b/src/microcode/utabmd.sh deleted file mode 100755 index 4a953bb8e..000000000 --- a/src/microcode/utabmd.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/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} diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm index b987f3cb5..e37438f43 100644 --- a/src/runtime/conpar.scm +++ b/src/runtime/conpar.scm @@ -801,19 +801,10 @@ USA. (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)) diff --git a/src/runtime/framex.scm b/src/runtime/framex.scm index e5b7b48a3..46f1d604e 100644 --- a/src/runtime/framex.scm +++ b/src/runtime/framex.scm @@ -152,17 +152,6 @@ USA. undefined-environment undefined-expression)) -(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) @@ -174,12 +163,6 @@ USA. (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)) @@ -329,22 +312,6 @@ USA. (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)) @@ -352,8 +319,6 @@ USA. (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 diff --git a/src/runtime/pathnm.scm b/src/runtime/pathnm.scm index 47ba8be9f..1c8de0fc1 100644 --- a/src/runtime/pathnm.scm +++ b/src/runtime/pathnm.scm @@ -593,7 +593,7 @@ these rules: (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" diff --git a/src/runtime/utabs.scm b/src/runtime/utabs.scm index e60d9bfdf..b4066ea1f 100644 --- a/src/runtime/utabs.scm +++ b/src/runtime/utabs.scm @@ -27,39 +27,8 @@ USA. ;;; 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))))) -(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 @@ -100,6 +69,14 @@ USA. (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))) @@ -206,23 +183,6 @@ USA. (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) @@ -251,4 +211,44 @@ USA. (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)) + +(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 diff --git a/src/sf/usicon.scm b/src/sf/usicon.scm index 17ecf6e03..c523f141a 100644 --- a/src/sf/usicon.scm +++ b/src/sf/usicon.scm @@ -44,13 +44,13 @@ USA. (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))) diff --git a/v8/src/microcode/fixobj.h b/v8/src/microcode/fixobj.h index 0699541c8..4cb3cd488 100644 --- a/v8/src/microcode/fixobj.h +++ b/v8/src/microcode/fixobj.h @@ -17,8 +17,7 @@ along with this program; if not, write to the Free Software 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. */ #define Non_Object 0x00 /* Used for unassigned variables. */ #define System_Interrupt_Vector 0x01 /* Handlers for interrupts. */