|
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: 13920 (0x3660)
Types: TextFile
Notes: flxfile
Names: »s28101:1.tsaveconv main «, »tsaveconv main «
└─⟦2c579b2cd⟧ Bits:30004129/s28101.imd SW8101/2 BOSS v.2 rel. 2.0
└─⟦4fb120d20⟧
└─⟦this⟧ »s28101:1.tsaveconv main «
saveconv = set 30 1
scope user saveconv
saveconv = algol list.no xref.no
begin write(out,<:<12><10> saveconv versionid: 78 10 25, 12 <10>:>);
begin
comment sm 75.09.08 tsaveconv ...1... ;
comment the program is used, when boss has crashed for some reason.
the purpose is to save all convertareas, made ready for conversion.
catalog entries, describing these convertareas are recognized as follows:
interval = -8388606,-8388606
key = 2 (i.e. login scope)
the catalog entry contains further information:
name table address field contains segmentnumber and -byterelative in
usercatalog, for finding user-identification.
entry field contains paper number.
the areas are copied to a magtape in the following way:
file 1 : number of areas, papertype of the first area(s),
file 2 to file: each file contains one area witch should be printed on the paper-
type defined in file 1. each area is written on the tape with a triangle before
and after,
file x+1: papertype of the next area(s),
etc.
last file: contains the text: all files have been printed.
the generated tape can be used as input-tape to the program getconv or it
can be printed on a converter-installation.
call of program: saveconv
or saveconv <tape-id>.<mode>
where <tape-id> ::= mt<identificator>
and <mode> ::= mto, mte, nrz or nrze.
default values : mtsaveconv.mto;
\f
comment sm 75.09.08 tsaveconv ...2... ;
zone cat, usercat(128, 1, stderror), z(128, 1, stderror);
integer field word, key, lower, upper, size, userid;
long field name1, name2;
boolean field papertype;
integer entryno, i, k, mode, number;
integer array oldcatbase,ia(1:20);
long array field usernamebase;
real a;
real array param1, param2(1:2), modetext(1:4);
procedure paramerr;
begin comment called if errors in program-parameters;
write(out,<:<10>parameter error.:>);
goto exit;
end;
for i:=1 step 1 until 4 do
modetext(i):=real(case i of (<:mto:>,<:mte:>,<:nrz:>,<:nrze:>));
comment read program parameters (if any);
k:=system(4, 1, param1);
if k=4 shift 12 + 10 then
begin
if param1(1) shift (-32) shift 32 <> real<:mt:> then paramerr;
k:=system(4, 2, param2);
if k<>8 shift 12 + 10 then paramerr;
a:=param2(1);
mode:=-1;
for i:=1 step 1 until 4 do
if a=modetext(i) then mode:=(i-1)*2;
if mode=-1 then paramerr;
end
else
if k=0 then
begin
param1(1):=real<:mtsav:> add 101;
param1(2):=real<:conv:>;
mode:=0;
end
else
paramerr;
system(11) get catalog base etcetera :(0,oldcatbase); comment save old catalog base;
comment check that the private bases of boss (-8388607, -8388606) is contained in
the max base (7,8) of the process and contains, equals or is contained in the
std base (3,4);
if oldcatbase(7)>-8388607 or oldcatbase(8)<-8388606 then
begin
write(out,<:*** max base should contain: -8388607, -8388606:>,
<:<10>it is: :>,oldcatbase(7),<:, :>, oldcatbase(8));
goto exit
end;
if oldcatbase(3)>-8388607 or oldcatbase(4)<-8388606 then
begin
write(out,<:*** std base should contain: -8388607, -8388606:>,
<:<10>it is: :>, oldcatbase(3), <:, :>, oldcatbase(4));
goto exit
end;
open(z, 0, <::>, 0); comment for set catbase;
ia(1) := ia(2) := -8388607; comment interval of usercat;
monitor(72) set catalog base :(z, 0, ia);
open(usercat, 4, <:usercat:>, 0);
inrec6(usercat, 512); comment to set name table address;
ia(1) := ia(2) := -8388606; comment interval of convert areas;
monitor(72) set catalog base :(z, 0, ia);
close(z,true);
open(cat, 4, <:catalog:>, 0);
monitor(42) lookup entry :(cat, 0, ia); comment to get catalog size;
entryno := ia(1) * 15;
comment the following fields describe a catalog entry;
key := 2; lower := 4; upper := 6; name1 := 10; name2 := 14;
size := 16; userid := 26; papertype := 32;
\f
comment sm 75.09.08 tsaveconv ...3... ;
comment scan the whole catalog;
number:=0;
comment all catalog-entries of convert-areas are copied to the area helpcatalog;
open(z,4,<:helpcatalog:>,0);
ia(1):=ia(2):=1;
monitor(40,z,0,ia);
for entryno:=entryno step -1 until 1 do
begin
inrec6(cat,34);
if cat.key extract 3 = 2
and cat.lower = -8388606
and cat.upper = -8388606
and cat.size > 0 then
begin
comment this is a convert area;
for word:=2 step 2 until 34 do
begin
outrec6(z,2);
z.key:=cat.word;
end;
number:=number+1;
end;
end;
close(z,true);
close(cat,true);
if number=0 then goto endprog;
begin
comment now the areas are copied;
procedure writ(type);
value type; integer type;
begin
comment the procedure writes triangles, area and userid etc. before exit
the current share is filled with <0>. each triangle fills two blocks
type: 1 : start-triangle, 2: end triangle;
integer nuchar, i, rest;
nuchar:=0;
nuchar:=nuchar+(if type=1 then write(output,<:<15>:>) else
write(output,<:<12>:>));
nuchar:=nuchar+write(output,false add 0,1,<:<10><10>area: :>);
i:=1;
write(output,false add 0,(12-write(output,
string (case increase(i) of (z.name1, z.name2)))));
nuchar:=nuchar+12; i:=1;
nuchar:=nuchar+write(output,<:<10><10>papertype : :>,<<zdd>,paper,
<:<10><10>size: :>,<<zddd>,nusegm,
<:<10><10>:>,string usercat.usernamebase(increase(i)),
false add 0,1);
for i:=1 step 1 until 25 do case type of
begin
nuchar:=nuchar+write(output,<:<10>:>,false add 32,(i-1),
false add 42,(25-i)*2+1);
nuchar:=nuchar+write(output,<:<10>:>,false add 32,(25-i),
false add 42,(2*i)-1);
end;
nuchar:=nuchar+write(output,false add 12,1);
comment now the rest of the current share is filled with <0>;
rest:=nuchar mod 768;
if rest>0 then nuchar:=nuchar+write(output,false add 0,768-rest);
end procedure writ;
\f
comment sm 75.09.08 tsaveconv ...4... ;
integer procedure scan_or_copy(type);
value type; integer type;
begin
comment the procedure either scans or copies an area. the area is described
by means of the field-variables name1 and name2 (fields in the zone z:
helpcatalog.
type=1: the area is scanned, scan_or_copy:=number of segments,
type=2: the area is copied to tape, last block is filled with <0>;
procedure skip(z,s,b);
zone z; integer s,b;
begin
comment stop conversion on any statusbit;
write(out,<:<12><10>*** harderror, decimal status =:>,s);
goto terminate;
end procedure skip;
zone area(128,1,skip);
integer i, k, j, shifts, nuchar;
integer array ia(1:20);
integer field rel;
k:=0;
i:=1;
open(area,4,string (case increase(i) of (z.name1,z.name2)),0);
i:=1;
if type=1 then goto nextsegm;
k:=nusegm-1;
getzone6(output,ia);
ia(13):=6;
setzone6(output,ia);
for i:=1 step 1 until k do
begin
outrec6(output,512);
inrec6(area,512);
for j:=1 step 1 until 128 do output(j):=area(j);
end;
outrec6(output,512);
getzone6(output,ia);
ia(13):=3;
setzone6(output,ia);
nextsegm:
j:=inrec6(area,0);
inrec6(area,j);
k:=k+1;
nuchar:=0;
for rel:=2 step 2 until j do
for shifts:=-16 step 8 until 0 do
begin
i:=area.rel shift shifts extract 8;
if i=25 or i>127 then goto terminate;
if type=2 then
begin
outchar(output,i); nuchar:=nuchar+1;
end;
end;
goto nextsegm;
terminate:
if type=2 then nuchar:=nuchar+
write(output,false add 0,768-nuchar);
j:=1;
if type=2 and i>127 then
write(out,<:<10>:>,false add 32, 20,<:conversion of :>,
string(case increase(j) of (z.name1, z.name2)),
<: terminated. illegal character found:>);
comment the current block is filled with <0>, last character: <25>;
scan_or_copy:=(if type=1 then k else nuchar);
close(area, true);
end procedure scan_or_copy;
\f
comment sm 75.09.08 tsaveconv ...5... ;
zone z(entier(number*34/4) shift (-7) add 1 shift 7, 1, stderror),
output(256,2,stderror);
real array a(1:number);
real temp;
integer i, m, k, j, paper, adr, nusegm, fileno;
open(z,4,<:helpcatalog:>,0);
inrec6(z,34*number);
papertype:=-2;
for i:=1 step 1 until number do
begin
papertype:=papertype+34;
a(i):=0.0 shift 24 add (z.papertype extract 12) shift 24 add i;
end;
comment now each element of the array a holds papertype, recordnumber.
the elements is now sorted (shell-sort);
for i:=1 step i until number do m:=2*i-1;
for m:=m//2 while m<>0 do
begin
k:=number-m;
for j:=1 step 1 until k do
begin
for i:=j step -m until 1 do
begin
if long a(i+m) >= long a(i) then goto nextj;
temp:=a(i); a(i):=a(i+m); a(i+m):=temp;
end i;
nextj:
end j;
end m;
comment now the array a contains elements of two integer-fields each.
first word: papertype, second word: the number of the record
in the file helpcatalog (the zone z)
now the areas are copied from disc to tape;
i:=1;
open(output,mode shift 12+18,string param1(increase(i)),0);
paper:=a(1) shift (-24) extract 24;
fileno:=1; setposition(output,fileno,0);
comment the first file, first block is now written. it contains the num-
ber of areas to be copied and information about the papertype
to be used first;
write(output,<:<15><12><10><10>number of areas: :>,
<<zdd>,number);
for i:=1 step 1 until 20 do write(output,
<:<10><10> put paper of type :>,<<zdd>,paper,<: in printer!:>);
write(output,false add 10,10,false add 0,13,false add 12,1);
comment the block is filled with <0>;\f
comment sm 75.09.08 tsaveconv ...6... ;
write(out,<:<10> copied areas:<10>fileno on tape<10>:>,
<: papertype<10> filename<10>:>);
for i:=1 step 1 until number do
begin
comment the areas are copied. for each area the following is written:
a leading triangle with id-information (2 blocks),
the area itself and a terminating triangle (2 blocks);
adr:=((a(i) extract 24) - 1) * 34;
comment adr points to the byte just before the actual record;
papertype:=32+adr;
name1:=10+adr;
name2:=14+adr;
userid:=26+adr;
setposition(usercat,0,z.userid shift (-12));
inrec6(usercat,512);
usernamebase:=z.userid extract 12;
if paper<>(z.papertype extract 12) then
begin
comment the next area to be copied has specified a papertype
different from the last one;
paper:=z.papertype extract 12;
comment 1 block is written (in its own file) containing infor-
tion to the operator about the papershift;
fileno:=fileno+1; setposition(output,fileno,0);
write(output,<:<15><12><10><10>:>,
false add 0,2);
for k:=1 step 1 until 15 do write(output,
<:change paper in printer.new papertype: :>,
<<zdd>,paper,<:<10><10>:>,false add 0,4);
write(output,false add 0,41,false add 14,1);
comment the block is filled with <0>;
end;
fileno:=fileno+1; setposition(output,fileno,0);
nusegm:=scan_or_copy(1); comment the area is scanned to find its size;
writ(1); comment leading triangle is written;
k:=scan_or_copy(2); comment the area is copied;
writ(2); comment the terminating triangle is written;
j:=1;
write(out,<:<10>:>,<<ddd>,fileno,<< ddd>,paper,<: :>,
string (case increase(j) of (z.name1,z.name2)));
end i;
fileno:=fileno+1; setposition(output,fileno,0);
write(output,<:<15><12><10><10>:>,false add 0,2);
for i:=1 step 1 until 25 do write(output,
<:all files have been printed <10><10>:>);
write(output,false add 0,11,false add 12,1);
setposition(out,0,0);
close(output,true);
close(z,true);
end;
endprog:
write(out, <:<12>
***conversion finished
:>);
open(z, 0, <::>, 0); comment reestablish old catalog base;
monitor(72) set catalog base :(z, 0, oldcatbase);
close(z, true);
close(usercat, true);
exit: ; comment used by base alarm and paramerr;
end;
end
▶EOF◀