|
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: »fttx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »fttx «
mode list.yes
ft=algol survey.yes
begin
boolean med_kopi;
integer i, j, k ;
integer array zd, zd_org, zd_kopi (1:20);
long array field docname;
zone z (128, 1, kopiproc);
integer
procedure outchar (z, i);
zone z ;
integer i ;
write (z, false add (i extract 12), 1);
procedure tøm_zone (z);
zone z ;
begin
integer array zd (1:20);
getzone6 (z, zd );
outchar (z, 'em');
setposition (z, 0, 0);
setzone6 (z, zd );
end tøm_zone;
procedure kopi_proc (z, s, b);
zone z ;
integer s, b ;
begin
integer i;
integer array zd (1:20);
if s extract 1 = 1 then
stderror (z, s, b);
if s shift (-5) extract 1 = 1 then
begin <*does not exist*>
getzone6 (z, zd);
if zd.docname (1) = long <:e :> then
begin <*kopi*>
zd (9) := zd (9) - 1; <*decrease segm count*>
<*skriv i kopiareal*>
for i := 7 step 1 until 20 do
zd_kopi (i) := zd (i);
setzone6 (z, zd_kopi);
setposition (z, 0, 0 );
<*skriv i dataareal*>
for i := 7 step 1 until 20 do
zd_org (i) := zd (i);
setzone6 (z, zd_org);
setposition (z, 0, 0 );
getzone6 (z, zd);
zd_org (6) := zd (6); <*nta*>
zd (9) := zd_org (9) + 1;
zd.docname (1) := long <:e :>;
setzone6 (z, zd);
end else
stderror (z, s, b) <*not hard error, not nonexist*>
end else
stderror (z, s, b);
end kopi_proc;
med_kopi := fp_mode (1);
docname := 2;
if med_kopi then
begin
open (z, 4, <:kopifil:>, 0);
monitor (52, z, i, zd); <*create area process*>
inrec6 (z, 0); <*name table address*>
setposition (z, 0, 0);
getzone6 (z, zd_kopi);
close (z, false);
end med_kopi;
open (z, 4, <:datafil:>, 0);
outrec6 (z, 512); <*name table address*>
setposition (z, 0, 0);
monitor (8, z, i, zd);
if med_kopi then
begin
getzone6 (z, zd_org);
zd_org (10) := 1 shift 5; <*give up mask := not exist*>
getzone6 (z, zd );
zd.docname (1) := long <:e :>;
zd (10) := 1 shift 5; <*give up mask := not exist*>
setzone6 (z, zd);
end;
for i := 1 step 1 until 7 do
begin
write (z, <:<10>< start transaction<10>:>);
for j := 11, 12, 13, 14 do
write (z, false add ('a' + i + j - 11), j, "nl", 1);
write (z, <:end transaction<10>:>, ">", 1, "nl", 1);
tøm_zone (z);
end;
if med_kopi then
begin
getzone6 (z, zd);
for i := 1 step 1 until 20 do
zd (i) := zd_org (i);
setzone6 (z, zd);
end;
<*outchar (z, 'em');
*>close (z, true);
end;
end
▶EOF◀