V7/usr/src/cmd/factor.s
.globl sqrt
exit = 1.
read = 3.
write = 4.
ldfps = 170100^tst
/
ldfps $240
clr argflg
cmp (sp)+,$2
blt begin
tst (sp)+
mov (sp),r2
jsr r5,atof; getch1
inc argflg
br begin1
begin:
tst argflg
beq 9f; sys exit; 9:
jsr r5,atof; getch
begin1:
tstf fr0
cfcc
bpl 9f; jmp ouch; 9:
bne 9f; sys exit; 9:
cmpf big,fr0
cfcc
bgt 9f; jmp ouch; 9:
/
movf fr0,n
jsr pc,sqrt
movf fr0,v
mov $1,r0
sys write; nl; 1
/
movf $one,fr0
movf fr0,fr4
/
movf n,fr0
movf $two,fr1
jsr r5,xt
/
movf n,fr0
movif $3,fr1
jsr r5,xt
/
movf n,fr0
movif $5,fr1
jsr r5,xt
/
movf n,fr0
movif $7,fr1
jsr r5,xt
/
movf n,fr0
movif $11.,fr1
jsr r5,xt
/
movf n,fr0
movif $13.,fr1
jsr r5,xt
/
movf n,fr0
movif $17.,fr1
mov $tab+6,r4
jsr pc,xx
jmp begin
/
xt:
movf fr0,fr2
divf fr1,fr2
modf $one,fr2
movf fr3,fr2
mulf fr1,fr2
cmpf fr2,fr0
cfcc
beq hit2
rts r5
/
/
out1:
mov $tab,r4
br in1
out2:
modf fr4,fr2
cfcc
bne 9f; mov $xx0,-(sp); jmp hit; 9:
br in2
xx:
mov (r4)+,kazoo
xx0:
mov $kazoo,r0
mov $100.,r1
clr r2
mov $gorp,r3
mov $gorp+6,r5
xx1:
movf fr0,fr2
divf fr1,fr2
cmp r4,$tabend
bhis out1
in1:
movf fr2,(r3)
bit r2,(r5)
beq out2
in2:
kazoo =.+2
addf $kazoo,fr1
mov (r4)+,(r0)
sob r1,xx1
mov $100.,r1
mov $127.,r2
cmpf v,fr1
cfcc
bge xx1
cmpf $one,fr0
cfcc
beq 1f
mov $1,r0
sys write; sp5; 5
movf n,fr0
jsr r5,ftoa; wrchar
mov $1,r0
sys write; nl; 1
1:
rts pc
/
/
/
hit2:
movf fr1,t
movf fr3,n
movf fr3,fr0
jsr pc,sqrt
movf fr0,v
mov $1,r0
sys write; sp5; 5
movf t,fr0
jsr r5,ftoa; wrchar
mov $1,r0
sys write; nl; 1
movf n,fr0
movf t,fr1
cmp r4,$tab
bne 1f
mov $tabend,r4
1:
mov -(r4),kazoo
jmp xt
/
hit:
movf fr1,t
movf fr3,n
movf fr3,fr0
jsr pc,sqrt
movf fr0,v
mov $1,r0
sys write; sp5; 5
movf t,fr0
jsr r5,ftoa; wrchar
mov $1,r0
sys write; nl; 1
movf n,fr0
movf t,fr1
mov $kazoo,r0
rts pc
/
/
/ get one character from the console.
/ called from atof.
/
getch:
clr r0
sys read; ch; 1
bec 9f; sys exit; 9:
tst r0; bne 9f; sys exit; 9:
mov ch,r0
rts r5
/
/
/ get one character form the argument string.
getch1:
movb (r2)+,r0
rts r5
/
/ write one character on the console
/ called from ftoa.
/
wrchar:
mov r0,ch
mov $1,r0
sys write; ch; 1
rts r5
/
/
/ read and convert a line from the console into fr0.
/
atof:
mov r1,-(sp)
movif $10.,r3
clrf r0
1:
jsr r5,*(r5)
sub $'0,r0
cmp r0,$9.
bhi 2f
mulf r3,r0
movif r0,r1
addf r1,r0
br 1b
2:
cmp r0,$' -'0
beq 1b
/
mov (sp)+,r1
tst (r5)+
rts r5
/
/
/
/
ftoa:
mov $ebuf,r2
1:
modf tenth,fr0
movf fr0,fr2
movf fr1,fr0
addf $epsilon,fr2
modf $ten,fr2
movfi fr3,r0
movb r0,-(r2)
tstf fr0
cfcc
bne 1b
1:
movb (r2)+,r0
add $60,r0
jsr r5,*(r5)
cmp r2,$ebuf
blo 1b
tst (r5)+
rts r5
/
epsilon = 037114
tenth: 037314; 146314; 146314; 146315
.bss
buf: .=.+18.
ebuf:
.text
/
/
/
/ complain about a number which the program
/ is unable to digest
ouch:
mov $2,r0
sys write; 1f; 2f-1f
jmp begin
/
1: <Ouch.\n>
2: .even
/
/
one = 40200
two = 40400
four = 40600
ten = 41040
/
.data
big: 056177; 177777; 177777; 177777
nl: <\n>
sp5: < >
.even
/
tab:
41040; 40400; 40600; 40400; 40600; 40700; 40400; 40700
40600; 40400; 40600; 40700; 40700; 40400; 40700; 40600
40400; 40700; 40600; 40700; 41000; 40600; 40400; 40600
40400; 40600; 41000; 40700; 40600; 40700; 40400; 40600
40700; 40400; 40700; 40700; 40600; 40400; 40600; 40700
40400; 40700; 40600; 40400; 40600; 40400; 41040; 40400
tabend:
/
.bss
ch: .=.+2
t: .=.+8
n: .=.+8
v: .=.+8
gorp: .=.+8
argflg: .=.+2
.text
ldfps = 170100^tst
stfps = 170200^tst
/
/ sqrt replaces the f.p. number in fr0 by its
/ square root. newton's method
/
.globl sqrt, _sqrt
/
/
_sqrt:
mov r5,-(sp)
mov sp,r5
movf 4(r5),fr0
jsr pc,sqrt
mov (sp)+,r5
rts pc
sqrt:
tstf fr0
cfcc
bne 1f
clc
rts pc /sqrt(0)
1:
bgt 1f
clrf fr0
sec
rts pc / sqrt(-a)
1:
mov r0,-(sp)
stfps -(sp)
mov (sp),r0
bic $!200,r0 / retain mode
ldfps r0
movf fr1,-(sp)
movf fr2,-(sp)
/
movf fr0,fr1
movf fr0,-(sp)
asr (sp)
add $20100,(sp)
movf (sp)+,fr0 /initial guess
mov $4,r0
1:
movf fr1,fr2
divf fr0,fr2
addf fr2,fr0
mulf $half,fr0 / x = (x+a/x)/2
sob r0,1b
2:
movf (sp)+,fr2
movf (sp)+,fr1
ldfps (sp)+
mov (sp)+,r0
clc
rts pc
/
half = 40000