Author: mdiep
Date: Sat Jan 6 16:59:52 2007
New Revision: 16450
Modified:
trunk/languages/tcl/src/binary.c
Log:
[tcl]: Use more functions for [binary]
Modified: trunk/languages/tcl/src/binary.c
==============================================================================
--- trunk/languages/tcl/src/binary.c (original)
+++ trunk/languages/tcl/src/binary.c Sat Jan 6 16:59:52 2007
@@ -2,12 +2,45 @@
#include "parrot/parrot.h"
#include "binary.h"
+#include <stdio.h>
+
+static PMC *
+binary_scan_field(Interp *interp, char field, char *binstr, int *_pos, int
length)
+{
+ char *c;
+ double *d;
+ int len;
+ PMC *value = PMCNULL;
+ int pos = *_pos;
+ switch (field)
+ {
+ case 'c':
+ if (pos >= length)
+ break;
+ c = (char *)(binstr + pos);
+ value = pmc_new(interp, enum_class_Integer);
+ VTABLE_set_integer_native(interp, value, (INTVAL)*c);
+ pos += 1;
+ break;
+ case 'd':
+ len = sizeof(double)/sizeof(char);
+ if (pos + len > length)
+ break;
+ d = (double *)(binstr + pos);
+ value = pmc_new(interp, enum_class_Float);
+ VTABLE_set_number_native(interp, value, *d);
+ pos += len;
+ break;
+ }
+ (*_pos) = pos;
+ return value;
+}
PMC *ParTcl_binary_scan(Interp *interp, STRING *BINSTR, STRING *FORMAT)
{
char *binstr = string_to_cstring(interp, BINSTR);
- INTVAL binstrlen = string_length(interp, BINSTR);
- INTVAL binstrpos = 0;
+ int binstrlen = (int)string_length(interp, BINSTR);
+ int binstrpos = 0;
char *format = string_to_cstring(interp, FORMAT);
INTVAL formatlen = string_length(interp, FORMAT);
INTVAL formatpos = 0;
@@ -16,72 +49,49 @@
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, values, 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, values, pmcval);
- binstrpos += len;
- break;
- default:
- break;
- }
+ PMC *value = binary_scan_field(interp, format[formatpos++],
+ binstr, &binstrpos, binstrlen);
+ VTABLE_push_pmc(interp, values, value);
}
return values;
}
+static STRING *
+binary_format_field(Interp *interp, char field, STRING *binstr, PMC *value)
+{
+ char c;
+ double d;
+ INTVAL len;
+
+ switch (field)
+ {
+ case 'c':
+ c = (char)VTABLE_get_integer(interp, value);
+ binstr = string_concat(interp, binstr, string_from_cstring(interp,
&c, 1), 1);
+ break;
+ case 'd':
+ d = (double)VTABLE_get_number(interp, value);
+ len = sizeof(double)/sizeof(char);
+ binstr = string_concat(interp, binstr, string_from_cstring(interp,
&d, len), len);
+ break;
+ }
+
+ return binstr;
+}
+
STRING *ParTcl_binary_format(Interp *interp, STRING *FORMAT, PMC *values)
{
char *format = string_to_cstring(interp, FORMAT);
INTVAL formatlen = string_length(interp, FORMAT);
INTVAL pos = 0;
- INTVAL value = 0;
- STRING *binstr = string_from_cstring(interp, "", 0);
+ INTVAL valueidx = 0;
+ STRING *binstr = string_make_empty(interp, enum_stringrep_one, 128);
while (pos < formatlen)
{
- char c;
- double d;
- INTVAL len;
- switch (format[pos++])
- {
- case 'c':
- c = (char)VTABLE_get_integer_keyed_int(interp, values,
value++);
- binstr = string_concat(interp, binstr,
string_from_cstring(interp, &c, 1), 1);
- break;
- case 'd':
- d = VTABLE_get_integer_keyed_int(interp, values, value++);
- len = sizeof(double)/sizeof(char);
- binstr = string_concat(interp, binstr,
string_from_cstring(interp, &d, len), len);
- break;
- default:
- break;
- }
+ PMC *value = VTABLE_get_pmc_keyed_int(interp, values, valueidx++);
+ binstr = binary_format_field(interp, format[pos++], binstr, value);
}
return binstr;
