home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 026.lha / HP-10C / functions.mod < prev    next >
Encoding:
Modula Implementation  |  1987-04-02  |  6.8 KB  |  384 lines
  1. IMPLEMENTATION MODULE CalcFunctions;
  2.  
  3. (*
  4.  
  5.    This module creates the functions for the calculator.
  6.     This is the lowest level module.
  7.  
  8.     Four functions need the gadget information and are in the
  9.      Module CalcGadgets. These functions are:
  10.           STO
  11.           RCL
  12.           DEG    (toggles between degrees and radians)
  13.           GOLD   (selects alternate gadgets in display)
  14.  
  15.  
  16.    Created: Duncan Prindle,  September 10, 1986
  17.  
  18.    Modified: Perhaps
  19.  
  20. *)
  21.  
  22.  
  23. FROM MathLib0     IMPORT pi, e,
  24.                          RadToDeg, DegToRad,
  25.                          sin, cos, tan, arctan,
  26.                          exp, ln, log, power, sqrt;
  27.  
  28.  
  29.  
  30. VAR
  31.   Y         : REAL;
  32.   Z         : REAL;
  33.   T         : REAL;
  34.   TEMP      : REAL;
  35.   lastX     : REAL;
  36.  
  37.  
  38.  PROCEDURE BLANK (): ErrorType;
  39.   BEGIN
  40.    RETURN NoError;
  41.  END BLANK;
  42.  
  43.   PROCEDURE CLRStack;
  44.   BEGIN
  45.    X    := 0.0;
  46.    Y    := 0.0;
  47.    Z    := 0.0;
  48.    T    := 0.0;
  49.   END CLRStack;
  50.  
  51.   PROCEDURE StackUp;
  52.   BEGIN
  53.    T    := Z;
  54.    Z    := Y;
  55.    Y    := X;
  56.   END StackUp;
  57.  
  58.   PROCEDURE StackDown;
  59.   BEGIN
  60.    X    := Y;
  61.    Y    := Z;
  62.    Z    := T;
  63.   END StackDown;
  64.  
  65.   PROCEDURE Add (): ErrorType;
  66.   BEGIN
  67.    lastX:= X;
  68.    TEMP := X;
  69.    StackDown;
  70.    X    := X + TEMP;
  71.    RETURN NoError;
  72.  END Add;
  73.  
  74.  PROCEDURE Subtract (): ErrorType;
  75.   BEGIN
  76.    lastX:= X;
  77.    TEMP := X;
  78.    StackDown;
  79.    X    := X - TEMP;
  80.    RETURN NoError;
  81.  END Subtract;
  82.  
  83.  PROCEDURE Multiply (): ErrorType;
  84.   BEGIN
  85.    lastX:= X;
  86.    TEMP := X;
  87.    StackDown;
  88.    X    := X * TEMP;
  89.    RETURN NoError;
  90.  END Multiply;
  91.  
  92.   PROCEDURE Divide (): ErrorType;
  93.   BEGIN
  94.     IF X = 0.0  THEN
  95.       RETURN DivideByZero;
  96.      ELSE;
  97.       lastX:= X;
  98.       TEMP := X;
  99.       StackDown;
  100.       X    := X / TEMP;
  101.       RETURN NoError;
  102.     END;
  103.  END Divide;
  104.  
  105.  PROCEDURE POINT (): ErrorType;
  106.   BEGIN
  107.    IF ~SAME THEN StackUp; END;
  108.    DECI  := TRUE;
  109.    NDeci := 0;
  110.    RETURN NoError;
  111.  END POINT;
  112.  
  113.  PROCEDURE PI (): ErrorType;
  114.   BEGIN
  115.    StackUp;
  116.    X    := pi;
  117.    RETURN NoError;
  118.   END PI;
  119.  
  120.  PROCEDURE CLX (): ErrorType;
  121.   BEGIN
  122.    X    := 0.0;
  123.    RETURN NoError;
  124.  END CLX;
  125.  
  126.  PROCEDURE RDN (): ErrorType;
  127.   BEGIN
  128.    TEMP := X;
  129.    StackDown;
  130.    T    := TEMP;
  131.    RETURN NoError;
  132.  END RDN;
  133.  
  134.  PROCEDURE ENTER (): ErrorType;
  135.   BEGIN
  136.    IF SAME
  137.      THEN SAME := FALSE;
  138.      ELSE StackUp;
  139.    END;
  140.    DECI := FALSE;
  141.    NDeci:= 0;
  142.    RETURN NoError;
  143.  END ENTER;
  144.  
  145.  
  146.  PROCEDURE LASTX (): ErrorType;
  147.   BEGIN
  148.    StackUp;
  149.    X     := lastX;
  150.    RETURN NoError;
  151.  END LASTX;
  152.  
  153.  PROCEDURE SIN (): ErrorType;
  154.   BEGIN
  155.    lastX:= X;
  156.    IF INDEG THEN  X := DegToRad( X ); END;
  157.    IF ABS(X) > 2.6E5 
  158.       THEN IF INDEG THEN  X := RadToDeg( X ); END;
  159.            RETURN XTooBigForSIN;
  160.       ELSE X    := sin(X);
  161.            RETURN NoError;
  162.    END;
  163.  END SIN;
  164.  
  165.  PROCEDURE ASIN (): ErrorType;
  166.   BEGIN
  167.    IF ABS(X) > 1.0 THEN
  168.       RETURN AsinTooBig;
  169.     ELSE
  170.      lastX:= X;
  171.      IF     X =  1.0 THEN X :=  pi/2.0;
  172.       ELSIF X = -1.0 THEN X := -pi/2.0;
  173.       ELSE  X := arctan( X / sqrt(1.0-X*X));
  174.      END;
  175.      IF INDEG THEN  X := RadToDeg( X ); END;
  176.      RETURN NoError;
  177.    END;
  178.  END ASIN;
  179.  
  180.  PROCEDURE COS (): ErrorType;
  181.   BEGIN
  182.    lastX:= X;
  183.    IF INDEG THEN  X := DegToRad( X ); END;
  184.    IF ABS(X) > 2.6E5
  185.       THEN IF INDEG THEN  X := RadToDeg( X ); END;
  186.            RETURN XTooBigForCOS;
  187.       ELSE X    := cos(X);
  188.            RETURN NoError;
  189.    END;
  190.  END COS;
  191.  
  192.  PROCEDURE ACOS (): ErrorType;
  193.   BEGIN
  194.    IF ABS(X) > 1.0 THEN
  195.       RETURN AcosTooBig;
  196.     ELSE
  197.       lastX:= X;
  198.       IF     X =  1.0 THEN X := 0.0;
  199.        ELSIF X = -1.0 THEN X := pi;
  200.        ELSE  X := pi/2.0 - arctan( X / sqrt(1.0-X*X) );
  201.       END;
  202.       IF INDEG THEN  X := RadToDeg( X ); END;
  203.       RETURN NoError;
  204.    END;
  205.  END ACOS;
  206.  
  207.  PROCEDURE TAN (): ErrorType;
  208.   BEGIN
  209.    lastX:= X;
  210.    IF INDEG THEN  X := DegToRad( X ); END;
  211.    IF X > 6.5E4
  212.       THEN IF INDEG THEN  X := RadToDeg( X ); END;
  213.            RETURN XTooBigForTAN;
  214.     ELSIF ABS(cos(X)) < 1.0E-6
  215.       THEN IF INDEG THEN  X := RadToDeg( X ); END;
  216.            RETURN piOver2;
  217.     ELSE   X    := tan(X);
  218.            RETURN NoError;
  219.    END;
  220.  END TAN;
  221.  
  222.  PROCEDURE ATAN (): ErrorType;
  223.   BEGIN
  224.    lastX:= X;
  225.    X    := arctan(X);
  226.    IF INDEG THEN  X := RadToDeg( X ); END;
  227.    RETURN NoError;
  228.  END ATAN;
  229.  
  230.  PROCEDURE LN (): ErrorType;
  231.   BEGIN
  232.   IF X <= 0.0 THEN
  233.      RETURN NegLn;
  234.     ELSE
  235.      lastX:= X;
  236.      X    := ln(X);
  237.      RETURN NoError;
  238.   END;
  239.  END LN;
  240.  
  241.  PROCEDURE EXP (): ErrorType;
  242.   BEGIN
  243.   IF ABS(X) > 88.0 THEN
  244.       RETURN OverFlow;
  245.    ELSE
  246.       lastX:= X;
  247.       X    := exp(X);
  248.       RETURN NoError;
  249.   END;
  250.  END EXP;
  251.  
  252.  PROCEDURE TENtotheX (): ErrorType;
  253.   BEGIN
  254.   IF ABS(X) > 38.0 THEN
  255.       RETURN OverFlow;
  256.    ELSE
  257.      lastX:= X;
  258.      X    := power( 10.0, X);
  259.      RETURN NoError;
  260.   END;
  261.  END TENtotheX;
  262.  
  263.  PROCEDURE LOG (): ErrorType;
  264.   BEGIN
  265.   IF X <= 0.0 THEN
  266.      RETURN NegLog;
  267.     ELSE
  268.      lastX:= X;
  269.      X    := log(X);
  270.      RETURN NoError;
  271.   END;
  272.  END LOG;
  273.  
  274.  PROCEDURE YtotheX (): ErrorType;
  275.   BEGIN
  276.    lastX:= X;
  277.    Y    := power( Y, X);
  278.    StackDown;
  279.    RETURN NoError;
  280.  END YtotheX;
  281.  
  282.  PROCEDURE OneOverX (): ErrorType;
  283.   BEGIN
  284.   IF X = 0.0 THEN
  285.       RETURN DivideByZero;
  286.     ELSE
  287.       lastX:= X;
  288.       X    := 1.0/X;
  289.       RETURN NoError;
  290.   END;
  291.  END OneOverX;
  292.  
  293.  PROCEDURE XSquared (): ErrorType;
  294.   BEGIN
  295.   IF ABS(X) > 1.8E19 THEN
  296.      RETURN OverFlow;
  297.    ELSE
  298.      lastX:= X;
  299.      X    := X * X;
  300.      RETURN NoError;
  301.   END;
  302.  END XSquared;
  303.  
  304.  PROCEDURE SQRT (): ErrorType;
  305.   BEGIN
  306.   IF X < 0.0 THEN
  307.      RETURN NegSqrt;
  308.    ELSE
  309.      lastX:= X;
  310.      X    := sqrt( X );
  311.      RETURN NoError;
  312.   END;
  313.  END SQRT;
  314.  
  315.  PROCEDURE XtoY (): ErrorType;
  316.   BEGIN
  317.    TEMP := X;
  318.    X    := Y;
  319.    Y    := TEMP;
  320.    RETURN NoError;
  321.  END XtoY;
  322.  
  323.  PROCEDURE CHS (): ErrorType;
  324.   BEGIN
  325.    X    := -X;
  326.    RETURN NoError;
  327.  END CHS;
  328.  
  329.  PROCEDURE CLRST (): ErrorType;
  330.   BEGIN
  331.    CLRStack;
  332.    RETURN NoError;
  333.  END CLRST;
  334.  
  335.  PROCEDURE EXTENDX( Digit: CARDINAL );
  336.    VAR I : INTEGER;
  337.  
  338.    BEGIN
  339.     IF SAME THEN
  340.       IF DECI
  341.          THEN NDeci := NDeci + 1;
  342.               IF X > 0.0
  343.                  THEN X := X + FLOAT( Digit ) / 
  344.                                power( 10.0, FLOAT( CARDINAL(ABS(NDeci)) ));
  345.                  ELSE X := X - FLOAT( Digit ) / 
  346.                                power( 10.0, FLOAT( CARDINAL(ABS(NDeci)) ));
  347.               END;
  348.          ELSE IF X > 0.0
  349.                  THEN X := FLOAT(10) * X + FLOAT( Digit );
  350.                  ELSE X := FLOAT(10) * X - FLOAT( Digit );
  351.               END;
  352.       END;
  353.      ELSE
  354.       StackUp;
  355.       SAME := TRUE;
  356.       IF DECI
  357.          THEN NDeci := 1;
  358.               X     := FLOAT( Digit ) / 10.0;
  359.          ELSE X     := FLOAT( Digit );
  360.       END;
  361.     END;
  362.  END EXTENDX;
  363.  
  364.  
  365.  
  366. BEGIN
  367.  
  368.  (* Initialize variables *)
  369.   X         := 0.0;
  370.   Y         := 0.0;
  371.   Z         := 0.0;
  372.   T         := 0.0;
  373.   TEMP      := 0.0;
  374.   lastX     := 0.0;
  375.   SAME      := FALSE;
  376.   INDEG     := FALSE;
  377.   DECI      := FALSE;
  378.   FOR NDeci := 0 TO 9 DO
  379.      stored[NDeci]    := 0.0;
  380.   END;
  381.   NDeci     := 0;
  382.  
  383. END CalcFunctions.
  384.