diff options
author | LaMont Jones <lamont@debian.org> | 2003-05-07 08:36:40 -0600 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | e21d47d7813159bb71e0671df9b52ec0470c358d (patch) | |
tree | 3c7770ea846123c291f599044e9f234ac17616bb /unif.c | |
parent | 8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff) | |
parent | deda2c0fd8689349fea2a900199a76ff7ecb319e (diff) | |
download | scm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip |
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low
* Fix hppa compile. Closes: #144062
scm (5d6-3.1) unstable; urgency=low
* NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171
scm (5d6-3) unstable; urgency=low
* Add build depend on xlibs-dev (Closes: #148020)
scm (5d6-2) unstable; urgency=low
* Remove libregexx-dev from build-depends.
* Change build to use ./scmlit rather than scmlit (should fix some build
problems) (looks like alpha is mostly building)
* New release (Closes: #140175)
* Built with turtlegraphics last time (Closes: #58515)
scm (5d6-1) unstable; urgency=low
* New upstream.
* Add xlib and turtlegr to requested list of features. (closes
some bug)
* Make clean actually clean most everything up.
* Remove hacks renaming build to something else and just set build as a
.PHONY target in debian/rules.
* Add the turtlegr code.
scm (5d5-1) unstable; urgency=low
* New upstream
* Has fixes for 64 bit archs. May fix alpha compile problem. Does fix
(Closes: #140175)
* Take out -O2 arg.
scm (5d4-3) unstable; urgency=low
* Don't link with regexx, but just use libc6's regular expression
functions.
* Define (terms) to output /usr/share/common-licenses/GPL (Closes:
#119321)
scm (5d4-2) unstable; urgency=low
* Add texinfo to build depends (Closes: #107011)
scm (5d4-1) unstable; urgency=low
* New upstream release.
* Move install-info --remove to prerm.
scm (5d3-5) unstable; urgency=low
* Move scm info files to section "The Algorithmic Language Scheme" to
match up with guile.
scm (5d3-4) unstable; urgency=low
* Fix build depends (Closes: #76691)
scm (5d3-3) unstable; urgency=low
* Fix path in scm dhelp file.
scm (5d3-2) unstable; urgency=low
* Actually put the header files in the package. Oops.
scm (5d3-1) unstable; urgency=low
* New upstream. (Closes: #74761)
* Make (terms) use new license location.
* Make use libregexx rather than librx.
* Fix build depends for above.
* Using new regex lib seems to fix crash (Closes: #66787)
* Consider adding scm-dev package with headers, but instead just add the
headers to the scm package. (Closes: #70787)
* Add doc-base support.
Diffstat (limited to 'unif.c')
-rw-r--r-- | unif.c | 115 |
1 files changed, 41 insertions, 74 deletions
@@ -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<LENGTH_MAX ? k : LENGTH_MAX), type), + MAKE_LENGTH((k < LENGTH_MAX ? k : LENGTH_MAX), type), s_vector); if (tc7_string==type) CHARS(v)[k] = 0; ALLOW_INTS; return v; } -static char s_uve_len[] = "uniform-vector-length"; -SCM uve_len(v) - SCM v; -{ - ASRTGO(NIMP(v), badarg1); - switch TYP7(v) { - default: badarg1: wta(v, (char *)ARG1, s_uve_len); - case tc7_vector: - case tcs_uves: - return MAKINUM(LENGTH(v)); - } -} - SCM arrayp(v, prot) SCM v, prot; { int enclosed = 0; long typ; if IMP(v) return BOOL_F; - typ = TYP7(v); loop: + typ = TYP7(v); switch (typ) { case tc7_smob: if (!ARRAYP(v)) return BOOL_F; if (UNBNDP(prot)) return BOOL_T; @@ -866,7 +840,7 @@ SCM aref(v, args) int k = ARRAY_NDIM(v); SCM res = make_ra(k); if (!ARRAYP(v)) { - ASRTGO(NULLP(args),badarg); + ASRTGO(NULLP(args), badarg); return v; } ARRAY_V(res) = ARRAY_V(v); @@ -1125,7 +1099,7 @@ SCM uve_read(v, port) long sz, len, ans; long start=0; if UNBNDP(port) port = cur_inp; - else ASSERT(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); + ASSERT(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); loop: @@ -1190,7 +1164,7 @@ SCM uve_write(v, port) long sz, len, ans; long start=0; if UNBNDP(port) port = cur_outp; - else ASSERT(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); + ASSERT(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); loop: @@ -1233,7 +1207,7 @@ SCM uve_write(v, port) break; # endif } - SYSCALL(ans = fwrite(CHARS(v)+start*sz, (sizet)sz, (sizet)len, STREAM(port));); + ans = lfwrite(CHARS(v)+start*sz, (sizet)sz, (sizet)len, port); if (TYP7(v)==tc7_bvect) ans *= LONG_BIT; return MAKINUM(ans); } @@ -1299,7 +1273,7 @@ SCM lcount(item, seq) } } static char s_uve_pos[] = "bit-position"; -SCM position(item, v, k) +SCM bit_position(item, v, k) SCM item, v, k; { long i, len, lenw, xbits, pos = INUM(k), offset = 0; @@ -1669,10 +1643,9 @@ SCM list2ura(ndim, prot, lst) SCM shp=EOL; SCM row=lst; SCM ra; - sizet k; long n; + sizet k = INUM(ndim); ASSERT(INUMP(ndim), ndim, ARG1, s_list2ura); - k = INUM(ndim); for (; k--; NIMP(row) && (row = CAR(row))) { n = ilength(row); ASSERT(n>=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<<INUM(ibit)))) : scm_logand(oval, MAKINUM(~(1<<INUM(ibit)))); -#ifndef RECKLESS +# ifndef RECKLESS else wta(obj, (char *)ARG2, s_logaset); -#endif +# endif } return aset(ra, obj, inds); } static iproc subr3s[] = { - {"uniform-vector-set1!", aset}, - {s_uve_pos, position}, + {s_uve_pos, bit_position}, {s_bit_set, bit_set}, {s_bit_count, bit_count}, {s_list2ura, list2ura}, {0, 0}}; static iproc subr2s[] = { - {"uniform-vector-ref", aref}, {s_resizuve, resizuve}, {s_count, lcount}, {s_uve_fill, uve_fill}, @@ -2033,7 +2004,6 @@ static iproc subr1s[] = { {"array-rank", array_rank}, {s_array_dims, array_dims}, {s_array2list, array2list}, - {s_uve_len, uve_len}, {s_bit_inv, bit_inv}, {s_strdown, strdown}, {s_strcap, strcap}, @@ -2059,8 +2029,6 @@ static iproc lsubr2s[] = { static iproc subr2os[] = { {"array?", arrayp}, {s_array_contents, array_contents}, - {s_uve_rd, uve_read}, - {s_uve_wr, uve_write}, {0, 0}}; static SCM markra(ptr) @@ -2071,7 +2039,8 @@ static SCM markra(ptr) static sizet freera(ptr) CELLPTR ptr; { - must_free(CHARS(ptr), sizeof(array) + ARRAY_NDIM(ptr)*sizeof(array_dim)); + must_free(CHARS((SCM)ptr), + sizeof(array) + ARRAY_NDIM((SCM)ptr)*sizeof(array_dim)); return 0; } static smobfuns rasmob = {markra, freera, raprin1, 0}; @@ -2087,9 +2056,7 @@ void init_unif() init_iprocs(lsubr2s, tc7_lsubr_2); init_iprocs(subr2os, tc7_subr_2o); tc16_array = newsmob(&rasmob); - i_short = CAR(sysintern("exact-short", UNDEFINED)); add_feature(s_array); - add_feature("string-case"); } #else /* ARRAYS */ |