Mercurial > hg > xemacs-beta
view lib-src/mmencode.c @ 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 | 49316578f12d |
children |
line wrap: on
line source
/* Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore) Permission to use, copy, modify, and distribute this material for any purpose and without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies, and that the name of Bellcore not be used in advertising or publicity pertaining to this material without the specific, prior written permission of an authorized representative of Bellcore. BELLCORE MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. */ #ifdef HAVE_CONFIG_H # include <config.h> #endif #define NEWLINE_CHAR '\n' #include <stdlib.h> #include <stdio.h> #include <ctype.h> #include <string.h> #include <errno.h> static void output64chunk(int c1, int c2, int c3, int pads, FILE *outfile); static signed char basis_64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; static signed char index_64[128] = { -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,62, -1,-1,-1,63, 52,53,54,55, 56,57,58,59, 60,61,-1,-1, -1,-1,-1,-1, -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, 15,16,17,18, 19,20,21,22, 23,24,25,-1, -1,-1,-1,-1, -1,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, 41,42,43,44, 45,46,47,48, 49,50,51,-1, -1,-1,-1,-1 }; #define char64(c) (((c) < 0 || (c) > 127) ? -1 : index_64[(c)]) /* char64(c) char c; { char *s = (char *) strchr(basis_64, c); if (s) return(s-basis_64); return(-1); } */ /* the following gets a character, but fakes it properly into two chars if there's a newline character */ static int InNewline=0; static int nextcharin (FILE *infile, int PortableNewlines) { int c; #ifndef NEWLINE_CHAR return(getc(infile)); #else if (!PortableNewlines) return(getc(infile)); if (InNewline) { InNewline = 0; return(10); /* LF */ } c = getc(infile); if (c == NEWLINE_CHAR) { InNewline = 1; return(13); /* CR */ } return(c); #endif } static void to64(FILE *infile, FILE *outfile, int PortableNewlines) { int c1, c2, c3, ct=0; InNewline = 0; /* always reset it */ while ((c1 = nextcharin(infile, PortableNewlines)) != EOF) { c2 = nextcharin(infile, PortableNewlines); if (c2 == EOF) { output64chunk(c1, 0, 0, 2, outfile); } else { c3 = nextcharin(infile, PortableNewlines); if (c3 == EOF) { output64chunk(c1, c2, 0, 1, outfile); } else { output64chunk(c1, c2, c3, 0, outfile); } } ct += 4; if (ct > 71) { putc('\n', outfile); ct = 0; } } if (ct) putc('\n', outfile); fflush(outfile); } static void output64chunk(int c1, int c2, int c3, int pads, FILE *outfile) { putc(basis_64[c1>>2], outfile); putc(basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)], outfile); if (pads == 2) { putc('=', outfile); putc('=', outfile); } else if (pads) { putc(basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)], outfile); putc('=', outfile); } else { putc(basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)], outfile); putc(basis_64[c3 & 0x3F], outfile); } } static int PendingBoundary(char *s, char **Boundaries, int *BoundaryCt) { int i, len; if (s[0] != '-' || s[1] != '-') return(0); for (i=0; i < *BoundaryCt; ++i) { len = strlen(Boundaries[i]); if (!strncmp(s, Boundaries[i], len)) { if (s[len] == '-' && s[len+1] == '-') *BoundaryCt = i; return(1); } } return(0); } /* If we're in portable newline mode, we have to convert CRLF to the local newline convention on output */ static int CRpending = 0; #ifdef NEWLINE_CHAR static void almostputc(int c, FILE *outfile, int PortableNewlines) { if (CRpending) { if (c == 10) { putc(NEWLINE_CHAR, outfile); CRpending = 0; } else { putc(13, outfile); if (c != 13) { putc(c, outfile); CRpending = 0; } } } else { if (PortableNewlines && c == 13) { CRpending = 1; } else { putc(c, outfile); } } } #else static void almostputc(int c, FILE *outfile, int PortableNewlines) { putc(c, outfile); } #endif static void from64(FILE *infile, FILE *outfile, char **boundaries, int *boundaryct, int PortableNewlines) { int c1, c2, c3, c4; int newline = 1, DataDone = 0; /* always reinitialize */ CRpending = 0; while ((c1 = getc(infile)) != EOF) { if (isspace(c1)) { if (c1 == '\n') { newline = 1; } else { newline = 0; } continue; } if (newline && boundaries && c1 == '-') { char Buf[200]; /* a dash is NOT base 64, so all bets are off if NOT a boundary */ ungetc(c1, infile); fgets(Buf, sizeof(Buf), infile); if (boundaries && (Buf[0] == '-') && (Buf[1] == '-') && PendingBoundary(Buf, boundaries, boundaryct)) { return; } fprintf(stderr, "Ignoring unrecognized boundary line: %s\n", Buf); continue; } if (DataDone) continue; newline = 0; do { c2 = getc(infile); } while (c2 != EOF && isspace(c2)); do { c3 = getc(infile); } while (c3 != EOF && isspace(c3)); do { c4 = getc(infile); } while (c4 != EOF && isspace(c4)); if (c2 == EOF || c3 == EOF || c4 == EOF) { fprintf(stderr, "Warning: base64 decoder saw premature EOF!\n"); return; } if (c1 == '=' || c2 == '=') { DataDone=1; continue; } c1 = char64(c1); c2 = char64(c2); almostputc(((c1<<2) | ((c2&0x30)>>4)), outfile, PortableNewlines); if (c3 == '=') { DataDone = 1; } else { c3 = char64(c3); almostputc((((c2&0XF) << 4) | ((c3&0x3C) >> 2)), outfile, PortableNewlines); if (c4 == '=') { DataDone = 1; } else { c4 = char64(c4); almostputc((((c3&0x03) <<6) | c4), outfile, PortableNewlines); } } } if (CRpending) putc(13, outfile); /* Don't drop a lone trailing char 13 */ } static signed char basis_hex[] = "0123456789ABCDEF"; static signed char index_hex[128] = { -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1, -1,-1,-1,-1, -1,10,11,12, 13,14,15,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,10,11,12, 13,14,15,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1 }; /* The following version generated complaints on Solaris. */ /* #define hexchar(c) (((c) < 0 || (c) > 127) ? -1 : index_hex[(c)]) */ /* Since we're no longer ever calling it with anything signed, this should work: */ #define hexchar(c) (((c) > 127) ? -1 : index_hex[(c)]) /* hexchar(c) char c; { char *s; if (islower(c)) c = toupper(c); s = (char *) strchr(basis_hex, c); if (s) return(s-basis_hex); return(-1); } */ static void toqp(FILE *infile, FILE *outfile) { int c, ct=0, prevc=255; while ((c = getc(infile)) != EOF) { if ((c < 32 && (c != '\n' && c != '\t')) || (c == '=') || (c >= 127) /* Following line is to avoid single periods alone on lines, which messes up some dumb smtp implementations, sigh... */ || (ct == 0 && c == '.')) { putc('=', outfile); putc(basis_hex[c>>4], outfile); putc(basis_hex[c&0xF], outfile); ct += 3; prevc = 'A'; /* close enough */ } else if (c == '\n') { if (prevc == ' ' || prevc == '\t') { putc('=', outfile); /* soft & hard lines */ putc(c, outfile); } putc(c, outfile); ct = 0; prevc = c; } else { if (c == 'F' && prevc == '\n') { /* HORRIBLE but clever hack suggested by MTR for sendmail-avoidance */ c = getc(infile); if (c == 'r') { c = getc(infile); if (c == 'o') { c = getc(infile); if (c == 'm') { c = getc(infile); if (c == ' ') { /* This is the case we are looking for */ fputs("=46rom", outfile); ct += 6; } else { fputs("From", outfile); ct += 4; } } else { fputs("Fro", outfile); ct += 3; } } else { fputs("Fr", outfile); ct += 2; } } else { putc('F', outfile); ++ct; } ungetc(c, infile); prevc = 'x'; /* close enough -- printable */ } else { /* END horrible hack */ putc(c, outfile); ++ct; prevc = c; } } if (ct > 72) { putc('=', outfile); putc('\n', outfile); ct = 0; prevc = '\n'; } } if (ct) { putc('=', outfile); putc('\n', outfile); } } static void fromqp(FILE *infile, FILE *outfile, char **boundaries, int *boundaryct) { int c1, c2; int sawnewline = 1, neednewline = 0; /* The neednewline hack is necessary because the newline leading into a multipart boundary is part of the boundary, not the data */ while ((c1 = getc(infile)) != EOF) { if (sawnewline && boundaries && (c1 == '-')) { char Buf[200]; unsigned char *s; ungetc(c1, infile); fgets(Buf, sizeof(Buf), infile); if (boundaries && (Buf[0] == '-') && (Buf[1] == '-') && PendingBoundary(Buf, boundaries, boundaryct)) { return; } /* Not a boundary, now we must treat THIS line as q-p, sigh */ if (neednewline) { putc('\n', outfile); neednewline = 0; } for (s=(unsigned char *) Buf; *s; ++s) { if (*s == '=') { if (!*++s) break; if (*s == '\n') { /* ignore it */ sawnewline = 1; } else { c1 = hexchar(*s); if (!*++s) break; c2 = hexchar(*s); putc(c1<<4 | c2, outfile); } } else { #ifdef WIN32_NATIVE if (*s == '\n') putc('\r', outfile); /* insert CR for binary-mode write */ #endif putc(*s, outfile); } } } else { if (neednewline) { putc('\n', outfile); neednewline = 0; } if (c1 == '=') { sawnewline = 0; c1 = getc(infile); if (c1 == '\n') { /* ignore it */ sawnewline = 1; } else { c2 = getc(infile); c1 = hexchar(c1); c2 = hexchar(c2); putc(c1<<4 | c2, outfile); if (c2 == '\n') sawnewline = 1; } } else { if (c1 == '\n') { sawnewline = 1; neednewline = 1; } else { sawnewline = 0; putc(c1, outfile); } } } } if (neednewline) { putc('\n', outfile); neednewline = 0; } } /* Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore) Permission to use, copy, modify, and distribute this material for any purpose and without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies, and that the name of Bellcore not be used in advertising or publicity pertaining to this material without the specific, prior written permission of an authorized representative of Bellcore. BELLCORE MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. */ #ifdef WIN32_NATIVE #include <io.h> #include <fcntl.h> #endif #define BASE64 1 #define QP 2 /* quoted-printable */ int main(int argc, char *argv[]) { int encode = 1, which = BASE64, i, portablenewlines = 0; FILE *fp = stdin; FILE *fpo = stdout; for (i=1; i<argc; ++i) { if (argv[i][0] == '-') { switch (argv[i][1]) { case 'o': if (++i >= argc) { fprintf(stderr, "mimencode: -o requires a file name.\n"); exit(-1); } fpo = fopen(argv[i], "w"); if (!fpo) { perror(argv[i]); exit(-1); } break; case 'u': encode = 0; break; case 'q': which = QP; break; case 'p': portablenewlines = 1; break; case 'b': which = BASE64; break; default: fprintf(stderr, "Usage: mmencode [-u] [-q] [-b] [-p] [-o outputfile] [file name]\n"); exit(-1); } } else { #ifdef WIN32_NATIVE if (encode) fp = fopen(argv[i], "rb"); else { fp = fopen(argv[i], "rt"); setmode(fileno(fpo), O_BINARY); } /* else */ #else fp = fopen(argv[i], "r"); #endif /* WIN32_NATIVE */ if (!fp) { perror(argv[i]); exit(-1); } } } #ifdef WIN32_NATIVE if (fp == stdin) setmode(fileno(fp), O_BINARY); #endif /* WIN32_NATIVE */ if (which == BASE64) { if (encode) { to64(fp, fpo, portablenewlines); } else { from64(fp,fpo, (char **) NULL, (int *) 0, portablenewlines); } } else { if (encode) toqp(fp, fpo); else fromqp(fp, fpo, NULL, 0); } return(0); }