Fix yet another bug in GC, in which the instruction pointer was not
[panda.git] / src / st-object.c
blob5041745fd0d376c61d47d3b638438c261d25d17a
1 /*
2 * st-object.c
4 * Copyright (C) 2008 Vincent Geddes
6 * Permission is hereby granted, free of charge, to any person obtaining a copy
7 * of this software and associated documentation files (the "Software"), to deal
8 * in the Software without restriction, including without limitation the rights
9 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
10 * copies of the Software, and to permit persons to whom the Software is
11 * furnished to do so, subject to the following conditions:
13 * The above copyright notice and this permission notice shall be included in
14 * all copies or substantial portions of the Software.
16 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
18 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
19 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
20 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
21 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
22 * THE SOFTWARE.
25 #include "st-object.h"
26 #include "st-universe.h"
27 #include "st-behavior.h"
28 #include "st-small-integer.h"
29 #include "st-association.h"
30 #include "st-float.h"
31 #include "st-array.h"
32 #include "st-array.h"
33 #include "st-symbol.h"
34 #include "st-object.h"
35 #include "st-character.h"
36 #include "st-unicode.h"
38 void
39 st_object_initialize_header (st_oop object, st_oop class)
41 ST_OBJECT_MARK (object) = 0 | ST_MARK_TAG;
42 ST_OBJECT_HASH (object) = st_smi_new (st_current_hash++);
43 ST_OBJECT_CLASS (object) = class;
44 st_object_set_format (object, st_smi_value (ST_BEHAVIOR_FORMAT (class)));
45 st_object_set_instance_size (object, st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (class)));
48 bool
49 st_object_equal (st_oop object, st_oop other)
51 if (st_object_class (object) == st_smi_class)
52 return st_smi_equal (object, other);
54 if (st_object_class (object) == st_character_class)
55 return st_character_equal (object, other);
57 if (ST_OBJECT_CLASS (object) == st_float_class)
58 return st_float_equal (object, other);
60 if (ST_OBJECT_CLASS (object) == st_association_class)
61 return st_association_equal (object, other);
63 if (ST_OBJECT_CLASS (object) == st_symbol_class)
64 return st_symbol_equal (object, other);
66 if (ST_OBJECT_CLASS (object) == st_byte_array_class ||
67 ST_OBJECT_CLASS (object) == st_string_class)
68 return st_byte_array_equal (object, other);
70 return object == other;
73 st_uint
74 st_object_hash (st_oop object)
76 if (st_object_class (object) == st_smi_class)
77 return st_smi_hash (object);
79 if (st_object_class (object) == st_byte_array_class ||
80 st_object_class (object) == st_string_class ||
81 st_object_class (object) == st_symbol_class)
82 return st_byte_array_hash (object);
84 if (st_object_class (object) == st_float_class)
85 return st_float_hash (object);
87 if (st_object_class (object) == st_character_class)
88 return st_character_hash (object);
90 if (st_object_class (object) == st_association_class)
91 return st_association_hash (object);
93 return st_smi_value (ST_HEADER (object)->hash);
96 char *
97 st_object_printString (st_oop object)
99 char *class_name;
100 char *string;
102 class_name = (char *) st_byte_array_bytes (ST_CLASS (st_object_class (object))->name);
104 // SmallInteger
105 if (st_object_is_smi (object))
106 string = st_strdup_printf ("%li", st_smi_value (object));
108 // Float
109 else if (st_object_class (object) == st_float_class)
110 string = st_strdup_printf ("%g", st_float_value (object));
112 // ByteString
113 else if (st_object_is_string (object))
114 string = st_strdup_printf ("'%s'", (char *) st_byte_array_bytes (object));
116 // ByteSymbol
117 else if (st_object_is_symbol (object))
118 string = st_strdup_printf ("#%s", (char *) st_byte_array_bytes (object));
120 // Character
121 else if (st_object_class (object) == st_character_class) {
122 char outbuf[6] = { 0 };
123 st_unichar_to_utf8 (st_character_value (object), outbuf);
124 string = st_strdup_printf ("$%s", outbuf);
126 // Other
127 } else
128 string = st_strdup_printf ("%s", class_name);
130 return string;
133 int st_current_hash = 1;
135 st_oop
136 st_object_allocate (st_oop class)
138 st_oop *fields;
139 st_uint instance_size;
140 st_oop object;
142 instance_size = st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (class));
143 object = st_memory_allocate (ST_SIZE_OOPS (struct st_header) + instance_size);
144 st_object_initialize_header (object, class);
146 fields = ST_OBJECT_FIELDS (object);
147 for (st_uint i = 0; i < instance_size; i++)
148 fields[i] = st_nil;
150 return object;