version 1.15, 2004/09/12 10:22:50 |
version 1.18, 2004/09/17 02:42:57 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.14 2004/09/12 08:55:36 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.17 2004/09/16 02:22:03 takayama Exp $ */ |
/* primitive.c */ |
/* primitive.c */ |
/* The functions in this module were in stackmachine.c */ |
/* The functions in this module were in stackmachine.c */ |
|
|
Line 40 static char *operatorType(type) |
|
Line 40 static char *operatorType(type) |
|
return("Unknown operator"); |
return("Unknown operator"); |
} |
} |
|
|
|
#define evalEA(ob1) if (ob1.tag == SexecutableArray) {\ |
|
executeExecutableArray(ob1,(char *)NULL,0); ob1 = Kpop();} |
|
|
/****** primitive functions ***************************************** |
/****** primitive functions ***************************************** |
the values must be greater than 1. 0 is used for special purposes.*/ |
the values must be greater than 1. 0 is used for special purposes.*/ |
#define Sadd 1 |
#define Sadd 1 |
Line 443 int executePrimitive(ob) |
|
Line 446 int executePrimitive(ob) |
|
extern struct ring *CurrentRingp; |
extern struct ring *CurrentRingp; |
extern TimerOn; |
extern TimerOn; |
extern SecureMode; |
extern SecureMode; |
|
extern int RestrictedMode; |
|
|
infixOn = 0; |
infixOn = 0; |
|
|
Line 450 int executePrimitive(ob) |
|
Line 454 int executePrimitive(ob) |
|
fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack(); |
fprintf(Fstack,"In execute %d\n",ob.lc.ival); printOperandStack(); |
} |
} |
|
|
|
if (RestrictedMode) { |
|
switch(ob.lc.ival) { |
|
case SleftBrace: |
|
case SrightBrace: |
|
case Sexec: |
|
break; |
|
default: |
|
fprintf(stderr,"primitive No = %d : ", ob.lc.ival); |
|
errorStackmachine("You cannot use this primitive in the RestrictedMode.\n"); |
|
} |
|
} |
|
|
if (GotoP) return(0); |
if (GotoP) return(0); |
switch (ob.lc.ival) { |
switch (ob.lc.ival) { |
/* Postscript primitives :stack */ |
/* Postscript primitives :stack */ |
Line 540 int executePrimitive(ob) |
|
Line 556 int executePrimitive(ob) |
|
|
|
/* Postscript primitives :arithmetic */ |
/* Postscript primitives :arithmetic */ |
case Sadd: |
case Sadd: |
ob1 = Kpop(); |
ob1 = Kpop(); |
ob2 = Kpop(); |
ob2 = Kpop(); |
|
evalEA(ob1); evalEA(ob2); |
rob = KooAdd(ob1,ob2); |
rob = KooAdd(ob1,ob2); |
Kpush(rob); |
Kpush(rob); |
break; |
break; |
case Ssub: |
case Ssub: |
ob2 = Kpop(); |
ob2 = Kpop(); |
ob1 = Kpop(); |
ob1 = Kpop(); |
|
evalEA(ob1); evalEA(ob2); |
rob = KooSub(ob1,ob2); |
rob = KooSub(ob1,ob2); |
Kpush(rob); |
Kpush(rob); |
break; |
break; |
case Smult: |
case Smult: |
ob2 = Kpop(); |
ob2 = Kpop(); |
ob1 = Kpop(); |
ob1 = Kpop(); |
|
evalEA(ob1); evalEA(ob2); |
rob = KooMult(ob1,ob2); |
rob = KooMult(ob1,ob2); |
Kpush(rob); |
Kpush(rob); |
break; |
break; |
case Sidiv: |
case Sidiv: |
ob2 = Kpop(); ob1 = Kpop(); |
ob2 = Kpop(); ob1 = Kpop(); |
|
evalEA(ob1); evalEA(ob2); |
rob = KooDiv(ob1,ob2); |
rob = KooDiv(ob1,ob2); |
Kpush(rob); |
Kpush(rob); |
break; |
break; |
|
|
case Sdiv: |
case Sdiv: |
ob2 = Kpop(); ob1 = Kpop(); |
ob2 = Kpop(); ob1 = Kpop(); |
|
evalEA(ob1); evalEA(ob2); |
rob = KooDiv2(ob1,ob2); |
rob = KooDiv2(ob1,ob2); |
Kpush(rob); |
Kpush(rob); |
break; |
break; |
Line 609 int executePrimitive(ob) |
|
Line 630 int executePrimitive(ob) |
|
/* Or; [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */ |
/* Or; [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */ |
ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop(); |
ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop(); |
switch(ob2.tag) { |
switch(ob2.tag) { |
|
case SuniversalNumber: |
|
ob2 = Kto_int32(ob2); /* do not break and go to Sinteger */ |
case Sinteger: |
case Sinteger: |
switch(ob3.tag) { |
switch(ob3.tag) { |
case Sarray: |
case Sarray: |
Line 643 int executePrimitive(ob) |
|
Line 666 int executePrimitive(ob) |
|
if (ob5.tag != Sarray) |
if (ob5.tag != Sarray) |
errorStackmachine("Object pointed by the multi-index is not array (put)\n"); |
errorStackmachine("Object pointed by the multi-index is not array (put)\n"); |
ob4 = getoa(ob2,i); |
ob4 = getoa(ob2,i); |
|
if (ob4.tag == SuniversalNumber) ob4 = Kto_int32(ob4); |
if (ob4.tag != Sinteger) |
if (ob4.tag != Sinteger) |
errorStackmachine("Index has to be an integer. (put)\n"); |
errorStackmachine("Index has to be an integer. (put)\n"); |
k = ob4.lc.ival; |
k = ob4.lc.ival; |