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

[paultcochrane]

Author: paultcochrane
Date: Sat Jan  6 14:41:46 2007
New Revision: 16448

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

Log:
getting a "commit message empty" message when smerging back with svk,
hopefully adding this message will fix the problem

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 14:41:46 2007
@@ -36,7 +36,53 @@
 =cut
 
 inline op tcl_binary_scan(out PMC, in STR, in STR) {
-    $1 = ParTcl_binary_scan(interp, $2, $3);
+    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;
+        }
+    }
+
     goto NEXT();
 }
 
@@ -47,7 +93,33 @@
 =cut
 
 inline op tcl_binary_format(out STR, in STR, in PMC) {
-    $1 = ParTcl_binary_format(interp, $2, $3);
+    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;
+        }
+    }
+
     goto NEXT();
 }