home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / factor.s < prev    next >
Encoding:
Text File  |  1979-01-10  |  4.2 KB  |  352 lines
  1. .globl    sqrt
  2. exit = 1.
  3. read = 3.
  4. write = 4.
  5. ldfps = 170100^tst
  6. /
  7.     ldfps    $240
  8.  
  9.     clr    argflg
  10.     cmp    (sp)+,$2
  11.     blt    begin
  12.     tst    (sp)+
  13.     mov    (sp),r2
  14.     jsr    r5,atof; getch1
  15.     inc    argflg
  16.     br    begin1
  17. begin:
  18.     tst    argflg
  19.     beq 9f; sys exit; 9:
  20.     jsr    r5,atof; getch
  21. begin1:
  22.     tstf    fr0
  23.     cfcc
  24.     bpl 9f; jmp ouch; 9:
  25.     bne 9f; sys exit; 9:
  26.     cmpf    big,fr0
  27.     cfcc
  28.     bgt 9f; jmp ouch; 9:
  29. /
  30.     movf    fr0,n
  31.     jsr    pc,sqrt
  32.     movf    fr0,v
  33.     mov    $1,r0
  34.     sys    write; nl; 1
  35. /
  36.     movf    $one,fr0
  37.     movf    fr0,fr4
  38. /
  39.     movf    n,fr0
  40.     movf    $two,fr1
  41.     jsr    r5,xt
  42. /
  43.     movf    n,fr0
  44.     movif    $3,fr1
  45.     jsr    r5,xt
  46. /
  47.     movf    n,fr0
  48.     movif    $5,fr1
  49.     jsr    r5,xt
  50. /
  51.     movf    n,fr0
  52.     movif    $7,fr1
  53.     jsr    r5,xt
  54. /
  55.     movf    n,fr0
  56.     movif    $11.,fr1
  57.     jsr    r5,xt
  58. /
  59.     movf    n,fr0
  60.     movif    $13.,fr1
  61.     jsr    r5,xt
  62. /
  63.     movf    n,fr0
  64.     movif    $17.,fr1
  65.     mov    $tab+6,r4
  66.     jsr    pc,xx
  67.     jmp    begin
  68. /
  69. xt:
  70.     movf    fr0,fr2
  71.     divf    fr1,fr2
  72.     modf    $one,fr2
  73.     movf    fr3,fr2
  74.     mulf    fr1,fr2
  75.     cmpf    fr2,fr0
  76.     cfcc
  77.     beq    hit2
  78.     rts    r5
  79. /
  80. /
  81. out1:
  82.     mov    $tab,r4
  83.     br    in1
  84.  
  85. out2:
  86.     modf    fr4,fr2
  87.     cfcc
  88.     bne 9f; mov $xx0,-(sp); jmp hit; 9:
  89.     br    in2
  90. xx:
  91.     mov    (r4)+,kazoo
  92. xx0:
  93.     mov    $kazoo,r0
  94.     mov    $100.,r1
  95.     clr    r2
  96.     mov    $gorp,r3
  97.     mov    $gorp+6,r5
  98. xx1:
  99.     movf    fr0,fr2
  100.     divf    fr1,fr2
  101.     cmp    r4,$tabend
  102.     bhis    out1
  103. in1:
  104.     movf    fr2,(r3)
  105.     bit    r2,(r5)
  106.     beq    out2
  107. in2:
  108. kazoo    =.+2
  109.     addf    $kazoo,fr1
  110.     mov    (r4)+,(r0)
  111.     sob    r1,xx1
  112.     mov    $100.,r1
  113.     mov    $127.,r2
  114.     cmpf    v,fr1
  115.     cfcc
  116.     bge    xx1
  117.     cmpf    $one,fr0
  118.     cfcc
  119.     beq    1f
  120.     mov    $1,r0
  121.     sys    write; sp5; 5
  122.     movf    n,fr0
  123.     jsr    r5,ftoa; wrchar
  124.     mov    $1,r0
  125.     sys    write; nl; 1
  126. 1:
  127.     rts    pc
  128. /
  129. /
  130. /
  131. hit2:
  132.     movf    fr1,t
  133.     movf    fr3,n
  134.     movf    fr3,fr0
  135.     jsr    pc,sqrt
  136.     movf    fr0,v
  137.     mov    $1,r0
  138.     sys    write; sp5; 5
  139.     movf    t,fr0
  140.     jsr    r5,ftoa; wrchar
  141.     mov    $1,r0
  142.     sys    write; nl; 1
  143.     movf    n,fr0
  144.     movf    t,fr1
  145.     cmp    r4,$tab
  146.     bne    1f
  147.     mov    $tabend,r4
  148. 1:
  149.     mov    -(r4),kazoo
  150.     jmp    xt
  151. /
  152. hit:
  153.     movf    fr1,t
  154.     movf    fr3,n
  155.     movf    fr3,fr0
  156.     jsr    pc,sqrt
  157.     movf    fr0,v
  158.     mov    $1,r0
  159.     sys    write; sp5; 5
  160.     movf    t,fr0
  161.     jsr    r5,ftoa; wrchar
  162.     mov    $1,r0
  163.     sys    write; nl; 1
  164.     movf    n,fr0
  165.     movf    t,fr1
  166.     mov    $kazoo,r0
  167.     rts    pc
  168. /
  169. /
  170. /    get one character from the console.
  171. /    called from atof.
  172. /
  173. getch:
  174.     clr    r0
  175.     sys    read; ch; 1
  176.     bec 9f; sys exit; 9:
  177.     tst r0; bne 9f; sys exit; 9:
  178.     mov    ch,r0
  179.     rts    r5
  180. /
  181. /
  182. /    get one character form the argument string.
  183. getch1:
  184.     movb    (r2)+,r0
  185.     rts    r5
  186. /
  187. /    write one character on the console
  188. /    called from ftoa.
  189. /
  190. wrchar:
  191.     mov    r0,ch
  192.     mov    $1,r0
  193.     sys    write; ch; 1
  194.     rts    r5
  195. /
  196. /
  197. /    read and convert a line from the console into fr0.
  198. /
  199. atof:
  200.     mov    r1,-(sp)
  201.     movif    $10.,r3
  202.     clrf    r0
  203. 1:
  204.     jsr    r5,*(r5)
  205.     sub    $'0,r0
  206.     cmp    r0,$9.
  207.     bhi    2f
  208.     mulf    r3,r0
  209.     movif    r0,r1
  210.     addf    r1,r0
  211.     br    1b
  212. 2:
  213.     cmp    r0,$' -'0
  214.     beq    1b
  215. /
  216.     mov    (sp)+,r1
  217.     tst    (r5)+
  218.     rts    r5
  219.  
  220. /
  221. /
  222. /
  223. /
  224. ftoa:
  225.     mov    $ebuf,r2
  226. 1:
  227.     modf    tenth,fr0
  228.     movf    fr0,fr2
  229.     movf    fr1,fr0
  230.     addf    $epsilon,fr2
  231.     modf    $ten,fr2
  232.     movfi    fr3,r0
  233.     movb    r0,-(r2)
  234.     tstf    fr0
  235.     cfcc
  236.     bne    1b
  237. 1:
  238.     movb    (r2)+,r0
  239.     add    $60,r0
  240.     jsr    r5,*(r5)
  241.     cmp    r2,$ebuf
  242.     blo    1b
  243.     tst    (r5)+
  244.     rts    r5
  245. /
  246. epsilon = 037114
  247. tenth:    037314; 146314; 146314; 146315
  248.     .bss
  249. buf:    .=.+18.
  250. ebuf:
  251.     .text
  252. /
  253. /
  254. /
  255. /    complain about a number which the program
  256. /    is unable to digest
  257. ouch:
  258.     mov    $2,r0
  259.     sys    write; 1f; 2f-1f
  260.     jmp    begin
  261. /
  262. 1:    <Ouch.\n>
  263. 2:    .even
  264. /
  265. /
  266. one    = 40200
  267. two    = 40400
  268. four    = 40600
  269. ten    = 41040
  270. /
  271.     .data
  272. big:    056177; 177777; 177777; 177777
  273. nl:    <\n>
  274. sp5:    <     >
  275.     .even
  276. /
  277. tab:
  278.     41040; 40400; 40600; 40400; 40600; 40700; 40400; 40700
  279.     40600; 40400; 40600; 40700; 40700; 40400; 40700; 40600
  280.     40400; 40700; 40600; 40700; 41000; 40600; 40400; 40600
  281.     40400; 40600; 41000; 40700; 40600; 40700; 40400; 40600
  282.     40700; 40400; 40700; 40700; 40600; 40400; 40600; 40700
  283.     40400; 40700; 40600; 40400; 40600; 40400; 41040; 40400
  284. tabend:
  285. /
  286.     .bss
  287. ch:    .=.+2
  288. t:    .=.+8
  289. n:    .=.+8
  290. v:    .=.+8
  291. gorp:    .=.+8
  292. argflg:    .=.+2
  293.     .text
  294. ldfps = 170100^tst
  295. stfps = 170200^tst
  296. /
  297. /    sqrt replaces the f.p. number in fr0 by its
  298. /    square root.  newton's method
  299. /
  300. .globl    sqrt, _sqrt
  301. /
  302. /
  303. _sqrt:
  304.     mov    r5,-(sp)
  305.     mov    sp,r5
  306.     movf    4(r5),fr0
  307.     jsr    pc,sqrt
  308.     mov    (sp)+,r5
  309.     rts    pc
  310.  
  311. sqrt:
  312.     tstf    fr0
  313.     cfcc
  314.     bne    1f
  315.     clc
  316.     rts    pc        /sqrt(0)
  317. 1:
  318.     bgt    1f
  319.     clrf    fr0
  320.     sec
  321.     rts    pc        / sqrt(-a)
  322. 1:
  323.     mov    r0,-(sp)
  324.     stfps    -(sp)
  325.     mov    (sp),r0
  326.     bic    $!200,r0        / retain mode
  327.     ldfps    r0
  328.     movf    fr1,-(sp)
  329.     movf    fr2,-(sp)
  330. /
  331.     movf    fr0,fr1
  332.     movf    fr0,-(sp)
  333.     asr    (sp)
  334.     add    $20100,(sp)
  335.     movf    (sp)+,fr0    /initial guess
  336.     mov    $4,r0
  337. 1:
  338.     movf    fr1,fr2
  339.     divf    fr0,fr2
  340.     addf    fr2,fr0
  341.     mulf    $half,fr0    / x = (x+a/x)/2
  342.     sob    r0,1b
  343. 2:
  344.     movf    (sp)+,fr2
  345.     movf    (sp)+,fr1
  346.     ldfps    (sp)+
  347.     mov    (sp)+,r0
  348.     clc
  349.     rts    pc
  350. /
  351. half    = 40000
  352.