|
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: »readparamtx«, »readparamtx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »readparamtx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦592c22808⟧ »proctxpack «
└─⟦c7b1c7cfc⟧
└─⟦this⟧ »readparamtx«
; readparam_tx * page 1 17 02 83, 11.19;
if listing.yes
char 10 12 10
(
readparam=set 1 0
readparam=slang list.no entry.no
readparam
)
b. ; outermost block
d.
p.<:fpnames:>
l.
m. gi readparam 25.01.83
;
; integer procedure read_param(array,more);
; array (return) long or real array
; An integer is floated into the first
; element of "array".
; A text item is assigned into array(1:2),
; NOTE: fielding may change the type of
; array, but not the adressing.
; more empty or
; (return) boolean
; True if the fp_parameter read is followed
; by a period, false otherwize.
; The procedure reads the parameters in the fp command
; activating the program.
;the program name is skipped.
; read_param := kind of item stored in "array"
; -1 <text>= (first call and aftr wrap around)
; 0 end_of_parameter_list
; 1 <sp><integer>
; 2 <sp><text>
; 3 .<integer>
; 4 .<text>
\f
; readparam_tx * page 2 17 02 83, 11.19;
b.g1,d1,e20, j55 ; block with names for tail and insertproc
w.
k=10000 ; load address
s. g10,a60,b1,c10, i1 ;start of slang segm
h.
g0=1 ; number of extern.
e0:
d0: g3,g2 ; headword: rel of last point, rel of abs word
;abswords:
j3: g0+ 3, 0 ; RS entry 3: reserve bytes in stack
j6: g0+ 6, 0 ; do 6: end by reg. expression
j13: g0+13, 0 ; do 13: last used
j21: g0+21, 0 ; do 21: general alarm
j30: g0+30, 0 ; do 30: saved stack ref. saved w3
j0: 0, 1 ; first word in own core
j50: 1, b0 ; system, 1. ext., chain for rel point to b0
g2=k-2-d0 ;end of abs words
; points
g3=k-2-d0 ; end of points
w.
e1: g0 ; start of external list: number of externals
g4 ; number of bytes in own permanent core,
; to be initialized.
g4=k-e1-4
<:system:>,0,0 ;
3<18+41<12+19<6+19,0 ; int proc(addr int, addr int, undef)
s3 ; date
s4 ; time
h.
g6: 12, b1 ; systems appetite, rel return to this segm
w.
; global working variables
c0: <:<10>ill type:>
c1: 6<12+10 ; bitpattern
c2: 0 ; element no. before system 4 call
c3: <:<10>params>2:>
c4= 8 ; wrk bytes to be reserved in stack
; ; 1. readparam param_no (1/2 allowed)
; ; 2. return addr af subroutine
; ; 3. upper limit
; ; 4. current param addr
c5: 4 ; fnc. of system call
c6= -6 ; rel addr of subroutine return addr
c7= -8 ; rel addr of readparam param_no
i0= -4 ; rel addr of upper limit
i1= -2 ; rel addr of current param addr
\f
; readparam_tx * page 3 17 02 83, 11.19;
;
; internal procedure call system 4
; system(4,int,undef)
; w2 = stack top at readparam entry (call)
; c2 contains the fp_par no. (call)
; w1 contains result (return)
a0: rs w3 x2+c6
al w1 -18 ; reserve 18 bytes in stack
jl. w3 (j3.) ; w1 := last used := new stack top
rs w2 x1 ; newstack(0) := w2
dl w0 x2+8 ; move formals of param( = array)
ds w0 x1+16 ; to newstack
rl. w3 d0. ; w3 := segm table addr of this segm
rl. w0 g6. ; w0 := appetite, rel return in this segm
ds w0 x1+4 ; store return inf in newstack
al w3 26 ; 1. formal of 1. param (kind=integer)
al. w0 c5. ; 2. formal of 1. param (addr of fnc)
ds w0 x1+8 ; save formals of 1. param in newstack
al. w0 c2. ; 2. formal of 2. param (addr of elem. no)
ds w0 x1+12 ; save formals of 2. param in newstack
rl. w3 (j50.) ; w3 := segm table(system)
b0=k+1-d0 ; end of ext. chain
jl x3+0 ; call system
b1=k-d0 ; return form system
jl (x2+c6) ; return
\f
; readparam_tx * page 4 17 02 83, 11.19;
; entry readparam
e2: rl. w2 (j13.) ; w2 := last used
ds. w3 (j30.) ; saved stack ref := w2 := last used
al w1 -c4 ; reserve c4 bytes in stack
jl. w3 (j3.)
al w3 0 ; readparam param_no := 0;
rs w3 x2+c7 ;
al w3 x2+6 ; upper limit := stack ref + 6
ea w3 x2+4 ; + appetite
rs w3 x2+i0 ; i0 := upper limit
al w3 x2+9 ; w3 := current param addr
jl. a11. ; goto first param
a1: rl w3 x2+i1 ; next param
al w3 x3+4 ; curr addr := curr addr + 4
sl w3 (x2+i0) ; if current param >= upper limit
jl. a28. ; end of param
a11: rs w3 x2+i1 ; i1 := current param addr
dl w1 x3 ; take param
sl w1 (x2+i0) ; if addr < upper limit and
jl. a12. ; addr >= first param addr then
sl w1 x2+6 ; upper limit := address
rs w1 x2+i0 ; literal or expr computed at call,
; so upper limit is adjusted
a12: rl w1 x2+c7 ; increment readparam param_no
al w1 x1+1
rs w1 x2+c7 ;
sn w1 1 ; case param_no
jl. a13. ; first
sn w1 2 ;
jl. a14. ; second
al. w0 c3. ; alarm text params>2
jl. a60. ; RS general alarm
a13: al w1 2.11111 ; check kind of array
la w1 x2+6 ; = long array or real array
se w1 19 ; (19=real array)
sn w1 20 ; (20=long array
jl. a1. ; continue with next param
al. w0 c0. ; alarm text illegal type
jl. a60. ; RS general alarm
a14: al w3 2.11111 ; check kind=boolean
la w3 x2+10 ;
sn w3 25 ; (25=boolean variable)
jl. a2.
al. w0 c0. ; alarm text (illegal type)
jl. w3 a60. ; RS general alarm
a2: rl. w3 (j0.) ; fp param no (not incremented yet)
al w3 x3+2 ; if following parameters
rs. w3 c2. ; seperator = period
jl. w3 a0. ; (call subroutine system 4)
rl w1 x1 ;
ls w1 -12 ;
al w3 1 ; then "more" := true
se w1 8 ; (8=period)
al w3 0 ; else more := false
hs w3 (x2+12) ;
jl. a1. ; continue with next param
\f
; readparam_tx * page 5 17 02 83, 11.19;
a28: rl. w1 (j0.) ;
al w1 x1+1 ; increment fp_param no
rs. w1 (j0.)
rs. w1 c2. ; fp_par no.
jl. w3 a0. ; call system 4
rl w1 x1 ; w1 := system result
rl. w0 (j0.) ; if element nmb <> 1
se w0 1
jl. a3. ; or system result <>
sn. w1 (c1.) ; leftsidetext = then
jl. a5.
; begin
a3: sn w1 0 ; if i <> 0 then
jl. a4.
al w0 0
hs w1 1 ; w0 := item length
ls w1 -12 ; w1 := seperator
al w3 0 ; readparam :=
sn w1 8 ; (if w1=8 then 2 else 0)
al w3 2 ; +
al w1 1 ; (if w0=10 then 2 else 1)
sn w0 10 ;
al w1 2
wa w1 6
jl. a6. ; exit
; end of param list
a4: rs. w1 (j0.) ; readparam := element count := 0;
jl. a6. ; exit
; first and = sign
a5: al w3 0 ; read fp_par no. 0
rs. w3 c2. ;
jl. w3 a0. ; w1 := addr of system4 result
al w1 -1 ; readparam := -1
\f
; readparam_tx * page 6 17 02 83, 11.19;
a6: rs. w2 (j13.) ; release reserved bytes in stack
jl. (j6.) ; end by reg.
a60: rs. w2 (j13.) ; release working location in stack
jl. (j21.) ; RS general alarm
g5:
c.g5-e0-506
m.code readparam too long
z.
c.502-g5+e0, jl -1, r.252-(:g5-e0:)>1 z.
; fill rest of segment with the illegal instruction jl -1
<:readparam<0>:> ; alarm text segment 1
i.
e. ; end slang segment
; entry tail:
e11=4<12 + e1 - e0 ; code proc start of ext. list
e12=1<12 + 2 ; 1 code segm, 2 bytes in own core
g0:
g1: 1 ; first tail: 1 segm
0, 0, 0, 0 ; fill
1<23+e2-e0 ; entrypoint for output on first segm
3<18+40<12, 0 ; integer proc(general address)
e11
e12
d.
p.<:insertproc:>
l.
e. ; end outermost block
if ok.no
mode 0.yes
if warning.yes
mode 0.yes
if 0.yes
(
message readparam not ok
lookup readparam
)
▶EOF◀