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;
}
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;
}
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;
}
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;
}
