version 1.6, 2003/08/23 02:28:39 |
version 1.13, 2004/09/12 02:37:57 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.5 2002/11/04 10:53:56 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.12 2004/09/11 01:00:42 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 420 int executePrimitive(ob) |
|
Line 424 int executePrimitive(ob) |
|
int size; |
int size; |
int i,j,k,n; |
int i,j,k,n; |
int status; |
int status; |
|
int infixOn; |
|
struct tokens infixToken; |
struct tokens *tokenArray; |
struct tokens *tokenArray; |
struct tokens token; |
struct tokens token; |
FILE *fp; |
FILE *fp; |
Line 438 int executePrimitive(ob) |
|
Line 444 int executePrimitive(ob) |
|
extern TimerOn; |
extern TimerOn; |
extern SecureMode; |
extern SecureMode; |
|
|
|
infixOn = 0; |
|
|
if (DebugStack >= 2) { |
if (DebugStack >= 2) { |
fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack(); |
fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack(); |
} |
} |
Line 592 int executePrimitive(ob) |
|
Line 600 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 761 int executePrimitive(ob) |
|
Line 755 int executePrimitive(ob) |
|
i=0; |
i=0; |
} |
} |
status = executeToken(token); |
status = executeToken(token); |
if (status || GotoP) break; |
if ((status & STATUS_BREAK) || GotoP) break; |
/* here, do not return 1. Do not propagate exit signal outside of the |
/* here, do not return 1. Do not propagate exit signal outside of the |
loop. */ |
loop. */ |
|
|
|
if (status & STATUS_INFIX) { |
|
infixOn = 1; infixToken = token; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if ((status & STATUS_BREAK) || GotoP) break; |
|
} |
|
|
} |
} |
break; |
break; |
|
|
Line 803 int executePrimitive(ob) |
|
Line 806 int executePrimitive(ob) |
|
size = ob1.rc.ival; |
size = ob1.rc.ival; |
for (j=0; j<size; j++) { |
for (j=0; j<size; j++) { |
status = executeToken(tokenArray[j]); |
status = executeToken(tokenArray[j]); |
if (status || GotoP) goto xyz; |
if ((status & STATUS_BREAK) || GotoP) goto xyz; |
} |
|
} |
if (status & STATUS_INFIX) { |
|
if (j == size-1) errorStackmachine("infix operator at the end.\n"); |
|
infixOn = 1; infixToken = tokenArray[j]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if ((status & STATUS_BREAK) || GotoP) goto xyz; |
|
} |
|
|
|
} |
|
} |
}else{ |
}else{ |
/* |
/* |
if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n"); |
if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n"); |
Line 816 int executePrimitive(ob) |
|
Line 829 int executePrimitive(ob) |
|
size = ob1.rc.ival; |
size = ob1.rc.ival; |
for (j=0; j<size; j++) { |
for (j=0; j<size; j++) { |
status = executeToken(tokenArray[j]); |
status = executeToken(tokenArray[j]); |
if (status || GotoP) goto xyz; |
if ((status & STATUS_BREAK) || GotoP) goto xyz; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (j == size-1) errorStackmachine("infix operator at the end.\n"); |
|
infixOn = 1; infixToken = tokenArray[j]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if ((status & STATUS_BREAK) || GotoP) goto xyz; |
|
} |
|
|
} |
} |
} |
} |
} |
} |
Line 852 int executePrimitive(ob) |
|
Line 875 int executePrimitive(ob) |
|
size = ob2.rc.ival; |
size = ob2.rc.ival; |
for (j=0; j<size; j++) { |
for (j=0; j<size; j++) { |
status = executeToken(tokenArray[j]); |
status = executeToken(tokenArray[j]); |
if (status) goto foor; |
if (status & STATUS_BREAK) goto foor; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (j == size-1) errorStackmachine("infix operator at the end(map).\n"); |
|
infixOn = 1; infixToken = tokenArray[j]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if ((status & STATUS_BREAK) || GotoP) goto foor; |
|
} |
|
|
} |
} |
} |
} |
foor: ; |
foor: ; |
Line 907 int executePrimitive(ob) |
|
Line 940 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) return(status); |
if (status & STATUS_BREAK) return(status); |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(if).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) return(status); |
|
} |
|
|
} |
} |
|
|
break; |
break; |
Line 925 int executePrimitive(ob) |
|
Line 968 int executePrimitive(ob) |
|
token = tokenArray[i]; |
token = tokenArray[i]; |
/***printf("[token %d]%s\n",i,token.token);*/ |
/***printf("[token %d]%s\n",i,token.token);*/ |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) break; |
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(exec).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
break; |
break; |
|
|
Line 1283 int executePrimitive(ob) |
|
Line 1336 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 1510 int executePrimitive(ob) |
|
Line 1564 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) break; |
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(sendmsg).\n"); |
|
infixOn = 1; infixToken = token; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
if (ccflag) { |
if (ccflag) { |
contextControl(CCPOP); ccflag = 0; /* recover the Current context. */ |
contextControl(CCPOP); ccflag = 0; /* recover the Current context. */ |
Line 1556 int executePrimitive(ob) |
|
Line 1620 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 (status & STATUS_INFIX) { |
|
if (status & DO_QUOTE) errorStackmachine("infix op with DO_QUOTE\n"); |
|
if (i == size-1) errorStackmachine("infix operator at the end(sendmsg2).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
|
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 & STATUS_BREAK) break; |
|
|
} |
} |
if (ccflag) { |
if (ccflag) { |
contextControl(CCPOP); ccflag = 0; |
contextControl(CCPOP); ccflag = 0; |
Line 1582 int executePrimitive(ob) |
|
Line 1688 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) break; |
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(primmsg).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
|
|
contextControl(CCPOP); /* recover the Current context. */ |
contextControl(CCPOP); /* recover the Current context. */ |
Line 1634 int executePrimitive(ob) |
|
Line 1750 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
if (status != 0) break; |
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(supmsg).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
if (ccflag) { |
if (ccflag) { |
contextControl(CCPOP); ccflag = 0; /* recover the Current context. */ |
contextControl(CCPOP); ccflag = 0; /* recover the Current context. */ |
Line 1684 int executePrimitive(ob) |
|
Line 1810 int executePrimitive(ob) |
|
*/ |
*/ |
break; |
break; |
|
|
|
case Soxshell: |
|
ob1 = Kpop(); |
|
Kpush(KoxShell(ob1)); |
|
break; |
|
|
case Stlimit: |
case Stlimit: |
/* { } time tlimit */ |
/* { } time tlimit */ |
ob2 = Kpop(); |
ob2 = Kpop(); |
Line 1707 int executePrimitive(ob) |
|
Line 1838 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
|
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(tlimit).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
cancelAlarm(); |
cancelAlarm(); |
}else{ |
}else{ |
Line 1715 int executePrimitive(ob) |
|
Line 1857 int executePrimitive(ob) |
|
for (i=0; i<size; i++) { |
for (i=0; i<size; i++) { |
token = tokenArray[i]; |
token = tokenArray[i]; |
status = executeToken(token); |
status = executeToken(token); |
|
if (status & STATUS_BREAK) break; |
|
|
|
if (status & STATUS_INFIX) { |
|
if (i == size-1) errorStackmachine("infix operator at the end(tlimit).\n"); |
|
infixOn = 1; infixToken = tokenArray[i]; |
|
infixToken.tflag |= NO_DELAY; continue; |
|
}else if (infixOn) { |
|
infixOn = 0; status = executeToken(infixToken); |
|
if (status & STATUS_BREAK) break; |
|
} |
|
|
} |
} |
times(&after); |
times(&after); |
after_real = time(&after_real); |
after_real = time(&after_real); |