~ubuntu-branches/ubuntu/trusty/gimp/trusty

« back to all changes in this revision

Viewing changes to plug-ins/script-fu/tinyscheme/scheme.c

  • Committer: Bazaar Package Importer
  • Author(s): Pedro Fragoso
  • Date: 2007-12-18 10:44:11 UTC
  • mfrom: (1.1.10 upstream)
  • Revision ID: james.westby@ubuntu.com-20071218104411-p2c1aor6tfqcwkyw
Tags: 2.4.3-1ubuntu1
* Merge from Debian unstable. (LP: #177821)
* Ubuntu remaining changes:
  - 02_help-message.patch, 03_gimp.desktop.in.in.patch: Distro changes.
  - Weave i18n magic in the rules file.
  - Remove the doc directory symlink in the preinst, and replace it with a
    directory.
  - Added NEWS, README and README.Debian to gimp.docs.
  - Modify Maintainer value to match Debian-Maintainer-Field Spec

Show diffs side-by-side

added added

removed removed

Lines of Context:
188
188
static double round_per_R5RS(double x);
189
189
#endif
190
190
static int is_zero_double(double x);
 
191
static INLINE int num_is_integer(pointer p) {
 
192
  return ((p)->_object._number.is_fixnum);
 
193
}
191
194
 
192
195
static num num_zero;
193
196
static num num_one;
207
210
INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a);
208
211
INTERFACE INLINE int is_number(pointer p)    { return (type(p)==T_NUMBER); }
209
212
INTERFACE INLINE int is_integer(pointer p) {
210
 
  return ((p)->_object._number.is_fixnum);
 
213
  return is_number(p) && ((p)->_object._number.is_fixnum);
211
214
}
 
215
 
212
216
INTERFACE INLINE int is_real(pointer p) {
213
 
  return (!(p)->_object._number.is_fixnum);
 
217
  return is_number(p) && (!(p)->_object._number.is_fixnum);
214
218
}
215
219
 
216
220
INTERFACE INLINE int is_character(pointer p) { return (type(p)==T_CHARACTER); }
217
221
INTERFACE INLINE int string_length(pointer p) { return strlength(p); }
218
222
INTERFACE INLINE char *string_value(pointer p) { return strvalue(p); }
219
223
INLINE num nvalue(pointer p)       { return ((p)->_object._number); }
220
 
INTERFACE long ivalue(pointer p)      { return (is_integer(p)?(p)->_object._number.value.ivalue:(long)(p)->_object._number.value.rvalue); }
221
 
INTERFACE double rvalue(pointer p)    { return (!is_integer(p)?(p)->_object._number.value.rvalue:(double)(p)->_object._number.value.ivalue); }
 
224
INTERFACE long ivalue(pointer p)      { return (num_is_integer(p)?(p)->_object._number.value.ivalue:(long)(p)->_object._number.value.rvalue); }
 
225
INTERFACE double rvalue(pointer p)    { return (!num_is_integer(p)?(p)->_object._number.value.rvalue:(double)(p)->_object._number.value.ivalue); }
222
226
#define ivalue_unchecked(p)       ((p)->_object._number.value.ivalue)
223
227
#define rvalue_unchecked(p)       ((p)->_object._number.value.rvalue)
224
 
#define set_integer(p)   (p)->_object._number.is_fixnum=1;
225
 
#define set_real(p)      (p)->_object._number.is_fixnum=0;
 
228
#define set_num_integer(p)   (p)->_object._number.is_fixnum=1;
 
229
#define set_num_real(p)      (p)->_object._number.is_fixnum=0;
226
230
INTERFACE  gunichar charvalue(pointer p)  { return (gunichar)ivalue_unchecked(p); }
227
231
 
228
232
INTERFACE INLINE int is_port(pointer p)     { return (type(p)==T_PORT); }
719
723
static pointer get_consecutive_cells(scheme *sc, int n) {
720
724
  pointer x;
721
725
 
722
 
  if(sc->no_memory) {
723
 
    return sc->sink;
724
 
  }
 
726
  if(sc->no_memory) { return sc->sink; }
725
727
 
726
728
  /* Are there any cells available? */
727
729
  x=find_consecutive_cells(sc,n);
728
 
  if (x == sc->NIL) {
729
 
    /* If not, try gc'ing some */
730
 
    gc(sc, sc->NIL, sc->NIL);
731
 
    x=find_consecutive_cells(sc,n);
732
 
    if (x == sc->NIL) {
733
 
      /* If there still aren't, try getting more heap */
734
 
      if (!alloc_cellseg(sc,1)) {
735
 
        sc->no_memory=1;
736
 
        return sc->sink;
737
 
      }
738
 
    }
739
 
    x=find_consecutive_cells(sc,n);
740
 
    if (x == sc->NIL) {
741
 
      /* If all fail, report failure */
 
730
  if (x != sc->NIL) { return x; }
 
731
 
 
732
  /* If not, try gc'ing some */
 
733
  gc(sc, sc->NIL, sc->NIL);
 
734
  x=find_consecutive_cells(sc,n);
 
735
  if (x != sc->NIL) { return x; }
 
736
 
 
737
  /* If there still aren't, try getting more heap */
 
738
  if (!alloc_cellseg(sc,1))
 
739
    {
742
740
      sc->no_memory=1;
743
741
      return sc->sink;
744
742
    }
745
 
  }
746
 
  return (x);
 
743
 
 
744
  x=find_consecutive_cells(sc,n);
 
745
  if (x != sc->NIL) { return x; }
 
746
 
 
747
  /* If all fail, report failure */
 
748
  sc->no_memory=1;
 
749
  return sc->sink;
747
750
}
748
751
 
749
752
static int count_consecutive_cells(pointer x, int needed) {
907
910
 
908
911
  typeflag(x) = (T_CHARACTER | T_ATOM);
909
912
  ivalue_unchecked(x)= c;
910
 
  set_integer(x);
 
913
  set_num_integer(x);
911
914
  return (x);
912
915
}
913
916
 
917
920
 
918
921
  typeflag(x) = (T_NUMBER | T_ATOM);
919
922
  ivalue_unchecked(x)= num;
920
 
  set_integer(x);
 
923
  set_num_integer(x);
921
924
  return (x);
922
925
}
923
926
 
926
929
 
927
930
  typeflag(x) = (T_NUMBER | T_ATOM);
928
931
  rvalue_unchecked(x)= n;
929
 
  set_real(x);
 
932
  set_num_real(x);
930
933
  return (x);
931
934
}
932
935
 
1027
1030
     pointer x=get_consecutive_cells(sc,len/2+len%2+1);
1028
1031
     typeflag(x) = (T_VECTOR | T_ATOM);
1029
1032
     ivalue_unchecked(x)=len;
1030
 
     set_integer(x);
 
1033
     set_num_integer(x);
1031
1034
     fill_vector(x,sc->NIL);
1032
1035
     return x;
1033
1036
}
1959
1962
          strcpy(p, "#<PORT>");
1960
1963
     } else if (is_number(l)) {
1961
1964
          p = sc->strbuff;
1962
 
          if(is_integer(l)) {
 
1965
          if(num_is_integer(l)) {
1963
1966
               sprintf(p, "%ld", ivalue_unchecked(l));
1964
1967
          } else {
1965
1968
               g_ascii_formatd (p, sizeof (sc->strbuff), "%.10g",
3040
3043
#if USE_MATH
3041
3044
     case OP_INEX2EX:    /* inexact->exact */
3042
3045
          x=car(sc->args);
3043
 
          if(is_integer(x)) {
 
3046
          if(num_is_integer(x)) {
3044
3047
               s_return(sc,x);
3045
3048
          } else if(modf(rvalue_unchecked(x),&dd)==0.0) {
3046
3049
               s_return(sc,mk_integer(sc,ivalue(x)));
4217
4220
 
4218
4221
typedef int (*test_predicate)(pointer);
4219
4222
static int is_any(pointer p) { return 1;}
4220
 
static int is_num_integer(pointer p) {
4221
 
  return is_number(p) && ((p)->_object._number.is_fixnum);
4222
 
}
 
4223
 
4223
4224
static int is_nonneg(pointer p) {
4224
 
  return is_num_integer(p) && ivalue(p)>=0;
 
4225
  return is_integer(p) && ivalue(p)>=0;
4225
4226
}
4226
4227
 
4227
4228
/* Correspond carefully with following defines! */
4242
4243
  {is_character, "character"},
4243
4244
  {is_vector, "vector"},
4244
4245
  {is_number, "number"},
4245
 
  {is_num_integer, "integer"},
4246
 
  {is_nonneg, "non-negative integer"},
 
4246
  {is_integer, "integer"},
 
4247
  {is_nonneg, "non-negative integer"}
4247
4248
};
4248
4249
 
4249
4250
#define TST_NONE 0
4391
4392
     y = get_cell(sc, sc->NIL, sc->NIL);
4392
4393
     typeflag(y) = (T_PROC | T_ATOM);
4393
4394
     ivalue_unchecked(y) = (long) op;
4394
 
     set_integer(y);
 
4395
     set_num_integer(y);
4395
4396
     return y;
4396
4397
}
4397
4398