-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

-- This file contains hand-specialized versions of certain time-critical
-- routines.

-- "short term" addition until the specialization pragams
-- are stable and working or we get no-runtime-cost debugging.
method if(@:true, tc:&():void):void (** control_structure **) { eval(tc) }
method if(@:false, tc:&():void):void (** control_structure **) { }
method if_false(@:true, fc:&():void):void (** control_structure **) { }
method if_false(@:false, fc:&():void):void (** control_structure **) {eval(fc)}


-- Specialized iterators for vectors that avoid doing bounds checking inside
-- of the loop.  The 'right' thing to do is to implement some kind of
-- bounds checking optimization, but that's fairly hard, so we'll do this
-- instead.

method do_associations(v@:vector[`T], c:&(int,T):void):void (** inline **) {
    v.range_do(0, v.length, c);
}

-- evaluates cl on all elements in [max(start,0) .. min(stop,len))
-- (note half-open interval!)
method range_do(v@:vector[`T], tagged_start@:int, tagged_stop@:int, 
		cl:&(int,T):void):void (** inline **) {
    prim rtl: "
        decl int start := unbox_int tagged_start;
        if start >=_int_log 0 goto start_OK;	-- ensure start >= 0
	start := 0;
      label start_OK;
        decl int stop := unbox_int tagged_stop;
        decl int len := num_elems_int v;
        if stop <=_int_log len goto stop_OK;	-- ensure stop <= len
	stop := len;
      label stop_OK;
        if start >=_int_log stop goto exit;
      label l3;
        decl OOP elem := v[start] OOP;
        decl OOP tagged_i := box_int start;
        decl OOP junk := send eval(cl, tagged_i, elem);
        start := start +_int 1;
        if start <_int_log stop goto l3;
      label exit;
        return void;
" }


prim c_++ {
#ifdef INDEXED_FIELDS
static int char_field_offset = -1;
static void lookup_char_field_offset(OOP p) {
    FieldEntry* e = p->map()->findField("value@anon:char:");
    if (e == NULL) {
      fatal("expected to find a 'value' field in char_obj");
    }
    char_field_offset = e->offset;
}
inline u_char getCharValue(OOP f) {
  if (char_field_offset == -1) lookup_char_field_offset(f);
  return GF_OOP(f, char_field_offset, u_char);
}
extern DECL_EXTERN_MAP(char_obj);
inline bool isChar(OOP f) {
    return f->map() == BASE_MAP(char_obj);
}
#else
inline u_char getCharValue(OOP f) {
    return f->asChar()->ch;
}
inline bool isChar(OOP f) {
    return f->isChar();
}
#endif
};

method includes(s@:vstring, c:char):bool (** return_type(true, false),
					     sends(),
					     formals_escape(f,f) **) {
  prim c_++: "
    if (!isChar(c)) {
      fatalEnv(currentEnv,
 	       \"includes called on vstring with non-char argument\");
    }
    char ch = getCharValue(c);
    int len = NUM_ELEMS(s);
    char* b = VEC_ELEMS(s,char);
    bool found = false;
    for (int i = 0; i < len; i++) {
      if (b[i] == ch) {
        found = true;
        break;
      }
    }
#ifdef DISPATCHERS
    RETURN(found ? BASE(true) : BASE(false));
#else
    BP(found ? BASE(true) : BASE(false));
#endif
"
}


prim c_++: "
#ifdef VORTEX_LINUX
// for some reason, memcmp, which is claimed to be a built-in function under
// gcc-2.x, isn't being treated as a built-in, and it isn't defined in the
// library, either, so I'll just define it explicitly here.
int memcmp(const void *s1, const void *s2, size_t n) {
  for(; n > 0; n--, s1 = (const char*)s1 + 1, s2 = (const char*)s2 + 1) {
    unsigned char c1 = *(const unsigned char*)s1;
    unsigned char c2 = *(const unsigned char*)s2;
    if (c1 < c2) return -1;
    if (c1 > c2) return  1;
  }
  return 0;
}
#endif
";

-- Performance hack:  a little better than what would happen if we had inlining
-- working and specialization had decided to specialize = for vstrings.
method =(s1@:vstring, s2@:vstring):bool (** return_type(true, false),
					    sends(),
					    formals_escape(f,f) **) {
    prim c_++ {
	int len;
	bool same =
	  (s1 == s2 || 
	   ((len=NUM_ELEMS(s1)) == NUM_ELEMS(s2) &&
	    (memcmp(VEC_ELEMS(s1,char), VEC_ELEMS(s2,char), len) == 0)));
#ifdef DISPATCHERS
        RETURN(same ? BASE(true) : BASE(false));
#else
        BP(same ? BASE(true) : BASE(false));
#endif
    }
}   


-- Performance hack:  be sure that this returns the same result as 
-- the hash function for ordered_collections in ordered.cecil
method hash(s@:vstring, range:int):int (** return_type(int), sends(),
					   formals_escape(f,f) **) {
    prim
    c_++: "
        if (!range->isInt()) {
          fatalEnv(currentEnv,
		   \"hash called on vstring with non-int range\");
        }
        int len = NUM_ELEMS(s);
        char* c = VEC_ELEMS(s,char);
        int h = 0;
        int r = range->asInt();
	int hash_shift = 4;
	int num_int_bits = 31;
	int num_hash_bits = num_int_bits - (num_int_bits % hash_shift);
	int right_shift = num_hash_bits - hash_shift;
        for (int i = 0; i < len; i++) {
          h = (h << hash_shift) + ((wordInt)c[i] % r);
	  unsigned g = (unsigned)h >> right_shift;
	  if (g) {
	    h = (h ^ g) ^ (g << right_shift);
	  }
        }
        h = (h << 1) >> 1;   // Lose 1 bit to appear as if we computed 31 bits
        if (h < 0) {
          h = 0 - h;
        }
#ifdef DISPATCHERS
        RETURN(asTaggedInt(h % r));
#else
        BP(asTaggedInt(h % r));
#endif
"
}   


prim c_++ {
#ifdef INDEXED_FIELDS
extern "C" OOP create_initialized_m__vstring_obj(int);
#endif
};

-- Another scanner performance hack.  Overrides the more general Cecil method.
method ||(s1@:vstring, s2@:vstring):string (** return_type(m_string), 
					       sends(), 
					       formals_escape(f,f) **) {
  prim c_++: "
    int len1 = NUM_ELEMS(s1);
    int len2 = NUM_ELEMS(s2);
#ifdef INDEXED_FIELDS
    OOP strNew = create_initialized_m__vstring_obj(len1+len2);
#else
    OOP strNew = newCecilMutableStringObjectNoInit(len1+len2)->asOop();
#endif
    memcpy(VEC_ELEMS(strNew,char),      VEC_ELEMS(s1,char), len1);
    memcpy(VEC_ELEMS(strNew,char)+len1, VEC_ELEMS(s2,char), len2);
#ifdef DISPATCHERS
    RETURN(strNew);
#else
    BP(strNew);
#endif
"
}

-- Performance hack.  Speeds up the scanner considerably.  Overrides the
-- more general Cecil implementation.
method write_into_string_at_pos(s1:string, s2@:m_vstring, pos:int):void {
    write_into_string_at_pos(s1.as_vstring, s2, pos) }
method write_into_string_at_pos(s1@:vstring, s2@:m_vstring, posoop@:int
				):void (** return_type(void), sends(),
					   formals_escape(f,f,f) **) {
  prim
      c_++: "
    int pos = posoop->asInt();
    int len1 = NUM_ELEMS(s1);
    int len2 = NUM_ELEMS(s2);
    if (pos < 0 || pos + len1 > len2) {
      fatalEnv(currentEnv,
               \"indices out of bounds in write_into_string_at_pos\");
    }
    memcpy(VEC_ELEMS(s2,char)+pos, VEC_ELEMS(s1,char), len1);
#ifdef DISPATCHERS
    RETURN(BASE(void));
#else
    BP(BASE(void));
#endif
"
}