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. PROCEDURE Zaehler;
  59.  
  60. BEGIN
  61.         i := i + 1;
  62.         WriteString(" Global:");
  63.         WriteCard   (i,3);
  64.         Write(" ");
  65. END Zaehler;
  66.  
  67.  
  68. PROCEDURE Message(Proz : CARDINAL;
  69.                   Break: CHAR);
  70.  
  71. BEGIN (* Message *)
  72.         WriteLn;
  73.         WriteString("Routine");
  74.         WriteCard  (Proz,1);
  75.         WriteString(" Testpunkt ");
  76.         Write      (Break);
  77.         Zaehler;
  78. END Message;
  79.  
  80.  
  81. PROCEDURE Menue;
  82.  
  83. VAR hlp : CHAR;
  84.  
  85. BEGIN   (* Menue *)
  86.         WriteLn;
  87.         WriteLn; WriteString("Tastatur waehrend des Programmablaufs");
  88.         WriteLn; WriteString("1              -> Wechsel nach Routine 1");
  89.         WriteLn; WriteString("2              -> Wechsel nach Routine 2");
  90.         WriteLn; WriteString("3              -> Wechsel nach Routine 3");
  91.         WriteLn; WriteString("H              -> Hilfsmenue");
  92.         WriteLn; WriteString("E              -> Ende des Programmes");
  93.         WriteLn; WriteString("Keine Taste    -> Pause ");
  94.         WriteLn; WriteString("Uebrige Tasten -> Programmablauf");
  95.         WriteLn;
  96.         WriteLn; WriteString("Programmstart mit jeder Taste");
  97.         ReadChar(hlp);
  98. END Menue;
  99.  
  100.  
  101. PROCEDURE ChangeRoutine(VAR proc :PROCESS);
  102.  
  103. VAR hlp : CHAR;
  104.  
  105. BEGIN
  106.         ReadChar(hlp);
  107.         hlp := CAP(hlp);
  108.         CASE hlp OF
  109.           | "1" : TRANSFER(proc,proc1)
  110.           | "2" : TRANSFER(proc,proc2)
  111.           | "3" : TRANSFER(proc,proc3)
  112.           | "E" : TRANSFER(proc,main)
  113.           | "H" : Menue
  114.         ELSE
  115.         (* garnichts *)
  116.         END; (* CASE *)
  117. END ChangeRoutine;
  118.  
  119.  
  120. PROCEDURE error;
  121.  
  122. BEGIN
  123.   LOOP
  124.         WriteLn;
  125.         WriteString(errMessage);
  126.         NewInstall := TRUE;
  127.         TRANSFER(err,main);
  128.   END (* LOOP *);
  129. END error;
  130.  
  131.  
  132. PROCEDURE Routine1;
  133.  
  134. VAR a,b,c: REAL;
  135.  
  136. BEGIN
  137.         a := 1.2;
  138.         b := 10.;
  139.         LOOP
  140.                 Message(1,"A");                          (* Testpunkt A *)
  141.                 c := a+b;
  142.                 WriteString("Adition ");
  143.                 WriteReal(c,3,3);
  144.                 ChangeRoutine(proc1);
  145.                 Message(1,"B");                          (* Testpunkt B *)
  146.                 c := b*a;
  147.                 WriteString("Multiplikation ");
  148.                 WriteReal(c,3,3);
  149.                 ChangeRoutine(proc1);
  150.                 Message(1,"C");                          (* Testpunkt C *)
  151.                 IF c = 0. THEN
  152.                   errMessage  := "Division durch 0 in Routine 1";
  153.                   error;
  154.                 END (* IF *);
  155.                 c := a/b;
  156.                 WriteString("Division ");
  157.                 WriteReal(c,3,3);
  158.                 ChangeRoutine(proc1);
  159.                 a := c+2.3;
  160.                 b := b - 0.5; (* Hier wird das gelegentl. Auftreten einer *)
  161.         END (* LOOP *);       (* Div. durch 0 provoziert, um die Fehler-  *)
  162. END Routine1;                 (* behandlung zu demonstieren               *)
  163.  
  164.  
  165. PROCEDURE Routine2;
  166.  
  167. BEGIN
  168.         LOOP
  169.                 Message(2,"X");                            (* Testpunkt X *)
  170.                 WriteString("Tick ");
  171.                 ChangeRoutine(proc2);
  172.                 Message(2,"Y");                            (* Testpunkt Y *)
  173.                 WriteString("Tack ");
  174.                 ChangeRoutine(proc2);
  175.         END (* LOOP *);
  176. END Routine2;
  177.  
  178.  
  179. PROCEDURE Routine3; (* Diese Prozedur ist keine endlose Schleife. Sie *)
  180.                     (* wuerde am Ende zu einem Run-Time-Error wegen   *)
  181. VAR ch : CHAR;      (* Verlassens eines PROCESS fuehren               *)
  182.  
  183. BEGIN
  184.   FOR ch := "A" TO "Z" DO
  185.                 Message(3,"N");                          (*  Testpunkt N *)
  186.                 WriteString("Buchstabenreihe :");
  187.                 Write(ch);
  188.                 ChangeRoutine(proc3);
  189.   END (* FOR *);
  190.   errMessage  := "Routinenende in Routine 3 erreicht";
  191.   error;                                           (* Hier wird das Ende *)
  192. END Routine3;                                      (* des PROCESS ab-    *)
  193.                                                    (* gefangen           *)
  194.  
  195. BEGIN  (* Beginn des Hauptprogramms *)
  196.   ClearScreen;
  197.   WriteLn; WriteString("Demoprogramm fuer Coroutinen");
  198.   WriteLn;
  199.   WriteLn;
  200.   (* Initialisierung *)
  201.   i := 0;
  202.   REPEAT
  203.         NewInstall:= FALSE;
  204.         Menue;
  205.         (* Einrichten der Prozesse *)
  206.         NEWPROCESS(error,    ADR(errorSp), SIZE(errorSp),err);
  207.         NEWPROCESS(Routine1, ADR(Proc1Sp), SIZE(Proc1Sp),proc1);
  208.         NEWPROCESS(Routine2, ADR(Proc2Sp), SIZE(Proc2Sp),proc2);
  209.         NEWPROCESS(Routine3, ADR(Proc3Sp), SIZE(Proc3Sp),proc3);
  210.         (* Uebergabe an Routine 1 *)
  211.         TRANSFER(main,proc1);
  212.     UNTIL NOT NewInstall;
  213.     (* Hauptprozess wird wieder aufgenommen und beendet *)
  214.     WriteLn; WriteString("Ende des Programmes Routinen");
  215. END Routinen.
  216.