home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 08 / calc / calcutil.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-22  |  5.7 KB  |  149 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                           CALCUTIL.PAS                                  *)
  3. (* Dieses Modul enthaelt die 'Laufzeit-'Fehlerbehandlung, Routinen zur     *)
  4. (* Verwaltung der dynamischen Calc-Groessen, sowie ein paar Dinge, die das *)
  5. (* das Leben mit Calc erleichtern sollen.                                  *)
  6.  
  7. (* ----------------------------------------------------------------------- *)
  8. (* Wird von 'CalcExpression' und der Mathe-Bibliothek MATHFUNC.PAS be-     *)
  9. (* noetigt, um bei auftretenden Fehlern nicht gleich aus dem Programm zu   *)
  10. (* fliegen:                                                                *)
  11.  
  12. PROCEDURE CalcError (ErrNum: INTEGER; Message: ErrString);
  13.  
  14. BEGIN
  15.   WriteLn;  WriteLn;  WriteLn('*** Laufzeitfehler:');  Write('    ');
  16.   CASE ErrNum OF
  17.     1: Write('Gleitkommaueberlauf');
  18.     2: Write('Division durch Null');
  19.     3: Write('Argumentfehler in ');
  20.     ELSE ;
  21.   END;
  22.   WriteLn(' ', Message, ' !');  WriteLn;
  23.   CalcResult := FALSE;                       (* Auswertung abbrechen ! *)
  24. END;
  25.  
  26. (* ----------------------------------------------------------------------- *)
  27. (* Noch freien Platz im Heap ermitteln. Auf PCs wird die Anzahl noch frei- *)
  28. (* er Paragraphen (1 Paragr. = 16 Bytes) von MemAvail geliefert. Unter     *)
  29. (* CP/M ergibt MemAvail einen neg. Wert, wenn mehr als 32k frei sind:      *)
  30.  
  31. FUNCTION HeapAvail: REAL;
  32.  
  33. (* fuer MS-DOS: *)
  34. BEGIN HeapAvail := MemAvail * 16.0 END;
  35.  
  36. (* fuer CP/M:
  37. VAR temp: REAL;
  38. BEGIN
  39.   temp := MemAvail;
  40.   IF temp < 0.0 THEN temp := 65536.0 + temp;
  41.   HeapAvail := temp;
  42. END;
  43. *)
  44. (* ----------------------------------------------------------------------- *)
  45. (* Ein nicht mehr benoetigtes Calc-Prog. (UPN_Queue) wieder aus dem Heap   *)
  46. (* entfernen! Wird bei fehlerhafter Uebersetzung von 'CompileExpression'   *)
  47. (* aufgerufen, um erzeugten 'Muell' wieder zu entfernen. Sollte vom Anwen- *)
  48. (* der fuer nicht mehr benoetigte, uebersetzte Ausdruecke benutzt werden,  *)
  49. (* um keinen Heap-Ueberlauf zu provozieren!                                *)
  50.  
  51. PROCEDURE KillExpression (VAR ExprPtr: Calc_Prog);
  52.  
  53. VAR NextPtr: Calc_Prog;
  54.  
  55. BEGIN
  56.    WHILE ExprPtr <> NIL DO
  57.    BEGIN
  58.       NextPtr := ExprPtr^.NextInst;  Dispose(ExprPtr);  ExprPtr := NextPtr
  59.    END;
  60.    ExprPtr := NIL;
  61. END;
  62.  
  63. (* ----------------------------------------------------------------------- *)
  64. (* Eine neue, leere Variablen-Tabelle im Heap anlegen. Siehe dazu Begleit- *)
  65. (* artikel, 'CompileExpression' und 'CalcExpression'.                      *)
  66.  
  67. FUNCTION NewVarTab: Calc_VarTab;
  68.  
  69. VAR VarTab: Calc_VarTab;
  70.  
  71. BEGIN
  72.   NewVarTab := NIL;
  73.   IF HeapAvail > Calc_MaxVar * (Calc_OpSize+Calc_Idlen) + 100 THEN
  74.     BEGIN
  75.       New(VarTab);  VarTab^[0].Value := 0.0;  NewVarTab := VarTab
  76.     END
  77.   ELSE CalcError(0, 'nicht genuegend freier Speicher fuer Var.-Tabelle')
  78. END;
  79.  
  80. (* ----------------------------------------------------------------------- *)
  81. (*  Eine nicht mehr benoetigte Variablen-Tabelle aus dem Heap entfernen:   *)
  82.  
  83. PROCEDURE KillVarTab (VAR VarTab: Calc_VarTab);
  84.  
  85. BEGIN  Dispose(VarTab);  VarTab := NIL  END;
  86.  
  87. (* ----------------------------------------------------------------------- *)
  88. (*  Variable mit dem Bezeichner 'Id' in Tabelle 'VarTab' suchen. Ist sie   *)
  89. (*  nicht enthalten, wird der Wert 0 zurueckgegeben, sonst der Index in    *)
  90. (*  die Tabelle.                                                           *)
  91.  
  92. FUNCTION SearchVarTab (VarTab: Calc_VarTab; Id: Calc_String): INTEGER;
  93.  
  94. VAR i: INTEGER;
  95.  
  96. BEGIN
  97.    i := Trunc(VarTab^[0].Value); VarTab^[0].VarId := Copy(Id, 1, Calc_IdLen);
  98.    WHILE VarTab^[i].VarId <> Id DO i := Pred(i);
  99.    SearchVarTab := i
  100. END;
  101.  
  102. (* ----------------------------------------------------------------------- *)
  103. (* Variable mit dem Bezeichner 'Id' in Tabelle 'VarTab' an naechste freie  *)
  104. (* Position aufnehmen. Zurueckgegeben wird diese Position. Ist kein Platz  *)
  105. (* mehr in der Tabelle, wird -1 zurueckgegeben.                            *)
  106.  
  107. FUNCTION AddToVarTab (VarTab: Calc_VarTab; Id: Calc_String): INTEGER;
  108.  
  109. VAR i: INTEGER;
  110.  
  111. BEGIN
  112.   i := Trunc(VarTab^[0].Value);
  113.   IF i < Calc_MaxVar THEN
  114.      BEGIN
  115.         i := Succ(i);  VarTab^[0].Value := i;
  116.         VarTab^[i].VarId := Id;  VarTab^[i].Value := 0
  117.      END
  118.   ELSE i := -1;
  119.   AddToVarTab := i
  120. END;
  121.  
  122. (* ----------------------------------------------------------------------- *)
  123. (* Variable an der Position 'i' in einer Variablen-Tabelle den Wert 'x'    *)
  124. (* zuweisen:                                                               *)
  125.  
  126. PROCEDURE AssignVarI (VarTab: Calc_VarTab; i: INTEGER; x: Calc_Operand);
  127.  
  128. BEGIN
  129.    IF (i > 0) AND (i <= Trunc(VarTab^[0].Value)) THEN
  130.       VarTab^[i].Value := x
  131.    ELSE
  132.       CalcError(0, 'Wertzuweisung an unbekannte Variable')
  133. END;
  134.  
  135. (* ----------------------------------------------------------------------- *)
  136. (*             ...  und der Variablen mit Bezeichner 'Id':                 *)
  137.  
  138. PROCEDURE AssignVar (VarTab: Calc_VarTab; Id: Calc_String; x: Calc_Operand);
  139.  
  140. BEGIN  AssignVarI(VarTab, SearchVarTab(VarTab, Id), x)  END;
  141.  
  142. (* ----------------------------------------------------------------------- *)
  143. (* es koennten noch Funktionen zur komfortablen, dialoggesteuerten Ein-    *)
  144. (* gabe/Aenderung aller in einer Tabelle enthaltenen Calc-Variablen fol-   *)
  145. (* gen. Hier kann der Anwender gemaess seines Problems und seiner Fan-     *)
  146. (* tasie walten...                                                         *)
  147. (* ----------------------------------------------------------------------- *)
  148. (*                     Ende von CALCUTIL.PAS                               *)
  149.