[svn:parrot] r16457 - trunk/languages/tcl/src/ops

[mdiep]

Author: mdiep
Date: Sat Jan  6 21:55:14 2007
New Revision: 16457

Modified:
   trunk/languages/tcl/src/ops/tcl.ops

Log:
[tcl]: Restore the new tcl.ops code

Modified: trunk/languages/tcl/src/ops/tcl.ops
==============================================================================
--- trunk/languages/tcl/src/ops/tcl.ops (original)
+++ trunk/languages/tcl/src/ops/tcl.ops Sat Jan  6 21:55:14 2007
@@ -36,53 +36,7 @@
 =cut
 
 inline op tcl_binary_scan(out PMC, in STR, in STR) {
-    char *binstr     = string_to_cstring(interp, $2);
-    INTVAL binstrlen = string_length(interp, $2);
-    INTVAL binstrpos = 0;
-    char *format     = string_to_cstring(interp, $3);
-    INTVAL formatlen = string_length(interp, $3);
-    INTVAL formatpos = 0;
-    INTVAL value     = 0;
-    $1               = pmc_new(interp, enum_class_ResizablePMCArray);
-
-    while (formatpos < formatlen)
-    {
-        char *c;
-        double *d;
-        INTVAL len;
-        PMC *pmcval;
-        switch (format[formatpos++])
-        {
-            case 'c':
-                if (binstrpos + 1 > binstrlen)
-                {
-                    formatpos = formatlen;
-                    break;
-                }
-                c = binstr + binstrpos;
-                pmcval = pmc_new(interp, enum_class_Integer);
-                VTABLE_set_integer_native(interp, pmcval, (int)(char)*c);
-                VTABLE_push_pmc(interp, $1, pmcval);
-                binstrpos += 1;
-                break;
-            case 'd':
-                len = sizeof(double)/sizeof(char);
-                if (binstrpos + len > binstrlen)
-                {
-                    formatpos = formatlen;
-                    break;
-                }
-                d = (double *)(binstr + binstrpos);
-                pmcval = pmc_new(interp, enum_class_Float);
-                VTABLE_set_number_native(interp, pmcval, *d);
-                VTABLE_push_pmc(interp, $1, pmcval);
-                binstrpos += len;
-                break;
-            default:
-                break;
-        }
-    }
-
+    $1 = ParTcl_binary_scan(interp, $2, $3);
     goto NEXT();
 }
 
@@ -93,33 +47,7 @@
 =cut
 
 inline op tcl_binary_format(out STR, in STR, in PMC) {
-    char *format      = string_to_cstring(interp, $2);
-    INTVAL formatlen  = string_length(interp, $2);
-    INTVAL pos        = 0;
-    INTVAL value      = 0;
-    $1                = string_from_cstring(interp, "", 0);
-
-    while (pos < formatlen)
-    {
-        char c;
-        double d;
-        INTVAL len;
-        switch (format[pos++])
-        {
-            case 'c':
-                c  = (char)VTABLE_get_integer_keyed_int(interp, $3, value++);
-                $1 = string_concat(interp, $1, string_from_cstring(interp, &c, 
1), 1);
-                break;
-            case 'd':
-                d   = VTABLE_get_integer_keyed_int(interp, $3, value++);
-                len = sizeof(double)/sizeof(char);
-                $1  = string_concat(interp, $1, string_from_cstring(interp, 
&d, len), len);
-                break;
-            default:
-                break;
-        }
-    }
-
+    $1 = ParTcl_binary_format(interp, $2, $3);
     goto NEXT();
 }