version 1.4, 2001/05/04 01:06:25 |
version 1.10, 2003/12/05 13:51:31 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.3 2000/02/24 12:33:47 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.9 2003/12/03 01:21:43 takayama Exp $ */ |
/* primitive.c */ |
/* primitive.c */ |
/* The functions in this module were in stackmachine.c */ |
/* The functions in this module were in stackmachine.c */ |
|
|
#include <stdio.h> |
#include <stdio.h> |
|
#include <signal.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
#include "extern.h" |
#include "extern.h" |
|
|
|
|
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 23 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 120 static char *operatorType(type) |
|
Line 123 static char *operatorType(type) |
|
#define Ssupmsg2 98 |
#define Ssupmsg2 98 |
#define Scclass 99 |
#define Scclass 99 |
#define Scoeff2 100 |
#define Scoeff2 100 |
|
#define Stlimit 101 |
|
#define Soxshell 102 |
/***********************************************/ |
/***********************************************/ |
void printObject(ob,nl,fp) |
void printObject(ob,nl,fp) |
struct object ob; |
struct object ob; |
Line 372 void KdefinePrimitiveFunctions() { |
|
Line 377 void KdefinePrimitiveFunctions() { |
|
putPrimitiveFunction("system",Ssystem); |
putPrimitiveFunction("system",Ssystem); |
putPrimitiveFunction("system_variable",Ssystem_variable); |
putPrimitiveFunction("system_variable",Ssystem_variable); |
putPrimitiveFunction("test",Stest); |
putPrimitiveFunction("test",Stest); |
|
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 1280 int executePrimitive(ob) |
|
Line 1287 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 1357 int executePrimitive(ob) |
|
Line 1365 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 1544 int executePrimitive(ob) |
|
Line 1561 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 */ |
|
putoa(qattr2,0,KpoString("class")); |
|
if (ob2.tag == Sdollar) { |
|
putoa(qattr2,1,ob2); |
|
}else{ |
|
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 1671 int executePrimitive(ob) |
|
Line 1717 int executePrimitive(ob) |
|
} |
} |
*/ |
*/ |
break; |
break; |
|
|
|
case Soxshell: |
|
ob1 = Kpop(); |
|
Kpush(KoxShell(ob1)); |
|
break; |
|
|
|
case Stlimit: |
|
/* { } time tlimit */ |
|
ob2 = Kpop(); |
|
ob1 = Kpop(); |
|
switch(ob2.tag) { |
|
case Sinteger: break; |
|
default: errorStackmachine("Usage:tlimit"); break; |
|
} |
|
switch(ob1.tag) { |
|
case SexecutableArray: break; |
|
default: |
|
errorStackmachine("Usage:tlimit"); |
|
break; |
|
} |
|
tokenArray = ob1.lc.tokenArray; |
|
size = ob1.rc.ival; |
|
n = ob2.lc.ival; |
|
i = 0; |
|
if (n > 0) { |
|
signal(SIGALRM,ctrlC); alarm((unsigned int) n); |
|
for (i=0; i<size; i++) { |
|
token = tokenArray[i]; |
|
status = executeToken(token); |
|
} |
|
cancelAlarm(); |
|
}else{ |
|
before_real = time(&before_real); |
|
times(&before); |
|
for (i=0; i<size; i++) { |
|
token = tokenArray[i]; |
|
status = executeToken(token); |
|
} |
|
times(&after); |
|
after_real = time(&after_real); |
|
ob1 = newObjectArray(3); |
|
putoa(ob1,0,KpoInteger((int) after.tms_utime - before.tms_utime)); |
|
putoa(ob1,1,KpoInteger((int) after.tms_stime - before.tms_stime)); |
|
putoa(ob1,2,KpoInteger((int) (after_real-before_real))); |
|
Kpush(ob1); |
|
} |
|
break; |
|
|
|
|
default: |
default: |