|
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: »tmatrixmult«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦09b4e9619⟧ »thcømat«
└─⟦this⟧
\f
message matrixmult prik
(matrixmult=slang entry.no message.no
matrixmult prik)
b. h99 ;
p. <:fpnames:> ;
b. g1,e3 ;
k=0 ;
s. g2,j42,b20 ;
h. ;
g0=0 ;
e3: ;
g1: g2 , g2 ;
j3: g0+ 3, 0 ; rs entry 3, reserve
j4: g0+ 4, 0 ; rs entry 4, take expression
j6: g0+ 6, 0 ; rs entry 6, end register expression
j8: g0+ 8, 0 ; rs entry 8, end address expression
j13: g0+13, 0 ; rs entry 13, last used
j18: g0+18, 0 ; rs entry 18, zone alarm
j29: g0+29, 0 ; rs entry 29, param alarm
j30: g0+30, 0 ; rs entry 30, saved stack ref, saved w3
g2=-g1.-2 ;
w. ;
e0: g0 ;
0 ;
811221,0 ;
; integer procedure take positive parameter;
; 4 bytes must have been reserved in stack before entry.
; call return
; w0: ?
; w1: formal1addr parameter
; w2: stackref stackref
; w3: link ?
; the parameter is also stored in formal1.
b. a5, w. ; begin
b0: rs w1 x2-2 ; save formal1addr;
al. w0 a1. ;
ws w3 0 ; catculate return;
rs w3 x2-4 ; save link;
dl w1 x1+2 ; take formals;
sz w0 16 ; if expression then
jl. a0. ; begin
jl. w3 ( j4.) ; take expression;
ds. w3 ( j30.) ; save stack reference
; end;
a0: dl w1 x1 ; take value;
rl w3 (x2-2) ; w3:= formal1;
sz w3 1 ; if real
cf w1 0 ; then round;
sh w1 0 ; if not positive
jl. w3 ( j29.) ; then param alarm;
rs w1 (x2-2) ; save param in formal1;
am (x2-4) ;
a1: jl. 0 ; return
e. ; end;
; procedure take real array and check index;
; 4 bytes must have been reserved in stack before entry.
; call return
; w0: formal1addr ?
; w1: index index
; w2: stackref stackref
; w3: link ?
; the address of the first element is stored in formal1.
b. a5, w. ; begin
b1: rx w1 0 ;
ds w0 x2-2 ; save index; save link;
rl w3 x1+2 ;
ba w3 x1 ; w3:= absolute dope address;
al w0 4 ;
wa w0 x3 ; w0:= lower index;
wa w0 (x1+2) ; w0:= address of first element;
rs w0 x1 ; formal1:= w0;
rl w0 x3-2 ; w0:= (upper index
ws w0 x3 ; -lower index+4)
as w0 -2 ; //4;
rl w1 x2-2 ; w1:= index;
sl w0 x1 ; if subscriptrange+1 >= index
jl (x2-4) ; then return
jl. w3 ( j18.) ; else index alarm
e. ; end;
;real procedure sigma;
; performs the calculation
;
; m
; SIGMA a b
; j=1 ij jk
;
; using extended accuracy.
; call return
; w0: 4*m
; w1: link result
; w2: a(i,1)addr w2+w0
; w3: b(1,k)addr ?
; b3: 4*n
b. a6, d7, w. ; begin
0 ;
d0: 2048 ; real zero;
0 ; address b1k,
d1: 0 ; a1m+4,
d2: 0 ; link;
0 ;
d3: 0 ; long fraction;
d4: 0 ; integer exponent;
0 ;
d5: 0 ; long work1,
0 ;
d6: 0 ; work2;
0 ;
d7: 1024 ; long roundconstant;
b2: wa w0 4 ; w0:= w0+w2;
ds. w0 d1. ; save w3; save w0;
rs. w1 d2. ; save link;
ld w1 -65 ;
ds. w1 d3. ; fraction:= 0;
al w1 -2048 ;
rs. w1 d4. ; exponent:= -2048;
jl. a2. ; goto start;
a0: ds. w1 d3. ; save fraction;
rs. w3 d4. ; save exponent;
a1: rl. w3 d1.-2 ;
wa. w3 b3. ;
rs. w3 d1.-2 ;
a2: rl w0 x2-2 ;
rl w1 x3-2 ;
se w0 0 ;
sn w1 0 ;
jl. a6. ;
wm w1 0 ;
ds. w1 d5. ;
bz w1 x2-1 ;
wm w1 x3-2 ;
ds. w1 d6. ;
bz w1 x3-1 ;
wm w1 x2-2 ;
aa. w1 d6. ;
ad w1 -12 ;
aa. w1 d5. ;
bl w3 x3 ;
ba w3 x2 ;
al w3 x3+1 ;
sh. w3 ( d4.) ;
jl. a3. ;
rx. w0 d3.-2 ;
rx. w1 d3. ;
rx. w3 d4. ;
a3: ws. w3 d4. ;
ad w1 x3 ;
aa. w1 d3. ;
nd w1 7 ;
ad w1 -1 ;
bl w3 7 ;
al w3 x3+1 ;
wa. w3 d4. ;
sn w0 0 ;
al w3 -2048 ;
al w2 x2+4 ;
se. w2 ( d1.) ;
jl. a0. ;
a4: sn w0 0 ;
jl. a5. ;
aa. w1 d7. ;
nd. w1 3 ;
al w3 x3 ;
a5: hl w1 7 ;
sl w3 -2048 ;
sl. w3 ( d0.) ;
fd. w1 d0. ;
jl. ( d2.) ;
a6: al w2 x2+4 ;
se. w2 ( d1.) ;
jl. a1. ;
dl. w1 d3. ;
rl. w3 d4. ;
jl. a4. ;
e.
b3: 0 ;
b. a5, d6, w. ;
d0: 0 ;
d1: 0 ;
d2: 0 ;
d3: 0 ;
d4: 0 ;
d5: 0 ;
d6: 0 ;
e1: rl. w2 ( j13.) ;matrixmult:
ds. w3 ( j30.) ;
al w1 -4 ;
jl. w3 ( j3.) ;
al w1 x2+6 ;
jl. w3 b0. ;
al w1 x2+10 ;
jl. w3 b0. ;
wm w1 x2+6 ;
rs w1 x2+8 ;
al w0 x2+18 ;
jl. w3 b1. ;
al w1 x2+14 ;
jl. w3 b0. ;
wm w1 x2+10 ;
al w0 x2+22 ;
jl. w3 b1. ;
rl w1 x2+14 ;
wm w1 x2+6 ;
al w0 x2+26 ;
jl. w3 b1. ;
rs. w2 ( j13.) ;
rl w0 x2+10 ;
ls w0 2 ;
rl w1 x2+26 ;
ds. w1 d1. ;
rl w0 x2+8 ;
rl w1 x2+14 ;
ld w1 2 ;
rs. w1 b3. ;
al w1 x1-4 ;
rl w3 x2+22 ;
rl w2 x2+18 ;
aa w1 6 ;
ds. w1 d3. ;
ds. w3 d5. ;
rs. w3 d6. ;
rl. w0 d0. ;
jl. w1 b2. ;
a0: ds. w1 ( d1.) ;
rl. w3 d5. ;
se. w3 ( d3.) ;
jl. a2. ;
sl. w2 ( d2.) ;
jl. ( j8.) ;
rs. w2 d4. ;
rl. w3 d6. ;
a1: rs. w3 d5. ;
dl. w1 d1. ;
al w1 x1+4 ;
rs. w1 d1. ;
al. w1 a0. ;
jl. b2. ;
a2: al w3 x3+4 ;
rl. w2 d4. ;
jl. a1. ;
e.
e2: rl. w2 ( j13.) ;prik:
ds. w3 ( j30.) ; save stackref;
al w1 -4 ;
jl. w3 ( j3.) ; reserve 4 bytes;
al w1 x2+6 ;
jl. w3 b0. ; take m;
al w0 x2+10 ;
jl. w3 b1. ; take A and test for m elements;
al w0 x2+14 ;
jl. w3 b1. ; take B and test for m elements;
rs. w2 ( j13.) ; release 4 bytes;
rl w3 x2+14 ; w3:= firstaddr(A)+2;
al w0 4 ;
rs. w0 b3. ; b3:= 1*4;
rl w0 x2+6 ; w0:= m
ls w0 2 ; *4;
rl w2 x2+10 ; w2:= firstaddr(B)+2;
jl. w1 b2. ; sigma;
jl. ( j6.) ; end register expression;
h. ; end
0,r.(:504-k:) ;
w. ;
<:matrixmult <0>:> ;
e. ;
w. ;
;matrixmult:
g0: 1 ;
0,0,0,0 ;
1<23+e1-e3 ;
1<18+26<12+26<6+26 ; procedure matrixmult(l,m,n,A,B,C);
13<18+13<12+13<6 ; value l,m,n; integer l,m,n; array A,B,C;
4<12+e0-e3 ;
1<12+0 ;
;prik:
g1: 1<23+4 ;
0,0,0,0 ;
1<23+e2-e3 ;
4<18+26<12+26<6+13 ; real procedure prik(m,A,B);
0 ; value m; integer m; array A,B;
4<12+e0-e3 ;
1<12+0 ;
p. <:insertproc:> ;
e.
▶EOF◀