DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

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

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦7e5553cff⟧ TextFile

    Length: 10752 (0x2a00)
    Types: TextFile
    Names: »testjobs«

Derivation

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »testjobs« 

TextFile

; testjobs

%


(***********************
*   ep test 1          *
*   proc func process  *
***********************)

process test_1;

procedure pip; external;

procedure pop(a: integer);
begin end;

function fut(a,b,c,d,e,f,g,h,i,j,k,l: integer):integer; external;

function fif(i: integer): integer;
begin fif:=99 end;

var i: integer :=0;

procedure pxp(i:integer);
begin end;

export ex = offset i;  exx = size i;

process p;
   procedure p1(i:integer);
      function fx(i:integer):boolean;
      var a,b: integer;
      begin
      fx:=true;
      end;
   begin
     if fx(1) then;
   end;
var x:integer :=0;
begin
x:=x+1;
end;

process xp(var s: semaphore); external;

process pp(i,j: integer);
var x: integer:=0;
begin
x:=x+1;
end;

begin
i:=i+1;
end.


%


\f


(*******************
*   ep test 2      *
*    prefix proc   *
*******************)

prefix test_2;
procedure pip;

var i: integer;

  procedure pop(var i:integer);
  begin i:=0; end;
(*
  procedure ptestp; external;

  function ff: boolean; external;
*)
  function fx: integer;
  begin fx:=1 end;

  export ia = address i;

begin
(*  ptestp; 
if ff then;  *)
i:=0
end;
.


%

\f



(******************
*   ep test 3     *
*   prefix func   *
******************)

prefix test_3;
function fx(a: integer): ^ niltype;
var p: ^ integer;
begin
fx:=p;
end;
.



%

\f


(************************
*   ep test 4           *
*   test processparam   *
************************)

process test_4(var s: semaphore);

var q,t: integer;   sem: semaphore;   sh: shadow;

procedure op(i: integer; p: processrec; j: integer; 
q: processrec); external;

function boot(i: integer; p: processrec): integer;
begin boot:=1; end;

process pip(var s: semaphore; i: integer); external;

process pop; external;

(* process fut *)

process fut(var s: semaphore; var p,q: integer);
var i: integer;
export qq = address i;
begin end;

(* end fut *)

(* process fif *)

process fif;
var sem: semaphore; i: integer; sh: shadow;
   process fitfut(var s: semaphore); external;
   process pippop(var s,p,q: semaphore);
   begin end;
begin
i:=create(fitfut(sem), sh, 2);
end;

(* end fif *)

begin (* body test_4  *)
op(q,pip(sem,t), 100, pop);
op(q,fut(sem,t,q), 100, fif);
q:=boot(boot(t,fut(sem,t,q)), pip(sem,t));
link(pip);
q:=create(pip(sem,q), sh, 3);
start(sh, 100);
end.


%

\f


(**************************
*   ep test 5             *
*   test proc/func call   *
**************************)

process test_5;

type  str = array ( 1..10 ) of char;
      rec = record a,b: integer; c: char end;
      ss = set of 0..31;

var s1: ss;  p: integer;  ch: char;
    rc: rec;

procedure ex(s: str); external;
procedure ptestp; external;
function fx(x: integer): integer; external;
function fa: rec;
begin fa.a:=1;  fa.b:=2;  fa.c:=chr(10); end;

procedure a(sa: ss; var vsa: ss);
var s2: set of 0..63;  i: integer;

   procedure b(i: integer; var vi: integer);
   var sx: set of 0..15;  ar: str;

      procedure c(ii: rec; var vii: rec);
      var s3: ss;  ic: integer;  q: -1..99;
      begin
        a(s1,s3);
        b(1+q,ic);
        c(fa,vii);
        ex('text');
        ic:=fx(1);
        ptestp;
        ic:=abs(i);
        ic:=pred(q);
        ic:=succ(q);
      end;
   begin
     a(s2,sa);
     b(99,vi);
     c(fa,rc);
     ex(ar);
   end;
begin
  a(vsa,sa);
  b(fx(3),i);
  rc:=fa;
  ex('en   lang   text');
  i:=abs(i);
end;

begin
a( (..), s1);
rc:=fa;
ex('tx 10 tegn');
p:=ord('a');
ch:=chr(10);
p:=pred(p);
end.


%
\f





(**********************
*   ep test 6         *
*   test statements   *
**********************)

process test_6;

type  rec = record rf: reference; c: char end;
      aa  = array (1..10) of rec;
var i,p,q: integer;
    b: boolean;
    su: 0..10;
    ra: aa;
label l,l1;

begin

l:

goto l1;

case i of
5: i:=5;
4: i:=4;
3: i:=3;
2: i:=2;
1: i:=1;
0: i:=0;
-1: i:=-1;
otherwise i:=6;
end;
 
case i of end;
 
case i of
1..3: i:=1;
6..8: i:=3;
3..5: i:=2;
end;

case i of
1..3: i:=1;
6..7: i:=3;
9:    i:=4;
10:   i:=5;
4..9: i:=2;
end;

case i of
2: i:=2;
7: i:=7;
4: i:=4;
3: i:=3;
5: i:=5;
1: i:=1;
end;

for su:=i to i do;
for su:=i downto i do;
for i:=p to q do;
for i:=p downto q do;

goto l;
l1:

if b then b:=true;
if b then b:=true else b:=false;
repeat b:=true until b;
while b do b:=true;
with ra(i) do c:='a';
lock ra(i).rf as x: set of 0..15 do
if 3 in x then b:=true;
channel ra(i).rf do b:=true;
ra(i).rf:=:ra(q).rf;
end.



%



\f





(********************
*   ep test 7       *
*   sys - user lib  *
********************)

process test_7;


var i: integer;    rf: reference;    p: pool 1;
    
    sem: semaphore;   sh: shadow;   b: boolean;

procedure write(s: alfa); external;
procedure writeln; external;
procedure pa(var i: integer); external;
procedure pb(var i,j: integer); external;
function fa(p,q: integer): integer; external;
function fb(var s: shadow): boolean; external;
procedure hup; external;
procedure object; external;
procedure ptestp; external;

begin
i:=abs(i);
pb(i,i);
object;
alloc(rf,p,sem);
write('hhh');
b:=fb(sh);
hup;
writeln;
b:=nil(rf);
i:=fa(i,i);
ptestp;
(*$5 4 1*)
end.


%

\f




(******************
*   ep test 8     *
*   test assign   *
******************)

process test_8;

type

rt1 = record
       a: integer;
       b: record
          a: integer;
          b: record;
             a: integer;
             b: char
             end
          end
       end;

rt2 = record
        a,b: ^ rt2;
        c: char
      end;

rt3 = packed record
        a: integer;
        b,c: 0..7
      end;


at1 = array (1..2) of integer;
at2 = array (1..2) of record
                       a: array (1..3) of char;
                       b: array (1..3) of char;
                      end;
at3 = packed array (1..10) of 0..7;
at4 = array (1..3) of packed record
                        a,b: 0..7;
                        c: integer;
                        d,e: 0..7
                      end;
at5 = array (1..3) of record a: integer; b: char end;
at6 = array (1..3) of record a: char; b: integer end;

(*global var*) var  rg1 : rt1;  ag1 : at1;  pg : ^ rt2;
                    bg: 0..31;  wg  : integer;  fg : rt3;

procedure x;

(* intermidiate var *)
               var ri1: rt1;  ai1: at1;  pi: ^ rt2;
                   bi: 0..31; wi: integer;  fi: rt3;

procedure y;

(* local var *)  var  rl1: rt1;  al1: at1;  i: integer;
                      al2: at2;  al3: at3;  pl: ^ rt2;
                      al4: at4;
                      s: set of 0..31;
                      bl: 0..31;  wl: integer;  fl: rt3;
                      al5: at5;  al6: at6;

begin

bg:=i;        bg:=3;
wg:=i;        wg:=3;
fg.b:=i;      fg.b:=3;

bi:=i;        bi:=3;
wi:=i;        wi:=3;
fi.b:=i;      fi.b:=3;

bl:=i;        bl:=3;
wl:=i;        wl:=3;
fl.b:=i;      fl.b:=3;

rg1.b.a:=1;   rl1.a:=i;
ri1.b.b.a:=i;

ag1(1):=1;    al1(1):=1;   ai1(1):=1;

al2(1).a(1):=1;
al2(2).b(2):=2;
al3(3):=i;
al5(1).a:=i;     al5(1).b:=i;
al5(1).a:=1;     al5(1).b:=1;
al6(1).a:=i;     al6(1).b:=i;
al6(1).a:=1;     al6(1).b:=1;

pg^.a^.c:='a';
pl^.b^.c:='a';
pi^.c:='a';

al4(3).a:=i;
al4(3).d:=i;
al4(3).a:=1;
al4(3).d:=1;

s:=s;
rg1:=rl1;

end;
begin end;
begin end.


%
\f


(*****************
*   ep test 9    *
*   var address  *
*****************)

process test_9;

type

rt1 = packed record
               a,b: 0..7;
               c: integer;
               d,e: 0..7
             end;

at1 = array (1..2) of record
                        a: char;
                        b: integer;
                        c: rt1
                      end;

at2 = array (1..2) of record
                        a: integer;
                        b: char;
                        c: rt1;
                      end;

at3 = array (1..2) of record
                        a: rt1;
                        b: char;
                        c: integer
                      end;

at4 = packed array (1..10) of 0..7;

at5 = array (1..10) of char;

const sc = (.30.);

function f1(i: integer): char;
begin f1:=1 end;

function f2(i: integer): integer;
begin f2:=1 end;

function f3(i: integer): rt1;
begin f3.a:=1 end;

function f4(i: integer): at5;
begin f4:='test' end;

(* global var *)

var gb: char;   gw: integer;   gr1: rt1;

procedure x;

(* inter var *)

var ib: char;   iw: integer;   ir1: rt1;

procedure y;

(* local var *)

var   lb: char;   lw: integer;   lr1: rt1;

      i: integer; 

      la1: at1;   la2: at2;    la3: at3;   la4: at4;

      la5: at5;    s: set of 0..31;    t: set of 0..47;

begin

i:=gb;
i:=ib;
i:=lb;
i:=gw;
i:=iw;
i:=lw;
i:=gr1.a;    i:=ir1.a;    i:=lr1.a;
i:=la1(1).a;
i:=la2(1).a;
i:=la3(1).a.a;
i:=la2(1).b;
i:=la1(1).b;
i:=la1(1).c.d;
i:=la4(1);

i:=5;     la5:='yest';
i:=f1(1);   
i:=f2(1);
i:=f3(1).d;
i:=f4(1)(1);
la5:=f4(1);

s:=sc;
s:=(.i,i,i..5.);
s:=(..);
i:=succ(5);
i:=pred(i);
i:=ord(i);
i:=chr(i);
end;
begin end;
begin end.

%

\f



(*****************
*   ep test 10   *
*   expression   *
*****************)

process test_10;

var i, p, q : integer;   s: set of 0..31;   t: set of 0..47;

   u: set of 0..63;    b: boolean;

   x,  y : record a,b: integer; c: char end;

begin

i:= - p + q - p div q mod p * q;

b:=p=p;    b:=p<>q;   b:=p>q;   b:=p<q;  
b:=p<=q;   b:=p>=q;

b:=x=y;    b:=x<>y;

b:=s>=t;   b:=s<=t;   b:=s=t;   b:=s<>t;
b:=i in (.30.);

b:= not b or b and b;

u:=s+t;   u:=t+s;   u:=s+s;
u:=s-t;   u:=t-s;   u:=s-s;
u:=(..)-s;          u:=(.i.)-s;
u:=s*t;   u:=t*s;   u:=s*s;
u:=(.i.)*t;
u:=t*(.i.);
end.


%


▶EOF◀