Author: mdiep
Date: Fri Jan 5 13:22:51 2007
New Revision: 16423
Modified:
trunk/languages/tcl/src/ops/tcl.ops
Log:
[tcl]: Add beginnings of dynops for [binary scan] and [binary format]
Modified: trunk/languages/tcl/src/ops/tcl.ops
==============================================================================
--- trunk/languages/tcl/src/ops/tcl.ops (original)
+++ trunk/languages/tcl/src/ops/tcl.ops Fri Jan 5 13:22:51 2007
@@ -23,6 +23,85 @@
=cut
+=head1 C<[binary]> opcodes
+
+=over 4
+
+=item B<tcl_binary_scan>(out PMC, in STR, in STR)
+
+Scan $2 for the fields specified in $3 and return their values in $1.
+
+=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)
+ {
+ INTVAL d, len;
+ PMC *pmcval;
+ switch (format[formatpos++])
+ {
+ case 'd':
+ len = sizeof(int)/sizeof(char);
+ if (binstrpos + len > binstrlen)
+ {
+ formatpos = formatlen;
+ break;
+ }
+ d = *(binstr + binstrpos);
+ pmcval = pmc_new(interp, enum_class_Integer);
+ VTABLE_set_integer_native(interp, pmcval, d);
+ VTABLE_push_pmc(interp, $1, pmcval);
+ break;
+ default:
+ break;
+ }
+ }
+
+ goto NEXT();
+}
+
+=item B<tcl_binary_format>(out STR, in STR, in PMC)
+
+Format the values in $3 into a string $1 according to the format in $2.
+
+=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)
+ {
+ INTVAL d, len;
+ switch (format[pos++])
+ {
+ case 'd':
+ d = VTABLE_get_integer_keyed_int(interp, $3, value++);
+ len = sizeof(int)/sizeof(char);
+ $1 = string_concat(interp, $1, string_from_cstring(interp,
&d, len), len);
+ break;
+ default:
+ break;
+ }
+ }
+
+ goto NEXT();
+}
+
+=back
+
=head1 Flow control opcodes
These opcodes are used to generate exception return values. (Anything that
