|
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: 22272 (0x5700)
Types: TextFile
Names: »gcrgn«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »gcrgn«
begin
boolean sign,ret,found,u,skriv,d,dd,fault,o1,o3,nypris;
long kr,B,I,E,F,R;
integer i,j,k,kontonr,tegn,ore,p,char,konto,t,uge;
integer array ia(1:2),dato(1:3),linie(1:32),tail,tail2(1:10),txt(1:36);
real array ra(1:2),skift(1:16);
real r;
zone z1,z2,z3(128,1,stderror);
integer procedure psubmit(z);
zone z;
begin
integer array carr(1:30),ia(1:20),rarr(1:11);
integer i,j;
for i:=7 step 1 until 30 do carr(i):=-1;
for i:=27,28,29,1 step 1 until 6 do carr(i):=0;
carr(26):=long <:lp:> shift (-24);
i:=wordload(66);
carr(9):= wordload(i+2);
carr(10):= wordload(i+4);
carr(11):=wordload(i+6);
carr(12):=wordload(i+8);
getzone(z,ia);
carr(21):=ia(2);
carr(22):=ia(3);
carr(23):=ia(4);
carr(24):=ia(5);
j:=transfer(2,carr,30,rarr,11);
if j=0 then write(out,<:jobnr :>,rarr(2),false add 10,1);
end;
integer procedure prisret;
begin
integer kroner;
boolean found;
found:=false;
open(z1,4,ra,0);
for i:=swoprec(z1,16) while
z1(1) shift (-24) extract 24<8388600,1 do
begin
if kontonr=z1(1) shift (-24) extract 24 and
z1(1) extract 24=dato(3)*10000+dato(2)*100+dato(1) then
begin
found:=false;
for j:=1 step 1 until 16 do
begin
linie(j*2):=z1(j) extract 24;
linie(j*2-1):=z1(j) shift (-24) extract 24;
end;
for j:=1 step 1 until 12 do
begin
txt(j*3):=linie(j+2) extract 8;
txt(j*3-1):=linie(j+2) shift (-8) extract 8;
txt(j*3-2):=linie(j+2) shift (-16) extract 8;
end;
write(out,<<zdd>,linie(1),<< zd dd dd>,linie(2),"sp",2);
for j:=1 step 1 until 36 do
write(out,false add txt(j),1);
kroner:=z1(8);
write(out,"sp",2,<<-dddddddd.dd>,kroner/100,
<< zd dd dd>,linie(17),"nl",1);
if readb(<:er det denne post:>) then
begin
found:=true;
z1(8):=kr;
goto ud;
end;
end;
end;
ud:
if -,found then
write(out,<:<10>JEG KAN IKKE FINDE DEN POST:>);
close(z1,true);
goto om;
end;
integer procedure date;
begin
omm:
dato(3):=tail(9);
write(out,<: <10>DAG MÅNED (evn. ÅR):: (eks 28/3) :>);
setposition(out,0,0); læsnl;
skipsp;
readchar(in,tegn);
if tegn=115 then goto AFSLUT else repeatchar(in);
for i := 1 step 1 until 3 do
begin
k:=dato(i) := 0;
skipsp;
nyd:
for j := readchar(in,tegn) while j = 2 do
begin
k:=-1;
dato(i) := dato(i) * 10 + tegn - 48;
end;
if tegn=105 or tegn=108 or tegn=111 then
begin
if tegn=111 then tegn:=48 else tegn:=49;
k:=-1;
dato(i):=dato(i)*10+tegn-48;
goto nyd;
end;
repeatchar(in);
skipsp;
if tegn=111 then tegn:=48;
if tegn=105 or tegn=108 then tegn:=49;
if tegn>47 and tegn<58 then goto next;
readchar(in,tegn);
if i=2 and tegn=10 then i:=3;
if i=3 and k=-1 then tegn:=32;
if i=3 and k=0 then goto omm;
if tegn<>32 and tegn<>46 and tegn<>47 and tegn<>44 then
goto omm;
next:
end;
if dato(3)>1979 then dato(3):=dato(3) mod 100;
if dato(1) < 1 or dato(1) > 31 or
dato(2) < 1 or dato(2) > 12 or dato(3)>99 then
goto omm;
end;
integer procedure kontonummer;
begin
fault:=false;
kontonrfejl:
write(out,<:<10>KONTONR: :>);
setposition(out,0,0); læsnl;
kontonr := 0;
skipsp;
readchar(in,tegn);
if tegn=115 then goto AFSLUT else repeatchar(in);
kon:
for i := i while readchar(in,tegn) = 2 do
kontonr := kontonr * 10 + tegn - 48;
if tegn=105 or tegn=108 or tegn=111 then
begin
if tegn=111 then tegn:=48 else tegn:=49;
kontonr:=kontonr*10+tegn-48;
goto kon;
end;
OM2:
for i:=readchar(z3,char) while char<>25 do
begin
if i<>2 then
begin
repeatchar(z3);
for j:=readchar(z3,char) while char<>10 and char<>25 do;
goto if char=25 then ud else OM2;
end;
repeatchar(z3);
read(z3,konto);
repeatchar(z3);
for j:=readchar(z3,char) while char<>10 and char<>25 do;
if char=25 then goto ud;
if kontonr=konto then goto ud;
end;
ud:
setposition(z3,0,0);
if kontonr<>konto then
begin
write(out,<:ukendt kontonummer<10>:>);
fault:=true;
goto om;
end;
end;
integer procedure rettelse;
begin
open(z1,4,ra,0); open(z2,4,<:gcrgn82:>,0);
if createentry(<:gcrgn82:>,tail)>0 then fejl(5);
scopeuser(<:gcrgn82:>);
found:=false;
for j:=inrec(z1,16) while z1(1) shift (-24) extract 24<8388600 do
begin
if z1(1) shift (-24) extract 24=kontonr and
z1(1) extract 24=dato(3)*10000+dato(2)*100+dato(1) and -,found then
begin
for i:=1 step 1 until 16 do
begin
linie(i*2):=z1(i) extract 24;
linie(i*2-1):=z1(i) shift (-24) extract 24;
end;
for i:=1 step 1 until 12 do
begin
txt(i*3):=linie(i+2) extract 8;
txt(i*3-1):=linie(i+2) shift (-8) extract 8;
txt(i*3-2):=linie(i+2) shift (-16) extract 8;
end;
write(out,<<zdd>,linie(1),<< zd dd dd>,linie(2),"sp",2);
for i:=1 step 1 until 36 do
write(out,false add txt(i),1);
kr:=z1(8);
write(out,"sp",2,<<-dddddddd.dd>,kr/100,
<< zd dd dd>,linie(17),"nl",1);
if readb(<:er det denne post:>) then
begin
found:=true;
inrec(z1,16);
if z1(1) shift (-24) extract 24>=8388600 then
goto stop;
end;
end;
outrec(z2,16);
for i:=1 step 1 until 16 do
z2(i):=z1(i);
end;
stop:
outrec(z2,16);
z2(1):=0.0 shift 48 add 8388600 shift 24;
close(z1,true); close(z2,true);
removeentry(ra);
renameentry(<:gcrgn82:>,ra);
if -,found then
begin
write(out,<:jeg kan ikke finde den post:>);
goto om;
end;
tail(10):=tail(10)-1;
changetail(ra,tail);
goto om;
end;
integer procedure tekst;
begin
tekstfejl:
for i := 1 step 1 until 36 do
txt(i) := 32;
write(out,<:<10>TEKST:....................................<10>:>,
<: :>);
setposition(out,0,0); læsnl;
i := 0;
for i := i + 1 while readchar(in,tegn) <> 8 do
begin
if i > 36 then
begin
write(out,<:<10>FOR LANG TEKST :>);
goto tekstfejl;
end;
txt(i) := tegn;
end;
if i=1 then goto tekstfejl;
for i:=1 step 1 until 12 do
linie(i+2):=txt(i*3-2) shift 8 add txt(i*3-1) shift 8 add txt(i*3);
end;
integer procedure pris;
begin
prisfejl:
write(out,if nypris then <:<10>NY PRIS::> else <:<10>PRIS::>,
<: (eks 27.45) :>);
setposition(out,0,0); læsnl;
kr := 0; ore := i := 0;
sign := false;
minus:;
for j:=readchar(in,tegn) while tegn=32 do;
repeatchar(in);
for i := i while readchar(in,tegn) = 2 do
kr := kr * 10 + tegn - 48;
if tegn=105 or tegn=108 or tegn=111 then
begin
if tegn=111 then tegn:=48 else tegn:=49;
kr:=kr*10+tegn-48;
goto minus;
end;
if tegn = 45 and kr=0 then
begin
sign := true;
goto minus;
end;
if (tegn <> 46 and tegn<>44 and tegn<>10) then
goto prisfejl;
if tegn<>10 then
begin
for j:=readchar(in,tegn) while tegn=32 do;
repeatchar(in);
oore:
for i := i + 1 while readchar(in,tegn) = 2 do
ore := ore * 10 + tegn - 48;
if tegn=105 or tegn=108 or tegn=111 then
begin
if tegn=111 then tegn:=48 else tegn:=49;
ore:=ore*10+tegn-48;
goto oore;
end;
if i =1 or ore>99 then
goto prisfejl;
if i=2 then ore:=ore*10;
end;
if kr>99000000 or kr<-99000000 then goto prisfejl;
kr:=kr*100+ore;
if sign then kr:=-kr;
end;
integer procedure skipsp;
begin
integer i;
for i:=readchar(in,tegn) while tegn=32 do;
repeatchar(in);
end;
integer procedure postud(z);
zone z;
begin
integer array ia(1:20);
getzone6(z,ia);
if ia(13)=3 then outchar(z,25);
setposition(z,ia(7),ia(if ia(1)=4 then 9 else 8));
if ia(1) extract 12=18 or ia(1)=4 then setzone6(z,ia);
end;
integer procedure fejl(i);
integer i;
begin
write(out,case i of(
<:gc82 kan ikke oprettes på 1 segment:>,
<:gc82 kan ikke permanentes på key 22:>,
<:gc82 er ikke i maskinen:>,
<:gc82 er nul i tail(10) FEJL???:>,
<:gcrgn82 kan ikke oprettes (25 segmenter>gc82):>,
<:gcbev82 er ikke i maskinen:>,
<:gc1out82 kan ikke oprettes på 30 segmenter:>,
<:gc2out82 kan ikke oprettes med størrelse=gc82:>,
<:fejl i gcbev82:>,
<:gc3out82 kan ikke oprettes på 30 segmenter:>));
goto udskrift;
end;
integer procedure læsnl;
begin
integer a,b;
repeatchar(in);
for a:=readchar(in,b) while b<>10 do;
end;
integer procedure flet;
begin
lookuptail(<:gcrgn82:>,tail);
open(z2,4,<:gcrgn82:>,0);
p:=tail(10);
write(out,<:Forrige kørsel har ikke været afsluttet normalt.
Derfor flettes nu de sidst indtastede poster med de øvrige poster.
Af de sidst indtastede poster er der tabt max 1 post.
Tag en udskrift for kontrol og indtast den eventuelle tabte post igen.:>,"nl",1);
setposition(out,0,0);
for j:=1 step 1 until tail(10) do
swoprec(z2,16);
open(z1,4,ra,0);
for j:=inrec(z1,16) while z1(1) shift(-24) extract 24<8388600,1 do
begin
swoprec(z2,16);
for i:=1 step 1 until 16 do
z2(i):=z1(i);
p:=p+1;
end;
close(z1,true); close(z2,true);
sort(<:gcrgn82:>,p,64,ia);
removeentry(ra);
renameentry(<:gcrgn82:>,ra);
tail(1):=(p-1)//8+1; tail(10):=p-1;
changetail(ra,tail);
goto udskrift;
end;
integer procedure init;
begin
real array ra(1:2);
cleararray(ra);
reads(<:navn på det nye dataareal:>,ra);
tail(1):=1; tail(9):=r/10000;
removeentry(<:gcrgn82:>);
removeentry(ra);
if createentry(ra,tail)>0 then fejl(1);
if scopeuser(ra)>0 then fejl(2);
open(z1,4,ra,0);
outrec(z1,16);
z1(1):=0.0 shift 48 add 8388600 shift 24;
close(z1,true);
goto udskrift;
end;
u:=false add 45;
nypris:=o1:=o3:=dd:=d:=skriv:=ret:=false;
p:=0;
B:=E:=I:=F:=R:=0;
ia(1):=0; ia(2):=2;
systime(1,0,r); r:=systime(4,r,r);
uge:=day;
cleararray(linie);
cleararray(skift);
cleararray(tail);
ra(1):=real <:gc82:> ;
ra(2):=real <::>;
if readparam(skift)=-1 then readparam(skift);
readparam(skift);
if skift(1)=real <:init:> then init;
if lookuptail(ra,tail)>0 then fejl(3);
if tail(10)=0 and lookuptail(<:gcrgn82:>,tail2)=0 then flet;
if lookupentry(<:gcbev82:>)>0 then fejl(6);
careaproc(ra);
reserveproc(ra,0);
ommm:
write(out,<:TAST DET ØNSKEDE (prisret,udskriv,ret,indsæt,stop)<10>:>,
<:<10><10>>:>);
setposition(out,0,0);
læsnl; skipsp;
readchar(in,tegn);
læsnl;
if tegn=112 then nypris:=true else
if tegn=115 then goto udskrift else
if tegn=105 then else
if tegn=114 then ret:=true else
if tegn=117 then skriv:=true else
goto ommm;
open(z3,4,<:gcbev82:>,0);
if skriv then
begin
integer a,b,c,forrige;
boolean totud;
long sub2,sub,tot,krr;
real bev,eksbev;
zone z4,z5(128,1,stderror);
open(z1,4,ra,0);
o1:=readb(<:ØNSKES UDSKRIFT AF FÆLLESFORBRUG:>);
o3:=readb(<:ØNSKES UDSKRIFT AF AFD.- FORBRUG:>);
d:=readb(<:ØNSKES UDSKRIFT AF POSTER:>);
if d then
dd:=readb(<:ØNSKES POSTER FRA EN BESTEMT DATO:>);
sub2:=sub:=tot:=krr:=0;
removeentry(<:gc1out82:>);
if d then
begin
if dd then
begin
date;
a:=dato(1);
dato(1):=dato(3)*10000+dato(2)*100+a;
end;
tail(10):=tail(9):=0;
removeentry(<:gc2out82:>);
if createentry(<:gc2out82:>,tail)>0 then fejl(8);
open(z5,4,<:gc2out82:>,0);
write(z5,"ff",1,"nl",1,
<:konto år md dag ................text................ kr. indtastet:>,
"nl",1);
end;
tail(10):=tail(9):=0;
tail(1):=30;
if createentry(<:gc1out82:>,tail)>0 then fejl(7);
open(z4,4,<:gc1out82:>,0);
write(z4,"ff",1,
<:H.C. ØRSTED INSTITUTET: REGNSKABSOVERSIGT UGE:>,
uge,"nl",1,
<:ANALYSEKONTO pr. :>,<<dd dd dd>,r,"nl",1,
false add 95,76,"nl",1);
removeentry(<:gc3out82:>);
if createentry(<:gc3out82:>,tail)>0 then fejl(10);
open(z2,4,<:gc3out82:>,0);
write(z2,"ff",1,
<:H.C.ØRSTED INSTITUTET: FÆLLESAFDELINGERNES FORBRUG PR. UGE:>,
uge,<:<10>UDFÆRDIGET PR. :>,<<dd dd dd>,r,"nl",2,
<: BEVILLING EKSTRA BEVILLING IALT FORBRUG TIL REST:>,
"nl",1,false add 95,76,"nl",1);
konto:=0;
inrec(z1,16);
for i:=1 step 1 until 16 do
begin
linie(i*2):=z1(i) extract 24;
linie(i*2-1):=z1(i) shift (-24) extract 24;
end;
kontonr:=linie(1);
totud:=false;
forrige:=0;
OM:
i:=readchar(z3,char);
if char=25 then goto SLUT;
if char=10 then goto OM;
if char=99 then
begin
for i:=readchar(z3,char) while char<>10 do;
goto OM;
end;
if char=58 then
begin
real bev,eksbev;
t:=0;
i:=readchar(z3,char);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,bev);
i:=readchar(z3,char);
if i<>2 and char<>45 then fejl(9);
repeatchar(z3);
read(z3,eksbev);
repeatchar(z3);
readchar(z3,char);
if char<>32 and char<>42 then repeatchar(z3);
for i:=readchar(z3,char) while char<>10 do
begin
t:=t+1;
outchar(z2,char);
if t mod 11=0 then
begin
readchar(z3,tegn);
if tegn<>10 then
begin
t:=0; outchar(z2,10);
end;
repeatchar(z3);
end;
end;
write(z2,"sp",11-t,<< -dddddddd.dd>,bev,eksbev,
bev+eksbev,0,bev+eksbev,"nl",1);
B:=B+bev*100;
E:=E+eksbev*100;
I:=I+(bev+eksbev)*100;
R:=R+(bev+eksbev)*100;
test:
for i:=readchar(z3,tegn) while tegn=10 do;
if tegn=99 then
begin
for i:=readchar(z3,tegn) while tegn<>10 do;
goto test;
end;
if tegn<>25 then fejl(9);
goto SLUT;
end else
if char=42 or char=44 or char=59 then
begin
if forrige=42 then totud:=true;
if forrige=59 then totud:=false;
if konto>0 then
begin
j:=41;
sub2:=sub2+sub;
if totud then
tot:=tot+sub;
write(z4,"sp",43,<:-------------:>,"nl",1);
if char=44 or forrige=44 then
begin
write(z4,"sp",27,<<-dddddddd.dd>,sub2/100);
j:=j-39;
end;
write(z4,"sp",j,<< -dddddddd.dd>,sub/100);
if totud then
write(z4,<< -dddddddd.dd>,tot/100);
outchar(z4,10);
if totud and (char=59 or char=42) then
begin
F:=F+sub2;
R:=R+(bev+eksbev)*100-sub2;
write(z2,<< -dddddddd.dd>,sub2/100,(bev+eksbev)-(sub2/100),"nl",2);
end;
sub:=0;
end;
if char=42 or char=59 then
begin
sub2:=0;
i:=readchar(z3,tegn);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,bev);
i:=readchar(z3,tegn);
if i<>2 and tegn<>45 then fejl(9);
repeatchar(z3);
read(z3,eksbev);
repeatchar(z3);
end;
forrige:=char;
t:=j:=0;
readchar(z3,char);
if char<>32 and char<>42 then repeatchar(z3);
if char=42 then outchar(z4,12) else
outchar(z4,10);
for i:=readchar(z3,char) while char<>10 do
begin
if forrige=42 then
begin
t:=t+1;
outchar(z2,char);
if t mod 11=0 then
begin
readchar(z3,tegn);
if tegn<>10 then
begin
t:=0; outchar(z2,10);
end;
repeatchar(z3);
end;
end;
j:=j+1;
outchar(z4,char);
end;
if j=0 then fejl(9);
if forrige=42 then
begin
B:=B+bev*100;
E:=E+eksbev*100;
I:=I+(bev+eksbev)*100;
write(z2,"sp",11-t,<< -dddddddd.dd>,bev,eksbev,bev+eksbev);
end;
if forrige=44 then outchar(z4,10) else
write(z4,"nl",1,u,j,"nl",1);
test2:
for i:=readchar(z3,char) while char=10 do;
if char=44 then
begin
repeatchar(z3);
konto:=0;
goto OM;
end;
if char=99 then
begin
for i:=readchar(z3,tegn) while tegn<>10 do;
goto test2;
end;
repeatchar(z3);
end else
repeatchar(z3);
if i<>2 then fejl(9);
i:=readchar(z3,tegn);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,konto);
i:=readchar(z3,tegn);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,a);
i:=readchar(z3,tegn);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,b);
i:=readchar(z3,tegn);
if i<>2 then fejl(9);
repeatchar(z3);
read(z3,c);
write(z4,<<zddd>,a,<< zd>,b,<< zddddd>,c,<< zdd>,konto,"sp",2);
j:=0;
for i:=readchar(z3,char) while char<>10 do
begin
j:=j+1;
outchar(z4,char);
end;
if j=0 then fejl(9);
write(z4,"sp",22-j);
if konto<kontonr then
begin
write(z4,<< -dddddddd.dd>,0,"nl",1);
goto OM;
end;
skrivp:
if kontonr=8388600 then goto SLUT;
kr:=z1(8);
krr:=krr+kr;
if (d and -,dd) or (d and dato(1)<=linie(17)) then
begin
write(z5,"nl",1,<< zdd>,linie(1),<< zd dd dd>,linie(2),"sp",2);
for i:=1 step 1 until 12 do
begin
txt(i*3):=linie(i+2) extract 8;
txt(i*3-1):=linie(i+2) shift (-8) extract 8;
txt(i*3-2):=linie(i+2) shift (-16) extract 8;
end;
for i:=1 step 1 until 36 do
write(z5,false add txt(i),1);
write(z5,<< -dddddddd.dd>,kr/100,<< zd dd dd>,linie(17));
end;
inrec(z1,16);
for i:=1 step 1 until 16 do
begin
linie(i*2):=z1(i) extract 24;
linie(i*2-1):=z1(i) shift (-24) extract 24;
end;
if kontonr=linie(1) then goto skrivp;
kontonr:=linie(1);
write(z4,<< -dddddddd.dd>,krr/100,"nl",1);
sub:=sub+krr;
krr:=0;
goto OM;
SLUT:
if forrige=59 then totud:=false;
sub2:=sub2+sub;
write(z4,"sp",43,<:-------------:>,"nl",1);
j:=41;
if forrige=44 then
begin
write(z4,"sp",27,<<-dddddddd.dd>,sub2/100);
j:=j-39;
end;
write(z4,"sp",j,<< -dddddddd.dd>,sub/100);
if totud then
begin
write(z2,<< -dddddddd.dd>,sub2/100,(bev+eksbev)-(sub2/100),"nl",1);
tot:=tot+sub;
write(z4,<< -dddddddd.dd>,tot/100);
end;
write(z4,"nl",5,"sp",55,<< -dddddddd.dd>,tot/100,"nl",1,
"sp",57,<:=============:>,"nl",1,
"ff",1,false add 25,3);
write(z2,false add 95,76,"nl",2,<:IALT:>,"sp",7,
<< -dddddddd.dd>,B/100,E/100,I/100,F/100,R/100);
write(z2,"ff",1,false add 25,3);
close(z2,true);
if o1 then
begin
j:=10000;
psubmit(z2);
write(out,<:gc3out82 job nr :>,j,"nl",1);
end;
if d then
begin
write(z5,"ff",1,false add 25,3);
close(z5,true);
j:=10000;
psubmit(z5);
write(out,<:gc2out82 job nr :>,j,"nl",1);
end;
close(z4,true);
if o3 then
begin
j:=10000;
psubmit(z4);
write(out,<:gc1out82 job nr :>,j);
end;
close(z1,true);
goto udskrift;
end;
removeentry(<:gcrgn82:>);
tail(10):=if ret or nypris then tail(10) else 0;
changetail(ra,tail);
write(out,<:<10>årstal=:>,
tail(9),<: hvis intet andet er opgivet i indata<10>:>);
tail(1):=tail(1)+25;
if -,ret and -,nypris then
begin
if createentry(<:gcrgn82:>,tail)>0 then fejl(5);
scopeuser(<:gcrgn82:>);
open(z2,4,<:gcrgn82:>,0);
end;
omm:
date;
kontonummer;
if ret then rettelse;
if nypris then
begin
pris;
prisret;
end;
tekst;
pris;
linie(1) := kontonr;
linie(2):=dato(3)*10000+dato(2)*100+dato(1);
linie(17):=r;
write(out,"nl",1,
<:konto dag md år ...............tekst................ kr.:>,
"nl",1,
<< zdd>,linie(1),"sp",2,
<< zd>,dato(1),dato(2),dato(3),"sp",2);
for i := 1 step 1 until 36 do
write(out,false add txt(i),1);
write(out,<<-dddddddd.dd>,kr/100);
om:
write(out,<:<10>>:>);
setposition(out,0,0);
læsnl;
for i:=readchar(in,tegn) while tegn=32 do;
læsnl;
if tegn=10 and nypris then goto omm;
if tegn=115 and nypris then goto udskrift;
if tegn=114 or (tegn=10 and ret) then goto omm;
if tegn=115 and ret then goto udskrift;
if fault and tegn=10 then goto omm;
if (tegn<>115 and tegn<>10) then
begin
write(out,<:her kan kun tastes::>,
<:<10>r(nl) (rettelse af post):>,
<:<10>s(nl) (slut):>,
<:<10>(nl) (næste post):>);
goto om;
end;
if -,fault then
begin
for i := 1 step 1 until 16 do
skift(i) := 0.0 shift 24 add linie(2*i-1) shift 24 add linie(2*i);
p:=p+1;
outrec(z2,16);
for i:=1 step 1 until 16 do
z2(i):=skift(i);
z2(8):=kr;
tail(10):=p;
changetail(<:gcrgn82:>,tail);
postud(z2);
if p=200 and tegn=10 then
begin
write(out,<:de 200 indtastede poster flettes nu med inputarealet:>,
<:kald programmet igen til de næste poster:>);
tegn:=0;
end;
if tegn=10 then
goto omm;
end;
AFSLUT:
if ret then goto udskrift;
open(z1,4,ra,0);
for j:=inrec(z1,16) while
z1(1) shift (-24) extract 24<8388600,1 do
begin
outrec(z2,16);
for i:=1 step 1 until 16 do
z2(i):=z1(i);
p:=p+1;
end;
close(z1,true); close(z2,true);
sort(<:gcrgn82:>,p,64,ia);
tail(1):=(p-1)//8+1; tail(10):=p-1;
changetail(<:gcrgn82:>,tail);
removeentry(ra);
renameentry(<:gcrgn82:>,ra);
udskrift:
close(z3,true);
end;
▶EOF◀