|
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: 9984 (0x2700)
Types: TextFile
Names: »readgeottx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦bf33d74f6⟧ »iogeofile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦bf33d74f6⟧ »iogeofile«
└─⟦this⟧
; read_geo_t_tx * page 1 22 05 78, 14.33;
; read_geo_t
; **********
if listing.yes
char 10 12 10
read_geo_t=set 1 disc
read_geo_t = algol
external long procedure read_geo_t
__________________________________
_ (kind, z, typedec);
value kind;
zone z;
boolean typedec;
integer kind;
comment
read geo t (return) long
the value of the input. angles are mult by max long/pi.
distances are in units of '- 6 m. max dec are defaulted
kind (call) integer
the type of the input
1 = geotype
2 = station number
3 = simple number
4 = timedate or cmt word
5 = simple number
the termination m_ will always switch to kind=1 except for kind=5
z (call and return) zone
the zone used for char input and buffering
typedec (return) boolean
descriptor of the input
kind =1 : (type shift 6) + number of decimals input
nr type termnt max dec
1 degr min sec sexagesimal sx 6
2 degr min sexagesimal nt 8
3 degr nonagesimal dg 10
4 hours min sec tm 6
5 degr min sec centesimal cc 6
6 degr min centesimal eu 8
7 degr centesimal (grads) gr 10
8 meters (>=1000 km) m_ 6
9 meters (>=1 km and <1000 km) m_ 6
10 meters (< 1km) m_ 6
type 9 and 10 are recorded at input as type 8.
the user may change the type after input;
\f
comment read_geo_t_tx * page 2 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
comment
kind = 2 : type packed as a short integer
nr type
1 landsnummer
2 station number
2 negative number
3 neg number term by x
4 neg number term by z
5 neg number term by anything else incl decpt.
>=8 shift 6 geotype, mtr=true
kind = 3 : decimals packed as a short integer
kind = 4 : true when do (=ditto) is read instead of a number
kind = 5 : decimals packed as a short integer
own variables used by read_geo_t
________________________________
tchar (return) integer
the value of the terminator char.
in_class (call and return) integer
return_value the class of the terminator char.
udt (call) integer
the terminator def. for kind=1, when illegal termination is met.
a system alarm is generated if udt is not a legal terminator
mtr (return) boolean
mtr is false except when the terminator m is input
not_eof (return) boolean
not_eof is true except when em is input
read_status (call and return) integer
read_status >= 0 : number errors give system9 alarm
read_status bit 0:0 = 1 : number errors are counted in
_ the 22 last bits of read_status
read_status bit 0:1 = 3 : number errors are counted and
_ report on number on curr. output;
\f
comment read_geo_t_tx * page 3 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
comment
_ decision table for input, kind = 1, 3, 4, 5
_____ 1 2 3 4 5 6 7 8 9
state start after after after after after after after after
_____ sign point si+sp pt+sp digit dg+pt dg+sp d+p+sp
class action/next state
2 digit 1/6 1/6 1/7 1/6 1/7 1/6 1/7 1/6 1/7
3 sign 2/2 2/2 2/2 2/2 2/2 5/11 5/11 5/11 5/11
4 point 3/3 3/3 2/3 3/3 2/3 3/7 5/11 3/7 5/11
5 space 5/1 5/4 5/5 2/1 2/1 5/8 5/9 5/10 5/10
6 others 4/1 4/1 4/1 4/1 4/1 4/10 4/10 4/10 4/10
state 10 => normal exit
state 11 => exit after syntax error
action nr
incl dig 1
rec sign 2 (incl del point rec)
rec point 3
char test 4
no action 5
input class numbers are decreased by 2 before being used;
\f
comment read_geo_t_tx * page 4 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
begin
long number;
integer nr_type, char, last_char, digits, dec,
_ class, state, action, index, p, r, t;
boolean cont, neg, decpt, dochar, too_many_digits;
_
prvers := 22 05 78 14 33;
if kind < 1 or kind > 5 then
system(9)alarm_exit:(kind, <:<10>geokind:>);
digits :=
dec :=
char :=
class := 0;
state := if noteof then 1 else 10;
number := 0;
too_many_digits :=
decpt :=
neg :=
dochar := false;
\f
comment read_geo_t_tx * page 5 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
if kind <> 2 then
begin
for last_char := char while state <= 9 do
begin comment reader loop;
class := read_char(z, char);
index := case class-1 of
(0, 1, 2, 4, 4, if char<>32 then 4 else 3, 4) * 9 + state;
action := case index of (
<* kind = 1, 3, 4, or 5 *>
_ 1, 1, 1, 1, 1, 1, 1, 1, 1,
_ 2, 2, 2, 2, 2, 5, 5, 5, 5,
_ 3, 3, 2, 3, 2, 3, 5, 3, 5,
_ 5, 5, 5, 2, 2, 5, 5, 5, 5,
_ 4, 4, 4, 4, 4, 4, 4, 4, 4);
state := case index of (
<* kind = 1, 3, 4 or 5 *>
_ 6, 6, 7, 6, 7, 6, 7, 6, 7,
_ 2, 2, 2, 2, 2, 11, 11, 11, 11,
_ 3, 3, 3, 3, 3, 7, 11, 7, 11,
_ 1, 4, 5, 1, 1, 8, 9, 10, 10,
_ 1, 1, 1, 1, 1, 10, 10, 10, 10);
comment test_output on
if em then
write(out, nl, 0, <:ch, cl, ix, ac, st:>,
_ char, class, index, action, state);
\f
comment read_geo_t_tx * page 6 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
case action of
begin
if digits <= 13 then
begin comment case 1, incl digits;
action1:
number := (((number shift 2) + number) shift 1)
+ char - 48;
digits := digits+1; if decpt then dec := dec+1;
end case 1
else too_many_digits := true;
begin comment case 2, sign;
neg := char = 45;
dec_pt := char = 46;
end case 2;
comment case 3, decpoint;
dec_pt := true;
begin comment case 4, char test;
case class-4 of
begin
comment sp, no action; ;
if kind=4 then
begin comment test do;
dochar := last_char=100 and char=111;
if dochar then state := 10;
end;
begin comment test * ;
if char = 42 then
_ for t := char while char<>59 and char<>25 do
_ _ class := read_char(z, char);
not_eof := char <> 25;
end;
comment test em; not_eof := char <> 25;
end;
if -, noteof then state := 10 else
if state = 1 then
decpt :=
neg := false;
end case 4, char test;
comment case 5, no action; ;
end cases;
comment test_output on
if em then write(out, <<-dd>, nr_type, state, nl, 1);
end reader loop;
\f
comment read_geo_t_tx * page 7 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
mtr := char = 109;
if kind = 5 then kind := 3
else
if mtr then kind := 1;
last_char := char;
if digits > 0 or do_char then
begin
case kind of
begin
begin comment kind=1, geotype;
if too_many_digits then
write(out, nl, 1, <:* +++ too many digits :>, number,
_ <:, term. : :>, char, <: = :>, false add char, 1,
_ <: ;<10>:>);
for r := 0, r+1 while r=1 do
begin
if r=1 then char := udt;
for t := 1 step 1 until 8 do
if char=(case t of
<* s, n, d, t, c, e, g, m *>
(115, 110, 100, 116, 99, 101, 103, 109)) then
begin
typedec := ((false add t) shift 6) add dec;
if neg then number := -number;
number := conv_t_geo(number, type_dec);
t := r := 100;
end known or defaulted terminator;
if r = 1 then
begin
comment emergency for undefined terminator;
if read_status >= 0 then
system(9, last_char, <:<10>imp_term:>)
else
begin
if read_status shift 1 < 0 then
write(out, nl, 1, <:* impossible term., nmb= :>,
number, <:, _term_=_:>, last_char, <:_=_:>,
false add last_char, 1, <: ;<10>:>);
read_status := read_status + 1;
end;
end;
mtr := char = 109;
end r-loop;
end geotype;
\f
comment read_geo_t_tx * page 8 22 05 78, 14.33
0 1 2 3 4 5 6 7 8 9 ;
comment kind=2 is placed last in procedure; ;
begin comment kind=3 or 5, simple number or st reading;
if neg then number := - number;
typedec := false add dec;
end;
begin comment kind=4, cmt or time date;
if neg then number := -number;
typedec := dochar;
if dochar then read_char(z, last_char);
end;
end kind cases;
end
else
begin
type_dec := false;
class := 8;
last_char := 25;
end;
read_geo_t := number;
t_char := last_char;
in_class := class;
repeat_char(z);
end
else
begin comment kind=2;
read_geo_t := read_nmb(z, nr_type);
type_dec := false add nr_type;
end;
end read_geo_t;
end
if warning.yes
(mode 0.yes
message read_geo_t not ok
lookup read_geo_t)
end
finis
▶EOF◀