DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tscalpr«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦09b4e9619⟧ »thcømat« 
            └─⟦this⟧ 

TextFile

message scalpr

(scalpr=set 1
(scalpr=slang fpnames type.yes insertproc entry.no
scalpr vectpr1 vectpr2)
; 23-7-74 ojh
; scalar product with extended accuracy

b. g1,e5 w.

k=10000

s. g6,j40,a16,b10,c20
h.
g0=0
e2:
g1:  g3,g2
j13: g0+13,0              ; last used
j30: g0+30,0              ; saved sr,w3
j6:  g0+6,0               ; end register expr
j8:  g0+8,0               ; end address expr
j4:  g0+4,0               ; take expr
j18: g0+18,0              ; zone alarm (index)
g2=k-2-g1, g3=g2          ; end of abs words, points
w.
e0:    g0
        0
23 07 74, 16 30 00
e4:
     am      1            ; entry vectpr2, mode=2
e3:  am      1            ; entry vectpr1, mode=1
e1:  al  w1  0            ; entry scalpr , mode=0
     rl. w2 (j13.)
     ds. w3 (j30.)
     rx  w1 x2+8          ; take n , store mode
     rl  w0 x2+6
     so  w0  16
     jl. w3 (j4.)
     ds. w3 (j30.)
     dl  w1 x1
     rl  w3 x2+6
     sz  w3  1
     cf  w1  0            ; w1=n
     sh  w1 -1            ; if n<0 then
     jl. w3 (j18.)        ; alarm index n
     rs. w1 a0.
     rl  w3 x2+8
     sn  w3  0            ; if mode=0 then w1=n
     jl.    c0.
     wm  w1  2
     sz  w3  1            ; else if mode is odd then w1=n*n
     jl.    c0.
     wa. w1 a0.           ; else w1=n*(n+1)/2
     as  w1 -1
c0:  rl  w3 x2+12         ; take first array (A)
     rl  w0 x3
     ba  w3 x2+10
     wa  w0 x3
     rs. w0 a1.
     rl  w0 x3-2          ; index check
     ws  w0 x3
     as  w0 -2
     sh  w0 x1            ; if not w1 elements then
     jl. w3 (j18.)        ; alarm index w1
     rl. w1 a0.
     rl  w3 x2+16         ; take second array (B)
     rl  w0 x3
     ba  w3 x2+14
     wa  w0 x3
     rs. w0 a2.
     rl  w0 x3-2          ; index check
     ws  w0 x3
     as  w0 -2
     sh  w0 x1            ; if not n elements then
     jl. w3 (j18.)        ; alarm index n
     rl  w1 x2+8          ; w1=mode
     al. w0 c3.
     rs. w0 b1.
     se  w1  0            ; if mode=0 then
     jl.    c5.           ; goto vectpr init
     rl. w1 j6.           ; initialize for scalpr
     rs. w1 b6.
     rl. w1 a1.
     rs. w1 b5.
     jl.    c1.           ; goto accumulated product
c5:  rl  w3 x2+20         ; vectpr init: take third array (C)
     rl  w0 x3
     ba  w3  x2+18
     wa  w0 x3
     rs. w0 a3.
     rl  w0 x3-2          ; index check
     ws  w0  x3
     as  w0 -2
     rl. w1 a0.
     sh  w0 x1            ; if not n elements then
     jl. w3 (j18.)        ; alarm index n
     rl  w0 x2+8          ; w0=mode
     sn  w0  2            ; if mode=2 then
     jl.    c6.           ; goto vectpr2 init
     rx. w1 a1.           ; initialize for vectpr2
     rs. w1 b4.
     al. w1 c7.
     rs. w1 b6.
     jl.    c1.
c7:  rl. w3 a3.           ; counter for vectpr1
     al  w3 x3+4
     ds  w1 x3            ; store result in C(i)
     rl. w2 a1.
     al  w2 x2-1          ; count
     sh  w2  0
     jl.    (j8.)
     ds. w3 a3.
     jl.    c1.
c6:  rs. w1 b7.           ; init vecpr2: b7:=n
     al  w0  0
     rs. w0 a4.
     al. w0 c11.
     rs. w0 b6.
     jl.    c13.
c11: rl. w3 a3.           ; counter for vectpr2
     al  w3 x3+4
     ds  w1 x3
     rs. w3 a3.
     rl. w3 b7.
     sh  w3  0
     jl.    (j8.)
c13:                      ; entry for accumulated product, if
     al  w3  4            ; only lower half of matrix is stored
     rs. w3 a10.
     rl. w3 b7.
     al  w2 x3-1
     rs. w2 b7.
     rl. w2 a1.
     rs. w2 b5.
     rl. w2 a4.
     al  w2 x2+4
     rs. w2 a4.
c1:  rl. w1 a2.           ; normal entry for accum.product
     rs. w1 b4.
     rl. w1 a0.
     rs. w1 b2.
     rl. w0 a8.
     rs. w0 a7.
     ld  w3 48
     ds. w3 a6.
c2:  dl. w3 a10.          ; continue for normal accum.prod.
c12: aa. w3 b5.           ; cont. for lower half of matrix stored
     ds. w3 b5.
     bz  w1 x2-1          ; start product, addr. of last byte
                          ; of the two reals in w2 and w3
     wm  w1 x3-2
     ds. w1 a11.
     bz  w1 x3-1
     wm  w1 x2-2
     aa. w1 a11.
     ad  w1 -12
     ds. w1 a11.
     rl  w1 x2-2
     wm  w1 x3-2
     aa. w1 a11.
     bl  w2 x2
     ba  w2 x3            ; product in w0w1,w2
     sn  w0  0            ; if product=0 then
     rl. w2 a8.           ; w2= -4096
     sh. w2 (a7.)         ; start accumulation, firts assure number
                          ; with smallest 2-exponent in w0w1,w2
     jl.    c17.
     rx. w0 a5.
     rx. w1 a6.
     rx. w2 a7.
c17: ws. w2 a7.
     ad  w1 x2        ; shift of smallest addend
     aa. w1 a6.           ; addition
     nd. w1  11           ; and normalization
     ad  w1 -1
     ds. w1 a6.
     rl. w2 a7.
     am      1
     al  w2 x2            ; adjust exponent
     rs. w2 a7.
     rl. w3 b2.          ; counter for accum. product
     al  w3 x3-1
     sh  w3  0
     jl.    (b1.)
     rs. w3 b2.
     se. w3 (b7.)
     jl.   c14.
     rl. w2 a4.
     rs. w2 a6.
     rl. w2 b5.
     rs. w2 a1.
     jl.    6
c14: sl. w3 (b7.)
     jl.    c2.
     dl. w3 a6.
     al  w3 x3+4
     rs. w3 a6.
     jl.    c12.
c3:  sl  w2 -2048
     jl.    b9.
     al  w0  0
     ac  w1 -2048
     jl.    (b6.)
b9:  sl. w2  (a9.)
     jl.    c16.
c15: ad  w1  1
     hl  w1  5
     jl.    (b6.)
c16: ds. w1 a11.
     al  w1  8
     ci  w1 x2
     dl. w1 a11.
     jl.    c15.
a8:     -4096
a9:      2048
          4
a10:      4
a0:        0
a3:       0
a1:       0
a2:       0
a4:      0
a5:       0
a6:       0
a7:       0
          0
a11:      0
b1:       0
b2:       0
b4:       0
b5:       0
b6:       0
b7:       0
h.    0,r. (:10504-k:) w.
     <:scalpr     <0>:>
e.

;scalpr
g0:
g1:      1
     0,0,0,0
     1<23+e1-e2
     4<18+26<12+26<6+13  ; real procedure scalpr(n,A,B);
         0                   ; value n; integer n; array A,B;
     4<12+e0-e2
     1<12+0
n.
▶EOF◀