OpenXM/src/kan96xx/Kan/kanExport0.c - diff

Return to kanExport0.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/kanExport0.c between version 1.27 and 1.31

-version 1.27, 2004/08/28 07:28:54
+version 1.31, 2004/09/09 03:14:46
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.26 2004/08/23 08:33:55 takayama Exp $  */
+ /* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.30 2004/09/04 11:25:58 takayama Exp $  */
  #include <stdio.h>
  #include "datatype.h"
  #include "stackm.h"
 Line 1211  struct object KdataConversion(obj,key)
 Line 1211  struct object KdataConversion(obj,key)
 Line 1211  struct object KdataConversion(obj,key)
    }
    return(NullObject);
  }
+ /* cf. macro to_int32 */
+ struct object Kto_int32(struct object ob) {
+   int n,i;
+   struct object otmp;
+   struct object rob;
+   if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer");
+   if (ob.tag == Sarray) {
+         n = getoaSize(ob);
+         rob = newObjectArray(n);
+         for (i=0; i<n; i++) {
+           otmp = Kto_int32(getoa(ob,i));
+           putoa(rob,i,otmp);
+         }
+         return rob;
+   }
+   return ob;
+ }
  /* conversion functions between primitive data and objects.
     If it's not time critical, it is recommended to use these functions */
  struct object KpoInteger(k)
-Line 1579  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
+Line 1596  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1579  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
 Line 1596  int KsetUpRing(ob1,ob2,ob3,ob4,ob5)
        outputVars[i] = i;
      }
    }
+   ob4 = Kto_int32(ob4); /* order matrix */
    oasize = getoaSize(ob4);
    order = (int *)sGC_malloc(sizeof(int)*((2*n)*oasize+1));
    if (order == (int *)NULL) errorKan1("%s\n","No memory.");
-Line 2928  struct object KdefaultPolyRing(struct object ob) {
+Line 2946  struct object KdefaultPolyRing(struct object ob) {
 Line 2928  struct object KdefaultPolyRing(struct object ob) {
 Line 2946  struct object KdefaultPolyRing(struct object ob) {
  }
+ struct object Krest(struct object ob) {
+   struct object rob;
+   struct object *op;
+   int n,i;
+   if (ob.tag == Sarray) {
+     n = getoaSize(ob);
+     if (n == 0) return ob;
+     rob = newObjectArray(n-1);
+     for (i=1; i<n; i++) {
+       putoa(rob,i-1,getoa(ob,i));
+     }
+     return rob;
+   }else if (ob.tag == Slist) {
+     errorKan1("%s\n","Krest: it has not yet been implemented.");
+   }else{
+     errorKan1("%s\n","Krest(ob): ob must be an array or a list.");
+   }
+ }
+ struct object Kjoin(struct object ob1, struct object ob2) {
+   struct object rob;
+   int n1,n2,i;
+   if ((ob1.tag == Sarray) &&  (ob2.tag == Sarray)) {
+     n1 = getoaSize(ob1); n2 = getoaSize(ob2);
+     rob = newObjectArray(n1+n2);
+     for (i=0; i<n1; i++) {
+       putoa(rob,i,getoa(ob1,i));
+     }
+     for (i=n1; i<n1+n2; i++) {
+       putoa(rob,i,getoa(ob2,i-n1));
+     }
+     return rob;
+   }else{
+     errorKan1("%s\n","Kjoin: arguments must be arrays.");
+   }
+ }
-Line 2954  errorKan1(str,message)
+Line 3007  errorKan1(str,message)
 Line 2954  errorKan1(str,message)
 Line 3007  errorKan1(str,message)
    if (ErrorMessageMode != 1) {
      fprintf(stderr,"\nERROR(kanExport[0|1].c): ");
      fprintf(stderr,str,message);
+     (void) traceShowStack(); traceClearStack();
    }
    /* fprintf(stderr,"Hello "); */
    if (GotoP) {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>