Mercurial > hg > Members > kono > os9 > sbc09

comparison examples/uslash.asm @ 57:2088fd998865

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sbc09 directry clean up
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 23 Jul 2018 16:07:12 +0900
parents
children
comparison
equal deleted inserted replaced
56:4fa2bdb0c457 57:2088fd998865
1 ; 6809 32/16 divison for a forth environment
2 ; 2012-06-20, 2014-07-01 J.E. Klasek j+forth@klasek.at
3 ;
4 ; There are two implementations:
5 ; TALBOT just for analysis, not really used here.
6 ; EFORTH advanced and optimized version for ef09
7 ;
8 ; EFORTH version's special cases:
9 ; overflow: quotient = $FFFF, remainder = divisor
10 ; underflow: quotient = $0000, remainder = dividend low
11 ; division by zero: quotient = $FFFF, remainder = $0000
12
13 org $100
14 lds #$100
15 ldu #$8000
16
17 ; Testvalues:
18 ;
19 ; DIVH DIVL DVSR QUOT REM comment
20 ;
21 ; 0100 0000 FFFF 0100 0100 maximum divisor
22 ; 0000 0001 8000 0000 0001 underflow (REM = DIVL)
23 ; 0000 5800 3000 0001 1800 normal divsion
24 ; 5800 0000 3000 FFFF 3000 overflow
25 ; 0000 0001 0000 FFFF 0000 overflow (division by zero)
26 ;
27
28 DIVH EQU $0000
29 DIVL EQU $5800
30 DVSR EQU $3000
31
32 bra EFORTH ; comment out to try TALBOT's version
33
34 ; ------------------------------------
35 ; Version from Talbot System FIG Forth
36 ; ------------------------------------
37
38 TALBOT:
39
40 ; sample parameters on forth parameter stack (U) ...
41 ldd #DIVL ; dividend low word
42 pshu d
43 ldd #DIVH ; dividend high word
44 pshu d
45 ldd #DVSR ; divisor
46 pshu d
47
48 USLASH: ldd 2,u ; dividend swap H/L word
49 ldx 4,u
50 stx 2,u
51 std 4,u
52 asl 3,u ; initial shift of L word
53 rol 2,u
54 ldx #$10
55 USL1: rol 5,u ; shift H word
56 rol 4,u
57 ldd 4,u
58 subd ,u ; does divisor fit?
59 andcc #$fe ; clc - clear carry flag
60 bmi USL2
61 std 4,u ; fits -> quotient = 1
62 orcc #$01 ; sec - set carry flag
63 USL2: rol 3,u ; L word/quotient
64 rol 2,u
65 leax -1,x
66 bne USL1
67 leau 2,u ; drop divisor from parameter stack
68
69 ; into registers for simulator ...
70
71 ldx ,u ; quotient on TOS
72 ldd 2,u ; remainder on 2nd
73
74 realexit:
75 sync
76
77
78
79
80 ; ------------------------------------
81 ; Version from J.E. Klasek, replacing
82 ; high-level variant in eFORTH.
83 ; ------------------------------------
84
85 EFORTH:
86 ; sample parameters on forth parameter stack (S) ...
87 ldd #DIVL ; dividend low word
88 pshs d
89 ldd #DIVH ; dividend high word
90 pshs d
91 ldd #DVSR ; divisor
92 pshs d
93
94 ; U/ ( udl udh un -- ur uq )
95 ; Unsigned divide of a double by a single. Return mod and quotient.
96 ;
97 ; Special cases:
98 ; 1. overflow: quotient overflow if dividend is to great (remainder = divisor),
99 ; remainder is set to $FFFF -> special handling.
100 ; This is checked also right before the main loop.
101 ; 2. underflow: divisor does not fit into dividend -> remainder
102 ; get the value of the dividend -> automatically covered.
103
104 USLASH2:
105 ldx #16
106 ldd 2,s ; udh
107 cmpd ,s ; dividend to great?
108 bhs UMMODOV ; quotient overflow!
109 asl 5,s ; udl low
110 rol 4,s ; udl high
111
112 UMMOD1: rolb ; got one bit from udl
113 rola
114 bcs UMMOD2 ; bit 16 means always greater as divisor
115 cmpd ,s ; divide by un
116 bhs UMMOD2 ; higher or same as divisor?
117 andcc #$fe ; clc - clear carry flag
118 bra UMMOD3
119 UMMOD2: subd ,s
120 orcc #$01 ; sec - set carry flag
121 UMMOD3: rol 5,s ; udl, quotient shifted in
122 rol 4,s
123 leax -1,x
124 bne UMMOD1
125
126 ldx 4,s ; quotient
127 cmpd ,s ; remainder >= divisor -> overflow
128 blo UMMOD4
129 UMMODOV:
130 ldd ,s ; remainder set to divisor
131 ldx #$FFFF ; quotient = FFFF (-1) marks overflow
132 ; (case 1)
133 UMMOD4:
134 leas 2,s ; un (divisor thrown away)
135 stx ,s ; quotient to TOS
136 std 2,s ; remainder 2nd
137
138 bra realexit
139
140 ; not reached
141 pulu pc ; eFORTH NEXT
142
143 enddata
144
145 end