version 1.8, 2002/02/24 10:27:18 |
version 1.14, 2003/07/14 12:49:52 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.7 2001/05/04 01:06:23 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/kanExport0.c,v 1.13 2003/07/05 01:53:33 takayama Exp $ */ |
#include <stdio.h> |
#include <stdio.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
Line 1537 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1537 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
newRingp->schreyer = 0; |
newRingp->schreyer = 0; |
newRingp->gbListTower = NULL; |
newRingp->gbListTower = NULL; |
newRingp->outputOrder = outputVars; |
newRingp->outputOrder = outputVars; |
|
newRingp->weightedHomogenization = 0; |
|
newRingp->degreeShiftSize = 0; |
|
newRingp->degreeShiftN = 0; |
|
newRingp->degreeShift = 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 1583 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
Line 1587 int KsetUpRing(ob1,ob2,ob3,ob4,ob5) |
|
errorKan1("%s\n","A name should be given. (ringName)"); |
errorKan1("%s\n","A name should be given. (ringName)"); |
} |
} |
ringName = KopString(getoa(ob5,i+1)); |
ringName = KopString(getoa(ob5,i+1)); |
|
} else if (strcmp(KopString(getoa(ob5,i)),"weightedHomogenization") == 0) { |
|
if (getoa(ob5,i+1).tag != Sinteger) { |
|
errorKan1("%s\n","A integer should be given. (weightedHomogenization)"); |
|
} |
|
newRingp->weightedHomogenization = KopInteger(getoa(ob5,i+1)); |
|
} else if (strcmp(KopString(getoa(ob5,i)),"degreeShift") == 0) { |
|
if (getoa(ob5,i+1).tag != Sarray) { |
|
errorKan1("%s\n","An array of array should be given. (degreeShift)"); |
|
} |
|
{ |
|
struct object ods; |
|
struct object ods2; |
|
int dssize,k,j,nn; |
|
ods=getoa(ob5,i+1); |
|
if ((getoaSize(ods) < 1) || (getoa(ods,0).tag != Sarray)) { |
|
errorKan1("%s\n", "An array of array should be given. (degreeShift)"); |
|
} |
|
nn = getoaSize(ods); |
|
dssize = getoaSize(getoa(ods,0)); |
|
newRingp->degreeShiftSize = dssize; |
|
newRingp->degreeShiftN = nn; |
|
newRingp->degreeShift = (int *) sGC_malloc(sizeof(int)*(dssize*nn+1)); |
|
if (newRingp->degreeShift == NULL) errorKan1("%s\n","No more memory."); |
|
for (j=0; j<nn; j++) { |
|
ods2 = getoa(ods,j); |
|
for (k=0; k<dssize; k++) { |
|
if (getoa(ods2,k).tag == SuniversalNumber) { |
|
(newRingp->degreeShift)[j*dssize+k] = coeffToInt(getoa(ods2,k).lc.universalNumber); |
|
}else{ |
|
(newRingp->degreeShift)[j*dssize+k] = KopInteger(getoa(ods2,k)); |
|
} |
|
} |
|
} |
|
} |
|
switch_function("grade","module1v"); |
|
/* Warning: grading is changed to module1v!! */ |
} else { |
} else { |
errorKan1("%s\n","Unknown keyword to set_up_ring@"); |
errorKan1("%s\n","Unknown keyword to set_up_ring@"); |
} |
} |
Line 2022 int KtoArgvbyCurryBrace(str,argv,limit) |
|
Line 2062 int KtoArgvbyCurryBrace(str,argv,limit) |
|
return(argc); |
return(argc); |
} |
} |
|
|
|
struct object KstringToArgv(struct object ob) { |
|
struct object rob; |
|
char *s; |
|
int n,wc,i,inblank; |
|
char **argv; |
|
if (ob.tag != Sdollar) |
|
errorKan1("%s\n","KstringToArgv(): the argument must be a string."); |
|
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] > ' ')) { |
|
wc++; inblank = 0; |
|
}else if ((!inblank) && (s[i] <= ' ')) { |
|
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] > ' ')) { |
|
argv[wc] = &(s[i]); argv[wc+1]=NULL; |
|
wc++; inblank = 0; |
|
}else if ((inblank == 0) && (s[i] <= ' ')) { |
|
inblank = 1; s[i] = 0; |
|
}else if (inblank && (s[i] <= ' ')) { |
|
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) |
static void checkDuplicateName(xvars,dvars,n) |
char *xvars[]; |
char *xvars[]; |
char *dvars[]; |
char *dvars[]; |
Line 2675 errorKan1(str,message) |
|
Line 2755 errorKan1(str,message) |
|
extern int GotoP; |
extern int GotoP; |
extern int ErrorMessageMode; |
extern int ErrorMessageMode; |
char tmpc[1024]; |
char tmpc[1024]; |
|
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): "); |
if (strlen(message) < 900) { |
if (strlen(message) < 900) { |