This is COWSExtendedMathLibrary.m in view mode; [Download] [Up]
#import <stdio.h>
#import <math.h>
#import "COWSExtendedMathLibrary.h"
@implementation COWSExtendedMathLibrary
#define ERRBFLEN 128
char *ext_needs1 = "ext_needs exactly one parameter";
char *ext_needs2 = "ext_needs exactly two parameters";
static id
COWSExtendedMathErr(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_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 = COWSExtendedMathErr(result, "exp", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "exp", ext_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 = COWSExtendedMathErr(result, "ldexp", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "ldexp", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_hypot: 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:hypot([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by hypot if error occurred
result = COWSExtendedMathErr(result, "hypot", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "hypot", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_cbrt: 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:cbrt([arg doubleVal])];
if (errno) { // set by cbrt if error occurred
result = COWSExtendedMathErr(result, "cbrt", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "cbrt", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_expm1: 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:expm1([arg doubleVal])];
if (errno) { // set by expm1 if error occurred
result = COWSExtendedMathErr(result, "expm1", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "expm1", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_log1p: 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:log1p([arg doubleVal])];
if (errno) { // set by log1p if error occurred
result = COWSExtendedMathErr(result, "log1p", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "log1p", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_lgamma: 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:lgamma([arg doubleVal])];
if (errno) { // set by lgamma if error occurred
result = COWSExtendedMathErr(result, "lgamma", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "lgamma", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_rint: 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:rint([arg doubleVal])];
if (errno) { // set by rint if error occurred
result = COWSExtendedMathErr(result, "rint", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "rint", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_erf: 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:erf([arg doubleVal])];
if (errno) { // set by erf if error occurred
result = COWSExtendedMathErr(result, "erf", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "erf", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_erfc: 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:erfc([arg doubleVal])];
if (errno) { // set by erfc if error occurred
result = COWSExtendedMathErr(result, "erfc", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "erfc", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_j0: 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:j0([arg doubleVal])];
if (errno) { // set by j0 if error occurred
result = COWSExtendedMathErr(result, "j0", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "j0", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_j1: 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:j1([arg doubleVal])];
if (errno) { // set by j1 if error occurred
result = COWSExtendedMathErr(result, "j1", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "j1", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_jn: 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:jn([arg1 intVal], [arg2 doubleVal])];
if (errno) { // set by jn if error occurred
result = COWSExtendedMathErr(result, "jn", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "jn", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_y0: 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:y0([arg doubleVal])];
if (errno) { // set by y0 if error occurred
result = COWSExtendedMathErr(result, "y0", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "y0", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_y1: 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:y1([arg doubleVal])];
if (errno) { // set by y1 if error occurred
result = COWSExtendedMathErr(result, "y1", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "y1", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_yn: 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:yn([arg1 intVal], [arg2 doubleVal])];
if (errno) { // set by yn if error occurred
result = COWSExtendedMathErr(result, "yn", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "yn", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_copysign: 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:copysign([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by copysign if error occurred
result = COWSExtendedMathErr(result, "copy-sign", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "copy-sign", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_drem: 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:drem([arg1 doubleVal], [arg2 doubleVal])];
if (errno) { // set by drem if error occurred
result = COWSExtendedMathErr(result, "drem", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "drem", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- math_logb: 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:logb([arg doubleVal])];
if (errno) { // set by logb if error occurred
result = COWSExtendedMathErr(result, "logb", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "logb", ext_needs1);
}
if (NULL != arg)
[arg free];
return result;
}
- math_scalb: 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:scalb([arg1 doubleVal], [arg2 intVal])];
if (errno) { // set by scalb if error occurred
result = COWSExtendedMathErr(result, "scalb", NULL);
}
}
else {
result = COWSExtendedMathErr(result, "scalb", ext_needs2);
}
if (NULL != arg1)
[arg1 free];
if (NULL != arg2)
[arg2 free];
return result;
}
- loadLibrary:sender {
id result = [super loadLibrary:sender];
if (![sender conformsTo:@protocol(LibraryControl)]) {
puts ("MathLibrary error: "
"Interpreter doesn't conform to LibraryControl!");
return NULL;
}
[sender addLibraryFunction: "exp"
selector:@selector(math_exp:)
target:self];
[sender addLibraryFunction: "ldexp"
selector:@selector(math_ldexp:)
target:self];
[sender addLibraryFunction: "hypot"
selector:@selector(math_hypot:)
target:self];
[sender addLibraryFunction: "cbrt"
selector:@selector(math_cbrt:)
target:self];
[sender addLibraryFunction: "expm1"
selector:@selector(math_expm1:)
target:self];
[sender addLibraryFunction: "log1p"
selector:@selector(math_log1p:)
target:self];
[sender addLibraryFunction: "lgamma"
selector:@selector(math_lgamma:)
target:self];
[sender addLibraryFunction: "rint"
selector:@selector(math_rint:)
target:self];
[sender addLibraryFunction: "erf"
selector:@selector(math_erf:)
target:self];
[sender addLibraryFunction: "erfc"
selector:@selector(math_erfc:)
target:self];
[sender addLibraryFunction: "j0"
selector:@selector(math_j0:)
target:self];
[sender addLibraryFunction: "j1"
selector:@selector(math_j1:)
target:self];
[sender addLibraryFunction: "jn"
selector:@selector(math_jn:)
target:self];
[sender addLibraryFunction: "y0"
selector:@selector(math_y0:)
target:self];
[sender addLibraryFunction: "y1"
selector:@selector(math_y1:)
target:self];
[sender addLibraryFunction: "yn"
selector:@selector(math_yn:)
target:self];
[sender addLibraryFunction: "copy-sign"
selector:@selector(math_copysign:)
target:self];
[sender addLibraryFunction: "drem"
selector:@selector(math_drem:)
target:self];
[sender addLibraryFunction: "logb"
selector:@selector(math_logb:)
target:self];
[sender addLibraryFunction: "scalb"
selector:@selector(math_scalb:)
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.