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.32 and 1.44

version 1.32, 2004/09/09 11:42:22

version 1.44, 2005/06/16 06:21:21

Line 1

/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.31 2004/09/09 03:14:46 takayama Exp $ */

/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.43 2005/06/16 05:07:23 takayama Exp $ */

#include <stdio.h>

#include "datatype.h"

#include "stackm.h"

Line 30 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 162 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 294 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 441 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 483 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 549 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 613 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 690 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 779 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 813 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 869 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 895 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 1033 struct object KdataConversion(obj,key)

Line 1047 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 1210 struct object KdataConversion(obj,key)

Line 1227 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");

}

Line 1219 struct object KdataConversion(obj,key)

Line 1244 struct object KdataConversion(obj,key)

/* cf. macro to_int32 */

struct object Kto_int32(struct object ob) {

int n,i;

struct object otmp;

struct object otmp = OINIT;

struct object rob;

struct object rob = OINIT;

if (ob.tag == SuniversalNumber) return KdataConversion(ob,"integer");

if (ob.tag == Sarray) {

n = getoaSize(ob);

Line 1238 struct object Kto_int32(struct object ob) {

Line 1263 struct object Kto_int32(struct object ob) {

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 1246 struct object KpoInteger(k)

Line 1271 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 1254 struct object KpoString(s)

Line 1279 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 1262 struct object KpoPOLY(f)

Line 1287 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 1271 struct object KpoArrayOfPOLY(ap)

Line 1296 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 1280 struct object KpoMatrixOfPOLY(mp)

Line 1305 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 1289 struct object KpoRingp(ringp)

Line 1314 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 1297 struct object KpoUniversalNumber(u)

Line 1322 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 1310 struct object arrayOfPOLYToArray(aa)

Line 1335 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 1327 struct object arrayOfPOLYToArray(aa)

Line 1352 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 1351 struct arrayOfPOLY *arrayToArrayOfPOLY(oa)

Line 1376 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 1379 struct matrixOfPOLY *arrayToMatrixOfPOLY(oa)

Line 1404 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 1417 int objArrayToOrderMatrix(oA,order,n,oasize)

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

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

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

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

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

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

Line 1838 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 1826 struct object KswitchFunction(ob1,ob2)

Line 1884 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 1868 struct object KoReplace(of,rule)

Line 1926 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 1931 struct object Kparts(f,v)

Line 1989 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 1948 struct object Kparts2(f,v)

Line 2006 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 1996 struct object Ksp(ob1,ob2)

Line 2054 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 2026 struct object Keval(obj)

Line 2085 struct object Keval(obj)

{

char *key;

int size;

struct object rob;

struct object rob = OINIT;

rob = NullObject;

if (obj.tag != Sarray)

Line 2071 char *KremoveSpace(str)

Line 2130 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 2168 int KtoArgvbyCurryBrace(str,argv,limit)

Line 2227 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 2230 static void checkDuplicateName(xvars,dvars,n)

Line 2289 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 2352 struct object KgbExtension(struct object obj)

Line 2411 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 2523 struct object KmpzExtension(struct object obj)

Line 2584 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 2754 struct object KmpzExtension(struct object obj)

Line 2818 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 2773 struct object KcreateClassIncetance(struct object ob1,

Line 2837 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 2829 struct object KpoDouble(double a) {

Line 2893 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 2859 double toDouble0(struct object ob) {

Line 2923 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 2876 static char *getspace0(int a) {

Line 2940 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 2969 struct object Krest(struct object ob) {

Line 3037 struct object Krest(struct object ob) {

}

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

struct object rob;

struct object rob = OINIT;

int n1,n2,i;

if ((ob1.tag == Sarray) && (ob2.tag == Sarray)) {

n1 = getoaSize(ob1); n2 = getoaSize(ob2);

Line 2992 struct object Kjoin(struct object ob1, struct object o

Line 3060 struct object Kjoin(struct object ob1, struct object o

}

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 3005 errorKan1(str,message)

Line 3265 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): ");

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