version 1.5, 2002/11/04 10:53:56 |
version 1.12, 2004/09/11 01:00:42 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.4 2001/05/04 01:06:25 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.11 2003/12/05 23:14:14 takayama Exp $ */ |
/* primitive.c */ |
/* primitive.c */ |
/* The functions in this module were in stackmachine.c */ |
/* The functions in this module were in stackmachine.c */ |
|
|
|
|
|
|
int PrintDollar = 1; /* flag for printObject() */ |
int PrintDollar = 1; /* flag for printObject() */ |
int PrintComma = 1; /* flag for printObject() */ |
int PrintComma = 1; /* flag for printObject() */ |
|
int InSendmsg2 = 0; |
#define OB_ARRAY_MAX (AGLIMIT+100) |
#define OB_ARRAY_MAX (AGLIMIT+100) |
|
|
extern int GotoP; |
extern int GotoP; |
Line 24 extern int ClassTypes[]; /* kclass.c */ |
|
Line 25 extern int ClassTypes[]; /* kclass.c */ |
|
extern struct context *PrimitiveContextp; |
extern struct context *PrimitiveContextp; |
extern struct context *CurrentContextp; |
extern struct context *CurrentContextp; |
extern struct dictionary *SystemDictionary; |
extern struct dictionary *SystemDictionary; |
|
extern int QuoteMode; |
|
|
static char *operatorType(int i); |
static char *operatorType(int i); |
|
|
Line 122 static char *operatorType(type) |
|
Line 124 static char *operatorType(type) |
|
#define Scclass 99 |
#define Scclass 99 |
#define Scoeff2 100 |
#define Scoeff2 100 |
#define Stlimit 101 |
#define Stlimit 101 |
|
#define Soxshell 102 |
/***********************************************/ |
/***********************************************/ |
void printObject(ob,nl,fp) |
void printObject(ob,nl,fp) |
struct object ob; |
struct object ob; |
Line 375 void KdefinePrimitiveFunctions() { |
|
Line 378 void KdefinePrimitiveFunctions() { |
|
putPrimitiveFunction("system_variable",Ssystem_variable); |
putPrimitiveFunction("system_variable",Ssystem_variable); |
putPrimitiveFunction("test",Stest); |
putPrimitiveFunction("test",Stest); |
putPrimitiveFunction("tlimit",Stlimit); |
putPrimitiveFunction("tlimit",Stlimit); |
|
putPrimitiveFunction("oxshell",Soxshell); |
putPrimitiveFunction("map",Smap); |
putPrimitiveFunction("map",Smap); |
putPrimitiveFunction("to_records",Sto_records); |
putPrimitiveFunction("to_records",Sto_records); |
putPrimitiveFunction("Usage",Susage); |
putPrimitiveFunction("Usage",Susage); |
Line 592 int executePrimitive(ob) |
|
Line 596 int executePrimitive(ob) |
|
/* ob2 ob1 get */ |
/* ob2 ob1 get */ |
ob1 = Kpop(); |
ob1 = Kpop(); |
ob2 = Kpop(); |
ob2 = Kpop(); |
switch(ob2.tag) { |
Kpush(Kget(ob2,ob1)); |
case Sarray: break; |
|
default: errorStackmachine("Usage:get"); |
|
} |
|
switch(ob1.tag) { |
|
case Sinteger: break; |
|
default: errorStackmachine("Usage:get"); |
|
} |
|
i =ob1.lc.ival; |
|
size = getoaSize(ob2); |
|
if ((0 <= i) && (i<size)) { |
|
Kpush(getoa(ob2,i)); |
|
}else{ |
|
errorStackmachine("Index is out of bound. (get)\n"); |
|
} |
|
break; |
break; |
|
|
case Sput: |
case Sput: |
Line 1283 int executePrimitive(ob) |
|
Line 1273 int executePrimitive(ob) |
|
KsetOrderByObjArray(ob1); |
KsetOrderByObjArray(ob1); |
break; |
break; |
case Sset_up_ring: |
case Sset_up_ring: |
|
KresetDegreeShift(); |
ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop(); |
ob5 = Kpop(); ob4=Kpop(); ob3=Kpop(); ob2=Kpop(); ob1=Kpop(); |
KsetUpRing(ob1,ob2,ob3,ob4,ob5); |
KsetUpRing(ob1,ob2,ob3,ob4,ob5); |
break; |
break; |
Line 1360 int executePrimitive(ob) |
|
Line 1351 int executePrimitive(ob) |
|
if (ob2.tag != Sarray) { |
if (ob2.tag != Sarray) { |
Kpush(Khead(ob2)); |
Kpush(Khead(ob2)); |
}else{ |
}else{ |
ob1 = Kpop(); |
if (getoaSize(ob2) > 0) { |
Kpush(oInitW(ob1,ob2)); |
if (getoa(ob2,getoaSize(ob2)-1).tag == Spoly) { |
|
Kpush(oInitW(ob2,newObjectArray(0))); |
|
}else{ |
|
ob1 = Kpop(); |
|
Kpush(oInitW(ob1,ob2)); |
|
} |
|
}else{ |
|
ob1 = Kpop(); |
|
Kpush(oInitW(ob1,ob2)); |
|
} |
} |
} |
break; |
break; |
|
|
Line 1547 int executePrimitive(ob) |
|
Line 1547 int executePrimitive(ob) |
|
size = ob1.rc.ival; |
size = ob1.rc.ival; |
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
|
InSendmsg2 = 1; |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) break; |
InSendmsg2 = 0; |
|
if (QuoteMode && (status==DO_QUOTE)) { |
|
/* generate tree object, for kan/k0 */ |
|
struct object qob; |
|
struct object qattr; |
|
struct object qattr2; |
|
if (i==0) { Kpop(); Kpop();} |
|
qob = newObjectArray(3); |
|
qattr = newObjectArray(1); |
|
qattr2 = newObjectArray(2); |
|
/* Set the node name of the tree. */ |
|
if (token.kind == ID) { |
|
putoa(qob,0,KpoString(token.token)); |
|
}else{ |
|
putoa(qob,0,KpoString("unknown")); |
|
} |
|
/* Set the attibute list; class=className */ |
|
if (ob2.tag == Sdollar) { |
|
putoa(qattr2,0,KpoString("cd")); |
|
putoa(qattr2,1,ob2); |
|
}else{ |
|
putoa(qattr2,0,KpoString("class")); |
|
putoa(qattr2,1,KpoString(CurrentContextp->contextName)); |
|
} |
|
putoa(qattr,0,qattr2); |
|
putoa(qob,1,qattr); |
|
putoa(qob,2,ob4); /* Argument */ |
|
qob = KpoTree(qob); |
|
Kpush(qob); |
|
} else if (status != 0) break; |
} |
} |
if (ccflag) { |
if (ccflag) { |
contextControl(CCPOP); ccflag = 0; |
contextControl(CCPOP); ccflag = 0; |
Line 1673 int executePrimitive(ob) |
|
Line 1703 int executePrimitive(ob) |
|
|
|
} |
} |
*/ |
*/ |
|
break; |
|
|
|
case Soxshell: |
|
ob1 = Kpop(); |
|
Kpush(KoxShell(ob1)); |
break; |
break; |
|
|
case Stlimit: |
case Stlimit: |