|
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: 4608 (0x1200)
Types: TextFile
Names: »listerrortx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦baac87bee⟧ »gi«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦baac87bee⟧ »gi«
└─⟦this⟧
comment listerrortx * page 1 27 04 79, 9.19
0 1 2 3 4 5 6 7 8 9 ;
begin
comment
Listerror er et program, som kan liste vilkårlige linier fra
en algol kildetekst (program eller extern procedure).
Sammen med linierne listes også de tilsvarende boss - og algol -
numre.
Kald af program:
----------------
_ 1 50
listerror (in.<input_file name>) lines(.<algol_nbr>)
_ 1 1
Eks. listerror in.readmaptx lines.45.46.57.68.101
Fra <readmaptx> listes nu teksten fra ovenstående linier samt
disse liniers samhørende boss- og algolnumre.
Programmør Erik Hansen, Topografisk Afdeling 22-01-79 ;
integer t, val, nbr, algol_nr, int, pointer, boss_nr;
integer array write_line, kind(1:50), table(0:127);
real array param, aktion(1:2);
long array input_file(1:2), la(1:50);
zone zn(128*2, 2, stderror);
boolean continue, ok;
continue := true;
algol_nr := 1;
pointer := 1;
boss_nr := 0;
nbr := 0;
val := 0;
\f
comment listerrortx * page 2 27 04 79, 9.19
0 1 2 3 4 5 6 7 8 9 ;
<******** R E A D F P - P A R A M ********>
for int := read_param(param) while int <> 0 do
case int + 2 of
begin
val := write(out, nl, 1,
<:***list<95>error FP-syntax, outputfile not allowed:>);
<* end of parameter list *> ;
<* <space><integer> *>
val := write(out, nl, 1,
<:***list<95>error FP-syntax, :>, round param(1));
<* <space><text> *>
to_from(aktion, param, 8);
<* .<integer> *>
if aktion(1) shift (-24) shift 24 = real<:lin:> then
begin
nbr := nbr + 1;
write_line(nbr) := round param(1);
end else
val := write(out, nl, 1, <:***list<95>error FP-syntax, :>,
string pump(aktion), <:.:>, round param(1));
<* .<text> *>
if aktion(1) shift (-32) shift 32 = real<:in:> then
to_from(input_file, param, 8) else
val := write(out, nl, 1, <:***list<95>error FP-syntax, :>,
string pump(aktion), <:.:>, string pump(param));
end; <******* R E A D F P - P A R A M ********>
if val <> 0 then
system(9, 0*write(out, nl, 1,
<:***list<95>error FP-problems:>), <:<10>stopped:>);
la(1) := longzero; <* ==> scope(1) := longzero *>
val := lookup_proc(la, input_file, kind <* tail *> );
if val <> 0 then
system(9, 0*write(out, nl, 1,
<:***list<95>error, input<95>file problems:>, nl, 1,
<:lookup<95>proc = :>, <<dd>, val), <:<10>stopped:>) else
open(zn, 4, inputfile, 0);
while continue do
begin
int := read_all(zn, la, kind, 1);
boss_nr := boss_nr + 10;
for t:=1 step 1 until int do
if la(t) = long<:begin:> or
_ la(t) shift (-8) shift 8 = long<:exter:> then
continue := false;
end;
\f
comment listerrortx * page 3 27 04 79, 9.19
0 1 2 3 4 5 6 7 8 9 ;
<* redefinering af alfabetet *>
stdtable(table);
for int:=32 step 1 until 125 do
table(int) := 6 shift 12 + int;
table(10) := 8 shift 12 + 0;
intable(table);
continue := true;
while continue do
begin
int := read_all(zn, la, kind, 1);
boss_nr := boss_nr + 10;
ok := false;
if t > 1 then
for t:=1, t+1 while t<=(int-1) and -, ok do
for val:=-40 step 8 until 0 do
if la(t) shift val extract 8 <> 32 and
_ la(t) shift val extract 8 <> 0 and
_ la(t) shift val extract 8 <> 95 then ok := true;
if la(int) = 12 <* ff *> then
boss_nr := ((((boss_nr//1000) + 1) * 1000) - 10) else
if ok then algol_nr := algol_nr + 1;
if write_line(pointer) = algol_nr then
begin
write(out, nl, 1, <<ddddd>, boss_nr, <<ddddd>, algol_nr,
_ sp, 1, la);
pointer := pointer + 1;
end;
if pointer > nbr then continue := false;
readchar(zn, val);
if val = 25 then continue := false else
repeatchar(zn);
end;
close(zn, true);
end;
▶EOF◀