|
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: 9984 (0x2700)
Types: TextFile
Names: »iabs3tx «, »iabstx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »iabs3tx «
└─⟦this⟧ »iabstx «
b. g1,e20 w.
k=10000
d.
p. <:fpnames:>
l.
s. a30,b20,j50,c5
; slang segment containing abs, mod, max, min
h.
e10: b0 ,b0 ; headword, abswords
j1: 0 ,1 ; own core (1) : kind wanted
j3: 3 ,0 ; reserve
j4: 48 ,0 ; take expression
j6: 6 ,0 ; end register expression
j7: 7 ,0 ; end uv-expression
j12: 12 ,0 ; uv
j13: 13 ,0 ; last used
j29: 29 ,0 ; param alarm
j30: 30 ,0 ; saved stack-ref
b0=k-2-e10
w.
e0: 0 ; external list
0 ;
s3 ; date
s4 ; time
f. -1.0 ; flotingpoint 1
c1=k-2
f. 0.5 ; - 0.5
c3=k-2
w.
a8 : 0 ; addr (y)
a10: 0 ; sign
0 ; result (1)
a11: 0 ; result (2)
\f
; procedure get param (no, kind wanted);
;
; w0
; w1 addr param
; w2 last used
; w3 link link
;
; entry a7: first param, kind real
; entry a1: first param, kind integer
; entry a5: sec. param, kind same as first
;
; notice : first formal (2) = x2+8 is destroyed (return)
a7: am 1 ; get first real:
a1: al w0 0 ; get first integer:
rs. w0 (j1.) ; save kind wanted;
rl. w2 (j13.) ; w2 := last used;
ds. w3 (j30.) ; save sref, w3;
ws. w3 (e10.) ; rel of return := return - addr head word;
dl w1 x2+8 ; take first formal;
a12: rs w3 x2+8 ; next param: first formal (2) := rel of return;
rl. w3 (j1.) ; get kind wanted
lx w3 0 ; logical excl. or actual kind;
sz w3 1 ; if no agreement then
jl. w3 (j29.) ; param alarm;
so w0 16 ; if expression then
jl. w3 (j4.) ; take expression;
ds. w3 (j30.) ; save sref, w3;
rl w3 x2+8 ; return :=
wa. w3 (e10.) ; rel of return + addr head word;
jl x3 ; return;
a5: ws. w3 (e10.) ; get second, same kind as first:
rl. w2 (j13.) ; w2 := last used;
dl w1 x2+12 ; get second formal;
jl. a12. ; goto next;
\f
e1: jl. w3 a1. ; iabs(x); get(x);
rl w1 x1 ; get value x;
sh w1 -1 ; if x<0
ac w1 x1 ; then i:= -i;
jl. (j6.) ; exit
e2: jl. w3 a7. ; abs(x); get(x);
dl w1 x1 ; get value x;
sh w0 -1 ; if x<0 then
fm. w1 c1. ; x:= -x;
jl. (j6.) ; exit
e3: jl. w3 a1. ; imod(x,y) == x imod y; get(x);
rs w1 x2+6 ; first formal (1) := addr x;
jl. w3 a5. ; get (y);
al w3 x1 ; w3 := addr y;
dl w1 (x2+6) ; w0w1 := value x;
bl w0 2 ; extend sign
bl w0 0 ;
wd w1 x3 ; (w0,w1):= entier(x/y);
ad w1 -24 ; (w0,w1):= remainder:= x imod y;
jl. (j6.) ;
e6: ; ifix(x);
jl. w3 a7. ; w0w1 := real get(x);
dl w1 x1 ; get value x;
rl w3 0 ; w3 := sign of param;
sh w3 -1 ;
fm. w1 c1. ; w0w1 := abs(x)
fs. w1 c3. ; - 0.5;
cf w1 0 ; w1 := entier(x);
sh w3 -1 ;
ac w1 x1 ; w1 := sign(x) * abs ( round (x - 0.5) );
jl. (j6.) ; return;
e7: ; float(i);
jl. w3 a1. ; w1 := integer get(x);
rl w1 x1 ; get value x;
ci w1 0 ; w0w1 := float(i);
jl. (j6.) ; return;
\f
e4: jl. w3 a7. ; mod (x, y): get (x);
rs w1 x2+6 ; first formal (1) := addr x;
jl. w3 a5. ; get (y);
rs. w1 a8. ; save addr y;
al w3 x1 ; w3 := addr y;
dl w1 (x2+6) ; get value x;
fd w1 x3 ; quot := x/y;
rs. w0 a10. ; sign := sign (quot);
sh w0 -1 ;
fm. w1 c1. ; quot := abs (quot);
ds. w1 a11. ; save quot;
el w3 3 ; shifts := 47 -
ac w3 x3-47 ; exp (quot);
al w0 -1 ; mask :=
al w1 -1 ; if shifts > 11 then
sh w3 11 ; extend (-1) shift shifts addd 2047
jl. a9. ; else
ld w1 x3 ; extend (-1);
al w3 -1 ;
hs w3 3 ;
a9: la. w0 a11.-2 ; quot :=
la. w1 a11. ; logand (mask, quot) *
rl. w3 a10. ; sign ;
sl w3 0 ;
fm. w1 c1. ; mod :=
fm. w1 (a8.) ; x -
fa w1 (x2+6) ; quot * y;
ds. w1 (j12.) ; uv := mod;
jl. (j7.) ; goto end uv-expression;
\f
e11: al w0 -4 ;imini:(llloo)
jl. a19. ;
e12: al w0 0 ;imaxi:(ooooo)
jl. a19. ;
e13: al w0 -2 ;rmini:(llllo)
jl. a19. ;
e14: al w0 2 ;rmaxi:(ooolo)
jl. a19. ;
e15: al w0 -1 ;rminr:(lllll)
jl. a19. ;
e16: al w0 3 ;rmaxr:(oooll)
jl. a19. ;
e17: al w0 -3 ;iminr:(lllol)
jl. a19. ;
e18: al w0 1 ;imaxr:(ooool)
jl. a19. ;
a19: rl. w2 (j13.) ;load last used
ds. w3 (j30.) ;
al w1 -18 ;
jl. w3 (j3.) ;call reserve
ds. w3 (j30.) ;save w23
al w1 x2+6 ;load first param
ba w1 x2+4 ;set lastparam
al w3 x2+9 ;set nextparam
ds w0 x2-2 ;store mark
rs w1 x2-6 ;
al w3 0 ;mark first call
jl. a20. ;call getparam
a24: ds w1 x2-10 ;return1: set old=first param
a21: dl w0 x2-4 ;loop: load paramaddresses
sl w0 x3 ;if lastparam<=nextparam
jl. a22. ;then goto fin
jl. w3 a20. ;call getparam
a25: ds w1 x2-14 ;return2: store new
fs w1 x2-10 ;w01=new-old
lx w0 x2-2 ;w0=sign(w01*mark)
sh w0 0 ;if w0<=0
jl. a21. ;then goto loop
dl w1 x2-14 ;load new
ds w1 x2-10 ;set old=new
jl. a21. ;goto loop
a22: dl w1 x2-10 ;fin: load old
rl w3 x2-2 ;load mark
so w3 2 ;if result=type integer
cf w1 0 ;then convert
rs. w2 (j13.) ;restore last used
jl. (j6.) ;return
a20: rs w3 x2-8 ;procedure getparam
dl w1 (x2-4) ;load formals
so w0 16 ;if expression
jl. w3 (j4.) ;then call takeexpr
ds. w3 (j30.) ;save w23
rl w3 x2-4 ;load nextparam
al w3 x3+4 ;change nextparam
rs w3 x2-4 ;store nextparam
rl w3 x3-6 ;load kind
sl w1 (x2-6) ;if opaddr>lastparam
jl. a26. ;then goto on
sl w1 x2+6 ;if opaddr>first param addr
rs w1 x2-6 ;then change lastparam
a26: dl w1 x1 ;on: load op
so w3 1 ;if integer
ci w1 0 ;then convert
rl w3 x2-8 ;load return
sn w3 0 ;if return=0
jl. a24. ;then goto return1
jl. a25. ;else goto return2
e5: 0,r.(:504-e5+e10:)/2 ; fill
<:fortranfct.<0>:>
m. fortranfct 1985.09.30
i.e.
;tail
;iabs(x)
g0: 1 ; size of area= 1 segment
0,0,0,0 ; fill
1<23+ e1-e10 ; entry for iabs
3<18+13<12,0 ; integer proc(value integer)
4<12+ e0-e10 ; codeproc, adr of external list
1<12+ 2 ; 1 code-segment
;abs(x)
1<23+4 ; backingstorage
0,0,0,0 ; fill
1<23+ e2-e10 ; entry on segment
4<18+14<12,0 ; real proc(value real);
4<12+ e0-e10 ;
1<12+ 2
;imod(x,y)
1<23+4
0,0,0,0
1<23+ e3-e10 ; entry
3<18+13<12+13<6,0; int proc(value int,value int);
4<12+ e0-e10 ;
1<12+ 2 ;
;mod(x/y);
1<23+4 ;
0,0,0,0 ;
1<23+ e4-e10 ; entry
4<18+14<12+14<6,0; real proc(value real,value real);
4<12+ e0-e10 ;
1<12+ 2
;ifix(x)
1<23+4 ;
0,0,0,0 ;
1<23+ e6-e10 ; entry
3<18+14<12 , 0 ; integer proc(value real)
4<12+ e0-e10 ;
1<12+ 2 ;
;float(x)
1<23+4 ;
0,0,0,0 ;
1<23+ e7-e10 ; entry
4<18+13<12 , 0 ; real procedure(value integer)
4<12+ e0-e10 ;
1<12+ 2 ;
\f
;imini(min0)
1<23+4
0,0,0,0,
1<23+e11-e10
3<18+40<12+13<6
0
4<12+e0-e10
1<12+2
;imaxi(max0)
1<23+4
0,0,0,0,
1<23+e12-e10
3<18+40<12+13<6
0
4<12+e0-e10
1<12+2
;rmini(amin0)
1<23+4
0,0,0,0,
1<23+e13-e10
4<18+40<12+13<6
0
4<12+e0-e10
1<12+2
;rmaxi(amax0)
1<23+4
0,0,0,0,
1<23+e14-e10
4<18+40<12+13<6
0
4<12+e0-e10
1<12+2
;iminr(min1)
1<23+4
0,0,0,0,
1<23+e17-e10
3<18+40<12+14<6
0
4<12+e0-e10
1<12+2
;imaxr(max1)
1<23+4
0,0,0,0,
1<23+e18-e10
3<18+40<12+14<6
0
4<12+e0-e10
1<12+2
;rminr(amin1)
1<23+4
0,0,0,0,
1<23+e15-e10
4<18+40<12+14<6
0
4<12+e0-e10
1<12+2
;rmaxr(amax1)
g1:1<23+4
0,0,0,0,
1<23+e16-e10
4<18+40<12+14<6
0
4<12+e0-e10
1<12+2
d.
p. <:insertproc:>
l.
▶EOF◀