├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── docs ├── usage1.png ├── usage10.png ├── usage11.png ├── usage12.png ├── usage13.png ├── usage14.png ├── usage15.png ├── usage15a.png ├── usage16.png ├── usage17.png ├── usage17a.png ├── usage17a1.png ├── usage17b.png ├── usage17c.png ├── usage18.png ├── usage19.png ├── usage2.png ├── usage20.png ├── usage21.png ├── usage22.png ├── usage23.png ├── usage24.png ├── usage3.png ├── usage4.png ├── usage5.png ├── usage6.png ├── usage7.png ├── usage8.png └── usage9.png ├── eigensup.txt ├── libfromcasio.a ├── logo.xcf ├── monoicon.eActIcon ├── selected.bmp ├── src ├── aboutGUI.cpp ├── aboutGUI.hpp ├── abs.cpp ├── add.cpp ├── adj.cpp ├── alloc.cpp ├── append.cpp ├── arccos.cpp ├── arccosh.cpp ├── arcsin.cpp ├── arcsinh.cpp ├── arctan.cpp ├── arctanh.cpp ├── arg.cpp ├── atomize.cpp ├── bake.cpp ├── besselj.cpp ├── bessely.cpp ├── bignum.cpp ├── binomial.cpp ├── catalogGUI.cpp ├── catalogGUI.hpp ├── ceiling.cpp ├── choose.cpp ├── circexp.cpp ├── clear.cpp ├── clock.cpp ├── coeff.cpp ├── cofactor.cpp ├── condense.cpp ├── conj.cpp ├── cons.cpp ├── constantsProvider.hpp ├── contract.cpp ├── cos.cpp ├── cosh.cpp ├── dConsole.cpp ├── dConsole.h ├── data.cpp ├── decomp.cpp ├── define.cpp ├── defint.cpp ├── defs.h ├── degree.cpp ├── denominator.cpp ├── derivative.cpp ├── det.cpp ├── dirac.cpp ├── display.cpp ├── distill.cpp ├── divisors.cpp ├── dpow.cpp ├── draw.cpp ├── dsolve.cpp ├── eigen.cpp ├── erf.cpp ├── erfc.cpp ├── eval.cpp ├── expand.cpp ├── expcos.cpp ├── expsin.cpp ├── factor.cpp ├── factorial.cpp ├── factorpoly.cpp ├── factors.cpp ├── fileGUI.cpp ├── fileGUI.hpp ├── fileProvider.cpp ├── fileProvider.hpp ├── filter.cpp ├── find.cpp ├── finetiming.cpp ├── float.cpp ├── floor.cpp ├── for.cpp ├── gamma.cpp ├── gcd.cpp ├── graphicsProvider.cpp ├── graphicsProvider.hpp ├── guess.cpp ├── hermite.cpp ├── hilbert.cpp ├── history.cpp ├── imag.cpp ├── incrdivpoly.cpp ├── index.cpp ├── init.cpp ├── inner.cpp ├── inputGUI.cpp ├── inputGUI.hpp ├── integral.cpp ├── inv.cpp ├── is.cpp ├── isprime.cpp ├── itab.cpp ├── itest.cpp ├── laguerre.cpp ├── laplace.cpp ├── lcm.cpp ├── leading.cpp ├── legendre.cpp ├── limit.cpp ├── list.cpp ├── log.cpp ├── madd.cpp ├── mag.cpp ├── main.cpp ├── mcmp.cpp ├── memmgr.c ├── memmgr.h ├── menuGUI.cpp ├── menuGUI.hpp ├── mfactor.cpp ├── mgcd.cpp ├── misc.cpp ├── mmodpow.cpp ├── mmul.cpp ├── mod.cpp ├── mpow.cpp ├── mprime.cpp ├── mroot.cpp ├── mscan.cpp ├── msqrt.cpp ├── mstr.cpp ├── multiply.cpp ├── nroots.cpp ├── numerator.cpp ├── outer.cpp ├── partition.cpp ├── polar.cpp ├── pollard.cpp ├── power.cpp ├── prime.cpp ├── primetab.cpp ├── print.cpp ├── product.cpp ├── prototypes.h ├── qadd.cpp ├── qdiv.cpp ├── qmul.cpp ├── qpow.cpp ├── qsub.cpp ├── quickfactor.cpp ├── quotient.cpp ├── random.cpp ├── rationalize.cpp ├── real.cpp ├── rect.cpp ├── rewrite.cpp ├── roots.cpp ├── run.cpp ├── scan.cpp ├── setjmp.h ├── sgn.cpp ├── simfac.cpp ├── simplify.cpp ├── sin.cpp ├── sinh.cpp ├── stack.cpp ├── stdafx.h ├── stringsProvider.cpp ├── stringsProvider.hpp ├── subst.cpp ├── sum.cpp ├── symbol.cpp ├── tan.cpp ├── tanh.cpp ├── taylor.cpp ├── tensor.cpp ├── test-script.txt ├── test.cpp ├── textGUI.cpp ├── textGUI.hpp ├── transform.cpp ├── transpose.cpp ├── userfunc.cpp ├── variables.cpp ├── vectorize.cpp ├── versionProvider.cpp ├── versionProvider.hpp └── zero.cpp └── unselected.bmp /.gitignore: -------------------------------------------------------------------------------- 1 | # Compiled source # 2 | ################### 3 | *.com 4 | *.class 5 | *.dll 6 | *.exe 7 | *.o 8 | *.so 9 | *.d 10 | *.bin 11 | *.g3a 12 | 13 | # Packages # 14 | ############ 15 | # it's better to unpack these files and commit the raw source 16 | # git has its own built in compression methods 17 | *.7z 18 | *.dmg 19 | *.gz 20 | *.iso 21 | *.jar 22 | *.rar 23 | *.tar 24 | *.zip 25 | 26 | # Logs and databases # 27 | ###################### 28 | *.log 29 | *.sql 30 | *.sqlite 31 | 32 | # OS generated files # 33 | ###################### 34 | .DS_Store 35 | .DS_Store? 36 | ._* 37 | .Spotlight-V100 38 | .Trashes 39 | Icon? 40 | ehthumbs.db 41 | Thumbs.db 42 | *~ 43 | .directory 44 | 45 | .tags 46 | .tags_sorted_by_file 47 | -------------------------------------------------------------------------------- /docs/usage1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage1.png -------------------------------------------------------------------------------- /docs/usage10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage10.png -------------------------------------------------------------------------------- /docs/usage11.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage11.png -------------------------------------------------------------------------------- /docs/usage12.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage12.png -------------------------------------------------------------------------------- /docs/usage13.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage13.png -------------------------------------------------------------------------------- /docs/usage14.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage14.png -------------------------------------------------------------------------------- /docs/usage15.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage15.png -------------------------------------------------------------------------------- /docs/usage15a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage15a.png -------------------------------------------------------------------------------- /docs/usage16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage16.png -------------------------------------------------------------------------------- /docs/usage17.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage17.png -------------------------------------------------------------------------------- /docs/usage17a.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage17a.png -------------------------------------------------------------------------------- /docs/usage17a1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage17a1.png -------------------------------------------------------------------------------- /docs/usage17b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage17b.png -------------------------------------------------------------------------------- /docs/usage17c.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage17c.png -------------------------------------------------------------------------------- /docs/usage18.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage18.png -------------------------------------------------------------------------------- /docs/usage19.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage19.png -------------------------------------------------------------------------------- /docs/usage2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage2.png -------------------------------------------------------------------------------- /docs/usage20.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage20.png -------------------------------------------------------------------------------- /docs/usage21.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage21.png -------------------------------------------------------------------------------- /docs/usage22.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage22.png -------------------------------------------------------------------------------- /docs/usage23.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage23.png -------------------------------------------------------------------------------- /docs/usage24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage24.png -------------------------------------------------------------------------------- /docs/usage3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage3.png -------------------------------------------------------------------------------- /docs/usage4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage4.png -------------------------------------------------------------------------------- /docs/usage5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage5.png -------------------------------------------------------------------------------- /docs/usage6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage6.png -------------------------------------------------------------------------------- /docs/usage7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage7.png -------------------------------------------------------------------------------- /docs/usage8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage8.png -------------------------------------------------------------------------------- /docs/usage9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/docs/usage9.png -------------------------------------------------------------------------------- /eigensup.txt: -------------------------------------------------------------------------------- 1 | logab(a,b)=log(b)/log(a) 2 | log10(x)=log(x)/log(10) 3 | ln(x)=log(x) 4 | cis(x)=cos(x)+i*sin(x) 5 | cot(x)=1/tan(x) 6 | coth(x)=cosh(x)/sinh(x) 7 | arccot(x)=arctan(1/x) 8 | arccoth(x)=arctanh(1/x) 9 | sec(x)=1/cos(x) 10 | sech(x)=1/cosh(x) 11 | arcsec(x)=arccos(1/x) 12 | arcsech(x)=arccosh(1/x) 13 | csc(x)=1/sin(x) 14 | csch(x)=1/sinh(x) 15 | arccsc(x)=arcsin(1/x) 16 | arccsch(x)=arcsinh(1/x) 17 | npr(n,r)=(n!)/(n-r)! 18 | ncr(n,r)=n!/(r!(n-r)!) 19 | xor(x,y)=or(and(x,not(y)),and(not(x),y)) 20 | prizmUIhandleKeys=1 21 | prizmUIkeyHandler(k,s)=(test( 22 | k=30011,clear, 23 | k=30014,draw, 24 | k=149,log10(last), 25 | k=181,10^last, 26 | k=155,last^(-1), 27 | nil)) 28 | prizmUIfkey3label=329 29 | prizmUIfkey6label=563 -------------------------------------------------------------------------------- /libfromcasio.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/libfromcasio.a -------------------------------------------------------------------------------- /logo.xcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/logo.xcf -------------------------------------------------------------------------------- /monoicon.eActIcon: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/monoicon.eActIcon -------------------------------------------------------------------------------- /selected.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/selected.bmp -------------------------------------------------------------------------------- /src/aboutGUI.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __ABOUTGUI_H 2 | #define __ABOUTGUI_H 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | void showAbout(); 19 | 20 | #endif -------------------------------------------------------------------------------- /src/abs.cpp: -------------------------------------------------------------------------------- 1 | // Absolute value, aka vector magnitude 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_abs(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | absval(); 12 | } 13 | 14 | void 15 | absval(void) 16 | { 17 | int h; 18 | save(); 19 | p1 = pop(); 20 | 21 | if (istensor(p1)) { 22 | absval_tensor(); 23 | restore(); 24 | return; 25 | } 26 | 27 | if (isnum(p1)) { 28 | push(p1); 29 | if (isnegativenumber(p1)) 30 | negate(); 31 | restore(); 32 | return; 33 | } 34 | 35 | if (iscomplexnumber(p1)) { 36 | push(p1); 37 | push(p1); 38 | conjugate(); 39 | multiply(); 40 | push_rational(1, 2); 41 | power(); 42 | restore(); 43 | return; 44 | } 45 | 46 | // abs(1/a) evaluates to 1/abs(a) 47 | 48 | if (car(p1) == symbol(POWER) && isnegativeterm(caddr(p1))) { 49 | push(p1); 50 | reciprocate(); 51 | absval(); 52 | reciprocate(); 53 | restore(); 54 | return; 55 | } 56 | 57 | // abs(a*b) evaluates to abs(a)*abs(b) 58 | 59 | if (car(p1) == symbol(MULTIPLY)) { 60 | h = tos; 61 | p1 = cdr(p1); 62 | while (iscons(p1)) { 63 | push(car(p1)); 64 | absval(); 65 | p1 = cdr(p1); 66 | } 67 | multiply_all(tos - h); 68 | restore(); 69 | return; 70 | } 71 | 72 | if (isnegativeterm(p1) || (car(p1) == symbol(ADD) && isnegativeterm(cadr(p1)))) { 73 | push(p1); 74 | negate(); 75 | p1 = pop(); 76 | } 77 | 78 | push_symbol(ABS); 79 | push(p1); 80 | list(2); 81 | 82 | restore(); 83 | } 84 | 85 | void 86 | absval_tensor(void) 87 | { 88 | if (p1->u.tensor->ndim != 1) 89 | stop("abs(tensor) with tensor rank > 1"); 90 | push(p1); 91 | push(p1); 92 | conjugate(); 93 | inner(); 94 | push_rational(1, 2); 95 | power(); 96 | simplify(); 97 | eval(); 98 | } 99 | 100 | #if SELFTEST 101 | 102 | static char *s[] = { 103 | 104 | "abs(2)", 105 | "2", 106 | 107 | "abs(2.0)", 108 | "2", 109 | 110 | "abs(-2)", 111 | "2", 112 | 113 | "abs(-2.0)", 114 | "2", 115 | 116 | "abs(a)", 117 | "abs(a)", 118 | 119 | "abs(-a)", 120 | "abs(a)", 121 | 122 | "abs(2*a)", 123 | "2*abs(a)", 124 | 125 | "abs(-2*a)", 126 | "2*abs(a)", 127 | 128 | "abs(2.0*a)", 129 | "2*abs(a)", 130 | 131 | "abs(-2.0*a)", 132 | "2*abs(a)", 133 | 134 | "abs(a-b)+abs(b-a)", 135 | "2*abs(a-b)", 136 | 137 | "abs(3 + 4 i)", 138 | "5", 139 | 140 | "abs((2,3,4))", 141 | "29^(1/2)", 142 | 143 | "abs(a*b)", 144 | "abs(a)*abs(b)", 145 | 146 | "abs(a/b)", 147 | "abs(a)/abs(b)", 148 | 149 | "abs(1/a^b)", 150 | "1/(abs(a^b))", 151 | 152 | // Check that vector length is simplified 153 | 154 | "P=(u*cos(v),u*sin(v),v)", 155 | "", 156 | 157 | "abs(cross(d(P,u),d(P,v)))", 158 | "(1+u^2)^(1/2)", 159 | }; 160 | 161 | void 162 | test_abs(void) 163 | { 164 | test(__FILE__, s, sizeof s / sizeof (char *)); 165 | } 166 | 167 | #endif 168 | -------------------------------------------------------------------------------- /src/adj.cpp: -------------------------------------------------------------------------------- 1 | // Adjunct of a matrix 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_adj(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | adj(); 12 | } 13 | 14 | void 15 | adj(void) 16 | { 17 | int i, j, n; 18 | 19 | save(); 20 | 21 | p1 = pop(); 22 | 23 | if (istensor(p1) && p1->u.tensor->ndim == 2 && p1->u.tensor->dim[0] == p1->u.tensor->dim[1]) 24 | ; 25 | else 26 | stop("adj: square matrix expected"); 27 | 28 | n = p1->u.tensor->dim[0]; 29 | 30 | p2 = alloc_tensor(n * n); 31 | 32 | p2->u.tensor->ndim = 2; 33 | p2->u.tensor->dim[0] = n; 34 | p2->u.tensor->dim[1] = n; 35 | 36 | for (i = 0; i < n; i++) 37 | for (j = 0; j < n; j++) { 38 | cofactor(p1, n, i, j); 39 | p2->u.tensor->elem[n * j + i] = pop(); /* transpose */ 40 | } 41 | 42 | push(p2); 43 | 44 | restore(); 45 | } 46 | 47 | #if SELFTEST 48 | 49 | static char *s[] = { 50 | 51 | "adj(((a,b),(c,d)))", 52 | "((d,-b),(-c,a))", 53 | 54 | "adj(((1,2),(3,4)))", 55 | "((4,-2),(-3,1))", 56 | 57 | "adj(((2,3,-2,5),(6,-2,1,4),(5,10,3,-2),(-1,2,2,3)))", 58 | "((-4,-177,-73,194),(-117,117,-99,-27),(310,-129,-44,-374),(-130,-51,71,-211))", 59 | }; 60 | 61 | void 62 | test_adj(void) 63 | { 64 | test(__FILE__, s, sizeof s / sizeof (char *)); 65 | } 66 | 67 | #endif 68 | -------------------------------------------------------------------------------- /src/append.cpp: -------------------------------------------------------------------------------- 1 | // Append one list to another. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | append(void) 8 | { 9 | int h; 10 | 11 | save(); 12 | 13 | p2 = pop(); 14 | p1 = pop(); 15 | 16 | h = tos; 17 | 18 | while (iscons(p1)) { 19 | push(car(p1)); 20 | p1 = cdr(p1); 21 | } 22 | 23 | while (iscons(p2)) { 24 | push(car(p2)); 25 | p2 = cdr(p2); 26 | } 27 | 28 | list(tos - h); 29 | 30 | restore(); 31 | } 32 | -------------------------------------------------------------------------------- /src/arccos.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arccos(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arccos(); 10 | } 11 | 12 | void 13 | arccos(void) 14 | { 15 | int n; 16 | double d; 17 | 18 | save(); 19 | 20 | p1 = pop(); 21 | 22 | if (car(p1) == symbol(COS)) { 23 | push(cadr(p1)); 24 | restore(); 25 | return; 26 | } 27 | 28 | if (isdouble(p1)) { 29 | errno = 0; 30 | d = acos(p1->u.d); 31 | if (errno) 32 | stop("arccos function argument is not in the interval [-1,1]"); 33 | push_double(d); 34 | restore(); 35 | return; 36 | } 37 | 38 | // if p1 == 1/sqrt(2) then return 1/4*pi (45 degrees) 39 | 40 | if (isoneoversqrttwo(p1)) { 41 | push_rational(1, 4); 42 | push_symbol(PI); 43 | multiply(); 44 | restore(); 45 | return; 46 | } 47 | 48 | // if p1 == -1/sqrt(2) then return 3/4*pi (135 degrees) 49 | 50 | if (isminusoneoversqrttwo(p1)) { 51 | push_rational(3, 4); 52 | push_symbol(PI); 53 | multiply(); 54 | restore(); 55 | return; 56 | } 57 | 58 | if (!isrational(p1)) { 59 | push_symbol(ARCCOS); 60 | push(p1); 61 | list(2); 62 | restore(); 63 | return; 64 | } 65 | 66 | push(p1); 67 | push_integer(2); 68 | multiply(); 69 | n = pop_integer(); 70 | 71 | switch (n) { 72 | 73 | case -2: 74 | push_symbol(PI); 75 | break; 76 | 77 | case -1: 78 | push_rational(2, 3); 79 | push_symbol(PI); 80 | multiply(); 81 | break; 82 | 83 | case 0: 84 | push_rational(1, 2); 85 | push_symbol(PI); 86 | multiply(); 87 | break; 88 | 89 | case 1: 90 | push_rational(1, 3); 91 | push_symbol(PI); 92 | multiply(); 93 | break; 94 | 95 | case 2: 96 | push(zero); 97 | break; 98 | 99 | default: 100 | push_symbol(ARCCOS); 101 | push(p1); 102 | list(2); 103 | break; 104 | } 105 | 106 | restore(); 107 | } 108 | 109 | #if SELFTEST 110 | 111 | static char *s[] = { 112 | 113 | "arccos(1)", 114 | "0", 115 | 116 | "arccos(1/2)", 117 | "1/3*pi", 118 | 119 | "arccos(0)", 120 | "1/2*pi", 121 | 122 | "arccos(-1/2)", 123 | "2/3*pi", 124 | 125 | "arccos(-1)", 126 | "pi", 127 | 128 | "arccos(cos(0))", 129 | "0", 130 | 131 | "arccos(cos(1/3*pi))", 132 | "1/3*pi", 133 | 134 | "arccos(cos(1/2*pi))", 135 | "1/2*pi", 136 | 137 | "arccos(cos(2/3*pi))", 138 | "2/3*pi", 139 | 140 | "arccos(cos(pi))", 141 | "pi", 142 | 143 | "arccos(cos(x))", 144 | "x", 145 | 146 | "arccos(1/sqrt(2))", 147 | "1/4*pi", 148 | 149 | "arccos(-1/sqrt(2))", 150 | "3/4*pi", 151 | 152 | "arccos(cos(1/4*pi))", 153 | "1/4*pi", 154 | 155 | "arccos(cos(3/4*pi))", 156 | "3/4*pi", 157 | }; 158 | 159 | void 160 | test_arccos(void) 161 | { 162 | test(__FILE__, s, sizeof s / sizeof (char *)); 163 | } 164 | 165 | #endif 166 | -------------------------------------------------------------------------------- /src/arccosh.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arccosh(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arccosh(); 10 | } 11 | 12 | void 13 | arccosh(void) 14 | { 15 | double d; 16 | save(); 17 | p1 = pop(); 18 | if (car(p1) == symbol(COSH)) { 19 | push(cadr(p1)); 20 | restore(); 21 | return; 22 | } 23 | if (isdouble(p1)) { 24 | d = p1->u.d; 25 | if (d < 1.0) 26 | stop("arccosh function argument is less than 1.0"); 27 | d = log(d + sqrt(d * d - 1.0)); 28 | push_double(d); 29 | restore(); 30 | return; 31 | } 32 | if (isplusone(p1)) { 33 | push(zero); 34 | restore(); 35 | return; 36 | } 37 | push_symbol(ARCCOSH); 38 | push(p1); 39 | list(2); 40 | restore(); 41 | } 42 | 43 | #if SELFTEST 44 | 45 | static char *s[] = { 46 | 47 | "arccosh(1.0)", 48 | "0", 49 | 50 | "arccosh(1)", 51 | "0", 52 | 53 | "arccosh(cosh(x))", 54 | "x", 55 | }; 56 | 57 | void 58 | test_arccosh(void) 59 | { 60 | test(__FILE__, s, sizeof s / sizeof (char *)); 61 | } 62 | 63 | #endif 64 | -------------------------------------------------------------------------------- /src/arcsin.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arcsin(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arcsin(); 10 | } 11 | 12 | void 13 | arcsin(void) 14 | { 15 | int n; 16 | double d; 17 | 18 | save(); 19 | 20 | p1 = pop(); 21 | 22 | if (car(p1) == symbol(SIN)) { 23 | push(cadr(p1)); 24 | restore(); 25 | return; 26 | } 27 | 28 | if (isdouble(p1)) { 29 | errno = 0; 30 | d = asin(p1->u.d); 31 | if (errno) 32 | stop("arcsin function argument is not in the interval [-1,1]"); 33 | push_double(d); 34 | restore(); 35 | return; 36 | } 37 | 38 | // if p1 == 1/sqrt(2) then return 1/4*pi (45 degrees) 39 | 40 | if (isoneoversqrttwo(p1)) { 41 | push_rational(1, 4); 42 | push_symbol(PI); 43 | multiply(); 44 | restore(); 45 | return; 46 | } 47 | 48 | // if p1 == -1/sqrt(2) then return -1/4*pi (-45 degrees) 49 | 50 | if (isminusoneoversqrttwo(p1)) { 51 | push_rational(-1, 4); 52 | push_symbol(PI); 53 | multiply(); 54 | restore(); 55 | return; 56 | } 57 | 58 | if (!isrational(p1)) { 59 | push_symbol(ARCSIN); 60 | push(p1); 61 | list(2); 62 | restore(); 63 | return; 64 | } 65 | 66 | push(p1); 67 | push_integer(2); 68 | multiply(); 69 | n = pop_integer(); 70 | 71 | switch (n) { 72 | 73 | case -2: 74 | push_rational(-1, 2); 75 | push_symbol(PI); 76 | multiply(); 77 | break; 78 | 79 | case -1: 80 | push_rational(-1, 6); 81 | push_symbol(PI); 82 | multiply(); 83 | break; 84 | 85 | case 0: 86 | push(zero); 87 | break; 88 | 89 | case 1: 90 | push_rational(1, 6); 91 | push_symbol(PI); 92 | multiply(); 93 | break; 94 | 95 | case 2: 96 | push_rational(1, 2); 97 | push_symbol(PI); 98 | multiply(); 99 | break; 100 | 101 | default: 102 | push_symbol(ARCSIN); 103 | push(p1); 104 | list(2); 105 | break; 106 | } 107 | 108 | restore(); 109 | } 110 | 111 | #if SELFTEST 112 | 113 | static char *s[] = { 114 | 115 | "arcsin(-1)", 116 | "-1/2*pi", 117 | 118 | "arcsin(-1/2)", 119 | "-1/6*pi", 120 | 121 | "arcsin(0)", 122 | "0", 123 | 124 | "arcsin(1/2)", 125 | "1/6*pi", 126 | 127 | "arcsin(1)", 128 | "1/2*pi", 129 | 130 | "arcsin(sin(-1/2*pi))", 131 | "-1/2*pi", 132 | 133 | "arcsin(sin(-1/6*pi))", 134 | "-1/6*pi", 135 | 136 | "arcsin(sin(0))", 137 | "0", 138 | 139 | "arcsin(sin(1/6*pi))", 140 | "1/6*pi", 141 | 142 | "arcsin(sin(1/2*pi))", 143 | "1/2*pi", 144 | 145 | "arcsin(sin(x))", 146 | "x", 147 | 148 | "arcsin(1/sqrt(2))", 149 | "1/4*pi", 150 | 151 | "arcsin(-1/sqrt(2))", 152 | "-1/4*pi", 153 | 154 | "arcsin(sin(1/4*pi))", 155 | "1/4*pi", 156 | 157 | "arcsin(sin(-1/4*pi))", 158 | "-1/4*pi", 159 | }; 160 | 161 | void 162 | test_arcsin(void) 163 | { 164 | test(__FILE__, s, sizeof s / sizeof (char *)); 165 | } 166 | 167 | #endif 168 | -------------------------------------------------------------------------------- /src/arcsinh.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arcsinh(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arcsinh(); 10 | } 11 | 12 | void 13 | arcsinh(void) 14 | { 15 | double d; 16 | save(); 17 | p1 = pop(); 18 | if (car(p1) == symbol(SINH)) { 19 | push(cadr(p1)); 20 | restore(); 21 | return; 22 | } 23 | if (isdouble(p1)) { 24 | d = p1->u.d; 25 | d = log(d + sqrt(d * d + 1.0)); 26 | push_double(d); 27 | restore(); 28 | return; 29 | } 30 | if (iszero(p1)) { 31 | push(zero); 32 | restore(); 33 | return; 34 | } 35 | push_symbol(ARCSINH); 36 | push(p1); 37 | list(2); 38 | restore(); 39 | } 40 | 41 | #if SELFTEST 42 | 43 | static char *s[] = { 44 | 45 | "arcsinh(0.0)", 46 | "0", 47 | 48 | "arcsinh(0)", 49 | "0", 50 | 51 | "arcsinh(sinh(x))", 52 | "x", 53 | }; 54 | 55 | void 56 | test_arcsinh(void) 57 | { 58 | test(__FILE__, s, sizeof s / sizeof (char *)); 59 | } 60 | 61 | #endif 62 | -------------------------------------------------------------------------------- /src/arctan.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arctan(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arctan(); 10 | } 11 | 12 | void 13 | arctan(void) 14 | { 15 | double d; 16 | 17 | save(); 18 | 19 | p1 = pop(); 20 | 21 | if (car(p1) == symbol(TAN)) { 22 | push(cadr(p1)); 23 | restore(); 24 | return; 25 | } 26 | 27 | if (isdouble(p1)) { 28 | errno = 0; 29 | d = atan(p1->u.d); 30 | if (errno) 31 | stop("arctan function error"); 32 | push_double(d); 33 | restore(); 34 | return; 35 | } 36 | 37 | if (iszero(p1)) { 38 | push(zero); 39 | restore(); 40 | return; 41 | } 42 | 43 | if (isnegative(p1)) { 44 | push(p1); 45 | negate(); 46 | arctan(); 47 | negate(); 48 | restore(); 49 | return; 50 | } 51 | 52 | // arctan(sin(a) / cos(a)) ? 53 | 54 | if (find(p1, symbol(SIN)) && find(p1, symbol(COS))) { 55 | push(p1); 56 | numerator(); 57 | p2 = pop(); 58 | push(p1); 59 | denominator(); 60 | p3 = pop(); 61 | if (car(p2) == symbol(SIN) && car(p3) == symbol(COS) && equal(cadr(p2), cadr(p3))) { 62 | push(cadr(p2)); 63 | restore(); 64 | return; 65 | } 66 | } 67 | 68 | // arctan(1/sqrt(3)) -> pi/6 69 | 70 | if (car(p1) == symbol(POWER) && equaln(cadr(p1), 3) && equalq(caddr(p1), -1, 2)) { 71 | push_rational(1, 6); 72 | push(symbol(PI)); 73 | multiply(); 74 | restore(); 75 | return; 76 | } 77 | 78 | // arctan(1) -> pi/4 79 | 80 | if (equaln(p1, 1)) { 81 | push_rational(1, 4); 82 | push(symbol(PI)); 83 | multiply(); 84 | restore(); 85 | return; 86 | } 87 | 88 | // arctan(sqrt(3)) -> pi/3 89 | 90 | if (car(p1) == symbol(POWER) && equaln(cadr(p1), 3) && equalq(caddr(p1), 1, 2)) { 91 | push_rational(1, 3); 92 | push(symbol(PI)); 93 | multiply(); 94 | restore(); 95 | return; 96 | } 97 | 98 | push_symbol(ARCTAN); 99 | push(p1); 100 | list(2); 101 | 102 | restore(); 103 | } 104 | 105 | #if SELFTEST 106 | 107 | static char *s[] = { 108 | 109 | "arctan(x)", 110 | "arctan(x)", 111 | 112 | "arctan(-x)", 113 | "-arctan(x)", 114 | 115 | "arctan(0)", 116 | "0", 117 | 118 | "arctan(tan(x))", 119 | "x", 120 | 121 | "arctan(1/sqrt(3))-pi/6", // 30 degrees 122 | "0", 123 | 124 | "arctan(1)-pi/4", // 45 degrees 125 | "0", 126 | 127 | "arctan(sqrt(3))-pi/3", // 60 degrees 128 | "0", 129 | 130 | "arctan(a-b)", 131 | "arctan(a-b)", 132 | 133 | "arctan(b-a)", 134 | "-arctan(a-b)", 135 | 136 | "arctan(tan(x))", 137 | "x", 138 | }; 139 | 140 | void 141 | test_arctan(void) 142 | { 143 | test(__FILE__, s, sizeof s / sizeof (char *)); 144 | } 145 | 146 | #endif 147 | -------------------------------------------------------------------------------- /src/arctanh.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_arctanh(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | arctanh(); 10 | } 11 | 12 | void 13 | arctanh(void) 14 | { 15 | double d; 16 | save(); 17 | p1 = pop(); 18 | if (car(p1) == symbol(TANH)) { 19 | push(cadr(p1)); 20 | restore(); 21 | return; 22 | } 23 | if (isdouble(p1)) { 24 | d = p1->u.d; 25 | if (d < -1.0 || d > 1.0) 26 | stop("arctanh function argument is not in the interval [-1,1]"); 27 | d = log((1.0 + d) / (1.0 - d)) / 2.0; 28 | push_double(d); 29 | restore(); 30 | return; 31 | } 32 | if (iszero(p1)) { 33 | push(zero); 34 | restore(); 35 | return; 36 | } 37 | push_symbol(ARCTANH); 38 | push(p1); 39 | list(2); 40 | restore(); 41 | } 42 | 43 | #if SELFTEST 44 | 45 | static char *s[] = { 46 | 47 | "arctanh(0.0)", 48 | "0", 49 | 50 | "arctanh(0)", 51 | "0", 52 | 53 | "arctanh(tanh(x))", 54 | "x", 55 | }; 56 | 57 | void 58 | test_arctanh(void) 59 | { 60 | test(__FILE__, s, sizeof s / sizeof (char *)); 61 | } 62 | 63 | #endif 64 | -------------------------------------------------------------------------------- /src/arg.cpp: -------------------------------------------------------------------------------- 1 | /* Argument (angle) of complex z 2 | 3 | z arg(z) 4 | - ------ 5 | 6 | a 0 7 | 8 | -a -pi See note 3 below 9 | 10 | (-1)^a a pi 11 | 12 | exp(a + i b) b 13 | 14 | a b arg(a) + arg(b) 15 | 16 | a + i b arctan(b/a) 17 | 18 | Result by quadrant 19 | 20 | z arg(z) 21 | - ------ 22 | 23 | 1 + i 1/4 pi 24 | 25 | 1 - i -1/4 pi 26 | 27 | -1 + i 3/4 pi 28 | 29 | -1 - i -3/4 pi 30 | 31 | Notes 32 | 33 | 1. Handles mixed polar and rectangular forms, e.g. 1 + exp(i pi/3) 34 | 35 | 2. Symbols in z are assumed to be positive and real. 36 | 37 | 3. Negative direction adds -pi to angle. 38 | 39 | Example: z = (-1)^(1/3), mag(z) = 1/3 pi, mag(-z) = -2/3 pi 40 | 41 | 4. jean-francois.debroux reports that when z=(a+i*b)/(c+i*d) then 42 | 43 | arg(numerator(z)) - arg(denominator(z)) 44 | 45 | must be used to get the correct answer. Now the operation is 46 | automatic. 47 | */ 48 | 49 | #include "stdafx.h" 50 | #include "defs.h" 51 | 52 | void 53 | eval_arg(void) 54 | { 55 | push(cadr(p1)); 56 | eval(); 57 | arg(); 58 | } 59 | 60 | void 61 | arg(void) 62 | { 63 | save(); 64 | p1 = pop(); 65 | push(p1); 66 | numerator(); 67 | yyarg(); 68 | push(p1); 69 | denominator(); 70 | yyarg(); 71 | subtract(); 72 | restore(); 73 | } 74 | 75 | #define RE p2 76 | #define IM p3 77 | 78 | void 79 | yyarg(void) 80 | { 81 | save(); 82 | p1 = pop(); 83 | if (isnegativenumber(p1)) { 84 | push(symbol(PI)); 85 | negate(); 86 | } else if (car(p1) == symbol(POWER) && equaln(cadr(p1), -1)) { 87 | // -1 to a power 88 | push(symbol(PI)); 89 | push(caddr(p1)); 90 | multiply(); 91 | } else if (car(p1) == symbol(POWER) && cadr(p1) == symbol(E)) { 92 | // exponential 93 | push(caddr(p1)); 94 | imag(); 95 | } else if (car(p1) == symbol(MULTIPLY)) { 96 | // product of factors 97 | push_integer(0); 98 | p1 = cdr(p1); 99 | while (iscons(p1)) { 100 | push(car(p1)); 101 | arg(); 102 | add(); 103 | p1 = cdr(p1); 104 | } 105 | } else if (car(p1) == symbol(ADD)) { 106 | // sum of terms 107 | push(p1); 108 | rect(); 109 | p1 = pop(); 110 | push(p1); 111 | real(); 112 | RE = pop(); 113 | push(p1); 114 | imag(); 115 | IM = pop(); 116 | if (iszero(RE)) { 117 | push(symbol(PI)); 118 | if (isnegative(IM)) 119 | negate(); 120 | } else { 121 | push(IM); 122 | push(RE); 123 | divide(); 124 | arctan(); 125 | if (isnegative(RE)) { 126 | push_symbol(PI); 127 | if (isnegative(IM)) 128 | subtract(); // quadrant 1 -> 3 129 | else 130 | add(); // quadrant 4 -> 2 131 | } 132 | } 133 | } else 134 | // pure real 135 | push_integer(0); 136 | restore(); 137 | } 138 | 139 | #if SELFTEST 140 | 141 | static char *s[] = { 142 | 143 | "arg(1+i)", 144 | "1/4*pi", 145 | 146 | "arg(1-i)", 147 | "-1/4*pi", 148 | 149 | "arg(-1+i)", 150 | "3/4*pi", 151 | 152 | "arg(-1-i)", 153 | "-3/4*pi", 154 | 155 | "arg((-1)^(1/3))", 156 | "1/3*pi", 157 | 158 | "arg(1+exp(i*pi/3))", 159 | "1/6*pi", 160 | 161 | "arg((-1)^(1/6)*exp(i*pi/6))", 162 | "1/3*pi", 163 | 164 | "arg(a)", 165 | "0", 166 | 167 | "arg(a*exp(b+i*pi/5))", 168 | "1/5*pi", 169 | 170 | "arg(-1)", 171 | "-pi", 172 | 173 | "arg(a)", 174 | "0", 175 | 176 | "arg(-a)", 177 | "-pi", 178 | 179 | "arg(-(-1)^(1/3))", 180 | "-2/3*pi", 181 | 182 | "arg(-exp(i*pi/3))", 183 | "-2/3*pi", 184 | 185 | "arg(-i)", 186 | "-1/2*pi", 187 | 188 | "arg((a+b*i)/(c+d*i))", 189 | "arctan(b/a)-arctan(d/c)", 190 | }; 191 | 192 | void 193 | test_arg(void) 194 | { 195 | test(__FILE__, s, sizeof s / sizeof (char *)); 196 | } 197 | 198 | #endif 199 | -------------------------------------------------------------------------------- /src/atomize.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_atomize(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | p1 = pop(); 10 | if (iscons(p1)) 11 | atomize(); 12 | else 13 | push(p1); 14 | } 15 | 16 | void 17 | atomize(void) 18 | { 19 | int i, n; 20 | p1 = cdr(p1); 21 | n = length(p1); 22 | if (n == 1) { 23 | push(car(p1)); 24 | return; 25 | } 26 | p2 = alloc_tensor(n); 27 | p2->u.tensor->ndim = 1; 28 | p2->u.tensor->dim[0] = n; 29 | for (i = 0; i < n; i++) { 30 | p2->u.tensor->elem[i] = car(p1); 31 | p1 = cdr(p1); 32 | } 33 | push(p2); 34 | } 35 | -------------------------------------------------------------------------------- /src/bake.cpp: -------------------------------------------------------------------------------- 1 | // pretty print 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | bake(void) 8 | { 9 | int h, s, t, x, y, z; 10 | 11 | expanding++; 12 | 13 | save(); 14 | 15 | p1 = pop(); 16 | 17 | s = ispoly(p1, symbol(SYMBOL_S)); 18 | t = ispoly(p1, symbol(SYMBOL_T)); 19 | x = ispoly(p1, symbol(SYMBOL_X)); 20 | y = ispoly(p1, symbol(SYMBOL_Y)); 21 | z = ispoly(p1, symbol(SYMBOL_Z)); 22 | 23 | if (s == 1 && t == 0 && x == 0 && y == 0 && z == 0) { 24 | p2 = symbol(SYMBOL_S); 25 | bake_poly(); 26 | } else if (s == 0 && t == 1 && x == 0 && y == 0 && z == 0) { 27 | p2 = symbol(SYMBOL_T); 28 | bake_poly(); 29 | } else if (s == 0 && t == 0 && x == 1 && y == 0 && z == 0) { 30 | p2 = symbol(SYMBOL_X); 31 | bake_poly(); 32 | } else if (s == 0 && t == 0 && x == 0 && y == 1 && z == 0) { 33 | p2 = symbol(SYMBOL_Y); 34 | bake_poly(); 35 | } else if (s == 0 && t == 0 && x == 0 && y == 0 && z == 1) { 36 | p2 = symbol(SYMBOL_Z); 37 | bake_poly(); 38 | } else if (iscons(p1)) { 39 | h = tos; 40 | push(car(p1)); 41 | p1 = cdr(p1); 42 | while (iscons(p1)) { 43 | push(car(p1)); 44 | bake(); 45 | p1 = cdr(p1); 46 | } 47 | list(tos - h); 48 | } else 49 | push(p1); 50 | 51 | restore(); 52 | 53 | expanding--; 54 | } 55 | 56 | void 57 | polyform(void) 58 | { 59 | int h; 60 | 61 | save(); 62 | 63 | p2 = pop(); 64 | p1 = pop(); 65 | 66 | if (ispoly(p1, p2)) 67 | bake_poly(); 68 | else if (iscons(p1)) { 69 | h = tos; 70 | push(car(p1)); 71 | p1 = cdr(p1); 72 | while (iscons(p1)) { 73 | push(car(p1)); 74 | push(p2); 75 | polyform(); 76 | p1 = cdr(p1); 77 | } 78 | list(tos - h); 79 | } else 80 | push(p1); 81 | 82 | restore(); 83 | } 84 | 85 | void 86 | bake_poly() 87 | { 88 | int h, i, k, n; 89 | U **a; 90 | a = stack + tos; 91 | push(p1); // p(x) 92 | push(p2); // x 93 | k = coeff(); 94 | h = tos; 95 | for (i = k - 1; i >= 0; i--) { 96 | p1 = a[i]; 97 | bake_poly_term(i); 98 | } 99 | n = tos - h; 100 | if (n > 1) { 101 | list(n); 102 | push(symbol(ADD)); 103 | swap(); 104 | cons(); 105 | } 106 | p1 = pop(); 107 | tos -= k; 108 | push(p1); 109 | } 110 | 111 | // p1 points to coefficient of p2 ^ k 112 | 113 | void 114 | bake_poly_term(int k) 115 | { 116 | int h, n; 117 | 118 | if (iszero(p1)) 119 | return; 120 | 121 | // constant term? 122 | 123 | if (k == 0) { 124 | if (car(p1) == symbol(ADD)) { 125 | p1 = cdr(p1); 126 | while (iscons(p1)) { 127 | push(car(p1)); 128 | p1 = cdr(p1); 129 | } 130 | } else 131 | push(p1); 132 | return; 133 | } 134 | 135 | h = tos; 136 | 137 | // coefficient 138 | 139 | if (car(p1) == symbol(MULTIPLY)) { 140 | p1 = cdr(p1); 141 | while (iscons(p1)) { 142 | push(car(p1)); 143 | p1 = cdr(p1); 144 | } 145 | } else if (!equaln(p1, 1)) 146 | push(p1); 147 | 148 | // x ^ k 149 | 150 | if (k == 1) 151 | push(p2); 152 | else { 153 | push(symbol(POWER)); 154 | push(p2); 155 | push_integer(k); 156 | list(3); 157 | } 158 | 159 | n = tos - h; 160 | 161 | if (n > 1) { 162 | list(n); 163 | push(symbol(MULTIPLY)); 164 | swap(); 165 | cons(); 166 | } 167 | } 168 | 169 | #if SELFTEST 170 | 171 | static char *s[] = { 172 | 173 | "(x+3)^3", 174 | "x^3+9*x^2+27*x+27", 175 | 176 | "factor", 177 | "(x+3)^3", 178 | }; 179 | 180 | void 181 | test_bake(void) 182 | { 183 | test(__FILE__, s, sizeof s / sizeof (char *)); 184 | } 185 | 186 | #endif 187 | -------------------------------------------------------------------------------- /src/bessely.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Bessel Y function 4 | // 5 | // Input: tos-2 x (can be a symbol or expr) 6 | // 7 | // tos-1 n 8 | // 9 | // Output: Result on stack 10 | // 11 | //----------------------------------------------------------------------------- 12 | 13 | #include "stdafx.h" 14 | #include "defs.h" 15 | 16 | void 17 | eval_bessely(void) 18 | { 19 | push(cadr(p1)); 20 | eval(); 21 | push(caddr(p1)); 22 | eval(); 23 | bessely(); 24 | } 25 | 26 | void 27 | bessely(void) 28 | { 29 | save(); 30 | yybessely(); 31 | restore(); 32 | } 33 | 34 | #define X p1 35 | #define N p2 36 | 37 | void 38 | yybessely(void) 39 | { 40 | double d; 41 | int n; 42 | 43 | N = pop(); 44 | X = pop(); 45 | 46 | push(N); 47 | n = pop_integer(); 48 | 49 | if (isdouble(X) && n != (int) 0x80000000) { 50 | d = yn(n, X->u.d); 51 | push_double(d); 52 | return; 53 | } 54 | 55 | if (isnegativeterm(N)) { 56 | push_integer(-1); 57 | push(N); 58 | power(); 59 | push_symbol(BESSELY); 60 | push(X); 61 | push(N); 62 | negate(); 63 | list(3); 64 | multiply(); 65 | return; 66 | } 67 | 68 | push_symbol(BESSELY); 69 | push(X); 70 | push(N); 71 | list(3); 72 | return; 73 | } 74 | 75 | #if SELFTEST 76 | 77 | static char *s[] = { 78 | 79 | "bessely(x,n)", 80 | "bessely(x,n)", 81 | }; 82 | 83 | void 84 | test_bessely(void) 85 | { 86 | test(__FILE__, s, sizeof s / sizeof (char *)); 87 | } 88 | 89 | #endif 90 | -------------------------------------------------------------------------------- /src/binomial.cpp: -------------------------------------------------------------------------------- 1 | // Binomial coefficient 2 | // 3 | // Input: tos-2 n 4 | // 5 | // tos-1 k 6 | // 7 | // Output: Binomial coefficient on stack 8 | // 9 | // binomial(n, k) = n! / k! / (n - k)! 10 | // 11 | // The binomial coefficient vanishes for k < 0 or k > n. (A=B, p. 19) 12 | 13 | #include "stdafx.h" 14 | #include "defs.h" 15 | static void ybinomial(void); 16 | static int check_args(void); 17 | 18 | void 19 | eval_binomial(void) 20 | { 21 | push(cadr(p1)); 22 | eval(); 23 | push(caddr(p1)); 24 | eval(); 25 | binomial(); 26 | } 27 | 28 | 29 | void 30 | binomial(void) 31 | { 32 | save(); 33 | ybinomial(); 34 | restore(); 35 | } 36 | 37 | #define N p1 38 | #define K p2 39 | 40 | static void 41 | ybinomial(void) 42 | { 43 | K = pop(); 44 | N = pop(); 45 | 46 | if (check_args() == 0) { 47 | push(zero); 48 | return; 49 | } 50 | 51 | push(N); 52 | factorial(); 53 | 54 | push(K); 55 | factorial(); 56 | 57 | divide(); 58 | 59 | push(N); 60 | push(K); 61 | subtract(); 62 | factorial(); 63 | 64 | divide(); 65 | } 66 | 67 | static int 68 | check_args(void) 69 | { 70 | if (isnum(N) && lessp(N, zero)) 71 | return 0; 72 | else if (isnum(K) && lessp(K, zero)) 73 | return 0; 74 | else if (isnum(N) && isnum(K) && lessp(N, K)) 75 | return 0; 76 | else 77 | return 1; 78 | } 79 | 80 | #if SELFTEST 81 | 82 | char *s[] = { 83 | 84 | "binomial(12,6)", 85 | "924", 86 | 87 | "binomial(n,k)", 88 | // "1/(factorial(k))*factorial(n)*1/(factorial(-k+n))", 89 | // "factorial(n)/(factorial(k)*factorial(-k+n))", 90 | "n!/(k!*(-k+n)!)", 91 | 92 | "binomial(0,k)", 93 | // "1/(factorial(k))*1/(factorial(-k))", 94 | // "1/(factorial(k)*factorial(-k))", 95 | "1/(k!*(-k)!)", 96 | 97 | "binomial(n,0)", 98 | "1", 99 | 100 | "binomial(-1,k)", 101 | "0", 102 | 103 | "binomial(n,-1)", 104 | "0", 105 | }; 106 | 107 | void 108 | test_binomial(void) 109 | { 110 | test(__FILE__, s, sizeof s / sizeof (char *)); 111 | } 112 | 113 | #endif 114 | -------------------------------------------------------------------------------- /src/catalogGUI.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __CATALOGGUI_H 2 | #define __CATALOGGUI_H 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | typedef struct { 19 | char* name; 20 | char* insert; 21 | char* desc; 22 | int category; 23 | } catalogFunc; 24 | 25 | #define CAT_CATEGORY_ALL 0 26 | #define CAT_CATEGORY_COMPLEXNUM 1 27 | #define CAT_CATEGORY_LINEARALG 2 28 | #define CAT_CATEGORY_CALCULUS 3 29 | #define CAT_CATEGORY_POLYNOMIAL 4 30 | #define CAT_CATEGORY_SPECIAL 5 31 | #define CAT_CATEGORY_PROG 6 32 | #define CAT_CATEGORY_TRIG 7 33 | #define CAT_CATEGORY_OTHER 8 34 | 35 | #define CAT_COMPLETE_COUNT 103 36 | 37 | int showCatalog(char* insertText); 38 | int doCatalogMenu(char* insertText, char* title, int category); 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /src/ceiling.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_ceiling(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | ceiling(); 10 | } 11 | 12 | void 13 | ceiling(void) 14 | { 15 | save(); 16 | yyceiling(); 17 | restore(); 18 | } 19 | 20 | void 21 | yyceiling(void) 22 | { 23 | double d; 24 | 25 | p1 = pop(); 26 | 27 | if (!isnum(p1)) { 28 | push_symbol(CEILING); 29 | push(p1); 30 | list(2); 31 | return; 32 | } 33 | 34 | if (isdouble(p1)) { 35 | d = ceil(p1->u.d); 36 | push_double(d); 37 | return; 38 | } 39 | 40 | if (isinteger(p1)) { 41 | push(p1); 42 | return; 43 | } 44 | 45 | p3 = alloc(); 46 | p3->k = NUM; 47 | p3->u.q.a = mdiv(p1->u.q.a, p1->u.q.b); 48 | p3->u.q.b = mint(1); 49 | push(p3); 50 | 51 | if (isnegativenumber(p1)) 52 | ; 53 | else { 54 | push_integer(1); 55 | add(); 56 | } 57 | } 58 | 59 | #if SELFTEST 60 | 61 | static char *s[] = { 62 | 63 | "ceiling(a)", 64 | "ceiling(a)", 65 | 66 | "ceiling(a+b)", 67 | "ceiling(a+b)", 68 | 69 | "ceiling(5/2)", 70 | "3", 71 | 72 | "ceiling(4/2)", 73 | "2", 74 | 75 | "ceiling(3/2)", 76 | "2", 77 | 78 | "ceiling(2/2)", 79 | "1", 80 | 81 | "ceiling(1/2)", 82 | "1", 83 | 84 | "ceiling(0/2)", 85 | "0", 86 | 87 | "ceiling(-1/2)", 88 | "0", 89 | 90 | "ceiling(-2/2)", 91 | "-1", 92 | 93 | "ceiling(-3/2)", 94 | "-1", 95 | 96 | "ceiling(-4/2)", 97 | "-2", 98 | 99 | "ceiling(-5/2)", 100 | "-2", 101 | 102 | "ceiling(5/2.0)", 103 | "3", 104 | 105 | "ceiling(4/2.0)", 106 | "2", 107 | 108 | "ceiling(3/2.0)", 109 | "2", 110 | 111 | "ceiling(2/2.0)", 112 | "1", 113 | 114 | "ceiling(1/2.0)", 115 | "1", 116 | 117 | "ceiling(0.0)", 118 | "0", 119 | 120 | "ceiling(-1/2.0)", 121 | "0", 122 | 123 | "ceiling(-2/2.0)", 124 | "-1", 125 | 126 | "ceiling(-3/2.0)", 127 | "-1", 128 | 129 | "ceiling(-4/2.0)", 130 | "-2", 131 | 132 | "ceiling(-5/2.0)", 133 | "-2", 134 | }; 135 | 136 | void 137 | test_ceiling(void) 138 | { 139 | test(__FILE__, s, sizeof s / sizeof (char *)); 140 | } 141 | 142 | #endif 143 | -------------------------------------------------------------------------------- /src/choose.cpp: -------------------------------------------------------------------------------- 1 | // For example, the number of five card hands is choose(52,5) 2 | // 3 | // n! 4 | // choose(n,k) = ------------- 5 | // k! (n - k)! 6 | 7 | #include "stdafx.h" 8 | #include "defs.h" 9 | 10 | void 11 | eval_choose(void) 12 | { 13 | push(cadr(p1)); 14 | eval(); 15 | push(caddr(p1)); 16 | eval(); 17 | choose(); 18 | } 19 | 20 | // Result vanishes for k < 0 or k > n. (A=B, p. 19) 21 | 22 | #define N p1 23 | #define K p2 24 | 25 | void 26 | choose(void) 27 | { 28 | save(); 29 | 30 | K = pop(); 31 | N = pop(); 32 | 33 | if (choose_check_args() == 0) { 34 | push_integer(0); 35 | restore(); 36 | return; 37 | } 38 | 39 | push(N); 40 | factorial(); 41 | 42 | push(K); 43 | factorial(); 44 | 45 | divide(); 46 | 47 | push(N); 48 | push(K); 49 | subtract(); 50 | factorial(); 51 | 52 | divide(); 53 | 54 | restore(); 55 | } 56 | 57 | int 58 | choose_check_args(void) 59 | { 60 | if (isnum(N) && lessp(N, zero)) 61 | return 0; 62 | else if (isnum(K) && lessp(K, zero)) 63 | return 0; 64 | else if (isnum(N) && isnum(K) && lessp(N, K)) 65 | return 0; 66 | else 67 | return 1; 68 | } 69 | 70 | #if SELFTEST 71 | 72 | static char *s[] = { 73 | 74 | "choose(52,5)", 75 | "2598960", 76 | 77 | "choose(n,k)", 78 | "n!/(k!*(-k+n)!)", 79 | 80 | "choose(0,k)", 81 | "1/(k!*(-k)!)", 82 | 83 | "choose(n,0)", 84 | "1", 85 | 86 | "choose(-1,k)", 87 | "0", 88 | 89 | "choose(n,-1)", 90 | "0", 91 | }; 92 | 93 | void 94 | test_choose(void) 95 | { 96 | test(__FILE__, s, sizeof s / sizeof (char *)); 97 | } 98 | 99 | #endif 100 | -------------------------------------------------------------------------------- /src/circexp.cpp: -------------------------------------------------------------------------------- 1 | // Change circular functions to exponentials 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_circexp(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | 12 | circexp(); 13 | 14 | // normalize 15 | 16 | eval(); 17 | } 18 | 19 | void 20 | circexp(void) 21 | { 22 | int i, h; 23 | save(); 24 | p1 = pop(); 25 | 26 | if (car(p1) == symbol(COS)) { 27 | push(cadr(p1)); 28 | expcos(); 29 | restore(); 30 | return; 31 | } 32 | 33 | if (car(p1) == symbol(SIN)) { 34 | push(cadr(p1)); 35 | expsin(); 36 | restore(); 37 | return; 38 | } 39 | 40 | if (car(p1) == symbol(TAN)) { 41 | p1 = cadr(p1); 42 | push(imaginaryunit); 43 | push(p1); 44 | multiply(); 45 | exponential(); 46 | p2 = pop(); 47 | push(imaginaryunit); 48 | push(p1); 49 | multiply(); 50 | negate(); 51 | exponential(); 52 | p3 = pop(); 53 | push(p3); 54 | push(p2); 55 | subtract(); 56 | push(imaginaryunit); 57 | multiply(); 58 | push(p2); 59 | push(p3); 60 | add(); 61 | divide(); 62 | restore(); 63 | return; 64 | } 65 | 66 | if (car(p1) == symbol(COSH)) { 67 | p1 = cadr(p1); 68 | push(p1); 69 | exponential(); 70 | push(p1); 71 | negate(); 72 | exponential(); 73 | add(); 74 | push_rational(1, 2); 75 | multiply(); 76 | restore(); 77 | return; 78 | } 79 | 80 | if (car(p1) == symbol(SINH)) { 81 | p1 = cadr(p1); 82 | push(p1); 83 | exponential(); 84 | push(p1); 85 | negate(); 86 | exponential(); 87 | subtract(); 88 | push_rational(1, 2); 89 | multiply(); 90 | restore(); 91 | return; 92 | } 93 | 94 | if (car(p1) == symbol(TANH)) { 95 | p1 = cadr(p1); 96 | push(p1); 97 | push_integer(2); 98 | multiply(); 99 | exponential(); 100 | p1 = pop(); 101 | push(p1); 102 | push_integer(1); 103 | subtract(); 104 | push(p1); 105 | push_integer(1); 106 | add(); 107 | divide(); 108 | restore(); 109 | return; 110 | } 111 | 112 | if (iscons(p1)) { 113 | h = tos; 114 | while (iscons(p1)) { 115 | push(car(p1)); 116 | circexp(); 117 | p1 = cdr(p1); 118 | } 119 | list(tos - h); 120 | restore(); 121 | return; 122 | } 123 | 124 | if (p1->k == TENSOR) { 125 | push(p1); 126 | copy_tensor(); 127 | p1 = pop(); 128 | for (i = 0; i < p1->u.tensor->nelem; i++) { 129 | push(p1->u.tensor->elem[i]); 130 | circexp(); 131 | p1->u.tensor->elem[i] = pop(); 132 | } 133 | push(p1); 134 | restore(); 135 | return; 136 | } 137 | 138 | push(p1); 139 | restore(); 140 | } 141 | 142 | #if SELFTEST 143 | 144 | static char *s[] = { 145 | 146 | "circexp(cos(x))", 147 | "1/2*exp(-i*x)+1/2*exp(i*x)", 148 | 149 | "circexp(sin(x))", 150 | "1/2*i*exp(-i*x)-1/2*i*exp(i*x)", 151 | 152 | "circexp(tan(x))", 153 | "i*exp(-i*x)/(exp(-i*x)+exp(i*x))-i*exp(i*x)/(exp(-i*x)+exp(i*x))", 154 | 155 | "circexp(cosh(x))", 156 | "1/2*exp(x)+1/2*exp(-x)", 157 | 158 | "circexp(sinh(x))", 159 | "1/2*exp(x)-1/2*exp(-x)", 160 | 161 | "circexp(tanh(x))", 162 | "-1/(1+exp(2*x))+exp(2*x)/(1+exp(2*x))", 163 | 164 | "circexp((cos(x),sin(x)))", 165 | "(1/2*exp(-i*x)+1/2*exp(i*x),1/2*i*exp(-i*x)-1/2*i*exp(i*x))", 166 | 167 | "circexp(cos(x)*sin(x))-expcos(x)*expsin(x)", 168 | "0", 169 | }; 170 | 171 | void 172 | test_circexp(void) 173 | { 174 | test(__FILE__, s, sizeof s / sizeof (char *)); 175 | } 176 | 177 | #endif 178 | -------------------------------------------------------------------------------- /src/clear.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | int run_startup_script_again = 0; 4 | void 5 | eval_clear(void) 6 | { 7 | if (test_flag == 0) 8 | clear_term(); 9 | clear_symbols(); 10 | defn(); 11 | push(symbol(NIL)); 12 | run_startup_script_again = 1; 13 | } 14 | 15 | // clear from application GUI code 16 | 17 | void 18 | clear(void) 19 | { 20 | run("clear"); 21 | } 22 | -------------------------------------------------------------------------------- /src/clock.cpp: -------------------------------------------------------------------------------- 1 | /* Convert complex z to clock form 2 | 3 | Input: push z 4 | 5 | Output: Result on stack 6 | 7 | clock(z) = mag(z) * (-1) ^ (arg(z) / pi) 8 | 9 | For example, clock(exp(i pi/3)) gives the result (-1)^(1/3) 10 | */ 11 | 12 | #include "stdafx.h" 13 | #include "defs.h" 14 | 15 | void 16 | eval_clock(void) 17 | { 18 | push(cadr(p1)); 19 | eval(); 20 | clockform(); 21 | } 22 | 23 | void 24 | clockform(void) 25 | { 26 | save(); 27 | #if 1 28 | p1 = pop(); 29 | push(p1); 30 | mag(); 31 | push_integer(-1); 32 | push(p1); 33 | arg(); 34 | push(symbol(PI)); 35 | divide(); 36 | power(); 37 | multiply(); 38 | #else 39 | p1 = pop(); 40 | push(p1); 41 | mag(); 42 | push(symbol(E)); 43 | push(p1); 44 | arg(); 45 | push(imaginaryunit); 46 | multiply(); 47 | power(); 48 | multiply(); 49 | #endif 50 | restore(); 51 | } 52 | 53 | #if SELFTEST 54 | 55 | static char *s[] = { 56 | 57 | "clock(exp(i pi/3))", 58 | "(-1)^(1/3)", 59 | 60 | "clock(exp(-i pi/3))", 61 | "-(-1)^(2/3)", 62 | 63 | "rect(clock(3+4*i))", // needs sin(arctan(x)) and cos(arctan(x)) 64 | "3+4*i", 65 | }; 66 | 67 | void 68 | test_clock(void) 69 | { 70 | test(__FILE__, s, sizeof s / sizeof (char *)); 71 | } 72 | 73 | #endif 74 | -------------------------------------------------------------------------------- /src/coeff.cpp: -------------------------------------------------------------------------------- 1 | // get the coefficient of x^n in polynomial p(x) 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define P p1 7 | #define X p2 8 | #define N p3 9 | 10 | void 11 | eval_coeff(void) 12 | { 13 | push(cadr(p1)); // 1st arg, p 14 | eval(); 15 | 16 | push(caddr(p1)); // 2nd arg, x 17 | eval(); 18 | 19 | push(cadddr(p1)); // 3rd arg, n 20 | eval(); 21 | 22 | N = pop(); 23 | X = pop(); 24 | P = pop(); 25 | 26 | if (N == symbol(NIL)) { // only 2 args? 27 | N = X; 28 | X = symbol(SYMBOL_X); 29 | } 30 | 31 | push(P); // divide p by x^n 32 | push(X); 33 | push(N); 34 | power(); 35 | divide(); 36 | 37 | push(X); // keep the constant part 38 | filter(); 39 | } 40 | 41 | //----------------------------------------------------------------------------- 42 | // 43 | // Put polynomial coefficients on the stack 44 | // 45 | // Input: tos-2 p(x) 46 | // 47 | // tos-1 x 48 | // 49 | // Output: Returns number of coefficients on stack 50 | // 51 | // tos-n Coefficient of x^0 52 | // 53 | // tos-1 Coefficient of x^(n-1) 54 | // 55 | //----------------------------------------------------------------------------- 56 | 57 | int 58 | coeff(void) 59 | { 60 | int h, n; 61 | 62 | save(); 63 | 64 | p2 = pop(); 65 | p1 = pop(); 66 | 67 | h = tos; 68 | 69 | for (;;) { 70 | 71 | push(p1); 72 | push(p2); 73 | push(zero); 74 | subst(); 75 | eval(); 76 | 77 | p3 = pop(); 78 | push(p3); 79 | 80 | push(p1); 81 | push(p3); 82 | subtract(); 83 | 84 | p1 = pop(); 85 | 86 | if (equal(p1, zero)) { 87 | n = tos - h; 88 | restore(); 89 | return n; 90 | } 91 | 92 | push(p1); 93 | push(p2); 94 | divide(); 95 | p1 = pop(); 96 | } 97 | } 98 | 99 | #if SELFTEST 100 | 101 | static char *s[] = { 102 | 103 | "coeff(40*x^3+30*x^2+20*x+10,3)", 104 | "40", 105 | 106 | "coeff(40*x^3+30*x^2+20*x+10,2)", 107 | "30", 108 | 109 | "coeff(40*x^3+30*x^2+20*x+10,1)", 110 | "20", 111 | 112 | "coeff(40*x^3+30*x^2+20*x+10,0)", 113 | "10", 114 | 115 | "coeff(a*t^3+b*t^2+c*t+d,t,3)", 116 | "a", 117 | 118 | "coeff(a*t^3+b*t^2+c*t+d,t,2)", 119 | "b", 120 | 121 | "coeff(a*t^3+b*t^2+c*t+d,t,1)", 122 | "c", 123 | 124 | "coeff(a*t^3+b*t^2+c*t+d,t,0)", 125 | "d", 126 | }; 127 | 128 | void 129 | test_coeff(void) 130 | { 131 | test(__FILE__, s, sizeof s / sizeof (char *)); 132 | } 133 | 134 | #endif 135 | -------------------------------------------------------------------------------- /src/cofactor.cpp: -------------------------------------------------------------------------------- 1 | // Cofactor of a matrix component. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_cofactor(void) 8 | { 9 | int i, j, n; 10 | push(cadr(p1)); 11 | eval(); 12 | p2 = pop(); 13 | if (istensor(p2) && p2->u.tensor->ndim == 2 && p2->u.tensor->dim[0] == p2->u.tensor->dim[1]) 14 | ; 15 | else 16 | stop("cofactor: 1st arg: square matrix expected"); 17 | n = p2->u.tensor->dim[0]; 18 | push(caddr(p1)); 19 | eval(); 20 | i = pop_integer(); 21 | if (i < 1 || i > n) 22 | stop("cofactor: 2nd arg: row index expected"); 23 | push(cadddr(p1)); 24 | eval(); 25 | j = pop_integer(); 26 | if (j < 1 || j > n) 27 | stop("cofactor: 3rd arg: column index expected"); 28 | cofactor(p2, n, i - 1, j - 1); 29 | } 30 | 31 | void 32 | cofactor(U *p, int n, int row, int col) 33 | { 34 | int i, j; 35 | for (i = 0; i < n; i++) 36 | for (j = 0; j < n; j++) 37 | if (i != row && j != col) 38 | push(p->u.tensor->elem[n * i + j]); 39 | determinant(n - 1); 40 | if ((row + col) % 2) 41 | negate(); 42 | } 43 | 44 | #if SELFTEST 45 | 46 | static char *s[] = { 47 | 48 | "cofactor(((1,2),(3,4)),1,1)", 49 | "4", 50 | 51 | "cofactor(((1,2),(3,4)),1,2)", 52 | "-3", 53 | 54 | "cofactor(((1,2),(3,4)),2,1)", 55 | "-2", 56 | 57 | "cofactor(((1,2),(3,4)),2,2)", 58 | "1", 59 | 60 | "cofactor(((1,2,3),(4,5,6),(7,8,9)),1,2)", 61 | "6", 62 | }; 63 | 64 | void 65 | test_cofactor(void) 66 | { 67 | test(__FILE__, s, sizeof s / sizeof (char *)); 68 | } 69 | 70 | #endif 71 | -------------------------------------------------------------------------------- /src/condense.cpp: -------------------------------------------------------------------------------- 1 | // Condense an expression by factoring common terms. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_condense(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | Condense(); 12 | } 13 | 14 | void 15 | Condense(void) 16 | { 17 | int tmp; 18 | tmp = expanding; 19 | save(); 20 | yycondense(); 21 | restore(); 22 | expanding = tmp; 23 | } 24 | 25 | void 26 | yycondense(void) 27 | { 28 | expanding = 0; 29 | 30 | p1 = pop(); 31 | 32 | if (car(p1) != symbol(ADD)) { 33 | push(p1); 34 | return; 35 | } 36 | 37 | // get gcd of all terms 38 | 39 | p3 = cdr(p1); 40 | push(car(p3)); 41 | p3 = cdr(p3); 42 | while (iscons(p3)) { 43 | push(car(p3)); 44 | gcd(); 45 | p3 = cdr(p3); 46 | } 47 | 48 | //printf("condense: this is the gcd of all the terms:\n"); 49 | //print(stdout, stack[tos - 1]); 50 | 51 | // divide each term by gcd 52 | 53 | inverse(); 54 | p2 = pop(); 55 | push(zero); 56 | p3 = cdr(p1); 57 | while (iscons(p3)) { 58 | push(p2); 59 | push(car(p3)); 60 | multiply(); 61 | add(); 62 | p3 = cdr(p3); 63 | } 64 | 65 | // We multiplied above w/o expanding so sum factors cancelled. 66 | 67 | // Now we expand which which normalizes the result and, in some cases, 68 | // simplifies it too (see test case H). 69 | 70 | yyexpand(); 71 | 72 | // multiply result by gcd 73 | 74 | push(p2); 75 | divide(); 76 | } 77 | 78 | #if SELFTEST 79 | 80 | static char *s[] = { 81 | 82 | "condense(a/(a+b)+b/(a+b))", 83 | "1", 84 | 85 | "psi(n) = exp(-r/n) laguerre(2r/n,n-1,1)", 86 | "", 87 | 88 | "psi(3)", 89 | "3*exp(-1/3*r)-2*r*exp(-1/3*r)+2/9*r^2*exp(-1/3*r)", 90 | 91 | "condense(last)", 92 | "exp(-1/3*r)*(3-2*r+2/9*r^2)", 93 | 94 | "psi()=psi", 95 | "", 96 | 97 | // test case H 98 | 99 | "condense(-3 exp(-1/3 r + i phi) cos(theta) - 6 exp(-1/3 r + i phi) cos(theta) sin(theta)^2 + 12 exp(-1/3 r + i phi) cos(theta)^3)", 100 | "3*exp(-1/3*r+i*phi)*(-1+4*cos(theta)^2-2*sin(theta)^2)*cos(theta)", 101 | }; 102 | 103 | void 104 | test_condense(void) 105 | { 106 | test(__FILE__, s, sizeof s / sizeof (char *)); 107 | } 108 | 109 | #endif 110 | -------------------------------------------------------------------------------- /src/conj.cpp: -------------------------------------------------------------------------------- 1 | // Complex conjugate 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_conj(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | p1 = pop(); 12 | push(p1); 13 | if (!find(p1, imaginaryunit)) { // example: (-1)^(1/3) 14 | polar(); 15 | conjugate(); 16 | clockform(); 17 | } else 18 | conjugate(); 19 | } 20 | 21 | 22 | void 23 | conjugate(void) 24 | { 25 | push(imaginaryunit); 26 | push(imaginaryunit); 27 | negate(); 28 | subst(); 29 | eval(); 30 | } 31 | -------------------------------------------------------------------------------- /src/cons.cpp: -------------------------------------------------------------------------------- 1 | // Cons two things on the stack. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | cons(void) 8 | { 9 | // auto var ok, no opportunity for garbage collection after p = alloc() 10 | U *p; 11 | p = alloc(); 12 | p->k = CONS; 13 | p->u.cons.cdr = pop(); 14 | p->u.cons.car = pop(); 15 | push(p); 16 | } 17 | -------------------------------------------------------------------------------- /src/constantsProvider.hpp: -------------------------------------------------------------------------------- 1 | #ifndef DIRNAME 2 | #define DIRNAME (unsigned char*)"@EIGEN" 3 | #endif 4 | 5 | #ifndef SCRIPTFILE 6 | #define SCRIPTFILE (unsigned char*)"Script" 7 | #endif 8 | 9 | #ifndef SESSIONFILE 10 | #define SESSIONFILE (unsigned char*)"Session" 11 | #endif 12 | 13 | #ifndef DATAFOLDER 14 | #define DATAFOLDER (char*)"\\\\fls0\\@EIGEN" 15 | #endif 16 | 17 | #ifndef CONSOLESTATEFILE 18 | #define CONSOLESTATEFILE (char*)DATAFOLDER"\\eigencon.erd" 19 | #endif 20 | 21 | #ifndef SYMBOLSSTATEFILE 22 | #define SYMBOLSSTATEFILE (char*)DATAFOLDER"\\eigensym.erd" 23 | #endif 24 | 25 | #ifndef SELFFILE 26 | #define SELFFILE (char*)"eigenmath.g3a" 27 | #endif 28 | 29 | /* 30 | #ifndef ENABLE_DEBUG 31 | #define ENABLE_DEBUG 1 32 | #endif*/ -------------------------------------------------------------------------------- /src/contract.cpp: -------------------------------------------------------------------------------- 1 | // Contract across tensor indices 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_contract(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | if (cddr(p1) == symbol(NIL)) { 12 | push_integer(1); 13 | push_integer(2); 14 | } else { 15 | push(caddr(p1)); 16 | eval(); 17 | push(cadddr(p1)); 18 | eval(); 19 | } 20 | contract(); 21 | } 22 | 23 | void 24 | contract(void) 25 | { 26 | save(); 27 | yycontract(); 28 | restore(); 29 | } 30 | 31 | void 32 | yycontract(void) 33 | { 34 | int h, i, j, k, l, m, n, ndim, nelem; 35 | int ai[MAXDIM], an[MAXDIM]; 36 | U **a, **b; 37 | 38 | p3 = pop(); 39 | p2 = pop(); 40 | p1 = pop(); 41 | 42 | if (!istensor(p1)) { 43 | if (!iszero(p1)) 44 | stop("contract: tensor expected, 1st arg is not a tensor"); 45 | push(zero); 46 | return; 47 | } 48 | 49 | push(p2); 50 | l = pop_integer(); 51 | 52 | push(p3); 53 | m = pop_integer(); 54 | 55 | ndim = p1->u.tensor->ndim; 56 | 57 | if (l < 1 || l > ndim || m < 1 || m > ndim || l == m 58 | || p1->u.tensor->dim[l - 1] != p1->u.tensor->dim[m - 1]) 59 | stop("contract: index out of range"); 60 | 61 | l--; 62 | m--; 63 | 64 | n = p1->u.tensor->dim[l]; 65 | 66 | // nelem is the number of elements in "b" 67 | 68 | nelem = 1; 69 | for (i = 0; i < ndim; i++) 70 | if (i != l && i != m) 71 | nelem *= p1->u.tensor->dim[i]; 72 | 73 | p2 = alloc_tensor(nelem); 74 | 75 | p2->u.tensor->ndim = ndim - 2; 76 | 77 | j = 0; 78 | for (i = 0; i < ndim; i++) 79 | if (i != l && i != m) 80 | p2->u.tensor->dim[j++] = p1->u.tensor->dim[i]; 81 | 82 | a = p1->u.tensor->elem; 83 | b = p2->u.tensor->elem; 84 | 85 | for (i = 0; i < ndim; i++) { 86 | ai[i] = 0; 87 | an[i] = p1->u.tensor->dim[i]; 88 | } 89 | 90 | for (i = 0; i < nelem; i++) { 91 | push(zero); 92 | for (j = 0; j < n; j++) { 93 | ai[l] = j; 94 | ai[m] = j; 95 | h = 0; 96 | for (k = 0; k < ndim; k++) 97 | h = (h * an[k]) + ai[k]; 98 | push(a[h]); 99 | add(); 100 | } 101 | b[i] = pop(); 102 | for (j = ndim - 1; j >= 0; j--) { 103 | if (j == l || j == m) 104 | continue; 105 | if (++ai[j] < an[j]) 106 | break; 107 | ai[j] = 0; 108 | } 109 | } 110 | 111 | if (nelem == 1) 112 | push(b[0]); 113 | else 114 | push(p2); 115 | } 116 | 117 | #if SELFTEST 118 | 119 | static char *s[] = { 120 | 121 | "contract(0)", 122 | "0", 123 | 124 | "contract(0.0)", 125 | "0", 126 | 127 | "contract(((a,b),(c,d)))", 128 | "a+d", 129 | 130 | "contract(((1,2),(3,4)),1,2)", 131 | "5", 132 | 133 | "A=((a11,a12),(a21,a22))", 134 | "", 135 | 136 | "B=((b11,b12),(b21,b22))", 137 | "", 138 | 139 | "contract(outer(A,B),2,3)", 140 | "((a11*b11+a12*b21,a11*b12+a12*b22),(a21*b11+a22*b21,a21*b12+a22*b22))", 141 | 142 | "A=quote(A)", 143 | "", 144 | 145 | "B=quote(B)", 146 | "", 147 | }; 148 | 149 | void 150 | test_contract(void) 151 | { 152 | test(__FILE__, s, sizeof s / sizeof (char *)); 153 | } 154 | 155 | #endif 156 | -------------------------------------------------------------------------------- /src/cosh.cpp: -------------------------------------------------------------------------------- 1 | // exp(x) + exp(-x) 2 | // cosh(x) = ---------------- 3 | // 2 4 | 5 | #include "stdafx.h" 6 | #include "defs.h" 7 | 8 | void 9 | eval_cosh(void) 10 | { 11 | push(cadr(p1)); 12 | eval(); 13 | ycosh(); 14 | } 15 | 16 | void 17 | ycosh(void) 18 | { 19 | save(); 20 | yycosh(); 21 | restore(); 22 | } 23 | 24 | void 25 | yycosh(void) 26 | { 27 | double d; 28 | p1 = pop(); 29 | if (car(p1) == symbol(ARCCOSH)) { 30 | push(cadr(p1)); 31 | return; 32 | } 33 | if (isdouble(p1)) { 34 | d = cosh(p1->u.d); 35 | if (fabs(d) < 1e-10) 36 | d = 0.0; 37 | push_double(d); 38 | return; 39 | } 40 | if (iszero(p1)) { 41 | push(one); 42 | return; 43 | } 44 | push_symbol(COSH); 45 | push(p1); 46 | list(2); 47 | } 48 | 49 | #if SELFTEST 50 | 51 | static char *s[] = { 52 | 53 | "cosh(x)", 54 | "cosh(x)", 55 | 56 | "cosh(0)", 57 | "1", 58 | 59 | "cosh(arccosh(x))", 60 | "x", 61 | }; 62 | 63 | void 64 | test_cosh(void) 65 | { 66 | test(__FILE__, s, sizeof s / sizeof (char *)); 67 | } 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /src/dConsole.h: -------------------------------------------------------------------------------- 1 | #ifndef DCONSOLE_H 2 | #define DCONSOLE_H 3 | #define INPUTBUFLEN 500 4 | #define LINE_ROW_MAX 200 // virtual console size (for console scrollback) 5 | #define LINE_COL_MAX 32 6 | //command history numbers: 7 | #define N 41 8 | #define HISTORYHEAP_N N+4 9 | typedef char line_row[LINE_COL_MAX+1]; 10 | 11 | extern int vsprintf(char *, const char *, char *); 12 | typedef char *va_list ; 13 | 14 | #define va_start(ap,param) (void)((ap)=(int)\ 15 | ((char *) &(param)+sizeof(param))%4u?\ 16 | (char *) &(param)+sizeof(param)+(4u-(sizeof(param)%4u)):\ 17 | (char *) &(param)+sizeof(param)) 18 | 19 | #define va_arg(ap,type) (*((ap)=((int)((ap)+sizeof(type))%4u?\ 20 | (ap)+sizeof(type)+(4u-(sizeof(type)%4u)):\ 21 | (ap)+sizeof(type)),\ 22 | (type *)((int)((ap)-sizeof(type))%4u?\ 23 | (ap)-sizeof(type)-(4u-(sizeof(type)%4u)):\ 24 | (ap)-sizeof(type)))) 25 | 26 | #define va_end(ap) 27 | 28 | void initializeConsoleMemory(line_row* area); 29 | 30 | int dGetLineBox (char * s,int max,int width,int x,int y); 31 | 32 | void dConsoleRedraw (); 33 | 34 | void dConsolePut(const char * str); 35 | void dConsolePutChar (char c); 36 | 37 | int dGetLine (char * s,int max, int isRecording=0, int ml=0); 38 | 39 | //int dPrintf (const char * format,...); 40 | 41 | void dConsoleCls (); 42 | void dPuts(const char *); 43 | 44 | //#define printf dPrintf 45 | #define puts dPuts 46 | #define putchar dConsolePutChar 47 | #define gets dGetLine 48 | 49 | void save_console_state_smem(); 50 | void load_console_state_smem(); 51 | 52 | #endif -------------------------------------------------------------------------------- /src/data.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | int endian = 1; 5 | 6 | U *p0, *p1, *p2, *p3, *p4, *p5, *p6, *p7, *p8, *p9; 7 | 8 | U *zero, *one, *imaginaryunit; 9 | 10 | U symtab[NSYM], *binding[NSYM], *arglist[NSYM]; 11 | 12 | int expanding; 13 | //int verbosing; 14 | int esc_flag; 15 | int test_flag; 16 | int draw_flag; 17 | int trigmode; 18 | #if SELFTEST 19 | char logbuf[256]; 20 | #endif 21 | -------------------------------------------------------------------------------- /src/decomp.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_decomp(void) 6 | { 7 | int h = tos; 8 | push(symbol(NIL)); 9 | push(cadr(p1)); 10 | eval(); 11 | push(caddr(p1)); 12 | eval(); 13 | p1 = pop(); 14 | if (p1 == symbol(NIL)) 15 | guess(); 16 | else 17 | push(p1); 18 | decomp(); 19 | list(tos - h); 20 | } 21 | 22 | // returns constant expresions on the stack 23 | 24 | void 25 | decomp(void) 26 | { 27 | save(); 28 | 29 | p2 = pop(); 30 | p1 = pop(); 31 | 32 | // is the entire expression constant? 33 | 34 | if (find(p1, p2) == 0) { 35 | push(p1); 36 | //push(p1); // may need later for pushing both +a, -a 37 | //negate(); 38 | restore(); 39 | return; 40 | } 41 | 42 | // sum? 43 | 44 | if (isadd(p1)) { 45 | decomp_sum(); 46 | restore(); 47 | return; 48 | } 49 | 50 | // product? 51 | 52 | if (car(p1) == symbol(MULTIPLY)) { 53 | decomp_product(); 54 | restore(); 55 | return; 56 | } 57 | 58 | // naive decomp if not sum or product 59 | 60 | p3 = cdr(p1); 61 | while (iscons(p3)) { 62 | push(car(p3)); 63 | push(p2); 64 | decomp(); 65 | p3 = cdr(p3); 66 | } 67 | 68 | restore(); 69 | } 70 | 71 | void 72 | decomp_sum(void) 73 | { 74 | int h; 75 | 76 | // decomp terms involving x 77 | 78 | p3 = cdr(p1); 79 | 80 | while (iscons(p3)) { 81 | if (find(car(p3), p2)) { 82 | push(car(p3)); 83 | push(p2); 84 | decomp(); 85 | } 86 | p3 = cdr(p3); 87 | } 88 | 89 | // add together all constant terms 90 | 91 | h = tos; 92 | 93 | p3 = cdr(p1); 94 | 95 | while (iscons(p3)) { 96 | if (find(car(p3), p2) == 0) 97 | push(car(p3)); 98 | p3 = cdr(p3); 99 | } 100 | 101 | if (tos - h) { 102 | add_all(tos - h); 103 | p3 = pop(); 104 | push(p3); 105 | push(p3); 106 | negate(); // need both +a, -a for some integrals 107 | } 108 | } 109 | 110 | void 111 | decomp_product(void) 112 | { 113 | int h; 114 | 115 | // decomp factors involving x 116 | 117 | p3 = cdr(p1); 118 | 119 | while (iscons(p3)) { 120 | if (find(car(p3), p2)) { 121 | push(car(p3)); 122 | push(p2); 123 | decomp(); 124 | } 125 | p3 = cdr(p3); 126 | } 127 | 128 | // multiply together all constant factors 129 | 130 | h = tos; 131 | 132 | p3 = cdr(p1); 133 | 134 | while (iscons(p3)) { 135 | if (find(car(p3), p2) == 0) 136 | push(car(p3)); 137 | p3 = cdr(p3); 138 | } 139 | 140 | if (tos - h) { 141 | multiply_all(tos - h); 142 | //p3 = pop(); // may need later for pushing both +a, -a 143 | //push(p3); 144 | //push(p3); 145 | //negate(); 146 | } 147 | } 148 | -------------------------------------------------------------------------------- /src/define.cpp: -------------------------------------------------------------------------------- 1 | // Store a function definition 2 | // 3 | // Example: 4 | // 5 | // f(x,y)=x^y 6 | // 7 | // For this definition, p1 points to the following structure. 8 | // 9 | // p1 10 | // | 11 | // ___v__ ______ ______ 12 | // |CONS |->|CONS |--------------------->|CONS | 13 | // |______| |______| |______| 14 | // | | | 15 | // ___v__ ___v__ ______ ______ ___v__ ______ ______ 16 | // |SETQ | |CONS |->|CONS |->|CONS | |CONS |->|CONS |->|CONS | 17 | // |______| |______| |______| |______| |______| |______| |______| 18 | // | | | | | | 19 | // ___v__ ___v__ ___v__ ___v__ ___v__ ___v__ 20 | // |SYM f | |SYM x | |SYM y | |POWER | |SYM x | |SYM y | 21 | // |______| |______| |______| |______| |______| |______| 22 | // 23 | // We have 24 | // 25 | // caadr(p1) points to f 26 | // cdadr(p1) points to the list (x y) 27 | // caddr(p1) points to (power x y) 28 | 29 | #include "stdafx.h" 30 | #include "defs.h" 31 | 32 | #define F p3 // F points to the function name 33 | #define A p4 // A points to the argument list 34 | #define B p5 // B points to the function body 35 | 36 | void 37 | define_user_function(void) 38 | { 39 | F = caadr(p1); 40 | A = cdadr(p1); 41 | B = caddr(p1); 42 | 43 | if (!issymbol(F)) 44 | stop("function name?"); 45 | 46 | // evaluate function body (maybe) 47 | 48 | if (car(B) == symbol(EVAL)) { 49 | push(cadr(B)); 50 | eval(); 51 | B = pop(); 52 | } 53 | 54 | set_binding_and_arglist(F, B, A); 55 | 56 | // return value is nil 57 | 58 | push_symbol(NIL); 59 | } 60 | -------------------------------------------------------------------------------- /src/defint.cpp: -------------------------------------------------------------------------------- 1 | // definite integral 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define F p2 7 | #define X p3 8 | #define A p4 9 | #define B p5 10 | 11 | void 12 | eval_defint(void) 13 | { 14 | push(cadr(p1)); 15 | eval(); 16 | F = pop(); 17 | 18 | p1 = cddr(p1); 19 | 20 | while (iscons(p1)) { 21 | 22 | push(car(p1)); 23 | p1 = cdr(p1); 24 | eval(); 25 | X = pop(); 26 | 27 | push(car(p1)); 28 | p1 = cdr(p1); 29 | eval(); 30 | A = pop(); 31 | 32 | push(car(p1)); 33 | p1 = cdr(p1); 34 | eval(); 35 | B = pop(); 36 | 37 | push(F); 38 | push(X); 39 | integral(); 40 | F = pop(); 41 | 42 | push(F); 43 | push(X); 44 | push(B); 45 | subst(); 46 | eval(); 47 | 48 | push(F); 49 | push(X); 50 | push(A); 51 | subst(); 52 | eval(); 53 | 54 | subtract(); 55 | F = pop(); 56 | } 57 | 58 | push(F); 59 | } 60 | 61 | #if SELFTEST 62 | 63 | static char *s[] = { 64 | "defint(x^2,y,0,sqrt(1-x^2),x,-1,1)", 65 | "1/8*pi", 66 | 67 | // from the eigenmath manual 68 | 69 | "z=2", 70 | "", 71 | 72 | "P=(x,y,z)", 73 | "", 74 | 75 | "a=abs(cross(d(P,x),d(P,y)))", 76 | "", 77 | 78 | "defint(a,y,-sqrt(1-x^2),sqrt(1-x^2),x,-1,1)", 79 | "pi", 80 | 81 | // from the eigenmath manual 82 | 83 | "z=x^2+2y", 84 | "", 85 | 86 | "P=(x,y,z)", 87 | "", 88 | 89 | "a=abs(cross(d(P,x),d(P,y)))", 90 | "", 91 | 92 | "defint(a,x,0,1,y,0,1)", 93 | "3/2+5/8*log(5)", 94 | 95 | // from the eigenmath manual 96 | 97 | "x=u*cos(v)", 98 | "", 99 | 100 | "y=u*sin(v)", 101 | "", 102 | 103 | "z=v", 104 | "", 105 | 106 | "S=(x,y,z)", 107 | "", 108 | 109 | "a=abs(cross(d(S,u),d(S,v)))", 110 | "", 111 | 112 | "defint(a,u,0,1,v,0,3pi)", 113 | "3/2*pi*log(1+2^(1/2))+3*pi/(2^(1/2))", 114 | }; 115 | 116 | void 117 | test_defint(void) 118 | { 119 | test(__FILE__, s, sizeof s / sizeof (char *)); 120 | } 121 | 122 | #endif 123 | -------------------------------------------------------------------------------- /src/degree.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_degree(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | push(caddr(p1)); 10 | eval(); 11 | p1 = pop(); 12 | if (p1 == symbol(NIL)) 13 | guess(); 14 | else 15 | push(p1); 16 | degree(); 17 | } 18 | 19 | //----------------------------------------------------------------------------- 20 | // 21 | // Find the degree of a polynomial 22 | // 23 | // Input: tos-2 p(x) 24 | // 25 | // tos-1 x 26 | // 27 | // Output: Result on stack 28 | // 29 | // Note: Finds the largest numerical power of x. Does not check for 30 | // weirdness in p(x). 31 | // 32 | //----------------------------------------------------------------------------- 33 | 34 | #define POLY p1 35 | #define X p2 36 | #define DEGREE p3 37 | 38 | void 39 | degree(void) 40 | { 41 | save(); 42 | X = pop(); 43 | POLY = pop(); 44 | DEGREE = zero; 45 | yydegree(POLY); 46 | push(DEGREE); 47 | restore(); 48 | } 49 | 50 | void 51 | yydegree(U *p) 52 | { 53 | if (equal(p, X)) { 54 | if (iszero(DEGREE)) 55 | DEGREE = one; 56 | } else if (car(p) == symbol(POWER)) { 57 | if (equal(cadr(p), X) && isnum(caddr(p)) && lessp(DEGREE, caddr(p))) 58 | DEGREE = caddr(p); 59 | } else if (iscons(p)) { 60 | p = cdr(p); 61 | while (iscons(p)) { 62 | yydegree(car(p)); 63 | p = cdr(p); 64 | } 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /src/denominator.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_denominator(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | denominator(); 10 | } 11 | 12 | void 13 | denominator(void) 14 | { 15 | int h; 16 | 17 | save(); 18 | 19 | p1 = pop(); 20 | 21 | if (car(p1) == symbol(ADD)) { 22 | push(p1); 23 | rationalize(); 24 | p1 = pop(); 25 | } 26 | 27 | if (car(p1) == symbol(MULTIPLY)) { 28 | h = tos; 29 | p1 = cdr(p1); 30 | while (iscons(p1)) { 31 | push(car(p1)); 32 | denominator(); 33 | p1 = cdr(p1); 34 | } 35 | multiply_all(tos - h); 36 | } else if (isrational(p1)) { 37 | push(p1); 38 | mp_denominator(); 39 | } else if (car(p1) == symbol(POWER) && isnegativeterm(caddr(p1))) { 40 | push(p1); 41 | reciprocate(); 42 | } else 43 | push(one); 44 | 45 | restore(); 46 | } 47 | 48 | #if SELFTEST 49 | 50 | static char *s[] = { 51 | 52 | "denominator(2/3)", 53 | "3", 54 | 55 | "denominator(x)", 56 | "1", 57 | 58 | "denominator(1/x)", 59 | "x", 60 | 61 | "denominator(a+b)", 62 | "1", 63 | 64 | "denominator(1/a+1/b)", 65 | "a*b", 66 | 67 | // denominator function expands 68 | 69 | "denominator(1/(x-1)/(x-2))", 70 | "x^2-3*x+2", 71 | }; 72 | 73 | void 74 | test_denominator(void) 75 | { 76 | test(__FILE__, s, sizeof s / sizeof (char *)); 77 | } 78 | 79 | #endif 80 | -------------------------------------------------------------------------------- /src/dirac.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Author : philippe.billet@noos.fr 4 | // 5 | // Dirac function dirac(x) 6 | // dirac(-x)=dirac(x) 7 | // dirac(b-a)=dirac(a-b) 8 | //----------------------------------------------------------------------------- 9 | 10 | #include "stdafx.h" 11 | #include "defs.h" 12 | static void ydirac(void); 13 | 14 | void 15 | eval_dirac(void) 16 | { 17 | push(cadr(p1)); 18 | eval(); 19 | dirac(); 20 | } 21 | 22 | void 23 | dirac(void) 24 | { 25 | save(); 26 | ydirac(); 27 | restore(); 28 | } 29 | 30 | #define X p1 31 | 32 | static void 33 | ydirac(void) 34 | { 35 | 36 | X = pop(); 37 | 38 | 39 | 40 | if (isdouble(X)) { 41 | if (X->u.d == 0) 42 | {push_integer(1); 43 | return;} 44 | else 45 | {push_integer(0); 46 | return;} 47 | } 48 | 49 | if (isrational(X)) { 50 | if (MZERO(mmul(X->u.q.a,X->u.q.b))) 51 | {push_integer(1); 52 | return;} 53 | else 54 | {push_integer(0); 55 | return;} 56 | 57 | } 58 | 59 | if (car(X) == symbol(POWER)) { 60 | push_symbol(DIRAC); 61 | push(cadr(X)); 62 | list(2); 63 | return; 64 | } 65 | 66 | if (isnegativeterm(X)) { 67 | push_symbol(DIRAC); 68 | push(X); 69 | negate(); 70 | list(2); 71 | return; 72 | } 73 | 74 | if (isnegativeterm(p1) || (car(p1) == symbol(ADD) && isnegativeterm(cadr(p1)))) { 75 | push(p1); 76 | negate(); 77 | p1 = pop(); 78 | } 79 | 80 | 81 | push_symbol(DIRAC); 82 | push(X); 83 | list(2); 84 | } 85 | 86 | #if SELFTEST 87 | 88 | static char *s[] = { 89 | 90 | 91 | "dirac(-x)", 92 | "dirac(x)", 93 | }; 94 | 95 | void 96 | test_dirac(void) 97 | { 98 | test(__FILE__, s, sizeof s / sizeof (char *)); 99 | } 100 | 101 | #endif 102 | -------------------------------------------------------------------------------- /src/distill.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | 3 | #include "defs.h" 4 | 5 | static void _distill(void); 6 | 7 | // take expr and push all constant subexpr 8 | 9 | // p1 expr 10 | 11 | // p2 independent variable (like x) 12 | 13 | void 14 | distill(void) 15 | { 16 | save(); 17 | _distill(); 18 | restore(); 19 | } 20 | 21 | static void 22 | _distill(void) 23 | { 24 | p2 = pop(); 25 | p1 = pop(); 26 | 27 | // is the entire expression constant? 28 | 29 | if (find(p1, p2) == 0) { 30 | push(p1); 31 | //push(p1); // may need later for pushing both +a, -a 32 | //negate(); 33 | return; 34 | } 35 | 36 | // sum? 37 | 38 | if (isadd(p1)) { 39 | distill_sum(); 40 | return; 41 | } 42 | 43 | // product? 44 | 45 | if (car(p1) == symbol(MULTIPLY)) { 46 | distill_product(); 47 | return; 48 | } 49 | 50 | // naive distill if not sum or product 51 | 52 | p3 = cdr(p1); 53 | while (iscons(p3)) { 54 | push(car(p3)); 55 | push(p2); 56 | distill(); 57 | p3 = cdr(p3); 58 | } 59 | } 60 | 61 | void 62 | distill_sum(void) 63 | { 64 | int h; 65 | 66 | // distill terms involving x 67 | 68 | p3 = cdr(p1); 69 | 70 | while (iscons(p3)) { 71 | if (find(car(p3), p2)) { 72 | push(car(p3)); 73 | push(p2); 74 | distill(); 75 | } 76 | p3 = cdr(p3); 77 | } 78 | 79 | // add together all constant terms 80 | 81 | h = tos; 82 | 83 | p3 = cdr(p1); 84 | 85 | while (iscons(p3)) { 86 | if (find(car(p3), p2) == 0) 87 | push(car(p3)); 88 | p3 = cdr(p3); 89 | } 90 | 91 | if (tos - h) { 92 | add_all(tos - h); 93 | p3 = pop(); 94 | push(p3); 95 | push(p3); 96 | negate(); // need both +a, -a for some integrals 97 | } 98 | } 99 | 100 | void 101 | distill_product(void) 102 | { 103 | int h; 104 | 105 | // distill factors involving x 106 | 107 | p3 = cdr(p1); 108 | 109 | while (iscons(p3)) { 110 | if (find(car(p3), p2)) { 111 | push(car(p3)); 112 | push(p2); 113 | distill(); 114 | } 115 | p3 = cdr(p3); 116 | } 117 | 118 | // multiply together all constant factors 119 | 120 | h = tos; 121 | 122 | p3 = cdr(p1); 123 | 124 | while (iscons(p3)) { 125 | if (find(car(p3), p2) == 0) 126 | push(car(p3)); 127 | p3 = cdr(p3); 128 | } 129 | 130 | if (tos - h) { 131 | multiply_all(tos - h); 132 | //p3 = pop(); // may need later for pushing both +a, -a 133 | //push(p3); 134 | //push(p3); 135 | //negate(); 136 | } 137 | } 138 | -------------------------------------------------------------------------------- /src/dpow.cpp: -------------------------------------------------------------------------------- 1 | // power function for double precision floating point 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | dpow(void) 8 | { 9 | double a, b, base, expo, result, theta; 10 | 11 | expo = pop_double(); 12 | base = pop_double(); 13 | 14 | // divide by zero? 15 | 16 | if (base == 0.0 && expo < 0.0) 17 | stop("divide by zero"); 18 | 19 | // nonnegative base or integer power? 20 | 21 | if (base >= 0.0 || fmod(expo, 1.0) == 0.0) { 22 | result = pow(base, expo); 23 | push_double(result); 24 | return; 25 | } 26 | 27 | result = pow(fabs(base), expo); 28 | 29 | theta = M_PI * expo; 30 | 31 | // this ensures the real part is 0.0 instead of a tiny fraction 32 | 33 | if (fmod(expo, 0.5) == 0.0) { 34 | a = 0.0; 35 | b = sin(theta); 36 | } else { 37 | a = cos(theta); 38 | b = sin(theta); 39 | } 40 | 41 | push_double(a * result); 42 | push_double(b * result); 43 | push(imaginaryunit); 44 | multiply(); 45 | add(); 46 | } 47 | -------------------------------------------------------------------------------- /src/dsolve.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | 3 | #include "defs.h" 4 | 5 | // q(x)y' + p(x)*y = g(x) 6 | // 7 | // u(x) = exp(integral(p)) 8 | // 9 | // y = (integral(u*g) + c) / u(x) 10 | 11 | 12 | #define f p1 13 | #define y p2 14 | #define x p3 15 | 16 | #define p p4 17 | #define g p5 18 | #define q p6 19 | 20 | #define mu p7 21 | 22 | void 23 | dsolve(void) 24 | { 25 | int n; 26 | 27 | save(); 28 | 29 | x = pop(); 30 | y = pop(); 31 | f = pop(); 32 | 33 | push(f); 34 | push(y); 35 | push(x); 36 | 37 | n = distilly(); 38 | 39 | if (n != 3) 40 | stop("error in dsolve"); 41 | 42 | q=pop(); 43 | 44 | p = pop(); 45 | 46 | negate(); 47 | g = pop(); 48 | 49 | /* print(g); 50 | print(p); 51 | print(p); 52 | */ 53 | push(p); 54 | push(q); 55 | divide(); 56 | push(x); 57 | integral(); 58 | exponential(); 59 | mu = pop(); 60 | 61 | push(mu); 62 | push(g); 63 | push(q); 64 | divide(); 65 | multiply(); 66 | push(x); 67 | integral(); 68 | scan("C"); 69 | add(); 70 | push(mu); 71 | divide(); 72 | 73 | restore(); 74 | } 75 | 76 | // n p1 p2 p3 p4 p5 stack 77 | 78 | // 1 4y'+3xy+2x+1 y x 1 2x+1 2x+1 79 | 80 | // 2 4y'+3xy y' x y 3xy 3x 81 | 82 | // 3 4y' y'' x y' 4y' 4 83 | 84 | int distilly() 85 | { 86 | int n = 0; 87 | save(); 88 | p4 = one; 89 | p3 = pop(); 90 | p2 = pop(); 91 | p1 = pop(); 92 | while (1) { 93 | n++; 94 | push(p1); 95 | push(p2); 96 | push(zero); 97 | subst(); 98 | eval(); 99 | p5 = pop(); 100 | push(p5); 101 | push(p4); 102 | divide(); 103 | push(p1); 104 | push(p5); 105 | subtract(); 106 | p1 = pop(); 107 | if (equal(p1, zero)) 108 | break; 109 | p4 = p2; 110 | push(p2); 111 | push(p3); 112 | derivative(); 113 | p2 = pop(); 114 | } 115 | restore(); 116 | return n; 117 | } 118 | -------------------------------------------------------------------------------- /src/erf.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Author : philippe.billet@noos.fr 4 | // 5 | // Error function erf(x) 6 | // erf(-x)=erf(x) 7 | // 8 | //----------------------------------------------------------------------------- 9 | 10 | #include "stdafx.h" 11 | #include "defs.h" 12 | static void yyerf(void); 13 | 14 | void 15 | eval_erf(void) 16 | { 17 | push(cadr(p1)); 18 | eval(); 19 | yerf(); 20 | } 21 | 22 | void 23 | yerf(void) 24 | { 25 | save(); 26 | yyerf(); 27 | restore(); 28 | } 29 | 30 | static void 31 | yyerf(void) 32 | { 33 | double d; 34 | 35 | p1 = pop(); 36 | 37 | if (isdouble(p1)) { 38 | d = 1.0 - erfc(p1->u.d); 39 | push_double(d); 40 | return; 41 | } 42 | 43 | if (isnegativeterm(p1)) { 44 | push_symbol(ERF); 45 | push(p1); 46 | negate(); 47 | list(2); 48 | negate(); 49 | return; 50 | } 51 | 52 | push_symbol(ERF); 53 | push(p1); 54 | list(2); 55 | return; 56 | } 57 | 58 | #if SELFTEST 59 | 60 | static char *s[] = { 61 | 62 | "erf(a)", 63 | "erf(a)", 64 | 65 | "erf(0.0) + 1", // add 1 to round off 66 | "1", 67 | 68 | "float(erf(0)) + 1", // add 1 to round off 69 | "1", 70 | #if 0 71 | "float(erf(1))", 72 | "0.842701", 73 | #endif 74 | }; 75 | 76 | void 77 | test_erf(void) 78 | { 79 | test(__FILE__, s, sizeof s / sizeof (char *)); 80 | } 81 | 82 | #endif 83 | -------------------------------------------------------------------------------- /src/erfc.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Author : philippe.billet@noos.fr 4 | // 5 | // erfc(x) 6 | // 7 | // GW Added erfc() from Numerical Recipes in C 8 | // 9 | //----------------------------------------------------------------------------- 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | static void yyerfc(void); 14 | 15 | void 16 | eval_erfc(void) 17 | { 18 | push(cadr(p1)); 19 | eval(); 20 | yerfc(); 21 | } 22 | 23 | void 24 | yerfc(void) 25 | { 26 | save(); 27 | yyerfc(); 28 | restore(); 29 | } 30 | 31 | static void 32 | yyerfc(void) 33 | { 34 | double d; 35 | 36 | p1 = pop(); 37 | 38 | if (isdouble(p1)) { 39 | d = erfc(p1->u.d); 40 | push_double(d); 41 | return; 42 | } 43 | 44 | push_symbol(ERFC); 45 | push(p1); 46 | list(2); 47 | return; 48 | } 49 | 50 | // from Numerical Recipes in C 51 | 52 | #ifndef LINUX 53 | double 54 | erfc(double x) 55 | { 56 | double t, z, ans; 57 | z = fabs(x); 58 | t = 1.0 / (1.0 + 0.5 * z); 59 | 60 | ans=t*exp(-z*z-1.26551223+t*(1.00002368+t*(0.37409196+t*(0.09678418+ 61 | t*(-0.18628806+t*(0.27886807+t*(-1.13520398+t*(1.48851587+ 62 | t*(-0.82215223+t*0.17087277))))))))); 63 | 64 | return x >= 0.0 ? ans : 2.0-ans; 65 | } 66 | #endif 67 | 68 | #if SELFTEST 69 | 70 | static char *s[] = { 71 | 72 | "erfc(a)", 73 | "erfc(a)", 74 | 75 | "erfc(0.0)", 76 | "1", 77 | 78 | "float(erfc(0))", 79 | "1", 80 | #if 0 81 | "float(erfc(1))", 82 | "0.157299", 83 | #endif 84 | }; 85 | 86 | void 87 | test_erfc(void) 88 | { 89 | test(__FILE__, s, sizeof s / sizeof (char *)); 90 | } 91 | 92 | #endif 93 | -------------------------------------------------------------------------------- /src/expcos.cpp: -------------------------------------------------------------------------------- 1 | // Do the exponential cosine function. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_expcos(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | expcos(); 12 | } 13 | 14 | void 15 | expcos(void) 16 | { 17 | save(); 18 | 19 | p1 = pop(); 20 | 21 | push(imaginaryunit); 22 | push(p1); 23 | multiply(); 24 | exponential(); 25 | push_rational(1, 2); 26 | multiply(); 27 | 28 | push(imaginaryunit); 29 | negate(); 30 | push(p1); 31 | multiply(); 32 | exponential(); 33 | push_rational(1, 2); 34 | multiply(); 35 | 36 | add(); 37 | 38 | restore(); 39 | } 40 | 41 | #if SELFTEST 42 | 43 | static char *s[] = { 44 | 45 | "expcos(x)", 46 | "1/2*exp(-i*x)+1/2*exp(i*x)", 47 | }; 48 | 49 | void 50 | test_expcos(void) 51 | { 52 | test(__FILE__, s, sizeof s / sizeof (char *)); 53 | } 54 | 55 | #endif 56 | -------------------------------------------------------------------------------- /src/expsin.cpp: -------------------------------------------------------------------------------- 1 | // Do the exponential sine function. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_expsin(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | expsin(); 12 | } 13 | 14 | void 15 | expsin(void) 16 | { 17 | save(); 18 | 19 | p1 = pop(); 20 | 21 | push(imaginaryunit); 22 | push(p1); 23 | multiply(); 24 | exponential(); 25 | push(imaginaryunit); 26 | divide(); 27 | push_rational(1, 2); 28 | multiply(); 29 | 30 | push(imaginaryunit); 31 | negate(); 32 | push(p1); 33 | multiply(); 34 | exponential(); 35 | push(imaginaryunit); 36 | divide(); 37 | push_rational(1, 2); 38 | multiply(); 39 | 40 | subtract(); 41 | 42 | restore(); 43 | } 44 | 45 | #if SELFTEST 46 | 47 | static char *s[] = { 48 | 49 | "expsin(x)", 50 | "1/2*i*exp(-i*x)-1/2*i*exp(i*x)", 51 | }; 52 | 53 | void 54 | test_expsin(void) 55 | { 56 | test(__FILE__, s, sizeof s / sizeof (char *)); 57 | } 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /src/factor.cpp: -------------------------------------------------------------------------------- 1 | // factor a polynomial or integer 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_factor(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | 12 | push(caddr(p1)); 13 | eval(); 14 | 15 | p2 = pop(); 16 | if (p2 == symbol(NIL)) 17 | guess(); 18 | else 19 | push(p2); 20 | 21 | factor(); 22 | 23 | // more factoring? 24 | 25 | p1 = cdddr(p1); 26 | while (iscons(p1)) { 27 | push(car(p1)); 28 | eval(); 29 | factor_again(); 30 | p1 = cdr(p1); 31 | } 32 | } 33 | 34 | void 35 | factor_again(void) 36 | { 37 | int h, n; 38 | 39 | save(); 40 | 41 | p2 = pop(); 42 | p1 = pop(); 43 | 44 | h = tos; 45 | 46 | if (car(p1) == symbol(MULTIPLY)) { 47 | p1 = cdr(p1); 48 | while (iscons(p1)) { 49 | push(car(p1)); 50 | push(p2); 51 | factor_term(); 52 | p1 = cdr(p1); 53 | } 54 | } else { 55 | push(p1); 56 | push(p2); 57 | factor_term(); 58 | } 59 | 60 | n = tos - h; 61 | 62 | if (n > 1) 63 | multiply_all_noexpand(n); 64 | 65 | restore(); 66 | } 67 | 68 | void 69 | factor_term(void) 70 | { 71 | save(); 72 | factorpoly(); 73 | p1 = pop(); 74 | if (car(p1) == symbol(MULTIPLY)) { 75 | p1 = cdr(p1); 76 | while (iscons(p1)) { 77 | push(car(p1)); 78 | p1 = cdr(p1); 79 | } 80 | } else 81 | push(p1); 82 | restore(); 83 | } 84 | 85 | void 86 | factor(void) 87 | { 88 | save(); 89 | p2 = pop(); 90 | p1 = pop(); 91 | if (isinteger(p1)) { 92 | push(p1); 93 | factor_number(); // see pollard.cpp 94 | } else { 95 | push(p1); 96 | push(p2); 97 | factorpoly(); 98 | } 99 | restore(); 100 | } 101 | 102 | // for factoring small integers (2^32 or less) 103 | 104 | void 105 | factor_small_number(void) 106 | { 107 | int d, expo, i, n; 108 | 109 | save(); 110 | 111 | n = pop_integer(); 112 | 113 | if (n == (int) 0x80000000) 114 | stop("number too big to factor"); 115 | 116 | if (n < 0) 117 | n = -n; 118 | 119 | for (i = 0; i < MAXPRIMETAB; i++) { 120 | 121 | //d = primetab[i]; 122 | d = get_prime_number(i); 123 | 124 | if (d > n / d) 125 | break; 126 | 127 | expo = 0; 128 | 129 | while (n % d == 0) { 130 | n /= d; 131 | expo++; 132 | } 133 | 134 | if (expo) { 135 | push_integer(d); 136 | push_integer(expo); 137 | } 138 | } 139 | 140 | if (n > 1) { 141 | push_integer(n); 142 | push_integer(1); 143 | } 144 | 145 | restore(); 146 | } 147 | 148 | #if SELFTEST 149 | 150 | static char *s[] = { 151 | 152 | "factor(0)", 153 | "0", 154 | 155 | "factor(1)", 156 | "1", 157 | 158 | "factor(2)", 159 | "2", 160 | 161 | "factor(3)", 162 | "3", 163 | 164 | "factor(4)", 165 | "2^2", 166 | 167 | "factor(5)", 168 | "5", 169 | 170 | "factor(6)", 171 | "2*3", 172 | 173 | "factor(7)", 174 | "7", 175 | 176 | "factor(8)", 177 | "2^3", 178 | 179 | "factor(9)", 180 | "3^2", 181 | 182 | "factor(10)", 183 | "2*5", 184 | 185 | "factor(100!)", 186 | "2^97*3^48*5^24*7^16*11^9*13^7*17^5*19^5*23^4*29^3*31^3*37^2*41^2*43^2*47^2*53*59*61*67*71*73*79*83*89*97", 187 | 188 | "factor(2*(2^30-35))", 189 | "2*1073741789", 190 | 191 | // x is the 10,000th prime 192 | 193 | // Prime factors greater than x^2 are found using the Pollard rho method 194 | 195 | "a=104729", 196 | "", 197 | 198 | "factor(2*(a^2+6))", 199 | "2*10968163447", 200 | 201 | "factor((a^2+6)^2)", 202 | "10968163447*10968163447", // FIXME should be 10968163447^2 203 | 204 | "factor((a^2+6)*(a^2+60))", 205 | "10968163501*10968163447", // FIXME sort order 206 | 207 | "f=(x+1)(x+2)(y+3)(y+4)", 208 | "", 209 | 210 | "factor(f,x,y)", 211 | "(x+1)*(x+2)*(y+3)*(y+4)", 212 | 213 | "factor(f,y,x)", 214 | "(x+1)*(x+2)*(y+3)*(y+4)", 215 | 216 | "f=(x+1)(x+1)(y+2)(y+2)", 217 | "", 218 | 219 | "factor(f,x,y)", 220 | "(x+1)^2*(y+2)^2", 221 | 222 | "factor(f,y,x)", 223 | "(x+1)^2*(y+2)^2", 224 | }; 225 | 226 | void 227 | test_factor_number(void) 228 | { 229 | test(__FILE__, s, sizeof s / sizeof (char *)); 230 | } 231 | 232 | #endif 233 | -------------------------------------------------------------------------------- /src/factorial.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | extern void bignum_factorial(int); 5 | 6 | void 7 | factorial(void) 8 | { 9 | int n; 10 | save(); 11 | p1 = pop(); 12 | push(p1); 13 | n = pop_integer(); 14 | if (n < 0 || n == (int) 0x80000000) { 15 | push_symbol(FACTORIAL); 16 | push(p1); 17 | list(2); 18 | restore(); 19 | return; 20 | } 21 | bignum_factorial(n); 22 | restore(); 23 | } 24 | 25 | void sfac_product(void); 26 | void sfac_product_f(U **, int, int); 27 | 28 | // simplification rules for factorials (m < n) 29 | // 30 | // (e + 1) * factorial(e) -> factorial(e + 1) 31 | // 32 | // factorial(e) / e -> factorial(e - 1) 33 | // 34 | // e / factorial(e) -> 1 / factorial(e - 1) 35 | // 36 | // factorial(e + n) 37 | // ---------------- -> (e + m + 1)(e + m + 2)...(e + n) 38 | // factorial(e + m) 39 | // 40 | // factorial(e + m) 1 41 | // ---------------- -> -------------------------------- 42 | // factorial(e + n) (e + m + 1)(e + m + 2)...(e + n) 43 | 44 | void 45 | simplifyfactorials(void) 46 | { 47 | int x; 48 | 49 | save(); 50 | 51 | x = expanding; 52 | expanding = 0; 53 | 54 | p1 = pop(); 55 | 56 | if (car(p1) == symbol(ADD)) { 57 | push(zero); 58 | p1 = cdr(p1); 59 | while (iscons(p1)) { 60 | push(car(p1)); 61 | simplifyfactorials(); 62 | add(); 63 | p1 = cdr(p1); 64 | } 65 | expanding = x; 66 | restore(); 67 | return; 68 | } 69 | 70 | if (car(p1) == symbol(MULTIPLY)) { 71 | sfac_product(); 72 | expanding = x; 73 | restore(); 74 | return; 75 | } 76 | 77 | push(p1); 78 | 79 | expanding = x; 80 | restore(); 81 | } 82 | 83 | void 84 | sfac_product(void) 85 | { 86 | int i, j, n; 87 | U **s; 88 | 89 | s = stack + tos; 90 | 91 | p1 = cdr(p1); 92 | n = 0; 93 | while (iscons(p1)) { 94 | push(car(p1)); 95 | p1 = cdr(p1); 96 | n++; 97 | } 98 | 99 | for (i = 0; i < n - 1; i++) { 100 | if (s[i] == symbol(NIL)) 101 | continue; 102 | for (j = i + 1; j < n; j++) { 103 | if (s[j] == symbol(NIL)) 104 | continue; 105 | sfac_product_f(s, i, j); 106 | } 107 | } 108 | 109 | push(one); 110 | 111 | for (i = 0; i < n; i++) { 112 | if (s[i] == symbol(NIL)) 113 | continue; 114 | push(s[i]); 115 | multiply(); 116 | } 117 | 118 | p1 = pop(); 119 | 120 | tos -= n; 121 | 122 | push(p1); 123 | } 124 | 125 | void 126 | sfac_product_f(U **s, int a, int b) 127 | { 128 | int i, n; 129 | 130 | p1 = s[a]; 131 | p2 = s[b]; 132 | 133 | if (ispower(p1)) { 134 | p3 = caddr(p1); 135 | p1 = cadr(p1); 136 | } else 137 | p3 = one; 138 | 139 | if (ispower(p2)) { 140 | p4 = caddr(p2); 141 | p2 = cadr(p2); 142 | } else 143 | p4 = one; 144 | 145 | if (isfactorial(p1) && isfactorial(p2)) { 146 | 147 | // Determine if the powers cancel. 148 | 149 | push(p3); 150 | push(p4); 151 | add(); 152 | yyexpand(); 153 | n = pop_integer(); 154 | if (n != 0) 155 | return; 156 | 157 | // Find the difference between the two factorial args. 158 | 159 | // For example, the difference between (a + 2)! and a! is 2. 160 | 161 | push(cadr(p1)); 162 | push(cadr(p2)); 163 | subtract(); 164 | yyexpand(); // to simplify 165 | 166 | n = pop_integer(); 167 | if (n == 0 || n == (int) 0x80000000) 168 | return; 169 | if (n < 0) { 170 | n = -n; 171 | p5 = p1; 172 | p1 = p2; 173 | p2 = p5; 174 | p5 = p3; 175 | p3 = p4; 176 | p4 = p5; 177 | } 178 | 179 | push(one); 180 | 181 | for (i = 1; i <= n; i++) { 182 | push(cadr(p2)); 183 | push_integer(i); 184 | add(); 185 | push(p3); 186 | power(); 187 | multiply(); 188 | } 189 | s[a] = pop(); 190 | s[b] = symbol(NIL); 191 | } 192 | } 193 | -------------------------------------------------------------------------------- /src/factors.cpp: -------------------------------------------------------------------------------- 1 | // Push expression factors onto the stack. For example... 2 | // 3 | // Input 4 | // 5 | // 2 6 | // 3x + 2x + 1 7 | // 8 | // Output on stack 9 | // 10 | // [ 3 ] 11 | // [ x^2 ] 12 | // [ 2 ] 13 | // [ x ] 14 | // [ 1 ] 15 | // 16 | // but not necessarily in that order. Returns the number of factors. 17 | 18 | #include "stdafx.h" 19 | #include "defs.h" 20 | 21 | // Local U *p is OK here because no functional path to garbage collector. 22 | 23 | int 24 | factors(U *p) 25 | { 26 | int h = tos; 27 | if (car(p) == symbol(ADD)) { 28 | p = cdr(p); 29 | while (iscons(p)) { 30 | push_term_factors(car(p)); 31 | p = cdr(p); 32 | } 33 | } else 34 | push_term_factors(p); 35 | return tos - h; 36 | } 37 | 38 | // Local U *p is OK here because no functional path to garbage collector. 39 | 40 | void 41 | push_term_factors(U *p) 42 | { 43 | if (car(p) == symbol(MULTIPLY)) { 44 | p = cdr(p); 45 | while (iscons(p)) { 46 | push(car(p)); 47 | p = cdr(p); 48 | } 49 | } else 50 | push(p); 51 | } 52 | -------------------------------------------------------------------------------- /src/fileGUI.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __FILEGUI_H 2 | #define __FILEGUI_H 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | #include "fileProvider.hpp" 18 | 19 | int fileBrowser(char* filename, char* filter, char* title); 20 | int fileBrowserSub(char* browserbasepath, char* filename, char* filter, char* title); 21 | void shortenDisplayPath(char* longpath, char* shortpath, int jump=1); 22 | void buildIconTable(MenuItemIcon* icontable); 23 | 24 | #endif -------------------------------------------------------------------------------- /src/fileProvider.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __FILEPROVIDER_H 2 | #define __FILEPROVIDER_H 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | #include "menuGUI.hpp" 18 | 19 | #define MAX_FILENAME_SIZE 270 //full path with //fls0/, extension and everything 20 | #define MAX_NAME_SIZE 128 //friendly name (in "//fls0/folder/file.txt", this would be "file.txt") 21 | #define MAX_ITEMS_IN_DIR 200 22 | #define MAX_ITEMS_IN_CLIPBOARD 51 23 | #define MAX_TEXTVIEWER_FILESIZE 64*1024 24 | typedef struct 25 | { 26 | char filename[MAX_FILENAME_SIZE]; //filename, not proper for use with Bfile. 27 | char visname[42]; //visible name, only for menus. use nameFromFilename to get the proper name. 28 | short action; // mostly for clipboard, can be used to tag something to do with the file 29 | short isfolder; // because menuitem shouldn't be the only struct holding this info 30 | int size; // file size 31 | } File; // right now File only holds the filename as other fields are now set directly on a MenuItem array 32 | 33 | typedef struct 34 | { 35 | unsigned short id, type; 36 | unsigned long fsize, dsize; 37 | unsigned int property; 38 | unsigned long address; 39 | } file_type_t; 40 | 41 | #define GETFILES_SUCCESS 0 42 | #define GETFILES_MAX_FILES_REACHED 1 43 | 44 | int GetFiles(File* files, MenuItem* menuitems, char* basepath, int* count, char* filter); 45 | void nameFromFilename(char* filename, char* name); 46 | 47 | #define FILE_ICON_FOLDER 0 48 | #define FILE_ICON_G3M 1 49 | #define FILE_ICON_G3E 2 50 | #define FILE_ICON_G3A 3 51 | #define FILE_ICON_G3P 4 52 | #define FILE_ICON_G3B 5 53 | #define FILE_ICON_BMP 6 54 | #define FILE_ICON_TXT 7 55 | #define FILE_ICON_CSV 8 56 | #define FILE_ICON_OTHER 9 57 | int fileIconFromName(char* name); 58 | 59 | #endif -------------------------------------------------------------------------------- /src/filter.cpp: -------------------------------------------------------------------------------- 1 | /* Remove terms that involve a given symbol or expression. For example... 2 | 3 | filter(x^2 + x + 1, x) => 1 4 | 5 | filter(x^2 + x + 1, x^2) => x + 1 6 | */ 7 | 8 | #include "stdafx.h" 9 | #include "defs.h" 10 | 11 | void 12 | eval_filter(void) 13 | { 14 | p1 = cdr(p1); 15 | push(car(p1)); 16 | eval(); 17 | p1 = cdr(p1); 18 | while (iscons(p1)) { 19 | push(car(p1)); 20 | eval(); 21 | filter(); 22 | p1 = cdr(p1); 23 | } 24 | } 25 | 26 | /* For example... 27 | 28 | push(F) 29 | push(X) 30 | filter() 31 | F = pop() 32 | */ 33 | 34 | void 35 | filter(void) 36 | { 37 | save(); 38 | p2 = pop(); 39 | p1 = pop(); 40 | filter_main(); 41 | restore(); 42 | } 43 | 44 | void 45 | filter_main(void) 46 | { 47 | if (car(p1) == symbol(ADD)) 48 | filter_sum(); 49 | else if (istensor(p1)) 50 | filter_tensor(); 51 | else if (find(p1, p2)) 52 | push_integer(0); 53 | else 54 | push(p1); 55 | } 56 | 57 | void 58 | filter_sum(void) 59 | { 60 | push_integer(0); 61 | p1 = cdr(p1); 62 | while (iscons(p1)) { 63 | push(car(p1)); 64 | push(p2); 65 | filter(); 66 | add(); 67 | p1 = cdr(p1); 68 | } 69 | } 70 | 71 | void 72 | filter_tensor(void) 73 | { 74 | int i, n; 75 | n = p1->u.tensor->nelem; 76 | p3 = alloc_tensor(n); 77 | p3->u.tensor->ndim = p1->u.tensor->ndim; 78 | for (i = 0; i < p1->u.tensor->ndim; i++) 79 | p3->u.tensor->dim[i] = p1->u.tensor->dim[i]; 80 | for (i = 0; i < n; i++) { 81 | push(p1->u.tensor->elem[i]); 82 | push(p2); 83 | filter(); 84 | p3->u.tensor->elem[i] = pop(); 85 | } 86 | push(p3); 87 | } 88 | -------------------------------------------------------------------------------- /src/find.cpp: -------------------------------------------------------------------------------- 1 | // returns 1 if expr p contains expr q, otherweise returns 0 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | int 7 | find(U *p, U *q) 8 | { 9 | int i; 10 | 11 | if (equal(p, q)) 12 | return 1; 13 | 14 | if (istensor(p)) { 15 | for (i = 0; i < p->u.tensor->nelem; i++) 16 | if (find(p->u.tensor->elem[i], q)) 17 | return 1; 18 | return 0; 19 | } 20 | 21 | while (iscons(p)) { 22 | if (find(car(p), q)) 23 | return 1; 24 | p = cdr(p); 25 | } 26 | 27 | return 0; 28 | } 29 | -------------------------------------------------------------------------------- /src/finetiming.cpp: -------------------------------------------------------------------------------- 1 | // function for returning fine timing numbers from the Prizm's TMU. added by gbl08ma 2 | #include "stdafx.h" 3 | #include "defs.h" 4 | 5 | void 6 | eval_finetiming(void) 7 | { 8 | finetiming(); 9 | } 10 | 11 | #define READ_ADDRESS(x) (*((unsigned int *)x)) 12 | void finetiming(void) 13 | { 14 | save(); 15 | unsigned int ft = READ_ADDRESS(0xA44D00D8); 16 | push_integer(ft); 17 | 18 | restore(); 19 | } -------------------------------------------------------------------------------- /src/float.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_float(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | yyfloat(); 10 | eval(); // normalize 11 | } 12 | 13 | void 14 | yyfloat(void) 15 | { 16 | int i, h; 17 | save(); 18 | p1 = pop(); 19 | if (iscons(p1)) { 20 | h = tos; 21 | while (iscons(p1)) { 22 | push(car(p1)); 23 | yyfloat(); 24 | p1 = cdr(p1); 25 | } 26 | list(tos - h); 27 | } else if (p1->k == TENSOR) { 28 | push(p1); 29 | copy_tensor(); 30 | p1 = pop(); 31 | for (i = 0; i < p1->u.tensor->nelem; i++) { 32 | push(p1->u.tensor->elem[i]); 33 | yyfloat(); 34 | p1->u.tensor->elem[i] = pop(); 35 | } 36 | push(p1); 37 | } else if (p1->k == NUM) { 38 | push(p1); 39 | bignum_float(); 40 | } else if (p1 == symbol(PI)) 41 | push_double(M_PI); 42 | else if (p1 == symbol(E)) 43 | push_double(M_E); 44 | else 45 | push(p1); 46 | restore(); 47 | } 48 | 49 | #if SELFTEST 50 | 51 | static char *s[] = { 52 | 53 | "float(x)", 54 | "x", 55 | 56 | "float(1/2)", 57 | "0.5", 58 | 59 | "float(pi)", 60 | "3.14159", 61 | 62 | "float(exp(1))", 63 | "2.71828", 64 | 65 | "x=(1/2,1/4)", 66 | "", 67 | 68 | "float(x)", 69 | "(0.5,0.25)", 70 | 71 | "x", 72 | "(1/2,1/4)", 73 | 74 | "x=quote(x)", 75 | "", 76 | }; 77 | 78 | void 79 | test_float(void) 80 | { 81 | test(__FILE__, s, sizeof s / sizeof (char *)); 82 | } 83 | 84 | #endif 85 | -------------------------------------------------------------------------------- /src/floor.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_floor(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | yfloor(); 10 | } 11 | 12 | void 13 | yfloor(void) 14 | { 15 | save(); 16 | yyfloor(); 17 | restore(); 18 | } 19 | 20 | void 21 | yyfloor(void) 22 | { 23 | double d; 24 | 25 | p1 = pop(); 26 | 27 | if (!isnum(p1)) { 28 | push_symbol(FLOOR); 29 | push(p1); 30 | list(2); 31 | return; 32 | } 33 | 34 | if (isdouble(p1)) { 35 | d = floor(p1->u.d); 36 | push_double(d); 37 | return; 38 | } 39 | 40 | if (isinteger(p1)) { 41 | push(p1); 42 | return; 43 | } 44 | 45 | p3 = alloc(); 46 | p3->k = NUM; 47 | p3->u.q.a = mdiv(p1->u.q.a, p1->u.q.b); 48 | p3->u.q.b = mint(1); 49 | push(p3); 50 | 51 | if (isnegativenumber(p1)) { 52 | push_integer(-1); 53 | add(); 54 | } 55 | } 56 | 57 | #if SELFTEST 58 | 59 | static char *s[] = { 60 | 61 | "floor(a)", 62 | "floor(a)", 63 | 64 | "floor(a+b)", 65 | "floor(a+b)", 66 | 67 | "floor(5/2)", 68 | "2", 69 | 70 | "floor(4/2)", 71 | "2", 72 | 73 | "floor(3/2)", 74 | "1", 75 | 76 | "floor(2/2)", 77 | "1", 78 | 79 | "floor(1/2)", 80 | "0", 81 | 82 | "floor(0/2)", 83 | "0", 84 | 85 | "floor(-1/2)", 86 | "-1", 87 | 88 | "floor(-2/2)", 89 | "-1", 90 | 91 | "floor(-3/2)", 92 | "-2", 93 | 94 | "floor(-4/2)", 95 | "-2", 96 | 97 | "floor(-5/2)", 98 | "-3", 99 | 100 | "floor(5/2.0)", 101 | "2", 102 | 103 | "floor(4/2.0)", 104 | "2", 105 | 106 | "floor(3/2.0)", 107 | "1", 108 | 109 | "floor(2/2.0)", 110 | "1", 111 | 112 | "floor(1/2.0)", 113 | "0", 114 | 115 | "floor(0.0)", 116 | "0", 117 | 118 | "floor(-1/2.0)", 119 | "-1", 120 | 121 | "floor(-2/2.0)", 122 | "-1", 123 | 124 | "floor(-3/2.0)", 125 | "-2", 126 | 127 | "floor(-4/2.0)", 128 | "-2", 129 | 130 | "floor(-5/2.0)", 131 | "-3", 132 | }; 133 | 134 | void 135 | test_floor(void) 136 | { 137 | test(__FILE__, s, sizeof s / sizeof (char *)); 138 | } 139 | 140 | #endif 141 | -------------------------------------------------------------------------------- /src/for.cpp: -------------------------------------------------------------------------------- 1 | // 'for' function 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define A p3 7 | #define B p4 8 | #define I p5 9 | #define X p6 10 | 11 | void 12 | eval_for(void) 13 | { 14 | int i, j, k; 15 | 16 | // 1st arg (quoted) 17 | 18 | X = cadr(p1); 19 | if (!issymbol(X)) 20 | stop("for: 1st arg?"); 21 | 22 | // 2nd arg 23 | 24 | push(caddr(p1)); 25 | eval(); 26 | j = pop_integer(); 27 | if (j == (int) 0x80000000) 28 | stop("for: 2nd arg?"); 29 | 30 | // 3rd arg 31 | 32 | push(cadddr(p1)); 33 | eval(); 34 | k = pop_integer(); 35 | if (k == (int) 0x80000000) 36 | stop("for: 3rd arg?"); 37 | 38 | // remaining args 39 | 40 | p1 = cddddr(p1); 41 | 42 | B = get_binding(X); 43 | A = get_arglist(X); 44 | 45 | for (i = j; i <= k; i++) { 46 | push_integer(i); 47 | I = pop(); 48 | set_binding(X, I); 49 | p2 = p1; 50 | while (iscons(p2)) { 51 | push(car(p2)); 52 | eval(); 53 | pop(); 54 | p2 = cdr(p2); 55 | } 56 | } 57 | 58 | set_binding_and_arglist(X, B, A); 59 | 60 | // return value 61 | 62 | push_symbol(NIL); 63 | } 64 | 65 | -------------------------------------------------------------------------------- /src/gamma.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Author : philippe.billet@noos.fr 4 | // 5 | // Gamma function gamma(x) 6 | // 7 | //----------------------------------------------------------------------------- 8 | 9 | #include "stdafx.h" 10 | #include "defs.h" 11 | void gamma(void); 12 | static void gammaf(void); 13 | static void gamma_of_sum(void); 14 | 15 | void 16 | eval_gamma(void) 17 | { 18 | push(cadr(p1)); 19 | eval(); 20 | gamma(); 21 | } 22 | 23 | void 24 | gamma(void) 25 | { 26 | save(); 27 | gammaf(); 28 | restore(); 29 | } 30 | 31 | static void 32 | gammaf(void) 33 | { 34 | // double d; 35 | 36 | p1 = pop(); 37 | 38 | if (isrational(p1) && MEQUAL(p1->u.q.a, 1) && MEQUAL(p1->u.q.b, 2)) { 39 | push_symbol(PI);; 40 | push_rational(1,2); 41 | power(); 42 | return; 43 | } 44 | 45 | if (isrational(p1) && MEQUAL(p1->u.q.a, 3) && MEQUAL(p1->u.q.b, 2)) { 46 | push_symbol(PI);; 47 | push_rational(1,2); 48 | power(); 49 | push_rational(1,2); 50 | multiply(); 51 | return; 52 | } 53 | 54 | // if (p1->k == DOUBLE) { 55 | // d = exp(lgamma(p1->u.d)); 56 | // push_double(d); 57 | // return; 58 | // } 59 | 60 | if (isnegativeterm(p1)) { 61 | push_symbol(PI); 62 | push_integer(-1); 63 | multiply(); 64 | push_symbol(PI); 65 | push(p1); 66 | multiply(); 67 | sine(); 68 | push(p1); 69 | multiply(); 70 | push(p1); 71 | negate(); 72 | gamma(); 73 | multiply(); 74 | divide(); 75 | return; 76 | } 77 | 78 | if (car(p1) == symbol(ADD)) { 79 | gamma_of_sum(); 80 | return; 81 | } 82 | 83 | 84 | push_symbol(GAMMA); 85 | push(p1); 86 | list(2); 87 | return; 88 | } 89 | 90 | static void 91 | gamma_of_sum(void) 92 | { 93 | p3 = cdr(p1); 94 | if (isrational(car(p3)) && MEQUAL(car(p3)->u.q.a, 1) && MEQUAL(car(p3)->u.q.b, 1)) { 95 | push(cadr(p3)); 96 | push(cadr(p3)); 97 | gamma(); 98 | multiply(); 99 | } 100 | else { 101 | if (isrational(car(p3)) && MEQUAL(car(p3)->u.q.a, -1) && MEQUAL(car(p3)->u.q.b, 1)) { 102 | push(cadr(p3)); 103 | gamma(); 104 | push(cadr(p3)); 105 | push_integer(-1); 106 | add(); 107 | divide(); 108 | } 109 | else { 110 | push_symbol(GAMMA); 111 | push(p1); 112 | list(2); 113 | return; 114 | } 115 | } 116 | } 117 | 118 | #if SELFTEST 119 | 120 | static char *s[] = { 121 | 122 | "Gamma(a)", 123 | "Gamma(a)", 124 | 125 | // "float(gamma(10))", 126 | // "362880", 127 | 128 | "Gamma(x+1)", 129 | "x*Gamma(x)", 130 | 131 | "Gamma(1/2)", 132 | "pi^(1/2)", 133 | 134 | "Gamma(x-1)-Gamma(x)/(-1+x)", 135 | "0", 136 | 137 | "Gamma(-x)", 138 | "-pi/(x*Gamma(x)*sin(pi*x))", 139 | 140 | }; 141 | 142 | void 143 | test_gamma(void) 144 | { 145 | test(__FILE__, s, sizeof s / sizeof (char *)); 146 | } 147 | 148 | #endif 149 | -------------------------------------------------------------------------------- /src/graphicsProvider.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __GRAPHICSPROVIDER_H 2 | #define __GRAPHICSPROVIDER_H 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | #define TNYIM_ORANGE 0xd222 18 | int PrintMiniFix(int x, int y, const unsigned char*Msg, const int flags, const short color, const short bcolor, int overstatus); 19 | void plot(int x0, int y0,unsigned short color); 20 | void drawRectangle(int x, int y, int width, int height, unsigned short color); 21 | void drawLine(int x1, int y1, int x2, int y2, int color); 22 | //void VRAMReplaceColorInRect(int x, int y, int width, int height, color_t color_old, color_t color_new); 23 | //void CopySprite(const void* datar, int x, int y, int width, int height); 24 | void CopySpriteMasked(unsigned short* data, int x, int y, int width, int height, unsigned short maskcolor); 25 | //void CopySpriteNbit(const unsigned char* data, int x, int y, int width, int height, const color_t* palette, unsigned int bitwidth); 26 | int drawRGB24toRGB565(int r, int g, int b); 27 | int alphaBlend(int newcc, int oldcc, float alpha); 28 | void drawSegvaultLogo(int x, int y); 29 | //int textColorToFullColor(int textcolor); 30 | //void progressMessage(char* message, int cur, int total); 31 | void printCentered(char* text, int y, int FGC, int BGC); 32 | void clearLine(int x, int y, color_t color=COLOR_WHITE); 33 | void mPrintXY(int x, int y, char*msg, int mode, int color); 34 | void drawScreenTitle(char* title, char* subtitle = NULL); 35 | void drawFkeyLabels(int f1=-1, int f2=-1, int f3=-1, int f4=-1, int f5=-1, int f6=-1); 36 | int getNextColorInSequence(int curcolor); 37 | int getPreviousColorInSequence(int curcolor); 38 | 39 | #endif -------------------------------------------------------------------------------- /src/guess.cpp: -------------------------------------------------------------------------------- 1 | // Guess which symbol to use for derivative, integral, etc. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | guess(void) 8 | { 9 | U *p; 10 | p = pop(); 11 | push(p); 12 | if (find(p, symbol(SYMBOL_X))) 13 | push_symbol(SYMBOL_X); 14 | else if (find(p, symbol(SYMBOL_Y))) 15 | push_symbol(SYMBOL_Y); 16 | else if (find(p, symbol(SYMBOL_Z))) 17 | push_symbol(SYMBOL_Z); 18 | else if (find(p, symbol(SYMBOL_T))) 19 | push_symbol(SYMBOL_T); 20 | else if (find(p, symbol(SYMBOL_S))) 21 | push_symbol(SYMBOL_S); 22 | else 23 | push_symbol(SYMBOL_X); 24 | } 25 | -------------------------------------------------------------------------------- /src/hermite.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Hermite polynomial 4 | // 5 | // Input: tos-2 x (can be a symbol or expr) 6 | // 7 | // tos-1 n 8 | // 9 | // Output: Result on stack 10 | // 11 | //----------------------------------------------------------------------------- 12 | 13 | #include "stdafx.h" 14 | #include "defs.h" 15 | 16 | void 17 | hermite(void) 18 | { 19 | save(); 20 | yyhermite(); 21 | restore(); 22 | } 23 | 24 | // uses the recurrence relation H(x,n+1)=2*x*H(x,n)-2*n*H(x,n-1) 25 | 26 | #define X p1 27 | #define N p2 28 | #define Y p3 29 | #define Y1 p4 30 | #define Y0 p5 31 | 32 | void 33 | yyhermite(void) 34 | { 35 | int n; 36 | 37 | N = pop(); 38 | X = pop(); 39 | 40 | push(N); 41 | n = pop_integer(); 42 | 43 | if (n < 0) { 44 | push_symbol(HERMITE); 45 | push(X); 46 | push(N); 47 | list(3); 48 | return; 49 | } 50 | 51 | if (issymbol(X)) 52 | yyhermite2(n); 53 | else { 54 | Y = X; // do this when X is an expr 55 | X = symbol(SECRETX); 56 | yyhermite2(n); 57 | X = Y; 58 | push(symbol(SECRETX)); 59 | push(X); 60 | subst(); 61 | eval(); 62 | } 63 | } 64 | 65 | void 66 | yyhermite2(int n) 67 | { 68 | int i; 69 | 70 | push_integer(1); 71 | push_integer(0); 72 | 73 | Y1 = pop(); 74 | 75 | for (i = 0; i < n; i++) { 76 | 77 | Y0 = Y1; 78 | 79 | Y1 = pop(); 80 | 81 | push(X); 82 | push(Y1); 83 | multiply(); 84 | 85 | push_integer(i); 86 | push(Y0); 87 | multiply(); 88 | 89 | subtract(); 90 | 91 | push_integer(2); 92 | multiply(); 93 | } 94 | } 95 | 96 | #if SELFTEST 97 | 98 | static char *s[] = { 99 | 100 | "hermite(x,n)", 101 | "hermite(x,n)", 102 | 103 | "hermite(x,0)-1", 104 | "0", 105 | 106 | "hermite(x,1)-2*x", 107 | "0", 108 | 109 | "hermite(x,2)-(4*x^2-2)", 110 | "0", 111 | 112 | "hermite(x,3)-(8*x^3-12*x)", 113 | "0", 114 | 115 | "hermite(x,4)-(16*x^4-48*x^2+12)", 116 | "0", 117 | 118 | "hermite(x,5)-(32*x^5-160*x^3+120*x)", 119 | "0", 120 | 121 | "hermite(x,6)-(64*x^6-480*x^4+720*x^2-120)", 122 | "0", 123 | 124 | "hermite(x,7)-(128*x^7-1344*x^5+3360*x^3-1680*x)", 125 | "0", 126 | 127 | "hermite(x,8)-(256*x^8-3584*x^6+13440*x^4-13440*x^2+1680)", 128 | "0", 129 | 130 | "hermite(x,9)-(512*x^9-9216*x^7+48384*x^5-80640*x^3+30240*x)", 131 | "0", 132 | 133 | "hermite(x,10)-(1024*x^10-23040*x^8+161280*x^6-403200*x^4+302400*x^2-30240)", 134 | "0", 135 | 136 | "hermite(a-b,10)-eval(subst(a-b,x,hermite(x,10)))", 137 | "0", 138 | }; 139 | 140 | void 141 | test_hermite(void) 142 | { 143 | test(__FILE__, s, sizeof s / sizeof (char *)); 144 | } 145 | 146 | #endif 147 | -------------------------------------------------------------------------------- /src/hilbert.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | 3 | //----------------------------------------------------------------------------- 4 | // 5 | // Create a Hilbert matrix 6 | // 7 | // Input: Dimension on stack 8 | // 9 | // Output: Hilbert matrix on stack 10 | // 11 | // Example: 12 | // 13 | // > hilbert(5) 14 | // ((1,1/2,1/3,1/4),(1/2,1/3,1/4,1/5),(1/3,1/4,1/5,1/6),(1/4,1/5,1/6,1/7)) 15 | // 16 | //----------------------------------------------------------------------------- 17 | 18 | #include "defs.h" 19 | 20 | #define A p1 21 | #define N p2 22 | 23 | #define AELEM(i, j) A->u.tensor->elem[i * n + j] 24 | 25 | void 26 | hilbert(void) 27 | { 28 | int i, j, n; 29 | save(); 30 | N = pop(); 31 | push(N); 32 | n = pop_integer(); 33 | if (n < 2) { 34 | push_symbol(HILBERT); 35 | push(N); 36 | list(2); 37 | restore(); 38 | return; 39 | } 40 | push_zero_matrix(n, n); 41 | A = pop(); 42 | for (i = 0; i < n; i++) { 43 | for (j = 0; j < n; j++) { 44 | push_integer(i + j + 1); 45 | inverse(); 46 | AELEM(i, j) = pop(); 47 | } 48 | } 49 | push(A); 50 | restore(); 51 | } 52 | -------------------------------------------------------------------------------- /src/history.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | extern "C" { 4 | #include "dConsole.h" 5 | } 6 | #include 7 | #include 8 | 9 | extern char *get_curr_cmd(void); 10 | extern void update_curr_cmd(char *); 11 | 12 | static char *buf[N]; 13 | static int i, j, k; 14 | 15 | typedef char history_line[INPUTBUFLEN+1]; 16 | history_line *history_buf; 17 | char is_index_busy[HISTORYHEAP_N]; 18 | 19 | void initialize_history_heap(history_line* area) { 20 | history_buf = area; 21 | for(int k = 0; ku.tensor->ndim = 1; 94 | TEMPO->u.tensor->dim[0] = n + m + x; 95 | 96 | for(j=0; j<= n + m + x; j++) { 97 | push_integer(0); 98 | TEMPO->u.tensor->elem[j]=pop(); 99 | } 100 | for(j=0; j<=m; j++) { 101 | TEMPO->u.tensor->elem[j]=dividend[j]; 102 | } 103 | push(zero); 104 | 105 | for(j=0; j<= x; j++) { 106 | 107 | push(TEMPO->u.tensor->elem[j]); 108 | push(divisor[0]); 109 | divide(); 110 | Q = pop(); 111 | for (i = 0; i <= n; i++) { 112 | push(TEMPO->u.tensor->elem[j + i]); 113 | push(divisor[i]); 114 | push(Q); 115 | multiply(); 116 | subtract(); 117 | TEMPO->u.tensor->elem[j + i] = pop(); 118 | } 119 | push(Q); 120 | push(X); 121 | push_integer(j); 122 | power(); 123 | multiply(); 124 | add(); 125 | } 126 | QUOTIENT=pop(); 127 | tos=h; 128 | push(QUOTIENT); 129 | } 130 | -------------------------------------------------------------------------------- /src/inputGUI.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __INPUTGUI_H 2 | #define __INPUTGUI_H 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | #define INPUTTYPE_NORMAL 0 19 | #define INPUTTYPE_DATE 1 20 | #define INPUTTYPE_TIME 2 21 | 22 | #define INPUT_RETURN_EXIT 0 23 | #define INPUT_RETURN_CONFIRM 1 24 | #define INPUT_RETURN_KEYCODE 2 25 | 26 | typedef struct { 27 | int type=INPUTTYPE_NORMAL; 28 | int x=1; // x and y are in character coordinates (21*8..) 29 | int y=3; 30 | int width=21; // again, in character coordinates. note that last space of the input is reserved for scrolling and never gets hit by a char, only the cursor 31 | int forcetext=0; // if 1, user will be forced to enter text 32 | int charlimit; // maximum number of chars to admit in bytes (which means that if users enter multibyte it will allow for less chars) 33 | int symbols=1; // if 1, user will be able to enter symbols with the OS's character select screen 34 | int key=0; // put a key here to provide for the initial keypress. also, when input returns INPUT_RETURN_KEYCODE, the keycode is here. 35 | int acceptF6=0; // accept F6 as a way to confirm the input (useful for wizards) 36 | int cursor=0; 37 | int start=0; 38 | char* buffer; 39 | } textInput; 40 | 41 | int doTextInput(textInput* input); 42 | 43 | #endif -------------------------------------------------------------------------------- /src/integral.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | #define F p3 5 | #define X p4 6 | #define N p5 7 | 8 | void 9 | eval_integral(void) 10 | { 11 | int i, n; 12 | 13 | // evaluate 1st arg to get function F 14 | 15 | p1 = cdr(p1); 16 | push(car(p1)); 17 | eval(); 18 | 19 | // evaluate 2nd arg and then... 20 | 21 | // example result of 2nd arg what to do 22 | // 23 | // integral(f) nil guess X, N = nil 24 | // integral(f,2) 2 guess X, N = 2 25 | // integral(f,x) x X = x, N = nil 26 | // integral(f,x,2) x X = x, N = 2 27 | // integral(f,x,y) x X = x, N = y 28 | 29 | p1 = cdr(p1); 30 | push(car(p1)); 31 | eval(); 32 | 33 | p2 = pop(); 34 | if (p2 == symbol(NIL)) { 35 | guess(); 36 | push(symbol(NIL)); 37 | } else if (isnum(p2)) { 38 | guess(); 39 | push(p2); 40 | } else { 41 | push(p2); 42 | p1 = cdr(p1); 43 | push(car(p1)); 44 | eval(); 45 | } 46 | 47 | N = pop(); 48 | X = pop(); 49 | F = pop(); 50 | 51 | while (1) { 52 | 53 | // N might be a symbol instead of a number 54 | 55 | if (isnum(N)) { 56 | push(N); 57 | n = pop_integer(); 58 | if (n == (int) 0x80000000) 59 | stop("nth integral: check n"); 60 | } else 61 | n = 1; 62 | 63 | push(F); 64 | 65 | if (n >= 0) { 66 | for (i = 0; i < n; i++) { 67 | push(X); 68 | integral(); 69 | } 70 | } else { 71 | n = -n; 72 | for (i = 0; i < n; i++) { 73 | push(X); 74 | derivative(); 75 | } 76 | } 77 | 78 | F = pop(); 79 | 80 | // if N is nil then arglist is exhausted 81 | 82 | if (N == symbol(NIL)) 83 | break; 84 | 85 | // otherwise... 86 | 87 | // N arg1 what to do 88 | // 89 | // number nil break 90 | // number number N = arg1, continue 91 | // number symbol X = arg1, N = arg2, continue 92 | // 93 | // symbol nil X = N, N = nil, continue 94 | // symbol number X = N, N = arg1, continue 95 | // symbol symbol X = N, N = arg1, continue 96 | 97 | if (isnum(N)) { 98 | p1 = cdr(p1); 99 | push(car(p1)); 100 | eval(); 101 | N = pop(); 102 | if (N == symbol(NIL)) 103 | break; // arglist exhausted 104 | if (isnum(N)) 105 | ; // N = arg1 106 | else { 107 | X = N; // X = arg1 108 | p1 = cdr(p1); 109 | push(car(p1)); 110 | eval(); 111 | N = pop(); // N = arg2 112 | } 113 | } else { 114 | X = N; // X = N 115 | p1 = cdr(p1); 116 | push(car(p1)); 117 | eval(); 118 | N = pop(); // N = arg1 119 | } 120 | } 121 | 122 | push(F); // final result 123 | } 124 | 125 | void 126 | integral(void) 127 | { 128 | save(); 129 | p2 = pop(); 130 | p1 = pop(); 131 | if (car(p1) == symbol(ADD)) 132 | integral_of_sum(); 133 | else if (car(p1) == symbol(MULTIPLY)) 134 | integral_of_product(); 135 | else 136 | integral_of_form(); 137 | p1 = pop(); 138 | if (find(p1, symbol(INTEGRAL))) 139 | stop("integral: sorry, could not find a solution"); 140 | push(p1); 141 | simplify(); // polish the result 142 | eval(); // normalize the result 143 | restore(); 144 | } 145 | 146 | void 147 | integral_of_sum(void) 148 | { 149 | p1 = cdr(p1); 150 | push(car(p1)); 151 | push(p2); 152 | integral(); 153 | p1 = cdr(p1); 154 | while (iscons(p1)) { 155 | push(car(p1)); 156 | push(p2); 157 | integral(); 158 | add(); 159 | p1 = cdr(p1); 160 | } 161 | } 162 | 163 | void 164 | integral_of_product(void) 165 | { 166 | push(p1); 167 | push(p2); 168 | partition(); 169 | p1 = pop(); // pop variable part 170 | integral_of_form(); 171 | multiply(); // multiply constant part 172 | } 173 | 174 | extern char *itab[]; 175 | 176 | void 177 | integral_of_form(void) 178 | { 179 | push(p1); 180 | push(p2); 181 | transform(itab); 182 | p3 = pop(); 183 | if (p3 == symbol(NIL)) { 184 | push_symbol(INTEGRAL); 185 | push(p1); 186 | push(p2); 187 | list(3); 188 | } else 189 | push(p3); 190 | } 191 | -------------------------------------------------------------------------------- /src/isprime.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_isprime(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | p1 = pop(); 10 | if (isnonnegativeinteger(p1) && mprime(p1->u.q.a)) 11 | push_integer(1); 12 | else 13 | push_integer(0); 14 | } 15 | 16 | #if SELFTEST 17 | 18 | static char *s[] = { 19 | 20 | // 0 and 1 are not prime numbers 21 | 22 | "isprime(0)", 23 | "0", 24 | 25 | "isprime(1)", 26 | "0", 27 | 28 | "isprime(13)", 29 | "1", 30 | 31 | "isprime(14)", 32 | "0", 33 | 34 | // from the Prime Curios web page 35 | 36 | "isprime(9007199254740991)", 37 | "0", 38 | 39 | // The largest prime that JavaScript supports 40 | 41 | "isprime(2^53 - 111)", 42 | "1", 43 | 44 | // misc. primes 45 | 46 | "isprime(2^50-71)", 47 | "1", 48 | 49 | "isprime(2^40-87)", 50 | "1", 51 | }; 52 | 53 | void 54 | test_isprime(void) 55 | { 56 | test(__FILE__, s, sizeof s / sizeof (char *)); 57 | } 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /src/laguerre.cpp: -------------------------------------------------------------------------------- 1 | /* Laguerre function 2 | 3 | Example 4 | 5 | laguerre(x,3) 6 | 7 | Result 8 | 9 | 1 3 3 2 10 | - --- x + --- x - 3 x + 1 11 | 6 2 12 | 13 | The computation uses the following recurrence relation. 14 | 15 | L(x,0,k) = 1 16 | 17 | L(x,1,k) = -x + k + 1 18 | 19 | n*L(x,n,k) = (2*(n-1)+1-x+k)*L(x,n-1,k) - (n-1+k)*L(x,n-2,k) 20 | 21 | In the "for" loop i = n-1 so the recurrence relation becomes 22 | 23 | (i+1)*L(x,n,k) = (2*i+1-x+k)*L(x,n-1,k) - (i+k)*L(x,n-2,k) 24 | */ 25 | 26 | #include "stdafx.h" 27 | #include "defs.h" 28 | 29 | void 30 | eval_laguerre(void) 31 | { 32 | // 1st arg 33 | 34 | push(cadr(p1)); 35 | eval(); 36 | 37 | // 2nd arg 38 | 39 | push(caddr(p1)); 40 | eval(); 41 | 42 | // 3rd arg 43 | 44 | push(cadddr(p1)); 45 | eval(); 46 | 47 | p2 = pop(); 48 | if (p2 == symbol(NIL)) 49 | push_integer(0); 50 | else 51 | push(p2); 52 | 53 | laguerre(); 54 | } 55 | 56 | #define X p1 57 | #define N p2 58 | #define K p3 59 | #define Y p4 60 | #define Y0 p5 61 | #define Y1 p6 62 | 63 | void 64 | laguerre(void) 65 | { 66 | int n; 67 | save(); 68 | 69 | K = pop(); 70 | N = pop(); 71 | X = pop(); 72 | 73 | push(N); 74 | n = pop_integer(); 75 | 76 | if (n < 0) { 77 | push_symbol(LAGUERRE); 78 | push(X); 79 | push(N); 80 | push(K); 81 | list(4); 82 | restore(); 83 | return; 84 | } 85 | 86 | if (issymbol(X)) 87 | laguerre2(n); 88 | else { 89 | Y = X; // do this when X is an expr 90 | X = symbol(SECRETX); 91 | laguerre2(n); 92 | X = Y; 93 | push(symbol(SECRETX)); 94 | push(X); 95 | subst(); 96 | eval(); 97 | } 98 | 99 | restore(); 100 | } 101 | 102 | void 103 | laguerre2(int n) 104 | { 105 | int i; 106 | 107 | push_integer(1); 108 | push_integer(0); 109 | 110 | Y1 = pop(); 111 | 112 | for (i = 0; i < n; i++) { 113 | 114 | Y0 = Y1; 115 | 116 | Y1 = pop(); 117 | 118 | push_integer(2 * i + 1); 119 | push(X); 120 | subtract(); 121 | push(K); 122 | add(); 123 | push(Y1); 124 | multiply(); 125 | 126 | push_integer(i); 127 | push(K); 128 | add(); 129 | push(Y0); 130 | multiply(); 131 | 132 | subtract(); 133 | 134 | push_integer(i + 1); 135 | divide(); 136 | } 137 | } 138 | 139 | #if SELFTEST 140 | 141 | static char *s[] = { 142 | 143 | "laguerre(x,n)", 144 | "laguerre(x,n,0)", 145 | 146 | "laguerre(x,n,k)", 147 | "laguerre(x,n,k)", 148 | 149 | "laguerre(x,0)-1", 150 | "0", 151 | 152 | "laguerre(x,1)-(-x+1)", 153 | "0", 154 | 155 | "laguerre(x,2)-1/2*(x^2-4*x+2)", 156 | "0", 157 | 158 | "laguerre(x,3)-1/6*(-x^3+9*x^2-18*x+6)", 159 | "0", 160 | 161 | "laguerre(x,0,k)-1", 162 | "0", 163 | 164 | "laguerre(x,1,k)-(-x+k+1)", 165 | "0", 166 | 167 | "laguerre(x,2,k)-1/2*(x^2-2*(k+2)*x+(k+1)*(k+2))", 168 | "0", 169 | 170 | "laguerre(x,3,k)-1/6*(-x^3+3*(k+3)*x^2-3*(k+2)*(k+3)*x+(k+1)*(k+2)*(k+3))", 171 | "0", 172 | 173 | "laguerre(a-b,10)-eval(subst(a-b,x,laguerre(x,10)))", 174 | "0", 175 | }; 176 | 177 | void 178 | test_laguerre(void) 179 | { 180 | test(__FILE__, s, sizeof s / sizeof (char *)); 181 | } 182 | 183 | #endif 184 | -------------------------------------------------------------------------------- /src/laplace.cpp: -------------------------------------------------------------------------------- 1 | // Laplace transform 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_laplace(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | push(symbol(SYMBOL_T)); 12 | laplace(); 13 | } 14 | 15 | #define F p3 16 | #define T p4 17 | #define A p5 18 | 19 | void 20 | laplace(void) 21 | { 22 | int h; 23 | save(); 24 | 25 | T = pop(); 26 | F = pop(); 27 | 28 | // L[f + g] = L[f] + L[g] 29 | 30 | if (car(F) == symbol(ADD)) { 31 | p1 = cdr(F); 32 | h = tos; 33 | while (iscons(p1)) { 34 | push(car(p1)); 35 | push(T); 36 | laplace(); 37 | p1 = cdr(p1); 38 | } 39 | add_all(tos - h); 40 | restore(); 41 | return; 42 | } 43 | 44 | // L[Af] = A L[f] 45 | 46 | if (car(F) == symbol(MULTIPLY)) { 47 | push(F); 48 | push(T); 49 | partition(); 50 | F = pop(); 51 | A = pop(); 52 | laplace_main(); 53 | push(A); 54 | multiply(); 55 | } else 56 | laplace_main(); 57 | 58 | restore(); 59 | } 60 | 61 | void 62 | laplace_main(void) 63 | { 64 | int n; 65 | 66 | // L[t] = 1 / s^2 67 | 68 | if (F == symbol(SYMBOL_T)) { 69 | push_symbol(SYMBOL_S); 70 | push_integer(-2); 71 | power(); 72 | return; 73 | } 74 | 75 | // L[t^n] = n! / s^(n+1) 76 | 77 | if (car(F) == symbol(POWER) && cadr(F) == T) { 78 | push(caddr(F)); 79 | n = pop_integer(); 80 | if (n > 0) { 81 | push_integer(n); 82 | factorial(); 83 | push_symbol(SYMBOL_S); 84 | push_integer(n + 1); 85 | power(); 86 | divide(); 87 | return; 88 | } 89 | } 90 | 91 | stop("laplace: cannot solve"); 92 | } 93 | 94 | #if SELFTEST 95 | 96 | static char *s[] = { 97 | 98 | // float ok? 99 | 100 | "laplace(3t^2.0)", 101 | "6/(s^3)", 102 | }; 103 | 104 | void 105 | test_laplace(void) 106 | { 107 | test(__FILE__, s, sizeof s / sizeof (char *)); 108 | } 109 | 110 | #endif 111 | -------------------------------------------------------------------------------- /src/lcm.cpp: -------------------------------------------------------------------------------- 1 | // Find the least common multiple of two expressions. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_lcm(void) 8 | { 9 | p1 = cdr(p1); 10 | push(car(p1)); 11 | eval(); 12 | p1 = cdr(p1); 13 | while (iscons(p1)) { 14 | push(car(p1)); 15 | eval(); 16 | lcm(); 17 | p1 = cdr(p1); 18 | } 19 | } 20 | 21 | void 22 | lcm(void) 23 | { 24 | int x; 25 | x = expanding; 26 | save(); 27 | yylcm(); 28 | restore(); 29 | expanding = x; 30 | } 31 | 32 | void 33 | yylcm(void) 34 | { 35 | expanding = 1; 36 | 37 | p2 = pop(); 38 | p1 = pop(); 39 | 40 | push(p1); 41 | push(p2); 42 | gcd(); 43 | 44 | push(p1); 45 | divide(); 46 | 47 | push(p2); 48 | divide(); 49 | 50 | inverse(); 51 | } 52 | 53 | #if SELFTEST 54 | 55 | static char *s[] = { 56 | 57 | "lcm(4,6)", 58 | "12", 59 | 60 | "lcm(4*x,6*x*y)", 61 | "12*x*y", 62 | 63 | // multiple arguments 64 | 65 | "lcm(2,3,4)", 66 | "12", 67 | }; 68 | 69 | void 70 | test_lcm(void) 71 | { 72 | test(__FILE__, s, sizeof (s) / sizeof (char *)); 73 | } 74 | 75 | #endif 76 | -------------------------------------------------------------------------------- /src/leading.cpp: -------------------------------------------------------------------------------- 1 | /* Return the leading coefficient of a polynomial. 2 | 3 | Example 4 | 5 | leading(5x^2+x+1,x) 6 | 7 | Result 8 | 9 | 5 10 | 11 | The result is undefined if P is not a polynomial. */ 12 | 13 | #include "stdafx.h" 14 | #include "defs.h" 15 | 16 | void 17 | eval_leading(void) 18 | { 19 | push(cadr(p1)); 20 | eval(); 21 | push(caddr(p1)); 22 | eval(); 23 | p1 = pop(); 24 | if (p1 == symbol(NIL)) 25 | guess(); 26 | else 27 | push(p1); 28 | leading(); 29 | } 30 | 31 | #define P p1 32 | #define X p2 33 | #define N p3 34 | 35 | void 36 | leading(void) 37 | { 38 | save(); 39 | 40 | X = pop(); 41 | P = pop(); 42 | 43 | push(P); // N = degree of P 44 | push(X); 45 | degree(); 46 | N = pop(); 47 | 48 | push(P); // divide through by X ^ N 49 | push(X); 50 | push(N); 51 | power(); 52 | divide(); 53 | 54 | push(X); // remove terms that depend on X 55 | filter(); 56 | 57 | restore(); 58 | } 59 | -------------------------------------------------------------------------------- /src/limit.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Author : philippe.billet@noos.fr 4 | // 5 | // limit of f(x) x->a 6 | // 7 | // Input: tos-3 f 8 | // 9 | // tos-2 x 10 | // 11 | // tos-1 a 12 | // 13 | // Output: Result on stack 14 | // 15 | //----------------------------------------------------------------------------- 16 | 17 | #include "stdafx.h" 18 | #include "defs.h" 19 | #ifdef HAS_LIMIT_SOLVER 20 | void 21 | eval_limit(void) 22 | { 23 | push(cadr(p1)); 24 | eval(); 25 | push(caddr(p1)); 26 | eval(); 27 | push(cadddr(p1)); 28 | eval(); 29 | limit(); 30 | } 31 | 32 | void 33 | limit(void) 34 | { 35 | save(); 36 | ylimit(); 37 | restore(); 38 | } 39 | 40 | 41 | #define F p1 42 | #define X p2 43 | #define Y p3 44 | #define TEMP p4 45 | #define DISP p5 46 | #define taylorprec 5 47 | 48 | 49 | void 50 | ylimit(void) 51 | { 52 | Y=pop(); 53 | X=pop(); 54 | F=pop(); 55 | 56 | if (X == symbol(NIL) || Y == symbol(NIL)) 57 | stop("limit formalism : limit(f,x,a)"); 58 | if (find(Y,X)) 59 | stop("limit : a shoudn't depend of x"); 60 | 61 | if (equal(Y,symbol(INFTY))) 62 | limit_infty(); 63 | else if (equal(Y,symbol(MINFTY))) 64 | limit_minfty(); 65 | else limit_other(); 66 | 67 | } 68 | 69 | void 70 | limit_infty(void) 71 | { 72 | //printstr("limit_infty\n"); 73 | push(F); 74 | push(X); 75 | push(X); 76 | inverse(); 77 | /* TEMP=pop(); 78 | print(TEMP); 79 | printstr("\n"); 80 | push(TEMP); */ 81 | subst(); 82 | eval(); 83 | /* TEMP=pop(); 84 | print(TEMP); 85 | printstr("\n"); 86 | push(TEMP); */ 87 | push(X); 88 | push_integer(0); 89 | limit(); 90 | return; 91 | } 92 | 93 | void 94 | limit_minfty(void) 95 | { 96 | //printstr("limit_minfty\n"); 97 | push(F); 98 | push(X); 99 | push(X); 100 | negate(); 101 | inverse(); 102 | subst(); 103 | eval(); 104 | /* TEMP=pop(); 105 | print(TEMP); 106 | printstr("\n"); 107 | push(TEMP); */ 108 | push(X); 109 | push_integer(0); 110 | limit(); 111 | return; 112 | } 113 | 114 | 115 | 116 | void 117 | limit_other(void) 118 | { 119 | //printstr("limit_other\n"); 120 | push(F); 121 | denominator(); 122 | TEMP=pop(); 123 | if (!find(TEMP,X) || (car(F) == symbol(POWER) && 124 | isnegativeterm(cadr(F)))) { 125 | // printstr("result may be false, de l'Hospital rule not applicable \n"); 126 | push(F); 127 | push(X); 128 | push(Y); 129 | subst(); 130 | eval(); 131 | return; 132 | } 133 | push(F); 134 | numerator(); 135 | push(X); 136 | push_integer(taylorprec); 137 | push(Y); 138 | taylor(); 139 | push(F); 140 | denominator(); 141 | push(X); 142 | push_integer(taylorprec); 143 | push(Y); 144 | taylor(); 145 | divide(); 146 | inverse(); 147 | inverse(); 148 | TEMP=pop(); 149 | push(TEMP); 150 | numerator(); 151 | push(TEMP); 152 | denominator(); 153 | push(X); 154 | push_integer(taylorprec); 155 | incrdivpoly(); 156 | push(X); 157 | push(Y); 158 | subst(); 159 | eval(); 160 | } 161 | 162 | #endif -------------------------------------------------------------------------------- /src/list.cpp: -------------------------------------------------------------------------------- 1 | // Create a list from n things on the stack. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | list(int n) 8 | { 9 | int i; 10 | push(symbol(NIL)); 11 | for (i = 0; i < n; i++) 12 | cons(); 13 | } 14 | -------------------------------------------------------------------------------- /src/log.cpp: -------------------------------------------------------------------------------- 1 | // natural logarithm 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_log(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | logarithm(); 12 | } 13 | 14 | void 15 | logarithm(void) 16 | { 17 | save(); 18 | yylog(); 19 | restore(); 20 | } 21 | 22 | void 23 | yylog(void) 24 | { 25 | double d; 26 | 27 | p1 = pop(); 28 | 29 | if (p1 == symbol(E)) { 30 | push_integer(1); 31 | return; 32 | } 33 | 34 | if (equaln(p1, 1)) { 35 | push_integer(0); 36 | return; 37 | } 38 | 39 | if (isnegativenumber(p1)) { 40 | push(p1); 41 | negate(); 42 | logarithm(); 43 | push(imaginaryunit); 44 | push_symbol(PI); 45 | multiply(); 46 | add(); 47 | return; 48 | } 49 | 50 | if (isdouble(p1)) { 51 | d = log(p1->u.d); 52 | push_double(d); 53 | return; 54 | } 55 | 56 | // rational number and not an integer? 57 | 58 | if (isfraction(p1)) { 59 | push(p1); 60 | numerator(); 61 | logarithm(); 62 | push(p1); 63 | denominator(); 64 | logarithm(); 65 | subtract(); 66 | return; 67 | } 68 | 69 | // log(a ^ b) --> b log(a) 70 | 71 | if (car(p1) == symbol(POWER)) { 72 | push(caddr(p1)); 73 | push(cadr(p1)); 74 | logarithm(); 75 | multiply(); 76 | return; 77 | } 78 | 79 | // log(a * b) --> log(a) + log(b) 80 | 81 | if (car(p1) == symbol(MULTIPLY)) { 82 | push_integer(0); 83 | p1 = cdr(p1); 84 | while (iscons(p1)) { 85 | push(car(p1)); 86 | logarithm(); 87 | add(); 88 | p1 = cdr(p1); 89 | } 90 | return; 91 | } 92 | 93 | push_symbol(LOG); 94 | push(p1); 95 | list(2); 96 | } 97 | 98 | #if SELFTEST 99 | 100 | static char *s[] = { 101 | 102 | "log(1)", 103 | "0", 104 | 105 | "log(exp(1))", 106 | "1", 107 | 108 | "log(exp(x))", 109 | "x", 110 | 111 | "exp(log(x))", 112 | "x", 113 | 114 | "log(x^2)", 115 | "2*log(x)", 116 | 117 | "log(1/x)", 118 | "-log(x)", 119 | 120 | "log(a^b)", 121 | "b*log(a)", 122 | 123 | "log(2)", 124 | "log(2)", 125 | 126 | "log(2.0)", 127 | "0.693147", 128 | 129 | "float(log(2))", 130 | "0.693147", 131 | 132 | "log(a*b)", 133 | "log(a)+log(b)", 134 | 135 | "log(1/3)+log(3)", 136 | "0", 137 | 138 | "log(-1)", 139 | "i*pi", 140 | 141 | "log(-1.0)", 142 | "i*pi", 143 | }; 144 | 145 | void 146 | test_log(void) 147 | { 148 | test(__FILE__, s, sizeof s / sizeof (char *)); 149 | } 150 | 151 | #endif 152 | -------------------------------------------------------------------------------- /src/mag.cpp: -------------------------------------------------------------------------------- 1 | /* Magnitude of complex z 2 | 3 | z mag(z) 4 | - ------ 5 | 6 | a a 7 | 8 | -a a 9 | 10 | (-1)^a 1 11 | 12 | exp(a + i b) exp(a) 13 | 14 | a b mag(a) mag(b) 15 | 16 | a + i b sqrt(a^2 + b^2) 17 | 18 | Notes 19 | 20 | 1. Handles mixed polar and rectangular forms, e.g. 1 + exp(i pi/3) 21 | 22 | 2. jean-francois.debroux reports that when z=(a+i*b)/(c+i*d) then 23 | 24 | mag(numerator(z)) / mag(denominator(z)) 25 | 26 | must be used to get the correct answer. Now the operation is 27 | automatic. 28 | */ 29 | 30 | #include "stdafx.h" 31 | #include "defs.h" 32 | 33 | void 34 | eval_mag(void) 35 | { 36 | push(cadr(p1)); 37 | eval(); 38 | mag(); 39 | } 40 | 41 | void 42 | mag(void) 43 | { 44 | save(); 45 | p1 = pop(); 46 | push(p1); 47 | numerator(); 48 | yymag(); 49 | push(p1); 50 | denominator(); 51 | yymag(); 52 | divide(); 53 | restore(); 54 | } 55 | 56 | void 57 | yymag(void) 58 | { 59 | save(); 60 | p1 = pop(); 61 | if (isnegativenumber(p1)) { 62 | push(p1); 63 | negate(); 64 | } else if (car(p1) == symbol(POWER) && equaln(cadr(p1), -1)) 65 | // -1 to a power 66 | push_integer(1); 67 | else if (car(p1) == symbol(POWER) && cadr(p1) == symbol(E)) { 68 | // exponential 69 | push(caddr(p1)); 70 | real(); 71 | exponential(); 72 | } else if (car(p1) == symbol(MULTIPLY)) { 73 | // product 74 | push_integer(1); 75 | p1 = cdr(p1); 76 | while (iscons(p1)) { 77 | push(car(p1)); 78 | mag(); 79 | multiply(); 80 | p1 = cdr(p1); 81 | } 82 | } else if (car(p1) == symbol(ADD)) { 83 | // sum 84 | push(p1); 85 | rect(); // convert polar terms, if any 86 | p1 = pop(); 87 | push(p1); 88 | real(); 89 | push_integer(2); 90 | power(); 91 | push(p1); 92 | imag(); 93 | push_integer(2); 94 | power(); 95 | add(); 96 | push_rational(1, 2); 97 | power(); 98 | simplify_trig(); 99 | } else 100 | // default (all real) 101 | push(p1); 102 | restore(); 103 | } 104 | 105 | #if SELFTEST 106 | 107 | static char *s[] = { 108 | 109 | "mag(a+i*b)", 110 | "(a^2+b^2)^(1/2)", 111 | 112 | "mag(exp(a+i*b))", 113 | "exp(a)", 114 | 115 | "mag(1)", 116 | "1", 117 | 118 | "mag(-1)", 119 | "1", 120 | 121 | "mag(1+exp(i*pi/3))", 122 | "3^(1/2)", 123 | 124 | "mag((a+i*b)/(c+i*d))", 125 | "(a^2+b^2)^(1/2)/((c^2+d^2)^(1/2))", 126 | 127 | "mag(exp(i theta))", 128 | "1", 129 | 130 | "mag(exp(-i theta))", 131 | "1", 132 | 133 | "mag((-1)^theta)", 134 | "1", 135 | 136 | "mag((-1)^(-theta))", 137 | "1", 138 | 139 | "mag(3*(-1)^theta)", 140 | "3", 141 | 142 | "mag(3*(-1)^(-theta))", 143 | "3", 144 | 145 | "mag(-3*(-1)^theta)", 146 | "3", 147 | 148 | "mag(-3*(-1)^(-theta))", 149 | "3", 150 | }; 151 | 152 | void 153 | test_mag(void) 154 | { 155 | test(__FILE__, s, sizeof s / sizeof (char *)); 156 | } 157 | 158 | #endif 159 | -------------------------------------------------------------------------------- /src/mcmp.cpp: -------------------------------------------------------------------------------- 1 | // Bignum compare 2 | // 3 | // returns 4 | // 5 | // -1 a < b 6 | // 7 | // 0 a = b 8 | // 9 | // 1 a > b 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | 14 | int 15 | mcmp(unsigned int *a, unsigned int *b) 16 | { 17 | int i; 18 | 19 | if (MSIGN(a) == -1 && MSIGN(b) == 1) 20 | return -1; 21 | 22 | if (MSIGN(a) == 1 && MSIGN(b) == -1) 23 | return 1; 24 | 25 | // same sign 26 | 27 | if (MLENGTH(a) < MLENGTH(b)) { 28 | if (MSIGN(a) == 1) 29 | return -1; 30 | else 31 | return 1; 32 | } 33 | 34 | if (MLENGTH(a) > MLENGTH(b)) { 35 | if (MSIGN(a) == 1) 36 | return 1; 37 | else 38 | return -1; 39 | } 40 | 41 | // same length 42 | 43 | for (i = MLENGTH(a) - 1; i > 0; i--) 44 | if (a[i] != b[i]) 45 | break; 46 | 47 | if (a[i] < b[i]) { 48 | if (MSIGN(a) == 1) 49 | return -1; 50 | else 51 | return 1; 52 | } 53 | 54 | if (a[i] > b[i]) { 55 | if (MSIGN(a) == 1) 56 | return 1; 57 | else 58 | return -1; 59 | } 60 | 61 | return 0; 62 | } 63 | 64 | int 65 | mcmpint(unsigned int *a, int n) 66 | { 67 | int t; 68 | unsigned int *b; 69 | b = mint(n); 70 | t = mcmp(a, b); 71 | mfree(b); 72 | return t; 73 | } 74 | 75 | #if SELFTEST 76 | 77 | void 78 | test_mcmp(void) 79 | { 80 | int i, j, k; 81 | unsigned int *x, *y; 82 | logout("testing mcmp\n"); 83 | for (i = -1000; i < 1000; i++) { 84 | x = mint(i); 85 | for (j = -1000; j < 1000; j++) { 86 | y = mint(j); 87 | k = mcmp(x, y); 88 | if (i == j && k != 0) { 89 | logout("failed\n"); 90 | errout(); 91 | } 92 | if (i < j && k != -1) { 93 | logout("failed\n"); 94 | errout(); 95 | } 96 | if (i > j && k != 1) { 97 | logout("failed\n"); 98 | errout(); 99 | } 100 | mfree(y); 101 | } 102 | mfree(x); 103 | } 104 | logout("ok\n"); 105 | } 106 | 107 | #endif 108 | -------------------------------------------------------------------------------- /src/memmgr.h: -------------------------------------------------------------------------------- 1 | //---------------------------------------------------------------- 2 | // Statically-allocated memory manager 3 | // 4 | // by Eli Bendersky (eliben@gmail.com) 5 | // 6 | // This code is in the public domain. 7 | //---------------------------------------------------------------- 8 | #ifndef MEMMGR_H 9 | #define MEMMGR_H 10 | 11 | // 12 | // Memory manager: dynamically allocates memory from 13 | // a fixed pool that is allocated statically at link-time. 14 | // 15 | // Usage: after calling memmgr_init() in your 16 | // initialization routine, just use memmgr_alloc() instead 17 | // of malloc() and memmgr_free() instead of free(). 18 | // Naturally, you can use the preprocessor to define 19 | // malloc() and free() as aliases to memmgr_alloc() and 20 | // memmgr_free(). This way the manager will be a drop-in 21 | // replacement for the standard C library allocators, and can 22 | // be useful for debugging memory allocation problems and 23 | // leaks. 24 | // 25 | // Preprocessor flags you can define to customize the 26 | // memory manager: 27 | // 28 | // DEBUG_MEMMGR_FATAL 29 | // Allow printing out a message when allocations fail 30 | // 31 | // DEBUG_MEMMGR_SUPPORT_STATS 32 | // Allow printing out of stats in function 33 | // memmgr_print_stats When this is disabled, 34 | // memmgr_print_stats does nothing. 35 | // 36 | // Note that in production code on an embedded system 37 | // you'll probably want to keep those undefined, because 38 | // they cause printf to be called. 39 | // 40 | // POOL_SIZE 41 | // Size of the pool for new allocations. This is 42 | // effectively the heap size of the application, and can 43 | // be changed in accordance with the available memory 44 | // resources. 45 | // 46 | // MIN_POOL_ALLOC_QUANTAS 47 | // Internally, the memory manager allocates memory in 48 | // quantas roughly the size of two ulong objects. To 49 | // minimize pool fragmentation in case of multiple allocations 50 | // and deallocations, it is advisable to not allocate 51 | // blocks that are too small. 52 | // This flag sets the minimal ammount of quantas for 53 | // an allocation. If the size of a ulong is 4 and you 54 | // set this flag to 16, the minimal size of an allocation 55 | // will be 4 * 2 * 16 = 128 bytes 56 | // If you have a lot of small allocations, keep this value 57 | // low to conserve memory. If you have mostly large 58 | // allocations, it is best to make it higher, to avoid 59 | // fragmentation. 60 | // 61 | // Notes: 62 | // 1. This memory manager is *not thread safe*. Use it only 63 | // for single thread/task applications. 64 | // 65 | 66 | //#define DEBUG_MEMMGR_SUPPORT_STATS 1 67 | 68 | #define POOL_SIZE 128 * 1024 69 | #define MIN_POOL_ALLOC_QUANTAS 300 70 | 71 | 72 | typedef unsigned char byte; 73 | typedef unsigned long ulong; 74 | 75 | 76 | 77 | // Initialize the memory manager. This function should be called 78 | // only once in the beginning of the program. 79 | // 80 | void memmgr_init(); 81 | 82 | // 'malloc' clone 83 | // 84 | void* memmgr_alloc(ulong nbytes); 85 | 86 | // 'free' clone 87 | // 88 | void memmgr_free(void* ap); 89 | 90 | // Prints statistics about the current state of the memory 91 | // manager 92 | // 93 | void memmgr_print_stats(); 94 | 95 | 96 | #endif // MEMMGR_H 97 | -------------------------------------------------------------------------------- /src/mfactor.cpp: -------------------------------------------------------------------------------- 1 | // For odd n, returns the largest factor less than or equal to sqrt(n) 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #if 0 // not used anymore 7 | 8 | unsigned int * 9 | mfactor(unsigned int *n) 10 | { 11 | unsigned int *r, *root, *t, *two, *x, *y; 12 | 13 | two = mint(2); 14 | 15 | root = msqrt(n); 16 | 17 | // y = 1; 18 | 19 | y = mint(1); 20 | 21 | // x = 2 isqrt(n) + 1 22 | 23 | t = madd(root, root); 24 | x = madd(t, y); 25 | mfree(t); 26 | 27 | // r = isqrt(n) ^ 2 - n 28 | 29 | t = mmul(root, root); 30 | r = msub(t, n); 31 | mfree(t); 32 | 33 | mfree(root); 34 | 35 | while (1) { 36 | 37 | if (MZERO(r)) { 38 | 39 | // n = (x - y) / 2 40 | 41 | t = msub(x, y); 42 | n = mdiv(t, two); 43 | mfree(t); 44 | 45 | mfree(r); 46 | mfree(x); 47 | mfree(y); 48 | mfree(two); 49 | 50 | return n; 51 | } 52 | 53 | // r = r + x 54 | 55 | t = madd(r, x); 56 | mfree(r); 57 | r = t; 58 | 59 | // x = x + 2 60 | 61 | t = madd(x, two); 62 | mfree(x); 63 | x = t; 64 | 65 | while (1) { 66 | 67 | // r = r - y 68 | 69 | t = msub(r, y); 70 | mfree(r); 71 | r = t; 72 | 73 | // y = y + 2 74 | 75 | t = madd(y, two); 76 | mfree(y); 77 | y = t; 78 | 79 | if (MSIGN(r) == -1 || MZERO(r)) 80 | break; 81 | } 82 | } 83 | } 84 | 85 | void 86 | test_mfactor(void) 87 | { 88 | unsigned int *n; 89 | n = mint(377); 90 | n = mfactor(n); 91 | printf("%d\n", n[0]); 92 | } 93 | 94 | #endif 95 | -------------------------------------------------------------------------------- /src/mgcd.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Bignum GCD 4 | // 5 | // Uses the binary GCD algorithm. 6 | // 7 | // See "The Art of Computer Programming" p. 338. 8 | // 9 | // mgcd always returns a positive value 10 | // 11 | // mgcd(0, 0) = 0 12 | // 13 | // mgcd(u, 0) = |u| 14 | // 15 | // mgcd(0, v) = |v| 16 | // 17 | //----------------------------------------------------------------------------- 18 | 19 | #include "stdafx.h" 20 | #include "defs.h" 21 | 22 | unsigned int * 23 | mgcd(unsigned int *u, unsigned int *v) 24 | { 25 | int i, k, n; 26 | unsigned int *t; 27 | 28 | if (MZERO(u)) { 29 | t = mcopy(v); 30 | MSIGN(t) = 1; 31 | return t; 32 | } 33 | 34 | if (MZERO(v)) { 35 | t = mcopy(u); 36 | MSIGN(t) = 1; 37 | return t; 38 | } 39 | 40 | u = mcopy(u); 41 | v = mcopy(v); 42 | 43 | MSIGN(u) = 1; 44 | MSIGN(v) = 1; 45 | 46 | k = 0; 47 | 48 | while ((u[0] & 1) == 0 && (v[0] & 1) == 0) { 49 | mshiftright(u); 50 | mshiftright(v); 51 | k++; 52 | } 53 | 54 | if (u[0] & 1) { 55 | t = mcopy(v); 56 | MSIGN(t) *= -1; 57 | } else 58 | t = mcopy(u); 59 | 60 | while (1) { 61 | 62 | while ((t[0] & 1) == 0) 63 | mshiftright(t); 64 | 65 | if (MSIGN(t) == 1) { 66 | mfree(u); 67 | u = mcopy(t); 68 | } else { 69 | mfree(v); 70 | v = mcopy(t); 71 | MSIGN(v) *= -1; 72 | } 73 | 74 | mfree(t); 75 | 76 | t = msub(u, v); 77 | 78 | if (MZERO(t)) { 79 | mfree(t); 80 | mfree(v); 81 | n = (k / 32) + 1; 82 | v = mnew(n); 83 | MSIGN(v) = 1; 84 | MLENGTH(v) = n; 85 | for (i = 0; i < n; i++) 86 | v[i] = 0; 87 | mp_set_bit(v, k); 88 | t = mmul(u, v); 89 | mfree(u); 90 | mfree(v); 91 | return t; 92 | } 93 | } 94 | } 95 | 96 | #if SELFTEST 97 | 98 | static unsigned int *egcd(unsigned int *, unsigned int *); 99 | 100 | void 101 | test_mgcd(void) 102 | { 103 | int i, j, n; 104 | unsigned int *a, *b, *c, *d; 105 | logout("testing mgcd\n"); 106 | n = mtotal; 107 | for (i = 1; i < 100; i++) { 108 | a = mint(i); 109 | for (j = 1; j < 100; j++) { 110 | b = mint(j); 111 | c = mgcd(a, b); 112 | d = egcd(a, b); 113 | if (mcmp(c, d) != 0) { 114 | logout("failed\n"); 115 | errout(); 116 | } 117 | mfree(b); 118 | mfree(c); 119 | mfree(d); 120 | } 121 | mfree(a); 122 | } 123 | if (n != mtotal) { 124 | logout("memory leak\n"); 125 | errout(); 126 | } 127 | logout("ok\n"); 128 | } 129 | 130 | // Euclid's algorithm 131 | 132 | static unsigned int * 133 | egcd(unsigned int *a, unsigned int *b) 134 | { 135 | int sign; 136 | unsigned int *c; 137 | if (MZERO(b)) 138 | stop("divide by zero"); 139 | b = mcopy(b); 140 | if (MZERO(a)) 141 | return b; 142 | sign = MSIGN(b); 143 | a = mcopy(a); 144 | while (!MZERO(b)) { 145 | c = mmod(a, b); 146 | mfree(a); 147 | a = b; 148 | b = c; 149 | } 150 | mfree(b); 151 | MSIGN(a) = sign; 152 | return a; 153 | } 154 | 155 | #endif 156 | -------------------------------------------------------------------------------- /src/mmodpow.cpp: -------------------------------------------------------------------------------- 1 | // Bignum modular power (x^n mod m) 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | // could do indexed bit test instead of shift right 7 | 8 | unsigned int * 9 | mmodpow(unsigned int *x, unsigned int *n, unsigned int *m) 10 | { 11 | unsigned int *y, *z; 12 | x = mcopy(x); 13 | n = mcopy(n); 14 | y = mint(1); 15 | while (1) { 16 | if (n[0] & 1) { 17 | z = mmul(y, x); 18 | mfree(y); 19 | y = mmod(z, m); 20 | mfree(z); 21 | } 22 | mshiftright(n); 23 | if (MZERO(n)) 24 | break; 25 | z = mmul(x, x); 26 | mfree(x); 27 | x = mmod(z, m); 28 | mfree(z); 29 | } 30 | mfree(x); 31 | mfree(n); 32 | return y; 33 | } 34 | 35 | #if SELFTEST 36 | 37 | void 38 | test_mmodpow(void) 39 | { 40 | int mem; 41 | int x, n, m; 42 | unsigned int *xx, *nn, *mm, *y; 43 | mem = mtotal; 44 | for (x = 1; x < 100; x++) { 45 | xx = mint(x); 46 | for (n = 1; n < 100; n++) { 47 | nn = mint(n); 48 | for (m = 1; m < 10; m++) { 49 | mm = mint(m); 50 | y = mmodpow(xx, nn, mm); 51 | mfree(y); 52 | mfree(mm); 53 | } 54 | mfree(nn); 55 | } 56 | mfree(xx); 57 | } 58 | if (mem != mtotal) { 59 | sprintf(logbuf, "mmodpow memory leak %d %d\n", mem, mtotal); 60 | logout(logbuf); 61 | errout(); 62 | } 63 | } 64 | 65 | #endif 66 | -------------------------------------------------------------------------------- /src/mod.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | 3 | #include "defs.h" 4 | 5 | void mod(void); 6 | 7 | void 8 | eval_mod(void) 9 | { 10 | push(cadr(p1)); 11 | eval(); 12 | push(caddr(p1)); 13 | eval(); 14 | mod(); 15 | } 16 | 17 | void 18 | mod(void) 19 | { 20 | int n; 21 | 22 | save(); 23 | 24 | p2 = pop(); 25 | p1 = pop(); 26 | 27 | if (iszero(p2)) 28 | stop("mod function: divide by zero"); 29 | 30 | if (!isnum(p1) || !isnum(p2)) { 31 | push_symbol(MOD); 32 | push(p1); 33 | push(p2); 34 | list(3); 35 | restore(); 36 | return; 37 | } 38 | 39 | if (isdouble(p1)) { 40 | push(p1); 41 | n = pop_integer(); 42 | if (n == (int) 0x80000000) 43 | stop("mod function: cannot convert float value to integer"); 44 | push_integer(n); 45 | p1 = pop(); 46 | } 47 | 48 | if (isdouble(p2)) { 49 | push(p2); 50 | n = pop_integer(); 51 | if (n == (int) 0x80000000) 52 | stop("mod function: cannot convert float value to integer"); 53 | push_integer(n); 54 | p2 = pop(); 55 | } 56 | 57 | if (!isinteger(p1) || !isinteger(p2)) 58 | stop("mod function: integer arguments expected"); 59 | 60 | p3 = alloc(); 61 | p3->k = NUM; 62 | p3->u.q.a = mmod(p1->u.q.a, p2->u.q.a); 63 | p3->u.q.b = mint(1); 64 | push(p3); 65 | 66 | restore(); 67 | } 68 | 69 | #if SELFTEST 70 | 71 | static char *s[] = { 72 | 73 | "mod(2.0,3.0)", 74 | "2", 75 | 76 | "mod(-2.0,3.0)", 77 | "-2", 78 | 79 | "mod(2.0,-3.0)", 80 | "2", 81 | 82 | "mod(-2.0,-3.0)", 83 | "-2", 84 | 85 | "mod(2,3)", 86 | "2", 87 | 88 | "mod(-2,3)", 89 | "-2", 90 | 91 | "mod(2,-3)", 92 | "2", 93 | 94 | "mod(-2,-3)", 95 | "-2", 96 | 97 | "mod(a,b)", 98 | "mod(a,b)", 99 | 100 | "mod(2.0,0.0)", 101 | "Stop: mod function: divide by zero", 102 | 103 | "mod(2,0)", 104 | "Stop: mod function: divide by zero", 105 | 106 | "mod(1.2,2)", 107 | "Stop: mod function: cannot convert float value to integer", 108 | 109 | "mod(1/2,3)", 110 | "Stop: mod function: integer arguments expected", 111 | 112 | "mod(15,8.0)", 113 | "7", 114 | }; 115 | 116 | void 117 | test_mod(void) 118 | { 119 | test(__FILE__, s, sizeof s / sizeof (char *)); 120 | } 121 | 122 | #endif 123 | -------------------------------------------------------------------------------- /src/mpow.cpp: -------------------------------------------------------------------------------- 1 | // Bignum power 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | unsigned int * 7 | mpow(unsigned int *a, unsigned int n) 8 | { 9 | unsigned int *aa, *t; 10 | 11 | a = mcopy(a); 12 | 13 | aa = mint(1); 14 | 15 | for (;;) { 16 | 17 | if (n & 1) { 18 | t = mmul(aa, a); 19 | mfree(aa); 20 | aa = t; 21 | } 22 | 23 | n >>= 1; 24 | 25 | if (n == 0) 26 | break; 27 | 28 | t = mmul(a, a); 29 | mfree(a); 30 | a = t; 31 | } 32 | 33 | mfree(a); 34 | 35 | return aa; 36 | } 37 | 38 | #if SELFTEST 39 | 40 | void 41 | test_mpow(void) 42 | { 43 | int i, j, mem, x; 44 | unsigned int *a, *b, *c; 45 | 46 | logout("testing mpow\n"); 47 | 48 | mem = mtotal; 49 | 50 | // small numbers 51 | 52 | for (i = -10; i < 10; i++) { 53 | a = mint(i); 54 | x = 1; 55 | for (j = 0; j < 10; j++) { 56 | b = mpow(a, j); 57 | c = mint(x); 58 | if (mcmp(b, c) != 0) { 59 | sprintf(logbuf, "failed a=%d b=%d c=%d\n", a[0], b[0], c[0]); 60 | logout(logbuf); 61 | errout(); 62 | } 63 | mfree(b); 64 | mfree(c); 65 | x *= i; 66 | } 67 | mfree(a); 68 | } 69 | 70 | if (mem != mtotal) { 71 | logout("memory leak\n"); 72 | errout(); 73 | } 74 | 75 | logout("ok\n"); 76 | } 77 | 78 | #endif 79 | -------------------------------------------------------------------------------- /src/mprime.cpp: -------------------------------------------------------------------------------- 1 | // Bignum prime test (returns 1 if prime, 0 if not) 2 | 3 | // Uses Algorithm P (probabilistic primality test) from p. 395 of 4 | // "The Art of Computer Programming, Volume 2" by Donald E. Knuth. 5 | 6 | #include "stdafx.h" 7 | #include "defs.h" 8 | 9 | static int mprimef(unsigned int *, unsigned int *, int); 10 | 11 | int 12 | mprime(unsigned int *n) 13 | { 14 | int i, k; 15 | unsigned int *q; 16 | 17 | // 1? 18 | 19 | if (MLENGTH(n) == 1 && n[0] == 1) 20 | return 0; 21 | 22 | // 2? 23 | 24 | if (MLENGTH(n) == 1 && n[0] == 2) 25 | return 1; 26 | 27 | // even? 28 | 29 | if ((n[0] & 1) == 0) 30 | return 0; 31 | 32 | // n = 1 + (2 ^ k) q 33 | 34 | q = mcopy(n); 35 | 36 | k = 0; 37 | do { 38 | mshiftright(q); 39 | k++; 40 | } while ((q[0] & 1) == 0); 41 | 42 | // try 25 times 43 | 44 | for (i = 0; i < 25; i++) 45 | if (mprimef(n, q, k) == 0) 46 | break; 47 | 48 | mfree(q); 49 | 50 | if (i < 25) 51 | return 0; 52 | else 53 | return 1; 54 | } 55 | 56 | //----------------------------------------------------------------------------- 57 | // 58 | // This is the actual implementation of Algorithm P. 59 | // 60 | // Input: n The number in question. 61 | // 62 | // q n = 1 + (2 ^ k) q 63 | // 64 | // k 65 | // 66 | // Output: 1 when n is probably prime 67 | // 68 | // 0 when n is definitely not prime 69 | // 70 | //----------------------------------------------------------------------------- 71 | 72 | static int 73 | mprimef(unsigned int *n, unsigned int *q, int k) 74 | { 75 | int i, j; 76 | unsigned int *t, *x, *y; 77 | 78 | // generate x 79 | 80 | t = mcopy(n); 81 | 82 | while (1) { 83 | for (i = 0; i < MLENGTH(t); i++) 84 | t[i] = rand(); 85 | x = mmod(t, n); 86 | if (!MZERO(x) && !MEQUAL(x, 1)) 87 | break; 88 | mfree(x); 89 | } 90 | 91 | mfree(t); 92 | 93 | // exponentiate 94 | 95 | y = mmodpow(x, q, n); 96 | 97 | // done? 98 | 99 | if (MEQUAL(y, 1)) { 100 | mfree(x); 101 | mfree(y); 102 | return 1; 103 | } 104 | 105 | j = 0; 106 | 107 | while (1) { 108 | 109 | // y = n - 1? 110 | 111 | t = msub(n, y); 112 | 113 | if (MEQUAL(t, 1)) { 114 | mfree(t); 115 | mfree(x); 116 | mfree(y); 117 | return 1; 118 | } 119 | 120 | mfree(t); 121 | 122 | if (++j == k) { 123 | mfree(x); 124 | mfree(y); 125 | return 0; 126 | } 127 | 128 | // y = (y ^ 2) mod n 129 | 130 | t = mmul(y, y); 131 | mfree(y); 132 | y = mmod(t, n); 133 | mfree(t); 134 | 135 | // y = 1? 136 | 137 | if (MEQUAL(y, 1)) { 138 | mfree(x); 139 | mfree(y); 140 | return 0; 141 | } 142 | } 143 | } 144 | 145 | #if SELFTEST 146 | 147 | void 148 | test_mprime(void) 149 | { 150 | int i, k, m, t; 151 | unsigned int *n; 152 | logout("test mprime\n"); 153 | m = mtotal; 154 | k = 0; 155 | for (i = 0; i < 10000; i++) { 156 | n = mint(i); 157 | t = mprime(n); 158 | mfree(n); 159 | //if (i == primetab[k]) { 160 | if (i == get_prime_number(k)) { 161 | if (t == 0) { 162 | sprintf(logbuf, "failed for prime number %d\n", i); 163 | logout(logbuf); 164 | errout(); 165 | } 166 | k++; 167 | } else if (t == 1) { 168 | sprintf(logbuf, "failed for composite number %d\n", i); 169 | logout(logbuf); 170 | errout(); 171 | } 172 | } 173 | if (m != mtotal) { 174 | logout("memory leak\n"); 175 | errout(); 176 | } 177 | logout("ok\n"); 178 | } 179 | 180 | #endif 181 | -------------------------------------------------------------------------------- /src/mroot.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Bignum root 4 | // 5 | // Returns null pointer if not perfect root. 6 | // 7 | // The sign of the radicand is ignored. 8 | // 9 | //----------------------------------------------------------------------------- 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | 14 | unsigned int * 15 | mroot(unsigned int *n, unsigned int index) 16 | { 17 | int i, j, k; 18 | unsigned int m, *x, *y; 19 | 20 | if (index == 0) 21 | stop("root index is zero"); 22 | 23 | // count number of bits 24 | 25 | k = 32 * (MLENGTH(n) - 1); 26 | 27 | m = n[MLENGTH(n) - 1]; 28 | 29 | while (m) { 30 | m >>= 1; 31 | k++; 32 | } 33 | 34 | if (k == 0) 35 | return mint(0); 36 | 37 | // initial guess 38 | 39 | k = (k - 1) / index; 40 | 41 | j = k / 32 + 1; 42 | x = mnew(j); 43 | MSIGN(x) = 1; 44 | MLENGTH(x) = j; 45 | for (i = 0; i < j; i++) 46 | x[i] = 0; 47 | 48 | while (k >= 0) { 49 | mp_set_bit(x, k); 50 | y = mpow(x, index); 51 | switch (mcmp(y, n)) { 52 | case -1: 53 | break; 54 | case 0: 55 | mfree(y); 56 | return x; 57 | case 1: 58 | mp_clr_bit(x, k); 59 | break; 60 | } 61 | mfree(y); 62 | k--; 63 | } 64 | 65 | mfree(x); 66 | 67 | return 0; 68 | } 69 | 70 | #if SELFTEST 71 | 72 | void 73 | test_mroot(void) 74 | { 75 | int i, j, mem; 76 | unsigned int *a, *b, *c; 77 | 78 | logout("testing mroot\n"); 79 | 80 | mem = mtotal; 81 | 82 | // small numbers 83 | 84 | for (i = 0; i < 10; i++) { 85 | a = mint(i); 86 | for (j = 1; j < 10; j++) { 87 | b = mpow(a, j); 88 | c = mroot(b, j); 89 | if (c == 0 || mcmp(a, c) != 0) { 90 | sprintf(logbuf, "failed a=%d b=%d c=%d\n", a[0], b[0], c[0]); 91 | logout(logbuf); 92 | errout(); 93 | } 94 | mfree(b); 95 | mfree(c); 96 | } 97 | mfree(a); 98 | } 99 | 100 | a = mint(12345); 101 | 102 | for (i = 1; i < 10; i++) { 103 | b = mpow(a, i); 104 | c = mroot(b, i); 105 | if (c == 0 || mcmp(a, c) != 0) { 106 | logout("failed\n"); 107 | errout(); 108 | } 109 | mfree(b); 110 | mfree(c); 111 | } 112 | 113 | mfree(a); 114 | 115 | if (mtotal != mem) { 116 | logout("memory leak\n"); 117 | errout(); 118 | } 119 | 120 | logout("ok\n"); 121 | } 122 | 123 | #endif 124 | -------------------------------------------------------------------------------- /src/mscan.cpp: -------------------------------------------------------------------------------- 1 | // bignum scanner 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | static unsigned int *addf(unsigned int *, int); 7 | static unsigned int *mulf(unsigned int *, int); 8 | 9 | unsigned int * 10 | mscan(char *s) 11 | { 12 | int sign; 13 | unsigned int *a, *b, *c; 14 | 15 | sign = 1; 16 | 17 | if (*s == '-') { 18 | sign = -1; 19 | s++; 20 | } 21 | 22 | a = mint(0); 23 | 24 | while (*s) { 25 | b = mulf(a, 10); 26 | c = addf(b, *s - '0'); 27 | mfree(a); 28 | mfree(b); 29 | a = c; 30 | s++; 31 | } 32 | 33 | if (!MZERO(a)) 34 | MSIGN(a) *= sign; 35 | 36 | return a; 37 | } 38 | 39 | static unsigned int * 40 | addf(unsigned int *a, int n) 41 | { 42 | unsigned int *b, *c; 43 | b = mint(n); 44 | c = madd(a, b); 45 | mfree(b); 46 | return c; 47 | } 48 | 49 | static unsigned int * 50 | mulf(unsigned int *a, int n) 51 | { 52 | unsigned int *b, *c; 53 | b = mint(n); 54 | c = mmul(a, b); 55 | mfree(b); 56 | return c; 57 | } 58 | -------------------------------------------------------------------------------- /src/msqrt.cpp: -------------------------------------------------------------------------------- 1 | // Bignum square root 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #if 0 // not used anymore 7 | 8 | unsigned int * 9 | msqrt(unsigned int *n) 10 | { 11 | int i, k, kk; 12 | unsigned int m, *x, *y; 13 | 14 | if (MLENGTH(n) == 1 && n[0] == 0) { 15 | x = mint(0); 16 | return x; 17 | } 18 | 19 | // count number of bits 20 | 21 | k = 32 * (MLENGTH(n) - 1); 22 | 23 | m = n[MLENGTH(n) - 1]; 24 | 25 | while (m) { 26 | m >>= 1; 27 | k++; 28 | } 29 | 30 | k = (k - 1) / 2; 31 | 32 | // initial guess 33 | 34 | kk = k / 32 + 1; 35 | x = mnew(kk); 36 | MSIGN(x) = 1; 37 | MLENGTH(x) = kk; 38 | for (i = 0; i < kk; i++) 39 | x[i] = 0; 40 | mp_set_bit(x, k); 41 | 42 | while (--k >= 0) { 43 | mp_set_bit(x, k); 44 | y = mmul(x, x); 45 | if (mcmp(y, n) == 1) 46 | mp_clr_bit(x, k); 47 | mfree(y); 48 | } 49 | 50 | return x; 51 | } 52 | 53 | void 54 | test_msqrt(void) 55 | { 56 | int i; 57 | unsigned int *n, *x, *y; 58 | logout("testing msqrt\n"); 59 | for (i = 0; i < 1000000; i++) { 60 | n = mint(i); 61 | x = msqrt(n); 62 | y = mint((int) (sqrt((double) i) + 1e-10)); 63 | if (mcmp(x, y) != 0) { 64 | sprintf(logbuf, "failed for %d got %u\n", i, x[0]); 65 | logout(logbuf); 66 | errout(); 67 | } 68 | mfree(n); 69 | mfree(x); 70 | mfree(y); 71 | } 72 | logout("ok\n"); 73 | } 74 | 75 | #endif 76 | -------------------------------------------------------------------------------- /src/mstr.cpp: -------------------------------------------------------------------------------- 1 | // Convert bignum to string 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | static int divby1billion(unsigned int *); 7 | 8 | static char *str; 9 | static int len; 10 | 11 | char * 12 | mstr(unsigned int *a) 13 | { 14 | int k, n, r, sign; 15 | char c; 16 | 17 | if (str == NULL) { 18 | str = (char *) malloc(1000); 19 | len = 1000; 20 | } 21 | 22 | // estimate string size 23 | 24 | n = 10 * MLENGTH(a) + 2; 25 | 26 | if (n > len) { 27 | free(str); 28 | str = (char *) malloc(n); 29 | len = n; 30 | } 31 | 32 | sign = MSIGN(a); 33 | 34 | a = mcopy(a); 35 | 36 | k = len - 1; 37 | 38 | str[k] = 0; 39 | 40 | for (;;) { 41 | k -= 9; 42 | r = divby1billion(a); 43 | c = str[k + 9]; 44 | sprintf(str + k, "%09d", r); 45 | str[k + 9] = c; 46 | if (MZERO(a)) 47 | break; 48 | } 49 | 50 | // remove leading zeroes 51 | 52 | while (str[k] == '0') 53 | k++; 54 | 55 | if (str[k] == 0) 56 | k--; 57 | 58 | // sign 59 | 60 | if (sign == -1) { 61 | k--; 62 | str[k] = '-'; 63 | } 64 | 65 | mfree(a); 66 | 67 | return str + k; 68 | } 69 | 70 | // Returns remainder as function value, quotient returned in a. 71 | 72 | static int 73 | divby1billion(unsigned int *a) 74 | { 75 | int i; 76 | unsigned long long kk; 77 | 78 | kk = 0; 79 | 80 | for (i = MLENGTH(a) - 1; i >= 0; i--) { 81 | 82 | if (little_endian()) { 83 | ((unsigned int *) &kk)[1] = ((unsigned int *) &kk)[0]; 84 | ((unsigned int *) &kk)[0] = a[i]; 85 | } else { 86 | ((unsigned int *) &kk)[0] = ((unsigned int *) &kk)[1]; 87 | ((unsigned int *) &kk)[1] = a[i]; 88 | } 89 | 90 | a[i] = (int) (kk / 1000000000); 91 | 92 | kk -= (unsigned long long) 1000000000 * a[i]; 93 | } 94 | 95 | // length of quotient 96 | 97 | for (i = MLENGTH(a) - 1; i > 0; i--) 98 | if (a[i]) 99 | break; 100 | 101 | MLENGTH(a) = i + 1; 102 | 103 | if (little_endian()) 104 | return ((unsigned int *) &kk)[0]; 105 | else 106 | return ((unsigned int *) &kk)[1]; 107 | } 108 | -------------------------------------------------------------------------------- /src/numerator.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_numerator(void) 6 | { 7 | push(cadr(p1)); 8 | eval(); 9 | numerator(); 10 | } 11 | 12 | void 13 | numerator(void) 14 | { 15 | int h; 16 | 17 | save(); 18 | 19 | p1 = pop(); 20 | 21 | if (car(p1) == symbol(ADD)) { 22 | push(p1); 23 | rationalize(); 24 | p1 = pop(); 25 | } 26 | 27 | if (car(p1) == symbol(MULTIPLY)) { 28 | h = tos; 29 | p1 = cdr(p1); 30 | while (iscons(p1)) { 31 | push(car(p1)); 32 | numerator(); 33 | p1 = cdr(p1); 34 | } 35 | multiply_all(tos - h); 36 | } else if (isrational(p1)) { 37 | push(p1); 38 | mp_numerator(); 39 | } else if (car(p1) == symbol(POWER) && isnegativeterm(caddr(p1))) 40 | push(one); 41 | else 42 | push(p1); 43 | 44 | restore(); 45 | } 46 | 47 | #if SELFTEST 48 | 49 | static char *s[] = { 50 | 51 | "numerator(2/3)", 52 | "2", 53 | 54 | "numerator(x)", 55 | "x", 56 | 57 | "numerator(1/x)", 58 | "1", 59 | 60 | "numerator(a+b)", 61 | "a+b", 62 | 63 | "numerator(1/a+1/b)", 64 | "a+b", 65 | }; 66 | 67 | void 68 | test_numerator(void) 69 | { 70 | test(__FILE__, s, sizeof s / sizeof (char *)); 71 | } 72 | 73 | #endif 74 | -------------------------------------------------------------------------------- /src/outer.cpp: -------------------------------------------------------------------------------- 1 | // Outer product of tensors 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_outer(void) 8 | { 9 | p1 = cdr(p1); 10 | push(car(p1)); 11 | eval(); 12 | p1 = cdr(p1); 13 | while (iscons(p1)) { 14 | push(car(p1)); 15 | eval(); 16 | outer(); 17 | p1 = cdr(p1); 18 | } 19 | } 20 | 21 | void 22 | outer(void) 23 | { 24 | save(); 25 | p2 = pop(); 26 | p1 = pop(); 27 | if (istensor(p1) && istensor(p2)) 28 | yyouter(); 29 | else { 30 | push(p1); 31 | push(p2); 32 | if (istensor(p1)) 33 | tensor_times_scalar(); 34 | else if (istensor(p2)) 35 | scalar_times_tensor(); 36 | else 37 | multiply(); 38 | } 39 | restore(); 40 | } 41 | 42 | void 43 | yyouter(void) 44 | { 45 | int i, j, k, ndim, nelem; 46 | 47 | ndim = p1->u.tensor->ndim + p2->u.tensor->ndim; 48 | 49 | if (ndim > MAXDIM) 50 | stop("outer: rank of result exceeds maximum"); 51 | 52 | nelem = p1->u.tensor->nelem * p2->u.tensor->nelem; 53 | 54 | p3 = alloc_tensor(nelem); 55 | 56 | p3->u.tensor->ndim = ndim; 57 | 58 | for (i = 0; i < p1->u.tensor->ndim; i++) 59 | p3->u.tensor->dim[i] = p1->u.tensor->dim[i]; 60 | 61 | j = i; 62 | 63 | for (i = 0; i < p2->u.tensor->ndim; i++) 64 | p3->u.tensor->dim[j + i] = p2->u.tensor->dim[i]; 65 | 66 | k = 0; 67 | 68 | for (i = 0; i < p1->u.tensor->nelem; i++) 69 | for (j = 0; j < p2->u.tensor->nelem; j++) { 70 | push(p1->u.tensor->elem[i]); 71 | push(p2->u.tensor->elem[j]); 72 | multiply(); 73 | p3->u.tensor->elem[k++] = pop(); 74 | } 75 | 76 | push(p3); 77 | } 78 | 79 | #if SELFTEST 80 | 81 | static char *s[] = { 82 | 83 | "outer(a,b)", 84 | "a*b", 85 | 86 | "outer(a,(b1,b2))", 87 | "(a*b1,a*b2)", 88 | 89 | "outer((a1,a2),b)", 90 | "(a1*b,a2*b)", 91 | 92 | "H33=hilbert(3)", 93 | "", 94 | 95 | "H44=hilbert(4)", 96 | "", 97 | 98 | "H55=hilbert(5)", 99 | "", 100 | 101 | "H3344=outer(H33,H44)", 102 | "", 103 | 104 | "H4455=outer(H44,H55)", 105 | "", 106 | 107 | "H33444455=outer(H33,H44,H44,H55)", 108 | "", 109 | 110 | "simplify(inner(H3344,H4455)-contract(H33444455,4,5))", 111 | "0", 112 | }; 113 | 114 | void 115 | test_outer(void) 116 | { 117 | test(__FILE__, s, sizeof s / sizeof (char *)); 118 | } 119 | 120 | #endif 121 | -------------------------------------------------------------------------------- /src/partition.cpp: -------------------------------------------------------------------------------- 1 | /* Partition a term 2 | 3 | Input stack: 4 | 5 | term (factor or product of factors) 6 | 7 | free variable 8 | 9 | Output stack: 10 | 11 | constant expression 12 | 13 | variable expression 14 | */ 15 | 16 | #include "stdafx.h" 17 | #include "defs.h" 18 | 19 | void 20 | partition(void) 21 | { 22 | save(); 23 | 24 | p2 = pop(); 25 | p1 = pop(); 26 | 27 | push_integer(1); 28 | 29 | p3 = pop(); 30 | p4 = p3; 31 | 32 | p1 = cdr(p1); 33 | 34 | while (iscons(p1)) { 35 | if (find(car(p1), p2)) { 36 | push(p4); 37 | push(car(p1)); 38 | multiply(); 39 | p4 = pop(); 40 | } else { 41 | push(p3); 42 | push(car(p1)); 43 | multiply(); 44 | p3 = pop(); 45 | } 46 | p1 = cdr(p1); 47 | } 48 | 49 | push(p3); 50 | push(p4); 51 | 52 | restore(); 53 | } 54 | -------------------------------------------------------------------------------- /src/polar.cpp: -------------------------------------------------------------------------------- 1 | /* Convert complex z to polar form 2 | 3 | Input: push z 4 | 5 | Output: Result on stack 6 | 7 | polar(z) = mag(z) * exp(i * arg(z)) 8 | */ 9 | 10 | #include "stdafx.h" 11 | #include "defs.h" 12 | 13 | void 14 | eval_polar(void) 15 | { 16 | push(cadr(p1)); 17 | eval(); 18 | polar(); 19 | } 20 | 21 | void 22 | polar(void) 23 | { 24 | save(); 25 | p1 = pop(); 26 | push(p1); 27 | mag(); 28 | push(imaginaryunit); 29 | push(p1); 30 | arg(); 31 | multiply(); 32 | exponential(); 33 | multiply(); 34 | restore(); 35 | } 36 | 37 | #if SELFTEST 38 | 39 | static char *s[] = { 40 | 41 | "polar(1+i)", 42 | "2^(1/2)*exp(1/4*i*pi)", 43 | 44 | "polar(-1+i)", 45 | "2^(1/2)*exp(3/4*i*pi)", 46 | 47 | "polar(-1-i)", 48 | "2^(1/2)*exp(-3/4*i*pi)", 49 | 50 | "polar(1-i)", 51 | "2^(1/2)*exp(-1/4*i*pi)", 52 | 53 | "rect(polar(3+4*i))", 54 | "3+4*i", 55 | 56 | "rect(polar(-3+4*i))", 57 | "-3+4*i", 58 | 59 | "rect(polar(3-4*i))", 60 | "3-4*i", 61 | 62 | "rect(polar(-3-4*i))", 63 | "-3-4*i", 64 | }; 65 | 66 | void 67 | test_polar(void) 68 | { 69 | test(__FILE__, s, sizeof s / sizeof (char *)); 70 | } 71 | 72 | #endif 73 | -------------------------------------------------------------------------------- /src/prime.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Look up the nth prime 4 | // 5 | // Input: n on stack (0 < n < 10001) 6 | // 7 | // Output: nth prime on stack 8 | // 9 | //----------------------------------------------------------------------------- 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | 14 | void 15 | eval_prime(void) 16 | { 17 | push(cadr(p1)); 18 | eval(); 19 | prime(); 20 | } 21 | 22 | void 23 | prime(void) 24 | { 25 | int n; 26 | n = pop_integer(); 27 | if (n < 1 || n > MAXPRIMETAB) 28 | stop("prime: Argument out of range."); 29 | //n = primetab[n - 1]; 30 | n = get_prime_number(n - 1); 31 | push_integer(n); 32 | } 33 | -------------------------------------------------------------------------------- /src/product.cpp: -------------------------------------------------------------------------------- 1 | // 'product' function 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define A p3 7 | #define B p4 8 | #define I p5 9 | #define X p6 10 | 11 | void 12 | eval_product(void) 13 | { 14 | int i, j, k; 15 | 16 | // 1st arg (quoted) 17 | 18 | X = cadr(p1); 19 | if (!issymbol(X)) 20 | stop("product: 1st arg?"); 21 | 22 | // 2nd arg 23 | 24 | push(caddr(p1)); 25 | eval(); 26 | j = pop_integer(); 27 | if (j == (int) 0x80000000) 28 | stop("product: 2nd arg?"); 29 | 30 | // 3rd arg 31 | 32 | push(cadddr(p1)); 33 | eval(); 34 | k = pop_integer(); 35 | if (k == (int) 0x80000000) 36 | stop("product: 3rd arg?"); 37 | 38 | // 4th arg 39 | 40 | p1 = caddddr(p1); 41 | 42 | B = get_binding(X); 43 | A = get_arglist(X); 44 | 45 | push_integer(1); 46 | 47 | for (i = j; i <= k; i++) { 48 | push_integer(i); 49 | I = pop(); 50 | set_binding(X, I); 51 | push(p1); 52 | eval(); 53 | multiply(); 54 | } 55 | 56 | set_binding_and_arglist(X, B, A); 57 | } 58 | -------------------------------------------------------------------------------- /src/qadd.cpp: -------------------------------------------------------------------------------- 1 | // Add rational numbers 2 | // 3 | // Input: tos-2 addend 4 | // 5 | // tos-1 addend 6 | // 7 | // Output: sum on stack 8 | 9 | #include "stdafx.h" 10 | #include "defs.h" 11 | 12 | void 13 | qadd(void) 14 | { 15 | unsigned int *a, *ab, *b, *ba, *c; 16 | 17 | save(); 18 | 19 | p2 = pop(); 20 | p1 = pop(); 21 | 22 | ab = mmul(p1->u.q.a, p2->u.q.b); 23 | ba = mmul(p1->u.q.b, p2->u.q.a); 24 | 25 | a = madd(ab, ba); 26 | 27 | mfree(ab); 28 | mfree(ba); 29 | 30 | // zero? 31 | 32 | if (MZERO(a)) { 33 | mfree(a); 34 | push(zero); 35 | restore(); 36 | return; 37 | } 38 | 39 | b = mmul(p1->u.q.b, p2->u.q.b); 40 | 41 | c = mgcd(a, b); 42 | 43 | MSIGN(c) = MSIGN(b); 44 | 45 | p1 = alloc(); 46 | 47 | p1->k = NUM; 48 | 49 | p1->u.q.a = mdiv(a, c); 50 | p1->u.q.b = mdiv(b, c); 51 | 52 | mfree(a); 53 | mfree(b); 54 | mfree(c); 55 | 56 | push(p1); 57 | 58 | restore(); 59 | } 60 | -------------------------------------------------------------------------------- /src/qdiv.cpp: -------------------------------------------------------------------------------- 1 | // Divide rational numbers 2 | // 3 | // Input: tos-2 dividend 4 | // 5 | // tos-1 divisor 6 | // 7 | // Output: quotient on stack 8 | 9 | #include "stdafx.h" 10 | #include "defs.h" 11 | 12 | void 13 | qdiv(void) 14 | { 15 | unsigned int *aa, *bb, *c; 16 | 17 | save(); 18 | 19 | p2 = pop(); 20 | p1 = pop(); 21 | 22 | // zero? 23 | 24 | if (MZERO(p2->u.q.a)) 25 | stop("divide by zero"); 26 | 27 | if (MZERO(p1->u.q.a)) { 28 | push(zero); 29 | restore(); 30 | return; 31 | } 32 | 33 | aa = mmul(p1->u.q.a, p2->u.q.b); 34 | bb = mmul(p1->u.q.b, p2->u.q.a); 35 | 36 | c = mgcd(aa, bb); 37 | 38 | MSIGN(c) = MSIGN(bb); 39 | 40 | p1 = alloc(); 41 | 42 | p1->k = NUM; 43 | 44 | p1->u.q.a = mdiv(aa, c); 45 | p1->u.q.b = mdiv(bb, c); 46 | 47 | mfree(aa); 48 | mfree(bb); 49 | mfree(c); 50 | 51 | push(p1); 52 | 53 | restore(); 54 | } 55 | -------------------------------------------------------------------------------- /src/qmul.cpp: -------------------------------------------------------------------------------- 1 | // Multiply rational numbers 2 | // 3 | // Input: tos-2 multiplicand 4 | // 5 | // tos-1 multiplier 6 | // 7 | // Output: product on stack 8 | 9 | #include "stdafx.h" 10 | #include "defs.h" 11 | 12 | void 13 | qmul(void) 14 | { 15 | unsigned int *aa, *bb, *c; 16 | 17 | save(); 18 | 19 | p2 = pop(); 20 | p1 = pop(); 21 | 22 | // zero? 23 | 24 | if (MZERO(p1->u.q.a) || MZERO(p2->u.q.a)) { 25 | push(zero); 26 | restore(); 27 | return; 28 | } 29 | 30 | aa = mmul(p1->u.q.a, p2->u.q.a); 31 | bb = mmul(p1->u.q.b, p2->u.q.b); 32 | 33 | c = mgcd(aa, bb); 34 | 35 | MSIGN(c) = MSIGN(bb); 36 | 37 | p1 = alloc(); 38 | 39 | p1->k = NUM; 40 | 41 | p1->u.q.a = mdiv(aa, c); 42 | p1->u.q.b = mdiv(bb, c); 43 | 44 | mfree(aa); 45 | mfree(bb); 46 | mfree(c); 47 | 48 | push(p1); 49 | 50 | restore(); 51 | } 52 | -------------------------------------------------------------------------------- /src/qsub.cpp: -------------------------------------------------------------------------------- 1 | // Subtract rational numbers 2 | // 3 | // Input: tos-2 minuend 4 | // 5 | // tos-1 subtrahend 6 | // 7 | // Output: difference on stack 8 | 9 | #include "stdafx.h" 10 | #include "defs.h" 11 | 12 | void 13 | qsub(void) 14 | { 15 | unsigned int *a, *ab, *b, *ba, *c; 16 | 17 | save(); 18 | 19 | p2 = pop(); 20 | p1 = pop(); 21 | 22 | ab = mmul(p1->u.q.a, p2->u.q.b); 23 | ba = mmul(p1->u.q.b, p2->u.q.a); 24 | 25 | a = msub(ab, ba); 26 | 27 | mfree(ab); 28 | mfree(ba); 29 | 30 | // zero? 31 | 32 | if (MZERO(a)) { 33 | mfree(a); 34 | push(zero); 35 | restore(); 36 | return; 37 | } 38 | 39 | b = mmul(p1->u.q.b, p2->u.q.b); 40 | 41 | c = mgcd(a, b); 42 | 43 | MSIGN(c) = MSIGN(b); 44 | 45 | p1 = alloc(); 46 | 47 | p1->k = NUM; 48 | 49 | p1->u.q.a = mdiv(a, c); 50 | p1->u.q.b = mdiv(b, c); 51 | 52 | mfree(a); 53 | mfree(b); 54 | mfree(c); 55 | 56 | push(p1); 57 | 58 | restore(); 59 | } 60 | -------------------------------------------------------------------------------- /src/quickfactor.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Factor small numerical powers 4 | // 5 | // Input: tos-2 Base (positive integer < 2^31 - 1) 6 | // 7 | // tos-1 Exponent 8 | // 9 | // Output: Expr on stack 10 | // 11 | //----------------------------------------------------------------------------- 12 | 13 | #include "stdafx.h" 14 | #include "defs.h" 15 | 16 | #define BASE p1 17 | #define EXPO p2 18 | 19 | static void quickpower(void); 20 | 21 | void 22 | quickfactor(void) 23 | { 24 | int h, i, n; 25 | U **s; 26 | 27 | save(); 28 | 29 | EXPO = pop(); 30 | BASE = pop(); 31 | 32 | h = tos; 33 | 34 | push(BASE); 35 | 36 | factor_small_number(); 37 | 38 | n = tos - h; 39 | 40 | s = stack + h; 41 | 42 | for (i = 0; i < n; i += 2) { 43 | push(s[i]); // factored base 44 | push(s[i + 1]); // factored exponent 45 | push(EXPO); 46 | multiply(); 47 | quickpower(); 48 | } 49 | 50 | // stack has n results from factor_number_raw() 51 | 52 | // on top of that are all the expressions from quickpower() 53 | 54 | // multiply the quickpower() results 55 | 56 | multiply_all(tos - h - n); 57 | 58 | p1 = pop(); 59 | 60 | tos = h; 61 | 62 | push(p1); 63 | 64 | restore(); 65 | } 66 | 67 | // BASE is a prime number so power is simpler 68 | 69 | static void 70 | quickpower(void) 71 | { 72 | int expo; 73 | 74 | save(); 75 | 76 | EXPO = pop(); 77 | BASE = pop(); 78 | 79 | push(EXPO); 80 | bignum_truncate(); 81 | p3 = pop(); 82 | 83 | push(EXPO); 84 | push(p3); 85 | subtract(); 86 | p4 = pop(); 87 | 88 | // fractional part of EXPO 89 | 90 | if (!iszero(p4)) { 91 | push_symbol(POWER); 92 | push(BASE); 93 | push(p4); 94 | list(3); 95 | } 96 | 97 | push(p3); 98 | expo = pop_integer(); 99 | 100 | if (expo == (int) 0x80000000) { 101 | push_symbol(POWER); 102 | push(BASE); 103 | push(p3); 104 | list(3); 105 | restore(); 106 | return; 107 | } 108 | 109 | if (expo == 0) { 110 | restore(); 111 | return; 112 | } 113 | 114 | push(BASE); 115 | bignum_power_number(expo); 116 | 117 | restore(); 118 | } 119 | 120 | #if SELFTEST 121 | 122 | void 123 | test_quickfactor(void) 124 | { 125 | int base, expo, i, j, h; 126 | logout("testing quickfactor\n"); 127 | for (i = 2; i < 10001; i++) { 128 | base = i; 129 | push_integer(base); 130 | push_integer(1); 131 | quickfactor(); 132 | h = tos; 133 | j = 0; 134 | while (base > 1) { 135 | expo = 0; 136 | while (base % primetab[j] == 0) { 137 | base /= primetab[j]; 138 | expo++; 139 | } 140 | if (expo) { 141 | push_integer(primetab[j]); 142 | push_integer(expo); 143 | quickpower(); 144 | } 145 | j++; 146 | } 147 | multiply_all(tos - h); 148 | p2 = pop(); 149 | p1 = pop(); 150 | if (!equal(p1, p2)) { 151 | logout("failed\n"); 152 | print_lisp(p1); 153 | print_lisp(p2); 154 | errout(); 155 | } 156 | } 157 | logout("ok\n"); 158 | } 159 | 160 | #endif 161 | -------------------------------------------------------------------------------- /src/quotient.cpp: -------------------------------------------------------------------------------- 1 | // Divide polynomials 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_quotient(void) 8 | { 9 | push(cadr(p1)); // 1st arg, p(x) 10 | eval(); 11 | 12 | push(caddr(p1)); // 2nd arg, q(x) 13 | eval(); 14 | 15 | push(cadddr(p1)); // 3rd arg, x 16 | eval(); 17 | 18 | p1 = pop(); // default x 19 | if (p1 == symbol(NIL)) 20 | p1 = symbol(SYMBOL_X); 21 | push(p1); 22 | 23 | divpoly(); 24 | } 25 | 26 | //----------------------------------------------------------------------------- 27 | // 28 | // Divide polynomials 29 | // 30 | // Input: tos-3 Dividend 31 | // 32 | // tos-2 Divisor 33 | // 34 | // tos-1 x 35 | // 36 | // Output: tos-1 Quotient 37 | // 38 | //----------------------------------------------------------------------------- 39 | 40 | #define DIVIDEND p1 41 | #define DIVISOR p2 42 | #define X p3 43 | #define Q p4 44 | #define QUOTIENT p5 45 | 46 | void 47 | divpoly(void) 48 | { 49 | int h, i, m, n, x; 50 | U **dividend, **divisor; 51 | 52 | save(); 53 | 54 | X = pop(); 55 | DIVISOR = pop(); 56 | DIVIDEND = pop(); 57 | 58 | h = tos; 59 | 60 | dividend = stack + tos; 61 | 62 | push(DIVIDEND); 63 | push(X); 64 | m = coeff() - 1; // m is dividend's power 65 | 66 | divisor = stack + tos; 67 | 68 | push(DIVISOR); 69 | push(X); 70 | n = coeff() - 1; // n is divisor's power 71 | 72 | x = m - n; 73 | 74 | push_integer(0); 75 | QUOTIENT = pop(); 76 | 77 | while (x >= 0) { 78 | 79 | push(dividend[m]); 80 | push(divisor[n]); 81 | divide(); 82 | Q = pop(); 83 | 84 | for (i = 0; i <= n; i++) { 85 | push(dividend[x + i]); 86 | push(divisor[i]); 87 | push(Q); 88 | multiply(); 89 | subtract(); 90 | dividend[x + i] = pop(); 91 | } 92 | 93 | push(QUOTIENT); 94 | push(Q); 95 | push(X); 96 | push_integer(x); 97 | power(); 98 | multiply(); 99 | add(); 100 | QUOTIENT = pop(); 101 | 102 | m--; 103 | x--; 104 | } 105 | 106 | tos = h; 107 | 108 | push(QUOTIENT); 109 | 110 | restore(); 111 | } 112 | 113 | #if SELFTEST 114 | 115 | static char *s[] = { 116 | 117 | "quotient(x^2+1,x+1)-x+1", 118 | "0", 119 | 120 | "quotient(a*x^2+b*x+c,d*x+e)-(-a*e/(d^2)+a*x/d+b/d)", 121 | "0", 122 | }; 123 | 124 | void 125 | test_quotient(void) 126 | { 127 | test(__FILE__, s, sizeof s / sizeof (char *)); 128 | } 129 | 130 | #endif 131 | -------------------------------------------------------------------------------- /src/random.cpp: -------------------------------------------------------------------------------- 1 | // function for returning random numbers. added by gbl08ma 2 | #include "stdafx.h" 3 | #include "defs.h" 4 | 5 | void 6 | eval_random(void) 7 | { 8 | randomnum(); 9 | } 10 | 11 | static int rnd_seed; 12 | 13 | void set_rnd_seed(int new_seed) 14 | { 15 | rnd_seed = new_seed; 16 | } 17 | 18 | int rand_int(void) 19 | { 20 | int k1; 21 | int ix = rnd_seed; 22 | 23 | k1 = ix / 127773; 24 | ix = 16807 * (ix - k1 * 127773) - k1 * 2836; 25 | if (ix < 0) 26 | ix += 2147483647; 27 | rnd_seed = ix; 28 | return rnd_seed; 29 | } 30 | 31 | void randomnum(void) 32 | { 33 | save(); 34 | 35 | push_integer(rand_int()); 36 | 37 | restore(); 38 | } -------------------------------------------------------------------------------- /src/real.cpp: -------------------------------------------------------------------------------- 1 | /* Returns the real part of complex z 2 | 3 | z real(z) 4 | - ------- 5 | 6 | a + i b a 7 | 8 | exp(i a) cos(a) 9 | */ 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | 14 | void 15 | eval_real(void) 16 | { 17 | push(cadr(p1)); 18 | eval(); 19 | real(); 20 | } 21 | 22 | void 23 | real(void) 24 | { 25 | save(); 26 | rect(); 27 | p1 = pop(); 28 | push(p1); 29 | push(p1); 30 | conjugate(); 31 | add(); 32 | push_integer(2); 33 | divide(); 34 | restore(); 35 | } 36 | 37 | #if SELFTEST 38 | 39 | static char *s[] = { 40 | 41 | "real(a+i*b)", 42 | "a", 43 | 44 | "real(1+exp(i*pi/3))", 45 | "3/2", 46 | 47 | "real(i)", 48 | "0", 49 | 50 | "real((-1)^(1/3))", 51 | "1/2", 52 | }; 53 | 54 | void 55 | test_real(void) 56 | { 57 | test(__FILE__, s, sizeof s / sizeof (char *)); 58 | } 59 | 60 | #endif 61 | -------------------------------------------------------------------------------- /src/rect.cpp: -------------------------------------------------------------------------------- 1 | /* Convert complex z to rectangular form 2 | 3 | Input: push z 4 | 5 | Output: Result on stack 6 | */ 7 | 8 | #include "stdafx.h" 9 | #include "defs.h" 10 | 11 | void 12 | eval_rect(void) 13 | { 14 | push(cadr(p1)); 15 | eval(); 16 | rect(); 17 | } 18 | 19 | void 20 | rect(void) 21 | { 22 | save(); 23 | p1 = pop(); 24 | if (car(p1) == symbol(ADD)) { 25 | push_integer(0); 26 | p1 = cdr(p1); 27 | while (iscons(p1)) { 28 | push(car(p1)); 29 | rect(); 30 | add(); 31 | p1 = cdr(p1); 32 | } 33 | } else { 34 | push(p1); // mag(z) * (cos(arg(z)) + i sin(arg(z))) 35 | mag(); 36 | push(p1); 37 | arg(); 38 | p1 = pop(); 39 | push(p1); 40 | cosine(); 41 | push(imaginaryunit); 42 | push(p1); 43 | sine(); 44 | multiply(); 45 | add(); 46 | multiply(); 47 | } 48 | restore(); 49 | } 50 | 51 | #if SELFTEST 52 | 53 | static char *s[] = { 54 | 55 | "rect(a+i*b)", 56 | "a+i*b", 57 | 58 | "rect(exp(a+i*b))", 59 | "i*exp(a)*sin(b)+exp(a)*cos(b)", 60 | 61 | "rect(1+exp(i*pi/3))", 62 | "3/2+1/2*i*3^(1/2)", 63 | 64 | "z=(a+b*i)/(c+d*i)", 65 | "", 66 | 67 | "rect(z)-real(z)-i*imag(z)", 68 | "0", 69 | 70 | "z=quote(z)", 71 | "", 72 | }; 73 | 74 | void 75 | test_rect(void) 76 | { 77 | test(__FILE__, s, sizeof s / sizeof (char *)); 78 | } 79 | 80 | #endif 81 | -------------------------------------------------------------------------------- /src/rewrite.cpp: -------------------------------------------------------------------------------- 1 | // Rewrite by expanding all symbols 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | rewrite(void) 8 | { 9 | int h; 10 | save(); 11 | 12 | p1 = pop(); 13 | 14 | if (istensor(p1)) { 15 | rewrite_tensor(); 16 | restore(); 17 | return; 18 | } 19 | 20 | if (iscons(p1)) { 21 | h = tos; 22 | push(car(p1)); // Do not rewrite function name 23 | p1 = cdr(p1); 24 | while (iscons(p1)) { 25 | push(car(p1)); 26 | rewrite(); 27 | p1 = cdr(p1); 28 | } 29 | list(tos - h); 30 | restore(); 31 | return; 32 | } 33 | 34 | // If not a symbol then done 35 | 36 | if (!issymbol(p1)) { 37 | push(p1); 38 | restore(); 39 | return; 40 | } 41 | 42 | // Get the symbol's binding, try again 43 | 44 | p2 = get_binding(p1); 45 | push(p2); 46 | if (p1 != p2) 47 | rewrite(); 48 | 49 | restore(); 50 | } 51 | 52 | void 53 | rewrite_tensor(void) 54 | { 55 | int i; 56 | push(p1); 57 | copy_tensor(); 58 | p1 = pop(); 59 | for (i = 0; i < p1->u.tensor->nelem; i++) { 60 | push(p1->u.tensor->elem[i]); 61 | rewrite(); 62 | p1->u.tensor->elem[i] = pop(); 63 | } 64 | push(p1); 65 | } 66 | -------------------------------------------------------------------------------- /src/run.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | jmp_buf stop_return, draw_stop_return; 5 | 6 | void 7 | stop(char *s) 8 | { 9 | if (draw_flag == 2) 10 | longjmp(draw_stop_return, 1); 11 | else { 12 | printstr("Stop: "); 13 | printstr(s); 14 | printstr("\n"); 15 | longjmp(stop_return, 1); 16 | } 17 | } 18 | 19 | void 20 | run(char *s) 21 | { 22 | int i, n; 23 | 24 | /*if (strncmp(s, "selftest", 8) == 0) { 25 | selftest(); 26 | return; 27 | }*/ 28 | 29 | if (setjmp(stop_return)) 30 | return; 31 | 32 | init(); 33 | 34 | while (1) { 35 | 36 | n = scan(s); 37 | 38 | p1 = pop(); 39 | check_stack(); 40 | 41 | if (n == 0) 42 | break; 43 | 44 | // if debug mode then print the source text 45 | 46 | if (equaln(get_binding(symbol(TRACE)), 1)) { 47 | for (i = 0; i < n; i++) 48 | if (s[i] != '\r') 49 | printchar(s[i]); 50 | if (s[n - 1] != '\n') // n is not zero, see above 51 | printchar('\n'); 52 | } 53 | 54 | s += n; 55 | 56 | push(p1); 57 | top_level_eval(); 58 | 59 | p2 = pop(); 60 | check_stack(); 61 | 62 | if (p2 == symbol(NIL)) 63 | continue; 64 | 65 | // print string w/o quotes 66 | 67 | if (isstr(p2)) { 68 | printstr(p2->u.str); 69 | printstr("\n"); 70 | continue; 71 | } 72 | 73 | if (equaln(get_binding(symbol(TTY)), 1) || test_flag) // tty mode? 74 | printline(p2); 75 | else { 76 | //#ifdef LINUX 77 | display(p2); 78 | /*#else 79 | push(p2); 80 | cmdisplay(); 81 | #endif*/ 82 | } 83 | } 84 | } 85 | 86 | void 87 | check_stack(void) 88 | { 89 | if (tos != 0) 90 | stop("stack error"); 91 | if (frame != stack + TOS) 92 | stop("frame error"); 93 | } 94 | 95 | // cannot reference symbols yet 96 | 97 | void 98 | echo_input(char *s) 99 | { 100 | printstr(s); 101 | printstr("\n"); 102 | } 103 | 104 | // returns nil on stack if no result to print 105 | 106 | void 107 | top_level_eval(void) 108 | { 109 | save(); 110 | 111 | trigmode = 0; 112 | 113 | p1 = symbol(AUTOEXPAND); 114 | 115 | if (iszero(get_binding(p1))) 116 | expanding = 0; 117 | else 118 | expanding = 1; 119 | 120 | p1 = pop(); 121 | push(p1); 122 | eval(); 123 | p2 = pop(); 124 | 125 | // "draw", "for" and "setq" return "nil", there is no result to print 126 | 127 | if (p2 == symbol(NIL)) { 128 | push(p2); 129 | restore(); 130 | return; 131 | } 132 | 133 | // update "last" 134 | 135 | set_binding(symbol(LAST), p2); 136 | 137 | if (!iszero(get_binding(symbol(BAKE)))) { 138 | push(p2); 139 | bake(); 140 | p2 = pop(); 141 | } 142 | 143 | // If we evaluated the symbol "i" or "j" and the result was sqrt(-1) 144 | 145 | // then don't do anything. 146 | 147 | // Otherwise if "j" is an imaginary unit then subst. 148 | 149 | // Otherwise if "i" is an imaginary unit then subst. 150 | 151 | if ((p1 == symbol(SYMBOL_I) || p1 == symbol(SYMBOL_J)) 152 | && isimaginaryunit(p2)) 153 | ; 154 | else if (isimaginaryunit(get_binding(symbol(SYMBOL_J)))) { 155 | push(p2); 156 | push(imaginaryunit); 157 | push_symbol(SYMBOL_J); 158 | subst(); 159 | p2 = pop(); 160 | } else if (isimaginaryunit(get_binding(symbol(SYMBOL_I)))) { 161 | push(p2); 162 | push(imaginaryunit); 163 | push_symbol(SYMBOL_I); 164 | subst(); 165 | p2 = pop(); 166 | } 167 | 168 | #ifndef LINUX 169 | 170 | // if we evaluated the symbol "a" and got "b" then print "a=b" 171 | 172 | // do not print "a=a" 173 | 174 | if (issymbol(p1) && !iskeyword(p1) && p1 != p2 && test_flag == 0) { 175 | push_symbol(SETQ); 176 | push(p1); 177 | push(p2); 178 | list(3); 179 | p2 = pop(); 180 | } 181 | #endif 182 | push(p2); 183 | 184 | restore(); 185 | } 186 | 187 | void 188 | check_esc_flag(void) 189 | { 190 | if (esc_flag) 191 | stop("esc key"); 192 | } 193 | -------------------------------------------------------------------------------- /src/setjmp.h: -------------------------------------------------------------------------------- 1 | /*------------------------------------------------------*/ 2 | /* SH SERIES C Compiler Ver. 1.0 */ 3 | /* Copyright (c) 1992 Hitachi,Ltd. */ 4 | /* Licensed material of Hitachi,Ltd. */ 5 | /*------------------------------------------------------*/ 6 | /***********************************************************************/ 7 | /* SPEC; */ 8 | /* NAME = setjmp.h : ; */ 9 | /* */ 10 | /* FUNC = this module do the following functions ; */ 11 | /* */ 12 | /* CLAS = UNIT; */ 13 | /* */ 14 | /* END; */ 15 | /***********************************************************************/ 16 | #ifndef _SETJMP 17 | #define _SETJMP 18 | 19 | typedef int jmp_buf[38]; 20 | typedef int jmp_buf_a[54]; 21 | 22 | #ifdef __cplusplus 23 | extern "C" { 24 | #endif 25 | extern int setjmp(jmp_buf); 26 | extern void longjmp(jmp_buf, int); 27 | extern int setjmp_a(jmp_buf); 28 | extern void longjmp_a(jmp_buf, int); 29 | 30 | extern volatile int _errno; 31 | 32 | #ifdef __cplusplus 33 | } 34 | #endif 35 | 36 | #ifndef SEQERR 37 | #define SEQERR 1108 38 | #endif 39 | 40 | #endif 41 | -------------------------------------------------------------------------------- /src/sgn.cpp: -------------------------------------------------------------------------------- 1 | #include "defs.h" 2 | 3 | void 4 | eval_sgn(void) 5 | { 6 | push(cadr(p1)); 7 | eval(); 8 | sgn(); 9 | } 10 | 11 | void 12 | sgn(void) 13 | { 14 | save(); 15 | 16 | p1 = pop(); 17 | 18 | if (!isnum(p1)) { 19 | push_symbol(SGN); 20 | push(p1); 21 | list(2); 22 | } else if (iszero(p1)) 23 | push_integer(0); 24 | else if (isnegativenumber(p1)) 25 | push_integer(-1); 26 | else 27 | push_integer(1); 28 | 29 | restore(); 30 | } 31 | -------------------------------------------------------------------------------- /src/sinh.cpp: -------------------------------------------------------------------------------- 1 | // exp(x) - exp(-x) 2 | // sinh(x) = ---------------- 3 | // 2 4 | 5 | #include "stdafx.h" 6 | #include "defs.h" 7 | 8 | void 9 | eval_sinh(void) 10 | { 11 | push(cadr(p1)); 12 | eval(); 13 | ysinh(); 14 | } 15 | 16 | void 17 | ysinh(void) 18 | { 19 | save(); 20 | yysinh(); 21 | restore(); 22 | } 23 | 24 | void 25 | yysinh(void) 26 | { 27 | double d; 28 | p1 = pop(); 29 | if (car(p1) == symbol(ARCSINH)) { 30 | push(cadr(p1)); 31 | return; 32 | } 33 | if (isdouble(p1)) { 34 | d = sinh(p1->u.d); 35 | if (fabs(d) < 1e-10) 36 | d = 0.0; 37 | push_double(d); 38 | return; 39 | } 40 | if (iszero(p1)) { 41 | push(zero); 42 | return; 43 | } 44 | push_symbol(SINH); 45 | push(p1); 46 | list(2); 47 | } 48 | 49 | #if SELFTEST 50 | 51 | static char *s[] = { 52 | 53 | "sinh(x)", 54 | "sinh(x)", 55 | 56 | "sinh(0)", 57 | "0", 58 | 59 | "sinh(arcsinh(x))", 60 | "x", 61 | }; 62 | 63 | void 64 | test_sinh(void) 65 | { 66 | test(__FILE__, s, sizeof s / sizeof (char *)); 67 | } 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /src/stack.cpp: -------------------------------------------------------------------------------- 1 | // _______ 2 | // | | <- stack 3 | // | | 4 | // |_______| 5 | // | | <- stack + tos 6 | // | | 7 | // | | 8 | // |_______| 9 | // | | <- frame 10 | // |_______| 11 | // <- stack + TOS 12 | // 13 | // The stack grows from low memory towards high memory. This is so that 14 | // multiple expressions can be pushed on the stack and then accessed as an 15 | // array. 16 | // 17 | // The frame area holds local variables and grows from high memory towards 18 | // low memory. The frame area makes local variables visible to the garbage 19 | // collector. 20 | 21 | #include "stdafx.h" 22 | #include "defs.h" 23 | 24 | U **frame, *stack[TOS]; 25 | int tos; 26 | 27 | void 28 | push(U *p) 29 | { 30 | if (stack + tos >= frame) 31 | stop("stack overflow"); 32 | stack[tos++] = p; 33 | } 34 | 35 | U * 36 | pop() 37 | { 38 | if (tos == 0) 39 | stop("stack underflow"); 40 | return stack[--tos]; 41 | } 42 | 43 | void 44 | push_frame(int n) 45 | { 46 | int i; 47 | frame -= n; 48 | if (frame < stack + tos) 49 | stop("frame overflow, circular reference?"); 50 | for (i = 0; i < n; i++) 51 | frame[i] = symbol(NIL); 52 | } 53 | 54 | void 55 | pop_frame(int n) 56 | { 57 | frame += n; 58 | if (frame > stack + TOS) 59 | stop("frame underflow"); 60 | } 61 | 62 | void 63 | save(void) 64 | { 65 | frame -= 10; 66 | if (frame < stack + tos) 67 | stop("frame overflow, circular reference?"); 68 | frame[0] = p0; 69 | frame[1] = p1; 70 | frame[2] = p2; 71 | frame[3] = p3; 72 | frame[4] = p4; 73 | frame[5] = p5; 74 | frame[6] = p6; 75 | frame[7] = p7; 76 | frame[8] = p8; 77 | frame[9] = p9; 78 | } 79 | 80 | void 81 | restore(void) 82 | { 83 | if (frame > stack + TOS - 10) 84 | stop("frame underflow"); 85 | p0 = frame[0]; 86 | p1 = frame[1]; 87 | p2 = frame[2]; 88 | p3 = frame[3]; 89 | p4 = frame[4]; 90 | p5 = frame[5]; 91 | p6 = frame[6]; 92 | p7 = frame[7]; 93 | p8 = frame[8]; 94 | p9 = frame[9]; 95 | frame += 10; 96 | } 97 | 98 | // Local U * is OK here because there is no functional path to the garbage collector. 99 | 100 | void 101 | swap(void) 102 | { 103 | U *p, *q; 104 | p = pop(); 105 | q = pop(); 106 | push(p); 107 | push(q); 108 | } 109 | 110 | // Local U * is OK here because there is no functional path to the garbage collector. 111 | 112 | void 113 | dupl(void) 114 | { 115 | U *p; 116 | p = pop(); 117 | push(p); 118 | push(p); 119 | } 120 | -------------------------------------------------------------------------------- /src/stdafx.h: -------------------------------------------------------------------------------- 1 | // Required by VC++. 2 | -------------------------------------------------------------------------------- /src/stringsProvider.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __STRINGSPROVIDER_H 2 | #define __STRINGSPROVIDER_H 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | 18 | 19 | char tolower(char c); 20 | char toupper(char c); 21 | int strncasecmp(const char *s1, const char *s2, size_t n); 22 | char *strcasestr(const char *s, const char *find); 23 | unsigned char *toksplit(unsigned char *src, char tokchar, unsigned char *token, int lgh); 24 | int EndsIWith(const char *str, const char *suffix); 25 | void* memmem(char* haystack, int hlen, char* needle, int nlen, int matchCase=1); 26 | void stringToMini(char* dest, char* orig); 27 | 28 | #endif -------------------------------------------------------------------------------- /src/subst.cpp: -------------------------------------------------------------------------------- 1 | /* Substitute new expr for old expr in expr. 2 | 3 | Input: push expr 4 | 5 | push old expr 6 | 7 | push new expr 8 | 9 | Output: Result on stack 10 | */ 11 | 12 | #include "stdafx.h" 13 | #include "defs.h" 14 | 15 | void 16 | subst(void) 17 | { 18 | int i; 19 | save(); 20 | p3 = pop(); // new expr 21 | p2 = pop(); // old expr 22 | if (p2 == symbol(NIL) || p3 == symbol(NIL)) { 23 | restore(); 24 | return; 25 | } 26 | p1 = pop(); // expr 27 | if (istensor(p1)) { 28 | p4 = alloc_tensor(p1->u.tensor->nelem); 29 | p4->u.tensor->ndim = p1->u.tensor->ndim; 30 | for (i = 0; i < p1->u.tensor->ndim; i++) 31 | p4->u.tensor->dim[i] = p1->u.tensor->dim[i]; 32 | for (i = 0; i < p1->u.tensor->nelem; i++) { 33 | push(p1->u.tensor->elem[i]); 34 | push(p2); 35 | push(p3); 36 | subst(); 37 | p4->u.tensor->elem[i] = pop(); 38 | } 39 | push(p4); 40 | } else if (equal(p1, p2)) 41 | push(p3); 42 | else if (iscons(p1)) { 43 | push(car(p1)); 44 | push(p2); 45 | push(p3); 46 | subst(); 47 | push(cdr(p1)); 48 | push(p2); 49 | push(p3); 50 | subst(); 51 | cons(); 52 | } else 53 | push(p1); 54 | restore(); 55 | } 56 | -------------------------------------------------------------------------------- /src/sum.cpp: -------------------------------------------------------------------------------- 1 | // 'sum' function 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define A p3 7 | #define B p4 8 | #define I p5 9 | #define X p6 10 | 11 | void 12 | eval_sum(void) 13 | { 14 | int i, j, k; 15 | 16 | // 1st arg (quoted) 17 | 18 | X = cadr(p1); 19 | if (!issymbol(X)) 20 | stop("sum: 1st arg?"); 21 | 22 | // 2nd arg 23 | 24 | push(caddr(p1)); 25 | eval(); 26 | j = pop_integer(); 27 | if (j == (int) 0x80000000) 28 | stop("sum: 2nd arg?"); 29 | 30 | // 3rd arg 31 | 32 | push(cadddr(p1)); 33 | eval(); 34 | k = pop_integer(); 35 | if (k == (int) 0x80000000) 36 | stop("sum: 3rd arg?"); 37 | 38 | // 4th arg 39 | 40 | p1 = caddddr(p1); 41 | 42 | B = get_binding(X); 43 | A = get_arglist(X); 44 | 45 | push_integer(0); 46 | 47 | for (i = j; i <= k; i++) { 48 | push_integer(i); 49 | I = pop(); 50 | set_binding(X, I); 51 | push(p1); 52 | eval(); 53 | add(); 54 | } 55 | 56 | set_binding_and_arglist(X, B, A); 57 | } 58 | -------------------------------------------------------------------------------- /src/symbol.cpp: -------------------------------------------------------------------------------- 1 | // The symbol table is a simple array of struct U. 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | // put symbol at index n 7 | 8 | void 9 | std_symbol(char *s, int n) 10 | { 11 | U *p; 12 | p = symtab + n; 13 | p->u.printname = s; 14 | } 15 | 16 | // symbol lookup, create symbol if need be 17 | 18 | U * 19 | usr_symbol(char *s) 20 | { 21 | int i; 22 | U *p; 23 | for (i = 0; i < NSYM; i++) { 24 | if (symtab[i].u.printname == 0) 25 | break; 26 | if (strcmp(s, symtab[i].u.printname) == 0) 27 | return symtab + i; 28 | } 29 | if (i == NSYM) 30 | stop("symbol table overflow"); 31 | p = symtab + i; 32 | p->u.printname = strdup(s); 33 | return p; 34 | } 35 | 36 | // get the symbol's printname 37 | 38 | char * 39 | get_printname(U *p) 40 | { 41 | if (p->k != SYM) 42 | stop("symbol error"); 43 | return p->u.printname; 44 | } 45 | 46 | // clears the arglist too 47 | 48 | void 49 | set_binding(U *p, U *q) 50 | { 51 | if (p->k != SYM) 52 | stop("symbol error"); 53 | binding[p - symtab] = q; 54 | arglist[p - symtab] = symbol(NIL); 55 | } 56 | 57 | U * 58 | get_binding(U *p) 59 | { 60 | if (p->k != SYM) 61 | stop("symbol error"); 62 | return binding[p - symtab]; 63 | } 64 | 65 | void 66 | set_binding_and_arglist(U *p, U *q, U *r) 67 | { 68 | if (p->k != SYM) 69 | stop("symbol error"); 70 | binding[p - symtab] = q; 71 | arglist[p - symtab] = r; 72 | } 73 | 74 | U * 75 | get_arglist(U *p) 76 | { 77 | if (p->k != SYM) 78 | stop("symbol error"); 79 | return arglist[p - symtab]; 80 | } 81 | 82 | // get symbol's number from ptr 83 | 84 | int 85 | symnum(U *p) 86 | { 87 | if (p->k != SYM) 88 | stop("symbol error"); 89 | return (int) (p - symtab); 90 | } 91 | 92 | // push indexed symbol 93 | 94 | void 95 | push_symbol(int k) 96 | { 97 | push(symtab + k); 98 | } 99 | 100 | void 101 | clear_symbols(void) 102 | { 103 | int i; 104 | for (i = 0; i < NSYM; i++) { 105 | binding[i] = symtab + i; 106 | arglist[i] = symbol(NIL); 107 | } 108 | } 109 | -------------------------------------------------------------------------------- /src/tanh.cpp: -------------------------------------------------------------------------------- 1 | // exp(2 x) - 1 2 | // tanh(x) = -------------- 3 | // exp(2 x) + 1 4 | 5 | #include "stdafx.h" 6 | #include "defs.h" 7 | 8 | void 9 | eval_tanh(void) 10 | { 11 | double d; 12 | push(cadr(p1)); 13 | eval(); 14 | p1 = pop(); 15 | if (car(p1) == symbol(ARCTANH)) { 16 | push(cadr(p1)); 17 | return; 18 | } 19 | if (isdouble(p1)) { 20 | d = tanh(p1->u.d); 21 | if (fabs(d) < 1e-10) 22 | d = 0.0; 23 | push_double(d); 24 | return; 25 | } 26 | if (iszero(p1)) { 27 | push(zero); 28 | return; 29 | } 30 | push_symbol(TANH); 31 | push(p1); 32 | list(2); 33 | } 34 | 35 | #if SELFTEST 36 | 37 | static char *s[] = { 38 | 39 | "tanh(x)", 40 | "tanh(x)", 41 | 42 | "tanh(0)", 43 | "0", 44 | 45 | "tanh(arctanh(x))", 46 | "x", 47 | }; 48 | 49 | void 50 | test_tanh(void) 51 | { 52 | test(__FILE__, s, sizeof s / sizeof (char *)); 53 | } 54 | 55 | #endif 56 | -------------------------------------------------------------------------------- /src/taylor.cpp: -------------------------------------------------------------------------------- 1 | /* Taylor expansion of a function 2 | 3 | push(F) 4 | push(X) 5 | push(N) 6 | push(A) 7 | taylor() 8 | */ 9 | 10 | #include "stdafx.h" 11 | #include "defs.h" 12 | 13 | void 14 | eval_taylor(void) 15 | { 16 | // 1st arg 17 | 18 | p1 = cdr(p1); 19 | push(car(p1)); 20 | eval(); 21 | 22 | // 2nd arg 23 | 24 | p1 = cdr(p1); 25 | push(car(p1)); 26 | eval(); 27 | p2 = pop(); 28 | if (p2 == symbol(NIL)) 29 | guess(); 30 | else 31 | push(p2); 32 | 33 | // 3rd arg 34 | 35 | p1 = cdr(p1); 36 | push(car(p1)); 37 | eval(); 38 | p2 = pop(); 39 | if (p2 == symbol(NIL)) 40 | push_integer(24); // default number of terms 41 | else 42 | push(p2); 43 | 44 | // 4th arg 45 | 46 | p1 = cdr(p1); 47 | push(car(p1)); 48 | eval(); 49 | p2 = pop(); 50 | if (p2 == symbol(NIL)) 51 | push_integer(0); // default expansion point 52 | else 53 | push(p2); 54 | 55 | taylor(); 56 | } 57 | 58 | #define F p1 59 | #define X p2 60 | #define N p3 61 | #define A p4 62 | #define C p5 63 | 64 | void 65 | taylor(void) 66 | { 67 | int i, k; 68 | 69 | save(); 70 | 71 | A = pop(); 72 | N = pop(); 73 | X = pop(); 74 | F = pop(); 75 | 76 | push(N); 77 | k = pop_integer(); 78 | if (k == (int) 0x80000000) { 79 | push_symbol(TAYLOR); 80 | push(F); 81 | push(X); 82 | push(N); 83 | push(A); 84 | list(5); 85 | restore(); 86 | return; 87 | } 88 | 89 | push(F); // f(a) 90 | push(X); 91 | push(A); 92 | subst(); 93 | eval(); 94 | 95 | push_integer(1); 96 | C = pop(); 97 | 98 | for (i = 1; i <= k; i++) { 99 | 100 | push(F); // f = f' 101 | push(X); 102 | derivative(); 103 | F = pop(); 104 | 105 | if (iszero(F)) 106 | break; 107 | 108 | push(C); // c = c * (x - a) 109 | push(X); 110 | push(A); 111 | subtract(); 112 | multiply(); 113 | C = pop(); 114 | 115 | push(F); // f(a) 116 | push(X); 117 | push(A); 118 | subst(); 119 | eval(); 120 | 121 | push(C); 122 | multiply(); 123 | push_integer(i); 124 | factorial(); 125 | divide(); 126 | 127 | add(); 128 | } 129 | 130 | restore(); 131 | } 132 | 133 | #if SELFTEST 134 | 135 | static char *s[] = { 136 | 137 | "taylor(1/(5+4*cos(x)),x,6,0)-(1/9+2/81*x^2+5/1458*x^4+49/131220*x^6)", 138 | "0", 139 | 140 | "taylor(1/(5+4*cos(x)),x,6)-(1/9+2/81*x^2+5/1458*x^4+49/131220*x^6)", 141 | "0", 142 | }; 143 | 144 | void 145 | test_taylor(void) 146 | { 147 | test(__FILE__, s, sizeof s / sizeof (char *)); 148 | } 149 | 150 | #endif 151 | -------------------------------------------------------------------------------- /src/textGUI.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __TEXTGUI_H 2 | #define __TEXTGUI_H 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | 17 | typedef struct 18 | { 19 | char* text; 20 | int newLine=0; // if 1, new line will be drawn before the text 21 | color_t color=COLOR_BLACK; 22 | int spaceAtEnd=0; 23 | int lineSpacing=0; 24 | int minimini=0; 25 | } textElement; 26 | 27 | #define TEXTAREATYPE_NORMAL 0 28 | #define TEXTAREATYPE_INSTANT_RETURN 1 29 | typedef struct 30 | { 31 | int x=0; 32 | int y=0; 33 | int width=LCD_WIDTH_PX; 34 | int lineHeight=17; 35 | textElement* elements; 36 | int numelements; 37 | char* title = NULL; 38 | int scrollbar=1; 39 | int allowEXE=0; //whether to allow EXE to exit the screen 40 | int allowF1=0; //whether to allow F1 to exit the screen 41 | int type=TEXTAREATYPE_NORMAL; 42 | } textArea; 43 | 44 | #define TEXTAREA_RETURN_EXIT 0 45 | #define TEXTAREA_RETURN_EXE 1 46 | #define TEXTAREA_RETURN_F1 2 47 | int doTextArea(textArea* text); //returns 0 when user EXITs, 1 when allowEXE is true and user presses EXE, 2 when allowF1 is true and user presses F1. 48 | 49 | #endif 50 | -------------------------------------------------------------------------------- /src/transform.cpp: -------------------------------------------------------------------------------- 1 | /* Transform an expression using table look-up 2 | 3 | The expression and free variable are on the stack. 4 | 5 | The argument s is a null terminated list of transform rules. 6 | 7 | For example, see itab.cpp 8 | 9 | Internally, the following symbols are used: 10 | 11 | F input expression 12 | 13 | X free variable, i.e. F of X 14 | 15 | A template expression 16 | 17 | B result expression 18 | 19 | C list of conditional expressions 20 | */ 21 | 22 | #include "stdafx.h" 23 | #include "defs.h" 24 | 25 | // p1 and p2 are tmps 26 | 27 | #define F p3 28 | #define X p4 29 | #define A p5 30 | #define B p6 31 | #define C p7 32 | 33 | void 34 | transform(char **s) 35 | { 36 | int h; 37 | 38 | save(); 39 | 40 | X = pop(); 41 | F = pop(); 42 | 43 | // save symbol context in case eval(B) below calls transform 44 | 45 | push(get_binding(symbol(METAA))); 46 | push(get_binding(symbol(METAB))); 47 | push(get_binding(symbol(METAX))); 48 | 49 | set_binding(symbol(METAX), X); 50 | 51 | // put constants in F(X) on the stack 52 | 53 | h = tos; 54 | push_integer(1); 55 | push(F); 56 | push(X); 57 | polyform(); // collect coefficients of x, x^2, etc. 58 | push(X); 59 | decomp(); 60 | 61 | while (*s) { 62 | 63 | scan_meta(*s); 64 | p1 = pop(); 65 | 66 | A = cadr(p1); 67 | B = caddr(p1); 68 | C = cdddr(p1); 69 | 70 | if (f_equals_a(h)) 71 | break; 72 | 73 | s++; 74 | } 75 | 76 | tos = h; 77 | 78 | if (*s) { 79 | push(B); 80 | eval(); 81 | p1 = pop(); 82 | } else 83 | p1 = symbol(NIL); 84 | 85 | set_binding(symbol(METAX), pop()); 86 | set_binding(symbol(METAB), pop()); 87 | set_binding(symbol(METAA), pop()); 88 | 89 | push(p1); 90 | 91 | restore(); 92 | } 93 | 94 | // search for a METAA and METAB such that F = A 95 | 96 | int 97 | f_equals_a(int h) 98 | { 99 | int i, j; 100 | for (i = h; i < tos; i++) { 101 | set_binding(symbol(METAA), stack[i]); 102 | for (j = h; j < tos; j++) { 103 | set_binding(symbol(METAB), stack[j]); 104 | p1 = C; // are conditions ok? 105 | while (iscons(p1)) { 106 | push(car(p1)); 107 | eval(); 108 | p2 = pop(); 109 | if (iszero(p2)) 110 | break; 111 | p1 = cdr(p1); 112 | } 113 | if (iscons(p1)) // no, try next j 114 | continue; 115 | push(F); // F = A? 116 | push(A); 117 | eval(); 118 | subtract(); 119 | p1 = pop(); 120 | if (iszero(p1)) 121 | return 1; // yes 122 | } 123 | } 124 | return 0; // no 125 | } 126 | -------------------------------------------------------------------------------- /src/transpose.cpp: -------------------------------------------------------------------------------- 1 | // Transpose tensor indices 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | void 7 | eval_transpose(void) 8 | { 9 | push(cadr(p1)); 10 | eval(); 11 | if (cddr(p1) == symbol(NIL)) { 12 | push_integer(1); 13 | push_integer(2); 14 | } else { 15 | push(caddr(p1)); 16 | eval(); 17 | push(cadddr(p1)); 18 | eval(); 19 | } 20 | transpose(); 21 | } 22 | 23 | void 24 | transpose(void) 25 | { 26 | int i, j, k, l, m, ndim, nelem, t; 27 | int ai[MAXDIM], an[MAXDIM]; 28 | U **a, **b; 29 | 30 | save(); 31 | 32 | p3 = pop(); 33 | p2 = pop(); 34 | p1 = pop(); 35 | 36 | if (!istensor(p1)) { 37 | if (!iszero(p1)) 38 | stop("transpose: tensor expected, 1st arg is not a tensor"); 39 | push(zero); 40 | restore(); 41 | return; 42 | } 43 | 44 | ndim = p1->u.tensor->ndim; 45 | nelem = p1->u.tensor->nelem; 46 | 47 | // vector? 48 | 49 | if (ndim == 1) { 50 | push(p1); 51 | restore(); 52 | return; 53 | } 54 | 55 | push(p2); 56 | l = pop_integer(); 57 | 58 | push(p3); 59 | m = pop_integer(); 60 | 61 | if (l < 1 || l > ndim || m < 1 || m > ndim) 62 | stop("transpose: index out of range"); 63 | 64 | l--; 65 | m--; 66 | 67 | p2 = alloc_tensor(nelem); 68 | 69 | p2->u.tensor->ndim = ndim; 70 | 71 | for (i = 0; i < ndim; i++) 72 | p2->u.tensor->dim[i] = p1->u.tensor->dim[i]; 73 | 74 | p2->u.tensor->dim[l] = p1->u.tensor->dim[m]; 75 | p2->u.tensor->dim[m] = p1->u.tensor->dim[l]; 76 | 77 | a = p1->u.tensor->elem; 78 | b = p2->u.tensor->elem; 79 | 80 | // init tensor index 81 | 82 | for (i = 0; i < ndim; i++) { 83 | ai[i] = 0; 84 | an[i] = p1->u.tensor->dim[i]; 85 | } 86 | 87 | // copy components from a to b 88 | 89 | for (i = 0; i < nelem; i++) { 90 | 91 | // swap indices l and m 92 | 93 | t = ai[l]; ai[l] = ai[m]; ai[m] = t; 94 | t = an[l]; an[l] = an[m]; an[m] = t; 95 | 96 | // convert tensor index to linear index k 97 | 98 | k = 0; 99 | for (j = 0; j < ndim; j++) 100 | k = (k * an[j]) + ai[j]; 101 | 102 | // swap indices back 103 | 104 | t = ai[l]; ai[l] = ai[m]; ai[m] = t; 105 | t = an[l]; an[l] = an[m]; an[m] = t; 106 | 107 | // copy one element 108 | 109 | b[k] = a[i]; 110 | 111 | // increment tensor index 112 | 113 | // Suppose the tensor dimensions are 2 and 3. 114 | // Then the tensor index ai increments as follows: 115 | // 00 -> 01 116 | // 01 -> 02 117 | // 02 -> 10 118 | // 10 -> 11 119 | // 11 -> 12 120 | // 12 -> 00 121 | 122 | for (j = ndim - 1; j >= 0; j--) { 123 | if (++ai[j] < an[j]) 124 | break; 125 | ai[j] = 0; 126 | } 127 | } 128 | 129 | push(p2); 130 | restore(); 131 | } 132 | 133 | #if SELFTEST 134 | 135 | static char *s[] = { 136 | 137 | "transpose(0)", 138 | "0", 139 | 140 | "transpose(0.0)", 141 | "0", 142 | 143 | "transpose(((a,b),(c,d)))", 144 | "((a,c),(b,d))", 145 | 146 | "transpose(((a,b),(c,d)),1,2)", 147 | "((a,c),(b,d))", 148 | 149 | "transpose(((a,b,c),(d,e,f)),1,2)", 150 | "((a,d),(b,e),(c,f))", 151 | 152 | "transpose(((a,d),(b,e),(c,f)),1,2)", 153 | "((a,b,c),(d,e,f))", 154 | 155 | "transpose((a,b,c))", 156 | "(a,b,c)", 157 | }; 158 | 159 | void 160 | test_transpose(void) 161 | { 162 | test(__FILE__, s, sizeof s / sizeof (char *)); 163 | } 164 | 165 | #endif 166 | -------------------------------------------------------------------------------- /src/userfunc.cpp: -------------------------------------------------------------------------------- 1 | // Evaluate a user defined function 2 | 3 | #include "stdafx.h" 4 | #include "defs.h" 5 | 6 | #define F p3 // F is the function body 7 | #define A p4 // A is the formal argument list 8 | #define B p5 // B is the calling argument list 9 | #define S p6 // S is the argument substitution list 10 | 11 | void 12 | eval_user_function(void) 13 | { 14 | int h; 15 | 16 | // Use "derivative" instead of "d" if there is no user function "d" 17 | 18 | if (car(p1) == symbol(SYMBOL_D) && get_arglist(symbol(SYMBOL_D)) == symbol(NIL)) { 19 | eval_derivative(); 20 | return; 21 | } 22 | 23 | F = get_binding(car(p1)); 24 | A = get_arglist(car(p1)); 25 | B = cdr(p1); 26 | 27 | // Undefined function? 28 | 29 | if (F == car(p1)) { 30 | h = tos; 31 | push(F); 32 | p1 = B; 33 | while (iscons(p1)) { 34 | push(car(p1)); 35 | eval(); 36 | p1 = cdr(p1); 37 | } 38 | list(tos - h); 39 | return; 40 | } 41 | 42 | // Create the argument substitution list S 43 | 44 | p1 = A; 45 | p2 = B; 46 | h = tos; 47 | while (iscons(p1) && iscons(p2)) { 48 | push(car(p1)); 49 | push(car(p2)); 50 | eval(); 51 | p1 = cdr(p1); 52 | p2 = cdr(p2); 53 | } 54 | list(tos - h); 55 | S = pop(); 56 | 57 | // Evaluate the function body 58 | 59 | push(F); 60 | if (iscons(S)) { 61 | push(S); 62 | rewrite_args(); 63 | } 64 | eval(); 65 | } 66 | 67 | // Rewrite by expanding symbols that contain args 68 | 69 | int 70 | rewrite_args(void) 71 | { 72 | int h, n = 0; 73 | save(); 74 | 75 | p2 = pop(); // subst. list 76 | p1 = pop(); // expr 77 | 78 | if (istensor(p1)) { 79 | n = rewrite_args_tensor(); 80 | restore(); 81 | return n; 82 | } 83 | 84 | if (iscons(p1)) { 85 | h = tos; 86 | push(car(p1)); // Do not rewrite function name 87 | p1 = cdr(p1); 88 | while (iscons(p1)) { 89 | push(car(p1)); 90 | push(p2); 91 | n += rewrite_args(); 92 | p1 = cdr(p1); 93 | } 94 | list(tos - h); 95 | restore(); 96 | return n; 97 | } 98 | 99 | // If not a symbol then done 100 | 101 | if (!issymbol(p1)) { 102 | push(p1); 103 | restore(); 104 | return 0; 105 | } 106 | 107 | // Try for an argument substitution first 108 | 109 | p3 = p2; 110 | while (iscons(p3)) { 111 | if (p1 == car(p3)) { 112 | push(cadr(p3)); 113 | restore(); 114 | return 1; 115 | } 116 | p3 = cddr(p3); 117 | } 118 | 119 | // Get the symbol's binding, try again 120 | 121 | p3 = get_binding(p1); 122 | push(p3); 123 | if (p1 != p3) { 124 | push(p2); // subst. list 125 | n = rewrite_args(); 126 | if (n == 0) { 127 | pop(); 128 | push(p1); // restore if not rewritten with arg 129 | } 130 | } 131 | 132 | restore(); 133 | return n; 134 | } 135 | 136 | int 137 | rewrite_args_tensor(void) 138 | { 139 | int i, n = 0; 140 | push(p1); 141 | copy_tensor(); 142 | p1 = pop(); 143 | for (i = 0; i < p1->u.tensor->nelem; i++) { 144 | push(p1->u.tensor->elem[i]); 145 | push(p2); 146 | n += rewrite_args(); 147 | p1->u.tensor->elem[i] = pop(); 148 | } 149 | push(p1); 150 | return n; 151 | } 152 | -------------------------------------------------------------------------------- /src/variables.cpp: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------------------------------- 2 | // 3 | // Scan expr for vars, return in vector 4 | // 5 | // Input: Expression on stack 6 | // 7 | // Output: Vector 8 | // 9 | //----------------------------------------------------------------------------- 10 | 11 | #include "stdafx.h" 12 | #include "defs.h" 13 | static void scan(U *); 14 | static int __cmp(const void *, const void *); 15 | static int h; 16 | 17 | void 18 | variables(void) 19 | { 20 | int i, n; 21 | save(); 22 | p1 = pop(); 23 | h = tos; 24 | scan(p1); 25 | n = tos - h; 26 | if (n > 1) 27 | qsort(stack + h, n, sizeof (U *), __cmp); 28 | p1 = alloc_tensor(n); 29 | p1->u.tensor->ndim = 1; 30 | p1->u.tensor->dim[0] = n; 31 | for (i = 0; i < n; i++) 32 | p1->u.tensor->elem[i] = stack[i]; 33 | tos = h; 34 | push(p1); 35 | restore(); 36 | } 37 | 38 | static void 39 | scan(U *p) 40 | { 41 | int i; 42 | if (iscons(p)) { 43 | p = cdr(p); 44 | while (iscons(p)) { 45 | scan(car(p)); 46 | p = cdr(p); 47 | } 48 | } else if (issymbol(p) && p != symbol(E)) { 49 | for (i = h; i < tos; i++) 50 | if (stack[i] == p) 51 | return; 52 | push(p); 53 | } 54 | } 55 | 56 | static int 57 | __cmp(const void *p1, const void *p2) 58 | { 59 | return cmp_expr(*((U **) p1), *((U **) p2)); 60 | } 61 | -------------------------------------------------------------------------------- /src/vectorize.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | 3 | //----------------------------------------------------------------------------- 4 | // 5 | // Encapsulate stack values in a vector 6 | // 7 | // Input: n Number of values on stack 8 | // 9 | // tos-n Start of value 10 | // 11 | // Output: Vector on stack 12 | // 13 | //----------------------------------------------------------------------------- 14 | 15 | #include "defs.h" 16 | 17 | void 18 | vectorize(int n) 19 | { 20 | int i; 21 | 22 | save(); 23 | 24 | p1 = alloc_tensor(n); 25 | 26 | p1->u.tensor->ndim = 1; 27 | p1->u.tensor->dim[0] = n; 28 | 29 | for (i = 0; i < n; i++) 30 | p1->u.tensor->elem[i] = stack[tos - n + i]; 31 | 32 | tos -= n; 33 | 34 | push(p1); 35 | 36 | restore(); 37 | } 38 | -------------------------------------------------------------------------------- /src/versionProvider.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "versionProvider.hpp" 5 | void getVersion(char* buffer) { 6 | strcpy(buffer, __GIT_VERSION); 7 | } 8 | void getTimestamp(char* buffer) { 9 | strcpy(buffer, __GIT_TIMESTAMP); 10 | } -------------------------------------------------------------------------------- /src/versionProvider.hpp: -------------------------------------------------------------------------------- 1 | #ifndef __VERSIONPROVIDER_H 2 | #define __VERSIONPROVIDER_H 3 | 4 | # ifdef __cplusplus 5 | extern "C" { 6 | # endif 7 | void getVersion(char* buffer); 8 | void getTimestamp(char* buffer); 9 | # ifdef __cplusplus 10 | } 11 | # endif 12 | 13 | #endif -------------------------------------------------------------------------------- /src/zero.cpp: -------------------------------------------------------------------------------- 1 | #include "stdafx.h" 2 | #include "defs.h" 3 | 4 | void 5 | eval_zero(void) 6 | { 7 | int i, k[MAXDIM], m, n; 8 | m = 1; 9 | n = 0; 10 | p2 = cdr(p1); 11 | while (iscons(p2)) { 12 | push(car(p2)); 13 | eval(); 14 | i = pop_integer(); 15 | if (i < 2) { 16 | push(zero); 17 | return; 18 | } 19 | m *= i; 20 | k[n++] = i; 21 | p2 = cdr(p2); 22 | } 23 | if (n == 0) { 24 | push(zero); 25 | return; 26 | } 27 | p1 = alloc_tensor(m); 28 | p1->u.tensor->ndim = n; 29 | for (i = 0; i < n; i++) 30 | p1->u.tensor->dim[i] = k[i]; 31 | push(p1); 32 | } 33 | 34 | #if SELFTEST 35 | 36 | static char *s[] = { 37 | 38 | "zero(2,2)", 39 | "((0,0),(0,0))", 40 | 41 | "zero(1,1)", 42 | "0", 43 | }; 44 | 45 | void 46 | test_zero(void) 47 | { 48 | test(__FILE__, s, sizeof s / sizeof (char *)); 49 | } 50 | 51 | #endif 52 | -------------------------------------------------------------------------------- /unselected.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gbl08ma/eigenmath/8be989f00f2f6f37989bb7fd2e75a83f882fdc49/unselected.bmp --------------------------------------------------------------------------------