home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / prozess.mod < prev    next >
Encoding:
Text File  |  1987-08-09  |  7.1 KB  |  216 lines
  1. (*
  2. Title       : Routinen:
  3.               Demoprogramm fuer Coroutinen
  4. Last Edit   : 12.6.87.
  5. Author      : Joerg BEYER
  6. System      : CP/M Turbo MODULA-2 Beta-Version
  7. *)
  8.  
  9. (* Bitte beachten Sie, dass es trotz der relativ strengen Normen von MOUDLA-2
  10.  unterschiedliche Implementierungen mit gewissen Unterschieden gibt. Dies
  11.  gilt besonders fuer die Biliotheksprozeduren. Die verwendeten SYSTEM-Pro-
  12.  zeduren und Typen entsprechen allerdings dem Wirth'schen Standard. *)
  13.  
  14. MODULE Routinen;
  15.  
  16. FROM InOut    IMPORT WriteCard,
  17.                      WriteReal,
  18.                      WriteString,
  19.                      Write,
  20.                      WriteLn;
  21.  
  22. FROM Terminal IMPORT ReadChar,
  23.                      ClearScreen;
  24.  
  25. FROM SYSTEM   IMPORT WORD,      (* Typ zur Speicherverwaltung *)
  26.                      PROCESS,   (* Typ eines Coprozesses *)
  27. (* In neueren MODULA-2 Implementationen wird statt PROCESS ADDRESS verwendet.
  28. Dies entspricht der neuesten Sprachdefinition von Niklaus Wirth
  29. (Programmieren in Modula-2 3.Auflage *)
  30.                      ADR,       (* Typ zum Bestimmen von Speicheradressen *)
  31.                      NEWPROCESS,(* Installation des Prozesspeichers *)
  32.                      TRANSFER;  (* Befehl zum Wechsel zwischen zwei *)
  33.                                 (* Coroutinen *)
  34.  
  35. CONST   BufferSize    = 500;    (* fuer Prozessbuffergroesse in BYTE *)
  36.  
  37. TYPE    RoutineBuffer = ARRAY (. 0..((BufferSize DIV 2) -1) .) OF WORD;
  38.                               (* (. und .) kann in vielen Compilern statt *)
  39.                               (* eckiger Klammern verwendet werden *)
  40. VAR     main,
  41.         proc1,
  42.         proc2,
  43.         proc3,
  44.         err     :         PROCESS; (* Prozessvariable, der eine Prozedur *)
  45.                                    (* zugewiesen wird                    *)
  46.         Proc1Sp,                   (* Variablen, die Speicherplatz fuer *)
  47.         Proc2Sp,                   (* regionale PROCESS-Variablen frei- *)
  48.         Proc3Sp,                   (* halten                            *)
  49.         errorSp :         RoutineBuffer;
  50.  
  51.         VAR i : CARDINAL;                  (* globaler Schleifenzaehler *)
  52.  
  53.         errMessage  :       ARRAY (. 0..79 .) OF CHAR;
  54.                                            (* String fuer Fehlermeldung *)
  55.         NewInstall  :       BOOLEAN; (* Schleifenkontrolle f. Hauptpgm. *)
  56.  
  57.  
  58.  
  59. PROCEDURE Zaehler;
  60.  
  61. BEGIN
  62.         i := i + 1;
  63.         WriteString(" Global:");
  64.         WriteCard   (i,3);
  65.         Write(" ");
  66. END Zaehler;
  67.  
  68.  
  69. PROCEDURE Message(Proz : CARDINAL;
  70.                   Break: CHAR);
  71.  
  72. BEGIN (* Message *)
  73.         WriteLn;
  74.         WriteString("Routine");
  75.         WriteCard  (Proz,1);
  76.         WriteString(" Testpunkt ");
  77.         Write      (Break);
  78.         Zaehler;
  79. END Message;
  80.  
  81.  
  82. PROCEDURE Menue;
  83.  
  84. VAR hlp : CHAR;
  85.  
  86. BEGIN   (* Menue *)
  87.         WriteLn;
  88.         WriteLn; WriteString("Tastatur waehrend des Programmablaufs");
  89.         WriteLn; WriteString("1              -> Wechsel nach Routine 1");
  90.         WriteLn; WriteString("2              -> Wechsel nach Routine 2");
  91.         WriteLn; WriteString("3              -> Wechsel nach Routine 3");
  92.         WriteLn; WriteString("H              -> Hilfsmenue");
  93.         WriteLn; WriteString("E              -> Ende des Programmes");
  94.         WriteLn; WriteString("Keine Taste    -> Pause ");
  95.         WriteLn; WriteString("Uebrige Tasten -> Programmablauf");
  96.         WriteLn;
  97.         WriteLn; WriteString("Programmstart mit jeder Taste");
  98.         ReadChar(hlp);
  99. END Menue;
  100.  
  101.  
  102. PROCEDURE ChangeRoutine(VAR proc :PROCESS);
  103.  
  104. VAR hlp : CHAR;
  105.  
  106. BEGIN
  107.         ReadChar(hlp);
  108.         hlp := CAP(hlp);
  109.         CASE hlp OF
  110.           | "1" : TRANSFER(proc,proc1)
  111.           | "2" : TRANSFER(proc,proc2)
  112.           | "3" : TRANSFER(proc,proc3)
  113.           | "E" : TRANSFER(proc,main)
  114.  
  115.           | "H" : Menue
  116.         ELSE
  117.         (* garnichts *)
  118.         END; (* CASE *)
  119. END ChangeRoutine;
  120.  
  121.  
  122. PROCEDURE error;
  123.  
  124. BEGIN
  125.   LOOP
  126.         WriteLn;
  127.         WriteString(errMessage);
  128.         NewInstall := TRUE;
  129.         TRANSFER(err,main);
  130.   END (* LOOP *);
  131. END error;
  132.  
  133.  
  134. PROCEDURE Routine1;
  135.  
  136. VAR a,b,c: REAL;
  137.  
  138. BEGIN
  139.         a := 1.2;
  140.         b := 10.;
  141.         LOOP
  142.                 Message(1,"A");                          (* Testpunkt A *)
  143.                 c := a+b;
  144.                 WriteString("Adition ");
  145.                 WriteReal(c,3,3);
  146.                 ChangeRoutine(proc1);
  147.                 Message(1,"B");                          (* Testpunkt B *)
  148.                 c := b*a;
  149.                 WriteString("Multiplikation ");
  150.                 WriteReal(c,3,3);
  151.                 ChangeRoutine(proc1);
  152.                 Message(1,"C");                          (* Testpunkt C *)
  153.                 IF c = 0. THEN
  154.                   errMessage  := "Division durch 0 in Routine 1";
  155.                   error;
  156.                 END (* IF *);
  157.                 c := a/b;
  158.                 WriteString("Division ");
  159.                 WriteReal(c,3,3);
  160.                 ChangeRoutine(proc1);
  161.                 a := c+2.3;
  162.                 b := b - 0.5; (* Hier wird das gelegentl. Auftreten einer *)
  163.         END (* LOOP *);       (* Div. durch 0 provoziert, um die Fehler-  *)
  164. END Routine1;                 (* behandlung zu demonstieren               *)
  165.  
  166.  
  167. PROCEDURE Routine2;
  168.  
  169. BEGIN
  170.         LOOP
  171.                 Message(2,"X");                            (* Testpunkt X *)
  172.                 WriteString("Tick ");
  173.                 ChangeRoutine(proc2);
  174.  
  175.                 Message(2,"Y");                            (* Testpunkt Y *)
  176.                 WriteString("Tack ");
  177.                 ChangeRoutine(proc2);
  178.         END (* LOOP *);
  179. END Routine2;
  180.  
  181.  
  182. PROCEDURE Routine3; (* Diese Prozedur ist keine endlose Schleife. Sie *)
  183.                     (* wuerde am Ende zu einem Run-Time-Error wegen   *)
  184. VAR ch : CHAR;      (* Verlassens eines PROCESS fuehren               *)
  185.  
  186. BEGIN
  187.   FOR ch := "A" TO "Z" DO
  188.                 Message(3,"N");                          (*  Testpunkt N *)
  189.                 WriteString("Buchstabenreihe :");
  190.                 Write(ch);
  191.                 ChangeRoutine(proc3);
  192.   END (* FOR *);
  193.   errMessage  := "Routinenende in Routine 3 erreicht";
  194.   error;                                           (* Hier wird das Ende *)
  195. END Routine3;                                      (* des PROCESS ab-    *)
  196.                                                    (* gefangen           *)
  197.  
  198. BEGIN  (* Beginn des Hauptprogramms *)
  199.   ClearScreen;
  200.   WriteLn; WriteString("Demoprogramm fuer Coroutinen");
  201.   WriteLn;
  202.   WriteLn;
  203.   (* Initialisierung *)
  204.   i := 0;
  205.   REPEAT
  206.         NewInstall:= FALSE;
  207.         Menue;
  208.         (* Einrichten der Prozesse *)
  209.         NEWPROCESS(error,    ADR(errorSp), SIZE(errorSp),err);
  210.         NEWPROCESS(Routine1, ADR(Proc1Sp), SIZE(Proc1Sp),proc1);
  211.         NEWPROCESS(Routine2, ADR(Proc2Sp), SIZE(Proc2Sp),proc2);
  212.         NEWPROCESS(Routine3, ADR(Proc3Sp), SIZE(Proc3Sp),proc3);
  213.         (* Uebergabe an Routine 1 *)
  214.         TRANSFER(main,proc1);
  215.     UNTIL NOT NewInstall;
  216.     (* Hauptprozess wird wieder aufgenommen und beendet *)
  217.     WriteLn; WriteString("Ende des Programmes Routinen");
  218. END Routinen.
  219.