version 1.16, 2004/09/12 10:58:28 |
version 1.25, 2018/09/07 00:15:44 |
|
|
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.15 2004/09/12 10:22:50 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/primitive.c,v 1.24 2016/03/31 05:27:34 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 <stdlib.h> |
|
#include <string.h> |
#include <signal.h> |
#include <signal.h> |
#include "datatype.h" |
#include "datatype.h" |
#include "stackm.h" |
#include "stackm.h" |
#include "extern.h" |
#include "extern.h" |
|
#include "extern2.h" |
#include "gradedset.h" |
#include "gradedset.h" |
#include "kclass.h" |
#include "kclass.h" |
#include <sys/types.h> |
#include <sys/types.h> |
#include <sys/times.h> |
#include <sys/times.h> |
|
#include "mysig.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() */ |
Line 200 void printObject(ob,nl,fp) |
|
Line 204 void printObject(ob,nl,fp) |
|
case Sdouble: |
case Sdouble: |
fprintf(fp,"<double> "); |
fprintf(fp,"<double> "); |
break; |
break; |
|
case SbyteArray: |
|
fprintf(fp,"<byteArray> "); |
|
break; |
default: |
default: |
fprintf(fp,"<Unknown object tag. %d >",ob.tag); |
fprintf(fp,"<Unknown object tag. %d >",ob.tag); |
break; |
break; |
Line 274 void printObject(ob,nl,fp) |
|
Line 281 void printObject(ob,nl,fp) |
|
printObjectList(&ob); |
printObjectList(&ob); |
break; |
break; |
case Sfile: |
case Sfile: |
fprintf(fp,"Name=%s, FILE *=%x ",ob.lc.str,(int) ob.rc.file); |
fprintf(fp,"Name=%s, FILE *=%p ",ob.lc.str,ob.rc.file); |
break; |
break; |
case Sring: |
case Sring: |
fprintf(fp,"Ring."); KshowRing(KopRingp(ob)); |
fprintf(fp,"Ring."); KshowRing(KopRingp(ob)); |
Line 294 void printObject(ob,nl,fp) |
|
Line 301 void printObject(ob,nl,fp) |
|
case Sdouble: |
case Sdouble: |
fprintf(fp,"%f",KopDouble(ob)); |
fprintf(fp,"%f",KopDouble(ob)); |
break; |
break; |
|
case SbyteArray: |
|
printObject(byteArrayToArray(ob),nl,fp); /* Todo: I should save memory.*/ |
|
break; |
default: |
default: |
fprintf(fp,"[Unknown object tag.]"); |
fprintf(fp,"[Unknown object tag.]"); |
break; |
break; |
Line 416 void KdefinePrimitiveFunctions() { |
|
Line 426 void KdefinePrimitiveFunctions() { |
|
int executePrimitive(ob) |
int executePrimitive(ob) |
struct object ob; |
struct object ob; |
{ |
{ |
struct object ob1; |
struct object ob1 = OINIT; |
struct object ob2; |
struct object ob2 = OINIT; |
struct object ob3; |
struct object ob3 = OINIT; |
struct object ob4; |
struct object ob4 = OINIT; |
struct object ob5; |
struct object ob5 = OINIT; |
struct object rob; |
struct object rob = OINIT; |
struct object obArray[OB_ARRAY_MAX]; |
struct object obArray[OB_ARRAY_MAX]; |
struct object obArray2[OB_ARRAY_MAX]; |
struct object obArray2[OB_ARRAY_MAX]; |
int size; |
int size; |
Line 434 int executePrimitive(ob) |
|
Line 444 int executePrimitive(ob) |
|
FILE *fp; |
FILE *fp; |
char *fname; |
char *fname; |
int rank; |
int rank; |
struct object oMat; |
struct object oMat = OINIT; |
static int timerStart = 1; |
static int timerStart = 1; |
static struct tms before, after; |
static struct tms before, after; |
static time_t before_real, after_real; |
static time_t before_real, after_real; |
struct object oInput; |
struct object oInput = OINIT; |
char *str; |
char *str; |
int ccflag = 0; |
int ccflag = 0; |
extern int KeepInput; |
extern int KeepInput; |
Line 446 int executePrimitive(ob) |
|
Line 456 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 453 int executePrimitive(ob) |
|
Line 464 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 501 int executePrimitive(ob) |
|
Line 524 int executePrimitive(ob) |
|
} |
} |
Kpush(ob3); |
Kpush(ob3); |
break; |
break; |
|
case SbyteArray: |
|
n = getByteArraySize(ob2); |
|
ob3 = newByteArray(n,ob2); |
|
Kpush(ob3); |
|
break; |
default: |
default: |
Kpush(ob2); |
Kpush(ob2); |
break; |
break; |
Line 617 int executePrimitive(ob) |
|
Line 645 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 641 int executePrimitive(ob) |
|
Line 671 int executePrimitive(ob) |
|
errorStackmachine("Index is out of bound. (put)\n"); |
errorStackmachine("Index is out of bound. (put)\n"); |
} |
} |
break; |
break; |
|
case SbyteArray: |
|
i = ob2.lc.ival; |
|
size = getByteArraySize(ob3); |
|
if ((0 <= i) && (i<size)) { |
|
if (ob1.tag != Sinteger) ob1 = Kto_int32(ob1); |
|
if (ob1.tag != Sinteger) errorStackmachine("One can put only integer.\n"); |
|
KopByteArray(ob3)[i] = KopInteger(ob1); |
|
}else{ |
|
errorStackmachine("Index is out of bound. (put)\n"); |
|
} |
|
break; |
default: errorStackmachine("Usage:put"); |
default: errorStackmachine("Usage:put"); |
} |
} |
break; |
break; |
Line 651 int executePrimitive(ob) |
|
Line 692 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; |
Line 711 int executePrimitive(ob) |
|
Line 753 int executePrimitive(ob) |
|
case Spoly: |
case Spoly: |
Kpush(KpoInteger(KpolyLength(KopPOLY(ob1)))); |
Kpush(KpoInteger(KpolyLength(KopPOLY(ob1)))); |
break; |
break; |
|
case SbyteArray: |
|
Kpush(KpoInteger(getByteArraySize(ob1))); |
|
break; |
default: errorStackmachine("Usage:length"); |
default: errorStackmachine("Usage:length"); |
} |
} |
break; |
break; |
Line 1540 int executePrimitive(ob) |
|
Line 1585 int executePrimitive(ob) |
|
|
|
if (QuoteMode && (status & DO_QUOTE)) { |
if (QuoteMode && (status & DO_QUOTE)) { |
/* generate tree object, for kan/k0 */ |
/* generate tree object, for kan/k0 */ |
struct object qob; |
struct object qob = OINIT; |
struct object qattr; |
struct object qattr = OINIT; |
struct object qattr2; |
struct object qattr2 = OINIT; |
if (i==0) { Kpop(); Kpop();} |
if (i==0) { Kpop(); Kpop();} |
qob = newObjectArray(3); |
qob = newObjectArray(3); |
qattr = newObjectArray(1); |
qattr = newObjectArray(1); |
Line 1702 int executePrimitive(ob) |
|
Line 1747 int executePrimitive(ob) |
|
} |
} |
n = ob2.lc.ival; |
n = ob2.lc.ival; |
if (n > 0) { |
if (n > 0) { |
signal(SIGALRM,ctrlC); alarm((unsigned int) n); |
mysignal(SIGALRM,ctrlC); alarm((unsigned int) n); |
status = executeExecutableArray(ob1,(char *)NULL,0); |
status = executeExecutableArray(ob1,(char *)NULL,0); |
cancelAlarm(); |
cancelAlarm(); |
}else{ |
}else{ |