|
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: 21504 (0x5400)
Types: TextFile
Names: »readgeotx«
└─⟦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_tx * page 1 13 09 77, 10.35;
(
readgeo = set 1
readgeor = set bs readgeo
readident = set bs readgeo
readcmt = set bs readgeo
readstn = set bs readgeo
readnl = set bs readgeo
mil = set bs readgeo
readgeo = slang entry.no
readgeo readgeor readident readcmt readstn readnl mil
scope project read_geo read_geo_r read_ident read_cmt,
read_stn read_nl m_i_l
lookup read_geo read_geo_r read_ident read_cmt,
read_stn read_nl m_i_l
if 11.yes
(message read_geo interim login scope
scope login read_geo)
)
b. ; outermost block
p.<:fpnames:>
m.girc 4000 readgeo 07.02.77, 08.21.46
\f
; read_geo_tx * page 2 13 09 77, 10.35;
; long procedure read_geo( z, typedec );
; ______________________________________
;
; read_geo (return, long) angle or distance of geotype
;
; z (call and return, zone) open for char input
; typedec (return, boolean) type shift 6 add dec
;
; further description of variables and actions on standard
; variables see read_geo_t;
;
; real procedure read_geo_r( z, typedec );
; ________________________________________
;
; read_geo_r (return, real) angle in radians
; or distance in meters
; z (call and return, zone) open for char input
; typedec (return, boolean) type shift 6 add dec
;
; further description of variables and actions on standard
; variables see read_geo_t;
;
; long procedure read_ident( z, typedec );
; ________________________________________
;
; read_ident (return, long) the number input, disregarding the
; first decimal point.
; z (call and return, zone) open for char input
; typedec (return, boolean) a short integer (12 bits) con-
; taining the number of decimals.
; the terminator m switches to
; geotype (type=8) recorded as
; typedec >= 8 shift 6 and mtr=true;
;
; long procedure read_cmt( z, typedec, scmt );
; ____________________________________________
; read_cmt (return, long) the value of the datetime or rundate
; input. a comma between date and time
; is permitted but not required. the
; same holds for decimal point between
; hour and minutes. a do is accepted
; giving read_cmt the value of scmt.
; termination m switches to geotype,
; signalled by mtr=true and then type-
; becomes the usual typedec for a
; geotype variable.
; typedec (return, boolean) true when a do is input.
; used as typedec in case of geotype
; input.
; scmt (call and return, long) the value used after input
; of a do. the return value equals
; read_cmt, except for input of
; geotype, where it is unchanged;
;
\f
; read_geo_tx * page 3 13 09 77, 10.35;
; long procedure read_stn( z, numbertype );
; _________________________________________
; zone z;
; integer numbertype;
;
; read_stn (return, long) the landsnummer or station number
; input after a nl or ff. 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 to geotype with the
; typedec packed in numbertype and
; with mtr=true.
; 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
; >=8 shift 6 : geotype (mtr=true);
;
; boolean procedure read_nl( z, b );
; __________________________________
; zone z;
; boolean b;
;
; read_nl (return, boolean) true if the line contains
; information sensed by aid of the
; boolean b,
; false if nl, ff or em is met.
; em gives not_eof=false
; z (call and return, zone) open for char input
; b (call, boolean) variable for use of jensens de-
; vice in control of exit from
; the procedure. i.e. reading
; stops when b == false;
;
;
; boolean procedure m_i_l( z, b );
; ________________________________
; zone z;
; boolean b;
;
; m_i_l (return, boolean) true if the line contains digi-
; tal info or information sensed
; by aid of the boolean b,
; false if nl, ff or em is met.
; em gives not_eof=false
; z (call and return, zone) open for char input
; b (call, boolean) variable for use of jensens de-
; vice in control of exit from
; the procedure. i.e. reading
; stops when b == false;
;
\f
; read_geo_tx * page 4 13 09 77, 10.35;
b. g1, e9 ; block with names for tail and insertproc
w.
k=10000 ; load addr
s. g10, j70, d15, f1 ; start of slang segm
h.
g0=9 ; number of extern.
e5:
g1: g3, g2 ; headword, rel of last point, absword
g2=k-2-g1 ; fin of abswords
; points:
g3=k-2-g1 ; fin of points
; fill with aw 0 :
w.
aw 0 , r. 250-(:+12*g0+4:)>1;
; extern. list:
w.
e0: g0 ; number of extern.;
g10 ; number of bytes to be initialized
g10=k-e0-4
<:rg:>, 0,0,0 ; rg
10<18+0, 0 ; own real
<:readgeot:>, 0 ; readgeot
5<18+2<12+8<6+13, 0; long proc, bool, zone, int.val
<:tchar:>, 0, 0 ;
9<18+0, 0 ; own integer
<:mtr<0>:>, 0, 0 ; mtr
8<18+0, 0 ; own boolean
<:readnmb:>, 0 ;
5<18+3<12+8<6+0, 0 ; long proc, integer zone
<:readchar:>, 0 ;
3<18+19<12+8<6+0, 0 ; integer proc, integer, zone
<:noteof<0>:>, 0 ;
8<18+0, 0 ; own boolean
<:inclass:>, 0 ;
9<18+0, 0 ; own integer
<:repeatchar:> ;
1<18+8<12+0, 0 ; procedure, zone;
\f
; read_geo_tx * page 5 13 09 77, 10.35;
; continuation-address on next segm of ext.list
g9
g4:
c.g4-e5-506
m.code readgeo too long
z.
c.502-g4+e5
jl -1 , r.252-(:g4-e5:)>1; fill whith -1
z.
<:readgeo<0>:>, 0
; slut første segm;
; start andet segm;
h.
e8:
g5: g7, g6 ; headword, rel of last point, absword
; abswords:
j3: g0+3 , 0 ; RS entry 3: reserve
j4: g0+ 4, 0 ; do 4: take expression
j6: g0+ 6, 0 ; do 6: stop reg expression
j13: g0+13, 0 ; do 13: last used
j30: g0+30, 0 ; do 30: saved stack ref. saved w3
j46: g0+46, d15 ; do 46: convert long to real
j60: 1, 0 ; first of extern. rg
j61: 2, d0 ; second do read_geo_t
j62: 3, 0 ; third do t_char
j63: 4, 0 ; fourth do mtr
j64: 5, d6 ; fifth of extn. read_nmb
j65: 6, d9 ; sixth do read_char
j66: 7, 0 ; seventh do not_eof
j67: 8, 0 ; eighth do in_class
j68: 9, d12 ; nineth do repeat_char
g6=k-2-g5 ; fin of abswords
; points:
g7=k-2-g5 ; fin of points
; continuation ext.list :
w.
g9=k-g5
s3 ; date
s4 ; time
\f
; read_geo_tx * page 6 13 09 77, 10.35;
f.
f1: '-6 ; constant used in geo_t_r and r_t_geo
w.
h.
d2: 12, d1 ; appetite, rel return from read_geo_t
d5: 10, d4 ; appetite, rel return from mil
d11: 8, d10 ; appetitte, rel return from read_char
d14: 4, d13 ; appetite, rel return from repeatchar
w.
b. a20, c2 ; start of read_geo
w.
a3:
; entrypoint read_cmt_2
; **********
am 5-4 ; proc_info
e7:
; entrypoint read_cmt
; ********
am 4-3 ; proc_info
e6:
; entrypoint read_ident
; **********
am 3-2 ; proc_info
e1:
; entrypoint read_geo_r
; **********
am 2-1 ; proc_info
e2:
; entrypoint read_geo
; ********
al w0 1 ; proc_info
al w1 -26 ; work + stack to readgeot
jl. w3 (j3.) ; reserve 26 bytes
sn w0 5 ; only 18 bytes are released
am 8 ; on return from read_geo_t;
al w2 x1+26 ; w2:= last used
ds. w3 (j30.) ; saved w3
rs w0 x2-2 ; save proc info
\f
; read_geo_tx * page 7 13 09 77, 10.35;
; set kind
sn w0 5 ;
al w0 4 ;
sn w0 2 ;
al w0 1 ;
rs w0 x2-4 ;
rs w2 x1 ; stack ref of readgeot stack
rl. w3 g5. ; segm. table of this segm.
rl. w0 d2. ; appetite, rel. return
ds w0 x1+4 ;
; set kind :
al w3 26 ; formals kind = integer
al w0 x2-4 ; addr of readgeot kind
ds w0 x1+8 ; save formals
; move formals :
dl w0 x2+12 ; tpd
ds w0 x1+16 ; save formals
dl w0 x2+8 ; z
ds w0 x1+12 ; save formals
; read_geo_t( kind, z, typedec );
rl. w3 (j61.) ; addr read_geo_t
d0=k+1-e8 ; rel chain
jl w3 x3+0 ; goto read_geo_t
d1=k-e8 ; rel. return
ds. w3 (j30.) ; save stack ref
dl w1 x1 ; w0w1 := read_geo_t;
rl w3 x2-2 ; load procinfo
as w3 1 ;
; goto proc.
rl. w3 x3+c1. ; rel addr.
c0: jl. x3 ;
; read_geo_r
; ==========
a10: rl. w3 (j46.) ; load addr of conv long to real
d15=k+1-e8 ; rel chain
jl w3 x3+0 ; goto conv long to real
ds w1 x2+8 ; save real
dl w1 x2+12 ; load formals tpd
so w0 16 ; if expr then
jl. w3 (j4.) ; take this
bz w3 x1 ; load tpd
dl w1 x2+8 ; load load real
sl w3 512 ; if (tpd shift(-6))extract 6 < 8
jl. a1. ; then
fm. w1 (j60.) ; geo_r:= geo_r * rg
jl. a2. ; else
a1: fm. w1 f1. ; geo_r:= geo_r * '-6
; stop:
a2: rs. w2 (j13.) ; release stack
jl. (j6.) ; stop reg expr
\f
; read_geo_tx * page 8 13 09 77, 10.35;
; read_cmt
; ========
a4:
bl. w3 (j63.) ; load mtr
sz w3 1 ; if mtr
jl. a2. ; then goto stop;
ds w1 x2-6 ; save icmt
rl. w3 (j62.) ; load t_char
sn w3 44 ; if t_char = 44 then
jl. a6. ; goto read more;
dl w1 x2+12 ; load formals of typedec;
so w0 16 ; if expression then
jl. w3 (j4.) ; take this;
ds. w3 (j30.) ;
bz w1 x1 ; w1:= typedec;
; scmt
a8: rs w1 x2-2 ; save this;
dl w1 x2+16 ; load formals scmt;
so w0 16 ; if expression then
jl. w3 (j4.) ; take this;
ds. w3 (j30.) ;
rl w3 x2-2 ; w3:= typedec;
sz w3 1 ; if -, typedec
jl. a5. ; then
rl w3 2 ; beginnn
dl w1 x2-6 ; load icmt
ds w1 x3 ; save in scmt
jl. a2. ; enddddd else
a5: dl w1 x1 ; load scmt;
jl. a2. ; goto stop.
; read more
a6:
; long mult
ad w1 8 ; icmt :=
ds w1 x2-2 ;
ad w1 -4 ; 16 * icmt
ss w1 x2-2 ; -256 * icmt
ds w1 x2-6 ;
dl w1 x2-2 ;
ad w1 3 ;
ds w1 x2-2 ;
ad w1 2 ; +8192 * icmt
aa w1 x2-2 ; +2048 * icmt
aa w1 x2-6 ; <* = 10000 * icmt *> ;
ds w1 x2-6 ; save icmt;
jl. a3. ; goto read_cmt_2;
; read_cmt_2
; ==========
a7: aa w1 x2-6 ; scmt :=
ds w1 x2-6 ; read_cmt :=
al w1 0 ; icmt + read_geo_t;
jl. a8. ; goto scmt;
\f
; read_geo_tx * page 9 13 09 77, 10.35;
c2:
; goto addresses after call of read_geo_t :
a2-c0 ; read_geo
a10-c0 ; read_geo_r
a2-c0 ; read_ident
a4-c0 ; read_cmt
a7-c0 ; read_cmt_2
c1=c2-2
i.
e.
; slut read_geo
b. a20, b3, c1 ; start of read_stn
w.
e3:
; entrypoint read_stn
; *******************
al w1 -16 ;
jl. w3 (j3.) ; save stack + stack to mil call
al w2 x1+16 ; last used
ds. w3 (j30.) ;
al w0 -1 ; b <*in mil_call*> := true;
rs w0 x2-2 ; save this
rs w2 x1 ; save stack info to call of mil
rl. w3 g5. ;
rl. w0 d5. ;
ds w0 x1+4 ;
dl w0 x2+8 ; move formals of z
ds w0 x1+8 ;
al w3 25 ; kind = boolean
al w0 x2-2 ; addr(b)
ds w0 x1+12 ; save formals(b)
; read_nl( z, b );
d3=k+1-e8
jl. w3 a0. ; subentry mil with inclass_lim = 0;
d4=k-e8
ds. w3 (j30.) ;
; read_nmb( z, tpd ); <* return from there *>
rl. w3 (j64.) ;
d6=k+1-e8
jl x3+0 ; goto read_nmb , return from there;
\f
; read_geo_tx * page 10 13 09 77, 10.35;
a0:
e9:
; entrypoint read_nl
; ******************
am -4 ; inclass_lim := 0;
e4:
; entrypoint mil
; **************
al w0 4 ; inclass_lim := 4;
al w1 -4 ;
jl. w3 (j3.) ; save work to inbranckets and classlim
al w2 x1+4 ; last used
ds. w3 (j30.) ;
rs w0 x2-2 ; save inclasslim
al w0 0 ; in_branckets := false;
; read next char:
b0: rs w0 x2-4 ; save inbranckets;
al w1 -14 ; save stack read_char(z, t_char );
jl. w3 (j3.) ;
ds. w3 (j30.) ;
rs w2 x1 ; return info
rl. w3 g5. ;
rl. w0 d11. ;
ds w0 x1+4 ;
dl w0 x2+8 ; move formals(z)
ds w0 x1+8 ;
al w3 26 ; kind = integer
rl. w0 j62. ; addr( t_char );
ds w0 x1+12 ; save formals( t_char )
; read_char( z, t_char );
rl. w3 (j65.) ;
d9=k+1-e8
jl w3 x3+0 ; goto read_chat( z, t_char );
d10=k-e8
ds. w3 (j30.) ;
rl w1 x1 ; w1 := read_char;
rs. w1 (j67.) ; save inclass
rl. w0 (j62.) ; load t_char
sn w0 25 ; if t_char = 25
jl. b3. ; then goto set not_eof;
dl w1 x2+12 ; load formals b
so w0 16 ; if expression then
jl. w3 (j4.) ; take this
ds. w3 (j30.) ;
rl. w0 (j62.) ; w0:= t_char
rl w3 x2-4 ; w3:= in_branckets;
sz w3 1 ; if in_branckets then
jl. b2. ; goto set in_branckets;
bl w1 x1 ; w1:= b;
sz w1 1 ; if -, b
sn w0 10 ; or t_char = 10 then
jl. b3. ; goto set not_eof;
\f
; read_geo_tx * page 11 13 09 77, 10.35;
rl. w1 (j67.) ; w1:= in_class;
se w0 12 ; if t_char = 12
sh w1 (x2-2) ; or inclass <= inclass_lim then
jl. b3. ; goto set not_eof;
; set in_branckets:
b1: se w0 42 ; if t_char = 42
jl. b2. ; then
al w0 -1 ; in_branckets := true
jl. b0. ; goto read next char ;
b2: se w0 59 ; in_branckets := if t_char <> 59
am x3 ; then in_branchets
al w0 0 ; else false;
jl. b0. ; goto read next char;
; set not_eof:
b3: sn w0 25 ; not_eof :=
am 1 ; t_char <> 25;
al w3 -1 ;
hs. w3 (j66.) ; save not_eof;
se w0 10 ; mil :=
sn w0 12 ; t_char <> 10
am 1 ; and t_char <> 12
al w1 -1 ;
la w1 6 ; and not_eof;
rs w1 x2-4 ; save mil;
al w1 -10 ; save stack to repeat_char
jl. w3 (j3.) ;
ds. w3 (j30.) ;
rs w2 x1 ; return info;
rl. w3 g5. ;
rl. w0 d14. ;
ds w0 x1+4 ;
dl w0 x2+8 ; move formals(z);
ds w0 x1+8 ;
; repeat_char( z );
rl. w3 (j68.) ;
d12=k+1-e8
jl w3 x3+0 ;
d13=k-e8
ds. w3 (j30.) ;
rl w1 x2-4 ; load mil
rs. w2 (j13.) ; release stack;
al w0 0 ;
jl. (j6.) ; stop by reg expr;
g8:
c.g8-e8-506
m. code readstn too long
z.
c.502-g8+e8
jl -1 , r.252-(:g8-e8:)>1; fill with -1
z.
<:readgeo<0>:>, 0
i.
e.
\f
; read_geo_tx * page 12 13 09 77, 10.35;
i.
e.
; entry tail:
; read_geo
g0: 2 ; first tail: 2 segm
0, 0, 0, 0 ; fill
1<23+0<12+e2-e8 ; entrypoint
5<18+2<12+8<6+0, 0 ; long proc, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 code segm. 0 bytes in perm core
; read_geo_r
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e1-e8 ; entrypoint
4<18+2<12+8<6+0, 0 ; real proc, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; read_ident
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e6-e8 ; entrypoint
5<18+2<12+8<6+0, 0 ; long proc, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; read_cmt
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e7-e8 ; entrypoint
5<18+5<12+2<6+8, 0 ; long proc, long, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; read_stn
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e3-e8 ; entrypoint
5<18+3<12+8<6+0, 0 ; long proc, integer, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; read_nl
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e9-e8 ; entrypoint
2<18+2<12+8<6+0, 0 ; boolean proc, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; mil
g1: 1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e4-e8 ; entrypoint
2<18+2<12+8<6+0, 0 ; boolean proc, boolean, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
p.<:insertproc:>
e. ; stop outermost block
\f
; read_geo_tx * page 13 13 09 77, 10.35;
if ok.no
( mode 0.yes
message readgeo not ok
lookup readgeo )
end
▶EOF◀