|
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: 16896 (0x4200)
Types: TextFile
Names: »epusingletx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦this⟧
; epu_simulator_sin * page 1 7 12 79, 16.13;
(
epu_single = set 1
epumode = set bs epusingle
workhigh = set bs epusingle
worklow = set bs epusingle
epu_single = slang entry.no
epusingle epumode workhigh worklow
)
b. ;outermost block
p. <:fpnames:>
m. girc 4000 epu_simulator_single_precision 21.11.79
\f
; epu_simulator_sin * page 2 7 12 79, 16.13;
; long procedure epu_single(epu, word);
; _____________________________________
;
; epu_single (return, long)
; exp_lim shift 36 + status shift 24
; + bytes processed
; status result
; 0 normal answer
; 1 illegal operation
; 2 illegal stop
;
; epu (call, zone)
; the epu instructions to be executed
;
; word (call, integer)
; the number of bytes peu instructions
; to be executed
;
; the procedure simulates the external processor epu in single
; real precition
\f
; epu_simulator_sin * page 3 7 12 79, 16.13;
b. g1, e20 ; block with names for tail and insertproc
w.
k=10000 ; load addr
s. g10, j71, a10, b4,c4, d11, i40 ; start of slang segm
h.
g0=0 ; number of extern.
e5:
g1: g3, g2 ; headword: rel of last point, absword
; abswords :
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+10:)>1; g10 = 10;
; extern. list:
w.
e0: g0 ; number of extern.
g10 ; number of bytes to be initialied
1 ; epu_mode
f.
0.0 ; work high
0.0 ; work low
w.
g10=k-e0-4
; continuation address on next segm of ext.list
g9
g4:
c.g4-e5-506
m. code epu_single too long on segm one
z.
c.502-g4+e5
jl -1 , r.252-(:g4-e5:)>1 ; fill with -1
z.
<:epusingl<0><0>:>
; slut første segm ;
; ******************** ;
\f
; epu_simulator_sin * page 4 7 12 79, 16.13;
; 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 register expression
j13: g0+13, 0 ; do 13: last used
j18: g0+18, 0 ; do 18: zone index alarm
j30: g0+30, 0 ; do 30: saved stack ref. saved w3
j70: 0, 5 ; first own : work_high
j71: 0, 9 ; second own : work_low
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
; epu_simulator_sin * page 5 7 12 79, 16.13;
; stack picture :
; addr at entry working
;
; -6 : non addr A(i)
; -4 ; non addr B(i)
; -2 ; non count
;
; last used : stack ref at call the same
; +2 : segm table addr the same
; +4 : appetite, rel returnpoint the same
;
; +6 : 6<12 + 23 first storage
; +8 : absaddr zonedescr last storage
; +10 : 26 continution addr
; +12 : absadddr baseword explim
;
d0: -1 < 1 ; remove last bit constant
d1: 6 ;
d2: 1 949 686 ; constant a <* used in sqrt *>
f.
d3: 0.0 ; radicand
d4: -'280 ; constant at singularity
w.
\f
; epu_simulator_sin * page 6 7 12 79, 16.13;
w.
e1:
; entrypoint epu_single
; **********
al w1 -6 ; reserve 6 bytes
jl. w3 (j3.) ;
al w2 x1+6 ; w2 := last used
ds. w3 (j30.) ; saved w3,last used
; take params
dl w1 x2+12 ; take bytes used
so w0 16 ; if expression
jl. w3 (j4.) ; then take this
ds. w3 (j30.) ;
dl w1 x1 ; take value
rl w3 x2+10 ; take first formal
sz w3 1 ; if real
cf w1 0 ; then convert to integer
am (x2+8) ;
dl w0 +2 ; load firs, last storage
rs w3 x2+10 ; store continuation addr
rs w3 x2+6 ; store first storage
wa w1 6 ; w1 := w1 + w3 <* last storage used *>
sl w0 x1 ; if last storage < last used
jl. a0. ; then
ws w1 6 ; w1 := index;
rs. w2 (j13.) ; index alarm
jl. w3 (j18.) ; zone index alarm ;
a0: rs w1 x2+8 ; store last used storage
rl w3 x1-4 ; w3 := last instruction
al w0 35 ; explim := 35;
rs w0 x2+12 ;
al w0 0 ; w0 := 0;
ws w1 x2+6 ; w1 := used bytes;
wd. w1 d1. ; rem := (last-first) mod 6;
sn. w3 (d9.) ; if last instruction <> legal stop
se w0 0 ; or rem <> 0
jl. c0. ; then goto illegal stop
jl. b0. ; goto take next op and decode
; illegal stop :
c0: am 2 ; illegal stop
; legal stop:
i4: al w3 0 ; normal
rl w1 x2+10 ;
; set answer :
i5: ; bytes:= continuation addr
ws w1 x2+6 ; - first storage;
rl w0 x2+12 ; take explim
hs w0 0 ; shift 12
hl w0 7 ; add status extract 12;
rs. w2 (j13.) ; release stack
jl. w3 (j6.) ; end register expr.
; illegal :
i7: al w3 1 ; illegal
rl w1 x2+10 ; take cont addr
al w1 x1-6 ; set to last accepted op
jl. i5. ; goto set answer
\f
; epu_simulator_sin * page 7 7 12 79, 16.13;
; set operation counter :
b0: rl w3 x2+10 ; take operation addr
al w3 x3+6 ; move to next
rs w3 x2+10 ; save addr
; take next operation and decode :
rl w1 x3-4 ; load operation
sn. w1 (d9.) ; if op = legal stop
jl. i4. ; then goto legal stop
sl w1 0 ; if clear
jl. a2. ; then
dl. w0 d11. ;
ds. w0 (j70.) ; set zero
ds. w0 (j71.) ;
a2: bl w3 3 ; load count
sn w3 0 ; if count = 0
jl. b0. ; then goto set operation counter;
ls w1 1 ; remove clear bit
bl w1 2 ; load 2*operation
sh w1 10 ; if hardware_op
jl. i10. ; then goto take op addr
sl w1 17 ; if op > 16
jl. i7. ; then goto illegal
sn w1 16 ; if operation = chl
jl. i21. ; then goto check cholesky
se w1 14 ; if operation = dia
jl. i9. ; then goto check count
rs w3 x2+12 ; store explim
jl. i10. ; goto op addr
; check counter
i9: se w3 1 ; if count <> 1
jl. i7. ; then goto illegal
; take operation address :
i10: rs w3 x2-2 ; save count
dl w0 (x2+10) ; take adresses
la. w3 d0. ; remove last bit
la. w0 d0. ; remove last bit
ds w0 x2-4 ; save op addr
sl w1 10 ; if operation MONITOR-ware
jl. a8. ; goto branch to monitorware
rl. w1 x1+d5. ; load branch addr relative
jl. b3. ; goto branch
b1: ds. w0 (j70.) ; store result
; load count : loop :
b2: rl w3 x2-2 ; load count
al w3 x3-1 ; count := count - 1;
sh w3 0 ; if count = 0
jl. b0. ; then goto set op count
rs w3 x2-2 ; save count
al w3 4 ; w3 :=
al w0 4 ; w0 := 4;
aa w0 x2-4 ; w3 := a + 4;
ds w0 x2-4 ; w0 := b + 4; and store;
; branch to HARDWARE-operation :
b3: jl. x1 ; goto operation
\f
; epu_simulator_sin * page 8 7 12 79, 16.13;
; ADD :
a3: dl w0 x3 ; load A(i)
fa. w0 (j70.) ; add RR
jl. b1. ; goto store RR
; SUB :
a4: dl. w0 (j70.) ; load RR
fs w0 (x2-6) ; sub A(i)
jl. b1. ; goto store RR
; MLA :
a5: dl w0 x3 ; load A(i)
fm w0 (x2-4) ; mult B(i)
fa. w0 (j70.) ; add RR
jl. b1. ; goto store RR
; MLS :
a6: dl. w0 d11. ;
fs w0 (x2-6) ; load -A(i)
fm w0 (x2-4) ; mult B(i)
fa. w0 (j70.) ; add RR
jl. b1. ; goto store RR
; STR :
a7: dl. w0 (j70.) ; load RR
ds w0 (x2-6) ; A(i) := RR
dl. w0 (j71.) ; load RR
ds w0 (x2-4) ; B(i) := RR
jl. b2. ; goto load count
\f
; epu_simulator_sin * page 9 7 12 79, 16.13;
; branch to MONITORWARE operation :
a8: rl. w3 x1+d5. ; load relative addr;
a9: jl. x3 ; branch to operation
; DIV :
i12: dl. w0 (j70.) ; load RR
fd w0 (x2-4) ; div A
ds w0 (x2-6) ; A := RR / B;
jl. b0. ;
; DIA :
i13: dl. w0 (j70.) ; load RR
bl w1 1 ; take exp for zerotest
sn w1 -2048 ; if float_zero
jl. i15. ; then goto singular by zero
ds. w0 d3. ; store radicand
al w0 1 ; dia_result := 1;
sh w3 -1 ; if negative
al w0 2 ; then dia_result := 2;
; test exp loss :
i14: am (x2-6) ;
bl w1 +1 ; take exp of unreduced
bs. w1 d3.+1 ; - exp of radicand;
ds w1 (x2-4) ; store dia_result and exploss
sl w1 (x2+12) ; if exploss >= explim
jl. i16. ; then goto singular
dl. w0 d3. ; load radicand;
jl. i19. ; goto start sqrt
; singular by zero :
i15: al w0 4 ; dia_result := 4;
al w1 0 ; exploss := 0;
jl. i17. ; goto dia_result
; singular :
i16: al w0 3 ; dia_result := 3;
; store dia_result :
i17: ds w1 (x2-4) ;
dl. w0 d4. ; dia := - '280;
jl. i20. ; goto store sqrt
\f
; epu_simulator_sin * page 10 7 12 79, 16.13;
; SQRT :
i18: dl. w0 (j70.) ; load RR
bl w1 1 ; take exp for zerotest
sn w1 -2048 ; if float_zero
jl. i20. ; then goto store sqrt
ds. w0 d3. ; store radicand
; start sqrt :
i19: sl w3 0 ; if radicand > 0
jl. a10. ; then goto sqrt
dl. w0 d11. ; load zero
fs. w0 d3. ; radicand := - radicand
ds. w0 d3. ; store radicand
; sqrt :
; see prog index 75015; first appr a+b*x; 2**43 <= x < 2**45
; given b = 2**(-23) min relative errors
; for a = 0.929 682 927 462 * 2**21 = 1 949 686
; max rel errors = 0.036 for a=a/b and 2**45
a10: so w0 1 ; if even expo
am -1 ; then w3 := w3 // 8
ls w3 -2 ; else w3 := w3 // 4 ;
rl w2 6 ; store radicand
rl. w1 d2. ; w1 := a;
wa w1 6 ;
wa w1 6 ; w1 := a + x * 2**(-24);
; newton integer :
wd w0 2 ; w3 := w3 // w1;
wa w1 0 ; w1 := w0 + w1;
ls w1 -1 ; w1 := w1 // 2;
rl w3 4 ; load long radicand
wd w0 2 ; w3 := w3 // w1
wa w1 0 ; w1 := w0 + w1;
sx 2.010 ; iterand := if -, ouflow
ls w1 -1 ; w1 else w1//2;
; prepare for newton real
dl. w0 d3. ; load real radicand
bl w2 1 ; w2 := expo(radicand);
al w2 x2+1 ; w2 := w2 + 1;
as w2 -1 ; w2 := w2 // 2;
bz w2 5 ; expo(iterand) := w2 extract 12;
; newton real :
fd w0 4 ; radicand / iterand
fa w0 4 ; plus iterand
bl w2 1 ; load expo
al w2 x2-1 ; expo := expo - 1;
hl w0 5 ; iterand := iterand / 2;
; restore w1, w2
am. (j30.) ;
rl w2 -2 ; w2 := last used
; store sqrt :
i20: ds w0 (x2-6) ; store result;
jl. b0. ; goto take next operation
\f
; epu_simulator_sin * page 11 7 12 79, 16.13;
; check cholesky :
i21:
; test of preceeding operation
rs w3 x2+12 ; save explim
rl w3 x2+10 ;
la. w3 d0. ; remove last bit
bz w0 x3-9 ; w0 := count of preceeding operation
bl w1 x3-10 ; w1 := precedding operation
se w1 -1<11+3 ; if -, zmls
sn w1 -1<11+2 ; or -, zmla
jl. i33. ; then
jl. i32. ; goto test mls
i33: as w0 2 ; w0, w1 := 4 * count;
rl w1 0 ; w0, w1 := a + 4*count, b + 4*count
aa w1 x3-6 ; add addr <* result = dia elem *>
la. w0 d0. ; remove last bit
la. w1 d0. ; remove last bit
ds w1 x2-4 ; save addr
;rl w3 x3-6 ; load addr;
;la. w3 d0.
;se w1 x3 ; if count <> 0
;jl. i22. ; then goto add A
;dl w0 (x2-6) ; load A
;jl. i23. ; goto store;
i22: dl. w0 (j70.) ; load RR
fa w0 (x2-6) ; add A
i23: ds. w0 (j70.) ; save RR
; decide dia or div
se w1 (x2-6) ; if a <> b
jl. i12. ; then goto div
am (x2+10) ;
rl w3 -2 ; w3 := col_status_addr <* = c *>
la. w3 d0. ; remove last bit
rs w3 x2-4 ; store addr
jl. i13. ; goto dia
; test mls or mla :
i32: se w1 3 ; if mls
sn w1 2 ; or mla
jl. i33. ; then goto load addr
jl. i7. ; else goto illegal
d5: a3 - b3 ; ADD addr rel to jump
a4 - b3 ; SUB addr rel to jump
a5 - b3 ; MLA addr rel to jump
a6 - b3 ; MLS addr rel to jump
a7 - b3 ; STR addr rel to jump
i12 - a9 ; DIV addr rel to jump
i18 - a9 ; SQR addr rel to jump
i13 - a9 ; DIA addr rel to jump
; i21 - a9 ; CHL addr rel to jump ( not used );
d9: 4095<12 + 1 ; STP 1 ; legal stop test;
f.
d11: 0.0 ; float zero
w.
\f
; epu_simulator_sin * page 12 7 12 79, 16.13;
g8:
c.g8-e8-506
m. code epusingle too long segm 2
z.
c.502-g8+e8
jl -1 , r.252-(:g8-e8:)>1 ; fill with -1
z.
<:epusingle<0><0>:>
i.
e.
; entry tails :
e18=1<23+4
e19=-1
e20=4<12
; epu_single
g0: 2 ; first tail : 2 segm
0 , 0, 0, 0 ; fill
1<23+0<12+e1-e8 ; entrypoint
5<18+13<12+8<6+0, 0 ; long proc, integer value, zone
4<12 + e0-e5 ; code proc start of extern. list
e17 ; 1 code segm. bytes in perm core
; epu_mode
e18 ; modekind bs
0, 0, 0, 0 ; fill
e19=e19+2
e19 ; byte addr in own core
9<18, 0 ; spec own integer
e20 ; code var, start of ext list
e17 ; code segm, bytes in own core
; work_high
e18 ; modekind bs
0, 0, 0, 0 ; fill
e19=e19+4
e19 ; byte addr in own core
10<18, 0 ; spec own real
e20 ; code var, start of ext list
e17 ; code segm, bytes in own core
; work_low
g1: e18 ; modekind bs
0, 0, 0, 0 ; fill
e19=e19+4
e19 ; byte addr in own core
10<18, 0 ; spec own real
e20 ; code var, start of ext list
e17 ; code segm, bytes in own core
e17=1<12+e19+1
p.<:insertproc:>
e. ; stop outermost block
if ok.no
( mode 0.yes
message epusingle not ok
lookup epusingle )
if 0.no
(
if 1.yes
scope project,
epumode,
workhigh,
worklow
if 2.yes
scope user,
epumode,
workhigh,
worklow
)
lookup epusingle epumode ,
workhigh worklow
end
finis
▶EOF◀