« back to all changes in this revision
Viewing changes to test/general/test32.asm
- browse files at revision 129
- compare with another revision
- download diff
- download tarball
- view history from revision 129
- Committer: Amaury Carvalho
- Date: 2020-06-12 13:08:59 UTC
- Revision ID: amauryspires@gmail.com-20200612130859-3qm5vl1jiqr2brok
Commit on 12/06/2020 10:08:59 -03 by amaury
- files added:
- test/demos
- test/games
- test/general
- files removed:
- test/build.sh
- files modified:
- bin/Debug/msxbas2asm
added
removed
test/general/test32.asm
1
;---------------------------------------------------------------------------------------------------------
2
; Source code converted by MSXBAS2ASM - MSX BASIC TO Z80 ASSEMBLY CONVERTER
3
; MSXBAS2ASM developed by Amaury Carvalho, 2019, Brazil
4
; http://launchpad.net/msxbas2asm
5
;---------------------------------------------------------------------------------------------------------
6
7
;--------------------------------------------------------
8
; MSX BIOS DATA/FUNCTION POINTERS
9
;--------------------------------------------------------
10
11
;---------------------------------------------------------------------------------------------------------
12
; BIOS FUNCTIONS
13
;---------------------------------------------------------------------------------------------------------
14
15
BIOS_CALBAS: equ 0x0159
16
BIOS_OUTDO: equ 0x0018 ; output to current device (i.e. screen)
17
BIOS_CHPUT: equ 0x00A2
18
BIOS_CLS: equ 0x00C3
19
BIOS_POSIT: equ 0x00C6
20
BIOS_BEEP: equ 0x00C0
21
BIOS_CHGET: equ 0x009F
22
BIOS_CHSNS: equ 0x009C
23
BIOS_INLIN: equ 0x00B1
24
BIOS_PINLIN: equ 0x00AE
25
BIOS_QINLIN: equ 0x00B4
26
BIOS_GTSTCK: equ 0x00D5
27
BIOS_GTTRIG: equ 0x00D8
28
BIOS_GTPAD: equ 0x00DB
29
BIOS_GTPDL: equ 0x00DE
30
BIOS_DISSCR: equ 0x0041
31
BIOS_ENASCR: equ 0x0044
32
BIOS_CHGMOD: equ 0x005F
33
BIOS_CHGCLR: equ 0x0062
34
BIOS_CLRSPR: equ 0x0069
35
BIOS_INITXT: equ 0x006C ; init text mode 40 columns
36
BIOS_INIT32: equ 0x006F ; init text mode 32 columns
37
BIOS_INIGRP: equ 0x0072
38
BIOS_INIMLT: equ 0x0075
39
BIOS_SETTXT: equ 0x0078 ; set text mode 40 columns
40
BIOS_SETT32: equ 0x007B ; set text mode 32 columns
41
BIOS_SETGRP: equ 0x007E
42
BIOS_SETMLT: equ 0x0081
43
BIOS_CALPAT: equ 0x0084
44
BIOS_CALATR: equ 0x0087
45
BIOS_GSPSIZ: equ 0x008A
46
BIOS_GRPPRT: equ 0x008D
47
BIOS_ERAFNK: equ 0x00CC
48
BIOS_DSPFNK: equ 0x00CF
49
BIOS_TOTEXT: equ 0x00D2
50
BIOS_BREAKX: equ 0x00B7
51
BIOS_ISCNTC: equ 0x03FB
52
BIOS_CHKRAM: equ 0x0000
53
BIOS_GICINI: equ 0x0090
54
BIOS_WRTPSG: equ 0x0093
55
BIOS_REDPSG: equ 0x0096
56
BIOS_STRTMS: equ 0x0099
57
BIOS_KEYINT: equ 0x0038
58
BIOS_CALSLT: equ 0x001C
59
BIOS_ENASLT: equ 0x0024
60
BIOS_RSLREG: equ 0x0138
61
BIOS_SCALXY: equ 0x010E
62
BIOS_MAPXYC: equ 0x0111 ; in BC = X, DE = Y
63
BIOS_READC: equ 0x011D ; out A = color of current pixel
64
BIOS_SETATR: equ 0x011A ; in A = color code
65
BIOS_SETC: equ 0x0120 ; set current pixel to color from SETATR
66
BIOS_NSETCX: equ 0x0123 ; in HL = pixel fill count
67
BIOS_SCANR: equ 0x012C ; in B=Fill switch, DE=Skip count, out DE=Skip remainder, HL=Pixel count
68
BIOS_SCANL: equ 0x012F ; out HL=Pixel count
69
BIOS_FETCHC: equ 0x0114 ; out A = cursor mask, HL = VRAM address of cursor
70
BIOS_STOREC: equ 0x0117 ; in A = cursor mask, HL = VRAM address of cursor
71
BIOS_RESET: equ 0x7D17 ; restart BASIC
72
BIOS_IOALLOC: equ 0X7e6b ; memory setup
73
74
BIOS_GETVCP: equ 0x0150 ; get PSG voice buffer address (in A = voice number, out HL = address of byte 2)
75
BIOS_GETVC2: equ 0x0153 ; get PSG voice buffer address (VOICEN = voice number, in L = byte number 0-36, out HL = address)
76
77
BIOS_CHPUT_LF: equ 0x0908
78
BIOS_CHPUT_CR: equ 0x0A81
79
BIOS_CHPUT_TAB: equ 0x0A71
80
81
; MSX2
82
BIOS_CHKNEW: equ 0x0165 ; C-flag set if screenmode = 5, 6, 7 or 8
83
BIOS_EXTROM: equ 0x015F
84
BIOS_SCALXY2: equ 0x008D ; in BC = X, DE = Y
85
BIOS_MAPXYC2: equ 0x0091 ; in BC = X, DE = Y
86
BIOS_SETC2: equ 0x009D ; set current pixel to color from SETATR
87
BIOS_READC2: equ 0x0095 ; out A = color of current pixel
88
BIOS_CHGMOD2: equ 0x00D1 ; in A = screenmode
89
BIOS_DOBOXF: equ 0x0079 ; hl = basic text pointer
90
BIOS_GRPPRT2: equ 0x0089 ; a = character
91
BIOS_CHGCLR2: equ 0x0111 ; change color, a = screen mode
92
BIOS_CALPAT2: equ 0x00F9
93
BIOS_CALATR2: equ 0x00FD
94
BIOS_GSPSIZ2: equ 0x0101
95
BIOS_CLRSPR2: equ 0x00F5
96
97
;---------------------------------------------------------------------------------------------------------
98
; BIOS WORK AREAS
99
;---------------------------------------------------------------------------------------------------------
100
101
BIOS_VERSION: equ 0x002D ; 0 = MSX1, 1 = MSX2, 2 = MSX2+, 3 = MSXturboR
102
BIOS_FORCLR: equ 0xF3E9
103
BIOS_BAKCLR: equ 0xF3EA
104
BIOS_BDRCLR: equ 0xF3EB
105
BIOS_ATRBYT: equ 0xF3F2
106
BIOS_INTFLG: equ 0xFC9B
107
BIOS_EXPTBL: equ 0xFCC1
108
BIOS_JIFFY: equ 0xFC9E
109
BIOS_BOTTOM: equ 0xFC48
110
BIOS_HIMEM: equ 0xFC4A
111
BIOS_SCRMOD: equ 0xFCAF ; 0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode.
112
BIOS_CLIKSW: equ 0xF3DB ; 0=keyboard click off, 1=keyboard click on
113
BIOS_GRPACX: equ 0xFCB7
114
BIOS_GRPACY: equ 0xFCB9
115
BIOS_DATLIN: equ 0xF6A3 ; 2 - line number of DATA statement read by READ statement
116
BIOS_DATPTR: equ 0xF6C8 ; 2 - address of data read by executing READ statement
117
BIOS_FLGINP: equ 0xF6A6 ; 1 - flag used in INPUT or READ
118
BIOS_TEMP: equ 0xF6A7 ; 2
119
BIOS_TEMP2: equ 0xF6BC ; 2
120
BIOS_TEMP3: equ 0xF69D ; 2
121
BIOS_TEMP8: equ 0xF69F ; 2
122
BIOS_TEMP9: equ 0xF7B8 ; 2
123
BIOS_OLDSCR: equ 0xFCB0 ; screen mode of the last text mode set
124
BIOS_LINL40: equ 0xF3AE ; width for 40 columns screen mode
125
BIOS_LINL32: equ 0xF3AF ; width for 32 columns screen mode
126
BIOS_LINLEN: equ 0xF3B0 ; current width for text screen mode
127
BIOS_CLMLST: equ 0xF3B2 ; minimum number of columns that must still be available on a line for a CRLF
128
BIOS_TXTNAM: equ 0xF3B3 ; characters table name
129
130
BIOS_VOICEN: equ 0xFB38 ; PSG voice number
131
BIOS_MCLTAB: equ 0xF956
132
BIOS_PRSCNT: equ 0xFB35
133
BIOS_SAVSP: equ 0xFB36
134
BIOS_QUEUEN: equ 0xFB3E
135
BIOS_MUSICF: equ 0xFB3F ;contains 3 bit flags set by the STRTMS. Bits 0, 1 and 2 correspond to VOICAQ, VOICBQ and VOICCQ.
136
BIOS_PLYCNT: equ 0xFB40
137
138
BIOS_DRWFLG: equ 0xFCBB
139
BIOS_MCLFLG: equ 0xF958
140
141
BIOS_SLTROM: equ 0xFCC1
142
BIOS_RAMAD0: equ 0xF341 ; Main-RAM Slot (00000h~03FFFh)
143
BIOS_RAMAD1: equ 0xF342 ; Main-RAM Slot (04000h~07FFFh)
144
BIOS_RAMAD2: equ 0xF343 ; Main-RAM Slot (08000h~0BFFFh)
145
BIOS_RAMAD3: equ 0xF344 ; Main-RAM Slot (0C000h~0FFFFh)
146
147
148
149
;--------------------------------------------------------
150
; MSX BASIC DATA/FUNCTION POINTERS
151
;--------------------------------------------------------
152
153
;---------------------------------------------------------------------------------------------------------
154
; MSX BASIC FUNCTIONS
155
;---------------------------------------------------------------------------------------------------------
156
157
BASIC_AUTO: equ 0x3973
158
BASIC_AND: equ 0x3A18
159
BASIC_ATTR: equ 0x39FE
160
BASIC_BASE: equ 0x39BE
161
BASIC_BSAVE: equ 0x39CC
162
BASIC_BLOAD: equ 0x39CA
163
BASIC_BEEP: equ 0x39AC
164
BASIC_CALL: equ 0x39C0
165
BASIC_CLOSE: equ 0x3994
166
BASIC_COPY: equ 0x39D8
167
BASIC_CONT: equ 0x395E
168
BASIC_CLEAR: equ 0x3950
169
BASIC_CLOAD: equ 0x3962
170
BASIC_CSAVE: equ 0x3960
171
BASIC_CSRLIN: equ 0x39FC
172
BASIC_CIRCLE: equ 0x39A4
173
BASIC_COLOR: equ 0x39A6
174
BASIC_CLS: equ 0x396A
175
BASIC_CMD: equ 0x39DA
176
BASIC_DELETE: equ 0x397C
177
BASIC_DATA: equ 0x3934
178
BASIC_DIM: equ 0x3938
179
BASIC_DEFSTR: equ 0x3982
180
BASIC_DEFINT: equ 0x3984
181
BASIC_DEFSNG: equ 0x3986
182
BASIC_DEFDBL: equ 0x3988
183
BASIC_DSKO: equ 0x39CE
184
BASIC_DEF: equ 0x395A
185
BASIC_DSKI: equ 0x3A00
186
BASIC_DRAW: equ 0x39A8
187
BASIC_ELSE: equ 0x396E
188
BASIC_END: equ 0x392E
189
BASIC_ERASE: equ 0x3976
190
BASIC_ERROR: equ 0x3978
191
BASIC_ERL: equ 0x39EE
192
BASIC_ERR: equ 0x39F0
193
BASIC_EQU: equ 0x3A1E
194
BASIC_FOR: equ 0x3920
195
BASIC_FIELD: equ 0x398E
196
BASIC_FILES: equ 0x39AA
197
BASIC_FN: equ 0x39E8
198
BASIC_GOTO: equ 0x393E
199
BASIC_GOSUB: equ 0x3948
200
BASIC_GET: equ 0x3990
201
BASIC_INPUT: equ 0x3936
202
BASIC_IF: equ 0x3942
203
BASIC_INSTR: equ 0x39F6
204
BASIC_IMP: equ 0x3A20
205
BASIC_INKEY: equ 0x3A04
206
BASIC_IPL: equ 0x39D6
207
BASIC_KILL: equ 0x39D4
208
BASIC_KEY: equ 0x3964
209
BASIC_LPRINT: equ 0x394C
210
BASIC_LLIST: equ 0x3968
211
BASIC_LET: equ 0x393C
212
BASIC_LOCATE: equ 0x39DC
213
BASIC_LINE: equ 0x398A
214
BASIC_LOAD: equ 0x3996
215
BASIC_LSET: equ 0x399C
216
BASIC_LIST: equ 0x3952
217
BASIC_LFILES: equ 0x39A2
218
BASIC_MOTOR: equ 0x39C8
219
BASIC_MERGE: equ 0x3998
220
BASIC_MOD: equ 0x3A22
221
BASIC_MAX: equ 0x39C6
222
BASIC_NEXT: equ 0x3932
223
BASIC_NAME: equ 0x39D2
224
BASIC_NEW: equ 0x3954
225
BASIC_NOT: equ 0x39EC
226
BASIC_OPEN: equ 0x398C
227
BASIC_OUT: equ 0x3964
228
BASIC_ON: equ 0x3956
229
BASIC_OR: equ 0x3A1A
230
BASIC_OFF: equ 0x3A02
231
BASIC_PRINT: equ 0x394E
232
BASIC_PUT: equ 0x3992
233
BASIC_POKE: equ 0x395C
234
BASIC_PSET: equ 0x39B0
235
BASIC_PRESET: equ 0x39B2
236
BASIC_POINT: equ 0x3A06
237
BASIC_PAINT: equ 0x39AA
238
BASIC_PLAY: equ 0x39AE
239
BASIC_RETURN: equ 0x3948
240
BASIC_READ: equ 0x393A
241
BASIC_RUN: equ 0x3940
242
BASIC_RESTORE:equ 0x3944
243
BASIC_REM: equ 0x394A
244
BASIC_RESUME: equ 0x397A
245
BASIC_RSET: equ 0x399E
246
BASIC_RENUM: equ 0x3980
247
BASIC_SCREEN: equ 0x39B6
248
BASIC_SPRITE: equ 0x39BA
249
BASIC_STOP: equ 0x394C
250
BASIC_SWAP: equ 0x3974
251
BASIC_SET: equ 0x39D0
252
BASIC_SAVE: equ 0x39A0
253
BASIC_SPC: equ 0x39EA
254
BASIC_STEP: equ 0x39E4
255
BASIC_STRING: equ 0x39F2
256
BASIC_SPACE1: equ 0x397E
257
BASIC_SOUND: equ 0x39B4
258
BASIC_THEN: equ 0x39E0
259
BASIC_TRON: equ 0x3970
260
BASIC_TROFF: equ 0x3972
261
BASIC_TAB: equ 0x39E2
262
BASIC_TO: equ 0x39DE
263
BASIC_TIME: equ 0x39C2
264
BASIC_USING: equ 0x39F4
265
BASIC_USR: equ 0x39E6
266
BASIC_VARPTR: equ 0x39FA
267
BASIC_VDP: equ 0x39BC
268
BASIC_VPOKE: equ 0x39B8
269
BASIC_WIDTH: equ 0x396C
270
BASIC_WAIT: equ 0x3958
271
BASIC_XOR: equ 0x3A1C
272
BASIC_ABS: equ 0x39E8
273
BASIC_ATN: equ 0x39F8
274
BASIC_ASC: equ 0x3A06
275
BASIC_BIN: equ 0x3A16
276
BASIC_CINT: equ 0x3A18
277
BASIC_CSNG: equ 0x3A1A
278
BASIC_CDBL: equ 0x3A1C
279
BASIC_CVI: equ 0x3A2C
280
BASIC_CVS: equ 0x3A2E
281
BASIC_CVD: equ 0x3A30
282
BASIC_COS: equ 0x39F4
283
BASIC_CHR: equ 0x3A08
284
BASIC_DSKF: equ 0x3A28
285
BASIC_EXP: equ 0x39F2
286
BASIC_EOF: equ 0x3A32
287
BASIC_FRE: equ 0x39FA
288
BASIC_FIX: equ 0x3A1E
289
BASIC_FPOS: equ 0x3A2A
290
BASIC_HEX: equ 0x3A12
291
BASIC_INT: equ 0x39E6
292
BASIC_INP: equ 0x39FC
293
BASIC_LPOS: equ 0x3A14
294
BASIC_LOG: equ 0x39F0
295
BASIC_LOC: equ 0x3A34
296
BASIC_LEN: equ 0x3A00
297
BASIC_LEFT: equ 0x39DE
298
BASIC_LOF: equ 0x3A36
299
BASIC_MKI: equ 0x3A38
300
BASIC_MKS: equ 0x3A3A
301
BASIC_MKD: equ 0x3A3C
302
BASIC_MID: equ 0x39E2
303
BASIC_OCT: equ 0x3A10
304
BASIC_POS: equ 0x39FE
305
BASIC_PEEK: equ 0x3A0A
306
BASIC_PDL: equ 0x3A24
307
BASIC_PAD: equ 0x3A26
308
BASIC_RIGHT: equ 0x39E0
309
BASIC_RND: equ 0x39EC
310
BASIC_SGN: equ 0x39E4
311
BASIC_SQR: equ 0x39EA
312
BASIC_SIN: equ 0x39EE
313
BASIC_STR: equ 0x3A02
314
BASIC_SPACE2: equ 0x3A0E
315
BASIC_STICK: equ 0x3A20
316
BASIC_STRIG: equ 0x3A22
317
BASIC_TAN: equ 0x39F6
318
BASIC_VAL: equ 0x3A04
319
BASIC_VPEEK: equ 0x3A0C
320
321
BASIC_TRAP_ENABLE: equ 0x631B ; ON INTERVAL/KEY/SPRITE/STOP/STRIG - hl = pointer to trap block
322
BASIC_TRAP_DISABLE: equ 0x632B ; hl = pointer to trap block
323
BASIC_TRAP_ACKNW: equ 0x6358 ; hl, acknowledge trap (handle trap: sts=5? has handler? ackn, pause, run trap, sts=1? unpause)
324
BASIC_TRAP_PAUSE: equ 0x6331 ; hl
325
BASIC_TRAP_UNPAUSE: equ 0x633E ; hl
326
BASIC_TRAP_CLEAR: equ 0x636E
327
328
BASIC_PLAY_DIRECT: equ 0x744C
329
BASIC_DRAW_DIRECT: equ 0x568C
330
331
BASIC_READYR: equ 0x409B
332
BASIC_READYC: equ 0x7D17
333
BASIC_FACEVAL: equ 0x4DC7
334
335
BASIC_ERROR_HANDLER:equ 0x406F
336
BASIC_ERROR_SYNTAX: equ 0x4055
337
BASIC_ERROR_DIVZER: equ 0x4058
338
BASIC_ERROR_OVRFLW: equ 0x4067
339
BASIC_ERROR_ARRAY: equ 0x405E
340
BASIC_ERROR_TYPMIS: equ 0x406D
341
342
; BASIC ERROR CODES TO BASIC_ERROR_HANDLER
343
; 01 NEXT without FOR 19 Device I/O error
344
; 02 Syntax error 20 Verify error
345
; 03 RETURN without GOSUB 21 No RESUME
346
; 04 Out of DATA 22 RESUME without error
347
; 05 Illegal function call 23 Unprintable error
348
; 06 Overflow 24 Missing operand
349
; 07 Out of memory 25 Line buffer overflow
350
; 08 Undefined line number 50 FIELD overflow
351
; 09 Subscript out of range 51 Internal error
352
; 10 Redimensioned array 52 Bad file number
353
; 11 Division by zero 53 File not found
354
; 12 Illegal direct 54 File already open
355
; 13 Type mismatch 55 Input past end
356
; 14 Out of string space 56 Bad file name
357
; 15 String too long 57 Direct statement in file
358
; 16 String formula too complex 58 Sequential I/O only
359
; 17 Can't CONTINUE 59 File not OPEN
360
; 18 Undefined user function
361
362
;---------------------------------------------------------------------------------------------------------
363
; MSX BASIC WORK AREAS
364
;---------------------------------------------------------------------------------------------------------
365
366
BASIC_DAC: equ 0xF7F6 ; 16
367
BASIC_ARG: equ 0xF847 ; 16
368
BASIC_VALTYP: equ 0xF663
369
BASIC_RNDX: equ 0xF857
370
BASIC_BUF: equ 0xF55E ; 259
371
BASIC_KBUF: equ 0xF41F ; 318
372
BASIC_SWPTMP: equ 0xF7BC ; 8
373
BASIC_STRBUF: equ 0xF7C5 ; 43
374
BASIC_TXTTAB: equ 0xF676
375
BASIC_VARTAB: equ 0xF6C2
376
BASIC_ARYTAB: equ 0xF6C4
377
BASIC_STREND: equ 0xF6C6
378
BASIC_STKTOP: equ 0xF674
379
BASIC_FRETOP: equ 0xF69B
380
BASIC_MEMSIZ: equ 0xF672
381
382
BASIC_TEMPPT: equ 0xF678 ; 2 Starting address of unused area of temporary descriptor.
383
BASIC_TEMPST: equ 0xF67A ; 30 Temporary descriptors.
384
385
BASIC_DATPTR: equ 0xF6C8 ; 2 Pointer to next data to read from the instruction DATA. Modified by RESTORE.
386
BASIC_DATLIN: equ 0xF6A3 ; 2 Número de linha do comando DATA para o comando READ.
387
BASIC_DORES: equ 0xF664 ; 1 Usada pelo comando DATA para manter o texto no formato ASCII.
388
BASIC_DEFTBL: equ 0xF6CA ; 26 table of variables defined by DEFINT, DEFSTR, DEFSNG and DEFDBL for each alphabet letter (2 = integer, 3 = String, 4 = Simple precision, 8 = Double precision).
389
390
BASIC_CURLIN: equ 0xF41C ; BASIC current line number
391
BASIC_INTVAL: equ 0xFCA0 ; interval value
392
BASIC_INTCNT: equ 0xFCA2 ; interval current count
393
394
BASIC_PRMPRV: equ 0xF74C ; Pointer to previous parameter block in PARM1
395
396
BASIC_TRPTBL: equ 0xFC4C ; 78 trap table - array of 3 bytes - state[1] (bit 0=on, bit 1=stop, bit 2=active) + address[2]
397
398
BASIC_TRPTBL_KEY: equ 0xFC4C ; 30 ON KEY GOSUB
399
BASIC_TRPTBL_STOP: equ 0xFC6A ; 3 ON STOP GOSUB
400
BASIC_TRPTBL_SPRITE: equ 0xFC6D ; 3 ON SPRITE GOSUB
401
BASIC_TRPTBL_STRIG: equ 0xFC70 ; 15 ON STRIG GOSUB
402
BASIC_TRPTBL_INTERVAL: equ 0xFC7F ; 3 ON INTERVAL GOSUB
403
BASIC_TRPTBL_OTHER: equ 0xFC82 ; 24 reserved for expansion
404
405
BASIC_ONGSBF: equ 0xFBD8 ; 1 trap occurred counter (0=not occurred)
406
407
408
409
;--------------------------------------------------------
410
; MATH PACK ROUTINES
411
;--------------------------------------------------------
412
FAST_MATH: EQU 1
413
414
;--------------------------------------------------------
415
; SUPPORT MACROS
416
;--------------------------------------------------------
417
COMPILE_TO_ROM: EQU 1
418
419
MACRO __call_basic,CALL_PARM
420
ld ix, CALL_PARM
421
call BIOS_CALBAS
422
ENDM
423
424
if defined COMPILE_TO_DOS
425
426
MACRO __call_bios,CALL_PARM
427
;ld iy,(BIOS_EXPTBL-1)
428
ld ix, CALL_PARM
429
call BIOS_CALBAS ; BIOS_CALSLT
430
ENDM
431
432
else
433
434
MACRO __call_bios,CALL_PARM
435
call CALL_PARM
436
ENDM
437
438
endif
439
440
MACRO push.parm
441
push hl ; save parameter
442
ENDM
443
444
MACRO pop.parm
445
pop iy ; restore PC of caller
446
pop hl ; get next parameter
447
push iy ; save PC of caller
448
ENDM
449
450
MACRO push.ret.parm
451
pop iy ; restore PC of caller
452
push hl ; save return parameter
453
push iy ; save PC of caller
454
ENDM
455
456
MACRO ret.parm
457
pop iy ; restore PC of caller
458
push hl ; save return parameter
459
push iy ; save PC of caller
460
ret ; return
461
ENDM
462
463
MACRO set.line.number, line_number
464
ld bc, line_number ; current line number
465
ld (BASIC_CURLIN), bc
466
ENDM
467
468
MACRO verify.break
469
ld a, (BIOS_INTFLG) ; verify CTRL+BREAK
470
or a
471
jp nz, end_pgm
472
ENDM
473
474
MACRO check.traps
475
ld a, (BASIC_ONGSBF) ; trap occured counter
476
or a
477
call nz, RUN_TRAPS
478
ENDM
479
480
481
;---------------------------------------------------------------------------------------------------------
482
; PROGRAM HEADER
483
;---------------------------------------------------------------------------------------------------------
484
485
romSize: equ 0x8000 ; ROM size (32k)
486
pageSize: equ 0x4000 ; Page size (16k)
487
lowLimitSize: equ 0x400 ; 10% of a page size
488
489
if defined COMPILE_TO_BIN
490
491
pgmArea: equ 0x8000 ; page 2 - program area
492
ramArea: equ 0xc000 ; page 3 - free RAM start area
493
494
org pgmArea ; program binary type start address
495
db 0FEh ; binary file ID
496
dw start_pgm ; begin address
497
dw end_file - 1 ; end address
498
dw start_pgm ; program execution address (for ,R option)
499
500
else
501
if defined COMPILE_TO_ROM
502
503
pgmArea: equ 0x4000 ; page 1 and 2 - program area
504
ramArea: equ 0xc000 ; page 3 - free RAM start area
505
506
org pgmArea ; program rom type start address
507
db 'AB' ; rom file ID
508
dw start_pgm ; INIT
509
dw 0x0000 ; STATEMENT
510
dw 0x0000 ; DEVICE
511
dw 0x0000 ; TEXT
512
ds 6,0 ; RESERVED
513
514
else
515
516
pgmArea: equ 0x8000 ; page 2 - program area
517
ramArea: equ 0xc000 ; page 3 - free RAM start area
518
519
org pgmArea ; program DOS type start address ; 0x0100
520
521
endif
522
endif
523
524
525
;---------------------------------------------------------------------------------------------------------
526
; PROGRAM ROUTINES
527
;---------------------------------------------------------------------------------------------------------
528
529
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
530
531
PROGRAM_TO_BASIC:
532
call PROGRAM_SLOT_2_RESTORE
533
__call_basic BASIC_READYR ; warm start Basic
534
ret
535
536
PROGRAM_SLOT_2_SAVE:
537
ld h,080h
538
call PROGRAM_SLOT_GET
539
ld (BIOS_RAMAD2), a ; Save RAM slot of page 8000h-BFFFh
540
ret
541
542
PROGRAM_SLOT_2_RESTORE:
543
ld a, (BIOS_RAMAD2)
544
ld h,080h
545
jp BIOS_ENASLT ; Select the RAM on page 8000h-BFFFh
546
547
PROGRAM_SLOT_2_ENABLE:
548
call BIOS_RSLREG
549
rrca
550
rrca
551
and 3 ;Keep bits corresponding to the page
552
ld c,a
553
ld b,0
554
ld hl,BIOS_EXPTBL
555
add hl,bc
556
ld a,(hl)
557
and 80h
558
or c
559
ld c,a
560
inc hl
561
inc hl
562
inc hl
563
inc hl
564
ld a,(hl)
565
and 0Ch
566
or c
567
ld h,080h
568
jp BIOS_ENASLT ; Select the ROM on page 8000h-BFFFh
569
570
; h = memory page
571
; a <- slot ID formatted FxxxSSPP
572
; Modifies: af, bc, de, hl
573
; ref: https://www.msx.org/forum/msx-talk/development/fusion-c-and-htimi#comment-366469
574
PROGRAM_SLOT_GET:
575
call BIOS_RSLREG
576
bit 7,h
577
jr z,PrimaryShiftContinue
578
rrca
579
rrca
580
rrca
581
rrca
582
PrimaryShiftContinue:
583
bit 6,h
584
jr z,PrimaryShiftDone
585
rrca
586
rrca
587
PrimaryShiftDone:
588
and 00000011B
589
ld c,a
590
ld b,0
591
ex de,hl
592
ld hl,BIOS_EXPTBL
593
add hl,bc
594
ld c,a
595
ld a,(hl)
596
and 80H
597
or c
598
ld c,a
599
inc hl ; move to SLTTBL
600
inc hl
601
inc hl
602
inc hl
603
ld a,(hl)
604
ex de,hl
605
bit 7,h
606
jr z,SecondaryShiftContinue
607
rrca
608
rrca
609
rrca
610
rrca
611
SecondaryShiftContinue:
612
bit 6,h
613
jr nz,SecondaryShiftDone
614
rlca
615
rlca
616
SecondaryShiftDone:
617
and 00001100B
618
or c
619
ret
620
621
endif
622
623
if defined COMPILE_TO_DOS
624
625
BIOS_SLOT_ENABLE:
626
ld a, (BIOS_EXPTBL)
627
ld hl,0
628
__call_bios BIOS_ENASLT ; Select main ROM on page 0 (0000h~3FFFh)
629
ret
630
631
endif
632
633
634
635
;---------------------------------------------------------------------------------------------------------
636
; PROGRAM MAIN CODE
637
;---------------------------------------------------------------------------------------------------------
638
639
start_pgm: ; start of the program
640
641
if defined COMPILE_TO_DOS
642
643
call BIOS_SLOT_ENABLE ; enable bios on page 0
644
;call BASIC_SLOT_ENABLE ; enable basic on page 1
645
646
endif
647
648
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
649
650
call PROGRAM_SLOT_2_SAVE ; save slot on page 2
651
call PROGRAM_SLOT_2_ENABLE ; enable program on page 2
652
653
endif
654
655
__call_bios BIOS_ERAFNK ; turn off function keys display
656
__call_bios BIOS_GICINI ; initialize sound system
657
__call_bios BIOS_INITXT ; initialize text screen
658
xor a
659
ld (BIOS_CLIKSW), a ; disable keyboard click
660
ld bc, 0xFFFF ;
661
ld (BASIC_CURLIN), bc ; interpreter in direct mode
662
__call_basic BASIC_TRAP_CLEAR ; clear traps work space
663
;call INITIALIZE_PARAMETERS ; initialize parameters stack
664
call memory.init ; initialize memory allocation
665
call INITIALIZE_VARIABLES ; initialize variables
666
667
668
TAG_10:
669
ld hl, LIT_4 ; parameter
670
push.parm
671
call SET_PLAY_VOICE_1 ; action call
672
ld hl, LIT_6 ; parameter
673
push.parm
674
call SET_PLAY_VOICE_2 ; action call
675
call DO_PLAY ; action call
676
677
TAG_20:
678
ld hl, LIT_11 ; parameter
679
push.parm
680
call INPUT.FUNCTION.STR ; action call
681
ld hl, IDF_8 ; parameter
682
push.parm
683
call LET ; action call
684
685
TAG_30:
686
ld hl, LIT_12 ; parameter
687
push.parm
688
call SET_PLAY_VOICE_1 ; action call
689
ld hl, LIT_13 ; parameter
690
push.parm
691
call SET_PLAY_VOICE_2 ; action call
692
call DO_PLAY ; action call
693
694
TAG_40:
695
ld hl, LIT_14 ; parameter
696
push.parm
697
call INPUT.FUNCTION.STR ; action call
698
ld hl, IDF_8 ; parameter
699
push.parm
700
call LET ; action call
701
702
TAG_50:
703
ld hl, LIT_15 ; parameter
704
push.parm
705
call SET_PLAY_VOICE_1 ; action call
706
call DO_PLAY ; action call
707
708
;---------------------------------------------------------------------------------------------------------
709
; PROGRAM END CODE
710
;---------------------------------------------------------------------------------------------------------
711
712
end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display
713
ld a, 1 ;
714
ld (BIOS_CLIKSW), a ; enable keyboard click
715
716
if defined COMPILE_TO_ROM
717
jp PROGRAM_TO_BASIC
718
else
719
if defined COMPILE_TO_DOS
720
; go back to DOS
721
else
722
__call_basic BASIC_READYR ; warm start Basic
723
endif
724
endif
725
726
ret ; end of the program
727
728
;__call_bios BIOS_GICINI ; initialize sound system
729
;if defined COMPILE_TO_DOS or defined COMPILE_TO_ROM
730
; __call_bios BIOS_RESET ; restart Basic
731
;else
732
; __call_basic BASIC_END ; end to Basic
733
;endif
734
735
736
;---------------------------------------------------------------------------------------------------------
737
; MSX BASIC KEYWORDS
738
;---------------------------------------------------------------------------------------------------------
739
740
; keyword
741
LET:
742
743
; out IX = variable assigned address
744
pop.parm ; get variable address parameter
745
push hl ; just to transfer hl to ix
746
pop ix ;
747
ld a, (ix) ; get variable type
748
cp 3 ; test if string
749
jr nz, LET.PARM ; if not a string, it isn't necessary to free memory
750
ld a, (ix + 3) ; get variable string length
751
or a ; cp 0
752
jr z, LET.PARM ; if zero, it isn't necessary to free memory
753
ld c, (ix + 4) ; get old string address low
754
ld b, (ix + 5) ; get old string address high
755
push ix ; save variable address
756
push bc ; just to transfer bc (old string address) to ix
757
pop ix ;
758
call memory.free ; free memory
759
pop ix ; restore variable address
760
LET.PARM: pop.parm ; get data address parameter (out hl = data address)
761
ld a, (ix + 2) ; get variable type flag
762
or a ; cp 0 - test type flag (0=any, 255=fixed)
763
jr nz, LET.FIXED ; if type flag is fixed, so casting is necessary
764
LET.ANY: push ix ; just to transfer ix (variable address) to de
765
pop de ;
766
ldi ; copy 1 byte from hl (data address) to de (variable address)
767
inc de ; go to variable data area
768
inc de ;
769
inc hl ; go to data data area
770
inc hl ;
771
ld bc, 8 ; data = 8 bytes
772
ldir ; copy bc bytes from hl (data address) to de (variable address)
773
ld a, (ix) ; get variable type
774
cp 3 ; test if string
775
ret nz ; if not string, return
776
jp LET.STRING ; else do string treatment (in ix = variable address)
777
LET.FIXED: push ix ; save variable destination address
778
push hl ; save variable source address
779
ld a, (ix) ; get variable fixed type, and hl has parameter data address
780
call CAST_TO ; cast data to type (in hl = variable address, a = type to, out hl = casted data address)
781
pop de
782
pop ix ; restore variable address
783
ld a, (ix) ; get variable destination type again
784
cp 3 ; test if string
785
jr nz, LET.VALUE ; if not string, do value treatment
786
ld a, (de) ; get variable source type again
787
cp 3 ; test if string
788
jr nz, LET.FIX1 ; if not string, get casted string size
789
inc de
790
inc de
791
inc de
792
ld a, (de)
793
ld (ix + 3), a ; source string size
794
jr LET.FIX2
795
LET.FIX1: call GET_STR.LENGTH ; get string length (in HL, out a)
796
ld (ix + 3), a ; set variable length
797
LET.FIX2: ld (ix + 4), l ; casted data address low
798
ld (ix + 5), h ; casted data address high
799
jp LET.STRING ; do string treatment (in ix = variable address)
800
LET.VALUE: push ix ; just to transfer ix (variable address) to de
801
pop de ;
802
inc de ; go to variable data area (and the data from its casted)
803
inc de ;
804
inc de ;
805
ld bc, 8 ; data = 8 bytes
806
ldir ; copy bc bytes from hl (data address) to de (variable address)
807
ret ;
808
LET.STRING: ld a, (ix + 3) ; string size
809
or a ; cp 0 - test if null
810
jr nz, LET.ALLOC ; if not null, allocate new string (in ix = variable address)
811
ld bc, LIT_NULL_STR ; else, set to a null string literal
812
ld (ix + 4), c ; variable address low
813
ld (ix + 5), b ; variable address high
814
ret ;
815
LET.ALLOC: push ix ; save variable address
816
ld l, (ix + 4) ; source string address low
817
ld h, (ix + 5) ; source string address high
818
push hl ; save copy from address
819
ld c, (ix + 3) ; get variable length
820
ld b, 0 ;
821
inc bc ; string length have one more byte from zero terminator
822
push bc ; save variable lenght + 1
823
call memory.alloc ; in bc = size, out ix = address, nz=OK
824
jp z, memory.error
825
push ix ; just to transfer memory address from ix to de
826
pop de ;
827
pop bc ; restore bytes to be copied
828
pop hl ; restore copy from string address
829
push de ; save copy to address
830
ldir ; copy bc bytes from hl (data address) to de (variable address)
831
;xor a
832
;ld (de), a
833
pop de ; restore copy to address
834
pop ix ; restore variable address
835
ld (ix + 4), e ; put memory address low into variable
836
ld (ix + 5), d ; put memory address high into variable
837
ret ; variable assigned
838
839
; keyword
840
BOOLEAN.IF:
841
842
pop.parm ; get parameter boolean result in hl
843
push hl ; ix = hl
844
pop ix ;
845
ld a, (ix+5) ; put boolean integer result in a
846
ret ;
847
848
; keyword
849
SET_PLAY_VOICE_1:
850
851
ld a, 0
852
jp SET_PLAY_VOICE
853
854
; keyword
855
SET_PLAY_VOICE_2:
856
857
ld a, 1
858
jp SET_PLAY_VOICE
859
860
; keyword
861
DO_PLAY:
862
863
jp PLAY_HOOK
864
865
; keyword
866
INPUT.FUNCTION.STR:
867
868
pop.parm ; get first parameter
869
call CAST_TO.INT ;
870
call GET_INT.VALUE ; output BC with integer value
871
call GET_STRING_SPACE ; in bc = size, out hl = address, out a = string size
872
or a
873
jr z, INPUT.FUNCTION.STR.2
874
push af
875
push hl
876
ld b, a
877
INPUT.FUNCTION.STR.1:
878
__call_bios BIOS_CHGET
879
ld (hl), a
880
inc hl
881
xor a
882
ld (hl), a
883
djnz INPUT.FUNCTION.STR.1
884
pop hl
885
pop af
886
INPUT.FUNCTION.STR.2:
887
call COPY_TO.VAR_DUMMY.STR ; create a fake string variable from HL in HL
888
ret.parm ;
889
890
891
892
;---------------------------------------------------------------------------------------------------------
893
; MSX BASIC SUPPORT CODE
894
;---------------------------------------------------------------------------------------------------------
895
896
if defined CHR or defined INKEY.STR
897
898
; in a = char
899
; out hl = string
900
COPY_CHAR_TO_STR:
901
push af
902
ld bc, 2 ; string size
903
call memory.alloc ; in bc size, out ix new memory address, nz=OK
904
jr z, COPY_CHAR_TO_STR.ERROR
905
pop af
906
ld (ix), a
907
xor a
908
ld (ix+1), a
909
push ix
910
pop hl ; HL = string address
911
ld a, 1 ; A = size
912
ret
913
COPY_CHAR_TO_STR.ERROR:
914
pop af
915
jp memory.error
916
917
endif
918
919
;if defined INPUT or defined LINE_INPUT or defined SPC or defined SPACE or defined INPUT.FUNCTION.STR
920
921
; bc = size
922
; out: a = size, hl = address
923
GET_STRING_SPACE:
924
ld hl, LIT_NULL_STR
925
ld a, c
926
or a
927
ret z
928
push de
929
push bc
930
inc bc
931
call memory.alloc ; in bc = size, out ix = address, nz=OK
932
pop bc
933
pop de
934
jp z, memory.error
935
ld a, 32
936
ld b, c
937
push ix
938
GET_STRING_SPACE.1:
939
ld (ix), a
940
inc ix
941
djnz GET_STRING_SPACE.1
942
xor a
943
ld (ix), a
944
pop hl
945
ld a, c ; size
946
ret
947
948
; in hl = string, out hl = temp string
949
COPY_TO.TEMP_STR:
950
call GET_STR.LENGTH ; get string length, in hl = address, out a = size
951
ex de, hl
952
ld c, a
953
ld b, 0
954
call GET_STRING_SPACE ; in bc = size, out hl = address, out a = string size
955
or 0
956
ret z
957
push af
958
push hl
959
push hl
960
call COPY_TO.VAR_DUMMY.STR ; create a fake string variable from HL in HL
961
pop hl
962
ex de, hl
963
ld c, a
964
ld b, 0
965
ldir ; copy bc bytes from hl to de
966
pop hl
967
pop af
968
ret
969
970
;endif
971
972
if defined INPUT or defined LINE_INPUT
973
974
INPUT.CONTINUE:
975
jr c, INPUT.EXIT ; exit if CTRL+STOP
976
977
inc hl ; string start
978
call COPY_TO.TEMP_STR
979
call COPY_TO.VAR_DUMMY.STR ; make a fake string variable from HL
980
push.parm ; LET parameter 2 - fake string variable as right operand
981
ld hl, (BIOS_TEMP)
982
push.parm ; LET parameter 1 - input variable as left operand
983
call LET ; put string into variable
984
INPUT.EXIT:
985
xor a ;
986
ld (BIOS_CLIKSW), a ; disable keyboard click
987
ret ;
988
989
endif
990
991
if defined ON_ERROR or defined ON_INTERVAL or defined ON_KEY_START or defined ON_SPRITE or defined ON_STOP or defined ON_STRIG_START or defined TRAP_ENABLED or defined TRAP_DISABLED or defined TRAP_PAUSE or defined TRAP_UNPAUSE
992
993
RUN_TRAPS: ld b, 26
994
ld hl, BASIC_TRPTBL
995
RUN_TRAPS.1: push hl
996
push bc
997
call TRAP_HANDLER
998
pop bc
999
pop hl
1000
inc hl
1001
inc hl
1002
inc hl
1003
djnz RUN_TRAPS.1
1004
ret
1005
1006
; in hl = trap block address (handle trap: sts=5? has handler? ackn, pause, run trap, sts=1? unpause)
1007
TRAP_HANDLER:
1008
ld a, (hl) ; trap status
1009
cp 5 ; trap occured AND trap not paused AND trap enabled ?
1010
ret nz ; return if false
1011
inc hl
1012
ld e, (hl) ; get trap address
1013
inc hl
1014
ld d, (hl)
1015
dec hl
1016
dec hl
1017
ld a, d
1018
or e
1019
ret z ; return if address zero
1020
push hl
1021
__call_basic BASIC_TRAP_ACKNW
1022
__call_basic BASIC_TRAP_PAUSE
1023
ld hl, TRAP_HANDLER.1
1024
ld a, (BASIC_ONGSBF) ; save traps execution
1025
push af
1026
xor a
1027
ld (BASIC_ONGSBF), a ; disable traps execution
1028
push hl ; next return will be to trap handler
1029
push de ; indirect jump to trap address
1030
ret
1031
TRAP_HANDLER.1: pop af
1032
ld (BASIC_ONGSBF), a ; restore traps execution
1033
pop hl
1034
ld a, (hl)
1035
cp 1 ; trap enabled?
1036
ret z
1037
__call_basic BASIC_TRAP_UNPAUSE
1038
ret
1039
1040
; hl = trap block, de = trap handler
1041
SET_TRAP: xor a
1042
ld (hl), a ; trap block status
1043
inc hl
1044
ld (hl), e ; trap block handler (pointer)
1045
inc hl
1046
ld (hl), d
1047
ret
1048
1049
endif
1050
1051
if defined SET_PLAY_VOICE_1 or defined SET_PLAY_VOICE_2 or defined SET_PLAY_VOICE_3 or defined DO_PLAY or defined MUSIC_PLAY or defined MUSIC_NEXT or defined MUSIC_STOP
1052
1053
SET_PLAY_VOICE:
1054
ld (BIOS_TEMP), a ; save voice number
1055
pop.parm
1056
ld a, (hl)
1057
cp 3
1058
ret nz ; return if not string
1059
call GET_STR.ADDR
1060
SET_PLAY_VOICE.1:
1061
ld (BIOS_TEMP2), a ; save string size
1062
push hl ; string address
1063
ld a, (BIOS_TEMP) ; restore voice number
1064
call BIOS_GETVCP ; get PSG voice buffer address (in A = voice number, out HL = address of byte 2)
1065
pop de
1066
ld a, (BIOS_TEMP2) ; restore string size
1067
ld (hl), a ; string size
1068
inc hl
1069
ld (hl), e ; string address
1070
inc hl
1071
ld (hl), d
1072
inc hl
1073
ld D,H ; voice stack
1074
ld E,L
1075
ld BC,001CH
1076
add HL,BC
1077
ex DE,HL
1078
ld (HL),E
1079
inc HL
1080
ld (HL),D
1081
ret
1082
1083
endif
1084
1085
1086
1087
;---------------------------------------------------------------------------------------------------------
1088
; VARIABLES ROUTINES
1089
;---------------------------------------------------------------------------------------------------------
1090
1091
; input hl = variable address
1092
; input bc = variable name
1093
; input d = variable type
1094
INIT_VAR: ld (hl), d ; variable type
1095
inc hl
1096
ld (hl), c ; variable name 1
1097
inc hl
1098
ld (hl), b ; variable name 2
1099
ld a, d
1100
cp 3
1101
jp nz, CLEAR.VAR
1102
ld de, LIT_NULL_STR
1103
inc hl
1104
ld (hl), 0
1105
inc hl
1106
ld (hl), e
1107
inc hl
1108
ld (hl), d
1109
ld b, 5
1110
jr CLEAR.VAR.LOOP
1111
CLEAR.VAR: ld b, 8
1112
CLEAR.VAR.LOOP: inc hl
1113
ld (hl), 0 ; data address/value
1114
djnz CLEAR.VAR.LOOP
1115
ret
1116
; input HL = variable address
1117
; input A = variable output type
1118
; output HL = casted data address
1119
CAST_TO: cp 2
1120
jp z, CAST_TO.INT
1121
cp 3
1122
jp z, CAST_TO.STR
1123
cp 4
1124
jp z, CAST_TO.SGL
1125
cp 8
1126
jp z, CAST_TO.DBL
1127
ret
1128
; input HL = variable address
1129
; output HL = variable address
1130
CAST_TO.INT: ;push af
1131
ld a, (HL)
1132
cp 2
1133
jp z, GET_INT.ADDR
1134
cp 3
1135
jp z, CAST_STR_TO.INT
1136
cp 4
1137
jp z, CAST_SGL_TO.INT
1138
cp 8
1139
jp z, CAST_DBL_TO.INT
1140
;pop af
1141
ret
1142
; input HL = variable address
1143
; output HL = variable address
1144
CAST_TO.STR: ;push af
1145
ld a, (HL)
1146
cp 2
1147
jp z, CAST_INT_TO.STR
1148
cp 3
1149
jp z, GET_STR.ADDR
1150
cp 4
1151
jp z, CAST_SGL_TO.STR
1152
cp 8
1153
jp z, CAST_DBL_TO.STR
1154
;pop af
1155
ret
1156
; input HL = variable address
1157
; output HL = variable address
1158
CAST_TO.SGL: ;push af
1159
ld a, (HL)
1160
cp 2
1161
jp z, CAST_INT_TO.SGL
1162
cp 3
1163
jp z, CAST_STR_TO.SGL
1164
cp 4
1165
jp z, GET_SGL.ADDR
1166
cp 8
1167
jp z, CAST_DBL_TO.SGL
1168
;pop af
1169
ret
1170
; input HL = variable address
1171
; output HL = variable address
1172
CAST_TO.DBL: ;push af
1173
ld a, (hl)
1174
cp 2
1175
jp z, CAST_INT_TO.DBL
1176
cp 3
1177
jp z, CAST_STR_TO.DBL
1178
cp 4
1179
jp z, CAST_SGL_TO.DBL
1180
cp 8
1181
jp z, GET_DBL.ADDR
1182
;pop af
1183
ret
1184
CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR
1185
CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR
1186
CAST_INT_TO.STR: call COPY_TO.DAC
1187
xor a
1188
__call_bios MATH_FOUT ; convert DAC to string
1189
call COPY_TO.TEMP_STR
1190
ret
1191
CAST_INT_TO.SGL: call COPY_TO.DAC
1192
__call_bios MATH_FRCSGL
1193
ld hl, BASIC_DAC
1194
ret
1195
CAST_INT_TO.DBL: call COPY_TO.DAC
1196
__call_bios MATH_FRCDBL
1197
ld hl, BASIC_DAC
1198
ret
1199
CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT
1200
CAST_DBL_TO.INT: call COPY_TO.DAC
1201
__call_bios MATH_FRCINT
1202
ld hl, BASIC_DAC
1203
ret
1204
CAST_STR_TO.INT: ld a, 2
1205
call CAST_STR_TO.VAL ;
1206
if defined BCD_MATH
1207
__call_bios MATH_FRCINT
1208
endif
1209
ld hl, BASIC_DAC ;
1210
ret ;
1211
CAST_STR_TO.SGL: ld a, 4
1212
call CAST_STR_TO.VAL ;
1213
if defined BCD_MATH
1214
__call_bios MATH_FRCSGL
1215
endif
1216
ld hl, BASIC_DAC ;
1217
ret ;
1218
CAST_STR_TO.DBL: ld a, 8
1219
call CAST_STR_TO.VAL ;
1220
if defined BCD_MATH
1221
__call_bios MATH_FRCDBL
1222
endif
1223
ld hl, BASIC_DAC ;
1224
ret ;
1225
CAST_STR_TO.VAL: ld (BASIC_VALTYP), a
1226
call GET_STR.ADDR ;
1227
ld a, (hl) ;
1228
__call_bios MATH_FIN ; convert string to a value type
1229
ld hl, BASIC_DAC ;
1230
ret ;
1231
GET_INT.VALUE: inc hl ; output BC with integer value
1232
inc hl ;
1233
ld c, (hl) ;
1234
inc hl ;
1235
ld b, (hl) ;
1236
ret ;
1237
CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR
1238
CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR
1239
GET_INT.ADDR: ; same as GET_DBL.ADDR
1240
GET_SGL.ADDR: ; same as GET_DBL.ADDR
1241
GET_DBL.ADDR: inc hl
1242
inc hl
1243
inc hl
1244
;pop af
1245
ret
1246
GET_STR.ADDR: push hl
1247
pop ix
1248
ld a, (ix + 3)
1249
ld l, (ix + 4)
1250
ld h, (ix + 5)
1251
ret
1252
; input hl = string address
1253
; output a = string length
1254
GET_STR.LENGTH: push hl
1255
ld bc, 255
1256
xor a
1257
cpir ; hl = source, a = compare char, bc = count
1258
pop hl
1259
ret nz ; not found
1260
ld a, c
1261
cpl
1262
dec a
1263
ret
1264
STRING.COMPARE: ld ix, (BASIC_DAC+1) ; string 1
1265
ld iy, (BASIC_ARG+1) ; string 2
1266
STRING.COMPARE.NX: ld a, (ix) ; next char from string 1
1267
cp (iy) ; char s1 = char s2?
1268
jr nz, STRING.COMPARE.NE ; if not equal...
1269
cp 0 ;
1270
jr z, STRING.COMPARE.F1 ; if string 1 has finished...
1271
ld a, (iy) ; next char from string 2
1272
cp 0 ;
1273
jr z, STRING.COMPARE.GT ; if s2 has finished, s1 has not finished yet, so s1 is greater than s2
1274
inc ix ;
1275
inc iy ;
1276
jr STRING.COMPARE.NX ; get next char pair
1277
STRING.COMPARE.F1: ld a, (iy) ; verify if string 2 has finished too
1278
cp 0 ;
1279
jr z, STRING.COMPARE.EQ ; if s2 has finished, then they are equals
1280
jr STRING.COMPARE.LT ; else, result = s1 is less than s2
1281
STRING.COMPARE.NE: jr c, STRING.COMPARE.GT ; verify if s1 is greater than s2...
1282
STRING.COMPARE.LT: ld a, 1 ; ...else, result = s1 less than s2
1283
ret ;
1284
STRING.COMPARE.GT: ld a, 0xFF ; result = s1 is greater than s2
1285
ret ;
1286
STRING.COMPARE.EQ: xor a ; result = s1 is equal to s2
1287
ret ;
1288
STRING.CONCAT: ld ix, BASIC_DAC ; s1 size
1289
ld a, (BASIC_ARG) ; s2 size
1290
add a, (ix) ; s3 size = s1 size + s2 size
1291
push af
1292
ld b, 0
1293
ld c, a ;
1294
inc bc ; add 1 byte to size
1295
call memory.alloc ; in bc size, out ix new memory address, nz=OK
1296
jp z, memory.error ;
1297
push ix ; save ix
1298
push ix ; save ix
1299
pop de ; de = ix
1300
ld a, (BASIC_DAC) ; s1 size
1301
ld hl, (BASIC_DAC + 1) ; string 1
1302
call COPY_TO.STR ; copy to new memory
1303
ld a, (BASIC_ARG) ; s2 size
1304
ld hl, (BASIC_ARG + 1) ; string 2
1305
call COPY_TO.STR ; copy to new memory
1306
xor a
1307
ld (de), a ; null terminated
1308
pop hl ; hl = ix
1309
pop af
1310
call COPY_TO.VAR_DUMMY.STR ;
1311
ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs
1312
STRING.PRINT: ld a, (BIOS_SCRMOD) ; 0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode
1313
cp 5 ;
1314
jr nc, STRING.PRINT.G2 ; jump if graphic screen mode MSX2 (>=5)
1315
cp 2 ;
1316
jr nc, STRING.PRINT.G1 ; jump if graphic screen mode MSX1 (>=2)
1317
STRING.PRINT.T: ld a, (hl) ; get a char from a string parameter
1318
or a ; cp 0 - is it the string end?
1319
ret z ; exit if yes
1320
__call_bios BIOS_CHPUT ; put the char (a) into text screen
1321
inc hl ; next char
1322
jr STRING.PRINT.T ; repeat
1323
STRING.PRINT.G1: ld a, (hl) ; get a char from a string parameter
1324
or a ; cp 0 - is it the string end?
1325
ret z ; exit if yes
1326
__call_bios BIOS_GRPPRT ; put the char (a) into graphical screen
1327
inc hl ; next char
1328
jr STRING.PRINT.G1 ; repeat
1329
STRING.PRINT.G2: ld a, (hl) ; get a char from a string parameter
1330
or a ; cp 0 - is it the string end?
1331
ret z ; exit if yes
1332
ld ix, BIOS_GRPPRT2 ; put the char (a) into graphical screen
1333
call BIOS_EXTROM
1334
inc hl ; next char
1335
jr STRING.PRINT.G2 ; repeat
1336
1337
; a = string size to copy
1338
; input hl = string from
1339
; input de = string to
1340
COPY_TO.STR: or a
1341
ret z ; avoid copy if size = zero
1342
ld b, 0
1343
ld c, a ; string size
1344
ldir ; copy bc bytes from hl to de
1345
ret ;
1346
COPY_TO.BASIC_BUF: ld bc, BASIC_BUF
1347
ld a, (LIT_QUOTE_CHAR)
1348
ld (bc), a
1349
inc bc
1350
COPY_BAS_BUF.LOOP: ld a, (hl)
1351
or a ; cp 0
1352
jr z, COPY_BAS_BUF.EXIT
1353
ld (bc), a
1354
inc bc
1355
inc hl
1356
jr COPY_BAS_BUF.LOOP
1357
COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)
1358
ld (bc), a
1359
inc bc
1360
xor a
1361
ld (bc), a
1362
ld hl, BASIC_BUF
1363
ret
1364
COPY_TO.VAR_DUMMY: ld a, (BASIC_VALTYP) ; create dummy variable from VALTYPE
1365
cp 3 ;
1366
jr nz, COPY_TO.VAR_DUMMY.DBL
1367
call GET_STR.LENGTH ; get string length, in hl = address, out a = size
1368
COPY_TO.VAR_DUMMY.STR: call GET_VAR_DUMMY.ADDR ; create dummy string variable from HL
1369
ld (ix), 3 ; data type string
1370
ld (ix+1), 0 ;
1371
ld (ix+2), 255 ; var type fixed
1372
ld (ix+3), a ; string length
1373
ld (ix+4), l ; data address low
1374
ld (ix+5), h ; data address high
1375
push ix ; output var address...
1376
pop hl ; ...into hl
1377
ret ;
1378
COPY_TO.VAR_DUMMY.INT: call GET_VAR_DUMMY.ADDR ; create dummy integer variable from BC
1379
ld (ix), 2 ; data type string
1380
ld (ix+1), 0 ;
1381
ld (ix+2), 0 ;
1382
ld (ix+3), 0 ;
1383
ld (ix+4), 0 ;
1384
ld (ix+5), c ;
1385
ld (ix+6), b ;
1386
ld (ix+7), 0 ;
1387
ld (ix+8), 0 ;
1388
ld (ix+9), 0 ;
1389
ld (ix+10), 0 ;
1390
push ix ; output var address...
1391
pop hl ; ...into hl
1392
ret ;
1393
COPY_TO.VAR_DUMMY.DBL: call GET_VAR_DUMMY.ADDR ; create dummy value variable from DAC
1394
ld (ix), a ; data type
1395
ld (ix+1), 0 ;
1396
ld (ix+2), 0 ;
1397
ld bc, 8 ;
1398
ld hl, BASIC_DAC ;
1399
push ix ; just to copy ix to de
1400
pop de ;
1401
inc de ;
1402
inc de ;
1403
inc de ;
1404
ldir ; copy bc bytes from hl (data address) to de (variable address)
1405
push ix ; output var address...
1406
pop hl ; ...into hl
1407
ret ;
1408
GET_VAR_DUMMY.ADDR: push af ;
1409
push de
1410
ld de, 11 ;
1411
ld ix, (VAR_DUMMY.POINTER) ;
1412
ld a, (VAR_DUMMY.COUNTER) ;
1413
GET_VAR_DUMMY.NEXT: add ix, de ;
1414
inc a ;
1415
cp VAR_DUMMY.SIZE ;
1416
jr nz, GET_VAR_DUMMY.EXIT ;
1417
xor a ;
1418
ld ix, VAR_DUMMY.DATA ;
1419
GET_VAR_DUMMY.EXIT: ld (VAR_DUMMY.POINTER), ix ;
1420
ld (VAR_DUMMY.COUNTER), a ;
1421
ld a, (ix) ; get last var dummy type
1422
cp 3 ; is it string?
1423
call z, GET_VAR_DUMMY.FREE ; free string memory
1424
pop de
1425
pop af ;
1426
ret ;
1427
GET_VAR_DUMMY.FREE:
1428
push hl
1429
push ix
1430
ld a, (ix+3) ; string size
1431
ld l, (ix+4) ; get string data address
1432
ld h, (ix+5)
1433
push hl
1434
pop ix
1435
or a
1436
call nz, memory.free ; free memory
1437
pop ix
1438
pop hl
1439
ret
1440
; input hl = variable address
1441
COPY_TO.DAC: ld de, BASIC_DAC
1442
COPY_TO.DAC.DATA: ld a, (hl)
1443
ld (BASIC_VALTYP), a
1444
inc hl
1445
inc hl
1446
inc hl
1447
ld bc, 8 ; data = 8 bytes
1448
ldir ; copy bc bytes from hl (data address) to de (variable address)
1449
ret
1450
COPY_TO.ARG: ld de, BASIC_ARG ;
1451
jr COPY_TO.DAC.DATA ;
1452
COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;
1453
ld de, BASIC_ARG ;
1454
ld bc, 8 ; data = 8 bytes
1455
ldir ; copy bc bytes from hl (data address) to de (variable address)
1456
ret ;
1457
COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;
1458
ld de, BASIC_DAC ;
1459
ld bc, 8 ; data = 8 bytes
1460
ldir ; copy bc bytes from hl (data address) to de (variable address)
1461
ret ;
1462
COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;
1463
ld de, BASIC_SWPTMP ;
1464
ld bc, 8 ; data = 8 bytes
1465
ldir ; copy bc bytes from hl (data address) to de (variable address)
1466
ret ;
1467
COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;
1468
ld de, BASIC_DAC ;
1469
ld bc, 8 ; data = 8 bytes
1470
ldir ; copy bc bytes from hl (data address) to de (variable address)
1471
ret ;
1472
SWAP.DAC.ARG: di
1473
exx ; save registers
1474
ld bc, 8 ;
1475
ld hl, BASIC_DAC ;
1476
ld de, BASIC_SWPTMP ;
1477
ldir ; copy bc bytes from hl to de
1478
ld bc, 8 ;
1479
ld hl, BASIC_ARG ;
1480
ld de, BASIC_DAC ;
1481
ldir ; copy bc bytes from hl to de
1482
ld bc, 8 ;
1483
ld hl, BASIC_SWPTMP ;
1484
ld de, BASIC_ARG ;
1485
ldir ; copy bc bytes from hl to de
1486
exx ; restore registers
1487
ei
1488
ret ;
1489
CLEAR.DAC: ld de, BASIC_DAC
1490
CLEAR.DAC.DATA: ld hl, BASIC_VALTYP
1491
ld (hl), 2
1492
ld hl, LIT_NULL_DBL
1493
ld bc, 8 ; data = 8 bytes
1494
ldir ; copy bc bytes from hl (data address) to de (variable address)
1495
ret
1496
CLEAR.ARG: ld de, BASIC_ARG
1497
jr CLEAR.DAC.DATA
1498
1499
1500
1501
;---------------------------------------------------------------------------------------------------------
1502
; MATH 16 BITS ROUTINES
1503
;---------------------------------------------------------------------------------------------------------
1504
1505
MATH.PARM.POP: pop af ; get PC from caller stack
1506
ex af, af' ; save PC to temp
1507
pop.parm ; get first parameter
1508
call COPY_TO.ARG ; put HL in ARG (return var type in A)
1509
pop.parm ; get second parameter
1510
ex af, af' ; restore PC from temp
1511
push af ; put again PC from caller in stack
1512
ex af, af' ; restore 1st data type
1513
push af ; save 1st data type
1514
call COPY_TO.DAC ; put HL in DAC (return var type in A)
1515
pop bc ; restore 1st data type (ARG) in B
1516
cp b ; test if data type in A (DAC) = data type in B (ARG)
1517
ret z ; return if is equal data types
1518
MATH.PARM.CAST: push bc ; else cast both to double
1519
and 12 ; test if single/double
1520
jr nz, MATH.PARM.CST1 ; avoid cast if already single/double
1521
__call_bios MATH_FRCDBL ; convert DAC to double
1522
MATH.PARM.CST1: pop af ;
1523
and 12 ; test if single/double
1524
jr nz, MATH.PARM.CST2 ; avoid cast if already single/double
1525
ld (BASIC_VALTYP), a ;
1526
call COPY_TO.DAC_TMP ;
1527
call COPY_TO.ARG_DAC ;
1528
__call_bios MATH_FRCDBL ; convert ARG to double
1529
call COPY_TO.DAC_ARG ;
1530
call COPY_TO.TMP_DAC ;
1531
MATH.PARM.CST2: ld a, 8 ;
1532
ld (BASIC_VALTYP), a ;
1533
ret ;
1534
MATH.PARM.POP.INT: ; return result in DAC/ARG as integer
1535
pop af ; get PC from caller stack
1536
ex af, af' ; save PC to temp
1537
pop.parm ; get first parameter
1538
ld a, (hl) ; get parameter type
1539
and 2 ; test if integer
1540
jr z, MATH.PARM.POP.I1 ; do cast if not integer
1541
call COPY_TO.ARG ; put HL in ARG (return var type in A)
1542
jr MATH.PARM.POP.I2 ; go to next parameter
1543
MATH.PARM.POP.I1: call COPY_TO.DAC ; put HL in DAC (return var type in A)
1544
__call_bios MATH_FRCINT ; convert DAC to int
1545
call COPY_TO.DAC_ARG ; copy DAC to ARG
1546
MATH.PARM.POP.I2: pop.parm ; get second parameter
1547
call COPY_TO.DAC ; put HL in DAC (return var type in A)
1548
and 2 ; test if integer
1549
jr nz, MATH.PARM.POP.I3 ; avoid cast if already integer
1550
__call_bios MATH_FRCINT ; convert DAC to int
1551
ld a, 2 ;
1552
ld (BASIC_VALTYP), a ;
1553
MATH.PARM.POP.I3:
1554
ex af, af' ; restore PC from temp
1555
push af ; put again PC from caller in stack
1556
ret ;
1557
MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;
1558
ret.parm ;
1559
1560
if defined MATH.ADD
1561
1562
; input DAC, ARG
1563
; output in parm stack
1564
; http://www.z80.info/zip/zaks_book.pdf - page 104
1565
MATH.ADD.INT: ld hl, (BASIC_DAC+2) ;
1566
ld bc, (BASIC_ARG+2) ;
1567
add hl, bc ;
1568
ld (BASIC_DAC+2), hl ;
1569
jp MATH.PARM.PUSH ;
1570
1571
endif
1572
1573
if defined MATH.SUB or defined MATH.NEG
1574
1575
; input DAC, ARG
1576
; output in parm stack
1577
; http://www.z80.info/zip/zaks_book.pdf - page 104
1578
MATH.SUB.INT: ld hl, (BASIC_DAC+2) ;
1579
ld de, (BASIC_ARG+2) ;
1580
and a ; clear carry
1581
sbc hl, de ;
1582
ld (BASIC_DAC+2), hl ;
1583
jp MATH.PARM.PUSH ;
1584
1585
endif
1586
1587
if defined MATH.MULT
1588
1589
; input DAC, ARG
1590
; output in parm stack
1591
MATH.MULT.INT: ld hl, (BASIC_DAC+2) ;
1592
ld bc, (BASIC_ARG+2) ;
1593
call MATH.MULT.16 ;
1594
ld (BASIC_DAC+2), hl ;
1595
jp MATH.PARM.PUSH ;
1596
1597
; input HL = multiplicand
1598
; input BC = multiplier
1599
; output HL = result
1600
; http://www.z80.info/zip/zaks_book.pdf - page 131
1601
MATH.MULT.16: ld a, c ; low multiplier
1602
ld c, b ; high multiplier
1603
ld b, 16
1604
ld d, h ; multiplicand
1605
ld e, l
1606
ld hl, 0
1607
MULT16LOOP: srl c ; right shift multiplier high
1608
rra ; rotate right multiplier low
1609
jr nc, MULT16NOADD ; test carry
1610
add hl, de ; add multiplicand to result
1611
MULT16NOADD: ex de, hl
1612
add hl, hl ; double - shift multiplicand
1613
ex de, hl
1614
djnz MULT16LOOP
1615
ret
1616
1617
endif
1618
1619
if defined MATH.DIV or defined MATH.IDIV or defined MATH.MOD
1620
1621
; input AC = dividend
1622
; input DE = divisor
1623
; output AC = quotient
1624
; output HL = remainder
1625
; http://www.z80.info/zip/zaks_book.pdf - page 140
1626
MATH.DIV.16: ld hl, 0 ; clear accumulator
1627
ld b, 16 ; set counter
1628
DIV16LOOP: rl c ; rotate accumulator result left
1629
rla
1630
adc hl, hl ; left shift
1631
sbc hl, de ; trial subtract divisor
1632
jr nc, $ + 3 ; subtract was OK ($ = current location)
1633
add hl, de ; restore accumulator
1634
ccf ; calculate result bit
1635
djnz DIV16LOOP ; counter not zero
1636
rl c ; shift in last result bit
1637
rla
1638
ret
1639
1640
endif
1641
1642
if defined GFX_FAST or defined LINE
1643
1644
; compare two signed 16 bits integers
1645
; HL < DE: Carry flag
1646
; HL = DE: Zero flag
1647
; http://www.z80.info/zip/zaks_book.pdf - page 531
1648
MATH.COMP.S16: ld a, h ; test high order byte
1649
and 0x80 ; test sign, clear carry
1650
jr nz, MATH.COMP.S16.NEGM1 ; jump if hl is negative
1651
bit 7, d
1652
ret nz ; de is negative (and hl is positive)
1653
ld a, h
1654
cp d ; signs are both positive, so normal compare
1655
ret nz
1656
ld a, l ; test low order byte
1657
cp e
1658
ret
1659
MATH.COMP.S16.NEGM1:
1660
xor d
1661
rla ; sign bit into carry
1662
ret c ; signs different
1663
ld a, h
1664
cp d ; both signs negative
1665
ret nz
1666
ld a, l
1667
cp e
1668
ret
1669
1670
endif
1671
1672
if defined MATH.ADD
1673
1674
MATH.ADD.SGL: ld a, 8 ;
1675
ld (BASIC_VALTYP), a ;
1676
MATH.ADD.DBL: __call_bios MATH_DECADD ;
1677
jp MATH.PARM.PUSH ;
1678
1679
endif
1680
1681
if defined MATH.SUB or defined MATH.NEG
1682
1683
MATH.SUB.SGL: ld a, 8 ;
1684
ld (BASIC_VALTYP), a ;
1685
MATH.SUB.DBL: __call_bios MATH_DECSUB ;
1686
jp MATH.PARM.PUSH ;
1687
1688
endif
1689
1690
if defined MATH.MULT
1691
1692
MATH.MULT.SGL: ld a, 8 ;
1693
ld (BASIC_VALTYP), a ;
1694
MATH.MULT.DBL: __call_bios MATH_DECMUL ;
1695
jp MATH.PARM.PUSH ;
1696
1697
endif
1698
1699
if defined MATH.DIV
1700
1701
; input DAC, ARG
1702
; output in parm stack
1703
MATH.DIV.INT: __call_bios MATH_FRCDBL ; convert DAC to double
1704
call SWAP.DAC.ARG ;
1705
ld a, 2 ;
1706
ld (BASIC_VALTYP), a ;
1707
__call_bios MATH_FRCDBL ; convert ARG to double
1708
call SWAP.DAC.ARG ;
1709
MATH.DIV.SGL: ld a, 8 ;
1710
ld (BASIC_VALTYP), a ;
1711
MATH.DIV.DBL: __call_bios MATH_DECDIV ;
1712
jp MATH.PARM.PUSH ;
1713
1714
endif
1715
1716
if defined MATH.IDIV
1717
1718
; input DAC, ARG
1719
; output in parm stack
1720
MATH.IDIV.SGL: ld a, 8 ;
1721
ld (BASIC_VALTYP), a ;
1722
MATH.IDIV.DBL: __call_bios MATH_FRCINT ; convert DAC to integer
1723
call SWAP.DAC.ARG ;
1724
ld a, 8 ;
1725
ld (BASIC_VALTYP), a ;
1726
__call_bios MATH_FRCINT ; convert ARG to integer
1727
call SWAP.DAC.ARG ;
1728
MATH.IDIV.INT: ld hl, (BASIC_DAC+2) ;
1729
ld a, h ;
1730
ld c, l ;
1731
ld de, (BASIC_ARG+2) ;
1732
call MATH.DIV.16 ;
1733
ld h, a ;
1734
ld l, c ;
1735
ld (BASIC_DAC+2), hl ; quotient
1736
jp MATH.PARM.PUSH ;
1737
1738
endif
1739
1740
if defined MATH.POW
1741
1742
MATH.POW.INT: ld (BASIC_VALTYP), a ;
1743
__call_bios MATH_FRCDBL ; convert DAC to double
1744
call SWAP.DAC.ARG ;
1745
ld a, 2 ;
1746
ld (BASIC_VALTYP), a ;
1747
__call_bios MATH_FRCDBL ; convert ARG to double
1748
call SWAP.DAC.ARG ;
1749
MATH.POW.SGL: ld a, 8 ;
1750
ld (BASIC_VALTYP), a ;
1751
MATH.POW.DBL: __call_bios MATH_DBLEXP ;
1752
jp MATH.PARM.PUSH ;
1753
1754
endif
1755
1756
if defined MATH.MOD
1757
1758
;MATH.MOD.SGL: ld a, 8 ;
1759
; ld (BASIC_VALTYP), a ;
1760
;MATH.MOD.DBL: __call_bios MATH_FRCINT ; convert DAC to integer
1761
; call SWAP.DAC.ARG ;
1762
; ld a, 8 ;
1763
; ld (BASIC_VALTYP), a ;
1764
; __call_bios MATH_FRCINT ; convert ARG to integer
1765
; call SWAP.DAC.ARG ;
1766
MATH.MOD.INT: ld hl, (BASIC_DAC+2) ;
1767
ld a, h ;
1768
ld c, l ;
1769
ld de, (BASIC_ARG+2) ;
1770
call MATH.DIV.16 ;
1771
ld (BASIC_DAC+2), hl ; remainder
1772
jp MATH.PARM.PUSH ;
1773
1774
endif
1775
1776
if defined ISQR
1777
1778
; fast 16-bit integer square root
1779
; http://www.retroprogramming.com/2017/07/a-fast-z80-integer-square-root.html
1780
; 92 bytes, 344-379 cycles (average 362)
1781
; v2 - 3 t-state optimization spotted by Russ McNulty
1782
; call with hl = number to square root
1783
; returns a = square root
1784
; corrupts hl, de
1785
1786
MATH.INT.SQR:
1787
ld a,h
1788
ld de,0B0C0h
1789
add a,e
1790
jr c,sq7
1791
ld a,h
1792
ld d,0F0h
1793
sq7:
1794
add a,d
1795
jr nc,sq6
1796
res 5,d
1797
db 254
1798
sq6:
1799
sub d
1800
sra d
1801
set 2,d
1802
add a,d
1803
jr nc,sq5
1804
res 3,d
1805
db 254
1806
sq5:
1807
sub d
1808
sra d
1809
inc d
1810
add a,d
1811
jr nc,sq4
1812
res 1,d
1813
db 254
1814
sq4:
1815
sub d
1816
sra d
1817
ld h,a
1818
add hl,de
1819
jr nc,sq3
1820
ld e,040h
1821
db 210
1822
sq3:
1823
sbc hl,de
1824
sra d
1825
ld a,e
1826
rra
1827
or 010h
1828
ld e,a
1829
add hl,de
1830
jr nc,sq2
1831
and 0DFh
1832
db 218
1833
sq2:
1834
sbc hl,de
1835
sra d
1836
rra
1837
or 04h
1838
ld e,a
1839
add hl,de
1840
jr nc,sq1
1841
and 0F7h
1842
db 218
1843
sq1:
1844
sbc hl,de
1845
sra d
1846
rra
1847
inc a
1848
ld e,a
1849
add hl,de
1850
jr nc,sq0
1851
and 0FDh
1852
sq0:
1853
sra d
1854
rra
1855
cpl
1856
ret
1857
1858
endif
1859
1860
if defined RANDOMIZE or defined SEED
1861
1862
MATH.RANDOMIZE: di ;
1863
ld bc, (BIOS_JIFFY) ;
1864
ei ;
1865
1866
MATH.SEED: ld (BASIC_RNDX), bc ; seed to IRND
1867
push bc ; in bc = new integer seed
1868
call CLEAR.DAC ;
1869
pop bc ;
1870
;ld ix, BASIC_DAC ;
1871
ld (BASIC_DAC+2), bc ; copy bc to dac
1872
ld a, 2 ; type integer
1873
ld (BASIC_VALTYP), a ;
1874
__call_bios MATH_FRCDBL ; convert DAC integer to DAC double
1875
__call_bios MATH_NEG ; DAC = -DAC
1876
__call_bios MATH_RND ; put in DAC a new random number from previous DAC parameter
1877
ret ;
1878
1879
endif
1880
1881
MATH.ERROR: ld e, 13 ; type mismatch
1882
__call_basic BASIC_ERROR_HANDLER ;
1883
ret
1884
1885
1886
;---------------------------------------------------------------------------------------------------------
1887
; BOOLEAN ROUTINES
1888
;---------------------------------------------------------------------------------------------------------
1889
1890
BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;
1891
ret.parm ;
1892
BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;
1893
ret.parm ;
1894
BOOLEAN.CMP.INT: ld hl, (BASIC_DAC+2) ;
1895
ld de, (BASIC_ARG+2) ;
1896
__call_bios MATH_ICOMP ;
1897
ret ;
1898
BOOLEAN.CMP.SGL: ld bc, (BASIC_ARG) ;
1899
ld de, (BASIC_ARG+2) ;
1900
__call_bios MATH_DCOMP ;
1901
ret ;
1902
BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;
1903
ret ;
1904
BOOLEAN.CMP.STR: call STRING.COMPARE ;
1905
ret ;
1906
1907
if defined BOOLEAN.GT
1908
1909
BOOLEAN.GT.INT: call BOOLEAN.CMP.INT ;
1910
jr BOOLEAN.GT.RET ;
1911
BOOLEAN.GT.STR: call BOOLEAN.CMP.STR ;
1912
jr BOOLEAN.GT.RET ;
1913
BOOLEAN.GT.SGL: call BOOLEAN.CMP.SGL ;
1914
jr BOOLEAN.GT.RET ;
1915
BOOLEAN.GT.DBL: call BOOLEAN.CMP.DBL ;
1916
jr BOOLEAN.GT.RET ;
1917
BOOLEAN.GT.RET: cp 0x01 ;
1918
jp z, BOOLEAN.RET.TRUE ;
1919
jp BOOLEAN.RET.FALSE ;
1920
endif
1921
1922
if defined BOOLEAN.LT
1923
1924
BOOLEAN.LT.INT: call BOOLEAN.CMP.INT ;
1925
jr BOOLEAN.LT.RET ;
1926
BOOLEAN.LT.STR: call BOOLEAN.CMP.STR ;
1927
jr BOOLEAN.LT.RET ;
1928
BOOLEAN.LT.SGL: call BOOLEAN.CMP.SGL ;
1929
jr BOOLEAN.LT.RET ;
1930
BOOLEAN.LT.DBL: call BOOLEAN.CMP.DBL ;
1931
jr BOOLEAN.LT.RET ;
1932
BOOLEAN.LT.RET: cp 0xFF ;
1933
jp z, BOOLEAN.RET.TRUE ;
1934
jp BOOLEAN.RET.FALSE ;
1935
1936
endif
1937
1938
if defined BOOLEAN.GE
1939
1940
BOOLEAN.GE.INT: call BOOLEAN.CMP.INT ;
1941
jr BOOLEAN.GE.RET ;
1942
BOOLEAN.GE.STR: call BOOLEAN.CMP.STR ;
1943
jr BOOLEAN.GE.RET ;
1944
BOOLEAN.GE.SGL: call BOOLEAN.CMP.SGL ;
1945
jr BOOLEAN.GE.RET ;
1946
BOOLEAN.GE.DBL: call BOOLEAN.CMP.DBL ;
1947
jr BOOLEAN.GE.RET ;
1948
BOOLEAN.GE.RET: cp 0x01 ;
1949
jp z, BOOLEAN.RET.TRUE ;
1950
or a ; cp 0
1951
jp z, BOOLEAN.RET.TRUE ;
1952
jp BOOLEAN.RET.FALSE ;
1953
1954
endif
1955
1956
if defined BOOLEAN.LE
1957
1958
BOOLEAN.LE.INT: call BOOLEAN.CMP.INT ;
1959
jr BOOLEAN.LE.RET ;
1960
BOOLEAN.LE.STR: call BOOLEAN.CMP.STR ;
1961
jr BOOLEAN.LE.RET ;
1962
BOOLEAN.LE.SGL: call BOOLEAN.CMP.SGL ;
1963
jr BOOLEAN.LE.RET ;
1964
BOOLEAN.LE.DBL: call BOOLEAN.CMP.DBL ;
1965
jr BOOLEAN.LE.RET ;
1966
BOOLEAN.LE.RET: cp 0xFF ;
1967
jp z, BOOLEAN.RET.TRUE ;
1968
or a ; cp 0
1969
jp z, BOOLEAN.RET.TRUE ;
1970
jp BOOLEAN.RET.FALSE ;
1971
1972
endif
1973
1974
if defined BOOLEAN.NE
1975
1976
BOOLEAN.NE.INT: call BOOLEAN.CMP.INT ;
1977
jr BOOLEAN.NE.RET ;
1978
BOOLEAN.NE.STR: call BOOLEAN.CMP.STR ;
1979
jr BOOLEAN.NE.RET ;
1980
BOOLEAN.NE.SGL: call BOOLEAN.CMP.SGL ;
1981
jr BOOLEAN.NE.RET ;
1982
BOOLEAN.NE.DBL: call BOOLEAN.CMP.DBL ;
1983
jr BOOLEAN.NE.RET ;
1984
BOOLEAN.NE.RET: or a ; cp 0
1985
jp nz, BOOLEAN.RET.TRUE ;
1986
jp BOOLEAN.RET.FALSE ;
1987
1988
endif
1989
1990
if defined BOOLEAN.EQ
1991
1992
BOOLEAN.EQ.INT: call BOOLEAN.CMP.INT ;
1993
jr BOOLEAN.EQ.RET ;
1994
BOOLEAN.EQ.STR: call BOOLEAN.CMP.STR ;
1995
jr BOOLEAN.EQ.RET ;
1996
BOOLEAN.EQ.SGL: call BOOLEAN.CMP.SGL ;
1997
jr BOOLEAN.EQ.RET ;
1998
BOOLEAN.EQ.DBL: call BOOLEAN.CMP.DBL ;
1999
jr BOOLEAN.EQ.RET ;
2000
BOOLEAN.EQ.RET: or a ; cp 0
2001
jp z, BOOLEAN.RET.TRUE ;
2002
jp BOOLEAN.RET.FALSE ;
2003
2004
endif
2005
2006
if defined BOOLEAN.AND
2007
2008
BOOLEAN.AND.INT: ld a, (BASIC_DAC+2) ;
2009
ld hl, BASIC_ARG+2 ;
2010
and (hl) ;
2011
ld (BASIC_DAC+2), a ;
2012
inc hl ;
2013
ld a, (BASIC_DAC+3) ;
2014
and (hl) ;
2015
ld (BASIC_DAC+3), a ;
2016
ld a, 2 ;
2017
jp MATH.PARM.PUSH ;
2018
2019
endif
2020
2021
if defined BOOLEAN.OR
2022
2023
BOOLEAN.OR.INT: ld a, (BASIC_DAC+2) ;
2024
ld hl, BASIC_ARG+2 ;
2025
or (hl) ;
2026
ld (BASIC_DAC+2), a ;
2027
inc hl ;
2028
ld a, (BASIC_DAC+3) ;
2029
or (hl) ;
2030
ld (BASIC_DAC+3), a ;
2031
ld a, 2 ;
2032
jp MATH.PARM.PUSH ;
2033
2034
endif
2035
2036
if defined BOOLEAN.XOR
2037
2038
BOOLEAN.XOR.INT: ld a, (BASIC_DAC+2) ;
2039
ld hl, BASIC_ARG+2 ;
2040
xor (hl) ;
2041
ld (BASIC_DAC+2), a ;
2042
inc hl ;
2043
ld a, (BASIC_DAC+3) ;
2044
xor (hl) ;
2045
ld (BASIC_DAC+3), a ;
2046
ld a, 2 ;
2047
jp MATH.PARM.PUSH ;
2048
2049
endif
2050
2051
if defined BOOLEAN.EQV
2052
2053
BOOLEAN.EQV.INT: ld a, (BASIC_DAC+2) ;
2054
ld hl, BASIC_ARG+2 ;
2055
xor (hl) ;
2056
cpl ;
2057
ld (BASIC_DAC+2), a ;
2058
inc hl ;
2059
ld a, (BASIC_DAC+3) ;
2060
xor (hl) ;
2061
cpl ;
2062
ld (BASIC_DAC+3), a ;
2063
ld a, 2 ;
2064
jp MATH.PARM.PUSH ;
2065
2066
endif
2067
2068
if defined BOOLEAN.IMP
2069
2070
BOOLEAN.IMP.INT: ld a, (BASIC_DAC+2) ;
2071
ld hl, BASIC_ARG+2 ;
2072
cpl ;
2073
or (hl) ;
2074
ld (BASIC_DAC+2), a ;
2075
inc hl ;
2076
ld a, (BASIC_DAC+3) ;
2077
cpl ;
2078
or (hl) ;
2079
ld (BASIC_DAC+3), a ;
2080
ld a, 2 ;
2081
jp MATH.PARM.PUSH ;
2082
2083
endif
2084
2085
if defined BOOLEAN.SHR
2086
2087
BOOLEAN.SHR.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to right (bits 15...0-->)
2088
ld a, (BASIC_ARG+2) ;
2089
or a ; clear carry
2090
jp z, MATH.PARM.PUSH ; return if not shift
2091
ld b, a ; shift count
2092
BOOLEAN.SHR.INT.N: rr (ix+1) ;
2093
rr (ix) ;
2094
or a ; clear carry
2095
djnz BOOLEAN.SHR.INT.N ; next shift
2096
ld a, 2 ;
2097
jp MATH.PARM.PUSH ; return DAC
2098
2099
endif
2100
2101
if defined BOOLEAN.SHL
2102
2103
BOOLEAN.SHL.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to left (<--bits 15...0)
2104
ld a, (BASIC_ARG+2) ;
2105
or a ; clear carry
2106
jp z, MATH.PARM.PUSH ; return if not shift
2107
ld b, a ; shift count
2108
BOOLEAN.SHL.INT.N: rl (ix) ;
2109
rl (ix+1) ;
2110
or a ; clear carry
2111
djnz BOOLEAN.SHL.INT.N ; next shift
2112
ld a, 2 ;
2113
jp MATH.PARM.PUSH ; return DAC
2114
2115
endif
2116
2117
if defined BOOLEAN.NOT
2118
2119
BOOLEAN.NOT.INT: ld a, (BASIC_DAC+2) ;
2120
cpl ;
2121
ld (BASIC_DAC+2), a ;
2122
ld a, (BASIC_DAC+3) ;
2123
cpl ;
2124
ld (BASIC_DAC+3), a ;
2125
ld a, 2 ;
2126
jp MATH.PARM.PUSH ;
2127
2128
endif
2129
2130
2131
2132
;---------------------------------------------------------------------------------------------------------
2133
; MEMORY ALLOCATION ROUTINES
2134
;---------------------------------------------------------------------------------------------------------
2135
; Adapted from memory allocator code by SamSaga2, Spain, 2015
2136
; https://www.msx.org/forum/msx-talk/development/asm-memory-allocator
2137
; https://www.msx.org/users/samsaga2
2138
;---------------------------------------------------------------------------------------------------------
2139
memory.heap_start: equ VAR_STACK.END + 1 ; start at end of variable stack
2140
memory.heap_end: equ 0xF0A0 - 100 ; end at start of work area for stack (100 bytes reserved), BIOS and BASIC interpreter
2141
block.next: equ 0 ; next free block address
2142
block.size: equ 2 ; size of block including header
2143
block: equ 4 ; block.next + block.size
2144
2145
;; init
2146
memory.init:
2147
ld ix,memory.heap_start ; first block
2148
ld hl,memory.heap_start+block ; second block
2149
;; first block NEXT=secondblock, SIZE=0
2150
;; with this block we have a fixed start location
2151
;; because never will be allocated
2152
ld (ix+block.next),l
2153
ld (ix+block.next+1),h
2154
ld (ix+block.size),0
2155
ld (ix+block.size+1),0
2156
;; second block NEXT=0, SIZE=all
2157
;; the first and only free block have all available memory
2158
ld (ix+block.next+block),0
2159
ld (ix+block.next+block+1),0
2160
xor a
2161
;ld hl,memory.heap_end ; size = @heap_end (stack) - heap_start - block_header * 2 - 100 (buffer for stack)
2162
ld (BIOS_TEMP), sp
2163
ld hl, (BIOS_TEMP)
2164
ld de, memory.heap_start + (block * 2) + 100
2165
sbc hl,de
2166
;ld de, block * 2 + 100
2167
;sbc hl, de
2168
ld (ix+block.size+block),l
2169
ld (ix+block.size+block+1),h
2170
ret
2171
2172
;; alloc
2173
;; IN BC=size, OUT IX=memptr, NZ=ok
2174
memory.alloc:
2175
ld hl,block
2176
add hl,bc
2177
;push hl
2178
;pop bc
2179
ld b, h
2180
ld c, l
2181
ld ix,memory.heap_start ; this
2182
ld iy,0 ; prev
2183
memory.alloc.find:
2184
ld l,(ix+block.size)
2185
ld h,(ix+block.size+1)
2186
xor a
2187
sbc hl,bc
2188
jp z, memory.alloc.exactfit
2189
jp c, memory.alloc.nextblock
2190
;; split found block
2191
memory.alloc.splitfit:
2192
;; free space must allow at least two blocks headers (current + next)
2193
or h
2194
jr nz, memory.alloc.splitfit.do ; if free space > 0xFF, do split
2195
ld a, l
2196
cp 4
2197
jr c, memory.alloc.nextblock ; if free space < 4, skip to next block
2198
memory.alloc.splitfit.do:
2199
;; newfreeblock = this + BC
2200
push ix
2201
pop hl
2202
add hl,bc
2203
;; prevblock->next = newfreeblock
2204
ld (iy+block.next),l
2205
ld (iy+block.next+1),h
2206
;; newfreeblock->next = this->next
2207
push hl
2208
pop iy ; iy = newfreeblock
2209
ld l,(ix+block.next)
2210
ld h,(ix+block.next+1)
2211
ld (iy+block.next),l
2212
ld (iy+block.next+1),h
2213
;; newfreeblock->size = this->size - BC
2214
ld l,(ix+block.size)
2215
ld h,(ix+block.size+1)
2216
xor a
2217
sbc hl,bc
2218
ld (iy+block.size),l
2219
ld (iy+block.size+1),h
2220
;; this->size = BC
2221
ld (ix+block.size),c
2222
ld (ix+block.size+1),b
2223
jr memory.alloc.ok
2224
;; use whole found block
2225
memory.alloc.exactfit:
2226
;; prevblock->next = this->next - remove block from free list
2227
ld l,(ix+block.next)
2228
ld h,(ix+block.next+1)
2229
ld (iy+block.next),l
2230
ld (iy+block.next+1),h
2231
memory.alloc.ok:
2232
;; ix = first byte
2233
ld de,block
2234
add ix,de
2235
;; enable z-flag
2236
ld a,1
2237
or a
2238
ret
2239
memory.alloc.nextblock:
2240
ld l,(ix+block.next)
2241
ld h,(ix+block.next+1)
2242
ld a,l
2243
cp h
2244
ret z
2245
;; prevblock = this
2246
push ix
2247
pop iy
2248
;; this = this->next
2249
push hl
2250
pop ix
2251
jp memory.alloc.find
2252
2253
;; free
2254
;; IN IX=memptr
2255
memory.free:
2256
;; HL = IX - block_header_size
2257
push ix
2258
pop hl
2259
ld de, block
2260
xor a
2261
sbc hl,de
2262
;; start of search
2263
ld ix,memory.heap_start
2264
memory.free.find:
2265
ld e,(ix+block.next)
2266
ld d,(ix+block.next+1)
2267
ld a,d
2268
or e
2269
jp z, memory.free.passedend
2270
sbc hl,de ; test this (HL) against next (DE)
2271
jr c, memory.free.found ; if DE > HL
2272
add hl,de ; restore hl value
2273
push de
2274
pop ix ; current = next
2275
jr memory.free.find
2276
2277
;; ix=prev, hl=this, de=next
2278
memory.free.found:
2279
add hl,de ; restore hl value
2280
ld (ix+block.next), l
2281
ld (ix+block.next+1), h ; prev->next = this
2282
push hl
2283
pop iy
2284
ld (iy+block.next), e
2285
ld (iy+block.next+1), d ; this->next = next
2286
push ix ; prev x this
2287
pop iy
2288
push hl
2289
pop ix
2290
push de
2291
call memory.free.coalesce
2292
pop ix ; this x next
2293
jr memory.free.coalesce
2294
2295
;; parm1 = *next
2296
;; parm2 = *this
2297
memory.free.coalesce:
2298
ld c, (iy+block.size)
2299
ld b, (iy+block.size+1) ; bc = this->size
2300
push iy
2301
pop hl
2302
xor a
2303
adc hl, bc ; hl = this + this->size
2304
push ix
2305
pop de
2306
xor a
2307
sbc hl, de ; if this + this->size == next, then this->size += next->size, this->next = next->next
2308
jr z, memory.free.coalesce.do
2309
push ix ; else, new *this = *next
2310
pop iy
2311
ret
2312
memory.free.coalesce.do:
2313
ld l, (ix+block.size)
2314
ld h, (ix+block.size+1) ; hl = next->size
2315
xor a
2316
adc hl, bc ; hl += this->size
2317
ld (iy+block.size), l
2318
ld (iy+block.size+1), h ; this->size = hl
2319
ld l, (ix+block.next)
2320
ld h, (ix+block.next+1) ; hl = next->next
2321
ld (iy+block.next), l
2322
ld (iy+block.next+1), h ; this->next = hl
2323
ret
2324
2325
memory.free.passedend:
2326
;; append block at the end of the free list
2327
ld (ix+block.next),l
2328
ld (ix+block.next+1),h
2329
push hl
2330
pop iy
2331
ld (iy+block.next),0
2332
ld (iy+block.next+1),0
2333
ret
2334
2335
;; get_free
2336
;; OUT BC=freespace
2337
memory.get_free:
2338
ld ix,memory.heap_start
2339
ld bc,0
2340
memory.get_free.count:
2341
ld a,c
2342
add a,(ix+block.size)
2343
ld c,a
2344
ld a,b
2345
adc a,(ix+block.size+1)
2346
ld b,a
2347
ld l,(ix+block.next)
2348
ld h,(ix+block.next+1)
2349
ld a,h
2350
or l
2351
ret z
2352
push hl
2353
pop ix
2354
jr memory.get_free.count
2355
2356
memory.error: ld e, 7 ; out of memory
2357
__call_basic BASIC_ERROR_HANDLER ;
2358
ret
2359
2360
2361
2362
;---------------------------------------------------------------------------------------------------------
2363
; MATH PACK WRAPPER
2364
;---------------------------------------------------------------------------------------------------------
2365
2366
CALL_MATH_LIB: exx
2367
ld hl, RET_MATH_LIB
2368
push hl
2369
ld hl, BASIC_DAC
2370
ld de, BASIC_ARG
2371
ld bc, BASIC_SWPTMP
2372
jp (ix)
2373
RET_MATH_LIB: call COPY_TO.TMP_DAC
2374
exx
2375
ret
2376
2377
if defined MATH.ADD
2378
2379
MATH_DECADD: ld ix, addSingle
2380
jp CALL_MATH_LIB
2381
2382
endif
2383
2384
if defined MATH.SUB or defined MATH.NEG
2385
2386
MATH_DECSUB: ld ix, subSingle
2387
jp CALL_MATH_LIB
2388
2389
endif
2390
2391
if defined MATH.MULT
2392
2393
MATH_DECMUL: ld ix, mulSingle
2394
jp CALL_MATH_LIB
2395
2396
endif
2397
2398
if defined MATH.DIV
2399
2400
MATH_DECDIV: ld ix, divSingle
2401
jp CALL_MATH_LIB
2402
2403
endif
2404
2405
if defined MATH.POW
2406
2407
MATH_DBLEXP:
2408
MATH_SNGEXP: ld ix, powSingle
2409
jp CALL_MATH_LIB
2410
2411
endif
2412
2413
if defined COS
2414
2415
MATH_COS: ld ix, cosSingle
2416
jp CALL_MATH_LIB
2417
2418
endif
2419
2420
if defined SIN
2421
2422
MATH_SIN: ld ix, sinSingle
2423
jp CALL_MATH_LIB
2424
2425
endif
2426
2427
if defined TAN
2428
2429
MATH_TAN: ld ix, tanSingle
2430
jp CALL_MATH_LIB
2431
2432
endif
2433
2434
if defined ATN
2435
2436
MATH_ATN: ld ix, atanSingle
2437
jp CALL_MATH_LIB
2438
2439
endif
2440
2441
if defined SQR
2442
2443
MATH_SQR: ld ix, sqrtSingle
2444
jp CALL_MATH_LIB
2445
2446
endif
2447
2448
if defined LOG
2449
2450
MATH_LOG: ld ix, lnSingle
2451
jp CALL_MATH_LIB
2452
2453
endif
2454
2455
if defined EXP
2456
2457
MATH_EXP: ld ix, expSingle
2458
jp CALL_MATH_LIB
2459
2460
endif
2461
2462
if defined ABS
2463
2464
MATH_ABSFN: ld ix, absSingle
2465
jp CALL_MATH_LIB
2466
2467
endif
2468
2469
if defined MATH.SEED or defined MATH.NEG
2470
2471
MATH_NEG: ld ix, negSingle
2472
jp CALL_MATH_LIB
2473
2474
endif
2475
2476
if defined SGN
2477
2478
MATH_SGN: ld ix, sgnSingle
2479
jp CALL_MATH_LIB
2480
2481
endif
2482
2483
if defined RND or defined MATH.SEED
2484
2485
MATH_RND: ld ix, randSingle
2486
jp CALL_MATH_LIB
2487
2488
endif
2489
2490
MATH_FRCINT: ld hl, BASIC_DAC
2491
ld bc, BASIC_DAC+2
2492
call single2Int
2493
ld ix, BASIC_DAC
2494
ld (ix), 0
2495
ld (ix+1), 0
2496
;ld (ix+2), l
2497
;ld (ix+3), h
2498
ld (ix+4), 0
2499
ld (ix+5), 0
2500
ld (ix+6), 0
2501
ld (ix+7), 0
2502
ld a, 2
2503
ld (BASIC_VALTYP), a
2504
ret
2505
2506
MATH_FRCDBL: ; same as MATH_FRCSGL
2507
MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address
2508
ld bc, BASIC_DAC ; output address
2509
call int2Single
2510
ld a, 8
2511
ld (BASIC_VALTYP), a
2512
ret
2513
2514
MATH_ICOMP: ld a, h ; cp hl, de (alternative to bios DCOMPR)
2515
cp d
2516
jr nz, MATH_ICOMP.NE.HIGH
2517
ld a, l
2518
cp e
2519
jr nz, MATH_ICOMP.NE.LOW
2520
jr MATH_DCOMP.EQ
2521
MATH_ICOMP.NE.HIGH: jr c, MATH_ICOMP.GT.HIGH
2522
bit 7, a
2523
jr nz, MATH_DCOMP.GT
2524
jr MATH_DCOMP.LT
2525
MATH_ICOMP.GT.HIGH: bit 7, d
2526
jr z, MATH_DCOMP.GT
2527
jr MATH_DCOMP.LT
2528
MATH_ICOMP.NE.LOW: jr c, MATH_DCOMP.GT
2529
jr MATH_DCOMP.LT
2530
2531
MATH_XDCOMP: ; same as MATH_DCOMP
2532
MATH_DCOMP: ld ix, cmpSingle
2533
call CALL_MATH_LIB
2534
jr z, MATH_DCOMP.EQ
2535
jr c, MATH_DCOMP.LT
2536
MATH_DCOMP.GT: ld a, 0xFF ; DAC > ARG
2537
ret
2538
MATH_DCOMP.EQ: ld a, 0 ; DAC = ARG
2539
ret
2540
MATH_DCOMP.LT: ld a, 1 ; DAC < ARG
2541
ret
2542
2543
if defined CAST_STR_TO.VAL
2544
2545
MATH_FIN: ; HL has the source string
2546
ld a, (BASIC_VALTYP)
2547
cp 2 ; test if integer
2548
jr nz, MATH_FIN.1
2549
;ld hl, (BASIC_DAC+2)
2550
;ld de, BASIC_STRBUF
2551
ex de, hl
2552
call StrToInt
2553
ld bc, 0
2554
ld (BASIC_DAC), bc
2555
ld (BASIC_DAC+2), hl
2556
ld (BASIC_DAC+4), bc
2557
ld (BASIC_DAC+6), bc
2558
;ld hl, BASIC_STRBUF
2559
ret
2560
MATH_FIN.1: ld BC, BASIC_DAC
2561
call str2single
2562
ret
2563
2564
endif
2565
2566
if defined CAST_INT_TO.STR
2567
2568
MATH_FOUT: ld a, (BASIC_VALTYP)
2569
cp 2 ; test if integer
2570
jr nz, MATH_FOUT.1
2571
ld hl, (BASIC_DAC+2)
2572
ld de, BASIC_STRBUF
2573
call IntToStr
2574
ld hl, BASIC_STRBUF
2575
ret
2576
MATH_FOUT.1: ld hl, BASIC_DAC
2577
ld bc, BASIC_STRBUF
2578
call single2str
2579
ld hl, BASIC_STRBUF
2580
ret
2581
2582
endif
2583
2584
2585
2586
2587
;---------------------------------------------------------------------------------------------------------
2588
; Z80FLOAT LIBRARY
2589
; Copyright 2018 Zeda A.K. Thomas
2590
;---------------------------------------------------------------------------------------------------------
2591
; References:
2592
; https://github.com/Zeda/z80float
2593
; https://www.omnimaga.org/asm-language/(z80)-floating-point-routines/
2594
; https://en.wikipedia.org/wiki/Single-precision_floating-point_format
2595
;---------------------------------------------------------------------------------------------------------
2596
; Parameters:
2597
; HL points to the first operand
2598
; DE points to the second operand (if needed)
2599
; IX points to the third operand (if needed, rare)
2600
; BC points to where the result should be output
2601
; Floats are stored by a little-endian 24-bit mantissa. However, the highest bit
2602
; is taken as implicitly 1, so we replace it as a sign bit. Next comes an 8-bit
2603
; exponent biased by +128.
2604
;---------------------------------------------------------------------------------------------------------
2605
; Adapted to MSXBas2Asm by Amaury Carvalho, 2019
2606
;---------------------------------------------------------------------------------------------------------
2607
2608
;---------------------------------------------------------------------------------------------------------
2609
; Work area
2610
;---------------------------------------------------------------------------------------------------------
2611
2612
BASIC_HOLD8: equ 0xF806 ; 48 Work area for decimal multiplications.
2613
BASIC_HOLD2: equ 0xF836 ; 8 Work area in the execution of numerical operators.
2614
BASIC_HOLD: equ 0xF83E ; 8 Work area in the execution of numerical operators.
2615
scrap: equ BASIC_HOLD8
2616
seed0: equ BASIC_RNDX
2617
seed1: equ seed0 + 4
2618
var48: equ scrap + 4
2619
quot: equ scrap + 1
2620
addend: equ scrap
2621
addend2: equ scrap+7 ;4 bytes
2622
var_x: equ BASIC_HOLD8 + 4 ;4 bytes
2623
var_y: equ var_x + 4 ;4 bytes
2624
var_z: equ var_y + 4 ;4 bytes
2625
var_a: equ var_z + 4 ;4 bytes
2626
var_b: equ var_a + 4 ;4 bytes
2627
var_c: equ var_b + 4 ;4 bytes
2628
temp: equ var_c + 4 ;4 bytes
2629
temp1: equ temp + 4 ;4 bytes
2630
temp2: equ temp1 + 4 ;4 bytes
2631
temp3: equ temp2 + 4 ;4 bytes
2632
2633
pow10exp_single: equ scrap+9
2634
strout_single: equ 0xF750 ; PARM2 - BASIC_BUF ;pow10exp_single+2
2635
2636
;---------------------------------------------------------------------------------------------------------
2637
; addSingle
2638
;---------------------------------------------------------------------------------------------------------
2639
2640
;;Still need to tend to special cases
2641
addSingle:
2642
;;x+y
2643
push af
2644
push hl
2645
push de
2646
push bc
2647
addInject:
2648
inc de
2649
inc de
2650
inc hl
2651
inc hl
2652
ld a,(de)
2653
xor (hl)
2654
push af
2655
inc de
2656
inc hl
2657
ex de,hl
2658
ld a,(de)
2659
sub (hl)
2660
ex de,hl
2661
jr nc,$+5
2662
ex de,hl
2663
neg
2664
cp 24
2665
jp nc,add_unneeded
2666
push hl
2667
ld hl,addend+6
2668
dec de
2669
ld bc,0408h
2670
dec hl
2671
ld (hl),0
2672
sub c
2673
jr nc,$-5
2674
add a,c
2675
push af
2676
push hl
2677
ex de,hl
2678
ld a,(hl)
2679
or 80h
2680
ld (de),a
2681
dec de
2682
dec hl
2683
ldd
2684
ldd
2685
ex de,hl
2686
dec b
2687
jr z,$+7
2688
ld (hl),0
2689
dec hl
2690
djnz $-3
2691
pop hl
2692
pop af
2693
ld b,a
2694
jr z,noshift
2695
set 7,(hl)
2696
_1:
2697
push hl
2698
srl (hl)
2699
dec hl
2700
rr (hl)
2701
dec hl
2702
rr (hl)
2703
dec hl
2704
rr (hl)
2705
pop hl
2706
djnz _1
2707
noshift:
2708
pop hl ;bigger float
2709
dec hl
2710
ld b,(hl)
2711
dec hl
2712
dec hl
2713
ex de,hl
2714
pop af
2715
jp m,subtract
2716
ld hl,addend+2
2717
ld a,(hl)
2718
rla
2719
inc hl
2720
ld a,(de)
2721
adc a,(hl)
2722
ld (hl),a
2723
inc hl
2724
inc de
2725
ld a,(de)
2726
adc a,(hl)
2727
ld (hl),a
2728
inc hl
2729
inc de
2730
ld a,(de)
2731
set 7,a
2732
adc a,(hl)
2733
ld (hl),a
2734
inc hl
2735
inc de
2736
ld a,(de)
2737
ld (hl),a
2738
jp nc,add_done
2739
inc (hl)
2740
jp z,add_overflow
2741
dec hl
2742
rr (hl)
2743
dec hl
2744
rr (hl)
2745
dec hl
2746
rr (hl)
2747
jp add_done
2748
subtract:
2749
ld hl,addend
2750
xor a
2751
ld c,a
2752
sub (hl)
2753
ld (hl),a
2754
inc hl
2755
ld a,c
2756
sbc a,(hl)
2757
ld (hl),a
2758
inc hl
2759
ld a,c
2760
sbc a,(hl)
2761
ld (hl),a
2762
inc hl
2763
ld a,(de)
2764
sbc a,(hl)
2765
ld (hl),a
2766
inc hl
2767
inc de
2768
ld a,(de)
2769
sbc a,(hl)
2770
ld (hl),a
2771
inc hl
2772
inc de
2773
ld a,(de)
2774
set 7,a
2775
sbc a,(hl)
2776
ld (hl),a
2777
inc hl
2778
inc de
2779
ld a,(de)
2780
ld (hl),a
2781
dec de
2782
ex de,hl
2783
jr nc,negated
2784
ld hl,addend
2785
ld a,80h
2786
xor b
2787
ld b,a
2788
ld a,c
2789
sub (hl)
2790
ld (hl),a
2791
inc hl
2792
ld a,c
2793
sbc a,(hl)
2794
ld (hl),a
2795
inc hl
2796
ld a,c
2797
sbc a,(hl)
2798
ld (hl),a
2799
inc hl
2800
ld a,c
2801
sbc a,(hl)
2802
ld (hl),a
2803
inc hl
2804
ld a,c
2805
sbc a,(hl)
2806
ld (hl),a
2807
inc hl
2808
ld a,c
2809
sbc a,(hl)
2810
ld (hl),a
2811
negated:
2812
jp m,add_done
2813
push bc
2814
ld hl,(addend)
2815
ld de,(addend+2)
2816
ld bc,(addend+4)
2817
ld a,h
2818
or l
2819
or d
2820
or e
2821
or b
2822
or c
2823
jp z,add_underflow
2824
ld a,(addend+6)
2825
normalize:
2826
dec a
2827
jr z,add_underflow
2828
add hl,hl
2829
rl e
2830
rl d
2831
rl c
2832
rl b
2833
jp p,normalize
2834
ld (addend),hl
2835
ld (addend+2),de
2836
ld (addend+4),bc
2837
ld (addend+6),a
2838
pop bc
2839
add_done:
2840
;;Need to adjust sign flag
2841
ld hl,addend+5
2842
ld a,(hl)
2843
rla
2844
rl b
2845
rra
2846
ld (hl),a
2847
dec hl
2848
dec hl
2849
add_copy:
2850
pop de
2851
push de
2852
ldi
2853
ldi
2854
ldi
2855
ld a,(hl)
2856
ld (de),a
2857
pop bc
2858
pop de
2859
pop hl
2860
pop af
2861
ret
2862
add_underflow:
2863
;;How many push/pops are needed?
2864
;;return ZERO
2865
ld hl,0
2866
ld (addend+3),hl
2867
ld (addend+5),hl
2868
pop bc
2869
jr add_done
2870
add_overflow:
2871
;;How many push/pops are needed?
2872
;;return INF
2873
dec hl
2874
ld (hl),40h
2875
jr add_done
2876
add_unneeded:
2877
;;How many push/pops are needed?
2878
;;Return bigger number
2879
pop af
2880
dec hl
2881
dec hl
2882
dec hl
2883
jr add_copy
2884
2885
;---------------------------------------------------------------------------------------------------------
2886
; subSingle
2887
;---------------------------------------------------------------------------------------------------------
2888
2889
subSingle:
2890
;;x-y
2891
push af
2892
push hl
2893
push de
2894
push bc
2895
push hl
2896
ex de,hl
2897
ld de,addend2
2898
ldi
2899
ldi
2900
ld a,(hl)
2901
xor 80h
2902
ld (de),a
2903
inc de
2904
inc hl
2905
ld a,(hl)
2906
ld (de),a
2907
ex de,hl
2908
pop hl
2909
ld de,addend2
2910
jp addInject ;jumps in to the addSingle routine
2911
2912
;---------------------------------------------------------------------------------------------------------
2913
; mulSingle
2914
;---------------------------------------------------------------------------------------------------------
2915
2916
mulSingle:
2917
;Inputs: HL points to float1, DE points to float2, BC points to where the result is copied
2918
;Outputs: float1*float2 is stored to (BC)
2919
;573+mul24+{0,35}+{0,30}
2920
;min: 1398cc
2921
;max: 2564cc
2922
;avg: 2055.13839751681cc
2923
push af
2924
push hl
2925
push de
2926
push bc
2927
2928
call _2 ;CHLB
2929
ld a,c
2930
ex de,hl
2931
pop hl
2932
push hl
2933
ld (hl),b
2934
inc hl
2935
ld (hl),e
2936
inc hl
2937
ld (hl),d
2938
inc hl
2939
ld (hl),a
2940
pop bc
2941
pop de
2942
pop hl
2943
pop af
2944
ret
2945
2946
2947
_2:
2948
;;return float in CHLB
2949
push de
2950
ld e,(hl)
2951
inc hl
2952
ld d,(hl)
2953
inc hl
2954
ld c,(hl)
2955
inc hl
2956
ld a,(hl)
2957
or a
2958
jr z,mulSingle_case0
2959
ex de,hl
2960
ex (sp),hl
2961
ld e,(hl)
2962
inc hl
2963
ld d,(hl)
2964
inc hl
2965
ld b,(hl)
2966
inc hl
2967
2968
;inc (hl)
2969
;dec (hl)
2970
;jr z,mulSingle_case1
2971
push af
2972
ld a, (hl)
2973
or a
2974
jp z,mulSingle_case1
2975
pop af
2976
2977
add a,(hl) ;\
2978
pop hl ; |
2979
rra ; |Lots of help from Runer112 and
2980
adc a,a ; |calc84maniac for optimizing
2981
jp po,bad ; |this exponent check.
2982
xor 80h ; |
2983
jr z,underflow ;/
2984
push af ;exponent
2985
ld a,b
2986
xor c
2987
push af ;sign
2988
set 7,b
2989
set 7,c
2990
call mul24 ;BDE*CHL->HLBCDE, returns sign info
2991
pop de
2992
ld a,e
2993
pop de
2994
jp m,_3
2995
rl c
2996
rl b
2997
adc hl,hl
2998
dec d
2999
_3:
3000
inc d
3001
jr z,overflow
3002
rl c
3003
ld c,d
3004
ld de,0
3005
push af
3006
ld a,b
3007
adc a,e
3008
ld b,a
3009
adc hl,de
3010
jr nc,_4
3011
inc c
3012
jr z,overflow
3013
rr h
3014
rr l
3015
rr b
3016
_4:
3017
pop af
3018
cpl
3019
and $80
3020
xor h
3021
ld h,a
3022
ret
3023
bad:
3024
jr nc,overflow
3025
underflow:
3026
ld hl,0
3027
rl b
3028
rr h
3029
ld c,l
3030
ld b,l
3031
ret
3032
overflow:
3033
ld hl,$8000
3034
jr underflow+3
3035
mulSingle_case1:
3036
;x*0 -> 0
3037
;x*inf -> inf
3038
;x*NaN -> NaN
3039
pop af
3040
pop hl
3041
ld h,b
3042
ld l,d
3043
ld b,e
3044
ld c,0
3045
ret
3046
mulSingle_case0:
3047
;special*x = special
3048
;NaN*x = NaN
3049
;0*0 = 0
3050
;0*NaN = NaN
3051
;0*Inf = NaN
3052
;Inf*Inf = Inf
3053
;Inf*-Inf =-Inf
3054
;0CDE
3055
pop hl
3056
inc hl
3057
inc hl
3058
inc hl
3059
ld a,(hl)
3060
or a
3061
jr z,_5
3062
ld h,c
3063
ld c,0
3064
ret
3065
_5:
3066
dec hl
3067
ld b,(hl)
3068
;basically, if b|c has bit 5 set, return NaN
3069
ld a,b
3070
or c
3071
ld h,$20
3072
and h
3073
jr z,_6
3074
ld c,0
3075
ret
3076
_6:
3077
ld a,c
3078
xor b
3079
rl b
3080
rlca
3081
rr b
3082
res 4,b
3083
3084
rl c
3085
rrca
3086
rr c
3087
3088
ld a,c
3089
and $E0
3090
add a,b
3091
rra
3092
ld h,a
3093
ld c,0
3094
ret
3095
mul24:
3096
;;BDE*CHL -> HLBCDE
3097
;;155 bytes
3098
;;402+3*C_Times_BDE
3099
;;fastest:1201cc
3100
;;slowest:1753cc
3101
;;avg :1464.9033203125cc (1464+925/1024)
3102
;min: 825cc
3103
;max: 1926cc
3104
;avg: 1449.63839751681cc
3105
3106
push bc
3107
ld c,l
3108
push hl
3109
call C_Times_BDE
3110
ld (var48),hl
3111
ld l,a
3112
ld h,c
3113
ld (var48+2),hl
3114
3115
pop hl
3116
ld c,h
3117
call C_Times_BDE
3118
push bc
3119
ld bc,(var48+1)
3120
add hl,bc
3121
ld (var48+1),hl
3122
pop bc
3123
ld b,c
3124
ld c,a
3125
ld hl,(var48+3)
3126
ld h,0
3127
adc hl,bc
3128
ld (var48+3),hl
3129
3130
pop bc
3131
call C_Times_BDE
3132
ld de,(var48+2)
3133
add hl,de
3134
ld (var48+2),hl
3135
ld d,c
3136
ld e,a
3137
ld b,h
3138
ld c,l
3139
ld hl,(var48+4)
3140
ld h,0
3141
adc hl,de
3142
ld de,(var48)
3143
ret
3144
3145
;---------------------------------------------------------------------------------------------------------
3146
; divSingle
3147
;---------------------------------------------------------------------------------------------------------
3148
3149
divSingle:
3150
;;HL points to numerator
3151
;;DE points to denominator
3152
;;BC points to where the quotient gets written
3153
call pushpop
3154
divSingle_no_pushpop:
3155
inc hl
3156
inc de
3157
inc hl
3158
inc de
3159
ld a,(de) ;\
3160
xor (hl) ; |Get sign of output
3161
add a,a ; |
3162
push af ;/
3163
push bc
3164
inc hl
3165
inc de
3166
ld a,(hl) ;\
3167
ex de,hl ; |Get exponent
3168
sub (hl) ; |
3169
ex de,hl ; |
3170
3171
ld b,-1
3172
jr nc,_7
3173
dec b
3174
_7:
3175
add a,128
3176
jr nc,_8
3177
inc b
3178
_8:
3179
inc b
3180
jr z,_9
3181
jp p,divunderflow
3182
jp m,divoverflow
3183
_9:
3184
ld (quot+3),a
3185
dec hl
3186
dec de
3187
ld b,(hl)
3188
dec hl
3189
ld a,(hl)
3190
dec hl
3191
ld l,(hl)
3192
ld h,a
3193
ex de,hl
3194
3195
ld c,(hl)
3196
dec hl
3197
ld a,(hl)
3198
dec hl
3199
ld l,(hl)
3200
ld h,a
3201
ex de,hl
3202
3203
set 7,c
3204
ld a,b
3205
or 80h
3206
sbc hl,de
3207
sbc a,c
3208
jr nz,_10
3209
or h
3210
or l
3211
jr z,setmantissa0
3212
xor a
3213
_10:
3214
jr nc,startdiv
3215
ld b,a
3216
ld a,(quot+3)
3217
dec a
3218
ld (quot+3),a
3219
ld a,b
3220
add hl,hl
3221
adc a,a
3222
add hl,de
3223
adc a,c
3224
startdiv:
3225
ld b,1
3226
call divsub0+3
3227
ld (quot+1),bc
3228
call divsub0
3229
ld (quot),bc
3230
call divsub0
3231
ld (quot-1),bc
3232
add hl,hl
3233
rla
3234
jr c,_11
3235
sbc hl,de
3236
sbc a,c
3237
ccf
3238
_11:
3239
ld hl,(quot)
3240
ld de,(quot+2)
3241
ld bc,0
3242
adc hl,bc
3243
ex de,hl
3244
adc hl,bc
3245
ld b,h
3246
ld c,l
3247
writeback:
3248
pop hl
3249
ld (hl),e
3250
inc hl
3251
ld (hl),d
3252
inc hl
3253
rl c
3254
pop af
3255
rr c
3256
ld (hl),c
3257
inc hl
3258
ld (hl),b
3259
ret
3260
divoverflow:
3261
ld b,$40
3262
jr _12
3263
divunderflow:
3264
ld b,0
3265
jr _12
3266
setmantissa0:
3267
ld bc,(quot+2)
3268
_12:
3269
ld de,0
3270
ld c,e
3271
jr writeback
3272
divsub0:
3273
;;882cc max
3274
call divsub1 ;34 or 66
3275
call divsub1 ;
3276
call divsub1
3277
call divsub1
3278
call divsub1
3279
call divsub1
3280
call divsub1
3281
call divsub1
3282
or a
3283
sbc hl,de
3284
sbc a,c
3285
inc b
3286
ret nc
3287
dec b
3288
add hl,de
3289
adc a,c
3290
ret
3291
divsub1:
3292
;34cc or 66cc or 93cc
3293
sla b
3294
add hl,hl
3295
rla
3296
ret nc
3297
or a
3298
inc b
3299
sbc hl,de
3300
sbc a,c
3301
ret c
3302
inc b
3303
sbc hl,de
3304
sbc a,c
3305
ret
3306
3307
;---------------------------------------------------------------------------------------------------------
3308
; powSingle
3309
; https://www.geeksforgeeks.org/write-a-c-program-to-calculate-powxn/
3310
; https://stackoverflow.com/questions/3518973/floating-point-exponentiation-without-power-function
3311
;---------------------------------------------------------------------------------------------------------
3312
;double mypow( double base, double power, double precision )
3313
;{
3314
; if ( power < 0 ) return 1 / mypow( base, -power, precision );
3315
; else if ( power >= 1 ) return base * mypow( base, power-1, precision );
3316
; else if ( precision >= 1 ) {
3317
; if( base >= 0 ) return sqrt( base );
3318
; else return sqrt( -base );
3319
; } else return sqrt( mypow( base, power*2, precision*2 ) );
3320
;}
3321
3322
if defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN
3323
3324
powSingle:
3325
;;Computes y^x
3326
;;HL points to y
3327
;;DE points to x
3328
;;BC points to output
3329
call pushpop
3330
push bc
3331
push de
3332
ld bc, var_y ; power
3333
call copySingle
3334
pop hl
3335
ld bc, var_x ; base
3336
call copySingle
3337
ld hl, const_precision
3338
ld bc, var_a ; precision
3339
call copySingle
3340
ld hl, const_0
3341
ld bc, var_z ; result
3342
call copySingle
3343
call powSingle.loop
3344
pop bc
3345
ld hl, var_z
3346
call copySingle
3347
ret
3348
3349
powSingle.loop:
3350
; if ( power < 0 ) return 1 / mypow( base, -power, precision );
3351
ld hl, var_y
3352
ld de, const_0
3353
call cmpSingle
3354
jp c, powSingle.1
3355
3356
; else if ( power >= 1 ) return base * mypow( base, power-1, precision );
3357
ld hl, var_y
3358
ld de, const_1
3359
call cmpSingle
3360
jp nc, powSingle.2
3361
3362
; else if ( precision >= 1 ) {
3363
; if( base >= 0 ) return sqrt( base );
3364
; else return sqrt( -base );
3365
ld hl, var_a
3366
ld de, const_1
3367
call cmpSingle
3368
jp nc, powSingle.3
3369
3370
; } else return sqrt( mypow( base, power*2, precision*2 ) );
3371
ld hl, var_y
3372
ld de, const_2
3373
ld bc, var_b
3374
call mulSingle
3375
ld hl, var_b
3376
ld bc, var_y
3377
call copySingle
3378
ld hl, var_a
3379
ld de, const_2
3380
ld bc, var_b
3381
call mulSingle
3382
ld hl, var_b
3383
ld bc, var_a
3384
call copySingle
3385
call powSingle.loop
3386
ld hl, var_z
3387
ld bc, var_b
3388
call sqrtSingle
3389
ld hl, var_b
3390
ld bc, var_z
3391
call copySingle
3392
ret
3393
3394
powSingle.1:
3395
; return 1 / mypow( base, -power, precision );
3396
ld hl, const_0
3397
ld de, var_y
3398
ld bc, var_b
3399
call subSingle
3400
ld hl, var_b
3401
ld bc, var_y
3402
call copySingle
3403
call powSingle.loop
3404
ld hl, const_1
3405
ld de, var_z
3406
ld bc, var_b
3407
call divSingle
3408
ld hl, var_b
3409
ld bc, var_z
3410
call copySingle
3411
ret
3412
3413
powSingle.2:
3414
; return base * mypow( base, power-1, precision );
3415
ld hl, var_y
3416
ld de, const_1
3417
ld bc, var_b
3418
call subSingle
3419
ld hl, var_b
3420
ld bc, var_y
3421
call copySingle
3422
call powSingle.loop
3423
ld hl, var_z
3424
ld de, var_x
3425
ld bc, var_b
3426
call mulSingle
3427
ld hl, var_b
3428
ld bc, var_z
3429
call copySingle
3430
ret
3431
3432
powSingle.3:
3433
; if( base >= 0 ) return sqrt( base );
3434
; else return sqrt( -base );
3435
ld hl, var_x
3436
ld de, const_0
3437
call cmpSingle
3438
jp nc, powSingle.1
3439
;ld hl, var_x
3440
ld bc, var_b
3441
call negSingle
3442
ld hl, var_b
3443
;ld bc, var_z
3444
;call sqrtSingle
3445
;ret
3446
3447
powSingle.3.1:
3448
;ld hl, var_x
3449
ld bc, var_z
3450
call sqrtSingle
3451
ret
3452
3453
pow2Single:
3454
;;Computes 2^x
3455
call pushpop
3456
push bc
3457
3458
exp_inject:
3459
;if x is on [0,1):
3460
; 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)))))
3461
;Please note that usually I like to reduce to [-.5,.5] as the extra overhead is usually worth it.
3462
;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.
3463
;
3464
;int(x) -> out_exp
3465
;x-=int(x) ;leaves x in [0,1)
3466
;;If x==0 -> out==1
3467
;;if x==inf -> out==inf
3468
;;if x==-inf -> out==0
3469
;;if x==NAN -> out==NAN
3470
ld de,var48+10
3471
call mov4
3472
ld hl,(var48+10)
3473
ld de,(var48+12)
3474
ld a,e
3475
add a,a
3476
push af ;keep track of sign
3477
rrca
3478
ld (var48+12),a
3479
ld c,a
3480
ld a,d
3481
or a
3482
jp z,exp_spec
3483
cp 80h-23
3484
jp c,exp_underflow
3485
sub 128 ; sub a,128
3486
jr c,_pow_1 ;int(x)=0
3487
inc a
3488
cp 7
3489
jp nc,exp_overflow
3490
set 7,c
3491
ld b,a
3492
xor a
3493
add hl,hl
3494
rl c
3495
rla
3496
djnz $-4
3497
ld b,7Fh
3498
bit 7,c
3499
jr nz,exp_normalized
3500
ld e,a
3501
ld a,h
3502
or l
3503
or c
3504
ld a,e
3505
jr z,exp_zeroed
3506
dec b
3507
add hl,hl
3508
rl c
3509
jp p,$-4
3510
jr exp_normalized ;.db $11 ;start of `ld de,**`
3511
exp_zeroed:
3512
ld b,0
3513
exp_normalized:
3514
ld (var48+10),hl
3515
res 7,c
3516
ld (var48+12),bc
3517
jr comp_exp ;.db $06 ;start of 'ld b,*` just to eat the next byte
3518
_pow_1:
3519
xor a
3520
comp_exp:
3521
pop hl
3522
rr l
3523
jr nc,_pow_2
3524
cpl
3525
or a
3526
jp z,exp_underflow+1
3527
;perform 1-(var48+10)--> var48+10
3528
ld hl,const_1
3529
ld de,var48+10
3530
ld b,d
3531
ld c,e
3532
call subSingle
3533
_pow_2:
3534
push af
3535
;our 'x' is at var48+10
3536
;our `temp` is at var48+6 so as not to cause issues with mulSingle)
3537
;uses 14 bytes of RAM
3538
ld hl,var48+10
3539
ld de,exp_a6
3540
ld bc,var48+6
3541
call mulSingle
3542
ld d,b
3543
ld e,c
3544
ld hl,exp_a5
3545
call addSingle
3546
ld hl,var48+10
3547
call mulSingle
3548
ld hl,exp_a4
3549
call addSingle
3550
ld hl,var48+10
3551
call mulSingle
3552
ld hl,exp_a3
3553
call addSingle
3554
ld hl,var48+10
3555
call mulSingle
3556
ld hl,exp_a2
3557
call addSingle
3558
ld hl,var48+10
3559
call mulSingle
3560
ld hl,exp_a1
3561
call addSingle
3562
ld hl,var48+10
3563
call mulSingle
3564
ld hl,const_1
3565
call addSingle
3566
ld hl,var48+9
3567
pop af
3568
add a,(hl)
3569
ld (hl),a
3570
ex de,hl
3571
pop de
3572
jp mov4
3573
exp_spec:
3574
;bit 6 means INF
3575
;bit 5 means NAN
3576
;no bits means zero
3577
;NAN -> NAN
3578
;+inf -> +inf
3579
;-inf -> +0 because lim approaches 0 from the right
3580
ld a,c
3581
add a,a
3582
jr z,exp_zero
3583
jp m,exp_inf
3584
;exp_NAN
3585
pop af
3586
ld de,0040h
3587
exp_return_spec:
3588
pop hl
3589
rr e
3590
ld (hl),a
3591
inc hl
3592
ld (hl),a
3593
inc hl
3594
ld (hl),e
3595
inc hl
3596
ld (hl),d
3597
ret
3598
exp_overflow:
3599
exp_inf:
3600
;+inf -> +inf
3601
;-inf -> +0 because lim approaches 0 from the right
3602
pop af
3603
sbc a,a ;FF if should be 0,
3604
cpl
3605
and 80h
3606
ld d,0
3607
ld e,a
3608
jr exp_return_spec
3609
exp_underflow:
3610
exp_zero:
3611
pop af
3612
or a
3613
ld de,$8000
3614
jr exp_return_spec
3615
3616
endif
3617
3618
;---------------------------------------------------------------------------------------------------------
3619
; sqrtSingle
3620
;---------------------------------------------------------------------------------------------------------
3621
3622
if defined MATH_SQR or defined MATH_EXP
3623
3624
;Uses 3 bytes at scrap
3625
sqrtSingle:
3626
;552+{0,19}+8{0,3+{0,3}}+pushpop+sqrtHLIX
3627
;min: 1784
3628
;max: 1987
3629
;avg: 1872
3630
call pushpop
3631
push bc
3632
ld c,(hl)
3633
inc hl
3634
ld e,(hl)
3635
inc hl
3636
ld a,(hl)
3637
add a,a
3638
jp c,sqrtSingle_NaN
3639
scf
3640
rra
3641
ld d,a
3642
inc hl
3643
ld a,(hl)
3644
or a
3645
jp z,sqrtSingle_special
3646
add a,80h
3647
rra
3648
push af ;new exponent
3649
jr c,_13
3650
srl d
3651
rr e
3652
rr c
3653
_13:
3654
ex de,hl
3655
ld ixh,c
3656
ld ixl,0
3657
call sqrtHLIX
3658
;AHL is the new remainder
3659
;Need to divide by 2, then divide by the 16-bit (var_x+4)
3660
rra
3661
ld a,h
3662
;HL/DE to 8 bits
3663
;We are just going to approximate it
3664
res 0,l
3665
jr c,$+5
3666
cp d
3667
jr c,$+4
3668
sub d
3669
inc l
3670
sla l
3671
rla
3672
jr c,$+5
3673
cp d
3674
jr c,$+4
3675
sub d
3676
inc l
3677
sla l
3678
rla
3679
jr c,$+5
3680
cp d
3681
jr c,$+4
3682
sub d
3683
inc l
3684
sla l
3685
rla
3686
jr c,$+5
3687
cp d
3688
jr c,$+4
3689
sub d
3690
inc l
3691
sla l
3692
rla
3693
jr c,$+5
3694
cp d
3695
jr c,$+4
3696
sub d
3697
inc l
3698
sla l
3699
rla
3700
jr c,$+5
3701
cp d
3702
jr c,$+4
3703
sub d
3704
inc l
3705
sla l
3706
rla
3707
jr c,$+5
3708
cp d
3709
jr c,$+4
3710
sub d
3711
inc l
3712
sla l
3713
rla
3714
jr c,$+5
3715
cp d
3716
jr c,$+4
3717
sub d
3718
inc l
3719
3720
pop bc
3721
ld a,l
3722
pop hl
3723
;BDEA
3724
ld (hl),a
3725
inc hl
3726
ld (hl),e
3727
inc hl
3728
res 7,d
3729
ld (hl),d
3730
inc hl
3731
ld (hl),b
3732
ret
3733
sqrtSingle_NaN:
3734
ld hl,const_NaN
3735
pop de
3736
jp mov4
3737
sqrtSingle_special:
3738
dec hl
3739
dec hl
3740
pop de
3741
jp mov4
3742
3743
sqrtHLIX:
3744
;Input: HLIX
3745
;Output: DE is the sqrt, AHL is the remainder
3746
;speed: 754+{0,1}+6{0,6}+{0,3+{0,18}}+{0,38}+sqrtHL
3747
;min: 1130
3748
;max: 1266
3749
;avg: 1190.5
3750
3751
3752
call sqrtHL
3753
add a,a
3754
ld e,a
3755
jr nc,_14
3756
inc d
3757
_14:
3758
3759
ld a,ixh
3760
sll e
3761
rl d
3762
add a,a
3763
adc hl,hl
3764
add a,a
3765
adc hl,hl
3766
sbc hl,de
3767
jr nc,_15
3768
add hl,de
3769
dec e
3770
jr _15a ;.db $FE ;start of `cp *`
3771
_15:
3772
inc e
3773
_15a:
3774
sll e
3775
rl d
3776
add a,a
3777
adc hl,hl
3778
add a,a
3779
adc hl,hl
3780
sbc hl,de
3781
jr nc,_16
3782
add hl,de
3783
dec e
3784
jr _16a ;.db $FE ;start of `cp *`
3785
_16:
3786
inc e
3787
_16a:
3788
sll e
3789
rl d
3790
add a,a
3791
adc hl,hl
3792
add a,a
3793
adc hl,hl
3794
sbc hl,de
3795
jr nc,_17
3796
add hl,de
3797
dec e
3798
jr _17a ;.db $FE ;start of `cp *`
3799
_17:
3800
inc e
3801
_17a:
3802
sll e
3803
rl d
3804
add a,a
3805
adc hl,hl
3806
add a,a
3807
adc hl,hl
3808
sbc hl,de
3809
jr nc,_18
3810
add hl,de
3811
dec e
3812
jr _18a ;.db $FE ;start of `cp *`
3813
_18:
3814
inc e
3815
_18a:
3816
;Now we have four more iterations
3817
;The first two are no problem
3818
ld a,ixl
3819
sll e
3820
rl d
3821
add a,a
3822
adc hl,hl
3823
add a,a
3824
adc hl,hl
3825
sbc hl,de
3826
jr nc,_19
3827
add hl,de
3828
dec e
3829
jr _19a ;.db $FE ;start of `cp *`
3830
_19:
3831
inc e
3832
_19a:
3833
sll e
3834
rl d
3835
add a,a
3836
adc hl,hl
3837
add a,a
3838
adc hl,hl
3839
sbc hl,de
3840
jr nc,_20
3841
add hl,de
3842
dec e
3843
jr _20a ;.db $FE ;start of `cp *`
3844
_20:
3845
inc e
3846
_20a:
3847
sqrt32_iter15:
3848
;On the next iteration, HL might temporarily overflow by 1 bit
3849
sll e
3850
rl d ;sla e \ rl d \ inc e
3851
add a,a
3852
adc hl,hl
3853
add a,a
3854
adc hl,hl ;This might overflow!
3855
jr c,sqrt32_iter15_br0
3856
;
3857
sbc hl,de
3858
jr nc,_21
3859
add hl,de
3860
dec e
3861
jr sqrt32_iter16
3862
sqrt32_iter15_br0:
3863
or a
3864
sbc hl,de
3865
_21:
3866
inc e
3867
3868
;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
3869
sqrt32_iter16:
3870
add a,a
3871
ld b,a ;either 0x00 or 0x80
3872
adc hl,hl
3873
rla
3874
adc hl,hl
3875
rla
3876
;AHL - (DE+DE+1)
3877
sbc hl,de
3878
sbc a,b
3879
inc e
3880
or a
3881
sbc hl,de
3882
sbc a,b
3883
ret p
3884
add hl,de
3885
adc a,b
3886
dec e
3887
add hl,de
3888
adc a,b
3889
ret
3890
3891
sqrtHL:
3892
;returns A as the sqrt, HL as the remainder, D = 0
3893
;min: 376cc
3894
;max: 416cc
3895
;avg: 393cc
3896
ld de,$5040
3897
ld a,h
3898
sub e
3899
jr nc,_22
3900
add a,e
3901
ld d,$10
3902
_22:
3903
sub d
3904
jr nc,_23
3905
add a,d
3906
jr _23a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3907
_23:
3908
set 5,d
3909
_23a:
3910
res 4,d
3911
srl d
3912
3913
set 2,d
3914
sub d
3915
jr nc,_24
3916
add a,d
3917
jr _24a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3918
_24:
3919
set 3,d
3920
_24a:
3921
res 2,d
3922
srl d
3923
3924
inc d
3925
sub d
3926
jr nc,_25
3927
add a,d
3928
dec d ;this resets the low bit of D, so `srl d` resets carry.
3929
jr _25a ;.db $06 ;start of ld b,* which is 7cc to skip the next byte.
3930
_25:
3931
inc d
3932
_25a:
3933
srl d
3934
ld h,a
3935
3936
3937
sbc hl,de
3938
ld a,e
3939
jr nc,_26
3940
add hl,de
3941
_26:
3942
ccf
3943
rra
3944
srl d
3945
rra
3946
ld e,a
3947
3948
sbc hl,de
3949
jr nc,_27
3950
add hl,de
3951
jr _27a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3952
_27:
3953
or %00100000
3954
_27a:
3955
xor %00011000
3956
srl d
3957
rra
3958
ld e,a
3959
3960
3961
sbc hl,de
3962
jr nc,_28
3963
add hl,de
3964
jr _28a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.
3965
_28:
3966
or %00001000
3967
_28a:
3968
xor %00000110
3969
srl d
3970
rra
3971
ld e,a
3972
sbc hl,de
3973
jr nc,_29
3974
add hl,de
3975
srl d
3976
rra
3977
ret
3978
_29:
3979
inc a
3980
srl d
3981
rra
3982
ret
3983
3984
endif
3985
3986
;---------------------------------------------------------------------------------------------------------
3987
; lnSingle
3988
;---------------------------------------------------------------------------------------------------------
3989
3990
if defined MATH_LOG or defined MATH_LN
3991
3992
lnSingle:
3993
; x / (1 + x/(2-x+4x/(3-2x+9x/(4-3x+16x/(5-4x)))))
3994
; a * x ^ (1/a) - a, where a = 100
3995
call pushpop
3996
push bc
3997
ld de, const_100_inv
3998
ld bc, temp
3999
call powSingle ; temp = x ^ (1/100)
4000
ld hl, temp
4001
ld de, const_100
4002
ld bc, temp1
4003
call mulSingle ; temp1 = temp * 100
4004
ld hl, temp1
4005
pop bc
4006
call subSingle ; bc = temp1 - 100
4007
ret
4008
4009
endif
4010
4011
;---------------------------------------------------------------------------------------------------------
4012
; logSingle
4013
;---------------------------------------------------------------------------------------------------------
4014
4015
if defined MATH_LOG
4016
4017
logSingle:
4018
call pushpop
4019
push bc
4020
ld bc, temp
4021
call lnSingle
4022
ld hl, temp
4023
ld de, const_lg10
4024
pop bc
4025
call divSingle
4026
ret
4027
4028
endif
4029
4030
;---------------------------------------------------------------------------------------------------------
4031
; expSingle
4032
;---------------------------------------------------------------------------------------------------------
4033
4034
if defined MATH_EXP
4035
4036
expSingle:
4037
;;Computes e^x
4038
;;HL points to x
4039
;;BC points to the output
4040
call pushpop
4041
ld de,const_lg_e
4042
push bc
4043
pow_inject:
4044
;;DE points to lg(y), HL points to x, BC points to output
4045
ld bc,var_x
4046
call mulSingle
4047
ld h,b
4048
ld l,c
4049
jp exp_inject
4050
4051
endif
4052
4053
;---------------------------------------------------------------------------------------------------------
4054
; sinSingle
4055
; https://en.wikipedia.org/wiki/List_of_trigonometric_identities
4056
; https://en.wikipedia.org/wiki/Taylor_series#Trigonometric_functions
4057
; https://cs.stackexchange.com/questions/89245/how-approximate-sine-using-taylor-series
4058
; https://stackoverflow.com/questions/42217069/approximating-sinex-with-a-taylor-series-in-c-and-having-a-lot-of-problems
4059
;---------------------------------------------------------------------------------------------------------
4060
4061
if defined MATH_SIN or defined MATH_TAN or defined MATH_COS
4062
4063
sinSingle:
4064
; taylor: x - x^3/6 + x^5/120 - x^7/5040
4065
; x(1 - x^2(1/6 - x^2(1/120 - x^2/5040)) )
4066
; reduction:
4067
; var_b = round( x / (2*PI), 0 )
4068
; var_c = x - var_b*2*PI
4069
; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )
4070
; temp2 = if( temp1 > PI, temp1 - PI, temp1 )
4071
; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )
4072
4073
call pushpop
4074
ld de, const_0
4075
call cmpSingle
4076
jr nz, sinSingle.1
4077
4078
call copySingle ; return 0
4079
ret
4080
4081
sinSingle.1:
4082
call trigRangeReductionSinCos
4083
push bc
4084
ld hl, var_a
4085
ld de, var_a
4086
ld bc, var_b
4087
call mulSingle ; var_b = var_a * var_a
4088
ld hl, var_b
4089
ld de, sin_a3
4090
ld bc, temp
4091
call mulSingle ; temp = x^2/5040
4092
ld hl, sin_a2
4093
ld de, temp
4094
ld bc, temp1
4095
call subSingle ; temp1 = 1/120 - temp
4096
ld hl, var_b
4097
ld de, temp1
4098
ld bc, temp
4099
call mulSingle ; temp = x^2 * temp1
4100
ld hl, sin_a1
4101
ld de, temp
4102
ld bc, temp1
4103
call subSingle ; temp1 = 1/6 - temp
4104
ld hl, var_b
4105
ld de, temp1
4106
ld bc, temp
4107
call mulSingle ; temp = x^2 * temp1
4108
ld hl, const_1
4109
ld de, temp
4110
ld bc, temp1
4111
call subSingle ; temp1 = 1 - temp
4112
ld hl, var_a
4113
ld de, temp1
4114
pop bc
4115
call mulSingle ; return x * temp1
4116
ret
4117
4118
trigRangeReductionSinCos:
4119
call pushpop
4120
push hl
4121
; var_b = round( x / (2*PI), 0 )
4122
ld de, const_2pi
4123
ld bc, var_c
4124
call divSingle
4125
ld hl, var_c
4126
ld de, 0
4127
ld bc, var_b
4128
call roundSingle
4129
; var_c = x - var_b*2*PI
4130
ld hl, var_b
4131
ld de, const_2pi
4132
ld bc, temp
4133
call mulSingle ; temp = var_b*2*PI
4134
pop hl
4135
ld de, temp
4136
ld bc, var_c
4137
call subSingle ; var_c = x - temp
4138
; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )
4139
ld hl, var_c
4140
ld de, const_0
4141
call cmpSingle
4142
jr nc, trigRangeReductionSinCos.else.2
4143
ld hl, var_c
4144
ld bc, temp1
4145
call copySingle ; temp1 = var_c
4146
jr trigRangeReductionSinCos.endif.2
4147
trigRangeReductionSinCos.else.2:
4148
ld hl, var_c
4149
ld de, const_2pi
4150
ld bc, temp1
4151
call addSingle ; temp1 = var_c + 2*PI
4152
trigRangeReductionSinCos.endif.2:
4153
; temp2 = if( temp1 > PI, temp1 - PI, temp1 )
4154
ld hl, const_pi
4155
ld de, temp1
4156
call cmpSingle
4157
jr c, trigRangeReductionSinCos.else.3
4158
jr z, trigRangeReductionSinCos.else.3
4159
ld hl, temp1
4160
ld de, const_pi
4161
ld bc, temp2
4162
call subSingle ; temp2
4163
jr trigRangeReductionSinCos.endif.3
4164
trigRangeReductionSinCos.else.3:
4165
ld hl, temp1
4166
ld bc, temp2
4167
call copySingle ; temp2 = temp1
4168
trigRangeReductionSinCos.endif.3:
4169
; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )
4170
ld hl, const_half_pi
4171
ld de, temp2
4172
call cmpSingle
4173
jr c, trigRangeReductionSinCos.else.4
4174
jr z, trigRangeReductionSinCos.else.4
4175
ld hl, const_pi
4176
ld de, temp2
4177
ld bc, var_a
4178
call subSingle ; var_a
4179
jr trigRangeReductionSinCos.endif.4
4180
trigRangeReductionSinCos.else.4:
4181
ld hl, temp2
4182
ld bc, var_a
4183
call copySingle ; var_a = temp2
4184
trigRangeReductionSinCos.endif.4:
4185
; if( temp > PI, -1, 1 )
4186
ld hl, temp1
4187
ld de, const_pi
4188
call cmpSingle
4189
jr nc, trigRangeReductionSinCos.endif.5
4190
ld ix, var_a
4191
ld a, (ix+2)
4192
set 7, a
4193
ld (ix+2), a ; turn var_a to negative
4194
trigRangeReductionSinCos.endif.5:
4195
; return var_a
4196
ret
4197
4198
endif
4199
4200
;---------------------------------------------------------------------------------------------------------
4201
; cosSingle
4202
;---------------------------------------------------------------------------------------------------------
4203
4204
if defined MATH_COS or defined MATH_TAN
4205
4206
cosSingle:
4207
; taylor: 1 - x^2/2 + x^4/24 - x^6/720
4208
; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )
4209
; reduction: same as sin
4210
; cos = cos * sign
4211
4212
call pushpop
4213
ld de, const_0
4214
call cmpSingle
4215
jr nz, cosSingle.1
4216
4217
ld hl, const_1
4218
call copySingle ; return 1
4219
ret
4220
4221
cosSingle.1:
4222
; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )
4223
call trigRangeReductionSinCos
4224
push bc
4225
ld hl, var_a
4226
ld de, var_a
4227
ld bc, var_b
4228
call mulSingle ; var_b = var_a * var_a
4229
ld hl, var_b
4230
ld de, cos_a3
4231
ld bc, temp
4232
call mulSingle ; temp = x^2/720
4233
ld hl, cos_a2
4234
ld de, temp
4235
ld bc, temp1
4236
call subSingle ; temp1 = 1/24 - temp
4237
ld hl, var_b
4238
ld de, temp1
4239
ld bc, temp
4240
call mulSingle ; temp = x^2 * temp1
4241
ld hl, cos_a1
4242
ld de, temp
4243
ld bc, temp1
4244
call subSingle ; temp1 = 1/2 - temp
4245
ld hl, var_b
4246
ld de, temp1
4247
ld bc, temp
4248
call mulSingle ; temp = x^2 * temp1
4249
ld hl, const_1
4250
ld de, temp
4251
ld bc, temp1
4252
call subSingle ; temp1 = 1 - temp
4253
4254
; temp3 = abs(var_c)
4255
; temp1 = temp1 * if( temp3 >= PI/2, -1, 1 ) ==> cos sign
4256
ld hl, var_c
4257
ld bc, temp3
4258
call copySingle
4259
ld ix, temp3
4260
ld a, (ix+2)
4261
res 7, a
4262
ld (ix+2), a ; temp3 = abs(var_c)
4263
ld hl, temp3
4264
ld de, const_half_pi
4265
call cmpSingle ; if temp3 >= PI/2 then temp1 = -temp1
4266
jr nc, cosSingle.endif.1
4267
ld ix, temp1
4268
ld a, (ix+2)
4269
set 7, a
4270
ld (ix+2), a ; temp1 = -temp1
4271
cosSingle.endif.1:
4272
pop bc
4273
ld hl, temp1
4274
call copySingle ; return temp1
4275
ret
4276
4277
endif
4278
4279
;---------------------------------------------------------------------------------------------------------
4280
; tanSingle
4281
;---------------------------------------------------------------------------------------------------------
4282
4283
if defined MATH_TAN
4284
4285
tanSingle:
4286
call pushpop
4287
push bc
4288
;HL points to input
4289
ld bc,var_z
4290
ld d,b
4291
ld e,c
4292
call cosSingle
4293
ld bc,var_x
4294
call sinSingle
4295
ld h,b
4296
ld l,c
4297
pop bc
4298
jp divSingle
4299
4300
endif
4301
4302
;---------------------------------------------------------------------------------------------------------
4303
; atanSingle
4304
;---------------------------------------------------------------------------------------------------------
4305
4306
if defined MATH_ATN
4307
4308
atanSingle:
4309
;taylor: x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )
4310
; x < -1: atan - PI/2
4311
; x >= 1: PI/2 - atan
4312
;reduction: abs(X) > 1 : Y = 1 / X
4313
; abs(X) <= 1: Y = X
4314
; X < 0: Y = -Y
4315
4316
call pushpop
4317
ld de, const_0
4318
call cmpSingle
4319
jr nz, atanSingle.1
4320
4321
ld hl, const_0
4322
call copySingle ; return 0
4323
ret
4324
4325
atanSingle.1:
4326
;x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )
4327
call trigRangeReductionAtan
4328
push bc
4329
push hl
4330
ld hl, var_a
4331
ld de, var_a
4332
ld bc, var_b
4333
call mulSingle ; var_b = var_a * var_a
4334
ld hl, var_b
4335
ld de, const_16
4336
ld bc, temp
4337
call mulSingle ; temp = (4*x)^2
4338
ld hl, temp
4339
ld de, const_9
4340
ld bc, temp1
4341
call divSingle ; temp1 = temp/9
4342
ld hl, temp1
4343
ld de, const_7
4344
ld bc, temp
4345
call addSingle ; temp = 7 + temp1
4346
ld hl, var_b
4347
ld de, const_9
4348
ld bc, temp1
4349
call mulSingle ; temp1 = var_b * 9
4350
ld hl, temp1
4351
ld de, temp
4352
ld bc, temp2
4353
call divSingle ; temp2 = temp1 / temp
4354
ld hl, temp2
4355
ld de, const_5
4356
ld bc, temp
4357
call addSingle ; temp = 5 + temp2
4358
ld hl, var_b
4359
ld de, const_4
4360
ld bc, temp1
4361
call mulSingle ; temp1 = var_b * 4
4362
ld hl, temp1
4363
ld de, temp
4364
ld bc, temp2
4365
call divSingle ; temp2 = temp1 / temp
4366
ld hl, temp2
4367
ld de, const_3
4368
ld bc, temp
4369
call addSingle ; temp = 3 + temp2
4370
ld hl, var_b
4371
ld de, temp
4372
ld bc, temp2
4373
call divSingle ; temp2 = var_b / temp
4374
ld hl, temp2
4375
ld de, const_1
4376
ld bc, temp
4377
call addSingle ; temp = 1 + temp2
4378
ld hl, var_a
4379
ld de, temp
4380
ld bc, temp2
4381
call divSingle ; temp2 = var_a / temp
4382
pop hl
4383
; x >= 1: PI/2 - atan
4384
ld de, const_1
4385
call cmpSingle
4386
jr nc, atanSingle.2
4387
ld hl, const_half_pi
4388
ld de, temp2
4389
ld bc, temp
4390
call subSingle
4391
ld hl, temp
4392
jr atanSingle.4
4393
atanSingle.2:
4394
; x < -1: atan - PI/2
4395
push hl
4396
ld hl, const_0
4397
ld de, const_1
4398
ld bc, temp
4399
call subSingle
4400
pop hl
4401
ld de, temp
4402
call cmpSingle
4403
jr c, atanSingle.3
4404
ld hl, temp2
4405
ld de, const_half_pi
4406
ld bc, temp
4407
call subSingle
4408
ld hl, temp
4409
jr atanSingle.4
4410
atanSingle.3:
4411
ld hl, temp2
4412
atanSingle.4:
4413
pop bc
4414
call copySingle ; return temp2
4415
ret
4416
4417
trigRangeReductionAtan:
4418
;reduction: abs(X) > 1 : Y = 1 / X
4419
; abs(X) <= 1: Y = X
4420
; X < 0: Y = -Y
4421
call pushpop
4422
push hl
4423
ld bc, temp
4424
call copySingle
4425
ld ix, temp
4426
ld a, (ix+2)
4427
res 7, a
4428
ld (ix+2), a ; abs(x)
4429
ld hl, temp
4430
ld de, const_1
4431
call cmpSingle
4432
jr nc, trigRangeReductionAtan.1
4433
ld hl, const_1
4434
pop de
4435
push de
4436
ld bc, var_a
4437
call divSingle
4438
jr trigRangeReductionAtan.2
4439
trigRangeReductionAtan.1:
4440
pop hl
4441
push hl
4442
ld bc, var_a
4443
call copySingle
4444
trigRangeReductionAtan.2:
4445
pop hl
4446
ld de, const_0
4447
call cmpSingle
4448
jr c, trigRangeReductionAtan.3
4449
ld ix, var_a
4450
ld a, (ix+2)
4451
set 7, a
4452
ld (ix+2), a ; y = -y
4453
trigRangeReductionAtan.3:
4454
ret
4455
4456
endif
4457
4458
if defined MATH_SIN or defined MATH_TAN or defined MATH_COS
4459
4460
;---------------------------------------------------------------------------------------------------------
4461
; copySingle
4462
;---------------------------------------------------------------------------------------------------------
4463
4464
copySingle:
4465
call pushpop
4466
;push bc
4467
;pop de
4468
ld d, b
4469
ld e, c
4470
ldi
4471
ldi
4472
ldi
4473
ldi
4474
ret
4475
4476
;---------------------------------------------------------------------------------------------------------
4477
; roundSingle
4478
;---------------------------------------------------------------------------------------------------------
4479
4480
roundSingle:
4481
call pushpop
4482
call copySingle
4483
;push bc
4484
;pop hl
4485
ld h, b
4486
ld l, c
4487
push de
4488
ld a, e
4489
ld de, const_10
4490
roundSingle.1:
4491
or 0
4492
jr z, roundSingle.2
4493
ld bc, temp
4494
call mulSingle
4495
;push hl
4496
;pop bc
4497
ld b, h
4498
ld c, l
4499
ld hl, temp
4500
call copySingle
4501
;push bc
4502
;pop hl
4503
ld h, b
4504
ld l, c
4505
dec a
4506
jr roundSingle.1
4507
roundSingle.2:
4508
ld de, const_half_1
4509
ld bc, temp
4510
call addSingle
4511
push hl
4512
ld hl, temp
4513
ld bc, temp1
4514
call single2Int
4515
ld hl, temp1
4516
pop bc
4517
call int2Single
4518
;push bc
4519
;pop hl
4520
ld h, b
4521
ld l, c
4522
pop de
4523
ld a, e
4524
ld de, const_10
4525
roundSingle.3:
4526
or 0
4527
jr z, roundSingle.4
4528
ld bc, temp
4529
call divSingle
4530
;push hl
4531
;pop bc
4532
ld b, h
4533
ld c, l
4534
ld hl, temp
4535
call copySingle
4536
;push bc
4537
;pop hl
4538
ld h, b
4539
ld l, c
4540
dec a
4541
jr roundSingle.3
4542
roundSingle.4:
4543
ret
4544
4545
endif
4546
4547
if defined MATH_ABSFN
4548
4549
;---------------------------------------------------------------------------------------------------------
4550
; absSingle
4551
;---------------------------------------------------------------------------------------------------------
4552
4553
absSingle:
4554
;;HL points to the float
4555
;;BC points to where to output the result
4556
call pushpop
4557
ld d,b
4558
ld e,c
4559
ldi
4560
ldi
4561
ld a,(hl)
4562
and %01111111
4563
ld (de),a
4564
inc hl
4565
inc de
4566
ld a,(hl)
4567
ld (de),a
4568
ret
4569
4570
endif
4571
4572
if defined MATH_SGN
4573
4574
;---------------------------------------------------------------------------------------------------------
4575
; sgnSingle
4576
;---------------------------------------------------------------------------------------------------------
4577
4578
sgnSingle:
4579
;;HL points to the float
4580
;;BC points to where to output the result
4581
jp negSingle
4582
4583
endif
4584
4585
if defined powSingle or defined sgnSingle or defined MATH_NEG
4586
4587
;---------------------------------------------------------------------------------------------------------
4588
; negSingle
4589
;---------------------------------------------------------------------------------------------------------
4590
4591
negSingle:
4592
;;HL points to the float
4593
;;BC points to where to output the result
4594
call pushpop
4595
push hl
4596
pop ix
4597
ld a, (ix+3)
4598
or 0
4599
jr nz, negSingle.test.sign
4600
ld a, (ix+2)
4601
or 0
4602
jr nz, negSingle.test.sign
4603
ld a, (ix+1)
4604
or 0
4605
jr nz, negSingle.test.sign
4606
ld a, (ix)
4607
or 0
4608
jr nz, negSingle.test.sign
4609
;push bc
4610
;pop de
4611
ld d, b
4612
ld e, c
4613
ld hl, const_0
4614
ldi
4615
ldi
4616
ldi
4617
ldi
4618
ret
4619
negSingle.test.sign:
4620
ld a, (ix+2)
4621
bit 7, a
4622
jr z, negSingle.positive
4623
negSingle.negative:
4624
push bc
4625
pop ix
4626
call negSingle.positive
4627
ld a, (ix+2)
4628
set 7, a
4629
ld (ix+2), a
4630
ret
4631
negSingle.positive:
4632
;push bc
4633
;pop de
4634
ld d, b
4635
ld e, c
4636
ld hl, const_1
4637
ldi
4638
ldi
4639
ldi
4640
ldi
4641
ret
4642
4643
endif
4644
4645
if defined MATH_DCOMP or defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN or defined MATH_SIN or defined MATH_TAN or defined MATH_COS or defined MATH_ATN
4646
4647
;---------------------------------------------------------------------------------------------------------
4648
; cmpSingle
4649
;---------------------------------------------------------------------------------------------------------
4650
4651
cmpSingle:
4652
;Input: HL points to float1, DE points to float2
4653
;Output:
4654
; float1 >= float2 : nc
4655
; float1 < float2 : c,nz
4656
; float1 == float2 : z
4657
; There is a margin of error allowed in the lower 2 bits of the mantissa.
4658
;
4659
;Currently fails when both numbers have magnitude less than about 2^-106
4660
push hl
4661
push de
4662
push bc
4663
ld c, a
4664
push bc
4665
ex de, hl
4666
call _30
4667
pop bc
4668
ld a, c
4669
pop bc
4670
pop de
4671
pop hl
4672
ret
4673
_30:
4674
inc de
4675
inc de
4676
inc de
4677
ld a,(de)
4678
inc hl
4679
inc hl
4680
inc hl
4681
cp (hl)
4682
jr nc,_31
4683
ld a,(hl)
4684
_31:
4685
dec hl
4686
dec hl
4687
dec hl
4688
dec de
4689
dec de
4690
dec de
4691
push af
4692
ld bc,scrap
4693
call subSingle
4694
ld a,(scrap+3) ;new power
4695
pop bc ;B is old power
4696
or a
4697
jr z,cmp_close
4698
sub b
4699
jr nc,cmp_is_sign
4700
dec a
4701
add a,22
4702
jr nc,cmp_close
4703
cmp_is_sign:
4704
ld a,(scrap+2)
4705
or 1 ;not equal, so reset z flag
4706
rla ;if negative, float1<float2, setting c flag as wanted, else nc.
4707
ret
4708
cmp_close:
4709
xor a
4710
ret
4711
4712
endif
4713
4714
if defined MATH_RND
4715
4716
;---------------------------------------------------------------------------------------------------------
4717
; randSingle
4718
;---------------------------------------------------------------------------------------------------------
4719
4720
randSingle:
4721
;Stores a pseudo-random number on [0,1)
4722
;it won't produce values on (0,2^-23)
4723
call pushpop
4724
push bc
4725
call rand
4726
push hl
4727
call rand
4728
pop de
4729
ex de,hl
4730
ld bc,$207F
4731
;DEHL is the mantissa, B is the exponent
4732
ld a,d
4733
or a
4734
jp m,rand_normed
4735
_32:
4736
dec c
4737
add hl,hl
4738
rl e
4739
rl d
4740
jp m,rand_normed
4741
djnz _32
4742
rand_zero:
4743
ld c,l
4744
ld b,l
4745
jr rand_done
4746
rand_normed:
4747
;If we needed to shift more than 8 bits, we'll load in more random data
4748
ld a,b
4749
cp 8
4750
jr c,rand_zero
4751
sub 24
4752
jp nc,rand_no_more_rand_data
4753
push bc
4754
push de
4755
call rand
4756
pop de
4757
ld e,h
4758
ld h,l
4759
pop bc
4760
rand_no_more_rand_data:
4761
ld b,e
4762
ld e,d
4763
ld d,c
4764
ld c,h
4765
res 7,e
4766
rand_done:
4767
pop hl
4768
;DEBC
4769
ld (hl),b
4770
inc hl
4771
ld (hl),c
4772
inc hl
4773
ld (hl),e
4774
inc hl
4775
ld (hl),d
4776
ret
4777
4778
rand:
4779
;;Tested and passes all CAcert tests
4780
;;Uses a very simple 32-bit LCG and 32-bit LFSR
4781
;;it has a period of 18,446,744,069,414,584,320
4782
;;roughly 18.4 quintillion.
4783
;;LFSR taps: 0,2,6,7 = 11000101
4784
;;323cc
4785
;;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.
4786
;Uses 64 bits of state
4787
ld hl,(seed0)
4788
ld de,(seed0+2)
4789
ld b,h
4790
ld c,l
4791
add hl,hl
4792
rl e
4793
rl d
4794
add hl,hl
4795
rl e
4796
rl d
4797
inc l
4798
add hl,bc
4799
ld (seed0),hl
4800
ld hl,(seed0+2)
4801
adc hl,de
4802
ld (seed0+2),hl
4803
ex de,hl
4804
;;lfsr
4805
ld hl,(seed1)
4806
ld bc,(seed1+2)
4807
add hl,hl
4808
rl c
4809
rl b
4810
ld (seed1+2),bc
4811
sbc a,a
4812
and %11000101
4813
xor l
4814
ld l,a
4815
ld (seed1),hl
4816
ex de,hl
4817
add hl,bc
4818
ret
4819
4820
endif
4821
4822
if defined MATH_FOUT
4823
4824
;---------------------------------------------------------------------------------------------------------
4825
; single2Str
4826
; in HL = Single address
4827
; BC = String address
4828
; out A = String size
4829
; http://0x80.pl/notesen/2015-12-29-float-to-string.html
4830
; http://0x80.pl/articles/convert-float-to-integer.html
4831
;---------------------------------------------------------------------------------------------------------
4832
4833
single2str:
4834
call pushpop
4835
push bc
4836
call _33
4837
pop de
4838
xor a
4839
cp (hl)
4840
ldi
4841
jr nz,$-3
4842
4843
ret
4844
_33:
4845
; Move the float to scrap
4846
ld de,scrap
4847
call mov4
4848
4849
; Make the float negative, write a '-' if already negative
4850
ld de,strout_single
4851
ld hl,scrap+2
4852
ld a,(hl)
4853
;rlca
4854
;scf
4855
;rra
4856
bit 7, a
4857
jr z, _34
4858
ld a,'-' ; write '-' simbol
4859
ld (de),a
4860
inc de
4861
ld a,(hl)
4862
_34:
4863
set 7, a
4864
ld (hl),a
4865
4866
; Check if the exponent field is 0 (a special value)
4867
inc hl
4868
ld a,(hl)
4869
or a
4870
jp z,strcase_single
4871
4872
4873
; We should write '0' next. When rounding 9.999999... for example, not padding with a 0 will return '.' instead of '1.'
4874
ex de,hl
4875
ld (hl),'0'
4876
inc hl
4877
4878
; Save the pointer
4879
push hl
4880
4881
; Now we need to perform signed (A-128)*77 (approximation of exponent*log10(2))
4882
ld de,77
4883
ld h,a
4884
ld l,d
4885
call mul8_preset
4886
ld de,-77*128
4887
add hl,de
4888
ld a,h
4889
ld (pow10exp_single),a ;The base-10 exponent
4890
ld de,pown10LUT
4891
jr c,_35
4892
neg
4893
ld de,pow10LUT ;get the table of 10^-(2^k)
4894
_35:
4895
ld hl, pow10exp_single
4896
ld bc,scrap
4897
call singletostr_mul
4898
call singletostr_mul
4899
call singletostr_mul
4900
call singletostr_mul
4901
call singletostr_mul
4902
call singletostr_mul
4903
;now the number is pretty close to a nice value
4904
4905
; If it is less than 1, multiply by 10
4906
ld a,(scrap+3)
4907
sub 128
4908
jr nc,_36
4909
ld de,const_10
4910
;ld hl,scrap ;Since singletostr_mul returns BC = scrap, can do this cheaper
4911
;ld b,h
4912
;ld c,l
4913
ld h,b
4914
ld l,c
4915
call mulSingle
4916
ld hl,pow10exp_single
4917
dec (hl)
4918
ld a,(scrap+3)
4919
sub 128
4920
_36:
4921
4922
; Convert to a fixed-point number !
4923
inc a
4924
ld b,a
4925
xor a
4926
_37:
4927
ld hl,scrap
4928
sla (hl)
4929
inc hl
4930
rl (hl)
4931
inc hl
4932
rl (hl)
4933
rla
4934
djnz _37
4935
4936
;We need to get 7 digits
4937
ld b,6
4938
pop hl ;Points to the string
4939
4940
;The first digit can be as large as 20, so it'll actually be two digits
4941
cp 10
4942
jr c,_38
4943
dec b
4944
;Increment the exponent :)
4945
ld de,(pow10exp_single-1)
4946
inc d
4947
ld (pow10exp_single-1),de
4948
;
4949
ld (hl),'0'-1
4950
inc (hl)
4951
sub 10
4952
jr nc,$-3
4953
add a,10
4954
inc hl
4955
_38:
4956
; Get the remaining digits.
4957
_39:
4958
add a,'0'
4959
ld (hl),a
4960
inc hl
4961
push hl
4962
push bc
4963
call singletostrmul10
4964
pop bc
4965
pop hl
4966
djnz _39
4967
4968
;Save the pointer to the end of the string
4969
ld d,h
4970
ld e,l
4971
;ld (hl), 0
4972
4973
;Now let's round!
4974
cp 5
4975
jr c,rounding_done_single
4976
jr _40a ;.db $DA ;start of `jp c,*` in order to skip the next instruction
4977
_40:
4978
ld (hl),'0'
4979
_40a:
4980
dec hl
4981
inc (hl)
4982
ld a,(hl)
4983
cp $3A
4984
jr z,_40
4985
rounding_done_single:
4986
4987
4988
;Strip the leading zero if it exists (rounding may have bumped this to `1`)
4989
ld hl,strout_single
4990
ld a,(hl)
4991
cp '-'
4992
jr nz,_41
4993
inc hl
4994
ld a,(hl)
4995
_41:
4996
cp '0'
4997
jr nz,_42
4998
dec de
4999
ex de,hl
5000
;Now lets move HL-DE bytes at DE+1 to DE
5001
sbc hl,de
5002
ld b,h
5003
ld c,l
5004
ld h,d
5005
ld l,e
5006
inc hl
5007
ldir
5008
cp a
5009
_42:
5010
5011
push de
5012
;If z flag is reset, this means that the exponent should be bumped up 1
5013
ld a,(pow10exp_single)
5014
jr z,_43
5015
inc a
5016
ld (pow10exp_single),a
5017
_43:
5018
5019
;if -4<=A<=6, then need to insert the decimal place somewhere.
5020
add a,4
5021
cp 10
5022
jp c,movdec_single
5023
_44:
5024
;for this, we need to insert the decimal after the first digit
5025
;Then, we need to append the exponent string
5026
ld hl,strout_single
5027
ld de,strout_single-1
5028
ld a,(hl)
5029
cp '-' ;negative sign
5030
jr nz,_45
5031
ldi
5032
_45:
5033
ldi
5034
ld a,'.'
5035
ld (de),a
5036
5037
;remove any stray zeroes at the end before appending the exponent
5038
pop hl
5039
call strip_zeroes
5040
5041
; Write the exponent
5042
ld (hl),'e'
5043
inc hl
5044
ld a,(pow10exp_single)
5045
or a
5046
jp p,_46
5047
ld (hl),'-' ;negative sign
5048
inc hl
5049
neg
5050
_46:
5051
cp 10
5052
jr c,_47
5053
ld (hl),'0'-1
5054
inc (hl)
5055
sub 10
5056
jr nc,$-3
5057
add a,10
5058
inc hl
5059
_47:
5060
add a,'0'
5061
ld (hl),a
5062
inc hl
5063
ld (hl),0
5064
5065
ld de, strout_single
5066
xor a
5067
sbc hl, de
5068
ld a, l ; string size
5069
5070
ld hl,strout_single-1
5071
ret
5072
5073
movdec_single:
5074
ld a,(pow10exp_single)
5075
or a
5076
jp p,posdec_single
5077
ld l,a
5078
;need to put zeroes before everything
5079
ld de,strout_single
5080
ld a,(de)
5081
cp '-' ;negative sign
5082
push af
5083
ld a,'0'
5084
jr z,$+3
5085
_48:
5086
dec de
5087
ld (de),a
5088
inc l
5089
jr nz,_48
5090
_49:
5091
ex de,hl
5092
ld (hl),'.'
5093
pop af
5094
jr nz,_50
5095
dec hl
5096
ld (hl),a
5097
_50:
5098
ex de,hl
5099
pop hl
5100
call strip_zeroes
5101
ld (hl),0
5102
ex de,hl
5103
ret
5104
5105
posdec_single:
5106
ld hl,strout_single
5107
ld de,strout_single-1
5108
ld c,a
5109
ld a,(hl)
5110
ld b,0
5111
cp '-' ;negative sign
5112
jr nz,_51
5113
inc c
5114
_51:
5115
inc c
5116
ldir
5117
ld a,'.'
5118
ld (de),a
5119
pop hl
5120
call strip_zeroes
5121
ld (hl),0
5122
ld hl,strout_single-1
5123
ret
5124
5125
strcase_single:
5126
ld hl,str_Zero
5127
ld a,(scrap+2)
5128
add a,a
5129
and $C0
5130
jr z,_52
5131
ld hl,str_Inf
5132
jp pe,_52
5133
ld hl,str_NaN
5134
_52:
5135
call mov4
5136
ld hl,strout_single
5137
ret
5138
5139
singletostrmul10:
5140
;multiply the 0.24 fixed point number at scrap by 10
5141
;overflow in A register
5142
ld a,(scrap+2)
5143
ld e,a
5144
ld hl,(scrap)
5145
xor a
5146
ld d,e
5147
ld b,h
5148
ld c,l
5149
add hl,hl
5150
rl d
5151
rla
5152
add hl,hl
5153
rl d
5154
rla
5155
add hl,bc
5156
ld b,a
5157
ld a,d
5158
adc a,e
5159
ld d,a
5160
ld a,b
5161
adc a,0
5162
add hl,hl
5163
rl d
5164
rla
5165
ld (scrap+1),de
5166
ld (scrap),hl
5167
ret
5168
5169
strip_zeroes:
5170
ld a,'0'
5171
_53:
5172
dec hl
5173
cp (hl)
5174
jr z,_53
5175
5176
;Check that the last digit isn't a decimal!
5177
ld a,'.'
5178
cp (hl)
5179
ret z
5180
inc hl
5181
ret
5182
5183
singletostr_mul:
5184
rra
5185
call c,_54
5186
ld hl,4
5187
add hl,de
5188
ex de,hl
5189
ret
5190
_54:
5191
ld h,b
5192
ld l,c
5193
jp mulSingle
5194
mul8:
5195
;H*E => HL
5196
ld l,0
5197
ld d,l
5198
mul8_preset:
5199
sla h
5200
jr nc,$+3
5201
ld l,e
5202
add hl,hl
5203
jr nc,$+3
5204
add hl,de
5205
add hl,hl
5206
jr nc,$+3
5207
add hl,de
5208
add hl,hl
5209
jr nc,$+3
5210
add hl,de
5211
add hl,hl
5212
jr nc,$+3
5213
add hl,de
5214
add hl,hl
5215
jr nc,$+3
5216
add hl,de
5217
add hl,hl
5218
jr nc,$+3
5219
add hl,de
5220
add hl,hl
5221
ret nc
5222
add hl,de
5223
ret
5224
5225
endif
5226
5227
5228
if defined MATH_FIN
5229
5230
;---------------------------------------------------------------------------------------------------------
5231
; str2Single
5232
; https://www.ticalc.org/pub/86/asm/source/routines/atof.asm
5233
;---------------------------------------------------------------------------------------------------------
5234
5235
char_NEG: equ '-'
5236
char_ENG: equ ','
5237
char_DEC: equ '.'
5238
ptr_sto: equ scrap+9
5239
5240
;;#Routines/Single Precision
5241
;;Inputs:
5242
;; HL points to the string
5243
;; BC points to where the float is output
5244
;;Output:
5245
;; scrap+9 is the pointer to the end of the string
5246
;;Destroys:
5247
;; 11 bytes at scrap ?
5248
5249
str2single:
5250
call pushpop
5251
push bc
5252
;Check if there is a negative sign.
5253
; Save for later
5254
; Advance ptr
5255
ld a,(hl)
5256
sub char_NEG
5257
sub 1
5258
push af
5259
jr nc,$+3
5260
inc hl
5261
;Skip all leading zeroes
5262
ld a,(hl)
5263
cp '0'
5264
jr z,$-4 ;jumps back to the `inc hl`
5265
;Set exponent to 0
5266
ld b,0
5267
;Check if the next char is char_DEC
5268
sub char_DEC
5269
or a ;to reset the carry flag
5270
jr nz,_55
5271
jr _54a ;.db $FE ;start of cp *
5272
;Get rid of zeroes
5273
dec b
5274
_54a:
5275
inc hl
5276
ld a,(hl)
5277
cp '0'
5278
jr z,$-5 ;jumps back to the `dec b`
5279
scf
5280
_55:
5281
;Now we read in the next 8 digits
5282
ld de,scrap+3
5283
call ascii_to_uint8
5284
call ascii_to_uint8
5285
call ascii_to_uint8
5286
call ascii_to_uint8
5287
;Now `scrap` holds the 4-digit base-100 number.
5288
;b is the exponent
5289
;if carry flag is set, just need to get rid of remaining digits
5290
;Otherwise, need to get rid of remaining digits, while incrementing the exponent
5291
sbc a,a
5292
inc a
5293
ld c,a
5294
_56:
5295
ld a,(hl)
5296
cp 30h
5297
jr nz,_57
5298
inc hl
5299
ld a,b
5300
add a,c
5301
jp z,strToSingle_inf
5302
ld b,a
5303
jr _56
5304
;Now check for engineering `E` to modify the exponent
5305
_57:
5306
cp char_NEG
5307
call z,str_eng_exp
5308
;Gotta multiply the number at (scrap) by 2^24
5309
ld (ptr_sto),hl
5310
ld d,100
5311
call scrap_times_256
5312
ld a,c
5313
ld (scrap+6),a
5314
call scrap_times_256
5315
ld a,c
5316
ld (scrap+5),a
5317
call scrap_times_256
5318
ld a,c
5319
ld (scrap+4),a
5320
call scrap_times_256
5321
ld a,c
5322
ld (scrap+3),a
5323
;Now scrap+3 is a 4-byte mantissa that needs to be normalized
5324
;
5325
ld hl,(scrap+3)
5326
ld a,h
5327
or l
5328
ld hl,(scrap+5)
5329
or l
5330
or h
5331
jp z,strToSingle_zero-1
5332
ld c,$7F
5333
ld a,h
5334
or a
5335
jp m,strToSingle_normed
5336
;Will need to iterate at most three times
5337
_58:
5338
dec c
5339
ld hl,scrap+3
5340
sla (hl)
5341
inc hl
5342
rl (hl)
5343
inc hl
5344
rl (hl)
5345
inc hl
5346
adc a,a
5347
jp p,_58
5348
strToSingle_normed:
5349
;Move the number to scrap
5350
ld hl,(scrap+4)
5351
ld (scrap),hl
5352
ld l,a
5353
ld h,c
5354
sla l
5355
pop af
5356
rr l
5357
ld (scrap+2),hl
5358
;now (scrap) is our number, need to multiply by power of 10!
5359
;Power of 10 is stored in B, need to put in A first
5360
xor a
5361
sub b
5362
ld de,pown10LUT
5363
jp p,_59
5364
ld a,b
5365
ld de,pow10LUT
5366
cp 40
5367
jp nc,strToSingle_inf+1
5368
_59:
5369
cp 40
5370
jp nc,strToSingle_zero
5371
ld hl,scrap
5372
ld b,h
5373
ld c,l
5374
call _60
5375
call _60
5376
call _60
5377
call _60
5378
call _60
5379
call _60
5380
pop de
5381
jp mov4
5382
_60:
5383
rra
5384
call c,mulSingle
5385
inc de
5386
inc de
5387
inc de
5388
inc de
5389
ret
5390
str_eng_exp:
5391
ld de,0
5392
inc hl
5393
ld a,(hl)
5394
cp char_NEG ;negative exponent?
5395
push af
5396
jr nz,$+3
5397
inc hl
5398
_61:
5399
ld a,(hl)
5400
sub 3Ah
5401
add a,10
5402
jr nc,_62
5403
inc hl
5404
push hl
5405
ld h,d
5406
ld l,e
5407
add hl,hl
5408
add hl,hl
5409
add hl,de
5410
add hl,hl
5411
add a,l
5412
ld l,a
5413
ex de,hl
5414
pop hl
5415
jp c,eng_overflow
5416
inc d
5417
dec d
5418
jp z,_61
5419
jp nz,eng_overflow
5420
_62:
5421
ld a,e
5422
cp 40
5423
jr nc,eng_overflow
5424
pop af
5425
ld a,b
5426
jr nz,_63
5427
sub e
5428
ld b,a
5429
ret
5430
_63:
5431
add a,e
5432
ld b,a
5433
ret
5434
scrap_times_256:
5435
ld e,8
5436
_64:
5437
or a
5438
ld hl,scrap
5439
call _65
5440
call _65
5441
rl c
5442
dec e
5443
jr nz,_64
5444
ret
5445
_65:
5446
call scrap_times_sub
5447
scrap_times_sub:
5448
ld a,(hl)
5449
rla
5450
cp d
5451
jr c,$+3
5452
sub d
5453
ld (hl),a
5454
inc hl
5455
ccf
5456
ret
5457
eng_overflow:
5458
pop af
5459
jr nz,strToSingle_inf
5460
pop af
5461
strToSingle_zero:
5462
ld hl,const_0
5463
pop de
5464
jp mov4
5465
strToSingle_inf:
5466
;return inf
5467
pop af
5468
ld hl,const_inf
5469
jr nc,_66
5470
ld hl,const_NegInf
5471
_66:
5472
pop de
5473
jp mov4
5474
5475
endif
5476
5477
if defined roundSingle or defined MATH_FRCSGL
5478
5479
;---------------------------------------------------------------------------------------------------------
5480
; int2Single
5481
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division
5482
;---------------------------------------------------------------------------------------------------------
5483
5484
int2Single:
5485
call pushpop
5486
push bc
5487
push hl
5488
pop ix
5489
ld l, (ix) ; convert integer parameter to single float
5490
ld h, (ix+1)
5491
ld bc, 0x1000 ; bynary digits count + sign
5492
5493
int2Single.test.zero:
5494
xor a
5495
or h ; test if hl is not zero
5496
jr nz, int2Single.test.negative
5497
or l
5498
jr nz, int2Single.test.negative
5499
ld hl, 0
5500
ld de, 0
5501
jp int2Single.save
5502
5503
int2Single.test.negative:
5504
bit 7, h ; test if hl is negative
5505
jr z, int2Single.normalize
5506
ld c, 0x80 ; sign negative
5507
ld a, h ;\
5508
cpl ; |
5509
ld h, a ; | abs(hl)
5510
ld a, l ; |
5511
cpl ; |
5512
ld l, a ;/
5513
inc hl
5514
5515
int2Single.normalize:
5516
dec b
5517
bit 7, h
5518
jr nz, int2Single.mount
5519
sla l
5520
rl h
5521
jr int2Single.normalize
5522
5523
int2Single.mount:
5524
res 7, h ; turn off upper bit
5525
5526
ld a, c ; restore sign
5527
or h ; put sign...
5528
ld h, a ; ...into upper mantissa
5529
5530
ld e, h ; sign+mantissa
5531
ld h, l ; high mantissa
5532
ld l, 0 ; low mantissa
5533
5534
ld a, b ; binary digits count
5535
or 0x80 ; exponent bias
5536
ld d, a ; exponent
5537
5538
int2Single.save:
5539
pop ix
5540
ld (ix), l ; low mantissa
5541
ld (ix+1), h ; high mantissa
5542
ld (ix+2), e ; sign + mantissa
5543
ld (ix+3), d ; expoent
5544
ld (ix+4), 0
5545
ld (ix+5), 0
5546
ld (ix+6), 0
5547
ld (ix+7), 0
5548
ret
5549
5550
endif
5551
5552
if defined roundSingle or defined MATH_FRCINT
5553
5554
;---------------------------------------------------------------------------------------------------------
5555
; single2Int
5556
; http://0x80.pl/articles/convert-float-to-integer.html
5557
;---------------------------------------------------------------------------------------------------------
5558
single2Int:
5559
;Input:
5560
; HL points to the single-precision float
5561
;Output:
5562
; HL is the 16-bit signed integer part of the float
5563
; BC points to 16-bit signed integer
5564
call pushpop
5565
push bc
5566
ld e,(hl)
5567
inc hl
5568
ld d,(hl)
5569
inc hl
5570
ld a,(hl)
5571
add a,a
5572
push af
5573
scf
5574
rra
5575
ld c,a
5576
inc hl
5577
ld a,(hl)
5578
ld hl,0
5579
sub 80h
5580
jr c,no_shift_single_to_int16
5581
cp 39
5582
jr nc,no_shift_single_to_int16
5583
sub 8
5584
jr c,_67
5585
ld l,c
5586
ld c,d
5587
ld d,e
5588
ld e,h
5589
sub 8
5590
jr c,_67
5591
ld h,l
5592
ld l,c
5593
ld c,d
5594
ld d,e
5595
sub 8
5596
jr c,_67
5597
ld h,l
5598
ld l,c
5599
ld c,d
5600
sub 8
5601
jr c,_67
5602
ld h,l
5603
ld l,c
5604
jr _67a ;.db $11 ;start of ld de,*
5605
_67:
5606
add a,9
5607
_67a:
5608
ld b,a
5609
ld a,e
5610
_68:
5611
add a,a
5612
rl d
5613
rl c
5614
adc hl,hl
5615
djnz _68
5616
no_shift_single_to_int16:
5617
pop af
5618
jr nc,_69
5619
;need to negate
5620
xor a
5621
sub e
5622
ld e,0
5623
ld a,e
5624
sbc a,d
5625
ld a,e
5626
sbc a,c
5627
ld d,e
5628
ex de,hl
5629
sbc hl,de
5630
_69:
5631
pop ix
5632
ld (ix), l
5633
ld (ix+1), h
5634
ret
5635
5636
endif
5637
5638
;---------------------------------------------------------------------------------------------------------
5639
; Auxiliary routines
5640
;---------------------------------------------------------------------------------------------------------
5641
5642
str_Zero: db "0",0
5643
str_Inf: db "inf",0
5644
str_NaN: db "NaN",0
5645
5646
start_const:
5647
const_pi: db $DB,$0F,$49,$81
5648
const_e: db $54,$f8,$2d,$81
5649
const_lg_e: db $3b,$AA,$38,$80
5650
const_ln_2: db $18,$72,$31,$7f
5651
const_log2: db $9b,$20,$1a,$7e
5652
const_lg10: db $78,$9a,$54,$81
5653
const_0: db $00,$00,$00,$00
5654
const_1: db $00,$00,$00,$80
5655
const_2: dw 0, 33024
5656
const_3: dw 0, 33088
5657
const_4: dw 0, 33280
5658
const_5: dw 0, 33312
5659
const_7: dw 0, 33376
5660
const_9: dw 0, 33552
5661
const_16: dw 0, 33792
5662
const_100: db $00,$00,$48,$86
5663
const_100_inv: dw 55050, 31011
5664
const_precision: db $77,$CC,$2B,$65 ;10^-8
5665
const_half_1: dw 0, 32512
5666
const_inf: db $00,$00,$40,$00
5667
const_NegInf: db $00,$00,$C0,$00
5668
const_NaN: db $00,$00,$20,$00
5669
const_log10_e: db $D9,$5B,$5E,$7E
5670
const_2pi: db $DB,$0F,$49,$82
5671
const_2pi_inv: db $83,$F9,$22,$7D
5672
const_half_pi: dw 4059, 32841
5673
const_p25: db $00,$00,$00,$7E
5674
const_p5: db $00,$00,$00,$7F
5675
; db $,$,$,$
5676
end_const:
5677
sin_a1: dw 43691, 32042
5678
sin_a2: dw 34952, 30984
5679
sin_a3: dw 3329, 29520
5680
cos_a1: equ const_half_1
5681
cos_a2: dw 43691, 31530
5682
cos_a3: dw 2914, 30262
5683
exp_a1: db $15,$72,$31,$7F ;.693146989552
5684
exp_a2: db $CE,$FE,$75,$7D ;.2402298085906
5685
exp_a3: db $7B,$42,$63,$7B ;.0554833215071
5686
exp_a4: db $FD,$94,$1E,$79 ;.00967907584392
5687
exp_a5: db $5E,$01,$23,$76 ;.001243632065103
5688
exp_a6: db $5F,$B7,$63,$73 ;.0002171671843714
5689
const_1p40625: db $00,$00,$34,$80 ;1.40625
5690
5691
if defined MATH_CONSTSINGLE
5692
5693
iconstSingle:
5694
ex (sp),hl
5695
ld a,(hl)
5696
inc hl
5697
ex (sp),hl
5698
constSingle:
5699
;A is the constant ID#
5700
;returns nc if failed, c otherwise
5701
;HL points to the constant
5702
cp (end_const-start_const)>>2
5703
ret nc
5704
ld hl,start_const
5705
add a,a
5706
add a,a
5707
add a,l
5708
ld l,a
5709
;#if ((end_const-4)>>8)!=(start_const>>8)
5710
; ccf
5711
; ret c
5712
; inc h
5713
;#endif
5714
scf
5715
ret
5716
5717
endif
5718
5719
;;LUTs used
5720
lut:
5721
pown10LUT:
5722
db $CD,$CC,$4C,$7C ;.1
5723
db $0A,$D7,$23,$79 ;.01
5724
db $17,$B7,$51,$72 ;.0001
5725
db $77,$CC,$2B,$65 ;10^-8
5726
db $95,$95,$66,$4A ;10^-16
5727
db $1F,$B1,$4F,$15 ;10^-32
5728
pow10LUT:
5729
const_10:
5730
db $00,$00,$20,$83 ;10
5731
db $00,$00,$48,$86 ;100
5732
db $00,$40,$1C,$8D ;10000
5733
db $20,$BC,$3E,$9A ;10^8
5734
db $CA,$1B,$0E,$B5 ;10^16
5735
db $AE,$C5,$1D,$EA ;10^32
5736
5737
C_Times_BDE:
5738
;;C*BDE => CAHL
5739
;C = 0 157
5740
;C = 1 141
5741
;141+
5742
;C>=128 135+6{0,33+{0,1}}+{0,20+{0,8}}
5743
;C>=64 115+5{0,33+{0,1}}+{0,20+{0,8}}
5744
;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}
5745
;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}
5746
;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}
5747
;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}
5748
;C>=2 15+{0,20+{0,8}}
5749
;min: 141cc
5750
;max: 508cc
5751
;avg: 349.21279907227cc
5752
5753
ld a,b
5754
ld h,d
5755
ld l,e
5756
sla c
5757
jr c,mul8_24_1
5758
sla c
5759
jr c,mul8_24_2
5760
sla c
5761
jr c,mul8_24_3
5762
sla c
5763
jr c,mul8_24_4
5764
sla c
5765
jr c,mul8_24_5
5766
sla c
5767
jr c,mul8_24_6
5768
sla c
5769
jr c,mul8_24_7
5770
sla c
5771
ret c
5772
ld a,c
5773
ld h,c
5774
ld l,c
5775
ret
5776
mul8_24_1:
5777
add hl,hl
5778
rla
5779
rl c
5780
jr nc,$+7
5781
add hl,de
5782
adc a,b
5783
jr nc,$+3
5784
inc c
5785
mul8_24_2:
5786
add hl,hl
5787
rla
5788
rl c
5789
jr nc,$+7
5790
add hl,de
5791
adc a,b
5792
jr nc,$+3
5793
inc c
5794
mul8_24_3:
5795
add hl,hl
5796
rla
5797
rl c
5798
jr nc,$+7
5799
add hl,de
5800
adc a,b
5801
jr nc,$+3
5802
inc c
5803
mul8_24_4:
5804
add hl,hl
5805
rla
5806
rl c
5807
jr nc,$+7
5808
add hl,de
5809
adc a,b
5810
jr nc,$+3
5811
inc c
5812
mul8_24_5:
5813
add hl,hl
5814
rla
5815
rl c
5816
jr nc,$+7
5817
add hl,de
5818
adc a,b
5819
jr nc,$+3
5820
inc c
5821
mul8_24_6:
5822
add hl,hl
5823
rla
5824
rl c
5825
jr nc,$+7
5826
add hl,de
5827
adc a,b
5828
jr nc,$+3
5829
inc c
5830
mul8_24_7:
5831
add hl,hl
5832
rla
5833
rl c
5834
ret nc
5835
add hl,de
5836
adc a,b
5837
ret nc
5838
inc c
5839
ret
5840
5841
pushpop:
5842
;26 bytes, adds 118cc to the traditional routine
5843
ex (sp),hl
5844
push de
5845
push bc
5846
push af
5847
push hl
5848
ld hl,pushpopret
5849
ex (sp),hl
5850
push hl
5851
push af
5852
ld hl,12
5853
add hl,sp
5854
ld a,(hl)
5855
inc hl
5856
ld h,(hl)
5857
ld l,a
5858
pop af
5859
ret
5860
pushpopret:
5861
pop af
5862
pop bc
5863
pop de
5864
pop hl
5865
ret
5866
5867
mov4:
5868
ldi
5869
ldi
5870
ldi
5871
ldi
5872
ret
5873
5874
if defined MATH_FIN
5875
5876
ascii_to_uint8:
5877
;c flag means don't increment the exponent
5878
ld c,0
5879
ld a,(hl)
5880
jr c,ascii_to_uint8_noexp
5881
cp char_DEC
5882
jr z,ascii_to_uint8_noexp-2
5883
_70:
5884
sub 3Ah
5885
add a,10
5886
jr nc,ascii_to_uint8_noexp_end
5887
inc b
5888
ld c,a
5889
add a,a
5890
add a,a
5891
add a,c
5892
add a,a
5893
ld c,a
5894
inc hl
5895
_71:
5896
ld a,(hl)
5897
cp char_DEC
5898
jr z,ascii_to_uint8_noexp_2nd
5899
_72:
5900
sub 3Ah
5901
add a,10
5902
jr nc,ascii_to_uint8_noexp_end
5903
inc b
5904
add a,c
5905
inc hl
5906
ld (de),a
5907
dec de
5908
or a
5909
ret
5910
5911
inc hl
5912
ld a,(hl)
5913
ascii_to_uint8_noexp:
5914
sub 3Ah
5915
add a,10
5916
jr nc,ascii_to_uint8_noexp_end
5917
ld c,a
5918
add a,a
5919
add a,a
5920
add a,c
5921
add a,a
5922
ld c,a
5923
ascii_to_uint8_noexp_2nd:
5924
inc hl
5925
ld a,(hl)
5926
sub 3Ah
5927
add a,10
5928
jr nc,ascii_to_uint8_noexp_end
5929
add a,c
5930
inc hl
5931
jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc
5932
ascii_to_uint8_noexp_end:
5933
ld a,c
5934
ascii_2:
5935
ld (de),a
5936
dec de
5937
scf
5938
ret
5939
5940
endif
5941
5942
if defined MATH_RSUBSINGLE
5943
5944
rsubSingle:
5945
;;-x+y
5946
push af
5947
push hl
5948
push de
5949
push bc
5950
push de
5951
ld de,addend2
5952
ldi
5953
ldi
5954
ld a,(hl)
5955
xor 80h
5956
ld (de),a
5957
inc de
5958
inc hl
5959
ld a,(hl)
5960
ld (de),a
5961
pop de
5962
ld hl,addend2
5963
jp addInject ;jumps in to the addSingle routine
5964
5965
endif
5966
5967
if defined MATH_MOD1SINGLE
5968
5969
;This routine performs `x mod 1`, returning a non-negative value.
5970
;+inf -> NaN
5971
;-inf -> NaN
5972
;NaN -> NaN
5973
mod1Single:
5974
call pushpop
5975
push bc
5976
ld e,(hl)
5977
inc hl
5978
ld d,(hl)
5979
inc hl
5980
ld c,(hl)
5981
ld a,c
5982
xor 80h
5983
push af
5984
jp p,mod1Single.1
5985
ld c,a
5986
mod1Single.1:
5987
5988
inc hl
5989
ld a,(hl)
5990
ld b,a
5991
or a
5992
jr z,mod1Single_special
5993
sub $80
5994
jr c,mod1_end
5995
inc a
5996
ld b,a
5997
ld a,c
5998
ex de,hl
5999
mod1Single.2:
6000
add hl,hl
6001
rla
6002
djnz mod1Single.2
6003
ld c,a
6004
6005
;If it is zero, need to set exponent to zero and return
6006
or h
6007
or l
6008
ex de,hl
6009
jr z,mod1_end
6010
6011
;Need to normalize
6012
ld b,$7F
6013
ld a,c
6014
or a
6015
jp m,mod1_end
6016
ex de,hl
6017
mod1Single.3:
6018
dec b
6019
add hl,hl
6020
adc a,a
6021
jp p,mod1Single.3
6022
ld c,a
6023
ex de,hl
6024
mod1_end:
6025
pop af
6026
pop hl
6027
jp m,mod1Single.4
6028
;make sure it isn't zero else we need to add 1
6029
ld a,b
6030
or a
6031
jr z,mod1Single.4
6032
ld (scrap),de
6033
ld (scrap+2),bc
6034
ld b,h
6035
ld c,l
6036
ld hl,scrap
6037
ld de,const_1
6038
jp addSingle
6039
mod1Single_special:
6040
;If INF, need to return NaN instead
6041
;For 0 and NaN, just return itself :)
6042
pop af
6043
pop hl
6044
ld a,c
6045
add a,a
6046
jp p,mod1Single.4
6047
ld c,$40
6048
mod1Single.4:
6049
res 7,c
6050
ld (hl),e
6051
inc hl
6052
ld (hl),d
6053
inc hl
6054
ld (hl),c
6055
inc hl
6056
ld (hl),b
6057
ret
6058
6059
endif
6060
6061
if defined MATH_FOUT
6062
6063
; --------------------------------------------------------------
6064
; Converts a signed integer value to a zero-terminated ASCII
6065
; string representative of that value (using radix 10).
6066
; References:
6067
; Brandon Wilson WikiTI
6068
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version
6069
; --------------------------------------------------------------
6070
; INPUTS:
6071
; HL Value to convert (two's complement integer).
6072
; DE Base address of string destination. (pointer).
6073
; --------------------------------------------------------------
6074
; OUTPUTS:
6075
; A Size of string
6076
; --------------------------------------------------------------
6077
; REGISTERS/MEMORY DESTROYED
6078
; AF HL
6079
; --------------------------------------------------------------
6080
6081
IntToStr:
6082
push de
6083
push bc
6084
6085
; Detect sign of HL.
6086
bit 7, h
6087
jr z, _DoConvert
6088
6089
; HL is negative. Output '-' to string and negate HL.
6090
ld a, '-'
6091
ld (de), a
6092
inc de
6093
6094
; Negate HL (using two's complement)
6095
xor a
6096
sub l
6097
ld l, a
6098
ld a, 0 ; Note that XOR A or SUB A would disturb CF
6099
sbc a, h
6100
ld h, a
6101
6102
; Convert HL to digit characters
6103
_DoConvert:
6104
ld b, 0 ; B will count character length of number
6105
_DoConvert.1:
6106
ld c, 10
6107
call div_hl_c; HL = HL / A, A = remainder
6108
push af
6109
inc b
6110
ld a, h
6111
or l
6112
jr nz, _DoConvert.1
6113
6114
; Retrieve digits from stack
6115
_DoConvert.2:
6116
pop af
6117
or $30
6118
ld (de), a
6119
inc de
6120
djnz _DoConvert.2
6121
6122
; Terminate string with NULL
6123
xor a
6124
ld (de), a
6125
6126
ld h, d
6127
ld l, e
6128
6129
pop bc
6130
pop de
6131
6132
sbc hl, de
6133
ld a, l ; string size
6134
6135
ret
6136
6137
endif
6138
6139
if defined MATH_FIN
6140
6141
;===============================================================
6142
; Convert a string of base-10 digits to a 16-bit value.
6143
; http://z80-heaven.wikidot.com/math#toc32
6144
;Input:
6145
; DE points to the base 10 number string in RAM.
6146
;Outputs:
6147
; HL is the 16-bit value of the number
6148
; DE points to the byte after the number
6149
; BC is HL/10
6150
; z flag reset (nz)
6151
; c flag reset (nc)
6152
;Destroys:
6153
; A (actually, add 30h and you get the ending token)
6154
;Size: 23 bytes
6155
;Speed: 104n+42+11c
6156
; n is the number of digits
6157
; c is at most n-2
6158
; at most 595 cycles for any 16-bit decimal value
6159
;===============================================================
6160
6161
StrToInt:
6162
ld hl,0 ; 10 : 210000
6163
dec de
6164
StrToInt.Skip_spaces:
6165
inc de ; 6 : 13
6166
ld a,(de) ; 7 : 1A
6167
or 0
6168
ret z
6169
cp 32
6170
jr z, StrToInt.Skip_spaces
6171
StrToInt.Init:
6172
push af
6173
cp '-'
6174
jr nz, StrToInt.ConvLoop
6175
inc de
6176
StrToInt.ConvLoop: ;
6177
ld a,(de) ; 7 : 1A
6178
or 0
6179
jr z, StrToInt.End
6180
sub 30h ; 7 : D630
6181
cp 10 ; 7 : FE0A
6182
jr nc, StrToInt.End
6183
;
6184
inc de ; 6 : 13
6185
ld b,h ; 4 : 44
6186
ld c,l ; 4 : 4D
6187
add hl,hl ; 11 : 29
6188
add hl,hl ; 11 : 29
6189
add hl,bc ; 11 : 09
6190
add hl,hl ; 11 : 29
6191
;
6192
add a,l ; 4 : 85
6193
ld l,a ; 4 : 6F
6194
jr nc, StrToInt.ConvLoop ;12|23: 30EE
6195
inc h ; --- : 24
6196
jr StrToInt.ConvLoop ; --- : 18EB
6197
6198
StrToInt.End:
6199
pop af
6200
cp '-'
6201
ret nz
6202
ld de, 0xffff
6203
ex de, hl
6204
dec de
6205
xor a
6206
sbc hl, de
6207
ret
6208
6209
endif
6210
6211
if defined IntToStr
6212
6213
; divides hl by c
6214
; return remainder in a
6215
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division
6216
div_hl_c:
6217
push bc
6218
xor a
6219
ld b, 16
6220
div_hl_c.loop:
6221
add hl, hl
6222
rla
6223
jr c, $+5
6224
cp c
6225
jr c, $+4
6226
sub c
6227
inc l
6228
djnz div_hl_c.loop
6229
pop bc
6230
ret
6231
6232
endif
6233
6234
if defined DIV_EHL
6235
6236
; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division
6237
div_ehl_d:
6238
xor a
6239
ld b, 24
6240
div_ehl_d.loop:
6241
add hl, hl
6242
rl e
6243
rla
6244
jr c, $+5
6245
cp d
6246
jr c, $+4
6247
sub d
6248
inc l
6249
djnz div_ehl_d.loop
6250
ret
6251
6252
div_dehl_c:
6253
push bc
6254
xor a
6255
ld b, 32
6256
div_dehl_c.loop:
6257
add hl, hl
6258
rl e
6259
rl d
6260
rla
6261
jr c, $+5
6262
cp c
6263
jr c, $+4
6264
sub c
6265
inc l
6266
djnz div_dehl_c.loop
6267
pop bc
6268
ret
6269
6270
endif
6271
6272
6273
6274
;---------------------------------------------------------------------------------------------------------
6275
; VARIABLES INITIALIZE
6276
;---------------------------------------------------------------------------------------------------------
6277
6278
INITIALIZE_DUMMY:
6279
xor a
6280
ld (VAR_DUMMY.COUNTER), a ; max circular queue = 8 dummys
6281
ld hl, VAR_DUMMY.DATA ; start of variable dummy circular queue
6282
ld (VAR_DUMMY.POINTER), hl
6283
ld b, VAR_DUMMY.LENGTH
6284
ld c, 0
6285
INITIALIZE_DUMMY.1:
6286
ld (hl), a
6287
inc hl
6288
djnz INITIALIZE_DUMMY.1
6289
ret
6290
6291
INITIALIZE_DATA:
6292
ld hl, DATA_ITEMS
6293
ld (BASIC_DATPTR), hl ; next DATA pointer to use by READ command
6294
ld hl, 0
6295
ld (BASIC_DATLIN), hl ; index of DATA item to use by READ command
6296
ret
6297
6298
INITIALIZE_VARIABLES:
6299
call INITIALIZE_DATA
6300
call INITIALIZE_DUMMY
6301
6302
if defined SCREEN
6303
call gfxInitSpriteCollisionTable
6304
endif
6305
6306
;if defined COMPILE_TO_ROM
6307
; ld ix, BIOS_JIFFY ; initialize rom clock
6308
; di
6309
; ld (ix), 0
6310
; ld (ix+1), 0
6311
; ei
6312
;endif
6313
6314
ld hl, IDF_8
6315
ld d, 3 ; string
6316
ld c, 0 ; variable name 1 (variable number)
6317
ld b, 255 ; variable name 2 (type flag=fixed)
6318
call INIT_VAR ; variable initialize
6319
ret
6320
6321
6322
;---------------------------------------------------------------------------------------------------------
6323
; MAIN WORK AREA - LITERALS / VARIABLES / CONFIGURATIONS
6324
;---------------------------------------------------------------------------------------------------------
6325
6326
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6327
6328
workAreaPad:
6329
pgmPage1.pad: equ pageSize - (workAreaPad - pgmArea)
6330
6331
if pgmPage1.pad >= 0
6332
ds pgmPage1.pad, 0
6333
;else
6334
; .WARNING "There's no free space left on program page 1"
6335
endif
6336
6337
endif
6338
6339
VAR_STACK.START: equ ramArea
6340
;VAR_STACK.END: equ VAR_STACK.START + 0x800 ; 2kb (~200 variables)
6341
6342
VAR_STACK.POINTER: equ VAR_STACK.START
6343
6344
PRINT.CRLF: db 3, 0, 0, 2
6345
dw PRINT.CRLF.DATA, 0, 0, 0
6346
PRINT.CRLF.DATA: db 13,10,0
6347
6348
PRINT.TAB: db 3, 0, 0, 1
6349
dw PRINT.TAB.DATA, 0, 0, 0
6350
PRINT.TAB.DATA: db 09,0
6351
6352
; null double
6353
LIT_NULL_DBL: dw 0, 0, 0, 0
6354
6355
; null string
6356
LIT_NULL_STR: db 0
6357
6358
; quote string
6359
LIT_QUOTE_CHAR: db '\"'
6360
6361
; logical true
6362
LIT_TRUE: db 2, 0, 0
6363
dw 0, 0xFFFF, 0, 0
6364
6365
; logical false
6366
LIT_FALSE: db 2, 0, 0
6367
dw 0, 0, 0, 0
6368
6369
6370
; string literal
6371
LIT_4: db 3, 0, 0, 3
6372
dw LIT_4_DATA, 0, 0
6373
db 0
6374
LIT_4_DATA: db "CCC", 0
6375
6376
; string literal
6377
LIT_6: db 3, 0, 0, 3
6378
dw LIT_6_DATA, 0, 0
6379
db 0
6380
LIT_6_DATA: db "CDE", 0
6381
6382
; identifier A$
6383
IDF_8: equ VAR_STACK.POINTER + 0
6384
6385
; numerical literal
6386
LIT_11: db 2, 0, 0
6387
dw 0, 1, 0, 0
6388
6389
; string literal
6390
LIT_12: db 3, 0, 0, 3
6391
dw LIT_12_DATA, 0, 0
6392
db 0
6393
LIT_12_DATA: db "DDD", 0
6394
6395
; string literal
6396
LIT_13: db 3, 0, 0, 3
6397
dw LIT_13_DATA, 0, 0
6398
db 0
6399
LIT_13_DATA: db "EDC", 0
6400
6401
; numerical literal
6402
LIT_14: db 2, 0, 0
6403
dw 0, 1, 0, 0
6404
6405
; string literal
6406
LIT_15: db 3, 0, 0, 3
6407
dw LIT_15_DATA, 0, 0
6408
db 0
6409
LIT_15_DATA: db "EEE", 0
6410
6411
AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 11
6412
6413
VAR_DUMMY.START: equ AFTER_LAST_VARIABLE ; variable dummy circular queue area
6414
VAR_DUMMY.COUNTER: equ VAR_DUMMY.START ; variable dummy circular queue count
6415
VAR_DUMMY.POINTER: equ VAR_DUMMY.COUNTER + 1 ; pointer to next variable dummy
6416
VAR_DUMMY.DATA: equ VAR_DUMMY.POINTER + 2 ; first variable dummy
6417
6418
VAR_DUMMY.SIZE: equ 8
6419
VAR_DUMMY.LENGTH: equ (11 * VAR_DUMMY.SIZE)
6420
VAR_DUMMY.END: equ VAR_DUMMY.DATA + VAR_DUMMY.LENGTH
6421
VAR_STACK.END: equ VAR_DUMMY.END + 1
6422
6423
;--------------------------------------------------------
6424
; DATA SIMBOLS
6425
;--------------------------------------------------------
6426
6427
DATA_ITEMS:
6428
DATA_ITEMS_COUNT: equ 0
6429
6430
DATA_SET_ITEMS_START:
6431
DATA_SET_ITEMS_COUNT: equ 0
6432
6433
6434
;---------------------------------------------------------------------------------------------------------
6435
; PROGRAM BASIC ROM HOOKS
6436
;---------------------------------------------------------------------------------------------------------
6437
6438
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6439
6440
BASIC_SLOT_ENABLE:
6441
ld a, (BIOS_EXPTBL)
6442
ld hl,04000h
6443
__call_bios BIOS_ENASLT ; Select main ROM on page 1 (4000h~7FFFh)
6444
ret
6445
6446
PROGRAM_SLOT_1_ENABLE:
6447
call BIOS_RSLREG
6448
rrca
6449
rrca
6450
rrca
6451
rrca
6452
and 3 ;Keep bits corresponding to the page
6453
ld c,a
6454
ld b,0
6455
ld hl,BIOS_EXPTBL
6456
add hl,bc
6457
ld a,(hl)
6458
and 80h
6459
or c
6460
ld c,a
6461
inc hl
6462
inc hl
6463
inc hl
6464
inc hl
6465
ld a,(hl)
6466
and 0Ch
6467
or c
6468
ld h,040h
6469
jp BIOS_ENASLT ; Select the ROM on page 4000h-7FFFh
6470
6471
endif
6472
6473
if defined DO_DRAW
6474
6475
DRAW_HOOK:
6476
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6477
ld de, PROGRAM_SLOT_1_ENABLE
6478
push de
6479
endif
6480
6481
ld bc, 0
6482
push bc
6483
push bc
6484
push bc
6485
push hl ; address of string
6486
push af ; size of string
6487
6488
ld de, 0x5D83
6489
ld (BIOS_MCLTAB),de
6490
xor a
6491
ld (BIOS_DRWFLG),a
6492
ld (BIOS_MCLFLG),a
6493
6494
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6495
call BASIC_SLOT_ENABLE
6496
endif
6497
6498
jp BASIC_DRAW_DIRECT
6499
6500
endif
6501
6502
if defined SET_PLAY_VOICE_1 or defined SET_PLAY_VOICE_2 or defined SET_PLAY_VOICE_3 or defined DO_PLAY or defined MUSIC_PLAY or defined MUSIC_NEXT or defined MUSIC_STOP
6503
6504
PLAY_HOOK:
6505
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6506
ld de, PROGRAM_SLOT_1_ENABLE
6507
push de
6508
endif
6509
6510
ld HL, 0x752E
6511
ld (BIOS_MCLTAB),HL
6512
ld a, 1
6513
ld (BIOS_MCLFLG),A
6514
ld hl, BIOS_TEMP ; voice count
6515
ld a, 3
6516
sub (hl)
6517
dec a
6518
ld (BIOS_PRSCNT), a
6519
xor a
6520
ld (BIOS_VOICEN), a
6521
ld (BIOS_QUEUEN), a
6522
ld (BIOS_MUSICF), a
6523
ld HL,-12 ; -10
6524
add HL,SP
6525
ld (BIOS_SAVSP),HL
6526
ld HL, BIOS_PLYCNT
6527
ld (HL), 0
6528
6529
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6530
call BASIC_SLOT_ENABLE
6531
endif
6532
6533
jp BASIC_PLAY_DIRECT
6534
6535
endif
6536
6537
if defined gfxBorderFill
6538
6539
PAINT_HOOK:
6540
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6541
ld de, PROGRAM_SLOT_1_ENABLE
6542
push de
6543
endif
6544
6545
ld bc, (BIOS_GRPACX)
6546
ld (BIOS_GXPOS), bc
6547
ld de, (BIOS_GRPACY)
6548
ld (BIOS_GYPOS), de
6549
push bc
6550
push de
6551
6552
xor a
6553
ld hl, BASIC_BUF
6554
ld (hl), a
6555
6556
ld a, (BIOS_BDRATR)
6557
xor b
6558
ld e, a
6559
ld a, (BIOS_ATRBYT)
6560
xor d
6561
ld c, a
6562
6563
push af
6564
push bc
6565
push hl
6566
push de
6567
6568
call gfxIsScreenModeMSX2
6569
jr nc, PAINT_HOOK.1 ; if MSX2 and screen mode above 3, jump (BASIC_SUB_PAINT2)
6570
ld a, (BIOS_BDRATR)
6571
ld (BIOS_ATRBYT), a
6572
ld e, a
6573
PAINT_HOOK.1:
6574
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6575
call BASIC_SLOT_ENABLE
6576
endif
6577
6578
pop de
6579
pop hl
6580
pop bc
6581
pop af
6582
6583
jp BASIC_SUB_PAINT1
6584
6585
endif
6586
6587
;---------------------------------------------------------------------------------------------------------
6588
; PROGRAM FOOTER
6589
;---------------------------------------------------------------------------------------------------------
6590
6591
if defined COMPILE_TO_ROM or defined COMPILE_TO_DOS
6592
6593
romPad:
6594
6595
pgmPage2.pad: equ romSize - (romPad - pgmArea)
6596
6597
if pgmPage2.pad >= 0
6598
ds pgmPage2.pad, 0
6599
6600
if pgmPage2.pad < lowLimitSize
6601
.WARNING "There's only less than 5% free space on this ROM"
6602
endif
6603
else
6604
.ERROR "There's no free space left on this ROM"
6605
endif
6606
6607
endif
6608
6609
end_file: end start_pgm ; label start is the entry point
6610
Loggerhead is a web-based interface for Breezy
Version: 2.0.1