X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cos.c;h=42b66ddc585f43eeaaf14e55bd94e7e520677d4e;hb=f047c237fb7e51822bb564f113fa0736e65c1ef9;hp=4a842b8d4fa6e56ad67ac1bada987419ba5d3c7b;hpb=73a70ba1eb49f0a0d15089e2abc45d09a49452c6;p=chise%2Fconcord.git diff --git a/cos.c b/cos.c index 4a842b8..42b66dd 100644 --- a/cos.c +++ b/cos.c @@ -67,6 +67,12 @@ cos_make_int (COS_C_Int num) return (COS_object)((COS_INT)(num << 1) | 1); } +int +cos_int_p (COS_object obj) +{ + return COS_OBJECT_INT_P (obj); +} + COS_C_Int cos_int_value (COS_object obj) { @@ -75,12 +81,6 @@ cos_int_value (COS_object obj) return INTPTR_MIN; } -int -cos_int_p (COS_object obj) -{ - return COS_OBJECT_INT_P (obj); -} - COS_object cos_make_char (int code) @@ -89,17 +89,17 @@ cos_make_char (int code) } int -cos_char_id (COS_object obj) +cos_char_p (COS_object obj) { - if (COS_OBJECT_CHAR_P (obj)) - return ((COS_INT)obj) >> 2; - return -1; + return COS_OBJECT_CHAR_P (obj); } int -cos_char_p (COS_object obj) +cos_char_id (COS_object obj) { - return COS_OBJECT_CHAR_P (obj); + if (COS_OBJECT_CHAR_P (obj)) + return (((COS_INT)obj) >> 2) & 0x7FFFFFFF; + return -1; } @@ -136,12 +136,12 @@ cos_release_object (COS_object obj) { if (COS_OBJECT_P (obj)) { - ((COS_Object)obj)->header.reference_count--; - if ( ((COS_Object)obj)->header.reference_count <= 0 ) return (*COS_Object_release_function_table [((COS_Object)obj)->header.type - COS_FAT_OBJECT_TYPE_MIN])(obj); + else + ((COS_Object)obj)->header.reference_count--; } return 0; } @@ -248,8 +248,8 @@ cos_cons (COS_object car, COS_object cdr) int cos_retain_cons (COS_Object obj) { - cos_retain_object (COS_CAR (obj)); - cos_retain_object (COS_CDR (obj)); + //cos_retain_object (COS_CAR (obj)); + //cos_retain_object (COS_CDR (obj)); return 0; } @@ -265,6 +265,12 @@ cos_release_cons (COS_Object obj) return 0; } +int +cos_cons_p (COS_object obj) +{ + return COS_OBJECT_CONS_P (obj); +} + COS_object cos_car (COS_Cons pair) { @@ -283,6 +289,29 @@ cos_cdr (COS_Cons pair) return NULL; } +COS_Cons +cos_assoc (COS_object key, COS_Cons alist) +{ + COS_Cons rest = alist; + + while ( COS_OBJECT_CONS_P (rest) ) + { + COS_Cons cell = cos_car (rest); + + if ( cos_car (cell) == key ) + return cell; + + rest = cos_cdr (rest); + } + return NULL; +} + +COS_object +cos_alist_get (COS_Cons alist, COS_object key) +{ + return cos_cdr (cos_assoc (key, alist)); +} + int cos_retain_container (COS_Object obj) @@ -474,67 +503,47 @@ concord_decode_object (COS_object ds, COS_object genre, char* id_str; char buf[256]; CONCORD_String_Tank obj_st; - COS_String obj_string; int cid; size_t end; if (index == NULL) return NULL; - printf ("decoding id (%lX)...", id); if (COS_OBJECT_INT_P (id)) { - printf ("(id is an int)..."); snprintf(buf, 256, "%ld", cos_int_value (id)); id_str = buf; } else if (COS_OBJECT_CHAR_P (id)) { - printf ("(id is a char)..."); - snprintf(buf, 256, "%ld", cos_char_id (id)); + snprintf(buf, 256, "%d", cos_char_id (id)); id_str = buf; } else if (COS_OBJECT_SYMBOL_P (id)) { - printf ("(id is a symbol)...."); id_str = cos_string_data (cos_symbol_name ((COS_Symbol)id)); } else if (COS_OBJECT_C_STRING_P (id)) { - printf ("(id is a C-string)...."); id_str = (char*)id; } else if (COS_OBJECT_STRING_P (id)) { - printf ("(id is a string)...."); id_str = cos_string_data ((COS_String)id); } else return NULL; - printf ("done (%s).\n", id_str); if ( concord_index_strid_get_obj_string (index, id_str, &obj_st) ) return NULL; - obj_string = cos_make_string ((char*)CONCORD_String_data (&obj_st), - CONCORD_String_size (&obj_st)); - cid = cos_read_char (CONCORD_String_data (&obj_st), CONCORD_String_size (&obj_st), 0, &end); if ( cid >= 0 ) { - printf ("obj = %s (%d, U+%04X), len = %d, end = %d\n", - cos_string_data (obj_string), - cid, cid, - CONCORD_String_size (&obj_st), end); - cos_release_object (obj_string); return cos_make_char (cid); } - else - printf ("obj = %s\n", cos_string_data (obj_string)); - - cos_release_object (obj_string); return NULL; } @@ -543,54 +552,36 @@ COS_object concord_object_get_feature_value (COS_object object, COS_object feature) { char id_buf[256]; + CONCORD_Genre gobj; CONCORD_Feature fobj; CONCORD_String_Tank val_st; - COS_String val_string; size_t end; - int val_cid; - COS_String val_str; - COS_object val_obj; if (COS_OBJECT_CHAR_P (object)) { - cos_utf8_print_char (object, id_buf, 256); - printf ("Object[char:0x%lX]'s id is %s.\n", object, id_buf); + cos_utf8_print_char (object, (unsigned char*)id_buf, 256); } else return NULL; - fobj = concord_get_feature (concord_current_env, - "character", feature); + if (!COS_OBJECT_DS_P (concord_current_env)) + { + concord_current_env = NULL; + return NULL; + } + + gobj = concord_get_genre (concord_current_env, "character"); + if (gobj == NULL) + return NULL; + + fobj = concord_get_feature (concord_current_env, gobj, feature); if (fobj == NULL) return NULL; if ( concord_obj_get_feature_value_string (id_buf, fobj, &val_st) ) return NULL; - val_string = cos_make_string ((char*)CONCORD_String_data (&val_st), - CONCORD_String_size (&val_st)); - printf ("obj[%s]'s %s = %s\n", - id_buf, - concord_feature_get_name (fobj), - cos_string_data (val_string)); - - val_obj = cos_read_int (CONCORD_String_data (&val_st), + return cos_read_object (CONCORD_String_data (&val_st), CONCORD_String_size (&val_st), 0, &end); - if ( val_obj != NULL ) - return val_obj; - - val_cid = cos_read_char (CONCORD_String_data (&val_st), - CONCORD_String_size (&val_st), - 0, &end); - if ( val_cid >= 0 ) - return cos_make_char (val_cid); - - val_str = cos_read_string (CONCORD_String_data (&val_st), - CONCORD_String_size (&val_st), - 0, &end); - if ( val_str != NULL ) - return val_str; - - return NULL; }