From d7eed5003e92d4e088915beb9a872f49c7672f00 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sun, 5 May 1991 00:41:58 +0000 Subject: [PATCH] Add support for execute caches directly linked to the global environment. Teach the linker about arity dispatcher entities. Add generic hooks for quotient, remainder, and modulo. --- v7/src/microcode/cmpint.c | 86 +++++++++++++++++++++++++++++++-------- v8/src/microcode/cmpint.c | 86 +++++++++++++++++++++++++++++++-------- 2 files changed, 138 insertions(+), 34 deletions(-) diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c index d430e4673..0bc27cb19 100644 --- a/v7/src/microcode/cmpint.c +++ b/v7/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.c,v 1.35 1991/05/02 06:11:10 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpint.c,v 1.36 1991/05/05 00:41:58 jinx Exp $ Copyright (c) 1989-1991 Massachusetts Institute of Technology @@ -176,6 +176,7 @@ do { \ extern long EXFUN (compiler_cache_operator, (void)), + EXFUN (compiler_cache_global_operator, (void)), EXFUN (compiler_cache_lookup, (void)), EXFUN (compiler_cache_assignment, (void)); @@ -293,10 +294,13 @@ extern SCHEME_UTILITY struct utility_result EXFUN (comutil_increment, ()), EXFUN (comutil_less, ()), EXFUN (comutil_minus, ()), + EXFUN (comutil_modulo, ()), EXFUN (comutil_multiply, ()), EXFUN (comutil_negative, ()), EXFUN (comutil_plus, ()), EXFUN (comutil_positive, ()), + EXFUN (comutil_quotient, ()), + EXFUN (comutil_remainder, ()), EXFUN (comutil_zero, ()), EXFUN (comutil_access, ()), EXFUN (comutil_reference, ()), @@ -377,7 +381,10 @@ struct utility_result comutil_assignment, /* 0x33 */ comutil_definition, /* 0x34 */ comutil_lookup_apply, /* 0x35 */ - comutil_primitive_error /* 0x36 */ + comutil_primitive_error, /* 0x36 */ + comutil_quotient, /* 0x37 */ + comutil_remainder, /* 0x38 */ + comutil_modulo /* 0x39 */ }; /* These definitions reflect the indices into the table above. */ @@ -919,22 +926,41 @@ DEFUN (link_cc_block, while ((--sections) >= 0) { header = (block_address[last_header_offset]); + kind = (READ_LINKAGE_KIND (header)); - if (kind == OPERATOR_LINKAGE_KIND) - { - execute_p = true; - entry_size = EXECUTE_CACHE_ENTRY_SIZE; - cache_handler = compiler_cache_operator; - count = (READ_OPERATOR_LINKAGE_COUNT (header)); - } - else + switch (kind) { - execute_p = false; - entry_size = 1; - cache_handler = ((kind == REFERENCE_LINKAGE_KIND) ? - compiler_cache_lookup : - compiler_cache_assignment); - count = (READ_CACHE_LINKAGE_COUNT (header)); + case OPERATOR_LINKAGE_KIND: + cache_handler = compiler_cache_operator; + + handle_operator: + execute_p = true; + entry_size = EXECUTE_CACHE_ENTRY_SIZE; + count = (READ_OPERATOR_LINKAGE_COUNT (header)); + break; + + case GLOBAL_OPERATOR_LINKAGE_KIND: + cache_handler = compiler_cache_global_operator; + goto handle_operator; + + case REFERENCE_LINKAGE_KIND: + cache_handler = compiler_cache_lookup; + handle_reference: + execute_p = false; + entry_size = 1; + count = (READ_CACHE_LINKAGE_COUNT (header)); + break; + + case ASSIGNMENT_LINKAGE_KIND: + cache_handler = compiler_cache_assignment; + goto handle_reference; + + default: + offset += 1; + total_count = (READ_CACHE_LINKAGE_COUNT (header)); + count = (total_count - 1); + result = ERR_COMPILED_CODE_ERROR; + goto back_out; } /* This accomodates the re-entry case after a GC. @@ -978,6 +1004,7 @@ DEFUN (link_cc_block, match the assembly language versions. */ + back_out: STACK_PUSH (ENTRY_TO_OBJECT (ret_add)); STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (sections + 1)); STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (last_header_offset)); @@ -1804,10 +1831,13 @@ COMPILER_ARITH_PRIM (comutil_greater, GENERIC_TRAMPOLINE_GREATER_P, 3); COMPILER_ARITH_PRIM (comutil_increment, GENERIC_TRAMPOLINE_SUCCESSOR, 2); COMPILER_ARITH_PRIM (comutil_less, GENERIC_TRAMPOLINE_LESS_P, 3); COMPILER_ARITH_PRIM (comutil_minus, GENERIC_TRAMPOLINE_SUBTRACT, 3); +COMPILER_ARITH_PRIM (comutil_modulo, GENERIC_TRAMPOLINE_MODULO, 3); COMPILER_ARITH_PRIM (comutil_multiply, GENERIC_TRAMPOLINE_MULTIPLY, 3); COMPILER_ARITH_PRIM (comutil_negative, GENERIC_TRAMPOLINE_NEGATIVE_P, 2); COMPILER_ARITH_PRIM (comutil_plus, GENERIC_TRAMPOLINE_ADD, 3); COMPILER_ARITH_PRIM (comutil_positive, GENERIC_TRAMPOLINE_POSITIVE_P, 2); +COMPILER_ARITH_PRIM (comutil_quotient, GENERIC_TRAMPOLINE_QUOTIENT, 3); +COMPILER_ARITH_PRIM (comutil_remainder, GENERIC_TRAMPOLINE_REMAINDER, 3); COMPILER_ARITH_PRIM (comutil_zero, GENERIC_TRAMPOLINE_ZERO_P, 2); /* @@ -2481,12 +2511,14 @@ DEFUN (make_uuo_link, long offset) { long kind, result, nactuals; - SCHEME_OBJECT trampoline, *cache_address; + SCHEME_OBJECT orig_proc, trampoline, *cache_address; cache_address = (MEMORY_LOC (block, offset)); EXTRACT_EXECUTE_CACHE_ARITY (nactuals, cache_address); /* nactuals >= 0 */ + orig_proc = procedure; +loop: switch (OBJECT_TYPE (procedure)) { case TC_COMPILED_ENTRY: @@ -2521,6 +2553,26 @@ DEFUN (make_uuo_link, case TC_ENTITY: { + SCHEME_OBJECT data, tag, handler; + + data = (MEMORY_REF (procedure, ENTITY_DATA)); + if ((VECTOR_P (data)) + && (nactuals < (VECTOR_LENGTH (data))) + && ((VECTOR_REF (data, nactuals)) != SHARP_F) + && ((VECTOR_REF (data, 0)) + == (Get_Fixed_Obj_Slot (ARITY_DISPATCHER_TAG)))) + { + if (procedure == orig_proc) + { + procedure = (VECTOR_REF (data, nactuals)); + goto loop; + } + else + { + /* No loops allowed! */ + procedure = orig_proc; + } + } kind = TRAMPOLINE_K_ENTITY; break; } diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c index 15762870b..f4553ea33 100644 --- a/v8/src/microcode/cmpint.c +++ b/v8/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpint.c,v 1.35 1991/05/02 06:11:10 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpint.c,v 1.36 1991/05/05 00:41:58 jinx Exp $ Copyright (c) 1989-1991 Massachusetts Institute of Technology @@ -176,6 +176,7 @@ do { \ extern long EXFUN (compiler_cache_operator, (void)), + EXFUN (compiler_cache_global_operator, (void)), EXFUN (compiler_cache_lookup, (void)), EXFUN (compiler_cache_assignment, (void)); @@ -293,10 +294,13 @@ extern SCHEME_UTILITY struct utility_result EXFUN (comutil_increment, ()), EXFUN (comutil_less, ()), EXFUN (comutil_minus, ()), + EXFUN (comutil_modulo, ()), EXFUN (comutil_multiply, ()), EXFUN (comutil_negative, ()), EXFUN (comutil_plus, ()), EXFUN (comutil_positive, ()), + EXFUN (comutil_quotient, ()), + EXFUN (comutil_remainder, ()), EXFUN (comutil_zero, ()), EXFUN (comutil_access, ()), EXFUN (comutil_reference, ()), @@ -377,7 +381,10 @@ struct utility_result comutil_assignment, /* 0x33 */ comutil_definition, /* 0x34 */ comutil_lookup_apply, /* 0x35 */ - comutil_primitive_error /* 0x36 */ + comutil_primitive_error, /* 0x36 */ + comutil_quotient, /* 0x37 */ + comutil_remainder, /* 0x38 */ + comutil_modulo /* 0x39 */ }; /* These definitions reflect the indices into the table above. */ @@ -919,22 +926,41 @@ DEFUN (link_cc_block, while ((--sections) >= 0) { header = (block_address[last_header_offset]); + kind = (READ_LINKAGE_KIND (header)); - if (kind == OPERATOR_LINKAGE_KIND) - { - execute_p = true; - entry_size = EXECUTE_CACHE_ENTRY_SIZE; - cache_handler = compiler_cache_operator; - count = (READ_OPERATOR_LINKAGE_COUNT (header)); - } - else + switch (kind) { - execute_p = false; - entry_size = 1; - cache_handler = ((kind == REFERENCE_LINKAGE_KIND) ? - compiler_cache_lookup : - compiler_cache_assignment); - count = (READ_CACHE_LINKAGE_COUNT (header)); + case OPERATOR_LINKAGE_KIND: + cache_handler = compiler_cache_operator; + + handle_operator: + execute_p = true; + entry_size = EXECUTE_CACHE_ENTRY_SIZE; + count = (READ_OPERATOR_LINKAGE_COUNT (header)); + break; + + case GLOBAL_OPERATOR_LINKAGE_KIND: + cache_handler = compiler_cache_global_operator; + goto handle_operator; + + case REFERENCE_LINKAGE_KIND: + cache_handler = compiler_cache_lookup; + handle_reference: + execute_p = false; + entry_size = 1; + count = (READ_CACHE_LINKAGE_COUNT (header)); + break; + + case ASSIGNMENT_LINKAGE_KIND: + cache_handler = compiler_cache_assignment; + goto handle_reference; + + default: + offset += 1; + total_count = (READ_CACHE_LINKAGE_COUNT (header)); + count = (total_count - 1); + result = ERR_COMPILED_CODE_ERROR; + goto back_out; } /* This accomodates the re-entry case after a GC. @@ -978,6 +1004,7 @@ DEFUN (link_cc_block, match the assembly language versions. */ + back_out: STACK_PUSH (ENTRY_TO_OBJECT (ret_add)); STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (sections + 1)); STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (last_header_offset)); @@ -1804,10 +1831,13 @@ COMPILER_ARITH_PRIM (comutil_greater, GENERIC_TRAMPOLINE_GREATER_P, 3); COMPILER_ARITH_PRIM (comutil_increment, GENERIC_TRAMPOLINE_SUCCESSOR, 2); COMPILER_ARITH_PRIM (comutil_less, GENERIC_TRAMPOLINE_LESS_P, 3); COMPILER_ARITH_PRIM (comutil_minus, GENERIC_TRAMPOLINE_SUBTRACT, 3); +COMPILER_ARITH_PRIM (comutil_modulo, GENERIC_TRAMPOLINE_MODULO, 3); COMPILER_ARITH_PRIM (comutil_multiply, GENERIC_TRAMPOLINE_MULTIPLY, 3); COMPILER_ARITH_PRIM (comutil_negative, GENERIC_TRAMPOLINE_NEGATIVE_P, 2); COMPILER_ARITH_PRIM (comutil_plus, GENERIC_TRAMPOLINE_ADD, 3); COMPILER_ARITH_PRIM (comutil_positive, GENERIC_TRAMPOLINE_POSITIVE_P, 2); +COMPILER_ARITH_PRIM (comutil_quotient, GENERIC_TRAMPOLINE_QUOTIENT, 3); +COMPILER_ARITH_PRIM (comutil_remainder, GENERIC_TRAMPOLINE_REMAINDER, 3); COMPILER_ARITH_PRIM (comutil_zero, GENERIC_TRAMPOLINE_ZERO_P, 2); /* @@ -2481,12 +2511,14 @@ DEFUN (make_uuo_link, long offset) { long kind, result, nactuals; - SCHEME_OBJECT trampoline, *cache_address; + SCHEME_OBJECT orig_proc, trampoline, *cache_address; cache_address = (MEMORY_LOC (block, offset)); EXTRACT_EXECUTE_CACHE_ARITY (nactuals, cache_address); /* nactuals >= 0 */ + orig_proc = procedure; +loop: switch (OBJECT_TYPE (procedure)) { case TC_COMPILED_ENTRY: @@ -2521,6 +2553,26 @@ DEFUN (make_uuo_link, case TC_ENTITY: { + SCHEME_OBJECT data, tag, handler; + + data = (MEMORY_REF (procedure, ENTITY_DATA)); + if ((VECTOR_P (data)) + && (nactuals < (VECTOR_LENGTH (data))) + && ((VECTOR_REF (data, nactuals)) != SHARP_F) + && ((VECTOR_REF (data, 0)) + == (Get_Fixed_Obj_Slot (ARITY_DISPATCHER_TAG)))) + { + if (procedure == orig_proc) + { + procedure = (VECTOR_REF (data, nactuals)); + goto loop; + } + else + { + /* No loops allowed! */ + procedure = orig_proc; + } + } kind = TRAMPOLINE_K_ENTITY; break; } -- 2.25.1