|
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: 14592 (0x3900)
Types: TextFile
Names: »tdecomposef«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »tdecomposef«
b. g1,e10
; <*** special version of decompose, solve where fielding is allowed ***>
s. a14,b70,c40,d10
k=10000
h.
a9: a10 , a10 ; last abs-word
a0: 4 , 0 ; take expression
a1: 6 , 0 ; end reg.expression
a8: 8 , 0 ; end addr.expression
a2: 13 , 0 ; last used
a4: 30 , 0 ; saved sref,w3
a5: 1<11+1 , 0 ; segm.table address(next segm.)
a10=a5-a9 ; define rel. last abs-word
0 , 0 ; constants and working locations
0 , c11:-2048 ; real 0
0 , 0 ;
0 , c12: 0 ; max
1<10 , 0 ;
0 , c15: 0 ; real 0.5
0 , 0 ;
0 , c16: 0 ; work.loc.
w.
c18: 0 ; addr(addr-increment)
c19: 0 ; addr(entry inner-product)
c2: 0 ; n
c1: 0 ; addr(piv(1))
c4: 0 ; addr(ex(1))
c9: 0 ; addr(a(k+1,1))
c8: 0 ; k
c17: 0 ; dec:p,solve:4*n
c7: 0 ; dec: j,addr(a(k,k))
e3: 0 ; external list
0
310869
1516
e1: am -6 ; entry decompose : w1:=-2
e2: al w1 4 ; entry solve: w1:=4
rl. w2 (a2.) ; w2:=last used
ds. w3 (a4.) ; save w2w3
rl w0 x2 +14 ;
rx w1 x2 +16 ; w0w1:=formal(mode); 2. formal:=entry
so w0 16 ; if expression
jl. w3 (a0.) ; then take expression
dl w1 x1 ; w0w1:=mode
rl w3 x2 +14 ; w3:=first formal(mode)
sz w3 1 ; if real
cf w1 0 ; then convert
ds. w3 (a4.) ; save w2w3
rl. w3 (a5.) ; w3:=segment table location
al w0 4 ;
rs w0 x3 +d1 ; first addr-incr.:=4; second segment in core
se w1 0 ;
am d2 ; mode=1 => rel.addr(inner-pr.):=d2+d3
al w0 x3 +d3 ; mode=0 => rel.addr(inner-pr.):=d3
al w3 x3 +d4 ; w3:=addr(addr-increment)
ds. w0 c19. ; store w3w0
al w3 x3 +d0 ;
rs. w3 c7. ; store addr(array-transformation)
sl w1 0 ; if mode<0
sl w1 2 ; or mode>1
jl. b33. ; then fejl 3
dl w1 x2 +12 ; w0w1:=formal(piv)
jl w3 x3 ; transform(piv)
as w0 -1 ; w0:=length in words
rs. w0 c2. ; store n
al w3 x3 +1 ; w3:=addr(piv(1))
wa w0 6 ; w0:=addr(ex(1))
ds. w0 c4. ; store addr
dl w1 x2 +8 ; w0w1:=formal(a)
jl. w3 (c7.); transform a
al w3 x3 +4 ; w3:=addr(a(x,y)) (last byte)
; <* fielding allowed *>
ds. w0 c8. ; c8:=length; c9:=addr(a(1,1))
rl. w0 c2. ; w0:=n
as w0 2 ; w0:=4*n
rs. w0 (c18.) ; second addr-increment:=4*n
wm. w0 c2. ; w0:=4*n**2
rs. w0 c8. ; c8:=4*n**2;
dl. w1 (c18.) ; w0w1:=4,4*n
se w0 (x2 +16) ; if entry<>4
jl. b0. ; then go to decompose
rs. w0 (c18.) ; address-increment:=4,4 SOLVE
rs. w1 c17. ; store 4*n
dl w1 x2 +20 ; w0w1:=formal(b)
jl. w3 (c7.) ; transform b
se. w0 (c17.) ; if length<>4*n
jl. b34. ; then fejl 4
al w2 x3 +4 ; w2:=addr(b(1))
rl. w3 c9. ; w3:=addr(a(1,1))
ds. w3 b29. ; store addr
al w0 0 ; k:=0
b20: rs. w0 c8. ; store k L*y=b
wa. w0 c1. ;
bl w1 (0) ; w1:=piv(k)
sl. w1 (c8.) ;
sl. w1 (c2.) ; if p<k or p>n-1
jl. b32. ; then fejl 2
as w1 2 ; w1:=4*p
wa. w1 b28. ; w1:=addr(b(p))
dl w0 x2 ; w3w0:=b(k)
rx w0 x1 ;
rx w3 x1 -2 ; w3w0:=b(p); b(p):=b(k)
ds w0 x2 ; b(k):=b(p)
jl. w3 (c19.) ; w0w1:=b(k)-S(b(i)*a(k,i)) i:=1,2,..,k-1
b28: 0 ; addr(b(1))
b29: 0 ; addr(a(k,1))
fd w1 x3 ; w0w1:=w0w1/a(k,k)
ds w1 x2 ; b(k):=w0w1
ds. w3 b25. ;
dl. w1 c17. ; w0:=k; w1:=4*n
wa. w1 b29. ; adjust addr(a(k,1))
rs. w1 b29. ;
ba. w0 1 ; w0:=k+1
al w2 x2 +4 ;
se. w0 (c2.) ; if w2<n
jl. b20. ; then continue
ld w1 48 ; w0w1:=0
ss. w1 (c18.) ; w1:=-5;w1:=-4
ds. w1 (c18.) ; store addr-increment
b23: al w2 x2 -4 ;
jl. w3 (c19.) ; w0w1:=b(k)-S(b(i)*a(k,i)) i:=n,n-1,..,k+1
b24: 0 ; addr(b(n))
b25: 0 ; addr(a(k,n))
ds w1 x2 ; b(k):=w0w1
sn. w2 (b28.) ; if k=1
jl. (a8.) ; then exit
rl. w1 b25. ;
ws. w1 c17. ;
rs. w1 b25. ; adjust addr(a(k,n))
jl. b23. ; continue
b0: rl. w0 c9. ; Decompose
al w1 0 ; i:=0 MAXEXP
rl w2 0 ; w2:=addr(aÆ1,1)
b2: wa. w0 (c18.) ; w0:=addr(a(k+1,1))
al w3 -2048 ; maxexp:=-2048
b1: bs w3 x2 ; maxexp-akt
sh w3 -1
al w3 0 ; max<akt : nulstil
ba w3 x2 ; add akt
al w2 x2+4 ; øg addr(akt)
se w0 x2 ; række ikke slut
jl. b1. ; => continue
am. (c4.)
hs w3 x1 ; ex(i):=maxexp
al w1 x1+1 ; i:=i+1
se. w1 (c2.) ; i<n
jl. b2. ; => continue
al w1 0 ; k:=0 INIT. K-STEP
rl. w2 c9. ; w2:=w3:=
al w3 x2 ; addr(aÆ1,1)
b11:ds. w3 b4. ; store addr(a(1,k)), addr(a(k,1))
rl w0 4 ;
ds. w0 b8. ;
wa. w0 (c18.) ;
ds. w1 c8. ; store addr(a(k+1,1)),k
al w3 x1 ;
as w3 2 ;
wa w2 6 ;
dl. w0 c11. ;
ds. w0 c12. ; max:=0
b5: rs. w1 c7. ; store j (init k) Lower
am. (c4.) ;
bl w1 x1 ; w1:=ex(j)
hs. w1 c15. ; sæt exp
jl. w3 (c19.) ; w0w1:=a(j,k)-S(a(j,i)*a(i,k)) i:=1,2,...,k-1
0 ;
b4: 0 ;
ds w1 x2 ; store w0w1
rx. w3 c7. ; w3:=j; c7:=addr(a(k,k))
sl w0 0 ;
jl. b9. ; w0w10 => hop
dl. w1 c11. ;
fs w1 x2 ; w0w1:=abs(a(j,k))
b9: fd. w1 c15. ; w0w1:=abs(a(j,k))/2**ex(j)-1)
ds. w1 c16. ;
fs. w1 c12. ; w0w1:=akt-max
sh w0 0 ;
jl. b3. ; akt=<max => hop
dl. w1 c16. ;
ds. w1 c12. ; max:= akt
rs. w3 c17. ; p:=j
b3: wa. w2 (c18.) ;
rl. w1 b4.-2 ;
wa. w1 (c18.) ;
rs. w1 b4.-2 ;
al w1 x3+1 ; w1:=j+1
se. w1 (c2.) ;
jl. b5. ; j<n => hop
dl. w2 c12. ; w1w2:=max
se w1 0 ; if max=0 then
jl.b13. ; begin value:=false
hs. w2 (c1.) ; piv(1):=-2048;
jl. (a1.) ; exit end;
b13: dl. w2 c17. ; w1:=k; w2:=p
am. (c1.) ;
hs w2 x1 ; piv(k):=p
sn w2 x1 ;
jl. b6. ; p=k => ikke ombyt
am. (c4.) ; OMBYT
bl w0 x1 ; w0:=EÆk
am. (c4.) ;
hs w0 x2 ; EÆp:=EÆk
ws w2 2 ; w2:=p-k
wm. w2 (c18.) ; w2:=4*n*(p-k)
rl. w1 b8. ; w2:=dddr(aÆk,1)
wa w2 2 ; w2:=addr(aÆp,1)
b7: dl w0 x2 ;
rx w0 x1 ;
rx w3 x1-2 ;
ds w0 x2 ; ombyt
al w1 x1+4 ;
al w2 x2+4 ;
se. w1 (c9.) ; addr(a(k,i))<>addr(a(k+1,1))
jl. b7. ; => continue
b6: dl. w1 (c18.) ;
rx w1 0 ;
ds. w1 (c18.) ;
rl. w2 c7. ; w2:=addr(a(k,k))
b10:al w2 x2+4 ; w2:=addr(aÆj,k)
am. (b12.) ;
al w1 4 ;
rs. w1 b12. ; w1:=addr(aÆ1,j)
sn. w2 (c9.) ; w2=addr(aÆk+1,1)
jl. b14. ; => end upper
jl. w3 (c19.) ; w0w1:=a(k,j)-S(a(i,j)*a(k,i)); i:=1,2,...,k-1
b12:0 ; addr(a(1,j))
b8: 0 ; addr(a(k,1))
fd w1 x3 ; w0w1:=w0w1/a(k,k)
ds w1 x2 ; a(k,j):=w0w1
jl. b10. ;
b14:dl. w0 (c18.) ;
rx w3 0 ;
ds. w0 (c18.) ;
wa. w3 b4. ;
rl. w1 c8. ;
al w1 x1+1 ; w1:=k+1
se. w1 (c2.) ;
jl. b11. ; k<n => forfra
al w1 -1 ; value:=true
jl. (a1.) ; exit
b34: am 1 ; fejl 4
b33: am 1 ; fejl 3
b32: am 1 ; fejl 2
b31: al w1 1 ; fejl 1
dl. w3 (a4.) ;
am. (c18.) ;
jl d5 ;
0,r. 253+a9>1-k>1 ; fill with zeroes
<:lin. eq. 1:>
; second segment
h.
b41: a11 , a11 ; rel addr last abs word
a12: 21 , 0 ; general alarm
a13: 22 , 0 ; overflow
a11=a13-b41 ; define last abs-word
w. ; constants and working locations
0 ; save w2
b43: 0 ; save w3
0 ;
b40: 0 ; addr.-increment
0 ;
b36: 0 ; sum
b49: -1<12
b47: 0 ; exponent
0
0
b58: 1<10
b59: 2048
f.
b37: 0 ; real 0
b45: 0 ; save actual addresses
b46: 0
b48: -1
b65: '600
'-600
w.
b44: rs. w3 b36.
rl w3 x1
ba w1 0
rl w0 x1 -2
ws w0 x1
; wa w3 x1
; <* in this comal version fielding is allowed *>
jl. (b36.)
b30: am (x2+16)
al. w0 b64. ;
jl. w3 (a12.) ;
b42: ds. w3 b43. ; inner-produre(mode=0) : save 2w3
dl w3 x3 +2 ; w2w3:=start-addr
dl. w1 b37. ; w0w1:=0
b38: ds. w1 b36. ;
dl w1 x2 ; w0w1:=l
sn. w2 (b43.-2) ; if addr(l)=slutaddr(l)
jl. b39. ; then go to slut
fm w1 x3 ; w0w1:=l*m
fa. w1 b36. ; w0w1:=sum+l*m
aa. w3 b40. ; add addr-increments
jl. b38. ; continue
b39: fs. w1 b36. ; slut: w0w1:=l
am. (b43.) ;
jl 4 ; return
d0=b44-b40, d1=b40-b41-2, d2=k-b42, d3=b42-b41, d4=b40-b41 , d5=b30-b40
ds. w3 b43. ; inner-product(mode=1) : save w2w3
dl w3 x3 +2 ; w2w3:=start-addr.
ld w1 48 ; w0w1:= long 0
ds. w1 b36. ; sum:=0
b50: ds. w3 b45. ; save addr
sn. w2 (b43.-2) ;
al. w3 b48.+1 ; if w2=slut-addr then w3:=addr(-1)
dl w1 x2 ; w0w1:=l
la. w1 b49. ; exponent:=0
ad w1 -1 ;
ls w1 -1 ;
dl w3 x3 ;
hs. w3 b47.+2 ; store exponent(m)
la. w3 b49. ; exponent:=0
ad w3 -1 ;
ls w3 -1 ;
ds. w2 b46. ; save l2,m1
wm w2 0 ; w1w2:=l1*m1
sn w1 0 ; if l*m=0
jl. b52. ; then goto next
wm w0 6 ; w0w3:=l1*m2
rx. w1 b46.-2 ;
rx. w2 b46. ;
wm w2 2 ; w1w2:=l2*m1
aa w2 0 ; w1w2:=l1*m2+l2*m1
ad w2 -23 ;
aa. w2 b46. ; w1w2:=l1*m1+(l1*m2+l2*m1)*2**(-23)
bl. w3 (b45.-2) ;
ba. w3 b47.+2 ; w3:=exponent(l)+exponent(m)
rl. w0 b36.-2 ;
sn w0 0 ; if sum=0
jl. b51. ; then goto store
sl. w3 (b47.) ; if w3>4exponent
jl. b55. ; then goto big_exp
b57: ws. w3 b47. ; w3:=w3-exponent
sh w3 -48 ; if expdiff<= -48
jl. b52. ; then goto store
ad w2 x3 ; shift product
rl. w3 b47. ; w3:=exponent
b56: aa. w2 b36. ; add sum
b51: nd w2 1 ; store:
ad w2 -1 ; w1w2:=sum normalized shift(-1)
ba w3 1 ;
al w3 x3 +1 ; exponent:=exponent+norm_exp+1
ds. w2 b36. ; store sum
rs. w3 b47. ; store exponent
b52: dl. w3 b45. ; next: w2w3:=addr
sn. w2 (b43.-2) ;if w2=slutaddr(l)
jl. b53. ; then goto prepare exit
aa. w3 b40. ; add addr-incr
jl. b50. ; continue
b55: sn. w3 (b47.) ; big_exp: if w3=exponent
jl. b56. ; then goto no_shift
rx. w1 b36.-2 ;
rx. w2 b36. ; exchange(w1w2,sum)
rx. w3 b47. ; exchange(w3,exponent)
jl. b57. ;
b53: ld w1 48 ; prepare exit:
ss. w1 b36. ; w0w1:=-sum
nd w1 7 ; sum:=sum normalized
sn w0 0 ; if sum=0
jl. b54. ; then exit
ad w1 -1 ; sum:=sum shift (-1)
aa. w1 b58. ; round
nd. w1 b36. ; normalize
bl w3 7 ;
ba. w3 b36. ;
wa. w3 b47. ;
al w3 x3 +4 ; exponent:=exponent+norm_exp1+norm_exp2+4
sl w3 -2048 ;
sl. w3 (b59.) ;
jl. b60. ; if exponent<-2048 or exponent>2047 then goto error
b54: hs w3 3 ;
b62: rl. w3 b45. ; w3:=slutaddr(m)
am. (b43.) ;
jl 4 ; exit
b60: sh w3 0 ;
am 4 ;
dl. w1 b65. ;
fm w1 2 ;
jl. b62. ;
b64=k+2
<:<10>decomp :>
<:<10>solve :>
0,r. 253+b41>1-k>1 ; fill with zeroes
<:lin. eq. 2:>
e1=e1-a9, e2=e2-a9, e3=e3-a9
e. ; end segment
w.
g0: 2 ; tailpart decompose: size of area
0,0,0,0 ;
1<23+e1 ; entry
2<18+13<12+25<6+26 ; spec.
0 ; spec.
4<12+e3 ; ext. list
2<12 ; number of segments
g1: 1<23+4 ; tailpart solve: shared entry
0,0,0,0 ;
1<23+e2 ; entry
1<18+26<12+13<6+25 ; spec.
26<18 ; spec.
4<12+e3 ; ext. list
2<12 ; number of segments
\f
▶EOF◀