Hi, Right now the only way to get the temps, args names from methods and blocks is the use the source code and extract those informations from it.
With the proposed patch I've added for each compiled method/block a debug information with the args and the names, the class could be extended to add line number inside it. Cheers, Gwen
>From 1a2422e2b9591b99154c888c09d510f1dfef43c9 Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio <[email protected]> Date: Mon, 27 May 2013 10:30:36 +0200 Subject: [PATCH] Add debug information --- kernel/CompildCode.st | 20 +++++++++- kernel/DebugInformation.st | 64 ++++++++++++++++++++++++++++++ libgst/comp.c | 77 ++++++++++++++++++++++++++++++++++-- libgst/comp.h | 2 + libgst/dict.c | 11 ++++-- libgst/dict.h | 1 + libgst/files.c | 2 + packages.xml | 1 + packages/stinst/parser/STCompiler.st | 7 ++++ tests/compiler.ok | 7 ++++ tests/compiler.st | 19 +++++++++ tests/stcompiler.ok | 7 ++++ tests/stcompiler.st | 20 ++++++++++ 13 files changed, 231 insertions(+), 7 deletions(-) create mode 100644 kernel/DebugInformation.st diff --git a/kernel/CompildCode.st b/kernel/CompildCode.st index f42034f..fcbfe1d 100644 --- a/kernel/CompildCode.st +++ b/kernel/CompildCode.st @@ -33,7 +33,7 @@ ArrayedCollection subclass: CompiledCode [ - | literals header | + | literals header debugInfo | <shape: #byte> <category: 'Language-Implementation'> @@ -314,6 +314,12 @@ superclass for blocks and methods'> ^0 ] + arguments [ + <category: 'accessing'> + + ^ debugInfo arguments + ] + numArgs [ "Answer the number of arguments for the receiver" @@ -321,6 +327,12 @@ superclass for blocks and methods'> self subclassResponsibility ] + temporaries [ + <category: 'accessing'> + + ^ debugInfo temporaries + ] + numTemps [ "Answer the number of temporaries for the receiver" @@ -1076,6 +1088,12 @@ superclass for blocks and methods'> ^0 ] + debugInformation: aDebugInformation [ + <category: 'private'> + + ^ debugInfo := aDebugInformation + ] + discardTranslation [ "Flush the just-in-time translated code for the receiver (if any)." diff --git a/kernel/DebugInformation.st b/kernel/DebugInformation.st new file mode 100644 index 0000000..5297164 --- /dev/null +++ b/kernel/DebugInformation.st @@ -0,0 +1,64 @@ +"====================================================================== +| +| 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 >> args: anArgsArray temps: aTempsArray [ + <category: 'instance creation'> + + ^ self new + args: anArgsArray temps: aTempsArray; + yourself + ] + + | args temps | + + args: anArgsArray temps: aTempsArray [ + <category: 'initialization'> + + args := anArgsArray. + temps := aTempsArray. + ] + + arguments [ + <category: 'accessing'> + + ^ args + ] + + temporaries [ + <category: 'accessing'> + + ^ temps + ] +] + diff --git a/libgst/comp.c b/libgst/comp.c index 10330e1..ac830e4 100644 --- a/libgst/comp.c +++ b/libgst/comp.c @@ -692,6 +692,10 @@ _gst_compile_method (tree_node method, OOP methodOOP; bc_vector bytecodes; int stack_depth; + int i, argCount, tempCount; + OOP argsOOP, tempsOOP, debugInfo; + gst_object object; + tree_node args; inc_ptr incPtr; gst_compiled_method compiledMethod; @@ -738,14 +742,14 @@ _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) + if ((argCount = _gst_declare_arguments (method->v_method.selectorExpr)) == -1) { _gst_errorf_at (method->location.first_line, "duplicate argument name"); EXIT_COMPILATION (); } - if (_gst_declare_temporaries (method->v_method.temporaries) == -1) + if ((tempCount = _gst_declare_temporaries (method->v_method.temporaries)) == -1) { _gst_errorf_at (method->location.first_line, "duplicate temporary variable name"); @@ -826,6 +830,44 @@ _gst_compile_method (tree_node method, selector, method->v_method.currentCategory, method->location.file_offset, method->v_method.endPos); + + + if (methodOOP != _gst_nil_oop) { + object = new_instance_with (_gst_array_class, argCount, &argsOOP); + INC_ADD_OOP (argsOOP); + + args = method->v_method.selectorExpr; + + if (args->nodeType == TREE_BINARY_EXPR) + { + object->data[0] = _gst_intern_string (args->v_expr.expression->v_list.name); + } + else + { + for (i = 0, 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 = i + 1; + } + } + + object = new_instance_with (_gst_array_class, tempCount, &tempsOOP); + INC_ADD_OOP (tempsOOP); + + for (i = 0, args = method->v_method.temporaries; args != NULL; args = args->v_list.next) + { + object->data[i] = _gst_intern_string (args->v_list.name); + i = i + 1; + } + + new_instance (_gst_debug_information_class, &debugInfo); + INC_ADD_OOP (debugInfo); + + inst_var_at_put (debugInfo, 1, argsOOP); + inst_var_at_put (debugInfo, 2, tempsOOP); + + inst_var_at_put (methodOOP, 3, debugInfo); + } } if (methodOOP != _gst_nil_oop) @@ -1064,9 +1106,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, argsOOP, tempsOOP; + OOP debugInfo; gst_compiled_block block; + gst_object object; inc_ptr incPtr; + tree_node args; current_bytecodes = _gst_save_bytecode_array (); @@ -1102,6 +1148,31 @@ 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, &argsOOP); + INC_ADD_OOP (argsOOP); + + 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 = i + 1; + } + + object = new_instance_with (_gst_array_class, tempCount, &tempsOOP); + INC_ADD_OOP (tempsOOP); + + for (i = 0, args = blockExpr->v_block.temporaries; args != NULL; args = args->v_list.next) { + object->data[i] = _gst_intern_string (args->v_list.name); + i = i + 1; + } + + new_instance (_gst_debug_information_class, &debugInfo); + INC_ADD_OOP (debugInfo); + + inst_var_at_put (debugInfo, 1, argsOOP); + inst_var_at_put (debugInfo, 2, tempsOOP); + + inst_var_at_put (blockOOP, 3, debugInfo); + _gst_pop_old_scope (); /* emit standard byte sequence to invoke a block: diff --git a/libgst/comp.h b/libgst/comp.h index 91a1f9c..56b4d44 100644 --- a/libgst/comp.h +++ b/libgst/comp.h @@ -136,6 +136,7 @@ typedef struct gst_compiled_method OBJ_HEADER; OOP literals; method_header header; + OOP debug; OOP descriptor; gst_uchar bytecodes[1]; } @@ -208,6 +209,7 @@ typedef struct gst_compiled_block OBJ_HEADER; OOP literals; block_header header; + OOP debug; OOP method; gst_uchar bytecodes[1]; } diff --git a/libgst/dict.c b/libgst/dict.c index f4324b7..b06c6ed 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, @@ -506,8 +507,8 @@ static const class_definition class_info[] = { "ByteArray", NULL, NULL, "CSymbols" }, {&_gst_compiled_code_class, &_gst_arrayed_collection_class, - GST_ISP_UCHAR, false, 2, - "CompiledCode", "literals header", + GST_ISP_UCHAR, false, 3, + "CompiledCode", "literals header debugInfo", NULL, NULL }, {&_gst_compiled_block_class, &_gst_compiled_code_class, @@ -747,7 +748,11 @@ static const class_definition class_info[] = { {&_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, 2, + "DebugInformation", "args temps", NULL, NULL } /* Classes not defined here (like Point/Rectangle/RunArray) are defined after the kernel has been fully initialized. */ diff --git a/libgst/dict.h b/libgst/dict.h index 93224c9..23c9408 100644 --- a/libgst/dict.h +++ b/libgst/dict.h @@ -447,6 +447,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. */ diff --git a/libgst/files.c b/libgst/files.c index a7156f9..913ade1 100644 --- a/libgst/files.c +++ b/libgst/files.c @@ -290,6 +290,8 @@ static const char standard_files[] = { "PkgLoader.st\0" "DirPackage.st\0" "Autoload.st\0" + + "DebugInformation.st\0" }; /* The argc and argv that are passed to libgst via gst_smalltalk_args. diff --git a/packages.xml b/packages.xml index fc6a049..c3b6514 100644 --- a/packages.xml +++ b/packages.xml @@ -189,6 +189,7 @@ <file>LinkedList.st</file> <file>Rectangle.st</file> <file>AnsiDates.st</file> + <file>DebugInformation.st</file> <file>CompildCode.st</file> <file>LookupKey.st</file> <file>BindingDict.st</file> diff --git a/packages/stinst/parser/STCompiler.st b/packages/stinst/parser/STCompiler.st index 74fc9a8..981ca53 100644 --- a/packages/stinst/parser/STCompiler.st +++ b/packages/stinst/parser/STCompiler.st @@ -488,6 +488,7 @@ indexed'' bytecode. The resulting stream is ifTrue: [error := handler value: method value: ann. error notNil ifTrue: [self compileError: error]]]. + self createDebugInformationFor: method from: node. ^method ] @@ -543,6 +544,7 @@ indexed'' bytecode. The resulting stream is bytecodes: bc depth: self maxDepth literals: self literals. + self createDebugInformationFor: block from: aNode. self depthSet: depth. clean := block flags. clean == 0 @@ -994,6 +996,11 @@ indexed'' bytecode. The resulting stream is selector := selectorBuilder contents asSymbol. ^Message selector: selector arguments: arguments contents ] + + createDebugInformationFor: aCompiledCode from: aNode [ + aCompiledCode + debugInformation: (DebugInformation args: aNode argumentNames temps: aNode body temporaryNames). + ] ] diff --git a/tests/compiler.ok b/tests/compiler.ok index 5f1b74d..a797b97 100644 --- a/tests/compiler.ok +++ b/tests/compiler.ok @@ -148,3 +148,10 @@ Execution begins... 'abc' 'def' returned value is ReadStream new "<0>" + +Execution begins... +true +true +true +true +returned value is nil diff --git a/tests/compiler.st b/tests/compiler.st index 1fbdf57..461babb 100644 --- a/tests/compiler.st +++ b/tests/compiler.st @@ -362,3 +362,22 @@ Eval [ #((#{ABC})) ] "Check that lookahead tokens are not discarded after compiling a doit." Eval ['''abc'' printNl ''def'' printNl' readStream fileIn] + +"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 +] 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..0b38220 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
_______________________________________________ help-smalltalk mailing list [email protected] https://lists.gnu.org/mailman/listinfo/help-smalltalk
