home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug083.ark / ARITH%.MUS < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.2 KB  |  149 lines
  1.  file ARITH%.MUS                              GAE - Feb. 1982
  2. Make a new version of file ARITH.MUS as follows:
  3. (1)  Start with the original file ARITH.MUS.
  4. (2)  Delete FUNCTION ^ .  This begins approximately 500 lines
  5.      from the beginning of the file.  Delete everything through
  6.      ENDFUN $ .  It is about 50 lines.
  7. (3)  In the place where the deletion was made, insert the new
  8.      FUNCTION ^ from this file (ARITH%.MUS).  It begins just
  9.      after the line ( ------ ) below, and is also about 50
  10.      lines.  It runs up to (but not including) the next line
  11.      ( ---------- ).
  12. (4)  Next delete everything between the two lines of stars
  13.      ( ******** )  This is the `optional fractional-power
  14.      package'.
  15. (5)  Replace it with the same package from this file (ARITH%.
  16.      MUS).  This is everything between the two lines of stars
  17.      ( ******** ), about 80 lines.
  18. ---------------------------------------------------------------
  19.  
  20. FUNCTION ^ (EX1, EX2),
  21.   WHEN INTEGER (EX2),
  22.     WHEN INTEGER (EX1),
  23.       WHEN EX1 EQ 1, 1 EXIT,
  24.       WHEN ZERO(EX1) AND ZERO(EX2), ?(LIST('^, EX1, EX2)) EXIT,
  25.       WHEN NEGATIVE (EX2),
  26.         WHEN ZERO (EX1), ?(LIST('^, EX1, EX2)) EXIT,
  27.         EX1: EXPT (EX1, -EX2),
  28.         WHEN NEGATIVE (EX1), -((-EX1)^-1) EXIT,
  29.     WHEN EX1 EQ 1, EX1 EXIT,
  30.         LIST ('^, EX1, -1) EXIT,
  31.       EXPT (EX1, EX2) EXIT,
  32.     WHEN EX2 EQ 1, EX1 EXIT,
  33.     WHEN ZERO (EX2) AND ZEROEXPT, 1 EXIT,
  34.     WHEN EX1 EQ #I,
  35.       EX2: MOD (EX2, 4),
  36.       WHEN EX2 EQ 2, -1 EXIT,
  37.       WHEN EX2 EQ 3, -#I EXIT,
  38.       EX1^EX2 EXIT,
  39.     WHEN ATOM (EX1), LIST ('^, EX1, EX2) EXIT,
  40.     WHEN APPLY (GET('BASE,FIRST(EX1)), ADJOIN(EX2,ARGEX(EX1))) EXIT,
  41.     LIST ('^, EX1, EX2) EXIT,
  42.   WHEN ATOM (EX1),
  43.     WHEN EX1 EQ 1, 1 EXIT,
  44.     WHEN ZERO (EX1),
  45.       WHEN EX2 < 0, ? (LIST('^, EX1, EX2))  EXIT,
  46.       WHEN EX2 > 0 OR ZEROBASE, 0,  EXIT,
  47.       LIST ('^, EX1, EX2)  EXIT,
  48.     WHEN ATOM (EX2),
  49.       WHEN EX1 EQ #E  AND  EX2 EQ #I  AND  NEGMULT(TRGEXPD,7),
  50.     COS(1) + #I*SIN(1)  EXIT,
  51.       WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR EX1<0),
  52.         LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
  53.       LIST ('^, EX1, EX2)  EXIT,
  54.     WHEN APPLY (GET('EXPON,FIRST(EX2)), ADJOIN(EX1,ARGEX(EX2)))  EXIT,
  55.     WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR NUMBER(EX2) OR EX1<0),
  56.       LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
  57.     LIST ('^, EX1, EX2)  EXIT,
  58.   WHEN APPLY (GET('EXPON,FIRST(EX2)), ADJOIN(EX1,ARGEX(EX2)))  EXIT,
  59.   WHEN APPLY (GET('BASE,FIRST(EX1)), ADJOIN(EX2,ARGEX(EX1)))  EXIT,
  60.   WHEN POSMULT(LOGEXPD,7) AND NOT(EX1=LOGBAS OR NUMBER(EX2) OR EX1<0),
  61.     LOGBAS ^ (EX2*LOG(EX1,LOGBAS))  EXIT,
  62.   LIST ('^, EX1, EX2),
  63. ENDFUN $
  64.  
  65. ------------------------------------------------------------
  66.  
  67. %************* optional fractional-power package ******************%
  68.  
  69.  
  70. PRIMES: '(2, 3, 5, 7, 11, 13, 17, 19) $
  71.  
  72. FUNCTION ROOT (EX1, EX2, EX3, LEX1, EX4, EX5, EX6,
  73.   % Local: %  EX7),
  74.   LOOP
  75.     BLOCK
  76.       WHEN ZERO (REST (EX7: DIVIDE(EX6,FIRST(LEX1)))),
  77.         EX6: FIRST(EX7),
  78.         WHEN (EX5:EX5+1) EQ EX3,  EX4: EX4*FIRST(LEX1),  EX5: 0,  EXIT EXIT,
  79.       EX5: 0,
  80.       WHEN NOT (POP(LEX1) < FIRST(EX7)), EX6: 1  EXIT,
  81.       WHEN ATOM(LEX1),
  82.         EX7: EX3 - 1,
  83.         LEX1: EX6,
  84.         LOOP
  85.           EX5: LEX1^EX7,
  86.           WHEN NOT ((EX5:QUOTIENT(EX6+EX7*LEX1*EX5,EX3*EX5)) < LEX1) EXIT,
  87.           LEX1: EX5
  88.         ENDLOOP,
  89.         WHEN LEX1^EX3 EQ EX6, EX4: EX4*LEX1,  EX6: 1  EXIT,
  90.         EX6: 1  EXIT,
  91.     ENDBLOCK,
  92.     WHEN EX6 EQ 1,
  93.       EX1: EX1/(EX4^EX3), EX4: EX4^EX2,
  94.       WHEN EX1 EQ 1, EX4 EXIT,
  95.       EX4 * LIST ('^, EX1, EX2/EX3)  EXIT
  96.   ENDLOOP,
  97. ENDFUN $
  98.  
  99. FUNCTION FREE (EX1, EX2),
  100.   WHEN EX1 = EX2, FALSE  EXIT,
  101.   WHEN ATOM(EX1)  EXIT,
  102.   LOOP
  103.     WHEN NOT FREE(POP(EX1),EX2), FALSE  EXIT,
  104.     WHEN ATOM(EX1), EXIT
  105.   ENDLOOP,
  106. ENDFUN $
  107.  
  108. PION2: #PI/2 $
  109.  
  110. PROPERTY EXPON, *, FUNCTION (EX1, EX2, EX3),
  111.   WHEN EX1 EQ #E,
  112.     WHEN INTEGER(EX2: EX2*EX3/PION2/#I), #I^EX2 EXIT,
  113.     WHEN NEGMULT(TRGEXPD,7),
  114.       WHEN FREE (EX2: EX2*PION2, #I),
  115.       COS(EX2) + #I*SIN(EX2)  EXIT EXIT EXIT,
  116.   WHEN INTEGER(EX1),
  117.     WHEN PBRCH AND INTEGER(EX2),
  118.       WHEN INTEGER(EX3:1/EX3),
  119.         WHEN EX1 > 0,
  120.           ROOT(EX1, EX2, EX3, PRIMES, 1, 0, EX1)  EXIT,
  121.         WHEN ZERO(MOD(EX3,2)),
  122.           #I^(2*EX2/EX3)*ROOT(-EX1,EX2,EX3,PRIMES,1,0,-EX1) EXIT,
  123.         (-1)^EX2 * ROOT(-EX1, EX2, EX3, PRIMES, 1, 0, -EX1)
  124.         EXIT EXIT EXIT,
  125.   WHEN EX1=#I OR EX1=-#I,
  126.     WHEN PBRCH AND INTEGER(EX2),
  127.       WHEN INTEGER(EX3:1/EX3),
  128.         WHEN EX1=#I, #E^(#I*#PI*EX2/EX3/2)  EXIT,
  129.         #E^(3*#I*#PI*EX2/EX3/2)  EXIT,
  130.       EXIT EXIT,
  131. ENDFUN $
  132.  
  133. PROPERTY EXPON, ^, FUNCTION (EX1, EX2, EX3),
  134.   WHEN INTEGER(EX1),
  135.     WHEN INTEGER(EX2),
  136.       WHEN PBRCH AND EX3 EQ -1,
  137.         WHEN EX1 > 0, ROOT (EX1, 1, EX2, PRIMES, 1, 0, EX1)  EXIT,
  138.         WHEN ZERO(MOD(EX2,2)),
  139.           #I^(2/EX2) * ROOT(-EX1, 1, EX2, PRIMES, 1, 0, -EX1)  EXIT,
  140.         -ROOT(-EX1, 1, EX2, PRIMES, 1, 0, -EX1) EXIT EXIT EXIT,
  141.   WHEN EX1=#I OR EX1=-#I,
  142.     WHEN INTEGER(EX2),
  143.       WHEN PBRCH AND EX3 EQ -1,
  144.         WHEN EX1=#I, #E^(#PI*#I/EX2/2)  EXIT,
  145.         #E^(3*#PI*#I/EX2/2)  EXIT
  146.       EXIT EXIT,
  147. ENDFUN $
  148. %****************** optional factorial package********************%
  149.