« back to all changes in this revision
Viewing changes to test/test9.asm
- browse files at revision 43
- compare with another revision
- download diff
- download tarball
- view history from revision 43
- Committer: Amaury Carvalho
- Date: 2019-07-27 00:55:12 UTC
- Revision ID: amauryspires@gmail.com-20190727005512-63nvkmpjbzkzc04i
Commit on 26/07/2019 09:55:12 -03 by amaury
- files modified:
- assembly.cpp
added
removed
test/test9.asm
248
248
BASIC_RNDX : equ 0xF857
249
249
BASIC_BUF : equ 0xF55E
250
250
BASIC_SWPTMP : equ 0xF7BC
251
BASIC_STRBUF : equ 0xF7C5
251
252
BASIC_TXTTAB : equ 0xF676
252
253
BASIC_VARTAB : equ 0xF6C2
253
254
BASIC_ARYTAB : equ 0xF6C4
266
267
;--------------------------------------------------------
267
268
; MATH PACK ROUTINES
268
269
;--------------------------------------------------------
269
MATH_DECSUB : equ 0x268C
270
MATH_DECADD : equ 0x269A
271
MATH_DECMUL : equ 0x27E6
272
MATH_DECDIV : equ 0x289F
273
MATH_SNGEXP : equ 0x37C8
274
MATH_DBLEXP : equ 0x37D7
275
MATH_COS : equ 0x2993
276
MATH_SIN : equ 0x29AC
277
MATH_TAN : equ 0x29FB
278
MATH_ATN : equ 0x2A14
279
MATH_SQR : equ 0x2AFF
280
MATH_LOG : equ 0x2A72
281
MATH_EXP : equ 0x2B4A
282
MATH_DECNRM : equ 0x26FA
283
MATH_SIGN : equ 0x2E71
284
MATH_ABSFN : equ 0x2E82
285
MATH_NEG : equ 0x2E8D
286
MATH_SGN : equ 0x2E97
287
MATH_RND : equ 0x2BDF
288
MATH_UMULT : equ 0x314A
289
MATH_ISUB : equ 0x3167
290
MATH_IADD : equ 0x3172
291
MATH_IMULT : equ 0x3193
292
MATH_IDIV : equ 0x31E6
293
MATH_IMOD : equ 0x323A
294
MATH_INTEXP : equ 0x383F
295
MATH_FRCINT : equ 0x2F8A
296
MATH_FRCSGL : equ 0x2FB2
297
MATH_FRCDBL : equ 0x303A
298
MATH_FIXER : equ 0x30BE
299
MATH_MAF : equ 0x2C4D
300
MATH_MAM : equ 0x2C50
301
MATH_MOV8DH : equ 0x2C53
302
MATH_MFA : equ 0x2C59
303
MATH_MFM : equ 0x2C5C
304
MATH_MMF : equ 0x2C67
305
MATH_MOV8HD : equ 0x2C6A
306
MATH_XTF : equ 0x2C6F
307
MATH_PHA : equ 0x2CC7
308
MATH_PHF : equ 0x2CCC
309
MATH_PPA : equ 0x2CDC
310
MATH_PPF : equ 0x2CE1
311
MATH_PUSHF : equ 0x2EB1
312
MATH_MOVFM : equ 0x2EBE
313
MATH_MOVFR : equ 0x2EC1
314
MATH_MOVRF : equ 0x2ECC
315
MATH_MOVRMI : equ 0x2ED6
316
MATH_MOVRM : equ 0x2EDF
317
MATH_MOVMF : equ 0x2EE8
318
MATH_MOVE : equ 0x2EEB
319
MATH_VMOVAM : equ 0x2EEF
320
MATH_MOVVFM : equ 0x2EF2
321
MATH_VMOVE : equ 0x2EF3
322
MATH_VMOVFA : equ 0x2F05
323
MATH_VMOVFM : equ 0x2F08
324
MATH_VMOVAF : equ 0x2F0D
325
MATH_VMOVMF : equ 0x2F10
326
MATH_ICOMP : equ 0x2F4D
327
MATH_DCOMP : equ 0x2F21
328
MATH_XDCOMP : equ 0x2F5C
329
MATH_FIN : equ 0x3299
330
MATH_FOUT : equ 0x3425
331
MATH_PUFOUT : equ 0x3426
332
MATH_FOUTB : equ 0x371A
333
MATH_FOUTO : equ 0x371E
334
MATH_FOUTH : equ 0x3722
335
270
336
271
;--------------------------------------------------------
337
272
; SUPPORT MACROS
1148
1083
jp z, memory.error ;
1149
1084
push ix ; save ix
1150
1085
push ix ; bc = ix
1151
pop bc ;
1152
ld ix, BASIC_DAC + 1 ; string 1
1153
ld l, (ix) ;
1154
ld h, (ix+1) ;
1086
pop de ;
1087
;ld ix, BASIC_DAC + 1 ; string 1
1088
;ld l, (ix) ;
1089
;ld h, (ix+1) ;
1090
ld hl, (BASIC_DAC + 1) ;
1155
1091
call COPY_TO.STR ; copy to new memory
1156
ld ix, BASIC_ARG + 1 ; string 2
1157
ld l, (ix) ;
1158
ld h, (ix+1) ;
1092
;ld ix, BASIC_ARG + 1 ; string 2
1093
;ld l, (ix) ;
1094
;ld h, (ix+1) ;
1095
ld hl, (BASIC_ARG + 1) ;
1159
1096
call COPY_TO.STR ; copy to new memory
1160
1097
pop hl ; hl = ix
1161
1098
call COPY_TO.VAR_DUMMY.STR ;
1176
1113
inc hl ; next char
1177
1114
jr STRING.PRINT.G ; repeat
1178
1115
; input hl = string from
1179
; input bc = memory to
1180
COPY_TO.STR: ld a, (hl)
1181
ld (bc), a
1182
or a ; cp 0
1183
ret z
1184
inc bc
1185
inc hl
1186
jr COPY_TO.STR
1116
; input de = memory to
1117
COPY_TO.STR: xor a ;
1118
COPY_TO.STR.1: cp (hl) ;
1119
ldi ;
1120
jr nz, COPY_TO.STR.1 ;
1121
ret ;
1187
1122
COPY_TO.BASIC_BUF: ld bc, BASIC_BUF
1188
1123
ld a, (LIT_QUOTE_CHAR)
1189
1124
ld (bc), a
1921
1856
ret ;
1922
1857
1923
1858
1859
1860
CALL_MATH_LIB: exx
1861
ld hl, RET_MATH_LIB
1862
push hl
1863
ld hl, BASIC_DAC
1864
ld de, BASIC_ARG
1865
ld bc, BASIC_SWPTMP
1866
jp (ix)
1867
RET_MATH_LIB: call COPY_TO.TMP_DAC
1868
exx
1869
ret
1870
1871
MATH_DECADD: ld ix, addSingle
1872
jp CALL_MATH_LIB
1873
1874
MATH_DECSUB: ld ix, subSingle
1875
jp CALL_MATH_LIB
1876
1877
MATH_DECMUL: ld ix, mulSingle
1878
jp CALL_MATH_LIB
1879
1880
MATH_DECDIV: ld ix, divSingle
1881
jp CALL_MATH_LIB
1882
1883
MATH_DBLEXP:
1884
MATH_SNGEXP: ld ix, powSingle
1885
jp CALL_MATH_LIB
1886
1887
MATH_COS: ret
1888
1889
MATH_SIN: ret
1890
1891
MATH_TAN: ret
1892
1893
MATH_ATN: ret
1894
1895
MATH_SQR: ld ix, sqrtSingle
1896
jp CALL_MATH_LIB
1897
1898
MATH_LOG: ret
1899
1900
MATH_EXP: ret
1901
1902
MATH_ABSFN: ret
1903
1904
MATH_NEG: ret
1905
1906
MATH_SGN: ret
1907
1908
MATH_RND: ld ix, randSingle
1909
jp CALL_MATH_LIB
1910
1911
MATH_FRCINT: ld ix, single2Int
1912
call CALL_MATH_LIB
1913
ld ix, BASIC_DAC
1914
ld (ix), 0
1915
ld (ix+1), 0
1916
ld (ix+2), l
1917
ld (ix+3), h
1918
ld (ix+4), 0
1919
ld (ix+5), 0
1920
ld (ix+6), 0
1921
ld (ix+7), 0
1922
ret
1923
1924
MATH_FRCDBL: ; same as MATH_FRCSGL
1925
MATH_FRCSGL: jp int2Single
1926
1927
MATH_ICOMP: ld a, h ; cp hl, de (or use bios DCOMPR)
1928
cp d
1929
jr nz, MATH_ICOMP.NE
1930
ld a, l
1931
cp e
1932
jr nz, MATH_ICOMP.NE
1933
jr MATH_DCOMP.EQ
1934
MATH_ICOMP.NE: jr c, MATH_DCOMP.LT
1935
jr MATH_DCOMP.GT
1936
1937
MATH_XDCOMP: ; same as MATH_DCOMP
1938
MATH_DCOMP: ld ix, cmpSingle
1939
call CALL_MATH_LIB
1940
jr z, MATH_DCOMP.EQ
1941
jr c, MATH_DCOMP.LT
1942
MATH_DCOMP.GT: ld a, 1 ; DAC > ARG
1943
ret
1944
MATH_DCOMP.EQ: ld a, 0 ; DAC = ARG
1945
ret
1946
MATH_DCOMP.LT: ld a, 0xFF ; DAC < ARG
1947
ret
1948
1949
1950
MATH_FIN: ; HL has the source string
1951
ld a, (BASIC_VALTYP)
1952
cp 2 ; test if integer
1953
jr nz, MATH_FIN.1
1954
ld hl, (BASIC_DAC+2)
1955
ld de, BASIC_STRBUF
1956
call StrToInt
1957
ld hl, BASIC_STRBUF
1958
ret
1959
MATH_FIN.1: ld BC, BASIC_DAC
1960
call str2single
1961
ret
1962
1963
MATH_FOUT: ld a, (BASIC_VALTYP)
1964
cp 2 ; test if integer
1965
jr nz, MATH_FOUT.1
1966
ld hl, (BASIC_DAC+2)
1967
ld de, BASIC_STRBUF
1968
call IntToStr
1969
ld hl, BASIC_STRBUF
1970
ret
1971
MATH_FOUT.1: ld hl, BASIC_DAC
1972
ld bc, BASIC_STRBUF
1973
call single2str
1974
ld hl, BASIC_STRBUF
1975
ret
1976
1977
1978
1979
1980
;---------------------------------------------------------------------------------------------------------
1981
; Z80FLOAT LIBRARY
1982
; Copyright 2018 Zeda A.K. Thomas
1983
;---------------------------------------------------------------------------------------------------------
1984
; References:
1985
; https://github.com/Zeda/z80float
1986
; https://www.omnimaga.org/asm-language/(z80)-floating-point-routines/
1987
; https://en.wikipedia.org/wiki/Single-precision_floating-point_format
1988
;---------------------------------------------------------------------------------------------------------
1989
; Parameters:
1990
; HL points to the first operand
1991
; DE points to the second operand (if needed)
1992
; IX points to the third operand (if needed, rare)
1993
; BC points to where the result should be output
1994
; Floats are stored by a little-endian 24-bit mantissa. However, the highest bit
1995
; is taken as implicitly 1, so we replace it as a sign bit. Next comes an 8-bit
1996
; exponent biased by +128.
1997
;---------------------------------------------------------------------------------------------------------
1998
; Adapted to MSXBas2Asm by Amaury Carvalho, 2019
1999
;---------------------------------------------------------------------------------------------------------
2000
2001
;---------------------------------------------------------------------------------------------------------
2002
; Work area
2003
;---------------------------------------------------------------------------------------------------------
2004
2005
BASIC_HOLD8: equ 0xF806 ; 48 Work area for decimal multiplications.
2006
BASIC_HOLD2: equ 0xF836 ; 8 Work area in the execution of numerical operators.
2007
BASIC_HOLD: equ 0xF83E ; 8 Work area in the execution of numerical operators.
2008
scrap: equ BASIC_HOLD8
2009
seed0: equ BASIC_RNDX
2010
seed1: equ seed0 + 4
2011
var48: equ scrap + 4
2012
quot: equ scrap + 1
2013
addend: equ scrap
2014
addend2: equ scrap+7 ;4 bytes
2015
var_x: equ BASIC_HOLD ;4 bytes
2016
var_c: equ var_x + 4 ;4 bytes
2017
pow10exp_single: equ scrap+9
2018
strout_single: equ pow10exp_single+2
2019
2020
;---------------------------------------------------------------------------------------------------------
2021
; addSingle
2022
;---------------------------------------------------------------------------------------------------------
2023
2024
;;Still need to tend to special cases
2025
addSingle:
2026
;;x+y
2027
push af
2028
push hl
2029
push de
2030
push bc
2031
addInject:
2032
inc de
2033
inc de
2034
inc hl
2035
inc hl
2036
ld a,(de)
2037
xor (hl)
2038
push af
2039
inc de
2040
inc hl
2041
ex de,hl
2042
ld a,(de)
2043
sub (hl)
2044
ex de,hl
2045
jr nc,$+5
2046
ex de,hl
2047
neg
2048
cp 24
2049
jp nc,add_unneeded
2050
push hl
2051
ld hl,addend+6
2052
dec de
2053
ld bc,0408h
2054
dec hl
2055
ld (hl),0
2056
sub c
2057
jr nc,$-5
2058
add a,c
2059
push af
2060
push hl
2061
ex de,hl
2062
ld a,(hl)
2063
or 80h
2064
ld (de),a
2065
dec de
2066
dec hl
2067
ldd
2068
ldd
2069
ex de,hl
2070
dec b
2071
jr z,$+7
2072
ld (hl),0
2073
dec hl
2074
djnz $-3
2075
pop hl
2076
pop af
2077
ld b,a
2078
jr z,noshift
2079
set 7,(hl)
2080
_1:
2081
push hl
2082
srl (hl)
2083
dec hl
2084
rr (hl)
2085
dec hl
2086
rr (hl)
2087
dec hl
2088
rr (hl)
2089
pop hl
2090
djnz _1
2091
noshift:
2092
pop hl ;bigger float
2093
dec hl
2094
ld b,(hl)
2095
dec hl
2096
dec hl
2097
ex de,hl
2098
pop af
2099
jp m,subtract
2100
ld hl,addend+2
2101
ld a,(hl)
2102
rla
2103
inc hl
2104
ld a,(de)
2105
adc a,(hl)
2106
ld (hl),a
2107
inc hl
2108
inc de
2109
ld a,(de)
2110
adc a,(hl)
2111
ld (hl),a
2112
inc hl
2113
inc de
2114
ld a,(de)
2115
set 7,a
2116
adc a,(hl)
2117
ld (hl),a
2118
inc hl
2119
inc de
2120
ld a,(de)
2121
ld (hl),a
2122
jp nc,add_done
2123
inc (hl)
2124
jp z,add_overflow
2125
dec hl
2126
rr (hl)
2127
dec hl
2128
rr (hl)
2129
dec hl
2130
rr (hl)
2131
jp add_done
2132
subtract:
2133
ld hl,addend
2134
xor a
2135
ld c,a
2136
sub (hl)
2137
ld (hl),a
2138
inc hl
2139
ld a,c
2140
sbc a,(hl)
2141
ld (hl),a
2142
inc hl
2143
ld a,c
2144
sbc a,(hl)
2145
ld (hl),a
2146
inc hl
2147
ld a,(de)
2148
sbc a,(hl)
2149
ld (hl),a
2150
inc hl
2151
inc de
2152
ld a,(de)
2153
sbc a,(hl)
2154
ld (hl),a
2155
inc hl
2156
inc de
2157
ld a,(de)
2158
set 7,a
2159
sbc a,(hl)
2160
ld (hl),a
2161
inc hl
2162
inc de
2163
ld a,(de)
2164
ld (hl),a
2165
dec de
2166
ex de,hl
2167
jr nc,negated
2168
ld hl,addend
2169
ld a,80h
2170
xor b
2171
ld b,a
2172
ld a,c
2173
sub (hl)
2174
ld (hl),a
2175
inc hl
2176
ld a,c
2177
sbc a,(hl)
2178
ld (hl),a
2179
inc hl
2180
ld a,c
2181
sbc a,(hl)
2182
ld (hl),a
2183
inc hl
2184
ld a,c
2185
sbc a,(hl)
2186
ld (hl),a
2187
inc hl
2188
ld a,c
2189
sbc a,(hl)
2190
ld (hl),a
2191
inc hl
2192
ld a,c
2193
sbc a,(hl)
2194
ld (hl),a
2195
negated:
2196
jp m,add_done
2197
push bc
2198
ld hl,(addend)
2199
ld de,(addend+2)
2200
ld bc,(addend+4)
2201
ld a,h
2202
or l
2203
or d
2204
or e
2205
or b
2206
or c
2207
jp z,add_underflow
2208
ld a,(addend+6)
2209
normalize:
2210
dec a
2211
jr z,add_underflow
2212
add hl,hl
2213
rl e
2214
rl d
2215
rl c
2216
rl b
2217
jp p,normalize
2218
ld (addend),hl
2219
ld (addend+2),de
2220
ld (addend+4),bc
2221
ld (addend+6),a
2222
pop bc
2223
add_done:
2224
;;Need to adjust sign flag
2225
ld hl,addend+5
2226
ld a,(hl)
2227
rla
2228
rl b
2229
rra
2230
ld (hl),a
2231
dec hl
2232
dec hl
2233
add_copy:
2234
pop de
2235
push de
2236
ldi
2237
ldi
2238
ldi
2239
ld a,(hl)
2240
ld (de),a
2241
pop bc
2242
pop de
2243
pop hl
2244
pop af
2245
ret
2246
add_underflow:
2247
;;How many push/pops are needed?
2248
;;return ZERO
2249
ld hl,0
2250
ld (addend+3),hl
2251
ld (addend+5),hl
2252
pop bc
2253
jr add_done
2254
add_overflow:
2255
;;How many push/pops are needed?
2256
;;return INF
2257
dec hl
2258
ld (hl),40h
2259
jr add_done
2260
add_unneeded:
2261
;;How many push/pops are needed?
2262
;;Return bigger number
2263
pop af
2264
dec hl
2265
dec hl
2266
dec hl
2267
jr add_copy
2268
2269
;---------------------------------------------------------------------------------------------------------
2270
; subSingle
2271
;---------------------------------------------------------------------------------------------------------
2272
2273
subSingle:
2274
;;x-y
2275
push af
2276
push hl
2277
push de
2278
push bc
2279
push hl
2280
ex de,hl
2281
ld de,addend2
2282
ldi
2283
ldi
2284
ld a,(hl)
2285
xor 80h
2286
ld (de),a
2287
inc de
2288
inc hl
2289
ld a,(hl)
2290
ld (de),a
2291
ex de,hl
2292
pop hl
2293
ld de,addend2
2294
jp addInject ;jumps in to the addSingle routine
2295
2296
;---------------------------------------------------------------------------------------------------------
2297
; mulSingle
2298
;---------------------------------------------------------------------------------------------------------
2299
2300
mulSingle:
2301
;Inputs: HL points to float1, DE points to float2, BC points to where the result is copied
2302
;Outputs: float1*float2 is stored to (BC)
2303
;573+mul24+{0,35}+{0,30}
2304
;min: 1398cc
2305
;max: 2564cc
2306
;avg: 2055.13839751681cc
2307
push af
2308
push hl
2309
push de
2310
push bc
2311
2312
call _2 ;CHLB
2313
ld a,c
2314
ex de,hl
2315
pop hl
2316
push hl
2317
ld (hl),b
2318
inc hl
2319
ld (hl),e
2320
inc hl
2321
ld (hl),d
2322
inc hl
2323
ld (hl),a
2324
pop bc
2325
pop de
2326
pop hl
2327
pop af
2328
ret
2329
2330
2331
_2:
2332
;;return float in CHLB
2333
push de
2334
ld e,(hl)
2335
inc hl
2336
ld d,(hl)
2337
inc hl
2338
ld c,(hl)
2339
inc hl
2340
ld a,(hl)
2341
or a
2342
jr z,mulSingle_case0
2343
ex de,hl
2344
ex (sp),hl
2345
ld e,(hl)
2346
inc hl
2347
ld d,(hl)
2348
inc hl
2349
ld b,(hl)
2350
inc hl
2351
inc (hl)
2352
dec (hl)
2353
jr z,mulSingle_case1
2354
add a,(hl) ;\
2355
pop hl ; |
2356
rra ; |Lots of help from Runer112 and
2357
adc a,a ; |calc84maniac for optimizing
2358
jp po,bad ; |this exponent check.
2359
xor 80h ; |
2360
jr z,underflow ;/
2361
push af ;exponent
2362
ld a,b
2363
xor c
2364
push af ;sign
2365
set 7,b
2366
set 7,c
2367
call mul24 ;BDE*CHL->HLBCDE, returns sign info
2368
pop de
2369
ld a,e
2370
pop de
2371
jp m,_3
2372
rl c
2373
rl b
2374
adc hl,hl
2375
dec d
2376
_3:
2377
inc d
2378
jr z,overflow
2379
rl c
2380
ld c,d
2381
ld de,0
2382
push af
2383
ld a,b
2384
adc a,e
2385
ld b,a
2386
adc hl,de
2387
jr nc,_4
2388
inc c
2389
jr z,overflow
2390
rr h
2391
rr l
2392
rr b
2393
_4:
2394
pop af
2395
cpl
2396
and $80
2397
xor h
2398
ld h,a
2399
ret
2400
bad:
2401
jr nc,overflow
2402
underflow:
2403
ld hl,0
2404
rl b
2405
rr h
2406
ld c,l
2407
ld b,l
2408
ret
2409
overflow:
2410
ld hl,$8000
2411
jr underflow+3
2412
mulSingle_case1:
2413
;x*0 -> 0
2414
;x*inf -> inf
2415
;x*NaN -> NaN
2416
pop hl
2417
ld h,b
2418
ld l,d
2419
ld b,e
2420
ld c,0
2421
ret
2422
mulSingle_case0:
2423
;special*x = special
2424
;NaN*x = NaN
2425
;0*0 = 0
2426
;0*NaN = NaN
2427
;0*Inf = NaN
2428
;Inf*Inf = Inf
2429
;Inf*-Inf =-Inf
2430
;0CDE
2431
pop hl
2432
inc hl
2433
inc hl
2434
inc hl
2435
ld a,(hl)
2436
or a
2437
jr z,_5
2438
ld h,c
2439
ld c,0
2440
ret
2441
_5:
2442
dec hl
2443
ld b,(hl)
2444
;basically, if b|c has bit 5 set, return NaN
2445
ld a,b
2446
or c
2447
ld h,$20
2448
and h
2449
jr z,_6
2450
ld c,0
2451
ret
2452
_6:
2453
ld a,c
2454
xor b
2455
rl b
2456
rlca
2457
rr b
2458
res 4,b
2459
2460
rl c
2461
rrca
2462
rr c
2463
2464
ld a,c
2465
and $E0
2466
add a,b
2467
rra
2468
ld h,a
2469
ld c,0
2470
ret
2471
mul24:
2472
;;BDE*CHL -> HLBCDE
2473
;;155 bytes
2474
;;402+3*C_Times_BDE
2475
;;fastest:1201cc
2476
;;slowest:1753cc
2477
;;avg :1464.9033203125cc (1464+925/1024)
2478
;min: 825cc
2479
;max: 1926cc
2480
;avg: 1449.63839751681cc
2481
2482
push bc
2483
ld c,l
2484
push hl
2485
call C_Times_BDE
2486
ld (var48),hl
2487
ld l,a
2488
ld h,c
2489
ld (var48+2),hl
2490
2491
pop hl
2492
ld c,h
2493
call C_Times_BDE
2494
push bc
2495
ld bc,(var48+1)
2496
add hl,bc
2497
ld (var48+1),hl
2498
pop bc
2499
ld b,c
2500
ld c,a
2501
ld hl,(var48+3)
2502
ld h,0
2503
adc hl,bc
2504
ld (var48+3),hl
2505
2506
pop bc
2507
call C_Times_BDE
2508
ld de,(var48+2)
2509
add hl,de
2510
ld (var48+2),hl
2511
ld d,c
2512
ld e,a
2513
ld b,h
2514
ld c,l
2515
ld hl,(var48+4)
2516
ld h,0
2517
adc hl,de
2518
ld de,(var48)
2519
ret
2520
2521
;---------------------------------------------------------------------------------------------------------
2522
; divSingle
2523
;---------------------------------------------------------------------------------------------------------
2524
2525
divSingle:
2526
;;HL points to numerator
2527
;;DE points to denominator
2528
;;BC points to where the quotient gets written
2529
call pushpop
2530
divSingle_no_pushpop:
2531
inc hl
2532
inc de
2533
inc hl
2534
inc de
2535
ld a,(de) ;\
2536
xor (hl) ; |Get sign of output
2537
add a,a ; |
2538
push af ;/
2539
push bc
2540
inc hl
2541
inc de
2542
ld a,(hl) ;\
2543
ex de,hl ; |Get exponent
2544
sub (hl) ; |
2545
ex de,hl ; |
2546
2547
ld b,-1
2548
jr nc,_7
2549
dec b
2550
_7:
2551
add a,128
2552
jr nc,_8
2553
inc b
2554
_8:
2555
inc b
2556
jr z,_9
2557
jp p,divunderflow
2558
jp m,divoverflow
2559
_9:
2560
ld (quot+3),a
2561
dec hl
2562
dec de
2563
ld b,(hl)
2564
dec hl
2565
ld a,(hl)
2566
dec hl
2567
ld l,(hl)
2568
ld h,a
2569
ex de,hl
2570
2571
ld c,(hl)
2572
dec hl
2573
ld a,(hl)
2574
dec hl
2575
ld l,(hl)
2576
ld h,a
2577
ex de,hl
2578
2579
set 7,c
2580
ld a,b
2581
or 80h
2582
sbc hl,de
2583
sbc a,c
2584
jr nz,_10
2585
or h
2586
or l
2587
jr z,setmantissa0
2588
xor a
2589
_10:
2590
jr nc,startdiv
2591
ld b,a
2592
ld a,(quot+3)
2593
dec a
2594
ld (quot+3),a
2595
ld a,b
2596
add hl,hl
2597
adc a,a
2598
add hl,de
2599
adc a,c
2600
startdiv:
2601
ld b,1
2602
call divsub0+3
2603
ld (quot+1),bc
2604
call divsub0
2605
ld (quot),bc
2606
call divsub0
2607
ld (quot-1),bc
2608
add hl,hl
2609
rla
2610
jr c,_11
2611
sbc hl,de
2612
sbc a,c
2613
ccf
2614
_11:
2615
ld hl,(quot)
2616
ld de,(quot+2)
2617
ld bc,0
2618
adc hl,bc
2619
ex de,hl
2620
adc hl,bc
2621
ld b,h
2622
ld c,l
2623
writeback:
2624
pop hl
2625
ld (hl),e
2626
inc hl
2627
ld (hl),d
2628
inc hl
2629
rl c
2630
pop af
2631
rr c
2632
ld (hl),c
2633
inc hl
2634
ld (hl),b
2635
ret
2636
divoverflow:
2637
ld b,$40
2638
jr _12
2639
divunderflow:
2640
ld b,0
2641
jr _12
2642
setmantissa0:
2643
ld bc,(quot+2)
2644
_12:
2645
ld de,0
2646
ld c,e
2647
jr writeback
2648
divsub0:
2649
;;882cc max
2650
call divsub1 ;34 or 66
2651
call divsub1 ;
2652
call divsub1
2653
call divsub1
2654
call divsub1
2655
call divsub1
2656
call divsub1
2657
call divsub1
2658
or a
2659
sbc hl,de
2660
sbc a,c
2661
inc b
2662
ret nc
2663
dec b
2664
add hl,de
2665
adc a,c
2666
ret
2667
divsub1:
2668
;34cc or 66cc or 93cc
2669
sla b
2670
add hl,hl
2671
rla
2672
ret nc
2673
or a
2674
inc b
2675
sbc hl,de
2676
sbc a,c
2677
ret c
2678
inc b
2679
sbc hl,de
2680
sbc a,c
2681
ret
2682
2683
;---------------------------------------------------------------------------------------------------------
2684
; powSingle
2685
;---------------------------------------------------------------------------------------------------------
2686
2687
powSingle:
2688
;;Computes y^x
2689
;;HL points to y
2690
;;DE points to x
2691
;;BC points to output
2692
call pushpop
2693
push bc
2694
ld bc,var_c
2695
call lgSingle
2696
ld h,b
2697
ld l,c
2698
ex de,hl
2699
jp pow_inject
2700
2701
pow2Single:
2702
;;Computes 2^x
2703
call pushpop
2704
push bc
2705
2706
exp_inject:
2707
;if x is on [0,1):
2708
; 2^x = 1.000000001752 + x * (0.693146989552 + x * (0.2402298085906 + x * (5.54833215071e-2 + x * (9.67907584392e-3 + x * (1.243632065103e-3 + x * 2.171671843714e-4)))))
2709
;Please note that usually I like to reduce to [-.5,.5] as the extra overhead is usually worth it.
2710
;In this case, our polynomial is the same degree, with error different by less than 1 bit, so it's just a waste to range-reduce in this way.
2711
;
2712
;int(x) -> out_exp
2713
;x-=int(x) ;leaves x in [0,1)
2714
;;If x==0 -> out==1
2715
;;if x==inf -> out==inf
2716
;;if x==-inf -> out==0
2717
;;if x==NAN -> out==NAN
2718
ld de,var48+10
2719
call mov4
2720
ld hl,(var48+10)
2721
ld de,(var48+12)
2722
ld a,e
2723
add a,a
2724
push af ;keep track of sign
2725
rrca
2726
ld (var48+12),a
2727
ld c,a
2728
ld a,d
2729
or a
2730
jp z,exp_spec
2731
cp 80h-23
2732
jp c,exp_underflow
2733
sub 128 ; sub a,128
2734
jr c,_pow_1 ;int(x)=0
2735
inc a
2736
cp 7
2737
jp nc,exp_overflow
2738
set 7,c
2739
ld b,a
2740
xor a
2741
add hl,hl
2742
rl c
2743
rla
2744
djnz $-4
2745
ld b,7Fh
2746
bit 7,c
2747
jr nz,exp_normalized
2748
ld e,a
2749
ld a,h
2750
or l
2751
or c
2752
ld a,e
2753
jr z,exp_zeroed
2754
dec b
2755
add hl,hl
2756
rl c
2757
jp p,$-4
2758
jr exp_normalized ;.db $11 ;start of `ld de,**`
2759
exp_zeroed:
2760
ld b,0
2761
exp_normalized:
2762
ld (var48+10),hl
2763
res 7,c
2764
ld (var48+12),bc
2765
jr comp_exp ;.db $06 ;start of 'ld b,*` just to eat the next byte
2766
_pow_1:
2767
xor a
2768
comp_exp:
2769
pop hl
2770
rr l
2771
jr nc,_pow_2
2772
cpl
2773
or a
2774
jp z,exp_underflow+1
2775
;perform 1-(var48+10)--> var48+10
2776
ld hl,const_1
2777
ld de,var48+10
2778
ld b,d
2779
ld c,e
2780
call subSingle
2781
_pow_2:
2782
push af
2783
;our 'x' is at var48+10
2784
;our `temp` is at var48+6 so as not to cause issues with mulSingle)
2785
;uses 14 bytes of RAM
2786
ld hl,var48+10
2787
ld de,exp_a6
2788
ld bc,var48+6
2789
call mulSingle
2790
ld d,b
2791
ld e,c
2792
ld hl,exp_a5
2793
call addSingle
2794
ld hl,var48+10
2795
call mulSingle
2796
ld hl,exp_a4
2797
call addSingle
2798
ld hl,var48+10
2799
call mulSingle
2800
ld hl,exp_a3
2801
call addSingle
2802
ld hl,var48+10
2803
call mulSingle
2804
ld hl,exp_a2
2805
call addSingle
2806
ld hl,var48+10
2807
call mulSingle
2808
ld hl,exp_a1
2809
call addSingle
2810
ld hl,var48+10
2811
call mulSingle
2812
ld hl,const_1
2813
call addSingle
2814
ld hl,var48+9
2815
pop af
2816
add a,(hl)
2817
ld (hl),a
2818
ex de,hl
2819
pop de
2820
jp mov4
2821
exp_spec:
2822
;bit 6 means INF
2823
;bit 5 means NAN
2824
;no bits means zero
2825
;NAN -> NAN
2826
;+inf -> +inf
2827
;-inf -> +0 because lim approaches 0 from the right
2828
ld a,c
2829
add a,a
2830
jr z,exp_zero
2831
jp m,exp_inf
2832
;exp_NAN
2833
pop af
2834
ld de,0040h
2835
exp_return_spec:
2836
pop hl
2837
rr e
2838
ld (hl),a
2839
inc hl
2840
ld (hl),a
2841
inc hl
2842
ld (hl),e
2843
inc hl
2844
ld (hl),d
2845
ret
2846
exp_overflow:
2847
exp_inf:
2848
;+inf -> +inf
2849
;-inf -> +0 because lim approaches 0 from the right
2850
pop af
2851
sbc a,a ;FF if should be 0,
2852
cpl
2853
and 80h
2854
ld d,0
2855
ld e,a
2856
jr exp_return_spec
2857
exp_underflow:
2858
exp_zero:
2859
pop af
2860
or a
2861
ld de,$8000
2862
jr exp_return_spec
2863
2864
;---------------------------------------------------------------------------------------------------------
2865
; sqrtSingle
2866
;---------------------------------------------------------------------------------------------------------
2867
2868
;Uses 3 bytes at scrap
2869
sqrtSingle:
2870
;552+{0,19}+8{0,3+{0,3}}+pushpop+sqrtHLIX
2871
;min: 1784
2872
;max: 1987
2873
;avg: 1872
2874
call pushpop
2875
push bc
2876
ld c,(hl)
2877
inc hl
2878
ld e,(hl)
2879
inc hl
2880
ld a,(hl)
2881
add a,a
2882
jp c,sqrtSingle_NaN
2883
scf
2884
rra
2885
ld d,a
2886
inc hl
2887
ld a,(hl)
2888
or a
2889
jp z,sqrtSingle_special
2890
add a,80h
2891
rra
2892
push af ;new exponent
2893
jr c,_13
2894
srl d
2895
rr e
2896
rr c
2897
_13:
2898
ex de,hl
2899
ld ixh,c
2900
ld ixl,0
2901
call sqrtHLIX
2902
;AHL is the new remainder
2903
;Need to divide by 2, then divide by the 16-bit (var_x+4)
2904
rra
2905
ld a,h
2906
;HL/DE to 8 bits
2907
;We are just going to approximate it
2908
res 0,l
2909
jr c,$+5
2910
cp d
2911
jr c,$+4
2912
sub d
2913
inc l
2914
sla l
2915
rla
2916
jr c,$+5
2917
cp d
2918
jr c,$+4
2919
sub d
2920
inc l
2921
sla l
2922
rla
2923
jr c,$+5
2924
cp d
2925
jr c,$+4
2926
sub d
2927
inc l
2928
sla l
2929
rla
2930
jr c,$+5
2931
cp d
2932
jr c,$+4
2933
sub d
2934
inc l
2935
sla l
2936
rla
2937
jr c,$+5
2938
cp d
2939
jr c,$+4
2940
sub d
2941
inc l
2942
sla l
2943
rla
2944
jr c,$+5
2945
cp d
2946
jr c,$+4
2947
sub d
2948
inc l
2949
sla l
2950
rla
2951
jr c,$+5
2952
cp d
2953
jr c,$+4
2954
sub d
2955
inc l
2956
sla l
2957
rla
2958
jr c,$+5
2959
cp d
2960
jr c,$+4
2961
sub d
2962
inc l
2963
2964
pop bc
2965
ld a,l
2966
pop hl
2967
;BDEA
2968
ld (hl),a
2969
inc hl
2970
ld (hl),e
2971
inc hl
2972
res 7,d
2973
ld (hl),d
2974
inc hl
2975
ld (hl),b
2976
ret
2977
sqrtSingle_NaN:
2978
ld hl,const_NaN
2979
pop de
2980
jp mov4
2981
sqrtSingle_special:
2982
dec hl
2983
dec hl
2984
pop de
2985
jp mov4
2986
2987
sqrtHLIX:
2988
;Input: HLIX
2989
;Output: DE is the sqrt, AHL is the remainder
2990
;speed: 754+{0,1}+6{0,6}+{0,3+{0,18}}+{0,38}+sqrtHL
2991
;min: 1130
2992
;max: 1266
2993
;avg: 1190.5
2994
2995
2996
call sqrtHL
2997
add a,a
2998
ld e,a
2999
jr nc,_14
3000
inc d
3001
_14:
3002
3003
ld a,ixh
3004
sll e
3005
rl d
3006
add a,a
3007
adc hl,hl
3008
add a,a
3009
adc hl,hl
3010
sbc hl,de
3011
jr nc,_15
3012
add hl,de
3013
dec e
3014
jr _15a ;.db $FE ;start of `cp *`
3015
_15:
3016
inc e
3017
_15a:
3018
sll e
3019
rl d
3020
add a,a
3021
adc hl,hl
3022
add a,a
3023
adc hl,hl
3024
sbc hl,de
3025
jr nc,_16
3026
add hl,de
3027
dec e
3028
jr _16a ;.db $FE ;start of `cp *`
3029
_16:
3030
inc e
3031
_16a:
3032
sll e
3033
rl d
3034
add a,a
3035
adc hl,hl
3036
add a,a
3037
adc hl,hl
3038
sbc hl,de
3039
jr nc,_17
3040
add hl,de
3041
dec e
3042
jr _17a ;.db $FE ;start of `cp *`
3043
_17:
3044
inc e
3045
_17a:
3046
sll e
3047
rl d
3048
add a,a
3049
adc hl,hl
3050
add a,a
3051
adc hl,hl
3052
sbc hl,de
3053
jr nc,_18
3054
add hl,de
3055
dec e
3056
jr _18a ;.db $FE ;start of `cp *`
3057
_18:
3058
inc e
3059
_18a:
3060
;Now we have four more iterations
3061
;The first two are no problem
3062
ld a,ixl
3063
sll e
3064
rl d
3065
add a,a
3066
adc hl,hl
3067
add a,a
3068
adc hl,hl
3069
sbc hl,de
3070
jr nc,_19
3071
add hl,de
3072
dec e
3073
jr _19a ;.db $FE ;start of `cp *`
3074
_19:
3075
inc e
3076
_19a:
3077
sll e
3078
rl d
3079
add a,a
3080
adc hl,hl
3081
add a,a
3082
adc hl,hl
3083
sbc hl,de
3084
jr nc,_20
3085
add hl,de
3086
dec e
3087
jr _20a ;.db $FE ;start of `cp *`
3088
_20:
3089
inc e
3090
_20a:
3091
sqrt32_iter15:
3092
;On the next iteration, HL might temporarily overflow by 1 bit
3093
sll e
3094
rl d ;sla e \ rl d \ inc e
3095
add a,a
3096
adc hl,hl
3097
add a,a
3098
adc hl,hl ;This might overflow!
3099
jr c,sqrt32_iter15_br0
3100
;
3101
sbc hl,de
3102
jr nc,_21
3103
add hl,de
3104
dec e
3105
jr sqrt32_iter16
3106
sqrt32_iter15_br0:
3107
or a
3108
sbc hl,de
3109
_21:
3110
inc e
3111
3112
;On the next iteration, HL is allowed to overflow, DE could overflow with our current routine, but it needs to be shifted right at the end, anyways
3113
sqrt32_iter16:
3114
add a,a
3115
ld b,a ;either 0x00 or 0x80
3116
adc hl,hl
3117
rla
3118
adc hl,hl
3119
rla
3120
;AHL - (DE+DE+1)
3121
sbc hl,de
3122
sbc a,b
3123
inc e
3124
or a
3125
sbc hl,de
3126
sbc a,b
3127
ret p
3128
add hl,de
3129
adc a,b
3130
dec e
3131
add hl,de
3132
adc a,b
3133
ret
3134
3135
sqrtHL:
3136
;returns A as the sqrt, HL as the remainder, D = 0
3137
;min: 376cc
3138
;max: 416cc
3139
;avg: 393cc
3140
ld de,$5040
3141
ld a,h
3142
sub e
3143
jr nc,_22
3144
add a,e
3145
ld d,$10
3146
_22:
3147
sub d
3148
jr nc,_23
3149
add a,d
3150
jr _23a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3151
_23:
3152
set 5,d
3153
_23a:
3154
res 4,d
3155
srl d
3156
3157
set 2,d
3158
sub d
3159
jr nc,_24
3160
add a,d
3161
jr _24a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3162
_24:
3163
set 3,d
3164
_24a:
3165
res 2,d
3166
srl d
3167
3168
inc d
3169
sub d
3170
jr nc,_25
3171
add a,d
3172
dec d ;this resets the low bit of D, so `srl d` resets carry.
3173
jr _25a ;.db $06 ;start of ld b,* which is 7cc to skip the next byte.
3174
_25:
3175
inc d
3176
_25a:
3177
srl d
3178
ld h,a
3179
3180
3181
sbc hl,de
3182
ld a,e
3183
jr nc,_26
3184
add hl,de
3185
_26:
3186
ccf
3187
rra
3188
srl d
3189
rra
3190
ld e,a
3191
3192
sbc hl,de
3193
jr nc,_27
3194
add hl,de
3195
jr _27a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3196
_27:
3197
or %00100000
3198
_27a:
3199
xor %00011000
3200
srl d
3201
rra
3202
ld e,a
3203
3204
3205
sbc hl,de
3206
jr nc,_28
3207
add hl,de
3208
jr _28a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3209
_28:
3210
or %00001000
3211
_28a:
3212
xor %00000110
3213
srl d
3214
rra
3215
ld e,a
3216
sbc hl,de
3217
jr nc,_29
3218
add hl,de
3219
srl d
3220
rra
3221
ret
3222
_29:
3223
inc a
3224
srl d
3225
rra
3226
ret
3227
3228
;---------------------------------------------------------------------------------------------------------
3229
; lnSingle
3230
;---------------------------------------------------------------------------------------------------------
3231
3232
lnSingle: ret
3233
3234
;---------------------------------------------------------------------------------------------------------
3235
; lgSingle
3236
;---------------------------------------------------------------------------------------------------------
3237
3238
lgSingle: ret
3239
3240
;---------------------------------------------------------------------------------------------------------
3241
; expSingle
3242
;---------------------------------------------------------------------------------------------------------
3243
3244
expSingle:
3245
;;Computes e^x
3246
;;HL points to x
3247
;;BC points to the output
3248
call pushpop
3249
ld de,const_lg_e
3250
push bc
3251
pow_inject:
3252
;;DE points to lg(y), HL points to x, BC points to output
3253
ld bc,var_x
3254
call mulSingle
3255
ld h,b
3256
ld l,c
3257
jp exp_inject
3258
3259
;---------------------------------------------------------------------------------------------------------
3260
; sinSingle
3261
;---------------------------------------------------------------------------------------------------------
3262
3263
sinSingle: ret
3264
3265
;---------------------------------------------------------------------------------------------------------
3266
; cosSingle
3267
;---------------------------------------------------------------------------------------------------------
3268
3269
cosSingle: ret
3270
3271
;---------------------------------------------------------------------------------------------------------
3272
; tanSingle
3273
;---------------------------------------------------------------------------------------------------------
3274
3275
tanSingle: ret
3276
3277
;---------------------------------------------------------------------------------------------------------
3278
; atanSingle
3279
;---------------------------------------------------------------------------------------------------------
3280
3281
atanSingle: ret
3282
3283
;---------------------------------------------------------------------------------------------------------
3284
; cmpSingle
3285
;---------------------------------------------------------------------------------------------------------
3286
3287
cmpSingle:
3288
;Input: DE points to float1, HL points to float2
3289
;Output:
3290
; float1 >= float2 : nc
3291
; float1 < float2 : c,nz
3292
; float1 == float2 : z
3293
; There is a margin of error allowed in the lower 2 bits of the mantissa.
3294
;
3295
;Currently fails when both numbers have magnitude less than about 2^-106
3296
push hl
3297
push de
3298
push bc
3299
call _30
3300
pop bc
3301
pop de
3302
pop hl
3303
ret
3304
_30:
3305
inc de
3306
inc de
3307
inc de
3308
ld a,(de)
3309
inc hl
3310
inc hl
3311
inc hl
3312
cp (hl)
3313
jr nc,_31
3314
ld a,(hl)
3315
_31:
3316
dec hl
3317
dec hl
3318
dec hl
3319
dec de
3320
dec de
3321
dec de
3322
push af
3323
ld bc,scrap
3324
call subSingle
3325
ld a,(scrap+3) ;new power
3326
pop bc ;B is old power
3327
or a
3328
jr z,cmp_close
3329
sub b
3330
jr nc,cmp_is_sign
3331
dec a
3332
add a,22
3333
jr nc,cmp_close
3334
cmp_is_sign:
3335
ld a,(scrap+2)
3336
or 1 ;not equal, so reset z flag
3337
rla ;if negative, float1<float2, setting c flag as wanted, else nc.
3338
ret
3339
cmp_close:
3340
xor a
3341
ret
3342
3343
;---------------------------------------------------------------------------------------------------------
3344
; randSingle
3345
;---------------------------------------------------------------------------------------------------------
3346
3347
randSingle:
3348
;Stores a pseudo-random number on [0,1)
3349
;it won't produce values on (0,2^-23)
3350
call pushpop
3351
push bc
3352
call rand
3353
push hl
3354
call rand
3355
pop de
3356
ex de,hl
3357
ld bc,$207F
3358
;DEHL is the mantissa, B is the exponent
3359
ld a,d
3360
or a
3361
jp m,rand_normed
3362
_32:
3363
dec c
3364
add hl,hl
3365
rl e
3366
rl d
3367
jp m,rand_normed
3368
djnz _32
3369
rand_zero:
3370
ld c,l
3371
ld b,l
3372
jr rand_done
3373
rand_normed:
3374
;If we needed to shift more than 8 bits, we'll load in more random data
3375
ld a,b
3376
cp 8
3377
jr c,rand_zero
3378
sub 24
3379
jp nc,rand_no_more_rand_data
3380
push bc
3381
push de
3382
call rand
3383
pop de
3384
ld e,h
3385
ld h,l
3386
pop bc
3387
rand_no_more_rand_data:
3388
ld b,e
3389
ld e,d
3390
ld d,c
3391
ld c,h
3392
res 7,e
3393
rand_done:
3394
pop hl
3395
;DEBC
3396
ld (hl),b
3397
inc hl
3398
ld (hl),c
3399
inc hl
3400
ld (hl),e
3401
inc hl
3402
ld (hl),d
3403
ret
3404
3405
rand:
3406
;;Tested and passes all CAcert tests
3407
;;Uses a very simple 32-bit LCG and 32-bit LFSR
3408
;;it has a period of 18,446,744,069,414,584,320
3409
;;roughly 18.4 quintillion.
3410
;;LFSR taps: 0,2,6,7 = 11000101
3411
;;323cc
3412
;;Thanks to Runer112 for his help on optimizing the LCG and suggesting to try the much simpler LCG. On their own, the two are terrible, but together they are great.
3413
;Uses 64 bits of state
3414
ld hl,(seed0)
3415
ld de,(seed0+2)
3416
ld b,h
3417
ld c,l
3418
add hl,hl
3419
rl e
3420
rl d
3421
add hl,hl
3422
rl e
3423
rl d
3424
inc l
3425
add hl,bc
3426
ld (seed0),hl
3427
ld hl,(seed0+2)
3428
adc hl,de
3429
ld (seed0+2),hl
3430
ex de,hl
3431
;;lfsr
3432
ld hl,(seed1)
3433
ld bc,(seed1+2)
3434
add hl,hl
3435
rl c
3436
rl b
3437
ld (seed1+2),bc
3438
sbc a,a
3439
and %11000101
3440
xor l
3441
ld l,a
3442
ld (seed1),hl
3443
ex de,hl
3444
add hl,bc
3445
ret
3446
3447
;---------------------------------------------------------------------------------------------------------
3448
; single2Str
3449
; HL = Single address
3450
; BC = String address
3451
; http://0x80.pl/notesen/2015-12-29-float-to-string.html
3452
; http://0x80.pl/articles/convert-float-to-integer.html
3453
;---------------------------------------------------------------------------------------------------------
3454
3455
single2str:
3456
call pushpop
3457
push bc
3458
call _33
3459
pop de
3460
xor a
3461
cp (hl)
3462
ldi
3463
jr nz,$-3
3464
3465
ret
3466
_33:
3467
; Move the float to scrap
3468
ld de,scrap
3469
call mov4
3470
3471
; Make the float negative, write a '-' if already negative
3472
ld de,strout_single
3473
ld hl,scrap+2
3474
ld a,(hl)
3475
rlca
3476
scf
3477
rra
3478
ld (hl),a
3479
jr nc,_34
3480
ld a,$1A
3481
ld (de),a
3482
inc de
3483
_34:
3484
3485
; Check if the exponent field is 0 (a special value)
3486
inc hl
3487
ld a,(hl)
3488
or a
3489
jp z,strcase_single
3490
3491
3492
; We should write '0' next. When rounding 9.999999... for example, not padding with a 0 will return '.' instead of '1.'
3493
ex de,hl
3494
ld (hl),'0'
3495
inc hl
3496
3497
; Save the pointer
3498
push hl
3499
3500
; Now we need to perform signed (A-128)*77 (approximation of exponent*log10(2))
3501
ld de,77
3502
ld h,a
3503
ld l,d
3504
call mul8_preset
3505
ld de,-77*128
3506
add hl,de
3507
ld a,h
3508
ld (pow10exp_single),a ;The base-10 exponent
3509
ld de,pown10LUT
3510
jr c,_35
3511
neg
3512
ld de,pow10LUT ;get the table of 10^-(2^k)
3513
_35:
3514
ld bc,scrap
3515
call singletostr_mul
3516
call singletostr_mul
3517
call singletostr_mul
3518
call singletostr_mul
3519
call singletostr_mul
3520
call singletostr_mul
3521
;now the number is pretty close to a nice value
3522
3523
; If it is less than 1, multiply by 10
3524
ld a,(scrap+3)
3525
sub 128
3526
jr nc,_36
3527
ld de,const_10
3528
;ld hl,scrap ;Since singletostr_mul returns BC = scrap, can do this cheaper
3529
;ld b,h
3530
;ld c,l
3531
ld h,b
3532
ld l,c
3533
call mulSingle
3534
ld hl,pow10exp_single
3535
dec (hl)
3536
ld a,(scrap+3)
3537
sub 128
3538
_36:
3539
3540
; Convert to a fixed-point number !
3541
inc a
3542
ld b,a
3543
xor a
3544
_37:
3545
ld hl,scrap
3546
sla (hl)
3547
inc hl
3548
rl (hl)
3549
inc hl
3550
rl (hl)
3551
rla
3552
djnz _37
3553
3554
;We need to get 7 digits
3555
ld b,6
3556
pop hl ;Points to the string
3557
3558
;The first digit can be as large as 20, so it'll actually be two digits
3559
cp 10
3560
jr c,_38
3561
dec b
3562
;Increment the exponent :)
3563
ld de,(pow10exp_single-1)
3564
inc d
3565
ld (pow10exp_single-1),de
3566
;
3567
ld (hl),'0'-1
3568
inc (hl)
3569
sub 10
3570
jr nc,$-3
3571
add a,10
3572
inc hl
3573
_38:
3574
; Get the remaining digits.
3575
_39:
3576
add a,'0'
3577
ld (hl),a
3578
inc hl
3579
push hl
3580
push bc
3581
call singletostrmul10
3582
pop bc
3583
pop hl
3584
djnz _39
3585
3586
;Save the pointer to the end of the string
3587
ld d,h
3588
ld e,l
3589
;ld (hl), 0
3590
3591
;Now let's round!
3592
cp 5
3593
jr c,rounding_done_single
3594
jr _40a ;.db $DA ;start of `jp c,*` in order to skip the next instruction
3595
_40:
3596
ld (hl),'0'
3597
_40a:
3598
dec hl
3599
inc (hl)
3600
ld a,(hl)
3601
cp $3A
3602
jr z,_40
3603
rounding_done_single:
3604
3605
3606
;Strip the leading zero if it exists (rounding may have bumped this to `1`)
3607
ld hl,strout_single
3608
ld a,(hl)
3609
cp $1A
3610
jr nz,_41
3611
inc hl
3612
ld a,(hl)
3613
_41:
3614
cp '0'
3615
jr nz,_42
3616
dec de
3617
ex de,hl
3618
;Now lets move HL-DE bytes at DE+1 to DE
3619
sbc hl,de
3620
ld b,h
3621
ld c,l
3622
ld h,d
3623
ld l,e
3624
inc hl
3625
ldir
3626
cp a
3627
_42:
3628
3629
push de
3630
;If z flag is reset, this means that the exponent should be bumped up 1
3631
ld a,(pow10exp_single)
3632
jr z,_43
3633
inc a
3634
ld (pow10exp_single),a
3635
_43:
3636
3637
;if -4<=A<=6, then need to insert the decimal place somewhere.
3638
add a,4
3639
cp 10
3640
jp c,movdec_single
3641
_44:
3642
;for this, we need to insert the decimal after the first digit
3643
;Then, we need to append the exponent string
3644
ld hl,strout_single
3645
ld de,strout_single-1
3646
ld a,(hl)
3647
cp $1A ;negative sign
3648
jr nz,_45
3649
ldi
3650
_45:
3651
ldi
3652
ld a,'.'
3653
ld (de),a
3654
3655
;remove any stray zeroes at the end before appending the exponent
3656
pop hl
3657
call strip_zeroes
3658
3659
; Write the exponent
3660
ld (hl),'e'
3661
inc hl
3662
ld a,(pow10exp_single)
3663
or a
3664
jp p,_46
3665
ld (hl),$1A ;negative sign
3666
inc hl
3667
neg
3668
_46:
3669
cp 10
3670
jr c,_47
3671
ld (hl),'0'-1
3672
inc (hl)
3673
sub 10
3674
jr nc,$-3
3675
add a,10
3676
inc hl
3677
_47:
3678
add a,'0'
3679
ld (hl),a
3680
inc hl
3681
ld (hl),0
3682
ld hl,strout_single-1
3683
ret
3684
movdec_single:
3685
ld a,(pow10exp_single)
3686
or a
3687
jp p,posdec_single
3688
ld l,a
3689
;need to put zeroes before everything
3690
ld de,strout_single
3691
ld a,(de)
3692
cp $1A ;negative sign
3693
push af
3694
ld a,'0'
3695
jr z,$+3
3696
_48:
3697
dec de
3698
ld (de),a
3699
inc l
3700
jr nz,_48
3701
_49:
3702
ex de,hl
3703
ld (hl),'.'
3704
pop af
3705
jr nz,_50
3706
dec hl
3707
ld (hl),a
3708
_50:
3709
ex de,hl
3710
pop hl
3711
call strip_zeroes
3712
ld (hl),0
3713
ex de,hl
3714
ret
3715
3716
posdec_single:
3717
ld hl,strout_single
3718
ld de,strout_single-1
3719
ld c,a
3720
ld a,(hl)
3721
ld b,0
3722
cp $1A ;negative sign
3723
jr nz,_51
3724
inc c
3725
_51:
3726
inc c
3727
ldir
3728
ld a,'.'
3729
ld (de),a
3730
pop hl
3731
call strip_zeroes
3732
ld (hl),0
3733
ld hl,strout_single-1
3734
ret
3735
strcase_single:
3736
ld hl,str_Zero
3737
ld a,(scrap+2)
3738
add a,a
3739
and $C0
3740
jr z,_52
3741
ld hl,str_Inf
3742
jp pe,_52
3743
ld hl,str_NaN
3744
_52:
3745
call mov4
3746
ld hl,strout_single
3747
ret
3748
3749
singletostrmul10:
3750
;multiply the 0.24 fixed point number at scrap by 10
3751
;overflow in A register
3752
ld a,(scrap+2)
3753
ld e,a
3754
ld hl,(scrap)
3755
xor a
3756
ld d,e
3757
ld b,h
3758
ld c,l
3759
add hl,hl
3760
rl d
3761
rla
3762
add hl,hl
3763
rl d
3764
rla
3765
add hl,bc
3766
ld b,a
3767
ld a,d
3768
adc a,e
3769
ld d,a
3770
ld a,b
3771
adc a,0
3772
add hl,hl
3773
rl d
3774
rla
3775
ld (scrap+1),de
3776
ld (scrap),hl
3777
ret
3778
3779
strip_zeroes:
3780
ld a,'0'
3781
_53:
3782
dec hl
3783
cp (hl)
3784
jr z,_53
3785
3786
;Check that the last digit isn't a decimal!
3787
ld a,'.'
3788
cp (hl)
3789
ret z
3790
inc hl
3791
ret
3792
3793
singletostr_mul:
3794
rra
3795
call c,_54
3796
ld hl,4
3797
add hl,de
3798
ex de,hl
3799
ret
3800
_54:
3801
ld h,b
3802
ld l,c
3803
jp mulSingle
3804
mul8:
3805
;H*E => HL
3806
ld l,0
3807
ld d,l
3808
mul8_preset:
3809
sla h
3810
jr nc,$+3
3811
ld l,e
3812
add hl,hl
3813
jr nc,$+3
3814
add hl,de
3815
add hl,hl
3816
jr nc,$+3
3817
add hl,de
3818
add hl,hl
3819
jr nc,$+3
3820
add hl,de
3821
add hl,hl
3822
jr nc,$+3
3823
add hl,de
3824
add hl,hl
3825
jr nc,$+3
3826
add hl,de
3827
add hl,hl
3828
jr nc,$+3
3829
add hl,de
3830
add hl,hl
3831
ret nc
3832
add hl,de
3833
ret
3834
3835
3836
;---------------------------------------------------------------------------------------------------------
3837
; str2Single
3838
; https://www.ticalc.org/pub/86/asm/source/routines/atof.asm
3839
;---------------------------------------------------------------------------------------------------------
3840
3841
;#ifdef char_TI_TOK
3842
char_NEG: equ $1A
3843
char_ENG: equ $1B
3844
char_DEC: equ '.'
3845
;#else
3846
;;otherwise, char_TI_CHR
3847
;char_NEG: equ $B0
3848
;char_ENG: equ $3B
3849
;char_DEC: equ $3A
3850
;#endif
3851
ptr_sto: equ scrap+9
3852
str2single:
3853
;;#Routines/Single Precision
3854
;;Inputs:
3855
;; HL points to the string
3856
;; BC points to where the float is output
3857
;;Output:
3858
;; scrap+9 is the pointer to the end of the string
3859
;;Destroys:
3860
;; 11 bytes at scrap ?
3861
call pushpop
3862
push bc
3863
;Check if there is a negative sign.
3864
; Save for later
3865
; Advance ptr
3866
ld a,(hl)
3867
sub char_NEG
3868
sub 1
3869
push af
3870
jr nc,$+3
3871
inc hl
3872
;Skip all leading zeroes
3873
ld a,(hl)
3874
cp '0'
3875
jr z,$-4 ;jumps back to the `inc hl`
3876
;Set exponent to 0
3877
ld b,0
3878
;Check if the next char is char_DEC
3879
sub char_DEC
3880
or a ;to reset the carry flag
3881
jr nz,_55
3882
jr _54a ;.db $FE ;start of cp *
3883
;Get rid of zeroes
3884
dec b
3885
_54a:
3886
inc hl
3887
ld a,(hl)
3888
cp '0'
3889
jr z,$-5 ;jumps back to the `dec b`
3890
scf
3891
_55:
3892
;Now we read in the next 8 digits
3893
ld de,scrap+3
3894
call ascii_to_uint8
3895
call ascii_to_uint8
3896
call ascii_to_uint8
3897
call ascii_to_uint8
3898
;Now `scrap` holds the 4-digit base-100 number.
3899
;b is the exponent
3900
;if carry flag is set, just need to get rid of remaining digits
3901
;Otherwise, need to get rid of remaining digits, while incrementing the exponent
3902
sbc a,a
3903
inc a
3904
ld c,a
3905
_56:
3906
ld a,(hl)
3907
cp 30h
3908
jr nz,_57
3909
inc hl
3910
ld a,b
3911
add a,c
3912
jp z,strToSingle_inf
3913
ld b,a
3914
jr _56
3915
;Now check for engineering `E` to modify the exponent
3916
_57:
3917
cp char_NEG
3918
call z,str_eng_exp
3919
;Gotta multiply the number at (scrap) by 2^24
3920
ld (ptr_sto),hl
3921
ld d,100
3922
call scrap_times_256
3923
ld a,c
3924
ld (scrap+6),a
3925
call scrap_times_256
3926
ld a,c
3927
ld (scrap+5),a
3928
call scrap_times_256
3929
ld a,c
3930
ld (scrap+4),a
3931
call scrap_times_256
3932
ld a,c
3933
ld (scrap+3),a
3934
;Now scrap+3 is a 4-byte mantissa that needs to be normalized
3935
;
3936
ld hl,(scrap+3)
3937
ld a,h
3938
or l
3939
ld hl,(scrap+5)
3940
or l
3941
or h
3942
jp z,strToSingle_zero-1
3943
ld c,$7F
3944
ld a,h
3945
or a
3946
jp m,strToSingle_normed
3947
;Will need to iterate at most three times
3948
_58:
3949
dec c
3950
ld hl,scrap+3
3951
sla (hl)
3952
inc hl
3953
rl (hl)
3954
inc hl
3955
rl (hl)
3956
inc hl
3957
adc a,a
3958
jp p,_58
3959
strToSingle_normed:
3960
;Move the number to scrap
3961
ld hl,(scrap+4)
3962
ld (scrap),hl
3963
ld l,a
3964
ld h,c
3965
sla l
3966
pop af
3967
rr l
3968
ld (scrap+2),hl
3969
;now (scrap) is our number, need to multiply by power of 10!
3970
;Power of 10 is stored in B, need to put in A first
3971
xor a
3972
sub b
3973
ld de,pown10LUT
3974
jp p,_59
3975
ld a,b
3976
ld de,pow10LUT
3977
cp 40
3978
jp nc,strToSingle_inf+1
3979
_59:
3980
cp 40
3981
jp nc,strToSingle_zero
3982
ld hl,scrap
3983
ld b,h
3984
ld c,l
3985
call _60
3986
call _60
3987
call _60
3988
call _60
3989
call _60
3990
call _60
3991
pop de
3992
jp mov4
3993
_60:
3994
rra
3995
call c,mulSingle
3996
inc de
3997
inc de
3998
inc de
3999
inc de
4000
ret
4001
str_eng_exp:
4002
ld de,0
4003
inc hl
4004
ld a,(hl)
4005
cp char_NEG ;negative exponent?
4006
push af
4007
jr nz,$+3
4008
inc hl
4009
_61:
4010
ld a,(hl)
4011
sub 3Ah
4012
add a,10
4013
jr nc,_62
4014
inc hl
4015
push hl
4016
ld h,d
4017
ld l,e
4018
add hl,hl
4019
add hl,hl
4020
add hl,de
4021
add hl,hl
4022
add a,l
4023
ld l,a
4024
ex de,hl
4025
pop hl
4026
jp c,eng_overflow
4027
inc d
4028
dec d
4029
jp z,_61
4030
jp nz,eng_overflow
4031
_62:
4032
ld a,e
4033
cp 40
4034
jr nc,eng_overflow
4035
pop af
4036
ld a,b
4037
jr nz,_63
4038
sub e
4039
ld b,a
4040
ret
4041
_63:
4042
add a,e
4043
ld b,a
4044
ret
4045
scrap_times_256:
4046
ld e,8
4047
_64:
4048
or a
4049
ld hl,scrap
4050
call _65
4051
call _65
4052
rl c
4053
dec e
4054
jr nz,_64
4055
ret
4056
_65:
4057
call scrap_times_sub
4058
scrap_times_sub:
4059
ld a,(hl)
4060
rla
4061
cp d
4062
jr c,$+3
4063
sub d
4064
ld (hl),a
4065
inc hl
4066
ccf
4067
ret
4068
eng_overflow:
4069
pop af
4070
jr nz,strToSingle_inf
4071
pop af
4072
strToSingle_zero:
4073
ld hl,const_0
4074
pop de
4075
jp mov4
4076
strToSingle_inf:
4077
;return inf
4078
pop af
4079
ld hl,const_inf
4080
jr nc,_66
4081
ld hl,const_NegInf
4082
_66:
4083
pop de
4084
jp mov4
4085
4086
;---------------------------------------------------------------------------------------------------------
4087
; int2Single
4088
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division
4089
;---------------------------------------------------------------------------------------------------------
4090
4091
int2Single:
4092
ld hl, (BASIC_DAC+2) ; convert integer DAC parameter to single float
4093
ld e, 0 ; digits count
4094
ld c, 10
4095
ld a, h
4096
and 0x80
4097
push af ; save sign (0=positive, 0x80=negative)
4098
jr z, int2Single.div10
4099
ld a, b ;\
4100
cpl ; |
4101
inc a ; | abs(b)
4102
ld b, a ;/
4103
4104
int2Single.div10:
4105
call div_hl_c ; get next digit
4106
push af ; save digit
4107
inc e
4108
xor a
4109
or h
4110
jr nz, int2Single.div10
4111
or l
4112
jr nz, int2Single.div10
4113
4114
int2Single.normalize:
4115
ld b, e ; digits count
4116
push bc
4117
exx
4118
pop bc
4119
exx
4120
ld de, 0 ; mantissa
4121
ld hl, 0
4122
4123
int2Single.normalize.1:
4124
pop af ; restore next digit
4125
ld d, a
4126
ld c, 10
4127
call div_dehl_c
4128
djnz int2Single.normalize.1
4129
4130
ld a, e
4131
and 0x7f ; turn off upper bit
4132
ld e, a
4133
4134
pop af ; restore sign
4135
or e ; put sign
4136
ld e, a ; into upper mantissa
4137
4138
exx ; restore exponent count
4139
push bc
4140
exx
4141
pop bc
4142
ld a, b
4143
or 0x80 ; exponent bias
4144
ld d, a
4145
4146
int2Single.float:
4147
ld ix, BASIC_DAC
4148
ld (ix), l ; mantissa
4149
ld (ix+1), h ; mantissa
4150
ld (ix+2), e ; sign + mantissa
4151
ld (ix+3), d ; expoent
4152
ld (ix+4), 0
4153
ld (ix+5), 0
4154
ld (ix+6), 0
4155
ld (ix+7), 0
4156
ret
4157
4158
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division
4159
div_ehl_d:
4160
xor a
4161
ld b, 24
4162
div_ehl_d.loop:
4163
add hl, hl
4164
rl e
4165
rla
4166
jr c, $+5
4167
cp d
4168
jr c, $+4
4169
sub d
4170
inc l
4171
djnz div_ehl_d.loop
4172
ret
4173
4174
div_dehl_c:
4175
push bc
4176
xor a
4177
ld b, 32
4178
div_dehl_c.loop:
4179
add hl, hl
4180
rl e
4181
rl d
4182
rla
4183
jr c, $+5
4184
cp c
4185
jr c, $+4
4186
sub c
4187
inc l
4188
djnz div_dehl_c.loop
4189
pop bc
4190
ret
4191
4192
;---------------------------------------------------------------------------------------------------------
4193
; single2Int
4194
; http://0x80.pl/articles/convert-float-to-integer.html
4195
;---------------------------------------------------------------------------------------------------------
4196
single2Int:
4197
;Input:
4198
; HL points to the single-precision float
4199
;Output:
4200
; HL is the 16-bit signed integer part of the float
4201
push de
4202
push bc
4203
push af
4204
ld e,(hl)
4205
inc hl
4206
ld d,(hl)
4207
inc hl
4208
ld a,(hl)
4209
add a,a
4210
push af
4211
scf
4212
rra
4213
ld c,a
4214
inc hl
4215
ld a,(hl)
4216
ld hl,0
4217
sub 80h
4218
jr c,no_shift_single_to_int16
4219
cp 39
4220
jr nc,no_shift_single_to_int16
4221
sub 8
4222
jr c,_67
4223
ld l,c
4224
ld c,d
4225
ld d,e
4226
ld e,h
4227
sub 8
4228
jr c,_67
4229
ld h,l
4230
ld l,c
4231
ld c,d
4232
ld d,e
4233
sub 8
4234
jr c,_67
4235
ld h,l
4236
ld l,c
4237
ld c,d
4238
sub 8
4239
jr c,_67
4240
ld h,l
4241
ld l,c
4242
jr _67a ;.db $11 ;start of ld de,*
4243
_67:
4244
add a,9
4245
_67a:
4246
ld b,a
4247
ld a,e
4248
_68:
4249
add a,a
4250
rl d
4251
rl c
4252
adc hl,hl
4253
djnz _68
4254
no_shift_single_to_int16:
4255
pop af
4256
jr nc,_69
4257
;need to negate
4258
xor a
4259
sub e
4260
ld e,0
4261
ld a,e
4262
sbc a,d
4263
ld a,e
4264
sbc a,c
4265
ld d,e
4266
ex de,hl
4267
sbc hl,de
4268
_69:
4269
pop af
4270
pop bc
4271
pop de
4272
ret
4273
4274
4275
;---------------------------------------------------------------------------------------------------------
4276
; Auxiliary routines
4277
;---------------------------------------------------------------------------------------------------------
4278
4279
str_Zero: db "0",0
4280
str_Inf: db "inf",0
4281
str_NaN: db "NaN",0
4282
4283
start_const:
4284
const_pi: db $DB,$0F,$49,$81
4285
const_e: db $54,$f8,$2d,$81
4286
const_lg_e: db $3b,$AA,$38,$80
4287
const_ln_2: db $18,$72,$31,$7f
4288
const_log2: db $9b,$20,$1a,$7e
4289
const_lg10: db $78,$9a,$54,$81
4290
const_0: db $00,$00,$00,$00
4291
const_1: db $00,$00,$00,$80
4292
const_inf: db $00,$00,$40,$00
4293
const_NegInf: db $00,$00,$C0,$00
4294
const_NaN: db $00,$00,$20,$00
4295
const_log10_e: db $D9,$5B,$5E,$7E
4296
const_2pi: db $DB,$0F,$49,$82
4297
const_2pi_inv: db $83,$F9,$22,$7D
4298
const_p25: db $00,$00,$00,$7E
4299
const_p5: db $00,$00,$00,$7F
4300
; db $,$,$,$
4301
end_const:
4302
sin_a1: db $A4,$AA,$2A,$7D ;a1= 2^-3 * 11184804/2^23
4303
sin_a2: db $AC,$83,$08,$79 ;a2= 2^-7 * 8946604/2^23
4304
sin_a3: db $11,$97,$4C,$73 ;a3=2^-13 * 13408017/2^23
4305
cos_a1: db $DA,$FF,$7F,$7E ;a1=2^-2 * 16777178/2^23
4306
cos_a2: db $5C,$9F,$2A,$7B ;a2=2^-5 * 11181916/2^23
4307
cos_a3: db $52,$26,$32,$76 ;a3=2^-10* 11675218/2^23
4308
exp_a1: db $15,$72,$31,$7F ;.693146989552
4309
exp_a2: db $CE,$FE,$75,$7D ;.2402298085906
4310
exp_a3: db $7B,$42,$63,$7B ;.0554833215071
4311
exp_a4: db $FD,$94,$1E,$79 ;.00967907584392
4312
exp_a5: db $5E,$01,$23,$76 ;.001243632065103
4313
exp_a6: db $5F,$B7,$63,$73 ;.0002171671843714
4314
const_1p40625: db $00,$00,$34,$80 ;1.40625
4315
4316
iconstSingle:
4317
ex (sp),hl
4318
ld a,(hl)
4319
inc hl
4320
ex (sp),hl
4321
constSingle:
4322
;A is the constant ID#
4323
;returns nc if failed, c otherwise
4324
;HL points to the constant
4325
cp (end_const-start_const)>>2
4326
ret nc
4327
ld hl,start_const
4328
add a,a
4329
add a,a
4330
add a,l
4331
ld l,a
4332
;#if ((end_const-4)>>8)!=(start_const>>8)
4333
; ccf
4334
; ret c
4335
; inc h
4336
;#endif
4337
scf
4338
ret
4339
4340
;;LUTs used
4341
lut:
4342
pown10LUT:
4343
db $CD,$CC,$4C,$7C ;.1
4344
db $0A,$D7,$23,$79 ;.01
4345
db $17,$B7,$51,$72 ;.0001
4346
db $77,$CC,$2B,$65 ;10^-8
4347
db $95,$95,$66,$4A ;10^-16
4348
db $1F,$B1,$4F,$15 ;10^-32
4349
pow10LUT:
4350
const_10:
4351
db $00,$00,$20,$83 ;10
4352
db $00,$00,$48,$86 ;100
4353
db $00,$40,$1C,$8D ;10000
4354
db $20,$BC,$3E,$9A ;10^8
4355
db $CA,$1B,$0E,$B5 ;10^16
4356
db $AE,$C5,$1D,$EA ;10^32
4357
4358
C_Times_BDE:
4359
;;C*BDE => CAHL
4360
;C = 0 157
4361
;C = 1 141
4362
;141+
4363
;C>=128 135+6{0,33+{0,1}}+{0,20+{0,8}}
4364
;C>=64 115+5{0,33+{0,1}}+{0,20+{0,8}}
4365
;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}
4366
;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}
4367
;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}
4368
;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}
4369
;C>=2 15+{0,20+{0,8}}
4370
;min: 141cc
4371
;max: 508cc
4372
;avg: 349.21279907227cc
4373
4374
ld a,b
4375
ld h,d
4376
ld l,e
4377
sla c
4378
jr c,mul8_24_1
4379
sla c
4380
jr c,mul8_24_2
4381
sla c
4382
jr c,mul8_24_3
4383
sla c
4384
jr c,mul8_24_4
4385
sla c
4386
jr c,mul8_24_5
4387
sla c
4388
jr c,mul8_24_6
4389
sla c
4390
jr c,mul8_24_7
4391
sla c
4392
ret c
4393
ld a,c
4394
ld h,c
4395
ld l,c
4396
ret
4397
mul8_24_1:
4398
add hl,hl
4399
rla
4400
rl c
4401
jr nc,$+7
4402
add hl,de
4403
adc a,b
4404
jr nc,$+3
4405
inc c
4406
mul8_24_2:
4407
add hl,hl
4408
rla
4409
rl c
4410
jr nc,$+7
4411
add hl,de
4412
adc a,b
4413
jr nc,$+3
4414
inc c
4415
mul8_24_3:
4416
add hl,hl
4417
rla
4418
rl c
4419
jr nc,$+7
4420
add hl,de
4421
adc a,b
4422
jr nc,$+3
4423
inc c
4424
mul8_24_4:
4425
add hl,hl
4426
rla
4427
rl c
4428
jr nc,$+7
4429
add hl,de
4430
adc a,b
4431
jr nc,$+3
4432
inc c
4433
mul8_24_5:
4434
add hl,hl
4435
rla
4436
rl c
4437
jr nc,$+7
4438
add hl,de
4439
adc a,b
4440
jr nc,$+3
4441
inc c
4442
mul8_24_6:
4443
add hl,hl
4444
rla
4445
rl c
4446
jr nc,$+7
4447
add hl,de
4448
adc a,b
4449
jr nc,$+3
4450
inc c
4451
mul8_24_7:
4452
add hl,hl
4453
rla
4454
rl c
4455
ret nc
4456
add hl,de
4457
adc a,b
4458
ret nc
4459
inc c
4460
ret
4461
4462
pushpop:
4463
;26 bytes, adds 118cc to the traditional routine
4464
ex (sp),hl
4465
push de
4466
push bc
4467
push af
4468
push hl
4469
ld hl,pushpopret
4470
ex (sp),hl
4471
push hl
4472
push af
4473
ld hl,12
4474
add hl,sp
4475
ld a,(hl)
4476
inc hl
4477
ld h,(hl)
4478
ld l,a
4479
pop af
4480
ret
4481
pushpopret:
4482
pop af
4483
pop bc
4484
pop de
4485
pop hl
4486
ret
4487
4488
mov4:
4489
ldi
4490
ldi
4491
ldi
4492
ldi
4493
ret
4494
4495
ascii_to_uint8:
4496
;c flag means don't increment the exponent
4497
ld c,0
4498
ld a,(hl)
4499
jr c,ascii_to_uint8_noexp
4500
cp char_DEC
4501
jr z,ascii_to_uint8_noexp-2
4502
_70:
4503
sub 3Ah
4504
add a,10
4505
jr nc,ascii_to_uint8_noexp_end
4506
inc b
4507
ld c,a
4508
add a,a
4509
add a,a
4510
add a,c
4511
add a,a
4512
ld c,a
4513
inc hl
4514
_71:
4515
ld a,(hl)
4516
cp char_DEC
4517
jr z,ascii_to_uint8_noexp_2nd
4518
_72:
4519
sub 3Ah
4520
add a,10
4521
jr nc,ascii_to_uint8_noexp_end
4522
inc b
4523
add a,c
4524
inc hl
4525
ld (de),a
4526
dec de
4527
or a
4528
ret
4529
4530
inc hl
4531
ld a,(hl)
4532
ascii_to_uint8_noexp:
4533
sub 3Ah
4534
add a,10
4535
jr nc,ascii_to_uint8_noexp_end
4536
ld c,a
4537
add a,a
4538
add a,a
4539
add a,c
4540
add a,a
4541
ld c,a
4542
ascii_to_uint8_noexp_2nd:
4543
inc hl
4544
ld a,(hl)
4545
sub 3Ah
4546
add a,10
4547
jr nc,ascii_to_uint8_noexp_end
4548
add a,c
4549
inc hl
4550
jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc
4551
ascii_to_uint8_noexp_end:
4552
ld a,c
4553
ascii_2:
4554
ld (de),a
4555
dec de
4556
scf
4557
ret
4558
4559
; --------------------------------------------------------------
4560
; Converts a signed integer value to a zero-terminated ASCII
4561
; string representative of that value (using radix 10).
4562
; References:
4563
; Brandon Wilson WikiTI
4564
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version
4565
; --------------------------------------------------------------
4566
; INPUTS:
4567
; HL Value to convert (two's complement integer).
4568
; DE Base address of string destination. (pointer).
4569
; --------------------------------------------------------------
4570
; OUTPUTS:
4571
; None
4572
; --------------------------------------------------------------
4573
; REGISTERS/MEMORY DESTROYED
4574
; AF HL
4575
; --------------------------------------------------------------
4576
4577
IntToStr:
4578
push de
4579
push bc
4580
4581
; Detect sign of HL.
4582
bit 7, h
4583
jr z, _DoConvert
4584
4585
; HL is negative. Output '-' to string and negate HL.
4586
ld a, '-'
4587
ld (de), a
4588
inc de
4589
4590
; Negate HL (using two's complement)
4591
xor a
4592
sub l
4593
ld l, a
4594
ld a, 0 ; Note that XOR A or SUB A would disturb CF
4595
sbc a, h
4596
ld h, a
4597
4598
; Convert HL to digit characters
4599
_DoConvert:
4600
ld b, 0 ; B will count character length of number
4601
_DoConvert.1:
4602
ld c, 10
4603
call div_hl_c; HL = HL / A, A = remainder
4604
push af
4605
inc b
4606
ld a, h
4607
or l
4608
jr nz, _DoConvert.1
4609
4610
; Retrieve digits from stack
4611
_DoConvert.2:
4612
pop af
4613
or $30
4614
ld (de), a
4615
inc de
4616
djnz _DoConvert.2
4617
4618
; Terminate string with NULL
4619
xor a
4620
ld (de), a
4621
4622
pop bc
4623
pop de
4624
ret
4625
4626
; divides hl by c
4627
; return remainder in a
4628
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division
4629
div_hl_c:
4630
push bc
4631
xor a
4632
ld b, 16
4633
div_hl_c.loop:
4634
add hl, hl
4635
rla
4636
jr c, $+5
4637
cp c
4638
jr c, $+4
4639
sub c
4640
inc l
4641
djnz div_hl_c.loop
4642
pop bc
4643
ret
4644
4645
;===============================================================
4646
; Convert a string of base-10 digits to a 16-bit value.
4647
; http://z80-heaven.wikidot.com/math#toc32
4648
;Input:
4649
; DE points to the base 10 number string in RAM.
4650
;Outputs:
4651
; HL is the 16-bit value of the number
4652
; DE points to the byte after the number
4653
; BC is HL/10
4654
; z flag reset (nz)
4655
; c flag reset (nc)
4656
;Destroys:
4657
; A (actually, add 30h and you get the ending token)
4658
;Size: 23 bytes
4659
;Speed: 104n+42+11c
4660
; n is the number of digits
4661
; c is at most n-2
4662
; at most 595 cycles for any 16-bit decimal value
4663
;===============================================================
4664
4665
StrToInt:
4666
ld hl,0 ; 10 : 210000
4667
ConvLoop: ;
4668
ld a,(de) ; 7 : 1A
4669
sub 30h ; 7 : D630
4670
cp 10 ; 7 : FE0A
4671
ret nc ;5|11 : D0
4672
inc de ; 6 : 13
4673
;
4674
ld b,h ; 4 : 44
4675
ld c,l ; 4 : 4D
4676
add hl,hl ; 11 : 29
4677
add hl,hl ; 11 : 29
4678
add hl,bc ; 11 : 09
4679
add hl,hl ; 11 : 29
4680
;
4681
add a,l ; 4 : 85
4682
ld l,a ; 4 : 6F
4683
jr nc,ConvLoop ;12|23: 30EE
4684
inc h ; --- : 24
4685
jr ConvLoop ; --- : 18EB
4686
4687
4688
4689
1924
4690
;--------------------------------------------------------
1925
4691
romPad:
1926
4692
ds romSize-(romPad-pgmArea),0
Loggerhead is a web-based interface for Breezy
Version: 2.0.1