home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / quellen / calcsimp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  2.6 KB  |  90 lines
  1. (*****************************************************************************)
  2. (*                              CALCSIMP.PAS                                 *)
  3. (*                                                                           *)
  4. (*                     Vereinfachen von Calc-Programmen                      *)
  5. (*****************************************************************************)
  6.  
  7.  
  8. PROCEDURE calcsimplify(VAR pptr : calc_prog);
  9.  
  10. VAR pptr1,help1,help2 : calc_prog;
  11.     op : INTEGER;
  12.     dummy : calc_operand;
  13.     arg1,arg2,simpleError : BOOLEAN;
  14.     helpinstruct : calc_symbols;
  15.  
  16.   FUNCTION equal(pptr1,pptr2 : calc_prog) : BOOLEAN;
  17.  
  18.   VAR help1,help2 : calc_prog;
  19.       check : BOOLEAN;
  20.  
  21.   BEGIN
  22.     help1 := endof(pptr1);
  23.     help2 := endof(pptr2);
  24.     IF (pptr1 <> nil) AND (pptr2 <> nil) AND (help1 <> nil) AND (help2 <>
  25.         nil)
  26.       THEN
  27.         BEGIN
  28.           check := TRUE;
  29.           REPEAT
  30.             check := check AND (pptr1^.instruct = pptr2^.instruct);
  31.             CASE pptr1^.instruct OF 
  32.               calc_const : check := check AND (pptr1^.operand = pptr2^.
  33.                                       operand);
  34.               calc_var   : check := check AND (pptr1^.varindex = pptr2^.
  35.                                       varindex)
  36.             END;
  37.             pptr1 := pptr1^.nextinst;
  38.             pptr2 := pptr2^.nextinst
  39.           UNTIL NOT check OR (pptr1 = help1^.nextinst) AND (pptr2 = help2^.
  40.                   nextinst);
  41.           equal := check
  42.         END
  43.       ELSE
  44.         equal := FALSE
  45.   END;
  46.  
  47.   FUNCTION compute(pptr,pptr1,pptr2 : calc_prog) : calc_operand;
  48.  
  49.   VAR exptr,a,b,c : calc_prog;
  50.       vardummy : calc_vartab;
  51.  
  52.   BEGIN
  53.     IF heapavail > 160.0
  54.       THEN
  55.         BEGIN
  56.           vardummy := newvartab;
  57.           New(a);
  58.           New(b);
  59.           New(c);
  60.           a^ := pptr^;
  61.           b^ := pptr1^;
  62.           IF pptr2 <> nil
  63.             THEN
  64.               c^ := pptr2^;
  65.           a^.nextinst := nil;
  66.           New(exptr);
  67.           exptr^.nextinst := b;
  68.           IF pptr2 <> nil
  69.             THEN
  70.               BEGIN
  71.                 b^.nextinst := c;
  72.                 c^.nextinst := a
  73.               END
  74.             ELSE
  75.               b^.nextinst := a;
  76.           compute := calcexpression(exptr,vardummy);
  77.           SimpleError := SimpleError or not calcresult;
  78.           Dispose(a);
  79.           Dispose(b);
  80.           Dispose(c);
  81.           Dispose(exptr);
  82.           killvartab(vardummy)
  83.         END
  84.       else
  85.         BEGIN
  86.           compute := 0.0;
  87.           SimpleError := true
  88.         END
  89.   END;
  90.