|
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: 13056 (0x3300)
Types: TextFile
Names: »retsave3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retsave3tx «
mode list.yes
save4tx=edit save3tx
; remove process udskydes til senere i save entries
; check af write access counter og area size genindføres nu da ida er enkbufret
; "covered by a better entry" => "area process inaccessible"
; "area size changed during save" laves om fra alarm til warning
; parameter array til system med lower bound = 0
; high speed bit til og fra i save entries
; connect output : segm < 2 + 0
l./page ... 36/, l./message stack current output/, l-1, r/81.12.07/88.09.08/
l./result := 2;/, r/2/1 shift 2/, r/1<1/1<2/, r/preferably on drum/temporary/
l./page ...38/, l./message connect output/, l-1, r/84.04.25/88.09.08/
l./1 shift 1/, r/1 shift 1/1 shift 2/, r/pref drum/temporary/
;********************************************
l./message decl. second level/, l./page 2;/, l-1, r/85.02.08/88.02.04/
l./dummy,/, i/
speedlimit ,
monrelease ,
/, p1
;********************************************
l./message mount param page 1;/, l-1, r/81.12.04/88.08.21/
l./<********/, d, d./<*******/, i/
<***************************************************************>
<* *>
<* The procedure returns the kind of the item given. *>
<* *>
<* Call : mount_param (seplength, item); *>
<* *>
<* mount_param (return value, integer). The kind of the *>
<* item : *>
<* 0 seplength<> <s> or ., item not below *>
<* 1 seplength = <s> or ., item = mountspec *>
<* 2 -"- , -"- release *>
<* 3 -"- , -"- mt62, mtlh, mto *>
<* 4 -"- , -"- mte *>
<* 5 -"- , -"- mt16, mtll, nrz *>
<* 6 -"- , -"- nrze *>
<* 7 -"- , -"- mt32 *>
<* 8 -"- , -"- mt08 *>
<* 9 -"- , -"- mthh *>
<* 10 -"- , -"- mthl *>
<* seplength (call value, integer). Separator < 12 + *>
<* length as for system (4, ...). *>
<* item (call value, array). An item in *>
<* item (1:2) as for system (4, ...). *>
<* *>
<***************************************************************>
/
l./message mount param page 2;/, l-1, r/84.05.30/88.08.21/
l./for i := 1 step 1/, d./i := 8/, i/
for i := 1 step 1 until
(if seplength <> space_txt and
seplength <> point_txt then 0 else 10) do
if item (1) = real ( case i of (
<:mount:> add 's',
<:relea:> add 's',
<:mt62:> ,
<::> ,
<:mt16:> ,
<::> ,
<:mt32:> ,
<:mt08:> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<:pec:> ,
<:e:> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mtlh:> ,
<::> ,
<:mtll:> ,
<::> ,
<::> ,
<::> ,
<:mthh:> ,
<:mthl:> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) )
or item (1) = real ( case i of (
<::> ,
<::> ,
<:mto:> ,
<:mte:> ,
<:nrz:> ,
<:nrze:> ,
<::> ,
<::> ,
<::> ,
<::> ) ) and
item (2) = real ( case i of (
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ,
<::> ) ) then
begin j := i; i := 10; end;
/
l./message prepare cat scan page 2/, l-1, r/85.07.09/88.02.01/
l./integer field/, l1, i/
integer array field iaf;
/, p-1
l./result :=/, i/
iaf := -2;
/, p1
l./system (5 )/, r/proc_descr)/proc_descr.iaf)/
l./message save entries page 8;/, l-1, r/85.07.09/88.02.01/
l./close (zhelp/, d1, i/
close (zhelp, false); <*process will be removed later*>
/, p1
l./message save entries page 12/, l-1, r/85.07.02/88.11.03/
l.#if (entry_kind (j) // segm) > 4#, d6, i#
for copy_count := 1 step 1 until copies do
if modekind (copy_count) shift 4 < 0 then
begin <*high speed bit specified*>
getzone6 (za (copy_count), zdescr);
zdescr (1):=
if entry_kind (j) <
speedlimit /
(if modekind (copy_count) shift 9 < 0 then 4 else 1) then
logand (modekind (copy_count),
-(1 shift 19 + 1)) extract 23 <*clear*>
else
logor (modekind (copy_count),
1 shift 19 ) extract 23;<*set *>
if test then
write (out,
"nl", 1, <:high speed bit zone (:>, copycount,<:) = :>,
zdescr (1) shift (-19) extract 1,
"nl",1,<:size = :>, entry_kind (j),
"nl", 1, <:speedlimit/dens = :>, speedlimit/
(if modekind (copycount) shift 9 < 0 then 4 else 1));
setzone6 (za (copy_count), zdescr);
end;
#, p1
l./<. write acces counter again/, r/<*/ /, g 18/<./<*/, g -18/.>/*>/
l-19,
l./<*write acces counter again*>/, d2, i/
<* write access counter again*>
system (5) move core :( entry_nta (j) , proc);
system (5) move core :( proc (1) - 4, proc);
if test then
write (out,
"nl", 1, <:entry_nta (j) = :>, entry_nta (j) ,
"nl", 1, <:proc (17) = :>, proc (17) ,
"nl", 1, <:write acc = :>, entry_wr_acc (j));
/
l./true, 9/, g/, 9,/, 10,/
l./*** alarm : area size changed during save/, r/alarm/warning/
l./true, 9/, g/, 9,/, 10,/
l2, r/trap (-1)/errorbits := 2/, r/;/; <*warning.yes, ok.yes*>/
l2, r/*>/ /
l./begin <*remove highspeed bit in modekind*>/, l-1, d./if ida_copy/, d./end;/
i#
getzone6 (za (copy_count), zd);
zd (1) := logand (modekind (copy_count),
-(1 shift 19 + 1)) extract 23 <*clear high speed*>;
if ida_copy then
begin <*update position in tape zone*>
getposition (zida ,
fileno (copy_count),
blockno (copy_count));
zd (7) := fileno (copy_count);
zd (8) := blockno (copy_count);
end;
setzone6 (za (copy_count), zd);
#, p1
l./end <*next entry*>/, l./if entry_kind (j) > 0/, r/>/>=/, p1
l./monitor (64/, d, i/
area_proc := monitor (4) proc :(zhelp, 0, proc <*dummy*>);
if area_proc <> outproc and
area_proc <> catproc then
monitor (64) remove process :(zhelp, 0, zdescr);
/, p-4
l./message list entry page 2;/, l-1, r/81.12.30/88.08.11/
l./write (z, "sp", 3, true, 7, case modekind/, d./<:mte:>/, i/
if monrelease < 80 shift 12 + 0 then
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mtlh:>,
<: mte:>, <:mtll:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ))
else
write (z, "sp", 3, true, 7, case modekind of (
<: ip:>, <: bs:>, <: tw:>, <: tro:>, <: tre:>, <: trn:>,
<: trf:>, <: trz:>, <: tpo:>, <: tpe:>, <: tpn:>, <: tpf:>,
<: tpt:>, <: lp:>, <: crb:>, <: crd:>, <: crc:>, <:mt62:>,
<: mte:>, <:mt16:>, <:nrze:>, <:mt32:>, <:mt08:>, <:mthh:>,
<:mthl:>, <: pl:> ));
/
l./message skip entry page 1;/, l-1, r/85.07.08/88.09.02/
l./<:covered by a better entry/,
r/covered by a better entry/area process inaccessible/
l./errorbits := 2/, d, i/
if result extract 12 < 4 then
errorbits := 2; <*warning.yes, ok.yes*>
/, p-2
l./message modekind case page 1;/, l-1, r/81.12.30/88.08.11/
l./until 24/, r/24/26/
l./<*mto, mtlh*>/, d./<*mthl*>/, i/
1 shift 23 + 0 shift 12 + 18, <* mt62, mto, mtlh*>
1 shift 23 + 2 shift 12 + 18, <* mte*>
1 shift 23 + 4 shift 12 + 18, <* mt16, nrz, mtll*>
1 shift 23 + 6 shift 12 + 18, <* nrze*>
1 shift 23 + 8 shift 12 + 18, <* mt32*>
1 shift 23 + 12 shift 12 + 18, <* mt08*>
1 shift 23 +128 shift 12 + 18, <* mthh*>
1 shift 23 +132 shift 12 + 18, <* mthl*>
/, p-8
l./i := 24/, r/24/26/
l./message program/, l./page 2;/, l-1, r/85.01.16/88.08.11/
l./<*obtain area and buffer claim*>/, i/
<*get monitor release*>
system (5) move core :(64, dummyia);
monrelease := dummyia (1); <*rel shift 12 + subrel*>
/, p-3
l./message program/, l./page 3;/, l-1, r/84.05.30/88.02.04/
;*********************************************
l./tape_param_ok :=/, l1, i/
<*
write (out, "nl", 1, <:speed limit : :>, "<", 1);
*>
<*stopzone (out, false);*>
<*read (in, speedlimit);
write (out, "nl", 1, <:speed limit : :>, speedlimit, "nl", 1);
*>
<*stopzone (out, false);*>
speedlimit := 100;
/
;**********************************************
l./message program page 4/, l-1, r/81.12.15/88.09.16/
l./1 shift 23 + 18/, d./1 shift 23+132/, i/
modekind (copycount) := 1 shift 23 + 18; <*mto, mtlh, mt62*>
modekind (copycount) := 1 shift 23 + 2 shift 12 + 18; <*mte*>
modekind (copycount) := 1 shift 23 + 4 shift 12 + 18; <*nrz, mtll, mt16*>
modekind (copycount) := 1 shift 23 + 6 shift 12 + 18; <*nrze*>
modekind (copycount) := 1 shift 23 + 8 shift 12 + 18; <*nr32*>
modekind (copycount) := 1 shift 23 +12 shift 12 + 18; <*mt08*>
modekind (copycount) := 1 shift 23+128 shift 12 + 18; <*mthh*>
modekind (copycount) := 1 shift 23+132 shift 12 + 18; <*mthl*>
/
l./message declare zones page 1;/, l-1, r/85.01.16/88.08.11/
l./ida_copy :=/, i/
ida_copy := monrelease < 80 shift 12 + 0; <*monitor release 80*>
/, l1, r/ida_copy :=/idacopy :=
idacopy and/,
p-2
f
end
▶EOF◀