array-primops-0.1.0.0: cbits/array.cmm

#include "Cmm.h"

consArray(gcptr elem, gcptr src) {
    W_ words, old_ptrs, new_ptrs, new_size;
    gcptr dst, dst_p, src_end;
                                                               
    again: MAYBE_GC(again); 
             
    old_ptrs = StgMutArrPtrs_ptrs(src);
    new_ptrs = old_ptrs + 1;
    new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);

    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgMutArrPtrs_ptrs(dst) = new_ptrs;
    StgMutArrPtrs_size(dst) = new_size;                               
                        
    dst_p   = dst + SIZEOF_StgMutArrPtrs;                   
    src     = src + SIZEOF_StgMutArrPtrs;
    src_end = src + WDS(old_ptrs);

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

snocArray(gcptr src, gcptr elem) {
    W_ words, old_ptrs, new_ptrs, new_size;
    gcptr dst, dst_p, src_end;
                                                               
    again: MAYBE_GC(again); 
             
    old_ptrs = StgMutArrPtrs_ptrs(src);
    new_ptrs = old_ptrs + 1;
    new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);

    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgMutArrPtrs_ptrs(dst) = new_ptrs;
    StgMutArrPtrs_size(dst) = new_size;                                  
                        
    dst_p   = dst + SIZEOF_StgMutArrPtrs;                   
    src     = src + SIZEOF_StgMutArrPtrs;
    src_end = src + WDS(old_ptrs);

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

insertArray(W_ index, gcptr elem, gcptr src) {
    W_ words, old_ptrs, new_ptrs, new_size;
    gcptr src_p, dst, dst_p, dst_end, ins_p;
                                                               
    again: MAYBE_GC(again); 
             
    old_ptrs = StgMutArrPtrs_ptrs(src);
    new_ptrs = old_ptrs + 1;
    new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);

    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgMutArrPtrs_ptrs(dst) = new_ptrs;
    StgMutArrPtrs_size(dst) = new_size;   

    src_p   = src + SIZEOF_StgMutArrPtrs;
    dst_p   = dst + SIZEOF_StgMutArrPtrs;                   
    ins_p   = dst_p + WDS(index);
    dst_end = dst_p + WDS(new_ptrs);    

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

deleteArray(W_ index, gcptr src) {

    W_ words, old_ptrs, new_ptrs, new_size;
    gcptr src_p, src_end, dst, dst_p, dst_end, del_p;
                                                               
    again: MAYBE_GC(again); 
             
    old_ptrs = StgMutArrPtrs_ptrs(src);
    new_ptrs = old_ptrs - 1;
    new_size = new_ptrs + mutArrPtrsCardWords(new_ptrs);

    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + new_size;
    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); 
    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(new_size), 0);
    SET_HDR(dst, stg_MUT_ARR_PTRS_FROZEN_info, CCCS);                                 
    StgMutArrPtrs_ptrs(dst) = new_ptrs;
    StgMutArrPtrs_size(dst) = new_size;   

    src_p   = src + SIZEOF_StgMutArrPtrs;
    dst_p   = dst + SIZEOF_StgMutArrPtrs;                   
    del_p   = src_p + WDS(index);
    src_end = src_p + WDS(old_ptrs);    

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