Changeset 557


Ignore:
Timestamp:
Apr 30, 2011, 12:24:44 AM (12 years ago)
Author:
Sam Hocevar
Message:

lisp: fix a crash in the garbage collection of cons_cells lying outside
of main space.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • abuse/trunk/src/lisp/lisp_gc.cpp

    r555 r557  
    114114static LObject *CollectObject(LObject *x)
    115115{
    116   LObject *ret = x;
    117 
    118   if (((uint8_t *)x) >= cstart && ((uint8_t *)x) < cend)
    119   {
    120     switch (item_type(x))
    121     {
    122       case L_BAD_CELL:
    123         lbreak("error: GC corrupted cell\n");
    124         break;
    125       case L_NUMBER:
    126         ret = LNumber::Create(((LNumber *)x)->num);
    127         break;
    128       case L_SYS_FUNCTION:
    129         ret = new_lisp_sys_function(((LSysFunction *)x)->min_args,
    130                                     ((LSysFunction *)x)->max_args,
    131                                     ((LSysFunction *)x)->fun_number);
    132         break;
    133       case L_USER_FUNCTION:
    134       {
    135         LUserFunction *fun = (LUserFunction *)x;
    136         LList *arg = (LList *)CollectObject(fun->arg_list);
    137         LList *block = (LList *)CollectObject(fun->block_list);
    138         ret = new_lisp_user_function(arg, block);
    139         break;
    140       }
    141       case L_STRING:
    142         ret = LString::Create(lstring_value(x));
    143         break;
    144       case L_CHARACTER:
    145         ret = LChar::Create(lcharacter_value(x));
    146         break;
    147       case L_C_FUNCTION:
    148         ret = new_lisp_c_function(((LSysFunction *)x)->min_args,
     116    LObject *ret = x;
     117
     118    if ((uint8_t *)x >= cstart && (uint8_t *)x < cend)
     119    {
     120        switch (item_type(x))
     121        {
     122        case L_BAD_CELL:
     123            lbreak("error: collecting corrupted cell\n");
     124            break;
     125        case L_NUMBER:
     126            ret = LNumber::Create(((LNumber *)x)->num);
     127            break;
     128        case L_SYS_FUNCTION:
     129            ret = new_lisp_sys_function(((LSysFunction *)x)->min_args,
     130                                        ((LSysFunction *)x)->max_args,
     131                                        ((LSysFunction *)x)->fun_number);
     132            break;
     133        case L_USER_FUNCTION:
     134        {
     135            LUserFunction *fun = (LUserFunction *)x;
     136            LList *arg = (LList *)CollectObject(fun->arg_list);
     137            LList *block = (LList *)CollectObject(fun->block_list);
     138            ret = new_lisp_user_function(arg, block);
     139            break;
     140        }
     141        case L_STRING:
     142            ret = LString::Create(lstring_value(x));
     143            break;
     144        case L_CHARACTER:
     145            ret = LChar::Create(lcharacter_value(x));
     146            break;
     147        case L_C_FUNCTION:
     148            ret = new_lisp_c_function(((LSysFunction *)x)->min_args,
     149                                      ((LSysFunction *)x)->max_args,
     150                                      ((LSysFunction *)x)->fun_number);
     151            break;
     152        case L_C_BOOL:
     153            ret = new_lisp_c_bool(((LSysFunction *)x)->min_args,
    149154                                  ((LSysFunction *)x)->max_args,
    150155                                  ((LSysFunction *)x)->fun_number);
    151         break;
    152       case L_C_BOOL:
    153         ret = new_lisp_c_bool(((LSysFunction *)x)->min_args,
    154                               ((LSysFunction *)x)->max_args,
    155                               ((LSysFunction *)x)->fun_number);
    156         break;
    157       case L_L_FUNCTION:
    158         ret = new_user_lisp_function(((LSysFunction *)x)->min_args,
    159                                      ((LSysFunction *)x)->max_args,
    160                                      ((LSysFunction *)x)->fun_number);
    161         break;
    162       case L_POINTER:
    163         ret = LPointer::Create(lpointer_value(x));
    164         break;
    165       case L_1D_ARRAY:
    166         ret = CollectArray((LArray *)x);
    167         break;
    168       case L_FIXED_POINT:
    169         ret = LFixedPoint::Create(lfixed_point_value(x));
    170         break;
    171       case L_CONS_CELL:
    172         ret = CollectList((LList *)x);
    173         break;
    174       case L_OBJECT_VAR:
    175         ret = LObjectVar::Create(((LObjectVar *)x)->index);
    176         break;
    177       case L_COLLECTED_OBJECT:
    178         ret = ((LRedirect *)x)->ref;
    179         break;
    180       default:
    181         lbreak("shouldn't happen. collecting bad object 0x%x\n", item_type(x));
    182         break;
    183     }
    184     ((LRedirect *)x)->type = L_COLLECTED_OBJECT;
    185     ((LRedirect *)x)->ref = ret;
    186   }
    187   else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
    188   {
    189     if (item_type(x) == L_CONS_CELL) // still need to remap cons_cells outside of space
    190     {
    191       for (; x && item_type(x) == L_CONS_CELL; x = CDR(x))
    192         ((LList *)x)->car = CollectObject(((LList *)x)->car);
    193       if (x)
    194         ((LList *)x)->cdr = CollectObject(((LList *)x)->cdr);
    195     }
    196   }
    197 
    198   return ret;
     156            break;
     157        case L_L_FUNCTION:
     158            ret = new_user_lisp_function(((LSysFunction *)x)->min_args,
     159                                         ((LSysFunction *)x)->max_args,
     160                                         ((LSysFunction *)x)->fun_number);
     161            break;
     162        case L_POINTER:
     163            ret = LPointer::Create(lpointer_value(x));
     164            break;
     165        case L_1D_ARRAY:
     166            ret = CollectArray((LArray *)x);
     167            break;
     168        case L_FIXED_POINT:
     169            ret = LFixedPoint::Create(lfixed_point_value(x));
     170            break;
     171        case L_CONS_CELL:
     172            ret = CollectList((LList *)x);
     173            break;
     174        case L_OBJECT_VAR:
     175            ret = LObjectVar::Create(((LObjectVar *)x)->index);
     176            break;
     177        case L_COLLECTED_OBJECT:
     178            ret = ((LRedirect *)x)->ref;
     179            break;
     180        default:
     181            lbreak("error: collecting bad object 0x%x\n", item_type(x));
     182            break;
     183        }
     184        ((LRedirect *)x)->type = L_COLLECTED_OBJECT;
     185        ((LRedirect *)x)->ref = ret;
     186    }
     187    else if ((uint8_t *)x < collected_start || (uint8_t *)x >= collected_end)
     188    {
     189        // Still need to remap cons_cells lying outside of space, for
     190        // instance on the stack.
     191        for (LObject *cell = NULL; x; cell = x, x = CDR(x))
     192        {
     193            if (item_type(x) != L_CONS_CELL)
     194            {
     195                if (cell)
     196                    CDR(cell) = CollectObject(CDR(cell));
     197                break;
     198            }
     199            CAR(x) = CollectObject(CAR(x));
     200        }
     201    }
     202
     203    return ret;
    199204}
    200205
Note: See TracChangeset for help on using the changeset viewer.