Branch data     Line data    Source code

       1                 :            : #include "equalhash.h"
       2                 :            : 
       3                 :        540 : fltype_t *get_type(fl_context_t *fl_ctx, value_t t)
       4                 :            : {
       5                 :            :     fltype_t *ft;
       6         [ +  + ]:        540 :     if (issymbol(t)) {
       7                 :        480 :         ft = ((symbol_t*)ptr(t))->type;
       8         [ +  + ]:        480 :         if (ft != NULL)
       9                 :         60 :             return ft;
      10                 :            :     }
      11                 :        480 :     void **bp = equalhash_bp_r(&fl_ctx->TypeTable, (void*)t, (void*)fl_ctx);
      12         [ -  + ]:        480 :     if (*bp != HT_NOTFOUND)
      13                 :          0 :         return (fltype_t*)*bp;
      14                 :            : 
      15   [ +  +  +  -  :        480 :     int align, isarray=(iscons(t) && car_(t) == fl_ctx->arraysym && iscons(cdr_(t)));
                   +  - ]
      16                 :            :     size_t sz;
      17   [ +  +  +  - ]:        480 :     if (isarray && !iscons(cdr_(cdr_(t)))) {
      18                 :            :         // special case: incomplete array type
      19                 :         60 :         sz = 0;
      20                 :            :     }
      21                 :            :     else {
      22                 :        420 :         sz = ctype_sizeof(fl_ctx, t, &align);
      23                 :            :     }
      24                 :            : 
      25                 :        480 :     ft = (fltype_t*)malloc(sizeof(fltype_t));
      26                 :            :     // TODO: if ft == NULL
      27                 :        480 :     ft->type = t;
      28         [ +  + ]:        480 :     if (issymbol(t)) {
      29                 :        420 :         ft->numtype = sym_to_numtype(fl_ctx, t);
      30                 :        420 :         ((symbol_t*)ptr(t))->type = ft;
      31                 :            :     }
      32                 :            :     else {
      33                 :         60 :         ft->numtype = (numerictype_t)N_NUMTYPES;
      34                 :            :     }
      35                 :        480 :     ft->size = sz;
      36                 :        480 :     ft->vtable = NULL;
      37                 :        480 :     ft->artype = NULL;
      38                 :        480 :     ft->marked = 1;
      39                 :        480 :     ft->elsz = 0;
      40                 :        480 :     ft->eltype = NULL;
      41                 :        480 :     ft->init = NULL;
      42         [ +  + ]:        480 :     if (iscons(t)) {
      43         [ +  - ]:         60 :         if (isarray) {
      44                 :         60 :             fltype_t *eltype = get_type(fl_ctx, car_(cdr_(t)));
      45         [ -  + ]:         60 :             if (eltype->size == 0) {
      46                 :          0 :                 free(ft);
      47                 :          0 :                 lerror(fl_ctx, fl_ctx->ArgError, "invalid array element type");
      48                 :            :             }
      49                 :         60 :             ft->elsz = eltype->size;
      50                 :         60 :             ft->eltype = eltype;
      51                 :         60 :             ft->init = &cvalue_array_init;
      52                 :         60 :             eltype->artype = ft;
      53                 :            :         }
      54                 :            :     }
      55                 :        480 :     *bp = ft;
      56                 :        480 :     return ft;
      57                 :            : }
      58                 :            : 
      59                 :          0 : fltype_t *get_array_type(fl_context_t *fl_ctx, value_t eltype)
      60                 :            : {
      61                 :          0 :     fltype_t *et = get_type(fl_ctx, eltype);
      62         [ #  # ]:          0 :     if (et->artype != NULL)
      63                 :          0 :         return et->artype;
      64                 :          0 :     return get_type(fl_ctx, fl_list2(fl_ctx, fl_ctx->arraysym, eltype));
      65                 :            : }
      66                 :            : 
      67                 :        120 : fltype_t *define_opaque_type(value_t sym, size_t sz, const cvtable_t *vtab,
      68                 :            :                              cvinitfunc_t init)
      69                 :            : {
      70                 :        120 :     fltype_t *ft = (fltype_t*)malloc(sizeof(fltype_t));
      71                 :        120 :     ft->type = sym;
      72                 :        120 :     ft->size = sz;
      73                 :        120 :     ft->numtype = (numerictype_t)N_NUMTYPES;
      74                 :        120 :     ft->vtable = vtab;
      75                 :        120 :     ft->artype = NULL;
      76                 :        120 :     ft->eltype = NULL;
      77                 :        120 :     ft->elsz = 0;
      78                 :        120 :     ft->marked = 1;
      79                 :        120 :     ft->init = init;
      80                 :        120 :     return ft;
      81                 :            : }
      82                 :            : 
      83                 :       4474 : void relocate_typetable(fl_context_t *fl_ctx)
      84                 :            : {
      85                 :       4474 :     htable_t *h = &fl_ctx->TypeTable;
      86                 :            :     size_t i;
      87                 :            :     void *nv;
      88         [ +  + ]:    2295160 :     for(i=0; i < h->size; i+=2) {
      89         [ +  + ]:    2290680 :         if (h->table[i] != HT_NOTFOUND) {
      90                 :      71584 :             nv = (void*)relocate(fl_ctx, (value_t)h->table[i]);
      91                 :      71584 :             h->table[i] = nv;
      92         [ +  - ]:      71584 :             if (h->table[i+1] != HT_NOTFOUND)
      93                 :      71584 :                 ((fltype_t*)h->table[i+1])->type = (value_t)nv;
      94                 :            :         }
      95                 :            :     }
      96                 :       4474 : }