array-primops-0.1.0.0: cbits/smallArray.cmm

#include "Cmm.h"

consSmallArray(gcptr elem, gcptr src) {
    W_ words, old_size, new_size;
    gcptr dst, dst_p, src_end;
                                                               
    again: MAYBE_GC(again); 
             
    old_size = StgSmallMutArrPtrs_ptrs(src);
    new_size = old_size + 1;

    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgSmallMutArrPtrs_ptrs(dst) = new_size;                                
                        
    dst_p   = dst + SIZEOF_StgSmallMutArrPtrs;                   
    src     = src + SIZEOF_StgSmallMutArrPtrs;
    src_end = src + WDS(old_size);

    W_[dst_p] = elem;
    dst_p = dst_p + WDS(1);

  while:                                                       
    if (src != src_end) {                                         
        W_[dst_p] = W_[src];                                 
        dst_p = dst_p + WDS(1);                                
        src   = src   + WDS(1);                                
        goto while;                                            
    }                                                          
                                                               
    return (dst);
}

snocSmallArray(gcptr src, gcptr elem) {
    W_ words, old_size, new_size;
    gcptr dst, dst_p, src_end;
                                                               
    again: MAYBE_GC(again); 
             
    old_size = StgSmallMutArrPtrs_ptrs(src);
    new_size = old_size + 1;

    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0); 
    SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgSmallMutArrPtrs_ptrs(dst) = new_size;                                
                        
    dst_p   = dst + SIZEOF_StgSmallMutArrPtrs;                   
    src     = src + SIZEOF_StgSmallMutArrPtrs;
    src_end = src + WDS(old_size);

  while:                                                       
    if (src != src_end) {                                         
        W_[dst_p] = W_[src];                                 
        dst_p = dst_p + WDS(1);                                
        src   = src   + WDS(1);                                
        goto while;                                            
    }
    
    W_[dst_p] = elem;                                             
                                                               
    return (dst);
}

insertSmallArray(W_ index, gcptr elem, gcptr src) {
    W_ words, size;
    gcptr src_p, dst, dst_p, dst_end, ins_p;

    again: MAYBE_GC(again);

    size = StgSmallMutArrPtrs_ptrs(src) + 1;

    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(size), 0);
    SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);
    StgSmallMutArrPtrs_ptrs(dst) = size;

    src_p   = src + SIZEOF_StgSmallMutArrPtrs;
    dst_p   = dst + SIZEOF_StgSmallMutArrPtrs;                   
    ins_p   = dst_p + WDS(index);
    dst_end = dst_p + WDS(size);    

    W_[ins_p] = elem;

  while1:
    if (dst_p != ins_p) {
       W_[dst_p] = W_[src_p];
       dst_p = dst_p + WDS(1);
       src_p = src_p + WDS(1);
       goto while1;
    }
    
    dst_p = dst_p + WDS(1);

  while2:
    if (dst_p != dst_end){
       W_[dst_p] = W_[src_p];
       dst_p = dst_p + WDS(1);
       src_p = src_p + WDS(1);      
       goto while2;
    }

    return (dst);
}

deleteSmallArray(W_ index, gcptr src) {
    W_ words, old_size, new_size;
    gcptr src_p, dst, dst_p, src_end, del_p;

    again: MAYBE_GC(again);

    old_size = StgSmallMutArrPtrs_ptrs(src);
    new_size = old_size - 1;

    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_info, CCCS);
    StgSmallMutArrPtrs_ptrs(dst) = new_size;

    src_p   = src + SIZEOF_StgSmallMutArrPtrs;
    dst_p   = dst + SIZEOF_StgSmallMutArrPtrs;                   
    del_p   = src_p + WDS(index);
    src_end = src_p + WDS(old_size);    

  while1:
    if (src_p != del_p) {
       W_[dst_p] = W_[src_p];
       dst_p = dst_p + WDS(1);
       src_p = src_p + WDS(1);
       goto while1;
    }
    
    src_p = src_p + WDS(1);

  while2:
    if (src_p != src_end){
       W_[dst_p] = W_[src_p];
       dst_p = dst_p + WDS(1);
       src_p = src_p + WDS(1);      
       goto while2;
    }

    return (dst);
}