calc.mx

一个内存数据库的源代码这是服务器端还有客户端

min(dbl1,dbl2).print;
min(lng1,lng2).print;

abs(sht2).print;
abs(int2).print;
abs(flt2).print;
abs(dbl2).print;
abs(lng2).print;

@:mil_calc_ops(oid1,oid2)@
max(oid1,oid2).print;
min(oid1,oid2).print;

inv(sht2).print;
inv(int2).print;
inv(flt2).print;
inv(dbl2).print;
inv(lng2).print;

(int1% int2).print;
(int1<<int2).print;
(int1>>int2).print;

(int1 or  int2).print;
(int1 and int2).print;
(int1 xor int2).print;
not(int2).print;

bit1 := true;
bit2 := false;
(bit1 or  bit2).print;
(bit1 and bit2).print;
(bit1 xor bit2).print;
not(bit2).print;

srand( 1234 );
rand().print;
quit;
@-
The @emph{comp_ops} implements the mil example script comparison 
operations.  It gets two parameters which are the operants for the operations.

@= mil_comp_ops
 (@1 < @2).print;  (@2 < @1).print;  (@1 < @1).print;
(@1 <= @2).print; (@2 <= @1).print; (@1 <= @1).print;
 (@1 = @2).print;  (@2 = @1).print;  (@1 = @1).print;
(@1 >= @2).print; (@2 >= @1).print; (@1 >= @1).print;
 (@1 > @2).print;  (@2 > @1).print;  (@1 > @1).print;
@

The @emph{calc_ops} implements the mil example script arithmetic 
operations.  It gets two parameters which are the operants for the operations.

@= mil_calc_ops
(@1 + @2).print;
(@1 - @2).print;
(@1 * @2).print;
(@1 / @2).print;
@

@+ Implementation
The implementation below differs from the pre-V5 implementation in
that all strings and pointers are passed by reference, rather than
by value. Since it is unclear in the module implementation whether
such references are static or refer to dynamic allocated space,
we have to be conservative. All deallocation calls should be prepared
and handled by the environment.
For this module this won't be a problem, because we do not change
the string representations.
@h
#ifndef __calc_H__
#define __calc_H__

#include "gdk.h"

#endif /* __calc_H__ */

@c
#include "mal_config.h"
#include "calc.h"
#include "stdlib.h"
#include "mal.h"
#include "mal_exception.h"
#include "mal_interpreter.h"

#ifdef WIN32
#ifndef LIBCALC
#define calc_export extern __declspec(dllimport)
#else
#define calc_export extern __declspec(dllexport)
#endif
#else
#define calc_export extern
#endif

/* third param indicates return value if one of the params is nil */
@:c_comp_ops(<,LT)@
@:c_comp_ops(<=,LE)@
@:c_comp_ops(==,EQ)@
@:c_comp_ops(!=,NEQ)@
@:c_comp_ops(>=,GE)@
@:c_comp_ops(>,GT)@

/* the normal implementation of an operator is to just stick the
   operator between the operands */
#define OP(l,op,r)	((l) op (r))
@:c_calc_ops(chr,chr,chr)@
@:c_calc_ops(chr,sht,sht)@
@:c_calc_ops(chr,int,int)@
@:c_calc_ops(chr,lng,lng)@
@:c_calc_ops(chr,flt,flt)@
@:c_calc_ops(chr,dbl,dbl)@

@:c_calc_ops(sht,chr,sht)@
@:c_calc_ops(sht,sht,sht)@
@:c_calc_ops(sht,int,int)@
@:c_calc_ops(sht,lng,lng)@
@:c_calc_ops(sht,flt,flt)@
@:c_calc_ops(sht,dbl,dbl)@

@:c_calc_ops(int,chr,int)@
@:c_calc_ops(int,sht,int)@
@:c_calc_ops(int,int,int)@
@:c_calc_ops(int,lng,lng)@
@:c_calc_ops(int,flt,flt)@
@:c_calc_ops(int,dbl,dbl)@

@:c_calc_ops(lng,chr,lng)@
@:c_calc_ops(lng,sht,lng)@
@:c_calc_ops(lng,int,lng)@
@:c_calc_ops(lng,lng,lng)@
@:c_calc_ops(lng,flt,flt)@
@:c_calc_ops(lng,dbl,dbl)@

@:c_calc_ops(flt,chr,flt)@
@:c_calc_ops(flt,sht,flt)@
@:c_calc_ops(flt,int,flt)@
@:c_calc_ops(flt,lng,flt)@
@:c_calc_ops(flt,flt,flt)@
@:c_calc_ops(flt,dbl,dbl)@

@:c_calc_ops(dbl,chr,dbl)@
@:c_calc_ops(dbl,sht,dbl)@
@:c_calc_ops(dbl,int,dbl)@
@:c_calc_ops(dbl,lng,dbl)@
@:c_calc_ops(dbl,flt,dbl)@
@:c_calc_ops(dbl,dbl,dbl)@

@:c_calc_ops(oid,oid,oid)@

#define calc_abs(s) ((s)>0)?(s):-(s)
@:calc_unop(ABS,calc_abs,chr)@
@:calc_unop(ABS,calc_abs,sht)@
@:calc_unop(ABS,calc_abs,int)@
@:calc_unop(ABS,calc_abs,flt)@
@:calc_unop(ABS,calc_abs,dbl)@
@:calc_unop(ABS,calc_abs,lng)@

#define calc_inv(s) (1/(s))
@:check_unop(INV,calc_inv,chr)@
@:check_unop(INV,calc_inv,sht)@
@:check_unop(INV,calc_inv,int)@
@:check_unop(INV,calc_inv,flt)@
@:check_unop(INV,calc_inv,dbl)@
@:check_unop(INV,calc_inv,lng)@

#define calc_neg(s) (-(s))
@:calc_unop(NEG,calc_neg,chr)@
@:calc_unop(NEG,calc_neg,sht)@
@:calc_unop(NEG,calc_neg,int)@
@:calc_unop(NEG,calc_neg,flt)@
@:calc_unop(NEG,calc_neg,dbl)@
@:calc_unop(NEG,calc_neg,lng)@
@-
@= calc_length
calc_export str CALClength@1(int *res , @1 *a );
str CALClength@1(int *res , @1 *a ) {
   *res = sizeof(*a);
   return(MAL_SUCCEED);
}
@c

@:calc_length(chr)@
@:calc_length(sht)@
@:calc_length(int)@
@:calc_length(flt)@
@:calc_length(dbl)@
@:calc_length(lng)@

calc_export str CALClengthstr(int *res , str *a );
str CALClengthstr(int *res , str *a ) {
   *res = strlen(*a);
   return(MAL_SUCCEED);
}
@:any_binary_minmax(MIN,<=)@
@:any_binary_minmax(MAX,>)@

@-
@= calc_macrobinop
calc_export str CALCbinary@1@3(@3 *res , @3 *a, @3 *b );
str CALCbinary@1@3(@3 *res , @3 *a, @3 *b ) {
#ifdef DEBUG
	printf( "CALCbinary@1@3\n");
#endif
   if (*a == @3_nil || *b == @3_nil) {
	*res = @3_nil;
   } else {
   	*res = @2 (*a,*b);
   }
   return(MAL_SUCCEED);
}
@c
#define calc_max(s1,s2) ((s1)>(s2))?(s1):(s2)
@:calc_macrobinop(MAX,calc_max,chr)@
@:calc_macrobinop(MAX,calc_max,sht)@
@:calc_macrobinop(MAX,calc_max,int)@
@:calc_macrobinop(MAX,calc_max,oid)@
@:calc_macrobinop(MAX,calc_max,flt)@
@:calc_macrobinop(MAX,calc_max,dbl)@
@:calc_macrobinop(MAX,calc_max,lng)@

#define calc_min(s1,s2) ((s1)<(s2))?(s1):(s2)
@:calc_macrobinop(MIN,calc_min,chr)@
@:calc_macrobinop(MIN,calc_min,sht)@
@:calc_macrobinop(MIN,calc_min,int)@
@:calc_macrobinop(MIN,calc_min,oid)@
@:calc_macrobinop(MIN,calc_min,flt)@
@:calc_macrobinop(MIN,calc_min,dbl)@
@:calc_macrobinop(MIN,calc_min,lng)@

@:check_binop(MOD,%,chr,int,int,int,"Modulo zero is not possible")@
@:check_binop(MOD,%,sht,sht,sht,sht,"Modulo zero is not possible")@
@:check_binop(MOD,%,sht,int,int,int,"Modulo zero is not possible")@
@:check_binop(MOD,%,int,int,int,int,"Modulo zero is not possible")@
@:check_binop(MOD,%,lng,lng,lng,lng,"Modulo zero is not possible")@
@:check_binop(MOD,%,lng,int,int,lng,"Modulo zero is not possible")@
@:check_binop(MOD,%,int,chr,chr,int,"Modulo zero is not possible")@
@:check_binop(MOD,%,int,sht,sht,int,"Modulo zero is not possible")@

/* a % b when a and/or b are float (double) doesn't exist, so provide
   an alternative way of calculating the result */
#undef OP
#define OP(l,op,r)	((l) - (dbl) ((lng) ((l) / (r))) * (r))
@:check_binop(MOD,%,dbl,dbl,dbl,dbl,"Modulo zero is not possible")@
@:check_binop(MOD,%,flt,flt,flt,flt,"Modulo zero is not possible")@

@:c_bitwise_ops(chr)@
@:c_bitwise_ops(sht)@
@:c_bitwise_ops(int)@
@:c_bitwise_ops(lng)@

@:c_shift_ops(chr)@
@:c_shift_ops(sht)@
@:c_shift_ops(int)@

calc_export str CALCstrConcat(str *ret, str *l, str *r);
str
CALCstrConcat(str *ret, str *l, str *r)
{
	str s;

	s = GDKmalloc(strlen(*l) + strlen(*r) + 1);
	strcpy(s, *l);
	strcat(s, *r);
	*ret = s;
	return MAL_SUCCEED;
}

calc_export str CALCstrConcatInt(str *ret, str *l, int *r);
str
CALCstrConcatInt(str *ret, str *l, int *r)
{
	str s;
	int len = strlen(*l) + 32;

	s = GDKmalloc(len);
	snprintf(s, len, "%s%d", *l, *r);
	*ret = s;
	return MAL_SUCCEED;
}

calc_export str CALCbinaryRSHlngint(lng *ret, lng *val, int *shift);
str
CALCbinaryRSHlngint(lng *ret, lng *val, int *shift)
{
	if (*val == lng_nil || *shift == int_nil) {
		*ret = lng_nil;
	} else {
		*ret = *val >> *shift;
	}
	return MAL_SUCCEED;
}

calc_export str CALCbinaryLSHlngint(lng *ret, lng *val, int *shift);
str
CALCbinaryLSHlngint(lng *ret, lng *val, int *shift)
{
	if (*val == lng_nil || *shift == int_nil) {
		*ret = lng_nil;
	} else {
		*ret = *val << *shift;
	}
	return MAL_SUCCEED;
}

calc_export str CALCbinaryANDbit(bit *retval, bit *v1, bit *v2);
str
CALCbinaryANDbit(bit *retval, bit *v1, bit *v2)
{
	if (*v1 == FALSE || *v2 == FALSE) {
		*retval = FALSE;
	} else if (*v1 == bit_nil || *v2 == bit_nil) {
		*retval = bit_nil;
	} else {
		*retval = TRUE;
	}
	return MAL_SUCCEED;
}

calc_export str CALCbinaryORbit(bit *retval, bit *v1, bit *v2);
str
CALCbinaryORbit(bit *retval, bit *v1, bit *v2)
{
	if (*v1 && *v1 != bit_nil) {
		*retval = TRUE;
	} else if (*v2 && *v2 != bit_nil) {
		*retval = TRUE;
	} else if (*v1 == bit_nil || *v2 == bit_nil) {
		*retval = bit_nil;
	} else {
		*retval = *v1 || *v2;
	}
	return MAL_SUCCEED;
}

calc_export str CALCbinaryXORbit(bit *retval, bit *v1, bit *v2);
str
CALCbinaryXORbit(bit *retval, bit *v1, bit *v2)
{
	if (*v1 == bit_nil || *v2 == bit_nil) {
		*retval = bit_nil;
	} else {
		*retval = ((*v1 && *v2 == FALSE) || (*v1 == FALSE && *v2));
	}
	return MAL_SUCCEED;
}

calc_export str CALCunarybitNOT(bit *retval, bit *value);
str
CALCunarybitNOT(bit *retval, bit *value)
{
	if (*value == bit_nil) {
		*retval = bit_nil;
	} else {
		*retval = (*value) ? FALSE : TRUE;
	}
	return MAL_SUCCEED;
}

/*
calc_export str CALCswitchbit(ptr retval, bit *b, ptr v1, ptr v2);
str
*/
calc_export str CALCswitchbit(MalBlkPtr mb, MalStkPtr stk, InstrPtr p);
str 
CALCswitchbit(MalBlkPtr mb, MalStkPtr stk, InstrPtr P)
{
	ptr p;
	ptr retval = getArgReference(stk,P,0);
	bit b = *(bit*) getArgReference(stk,P,1);
	int t1 = getArgType(mb, P, 2);
	int t2 = getArgType(mb, P, 3);

	if (t1 != t2)
		throw(MAL, "ifthenelse", "types should match\n");

	if (b == bit_nil) {
		p = ATOMnilptr(t1);
		throw(MAL, "ifthenelse", "cannot switch on nil value\n");
	} else if (b) {
		p = getArgReference(stk,P,2);
	} else {
		p = getArgReference(stk,P,3);
	}
	if (ATOMextern(t1)) {
		*(ptr **) retval = ATOMdup(t1, *(ptr**)p);
	} else {
		memcpy(retval, p, ATOMsize(t1));
	}
	return MAL_SUCCEED;
}


@-
The @emph{c_comp} and @emph{c_comp_ops} macros implement the mil comparison 
operations.

@= any_binary_minmax
calc_export str CALCbinary@1any(ptr ret, ptr v1, int t, ptr v2);
str CALCbinary@1any(ptr ret, ptr v1, int t, ptr v2){
	int (*cmp)(ptr,ptr) = BATatoms[t].atomCmp;
	ptr src, nil = ATOMnilptr(t);
	if ((*cmp)(v1, nil) == 0 || (*cmp)(v2, nil) == 0) {
		src = nil;
	} else {
		src = ((*cmp)(v1, v2) @2 0)?v1:v2;
	}
	if (ATOMextern(t)) {
		int s = ATOMlen(t, src);
		str buf = *(str*) ret = (char*) GDKmalloc(s);
		memcpy(buf, src, s);
	} else {
		memcpy(ret, src, ATOMsize(t));
	}
	return MAL_SUCCEED;
}

@= c_comp_op
calc_export str CALCcomp@4@2@3(bit *retval, @2 *v1, @3 *v2);
str CALCcomp@4@2@3(bit *retval, @2 *v1, @3 *v2){
	if (*v1 == @2_nil || *v2 == @3_nil) {
		*retval = bit_nil;
	} else {
		*retval = *v1 @1 *v2;	
	}
	return MAL_SUCCEED;
}
@= c_comp_ops
		@:c_comp_op(@1,oid,oid,@2)@
		@:c_comp_op(@1,flt,flt,@2)@
		@:c_comp_op(@1,flt,dbl,@2)@
		@:c_comp_op(@1,dbl,dbl,@2)@

		@:c_comp_op(@1,chr,chr,@2)@
		@:c_comp_op(@1,chr,sht,@2)@
		@:c_comp_op(@1,chr,int,@2)@
		@:c_comp_op(@1,chr,lng,@2)@

		@:c_comp_op(@1,bit,bit,@2)@
		@:c_comp_op(@1,bit,chr,@2)@
		@:c_comp_op(@1,bit,sht,@2)@
		@:c_comp_op(@1,bit,int,@2)@
		@:c_comp_op(@1,bit,lng,@2)@

		@:c_comp_op(@1,sht,chr,@2)@
		@:c_comp_op(@1,sht,sht,@2)@
		@:c_comp_op(@1,sht,int,@2)@
		@:c_comp_op(@1,sht,lng,@2)@

		@:c_comp_op(@1,int,chr,@2)@
		@:c_comp_op(@1,int,sht,@2)@
		@:c_comp_op(@1,int,int,@2)@
		@:c_comp_op(@1,int,lng,@2)@

		@:c_comp_op(@1,lng,chr,@2)@
		@:c_comp_op(@1,lng,sht,@2)@
		@:c_comp_op(@1,lng,int,@2)@
		@:c_comp_op(@1,lng,lng,@2)@

calc_export str CALCcomp@2strstr(bit *retval, str *s1, str *s2);
str CALCcomp@2strstr(bit *retval, str *s1, str *s2){
	if (strNil(*s1) || strNil(*s2)) {
		*retval = bit_nil; 
	} else {
		*retval = (strcmp(*s1,*s2) @1 0);
	}
	return MAL_SUCCEED;
}
calc_export str CALCcomp@2any(bit *retval, ptr *v1, int tpe, ptr *v2);
str CALCcomp@2any(bit *retval, ptr *v1, int tpe, ptr *v2){
	int (*cmp)(ptr,ptr) = BATatoms[tpe].atomCmp;
	ptr nil = ATOMnilptr(tpe);

	if ((*cmp)(*v1, nil) == 0 || (*cmp)(*v2, nil) == 0) {
		*retval = bit_nil; 
	} else {
		*retval = ((*cmp)( *v1, *v2) @1 0);
	}
	return MAL_SUCCEED;
}
@c
@:c_between_op(chr)@
@:c_between_op(sht)@
@:c_between_op(int)@
@:c_between_op(oid)@
@:c_between_op(flt)@
@:c_between_op(dbl)@
@:c_between_op(lng)@
calc_export str CALCcompBetweenstr(bit *retval, str *val, str *low, str *high);
str
CALCcompBetweenstr(bit *retval, str *val, str *low, str *high)
{
	int val_nil = strNil(*val);
	int low_nil = strNil(*low);
	int high_nil = strNil(*high);

	if (val_nil || (low_nil && high_nil)) {
		*retval = bit_nil;
	} else if (low_nil) {
		*retval = (strcmp(*val, *high) <= 0);
	} else if (high_nil) {
		*retval = (strcmp(*low, *val) <= 0);
	} else {
		*retval = (strcmp(*low, *val) <= 0 && strcmp(*val, *high) <= 0);
	}
	return MAL_SUCCEED;
}

calc_export str CALCcompBetweenany(bit *retval, ptr *val, int tpe, ptr *low, ptr *high);
str
CALCcompBetweenany(bit *retval, ptr *val, int tpe, ptr *low, ptr *high)
{
	int (*cmp) (ptr, ptr) = BATatoms[tpe].atomCmp;
	ptr nilptr = ATOMnilptr(tpe);
	int val_nil = ((*cmp) (*val, nilptr) == 0);
	int low_nil = ((*cmp) (*low, nilptr) == 0);
	int high_nil = ((*cmp) (*high, nilptr) == 0);

	if (val_nil || (low_nil && high_nil)) {
		*retval = bit_nil;
	} else if (low_nil) {
		*retval = ((*cmp) (*val, *high) <= 0);
	} else if (high_nil) {
		*retval = ((*cmp) (*low, *val) <= 0);
	} else {
		*retval = ((*cmp) (*low, *val) <= 0 && (*cmp) (*val, *high) <= 0);
	}
	return MAL_SUCCEED;
}

@= c_isnil
calc_export str CALCisnil_@1(bit *retval, @1 *val);
str CALCisnil_@1(bit *retval, @1 *val) {
	*retval = (*val == @1_nil);
	return MAL_SUCCEED;
}
calc_export str CALCisnotnil_@1(bit *retval, @1 *val);
str CALCisnotnil_@1(bit *retval, @1 *val) {
	*retval = (*val != @1_nil);
	return MAL_SUCCEED;
}
calc_export str CALCnil2@1(@1 *retval, ptr val);
str CALCnil2@1(@1 *retval, ptr val){
	(void) val;/* fool compiler */
	memcpy(retval, ATOMnilptr(TYPE_@1), ATOMsize(TYPE_@1));
	return MAL_SUCCEED;
}
@c
@:c_isnil(bit)@