|
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: 6144 (0x1800)
Types: TextFile
Names: »tinitmtpool«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »tinitmtpool«
initmtpool =algol list.no
begin
message vk 1982.03.21 initmtpool;
comment
*******************************************************************
* *
* This program initialises the mtpool. It can be called with two *
* parameters, one indicating how many totaltapes you will have *
* in the mtpool and the other indicating how many tapes you will *
* have in the whole mtpool. *
* The program shall be called in the following way: *
* *
* <outfile>=initmtpool daily.<integer> weekly.<integer> *
* mountly.<integer> *
* The error message are: *
* *** Param error *
* *** Mtpool does exist *
* *** Mtpool can not be created *
* *** Connect error = <outres> *
* *
******************************************************************* ;
boolean outp;
integer outres,i;
real array input(1:2);
real array outarr(1:3);
\f
procedure error(errorno);integer errorno;
begin
case errorno of
begin
<*1*>write(out,<:<10>*** Param error:>);
<*2*>write(out,<:<10>*** Mtpool does exist:>);
<*3*>write(out,<:<10>*** Mtpool can not be created :>);
<*4*>write(out,<:<10>*** Connect error = :>,outres);
end;
write(out,<:<10> initmtpool not ok :>,<:<10>:>);
goto halt;
end;
\f
procedure openout;
begin
real array outname(1:2);
outp:=true;
outname(1):=input(1);outname(2):=input(2);
fpproc(29)stack current out:(0,out,outarr);
fpproc(28)connect out:(outres,out,outname);
if outres <> 0 then
begin
outp:=false;
fpproc(30)unstack out:(0,out,outarr);
error(4);
end;
end;
procedure closeout;
begin
if outp then
begin
fpproc(34)close up:(0,out,25);
fpproc(30)unstack out:(0,out,outarr);
end;
end;
\f
integer procedure readparam(val);real array val;
begin
comment
This procedure reads the parameters in the FILE Processor com-
mand, which called the algol program.;
own integer q;
integer ik;
readparam:=0;
if q>=0 then q:=q+1;
if q=1 then
begin
ik:=system(4,1,val);
if ik = 6 shift 12 +10 then
begin
system(4,0,val);
readparam := -1;
end
else if ik<> 0 then goto p;
end
else
if q > 0 then
begin
p: ik:=system(4,q-1,val);
if ik = 0 then q := -1 else
readparam := (if i shift (-12) = 8 then 2 else 0)
+(if i extract 12 = 10 then 2 else 1)
end
end readparam;
\f
real array inp,mtpool(1:2);
integer array tail(1:10),ttail(1:17);
zone mtrecord(128,1,stderror);
integer j,l,k,noofttape,nooftape,noofdtape,noofwtape,noofmtape,
tael,tapekind;
integer array entrybase(1:2),interval(1:8);
integer field mtnr,mtdate,mttotal,mtrsize,antal,mtno,lbase,ubase;
real array field mtname,tadocname;
system(11)get catalog base:(0,interval);
mtrsize:=16;
lbase:=4;ubase:=6;
outp:=false;
mtnr:=2;
mtname:=2;
mtdate:=12;
mttotal:=14;
noofdtape:=0;noofwtape:=0;noofmtape:=0;
mtno:=16;
for i:=readparam(inp) while i<>0 do
begin
if i = -1 then openout;
if inp(1) = real <:daily:> then
begin
i:=readparam(inp);
if i <> 1 then error(1) else noofdtape:=inp(1);
end;
if inp(1) = real <:weekl:> add 121 then
begin
i:=readparam(inp);
if i <> 1 then error(1) else noofwtape:=inp(1);
end;
if inp(1) = real <:mount:> add 108 and inp(2) = real <:y:> then
begin
i:=readparam(inp);
if i <> 1 then error(1) else noofmtape:=inp(1);
end;
end;
mtpool(1):= real <:mtpoo:> add 108;
mtpool(2):= real <::>;
i:=1;
open(mtrecord,4, string mtpool(increase(i)),0);
tail(1):=3;
nooftape:=noofdtape+noofwtape+noofmtape;
tail(1):=nooftape//31 +1;
tail(2):= 1;
tail(3):= 0;
for i:= 4 step 1 until 10 do tail(i):= 0;
i:=monitor(76)lookup head and tail:(mtrecord,0,ttail);
if i = 0 and ttail.lbase >= interval(7) and ttail.ubase <= interval(8)
then error(2);
tadocname:=2;
tail(2):=1;tail(3):=0;tail(4):=0;tail(5):=0;tail(6):=0;
tail(7):=0;tail(8):=0;tail(9):=11 shift 12;tail(10):=0;
i:= monitor(40) create entry :(mtrecord,0,tail);
if i <> 0 then
error(3);
i:=monitor(50)permanent entry:(mtrecord,3,tail);
if i<> 0 then
error(3);
entrybase(1):=interval(5);entrybase(2):=interval(6);
i:=monitor(74)set entry base:(mtrecord,0,entrybase);
if i <> 0 then
error(3);
outrec6(mtrecord,2);
antal:=2;
mtrecord.antal:=nooftape;
tael:=0;
for tapekind := 0 step 1 until 2 do
begin
if tapekind = 0 then nooftape:=noofdtape;
if tapekind = 1 then nooftape:=noofwtape;
if tapekind = 2 then nooftape:=noofmtape;
for i:= 1 step 1 until nooftape do
begin
tael:=tael+1;
outrec6(mtrecord,mtrsize);
mtrecord.mtnr:=tael;
l:=tael//100+48;
mtrecord.mtname(1):= real <:mtsa0:> add l;
j:=tael mod 10 +48;
k:=(tael) // 10 ;
if k >=10 then k:= k-10 +48 else k:=k+48;
mtrecord.mtname(2):=
(((( 0.0 shift (-48)) add k ) shift 8) add j) shift 32;
mtrecord.mtdate:=0;
mtrecord.mttotal := tapekind + 1 shift 10;
mtrecord.mtno:=0;
end;
end;
outrec6(mtrecord,mtrsize);
mtrecord.mtnr:=-1;
mtrecord.mtname(1):=-1;mtrecord.mtname(2):=-1;
mtrecord.mtdate:=-1;mtrecord.mttotal:=-1;
close(mtrecord,false);
i:=monitor(42)lookupentry:(mtrecord,0,tail);
write(out,<:<10>initialisation ok:>,<:<10>:>);
halt:
if outp then closeout;
fpproc(7)end_of_program:(0,0,0);
end;
▶EOF◀