home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / s1 / dc2.s < prev    next >
Encoding:
Text File  |  1975-05-13  |  5.9 KB  |  458 lines
  1. /
  2. /
  3. /    routine to add the two centennial numbers
  4. /    pointed to by r2 and r3.
  5. /    a pointer to the result is returned in r1
  6. /    r2 and r3 are preserved
  7. /
  8. /    mov    ptr1,r2
  9. /    mov    ptr2,r3
  10. /    jsr    pc,add3
  11. /    mov    r1,...
  12. /
  13. add3:    mov    r0,-(sp)
  14.     mov    r4,-(sp)
  15.     mov    r5,-(sp)
  16.     mov    r3,-(sp)
  17.     mov    r2,-(sp)
  18. /
  19. /    allocate a new string whose length is
  20. /    the max of the two addends.
  21. /
  22.     mov    w(r2),r0
  23.     sub    a(r2),r0
  24.     mov    w(r3),r4
  25.     sub    a(r3),r4
  26.     cmp    r0,r4
  27.     bgt    1f
  28.     mov    r4,r0
  29. 1:    mov    r0,r4
  30.     jsr    pc,allocate
  31.     mov    r1,-(sp)
  32. /
  33. /    get everything ready
  34. /
  35.     mov    2(sp),r1
  36.     jsr    pc,rewind
  37.     mov    4(sp),r1
  38.     jsr    pc,rewind
  39.     clr    carry
  40. /
  41. /    now add them
  42. /
  43. 2:    dec    r4
  44.     blt    3f
  45.     mov    2(sp),r1    /r2
  46.     jsr    pc,getchar
  47.     mov    r0,r5
  48.     mov    4(sp),r1    /r3
  49.     jsr    pc,getchar
  50.     add    r5,r0
  51.     add    carry,r0
  52.     clr    carry
  53.     cmp    r0,$100.
  54.     blt    1f
  55.     sub    $100.,r0
  56.     mov    $1,carry
  57. 1:
  58.     tstb    r0
  59.     bpl    1f
  60.     add    $100.,r0
  61.     mov    $-1,carry
  62. 1:    mov    (sp),r1        /r1
  63.     jsr    pc,putchar
  64.     br    2b
  65. /
  66. /    perhaps there is an extra digit
  67. /
  68. 3:    mov    carry,r0
  69.     beq    2f
  70.     mov    (sp),r1        /r1
  71.     jsr    pc,putchar
  72. /
  73. /    strip leading zeros
  74. /
  75. 2:
  76.     jsr    pc,fsfile
  77. 2:    jsr    pc,backspace
  78.     bes    2f
  79.     beq    2b
  80.     inc    r(r1)
  81. 2:    mov    r(r1),w(r1)
  82. /
  83. /    strip leading 99's
  84. /
  85.     jsr    pc,fsfile
  86.     jsr    pc,backspace
  87.     cmpb    r0,$-1
  88.     bne    1f
  89. 2:
  90.     jsr    pc,backspace
  91.     bes    2f
  92.     cmpb    r0,$99.
  93.     beq    2b
  94.     jsr    pc,getchar
  95. 2:
  96.     mov    $-1,r0
  97.     jsr    pc,alterchar
  98.     mov    r(r1),w(r1)
  99. /
  100. /    restore and return
  101. /
  102. 1:
  103.     mov    (sp)+,r1
  104.     mov    (sp)+,r2
  105.     mov    (sp)+,r3
  106.     mov    (sp)+,r5
  107.     mov    (sp)+,r4
  108.     mov    (sp)+,r0
  109.     rts    pc
  110. /
  111. .bss
  112. carry:    .=.+2
  113. .text
  114. /
  115. /
  116. /    routine to change the sign of the centennial number
  117. /    pointed to by r1.
  118. /    negative numbers are stored in 100's complement form with
  119. /    -1 as the high order digit; the second digit is not 99.
  120. /
  121. /    mov    ...,r1
  122. /    jsr    pc,chsign
  123. /
  124. chsign:
  125.     mov    r1,-(sp)
  126.     mov    r0,-(sp)
  127.     jsr    pc,rewind
  128.     clr    chcarry
  129. /
  130. 1:
  131.     jsr    pc,lookchar
  132.     bes    1f
  133.     negb    r0
  134.     sub    chcarry,r0
  135.     mov    $1,chcarry
  136.     add    $100.,r0
  137.     cmpb    $100.,r0
  138.     bgt    2f
  139.     sub    $100.,r0
  140.     clr    chcarry
  141. 2:
  142.     jsr    pc,alterchar
  143.     br    1b
  144. /
  145. 1:
  146.     clr    r0
  147.     sub    chcarry,r0
  148.     beq    2f
  149.     jsr    pc,putchar
  150.     jsr    pc,fsfile
  151.     jsr    pc,backspace
  152.     jsr    pc,backspace
  153.     cmp    r0,$99.
  154.     bne    1f
  155.     mov    r(r1),w(r1)
  156.     mov    $-1,r0
  157.     jsr    pc,putchar
  158.     br    1f
  159. /
  160. 2:
  161.     jsr    pc,fsfile
  162.     jsr    pc,backspace
  163.     bne    1f
  164.     mov    r(r1),w(r1)
  165. /
  166. 1:
  167.     mov    (sp)+,r0
  168.     mov    (sp)+,r1
  169.     rts    pc
  170. /
  171. .bss
  172. chcarry: .=.+2
  173. .text
  174. /
  175. /
  176. /
  177. /
  178. /    routine to multiply the two centennial numbers
  179. /    pointed to by r2 and r3.
  180. /    a pointer to the result is returned in r1
  181. /    r2 and r3 are preserved
  182. /
  183. /    mov    ptr1,r2
  184. /    mov    ptr2,r3
  185. /    jsr    pc,mul3
  186. /    mov    r1,...
  187. /
  188. /    save registers and make space for temps
  189. /
  190. mul3:
  191.     mov    r5,-(sp)
  192.     mov    r3,-(sp)    /arg2
  193.     mov    r2,-(sp)    /arg1
  194.     mov    r0,-(sp)
  195.     tst    -(sp)        /result
  196.     tst    -(sp)        /arg1
  197.     tst    -(sp)        /arg2
  198.     tst    -(sp)        /carry
  199. /
  200. /    compute sign of result and make args positive
  201. /
  202.     clr    outsign
  203.     mov    r2,r1
  204.     jsr    pc,fsfile
  205.     jsr    pc,backspace
  206.     bmi    2f
  207.     mov    r2,4(sp)    /arg1
  208.     br    1f
  209. 2:
  210.     jsr    pc,length
  211.     jsr    pc,allocate
  212.     mov    r1,4(sp)
  213.     mov r2,r0
  214.     jsr    pc,move
  215.     jsr    pc,chsign
  216.     com    outsign
  217. 1:
  218.     mov    r3,r1
  219.     jsr    pc,fsfile
  220.     jsr    pc,backspace
  221.     bmi    2f
  222.     mov    r3,2(sp)    /arg2
  223.     br    1f
  224. 2:
  225.     mov    r3,r1
  226.     jsr    pc,length
  227.     jsr    pc,allocate
  228.     mov    r1,2(sp)
  229.     mov    r3,r0
  230.     jsr    pc,move
  231.     jsr    pc,chsign
  232.     com    outsign
  233. 1:
  234. /
  235. /    compute the length of the result and
  236. /    allocate space for it
  237. /
  238.     mov    w(r2),r0
  239.     sub    a(r2),r0
  240.     add    w(r3),r0
  241.     sub    a(r3),r0
  242.     jsr    pc,allocate
  243.     jsr    pc,zero
  244.     mov    r1,6(sp)    /result
  245.     clr    offset
  246.     mov    2(sp),r1    /arg2
  247.     jsr    pc,rewind
  248. /
  249. /    work on next digit of arg2, starting over on arg1
  250. /
  251. 1:    mov    4(sp),r1    /arg1
  252.     jsr    pc,rewind
  253.     mov    2(sp),r1    /arg2
  254.     jsr    pc,getchar
  255.     bes    3f
  256.     mov    r0,r2
  257.     mov    6(sp),r1    /result
  258.     jsr    pc,rewind
  259.     add    offset,r(r1)
  260.     clr    0(sp)        /carry
  261. /
  262. /    work on next digit of arg3
  263. /    form the product of the two digits,
  264. /    add to what is already there and add in old carry
  265. /    to generate new dit and new carry.
  266. /
  267. 2:    mov    4(sp),r1    /arg1
  268.     jsr    pc,getchar
  269.     bes    2f
  270.     mov    r0,r3
  271.     mpy    r2,r3
  272.     add    (sp),r3        /carry
  273.     mov    6(sp),r1    /result
  274.     jsr    pc,lookchar
  275.     add    r0,r3
  276.     mov    r3,r1
  277.     clr    r0
  278.     dvd    $100.,r0
  279.     mov    r0,(sp)        /carry
  280.     mov    r1,r0
  281.     mov    6(sp),r1    /result
  282.     jsr    pc,alterchar
  283.     br    2b
  284. /
  285. 2:
  286.     inc    offset
  287.     tst    (sp)        /carry
  288.     beq    1b
  289.     mov    6(sp),r1    /result
  290.     jsr    pc,lookchar
  291.     add    (sp),r0        /carry
  292.     jsr    pc,alterchar
  293.     br    1b
  294. /
  295. 3:
  296. /
  297. /    change sign of result if necessary
  298. /
  299.     tst    outsign
  300.     bpl    1f
  301.     mov    6(sp),r1    /result
  302.     jsr    pc,chsign
  303. /
  304. /    release dregs if necessary
  305. /
  306. 1:
  307.     cmp    2(sp),14(sp)
  308.     beq    1f
  309.     mov    2(sp),r1
  310.     jsr    pc,release
  311. 1:
  312.     cmp    4(sp),12(sp)
  313.     beq    1f
  314.     mov    4(sp),r1
  315.     jsr    pc,release
  316. 1:
  317. /
  318. /    restore registers and return
  319. /
  320.     tst    (sp)+
  321.     tst    (sp)+
  322.     tst    (sp)+
  323.     mov    (sp)+,r1
  324.     mov    (sp)+,r0
  325.     mov    (sp)+,r2
  326.     mov    (sp)+,r3
  327.     mov    (sp)+,r5
  328.     rts    pc
  329. /
  330. .bss
  331. outsign: .=.+2
  332. offset:    .=.+2
  333. k:    .=.+2
  334. kptr:    .=.+2
  335. .text
  336. /
  337. sqrt:
  338.     mov    r4,-(sp)
  339.     mov    r3,-(sp)
  340.     mov    r2,-(sp)
  341.     mov    r0,-(sp)
  342. /
  343. /    check for zero or negative
  344. /
  345.     mov    w(r1),r2
  346.     sub    a(r1),r2
  347. /
  348. /    look at the top one or two digits
  349. /
  350.     mov    r1,r3
  351.     jsr    pc,fsfile
  352.     jsr    pc,backspace
  353.     mov    r0,r4
  354.     bit    $1,r2
  355.     bne    2f
  356.     mov    r4,r1
  357.     mul    $100.,r1
  358.     mov    r1,r4
  359.     mov    r3,r1
  360.     jsr    pc,backspace
  361.     add    r0,r4
  362. 2:
  363. /
  364. /    allocate space for result
  365. /
  366.     inc    r2
  367.     asr    r2
  368.     mov    r2,r0
  369.     jsr    pc,allocate
  370.     jsr    pc,zero
  371.     mov    r2,r0
  372.     jsr    pc,seekchar
  373.     mov    r1,r2
  374. /
  375. /    get high order digit of arg and square root it
  376. /
  377.     mov    $1,r0
  378. 2:    sub    r0,r4
  379.     blt    2f
  380.     add    $2,r0
  381.     br    2b
  382. 2:    inc    r0
  383.     asr    r0
  384.     mov    r0,r4
  385.     mov    r2,r1
  386.     jsr    pc,fsfile
  387.     jsr    pc,backspace
  388.     cmp    r4,$100.
  389.     blt    1f
  390.     sub    $100.,r4
  391.     mov    r4,r0
  392.     jsr    pc,alterchar
  393.     mov    $1,r0
  394.     jsr    pc,putchar
  395.     br    2f
  396. 1:
  397.     mov    r4,r0
  398.     jsr    pc,alterchar
  399. 2:
  400.     mov    r1,-(sp)
  401.     mov    r3,-(sp)
  402. /
  403. /    get successive approx. from Newton
  404. /
  405. 1:    mov    (sp),r3        /arg
  406.     mov    2(sp),r2    /approx
  407.     jsr    pc,div3
  408.     mov    r1,r3
  409.     jsr    pc,add3
  410.     mov    r1,-(sp)
  411.     mov    r3,r1
  412.     jsr    pc,release
  413.     mov    r4,r1
  414.     jsr    pc,release
  415.     mov    (sp)+,r1
  416.     mov    sqtemp,r2
  417.     mov    r1,r3
  418.     jsr    pc,div3
  419.     mov    r1,-(sp)
  420.     mov    r3,r1
  421.     jsr    pc,release
  422.     mov    r4,r1
  423.     jsr    pc,release
  424.     mov    (sp)+,r3
  425.     mov    2(sp),r1
  426.     jsr    pc,length
  427.     jsr    pc,allocate
  428.     mov    2(sp),r0
  429.     jsr    pc,move
  430.     jsr    pc,chsign
  431.     mov    r1,r2
  432.     jsr    pc,add3
  433.     jsr    pc,fsfile
  434.     jsr    pc,backspace
  435.     jsr    pc,release
  436.     mov    r2,r1
  437.     jsr    pc,release
  438.     tst    r0
  439.     bpl    2f
  440. /
  441. /    loop if new < old
  442.     mov    2(sp),r1
  443.     jsr    pc,release
  444.     mov    r3,2(sp)
  445.     br    1b
  446. /
  447. 2:
  448.     mov    r3,r1
  449.     jsr    pc,release
  450.     mov    (sp)+,r1
  451.     jsr    pc,release
  452.     mov    (sp)+,r1
  453.     mov    (sp)+,r0
  454.     mov    (sp)+,r2
  455.     mov    (sp)+,r3
  456.     mov    (sp)+,r4
  457.     rts    pc
  458.