|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 9216 (0x2400)
Types: TextFileVerbose
Names: »pemnjobs«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »pemnjobs«
%
(************************************************
* pemn, test : 1, 8/5/80 . *
* *
* succ, pred, chr, ord *
************************************************)
process test1;
var
ch : char;
i : integer;
r : -10 .. 11;
begin
ch := 'a';
i := 0;
r := -1;
i := succ( i );
i := pred( i );
ch := succ( ch );
ch := pred( ch );
r := succ( i );
r := succ( r );
r := pred( r );
i := pred( r );
i := ord( ch );
ch := chr( i );
i := ord( chr( ch ) )
end.
%
(******************************************************
* pemn, test : 2, 22/5/80 . *
* *
* pass5mext2 ( platonlib ) *
******************************************************)
process test2;
var
r : reference;
s : semaphore;
i : integer;
poo : pool 1 of integer;
process p;
external;
begin
i := abs( i );
alloc( r, poo, s );
create( i, p )
end.
%
(*******************************************************
* pemn, test : 3, 28/5/80 . *
* internal process declarations *
*******************************************************)
process test3;
process t1;
begin
end;
begin
end.
%
(*********************************************************
* pemn, test : 4, 29/5/80 . *
* comparisons of pointers *
*********************************************************)
process test4;
var
p1, p2 : record a: ^ integer end;
q1, q2 : ^ integer;
begin
p1 := p2;
q1 := q2;
if q1^ = q2^ then;
if q1^ <> q2^ then;
if p1 = p2 then;
if p1 <> p2 then;
if q1 = q2 then;
if q1 <> q2 then
end.
%
(***************************************************
* pemn, test : 5, 5/6/80. *
* assignment too boolean types *
***************************************************)
process test5;
var
b1,b2 : boolean:=true;
procedure p( p1:boolean; var p2:boolean );
var
b3,b4 : boolean:=false;
begin
b3:=true;
b4:=false;
p1:=p2;
p1:=true;
p2:=false
end;
begin
b1:=true;
b2:=false;
b1:=b2;
b2:=b1;
p( b1,b2 )
end.
%
(*************************************************
* pemn, test : 6 , 5/6/80 . *
* test rev. 0 to rev. 1 *
*************************************************)
(*$ 5 2 0 *)
process test6;
type
prec = record
pa : pool 1 of boolean;
pb : pool 2 of array( 1 .. 5 ) of boolean;
end;
var
ch:char:='a';
i:integer:=3;
r:reference;
s:semaphore;
p1 : pool 3 of array( 1 .. 5 ) of integer;
p2:prec;
p3 : array( 1 .. 10 ) of prec;
process q; external;
procedure wait( var s:semaphore; var r:reference ); external;
procedure ref; external;
begin
ch:=chr(i);
i:=ord(ch);
ch:=succ(ch); ch:=pred(ch);
i:=succ(i); i:=pred(i);
i:=abs(i);
signal(r,s);
wait(s,r);
ref
end.
%
(**********************************************************
* pemn, test : 7 , 11/6/80. *
* debug ( tele ) . *
**********************************************************)
process test7;
type
macroaddr = packed record
dc_addr : 0..15;
nc_addr : 0..63;
ts_addr : 0..63
end;
alarmnetaddr = packed record
macro : macroaddr;
micro : integer
end;
alarmlabel = packed record
no_of_by : integer;
rec : alarmnetaddr
end;
const
ts1_macro = macroaddr( 7, 9, 13 );
dcts_macro = ts1_macro;
l1_const = l_const;
var
x : alarmlabel;
dc_addr : macroaddr;
owntsmacro : macroaddr;
v : p_type;
begin
owntsmacro := ts1_macro;
owntsmacro := dcts_macro;
v := l_const;
v := l1_const;
if owntsmacro = dc_addr then;
if owntsmacro = dcts_macro then;
if v = l_const then;
if v = l1_const then;
x.rec.macro := dc_addr;
if x.rec.macro = dc_addr then;
end.
%
(****************************************************
* pemn, test : 8, 13/6/80 . *
* debug ( tele ). *
****************************************************)
process test8;
type
telegram_type = packed record
opcode_part : set of 13 .. 15;
check_part : set of 8 .. 12;
data_part : set of 0 .. 7
end;
databuffer_type = record
first, top, next : integer;
telegram : telegram_type
end;
var
x : databuffer_type;
y : set of 8 .. 12;
begin
with x.telegram do
check_part:= y
end.
%
(************************************************
* pemn, test : 9, 2/7/80 . *
* test : rev. 1 to rev. x ( later rev 2 ) *
************************************************)
process test9;
type
t1 = array ( 1 .. 5 ) of reference;
t2 = record
r1 : reference;
p1 : ^ t1;
r2 : reference
end;
t3 = array ( 1 .. 5 ) of integer;
t4 = record
f1, f2, f3 : char
end;
t5 = set of 1 .. 16;
procedure exception( i : integer );
begin
end;
var
i, j : integer;
k : 0 .. 16;
m1 : t3;
m2 : t4;
s1 : t5 := (. 15 .. 16 .);
r1, r2 : reference;
v1 : ^ t1;
v2 : semaphore;
v3 : shadow;
v4 : pool 3 of integer;
procedure p1( par1 : t3; par2 : t4; par3 : t5 );
begin
end;
procedure p2;
var
r1 : reference;
rec1 : record
f1 : reference;
f2 : t2;
f3 : t1
end;
a1 : t1;
a2 : array ( 2 .. 4 ) of t2;
a3 : array ( 3 .. 4 ) of t1;
begin
end;
begin
k := k+1;
p1( m1, m2, s1 );
s1 := s1 + (. 13, 15 .);
for k := 1 to 10 do
lock r1 as v : integer do
channel r2 do
for j := 5 downto 1 do r1 :=: r2
end.
%
(****************************************************
* pemn, test : 10 , 14/7/80. *
* test : debug ( tele ). *
****************************************************)
process test10;
var
i : integer;
begin
case i of
1: ;
2: ;
4,5,6: ;
end
end.
%
(**************************************************
* pemn, test : 11 , 24/7/80. *
* test : debug ( tele ). *
**************************************************)
process test11;
type
a = record
f, a : integer
end;
b = record
b, f : integer
end;
var
aa : a;
bb : b;
begin
with aa, bb do
begin
f := a;
b := f
end
end.
%
(*****************************************************
* pemn, test : 12 , 13/8/80, *
* test : debug ( tele ). *
*****************************************************)
process test12;
type
statetype = ( idle, wd, wrtr, wt, wack );
inputtype = ( enq, data, out, here, rnr, nak, ack, rtr, lto, tto, nons );
staterow = array ( inputtype ) of statetype;
statetabletype = array ( statetype ) of staterow;
const
statetable =
statetabletype(
staterow( wd, idle, wrtr, idle, idle, idle, idle, idle, idle, idle, idle ),
staterow( wd, idle, wd, wd, wd, wd, wd, wd, wd, wd, wd ),
staterow( wt, wrtr, wrtr, wrtr, wt, wrtr, wrtr, wack, wrtr, wrtr, wrtr ),
staterow( wd, wt, wt, wt, wt, wt, wt, wt, wt, wrtr, wt ),
staterow( wack, wack, wack, wack, wack, wack, idle, wack, wack, wack, wack )
);
var
x : statetype;
begin
x := statetable( wd, here )
end.
%
(********************************************************
* pemn, test : 13 , 13/8/80,
* test : debug ( tele ).
********************************************************)
process test13;
type
r1 = record
f1 : byte;
f2 : integer;
f3 : byte;
f4 : bit
end;
r2 = packed record
f1 : byte;
f2 : integer;
f3 : byte;
f4 : bit
end;
var
xr1 : r1;
xr2 : r2;
x : integer;
begin
with xr1 do
begin
x := f1; x := f2; x := f3; x := f4
end;
with xr2 do
begin
x := f1; x := f2; x := f3; x := f4
end;
xr1.f4 := x; xr2.f4 := x
end.
%
«eof»