DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »ttestexc«

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

TextFile

job btj 2 600 perm disc 100 1 time 11 0 output 100000 size 90000

mode list.yes
btestexc = pascal80 codelist.yes spacing.10 survey.yes

(*$1 1 1*)
process testexc (var sv: system_vector);

process barn (test, subtest: integer);
const devno = 6;

var
  i,j: integer;
  ptr: ^ integer;
  c  : boolean;
  nilchm, chm, nilr, nilr2, r : reference;
  nilsh : shadow;
  p : pool 1 of integer;
  s : semaphore;
  pa : packed array (1..3) of 1..4;
  a  :        array (1..3) of 1..4;

procedure refcall;
var
  locr : reference;
begin
locr :=: r;
end;

begin
i := reservech (chm, devno + test, 0);
i := -32768;
j := 16789;
alloc (r, p, s);

case test of
  1: return (nilr);
#h1a: wait( chm, s );
  8: outbyteblock (i, 0, 1, chm, chm);
  9: outbyteblock (i, 0, 2, r  , chm);
#ha: outbyteblock (i, 1, 0, r  , chm);
#hb: case subtest of
      #h50: i := -i;
        #h51: i := i div 1;
        #h52: i := i div (-1);
      #h53: i := abs (i);
      #h55: i := i+i;
      #h56: i := i-j;
      #h57: i := j*i;
      #h58: i := i div (i-i);
      #h59: i := i mod (i-i);
     otherwise
     end;
#hc: case subtest of
      1: i := pa(i);
      2: pa(i) := 1;
      3: a(j) := 2;
     end;
#h10: i := ord (j in (.i-i .. 32767.) );
#h11: pa(1) := i;
#h12: i := ptr^;
#h20: break (nilsh, 0);
#h15: push (r, r);
#h16: lock r as rr : integer do push ( chm, r );
#h17: pop (r, nilr);
#h18: pop (nilr, nilr2);
#h19: lock r as rr : integer do pop ( nilr, r );
   7: inbyteblock( i, 0, 1, r, chm );
#h13: push (nilr, r);
#h21: remove (nilsh);
#h22: start (nilsh, 0);
#h23: stop (nilsh);
#h24: case 7 of 6: (*nothing*); end;
#h25: c := succ (true);
#h26: c := pred (false);
#h1c: lock chm as rr : integer do ;
#h1d: lock r as rr : addr do ;
#h29: refcall;

otherwise
trace( test );
end;

end; (* process barn *)

var
i, test, subtest : integer;
testno : integer := 0;
sh : array ( 1 .. #h37 ) of shadow;

procedure run;
begin
 testno := testno + 1;
  i := create ('test_except ',barn (test, subtest), sh ( testno ), 512);
  start (sh ( testno ), 0);
  if own.incname = 'remove      ' then
  begin
    for i := 0 to 2000 do; (* wait! *)
    remove (sh ( testno ));
  end;
end;

begin (* main process *)
 for test := 1 to #h29 do
   case test of
     #hb : for subtest := #h50 to #h59 do run;
     #hc : for subtest := 1    to 3    do run;
   otherwise run
   end;
end.

scope project btestexc
finis
▶EOF◀