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