|
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: »writegeotx«
└─⟦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_geo_tx * page 1 13 09 77, 10.36;
(
write_geo = set 1
write_geo_r = set bs write_geo
write_geo_c = set bs write_geo
write_geo_c_r = set bs write_geo
write_geo = slang entry.no
writegeo writegeor writegeoc writegeocr
scope project write_geo write_geo_r writegeo_c write_geo_c_r
lookup write_geo write_geo_r write_geo_c write_geo_c_r
if 11.yes
(message write_geo interim login scope
scope login write_geo)
)
b. ; outermost block
p. <:fpnames:>
m. girc 4000 write_geo 14.05.77
\f
; write_geo_tx * page 2 13 09 77, 10.36;
; integer procedure write_geo( z, obs, typedec );
; _______________________________________________
;
; write_geo (return) integer
; the number of characters output by the procedure
;
; z (call and return) zone
; the zone used for buffering, open and ready for char output
;
; obs (call) long
; the angle or distance output. angles are counted in the
; interval 0, 2 pi and output according to the typedec
;
; typedec (call) boolean
; the type and number of decimals of obs (see write_geo_t);
;
; integer procedure write_geo_c( z, obs, typedec );
; _________________________________________________
;
; write_geo_c (return) integer
; the number of characters output by the procedure
;
; z (call and return) zone
; the zone used for buffering, open and ready for char output
;
; obs (call) long
; the angle or distance output. angles are counted in the
; interval -pi, pi and output according to the typedec
;
; typedec (call) boolean
; the type and number of decimals of obs (see write_geo_t);
;
; integer procedure write_geo_r( z, obs, typedec );
; _________________________________________________
;
; write_geo_r (return) integer
; the number of characters output by the procedure
;
; z (call and return) zone
; the zone used for buffering, open and ready for char output
;
; obs (call) real
; the angle or distance output. angles are counted in the
; interval 0, 2 pi and output according to the typedec
;
; typedec (call) boolean
; the type and number of decimals of obs (see write_geo_t);
;
\f
; write_geo_tx * page 3 13 09 77, 10.36;
; integer procedure write_geo_c_r( z, obs, typedec );
; ___________________________________________________
;
; write_geo_c_r (return) integer
; the number of characters output by the procedure
;
; z (call and return) zone
; the zone used for buffering, open and ready for char output
;
; obs (call) real
; the angle or distance output. angles are counted in the
; interval -pi, pi and output according to the typedec
;
; typedec (call) boolean
; the type and number of decimals of obs (see write_geo_t);
;
\f
; write_geo_tx * page 4 13 09 77, 10.36;
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=2 ; 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
<:writegeot:>, 0 ; writegeot
3<18+12<12+15<6+8 ; integer proc, bool val, long val, zone
13<18 ; int val.
\f
; write_geo_tx * page 5 13 09 77, 10.36;
; 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.
<:writegeo<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
j43: g0+47, d15 ; do 47: convert real to long
j60: 1, 0 ; first of extern. rg
j61: 2, d0 ; second do write_geo_t
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.
f1: '-6 ; constant used in geo_t_r and r_t_geo
w.
d2: 12<12 ; appetite increase constant
\f
; write_geo_tx * page 6 13 09 77, 10.36;
b. a20, c2 ; start of write_geo
w.
e7:
; entrypoint write_geo_c_r
; *************
am 4-3 ; proc_info
e6:
; entrypoint write_geo_c
; ***********
am 3-2 ; proc_info
e1:
; entrypoint write_geo_r
; ***********
am 2-1 ; proc_info
e2:
; entrypoint write_geo
; *********
al w0 1 ; proc_info
al w1 -12 ; work + stack to readgeot
jl. w3 (j3.) ; reserve 12 bytes
al w2 x1 ; w2:= last used
ds. w3 (j30.) ; saved w3
rl w3 0 ; move procinfo
rl w0 x2+12 ; move return point
rs w0 x2 ; to new stack top
dl w1 x2+16 ;
wa. w1 d2. ; new appetite := app. + 12
ds w1 x2+4 ;
dl w1 x2+20 ; move formals z
ds w1 x2+12 ;
dl w1 x2+24 ; obs
ds w1 x2+16 ;
; set kind
sl w3 3 ;
am 1 ;
al w0 1 ;
rs w0 x2+22 ;
; set kind :
al w0 26 ; formals kind = integer
al w1 x2+22 ; addr of readgeot kind
ds w1 x2+8 ; save formals
dl w1 x2+28 ; move formals tpd
ds w1 x2+20 ;
\f
; write_geo_tx * page 7 13 09 77, 10.36;
so w3 1 ; if _r then
jl. a1. ; goto conv. obs.
a0:
; write_geo_t( kind, z, obs, typedec );
rl. w3 (j61.) ; addr write_geo_t
d0=k+1-e8 ; rel chain
jl w3 x3 ; goto write_geo_t
; return from there.
a1:
; if _r proc_info then convert obs long :
so w0 16 ; if expr then
jl. w3 (j4.) ; take this;
bz w3 x1 ;
rs w3 x2+24 ; save value tpd;
al w0 25 ; new formals
al w1 x2+25 ; tpd;
ds w1 x2+20 ;
dl w1 x2+16 ; load formals obs
so w0 16 ; if expr then
jl. (j4.) ; take this;
dl w1 x1 ; load obs
rl w3 x2+14 ; load first formal obs
so w3 1 ; if integer then
ci w0 0 ; convert this
rl w3 x2+24 ; load tpd
sl w3 512 ; obs := obs /
jl. a2. ; (
fd. w1 (j60.) ; if tpd shift (-6) extract 6 < 8 then
jl. a3. ; rg
a2: fd. w1 f1. ; else '-6 );
a3: rl. w3 (j43.) ; convert to long
d15=k+1-e8 ;
jl w3 x3+0 ;
ds w1 x2+28 ; save obs
al w0 28 ; new formals obs
al w1 x2+28 ;
ds w1 x2+16 ;
jl. a0. ; goto call write_geo_t
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.
<:writegeo<0>:>, 0
i.
e.
\f
; write_geo_tx * page 8 13 09 77, 10.36;
i.
e.
; entry tail:
; write_geo
g0: 2 ; first tail: 2 segm
0, 0, 0, 0 ; fill
1<23+0<12+e2-e8 ; entrypoint
3<18+12<12+15<6+8, 0 ; integer proc, bool val, long val, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 code segm. 0 bytes in perm core
; write_geo_r
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e1-e8 ; entrypoint
3<18+12<12+14<6+8, 0 ; integer proc, bool val, real val, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; write_geo_c
1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e6-e8 ; entrypoint
3<18+12<12+15<6+8, 0 ; integer proc, bool val, long val, zone
4<12 + e0-e5 ; code proc start of extern. list
1<12 + 0 ; 1 segm, 0 bytes in perm core
; write_geo_c_r
g1: 1<23 + 4 ; modekind = backing storage
0, 0, 0, 0 ; fill
1<23+0<12+e7-e8 ; entrypoint
3<18+12<12+14<6+8, 0 ; integer proc, bool val, real val, 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
; write_geo_tx * page 9 13 09 77, 10.36;
if ok.no
( mode 0.yes
message writegeo not ok
lookup writegeo )
end
▶EOF◀