File: [local] / OpenXM / src / k097 / Replace / test.c (download)
Revision 1.1.1.1 (vendor branch), Fri Oct 8 02:12:15 1999 UTC (24 years, 7 months ago) by maekawa
Branch: OpenXM, MAIN
CVS Tags: maekawa-ipv6, R_1_3_1-2, RELEASE_20000124, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, RELEASE_1_1_3, RELEASE_1_1_2, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9, ALPHA
Changes since 1.1: +0 -0
lines
o import OpenXM sources
|
/* stackmachin.c */
#include <stdio.h>
#include "datatype.h"
#include "stackm.h"
#include "extern.h"
#include <signal.h>
#include <sys/types.h>
#include <sys/times.h>
#define OPERAND_STACK_SIZE 2000
#define SYSTEM_DICTIONARY_SIZE 200
#define USER_DICTIONARY_SIZE 1223
/* The value of USER_DICTIONARY_SIZE must be prime number, because of hashing
method */
#define OB_ARRAY_MAX (AGLIMIT+100)
#define ARGV_WORK_MAX (AGLIMIT+100)
#define EMPTY (char *)NULL
/* global variables */
struct object OperandStack[OPERAND_STACK_SIZE];
int Osp = 0; /* OperandStack pointer */
struct dictionary SystemDictionary[SYSTEM_DICTIONARY_SIZE];
int Sdp = 0; /* SystemDictionary pointer */
struct dictionary UserDictionary[USER_DICTIONARY_SIZE];
int Udp = 0; /* UserDictionary pointer */
int PrintDollar = 1; /* flag for printObject() */
int PrintComma = 1; /* flag for printObject() */
static struct object ObjTmp; /* for poor compiler */
int StandardMacros = 1;
int StartAFile = 0;
char *StartFile;
static char *SMacros =
#include "smacro.h"
static isInteger(char *);
static strToInteger(char *);
static power(int s,int i);
static struct object pop(void);
static push(struct object);
static char *operatorType(int i);
static void pstack(void);
static struct object executableStringToExecutableArray(char *str);
/****** primitive functions *****************************************
the values must be greater than 1. 0 is used for special purposes.*/
#define Sadd 1
#define Ssub 2
#define Smult 3
#define Sset_up_ring 4
#define Soptions 6
#define Sgroebner 7
#define Sdef 8
#define Spop 9
#define Sput 10
#define Sprint 11
#define Spstack 12
#define Sshow_ring 13
#define Sprint_options 14
#define Sshow_systemdictionary 15
#define Slength 16
#define Sfor 17
#define Sroll 18
#define Squit 19
#define Stest 20 /* this is used for test of new function*/
#define Ssyzygies 21
#define Sresolution 22
#define Sfileopen 23
#define Sclosefile 24
#define Sidiv 25
#define Sdup 26
#define Smap 27
#define Sreduction 28
#define Sreplace 29
#define SleftBrace 30 /* primitive [ */
#define SrightBrace 31 /* primitive ] */
#define Srun 32 /* run from a file */
#define Sloop 33
#define Saload 34
#define Sifelse 35
#define Sequal 36
#define Sexec 37
#define Sset 38
#define Sget 41
#define Scopy 43
#define Sindex 44
#define Ssystem 45
#define Shilbert 47
#define Sset_order_by_matrix 50
#define Sshow_user_dictionary 54
#define Selimination_order 55
#define Sswitch_function 58
#define Sprint_switch_status 59
#define Scat_n 62
#define Sless 63
#define Sgreater 64
#define Swritestring 66
#define Sset_timer 67
#define Sspol 68
#define Susage 69
#define Sto_records 70
#define Scoefficients 71
#define Ssystem_variable 72
#define Sdata_conversion 73
#define Sdegree 74
#define Sinit 75
#define Sload 76
#define Seval 77
#define Shomogenize 78
#define Sprincipal 79
#define Spushfile 80
/***********************************************/
struct object * newObject()
{
struct object *r;
r = (struct object *)GC_malloc(sizeof(struct object));
if (r == (struct object *)NULL) errorStackmachine("No memory\n");
r->tag = 0;
(r->lc).ival = 0;
(r->rc).ival = 0;
return(r);
}
struct object newObjectArray(size)
int size;
{
struct object rob;
struct object *op;
if (size < 0) return(NullObject);
if (size > 0) {
op = (struct object *)GC_malloc(size*sizeof(struct object));
if (op == (struct object *)NULL) errorStackmachine("No memory\n");
}else{
op = (struct object *)NULL;
}
rob.tag = Sarray;
rob.lc.ival = size;
rob.rc.op = op;
return(rob);
}
isNullObject(obj)
struct object obj;
{
if (obj.tag == 0) return(1);
else return(0);
}
int putSystemDictionary(str,ob)
char *str; /* key */
struct object ob; /* value */
{
int i;
int j;
int flag = 0;
for (i = Sdp-1; i>=0; i--) {
/*printf("Add %d %s\n",i,str);*/
if (strcmp(str,(SystemDictionary[i]).key) > 0) {
for (j=Sdp-1; j>=i+1; j--) {
(SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
(SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
}
(SystemDictionary[i+1]).key = str;
(SystemDictionary[i+1]).obj = ob;
flag = 1;
break;
}
}
if (!flag) { /* str is the minimum element */
for (j=Sdp-1; j>=0; j--) {
(SystemDictionary[j+1]).key = (SystemDictionary[j]).key;
(SystemDictionary[j+1]).obj = (SystemDictionary[j]).obj;
}
(SystemDictionary[0]).key = str;
(SystemDictionary[0]).obj = ob;
}
Sdp++;
if (Sdp >= SYSTEM_DICTIONARY_SIZE) {
warningStackmachine("No space for system dictionary area.\n");
Sdp--;
return(-1);
}
return(Sdp-1);
}
int findSystemDictionary(str)
/* only used for primitive functions */
/* returns 0, if there is no item. */
/* This function assumes that the dictionary is sorted by strcmp() */
char *str; /* key */
{
int first,last,rr,middle;
/* binary search */
first = 0; last = Sdp-1;
while (1) {
if (first > last) {
return(0);
} else if (first == last) {
if (strcmp(str,(SystemDictionary[first]).key) == 0) {
return((SystemDictionary[first]).obj.lc.ival);
}else {
return(0);
}
} else if (last - first == 1) { /* This case is necessary */
if (strcmp(str,(SystemDictionary[first]).key) == 0) {
return((SystemDictionary[first]).obj.lc.ival);
}else if (strcmp(str,(SystemDictionary[last]).key) == 0) {
return((SystemDictionary[last]).obj.lc.ival);
}else return(0);
}
middle = (first + last)/2;
rr = strcmp(str,(SystemDictionary[middle]).key);
if (rr < 0) { /* str < middle */
last = middle;
}else if (rr == 0) {
return((SystemDictionary[middle]).obj.lc.ival);
}else { /* str > middle */
first = middle;
}
}
}
int putUserDictionary(str,h0,h1,ob)
char *str; /* key */
int h0,h1; /* Hash values of the key */
struct object ob; /* value */
{
int x;
x = h0;
if (str[0] == '\0') {
errorKan1("%s\n","putUserDictionary(): You are defining a value with the null key.");
}
while (1) {
if ((UserDictionary[x]).key == EMPTY) break;
if (strcmp((UserDictionary[x]).key,str) == 0) break;
x = (x+h1) % USER_DICTIONARY_SIZE;
if (x == h0) {
errorStackmachine("User dictionary is full. loop hashing.\n");
}
}
(UserDictionary[x]).key = str;
(UserDictionary[x]).obj = ob;
(UserDictionary[x]).h0 = h0;
(UserDictionary[x]).h1 = h1;
return(x);
}
struct object findUserDictionary(str,h0,h1)
/* returns NoObject, if there is no item. */
char *str; /* key */
int h0,h1; /* The hashing values of the key. */
{
int x;
x = h0;
while (1) {
if ((UserDictionary[x]).key == EMPTY) return(NoObject);
/* if ((UserDictionary[x]).h1 != h1) return(NoObject); */
if (strcmp((UserDictionary[x]).key,str) == 0) {
return( (UserDictionary[x]).obj );
}
x = (x+h1) % USER_DICTIONARY_SIZE;
if (x == h0) {
errorStackmachine("User dictionary is full. loop hashing in findUserDictionary.\n");
}
}
}
int putPrimitiveFunction(str,number)
char *str;
int number;
{
struct object ob;
ob.tag = Soperator;
ob.lc.ival = number;
return(putSystemDictionary(str,ob));
}
struct tokens lookupTokens(t)
struct tokens t;
{
struct object *left;
struct object *right;
t.object.tag = Slist;
left = t.object.lc.op = newObject();
right = t.object.rc.op = newObject();
left->tag = Sinteger;
(left->lc).ival = hash0(t.token);
(left->rc).ival = hash1(t.token);
right->tag = Sinteger;
(right->lc).ival = findSystemDictionary(t.token);
return(t);
}
struct object lookupLiteralString(s)
char *s; /* s must be a literal string */
{
struct object ob;
ob.tag = Slist;
ob.lc.op = newObject();
ob.rc.op = (struct object *)NULL;
ob.lc.op->tag = Sinteger;
(ob.lc.op->lc).ival = hash0(&(s[1]));
(ob.lc.op->rc).ival = hash1(&(s[1]));
return(ob);
}
int hash0(str)
char *str;
{
int h=0;
while (*str != '\0') {
h = ((h*128)+(*str)) % USER_DICTIONARY_SIZE;
str++;
}
return(h);
}
int hash1(str)
char *str;
{
return(8-(str[0]%8));
}
void hashInitialize(void)
{
int i;
for (i=0; i<USER_DICTIONARY_SIZE; i++) {
(UserDictionary[i]).key = EMPTY;
}
}
static isInteger(str)
char *str;
{
int i;
int n;
int start;
n = strlen(str);
if ((str[0] == '+') || (str[0] == '-'))
start = 1;
else
start = 0;
if (start >= n) return(0);
for (i=start; i<n; i++) {
if (('0' <= str[i]) && (str[i] <= '9')) ;
else return(0);
}
return(1);
}
static strToInteger(str)
char *str;
{
int i;
int n;
int r;
int start;
if ((str[0] == '+') || (str[0] == '-'))
start = 1;
else
start = 0;
n = strlen(str);
r = 0;
for (i=n-1; i>=start ; i--) {
r += (int)(str[i]-'0') *power(10,n-1-i);
}
if (str[0] == '-') r = -r;
return(r);
}
static power(s,i)
int s;
int i;
{
if (i == 0) return 1;
else return( s*power(s,i-1) );
}
static push(ob)
struct object ob;
{
OperandStack[Osp++] = ob;
if (Osp >= OPERAND_STACK_SIZE) {
warningStackmachine("Operand stack overflow. \n");
Osp--;
return(-1);
}
return(0);
}
static struct object pop()
{
if (Osp <= 0) {
return( NullObject );
}else{
return( OperandStack[--Osp]);
}
}
struct object peek(k)
int k;
{
if ((Osp-k-1) < 0) {
return( NullObject );
}else{
return( OperandStack[Osp-k-1]);
}
}
int isLiteral(str)
char *str;
{
if (strlen(str) <2) return(0);
else {
if ((str[0] == '/') && (str[1] != '/')) return(1);
else return(0);
}
}
void printOperandStack() {
int i;
struct object ob;
int vs;
vs = VerboseStack; VerboseStack = 2;
for (i=Osp-1; i>=0; i--) {
fprintf(Fstack,"[%d] ",i);
ob = OperandStack[i];
printObject(ob,1,Fstack);
}
VerboseStack = vs;
}
void printObject(ob,nl,fp)
struct object ob;
int nl;
FILE *fp;
/* print the object on the top of the stack. */
{
int size;
int i;
struct tokens *ta;
if (VerboseStack >= 2) {
/*fprintf(fp,"@@@");*/
switch (ob.tag) {
case 0:
fprintf(fp,"<null> "); /* null object */
break;
case Sinteger:
fprintf(fp,"<integer> ");
break;
case Sstring:
fprintf(fp,"<literal-string> ");
break;
case Soperator:
fprintf(fp,"<operator> ");
break;
case Sdollar:
fprintf(fp,"<string(dollar)> ");
break;
case SexecutableArray:
fprintf(fp,"<executable array> ");
break;
case Sarray:
fprintf(fp,"<array> ");
break;
case SleftBraceTag:
fprintf(fp,"<leftBraceTag> ");
break;
case SrightBraceTag:
fprintf(fp,"<rightBraceTag> ");
break;
case Spoly:
fprintf(fp,"<poly> ");
break;
case SarrayOfPOLY:
fprintf(fp,"<arrayOfPOLY> ");
break;
case SmatrixOfPOLY:
fprintf(fp,"<matrixOfPOLY> ");
break;
case Slist:
fprintf(fp,"<list> ");
break;
case Sfile:
fprintf(fp,"<file> ");
break;
case Sring:
fprintf(fp,"<ring> ");
break;
default:
fprintf(fp,"<Unknown object tag. %d >",ob.tag);
break;
}
}
switch (ob.tag) {
case 0:
fprintf(fp,"%%[null]"); /* null object */
break;
case Sinteger:
fprintf(fp,"%d",ob.lc.ival);
break;
case Sstring:
fprintf(fp,"%s",ob.lc.str);
break;
case Soperator:
fprintf(fp,"%s %%[operator] ",operatorType(ob.lc.ival));
break;
case Sdollar:
if (PrintDollar == 2) {
fprintf(fp,"(%s)",ob.lc.str);
} else if (PrintDollar == 0 ) {
fprintf(fp,ob.lc.str);
} else {
fprintf(fp,"$%s$",ob.lc.str);
}
break;
case SexecutableArray:
size = ob.rc.ival;
ta = ob.lc.tokenArray;
fprintf(fp,"{ ");
for (i=0; i<size; i++) {
switch ((ta[i]).kind) {
case ID:
fprintf(fp,"<<ID>>%s ",(ta[i]).token);
break;
case EXECUTABLE_STRING:
fprintf(fp,"<<EXECUTABLE_STRING>>{%s} ",(ta[i]).token);
break;
case EXECUTABLE_ARRAY:
printObject((ta[i]).object,nl,fp);
break;
default:
fprintf(fp,"Unknown token type\n");
break;
}
}
fprintf(fp," }");
break;
case Sarray:
printObjectArray(ob,0,fp);
break;
case SleftBraceTag:
fprintf(fp,"[ ");
break;
case SrightBraceTag:
fprintf(fp,"] ");
break;
case Spoly:
fprintf(fp,"%s",KPOLYToString(ob.lc.poly));
break;
case SarrayOfPOLY:
fprintf(fp,"Sorry! The object arrayOfPOLY cannot be printed.");
break;
case SmatrixOfPOLY:
fprintf(fp,"Sorry! The object matrixOfPOLY cannot be printed.");
break;
case Slist:
printObjectList(&ob);
break;
case Sfile:
fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file);
break;
case Sring:
fprintf(fp,"Ring."); KshowRing(KopRingp(ob));
break;
default:
fprintf(fp,"[Unknown object tag.]");
break;
}
if (nl) fprintf(fp,"\n");
}
void printObjectArray(ob,nl,fp)
struct object ob;
int nl;
FILE *fp;
{
int size;
int i;
size = ob.lc.ival;
fprintf(fp,"[ ");
for (i=0; i<size; i++) {
if (PrintComma && (i != 0)) {
fprintf(fp," , ");
}else{
fprintf(fp," ");
}
printObject((ob.rc.op)[i],0,fp);
}
fprintf(fp," ] ");
if (nl) fprintf(fp,"\n");
}
static initSystemDictionary()
{
/* It is recommended to sort the follows for performance */
putPrimitiveFunction("mul",Smult);
putPrimitiveFunction("add",Sadd);
putPrimitiveFunction("sub",Ssub);
putPrimitiveFunction("lt",Sless);
putPrimitiveFunction("set",Sset);
putPrimitiveFunction("eq",Sequal);
putPrimitiveFunction("gt",Sgreater);
putPrimitiveFunction("QUIT",Squit);
putPrimitiveFunction("[",SleftBrace);
putPrimitiveFunction("]",SrightBrace);
putPrimitiveFunction("bye",Squit);
putPrimitiveFunction("length",Slength);
putPrimitiveFunction("for",Sfor);
putPrimitiveFunction("roll",Sroll);
putPrimitiveFunction("cat_n",Scat_n);
putPrimitiveFunction("coefficients",Scoefficients);
putPrimitiveFunction("copy",Scopy);
putPrimitiveFunction("data_conversion",Sdata_conversion);
putPrimitiveFunction("aload",Saload);
putPrimitiveFunction("def",Sdef);
putPrimitiveFunction("degree",Sdegree);
putPrimitiveFunction("elimination_order",Selimination_order);
putPrimitiveFunction("exec",Sexec);
putPrimitiveFunction("exit",Squit);
putPrimitiveFunction("get",Sget);
putPrimitiveFunction("groebner",Sgroebner);
putPrimitiveFunction("hilbert",Shilbert);
putPrimitiveFunction("ifelse",Sifelse);
putPrimitiveFunction("index",Sindex);
putPrimitiveFunction("dup",Sdup);
putPrimitiveFunction("init",Sinit);
putPrimitiveFunction("loop",Sloop);
putPrimitiveFunction("options",Soptions);
putPrimitiveFunction("pop",Spop);
putPrimitiveFunction("put",Sput);
putPrimitiveFunction("print",Sprint);
putPrimitiveFunction("pstack",Spstack);
putPrimitiveFunction("print_options",Sprint_options);
putPrimitiveFunction("print_switch_status",Sprint_switch_status);
putPrimitiveFunction("quit",Squit);
putPrimitiveFunction("file",Sfileopen);
putPrimitiveFunction("closefile",Sclosefile);
putPrimitiveFunction("idiv",Sidiv);
putPrimitiveFunction("reduction",Sreduction);
putPrimitiveFunction("replace",Sreplace);
putPrimitiveFunction("resolution",Sresolution);
putPrimitiveFunction("run",Srun);
putPrimitiveFunction("set_order_by_matrix",Sset_order_by_matrix);
putPrimitiveFunction("set_timer",Sset_timer);
putPrimitiveFunction("set_up_ring@",Sset_up_ring);
putPrimitiveFunction("show_ring",Sshow_ring);
putPrimitiveFunction("show_systemdictionary",Sshow_systemdictionary);
putPrimitiveFunction("show_user_dictionary",Sshow_user_dictionary);
putPrimitiveFunction("spol",Sspol);
putPrimitiveFunction("switch_function",Sswitch_function);
putPrimitiveFunction("system",Ssystem);
putPrimitiveFunction("system_variable",Ssystem_variable);
putPrimitiveFunction("syzygies",Ssyzygies);
putPrimitiveFunction("test",Stest);
putPrimitiveFunction("map",Smap);
putPrimitiveFunction("to_records",Sto_records);
putPrimitiveFunction("Usage",Susage);
putPrimitiveFunction("load",Sload);
putPrimitiveFunction("writestring",Swritestring);
putPrimitiveFunction("eval",Seval);
putPrimitiveFunction("homogenize",Shomogenize);
putPrimitiveFunction("principal",Sprincipal);
putPrimitiveFunction("pushfile",Spushfile);
}
static showSystemDictionary() {
int i;
int maxl;
char format[1000];
int nl;
maxl = 1;
for (i=0; i<Sdp; i++) {
if (strlen((SystemDictionary[i]).key) >maxl)
maxl = strlen((SystemDictionary[i]).key);
}
maxl += 3;
nl = 80/maxl;
if (nl < 2) nl = 2;
sprintf(format,"%%-%ds",maxl);
for (i=0; i<Sdp; i++) {
fprintf(Fstack,format,(SystemDictionary[i]).key);
if (i % nl == nl-1) fprintf(Fstack,"\n");
}
fprintf(Fstack,"\n");
}
static showUserDictionary()
{
int i,j;
int maxl;
char format[1000];
int nl;
maxl = 1;
for (i=0; i<USER_DICTIONARY_SIZE; i++) {
if ((UserDictionary[i]).key != EMPTY) {
if (strlen((UserDictionary[i]).key) >maxl)
maxl = strlen((UserDictionary[i]).key);
}
}
maxl += 3;
nl = 80/maxl;
if (nl < 2) nl = 2;
sprintf(format,"%%-%ds",maxl);
for (i=0,j=0; i<USER_DICTIONARY_SIZE; i++) {
if ((UserDictionary[i]).key != EMPTY) {
fprintf(Fstack,format,(UserDictionary[i]).key);
/*{ char *sss; int ii,h0,h1;
sss = UserDictionary[i].key;
h0 = UserDictionary[i].h0;
h1 = UserDictionary[i].h1;
for (ii=0; ii<strlen(sss); ii++) fprintf(Fstack,"%x ",sss[ii]);
fprintf(Fstack,": h0=%d, h1=%d, %d\n",h0,h1,i);
}*/
if (j % nl == nl-1) fprintf(Fstack,"\n");
j++;
}
}
fprintf(Fstack,"\n");
}
static char *operatorType(type)
int type;
{ int i;
for (i=0; i<Sdp; i++) {
if (type == (SystemDictionary[i]).obj.lc.ival) {
return((SystemDictionary[i]).key);
}
}
return("Unknown operator");
}
static struct object executableStringToExecutableArray(s)
char *s;
{
struct tokens *tokenArray;
struct object ob;
int i;
int size;
tokenArray = decomposeToTokens(s,&size);
ob.tag = SexecutableArray;
ob.lc.tokenArray = tokenArray;
ob.rc.ival = size;
for (i=0; i<size; i++) {
if ( ((ob.lc.tokenArray)[i]).kind == EXECUTABLE_STRING) {
((ob.lc.tokenArray)[i]).kind = EXECUTABLE_ARRAY;
((ob.lc.tokenArray)[i]).object =
executableStringToExecutableArray(((ob.lc.tokenArray)[i]).token);
}
}
return(ob);
}
/**************** stack machine **************************/
void scanner() {
struct tokens token;
struct object ob;
extern int ctrlC();
int tmp;
char *tmp2;
getokenSM(INIT);
initSystemDictionary();
if (setjmp(EnvOfStackMachine)) {
/* do nothing in the case of error */
} else {
if (signal(SIGINT,SIG_IGN) != SIG_IGN) {
signal(SIGINT,ctrlC);
}
KSdefineMacros();
if (StartAFile) {
tmp2 = StartFile;
StartFile = (char *)GC_malloc(sizeof(char)*(strlen(StartFile)+
40));
sprintf(StartFile,"$%s$ run\n",tmp2);
token.kind = EXECUTABLE_STRING;
token.token = StartFile;
executeToken(token); /* execute startup commands */
token.kind = ID;
token.token = "exec";
token = lookupTokens(token); /* set hashing values */
tmp = findSystemDictionary(token.token);
ob.tag = Soperator;
ob.lc.ival = tmp;
executePrimitive(ob); /* exec */
}
}
for (;;) {
if (setjmp(EnvOfStackMachine)) {
if (DebugStack >= 1) {
fprintf(Fstack,"\nscanner> ");
}
} else { }
if (DebugStack >= 1) { printOperandStack(); }
token = getokenSM(GET);
if ((tmp=executeToken(token)) < 0) break;
/***if (tmp == 1) fprintf(stderr," --- exit --- \n");*/
}
}
int ctrlC(sig)
int sig;
{
extern int ctrlC();
signal(sig,SIG_IGN);
/* see 133p */
fprintf(Fstack,"User interruption by ctrl-C. We are in the top-level.\n");
fprintf(Fstack,"Type in quit in order to exit sm1.\n");
/*fprintf(Fstack,"Warning! The handler of ctrl-C has a bug, so you might have a core-dump.\n");*/
/*
$(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
ctrl-C
$(x0+1)^50$ $x1 x0 + x1^20$ 2 groebner_n
It SOMETIMES makes core dump.
*/
getokenSM(INIT); /* It might fix the bug above. 1992/11/14 */
signal(SIGINT,ctrlC);
longjmp(EnvOfStackMachine,1);
}
int executeToken(token)
struct tokens token;
{
struct object ob;
int primitive;
int size;
int status;
struct tokens *tokenArray;
int i,h0,h1;
if (token.kind == DOLLAR) {
ob.tag = Sdollar;
ob.lc.str = token.token;
push(ob);
} else if (token.kind == ID) { /* ID */
if (strcmp(token.token,"exit") == 0) return(1);
/* "exit" is not primitive here. */
if (isLiteral(token.token)) {
/* literal object */
ob.tag = Sstring;
ob.lc.str = (char *)GC_malloc((strlen(token.token)+1)*sizeof(char));
if (ob.lc.str == (char *)NULL) errorStackmachine("No space.");
strcpy(ob.lc.str, &((token.token)[1]));
if (token.object.tag != Slist) {
fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
token.object = lookupLiteralString(token.token);
}
ob.rc.op = token.object.lc.op;
push(ob);
} else if (isInteger(token.token)) {
/* integer object */
ob.tag = Sinteger ;
ob.lc.ival = strToInteger(token.token);
push(ob);
} else {
if (token.object.tag != Slist) {
fprintf(Fstack,"\n%%Warning: The hashing values for the <<%s>> are not set.\n",token.token);
token = lookupTokens(token);
}
h0 = ((token.object.lc.op)->lc).ival;
h1 = ((token.object.lc.op)->rc).ival;
ob = findUserDictionary(token.token,h0,h1);
primitive = ((token.object.rc.op)->lc).ival;
if (ob.tag >= 0) {
/* there is a definition in the user dictionary */
if (ob.tag == SexecutableArray) {
tokenArray = ob.lc.tokenArray;
size = ob.rc.ival;
for (i=0; i<size; i++) {
status = executeToken(tokenArray[i]);
if (status != 0) return(status);
}
}else {
push(ob);
}
} else if (primitive) {
/* system operator */
ob.tag = Soperator;
ob.lc.ival = primitive;
return(executePrimitive(ob));
} else {
fprintf(Fstack,"\n%%Warning: The identifier <<%s>> is not in the system dictionary\n%% nor in the user dictionary. Push NullObject.\n",token.token);
/*fprintf(Fstack,"(%d,%d)\n",h0,h1);*/
push(NullObject);
}
}
} else if (token.kind == EXECUTABLE_STRING) {
push(executableStringToExecutableArray(token.token));
} else if (token.kind == EXECUTABLE_ARRAY) {
push(token.object);
} else if ((token.kind == -1) || (token.kind == -2)) { /* eof token */
return(-1);
} else {
/*fprintf(Fstack,"\n%%Error: Unknown token type\n");***/
fprintf(stderr,"\nUnknown token type = %d\n",token.kind);
fprintf(stderr,"\ntype in ctrl-\\ if you like to make core-dump.\n");
fprintf(stderr,"If you like to continue, type in RETURN key.\n");
fprintf(stderr,"The author expects the bug report.\n");
getchar();
errorStackmachine("Error: Unknown token type.\n");
/**return(-2); /* exit */
}
return(0); /* normal exit */
}
int executePrimitive(ob)
struct object ob;
{
struct object ob1;
struct object ob2;
struct object ob3;
struct object ob4;
struct object ob5;
struct object rob;
struct object obArray[OB_ARRAY_MAX];
struct object obArray2[OB_ARRAY_MAX];
int size;
int i,j,k,n;
int status;
struct tokens *tokenArray;
struct tokens token;
FILE *fp;
char *fname;
int rank;
struct object oMat;
static int timerStart = 1;
static struct tms before, after;
struct object oInput;
char *str;
extern int KeepInput;
extern int History;
extern struct ring *CurrentRingp;
if (DebugStack >= 2) {
fprintf(Fstack,"In execute\n"); printOperandStack();
}
switch (ob.lc.ival) {
/* Postscript primitives :stack */
case Spop:
ob1 = pop();
break;
case Sdup:
ob1 = pop();
push(ob1); push(ob1);
break;
case Scopy: /* copy values. cf. dup */
ob1 = pop();
switch(ob1.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:copy");
}
size = ob1.lc.ival;
k = 0;
for (i=size-1; i>=0; i--) {
ob2 = peek(i+k);
switch(ob2.tag) {
case Sdollar: /* copy by value */
str = (char *)GC_malloc(strlen(ob2.lc.str)+3);
if (str == (char *)NULL) errorStackmachine("No memory (copy)");
strcpy(str,ob2.lc.str);
push(KpoString(str));
break;
case Spoly:
errorStackmachine("no pCopy (copy)");
break;
case Sarray:
n = ob2.lc.ival;
ob3 = newObjectArray(n);
for (j=0; j<n; j++) {
putoa(ob3,j,getoa(ob2,j));
}
push(ob3);
break;
default:
push(ob2);
break;
}
k++;
}
break;
case Sroll:
ob1 = pop();
ob2 = pop();
switch(ob1.tag) {
case Sinteger:
j = ob1.lc.ival;
break;
default: errorStackmachine("Usage:roll");
}
switch(ob2.tag) {
case Sinteger:
n = ob2.lc.ival;
break;
default: errorStackmachine("Usage:roll");
}
for (i=0; i<n; i++) {
if (i < OB_ARRAY_MAX) {
obArray[i] = pop();
}else{
errorStackmachine("exceeded OB_ARRAY_MAX (roll)\n");
}
}
for (i=0; i<n; i++) {
k = (j-1)%n;
k = (k>=0?k: k+n);
push(obArray[k]);
j--;
}
break;
case Spstack:
printOperandStack();
break;
/* Postscript primitives :arithmetic */
case Sadd:
ob1 = pop();
ob2 = pop();
rob = KooAdd(ob1,ob2);
push(rob);
break;
case Ssub:
ob2 = pop();
ob1 = pop();
rob = KooSub(ob1,ob2);
push(rob);
break;
case Smult:
ob2 = pop();
ob1 = pop();
rob = KooMult(ob1,ob2);
push(rob);
break;
case Sidiv:
ob2 = pop(); ob1 = pop();
rob = KooDiv(ob1,ob2);
push(rob);
break;
/* Postscript primitives :array */
case SleftBrace:
rob.tag = SleftBraceTag;
push(rob);
break;
case SrightBrace:
size = 0;
ob1 = peek(size);
while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
if (ob1.tag == SleftBraceTag) {
rob = newObjectArray(size);
for (i=0; i<size; i++) {
(rob.rc.op)[i] = peek(size-1-i);
}
for (i=0; i<size+1; i++) {
pop();
}
break;
}
size++;
ob1 = peek(size);
}
push(rob);
break;
case Sget:
/* [a_0 ... a_{n-1}] i get a_i */
/* ob2 ob1 get */
ob1 = pop();
ob2 = pop();
switch(ob2.tag) {
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)) {
push(getoa(ob2,i));
}else{
errorStackmachine("Index is out of bound. (get)\n");
}
break;
case Sput:
/* [a_0 ... a_{n-1}] index any put */
/* ob3 ob2 ob1 put */
ob1 = pop(); ob2 = pop(); ob3 = pop();
switch(ob2.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:put");
}
switch(ob3.tag) {
case Sarray:
i = ob2.lc.ival;
size = getoaSize(ob3);
if ((0 <= i) && (i<size)) {
getoa(ob3,i) = ob1;
}else{
errorStackmachine("Index is out of bound. (put)\n");
}
break;
case Sdollar:
i = ob2.lc.ival;
size = strlen(ob3.lc.str);
if ((0 <= i) && (i<size)) {
if (ob1.tag == Sdollar) {
(ob3.lc.str)[i] = (ob1.lc.str)[0];
}else{
(ob3.lc.str)[i] = ob1.lc.ival;
}
}else{
errorStackmachine("Index is out of bound. (put)\n");
}
break;
default: errorStackmachine("Usage:put");
}
break;
case Sindex:
ob1 = pop();
switch(ob1.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:index");
}
size = ob1.lc.ival;
push(peek(size-1));
break;
case Saload:
/* [a1 a2 ... an] aload a1 a2 ... an [a1 ... an] */
ob1 = pop();
switch(ob1.tag) {
case Sarray: break;
default:
errorStackmachine("Usage:aload");
}
size = getoaSize(ob1);
for (i=0; i<size; i++) {
push(getoa(ob1,i));
}
push(ob1);
break;
case Slength:
/* [a_0 ... a_{n-1}] length n */
/* ob1 length rob */
ob1 = pop();
switch(ob1.tag) {
case Sarray:
size = getoaSize(ob1);
push(KpoInteger(size));
break;
case Sdollar:
push(KpoInteger(strlen(ob1.lc.str)));
break;
default: errorStackmachine("Usage:length");
}
break;
/* Postscript primitives :relation */
case Sequal:
/* obj1 obj2 == bool */
ob2 = pop();
ob1 = pop();
if(KooEqualQ(ob1,ob2)) {
push(KpoInteger(1));
}else{
push(KpoInteger(0));
}
break;
case Sless:
/* obj1 obj2 < bool */
ob2 = pop();
ob1 = pop();
push(KooLess(ob1,ob2));
break;
case Sgreater:
/* obj1 obj2 < bool */
ob2 = pop();
ob1 = pop();
push(KooGreater(ob1,ob2));
break;
/* Postscript primitives :controle */
case Sloop:
/* { .... exit .....} loop */
ob1 = pop();
switch(ob1.tag) {
case SexecutableArray: break;
default:
errorStackmachine("Usage:loop");
break;
}
tokenArray = ob1.lc.tokenArray;
size = ob1.rc.ival;
i = 0;
while (1) {
token = tokenArray[i];
/***printf("[token %d]%s\n",i,token.token);*/
i++;
if (i >= size) i=0;
status = executeToken(token);
if (status != 0) break;
/* here, do not return 1. Do not propagate exit signal outside of the
loop. */
}
break;
case Sfor:
/* init inc limit { } for */
/* ob4 ob3 ob2 ob1 */
ob1 =pop(); ob2 = pop(); ob3 = pop(); ob4 = pop();
switch(ob1.tag) {
case SexecutableArray: break;
default: errorStackmachine("Usage:for");
}
switch(ob2.tag) {
case Sinteger: break;
default:
errorStackmachine("Usage:for The 3rd argument must be integer.");
}
switch(ob3.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:for The 2nd argument must be integer.");
}
switch(ob4.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:for The 1st argument must be integer.");
}
{
int i,lim,inc,j;
i = ob4.lc.ival;
lim = ob2.lc.ival;
inc = ob3.lc.ival;
if (inc > 0) {
/*
if (lim < i) errorStackmachine("The initial value must not be greater than limit value (for).\n");
*/
for ( ; i<=lim; i += inc) {
push(KpoInteger(i));
tokenArray = ob1.lc.tokenArray;
size = ob1.rc.ival;
for (j=0; j<size; j++) {
status = executeToken(tokenArray[j]);
if (status) goto xyz;
}
}
}else{
/*
if (lim > i) errorStackmachine("The initial value must not be less than limit value (for).\n");
*/
for ( ; i>=lim; i += inc) {
push(KpoInteger(i));
tokenArray = ob1.lc.tokenArray;
size = ob1.rc.ival;
for (j=0; j<size; j++) {
status = executeToken(tokenArray[j]);
if (status) goto xyz;
}
}
}
xyz: ;
}
break;
case Smap:
ob2 = pop(); ob1 = pop();
switch(ob1.tag) {
case Sarray: break;
default:
errorStackmachine("Usage:map The 1st argument must be an array.");
break;
}
switch(ob2.tag) {
case SexecutableArray: break;
default:
errorStackmachine("Usage:map The 2nd argument must be an executable array.");
break;
}
{ int osize,size;
int i,j;
osize = getoaSize(ob1);
/*KSexecuteString("[");*/
rob.tag = SleftBraceTag;
push(rob);
for (i=0; i<osize; i++) {
push(getoa(ob1,i));
tokenArray = ob2.lc.tokenArray;
size = ob2.rc.ival;
for (j=0; j<size; j++) {
status = executeToken(tokenArray[j]);
if (status) goto foor;
}
}
foor: ;
/*KSexecuteString("]");*/
{
size = 0;
ob1 = peek(size);
while (!(Osp-size-1 < 0)) { /* while the stack is not underflow */
if (ob1.tag == SleftBraceTag) {
rob = newObjectArray(size);
for (i=0; i<size; i++) {
(rob.rc.op)[i] = peek(size-1-i);
}
for (i=0; i<size+1; i++) {
pop();
}
break;
}
size++;
ob1 = peek(size);
}
push(rob);
}
}
break;
case Sifelse:
/* bool { } { } ifelse */
ob1 = pop();
ob2 = pop();
ob3 = pop();
switch (ob1.tag) {
case SexecutableArray: break;
default: errorStackmachine("Usage:ifelse");
}
switch (ob2.tag) {
case SexecutableArray: break;
default: errorStackmachine("Usage:ifelse");
}
switch (ob3.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:ifelse");
}
if (ob3.lc.ival) {
/* execute ob2 */
ob1 = ob2;
}
/* execute ob1 */
tokenArray = ob1.lc.tokenArray;
size = ob1.rc.ival;
for (i=0; i<size; i++) {
token = tokenArray[i];
status = executeToken(token);
if (status != 0) return(status);
}
break;
case Sexec:
/* { .........} exec */
ob1 = pop();
switch(ob1.tag) {
case SexecutableArray: break;
default: errorStackmachine("Usage:exec");
}
tokenArray = ob1.lc.tokenArray;
size = ob1.rc.ival;
for (i=0; i<size; i++) {
token = tokenArray[i];
/***printf("[token %d]%s\n",i,token.token);*/
status = executeToken(token);
if (status != 0) break;
}
break;
/* Postscript primitives :dictionary */
case Sdef:
ob2 = pop();
ob1 = pop();
/* type check */
switch(ob1.tag) {
case Sstring: break;
default:
errorStackmachine("Usage:def");
break;
}
putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
(ob1.rc.op->rc).ival,ob2);
break;
case Sload:
ob1 = pop();
switch(ob1.tag) {
case Sstring: break;
default: errorStackmachine("Usage:load");
}
ob1 = findUserDictionary(ob1.lc.str,
(ob1.rc.op->lc).ival,
(ob1.rc.op->rc).ival);
if (ob1.tag == -1) push(NullObject);
else push(ob1);
break;
case Sset:
ob1 = pop();
ob2 = pop();
switch(ob1.tag) {
case Sstring: break;
default: errorStackmachine("Usage:set");
}
putUserDictionary(ob1.lc.str,(ob1.rc.op->lc).ival,
(ob1.rc.op->rc).ival,ob2);
break;
case Sshow_systemdictionary:
fprintf(Fstack,"------------- system dictionary -------------------\n");
showSystemDictionary();
break;
case Sshow_user_dictionary:
showUserDictionary("");
break;
/* Postscript primitives : convert */
case Sdata_conversion:
ob2 = pop();
ob1 = pop();
switch(ob2.tag) {
case Sdollar: break;
default: errorStackmachine("Usage:data_conversion");
}
rob = KdataConversion(ob1,ob2.lc.str);
push(rob);
break;
/* Postscript ptimitives :file */
case Srun:
ob1 = pop();
switch(ob1.tag) {
case Sdollar: break;
case Sstring: break;
default:
errorStackmachine("Usage:run");
break;
}
getokenSM(OPEN,ob1.lc.str); /* open the file, $filename$ run */
break;
case Sprint:
ob1 = pop();
printObject(ob1,0,Fstack);
break;
case Sfileopen: /* filename mode file descripter */
/* ob2 ob1 */
ob1 = pop();
ob2 = pop();
switch(ob1.tag) {
case Sdollar: break;
default: errorStackmachine("Usage:file");
}
switch(ob2.tag) {
case Sdollar: break;
default:errorStackmachine("Usage:file");
}
rob = NullObject;
if (strcmp(ob2.lc.str,"%stdin") == 0) {
rob.tag = Sfile; rob.lc.str="%stdin"; rob.rc.file = stdin;
}else if (strcmp(ob2.lc.str,"%stdout") == 0) {
rob.tag = Sfile; rob.lc.str="%stdout"; rob.rc.file = stdout;
}else if (strcmp(ob2.lc.str,"%stderr") == 0) {
rob.tag = Sfile; rob.lc.str="%stderr"; rob.rc.file = stderr;
}else if ( (rob.rc.file = fopen(ob2.lc.str,ob1.lc.str)) != (FILE *)NULL) {
rob.tag = Sfile; rob.lc.str = ob2.lc.str;
}else {
errorStackmachine("I cannot open the file.");
}
push(rob);
break;
case Swritestring:
/* file string writestring
ob2 ob1
*/
ob1 = pop();
ob2 = pop();
switch(ob2.tag) {
case Sfile: break;
default: errorStackmachine("Usage:writestring");
}
switch(ob1.tag) {
case Sdollar: break;
default: errorStackmachine("Usage:writestring");
}
fprintf(ob2.rc.file,"%s",ob1.lc.str);
break;
case Sclosefile:
ob1 = pop();
switch(ob1.tag) {
case Sfile: break;
default: errorStackmachine("Usage:closefile");
}
if (fclose(ob1.rc.file) == EOF) {
errorStackmachine("I couldn't close the file.\n");
}
break;
case Spushfile: /* filename pushfile string */
/* ob2 */
ob2 = pop();
switch(ob2.tag) {
case Sdollar: break;
default:errorStackmachine("Usage:pushfile");
}
rob = NullObject;
if (strcmp(ob2.lc.str,"%stdin") == 0) {
ob1.tag = Sfile; ob1.lc.str="%stdin"; ob1.rc.file = stdin;
}else if (strcmp(ob2.lc.str,"%stdout") == 0) {
ob1.tag = Sfile; ob1.lc.str="%stdout"; ob1.rc.file = stdout;
}else if (strcmp(ob2.lc.str,"%stderr") == 0) {
ob1.tag = Sfile; ob1.lc.str="%stderr"; ob1.rc.file = stderr;
}else if ( (ob1.rc.file = fopen(ob2.lc.str,"r")) != (FILE *)NULL) {
ob1.tag = Sfile; ob1.lc.str = ob2.lc.str;
}else {
errorStackmachine("I cannot open the file.");
}
/* read the strings
*/
n = 256; j=0;
rob.tag = Sdollar; rob.lc.str = (char *) GC_malloc(sizeof(char)*n);
if (rob.lc.str == (char *)NULL) errorStackmachine("No more memory.");
while ((i = fgetc(ob1.rc.file)) != EOF) {
if (j >= n-1) {
n = 2*n;
if (n <= 0) errorStackmachine("Too large file to put on the stack.");
str = (char *)GC_malloc(sizeof(char)*n);
if (str == (char *)NULL) errorStackmachine("No more memory.");
for (k=0; k< n/2; k++) str[k] = (rob.lc.str)[k];
rob.lc.str = str;
}
(rob.lc.str)[j] = i; (rob.lc.str)[j+1] = '\0';
j++;
}
fclose(ob1.rc.file);
push(rob);
break;
/* Postscript primitives :misc */
case Squit:
Kclose(); stackmachine_close();
exit(0);
break;
case Ssystem:
ob1 = pop();
switch(ob1.tag) {
case Sdollar: break;
case Sstring: break;
default: errorStackmachine("Usage:system");
}
system( ob1.lc.str );
break;
case Scat_n:
ob1 = pop();
switch(ob1.tag) {
case Sinteger: break;
default: errorStackmachine("Usage:cat_n");
}
size = ob1.lc.ival;
k = 0;
for (i=size-1; i>=0; i--) {
ob2 = peek(i);
switch(ob2.tag) {
case Sdollar: break;
default: errorStackmachine("Usage:cat_n");
}
k += strlen(ob2.lc.str);
}
ob1.tag = Sdollar;
ob1.lc.str = (char *)GC_malloc(sizeof(char)*(k+1));
if (ob1.lc.str == (char *)NULL) {
errorStackmachine("No more memory.\n");
}
/* concatnate */
k = 0;
for (i=size-1; i>=0; i--) {
ob2 = peek(i);
strcpy(&((ob1.lc.str)[k]),ob2.lc.str);
k = strlen(ob1.lc.str);
}
/* clear the arguments */
for (i=size-1; i>=0; i--) {
ob2 = pop();
}
push(ob1);
break;
case Sset_timer:
/* 118p */
if (timerStart) {
times(&before);
timerStart = 0;
}else{
times(&after);
printf("User time: %f seconds, System time: %f seconds\n",
((double)(after.tms_utime - before.tms_utime)) /60.0,
((double)(after.tms_stime - before.tms_stime)) /60.0);
timerStart = 1;
}
break;
case Susage:
ob1 = pop();
Kusage(ob1);
break;
case Sto_records:
ob1 = pop();
switch(ob1.tag) {
case Sdollar: break;
default: errorStackmachine("Usage:to_records");
}
ob2 = KtoRecords(ob1);
size = getoaSize(ob2);
for (i=0; i<size; i++) {
push(getoa(ob2,i));
}
rob.tag = Sinteger;
rob.lc.ival = size;
push(rob);
break;
case Ssystem_variable:
ob1 = pop();
switch(ob1.tag) {
case Sarray: break;
default: errorStackmachine("Usage:system_variable");
}
push(KsystemVariable(ob1));
break;
/* kan primitives :kan :ring */
case Sset_order_by_matrix:
ob1 = pop();
KsetOrderByObjArray(ob1);
break;
case Sset_up_ring:
ob5 = pop(); ob4=pop(); ob3=pop(); ob2=pop(); ob1=pop();
KsetUpRing(ob1,ob2,ob3,ob4,ob5);
break;
case Sshow_ring:
KshowRing(CurrentRingp);
break;
case Sswitch_function:
ob1 = pop();
ob2 = pop();
KswitchFunction(ob2,ob1);
break;
case Sprint_switch_status:
KprintSwitchStatus();
break;
case Sreplace:
ob2 = pop();
ob1 = pop();
push(KoReplace(ob1,ob2));
break;
case Scoefficients:
ob2 = pop();
ob1 = pop();
push(Kparts(ob1,ob2));
break;
case Sdegree:
ob2 = pop();
ob1 = pop();
push(Kdegree(ob1,ob2));
break;
case Sspol:
ob2 = pop();
ob1 = pop();
push(Ksp(ob1,ob2));
break;
case Seval:
ob1 = pop();
push(Keval(ob1));
break;
case Sreduction:
ob2 = pop();
ob1 = pop();
push(Kreduction(ob1,ob2));
break;
case Sgroebner :
ob1 = pop();
push(Kgroebner(ob1));
break;
case Shomogenize :
ob1 = pop();
push(homogenizeObject(ob1,&i));
break;
case Sprincipal :
ob1 = pop();
push(oPrincipalPart(ob1));
break;
case Sinit:
ob1 = pop();
push(Khead(ob1));
break;
case Stest:
/* test is used for a test of a new function. */
ob1 = pop();
push(test(ob1));
/*
{
}
*/
break;
default:
errorStackmachine("Unknown Soperator type. \n");
}
return(0); /* normal exit */
}
errorStackmachine(str)
char *str;
{
int i,j,k;
static char *u="Usage:";
char message0[1024];
char *message;
message = message0;
i = 0;
while (i<6 && str[i]!='0') {
if (str[i] != u[i]) break;
i++;
}
if (i==6) {
fprintf(stderr,"ERROR(sm): \n");
while (str[i] != '\0' && str[i] != ' ') {
i++;
}
if (str[i] == ' ') {
fprintf(stderr," %s\n",&(str[i+1]));
k = 0;
if (i-6 > 1022) message = (char *)GC_malloc(sizeof(char)*i);
for (j=6; j<i ; j++) {
message[k] = str[j];
message[k+1] = '\0';
k++;
}
Kusage2(stderr,message);
}else{
Kusage2(stderr,&(str[6]));
}
}else {
fprintf(stderr,"ERROR(sm): ");
fprintf(stderr,str);
}
fprintf(stderr,"\n");
longjmp(EnvOfStackMachine,1);
}
warningStackmachine(str)
char *str;
{
fprintf(stderr,"WARNING(sm): ");
fprintf(stderr,str);
return(0);
}
/* exports */
KSexecuteString(s)
char *s;
{
struct tokens token;
struct object ob;
int tmp;
if (setjmp(EnvOfStackMachine)) {
return(-1);
}else{
token.token = s;
token.kind = EXECUTABLE_STRING;
executeToken(token);
token.kind = ID;
token.token = "exec";
token = lookupTokens(token); /* no use */
tmp = findSystemDictionary(token.token);
ob.tag = Soperator;
ob.lc.ival = tmp;
executePrimitive(ob);
return(0);
}
}
KSdefineMacros() {
struct tokens token;
int tmp;
struct object ob;
if (setjmp(EnvOfStackMachine)) {
return(-1);
}else{
if (StandardMacros && (strlen(SMacros))) {
token.kind = EXECUTABLE_STRING;
token.token = SMacros;
executeToken(token); /* execute startup commands */
token.kind = ID;
token.token = "exec";
token = lookupTokens(token); /* no use */
tmp = findSystemDictionary(token.token);
ob.tag = Soperator;
ob.lc.ival = tmp;
executePrimitive(ob); /* exec */
}
return(0);
}
}
void KSstart() {
stackmachine_init(); KinitKan();
getokenSM(INIT); initSystemDictionary();
KSdefineMacros();
/* setjmp(EnvOfStackMachine) */
}
void KSstop() {
Kclose(); stackmachine_close();
}
struct object KSpop() {
return(pop());
}
void KSpush(ob)
struct object ob;
{
push(ob);
}
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / Replace