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