/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/


/* Conversions between types */

#include "arith.internal.h"


int
ar_convert_to_integral
		(ar_data *result, const AR_TYPE *resulttype,
   const ar_data *opnd,   const AR_TYPE *opndtype) {

	int status = AR_STAT_OK;
	int maxnegint;
	int rsltsz, opndsz;

	if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT) {
		switch (*opndtype) {
		case AR_Float_Cray1_64:
		case AR_Float_Cray1_64_F:
			status = ar_cfix64 (&result->ar_i64, &opnd->ar_f64, 64);
			break;
		case AR_Float_Cray1_128:
			status = ar_cfix128 (&result->ar_i64,
					     &opnd->ar_f128, 64);
			break;
		case AR_Float_IEEE_NR_32:
		case AR_Float_IEEE_ZE_32:
		case AR_Float_IEEE_UP_32:
		case AR_Float_IEEE_DN_32:
			status = ar_ifix32 (&result->ar_i64, &opnd->ar_ieee32,
					    64, ROUND_MODE (*opndtype));
			break;
		case AR_Float_IEEE_NR_64:
		case AR_Float_IEEE_ZE_64:
		case AR_Float_IEEE_UP_64:
		case AR_Float_IEEE_DN_64:
			status = ar_ifix64 (&result->ar_i64, &opnd->ar_ieee64,
					    64, ROUND_MODE (*opndtype));
			break;
		case AR_Float_IEEE_NR_128:
		case AR_Float_IEEE_ZE_128:
		case AR_Float_IEEE_UP_128:
		case AR_Float_IEEE_DN_128:
			status = ar_ifix128 (&result->ar_i64, &opnd->ar_ieee128,
					    64, ROUND_MODE (*opndtype));
			break;
		case AR_Complex_Cray1_64:
		case AR_Complex_Cray1_64_F:
			status = ar_cfix64 (&result->ar_i64,
					    &opnd->ar_cplx_f64.real, 64);
			break;
		case AR_Complex_Cray1_128:
			status = ar_cfix128 (&result->ar_i64,
					     &opnd->ar_cplx_f128.real, 64);
			break;
		case AR_Complex_IEEE_NR_32:
		case AR_Complex_IEEE_ZE_32:
		case AR_Complex_IEEE_UP_32:
		case AR_Complex_IEEE_DN_32:
		{
			AR_IEEE_32 realpart;

			CPLX32_REAL_TO_IEEE32(realpart, opnd->ar_cplx_ieee32);
			status = ar_ifix32 (&result->ar_i64, &realpart,
					    64, ROUND_MODE (*opndtype));
			break;
		}
		case AR_Complex_IEEE_NR_64:
		case AR_Complex_IEEE_ZE_64:
		case AR_Complex_IEEE_UP_64:
		case AR_Complex_IEEE_DN_64:
			status = ar_ifix64 (&result->ar_i64,
					    &opnd->ar_cplx_ieee64.real,
					    64, ROUND_MODE (*opndtype));
			break;
		case AR_Complex_IEEE_NR_128:
		case AR_Complex_IEEE_ZE_128:
		case AR_Complex_IEEE_UP_128:
		case AR_Complex_IEEE_DN_128:
			status = ar_ifix128(&result->ar_i64,
					    &opnd->ar_cplx_ieee128.real,
					    64, ROUND_MODE (*opndtype));
			break;

		default:
			return AR_STAT_INVALID_TYPE;
		}

	}

	else if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) {
		result->ar_i64 = opnd->ar_i64;
	}

	else if (AR_CLASS (*opndtype) == AR_CLASS_INT) {
	        if (*opndtype != AR_Int_8_S && *resulttype == AR_Int_8_S) {
		    result->ar_i8.part1 = opnd->ar_i64.part1;
		    result->ar_i8.part2 = opnd->ar_i64.part2;
		    result->ar_i8.part3 = opnd->ar_i64.part3;
		    result->ar_i8.part4 = opnd->ar_i64.part4 >> 8;
		    result->ar_i8.part5 = opnd->ar_i64.part4;

	        } else if (*opndtype == AR_Int_8_S && *resulttype != AR_Int_8_S) {
		    result->ar_i64.part1 = opnd->ar_i8.part1;
		    result->ar_i64.part2 = opnd->ar_i8.part2;
		    result->ar_i64.part3 = opnd->ar_i8.part3;
		    result->ar_i64.part4 = (opnd->ar_i8.part4 << 8) |
                                            opnd->ar_i8.part5;

		} else
		    result->ar_i64 = opnd->ar_i64;

		opndsz = AR_INT_SIZE(*opndtype);
		if(opndsz == AR_INT_SIZE_46) opndsz = AR_INT_SIZE_64;
		rsltsz = AR_INT_SIZE(*resulttype);
		if(rsltsz == AR_INT_SIZE_46) rsltsz = AR_INT_SIZE_64;

		if (AR_SIGNEDNESS (*opndtype) == AR_SIGNED) {
			/* operand is signed; sign extend to 64-bit int */
			if (opndsz == AR_INT_SIZE_8 && INT8_SIGN(opnd)) {
				/* 8-bit operand is negative; extend the sign */
				maxnegint = IS_INT8_UPPER_ZERO(opnd) &&
							(opnd->ar_i8.part5 == 0x80);
				result->ar_i64.part1  = 0xFFFF;
				result->ar_i64.part2  = 0xFFFF;
				result->ar_i64.part3  = 0xFFFF;
				result->ar_i64.part4 |= 0xFF00;
			}
			else if (opndsz == AR_INT_SIZE_16 && INT16_SIGN(opnd)) {
				maxnegint = IS_INT16_UPPER_ZERO(opnd) &&
							(opnd->ar_i64.part4 == 0x8000);
				/* 16-bit operand is negative; extend the sign*/
				result->ar_i64.part1 = 0xFFFF;
				result->ar_i64.part2 = 0xFFFF;
				result->ar_i64.part3 = 0xFFFF;
			}
			else if (opndsz == AR_INT_SIZE_24 && INT24_SIGN(opnd)) {
				maxnegint = IS_INT24_UPPER_ZERO(opnd) &&
							(opnd->ar_i64.part3 == 0x80) &&
							(opnd->ar_i64.part4 == 0x0);
				/* 24-bit operand is negative; extend the sign*/
				result->ar_i64.part1  = 0xFFFF;
				result->ar_i64.part2  = 0xFFFF;
				result->ar_i64.part3 |= 0xFF00;
			}
			else if (opndsz == AR_INT_SIZE_32 && INT32_SIGN(opnd)) {
				maxnegint = IS_INT32_UPPER_ZERO(opnd) &&
							(opnd->ar_i64.part3 == 0x8000) &&
							(opnd->ar_i64.part4 == 0);
				/* 32-bit operand is negative; extend the sign*/
				result->ar_i64.part1 = 0xFFFF;
				result->ar_i64.part2 = 0xFFFF;
			}
			else
				maxnegint = (opnd->ar_i64.part1 == 0x8000) &&
							(opnd->ar_i64.part2 == 0) &&
							(opnd->ar_i64.part3 == 0) &&
							(opnd->ar_i64.part4 == 0);

			if ((result->ar_i64.part1 & 0x8000) &&
				(AR_SIGNEDNESS (*resulttype) == AR_UNSIGNED)) {
				/* operand is negative and result is unsigned;
				   original value cannot be preserved */
				if(opndsz == rsltsz)
					status |= AR_STAT_SEMIVALID;
				if(opndsz != rsltsz || !maxnegint)
					status |= AR_STAT_OVERFLOW;
			}
		}
		else if (AR_SIGNEDNESS(*resulttype) == AR_SIGNED && rsltsz == opndsz) {
			/* operand is unsigned, same size result is signed */
			switch (AR_INT_SIZE (*opndtype)) {
			case AR_INT_SIZE_8:
				if (INT8_SIGN(opnd)) {
					status |= AR_STAT_SEMIVALID;
					if(opnd->ar_i8.part5 != 0x80)
						status |= AR_STAT_OVERFLOW;
				}
				break;

			case AR_INT_SIZE_16:
				if (INT16_SIGN(opnd)) {
					status |= AR_STAT_SEMIVALID;
					if(opnd->ar_i64.part4 != 0x8000)
						status |= AR_STAT_OVERFLOW;
				}
				break;

			case AR_INT_SIZE_24:
				if (INT24_SIGN(opnd)) {
					status |= AR_STAT_SEMIVALID;
					if(opnd->ar_i64.part3 != 0x80 ||
					   opnd->ar_i64.part4 != 0)
						status |= AR_STAT_OVERFLOW;
				}
				break;

			case AR_INT_SIZE_32:
				if (INT32_SIGN(opnd)) {
					status |= AR_STAT_SEMIVALID;
					if(opnd->ar_i64.part3 != 0x8000 ||
					   opnd->ar_i64.part4 != 0)
						status |= AR_STAT_OVERFLOW;
				}
				break;

			case AR_INT_SIZE_46:
			case AR_INT_SIZE_64:
				if(INT64_SIGN(opnd)) {
					status |= AR_STAT_SEMIVALID;
					if(opnd->ar_i64.part1 != 0x8000 ||
					   opnd->ar_i64.part2 != 0 ||
					   opnd->ar_i64.part3 != 0 ||
					   opnd->ar_i64.part4 != 0)
						status |= AR_STAT_OVERFLOW;
				}
				break;

			default:
				return (AR_STAT_INVALID_TYPE);
			}

			if(status & (AR_STAT_SEMIVALID | AR_STAT_OVERFLOW))
				status |= AR_STAT_NEGATIVE;
		}
		else {
			/* operand is unsigned and result is different size */
			if (INT64_SIGN(result) &&
			    (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) {
				/* result is negative; we have overflow */
				status |= AR_STAT_OVERFLOW;
			}
		}        
	}
	else
		return AR_STAT_INVALID_TYPE;

	/* At this point, regardless of the original operand type, we've converted
	   it to a 64-bit int.  Now, check for overflow, negative. */

	/* If resulttype is AR_INT_SIZE_8 then make sure result has data
	 * in the correct places when being converted from type FLOAT.
	 * */
	if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT && AR_INT_SIZE(*resulttype) == AR_INT_SIZE_8) {
	    ar_data tmp_res;
	    tmp_res.ar_i64 = result->ar_i64;
	    result->ar_i8.part4 = tmp_res.ar_i64.part4 >> 8;
	    result->ar_i8.part5 = tmp_res.ar_i64.part4 & 0xFF;
	}
	if(!(status & AR_STAT_SEMIVALID))
		switch (*resulttype) {
                case AR_Int_8_S:
                        if (!(result->ar_i8.part1 == 0xffff &&
                              result->ar_i8.part2 == 0xffff &&
                              result->ar_i8.part3 == 0xffff &&
                              result->ar_i8.part4 ==   0xff &&
                              INT8_SIGN(result) == 0x80)&&
                            !(IS_INT8_UPPER_ZERO(result) &&
                              INT8_SIGN(result) == 0)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        if (INT8_SIGN(result))
                                status |= AR_STAT_NEGATIVE;
                        break;

                case AR_Int_8_U:
                        if (!IS_INT8_UPPER_ZERO(result)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        break;

                case AR_Int_16_S:
                        if (!(result->ar_i64.part1 == 0xffff &&
                              result->ar_i64.part2 == 0xffff &&
                              result->ar_i64.part3 == 0xffff &&
                              INT16_SIGN(result) == 0x8000)&&
                            !(IS_INT16_UPPER_ZERO(result) &&
                              INT16_SIGN(result) == 0)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        if (INT16_SIGN(result))
                                status |= AR_STAT_NEGATIVE;
                        break;

                case AR_Int_16_U:
                        if (!IS_INT16_UPPER_ZERO(result)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        break;

                case AR_Int_24_S:
                        if (!(result->ar_i64.part1 == 0xffff &&
                              result->ar_i64.part2 == 0xffff &&
                              (result->ar_i64.part3&0xff00) == 0xff00 &&
                              INT24_SIGN(result) == 0x0080)&&
                            !(IS_INT24_UPPER_ZERO(result) &&
                              INT24_SIGN(result) == 0)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        if (INT24_SIGN(result))
                                status |= AR_STAT_NEGATIVE;
                        break;

                case AR_Int_24_U:
                        if (!IS_INT24_UPPER_ZERO(result)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        break;

                case AR_Int_32_S:
                        if (!(result->ar_i64.part1 == 0xffff &&
                              result->ar_i64.part2 == 0xffff &&
                              INT32_SIGN(result) == 0x8000)&&
                            !(IS_INT32_UPPER_ZERO(result) &&
                              INT32_SIGN(result) == 0)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        if (INT32_SIGN(result))
                                status |= AR_STAT_NEGATIVE;

                        break;

                case AR_Int_32_U:
                        if (!IS_INT32_UPPER_ZERO(result)) {
                                status |= AR_STAT_OVERFLOW;
                        }
                        break;

                case AR_Int_46_S:
                        if (INT_OVERFLOWS_46_BITS(*result))
                                status |= AR_STAT_OVERFLOW;
                        if (INT64_SIGN(result))
                                status |= AR_STAT_NEGATIVE;
                        break;

                case AR_Int_64_S:
                        if (INT64_SIGN(result))
                                status |= AR_STAT_NEGATIVE;
                        break;
		}

        ar_clear_unused_bits(result, resulttype);

        if (IS_INT64_ZERO(result))
                status |= AR_STAT_ZERO;

        return status;
}

static
int
ar_convert_to_pointer
		(ar_data *result, const AR_TYPE *resulttype,
   const ar_data *opnd,   const AR_TYPE *opndtype) {

      AR_TYPE unsigned_word_type = AR_Int_64_U;


	if (AR_CLASS (*opndtype) == AR_CLASS_INT)
		/* for some reason, we don't sign extend when converting to a
		   word pointer, but we do if converting to other pointers... */
		if (AR_POINTER_FORMAT (*resulttype) != AR_POINTER_WORD) {
			ar_convert_to_integral (result, &unsigned_word_type,
						opnd, opndtype);
		}
		else {
			result->ar_i64 = opnd->ar_i64;
		}

	else if (AR_CLASS (*opndtype) == AR_CLASS_POINTER) {

		result->ar_i64 = opnd->ar_i64;
		if (*resulttype == *opndtype)
			return AR_STAT_OK;
		/* if either the result or the operand is a byte pointer
                   (and the other isn't from the previous test):  ERROR  */
		if (*resulttype == AR_Pointer_Byte ||
		    *opndtype == AR_Pointer_Byte)
			return AR_STAT_INVALID_TYPE;

		if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_WORD) {
			if (AR_POINTER_FORMAT (*opndtype) == AR_POINTER_FCTN) {
				/* convert parcel address to word address */
				ar_dblshift(result, &unsigned_word_type,
					(const ar_data*)&AR_const_zero, result, 2);
			}

		} else if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_FCTN) {
			if (AR_POINTER_FORMAT (*opndtype) == AR_POINTER_WORD) {
				/* convert word address to parcel address */
				ar_dblshift(result, &unsigned_word_type,
					(const ar_data*)&AR_const_zero, result, 126);
			}
		}
	} else
		return AR_STAT_INVALID_TYPE;

	ar_clear_unused_bits (result, resulttype);
	return AR_STAT_OK;
}

int
ar_convert_to_float
		(ar_data *result, const AR_TYPE *resulttype,
   const ar_data *opnd,   const AR_TYPE *opndtype) {

	ar_data re, im, sint64;
	AR_TYPE reimtype, sint64type = AR_Int_64_S;
	int status = AR_STAT_OK;

	if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT) {

		if (AR_FLOAT_IS_COMPLEX (*opndtype) == AR_FLOAT_COMPLEX)
			status |= ar_decompose_complex (&re, &im, &reimtype,
							opnd, opndtype);
		else {
			re = *opnd;
			reimtype = *opndtype;
		}

		if (AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_CRAY)
			if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64)
				if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE)
					if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
						status |= ar_itoc64 (&result->ar_f64, &re.ar_ieee64, AR_ROUND_NEAREST);
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) {
						status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32);
						status |= ar_itoc64 (&result->ar_f64, &im.ar_ieee64, AR_ROUND_NEAREST);
					} else
						return AR_STAT_INVALID_TYPE;
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) {
					result->ar_f64 = re.ar_f64;
					status = AR_status ((AR_DATA*)result, resulttype);
				} else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128)
					status |= ar_c128to64 (&result->ar_f64,
							       &re.ar_f128);
				else
					return AR_STAT_INVALID_TYPE;
			else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128)
				if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE)
					if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
						status |= ar_i64toc128 (&result->ar_f128, &re.ar_ieee64);
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) {
						status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32);
						status |= ar_i64toc128 (&result->ar_f128, &im.ar_ieee64);
					} else
						return AR_STAT_INVALID_TYPE;
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) {
					result->ar_f128 = re.ar_f128;
					status = AR_status ((AR_DATA*)result, resulttype);
				} else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
					status |= ar_c64to128 (&result->ar_f128,
							       &re.ar_f64);
				else
					return AR_STAT_INVALID_TYPE;
			else
				return AR_STAT_INVALID_TYPE;

		else {
			/* AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_IEEE */
			if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_32) {
				if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) {
					if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) {
						result->ar_ieee32 = re.ar_ieee32;
						status |= AR_status ((AR_DATA*)result, resulttype);
					} else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
						status |= ar_i64to32 (&result->ar_ieee32, &re.ar_ieee64, AR_ROUND_NEAREST);
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) {
						status |= ar_i128to64 (&im.ar_ieee64, &re.ar_ieee128, AR_ROUND_NEAREST);
						status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST);
					}
					else
						return AR_STAT_INVALID_TYPE;
				}
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) {
					status |= ar_c128toi64 (&im.ar_ieee64, &re.ar_f128);
					status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST);
				} else {
					status |= ar_ctoi64 (&im.ar_ieee64, &re.ar_f64);
					status |= ar_i64to32 (&result->ar_ieee32, &im.ar_ieee64, AR_ROUND_NEAREST);
				}
			}
			else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) {
				if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) {
					if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32)
						status |= ar_i32to64 (&result->ar_ieee64, &re.ar_ieee32);
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64) {
						result->ar_ieee64 = re.ar_ieee64;
						return AR_status ((AR_DATA*)result, resulttype);
					}
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128)
						status |= ar_i128to64 (&result->ar_ieee64, &re.ar_ieee128, AR_ROUND_NEAREST);
					else
						return AR_STAT_INVALID_TYPE;
				}
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) {
					status |= ar_ctoi128 (&im.ar_ieee128, &re.ar_f128);
					status |= ar_i128to64 (&result->ar_ieee64, &im.ar_ieee128, AR_ROUND_NEAREST);
				}
				else {
					status |= ar_ctoi64 (&result->ar_ieee64, &re.ar_f64);
				}
			}

			else if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) {
				if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_IEEE) {
					if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32) {
						status |= ar_i32to64 (&im.ar_ieee64, &re.ar_ieee32);
						status |= ar_i64to128 (&result->ar_ieee128, &im.ar_ieee64);
					}
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
						status |= ar_i64to128 (&result->ar_ieee128, &re.ar_ieee64);
					else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128) {
						result->ar_ieee128 = re.ar_ieee128;
						return AR_status ((AR_DATA*)result, resulttype);
					}
					else
						return AR_STAT_INVALID_TYPE;
				}
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128)
					status |= ar_ctoi128 (&result->ar_ieee128, &re.ar_f128);
				else {
					status |= ar_ctoi64 (&im.ar_ieee64, &re.ar_f64);
					status |= ar_i64to128(&result->ar_ieee128, &im.ar_ieee64);
				}
			}

			else if (AR_FLOAT_FORMAT (reimtype) == AR_FLOAT_CRAY)
				if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_128)
					status |= ar_c128toi64 (&result->ar_ieee64, &re.ar_f128);
				else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_64)
					status |= ar_ctoi64 (&result->ar_ieee64, &re.ar_f64);
				else
					return AR_STAT_INVALID_TYPE;
			else if (AR_FLOAT_SIZE (reimtype) == AR_FLOAT_32)
				status |= ar_i32to64 (&result->ar_ieee64, &re.ar_ieee32);
			else {
				result->ar_ieee64 = re.ar_ieee64;
				status = AR_status ((AR_DATA*)result, resulttype);
			}
		}

	} else if (AR_CLASS (*opndtype) == AR_CLASS_INT) {

		/* Convert to signed 64-bit (ignoring status) */
		ar_convert_to_integral (&sint64, &sint64type, opnd, opndtype);

		switch (*resulttype) {
		case AR_Float_Cray1_64:
		case AR_Float_Cray1_64_F:
			status |= ar_cflt64 (&result->ar_f64, &sint64.ar_i64,
					     AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED);
			break;
		case AR_Float_Cray1_128:
			status |= ar_cflt128 (&result->ar_f128, &sint64.ar_i64,
					      AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED);
			break;
		case AR_Float_IEEE_NR_32:
		case AR_Float_IEEE_ZE_32:
		case AR_Float_IEEE_UP_32:
		case AR_Float_IEEE_DN_32:
			status |= ar_iflt32 (&result->ar_ieee32, &sint64.ar_i64,
					     AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED,
					     ROUND_MODE (*resulttype));
			break;
		case AR_Float_IEEE_NR_64:
		case AR_Float_IEEE_ZE_64:
		case AR_Float_IEEE_UP_64:
		case AR_Float_IEEE_DN_64:
			status |= ar_iflt64 (&result->ar_ieee64, &sint64.ar_i64,
					     AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED,
					     ROUND_MODE (*resulttype));
			break;
		case AR_Float_IEEE_NR_128:
		case AR_Float_IEEE_ZE_128:
		case AR_Float_IEEE_UP_128:
		case AR_Float_IEEE_DN_128:
			status |= ar_iflt128 (&result->ar_ieee128, &sint64.ar_i64,
					     AR_SIGNEDNESS (*opndtype) == AR_UNSIGNED,
					     ROUND_MODE (*resulttype));
			break;
		default:
			return AR_STAT_INVALID_TYPE;
		}

	} else
		return AR_STAT_INVALID_TYPE;

	return status;
}


int
ar_convert_to_complex
		(ar_data *result, const AR_TYPE *resulttype,
   const ar_data *opnd,   const AR_TYPE *opndtype) {
 
	ar_data from, re, im, cre, cim;
	AR_TYPE reimtype, parttype, temptype;
	int status = AR_STAT_OK, restat, imstat;

	parttype = (AR_TYPE) (*resulttype ^ AR_FLOAT_COMPLEX);

	if (AR_CLASS (*opndtype) == AR_CLASS_FLOAT &&
	    AR_FLOAT_IS_COMPLEX (*opndtype) == AR_FLOAT_COMPLEX) {
		status |= ar_decompose_complex (&re, &im, &reimtype,
						opnd, opndtype);
		restat = ar_convert_to_float (&cre, &parttype, &re, &reimtype);
		imstat = ar_convert_to_float (&cim, &parttype, &im, &reimtype);
		status |= ar_compose_complex (result, &temptype,
					      &cre, &cim, &parttype);
		status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
		status |= restat & imstat & AR_STAT_ZERO;
		return status;
	}

	status |= ar_convert_to_float (&cre, &parttype, opnd, opndtype);

	switch (*resulttype) {
	case AR_Complex_Cray1_64:
	case AR_Complex_Cray1_64_F:
		result->ar_cplx_f64.real = cre.ar_f64;
		ZEROCRAY64 (result->ar_cplx_f64.imag);
		break;
	case AR_Complex_Cray1_128:
		result->ar_cplx_f128.real = cre.ar_f128;
		ZEROCRAY128 (result->ar_cplx_f128.imag);
		break;
	case AR_Complex_IEEE_NR_32:
	case AR_Complex_IEEE_ZE_32:
	case AR_Complex_IEEE_UP_32:
	case AR_Complex_IEEE_DN_32:
		IEEE32_TO_CPLX32_REAL(result->ar_cplx_ieee32, cre.ar_ieee32);
		result->ar_cplx_ieee32.isign = 0;
		result->ar_cplx_ieee32.iexpo = 0;
		result->ar_cplx_ieee32.icoeff0 = 0;
		result->ar_cplx_ieee32.icoeff1 = 0;
		break;
	case AR_Complex_IEEE_NR_64:
	case AR_Complex_IEEE_ZE_64:
	case AR_Complex_IEEE_UP_64:
	case AR_Complex_IEEE_DN_64:
		result->ar_cplx_ieee64.real = cre.ar_ieee64;
		ZEROIEEE64 (result->ar_cplx_ieee64.imag);
		break;
	case AR_Complex_IEEE_NR_128:
	case AR_Complex_IEEE_ZE_128:
	case AR_Complex_IEEE_UP_128:
	case AR_Complex_IEEE_DN_128:
		result->ar_cplx_ieee128.real = cre.ar_ieee128;
		ZEROIEEE128 (result->ar_cplx_ieee128.imag);
		break;
	default:
		return AR_STAT_INVALID_TYPE;
	}

	return status;
}


/* General dispatch routine for numeric conversions. */
int
AR_convert
		(AR_DATA *res, const AR_TYPE *resulttype,
   const AR_DATA *opd, const AR_TYPE *opndtype) {

	ar_data* result = (ar_data*)res;
	ar_data* opnd   = (ar_data*)opd;

	if (AR_CLASS (*resulttype) == AR_CLASS_INT)
		return ar_convert_to_integral (result, resulttype, opnd, opndtype);

	if (AR_CLASS (*resulttype) == AR_CLASS_POINTER)
		return ar_convert_to_pointer (result, resulttype, opnd, opndtype);

	if (AR_CLASS (*resulttype) == AR_CLASS_FLOAT)
		if (AR_FLOAT_IS_COMPLEX (*resulttype) == AR_FLOAT_COMPLEX)
			return ar_convert_to_complex (result, resulttype, opnd, opndtype);
		else
			return ar_convert_to_float (result, resulttype, opnd, opndtype);

	return AR_STAT_INVALID_TYPE;
}


/* Weird "round_int_div" operation */
int
AR_round_int_div
		(AR_DATA *res, const AR_TYPE *resulttype,
   const AR_DATA *opd, const AR_TYPE *opndtype) {

	ar_data* result = (ar_data*)res;
	ar_data* opnd   = (ar_data*)opd;

	if (*resulttype != *opndtype)
		return AR_STAT_INVALID_TYPE;

	if (*resulttype == AR_Float_Cray1_64 ||
	    *resulttype == AR_Float_Cray1_64_F)
		return ar_crnd64 (&result->ar_f64, &opnd->ar_f64);
	else if (*resulttype == AR_Float_Cray1_128)
		return ar_crnd128 (&result->ar_f128, &opnd->ar_f128);
	else
		return AR_STAT_INVALID_TYPE;
}


static char USMID [] = "\n%Z%%M%	%I%	%G% %U%\n";
static char rcsid [] = "$Id$";
