version 1.33, 2004/09/11 01:00:42 |
version 1.39, 2004/09/20 02:26:56 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.32 2004/09/09 11:42:22 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.38 2004/09/20 02:11:22 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
Line 687 KooEqualQ(obj1,obj2) |
|
Line 687 KooEqualQ(obj1,obj2) |
|
{ |
{ |
struct object ob; |
struct object ob; |
int i; |
int i; |
|
extern int Verbose; |
if (obj1.tag != obj2.tag) { |
if (obj1.tag != obj2.tag) { |
warningKan("KooEqualQ(ob1,ob2): the datatypes of ob1 and ob2 are not same. Returns false (0).\n"); |
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); |
return(0); |
} |
} |
switch(obj1.tag) { |
switch(obj1.tag) { |
Line 1033 struct object KdataConversion(obj,key) |
|
Line 1041 struct object KdataConversion(obj,key) |
|
}else if (strcmp(key,"null") == 0) { |
}else if (strcmp(key,"null") == 0) { |
rob = NullObject; |
rob = NullObject; |
return(rob); |
return(rob); |
|
}else if (strcmp(key,"byteArray") == 0) { |
|
rob = newByteArray(getoaSize(obj),obj); |
|
return(rob); |
}else { |
}else { |
{ /* Automatically maps the elements. */ |
{ /* Automatically maps the elements. */ |
int n,i; |
int n,i; |
Line 1210 struct object KdataConversion(obj,key) |
|
Line 1221 struct object KdataConversion(obj,key) |
|
warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n"); |
warningKan("Sorryl This type of data conversion of ringp has not supported yet.\n"); |
} |
} |
break; |
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: |
default: |
warningKan("Sorry. This type of data conversion has not supported yet.\n"); |
warningKan("Sorry. This type of data conversion has not supported yet.\n"); |
} |
} |
Line 1646 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1665 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
newRingp->degreeShiftSize = 0; |
newRingp->degreeShiftSize = 0; |
newRingp->degreeShiftN = 0; |
newRingp->degreeShiftN = 0; |
newRingp->degreeShift = NULL; |
newRingp->degreeShift = NULL; |
|
newRingp->partialEcart = 0; |
|
newRingp->partialEcartGlobalVarX = NULL; |
|
|
if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) { |
if (ob5.tag != Sarray || (getoaSize(ob5) % 2) != 0) { |
errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given."); |
errorKan1("%s\n","[(keyword) value (keyword) value ....] should be given."); |
Line 1726 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1747 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; |
|
struct object ovv; |
|
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"); |
switch_function("grade","module1v"); |
/* Warning: grading is changed to module1v!! */ |
/* Warning: grading is changed to module1v!! */ |
} else { |
} else { |
Line 3027 struct object Kget(struct object ob1, struct object ob |
|
Line 3078 struct object Kget(struct object ob1, struct object ob |
|
ob1 = rob; |
ob1 = rob; |
} |
} |
return Kcar(ob1); |
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."); |
}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,tob; |
|
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 byteArrayToArray(struct object obj) { |
|
int n,i; unsigned char *ba; |
|
struct object rob; |
|
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; |
|
} |
|
|
/****************************************************************** |
/****************************************************************** |
error handler |
error handler |
******************************************************************/ |
******************************************************************/ |
Line 3041 errorKan1(str,message) |
|
Line 3155 errorKan1(str,message) |
|
extern char *GotoLabel; |
extern char *GotoLabel; |
extern int GotoP; |
extern int GotoP; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
|
extern int RestrictedMode, RestrictedMode_saved; |
char tmpc[1024]; |
char tmpc[1024]; |
|
RestrictedMode = RestrictedMode_saved; |
cancelAlarm(); |
cancelAlarm(); |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
if (ErrorMessageMode == 1 || ErrorMessageMode == 2) { |
sprintf(tmpc,"\nERROR(kanExport[0|1].c): "); |
sprintf(tmpc,"\nERROR(kanExport[0|1].c): "); |