|
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: 9216 (0x2400)
Types: TextFile
Names: »writestntx«
└─⟦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⟧
; write_stn_tx * page 1 29 03 79, 9.34;
; write_stn
; *********
if listing.yes
char 10 12 10
write_stn = set 1 disc
write_stn = algol
external integer procedure write_stn
____________________________________
_ (z, nr);
value nr;
zone z;
long nr;
comment
write_stn (return) integer
the number of characters output by the procedure (always 11)
z (call and return) zone
the zone used for buffering of output. must be open and ready
for char output.
nr (call) long
the station number output by the procedure. the number may
be a landsnummer or a stationsnummer or a negative number.
the procedure distinguishes between the two first by means of
their value, a number less than 200 00 0000 being a landsnummer.
a stationsnummer may have a suffix, either a point and a number
less than 4095, or a K and a number less than 100 , or one of the
capitals A to H, P, N, S, Ø, V, but the procedure will output any
capital suffix. Negative numbers are output without any trans-
formation. a stationsnummer is stored as follows:
bit 0 : binary zero
bit 1-28 : the main landsnummer
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
prog. K. Engsager, W. Weng jan.78
_ K. Engsager mar.79
;
\f
comment write_stn_tx * page 2 29 03 79, 9.34
0 1 2 3 4 5 6 7 8 9 ;
if nr > 0 then
begin
long stn;
integer hnr, snr, lbnr,
_ suffix, suffix_char, dec, t;
stn := nr;
suffix := nr extract 19;
nr := nr shift (-19);
if nr<200 00 0000 and suffix=0 then
begin comment landsnummer;
hnr:=nr//100 0000; snr:=nr mod 100 0000;
lbnr:=snr mod 10000; snr:=snr//10000;
write_stn := (if hnr<>0 then write(z, <<ddd>, hnr)
_ else write(z, <:_K_:>))
_ + write(z, <:-:>, <<zd>, snr, <:-:>,
_ if lbnr<1000 then <<_zdd> else <<zddd>, lbnr);
end landsnummer
else
begin comment stationsnummer;
integer array action(0:127);
nr := nr mod 200 00 0000;
suffix_char := suffix shift (-12);
suffix := suffix extract 12;
for t:= 4 step 1 until 64, 94 step 1 until 127 do
action(t):= 8 <* error *>;
for t:= 65 step 1 until 93 do
action(t):= 4 <*capital char *>;
for t:= 1 step 1 until 9 do
action(case t of( 0, 1, 2, 3, 46, 75, 76, 77, 88)) :=
_ case t of( 1, 3, 5, 5, 2, 6, 5, 7, 8);
case action(suffix_char) of
begin
comment case 1: no suffix char;
write_stn := write(z, <<-ddd_dd_ddd>, nr);
begin comment case 2: decimal point;
dec := 0;
for t := suffix, t//10 while t > 0 do
dec := dec + 1;
write_stn := write(z, case dec of (
_ <<__-dd_ddd>, <<_-dd_ddd>,
_ <<-dd_ddd>, <<dd_ddd>),
_ nr, false add suffix_char, 1,
_ case dec of (
_ <<d>, <<dd>, <<ddd>, <<dddd>),
_ suffix);
end decimal point action;
\f
<* write_stn_tx * page 3 29 03 79, 9.34
0 1 2 3 4 5 6 7 8 9 *>
begin
comment case 3:
Output of exposure identification,
see also read_steco, GI-no 76092.
text syntax:
<exp id> ::= P<route no> <photo no>
<route no> ::= <integer><alphafabetic character>
_ ( <integer> . <integer> )
<photo no> ::= < >
_ ( <integer> )
The second alternativ in <photo no> is used
when sub=no = 0.
Packing of exposure identification.
The exposure identification is packed in a long. Note
that also the exposure date is needed for a full ident-
fication.
The format must conform to the read/write_stn
packing of station numbers in order to use the
exposure identification no as the station no of the
optical center of the camera. The read/write_stn
format is
_ (no shift 19) + (char shift 12) + sub_no
The exposure identification no use the non-
graphic char value 1 and pack in this way
bit no bits use
47 : 1 sign, not used
46-36: 11 route no (max decimal value 2047)
35-31: 5 last bits of route character
30-19: 12 picture no (max decimal value 4095)
18-12: 7 char (value 1)
11- 0: 12 sub-no
;
dec := 0;
if suffix > 0 then
for t := 10*suffix, t//10 while t>0 do dec := dec+1;
h_nr := stn shift (-36) extract 11;
s_nr := stn shift (-19) extract 12;
if h_nr > 999 then dec := dec + 1;
if s_nr > 999 then dec := dec + 1;
write_stn := write(z, sp, 3 - dec, <:P:>, <<zdd>, h_nr,
false add (stn shift (-31) extract 5 + 64), 1, s_nr)
+ ( if suffix > 0 then
write(z, <:.:>, <<d>, suffix) else 0);
end if suffix_char = 1;
\f
<* write_stn_tx * page 4 29 03 79, 9.34
0 1 2 3 4 5 6 7 8 9 *>
comment case 4: capital char;
if (stn shift(-19) < 200_00_0000) and (nr mod 10000 = 0) then
begin
comment spec. niv-landsnummer;
dec := 0;
if suffix > 0 then
for t := 10 * suffix, t//10 while t>0 do dec:= dec+1;
h_nr := nr // 100_0000;
s_nr := (nr mod 100_0000) // 10000;
write_stn := (if dec < 3 then
_ write(z, sp, 2 - dec) else 0)
_ + (if h_nr <> 0 then
_ write(z, <<ddd>, h_nr)
_ else write(z, <: K :>))
_ + write(z, <:-:>, <<zd>, s_nr, <:-:>,
_ sp, if dec>=3 then 0 else 1,
_ false add suffix_char, 1)
_ + (if suffix > 0 then
_ write(z, <:.:>, <<d>, suffix)
_ else 0);
end
else
write_stn := write(z, <<-d_dd_ddd>, nr,
_ sp, 1,
_ false add suffix_char, 1);
comment case 5: G.I. or G.M. or F.K. or K.K. number;
begin
if suffix shift(-11) > 0 then
begin
comment intermedium number;
lb_nr := suffix shift(-6) extract 5;
suffix := suffix extract 6;
end
else
lb_nr := 0;
dec := 0;
if suffix>0 then
for t:= 10*suffix, t//10 while t>0 do dec:= dec+1;
for t:= nr , t//10 while t>0 do dec := dec+1;
if lb_nr > 0 then
for t:= 10*nr+lb_nr , t//10 while t>0 do dec := dec+1;
write_stn := write(z, sp, 7-dec,
_ if suffix_char = 2 then <:F.K.:> else
_ if suffix_char = 3 then <:K.K.:> else
_ if nr >= 1600 then <:G.I.:>
_ else <:G.M.:>, <<d>, nr)
_ + (if lb_nr > 0 then
_ write(z, <:/:>, <<d>, nr+lb_nr) else 0)
_ + (if suffix>0 then
_ write(z, <:.:>, <<d>, suffix) else 0);
end;
\f
<* write_stn_tx * page 5 29 03 79, 9.34
0 1 2 3 4 5 6 7 8 9 *>
comment case 6: kalot;
write_stn := write(z, <<-dd_ddd>, nr,
_ sp, 1,
_ false add suffix_char, 1,
_ <<dd>, suffix);
comment case 7: write model no.
Text syntax:
M<no>(.<sub-no> / empty)
<no> and <sub-no> are integers.
Packing:
bit no bits use
47 : 1 sign, zero
46 - 19: 28 model no
18 - 12: 7 char (value 77)
11 - 0 : 12 sub no
;
begin
dec := 0;
if suffix > 0 then
for t := 10*suffix, t//10 while t>0 do dec := dec+1;
for t := nr , t//10 while t>0 do dec := dec+1;
write_stn := write(z, sp, 10-dec, <:M:>, <<d>, nr)
_ + (if suffix>0 then
_ write(z, <:.:>, <<d>, suffix) else 0);
end;
comment case 8: error;
write_stn:= if suffix_char = 88 <* X*>
_ and nr <> 99 999
then write(z, <<-d dd ddd>, nr, <: X:>)
else write(z, <: 99 999XXXXXXXXXX:>);
end case action(suffix_xchar) of;
end stationsnummer;
end nr>0
else write_stn := write(z, <<-ddd_dd_ddd>, nr);
end
if warning.yes
(mode 0.yes
message write_stn not ok
lookup write_stn)
end
finis
▶EOF◀