|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 21749 (0x54f5)
Types: TextFile
Names: »TESTVER5.RTP«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTP\TESTVER5.RTP«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »RTP\TESTVER5.RTP«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\TESTVER5.RTP«
└─⟦d5707feda⟧ Bits:30010512 DVBS1.SW2114.src.2.14-3 SW2114 REAL #3/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTP\TESTVER5.RTP«
(* ******RTP compiler test. Test Version 5 ****************)\r
\r
systemtest;\r
const\r
ni = 9;\r
\r
procedure writeName( VAR z : inoutzone; 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 : inoutzone;\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
(********************* 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
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
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
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
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
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
PrintInteger(ZoneVar,d2^(-7)); (* 7*)\r
IF d2^(-7) <> 7 THEN EXIT;\r
\r
dtype := newandinit(5)^;\r
ptr := newandinit(10);\r
\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
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
$code\r
new(d1);\r
$nocode\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
$code\r
b := b and nil(d1^(i).Ref); \r
$nocode \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
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
$code\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
$nocode \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
(************************* TEST5DA ******************************)\r
PROGRAM Test5da(shared finish : boolean; shared Test5DAOK : boolean);\r
EXTERNAL;\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,2000,stdpriority);\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
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
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 : inoutzone;\r
FirstTime : boolean := true;\r
OK : Boolean := true;\r
\r
Program P1(Shared x : integer; Shared ArrVal : ArrType); External;\r
Program P2(Shared x : integer; Shared ArrVal : ArrType; ProcessNo : integer);\r
Var ZoneVar : inoutzone;\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
$IF target = ta\r
FOR i := 1 TO 1 DO\r
$ELSE\r
for i := 1 to 2 DO\r
$ENDIF\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),2000,stdpriority);\r
PrintInteger(ZoneVar,ord(CRes));\r
CRes := Create("Pro2",P2(x,ArrVal,2),ProcessArr(2),2000,stdpriority);\r
PrintInteger(ZoneVar,ord(CRes));\r
CRes := Create("Pro3",P2(x,ArrVal,3),ProcessArr(3),2000,stdpriority);\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
Program EXTERNALP1(Shared x : integer; Shared ArrVal : ArrType);\r
\r
Var ZoneVar : inoutzone;\r
sss : integer;\r
\r
BEGIN\r
WriteName(ZoneVar,"EXTERNALP1");\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