develooper Front page | perl.perl6.internals | Postings from December 2001

Re: Large string patch

Thread Previous | Thread Next
From:
David & Lisa Jacobs
Date:
December 30, 2001 00:46
Subject:
Re: Large string patch
Message ID:
002201c1910e$84e16c20$6401a8c0@jacobs
Here is the string patch with the interpreter left in.  Take your pick :-)

David

Index: Makefile.in
===================================================================
RCS file: /cvs/public/parrot/Makefile.in,v
retrieving revision 1.85
diff -c -r1.85 Makefile.in
*** Makefile.in 27 Dec 2001 23:57:58 -0000 1.85
--- Makefile.in 30 Dec 2001 08:38:15 -0000
***************
*** 44,50 ****

  #XXX This target is not portable to Win32

! shared: libparrot.so libcore_prederef_0_3.so

  libparrot.so: $(O_FILES)
   $(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
--- 44,50 ----

  #XXX This target is not portable to Win32

! shared: Libparrot.so libcore_prederef_0_3.so

  libparrot.so: $(O_FILES)
   $(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
***************
*** 173,178 ****
--- 173,179 ----
   $(RM_F) Parrot/Jit.pm
   $(RM_F) include/parrot/jit_struct.h
   $(RM_F) libparrot.so libcore_prederef_0_3.so
+  $(RM_F) *~
   cd docs && $(MAKE) clean && cd ..
   cd classes && $(MAKE) clean && cd ..
   cd languages && $(MAKE) clean && cd ..
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.60
diff -c -r1.60 core.ops
*** core.ops 28 Dec 2001 21:20:19 -0000 1.60
--- core.ops 30 Dec 2001 08:38:18 -0000
***************
*** 104,110 ****

  op err(s) {
    char *tmp = strerror(errno);
!   STRING *s = string_make(interpreter, tmp, strlen(tmp), 0, 0, 0);
    $1 = s;
    goto NEXT();
  }
--- 104,110 ----

  op err(s) {
    char *tmp = strerror(errno);
!   STRING *s = string_make(interpreter, tmp, strlen(tmp), NULL, 0, NULL);
    $1 = s;
    goto NEXT();
  }
***************
*** 165,174 ****
   default: file = (FILE *)$2;
    }

!   string_grow($1, 65535);
    memset(($1)->bufstart, 0, 65535);
    fgets(($1)->bufstart, 65534, file);
!   ($1)->strlen = strlen(($1)->bufstart);
    goto NEXT();
  }

--- 165,174 ----
   default: file = (FILE *)$2;
    }

!   $1 = string_make(interpreter, NULL, 65535, NULL, 0, NULL);
    memset(($1)->bufstart, 0, 65535);
    fgets(($1)->bufstart, 65534, file);
!   ($1)->strlen = ($1)->bufused = strlen(($1)->bufstart);
    goto NEXT();
  }

***************
*** 359,369 ****
    INTVAL len = $3;

    string_destroy($1);
!   tmp = malloc(len + 1);
!   read($2, tmp, len);
!   s = string_make(interpreter, tmp, len, 0, 0, 0);
    $1 = s;
-   free(tmp);
    goto NEXT();
  }

--- 359,368 ----
    INTVAL len = $3;

    string_destroy($1);
!   s = string_make(interpreter, NULL, len, NULL, 0, NULL);
!   read($2, s->bufstart, len);
!   s->bufused = s->buflen;
    $1 = s;
    goto NEXT();
  }

***************
*** 860,865 ****
--- 859,868 ----

  =item B<lt>(s, sc, ic)

+ =item B<lt>(sc, s, ic)
+
+ =item B<lt>(sc, sc, ic)
+
  Branch if $1 is less than $2.

  =cut
***************
*** 885,890 ****
--- 888,900 ----
    goto NEXT();
  }

+ op lt(sc, s|sc, ic) {
+   if (string_compare(interpreter, $1, $2) < 0) {
+     goto OFFSET($3);
+   }
+   goto NEXT();
+ }
+

  ########################################

***************
*** 900,905 ****
--- 910,919 ----

  =item B<le>(s, sc, ic)

+ =item B<le>(sc, s, ic)
+
+ =item B<le>(sc, sc, ic)
+
  Branch if $1 is less than or equal to $2.

  =cut
***************
*** 925,930 ****
--- 939,951 ----
    goto NEXT();
  }

+ op le(sc, s|sc, ic) {
+   if (string_compare(interpreter, $1, $2) <= 0) {
+     goto OFFSET($3);
+   }
+   goto NEXT();
+ }
+

  ########################################

***************
*** 940,945 ****
--- 961,970 ----

  =item B<gt>(s, sc, ic)

+ =item B<gt>(sc, s, ic)
+
+ =item B<gt>(sc, sc, ic)
+
  Branch if $1 is greater than $2.

  =cut
***************
*** 965,970 ****
--- 990,1002 ----
    goto NEXT();
  }

+ op gt(sc, s|sc, ic) {
+   if (string_compare(interpreter, $1, $2) > 0) {
+     goto OFFSET($3);
+   }
+   goto NEXT();
+ }
+

  ########################################

***************
*** 980,985 ****
--- 1012,1021 ----

  =item B<ge>(s, sc, ic)

+ =item B<ge>(sc, s, ic)
+
+ =item B<ge>(sc, sc, ic)
+
  Branch if $1 is greater than or equal to $2.

  =cut
***************
*** 1005,1010 ****
--- 1041,1053 ----
    goto NEXT();
  }

+ op ge(sc, s|sc, ic) {
+   if (string_compare(interpreter, $1, $2) >= 0) {
+     goto OFFSET($3);
+   }
+   goto NEXT();
+ }
+

  ########################################

***************
*** 1035,1041 ****
  }

  op if (s, ic) {
!   if (string_bool(interpreter, $1)) {
      goto OFFSET($2);
    }
    goto NEXT();
--- 1078,1084 ----
  }

  op if (s, ic) {
!   if (string_bool($1)) {
      goto OFFSET($2);
    }
    goto NEXT();
***************
*** 1117,1123 ****
    $1 = $2 + $3;
    goto NEXT();
  }
-

  ########################################

--- 1160,1165 ----
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/packfile.c,v
retrieving revision 1.16
diff -c -r1.16 packfile.c
*** packfile.c 6 Dec 2001 21:22:13 -0000 1.16
--- packfile.c 30 Dec 2001 08:38:21 -0000
***************
*** 1484,1493 ****

      self->type   = PFC_STRING;
      if (encoding == 0) {
!         self->string = string_make(interpreter, cursor, size, NULL, flags,
NULL); /* fixme */
      }
      else if (encoding == 3) {
!         self->string = string_make(interpreter, cursor, size,
encoding_lookup("utf32"), flags, chartype_lookup("unicode")); /* fixme */
      }
      else {
        return 0;
--- 1484,1496 ----

      self->type   = PFC_STRING;
      if (encoding == 0) {
!         self->string = string_make(interpreter, cursor, size, NULL, flags,
!                                    NULL); /* fixme */
      }
      else if (encoding == 3) {
!         self->string = string_make(interpreter, cursor, size,
!                                    encoding_lookup("utf32"), flags,
!                                    chartype_lookup("unicode")); /* fixme
*/
      }
      else {
        return 0;
Index: pbc2c.pl
===================================================================
RCS file: /cvs/public/parrot/pbc2c.pl,v
retrieving revision 1.8
diff -c -r1.8 pbc2c.pl
*** pbc2c.pl 27 Dec 2001 21:18:03 -0000 1.8
--- pbc2c.pl 30 Dec 2001 08:38:21 -0000
***************
*** 123,129 ****
          $data = '"' . $data . '"' unless $data =~ m/^"/;

          print <<END_C;
!     c = PackFile_Constant_new_string(interpreter, string_make(interpreter,
$data, $size, $encoding, $flags, $type));
  END_C
        } else {
          die;
--- 123,130 ----
          $data = '"' . $data . '"' unless $data =~ m/^"/;

          print <<END_C;
!     c = PackFile_Constant_new_string(interpreter, string_make(interpreter,
!  $data, $size, $encoding, $flags, $type));
  END_C
        } else {
          die;
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.27
diff -c -r1.27 string.c
*** string.c 29 Dec 2001 22:12:37 -0000 1.27
--- string.c 30 Dec 2001 08:38:22 -0000
***************
*** 1,7 ****
  /* string.c
   *  Copyright: (When this is determined...it will go here)
   *  CVS Info
!  *     $Id: string.c,v 1.27 2001/12/29 22:12:37 dan Exp $
   *  Overview:
   *     This is the api definitions for the string subsystem
   *  Data Structure and Algorithms:
--- 1,7 ----
  /* string.c
   *  Copyright: (When this is determined...it will go here)
   *  CVS Info
!  *     $Id: string.c,v 1.26 2001/12/28 18:20:12 ajgough Exp $
   *  Overview:
   *     This is the api definitions for the string subsystem
   *  Data Structure and Algorithms:
***************
*** 31,39 ****
   * and compute its string length
   */
  STRING *
! string_make(struct Parrot_Interp *interpreter, void *buffer, INTVAL
buflen,
!             const ENCODING *encoding, INTVAL flags, const CHARTYPE *type)
{
!     STRING *s = new_string_header(interpreter);

      if (!type) {
        type = string_native_type;
--- 31,40 ----
   * and compute its string length
   */
  STRING *
! string_make(struct Parrot_Interp *interpreter, const void *buffer,
!             INTVAL buflen, const ENCODING *encoding, INTVAL flags,
!             const CHARTYPE *type) {
!     STRING *s;

      if (!type) {
        type = string_native_type;
***************
*** 43,69 ****
        encoding = encoding_lookup(type->default_encoding);
      }

!     s->bufstart = mem_sys_allocate(buflen);
!     mem_sys_memcopy(s->bufstart, buffer, buflen);
      s->encoding = encoding;
-     s->buflen = s->bufused = buflen;
      s->flags = flags;
-     string_compute_strlen(s);
      s->type = type;

!     return s;
! }
!
! /*=for api string string_grow
!  * reallocate memory for the string if it is too small
!  */
! void
! string_grow(STRING* s, INTVAL newsize) {
!     INTVAL newsize_in_bytes = string_max_bytes(s, newsize);
!     if (s->buflen < newsize_in_bytes) {
!         s->bufstart = mem_sys_realloc(s->bufstart, newsize_in_bytes);
      }
!     s->buflen = newsize_in_bytes;
  }

  /*=for api string string_destroy
--- 44,68 ----
        encoding = encoding_lookup(type->default_encoding);
      }

!     s = mem_sys_allocate(sizeof(STRING)+buflen);
      s->encoding = encoding;
      s->flags = flags;
      s->type = type;
+     s->buflen = buflen;

!     if (buffer) {
!         mem_sys_memcopy(s->bufstart, buffer, buflen);
!         s->bufused = buflen;
!         string_compute_strlen(s);
!     }
!     else {
!         s->strlen = s->bufused = 0;
      }
!
!     /* Make it null terminate. This will simplify making a native string
*/
!     s->bufstart[s->bufused]='\0';
!
!     return s;
  }

  /*=for api string string_destroy
***************
*** 80,86 ****
   * return the length of the string
   */
  INTVAL
! string_length(STRING* s) {
      return s->strlen;
  }

--- 79,85 ----
   * return the length of the string
   */
  INTVAL
! string_length(const STRING* s) {
      return s->strlen;
  }

***************
*** 91,97 ****
   * functions are fleshed out, this function can DTRT.
   */
  static INTVAL
! string_index(STRING* s, INTVAL index) {
      return s->encoding->decode(s->encoding->skip_forward(s->bufstart,
index));
  }

--- 90,96 ----
   * functions are fleshed out, this function can DTRT.
   */
  static INTVAL
! string_index(const STRING* s, INTVAL index) {
      return s->encoding->decode(s->encoding->skip_forward(s->bufstart,
index));
  }

***************
*** 99,105 ****
   * return the length of the string
   */
  INTVAL
! string_ord(STRING* s, INTVAL index) {
      if((s == NULL) || (string_length(s) == 0)) {
          INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
                             "Cannot get character of empty string");
--- 98,104 ----
   * return the length of the string
   */
  INTVAL
! string_ord(const STRING* s, INTVAL index) {
      if((s == NULL) || (string_length(s) == 0)) {
          INTERNAL_EXCEPTION(ORD_OUT_OF_STRING,
                             "Cannot get character of empty string");
***************
*** 129,136 ****
   * create a copy of the argument passed in
   */
  STRING*
! string_copy(struct Parrot_Interp *interpreter, STRING *s) {
!     return string_make(interpreter, s->bufstart, s->bufused, s->encoding,
                         s->flags, s->type);
  }

--- 128,135 ----
   * create a copy of the argument passed in
   */
  STRING*
! string_copy(struct Parrot_Interp *interpreter, const STRING *s) {
!     return string_make(interpreter, s->bufstart, s->bufused, s->encoding,
                         s->flags, s->type);
  }

***************
*** 138,199 ****
   * create a transcoded copy of the argument passed in
   */
  STRING*
! string_transcode(struct Parrot_Interp *interpreter, STRING *src,
!                  const ENCODING *encoding, const CHARTYPE *type,
!                  STRING *dest) {
!     if (!dest) {
!         dest = string_make(interpreter, NULL, 0, encoding, 0, type);
!     }
!     else {
!         dest->encoding = encoding;
!         dest->type = type;
!     }

!     string_grow(dest, src->strlen);
!
!     if (src->encoding == dest->encoding && src->type == dest->type) {
!         mem_sys_memcopy(dest->bufstart, src->bufstart, src->bufused);
!
!         dest->bufused = src->bufused;
!     }
!     else {
!         CHARTYPE_TRANSCODER transcoder1 = NULL;
!         CHARTYPE_TRANSCODER transcoder2 = NULL;
!         char *srcstart;
!         char *srcend;
!         char *deststart;
!         char *destend;
!
!         if (src->type != dest->type) {
!             transcoder1 = chartype_lookup_transcoder(src->type,
dest->type);
!             if (!transcoder1) {
!                 transcoder1 = chartype_lookup_transcoder(src->type,
!                                   string_unicode_type);
!                 transcoder2 =
chartype_lookup_transcoder(string_unicode_type,
!                                   dest->type);
!             }
!         }
!
!         srcstart = src->bufstart;
!         srcend = srcstart + src->bufused;
!         deststart = dest->bufstart;
!         destend = deststart + dest->buflen;
!
!         while (srcstart < srcend) {
!             INTVAL c = src->encoding->decode(srcstart);
!
!             if (transcoder1) c = transcoder1(c);
!             if (transcoder2) c = transcoder2(c);
!
!             deststart = dest->encoding->encode(deststart, c);
!
!             srcstart = src->encoding->skip_forward(srcstart, 1);
          }

!         dest->bufused = destend - deststart;
      }

      dest->strlen = src->strlen;

      return dest;
  }
--- 137,194 ----
   * create a transcoded copy of the argument passed in
   */
  STRING*
! string_transcode(struct Parrot_Interp *interpreter,
!                  const STRING *src, const ENCODING *encoding,
!                  const CHARTYPE *type, STRING **dest_ptr) {

!     STRING *dest;
!     CHARTYPE_TRANSCODER transcoder1 = NULL;
!     CHARTYPE_TRANSCODER transcoder2 = NULL;
!     void *srcstart;
!     void *srcend;
!     void *deststart;
!     void *destend;
!
!     if (src->encoding == encoding && src->type == type) {
!         return string_copy(interpreter, src);
!     }
!
!     dest = string_make(interpreter, NULL,
src->strlen*src->encoding->max_bytes,
!                        encoding, 0, type);
!
!     if (src->type != dest->type) {
!         transcoder1 = chartype_lookup_transcoder(src->type, dest->type);
!         if (!transcoder1) {
!             transcoder1 = chartype_lookup_transcoder(src->type,
!                                                      string_unicode_type);
!             transcoder2 = chartype_lookup_transcoder(string_unicode_type,
!                                                      dest->type);
          }
+     }

!     srcstart = (void*)src->bufstart;
!     srcend = srcstart + src->bufused;
!     deststart = dest->bufstart;
!     destend = deststart + dest->buflen;
!
!     while (srcstart < srcend) {
!         INTVAL c = src->encoding->decode(srcstart);
!
!         if (transcoder1) c = transcoder1(c);
!         if (transcoder2) c = transcoder2(c);
!
!         deststart = dest->encoding->encode(deststart, c);
!
!         srcstart = src->encoding->skip_forward(srcstart, 1);
      }

+     dest->bufused = destend - deststart;
      dest->strlen = src->strlen;
+     dest->bufstart[dest->bufused]='\0';
+
+     if (dest_ptr) {
+         *dest_ptr = dest;
+     }

      return dest;
  }
***************
*** 209,249 ****
      return s->strlen;
  }

- /*=for api string string_max_bytes
-  * get the maximum number of bytes needed by iv characters
-  */
- INTVAL
- string_max_bytes(STRING* s, INTVAL iv) {
-     return iv * s->encoding->max_bytes;
- }
-
  /*=for api string string_concat
   * concatenate two strings
   */
  STRING*
! string_concat(struct Parrot_Interp *interpreter, STRING* a, STRING* b,
!               INTVAL flags) {
!     if(a != NULL) {
!         if (b == NULL || b->strlen == 0) {
!             return a;
          }
!         if (a->type != b->type || a->encoding != b->encoding) {
!             b = string_transcode(interpreter, b, a->encoding, a->type,
NULL);
          }
-         string_grow(a, a->strlen + b->strlen);
-         mem_sys_memcopy((void*)((ptrcast_t)a->bufstart + a->bufused),
-                           b->bufstart, b->bufused);
-         a->strlen = a->strlen + b->strlen;
-         a->bufused = a->bufused + b->bufused;
      }
      else {
!         if (b == NULL) {
!             return string_make(interpreter, "", 0, 0, 0, 0);
          }
-         return string_make(interpreter,
-                          b->bufstart,b->buflen,b->encoding,flags,b->type);
      }
!     return a;
  }

  /*=for api string string_repeat
--- 204,250 ----
      return s->strlen;
  }

  /*=for api string string_concat
   * concatenate two strings
   */
  STRING*
! string_concat(struct Parrot_Interp *interpreter, const STRING* a,
!               const STRING* b, INTVAL flags) {
!     STRING *result;
!
!     if (a != NULL && a->strlen != 0) {
!         if (b != NULL && b->strlen != 0) {
!             result = string_make(interpreter, NULL, a->bufused +
!                                  b->strlen*a->encoding->max_bytes,
!                                  a->encoding, 0, a->type);
!             mem_sys_memcopy(result->bufstart,a->bufstart,a->bufused);
!             if (a->type != b->type || a->encoding != b->encoding) {
!                 b = string_transcode(interpreter, b, a->encoding, a->type,
NULL);
!             }
!             mem_sys_memcopy((void*)((ptrcast_t)result->bufstart +
a->bufused),
!                             b->bufstart, b->bufused);
!             result->strlen = a->strlen + b->strlen;
!             result->bufused = a->bufused + b->bufused;
!             result->bufstart[result->bufused]='\0';
          }
!         else {
!             return string_copy(interpreter, a);
          }
      }
      else {
!         if (a != NULL) {
!             return string_transcode(interpreter, b, a->encoding, a->type,
NULL);
!         }
!         else {
!             if (b != NULL) {
!                 return string_copy(interpreter, b);
!             }
!             else {
!                 return string_make(interpreter, "", 0, NULL, 0, NULL);
!             }
          }
      }
!     return result;
  }

  /*=for api string string_repeat
***************
*** 251,258 ****
   * Allocates I<d> if needed, also returns d.
  */
  STRING*
! string_repeat(struct Parrot_Interp *interpreter, STRING* s, INTVAL num,
!               STRING** d) {
      STRING* dest;
      INTVAL i;

--- 252,258 ----
   * Allocates I<d> if needed, also returns d.
  */
  STRING*
! string_repeat(struct Parrot_Interp *interpreter, const STRING* s, INTVAL
num, STRING** d) {
      STRING* dest;
      INTVAL i;

***************
*** 260,293 ****
          INTERNAL_EXCEPTION(NEG_REPEAT, "Cannot repeat with negative arg");
      }

!     if (!d || !*d) {
!         dest = string_make(interpreter,
!                            NULL, 0, s->encoding,
!                            0, s->type);
!     }
!     else {
!         dest = *d;
!     }
!     string_grow(dest, s->strlen * num);
      if (num == 0) {
-         dest->strlen = 0;
          return dest;
      }

!     /* copy s into dest */
!     mem_sys_memcopy(dest->bufstart, s->bufstart, s->bufused);
!
!     /* copy from start of dest to later part of dest n times */
!     for (i = 1; i< num; i++) {
          mem_sys_memcopy((void*)((ptrcast_t)dest->bufstart+s->bufused * i),
!                         dest->bufstart, s->bufused);
      }

-     dest->type = s->type;
-     dest->encoding = s->encoding;
-     dest->language = s->language;
      dest->bufused = s->bufused * num;
!     string_compute_strlen(dest);
      return dest;
  }

--- 260,283 ----
          INTERNAL_EXCEPTION(NEG_REPEAT, "Cannot repeat with negative arg");
      }

!     dest = string_make(interpreter, NULL, s->bufused*num, s->encoding, 0,
!                        s->type);
      if (num == 0) {
          return dest;
      }

!     /* copy s into dest num times */
!     for (i = 0; i< num; i++) {
          mem_sys_memcopy((void*)((ptrcast_t)dest->bufstart+s->bufused * i),
!                         s->bufstart, s->bufused);
      }

      dest->bufused = s->bufused * num;
!     dest->strlen = s->strlen *num;
!
!     if (d != NULL) {
!         *d = dest;
!     }
      return dest;
  }

***************
*** 296,306 ****
   * Allocate memory for d if necessary.
   */
  STRING*
! string_substr(struct Parrot_Interp *interpreter, STRING* src, INTVAL
offset,
!               INTVAL length, STRING** d) {
      STRING *dest;
!     char *substart;
!     char *subend;
      if (offset < 0) {
          offset = src->strlen + offset;
      }
--- 286,295 ----
   * Allocate memory for d if necessary.
   */
  STRING*
! string_substr(struct Parrot_Interp *interpreter, const STRING* src, INTVAL
offset, INTVAL length, STRING** d) {
      STRING *dest;
!     void *substart;
!     void *subend;
      if (offset < 0) {
          offset = src->strlen + offset;
      }
***************
*** 314,331 ****
      if (length > (src->strlen - offset) ) {
          length = src->strlen - offset;
      }
!     if (!d || !*d) {
!         dest = string_make(interpreter, NULL, 0, src->encoding, 0,
src->type);
!     }
!     else {
!         dest = *d;
!     }
      substart = src->encoding->skip_forward(src->bufstart, offset);
      subend = src->encoding->skip_forward(substart, length);
-     string_grow(dest, length);
      mem_sys_memcopy(dest->bufstart, substart, subend - substart);
      dest->bufused = subend - substart;
      dest->strlen = length;
      return dest;
  }

--- 303,320 ----
      if (length > (src->strlen - offset) ) {
          length = src->strlen - offset;
      }
!     dest = string_make(interpreter, NULL, length*src->encoding->max_bytes,
!                        src->encoding, 0, src->type);
      substart = src->encoding->skip_forward(src->bufstart, offset);
      subend = src->encoding->skip_forward(substart, length);
      mem_sys_memcopy(dest->bufstart, substart, subend - substart);
      dest->bufused = subend - substart;
      dest->strlen = length;
+     dest->bufstart[dest->bufused]='\0';
+
+     if (d != NULL) {
+         *d = dest;
+     }
      return dest;
  }

***************
*** 334,341 ****
   */
  STRING*
  string_chopn(STRING* s, INTVAL n) {
!     char *bufstart = s->bufstart;
!     char *bufend = bufstart + s->bufused;
      if (n > s->strlen) {
          n = s->strlen;
      }
--- 323,330 ----
   */
  STRING*
  string_chopn(STRING* s, INTVAL n) {
!     void *bufstart = s->bufstart;
!     void *bufend = bufstart + s->bufused;
      if (n > s->strlen) {
          n = s->strlen;
      }
***************
*** 345,350 ****
--- 334,340 ----
      bufend = s->encoding->skip_backward(bufend, n);
      s->bufused = bufend - bufstart;
      s->strlen = s->strlen - n;
+     s->bufstart[s->bufused] = '\0';
      return s;
  }

***************
*** 352,374 ****
   * compare two strings.
   */
  INTVAL
! string_compare(struct Parrot_Interp *interpreter, STRING* s1, STRING* s2)
{
!     char *s1start;
!     char *s1end;
!     char *s2start;
!     char *s2end;
      INTVAL cmp = 0;

      if (s1->type != s2->type || s1->encoding != s2->encoding) {
!         s1 =
!             string_transcode(interpreter, s1, NULL, string_unicode_type,
NULL);
!         s2 =
!             string_transcode(interpreter, s2, NULL, string_unicode_type,
NULL);
      }

!     s1start = s1->bufstart;
      s1end = s1start + s1->bufused;
!     s2start = s2->bufstart;
      s2end = s2start + s2->bufused;

      while (cmp == 0 && s1start < s1end && s2start < s2end) {
--- 342,365 ----
   * compare two strings.
   */
  INTVAL
! string_compare(struct Parrot_Interp *interpreter, const STRING* s1,
!                const STRING* s2) {
!     void *s1start;
!     void *s1end;
!     void *s2start;
!     void *s2end;
      INTVAL cmp = 0;

      if (s1->type != s2->type || s1->encoding != s2->encoding) {
!         s1 = string_transcode(interpreter, s1, NULL, string_unicode_type,
!                               NULL);
!         s2 = string_transcode(interpreter, s2, NULL, string_unicode_type,
!                               NULL);
      }

!     s1start = (void*)s1->bufstart;
      s1end = s1start + s1->bufused;
!     s2start = (void*)s2->bufstart;
      s2end = s2start + s2->bufused;

      while (cmp == 0 && s1start < s1end && s2start < s2end) {
***************
*** 388,394 ****
  }

  /* A string is "true" if it is equal to anything but "" and "0" */
! BOOLVAL string_bool (struct Parrot_Interp *interpreter, STRING* s) {
      INTVAL len;
      if (s == NULL) {
          return 0;
--- 379,385 ----
  }

  /* A string is "true" if it is equal to anything but "" and "0" */
! BOOLVAL string_bool (const STRING* s) {
      INTVAL len;
      if (s == NULL) {
          return 0;
***************
*** 423,434 ****
    rounding towards zero.
  */

! INTVAL string_to_int (struct Parrot_Interp *interpreter, STRING *s) {
      INTVAL i = 0;

      if (s) {
!         char *start = s->bufstart;
!         char *end = start + s->bufused;
          int sign = 1;
          BOOLVAL in_number = 0;

--- 414,425 ----
    rounding towards zero.
  */

! INTVAL string_to_int (const STRING *s) {
      INTVAL i = 0;

      if (s) {
!         void *start = (void*)s->bufstart;
!         void *end = start + s->bufused;
          int sign = 1;
          BOOLVAL in_number = 0;

***************
*** 461,472 ****
      return i;
  }

! FLOATVAL string_to_num (struct Parrot_Interp *interpreter, STRING *s) {
      FLOATVAL f = 0.0;

      if (s) {
!         char *start = s->bufstart;
!         char *end = start + s->bufused;
          int sign = 1;
          BOOLVAL seen_dot = 0;
          BOOLVAL seen_e = 0;
--- 452,463 ----
      return i;
  }

! FLOATVAL string_to_num (const STRING *s) {
      FLOATVAL f = 0.0;

      if (s) {
!         void *start = (void*)s->bufstart;
!         void *end = start + s->bufused;
          int sign = 1;
          BOOLVAL seen_dot = 0;
          BOOLVAL seen_e = 0;
Index: classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.10
diff -c -r1.10 perlstring.pmc
*** classes/perlstring.pmc 28 Dec 2001 18:20:12 -0000 1.10
--- classes/perlstring.pmc 30 Dec 2001 08:38:23 -0000
***************
*** 47,53 ****

      INTVAL get_integer () {
   STRING* s = (STRING*) SELF->cache.struct_val;
!  return string_to_int(interpreter, s);
      }

      INTVAL get_integer_index (INTVAL index) {
--- 47,53 ----

      INTVAL get_integer () {
   STRING* s = (STRING*) SELF->cache.struct_val;
!  return string_to_int(s);
      }

      INTVAL get_integer_index (INTVAL index) {
***************
*** 55,61 ****

      FLOATVAL get_number () {
   STRING* s = (STRING*) SELF->cache.struct_val;
!  return string_to_num(interpreter, s);
      }

      FLOATVAL get_number_index (INTVAL index) {
--- 55,61 ----

      FLOATVAL get_number () {
   STRING* s = (STRING*) SELF->cache.struct_val;
!  return string_to_num(s);
      }

      FLOATVAL get_number_index (INTVAL index) {
***************
*** 69,75 ****
      }

      BOOLVAL get_bool () {
!  return string_bool(interpreter, SELF->cache.struct_val);
      }

      void* get_value () {
--- 69,75 ----
      }

      BOOLVAL get_bool () {
!  return string_bool(SELF->cache.struct_val);
      }

      void* get_value () {
***************
*** 455,461 ****
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(interpreter, value), NULL
                    );
      }

--- 455,461 ----
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(value), NULL
                    );
      }

***************
*** 463,469 ****
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(interpreter, value), NULL
                    );
      }

--- 463,469 ----
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(value), NULL
                    );
      }

***************
*** 471,477 ****
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(interpreter, value), NULL
                    );
      }

--- 471,477 ----
   dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
   dest->cache.struct_val =
             string_repeat(INTERP, SELF->cache.struct_val,
!                   string_to_int(value), NULL
                    );
      }

Index: docs/strings.pod
===================================================================
RCS file: /cvs/public/parrot/docs/strings.pod,v
retrieving revision 1.7
diff -c -r1.7 strings.pod
*** docs/strings.pod 28 Dec 2001 18:20:12 -0000 1.7
--- docs/strings.pod 30 Dec 2001 08:38:24 -0000
***************
*** 77,83 ****

  To repeat a string, (ie, turn 'xyz' into 'xyzxyzxyz') use:

!     STRING* string_repeat(struct Parrot_Interp *, STRING* s, INTVAL n,
STRING** d)

  Which will repeat string I<s> n times and store the result into I<d>,
which it
  also returns.  If I<*d> or I<**d> is NULL, a new string will be allocated
--- 77,83 ----

  To repeat a string, (ie, turn 'xyz' into 'xyzxyzxyz') use:

!     STRING* string_repeat(STRING* s, INTVAL n, STRING** d)

  Which will repeat string I<s> n times and store the result into I<d>,
which it
  also returns.  If I<*d> or I<**d> is NULL, a new string will be allocated
***************
*** 91,97 ****

  To retrieve a substring of the string, call

!     STRING* string_substr(struct Parrot_Interp *, STRING* src, INTVAL
offset, INTVAL length, STRING** dest)

  The result will be placed in C<dest>.
  (Passing in C<dest> avoids allocating a new string at runtime. If
--- 91,97 ----

  To retrieve a substring of the string, call

!     STRING* string_substr(STRING* src, INTVAL offset, INTVAL length,
STRING** dest)

  The result will be placed in C<dest>.
  (Passing in C<dest> avoids allocating a new string at runtime. If
***************
*** 113,119 ****

  To compare two strings, use:

!     INTVAL string_compare(struct Parrot_Interp *, STRING* s1, STRING* s2)

  The value returned will be less than, equal to, or greater than zero
  depending on whether C<s1> is less than, equal to, or greater than C<s2>.
--- 113,119 ----

  To compare two strings, use:

!     INTVAL string_compare(STRING* s1, STRING* s2)

  The value returned will be less than, equal to, or greater than zero
  depending on whether C<s1> is less than, equal to, or greater than C<s2>.
***************
*** 124,130 ****

  To test a string for truth, use:

!     BOOLVAL string_bool(struct Parrot_Interp *, STRING* s);

  A string is false if it

--- 124,130 ----

  To test a string for truth, use:

!     BOOLVAL string_bool(STRING* s);

  A string is false if it

***************
*** 152,158 ****
  structure in F<string.h>:

      struct parrot_string {
-       void *bufstart;
        INTVAL buflen;
        INTVAL bufused;
        INTVAL flags;
--- 152,157 ----
***************
*** 160,176 ****
        INTVAL encoding;
        INTVAL type;
        INTVAL unused;
      };

  Let's look at each element of this structure in turn.

- =head2 C<bufstart>
-
- This pointer points to the buffer which holds the string, encoded in
- whatever is the string's specified encoding. Because of this, you should
- not make any assumptions about what's in the buffer, and hence you
- shouldn't try and access it directly.
-
  =head2 C<buflen>

  This is used for memory allocation; it tells you the currently allocated
--- 159,169 ----
        INTVAL encoding;
        INTVAL type;
        INTVAL unused;
+       char bufstart[1];
      };

  Let's look at each element of this structure in turn.

  =head2 C<buflen>

  This is used for memory allocation; it tells you the currently allocated
***************
*** 236,241 ****
--- 229,241 ----
  This field is, as its name suggests, unused; however, it can be used to
  hold a pointer to the correct vtable for foreign strings.

+ =head2 C<bufstart>
+
+ This pointer points to the buffer which holds the string, encoded in
+ whatever is the string's specified encoding. Because of this, you should
+ not make any assumptions about what's in the buffer, and hence you
+ shouldn't try and access it directly.
+
  =head1 String Vtable Functions

  The L</String Manipulation Functions> above are implemented in terms of
***************
*** 326,357 ****
  not helping construct the Parrot core itself, you probably want to look
  away now.

- The first two functions to note are
-
      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<bufstart> 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<string_native_max_bytes>
! simply returns the C<INTVAL> it is passed; C<string_utf8_max_bytes>, 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<string_max_bytes> is called to turn
! this into a size in bytes, and then the buffer is grown to accomodate
! (at least) that many bytes.

  =head1 Transcoding

--- 326,335 ----
  not helping construct the Parrot core itself, you probably want to look
  away now.

      INTVAL string_compute_strlen(STRING* s)

! Updates the contents of C<< s->strlen >> by contemplating the
! buffer C<bufstart> and working out how many characters it contains.

  =head1 Transcoding

Index: encodings/singlebyte.c
===================================================================
RCS file: /cvs/public/parrot/encodings/singlebyte.c,v
retrieving revision 1.5
diff -c -r1.5 singlebyte.c
*** encodings/singlebyte.c 6 Dec 2001 00:11:24 -0000 1.5
--- encodings/singlebyte.c 30 Dec 2001 08:38:24 -0000
***************
*** 41,55 ****
  }

  static void *
! singlebyte_skip_forward (void *ptr, INTVAL n) {
!     byte_t *bptr = ptr;

      return bptr + n;
  }

  static void *
! singlebyte_skip_backward (void *ptr, INTVAL n) {
!     byte_t *bptr = ptr;

      return bptr - n;
  }
--- 41,55 ----
  }

  static void *
! singlebyte_skip_forward (const void *ptr, INTVAL n) {
!     byte_t *bptr = (byte_t*)ptr;

      return bptr + n;
  }

  static void *
! singlebyte_skip_backward (const void *ptr, INTVAL n) {
!     byte_t *bptr = (byte_t*)ptr;

      return bptr - n;
  }
Index: encodings/utf16.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf16.c,v
retrieving revision 1.4
diff -c -r1.4 utf16.c
*** encodings/utf16.c 6 Dec 2001 00:11:24 -0000 1.4
--- encodings/utf16.c 30 Dec 2001 08:38:24 -0000
***************
*** 77,84 ****
  }

  static void *
! utf16_skip_forward (void *ptr, INTVAL n) {
!     utf16_t *u16ptr = ptr;

      while (n-- > 0) {
        if (UNICODE_IS_HIGH_SURROGATE(*u16ptr)) {
--- 77,84 ----
  }

  static void *
! utf16_skip_forward (const void *ptr, INTVAL n) {
!     utf16_t *u16ptr = (utf16_t*)ptr;

      while (n-- > 0) {
        if (UNICODE_IS_HIGH_SURROGATE(*u16ptr)) {
***************
*** 100,107 ****
  }

  static void *
! utf16_skip_backward (void *ptr, INTVAL n) {
!     utf16_t *u16ptr = ptr;

      while (n--> 0) {
          u16ptr--;
--- 100,107 ----
  }

  static void *
! utf16_skip_backward (const void *ptr, INTVAL n) {
!     utf16_t *u16ptr = (utf16_t*)ptr;

      while (n--> 0) {
          u16ptr--;
Index: encodings/utf32.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf32.c,v
retrieving revision 1.1
diff -c -r1.1 utf32.c
*** encodings/utf32.c 31 Oct 2001 22:51:31 -0000 1.1
--- encodings/utf32.c 30 Dec 2001 08:38:24 -0000
***************
*** 44,58 ****
  }

  static void *
! utf32_skip_forward (void *ptr, INTVAL n) {
!     utf32_t *u32ptr = ptr;

      return u32ptr + n;
  }

  static void *
! utf32_skip_backward (void *ptr, INTVAL n) {
!     utf32_t *u32ptr = ptr;

      return u32ptr - n;
  }
--- 44,58 ----
  }

  static void *
! utf32_skip_forward (const void *ptr, INTVAL n) {
!     utf32_t *u32ptr = (utf32_t*)ptr;

      return u32ptr + n;
  }

  static void *
! utf32_skip_backward (const void *ptr, INTVAL n) {
!     utf32_t *u32ptr = (utf32_t*)ptr;

      return u32ptr - n;
  }
Index: encodings/utf8.c
===================================================================
RCS file: /cvs/public/parrot/encodings/utf8.c,v
retrieving revision 1.4
diff -c -r1.4 utf8.c
*** encodings/utf8.c 6 Dec 2001 00:11:24 -0000 1.4
--- encodings/utf8.c 30 Dec 2001 08:38:25 -0000
***************
*** 97,104 ****
  }

  static void *
! utf8_skip_forward (void *ptr, INTVAL n) {
!     utf8_t *u8ptr = ptr;

      while (n-- > 0) {
          u8ptr += UTF8SKIP(u8ptr);
--- 97,104 ----
  }

  static void *
! utf8_skip_forward (const void *ptr, INTVAL n) {
!     utf8_t *u8ptr = (utf8_t*)ptr;

      while (n-- > 0) {
          u8ptr += UTF8SKIP(u8ptr);
***************
*** 108,115 ****
  }

  static void *
! utf8_skip_backward (void *ptr, INTVAL n) {
!     utf8_t *u8ptr = ptr;

      while (n-- > 0) {
          u8ptr--;
--- 108,115 ----
  }

  static void *
! utf8_skip_backward (const void *ptr, INTVAL n) {
!     utf8_t *u8ptr = (utf8_t*)ptr;

      while (n-- > 0) {
          u8ptr--;
Index: include/parrot/encoding.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/encoding.h,v
retrieving revision 1.4
diff -c -r1.4 encoding.h
*** include/parrot/encoding.h 6 Dec 2001 00:11:24 -0000 1.4
--- include/parrot/encoding.h 30 Dec 2001 08:38:25 -0000
***************
*** 19,26 ****
      INTVAL (*characters)(const void *ptr, INTVAL bytes);
      INTVAL (*decode)(const void *ptr);
      void *(*encode)(void *ptr, INTVAL c);
!     void *(*skip_forward)(void *ptr, INTVAL n);
!     void *(*skip_backward)(void *ptr, INTVAL n);
  } ENCODING;

  const ENCODING *
--- 19,26 ----
      INTVAL (*characters)(const void *ptr, INTVAL bytes);
      INTVAL (*decode)(const void *ptr);
      void *(*encode)(void *ptr, INTVAL c);
!     void *(*skip_forward)(const void *ptr, INTVAL n);
!     void *(*skip_backward)(const void *ptr, INTVAL n);
  } ENCODING;

  const ENCODING *
Index: include/parrot/string.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string.h,v
retrieving revision 1.15
diff -c -r1.15 string.h
*** include/parrot/string.h 28 Dec 2001 18:20:12 -0000 1.15
--- include/parrot/string.h 30 Dec 2001 08:38:25 -0000
***************
*** 16,22 ****
  #include "parrot/parrot.h"

  typedef struct {
-     void *bufstart;
      INTVAL buflen;
      INTVAL flags;
      INTVAL bufused;
--- 16,21 ----
***************
*** 24,29 ****
--- 23,29 ----
      const ENCODING *encoding;
      const CHARTYPE *type;
      INTVAL language;
+     char bufstart[1];
  } STRING;


***************
*** 31,72 ****

  INTVAL
  string_compute_strlen(STRING*);
- INTVAL
- string_max_bytes(STRING*, INTVAL);
  STRING*
! string_concat(struct Parrot_Interp *, STRING*, STRING*, INTVAL);
  STRING*
! string_repeat(struct Parrot_Interp *, STRING* , INTVAL, STRING**);
  STRING*
  string_chopn(STRING*, INTVAL);
  STRING*
! string_substr(struct Parrot_Interp *interpreter, STRING*, INTVAL, INTVAL,
STRING**);
  INTVAL
! string_compare(struct Parrot_Interp *, STRING*, STRING*);
  BOOLVAL
! string_bool(struct Parrot_Interp *, STRING*);

  /* Declarations of other functions */
  INTVAL
! string_length(STRING*);
  INTVAL
! string_ord(STRING* s, INTVAL index);
  FLOATVAL
! string_to_num (struct Parrot_Interp *interpreter, STRING *s);
  INTVAL
! string_to_int (struct Parrot_Interp *interpreter, STRING *s);
! void
! string_grow(STRING* s, INTVAL newsize);
  void
  string_destroy(STRING* s);
  STRING*
! string_make(struct Parrot_Interp *interpreter, void *buffer, INTVAL
buflen, const ENCODING *encoding, INTVAL flags, const CHARTYPE *type);
  STRING*
! string_copy(struct Parrot_Interp *interpreter, STRING *i);
  STRING*
! string_transcode(struct Parrot_Interp *interpreter, STRING *src, const
ENCODING *encoding, const CHARTYPE *type, STRING *dest);
  void
  string_init(void);

  #endif

--- 31,76 ----

  INTVAL
  string_compute_strlen(STRING*);
  STRING*
! string_concat(struct Parrot_Interp *interpreter, const STRING*, const
STRING*,
!               INTVAL);
  STRING*
! string_repeat(struct Parrot_Interp *interpreter, const STRING* , INTVAL,
!               STRING**);
  STRING*
  string_chopn(STRING*, INTVAL);
  STRING*
! string_substr(struct Parrot_Interp *interpreter, const STRING*, INTVAL,
!               INTVAL, STRING**);
  INTVAL
! string_compare(struct Parrot_Interp *interpreter, const STRING*, const
STRING*);
  BOOLVAL
! string_bool(const STRING*);

  /* Declarations of other functions */
  INTVAL
! string_length(const STRING*);
  INTVAL
! string_ord(const STRING* s, INTVAL index);
  FLOATVAL
! string_to_num (const STRING *s);
  INTVAL
! string_to_int (const STRING *s);
  void
  string_destroy(STRING* s);
  STRING*
! string_make(struct Parrot_Interp *interpreter, const void *buffer,
!             INTVAL buflen, const ENCODING *encoding, INTVAL flags,
!             const CHARTYPE *type);
  STRING*
! string_copy(struct Parrot_Interp *interpreter, const STRING *i);
  STRING*
! string_transcode(struct Parrot_Interp *interpreter, const STRING *src,
!                  const ENCODING *encoding, const CHARTYPE *type, STRING
**d);
  void
  string_init(void);
+ static INTVAL
+ string_index(const STRING* s, INTVAL index);

  #endif

Index: t/op/string.t
===================================================================
RCS file: /cvs/public/parrot/t/op/string.t,v
retrieving revision 1.16
diff -c -r1.16 string.t
*** t/op/string.t 28 Dec 2001 18:20:13 -0000 1.16
--- t/op/string.t 30 Dec 2001 08:38:28 -0000
***************
*** 1,13 ****
  #! perl -w

! use Parrot::Test tests => 48;

! output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
   set S4, "JAPH\n"
   print S4
   end
  CODE
  JAPH
  OUTPUT

  output_is( <<'CODE', '4', "length_i_s" );
--- 1,16 ----
  #! perl -w

! use Parrot::Test tests => 63;

! output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
   set S4, "JAPH\n"
+  set S5, S4
   print S4
+  print S5
   end
  CODE
  JAPH
+ JAPH
  OUTPUT

  output_is( <<'CODE', '4', "length_i_s" );
***************
*** 18,38 ****
   end
  CODE

! output_is( <<'CODE', <<OUTPUT, "chopn_s_ic" );
   set S4, "JAPHxyzw"
   set S5, "japhXYZW"
!  set S3, "\n"
   chopn S4, 3
   chopn S4, 1
!  chopn S5, 4
   print S4
!  print S3
   print S5
   print S3
   end
  CODE
  JAPH
  japh
  OUTPUT

  output_is(<<'CODE', <<OUTPUT, "chopn, OOB values");
--- 21,46 ----
   end
  CODE

! output_is( <<'CODE', <<OUTPUT, "chopn_s_i|ic" );
   set S4, "JAPHxyzw"
   set S5, "japhXYZW"
!  set S3, S4
!  set S1  "\n"
!  set I1  4
   chopn S4, 3
   chopn S4, 1
!  chopn S5, I1
   print S4
!  print S1
   print S5
+  print S1
   print S3
+  print S1
   end
  CODE
  JAPH
  japh
+ JAPHxyzw
  OUTPUT

  output_is(<<'CODE', <<OUTPUT, "chopn, OOB values");
***************
*** 57,81 ****
  ** nothing **
  OUTPUT

! output_is( <<'CODE', 'JAPH', "substr_s_s_i_i" );
   set S4, "12345JAPH01"
   set I4, 5
   set I5, 4
   substr S5, S4, I4, I5
   print S5
   end
  CODE

  # negative offsets
  output_is(<<'CODE', <<'OUTPUT', "neg substr offset");
   set S0, "A string of length 21"
!  set I0, -9
!  set I1, 6
!  substr_s_s_i S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
--- 65,106 ----
  ** nothing **
  OUTPUT

! output_is( <<'CODE', <<'OUTPUT', "substr_s_s|sc_i|ic_i|ic" );
   set S4, "12345JAPH01"
   set I4, 5
   set I5, 4
   substr S5, S4, I4, I5
   print S5
+  substr S5, S4, I4, 4
+  print S5
+  substr S5, S4, 5, I5
+  print S5
+  substr S5, S4, 5, 4
+  print S5
+  substr S5, "12345JAPH01", I4, I5
+  print S5
+  substr S5, "12345JAPH01", I4, 4
+  print S5
+  substr S5, "12345JAPH01", 5, I5
+  print S5
+  substr S5, "12345JAPH01", 5, 4
+  print S5
+  print "\n"
   end
  CODE
+ JAPHJAPHJAPHJAPHJAPHJAPHJAPHJAPH
+ OUTPUT

  # negative offsets
  output_is(<<'CODE', <<'OUTPUT', "neg substr offset");
   set S0, "A string of length 21"
!  set I0, -9
!  set I1, 6
!  substr S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
***************
*** 83,110 ****
  OUTPUT

  # This asks for substring it shouldn't be allowed...
! output_is(<<'CODE', 'Cannot take substr outside string', "sub err:OOR");
   set S0, "A string of length 21"
!  set I0, -99
!  set I1, 6
!  substr_s_s_i S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE

  # This asks for substring much greater than length of original string
  output_is(<<'CODE', <<'OUTPUT', "len>strlen");
   set S0, "A string of length 21"
!  set I0, 12
!  set I1, 1000
!  substr_s_s_i S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
--- 108,140 ----
  OUTPUT

  # This asks for substring it shouldn't be allowed...
! output_is(<<'CODE', 'Cannot take substr outside string', "substr OOB");
   set S0, "A string of length 21"
!  set I0, -99
!  set I1, 6
!  substr S1, S0, I0, I1
!  end
! CODE
!
! # This asks for substring it shouldn't be allowed...
! output_is(<<'CODE', 'Cannot take substr outside string', "substr OOB");
!  set S0, "A string of length 21"
!  set I0, 99
!  set I1, 6
!  substr S1, S0, I0, I1
   end
  CODE

  # This asks for substring much greater than length of original string
  output_is(<<'CODE', <<'OUTPUT', "len>strlen");
   set S0, "A string of length 21"
!  set I0, 12
!  set I1, 1000
!  substr S1, S0, I0, I1
!  print  S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
***************
*** 114,168 ****
  # The same, with a negative offset
  output_is(<<'CODE', <<'OUTPUT', "len>strlen, -ve os");
   set S0, "A string of length 21"
!  set I0, -9
!  set I1, 1000
!  substr_s_s_i S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
  length 21
  OUTPUT

! output_is( <<'CODE', '<><', "2-param concat, null onto null" );
!     print "<>"
!     concat S0,S0
!     print "<"
!     end
  CODE

! output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo1" onto null' );
!     concat S0,"foo1"
!     print S0
!     print "\n"
!     end
  CODE
  foo1
  OUTPUT

! output_is( <<'CODE', <<OUTPUT, '2-param concat, "foo2" onto null' );
!     set S1,"foo2"
!     concat S0,S1
!     print S0
!     print "\n"
      end
  CODE
! foo2
  OUTPUT

! output_is( <<'CODE', <<OUTPUT, "concat" );
!     set S1, "fish"
!     set S2, "bone"
!     concat S1, S2
!     print S1
!     set S2, "\n"
!     print S2
      end
  CODE
! fishbone
  OUTPUT


--- 144,230 ----
  # The same, with a negative offset
  output_is(<<'CODE', <<'OUTPUT', "len>strlen, -ve os");
   set S0, "A string of length 21"
!  set I0, -9
!  set I1, 1000
!  substr S1, S0, I0, I1
!  print S0
!  print "\n"
!  print S1
!  print "\n"
   end
  CODE
  A string of length 21
  length 21
  OUTPUT

! output_is( <<'CODE', '<><', "concat_s_s|sc, null onto null" );
!  print "<>"
!  concat S0, S0
!  concat S1, ""
!  print "<"
!  end
  CODE

! output_is( <<'CODE', <<OUTPUT, 'concat_s_s|sc, "foo1" onto null' );
!  concat S0, "foo1"
!  set S1, "foo2"
!  concat S2, S1
!  print S0
!  print "\n"
!  print S2
!  print "\n"
!  end
  CODE
  foo1
+ foo2
  OUTPUT

! output_is( <<'CODE', <<OUTPUT, "concat_s_s|sc" );
!  set S1, "fish"
!  set S2, "bone"
!  concat S1, S2
!  print S1
!  concat S1, "\n"
!  print S1
      end
  CODE
! fishbonefishbone
  OUTPUT

! output_is( <<'CODE', <<OUTPUT, "concat_s_s|sc_s|sc" );
!  set S1, "japh"
!  set S2, "JAPH"
!  concat S0, "japh", "JAPH"
!  print S0
!  print "\n"
!  concat S0, S1, "JAPH"
!  print S0
!  print "\n"
!  concat S0, "japh", S2
!  print S0
!  print "\n"
!  concat S0, S1, S2
!  print S0
!  print "\n"
      end
  CODE
! japhJAPH
! japhJAPH
! japhJAPH
! japhJAPH
! OUTPUT
!
! output_is( <<'CODE', <<OUTPUT, "concat - ensure copy is made" );
!  set S2, "JAPH"
!  concat S0, S2, ""
!  concat S1, "", S2
!  chopn S0, 1
!  chopn S1, 1
!  print S2
!  print "\n"
!  end
! CODE
! JAPH
  OUTPUT


***************
*** 201,207 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_s_sc_ic");
  @{[ compare_strings( 1, "eq", @strings ) ]}
      print "ok\\n"
      end
--- 263,269 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_sc_s_ic");
  @{[ compare_strings( 1, "eq", @strings ) ]}
      print "ok\\n"
      end
***************
*** 212,275 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_sc_s_ic");
!  set S0, "I am legion"

!  eq "I am legion", S0, GOOD1
!  print "not "
! GOOD1: print "ok 1\\n"

!  eq "I am legend", S0, BAD1
!  branch GOOD2
! BAD1: print "not "
! GOOD2: print "ok 2\\n"
!  end
  CODE
! ok 1
! ok 2
  OUTPUT

  output_is(<<CODE, <<OUTPUT, "ne_sc_s_ic");
!  set S0, "I am legion"

!  ne "I am legend", S0, GOOD1
!  print "not "
! GOOD1: print "ok 1\\n"

!  ne "I am legion", S0, BAD1
!  branch GOOD2
! BAD1: print "not "
! GOOD2: print "ok 2\\n"
!  end
  CODE
! ok 1
! ok 2
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_sc_s");

   set S0, "Sparticus"
   bsr TEST1
   print "ok 1\\n"
   bsr TEST2
   print "ok 2\\n"
   end

  TEST1: eq "Sparticus", S0
   print "not "
   ret

! TEST2: ne "Spartisnt", S0
   print "not "
   ret

  CODE
  ok 1
  ok 2
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "ne_s_s_ic");
! @{[ compare_strings( 0, "ne", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
--- 274,383 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_s_sc_ic");
! @{[ compare_strings( 2, "eq", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
! CODE
! ok
! OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_sc_sc_ic");
! @{[ compare_strings( 3, "eq", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
! CODE
! ok
! OUTPUT

! output_is(<<CODE, <<OUTPUT, "ne_s_s_ic");
! @{[ compare_strings( 0, "ne", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
  CODE
! ok
  OUTPUT

  output_is(<<CODE, <<OUTPUT, "ne_sc_s_ic");
! @{[ compare_strings( 1, "ne", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
! CODE
! ok
! OUTPUT

! output_is(<<CODE, <<OUTPUT, "ne_s_sc_ic");
! @{[ compare_strings( 2, "ne", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
! CODE
! ok
! OUTPUT

! output_is(<<CODE, <<OUTPUT, "ne_sc_sc_ic");
! @{[ compare_strings( 3, "ne", @strings ) ]}
!     print "ok\\n"
!     end
! ERROR:
!     print "bad\\n"
!     end
  CODE
! ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "eq_s|sc_s|sc");

   set S0, "Sparticus"
   bsr TEST1
   print "ok 1\\n"
   bsr TEST2
   print "ok 2\\n"
+  bsr TEST3
+  print "ok 3\\n"
+  bsr TEST4
+  print "ok 4\\n"
   end

  TEST1: eq "Sparticus", S0
   print "not "
   ret

! TEST2: eq S0, "Sparticus"
!  print "not "
!  ret
!
! TEST3: eq S0, S0
!  print "not "
!  ret
!
! TEST4: eq "Sparticus", "Sparticus"
   print "not "
   ret

  CODE
  ok 1
  ok 2
+ ok 3
+ ok 4
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_s_s_ic");
! @{[ compare_strings( 0, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
***************
*** 279,286 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "ne_s_sc_ic");
! @{[ compare_strings( 1, "ne", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
--- 387,394 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_sc_s_ic");
! @{[ compare_strings( 1, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
***************
*** 290,297 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_s_s_ic");
! @{[ compare_strings( 0, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
--- 398,405 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_s_sc_ic");
! @{[ compare_strings( 2, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
***************
*** 301,308 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_s_sc_ic");
! @{[ compare_strings( 1, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
--- 409,416 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "lt_sc_sc_ic");
! @{[ compare_strings( 3, "lt", @strings ) ]}
      print "ok\\n"
      end
  ERROR:
***************
*** 323,329 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "le_s_sc_ic");
  @{[ compare_strings( 1, "le", @strings ) ]}
      print "ok\\n"
      end
--- 431,437 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "le_sc_s_ic");
  @{[ compare_strings( 1, "le", @strings ) ]}
      print "ok\\n"
      end
***************
*** 334,339 ****
--- 442,469 ----
  ok
  OUTPUT

+ output_is(<<CODE, <<OUTPUT, "le_s_sc_ic");
+ @{[ compare_strings( 2, "le", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
+ output_is(<<CODE, <<OUTPUT, "le_sc_sc_ic");
+ @{[ compare_strings( 3, "le", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
  output_is(<<CODE, <<OUTPUT, "gt_s_s_ic");
  @{[ compare_strings( 0, "gt", @strings ) ]}
      print "ok\\n"
***************
*** 345,351 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "gt_s_sc_ic");
  @{[ compare_strings( 1, "gt", @strings ) ]}
      print "ok\\n"
      end
--- 475,481 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "gt_sc_s_ic");
  @{[ compare_strings( 1, "gt", @strings ) ]}
      print "ok\\n"
      end
***************
*** 356,361 ****
--- 486,513 ----
  ok
  OUTPUT

+ output_is(<<CODE, <<OUTPUT, "gt_s_sc_ic");
+ @{[ compare_strings( 2, "gt", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
+ output_is(<<CODE, <<OUTPUT, "gt_sc_sc_ic");
+ @{[ compare_strings( 3, "gt", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
  output_is(<<CODE, <<OUTPUT, "ge_s_s_ic");
  @{[ compare_strings( 0, "ge", @strings ) ]}
      print "ok\\n"
***************
*** 367,373 ****
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "ge_s_sc_ic");
  @{[ compare_strings( 1, "ge", @strings ) ]}
      print "ok\\n"
      end
--- 519,525 ----
  ok
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "ge_sc_s_ic");
  @{[ compare_strings( 1, "ge", @strings ) ]}
      print "ok\\n"
      end
***************
*** 378,383 ****
--- 530,557 ----
  ok
  OUTPUT

+ output_is(<<CODE, <<OUTPUT, "ge_s_sc_ic");
+ @{[ compare_strings( 2, "ge", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
+ output_is(<<CODE, <<OUTPUT, "ge_sc_sc_ic");
+ @{[ compare_strings( 3, "ge", @strings ) ]}
+     print "ok\\n"
+     end
+ ERROR:
+     print "bad\\n"
+     end
+ CODE
+ ok
+ OUTPUT
+
  output_is(<<'CODE', <<OUTPUT, "same constant twice bug");
         set     S0, ""
         set     S1, ""
***************
*** 421,426 ****
--- 595,606 ----
   end
  CODE

+ output_is(<<'CODE',ord('a'),'2-param ord, multi-character string');
+  ord I0,"abc"
+  print I0
+  end
+ CODE
+
  output_is(<<'CODE',ord('a'),'2-param ord, one-character string register');
   set S0,"a"
   ord I0,S0
***************
*** 493,498 ****
--- 673,685 ----
   end
  CODE

+ output_is(<<'CODE','Cannot get character past end of string','3-param ord,
multi-character string register, from end, OOB');
+  set S0,"ab"
+  ord I0,S0,-3
+  print I0
+  end
+ CODE
+
  output_is(<<CODE, <<OUTPUT, "if_s_ic");
   set S0, "I've told you once, I've told you twice..."
   if S0, OK1
***************
*** 554,560 ****
  ok 9
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "repeat");
   set S0, "x"

   repeat S1, S0, 12
--- 741,747 ----
  ok 9
  OUTPUT

! output_is(<<CODE, <<OUTPUT, "repeat_s_s|sc_i|ic");
   set S0, "x"

   repeat S1, S0, 12
***************
*** 596,601 ****
--- 783,794 ----
  >< done
  OUTPUT

+ output_is(<<'CODE','Cannot repeat with negative arg','repeat OOB');
+  repeat S0, "japh", -1
+  end
+ CODE
+
+
  # Set all string registers to values given by &$_[0](reg num)
  sub set_str_regs {
    my $code = shift;
***************
*** 623,643 ****
    while (@strings) {
      my $s1 = shift @strings;
      my $s2 = shift @strings;
!     my $arg;
!     $rt .= "    set S0, \"$s1\"\n";
!     if ($const) {
!       $arg = "\"$s2\"";
      }
      else {
!       $rt .= "    set S1, \"$s2\"\n";
!       $arg = "S1";
      }
      if (eval "\"$s1\" $op \"$s2\"") {
!       $rt .= "    $op S0, $arg, OK$i\n";
        $rt .= "    branch ERROR\n";
      }
      else {
!       $rt .= "    $op S0, $arg, ERROR\n";
      }
      $rt .= "OK$i:\n";
      $i++;
--- 816,849 ----
    while (@strings) {
      my $s1 = shift @strings;
      my $s2 = shift @strings;
!     my $arg1;
!     my $arg2;
!     if ($const == 3) {
!  $arg1 = "\"$s1\"";
!  $arg2 = "\"$s2\"";
!     }
!     elsif ($const == 2) {
!  $rt .= "    set S0, \"$s1\"\n";
!  $arg1 = "S0";
!  $arg2 = "\"$s2\"";
!     }
!     elsif ($const == 1) {
!  $rt .= "    set S0, \"$s2\"\n";
!  $arg1 = "\"$s1\"";
!  $arg2 = "S0";
      }
      else {
!  $rt .= "    set S0, \"$s1\"\n";
!  $rt .= "    set S1, \"$s2\"\n";
!  $arg1 = "S0";
!  $arg2 = "S1";
      }
      if (eval "\"$s1\" $op \"$s2\"") {
!       $rt .= "    $op $arg1, $arg2, OK$i\n";
        $rt .= "    branch ERROR\n";
      }
      else {
!       $rt .= "    $op $arg1, $arg2, ERROR\n";
      }
      $rt .= "OK$i:\n";
      $i++;



Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About