>From 5b0dafb33b288aaf3fa552732b77341ed1be7c4b Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio Date: Mon, 24 Jun 2013 18:11:00 +0200 Subject: [PATCH] Add support for DebugInformation (final) --- ChangeLog | 15 ++++++++ kernel/CompildMeth.st | 24 +++++++++++++ kernel/CompiledBlk.st | 12 +++++++ kernel/DebugInformation.st | 70 ++++++++++++++++++++++++++++++++++++++ kernel/MethodInfo.st | 14 +++++++- libgst/comp.c | 85 +++++++++++++++++++++++++++++++++++++++++++--- libgst/comp.h | 2 ++ libgst/dict.c | 23 ++++++------- libgst/dict.h | 7 ++++ libgst/files.c | 1 + packages.xml | 1 + tests/stcompiler.ok | 7 ++++ tests/stcompiler.st | 20 +++++++++++ 13 files changed, 264 insertions(+), 17 deletions(-) create mode 100644 kernel/DebugInformation.st diff --git a/ChangeLog b/ChangeLog index d5395cc..bb14969 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2013-06-24 Gwenael Casaccio + + * kernel/DebugInformation.st: Add DebugInformation. + * kernel/CompildMeth.st: Add DebugInformation support. + * kernel/CompiledBlk.st: Add DebugInformation support. + * kernel/MethodInfo.st: Add DebugInformation support. + * libgst/comp.c: Add arguments and temporaries name in DebugInformation. + * libgst/comp.h: Add a debugInfo state in the compiler. + * libgst/dict.c: Add _gst_identity_dictionary_new. + * libgst/dict.h: Add _gst_identity_dictionary_new. + * libgst/files.c: Bootstrap information for DebugInformation. + * packages.xml: Bootstrap information for DebugInformation. + * tests/stcompiler.ok: Tests for DebugInformations. + * tests/stcompiler.st: Tests for DebugInformations. + 2013-06-14 Jochen Schmitt * smalltalk-mode-init.el.in: Use inhibit-local-variables-regexps diff --git a/kernel/CompildMeth.st b/kernel/CompildMeth.st index 45fc3b9..5a9b056 100644 --- a/kernel/CompildMeth.st +++ b/kernel/CompildMeth.st @@ -756,5 +756,29 @@ instances.'> self become: newMethod. ^nil ] + + arguments [ + + + ^ self argumentsFor: self + ] + + temporaries [ + + + ^ self temporariesFor: self + ] + + argumentsFor: anObject [ + + + ^ self descriptor argumentsFor: anObject + ] + + temporariesFor: anObject [ + + + ^ self descriptor temporariesFor: anObject + ] ] diff --git a/kernel/CompiledBlk.st b/kernel/CompiledBlk.st index 96a2b8d..d5ca707 100644 --- a/kernel/CompiledBlk.st +++ b/kernel/CompiledBlk.st @@ -280,5 +280,17 @@ CompiledCode subclass: CompiledBlock [ receiver: self method]]. self error: 'object cannot be dumped' ] + + arguments [ + + + ^ self method argumentsFor: self + ] + + temporaries [ + + + ^ self method temporariesFor: self + ] ] diff --git a/kernel/DebugInformation.st b/kernel/DebugInformation.st new file mode 100644 index 0000000..23a1635 --- /dev/null +++ b/kernel/DebugInformation.st @@ -0,0 +1,70 @@ +"====================================================================== +| +| Object Method Definitions +| +| + ======================================================================" + +"====================================================================== +| +| Copyright 2013 Free Software Foundation, Inc. +| Written by Gwenael Casaccio. +| +| This file is part of the GNU Smalltalk class library. +| +| The GNU Smalltalk class library is free software; you can redistribute it +| and/or modify it under the terms of the GNU Lesser General Public License +| as published by the Free Software Foundation; either version 2.1, or (at +| your option) any later version. +| +| The GNU Smalltalk class library 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 Lesser +| General Public License for more details. +| +| You should have received a copy of the GNU Lesser General Public License +| along with the GNU Smalltalk class library; see the file COPYING.LIB. +| If not, write to the Free Software Foundation, 59 Temple Place - Suite +| 330, Boston, MA 02110-1301, USA. +| + ======================================================================" + + +Object subclass: DebugInformation [ + + DebugInformation class >> variables: anArray [ + + + ^ self new + variables: anArray; + yourself + ] + + | variables | + + variables: anArray [ + + + variables := anArray. + ] + + variables [ + + + ^ variables + ] + + arguments: anInteger [ + + + ^ variables copyFrom: 1 to: anInteger + ] + + temporaries: anInteger [ + + + ^ variables copyFrom: anInteger + 1 to: variables size + ] +] + + diff --git a/kernel/MethodInfo.st b/kernel/MethodInfo.st index c58ba79..47ef495 100644 --- a/kernel/MethodInfo.st +++ b/kernel/MethodInfo.st @@ -33,7 +33,7 @@ Object subclass: MethodInfo [ - | sourceCode category class selector | + | sourceCode category class selector debugInfo | @@ -140,5 +140,17 @@ code of the method.'> sourceCode := source ] + + argumentsFor: anObject [ + + + ^ (debugInfo at: anObject) arguments: anObject numArgs + ] + + temporariesFor: anObject [ + + + ^ (debugInfo at: anObject) temporaries: anObject numArgs + ] ] diff --git a/libgst/comp.c b/libgst/comp.c index 10330e1..f03b380 100644 --- a/libgst/comp.c +++ b/libgst/comp.c @@ -534,6 +534,9 @@ _gst_execute_statements (OOP receiverOOP, memset (&s, 0, sizeof (s)); _gst_compiler_state->undeclared_temporaries = undeclared; + _gst_compiler_state->debugInfoDict = _gst_identity_dictionary_new (_gst_identity_dictionary_class, 6); + INC_ADD_OOP (_gst_compiler_state->debugInfoDict); + if (setjmp (_gst_compiler_state->bad_method) == 0) { resultOOP = _gst_make_constant_oop (statements->v_list.value); @@ -692,6 +695,10 @@ _gst_compile_method (tree_node method, OOP methodOOP; bc_vector bytecodes; int stack_depth; + int i, argCount, tempCount; + OOP variablesOOP, debugInfo; + gst_object object; + tree_node args; inc_ptr incPtr; gst_compiled_method compiledMethod; @@ -719,6 +726,9 @@ _gst_compile_method (tree_node method, _gst_push_new_scope (); selector = compute_selector (method->v_method.selectorExpr); + _gst_compiler_state->debugInfoDict = _gst_identity_dictionary_new (_gst_identity_dictionary_class, 6); + INC_ADD_OOP (_gst_compiler_state->debugInfoDict); + /* When we are reading from stdin, it's better to write line numbers where 1 is the first line *in the current doit*, because for now the prompt does not include the line number. This might change in the future. @@ -738,14 +748,18 @@ _gst_compile_method (tree_node method, methodOOP = _gst_nil_oop; if (setjmp (_gst_compiler_state->bad_method) == 0) { - if (_gst_declare_arguments (method->v_method.selectorExpr) == -1) + argCount = _gst_declare_arguments (method->v_method.selectorExpr); + + if (argCount == -1) { _gst_errorf_at (method->location.first_line, "duplicate argument name"); EXIT_COMPILATION (); } - if (_gst_declare_temporaries (method->v_method.temporaries) == -1) + tempCount = _gst_declare_temporaries (method->v_method.temporaries); + + if (tempCount == -1) { _gst_errorf_at (method->location.first_line, "duplicate temporary variable name"); @@ -826,11 +840,48 @@ _gst_compile_method (tree_node method, selector, method->v_method.currentCategory, method->location.file_offset, method->v_method.endPos); + + if (methodOOP != _gst_nil_oop) { + INC_ADD_OOP (methodOOP); + + object = new_instance_with (_gst_array_class, argCount + tempCount, &variablesOOP); + INC_ADD_OOP (variablesOOP); + + args = method->v_method.selectorExpr; + i = 0; + + if (args->nodeType == TREE_BINARY_EXPR) + { + object->data[i] = _gst_intern_string (args->v_expr.expression->v_list.name); + i += 1; + } + else + { + for (args = args->v_expr.expression; args != NULL; args = args->v_list.next) + { + object->data[i] = _gst_intern_string (args->v_list.value->v_list.name); + i += 1; + } + } + + for (args = method->v_method.temporaries; args != NULL; args = args->v_list.next) + { + object->data[i] = _gst_intern_string (args->v_list.name); + i += 1; + } + + new_instance (_gst_debug_information_class, &debugInfo); + INC_ADD_OOP (debugInfo); + + inst_var_at_put (debugInfo, 1, variablesOOP); + _gst_identity_dictionary_at_put (_gst_compiler_state->debugInfoDict, methodOOP, debugInfo); + inst_var_at_put (inst_var_at (methodOOP, 3), 5, _gst_compiler_state->debugInfoDict); + } + } if (methodOOP != _gst_nil_oop) { - INC_ADD_OOP (methodOOP); compiledMethod = (gst_compiled_method) OOP_TO_OBJ (methodOOP); compiledMethod->header.isOldSyntax = method->v_method.isOldSyntax; @@ -1064,9 +1115,13 @@ compile_block (tree_node blockExpr) bc_vector current_bytecodes, blockByteCodes; int argCount, tempCount; int stack_depth; - OOP blockClosureOOP, blockOOP; + int i; + OOP blockClosureOOP, blockOOP, variablesOOP; + OOP debugInfo; gst_compiled_block block; + gst_object object; inc_ptr incPtr; + tree_node args; current_bytecodes = _gst_save_bytecode_array (); @@ -1102,6 +1157,27 @@ compile_block (tree_node blockExpr) blockOOP = make_block (_gst_get_arg_count (), _gst_get_temp_count (), blockByteCodes, stack_depth); INC_ADD_OOP (blockOOP); + + object = new_instance_with (_gst_array_class, argCount + tempCount, &variablesOOP); + INC_ADD_OOP (variablesOOP); + + for (i = 0, args = blockExpr->v_block.arguments; args != NULL; args = args->v_list.next) { + object->data[i] = _gst_intern_string (args->v_list.name); + i += 1; + } + + for (args = blockExpr->v_block.temporaries; args != NULL; args = args->v_list.next) { + object->data[i] = _gst_intern_string (args->v_list.name); + i += 1; + } + + new_instance (_gst_debug_information_class, &debugInfo); + INC_ADD_OOP (debugInfo); + + inst_var_at_put (debugInfo, 1, variablesOOP); + + _gst_identity_dictionary_at_put (_gst_compiler_state->debugInfoDict, blockOOP, debugInfo); + _gst_pop_old_scope (); /* emit standard byte sequence to invoke a block: @@ -2739,6 +2815,7 @@ method_info_new (OOP class, methodInfo->category = categoryOOP; methodInfo->class = class; methodInfo->selector = selector; + methodInfo->debugInfo = _gst_nil_oop; while (attrs) { diff --git a/libgst/comp.h b/libgst/comp.h index 91a1f9c..f10f2c0 100644 --- a/libgst/comp.h +++ b/libgst/comp.h @@ -148,6 +148,7 @@ typedef struct gst_method_info OOP category; OOP class; OOP selector; + OOP debugInfo; OOP attributes[1]; } *gst_method_info; @@ -234,6 +235,7 @@ typedef struct compiler_state OOP *literal_vec; OOP *literal_vec_curr; OOP *literal_vec_max; + OOP debugInfoDict; jmp_buf bad_method; } compiler_state; diff --git a/libgst/dict.c b/libgst/dict.c index f4324b7..0b4ddb9 100644 --- a/libgst/dict.c +++ b/libgst/dict.c @@ -177,6 +177,7 @@ OOP _gst_weak_key_identity_dictionary_class = NULL; OOP _gst_weak_value_identity_dictionary_class = NULL; OOP _gst_write_stream_class = NULL; OOP _gst_processor_oop = NULL; +OOP _gst_debug_information_class = NULL; /* Called when a dictionary becomes full, this routine replaces the dictionary instance that DICTIONARYOOP is pointing to with a new, @@ -216,11 +217,6 @@ static int _gst_identity_dictionary_at_inc (OOP identityDictionaryOOP, OOP keyOOP, int inc); -/* Create a new instance of CLASSOOP (an IdentityDictionary subclass) - and answer it. */ -static OOP identity_dictionary_new (OOP classOOP, - int size); - /* Create a new instance of Namespace with the given SIZE, NAME and superspace (SUPERSPACEOOP). */ static OOP namespace_new (int size, @@ -742,12 +738,16 @@ static const class_definition class_info[] = { "Memory", NULL, NULL, NULL }, {&_gst_method_info_class, &_gst_object_class, - GST_ISP_POINTER, true, 4, - "MethodInfo", "sourceCode category class selector", NULL, NULL }, + GST_ISP_POINTER, true, 5, + "MethodInfo", "sourceCode category class selector debugInfo", NULL, NULL }, {&_gst_file_segment_class, &_gst_object_class, GST_ISP_FIXED, true, 3, - "FileSegment", "file startPos size", NULL, NULL } + "FileSegment", "file startPos size", NULL, NULL }, + + {&_gst_debug_information_class, &_gst_object_class, + GST_ISP_FIXED, true, 1, + "DebugInformation", "variables", NULL, NULL } /* Classes not defined here (like Point/Rectangle/RunArray) are defined after the kernel has been fully initialized. */ @@ -1405,7 +1405,7 @@ _gst_valid_class_method_dictionary (OOP class_oop) { OOP methodDictionaryOOP; methodDictionaryOOP = - identity_dictionary_new (_gst_method_dictionary_class, 32); + _gst_identity_dictionary_new (_gst_method_dictionary_class, 32); class = (gst_class) OOP_TO_OBJ (class_oop); class->methodDictionary = methodDictionaryOOP; } @@ -1625,7 +1625,6 @@ grow_identity_dictionary (OOP oldIdentityDictionaryOOP) identityDictionary = instantiate_with (OOP_CLASS (oldIdentityDictionaryOOP), numFields * 2, &identityDictionaryOOP); - oldIdentityDictionary = OOP_TO_OBJ (oldIdentityDictionaryOOP); oldIdentDict = (gst_identity_dictionary) oldIdentityDictionary; identDict = (gst_identity_dictionary) identityDictionary; @@ -1721,7 +1720,7 @@ identity_dictionary_find_key_or_nil (OOP identityDictionaryOOP, } OOP -identity_dictionary_new (OOP classOOP, int size) +_gst_identity_dictionary_new (OOP classOOP, int size) { gst_identity_dictionary identityDictionary; OOP identityDictionaryOOP; @@ -2206,7 +2205,7 @@ _gst_record_profile (OOP oldMethod, OOP newMethod, int ipOffset) profile = _gst_identity_dictionary_at (_gst_raw_profile, oldMethod); if UNCOMMON (IS_NIL (profile)) { - profile = identity_dictionary_new (_gst_identity_dictionary_class, 6); + profile = _gst_identity_dictionary_new (_gst_identity_dictionary_class, 6); _gst_identity_dictionary_at_put (_gst_raw_profile, oldMethod, profile); } diff --git a/libgst/dict.h b/libgst/dict.h index 9202b23..5aaa7eb 100644 --- a/libgst/dict.h +++ b/libgst/dict.h @@ -439,6 +439,7 @@ extern OOP _gst_weak_key_identity_dictionary_class ATTRIBUTE_HIDDEN; extern OOP _gst_weak_value_identity_dictionary_class ATTRIBUTE_HIDDEN; extern OOP _gst_write_stream_class ATTRIBUTE_HIDDEN; extern OOP _gst_processor_oop ATTRIBUTE_HIDDEN; +extern OOP _gst_debug_information_class ATTRIBUTE_HIDDEN; /* The size of the indexed instance variables corresponding to the various instanceSpec values declared in gstpriv.h. */ @@ -487,6 +488,12 @@ extern OOP _gst_dictionary_add (OOP dictionaryOOP, OOP associationOOP) ATTRIBUTE_HIDDEN; +/* Create a new instance of CLASSOOP (an IdentityDictionary subclass) + and answer it. */ +extern OOP _gst_identity_dictionary_new (OOP classOOP, + int size) + ATTRIBUTE_HIDDEN; + /* Look for the value associated to KEYOOP in IDENTITYDICTIONARYOOP and answer it or, if not found, _gst_nil_oop. */ extern OOP _gst_identity_dictionary_at (OOP identityDictionaryOOP, diff --git a/libgst/files.c b/libgst/files.c index a7156f9..06ecfd2 100644 --- a/libgst/files.c +++ b/libgst/files.c @@ -236,6 +236,7 @@ static const char standard_files[] = { "Continuation.st\0" "Memory.st\0" "MethodInfo.st\0" + "DebugInformation.st\0" "FileSegment.st\0" "FileDescr.st\0" "SymLink.st\0" diff --git a/packages.xml b/packages.xml index fc6a049..c3b6514 100644 --- a/packages.xml +++ b/packages.xml @@ -189,6 +189,7 @@ LinkedList.st Rectangle.st AnsiDates.st + DebugInformation.st CompildCode.st LookupKey.st BindingDict.st diff --git a/tests/stcompiler.ok b/tests/stcompiler.ok index a0cebf4..4587736 100644 --- a/tests/stcompiler.ok +++ b/tests/stcompiler.ok @@ -60,3 +60,10 @@ Execution begins... true true returned value is true + +Execution begins... +true +true +true +true +returned value is nil diff --git a/tests/stcompiler.st b/tests/stcompiler.st index 5605a6e..a645741 100644 --- a/tests/stcompiler.st +++ b/tests/stcompiler.st @@ -140,3 +140,23 @@ Eval [ (bla sharedPools = #('STInST') asOrderedCollection) printNl. (bla classVarNames = #('ClassInst') asOrderedCollection) printNl. ] + +"Test debug informations are generated" +Object subclass: Foo [ + a_1: i_1 a_2: i_2 [ + | i j k | + + ^ [ :a :b :c | | d e f | ] + ] +] + +Eval [ + | mth | + mth := Foo>>#'a_1:a_2:'. + (mth arguments = #(#'i_1' #'i_2')) printNl. + (mth temporaries = #(#'i' #'j' #'k')) printNl. + ((mth blockAt: 1) arguments = #(#'a' #'b' #'c')) printNl. + ((mth blockAt: 1) temporaries = #(#'d' #'e' #'f')) printNl. + nil +] + -- 1.8.1.2