~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to mp/fplus.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
2
/*          Copyright (C) 1994 W. Schelter
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 
14
for more details.
 
15
 
 
16
You should have received a copy of the GNU library general public
 
17
license along with GCL; see the file COPYING.  If not, write to the
 
18
Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
*/
 
20
 
 
21
/* #include "include.h" */
 
22
#include "config.h"
 
23
/* #include "cmpinclude.h"   */
 
24
/* #include "genpari.h" */
 
25
#include "arith.h"
 
26
object make_integer();  
 
27
 
 
28
 
 
29
static unsigned plong small_pos_int[3]={0x1000003,0x01000003,0};
 
30
static unsigned plong small_neg_int[3]={0x1000003,0xff000003,0};
 
31
static unsigned plong s4_neg_int[4]={0x1000004,0xff000004,1,0};
 
32
 
 
33
object
 
34
fplus(a,b)
 
35
     int a,b;
 
36
{ int z ;
 
37
  int x;
 
38
  if (a >= 0)
 
39
   { if (b >= 0)
 
40
       { x = a + b;
 
41
         if (x == 0) return small_fixnum(0);
 
42
         small_pos_int[2]=x;
 
43
         return make_integer(small_pos_int);
 
44
       }
 
45
     else
 
46
       { /* b neg */
 
47
         x = a + b;
 
48
         return make_fixnum(x);
 
49
       }}
 
50
  else
 
51
    { /* a neg */
 
52
      if (b >= 0)
 
53
        { x = a + b;
 
54
          return make_fixnum(x);}
 
55
      else
 
56
        { /* both neg */
 
57
            { unsigned plong Xtx,Xty,overflow,Xtres;
 
58
              Xtres = addll(-a,-b);
 
59
              if (overflow)
 
60
                { 
 
61
                  s4_neg_int[3]=Xtres;
 
62
                  return make_integer(s4_neg_int);}
 
63
              else
 
64
                { small_neg_int[2]=Xtres;
 
65
                  return make_integer(small_neg_int);}
 
66
            }}}
 
67
}
 
68
 
 
69
 
 
70
object
 
71
fminus(a,b)
 
72
     int a,b;
 
73
{ int z ;
 
74
  int x;
 
75
  if (a >= 0)
 
76
   { if (b >= 0)
 
77
       { x = a - b;
 
78
         return make_fixnum(x);
 
79
       }
 
80
     else
 
81
       { /* b neg */
 
82
         x = a - b;
 
83
         if (x==0) return small_fixnum(0);
 
84
         small_pos_int[2]=x;
 
85
         return make_integer(small_pos_int);
 
86
       }}
 
87
  else
 
88
    { /* a neg */
 
89
      if (b <= 0)
 
90
        { x = a - b;
 
91
          return make_fixnum(x);}
 
92
      else
 
93
        {  /* b positive */
 
94
            { unsigned plong Xtx,Xty,overflow,Xtres;
 
95
              unsigned plong t[4];
 
96
              Xtres = addll(-a,b);
 
97
              if (overflow)
 
98
                { s4_neg_int[3]=Xtres;
 
99
                  return make_integer(s4_neg_int);}
 
100
              else
 
101
                { small_neg_int[2]=Xtres;
 
102
                  return make_integer(small_neg_int);}
 
103
            }}}
 
104
}