DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦bd38c9c39⟧ TextFile

    Length: 21760 (0x5500)
    Types: TextFile
    Names: »TESTVER5.RTP«

Derivation

└─⟦316f7fc78⟧ Bits:30010522 DVBS1.SW2114.src.2.7-4 SW2114 4/4 Real Time Pascal 2.7 til old rtp 92.06.10
    └─⟦this⟧ »OLDRTP\TESTVER5.RTP« 
└─⟦3651f6bb8⟧ Bits:30010514 DVBS1.SW2114.src.2.14-4 SW2114 REAL #4/4 TIME PASCAL SOURCE REL 2.14 92.09.01
    └─⟦this⟧ »OLDRTP\TESTVER5.RTP« 
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
    └─⟦this⟧ »OLDRTP\TESTVER5.RTP« 
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
    └─⟦this⟧ »OLDRTP\TESTVER5.RTP« 

TextFile

(*  ******RTP compiler test. Test  Version 5 ****************)\r
\r
systemtest;\r
const\r
ni = 9;\r
\r
procedure writeName( VAR z : Zone; INSPECT name : String); external;\r
\r
(*test5daenv;*)\r
  type\r
    arrType = Array(1..3) OF Integer;\r
\r
.\r
\r
\r
 \r
\r
(***********************************************************)\r
(***********************************************************)\r
(****************** test version 5 *************************)\r
(***********************************************************)\r
Program TestVer5(Shared fin,OK : boolean);\r
Var\r
\r
\r
 ZoneVar : Zone;\r
\r
 Test5Ok : Boolean;\r
 OK1 : Boolean;\r
 Process5DA : Process;\r
 Linkok : Link_Result;\r
 CreateOK : Create_Result;\r
 Shared\r
   Test5DAOK : boolean := false;\r
   Test5DAEnd : boolean := false;\r
\r
\r
\r
 (* Variable for test5ca *)\r
   var\r
    \r
   \r
   Test5CA_y : Reference;\r
   Test5CA_x : chain;\r
   Test5CA_f : pool;\r
   Test5CA_s : mailbox;\r
   Test5CA_e :process;\r
   Test5CA_p : port;\r
\r
\r
  (* Variable and types For test5cb *)\r
   type\r
   trec = record\r
             x : boolean;\r
             l : array(1..2) of reference;\r
          End;\r
   sss = array(1..4) of record\r
                          s : integer;\r
                          m : mailbox;\r
                        END;\r
   \r
   var\r
   \r
   Test5CB_ss : sss; \r
   Test5CB_f : trec;\r
   Test5CB_y : array(-1..10) of process;\r
\r
\r
 (* variabel for test5d *)\r
   shared\r
    \r
   \r
   Test5d_y, Test5d_index : integer := 24;\r
   Test5d_x : boolean := true;\r
   Test5d_f : record\r
                 x : integer;\r
                 y : boolean;\r
              end;\r
    Test5d_Arr : Array(1..10) OF Integer;\r
   \r
\r
  (* variable for test5db  *)\r
\r
    var high : integer := 10;\r
    shared\r
     \r
    \r
    Test5db_y,Test5db_index : integer := 24;\r
    Test5db_x : boolean := true;\r
    Test5db_f : record\r
             x : integer;\r
             y : boolean;\r
            end;\r
    shared\r
    Test5db_Arr : Array(1..high) OF Integer;\r
    \r
\r
   (********************* TEST5A ***********************)\r
   PROCEDURE Test5A;\r
   (* test new *)\r
   type\r
     rec = record\r
             f1 : integer;\r
             f2 : array(1..3) of integer;\r
             f3 : integer;\r
           end;\r
   var\r
     ptr : ^rec;\r
\r
   begin\r
     WriteName(ZoneVar,"Test5A");\r
     new(ptr); \r
     ptr^.f1 := 1;\r
     for i := 1 to 3 do ptr^.f2(i) := i + 1;\r
     with ptr^ do\r
         f3 := 5;\r
     PrintInteger(Zonevar,ptr^.f1); (* 1 *)\r
     PrintInteger(Zonevar,ptr^.f2(1)); (* 2 *)\r
     PrintInteger(Zonevar,ptr^.f2(2)); (* 3 *)\r
     PrintInteger(Zonevar,ptr^.f2(3)); (* 4 *)\r
     PrintInteger(Zonevar,ptr^.f3); (* 5 *)\r
\r
     IF (ptr^.F1 = 1) AND \r
        (ptr^.f2(1) = 2) AND\r
        (ptr^.f2(2) = 3) AND\r
        (ptr^.f2(3) = 4) AND\r
        (ptr^.f3 = 5) THEN Test5OK := true;\r
   END;\r
\r
\r
\r
\r
\r
\r
    (******************* TEST5AA ***********************)\r
    PROCEDURE test5aa;\r
    const\r
    ni = 9;\r
    type\r
    t = 1..4;\r
    data = array( t ) of integer;\r
    data1 = array(0..2) of boolean;\r
    data2 = array(-10..10) of integer;\r
    ptrtype = ^data;\r
    \r
    var\r
    a,c : integer;\r
    d :^data;\r
    d1: ^data1;\r
    d2: ^data2;\r
    ptr : ptrtype;\r
    dtype : data;\r
    \r
      FUNCTION newandInit( i : integer) : ptrtype;\r
      var help : ptrtype;\r
      begin\r
        new(help);\r
        for j := 1 to 4 do help^(j) := i;\r
        newandinit := help;\r
      end;\r
    \r
    begin\r
    WriteName(ZoneVar,"Test5AA");\r
    new(d1);\r
    new(d2);\r
    new(d);\r
    a:= 2;\r
    d^(2):= a;\r
    c:= d^(a) + ni;\r
    printinteger(zonevar,  c );   (* 11 *)\r
    IF c <> 11 THEN EXIT;\r
    \r
    for i := 0 to 2 do\r
    begin\r
    d1^(i) := d^(2) + i = a;\r
    end;\r
    printboolean(ZoneVar,d1^(0));     (* true *)\r
    printboolean(ZoneVar, d1^(1));     (*  false *)\r
    printboolean(ZoneVar,d1^(2));     (* false *)\r
    IF (d1^(1) OR d1^(2) OR (d1^(0) = false)) THEN EXIT;\r
    \r
    d2^(0) := 0;\r
    for i := 1 to 10 do\r
    begin\r
    d2^(i) := i;\r
    d2^(-i) := i;\r
    d2^(0) := (d2^(d2^(-i)) + d2^(-i)) + d2^(0);\r
    end;\r
    c := 9;\r
    PrintInteger(ZoneVar,d2^(d2^(10) - d2^(c) - 1));    (* 110 *)\r
    IF d2^(d2^(10) - d2^(c) - 1) <> 110 THEN EXIT;\r
    \r
    PrintInteger(ZoneVar,d2^(-7)); (* 7*)\r
    IF d2^(-7) <> 7 THEN EXIT;\r
    \r
    dtype := newandinit(5)^;\r
    ptr := newandinit(10);\r
    FOR i := 1 to 4 do \r
      BEGIN\r
        PrintInteger(ZoneVar,dtype(i)); (* 5 , 5 , 5 , 5 *)\r
        PrintInteger(ZoneVar,Ptr^(i));  (* 10, 10, 10, 10 *)\r
        IF (dtype(i) <> 5) OR ( Ptr^(i) <> 10) THEN EXIT;\r
      END;\r
      Test5OK := true;\r
    end;\r
    \r
    \r
    \r
    \r
   (*********************** TEST5AB *******************)\r
     (* initialize pointer types *)\r
   PROCEDURE test5ab;\r
   type\r
   ptrtrec;\r
   trec = record\r
             x : boolean;\r
             l : array(1..2) of ptrtrec;\r
          End;\r
   ptrtrec = ^trec;\r
   sss = array(1..4) of record\r
                          s : integer;\r
                          m : ptrtrec;\r
                        END;\r
   \r
   var\r
   p : ptrtrec;\r
   d : ARRAY(-2..3) of ^integer;\r
   ss : sss; \r
   f : trec;\r
   e : trec;\r
   begin\r
     WriteName(ZoneVar,"Test5AB");\r
     f.x := nil(p);\r
     printboolean(ZoneVar, f.x); (* true *)\r
     IF f.x <> true THEN EXIT;\r
     f.x := true;\r
     for i := -2 to 3 do \r
       f.x := f.x and nil(d(i));\r
     printboolean(ZoneVar, f.x); (* true *)\r
     IF f.x <> true THEN EXIT;\r
     f.x := true;\r
     for i := 1 to 4 do\r
       f.x := f.x and nil(ss(i).m);\r
     printboolean(ZoneVar, f.x);  (* true *)\r
     IF f.x <> true THEN EXIT;\r
     f.x := ( nil(f.l(1)) and nil(f.l(2)) ) AND\r
            ( nil(e.l(1)) and nil(e.l(2)) ) ;\r
     printboolean(ZoneVar, f.x); (* true *)\r
     IF f.x  THEN Test5OK := true;\r
   \r
     \r
   end;\r
\r
\r
   (********************** TEST5AC *******************)\r
\r
    Procedure test5ac;\r
    (* test of new and init *)\r
    const\r
    ni = 9;\r
    type\r
    t = 1..4;\r
    data = array( t ) of ^integer;\r
    data1 = array(0..2) of record\r
                             p : data;\r
                             ref : reference;\r
                             b : boolean;\r
                             mail : mailbox;\r
                             proc : process;\r
                           END;\r
    \r
    var\r
    a,c : integer;\r
    d :^data;\r
    d1: ^data1;\r
    b : boolean;\r
    \r
    \r
    begin\r
    \r
    WriteName(ZoneVar,"Test5AC");\r
    new(d);\r
    new(d1);\r
    d1^(0).b := true;\r
    for i := 1 to  4 do d1^(0).b := d1^(0).b and nil(d^(i));\r
    printBoolean(ZoneVar,d1^(0).b);   (* true *)\r
    IF Not d1^(0).b THEN EXIT;\r
    \r
    for i := 1 to 4 do new(d^(i));\r
    a:= 2;\r
    d^(2)^:= a;\r
    c:= d^(a)^ + ni;\r
    printinteger(ZoneVar, c );   (* 11 *)\r
    IF c <> 11 THEN EXIT;\r
    \r
    c := 0;\r
    for i := 1 to 4 do d^(i)^ := i;\r
    for i := 1 to 4 do c := c + d^(i)^;\r
    \r
    PrintInteger(ZoneVar,c);   (* 10 *)\r
    IF c <> 10 THEN EXIT;\r
    \r
    \r
    b := true;\r
    for i := 0 to 2 do\r
    begin\r
    for j := 1 to 4 do b := b and nil(d1^(i).p(j));\r
    b := b and nil(d1^(i).Ref); \r
    b := b and Passive(d1^(i).Mail); \r
    b := b and nil(d1^(i).Proc); \r
    end;\r
    printboolean(ZoneVar,b);  (* true *)\r
    IF b  THEN Test5OK := true;\r
    end;\r
    \r
\r
\r
   (******************* TEST5AD ***************)\r
   PROCEDURE TEST5AD;\r
    var i : integer := 100;\r
     Type\r
       data = array(1..1100) OF integer;\r
       data1 = array(1..i) of integer; \r
       integer10=array(0..9) of integer;\r
\r
    var d : ^data;\r
        d1 : ^data1;\r
        Sum,sum1,sum2 : integer := 0;\r
        d2 : array(1..100) of ^integer10;\r
    begin\r
      WriteName(ZoneVar,"Test5AD");\r
      new(d);\r
      for i := 1 to 1100 do d^(i) := 2;\r
      new(d1);\r
      For j := 1 TO i DO d1^(j) := 4;\r
      FOR i := 1 To 100 do BEGIN\r
                             new(d2(i));\r
                             for j:=0 to 9 do d2(i)^(j) := 3;\r
                           END;\r
\r
      For j := 1 TO 1100 DO Sum := Sum + d^(j);\r
      For j := 1 TO i DO Sum1 := Sum1 + d1^(j);\r
      For j := 1 TO 100 DO\r
      For i := 0 to 9 do Sum2 := Sum2 + d2(j)^(i);\r
      PrintInteger(ZoneVar,Sum); (* 2200 *)\r
      PrintInteger(ZoneVar,Sum1); (* 400 *)\r
      PrintInteger(ZoneVar,Sum2); (* 3000 *)\r
      IF (Sum = 2200) AND (Sum1 = 400) AND (Sum2 = 3000) THEN Test5OK := true;\r
    END;\r
\r
\r
\r
\r
   (********************* TEST5CA ********************)\r
   (* declaretion  of shielded types*)\r
   PROCEDURE test5ca;\r
   \r
   var\r
   b : boolean;\r
\r
   begin\r
   WriteName(ZoneVar,"Test5CA");\r
   b := nil(Test5CA_y);\r
   printboolean(ZoneVar, b);  (* true *);\r
   IF b <> true THEN EXIT;\r
   b := nil(Test5CA_e);\r
   printboolean(ZoneVar, b);  (* true *);\r
   IF b <> true THEN EXIT;\r
   b := passive(Test5CA_s);\r
   printboolean(ZoneVar, b);  (* true *);\r
   IF b <> true THEN EXIT;\r
   b := locked(Test5CA_s);\r
   PrintBoolean(ZoneVar, b); (* false *)\r
   IF b  THEN EXIT;\r
   b := Open(Test5CA_s);\r
   PrintBoolean(ZoneVar, b); (* false *)\r
   IF b <> true THEN Test5OK := True;\r
   \r
   end;\r
\r
\r
\r
\r
\r
   (******************** TEST5CB *********************)\r
   (* initialize shielded types *)\r
   PROCEDURE test5cb;\r
   begin\r
     WriteName(ZoneVar,"Test5CB");\r
     Test5CB_f.x := true;\r
     for i := 1 to 4 do\r
       Test5CB_f.x := Test5CB_f.x and passive(Test5CB_ss(i).m);\r
     printboolean(Zonevar,Test5CB_f.x);  (* true *)\r
     IF Test5CB_f.x <> true THEN EXIT;\r
   \r
     Test5CB_f.x := nil(Test5CB_f.l(1)) and nil(Test5CB_f.l(2));\r
     printBoolean(Zonevar,Test5CB_f.x);  (* true *)\r
     IF Test5CB_f.x <> true THEN EXIT;\r
   \r
     Test5CB_f.x := true;\r
     for i := -1 to 10 do\r
      Test5CB_f.x :=  nil(Test5CB_y(i)) and Test5CB_f.x;\r
     printBoolean(Zonevar,Test5CB_f.x);  (* true *)\r
     IF Test5CB_f.x THEN Test5OK := true;\r
   end;\r
   \r
   \r
   \r
   (******************* TEST5D **********************)\r
   (* shared variabel declaration *)\r
   Procedure test5d;\r
   const\r
   ni = 9;\r
   var j : integer;\r
   procedure addshared(shared x,y : integer);\r
   begin\r
     region x do region y do x := x  + y;\r
   end;\r
   \r
   \r
   procedure addvarparam(var x : integer; y : integer);\r
   begin\r
    x := x + y;\r
   end;\r
   \r
   \r
   \r
   procedure testshared(shared xx : integer ; shared yy : Boolean);\r
   begin\r
     Region xx do region yy do region Test5d_y do\r
   \r
       begin\r
         Test5d_y := 30;\r
         xx := 6;\r
         j := 1;\r
         region Test5d_arr do Test5d_arr(7) := 0;\r
         while yy do \r
           begin\r
             if j = 6 then exit\r
             else region  Test5d_arr do  Test5d_arr(j) := j;\r
             j := j + 1;\r
           End;\r
       end;\r
   end;\r
   begin\r
     WriteName(ZoneVar,"Test5D");\r
     region Test5d_y do region Test5d_x do region Test5d_index do\r
       begin\r
         PrintInteger(ZoneVar,Test5d_y); (* 24*)\r
         IF test5d_y <> 24 THEN EXIT;\r
         PrintInteger(ZoneVar, Test5d_index); (* 24 *)\r
         IF Test5d_Index <> 24 THEN EXIT;\r
         PrintBoolean(ZoneVar, Test5d_x); (* true *)\r
         IF Test5d_x <> true THEN EXIT;\r
         region Test5d_y do region Test5d_f do\r
           begin\r
             Test5d_f.x := 5;\r
             Test5d_f.y := false;\r
           end;\r
       End;\r
   \r
   \r
     testshared(Test5d_y,Test5d_x);\r
   \r
     region Test5d_y do PrintInteger(ZoneVar,Test5d_y);   (* 6 *)\r
     Region Test5d_y do IF Test5d_y <> 6 THEN EXIT;\r
   \r
   \r
     region Test5d_y do\r
       begin\r
         addshared(Test5d_y,Test5d_y);\r
         PrintInteger(ZoneVar,Test5d_y); (* 12 *)\r
         IF Test5d_y <> 12 THEN EXIT;\r
       end;\r
   \r
     region Test5d_y do\r
       begin\r
         addvarparam(Test5d_y,Test5d_y);\r
         PrintInteger(ZoneVar,Test5d_y); (* 24 *)\r
         IF Test5d_y <> 24 THEN EXIT;\r
       \r
       end;\r
   \r
     region Test5d_f do region Test5d_index do\r
      Begin\r
        Test5d_index := 1;\r
        while Test5d_f.y = false do\r
         begin\r
          region Test5d_arr do\r
            if Test5d_arr(Test5d_index) = Test5d_f.x Then ExitLoop\r
            Else Test5d_arr(7) := Test5d_Arr(Test5d_index) + Test5d_arr(7);\r
          Test5d_index := Test5d_index + 1;\r
         end;\r
      end;\r
   \r
    region Test5d_arr do PrintInteger(ZoneVar,Test5d_arr(7)) ;  (* 10 *)\r
    region test5d_arr do If test5d_arr(7) = 10 THEN Test5OK := true;\r
   \r
   \r
   \r
   end;\r
\r
  \r
\r
  (************************* TEST5DA ******************************)\r
  PROGRAM Test5da(shared finish : boolean; shared Test5DAOK : boolean);\r
  EXTERNAL;\r
\r
\r
\r
  (************************ TEST5DB ************************)\r
    (* shared variabel declaration  with  dynamic type *)\r
    PROCEDURE test5db;\r
    \r
     \r
    \r
    var j : integer;\r
    \r
    procedure addshared(shared x,y : integer);\r
    begin\r
      region x do region y do x := x  + y;\r
    end;\r
    \r
    \r
    procedure addvarparam(var x : integer; y : integer);\r
    begin\r
     x := x + y;\r
    end;\r
    \r
    \r
    \r
    procedure testshared(shared xx : integer ; shared yy : Boolean);\r
    begin\r
      Region xx do region yy do region Test5db_y do\r
    \r
        begin\r
          Test5db_y := 30;\r
          xx := 6;\r
          j := 1;\r
          region Test5db_arr do Test5db_arr(7) := 0;\r
          while yy do \r
            begin\r
              if j = 6 then exit\r
              else region Test5db_arr do Test5db_arr(j) := j;\r
              j := j + 1;\r
            End;\r
        end;\r
    end;\r
    begin\r
      WriteName(ZoneVar,"Test5DB");\r
      region Test5db_y do region Test5db_x do region Test5db_index do\r
        begin\r
          PrintInteger(ZoneVar, Test5db_y); (* 24*)\r
          IF Test5db_y <> 24 THEN EXIT;\r
          PrintInteger(ZoneVar, Test5db_index); (* 24 *)\r
          IF Test5db_Index <> 24 THEN EXIT;\r
          PrintBoolean(ZoneVar, Test5db_x); (* true *)\r
          IF Test5db_x <> True THEN EXIT;\r
          region Test5db_y do region Test5db_f do\r
            begin\r
              Test5db_f.x := 5;\r
              Test5db_f.y := false;\r
            end;\r
        End;\r
    \r
    \r
      testshared(Test5db_y,Test5db_x);\r
    \r
      region Test5db_y do PrintInteger(ZoneVar, Test5db_y);   (* 6 *)\r
      region Test5db_y Do IF Test5db_y <> 6 THEN EXIT;\r
    \r
    \r
      region Test5db_y do\r
        begin\r
          addshared(Test5db_y,Test5db_y);\r
          PrintInteger(ZoneVar, Test5db_y); (* 12 *)\r
          IF Test5db_y <> 12 THEN EXIT;\r
        end;\r
    \r
      region Test5db_y do\r
        begin\r
          addvarparam(Test5db_y,Test5db_y);\r
          PrintInteger(ZoneVar, Test5db_y); (* 24 *)\r
          IF Test5db_y <> 24 THEN EXIT;\r
        end;\r
    \r
      region Test5db_f do region Test5db_index do\r
       Begin\r
         Test5db_index := 1;\r
         while Test5db_f.y = false do\r
          begin\r
           region Test5db_arr do\r
             if Test5db_arr(Test5db_index) = Test5db_f.x Then ExitLoop\r
             Else Test5db_arr(7) := Test5db_Arr(Test5db_index) + Test5db_arr(7);\r
           Test5db_index := Test5db_index + 1;\r
          end;\r
       end;\r
    \r
     region Test5db_arr do PrintInteger(ZoneVar, Test5db_arr(7)) ;  (* 10 *)\r
     region Test5DB_arr do IF Test5db_arr(7) = 10 THEN Test5OK := true;\r
    \r
    \r
    end;\r
\r
\r
\r
\r
\r
begin  (* Main program *)\r
\r
  WriteName(ZoneVar,"TESTVERSION5");\r
\r
\r
  (********************* TEST5A ***************)\r
  Test5OK := false;\r
  Test5A;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
  (********************* TEST5AA ***************)\r
  Test5OK := false;\r
  Test5AA;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
  (********************* TEST5AB ***************)\r
  Test5OK := false;\r
  Test5AB;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
  (********************* TEST5AC ***************)\r
  Test5OK := false;\r
  Test5AC;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
\r
\r
  (********************* TEST5AD ***************)\r
  Test5OK := false;\r
  Test5AD;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
  (********************* TEST5CA ***************)\r
  Test5OK := false;\r
  Test5CA;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
\r
  (********************* TEST5CB ***************)\r
  Test5OK := false;\r
  Test5CB;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
\r
  (********************* TEST5D ***************)\r
  Test5OK := false;\r
  Test5D;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
  (*********************** TEST5DA ************************)\r
  LinkOk := Link("TEST5DA",test5da);\r
\r
  PrintInteger(ZoneVar,ord(LinkOK));\r
  IF LinkOK <> Link_OK THEN GOTO EXitError;\r
  region test5daok do test5daok := false;\r
  region test5daend do test5daend := false;\r
  createok := Create("test5da", Test5da(test5daend,test5daok),Process5da,0,130);\r
  PrintInteger(ZoneVar,ord(CreateOK));\r
  IF CreateOK <> Create_OK THEN GOTO EXitError;\r
\r
  OK1 := false;\r
  WHILE Not OK1 do \r
     begin\r
       REGION test5daEnd do OK1 := test5daEnd;\r
       delay(2);\r
     end;\r
  (* test5da finish *)\r
  REGION test5daOK do  OK1 := test5daOK ;\r
  IF OK1 = false THEN GOTO ExitError;\r
  remove(Process5da); \r
\r
\r
\r
  (********************* TEST5DB ***************)\r
  Test5OK := false;\r
  Test5DB;\r
  IF Test5OK = false THEN GOTO ExitError;\r
\r
\r
  WriteChar(ZoneVar,'*');\r
  WriteChar(ZoneVar,'O');\r
  WriteChar(ZoneVar,'K');\r
  WriteChar(ZoneVar,'5');\r
  WriteChar(ZoneVar,'*');\r
  region OK do OK := true;\r
  region fin do fin := true;\r
  EXIT;\r
  ExitError:\r
  WriteChar(ZoneVar,'*');\r
  WriteChar(ZoneVar,'N');\r
  WriteChar(ZoneVar,'O');\r
  WriteChar(ZoneVar,'T');\r
  WriteChar(ZoneVar,' ');\r
  WriteChar(ZoneVar,'O');\r
  WriteChar(ZoneVar,'K');\r
  WriteChar(ZoneVar,'5');\r
  region OK do OK := false;\r
  region fin do fin := true;\r
end;\r
\r
\r
  (************************* TEST5DA ******************************)\r
\r
\r
  PROGRAM Test5da(shared finish : boolean; shared Test5DAOK : boolean);\r
  (* test of shared variabel and the following routines\r
     create, link, unlink,remove, resume, stop  *)\r
  \r
  Shared x : integer;\r
         ArrVal : ArrType;\r
  VAR   ProcessArr : Array(1..3) Of Process;\r
        LR : Link_Result;\r
        Ul : UnLink_Result;\r
        CRes : Create_Result;\r
        ZoneVar : Zone;\r
        FirstTime : boolean := true;\r
        OK : Boolean := true;\r
\r
\r
\r
  Program P1(Shared x : integer; Shared ArrVal : ArrType); External;\r
\r
  Program P2(Shared x : integer; Shared ArrVal : ArrType; ProcessNo : integer);\r
\r
    Var ZoneVar : Zone;\r
        sss : integer;\r
    BEGIN\r
      WriteName(ZoneVar,"P2");\r
      For i := 1 TO 1000 Do\r
        Region x do Region ArrVal do\r
          Begin\r
            x := x + 1;\r
            ArrVal(ProcessNo) := ArrVal(ProcessNo) + 1;\r
            if ArrVal(ProcessNo) = 500 then\r
              begin\r
                PrintInteger(ZoneVar,processNo);\r
                PrintInteger(ZoneVar,x);\r
              end;\r
              \r
          End;\r
    END;\r
\r
  BEGIN\r
    WriteName(ZoneVar,"Test5DA");\r
\r
    FOR i := 1 TO 2 DO\r
      BEGIN\r
        region x do x := 0;\r
        region arrval do for i := 1 to 3 do arrval(i) := 0;\r
    \r
        IF FirstTime THEN LR := Link("EXTERNALP1",P1);\r
        FirstTime := false;\r
        PrintInteger(ZoneVar,ord(LR));\r
        CRes := Create("Pro1",P1(x,ArrVal),ProcessArr(1),0,130);\r
        PrintInteger(ZoneVar,ord(CRes));\r
        CRes := Create("Pro2",P2(x,ArrVal,2),ProcessArr(2),0,130);\r
        PrintInteger(ZoneVar,ord(CRes));\r
        CRes := Create("Pro3",P2(x,ArrVal,3),ProcessArr(3),100,130);\r
        PrintInteger(ZoneVar,ord(CRes));\r
        region x do region arrval do\r
          begin\r
--            stop(processArr(1));\r
--            stop(processArr(2));\r
          end;\r
    \r
        loop\r
--          Resume(processArr(1));\r
--          Resume(processArr(2));\r
          region x do \r
           Begin\r
            if x = 3000 then exitloop;\r
            region  arrVal do if x <> ( arrVal(1) + ArrVal(2) + ArrVal(3))\r
                                then exitloop;\r
           end;\r
          delay(2);\r
        endloop; \r
           \r
        region x do \r
           begin\r
             printinteger(ZoneVar,x);  (* 3000*)\r
             IF x <> 3000 THEN \r
                 region finish do \r
                   begin\r
                     finish := true;\r
                     EXIT;\r
                   END;\r
           end;\r
        \r
    \r
        region ArrVal do For i := 1 TO 3 do \r
          BEGIN\r
             PrintInteger(ZoneVar,ArrVal(i));  (* 1000 *)\r
             IF ArrVal(i) <> 1000 THEN \r
                 region finish do \r
                   begin\r
                     finish := true;\r
                     EXIT;\r
                   END;\r
          end;\r
    \r
\r
        FOR i := 1 TO 3 DO \r
        begin\r
          trace(1024+i);\r
          ReMove(ProcessArr(i));\r
        end; \r
      END;   \r
    Ul := UnLink(P1);\r
    PrintInteger(ZoneVar,ord(Ul));\r
    IF ord(UL) = 0 THEN Region test5daOK do test5daOK := true;\r
\r
    Region finish do finish := true;\r
  end;\r
    \r
$code\r
  Program EXTERNALP1(Shared x : integer; Shared ArrVal : ArrType);\r
\r
    Var ZoneVar : Zone;\r
         sss : integer;\r
\r
    BEGIN\r
      WriteName(ZoneVar,"EXTERNALP1");\r
$nocode\r
      For i := 1 TO 1000 Do\r
        Region x do Region ArrVal do\r
          Begin\r
            x := x + 1;\r
            ArrVal(1) := ArrVal(1) + 1;\r
            IF arrVal(1) = 500 then \r
              BEGIN\r
                 PrintInteger(ZoneVar,1);\r
                 PrintInteger(ZoneVar,x);\r
              END;\r
          End;\r
    END\r
.\r
\r
\r
\r
\r
\r
 \r
«eof»