|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 46080 (0xb400)
Types: TextFile
Names: »tcrossload «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »tcrossload «
crossl=algol list.no xref.no blocks.no connect.no
begin
<* crossload release 3 lbj 861110
Revision history:
850801 lbj Release 1.0 of SW8740 and SW8741
860224 lbj Floppy handler included in connect
860320 lbj Console and printer included in link
860514 lbj reserve printer and printlog
860724 lbj Streamer handler included in link
860804 lbj release 2.0 of SW8740
861110 lbj Error in disconnect device
861201 lbj release 3.0 of sw8740
871026 kak copy core changed (system(5,..)): fielding nessary if lower ind<>1
880209 kak Release 5.0:
connect and disconnect commands are changed to createlink and removelink
the commands timeout and reset are removed as visible commands
printer commands are removed
this program is used to load an IFP801/IFP802 and/or an ADP. After the
ADP is loaded, links can be createed to the devices on ADP.
call:
(<outfile>=) crossload (test) main.<ifpmain>,
rc8410,
rc8411,
rc8420,
lib.<libfile>,
createlink.3270.<in_device>.<in_name>.<out_device>.<out_name>,
createlink.imc.<devno>.<name>,
createlink.mailbox.<in_device>.<in_name>.<out_device>.<out_name>,
createlink.mirror.<devno>.<devname>,
createlink.floppy.<devno>.<devname>,
createlink.printer.<printername>.<devno>.(<devname>),
createlink.console.<consolename>.<devno>.(<devname>) (printlog),
createlink.streamer.<devno>.<devname>,
removelink.(<devno>)!(<devname>)
<outfile> ::= Current output
test ::= Inclusion of test output.
lib.<libname> ::= The library is searched if the names are not found in
the catalog. Default name for the library is 'crosslib'.
main.<ifpmain> ::= The name of the main process for the controller. If the
main clause appear several times, the described functions
(load, connect) will be executed on the main processes
listed.
ifp.<ifpfw> ::= The IFP is loaded with FirmWare in the mentioned file.
There is no default filename. If no filename is specified
a dummy record is sent to the IFP in order to read a
filename
adp.<pi3file> ::= The ADP is loaded with a PI-3 basis system, and the
necessary programs and configuration files. Default name
for the basis system is 's8410'.
rc8410 ::= The ADP is loaded with the PI-3 basis system, and the
necessary programs and configuration file in accordance
with rc8410. Before the adp is loaded the ifp is sensed
and if it is not already loaded, it is loaded with the
suggested filename.
rc8411 ::= Same as rc8410.
rc8420 ::= The ADP is loaded with a basis system and configuration
file according to rc8420.
timeout.<seconds> ::= After an eventual load of IFP and ADP the timeout super
vision is started with the mentioned period. A period
of 0 seconds will disable the timeout supervision.
reset ::= The main process is reset.
createlink.3270 ::= A link to 3270 input and output handlers are
created. A RC8000 device number may be specified for
the input as well as the output process. If no device
number is specified the first free device is selected.
The processes may also be given a name.
createlink.imc ::= A link to a IMC port handler is created. Same
possibilities as the 3270 device handler for selecting
device number and name.
createlink.mailbox ::= A link to mailbox input and output handlers are created.
The mailbox handlers are used in connection with RC SHIPPING.
createlink.mirror ::= A link to a mirror device is created. The mirror
device is used in connection with the RC8000 testsystem.
createlink.floppy ::= A link to the floppy handler is created.
createlink.printer ::= A link to a printer is created.
createlink.console ::= A link to the console is created.
createlink.streamer::= A link to the streamer is created
removelink.<devno> ::= A link to a device, addressed with number,
is removed.
removelink.<name> ::= A link to a device, addressed with name, is
removed.
*>
integer startparam,i;
long array param(1:2);
procedure crossload(z_write,startparam,echo);
zone z_write;
integer startparam;
boolean echo;
begin
zone z(1,1,stderror);
integer i,j,k,timecount,point_integer,point_name,space_name;
integer mainparam,system4,ext_char,adp_boot,time_base;
long l;
long array field laf;
boolean test,ifp,main,ok,createlink,removelink,more;
boolean reset,time;
long array param1,param,main_name,lib_name,ifp_name,adp_name(1:2);
integer array ia(1:20);
procedure type_info;
begin
write(z_write,
<:<10>program call:<10><10>:>,
<:(<outfile>=) crossload main.<ifpmainprocess> default = ifpmain1,<10>:>,
<: rc8410 ; sense ifp, bootfile = s8410,<10>:>,
<: rc8411 ; sense ifp, bootfile = s8410,<10>:>,
<: rc8420 ; sense ifp, bootfile = s8420,<10>:>,
<: lib.<libfile> ; default library = crosslib,<10>:>,
<: createlink.3270(.<i_devno>)(.<i_name>)(.<o_devno>)(.<o_name>),<10>:>,
<: createlink.imc(.<devno>)(.<name>),<10>:>,
<: createlink.mailbox(.<i_devno>)(.<i_name>)(.<o_devno>)(.<o_name>),<10>:>,
<: createlink.mirror(.<devno>)(.<devname>),<10>:>,
<: createlink.floppy(.<devno>)(.<devname>),<10>:>,
<: createlink.printer.<printername>(.<devno>)(.<devname>),<10>:>,
<: createlink.console.<consolename>(.<devno>)(.<devname>) (printlog),<10>:>,
<: createlink.streamer(.<devno>)(.<devname>),<10>:>,
<: removelink.(<devno>!<devname>)<10>:>);
end;
boolean procedure create_peripheral(name,devno);
long array name;
integer devno;
begin
zone z(1,1,stderror);
integer array ia(1:12);
integer i;
open(z,0,name,0);
close(z,true);
i:= monitor(54)create peripheral process:(z,devno,ia);
if i <> 0 then
write(z_write,<:<10>***crossload create peripheral process, :>,
case i of (<:function forbidden:>,<:not user:>,<:name conflict:>,
<:device number does not exist:>,<:device reserved:>,
<:name format illegal:>));
create_peripheral:= i=0;
end;
boolean procedure remove_device(devno,devname,print);
integer devno;
long array devname;
boolean print;
begin
integer array ia(1:12);
zone z(1,1,stderror);
integer i,j;
i:= -1; remove_device:= false;
if devno <> -1 then
i:= devno
else
begin
open(z,0,devname,0);
close(z,false);
j:= monitor(4)process description:(z,1,ia);
if j <> 0 then
begin
integer array start(1:2);
integer peripherals;
system(5)copy core:(74,start);
peripherals:= (start(2)-start(1))/2 - 1;
begin
integer array field iaf;
integer array nametable(0:peripherals);
iaf:=-2;
system(5)copy core:(start(1),nametable.iaf);
for i:= 0,i+1 while i <= peripherals and
nametable(i) <> j do;
if i = peripherals then
begin
i:= -1;
if print then write(z_write,
<:<10>***crossload remove device, process not a device<10>:>);
end;
end;
end else
if print then write(z_write,
<:<10>***crossload remove device, process does not exist<10>:>);
end;
if i <> -1 then
begin
open(z,0,mainname,0);
close(z,false);
getshare6(z,ia,1);
ia(4):= 10 shift 12;
ia(5):= i;
setshare6(z,ia,1);
i:= monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
if timeout(i,time_base) then
begin
monitor(82)regret message:(z,1,ia);
write(z_write,<:<10>***crossload remove device, timeout<10>:>);
end else
begin
i:= monitor(18)wait answer:(z,1,ia);
j:= 1 shift i + ia(1);
if j = 2 then
begin
if print then
begin
if devno=-1 then write(z_write, devname)
else write(z_write, <:device :>,<<ddd>,devno);
write(z_write, <: removed<10>:>);
end;
remove_device:= true;
end else if print then
begin
write(z_write,<:<10>***crossload remove device, :>,
case i of (<:status = :>,<:reserve error:>,<:illegal device:>,
<:receiver malfunction:>,<:mainprocess unknown:>));
if i = 1 then for i:= 0 step 1 until 23 do
write(z_write,if j shift i < 1 then <:1:> else <:.:>);
write(z_write,"nl",1);
end;
end;
end;
end remove_device;
boolean procedure link_device(type,device,net_name,dev_name,text);
integer type,device;
long array net_name,dev_name;
string text;
begin
integer i,j;
integer array ia(1:12);
zone z(1,1,stderror);
open(z,0,main_name,0);
close(z,false);
link_device:= false;
getshare6(z,ia,1);
ia(4):= 6 shift 12 + 1;
ia(5):= type;
ia(6):= 255; <* select the first free *>
ia(7):= device;
if type = 9 then
ia(8):= 1 shift 12 + 1 <* link streamer *>
else if type=8 or type=1 then begin
laf:=14;
ia.laf(1):=net_name(1);
ia.laf(2):=net_name(2);
end else
ia(8):= 2 shift 12 + 4;
setshare6(z,ia,1);
i:= monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
if timeout(i,time_base) then
begin
monitor(82)regret message:(z,1,ia);
write(z_write,<:<10>***crossload link device, timeout<10>:>);
end else
begin
i:= 1 shift monitor(18)wait answer:(z,1,ia) + ia(1);
if i = 2 then
begin
device:= ia(2); <* return devicenumber *>
if dev_name(1) <> long<::> then
begin
if -,create_peripheral(dev_name,ia(2)) then
remove_device(ia(2),dev_name,false)
else
begin
link_device:= true;
if type=1 or type=8 then begin
i:=write(z_write,net_name);
write(out,"sp",11-i);
end else write(z_write,text);
write(z_write,<< dddd>,ia(5));
write(z_write,<: linked to:>,ia(2),
<: called :>,dev_name,"nl",1);
end;
end else
begin
link_device:= true;
if type=1 or type=8 then begin
i:=write(z_write,net_name);
write(out,"sp",11-i);
end else write(z_write,text);
write(z_write,<< dddd>,ia(5));
write(z_write,<: linked to:>,ia(2),"nl",1);
end;
end else
begin
j:= ia(1) shift (-8) extract 6;
write(z_write,<:<10>***crossload link device: :>);
if j=4 and (type=1 or type=8) then write(z_write,net_name,"sp",2) else write(z_write,dev_name,"sp",2);
if j>0 and j<=4 then
write(z_write,case j of (<:device troubles:>,
<:status = ..............1.......1.:>,
<:no resources at RC8000:>,<:no resources at ADP:>),"nl",1)
else
begin
write(z_write,<:status = :>);
for j:= 0 step 1 until 23 do
write(z_write,if i shift j < 0 then <:1:> else <:.:>);
write(z_write,"nl",1);
end;
end;
end if not timeout;
end link_device;
boolean procedure boot(boot_name);
long array boot_name;
begin
long array field name;
boolean finis,em,found,basisfile,ext_name,host_name_set;
integer ia12,i,status,blockcount;
integer array ia(1:20),tail(1:10);
zone z_in,z_out(128,1,blockproc);
long array param,wrk_name(1:2);
procedure set_host_name;
begin
long array field laf;
integer array z_in_descr(1:20);
integer i,j,k,e_count;
if test then write(z_write,<: : try name from monitor:>);
close(z_in,true);
getzone6(z_in,z_in_descr);
z_in_descr(2):=0;
setzone6(z_in,z_in_descr);
for j:=1 step 1 until 10 do tail(j):=0;
tail(1):=2;
monitor(40,z_in,1,tail);
getzone6(z_in,z_in_descr);
laf:=2;
wrk_name(1):=z_in_descr.laf(1);
wrk_name(2):=z_in_descr.laf(2);
open(z_in,4,wrk_name,0);
outrec6(z_in,512);
for j:=1 step 1 until 128 do z_in(j):=real<::>;
system(5,1192,z_in);
j:=1;
get_char(z_in,j,k);
if k>126 or k<97 then k:=6 else
repeat
get_char(z_in,j,k);
if k=0 then else
if (k>126 or k<97) and (k<48 or k>57) then k:=6;
until k=6 or k=0 or j>9;
if k=6 then begin
z_in(2):=real<::>;
puttext(z_in,1,<:rc8000<26>:>); <*default value*>
end else putchar(z_in,j-1,26);
close(z_in,true);
open(z_in,4,wrk_name,1 shift 18);
fpproc(27,j,z_in,wrk_name);
param(1):=wrk_name(1); param(2):=wrk_name(2);
inrec6(z_in,512);
end;
procedure blockproc(z,s,b);
zone z;
integer s,b;
begin
integer array field iaf,iaf1;
integer array tail(1:10);
integer i,block,katseg,mask;
system(14,0,ia);
if test then
begin
write(z_write,"sp",14-
write(z_write,<:<10>:>,param));
for i:= 0 step 1 until 23 do
write(z_write,if s shift i <0 then <:1:> else <:.:>);
end;
em:= true; b:= 512;
if s shift 19 < 0 then
status:= 5
else if s shift 5 < 0 then
status:= 1
else if s shift 18 < 0 then
begin
status:= 1;
found:= false;
close(z_in,true);
open(z_in,4,lib_name,1 shift 18);
if (monitor(42)lookup entry:(z_in,1,tail)=0) then
<* file does not exist, search in lib *>
begin
iaf:= 0;
inrec6(z_in,512);
i:= z_in.iaf(1); <* version *>
katseg:= z_in.iaf(2);
setposition(z_in,0,katseg+1);
inrec6(z_in,512);
if z_in.iaf(1) < i then
setposition(z_in,0,1);
for i:= 1,i+1 while -,found and i<=katseg do
begin
inrec6(z_in,512);
iaf1:= 14;
iaf:= 0;
laf:= 6;
mask:= z_in.iaf(256);
while -,found and (mask<>0) do
begin
mask:= mask shift (-1);
if mask extract 1 = 1 then
begin
found:= z_in.laf(1)=param(1) and z_in.laf(2)=param(2);
block:= z_in.iaf(1)//8;
blockcount:= z_in.iaf1(1);
end;
iaf:= iaf+34; laf:= laf+34; iaf1:= iaf1 + 34;
end;
end;
if found then
begin
if test then write(z_write,<: : found in lib:>);
setposition(z_in,0,block);
inrec6(z_in,512);
em:= false;
end else
if -,ext_name then
begin <* try with a name extended with the last char in mainproc *>
ext_name:= true;
if test then write(z_write,<: : try extended name:>);
if param(1) extract 8 <> 0 then
begin
if param(2) extract 16 <> 0 then
param(2):=param(2) shift (-16) shift (16);
i:= -48;
repeat
i:= i + 8;
j:= (param(2) shift i) extract 8
until j = 0;
param(2):= logor(param(2),(extend ext_char) shift (-i));
end else
begin
i:= -48;
repeat
i:= i + 8;
j:= (param(1) shift i) extract 8
until j = 0;
param(1):= logor(param(1),(extend ext_char) shift (-i));
end;
close(z_in,true);
open(z_in,4,param,1 shift 18);
fpproc(27,i,z_in,param); <* connect input zone *>
em:= false;
inrec6(z_in,512);
end else if -,hostname_set and param(1)=long<:hostn:> add 'a' and
param(2) shift (-32) shift 32 =long<:me:> then begin
set_host_name;
hostname_set:=true;
em:=false;
end;
end lib;
end else if s shift 9 < 0 then
status:= 2
else if s shift 2 < 0 then
status:= 3
else
stderror(z,s,b);
end blockproc;
procedure send_to_ifp;
begin
integer i;
i:= monitor(16)send message:(z_out,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
if timeout(i,6*time_base) then
begin
reset_main;
blockproc(z_out,1 shift 21,512); <* generate timeout status *>
monitor(18)wait answer:(z_out,1,ia);
end else
check(z_out);
end;
open(z_out,0,main_name,1 shift 4 + 1 shift 14 + 1 shift 18 + 1 shift 21);
host_name_set:=false;
wrk_name(1):=wrk_name(2):=long<::>;
name:= 8;
outrec6(z_out,512);
getzone6(z_out,ia);
i:= ia(14);
getshare6(z_out,ia,1);
ia12:= ia(12);
ia(4):= 5 shift 12;
ia(5):= i + 1;
ia(6):= ia(5) + 510;
ia(7):=ia(8):=ia(9):=ia(10):=ia(11):= 0;
setshare6(z_out,ia,1);
em:= finis:= boot:= false;
ext_name:= true;
if boot_name(1) = long<::> then
begin
z_out(1):= real<::> add ( 765 shift (-8) + ((765 extract 8) shift 8)) shift 24;
for i:= 2 step 1 until 128 do z_out(i):= real<::>;
z_out(128):= real <::> add 1; <* checksum is zero *>
send_to_ifp;
<* send a dummy record to the ifp, it will answer with a default
filename of the firmware *>
system(14,0,ia);
if em then
begin
if test then write(z_write,<: : ifp status -:>);
end else if ia(5) <> 0 then
begin
boot_name(1):= ia.name(1); boot_name(2):= ia.name(2);
end;
end;
param(1):= boot_name(1); param(2):= boot_name(2);
open(z_in,4,param,1 shift 18);
fpproc(27,i,z_in,param); <* connect input zone *>
basisfile:= true;
blockcount:= 8 000 000;
repeat
while -,em do
begin
inrec6(z_in,512);
tofrom(z_out,z_in,512);
blockcount:= blockcount - 1;
if (blockcount < 0) and -,em then blockproc(z_in, 1 shift 18, 0);
getshare6(z_out,ia,1);
ia(12):= ia12;
if em then
begin
if test then write(z_write,<: : disc status:>);
ia(8):= 2;
setshare6(z_out,ia,1);
status:= 4;
if -,basisfile then
begin
em:= false;
send_to_ifp;
if em and test then write(z_write,<: : ifp status -:>);
end;
end else
begin
ia(8):= 0;
setshare6(z_out,ia,1);
send_to_ifp;
if em and test then write(z_write,<: : ifp status -:>);
end;
end;
case status of
begin
begin
finis:= ia(5)=0;
if test then
write(z_write,if finis then <: end load<10>:> else
<: get next file:>);
if finis then
begin
boot:= true;
write(z_write,<:boot :>,boot_name,<: ok<10>:>);
end;
end;
begin
finis:= true;
write(z_write,if test then <: load error<10>:>
else <:<10>***crossload load error<10>:>);
end;
begin
finis:= true;
write(z_write,if test then <: timeout<10>:>
else <:<10>***crossload timeout in load<10>:>);
end;
begin
finis:= true;
if boot_name(1) <> long<::> then
write(z_write,<:<10>***crossload :>,boot_name,<: does not exist<10>:>)
else
boot:= true;
end;
begin
<* result 4 *>
finis:= true;
write(z_write,if test then <: result 4<10>:> else
<: <10>***crossload receiver malfunction<10>:>);
end;
end;
param(1):= ia.name(1); param(2):= ia.name(2);
if -,finis then
begin
ext_name:= em:= found:= false;
close(z_in,true);
basisfile:= false;
<* if (param(1) = long<:confi:> add 'g') and (param(2) = long<:cst:>) then
param(2):= case adp_boot of (long<:cst:>,long<:8410:>,long<:8420:>); *>
open(z_in,4,param,1 shift 18);
fpproc(27,i,z_in,param); <* connect input zone *>
blockcount := 8 000 000;
end;
until finis;
close(z_in,true);
changerec6(z_out,0);
if wrk_name(1)<>long<::> then begin
close(z_in,true);
open(z_in,4,wrk_name,0);
close(z_in,true);
monitor(48,z_in,1,tail);
end;
end boot;
boolean procedure reset_main;
begin
integer i;
integer array ia(1:12);
zone z(1,1,stderror);
open(z,0,main_name,0);
close(z,false);
getshare6(z,ia,1);
ia(4):= 4 shift 12;
setshare6(z,ia,1);
i:= monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
if monitor(18)wait answer:(z,1,ia) = 1 then
begin
delay(1);
reset_main:= true;
end else
begin
reset_main:= false;
write(z_write,<:<10>***crossload reset error<10>:>);
end;
end reset_main;
boolean procedure timeout(buf,count);
value buf,count;
integer buf,count;
begin
integer i,j;
integer array ia(1:12);
zone z(1,1,stderror);
open(z,2,<:clock:>,0);
getshare6(z,ia,1);
ia(4):= 2;
ia(5):= 0;
ia(6):= count*10000;
setshare6(z,ia,1);
i:=monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
j:= 0;
while (j<>buf) and (j<>i) do
monitor(24)wait event:(z,j,ia);
if i = j then <* timeout *>
begin
monitor(18)wait answer:(z,1,ia);
timeout:= true;
end else
begin
monitor(82)regret message:(z,1,ia);
timeout:= false;
end;
end timeout;
procedure read_device_and_name(par_no,device,name);
integer par_no,device;
long array name;
begin
integer j;
device:= -1;
name(1):= name(2):= long <::>;
j:= system(4,par_no+1,param);
if j = point_integer <* .<integer> *> then
begin
par_no:= par_no+1;
device:= round param(1);
if echo then write(z_write,<:.:>,<<d>,device);
j:= system(4,par_no+1,param);
end;
if j = point_name then <* .<name> *>
begin
name(1):= param(1);
name(2):= param(2);
if echo then write(z_write,<:.:>,name);
par_no:= par_no+1;
end;
end read_device_and_name;
procedure read_name(par_no,name);
integer par_no;
long array name;
begin
integer j;
name(1):= name(2):= long <::>;
j:= system(4,par_no+1,param);
if j = point_name then <* .<name> *>
begin
name(1):= param(1);
name(2):= param(2);
if echo then write(z_write,<:.:>,name);
par_no:= par_no+1;
end;
end read_name;
boolean procedure set_timeout(count);
value count;
integer count;
begin
integer i;
integer array ia(1:12);
zone z(1,1,stderror);
open(z,0,main_name,0);
close(z,false);
getshare6(z,ia,1);
ia(4):= 2 shift 12;
ia(5):= count;
setshare6(z,ia,1);
i:= monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
if timeout(i,time_base) then
begin
monitor(82)regret message:(z,1,ia);
write(z_write,<:<10>***crossload timeout error<10>:>);
set_timeout:= false
end else
begin
i:= monitor(18)wait answer:(z,1,ia);
if (i = 1) and (ia(1) = 0) then
begin
write(z_write,<:timeout ok<10>:>);
set_timeout:= true;
end else
begin
write(z_write,<:<10>***crossload timeout error<10>:>);
set_timeout:= false;
end;
end;
end set_timeout;
procedure delay(count);
value count;
integer count;
begin
integer i;
integer array ia(1:12);
zone z(1,1,stderror);
open(z,2,<:clock:>,0);
getshare6(z,ia,1);
ia(4):= 2;
ia(5):= 0;
ia(6):= count*10000;
setshare6(z,ia,1);
i:=monitor(16)send message:(z,1,ia);
if i=0 then system(9)run time alarm:(1,<:<10>send mes:>);
monitor(18)wait answer:(z,1,ia);
end delay;
procedure param_error(param,kind);
long array param;
integer kind;
begin
write(z_write,<:<10>***crossload parameter error, :>,
case (kind shift (-12))/2+1 of (<:(:>,<: :>,<: :>,<:=:>,<:.:>));
if kind extract 12 = 4 then write(z_write,<<d>,round param(1)) else
write(z_write,param); write(z_write,"nl",1);
ok:= false;
type_info;
end param_error;
point_integer:= 8 shift 12 + 4;
point_name := 8 shift 12 + 10;
space_name := 4 shift 12 + 10;
ok := true;
if echo then write(z_write,<:*crossload<10>:>);
if system(4,startparam,param) = 0 then
type_info; <* no parameters *>
test:= false;
time_base:=10;
ext_char:=1;
main_name(1):= long<:ifpma:> add 'i'; main_name(2):= long<:n1:>;
mainparam:= startparam;
while (system(4,startparam,param) <> 0) and ok do
<* repeat for each main *>
begin
more:= true;
removelink:= ifp:= createlink:= reset:= time:= false;
adp_boot:= 0;
lib_name(1):= long<:cross:> add 'l'; lib_name(2):= long<:ib:>;
ifp_name(1):= long<::> ; ifp_name(2):= long<::>;
adp_name(1):= long<:s8410:> ; adp_name(2):= long<::>;
main:=false;
system4:= system(4,startparam,param);
while (system4 <> 0) and more do
begin
if system4 <> space_name then
begin
param_error(param,system4);
more:= false;
end else
if param(1) = long<:test:>
and param(2) = long<::> then
begin
if echo then write(z_write,<:*test<10>:>);
test:= true;
end else
if (param(1) = long<:timeo:> add 'u')
and (param(2) = long<:t:>)
and (system(4,startparam+1,param1)=point_integer) then
begin
timecount:= round param1(1);
time:= true;
startparam:= startparam + 1;
end else
if (param(1) = long<:main:>)
and (param(2) = long<::>)
and (system(4,startparam+1,param1) = point_name) then
begin
if main then
begin
more:= false;
startparam:= startparam - 1;
end else
begin
main_name(1):= param1(1);
main_name(2):= param1(2);
if main_name(2) <> long<::> then
l:= main_name(2)
else
l:= main_name(1);
repeat
ext_char:= l extract 8;
l:= l shift (-8);
until ext_char<>0;
startparam:= startparam + 1;
main:= true;
end;
end else
if param(1) = long<:ifp:> and param(2)=long<::>
and adp_boot <= 1 then
begin
if system(4,startparam+1,param) = point_name then
begin
ifp_name(1):= param(1);
ifp_name(2):= param(2);
startparam:= startparam+1;
end;
ifp:= true;
end else
if param(1) = long<:adp:> and param(2)=long<::>
and adp_boot = 0 then
begin
if system(4,startparam+1,param)=point_name then
begin
adp_name(1):= param(1);
adp_name(2):= param(2);
startparam:=startparam+1;
end;
adp_boot:= 1;
end else
if ((param(1) = long<:rc841:> add '0')
or (param(1) = long<:rc841:> add '1'))
and -,ifp and adp_boot = 0 then
begin
adp_name(1):= long<:s8410:>;
adp_name(2):= long<::>;
adp_boot:= 2;
end else
if (param(1) = long<:rc842:> add '0')
and -,ifp and adp_boot = 0 then
begin
adp_name(1):= long<:s8420:>;
adp_name(2):= long<::>;
adp_boot:= 3;
end else
if (param(1) = long<:lib:>)
and (param(2) = long<::>)
and (system(4,startparam+1,param1) = point_name) then
begin
lib_name(1):= param1(1);
lib_name(2):= param1(2);
startparam:= startparam+1;
end else
if ( (param(1) = long<:conne:> add 'c') and (param(2) = long<:t:>)
or (param(1) = long<:creat:> add 'e') and (param(2) = long<:link:>) )
and (system(4,startparam+1,param1) shift(-12) = 8) then
begin
createlink:= true;
while system(4,startparam+1,param) shift (-12) = 8 do
<* repeat while point separator *>
startparam:= startparam+1;
end else
if ( (param(1) = long<:disco:> add 'n') and (param(2) = long<:nect:>)
or (param(1) = long<:remov:> add 'e') and (param(2) = long<:link:>) )
then
begin
removelink:= true;
while system(4,startparam+1,param) shift (-12) = 8 do
<* repeat while point separator *>
startparam:= startparam+1;
end else
if (param(1) = long<:reset:>)
and (param(2) = long<::>) then
reset:= true
else
if (param(1) = long<:reser:> add 'v')
and (param(2) = long<:e:>) then
begin
if system(4,startparam+1,param) = pointname then
startparam:= startparam + 1;
end else
if (param(1) <> long<:print:> add 'l')
or (param(2) <> long<:og:>) then
begin
param_error(param,system4);
more:= false;
end;
startparam:= startparam+1;
system4:= system(4,startparam,param);
end while more;
if ok then
begin
open(z,0,main_name,0);
close(z,false);
if echo then write(z_write,<:*main.:>,main_name,"nl",1);
i:= monitor(8)reserve process:(z,i,ia);
if (i<>0) and (i<>2) then
begin
write(z_write,<:<10>***crossload :>, main_name,
case i of (<: reserved by another process:>,<: can not be reserved:>,
<: does not exist:>),"nl",1);
ok:= false;
end;
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
if ok and reset then begin
if echo then write(z_write,<:*reset<10>:>);
ok:= reset_main;
if ok then
write(z_write,<:reset ok<10>:>);
end;
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
i:= mainparam; j:= system(4,mainparam,param);
while (j<>0) and ok and removelink and i < startparam do
begin
if ( (param(1) = long<:disco:> add 'n') and (param(2) = long<:nect:>)
or (param(1) = long<:remov:> add 'e') and (param(2) = long<:link:>) )
and j = space_name then
begin
j:= system(4,i+1,param);
if j = point_integer then
ok:=remove_device(round param(1),param,true)
else if j = point_name then
ok:=remove_device(-1,param,true)
else
param_error(param,j);
i:= i + 1;
end;
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
ok:=true; <* disconnect of illegal devices don't stop the program *>
i:= i+1;
j:= system(4,i,param);
end;
if ifp and ok then
begin
if echo then write(z_write,<:*ifp.:>,ifp_name,<: lib.:>,lib_name,"nl",1);
reset_main;
ok:= boot(ifp_name);
if ok and ifp_name(1)=long<::> then
begin
ifp_name(1):= long<:ifp80:> add '1';
ifp_name(2):= long<::>;
ok:= boot(ifp_name);
end;
end;
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
if (adp_boot<>0) and ok then
begin
if echo then
begin
write(z_write, case adp_boot of (<:*adp.:>,<:*rc8410:>,<:*rc8420:>));
if adp_boot = 1 then write(z_write, adp_name);
write(z_write,<: lib.:>,lib_name,"nl",1);
end;
reset_main;
if adp_boot > 1 then
ok:= boot(ifp_name);
if ok then ok:= boot(adp_name);
end;
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
if time and ok then begin
if echo then write(z_write,<:*timeout.:>,<<d>,timecount,"nl",1);
ok:= set_timeout(timecount);
end;
i:= mainparam; j:= system(4,mainparam,param);
while (j<>0) and ok and createlink and i < startparam do
begin
if ( (param(1) = long<:conne:> add 'c') and (param(2) = long<:t:>)
or (param(1) = long<:creat:> add 'e') and (param(2) = long<:link:>) )
and j = space_name then
begin
integer devin,devout;
long array n_name,i_name,o_name(1:2);
i:= i+1;
j:= system(4,i,param);
if (param(1) = long<:imc:>)
and (param(2) = long<::>) then
begin
if echo then write(z_write,<:*createlink.imc:>);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(2,devout,n_name,o_name,<:imc port :>);
end else
if (param(1) = long<:mailb:> add 'o')
and (param(2) = long<:x:>) then
begin
if echo then write(z_write,<:*createlink.mailbox:>);
read_device_and_name(i,devin,i_name);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(3,devout,n_name,o_name,<:mailbox out:>);
if ok then ok:= link_device(3,devin,n_name,i_name,<:mailbox in :>);
end else
if (param(1) = long<:adp32:> add '7')
and (param(2) = long<:0:>) or (param(1)=3270) then
begin
if echo then write(z_write,<:*createlink.3270:>);
read_device_and_name(i,devin,i_name);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(4,devin,n_name,i_name, <:3270 in :>);
if ok then ok:= link_device(5,devout,n_name,o_name,<:3270 out:>);
end else
if (param(1) = (long<:mirro:> add 'r'))
and (param(2) = long<::>) then
begin
if echo then write(z_write,<:*createlink.mirror:>);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(6,devout,n_name,o_name,<:adp mirror :>);
end else
if (param(1) = (long<:flopp:> add 'y'))
and (param(2) = long<::>) then
begin
if echo then write(z_write,<:*createlink.floppy:>);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(7,devout,n_name,o_name,<:floppy :>);
end else
if (param(1) = (long<:print:> add 'e'))
and (param(2) = long<:r:>) then
begin
if echo then write(z_write,<:*createlink.printer:>);
read_name(i,n_name);
ok:=n_name(1)<>long<::>;
if ok then begin
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(8,devout,n_name,o_name,<:printer :>);
j:= system(4,i+1,param);
if ok and (j=space_name) and (param(1)=long<:reser:> add 'v')
and (param(2)=long<:e:>) then
begin
zone z(1,1,stderror);
i:= i + 1;
system(4,i+1,param);
if echo then write(z_write,<:*reserve.:>,param,"nl",1);
i:= i + 1;
if o_name(1) = long<::> then
begin
o_name(1):= param(1);
o_name(2):= param(2);
ok:= create_peripheral(o_name,devout);
end;
if ok then
begin
open(z,14,o_name,0);
getshare6(z,ia,1);
ia(4):= 8 shift 12;
ia(5):= ia(6):= ia(7):= 0;
laf:= 14;
ia.laf(1):= param(1); ia.laf(2):= param(2);
setshare6(z,ia,1);
monitor(16)send message:(z,1,ia);
j:= 1 shift monitor(18)wait answer:(z,1,ia) + ia(1);
if j<>2 then
begin
write(z_write,<:***crossload reserve printer, status = :>);
for k:= 0,k+1 while k<24 do
write(z_write,if j shift k < 0 then <:1:> else <:.:>);
write(z_write,"nl",1);
remove_device(devout,o_name,true);
end;
close(z,true);
end;
end;
end else write(z_write,<:*** crossload createlink.printer no printer name<10>:>);
end else
if (param(1) = (long<:conso:> add 'l'))
and (param(2) = long<:e:>) then
begin
if echo then write(z_write,<:*createlink.console:>);
read_name(i,n_name);
ok:=n_name(1)<>long<::>;
if ok then begin
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(1,devout,n_name,o_name,<:console :>);
j:= system(4,i+1,param);
if ok and (j=space_name) and (param(1) = long<:print:> add 'l')
and (param(2) = long<:og:>) then
begin <* print s-log *>
zone z1,z2(128,1,stderror),z3(1,1,stderror);
integer array mess,answ,tail(1:20);
integer char,cl_wait;
open(z1,4,<:slogarea:>,0);
open(z2,8,o_name,0);
if echo then write(z_write,<:*printlog<10>:>);
if o_name(1) = long<::> then
begin
monitor(68)generate name:(z2,1,tail);
laf:= 2;
getzone6(z2,tail);
o_name(1):= tail.laf(1);
o_name(2):= tail.laf(2);
create_peripheral(o_name,devout);
end;
if (monitor(42)lookup entry:(z1,1,tail) = 0) and (tail(1)>0) then
begin
cl_wait:=10;
open(z3,0,<:clock:>,0);
close(z3,true);
repeat
getshare6(z2,mess,1);
mess(4):=0; <* sense console *>
setshare6(z2,mess,1);
monitor(16,z2,1,answ);
monitor(18,z2,1,answ);
if answ(1)<>0 then begin
getshare6(z3,mess,1);
mess(4):=0;
mess(5):=5; <* wait in 5.sec *>
setshare6(z3,mess,1);
monitor(16,z3,1,answ);
monitor(18,z3,1,answ);
end else cl_wait:=0;
cl_wait:=cl_wait-1;
until cl_wait<=0 ;
repeat
read_char(z1,char);
out_char(z2,char);
until char=25;
out_char(z2,10);
end;
close(z1,true);
setposition(z2,0,0);
close(z2,true);
getzone6(z_write,tail);
laf:= 2;
<* change output document to console *>
tail(1):= 8; <* kind *>
tail.laf(1):= o_name(1);
tail.laf(2):= o_name(2);
setzone6(z_write,tail);
end;
end else write(z_write,<:*** crossload createlink.console no console name<10>:>);
end else
if (param(1) = (long<:strea:> add 'm'))
and (param(2) = long<:er:>) then
begin
if echo then write(z_write,<:*createlink.streamer:>);
read_device_and_name(i,devout,o_name);
if echo then write(z_write,"nl",1);
ok:= link_device(9,devout,n_name,o_name,<:streamer :>);
end else
param_error(param,j);
end createlink;
i:= i+1;
j:= system(4,i,param);
if -,ok then errorbits:= log_or(errorbits,1 shift 0); <* ok.no *>
ok:=true; <* goto next createlink: not ok don't stop the program *>
end while;
monitor(10)release process:(z,i,ia);
end <* if ok *>;
mainparam:= startparam;
ok:=true; <* goto next main: not ok don't stop the program *>
end for each main;
end crossload;
i:= 1;
if system(4,1,param) shift (-12) = 6 <*=*> then
begin
fpproc(29,0,in,0); <* stack current input zone *>
system(4,0,param);
i:= 1 shift 1 + 1; <* one segment preferably on disc *>
fpproc(28,i,in,param); <* connect output *>
setposition(in,0,0);
if i <> 0 then
begin
write(out,<:<10>***crossload connect output, :>, case i of
(<:no resources:>,<:malfunction:>,<:not user:>,
<:convention error:>,<:not allowed:>,<:name format error:>),"nl",1);
end;
startparam:=2;
end else
startparam:= 1;
if i = 0 then
begin
crossload(in,startparam,true);
fpproc(34,0,in,'em'); <* close up *>
<* fp will unstack current input zone *>
end else
crossload(out,startparam,false);
end
▶EOF◀