DataMuseum.dk

top - metrics - download

    Length: 49920 (0xc300)
    Types: TextFileVerbose
    Names: »feaosjob2«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »feaosjob2« 

TextFileVerbose

\f





\f


PROCESS feopsys( VAR semvector: system_vector;
VAR evavector: appl_vector );

(***************************************************
*
* function:    the test module is used to initialise buffers,
*              signal them to semaphores, and to write their
*              contents, when they have been handled by another
*
* externals:   none
*
* var params:  none
*
* semaphores:  the module sends to the system semaphore
*              "operatorsem".
*
*
* programmed may 1980 by wib and stb
*
***************************************************)

CONST
version = "vers  4.18 /";



\f


CONST
opbufsize = 80; (* no. of bytes in buffers to the operator module *)
(***   bufs   ***)
messbufsize= 64; (*words*)
testbufsize= 120;
maxbufsize= 120;
minbufsize=  16;
noofmodules= 11;
noofsemaphores= ts_sem_total;
pu= 0; (* processing unit number *)
pr= -1; (* timeslicing priority *)

valparam= "param val ";
noparam= " no param ";
alreadyexists= " already exists     ";
doesntexist= " doesn't exist      ";
illegalno= "illegal no";
createerror= "error in createcall ";

linelength= 80;
firstindex= 6 + alfalength;
lastindex= firstindex + (linelength - 1);
ok= 0; (* result from operator *)


TYPE

(*---- for alarmenv later  ------*)

paxpooltype = pool no_pax_bufs OF min_rut_mess;

opbuftype=
RECORD
first,
last,
next: integer;
name: alfa;
data: ARRAY (firstindex..lastindex) OF char
END;

(***   bufs   ***)
messbuftype= ARRAY (1..messbufsize) OF integer;
testbuftype= ARRAY (1..testbufsize) OF integer;
minbuftype = ARRAY (1.. minbufsize) OF integer;
maxbuftype = ARRAY (1.. maxbufsize) OF integer;

\f


createchtype=
RECORD
controlinfo, timeout: byte
END;

atbuffer= ARRAY (0..1) OF byte;


alfa10= ARRAY (1..10) OF char;
alfa20= ARRAY (1..20) OF char;

(* type necessary to compare sempointers *)
point_rec = RECORD
a: sempointer;
END;

VAR
(*********  pools  *********)
opbufpool: pool 3 OF opbuftype;
(***   bufs   ***)
testbufpool: pool 12 OF testbuftype;
messbufpool: pool no_listen OF messbuftype;
paxbufpool : paxpooltype;

(**********  semaphores  **********)
countsem,    (* used by "t"-command *)
wsem,        (* buffers written by the operatormodule is
returned here *)
wrsem        (* buffers with content read by the operator
module is returned here *)
: semaphore;
ts_sem : ARRAY (1..ts_sem_total) OF semaphore;

(**********  references  **********)
nref,
countref,    (* used by "t"-command *)
opinref,    (* ref. to buffer from operator *)
opoutref,   (* ref. to buffer to operator *)
cur           (* ref. to current buffer *)
: reference;

(**********  pointers  **********)
opsem: sempointer;
worksem: sempointer;
sem : ts_pointer_vector;

\f


(**********  zones  **********)
z: zone;

(**********  char  **********)
command: char;   (* the first char the operator typed *)


(**********  integers  **********)
base,            (* number base for input and output *)
firstword,       (* used by "o"-command *)
i,
incharsleft,   (* no. of not yet read chars in opinbuffer *)
j,
k,
lastword,       (* used by "o"-command *)
leftbyte,       (* used by "p"-command *)
moduleno,       (* tested module *)
noofparams,     (* no. of params in operator line *)
oldbase,        (* used by the "b" command *)
rightbyte,      (* used by "p"-command *)
semno,           (* typed semaphore number *)
curbufsize,     (* in words *)
curbuftype,     (* 0 - 4 *)
st              (* storage requirements *)
: integer;

(**********  booleans  **********)
readok,         (* indicates if the last call of readinteger
yielded a result *)
testmode
: boolean;

(**********  arrays  **********)
netc_locals : netc_loc_sems;
params: ARRAY(1..50) OF integer; (* holds parameters from operator *)
sh: ARRAY(1..noofmodules) OF shadow; (* ref. to process incarn. *)

(********** param to use in create **********)
dc_addr: macroaddr := macroaddr(7,0,0);
nc_addr: macroaddr := macroaddr(7,5,0);
ts_addr: macroaddr := macroaddr(7,5,4);

(*** auxiliary to compare sempointers ***)
ap,bp : point_rec;

\f


(**********  externals **********)
PROCESS fesupervisor(
op: sempointer;
VAR input_sem, que_sem : ! ts_pointer;
VAR stream_sem, com_pool : ! sempointer;
EXTERNAL;

PROCESS streamer(
VAR input_sem, xmitter, receiver : ! ts_pointer;
retrans_max : integer;
op : sempointer);
EXTERNAL;

PROCESS timeout(
opsem: sempointer;
VAR timeoutsem: !ts_pointer;
ticklength, max: integer);
EXTERNAL;

PROCESS lam(
opsem: sempointer;
pu, level: integer;
VAR inputsem: !ts_pointer);
EXTERNAL;

PROCESS tap(
opsem: sempointer;
VAR tab_sem: !ts_pointer);
EXTERNAL;

PROCESS dtesimulator (
op_sem : sempointer;
VAR
pax_pool_sem,
dte_sem : !ts_pointer;
VAR
netc_sem,
rut_trm_sem,
rut_rec_sem : !sempointer;
dte_addr : int_pax_addr
);
EXTERNAL;

PROCESS netconnector (
global_timeout : byte;
op_sem : sempointer;
\f


VAR
pax_pool_sem,
main_sem : !ts_pointer;
local_sem_table : netc_loc_sems;
VAR
com_pool_sem,
timeout_sem,
dte_sem : !sempointer
);
EXTERNAL;

PROCESS tapdte (
op_sem : sempointer;
VAR sem : ! ts_pointer );
EXTERNAL;

PROCESS tapnet (
op_sem : sempointer;
VAR sem : !ts_pointer );
EXTERNAL;

PROCESS osif (
op_sem : sempointer;
VAR inputsem : !ts_pointer;
VAR streemsem, lamsem : !sempointer;
port : byte);
EXTERNAL;

PROCEDURE setoflowmask( oflow: boolean);
EXTERNAL;


(********** forwards **********)

PROCEDURE getparams;
FORWARD;

PROCEDURE outdecimal(int,positions: integer);
FORWARD;

PROCEDURE outinteger(int,positions: integer);
FORWARD;

PROCEDURE outstring10(text: alfa10);
FORWARD;

\f


PROCEDURE outstring12(text: alfa);
FORWARD;

PROCEDURE outstring20(text: alfa20);
FORWARD;

FUNCTION readchar: char;
FORWARD;

FUNCTION readinteger: integer;
FORWARD;

PROCEDURE repeatchar;
FORWARD;

PROCEDURE testmodeout (text: alfa20; i: integer);
FORWARD;

PROCEDURE writenl;
FORWARD;

\f


FUNCTION dte_pax_addr (i:integer): int_pax_addr;
VAR pax_adr : int_pax_addr;
BEGIN
pax_adr.net_addr := params(i);
pax_adr.reg_addr := params(i+1);
pax_adr.node_addr := params(i+2);
pax_adr.ext_addr := params(i+3);
dte_pax_addr := pax_adr;
END;

PROCEDURE make_phead (
i : integer; op_code : byte;
VAR p : format_1_packet_header );
BEGIN
WITH p DO
BEGIN
format := rut_format_1;
priority := rut_prio_0;
packet_type := rut_pack_type;
state := 0;
org := dte_pax_addr(i);
dst := dte_pax_addr(i+3);
facility := params(9);
user_field := op_code *256 + params(2);
top_of_data := 0;
END;
END;

\f


FUNCTION packmacro (
par:integer):macroaddr;
VAR
a:macroaddr;
BEGIN
a.dc_addr := params( par);
a.nc_addr := params( par+1);
a.ts_addr := params( par+2);
packmacro := a;
END;

FUNCTION packextnode (
par:integer) : ext_pax_addr;
VAR
i:integer;
a:ext_pax_addr;
BEGIN
FOR i:=1 TO 6 DO
a(i):=0;
FOR i:=0 TO 2 DO
a(7+i):=params(par+i);
FOR i:= 10 TO 14 DO
a(i) := 0;
packextnode := a;
END;

\f


PROCEDURE get_curbuftype;
BEGIN
IF cur^.size < minbufsize THEN
curbuftype:= 0 ELSE
IF cur^.size < messbufsize THEN
curbuftype:= 1 ELSE
IF cur^.size < maxbufsize THEN
curbuftype:= 2 ELSE
IF cur^.size < testbufsize THEN
curbuftype:= 3 ELSE
curbuftype:= 4;

CASE curbuftype OF
0: curbufsize:= 0;
1: curbufsize:= minbufsize;
2: curbufsize:= messbufsize;
3: curbufsize:= maxbufsize;
4: curbufsize:= testbufsize;
END;
END;

\f


PROCEDURE getinput;
(* reads input from console into opinref^ *)
BEGIN

testmodeout ("getinput called     ",0);

REPEAT
LOCK opinref AS opbuf: opbuftype DO
opbuf.next:= firstindex;
signal (opinref, opsem^);
wait (opinref, wrsem);
UNTIL opinref^.u2= ok (* 0*);

LOCK opinref AS opbuf: opbuftype DO
WITH opbuf DO
BEGIN
incharsleft:= next - first;
next:= firstindex;
END;
command:= readchar;

testmodeout ("command read:       ",ord(command));

getparams;
END (* getinput *);

\f


PROCEDURE getparams;
(* reads integer parameters *)
VAR newbase: boolean;
BEGIN
testmodeout ("getparams called    ",0);

noofparams:= 0;

IF command IN (."a","b","c","d","e","f","k","n","o","p","s","t","w","x".)
THEN
BEGIN (* change to decimal *)
oldbase:= base;
base:= 10;
newbase:= true;
END
ELSE
newbase:= false;

REPEAT
noofparams:= noofparams + 1;
params(noofparams):= readinteger;
testmodeout ("parameter read:     ",params(noofparams));
IF (noofparams=1) THEN
IF command IN (."f","p".) THEN
BEGIN (* change to old *)
base:= oldbase;
newbase:= false;
END;

UNTIL (NOT readok) OR (noofparams= 50);

noofparams:= noofparams - 1;

IF newbase THEN
(* change back to old base *)
base:= oldbase;
END (* getparams *);

\f


PROCEDURE init_proc(
index: integer;
name,
inc_name : alfa;
p    : processrec;
size,
prio : integer);
VAR
okl,
ok   : integer;
BEGIN
IF NOT nil(sh(index)) THEN
outstring20(alreadyexists) ELSE
BEGIN
IF noofparams<2 THEN st:= size;
okl:= link(name,p.processref^);
ok:= create(inc_name,p,sh(index),st);
IF ok=0 THEN
start(sh(index),prio) ELSE
BEGIN
ok:= ok*100+okl;
outstring20(createerror);
outstring12(inc_name);
outdecimal(ok,5);
writenl;
okl:= unlink(p.processref^);
END;
END;
END;

\f


PROCEDURE init_modul(index: integer);
CONST
n1 = "fesupervisor";
n2 = "streamer    ";
n3 = "osif        ";
n4 = "timeout     ";
n5 = "lam         ";
n6 = "tap         ";
n7 = "netconnector";
n8 = "dtesimulator";
n9 = "tapdte      ";
n10= "tapnet      ";
BEGIN
CASE index OF
1: (* fesup *)
init_proc(index, n1, n1,
fesupervisor( opsem,
sem(fesup_sem_no), sem(fesup_que),
sem(stream_sem_no).s, sem(netc_sem_no).s, sem(com_pool).w ),
fesup_size, fesup_pri );
2: (* streamer *)
init_proc(index, n2, n2,
streamer( sem(stream_sem_no), sem(stream_xmit),
sem(stream_rec), 5, opsem), stream_size, stream_pri);
3: (* osif *)
init_proc(index, n3, n3,
osif( opsem, sem(osif_sem_no), sem(stream_sem_no).s, 7),
osif_size, osif_pri);
4: (* timeout *)
init_proc(index, n4, n4,
timeout( opsem, sem(timeout_sem_no), time_out_unit, 40),
tim_size,tim_pri);
5: (* lam *)
init_proc(index, n5, n5,
lam( opsem, pu, 5, sem(lam_sem_no)),
lam_size, lam_pri);
6: (* tap *)
init_proc(index, n6, n6,
tap( opsem, sem(tap_sem_no)),
512, 0);
11: (* tap01 *)
init_proc(index, n6, "tap01       ",
tap ( opsem, sem(tap1_sem_no)),
512, 0);
7: (* netconnector *)
init_proc ( index, n7, n7,
\f


netconnector( glob_timeout, opsem,
sem( pax_pool),sem( netc_sem_no), netc_locals,
sem( com_pool).w,
sem( timeout_sem_no).s, sem( net_int4).s),
netc_size, netc_pri);

8: (* dtesimulator *)
init_proc ( index, n8, n8,
dtesimulator ( opsem, sem( pax_pool), sem(net_int4),
sem( netc_sem_no).s,
sem( net_int2).s, sem( net_int1).s,
dte_pax_addr(3)),
netc_size, netc_pri);
9: (* tapdte *)
init_proc ( index, n9, n9,
tapdte ( opsem, sem(tapdte_sem_no)),
512,0);
10: (* tapnet *)
init_proc ( index, n10, n10,
tapnet ( opsem, sem(tapnet_sem_no)),
512,0);



OTHERWISE
BEGIN
outdecimal(index,4);
outstring10(illegalno);
END;
END (* case *)
END;

\f


FUNCTION moduleready(moduleno: integer): boolean;
(* tests if an incarnation of the module is existing
and writes an errormessage if so *)
BEGIN
IF nil( sh( moduleno) ) THEN moduleready:=true
ELSE
BEGIN  (* module is already existing *)
outdecimal(moduleno,4);
outstring20(alreadyexists);
moduleready:=false;
END;
END (* module ready *);



\f


PROCEDURE outchar(ch:char);
(* writes ch into the output buffer *)
BEGIN
LOCK opoutref AS opbuf: opbuftype DO
WITH opbuf DO
BEGIN
last:= last + 1;
data (last):= ch;
END;
END (* outchar *);

\f


PROCEDURE outdecimal (int, positions: integer);
(* writes the integer "int" decimally into opbuf starting
at "last", which is updated accordingly *)

BEGIN
oldbase:= base;
base:= 10;
outinteger(int,positions);
base:= oldbase;
END (* outdecimal *);

\f


PROCEDURE outinteger(int,positions:integer);
(* writes the integer "int" into opbuf starting at
"last", which is updated accordingly *)
CONST
maxpos = 20; (* max number of positions in layout *)

VAR
bits: ARRAY(0..15) OF bit;
digits:ARRAY(1..maxpos) OF char;
curdigit, (* current pos. in digits-array to be filled out *)
curpos,   (* cur. pos. in the nunber being computed *)
h, i,
m, newm,
noofdig,  (* no. of digits in the resulting number *)
noofpos,  (* no. of pos. from bits-array for one number *)
res,      (* resulting number *)
used: integer;

negative, zeroes: boolean;

BEGIN
used:= 1;

(* first we initialise the digits array *)
FOR i:=1 TO maxpos DO digits(i):=sp;

IF base= 10 THEN
BEGIN
i:=maxpos;

negative:= int<0;

REPEAT
(* now we unpack the digits backwards and put them
into the digits array *)

digits(i):= chr (abs(int MOD base) + ord("0"));
int:=int DIV base;
i:=i-1;
UNTIL (i=1) OR (int=0);

IF negative THEN
BEGIN
digits(i):="-";
i:=i-1;
END;
\f



used:=maxpos-i;

IF int <> 0 THEN digits(1):= "*";
END (* if base= 10 *)

ELSE (* base= 2, 8, or 16 *)
BEGIN
(* initialise bits-array *)
IF int>=0 THEN
BEGIN
FOR i:= 15 DOWNTO 1 DO
BEGIN
bits(i):= int MOD 2;
int:= int DIV 2;
END;
bits(0):= int MOD 2;
int:= int DIV 2;
END
ELSE
(* int<0 *)
BEGIN
(* subtract abs(int) from 1111111...1 *)
FOR i:= 15 DOWNTO 1 DO
BEGIN
bits(i):= 1+(int MOD 2);
int:= int DIV 2;
END;
bits(0):= 1+(int MOD 2);
int:= int DIV 2;

(* add 1 *)
m:= 1;
FOR i:= 15 DOWNTO 1 DO
BEGIN
newm:= (bits(i)+m) DIV 2;
bits(i):= (bits(i)+m) MOD 2;
m:= newm;
END;
newm:= (bits(0)+m) DIV 2;
bits(0):= (bits(0)+m) MOD 2;
m:= newm;
END (*int<0*);

(* compute digits-array *)
CASE base OF
\f


2: BEGIN
noofpos:= 1;
noofdig:= 16;
END;

8: BEGIN
noofpos:= 3;
noofdig:= 6;
END;

16: BEGIN
noofpos:= 4;
noofdig:= 4;
END;
END (* case *);

curdigit:= maxpos -noofdig +1;

IF base= 8
THEN curpos:= 3
ELSE curpos:= 1;
res:= 0;
zeroes:= true;

FOR h:= 0 TO 15 DO
BEGIN
res:= res*2 + bits(h);
IF curpos= noofpos THEN
BEGIN (* time to fill out a pos. in digits-array *)
IF zeroes AND (res=0) THEN
BEGIN
IF curdigit=maxpos
THEN digits(curdigit):= "0"
(*else digits (curdigit):= " "*);
END
ELSE
IF res<=9
THEN digits(curdigit):= chr (res + ord ("0"))
ELSE digits(curdigit):= chr (res + ord ("7"));
IF (res<>0) AND zeroes THEN
BEGIN
zeroes:= false;
used:= maxpos - curdigit + 1;
END;
res:= 0;
curpos:= 0;
\f


curdigit:= curdigit + 1;
END;
curpos:= curpos + 1;
END;
END (* base= 2, 8, of 16 *);

IF positions<used THEN outchar(sp);

IF (NOT (positions IN (. 1 .. maxpos .)) )
OR (positions < used) THEN
positions:=used;

FOR i:=maxpos+1-positions TO maxpos DO
BEGIN
outchar( digits(i) );
END

END (* out integer *);



\f


PROCEDURE outstring10(text: alfa10);
(* writes the text into opbuf starting at outputpointer
which is updated accordingly *)
VAR
i: integer;
BEGIN
FOR i:=1 TO 10 DO
outchar( text(i) );
END (* out string 10 *);

PROCEDURE outstring12(text: alfa);
VAR
i: integer;
BEGIN
FOR i:=1 TO 12 DO
outchar(text(i));
END;

\f


PROCEDURE outstring20(text: alfa20);
(* analogue to outstring10 *)
VAR
i: integer;
BEGIN
FOR i:=1 TO 20 DO
outchar( text(i) );
END (* out string 20 *);




\f


FUNCTION readchar: char;
(* reads the next char from opinref^.
next is incremented and charsleft is
decremented *)
BEGIN
LOCK opinref AS opbuf: opbuftype DO
WITH opbuf DO
BEGIN
readchar:= data(next);
next:= next + 1;
END;
incharsleft:=incharsleft-1;
END (* readchar *);




\f


FUNCTION readinteger : integer;
(* reads the next integer from opinref^ starting
at "inputpoint". upon return "inputpoint" will be
the position just after the last char read.

the global boolean "readok" will be true if an
integer was read and false otherwise *)

CONST
digits = (. "0" .. "9" .);
hexdigits = (. "a" .. "f" .);
signs =  (. "+" , "-" .);

VAR
negative, digit: boolean;

curdigit, noofdigit,
result: integer;

ch,lastchar: char;


BEGIN
readok:=false;
lastchar:=nul;
ch:=nul;
digit:=false;

(* now skip until a digit is encountered *)

IF incharsleft > 0 THEN
REPEAT
lastchar:=ch;
ch:=readchar;
digit:= (ch IN digits) OR
((base= 16) AND (ch IN hexdigits))
UNTIL digit OR (incharsleft<=0);

result:=0;
IF base= 10 THEN
negative:= lastchar= "-"
ELSE negative:= false;


IF digit THEN
BEGIN
\f


IF ch IN digits
THEN result:= ord (ch) - ord ("0")
ELSE result:= ord (ch) - 87 (*ord ("W")*);
readok:=true;
END;

IF base=10 THEN
BEGIN
WHILE digit AND (incharsleft>0) DO
BEGIN (* read the digits *)
ch:= readchar;

digit:= (ch IN digits) OR
((base= 16) AND (ch IN hexdigits));
IF digit THEN
BEGIN
IF negative AND (result=3276) AND (ch="8")
THEN BEGIN
result:= -32768;
negative:= false;
END
ELSE
BEGIN
IF ch IN digits
THEN result:= result*base+(ord(ch)-ord("0"))
ELSE result:= result*base+(ord(ch)-87(*ord("W")*));
END;
END;
END (* while *);

IF negative THEN result:= - result;

END (* base= 10 *)

ELSE
BEGIN (* base= 2, 8, or 16 *)

CASE base OF
2:BEGIN
IF ch="1" THEN negative:= true;
noofdigit:= 16;
END;

8: BEGIN
IF ch="1" THEN negative:= true;
noofdigit:= 6;
\f


END;

16: BEGIN
IF ch>="8" THEN negative:= true;
noofdigit:= 4;
END;
END (*case*);
curdigit:= 1;

WHILE digit AND (incharsleft>0) DO
BEGIN
ch:= readchar;
digit:= (ch IN digits) OR
((base=16) AND (ch IN hexdigits));
IF digit
THEN BEGIN
curdigit:= curdigit+1;
IF (curdigit=noofdigit) AND negative THEN
BEGIN
CASE base OF
2: result:= result - 16384 (*2^14*);
8: result:= result -  4096 (*2^12*);
16:result:= result -  2048 (*2^11*);
END (*case*)
END;
IF ch IN digits THEN
result:= result*base + (ord(ch)-ord("0"))
ELSE
result:= result*base + (ord(ch)-87 (*ord("W")*));
IF (curdigit=noofdigit) AND negative
THEN BEGIN
IF result=0
THEN result:= -32768
ELSE result:= -((32767-result)+1);
END;
END (*if digit*);
END (*while digit*);
END (* base= 2, 8, or 16 *);
IF incharsleft > 0 THEN
(* we read one char too many - spit it out *)
repeatchar;

readinteger:=result;
END (* read integer *);

\f


PROCEDURE repeatchar;
BEGIN
LOCK opinref AS opbuf: opbuftype DO
opbuf.next:= opbuf.next - 1;
incharsleft:= incharsleft + 1;
END;

\f


FUNCTION testinterval (i,first,last: integer): boolean;
(* true if first<=i<=last *)
BEGIN
IF (i<first) OR (i>last) THEN
BEGIN
outstring10(illegalno);
outinteger(i,4);
writenl;
testinterval:= false
END
ELSE
testinterval:= true;
END;

\f


PROCEDURE testmodeout (text: alfa20; i: integer);
BEGIN
IF testmode THEN
BEGIN
outstring20 (text);
outinteger (i, 4);
writenl;
END;
END (* testout *);

\f


PROCEDURE testsem(i: integer; VAR t_sem : semaphore);
(* test the semaphore t_sem, and
writes its status on the console if it is
non-passive *)
VAR more: boolean;
BEGIN

IF i>0 THEN
BEGIN
ap.a := sem(i).s;
bp.a := sem(i).w;
END
ELSE ap:=bp;
IF open(t_sem) THEN
BEGIN (* user semaphore no. i is open *)
IF ap=bp THEN
outchar(" ") ELSE outchar("^");
outdecimal(i,3);
outchar(":");
more:= true;

(* now count the no. of buffers on this semaphore *)
j:=0; (* j is the counter *)
WHILE more DO
BEGIN
sensesem(countref, t_sem);
IF nil(countref) THEN
more:= false
ELSE
BEGIN
signal(countref,countsem);
j:=j+1;
END
END;

outdecimal(j,3);
WHILE open(countsem) DO
BEGIN (* return the buffers to sem(i) *)
wait(countref,countsem);
signal(countref,t_sem);
END;

writenl;
END (* open *)
ELSE
IF locked( t_sem) THEN
\f


BEGIN (* user semaphore no. i is locked *)
IF ap=bp THEN
outchar(" ") ELSE outchar("^");
outdecimal(i,3);
outchar(":");
outstring10(" locked   ");
writenl;
END;
END (* testsem *);





\f


PROCEDURE writenl;
(* prepares opbuf for output to the operator and signals
it to operator module *)
BEGIN
IF NOT nil(opoutref) THEN
BEGIN
outchar(nl);
signal(opoutref, opsem^)
END;
wait(opoutref, wsem);
LOCK opoutref AS opbuf: opbuftype DO
opbuf.last:= firstindex;
END (* writenl *);


\f





(****************************************
*                                       *
*       m a i n   p r o g r a m         *
*                                       *
****************************************)






BEGIN

opsem:= semvector(operatorsem);
testmode:= false;
testopen (z,own.incname,opsem);
testout(z,version,fe_env_version);

(* initialise pointers *)
FOR i:=1 TO ts_sem_total DO
BEGIN
sem(i).s:= ref(ts_sem(i));
sem(i).w:= sem(i).s;
END;

(*  initialize pointers to eva semaphores *)
sem(net_int1).s:=ref(evavector(px_urec));
sem(net_int1).w:=sem(net_int1).s;
sem(net_int2).s:=ref(evavector(px_utrm));
sem(net_int2).w:=sem(net_int2).s;
sem(net_int3).s:=ref(evavector(px_ncp));
sem(net_int3).w:=sem(net_int3).s;
sem(lam_sem_no).s:= ref(evavector(al_lam1));
sem(lam_sem_no).w:= sem(lam_sem_no).s;

(*  initialize local semaphores for netconnector  *)

netc_locals(1):=sem(tssup_sem_no).s;
netc_locals(2):=sem(nc_sem_no).s;

(* initialise buffers *)
FOR i:= 1 TO 2 DO
BEGIN
\f


alloc (opoutref, opbufpool, wsem);
opoutref^.u1:=2; (* write *)
LOCK opoutref AS opbuf: opbuftype DO
WITH opbuf DO
BEGIN
first:= firstindex;
name:= opsysname;
data(firstindex):= "!";
END;
return (opoutref);
END;
writenl;

alloc(opinref, opbufpool, wrsem);

opinref^.u1:=1; (* read *)

LOCK opinref AS opbuf: opbuftype DO
WITH opbuf DO
BEGIN
first:= firstindex;
last:= lastindex;
name:= opsysname;
END;

(*-------    allocate all listenbuffers ---*)
FOR i:= 1 TO no_listen DO
BEGIN
alloc(cur,messbufpool,sem(com_pool).s^);
return(cur);
END;

(*-------    allocate all paxnetbuffers ---*)
FOR i:=1 TO no_pax_bufs DO
BEGIN
alloc( cur, paxbufpool, sem(net_int4).s^);
signal( cur, sem( pax_pool).s^);
END;

st:= 1024;
base:= 10;
firstword:= 1;
lastword:= 10;

setoflowmask(true);

\f


noofparams:= 0;
(* insert auto create with edit here *)

REPEAT
(* read a line of input from the operator and execute it *)

getinput;

CASE command OF

";": (* comment command *)
BEGIN
END;

\f


"a": (* alloc *)
(* a buffer is allocated from the messbufpool to the current
reference "cur".
1st param is the answersem *)
BEGIN
semno:= params(1);

IF noofparams >= 1 THEN
IF nil(cur) THEN
IF ((semno>0) AND (semno <= noofsemaphores))
OR ((semno<0) AND (semno >= -applsem_max)) THEN
BEGIN
IF semno > 0 THEN
alloc (cur, testbufpool, ts_sem(semno))
ELSE
alloc (cur, testbufpool, evavector(-semno));
WITH cur^ DO
BEGIN
u1:= 0;
u2:= 0;
u3:= 0;
u4:= 0;
END;
get_curbuftype;
outstring10("  bufsize ");
outinteger(curbufsize, 5);
outinteger(cur^.size, 5)
END
ELSE outstring10(illegalno)
ELSE outstring20("you already have one")
ELSE outstring10(noparam)
END (* alloc*);

\f


"b": (* base *)
(* defines the number base for input as well as output *)
(* the base is always read decimally *)
BEGIN
IF noofparams < 1 THEN
BEGIN
base:= oldbase;
outstring10(noparam)
END
ELSE

IF NOT (params(1) IN (. 2, 8, 10, 16 .) ) THEN
BEGIN (* illegal base *)
outstring20("illegal base        ");
base:= oldbase;
END
ELSE
base:= params(1);
END;

\f


"c": (* create *)
(* an incarnation of each of the predefined modules to be tested
is created and started.
params are nos. of the modules to be created and started *)

IF noofparams >= 1 THEN

BEGIN
moduleno:= params(1);

IF noofparams>1 THEN st:= params(2);

IF (moduleno<1) OR (moduleno > noofmodules) THEN
BEGIN (* illegal no *)
outdecimal(moduleno,4);
outstring10(illegalno);
END
ELSE
IF moduleready(moduleno) THEN init_modul(moduleno);
END (* if noofparams >= 1 *)
ELSE outstring10 (noparam);
(* end create *)

\f


"d": (*  test dtesimulator  *)
BEGIN
outstring10("test dte  ");

sensesem( nref, sem( pax_pool).w^);

IF NOT nil( nref) THEN
BEGIN
nref^.u2 := 7;
nref^.u4 := from_link;

CASE params(1) OF

1: (* answer to connect ext *)
BEGIN
nref^.u1 := rut_con;
nref^.u2 := rut_ok;
nref^.u3 := 7;

LOCK nref AS buf: rut_prefix_type DO
buf.ext_no := params(2);
(* ie  d 1 20  answers on connect ext 20 *)
END;

2: (* call request *)
BEGIN
nref^.u1 := dte_car;
nref^.u3 := params(2);
nref^.u4 := to_link;
LOCK nref AS buf:car_buf_type DO
WITH buf DO
BEGIN
first := ric_first_val;
last := ric_first_val+l_control+l_listen-1;
q_bit := false;
WITH call_buf DO
BEGIN
control.op_code := dte_car;
dte_adr_l := l_dte_adr;
dte_adr := packextnode(3);
facility_l := l_facilities;
facility := params(6);
FOR i := 1 TO l_listen DO
alarm_mess(i):=i;
END;
END;
\f


END;
(* ie d 2  1  0 0 3  0 sends a call to 3 on stream 1 *)
(* ie d 2  2  0 0 4  0 sends a call to 4 on stream 2 *)

3: (* call accepted from remote user *)
BEGIN
nref^.u1 := rut_rec;
nref^.u2 := rut_ok;
nref^.u3 := rut_default;
LOCK nref AS buf: rut_trp_pdata DO
WITH buf DO
make_phead( 3, dte_aic, phead);
END;
(* ie d  3  1  0 0 3  0 0 2  0  is 3 accepting call from 2 *)

4: (* send data to remote user *)
BEGIN
nref^.u1 := dte_sdata;
nref^.u3 := params(2);
LOCK nref AS buf : dte_sdata_data DO
WITH buf DO
BEGIN
q_bit := false;
m_bit := false;
control.op_code := dte_sdata;
FOR i := 1 TO l_listen DO
alarm_mess(i) := i;
END
END;
(* ie d  4  1      sends data on stream 1 *)



OTHERWISE
outstring10("undef test");
END;
signal( nref, sem( net_int4).s^);
END
ELSE
outstring10("no paxbufs");

END;

\f


"f": (* fill *)
(* fills integers into current buffer.
1st param: first word no. to be filled,
following: values to be assigned *)
BEGIN
IF noofparams < 2 THEN
outstring10("param     ")
ELSE
IF (params(1) < 1) THEN
outstring20("illegal start       ")
ELSE
IF nil(cur) THEN
outstring10("no buffer ")
ELSE
BEGIN (* params are ok *)
i:= params(1); (* i points into the messbuf *)

FOR j:= 2 TO noofparams DO
(* j points into the param list *)
IF i <= curbufsize THEN
BEGIN
CASE curbuftype OF
1: LOCK cur AS minbuf: minbuftype DO
minbuf(i):= params(j);
2: LOCK cur AS messbuf: messbuftype DO
messbuf(i):= params(j);
3: LOCK cur AS maxbuf: maxbuftype DO
maxbuf(i):= params(j);
4: LOCK cur AS testbuf: testbuftype DO
testbuf(i):= params(j);
OTHERWISE
END;
i:= i + 1;
END;

END (* params ok *)
END (* fill *);

\f


"h": (* help *)
(* lists possible commands and no. of parameters *)
BEGIN
outstring20("comm and no of param"); writenl;
outstring20("a: allocate   1     "); writenl;
outstring20("b: base       1     "); writenl;
outstring20("c: create     >=1   "); writenl;
outstring20("e: execute    1     "); writenl;
outstring20("f: fill       2     "); writenl;
outstring20("h: help       0     "); writenl;
outstring20("i: init point 0     "); writenl;
outstring20("k: kill       >=1   "); writenl;
outstring20("o: output     0 to 2"); writenl;
outstring20("p: partial    >=3   "); writenl;
outstring20("r: return     0     "); writenl;
outstring20("s: signal     1     "); writenl;
outstring20("t: test       0 or 1"); writenl;
outstring20("u: user param 1 to 4"); writenl;
outstring20("w: wait       1     "); writenl;
outstring20("x: exch point 2     "); writenl;
outstring20(";: comment          ");
END;

\f


"i": (* initialise pointers *)
IF noofparams=0 THEN
FOR i:=1 TO noofsemaphores DO sem(i).w:= sem(i).s ELSE
IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
sem(params(1)).w:= sem(params(1)).s ELSE
outstring10(valparam);

\f


"e", (* exception *)
(* call of exception routine in one or more incarnations *)
"k": (* kill *)
(* removes incarnation of tested module(s)
params are nos. of modules to be removed *)

IF noofparams >= 1 THEN
FOR i:= 1 TO noofparams DO
BEGIN
moduleno:= params(i);
IF (1<=moduleno) AND (moduleno<=noofmodules) THEN
IF NOT nil(sh(moduleno)) THEN
IF command="e" THEN
break(sh(moduleno),#h2f) ELSE
remove (sh(moduleno))
ELSE
BEGIN
outdecimal (moduleno, 4);
outstring10(" not alive");
writenl;
END
ELSE
BEGIN
outdecimal (moduleno, 4);
outstring10(illegalno);
writenl;
END
END
ELSE outstring10("no params ");

\f


"m": (* testmode *)
testmode:= NOT testmode;

\f


"n": (*  test netconnector *)
BEGIN
outstring10("test netc ");

sensesem( nref, sem( pax_pool).w^);

IF NOT nil( nref) THEN
BEGIN

nref^.u2 := 7;

CASE params(1) OF

1: (* update pax-table from local sup *)
BEGIN
nref^.u3 := tss_route;
nref^.u4 := #hac;

LOCK nref AS buf : RECORD
a:alarmlabel;
i : integer;
p:paxnet_e;
END DO
WITH buf DO
BEGIN
a.update := insert_code;
a.rec.macro := packmacro(2);
a.rec.micro := netc_mic_addr;
a.send.macro := packmacro(5);
p.al_mac_addr := packmacro(8);
p.pax_addr := packextnode(11);
i := params(14);
p.stream_no := params(15);
END;
(*       receiver sender al-mac  pax indx stream       *)
(* ie n 1  0 0 0  1 0 0  1 2 2  0 0 2  1  0 sets netc address *)
(* ie n 1  1 2 2  1 0 0  1 2 2  0 0 2  2  1 sets tssup addr   *)
(* ie n 1  1 2 2  1 0 0  1 2 0  0 0 2  3  2 sets ncsup addr   *)
(* ie n 1  1 2 2  1 0 0  1 3 2  0 0 3  4  0 sets global ts-adr*)
(* ie n 1  1 2 2  1 0 0  1 3 0  0 0 3  5  0 sets global nc-adr*)
END;

\f


2 : (* update pax-table from net *)
BEGIN
nref^.u3 := params(15);
nref^.u4 := to_link;

LOCK nref AS buf : RECORD
x,y,z:integer;
b1,b2:boolean;
d:byte;
control: control_field_type;
a:alarmlabel;
i:integer;
p:paxnet_e;
END DO
WITH buf DO
BEGIN
a.update := insert_code;
a.rec.macro := packmacro(2);
a.rec.micro:=netc_mic_addr;
a.send.macro:=packmacro(5);
p.al_mac_addr := packmacro(8);
p.pax_addr := packextnode(11);
i:=params(14);
p.stream_no := 0;
END;
END;
(*       receiver sender al-mac  pax  indx stream  *)
(* ie n 2  1 2 2  1 0 0  1 4 2  0 0 4  6  1   sets global ts-addr *)
(* ie n 2  1 2 2  1 0 0  1 4 0  0 0 4  7  1   sets global nc-addr *)
(* ie n 2  1 2 2  1 0 0  1 5 2  0 0 5  8  1   sets global ts-addr *)
(* ie n 2  1 2 2  1 0 0  1 5 0  0 0 5  9  1   sets global nc-addr *)

\f


3:  (* send alarmmessage *)
BEGIN
nref^.u3 := tss_route;
nref^.u4 := #h30;

LOCK nref AS abuf : alarmlabel DO
abuf.rec.macro := packmacro(2);

(*        receiver *)
(* ie n 3  1 2 2   gives an alarm to tssup itself  *)
(* ie n 3  1 2 0   gives an alarm to ncsup local   *)
(* ie n 3  1 3 2   gives an alarm to tssup global  *)
(* ie n 3  1 3 0   gives an alarm to ncsup global  *)
END;


OTHERWISE
outstring10("undef test");
END;
signal( nref, sem( netc_sem_no).s^);
END
ELSE
outstring10("no paxbufs");
END;


\f


"o": (* output *)
(* outputs current buffer incl. user parameters
1st param is firstword,
2nd param is lastword *)
BEGIN
IF nil(cur) THEN
outstring10 ("no buffer ")
ELSE
BEGIN
outchar("u");
outchar(":");

outinteger(cur^.u1,4);
outinteger(cur^.u2,4);
outinteger(cur^.u3,4);
outinteger(cur^.u4,4);
writenl;

IF (noofparams>=1) AND (params(1)>=1)
AND (params(1)<= curbufsize) THEN
firstword:= params(1);

IF (noofparams>=2) AND (params(2)<=curbufsize) THEN
lastword:= params(2);
IF lastword>curbufsize THEN
lastword:= curbufsize;

IF cur^.size<curbufsize THEN
outstring20("too small buffer    ") ELSE
FOR i:= firstword TO lastword DO
BEGIN
outdecimal(i,3);
outchar(":");
CASE curbuftype OF
1: LOCK cur AS minbuf: minbuftype DO
j:= minbuf(i);
2: LOCK cur AS messbuf: messbuftype DO
j:= messbuf(i);
3: LOCK cur AS maxbuf: maxbuftype DO
j:= maxbuf(i);
4: LOCK cur AS testbuf: testbuftype DO
j:= testbuf(i);
OTHERWISE
j:= 0;
END;
IF base= 2 THEN
\f


outinteger(j,17)
ELSE
outinteger(j,7);
writenl;
END;
END (* ok *);
END (* output *);

\f


"p": (* partial words *)
(* fills partial words i.e. bytes into current buffer.
1st param: word no. in which to start
2nd param: byte no. (of 1st word) in which to start:
-           0: left byte
-           1: right byte
following: byte values to be assigned *)
BEGIN
IF noofparams<2 THEN
outstring10("param     ")
ELSE
IF (params(1)<1) THEN
outstring20("illegal start-word  ")
ELSE
IF NOT (params(2) IN (.0,1.)) THEN
outstring20 ("2nd must be 0 or 1  ")
ELSE
IF nil (cur) THEN
outstring10 ("no buffer ")
ELSE
BEGIN (* params are ok *)
i:= params(1); (* i points into current buffer *)
j:= params(2);

IF cur^.size<messbufsize THEN
outstring20("too small buffer    ") ELSE
LOCK cur AS messbuf: messbuftype DO
BEGIN
IF messbuf(i)<0 THEN
leftbyte:= (messbuf(i)+255) DIV 256
ELSE
leftbyte:= messbuf(i) DIV 256;

FOR k:= 3 TO noofparams DO
(* k points into the parameter list *)
IF i<= messbufsize THEN
BEGIN
CASE j OF
0:
BEGIN (* left *)
rightbyte:= abs(messbuf(i) MOD 256);
leftbyte := params (k);
END;
1:
BEGIN (* right *)
rightbyte:= params (k);
\f


IF leftbyte>=128 THEN
BEGIN
messbuf(i):= (leftbyte-128)*256 + rightbyte;
IF messbuf(i)>0 THEN
messbuf(i):= -((32767-messbuf(i))+1)
ELSE messbuf(i):= -32768;
END
ELSE
messbuf(i):= leftbyte*256 + rightbyte;
i:= i+1;
END;

END (* case *);

j:= 1-j;
END;

IF (j=1) AND (i<=messbufsize) THEN
IF leftbyte>=128 THEN
BEGIN
IF messbuf(i)>0 THEN
messbuf(i):= (leftbyte-128)*256 + rightbyte
ELSE messbuf(i):= - 32768;
messbuf(i):= -((32767-messbuf(i))+1);
END
ELSE
messbuf(i):= leftbyte*256 + rightbyte;
END (* lock *);
END (* params ok *);
END (* partial *);

\f


"r": (* return *)
(* returns current buffer *)
IF nil(cur)
THEN outstring10("no buffer ")
ELSE return(cur);

\f


"s": (* signal *)
(* signals current buffer to one of the predefined semaphores.
1st param is semno *)
BEGIN
semno:= params(1);

IF noofparams >= 1 THEN
IF (1<=semno) AND (semno<=noofsemaphores) THEN
IF NOT nil(cur) THEN
signal (cur,ts_sem(semno))
ELSE outstring10("no buffer ")
ELSE
IF (semno <= -1) AND (semno >= -applsem_max) THEN
signal( cur, evavector( -semno))
ELSE outstring10(illegalno)
ELSE outstring10(noparam)
END (* signal *);

\f


"t": (* testsem *)
(* tests the status of the specified semaphores.
if none is specified, the status of all the
user semaphores is given.
in both cases nothing will be written for a semaphore
if it is passive. *)
BEGIN
IF noofparams=0 THEN
BEGIN (* test all semaphores *)

FOR i:= -applsem_max TO -1 DO
testsem( i,evavector(-i));

FOR i:=1 TO noofsemaphores DO
testsem(i,ts_sem(i))
END (* test all *)
ELSE
BEGIN (* test the specified semaphores *)

FOR i:=1 TO noofparams DO
IF (params(i)=0) OR (params(i)>noofsemaphores)
OR (params(i) < -applsem_max) THEN
BEGIN (* illegal no. *)
outstring20("illegal no.:        ");
outdecimal(params(i),3);
writenl;
END (* illegal no *)
ELSE
BEGIN
IF params(i)>0 THEN
testsem( params(i), ts_sem(params(i)))
ELSE
testsem( params(i), evavector(-params(i)));
END
END (* test the specified semaphores *)
END (* testsem *);


\f


"u": (* user parameters *)
(* inserts user param into header of current buffer
1st param is u1
2nd param is u2
3rd param is u3
4th param is u4 *)
BEGIN
IF nil(cur)
THEN outstring10("no buffer ")
ELSE
IF noofparams = 0 THEN
outstring10(noparam)
ELSE
WITH cur^ DO
BEGIN
IF testinterval (params(1),0,255) THEN u1:= params(1);
IF (noofparams>=2) THEN IF testinterval(params(2),0,255) THEN
u2:= params(2);
IF (noofparams>=3) THEN IF testinterval(params(3),0,255) THEN
u3:= params(3);
IF (noofparams>=4) THEN IF testinterval(params(4),0,255) THEN
u4:= params(4);
END
END; (* end user parameters *)


\f


"w": (* wait *)
(* waits for semaphore semno.
1st param is semno *)
BEGIN
semno:= params(1);

IF noofparams >= 1 THEN
IF nil(cur) THEN
IF ((semno>0) AND (semno <= noofsemaphores))
OR ((semno<0) AND (semno >= -applsem_max)) THEN
BEGIN
IF semno > 0 THEN
sensesem( cur, ts_sem(semno))
ELSE
sensesem( cur, evavector(-semno));
IF nil(cur) THEN
outstring20("semaphore not open  ")
ELSE
BEGIN
get_curbuftype;
outstring10("  bufsize ");
outinteger(curbufsize, 5);
outinteger(cur^.size, 5)
END;
END
ELSE outstring10(illegalno)
ELSE outstring20("you already have one")
ELSE outstring10(noparam)
END (* wait *);

\f


"x": (* exchange pointer *)
BEGIN
IF noofparams >= 2 THEN
IF (params(1)>0) AND (params(1)<=noofsemaphores) THEN
IF (params(2)>0) AND (params(2)<=noofsemaphores) THEN
BEGIN
worksem:= sem(params(1)).w;
sem(params(1)).w:= sem(params(2)).w;
sem(params(2)).w:= worksem;
END
ELSE outstring10(valparam)
ELSE outstring10(valparam)
ELSE outstring10(noparam)
END (* exchange pointer *);


OTHERWISE (* error *)
outstring20 ("illegal comm. type h");
END (* case *);

IF command<>";" THEN
writenl;

UNTIL false;

END.




\f


9*   52*   81*  160*  160*  161*  299   304   326   327   330   337   347:  347   359 
387   436   488   492   511   515   571*  594   603   613   619   626   638   649 
650   677   680   685   695   700   701   800   806   808   824   871   893   900 
960  1105  1128  1129  1131  1137  1138  1139  1140  1346  1348  1450  1528  1553 
1577: 1588  1605  1647  1660  1669  1688  1693  1694  1696  1698  1712  1713  1715 
1738 
*   51*   71*   72*   73*   74*   81*   84*   85*  107*  156*  157*  284   314   325 
348:  400   403   412   463:  548   572*  585   588   602   603   608   613   621 
635   638   642   643   657   672   676   698   702   704   710   714   729   737 
762   764   869   878   895   910   911   969  1035  1053  1057  1074  1085  1092 
1124  1126  1156  1163  1169  1177  1180  1182  1184  1206  1208: 1228  1237  1266 
1292  1299  1306: 1316  1347  1348  1348  1349  1349  1358  1359  1362  1396  1398:
1503  1503  1504  1505  1519: 1550  1550  1553  1560  1582: 1589  1594  1599  1602 
1626  1628  1629  1634  1650  1653  1659  1693  1693  1708  1710  1737  1737  1740 

303   315   327   341   349:  433   469:  623   624   626   627   635   636   638 
645   646   649   650   656:  682   854:  882: 1054  1057  1060  1163  1182  1215 
: 1222  1259  1289  1301  1308: 1411  1427: 1444  1465  1507  1507  1508  1521: 1530 
1553  1561  1694  1694  1695  1736  1738  1738  1741  1742 
*  286   301   343   350:  473:  506   662   675   955   973   987  1234  1245: 1252 
: 1459: 1516  1523: 1572  1664  1696  1696  1697 
*  344   351:  477:  521   534   667   668   866   920   933  1186  1256: 1312: 1369 
1497  1498  1499  1500  1525: 1698  1698  1699 
*  162*  442   472   481:  483  1144  1145  1413  1446  1725  1726 
*  325   485:  663   861  1236 
*  161*  162*  328   475   493: 1203  1212  1394  1533 
:  661:  674   859:  883: 1163  1414  1447 
508:  692 
*  329   393   512:  559   590   729   809   822  1099  1101  1163 
*  489: 1415  1448 
*  737 
1416  1449 
*  621   633   643   680  1417  1429 
*  658   666:  805   829   856   864:  875   884: 1163 

*  568*  746 

*  410 
*
*   49*
841   890 

*   35*
1587  1603  1606 
\f


8  1693  1694  1696  1698 
1568  1570  1579  1587  1593  1606  1611 
492   511   515 





1589  1608 
894  1590  1607 
*  311*  313   314   315   316   323*  326=  328=  330=  331   947=  948= 1404: 1410 
1412  1413  1437: 1443  1444  1445  1446 
1579 
: 1465 
1437  1464 
= 1267=
*  259*  422*  733*
*  256*  723*
*  262*  274*  741*  928*
*
1072  1087  1094  1132  1134 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*  431   535 

= 1447=
*  947   950=  953   985 
1634  1650  1661  1713 
*
:  368:  545:  758:  909: 1008: 1061: 1076: 1214: 1224: 1250: 1260: 1306: 1308: 1310:
: 1403: 1432: 1464: 1519: 1521: 1523: 1525: 1565:
*
:
:
*  392   393=  406=  416=  558   559=  561=  590   600   601   655   674   805   809 
829   840   841   853   875   881   888   890  1099= 1158= 1166= 1169= 1530 
*
*  623=  626=  635=  638=  645   646=  646   649   650=  650   682 
*  241*  383*  527*  582*  784*  914*  942* 1434 
*  948   950   953   985 

: 1215  1224: 1225  1250: 1251  1260: 1261  1403: 1408  1432: 1441 
*   81*  211*  238*  291* 1435 


\f


2*  549   789*  795=  802   803=  804   805   816   817   818   826=  828   829   832 
840   841   855   860   865   873=  874   875   887   888   890 
*   84*   85*  126*  265*  542*  572*  753*  789*
693   694 
*  374=  376   389   404  1113  1364  1754 
*  467   497  1087 
*
1265  1436:
*
e                                               <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

*  963   964   968   976   977 
*  968   974   976 

*
*  440 
*  336   338   340   342  1087  1088  1094  1095  1127  1132  1134  1135  1145  1295 
: 1308: 1310: 1312: 1490  1497  1498  1499  1500  1512  1519: 1521: 1523: 1525: 1556 
1565: 1618  1620  1630  1631  1635  1685  1691  1711  1716  1718  1719  1726 
*  347=  348=  349=  350=  351= 1144  1303  1504  1507  1509  1510  1512  1725 
*  337=  339=  341=  343=  344=  346  1305  1518 
*  672=  687   688   693   694   698   702=  702   786*  869=  878=  878   879   891 
*  675=  676=  683   701=  704=  704 
:
*  549=  761  1066=
*  313=
*  796=  804=  806   814   824   828=  830   871   874=  876 
*  588=  600=  607=  613=  688=  693=  694=  716   779*  804   816   828   839   874 

*
=
*  503 
*
=
=

1232 
*  287=  300   301   506 
1265 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

*  220*
* 1042  1044  1046  1048  1134  1635  1651  1672  1718 
*  178*  184*  190*  195*  208*  222*  227*  232*  239*  242*
\f


6=
=
*  323*
= 1236=
=
407   536   697   793   796   811   835   922   965  1030  1229  1263  1264  1757 
*
*  465 




<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

*  371   914*  917  1064= 1079= 1227=
*   51*   67*  363   372  1009  1064  1066  1079 
* 1100= 1505= 1514 
=
eader                                           <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*

* 1111 
*  378   381*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* 1142  1723 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*

*  680=  682 



*  805   829   875 
*  274*  280*  283   284   285   286   291*  300   301   322*  325=  326   327=  328 
329=  330   575*  588=  588   592=  600   602=  602   603   607   608=  608   611 
=  623   633=  635   643=  645   646   646   714=  716   727*  729=  730   735*  737=
744*  746=  747   914*  917   917   920   928*  933   938*  945   947   948   955 
1035= 1037  1037  1038  1038  1057= 1085= 1092= 1237= 1238  1238  1266= 1267  1267 
= 1303  1307  1309  1311  1313  1316= 1316  1347= 1347  1347  1359= 1361  1405: 1416=
: 1449= 1514= 1516  1520  1522  1524  1526  1560= 1567  1568  1570  1574  1579  1587 
1589  1589  1590  1593  1594= 1594  1602  1605  1606  1607  1608  1608  1611  1650=
1651  1653= 1654  1654  1659= 1660  1660  1661  1664  1669  1670  1670  1672  1672 
*  522   919  1147  1187  1376  1636  1729 
*  371=  764=  764   800   806   824   871   900   911=  911 
\f


1 
*  435   441 
*  430   435   437   449*  462   464   470   474   478   482   486   490   494   502 
513   521 
* 1190 
*  464   470   474   478   482   486   490   494   502   509   513 
*  236*
*  175*
1443 
*  253*  553*  560   564*  594   600   601=  601   603   613   619   623   624=  624 
627=  627   635   636=  636   638   639=  639 
*   71*   72*   73*   74*  146*  156*  176*  183*  188*  250*  253*  268*  274*  280*
*  309*  320*  322*  420*  425*  428*  449*  527*  553*  564*  580*  727*  735*  744*
*  787*  914*  928*  938* 1405  1433  1438 
*  280*  281*
*  960=  969=  969   973  1301= 1307  1309  1311  1313  1520= 1522= 1524= 1526= 1528=
1533  1561= 1576  1599= 1599  1602 
* 1572= 1580  1584 
*  483 
*

1048  1049  1049 

*  548=  548   549   914*  917  1009= 1080= 1228=
*  794=  802=  810 
*   67* 1080 
* 1101= 1508= 1509  1510= 1514 
* 1568= 1570= 1580= 1585  1587  1593  1603  1606  1611 
*
*   51*

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*
:  368:  545:  758:  909: 1008: 1061: 1076: 1214: 1224: 1250: 1260: 1306: 1308: 1310:
: 1403: 1432: 1464: 1519: 1521: 1523: 1525: 1565:




1237  1266 
*  642=  645   646   647=  649   650   651=
= 1413= 1444= 1446= 1465=
*  160*  161*  161*  162*  162*  309*  311*
*
\f


0* 1252 
*
: 1311= 1523: 1524 
*   74*  340   350 
* 1310  1523 
*  572*  588   592   611   672   687   698   710   714   714 
: 1309= 1521: 1522  1565: 1567  1568  1570  1579  1587= 1588  1589= 1589  1590= 1593=
1606= 1607= 1608= 1608  1611=
* 1087 
*   71*  338   349  1563  1574  1602 
*   97* 1308  1521  1565 
= 1445=
: 1307= 1519: 1520 
*   73*  336   348 
* 1306  1519 
*
*  527*  531   534  1180= 1184  1184  1186  1190  1190  1361= 1362  1362  1363  1365 
1369  1375 
*  531=  536= 1190 
*  957=  961   965=
=
*  464   464 
*  513   513 
*  470   470 
*  474   474 
*  478   478 
*  482   482 
*  486   486   490 
*  494   494 
*  502   502 
*  509   509 
*  421*  434  1065= 1081=
*  314=

*  594=  605   784*  810=  811=  832   835=  846   855=  860=  865=  879   891 
*  495 
*  496  1053= 1054=
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*  216*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1445 
507 
*
496   504  1478 
\f


9   507 
=
1042  1043  1043 
1044  1045  1045 
1047  1047 
503  1094  1277 
*  394=  397=  407=  414 
*  645=  647   649=  651 
*  363=  371   372=  761   762=  762   910=  910 

=
*  658=  663=  668=  672 
*  856=  861=  866=  879   891 
*  157* 1184  1362 
*  387=  400=  400   401   402   403   410   412=  412   433  1105= 1126  1156  1177 
1289  1301  1346  1358  1359  1503  1507  1547  1572  1628  1647  1659  1688  1694 
1698  1710  1736 
*  657=  662=  667=  683 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
* 1128  1347  1348  1629  1653  1660  1712  1737  1738 
* 1149  1159  1192  1637  1689  1731  1746 
* 1085 
* 1092 
* 1199  1201  1203  1204  1210  1211  1212  1214: 1221  1222  1223  1224: 1247  1248 
1250: 1258  1259  1260: 1277  1389  1391  1394  1400  1401  1403: 1429  1430  1432:
1462  1464: 1478 
795 
*
*  366   428*  435=  436   439=  439   442 
*  434=  439   444=
*  392=  406   416   558=  561  1158  1166 
*  177*
:  363   368:  369   545:  546   758:  759   909:  910   910  1008: 1009  1061: 1062 
: 1077 
* 1059  1072 
*
*   94*  362   368   545   758   909  1008  1061  1076 
974 

*  362:  364   365   366   368:  758:  909: 1072  1074  1076:
*  545: 1002  1005  1007  1008: 1059  1060  1061: 1068 
*  181*  187*  193*  364   465   472   475   479   483   487   491   495   503   510 
1005  1029= 1031 
1081 
\f


1*  303  1232= 1265=
*  212*  225*  230*  235*
600   693   694   817   817   818   840   840   841   888   888   890 
=
*  475 



*  708   716   730   738   747   954   954   956   986   986   988  1004  1494  1495 

*  442   521   534   553*  955   973   987  1186  1369  1375  1516  1664 
*  560   564*  920   933  1144  1145  1497  1498  1499  1500  1531  1533  1725  1726 
*  522   723*  919   989  1143  1147  1149  1159  1187  1192  1197  1275  1280  1290 
1350  1370  1376  1380  1387  1476  1481  1491  1548  1557  1619  1632  1636  1637 
1689  1724  1729  1731  1744  1745  1746 
*  441   733*
*  431   440   535   741*  932  1148  1165  1293  1325  1326  1327  1328  1329  1330 
1332  1333  1334  1335  1336  1337  1338  1339  1340  1341  1342  1513  1551  1554 
1663  1720  1730  1751 

*  294   423*  434   435   444  1406: 1414  1415  1417  1439: 1447  1448  1450 
=
*  331= 1234  1415  1448 
*  316= 1411  1413  1414  1444  1446  1447  1465 
*  313   314   315   320*  328 
*  283   284   285   286   302   303   313   314   315   328   401=  402  1124  1163 
1180  1182  1206  1215  1222  1236  1259  1292  1299  1307  1309  1311  1313  1348 
1349  1349  1361  1396  1416  1417  1429  1449  1503  1504  1505  1507  1508  1550 
1560  1561  1580  1584  1626  1660  1660  1661  1664  1669  1670  1670  1672  1672 
1693  1694  1695  1696  1697  1698  1699  1708  1737  1737  1738  1738  1740  1741 
1742 
* 1094 
1439 
*   98*
= 1448=
*  283   284   285   286   287 
503  1095  1199  1389 
*  214*

*  165*
*   94*   96*   97*
*
*  253*  553*  560   564*  708   710   711   712=  714 
*
\f


5*  437 
=
*  168*  174*  180*  186*  192*  197*  210*  224*  229*  234*
*
444 
*  188*  483 



*
= 1263=
*  374   753*  761=  803   826   873 
*  401   770*  904=
*  410   793=  819=
1412  1444  1445  1465 
*
1042  1044  1046  1048 
*
=

*  902   907*
*  677=  682=  682   685   692   693   694   695   700=
*  808=  817=  818=  832   834=  840=  840   841=  841   846=  846   882=  882   883=
884=  884   888=  888   890=  890   893   894=  895=  895   904 
*
1088  1620 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1228 
* 1579= 1584= 1587  1593  1606  1611 



1248 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<



*
*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

467   475   498   498   504   505   505   947  1037= 1038  1042= 1043  1044= 1045 
= 1047  1048= 1049  1053  1054  1087  1094  1095  1277  1347  1349  1478 
\f


0*  226*  231*  466   466   467   467   467   471   471   472   475   475   479   483 
491   496   496   497   498   498   503   503   504   505   505   510   514   947 
1037  1038  1038  1042  1043  1043  1044  1045  1045  1046  1047  1047  1048  1049 
1053  1054  1087  1094  1095  1199  1277  1347  1347  1349  1349  1389  1478  1740 
1741  1742 
*  107*  938*
* 1124= 1128  1128  1129  1129  1131  1132  1134  1626= 1629  1629  1631  1634  1634 
1708= 1712  1712  1713  1713  1715  1716  1718 
*  118*  119*  169*  171*  177*  181*  187*  193*  198*  205*  212*  220*  225*  230*
*  237*
* 1029 
1446 
1199  1389  1716  1718 
* 1103 
*  430   435   437   531  1363  1365  1366 
*
968   977  1005  1095  1277  1478  1631  1635 
*
338   340   342   424*  433  1145  1512  1563  1726 
708 
*  433=  435  1098= 1182=

=
*  471 
= 1450=


*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
471   475 


*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*
*
*  487   491 

*  510 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

*  514 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

\f


7 
: 1313= 1525: 1526 
* 1132  1134 
*   72*  342   351 
*   96* 1312  1525 
*  922=  925= 1693  1694  1696  1698 
*  930  1030= 1383= 1383 
*  359   376   385   402   928*


* 1651  1654  1670  1672 
*  259*  262*  274*  723*  730   733*  738   741*  747   928*  932 
*
*  180*  479 
*
*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
498 
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<



=
1430 
531   678   819   855   860   865   925   957  1103 

1461 
*  315=
*  175*  182*  189*  194*  201*  215*  226*  231*  236*
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
*
* 1037  1132  1631  1654  1670  1716 
*  107* 1035 
*  951   963   977   983 
= 1074= 1137= 1210= 1221= 1247= 1258= 1497  1693=
1138= 1203= 1211= 1248= 1394= 1498  1695=
= 1212= 1222= 1249= 1259= 1400= 1429= 1461= 1499  1697=
= 1204= 1223= 1401= 1430= 1462= 1500  1699=

= 1443=
*  585=  611=  698=  708   711   712 
=
* 1350  1744  1745 
* 1032 
\f


7   497   948  1038= 1043= 1045= 1047= 1049= 1199  1347= 1349= 1389  1740  1741= 1741 
=
976  1007 
* 1740= 1742 
*  443   921   934   980   990   998* 1070  1325  1326  1327  1328  1329  1330  1331 
1333  1334  1335  1336  1337  1338  1339  1340  1341  1371  1377  1501  1534  1665 

*  365  1072 
* 1007  1059 
:
*
:
* 1031  1032  1433:
*  678=  685   695   697=
*
\f


25
13
135
11
5
9
68
3
76
151
26
11
9
117
14
8
16
11
28
13
6
26
5
5
117
23
1
5
30
4
14
\f


.04.08.      15.03.                         pascal80     version 1981.02.09
nal; 
^4
s streamer( 
^4
ure setoflowmask( oflow: boolean); 
^44
r.net_addr := params(i); 
^0
fmax' too small 
\f


s:   0
on
aracter or fatal error
expected
or 'prefix' expected
erminated after pass1 
58
23
1
5
30
4
14
\f


.04.08.      15.03.                         pascal80     version 1981.02.09
nal; 
^4
s streamer( 
^4
ure setoflowmask( oflow: boolean); 
^44
r.net_addr := params(i); 
«eof»