示例#1
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**nest**  
> Creates a fresh stack with current TOS on it. Saves current dstack onto
> rstack.
*/
bvm_cache *nest(bvm_cache *this_bvm){ // nest#

    mword *nest_body = dstack_get(this_bvm,0);
//    mword *new_stack = dstack_get(this_bvm,1);
    mword *save_TOS = dstack_get(this_bvm,1);

    popd(this_bvm);
    popd(this_bvm);

    mword *save_dstack = (mword*)icar(this_bvm->dstack_ptr);
    mword *save_ustack = (mword*)icar(this_bvm->ustack_ptr);

    clear(this_bvm); // clear the stack

    //rgive(this_bvm, new_stack);
    pushd(this_bvm, save_TOS, IMMORTAL);

    mword *nest_return = (mword*)icdr(icar(this_bvm->code_ptr));

    mword *nest_rstack_entry = consa2(this_bvm, save_dstack,
                                    consa2(this_bvm, save_ustack,
                                        consa2(this_bvm, nest_return, nil)));

    pushr(this_bvm, nest_rstack_entry, _hash8(C2B("/babel/tag/nest")));

    this_bvm->code_ptr = consa2(this_bvm, nest_body,nil);

    icar(this_bvm->advance_type) = BVM_CONTINUE;

    return this_bvm;    

}
示例#2
0
文件: stack.c 项目: lucciano/Babel
inline mword *get_from_udr_stack(bvm_cache *this_bvm, mword *stack_ptr, mword stack_index){ // get_from_udr_stack#

//    return _chain_deref( this_bvm->sym_table, (mword*)icar( _ith( (mword*)icar( stack_ptr ), stack_index )) );
//    return (mword*)icar( _ith( (mword*)icar( stack_ptr ), stack_index ));
    return _chain_deref( this_bvm, (mword*)icar( _ith( (mword*)icar( stack_ptr ), stack_index )) );

}
示例#3
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**clear**  
> Empties the stack  
*/
bvm_cache *clear(bvm_cache *this_bvm){ // clear#

    (mword*)icar(this_bvm->dstack_ptr) = nil;
    (mword*)icar(this_bvm->ustack_ptr) = nil;

    return this_bvm;

}
示例#4
0
文件: stack.c 项目: lucciano/Babel
inline mword *set_in_udr_stack(bvm_cache *this_bvm, mword *stack_ptr, mword stack_index, mword *bs){ // set_in_udr_stack#

//    mword *stack_entry = _chain_deref( this_bvm->sym_table, (mword*)icar( icar( _ith( stack_ptr, stack_index ))) );
    mword *stack_entry = (mword*)icar( icar( _ith( stack_ptr, stack_index )));

    (mword*)c(stack_entry,0) = bs;

    return stack_entry;

}
示例#5
0
文件: bpdl.c 项目: claytonkb/Babel
void inline_bpdl_sym_list(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl_sym_list#

#ifdef BPDL_TRACE
_trace;
#endif

    insym(this_bvm, 
        _hash8( this_bvm, bpdl_quote_to_bstruct( this_bvm, (mword*)icar(sexpr) ) ),
        inline_bpdl( this_bvm, (mword*)icar((mword*)icdr(sexpr)) ));

}
示例#6
0
文件: stack.c 项目: lucciano/Babel
mword *pop_udr_stack(mword *stack_ptr){ // pop_udr_stack#

    //mword *temp = (mword*)icar(icar(stack_ptr));
    mword *temp = (mword*)icar(stack_ptr);

    (mword*)*stack_ptr = _pop((mword*)icar(stack_ptr));

    free_lumbar(temp);

    return (mword*)icar(temp);

    //return temp;

}
示例#7
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**take**  
> Takes TOS items from the stack and puts them into a list. 
> If TOS == -1, the entire stack is taken.  
*/
bvm_cache *take(bvm_cache *this_bvm){ // take#

    int count = (int)icar(dstack_get(this_bvm,0));
    popd(this_bvm);

    mword *result = nil;
    mword *list_entry;
    mword *temp;
    int i;

    if(count == -1){
//        while(!is_nil(this_bvm->dstack_ptr)){
        while(!dstack_empty(this_bvm)){
            list_entry = dstack_get(this_bvm,0);
            result = consa2(this_bvm, list_entry, result);
            popd(this_bvm);
        }
    }
    else{
        for(i=0;i<count;i++){
            list_entry = dstack_get(this_bvm,0);
            result = consa2(this_bvm, list_entry, result);
            popd(this_bvm);
        }
    }
    
    pushd(this_bvm, result, IMMORTAL);

    return this_bvm;

}
示例#8
0
文件: bpdl.c 项目: claytonkb/Babel
mword *inline_bpdl_hash_list(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl_hash_list#

#ifdef BPDL_TRACE
_trace;
#endif

    return _hash8( this_bvm, bpdl_quote_to_bstruct( this_bvm, (mword*)icar(sexpr) ) );

}
示例#9
0
文件: stack.c 项目: lucciano/Babel
inline mword *zap_from_udr_stack(bvm_cache *this_bvm, mword *stack_ptr, mword stack_index){ // zap_from_udr_stack#

    mword *temp;
    mword *zapped;
    mword *tail;
    mword length;
    mword *work_stack = (mword*)car(stack_ptr);

    if(stack_index==0){
        pop_udr_stack(stack_ptr);
        //work_stack = pop_udr_stack(stack_ptr);

        //temp = pop_udr_stack(work_stack);
        //(mword*)c(temp,0) = nil;
        //_del(temp);
    }
    else{
        length = _len(work_stack);
        if( length > stack_index+1 ){
            zapped = _list_cut(work_stack,   stack_index);
            tail   = _list_cut(zapped,      1);
            (mword*)c(icar(zapped),0) = nil;
            //_dump(zapped);
            //die;
            //_del(zapped);
            _append_direct(this_bvm, work_stack,tail);
        }
        else if( length > stack_index ){
            zapped = _list_cut(work_stack, stack_index);
            (mword*)c(zapped,0) = nil;
            //_del(zapped);
        }
        // else do nothing
    }

    (mword*)icar(stack_ptr) = work_stack;

//    _dump(stack_ptr);
//    die;

    return stack_ptr;

}
示例#10
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**depth**  
> Places the depth of the stack on TOS. To gather up the entire stack
> into a list:  
>  
> depth take  
*/
bvm_cache *depth(bvm_cache *this_bvm){ // depth#

    mword *result = _new2va( this_bvm, 1);

    *result = _len((mword*)icar(this_bvm->dstack_ptr));

    pushd(this_bvm, result, IMMORTAL);

    return this_bvm;

}
示例#11
0
文件: bpdl.c 项目: claytonkb/Babel
// XXX: This does not handle [tag "foo"] syntax for vals... 
//
mword *inline_bpdl_tag_list(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl_tag_list#

#ifdef BPDL_TRACE
_trace;
#endif

    mword *tag = _hash8( this_bvm, bpdl_quote_to_bstruct( this_bvm, (mword*)icar(sexpr) ) );
//    mword *pay = inline_bpdl( this_bvm, (mword*)icar((mword*)icdr(sexpr)) );
    mword *pay = inline_bpdl( this_bvm, (mword*)icdr(sexpr) );
//    mword *pay = inline_bpdl_list_list( this_bvm, (mword*)icdr(sexpr) );

    return tptr_new(this_bvm, tag, pay);//_bons(this_bvm, leaf_list);

}
示例#12
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**sel** (?)  
> Selects one of the top two values on the stack:  
> `{f} {X} {Y}| -> {X}|`  
> `{t} {X} {Y}| -> {Y}|`  
> `{f} [X] {Y}| -> [X]|`  
> `{t} [X] {Y}| -> {Y}|`  
> etc.  
>  
> Where f = 0 and t != 0  
*/
bvm_cache *sel(bvm_cache *this_bvm){ // sel#

    mword *temp = pop_udr_stack(this_bvm->dstack_ptr);

    if(!is_false(icar(temp))){
        popd(this_bvm);
    }
    else{
        remove_from_udr_stack(this_bvm, this_bvm->dstack_ptr, 1);
    }

    return this_bvm;

}
示例#13
0
文件: bpdl.c 项目: claytonkb/Babel
mword *inline_bpdl_label_list(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl_label_list#

    mword *sexpr_label = (mword*)icar(sexpr);

    if(bpdl_is_label_nil(sexpr_label)){
        return nil;
    }

    mword *macro_code_list;
    mword *bpdl_list;
    mword *result = nil;
    mword *bpdl_label = _lf2by(this_bvm, sexpr_label);
    mword *bpdl_label_hash = _hash8(this_bvm,bpdl_label);

    if(trie_exists(this_bvm, bpdl_macro_table, bpdl_label_hash, nil)){

        bpdl_list = inline_bpdl_list_list(this_bvm, (mword *)icdr(sexpr));

        macro_code_list =
            _cons( this_bvm, 
                    _cp( this_bvm, _ith( this_bvm, trie_lookup_hash(this_bvm, bpdl_macro_table, bpdl_label_hash, nil), 2) ),
                    nil);

//        result = lib_babelc(this_bvm, (mword*)icar(macro_code_list), bpdl_list); 
        result = lib_babelcs(this_bvm, (mword*)icar(macro_code_list), bpdl_list, this_bvm->soft_root); 

    }
    else{

        _fatal("Unrecognized label-list"); //FIXME Throw exception

    }

    return result;

}
示例#14
0
文件: stack.c 项目: lucciano/Babel
/* stack operator
**swap** (<->)  
> Named after the Joy operator  
> Swaps the top two items on the stack.  
> `{X} {Y}| -> {Y} {X}|`  
> `[X] {Y}| -> {Y} [X]|`  
> etc.  
*/
bvm_cache *swap(bvm_cache *this_bvm){ // swap#

    // stack_ptr -> A -> B -> C
    // 
    // stack_ptr -> B
    // B -> A
    // A -> C

    //FIXME: Depth-check the stack

    mword *A = (mword*)icar(this_bvm->dstack_ptr);
    mword *B = (mword*)icdr(A);
    mword *C = (mword*)icdr(B);

    (mword*)c(this_bvm->dstack_ptr,0) = B;
    (mword*)icdr(B) = A;
    (mword*)icdr(A) = C;

    return this_bvm;

}
示例#15
0
文件: stack.c 项目: lucciano/Babel
// same as pop_udr_stack except calls mc_free if PACMAN tag
//
void zap_udr_stack(mword *stack_ptr){ // zap_udr_stack#

    mword *free_ptr = (mword*)icar(stack_ptr);

    mword *tag = (mword*)icar(icdr(icar(icar(stack_ptr))));
    mword *temp = (mword*)icar(icar(icar(stack_ptr)));

    (mword*)*stack_ptr = _pop((mword*)icar(stack_ptr));

    //_dump(stack_ptr);

//    trace;
//    _mem(temp);
//    printf("\n");

    if(is_tptr(tag) && tageq(tag,BABEL_TAG_PACMAN,TAG_SIZE)){
        //printf("MATCH\n");
        mc_free(temp);
    }

    free_lumbar(free_ptr);

}
示例#16
0
文件: bpdl.c 项目: claytonkb/Babel
mword *rinline_bpdl_ptr_list(bvm_cache *this_bvm, mword *sexpr){ // rinline_bpdl_ptr_list#

#ifdef BPDL_TRACE
_trace;
#endif

    // 1. string
    // 2. number
    // 3. label (lookup in sym-table)
    // 4. recurse inline_bpdl
    mword entry_type;
    mword *list_head = nil;
    mword *list_curr = nil;
    mword *new_entry;
    mword *bpdl_label;
    mword *bpdl_label_hash;

    while(!is_nil(sexpr)){

        entry_type = get_bpdl_list_entry_type((mword*)icar(sexpr));

        switch(entry_type){

            case BPDL_LIST_ENTRY_DNUMBER:
            case BPDL_LIST_ENTRY_HNUMBER:
            case BPDL_LIST_ENTRY_DQUOTE:
            case BPDL_LIST_ENTRY_SQUOTE:

                new_entry = 
                    _cons( this_bvm,
                        bpdl_const_to_bstruct(
                            this_bvm, 
                            (mword*)icar(sexpr), 
                            entry_type),
                        nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_LABEL:

                bpdl_label = _lf2by(this_bvm, (mword*)icar(sexpr));
                bpdl_label_hash = _hash8(this_bvm,bpdl_label);

                if(_arcmp((mword*)icar(sexpr), SEXPR_NIL_SYMBOL) == 0){
                    new_entry =
                        _cons( this_bvm,
                               lusym(this_bvm, 
                                   _hash8( this_bvm, bpdl_label )),
                            nil);
                }
                else{

                    if(exsym(this_bvm, bpdl_label_hash)){ // XXX PERF (double-lookup)

                        new_entry =
                            _cons( this_bvm,
                               lusym(this_bvm, 
                                   bpdl_label_hash),
                                       nil);

                    }
                    else{
                        new_entry =
                            _cons( this_bvm, 
                                tptr_new(this_bvm, BABEL_TAG_REF_SYM_LOCAL, tptr_new(this_bvm, bpdl_label_hash, nil)),
                                nil);
                    }

                }

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_INTE:

                new_entry =
                    _cons( this_bvm,
                        inline_bpdl(this_bvm, (mword*)icar(sexpr)),
                        nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            default:

                _fatal("Unrecognized bpdl ptr list entry"); //FIXME Throw exception

        }

        sexpr = (mword*)icdr(sexpr);

    }

    return list_head;

}
示例#17
0
文件: bpdl.c 项目: claytonkb/Babel
mword *rinline_bpdl_val_list(bvm_cache *this_bvm, mword *sexpr){ // rinline_bpdl_val_list#

#ifdef BPDL_TRACE
_trace;
#endif

    // 1. string
    // 2. number
    // 3. label (lookup in sym-table)
    // 4. recurse inline_bpdl
    mword entry_type;
    mword *list_head = nil;
    mword *list_curr = nil;
    mword *new_entry;

    while(!is_nil(sexpr)){

        entry_type = get_bpdl_list_entry_type((mword*)icar(sexpr));

        switch(entry_type){

            case BPDL_LIST_ENTRY_DNUMBER:
            case BPDL_LIST_ENTRY_HNUMBER:
            case BPDL_LIST_ENTRY_DQUOTE:
            case BPDL_LIST_ENTRY_SQUOTE:

                new_entry = 
                    _cons( this_bvm,
                        bpdl_const_to_bstruct(
                            this_bvm, 
                            (mword*)icar(sexpr), 
                            entry_type),
                        nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_LABEL:

                new_entry =
                    _cons( this_bvm,
                           lusym2(this_bvm, 
                               _lf2by(this_bvm, 
                               (mword*)icar(sexpr))),
                        nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_INTE:

                _fatal("Can't nest inside val/leaf array");

                break;

            default:

                _fatal("Unrecognized bpdl val list entry"); //FIXME Throw exception

        }

        sexpr = (mword*)icdr(sexpr);

    }

    return list_head;

}
示例#18
0
文件: bpdl.c 项目: claytonkb/Babel
mword *inline_bpdl_code_list(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl_code_list#

#ifdef BPDL_TRACE
_trace;
#endif

    // 1. string
    // 2. number
    // 3. built-in (opcodes)
    // 3. label (lookup in sym-table)
    // 4. recurse inline_bpdl
    mword entry_type;
    mword *list_head = nil;
    mword *list_curr = nil;
    mword *new_entry;
    mword *bpdl_label;
    mword *bpdl_label_hash;

    while(!is_nil(sexpr)){

        entry_type = get_bpdl_list_entry_type((mword*)icar(sexpr));

        switch(entry_type){

            case BPDL_LIST_ENTRY_DNUMBER:
            case BPDL_LIST_ENTRY_HNUMBER:
            case BPDL_LIST_ENTRY_DQUOTE:
            case BPDL_LIST_ENTRY_SQUOTE:

                new_entry = 
                    _cons( this_bvm,
                        _cons( this_bvm,
                            bpdl_const_to_bstruct(
                                this_bvm, 
                                (mword*)icar(sexpr), 
                                entry_type),
                            nil), nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_LABEL:
                if(_arcmp((mword*)icar(sexpr), SEXPR_NIL_SYMBOL) == 0){
                        new_entry =
                            _cons( this_bvm, 
                                    _cons( this_bvm,
                                        nil,
                                        nil), nil);
                }
                else{

                    // if built-in:
                    //   substitute opcode-value
                    bpdl_label = _lf2by(this_bvm, (mword*)icar(sexpr));
                    bpdl_label_hash = _hash8(this_bvm,bpdl_label);

                    if(trie_exists(this_bvm, bpdl_opcode_table, bpdl_label_hash, nil)){
                        new_entry =
                            _cons( this_bvm, 
                                    _cp( this_bvm, _ith( this_bvm, trie_lookup_hash(this_bvm, bpdl_opcode_table, bpdl_label_hash, nil), 2) ),
                                    nil);
                    }
                    else{

                        new_entry =
                            _cons( this_bvm, 
                                tptr_new(this_bvm, bpdl_label_hash, nil),
                                nil);

                    }

                }

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            case BPDL_LIST_ENTRY_INTE:

                new_entry =
                    _cons( this_bvm,
                        _cons( this_bvm,
                            inline_bpdl(this_bvm, (mword*)icar(sexpr)),
                            nil), nil);

                if(is_nil(list_head)){
                    list_head = list_curr = new_entry;
                }
                else{
                    _append_direct(this_bvm, list_curr, new_entry);
                    list_curr = (mword*)icdr(list_curr); // Save unnecessary traversal
                }

                break;

            default:
                _d(entry_type);
                _fatal("Unrecognized bpdl list entry"); //FIXME Throw exception

        }

        sexpr = (mword*)icdr(sexpr);

    }

    return list_head;

}
示例#19
0
文件: bpdl.c 项目: claytonkb/Babel
// Differs from _bpdl because no named-sections and assumes all symbols
// pre-exist in symbol-table
//
mword *inline_bpdl(bvm_cache *this_bvm, mword *sexpr){ // inline_bpdl#

#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_trace;
#endif

    if(is_nil(sexpr)){
        return nil;
    }

    mword bpdl_list_type = get_bpdl_list_type(sexpr);

    switch(bpdl_list_type){

        case BPDL_LIST_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_LIST_LIST");
#endif
            return inline_bpdl_list_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_CODE_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_CODE_LIST");
#endif
            return inline_bpdl_code_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_SHORT_VAL_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_SHORT_VAL_LIST");
#endif
            return inline_bpdl_val_list(this_bvm, sexpr);


        case BPDL_VAL_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_VAL_LIST");
#endif
            return inline_bpdl_val_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_SHORT_PTR_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_SHORT_PTR_LIST");
#endif
            return inline_bpdl_ptr_list(this_bvm, sexpr);


        case BPDL_PTR_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_PTR_LIST");
#endif
            return inline_bpdl_ptr_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_TAG_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_TAG_LIST");
#endif
            return inline_bpdl_tag_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_HASH_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_HASH_LIST");
#endif
            return inline_bpdl_hash_list(this_bvm, (mword*)icdr(sexpr));


        case BPDL_SYM_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_SYM_LIST");
#endif
            //inline_bpdl_sym_list(this_bvm, (mword*)icdr(sexpr));
            return nil;


        case BPDL_BS_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_BS_LIST");
#endif
            return nil; // XXX UNIMPLEMENTED

        case BPDL_QW_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_QW_LIST");
#endif
            return nil; // XXX UNIMPLEMENTED

        case BPDL_SEXPR_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_SEXPR_LIST");
#endif
            return (mword*)icar((mword*)icdr(sexpr));

        case BPDL_LABEL_LIST:
#if(defined BPDL_TRACE || defined INLINE_BPDL_TRACE)
_msg("BPDL_LABEL_LIST");
#endif
// XXX macros go here ... XXX

//            return bpdl_lookup_label(this_bvm, (mword*)icar(sexpr));
            return inline_bpdl_label_list(this_bvm, sexpr);

        default: // BPDL_UNKNOWN_LIST
            _msg("Unrecognized list type");
            _dump(sexpr);
            _die;

    }

    return nil;

}
示例#20
0
文件: bpdl.c 项目: claytonkb/Babel
mword get_bpdl_list_type(mword *sexpr){ // get_bpdl_list_type#

#ifdef BPDL_TRACE
_trace;
#endif

    if(!is_inte(sexpr) || !is_leaf(icar(sexpr))){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_UNKNOWN_LIST;
    }

#ifdef BPDL_TRACE
_trace;
#endif

    sexpr = (mword*)icar(sexpr);

#ifdef BPDL_TRACE
_trace;
#endif

    if(     _arcmp(sexpr, SEXPR_LIST_SYMBOL) == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_LIST_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_SEXPR_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_SEXPR_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_CODE_SYMBOL) == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_CODE_LIST;
    }
//    else if( bpdl_is_const_like(sexpr) ){
    else if( bpdl_is_number(sexpr) ){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_SHORT_VAL_LIST;
    }
    else if( _arcmp(sexpr, SEXPR_VAL_SYMBOL) == 0 ){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_VAL_LIST;
    }
    else if( bpdl_is_string(sexpr) ){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_SHORT_PTR_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_PTR_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_PTR_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_HASH_SYMBOL) == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_HASH_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_TAG_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_TAG_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_REF_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_REF_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_SYM_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_SYM_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_BS_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_BS_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_QW_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_QW_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_TPTR_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_TPTR_LIST;
    }
    else if(_arcmp(sexpr, SEXPR_BYTES_SYMBOL)  == 0){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_BYTES_LIST;
    }
    else if( !bpdl_is_const_like(sexpr) ){
#ifdef BPDL_TRACE
_trace;
#endif
        return BPDL_LABEL_LIST;
    }

#ifdef BPDL_TRACE
_trace;
#endif

    return BPDL_UNKNOWN_LIST;

}