home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / FORTH / FRASRC11.ZIP / NEWTON.ASM < prev    next >
Assembly Source File  |  1989-12-18  |  6KB  |  329 lines
  1. ; NEWTON.ASM : Procedure NewtonFractal() from FRACTINT.
  2. ; Lee Daniel Crocker, 4/23/89.
  3. ;
  4. ; Tabs: 8
  5. ;
  6. ; Modifications:
  7. ;   BT = Bert Tyler
  8. ;   TW = Timothy Wegner
  9. ;   RD = Robert Day
  10. ;   MP = Mark Peterson
  11. ;
  12. ; Note: newton.asm was totally rewritten by Lee Crocker for FRACTINT 10.0
  13. ;    for integration with the newly structured fractal engine in calcmand.c 
  14. ;    and fractals.c. The current routine consists of the inner orbit 
  15. ;    calculation, with the supporting code removed. Early versions of 
  16. ;    newton.asm contained a complete newton fractal function.
  17. ;
  18. ; Assembled by Microsoft Macro Assembler 5.1, for use with Microsoft C 5.1.
  19. ;
  20.  
  21. ; Required for compatibility if Turbo ASM (BT 5/20/89)
  22.  
  23. IFDEF ??version
  24. MASM51
  25. QUIRKS
  26. EMUL
  27. ENDIF
  28.  
  29. .model    medium, c
  30.  
  31. public    NewtonFractal2
  32. public    invertz2
  33.  
  34. .data
  35.     extrn    color:word, maxcolor:word, degree:word, basin:word
  36.     extrn    row:word, col:word
  37.  
  38.     extrn    dx0:dword, dy0:dword
  39.  
  40.     extrn    old:qword, new:qword, d1overd:qword, roverd:qword
  41.     extrn    threshold:qword, floatmin:qword, floatmax:qword
  42.     extrn    f_radius:qword, f_xcenter:qword, f_ycenter:qword
  43.     extrn    roots:word, tempsqrx:qword
  44.  
  45. statw    dw    ?
  46.  
  47. .code
  48.  
  49. public    NewtonFractal2
  50. NewtonFractal2 proc
  51.  
  52. ;
  53. ; cpower(&old, degree-1, &tmp)
  54. ;
  55.     mov    ax, degree
  56.     dec    ax
  57.  
  58.     fld    old + 8
  59.     fld    old
  60. ;
  61. ; cpower() is expanded inline here.
  62. ;
  63.     shr    ax, 1
  64.     jnc    load1            ; if (exp & 1)
  65.  
  66.     fld    st(1)
  67.     fld    st(1)
  68.     jmp    short looptop        ; tmp = old
  69. load1:
  70.     fldz
  71.     fld1                ; else tmp = [1,0]
  72. looptop:
  73.     cmp    ax, 0
  74.     je    loopexit        ; while (exp)
  75.  
  76.     fld    st(2)            ; RD 5/7/89: Calculate xt^2 - yt^2
  77.     fadd    st, st(4)        ; by using (xt+yt)*(xt-yt), which
  78.     fld    st(3)            ; trades one multiplication for an
  79.     fsub    st, st(5)        ; addition.  This trick saves a
  80.     fmul                ; whopping 1.2% of time.
  81.  
  82.     fld    st(4)
  83.     fmul    st, st(4)
  84.     fadd    st, st            ; yt = 2 * xt * yt
  85.  
  86.     fstp    st(5)            ; tmp.y = yt
  87.     fstp    st(3)            ; tmp.x = xt
  88.  
  89.     shr    ax, 1
  90.     jnc    looptop         ; if (exp & 1)
  91.  
  92.     fld    st(2)
  93.     fmul    st, st(1)
  94.     fld    st(4)
  95.     fmul    st, st(3)
  96.     fsub                ; tmp.x = xt * tmp.x - yt * tmp.y
  97.  
  98.     fld    st(3)
  99.     fmul    st, st(3)
  100.     fld    st(5)
  101.     fmul    st, st(3)
  102.     fadd                ; tmp.y = xt * tmp.y + yt * tmp.x
  103.     fstp    st(3)
  104.     fstp    st(1)
  105.  
  106.     jmp    short looptop
  107. loopexit:
  108.     fstp    st(2)
  109.     fstp    st(2)
  110. ;
  111. ; End of complex_power() routine.  Result is in ST, ST(1)
  112. ;
  113. ;
  114. ; complex_mult(tmp, old, &new);
  115. ;
  116.     fld    old + 8
  117.     fld    old
  118.  
  119.     fld    st(3)        ; tmp.y
  120.     fmul    st, st(1)   ; old.x
  121.     fld    st(3)        ; tmp.x
  122.     fmul    st, st(3)   ; old.y
  123.     fadd
  124.     fld    st(3)        ; tmp.x
  125.     fmul    st, st(2)   ; old.x
  126.     fld    st(5)        ; tmp.y
  127.     fmul    st, st(4)   ; old.y
  128.     fsub
  129. ;
  130. ; if (DIST1(new) < THRESHOLD) {
  131. ;
  132.     fld1
  133.     fsubr    st, st(1)
  134.     fmul    st, st
  135.     fld    st(2)        ; new.y
  136.     fmul    st, st
  137.     fadd
  138.     fcomp    threshold
  139.     fstsw    statw
  140.     mov    ax, statw
  141.     sahf
  142.     jnc    notless
  143. ;
  144. ; if (fractype == NEWTBASIN) {
  145. ;
  146.     mov    ax, basin
  147.     cmp    ax, 0
  148.     je    notbasin
  149.  
  150.     mov    bx, roots
  151.     mov    dx, -1            ; tempcolor = -1
  152.     sub    cx, cx
  153. dloop:
  154.     fld    qword ptr [bx]    ; roots[i].x
  155.     fsub    st, st(3)    ; old.x
  156.     fmul    st, st
  157.     fld    qword ptr [bx+8]; roots[i].y
  158.     fsub    st, st(5)    ; old.y
  159.     fmul    st, st
  160.     fadd
  161.     fcomp    threshold
  162.     fstsw    statw
  163.     mov    ax, statw
  164.     sahf                ; if (distance(roots[i],old) < threshold)...
  165.     jnc    nl2
  166.  
  167. ; TW commented out next few lines and add dx,ax to eliminate newtbasin
  168. ; color shades per Phil Wilson's request 12/03/89
  169. ;    mov    ax, color
  170. ;    and    ax, 1
  171. ;    shl    ax, 1
  172. ;    shl    ax, 1
  173. ;    shl    ax, 1
  174.  
  175.     mov    dx, cx
  176. ;    and    dx, 7
  177. ;    add    dx, ax
  178.     inc    dx            ; tempcolor = 1+(i&7)+((color&1)<<3)
  179.     jmp    short nfb        ; break
  180. nl2:
  181.     add    bx, 16
  182.     inc    cx
  183.     cmp    cx, degree
  184.     jl    dloop
  185. nfb:
  186.     mov    ax, dx
  187.     cmp    dx, -1
  188.     jne    notm1
  189.     mov    ax, maxcolor        ; if (tmpcolor == -1)...
  190. notm1:
  191.     mov    color, ax
  192. notbasin:
  193.     mov    ax, 1
  194.     jmp    nlexit
  195. notless:
  196.     fld    d1overd
  197.     fmul    st(2), st        ; new.y *= d1overd
  198.     fmul
  199.     fld    roverd
  200.     fadd                ; new.x = d1overd * new.x + roverd
  201.  
  202.     fld    st(5)        ; tmp.y
  203.     fmul    st, st
  204.     fld    st(5)        ; tmp.x
  205.     fmul    st, st
  206.     fadd
  207.     fcom    floatmin
  208.     fstsw    statw
  209.     mov    ax, statw
  210.     sahf                ; if (mod(tmp) < FLT_MIN) {
  211.     jnc    cont
  212.     mov    ax, 1
  213.     fstp    st
  214.     jmp    nlexit
  215. cont:
  216.     fld1
  217.     fdivr
  218.     fst    st(4)        ; old.y
  219.     fstp    st(3)        ; old.x
  220.  
  221.     fld    st(4)        ; tmp.x
  222.     fmul    st, st(1)   ; new.x
  223.     fld    st(6)        ; tmp.y
  224.     fmul    st, st(3)   ; new.y
  225.     fadd
  226.     fmulp    st(3), st   ; old.x
  227.  
  228.     fld    st(4)        ; tmp.x
  229.     fmul    st, st(2)   ; new.y
  230.     fld    st(6)        ; tmp.y
  231.     fmul    st, st(2)   ; new.x
  232.     fsub
  233.     fmulp    st(4), st   ; old.y    ; old = new / tmp
  234.  
  235.     fstp    new
  236.     fstp    new + 8
  237.     fstp    old
  238.     fstp    old + 8
  239.     mov    ax, 0
  240.     jmp    nlx2
  241. nlexit:
  242.     fstp    new
  243.     fstp    new + 8
  244.     fstp    st
  245.     fstp    st
  246. nlx2:
  247.     fstp    st
  248.     fstp    st
  249.  
  250.     ret
  251. NewtonFractal2 endp
  252. ;
  253. ;
  254. ;
  255. public    invertz2
  256. invertz2 proc    uses si, zval:word    ; TW 11/03/89 changed zval to near
  257.  
  258.     push    ds
  259.  
  260.     fld    f_xcenter
  261.     fld    f_ycenter
  262.  
  263.     mov    ax, col
  264.     shl    ax, 1
  265.     shl    ax, 1
  266.     shl    ax, 1
  267.  
  268.     lds    si, dx0
  269.     add    si, ax
  270.     fld    qword ptr [si]
  271.     fsub    st, st(2)
  272.  
  273.     pop    ds    ; MP 11/03/89 restore near segement 
  274.     push    ds
  275.  
  276.     mov    ax, row
  277.     shl    ax, 1
  278.     shl    ax, 1
  279.     shl    ax, 1
  280.  
  281. ;    pop    ds        ; TW segment already restored above
  282. ;    push    ds
  283.  
  284.     lds    si, dy0
  285.     add    si, ax
  286.     fld    qword ptr [si]
  287.     fsub    st, st(2)
  288.  
  289.     fld    st(1)
  290.     fmul    st, st
  291.     fld    st(1)
  292.     fmul    st, st
  293.     fadd
  294.  
  295.     pop    ds
  296.     push    ds
  297.  
  298.     fcom    floatmin
  299.     fstsw    statw
  300.     mov    ax, statw
  301.     sahf
  302.     jnc    inl1
  303.  
  304.     fstp    st
  305.     fld    floatmax
  306.     jmp    icom
  307. inl1:
  308.     fld    f_radius
  309.     fdivr
  310. icom:
  311.     fst    tempsqrx
  312.  
  313.     fmul    st(2), st
  314.     fmul
  315.     faddp    st(2), st
  316.     faddp    st(2), st
  317.  
  318. ;    lds    si, zval    ; TW 11/03/89 zval is now a near pointer
  319.     mov    si, zval    ; TW
  320.     fstp    qword ptr [si+8]
  321.     fstp    qword ptr [si]
  322.  
  323.     pop    ds
  324.  
  325.     ret
  326. invertz2 endp
  327.  
  328. END
  329.