OpenXM/src/kan96xx/Kan/primitive.c - diff

Return to primitive.c CVS log

Up to [local] / OpenXM / src / kan96xx / Kan

Diff for /OpenXM/src/kan96xx/Kan/primitive.c between version 1.15 and 1.22

version 1.15, 2004/09/12 10:22:50

version 1.22, 2013/11/06 06:44:48

Line 1

/* $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.21 2005/07/03 11:08:54 ohara Exp $ */

/* primitive.c */

/* The functions in this module were in stackmachine.c */

#include <stdio.h>

#include <stdlib.h>

#include <string.h>

#include <signal.h>

#include "datatype.h"

#include "stackm.h"

#include "extern.h"

#include "extern2.h"

#include "gradedset.h"

#include "kclass.h"

#include <sys/types.h>

Line 40 static char *operatorType(type)

Line 43 static char *operatorType(type)

return("Unknown operator");

}

#define evalEA(ob1) if (ob1.tag == SexecutableArray) {\

executeExecutableArray(ob1,(char *)NULL,0); ob1 = Kpop();}

/****** primitive functions *****************************************

the values must be greater than 1. 0 is used for special purposes.*/

#define Sadd 1

Line 197 void printObject(ob,nl,fp)

Line 203 void printObject(ob,nl,fp)

case Sdouble:

fprintf(fp,"<double> ");

break;

case SbyteArray:

fprintf(fp,"<byteArray> ");

break;

default:

fprintf(fp,"<Unknown object tag. %d >",ob.tag);

break;

Line 291 void printObject(ob,nl,fp)

Line 300 void printObject(ob,nl,fp)

case Sdouble:

fprintf(fp,"%f",KopDouble(ob));

break;

case SbyteArray:

printObject(byteArrayToArray(ob),nl,fp); /* Todo: I should save memory.*/

break;

default:

fprintf(fp,"[Unknown object tag.]");

break;

Line 413 void KdefinePrimitiveFunctions() {

Line 425 void KdefinePrimitiveFunctions() {

int executePrimitive(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 obArray2[OB_ARRAY_MAX];

int size;

Line 431 int executePrimitive(ob)

Line 443 int executePrimitive(ob)

FILE *fp;

char *fname;

int rank;

struct object oMat;

struct object oMat = OINIT;

static int timerStart = 1;

static struct tms before, after;

static time_t before_real, after_real;

struct object oInput;

struct object oInput = OINIT;

char *str;

int ccflag = 0;

extern int KeepInput;

Line 443 int executePrimitive(ob)

Line 455 int executePrimitive(ob)

extern struct ring *CurrentRingp;

extern TimerOn;

extern SecureMode;

extern int RestrictedMode;

infixOn = 0;

Line 450 int executePrimitive(ob)

Line 463 int executePrimitive(ob)

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);

switch (ob.lc.ival) {

/* Postscript primitives :stack */

Line 498 int executePrimitive(ob)

Line 523 int executePrimitive(ob)

}

Kpush(ob3);

break;

case SbyteArray:

n = getByteArraySize(ob2);

ob3 = newByteArray(n,ob2);

Kpush(ob3);

break;

default:

Kpush(ob2);

break;

Line 540 int executePrimitive(ob)

Line 570 int executePrimitive(ob)

/* Postscript primitives :arithmetic */

case Sadd:

ob1 = Kpop();

ob2 = Kpop();

evalEA(ob1); evalEA(ob2);

rob = KooAdd(ob1,ob2);

Kpush(rob);

break;

case Ssub:

ob2 = Kpop();

ob1 = Kpop();

evalEA(ob1); evalEA(ob2);

rob = KooSub(ob1,ob2);

Kpush(rob);

break;

case Smult:

ob2 = Kpop();

ob1 = Kpop();

evalEA(ob1); evalEA(ob2);

rob = KooMult(ob1,ob2);

Kpush(rob);

break;

case Sidiv:

ob2 = Kpop(); ob1 = Kpop();

evalEA(ob1); evalEA(ob2);

rob = KooDiv(ob1,ob2);

Kpush(rob);

break;

case Sdiv:

ob2 = Kpop(); ob1 = Kpop();

evalEA(ob1); evalEA(ob2);

rob = KooDiv2(ob1,ob2);

Kpush(rob);

break;

Line 609 int executePrimitive(ob)

Line 644 int executePrimitive(ob)

/* Or; [[a_00 ....] [a_10 ....] ....] [1 0] any put. MultiIndex. */

ob1 = Kpop(); ob2 = Kpop(); ob3 = Kpop();

switch(ob2.tag) {

case SuniversalNumber:

ob2 = Kto_int32(ob2); /* do not break and go to Sinteger */

case Sinteger:

switch(ob3.tag) {

case Sarray:

Line 633 int executePrimitive(ob)

Line 670 int executePrimitive(ob)

errorStackmachine("Index is out of bound. (put)\n");

}

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");

}

break;

Line 643 int executePrimitive(ob)

Line 691 int executePrimitive(ob)

if (ob5.tag != Sarray)

errorStackmachine("Object pointed by the multi-index is not array (put)\n");

ob4 = getoa(ob2,i);

if (ob4.tag == SuniversalNumber) ob4 = Kto_int32(ob4);

if (ob4.tag != Sinteger)

errorStackmachine("Index has to be an integer. (put)\n");

k = ob4.lc.ival;

Line 703 int executePrimitive(ob)

Line 752 int executePrimitive(ob)

case Spoly:

Kpush(KpoInteger(KpolyLength(KopPOLY(ob1))));

break;

case SbyteArray:

Kpush(KpoInteger(getByteArraySize(ob1)));

break;

default: errorStackmachine("Usage:length");

}

break;

Line 1532 int executePrimitive(ob)

Line 1584 int executePrimitive(ob)

if (QuoteMode && (status & DO_QUOTE)) {

/* 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();}

qob = newObjectArray(3);

qattr = newObjectArray(1);

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>