From deda2c0fd8689349fea2a900199a76ff7ecb319e Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:26 -0800 Subject: Import Upstream version 5d6 --- unif.c | 115 +++++++++++++++++++++++------------------------------------------ 1 file changed, 41 insertions(+), 74 deletions(-) (limited to 'unif.c') diff --git a/unif.c b/unif.c index 88250c2..ae5c1b7 100644 --- a/unif.c +++ b/unif.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2002 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -15,26 +15,26 @@ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. * * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * for additional uses of the text contained in its release of SCM. * - * The exception is that, if you link the GUILE library with other files + * The exception is that, if you link the SCM library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * linking the SCM library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy + * Free Software Foundation under the name SCM. If you copy * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does + * SCM, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * - * If you write modifications of your own for GUILE, it is your choice + * If you write modifications of your own for SCM, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ @@ -61,7 +61,6 @@ complex double cvect #endif long tc16_array = 0; -static SCM i_short; char s_resizuve[] = "vector-set-length!"; SCM resizuve(vect, len) @@ -112,7 +111,7 @@ SCM resizuve(vect, len) siz = l * sz; if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve); DEFER_INTS; - must_realloc_cell(vect, (long)ol*sz, (long)siz, s_resizuve); + must_realloc_cell(vect, ol*sz, (long)siz, s_resizuve); if VECTORP(vect) while(l > ol) VELTS(vect)[--l] = UNSPECIFIED; @@ -149,34 +148,22 @@ long scm_prot2type(prot) { if (BOOL_T==prot) return tc7_bvect; if ICHRP(prot) return tc7_string; - if INUMP(prot) - return INUM(prot)>0 ? tc7_uvect : tc7_ivect; - if (i_short==prot) return tc7_svect; + if (MAKINUM(32L)==prot) return tc7_uvect; + if (MAKINUM(-32L)==prot) return tc7_ivect; + if (MAKINUM(-16L)==prot) return tc7_svect; + if INUMP(prot) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; if IMP(prot) return tc7_vector; # ifdef FLOATS if INEXP(prot) { double x; - float fx; if CPLXP(prot) return tc7_cvect; x = REALPART(prot); - fx = x; - return (x == fx) ? tc7_fvect : tc7_dvect; - } -# endif -# ifdef BIGDIG - if (TYP16(prot)==tc16_bigpos) { - if (DIGSPERLONG < NUMDIGS(prot)) return tc7_vector; - return tc7_uvect; - } - if (TYP16(prot)==tc16_bigneg) { - long res = 0; - sizet l = NUMDIGS(prot); - if (DIGSPERLONG < l) return tc7_vector; - for(;l--;) res = BIGUP(res) + BDIGITS(prot)[l]; - if (0>=res) return tc7_vector; - return tc7_ivect; + if (32.0==x) return tc7_fvect; + if (64.0==x) return tc7_dvect; + return tc7_dvect; } # endif + return tc7_vector; } SCM make_uve(k, prot) @@ -216,34 +203,21 @@ SCM make_uve(k, prot) } DEFER_INTS; v = must_malloc_cell((i ? i : 1L), - MAKE_LENGTH((k=0, lst, ARG2, s_list2ura); @@ -1879,18 +1852,18 @@ int raprin1(exp, port, writing) case tc7_string: lputs("A\\", port); break; case tc7_uvect: - lputs("Au", port); break; + lputs("Au32", port); break; case tc7_ivect: - lputs("Ae", port); break; + lputs("As32", port); break; case tc7_svect: - lputs("Aes", port); break; + lputs("As16", port); break; # ifdef FLOATS case tc7_fvect: - lputs("Aif", port); break; + lputs("Ar32", port); break; case tc7_dvect: - lputs("Ai", port); break; + lputs("Ar64", port); break; case tc7_cvect: - lputs("Aic", port); break; + lputs("Ac64", port); break; # endif /*FLOATS*/ } if ((v != exp) && 0==ARRAY_NDIM(exp)) { @@ -1921,13 +1894,13 @@ SCM array_prot(ra) case tc7_vector: return EOL; case tc7_bvect: return BOOL_T; case tc7_string: return MAKICHR('a'); - case tc7_svect: return i_short; - case tc7_uvect: return MAKINUM(1L); - case tc7_ivect: return MAKINUM(-1L); + case tc7_uvect: return MAKINUM(32L); + case tc7_ivect: return MAKINUM(-32L); + case tc7_svect: return MAKINUM(-16L); # ifdef FLOATS - case tc7_fvect: return makflo(1.0); - case tc7_dvect: return makdbl(1.0/3.0, 0.0); - case tc7_cvect: return makdbl(0.0, 1.0); + case tc7_fvect: return makflo(32.0); + case tc7_dvect: return makdbl(64.0, 0.0); + case tc7_cvect: return makdbl(0.0, 64.0); # endif } } @@ -2007,23 +1980,21 @@ SCM scm_logaset(ra, obj, args) else if (BOOL_F==obj) obj = INUMP(oval) ? MAKINUM(INUM(oval) & (~(1<