Mercurial > hg > xemacs-beta
view netinstall/fromcwd.cc @ 4678:b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
lisp/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (ceiling*, floor*, round*, truncate*):
Implement these in terms of the C functions; mark them as
obsolete.
(mod*, rem*): Use #'nth-value with the C functions, not #'nth with
the CL emulation functions.
man/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* lispref/numbers.texi (Bigfloat Basics):
Correct this documentation (ignoring for the moment that it breaks
off in mid-sentence).
tests/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test the new Common Lisp-compatible rounding functions available in
C.
(generate-rounding-output): Provide a function useful for
generating the data for the rounding functions tests.
src/ChangeLog addition:
2009-08-11 Aidan Kehoe <kehoea@parhasard.net>
* floatfns.c (ROUNDING_CONVERT, CONVERT_WITH_NUMBER_TYPES)
(CONVERT_WITHOUT_NUMBER_TYPES, MAYBE_TWO_ARGS_BIGNUM)
(MAYBE_ONE_ARG_BIGNUM, MAYBE_TWO_ARGS_RATIO)
(MAYBE_ONE_ARG_RATIO, MAYBE_TWO_ARGS_BIGFLOAT)
(MAYBE_ONE_ARG_BIGFLOAT, MAYBE_EFF, MAYBE_CHAR_OR_MARKER):
New macros, used in the implementation of the rounding functions.
(ceiling_two_fixnum, ceiling_two_bignum, ceiling_two_ratio)
(ceiling_two_bigfloat, ceiling_one_ratio, ceiling_one_bigfloat)
(ceiling_two_float, ceiling_one_float, ceiling_one_mundane_arg)
(floor_two_fixnum, floor_two_bignum, floor_two_ratio)
(floor_two_bigfloat, floor_one_ratio, floor_one_bigfloat)
(floor_two_float, floor_one_mundane_arg, round_two_fixnum)
(round_two_bignum_1, round_two_bignum, round_two_ratio)
(round_one_bigfloat_1, round_two_bigfloat, round_one_ratio)
(round_one_bigfloat, round_two_float, round_one_float)
(round_one_mundane_arg, truncate_two_fixnum)
(truncate_two_bignum, truncate_two_ratio, truncate_two_bigfloat)
(truncate_one_ratio, truncate_one_bigfloat, truncate_two_float)
(truncate_one_float, truncate_one_mundane_arg):
New functions, used in the implementation of the rounding
functions.
(Fceiling, Ffloor, Fround, Ftruncate, Ffceiling, Fffloor)
(Ffround, Fftruncate):
Revise to fully support Common Lisp conventions. This means:
-- All functions have optional DIVISOR arguments
-- All functions return multiple values; see #'values
-- All functions do their arithmetic with the correct number types
according to the contamination rules.
-- #'round and #'fround always round towards the even number
in ambiguous cases.
* doprnt.c (emacs_doprnt_1):
* number.c (internal_coerce_number):
Call Ftruncate with two arguments, not one.
* floatfns.c (Ffloat):
Correct this, if NUMBER is a bignum.
* lisp.h:
Declare Ftruncate as taking two arguments.
* number.c:
Provide scratch_ratio2, init it appropriately.
* number.h:
Make scratch_ratio2 available.
* number.h (BIGFLOAT_ARITH_RETURN):
* number.h (BIGFLOAT_ARITH_RETURN1):
Correct these functions.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 11 Aug 2009 17:59:23 +0100 |
parents | 3078fd1074e8 |
children |
line wrap: on
line source
/* * Copyright (c) 2000, Red Hat, 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 * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * A copy of the GNU General Public License can be found at * http://www.gnu.org/ * * Written by DJ Delorie <dj@cygnus.com> * */ /* The purpose of this file is to handle the case where we're installing from files that already exist in the current directory. If a setup.ini file is present, we set the mirror site to "." and pretend we're installing from the `internet' ;-) else we have to find all the .tar.gz files, deduce their versions, and try to compare versions in the case where the current directory contains multiple versions of any given package. We do *not* try to compare versions with already installed packages; we always choose a package in the current directory over one that's already installed (otherwise, why would you have asked to install it?). Note that we search recursively. */ #include "win32.h" #include <stdio.h> #include <stdlib.h> #include <io.h> #include <ctype.h> #ifndef WIN32_NATIVE #include <unistd.h> #endif #include "ini.h" #include "resource.h" #include "concat.h" #include "state.h" #include "dialog.h" #include "msg.h" #include "find.h" #include "version.h" #include "port.h" static int is_test_version (char *v) { int i; for (i=0; v[i] && isdigit (v[i]); i++) ; return (i >= 6) ? 1 : 0; } char * canonicalize_version (char *v) { static char nv[3][100]; static int idx = 0; char *np, *dp; int i; idx = (idx+1) % 3; np = nv[idx]; while (*v) { if (isdigit (*v)) { for (dp=v; *dp && isdigit (*dp); dp++) ; for (i=dp-v; i<12; i++) *np++ = '0'; while (v < dp) *np++ = *v++; } else *np++ = *v++; } *np++ = 0; return nv[idx]; } static void found_file (char *path, unsigned int fsize) { char base[_MAX_PATH], *ver; int l = strlen (path); if (strcmp (path + l - 7, ".tar.gz") != 0) return; if (strstr (path, "-src.")) return; if (strstr (path, "-patch.")) return; char *sl = strrchr (path, '/'); if (sl) sl ++; else sl = path; strcpy (base, sl); base[strlen (base) - 7] = 0; /* remove .tar.gz */ for (ver=base; *ver; ver++) if ((*ver == '-' || *ver == '_') && isdigit (ver[1])) { *ver++ = 0; break; } Package *p = 0; int i; for (i=0; i<npackages; i++) if (strcmp (package[i].name, base) == 0) { p = package + i; break; } if (p == 0) p = new_package (strdup (base)); int trust = is_test_version (ver) ? TRUST_TEST : TRUST_CURR; if (!*ver) trust = TRUST_PREV; /* See if this version is older than what we have */ if (p->info[trust].version) { char *ov = canonicalize_version (p->info[trust].version); char *nv = canonicalize_version (ver); if (strcmp (ov, nv) > 0) return; } l = strlen (base); if (l >= 5 && strcmp (base + l - 5, "win32") == 0) p->type = TY_NATIVE; if (l >= 8 && strcmp (base + l - 8, "cygwin32") == 0) p->type = TY_CYGWIN; p->info[trust].version = strdup (ver); p->info[trust].install = strdup (path); p->info[trust].install_size = fsize; } void do_fromcwd (HINSTANCE h) { if (_access ("./setup.ini", 0) == 0) { mirror_site = "."; next_dialog = IDD_S_LOAD_INI; return; } next_dialog = IDD_CHOOSE; find (".", found_file); // Now see about source tarballs int i, t; Package *p; char srcpath[_MAX_PATH]; for (i=0; i<npackages; i++) { p = package+i; for (t=TRUST_PREV; t<=TRUST_TEST; t++) if (p->info[t].install) { strcpy (srcpath, p->info[t].install); strcpy (srcpath + strlen (srcpath) - 7, "-src.tar.gz"); msg ("looking for %s", srcpath); WIN32_FIND_DATA wfd; HANDLE h = FindFirstFile (srcpath, &wfd); if (h != INVALID_HANDLE_VALUE) { msg("-- got it"); FindClose (h); p->info[t].source = strdup (srcpath); p->info[t].source_size = wfd.nFileSizeLow; } } } return; }