home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p2_16bs.seq < prev    next >
Encoding:
Text File  |  1990-03-29  |  3.0 KB  |  101 lines
  1. \ Comp 462
  2. \ Balraj Sidhu   Set: 14D4
  3. \ Date: March 29, 1990
  4. \ Problem 2.16
  5.  
  6. \ Program INTDIV
  7. \ Function: Plots r vs m and q vs m for floored and symmetric division.
  8.  
  9. \ plot point
  10. : plot ( -- )
  11.         16 -15 do i over / 10 swap - I 15 + 2* swap at
  12.           ascii o emit loop drop ;
  13.  
  14. \ make grid for plot
  15. : grid ( -- )
  16.         0 10 at 60 0 do 197 emit 196 emit 2 +loop
  17.         ascii + emit
  18.         21 1 do 30 i at 197 emit loop
  19.          9 9 at -10 . 50  9 at  10 .
  20.         28 0 at  10 . 27 20 at -10 . ;
  21.  
  22. \ display divisor
  23. : .divisor ( n -- )
  24.         40 1 at ." Divisor = n = " . ;
  25.  
  26. \ display division equations
  27. : .eqn ( -- )
  28.         40 18 at ."  m  = nq + r"
  29.         40 19 at ." m/n =  q + r/n"
  30.         0 22 at
  31.         ." ( m = dividend, n = divisor, q = quotient, and r = remainder )" ;
  32.  
  33. \ floored integer division... quotient vs dividend
  34. : fqvsm ( n -- )
  35.         1 1 at ." FLOORED g vs m" dup .divisor .eqn
  36.         30 0 at ascii q emit 61 10 at ascii m emit
  37.         5 21 at ." Quotient vs Dividend fo Floored Integer Division"
  38.         16 -15 do i over / 10 swap - I 15 + 2* swap at
  39.           219 emit loop drop ;
  40.  
  41. \ floored integer division... remainder vs dividend.
  42. : frvsm ( n -- )
  43.         1 1 at ." FLOORED r vs m " dup .divisor .eqn
  44.         30 0 at ascii r emit 62 10 at ascii m emit
  45.         5 21 at ." Remainder vs Dividend for Floored Integer Division"
  46.         16 -15 do i over mod 10 swap - I 15 + 2* swap at
  47.           219 emit loop drop ;
  48.  
  49. \ symmetric integer division form of /mod
  50. : s/mod ( m n -- r q )
  51.         2dup xor 0<
  52.         if   2dup
  53.              abs swap abs swap          \ m n |m| |n|
  54.              / negate                   \ m n q
  55.              -rot 2 pick                \ q m n q
  56.              * -                        \ q r = m - nq
  57.              swap                       \ r q
  58.         else /mod
  59.         then ;
  60.  
  61. \ symmetric integer division form of /
  62. : s/ ( m n -- q )
  63.         s/mod nip ;
  64.  
  65. \ symmetric integer division form of mod
  66. : smod ( m n -- r )
  67.         s/mod drop ;
  68.  
  69. \ symmetric integer division... quotient vs dividend
  70. : sqvsm ( n -- )
  71.         1 1 at ." SYMMETRIC q vs m" dup .divisor .eqn
  72.         30 0 at ascii q emit 62 10 at ascii m emit
  73.         5 21 at ." Quotient vs Dividend for Symmetric Integer Divsion"
  74.         16 -15 do i over s/ 10 swap - I 15 + 2* swap at
  75.           219 emit loop drop ;
  76.  
  77. \ symmetric integer divsion... remainder vs dividend.
  78. : srvsm ( n -- )
  79.         1 1 at ." SYMMETRIC r vs m" dup .divisor .eqn
  80.         31 0 at ascii q emit 62 10 at ascii m emit
  81.         5 21 at ." Quotient vs Dividend for Symmetric Integer Divsion"
  82.         16 -15 do i over smod 10 swap - I 15 + 2* swap at
  83.           219 emit loop drop ;
  84.  
  85. \ Run through the four plots for an integer divisor
  86. : intdiv ( n -- )
  87.         -10 max 10 min ?dup
  88.         if
  89.         dup dark grid fqvsm key drop
  90.         dup dark grid frvsm key drop
  91.         dup dark grid sqvsm key drop
  92.         dup dark grid srvsm key drop
  93.         drop 0 22 at
  94.         else dark ." Can't divide by zero"
  95.         then ;
  96.  
  97.  
  98.  
  99.  
  100.  
  101.