|
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: 5376 (0x1500)
Types: TextFile
Names: »retsave5tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retsave5tx «
save51tx=edit save5tx
; blocklength error in get_file_nos for blocklength = 4, 7, 10
;
; give up if timer status from tape if not empty input
;
; no of shares always = 3
;
l./message declare zones page 1;/, l-1, r/88.08.11/90.02.13/
l./no_of_shares :=/, r/if segm/<*if segm/, r/2 else/2 else*>/
l./message end of document page 1;/, l-1, r/84.06.06/90.02.13/
l./<******/,
d./end <*end of document*>;/, d./end <*end of document*>;/, i#
<**********************************************************>
<* *>
<* The procedure acts as a block procedure in the zone ar-*>
<* ray za (1:no_of_copies + 1) and supposes that there are*>
<* no other user bits in the status than 1<18, e. o. d. *>
<* and 1 shift 21, timer. *>
<* The purpose of the procedure is to : *>
<* - give up and call stderror if give up bit is raised *>
<* - in case of end of document status, *>
<* signal end of document status in the global boolean *>
<* array end_of_doc indexed with the index found in the *>
<* partial word of the zone ztape (set there by openin- *>
<* out or explicitly by the program in case of normal *>
<* record io). *>
<* - in case of timer status, give up if anything else *>
<* then empty input (which might be unrecorded media on *>
<* streamer casette tape) *>
<* - ignore the status if the operation was output *>
<* - simulate a block of 2 halfs if the operation was in- *>
<* put and nothing was transferred *>
<* *>
<**********************************************************>
integer array zdescr (1:20), sdescr (1:12);
integer index, operation;
if status extract 1 = 1 then
give_up (ztape, status, hwds);
if status shift (-21) extract 1 = 1 then
begin <*timer*>
if not (operation = 3 and
hwds = 0 ) then
give_up (ztape, status, hwds);
end
else
if status shift (-18) extract 1 = 1 then
begin <* end of document *>
getzone__6 (ztape, zdescr );
getshare_6 (ztape, sdescr, zdescr (17)); <*used share*>
index := zdescr (12);
operation := sdescr ( 4) shift (-12);
end_of_doc (index) := true;
end <* end of document *>;
if operation = 3 <* input*> and
hwds = 0 <*nothing xferred*> then
hwds := 2;
end <*end of document*>;
#, p-2
l./page ...110/, l./message prepare tapes and ida page 1;/,
l-1, r/84.10.31/90.01.16/
l./get_filenos/, l-1, d2, i#
begin <*special block for decl of zones for get file nos*>
integer high, low, segs_pr_buf_low, segs_pr_buf_high, segs_pr_buf;
array ra (1:2);
low := system (15, high, ra);
segs_pr_buf_low :=
if low <= 1022 then
0
else
((low - 1022) shift (-9)) // no_of_copies;
segs_pr_buf_high :=
if high <= 1022 then
0
else
((high - 1022) shift (-9)) // no_of_copies;
segs_pr_buf :=
if segs_pr_buf_high >= segs_pr_buf_low then
segs_pr_buf_high
else
segs_pr_buf_low;
if segs_pr_buf > 84 then
segs_pr_buf := 84; <*max allowed tape buffer*>
if test then
write (out,
"nl", 2, <:special block for declare zones for get_filenos:>,
"nl", 1, <:low = :>, low,
"nl", 1, <:segs pr buf low = :>, segs_pr_buf_low,
"nl", 1, <:high = :>, high,
"nl", 1, <:segs pr buf high = :>, segs_pr_buf_high,
"nl", 1, <:segs pr buf = :>, segs_pr_buf);
<*100 halfs for call of opentape, ff., rounded up to 1022*>
<* 42 halfs for one share descriptor , rounded up to 1022*>
begin <*extra block for decl of zone array*>
zone array ztape (no_of_copies,
if segs_pr_buf_high >= segs_pr_buf_low then
segs_pr_buf * 128
else
1 shift 23 +
segs_pr_buf * 128,
1,
end_of_document);
get_filenos (ztape, no_of_copies, vol_count, no_of_vol,
tapename , device_no, modekind , fileno);
end;
end;
#, p-20
l./setposition (ztape/, l2, i/
trap (traplabel); <*to release and remove processes*>
/, p-1
f
▶EOF◀