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