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.47

version 1.27, 2004/08/28 07:28:54

version 1.47, 2006/12/21 05:29:49

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.46 2005/09/27 06:10:43 takayama Exp $ */

#include <stdio.h>

#include <stdlib.h>

#include <string.h>

#include "datatype.h"

#include "stackm.h"

#include "extern.h"

Line 30 struct object KooAdd(ob1,ob2)

Line 32 struct object KooAdd(ob1,ob2)

POLY r;

int s,i;

objectp f1,f2,g1,g2;

struct object nn,dd;

struct object nn = OINIT;

struct object dd = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

case SintegerSinteger:

Line 161 struct object KooSub(ob1,ob2)

Line 164 struct object KooSub(ob1,ob2)

int s,i;

objectp f1,f2,g1,g2;

extern struct coeff *UniversalZero;

struct object nn,dd;

struct object nn = OINIT;

struct object dd = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

case SintegerSinteger:

Line 292 struct object KooMult(ob1,ob2)

Line 296 struct object KooMult(ob1,ob2)

POLY r;

int i,s;

objectp f1,f2,g1,g2;

struct object dd,nn;

struct object dd = OINIT;

struct object nn = OINIT;

switch (Lookup[ob1.tag][ob2.tag]) {

Line 438 struct object KoNegate(obj)

Line 443 struct object KoNegate(obj)

{

struct object rob = NullObject;

extern struct ring SmallRing;

struct object tob;

struct object tob = OINIT;

switch(obj.tag) {

case Sinteger:

rob = obj;

Line 480 struct object KoInverse(obj)

Line 485 struct object KoInverse(obj)

struct object rob = NullObject;

extern struct coeff *UniversalOne;

objectp onep;

struct object tob;

struct object tob = OINIT;

switch(obj.tag) {

case Spoly:

tob.tag = SuniversalNumber;

Line 546 struct object KaoMult(aa,bb)

Line 551 struct object KaoMult(aa,bb)

POLY tmp;

POLY fik;

POLY gkj;

struct object rob;

struct object rob = OINIT;

int r1,r2;

int rsize;

struct object tob;

struct object tob = OINIT;

struct object ob1;

struct object ob1 = OINIT;

extern struct ring SmallRing;

m = getoaSize(aa); m2 = getoaSize(bb);

Line 610 struct object KaoMult(aa,bb)

Line 615 struct object KaoMult(aa,bb)

r1 = isMatrix(aa,m,n); r2 = isMatrix(bb,m2,n2);

if (r1 == -1 || r2 == -1) {

/* Object multiplication. Elements are not polynomials. */

struct object ofik,ogkj,otmp;

struct object ofik = OINIT;

struct object ogkj = OINIT;

struct object otmp = OINIT;

rob = newObjectArray(m);

for (i=0; i<m; i++) {

getoa(rob,i) = newObjectArray(n2);

Line 685 KooEqualQ(obj1,obj2)

Line 692 KooEqualQ(obj1,obj2)

struct object obj1;

struct object obj2;

{

struct object ob;

struct object ob = OINIT;

int i;

extern int Verbose;

if (obj1.tag != obj2.tag) {

warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n");

if (Verbose & 0x10) {

fprintf(stderr,"obj1(tag:%d)=",obj1.tag);

printObject(obj1,0,stderr);

fprintf(stderr,", obj2(tag:%d)=",obj2.tag);

printObject(obj2,0,stderr);

fprintf(stderr,"\n"); fflush(stderr);

}

return(0);

}

switch(obj1.tag) {

Line 766 struct object KooGreater(obj1,obj2)

Line 781 struct object KooGreater(obj1,obj2)

struct object obj1;

struct object obj2;

{

struct object ob;

struct object ob = OINIT;

int tt;

if (obj1.tag != obj2.tag) {

errorKan1("%s\n","You cannot compare different kinds of objects.");

Line 800 struct object KooGreater(obj1,obj2)

Line 815 struct object KooGreater(obj1,obj2)

case Sarray:

{

int i,m1,m2;

struct object rr;

struct object rr = OINIT;

m1 = getoaSize(obj1); m2 = getoaSize(obj2);

for (i=0; i< (m1>m2?m2:m1); i++) {

rr=KooGreater(getoa(obj1,i),getoa(obj2,i));

Line 856 struct object KooLess(obj1,obj2)

Line 871 struct object KooLess(obj1,obj2)

case Sarray:

{

int i,m1,m2;

struct object rr;

struct object rr = OINIT;

m1 = getoaSize(obj1); m2 = getoaSize(obj2);

for (i=0; i< (m1>m2?m2:m1); i++) {

rr=KooLess(getoa(obj1,i),getoa(obj2,i));

Line 882 struct object KdataConversion(obj,key)

Line 897 struct object KdataConversion(obj,key)

{

char tmps[128]; /* Assume that double is not more than 128 digits */

char intstr[100]; /* Assume that int is not more than 100 digits */

struct object rob;

struct object rob = OINIT;

extern struct ring *CurrentRingp;

extern struct ring SmallRing;

int flag;

struct object rob1,rob2;

struct object rob1 = OINIT;

struct object rob2 = OINIT;

char *s;

int i;

double f;

Line 919 struct object KdataConversion(obj,key)

Line 935 struct object KdataConversion(obj,key)

return(rob);

}else if (strcmp(key,"poly") == 0) {

rob = KpoPOLY(ZERO);

return rob;

}else if (strcmp(key,"array") == 0) {

rob = newObjectArray(0);

return rob;

}else{

warningKan("Sorry. The data conversion from null to this data type has not supported yet.\n");

}

Line 1015 struct object KdataConversion(obj,key)

Line 1035 struct object KdataConversion(obj,key)

if (strcmp(key,"array") == 0) {

return(rob);

}else if (strcmp(key,"list") == 0) {

rob = *( arrayToList(obj) );

rob = KarrayToList(obj);

return(rob);

}else if (strcmp(key,"arrayOfPOLY")==0) {

rob = KpoArrayOfPOLY(arrayToArrayOfPOLY(obj));

Line 1029 struct object KdataConversion(obj,key)

Line 1049 struct object KdataConversion(obj,key)

}else if (strcmp(key,"null") == 0) {

rob = NullObject;

return(rob);

}else if (strcmp(key,"byteArray") == 0) {

rob = newByteArray(getoaSize(obj),obj);

return(rob);

}else {

{ /* Automatically maps the elements. */

int n,i;

Line 1108 struct object KdataConversion(obj,key)

Line 1131 struct object KdataConversion(obj,key)

break;

case Slist:

if (strcmp(key,"array") == 0) {

rob = listToArray(&obj);

rob = KlistToArray(obj);

return(rob);

}

break;

Line 1206 struct object KdataConversion(obj,key)

Line 1229 struct object KdataConversion(obj,key)

warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");

}

break;

case SbyteArray:

if (strcmp(key,"array") == 0) {

rob = byteArrayToArray(obj);

return(rob);

} else {

warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n");

}

break;

default:

warningKan("Sorry. This type of data conversion has not supported yet.\n");

}

return(NullObject);

}

/* cf. macro to_int32 */

struct object Kto_int32(struct object ob) {

int n,i;

struct object otmp = OINIT;

struct object rob = OINIT;

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)

int k;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sinteger;

obj.lc.ival = k; obj.rc.ival = 0;

return(obj);

Line 1225 struct object KpoInteger(k)

Line 1273 struct object KpoInteger(k)

struct object KpoString(s)

char *s;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sdollar;

obj.lc.str = s; obj.rc.ival = 0;

return(obj);

Line 1233 struct object KpoString(s)

Line 1281 struct object KpoString(s)

struct object KpoPOLY(f)

POLY f;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Spoly;

obj.lc.poly = f; obj.rc.ival = 0;

return(obj);

Line 1241 struct object KpoPOLY(f)

Line 1289 struct object KpoPOLY(f)

struct object KpoArrayOfPOLY(ap)

struct arrayOfPOLY *ap ;

{

struct object obj;

struct object obj = OINIT;

obj.tag = SarrayOfPOLY;

obj.lc.arrayp = ap; obj.rc.ival = 0;

return(obj);

Line 1250 struct object KpoArrayOfPOLY(ap)

Line 1298 struct object KpoArrayOfPOLY(ap)

struct object KpoMatrixOfPOLY(mp)

struct matrixOfPOLY *mp ;

{

struct object obj;

struct object obj = OINIT;

obj.tag = SmatrixOfPOLY;

obj.lc.matrixp = mp; obj.rc.ival = 0;

return(obj);

Line 1259 struct object KpoMatrixOfPOLY(mp)

Line 1307 struct object KpoMatrixOfPOLY(mp)

struct object KpoRingp(ringp)

struct ring *ringp;

{

struct object obj;

struct object obj = OINIT;

obj.tag = Sring;

obj.lc.ringp = ringp;

return(obj);

Line 1268 struct object KpoRingp(ringp)

Line 1316 struct object KpoRingp(ringp)

struct object KpoUniversalNumber(u)

struct coeff *u;

{

struct object obj;

struct object obj = OINIT;

obj.tag = SuniversalNumber;

obj.lc.universalNumber = u;

return(obj);

Line 1276 struct object KpoUniversalNumber(u)

Line 1324 struct object KpoUniversalNumber(u)

struct object KintToUniversalNumber(n)

int n;

{

struct object rob;

struct object rob = OINIT;

extern struct ring SmallRing;

rob.tag = SuniversalNumber;

rob.lc.universalNumber = intToCoeff(n,&SmallRing);

Line 1289 struct object arrayOfPOLYToArray(aa)

Line 1337 struct object arrayOfPOLYToArray(aa)

{

POLY *a;

int size;

struct object r;

struct object r = OINIT;

int j;

struct object tmp;

struct object tmp = OINIT;

size = aa->n; a = aa->array;

r = newObjectArray(size);

Line 1306 struct object arrayOfPOLYToArray(aa)

Line 1354 struct object arrayOfPOLYToArray(aa)

struct object matrixOfPOLYToArray(pmat)

struct matrixOfPOLY *pmat;

{

struct object r;

struct object r = OINIT;

struct object tmp;

struct object tmp = OINIT;

int i,j;

int m,n;

POLY *mat;

Line 1330 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)

Line 1378 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)

POLY *a;

int size;

int i;

struct object tmp;

struct object tmp = OINIT;

struct arrayOfPOLY *ap;

if (oa.tag != Sarray) errorKan1("KarrayToArrayOfPOLY(): %s",

Line 1358 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)

Line 1406 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)

int i,j;

struct matrixOfPOLY *ma;

struct object tmp,tmp2;

struct object tmp = OINIT;

struct object tmp2 = OINIT;

if (oa.tag != Sarray) errorKan1("KarrayToMatrixOfPOLY(): %s",

"Argument is not array\n");

m = getoaSize(oa);

Line 1396 int objArrayToOrderMatrix(oA,order,n,oasize)

Line 1445 int objArrayToOrderMatrix(oA,order,n,oasize)

{

int size;

int k,j;

struct object tmpOa;

struct object tmpOa = OINIT;

struct object obj;

struct object obj = OINIT;

if (oA.tag != Sarray) {

warningKan("The argument should be of the form [ [...] [...] ... [...]].");

return(-1);

Line 1482 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1531 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

ob4 = Order matrix

ob5 = [(keyword) value (keyword) value ....]

#define RP_LIMIT 500

#define RP_LIMIT 5000

{

int i;

struct object ob;

struct object ob = OINIT;

int c,l,m,n;

int cc,ll,mm,nn;

int p;

Line 1508 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1557 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

extern char *F_mpMult;

char *fmp_mult_saved;

char *mpMultName = NULL;

struct object rob;

struct object rob = OINIT;

struct ring *savedCurrentRingp;

/* To get the ring structure. */

Line 1579 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1628 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 1609 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1659 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

newRingp->cc = cc;

newRingp->x = xvars;

newRingp->D = dvars;

newRingp->Dsmall = makeDsmall(dvars,n);

/* You don't need to set order and orderMatrixSize here.

It was set by setOrder(). */

setFromTo(newRingp);

Line 1624 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1675 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

newRingp->degreeShiftSize = 0;

newRingp->degreeShiftN = 0;

newRingp->degreeShift = NULL;

newRingp->partialEcart = 0;

newRingp->partialEcartGlobalVarX = NULL;

if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) {

errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given.");

Line 1680 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1733 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

errorKan1("%s\n","An array of array should be given. (degreeShift)");

}

{

struct object ods;

struct object ods = OINIT;

struct object ods2;

struct object ods2 = OINIT;

int dssize,k,j,nn;

ods=getoa(ob5,i+1);

if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) {

Line 1704 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1757 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

}

} else if (strcmp(KopString(getoa(ob5,i)),"partialEcartGlobalVarX") == 0) {

if (getoa(ob5,i+1).tag != Sarray) {

errorKan1("%s\n","An array of array should be given. (partialEcart)");

}

{

struct object odv = OINIT;

struct object ovv = OINIT;

int k,j,nn;

char *vname;

odv=getoa(ob5,i+1);

nn = getoaSize(odv);

newRingp->partialEcart = nn;

newRingp->partialEcartGlobalVarX = (int *) sGC_malloc(sizeof(int)*nn+1);

if (newRingp->partialEcartGlobalVarX == NULL) errorKan1("%s\n","No more memory.");

for (j=0; j<nn; j++)

(newRingp->partialEcartGlobalVarX)[j] = -1;

for (j=0; j<nn; j++) {

ovv = getoa(odv,j);

if (ovv.tag != Sdollar) errorKan1("%s\n","partialEcartGlobalVarX: string is expected.");

vname = KopString(ovv);

for (k=0; k<n; k++) {

if (strcmp(vname,xvars[k]) == 0) {

(newRingp->partialEcartGlobalVarX)[j] = k; break;

}else{

if (k == n-1) errorKan1("%s\n","partialEcartGlobalVarX: no such variable.");

}

switch_function("grade","module1v");

/* Warning: grading is changed to module1v!! */

} else {

Line 1758 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

Line 1841 int KsetUpRing(ob1,ob2,ob3,ob4,ob5)

struct object KsetVariableNames(struct object ob,struct ring *rp)

{

int n,i;

struct object ox;

struct object ox = OINIT;

struct object otmp;

struct object otmp = OINIT;

char **xvars;

char **dvars;

if (ob.tag != Sarray) {

Line 1804 struct object KswitchFunction(ob1,ob2)

Line 1887 struct object KswitchFunction(ob1,ob2)

struct object ob1,ob2;

{

char *ans ;

struct object rob;

struct object rob = OINIT;

int needWarningForAvoidTheSameRing = 0;

extern int AvoidTheSameRing;

if ((ob1.tag != Sdollar) || (ob2.tag != Sdollar)) {

Line 1846 struct object KoReplace(of,rule)

Line 1929 struct object KoReplace(of,rule)

struct object of;

struct object rule;

{

struct object rob;

struct object rob = OINIT;

POLY f;

POLY lRule[N0*2];

POLY rRule[N0*2];

POLY r;

int i;

int n;

struct object trule;

struct object trule = OINIT;

if (rule.tag != Sarray) {

Line 1909 struct object Kparts(f,v)

Line 1992 struct object Kparts(f,v)

{

POLY ff;

POLY vv;

struct object obj;

struct object obj = OINIT;

struct matrixOfPOLY *co;

/* check the data type */

if (f.tag != Spoly || v.tag != Spoly)

Line 1926 struct object Kparts2(f,v)

Line 2009 struct object Kparts2(f,v)

{

POLY ff;

POLY vv;

struct object obj;

struct object obj = OINIT;

struct matrixOfPOLY *co;

/* check the data type */

if (f.tag != Spoly || v.tag != Spoly)

Line 1974 struct object Ksp(ob1,ob2)

Line 2057 struct object Ksp(ob1,ob2)

struct object ob1,ob2;

{

struct spValue sv;

struct object rob,cob;

struct object rob = OINIT;

struct object cob = OINIT;

POLY f;

if (ob1.tag != Spoly || ob2.tag != Spoly)

errorKan1("%s\n","Ksp(): The arguments must be polynomials.");

Line 2004 struct object Keval(obj)

Line 2088 struct object Keval(obj)

{

char *key;

int size;

struct object rob;

struct object rob = OINIT;

rob = NullObject;

if (obj.tag != Sarray)

Line 2049 char *KremoveSpace(str)

Line 2133 char *KremoveSpace(str)

struct object KtoRecords(ob)

struct object ob;

{

struct object obj;

struct object obj = OINIT;

struct object tmp;

struct object tmp = OINIT;

int i;

int size;

char **argv;

Line 2146 int KtoArgvbyCurryBrace(str,argv,limit)

Line 2230 int KtoArgvbyCurryBrace(str,argv,limit)

}

struct object KstringToArgv(struct object ob) {

struct object rob;

struct object rob = OINIT;

char *s;

int n,wc,i,inblank;

char **argv;

Line 2186 struct object KstringToArgv(struct object ob) {

Line 2270 struct object KstringToArgv(struct object ob) {

return(rob);

}

struct object KstringToArgv2(struct object ob,struct object oseparator) {

struct object rob = OINIT;

char *s;

int n,wc,i,inblank;

char **argv;

int separator;

if (ob.tag != Sdollar)

errorKan1("%s\n","KstringToArgv2(): the argument must be a string.");

if (oseparator.tag == Sinteger) {

separator = KopInteger(oseparator);

}else if (oseparator.tag == Sdollar) {

s = KopString(oseparator);

separator=s[0];

}else {

errorKan1("%s\n","KstringToArgv2(ob,separator):the argument must be strings.");

}

n = strlen(KopString(ob));

s = (char *) sGC_malloc(sizeof(char)*(n+2));

if (s == NULL) errorKan1("%s\n","KstringToArgv(): No memory.");

strcpy(s,KopString(ob));

inblank = 1; wc = 0;

for (i=0; i<n; i++) {

if (inblank && (s[i] != separator)) {

wc++; inblank = 0;

}else if ((!inblank) && (s[i] == separator)) {

inblank = 1;

}

argv = (char **) sGC_malloc(sizeof(char *)*(wc+2));

argv[0] = NULL;

inblank = 1; wc = 0;

for (i=0; i<n; i++) {

if (inblank && (s[i] != separator)) {

argv[wc] = &(s[i]); argv[wc+1]=NULL;

wc++; inblank = 0;

}else if ((inblank == 0) && (s[i] == separator)) {

inblank = 1; s[i] = 0;

}else if (inblank && (s[i] == separator)) {

s[i] = 0;

}

rob = newObjectArray(wc);

for (i=0; i<wc; i++) {

putoa(rob,i,KpoString(argv[i]));

/* printf("%s\n",argv[i]); */

}

return(rob);

}

static void checkDuplicateName(xvars,dvars,n)

char *xvars[];

char *dvars[];

Line 2208 static void checkDuplicateName(xvars,dvars,n)

Line 2342 static void checkDuplicateName(xvars,dvars,n)

}

struct object KooPower(struct object ob1,struct object ob2) {

struct object rob;

struct object rob = OINIT;

/* Bug. It has not yet been implemented. */

if (QuoteMode) {

rob = powerTree(ob1,ob2);

Line 2330 struct object KgbExtension(struct object obj)

Line 2464 struct object KgbExtension(struct object obj)

{

char *key;

int size;

struct object keyo;

struct object keyo = OINIT;

struct object rob = NullObject;

struct object obj1,obj2,obj3;

struct object obj1 = OINIT;

struct object obj2 = OINIT;

struct object obj3 = OINIT;

POLY f1;

POLY f2;

POLY f3;

Line 2501 struct object KmpzExtension(struct object obj)

Line 2637 struct object KmpzExtension(struct object obj)

{

char *key;

int size;

struct object keyo;

struct object keyo = OINIT;

struct object rob = NullObject;

struct object obj0,obj1,obj2,obj3;

struct object obj0 = OINIT;

struct object obj1 = OINIT;

struct object obj2 = OINIT;

struct object obj3 = OINIT;

MP_INT *f;

MP_INT *g;

MP_INT *h;

Line 2732 struct object KmpzExtension(struct object obj)

Line 2871 struct object KmpzExtension(struct object obj)

/** : context */

struct object KnewContext(struct object superObj,char *name) {

struct context *cp;

struct object ob;

struct object ob = OINIT;

if (superObj.tag != Sclass) {

errorKan1("%s\n","The argument of KnewContext must be a Class.Context");

}

Line 2751 struct object KcreateClassIncetance(struct object ob1,

Line 2890 struct object KcreateClassIncetance(struct object ob1,

struct object ob3)

{

/* [class-tag super-obj] size [class-tag] cclass */

struct object ob4;

struct object ob4 = OINIT;

int size,size2,i;

struct object ob5;

struct object ob5 = OINIT;

struct object rob;

struct object rob = OINIT;

if (ob1.tag != Sarray)

errorKan1("%s\n","cclass: The first argument must be an array.");

Line 2807 struct object KpoDouble(double a) {

Line 2946 struct object KpoDouble(double a) {

double toDouble0(struct object ob) {

double r;

int r3;

struct object ob2;

struct object ob2 = OINIT;

struct object ob3;

struct object ob3 = OINIT;

switch(ob.tag) {

case Sinteger:

return( (double) (KopInteger(ob)) );

Line 2837 double toDouble0(struct object ob) {

Line 2976 double toDouble0(struct object ob) {

}

struct object KpoGradedPolySet(struct gradedPolySet *grD) {

struct object rob;

struct object rob = OINIT;

rob.tag = Sclass;

rob.lc.ival = CLASSNAME_GradedPolySet;

rob.rc.voidp = (void *) grD;

Line 2854 static char *getspace0(int a) {

Line 2993 static char *getspace0(int a) {

return(s);

}

struct object KdefaultPolyRing(struct object ob) {

struct object rob;

struct object rob = OINIT;

int i,j,k,n;

struct object ob1,ob2,ob3,ob4,ob5;

struct object ob1 = OINIT;

struct object t1;

struct object ob2 = OINIT;

struct object ob3 = OINIT;

struct object ob4 = OINIT;

struct object ob5 = OINIT;

struct object t1 = OINIT;

char *s1;

extern struct ring *CurrentRingp;

static struct ring *a[N0];

Line 2928 struct object KdefaultPolyRing(struct object ob) {

Line 3071 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) || (ob.tag == Snull)) {

return Kcdr(ob);

}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 = OINIT;

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 if ((ob1.tag == Slist) || (ob1.tag == Snull)) {

if ((ob2.tag == Slist) || (ob2.tag == Snull)) {

return KvJoin(ob1,ob2);

}else{

errorKan1("%s\n","Kjoin: both argument must be a list.");

}

}else{

errorKan1("%s\n","Kjoin: arguments must be arrays.");

}

struct object Kget(struct object ob1, struct object ob2) {

struct object rob = OINIT;

struct object tob = OINIT;

int i,j,size,n;

if (ob2.tag == Sinteger) {

i =ob2.lc.ival;

}else if (ob2.tag == SuniversalNumber) {

i = KopInteger(KdataConversion(ob2,"integer"));

}else if (ob2.tag == Sarray) {

n = getoaSize(ob2);

if (n == 0) return ob1;

rob = ob1;

for (i=0; i<n; i++) {

rob=Kget(rob,getoa(ob2,i));

}

return rob;

}

if (ob1.tag == Sarray) {

size = getoaSize(ob1);

if ((0 <= i) && (i<size)) {

return(getoa(ob1,i));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

}else if (ob1.tag == Slist) {

rob = NullObject;

if (i < 0) errorKan1("%s\n","Kget: Index is negative. (get)");

for (j=0; j<i; j++) {

rob = Kcdr(ob1);

if ((ob1.tag == Snull) && (rob.tag == Snull)) {

errorKan1("%s\n","Kget: Index is out of bound. (get) cdr of null list.\n");

}

ob1 = rob;

}

return Kcar(ob1);

} else if (ob1.tag == SbyteArray) {

size = getByteArraySize(ob1);

if ((0 <= i) && (i<size)) {

return(KpoInteger(KopByteArray(ob1)[i]));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

} else if (ob1.tag == Sdollar) {

unsigned char *sss;

sss = (unsigned char *) KopString(ob1);

size = strlen(sss);

if ((0 <= i) && (i<size)) {

return(KpoInteger(sss[i]));

}else{

errorKan1("%s\n","Kget: Index is out of bound. (get)\n");

}

}else errorKan1("%s\n","Kget: argument must be an array or a list.");

}

/* Constructor of byteArray */

struct object newByteArray(int size,struct object obj) {

unsigned char *ba;

unsigned char *ba2;

struct object rob = OINIT;

struct object tob = OINIT;

int i,n;

ba = NULL;

if (size > 0) {

ba = (unsigned char *) sGC_malloc(size);

if (ba == NULL) errorKan1("%s\n","No more memory.");

}

rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;

if (obj.tag == SbyteArray) {

n = getByteArraySize(obj);

ba2 = KopByteArray(obj);

for (i=0; i<(n<size?n:size); i++) {

ba[i] = ba2[i];

}

for (i=n; i<size; i++) ba[i] = 0;

return rob;

}else if (obj.tag == Sarray) {

n = getoaSize(obj);

for (i=0; i<n; i++) {

tob = getoa(obj,i);

tob = Kto_int32(tob);

if (tob.tag != Sinteger) errorKan1("%s\n","newByteArray: array is not an array of integer or universalNumber.");

ba[i] = (unsigned char) KopInteger(tob);

}

for (i=n; i<size; i++) ba[i] = 0;

return rob;

}else{

for (i=0; i<size; i++) ba[i] = 0;

return rob;

}

struct object newByteArrayFromStr(char *s,int size) {

unsigned char *ba;

struct object rob = OINIT;

int i;

ba = NULL;

if (size > 0) {

ba = (unsigned char *) sGC_malloc(size);

if (ba == NULL) errorKan1("%s\n","No more memory.");

}

rob.tag = SbyteArray; rob.lc.bytes = ba; rob.rc.ival = size;

for (i=0; i<size; i++) {

ba[i] = (char) s[i];

}

return(rob);

}

struct object byteArrayToArray(struct object obj) {

int n,i; unsigned char *ba;

struct object rob = OINIT;

if (obj.tag != SbyteArray) errorKan1("%s\n","byteArrayToArray: argument is not an byteArray.");

n = getByteArraySize(obj);

rob = newObjectArray(n);

ba = KopByteArray(obj);

for (i=0; i<n; i++) putoa(rob,i,KpoInteger((int) ba[i]));

return rob;

}

struct object KgetAttributeList(struct object ob){

struct object rob = OINIT;

if (ob.attr != NULL) rob = *(ob.attr);

else rob = NullObject;

return rob;

}

struct object KsetAttributeList(struct object ob,struct object attr) {

ob.attr = newObject();

*(ob.attr) = attr;

return ob;

}

struct object KgetAttribute(struct object ob,struct object key) {

struct object rob = OINIT;

struct object alist = OINIT;

int n,i;

struct object tob = OINIT;

char *s;

rob = NullObject;

if (ob.attr == NULL) return rob;

alist = *(ob.attr);

if (alist.tag != Sarray) return rob;

if (key.tag != Sdollar) return rob;

s = KopString(key);

n = getoaSize(alist);

for (i = 0; i < n; i += 2) {

tob = getoa(alist,i);

if (tob.tag == Sdollar) {

if (strcmp(KopString(tob),s) == 0) {

if (i+1 < n) rob = getoa(alist,i+1);

return rob;

}

return rob;

}

/* ob (key) (value) setAttribute /ob set. They are not destructive. */

struct object KsetAttribute(struct object ob,struct object key,struct object value) {

struct object rob = OINIT;

struct object alist = OINIT;

int n,i;

char *s = "";

struct object tob = OINIT;

rob = ob;

if (ob.attr == NULL) {

rob.attr = newObject();

*(rob.attr) = newObjectArray(2);

putoa((*(rob.attr)),0,key);

putoa((*(rob.attr)),1,value);

return rob;

}

alist = *(ob.attr);

if (alist.tag != Sarray) return rob;

if (key.tag != Sdollar) {

s = KopString(key);

}

n = getoaSize(alist);

for (i = 0; i < n; i += 2) {

tob = getoa(alist,i);

if (tob.tag == Sdollar) {

if (strcmp(KopString(tob),s) == 0) {

if (i+1 < n) putoa(alist,i+1,value);

return rob;

}

rob.attr = newObject();

*(rob.attr) = newObjectArray(n+2);

for (i=0; i<n; i++) {

putoa((*(rob.attr)),i,getoa((*(ob.attr)),i));

}

putoa((*(rob.attr)),n,key);

putoa((*(rob.attr)),n+1,value);

return rob;

}

/******************************************************************

error handler

Error handler

******************************************************************/

errorKan1(str,message)

Line 2942 errorKan1(str,message)

Line 3318 errorKan1(str,message)

extern char *GotoLabel;

extern int GotoP;

extern int ErrorMessageMode;

extern int RestrictedMode, RestrictedMode_saved;

char tmpc[1024];

RestrictedMode = RestrictedMode_saved;

cancelAlarm();

if (ErrorMessageMode == 1 || ErrorMessageMode == 2) {

sprintf(tmpc,"\nERROR(kanExport[0|1].c): ");

Line 2954 errorKan1(str,message)

Line 3332 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>