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