cvsuser 03/08/22 03:05:58
Modified: . exceptions.c interpreter.c packfile.c
runops_cores.c warnings.c
include/parrot interpreter.h
languages/imcc pbc.c
languages/imcc/t harness
Log:
PackFile-15: print warning location
Revision Changes Path
1.32 +3 -3 parrot/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/exceptions.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- exceptions.c 20 Aug 2003 11:01:35 -0000 1.31
+++ exceptions.c 22 Aug 2003 10:05:34 -0000 1.32
@@ -1,7 +1,7 @@
/* exceptions.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exceptions.c,v 1.31 2003/08/20 11:01:35 leo Exp $
+ * $Id: exceptions.c,v 1.32 2003/08/22 10:05:34 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -292,9 +292,9 @@
*/
if (interpreter->profile &&
Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
- interpreter->profile->data[*interpreter->profile->lastpc].time +=
+ interpreter->profile->data[*interpreter->cur_pc].time +=
Parrot_floatval_time() - interpreter->profile->starttime;
- interpreter->profile->lastpc = (opcode_t*) &interpreter->op_count;
+ interpreter->cur_pc = (opcode_t*) &interpreter->op_count;
interpreter->profile->starttime = Parrot_floatval_time();
interpreter->profile->data[interpreter->op_count].numcalls++;
}
1.198 +3 -3 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.197
retrieving revision 1.198
diff -u -w -r1.197 -r1.198
--- interpreter.c 20 Aug 2003 11:01:35 -0000 1.197
+++ interpreter.c 22 Aug 2003 10:05:34 -0000 1.198
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.197 2003/08/20 11:01:35 leo Exp $
+ * $Id: interpreter.c,v 1.198 2003/08/22 10:05:34 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -662,9 +662,9 @@
offset = handle_exception(interpreter);
}
if (interpreter->profile &&
- interpreter->profile->lastpc == (opcode_t*)&interpreter->op_count &&
+ interpreter->cur_pc == (opcode_t*)&interpreter->op_count &&
Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
- interpreter->profile->data[*interpreter->profile->lastpc].time +=
+ interpreter->profile->data[*interpreter->cur_pc].time +=
Parrot_floatval_time() - interpreter->profile->starttime;
}
#endif
1.109 +1 -2 parrot/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/packfile.c,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -w -r1.108 -r1.109
--- packfile.c 18 Aug 2003 11:30:43 -0000 1.108
+++ packfile.c 22 Aug 2003 10:05:34 -0000 1.109
@@ -7,7 +7,7 @@
** This program is free software. It is subject to the same
** license as Parrot itself.
**
-** $Id: packfile.c,v 1.108 2003/08/18 11:30:43 leo Exp $
+** $Id: packfile.c,v 1.109 2003/08/22 10:05:34 leo Exp $
**
** History:
** Rework by Melvin; new bytecode format, make bytecode portable.
@@ -1411,7 +1411,6 @@
byte_code->prederef_code = NULL;
byte_code->jit_info = NULL;
byte_code->prev = NULL;
- byte_code->debugs = NULL;
byte_code->debugs = NULL;
byte_code->consts = NULL;
byte_code->fixups = NULL;
1.34 +3 -3 parrot/runops_cores.c
Index: runops_cores.c
===================================================================
RCS file: /cvs/public/parrot/runops_cores.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -w -r1.33 -r1.34
--- runops_cores.c 20 Aug 2003 11:01:35 -0000 1.33
+++ runops_cores.c 22 Aug 2003 10:05:35 -0000 1.34
@@ -1,7 +1,7 @@
/* runops_cores.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: runops_cores.c,v 1.33 2003/08/20 11:01:35 leo Exp $
+ * $Id: runops_cores.c,v 1.34 2003/08/22 10:05:35 leo Exp $
* Overview:
* The switchable runops cores.
* Data Structure and Algorithms:
@@ -112,9 +112,9 @@
#endif
while (pc && pc >= code_start && pc < code_end) {
+ interpreter->cur_pc = pc;
if (Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
interpreter->profile->data[*pc].numcalls++;
- interpreter->profile->lastpc = pc;
interpreter->profile->starttime = Parrot_floatval_time();
}
@@ -130,7 +130,7 @@
#endif
}
if (Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
- interpreter->profile->data[*interpreter->profile->lastpc].time +=
+ interpreter->profile->data[*interpreter->cur_pc].time +=
Parrot_floatval_time() - interpreter->profile->starttime;
}
}
1.15 +54 -40 parrot/warnings.c
Index: warnings.c
===================================================================
RCS file: /cvs/public/parrot/warnings.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- warnings.c 2 Nov 2002 14:57:47 -0000 1.14
+++ warnings.c 22 Aug 2003 10:05:35 -0000 1.15
@@ -1,8 +1,54 @@
#include "parrot/parrot.h"
#include <stdarg.h>
+#include <assert.h>
-#define Default(interp, field, default) (interp ? interp->field : default)
+static int
+find_line(struct Parrot_Interp *interpreter, struct PackFile_Debug * debug)
+{
+ size_t offs, i, n;
+ op_info_t *op_info;
+ opcode_t *pc;
+
+ if (!interpreter->cur_pc)
+ return -2;
+ pc = interpreter->code->cur_cs->base.data;
+ offs = interpreter->cur_pc - pc;
+ for (i = n = 0; n < interpreter->code->cur_cs->base.size; i++) {
+ op_info = &interpreter->op_info_table[*pc];
+ if (n >= offs)
+ return (int) debug->base.data[i];
+ n += op_info->arg_count;
+ pc += op_info->arg_count;
+ }
+ return -1;
+}
+
+static INTVAL
+print_warning(struct Parrot_Interp *interpreter, STRING *msg)
+{
+ const char *file;
+ int line;
+ struct PackFile_Debug * debugs = interpreter->code->cur_cs->debugs;
+
+ if (debugs) {
+ file = debugs->filename;
+ line = find_line(interpreter, debugs);
+ }
+ else {
+ file = "(unknown)";
+ line = 0;
+ }
+
+
+ if (!msg)
+ return -1;
+
+ if (PIO_eprintf(interpreter, "%S at %s line %d.\n", msg, file, line))
+ return -2;
+ else
+ return 1;
+}
INTVAL
Parrot_warn(struct Parrot_Interp *interpreter, INTVAL warnclass,
@@ -11,32 +57,16 @@
STRING *targ;
va_list args;
- va_start(args, message);
- if (!(interpreter == NULL || PARROT_WARNINGS_test(interpreter, warnclass))) {
+ assert(interpreter);
+ if (!PARROT_WARNINGS_test(interpreter, warnclass))
return 2;
- }
+ va_start(args, message);
targ = Parrot_vsprintf_c(interpreter, message, args);
-
va_end(args);
+ return print_warning(interpreter, targ);
- if (!targ) {
- return -1;
- }
-
- if (PIO_eprintf(interpreter, "%S%S.\n",
- targ,
- interpreter ? Parrot_sprintf_c(interpreter,
- " at %S line %d",
- interpreter->current_file,
- interpreter->
- current_line) : NULL) < 0) {
- return -2;
- }
- else {
- return 1;
- }
}
INTVAL
@@ -46,31 +76,15 @@
STRING *targ;
va_list args;
- va_start(args, message);
- if (!(interpreter == NULL || PARROT_WARNINGS_test(interpreter, warnclass))) {
+ if (!interpreter || !PARROT_WARNINGS_test(interpreter, warnclass))
return 2;
- }
+ va_start(args, message);
targ = Parrot_vsprintf_s(interpreter, message, args);
va_end(args);
- if (!targ) {
- return -1;
- }
-
- if (PIO_eprintf(interpreter, "%S%S.\n",
- targ,
- interpreter ? Parrot_sprintf_c(interpreter,
- " at %S line %d",
- interpreter->current_file,
- interpreter->
- current_line) : NULL) < 0) {
- return -2;
- }
- else {
- return 1;
- }
+ return print_warning(interpreter, targ);
}
/*
1.83 +2 -2 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -w -r1.82 -r1.83
--- interpreter.h 20 Aug 2003 11:01:37 -0000 1.82
+++ interpreter.h 22 Aug 2003 10:05:50 -0000 1.83
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.82 2003/08/20 11:01:37 leo Exp $
+ * $Id: interpreter.h,v 1.83 2003/08/22 10:05:50 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -82,7 +82,6 @@
} ProfData;
typedef struct RunProfile {
- opcode_t *lastpc;
FLOATVAL starttime;
ProfData *data;
} RunProfile;
@@ -140,6 +139,7 @@
RunProfile *profile; /* The structure and array where we keep the
* profile counters */
+ opcode_t *cur_pc; /* for profile and warnings */
INTVAL resume_flag;
size_t resume_offset;
1.46 +4 -3 parrot/languages/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/pbc.c,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -w -r1.45 -r1.46
--- pbc.c 16 Aug 2003 12:41:26 -0000 1.45
+++ pbc.c 22 Aug 2003 10:05:54 -0000 1.46
@@ -323,8 +323,8 @@
*/
*src_lines = 0;
for (code_size = 0, ins = instructions; ins ; ins = ins->next) {
- (*src_lines)++;
if (ins->op && *ins->op) {
+ (*src_lines)++;
if (ins->opnum < 0)
fatal(1, "e_pbc_emit", "no opnum ins#%d %s\n",
ins->index, ins_string(ins));
@@ -850,7 +850,8 @@
pc = (opcode_t*) interpreter->code->byte_code + oldsize;
npc = 0;
/* add debug if necessary */
- if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
+ if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG) ||
+ PARROT_WARNINGS_test(interpreter, PARROT_WARNINGS_ALL_FLAG)) {
/* FIXME length and multiple subs */
debug_seg = Parrot_new_debug_seg(interpreter,
interpreter->code->cur_cs, sourcefile,
@@ -894,7 +895,7 @@
}
}
/* add debug line info */
- if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
+ if (debug_seg) {
debug_seg->base.data[ins_line++] = (opcode_t) ins->line;
}
/* Start generating the bytecode */
1.5 +3 -2 parrot/languages/imcc/t/harness
Index: harness
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/t/harness,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- harness 8 Feb 2003 14:41:36 -0000 1.4
+++ harness 22 Aug 2003 10:05:58 -0000 1.5
@@ -1,5 +1,5 @@
#! perl -w
-# $Id: harness,v 1.4 2003/02/08 14:41:36 leo Exp $
+# $Id: harness,v 1.5 2003/08/22 10:05:58 leo Exp $
#Blatantly stolen from parrot/t/harness by Mike Lambert
#Then blatantly stolen from perl6/t/harness by leo ;-)
@@ -14,10 +14,11 @@
use Getopt::Std;
my %opts;
-getopts('gjPbvdc?hO:', \%opts);
+getopts('wgjPbvdc?hO:', \%opts);
if ($opts{'?'} || $opts{h}) {
print <<"EOF";
perl t/harness [options] [testfiles]
+ -w ... warnings on
-g ... disable CGoto
-j ... run JIT
-P ... run Prederef or CGP
