|
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: 25344 (0x6300)
Types: TextFile
Names: »readnmbtx«
└─⟦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_nmb_tx * page 1 1 08 79, 13.01;
; read_nmb
; ********
if listing.yes
char 10 12 10
read_nmb=set 1 disc
readnmb=algol
external long procedure read_nmb
________________________________
_ (z, numbertype);
zone z;
integer numbertype;
comment
read_nmb (return, long) the landsnummer or station number
_ input. the value 200 00 0000
_ is added to station numbers. K is
_ totally neglected. old landsnummer
_ notation (without - ) is recognized
_ and transformed correctly provided
_ only 3 digits are used in the løbenr
_ negative numbers are not transformed,
_ but their occurrence is reflected in
_ the value of numbertype. the termi-
_ nator m switches positive numbers to
_ geotype with the typedec packed in
_ numbertype and with mtr=true.
_ Station number (numbertype=2) may be
_ terminated by a capital letter A to H,
_ P, N, S, X, Ø, V.
_ bit 0 : binary zero.
_ bit 1-28 : the main number
_ bit 29-35 : suffix capital, point, K, or all zeroes
_ bit 36-47 : suffix number, used for point and K only
_ an ordinary stationsnummer has all zeroes in bits 29-47.
z (call and return, zone) open for char input
numbertype (return, integer) the type of the number input
_ 1 : landsnummmer (ddd-dd-dddd)
_ 2 : station number
_ 3 : neg number term by x
_ 4 : neg number term by z
_ 5 : neg nmb term by anything else
_ inclusive dec_point.
_ >=8 shift 6 : geotype (mtr=true)
Packing of Photonmb Modelnmb G.I./G.M. nmb
bit 0 : binary zero
bit 1-11 : first nmb ) ( main nmb
bit 12-16 : char extract 6 )( main nmb ) ( +
bit 17-28 : second nmb ) ( 200 00 0000
bit 29-35 : 1 77<*M*> 76<*L*>
bit 36-47 : suffix number
Suffix number packing for G.I./G.M. intermedium nmb ex. G.M.27/28
bit 36 : = 1 (else = 0)
bit 37-41 : numberdiff = lastnmb - firstnmb ( >0 )
bit 42-47 : decpoint suffix
EM is recorded as : -1 z not_eof = true
;
\f
comment read_nmb_tx * page 2 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
begin
boolean tpd, dec_pt, neg, niv,
_ model, photo1, photo2, kalot, lnr;
integer action, state, pt_val, sg_val, sp_val,
_ max_suffix, digits, lnr_state, niv_state,
_ Cap, div, r, char, class, nivcase;
long number, saved_number, h_nr, s_nr, p_nr, dec_number,
_ niv_nmb, route, picture;
comment syntax of legal numbers :
landsnummer ::= (( ddd-dd-dddd * ddd_dd_ddd )_<term_1>)
_ * ( ddd-dd-_<CAPITAL><term_3>)
station number ::= <ordenary stnmb> * <photo nmb> * <model nmb>
_ * <niv nmb>
neg number ::= -dddddddddd<term_4>
<ordinary stnmb> ::= ddddd<term_2>
<photo nmb> ::= Pddd<letter>ddd<term_3>
<model nmb> ::= Mddd<term_3>
<niv nmb> ::= <pro>dddd(/dddd * <empty>)<term_3>
<pro> ::= G.I.*G.M.*F.K.*K.K.
<term_1> ::= <small letter> * <a class 8 char> * <a class 7 char>
<term_2> ::= ( _K_dd * .dddd * _<CAPITAL> * <empty> ) _<term_1>
<term_3> ::= ( .dddd * <empty> ) _<term_1>
<term_4> ::= ( .dddddd * <empty> )_< any char not digit >
<CAPITAL> ::= A*B*C*D*E*F*G*H*I*J*P*N*S*X*Ø*V
d is a digit
NB NB NB
in <photo nmb> <model nmb> and <niv nmb> is space a TERMINATOR
then a number as G.I.24 2 will give the alarm :
* illegal nmb term G.I.242 , term = 50
NB NB NB
<ordinary nmb> where <term_2> == ( .dddd * <empty>) _m
_ is converted to geotype meters.
negative numbers where <term_4> == _m or .d_m are converted
_
negative numbers where <term_4> == .d_< char not m >
_ the digits after point are skipped
_ *******
<photo nmb> ) (
<model nmb> ) ( spaces are illegals or terminators
<niv nmb> ) (
prog. K. Engsager, K. Poder jan.78
_ K. Engsager mar.79 july.79
;
\f
comment read_nmb_tx * page 3 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
comment decision table for input :
----- 1 2 3 4 5 6
class digit sign decpoint space other illegal
-----
state action/next state
0 init 1/5 2/1 3/3 4/0 6/0 8/10
1 after sign 1/5 2/1 3/3 4/2 6/0 8/10
2 after sign+space 1/5 2/1 3/3 2/0 6/0 8/10
3 after point 1/5 2/1 2/3 4/4 6/0 8/10
4 after point+sp 1/7 2/1 2/3 2/0 6/0 8/10
5 after digit 1/5 5/5 3/7 4/6 7/10 8/10
6 after digit+sp 1/5 5/5 3/7 7/10 7/10 8/10
7 after digit+pt 1/7 8/10 8/10 4/8 7/10 8/10
8 after dig+pt+sp 1/8 8/10 8/10 7/10 7/10 8/10
actions
-------
include digit 1
record sign 2
record point 3
no action 4
test lnr 5
init test 6
stop test 7
alarm 8
;
\f
comment read_nmb_tx * page 4 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
procedure illegal_term;
begin
if read_status >= 0 then
_ system(9)alarm_exit:(round number, <:<10>ilg.term:>)
else
begin
if read_status shift 1 < 0 then
begin
write(out, nl, 1, <:* illegal nmb term :>);
class := if photo1 or photo2 then 1
_ else if model then 2
_ else if niv then 3
_ else 4;
if class<=3 then write(out,
_ case class of (<:P:>, <:M:>,
_ _ (case niv_case of (<:G.I.:>, <:F.K.:>, <:K.K.:>))));
class := case class of
( if photo1 then 1 else 2,
_ 1,
_ if niv_state=1 then 1 else 6,
_ if kalot then 1 else
_ if lnr_state=2 then 3 else
_ if lnr_state=3 then 4 else
_ if lnr_state=4 then 5 else 1);
case class of
begin
write(out, <<d>, number);
begin
write(out, <<d>, p_nr shift(-17),
_ false add (((p_nr shift(-12)) extract 5)+64), 1);
if number extract 12 > 0 then
_ write(out, <<d>, number extract 12);
end;
begin
write(out, <<d>, h_nr//100_0000, <:-:>);
if digits>0 then write(out, <<d>, number);
end;
begin
if h_nr = 0 then write(out, <:K:>) else
_ write(out, <<d>, h_nr // 100_0000);
write(out, <<d>, <:-:>, s_nr//10000, <:-:>);
if digits>0 then write(out, <<d>, number mod 10000);
end;
begin
if h_nr=0 then write(out, <:K:>) else
_ write(out, h_nr // 100_0000);
write(out, <<d>, <:-:>, s_nr // 10000, <:-:>,
_ false add Cap, 1);
end;
\f
<* read_nmb_tx * page 5 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
begin
write(out, <<d>, niv_nmb, <:/:>);
if digits>0 then write(out, <<d>, number);
end;
end cases;
if dec_pt or kalot then
begin
write(out, if dec_pt then <:.:> else <:K:>);
if digits>0 then write(out, <<d>, dec_number);
end;
write(out, false add char, 1, <: , term = :>, char,
_ <: ;<10>:>);
end;
lnr :=
model :=
photo2 :=
niv :=
neg :=
dec_pt := false;
digits := 5;
number := 99 999;
Cap := 99 <* X *>;
read_status := read_status + 1;
end;
end illegal_term;
procedure read_semi;
begin
for r := char while char<>59 <*;*> and char<>25 <*em*> do
_ class := read_char(z, char);
if char = 25 then repeat_char(z);
end;
procedure read_semi_1;
begin
for class := read_char(z, char) while char<>59 and not_eof do
_ not_eof := char <> 25;
if -, not_eof then repeat_char(z);
end;
pr_vers := 1;
\f
comment read_nmb_tx * page 6 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
if not_eof then
begin
model :=
photo1 :=
photo2 :=
kalot :=
lnr :=
niv :=
mtr :=
neg :=
dec_pt := false;
Cap :=
digits :=
state := 0;
sg_val := 2;
pt_val := 3;
sp_val := 4;
niv_state :=
lnr_state := 1;
max_suffix := 4095;
dec_number :=
saved_number :=
number := 0;
while state <= 9 do
begin
in_class := read_char(z, char);
class := case (in_class-1) of
(1, sg_val, pt_val, 5, 5, if char=32 then sp_val else 5, 5);
action := case (6*state + class) of (
<*input cl: dig sgn pnt sp other ill*>
<*state*>
<*0=init *> 1, 2, 3, 4, 6, 8,
<*1=sign *> 1, 2, 3, 4, 6, 8,
<*2=sg +sp*> 1, 2, 3, 2, 6, 8,
<*3=pnt *> 1, 2, 2, 4, 6, 8,
<*4=pnt+sp*> 1, 2, 2, 2, 6, 8,
<*5=digit *> 1, 5, 3, 4, 7, 8,
<*6=dig+sp*> 1, 5, 3, 7, 7, 8,
<*7=dig+pt*> 1, 8, 8, 4, 7, 8,
<*8=d+p+sp*> 1, 8, 8, 7, 7, 8);
state := case (6*state + class) of (
<*0=init *> 5, 1, 3, 0, 0, 10,
<*1=sign *> 5, 1, 3, 2, 0, 10,
<*2=sg +sp*> 5, 1, 3, 0, 0, 10,
<*3=pnt *> 5, 1, 3, 4, 0, 10,
<*4=pnt+sp*> 7, 1, 3, 0, 0, 10,
<*5=digit *> 5, 5, 7, 6, 10, 10,
<*6=dig+sp*> 5, 5, 7, 10, 10, 10,
<*7=dig+pt*> 7, 10, 10, 8, 10, 10,
<*8=d+p+sp*> 8, 10, 10, 10, 10, 10);
comment TEST_OUTPUT ON if ff then
write(out, <:in cl ch ac st:>, << ddd>,
in_class, class, char, action, state, nl, 1);
\f
comment read_nmb_tx * page 7 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
case action of
begin
begin comment action 1 : include digit;
number := ((number shift 2) + number) shift 1
_ + char - 48;
digits := digits + 1;
end;
begin comment case 2, sign;
neg := char = 45;
dec_pt := char = 46;
end;
begin comment case 3, decpoint;
dec_pt := true;
saved_number := number;
number := 0;
digits := 0;
end;
comment case 4, no action; ;
begin comment case 5, test lnr;
case lnr_state of
begin
<* state 1 *>
begin
pt_val := 6;
if -, neg then
h_nr := 100 0000 * number
else
begin
lnr_state := 2;
h_nr := 0;
s_nr := 10 000 * number;
end;
end;
<* state 2 *>
begin
sg_val := 6;
s_nr := 10 000 * number;
end;
end lnr_states;
lnr_state := lnr_state + 1;
digits := 0;
number := 0;
end test lnr;
\f
comment read_nmb_tx * page 8 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
begin comment test init char;
case in_class - 4 of
begin
comment class 5, exp-mark;
;
begin comment class 6, letters;
if char = 70 or char = 71 or char = 75 <*F G K*> then
<*look for G.I. or G.M. or F.K. or K.K.*>
begin
action := if char = 71 then 1 else 2;
niv_case := if char = 75 then 3 else action;
class := read_char(z, char);
if char = 46 <*.*> then
begin
class := read_char(z, char);
if char = (case action of (73 <*I*>, 75 <*K*>))
or char = (case action of (77 <*M*>, 75 <*K*>)) then
begin
class := read_char(z, char);
if char = 46 <*.*> then
begin
niv := read_char(z, char) = 2;
if niv then
begin
niv_nmb := 0;
state := 5;
sg_val := 6;
sp_val := 5;
end;
end;
end;
end;
repeat_char(z);
end GI_or_GM
else
if char = 77 <*M*> then
begin
model := read_char(z, char) = 2;
if model then
begin
state := 5;
sg_val := 6;
sp_val := 5;
end;
repeat_char(z);
end
else
\f
<* read_nmb_tx * page 9 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
if char = 80 <*P*> then
begin
photo1 := read_char(z, char) = 2;
if photo1 then
begin
state := 5;
sg_val :=
pt_val :=
sp_val := 6;
end;
repeat_char(z);
end photo;
neg :=
dec_pt := false;
end letter case;
comment graphic;
if char = 42 <* * *> then read_semi;
comment case em;
if char = 25 <* em *> then
begin
digits := 1;
neg := true;
number := 1;
char := 122 <*z*>;
not_eof := false;
state := 10;
write(out, nl, 2, <:end medium generated:>, nl, 2);
end;
end test cases;
end test init char;
_
begin comment case 7, test stop char;
if dec_pt then
begin
dec_number := number;
number := saved_number;
end;
\f
comment read_nmb_tx * page 10 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
if char <> 42 then
begin
if inclass > 5
and (lnr_state=1 or lnr_state=3 or lnr_state=4) then
begin
class := if lnr_state = 3
_ and digits > 0 then 1
_ else if photo1 then 2
_ else if photo2 then 3
_ else if model then 4
_ else if niv then 5
_ else if kalot then 9
_ else if lnr_state = 4
_ or (lnr_state = 3 and digits = 0)
_ then 10
_ else if number>99_999 and -, dec_pt and -, neg
_ and char<>109 <*m*> then 1
_ else inclass;
comment TEST ON if ff then
write(out, <:cl, lnrst, dig:>, class, lnrstate, digits, nl, 1);
comment TEST OFF;
case class of
begin
begin comment lnr;
if lnr_state=1 then
number := 10000 * (number // 1000) + number mod 1000
else
begin
neg := false;
number := h_nr + s_nr + number;
end;
if (in_class=6 and char<97) or
_ 200_00_0000 + 100_0000 <= number then illegal_term;
if 200_00_0000 < number then
number := number - 200_00_0000;
lnr:= true;
end;
if in_class = 6 then
begin comment photo1;
photo1 := false;
photo2 := true;
if number < 2048 then route := 0
else
begin
route := number;
number := 2047;
end;
p_nr := ((number shift 5) add (char extract 5))
_ shift 12;
digits := 0;
number := 0;
state := 5;
pt_val := 3;
sp_val := 5;
end
else illegal_term;
\f
comment read_nmb_tx * page 11 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 ;
begin comment photo2;
if char=32 then inclass := read_char(z, char);
if (in_class=6 and char<97)
or in_class<5 then illegal_term;
if number < 4096 then picture := 0
else
begin
picture := number;
number := 4095;
end;
number := p_nr + number;
Cap := 1;
end;
begin comment model;
if char = 32 then in_class := readchar(z, char);
if (in_class=6 and char<97)
or in_class<5 then illegal_term;
Cap := 77 <*M*>;
end;
begin comment GI_or_GM_or_FKor_KK;
if char = 47 and nivstate = 1 then
begin
niv_nmb := number;
number := 0;
digits := 0;
state := 5;
niv_state := 2;
end
else
begin
if niv_state = 2 then
begin
number := number - niv_nmb;
if number > 31 then number := 31;
if number < 0 then number := 0;
if dec_number > 63 then dec_number := 63;
dec_number := 1 shift 11
+ number shift 6
+ dec_number;
number := niv_nmb;
end
else
if dec_number > 2047 then dec_number := 2047;
if char=32 then in_class := read_char(z, char);
if (in_class=6 and char<97)
or in_class<5 then illegal_term;
end;
Cap := case nivcase of (76 <*L*>, 2, 3);
end;
\f
<* read_nmb_tx * page 12 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
begin comment nr terminated by character;
if char = 109 <* m *> then
begin
mtr := true;
if dec_pt then
begin
for r := 1 step 1 until digits do
_ number := ((number shift 2) +
_ number) shift 1;
end
else
digits := 0;
number_type := 8 shift 6 add digits;
tpd := false add number_type;
number := number + dec_number;
if neg then number := - number;
read_nmb := conv_t_geo(number, tpd);
neg := false;
digits := 6;
end
else
if -, neg then
begin
if dec_pt then
begin
if char < 97 <* a *> then illegal_term;
end
else
if char = 75 <* K *> then
begin
kalot := true;
saved_number := number;
number := 0;
state := 5;
sg_val :=
pt_val := 6;
Cap := 75;
max_suffix := 99;
end
else
if (65<=char and char <=74 <* A..J *> )
or char=80 or char=86 <* P V *>
or char=78 or char=83 <* N S *>
or char=88 or char=92 <* X Ø *> then
begin
Cap := char;
in_class := read_char(z, char);
if char = 42 <* * *> then read_semi_1;
if char = 32 <* sp *> then
begin
class := read_char(z, char);
if char = 42 then read_semi_1;
end;
not_eof := char <> 25 and not_eof;
if (in_class=6 and char<97)
or in_class<5 then illegal_term;
end
else
if char < 97 <* a *> then illegal_term;
end -, neg;
end;
\f
<* read_nmb_tx * page 13 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
comment nr term grafic, no action;
;
comment nr term nl/ff/em;
;
begin comment kalot;
dec_number := number;
number := saved_number;
if char<97 <*a*> and in_class=6 then illegal_term;
end;
if lnr_state = 4
or ((65<=char and char<=74 <* A..J *> )
or char=80 or char=86 <* P V *>
or char=78 or char=83 <* N S *>
or char=88 or char=92 <* X Ø *>) then
begin comment spec lnr_nivcase hnr-snr-<CAPITAL>;
comment this case is rather clumsy.
It would be natural to search Cap or decimal
under main actin 5 : test lnr -
but this lnr_nivcase is rather seldom;
if lnr_state = 3 then
begin
neg := false;
number := h_nr + s_nr;
Cap := char;
in_class := read_char(z, char);
end;
if char = 46 <*decpoint*> and lnr_state = 3 then
begin
repeatchar(z);
pt_val := 3;
sg_val := 6;
state := 5;
end
else
begin
if char = 42 <* * *> then read_semi_1;
if char = 32 <* sp *> then
begin
in_class := read_char(z, char);
if char = 42 <* * *> then read_semi_1;
end;
not_eof := char <> 25 and not_eof;
lnr_state := 4 <* to propper ill.act.*>;
if (in_class = 6 and char < 97)
or in_class < 5 then illegal_term;
digits := 1;
end;
lnr := true;
lnr_state := 4;
end
else illegal_term;
end term cases;
\f
<* read_nmb_tx * page 14 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
end
else
illegal_term;
end
else
begin
readsemi;
if not_eof then state := 5;
end;
end test stop char;
begin comment case 8, illegal_term;
if dec_pt or kalot then
begin
dec_number := number;
number := saved_number;
end;
illegal_term;
end;
end cases;
comment TEST_OUTPUT ON
if ff then
write(out, <:st, kind, cl :>, <<dd>, state, sp, 2,
_ if photo1 then <:P1:> else
_ if photo2 then <:P2:> else
_ if model then <:M:> else
_ if niv then
_ (case niv_state of (<:G.I.:>, <:F.K:>, <:K.K.:>)) else
_ if lnr_state>1 then <:lnr:> else
_ if kalot then <:kalot:> else <:nr:>,
_ class, nl, 1);
end state <= 9;
if digits = 0 then illegal_term;
if neg then
begin
read_nmb := - number;
number_type := if char = 120 then 3 <* x *>
_ else if char = 122 then 4 <* z *>
_ else 5 <* anything *>;
end
else
if -, mtr then
begin
number_type := if lnr then 1 else 2;
if -, (lnr or model or photo2) then
_ number := 200_00_0000 + number;
if Cap=0 and dec_pt then Cap := 46;
Cap := Cap shift 12;
r := if dec_number > max_suffix then max_suffix
_ else dec_number;
read_nmb := (number shift 19) add Cap add r;
end;
repeat_char(z);
t_char := char;
if route+picture > 0 and photo2 then
begin
write(out, nl, 2, <:***P:>, <<zdd>,
if route > 0 then route else (number shift (-17)),
false add (((number shift (-12)) extract 5) + 64), 1,
if picture > 0 then picture else number extract 12);
if r > 0 then write(out, <:.:>, <<d>, r);
write(out, <: --> :>);
write_stn(out, number shift 19 add Cap add r);
write(out, <: ; :>, nl, 1);
end;
end
else
\f
<* read_nmb_tx * page 15 1 08 79, 13.01
0 1 2 3 4 5 6 7 8 9 *>
begin <* EM read earlier, i.e. not_eof == false *>
_ <* simulate -1 z *>
read_nmb := -1;
t_char := 122 <* z *>;
number_type := 4;
write(out, nl, 2, <:file empty:>, nl, 2);
end;
end read_nmb;
end;
if warning.yes
( mode 0.yes
message read_nmb not ok
lookup read_nmb)
end
finis
▶EOF◀