cvsuser 05/03/29 21:53:35
Modified: dynclasses tclstring.pmc
Log:
fix get_bool
move a bunch of variables into pmc-static vars.
Revision Changes Path
1.4 +32 -12 parrot/dynclasses/tclstring.pmc
Index: tclstring.pmc
===================================================================
RCS file: /cvs/public/parrot/dynclasses/tclstring.pmc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- tclstring.pmc 21 Nov 2004 20:50:13 -0000 1.3
+++ tclstring.pmc 30 Mar 2005 05:53:35 -0000 1.4
@@ -1,7 +1,7 @@
/* TclString.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tclstring.pmc,v 1.3 2004/11/21 20:50:13 coke Exp $
+ * $Id: tclstring.pmc,v 1.4 2005/03/30 05:53:35 coke Exp $
* Overview:
* These are the vtable functions for the TclString base class
* Data Structure and Algorithms:
@@ -13,16 +13,25 @@
#include "parrot/parrot.h"
-/* This shouldn't be necessary, IMO */
-#define enum_class_TclString -1
-
-/* this is, I'm sure, terribly inefficient. */
-#define TclString_type (pmc_type(interpreter,
string_from_cstring(interpreter, "TclString", 9)))
-#define TclInt_type (pmc_type(interpreter, string_from_cstring(interpreter,
"TclInt", 6)))
-#define TclFloat_type (pmc_type(interpreter,
string_from_cstring(interpreter, "TclFloat", 8)))
+static INTVAL dynclass_TclString;
+static INTVAL dynclass_TclFloat;
+static INTVAL dynclass_TclInt;
+static STRING *true, *false, *yes, *no;
pmclass TclString extends TclObject dynpmc group tcl_group {
+ void class_init () {
+ if (pass) {
+ dynclass_TclString = Parrot_PMC_typenum(INTERP,"TclString");
+ dynclass_TclInt = Parrot_PMC_typenum(INTERP,"TclInt");
+ dynclass_TclFloat = Parrot_PMC_typenum(INTERP,"TclFloat");
+ true = string_from_const_cstring(INTERP, "true",4);
+ false = string_from_const_cstring(INTERP, "false",5);
+ yes = string_from_const_cstring(INTERP, "yes",3);
+ no = string_from_const_cstring(INTERP, "no",2);
+ }
+ }
+
void init () {
PMC_str_val(SELF) = string_make_empty(INTERP,enum_stringrep_one,0);
PObj_custom_mark_SET(SELF);
@@ -65,8 +74,19 @@
}
INTVAL get_bool () {
- /* This is the perl truth value - fissit */
- return string_bool(INTERP, PMC_str_val(SELF));
+
+ STRING* s = (STRING*) PMC_str_val(SELF);
+ if (!string_compare(INTERP,s,true)) {
+ return 1;
+ } else if (!string_compare(INTERP,s,false)) {
+ return 0;
+ } else if (!string_compare(INTERP,s,yes)) {
+ return 1;
+ } else if (!string_compare(INTERP,s,no)) {
+ return 0;
+ }
+
+ return 0; /* XXX Throw exception about invalid boolean type. */
}
INTVAL is_same (PMC* other) {
@@ -78,12 +98,12 @@
}
void set_integer_native (INTVAL value) {
- DYNSELF.morph(TclInt_type);
+ DYNSELF.morph(dynclass_TclInt);
DYNSELF.set_integer_native(value);
}
void set_number_native (FLOATVAL value) {
- DYNSELF.morph(TclFloat_type);
+ DYNSELF.morph(dynclass_TclFloat);
DYNSELF.set_number_native(value);
}
