This is COWSMathLibrary.m in view mode; [Download] [Up]
#import <stdio.h>
#import <math.h>
#import "COWSMathLibrary.h"
@implementation COWSMathLibrary
#define ERRBFLEN 128
// changed by Sean
char *needs1 = "Needs exactly one argument";
char *needs2 = "Needs exactly two argument";
static id
COWSMathErr(id result, const char *fname, const char *errmes)
{
char buf[ERRBFLEN];
if (NULL == errmes)
sprintf(buf, "%s: %s", fname, strerror(errno));
else
sprintf(buf, "%s %s", fname, errmes);
[result setString: buf];
[result setError: YES];
return result;
}
- math_acos: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:acos([arg doubleVal])];
if (errno) { // set by acos if error occurred
result = COWSMathErr(result, "Acos", NULL);
}
}
else {
result = COWSMathErr(result, "Acos", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_asin: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:asin([arg doubleVal])];
if (errno) { // set by asin if error occurred
result = COWSMathErr(result, "Asin", NULL);
}
}
else {
result = COWSMathErr(result, "Asin", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_atan: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:atan([arg doubleVal])];
if (errno) { // set by atan if error occurred
result = COWSMathErr(result, "Atan", NULL);
}
}
else {
result = COWSMathErr(result, "Atan", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_atan2: arg_list {
id result=[[COWSStringNode alloc] init];
id arg1 = [arg_list pop];
id arg2 = [arg_list pop];
if(arg1 && arg2 && ![arg_list top]) {
// arg_list should be empty after first 2 parameters
errno = 0;
[result setDoubleVal:atan2([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by atan2 if error occurred
result = COWSMathErr(result, "Atan2", NULL);
}
}
else {
result = COWSMathErr(result, "Atan2", needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_cos: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:cos([arg doubleVal])];
if (errno) { // set by cos if error occurred
result = COWSMathErr(result, "Cos", NULL);
}
}
else {
result = COWSMathErr(result, "Cos", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_sin: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:sin([arg doubleVal])];
if (errno) { // set by sin if error occurred
result = COWSMathErr(result, "Sin", NULL);
}
}
else {
result = COWSMathErr(result, "Sin", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_tan: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:tan([arg doubleVal])];
if (errno) { // set by tan if error occurred
result = COWSMathErr(result, "Tan", NULL);
}
}
else {
result = COWSMathErr(result, "Tan", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_cosh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:cosh([arg doubleVal])];
if (errno) { // set by cosh if error occurred
result = COWSMathErr(result, "Cosh", NULL);
}
}
else {
result = COWSMathErr(result, "Cosh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_sinh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:sinh([arg doubleVal])];
if (errno) { // set by sinh if error occurred
result = COWSMathErr(result, "Sinh", NULL);
}
}
else {
result = COWSMathErr(result, "Sinh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_tanh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:tanh([arg doubleVal])];
if (errno) { // set by tanh if error occurred
result = COWSMathErr(result, "Tanh", NULL);
}
}
else {
result = COWSMathErr(result, "Tanh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_exp: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:exp([arg doubleVal])];
if (errno) { // set by exp if error occurred
result = COWSMathErr(result, "Exp", NULL);
}
}
else {
result = COWSMathErr(result, "Exp", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_ldexp: arg_list {
id result=[[COWSStringNode alloc] init];
id arg1 = [arg_list pop];
id arg2 = [arg_list pop];
if(arg1 && arg2 && ![arg_list top]) {
// arg_list should be empty after first 2 parameters
errno = 0;
[result setDoubleVal:ldexp([arg1 doubleVal], [arg2 intVal])];
if (errno) { // set by ldexp if error occurred
result = COWSMathErr(result, "Ldexp", NULL);
}
}
else {
result = COWSMathErr(result, "Ldexp", needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_log: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:log([arg doubleVal])];
if (errno) { // set by log if error occurred
result = COWSMathErr(result, "Log", NULL);
}
}
else {
result = COWSMathErr(result, "Log", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_log10: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:log10([arg doubleVal])];
if (errno) { // set by log10 if error occurred
result = COWSMathErr(result, "Log10", NULL);
}
}
else {
result = COWSMathErr(result, "Log10", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_pow: arg_list {
id result=[[COWSStringNode alloc] init];
id arg1 = [arg_list pop];
id arg2 = [arg_list pop];
if(arg1 && arg2 && ![arg_list top]) {
// arg_list should be empty after first 2 parameters
errno = 0;
[result setDoubleVal:pow([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by pow if error occurred
result = COWSMathErr(result, "Pow", NULL);
}
}
else {
result = COWSMathErr(result, "Pow", needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_sqrt: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:sqrt([arg doubleVal])];
if (errno) { // set by sqrt if error occurred
result = COWSMathErr(result, "Sqrt", NULL);
}
}
else {
result = COWSMathErr(result, "Sqrt", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_ceil: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:ceil([arg doubleVal])];
if (errno) { // set by ceil if error occurred
result = COWSMathErr(result, "Ceil", NULL);
}
}
else {
result = COWSMathErr(result, "Ceil", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_fabs: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:fabs([arg doubleVal])];
if (errno) { // set by fabs if error occurred
result = COWSMathErr(result, "Fabs", NULL);
}
}
else {
result = COWSMathErr(result, "Fabs", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_floor: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:floor([arg doubleVal])];
if (errno) { // set by floor if error occurred
result = COWSMathErr(result, "Floor", NULL);
}
}
else {
result = COWSMathErr(result, "Floor", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_fmod: arg_list {
id result=[[COWSStringNode alloc] init];
id arg1 = [arg_list pop];
id arg2 = [arg_list pop];
if(arg1 && arg2 && ![arg_list top]) {
// arg_list should be empty after first 2 parameters
errno = 0;
[result setDoubleVal:fmod([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by fmod if error occurred
result = COWSMathErr(result, "Fmod", NULL);
}
}
else {
result = COWSMathErr(result, "Fmod", needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_asinh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:asinh([arg doubleVal])];
if (errno) { // set by asinh if error occurred
result = COWSMathErr(result, "Asinh", NULL);
}
}
else {
result = COWSMathErr(result, "Asinh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_acosh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:acosh([arg doubleVal])];
if (errno) { // set by acosh if error occurred
result = COWSMathErr(result, "Acosh", NULL);
}
}
else {
result = COWSMathErr(result, "Acosh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_atanh: arg_list {
id result=[[COWSStringNode alloc] init];
id arg = [arg_list pop];
if(arg && ![arg_list top]) {
// arg_list should be empty after first parameter
errno = 0;
[result setDoubleVal:atanh([arg doubleVal])];
if (errno) { // set by atanh if error occurred
result = COWSMathErr(result, "Atanh", NULL);
}
}
else {
result = COWSMathErr(result, "Atanh", needs1);
}
if (NULL != arg)
[arg free];
return result;
}
// From here on down I've either cut out stuff, made changes, or added.
// Sean Luke, May 14
#define COWSMATHLIBRARY_PI 3.141592653589793238462643383279502884197
#define COWSMATHLIBRARY_E 2.718281828459045235360287471352662497757
// these is defined to 40 decimal places
- math_pi: arg_list {
id result=[[COWSStringNode alloc] init];
[result setDoubleVal: COWSMATHLIBRARY_PI];
return result;
}
- math_e: arg_list {
id result=[[COWSStringNode alloc] init];
[result setDoubleVal: COWSMATHLIBRARY_E];
return result;
}
- math_rand: arg_list {
id result=[[COWSStringNode alloc] init];
double random=(double)rand();
random/=(double)RAND_MAX;
[result setDoubleVal: random]; // so 0 <= random <= 1
return result;
}
- math_round: arg_list {
id result=[[COWSStringNode alloc] init];
id value;
double val;
if ((value=[arg_list top])==NULL)
return COWSMathErr(result, "round", needs1);
val=[value doubleVal];
if (val-floor(val)>.5) val=ceil(val);
else val=floor(val);
[result setDoubleVal:val];
return result;
}
- math_strip: arg_list {
id result=[[COWSStringNode alloc] init];
id value;
double val;
if ((value=[arg_list top])==NULL)
return COWSMathErr(result, "round", needs1);
val=[value doubleVal];
if (val>0) val=floor(val);
else val=ceil(val);
[result setDoubleVal:val];
return result;
}
- math_max: arg_list {
id result=[[COWSStringNode alloc] init];
id value;
double max;
double new;
[arg_list first];
if ((value=[arg_list now])==NULL)
return COWSMathErr(result, "round", needs1);
max=[value doubleVal];
while ([arg_list next]!=NULL)
{
new=[[arg_list now] doubleVal];
max= (max > new ? max : new);
}
[result setDoubleVal:max];
return result;
}
- math_min: arg_list {
id result=[[COWSStringNode alloc] init];
id value;
double min;
double new;
[arg_list first];
if ((value=[arg_list now])==NULL)
return COWSMathErr(result, "round", needs1);
min=[value doubleVal];
while ([arg_list next]!=NULL)
{
new=[[arg_list now] doubleVal];
min= (min < new ? min : new);
}
[result setDoubleVal:min];
return result;
}
- math_ge:arg_list // numerically compares the first
// value against all the other values.
// if it is greater or equal, returns t.
// returns f if there are no values,
// or in any other situation.
{
double first;
BOOL success=YES;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=[current doubleVal];
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (first<[current doubleVal])
{
success=NO;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
return return_val;
}
- math_le:arg_list // numerically compares the first
// value against all the other values.
// if it is smaller or equal, returns t.
// returns f if there are no values,
// or in any other situation.
{
double first;
BOOL success=YES;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=[current doubleVal];
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (first>[current doubleVal])
{
success=NO;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
return return_val;
}
- math_factorial: arg_list
{
id result=[[COWSStringNode alloc] init];
int x;
int max_val;
id value;
double total=1.0;
if ((value=[arg_list top])==NULL)
return COWSMathErr(result, "!", needs1);
max_val=[value intVal];
if (max_val<0) return
COWSMathErr(result,"!","Can't factorialize a negative number");
if (max_val==0)
{
[result setDoubleVal:1.0]; // by definition
return result;
}
// this function could go on for a VERY VERY long time accidentally.
// So I have it check for user abort every 100 multiplies.
for (x=1;x<=max_val;x++)
{
if ( !(x%100) && NXUserAborted() )
return COWSMathErr(result,"!","Factorialization cancelled");
total*=(double)x; // must be double because ! rises very fast
}
[result setDoubleVal:total];
return result;
}
- loadLibrary:sender {
id result = [super loadLibrary:sender];
// seed random number generator
srand((int)time(NULL)); // based on time of day
if (![sender conformsTo:@protocol(LibraryControl)]) {
puts ("MathLibrary error: "
"Interpreter doesn't conform to LibraryControl!");
return NULL;
}
[sender addLibraryFunction: "acos"
selector:@selector(math_acos:)
target:self];
[sender addLibraryFunction: "asin"
selector:@selector(math_asin:)
target:self];
[sender addLibraryFunction: "atan"
selector:@selector(math_atan:)
target:self];
[sender addLibraryFunction: "atan2"
selector:@selector(math_atan2:)
target:self];
[sender addLibraryFunction: "cos"
selector:@selector(math_cos:)
target:self];
[sender addLibraryFunction: "sin"
selector:@selector(math_sin:)
target:self];
[sender addLibraryFunction: "tan"
selector:@selector(math_tan:)
target:self];
[sender addLibraryFunction: "cosh"
selector:@selector(math_cosh:)
target:self];
[sender addLibraryFunction: "sinh"
selector:@selector(math_sinh:)
target:self];
[sender addLibraryFunction: "tanh"
selector:@selector(math_tanh:)
target:self];
[sender addLibraryFunction: "log"
selector:@selector(math_log:)
target:self];
[sender addLibraryFunction: "log-10"
selector:@selector(math_log10:)
target:self];
[sender addLibraryFunction: "^"
selector:@selector(math_pow:)
target:self];
[sender addLibraryFunction: "square-root"
selector:@selector(math_sqrt:)
target:self];
[sender addLibraryFunction: "ceiling"
selector:@selector(math_ceil:)
target:self];
[sender addLibraryFunction: "abs"
selector:@selector(math_fabs:)
target:self];
[sender addLibraryFunction: "floor"
selector:@selector(math_floor:)
target:self];
[sender addLibraryFunction: "mod"
selector:@selector(math_fmod:)
target:self];
[sender addLibraryFunction: "asinh"
selector:@selector(math_asinh:)
target:self];
[sender addLibraryFunction: "acosh"
selector:@selector(math_acosh:)
target:self];
[sender addLibraryFunction: "atanh"
selector:@selector(math_atanh:)
target:self];
[sender addLibraryFunction: "pi"
selector:@selector(math_pi:)
target:self];
[sender addLibraryFunction: "e"
selector:@selector(math_e:)
target:self];
[sender addLibraryFunction: "!"
selector:@selector(math_factorial:)
target:self];
[sender addLibraryFunction: "random"
selector:@selector(math_rand:)
target:self];
[sender addLibraryFunction: "round"
selector:@selector(math_round:)
target:self];
[sender addLibraryFunction: "strip"
selector:@selector(math_strip:)
target:self];
[sender addLibraryFunction: "min"
selector:@selector(math_min:)
target:self];
[sender addLibraryFunction: "max"
selector:@selector(math_max:)
target:self];
[sender addLibraryFunction: ">="
selector:@selector(math_ge:)
target:self];
[sender addLibraryFunction: "<="
selector:@selector(math_le:)
target:self];
return result;
}
@end
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.