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