[perl #19143] Another GC bug?

[via RT]

# New Ticket Created by  Simon Glover 
# Please include the string:  [perl #19143]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19143 >



 I've managed to track down the cause of the failure of at least one of
 the properties tests on TD-Miata (the Itanium in the Tinderbox). The
 chain of events in test 1 of prop.t is as follows:

  i) setprop in default.pmc is called for the first time

  ii) This creates a Key PMC by calling key_new_string; this has its
  KEY_string_FLAG  (aka PObj_private2_FLAG) and PObj_custom_mark_FLAG
  flags set, as it should do.

  iii) Since there's no properties hash, a new PerlHash is created.

  iv) The test is running with --gc-debug set, so this triggers GC/DOD.

  v)  The key is (erroneously) placed on the free list; at this point,
  the only flag it has set is the PObj_on_free_list_FLAG

  vi) setprop next calls the PerlHash's set_pmc_keyed method with this
  key (which is now invalid)

  vii) set_pmc_keyed finally calls key_string (in key.c), which sees that
  the key is invalid, and throws an exception ("Key not a string!")


 Clearly the problem is that the Key is being put on the free list when
 it shouldn't be. Unfortunately, I have no idea why, or how to fix it.

 I haven't investigated any of the other failures, but it seems likely
 that the root cause is the same (since the Tinderbox report shows that
 they're printing the same error message).

 Hope this analysis is useful,
 Simon

[perl #19163] configure probe for va_list*

[via RT]

# New Ticket Created by  Steve Fink 
# Please include the string:  [perl #19163]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19163 >


I'm a little confused by the va_list* stuff for sprintf*. At one
point, people were saying that ppc does va_list differently, though
I'm guessing that was a different compiler than gcc. Now, it seems
like everything uses the same mechanism (and it was just patched to be
this way by Dan). Are there architectures out there that do an extra
level of pointers, or was the whole thing cleaned up by using va_list
pointers in the first place, or what? In meddling with this, I
generated the attached patch to probe for something that now seems to
be a figment of somebody's imagination.

 -- a confused Fink


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45502/35713/e3eb68/va_list.patch


Index: config/gen/feature_h/feature_h.in
===
RCS file: /cvs/public/parrot/config/gen/feature_h/feature_h.in,v
retrieving revision 1.3
diff -u -r1.3 feature_h.in
--- config/gen/feature_h/feature_h.in   15 Dec 2002 19:20:42 -  1.3
+++ config/gen/feature_h/feature_h.in   16 Dec 2002 05:27:15 -
@@ -3,8 +3,8 @@
  */
 
 
-#if !defined(PARROT_FEATRUE_H_GUARD)
-#define PARROT_FEATRUE_H_GUARD
+#if !defined(PARROT_FEATURE_H_GUARD)
+#define PARROT_FEATURE_H_GUARD
 
 #perl - all below here gets evaled by perl, OUT is the filehandle
 
@@ -15,9 +15,17 @@
print OUT "#endif\n";
 }
 
+if (${va_list_ptr} eq 'direct') {
+print OUT <<'END';
+#define VA_TO_VAPTR(x) (x)
+END
+} elsif (${va_list_ptr} eq 'address') {
 print OUT <<'END';
 #define VA_TO_VAPTR(x) (&(x))
 END
+} else {
+die "Hey! Need to know how to get a va_list* !!";
+}
 
 #endif guard
 print OUT "\n\n#endif\n"
Index: lib/Parrot/Configure/RunSteps.pm
===
RCS file: /cvs/public/parrot/lib/Parrot/Configure/RunSteps.pm,v
retrieving revision 1.16
diff -u -r1.16 RunSteps.pm
--- lib/Parrot/Configure/RunSteps.pm12 Dec 2002 11:21:36 -  1.16
+++ lib/Parrot/Configure/RunSteps.pm16 Dec 2002 05:27:15 -
@@ -27,6 +27,7 @@
auto/funcptr.pl
auto/cgoto.pl
auto/gc.pl
+auto/varargs.pl
gen/config_h.pl
gen/feature_h.pl
gen/config_pm.pl
--- /dev/null   Thu Apr 11 07:25:15 2002
+++ config/auto/varargs.pl  Sun Dec 15 21:27:51 2002
@@ -0,0 +1,24 @@
+package Configure::Step;
+
+use strict;
+use vars qw($description @args);
+use Parrot::Configure::Step ':auto';
+
+$description="Determining how to access va_list...";
+
+sub runstep {
+my $method = "unknown";
+cc_gen('config/auto/varargs/test_c.in');
+cc_build();
+$method = "direct" if (cc_run_capture(1) =~ /yes/);
+$method = "address" if (cc_run_capture(2) =~ /yes/);
+cc_clean();
+
+if ($method eq "unknown") {
+die "Can't determine how to get a ptr to a va_list!\n";
+}
+
+Configure::Data->set(va_list_ptr => $method);
+}
+
+1;
--- /dev/null   Thu Apr 11 07:25:15 2002
+++ config/auto/varargs/test_c.in   Sun Dec 15 21:28:06 2002
@@ -0,0 +1,61 @@
+/*
+ * testvarargs.c - figure out how to get a pointer to a va_list
+ */
+
+#include 
+#include 
+
+#define UNKNOWN 0
+#define ADDRESS_OF 1
+#define DIRECT 2
+
+int
+test_address(int first_arg, ...)
+{
+va_list args;
+va_list* ptr;
+int value;
+va_start(args, first_arg);
+ptr = (va_list*) &args;
+value = va_arg(*ptr, int);
+va_end(args);
+return (value == 7531);
+}
+
+int
+test_direct(int first_arg, ...)
+{
+va_list args;
+va_list* ptr;
+int value;
+va_start(args, first_arg);
+ptr = (va_list*) args;
+value = va_arg(*ptr, int);
+va_end(args);
+return (value == 7531);
+}
+
+int
+main(int argc, char *argv[])
+{
+if (argv[1][0] == '1' && test_direct(0, 7531)) {
+printf("yes\n");
+return 0;
+} else if (argv[1][0] == '2' && test_address(0, 7531)) {
+printf("yes\n");
+return 0;
+} else {
+printf("unknown\n");
+return 1;
+}
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */

[perl #19179] [PATCH] creating string_max_bytes()

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19179]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19179 >


This patch
 (1) Creates a string_max_bytes() function,
 as described in docs/strings.pod.
 Code in string.c, prototype in include/parrot/string_funcs.h.
 It just uses s->encoding->max_bytes.
 (2) Modifies string_grow() in string.c to use string_max_bytes(),
 as described in docs/strings.pod.

That is all.

Apropos the TODO item

   String subsystem
   
   grep docs/strings.pod for unimplemented functions and implement them

and the docs/strings.pod description

   =head1 Non-user-visible String Manipulation Functions
  [...]
   INTVAL string_compute_strlen(STRING* s)

   and

   INTVAL string_max_bytes(STRING *s, INTVAL iv)

   The first updates the contents of C<< s->strlen >> by contemplating the
   buffer C and working out how many characters it contains. The
   second is given a number of characters which we assume are going to be
   added into the string at some point; it returns the maximum number of
   bytes that need to be allocated to admit that number of characters. For
   fixed-width encodings, this is trivial - the "native" encoding, for
   instance, encodes one byte per character, so C
   simply returns the C it is passed; C, on the
   other hand, returns three times the value that it is passed because a
   UTF8 character may occupy up to three bytes.

   To grow a string to a specified size, use 

   void string_grow(STRING *s, INTVAL newsize)

   The size is given in characters; C is called to turn
   this into a size in bytes, and then the buffer is grown to accomodate
   (at least) that many bytes.

Mitchell Charity



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45540/35737/fed377/create_string_max_bytes.patch


diff -ur ./include/parrot/string_funcs.h 
../parrot_strings/include/parrot/string_funcs.h
--- ./include/parrot/string_funcs.h Sun Dec 15 12:59:51 2002
+++ ../parrot_strings/include/parrot/string_funcs.h Mon Dec 16 06:53:11 2002
@@ -18,6 +18,7 @@
 /* Declarations of accessors */
 
 INTVAL string_compute_strlen(STRING *);
+INTVAL string_max_bytes(STRING*, INTVAL);
 STRING *string_concat(struct Parrot_Interp *, STRING *, STRING *, UINTVAL);
 STRING *string_append(struct Parrot_Interp *, STRING *, STRING *, UINTVAL);
 STRING *string_from_c_string(struct Parrot_Interp *, const void *, UINTVAL);
diff -ur ./string.c ../parrot_strings/string.c
--- ./string.c  Sun Dec 15 12:59:47 2002
+++ ../parrot_strings/string.c  Mon Dec 16 07:16:04 2002
@@ -275,7 +275,8 @@
 unmake_COW(interpreter,s);
 
 /* Don't check buflen, if we are here, we already checked. */
-Parrot_reallocate_string(interpreter, s, s->buflen + addlen);
+Parrot_reallocate_string(interpreter, s,
+ s->buflen + string_max_bytes(s,addlen));
 return s;
 }
 
@@ -488,6 +489,16 @@
 return s->strlen;
 }
 
+/*=for api string string_max_bytes
+ * returns the number of bytes required to safely contain
+ * n characters in the string's encoding
+ */
+INTVAL
+string_max_bytes(STRING *s, INTVAL nchars)
+{
+return (nchars * s->encoding->max_bytes);
+}
+
 /*=for api string string_concat
  * concatenate two strings
  */

[perl #19183] languages/perl6/t/compiler.t -- multiple ways to spell "Inf"

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19183]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19183 >


On Solaris 8, with Sun's Workshop Compiler, using Sun's supplied
5.00503, I get the following test failure in

t/compiler/1# Failed test (t/compiler/1.t at line 306)
#  got: '7.00 9.00 4.00 
# 7.00 9.00 4.00 
# 10.00 18.00 0.00 
# 32.00 729.00 1.00 
# 0.40 0.50 Inf 
# 1.00 0.00 0.00 
# 3.00 3.00 -4.00 
# '
# expected: '7.00 9.00 4.00 
# 7.00 9.00 4.00 
# 10.00 18.00 0.00 
# 32.00 729.00 1.00 
# 0.40 0.50 inf 
# 1.00 0.00 0.00 
# 3.00 3.00 -4.00 
# '
# Looks like you failed 1 tests of 14.
dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 14
Failed 1/14 tests, 92.86% okay

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19184] languages/perl6/t/rx/call test error

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19184]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19184 >


On Solaris 8, with Sun's Workshop Compiler, using Sun's supplied
5.00503, I get the following test failure in
languages/perl6/t/rx/call:

t/rx/call...Use of uninitialized value at ../../assemble.pl line 277.
Use of uninitialized value at ../../assemble.pl line 883.
Use of uninitialized value at ../../assemble.pl line 883.
# Failed test (t/rx/call.t at line 48)
#  got: ''
# expected: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# '
# Looks like you failed 1 tests of 2.
dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 2
Failed 1/2 tests, 50.00% okay

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19185] jako not perl-5.00503-compatible

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19185]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19185 >


Here's what I get running 'make languages' with perl-5.00503:

cd jako && make && cd ..
/usr/perl5/bin/perl5.00503 -I lib jakoc examples/bench.jako > examples/bench.imc || 
(rm -f examples/bench.imc && false)
Can't locate warnings.pm in @INC (@INC contains: lib /usr/perl5/5.00503/sun4-solaris 
/usr/perl5/5.00503 /usr/perl5/site_perl/5.005/sun4-solaris /usr/perl5/site_perl/5.005 
.) at lib/Jako/Lexer.pm line 12.
BEGIN failed--compilation aborted at lib/Jako/Lexer.pm line 12.
BEGIN failed--compilation aborted at jakoc line 23.

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19187] t/src/sprintf errors with 64-bit ints:

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19187]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19187 >



On Solaris 8, with Sun's Workshop Compiler, using 64-bit long longs as
INTVAL, I get the following test failure in t/src/sprintf.  It looks
like something is getting passed a 64-bit integer quantity but only taking
the first 32-bits (i.e. an int or long) to do the printing.  On i386,
this ends up not mattering since those 32-bits are the significant ones.
A SPARC, however, is the other-endian, so those first 32 bits are all
zeros.  I don't have time to track this down further myself.

t/src/sprintf...# Failed test (t/src/sprintf.t at line 9)
#  got: 'C
# Hello, %Parrot!%
# PerlHash[0x100]
# PerlHash[0x100]
# Hello, Pa!
# Hello, Hello, Pa!
# 1 == 1
# -255 == -255
# 256 == 256
# 0.50 == 0.50
# 0.500 == 0.500
# 0.001 == 0.001
# 1e+06 == 1e+06
# 0.5 == 0.5
# 0x20 == 0x0
#25 == 0
# 25== 0|
# 00025 == 0
# 25 ==  0
# 0x == 0x
# -001 == -001
# That's all, folks!
# '
# expected: 'C
# Hello, %Parrot!%
# PerlHash[0x100]
# PerlHash[0x100]
# Hello, Pa!
# Hello, Hello, Pa!
# 1 == 1
# -255 == -255
# 256 == 256
# 0.50 == 0.50
# 0.500 == 0.500
# 0.001 == 0.001
# 1e+06 == 1e+06
# 0.5 == 0.5
# 0x20 == 0x20
#25 ==25
# 25== 25   |
# 00025 == 00025
# 25 == 25
# 0x == 0x
# -001 == -001
# That's all, folks!
# '
# Looks like you failed 1 tests of 2.
dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 1
Failed 1/2 tests, 50.00% okay

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19188] t/pmc/pmc test failure with 64-bit INTVALs

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19188]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19188 >



On Solaris 8, with Sun's Workshop Compiler, using 64-bit long longs as
INTVAL, I get the following test failure in t/pmc/pmc;

t/pmc/pmc...# Failed test (t/pmc/pmc.t at line 68)
#  got: 'Illegal PMC enum (0) in new
# '
# expected: 'Illegal PMC enum (21) in new
# '
# Looks like you failed 1 tests of 80.
dubious
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 3
Failed 1/80 tests, 98.75% okay (less 2 skipped tests: 77 okay, 96.25%)

This is probably because the internal_exception() function gets passed a
format type of %d, but then is passed a long-long argument.  The fix is
either to re-work internal_exception to use the Parrot_v*printf stuff
(maybe not because we're throwing an exception because we're in serious
trouble?) or else cast all the arguments to internal_exception() to the
right type, or else use the right printf format characters (found,
perhaps, by Configure.pl).

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19189] t/pmc/perlhash fails with gcc-2.95.4 or gcc-2.8.1 on SPARC

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19189]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19189 >


On a Debian/SPARC system with gcc-2.95.4, and on a Solaris/SPARC
system with gcc-2.8.1, I get the following failure in t/pmc/perlhash:

t/pmc/perlhash..# Failed test (t/pmc/perlhash.t at line 534)
#  got: ''
# expected: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# '
# Looks like you failed 1 tests of 23.
dubious
Test returned status 1 (wstat 256, 0x10

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19191] [PATCH] creation of string_nprintf()

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19191]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19191 >


This patch creates a string_nprintf(), as described in docs/strings.pod.

Specifically,
  (1) string_nprintf's docs/strings.pod entry is updated to reflect
  an extra first argument, interpreter.  All the similar string_*
  functions need it, and we do too.
  (2) string_nprintf() is added to string.c, and its prototype to
  include/parrot/string_funcs.h.
  (3) Test code is added to t/src/sprintf.t.

That is all.

The Parrot_*printf functions made it nicely straightforward. :)

It looks like string_destory(), and the string_utf8_max_bytes() (et al)
functions, are all that remains before
   grep docs/strings.pod for unimplemented functions and implement them
can be removed from the TODO list.  I won't get to it today.

Mitchell



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45565/35760/c784f8/create_string_nprintf.patch


diff -u -r ./docs/strings.pod ../parrot_nprintf/docs/strings.pod
--- ./docs/strings.pod  Tue Aug 27 02:57:55 2002
+++ ../parrot_nprintf/docs/strings.pod  Mon Dec 16 12:10:07 2002
@@ -138,10 +138,9 @@
 
 Otherwise the string will be true.
 
-B: 
 To format output into a string, use
 
-STRING* string_nprintf(STRING* dest, INTVAL len, char* format, ...) 
+STRING* string_nprintf(struct Parrot_Interp *, STRING* dest, INTVAL len, char* 
+format, ...) 
 
 C may be a null pointer, in which case a new B string will
 be created. If C is zero, the behaviour becomes more Cish
diff -u -r ./include/parrot/string_funcs.h 
../parrot_nprintf/include/parrot/string_funcs.h
--- ./include/parrot/string_funcs.h Sun Dec 15 12:59:51 2002
+++ ../parrot_nprintf/include/parrot/string_funcs.h Mon Dec 16 11:31:36 2002
@@ -28,6 +28,8 @@
   INTVAL, STRING **);
 STRING *string_replace(struct Parrot_Interp *, STRING *, INTVAL, INTVAL,
STRING *, STRING **);
+STRING *string_nprintf(struct Parrot_Interp *,
+   STRING *, INTVAL, const char *, ...);
 INTVAL string_compare(struct Parrot_Interp *, STRING *, STRING *);
 INTVAL string_bool(const STRING *);
 const char *Parrot_string_cstring(const STRING *);
diff -u -r ./string.c ../parrot_nprintf/string.c
--- ./string.c  Sun Dec 15 12:59:47 2002
+++ ../parrot_nprintf/string.c  Mon Dec 16 12:07:30 2002
@@ -903,6 +903,41 @@
 return 1;   /* it must be true */
 }
 
+/*=for api string string_nprintf
+ * like Parrot_snprintf, but writes to, and returns, a STRING.
+ *
+ * bytelen does _not_ include space for a (non-existent) trailing null.
+ * dest may be a null pointer, in which case a new native string will
+ * be created. If bytelen is zero, the behaviour becomes more
+ * sprintf-ish than snprintf-like.  bytelen is measured in dest's encoding.
+ */
+STRING*
+string_nprintf(struct Parrot_Interp *interpreter,
+   STRING *dest, INTVAL bytelen, const char *format, ...)
+{
+STRING *output;
+ENCODING *dest_encoding;
+va_list args;
+
+va_start(args, format);
+output = Parrot_vsprintf_c(interpreter, format, args);
+va_end(args);
+
+dest_encoding = (dest != NULL) ? dest->encoding : NULL;
+string_transcode(interpreter, output, dest_encoding, NULL, &output);
+
+if(bytelen > 0 && bytelen < string_length(output)) {
+string_substr(interpreter, output, 0, bytelen, &output);
+}
+
+if(dest == NULL) {
+return output;
+} else {
+string_set(interpreter,dest,output);
+return dest;
+}
+}
+
 /* A number is such that:
   sign   =  '+' | '-'
   digit  =  "Any code point considered a digit by the chartype"
Only in ../parrot_nprintf/t/op: #string.t#
diff -u -r ./t/src/sprintf.t ../parrot_nprintf/t/src/sprintf.t
--- ./t/src/sprintf.t   Sun Dec 15 14:20:44 2002
+++ ../parrot_nprintf/t/src/sprintf.t   Mon Dec 16 11:57:28 2002
@@ -111,6 +111,24 @@
 printf("%08d %s", (int) ival,
string_to_cstring(interpreter, S));
  
+/* test string_nprintf() */
+{
+   STRING *S2;
+   ival = 100;
+   S = string_nprintf(interpreter, NULL, 0, "== %d\n", (int) ival);
+   printf("%d %s", (int) ival, string_to_cstring(interpreter, S));
+   S2 = string_from_c_string(interpreter,"Parrot", 0);
+   S = string_nprintf(interpreter, S2, 0, "== %d\n", (int) ival);
+   printf("%d %s", (int) ival, string_to_cstring(interpreter, S));
+   printf("%s\n", (S == S2) ? "ok" : "different?!?");
+   S = string_nprintf(interpreter, NULL, 42, "== %d\n", (int) ival);
+   printf("%d %s", (int) ival, string_to_cstring(interpreter, S));
+   S = string_nprintf(interpreter, NULL, 6, "== %d\n", (int) ival);
+   printf("100 %s\n", string_to_cstring(interpreter, S));
+   S = string_nprintf(interp

[perl #19192] JIT fails 3 tests on AMD K5

[via RT]

# New Ticket Created by  The RT System itself 
# Please include the string:  [perl #19192]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19192 >


I can build parrot fine on my FreeBSD box. I can re-run the tests fine with
/usr/local/bin/perl5.8.0 t/harness  quick

All tests successful, 18 subtests skipped.
Files=42, Tests=581, 205 wallclock secs (65.07 cusr + 38.41 csys = 103.48 CPU)

However, if I try to test the JIT:

/usr/local/bin/perl5.8.0 t/harness -j  quick

Failed TestStat Wstat Total Fail  Failed  List of Failed
---
t/op/trans.t  2   512182  11.11%  11 18
t/pmc/perlstring.t1   256 81  12.50%  3
t/pmc/pmc.t   1   256801   1.25%  36
18 subtests skipped.
Failed 3/42 test scripts, 92.86% okay. 4/581 subtests failed, 99.31% okay.


Details are:

t/op/trans..NOK 11# Failed test (t/op/trans.t at line 251)   
#  got: 'ok 1
# not ok 2
# '
# expected: 'ok 1
# ok 2
# '
t/op/trans..NOK 18# Failed test (t/op/trans.t at line 479)   
#  got: 'not ok 1
# not ok 2
# not ok 3
# not ok 4
# not ok 5
# not ok 6
# ok 7
# ok 8
# ok 9
# ok 10
# not ok 11
# not ok 12
# ok 13
# not ok 14
# not ok 15
# ok 16
# '
# expected: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# ok 6
# ok 7
# ok 8
# ok 9
# ok 10
# ok 11
# ok 12
# ok 13
# ok 14
# ok 15
# ok 16
# '
# Looks like you failed 2 tests of 18.
t/op/trans..dubious  
Test returned status 2 (wstat 512, 0x200)
DIED. FAILED tests 11, 18
Failed 2/18 tests, 88.89% okay

t/pmc/perlstringNOK 3# Failed test (t/pmc/perlstring.t at line 137)  
#  got: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# not ok 6
# '
# expected: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# ok 6
# '
t/pmc/perlstringok 8/8# Looks like you failed 1 tests of 8.
t/pmc/perlstringdubious  
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 3
Failed 1/8 tests, 87.50% okay (less 1 skipped test: 6 okay, 75.00%)
t/pmc/pmc...NOK 36# Failed test (t/pmc/pmc.t at line 585)
#  got: 'ok 1
# ok 2
# ok 3
# 0.00not ok 4
# ok 5
# ok 6
# ok 7
# ok 8
# 0.00not ok 9
# ok 10
# ok 11
# ok 12
# '
# expected: 'ok 1
# ok 2
# ok 3
# ok 4
# ok 5
# ok 6
# ok 7
# ok 8
# ok 9
# ok 10
# ok 11
# ok 12
# '
t/pmc/pmc...ok 80/80# Looks like you failed 1 tests of 80.   
t/pmc/pmc...dubious  
Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 36
Failed 1/80 tests, 98.75% okay (less 2 skipped tests: 77 okay, 96.25%)

Unlike the previous JIT bug, this doesn't seem to be due to the JIT using
instructions that are absent on the K5. (Or at least it's not core dumping
with SIGILL)

CPU is:
CPU: AMD-K5(tm) Processor (100.23-MHz 586-class CPU)
  Origin = "AuthenticAMD"  Id = 0x514  Stepping = 4
  Features=0x21bf
  AMD Features=0x0
real memory  = 16777216 (16384K bytes)
avail memory = 13422592 (13108K bytes)

Hmm. I'd not looked at that before. Maybe my sister was mistaken when she
gave it to me saying it was 133 Mhz. I'll have to get my money back. All £0. :-)

uname -a reports:
FreeBSD thinking-cap.moo 4.6-RELEASE FreeBSD 4.6-RELEASE #0: Sat Jul 13 18:39:23 GMT 
2002 [EMAIL PROTECTED]:/usr/local/obj/usr/src/sys/THINKINGCAP  i386

The same JIT test passes 100% on another FreeBSD machine I have access to.
Although this isn't totally helpful, as that machine has a Citrix processor,
and it's more recent than my K5

Nicholas Clark

[perl #19227] [PATCH] Unintialized buffer causes GC to fail in t/src/sprintf.t on Win32.

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19227]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19227 >


In headers.c version 1.18, the code initializing 
interpreter->arena_base->extra_buffer_headers was #if'ed out.
This caused pointer extra_buffer_headers.bufstart to be 
uninitialized on Win32, which does not zero memory during 
allocation. Test t/src/sprintf.t (#2) dereferences bufstart 
and segfaults during compact_pool().

This patch corrects the problem.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45705/35831/c12f8b/bufstart_init.patch


Index: headers.c
===
RCS file: /cvs/public/parrot/headers.c,v
retrieving revision 1.23
diff -u -r1.23 headers.c
--- headers.c   12 Dec 2002 08:07:08 -  1.23
+++ headers.c   17 Dec 2002 22:26:20 -
@@ -402,8 +402,15 @@
 #if 0
 Parrot_allocate(interpreter,
 &interpreter->arena_base->extra_buffer_headers, 0);
 add_extra_buffer_header(interpreter,
 &interpreter->arena_base->extra_buffer_headers);
+#else
+interpreter->arena_base->extra_buffer_headers.bufstart  = NULL;
+interpreter->arena_base->extra_buffer_headers.buflen= 0;
+interpreter->arena_base->extra_buffer_headers.obj.flags = 0;
+# if ! DISABLE_GC_DEBUG
+interpreter->arena_base->extra_buffer_headers.version   = 0;
+# endif
 #endif
 /* Init the constant string header pool */
 interpreter->arena_base->constant_string_header_pool =

[perl #19229] [PATCH] config/auto/jit.pl - missing cc_clean

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19229]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19229 >


The JIT config test is not cleaning up after itself, causing 
sporadic failures of the next config test (funcptr.pl) on Win32.

This patch corrects the problem.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45708/35838/f7b5b9/jit_cc_clean.patch


Index: config/auto/jit.pl
===
RCS file: /cvs/public/parrot/config/auto/jit.pl,v
retrieving revision 1.9
diff -u -r1.9 jit.pl
--- config/auto/jit.pl  12 Dec 2002 11:20:26 -  1.9
+++ config/auto/jit.pl  17 Dec 2002 22:26:20 -
@@ -93,6 +93,7 @@
  jit_i386 => 'fcomip'
);
   }
+  cc_clean();
 }
   }
   else {

[perl #19230] [PATCH] classes/*.h not cleaned up by `make clean`

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19230]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19230 >


The 'clean' target in the classes makefile is only removing 
'default.h'; it should remove all .h files.

This patch corrects the problem.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45710/35841/c823f4/classes_makefile_clean.patch


Index: config/gen/makefiles/classes.in
===
RCS file: /cvs/public/parrot/config/gen/makefiles/classes.in,v
retrieving revision 1.5
diff -u -r1.5 classes.in
--- config/gen/makefiles/classes.in 23 Oct 2002 03:47:17 -  1.5
+++ config/gen/makefiles/classes.in 17 Dec 2002 22:26:20 -
@@ -28,7 +28,7 @@
 ${pmc_build}
 
 clean:
-   $(RM_F) *.c *$(O) default.h
+   $(RM_F) *.c *$(O) *.h
 
 update:
cvs -q update -dP

[perl #19232] [PATCH] UINTVAL_SIZE is not defined

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19232]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19232 >


In parrot.h (revision 1.45 2002-08-07), macros were defined 
to eliminate warnings during pointer conversions. See:
http://rt.perl.org/rt2/Ticket/Display.html?id=16019

The definition of the macros is controlled by the first line of this block:
#if (INTVAL_SIZE == PTR_SIZE) && (UINTVAL_SIZE == PTR_SIZE)
#  define INTVAL2PTR(any,d)(any)(d)
#  define UINTVAL2PTR(any,d)(any)(d)
#else
#  if PTR_SIZE == LONG_SIZE
#define INTVAL2PTR(any,d)(any)(unsigned long)(d)
#define UINTVAL2PTR(any,d)(any)(unsigned long)(d)
#  else
#define INTVAL2PTR(any,d)(any)(unsigned int)(d)
#define UINTVAL2PTR(any,d)(any)(unsigned int)(d)
#  endif
#endif
#define PTR2INTVAL(p)INTVAL2PTR(INTVAL,p)
#define PTR2UINTVAL(p)UINTVAL2PTR(UINTVAL,p)
--snip--
#define D2FPTR(x) UINTVAL2PTR(funcptr_t, PTR2UINTVAL(x))
#define F2DPTR(x) UINTVAL2PTR(void *, PTR2UINTVAL((funcptr_t) x))

I cannot find a definition for UINTVAL_SIZE anywhere. Being 
undefined, it evaluates to 0, and so the #if always fails. 
This means that some systems have been getting the wrong 
macro definitions.

It would not be difficult to add Configure tests to define 
UINTVAL_SIZE, but I think that it is not really needed. 
Instead, the attached patch just changes the first line to:
#if PTR_SIZE == INTVAL_SIZE
( Is there any platform for which sizeof(signed foo) <> 
sizeof(unsigned foo)? Would the C spec even allow it? If so, 
I will be glad to write the Configure tests. )

I feel confident that this simpler change is the Right 
Thing, but it could uncover other bugs, and I have no 
esoteric platforms to test it on. Here is a summary of the 
patch's effect on different platforms:

1) PTR_SIZE <> INTVAL_SIZE
No change.

2) PTR_SIZE == INTVAL_SIZE == LONG_SIZE (x86 Linux and Win32)
Intermediate casts to (unsigned long) removed, i.e.
(any)(unsigned long)(d)
becomes
(any)(d)

3) PTR_SIZE == INTVAL_SIZE <> LONG_SIZE
Intermediate casts to (unsigned int) removed, i.e.
(any)(unsigned int)(d)
becomes
(any)(d)


Under MS VC++ for .Net, this patch changes the results of 
none of the tests; it only stops the "UINTVAL_SIZE is not 
defined as a preprocessor macro" warnings that are given 
with the -Wall option.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/45713/35845/cf2db0/UINTVAL_SIZE.patch


Index: include/parrot/parrot.h
===
RCS file: /cvs/public/parrot/include/parrot/parrot.h,v
retrieving revision 1.58
diff -u -r1.58 parrot.h
--- include/parrot/parrot.h 12 Dec 2002 20:13:35 -  1.58
+++ include/parrot/parrot.h 17 Dec 2002 22:26:21 -
@@ -112,7 +112,7 @@
 explicitly Configured in) which do limits checks?
 A. D. Aug. 6, 2002.
 */
-#if (INTVAL_SIZE == PTR_SIZE) && (UINTVAL_SIZE == PTR_SIZE)
+#if PTR_SIZE == INTVAL_SIZE
 #  define INTVAL2PTR(any,d)(any)(d)
 #  define UINTVAL2PTR(any,d)(any)(d)
 #else

[perl #19286] Jako/imcc dependency problems.

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19286]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19286 >


Starting with a fresh checkout today (19/Dec/2002), I get the
following error when I try

make languages

cd languages && make && cd ..
cd jako && make && cd ..
yacc  ../imcc/imcc.y
cc-o ../imcc/imcc y.tab.c 
"../imcc/imc.h", line 19: cannot find include file: "parrot/parrot.h"
"../imcc/instructions.h", line 18: undefined symbol: PARROT_MAX_ARGS
"../imcc/instructions.h", line 18: integral constant expression expected
"../imcc/parser.h", line 10: integral constant expression expected
"../imcc/imcc.y", line 34: integral constant expression expected
"../imcc/imcc.y", line 39: undefined symbol: va_list
"../imcc/imcc.y", line 39: syntax error before or at: ap
"../imcc/imcc.y", line 42: undefined symbol: ap
"../imcc/imcc.y", line 44: undefined symbol: i
"../imcc/imcc.y", line 44: syntax error before or at: SymReg
"../imcc/imcc.y", line 47: undefined symbol: i
"../imcc/imcc.y", line 50: cannot recover from previous errors
cc: acomp failed for y.tab.c
*** Error code 2
make: Fatal error: Command failed for target `../imcc/imcc'
Current working directory /home/doughera/src/parrot/parrot-current/languages/jako
*** Error code 1

Rerunning with the '-d' flag to make (for debugging) shows what's 
happening:

MAKEFLAGS value: 
cd languages && make && cd ..
MAKEFLAGS value: -d
cd jako && make && cd ..
MAKEFLAGS value: -d
Building examples/bench.pasm because it is out of date relative to 
examples/bench.imc
  Building ../imcc/imcc using suffix rule for .y because it is out of date 
relative to ../imcc/imcc.y
yacc  ../imcc/imcc.y
cc-o ../imcc/imcc y.tab.c 

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19291] languages/jako/examples/life: Unknown signature type

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #19291]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19291 >


Running
./parrot languages/jako/examples/life.pbc
gives (once you apply my exceptions.c patch in ticket 17091)

Parrot VM: PANIC: Unknown signature type!
C file nci.c, line 371
Parrot file life.pbc, line 0

We highly suggest you notify the Parrot team if you have not been working on 
Parrot.  Use bugs6.perl.org or send an e-mail to [EMAIL PROTECTED]  
Include the entire text of this error message and the text of the script that 
generated the error.  If you've made any modifications to Parrot, please 
describe them as well.

Version : 0.0.8-devel
Configured  : Thu Dec 19 12:50:48 2002
Architecture: nojit
JIT Capable : No
Interp Flags: 0x0
Exceptions  : (missing from core)

Dumping Core...
Sorry, coredump is not yet implemented for this platform.

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #19328] bug/feature (?) in perlarray of perlarrays

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19328]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19328 >


Hi there,

While trying to use a PerlArray of PerlArrays (guess why? :-) ), I ran 
into a strange behavior. Look at the following code:

new P0, .PerlArray
new P1, .PerlArray
push P1, 9
push P1, 8
push P1, 7
push P1, 6
push P1, 5
push P0, P1
new P1, .PerlArray
push P1, 4
push P1, 3
push P1, 2
push P1, 1
push P1, 0
push P0, P1
bsr DUMP
print "---\n"
set P0[1;3], 9
bsr DUMP
end
DUMP:   
set I0, 0
LOOP0:  
set I1, 0
LOOP1:  
set I2, P0[I0;I1]
print I2
print " "
inc I1
lt I1, 5, LOOP1
inc I0
print "\n"
lt I0, 2, LOOP0
ret

I get the following result:
9 8 7 6 5
4 3 2 1 0
---
9 8 7 6 5
4 3 2 1 0

although I'd rather have:
9 8 7 6 5
4 3 2 1 0
---
9 8 7 6 5
4 3 2 9 0


When I get the 2nd perlarray (corresponding to offset 1), then set the 
3rd integer in it, then set back the perlarray, I get the correct 
answer.

Is it a bug or a feature? For me, it looks like a bug, and I'd be happy 
to be able to set a slot in a PerlArray of PerlArrays via set P0[x;y].

Cheers,

Jerome
-- 
[EMAIL PROTECTED]

[perl #19331] [PATCH]befunge 0.1.0 released

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19331]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19331 >


Thanks to Leo who fixed the bug when setting a list of lists element, 
the befunge interpreter now uses a list of lists (perlarray of 
perlarrays to be more precise) instead of a list of strings.

I thought this big evolution needed a gap in my versioning scheme, so 
this is now befunge 0.1.0 (instead of 0.07 - yes, I also went for a 
traditional open-source versioning system)

Jerome
-- 
[EMAIL PROTECTED]


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46012/35999/0f0469/befunge_use_array_of_arrays.patch


? befunge.pbc
Index: Changes
===
RCS file: /cvs/public/parrot/languages/befunge/Changes,v
retrieving revision 1.4
diff -u -d -r1.4 Changes
--- Changes	1 Dec 2002 16:22:28 -	1.4
+++ Changes	21 Dec 2002 14:25:37 -
@@ -1,4 +1,11 @@
-Revision history for Befunge-93 interpreter written for Parrot.
+Revision history for a Befunge interpreter written for Parrot.
+
+0.1.0 Sat Dec 21 14:58:24 CET 2002
+- playfield now is an array of array (of integers) instead of
+  an array of strings.
+- load, io and debug updated to reflect this.
+- new versioning scheme, and minor version incrementing since
+  this is a big step for the project.
 
 0.06  Sun Dec  1 10:00:35 CET 2002
 - debugger can now interact with user.
Index: README
===
RCS file: /cvs/public/parrot/languages/befunge/README,v
retrieving revision 1.6
diff -u -d -r1.6 README
--- README	1 Dec 2002 16:22:28 -	1.6
+++ README	21 Dec 2002 14:25:37 -
@@ -1,11 +1,12 @@
 DESCRIPTION
 ---
-This is a Befunge interpreter written in Parrot assembler, version 0.06
+This is a Befunge interpreter written in Parrot assembler, version 0.1.0
 
 This interpreter should be Befunge-93 compliant. This means the
-playfield is limited to 80x25 and can hold *only bytes*. This means
-that you can't fetch/store numbers greater than 255 or less than 0 in
-the torus (even if I do not check for over/underflow - for now).
+playfield is limited to 80x25. This should also mean that the torus
+can hold *only bytes* (that is, you can't store/fetch numbers greater
+than 255 or less than 0), but actually I do not check for over /
+underflow - for now.
 
 You should compile and test the files with:
 
@@ -25,7 +26,7 @@
 befunge.pasmthe main loop
 debug.pasm  routines for the debugger
 flow.pasm   handles the flow-control instructions
-io.pasm handles the io related instructions
+io.pasm handles the i/o related instructions
 load.pasm   function to load the code from source file
 maths.pasm  handles all the maths instructions
 stack.pasm  handles the stack instructions
@@ -47,7 +48,6 @@
 * better rand() methods
 * more tests (with Perl and Test::Harness)
 * debugging options (work in progress)
-* use an array of arrays instead of an array of strings
 * implement Befunge 98
 
 
Index: befunge.pasm
===
RCS file: /cvs/public/parrot/languages/befunge/befunge.pasm,v
retrieving revision 1.3
diff -u -d -r1.3 befunge.pasm
--- befunge.pasm	30 Nov 2002 15:51:09 -	1.3
+++ befunge.pasm	21 Dec 2002 14:25:38 -
@@ -25,20 +25,19 @@
 set S10, P0[I0]
 save S10
 bsr LOAD
-restore P1  # the playfield
-new P2, .PerlArray  # the stack
-set I0, 0   # x coord of the PC
-set I1, 0   # y coord of the PC
-set I2, 1   # direction of the PC
-set I4, 0   # flag (1=string-mode,2=bridge,3=end)
-time N0 # random seed
+restore P1  # P1 = the playfield
+new P2, .PerlArray  # P2 = the stack
+set I0, 0   # I0 = x coord of the PC
+set I1, 0   # I1 = y coord of the PC
+set I2, 1   # I2 = direction of the PC
+set I4, 0   # I4 = flag (1=string-mode,2=bridge,3=end)
+time N0 # N0 = random seed
 mod N0, N0, .RANDMAX
-set S0, " " # current instruction
-set S1, P1[0]   # current line
-set S2, ""  # user input
+set S2, ""  # S2 = user input
 
 TICK:
-substr S0, S1, I0, 1
+set I20, P1[I1;I0]
+chr S0, I20 # S0 = current instruction
 eq I5, 0, TICK_NODEBUG
 bsr DEBUG_CHECK_BREAKPOINT
 TICK_NODEBUG:
@@ -100,7 +99,6 @@
 MOVE_NORTH:
 dec I1
 mod I1, I1, 25
-

[perl #19332] [PATCH] mark PMCs w/o next_for_GC

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #19332]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19332 >


I'll send this first to the list for review.

This patch changes mark_used(PMC *) so that the PMC field next_for_GC 
isn't used anymore (it could be removed now, making a PMC one ptr size 
smaller).

This would allow finally to use one common mark function:

void pobject_lives(PObj* obj)

which is the same as buffer_lives() now looks like (modulo the 
interpreter used for GC_DEBUG).

A short test (5E6 new P0, .PerlUndef) in a loop shows ~1% speed increase 
due to one less instruction in headers.c:get_free_pmc().

Comments welcome,
leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46018/36002/ea1b6f/mark.patch


--- parrot/dod.cThu Dec 12 09:07:25 2002
+++ parrot-leo/dod.cSat Dec 21 16:28:57 2002
@@ -23,6 +23,7 @@
 extern void flush_register_windows(void);
 static size_t find_common_mask(size_t val1, size_t val2);
 
+#ifdef MARK_USE_NEXT_FOR_GC
 PMC *
 mark_used(PMC *used_pmc, PMC *current_end_of_list)
 {
@@ -49,6 +50,24 @@
 return used_pmc;
 }
 
+#else
+
+static PMC ** mark_list, ** mark_ptr;
+
+PMC *
+mark_used(PMC *used_pmc, PMC *current_end_of_list)
+{
+if (PObj_is_live_or_free_TESTALL(used_pmc)) {
+return current_end_of_list;
+}
+PObj_live_SET(used_pmc);
+*mark_ptr++ = used_pmc;
+*mark_ptr = NULL;
+return *mark_ptr;
+}
+
+#endif
+
 #if DISABLE_GC_DEBUG
 void
 buffer_lives(struct Parrot_Interp *interpreter, Buffer *buffer)
@@ -120,6 +139,12 @@
 /* We have to start somewhere, and the global stash is a good place */
 last = current = interpreter->perl_stash->stash_hash;
 
+#ifndef MARK_USE_NEXT_FOR_GC
+mark_list = realloc(mark_list,
+(interpreter->arena_base->pmc_pool->total_objects + 1) *
+sizeof(PMC *));
+mark_ptr = mark_list;
+#endif
 /* mark it as used and get an updated end of list */
 last = mark_used(current, last);
 /* Parrot_base_classname_hash */
@@ -218,7 +243,11 @@
 /* Okay, we've marked the whole root set, and should have a good-sized
  * list 'o things to look at. Run through it */
 prev = NULL;
+#ifdef MARK_USE_NEXT_FOR_GC
 for (; current != prev; current = current->next_for_GC) {
+#else
+for (j = 0, current = mark_list[0]; current; current = mark_list[++j]) {
+#endif
 UINTVAL bits = PObj_get_FLAGS(current) & mask;
 
 /* mark properties */
--- parrot/headers.cSat Dec 21 11:08:06 2002
+++ parrot-leo/headers.cSat Dec 21 16:29:50 2002
@@ -60,8 +60,10 @@
 pool->free_list = *(void **)pmc;
 
 PObj_flags_SETTO(pmc, 0);
+#ifdef MARK_USE_NEXT_FOR_GC
 /* Make sure it doesn't seem to be on the GC list */
 pmc->next_for_GC = NULL;
+#endif
 
 return pmc;
 }

[perl #19334] [PATCH] PARROT_GC_DEBUG=1 failures

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #19334]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19334 >



Trying to run parrot with the PARROT_GC_DEBUG environment variable set to 1
causes parrot to fail during initialization.

The GC_DEBUG flag is set early based on the environment variable, but the
marker for the top of the C stack is not set so non-rooted PMCs created during
initialization are wrongly collected.

The patch sets the stack top pointer at the time the GC_DEBUG flag is set.

> set | grep PARRO
PARROT_GC_DEBUG=1
> ./parrot
Segmentation fault
> unset PARROT_GC_DEBUG
> ./parrot
Usage: parrot [switches] [--] programfile [arguments]
  -bActivate bounds checks
  -dActivate debugging
  -hDisplay this message
  -jActivate Just-In-Time compiler
  -pActivate profiling
  -PActivate predereferencing
  -gDeactivate computed goto
  -tActivate tracing
  -vDisplay version information
  -.Wait for a keypress (gives Windows users time to attach a debugger)
  --gc-debug
Enable garbage collection debugging mode. This may also be enabled
by setting the environment variable $PARROT_GC_DEBUG to 1.


-- 
Jason


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46028/36011/bb8555/gcdebug.patch


Index: interpreter.c
===
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.123
diff -u -r1.123 interpreter.c
--- interpreter.c   14 Dec 2002 23:44:49 -  1.123
+++ interpreter.c   21 Dec 2002 19:56:05 -
@@ -417,6 +417,7 @@
 if (env_var_set("PARROT_GC_DEBUG")) {
 #if ! DISABLE_GC_DEBUG
 Interp_flags_SET(interpreter, PARROT_GC_DEBUG_FLAG);
+   interpreter->lo_var_ptr = &interpreter;
 #else
 fprintf(stderr, "PARROT_GC_DEBUG is set but the binary was compiled "
 "with DISABLE_GC_DEBUG.\n");

[perl #19349] [PATCH] mark PMCs - take #2

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #19349]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19349 >


Here is another approach, to finally unify the marking routines:
- next_for_GC remains what it is
- instead of current_end_of_list and a return value, mark_used() uuses
   a file static mark_ptr. As we don't have recursive DOD runs, this
   ought to be safe.

leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46052/36042/805a5c/mark.patch


--- parrot/dod.cThu Dec 12 09:07:25 2002
+++ parrot-leo/dod.cSun Dec 22 14:42:42 2002
@@ -23,6 +23,38 @@
 extern void flush_register_windows(void);
 static size_t find_common_mask(size_t val1, size_t val2);
 
+#define MARK_USE_MARK_PTR
+
+#ifdef MARK_USE_MARK_PTR
+
+static PMC * mark_ptr;
+
+/* actually this could be:
+ *
+ * void pobject_lives(PObj* obj)
+ */
+
+PMC *
+mark_used(PMC *used_pmc, PMC *current_end_of_list)
+{
+UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
+| PObj_custom_mark_FLAG;
+
+UNUSED(current_end_of_list);
+
+if (PObj_is_live_or_free_TESTALL(used_pmc)) {
+return NULL;/* only for compatibility */
+}
+PObj_live_SET(used_pmc);
+if ((PObj_get_FLAGS(used_pmc) & mask) || used_pmc->metadata) {
+mark_ptr->next_for_GC = used_pmc;
+mark_ptr = used_pmc->next_for_GC = used_pmc;
+}
+return NULL;/* only for compatibility */
+}
+
+#else
+
 PMC *
 mark_used(PMC *used_pmc, PMC *current_end_of_list)
 {
@@ -49,6 +81,8 @@
 return used_pmc;
 }
 
+#endif
+
 #if DISABLE_GC_DEBUG
 void
 buffer_lives(struct Parrot_Interp *interpreter, Buffer *buffer)
@@ -120,6 +154,9 @@
 /* We have to start somewhere, and the global stash is a good place */
 last = current = interpreter->perl_stash->stash_hash;
 
+#ifdef MARK_USE_MARK_PTR
+mark_ptr = last;
+#endif
 /* mark it as used and get an updated end of list */
 last = mark_used(current, last);
 /* Parrot_base_classname_hash */

[perl #19356] [PATCH] creating string_destroy()

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19356]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19356 >


This patch creates a new function string_destroy(),
as described in docs/strings.pod,
and motivated by TODO item
grep docs/strings.pod for unimplemented functions and implement them

string_destroy() currently does nothing.  I did not find anything
currently worth doing under normal gc.  Though one can imagine things
it might do in future.

If one could deallocate the buffer provided by Parrot_allocate_string,
or even just shrink it, without COW problems, then string_destroy()
might actually be somewhat useful.

Like all related functions, it requires an "interpreter" argument, so
strings.pod was updated to reflect this.  I plan to further syncronize
the pod with string_funcs.h as a separate patch.

No tests were created.

Banging away at that TODO list item,
Mitchell Charity



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46063/36056/07fd71/create_string_destroy.patch


diff -ur ./docs/strings.pod ../parrot_string_destroy/docs/strings.pod
--- ./docs/strings.pod  Sat Dec 21 11:00:14 2002
+++ ../parrot_string_destroy/docs/strings.pod   Sun Dec 22 15:05:08 2002
@@ -52,7 +52,7 @@
 
 When a string is done with, it can be destroyed using the destroyer
 
-void string_destroy(STRING *s)
+void string_destroy(struct Parrot_Interp *, STRING *s)
 
 =head2 String Manipulation Functions
 
diff -ur ./include/parrot/string_funcs.h 
../parrot_string_destroy/include/parrot/string_funcs.h
--- ./include/parrot/string_funcs.h Sat Dec 21 11:00:14 2002
+++ ../parrot_string_destroy/include/parrot/string_funcs.h  Sun Dec 22 14:51:41 
+2002
@@ -48,6 +48,7 @@
 STRING *string_make(struct Parrot_Interp *, const void *buff,
 UINTVAL len, const ENCODING *, UINTVAL flags,
 const CHARTYPE *);
+void string_destroy(struct Parrot_Interp *, STRING *);
 STRING *string_copy(struct Parrot_Interp *, STRING *);
 STRING *string_set(struct Parrot_Interp *, STRING *d, STRING *s);
 STRING *string_transcode(struct Parrot_Interp *, STRING *src,
diff -ur ./string.c ../parrot_string_destroy/string.c
--- ./string.c  Sat Dec 21 11:00:14 2002
+++ ../parrot_string_destroy/string.c   Sun Dec 22 16:35:39 2002
@@ -267,6 +267,23 @@
 return s;
 }
 
+/*=for api string string_destroy
+ * "when a string is done with, it can be destroyed"
+ */
+void
+string_destroy(struct Parrot_Interp *interpreter, STRING *s)
+{
+/* Currently (2002 Dec), I don't see anything to do.  There
+   doesn't seem to be any way to deallocate the buffer provide by
+   Parrot_allocate_string.  And while, under GC_IS_MALLOC, we
+   might mem_sys_free the buffer of some strings, leaving headers
+   around with NULL bufstart and strstart seems problematic.  And
+   we might Parrot_reallocate_string to a smaller size (len=1),
+   but that might, perhaps, interact with COW'ed pointers to this
+   string(?).  Also, it didn't seem worth the complexity cost at
+   this time.  So we do nothing. */
+}
+
 /*=for api string string_grow
  * grow the string buffer by addlen bytes
  */

[perl #19357] [PATCH] sync strings.pod with code - Opportunity to write simple docs!

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19357]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19357 >


This patch modifies docs/strings.pod to match the code.

It is mainly some slight argument list changes, and a list of
undocument functions for future documentation work.

It also corrects a function name typo in a comment in string.c.

The undocument functions provide an opportunity for anyone wishing to
contribute some bite-sized documentation updates.  The functions are
in string.c.

Mitchell Charity



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46066/36060/63c5ba/sync_strings_pod.patch


diff -ur ./docs/strings.pod ../parrot_string_doc/docs/strings.pod
--- ./docs/strings.pod  Sat Dec 21 11:00:14 2002
+++ ../parrot_string_doc/docs/strings.pod   Sun Dec 22 17:44:59 2002
@@ -25,7 +25,7 @@
 The most basic way of creating a string is through the function
 C:
 
-STRING* string_make(void *buffer, INTVAL buflen, INTVAL encoding, INTVAL flags, 
INTVAL type)
+STRING* string_make(struct Parrot_Interp *, const void *buffer, INTVAL buflen, 
+INTVAL encoding, INTVAL flags, INTVAL type)
 
 In here you pass a pointer to a buffer of a given encoding, and the
 number of bytes in that buffer to examine, the encoding, (see below for
@@ -40,19 +40,19 @@
 
 I: Nothing stops you doing
 
-string_make(NULL, 0, ... 
+string_make(interpreter, NULL, 0, ... 
 
 =back
 
 If you already have a string, you can make a copy of it by calling
 
-STRING* string_copy(STRING* s)
+STRING* string_copy(struct Parrot_Interp *, STRING* s)
 
 This is itself implemented in terms of C.
 
 When a string is done with, it can be destroyed using the destroyer
 
-void string_destroy(STRING *s)
+void string_destroy(struct Parrot_Interp *, STRING *s)
 
 =head2 String Manipulation Functions
 
@@ -62,7 +62,7 @@
 
 To find out the length of a string, use
 
-INTVAL string_length(STRING *s)
+INTVAL string_length(const STRING *s)
 
 You I explicitly use C<< s->strlen >> for this since it is such a 
 useful operation.
@@ -70,7 +70,7 @@
 To concatenate two strings - that is, to add the contents of string
 C to the end of string C, use:
 
-STRING* string_concat(STRING* a, STRING *b, INTVAL flag)
+STRING* string_concat(struct Parrot_Interp *, STRING* a, STRING *b, INTVAL flag)
 
 C is updated, and is also returned as a convenience. If the flag is
 set to a non-zero value, then C will be transcoded to C's encoding
@@ -80,7 +80,7 @@
 
 To repeat a string, (ie, turn 'xyz' into 'xyzxyzxyz') use:
 
-STRING* string_repeat(struct Parrot_Interp *, STRING* s, INTVAL n, STRING** d)
+STRING* string_repeat(struct Parrot_Interp *, const STRING* s, UINTVAL n, 
+STRING** d)
 
 Which will repeat string I n times and store the result into I, which it
 also returns.  If I<*d> or I<**d> is NULL, a new string will be allocated
@@ -103,7 +103,7 @@
 
 To retrieve a single character of the string, call
 
-INTVAL string_ord(STRING* s, INTVAL n)
+INTVAL string_ord(const STRING* s, INTVAL n)
 
 The result will be returned from the function. It checks for the existence of
 C, and tests for C being out of range. Currently it applies the method
@@ -127,7 +127,7 @@
 
 To test a string for truth, use:
 
-BOOLVAL string_bool(struct Parrot_Interp *, STRING* s);
+BOOLVAL string_bool(STRING* s);
 
 A string is false if it
 
@@ -262,7 +262,7 @@
 string vtables to create encoding abstraction; here's an example of one:
 
 STRING*
-string_concat(STRING* a, STRING* b, INTVAL flags) {
+string_concat(struct Parrot_Interp *interpreter, STRING* a, STRING* b, INTVAL 
+flags) {
 return (ENC_VTABLE(a).concat)(a, b, flags);
 }
 
@@ -367,7 +367,7 @@
 
 To grow a string to a specified size, use 
 
-void string_grow(STRING *s, INTVAL newsize)
+void string_grow(struct Parrot_Interp *, STRING *s, INTVAL newsize)
 
 The size is given in characters; C is called to turn
 this into a size in bytes, and then the buffer is grown to accomodate
@@ -405,3 +405,23 @@
 Fill this in later; if anyone wants to implement new encodings at this
 stage they must be mad.
 
+=head1 Work In Progress
+
+The transcoding section is out of sync with the code.
+
+Should the following functions be mentioned?
+C,
+C,
+C,
+C,
+C,
+C,
+C,
+C,
+C,
+C,
+C,
+C.
+
+C is here said to return C.  But the code is
+returning C (2002Dec).  Which is the right thing?
diff -ur ./string.c ../parrot_string_doc/string.c
--- ./string.c  Sat Dec 21 11:00:14 2002
+++ ../parrot_string_doc/string.c   Sun Dec 22 17:14:59 2002
@@ -532,7 +532,7 @@
 if (a != NULL) {
 /* XXX
  * string_transcode may here be used as string_copy, which is
- * the only case, where string_transcodes STRING isn't
+ * the only case, where string_transcode

[perl #19358] [PATCH] Test fix for P6C.

[via RT]

# New Ticket Created by  Joseph F. Ryan 
# Please include the string:  [perl #19358]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19358 >


This patch should fix a bug in the test suite (specifically, at
parrot/languages/perl6/t/compiler/1.t) that was causing one test to
fail.  Seems to be nothing more than a typo.

Joseph F. Ryan
[EMAIL PROTECTED]


This message was sent using the Webmail System hosted by OARDC Computing Services  -- 
http://webmail.oardc.ohio-state.edu:8080


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46070/36063/8dca1a/1.t.diff




1.t.diff
Description: 1.t.diff

[perl #19359] [PATCH] Extending P6C strings.

[via RT]

# New Ticket Created by  Joseph F. Ryan 
# Please include the string:  [perl #19359]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19359 >


This patch will extend interpolating string support to include \c[^],
\c[NAME], \c[NAME;NAME], \u, \l, \e, \U[], \L[], and \E[].

Joseph F. Ryan
[EMAIL PROTECTED]


This message was sent using the Webmail System hosted by OARDC Computing Services  -- 
http://webmail.oardc.ohio-state.edu:8080


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46072/36066/cc1025/Parser.pm.diff

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46072/36067/53ca33/String.pm.diff

-- attachment  3 --
url: http://rt.perl.org/rt2/attach/46072/36068/ffad51/Tree.pm.diff




Parser.pm.diff
Description: Parser.pm.diff


String.pm.diff
Description: String.pm.diff


Tree.pm.diff
Description: Tree.pm.diff

[perl #19363] [PATCH] Radii Support for P6C.

[via RT]

# New Ticket Created by  Joseph F. Ryan 
# Please include the string:  [perl #19363]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19363 >


This patch adds full numeral support, including 0b0, 0c0, 0d0, 0x0,
specific radii notation, and dotted-radii notation.

This doesn't mean *everything* with numbers is done; for instance,
"formatted" (underscore separated) numbers still aren't implemented
for radii-bases yet.

Assumes application of ticket 19359.


This message was sent using the Webmail System hosted by OARDC Computing Services  -- 
http://webmail.oardc.ohio-state.edu:8080


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46079/36076/2ec77d/Parser.pm.diff

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46079/36077/a708dc/Tree.pm.diff




Parser.pm.diff
Description: Parser.pm.diff


Tree.pm.diff
Description: Tree.pm.diff

[perl #19367] [PATCH] Bug Fixes for P6C.

[via RT]

# New Ticket Created by  Joseph F. Ryan 
# Please include the string:  [perl #19367]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19367 >


This patch adds further extends interpolating strings to add support
for \0, \0[], \0[;], and \x[;].

Also, Bug fixes:

- \e worked incorrectly (and thus broke a test); fixed
- Literal backslashes ('\\') broke the parse; fixed
- \c[;] didn't work right; fixed
- If \c[] or \c[;] might returned a literal backslash (such as
  \c[REVERSE SOLIDUS]), the op-tree would become malformed; fixed.
- \c[^J] corrupted the op-tree; fixed

Assumes application of tickets  and .


Joseph F. Ryan
[EMAIL PROTECTED]


This message was sent using the Webmail System hosted by OARDC Computing Services  -- 
http://webmail.oardc.ohio-state.edu:8080


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46086/36085/0959f4/Parser.pm.diff

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46086/36086/c8f225/String.pm.diff




Parser.pm.diff
Description: Parser.pm.diff


String.pm.diff
Description: String.pm.diff

[perl #19369] [PATCH] P6C compiler tests for tickets 19359, 19363, 19367.

[via RT]

# New Ticket Created by  Joseph F. Ryan 
# Please include the string:  [perl #19369]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19369 >


This patch adds tests that cover the changes made by tickets 19359, 
19363, and 19367.

The new file, c.t, should be added to:
parrot/languages/perl6/t/compiler/


Joseph F. Ryan
[EMAIL PROTECTED]


This message was sent using the Webmail System hosted by OARDC Computing Services  -- 
http://webmail.oardc.ohio-state.edu:8080


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46089/36090/9fb612/c.t

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46089/36091/0dbc0f/b.t.diff




c.t
Description: c.t


b.t.diff
Description: b.t.diff

[perl #19406] [PATCH] creates a script which describes source files

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19406]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19406 >


This patch creates a script
  tools/dev/extract_file_descriptions.pl

It produces a browsable list of file names with brief descriptions, and
is intended to help familiarize new developers with the layout of parrot.

The descriptions are extracted from leading comments and embedded pods.

I found the output to be surprisingly easy and interesting to read.
Your mileage may vary.

When run
  $ pwd
  parrot/
  $ perl tools/dev/extract_file_descriptions.pl
it prints out entries like

   * ./ChangeLog

 2002-12-18 20:38  sfink: changes since 0.0.8

   - Allow suppression of cgoto core to save memory during compile
   * Native function calling interface
   * Major rewrite of stack and list aggregates
   - Scalar PMC added
   * Scratchpads implemented
   - Win32 libraries
   - Internal memory subsystem documentation
   * Preliminary DotGNU support
   - Packfile fingerprinting
   * Buffer/PMC unification (into PObjs)
   * stabs debugging information support
   * Major Jako overhaul, including:
 - imcc integration
  [...]


   * ./build_nativecall.pl

 Build up the native call routines.


   * ./byteorder.c

 Byteordering functions
These are assigned to a vtable in PackFile at each load.
If the vtable method is called for conversion from the
native byteorder, it is a noop and will work, but the
caller should know if the PackFile byteorder is native
and skip the conversion and just map it in.

   ( ./warnings.c )

The last being an file without an obvious descriptive comment or pod.

The default output is currently something like 6k lines, and 100KB.
This was a quick hack, written yesterday evening.
But it looks vaguely plausible.

Mitchell Charity



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46190/36166/854f4b/extract_file_descriptions.patch


diff -urN ./MANIFEST ../parrot-describe/MANIFEST
--- ./MANIFEST  Sun Dec 15 09:20:09 2002
+++ ../parrot-describe/MANIFEST Tue Dec 24 11:05:13 2002
@@ -1741,6 +1741,7 @@
 t/src/sprintf.t
 test_main.c
 tools/dev/check_source_standards.pl
+tools/dev/extract_file_descriptions.pl
 tools/dev/genrpt.pl
 tools/dev/lib_deps.pl
 tools/dev/manicheck.pl
diff -urN ./tools/dev/extract_file_descriptions.pl 
../parrot-describe/tools/dev/extract_file_descriptions.pl
--- ./tools/dev/extract_file_descriptions.plWed Dec 31 19:00:00 1969
+++ ../parrot-describe/tools/dev/extract_file_descriptions.pl   Tue Dec 24 10:57:34 
+2002
@@ -0,0 +1,206 @@
+#!/usr/bin/perl -w
+
+# This script extracts descriptions from the Parrot source files.
+
+#  Doables:
+#   - Given a directory argument, should recursively descend.
+#   - Should create descriptive hashes earlier, before files are filtered.
+# So one can skip, say a binary file, but still have it listed in the output.
+# For instance, it is nice to see where the .pbc's land.
+#   - Allow indescribable heads to be mixed in with rest, for when exploring
+# a location is more important than big-picture browsing.
+#   - Is absense of "[...]"s in the indescribable listing a ui consistency violation?
+#   - Fragment describe_file() - it shouldn't both `cat` and dispatch on file suffix.
+#   - Finish making this usable as a library.
+#   - It would be nice to have a ParrotSourceFile class of course. ;) (a jest - sort 
+of.)
+#   - Misc: rationalize indent; clarify desc emptiness contract;
+# review readability of intra-comment blank line elimination; pod handling;
+# 
+
+use Regexp::Common qw/comment/;
+use Getopt::Long;
+use strict;
+
+if(1) {
+my $show_full = 0;
+GetOptions('plus-misses' => \$show_full)
+   || die ("Usage: $0 [--plus-misses] [files...]\n\n".
+   "FILES defaults to a recursive \" find . \".\n\n".
+   "--plus-misses creates a second section, with the heads of any\n".
+   "files which had familiar types, but from which descriptions\n".
+   "were not obtained.\n\n");
+
+my @files = @ARGV ? @ARGV : &files_worth_describing;
+
+print "This file was generated by $0\non ".scalar(localtime).".\n\n";
+print "Files in ( parenthesis ) did not have extractable descriptions.\n";
+if($show_full) {
+   print "Their heads are included in a second section below, "
+   ."marked with \"#=#=#=\".\n";
+} else {
+   print "Run this script with --plus-misses, and a second section will be "
+   ."included,\nwith the heads of these indescribable files.\n";
+}
+print "\n";
+my @no_descriptions;
+foreach (@files) {
+   my $info = &describe_file($_);
+   if($info->{desc}) {
+   

[perl #19418] [PATCH] IA-64 stack and register collection for GC

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #19418]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19418 >



This patch gets garbage collection working on IA-64 linux. With a few more
changes it should work on HP-sUX as well.  The patch reorganizes the
trace_system_stack function that is now trace_mem_block, which examines an
arbitrary block of memory for possible buffer/PMC pointers.

The IA-64 is a big special case. In addition to having registers that must be
flushed to RAM, the registers are not flushed to the stack, but a separate
backing store area which is separate from the stack. To capture the remaining
registers, I've used the getcontext() call, as setjmp is not necessarily
sufficient.

Right now I've hard-coded the base address of the default backing store in
linux.  To make the current code work on all IA-64 platforms a base value of
the backing store for each interpreter thread will have to be noted as is done
for the stack pointer.

The code to flush the register store and return the current top of the register
store should go into asm/ia64.s .

I started trying to do this like I did for SPARC with pre-assembled code, but
I ran into two complications :

1) Thanks to the IA-64 ABI, function pointers are not simple pointers, but
instead point to function descriptors, which are somewhat awkward to construct
by hand because of compiler magic. I was able to sort this out and then ran
into 2.

2) Pages in the heap do not have execute permission by default on IA-64 linux,
so we'd have to put the code on the stack or use mprotect or mmap to create
pages with execute permissions in order to execute the pre-assembled code.

If anyone decides to implement Jit support for IA-64 they will have to deal
these issues.

-- 
Jason


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46220/36192/934c5b/ia64.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46220/36193/8e42dc/ia64.s


? asm
Index: cpu_dep.c
===
RCS file: /cvs/public/parrot/cpu_dep.c,v
retrieving revision 1.3
diff -u -r1.3 cpu_dep.c
--- cpu_dep.c   11 Dec 2002 14:07:30 -  1.3
+++ cpu_dep.c   24 Dec 2002 19:53:52 -
@@ -12,12 +12,20 @@
 
 #include "parrot/parrot.h"
 
-void flush_register_windows(void);
+#ifdef __ia64__
 
-void
-flush_register_windows(void)
-{
-#ifdef __sparc
+#include 
+extern void *flush_reg_store(void);
+#define BACKING_STORE_BASE 0x8fff8000
+
+#endif
+
+PMC * trace_system_stack(struct Parrot_Interp *interpreter, PMC *last);
+
+PMC *
+trace_system_areas(struct Parrot_Interp *interpreter, PMC *last){
+
+#ifdef __sparc /* Flush register windows */
 static union {
int insns[4];
 double align_hack[2];
@@ -33,10 +41,42 @@
 
 static void (*fn_ptr)(void) = (void (*)(void))&u.align_hack[0];
 fn_ptr();
+#endif
+
+
+#ifdef __ia64__
+
+struct ucontext ucp;
+void *current_regstore_top;
 
+getcontext(&ucp);
+current_regstore_top = flush_reg_store();
+
+last = trace_mem_block(interpreter, last, 0x8fff8000,
+   (size_t)current_regstore_top);
 #else
 
-return;
+#ifdef HAS_HEADER_SETJMP
+Parrot_jump_buff env;
+
+/* this should put registers in env, which then get marked in
+ * trace_system_stack below
+ */
+setjmp(env);
+#endif
 
 #endif
+
+
+return trace_system_stack(interpreter, last);
+}
+
+PMC *
+trace_system_stack(struct Parrot_Interp *interpreter, PMC *last){
+size_t lo_var_ptr = (size_t)interpreter->lo_var_ptr;
+
+last = trace_mem_block(interpreter, last, (size_t)lo_var_ptr,
+  (size_t)&lo_var_ptr);
+
+return last;
 }
Index: dod.c
===
RCS file: /cvs/public/parrot/dod.c,v
retrieving revision 1.38
diff -u -r1.38 dod.c
--- dod.c   12 Dec 2002 08:07:08 -  1.38
+++ dod.c   24 Dec 2002 19:53:53 -
@@ -20,7 +20,6 @@
 int CONSERVATIVE_POINTER_CHASING = 0;
 #endif
 
-extern void flush_register_windows(void);
 static size_t find_common_mask(size_t val1, size_t val2);
 
 PMC *
@@ -108,14 +107,6 @@
 struct Stash *stash;
 UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
 | PObj_custom_mark_FLAG;
-#ifdef HAS_HEADER_SETJMP
-Parrot_jump_buff env;
-
-/* this should put registers in env, which then get marked in
- * trace_system_stack below
- */
-setjmp(env);
-#endif
 
 /* We have to start somewhere, and the global stash is a good place */
 last = current = interpreter->perl_stash->stash_hash;
@@ -129,7 +120,7 @@
 #if ! DISABLE_GC_DEBUG
 CONSERVATIVE_POINTER_CHASING = 1;
 #endif
-last = trace_system_stack(interpreter, last);
+last = trace_system_areas(inter

[perl #19462] [PATCH] Supress alignment warnings in jit.h and debug.h

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19462]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19462 >


Summary:
Whenever jit.h or debug.h are '#include'ed, gcc 3.x emits 
warnings about structure padding. These patches fix the problem.

Detail:
When compiling with gcc 3.x, Configure turns on flag -Wpadded:
  -Wpadded
Warn if padding is included in a structure, either to align 
an element of the structure or to align the whole structure. 
Sometimes when this happens it is possible to rearrange the 
fields of the structure to reduce the padding and so make 
the structure smaller.

This is causing 95 warnings to be emitted in 427 lines of output:
 58include/parrot/debug.h:53: warning: padding struct to align `value'
 22 ../include/parrot/debug.h:53: warning: padding struct to align `value'
  5include/parrot/jit.h:35:   warning: padding struct to align `param'
  5include/parrot/jit.h:123:  warning: padding struct to align `block'
  5include/parrot/jit.h:149:  warning: padding struct size to alignment boundary
 58 In file included from include/parrot/interpreter.h:53,
 58  from include/parrot/parrot.h:198,
 58  from include/parrot/global_setup.h:18,
 22 In file included from ../include/parrot/interpreter.h:53,
 22  from ../include/parrot/parrot.h:198,
 22  from ../include/parrot/global_setup.h:18,
  1 In file included from nci.c:30:
  1 In file included from jit_debug.c:14:
  1 In file included from jit_cpu.c:12:
  1 In file included from jit.c:8:
  1 In file included from interpreter.c:19:
...
  1  from boolean.c:22:
  1  from array.c:27:  


In the past, these warnings have been resolved by 
rearranging the fields of the structure; that will not work 
in these cases. I have added dummy fields where the compiler 
was placing the padding, and marked each field with a 
comment.

Note: I am not convinced that this is the right way to 
handle these warnings on *every* platform. We may need a 
different approach to best handle the Crays and toasters. 
Due to the high number of errors on our major development
platform (Linux), please apply for (at least) the short term.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46288/36271/369a6d/warn_align_debug.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46288/36272/58ece2/warn_align_jit.patch


Index: include/parrot/debug.h
===
RCS file: /cvs/public/parrot/include/parrot/debug.h,v
retrieving revision 1.18
diff -u -r1.18 debug.h
--- include/parrot/debug.h  13 Oct 2002 09:39:45 -  1.18
+++ include/parrot/debug.h  26 Dec 2002 21:48:25 -
@@ -50,6 +50,7 @@
 typedef struct PDB_condition {
 unsigned short  type;
 unsigned char   reg;
+unsigned char   dummy; /* For alignment */
 void*value;
 PDB_condition_ptr   next;
 } PDB_condition_t;

Index: include/parrot/jit.h
===
RCS file: /cvs/public/parrot/include/parrot/jit.h,v
retrieving revision 1.30
diff -u -r1.30 jit.h
--- include/parrot/jit.h14 Dec 2002 09:04:21 -  1.30
+++ include/parrot/jit.h26 Dec 2002 21:54:02 -
@@ -29,6 +29,7 @@
 int type;
 ptrdiff_t   native_offset;
 charskip;
+chardummy[3]; /* For alignment */
 union {
 opcode_topcode;
 void(*fptr)(void);
@@ -120,6 +121,7 @@
 unsigned int op_count;
 ptrdiff_tload_size;
 char isjit;
+char dummy[3]; /* For alignment */
 int  block;
 Parrot_jit_optimizer_section_ptr branch_target;
 Parrot_jit_optimizer_section_ptr prev;
@@ -146,6 +148,7 @@
 char*map_branch;
 opcode_t   **branch_list;
 unsigned charhas_unpredictable_jump;
+unsigned chardummy[3]; /* For alignment */
 } Parrot_jit_optimizer_t;
 
 /*  Parrot_jit_constant_pool_t

[perl #19463] [PATCH] Sanity check for alignptrs/test_c.in

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19463]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19463 >


This patch gives Configure's pointer alignment test a better 
error message for missing input.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46291/36278/4d67b2/alignptrs_argc.patch


Index: config/auto/alignptrs/test_c.in
===
RCS file: /cvs/public/parrot/config/auto/alignptrs/test_c.in,v
retrieving revision 1.6
diff -u -r1.6 test_c.in
--- config/auto/alignptrs/test_c.in 13 Sep 2002 10:54:53 -  1.6
+++ config/auto/alignptrs/test_c.in 26 Dec 2002 23:51:03 -
@@ -22,6 +22,12 @@
 void **ptr;
 
 int align = 0;
+
+if(argc != 2) {
+printf("FAILED - single command-line parameter required!\n");
+   return 1;
+}
+
 #ifdef SIGBUS
 signal(SIGBUS, bletch);
 #endif

[perl #19465] [PATCH] method_util.h lacks Vim local variables

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19465]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19465 >


The file 'method_util.h' is missing the standard comment 
block that sets the behavior for the Vim editor. This patch 
adds the comment.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46294/36282/603db4/method_util_vi_fix.patch


Index: include/parrot/method_util.h
===
RCS file: /cvs/public/parrot/include/parrot/method_util.h,v
retrieving revision 1.4
diff -u -r1.4 method_util.h
--- include/parrot/method_util.h21 Nov 2002 01:47:47 -  1.4
+++ include/parrot/method_util.h27 Dec 2002 00:07:38 -
@@ -44,3 +44,13 @@
  Stack_Chunk_t * cur_stack, PMC * end_of_used_list);
 
 #endif /* PARROT_METHOD_UTIL_H_GUARD */
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */

[perl #19467] [PATCH] win32.h - MinGW #pragma warnings

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19467]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19467 >


The gcc compiler in MinGW (win32) emits warnings for invalid pragmas in win32.h 
(platform.h).
This patch uses '#ifndef __GNUC__' to hide the pragmas from gcc.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46297/36286/58aacf/win32_h_MinGW.patch


Index: config/gen/platform/win32.h
===
RCS file: /cvs/public/parrot/config/gen/platform/win32.h,v
retrieving revision 1.6
diff -u -r1.6 win32.h
--- config/gen/platform/win32.h 23 Jul 2002 07:25:36 -  1.6
+++ config/gen/platform/win32.h 27 Dec 2002 00:43:51 -
@@ -13,6 +13,7 @@
 #  define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
 #endif
 
+#ifndef __GNUC__
 /* These disable certain Level 4 Warnings */
 #pragma warning( disable: 4100 ) /* disables 'unreferenced formal parameter'
   * warnings */
@@ -21,6 +22,8 @@
   * include files */
 #pragma warning( disable: 4505 ) /* disables 'unreferenced local function has
   * been removed' warnings in header files */
+#endif
+
 /*
 ** Miscellaneous:
 */

[perl #19470] [PATCH] --cc=FOO fails for Win32

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19470]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19470 >


In hints/mswin32.pl, there is code in place to customize the 
build environment based on the value of $cc. However, $cc is 
only populated by the 'cc' from the local 'perl -V'; the 
command-line flag '-cc=FOO' is not used here. This patch 
corrects that problem, as well as missing 'link', 'ar', and 'slash' 
values for MinGW.

Tested under MinGW 2.0.0-3 (current) using these commands:
perl Configure.pl --debugging --cc=gcc
mingw32-make
mingw32-make test
Many warnings remain, but only one test fails (sprintf).
With this patch, Parrot now supports MinGW out-of-the-box!

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46301/36291/613a29/mswin32_pl_MinGW.patch


Index: config/init/hints.pl
===
RCS file: /cvs/public/parrot/config/init/hints.pl,v
retrieving revision 1.3
diff -u -r1.3 hints.pl
--- config/init/hints.pl9 Dec 2002 04:02:09 -   1.3
+++ config/init/hints.pl27 Dec 2002 01:39:50 -
@@ -6,7 +6,7 @@
 
 $description="Loading platform and local hints files...";
 
-@args=();
+@args = qw( cc );
 
 sub runstep {
   my $hints = "config/init/hints/" . lc($^O) . ".pl";
Index: config/init/hints/mswin32.pl
===
RCS file: /cvs/public/parrot/config/init/hints/mswin32.pl,v
retrieving revision 1.6
diff -u -r1.6 mswin32.pl
--- config/init/hints/mswin32.pl11 Oct 2002 01:46:52 -  1.6
+++ config/init/hints/mswin32.pl27 Dec 2002 01:39:50 -
@@ -1,9 +1,18 @@
 {
+   my %args;
+   @args{@args}=@_;
+
my($cc, $ccflags, $libs)=Configure::Data->get(qw(cc ccflags libs));
+
+   # Later in the Parrot::Configure::RunSteps->runsteps process,
+   # inter/progs.pl will merge the command-line overrides with the defaults.
+   # We do one bit of its work early here, because we need the result now.
+   $cc = $args{cc} if defined $args{cc};
+
my $is_msvc  = grep { $cc eq $_ } ( qw(cl cl.exe) );
my $is_mingw = grep { $cc eq $_ } ( qw(gcc gcc.exe) );
my $is_bcc   = grep { $cc eq $_ } ( qw(bcc32 bcc32.exe) );
-   
+
Configure::Data->set(
rm_f  => '$(PERL) -MExtUtils::Command -e rm_f',
rm_rf => '$(PERL) -MExtUtils::Command -e rm_rf',
@@ -66,8 +75,10 @@
elsif( $is_mingw ) {
$libs='' if $libs =~ /\.lib\s/i;
Configure::Data->set(
-   ld => 'gcc',
-   libs => $libs
+   link  => 'gcc',
+   libs  => $libs,
+   slash => '\\',
+   ar=> 'ar',
);
}
 }

[perl #19493] [PATCH] Documentation updates in vtables.pod

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19493]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19493 >


Hi,

during the holidays I have been looking in the possibility of targeting the
Quantum Computing Language, http://tph.tuwien.ac.at/~oemer/qcl.html, for
Parrot.
I thing the first step to that is adding complex numbers as a PMC to Parrot.
Working on that I found a couple of minor quirks in vtables.pod.

i. The example with incrementing '1a' in Perl5 is broken. Incrementing '1a'
gives '2'. Incrementing 'a9' gives 'b0'.

ii. The flags in the PMC structure seem to have the prefix 'PObj_' not
'PMC_'.

A patch fixing i. and ii. is attached.

Happy New Year, 
  Bernhard Schmalhofer

-- 
+++ GMX - Mail, Messaging & more  http://www.gmx.net +++
NEU: Mit GMX ins Internet. Rund um die Uhr für 1 ct/ Min. surfen!

-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46333/36324/b50384/vtables.pod.patch




vtables.pod.patch
Description: vtables.pod.patch

[perl #19500] [PATCH] fix to disallow negative zero

[via RT]

# New Ticket Created by  Michael Joyce 
# Please include the string:  [perl #19500]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19500 >


Hello.

The core parrot op neg() allows zero to become negative. That shouldn't 
happen. I've attached a patch to this email that corrects the problem by 
testing if neg() was passed a value of zero. I've also attached a patch that 
adds a new test to make sure that zero cannot become negative.

See also http://mathworld.wolfram.com/CountingNumber.html (zero is neither 
positive nor negative)

Michael.

PS. I hope I've done this right. Please let me know if I didn't.

-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46352/36351/45ddee/core.ops.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/46352/36352/1d39c1/number.t.patch


Index: core.ops
===
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.240
diff -u -r1.240 core.ops
--- core.ops	27 Dec 2002 09:33:11 -	1.240
+++ core.ops	27 Dec 2002 21:25:37 -
@@ -1703,21 +1703,29 @@
 =cut
 
 inline op neg(inout INT) {
+  if($1 == 0.0)
+goto NEXT();
   $1 = -($1);
   goto NEXT();
 }
 
 inline op neg(inout NUM) {
+  if($1 == 0.0)
+goto NEXT();
   $1 = -($1);
   goto NEXT();
 }
 
 inline op neg(out INT, in INT) {
+  if($2 == 0.0)
+goto NEXT();
   $1 = -($2);
   goto NEXT();
 }
 
 inline op neg(out NUM, in NUM) {
+  if($2 == 0.0)
+goto NEXT();
   $1 = -($2);
   goto NEXT();
 }

Index: t/op/number.t
===
RCS file: /cvs/public/parrot/t/op/number.t,v
retrieving revision 1.27
diff -u -r1.27 number.t
--- t/op/number.t	14 Dec 2002 01:17:04 -	1.27
+++ t/op/number.t	27 Dec 2002 21:26:41 -
@@ -1,6 +1,6 @@
 #! perl -w
 
-use Parrot::Test tests => 36;
+use Parrot::Test tests => 37;
 use Test::More;
 
 output_is(<

[perl #19511] [PATCH] Pointers in List_chunk not initialized

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #19511]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19511 >


On Win32, these tests are segfaulting due to invalid 
pointers in List_chunk structs:
t/op/string.t  97-98
t/pmc/intlist.t3-4
t/pmc/pmc.t80

The problem is caused by list.c/allocate_chunk not 
initializing the pointers. This patch corrects the problem.

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46396/36388/e02d85/list_chunk_initialize.patch


Index: list.c
===
RCS file: /cvs/public/parrot/list.c,v
retrieving revision 1.23
diff -u -r1.23 list.c
--- list.c  27 Dec 2002 09:33:11 -  1.23
+++ list.c  28 Dec 2002 03:37:35 -
@@ -187,6 +187,10 @@
 Parrot_block_GC(interpreter);
 chunk = (List_chunk *)new_bufferlike_header(interpreter, sizeof(*chunk));
 chunk->items = items;
+chunk->n_chunks = 0;
+chunk->n_items  = 0;
+chunk->next = NULL;
+chunk->prev = NULL;
 Parrot_allocate_zeroed(interpreter, (Buffer *)chunk, size);
 Parrot_unblock_DOD(interpreter);
 Parrot_unblock_GC(interpreter);

[perl #19516] imcc whitespace sensitive parsing error

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19516]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19516 >


Whitespace sensitive imcc issue...

$ cat find_close.imc
.sub MAIN
   $S0 = "\\"
   print $S0
  end
.end
$ make find_close
../../imcc/imcc -o find_close.pasm find_close.imc
last token = ["\\"
]
(error) line 2: parse error
Didn't create output asm.
make: *** [find_close.pasm] Error 69


but..

$ cat find_close.imc
.sub MAIN
   $S0 = "\\"

   print $S0
  end
.end
$ make find_close
perl -I../../../lib ../../../assemble.pl find_close.pasm > find_close.pbc
../../../parrot find_close.pbc
\


-- 
Will "Coke" Coleda

[perl #19517] RT issue

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #19517]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19517 >


(I don't see an RT queue, so I'm sending this to the parrot queue)

I have a dev.perl.org account. my email is currently set to "will at 
coleda.com".

http://bugs6.perl.org/rt2/Ticket/Create.html?Queue=1

tells me:

 > Create a new ticket
 > We do not allow tickets to be created via the web interface.
 > To create an email for the parrot queue, please send an email to:

 > bugs-parrot at rt.perl.org

 > For proper tracking, you should send the email from wcoleda at 
infomg.com.

Which -used- to be my email address, but is no longer.

??
-- 
Will "Coke" Coleda

[perl #19599] [pasm bug] PerlHash: cannot delete a key

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19599]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19599 >


Hi,

How one can delete a key from a perl hash in parrot assembly?
I tried:
new P0, .PerlHash
set P0["a"], 1
exists I0, P0["a"]
print I0
print "\n"
delete P0["a"]
exists I0, P0["a"]
print I0
print "\n"
end

and got:
Couldn't find operator 'delete_p_kc' on line 6.

although pdd02 talks about "void delete_keyed(...)", and this function 
exists in $PARROT/classes/perlhash.pmc

The $PARROT/t/pmc/perlhash.t doesn't test either this operation.

It must be a bug, since it seems important to me (and guess what, I need 
it for my befunge interpreter :o) ).

Jerome
-- 
[EMAIL PROTECTED]

[perl #19603] [PATCH] Befunge debugger now supports breakpoints

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19603]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19603 >


Upon general (ahem) request, the befunge interpreter now supports 
breakpoints inside the debugger.
One can now:
 - break upon a given instruction (a character)
 - break at a specified location (x,y)
 - break when reaching a given row
 - break when reaching a given column

Jerome
-- 
[EMAIL PROTECTED]


-- attachment  1 --
url: 
http://rt.perl.org/rt2/attach/46581/36580/15fced/befunge_debugger_has_breakpoints.patch


? befunge.pbc
Index: Changes
===
RCS file: /cvs/public/parrot/languages/befunge/Changes,v
retrieving revision 1.5
diff -u -d -r1.5 Changes
--- Changes	21 Dec 2002 16:56:09 -	1.5
+++ Changes	30 Dec 2002 17:23:25 -
@@ -1,5 +1,10 @@
 Revision history for a Befunge interpreter written for Parrot.
 
+0.1.1 Mon Dec 30 18:12:34 CET 2002
+- debugger now accepts breakpoints: either on instructions
+  (characters), or on a specified location (x,y), or on a
+  given row, or on a given column.
+
 0.1.0 Sat Dec 21 14:58:24 CET 2002
 - playfield now is an array of array (of integers) instead of
   an array of strings.
Index: README
===
RCS file: /cvs/public/parrot/languages/befunge/README,v
retrieving revision 1.7
diff -u -d -r1.7 README
--- README	21 Dec 2002 16:56:09 -	1.7
+++ README	30 Dec 2002 17:23:25 -
@@ -1,6 +1,6 @@
 DESCRIPTION
 ---
-This is a Befunge interpreter written in Parrot assembler, version 0.1.0
+This is a Befunge interpreter written in Parrot assembler, version 0.1.1
 
 This interpreter should be Befunge-93 compliant. This means the
 playfield is limited to 80x25. This should also mean that the torus
@@ -17,7 +17,8 @@
  $ ../../parrot befunge.pbc [-d] foo.bef
 
 The -d flag enables debugging within the befunge interpreter (not yet
-fully implemented, this is a work in progress).
+fully implemented, this is a work in progress). Type 'help' in the
+debugger to see the commands supported.
 
 
 FILES
Index: debug.pasm
===
RCS file: /cvs/public/parrot/languages/befunge/debug.pasm,v
retrieving revision 1.3
diff -u -d -r1.3 debug.pasm
--- debug.pasm	21 Dec 2002 16:56:09 -	1.3
+++ debug.pasm	30 Dec 2002 17:23:25 -
@@ -1,24 +1,17 @@
 # Initialize the debug structure.
-# P3 = [ 1, "000 ... 000", [x1, x2, ...], [y1, y2, ...], [x1,y1, x2,y2, ...] ]
+# P3 = [ 1, { "<" => 1, "10,10" => 1, "r:6" => 1, "c:3" => 1, ... } ]
 # P3[0] = stop at each step
-# P3[1] = a 128 chars length string, 0 or 1 depending wether the
-# interpreter should stop at the corresponding character.
-# P3[2] = a PerlArray of column index that should stop the interpreter.
-# P3[3] = a PerlArray of row index that should stop the interpreter.
-# P3[4] = a PerlArray of 2d coord that should stop the interpreter.
+# P3[1] = a PerlHash which keys are either the char to break upon
+# when reaching it, or a location "y,x", or a column "c:nn"
+# or a row "r:nn"
 DEBUG_INITIALIZE:
 pushi
 pushs
 new P3, .PerlArray
 set P3[0], 1  # Stop at first step.
 repeat S10, "0", 128  # No char to break on.
-set P3[1], S10
-new P4, .PerlArray# No col to break on.
-set P3[2], P4
-new P4, .PerlArray# No row to break on.
-set P3[3], P4
-new P4, .PerlArray# No coord to break on.
-set P3[4], P4
+new P4, .PerlHash
+set P3[1], P4 # The breakpoints.
 pops
 popi
 ret
@@ -29,12 +22,45 @@
 DEBUG_CHECK_BREAKPOINT:
 pushi
 pushs
+pushp
 set I10, P3[0]
 eq 0, I10, DEBUG_CHECK_BREAKPOINT_CHAR
 bsr DEBUG_INTERACT
 branch DEBUG_CHECK_BREAKPOINT_END
 DEBUG_CHECK_BREAKPOINT_CHAR:
-DEBUG_CHECK_BREAKPOINT_END: 
+set P4, P3[1]
+exists I10, P4[S0]
+eq 0, I10, DEBUG_CHECK_BREAKPOINT_COORD
+bsr DEBUG_INTERACT
+branch DEBUG_CHECK_BREAKPOINT_END
+DEBUG_CHECK_BREAKPOINT_COORD:
+set S10, I0
+concat S10, ","
+set S11, I1
+concat S10, S11
+exists I10, P4[S10]
+eq 0, I10, DEBUG_CHECK_BREAKPOINT_ROW
+bsr DEBUG_INTERACT
+branch DEBUG_CHECK_BREAKPOINT_END
+DEBUG_CHECK_BREAKPOINT_ROW:
+set S10, "r:"
+set S11, I1
+concat S10, S11
+exists I10, P4[S10]
+eq 0, I10, DEBUG_CHECK_BREAKPOINT_COL
+bsr DEBUG_INTERACT
+branch DEBUG_CHECK_BREAKPOINT_END
+DEBUG_CHECK_BREAKPOINT_COL: 
+set S10, "c:"
+set S11, I0
+concat S10, S11
+exists I10, P4

[perl #19610] [PATCH] New language support: Ook!

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19610]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19610 >


Thanks to our dear summarizer, I'm now known (from a googlism point of 
view) as 'one of the "let's implement a bunch of languages on parrot" 
crew'. So, in order to prove him right definitely (and also because 
orang-utans should also benefit from Parrot's speed), here's a new 
language supported by Parrot: the Ook! language.

For the unlucky who don't know it, Ook! is essentially isomorphic to the 
well-known brainfsck language. 
Refer to http://www.dangermouse.net/esoteric/ook.html for more details.

Ok, about this implementation:
 - this is a compiler (and not an interpreter) that spits Parrot 
assembly code (yes, I'm targeting Parrot).
 - it implements every Ook! instruction but the "Ook. Ook!" one. I'll 
work on it later.
 - currently I'm just printing on stdout the resulting parrot code, I 
lack an eval instruction in Parrot. Dan, Leo? :-)

Disclaimer: it's all of Nicholas Clark's fault. Really. He's the one to 
take the blame for it.

Jerome
-- 
[EMAIL PROTECTED]


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46602/36599/6c9317/ook_first_draft.patch


diff -urbN parrot.old/config/gen/makefiles/ook.in parrot/config/gen/makefiles/ook.in
--- parrot.old/config/gen/makefiles/ook.in	1970-01-01 01:00:00.0 +0100
+++ parrot/config/gen/makefiles/ook.in	2002-12-30 23:25:20.0 +0100
@@ -0,0 +1,18 @@
+RM_F = ${rm_f}
+PERL = ${perl}
+
+ASSEMBLE=$(PERL) ../../assemble.pl
+PARROT=../../parrot
+
+all: build
+
+test: build
+	$(PARROT) ook.pbc hello.ook > foo.pasm
+	$(ASSEMBLE) foo.pasm > foo.pbc
+	$(PARROT) foo.pbc
+
+build: ook.pasm
+	$(ASSEMBLE) ook.pasm > ook.pbc
+
+clean:
+	$(RM_F) core *.pbc *~ foo.p*
diff -urbN parrot.old/config/gen/makefiles.pl parrot/config/gen/makefiles.pl
--- parrot.old/config/gen/makefiles.pl	2002-12-30 23:43:54.0 +0100
+++ parrot/config/gen/makefiles.pl	2002-12-30 23:25:02.0 +0100
@@ -31,6 +31,8 @@
   commentType => '#');
   genfile('config/gen/makefiles/befunge.in',   'languages/befunge/Makefile',
   commentType => '#');
+  genfile('config/gen/makefiles/ook.in',   'languages/ook/Makefile',
+  commentType => '#');
 }
 
 1;
diff -urbN parrot.old/languages/ook/Changes parrot/languages/ook/Changes
--- parrot.old/languages/ook/Changes	1970-01-01 01:00:00.0 +0100
+++ parrot/languages/ook/Changes	2002-12-30 23:55:01.0 +0100
@@ -0,0 +1,9 @@
+Revision history for a Ook! compiler written in Parrot and targeting Parrot.
+
+0.0.1 Mon Dec 30 23:46:32 CET 2002
+- thanks to a silly idea of Nicholas Clark, first draft of this
+  Ook! compiler written in Parrot.
+	- every Ook! instruction is implemented but the "Ook. Ook!"
+  one.
+- currently spitting Parrot assembly on stdout.
+
diff -urbN parrot.old/languages/ook/hello.ook parrot/languages/ook/hello.ook
--- parrot.old/languages/ook/hello.ook	1970-01-01 01:00:00.0 +0100
+++ parrot/languages/ook/hello.ook	2002-12-30 23:46:46.0 +0100
@@ -0,0 +1,20 @@
+Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook.
+Ook! Ook. Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook?
+Ook! Ook! Ook? Ook! Ook? Ook. Ook. Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook. Ook! Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook.
+Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook! Ook? Ook? Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook? Ook! Ook! Ook? Ook! Ook? Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
+Ook? Ook. Ook? Ook. Ook? Ook. Ook? Ook. Ook! Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook! Ook. Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook.
+Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook! Ook!
+Ook! Ook. Ook. Ook? Ook. Ook? Ook. Ook. Ook! Ook. Ook! Ook? Ook! Ook! Ook? Ook!
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook.
+Ook. Ook. Ook. Ook. Ook! Ook.
diff -urbN parrot.old/languages/ook/ook.pasm parrot/languages/ook/ook.pasm
--- parrot.old/languages/ook/ook.pasm	1970-01-01 01:00:00.0 +0100
+++ parrot/languages/ook/ook

[perl #19622] [PATCH] compact_pool

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #19622]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19622 >


I did write:

[1] which BTW seems bogus to me: pool_compact() may be called (when 
there is enough reclaimable space), without having a DOD run immediately 
before it. So e.g. the on_free_list flag might not reflect current usage 
of a buffer.

Here is a program showing more problems with the current implementation:

set S0, "abcdefghij"
set I0, 0
lp: 
repeat S1, S0, 5000
ne S0, "abcdefghij", nok
substr S2, S1, 1, 1
ne S2, "b", nok
inc I0
lt I0, 1000, lp
print "ok\n"
end
nok: 
print "nok\n"
print S0
print " - "
print S1
print "\n"
end

The substr makes a COW reference of S1, which doesn't set 
pool->guaranteed_reclaimable, so when above is run without --gc-debug, 
pool->compact gets nether called and the program dies with SIGSEGV - the 
real reason is a NULL pointer returned from malloc().

--gc-debug does a DOD run + an unconditional compact_pool, so the 
program runs fine.

A proposed change could look like attached patch:
- die when malloc returns zero (IMHO we can't recover)
- always call do_dod_run before compact_pool
- when possibly_reclaimable reaches a certain amount, always compact the 
pool - the reclaim_factor (currently 20%) doesn't really matter, it just 
allows that the pool gets compacted sooner or later - it is used now as 
a probablity meaning 20% of COWed strings might be reclaimable.

leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46630/36629/d8ca8a/resources.c.patch


--- resources.c Fri Dec 27 10:34:28 2002
+++ /home/lt/src/parrot-leo/resources.c Tue Dec 31 14:26:26 2002
@@ -45,6 +45,8 @@
 new_block = mem_sys_allocate_zeroed(sizeof(struct Memory_Block) +
 alloc_size + 32);
 if (!new_block) {
+fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
+exit(1);
 return NULL;
 }
 
@@ -110,25 +112,25 @@
 }
 }
 if (pool->top_block->free < size) {
+Parrot_do_dod_run(interpreter);
 /* Compact the pool if allowed and worthwhile */
 if (pool->compact) {
 /* don't bother reclaiming if its just chicken feed */
-if ((pool->possibly_reclaimable + pool->guaranteed_reclaimable) / 2
-> (size_t)(pool->total_allocated * pool->reclaim_factor)
+if (pool->possibly_reclaimable * pool->reclaim_factor
+> size
 /* don't bother reclaiming if it won't even be enough */
-&& (pool->guaranteed_reclaimable > size)
+|| (pool->guaranteed_reclaimable > size)
 ) {
 (*pool->compact) (interpreter, pool);
 }
-else {
-Parrot_do_dod_run(interpreter);
-}
 
 }
 if (pool->top_block->free < size) {
 alloc_new_block(interpreter, size, pool);
 interpreter->mem_allocs_since_last_collect++;
 if (pool->top_block->free < size) {
+fprintf(stderr, "out of mem\n");
+exit(1);
 return NULL;
 }
 }

[perl #19626] [PATCH] Fixing multi-level while in Ook!

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19626]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19626 >


> Because what I said I'd really like (apart from "moon on a stick",
> "a new apocalypse" (and "a pony", which Jerome had to remind me
> about)) would be a compiler that reads in Ook!, creates parrot
> bytecode on the fly, and then calls it, without using temporary
> files.

I can't imagine how you could forget to ask for a pony... :-)


> However, when I tried compiling my Ook! test program:
[... Nice Ook! program skipped ...]
> I got this:
> Label KOO1_2 already exists at ../../assemble.pl line 557.

Uh, yes... The previous implementation was a little naive with 
multi-level while nested. The patch attached fixes that with a new 
naming scheme for the labels generated, alowing as many nesting levels 
and as many while in a row in whatever order you want (hopefully).
I also added your test.ook file (if you allow me to ship it) in order 
for other people to play with. If you're ok with it, please add it to 
the MANIFEST file (laziness reasons made me diffing only the ook 
directory). Thanks.

Oh, btw. This patch assumes the first Ook! patch is already commited.

Jerome
-- 
[EMAIL PROTECTED]


-- attachment  1 --
url: 
http://rt.perl.org/rt2/attach/46638/36636/906ac0/ook_use_array_for_multilevel_while.patch


diff -urbN ook.old/Changes ook/Changes
--- ook.old/Changes	2002-12-31 16:57:58.0 +0100
+++ ook/Changes	2002-12-31 18:02:53.0 +0100
@@ -1,5 +1,13 @@
 Revision history for a Ook! compiler written in Parrot and targeting Parrot.
 
+0.0.2 Tue Dec 31 18:02:01 CET 2002
+- Nicholas Clark reported a bug when there's a complex nesting
+  of while instructions in the ook source. This version fixes
+  it with a brand new scheme of naming the labels in the
+  generated Parrot assembly.
+- added a test.ook file that illustrates the old bug, and
+  works as Test::Harness expects.
+
 0.0.1 Mon Dec 30 23:46:32 CET 2002
 - thanks to a silly idea of Nicholas Clark, first draft of this
   Ook! compiler written in Parrot.
diff -urbN ook.old/ook.pasm ook/ook.pasm
--- ook.old/ook.pasm	2002-12-31 18:05:59.0 +0100
+++ ook/ook.pasm	2002-12-31 18:07:04.0 +0100
@@ -11,13 +11,12 @@
 EOF:
 close P0
 
-
 # Then, parse it to translate it.
 length I0, S1   # Total length of file.
 set I1, 0   # Char number in the file.
 set I2, 1   # Line number (for error reporting).
-set I6, 0   # While-level (iterate).
-set I7, 0   # While-level (nested).
+new P1, .PerlArray  # While-level.
+push P1, 0
 set S2, ""  # Current char.
 set S3, ""  # Current instruction.
 set S4, "\tnew P0,.PerlArray\n\tset I0,0\n"   # Code generated.
@@ -55,41 +54,27 @@
 branch LOOP_END
 LOOP_NOT_DEC:
 ne S3, "Ook!Ook?", LOOP_NOT_WHILE
-inc I7
+bsr MAKE_LABEL
 concat S4, "\tbranch OOK"
-set S5, I6
-concat S4, S5
-concat S4, "_"
-set S5, I7
-concat S4, S5
+concat S4, S6
 concat S4, "\nKOO"
-set S5, I6
-concat S4, S5
-concat S4, "_"
-set S5, I7
-concat S4, S5
+concat S4, S6
 concat S4, ":\n"
+push P1, 0
 set S3, ""
 branch LOOP_END
 LOOP_NOT_WHILE:
 ne S3, "Ook?Ook!", LOOP_NOT_ELIHW
+pop I10, P1
+bsr MAKE_LABEL
 concat S4, "OOK"
-set S5, I6
-concat S4, S5
-concat S4, "_"
-set S5, I7
-concat S4, S5
+concat S4, S6
 concat S4, ":\n\tset I1,P0[I0]\n\tne I1,0,KOO"
-set S5, I6
-concat S4, S5
-concat S4, "_"
-set S5, I7
-concat S4, S5
+concat S4, S6
 concat S4, "\n"
-dec I7
-ne I7, 0, LOOP_NESTING_DONE
-inc I6
-LOOP_NESTING_DONE:  
+pop I7, P1
+inc I7
+push P1, I7
 set S3, ""
 branch LOOP_END
 LOOP_NOT_ELIHW:
@@ -118,3 +103,21 @@
 concat S4, "\tend\n"
 print S4
 end
+
+# Given the content of P1, create a label of integers concateneted in S6.
+MAKE_LABEL:
+set I10, P1
+set I11, 0
+set S6, ""
+branch LABEL_END
+LABEL_LOOP:
+concat S6, "_"
+set I12, P1[I11]
+set S7, I12
+concat S6, S7
+inc I11
+LABEL_END:
+lt I11, I10, LABEL_LOOP
+ret
+
+
diff -urbN ook.old/test.ook ook/test.ook
--- ook.old/test.ook	1970-01-01 01:00:00.0 +0100
+++ ook/test.ook	2002-12-31 16:59:14.0 +0100
@@ -0,0 +1,28 @@
+Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook. Ook

[perl #19630] [PATCH] undef warning in Configure.pl

[via RT]

# New Ticket Created by  Nicholas Clark 
# Please include the string:  [perl #19630]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19630 >


I was seeing this:

Generating config.h...done.
Generating feature.h...done.
Writing Parrot::Config module...done.
Use of uninitialized value in substitution iterator at lib/Parrot/Configure/Step.pm 
line 121,  line 111.
Generating Makefiles...done.
Recording this configuration in myconfig...done.
Moving platform files into place...done.
Generating libparrot.def...done.
Generating core pmc list...done.
Okay, we're done!


And it was annoying me. So I did this to track it down:

--- lib/Parrot/Configure/Step.pm~   Sat Dec 28 12:10:18 2002
+++ lib/Parrot/Configure/Step.pmTue Dec 31 18:55:14 2002
@@ -120,7 +120,9 @@ sub genfile {
}
s{
 \$\{(\w+)\}
-}{Configure::Data->get($1)}egx;
+}{my $val=Configure::Data->get($1);
+ defined $val ? $val
+   : (warn "value for '$1' in $source is undef", '')}egx;
print OUT;
}
 

I think that something like that is a good idea, as this is more helpful:

Generating config.h...done.
Generating feature.h...done.
Writing Parrot::Config module...done.
value for 'asmfun_o' in config/gen/makefiles/root.in is undef at 
lib/Parrot/Configure/Step.pm line 122,  line 111.
Generating Makefiles...done.
Recording this configuration in myconfig...done.
Moving platform files into place...done.
Generating libparrot.def...done.
Generating core pmc list...done.
Okay, we're done!

So I think we also need the appended patch, which elimates the warning.

Nicholas Clark

--- config/auto/jit.pl~ Fri Dec 27 18:27:04 2002
+++ config/auto/jit.pl  Tue Dec 31 18:59:16 2002
@@ -73,6 +73,8 @@ sub runstep {
 copy_if_diff("config/gen/platform/$cpuarch.s", "asmfun.s");
 
 Configure::Data->set(asmfun_o => 'asmfun$(O)');
+  } else {
+Configure::Data->set(asmfun_o => '');
   }
 
   $jitcapable = $set_jitcapable if defined $set_jitcapable;

[perl #19668] [PATCH] infant mortality #1

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #19668]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19668 >


Attached patch changes a view places, which cause problems running w/o 
trace_system_areas().

With this all parrot tests pass here (i386/linux) with or without 
--gc-debug. Some perl6 tests related to try/catch are failing.

Please check this on different platforms, TIA.

leo



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46715/36710/7ee026/infant-mort-1.patch


--- parrot/classes/default.pmc  Mon Dec 30 18:38:57 2002
+++ parrot-leo/classes/default.pmc  Thu Jan  2 12:44:10 2003
@@ -65,7 +65,8 @@
  SELF->metadata, p_key, value, NULL);
} else {
   /* first make new hash */
- SELF->metadata = pmc_new(interpreter, enum_class_PerlHash);
+ SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
+ SELF->metadata->vtable->init(interpreter, SELF->metadata);
  /* then the key, else it vanishes with --gc-debug */
   p_key = key_new_string(interpreter, key);
  SELF->metadata->vtable->set_pmc_keyed(interpreter,
--- parrot/dod.cMon Dec 30 11:47:25 2002
+++ parrot-leo/dod.cThu Jan  2 12:18:40 2003
@@ -22,8 +22,6 @@
 #endif
 
 static size_t find_common_mask(size_t val1, size_t val2);
-static void trace_system_stack(struct Parrot_Interp *);
-
 
 void pobject_lives(struct Parrot_Interp *interpreter, PObj *obj)
 {
@@ -93,7 +91,7 @@
 #if ! DISABLE_GC_DEBUG
 CONSERVATIVE_POINTER_CHASING = 1;
 #endif
-trace_system_areas(interpreter);
+/* trace_system_areas(interpreter); */
 #if ! DISABLE_GC_DEBUG
 CONSERVATIVE_POINTER_CHASING = 0;
 #endif
--- parrot/hash.c   Fri Dec 27 10:34:28 2002
+++ parrot-leo/hash.c   Thu Jan  2 12:34:27 2003
@@ -418,6 +418,8 @@
 hash_clone(struct Parrot_Interp *interp, HASH *hash, HASH **dest)
 {
 HashIndex i;
+
+Parrot_block_DOD(interp);
 new_hash(interp, dest);
 for (i = 0; i <= hash->max_chain; i++) {
 BucketIndex bi = lookupBucketIndex(hash, i);
@@ -456,6 +458,7 @@
 bi = b->next;
 }
 }
+Parrot_unblock_DOD(interp);
 }
 
 /*
--- parrot/resources.c  Fri Dec 27 10:34:28 2002
+++ parrot-leo/resources.c  Tue Dec 31 14:26:26 2002
@@ -45,6 +45,8 @@
 new_block = mem_sys_allocate_zeroed(sizeof(struct Memory_Block) +
 alloc_size + 32);
 if (!new_block) {
+fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
+exit(1);
 return NULL;
 }
 
@@ -110,25 +112,25 @@
 }
 }
 if (pool->top_block->free < size) {
+Parrot_do_dod_run(interpreter);
 /* Compact the pool if allowed and worthwhile */
 if (pool->compact) {
 /* don't bother reclaiming if its just chicken feed */
-if ((pool->possibly_reclaimable + pool->guaranteed_reclaimable) / 2
-> (size_t)(pool->total_allocated * pool->reclaim_factor)
+if (pool->possibly_reclaimable * pool->reclaim_factor
+> size
 /* don't bother reclaiming if it won't even be enough */
-&& (pool->guaranteed_reclaimable > size)
+|| (pool->guaranteed_reclaimable > size)
 ) {
 (*pool->compact) (interpreter, pool);
 }
-else {
-Parrot_do_dod_run(interpreter);
-}
 
 }
 if (pool->top_block->free < size) {
 alloc_new_block(interpreter, size, pool);
 interpreter->mem_allocs_since_last_collect++;
 if (pool->top_block->free < size) {
+fprintf(stderr, "out of mem\n");
+exit(1);
 return NULL;
 }
 }
--- parrot/spf_render.c Tue Dec 17 08:30:55 2002
+++ parrot-leo/spf_render.c Thu Jan  2 12:28:59 2003
@@ -228,6 +228,7 @@
 char tc[PARROT_SPRINTF_BUFFER_SIZE];
 
 
+Parrot_block_DOD(interpreter);
 for (i = old = len = 0; i < (INTVAL) string_length(pat); i++) {
 if (string_ord(pat, i) == '%') {/* % */
 if (len) {
@@ -663,6 +664,7 @@
 string_append(interpreter, targ, substr, 0);
 }
 
+Parrot_unblock_DOD(interpreter);
 return targ;
 }
 
--- parrot/string.c Thu Dec 26 12:32:35 2002
+++ parrot-leo/string.c Thu Jan  2 12:41:12 2003
@@ -244,7 +244,12 @@
 PObj_bufstart_external_SET(s);
 }
 else {
+/* allocate_string can trigger DOD, which destroys above allocated
+ * string header w/o stack_walk
+ */
+Parrot_block_DOD(interpreter);
 Parrot_allocate_string(interpreter, s, len);
+Parrot_unblock_DOD(interpreter);
 }
 s->encoding = encoding;
 s->type = type;

[perl #19670] [PASM] bug in i/o (read on stdin)

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19670]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19670 >


Hi,

The following code does not work as it should:
read S0, 0, 1
print ">"
print S0
print "<\n"
end

$ perl ../../assemble.pl q.pasm > q && ../../parrot q
abcde
><
$ bcde
zsh: command not found: bcde

So it seems that Parrot "reads" the first char, as I want, but does not 
stuff it in S0. Or maybe I'm wrong, and should "open" STDIN before 
reading it via a file PMC?

Another thing. Could one turn off bufferization, so that "read S0, 0, 1" 
only reads one char without slurping the whole line till the carriage 
return?

Jerome
-- 
[EMAIL PROTECTED]

[perl #19671] [PATCH] befunge debugger supports the "delete" instruction

[via RT]

# New Ticket Created by  Jerome Quelin 
# Please include the string:  [perl #19671]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19671 >


The previous befunge patch enabled befunge to set breakpoints, this one 
allows one to clear those breakpoints (thanks to Leo who fixed the 
PerlHash vtable).

Jerome
-- 
[EMAIL PROTECTED]


-- attachment  1 --
url: 
http://rt.perl.org/rt2/attach/46731/36719/ffd307/befunge_debugger_clear_breakpoints.patch


? befunge.pbc
Index: Changes
===
RCS file: /cvs/public/parrot/languages/befunge/Changes,v
retrieving revision 1.6
diff -u -d -r1.6 Changes
--- Changes	30 Dec 2002 20:55:44 -	1.6
+++ Changes	2 Jan 2003 16:53:13 -
@@ -1,5 +1,9 @@
 Revision history for a Befunge interpreter written for Parrot.
 
+0.1.2 Thu Jan  2 17:50:25 CET 2003
+- new debugger instruction: "delete", that allows to clear
+  breakpoints (those created by the "break" instruction)
+
 0.1.1 Mon Dec 30 18:12:34 CET 2002
 - debugger now accepts breakpoints: either on instructions
   (characters), or on a specified location (x,y), or on a
Index: README
===
RCS file: /cvs/public/parrot/languages/befunge/README,v
retrieving revision 1.8
diff -u -d -r1.8 README
--- README	30 Dec 2002 20:55:44 -	1.8
+++ README	2 Jan 2003 16:53:13 -
@@ -1,6 +1,6 @@
 DESCRIPTION
 ---
-This is a Befunge interpreter written in Parrot assembler, version 0.1.1
+This is a Befunge interpreter written in Parrot assembler, version 0.1.2
 
 This interpreter should be Befunge-93 compliant. This means the
 playfield is limited to 80x25. This should also mean that the torus
Index: debug.pasm
===
RCS file: /cvs/public/parrot/languages/befunge/debug.pasm,v
retrieving revision 1.4
diff -u -d -r1.4 debug.pasm
--- debug.pasm	30 Dec 2002 20:55:44 -	1.4
+++ debug.pasm	2 Jan 2003 16:53:13 -
@@ -84,6 +84,7 @@
 substr S11, S10, 0, 5
 eq S11, "break", DEBUG_INTERACT_BREAK
 substr S11, S10, 0, 6
+eq S11, "delete", DEBUG_INTERACT_DELETE
 eq S11, "status", DEBUG_INTERACT_STATUS
 substr S11, S10, 0, 7
 eq S11, "restart", DEBUG_INTERACT_RESTART
@@ -101,6 +102,13 @@
 DEBUG_INTERACT_CONTINUE:
 set P3[0], 0# do not stop at next instruction
 branch DEBUG_INTERACT_END
+DEBUG_INTERACT_DELETE:
+substr S11, S10, 0, 7, ""
+pushp
+set P4, P3[1]
+delete P4[S10]
+popp
+branch DEBUG_INTERACT
 DEBUG_INTERACT_DUMP:
 bsr DEBUG_DUMP_PLAYFIELD
 branch DEBUG_INTERACT
@@ -112,6 +120,10 @@
 print " break x,y - set a breakpoint at coords (x,y)\n"
 print " break c:x - set a breakpoint on column x\n"
 print " break r:y - set a breakpoint on row y\n"
+print " delete c  - delete breakpoint on character c\n"
+print " delete x,y- delete breakpoint at coords (x,y)\n"
+print " delete c:x- delete breakpoint on column x\n"
+print " delete r:y- delete breakpoint on row y\n"
 print " list  - list breakpoints\n"
 print " next  - step one befunge instruction\n"
 print " continue  - resume execution\n"

[perl #19729] [PATCH] SPARC JIT support for restart

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #19729]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19729 >



This patch adds JIT support for restart and similar ops.

-- 
Jason


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/46899/36851/696709/restart.patch


Index: jit/sun4/jit_emit.h
===
RCS file: /cvs/public/parrot/jit/sun4/jit_emit.h,v
retrieving revision 1.18
diff -u -r1.18 jit_emit.h
--- jit/sun4/jit_emit.h 1 Dec 2002 12:51:23 -   1.18
+++ jit/sun4/jit_emit.h 5 Jan 2003 04:01:03 -
@@ -287,7 +287,7 @@
 #define Parrot_jit_intrp emitm_i(0)
 
 /* The register holding the address of I0 */
-#define Parrot_jit_regbase emitm_i(1)
+#define Parrot_jit_regbase emitm_i(2)
 
 /* The register containing the address of the opmap */
 #define Parrot_jit_opmap emitm_i(3)
@@ -300,6 +300,32 @@
 /* The offset of a Parrot register from the base register */
 #define Parrot_jit_regoff(a, i) (unsigned)(a) - (unsigned)(Parrot_jit_regbase_ptr(i))
 
+/* Generate a jump to a bytecode address - uses the temporary register */
+static void
+Parrot_jit_bytejump(Parrot_jit_info_t *jit_info,
+struct Parrot_Interp *interpreter, int reg_num)
+{
+
+/* Construct the starting address of the byte code */
+emitm_sethi(jit_info->native_ptr, emitm_hi22(interpreter->code->byte_code),
+Parrot_jit_tmp);
+emitm_or_i(jit_info->native_ptr, Parrot_jit_tmp,
+emitm_lo10(interpreter->code->byte_code), Parrot_jit_tmp);
+
+/* Calculates the offset into op_map shadow array 
+ * assuming sizeof(opcode_t) == sizeof(opmap array entry) */
+emitm_sub_r(jit_info->native_ptr, reg_num, Parrot_jit_tmp,
+Parrot_jit_tmp);
+
+/* Load the address of the native code from op_map */
+emitm_ld_r(jit_info->native_ptr, Parrot_jit_opmap, Parrot_jit_tmp,
+   Parrot_jit_tmp);
+
+/* This jumps to the address from op_map */
+emitm_jumpl_i(jit_info->native_ptr, Parrot_jit_tmp, 0, Parrot_jit_tmp);
+emitm_nop(jit_info->native_ptr);
+}
+
 /* Generate conditional branch to offset from current parrot op */
 static void Parrot_jit_bicc(Parrot_jit_info_t *jit_info, int cond, int annul,
 opcode_t disp)
@@ -505,9 +531,14 @@
 }
 }
 
-void Parrot_jit_begin(Parrot_jit_info_t *jit_info,
+void
+Parrot_jit_begin(Parrot_jit_info_t *jit_info,
   struct Parrot_Interp * interpreter)
 {
+/* generated code is called as jit_code(interpreter, pc)
+ * so interpreter is in i0 and pc in i1.
+ * i1 is reusable once past the jump. interpreter is preserved in i0
+ */
 int ireg0_offset;
 
 /* Standard Prolog */
@@ -531,8 +562,10 @@
 emitm_sethi(jit_info->native_ptr,
 emitm_hi22(jit_info->arena.op_map), Parrot_jit_opmap);
 emitm_or_i(jit_info->native_ptr,
-emitm_i(3), emitm_lo10(jit_info->arena.op_map), Parrot_jit_opmap);
-/* TODO emit restart code s. i386 */
+Parrot_jit_opmap, emitm_lo10(jit_info->arena.op_map), Parrot_jit_opmap);
+
+/* Jump to the current pc */
+Parrot_jit_bytejump(jit_info, interpreter, emitm_i(1));
 }
 
 void Parrot_jit_normal_op(Parrot_jit_info_t *jit_info,
@@ -555,21 +588,27 @@
 struct Parrot_Interp * interpreter)
 {
 Parrot_jit_normal_op(jit_info, interpreter);
+Parrot_jit_bytejump(jit_info, interpreter, emitm_o(0));
+}
 
-emitm_sethi(jit_info->native_ptr, emitm_hi22(interpreter->code->byte_code),
-emitm_l(1));
-emitm_or_i(jit_info->native_ptr, emitm_l(1),
-emitm_lo10(interpreter->code->byte_code), emitm_l(1));
-
-/* This calculates offset into op_map shadow array */
-emitm_sub_r(jit_info->native_ptr, emitm_o(0), emitm_l(1), emitm_o(0));
+#undef Parrot_jit_restart_op
+void Parrot_jit_restart_op(Parrot_jit_info_t *jit_info,
+struct Parrot_Interp * interpreter)
+{
+Parrot_jit_normal_op(jit_info, interpreter);
 
-/* Load the address of the native code from op_map */
-emitm_ld_r(jit_info->native_ptr, emitm_i(3), emitm_o(0), emitm_o(0));
+/* Test whether the return value is 0 */
+emitm_subcc_r(jit_info->native_ptr, emitm_o(0), emitm_g(0), emitm_g(0));
 
-/* This jumps to the address from op_map */
-emitm_jumpl_i(jit_info->native_ptr, emitm_o(0), 0, emitm_g(0));
+/* If the return pc is not zero skip the next 3 instructions */
+emitm_bicc(jit_info->native_ptr, 0, emitm_bne, 4);
 emitm_nop(jit_info->native_ptr);
+
+/* Return if the return pc is 0 */
+emitm_ret(jit_info->native_ptr);
+emitm_restore_i(jit_info->native_ptr, emitm_g(0), emitm_g(0), emitm_g(0));
+
+Parrot_jit_bytejump(jit_info, interpreter, emitm_o(0));
 }
 
 /* move reg to mem (i.e. intreg) */

[perl #19807] [PATCH] rx.ops doc typos

[via RT]

# New Ticket Created by  Jim Radford 
# Please include the string:  [perl #19807]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19807 >


I found a few typos while reading through the documentation in rx.ops.

-Jim

--- parrot-0.0.9/rx.ops.origMon Jan  6 15:28:08 2003
+++ parrot-0.0.9/rx.ops Mon Jan  6 15:38:41 2003
@@ -405,7 +405,7 @@
 
 =item C(in str, inout int, in pmc, inconst int)
 
-Matches if the current character is one of the characters in the second parameter.
+Matches if the current character is one of the characters in the third parameter.
 
 This op requires that its input be sorted for efficiency.  Further, it requires that 
all
 ranges (C) be expanded by the regex compiler.
@@ -437,7 +437,7 @@
 
 =item C(in str, inout int, in pmc, inconst int)
 
-This op has the exact same behavior as C, except that the second parameter 
+This op has the exact same behavior as C, except that the third parameter 
 is a Pointer to a bitmap generated by C.
 
 =cut
@@ -542,10 +542,10 @@
 
 =item C(in str, out int, inout int, in str, inconst in) 
 
-Searches for the literal $4 on the string $1. Sets $2 to the current
+Searches for the literal $4 on the string $1 starting at $3. Sets $2 to the current
 index in the string (after the literal), and $3 to start_index.
 
-Branches to $4 if the literal is not found.
+Branches to $5 if the literal is not found.
 
 =cut
 
@@ -597,10 +597,10 @@
 
 =item C (in str, out int, inout int, in str, inconst in) 
 
-Searches for the char $4 on the string $1. Sets $2 to the current
+Searches for the char $4 on the string $1 starting at $3. Sets $2 to the current
 index in the string (after the char)
 
-Branches to $4 if the char is not found.
+Branches to $5 if the char is not found.
 
 The char is expressed as an integer representing its codepoint.
 
@@ -914,7 +914,7 @@
 
set I0, 0
$start:
-   rx_literal, S0, I1, I0, "foobar", $fail 
+   rx_search, S0, I1, I0, "foobar", $fail 
print "match"
branch $end 
$fail:

[perl #19834] [PATCH] sub, add, mul, div with combinations of INT, NUM, PMC

[via RT]

# New Ticket Created by  Bernhard Schmalhofer 
# Please include the string:  [perl #19834]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19834 >


Hi,

I have been looking into the possibility of adding complex numbers as PMCs.
When looking at core.ops I was missing some operations, where INT, NUM 
and PMC interact.
For addition I found the operations:
add_i_i, add_n_n, add_p_i, add_p_n, add_p_p, add_i_i_i, add_n_n_n, 
add_p_p_i, add_p_p_p.
Trying to make this more consistent I added:
add_n_i, add_n_n_i and app_p_p_n.
This means that there are now 12 addition ops.
I also brought 'sub', 'mul' and 'div' to the same level.

I have put some tests in t/op/arithmetics.t. Each of the operations 
mentioned above should be called in the test.

However I still wonder about operations like 'div_p_n_p'. Unlike 
'div_p_p_n', it can't be implemented with the vtable-function divide_float.

I have attached the patch for core.ops and the file arithmetics.t.

CU, Bernhard

-- 
*
Bernhard Schmalhofer
Senior Developer

Biomax Informatics AG
Lochhamer Str. 11
82152 Martinsried, Germany

Tel:+49 89 89 55 74 - 839
Fax:+49 89 89 55 74 - 25
PGP:https://ssl.biomax.de/pgp/
Email:  mailto:[EMAIL PROTECTED]
Web:http://www.biomax.de
*


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/47101/37035/779e55/core.ops.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/47101/37036/45ee9d/arithmetics.t


--- core.opsWed Jan  8 20:13:48 2003
+++ core.ops.20020108   Wed Jan  8 18:57:49 2003
@@ -1279,8 +1279,6 @@
 
 =item B(inout INT, in INT)
 
-=item B(inout NUM, in INT)
-
 =item B(inout NUM, in NUM)
 
 =item B(inout PMC, in INT)
@@ -1293,14 +1291,10 @@
 
 =item B(out INT, in INT, in INT)
 
-=item B(out NUM, in NUM, in INT)
-
 =item B(out NUM, in NUM, in NUM)
 
 =item B(inout PMC, in PMC, in INT)
 
-=item B(inout PMC, in PMC, in NUM)
-
 =item B(inout PMC, in PMC, in PMC)
 
 Set $1 to the sum of $2 and $3.
@@ -1312,11 +1306,6 @@
   goto NEXT();
 }
 
-inline op add(inout NUM, in INT) {
-  $1 += $2;
-  goto NEXT();
-}
-
 inline op add(inout NUM, in NUM) {
   $1 += $2;
   goto NEXT();
@@ -1342,11 +1331,6 @@
   goto NEXT();
 }
 
-inline op add(out NUM, in NUM, in INT) {
-  $1 = $2 + $3;
-  goto NEXT();
-}
-
 inline op add(out NUM, in NUM, in NUM) {
   $1 = $2 + $3;
   goto NEXT();
@@ -1357,11 +1341,6 @@
   goto NEXT();
 }
 
-inline op add(inout PMC, in PMC, in NUM) {
-  $2->vtable->add_float(interpreter, $2, $3, $1);
-  goto NEXT();
-}
-
 inline op add (inout PMC, in PMC, in PMC) {
   $2->vtable->add(interpreter, $2, $3, $1);
   goto NEXT();
@@ -1477,91 +1456,40 @@
 
 
 
-=item B(inout INT, in INT)
-
-=item B(inout NUM, in INT)
-
-=item B(inout NUM, in NUM)
-
-=item B(inout PMC, in INT)
-
-=item B(inout PMC, in NUM)
-
-=item B(inout PMC, in PMC)
-
-Divide $1 by $2. 
-
 =item B(out INT, in INT, in INT)
 
-=item B(out NUM, in NUM, in INT)
-
 =item B(out NUM, in NUM, in NUM)
 
-=item B(inout PMC, in PMC, in INT)
-
-=item B(inout PMC, in PMC, in NUM)
-
 =item B(inout PMC, in PMC, in PMC)
 
+=item B(inout PMC, in INT)
+
 Set $1 to the quotient of $2 divided by $3. In the case of INTVAL division, the
 result is truncated (NOT rounded or floored).
 
 =cut
 
-inline op div(inout INT, in INT) {
-  $1 /= $2;
-  goto NEXT();
-}
-
-inline op div(inout NUM, in INT) {
-  $1 /= $2;
-  goto NEXT();
-}
-
-inline op div(inout NUM, in NUM) {
-  $1 /= $2;
-  goto NEXT();
-}
-
-inline op div (inout PMC, in INT) {
-  $1->vtable->divide_int(interpreter, $1, $2, $1);
-  goto NEXT();
-}
-
-inline op div (inout PMC, in NUM) {
-  $1->vtable->divide_float(interpreter, $1, $2, $1);
-  goto NEXT();
-}
-
 inline op div(out INT, in INT, in INT) {
   $1 = $2 / $3;
   goto NEXT();
 }
 
-inline op div(out NUM, in NUM, in INT) {
-  $1 = $2 / $3;
-  goto NEXT();
-}
-
 inline op div(out NUM, in NUM, in NUM) {
   $1 = $2 / $3;
   goto NEXT();
 }
 
-inline op div (inout PMC, in PMC, in INT) {
-  $2->vtable->divide_int(interpreter, $2, $3, $1);
+inline op div (inout PMC, in PMC, in PMC) {
+  $2->vtable->divide(interpreter, $2, $3, $1);
   goto NEXT();
 }
 
-inline op div (inout PMC, in PMC, in NUM) {
-  $2->vtable->divide_float(interpreter, $2, $3, $1);
+inline op div (inout PMC, in INT) {
+  $1->vtable->divide_int(interpreter, $1, $2, $1);
   goto NEXT();
 }
 
-inline op div (inout PMC, in PMC, in PMC) {
-  $2->vtable->divide(interpreter, $2, $3, $1);
-  goto NEXT();
-}
+
 
 
 
@@ -1703,28 +1631,18 @@
 
 =item B(inout INT, in INT)
 
-=item B(inout NUM, in INT)
-
 =item B(inout NUM, in NUM)
 
 =item B(inout PMC, in INT)
 
-=item B(inout PMC, in NUM)
-
 =item B(inout PMC, in PMC)
 
 Set $1 to the product of $1

[perl #19870] Compile failure in jit_cpu.c

[via RT]

# New Ticket Created by  Matthew Zimmerman 
# Please include the string:  [perl #19870]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19870 >


A CVS update from about 30 minutes ago is failing to compile
on my Red Hat Linux 7.2/i386 system, with this error:

---
$ make realclean
$ perl Configure.pl && make
[...]
perl ops2pm.pl core.ops debug.ops dotgnu.ops io.ops math.ops pmc.ops rx.ops 
perl jit2h.pl i386 jit_cpu.c
jit2h: 171 (+ 150 vtable) of 991 ops are JITed.
gcc -I/usr/local/include  -Wall -Wstrict-prototypes -Wmissing-prototypes -Winline 
-Wshadow -Wpointer-arith -Wcast-qual -Wcast-align -Wwrite-strings -Waggregate-return 
-Winline -W -Wno-unused -Wsign-compare  -I./include  -DHAS_JIT -DI386 
-DHAVE_COMPUTED_GOTO  -o jit_cpu.o -c jit_cpu.c
In file included from jit_cpu.c:33:
include/parrot/jit_emit.h:2027: conflicting types for `Parrot_jit_build_call_func'
include/parrot/jit.h:238: previous declaration of `Parrot_jit_build_call_func'
make: *** [jit_cpu.o] Error 1
$ uname -a
Linux macko.med.virginia.edu 2.4.7-10 #1 Thu Sep 6 17:27:27 EDT 2001 i686 unknown
$ perl --version

This is perl, v5.6.1 built for i386-linux

---

-- 
  Matt

  Matthew Zimmerman
  Interdisciplinary Biophysics, University of Virginia
  http://www.people.virginia.edu/~mdz4c/

[perl #19871] Fwd: Introduction and cygwin results

[via RT]

# New Ticket Created by  James Michael DuPont 
# Please include the string:  [perl #19871]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19871 >


Attached is the bug report and test results for 
parrot on cygwin.

--- James Michael DuPont <[EMAIL PROTECTED]> wrote:
> From James Michael DuPont Fri Jan  3 10:51:37 2003
> Received: from [194.202.25.243] by web13305.mail.yahoo.com via HTTP;
> Fri, 03 Jan 2003 10:51:37 PST
> Date: Fri, 3 Jan 2003 10:51:37 -0800 (PST)
> From: James Michael DuPont <[EMAIL PROTECTED]>
> Subject: Introduction and cygwin results
> To: [EMAIL PROTECTED]
> MIME-Version: 1.0
> Content-Type: text/plain; charset=us-ascii
> Content-Length: 2374
> 
> Hi There!
> 
> My name is Mike, and I have decided to pick up on the parrot again.
> You
> seem to be making good progress, let me help you test this thing and
> build some interfaces to other programs.
> 
> Can someone tell me if anyone uses packdump from cvs? is that an
> equivalent to ildasm in dotnet? It seems to be broken. 
> Can I dump an set of instructions from a program into a file, and
> reassemble them? 
> If not, is there a way to dump a parrot program? 
> 
> Is there a way to capture the line number, and comments of a perl6
> program in parrot? What about high level type information?
> 
> I am interested in building a interface from parrot into the
> introspector, that will give you a way to convert your programs
> internals into RDF/XML and visualize and manipulate them via the GUI.
> 
> I am using the redland perl api, and would like to link that into
> parrot.
> 
> We are freezing the gcc interface soon, and because the introspector
> is
> mostly writtten in perl, I think that parrot would be the next step. 
> 
> I would be willing to port my code to the subset of perl/parrot that
> is
> currently supported, where I can i find that? 
> 
> Here is my first test results with parrot under cygwin :
> [SECTION GCC -V] compiler version
> [SECTION MAKE TEST]  results of maketest
> [SECTION PACKDUMP]   compiling error in packdump
> running examples : 
> [SECTION MOPS] 
> [SECTION LIFE]
> 
> Mike
> 
> [SECTION GCC -v]
> gcc -v : 
> Reading specs from /usr/lib/gcc-lib/i686-pc-cygwin/3.2/specs
> Configured with: /netrel/src/gcc-3.2-3/configure --enable
> languages=c,c++,f77,java --enable-libgcj --enable-threads=posix
> --with-system-zlib --enable-nls --without-included-gettext
> --enable-interpreter --disable-sjlj-exceptions
> --disable-version-specific-runtime-libs --enable-shared
> --build=i686-pc-linux --host=i686-pc-cygwin --target=i686-pc-cygwin
> --enable-haifa --prefix=/usr --exec-prefix=/usr --sysconfdir=/etc
> --libdir=/usr/lib --includedir=/nonexistent/include
> --libexecdir=/usr/sbin
> Thread model: posix
> gcc version 3.2 20020927 (prerelease)
> 
> [SECTION MAKE TEST]
> perl t/harness --gc-debug --running-make-test
> t/src/basic.ok
> t/src/exit..ok
> t/src/intlist...ok
> t/src/list..ok
> t/src/manifest..ok
> t/src/sprintf...ok
> t/op/basic..ok
> t/op/bitwiseok
> t/op/comp...ok
> t/op/conv...ok
> t/op/debuginfo..ok
> t/op/gc.ok
> t/op/globalsok
> t/op/hacks..ok
> t/op/ifunless...ok
> t/op/jitok
> t/op/jitn...ok
> t/op/lexicals...ok
> t/op/macro..ok, 1/15 skipped: Await exceptions
> t/op/number.ok
> t/op/rx.ok, 1/23 skipped: Pending some sort of
> lowercasing
> op
> t/op/stacks.ok, 1/35 skipped: Await exceptions
> t/op/string.ok
> t/op/time...ok
> t/op/trans..ok
> t/op/types..ok
> t/pmc/array.ok
> t/pmc/boolean...ok
> t/pmc/intlist...ok
> t/pmc/multiarrayok
> t/pmc/nci...ok, 11/11 skipped: needs jit/i386 and libnci.so
> t/pmc/perlarray.ok
> t/pmc/perlhash..ok
> t/pmc/perlint...ok, 1/5 skipped: add_keyed: not yet
> t/pmc/perlstringok, 1/8 skipped: Pending new version of
> concat_p_p_s
> t/pmc/pmc...ok 31/80# Failed test (t/pmc/pmc.t at line
> 491)
> #  got: '2.70
> # '
> # expected: 'bar2.70
> # '
> t/pmc/pmc...ok 79/80# Looks like you failed 1 tests of 80.
> t/pmc/pmc...dubious
> Test returned status 1 (wstat 256, 0x100)
> DIED. FAILED test 32
> Failed 1/80 tests, 98.75% okay (-2 skipped tests: 77 okay,
> 96.25%)
> t/pmc/prop..ok
> t/pmc/scratchpadok
> t/pmc/sub...ok
> Failed Test Status Wstat Total Fail  Failed  List of Failed
>
---
> 
> t/pmc/pmc.t1   256801   1.25%  32
> 18 subtests skipped.
> Failed 1/42 test scripts, 97.62% okay. 1/584 subtests failed, 99.83%
> okay.
> make: *** [test_dummy] Error 2
> 
> [SECTION PACKDUMP]
> make packdump.exe
> packdump.c: In function `PackFile_Constant_dump':
> packdump.c:111: structure has no member n

[perl #19872] Fwd: Re: Introduction and cygwin results

[via RT]

# New Ticket Created by  James Michael DuPont 
# Please include the string:  [perl #19872]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19872 >


Missing header file for cygwin

--- James Michael DuPont <[EMAIL PROTECTED]> wrote:
> From James Michael DuPont Fri Jan  3 11:01:39 2003
> Received: from [194.202.25.243] by web13307.mail.yahoo.com via HTTP;
> Fri, 03 Jan 2003 11:01:39 PST
> Date: Fri, 3 Jan 2003 11:01:39 -0800 (PST)
> From: James Michael DuPont <[EMAIL PROTECTED]>
> Subject: Re: Introduction and cygwin results
> To: [EMAIL PROTECTED]
> In-Reply-To: <[EMAIL PROTECTED]>
> MIME-Version: 1.0
> Content-Type: text/plain; charset=us-ascii
> Content-Length: 978
> 
> 
> --- James Michael DuPont <[EMAIL PROTECTED]> wrote:
> > Hi There!
> 
> > [SECTION PACKDUMP]
> > make packdump.exe
> > packdump.c: In function `PackFile_Constant_dump':
> > packdump.c:111: structure has no member named `flags'
> > make: *** [packdump.o] Error 1
> > 
> > I have commented that out for now : 
> > /*PIO_printf(interpreter, "FLAGS=>
> > 0x%04lx,\n",
> >(long)self->string->flags);
> > */
> 
> Oopps : more then that : 
> pdump.c: In function `main':
> pdump.c:21: storage size of `file_stat' isn't known
> pdump.c:37: `O_RDONLY' undeclared (first use in this function)
> pdump.c:37: (Each undeclared identifier is reported only once
> pdump.c:37: for each function it appears in.)
> 
> under cygwin you need :
> #include 
> 
> 
> mike
> 
> 
> =
> James Michael DuPont
> http://introspector.sourceforge.net/
> 
> __
> Do you Yahoo!?
> Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
> http://mailplus.yahoo.com
> 


=
James Michael DuPont
http://introspector.sourceforge.net/

__
Do you Yahoo!?
Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
http://mailplus.yahoo.com

[perl #19873] Fwd: perl6 testing on mingw32

[via RT]

# New Ticket Created by  James Michael DuPont 
# Please include the string:  [perl #19873]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19873 >


bug report for parrot/languages/perl6
mike

--- James Michael DuPont <[EMAIL PROTECTED]> wrote:
> From James Michael DuPont Mon Jan  6 04:53:01 2003
> Received: from [194.202.25.243] by web13301.mail.yahoo.com via HTTP;
> Mon, 06 Jan 2003 04:53:01 PST
> Date: Mon, 6 Jan 2003 04:53:01 -0800 (PST)
> From: James Michael DuPont <[EMAIL PROTECTED]>
> Subject: perl6 testing on mingw32
> To: Leopold Toetsch <[EMAIL PROTECTED]>, P6I <[EMAIL PROTECTED]>
> In-Reply-To: <[EMAIL PROTECTED]>
> MIME-Version: 1.0
> Content-Type: text/plain; charset=us-ascii
> Content-Length: 843
> 
> first of all :
> to run this, it needs a -I.
> 
> second of all, the test has errors 
> the Perl6grammar.pm did not return a true value at (eval 58) line 3.
> can be ignored, because via some magic, it is regenerated.
> 
> I get the following error
> >>WHOA!  Somehow you got a different number of results than tests
> ran!
> >>This should never happen!  Please contact the author immediately!
> >>END failed--call queue aborted.
> 
> test results :
>
---
> mdupont@PI
> /cygdrive/c/development/testing/parrot/parrot/languages/perl6
> $ perl -I. ./perl6 --test
> Perl6grammar.pm did not return a true value at (eval 58) line 3.
> 
> Test details:
> t/builtins/array.t2/3
> t/builtins/string.t...4/4
> t/compiler/1.t..14/14
> t/compiler/2.t5/5
> t/compiler/3.t7/7
> t/compiler/4.t3/3
> t/compiler/5.t5/5
> t/compiler/6.t6/6
> t/compiler/7.t1/1
> t/compiler/8.t6/6
> t/compiler/9.t4/4
> t/compiler/a.t3/3
> t/compiler/b.t6/6
> t/compiler/c.t6/6
> t/compiler/qsort.t1/1
> t/rx/basic.t..6/6
> t/rx/call.t...2/2
> t/rx/special.t2/2
> 
> Test summary:
> t/builtins/array.tesok, 2/3 skipped: various reasons
> t/builtins/string.tesok
> t/compiler/1.tesok
> t/compiler/2.tesok
> t/compiler/3.tesok
> t/compiler/4.tesok
> t/compiler/5.tesok
> t/compiler/6.tesok
> t/compiler/7.tesok
> t/compiler/8.tesok
> t/compiler/9.tesok
> t/compiler/a.tesok
> t/compiler/b.tesok
> t/compiler/c.tesok
> t/compiler/qsort.tesok
> t/rx/basic.tes..ok
> t/rx/call.tes...ok
> t/rx/special.tesok
> All tests successful, 2 subtests skipped.
> Files=18, Tests=84,  3 wallclock secs ( 0.79 cusr +  1.03 csys = 
> 1.82
> CPU)
> WHOA!  Somehow you got a different number of results than tests ran!
> This should never happen!  Please contact the author immediately!
> END failed--call queue aborted.
> 
> 
> =
> James Michael DuPont
> http://introspector.sourceforge.net/
> 
> __
> Do you Yahoo!?
> Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
> http://mailplus.yahoo.com
> 


=
James Michael DuPont
http://introspector.sourceforge.net/

__
Do you Yahoo!?
Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
http://mailplus.yahoo.com

[perl #19874] Patch for pdump

[via RT]

# New Ticket Created by  James Michael DuPont 
# Please include the string:  [perl #19874]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=19874 >


this is the patch to compile pdump under linux
basically it removes a field that was not used anymore

--- James Michael DuPont <[EMAIL PROTECTED]> wrote:
> From James Michael DuPont Sat Jan  4 08:22:46 2003
> Received: from [80.128.234.119] by web13302.mail.yahoo.com via HTTP;
> Sat, 04 Jan 2003 08:22:46 PST
> Date: Sat, 4 Jan 2003 08:22:46 -0800 (PST)
> From: James Michael DuPont <[EMAIL PROTECTED]>
> Subject: Re: Introduction and cygwin results
> To: Dan Sugalski <[EMAIL PROTECTED]>, [EMAIL PROTECTED]
> In-Reply-To: 
> MIME-Version: 1.0
> Content-Type: text/plain; charset=us-ascii
> Content-Length: 1284
> 
> 
> --- Dan Sugalski <[EMAIL PROTECTED]> wrote:
> > At 10:51 AM -0800 1/3/03, James Michael DuPont wrote:
> > >Can someone tell me if anyone uses packdump from cvs? is that an
> > >equivalent to ildasm in dotnet? It seems to be broken.
> > >Can I dump an set of instructions from a program into a file, and
> > >reassemble them?
> > >If not, is there a way to dump a parrot program?
> > 
> > Not that I know of, I think so, damn, you should be able to, and no
> 
> > no other way.
> 
> Here is my patch for pdump :
> But the pdump does not disassemble... i have to look into
> dissassemble.pl
> 
> Index: packdump.c
> ===
> RCS file: /cvs/public/parrot/packdump.c,v
> retrieving revision 1.6
> diff -u -r1.6 packdump.c
> --- packdump.c2 Nov 2002 14:57:47 -   1.6
> +++ packdump.c4 Jan 2003 16:18:37 -
> @@ -107,8 +107,13 @@
>  
>  case PFC_STRING:
>  PIO_printf(interpreter, "[ 'PFC_STRING', {\n");
> -PIO_printf(interpreter, "FLAGS=> 0x%04lx,\n",
> +
> +#ifdef HAS_parrot_string_t_flags
> +
> +PIO_printf(interpreter, "FLAGS=>
> 0x%04lx,\n",
> (long)self->string->flags);
> +#endif 
> +
>  PIO_printf(interpreter, "ENCODING => %s,\n",
> self->string->encoding->name);
>  PIO_printf(interpreter, "TYPE => %s,\n",
> 
> Anyone working on cross compiling? I have a setup here for cross
> compiling from debian to windows, but always use autoconf to do that.
> Anyone have an idea?
> 
> > 
> > >Is there a way to capture the line number, and comments of a perl6
> > >program in parrot? What about high level type information?
> > 
> > Line number, yes. Comments, probably not, though it's possible that
> 
> > info can get embedded. What type of high-level info are you looking
> 
> > for? We've all sorts. :)
> well as much as you can give me.
> 
> > Seriously, if you're looking for variable 
> > type info, it'll potentially be there, assuming that it's not been 
> > stripped out.
> 
> OK, that is good.
> 
> > 
> > >I would be willing to port my code to the subset of perl/parrot
> that
> > is
> > >currently supported, where I can i find that?
> > 
> > Perl 6 is in languages/perl6, though I think that there's still
> some 
> > stuff missing.
> Well, I will try that out. Thanks,
> 
> mike
> 
> =
> James Michael DuPont
> http://introspector.sourceforge.net/
> 
> __
> Do you Yahoo!?
> Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
> http://mailplus.yahoo.com
> 


=
James Michael DuPont
http://introspector.sourceforge.net/

__
Do you Yahoo!?
Yahoo! Mail Plus - Powerful. Affordable. Sign up now.
http://mailplus.yahoo.com

[perl #20315] [PATCH] eval

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #20315]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20315 >


Attached is a first try towards eval.

- interpreter has a new data member Parrot_compreg_hash
- parrot registers the PASM1 type i.e. what PDB_eval can parse
- the new B opcode (ab)uses nci to build a function for calling 
PDB_eval
- nci is extended (jit/i386 only), to understand an 'I' param as interpreter
- the string is evaled immediately, we don't have multiple byte code 
segments yet

No registers, which nci uses, are preserved, no error checking and so 
on, but works ;-)

Some questions arise here:
- Should the B opcode also have a form with a label to build 
PASM compilers, ook?
- is using the NCI interface ok for evals purpose?
- how should a byte code segment (PMC) look like?

Comment welcome
leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/48556/37739/ade5a5/eval.patch


--- parrot/classes/csub.pmc Fri Jan 10 18:05:02 2003
+++ parrot-leo/classes/csub.pmc Tue Jan 14 19:06:24 2003
@@ -49,7 +49,7 @@
 return SELF->cache.struct_val != NULL;
 }
 
-void * invoke (void * next) {
+void* invoke (void * next) {
 Parrot_csub_t func = (Parrot_csub_t)SELF->cache.struct_val;
 func(INTERP, SELF);
 return next;
--- parrot/core.ops Tue Jan 14 09:09:55 2003
+++ parrot-leo/core.ops Tue Jan 14 19:25:19 2003
@@ -4485,6 +4485,10 @@
 
 Call the subroutine in P0, as described in PDD03.
 
+=item B(out PMC, in STR, in STR)
+
+Compile source code $2 of a registered source type $3 into PMC $1.
+
 =cut
 
 inline op loadext(in STR, in STR) {
@@ -4547,6 +4551,19 @@
 
   goto ADDRESS(dest);
 }
+
+inline op compile(OUT PMC, in STR, in STR) {
+  opcode_t *dest;
+  PMC *key = key_new_string(interpreter, $3);
+  PMC *func = interpreter->Parrot_compreg_hash->vtable->get_pmc_keyed(
+interpreter, interpreter->Parrot_compreg_hash, key);
+  /* XXX undef */
+  interpreter->ctx.string_reg.registers[5] = $2;   /* XXX */
+  dest = (opcode_t *)func->vtable->invoke(interpreter, func, expr NEXT());
+  /* XXX retval */
+  goto ADDRESS(dest);
+}
+
 
 =item B(out PMC, in PMC, in STR)
 
--- parrot/dod.cTue Jan 14 09:09:55 2003
+++ parrot-leo/dod.cTue Jan 14 18:51:15 2003
@@ -104,6 +104,8 @@
 /* mark it as used  */
 pobject_lives(interpreter, (PObj *)current);
 
+if (interpreter->Parrot_compreg_hash)
+pobject_lives(interpreter, (PObj *)interpreter->Parrot_compreg_hash);
 /* Now, go run through the PMC registers and mark them as live */
 /* First mark the current set. */
 for (i = 0; i < NUM_REGISTERS; i++) {
--- parrot/include/parrot/interpreter.h Sat Jan  4 12:35:22 2003
+++ parrot-leo/include/parrot/interpreter.h Tue Jan 14 18:13:08 2003
@@ -169,6 +169,7 @@
 INTVAL world_inited;/* Parrot_init is done */
 PMC *mark_ptr; /* last PMC marked used in DOD runs */
 PMC *Parrot_base_classname_hash;/* hash containing name->base_type */
+PMC *Parrot_compreg_hash;   /* hash containing assembler/compilers */
 } Interp;
 
 #define PCONST(i) PF_CONST(interpreter->code, (i))
@@ -189,6 +190,7 @@
 VAR_SCOPE opcode_t *(*run_native)(struct Parrot_Interp * interpreter,
   opcode_t * cur_opcode,
   opcode_t * start_code);
+void Parrot_compreg(Parrot_Interp interpreter, STRING *type, PMC *func);
 
 #endif   /* Parrot core */
 
--- parrot/interpreter.cSat Jan 11 09:39:08 2003
+++ parrot-leo/interpreter.cTue Jan 14 19:21:00 2003
@@ -21,11 +21,13 @@
 #ifdef HAVE_COMPUTED_GOTO
 #  include "parrot/oplib/core_ops_cg.h"
 #endif
+#include "parrot/method_util.h"
 
 #define ATEXIT_DESTROY
 
 extern op_lib_t *PARROT_CORE_PREDEREF_OPLIB_INIT(void);
 
+static void setup_default_compreg(Parrot_Interp interpreter);
 
 /*=for api interpreter runops_generic
  * TODO: Not really part of the API, but here's the docs.
@@ -512,6 +514,10 @@
 SET_NULL_P(interpreter->prederef_code, void **);
 SET_NULL(interpreter->jit_info);
 
+SET_NULL_P(interpreter->Parrot_compreg_hash, PMC *);
+/* register assembler/compilers */
+setup_default_compreg(interpreter);
+
 /* Done. Return and be done with it */
 
 /* Okay, we've finished doing anything that might trigger GC.
@@ -686,6 +692,42 @@
 }
 return ret;
 }
+
+/*=for api interpreter Parrot_compreg
+ * register a parser/compiler function
+ */
+
+void Parrot_compreg(Parrot_Interp interpreter, STRING *type, PMC *func)
+{
+PMC* key, *hash;
+if (!interpreter->Parrot_compreg_hash) {
+hash = interpreter->Parrot_compreg_hash =
+pmc_new_noinit(interpreter, enum_class_PerlHash);
+hash->vtable->init(interpreter, hash);
+}
+key = key_new_string(interpreter, type);
+hash->vtable->set_pmc_keye

[perl #20320] [PATCH] bring pdd06_pasm.pod up to date

[via RT]

# New Ticket Created by  Jonathan Sillito 
# Please include the string:  [perl #20320]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20320 >


The documentation for the lexical ops in pdd06_pasm.pod has gotten out of
date. I do not like maintaining documentation in more than one place, so in
pdd06_pasm.pod I put a terse (but correct) description along with a
reference to the generated documentation in docs/core_ops.pod. Is that
suitable?

In addition to changes to pdd06, the attached patch also adds documentation
for the push_pad op to core.ops, which I somehow missed.

--
Jonathan Sillito


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/48635/37746/ca96a3/documentation.patch




documentation.patch
Description: documentation.patch

[perl #20355] [PATCH] Incorrect ifdef nesting in cpu_dep.c

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #20355]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20355 >


I don't think the ifdef logic is quite right in cpu_dep.c.  Specifically,
if either __sparc or __ia64__ is defined, then *both* the cpu-dependent
register flushing *and* the setjmp-using register flushing tricks are
used.

This actually shows up as a syntax error on the "frivolous" tinderbox.

The enclosed patch changes the logic to what I suspect was actually
intended.

--- parrot-current/cpu_dep.cSat Jan  4 03:00:09 2003
+++ parrot-andy/cpu_dep.c   Thu Jan 16 13:49:32 2003
@@ -26,7 +26,7 @@
 trace_system_areas(struct Parrot_Interp *interpreter)
 {
 
-#ifdef __sparc /* Flush register windows */
+#if defined(__sparc) /* Flush register windows */
 static union {
int insns[4];
 double align_hack[2];
@@ -42,10 +42,8 @@
 
 static void (*fn_ptr)(void) = (void (*)(void))&u.align_hack[0];
 fn_ptr();
-#endif
 
-
-#ifdef __ia64__
+#elif defined(__ia64__)
 
 struct ucontext ucp;
 void *current_regstore_top;

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #20358] [BUG] disassemble still

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #20358]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20358 >


disassemble sometimes takes huge amounts of mem and dies.
I'm using disassemble to get a test coverage of ops with this shell script:

#!/bin/sh
# op-stat
DIS=disassemble
[ -e .op-list1 ] && rm .op-list1
[ -e op-list-all ] && rm op-list-all
[ -e op-list-s ] && rm op-list-s
find . -name '*.pbc' -fprint /dev/stderr -exec $DIS {} \; |
   sed -e's/^[[:blank:]]*L[0-9]*://' | \
   sed -e's/^[[:blank:]]+//' | cut -d\  -f1 >> .op-list1
sort < .op-list1 | uniq -c | sort -rg > op-list-all
sort < .op-list1 | sed -e's/_.*//' | uniq -c | sort -rg > op-list-s
echo
T=`grep NAME lib/Parrot/OpLib/core.pm | wc -l`
S=`grep NAME lib/Parrot/OpLib/core.pm | sort | uniq | wc -l`
echo total ops $T
echo ops types $S
echo op usage stat
wc -l op-list* | head -2

[perl #20374] Solaris tinderbox failures: PANIC: Unknown signature type

[via RT]

# New Ticket Created by  Andy Dougherty 
# Please include the string:  [perl #20374]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20374 >


The Solaris tinderboxes are failing with the unhelpful message
"PANIC:  Unknown signature type".  Would it be possible to include
the signature type that was failing to match in the error message?

In this case, I suspect it's failing to match "pIt", which was recently
added to interpeter.c:setup_default_compreg().

-- 
Andy Dougherty  [EMAIL PROTECTED]

[perl #20400] [PATCH] ook.pasm eval

[via RT]

# New Ticket Created by  Leon Brocard 
# Please include the string:  [perl #20400]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20400 >


It's PASM1, not PASM. However, "make test" in languages/ook/ still
segfaults for me atm.

Leon
-- 
Leon Brocard.http://www.astray.com/
scribot.http://www.scribot.com/

... Always forgive your enemies, nothing annoys them so much


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/48981/37965/f9e9a5/ook.pasm.patch


Index: ook.pasm
===
RCS file: /cvs/public/parrot/languages/ook/ook.pasm,v
retrieving revision 1.2
diff -u -r1.2 ook.pasm
--- ook.pasm17 Jan 2003 15:11:17 -  1.2
+++ ook.pasm19 Jan 2003 11:30:53 -
@@ -104,7 +104,7 @@
 #print S4
# needs imcc:
# ../imcc/imcc -r ook.pasm hello.ook
-   compreg P1, "PASM"
+   compreg P1, "PASM1"
compile P0, P1, S4
invoke
 end

[perl #20584] [PATCH] packfile #5

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #20584]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20584 >


This is a first try to solve the packfile wordsize issues.
Could people with 64 bit machines please test this.

Also committing some test files to t/native_pbc would be appreciated.

TIA,
leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/49836/38410/a8b2d5/packfile5.patch


--- parrot/include/parrot/packfile.hTue Jan 28 10:21:49 2003
+++ parrot-leo/include/parrot/packfile.hTue Jan 28 12:56:08 2003
@@ -319,11 +319,13 @@
 opcode_t * PackFile_Constant_unpack_key(struct Parrot_Interp *interpreter,
 struct PackFile * pf, struct PackFile_Constant *, opcode_t * packed);
 
-opcode_t PackFile_fetch_op(struct PackFile *pf, opcode_t *stream);
+opcode_t PackFile_fetch_op(struct PackFile *pf, opcode_t **stream);
 
-INTVAL PackFile_fetch_iv(struct PackFile *pf, opcode_t *stream);
+INTVAL PackFile_fetch_iv(struct PackFile *pf, opcode_t **stream);
 
 FLOATVAL PackFile_fetch_nv(struct PackFile *pf, opcode_t **stream);
+
+char * PackFile_fetch_cstring(struct PackFile *pf, opcode_t **stream);
 
 void PackFile_assign_transforms(struct PackFile *pf);
 
--- parrot/packfile.c   Tue Jan 28 10:21:48 2003
+++ parrot-leo/packfile.c   Tue Jan 28 14:26:02 2003
@@ -95,13 +95,16 @@
 ***/
 
 opcode_t
-PackFile_fetch_op(struct PackFile *pf, opcode_t *stream) {
-if(pf->fetch_op == NULL)
-return *stream;
+PackFile_fetch_op(struct PackFile *pf, opcode_t **stream) {
+opcode_t o;
+if (!pf->fetch_op)
+return *(*stream)++;
 #if TRACE_PACKFILE == 2
 PIO_eprintf(NULL, "PackFile_fetch_op: Reordering.\n");
 #endif
-return (pf->fetch_op)(*stream);
+o = (pf->fetch_op)(**stream);
+((unsigned char *) (*stream)) += pf->header->wordsize;
+return o;
 }
 
 /***
@@ -116,10 +119,12 @@
 ***/
 
 INTVAL
-PackFile_fetch_iv(struct PackFile *pf, opcode_t *stream) {
+PackFile_fetch_iv(struct PackFile *pf, opcode_t **stream) {
 if(pf->fetch_iv == NULL)
-return *stream;
-return (pf->fetch_iv)(*stream);
+return *(*stream++);
+PIO_eprintf(NULL, "PackFile_fetch_iv: Unsupported.\n");
+exit(1);
+return (pf->fetch_iv)(**stream);
 }
 
 /***
@@ -142,7 +147,7 @@
 FLOATVAL f;
 HUGEFLOATVAL g;
 double d;
-if(pf->fetch_nv == NULL) {
+if (!pf->fetch_nv) {
 #if TRACE_PACKFILE
 PIO_eprintf(NULL, "PackFile_fetch_nv: Native [%d bytes]..\n",
 sizeof(FLOATVAL));
@@ -171,14 +176,52 @@
 return f;
 }
 
+static opcode_t
+fetch_op_mixed(opcode_t b)
+{
+union {
+unsigned char buf[8];
+opcode_t o1;
+opcode_t o2;
+} u;
+opcode_t o;
+
+#if PARROT_BIGENDIAN
+#  if OPCODE_T_SIZE == 4
+ /* wordsize = 8 then */
+ fetch_buf_le_8(u.buf, (unsigned char *) b);
+ return u.o2; /* or u.o1 */
+#  else
+ o = fetch_op_le(b);/* or fetch_be_le_4 and convert? */
+ return o >> 32;/* or o & 0x */
+#  endif
+#else
+#  if OPCODE_T_SIZE == 4
+ /* wordsize = 8 then */
+ fetch_buf_be_8(u.buf, (unsigned char *) b);
+ return u.o1; /* or u.o2 */
+#  else
+ o = fetch_op_be(b);
+ return o & 0x;
+#  endif
+
+#endif
+}
 /*
  * Assign transform functions to vtable
  */
-void PackFile_assign_transforms(struct PackFile *pf) {
+void
+PackFile_assign_transforms(struct PackFile *pf) {
 #if PARROT_BIGENDIAN
 if(pf->header->byteorder != PARROT_BIGENDIAN) {
 pf->need_endianize = 1;
+if (pf->header->wordsize == sizeof(opcode_t))
 pf->fetch_op = fetch_op_le;
+else {
+pf->need_wordsize = 1;
+pf->fetch_op = fetch_op_mixed;
+}
+
 pf->fetch_iv = fetch_iv_le;
 if (pf->header->floattype == 0)
 pf->fetch_nv = fetch_buf_le_8;
@@ -188,7 +231,13 @@
 #else
 if(pf->header->byteorder != PARROT_BIGENDIAN) {
 pf->need_endianize = 1;
+if (pf->header->wordsize == sizeof(opcode_t)) {
 pf->fetch_op = fetch_op_be;
+}
+else {
+pf->need_wordsize = 1;
+pf->fetch_op = fetch_op_mixed;
+}
 pf->fetch_iv = fetch_iv_be;
 if (pf->header->floattype == 0)
 pf->fetch_nv = fetch_buf_be_8;
@@ -201,12 +250,16 @@
 else if (NUMVAL_SIZE != 8 && pf->header->floattype == 0)
 pf->fetch_nv = fetch_buf_le_8;
 /* XXX else */
+}
 #  if TRACE_PACKFILE
 PIO_eprintf(NULL, "header->byteorder [%d] native byteorder [%d]\n",
 pf->header->byteorder, PARROT_BIGENDIAN);
 #  endif
-}
 #endif
+if (pf->header->wordsize != sizeof(opcode_t)) {
+pf->need_wordsize = 1

[perl #20592] [PATCH] save and restore more of a coroutine's context (and more)

[via RT]

# New Ticket Created by  Jonathan Sillito 
# Please include the string:  [perl #20592]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20592 >


A description of each attachment:

1) coroutine.t (which should be put in t/pmc/) exposes some errors in our
coroutine code.

2) coroutine.patch fixes those errors by saving and restoring more of the
coroutine's context. More specifically the user_stack, control_stack and
pad_stack.

3) document.patch (some of this this was submitted before but not applied)
adds documentation for the push_pad op to core.ops, which I somehow missed.
It also brings pdd06_pasm.pod up to date. I do not like maintaining
documentation in more than one place, so in pdd06_pasm.pod I put a terse
(but correct) description along with a reference to the generated
documentation in docs/core_ops.pod. Is that suitable???

And a couple of questions:

1) I was thinking of writing a couple of short "how to" documents aimed at
compiler writers. Is there interest in something like this?

2) Which of the following names are consistent with our current naming
convention?

   new_coroutine
   coroutine_new

Thanks!
--
Jonathan Sillito


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/49853/38427/66cf1f/coroutine.t

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/49853/38428/c9fd23/coroutine.patch

-- attachment  3 --
url: http://rt.perl.org/rt2/attach/49853/38429/34393f/document.patch




coroutine.t
Description: coroutine.t


coroutine.patch
Description: coroutine.patch


document.patch
Description: document.patch

[perl #20597] [PATCH] packfile #6

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #20597]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20597 >


Next try. This patch obsoletes #20584.

- more wordsize fixes
- routine for converting i386 12 byte long double to IEEE (modulo NaN's 
and such)
- the latter needs still work, if machine is big endian, but swapping 
buffer bytes before or after ;-) could do it.

Thanks for testing.
leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/49861/38438/6d8a85/packfile6.patch


--- parrot/include/parrot/packfile.hTue Jan 28 10:21:49 2003
+++ parrot-leo/include/parrot/packfile.hTue Jan 28 12:56:08 2003
@@ -319,11 +319,13 @@
 opcode_t * PackFile_Constant_unpack_key(struct Parrot_Interp *interpreter,
 struct PackFile * pf, struct PackFile_Constant *, opcode_t * packed);
 
-opcode_t PackFile_fetch_op(struct PackFile *pf, opcode_t *stream);
+opcode_t PackFile_fetch_op(struct PackFile *pf, opcode_t **stream);
 
-INTVAL PackFile_fetch_iv(struct PackFile *pf, opcode_t *stream);
+INTVAL PackFile_fetch_iv(struct PackFile *pf, opcode_t **stream);
 
 FLOATVAL PackFile_fetch_nv(struct PackFile *pf, opcode_t **stream);
+
+char * PackFile_fetch_cstring(struct PackFile *pf, opcode_t **stream);
 
 void PackFile_assign_transforms(struct PackFile *pf);
 
--- parrot/packfile.c   Tue Jan 28 10:21:48 2003
+++ parrot-leo/packfile.c   Wed Jan 29 08:57:06 2003
@@ -95,13 +95,16 @@
 ***/
 
 opcode_t
-PackFile_fetch_op(struct PackFile *pf, opcode_t *stream) {
-if(pf->fetch_op == NULL)
-return *stream;
+PackFile_fetch_op(struct PackFile *pf, opcode_t **stream) {
+opcode_t o;
+if (!pf->fetch_op)
+return *(*stream)++;
 #if TRACE_PACKFILE == 2
 PIO_eprintf(NULL, "PackFile_fetch_op: Reordering.\n");
 #endif
-return (pf->fetch_op)(*stream);
+o = (pf->fetch_op)(**stream);
+((unsigned char *) (*stream)) += pf->header->wordsize;
+return o;
 }
 
 /***
@@ -116,12 +119,53 @@
 ***/
 
 INTVAL
-PackFile_fetch_iv(struct PackFile *pf, opcode_t *stream) {
+PackFile_fetch_iv(struct PackFile *pf, opcode_t **stream) {
 if(pf->fetch_iv == NULL)
-return *stream;
-return (pf->fetch_iv)(*stream);
+return *(*stream++);
+PIO_eprintf(NULL, "PackFile_fetch_iv: Unsupported.\n");
+exit(1);
+return (pf->fetch_iv)(**stream);
 }
 
+/* convert i386 LE 12 byte long double to IEEE 8 byte doubles
+ * TODO: nan's and such
+ */
+static void cvt_num12_num8(unsigned char *dest, unsigned char *src)
+{
+int expo, i, s;
+
+memset (dest, 0, 8);
+/* exponents 15 -> 11 bits */
+s = src[9] & 0x80; /* sign */
+expo = ((src[9] & 0x7f)<< 8 | src[8]) - 16383;  /* - bias */
+expo += 1023;   /* + bias 8byte */
+expo <<= 4;
+dest[6] = (expo & 0xff);
+dest[7] = (expo & 0x7f00) >> 8;
+if (s)
+dest[7] |= 0x80;
+/* long double frac 63 bits => 52 bits
+   src[7] &= 0x7f; reset integer bit */
+for (i = 0; i < 6; i++) {
+dest[i+1] |= (i==5 ? src[7]&0x7f : src[i+2]) >> 3;
+dest[i] |= (src[i+2] & 0x1f) << 5;
+}
+dest[0] |= src[1] >> 3;
+}
+
+static void cvt_num12_num8_be(unsigned char *dest, unsigned char *src)
+{
+cvt_num12_num8(dest, src);
+/* TODO endianize */
+internal_exception(1, "TODO cvt_num12_num8_be\n");
+}
+
+static void cvt_num12_num8_le(unsigned char *dest, unsigned char *src)
+{
+cvt_num12_num8(dest, src);
+/* TODO endianize */
+internal_exception(1, "TODO cvt_num12_num8_le\n");
+}
 /***
 
 =item fetch_nv
@@ -140,9 +184,8 @@
  * to use memcpy() for native byteorder.
  */
 FLOATVAL f;
-HUGEFLOATVAL g;
 double d;
-if(pf->fetch_nv == NULL) {
+if (!pf->fetch_nv) {
 #if TRACE_PACKFILE
 PIO_eprintf(NULL, "PackFile_fetch_nv: Native [%d bytes]..\n",
 sizeof(FLOATVAL));
@@ -153,15 +196,13 @@
 return f;
 }
 f = (FLOATVAL) 0;
-g = (HUGEFLOATVAL) 0;
 #if TRACE_PACKFILE
 PIO_eprintf(NULL, "PackFile_fetch_nv: Byteordering..\n");
 #endif
 /* Here is where the size transforms get messy */
 if (NUMVAL_SIZE == 8 && pf->header->floattype == 1) {
-(pf->fetch_nv)((unsigned char *)&g, (unsigned char *) *stream);
+(pf->fetch_nv)((unsigned char *)&f, (unsigned char *) *stream);
 ((unsigned char *) (*stream)) += 12;
-f = g;
 }
 else {
 (pf->fetch_nv)((unsigned char *)&d, (unsigned char *) *stream);
@@ -171,42 +212,90 @@
 return f;
 }
 
+static opcode_t
+fetch_op_mixed(opcode_t b)
+{
+union {
+unsigned char buf[8];
+opcode_t o1;
+opcode_t o2;
+} u;
+opcode_t o;
+
+#if PARROT_BIGENDIAN
+#  if OPCODE_T_SIZE == 4
+ /*

[perl #20666] Assemble.pl Reports Incorrect Line Numbers after Removal of Macros

[via RT]

# New Ticket Created by  Joe Yates 
# Please include the string:  [perl #20666]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20666 >


Line numbers reported by Assemble.pl are array indices AFTER the removal of 
macros.

This code:
xxx
.constant FirstConstant "1"
yyy
.constant SecondConstant "2"
zzz

Gets this error:
Couldn't find operator 'xxx' on line 1.
Couldn't find operator 'yyy' on line 2.
Couldn't find operator 'zzz' on line 3.

The second and third errors should report lines 2 and 3.

Joe Yates

[perl #20707] Major packfile(?) breakage

[via RT]

# New Ticket Created by  Simon Glover 
# Please include the string:  [perl #20707]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20707 >



 A fresh check-out of parrot from CVS is giving me a huge number of
 failing tests:

Failed TestStat Wstat Total Fail  Failed  List of Failed
---
t/op/arithmetics.t   17  435226   17  65.38%  7-14 18-26
t/op/hacks.t  1   256 31  33.33%  2
t/op/ifunless.t   2   512 62  33.33%  2 5
t/op/integer.t1   256381   2.63%  4
t/op/jitn.t   1   256 91  11.11%  9
t/op/number.t33  844837   33  89.19%  1-29 31 34-36
t/op/stacks.t 6  1536356  17.14%  5 26-27 33-35
t/op/string.t 2   512992   2.02%  89 97
t/op/time.t   1   256 41  25.00%  2
t/op/trans.t 18  460818   18 100.00%  1-18
t/pmc/array.t 2   512 72  28.57%  2-3
t/pmc/boolean.t   1   256 61  16.67%  2
t/pmc/perlarray.t 8  2048228  36.36%  2-3 5-6 11-12 16-17
t/pmc/perlhash.t  6  1536246  25.00%  1 11 13-15 18
t/pmc/perlint.t   2   512 52  40.00%  4-5
t/pmc/perlstring.t3   768 83  37.50%  1 3 7
t/pmc/pmc.t  46 1177680   46  57.50%  12-28 31-32 36 39-42 44-47
  50-51 55-56 60-64 69 72-78 80
t/src/sprintf.t   1   256 21  50.00%  1


 This seems to be packfile-related, since the consistent theme is the
 error message:  'Constant_unpack: Unrecognized type '' during unpack!'

 Also, the bug is apparently related to the fact that I'm using a perl
 compiled with -Duselongdouble; if I use the system perl, which was
 compiled with -Uuselongdouble, then all the tests pass. [Note, however,
 that my perl is 5.8.0, whereas the system perl is 5.6.0 -- I don't think
 this has anything to do with the difference, but I can't rule it out].

 Other than the above, I'm on a pretty standard Linux/x86 system - I can
 provide more details if required.

 Simon

[perl #20786] PATCH: bf compiler

[via RT]

# New Ticket Created by  Leon Brocard 
# Please include the string:  [perl #20786]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20786 >


Attached is a bf compiler for languages/bf/ and a patch to the
makefile to make and test it.

The actual compiler is a bit slow on large bf programs - the culprit
being concat. Oh well, at least they run fast once compiled.

Cheers, Leon
-- 
Leon Brocard.http://www.astray.com/
scribot.http://www.scribot.com/

... I haven't lost my mind -- it's backed up on tape somewhere


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/50591/38842/9e1900/bf.in.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/50591/38843/a7fbdf/bfc.pasm


Index: config/gen/makefiles/bf.in
===
RCS file: /cvs/public/parrot/config/gen/makefiles/bf.in,v
retrieving revision 1.1
diff -u -r1.1 bf.in
--- config/gen/makefiles/bf.in  9 Dec 2002 04:00:24 -   1.1
+++ config/gen/makefiles/bf.in  8 Feb 2003 12:44:38 -
@@ -3,14 +3,17 @@
 
 ASSEMBLE=$(PERL) ../../assemble.pl
 PARROT=../../parrot
+IMCC=../imcc/imcc
 
 all: build
 
 test: build
$(PARROT) bf.pbc test.bf
+   $(IMCC) -r bfc.pbc test.bf
 
 build: bf.pasm
$(ASSEMBLE) bf.pasm > bf.pbc
+   $(IMCC) -o bfc.pbc bfc.pasm
 
 clean:
$(RM_F) core *.pbc *~

# $Id: bfc.pasm,v 1.1 2002/12/09 04:00:27 sfink Exp $
# A Brainfuck compiler
# By Leon Brocard <[EMAIL PROTECTED]>
# 
# See http://www.catseye.mb.ca/esoteric/bf/
# for more information on this silly language

  # Get the brainfuck source file into S0
  set S0, P0[1]
  if S0, SOURCE
  set S0, P0[0]
  print "usage: ../imcc/imcc -r "
  print S0
  print " file.bf\n"
  end

  # Read the file into S1
SOURCE:
  open I0, S0
SOURCE_LOOP:
  readline S2, I0
  concat S1, S2
  if S2, SOURCE_LOOP
  close I0

  length I30, S1

  # Initialise
  set S3,"set I0, 0  # pc\n"
  concat S3, "new P0, .PerlArray # memory\n"
  concat S3, "set I1, 0  # pointer\n"

  set I0, 0 # pc
  set I3, 0 # label count

  # The main interpreter loop
INTERP:
  substr S0, S1, I0, 1
  concat S3, "\nSTEP"
  setS4, I0
  concat S3, S4
  concat S3, ": # "
  concat S3, S0
  concat S3, "\n"

#  concat S3, '#print "STEP'
#  concat S3, S4
#  concat S3, '\n"'
#  concat S3, "\n"

  ne S0, "+", NOTPLUS
  concat S3, "set I2, P0[I1]\n"
  concat S3, "inc I2\n"
  concat S3, "set P0[I1], I2\n"
  branch NEXT

NOTPLUS:
  ne S0, "-", NOTMINUS
  concat S3, "set I2, P0[I1]\n"
  concat S3, "dec I2\n"
  concat S3, "set P0[I1], I2\n"
  branch NEXT

NOTMINUS:
  ne S0, ">", NOTGT
  concat S3, "inc I1\n"
  branch NEXT

NOTGT:
  ne S0, "<", NOTLT
  concat S3, "dec I1\n"
  branch NEXT

NOTLT:
  ne S0, "[", NOTOPEN

  set I2, 0 # "depth"

  set I3, I0
OPEN_LOOP:
  inc I3
  substr S2, S1, I3, 1
  ne S2, "[", OPEN_NOTOPEN
  inc I2
  branch OPEN_LOOP
OPEN_NOTOPEN:
  ne S2, "]", OPEN_LOOP
  eq I2, 0, OPEN_NEXT
  dec I2
  branch OPEN_LOOP
OPEN_NEXT:
  inc I3
  set S4, I3
  concat S3, "set I2, P0[I1]\n"
  concat S3, "unless I2, STEP"
  concat S3, S4
  concat S3, "\n"

  branch NEXT

NOTOPEN:
  ne S0, "]", NOTCLOSE

  set I3, I0
  set I2, 0 # "height"

CLOSE_LOOP:
  dec I3
  substr S2, S1, I3, 1
  ne S2, "]", CLOSE_NOTCLOSE
  inc I2
  branch CLOSE_LOOP
CLOSE_NOTCLOSE:
  ne S2, "[", CLOSE_LOOP
  eq I2, 0, CLOSE_NEXT
  dec I2
  branch CLOSE_LOOP

CLOSE_NEXT:
  set S4, I3
  concat S3, "branch STEP"
  concat S3, S4
  concat S3, "\n"

  branch NEXT

NOTCLOSE:
  ne S0, ".", NOTDOT
  concat S3, "set I2, P0[I1]\n"
  concat S3, "chr S31, I2\n"
  concat S3, "print S31\n"
  branch NEXT

NOTDOT:
  ne S0, ",", NEXT
  concat S3, "readline S31, 0\n"
  concat S3, "ord I2, S31\n"
  concat S3, "set P0[I1], I2\n"
  branch NEXT

NEXT:
  inc I0

  le I0, I30, INTERP
  concat S3, "end\n"

#  print S3
#  print "\n"

  # Now actually run it
  compreg P1, "PASM"
  compile P0, P1, S3
  invoke
  end

[perl #20804] [PATCH]-added inc by NN to core.ops

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #20804]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=20804 >


I was not able to find the increment by NN operation implemented and did it. 

Thanks,
-bc

__
The NEW Netscape 7.0 browser is now available. Upgrade now! 
http://channels.netscape.com/ns/browsers/download.jsp 

Get your own FREE, personal Netscape Mail account today at http://webmail.netscape.com/


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/50634/38880/2f2dbf/core.ops.20030209.patch




core.ops.20030209.patch
Description: core.ops.20030209.patch

[perl #21276] [PATCH] formatting fix for docs/dev/rx.dev

[via RT]

# New Ticket Created by  Cal Henderson 
# Please include the string:  [perl #21276]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21276 >


hi,

this patch fixes some formatting issues that cause docs/dev/rx.dev to
incorrectly display code snippets and to have no title. it also adds
a missing B<> tag.

second code snippet broken here:
  http://www.parrotcode.org/docs/dev/rx.dev.html

no title displayed here:
  http://www.parrotcode.org/docs/


-cal
--



** For great Emap magazine subscription & gift offers visit 
http://www.emapmagazines.co.uk **


The information in this email is intended only for the addressee(s) named above.
Access to this email by anyone else is unauthorised.
If you are not the intended recipient of this message any disclosure, copying, 
distribution or any action taken in reliance on it is prohibited and may be unlawful. 

Emap plc and or its subsidiaries do not warrant that any attachments are free from 
viruses or other defects and accept no liability for any losses resulting from 
infected email transmissions.

Please note that any views expressed in this email may be those of the originator 
and do not necessarily reflect those of this organisation.




-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52349/39656/85f0fd/rx.dev.diff




rx.dev.diff
Description: rx.dev.diff

[perl #21288] [PATCH] Function pointer initialization in packfile.c

[via RT]

# New Ticket Created by  Simon Glover 
# Please include the string:  [perl #21288]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21288 >



 The attached patch changes the initialization of various function
 pointers in packfile.c from NULL to NULLfunc (defined in parrot.h),
 in line with the discussion in parrot.h

 Hopefully this will fix the current breakage with lcc, but I don't have
 a working copy to test this with; on the machines I do have access to
 (x86 and Alpha, both with Linux) parrot builds fine, and all tests past.

 Simon


--- packfile.c.old  Tue Feb 18 14:18:26 2003
+++ packfile.c  Tue Feb 18 14:27:22 2003
@@ -763,9 +763,9 @@ PackFile_new(INTVAL is_mapped)
 PackFile_Segment_new_seg(pf, PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME, 1);
 pf->need_wordsize = 0;
 pf->need_endianize = 0;
-pf->fetch_op = (opcode_t (*)(opcode_t)) NULL;
-pf->fetch_iv = (INTVAL (*)(INTVAL)) NULL;
-pf->fetch_nv = (void (*)(unsigned char *, unsigned char *)) NULL;
+pf->fetch_op = (opcode_t (*)(opcode_t)) NULLfunc;
+pf->fetch_iv = (INTVAL (*)(INTVAL)) NULLfunc;
+pf->fetch_nv = (void (*)(unsigned char *, unsigned char *)) NULLfunc;
 return pf;
 }

@@ -868,10 +868,10 @@ pf_register_standard_funcs(struct PackFi
 };
 struct PackFile_funcs defaultf = {
 PackFile_Segment_new,
-(PackFile_Segment_destroy_func_t) NULL,
-(PackFile_Segment_packed_size_func_t) NULL,
-(PackFile_Segment_pack_func_t) NULL,
-(PackFile_Segment_unpack_func_t) NULL,
+(PackFile_Segment_destroy_func_t) NULLfunc,
+(PackFile_Segment_packed_size_func_t) NULLfunc,
+(PackFile_Segment_pack_func_t) NULLfunc,
+(PackFile_Segment_unpack_func_t) NULLfunc,
 default_dump
 };
 struct PackFile_funcs fixupf = {
@@ -893,9 +893,9 @@ pf_register_standard_funcs(struct PackFi
 struct PackFile_funcs bytef = {
 byte_code_new,
 byte_code_destroy,
-(PackFile_Segment_packed_size_func_t) NULL,
-(PackFile_Segment_pack_func_t) NULL,
-(PackFile_Segment_unpack_func_t) NULL,
+(PackFile_Segment_packed_size_func_t) NULLfunc,
+(PackFile_Segment_pack_func_t) NULLfunc,
+(PackFile_Segment_unpack_func_t) NULLfunc,
 default_dump
 };
 struct PackFile_funcs debugf = {

[perl #21301] [PATCH] life.pasm

[via RT]

# New Ticket Created by  Leon Brocard 
# Please include the string:  [perl #21301]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21301 >


This little patch changes the life.pasm in examples/assembly/ to use a
small spaceship instead. This can provide hours of enjoyment at
conferences if projected onto a big screen while answering parrot
questions.

Leon
-- 
Leon Brocard.http://www.astray.com/
scribot.http://www.scribot.com/

... Do not meddle in the affairs of dragons, for you are crunchy


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52439/39717/fefd53/life.pasm.diff


Index: examples/assembly/life.pasm
===
RCS file: /cvs/public/parrot/examples/assembly/life.pasm,v
retrieving revision 1.14
diff -u -r1.14 life.pasm
--- examples/assembly/life.pasm 27 Jan 2003 17:08:01 -  1.14
+++ examples/assembly/life.pasm 19 Feb 2003 13:10:16 -
@@ -12,16 +12,16 @@
set I12, 1
set S0,  "   "
set S1,  "   "
-   set S2,  "  *"
-   set S3,  "  **   "
-set S4,  " * *   "
-set S5,  "   "
-   set S6,  " * "
-   set S7,  " * "
-   set S8,  " * "
-   set S9,  " * "
-   set S10, " * "
-   set S11, " * "
+   set S2,  "   "
+set S3,  "   "
+   set S4,  "   **  "
+   set S5,  " **"
+   set S6,  "   *   "
+   set S7,  " * *   "
+   set S8,  "  **   "
+   set S9,  "   "
+   set S10, "   "
+   set S11, "   "
set S12, "   "
set S13, "   "
set S14, "   "

[perl #21378] can't locate new method in package uri

[via RT]

# New Ticket Created by  logo 
# Please include the string:  [perl #21378]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21378 >


I was trying to install the latest version of libwww-perl with my 5.8.0 
installation of perl.  Everytime I run make test I get the following error: 
can't located object method "new" in package "URI" at 
/usr/local/lib/perl5/site_perl/5.8.0/HTTP/Response.pm.  One of the 
prerequisites for libwww is the URI module.  However I definately have this 
module installed and installed properly.  I've been able to locate others 
who have had this problem as well, but noone was able to help them resolve 
the issue.  If anyone knows what's going on and what I can do to fix this I 
would be very appreciative.





_
Add photos to your messages with MSN 8. Get 2 months FREE*.  
http://join.msn.com/?page=features/featuredemail

[perl #21385] [PATCH]Patch to eliminate compiler warnings from packfile.c

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21385]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21385 >


This patch eliminates compiler warnings generated when compiling packfile.c. 
  In the function, fetch_op_mixed, the variables u and o are defined as 
local variables.  Inside the function, however, one variable is used within 
different parts of a #if...#else..#endif statement.  It then appears that 
one of the variables is unused.  This patch places the variables within 
their own #if..#else..#endif to stop the warnings.

Steve Peters
[EMAIL PROTECTED]




_
Tired of spam? Get advanced junk mail protection with MSN 8. 
http://join.msn.com/?page=features/junkmail


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52824/39969/0249ad/packfile.c.patch



packfile.c.patch
Description: packfile.c.patch

[perl #21386] [PATCH]Patch to eliminate compilier warnings in interpreter.c

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21386]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21386 >


This patch fixes compilier warnings generated when compiling interpreter.c.  
In the function runops_prederef, the local variables code_size and code_end 
are declared but never used.  This patch removes these variable declarations 
and stops the compilier warnings.

Steve Peters
[EMAIL PROTECTED]




_
The new MSN 8: smart spam protection and 2 months FREE*  
http://join.msn.com/?page=features/junkmail


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52826/39972/138ed3/interpreter.c.patch



interpreter.c.patch
Description: interpreter.c.patch

[perl #21387] [PATCH]Patch to prevent compilier warnings in embed.c

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21387]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21387 >


This patch is to stop compilier warnings in embed.c.  The loop label "again" 
is only called inside of code where HAS_HEADER_SYSMMAN is defined.  If 
HAS_HEADER_SYSMMAN is not defined, the loop label causes a warning when 
compiled.

Steve Peters
[EMAIL PROTECTED]




_
Add photos to your e-mail with MSN 8. Get 2 months FREE*.  
http://join.msn.com/?page=features/featuredemail


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52828/39975/da6239/embed.c.patch



embed.c.patch
Description: embed.c.patch

[perl #21388] [PATCH]Patch for jit.c to stop compilier warnings

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21388]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21388 >


The attached patch is to stop compilier warnings in jit.c.  The local 
variables i and typ are declared but never used in the function 
make_sections.

Steve Peters
[EMAIL PROTECTED]





_
Add photos to your e-mail with MSN 8. Get 2 months FREE*.  
http://join.msn.com/?page=features/featuredemail

[perl #21389] [PATCH]Patch to stop compiler warnings in dod.c

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21389]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21389 >


This patch is to stop warnings from being generated when compiling dod.c.  
In the function trace_active_buffers, the local variables cur_stack and 
entry are declared but never used.

Steve Peters
[EMAIL PROTECTED]




_
MSN 8 with e-mail virus protection service: 2 months FREE*  
http://join.msn.com/?page=features/virus


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52832/39979/847da6/dod.c.patch



dod.c.patch
Description: dod.c.patch

[perl #21399] [PATCH]Patch to fix compiler warnings in smallobject.c

[via RT]

# New Ticket Created by  Steve Peters 
# Please include the string:  [perl #21399]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21399 >


The attached patch fixes a compiler warning in smallobject.c.  The #define 
UNITS_PER_ALLOC_GROWTH_FACTOR has a value of 1.75, but is multiplied to a 
size_t.  This patch sets UNITS_PER_ALLOC_GROWTH_FACTOR to (size_t)2.  A 
comment prior to this #define says that this value (1.75) is arbitrary, so 
this should not be a problem.

Steve Peters
[EMAIL PROTECTED]




_
The new MSN 8: advanced junk mail protection and 2 months FREE*  
http://join.msn.com/?page=features/junkmail


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/52970/40020/bf3eeb/smallobject.c.patch



smallobject.c.patch
Description: smallobject.c.patch

[perl #21457] [PATCH] sun4 jit additions

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #21457]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21457 >



Here are some additional ops for the sun4 jit, a bit of name juggling to use
templates in the jit directives and register allocation support.

-- 
Jason


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/53234/40147/51b1c5/sunjit.patch

Index: jit/sun4/core.jit
===
RCS file: /cvs/public/parrot/jit/sun4/core.jit,v
retrieving revision 1.2
diff -u -r1.2 core.jit
--- jit/sun4/core.jit   20 May 2002 05:33:01 -  1.2
+++ jit/sun4/core.jit   4 Mar 2003 15:09:34 -
@@ -13,41 +13,180 @@
 emitm_nop(NATIVECODE);
 }
 
+TEMPLATE Parrot_set_x_x {
+if(MAP[1] && MAP[2]){
+   jit_emit_mov_rr<_N>(NATIVECODE, MAP[1], MAP[2]);
+}
+else if(MAP[1]){
+jit_emit_load<_N>(jit_info, interpreter, 2, MAP[1]);
+}
+else if(MAP[2]){
+jit_emit_store<_N>(jit_info, interpreter, 1, MAP[2]);
+}
+else {
+   jit_emit_load<_N>(jit_info, interpreter, 2, ISR1);
+   jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+}
+}
+
 Parrot_set_i_i {
-Parrot_jit_int_load(jit_info, interpreter, 2, emitm_l(0));
-Parrot_jit_int_store(jit_info, interpreter, 1, emitm_l(0));
+Parrot_set_x_x s/<_N>/_i/
 }
 
-Parrot_set_i_ic {
-Parrot_jit_int_load(jit_info, interpreter, 2, emitm_l(0));
-Parrot_jit_int_store(jit_info, interpreter, 1, emitm_l(0));
+Parrot_set_p_p {
+Parrot_set_x_x s/<_N>/_i/
 }
 
-Parrot_set_n_nc {
-Parrot_jit_int_load(jit_info, interpreter, 2, emitm_l(0));
-Parrot_jit_int_store(jit_info, interpreter, 1, emitm_l(0));
+Parrot_set_s_s {
+Parrot_set_x_x s/<_N>/_i/
 }
 
 Parrot_set_n_n {
-Parrot_jit_int_load(jit_info, interpreter, 2, emitm_l(0));
-Parrot_jit_int_store(jit_info, interpreter, 1, emitm_l(0));
+Parrot_set_x_x s/<_N>/_n/ s/ISR/FSR/
+}
+
+TEMPLATE Parrot_set_x_xc {
+if(MAP[1]){
+   jit_emit_load<_N>(jit_info, interpreter, 2, MAP[1]);
+}
+else {
+   jit_emit_load<_N>(jit_info, interpreter, 2, ISR1);
+   jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+}
+}
+
+Parrot_set_i_ic {
+Parrot_set_x_xc s/<_N>/_i/
+}
+
+Parrot_set_n_nc {
+Parrot_set_x_xc s/<_N>/_n/ s/ISR/FSR/
 }
 
 Parrot_set_n_i {
-Parrot_jit_float_load(jit_info, interpreter, 2, emitm_f(0));
-emitm_fitod(NATIVECODE, emitm_f(0), emitm_f(2));
-Parrot_jit_float_store(jit_info, interpreter, 1, emitm_f(2));
+/* There's no way to move a value directly between integer and floating
+ * point registers so the mapped integer register must be written to memory
+ */
+if(MAP[2]){
+   jit_emit_store_i(jit_info, interpreter, 2, MAP[2]);
+}
+
+jit_emit_load_n(jit_info, interpreter, 2, FSR1);
+
+/* If result register is mapped convert directly into the register */
+if(MAP[1]){
+   emitm_fitod(NATIVECODE, FSR1, MAP[1]);
+}
+else {
+   emitm_fitod(NATIVECODE, FSR1, FSR2);
+   jit_emit_store_n(jit_info, interpreter, 1, FSR2);
+}
 }
 
 Parrot_set_i_n {
-Parrot_jit_float_load(jit_info, interpreter, 2, emitm_f(0));
-emitm_fdtoi(NATIVECODE, emitm_f(0), emitm_f(2));
-Parrot_jit_float_store(jit_info, interpreter, 1, emitm_f(2));
+if(MAP[2]){
+   emitm_fdtoi(NATIVECODE, MAP[2], FSR2);
+}
+else {
+   jit_emit_load_n(jit_info, interpreter, 2, FSR1);
+   emitm_fdtoi(NATIVECODE, FSR1, FSR2);
+}
+
+jit_emit_store_n(jit_info, interpreter, 1, FSR2);
+
+/* No float reg to integer reg move instruction available */
+if(MAP[1]){
+   jit_emit_load_i(jit_info, interpreter, 1, MAP[1]);
+}
+}
+
+Parrot_set_i_nc {
+if(MAP[2]){
+emitm_fdtoi(NATIVECODE, MAP[2], FSR1);
+}
+else {
+jit_emit_load_n(jit_info, interpreter, 2, FSR2);
+emitm_fdtoi(NATIVECODE, FSR2, FSR1);
+}
+
+jit_emit_store_n(jit_info, interpreter, 1, FSR1); 
+
+if(MAP[1]){
+jit_emit_load_i(jit_info, interpreter, 1, MAP[1]);
+}
+}
+
+TEMPLATE Parrot_binop_x_x {
+int arg1, arg2;
+
+if (MAP[1]) {
+arg1 = MAP[1];
+}
+else {
+arg1 = ISR1;
+jit_emit_load<_N>(jit_info, interpreter, 1, ISR1);
+}
+
+if (MAP[2]) {
+arg2 = MAP[2];
+}
+else {
+arg2 = ISR2;
+jit_emit_load<_N>(jit_info, interpreter, 2, ISR2);
+}
+
+emitm_(NATIVECODE, arg1, arg2, arg1);
+
+if(!MAP[1]){
+jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+}
+}
+
+Parrot_add_i_i {
+Parrot_binop_x_x s//add_r/ s/<_N>/_i/
+}
+
+Parrot_sub_i_i {
+Parrot_binop_x_x s//sub_r/ s/<_N>/_i/
+}
+
+Parrot_bor_i_i {
+Parrot_binop_x_x s//or_r/ s/<_N>/_i/
+}
+
+Parrot_bxor_i_i {
+Parrot_binop_x_x s//xor_r/ s/<_N>/_i/
+}
+
+Parrot_band

[perl #21476] [imcc] problems with the optimizer under OS X

[via RT]

# New Ticket Created by  Allison Randal 
# Please include the string:  [perl #21476]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21476 >


I couldn't compile imcc under OS X because of a repeat of the old "ld:
multiple definitions of symbol" problem (ticket #17159). I fixed that
with the attached patch. 

Now that it compiles, several of the optimizer tests fail. The problem
seems to be unrelated to the patch because the tests pass with the patch
on my Slackware box.

Hope this is useful.

Allison


...
t/imcpasm/cfg...ok   
t/imcpasm/opt1..ok 12/49# Failed test (t/imcpasm/opt1.t at line
168) 
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 13# Failed test (t/imcpasm/opt1.t at line
178)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 14# Failed test (t/imcpasm/opt1.t at line
188)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 15# Failed test (t/imcpasm/opt1.t at line
198)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 16# Failed test (t/imcpasm/opt1.t at line
208)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 17# Failed test (t/imcpasm/opt1.t at line
218)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 18# Failed test (t/imcpasm/opt1.t at line
228)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 19# Failed test (t/imcpasm/opt1.t at line
238)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 20# Failed test (t/imcpasm/opt1.t at line
248)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 21# Failed test (t/imcpasm/opt1.t at line
258)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 22# Failed test (t/imcpasm/opt1.t at line
268)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 23# Failed test (t/imcpasm/opt1.t at line
278)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..NOK 24# Failed test (t/imcpasm/opt1.t at line
288)   
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 25# Failed test (t/imcpasm/opt1.t at line
298)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..ok 28/49# Failed test (t/imcpasm/opt1.t at line
328) 
#  got: ''
# expected: 'L1:
#  end
# '
t/imcpasm/opt1..NOK 29# Failed test (t/imcpasm/opt1.t at line
338)   
#  got: ''
# expected: ' set I0, 5
#  end
# '
t/imcpasm/opt1..ok 49/49# Looks like you failed 16 tests of 49.  
t/imcpasm/opt1..dubious  
Test returned status 16 (wstat 4096, 0x1000)
DIED. FAILED tests 13-26, 29-30
Failed 16/49 tests, 67.35% okay (-1 skipped test: 32 okay,
65.31%)
t/imcpasm/opt2..ok
...


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/53326/40198/c54bdc/extern_optimize_enums.patch

Index: languages/imcc/cfg.h
===
RCS file: /cvs/public/parrot/languages/imcc/cfg.h,v
retrieving revision 1.8
diff -u -r1.8 cfg.h
--- languages/imcc/cfg.h5 Mar 2003 16:08:50 -   1.8
+++ languages/imcc/cfg.h6 Mar 2003 05:57:26 -
@@ -22,7 +22,7 @@
 int flag;
 } Basic_block;
 
-enum {
+EXTERN enum {
BB_IS_SUB = 1 << 0
 } block_enum_flags;
 
Index: languages/imcc/imc.h
===
RCS file: /cvs/public/parrot/languages/imcc/imc.h,v
retrieving revision 1.31
diff -u -r1.31 imc.h
--- languages/imcc/imc.h5 Mar 2003 16:08:50 -   1.31
+++ languages/imcc/imc.h6 Mar 2003 05:57:26 -
@@ -85,7 +85,7 @@
 EXTERN int allocated;
 
 
-enum {
+EXTERN enum {
OPT_NONE,
OPT_PRE,
OPT_CFG =   0x002,

[perl #21508] [PATCH] more sun4 jit changes

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #21508]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21508 >



This adds still more ops and re-organizes register use to avoid potential
conflicts in register use between the main .jit code and the helper routines.
More registers are available for allocation.

Some of the new ops are commented out. They really need a constant pool to
implement them correctly. It would be nice if the constant pool was more
generic, but I will probably want to work on the vtable functions before that.

-- 
Jason

[perl #21547] [PATCH] makefiles.pl - system("$^X -i -e '...'") not portable

[via RT]

# New Ticket Created by  Bruce Gray 
# Please include the string:  [perl #21547]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21547 >


In config/gen/makefiles.pl, Perl is called with "inplace editing" like so:
system("$^X -i -e 'FOO' filename");
This causes two different problems during `perl Configure.pl` on Win2000:

1) The command processor requires double quotes around the '-e' code.
Solution: The Configure::Data element PQ holds the Perl Quote needed for
the current platform, so the code becomes:
system("$^X -i -e ${PQ}FOO${PQ} filename");

2) From perldiag:
Can't do inplace edit without backup
(F) You're on a system such as MS-DOS that gets confused if you try
reading from a deleted (but still opened) file. You have to say
 -i.bak, or some such.
Win2000 has this problem, so the bare '-i' fails.
Solution: Use '-i.bak' and unlink the .bak file when done.
system("$^X -i.bak -e ${PQ}FOO${PQ}  filename");
unlink 'filename.bak';

This patch implements these two fixes, and reorganizes the three system
calls into one call.

Tested under Linux and Win2K (MinGW).

-- 
Hope this helps,
Bruce Gray



-- attachment  1 --
url: http://rt.perl.org/rt2/attach/53571/40362/0085a7/inplace_edit.patch

Index: config/gen/makefiles.pl
===
RCS file: /cvs/public/parrot/config/gen/makefiles.pl,v
retrieving revision 1.14
diff -u -r1.14 makefiles.pl
--- config/gen/makefiles.pl 21 Jan 2003 10:09:58 -  1.14
+++ config/gen/makefiles.pl 11 Mar 2003 22:36:18 -
@@ -27,15 +27,22 @@
   commentType => '#');
   genfile('config/gen/makefiles/imcc.in',  'languages/imcc/Makefile',
   commentType => '#');
-  system("$^X -pi -e's/ -Wwrite-strings//' languages/imcc/Makefile");
-  system("$^X -pi -e's/ -Wcast-qual//' languages/imcc/Makefile");
-  system("$^X -pi -e's/ -Wno-unused/ -Wunused/' languages/imcc/Makefile");
   genfile('config/gen/makefiles/bf.in','languages/bf/Makefile',
   commentType => '#');
   genfile('config/gen/makefiles/befunge.in',   'languages/befunge/Makefile',
   commentType => '#');
   genfile('config/gen/makefiles/ook.in',   'languages/ook/Makefile',
   commentType => '#');
+
+  # Change compiler flags in IMCC's makefile using inplace edit.
+  my $PQ   = Configure::Data->get('PQ');
+  my $imcc = 'languages/imcc/Makefile';
+  my $pgm  = ' s/ -Wwrite-strings//;'
+   . ' s/ -Wcast-qual//;'
+   . ' s/ -Wno-unused/ -Wunused/;';
+  system "$^X -pi.bak -e$PQ$pgm$PQ $imcc" and warn;
+  unlink "$imcc.bak" or warn;
+
 }
 
 1;

[perl #21577] [PATCH] sun4 vtable jit support

[via RT]

# New Ticket Created by  Jason Gloudon 
# Please include the string:  [perl #21577]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21577 >



This patch adds support for vtable calls in sun4/JIT as well as providing
additional ops.

-- 
Jason


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/53666/40437/0b19ab/jitsun4.patch

Index: jit/sun4/core.jit
===
RCS file: /cvs/public/parrot/jit/sun4/core.jit,v
retrieving revision 1.3
diff -u -r1.3 core.jit
--- jit/sun4/core.jit   4 Mar 2003 15:58:11 -   1.3
+++ jit/sun4/core.jit   15 Mar 2003 01:48:36 -
@@ -45,22 +45,24 @@
 Parrot_set_x_x s/<_N>/_n/ s/ISR/FSR/
 }
 
-TEMPLATE Parrot_set_x_xc {
+Parrot_set_i_ic {
+Parrot_set_x_x s/<_N>/_i/
+}
+
+Parrot_set_n_ic {
 if(MAP[1]){
-   jit_emit_load<_N>(jit_info, interpreter, 2, MAP[1]);
+   jit_emit_load_n(jit_info, interpreter, 2, MAP[1]);
+emitm_fitod(NATIVECODE, MAP[1], MAP[1]);
 }
 else {
-   jit_emit_load<_N>(jit_info, interpreter, 2, ISR1);
-   jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+   jit_emit_load_n(jit_info, interpreter, 2, FSR1);
+emitm_fitod(NATIVECODE, FSR1, FSR1);
+   jit_emit_store_n(jit_info, interpreter, 1, FSR1);
 }
 }
 
-Parrot_set_i_ic {
-Parrot_set_x_xc s/<_N>/_i/
-}
-
 Parrot_set_n_nc {
-Parrot_set_x_xc s/<_N>/_n/ s/ISR/FSR/
+Parrot_set_x_x s/<_N>/_n/ s/ISR/FSR/
 }
 
 Parrot_set_n_i {
@@ -132,13 +134,13 @@
 }
 else {
 arg2 = ISR2;
-jit_emit_load<_N>(jit_info, interpreter, 2, ISR2);
+jit_emit_load<_N>(jit_info, interpreter, 2, arg2);
 }
 
 emitm_(NATIVECODE, arg1, arg2, arg1);
 
 if(!MAP[1]){
-jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+jit_emit_store<_N>(jit_info, interpreter, 1, arg1);
 }
 }
 
@@ -178,7 +180,354 @@
 Parrot_binop_x_x s//fdivd/ s/<_N>/_n/
 }
 
-Parrot_if_i_ic {
+TEMPLATE Parrot_binop_i_xc {
+int arg1;
+
+if(MAP[1]){
+arg1 = MAP[1];
+}
+else {
+arg1 = ISR1;
+jit_emit_load_i(jit_info, interpreter, 1, arg1);
+}
+
+if(emitm_simm13_const(*INT_CONST[2])){
+emitm__i(NATIVECODE, arg1, *INT_CONST[2], arg1);
+}
+else {
+jit_emit_load_i(jit_info, interpreter, 2, ISR1);
+emitm__r(NATIVECODE, arg1, ISR1, arg1);
+}
+
+if(!MAP[1]){
+jit_emit_store_i(jit_info, interpreter, 1, arg1);
+}
+}
+
+Parrot_add_i_ic {
+Parrot_binop_i_xc s//add/
+}
+
+Parrot_sub_i_ic {
+Parrot_binop_i_xc s//sub/
+}
+
+Parrot_bor_i_ic {
+Parrot_binop_i_xc s//or/
+}
+
+Parrot_band_i_ic {
+Parrot_binop_i_xc s//and/
+}
+
+Parrot_bxor_i_ic {
+Parrot_binop_i_xc s//xor/
+}
+
+Parrot_sub_n_nc {
+Parrot_binop_x_x s//faddd/ s/ISR/FSR/ s/<_N>/_n/
+}
+
+Parrot_sub_n_nc {
+Parrot_binop_x_x s//fsubd/ s/ISR/FSR/ s/<_N>/_n/
+}
+
+Parrot_mul_n_nc {
+Parrot_binop_x_x s//fmuld/ s/ISR/FSR/ s/<_N>/_n/
+}
+
+Parrot_div_n_nc {
+Parrot_binop_x_x s//fdivd/ s/ISR/FSR/ s/<_N>/_n/
+}
+
+TEMPLATE Parrot_binop_x_x_x {
+int arg2, arg3;
+
+/* Generate load if needed */
+if(MAP[2]){
+arg2 = MAP[2];
+}
+else {
+arg2 = ISR1;
+jit_emit_load<_N>(jit_info, interpreter, 2, arg2);
+}
+
+/* Generate load if needed */
+if (MAP[3]) {
+arg3 = MAP[3];
+}
+else {
+arg3 = ISR2;
+jit_emit_load<_N>(jit_info, interpreter, 3, arg3);
+}
+
+/* Destination is a register */
+if (MAP[1]) {
+emitm_(NATIVECODE, arg2, arg3, MAP[1]);
+}
+/* Destination is memory */
+else {
+emitm_(NATIVECODE, arg2, arg3, ISR1);
+jit_emit_store<_N>(jit_info, interpreter, 1, ISR1);
+}
+}
+
+Parrot_add_i_ic_ic {
+Parrot_binop_x_x_x s//add_r/ s/<_N>/_i/
+}
+
+Parrot_sub_i_ic_ic {
+Parrot_binop_x_x_x s//sub_r/ s/<_N>/_i/
+}
+
+Parrot_band_i_ic_ic {
+Parrot_binop_x_x_x s//and_r/ s/<_N>/_i/
+}
+
+Parrot_bor_i_ic_ic {
+Parrot_binop_x_x_x s//or_r/ s/<_N>/_i/
+}
+
+Parrot_bxor_i_ic_ic {
+Parrot_binop_x_x_x s//xor_r/ s/<_N>/_i/
+}
+
+Parrot_shl_i_ic_ic {
+Parrot_binop_x_x_x s//sll_r/ s/<_N>/_i/
+}
+
+Parrot_shr_i_ic_ic {
+Parrot_binop_x_x_x s//sra_r/ s/<_N>/_i/
+}
+
+Parrot_lsr_i_ic_ic {
+Parrot_binop_x_x_x s//srl_r/ s/<_N>/_i/
+}
+
+Parrot_add_n_nc_nc {
+Parrot_binop_x_x_x s//faddd/ s/<_N>/_n/ s/ISR/FSR/
+}
+
+Parrot_sub_n_nc_nc {
+Parrot_binop_x_x_x s//fsubd/ s/<_N>/_n/ s/ISR/FSR/
+}
+
+Parrot_mul_n_nc_nc {
+Parrot_binop_x_x_x s//fmuld/ s/<_N>/_n/ s/ISR/FSR/
+}
+
+Parrot_div_n_nc_nc {
+Parrot_binop_x_x_x s//fdivd/ s/<_N>/_n/ s/ISR/FSR/
+}
+
+Parrot_add_i_i_ic {
+Parrot_binop_x_x_x s//add_r/ s/<_N>/_i/
+}
+
+Parrot_sub_i_i_ic {
+Parrot_binop_x_x_x s//sub_r/ s/<_N>/_i/
+}
+
+Parrot_bor_i_i_ic {
+Parrot_binop_x_x_x 

[perl #21588] [PATCH] uniq.pasm

[via RT]

# New Ticket Created by  Leon Brocard 
# Please include the string:  [perl #21588]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21588 >


Well, it's more of a new file than a patch. I'm aware that we're in a
code freeze, so I don't mind if this doesn't get it right now, but
it'd be nice ;-)

I've attached an example "uniq" implementation in pasm, which takes
options. It's not very fast compared to GNU uniq atm, but hey. I'd
suggest putting this in examples/assembly/ (don't forget the
MANIFEST).

Cheers, Leon
-- 
Leon Brocard.http://www.astray.com/
scribot.http://www.scribot.com/

... What if there were no hypothetical questions?


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/53714/40460/cda411/uniq.pasm

# $Id$
# uniq - Remove duplicate lines from a sorted file
#
#   % ./assemble.pl uniq.pasm -o uniq.pbc
#   % ./parrot uniq.pbc data.txt
#   % ./parrot uniq.pbc -c data.txt
#
# Takes options and a filename as argument:
#
# -c
#   Precede each output line with the count of the number of times the
#   line occurred in the input, followed by a single space
#
# -d
#   Don't output lines that are not repeated in the input
#
# -u
#   Don't output lines that are repeated in the input
#
# By Leon Brocard <[EMAIL PROTECTED]>

  set S0, P0[1]
  if S0, SOURCE
  set S0, P0[0]
  print "usage: parrot "
  print S0
  print " [-cdu] filename\n"
  end

SOURCE:
  # do some simple option parsing

  ne S0, "-c", NOTC
  set I10, 1 # count mode
  set S0, P0[2]

NOTC:
  ne S0, "-d", NOTD
  set I11, 1 # duplicate mode
  set S0, P0[2]

NOTD:
  ne S0, "-u", GO
  set I12, 1 # unique mode
  set S0, P0[2]

GO:
  # S2 is the previous line

  set I1, 1 # count
  # Read the file into S1
  open I0, S0
  readline S2, I0

SOURCE_LOOP:
  readline S1, I0

  eq S1, S2, MATCH

  # different line

  unless I10, NOTC2
  # count mode
  # we go to some lengths to make the count pretty
  set S3, I1
  length I2, S3
  sub I2, 7, I2
  set S3, " "
  repeat S3, S3, I2
  print S3
  print I1
  print " "
  print S2
  branch RESET

NOTC2:
  unless I11, NOTD2

  # show duplicates mode
  eq 1, I1, RESET
  print S2
  branch RESET

NOTD2:
  unless I12, NOTU2

  # don't show lines that are duplicated mode
  ne 1, I1, RESET
  print S2
  branch RESET

NOTU2:

  # default mode
  print S2
  branch RESET

RESET:
  set I1, 1
  branch LOOP

MATCH:
  inc I1
  # fall through

LOOP:
  set S2, S1
  if S1, SOURCE_LOOP
  close I0

  end

[perl #21659] ScanMail Message: To Sender Match eManager setting and take actio n.

[via RT]

# New Ticket Created by  System Attendant 
# Please include the string:  [perl #21659]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21659 >


 eManager Notification *

The following mail was blocked since it contains sensitive content.

Source mailbox: [EMAIL PROTECTED]
Destination mailbox(es): [EMAIL PROTECTED]
Rule/Policy: Anti-Spam
Action: Delete

Content filter has detected a sensitive e-mail.

*** End of message *

[perl #21660] ScanMail Message: To Sender, sensitive content found and action t aken.

[via RT]

# New Ticket Created by  System Attendant 
# Please include the string:  [perl #21660]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21660 >


Trend SMEX Content Filter has detected sensitive content.

Place = [EMAIL PROTECTED]; ; ; [EMAIL PROTECTED]
Sender = Brittany Lacey
Subject = [perl #21658] ATTN:   No tests, classes, or books - just a college
deg-ree
Delivery Time = March 23, 2003 (Sunday) 02:08:46
Policy = Anti-Spam
Action on this mail = Quarantine message

Warning message from administrator:
Content filter has detected a sensitive e-mail.

[perl #21665] [BUG] Incompatible return type in io/io_unix.c

[via RT]

# New Ticket Created by  Simon Glover 
# Please include the string:  [perl #21665]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21665 >



 Hi,

 In io/io_unix.c, PIO_unix_flush returns void, but in io.h, the
 (*Flush) slot in the ParrotIOLayerAPI (to which we assign PIO_unix_flush)
 expects a function that returns INTVAL. This mismatch causes a compiler
 warning with gcc, and breaks compilation with lcc and tcc.

 Simon

[perl #21735] ScanMail Message: To Sender Match eManager setting and take actio n.

[via RT]

# New Ticket Created by  System Attendant 
# Please include the string:  [perl #21735]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21735 >


 eManager Notification *

The following mail was blocked since it contains sensitive content.

Source mailbox: [EMAIL PROTECTED]
Destination mailbox(es): [EMAIL PROTECTED]
Rule/Policy: Anti-Spam
Action: Delete

Content filter has detected a sensitive e-mail.

*** End of message *

[perl #21736] ScanMail Message: To Sender, sensitive content found and action t aken.

[via RT]

# New Ticket Created by  System Attendant 
# Please include the string:  [perl #21736]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21736 >


Trend SMEX Content Filter has detected sensitive content.

Place = [EMAIL PROTECTED]; ; ; [EMAIL PROTECTED]
Sender = Marla Hurley
Subject = [perl #21734] All credit welcome, jump on the lowest rates in 50
years
Delivery Time = March 28, 2003 (Friday) 15:11:41
Policy = Anti-Spam
Action on this mail = Quarantine message

Warning message from administrator:
Content filter has detected a sensitive e-mail.

[perl #21759] Documentation for PMCS

[via RT]

# New Ticket Created by  Alberto Simoes 
# Please include the string:  [perl #21759]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=21759 >


Hi, I'm back to business (I hope).

If someone remember, I wrote some pods about using some PMCs. At the moment
I started rewriting some of them. Here I send the first one, and ask to
include it on the parrot source tree at 'docs/pmcs' as 'array.pod'.

If you think it can be usefull, insert it in the parrot tree an e-mail me.
I'll prepare another PMCs. I accept suggestions, too!

Best regards, 
 Alberto Simões
-- 
Departamento de Informatica - Universidade do Minho

"The C Programming Language -- A language which combines the
flexibility of assembly language with the power of assembly language."


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/54377/40995/9e7801/array.pod

# -*- cperl -*-

=head1 Array base class

This pod file documents the Array base class usage. For implementation
details you should look inside the class file, found on
C in the parrot source code.

=head2 Creation

As any other PMC, the following line creates an array PMC on register C.

  new P0, .Array

As soon the array is created, you can test if it is defined using:

  defined I0, P0

which will put C<1> on C if it is defined, otherwise, C<0>.

=head2 Array sizes

When used on numeric context the PMC register containing the array
object contains the size of the array. You can use

  set I0, P0

to retrieve to C the size of the array on register C. In the
same way, you can assign directly the size of the array using

  set P0, 2

which will expand the array size to two.

=head2 Accessing elements

Elements are accessed using indexes, as in any programming
language. Notice that these arrays do not expand as Perl arrays, when
you access non-existing indexes.

The following code initializes an array on C with size two, and
sets the first position with an integer C<-8> and second position with
a real, C<3.1415>.

  new P0, .Array
  set P0, 2

  set P0[0], -8
  set P0[1], 3.1415

It must be clear that you can assign directly from a register. Check
this second example, with the same meaning:

  new P0, .Array
  set P0, 2

  set I0, -8
  set N0, 3.1415

  set P0[0], I0
  set P0[1], N0

To retrieve the elements we use the same syntax, switching registers:

  set N1, P0[1]
  set I1, P0[0]

These two lines retrieve the values from the array back to registers.
Whenever you want, it is possible to change the value type on some
position:

  set P0[1], "A string"

Accessing an out-of-bounds array element, an exception will be raised
(as soon as we have exceptions).

You can test if there is a defined element on some array position using

  defined I0, P0[1]

for the position you want to test. On the other hand, if you want only
to test if there is an element (rather than testing if it is defines)
you should use the C keyword:

  exists I0, P0[0]

=head2 TODO

Explain a little more which exception will be raised in case you
access a out-of-bounds index on the array (as soon we have
exceptions).

=cut

[perl #22592] [PATCH] Introduce macros for register access.

[via RT]

# New Ticket Created by  [EMAIL PROTECTED] 
# Please include the string:  [perl #22592]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=22592 >


These patches are a follow-up to the exploration and proposal
  http://nntp.x.perl.org/group/perl.perl6.internals/16081
  Subject: Register access
  From: mcharity[at]vendian.org (Mitchell N Charity)
  Date: Fri, 30 May 2003 19:42:54 -0400

These patches differ from the proposal in two main respects:
(1) The macro names are different, REGISTER_INT vs REG_INT.
It turned out names like INT_REG were being used both as C macros,
_and_ as .jit syntax.  It seemed worth disambiguating these two.
The annoyingly long REGISTER_INT was the best I came up with.
(2) The macros are argument-less.  REGISTER_INT vs REG_INT(n).
So the normal usage looks like REGISTER_INT[n] vs REG_INT(n).
I thought the square-brackets were, usually, visually clearer.
And it allowed the macros to be used for the few bulk register
manipulation cases, so _all_ instances of the string
interpreter->ctx.FOO_reg.registers could be switched to the macros.


These patches create macros
  #define REGISTER_INT interpreter->ctx.int_reg.registers
  #define REGISTER_NUM interpreter->ctx.num_reg.registers
  #define REGISTER_STR interpreter->ctx.string_reg.registers
  #define REGISTER_PMC interpreter->ctx.pmc_reg.registers
and substitute them in everywhere.

So register access looks like
  REGISTER_INT[n]

Not, as originally proposed, like
  REGISTER_INT(n)
which turned out to be less clear.

The C macros
  INT_REG(n) etal
are also replaced.

The assorted OpTrans macros
  IREG(i) etal
still exist, but are now defined using REGISTER_INT etal.

The .jit syntax register references
  INT_REG[n] etal
are left unchanged.

The new macros were named REGISTER_mumble to avoid recreating the
current confusion between C macros and jit syntax.

(Currently, in jit-related files, "if it has square brackets, then
 it's .jit syntax, if it has parens, then it's a C macro".
 Except for the differently named STR_REG(n) vs STRING_REG[n].
 Though the current C macros may not be accessible from .jit code?
 This naming collision seemed unfortunate.)

I would have liked something shorter than
  REGISTER_INT[n] etal,
specifically
  REG_INT[n] etal,
but that seemed unacceptably similar to the INT_REG[n] .jit syntax.
And REG_I[n] seemed too obscure.  And... my creativity failed.
Oh well -- it actually doesn't look too bad.

Bogus ops2cgc.pl lines (note the "_reg->registers") like
  'i'  => "interpreter->ctx.int_reg->registers[cur_opcode[%ld]]",
have been changed to
  'i'  => "REGISTER_INT[cur_opcode[%ld]]",
etc.

The method_util.c interpreter naming convention was changed ("interp"
to "interpreter") so I could crush out some more register accesses.
The file was already using both conventions, so this seemed reasonable.

The second patch will change the interpreter naming convention in
./languages/imcc/optimizer.c's function subst_constants(), to get the
two last register accesses.  The problem is the rest of the file uses
an "interp" convention.  So it's a tradeoff.  Either the function is
slightly oddball, or two register accesses escape the macros.
I suggest applying it.

Wouldn't it be nice to have a single interpreter naming convention
rather than two?

How about "interp"?

Sigh.

Patches pass "make test" and "make quickfulltest" against snapshot
parrot_2003-06-05_15.tar.gz on a linux x86.

No ChangeLog entry is included.


Comments?

Mitchell




-- attachment  1 --
url: http://rt.perl.org/rt2/attach/59029/43772/e962b0/register_macros_main.patch

-- attachment  2 --
url: http://rt.perl.org/rt2/attach/59029/43773/e22dd9/register_macros_secondary.patch

Only in .: TAGS
diff -ur ../old/build_nativecall.pl ./build_nativecall.pl
--- ../old/build_nativecall.pl  Tue Mar 18 11:00:13 2003
+++ ./build_nativecall.pl   Thu Jun  5 17:00:40 2003
@@ -39,13 +39,13 @@
   v => "void *",
  );
 
-my (%ret_assign) = (p => "final_destination->data = return_data;\nPMC_REG(5) = 
final_destination;",
-   i => "INT_REG(5) = return_data;",
-   l => "INT_REG(5) = return_data;",
-   c => "INT_REG(5) = return_data;",
-   s => "INT_REG(5) = return_data;",
-f => "NUM_REG(5) = return_data;",
-d => "NUM_REG(5) = return_data;",
+my (%ret_assign) = (p => "final_destination->data = return_data;\nREGISTER_PMC[5] = 
final_destination;",
+   i => "REGISTER_INT[5] = return_data;",
+   l => "REGISTER_INT[5] = return_data;",
+   c => "REGISTER_INT[5] = return_data;",
+   s => "REGISTER_INT[5] = return_data;",
+f => "REGISTER_NUM[5] = return_da

[perl #22337] [PATCH] Smaller PMC + separated DOD flags

[via RT]

# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #22337]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt2/Ticket/Display.html?id=22337 >


The next stage for getting faster DOD runs:

The relevant DOD flags are moved into an extra buffer per arena. Parrot
objects get allocated memalign-ed, so that the arena can be calculated
from the object address.

The major drawback of this is: the arenas have to be all equally sized
and - as we want to deal with many objecs too - rather big. So there
is a slight penalty for very short/small programs. The slowest part
here seems to be the clearing of the memalign'ed memory - I didn't
test yet, if this is necessary. It could at least be moved to
add_to_free_list(), where the memory is likely to be touched after
anyway.

To get around the initial big count of total_objects they are put on
the free_list not at once but in increasing parts for the first arena.

CVS has about 2 Million L2-Cache misses on the stress.pasm test
acounting for ~0.5 seconds on my Athlon 800 (estimated 1 miss = 200
cycles).
With ARENA_DOD_FLAGS enabled the miss count gets halfed (and half of 
these misses are due to the memset of the aligned memory)

It's equally fast compared to the previous patch and should get faster
on faster CPUs because the cache misses do hurt more then.

The usage of ARENA_DOD_FLAGS can be toggled in include/parrot/pobj.h
line 19.

Please give it a try and compare CVS, ARENA_DOD_FLAGS 0 and 1.

And of course ARENA_DOD_FLAGS = 1 needs a real memalign function, not
the dummy, that currently is inserted during config, when no memalign
is detected.

Thanks,
leo


-- attachment  1 --
url: http://rt.perl.org/rt2/attach/58274/43300/3a1627/dod-flags.patch

--- parrot/classes/default.pmc  Mon May 19 15:07:49 2003
+++ parrot-leo/classes/default.pmc  Sun May 25 14:12:25 2003
@@ -48,7 +48,7 @@
 
 PMC* getprop(STRING* key) {
 PMC* p_key = key_new_string(interpreter, key);
-   if (SELF->metadata) {
+   if (SELF->pmc_ext && SELF->metadata) {
  return (VTABLE_get_pmc_keyed(interpreter, SELF->metadata, p_key));
} else {
  PMC* undef = pmc_new(INTERP, enum_class_PerlUndef);
@@ -59,11 +59,13 @@
 
 void setprop(STRING* key, PMC* value) {
 PMC* p_key;
-   if (SELF->metadata) {
+   if (SELF->pmc_ext && SELF->metadata) {
   p_key = key_new_string(interpreter, key);
  VTABLE_set_pmc_keyed(interpreter,
  SELF->metadata, p_key, value, NULL);
} else {
+  if (!SELF->pmc_ext)
+  add_pmc_ext(INTERP, SELF);
   /* first make new hash */
  SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
  VTABLE_init(interpreter, SELF->metadata);
@@ -76,7 +78,7 @@
 }
 
 void delprop(STRING* key) {
-   if (SELF->metadata) {
+   if (SELF->pmc_ext && SELF->metadata) {
   PMC* p_key = key_new_string(interpreter, key);
  VTABLE_delete_keyed(interpreter, SELF->metadata, p_key);
}
@@ -84,6 +86,8 @@
 }
 
 PMC* getprops() {
+if (!SELF->pmc_ext)
+ add_pmc_ext(INTERP, SELF);
if (!SELF->metadata) {
  SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
  VTABLE_init(interpreter, SELF->metadata);
--- parrot/dod.cWed May 21 16:59:10 2003
+++ parrot-leo/dod.cTue May 27 13:26:03 2003
@@ -17,7 +17,7 @@
 #include 
 
 /* set this to 1 for tracing the system stack and processor registers */
-#define TRACE_SYSTEM_AREAS 1
+#define TRACE_SYSTEM_AREAS 0
 
 /* set this to 1 and above to zero to see if unanchored objects
  * are found in system areas. Please note: these objects might be bogus
@@ -31,6 +31,37 @@
 
 static size_t find_common_mask(size_t val1, size_t val2);
 
+#if ARENA_DOD_FLAGS
+
+void pobject_lives(struct Parrot_Interp *interpreter, PObj *obj)
+{
+
+struct Small_Object_Arena *arena = GET_ARENA(obj);
+size_t n = GET_OBJ_N(arena, obj);
+size_t ns = n >> ARENA_FLAG_SHIFT;
+UINTVAL nm = (n & ARENA_FLAG_MASK) << 2;
+UINTVAL *dod_flags = arena->dod_flags + ns;
+if (*dod_flags & ((PObj_on_free_list_FLAG | PObj_live_FLAG) << nm))
+return;
+++arena->live_objects;
+*dod_flags |= PObj_live_FLAG << nm;
+
+if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
+if (((PMC*)obj)->pmc_ext) {
+/* put it on the end of the list */
+interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+/* Explicitly make the tail of the linked list be
+ * self-referential */
+interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+}
+else if (PObj_custom_mark_TEST(obj))
+VTABLE_mark(interpreter, (PMC *) obj);
+return;
+}
+}
+
+#else
+
 /* Tag a buffer header as alive. Used by the GC system when tracin

[perl #40124] [TODO] Document HLL mappings

[via RT]

# New Ticket Created by  Will Coleda 
# Please include the string:  [perl #40124]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt3/Ticket/Display.html?id=40124 >


The purpose of each of the various HLL mappings should be documented;  
that is, when you specify a mapping, in which cases is this defined  
to do something. Additionally, what are the restrictions on each type  
specification (e.g.: must "does array" vs. "extend array"?  
restrictions on internal implementations? etc.).

For example : {{{

If you map to Float, then:

  ...

  joe(1.2)

  .sub joe
.param pmc number
  ...

Will use the mapped type instead of the core type Float when  
autoboxing the 1.2 into a PMC.

}}}

As a starting point, here are the current parrot classes that are  
being mapped either declaratively in the PMC or the at compile time  
via the .HLL_map syntax.

Array
BigInt
Boolean
Closure
Complex
Coroutine
Exception
FixedPMCArray
Float
Hash
Integer
LexPad
NameSpace
None
OrderedHash
ResizablePMCArray
String
Sub
Undef

Knowing when these are used and what the restrictions on each of  
those cases are will help HLL authors know when and how they should  
be overriding them. (Or when not to bother implementing them because  
they have no effect.)

--
Will "Coke" Coleda
[EMAIL PROTECTED]

[perl #40125] [TODO] implement splice for ResizablePMCArray

[via RT]

# New Ticket Created by  Will Coleda 
# Please include the string:  [perl #40125]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt3/Ticket/Display.html?id=40125 >


Implement a generic splice vtable method for RPA.

NB: can't use the same mechanism for this that array.pmc does:  
list_splice is geared to array.pmc style internals.

--
Will "Coke" Coleda
[EMAIL PROTECTED]

[perl #40132] [TODO] Remove set_pmc vtable method

[via RT]

# New Ticket Created by  Matt Diephouse 
# Please include the string:  [perl #40132]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt3/Ticket/Display.html?id=40132 >


So sayeth array.pmc:

   void set_pmc(PMC *other)

   Currently, an alias to C.  Expected to go away soon.

Evidently this is for some non-standard definition of "soon", as it's  
been more than a year AFAICT. This ought to be removed RSN to reduce  
confusion (which I suffered from this week).

--
Matt Diephouse

[perl #40135] [BUG] Tcl - t_tcl/subst.t failure.

[via RT]

# New Ticket Created by  Will Coleda 
# Please include the string:  [perl #40135]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt3/Ticket/Display.html?id=40135 >


The failure to parse this test (Malformed string) is due to this line:

test subst-3.2 {backslash substitutions with utf chars} {
 # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
 # that also doesn't mean anything, but is multi-byte in UTF-8.
 list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
} "j j \344 \344"


This is compiled to PIR (in part) as:

$P83 = ascii:"\n# 'j' is just a char that doesn't mean anything,  
and \\344 is '\x{e4}'\n# that also doesn't mean anything, but is  
multi-byte in UTF-8.\nlist [subst \\j] [subst j] [subst \\\ 
\344] [subst \\344]\n"

the "\x{e4}" makes this non ascii, so parrot hits this line and blows  
up.

--
Will "Coke" Coleda
[EMAIL PROTECTED]

[perl #40138] [TODO] Tcl - add tcl's tests into our repository

[via RT]

# New Ticket Created by  Will Coleda 
# Please include the string:  [perl #40138]
# in the subject line of all future correspondence about this issue. 
# http://rt.perl.org/rt3/Ticket/Display.html?id=40138 >


The .test files from the CVS repository should be added as part of  
our svn repo to allow anyone to run the tests directly.

I believe TPF has already signed off on this for other files from the  
tcl repository.

Should be a makefile target to update the files from CVS as necessary.



--
Will "Coke" Coleda
[EMAIL PROTECTED]