|
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: 19200 (0x4b00)
Types: TextFile
Names: »movesegmtx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »movesegmtx«
; move segm * page 1 10 03 80, 14.23;
movesegm = set 1
movesegm = algol connect.no
begin
<* recommended size : 17200 or 26500 bytes
<to_file> = movesegm <from_file> (.<start_segm>)0/1,
_ (to(.<startsegm>(.<startbyte>)0/1)0/1(.<bs>)0/1)0/1,
_ (move.<movesegm> // movebytes.<movebytes>)0/1,
_ (segm.<sharelength>)0/1 (change.(yes//no))0/1
<to_file> and <from_file> must either be a backing storage
_ file or a catalog entry descibing a magnetic tape.
Note : At most one tape is alowed
****
Function
********
<from_file> is moved to <to_file> according to specifications:
_ to.<startsegm>.<startbyte>.<bs> :
_ moved bytes are placed on segm no <startsegm> in
_ byte no <startbyte> and on.
_ if <to_file> does not exist it is set on <bs>.
_ initial values to.0.1.disc
_ <from_file>.<startsegm> :
_ the move action starts from segm no <startsegm> in
_ byte no <startbyte> (taken from the to_param) and on.
_ initial value <from_file>.0
_ move.<movesegm> :
_ the number of segments to move.
_ movebytes.<movebytes> :
_ the number of bytes to move.
_ initial value == lookup_length of <from_file>.
_ segm.<share_length>
_ the sharelength in segments to be used when
_ any file is tape_type elsehighest divisor in 36 to be
_ hold in corearea.
_ initial value for tape == 1.
_ change.no :
_ the to_file may only be extended in size not shortend.
_ initial value == yes.
The move is performed in blocks of length <sharelength> segm
The last segm is filled with zeroes after the moved bytes, except
when the last segm is the the first segm and firstbyte > 1.
NB: When an entry is discibing a magnetic tape the startpoint
++ relative to the file and block descibed by the entry.
++ e.g. The startpoint for the entry t
++ t = set mto mtke4033 0 4 3
++ is file 4 block 3 ( usually you start at block 0 ).
*>
\f
<* move segm * page 2 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 *>
\f
comment move segm * page 3 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
boolean param_error, bs, tape, last_byte_tape, new_size;
integer first_segm, from_segm, first_byte, last_segm,
_ sh_lng, sh_lng_bytes, free_size, shift_size,
_ to_sh_pos, from_sh_pos, save_base, save_length,
_ save_base_from, save_length_from, save_segm,
_ to_move, to_move1, to_slice_lng, from_slice_lng,
_ stations,
_ i, j, k;
long last_byte, moved;
integer array from_tail, to_tail, save_tail(1:10),
_ from_descr, to_descr(1:20),
_ from_share, to_share(1:12);
long array from_file, to_file, devi, scope( 1:3 );
real array name( 1:3 );
boolean array field baf, from_field;
long array field laf, laf1;
real array field raf;
integer procedure H_C_F(free, slice);
value free, slice;
integer free, slice;
begin <* Highest Common Factor *>
integer j;
repeat
j := free;
free := slice;
slice := j - (j // free) * free;
until slice = 0;
H_C_F := free;
end H_C_F;
procedure set_const(i);
value i; integer i;
begin
sh_lng := i * 128;
sh_lng_bytes := i * 512;
to___sh_pos := (first_segm // i) * i;
from_sh_pos := (from__segm // i) * i;
shift_size := (first_segm-to_sh_pos-from_segm+from_sh_pos)*512;
if shift_size < 0 then
_ shift_size := shift_size + sh_lng_bytes;
end set_const;
integer procedure H_F_S(max, slice);
value max, slice;
integer max, slice;
begin <* Highest Factor i slice Smaller than max *>
integer k;
max := if max > slice then slice + 1 else
_ if max > slice // 2 then slice//2+2 else max + 1;
repeat
max := max - 1;
k := H_C_F(max, slice);
until k = max;
H_F_S := k;
end;
\f
comment move segm * page 4 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
procedure clear_last_of_record(zn, used);
value used;
zone zn;
integer used;
begin
if used mod 2 = 1 then
begin
used :=
baf := used + 1;
zn.baf(0) := false;
end;
if used mod 4 = 2 then
begin
used :=
baf := used + 2;
zn.baf(-1) :=
zn.baf( 0) := false;
end;
if used < sh_lng_bytes then
begin
laf := used;
laf1 := used + 4;
zn.laf(1) := 0;
to_from(zn.laf1, zn.laf, sh_lng_bytes - used - 4);
end;
end clear last of record;
procedure clear_last_of_slice(zn, pos);
value pos;
zone zn;
integer pos;
begin
out_rec6(zn, sh_lng_bytes);
zn(1) := real <::>;
laf := 4;
to_from(zn.laf, zn, sh_lng_bytes - 4);
k := sh_lng // 128;
for pos := pos + k + k step k until last_segm do
_ out_rec6(zn, sh_lng_bytes);
end;
\f
comment move segm * page 5 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
procedure change_bs(change, length);
value length;
integer length;
zone change;
begin
save_tail(1) := length;
length := monitor(44, change, i, save_tail);
if length <> 0 then system(9, write(out, nl, 2, <:***:>,
_ string pump(to_file), <: :>, case length of ( <:change kind imp.:>,
_ <:cat i/o error:>, <:not found:>,
_ <:protected:>, <:in use:>, <:format illegal or claims exceeded:>,
_ <:catalog inconsistent:>), nl, 2),
_ <:chngentry:>);
end change_bs;
integer procedure claimproc_call(name);
long array name;
begin
integer key_no, bs_no, entries, segm, slice_lng;
bs_no := -1;
key_no := 0;
if -, claim_proc(key_no, bs_no, name, entries, segm, slice_lng)
_ then key_no := write(out, nl, 1,
_ <:+++ bs<95>name not valid :>, string pump(name), nl, 1);
if key_no <> 0 then system(9, 0, <:<10>***claim:>);
claim_proc_call := slice_lng;
end claimproc_call;
\f
comment move segm * page 6 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
moved := 0;
raf :=
from__segm :=
first_segm :=
first_byte := 0;
last_segm := -1;
last_byte := -1;
sh_lng :=
stations :=
k := 1;
from_file(1) := 0;
devi(1) := long <:disc:>;
devi(2) := long <::>;
new_size := true;
if read_param( to_file.raf ) <> -1 then
system( 9 ) alarm exit :( -1, <:<10>**tofile:> );
if read_param(from_file.raf) <> 2 then
system(9)alarm:(-2, <:<10>**infile:>);
<* prepared for reading <to_segm> *>
j := 5;
param_error := false;
\f
comment move segm * page 7 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
for i := read_param( name ) while i <> 0 do
if i = 2 then
begin
_ j := nr_string( i, 7, string(name(1)),
_ case i of ( <:to:>, <:move:>, <:moveb:>, <:segm:>,
_ <:from:>, <:stat:>, <:chang:>)) - 1;
end
else
if i = 3 and j <> 0 then
begin
case j of
begin
begin <* first.<fi_segm>.<f_byte> *>
if k = 1 then first_segm := round( name(1) ) else
if k = 2 then first_byte := round(name(1))-1;
k:= k + 1;
end;
<* move.<move_segm> *>
last_segm := round name(1);
<* movebyte.<move_byte> *>
last_byte := round name(1);
<* seg. *>
sh_lng := round name(1);
<* <from_file>. *>
from_segm := round name(1);
<* stat. *>
stations := round name(1);
end;
if k<>2 or j<>1 then j := 0;
end
else
if i=4 and j=5 then
begin
from_file.raf(1) := name(1);
from_file.raf(2) := name(2);
end
else
if i = 4 and j = 1 then
begin
devi.raf(1) := name(1);
devi.raf(2) := name(2);
end
else
if i=4 and j=7 then new_size := name(1) = real<:yes:>
else
begin
param_error := true;
write(out, nl, 1, <:wrong :>,
_ if i<=2 then <:first:> else <:second:>, <: param :>);
if i>2 then write(out, <:to :>, case (j+1) of (
_ <:unknown:>, <:to:>, <:moveb:>, <:move:>, <:segm:>,
_ <:from:>, <:stat:>, <:change:>), <:.:>);
if i mod 2 = 1 then
_ write(out, <<d>, name(1)) else
_ write(out, string pump(name));
out_char(out, 10);
end;
\f
comment move segm * page 8 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
if from_file(1) = 0 then system(9, -2, <:<10>**infile:>);
if param_error then system(9, 0, <:<10>***param:>);
if first_byte > 511 then
begin
first_segm := (first_byte // 512) + first_segm;
first_byte := first_byte mod 512;
end;
begin
zone zm(1, 1, std_error);
open(zm, 0, fromfile, 0);
close(zm, true);
i := monitor(42)lookup:(zm, i, from_tail);
if i<>0 then system(9) alarm exit :(
_ write( out, <:*** :>, from_file,
_ sp, 3, case i of (
_ <::>, <:cat i/o error:>, <:not found:>, <::>, <::>,
_ <:name format illegal:> )), <:<10>**lookup:> );
end;
scope(1) := 0;
i := look_up_proc( scope, to_file, to_tail );
if ( scope(1)=long<:syste:> add 109
_ and to_tail(1) <> (2048 shift 12) add 18 ) or i <> 0 then
begin
<* to_file = set 1 <bs>/disc *>
laf := 0;
for i := 2 step 1 until 5 do to_tail.laf(i) := 0;
to_tail(1) := 1;
laf := 2;
to_tail.laf(1) := devi(1);
to_tail.laf(2) := devi(2);
i := set_proc( to_file, to_tail );
if i<> 0 then
system( 9 ) alarm exit :( write( out, nl, 1, <:*** :>,
_ to_file, sp, 3, case i of ( <::>,
_ <:bs device unknown:>, <::>, <:no resources:>, <:in use:>,
_ <:name format illegal:>, <:catalog inconsistency:>), nl, 1),
_ <:<10>*** set:> );
end;
\f
comment * page
0 1 2 3 4 5 6 7 8 9 ;
<* check for more than one station *>
tape := to_tail(1) = ( 2048 shift 12 ) add 18;
bs := -, tape;
if from_tail(1) = ( 2048 shift 12 ) add 18 and tape then
_ system( 9 ) alarm exit :( 2, <:<10>*** stat:> );
if to_tail(1) < 0 and bs then
_ system( 9 ) alarm exit :( to_tail(1) extract 12,
_ <:<10>todevice:> );
<*save to_tail*>
for i := 1 step 1 until 10 do
begin
save_tail(i) :=
to_descr(i) := to_tail(i);
from_descr(i) := from_tail(i);
end;
laf := 2;
if tape then
begin <*move mt-name*>
to_file(1) := to_tail.laf(1);
to_file(2) := to_tail.laf(2);
end;
<*set start, set length *>
if -, tape then to_tail(7) := 0;
to_tail(8) := ( if tape then to_tail(8) else 0 ) + first_segm;
to_tail(1) := if tape then 18 else 4;
tape := from_tail(1) = ( 2048 shift 12 ) add 18;
bs := bs and -, tape;
if from_tail(1) < 0 and -, tape then
_ system( 9 ) alarm exit :( from_tail(1) extract 12,
_ <:<10>fromdevi:> );
if tape then
begin <*move mt-name*>
from_file(1) := from_tail.laf(1);
from_file(2) := from_tail.laf(2);
end;
if first_byte + first_segm = 0 and bs then
for i := 6 step 1 until 10 do
_ save_tail(i) := to_descr(i) := from_tail(i);
if -, tape then from_tail(7) := 0;
from_tail(8) := ( if tape then from_tail(8) else 0 ) + from_segm;
from_tail(6) := if tape then 1 else from_tail(1);
from_tail(1) := if tape then 18 else 4;
\f
comment move segm * page 10 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
if last_segm > 0 then
_ last_byte := (if last_byte > -1 then last_byte else 0)
_ + last_segm * 512;
last_byte_tape := last_byte = -1 and tape;
moved := (extend from_tail(6) - from_segm) * 512 - first_byte;
if last_byte = -1 then
_ last_byte := if tape then 0 else moved;
if moved < last_byte and -, tape then
begin
k := last_byte;
last_byte := moved;
write( out, nl, 2, <:+++ warning: try to move:>, << z>,
_ k, <: bytes. <10>+++ moved = entry length :>,
_ if firstsegm+firstbyte > 0 then <: minus start point:>
_ else <::>, last_byte, <: bytes:>, nl, 2 );
end;
moved := 0;
free_size := -200-3*512<*prog_core*>+system(2, i, name);
if free_size < 512 then
_ system(9, 3*512 - free_size, <:<10>needcore:>);
to___slice_lng := claim_proc_call(to___descr.laf);
from_slice_lng := claim_proc_call(from_descr.laf);
if bs then
begin
last_segm := (((last_byte + first_byte + 511) // 512
_ + first_segm + to_slice_lng - 1) // to_slice_lng)
_ * to_slice_lng;
if last_byte >= 512 then
_ sh_lng := HFS(free_size//512, HCF(toslicelng, fromslicelng));
set_const(sh_lng);
end;
\f
comment move segm * page 11 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
if first_segm - to_sh_pos + shift_size + first_byte = 0 and bs then
begin
zone to_from_zn(shlng, 1, std_error);
get_zone6(to_from_zn, to___descr);
open(to_from_zn, 4, string pump(from_file), 0);
set_position(to_from_zn, 0, from_segm);
get_zone6(to_from_zn, from_descr);
set_zone6(to_from_zn, to___descr);
open(to_from_zn, 4, string pump(to___file), 0);
set_position(to_from_zn, 0, first_segm);
to_move := sh_lng_bytes;
while moved < last_byte do
begin
if to_move + moved > last_byte then
_ to_move := last_byte - moved;
get_zone6(to_from_zn, to___descr);
set_zone6(to_from_zn, from_descr);
in___rec6(to_from_zn, to_move);
get_zone6(to_from_zn, from_descr);
set_zone6(to_from_zn, to___descr);
out__rec6(to_from_zn, sh_lng_bytes);
moved := moved + to_move;
if moved < last_byte then out_rec6(to_from_zn, 0);
end;
if to_move < sh_lng_bytes then
_ clear_last_of_record(to_from_zn, to_move);
if sh_lng // 128 + to_descr(9) < last_segm then
_ clear_last_of_slice(to_from_zn, sh_lng//128 + to_descr(9));
last_segm := (tomove // 512) + to_descr(9);
set_position(to_from_zn, 0, 0);
change_bs(to_from_zn,
_ if newsize or save_tail(1) < last_segm
_ then last_segm else save_tail(1));
close(to_from_zn, true);
set_zone6(to_from_zn, from_descr);
close(to_from_zn, true);
\f
comment move segm * page 12 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
end shift_size + first_byte = 0 and bs
else
begin
if last_byte >= 512 and bs then
sh_lng := H_F_S((free_size - 600) // 1024,
_ H_C_F(to_slice_lng, from_slice_lng) );
set_const(sh_lng);
begin
zone to, from (sh_lng, 1, std_error);
open( to , to___tail(1), string pump(to___file), 0);
open(from, from_tail(1), string pump(from_file), 0);
set_position( to , to___tail(7), to___sh_pos);
set_position(from, from_tail(7), from_sh_pos);
if first_byte + first_segm - to_sh_pos > 0 then
begin
in_rec6(to, sh_lng_bytes);
set_position(to, to_tail(7), to_sh_pos);
end;
to_move1 := 0;
\f
comment move segm * page 13 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
if first_segm - to_sh_pos + first_byte + shift_size > 0 then
begin
if in_rec6(from, 0) > 2 then
begin
in_rec6(from, sh_lng_bytes);
out_rec6(to , sh_lng_bytes);
laf := (from__segm - from_sh_pos) * 512;
laf1 := (first_segm - to___sh_pos) * 512;
if last_byte_tape then
_ last_byte := sh_lng_bytes - laf - first_byte;
if first_byte mod 2 = 1 then
begin <* move one byte *>
baf := first_byte + 1;
to.laf1.baf(0) := from.laf.baf(0);
moved := 1;
end
else baf:= first_byte;
to_move := sh_lng_bytes - laf - baf;
if to_move+moved > lastbyte then to_move := last_byte-moved;
if to_move + laf1 + baf > sh_lng_bytes then
begin
to_from(to.laf1.baf, from.laf.baf, sh_lng_bytes - laf1 - baf);
moved := moved + sh_lng_bytes - laf1 - baf;
to_move := to_move - sh_lng_bytes + laf1 + baf;
out_rec6(to, sh_lng_bytes);
laf := sh_lng_bytes - shift_size;
laf1 :=
baf := 0;
end;
to_from(to.laf1.baf, from.laf.baf, to_move);
moved := moved + to_move;
to_move := baf + to_move;
laf := (if shift_size>0 then sh_lng_bytes-shift_size else 0);
laf1 := shift_size;
end
else
begin
to_move := 0;
last_byte := 0;
end;
end
else
laf := 0;
if in_rec6(from, 0) > 2 then
begin
if last_byte_tape then
_ last_byte := last_byte + sh_lng_bytes;
end
else
last_byte := moved;
\f
comment move segm * page 14 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
while moved < last_byte do
begin
to_move1 := sh_lng_bytes - shift_size;
if to_move1 + moved > last_byte then
_ to_move1 := last_byte - moved;
to_move := to_move1;
in_rec6(from, sh_lng_bytes);
if shift_size = 0 then
_ to_move1 := out_rec6(to, sh_lng_bytes)
else
begin
to_from(to.laf1, from, to_move1);
to_move := shift_size;
if to_move + to_move1 + moved > last_byte then
_ to_move := last_byte - moved - to_move1;
if to_move > 0 then
_ out_rec6(to, sh_lng_bytes);
end;
to_from(to, from.laf, to_move);
moved := moved + to_move1 + to_move;
if tape then
begin
if in_rec6(from, 0) > 2 then
begin
if last_byte_tape then
_ last_byte := last_byte + sh_lng_bytes;
end
else
last_byte := moved;
end;
end;
if to_move = 0 then to_move := shift_size + to_move1;
if 0 < to_move and to_move < sh_lng_bytes and
_ first_segm*512 + first_byte + last_byte >= 512 then
_ clear_last_of_record(to, to_move);
get_zone6(to, to_descr);
if to_descr(1) = 4 then
begin
last_segm := ((to_descr(9) + to_slice_lng - 1)
_ // to_slice_lng) * to_slice_lng;
if to_descr(9) < last_segm then
_ clear_last_of_slice(to, to_descr(9));
last_segm := to_descr(9) - ((sh_lng_bytes-tomove) // 512);
set_position(to, 0, 0);
change_bs(to, if newsize or save_tail(1) < last_segm
_ then last_segm else save_tail(1));
end;
close(from, true );
close( to , true );
end to, from declare;
end shift_size<>0 or tape;
\f
comment move segm * page 15 10 03 80, 14.23
0 1 2 3 4 5 6 7 8 9 ;
i := write(out, nl, 1, string pump(to_file)) + 2;
write(out, <: = movesegm :>, string pump(from_file),
_ <:.:>, <<d>, from_segm, <:,<10>:>,
_ sp, i, <:to.:>, first_segm, <:.:>, first_byte+1);
moved := last_byte // 512;
last_byte := last_byte mod 512;
if moved > 0 then
write(out, <:,<10>:>, sp, i, <:movesegm.:>, moved);
if last_byte > 0 or moved = 0 then
write(out, <:,<10>:>, sp, i, <:movebytes.:>, last_byte);
write(out, <:,<10>:>, sp, i, <:segm.:>, sh_lng//128, nl, 2);
trap_mode := 1 shift 10;
end;
\f
; move segm * page 16 10 03 80, 14.23;
if warning.yes
( mode 0.yes
message move_segm not ok
look_up movesegm
)
if 0.no
scope project movesegm
end
finis
▶EOF◀