'=========================================================================== ' Subject: TRANSCENDENTAL FUNCTIONS FOR QB Date: 01-19-97 (16:30) ' Author: Erika Schulze & Gunther Ilzig Code: QB, QBasic, PDS ' Origin: 100775.2275@CompuServe.Com Packet: ALGOR.ABC '=========================================================================== DECLARE SUB Reading (x%, y%) DECLARE SUB Basex (p1!, p2!, p3!) DECLARE SUB Waiting () DECLARE FUNCTION CalcRad! (p!) DECLARE FUNCTION CalcDeg! (p!) '*************************************************************************** 'Program: TRANS.BAS * 'Task: Demonstration for the transcendental functions. * 'Interpreter: QBASIC mixed with assembly language * 'Written: January 1997 * 'Authors: Gunther Ilzig and Erika Schulze * ' CIS: 10775,2275 * ' Internet: 100775.2275@compuserve.com * ' PUBLIC DOMAIN * '*************************************************************************** 'The software is provided with the standard disclaimers: no 'warranties or guaranties, either explicit or implied. The 'material is free for use (PUBLIC DOMAIN). 'There is no documentation, but in the source code, every sub or 'function has a header that contains not only the passed 'parameters (INPUT and OUTPUT), but also the used algorithms. 'Hardware requirements: 80386/80387 (or better). 'The program works under DOS, WINDOWS 3.x, WIN95 and OS/2. 'Motivation: '=========== 'QBASIC doesn't support FPU instructions. That makes the programs 'sometimes a bit slow and that's not necessary, if a FPU is avail- 'able. 'The demonstration program contains several procedures for 'calculating transcendental functions: sin x, cos x, tan x, cot x, 'arcsin x, arccos x, arctan x, arccot x, y^x, log x (ln x) and 'log10 x (lg x). The calculation procedures are completely in 'assembly language with the new 80387 instructions and therefore 'very fast. 'Note about terminology: 'There are differences in the expressions of the logarithms between 'the USA/Canada on the one hand and Europe on the other hand. 'USA/ Canada Europe '=========== ====== 'LOG X LN X 'LOG10 X LG X 'LOG2 X LD X 'It follows the explanation. The different terminology is a long 'tradition from the European renaissance and later from the Enlightenment. 'The famous English mathematician Henry Briggs (1561 - 1630) made the 'first table of logarithms and the G in LG X stands for Briggs. The other 'expressions come from the Latin: LN = Logarithmus Naturalis and 'LD = Logarithmus Dualis. 'We've mostly used both expressions (one in brackets) and therefore 'the programmers in both worlds shouldn't have difficulties. 'The library is, of course, PUBLIC DOMAIN and everybody may use it 'free and change it, if, for example, another precision is 'needed. It isn't complete and doesn't include procedures for: 'sinh x, cosh x, tanh x, coth x; but it is the first release. 'Please feel free to make suggestions for improvement. 'Another, possibly better, approach to calculate such functions, 'is the use of the so called Chebyshev approximation (for 'background information see points 5 and 6 of the literature 'list). 'Literature List: '1. Ross P. Nelson: 80386/80486 Programming Guide. Microsoft Press '2. Stephen P. Morse et. al. The 80386/387 Architecture. John 'Wiley & Sons '3. IEEE Standard Boards. IEEE Standard for Binary Floating-Point 'Arithmetic. ANSI/IEEE Std. 754 - 1985 '4. Intel, 387 DX User's Manual (Programmer's Reference), Order 'Number 231917 - 002 '5. G. G. Lorentz: Approximation of Functions. Holt, Rinehart and 'Winston. '6. Lyusternik, Chervonenkis, Yanpolski: Handbook for Computing 'Elementary Functions. Pergamon Press (translation from Russian). '7. K. - D. Thies: PC XT/AT Numerik-Buch. TeWi-Verlag (in German) '8. Jorke, Lampe, Wengel: Arithmetische Algorithmen. Verlag 'Technik (in German). 'For further informations or questions send us a message. 'Erika Schulze and Gunther Ilzig 'CIS: 100775,2275 'Internet: 100775.2275@compuserve.com '=========================================================================== 'used arrays, variables and constants for the demonstration = '=========================================================================== DIM FMSin%(15) 'array for the sine procedure FMSinseg% = VARSEG(FMSin%(0)) 'start address sine procedure FMSinoff% = VARPTR(FMSin%(0)) DIM FMCos%(15) 'array for the cosine procedure FMCosseg% = VARSEG(FMCos%(0)) 'start address cosine procedure FMSinoff% = VARPTR(FMCos%(0)) DIM FMTan%(16) 'array for the tangent procedure FMTanseg% = VARSEG(FMTan%(0)) 'start address tangent procedure FMTanoff% = VARPTR(FMTan%(0)) DIM FMCot%(16) 'array for the cotangent procedure FMCotseg% = VARSEG(FMCot%(0)) 'start address cotangent procedure FMCotoff% = VARPTR(FMCot%(0)) DIM FMAtn%(16) 'array for the arctangent procedure FMAtnseg% = VARSEG(FMAtn%(0)) 'start address arctangent procedure FMAtnoff% = VARPTR(FMAtn%(0)) DIM FMAct%(16) 'array for the arccotangent procedure FMActseg% = VARSEG(FMAct%(0)) 'start address arccotangent procedure FMActoff% = VARPTR(FMAct%(0)) DIM FMAsn%(20) 'array for the arcsine procedure FMAsnseg% = VARSEG(FMAsn%(0)) 'start address arcsine procedure FMAsnoff% = VARPTR(FMAsn%(0)) DIM FMAcs%(20) 'array for the arccosine procedure FMAcsseg% = VARSEG(FMAcs%(0)) 'start address arccosine procedure FMAcsoff% = VARPTR(FMAcs%(0)) DIM FMPow%(26) 'array for the power routine FMPowseg% = VARSEG(FMPow%(0)) 'start address power routine FMPowoff% = VARPTR(FMPow%(0)) DIM FMexp%(26) 'array for the expo procedure FMExpseg% = VARSEG(FMexp%(0)) 'start address expo procedure FMExpoff% = VARPTR(FMexp%(0)) DIM FMLn%(16) 'array for the naturalis procedure FMLnseg% = VARSEG(FMLn%(0)) 'start address naturalis procedure FMLnoff% = VARPTR(FMLn%(0)) DIM FMLg%(16) 'array for the brigg procedure FMLgseg% = VARSEG(FMLg%(0)) 'start address brigg procedure FMLgoff% = VARPTR(FMLg%(0)) angalphadeg = 30 'angle alpha in degree angalpharad = 0 'result for the angle alpha in radian angbetadeg = 0 'result for the angle beta in degree sinbeta = .8660253 'the sine of 60 degree cosbeta = .5000002 'the cosine of 60 degree tanbeta = 1.73205 'the tangent of 60 degree cotbeta = .5773506 'the cotangent of 60 degree result = 0 'the result for the trigonometrical 'functions a = 3 'the values for the expression: b = 4 'c=a^b c = 0 x = 5 'value for e^x, log x, log10 x '=========================================================================== 'Demonstration starts here = '=========================================================================== CLS 'clear the screen RESTORE sine 'read code for sine procedure CALL Reading(FMSinseg%, FMSinoff%) RESTORE cosine 'read the code for cosine procedure CALL Reading(FMCosseg%, FMCosoff%) RESTORE tangent 'read the code for tangent procedure CALL Reading(FMTanseg%, FMTanoff%) RESTORE cotangent 'read the code for cotangent procedure CALL Reading(FMCotseg%, FMCotoff%) RESTORE arctangent 'read the code for arctangent procedure CALL Reading(FMAtnseg%, FMAtnoff%) RESTORE arccotangent 'read the code for arccotangent procedure CALL Reading(FMActseg%, FMActoff%) RESTORE arcsine 'read the code for arcsine procedure CALL Reading(FMAsnseg%, FMAsnoff%) RESTORE arccosine 'read the code for arccosine procedure CALL Reading(FMAcsseg%, FMAcsoff%) RESTORE power 'read the code for the power routine CALL Reading(FMPowseg%, FMPowoff%) RESTORE expo 'read the code for the expo routine CALL Reading(FMExpseg%, FMExpoff%) RESTORE naturalis 'read the code for the naturalis routine CALL Reading(FMLnseg%, FMLnoff%) RESTORE brigg 'read the code for the brigg procedure CALL Reading(FMLgseg%, FMLgoff%) angalpharad = CalcRad(angalphadeg) 'convert the angle into radian DEF SEG = FMSinseg% 'calculate the sine CALL ABSOLUTE(angalpharad, result, FMSinoff%) DEF SEG PRINT "The sine from 30 Degree is :"; result 'print the sine DEF SEG = FMCosseg% 'calculate the cosine CALL ABSOLUTE(angalpharad, result, FMCosoff%) DEF SEG PRINT "The cosine from 30 Degree is :"; result 'print the cosine DEF SEG = FMTanseg% 'calculate the tangent CALL ABSOLUTE(angalpharad, result, FMTanoff%) DEF SEG PRINT "The tangent from 30 Degree is :"; result DEF SEG = FMCotseg% 'calculate the cotangent CALL ABSOLUTE(angalpharad, result, FMCotoff%) DEF SEG PRINT "The cotangent from 30 Degree is :"; result DEF SEG = FMAtnseg% 'calculate the inverse tangent CALL ABSOLUTE(tanbeta, result, FMAtnoff%) DEF SEG angbetadeg = CalcDeg(result) PRINT "The angle from the tangent value is :"; angbetadeg; "Degree" DEF SEG = FMActseg% 'calculate the inverse cotangent CALL ABSOLUTE(cotbeta, result, FMActoff%) DEF SEG angbetadeg = CalcDeg(result) PRINT "The angle from the cotangent value is:"; angbetadeg; "Degree" DEF SEG = FMAsnseg% 'calculate the inverse sine CALL ABSOLUTE(sinbeta, result, FMAsnoff%) DEF SEG angbetadeg = CalcDeg(result) PRINT "The angle from the sine value is :"; angbetadeg; "Degree" DEF SEG = FMAcsseg% 'calculate the inverse cosine CALL ABSOLUTE(cosbeta, result, FMAcsoff%) DEF SEG angbetadeg = CalcDeg(result) PRINT "The angle from the cosine value is :"; angbetadeg; "Degree" DEF SEG = FMPowseg% 'calculate c=a^b CALL ABSOLUTE(a, b, c, FMPowoff%) DEF SEG PRINT "The result of 3^4 is :"; c DEF SEG = FMExpseg% 'calculate e^x CALL ABSOLUTE(x, result, FMExpoff%) DEF SEG PRINT "The result of e^5 is :"; result DEF SEG = FMLnseg% 'calculate ln x CALL ABSOLUTE(x, result, FMLnoff%) DEF SEG PRINT "The result of ln 5 is :"; result DEF SEG = FMLgseg% 'calculate ln x CALL ABSOLUTE(x, result, FMLgoff%) DEF SEG PRINT "The result of lg 5 is :"; result PRINT PRINT PRINT "It follows a speed demonstration of c=a^b with" PRINT "10 000 loop cycles. First with QBASIC." PRINT PRINT "Please press any key to continue ..." CALL Waiting 'wait for a key CLS 'clear the screen PRINT "I'm calculating..." t = TIMER FOR i% = 1 TO 10000 CALL Basex(a, b, c) NEXT i% t = ABS(t - TIMER) PRINT PRINT "Result of 3^4 ="; c PRINT "Elapsed Time ="; t; "Seconds" PRINT PRINT "Now with the assembly language procedure:" PRINT PRINT "Please press any key to continue ..." CALL Waiting 'wait for a key CLS 'clear the screen PRINT "I'm calculating..." t = TIMER FOR i% = 1 TO 10000 DEF SEG = FMPowseg% 'calculate c=a^b CALL ABSOLUTE(a, b, c, FMPowoff%) DEF SEG NEXT i% t = ABS(t - TIMER) PRINT PRINT "Result of 3^4 ="; c PRINT "Elapsed Time ="; t; "Seconds" PRINT PRINT "Please press any key to end the demonstration." CALL Waiting 'wait for a key CLS 'clear the screen END sine: '*************************************************************************** 'PROCEDURE sine * 'Task: Calculates the sine. * 'Input: [bp+6] = address result * ' [bp+8] = address angle * 'Output: sine * 'Uses: no subroutines * 'Note: The domain for the angle is with 80387 instructions: * ' -2^63 < angle < 2^63 * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di ;don't want to be like MicroSoft DATA 56: 'push si ;save registers DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=angle DATA d9,fe: 'fsin ;st(0):=SIN(angle) DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character cosine: '*************************************************************************** 'PROCEDURE cosine * 'Task: Calculates the cosine. * 'Input: [bp+6] = address result * ' [bp+8] = address angle * 'Output: sine * 'Uses: no subroutines * 'Note: The domain for the angle is with 80387 instructions: * ' -2^63 < angle < 2^63 * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=angle DATA d9,ff: 'fcos ;st(0):=COS(angle) DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character tangent: '*************************************************************************** 'PROCEDURE tangent * 'Task: Calculates the tangent. * 'Input: [bp+6] = address result * ' [bp+8] = address angle * 'Output: tangent * 'Uses: no subroutines * 'Note: The domain for the angle is with 80387 instructions: * ' -2^63 < angle < 2^63 * ' For the calculation of the tangent function we use the * ' FPU instruction FPTAN (partial tangent). This instruction * ' moves automatic the constant 1 at the FPU stack. Therefore * ' we must remove this value after the calculation is done. * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=angle DATA d9,f2: 'fptan ;st(0):=1 ' ;st(1):=TAN(angle) DATA dd,d8: 'fstp st(0) ;remove the 1 ' ;st(0):=TAN(angle) DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character cotangent: '*************************************************************************** 'PROCEDURE cotangent * 'Task: Calculates the cotangent. * 'Input: [bp+6] = address result * ' [bp+8] = address angle * 'Output: cotangent * 'Uses: no subroutines * 'Note: The domain for the angle with 80387 instructions is: * ' -2^63 < angle < 2^63 * ' It is: * ' 1 * ' cot(x) = -------- * ' tan(x) * ' * ' Therefore, we can use the '1' from FPTAN to calculate the * ' cotangent. * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=angle DATA d9,f2: 'fptan ;st(0):=1 ' ;st(1):=TAN(angle) DATA de,f1: 'fdivrp ;st(0):=st(0)/st(1) ' ;and the FPU stack is cleared DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character arctangent: '*************************************************************************** 'PROCEDURE arctangent * 'Task: Calculates the inverse tangent. * 'Input: [bp+6] = address result * ' [bp+8] = address tangent value * 'Output: angle in radian * 'Uses: no subroutines * 'Note: The domain for the angle (main value) is: * ' -PI/2 < arctan y < PI/2 * ' The FPU instruction FPATAN(st(1),st) is defined as: * ' * ' Ú arctan x for st(1)=x and st(0)=1 * ' FPATAN(st(1),st) =Ä´ * ' À arccot x for st(1)=1 and st(0)=x * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=tangent value DATA d9,e8: 'fld1 ;load '1' ' ;st(0):=1 ' ;st(1):=tangent value DATA d9,f3: 'fpatan ;st(0):=angle DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character arccotangent: '*************************************************************************** 'PROCEDURE arccotangent * 'Task: Calculates the inverse cotangent. * 'Input: [bp+6] = address result * ' [bp+8] = address cotangent value * 'Output: angle in radian * 'Uses: no subroutines * 'Note: see FMAtn * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,e8: 'fld1 ;load '1' DATA d9,04: 'fld dword ptr [si] ;st(0):=cotangent value ' ;st(1):=1 DATA d9,f3: 'fpatan ;st(0):=angle DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character arcsine: '*************************************************************************** 'PROCEDURE arcsine * 'Task: Calculates the inverse sine. * 'Input: [bp+6] = address result * ' [bp+8] = address sine value * 'Output: angle in radian * 'Uses: no subroutines * 'Note: It is: * ' * ' x * ' arcsin x = arctan ------------ * ' ÚÄÄÄÄÄÄÄÄÄÄ * ' \ ³ 2 * ' \³ 1 - x * ' * ' It follows: * ' * ' arcsin x = FPATAN(x,SQR(1-x^2)) * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=sine value=x DATA d9,c0: 'fld st ;st(0):=x ' ;st(1):=x DATA d8,c8: 'fmul st,st ;st(0):=x^2 ' ;st(1):=x DATA d9,e8: 'fld1 ;st(0):=1 ' ;st(1):=x^2 ' ;st(2):=x DATA de,e1: 'fsubrp ;st(0):=1-x^2 ' ;st(0):=x DATA d9,fa: 'fsqrt ;st(0):=SQR(1-x^2) ' ;st(1):=x DATA d9,f3: 'fpatan ;st(0):=arcsin x=angle DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character arccosine: '*************************************************************************** 'PROCEDURE arccosine * 'Task: Calculates the inverse cosine. * 'Input: [bp+6] = address result * ' [bp+8] = address cosine value * 'Output: angle in radian * 'Uses: no subroutines * 'Note: It is: * ' * ' x * ' arccos x = arccot ---------- * ' ÚÄÄÄÄÄÄÄ * ' \ ³ 2 * ' \³1 - x * ' * ' It follows: * ' * ' arccos x = FPATAN(SQR(1-x^2),x) * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;ds:si -> angle DATA 8b,7e,06: 'mov di,[bp+6] ;ds:di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=sine value=x DATA d9,c0: 'fld st ;st(0):=x ' ;st(1):=x DATA d8,c8: 'fmul st,st ;st(0):=x^2 ' ;st(1):=x DATA d9,e8: 'fld1 ;st(0):=1 ' ;st(1):=x^2 ' ;st(2):=x DATA de,e1: 'fsubrp ;st(0):=1-x^2 ' ;st(0):=x DATA d9,fa: 'fsqrt ;st(0):=SQR(1-x^2) ' ;st(1):=x DATA d9,c9: 'fxch ;exchange st(0) and st(1) DATA d9,f3: 'fpatan ;st(0):=arcsin x=angle DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character power: '*************************************************************************** 'PROCEDURE power b * 'Task: Calculates the expression c=a * 'Input: [bp+6] = address c * ' [bp+8] = address b * ' [bp+10] = address a * 'Output: c=a^b * 'Note: It is: * ' b b*ld x * ' a = 2 * ' * ' The expression b*ld x we can compute with the instruction * ' FYL2X. x * ' The instruction F2XM1 calculates 2 - 1 * ' y * ' With FSCALE we compute x*2 * ' Unfortunately, FSCALE accepts only integer exponents and * ' F2XM needs the argument in -0.5 < x < 0.5. Therefore we * ' round with FRNDINT. * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 53: 'push bx DATA 57: 'push di DATA 56: 'push si DATA 8b,5e,0a: 'mov bx,[bp+10] ;bx -> a DATA 8b,76,08: 'mov si,[bp+8] ;si -> b DATA 8b,7e,06: 'mov di,[bp+6] ;di -> c DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=b DATA d9,07: 'fld dword ptr [bx] ;st(0):=a ' ;st(1):=b DATA d9,f1: 'fyl2x ;st(0):=b*log2 a=z DATA d9,c0: 'fld st ;copy the result ' ;st(0):=z ' ;st(1):=z DATA d9,fc: 'frndint ;round st(0) to integer DATA dc,e9: 'fsub st(1),st(0) ;st(1):=z-round(z) DATA d9,c9: 'fxch ;st(0):=z-round(z) ' ;st(1):=round(z) DATA d9,f0: 'f2xm1 ;st(0):=2^(z-round(z))-1 ' ;st(1):=round(z) DATA d9,e8: 'fld1 ;st(0):=1 ' ;st(1):=2^(z-round(z))-1 ' ;st(2):=round(z) DATA de,c1: 'faddp ;st(0):=2^(z-round(z)) ' ;st(1):=round(z) DATA d9,fd: 'fscale ;st(0):=2^(z-round(z))*2^round(z) ' ;=2^z=result DATA dd,d9: 'fstp st(1) ;clear FPU stack DATA d9,1d: 'fstp dword ptr [di] ;c:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 5b: 'pop bx DATA 8b,e5: 'mov sp,bp DATA 5d: 'pop bp DATA ca,06,00: 'ret 6 DATA *: 'end character expo: '*************************************************************************** 'PROCEDURE expo * 'Task: Calculates e^x. * 'Input: [bp+6] = address result * ' [bp+8] = address x * 'Output: e^x * 'Uses: no subroutines * 'Note: See also FMPow. The only difference is that we moreover * ' need the constant log2 e. * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;si -> x DATA 8b,7e,06: 'mov di,[bp+6] ;di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,04: 'fld dword ptr [si] ;st(0):=x DATA d9,ea: 'fldl2e ;st(0):=log2 e=ld e ' ;st(1):=x DATA de,c9: 'fmulp ;st(0):=x*ld e=z DATA d9,c0: 'fld st ;copy the result ' ;st(0):=z ' ;st(1):=z DATA d9,fc: 'frndint ;round st(0) to integer DATA dc,e9: 'fsub st(1),st(0) ;st(1):=z-round(z) DATA d9,c9: 'fxch ;st(0):=z-round(z) ' ;st(1):=round(z) DATA d9,f0: 'f2xm1 ;st(0):=2^(z-round(z))-1 ' ;st(1):=round(z) DATA d9,e8: 'fld1 ;st(0):=1 ' ;st(1):=2^(z-round(z))-1 ' ;st(2):=round(z) DATA de,c1: 'faddp ;st(0):=2^(z-round(z)) ' ;st(1):=round(z) DATA d9,fd: 'fscale ;st(0):=2^(z-round(z))*2^round(z) ' ;=2^z=result DATA dd,d9: 'fstp st(1) ;clear FPU stack DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d: 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character naturalis: '*************************************************************************** 'PROCEDURE naturalis * 'Task: Calculates log x (ln x, logarithmus naturalis). * 'Input: [bp+6] = address result * ' [bp+8] = address x * 'Output: logx (ln x) * 'Uses: no subroutines * 'Note: It is: * ' log x = log 2*log2 x * ' a a * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;si -> x DATA 8b,7e,06: 'mov di,[bp+6] ;di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,ed: 'fldln2 ;st(0):=ln 2 DATA d9,04: 'fld dword ptr [si] ;st(0):=x ' ;st(1):=ln 2 DATA d9,f1: 'fyl2x ;st(0):=ln 2*ld x=result DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d: 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character brigg: '*************************************************************************** 'PROCEDURE brigg * 'Task: Calculates log10 x (lg x, Brigg's logarithms). * 'Input: [bp+6] = address result * ' [bp+8] = address x * 'Output: logx (ln x) * 'Uses: no subroutines * 'Note: It is: * ' log x = log 2*log2 x * ' a a * '*************************************************************************** DATA 55: 'push bp DATA 8b,ec: 'mov bp,sp DATA 57: 'push di DATA 56: 'push si DATA 8b,76,08: 'mov si,[bp+8] ;si -> x DATA 8b,7e,06: 'mov di,[bp+6] ;di -> result DATA db,e3: 'fninit ;initialize FPU DATA d9,ec: 'fldlg2 ;st(0):=lg 2 DATA d9,04: 'fld dword ptr [si] ;st(0):=x ' ;st(1):=lg 2 DATA d9,f1: 'fyl2x ;st(0):=lg 2*ld x=result DATA d9,1d: 'fstp dword ptr [di] ;result:=st(0) DATA 9b: 'fwait DATA 5e: 'pop si DATA 5f: 'pop di DATA 8b,e5: 'mov sp,bp DATA 5d: 'pop bp DATA ca,04,00: 'ret 4 DATA *: 'end character SUB Basex (p1!, p2!, p3!) p3! = p1! ^ p2! END SUB '*************************************************************************** 'FUNCTION CalcDeg * 'Task: Converts radian in degree. * 'Input: p = angle in radian * 'Output: angle in degree * 'Uses: no subroutines * 'Note: It is (see also CalcRad): * ' * ' x *180 * ' radian * ' x = ------------ * ' degree Pi * '*************************************************************************** FUNCTION CalcDeg! (p!) pi = 3.141592 'pi as extended variable factor = 180 CalcDeg = p * factor / pi END FUNCTION '*************************************************************************** 'FUNCTION CalcRad * 'Task: Converts degree in radian. * 'Input: p# = angle in degree * 'Output: angle in radian * 'Uses: no subroutines * 'Note: It is: * ' x 360 * ' degree * ' --------- = ----- * ' x 2*Pi * ' radian * ' * ' x *Pi * ' It follows: degree * ' x = ------------ * ' radian 180 * '*************************************************************************** FUNCTION CalcRad! (p!) pi = 3.141592 'pi divisor = 180 CalcRad = p * pi / divisor END FUNCTION '*************************************************************************** 'SUB Reading * 'Task: Reads machine code in an array. * 'Input: x% = segment address first array element * ' y% = offset address first array element * 'Output: machine code in the array * 'Uses: no subroutines * '*************************************************************************** SUB Reading (x%, y%) DEF SEG = x% 'set the segment FOR i% = 0 TO 199 'reading loop READ byte$ 'read 1 byte IF byte$ = "*" THEN EXIT FOR 'end character POKE (y% + i%), VAL("&H" + byte$) 'write 1 byte NEXT i% DEF SEG 'reset the segment END SUB '*************************************************************************** 'SUB Waiting * 'Task: Waits until the user has pressed a key. * 'Input: Nothing * 'Output: Waiting * 'Uses: No Subroutines * '*************************************************************************** SUB Waiting WHILE LEN(INKEY$) = 0 WEND END SUB