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

⟦ed08d3ebf⟧ TextFile

    Length: 8884 (0x22b4)
    Types: TextFile
    Names: »TESTVER9.RTP«

Derivation

└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
    └─⟦this⟧ »RTP\TESTVER9.RTP« 
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
    └─⟦this⟧ »RTP\TESTVER9.RTP« 
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\TESTVER9.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\TESTVER9.RTP«

TextFile

env;\r
procedure writename(Var z : inoutZone; Inspect name : String); EXTERNAL;\r
.\r
PROCEDURE test9a(Var OK : Boolean; VAR ZoneVar : inoutZone);\r
(** sets **)\r
const\r
  setlow = 0;\r
  sethigh= 10;\r
\r
type\r
set_range = setlow..sethigh;\r
set_type = set of set_range;\r
\r
FUNCTION firstbit(s : set_type) : Integer;\r
   begin\r
     firstbit := setlow - 1;\r
     for i := setlow to sethigh do\r
      if i in s then\r
      begin\r
        firstbit := i;\r
        exitloop;\r
      end;\r
   end;\r
\r
FUNCTION sumbits(s : set_type) : Integer;\r
   var sum : Integer;\r
   begin\r
     sum := 0;\r
     for i := setlow to sethigh do\r
      if i in s then\r
      begin\r
        sum := sum + i;\r
      end;\r
     sumbits := sum;\r
   end;\r
\r
var\r
set1, set2, set3 : set_type;\r
set4 : set of 2..13;\r
setvar : integer;\r
b : boolean;\r
repeats : Integer := 10;\r
\r
procedure printset(s: set_type);\r
var b : boolean;\r
begin\r
b := true;\r
for i := setlow to sethigh do\r
if i in s then\r
begin\r
PrintInteger(ZoneVar, i);\r
b := false;\r
end;\r
if b then printinteger(zonevar, setlow - 1);\r
end;\r
\r
function checkset(s: set_type; value : integer): boolean;\r
var b : boolean;\r
    foundvalue : integer;\r
begin\r
b := true;\r
foundvalue := 0;\r
for i := setlow to sethigh do\r
if i in s then\r
begin\r
foundvalue := foundvalue + i;\r
b := false;\r
end;\r
\r
if b then foundvalue := setlow - 1;\r
checkset := foundvalue = value;\r
end; (* checkset *)\r
\r
procedure printsetboo(b: boolean);\r
begin\r
printBoolean(zonevar, b);\r
end; (* printsetboo *)\r
\r
begin \r
for counter := 1 to repeats do\r
begin\r
   WriteName(ZoneVar,"Test9A");\r
  Ok := false;\r
set1 := (.1.);\r
$code\r
printset(set1);               (* 1 *)\r
$nocode\r
if firstbit(set1) <> 1 then exit;\r
if sumbits(set1) <> 1 then exit;\r
\r
set1 := (..);\r
printset(set1);               (* -1 *)\r
if firstbit(set1) <> -1 then exit;\r
if sumbits(set1) <> 0 then exit;\r
\r
set1 := (. 2, 4 .);\r
printset(set1);               (* 2 4 *)\r
if firstbit(set1) <> 2 then exit;\r
if sumbits(set1) <> 6 then exit;\r
\r
setvar := 10;\r
set2 := (. 4, setvar.);\r
printset(set2);               (* 4 10 *)\r
if firstbit(set2) <> 4 then exit;\r
if sumbits(set2) <> 14 then exit;\r
\r
set3 := set1 + set2;\r
printset(set3);               (* 2 4 10 *)\r
if firstbit(set3) <> 2 then exit;\r
if sumbits(set3) <> 16 then exit;\r
\r
set3 := set1 - set2;\r
printset(set3);               (* 2 *)\r
if firstbit(set3) <> 2 then exit;\r
if sumbits(set3) <> 2 then exit;\r
\r
set3 := set1 * set2;\r
printset(set3);               (* 4 *)\r
if firstbit(set3) <> 4 then exit;\r
if sumbits(set3) <> 4 then exit;\r
\r
b := set1 <= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
\r
b := set3 <= set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
\r
b := set3 >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
\r
setvar := 4;\r
set4 := ( (.2..setvar.) - (.setvar-1.)) + set2;\r
printset(set4);               (* 2 4 10 *)\r
if firstbit(set4) <> 2 then exit;\r
if sumbits(set4) <> 16 then exit;\r
\r
set4 := ( (.2..setvar.) - (.setvar-1.)) - set2;\r
printset(set4);               (* 2 *)\r
if firstbit(set4) <> 2 then exit;\r
if sumbits(set4) <> 2 then exit;\r
\r
set4 := ( (.2..setvar.) - (.setvar-1.)) * set2;\r
printset(set4);               (* 4 *)\r
if firstbit(set4) <> 4 then exit;\r
if sumbits(set4) <> 4 then exit;\r
\r
b := ( (.2..setvar.) - (.setvar-1.)) <= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.2..setvar.) - (.setvar-1.)) >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.2..setvar.) - (.setvar-1.)) = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.2..setvar.) - (.setvar-1.)) <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
printset((.5..setvar.) + (..));     (* -1 *)\r
\r
if not checkset((.5..setvar.) + (..), -1) then exit;\r
end;\r
ok := true;\r
end;\r
\r
PROCEDURE test9aa(Var OK : Boolean; VAR ZoneVar : inoutZone);\r
(** sets **)\r
const\r
  setlow = 50;\r
  sethigh= 1000;\r
\r
type\r
set_range = setlow..sethigh;\r
set_type = set of set_range;\r
\r
FUNCTION firstbit(s : set_type) : Integer;\r
   begin\r
     firstbit := setlow - 1;\r
     for i := setlow to sethigh do\r
      if i in s then\r
      begin\r
        firstbit := i;\r
        exitloop;\r
      end;\r
   end;\r
\r
FUNCTION sumbits(s : set_type) : Integer;\r
   var sum : Integer;\r
   begin\r
     sum := 0;\r
     for i := setlow to sethigh do\r
      if i in s then\r
      begin\r
        sum := sum + i;\r
      end;\r
     sumbits := sum;\r
   end;\r
\r
var\r
set1, set2, set3 : set_type;\r
set4 : set of 2..1300;\r
setvar : integer;\r
b : boolean;\r
repeats : Integer := 10;\r
\r
procedure printset(s: set_type);\r
var b : boolean;\r
begin\r
b := true;\r
for i := setlow to sethigh do\r
if i in s then\r
begin\r
PrintInteger(ZoneVar, i);\r
b := false;\r
end;\r
if b then printinteger(zonevar, setlow - 1);\r
end;\r
\r
function checkset(s: set_type; value : integer): boolean;\r
var b : boolean;\r
    foundvalue : integer;\r
begin\r
b := true;\r
foundvalue := 0;\r
for i := setlow to sethigh do\r
if i in s then\r
begin\r
foundvalue := foundvalue + i;\r
b := false;\r
end;\r
\r
if b then foundvalue := setlow - 1;\r
checkset := foundvalue = value;\r
end; (* checkset *)\r
\r
procedure printsetboo(b: boolean);\r
begin\r
printBoolean(zonevar, b);\r
end; (* printsetboo *)\r
\r
begin \r
for counter := 1 to repeats do\r
begin\r
   WriteName(ZoneVar,"Test9AA");\r
  Ok := false;\r
set1 := (.100.);\r
printset(set1);               (* 100 *)\r
if firstbit(set1) <> 100 then exit;\r
if sumbits(set1) <> 100 then exit;\r
\r
set1 := (..);\r
printset(set1);               (* 49 *)\r
if firstbit(set1) <> 49 then exit;\r
if sumbits(set1) <> 0 then exit;\r
\r
set1 := (. 200, 400 .);\r
printset(set1);               (* 200 400 *)\r
if firstbit(set1) <> 200 then exit;\r
if sumbits(set1) <> 600 then exit;\r
\r
setvar := 1000;\r
set2 := (. 400, setvar.);\r
printset(set2);               (* 400 1000 *)\r
if firstbit(set2) <> 400 then exit;\r
if sumbits(set2) <> 1400 then exit;\r
\r
set3 := set1 + set2;\r
printset(set3);               (* 200 400 1000 *)\r
if firstbit(set3) <> 200 then exit;\r
if sumbits(set3) <> 1600 then exit;\r
\r
set3 := set1 - set2;\r
printset(set3);               (* 200 *)\r
if firstbit(set3) <> 200 then exit;\r
if sumbits(set3) <> 200 then exit;\r
\r
set3 := set1 * set2;\r
printset(set3);               (* 400 *)\r
if firstbit(set3) <> 400 then exit;\r
if sumbits(set3) <> 400 then exit;\r
\r
b := set1 <= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
\r
b := set3 <= set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
\r
b := set3 >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := set1 <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
$code\r
setvar := 400;\r
set4 := ( (.200..setvar.) - (.201..setvar-1.)) + set2;\r
printset(set4);               (* 200 400 1000 *)\r
$nocode\r
if firstbit(set4) <> 200 then exit;\r
if sumbits(set4) <> 1600 then exit;\r
\r
set4 := ( (.200..setvar.) - (.201..setvar-1.)) - set2;\r
printset(set4);               (* 200 *)\r
if firstbit(set4) <> 200 then exit;\r
if sumbits(set4) <> 200 then exit;\r
\r
set4 := ( (.200..setvar.) - (.201..setvar-1.)) * set2;\r
printset(set4);               (* 400 *)\r
if firstbit(set4) <> 400 then exit;\r
if sumbits(set4) <> 400 then exit;\r
\r
b := ( (.200..setvar.) - (.201..setvar-1.)) <= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.200..setvar.) - (.201..setvar-1.)) >= set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.200..setvar.) - (.201..setvar-1.)) = set2;\r
printsetboo(b);               (* False *)\r
if b then exit;\r
\r
b := ( (.200..setvar.) - (.201..setvar-1.)) <> set2;\r
printsetboo(b);               (* True *)\r
if not b then exit;\r
printset((.500..setvar.) + (..));     (* 49 *)\r
\r
if not checkset((.500..setvar.) + (..), 49) then exit;\r
end;\r
ok := true;\r
end;\r
PROCEDURE test9(Var OK : Boolean; VAR ZoneVar : inoutZone);\r
PROCEDURE test9a(Var OK : Boolean; VAR ZoneVar : inoutZone); external;\r
PROCEDURE test9aa(Var OK : Boolean; VAR ZoneVar : inoutZone); external;\r
begin\r
test9a(ok, zonevar);\r
if ok then test9aa(ok, zonevar);\r
end.\r