diff --git a/main_tb_behav.wcfg b/main_tb_behav.wcfg
index d3a68df..1250e04 100644
--- a/main_tb_behav.wcfg
+++ b/main_tb_behav.wcfg
@@ -14,15 +14,15 @@
-
-
-
+
+
+
-
+
-
+
cpuAddress[31:0]
cpuAddress[31:0]
@@ -99,4 +99,8 @@
memAddress[15:0]
memAddress[15:0]
+
+ txBitCount[3:0]
+ txBitCount[3:0]
+
diff --git a/roms/ehbasic/basic68k.L68 b/roms/ehbasic/basic68k.L68
index 7ee63cd..21c7cb7 100644
--- a/roms/ehbasic/basic68k.L68
+++ b/roms/ehbasic/basic68k.L68
@@ -1,6 +1,6 @@
-0000083E Starting Address
+00B0003E Starting Address
Assembler used: EASy68K Editor/Assembler v5.16.01
-Created On: 15/08/2020 20:38:05
+Created On: 16/08/2020 07:51:09
00000000 1 *************************************************************************************
00000000 2 * *
@@ -73,9174 +73,9175 @@ Created On: 15/08/2020 20:38:05
00000000 69 INCLUDE "basic68k.inc"
00000000 70
00000000 71
-00000000 72 ORG 0 * start of RAM
-00000000 73
-00000000 74 ram_strt ds.l $100 * allow 1K for the stack, this should be plenty
-00000400 75 * for any BASIC program that doesn't do something
-00000400 76 * silly, it could even be much less.
-00000400 77 ram_base
-00000400 78 LAB_WARM ds.w 1 * BASIC warm start entry point
-00000402 79 Wrmjpv ds.l 1 * BASIC warm start jump vector
-00000406 80
-00000406 81 Usrjmp ds.w 1 * USR function JMP address
-00000408 82 Usrjpv ds.l 1 * USR function JMP vector
-0000040C 83
-0000040C 84
-0000040C 85 V_INPT ds.w 1 * non halting scan input device entry point
-0000040E 86 V_INPTv ds.l 1 * non halting scan input device jump vector
-00000412 87
-00000412 88 V_OUTP ds.w 1 * send byte to output device entry point
-00000414 89 V_OUTPv ds.l 1 * send byte to output device jump vector
-00000418 90
-00000418 91 V_LOAD ds.w 1 * load BASIC program entry point
-0000041A 92 V_LOADv ds.l 1 * load BASIC program jump vector
-0000041E 93
-0000041E 94 V_SAVE ds.w 1 * save BASIC program entry point
-00000420 95 V_SAVEv ds.l 1 * save BASIC program jump vector
-00000424 96
-00000424 97 V_CTLC ds.w 1 * save CTRL-C check entry point
-00000426 98 V_CTLCv ds.l 1 * save CTRL-C check jump vector
-0000042A 99
-0000042A 100 Itemp ds.l 1 * temporary integer (for GOTO etc)
-0000042E 101
-0000042E 102 Smeml ds.l 1 * start of memory (start of program)
-00000432 103
-00000432 104
-00000432 105 Sfncl ds.l 1 * start of functions (end of Program)
-00000436 106
-00000436 107
-00000436 108 Svarl ds.l 1 * start of variables (end of functions)
-0000043A 109
-0000043A 110
-0000043A 111 Sstrl ds.l 1 * start of strings (end of variables)
-0000043E 112
-0000043E 113
-0000043E 114 Sarryl ds.l 1 * start of arrays (end of strings)
-00000442 115
-00000442 116
-00000442 117 Earryl ds.l 1 * end of arrays (start of free mem)
-00000446 118 Sstorl ds.l 1 * string storage (moving down)
-0000044A 119 Ememl ds.l 1 * end of memory (upper bound of RAM)
-0000044E 120 Sutill ds.l 1 * string utility ptr
-00000452 121 Clinel ds.l 1 * current line (Basic line number)
-00000456 122 Blinel ds.l 1 * break line (Basic line number)
-0000045A 123
-0000045A 124 Cpntrl ds.l 1 * continue pointer
-0000045E 125 Dlinel ds.l 1 * current DATA line
-00000462 126 Dptrl ds.l 1 * DATA pointer
-00000466 127 Rdptrl ds.l 1 * read pointer
-0000046A 128 Varname ds.l 1 * current var name
-0000046E 129 Cvaral ds.l 1 * current var address
-00000472 130 Lvarpl ds.l 1 * variable pointer for LET and FOR/NEXT
-00000476 131
-00000476 132 des_sk_e ds.l 6 * descriptor stack end address
-0000048E 133 des_sk * descriptor stack start address
-0000048E 134 * use a4 for the descriptor pointer
-0000048E 135 ds.w 1
-00000490 136 Ibuffs ds.l $40 * start of input buffer
-00000590 137 Ibuffe
-00000590 138 * end of input buffer
-00000590 139
-00000590 140 FAC1_m ds.l 1 * FAC1 mantissa1
-00000594 141 FAC1_e ds.w 1 * FAC1 exponent
-00000596 =00000595 142 FAC1_s EQU FAC1_e+1 * FAC1 sign (b7)
-00000596 143 ds.w 1
-00000598 144
-00000598 145 FAC2_m ds.l 1 * FAC2 mantissa1
-0000059C 146 FAC2_e ds.l 1 * FAC2 exponent
-000005A0 =0000059D 147 FAC2_s EQU FAC2_e+1 * FAC2 sign (b7)
-000005A0 =0000059E 148 FAC_sc EQU FAC2_e+2 * FAC sign comparison, Acc#1 vs #2
-000005A0 =0000059F 149 flag EQU FAC2_e+3 * flag byte for divide routine
-000005A0 150
-000005A0 151 PRNlword ds.l 1 * PRNG seed long word
-000005A4 152
-000005A4 153 ut1_pl ds.l 1 * utility pointer 1
-000005A8 154
-000005A8 155 Asptl ds.l 1 * array size/pointer
-000005AC 156 Astrtl ds.l 1 * array start pointer
-000005B0 157
-000005B0 =000005AC 158 numexp EQU Astrtl * string to float number exponent count
-000005B0 =000005AD 159 expcnt EQU Astrtl+1 * string to float exponent count
-000005B0 160
-000005B0 =000005AF 161 expneg EQU Astrtl+3 * string to float eval exponent -ve flag
-000005B0 162
-000005B0 163 func_l ds.l 1 * function pointer
-000005B4 164
-000005B4 165
-000005B4 166 * these two need to be a word aligned pair !
-000005B4 167 Defdim ds.w 1 * default DIM flag
-000005B6 =000005B4 168 cosout EQU Defdim * flag which CORDIC output (re-use byte)
-000005B6 =000005B5 169 Dtypef EQU Defdim+1 * data type flag, $80=string, $40=integer, $00=float
-000005B6 170
-000005B6 171
-000005B6 172 Binss ds.l 4 * number to bin string start (32 chrs)
-000005C6 173
-000005C6 174 Decss ds.l 1 * number to decimal string start (16 chrs)
-000005CA 175 ds.w 1 *
-000005CC 176 Usdss ds.w 1 * unsigned decimal string start (10 chrs)
-000005CE 177
-000005CE 178 Hexss ds.l 2 * number to hex string start (8 chrs)
-000005D6 179
-000005D6 180 BHsend ds.w 1 * bin/decimal/hex string end
-000005D8 181
-000005D8 182
-000005D8 183 prstk ds.b 1 * stacked function index
-000005D9 184
-000005D9 185 tpower ds.b 1 * remember CORDIC power
-000005DA 186
-000005DA 187 Asrch ds.b 1 * scan-between-quotes flag, alt search character
-000005DB 188
-000005DB 189 Dimcnt ds.b 1 * # of dimensions
-000005DC 190
-000005DC 191 Breakf ds.b 1 * break flag, $00=END else=break
-000005DD 192 Oquote ds.b 1 * open quote flag (Flag: DATA; LIST; memory)
-000005DE 193 Gclctd ds.b 1 * garbage collected flag
-000005DF 194 Sufnxf ds.b 1 * subscript/FNX flag, 1xxx xxx = FN(0xxx xxx)
-000005E0 195 Imode ds.b 1 * input mode flag, $00=INPUT, $98=READ
-000005E1 196
-000005E1 197 Cflag ds.b 1 * comparison evaluation flag
-000005E2 198
-000005E2 199 TabSiz ds.b 1 * TAB step size
-000005E3 200
-000005E3 201 comp_f ds.b 1 * compare function flag, bits 0,1 and 2 used
-000005E4 202 * bit 2 set if >
-000005E4 203 * bit 1 set if =
-000005E4 204 * bit 0 set if <
-000005E4 205
-000005E4 206 Nullct ds.b 1 * nulls output after each line
-000005E5 207 TPos ds.b 1 * BASIC terminal position byte
-000005E6 208 TWidth ds.b 1 * BASIC terminal width byte
-000005E7 209 Iclim ds.b 1 * input column limit
-000005E8 210 ccflag ds.b 1 * CTRL-C check flag
-000005E9 211 ccbyte ds.b 1 * CTRL-C last received byte
-000005EA 212 ccnull ds.b 1 * CTRL-C last received byte 'life' timer
-000005EB 213
-000005EB 214
-000005EB 215 file_byte ds.b 1 * load/save data byte
-000005EC 216 file_id ds.l 1 * load/save file ID
-000005F0 217
-000005F0 218 even * dummy even value and zero pad byte
-000005F0 219
-000005F0 220 -------------------- end include --------------------
-000005F0 221 * RAM offset definitions
-000005F0 222
-000005F0 223 * Use this value to run out of ROM
-000005F0 224 * ORG $00C000 * past the vectors in a real system
-000005F0 225 * Use this value to run out of RAM
-00000800 226 ORG $000800 * past the vectors in a real system
-00000800 227
-00000800 228 * Use these two lines when running from ROM
-00000800 229 *ram_addr EQU $02000 * RAM start address
-00000800 230 *ram_size EQU $06000 * RAM size
-00000800 231 prg_strt
-00000800 232
-00000800 233 * Use these two lines when running from RAM
-00000800 =00004000 234 ram_addr EQU $04000 * RAM start address
-00000800 =00004000 235 ram_size EQU $04000 * RAM size
-00000800 236
-00000800 =00F00009 237 ACIAC EQU $F00009
-00000800 =00F0000B 238 ACIAD EQU ACIAC+2
-00000800 =00000000 239 RDRF EQU 0 ; ACIAC Receive Data Register Full
-00000800 =00000001 240 TDRE EQU 1 ; ACIAC Transmit Data Register Empty
-00000800 241
-00000800 6000 003C 242 BRA code_start * For convenience, so you can start from first address
-00000804 243
-00000804 244 *************************************************************************************
-00000804 245 *
-00000804 246 * the following code is simulator specific, change to suit your system
-00000804 247 * output character to the console from register d0.b
-00000804 248
-00000804 249
-00000804 250 VEC_OUT
-00000804 0839 0001 00F00009 251 BTST.B #TDRE,ACIAC.L
-0000080C 67F6 252 BEQ.S VEC_OUT
-0000080E 13C0 00F0000B 253 MOVE.B D0,ACIAD.L
-00000814 4E75 254 RTS
-00000816 255
-00000816 256 *************************************************************************************
-00000816 257 *
-00000816 258 * input a character from the console into register d0
-00000816 259 * else return Cb=0 if theres no character available
-00000816 260
-00000816 261
-00000816 262 VEC_IN
-00000816 0839 0000 00F00009 263 BTST.B #RDRF,ACIAC.L
-0000081E 670C 264 BEQ.S RXNOTREADY
-00000820 1039 00F0000B 265 MOVE.B ACIAD.L,D0
-00000826 003C 0001 266 ORI.b #1,CCR * Set the carry, flag we got a byte
-0000082A 4E75 267 RTS * Return
-0000082C 268 RXNOTREADY
-0000082C 023C 00FE 269 ANDI.b #$FE,CCR * Clear the carry, flag character available
-00000830 4E75 270 RTS
-00000832 271
-00000832 272 *************************************************************************************
-00000832 273 *
-00000832 274 * LOAD routine for the TS2 computer (not implemented)
-00000832 275
-00000832 276 VEC_LD
-00000832 7E2E 277 MOVEQ #$2E,d7 * error code $2E "Not implemented" error
-00000834 6000 013A 278 BRA LAB_XERR * do error #d7, then warm start
-00000838 279
-00000838 280 *************************************************************************************
-00000838 281 *
-00000838 282 * SAVE routine for the TS2 computer (not implemented)
-00000838 283
-00000838 284 VEC_SV
-00000838 7E2E 285 MOVEQ #$2E,d7 * error code $2E "Not implemented" error
-0000083A 6000 0134 286 BRA LAB_XERR * do error #d7, then warm start
-0000083E 287
-0000083E 288 *************************************************************************************
-0000083E 289 *
-0000083E 290 * turn off simulator key echo
-0000083E 291
-0000083E 292 code_start
-0000083E 293 * Set up ACIA parameters
-0000083E 41F9 00F00009 294 LEA.L ACIAC,A0 * A0 points to console ACIA
-00000844 10BC 0015 295 MOVE.B #$15,(A0) * Set up ACIA1 constants (no IRQ,
-00000848 296 * RTS* low, 8 bit, no parity, 1 stop)
-00000848 297
-00000848 298 * to tell EhBASIC where and how much RAM it has pass the address in a0 and the size
-00000848 299 * in d0. these values are at the end of the .inc file
-00000848 300
-00000848 207C 00004000 301 MOVEA.l #ram_addr,a0 * tell BASIC where RAM starts
-0000084E 203C 00004000 302 MOVE.l #ram_size,d0 * tell BASIC how big RAM is
-00000854 303
-00000854 304 * end of simulator specific code
-00000854 305
-00000854 306
-00000854 307 ****************************************************************************************
-00000854 308 ****************************************************************************************
-00000854 309 ****************************************************************************************
-00000854 310 ****************************************************************************************
-00000854 311 *
-00000854 312 * Register use :- (must improve this !!)
-00000854 313 *
-00000854 314 * a6 - temp Bpntr * temporary BASIC execute pointer
-00000854 315 * a5 - Bpntr * BASIC execute (get byte) pointer
-00000854 316 * a4 - des_sk * descriptor stack pointer
-00000854 317 * a3 - ram_strt * start of RAM. all RAM references are offsets
-00000854 318 * * from this value
-00000854 319 *
-00000854 320
-00000854 321 *************************************************************************************
-00000854 322 *
-00000854 323 * BASIC cold start entry point. assume entry with RAM address in a0 and RAM length
-00000854 324 * in d0
-00000854 325
-00000854 326 LAB_COLD
-00000854 B0BC 00004000 327 CMP.l #$4000,d0 * compare size with 16k
-0000085A 6C08 328 BGE.s LAB_sizok * branch if >= 16k
-0000085C 329
-0000085C 7005 330 MOVEQ #5,d0 * error 5 - not enough RAM
-0000085E 1E3C 00E4 331 move.b #228,D7 * Go to TUTOR function
-00000862 4E4E 332 trap #14 * Call TRAP14 handler
-00000864 333
-00000864 334 LAB_sizok
-00000864 2648 335 MOVEA.l a0,a3 * copy RAM base to a3
-00000866 D1C0 336 ADDA.l d0,a0 * a0 is top of RAM
-00000868 2748 044A 337 MOVE.l a0,Ememl(a3) * set end of mem
-0000086C 4FEB 0400 338 LEA ram_base(a3),sp * set stack to RAM start + 1k
-00000870 339
-00000870 303C 4EF9 340 MOVE.w #$4EF9,d0 * JMP opcode
-00000874 204F 341 MOVEA.l sp,a0 * point to start of vector table
-00000876 342
-00000876 30C0 343 MOVE.w d0,(a0)+ * LAB_WARM
-00000878 43FA FFDA 344 LEA LAB_COLD(pc),a1 * initial warm start vector
-0000087C 20C9 345 MOVE.l a1,(a0)+ * set vector
-0000087E 346
-0000087E 30C0 347 MOVE.w d0,(a0)+ * Usrjmp
-00000880 43FA 00DC 348 LEA LAB_FCER(pc),a1 * initial user function vector
-00000884 349 * "Function call" error
-00000884 20C9 350 MOVE.l a1,(a0)+ * set vector
-00000886 351
-00000886 30C0 352 MOVE.w d0,(a0)+ * V_INPT JMP opcode
-00000888 43FA FF8C 353 LEA VEC_IN(pc),a1 * get byte from input device vector
-0000088C 20C9 354 MOVE.l a1,(a0)+ * set vector
-0000088E 355
-0000088E 30C0 356 MOVE.w d0,(a0)+ * V_OUTP JMP opcode
-00000890 43FA FF72 357 LEA VEC_OUT(pc),a1 * send byte to output device vector
-00000894 20C9 358 MOVE.l a1,(a0)+ * set vector
-00000896 359
-00000896 30C0 360 MOVE.w d0,(a0)+ * V_LOAD JMP opcode
-00000898 43FA FF98 361 LEA VEC_LD(pc),a1 * load BASIC program vector
-0000089C 20C9 362 MOVE.l a1,(a0)+ * set vector
-0000089E 363
-0000089E 30C0 364 MOVE.w d0,(a0)+ * V_SAVE JMP opcode
-000008A0 43FA FF96 365 LEA VEC_SV(pc),a1 * save BASIC program vector
-000008A4 20C9 366 MOVE.l a1,(a0)+ * set vector
-000008A6 367
-000008A6 30C0 368 MOVE.w d0,(a0)+ * V_CTLC JMP opcode
-000008A8 43FA 261E 369 LEA VEC_CC(pc),a1 * save CTRL-C check vector
-000008AC 20C9 370 MOVE.l a1,(a0)+ * set vector
-000008AE 371
-000008AE 372 * set-up start values
-000008AE 373
-000008AE 374 *##LAB_GMEM
-000008AE 7000 375 MOVEQ #$00,d0 * clear d0
-000008B0 1740 05E4 376 MOVE.b d0,Nullct(a3) * default NULL count
-000008B4 1740 05E5 377 MOVE.b d0,TPos(a3) * clear terminal position
-000008B8 1740 05E8 378 MOVE.b d0,ccflag(a3) * allow CTRL-C check
-000008BC 3740 07FE 379 MOVE.w d0,prg_strt-2(a3) * clear start word
-000008C0 3740 05D6 380 MOVE.w d0,BHsend(a3) * clear value to string end word
-000008C4 381
-000008C4 177C 0050 05E6 382 MOVE.b #$50,TWidth(a3) * default terminal width byte for simulator
-000008CA 177C 000E 05E2 383 MOVE.b #$0E,TabSiz(a3) * save default tab size = 14
-000008D0 384
-000008D0 177C 0038 05E7 385 MOVE.b #$38,Iclim(a3) * default limit for TAB = 14 for simulator
-000008D6 386
-000008D6 49EB 048E 387 LEA des_sk(a3),a4 * set descriptor stack start
-000008DA 388
-000008DA 41EB 0800 389 LEA prg_strt(a3),a0 * get start of mem
-000008DE 2748 042E 390 MOVE.l a0,Smeml(a3) * save start of mem
-000008E2 391
-000008E2 6100 0322 392 BSR LAB_1463 * do "NEW" and "CLEAR"
-000008E6 6100 0898 393 BSR LAB_CRLF * print CR/LF
-000008EA 202B 044A 394 MOVE.l Ememl(a3),d0 * get end of mem
-000008EE 90AB 042E 395 SUB.l Smeml(a3),d0 * subtract start of mem
-000008F2 396
-000008F2 6100 1BCC 397 BSR LAB_295E * print d0 as unsigned integer (bytes free)
-000008F6 41FA 33EE 398 LEA LAB_SMSG(pc),a0 * point to start message
-000008FA 6100 08E2 399 BSR LAB_18C3 * print null terminated string from memory
-000008FE 400
-000008FE 41FA 29D2 401 LEA LAB_RSED(pc),a0 * get pointer to value
-00000902 6100 1A68 402 BSR LAB_UFAC * unpack memory (a0) into FAC1
-00000906 403
-00000906 41FA 0092 404 LEA LAB_1274(pc),a0 * get warm start vector
-0000090A 2748 0402 405 MOVE.l a0,Wrmjpv(a3) * set warm start vector
-0000090E 6100 1FD2 406 BSR LAB_RND * initialise
-00000912 4EEB 0400 407 JMP LAB_WARM(a3) * go do warm start
-00000916 408
-00000916 409
-00000916 410 *************************************************************************************
-00000916 411 *
-00000916 412 * do format error
-00000916 413
-00000916 414 LAB_FOER
-00000916 7E2C 415 MOVEQ #$2C,d7 * error code $2C "Format" error
-00000918 6056 416 BRA.s LAB_XERR * do error #d7, then warm start
-0000091A 417
-0000091A 418
-0000091A 419 *************************************************************************************
-0000091A 420 *
-0000091A 421 * do address error
-0000091A 422
-0000091A 423 LAB_ADER
-0000091A 7E2A 424 MOVEQ #$2A,d7 * error code $2A "Address" error
-0000091C 6052 425 BRA.s LAB_XERR * do error #d7, then warm start
-0000091E 426
-0000091E 427
-0000091E 428 *************************************************************************************
-0000091E 429 *
-0000091E 430 * do wrong dimensions error
-0000091E 431
-0000091E 432 LAB_WDER
-0000091E 7E28 433 MOVEQ #$28,d7 * error code $28 "Wrong dimensions" error
-00000920 604E 434 BRA.s LAB_XERR * do error #d7, then warm start
-00000922 435
-00000922 436
-00000922 437 *************************************************************************************
-00000922 438 *
-00000922 439 * do undimensioned array error
-00000922 440
-00000922 441 LAB_UDER
-00000922 7E26 442 MOVEQ #$26,d7 * error code $26 "undimensioned array" error
-00000924 604A 443 BRA.s LAB_XERR * do error #d7, then warm start
-00000926 444
-00000926 445
-00000926 446 *************************************************************************************
-00000926 447 *
-00000926 448 * do undefined variable error
-00000926 449
-00000926 450 LAB_UVER
-00000926 451
-00000926 452 * if you do want a non existant variable to return an error then leave the novar
-00000926 453 * value at the top of this file set to zero
-00000926 454
-00000926 TRUE 455 ifeq novar
-00000926 456
-00000926 7E24 457 MOVEQ #$24,d7 * error code $24 "undefined variable" error
-00000928 6046 458 BRA.s LAB_XERR * do error #d7, then warm start
-0000092A 459
-0000092A 460 endc
-0000092A 461
-0000092A 462 * if you want a non existant variable to return a null value then set the novar
-0000092A 463 * value at the top of this file to some non zero value
-0000092A 464
-0000092A FALSE 465 ifne novar
-0000092A 466 endc
-0000092A 467
-0000092A 468
-0000092A 469 *************************************************************************************
-0000092A 470 *
-0000092A 471 * do loop without do error
-0000092A 472
-0000092A 473 LAB_LDER
-0000092A 7E22 474 MOVEQ #$22,d7 * error code $22 "LOOP without DO" error
-0000092C 6042 475 BRA.s LAB_XERR * do error #d7, then warm start
-0000092E 476
-0000092E 477
-0000092E 478 *************************************************************************************
-0000092E 479 *
-0000092E 480 * do undefined function error
-0000092E 481
-0000092E 482 LAB_UFER
-0000092E 7E20 483 MOVEQ #$20,d7 * error code $20 "Undefined function" error
-00000930 603E 484 BRA.s LAB_XERR * do error #d7, then warm start
-00000932 485
-00000932 486
-00000932 487 *************************************************************************************
-00000932 488 *
-00000932 489 * do can't continue error
-00000932 490
-00000932 491 LAB_CCER
-00000932 7E1E 492 MOVEQ #$1E,d7 * error code $1E "Can't continue" error
-00000934 603A 493 BRA.s LAB_XERR * do error #d7, then warm start
-00000936 494
-00000936 495
-00000936 496 *************************************************************************************
-00000936 497 *
-00000936 498 * do string too complex error
-00000936 499
-00000936 500 LAB_SCER
-00000936 7E1C 501 MOVEQ #$1C,d7 * error code $1C "String too complex" error
-00000938 6036 502 BRA.s LAB_XERR * do error #d7, then warm start
-0000093A 503
-0000093A 504
-0000093A 505 *************************************************************************************
-0000093A 506 *
-0000093A 507 * do string too long error
-0000093A 508
-0000093A 509 LAB_SLER
-0000093A 7E1A 510 MOVEQ #$1A,d7 * error code $1A "String too long" error
-0000093C 6032 511 BRA.s LAB_XERR * do error #d7, then warm start
-0000093E 512
-0000093E 513
-0000093E 514 *************************************************************************************
-0000093E 515 *
-0000093E 516 * do type missmatch error
-0000093E 517
-0000093E 518 LAB_TMER
-0000093E 7E18 519 MOVEQ #$18,d7 * error code $18 "Type mismatch" error
-00000940 602E 520 BRA.s LAB_XERR * do error #d7, then warm start
-00000942 521
-00000942 522
-00000942 523 *************************************************************************************
-00000942 524 *
-00000942 525 * do illegal direct error
-00000942 526
-00000942 527 LAB_IDER
-00000942 7E16 528 MOVEQ #$16,d7 * error code $16 "Illegal direct" error
-00000944 602A 529 BRA.s LAB_XERR * do error #d7, then warm start
-00000946 530
-00000946 531
-00000946 532 *************************************************************************************
-00000946 533 *
-00000946 534 * do divide by zero error
-00000946 535
-00000946 536 LAB_DZER
-00000946 7E14 537 MOVEQ #$14,d7 * error code $14 "Divide by zero" error
-00000948 6026 538 BRA.s LAB_XERR * do error #d7, then warm start
-0000094A 539
-0000094A 540
-0000094A 541 *************************************************************************************
-0000094A 542 *
-0000094A 543 * do double dimension error
-0000094A 544
-0000094A 545 LAB_DDER
-0000094A 7E12 546 MOVEQ #$12,d7 * error code $12 "Double dimension" error
-0000094C 6022 547 BRA.s LAB_XERR * do error #d7, then warm start
-0000094E 548
-0000094E 549
-0000094E 550 *************************************************************************************
-0000094E 551 *
-0000094E 552 * do array bounds error
-0000094E 553
-0000094E 554 LAB_ABER
-0000094E 7E10 555 MOVEQ #$10,d7 * error code $10 "Array bounds" error
-00000950 601E 556 BRA.s LAB_XERR * do error #d7, then warm start
-00000952 557
-00000952 558
-00000952 559 *************************************************************************************
-00000952 560 *
-00000952 561 * do undefined satement error
-00000952 562
-00000952 563 LAB_USER
-00000952 7E0E 564 MOVEQ #$0E,d7 * error code $0E "Undefined statement" error
-00000954 601A 565 BRA.s LAB_XERR * do error #d7, then warm start
-00000956 566
-00000956 567
-00000956 568 *************************************************************************************
-00000956 569 *
-00000956 570 * do out of memory error
-00000956 571
-00000956 572 LAB_OMER
-00000956 7E0C 573 MOVEQ #$0C,d7 * error code $0C "Out of memory" error
-00000958 6016 574 BRA.s LAB_XERR * do error #d7, then warm start
-0000095A 575
-0000095A 576
-0000095A 577 *************************************************************************************
-0000095A 578 *
-0000095A 579 * do overflow error
-0000095A 580
-0000095A 581 LAB_OFER
-0000095A 7E0A 582 MOVEQ #$0A,d7 * error code $0A "Overflow" error
-0000095C 6012 583 BRA.s LAB_XERR * do error #d7, then warm start
-0000095E 584
-0000095E 585
-0000095E 586 *************************************************************************************
-0000095E 587 *
-0000095E 588 * do function call error
-0000095E 589
-0000095E 590 LAB_FCER
-0000095E 7E08 591 MOVEQ #$08,d7 * error code $08 "Function call" error
-00000960 600E 592 BRA.s LAB_XERR * do error #d7, then warm start
-00000962 593
-00000962 594
-00000962 595 *************************************************************************************
-00000962 596 *
-00000962 597 * do out of data error
-00000962 598
-00000962 599 LAB_ODER
-00000962 7E06 600 MOVEQ #$06,d7 * error code $06 "Out of DATA" error
-00000964 600A 601 BRA.s LAB_XERR * do error #d7, then warm start
-00000966 602
-00000966 603
-00000966 604 *************************************************************************************
-00000966 605 *
-00000966 606 * do return without gosub error
-00000966 607
-00000966 608 LAB_RGER
-00000966 7E04 609 MOVEQ #$04,d7 * error code $04 "RETURN without GOSUB" error
-00000968 6006 610 BRA.s LAB_XERR * do error #d7, then warm start
-0000096A 611
-0000096A 612
-0000096A 613 *************************************************************************************
-0000096A 614 *
-0000096A 615 * do syntax error
-0000096A 616
-0000096A 617 LAB_SNER
-0000096A 7E02 618 MOVEQ #$02,d7 * error code $02 "Syntax" error
-0000096C 6002 619 BRA.s LAB_XERR * do error #d7, then warm start
-0000096E 620
-0000096E 621
-0000096E 622 *************************************************************************************
-0000096E 623 *
-0000096E 624 * do next without for error
-0000096E 625
-0000096E 626 LAB_NFER
-0000096E 7E00 627 MOVEQ #$00,d7 * error code $00 "NEXT without FOR" error
-00000970 628
-00000970 629
-00000970 630 *************************************************************************************
-00000970 631 *
-00000970 632 * do error #d7, then warm start
-00000970 633
-00000970 634 LAB_XERR
-00000970 6100 02CA 635 BSR LAB_1491 * flush stack & clear continue flag
-00000974 6100 080A 636 BSR LAB_CRLF * print CR/LF
-00000978 43FA 2FE4 637 LEA LAB_BAER(pc),a1 * start of error message pointer table
-0000097C 3E31 7000 638 MOVE.w (a1,d7.w),d7 * get error message offset
-00000980 41F1 7000 639 LEA (a1,d7.w),a0 * get error message address
-00000984 6100 0858 640 BSR LAB_18C3 * print null terminated string from memory
-00000988 41FA 331F 641 LEA LAB_EMSG(pc),a0 * point to " Error" message
-0000098C 642 LAB_1269
-0000098C 6100 0850 643 BSR LAB_18C3 * print null terminated string from memory
-00000990 202B 0452 644 MOVE.l Clinel(a3),d0 * get current line
-00000994 6B04 645 BMI.s LAB_1274 * go do warm start if -ve # (was immediate mode)
-00000996 646
-00000996 647 * else print line number
-00000996 6100 1B1C 648 BSR LAB_2953 * print " in line [LINE #]"
-0000099A 649
-0000099A 650 * BASIC warm start entry point, wait for Basic command
-0000099A 651
-0000099A 652 LAB_1274
-0000099A 41FA 3340 653 LEA LAB_RMSG(pc),a0 * point to "Ready" message
-0000099E 6100 083E 654 BSR LAB_18C3 * go do print string
-000009A2 655
-000009A2 656 * wait for Basic command - no "Ready"
-000009A2 657
-000009A2 658 LAB_127D
-000009A2 72FF 659 MOVEQ #-1,d1 * set to -1
-000009A4 2741 0452 660 MOVE.l d1,Clinel(a3) * set current line #
-000009A8 1741 05DC 661 MOVE.b d1,Breakf(a3) * set break flag
-000009AC 4BEB 0490 662 LEA Ibuffs(a3),a5 * set basic execute pointer ready for new line
-000009B0 663 LAB_127E
-000009B0 6100 00EC 664 BSR LAB_1357 * call for BASIC input
-000009B4 6100 0BF4 665 BSR LAB_GBYT * scan memory
-000009B8 67F6 666 BEQ.s LAB_127E * loop while null
-000009BA 667
-000009BA 668 * got to interpret input line now ....
-000009BA 669
-000009BA 6508 670 BCS.s LAB_1295 * branch if numeric character, handle new
-000009BC 671 * BASIC line
-000009BC 672
-000009BC 673 * no line number so do immediate mode, a5
-000009BC 674 * points to the buffer start
-000009BC 6100 0156 675 BSR LAB_13A6 * crunch keywords into Basic tokens
-000009C0 676 * crunch from (a5), output to (a0)
-000009C0 677 * returns ..
-000009C0 678 * d2 is length, d1 trashed, d0 trashed,
-000009C0 679 * a1 trashed
-000009C0 6000 03C4 680 BRA LAB_15F6 * go scan & interpret code
-000009C4 681
-000009C4 682
-000009C4 683 *************************************************************************************
-000009C4 684 *
-000009C4 685 * handle a new BASIC line
-000009C4 686
-000009C4 687 LAB_1295
-000009C4 6100 063A 688 BSR LAB_GFPN * get fixed-point number into temp integer & d1
-000009C8 6100 014A 689 BSR LAB_13A6 * crunch keywords into Basic tokens
-000009CC 690 * crunch from (a5), output to (a0)
-000009CC 691 * returns .. d2 is length,
-000009CC 692 * d1 trashed, d0 trashed, a1 trashed
-000009CC 222B 042A 693 MOVE.l Itemp(a3),d1 * get required line #
-000009D0 6100 0218 694 BSR LAB_SSLN * search BASIC for d1 line number
-000009D4 695 * returns pointer in a0
-000009D4 6532 696 BCS.s LAB_12E6 * branch if not found
-000009D6 697
-000009D6 698 * aroooogah! line # already exists! delete it
-000009D6 2250 699 MOVEA.l (a0),a1 * get start of block (next line pointer)
-000009D8 202B 0432 700 MOVE.l Sfncl(a3),d0 * get end of block (start of functions)
-000009DC 9089 701 SUB.l a1,d0 * subtract start of block ( = bytes to move)
-000009DE E288 702 LSR.l #1,d0 * /2 (word move)
-000009E0 5380 703 SUBQ.l #1,d0 * adjust for DBF loop
-000009E2 4840 704 SWAP d0 * swap high word to low word
-000009E4 2448 705 MOVEA.l a0,a2 * copy destination
-000009E6 706 LAB_12AE
-000009E6 4840 707 SWAP d0 * swap high word to low word
-000009E8 708 LAB_12B0
-000009E8 34D9 709 MOVE.w (a1)+,(a2)+ * copy word
-000009EA 51C8 FFFC 710 DBF d0,LAB_12B0 * decrement low count and loop until done
-000009EE 711
-000009EE 4840 712 SWAP d0 * swap high word to low word
-000009F0 51C8 FFF4 713 DBF d0,LAB_12AE * decrement high count and loop until done
-000009F4 714
-000009F4 274A 0432 715 MOVE.l a2,Sfncl(a3) * start of functions
-000009F8 274A 0436 716 MOVE.l a2,Svarl(a3) * save start of variables
-000009FC 274A 043A 717 MOVE.l a2,Sstrl(a3) * start of strings
-00000A00 274A 043E 718 MOVE.l a2,Sarryl(a3) * save start of arrays
-00000A04 274A 0442 719 MOVE.l a2,Earryl(a3) * save end of arrays
-00000A08 720
-00000A08 721 * got new line in buffer and no existing same #
-00000A08 722 LAB_12E6
-00000A08 102B 0490 723 MOVE.b Ibuffs(a3),d0 * get byte from start of input buffer
-00000A0C 6764 724 BEQ.s LAB_1325 * if null line go do line chaining
-00000A0E 725
-00000A0E 726 * got new line and it isn't empty line
-00000A0E 226B 0432 727 MOVEA.l Sfncl(a3),a1 * get start of functions (end of block to move)
-00000A12 45F1 2008 728 LEA 8(a1,d2),a2 * copy it, add line length and add room for
-00000A16 729 * pointer and line number
-00000A16 730
-00000A16 274A 0432 731 MOVE.l a2,Sfncl(a3) * start of functions
-00000A1A 274A 0436 732 MOVE.l a2,Svarl(a3) * save start of variables
-00000A1E 274A 043A 733 MOVE.l a2,Sstrl(a3) * start of strings
-00000A22 274A 043E 734 MOVE.l a2,Sarryl(a3) * save start of arrays
-00000A26 274A 0442 735 MOVE.l a2,Earryl(a3) * save end of arrays
-00000A2A 276B 044A 0446 736 MOVE.l Ememl(a3),Sstorl(a3) * copy end of mem to start of strings, clear
-00000A30 737 * strings
-00000A30 738
-00000A30 2209 739 MOVE.l a1,d1 * copy end of block to move
-00000A32 9288 740 SUB.l a0,d1 * subtract start of block to move
-00000A34 E289 741 LSR.l #1,d1 * /2 (word copy)
-00000A36 5381 742 SUBQ.l #1,d1 * correct for loop end on -1
-00000A38 4841 743 SWAP d1 * swap high word to low word
-00000A3A 744 LAB_12FF
-00000A3A 4841 745 SWAP d1 * swap high word to low word
-00000A3C 746 LAB_1301
-00000A3C 3521 747 MOVE.w -(a1),-(a2) * decrement pointers and copy word
-00000A3E 51C9 FFFC 748 DBF d1,LAB_1301 * decrement & loop
-00000A42 749
-00000A42 4841 750 SWAP d1 * swap high word to low word
-00000A44 51C9 FFF4 751 DBF d1,LAB_12FF * decrement high count and loop until done
-00000A48 752
-00000A48 753 * space is opened up, now copy the crunched line from the input buffer into the space
-00000A48 754
-00000A48 43EB 0490 755 LEA Ibuffs(a3),a1 * source is input buffer
-00000A4C 2448 756 MOVEA.l a0,a2 * copy destination
-00000A4E 72FF 757 MOVEQ #-1,d1 * set to allow re-chaining
-00000A50 24C1 758 MOVE.l d1,(a2)+ * set next line pointer (allow re-chaining)
-00000A52 24EB 042A 759 MOVE.l Itemp(a3),(a2)+ * save line number
-00000A56 E24A 760 LSR.w #1,d2 * /2 (word copy)
-00000A58 5342 761 SUBQ.w #1,d2 * correct for loop end on -1
-00000A5A 762 LAB_1303
-00000A5A 34D9 763 MOVE.w (a1)+,(a2)+ * copy word
-00000A5C 51CA FFFC 764 DBF d2,LAB_1303 * decrement & loop
-00000A60 765
-00000A60 6010 766 BRA.s LAB_1325 * go test for end of prog
-00000A62 767
-00000A62 768 * rebuild chaining of BASIC lines
-00000A62 769
-00000A62 770 LAB_132E
-00000A62 5048 771 ADDQ.w #8,a0 * point to first code byte of line, there is
-00000A64 772 * always 1 byte + [EOL] as null entries are
-00000A64 773 * deleted
-00000A64 774 LAB_1330
-00000A64 4A18 775 TST.b (a0)+ * test byte
-00000A66 66FC 776 BNE.s LAB_1330 * loop if not [EOL]
-00000A68 777
-00000A68 778 * was [EOL] so get next line start
-00000A68 3208 779 MOVE.w a0,d1 * past pad byte(s)
-00000A6A 0241 0001 780 ANDI.w #1,d1 * mask odd bit
-00000A6E D0C1 781 ADD.w d1,a0 * add back to ensure even
-00000A70 2288 782 MOVE.l a0,(a1) * save next line pointer to current line
-00000A72 783 LAB_1325
-00000A72 2248 784 MOVEA.l a0,a1 * copy pointer for this line
-00000A74 4A90 785 TST.l (a0) * test pointer to next line
-00000A76 66EA 786 BNE.s LAB_132E * not end of program yet so we must
-00000A78 787 * go and fix the pointers
-00000A78 788
-00000A78 6100 0198 789 BSR LAB_1477 * reset execution to start, clear variables
-00000A7C 790 * and flush stack
-00000A7C 6000 FF24 791 BRA LAB_127D * now we just wait for Basic command, no "Ready"
-00000A80 792
-00000A80 793
-00000A80 794 *************************************************************************************
-00000A80 795 *
-00000A80 796 * receive a line from the keyboard
-00000A80 797 * character $08 as delete key, BACKSPACE on
-00000A80 798 * standard keyboard
-00000A80 799 LAB_134B
-00000A80 6100 0776 800 BSR LAB_PRNA * go print the character
-00000A84 7020 801 MOVEQ #' ',d0 * load [SPACE]
-00000A86 6100 0770 802 BSR LAB_PRNA * go print
-00000A8A 7008 803 MOVEQ #$08,d0 * load [BACKSPACE]
-00000A8C 6100 076A 804 BSR LAB_PRNA * go print
-00000A90 5341 805 SUBQ.w #$01,d1 * decrement the buffer index (delete)
-00000A92 6010 806 BRA.s LAB_1359 * re-enter loop
-00000A94 807
-00000A94 808 * print "? " and get BASIC input
-00000A94 809 * return a0 pointing to the buffer start
-00000A94 810
-00000A94 811 LAB_INLN
-00000A94 6100 0760 812 BSR LAB_18E3 * print "?" character
-00000A98 7020 813 MOVEQ #' ',d0 * load " "
-00000A9A 6100 075C 814 BSR LAB_PRNA * go print
-00000A9E 815
-00000A9E 816 * call for BASIC input (main entry point)
-00000A9E 817 * return a0 pointing to the buffer start
-00000A9E 818
-00000A9E 819 LAB_1357
-00000A9E 7200 820 MOVEQ #$00,d1 * clear buffer index
-00000AA0 41EB 0490 821 LEA Ibuffs(a3),a0 * set buffer base pointer
-00000AA4 822 LAB_1359
-00000AA4 4EAB 040C 823 JSR V_INPT(a3) * call scan input device
-00000AA8 64FA 824 BCC.s LAB_1359 * loop if no byte
-00000AAA 825
-00000AAA 67F8 826 BEQ.s LAB_1359 * loop if null byte
-00000AAC 827
-00000AAC B03C 0007 828 CMP.b #$07,d0 * compare with [BELL]
-00000AB0 6718 829 BEQ.s LAB_1378 * branch if [BELL]
-00000AB2 830
-00000AB2 B03C 000D 831 CMP.b #$0D,d0 * compare with [CR]
-00000AB6 6700 06C2 832 BEQ LAB_1866 * do CR/LF exit if [CR]
-00000ABA 833
-00000ABA 4A41 834 TST.w d1 * set flags on buffer index
-00000ABC 6606 835 BNE.s LAB_1374 * branch if not empty
-00000ABE 836
-00000ABE 837 * the next two lines ignore any non printing character and [SPACE] if the input buffer
-00000ABE 838 * is empty
-00000ABE 839
-00000ABE B03C 0020 840 CMP.b #' ',d0 * compare with [SP]+1
-00000AC2 63E0 841 BLS.s LAB_1359 * if < ignore character
-00000AC4 842
-00000AC4 843 *## CMP.b #' '+1,d0 * compare with [SP]+1
-00000AC4 844 *## BCS.s LAB_1359 * if < ignore character
-00000AC4 845
-00000AC4 846 LAB_1374
-00000AC4 B03C 0008 847 CMP.b #$08,d0 * compare with [BACKSPACE]
-00000AC8 67B6 848 BEQ.s LAB_134B * go delete last character
-00000ACA 849
-00000ACA 850 LAB_1378
-00000ACA B27C 00FF 851 CMP.w #(Ibuffe-Ibuffs-1),d1 * compare character count with max-1
-00000ACE 640C 852 BCC.s LAB_138E * skip store & do [BELL] if buffer full
-00000AD0 853
-00000AD0 1180 1000 854 MOVE.b d0,(a0,d1.w) * else store in buffer
-00000AD4 5241 855 ADDQ.w #$01,d1 * increment index
-00000AD6 856 LAB_137F
-00000AD6 6100 0720 857 BSR LAB_PRNA * go print the character
-00000ADA 60C8 858 BRA.s LAB_1359 * always loop for next character
-00000ADC 859
-00000ADC 860 * announce buffer full
-00000ADC 861
-00000ADC 862 LAB_138E
-00000ADC 7007 863 MOVEQ #$07,d0 * [BELL] character into d0
-00000ADE 60F6 864 BRA.s LAB_137F * go print the [BELL] but ignore input character
-00000AE0 865
-00000AE0 866
-00000AE0 867 *************************************************************************************
-00000AE0 868 *
-00000AE0 869 * copy a hex value without crunching
-00000AE0 870
-00000AE0 871 LAB_1392
-00000AE0 1180 2000 872 MOVE.b d0,(a0,d2.w) * save the byte to the output
-00000AE4 5242 873 ADDQ.w #1,d2 * increment the buffer save index
-00000AE6 874
-00000AE6 5241 875 ADDQ.w #1,d1 * increment the buffer read index
-00000AE8 1035 1000 876 MOVE.b (a5,d1.w),d0 * get a byte from the input buffer
-00000AEC 6700 0094 877 BEQ LAB_13EC * if [EOL] go save it without crunching
-00000AF0 878
-00000AF0 B03C 0020 879 CMP.b #' ',d0 * compare the character with " "
-00000AF4 67EA 880 BEQ.s LAB_1392 * if [SPACE] just go save it and get another
-00000AF6 881
-00000AF6 B03C 0030 882 CMP.b #'0',d0 * compare the character with "0"
-00000AFA 654A 883 BCS.s LAB_13C6 * if < "0" quit the hex save loop
-00000AFC 884
-00000AFC B03C 0039 885 CMP.b #'9',d0 * compare with "9"
-00000B00 63DE 886 BLS.s LAB_1392 * if it is "0" to "9" save it and get another
-00000B02 887
-00000B02 7ADF 888 MOVEQ #-33,d5 * mask xx0x xxxx, ASCII upper case
-00000B04 CA00 889 AND.b d0,d5 * mask the character
-00000B06 890
-00000B06 BA3C 0041 891 CMP.b #'A',d5 * compare with "A"
-00000B0A 6540 892 BCS.s LAB_13CC * if < "A" quit the hex save loop
-00000B0C 893
-00000B0C BA3C 0046 894 CMP.b #'F',d5 * compare with "F"
-00000B10 63CE 895 BLS.s LAB_1392 * if it is "A" to "F" save it and get another
-00000B12 896
-00000B12 6038 897 BRA.s LAB_13CC * else continue crunching
-00000B14 898
-00000B14 899 * crunch keywords into Basic tokens
-00000B14 900 * crunch from (a5), output to (a0)
-00000B14 901 * returns ..
-00000B14 902 * d4 trashed
-00000B14 903 * d3 trashed
-00000B14 904 * d2 is length
-00000B14 905 * d1 trashed
-00000B14 906 * d0 trashed
-00000B14 907 * a1 trashed
-00000B14 908
-00000B14 909 * this is the improved BASIC crunch routine and is 10 to 100 times faster than the
-00000B14 910 * old list search
-00000B14 911
-00000B14 912 LAB_13A6
-00000B14 7200 913 MOVEQ #0,d1 * clear the read index
-00000B16 2401 914 MOVE.l d1,d2 * clear the save index
-00000B18 1741 05DD 915 MOVE.b d1,Oquote(a3) * clear the open quote/DATA flag
-00000B1C 916 LAB_13AC
-00000B1C 7000 917 MOVEQ #0,d0 * clear word
-00000B1E 1035 1000 918 MOVE.b (a5,d1.w),d0 * get byte from input buffer
-00000B22 675E 919 BEQ.s LAB_13EC * if null save byte then continue crunching
-00000B24 920
-00000B24 B03C 005F 921 CMP.b #'_',d0 * compare with "_"
-00000B28 6458 922 BCC.s LAB_13EC * if >= "_" save byte then continue crunching
-00000B2A 923
-00000B2A B03C 003C 924 CMP.b #'<',d0 * compare with "<"
-00000B2E 641C 925 BCC.s LAB_13CC * if >= "<" go crunch
-00000B30 926
-00000B30 B03C 0030 927 CMP.b #'0',d0 * compare with "0"
-00000B34 644C 928 BCC.s LAB_13EC * if >= "0" save byte then continue crunching
-00000B36 929
-00000B36 1740 05DA 930 MOVE.b d0,Asrch(a3) * save buffer byte as search character
-00000B3A B03C 0022 931 CMP.b #$22,d0 * is it quote character?
-00000B3E 6776 932 BEQ.s LAB_1410 * branch if so (copy quoted string)
-00000B40 933
-00000B40 B03C 0024 934 CMP.b #'$',d0 * is it the hex value character?
-00000B44 679A 935 BEQ.s LAB_1392 * if so go copy a hex value
-00000B46 936
-00000B46 937 LAB_13C6
-00000B46 B03C 002A 938 CMP.b #'*',d0 * compare with "*"
-00000B4A 6536 939 BCS.s LAB_13EC * if <= "*" save byte then continue crunching
-00000B4C 940
-00000B4C 941 * crunch rest
-00000B4C 942 LAB_13CC
-00000B4C 082B 0006 05DD 943 BTST.b #6,Oquote(a3) * test open quote/DATA token flag
-00000B52 662E 944 BNE.s LAB_13EC * branch if b6 of Oquote set (was DATA)
-00000B54 945 * go save byte then continue crunching
-00000B54 946
-00000B54 0400 002A 947 SUB.b #$2A,d0 * normalise byte
-00000B58 D040 948 ADD.w d0,d0 * *2 makes word offset (high byte=$00)
-00000B5A 43FA 2C04 949 LEA TAB_CHRT(pc),a1 * get keyword offset table address
-00000B5E 3031 0000 950 MOVE.w (a1,d0.w),d0 * get offset into keyword table
-00000B62 6B6E 951 BMI.s LAB_141F * branch if no keywords for character
-00000B64 952
-00000B64 43FA 2F90 953 LEA TAB_STAR(pc),a1 * get keyword table address
-00000B68 D2C0 954 ADDA.w d0,a1 * add keyword offset
-00000B6A 76FF 955 MOVEQ #-1,d3 * clear index
-00000B6C 3801 956 MOVE.w d1,d4 * copy read index
-00000B6E 957 LAB_13D6
-00000B6E 5243 958 ADDQ.w #1,d3 * increment table index
-00000B70 1031 3000 959 MOVE.b (a1,d3.w),d0 * get byte from table
-00000B74 960 LAB_13D8
-00000B74 6B0A 961 BMI.s LAB_13EA * branch if token, save token and continue
-00000B76 962 * crunching
-00000B76 963
-00000B76 5244 964 ADDQ.w #1,d4 * increment read index
-00000B78 B035 4000 965 CMP.b (a5,d4.w),d0 * compare byte from input buffer
-00000B7C 67F0 966 BEQ.s LAB_13D6 * loop if character match
-00000B7E 967
-00000B7E 6040 968 BRA.s LAB_1417 * branch if no match
-00000B80 969
-00000B80 970 LAB_13EA
-00000B80 3204 971 MOVE.w d4,d1 * update read index
-00000B82 972 LAB_13EC
-00000B82 1180 2000 973 MOVE.b d0,(a0,d2.w) * save byte to output
-00000B86 5242 974 ADDQ.w #1,d2 * increment buffer save index
-00000B88 5241 975 ADDQ.w #1,d1 * increment buffer read index
-00000B8A 4A00 976 TST.b d0 * set flags
-00000B8C 674A 977 BEQ.s LAB_142A * branch if was null [EOL]
-00000B8E 978
-00000B8E 979 * d0 holds token or byte here
-00000B8E 0400 003A 980 SUB.b #$3A,d0 * subtract ":"
-00000B92 6706 981 BEQ.s LAB_13FF * branch if it was ":" (is now $00)
-00000B94 982
-00000B94 983 * d0 now holds token-$3A
-00000B94 B03C 0049 984 CMP.b #(TK_DATA-$3A),d0 * compare with DATA token - $3A
-00000B98 6604 985 BNE.s LAB_1401 * branch if not DATA
-00000B9A 986
-00000B9A 987 * token was : or DATA
-00000B9A 988 LAB_13FF
-00000B9A 1740 05DD 989 MOVE.b d0,Oquote(a3) * save token-$3A ($00 for ":", TK_DATA-$3A for
-00000B9E 990 * DATA)
-00000B9E 991 LAB_1401
-00000B9E 0400 0055 992 SUB.b #(TK_REM-$3A),d0 * subtract REM token offset
-00000BA2 6600 FF78 993 BNE LAB_13AC * If wasn't REM then go crunch rest of line
-00000BA6 994
-00000BA6 1740 05DA 995 MOVE.b d0,Asrch(a3) * else was REM so set search for [EOL]
-00000BAA 996
-00000BAA 997 * loop for REM, "..." etc.
-00000BAA 998 LAB_1408
-00000BAA 1035 1000 999 MOVE.b (a5,d1.w),d0 * get byte from input buffer
-00000BAE 67D2 1000 BEQ.s LAB_13EC * branch if null [EOL]
-00000BB0 1001
-00000BB0 B02B 05DA 1002 CMP.b Asrch(a3),d0 * compare with stored character
-00000BB4 67CC 1003 BEQ.s LAB_13EC * branch if match (end quote, REM, :, or DATA)
-00000BB6 1004
-00000BB6 1005 * entry for copy string in quotes, don't crunch
-00000BB6 1006 LAB_1410
-00000BB6 1180 2000 1007 MOVE.b d0,(a0,d2.w) * save byte to output
-00000BBA 5242 1008 ADDQ.w #1,d2 * increment buffer save index
-00000BBC 5241 1009 ADDQ.w #1,d1 * increment buffer read index
-00000BBE 60EA 1010 BRA.s LAB_1408 * loop
-00000BC0 1011
-00000BC0 1012 * not found keyword this go so find the end of this word in the table
-00000BC0 1013
-00000BC0 1014 LAB_1417
-00000BC0 3801 1015 MOVE.w d1,d4 * reset read pointer
-00000BC2 1016 LAB_141B
-00000BC2 5243 1017 ADDQ.w #1,d3 * increment keyword table pointer, flag
-00000BC4 1018 * unchanged
-00000BC4 1031 3000 1019 MOVE.b (a1,d3.w),d0 * get keyword table byte
-00000BC8 6AF8 1020 BPL.s LAB_141B * if not end of keyword go do next byte
-00000BCA 1021
-00000BCA 5243 1022 ADDQ.w #1,d3 * increment keyword table pointer flag
-00000BCC 1023 * unchanged
-00000BCC 1031 3000 1024 MOVE.b (a1,d3.w),d0 * get keyword table byte
-00000BD0 66A2 1025 BNE.s LAB_13D8 * go test next word if not zero byte (table end)
-00000BD2 1026
-00000BD2 1027 * reached end of table with no match
-00000BD2 1028 LAB_141F
-00000BD2 1035 1000 1029 MOVE.b (a5,d1.w),d0 * restore byte from input buffer
-00000BD6 60AA 1030 BRA.s LAB_13EC * go save byte in output and continue crunching
-00000BD8 1031
-00000BD8 1032 * reached [EOL]
-00000BD8 1033 LAB_142A
-00000BD8 7000 1034 MOVEQ #0,d0 * ensure longword clear
-00000BDA 0102 1035 BTST d0,d2 * test odd bit (fastest)
-00000BDC 6706 1036 BEQ.s LAB_142C * branch if no bytes to fill
-00000BDE 1037
-00000BDE 1180 2000 1038 MOVE.b d0,(a0,d2.w) * clear next byte
-00000BE2 5242 1039 ADDQ.w #1,d2 * increment buffer save index
-00000BE4 1040 LAB_142C
-00000BE4 2180 2000 1041 MOVE.l d0,(a0,d2.w) * clear next line pointer, EOT in immediate mode
-00000BE8 4E75 1042 RTS
-00000BEA 1043
-00000BEA 1044
-00000BEA 1045 *************************************************************************************
-00000BEA 1046 *
-00000BEA 1047 * search Basic for d1 line number from start of mem
-00000BEA 1048
-00000BEA 1049 LAB_SSLN
-00000BEA 206B 042E 1050 MOVEA.l Smeml(a3),a0 * get start of program mem
-00000BEE 6002 1051 BRA.s LAB_SCLN * go search for required line from a0
-00000BF0 1052
-00000BF0 1053 LAB_145F
-00000BF0 2040 1054 MOVEA.l d0,a0 * copy next line pointer
-00000BF2 1055
-00000BF2 1056 * search Basic for d1 line number from a0
-00000BF2 1057 * returns Cb=0 if found
-00000BF2 1058 * returns a0 pointer to found or next higher (not found) line
-00000BF2 1059
-00000BF2 1060 LAB_SCLN
-00000BF2 2018 1061 MOVE.l (a0)+,d0 * get next line pointer and point to line #
-00000BF4 6708 1062 BEQ.s LAB_145E * is end marker so we're done, do 'no line' exit
-00000BF6 1063
-00000BF6 B290 1064 CMP.l (a0),d1 * compare this line # with required line #
-00000BF8 6EF6 1065 BGT.s LAB_145F * loop if required # > this #
-00000BFA 1066
-00000BFA 5948 1067 SUBQ.w #4,a0 * adjust pointer, flags not changed
-00000BFC 4E75 1068 RTS
-00000BFE 1069
-00000BFE 1070 LAB_145E
-00000BFE 5948 1071 SUBQ.w #4,a0 * adjust pointer, flags not changed
-00000C00 5380 1072 SUBQ.l #1,d0 * make end program found = -1, set carry
-00000C02 4E75 1073 RTS
-00000C04 1074
-00000C04 1075
-00000C04 1076 *************************************************************************************
-00000C04 1077 *
-00000C04 1078 * perform NEW
-00000C04 1079
-00000C04 1080 LAB_NEW
-00000C04 664C 1081 BNE.s RTS_005 * exit if not end of statement (do syntax error)
-00000C06 1082
-00000C06 1083 LAB_1463
-00000C06 206B 042E 1084 MOVEA.l Smeml(a3),a0 * point to start of program memory
-00000C0A 7000 1085 MOVEQ #0,d0 * clear longword
-00000C0C 20C0 1086 MOVE.l d0,(a0)+ * clear first line, next line pointer
-00000C0E 2748 0432 1087 MOVE.l a0,Sfncl(a3) * set start of functions
-00000C12 1088
-00000C12 1089 * reset execution to start, clear variables and flush stack
-00000C12 1090
-00000C12 1091 LAB_1477
-00000C12 2A6B 042E 1092 MOVEA.l Smeml(a3),a5 * reset BASIC execute pointer
-00000C16 534D 1093 SUBQ.w #1,a5 * -1 (as end of previous line)
-00000C18 1094
-00000C18 1095 * "CLEAR" command gets here
-00000C18 1096
-00000C18 1097 LAB_147A
-00000C18 276B 044A 0446 1098 MOVE.l Ememl(a3),Sstorl(a3) * save end of mem as bottom of string space
-00000C1E 202B 0432 1099 MOVE.l Sfncl(a3),d0 * get start of functions
-00000C22 2740 0436 1100 MOVE.l d0,Svarl(a3) * start of variables
-00000C26 2740 043A 1101 MOVE.l d0,Sstrl(a3) * start of strings
-00000C2A 2740 043E 1102 MOVE.l d0,Sarryl(a3) * set start of arrays
-00000C2E 2740 0442 1103 MOVE.l d0,Earryl(a3) * set end of arrays
-00000C32 1104 LAB_1480
-00000C32 7000 1105 MOVEQ #0,d0 * set Zb
-00000C34 1740 05EA 1106 MOVE.b d0,ccnull(a3) * clear get byte countdown
-00000C38 6100 01CE 1107 BSR LAB_RESTORE * perform RESTORE command
-00000C3C 1108
-00000C3C 1109 * flush stack & clear continue flag
-00000C3C 1110
-00000C3C 1111 LAB_1491
-00000C3C 49EB 048E 1112 LEA des_sk(a3),a4 * reset descriptor stack pointer
-00000C40 1113
-00000C40 201F 1114 MOVE.l (sp)+,d0 * pull return address
-00000C42 4FEB 0400 1115 LEA ram_base(a3),sp * set stack to RAM start + 1k, flush stack
-00000C46 2F00 1116 MOVE.l d0,-(sp) * restore return address
-00000C48 1117
-00000C48 7000 1118 MOVEQ #0,d0 * clear longword
-00000C4A 2740 045A 1119 MOVE.l d0,Cpntrl(a3) * clear continue pointer
-00000C4E 1740 05DF 1120 MOVE.b d0,Sufnxf(a3) * clear subscript/FNX flag
-00000C52 1121 RTS_005
-00000C52 4E75 1122 RTS
-00000C54 1123
-00000C54 1124
-00000C54 1125 *************************************************************************************
-00000C54 1126 *
-00000C54 1127 * perform CLEAR
-00000C54 1128
-00000C54 1129 LAB_CLEAR
-00000C54 67C2 1130 BEQ.s LAB_147A * if no following byte go do "CLEAR"
-00000C56 1131
-00000C56 4E75 1132 RTS * was following byte (go do syntax error)
-00000C58 1133
-00000C58 1134
-00000C58 1135 *************************************************************************************
-00000C58 1136 *
-00000C58 1137 * perform LIST [n][-m]
-00000C58 1138
-00000C58 1139 LAB_LIST
-00000C58 6512 1140 BCS.s LAB_14BD * branch if next character numeric (LIST n...)
-00000C5A 1141
-00000C5A 72FF 1142 MOVEQ #-1,d1 * set end to $FFFFFFFF
-00000C5C 2741 042A 1143 MOVE.l d1,Itemp(a3) * save to Itemp
-00000C60 1144
-00000C60 7200 1145 MOVEQ #0,d1 * set start to $00000000
-00000C62 4A00 1146 TST.b d0 * test next byte
-00000C64 670A 1147 BEQ.s LAB_14C0 * branch if next character [NULL] (LIST)
-00000C66 1148
-00000C66 B03C 00B3 1149 CMP.b #TK_MINUS,d0 * compare with token for -
-00000C6A 66E6 1150 BNE.s RTS_005 * exit if not - (LIST -m)
-00000C6C 1151
-00000C6C 1152 * LIST [[n]-[m]] this sets the n, if present,
-00000C6C 1153 * as the start and end
-00000C6C 1154 LAB_14BD
-00000C6C 6100 0392 1155 BSR LAB_GFPN * get fixed-point number into temp integer & d1
-00000C70 1156 LAB_14C0
-00000C70 6100 FF78 1157 BSR LAB_SSLN * search BASIC for d1 line number
-00000C74 1158 * (pointer in a0)
-00000C74 6100 0934 1159 BSR LAB_GBYT * scan memory
-00000C78 6716 1160 BEQ.s LAB_14D4 * branch if no more characters
-00000C7A 1161
-00000C7A 1162 * this bit checks the - is present
-00000C7A B03C 00B3 1163 CMP.b #TK_MINUS,d0 * compare with token for -
-00000C7E 66D2 1164 BNE.s RTS_005 * return if not "-" (will be Syntax error)
-00000C80 1165
-00000C80 72FF 1166 MOVEQ #-1,d1 * set end to $FFFFFFFF
-00000C82 2741 042A 1167 MOVE.l d1,Itemp(a3) * save Itemp
-00000C86 1168
-00000C86 1169 * LIST [n]-[m] the - was there so see if
-00000C86 1170 * there is an m to set as the end value
-00000C86 6100 0920 1171 BSR LAB_IGBY * increment & scan memory
-00000C8A 6704 1172 BEQ.s LAB_14D4 * branch if was [NULL] (LIST n-)
-00000C8C 1173
-00000C8C 6100 0372 1174 BSR LAB_GFPN * get fixed-point number into temp integer & d1
-00000C90 1175 LAB_14D4
-00000C90 177C 0000 05DD 1176 MOVE.b #$00,Oquote(a3) * clear open quote flag
-00000C96 6100 04E8 1177 BSR LAB_CRLF * print CR/LF
-00000C9A 2018 1178 MOVE.l (a0)+,d0 * get next line pointer
-00000C9C 67B4 1179 BEQ.s RTS_005 * if null all done so exit
-00000C9E 1180
-00000C9E 2240 1181 MOVEA.l d0,a1 * copy next line pointer
-00000CA0 6100 012C 1182 BSR LAB_1629 * do CRTL-C check vector
-00000CA4 1183
-00000CA4 2018 1184 MOVE.l (a0)+,d0 * get this line #
-00000CA6 B0AB 042A 1185 CMP.l Itemp(a3),d0 * compare end line # with this line #
-00000CAA 62A6 1186 BHI.s RTS_005 * if this line greater all done so exit
-00000CAC 1187
-00000CAC 1188 LAB_14E2
-00000CAC 48E7 00C0 1189 MOVEM.l a0-a1,-(sp) * save registers
-00000CB0 6100 180E 1190 BSR LAB_295E * print d0 as unsigned integer
-00000CB4 4CDF 0300 1191 MOVEM.l (sp)+,a0-a1 * restore registers
-00000CB8 7020 1192 MOVEQ #$20,d0 * space is the next character
-00000CBA 1193 LAB_150C
-00000CBA 6100 053C 1194 BSR LAB_PRNA * go print the character
-00000CBE B03C 0022 1195 CMP.b #$22,d0 * was it " character
-00000CC2 6606 1196 BNE.s LAB_1519 * branch if not
-00000CC4 1197
-00000CC4 1198 * we're either entering or leaving quotes
-00000CC4 0A2B 00FF 05DD 1199 EOR.b #$FF,Oquote(a3) * toggle open quote flag
-00000CCA 1200 LAB_1519
-00000CCA 1018 1201 MOVE.b (a0)+,d0 * get byte and increment pointer
-00000CCC 6608 1202 BNE.s LAB_152E * branch if not [EOL] (go print)
-00000CCE 1203
-00000CCE 1204 * was [EOL]
-00000CCE 2049 1205 MOVEA.l a1,a0 * copy next line pointer
-00000CD0 2008 1206 MOVE.l a0,d0 * copy to set flags
-00000CD2 66BC 1207 BNE.s LAB_14D4 * go do next line if not [EOT]
-00000CD4 1208
-00000CD4 4E75 1209 RTS
-00000CD6 1210
-00000CD6 1211 LAB_152E
-00000CD6 6AE2 1212 BPL.s LAB_150C * just go print it if not token byte
-00000CD8 1213
-00000CD8 1214 * else it was a token byte so maybe uncrunch it
-00000CD8 4A2B 05DD 1215 TST.b Oquote(a3) * test the open quote flag
-00000CDC 6BDC 1216 BMI.s LAB_150C * just go print character if open quote set
-00000CDE 1217
-00000CDE 1218 * else uncrunch BASIC token
-00000CDE 45FA 2AEA 1219 LEA LAB_KEYT(pc),a2 * get keyword table address
-00000CE2 727F 1220 MOVEQ #$7F,d1 * mask into d1
-00000CE4 C200 1221 AND.b d0,d1 * copy and mask token
-00000CE6 E549 1222 LSL.w #2,d1 * *4
-00000CE8 45F2 1000 1223 LEA (a2,d1.w),a2 * get keyword entry address
-00000CEC 101A 1224 MOVE.b (a2)+,d0 * get byte from keyword table
-00000CEE 6100 0508 1225 BSR LAB_PRNA * go print the first character
-00000CF2 7200 1226 MOVEQ #0,d1 * clear d1
-00000CF4 121A 1227 MOVE.b (a2)+,d1 * get remaining length byte from keyword table
-00000CF6 6BD2 1228 BMI.s LAB_1519 * if -ve done so go get next byte
-00000CF8 1229
-00000CF8 3012 1230 MOVE.w (a2),d0 * get offset to rest
-00000CFA 45FA 2DFA 1231 LEA TAB_STAR(pc),a2 * get keyword table address
-00000CFE 45F2 0000 1232 LEA (a2,d0.w),a2 * get address of rest
-00000D02 1233 LAB_1540
-00000D02 101A 1234 MOVE.b (a2)+,d0 * get byte from keyword table
-00000D04 6100 04F2 1235 BSR LAB_PRNA * go print the character
-00000D08 51C9 FFF8 1236 DBF d1,LAB_1540 * decrement and loop if more to do
-00000D0C 1237
-00000D0C 60BC 1238 BRA.s LAB_1519 * go get next byte
-00000D0E 1239
-00000D0E 1240
-00000D0E 1241 *************************************************************************************
-00000D0E 1242 *
-00000D0E 1243 * perform FOR
-00000D0E 1244
-00000D0E 1245 LAB_FOR
-00000D0E 6100 0390 1246 BSR LAB_LET * go do LET
-00000D12 1247
-00000D12 202B 0472 1248 MOVE.l Lvarpl(a3),d0 * get the loop variable pointer
-00000D16 B0AB 043A 1249 CMP.l Sstrl(a3),d0 * compare it with the end of vars memory
-00000D1A 6C00 FC22 1250 BGE LAB_TMER * if greater go do type mismatch error
-00000D1E 1251
-00000D1E 1252 * test for not less than the start of variables memory if needed
-00000D1E 1253 *
-00000D1E 1254 * CMP.l Svarl(a3),d0 * compare it with the start of variables memory
-00000D1E 1255 * BLT LAB_TMER * if not variables memory do type mismatch error
-00000D1E 1256
-00000D1E 1257 * MOVEQ #28,d0 * we need 28 bytes !
-00000D1E 1258 * BSR.s LAB_1212 * check room on stack for d0 bytes
-00000D1E 1259
-00000D1E 6100 0214 1260 BSR LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
-00000D22 1261 * returns a0 as pointer to [:] or [EOL]
-00000D22 2E88 1262 MOVE.l a0,(sp) * push onto stack (and dump the return address)
-00000D24 2F2B 0452 1263 MOVE.l Clinel(a3),-(sp) * push current line onto stack
-00000D28 1264
-00000D28 70AA 1265 MOVEQ #TK_TO-$100,d0 * set "TO" token
-00000D2A 6100 0874 1266 BSR LAB_SCCA * scan for CHR$(d0) else syntax error/warm start
-00000D2E 6100 0702 1267 BSR LAB_CTNM * check if source is numeric, else type mismatch
-00000D32 1F2B 05B5 1268 MOVE.b Dtypef(a3),-(sp) * push the FOR variable data type onto stack
-00000D36 6100 06F8 1269 BSR LAB_EVNM * evaluate expression and check is numeric else
-00000D3A 1270 * do type mismatch
-00000D3A 1271
-00000D3A 2F2B 0590 1272 MOVE.l FAC1_m(a3),-(sp) * push TO value mantissa
-00000D3E 3F2B 0594 1273 MOVE.w FAC1_e(a3),-(sp) * push TO value exponent and sign
-00000D42 1274
-00000D42 277C 80000000 0590 1275 MOVE.l #$80000000,FAC1_m(a3) * set default STEP size mantissa
-00000D4A 377C 8100 0594 1276 MOVE.w #$8100,FAC1_e(a3) * set default STEP size exponent and sign
-00000D50 1277
-00000D50 6100 0858 1278 BSR LAB_GBYT * scan memory
-00000D54 B03C 00AF 1279 CMP.b #TK_STEP,d0 * compare with STEP token
-00000D58 6608 1280 BNE.s LAB_15B3 * jump if not "STEP"
-00000D5A 1281
-00000D5A 1282 * was STEP token so ....
-00000D5A 6100 084C 1283 BSR LAB_IGBY * increment & scan memory
-00000D5E 6100 06D0 1284 BSR LAB_EVNM * evaluate expression & check is numeric
-00000D62 1285 * else do type mismatch
-00000D62 1286 LAB_15B3
-00000D62 2F2B 0590 1287 MOVE.l FAC1_m(a3),-(sp) * push STEP value mantissa
-00000D66 3F2B 0594 1288 MOVE.w FAC1_e(a3),-(sp) * push STEP value exponent and sign
-00000D6A 1289
-00000D6A 2F2B 0472 1290 MOVE.l Lvarpl(a3),-(sp) * push variable pointer for FOR/NEXT
-00000D6E 3F3C 0081 1291 MOVE.w #TK_FOR,-(sp) * push FOR token on stack
-00000D72 1292
-00000D72 6018 1293 BRA.s LAB_15C2 * go do interpreter inner loop
-00000D74 1294
-00000D74 1295 LAB_15DC * have reached [EOL]+1
-00000D74 300D 1296 MOVE.w a5,d0 * copy BASIC execute pointer
-00000D76 C07C 0001 1297 AND.w #1,d0 * and make line start address even
-00000D7A DAC0 1298 ADD.w d0,a5 * add to BASIC execute pointer
-00000D7C 201D 1299 MOVE.l (a5)+,d0 * get next line pointer
-00000D7E 6700 FC1A 1300 BEQ LAB_1274 * if null go to immediate mode, no "BREAK"
-00000D82 1301 * message (was immediate or [EOT] marker)
-00000D82 1302
-00000D82 275D 0452 1303 MOVE.l (a5)+,Clinel(a3) * save (new) current line #
-00000D86 1304 LAB_15F6
-00000D86 6100 0822 1305 BSR LAB_GBYT * get BASIC byte
-00000D8A 611A 1306 BSR.s LAB_15FF * go interpret BASIC code from (a5)
-00000D8C 1307
-00000D8C 1308 * interpreter inner loop (re)entry point
-00000D8C 1309
-00000D8C 1310 LAB_15C2
-00000D8C 6140 1311 BSR.s LAB_1629 * do CRTL-C check vector
-00000D8E 4A2B 0452 1312 TST.b Clinel(a3) * test current line #, is -ve for immediate mode
-00000D92 6B04 1313 BMI.s LAB_15D1 * branch if immediate mode
-00000D94 1314
-00000D94 274D 045A 1315 MOVE.l a5,Cpntrl(a3) * save BASIC execute pointer as continue pointer
-00000D98 1316 LAB_15D1
-00000D98 101D 1317 MOVE.b (a5)+,d0 * get this byte & increment pointer
-00000D9A 67D8 1318 BEQ.s LAB_15DC * loop if [EOL]
-00000D9C 1319
-00000D9C B03C 003A 1320 CMP.b #$3A,d0 * compare with ":"
-00000DA0 67E4 1321 BEQ.s LAB_15F6 * loop if was statement separator
-00000DA2 1322
-00000DA2 6000 FBC6 1323 BRA LAB_SNER * else syntax error, then warm start
-00000DA6 1324
-00000DA6 1325
-00000DA6 1326 *************************************************************************************
-00000DA6 1327 *
-00000DA6 1328 * interpret BASIC code from (a5)
-00000DA6 1329
-00000DA6 1330 LAB_15FF
-00000DA6 6700 008C 1331 BEQ RTS_006 * exit if zero [EOL]
-00000DAA 1332
-00000DAA 1333 LAB_1602
-00000DAA 0A00 0080 1334 EORI.b #$80,d0 * normalise token
-00000DAE 6B00 02F0 1335 BMI LAB_LET * if not token, go do implied LET
-00000DB2 1336
-00000DB2 B03C 0028 1337 CMP.b #(TK_TAB-$80),d0 * compare normalised token with TAB
-00000DB6 6400 FBB2 1338 BCC LAB_SNER * branch if d0>=TAB, syntax error/warm start
-00000DBA 1339 * only tokens before TAB can start a statement
-00000DBA 1340
-00000DBA 4880 1341 EXT.w d0 * byte to word (clear high byte)
-00000DBC D040 1342 ADD.w d0,d0 * *2
-00000DBE 41FA 2868 1343 LEA LAB_CTBL(pc),a0 * get vector table base address
-00000DC2 3030 0000 1344 MOVE.w (a0,d0.w),d0 * get offset to vector
-00000DC6 4870 0000 1345 PEA (a0,d0.w) * push vector
-00000DCA 6000 07DC 1346 BRA LAB_IGBY * get following byte & execute vector
-00000DCE 1347
-00000DCE 1348
-00000DCE 1349 *************************************************************************************
-00000DCE 1350 *
-00000DCE 1351 * CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
-00000DCE 1352 * key press is detected.
-00000DCE 1353
-00000DCE 1354 LAB_1629
-00000DCE 4EEB 0424 1355 JMP V_CTLC(a3) * ctrl c check vector
-00000DD2 1356
-00000DD2 1357 * if there was a key press it gets back here .....
-00000DD2 1358
-00000DD2 1359 LAB_1636
-00000DD2 B03C 0003 1360 CMP.b #$03,d0 * compare with CTRL-C
-00000DD6 670C 1361 BEQ.s LAB_163B * STOP if was CTRL-C
-00000DD8 1362
-00000DD8 1363 LAB_1639
-00000DD8 4E75 1364 RTS *
-00000DDA 1365
-00000DDA 1366
-00000DDA 1367 *************************************************************************************
-00000DDA 1368 *
-00000DDA 1369 * perform END
-00000DDA 1370
-00000DDA 1371 LAB_END
-00000DDA 66FC 1372 BNE.s LAB_1639 * exit if something follows STOP
-00000DDC 177C 0000 05DC 1373 MOVE.b #0,Breakf(a3) * clear break flag, indicate program end
-00000DE2 1374
-00000DE2 1375
-00000DE2 1376 *************************************************************************************
-00000DE2 1377 *
-00000DE2 1378 * perform STOP
-00000DE2 1379
-00000DE2 1380 LAB_STOP
-00000DE2 66F4 1381 BNE.s LAB_1639 * exit if something follows STOP
-00000DE4 1382
-00000DE4 1383 LAB_163B
-00000DE4 43EB 0590 1384 LEA Ibuffe(a3),a1 * get buffer end
-00000DE8 BBC9 1385 CMPA.l a1,a5 * compare execute address with buffer end
-00000DEA 650A 1386 BCS.s LAB_164F * branch if BASIC pointer is in buffer
-00000DEC 1387 * can't continue in immediate mode
-00000DEC 1388
-00000DEC 1389 * else...
-00000DEC 274D 045A 1390 MOVE.l a5,Cpntrl(a3) * save BASIC execute pointer as continue pointer
-00000DF0 1391 LAB_1647
-00000DF0 276B 0452 0456 1392 MOVE.l Clinel(a3),Blinel(a3) * save break line
-00000DF6 1393 LAB_164F
-00000DF6 584F 1394 ADDQ.w #4,sp * dump return address, don't return to execute
-00000DF8 1395 * loop
-00000DF8 102B 05DC 1396 MOVE.b Breakf(a3),d0 * get break flag
-00000DFC 6700 FB9C 1397 BEQ LAB_1274 * go do warm start if was program end
-00000E00 1398
-00000E00 41FA 2E9F 1399 LEA LAB_BMSG(pc),a0 * point to "Break"
-00000E04 6000 FB86 1400 BRA LAB_1269 * print "Break" and do warm start
-00000E08 1401
-00000E08 1402
-00000E08 1403 *************************************************************************************
-00000E08 1404 *
-00000E08 1405 * perform RESTORE
-00000E08 1406
-00000E08 1407 LAB_RESTORE
-00000E08 206B 042E 1408 MOVEA.l Smeml(a3),a0 * copy start of memory
-00000E0C 6720 1409 BEQ.s LAB_1624 * branch if next character null (RESTORE)
-00000E0E 1410
-00000E0E 6100 01F0 1411 BSR LAB_GFPN * get fixed-point number into temp integer & d1
-00000E12 B2AB 0452 1412 CMP.l Clinel(a3),d1 * compare current line # with required line #
-00000E16 630E 1413 BLS.s LAB_GSCH * branch if >= (start search from beginning)
-00000E18 1414
-00000E18 204D 1415 MOVEA.l a5,a0 * copy BASIC execute pointer
-00000E1A 1416 LAB_RESs
-00000E1A 4A18 1417 TST.b (a0)+ * test next byte & increment pointer
-00000E1C 66FC 1418 BNE.s LAB_RESs * loop if not EOL
-00000E1E 1419
-00000E1E 3008 1420 MOVE.w a0,d0 * copy pointer
-00000E20 C07C 0001 1421 AND.w #1,d0 * mask odd bit
-00000E24 D0C0 1422 ADD.w d0,a0 * add pointer
-00000E26 1423 * search for line in Itemp from (a0)
-00000E26 1424 LAB_GSCH
-00000E26 6100 FDCA 1425 BSR LAB_SCLN * search for d1 line number from a0
-00000E2A 1426 * returns Cb=0 if found
-00000E2A 6500 FB26 1427 BCS LAB_USER * go do "Undefined statement" error if not found
-00000E2E 1428
-00000E2E 1429 LAB_1624
-00000E2E 4A20 1430 TST.b -(a0) * decrement pointer (faster)
-00000E30 2748 0462 1431 MOVE.l a0,Dptrl(a3) * save DATA pointer
-00000E34 1432 RTS_006
-00000E34 4E75 1433 RTS
-00000E36 1434
-00000E36 1435
-00000E36 1436 *************************************************************************************
-00000E36 1437 *
-00000E36 1438 * perform NULL
-00000E36 1439
-00000E36 1440 LAB_NULL
-00000E36 6100 10DA 1441 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
-00000E3A 1740 05E4 1442 MOVE.b d0,Nullct(a3) * save new NULL count
-00000E3E 4E75 1443 RTS
-00000E40 1444
-00000E40 1445
-00000E40 1446 *************************************************************************************
-00000E40 1447 *
-00000E40 1448 * perform CONT
-00000E40 1449
-00000E40 1450 LAB_CONT
-00000E40 6600 FB28 1451 BNE LAB_SNER * if following byte exit to do syntax error
-00000E44 1452
-00000E44 4A2B 0452 1453 TST.b Clinel(a3) * test current line #, is -ve for immediate mode
-00000E48 6A00 FAE8 1454 BPL LAB_CCER * if running go do can't continue error
-00000E4C 1455
-00000E4C 202B 045A 1456 MOVE.l Cpntrl(a3),d0 * get continue pointer
-00000E50 6700 FAE0 1457 BEQ LAB_CCER * go do can't continue error if we can't
-00000E54 1458
-00000E54 1459 * we can continue so ...
-00000E54 2A40 1460 MOVEA.l d0,a5 * save continue pointer as BASIC execute pointer
-00000E56 276B 0456 0452 1461 MOVE.l Blinel(a3),Clinel(a3) * set break line as current line
-00000E5C 4E75 1462 RTS
-00000E5E 1463
-00000E5E 1464
-00000E5E 1465 *************************************************************************************
-00000E5E 1466 *
-00000E5E 1467 * perform RUN
-00000E5E 1468
-00000E5E 1469 LAB_RUN
-00000E5E 660C 1470 BNE.s LAB_RUNn * if following byte do RUN n
-00000E60 1471
-00000E60 6100 FDB0 1472 BSR LAB_1477 * execution to start, clear vars & flush stack
-00000E64 274D 045A 1473 MOVE.l a5,Cpntrl(a3) * save as continue pointer
-00000E68 6000 FF22 1474 BRA LAB_15C2 * go do interpreter inner loop
-00000E6C 1475 * (can't RTS, we flushed the stack!)
-00000E6C 1476
-00000E6C 1477 LAB_RUNn
-00000E6C 6100 FDAA 1478 BSR LAB_147A * go do "CLEAR"
-00000E70 601C 1479 BRA.s LAB_16B0 * get n and do GOTO n
-00000E72 1480
-00000E72 1481
-00000E72 1482 *************************************************************************************
-00000E72 1483 *
-00000E72 1484 * perform DO
-00000E72 1485
-00000E72 1486 LAB_DO
-00000E72 1487 * MOVE.l #$05,d0 * need 5 bytes for DO
-00000E72 1488 * BSR.s LAB_1212 * check room on stack for A bytes
-00000E72 2F0D 1489 MOVE.l a5,-(sp) * push BASIC execute pointer on stack
-00000E74 2F2B 0452 1490 MOVE.l Clinel(a3),-(sp) * push current line on stack
-00000E78 3F3C 009C 1491 MOVE.w #TK_DO,-(sp) * push token for DO on stack
-00000E7C 487A FF0E 1492 PEA LAB_15C2(pc) * set return address
-00000E80 6000 0728 1493 BRA LAB_GBYT * scan memory & return to interpreter inner loop
-00000E84 1494
-00000E84 1495
-00000E84 1496 *************************************************************************************
-00000E84 1497 *
-00000E84 1498 * perform GOSUB
-00000E84 1499
-00000E84 1500 LAB_GOSUB
-00000E84 1501 * MOVE.l #10,d0 * need 10 bytes for GOSUB
-00000E84 1502 * BSR.s LAB_1212 * check room on stack for d0 bytes
-00000E84 2F0D 1503 MOVE.l a5,-(sp) * push BASIC execute pointer
-00000E86 2F2B 0452 1504 MOVE.l Clinel(a3),-(sp) * push current line
-00000E8A 3F3C 008D 1505 MOVE.w #TK_GOSUB,-(sp) * push token for GOSUB
-00000E8E 1506 LAB_16B0
-00000E8E 6100 071A 1507 BSR LAB_GBYT * scan memory
-00000E92 487A FEF8 1508 PEA LAB_15C2(pc) * return to interpreter inner loop after GOTO n
-00000E96 1509
-00000E96 1510 * this PEA is needed because either we just cleared the stack and have nowhere to return
-00000E96 1511 * to or, in the case of GOSUB, we have just dropped a load on the stack and the address
-00000E96 1512 * we whould have returned to is buried. This burried return address will be unstacked by
-00000E96 1513 * the corresponding RETURN command
-00000E96 1514
-00000E96 1515
-00000E96 1516 *************************************************************************************
-00000E96 1517 *
-00000E96 1518 * perform GOTO
-00000E96 1519
-00000E96 1520 LAB_GOTO
-00000E96 6100 0168 1521 BSR LAB_GFPN * get fixed-point number into temp integer & d1
-00000E9A 206B 042E 1522 MOVEA.l Smeml(a3),a0 * get start of memory
-00000E9E B2AB 0452 1523 CMP.l Clinel(a3),d1 * compare current line with wanted #
-00000EA2 630E 1524 BLS.s LAB_16D0 * branch if current # => wanted #
-00000EA4 1525
-00000EA4 204D 1526 MOVEA.l a5,a0 * copy BASIC execute pointer
-00000EA6 1527 LAB_GOTs
-00000EA6 4A18 1528 TST.b (a0)+ * test next byte & increment pointer
-00000EA8 66FC 1529 BNE.s LAB_GOTs * loop if not EOL
-00000EAA 1530
-00000EAA 3008 1531 MOVE.w a0,d0 * past pad byte(s)
-00000EAC C07C 0001 1532 AND.w #1,d0 * mask odd bit
-00000EB0 D0C0 1533 ADD.w d0,a0 * add to pointer
-00000EB2 1534
-00000EB2 1535 LAB_16D0
-00000EB2 6100 FD3E 1536 BSR LAB_SCLN * search for d1 line number from a0
-00000EB6 1537 * returns Cb=0 if found
-00000EB6 6500 FA9A 1538 BCS LAB_USER * if carry set go do "Undefined statement" error
-00000EBA 1539
-00000EBA 2A48 1540 MOVEA.l a0,a5 * copy to basic execute pointer
-00000EBC 534D 1541 SUBQ.w #1,a5 * decrement pointer
-00000EBE 274D 045A 1542 MOVE.l a5,Cpntrl(a3) * save as continue pointer
-00000EC2 4E75 1543 RTS
-00000EC4 1544
-00000EC4 1545
-00000EC4 1546 *************************************************************************************
-00000EC4 1547 *
-00000EC4 1548 * perform LOOP
-00000EC4 1549
-00000EC4 1550 LAB_LOOP
-00000EC4 0C6F 009C 0004 1551 CMP.w #TK_DO,4(sp) * compare token on stack with DO token
-00000ECA 6600 FA5E 1552 BNE LAB_LDER * branch if no matching DO
-00000ECE 1553
-00000ECE 1E00 1554 MOVE.b d0,d7 * copy following token (byte)
-00000ED0 672E 1555 BEQ.s LoopAlways * if no following token loop forever
-00000ED2 1556
-00000ED2 BE3C 003A 1557 CMP.b #':',d7 * compare with ":"
-00000ED6 6728 1558 BEQ.s LoopAlways * if no following token loop forever
-00000ED8 1559
-00000ED8 0407 00B0 1560 SUB.b #TK_UNTIL,d7 * subtract token for UNTIL
-00000EDC 6708 1561 BEQ.s DoRest * branch if was UNTIL
-00000EDE 1562
-00000EDE 5307 1563 SUBQ.b #1,d7 * decrement result
-00000EE0 6600 FA88 1564 BNE LAB_SNER * if not WHILE go do syntax error & warm start
-00000EE4 1565 * only if the token was WHILE will this fail
-00000EE4 1566
-00000EE4 7EFF 1567 MOVEQ #-1,d7 * set invert result longword
-00000EE6 1568 DoRest
-00000EE6 6100 06C0 1569 BSR LAB_IGBY * increment & scan memory
-00000EEA 6100 055C 1570 BSR LAB_EVEX * evaluate expression
-00000EEE 4A2B 0594 1571 TST.b FAC1_e(a3) * test FAC1 exponent
-00000EF2 6706 1572 BEQ.s DoCmp * if = 0 go do straight compare
-00000EF4 1573
-00000EF4 177C 00FF 0594 1574 MOVE.b #$FF,FAC1_e(a3) * else set all bits
-00000EFA 1575 DoCmp
-00000EFA BF2B 0594 1576 EOR.b d7,FAC1_e(a3) * EOR with invert byte
-00000EFE 6614 1577 BNE.s LoopDone * if <> 0 clear stack & back to interpreter loop
-00000F00 1578
-00000F00 1579 * loop condition wasn't met so do it again
-00000F00 1580 LoopAlways
-00000F00 276F 0006 0452 1581 MOVE.l 6(sp),Clinel(a3) * copy DO current line
-00000F06 2A6F 000A 1582 MOVE.l 10(sp),a5 * save BASIC execute pointer
-00000F0A 1583
-00000F0A 41FA FE80 1584 LEA LAB_15C2(pc),a0 * get return address
-00000F0E 2E88 1585 MOVE.l a0,(sp) * dump the call to this routine and set the
-00000F10 1586 * return address
-00000F10 6000 0698 1587 BRA LAB_GBYT * scan memory and return to interpreter inner
-00000F14 1588 * loop
-00000F14 1589
-00000F14 1590 * clear stack & back to interpreter loop
-00000F14 1591 LoopDone
-00000F14 4FEF 000E 1592 LEA 14(sp),sp * dump structure and call from stack
-00000F18 6014 1593 BRA.s LAB_DATA * go perform DATA (find : or [EOL])
-00000F1A 1594
-00000F1A 1595
-00000F1A 1596 *************************************************************************************
-00000F1A 1597 *
-00000F1A 1598 * perform RETURN
-00000F1A 1599
-00000F1A 1600 LAB_RETURN
-00000F1A 6616 1601 BNE.s RTS_007 * exit if following token to allow syntax error
-00000F1C 1602
-00000F1C 0C6F 008D 0004 1603 CMP.w #TK_GOSUB,4(sp) * compare token from stack with GOSUB
-00000F22 6600 FA42 1604 BNE LAB_RGER * do RETURN without GOSUB error if no matching
-00000F26 1605 * GOSUB
-00000F26 1606
-00000F26 5C4F 1607 ADDQ.w #6,sp * dump calling address & token
-00000F28 275F 0452 1608 MOVE.l (sp)+,Clinel(a3) * pull current line
-00000F2C 2A5F 1609 MOVE.l (sp)+,a5 * pull BASIC execute pointer
-00000F2E 1610 * now do perform "DATA" statement as we could be
-00000F2E 1611 * returning into the middle of an ON GOSUB
-00000F2E 1612 * n,m,p,q line (the return address used by the
-00000F2E 1613 * DATA statement is the one pushed before the
-00000F2E 1614 * GOSUB was executed!)
-00000F2E 1615
-00000F2E 1616
-00000F2E 1617 *************************************************************************************
-00000F2E 1618 *
-00000F2E 1619 * perform DATA
-00000F2E 1620
-00000F2E 1621 LAB_DATA
-00000F2E 6104 1622 BSR.s LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
-00000F30 1623 * returns a0 as pointer to [:] or [EOL]
-00000F30 2A48 1624 MOVEA.l a0,a5 * skip rest of statement
-00000F32 1625 RTS_007
-00000F32 4E75 1626 RTS
-00000F34 1627
-00000F34 1628
-00000F34 1629 *************************************************************************************
-00000F34 1630 *
-00000F34 1631 * scan for next BASIC statement ([:] or [EOL])
-00000F34 1632 * returns a0 as pointer to [:] or [EOL]
-00000F34 1633
-00000F34 1634 LAB_SNBS
-00000F34 204D 1635 MOVEA.l a5,a0 * copy BASIC execute pointer
-00000F36 7222 1636 MOVEQ #$22,d1 * set string quote character
-00000F38 743A 1637 MOVEQ #$3A,d2 * set look for character = ":"
-00000F3A 6008 1638 BRA.s LAB_172D * go do search
-00000F3C 1639
-00000F3C 1640 LAB_172C
-00000F3C B400 1641 CMP.b d0,d2 * compare with ":"
-00000F3E 6708 1642 BEQ.s RTS_007a * exit if found
-00000F40 1643
-00000F40 B200 1644 CMP.b d0,d1 * compare with '"'
-00000F42 670C 1645 BEQ.s LAB_1725 * if found go search for [EOL]
-00000F44 1646
-00000F44 1647 LAB_172D
-00000F44 1018 1648 MOVE.b (a0)+,d0 * get next byte
-00000F46 66F4 1649 BNE.s LAB_172C * loop if not null [EOL]
-00000F48 1650
-00000F48 1651 RTS_007a
-00000F48 5348 1652 SUBQ.w #1,a0 * correct pointer
-00000F4A 4E75 1653 RTS
-00000F4C 1654
-00000F4C 1655 LAB_1723
-00000F4C B200 1656 CMP.b d0,d1 * compare with '"'
-00000F4E 67F4 1657 BEQ.s LAB_172D * if found go search for ":" or [EOL]
-00000F50 1658
-00000F50 1659 LAB_1725
-00000F50 1018 1660 MOVE.b (a0)+,d0 * get next byte
-00000F52 66F8 1661 BNE.s LAB_1723 * loop if not null [EOL]
-00000F54 1662
-00000F54 60F2 1663 BRA.s RTS_007a * correct pointer & return
-00000F56 1664
-00000F56 1665
-00000F56 1666 *************************************************************************************
-00000F56 1667 *
-00000F56 1668 * perform IF
-00000F56 1669
-00000F56 1670 LAB_IF
-00000F56 6100 04F0 1671 BSR LAB_EVEX * evaluate expression
-00000F5A 6100 064E 1672 BSR LAB_GBYT * scan memory
-00000F5E B03C 00AD 1673 CMP.b #TK_THEN,d0 * compare with THEN token
-00000F62 6714 1674 BEQ.s LAB_174B * if it was THEN then continue
-00000F64 1675
-00000F64 1676 * wasn't IF .. THEN so must be IF .. GOTO
-00000F64 B03C 0089 1677 CMP.b #TK_GOTO,d0 * compare with GOTO token
-00000F68 6600 FA00 1678 BNE LAB_SNER * if not GOTO token do syntax error/warm start
-00000F6C 1679
-00000F6C 1680 * was GOTO so check for GOTO
-00000F6C 204D 1681 MOVE.l a5,a0 * save the execute pointer
-00000F6E 6100 0638 1682 BSR LAB_IGBY * scan memory, test for a numeric character
-00000F72 2A48 1683 MOVE.l a0,a5 * restore the execute pointer
-00000F74 6400 F9F4 1684 BCC LAB_SNER * if not numeric do syntax error/warm start
-00000F78 1685
-00000F78 1686 LAB_174B
-00000F78 102B 0594 1687 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
-00000F7C 671E 1688 BEQ.s LAB_174E * if result was zero go look for an ELSE
-00000F7E 1689
-00000F7E 6100 0628 1690 BSR LAB_IGBY * increment & scan memory
-00000F82 6500 FF12 1691 BCS LAB_GOTO * if numeric do GOTO n
-00000F86 1692 * a GOTO will never return to the IF
-00000F86 1693 * statement so there is no need to return
-00000F86 1694 * to this code
-00000F86 1695
-00000F86 B03C 008E 1696 CMP.b #TK_RETURN,d0 * compare with RETURN token
-00000F8A 6700 FE1E 1697 BEQ LAB_1602 * if RETURN then interpret BASIC code from (a5)
-00000F8E 1698 * and don't return here
-00000F8E 1699
-00000F8E 6100 FE16 1700 BSR LAB_15FF * else interpret BASIC code from (a5)
-00000F92 1701
-00000F92 1702 * the IF was executed and there may be a following ELSE so the code needs to return
-00000F92 1703 * here to check and ignore the ELSE if present
-00000F92 1704
-00000F92 1015 1705 MOVE.b (a5),d0 * get the next basic byte
-00000F94 B03C 00A9 1706 CMP.b #TK_ELSE,d0 * compare it with the token for ELSE
-00000F98 6794 1707 BEQ LAB_DATA * if ELSE ignore the following statement
-00000F9A 1708
-00000F9A 1709 * there was no ELSE so continue execution of IF THEN [: ]. any
-00000F9A 1710 * following ELSE will, correctly, cause a syntax error
-00000F9A 1711
-00000F9A 4E75 1712 RTS * else return to interpreter inner loop
-00000F9C 1713
-00000F9C 1714 * perform ELSE after IF
-00000F9C 1715
-00000F9C 1716 LAB_174E
-00000F9C 101D 1717 MOVE.b (a5)+,d0 * faster increment past THEN
-00000F9E 76A9 1718 MOVEQ #TK_ELSE,d3 * set search for ELSE token
-00000FA0 788B 1719 MOVEQ #TK_IF,d4 * set search for IF token
-00000FA2 7A00 1720 MOVEQ #0,d5 * clear the nesting depth
-00000FA4 1721 LAB_1750
-00000FA4 101D 1722 MOVE.b (a5)+,d0 * get next BASIC byte & increment ptr
-00000FA6 6720 1723 BEQ.s LAB_1754 * if EOL correct the pointer and return
-00000FA8 1724
-00000FA8 B004 1725 CMP.b d4,d0 * compare with "IF" token
-00000FAA 6604 1726 BNE.s LAB_1752 * skip if not nested IF
-00000FAC 1727
-00000FAC 5245 1728 ADDQ.w #1,d5 * else increment the nesting depth ..
-00000FAE 60F4 1729 BRA.s LAB_1750 * .. and continue looking
-00000FB0 1730
-00000FB0 1731 LAB_1752
-00000FB0 B003 1732 CMP.b d3,d0 * compare with ELSE token
-00000FB2 66F0 1733 BNE.s LAB_1750 * if not ELSE continue looking
-00000FB4 1734
-00000FB4 1735 LAB_1756
-00000FB4 51CD FFEE 1736 DBF d5,LAB_1750 * loop if still nested
-00000FB8 1737
-00000FB8 1738 * found the matching ELSE, now do <{n|statement}>
-00000FB8 1739
-00000FB8 6100 05F0 1740 BSR LAB_GBYT * scan memory
-00000FBC 6500 FED8 1741 BCS LAB_GOTO * if numeric do GOTO n
-00000FC0 1742 * code will return to the interpreter loop
-00000FC0 1743 * at the tail end of the GOTO
-00000FC0 1744
-00000FC0 6000 FDE4 1745 BRA LAB_15FF * else interpret BASIC code from (a5)
-00000FC4 1746 * code will return to the interpreter loop
-00000FC4 1747 * at the tail end of the
-00000FC4 1748
-00000FC4 1749
-00000FC4 1750 *************************************************************************************
-00000FC4 1751 *
-00000FC4 1752 * perform REM, skip (rest of) line
-00000FC4 1753
-00000FC4 1754 LAB_REM
-00000FC4 4A1D 1755 TST.b (a5)+ * test byte & increment pointer
-00000FC6 66FC 1756 BNE.s LAB_REM * loop if not EOL
-00000FC8 1757
-00000FC8 1758 LAB_1754
-00000FC8 534D 1759 SUBQ.w #1,a5 * correct the execute pointer
-00000FCA 4E75 1760 RTS
-00000FCC 1761
-00000FCC 1762
-00000FCC 1763 *************************************************************************************
-00000FCC 1764 *
-00000FCC 1765 * perform ON
-00000FCC 1766
-00000FCC 1767 LAB_ON
-00000FCC 6100 0F44 1768 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
-00000FD0 1400 1769 MOVE.b d0,d2 * copy byte
-00000FD2 6100 05D6 1770 BSR LAB_GBYT * restore BASIC byte
-00000FD6 3F00 1771 MOVE.w d0,-(sp) * push GOTO/GOSUB token
-00000FD8 B03C 008D 1772 CMP.b #TK_GOSUB,d0 * compare with GOSUB token
-00000FDC 6708 1773 BEQ.s LAB_176C * branch if GOSUB
-00000FDE 1774
-00000FDE B03C 0089 1775 CMP.b #TK_GOTO,d0 * compare with GOTO token
-00000FE2 6600 F986 1776 BNE LAB_SNER * if not GOTO do syntax error, then warm start
-00000FE6 1777
-00000FE6 1778 * next character was GOTO or GOSUB
-00000FE6 1779
-00000FE6 1780 LAB_176C
-00000FE6 5302 1781 SUBQ.b #1,d2 * decrement index (byte value)
-00000FE8 6606 1782 BNE.s LAB_1773 * branch if not zero
-00000FEA 1783
-00000FEA 301F 1784 MOVE.w (sp)+,d0 * pull GOTO/GOSUB token
-00000FEC 6000 FDBC 1785 BRA LAB_1602 * go execute it
-00000FF0 1786
-00000FF0 1787 LAB_1773
-00000FF0 6100 05B6 1788 BSR LAB_IGBY * increment & scan memory
-00000FF4 610A 1789 BSR.s LAB_GFPN * get fixed-point number into temp integer & d1
-00000FF6 1790 * (skip this n)
-00000FF6 B03C 002C 1791 CMP.b #$2C,d0 * compare next character with ","
-00000FFA 67EA 1792 BEQ.s LAB_176C * loop if ","
-00000FFC 1793
-00000FFC 301F 1794 MOVE.w (sp)+,d0 * pull GOTO/GOSUB token (run out of options)
-00000FFE 4E75 1795 RTS * and exit
-00001000 1796
-00001000 1797
-00001000 1798 *************************************************************************************
-00001000 1799 *
-00001000 1800 * get fixed-point number into temp integer & d1
-00001000 1801 * interpret number from (a5), leave (a5) pointing to byte after #
-00001000 1802
-00001000 1803 LAB_GFPN
-00001000 7200 1804 MOVEQ #$00,d1 * clear integer register
-00001002 2001 1805 MOVE.l d1,d0 * clear d0
-00001004 6100 05A4 1806 BSR LAB_GBYT * scan memory, Cb=1 if "0"-"9", & get byte
-00001008 642E 1807 BCC.s LAB_1786 * return if carry clear, chr was not "0"-"9"
-0000100A 1808
-0000100A 2F02 1809 MOVE.l d2,-(sp) * save d2
-0000100C 1810 LAB_1785
-0000100C 2401 1811 MOVE.l d1,d2 * copy integer register
-0000100E D281 1812 ADD.l d1,d1 * *2
-00001010 6500 F958 1813 BCS LAB_SNER * if overflow do syntax error, then warm start
-00001014 1814
-00001014 D281 1815 ADD.l d1,d1 * *4
-00001016 6500 F952 1816 BCS LAB_SNER * if overflow do syntax error, then warm start
-0000101A 1817
-0000101A D282 1818 ADD.l d2,d1 * *1 + *4
-0000101C 6500 F94C 1819 BCS LAB_SNER * if overflow do syntax error, then warm start
-00001020 1820
-00001020 D281 1821 ADD.l d1,d1 * *10
-00001022 6500 F946 1822 BCS LAB_SNER * if overflow do syntax error, then warm start
-00001026 1823
-00001026 0400 0030 1824 SUB.b #$30,d0 * subtract $30 from byte
-0000102A D280 1825 ADD.l d0,d1 * add to integer register, the top 24 bits are
-0000102C 1826 * always clear
-0000102C 6900 F93C 1827 BVS LAB_SNER * if overflow do syntax error, then warm start
-00001030 1828 * this makes the maximum line number 2147483647
-00001030 6100 0576 1829 BSR LAB_IGBY * increment & scan memory
-00001034 65D6 1830 BCS.s LAB_1785 * loop for next character if "0"-"9"
-00001036 1831
-00001036 241F 1832 MOVE.l (sp)+,d2 * restore d2
-00001038 1833 LAB_1786
-00001038 2741 042A 1834 MOVE.l d1,Itemp(a3) * save Itemp
-0000103C 4E75 1835 RTS
-0000103E 1836
-0000103E 1837
-0000103E 1838 *************************************************************************************
-0000103E 1839 *
-0000103E 1840 * perform DEC
-0000103E 1841
-0000103E 1842 LAB_DEC
-0000103E 3F3C 8180 1843 MOVE.w #$8180,-(sp) * set -1 sign/exponent
-00001042 600A 1844 BRA.s LAB_17B7 * go do DEC
-00001044 1845
-00001044 1846
-00001044 1847 *************************************************************************************
-00001044 1848 *
-00001044 1849 * perform INC
-00001044 1850
-00001044 1851 LAB_INC
-00001044 3F3C 8100 1852 MOVE.w #$8100,-(sp) * set 1 sign/exponent
-00001048 6004 1853 BRA.s LAB_17B7 * go do INC
-0000104A 1854
-0000104A 1855 * was "," so another INCR variable to do
-0000104A 1856 LAB_17B8
-0000104A 6100 055C 1857 BSR LAB_IGBY * increment and scan memory
-0000104E 1858 LAB_17B7
-0000104E 6100 0768 1859 BSR LAB_GVAR * get variable address in a0
-00001052 1860
-00001052 1861 * if you want a non existant variable to return a null value then set the novar
-00001052 1862 * value at the top of this file to some non zero value
-00001052 1863
-00001052 FALSE 1864 ifne novar
-00001052 1865 endc
-00001052 1866
-00001052 4A2B 05B5 1867 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-00001056 1868 * $00=float
-00001056 6B00 F8E6 1869 BMI LAB_TMER * if string do "Type mismatch" error/warm start
-0000105A 1870
-0000105A 6636 1871 BNE.s LAB_INCI * go do integer INC/DEC
-0000105C 1872
-0000105C 2748 0472 1873 MOVE.l a0,Lvarpl(a3) * save var address
-00001060 6100 130A 1874 BSR LAB_UFAC * unpack memory (a0) into FAC1
-00001064 277C 80000000 0598 1875 MOVE.l #$80000000,FAC2_m(a3) * set FAC2 mantissa for 1
-0000106C 3017 1876 MOVE.w (sp),d0 * move exponent & sign to d0
-0000106E 3740 059C 1877 MOVE.w d0,FAC2_e(a3) * move exponent & sign to FAC2
-00001072 176B 0595 059E 1878 MOVE.b FAC1_s(a3),FAC_sc(a3) * make sign compare = FAC1 sign
-00001078 B12B 059E 1879 EOR.b d0,FAC_sc(a3) * make sign compare (FAC1_s EOR FAC2_s)
-0000107C 6100 100A 1880 BSR LAB_ADD * add FAC2 to FAC1
-00001080 6100 1306 1881 BSR LAB_PFAC * pack FAC1 into variable (Lvarpl)
-00001084 1882 LAB_INCT
-00001084 6100 0524 1883 BSR LAB_GBYT * scan memory
-00001088 0C00 002C 1884 CMPI.b #$2C,d0 * compare with ","
-0000108C 67BC 1885 BEQ.s LAB_17B8 * continue if "," (another variable to do)
-0000108E 1886
-0000108E 544F 1887 ADDQ.w #2,sp * else dump sign & exponent
-00001090 4E75 1888 RTS
-00001092 1889
-00001092 1890 LAB_INCI
-00001092 4A2F 0001 1891 TST.b 1(sp) * test sign
-00001096 6604 1892 BNE.s LAB_DECI * branch if DEC
-00001098 1893
-00001098 5290 1894 ADDQ.l #1,(a0) * increment variable
-0000109A 60E8 1895 BRA.s LAB_INCT * go scan for more
-0000109C 1896
-0000109C 1897 LAB_DECI
-0000109C 5390 1898 SUBQ.l #1,(a0) * decrement variable
-0000109E 60E4 1899 BRA.s LAB_INCT * go scan for more
-000010A0 1900
-000010A0 1901
-000010A0 1902 *************************************************************************************
-000010A0 1903 *
-000010A0 1904 * perform LET
-000010A0 1905
-000010A0 1906 LAB_LET
-000010A0 6100 0712 1907 BSR LAB_SVAR * search for or create a variable
-000010A4 1908 * return the variable address in a0
-000010A4 2748 0472 1909 MOVE.l a0,Lvarpl(a3) * save variable address
-000010A8 1F2B 05B5 1910 MOVE.b Dtypef(a3),-(sp) * push var data type, $80=string, $40=integer,
-000010AC 1911 * $00=float
-000010AC 70BD 1912 MOVEQ #TK_EQUAL-$100,d0 * get = token
-000010AE 6100 04F0 1913 BSR LAB_SCCA * scan for CHR$(d0), else do syntax error/warm
-000010B2 1914 * start
-000010B2 6100 0394 1915 BSR LAB_EVEX * evaluate expression
-000010B6 102B 05B5 1916 MOVE.b Dtypef(a3),d0 * copy expression data type
-000010BA 175F 05B5 1917 MOVE.b (sp)+,Dtypef(a3) * pop variable data type
-000010BE E318 1918 ROL.b #1,d0 * set carry if expression type = string
-000010C0 6100 0372 1919 BSR LAB_CKTM * type match check, set C for string
-000010C4 6700 12C2 1920 BEQ LAB_PFAC * if number pack FAC1 into variable Lvarpl & RET
-000010C8 1921
-000010C8 1922 * string LET
-000010C8 1923
-000010C8 1924 LAB_17D5
-000010C8 246B 0472 1925 MOVEA.l Lvarpl(a3),a2 * get pointer to variable
-000010CC 1926 LAB_17D6
-000010CC 206B 0590 1927 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer
-000010D0 2250 1928 MOVEA.l (a0),a1 * get string pointer
-000010D2 B3EB 0446 1929 CMP.l Sstorl(a3),a1 * compare string memory start with string
-000010D6 1930 * pointer
-000010D6 6516 1931 BCS.s LAB_1811 * if it was in program memory assign the value
-000010D8 1932 * and exit
-000010D8 1933
-000010D8 B1EB 0432 1934 CMPA.l Sfncl(a3),a0 * compare functions start with descriptor
-000010DC 1935 * pointer
-000010DC 6510 1936 BCS.s LAB_1811 * branch if >= (string is on stack)
-000010DE 1937
-000010DE 1938 * string is variable$ make space and copy string
-000010DE 1939 LAB_1810
-000010DE 7200 1940 MOVEQ #0,d1 * clear length
-000010E0 3228 0004 1941 MOVE.w 4(a0),d1 * get string length
-000010E4 2050 1942 MOVEA.l (a0),a0 * get string pointer
-000010E6 6100 0B04 1943 BSR LAB_20C9 * copy string
-000010EA 206B 0590 1944 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer back
-000010EE 1945 * clean stack & assign value to string variable
-000010EE 1946 LAB_1811
-000010EE B9C8 1947 CMPA.l a0,a4 * is string on the descriptor stack
-000010F0 6602 1948 BNE.s LAB_1813 * skip pop if not
-000010F2 1949
-000010F2 5C4C 1950 ADDQ.w #$06,a4 * else update stack pointer
-000010F4 1951 LAB_1813
-000010F4 24D8 1952 MOVE.l (a0)+,(a2)+ * save pointer to variable
-000010F6 3490 1953 MOVE.w (a0),(a2) * save length to variable
-000010F8 1954 RTS_008
-000010F8 4E75 1955 RTS
-000010FA 1956
-000010FA 1957
-000010FA 1958 *************************************************************************************
-000010FA 1959 *
-000010FA 1960 * perform GET
-000010FA 1961
-000010FA 1962 LAB_GET
-000010FA 6100 06B8 1963 BSR LAB_SVAR * search for or create a variable
-000010FE 1964 * return the variable address in a0
-000010FE 2748 0472 1965 MOVE.l a0,Lvarpl(a3) * save variable address as GET variable
-00001102 4A2B 05B5 1966 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-00001106 1967 * $00=float
-00001106 6B0C 1968 BMI.s LAB_GETS * go get string character
-00001108 1969
-00001108 1970 * was numeric get
-00001108 6100 1DE4 1971 BSR INGET * get input byte
-0000110C 6100 09BA 1972 BSR LAB_1FD0 * convert d0 to unsigned byte in FAC1
-00001110 6000 1276 1973 BRA LAB_PFAC * pack FAC1 into variable (Lvarpl) & return
-00001114 1974
-00001114 1975 LAB_GETS
-00001114 7200 1976 MOVEQ #$00,d1 * assume no byte
-00001116 2041 1977 MOVE.l d1,a0 * assume null string
-00001118 6100 1DD4 1978 BSR INGET * get input byte
-0000111C 6408 1979 BCC.s LAB_NoSt * branch if no byte received
-0000111E 1980
-0000111E 7201 1981 MOVEQ #$01,d1 * string is single byte
-00001120 6100 0AFC 1982 BSR LAB_2115 * make string space d1 bytes long
-00001124 1983 * return a0 = pointer, other registers unchanged
-00001124 1984
-00001124 1080 1985 MOVE.b d0,(a0) * save byte in string (byte IS string!)
-00001126 1986 LAB_NoSt
-00001126 6100 0ADC 1987 BSR LAB_RTST * push string on descriptor stack
-0000112A 1988 * a0 = pointer, d1 = length
-0000112A 1989
-0000112A 609C 1990 BRA.s LAB_17D5 * do string LET & return
-0000112C 1991
-0000112C 1992
-0000112C 1993 *************************************************************************************
-0000112C 1994 *
-0000112C 1995 * PRINT
-0000112C 1996
-0000112C 1997 LAB_1829
-0000112C 6100 00B4 1998 BSR LAB_18C6 * print string from stack
-00001130 1999 LAB_182C
-00001130 6100 0478 2000 BSR LAB_GBYT * scan memory
-00001134 2001
-00001134 2002 * perform PRINT
-00001134 2003
-00001134 2004 LAB_PRINT
-00001134 674A 2005 BEQ.s LAB_CRLF * if nothing following just print CR/LF
-00001136 2006
-00001136 2007 LAB_1831
-00001136 B03C 00A8 2008 CMP.b #TK_TAB,d0 * compare with TAB( token
-0000113A 6764 2009 BEQ.s LAB_18A2 * go do TAB/SPC
-0000113C 2010
-0000113C B03C 00AC 2011 CMP.b #TK_SPC,d0 * compare with SPC( token
-00001140 675E 2012 BEQ.s LAB_18A2 * go do TAB/SPC
-00001142 2013
-00001142 B03C 002C 2014 CMP.b #',',d0 * compare with ","
-00001146 6740 2015 BEQ.s LAB_188B * go do move to next TAB mark
-00001148 2016
-00001148 B03C 003B 2017 CMP.b #';',d0 * compare with ";"
-0000114C 6700 0086 2018 BEQ LAB_18BD * if ";" continue with PRINT processing
-00001150 2019
-00001150 6100 02F6 2020 BSR LAB_EVEX * evaluate expression
-00001154 4A2B 05B5 2021 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-00001158 2022 * $00=float
-00001158 6BD2 2023 BMI.s LAB_1829 * branch if string
-0000115A 2024
-0000115A 2025 ** replace the two lines above with this code
-0000115A 2026
-0000115A 2027 ** MOVE.b Dtypef(a3),d0 * get data type flag, $80=string, $00=numeric
-0000115A 2028 ** BMI.s LAB_1829 * branch if string
-0000115A 2029
-0000115A 6100 13AA 2030 BSR LAB_2970 * convert FAC1 to string
-0000115E 6100 0A5E 2031 BSR LAB_20AE * print " terminated string to FAC1 stack
-00001162 2032
-00001162 2033 * don't check fit if terminal width byte is zero
-00001162 2034
-00001162 7000 2035 MOVEQ #0,d0 * clear d0
-00001164 102B 05E6 2036 MOVE.b TWidth(a3),d0 * get terminal width byte
-00001168 670C 2037 BEQ.s LAB_185E * skip check if zero
-0000116A 2038
-0000116A 902C 0007 2039 SUB.b 7(a4),d0 * subtract string length
-0000116E 902B 05E5 2040 SUB.b TPos(a3),d0 * subtract terminal position
-00001172 6402 2041 BCC.s LAB_185E * branch if less than terminal width
-00001174 2042
-00001174 610A 2043 BSR.s LAB_CRLF * else print CR/LF
-00001176 2044 LAB_185E
-00001176 616A 2045 BSR.s LAB_18C6 * print string from stack
-00001178 60B6 2046 BRA.s LAB_182C * always go continue processing line
-0000117A 2047
-0000117A 2048
-0000117A 2049 *************************************************************************************
-0000117A 2050 *
-0000117A 2051 * CR/LF return to BASIC from BASIC input handler
-0000117A 2052 * leaves a0 pointing to the buffer start
-0000117A 2053
-0000117A 2054 LAB_1866
-0000117A 11BC 0000 1000 2055 MOVE.b #$00,(a0,d1.w) * null terminate input
-00001180 2056
-00001180 2057 * print CR/LF
-00001180 2058
-00001180 2059 LAB_CRLF
-00001180 700D 2060 MOVEQ #$0D,d0 * load [CR]
-00001182 6174 2061 BSR.s LAB_PRNA * go print the character
-00001184 700A 2062 MOVEQ #$0A,d0 * load [LF]
-00001186 6070 2063 BRA.s LAB_PRNA * go print the character & return
-00001188 2064
-00001188 2065 LAB_188B
-00001188 142B 05E5 2066 MOVE.b TPos(a3),d2 * get terminal position
-0000118C B42B 05E7 2067 CMP.b Iclim(a3),d2 * compare with input column limit
-00001190 6504 2068 BCS.s LAB_1898 * branch if less than Iclim
-00001192 2069
-00001192 61EC 2070 BSR.s LAB_CRLF * else print CR/LF (next line)
-00001194 603E 2071 BRA.s LAB_18BD * continue with PRINT processing
-00001196 2072
-00001196 2073 LAB_1898
-00001196 942B 05E2 2074 SUB.b TabSiz(a3),d2 * subtract TAB size
-0000119A 64FA 2075 BCC.s LAB_1898 * loop if result was >= 0
-0000119C 2076
-0000119C 4402 2077 NEG.b d2 * twos complement it
-0000119E 6022 2078 BRA.s LAB_18B7 * print d2 spaces
-000011A0 2079
-000011A0 2080 * do TAB/SPC
-000011A0 2081 LAB_18A2
-000011A0 3F00 2082 MOVE.w d0,-(sp) * save token
-000011A2 6100 0D6A 2083 BSR LAB_SGBY * increment and get byte, result in d0 and Itemp
-000011A6 3400 2084 MOVE.w d0,d2 * copy byte
-000011A8 6100 0400 2085 BSR LAB_GBYT * get basic byte back
-000011AC B03C 0029 2086 CMP.b #$29,d0 * is next character ")"
-000011B0 6600 F7B8 2087 BNE LAB_SNER * if not do syntax error, then warm start
-000011B4 2088
-000011B4 301F 2089 MOVE.w (sp)+,d0 * get token back
-000011B6 B03C 00A8 2090 CMP.b #TK_TAB,d0 * was it TAB ?
-000011BA 6606 2091 BNE.s LAB_18B7 * branch if not (was SPC)
-000011BC 2092
-000011BC 2093 * calculate TAB offset
-000011BC 942B 05E5 2094 SUB.b TPos(a3),d2 * subtract terminal position
-000011C0 6312 2095 BLS.s LAB_18BD * branch if result was <= 0
-000011C2 2096 * can't TAB backwards or already there
-000011C2 2097
-000011C2 2098 * print d2.b spaces
-000011C2 2099 LAB_18B7
-000011C2 7000 2100 MOVEQ #0,d0 * clear longword
-000011C4 5300 2101 SUBQ.b #1,d0 * make d0 = $FF
-000011C6 C480 2102 AND.l d0,d2 * mask for byte only
-000011C8 670A 2103 BEQ.s LAB_18BD * branch if zero
-000011CA 2104
-000011CA 7020 2105 MOVEQ #$20,d0 * load " "
-000011CC 5302 2106 SUBQ.b #1,d2 * adjust for DBF loop
-000011CE 2107 LAB_18B8
-000011CE 6128 2108 BSR.s LAB_PRNA * go print
-000011D0 51CA FFFC 2109 DBF d2,LAB_18B8 * decrement count and loop if not all done
-000011D4 2110
-000011D4 2111 * continue with PRINT processing
-000011D4 2112 LAB_18BD
-000011D4 6100 03D2 2113 BSR LAB_IGBY * increment & scan memory
-000011D8 6600 FF5C 2114 BNE LAB_1831 * if byte continue executing PRINT
-000011DC 2115
-000011DC 4E75 2116 RTS * exit if nothing more to print
-000011DE 2117
-000011DE 2118
-000011DE 2119 *************************************************************************************
-000011DE 2120 *
-000011DE 2121 * print null terminated string from a0
-000011DE 2122
-000011DE 2123 LAB_18C3
-000011DE 6100 09DE 2124 BSR LAB_20AE * print terminated string to FAC1/stack
-000011E2 2125
-000011E2 2126 * print string from stack
-000011E2 2127
-000011E2 2128 LAB_18C6
-000011E2 6100 0BCE 2129 BSR LAB_22B6 * pop string off descriptor stack or from memory
-000011E6 2130 * returns with d0 = length, a0 = pointer
-000011E6 670C 2131 BEQ.s RTS_009 * exit (RTS) if null string
-000011E8 2132
-000011E8 3200 2133 MOVE.w d0,d1 * copy length & set Z flag
-000011EA 5341 2134 SUBQ.w #1,d1 * -1 for BF loop
-000011EC 2135 LAB_18CD
-000011EC 1018 2136 MOVE.b (a0)+,d0 * get byte from string
-000011EE 6108 2137 BSR.s LAB_PRNA * go print the character
-000011F0 51C9 FFFA 2138 DBF d1,LAB_18CD * decrement count and loop if not done yet
-000011F4 2139
-000011F4 2140 RTS_009
-000011F4 4E75 2141 RTS
-000011F6 2142
-000011F6 2143
-000011F6 2144 *************************************************************************************
-000011F6 2145 *
-000011F6 2146 * print "?" character
-000011F6 2147
-000011F6 2148 LAB_18E3
-000011F6 703F 2149 MOVEQ #$3F,d0 * load "?" character
-000011F8 2150
-000011F8 2151
-000011F8 2152 *************************************************************************************
-000011F8 2153 *
-000011F8 2154 * print character in d0, includes the null handler and infinite line length code
-000011F8 2155 * changes no registers
-000011F8 2156
-000011F8 2157 LAB_PRNA
-000011F8 2F01 2158 MOVE.l d1,-(sp) * save d1
-000011FA B03C 0020 2159 CMP.b #$20,d0 * compare with " "
-000011FE 6528 2160 BCS.s LAB_18F9 * branch if less, non printing character
-00001200 2161
-00001200 2162 * don't check fit if terminal width byte is zero
-00001200 122B 05E6 2163 MOVE.b TWidth(a3),d1 * get terminal width
-00001204 6610 2164 BNE.s LAB_18F0 * branch if not zero (not infinite length)
-00001206 2165
-00001206 2166 * is "infinite line" so check TAB position
-00001206 122B 05E5 2167 MOVE.b TPos(a3),d1 * get position
-0000120A 922B 05E2 2168 SUB.b TabSiz(a3),d1 * subtract TAB size
-0000120E 6614 2169 BNE.s LAB_18F7 * skip reset if different
-00001210 2170
-00001210 1741 05E5 2171 MOVE.b d1,TPos(a3) * else reset position
-00001214 600E 2172 BRA.s LAB_18F7 * go print character
-00001216 2173
-00001216 2174 LAB_18F0
-00001216 B22B 05E5 2175 CMP.b TPos(a3),d1 * compare with terminal character position
-0000121A 6608 2176 BNE.s LAB_18F7 * branch if not at end of line
-0000121C 2177
-0000121C 2F00 2178 MOVE.l d0,-(sp) * save d0
-0000121E 6100 FF60 2179 BSR LAB_CRLF * else print CR/LF
-00001222 201F 2180 MOVE.l (sp)+,d0 * restore d0
-00001224 2181 LAB_18F7
-00001224 522B 05E5 2182 ADDQ.b #$01,TPos(a3) * increment terminal position
-00001228 2183 LAB_18F9
-00001228 4EAB 0412 2184 JSR V_OUTP(a3) * output byte via output vector
-0000122C B03C 000D 2185 CMP.b #$0D,d0 * compare with [CR]
-00001230 6618 2186 BNE.s LAB_188A * branch if not [CR]
-00001232 2187
-00001232 2188 * else print nullct nulls after the [CR]
-00001232 7200 2189 MOVEQ #$00,d1 * clear d1
-00001234 122B 05E4 2190 MOVE.b Nullct(a3),d1 * get null count
-00001238 670C 2191 BEQ.s LAB_1886 * branch if no nulls
-0000123A 2192
-0000123A 7000 2193 MOVEQ #$00,d0 * load [NULL]
-0000123C 2194 LAB_1880
-0000123C 4EAB 0412 2195 JSR V_OUTP(a3) * go print the character
-00001240 51C9 FFFA 2196 DBF d1,LAB_1880 * decrement count and loop if not all done
-00001244 2197
-00001244 700D 2198 MOVEQ #$0D,d0 * restore the character
-00001246 2199 LAB_1886
-00001246 1741 05E5 2200 MOVE.b d1,TPos(a3) * clear terminal position
-0000124A 2201 LAB_188A
-0000124A 221F 2202 MOVE.l (sp)+,d1 * restore d1
-0000124C 4E75 2203 RTS
-0000124E 2204
-0000124E 2205
-0000124E 2206 *************************************************************************************
-0000124E 2207 *
-0000124E 2208 * handle bad input data
-0000124E 2209
-0000124E 2210 LAB_1904
-0000124E 2A5F 2211 MOVEA.l (sp)+,a5 * restore execute pointer
-00001250 4A2B 05E0 2212 TST.b Imode(a3) * test input mode flag, $00=INPUT, $98=READ
-00001254 6A0A 2213 BPL.s LAB_1913 * branch if INPUT (go do redo)
-00001256 2214
-00001256 276B 045E 0452 2215 MOVE.l Dlinel(a3),Clinel(a3) * save DATA line as current line
-0000125C 6000 F6E0 2216 BRA LAB_TMER * do type mismatch error, then warm start
-00001260 2217
-00001260 2218 * mode was INPUT
-00001260 2219 LAB_1913
-00001260 41FA 2A68 2220 LEA LAB_REDO(pc),a0 * point to redo message
-00001264 6100 FF78 2221 BSR LAB_18C3 * print null terminated string from memory
-00001268 2A6B 045A 2222 MOVEA.l Cpntrl(a3),a5 * save continue pointer as BASIC execute pointer
-0000126C 4E75 2223 RTS
-0000126E 2224
-0000126E 2225
-0000126E 2226 *************************************************************************************
-0000126E 2227 *
-0000126E 2228 * perform INPUT
-0000126E 2229
-0000126E 2230 LAB_INPUT
-0000126E 6100 0860 2231 BSR LAB_CKRN * check not direct (back here if ok)
-00001272 B03C 0022 2232 CMP.b #'"',d0 * compare the next byte with open quote
-00001276 660E 2233 BNE.s LAB_1934 * if no prompt string just go get the input
-00001278 2234
-00001278 6100 0306 2235 BSR LAB_1BC1 * print "..." string
-0000127C 703B 2236 MOVEQ #';',d0 * set the search character to ";"
-0000127E 6100 0320 2237 BSR LAB_SCCA * scan for CHR$(d0), else do syntax error/warm
-00001282 2238 * start
-00001282 6100 FF5E 2239 BSR LAB_18C6 * print string from Sutill/Sutilh
-00001286 2240 * finished the prompt, now read the data
-00001286 2241 LAB_1934
-00001286 6100 F80C 2242 BSR LAB_INLN * print "? " and get BASIC input
-0000128A 2243 * return a0 pointing to the buffer start
-0000128A 7000 2244 MOVEQ #0,d0 * flag INPUT
-0000128C 2245
-0000128C 2246 * if you don't want a null response to INPUT to break the program then set the nobrk
-0000128C 2247 * value at the top of this file to some non zero value
-0000128C 2248
-0000128C FALSE 2249 ifne nobrk
-0000128C 2250 endc
-0000128C 2251
-0000128C 2252 * if you do want a null response to INPUT to break the program then leave the nobrk
-0000128C 2253 * value at the top of this file set to zero
-0000128C 2254
-0000128C TRUE 2255 ifeq nobrk
-0000128C 2256
-0000128C 4A10 2257 TST.b (a0) * test first byte from buffer
-0000128E 660A 2258 BNE.s LAB_1953 * branch if not null input
-00001290 2259
-00001290 6000 FB5E 2260 BRA LAB_1647 * go do BREAK exit
-00001294 2261
-00001294 2262 endc
-00001294 2263
-00001294 2264
-00001294 2265 *************************************************************************************
-00001294 2266 *
-00001294 2267 * perform READ
-00001294 2268
-00001294 2269 LAB_READ
-00001294 206B 0462 2270 MOVEA.l Dptrl(a3),a0 * get the DATA pointer
-00001298 7098 2271 MOVEQ #$98-$100,d0 * flag READ
-0000129A 2272 LAB_1953
-0000129A 1740 05E0 2273 MOVE.b d0,Imode(a3) * set input mode flag, $00=INPUT, $98=READ
-0000129E 2748 0466 2274 MOVE.l a0,Rdptrl(a3) * save READ pointer
-000012A2 2275
-000012A2 2276 * READ or INPUT the next variable from list
-000012A2 2277 LAB_195B
-000012A2 6100 0510 2278 BSR LAB_SVAR * search for or create a variable
-000012A6 2279 * return the variable address in a0
-000012A6 2748 0472 2280 MOVE.l a0,Lvarpl(a3) * save variable address as LET variable
-000012AA 2F0D 2281 MOVE.l a5,-(sp) * save BASIC execute pointer
-000012AC 2282 LAB_1961
-000012AC 2A6B 0466 2283 MOVEA.l Rdptrl(a3),a5 * set READ pointer as BASIC execute pointer
-000012B0 6100 02F8 2284 BSR LAB_GBYT * scan memory
-000012B4 661E 2285 BNE.s LAB_1986 * if not null go get the value
-000012B6 2286
-000012B6 2287 * the pointer was to a null entry
-000012B6 4A2B 05E0 2288 TST.b Imode(a3) * test input mode flag, $00=INPUT, $98=READ
-000012BA 6B72 2289 BMI.s LAB_19DD * branch if READ (go find the next statement)
-000012BC 2290
-000012BC 2291 * else the mode was INPUT so get more
-000012BC 6100 FF38 2292 BSR LAB_18E3 * print a "?" character
-000012C0 6100 F7D2 2293 BSR LAB_INLN * print "? " and get BASIC input
-000012C4 2294 * return a0 pointing to the buffer start
-000012C4 2295
-000012C4 2296 * if you don't want a null response to INPUT to break the program then set the nobrk
-000012C4 2297 * value at the top of this file to some non zero value
-000012C4 2298
-000012C4 FALSE 2299 ifne nobrk
-000012C4 2300 endc
-000012C4 2301
-000012C4 2302 * if you do want a null response to INPUT to break the program then leave the nobrk
-000012C4 2303 * value at the top of this file set to zero
-000012C4 2304
-000012C4 TRUE 2305 ifeq nobrk
-000012C4 2306
-000012C4 4A10 2307 TST.b (a0) * test the first byte from the buffer
-000012C6 6604 2308 BNE.s LAB_1984 * if not null input go handle it
-000012C8 2309
-000012C8 6000 FB26 2310 BRA LAB_1647 * else go do the BREAK exit
-000012CC 2311
-000012CC 2312 LAB_1984
-000012CC 2A48 2313 MOVEA.l a0,a5 * set the execute pointer to the buffer
-000012CE 534D 2314 SUBQ.w #1,a5 * decrement the execute pointer
-000012D0 2315
-000012D0 2316 endc
-000012D0 2317
-000012D0 2318 LAB_1985
-000012D0 6100 02D6 2319 BSR LAB_IGBY * increment & scan memory
-000012D4 2320 LAB_1986
-000012D4 4A2B 05B5 2321 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-000012D8 2322 * $00=float
-000012D8 6A20 2323 BPL.s LAB_19B0 * branch if numeric
-000012DA 2324
-000012DA 2325 * else get string
-000012DA 1400 2326 MOVE.b d0,d2 * save search character
-000012DC B03C 0022 2327 CMP.b #$22,d0 * was it " ?
-000012E0 6706 2328 BEQ.s LAB_1999 * branch if so
-000012E2 2329
-000012E2 743A 2330 MOVEQ #':',d2 * set new search character
-000012E4 702C 2331 MOVEQ #',',d0 * other search character is ","
-000012E6 534D 2332 SUBQ.w #1,a5 * decrement BASIC execute pointer
-000012E8 2333 LAB_1999
-000012E8 524D 2334 ADDQ.w #1,a5 * increment BASIC execute pointer
-000012EA 1600 2335 MOVE.b d0,d3 * set second search character
-000012EC 204D 2336 MOVEA.l a5,a0 * BASIC execute pointer is source
-000012EE 2337
-000012EE 6100 08D2 2338 BSR LAB_20B4 * print d2/d3 terminated string to FAC1 stack
-000012F2 2339 * d2 = Srchc, d3 = Asrch, a0 is source
-000012F2 2A4A 2340 MOVEA.l a2,a5 * copy end of string to BASIC execute pointer
-000012F4 6100 FDD2 2341 BSR LAB_17D5 * go do string LET
-000012F8 6010 2342 BRA.s LAB_19B6 * go check string terminator
-000012FA 2343
-000012FA 2344 * get numeric INPUT
-000012FA 2345 LAB_19B0
-000012FA 1F2B 05B5 2346 MOVE.b Dtypef(a3),-(sp) * save variable data type
-000012FE 6100 1D98 2347 BSR LAB_2887 * get FAC1 from string
-00001302 175F 05B5 2348 MOVE.b (sp)+,Dtypef(a3) * restore variable data type
-00001306 6100 1080 2349 BSR LAB_PFAC * pack FAC1 into (Lvarpl)
-0000130A 2350 LAB_19B6
-0000130A 6100 029E 2351 BSR LAB_GBYT * scan memory
-0000130E 670A 2352 BEQ.s LAB_19C2 * branch if null (last entry)
-00001310 2353
-00001310 B03C 002C 2354 CMP.b #',',d0 * else compare with ","
-00001314 6600 FF38 2355 BNE LAB_1904 * if not "," go handle bad input data
-00001318 2356
-00001318 524D 2357 ADDQ.w #1,a5 * else was "," so point to next chr
-0000131A 2358 * got good input data
-0000131A 2359 LAB_19C2
-0000131A 274D 0466 2360 MOVE.l a5,Rdptrl(a3) * save the read pointer for now
-0000131E 2A5F 2361 MOVEA.l (sp)+,a5 * restore the execute pointer
-00001320 6100 0288 2362 BSR LAB_GBYT * scan the memory
-00001324 6736 2363 BEQ.s LAB_1A03 * if null go do extra ignored message
-00001326 2364
-00001326 487A FF7A 2365 PEA LAB_195B(pc) * set return address
-0000132A 6000 0272 2366 BRA LAB_1C01 * scan for "," else do syntax error/warm start
-0000132E 2367 * then go INPUT next variable from list
-0000132E 2368
-0000132E 2369 * find next DATA statement or do "Out of Data"
-0000132E 2370 * error
-0000132E 2371 LAB_19DD
-0000132E 6100 FC04 2372 BSR LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
-00001332 2373 * returns a0 as pointer to [:] or [EOL]
-00001332 2A48 2374 MOVEA.l a0,a5 * add index, now = pointer to [EOL]/[EOS]
-00001334 524D 2375 ADDQ.w #1,a5 * pointer to next character
-00001336 B03C 003A 2376 CMP.b #':',d0 * was it statement end?
-0000133A 6712 2377 BEQ.s LAB_19F6 * branch if [:]
-0000133C 2378
-0000133C 2379 * was [EOL] so find next line
-0000133C 2380
-0000133C 320D 2381 MOVE.w a5,d1 * past pad byte(s)
-0000133E C27C 0001 2382 AND.w #1,d1 * mask odd bit
-00001342 DAC1 2383 ADD.w d1,a5 * add pointer
-00001344 241D 2384 MOVE.l (a5)+,d2 * get next line pointer
-00001346 6700 F61A 2385 BEQ LAB_ODER * branch if end of program
-0000134A 2386
-0000134A 275D 045E 2387 MOVE.l (a5)+,Dlinel(a3) * save current DATA line
-0000134E 2388 LAB_19F6
-0000134E 6100 025A 2389 BSR LAB_GBYT * scan memory
-00001352 B03C 0083 2390 CMP.b #TK_DATA,d0 * compare with "DATA" token
-00001356 6700 FF78 2391 BEQ LAB_1985 * was "DATA" so go do next READ
-0000135A 2392
-0000135A 60D2 2393 BRA.s LAB_19DD * go find next statement if not "DATA"
-0000135C 2394
-0000135C 2395 * end of INPUT/READ routine
-0000135C 2396
-0000135C 2397 LAB_1A03
-0000135C 206B 0466 2398 MOVEA.l Rdptrl(a3),a0 * get temp READ pointer
-00001360 4A2B 05E0 2399 TST.b Imode(a3) * get input mode flag, $00=INPUT, $98=READ
-00001364 6A06 2400 BPL.s LAB_1A0E * branch if INPUT
-00001366 2401
-00001366 2748 0462 2402 MOVE.l a0,Dptrl(a3) * else save temp READ pointer as DATA pointer
-0000136A 4E75 2403 RTS
-0000136C 2404
-0000136C 2405 * we were getting INPUT
-0000136C 2406 LAB_1A0E
-0000136C 4A10 2407 TST.b (a0) * test next byte
-0000136E 6602 2408 BNE.s LAB_1A1B * error if not end of INPUT
-00001370 2409
-00001370 4E75 2410 RTS
-00001372 2411 * user typed too much
-00001372 2412 LAB_1A1B
-00001372 41FA 2946 2413 LEA LAB_IMSG(pc),a0 * point to extra ignored message
-00001376 6000 FE66 2414 BRA LAB_18C3 * print null terminated string from memory & RTS
-0000137A 2415
-0000137A 2416
-0000137A 2417 *************************************************************************************
-0000137A 2418 *
-0000137A 2419 * perform NEXT
-0000137A 2420
-0000137A 2421 LAB_NEXT
-0000137A 6610 2422 BNE.s LAB_1A46 * branch if NEXT var
-0000137C 2423
-0000137C 584F 2424 ADDQ.w #4,sp * back past return address
-0000137E 0C57 0081 2425 CMP.w #TK_FOR,(sp) * is FOR token on stack?
-00001382 6600 F5EA 2426 BNE LAB_NFER * if not do NEXT without FOR err/warm start
-00001386 2427
-00001386 206F 0002 2428 MOVEA.l 2(sp),a0 * get stacked FOR variable pointer
-0000138A 601C 2429 BRA.s LAB_11BD * branch always (no variable to search for)
-0000138C 2430
-0000138C 2431 * NEXT var
-0000138C 2432
-0000138C 2433 LAB_1A46
-0000138C 6100 042A 2434 BSR LAB_GVAR * get variable address in a0
-00001390 584F 2435 ADDQ.w #4,sp * back past return address
-00001392 303C 0081 2436 MOVE.w #TK_FOR,d0 * set for FOR token
-00001396 721C 2437 MOVEQ #$1C,d1 * set for FOR use size
-00001398 6002 2438 BRA.s LAB_11A6 * enter loop for next variable search
-0000139A 2439
-0000139A 2440 LAB_11A5
-0000139A DFC1 2441 ADDA.l d1,sp * add FOR stack use size
-0000139C 2442 LAB_11A6
-0000139C B057 2443 CMP.w (sp),d0 * is FOR token on stack?
-0000139E 6600 F5CE 2444 BNE LAB_NFER * if not found do NEXT without FOR error and
-000013A2 2445 * warm start
-000013A2 2446
-000013A2 2447 * was FOR token
-000013A2 B1EF 0002 2448 CMPA.l 2(sp),a0 * compare var pointer with stacked var pointer
-000013A6 66F2 2449 BNE.s LAB_11A5 * loop if no match found
-000013A8 2450
-000013A8 2451 LAB_11BD
-000013A8 376F 0006 059C 2452 MOVE.w 6(sp),FAC2_e(a3) * get STEP value exponent and sign
-000013AE 276F 0008 0598 2453 MOVE.l 8(sp),FAC2_m(a3) * get STEP value mantissa
-000013B4 2454
-000013B4 176F 0012 05B5 2455 MOVE.b 18(sp),Dtypef(a3) * restore FOR variable data type
-000013BA 6100 021C 2456 BSR LAB_1C19 * check type and unpack (a0)
-000013BE 2457
-000013BE 176B 059D 059E 2458 MOVE.b FAC2_s(a3),FAC_sc(a3) * save FAC2 sign as sign compare
-000013C4 102B 0595 2459 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
-000013C8 B12B 059E 2460 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
-000013CC 2461
-000013CC 2748 0472 2462 MOVE.l a0,Lvarpl(a3) * save variable pointer
-000013D0 6100 0CB6 2463 BSR LAB_ADD * add STEP value to FOR variable
-000013D4 176F 0012 05B5 2464 MOVE.b 18(sp),Dtypef(a3) * restore FOR variable data type (again)
-000013DA 6100 0FAC 2465 BSR LAB_PFAC * pack FAC1 into FOR variable (Lvarpl)
-000013DE 2466
-000013DE 376F 000C 059C 2467 MOVE.w 12(sp),FAC2_e(a3) * get TO value exponent and sign
-000013E4 276F 000E 0598 2468 MOVE.l 14(sp),FAC2_m(a3) * get TO value mantissa
-000013EA 2469
-000013EA 176B 059D 059E 2470 MOVE.b FAC2_s(a3),FAC_sc(a3) * save FAC2 sign as sign compare
-000013F0 102B 0595 2471 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
-000013F4 B12B 059E 2472 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
-000013F8 2473
-000013F8 6100 1038 2474 BSR LAB_27FA * compare FAC1 with FAC2 (TO value)
-000013FC 2475 * returns d0=+1 if FAC1 > FAC2
-000013FC 2476 * returns d0= 0 if FAC1 = FAC2
-000013FC 2477 * returns d0=-1 if FAC1 < FAC2
-000013FC 2478
-000013FC 322F 0006 2479 MOVE.w 6(sp),d1 * get STEP value exponent and sign
-00001400 B141 2480 EOR.w d0,d1 * EOR compare result with STEP exponent and sign
-00001402 2481
-00001402 4A00 2482 TST.b d0 * test for =
-00001404 6704 2483 BEQ.s LAB_1A90 * branch if = (loop INcomplete)
-00001406 2484
-00001406 4A01 2485 TST.b d1 * test result
-00001408 6A0E 2486 BPL.s LAB_1A9B * branch if > (loop complete)
-0000140A 2487
-0000140A 2488 * loop back and do it all again
-0000140A 2489 LAB_1A90
-0000140A 276F 0014 0452 2490 MOVE.l 20(sp),Clinel(a3) * reset current line
-00001410 2A6F 0018 2491 MOVE.l 24(sp),a5 * reset BASIC execute pointer
-00001414 6000 F976 2492 BRA LAB_15C2 * go do interpreter inner loop
-00001418 2493
-00001418 2494 * loop complete so carry on
-00001418 2495 LAB_1A9B
-00001418 DEFC 001C 2496 ADDA.w #28,sp * add 28 to dump FOR structure
-0000141C 6100 018C 2497 BSR LAB_GBYT * scan memory
-00001420 B03C 002C 2498 CMP.b #$2C,d0 * compare with ","
-00001424 6600 F966 2499 BNE LAB_15C2 * if not "," go do interpreter inner loop
-00001428 2500
-00001428 2501 * was "," so another NEXT variable to do
-00001428 6100 017E 2502 BSR LAB_IGBY * else increment & scan memory
-0000142C 6100 FF5E 2503 BSR LAB_1A46 * do NEXT (var)
-00001430 2504
-00001430 2505
-00001430 2506 *************************************************************************************
-00001430 2507 *
-00001430 2508 * evaluate expression & check is numeric, else do type mismatch
-00001430 2509
-00001430 2510 LAB_EVNM
-00001430 6116 2511 BSR.s LAB_EVEX * evaluate expression
-00001432 2512
-00001432 2513
-00001432 2514 *************************************************************************************
-00001432 2515 *
-00001432 2516 * check if source is numeric, else do type mismatch
-00001432 2517
-00001432 2518 LAB_CTNM
-00001432 B040 2519 CMP.w d0,d0 * required type is numeric so clear carry
-00001434 2520
-00001434 2521
-00001434 2522 *************************************************************************************
-00001434 2523 *
-00001434 2524 * type match check, set C for string, clear C for numeric
-00001434 2525
-00001434 2526 LAB_CKTM
-00001434 082B 0007 05B5 2527 BTST.b #7,Dtypef(a3) * test data type flag, don't change carry
-0000143A 6606 2528 BNE.s LAB_1ABA * branch if data type is string
-0000143C 2529
-0000143C 2530 * else data type was numeric
-0000143C 6500 F500 2531 BCS LAB_TMER * if required type is string do type mismatch
-00001440 2532 * error
-00001440 2533
-00001440 4E75 2534 RTS
-00001442 2535 * data type was string, now check required type
-00001442 2536 LAB_1ABA
-00001442 6400 F4FA 2537 BCC LAB_TMER * if required type is numeric do type mismatch
-00001446 2538 * error
-00001446 4E75 2539 RTS
-00001448 2540
-00001448 2541
-00001448 2542 *************************************************************************************
-00001448 2543 *
-00001448 2544 * this routine evaluates any type of expression. first it pushes an end marker so
-00001448 2545 * it knows when the expression has been evaluated, this is a precedence value of zero.
-00001448 2546 * next the first value is evaluated, this can be an in line value, either numeric or
-00001448 2547 * string, a variable or array element of any type, a function or even an expression
-00001448 2548 * in parenthesis. this value is kept in FAC_1
-00001448 2549 * after the value is evaluated a test is made on the next BASIC program byte, if it
-00001448 2550 * is a comparrison operator i.e. "<", "=" or ">", then the corresponding bit is set
-00001448 2551 * in the comparison evaluation flag. this test loops until no more comparrison operators
-00001448 2552 * are found or more than one of any type is found. in the last case an error is generated
-00001448 2553
-00001448 2554 * evaluate expression
-00001448 2555
-00001448 2556 LAB_EVEX
-00001448 534D 2557 SUBQ.w #1,a5 * decrement BASIC execute pointer
-0000144A 2558 LAB_EVEZ
-0000144A 7200 2559 MOVEQ #0,d1 * clear precedence word
-0000144C 1741 05B5 2560 MOVE.b d1,Dtypef(a3) * clear the data type, $80=string, $40=integer,
-00001450 2561 * $00=float
-00001450 601C 2562 BRA.s LAB_1ACD * enter loop
-00001452 2563
-00001452 2564 * get vector, set up operator then continue evaluation
-00001452 2565
-00001452 2566 LAB_1B43 *
-00001452 41FA 22BC 2567 LEA LAB_OPPT(pc),a0 * point to operator vector table
-00001456 3030 1002 2568 MOVE.w 2(a0,d1.w),d0 * get vector offset
-0000145A 4870 0000 2569 PEA (a0,d0.w) * push vector
-0000145E 2570
-0000145E 2F2B 0590 2571 MOVE.l FAC1_m(a3),-(sp) * push FAC1 mantissa
-00001462 3F2B 0594 2572 MOVE.w FAC1_e(a3),-(sp) * push sign and exponent
-00001466 1F2B 05E3 2573 MOVE.b comp_f(a3),-(sp) * push comparison evaluation flag
-0000146A 2574
-0000146A 3230 1000 2575 MOVE.w (a0,d1.w),d1 * get precedence value
-0000146E 2576 LAB_1ACD
-0000146E 3F01 2577 MOVE.w d1,-(sp) * push precedence value
-00001470 6100 00E4 2578 BSR LAB_GVAL * get value from line
-00001474 177C 0000 05E3 2579 MOVE.b #$00,comp_f(a3) * clear compare function flag
-0000147A 2580 LAB_1ADB
-0000147A 6100 012E 2581 BSR LAB_GBYT * scan memory
-0000147E 2582 LAB_1ADE
-0000147E 0400 00BC 2583 SUB.b #TK_GT,d0 * subtract token for > (lowest compare function)
-00001482 652A 2584 BCS.s LAB_1AFA * branch if < TK_GT
-00001484 2585
-00001484 B03C 0003 2586 CMP.b #$03,d0 * compare with ">" to "<" tokens
-00001488 650A 2587 BCS.s LAB_1AE0 * branch if <= TK_SGN (is compare function)
-0000148A 2588
-0000148A 4A2B 05E3 2589 TST.b comp_f(a3) * test compare function flag
-0000148E 6660 2590 BNE.s LAB_1B2A * branch if compare function
-00001490 2591
-00001490 6000 0086 2592 BRA LAB_1B78 * go do functions
-00001494 2593
-00001494 2594 * was token for > = or < (d0 = 0, 1 or 2)
-00001494 2595 LAB_1AE0
-00001494 7201 2596 MOVEQ #1,d1 * set to 0000 0001
-00001496 E121 2597 ASL.b d0,d1 * 1 if >, 2 if =, 4 if <
-00001498 102B 05E3 2598 MOVE.b comp_f(a3),d0 * copy old compare function flag
-0000149C B32B 05E3 2599 EOR.b d1,comp_f(a3) * EOR in this compare function bit
-000014A0 B02B 05E3 2600 CMP.b comp_f(a3),d0 * compare old with new compare function flag
-000014A4 6400 F4C4 2601 BCC LAB_SNER * if new <= old comp_f do syntax error and warm
-000014A8 2602 * start, there was more than one <, = or >
-000014A8 6100 00FE 2603 BSR LAB_IGBY * increment & scan memory
-000014AC 60D0 2604 BRA.s LAB_1ADE * go do next character
-000014AE 2605
-000014AE 2606 * token is < ">" or > "<" tokens
-000014AE 2607 LAB_1AFA
-000014AE 4A2B 05E3 2608 TST.b comp_f(a3) * test compare function flag
-000014B2 663C 2609 BNE.s LAB_1B2A * branch if compare function
-000014B4 2610
-000014B4 2611 * was < TK_GT so is operator or lower
-000014B4 0600 000A 2612 ADD.b #(TK_GT-TK_PLUS),d0 * add # of operators (+ - * / ^ AND OR EOR)
-000014B8 645E 2613 BCC.s LAB_1B78 * branch if < + operator
-000014BA 2614
-000014BA 6608 2615 BNE.s LAB_1B0B * branch if not + token
-000014BC 2616
-000014BC 4A2B 05B5 2617 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-000014C0 2618 * $00=float
-000014C0 6B00 087C 2619 BMI LAB_224D * type is string & token was +
-000014C4 2620
-000014C4 2621 LAB_1B0B
-000014C4 7200 2622 MOVEQ #0,d1 * clear longword
-000014C6 D000 2623 ADD.b d0,d0 * *2
-000014C8 D000 2624 ADD.b d0,d0 * *4
-000014CA 1200 2625 MOVE.b d0,d1 * copy to index
-000014CC 2626 LAB_1B13
-000014CC 301F 2627 MOVE.w (sp)+,d0 * pull previous precedence
-000014CE 41FA 2240 2628 LEA LAB_OPPT(pc),a0 * set pointer to operator table
-000014D2 B070 1000 2629 CMP.w (a0,d1.w),d0 * compare with this opperator precedence
-000014D6 6446 2630 BCC.s LAB_1B7D * branch if previous precedence (d0) >=
-000014D8 2631
-000014D8 6100 FF58 2632 BSR LAB_CTNM * check if source is numeric, else type mismatch
-000014DC 2633 LAB_1B1C
-000014DC 3F00 2634 MOVE.w d0,-(sp) * save precedence
-000014DE 2635 LAB_1B1D
-000014DE 6100 FF72 2636 BSR LAB_1B43 * get vector, set-up operator and continue
-000014E2 2637 * evaluation
-000014E2 301F 2638 MOVE.w (sp)+,d0 * restore precedence
-000014E4 222B 05D8 2639 MOVE.l prstk(a3),d1 * get stacked function pointer
-000014E8 6A22 2640 BPL.s LAB_1B3C * branch if stacked values
-000014EA 2641
-000014EA 3000 2642 MOVE.w d0,d0 * copy precedence (set flags)
-000014EC 672E 2643 BEQ.s LAB_1B7B * exit if done
-000014EE 2644
-000014EE 603C 2645 BRA.s LAB_1B86 * else pop FAC2 & return (do function)
-000014F0 2646
-000014F0 2647 * was compare function (< = >)
-000014F0 2648 LAB_1B2A
-000014F0 102B 05B5 2649 MOVE.b Dtypef(a3),d0 * get data type flag
-000014F4 122B 05E3 2650 MOVE.b comp_f(a3),d1 * get compare function flag
-000014F8 D000 2651 ADD.b d0,d0 * string bit flag into X bit
-000014FA D301 2652 ADDX.b d1,d1 * shift compare function flag
-000014FC 2653
-000014FC 177C 0000 05B5 2654 MOVE.b #0,Dtypef(a3) * clear data type flag, $00=float
-00001502 1741 05E3 2655 MOVE.b d1,comp_f(a3) * save new compare function flag
-00001506 534D 2656 SUBQ.w #1,a5 * decrement BASIC execute pointer
-00001508 7230 2657 MOVEQ #(TK_LT-TK_PLUS)*4,d1 * set offset to last operator entry
-0000150A 60C0 2658 BRA.s LAB_1B13 * branch always
-0000150C 2659
-0000150C 2660 LAB_1B3C
-0000150C 41FA 2202 2661 LEA LAB_OPPT(pc),a0 * point to function vector table
-00001510 B070 1000 2662 CMP.w (a0,d1.w),d0 * compare with this opperator precedence
-00001514 6416 2663 BCC.s LAB_1B86 * branch if d0 >=, pop FAC2 & return
-00001516 2664
-00001516 60C4 2665 BRA.s LAB_1B1C * branch always
-00001518 2666
-00001518 2667 * do functions
-00001518 2668
-00001518 2669 LAB_1B78
-00001518 72FF 2670 MOVEQ #-1,d1 * flag all done
-0000151A 301F 2671 MOVE.w (sp)+,d0 * pull precedence word
-0000151C 2672 LAB_1B7B
-0000151C 6732 2673 BEQ.s LAB_1B9D * exit if done
-0000151E 2674
-0000151E 2675 LAB_1B7D
-0000151E B07C 0064 2676 CMP.w #$64,d0 * compare previous precedence with $64
-00001522 6704 2677 BEQ.s LAB_1B84 * branch if was $64 (< function can be string)
-00001524 2678
-00001524 6100 FF0C 2679 BSR LAB_CTNM * check if source is numeric, else type mismatch
-00001528 2680 LAB_1B84
-00001528 2741 05D8 2681 MOVE.l d1,prstk(a3) * save current operator index
-0000152C 2682
-0000152C 2683 * pop FAC2 & return
-0000152C 2684 LAB_1B86
-0000152C 101F 2685 MOVE.b (sp)+,d0 * pop comparison evaluation flag
-0000152E 1200 2686 MOVE.b d0,d1 * copy comparison evaluation flag
-00001530 E208 2687 LSR.b #1,d0 * shift out comparison evaluation lowest bit
-00001532 1740 05E1 2688 MOVE.b d0,Cflag(a3) * save comparison evaluation flag
-00001536 375F 059C 2689 MOVE.w (sp)+,FAC2_e(a3) * pop exponent and sign
-0000153A 275F 0598 2690 MOVE.l (sp)+,FAC2_m(a3) * pop mantissa
-0000153E 176B 059D 059E 2691 MOVE.b FAC2_s(a3),FAC_sc(a3) * copy FAC2 sign
-00001544 102B 0595 2692 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
-00001548 B12B 059E 2693 EOR.b d0,FAC_sc(a3) * EOR FAC1 sign and set sign compare
-0000154C 2694
-0000154C E209 2695 LSR.b #1,d1 * type bit into X and C
-0000154E 4E75 2696 RTS
-00001550 2697
-00001550 2698 LAB_1B9D
-00001550 102B 0594 2699 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
-00001554 4E75 2700 RTS
-00001556 2701
-00001556 2702
-00001556 2703 *************************************************************************************
-00001556 2704 *
-00001556 2705 * get a value from the BASIC line
-00001556 2706
-00001556 2707 LAB_GVAL
-00001556 6150 2708 BSR.s LAB_IGBY * increment & scan memory
-00001558 6500 1B3E 2709 BCS LAB_2887 * if numeric get FAC1 from string & return
-0000155C 2710
-0000155C 4A00 2711 TST.b d0 * test byte
-0000155E 6B00 008E 2712 BMI LAB_1BD0 * if -ve go test token values
-00001562 2713
-00001562 2714 * else it is either a string, number, variable
-00001562 2715 * or ()
-00001562 B03C 0024 2716 CMP.b #'$',d0 * compare with "$"
-00001566 6700 1B30 2717 BEQ LAB_2887 * if "$" get hex number from string & return
-0000156A 2718
-0000156A B03C 0025 2719 CMP.b #'%',d0 * else compare with "%"
-0000156E 6700 1B28 2720 BEQ LAB_2887 * if "%" get binary number from string & return
-00001572 2721
-00001572 B03C 002E 2722 CMP.b #$2E,d0 * compare with "."
-00001576 6700 1B20 2723 BEQ LAB_2887 * if so get FAC1 from string and return
-0000157A 2724 * (e.g. .123)
-0000157A 2725
-0000157A 2726 * wasn't a number so ...
-0000157A B03C 0022 2727 CMP.b #$22,d0 * compare with "
-0000157E 660C 2728 BNE.s LAB_1BF3 * if not open quote it must be a variable or
-00001580 2729 * open bracket
-00001580 2730
-00001580 2731 * was open quote so get the enclosed string
-00001580 2732
-00001580 2733 * print "..." string to string stack
-00001580 2734
-00001580 2735 LAB_1BC1
-00001580 101D 2736 MOVE.b (a5)+,d0 * increment BASIC execute pointer (past ")
-00001582 2737 * fastest/shortest method
-00001582 204D 2738 MOVEA.l a5,a0 * copy basic execute pointer (string start)
-00001584 6100 0638 2739 BSR LAB_20AE * print " terminated string to stack
-00001588 2A4A 2740 MOVEA.l a2,a5 * restore BASIC execute pointer from temp
-0000158A 4E75 2741 RTS
-0000158C 2742
-0000158C 2743 * get value from line .. continued
-0000158C 2744 * wasn't any sort of number so ...
-0000158C 2745 LAB_1BF3
-0000158C B03C 0028 2746 CMP.b #'(',d0 * compare with "("
-00001590 6642 2747 BNE.s LAB_1C18 * if not "(" get (var) and return value in FAC1
-00001592 2748 * and $ flag
-00001592 2749
-00001592 2750
-00001592 2751 *************************************************************************************
-00001592 2752 *
-00001592 2753 * evaluate expression within parentheses
-00001592 2754
-00001592 2755 LAB_1BF7
-00001592 6100 FEB6 2756 BSR LAB_EVEZ * evaluate expression (no decrement)
-00001596 2757
-00001596 2758
-00001596 2759 *************************************************************************************
-00001596 2760 *
-00001596 2761 * all the 'scan for' routines return the character after the sought character
-00001596 2762
-00001596 2763 * scan for ")", else do syntax error, then warm start
-00001596 2764
-00001596 2765 LAB_1BFB
-00001596 7029 2766 MOVEQ #$29,d0 * load d0 with ")"
-00001598 6006 2767 BRA.s LAB_SCCA
-0000159A 2768
-0000159A 2769
-0000159A 2770 *************************************************************************************
-0000159A 2771 *
-0000159A 2772 * scan for "," and get byte, else do Syntax error then warm start
-0000159A 2773
-0000159A 2774 LAB_SCGB
-0000159A 487A 0976 2775 PEA LAB_GTBY(pc) * return address is to get byte parameter
-0000159E 2776
-0000159E 2777
-0000159E 2778 *************************************************************************************
-0000159E 2779 *
-0000159E 2780 * scan for ",", else do syntax error, then warm start
-0000159E 2781
-0000159E 2782 LAB_1C01
-0000159E 702C 2783 MOVEQ #$2C,d0 * load d0 with ","
-000015A0 2784
-000015A0 2785
-000015A0 2786 *************************************************************************************
-000015A0 2787 *
-000015A0 2788 * scan for CHR$(d0) , else do syntax error, then warm start
-000015A0 2789
-000015A0 2790 LAB_SCCA
-000015A0 B01D 2791 CMP.b (a5)+,d0 * check next byte is = d0
-000015A2 6706 2792 BEQ.s LAB_GBYT * if so go get next
-000015A4 2793
-000015A4 6000 F3C4 2794 BRA LAB_SNER * else do syntax error/warm start
-000015A8 2795
-000015A8 2796
-000015A8 2797 *************************************************************************************
-000015A8 2798 *
-000015A8 2799 * BASIC increment and scan memory routine
-000015A8 2800
-000015A8 2801 LAB_IGBY
-000015A8 101D 2802 MOVE.b (a5)+,d0 * get byte & increment pointer
-000015AA 2803
-000015AA 2804 * scan memory routine, exit with Cb = 1 if numeric character
-000015AA 2805 * also skips any spaces encountered
-000015AA 2806
-000015AA 2807 LAB_GBYT
-000015AA 1015 2808 MOVE.b (a5),d0 * get byte
-000015AC 2809
-000015AC B03C 0020 2810 CMP.b #$20,d0 * compare with " "
-000015B0 67F6 2811 BEQ.s LAB_IGBY * if " " go do next
-000015B2 2812
-000015B2 2813 * test current BASIC byte, exit with Cb = 1 if numeric character
-000015B2 2814
-000015B2 B03C 00A9 2815 CMP.b #TK_ELSE,d0 * compare with the token for ELSE
-000015B6 640C 2816 BCC.s RTS_001 * exit if >= (not numeric, carry clear)
-000015B8 2817
-000015B8 B03C 003A 2818 CMP.b #$3A,d0 * compare with ":"
-000015BC 6406 2819 BCC.s RTS_001 * exit if >= (not numeric, carry clear)
-000015BE 2820
-000015BE 7CD0 2821 MOVEQ #$D0,d6 * set -"0"
-000015C0 D006 2822 ADD.b d6,d0 * add -"0"
-000015C2 9006 2823 SUB.b d6,d0 * subtract -"0"
-000015C4 2824 RTS_001 * carry set if byte = "0"-"9"
-000015C4 4E75 2825 RTS
-000015C6 2826
-000015C6 2827
-000015C6 2828 *************************************************************************************
-000015C6 2829 *
-000015C6 2830 * set-up for - operator
-000015C6 2831
-000015C6 2832 LAB_1C11
-000015C6 6100 FE6A 2833 BSR LAB_CTNM * check if source is numeric, else type mismatch
-000015CA 7228 2834 MOVEQ #(TK_GT-TK_PLUS)*4,d1 * set offset from base to - operator
-000015CC 2835 LAB_1C13
-000015CC 4FEF 0004 2836 LEA 4(sp),sp * dump GVAL return address
-000015D0 6000 FF0C 2837 BRA LAB_1B1D * continue evaluating expression
-000015D4 2838
-000015D4 2839
-000015D4 2840 *************************************************************************************
-000015D4 2841 *
-000015D4 2842 * variable name set-up
-000015D4 2843 * get (var), return value in FAC_1 & data type flag
-000015D4 2844
-000015D4 2845 LAB_1C18
-000015D4 6100 01E2 2846 BSR LAB_GVAR * get variable address in a0
-000015D8 2847
-000015D8 2848 * if you want a non existant variable to return a null value then set the novar
-000015D8 2849 * value at the top of this file to some non zero value
-000015D8 2850
-000015D8 FALSE 2851 ifne novar
-000015D8 2852 endc
-000015D8 2853
-000015D8 2854 * return existing variable value
-000015D8 2855
-000015D8 2856 LAB_1C19
-000015D8 4A2B 05B5 2857 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-000015DC 2858 * $00=float
-000015DC 6700 0D8E 2859 BEQ LAB_UFAC * if float unpack memory (a0) into FAC1 and
-000015E0 2860 * return
-000015E0 2861
-000015E0 6A06 2862 BPL.s LAB_1C1A * if integer unpack memory (a0) into FAC1
-000015E2 2863 * and return
-000015E2 2864
-000015E2 2748 0590 2865 MOVE.l a0,FAC1_m(a3) * else save descriptor pointer in FAC1
-000015E6 4E75 2866 RTS
-000015E8 2867
-000015E8 2868 LAB_1C1A
-000015E8 2010 2869 MOVE.l (a0),d0 * get integer value
-000015EA 6000 04BC 2870 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-000015EE 2871
-000015EE 2872
-000015EE 2873 *************************************************************************************
-000015EE 2874 *
-000015EE 2875 * get value from line .. continued
-000015EE 2876 * do tokens
-000015EE 2877
-000015EE 2878 LAB_1BD0
-000015EE B03C 00B3 2879 CMP.b #TK_MINUS,d0 * compare with token for -
-000015F2 67D2 2880 BEQ.s LAB_1C11 * branch if - token (do set-up for - operator)
-000015F4 2881
-000015F4 2882 * wasn't -123 so ...
-000015F4 B03C 00B2 2883 CMP.b #TK_PLUS,d0 * compare with token for +
-000015F8 6700 FF5C 2884 BEQ LAB_GVAL * branch if + token (+n = n so ignore leading +)
-000015FC 2885
-000015FC B03C 00AE 2886 CMP.b #TK_NOT,d0 * compare with token for NOT
-00001600 6606 2887 BNE.s LAB_1BE7 * branch if not token for NOT
-00001602 2888
-00001602 2889 * was NOT token
-00001602 323C 002C 2890 MOVE.w #(TK_EQUAL-TK_PLUS)*4,d1 * offset to NOT function
-00001606 60C4 2891 BRA.s LAB_1C13 * do set-up for function then execute
-00001608 2892
-00001608 2893 * wasn't +, - or NOT so ...
-00001608 2894 LAB_1BE7
-00001608 B03C 00AB 2895 CMP.b #TK_FN,d0 * compare with token for FN
-0000160C 6700 0514 2896 BEQ LAB_201E * if FN go evaluate FNx
-00001610 2897
-00001610 2898 * wasn't +, -, NOT or FN so ...
-00001610 0400 00BF 2899 SUB.b #TK_SGN,d0 * compare with token for SGN & normalise
-00001614 6500 F354 2900 BCS LAB_SNER * if < SGN token then do syntax error
-00001618 2901
-00001618 2902 * get value from line .. continued
-00001618 2903 * only functions left so set up function references
-00001618 2904
-00001618 2905 * new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
-00001618 2906 * to process function calls. now the function vector is computed and pushed on the stack
-00001618 2907 * and the preprocess offset is read. if the preprocess offset is non zero then the vector
-00001618 2908 * is calculated and the routine called, if not this routine just does RTS. whichever
-00001618 2909 * happens the RTS at the end of this routine, or the preprocess routine calls, the
-00001618 2910 * function code
-00001618 2911
-00001618 2912 * this also removes some less than elegant code that was used to bypass type checking
-00001618 2913 * for functions that returned strings
-00001618 2914
-00001618 C07C 007F 2915 AND.w #$7F,d0 * mask byte
-0000161C D040 2916 ADD.w d0,d0 * *2 (2 bytes per function offset)
-0000161E 2917
-0000161E 41FA 20A4 2918 LEA LAB_FTBL(pc),a0 * pointer to functions vector table
-00001622 3230 0000 2919 MOVE.w (a0,d0.w),d1 * get function vector offset
-00001626 4870 1000 2920 PEA (a0,d1.w) * push function vector
-0000162A 2921
-0000162A 41FA 204C 2922 LEA LAB_FTPP(pc),a0 * pointer to functions preprocess vector table
-0000162E 3030 0000 2923 MOVE.w (a0,d0.w),d0 * get function preprocess vector offset
-00001632 6712 2924 BEQ.s LAB_1C2A * no preprocess vector so go do function
-00001634 2925
-00001634 41F0 0000 2926 LEA (a0,d0.w),a0 * get function preprocess vector
-00001638 4ED0 2927 JMP (a0) * go do preprocess routine then function
-0000163A 2928
-0000163A 2929
-0000163A 2930 *************************************************************************************
-0000163A 2931 *
-0000163A 2932 * process string expression in parenthesis
-0000163A 2933
-0000163A 2934 LAB_PPFS
-0000163A 6100 FF56 2935 BSR LAB_1BF7 * process expression in parenthesis
-0000163E 4A2B 05B5 2936 TST.b Dtypef(a3) * test data type
-00001642 6A00 F2FA 2937 BPL LAB_TMER * if numeric do Type missmatch Error/warm start
-00001646 2938
-00001646 2939 LAB_1C2A
-00001646 4E75 2940 RTS * else do function
-00001648 2941
-00001648 2942
-00001648 2943 *************************************************************************************
-00001648 2944 *
-00001648 2945 * process numeric expression in parenthesis
-00001648 2946
-00001648 2947 LAB_PPFN
-00001648 6100 FF48 2948 BSR LAB_1BF7 * process expression in parenthesis
-0000164C 4A2B 05B5 2949 TST.b Dtypef(a3) * test data type
-00001650 6B00 F2EC 2950 BMI LAB_TMER * if string do Type missmatch Error/warm start
-00001654 2951
-00001654 4E75 2952 RTS * else do function
-00001656 2953
-00001656 2954
-00001656 2955 *************************************************************************************
-00001656 2956 *
-00001656 2957 * set numeric data type and increment BASIC execute pointer
-00001656 2958
-00001656 2959 LAB_PPBI
-00001656 177C 0000 05B5 2960 MOVE.b #$00,Dtypef(a3) * clear data type flag, $00=float
-0000165C 101D 2961 MOVE.b (a5)+,d0 * get next BASIC byte
-0000165E 4E75 2962 RTS * do function
-00001660 2963
-00001660 2964
-00001660 2965 *************************************************************************************
-00001660 2966 *
-00001660 2967 * process string for LEFT$, RIGHT$ or MID$
-00001660 2968
-00001660 2969 LAB_LRMS
-00001660 6100 FDE8 2970 BSR LAB_EVEZ * evaluate (should be string) expression
-00001664 4A2B 05B5 2971 TST.b Dtypef(a3) * test data type flag
-00001668 6A00 F2D4 2972 BPL LAB_TMER * if type is not string do type mismatch error
-0000166C 2973
-0000166C 141D 2974 MOVE.b (a5)+,d2 * get BASIC byte
-0000166E B43C 002C 2975 CMP.b #',',d2 * compare with comma
-00001672 6600 F2F6 2976 BNE LAB_SNER * if not "," go do syntax error/warm start
-00001676 2977
-00001676 2F2B 0590 2978 MOVE.l FAC1_m(a3),-(sp) * save descriptor pointer
-0000167A 6100 08AA 2979 BSR LAB_GTWO * get word parameter, result in d0 and Itemp
-0000167E 205F 2980 MOVEA.l (sp)+,a0 * restore descriptor pointer
-00001680 4E75 2981 RTS * do function
-00001682 2982
-00001682 2983
-00001682 2984 *************************************************************************************
-00001682 2985 *
-00001682 2986 * process numeric expression(s) for BIN$ or HEX$
-00001682 2987
-00001682 2988 LAB_BHSS
-00001682 6100 FDC6 2989 BSR LAB_EVEZ * evaluate expression (no decrement)
-00001686 4A2B 05B5 2990 TST.b Dtypef(a3) * test data type
-0000168A 6B00 F2B2 2991 BMI LAB_TMER * if string do Type missmatch Error/warm start
-0000168E 2992
-0000168E 6100 0DCE 2993 BSR LAB_2831 * convert FAC1 floating to fixed
-00001692 2994 * result in d0 and Itemp
-00001692 7200 2995 MOVEQ #0,d1 * set default to no leading "0"s
-00001694 141D 2996 MOVE.b (a5)+,d2 * get BASIC byte
-00001696 B43C 002C 2997 CMP.b #',',d2 * compare with comma
-0000169A 660C 2998 BNE.s LAB_BHCB * if not "," go check close bracket
-0000169C 2999
-0000169C 2F00 3000 MOVE.l d0,-(sp) * copy number to stack
-0000169E 6100 0872 3001 BSR LAB_GTBY * get byte value
-000016A2 2200 3002 MOVE.l d0,d1 * copy leading 0s #
-000016A4 201F 3003 MOVE.l (sp)+,d0 * restore number from stack
-000016A6 141D 3004 MOVE.b (a5)+,d2 * get BASIC byte
-000016A8 3005 LAB_BHCB
-000016A8 B43C 0029 3006 CMP.b #')',d2 * compare with close bracket
-000016AC 6600 F2BC 3007 BNE LAB_SNER * if not ")" do Syntax Error/warm start
-000016B0 3008
-000016B0 4E75 3009 RTS * go do function
-000016B2 3010
-000016B2 3011
-000016B2 3012 *************************************************************************************
-000016B2 3013 *
-000016B2 3014 * perform EOR
-000016B2 3015
-000016B2 3016 LAB_EOR
-000016B2 6116 3017 BSR.s GetFirst * get two values for OR, AND or EOR
-000016B4 3018 * first in d0, and Itemp, second in d2
-000016B4 B580 3019 EOR.l d2,d0 * EOR values
-000016B6 6000 03F0 3020 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-000016BA 3021
-000016BA 3022
-000016BA 3023 *************************************************************************************
-000016BA 3024 *
-000016BA 3025 * perform OR
-000016BA 3026
-000016BA 3027 LAB_OR
-000016BA 610E 3028 BSR.s GetFirst * get two values for OR, AND or EOR
-000016BC 3029 * first in d0, and Itemp, second in d2
-000016BC 8082 3030 OR.l d2,d0 * do OR
-000016BE 6000 03E8 3031 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-000016C2 3032
-000016C2 3033
-000016C2 3034 *************************************************************************************
-000016C2 3035 *
-000016C2 3036 * perform AND
-000016C2 3037
-000016C2 3038 LAB_AND
-000016C2 6106 3039 BSR.s GetFirst * get two values for OR, AND or EOR
-000016C4 3040 * first in d0, and Itemp, second in d2
-000016C4 C082 3041 AND.l d2,d0 * do AND
-000016C6 6000 03E0 3042 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-000016CA 3043
-000016CA 3044
-000016CA 3045 *************************************************************************************
-000016CA 3046 *
-000016CA 3047 * get two values for OR, AND, EOR
-000016CA 3048 * first in d0, second in d2
-000016CA 3049
-000016CA 3050 GetFirst
-000016CA 6100 0228 3051 BSR LAB_EVIR * evaluate integer expression (no sign check)
-000016CE 3052 * result in d0 and Itemp
-000016CE 2400 3053 MOVE.l d0,d2 * copy second value
-000016D0 6100 0CF4 3054 BSR LAB_279B * copy FAC2 to FAC1, get first value in
-000016D4 3055 * expression
-000016D4 6000 021E 3056 BRA LAB_EVIR * evaluate integer expression (no sign check)
-000016D8 3057 * result in d0 and Itemp & return
-000016D8 3058
-000016D8 3059
-000016D8 3060 *************************************************************************************
-000016D8 3061 *
-000016D8 3062 * perform NOT
-000016D8 3063
-000016D8 3064 LAB_EQUAL
-000016D8 6100 021A 3065 BSR LAB_EVIR * evaluate integer expression (no sign check)
-000016DC 3066 * result in d0 and Itemp
-000016DC 4680 3067 NOT.l d0 * bitwise invert
-000016DE 6000 03C8 3068 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-000016E2 3069
-000016E2 3070
-000016E2 3071 *************************************************************************************
-000016E2 3072 *
-000016E2 3073 * perform comparisons
-000016E2 3074 * do < compare
-000016E2 3075
-000016E2 3076 LAB_LTHAN
-000016E2 6100 FD50 3077 BSR LAB_CKTM * type match check, set C for string
-000016E6 6506 3078 BCS.s LAB_1CAE * branch if string
-000016E8 3079
-000016E8 3080 * do numeric < compare
-000016E8 6100 0D48 3081 BSR LAB_27FA * compare FAC1 with FAC2
-000016EC 3082 * returns d0=+1 if FAC1 > FAC2
-000016EC 3083 * returns d0= 0 if FAC1 = FAC2
-000016EC 3084 * returns d0=-1 if FAC1 < FAC2
-000016EC 6042 3085 BRA.s LAB_1CF2 * process result
-000016EE 3086
-000016EE 3087 * do string < compare
-000016EE 3088 LAB_1CAE
-000016EE 177C 0000 05B5 3089 MOVE.b #$00,Dtypef(a3) * clear data type, $80=string, $40=integer,
-000016F4 3090 * $00=float
-000016F4 6100 06BC 3091 BSR LAB_22B6 * pop string off descriptor stack, or from top
-000016F8 3092 * of string space returns d0 = length,
-000016F8 3093 * a0 = pointer
-000016F8 2248 3094 MOVEA.l a0,a1 * copy string 2 pointer
-000016FA 2200 3095 MOVE.l d0,d1 * copy string 2 length
-000016FC 206B 0598 3096 MOVEA.l FAC2_m(a3),a0 * get string 1 descriptor pointer
-00001700 6100 06B4 3097 BSR LAB_22BA * pop (a0) descriptor, returns with ..
-00001704 3098 * d0 = length, a0 = pointer
-00001704 2400 3099 MOVE.l d0,d2 * copy length
-00001706 6604 3100 BNE.s LAB_1CB5 * branch if not null string
-00001708 3101
-00001708 4A81 3102 TST.l d1 * test if string 2 is null also
-0000170A 6724 3103 BEQ.s LAB_1CF2 * if so do string 1 = string 2
-0000170C 3104
-0000170C 3105 LAB_1CB5
-0000170C 9481 3106 SUB.l d1,d2 * subtract string 2 length
-0000170E 670C 3107 BEQ.s LAB_1CD5 * branch if strings = length
-00001710 3108
-00001710 6504 3109 BCS.s LAB_1CD4 * branch if string 1 < string 2
-00001712 3110
-00001712 70FF 3111 MOVEQ #-1,d0 * set for string 1 > string 2
-00001714 6008 3112 BRA.s LAB_1CD6 * go do character comapare
-00001716 3113
-00001716 3114 LAB_1CD4
-00001716 2200 3115 MOVE.l d0,d1 * string 1 length is compare length
-00001718 7001 3116 MOVEQ #1,d0 * and set for string 1 < string 2
-0000171A 6002 3117 BRA.s LAB_1CD6 * go do character comapare
-0000171C 3118
-0000171C 3119 LAB_1CD5
-0000171C 2002 3120 MOVE.l d2,d0 * set for string 1 = string 2
-0000171E 3121 LAB_1CD6
-0000171E 5381 3122 SUBQ.l #1,d1 * adjust length for DBcc loop
-00001720 3123
-00001720 3124 * d1 is length to compare, d0 is <=> for length
-00001720 3125 * a0 is string 1 pointer, a1 is string 2 pointer
-00001720 3126 LAB_1CE6
-00001720 B308 3127 CMPM.b (a0)+,(a1)+ * compare string bytes (1 with 2)
-00001722 56C9 FFFC 3128 DBNE d1,LAB_1CE6 * loop if same and not end yet
-00001726 3129
-00001726 6708 3130 BEQ.s LAB_1CF2 * if = to here, then go use length compare
-00001728 3131
-00001728 6404 3132 BCC.s LAB_1CDB * else branch if string 1 > string 2
-0000172A 3133
-0000172A 70FF 3134 MOVEQ #-1,d0 * else set for string 1 < string 2
-0000172C 6002 3135 BRA.s LAB_1CF2 * go set result
-0000172E 3136
-0000172E 3137 LAB_1CDB
-0000172E 7001 3138 MOVEQ #1,d0 * and set for string 1 > string 2
-00001730 3139
-00001730 3140 LAB_1CF2
-00001730 5200 3141 ADDQ.b #1,d0 * make result 0, 1 or 2
-00001732 1200 3142 MOVE.b d0,d1 * copy to d1
-00001734 7001 3143 MOVEQ #1,d0 * set d0 longword
-00001736 E338 3144 ROL.b d1,d0 * make 1, 2 or 4 (result = flag bit)
-00001738 C02B 05E1 3145 AND.b Cflag(a3),d0 * AND with comparison evaluation flag
-0000173C 6700 0CDC 3146 BEQ LAB_27DB * exit if not a wanted result (i.e. false)
-00001740 3147
-00001740 70FF 3148 MOVEQ #-1,d0 * else set -1 (true)
-00001742 6000 0CD6 3149 BRA LAB_27DB * save d0 as integer & return
-00001746 3150
-00001746 3151
-00001746 3152 LAB_1CFE
-00001746 6100 FE56 3153 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
-0000174A 3154
-0000174A 3155
-0000174A 3156 *************************************************************************************
-0000174A 3157 *
-0000174A 3158 * perform DIM
-0000174A 3159
-0000174A 3160 LAB_DIM
-0000174A 72FF 3161 MOVEQ #-1,d1 * set "DIM" flag
-0000174C 6170 3162 BSR.s LAB_1D10 * search for or dimension a variable
-0000174E 6100 FE5A 3163 BSR LAB_GBYT * scan memory
-00001752 66F2 3164 BNE.s LAB_1CFE * loop and scan for "," if not null
-00001754 3165
-00001754 4E75 3166 RTS
-00001756 3167
-00001756 3168
-00001756 3169 *************************************************************************************
-00001756 3170 *
-00001756 3171 * perform << (left shift)
-00001756 3172
-00001756 3173 LAB_LSHIFT
-00001756 612E 3174 BSR.s GetPair * get an integer and byte pair
-00001758 3175 * byte is in d2, integer is in d0 and Itemp
-00001758 6708 3176 BEQ.s NoShift * branch if byte zero
-0000175A 3177
-0000175A B43C 0020 3178 CMP.b #$20,d2 * compare bit count with 32d
-0000175E 6420 3179 BCC.s TooBig * branch if >=
-00001760 3180
-00001760 E5A0 3181 ASL.l d2,d0 * shift longword
-00001762 3182 NoShift
-00001762 6000 0344 3183 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-00001766 3184
-00001766 3185
-00001766 3186 *************************************************************************************
-00001766 3187 *
-00001766 3188 * perform >> (right shift)
-00001766 3189
-00001766 3190 LAB_RSHIFT
-00001766 611E 3191 BSR.s GetPair * get an integer and byte pair
-00001768 3192 * byte is in d2, integer is in d0 and Itemp
-00001768 67F8 3193 BEQ.s NoShift * branch if byte zero
-0000176A 3194
-0000176A B43C 0020 3195 CMP.b #$20,d2 * compare bit count with 32d
-0000176E 650A 3196 BCS.s Not2Big * branch if >= (return shift)
-00001770 3197
-00001770 4A80 3198 TST.l d0 * test sign bit
-00001772 6A0C 3199 BPL.s TooBig * branch if +ve
-00001774 3200
-00001774 70FF 3201 MOVEQ #-1,d0 * set longword
-00001776 6000 0330 3202 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
-0000177A 3203
-0000177A 3204 Not2Big
-0000177A E4A0 3205 ASR.l d2,d0 * shift longword
-0000177C 6000 032A 3206 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
-00001780 3207
-00001780 3208 TooBig
-00001780 7000 3209 MOVEQ #0,d0 * clear longword
-00001782 6000 0324 3210 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
-00001786 3211
-00001786 3212
-00001786 3213 *************************************************************************************
-00001786 3214 *
-00001786 3215 * get an integer and byte pair
-00001786 3216 * byte is in d2, integer is in d0 and Itemp
-00001786 3217
-00001786 3218 GetPair
-00001786 6100 078E 3219 BSR LAB_EVBY * evaluate byte expression, result in d0 and
-0000178A 3220 * Itemp
-0000178A 1400 3221 MOVE.b d0,d2 * save it
-0000178C 6100 0C38 3222 BSR LAB_279B * copy FAC2 to FAC1, get first value in
-00001790 3223 * expression
-00001790 6100 0162 3224 BSR LAB_EVIR * evaluate integer expression (no sign check)
-00001794 3225 * result in d0 and Itemp
-00001794 4A02 3226 TST.b d2 * test byte value
-00001796 4E75 3227 RTS
-00001798 3228
-00001798 3229
-00001798 3230 *************************************************************************************
-00001798 3231 *
-00001798 3232 * check alpha, return C=0 if<"A" or >"Z" or <"a" to "z">
-00001798 3233
-00001798 3234 LAB_CASC
-00001798 B03C 0061 3235 CMP.b #$61,d0 * compare with "a"
-0000179C 6410 3236 BCC.s LAB_1D83 * if >="a" go check =<"z"
-0000179E 3237
-0000179E 3238
-0000179E 3239 *************************************************************************************
-0000179E 3240 *
-0000179E 3241 * check alpha upper case, return C=0 if<"A" or >"Z"
-0000179E 3242
-0000179E 3243 LAB_CAUC
-0000179E B03C 0041 3244 CMP.b #$41,d0 * compare with "A"
-000017A2 6404 3245 BCC.s LAB_1D8A * if >="A" go check =<"Z"
-000017A4 3246
-000017A4 8040 3247 OR d0,d0 * make C=0
-000017A6 4E75 3248 RTS
-000017A8 3249
-000017A8 3250 LAB_1D8A
-000017A8 B03C 005B 3251 CMP.b #$5B,d0 * compare with "Z"+1
-000017AC 3252 * carry set if byte<="Z"
-000017AC 4E75 3253 RTS
-000017AE 3254
-000017AE 3255 LAB_1D83
-000017AE B03C 007B 3256 CMP.b #$7B,d0 * compare with "z"+1
-000017B2 3257 * carry set if byte<="z"
-000017B2 4E75 3258 RTS
-000017B4 3259
-000017B4 3260
-000017B4 3261 *************************************************************************************
-000017B4 3262 *
-000017B4 3263 * search for or create variable. this is used to automatically create a variable if
-000017B4 3264 * it is not found. any routines that need to create the variable call LAB_GVAR via
-000017B4 3265 * this point and error generation is supressed and the variable will be created
-000017B4 3266 *
-000017B4 3267 * return pointer to variable in Cvaral and a0
-000017B4 3268 * set data type to variable type
-000017B4 3269
-000017B4 3270 LAB_SVAR
-000017B4 6102 3271 BSR.s LAB_GVAR * search for variable
-000017B6 3272 LAB_FVAR
-000017B6 4E75 3273 RTS
-000017B8 3274
-000017B8 3275
-000017B8 3276 *************************************************************************************
-000017B8 3277 *
-000017B8 3278 * search for variable. if this routine is called from anywhere but the above call and
-000017B8 3279 * the variable searched for does not exist then an error will be returned
-000017B8 3280 *
-000017B8 3281 * DIM flag is in d1.b
-000017B8 3282 * return pointer to variable in Cvaral and a0
-000017B8 3283 * set data type to variable type
-000017B8 3284
-000017B8 3285 LAB_GVAR
-000017B8 7200 3286 MOVEQ #$00,d1 * set DIM flag = $00
-000017BA 6100 FDEE 3287 BSR LAB_GBYT * scan memory (1st character)
-000017BE 3288 LAB_1D10
-000017BE 1741 05B4 3289 MOVE.b d1,Defdim(a3) * save DIM flag
-000017C2 3290
-000017C2 3291 * search for FN name entry point
-000017C2 3292
-000017C2 3293 LAB_1D12
-000017C2 61D4 3294 BSR.s LAB_CASC * check byte, return C=0 if<"A" or >"Z"
-000017C4 6400 F1A4 3295 BCC LAB_SNER * if not, syntax error then warm start
-000017C8 3296
-000017C8 3297 * it is a variable name so ...
-000017C8 7200 3298 MOVEQ #$0,d1 * set index for name byte
-000017CA 41EB 046A 3299 LEA Varname(a3),a0 * pointer to variable name
-000017CE 2081 3300 MOVE.l d1,(a0) * clear the variable name
-000017D0 1741 05B5 3301 MOVE.b d1,Dtypef(a3) * clear the data type, $80=string, $40=integer,
-000017D4 3302 * $00=float
-000017D4 3303
-000017D4 3304 LAB_1D2D
-000017D4 B27C 0004 3305 CMP.w #$04,d1 * done all significant characters?
-000017D8 6406 3306 BCC.s LAB_1D2E * if so go ignore any more
-000017DA 3307
-000017DA 1180 1000 3308 MOVE.b d0,(a0,d1.w) * save the character
-000017DE 5241 3309 ADDQ.w #1,d1 * increment index
-000017E0 3310 LAB_1D2E
-000017E0 6100 FDC6 3311 BSR LAB_IGBY * increment & scan memory (next character)
-000017E4 65EE 3312 BCS.s LAB_1D2D * branch if character = "0"-"9" (ok)
-000017E6 3313
-000017E6 3314 * character wasn't "0" to "9" so ...
-000017E6 61B0 3315 BSR.s LAB_CASC * check byte, return C=0 if<"A" or >"Z"
-000017E8 65EA 3316 BCS.s LAB_1D2D * branch if = "A"-"Z" (ok)
-000017EA 3317
-000017EA 3318 * check if string variable
-000017EA B03C 0024 3319 CMP.b #'$',d0 * compare with "$"
-000017EE 660C 3320 BNE.s LAB_1D44 * branch if not string
-000017F0 3321
-000017F0 3322 * type is string
-000017F0 002B 0080 046B 3323 OR.b #$80,Varname+1(a3) * set top bit of 2nd character, indicate string
-000017F6 6100 FDB0 3324 BSR LAB_IGBY * increment & scan memory
-000017FA 6010 3325 BRA.s LAB_1D45 * skip integer check
-000017FC 3326
-000017FC 3327 * check if integer variable
-000017FC 3328 LAB_1D44
-000017FC B03C 0026 3329 CMP.b #'&',d0 * compare with "&"
-00001800 660A 3330 BNE.s LAB_1D45 * branch if not integer
-00001802 3331
-00001802 3332 * type is integer
-00001802 002B 0080 046C 3333 OR.b #$80,Varname+2(a3) * set top bit of 3rd character, indicate integer
-00001808 6100 FD9E 3334 BSR LAB_IGBY * increment & scan memory
-0000180C 3335
-0000180C 3336 * after we have determined the variable type we need to determine
-0000180C 3337 * if it's an array of type
-0000180C 3338
-0000180C 3339 * gets here with character after var name in d0
-0000180C 3340 LAB_1D45
-0000180C 4A2B 05DF 3341 TST.b Sufnxf(a3) * test function name flag
-00001810 670E 3342 BEQ.s LAB_1D48 * if not FN or FN variable continue
-00001812 3343
-00001812 6A14 3344 BPL.s LAB_1D49 * if FN variable go find or create it
-00001814 3345
-00001814 3346 * else was FN name
-00001814 202B 046A 3347 MOVE.l Varname(a3),d0 * get whole function name
-00001818 7208 3348 MOVEQ #8,d1 * set step to next function size -4
-0000181A 41EB 0432 3349 LEA Sfncl(a3),a0 * get pointer to start of functions
-0000181E 601C 3350 BRA.s LAB_1D4B * go find function
-00001820 3351
-00001820 3352 LAB_1D48
-00001820 0400 0028 3353 SUB.b #'(',d0 * subtract "("
-00001824 6700 00F4 3354 BEQ LAB_1E17 * if "(" go find, or make, array
-00001828 3355
-00001828 3356 * either find or create var
-00001828 3357 * var name (1st four characters only!) is in Varname
-00001828 3358
-00001828 3359 * variable name wasn't var( .. so look for
-00001828 3360 * plain variable
-00001828 3361 LAB_1D49
-00001828 202B 046A 3362 MOVE.l Varname(a3),d0 * get whole variable name
-0000182C 3363 LAB_1D4A
-0000182C 7204 3364 MOVEQ #4,d1 * set step to next variable size -4
-0000182E 41EB 0436 3365 LEA Svarl(a3),a0 * get pointer to start of variables
-00001832 3366
-00001832 0800 0017 3367 BTST.l #23,d0 * test if string name
-00001836 6704 3368 BEQ.s LAB_1D4B * branch if not
-00001838 3369
-00001838 5441 3370 ADDQ.w #2,d1 * 6 bytes per string entry
-0000183A 5848 3371 ADDQ.w #(Sstrl-Svarl),a0 * move to string area
-0000183C 3372
-0000183C 3373 LAB_1D4B
-0000183C 2268 0004 3374 MOVEA.l 4(a0),a1 * get end address
-00001840 2050 3375 MOVEA.l (a0),a0 * get start address
-00001842 6006 3376 BRA.s LAB_1D5E * enter loop at exit check
-00001844 3377
-00001844 3378 LAB_1D5D
-00001844 B098 3379 CMP.l (a0)+,d0 * compare this variable with name
-00001846 6776 3380 BEQ.s LAB_1DD7 * branch if match (found var)
-00001848 3381
-00001848 D1C1 3382 ADDA.l d1,a0 * add offset to next variable
-0000184A 3383 LAB_1D5E
-0000184A B1C9 3384 CMPA.l a1,a0 * compare address with variable space end
-0000184C 66F6 3385 BNE.s LAB_1D5D * if not end go check next
-0000184E 3386
-0000184E 4A2B 05DF 3387 TST.b Sufnxf(a3) * is it a function or function variable
-00001852 660A 3388 BNE.s LAB_1D94 * if was go do DEF or function variable
-00001854 3389
-00001854 3390 * reached end of variable mem without match
-00001854 3391 * ... so create new variable, possibly
-00001854 3392
-00001854 45FA FF60 3393 LEA LAB_FVAR(pc),a2 * get the address of the create if doesn't
-00001858 3394 * exist call to LAB_GVAR
-00001858 B5D7 3395 CMPA.l (sp),a2 * compare the return address with expected
-0000185A 6600 F0CA 3396 BNE LAB_UVER * if not create go do error or return null
-0000185E 3397
-0000185E 3398 * this will only branch if the call to LAB_GVAR wasn't from LAB_SVAR
-0000185E 3399
-0000185E 3400 LAB_1D94
-0000185E 082B 0000 05DF 3401 BTST.b #0,Sufnxf(a3) * test function search flag
-00001864 6600 F0C8 3402 BNE LAB_UFER * if not doing DEF then go do undefined
-00001868 3403 * function error
-00001868 3404
-00001868 3405 * else create new variable/function
-00001868 3406 LAB_1D98
-00001868 246B 0442 3407 MOVEA.l Earryl(a3),a2 * get end of block to move
-0000186C 240A 3408 MOVE.l a2,d2 * copy end of block to move
-0000186E 9489 3409 SUB.l a1,d2 * calculate block to move size
-00001870 3410
-00001870 204A 3411 MOVEA.l a2,a0 * copy end of block to move
-00001872 5881 3412 ADDQ.l #4,d1 * space for one variable/function + name
-00001874 D5C1 3413 ADDA.l d1,a2 * add space for one variable/function
-00001876 274A 0442 3414 MOVE.l a2,Earryl(a3) * set new array mem end
-0000187A E28A 3415 LSR.l #1,d2 * /2 for word copy
-0000187C 6712 3416 BEQ.s LAB_1DAF * skip move if zero length block
-0000187E 3417
-0000187E 5382 3418 SUBQ.l #1,d2 * -1 for DFB loop
-00001880 4842 3419 SWAP d2 * swap high word to low word
-00001882 3420 LAB_1DAC
-00001882 4842 3421 SWAP d2 * swap high word to low word
-00001884 3422 LAB_1DAE
-00001884 3520 3423 MOVE.w -(a0),-(a2) * copy word
-00001886 51CA FFFC 3424 DBF d2,LAB_1DAE * loop until done
-0000188A 3425
-0000188A 4842 3426 SWAP d2 * swap high word to low word
-0000188C 51CA FFF4 3427 DBF d2,LAB_1DAC * decrement high count and loop until done
-00001890 3428
-00001890 3429 * get here after creating either a function, variable or string
-00001890 3430 * if function set variables start, string start, array start
-00001890 3431 * if variable set string start, array start
-00001890 3432 * if string set array start
-00001890 3433
-00001890 3434 LAB_1DAF
-00001890 4A2B 05DF 3435 TST.b Sufnxf(a3) * was it function
-00001894 6B08 3436 BMI.s LAB_1DB0 * branch if was FN
-00001896 3437
-00001896 0800 0017 3438 BTST.l #23,d0 * was it string
-0000189A 660A 3439 BNE.s LAB_1DB2 * branch if string
-0000189C 3440
-0000189C 6004 3441 BRA.s LAB_1DB1 * branch if was plain variable
-0000189E 3442
-0000189E 3443 LAB_1DB0
-0000189E D3AB 0436 3444 ADD.l d1,Svarl(a3) * set new variable memory start
-000018A2 3445 LAB_1DB1
-000018A2 D3AB 043A 3446 ADD.l d1,Sstrl(a3) * set new start of strings
-000018A6 3447 LAB_1DB2
-000018A6 D3AB 043E 3448 ADD.l d1,Sarryl(a3) * set new array memory start
-000018AA 20C0 3449 MOVE.l d0,(a0)+ * save variable/function name
-000018AC 20BC 00000000 3450 MOVE.l #$00,(a0) * initialise variable
-000018B2 0800 0017 3451 BTST.l #23,d0 * was it string
-000018B6 6706 3452 BEQ.s LAB_1DD7 * branch if not string
-000018B8 3453
-000018B8 317C 0000 0004 3454 MOVE.w #$00,4(a0) * else initialise string length
-000018BE 3455
-000018BE 3456 * found a match for var ((Vrschl) = ptr)
-000018BE 3457 LAB_1DD7
-000018BE 2200 3458 MOVE.l d0,d1 * ........ $....... &....... ........
-000018C0 D281 3459 ADD.l d1,d1 * .......$ .......& ........ .......0
-000018C2 4841 3460 SWAP d1 * ........ .......0 .......$ .......&
-000018C4 E219 3461 ROR.b #1,d1 * ........ .......0 .......$ &.......
-000018C6 E249 3462 LSR.w #1,d1 * ........ .......0 0....... $&.....?.
-000018C8 C23C 00C0 3463 AND.b #$C0,d1 * mask the type bits
-000018CC 1741 05B5 3464 MOVE.b d1,Dtypef(a3) * save the data type
-000018D0 3465
-000018D0 177C 0000 05DF 3466 MOVE.b #$00,Sufnxf(a3) * clear FN flag byte
-000018D6 3467
-000018D6 3468 * if you want a non existant variable to return a null value then set the novar
-000018D6 3469 * value at the top of this file to some non zero value
-000018D6 3470
-000018D6 FALSE 3471 ifne novar
-000018D6 3472 endc
-000018D6 3473
-000018D6 4E75 3474 RTS
-000018D8 3475
-000018D8 3476
-000018D8 3477 *************************************************************************************
-000018D8 3478 *
-000018D8 3479 * set-up array pointer, d0, to first element in array
-000018D8 3480 * set d0 to (a0)+2*(Dimcnt)+$0A
-000018D8 3481
-000018D8 3482 LAB_1DE6
-000018D8 7005 3483 MOVEQ #5,d0 * set d0 to 5 (*2 = 10, later)
-000018DA D02B 05DB 3484 ADD.b Dimcnt(a3),d0 * add # of dimensions (1, 2 or 3)
-000018DE D080 3485 ADD.l d0,d0 * *2 (bytes per dimension size)
-000018E0 D088 3486 ADD.l a0,d0 * add array start pointer
-000018E2 4E75 3487 RTS
-000018E4 3488
-000018E4 3489
-000018E4 3490 *************************************************************************************
-000018E4 3491 *
-000018E4 3492 * evaluate unsigned integer expression
-000018E4 3493
-000018E4 3494 LAB_EVIN
-000018E4 6100 FCC2 3495 BSR LAB_IGBY * increment & scan memory
-000018E8 6100 FB46 3496 BSR LAB_EVNM * evaluate expression & check is numeric,
-000018EC 3497 * else do type mismatch
-000018EC 3498
-000018EC 3499
-000018EC 3500 *************************************************************************************
-000018EC 3501 *
-000018EC 3502 * evaluate positive integer expression, result in d0 and Itemp
-000018EC 3503
-000018EC 3504 LAB_EVPI
-000018EC 4A2B 0595 3505 TST.b FAC1_s(a3) * test FAC1 sign (b7)
-000018F0 6B00 F06C 3506 BMI LAB_FCER * do function call error if -ve
-000018F4 3507
-000018F4 3508
-000018F4 3509 *************************************************************************************
-000018F4 3510 *
-000018F4 3511 * evaluate integer expression, no sign check
-000018F4 3512 * result in d0 and Itemp, exit with flags set correctly
-000018F4 3513
-000018F4 3514 LAB_EVIR
-000018F4 0C2B 00A0 0594 3515 CMPI.b #$A0,FAC1_e(a3) * compare exponent with exponent = 2^32 (n>2^31)
-000018FA 6500 0B62 3516 BCS LAB_2831 * convert FAC1 floating to fixed
-000018FE 3517 * result in d0 and Itemp
-000018FE 6600 F05E 3518 BNE LAB_FCER * if > do function call error, then warm start
-00001902 3519
-00001902 4A2B 0595 3520 TST.b FAC1_s(a3) * test sign of FAC1
-00001906 6A00 0B56 3521 BPL LAB_2831 * if +ve then ok
-0000190A 3522
-0000190A 202B 0590 3523 MOVE.l FAC1_m(a3),d0 * get mantissa
-0000190E 4480 3524 NEG.l d0 * do -d0
-00001910 6800 F04C 3525 BVC LAB_FCER * if not $80000000 do FC error, then warm start
-00001914 3526
-00001914 2740 042A 3527 MOVE.l d0,Itemp(a3) * else just set it
-00001918 4E75 3528 RTS
-0000191A 3529
-0000191A 3530
-0000191A 3531 *************************************************************************************
-0000191A 3532 *
-0000191A 3533 * find or make array
-0000191A 3534
-0000191A 3535 LAB_1E17
-0000191A 3F2B 05B4 3536 MOVE.w Defdim(a3),-(sp) * get DIM flag and data type flag (word in mem)
-0000191E 7200 3537 MOVEQ #0,d1 * clear dimensions count
-00001920 3538
-00001920 3539 * now get the array dimension(s) and stack it (them) before the data type and DIM flag
-00001920 3540
-00001920 3541 LAB_1E1F
-00001920 3F01 3542 MOVE.w d1,-(sp) * save dimensions count
-00001922 2F2B 046A 3543 MOVE.l Varname(a3),-(sp) * save variable name
-00001926 61BC 3544 BSR.s LAB_EVIN * evaluate integer expression
-00001928 3545
-00001928 4840 3546 SWAP d0 * swap high word to low word
-0000192A 4A40 3547 TST.w d0 * test swapped high word
-0000192C 6600 F020 3548 BNE LAB_ABER * if too big do array bounds error
-00001930 3549
-00001930 275F 046A 3550 MOVE.l (sp)+,Varname(a3) * restore variable name
-00001934 321F 3551 MOVE.w (sp)+,d1 * restore dimensions count
-00001936 301F 3552 MOVE.w (sp)+,d0 * restore DIM and data type flags
-00001938 3F2B 042C 3553 MOVE.w Itemp+2(a3),-(sp) * stack this dimension size
-0000193C 3F00 3554 MOVE.w d0,-(sp) * save DIM and data type flags
-0000193E 5241 3555 ADDQ.w #1,d1 * increment dimensions count
-00001940 6100 FC68 3556 BSR LAB_GBYT * scan memory
-00001944 B03C 002C 3557 CMP.b #$2C,d0 * compare with ","
-00001948 67D6 3558 BEQ.s LAB_1E1F * if found go do next dimension
-0000194A 3559
-0000194A 1741 05DB 3560 MOVE.b d1,Dimcnt(a3) * store dimensions count
-0000194E 6100 FC46 3561 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00001952 375F 05B4 3562 MOVE.w (sp)+,Defdim(a3) * restore DIM and data type flags (word in mem)
-00001956 206B 043E 3563 MOVEA.l Sarryl(a3),a0 * get array mem start
-0000195A 3564
-0000195A 3565 * now check to see if we are at the end of array memory (we would be if there were
-0000195A 3566 * no arrays).
-0000195A 3567
-0000195A 3568 LAB_1E5C
-0000195A 2748 05AC 3569 MOVE.l a0,Astrtl(a3) * save as array start pointer
-0000195E B1EB 0442 3570 CMPA.l Earryl(a3),a0 * compare with array mem end
-00001962 672E 3571 BEQ.s LAB_1EA1 * go build array if not found
-00001964 3572
-00001964 3573 * search for array
-00001964 2010 3574 MOVE.l (a0),d0 * get this array name
-00001966 B0AB 046A 3575 CMP.l Varname(a3),d0 * compare with array name
-0000196A 670A 3576 BEQ.s LAB_1E8D * array found so branch
-0000196C 3577
-0000196C 3578 * no match
-0000196C 2068 0004 3579 MOVEA.l 4(a0),a0 * get this array size
-00001970 D1EB 05AC 3580 ADDA.l Astrtl(a3),a0 * add to array start pointer
-00001974 60E4 3581 BRA.s LAB_1E5C * go check next array
-00001976 3582
-00001976 3583 * found array, are we trying to dimension it?
-00001976 3584 LAB_1E8D
-00001976 4A2B 05B4 3585 TST.b Defdim(a3) * are we trying to dimension it?
-0000197A 6600 EFCE 3586 BNE LAB_DDER * if so do double dimension error/warm start
-0000197E 3587
-0000197E 3588 * found the array and we're not dimensioning it so we must find an element in it
-0000197E 3589
-0000197E 6100 FF58 3590 BSR LAB_1DE6 * set data pointer, d0, to the first element
-00001982 3591 * in the array
-00001982 5048 3592 ADDQ.w #8,a0 * index to dimension count
-00001984 3018 3593 MOVE.w (a0)+,d0 * get no of dimensions
-00001986 B02B 05DB 3594 CMP.b Dimcnt(a3),d0 * compare with dimensions count
-0000198A 6700 0094 3595 BEQ LAB_1F28 * found array so go get element
-0000198E 3596
-0000198E 6000 EF8E 3597 BRA LAB_WDER * else wrong so do "Wrong dimensions" error
-00001992 3598
-00001992 3599 * array not found, so possibly build it
-00001992 3600 LAB_1EA1
-00001992 4A2B 05B4 3601 TST.b Defdim(a3) * test the default DIM flag
-00001996 6700 EF8A 3602 BEQ LAB_UDER * if default flag is clear then we are not
-0000199A 3603 * explicitly dimensioning an array so go
-0000199A 3604 * do an "Undimensioned array" error
-0000199A 3605
-0000199A 6100 FF3C 3606 BSR LAB_1DE6 * set data pointer, d0, to the first element
-0000199E 3607 * in the array
-0000199E 202B 046A 3608 MOVE.l Varname(a3),d0 * get array name
-000019A2 20C0 3609 MOVE.l d0,(a0)+ * save array name
-000019A4 7204 3610 MOVEQ #4,d1 * set 4 bytes per element
-000019A6 0800 0017 3611 BTST.l #23,d0 * test if string array
-000019AA 6702 3612 BEQ.s LAB_1EDF * branch if not string
-000019AC 3613
-000019AC 7206 3614 MOVEQ #6,d1 * else 6 bytes per element
-000019AE 3615 LAB_1EDF
-000019AE 2741 05A8 3616 MOVE.l d1,Asptl(a3) * set array data size (bytes per element)
-000019B2 122B 05DB 3617 MOVE.b Dimcnt(a3),d1 * get dimensions count
-000019B6 5848 3618 ADDQ.w #4,a0 * skip the array size now (don't know it yet!)
-000019B8 30C1 3619 MOVE.w d1,(a0)+ * set array's dimensions count
-000019BA 3620
-000019BA 3621 * now calculate the array data space size
-000019BA 3622
-000019BA 3623 LAB_1EC0
-000019BA 3624
-000019BA 3625 * If you want arrays to dimension themselves by default then comment out the test
-000019BA 3626 * above and uncomment the next three code lines and the label LAB_1ED0
-000019BA 3627
-000019BA 3628 * MOVE.w #$0A,d1 * set default dimension value, allow 0 to 9
-000019BA 3629 * TST.b Defdim(a3) * test default DIM flag
-000019BA 3630 * BNE.s LAB_1ED0 * branch if b6 of Defdim is clear
-000019BA 3631
-000019BA 321F 3632 MOVE.w (sp)+,d1 * get dimension size
-000019BC 3633 *LAB_1ED0
-000019BC 30C1 3634 MOVE.w d1,(a0)+ * save to array header
-000019BE 6100 00AE 3635 BSR LAB_1F7C * do this dimension size+1 * array size
-000019C2 3636 * (d1+1)*(Asptl), result in d0
-000019C2 2740 05A8 3637 MOVE.l d0,Asptl(a3) * save array data size
-000019C6 532B 05DB 3638 SUBQ.b #1,Dimcnt(a3) * decrement dimensions count
-000019CA 66EE 3639 BNE.s LAB_1EC0 * loop while not = 0
-000019CC 3640
-000019CC D1EB 05A8 3641 ADDA.l Asptl(a3),a0 * add size to first element address
-000019D0 6500 EF84 3642 BCS LAB_OMER * if overflow go do "Out of memory" error
-000019D4 3643
-000019D4 B1EB 0446 3644 CMPA.l Sstorl(a3),a0 * compare with bottom of string memory
-000019D8 650C 3645 BCS.s LAB_1ED6 * branch if less (is ok)
-000019DA 3646
-000019DA 6100 028E 3647 BSR LAB_GARB * do garbage collection routine
-000019DE B1EB 0446 3648 CMPA.l Sstorl(a3),a0 * compare with bottom of string memory
-000019E2 6400 EF72 3649 BCC LAB_OMER * if Sstorl <= a0 do "Out of memory"
-000019E6 3650 * error then warm start
-000019E6 3651
-000019E6 3652 LAB_1ED6 * ok exit, carry set
-000019E6 2748 0442 3653 MOVE.l a0,Earryl(a3) * save array mem end
-000019EA 7000 3654 MOVEQ #0,d0 * zero d0
-000019EC 222B 05A8 3655 MOVE.l Asptl(a3),d1 * get size in bytes
-000019F0 E289 3656 LSR.l #1,d1 * /2 for word fill (may be odd # words)
-000019F2 5341 3657 SUBQ.w #1,d1 * adjust for DBF loop
-000019F4 3658 LAB_1ED8
-000019F4 3100 3659 MOVE.w d0,-(a0) * decrement pointer and clear word
-000019F6 51C9 FFFC 3660 DBF d1,LAB_1ED8 * decrement & loop until low word done
-000019FA 3661
-000019FA 4841 3662 SWAP d1 * swap words
-000019FC 4A41 3663 TST.w d1 * test high word
-000019FE 6706 3664 BEQ.s LAB_1F07 * exit if done
-00001A00 3665
-00001A00 5341 3666 SUBQ.w #1,d1 * decrement low (high) word
-00001A02 4841 3667 SWAP d1 * swap back
-00001A04 60EE 3668 BRA.s LAB_1ED8 * go do a whole block
-00001A06 3669
-00001A06 3670 * now we need to calculate the array size by doing Earryl - Astrtl
-00001A06 3671
-00001A06 3672 LAB_1F07
-00001A06 206B 05AC 3673 MOVEA.l Astrtl(a3),a0 * get for calculation and as pointer
-00001A0A 202B 0442 3674 MOVE.l Earryl(a3),d0 * get array memory end
-00001A0E 9088 3675 SUB.l a0,d0 * calculate array size
-00001A10 2140 0004 3676 MOVE.l d0,4(a0) * save size to array
-00001A14 4A2B 05B4 3677 TST.b Defdim(a3) * test default DIM flag
-00001A18 6652 3678 BNE.s RTS_011 * exit (RET) if this was a DIM command
-00001A1A 3679
-00001A1A 3680 * else, find element
-00001A1A 5048 3681 ADDQ.w #8,a0 * index to dimension count
-00001A1C 3758 05DB 3682 MOVE.w (a0)+,Dimcnt(a3) * get array's dimension count
-00001A20 3683
-00001A20 3684 * we have found, or built, the array. now we need to find the element
-00001A20 3685
-00001A20 3686 LAB_1F28
-00001A20 7000 3687 MOVEQ #0,d0 * clear first result
-00001A22 2740 05A8 3688 MOVE.l d0,Asptl(a3) * clear array data pointer
-00001A26 3689
-00001A26 3690 * compare nth dimension bound (a0) with nth index (sp)+
-00001A26 3691 * if greater do array bounds error
-00001A26 3692
-00001A26 3693 LAB_1F2C
-00001A26 3218 3694 MOVE.w (a0)+,d1 * get nth dimension bound
-00001A28 B257 3695 CMP.w (sp),d1 * compare nth index with nth dimension bound
-00001A2A 6500 EF22 3696 BCS LAB_ABER * if d1 less or = do array bounds error
-00001A2E 3697
-00001A2E 3698 * now do pointer = pointer * nth dimension + nth index
-00001A2E 3699
-00001A2E 4A80 3700 TST.l d0 * test pointer
-00001A30 6702 3701 BEQ.s LAB_1F5A * skip multiply if last result = null
-00001A32 3702
-00001A32 613A 3703 BSR.s LAB_1F7C * do this dimension size+1 * array size
-00001A34 3704 LAB_1F5A
-00001A34 7200 3705 MOVEQ #0,d1 * clear longword
-00001A36 321F 3706 MOVE.w (sp)+,d1 * get nth dimension index
-00001A38 D081 3707 ADD.l d1,d0 * add index to size
-00001A3A 2740 05A8 3708 MOVE.l d0,Asptl(a3) * save array data pointer
-00001A3E 3709
-00001A3E 532B 05DB 3710 SUBQ.b #1,Dimcnt(a3) * decrement dimensions count
-00001A42 66E2 3711 BNE.s LAB_1F2C * loop if dimensions still to do
-00001A44 3712
-00001A44 177C 0000 05B5 3713 MOVE.b #0,Dtypef(a3) * set data type to float
-00001A4A 7203 3714 MOVEQ #3,d1 * set for numeric array
-00001A4C 4A2B 046B 3715 TST.b Varname+1(a3) * test if string array
-00001A50 6A0A 3716 BPL.s LAB_1F6A * branch if not string
-00001A52 3717
-00001A52 7205 3718 MOVEQ #5,d1 * else set for string array
-00001A54 177C 0080 05B5 3719 MOVE.b #$80,Dtypef(a3) * and set data type to string
-00001A5A 600C 3720 BRA.s LAB_1F6B * skip integer test
-00001A5C 3721
-00001A5C 3722 LAB_1F6A
-00001A5C 4A2B 046C 3723 TST.b Varname+2(a3) * test if integer array
-00001A60 6A06 3724 BPL.s LAB_1F6B * branch if not integer
-00001A62 3725
-00001A62 177C 0040 05B5 3726 MOVE.b #$40,Dtypef(a3) * else set data type to integer
-00001A68 3727 LAB_1F6B
-00001A68 6104 3728 BSR.s LAB_1F7C * do element size (d1) * array size (Asptl)
-00001A6A D1C0 3729 ADDA.l d0,a0 * add array data start pointer
-00001A6C 3730 RTS_011
-00001A6C 4E75 3731 RTS
-00001A6E 3732
-00001A6E 3733
-00001A6E 3734 *************************************************************************************
-00001A6E 3735 *
-00001A6E 3736 * do this dimension size (d1) * array data size (Asptl)
-00001A6E 3737
-00001A6E 3738 * do a 16 x 32 bit multiply
-00001A6E 3739 * d1 holds the 16 bit multiplier
-00001A6E 3740 * Asptl holds the 32 bit multiplicand
-00001A6E 3741
-00001A6E 3742 * d0 bbbb bbbb
-00001A6E 3743 * d1 0000 aaaa
-00001A6E 3744 * ----------
-00001A6E 3745 * d0 rrrr rrrr
-00001A6E 3746
-00001A6E 3747 LAB_1F7C
-00001A6E 202B 05A8 3748 MOVE.l Asptl(a3),d0 * get result
-00001A72 2400 3749 MOVE.l d0,d2 * copy it
-00001A74 4842 3750 SWAP d2 * shift high word to low word
-00001A76 C0C1 3751 MULU.w d1,d0 * d1 * low word = low result
-00001A78 C4C1 3752 MULU.w d1,d2 * d1 * high word = high result
-00001A7A 4842 3753 SWAP d2 * align words for test
-00001A7C 4A42 3754 TST.w d2 * must be zero
-00001A7E 6600 EED6 3755 BNE LAB_OMER * if overflow go do "Out of memory" error
-00001A82 3756
-00001A82 D082 3757 ADD.l d2,d0 * calculate result
-00001A84 6500 EED0 3758 BCS LAB_OMER * if overflow go do "Out of memory" error
-00001A88 3759
-00001A88 D0AB 05A8 3760 ADD.l Asptl(a3),d0 * add original
-00001A8C 6500 EEC8 3761 BCS LAB_OMER * if overflow go do "Out of memory" error
-00001A90 3762
-00001A90 4E75 3763 RTS
-00001A92 3764
-00001A92 3765
-00001A92 3766 *************************************************************************************
-00001A92 3767 *
-00001A92 3768 * perform FRE()
-00001A92 3769
-00001A92 3770 LAB_FRE
-00001A92 4A2B 05B5 3771 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
-00001A96 3772 * $00=float
-00001A96 6A04 3773 BPL.s LAB_1FB4 * branch if numeric
-00001A98 3774
-00001A98 6100 0318 3775 BSR LAB_22B6 * pop string off descriptor stack, or from
-00001A9C 3776 * top of string space, returns d0 = length,
-00001A9C 3777 * a0 = pointer
-00001A9C 3778
-00001A9C 3779 * FRE(n) was numeric so do this
-00001A9C 3780 LAB_1FB4
-00001A9C 6100 01CC 3781 BSR LAB_GARB * go do garbage collection
-00001AA0 202B 0446 3782 MOVE.l Sstorl(a3),d0 * get bottom of string space
-00001AA4 90AB 0442 3783 SUB.l Earryl(a3),d0 * subtract array mem end
-00001AA8 3784
-00001AA8 3785
-00001AA8 3786 *************************************************************************************
-00001AA8 3787 *
-00001AA8 3788 * convert d0 to signed longword in FAC1
-00001AA8 3789
-00001AA8 3790 LAB_AYFC
-00001AA8 177C 0000 05B5 3791 MOVE.b #$00,Dtypef(a3) * clear data type, $80=string, $40=integer,
-00001AAE 3792 * $00=float
-00001AAE 377C A000 0594 3793 MOVE.w #$A000,FAC1_e(a3) * set FAC1 exponent and clear sign (b7)
-00001AB4 2740 0590 3794 MOVE.l d0,FAC1_m(a3) * save FAC1 mantissa
-00001AB8 6A00 063E 3795 BPL LAB_24D0 * convert if +ve
-00001ABC 3796
-00001ABC 003C 0001 3797 ORI.b #1,CCR * else set carry
-00001AC0 6000 0636 3798 BRA LAB_24D0 * do +/- (carry is sign) & normalise FAC1
-00001AC4 3799
-00001AC4 3800
-00001AC4 3801 *************************************************************************************
-00001AC4 3802 *
-00001AC4 3803 * remember if the line length is zero (infinite line) then POS(n) will return
-00001AC4 3804 * position MOD tabsize
-00001AC4 3805
-00001AC4 3806 * perform POS()
-00001AC4 3807
-00001AC4 3808 LAB_POS
-00001AC4 102B 05E5 3809 MOVE.b TPos(a3),d0 * get terminal position
-00001AC8 3810
-00001AC8 3811 * convert d0 to unsigned byte in FAC1
-00001AC8 3812
-00001AC8 3813 LAB_1FD0
-00001AC8 C0BC 000000FF 3814 AND.l #$FF,d0 * clear high bits
-00001ACE 60D8 3815 BRA.s LAB_AYFC * convert d0 to signed longword in FAC1 & RET
-00001AD0 3816
-00001AD0 3817 * check not direct (used by DEF and INPUT)
-00001AD0 3818
-00001AD0 3819 LAB_CKRN
-00001AD0 4A2B 0452 3820 TST.b Clinel(a3) * test current line #
-00001AD4 6B00 EE6C 3821 BMI LAB_IDER * if -ve go do illegal direct error then warm
-00001AD8 3822 * start
-00001AD8 3823
-00001AD8 4E75 3824 RTS * can continue so return
-00001ADA 3825
-00001ADA 3826
-00001ADA 3827 *************************************************************************************
-00001ADA 3828 *
-00001ADA 3829 * perform DEF
-00001ADA 3830
-00001ADA 3831 LAB_DEF
-00001ADA 70AB 3832 MOVEQ #TK_FN-$100,d0 * get FN token
-00001ADC 6100 FAC2 3833 BSR LAB_SCCA * scan for CHR$(d0), else syntax error and
-00001AE0 3834 * warm start
-00001AE0 3835 * return character after d0
-00001AE0 177C 0080 05DF 3836 MOVE.b #$80,Sufnxf(a3) * set FN flag bit
-00001AE6 6100 FCDA 3837 BSR LAB_1D12 * get FN name
-00001AEA 2748 05B0 3838 MOVE.l a0,func_l(a3) * save function pointer
-00001AEE 3839
-00001AEE 61E0 3840 BSR.s LAB_CKRN * check not direct (back here if ok)
-00001AF0 0C1D 0028 3841 CMP.b #$28,(a5)+ * check next byte is "(" and increment
-00001AF4 6600 EE74 3842 BNE LAB_SNER * else do syntax error/warm start
-00001AF8 3843
-00001AF8 177C 007E 05DF 3844 MOVE.b #$7E,Sufnxf(a3) * set FN variable flag bits
-00001AFE 6100 FCB4 3845 BSR LAB_SVAR * search for or create a variable
-00001B02 3846 * return the variable address in a0
-00001B02 6100 FA92 3847 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00001B06 70BD 3848 MOVEQ #TK_EQUAL-$100,d0 * = token
-00001B08 6100 FA96 3849 BSR LAB_SCCA * scan for CHR$(A), else syntax error/warm start
-00001B0C 3850 * return character after d0
-00001B0C 2F2B 046A 3851 MOVE.l Varname(a3),-(sp) * push current variable name
-00001B10 2F0D 3852 MOVE.l a5,-(sp) * push BASIC execute pointer
-00001B12 6100 F41A 3853 BSR LAB_DATA * go perform DATA, find end of DEF FN statement
-00001B16 206B 05B0 3854 MOVEA.l func_l(a3),a0 * get the function pointer
-00001B1A 209F 3855 MOVE.l (sp)+,(a0) * save BASIC execute pointer to function
-00001B1C 215F 0004 3856 MOVE.l (sp)+,4(a0) * save current variable name to function
-00001B20 4E75 3857 RTS
-00001B22 3858
-00001B22 3859
-00001B22 3860 *************************************************************************************
-00001B22 3861 *
-00001B22 3862 * evaluate FNx
-00001B22 3863
-00001B22 3864 LAB_201E
-00001B22 177C 0081 05DF 3865 MOVE.b #$81,Sufnxf(a3) * set FN flag (find not create)
-00001B28 6100 FA7E 3866 BSR LAB_IGBY * increment & scan memory
-00001B2C 6100 FC94 3867 BSR LAB_1D12 * get FN name
-00001B30 1F2B 05B5 3868 MOVE.b Dtypef(a3),-(sp) * push data type flag (function type)
-00001B34 2F08 3869 MOVE.l a0,-(sp) * push function pointer
-00001B36 0C15 0028 3870 CMP.b #$28,(a5) * check next byte is "(", no increment
-00001B3A 6600 EE2E 3871 BNE LAB_SNER * else do syntax error/warm start
-00001B3E 3872
-00001B3E 6100 FA52 3873 BSR LAB_1BF7 * evaluate expression within parentheses
-00001B42 205F 3874 MOVEA.l (sp)+,a0 * pop function pointer
-00001B44 2748 05B0 3875 MOVE.l a0,func_l(a3) * set function pointer
-00001B48 1F2B 05B5 3876 MOVE.b Dtypef(a3),-(sp) * push data type flag (function expression type)
-00001B4C 3877
-00001B4C 2028 0004 3878 MOVE.l 4(a0),d0 * get function variable name
-00001B50 6100 FCDA 3879 BSR LAB_1D4A * go find function variable (already created)
-00001B54 3880
-00001B54 3881 * now check type match for variable
-00001B54 101F 3882 MOVE.b (sp)+,d0 * pop data type flag (function expression type)
-00001B56 E318 3883 ROL.b #1,d0 * set carry if type = string
-00001B58 6100 F8DA 3884 BSR LAB_CKTM * type match check, set C for string
-00001B5C 3885
-00001B5C 3886 * now stack the function variable value before
-00001B5C 3887 * use
-00001B5C 6712 3888 BEQ.s LAB_2043 * branch if not string
-00001B5E 3889
-00001B5E 43EB 0476 3890 LEA des_sk_e(a3),a1 * get string stack pointer max+1
-00001B62 B9C9 3891 CMPA.l a1,a4 * compare string stack pointer with max+1
-00001B64 6700 EDD0 3892 BEQ LAB_SCER * if no space on the stack go do string too
-00001B68 3893 * complex error
-00001B68 3894
-00001B68 3928 0004 3895 MOVE.w 4(a0),-(a4) * string length on descriptor stack
-00001B6C 2910 3896 MOVE.l (a0),-(a4) * string address on stack
-00001B6E 6002 3897 BRA.s LAB_204S * skip var push
-00001B70 3898
-00001B70 3899 LAB_2043
-00001B70 2F10 3900 MOVE.l (a0),-(sp) * push variable
-00001B72 3901 LAB_204S
-00001B72 2F08 3902 MOVE.l a0,-(sp) * push variable address
-00001B74 1F2B 05B5 3903 MOVE.b Dtypef(a3),-(sp) * push variable data type
-00001B78 3904
-00001B78 6132 3905 BSR.s LAB_2045 * pack function expression value into (a0)
-00001B7A 3906 * (function variable)
-00001B7A 2F0D 3907 MOVE.l a5,-(sp) * push BASIC execute pointer
-00001B7C 206B 05B0 3908 MOVEA.l func_l(a3),a0 * get function pointer
-00001B80 2A50 3909 MOVEA.l (a0),a5 * save function execute ptr as BASIC execute ptr
-00001B82 6100 F8C4 3910 BSR LAB_EVEX * evaluate expression
-00001B86 6100 FA22 3911 BSR LAB_GBYT * scan memory
-00001B8A 6600 EDDE 3912 BNE LAB_SNER * if not [EOL] or [EOS] do syntax error and
-00001B8E 3913 * warm start
-00001B8E 3914
-00001B8E 2A5F 3915 MOVE.l (sp)+,a5 * restore BASIC execute pointer
-00001B90 3916
-00001B90 3917 * restore variable from stack and test data type
-00001B90 3918
-00001B90 101F 3919 MOVE.b (sp)+,d0 * pull variable data type
-00001B92 205F 3920 MOVEA.l (sp)+,a0 * pull variable address
-00001B94 4A00 3921 TST.b d0 * test variable data type
-00001B96 6A08 3922 BPL.s LAB_204T * branch if not string
-00001B98 3923
-00001B98 209C 3924 MOVE.l (a4)+,(a0) * string address from descriptor stack
-00001B9A 315C 0004 3925 MOVE.w (a4)+,4(a0) * string length from descriptor stack
-00001B9E 6002 3926 BRA.s LAB_2044 * skip variable pull
-00001BA0 3927
-00001BA0 3928 LAB_204T
-00001BA0 209F 3929 MOVE.l (sp)+,(a0) * restore variable from stack
-00001BA2 3930 LAB_2044
-00001BA2 101F 3931 MOVE.b (sp)+,d0 * pop data type flag (function type)
-00001BA4 E318 3932 ROL.b #1,d0 * set carry if type = string
-00001BA6 6100 F88C 3933 BSR LAB_CKTM * type match check, set C for string
-00001BAA 4E75 3934 RTS
-00001BAC 3935
-00001BAC 3936 LAB_2045
-00001BAC 4A2B 05B5 3937 TST.b Dtypef(a3) * test data type
-00001BB0 6A00 07EE 3938 BPL LAB_2778 * if numeric pack FAC1 into variable (a0)
-00001BB4 3939 * and return
-00001BB4 3940
-00001BB4 2448 3941 MOVEA.l a0,a2 * copy variable pointer
-00001BB6 6000 F514 3942 BRA LAB_17D6 * go do string LET & return
-00001BBA 3943
-00001BBA 3944
-00001BBA 3945
-00001BBA 3946 *************************************************************************************
-00001BBA 3947 *
-00001BBA 3948 * perform STR$()
-00001BBA 3949
-00001BBA 3950 LAB_STRS
-00001BBA 6100 094A 3951 BSR LAB_2970 * convert FAC1 to string
-00001BBE 3952
-00001BBE 3953 * scan, set up string
-00001BBE 3954 * print " terminated string to FAC1 stack
-00001BBE 3955
-00001BBE 3956 LAB_20AE
-00001BBE 7422 3957 MOVEQ #$22,d2 * set Srchc character (terminator 1)
-00001BC0 3602 3958 MOVE.w d2,d3 * set Asrch character (terminator 2)
-00001BC2 3959
-00001BC2 3960 * print d2/d3 terminated string to FAC1 stack
-00001BC2 3961 * d2 = Srchc, d3 = Asrch, a0 is source
-00001BC2 3962 * a6 is temp
-00001BC2 3963
-00001BC2 3964 LAB_20B4
-00001BC2 7200 3965 MOVEQ #0,d1 * clear longword
-00001BC4 5341 3966 SUBQ.w #1,d1 * set length to -1
-00001BC6 2448 3967 MOVEA.l a0,a2 * copy start to calculate end
-00001BC8 3968 LAB_20BE
-00001BC8 5241 3969 ADDQ.w #1,d1 * increment length
-00001BCA 1030 1000 3970 MOVE.b (a0,d1.w),d0 * get byte from string
-00001BCE 6710 3971 BEQ.s LAB_20D0 * exit loop if null byte [EOS]
-00001BD0 3972
-00001BD0 B002 3973 CMP.b d2,d0 * compare with search character (terminator 1)
-00001BD2 6704 3974 BEQ.s LAB_20CB * branch if terminator
-00001BD4 3975
-00001BD4 B003 3976 CMP.b d3,d0 * compare with terminator 2
-00001BD6 66F0 3977 BNE.s LAB_20BE * loop if not terminator 2 (or null string)
-00001BD8 3978
-00001BD8 3979 LAB_20CB
-00001BD8 B03C 0022 3980 CMP.b #$22,d0 * compare with "
-00001BDC 6602 3981 BNE.s LAB_20D0 * branch if not "
-00001BDE 3982
-00001BDE 524A 3983 ADDQ.w #1,a2 * else increment string start (skip " at end)
-00001BE0 3984 LAB_20D0
-00001BE0 D5C1 3985 ADDA.l d1,a2 * add longowrd length to make string end+1
-00001BE2 3986
-00001BE2 B1CB 3987 CMPA.l a3,a0 * is string in ram
-00001BE4 651E 3988 BCS.s LAB_RTST * if not go push descriptor on stack & exit
-00001BE6 3989 * (could be message string from ROM)
-00001BE6 3990
-00001BE6 B1EB 042E 3991 CMPA.l Smeml(a3),a0 * is string in utility ram
-00001BEA 6418 3992 BCC.s LAB_RTST * if not go push descriptor on stack & exit
-00001BEC 3993 * (is in string or program space)
-00001BEC 3994
-00001BEC 3995 * (else) copy string to string memory
-00001BEC 3996 LAB_20C9
-00001BEC 2248 3997 MOVEA.l a0,a1 * copy descriptor pointer
-00001BEE 2001 3998 MOVE.l d1,d0 * copy longword length
-00001BF0 6604 3999 BNE.s LAB_20D8 * branch if not null string
-00001BF2 4000
-00001BF2 2041 4001 MOVEA.l d1,a0 * make null pointer
-00001BF4 600E 4002 BRA.s LAB_RTST * go push descriptor on stack & exit
-00001BF6 4003
-00001BF6 4004 LAB_20D8
-00001BF6 6126 4005 BSR.s LAB_2115 * make string space d1 bytes long
-00001BF8 D1C1 4006 ADDA.l d1,a0 * new string end
-00001BFA D3C1 4007 ADDA.l d1,a1 * old string end
-00001BFC 5340 4008 SUBQ.w #1,d0 * -1 for DBF loop
-00001BFE 4009 LAB_20E0
-00001BFE 1121 4010 MOVE.b -(a1),-(a0) * copy byte (source can be odd aligned)
-00001C00 51C8 FFFC 4011 DBF d0,LAB_20E0 * loop until done
-00001C04 4012
-00001C04 4013
-00001C04 4014
-00001C04 4015 *************************************************************************************
-00001C04 4016 *
-00001C04 4017 * check for space on descriptor stack then ...
-00001C04 4018 * put string address and length on descriptor stack & update stack pointers
-00001C04 4019 * start is in a0, length is in d1
-00001C04 4020
-00001C04 4021 LAB_RTST
-00001C04 43EB 0476 4022 LEA des_sk_e(a3),a1 * get string stack pointer max+1
-00001C08 B9C9 4023 CMPA.l a1,a4 * compare string stack pointer with max+1
-00001C0A 6700 ED2A 4024 BEQ LAB_SCER * if no space on string stack ..
-00001C0E 4025 * .. go do 'string too complex' error
-00001C0E 4026
-00001C0E 4027 * push string & update pointers
-00001C0E 3901 4028 MOVE.w d1,-(a4) * string length on descriptor stack
-00001C10 2908 4029 MOVE.l a0,-(a4) * string address on stack
-00001C12 274C 0590 4030 MOVE.l a4,FAC1_m(a3) * string descriptor pointer in FAC1
-00001C16 177C 0080 05B5 4031 MOVE.b #$80,Dtypef(a3) * save data type flag, $80=string
-00001C1C 4E75 4032 RTS
-00001C1E 4033
-00001C1E 4034
-00001C1E 4035 *************************************************************************************
-00001C1E 4036 *
-00001C1E 4037 * build descriptor a0/d1
-00001C1E 4038 * make space in string memory for string d1.w long
-00001C1E 4039 * return pointer in a0/Sutill
-00001C1E 4040
-00001C1E 4041 LAB_2115
-00001C1E 4A41 4042 TST.w d1 * test length
-00001C20 672E 4043 BEQ.s LAB_2128 * branch if user wants null string
-00001C22 4044
-00001C22 4045 * make space for string d1 long
-00001C22 2F00 4046 MOVE.l d0,-(sp) * save d0
-00001C24 7000 4047 MOVEQ #0,d0 * clear longword
-00001C26 1740 05DE 4048 MOVE.b d0,Gclctd(a3) * clear garbage collected flag (b7)
-00001C2A 7001 4049 MOVEQ #1,d0 * +1 to possibly round up
-00001C2C C041 4050 AND.w d1,d0 * mask odd bit
-00001C2E D041 4051 ADD.w d1,d0 * ensure d0 is even length
-00001C30 6404 4052 BCC.s LAB_2117 * branch if no overflow
-00001C32 4053
-00001C32 7001 4054 MOVEQ #1,d0 * set to allocate 65536 bytes
-00001C34 4840 4055 SWAP d0 * makes $00010000
-00001C36 4056 LAB_2117
-00001C36 206B 0446 4057 MOVEA.l Sstorl(a3),a0 * get bottom of string space
-00001C3A 91C0 4058 SUBA.l d0,a0 * subtract string length
-00001C3C B1EB 0442 4059 CMPA.l Earryl(a3),a0 * compare with top of array space
-00001C40 6512 4060 BCS.s LAB_2137 * if less do out of memory error
-00001C42 4061
-00001C42 2748 0446 4062 MOVE.l a0,Sstorl(a3) * save bottom of string space
-00001C46 2748 044E 4063 MOVE.l a0,Sutill(a3) * save string utility pointer
-00001C4A 201F 4064 MOVE.l (sp)+,d0 * restore d0
-00001C4C 4A41 4065 TST.w d1 * set flags on length
-00001C4E 4E75 4066 RTS
-00001C50 4067
-00001C50 4068 LAB_2128
-00001C50 3041 4069 MOVEA.w d1,a0 * make null pointer
-00001C52 4E75 4070 RTS
-00001C54 4071
-00001C54 4072 LAB_2137
-00001C54 4A2B 05DE 4073 TST.b Gclctd(a3) * get garbage collected flag
-00001C58 6B00 ECFC 4074 BMI LAB_OMER * do "Out of memory" error, then warm start
-00001C5C 4075
-00001C5C 2F09 4076 MOVE.l a1,-(sp) * save a1
-00001C5E 610A 4077 BSR.s LAB_GARB * else go do garbage collection
-00001C60 225F 4078 MOVEA.l (sp)+,a1 * restore a1
-00001C62 177C 0080 05DE 4079 MOVE.b #$80,Gclctd(a3) * set garbage collected flag
-00001C68 60CC 4080 BRA.s LAB_2117 * go try again
-00001C6A 4081
-00001C6A 4082
-00001C6A 4083 *************************************************************************************
-00001C6A 4084 *
-00001C6A 4085 * garbage collection routine
-00001C6A 4086
-00001C6A 4087 LAB_GARB
-00001C6A 48E7 E0E0 4088 MOVEM.l d0-d2/a0-a2,-(sp) * save registers
-00001C6E 276B 044A 0446 4089 MOVE.l Ememl(a3),Sstorl(a3) * start with no strings
-00001C74 4090
-00001C74 4091 * re-run routine from last ending
-00001C74 4092 LAB_214B
-00001C74 222B 0442 4093 MOVE.l Earryl(a3),d1 * set highest uncollected string so far
-00001C78 7000 4094 MOVEQ #0,d0 * clear longword
-00001C7A 2240 4095 MOVEA.l d0,a1 * clear string to move pointer
-00001C7C 206B 043A 4096 MOVEA.l Sstrl(a3),a0 * set pointer to start of strings
-00001C80 41E8 0004 4097 LEA 4(a0),a0 * index to string pointer
-00001C84 246B 043E 4098 MOVEA.l Sarryl(a3),a2 * set end pointer to start of arrays (end of
-00001C88 4099 * strings)
-00001C88 6008 4100 BRA.s LAB_2176 * branch into loop at end loop test
-00001C8A 4101
-00001C8A 4102 LAB_2161
-00001C8A 6100 0084 4103 BSR LAB_2206 * test and set if this is the highest string
-00001C8E 41E8 000A 4104 LEA 10(a0),a0 * increment to next string
-00001C92 4105 LAB_2176
-00001C92 B1CA 4106 CMPA.l a2,a0 * compare end of area with pointer
-00001C94 65F4 4107 BCS.s LAB_2161 * go do next if not at end
-00001C96 4108
-00001C96 4109 * done strings, now do arrays.
-00001C96 4110
-00001C96 41E8 FFFC 4111 LEA -4(a0),a0 * decrement pointer to start of arrays
-00001C9A 246B 0442 4112 MOVEA.l Earryl(a3),a2 * set end pointer to end of arrays
-00001C9E 6024 4113 BRA.s LAB_218F * branch into loop at end loop test
-00001CA0 4114
-00001CA0 4115 LAB_217E
-00001CA0 2428 0004 4116 MOVE.l 4(a0),d2 * get array size
-00001CA4 D488 4117 ADD.l a0,d2 * makes start of next array
-00001CA6 4118
-00001CA6 2010 4119 MOVE.l (a0),d0 * get array name
-00001CA8 0800 0017 4120 BTST #23,d0 * test string flag
-00001CAC 6714 4121 BEQ.s LAB_218B * branch if not string
-00001CAE 4122
-00001CAE 3028 0008 4123 MOVE.w 8(a0),d0 * get # of dimensions
-00001CB2 D040 4124 ADD.w d0,d0 * *2
-00001CB4 D0C0 4125 ADDA.w d0,a0 * add to skip dimension size(s)
-00001CB6 41E8 000A 4126 LEA 10(a0),a0 * increment to first element
-00001CBA 4127 LAB_2183
-00001CBA 6154 4128 BSR.s LAB_2206 * test and set if this is the highest string
-00001CBC 5C48 4129 ADDQ.w #6,a0 * increment to next element
-00001CBE B1C2 4130 CMPA.l d2,a0 * compare with start of next array
-00001CC0 66F8 4131 BNE.s LAB_2183 * go do next if not at end of array
-00001CC2 4132
-00001CC2 4133 LAB_218B
-00001CC2 2042 4134 MOVEA.l d2,a0 * pointer to next array
-00001CC4 4135 LAB_218F
-00001CC4 B5C8 4136 CMPA.l a0,a2 * compare pointer with array end
-00001CC6 66D8 4137 BNE.s LAB_217E * go do next if not at end
-00001CC8 4138
-00001CC8 4139 * done arrays and variables, now just the descriptor stack to do
-00001CC8 4140
-00001CC8 204C 4141 MOVEA.l a4,a0 * get descriptor stack pointer
-00001CCA 45EB 048E 4142 LEA des_sk(a3),a2 * set end pointer to end of stack
-00001CCE 6006 4143 BRA.s LAB_21C4 * branch into loop at end loop test
-00001CD0 4144
-00001CD0 4145 LAB_21C2
-00001CD0 613E 4146 BSR.s LAB_2206 * test and set if this is the highest string
-00001CD2 41E8 0006 4147 LEA 6(a0),a0 * increment to next string
-00001CD6 4148 LAB_21C4
-00001CD6 B5C8 4149 CMPA.l a0,a2 * compare pointer with stack end
-00001CD8 66F6 4150 BNE.s LAB_21C2 * go do next if not at end
-00001CDA 4151
-00001CDA 4152 * descriptor search complete, now either exit or set-up and move string
-00001CDA 4153
-00001CDA 2009 4154 MOVE.l a1,d0 * set the flags (a1 is move string)
-00001CDC 672C 4155 BEQ.s LAB_21D1 * go tidy up and exit if no move
-00001CDE 4156
-00001CDE 2051 4157 MOVEA.l (a1),a0 * a0 is now string start
-00001CE0 7200 4158 MOVEQ #0,d1 * clear d1
-00001CE2 3229 0004 4159 MOVE.w 4(a1),d1 * d1 is string length
-00001CE6 5281 4160 ADDQ.l #1,d1 * +1
-00001CE8 C23C 00FE 4161 AND.b #$FE,d1 * make even length
-00001CEC D1C1 4162 ADDA.l d1,a0 * pointer is now to string end+1
-00001CEE 246B 0446 4163 MOVEA.l Sstorl(a3),a2 * is destination end+1
-00001CF2 B1CA 4164 CMPA.l a2,a0 * does the string need moving
-00001CF4 670C 4165 BEQ.s LAB_2240 * branch if not
-00001CF6 4166
-00001CF6 E289 4167 LSR.l #1,d1 * word move so do /2
-00001CF8 5341 4168 SUBQ.w #1,d1 * -1 for DBF loop
-00001CFA 4169 LAB_2216
-00001CFA 3520 4170 MOVE.w -(a0),-(a2) * copy word
-00001CFC 51C9 FFFC 4171 DBF d1,LAB_2216 * loop until done
-00001D00 4172
-00001D00 228A 4173 MOVE.l a2,(a1) * save new string start
-00001D02 4174 LAB_2240
-00001D02 2751 0446 4175 MOVE.l (a1),Sstorl(a3) * string start is new string mem start
-00001D06 6000 FF6C 4176 BRA LAB_214B * re-run routine from last ending
-00001D0A 4177 * (but don't collect this string)
-00001D0A 4178
-00001D0A 4179 LAB_21D1
-00001D0A 4CDF 0707 4180 MOVEM.l (sp)+,d0-d2/a0-a2 * restore registers
-00001D0E 4E75 4181 RTS
-00001D10 4182
-00001D10 4183 * test and set if this is the highest string
-00001D10 4184
-00001D10 4185 LAB_2206
-00001D10 2010 4186 MOVE.l (a0),d0 * get this string pointer
-00001D12 6728 4187 BEQ.s RTS_012 * exit if null string
-00001D14 4188
-00001D14 B280 4189 CMP.l d0,d1 * compare with highest uncollected string so far
-00001D16 6424 4190 BCC.s RTS_012 * exit if <= with highest so far
-00001D18 4191
-00001D18 B0AB 0446 4192 CMP.l Sstorl(a3),d0 * compare with bottom of string space
-00001D1C 641E 4193 BCC.s RTS_012 * exit if >= bottom of string space
-00001D1E 4194
-00001D1E 70FF 4195 MOVEQ #-1,d0 * d0 = $FFFFFFFF
-00001D20 3028 0004 4196 MOVE.w 4(a0),d0 * d0 is string length
-00001D24 4440 4197 NEG.w d0 * make -ve
-00001D26 C03C 00FE 4198 AND.b #$FE,d0 * make -ve even length
-00001D2A D0AB 0446 4199 ADD.l Sstorl(a3),d0 * add string store to -ve length
-00001D2E B090 4200 CMP.l (a0),d0 * compare with string address
-00001D30 6706 4201 BEQ.s LAB_2212 * if = go move string store pointer down
-00001D32 4202
-00001D32 2210 4203 MOVE.l (a0),d1 * highest = current
-00001D34 2248 4204 MOVEA.l a0,a1 * string to move = current
-00001D36 4E75 4205 RTS
-00001D38 4206
-00001D38 4207 LAB_2212
-00001D38 2740 0446 4208 MOVE.l d0,Sstorl(a3) * set new string store start
-00001D3C 4209 RTS_012
-00001D3C 4E75 4210 RTS
-00001D3E 4211
-00001D3E 4212
-00001D3E 4213 *************************************************************************************
-00001D3E 4214 *
-00001D3E 4215 * concatenate - add strings
-00001D3E 4216 * string descriptor 1 is in FAC1_m, string 2 is in line
-00001D3E 4217
-00001D3E 4218 LAB_224D
-00001D3E 487A F73A 4219 PEA LAB_1ADB(pc) * continue evaluation after concatenate
-00001D42 2F2B 0590 4220 MOVE.l FAC1_m(a3),-(sp) * stack descriptor pointer for string 1
-00001D46 4221
-00001D46 6100 F80E 4222 BSR LAB_GVAL * get value from line
-00001D4A 4A2B 05B5 4223 TST.b Dtypef(a3) * test data type flag
-00001D4E 6A00 EBEE 4224 BPL LAB_TMER * if type is not string do type mismatch error
-00001D52 4225
-00001D52 205F 4226 MOVEA.l (sp)+,a0 * restore descriptor pointer for string 1
-00001D54 4227
-00001D54 4228 *************************************************************************************
-00001D54 4229 *
-00001D54 4230 * concatenate
-00001D54 4231 * string descriptor 1 is in a0, string descriptor 2 is in FAC1_m
-00001D54 4232
-00001D54 4233 LAB_224E
-00001D54 226B 0590 4234 MOVEA.l FAC1_m(a3),a1 * copy descriptor pointer 2
-00001D58 3228 0004 4235 MOVE.w 4(a0),d1 * get length 1
-00001D5C D269 0004 4236 ADD.w 4(a1),d1 * add length 2
-00001D60 6500 EBD8 4237 BCS LAB_SLER * if overflow go do 'string too long' error
-00001D64 4238
-00001D64 2F08 4239 MOVE.l a0,-(sp) * save descriptor pointer 1
-00001D66 6100 FEB6 4240 BSR LAB_2115 * make space d1 bytes long
-00001D6A 2748 0598 4241 MOVE.l a0,FAC2_m(a3) * save new string start pointer
-00001D6E 2057 4242 MOVEA.l (sp),a0 * copy descriptor pointer 1 from stack
-00001D70 3028 0004 4243 MOVE.w 4(a0),d0 * get length
-00001D74 2050 4244 MOVEA.l (a0),a0 * get string pointer
-00001D76 6120 4245 BSR.s LAB_229E * copy string d0 bytes long from a0 to Sutill
-00001D78 4246 * return with a0 = pointer, d1 = length
-00001D78 4247
-00001D78 206B 0590 4248 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer for string 2
-00001D7C 6138 4249 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
-00001D7E 4250 * a0 = pointer, d0 = length
-00001D7E 6118 4251 BSR.s LAB_229E * copy string d0 bytes long from a0 to Sutill
-00001D80 4252 * return with a0 = pointer, d1 = length
-00001D80 4253
-00001D80 205F 4254 MOVEA.l (sp)+,a0 * get descriptor pointer for string 1
-00001D82 6132 4255 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
-00001D84 4256 * d0 = length, a0 = pointer
-00001D84 4257
-00001D84 206B 0598 4258 MOVEA.l FAC2_m(a3),a0 * retreive the result string pointer
-00001D88 2208 4259 MOVE.l a0,d1 * copy the result string pointer
-00001D8A 6700 FE78 4260 BEQ LAB_RTST * if it is a null string just return it
-00001D8E 4261 * a0 = pointer, d1 = length
-00001D8E 4262
-00001D8E 4481 4263 NEG.l d1 * else make the start pointer negative
-00001D90 D2AB 044E 4264 ADD.l Sutill(a3),d1 * add the end pointert to give the length
-00001D94 6000 FE6E 4265 BRA LAB_RTST * push string on descriptor stack
-00001D98 4266 * a0 = pointer, d1 = length
-00001D98 4267
-00001D98 4268
-00001D98 4269 *************************************************************************************
-00001D98 4270 *
-00001D98 4271 * copy string d0 bytes long from a0 to Sutill
-00001D98 4272 * return with a0 = pointer, d1 = length
-00001D98 4273
-00001D98 4274 LAB_229E
-00001D98 3200 4275 MOVE.w d0,d1 * copy and check length
-00001D9A 6714 4276 BEQ.s RTS_013 * skip copy if null
-00001D9C 4277
-00001D9C 226B 044E 4278 MOVEA.l Sutill(a3),a1 * get destination pointer
-00001DA0 2F09 4279 MOVE.l a1,-(sp) * save destination string pointer
-00001DA2 5340 4280 SUBQ.w #1,d0 * subtract for DBF loop
-00001DA4 4281 LAB_22A0
-00001DA4 12D8 4282 MOVE.b (a0)+,(a1)+ * copy byte
-00001DA6 51C8 FFFC 4283 DBF d0,LAB_22A0 * loop if not done
-00001DAA 4284
-00001DAA 2749 044E 4285 MOVE.l a1,Sutill(a3) * update Sutill to end of copied string
-00001DAE 205F 4286 MOVEA.l (sp)+,a0 * restore destination string pointer
-00001DB0 4287 RTS_013
-00001DB0 4E75 4288 RTS
-00001DB2 4289
-00001DB2 4290
-00001DB2 4291 *************************************************************************************
-00001DB2 4292 *
-00001DB2 4293 * pop string off descriptor stack, or from top of string space
-00001DB2 4294 * returns with d0.l = length, a0 = pointer
-00001DB2 4295
-00001DB2 4296 LAB_22B6
-00001DB2 206B 0590 4297 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer
-00001DB6 4298
-00001DB6 4299
-00001DB6 4300 *************************************************************************************
-00001DB6 4301 *
-00001DB6 4302 * pop (a0) descriptor off stack or from string space
-00001DB6 4303 * returns with d0.l = length, a0 = pointer
-00001DB6 4304
-00001DB6 4305 LAB_22BA
-00001DB6 48E7 4040 4306 MOVEM.l a1/d1,-(sp) * save other regs
-00001DBA B9C8 4307 CMPA.l a0,a4 * is string on the descriptor stack
-00001DBC 6602 4308 BNE.s LAB_22BD * skip pop if not
-00001DBE 4309
-00001DBE 5C4C 4310 ADDQ.w #$06,a4 * else update stack pointer
-00001DC0 4311 LAB_22BD
-00001DC0 7000 4312 MOVEQ #0,d0 * clear string length longword
-00001DC2 2258 4313 MOVEA.l (a0)+,a1 * get string address
-00001DC4 3018 4314 MOVE.w (a0)+,d0 * get string length
-00001DC6 4315
-00001DC6 B9C8 4316 CMPA.l a0,a4 * was it on the descriptor stack
-00001DC8 6610 4317 BNE.s LAB_22E6 * branch if it wasn't
-00001DCA 4318
-00001DCA B3EB 0446 4319 CMPA.l Sstorl(a3),a1 * compare string address with bottom of string
-00001DCE 4320 * space
-00001DCE 660A 4321 BNE.s LAB_22E6 * branch if <>
-00001DD0 4322
-00001DD0 7201 4323 MOVEQ #1,d1 * mask for odd bit
-00001DD2 C240 4324 AND.w d0,d1 * AND length
-00001DD4 D280 4325 ADD.l d0,d1 * make it fit word aligned length
-00001DD6 4326
-00001DD6 D3AB 0446 4327 ADD.l d1,Sstorl(a3) * add to bottom of string space
-00001DDA 4328 LAB_22E6
-00001DDA 2049 4329 MOVEA.l a1,a0 * copy to a0
-00001DDC 4CDF 0202 4330 MOVEM.l (sp)+,a1/d1 * restore other regs
-00001DE0 4A80 4331 TST.l d0 * set flags on length
-00001DE2 4E75 4332 RTS
-00001DE4 4333
-00001DE4 4334
-00001DE4 4335 *************************************************************************************
-00001DE4 4336 *
-00001DE4 4337 * perform CHR$()
-00001DE4 4338
-00001DE4 4339 LAB_CHRS
-00001DE4 6100 0130 4340 BSR LAB_EVBY * evaluate byte expression, result in d0 and
-00001DE8 4341 * Itemp
-00001DE8 4342 LAB_MKCHR
-00001DE8 7201 4343 MOVEQ #1,d1 * string is single byte
-00001DEA 6100 FE32 4344 BSR LAB_2115 * make string space d1 bytes long
-00001DEE 4345 * return a0/Sutill = pointer, others unchanged
-00001DEE 1080 4346 MOVE.b d0,(a0) * save byte in string (byte IS string!)
-00001DF0 6000 FE12 4347 BRA LAB_RTST * push string on descriptor stack
-00001DF4 4348 * a0 = pointer, d1 = length
-00001DF4 4349
-00001DF4 4350
-00001DF4 4351 *************************************************************************************
-00001DF4 4352 *
-00001DF4 4353 * perform LEFT$()
-00001DF4 4354
-00001DF4 4355 * enter with a0 is descriptor, d0 & Itemp is word 1
-00001DF4 4356
-00001DF4 4357 LAB_LEFT
-00001DF4 C141 4358 EXG d0,d1 * word in d1
-00001DF6 6100 F79E 4359 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00001DFA 4360
-00001DFA 4A81 4361 TST.l d1 * test returned length
-00001DFC 6722 4362 BEQ.s LAB_231C * branch if null return
-00001DFE 4363
-00001DFE 7000 4364 MOVEQ #0,d0 * clear start offset
-00001E00 B268 0004 4365 CMP.w 4(a0),d1 * compare word parameter with string length
-00001E04 651A 4366 BCS.s LAB_231C * branch if string length > word parameter
-00001E06 4367
-00001E06 6014 4368 BRA.s LAB_2317 * go copy whole string
-00001E08 4369
-00001E08 4370
-00001E08 4371 *************************************************************************************
-00001E08 4372 *
-00001E08 4373 * perform RIGHT$()
-00001E08 4374
-00001E08 4375 * enter with a0 is descriptor, d0 & Itemp is word 1
-00001E08 4376
-00001E08 4377 LAB_RIGHT
-00001E08 C141 4378 EXG d0,d1 * word in d1
-00001E0A 6100 F78A 4379 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00001E0E 4380
-00001E0E 4A81 4381 TST.l d1 * test returned length
-00001E10 670E 4382 BEQ.s LAB_231C * branch if null return
-00001E12 4383
-00001E12 3028 0004 4384 MOVE.w 4(a0),d0 * get string length
-00001E16 9081 4385 SUB.l d1,d0 * subtract word
-00001E18 6406 4386 BCC.s LAB_231C * branch if string length > word parameter
-00001E1A 4387
-00001E1A 4388 * else copy whole string
-00001E1A 4389 LAB_2316
-00001E1A 7000 4390 MOVEQ #0,d0 * clear start offset
-00001E1C 4391 LAB_2317
-00001E1C 3228 0004 4392 MOVE.w 4(a0),d1 * else make parameter = length
-00001E20 4393
-00001E20 4394 * get here with ...
-00001E20 4395 * a0 - points to descriptor
-00001E20 4396 * d0 - is offset from string start
-00001E20 4397 * d1 - is required string length
-00001E20 4398
-00001E20 4399 LAB_231C
-00001E20 2248 4400 MOVEA.l a0,a1 * save string descriptor pointer
-00001E22 6100 FDFA 4401 BSR LAB_2115 * make string space d1 bytes long
-00001E26 4402 * return a0/Sutill = pointer, others unchanged
-00001E26 2049 4403 MOVEA.l a1,a0 * restore string descriptor pointer
-00001E28 2F00 4404 MOVE.l d0,-(sp) * save start offset (longword)
-00001E2A 618A 4405 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
-00001E2C 4406 * d0 = length, a0 = pointer
-00001E2C D1DF 4407 ADDA.l (sp)+,a0 * adjust pointer to start of wanted string
-00001E2E 3001 4408 MOVE.w d1,d0 * length to d0
-00001E30 6100 FF66 4409 BSR LAB_229E * store string d0 bytes long from (a0) to
-00001E34 4410 * (Sutill) return with a0 = pointer,
-00001E34 4411 * d1 = length
-00001E34 6000 FDCE 4412 BRA LAB_RTST * push string on descriptor stack
-00001E38 4413 * a0 = pointer, d1 = length
-00001E38 4414
-00001E38 4415
-00001E38 4416 *************************************************************************************
-00001E38 4417 *
-00001E38 4418 * perform MID$()
-00001E38 4419
-00001E38 4420 * enter with a0 is descriptor, d0 & Itemp is word 1
-00001E38 4421
-00001E38 4422 LAB_MIDS
-00001E38 7E00 4423 MOVEQ #0,d7 * clear longword
-00001E3A 5347 4424 SUBQ.w #1,d7 * set default length = 65535
-00001E3C 2F00 4425 MOVE.l d0,-(sp) * save word 1
-00001E3E 6100 F76A 4426 BSR LAB_GBYT * scan memory
-00001E42 B03C 002C 4427 CMP.b #',',d0 * was it ","
-00001E46 660C 4428 BNE.s LAB_2358 * branch if not "," (skip second byte get)
-00001E48 4429
-00001E48 101D 4430 MOVE.b (a5)+,d0 * increment pointer past ","
-00001E4A 2F08 4431 MOVE.l a0,-(sp) * save descriptor pointer
-00001E4C 6100 00D8 4432 BSR LAB_GTWO * get word parameter, result in d0 and Itemp
-00001E50 205F 4433 MOVEA.l (sp)+,a0 * restore descriptor pointer
-00001E52 2E00 4434 MOVE.l d0,d7 * copy length
-00001E54 4435 LAB_2358
-00001E54 6100 F740 4436 BSR LAB_1BFB * scan for ")", else do syntax error then warm
-00001E58 4437 * start
-00001E58 201F 4438 MOVE.l (sp)+,d0 * restore word 1
-00001E5A 7200 4439 MOVEQ #0,d1 * null length
-00001E5C 5380 4440 SUBQ.l #1,d0 * decrement start index (word 1)
-00001E5E 6B00 EAFE 4441 BMI LAB_FCER * if was null do function call error then warm
-00001E62 4442 * start
-00001E62 4443
-00001E62 B068 0004 4444 CMP.w 4(a0),d0 * compare string length with start index
-00001E66 64B8 4445 BCC.s LAB_231C * if start not in string do null string (d1=0)
-00001E68 4446
-00001E68 2207 4447 MOVE.l d7,d1 * get length back
-00001E6A DE40 4448 ADD.w d0,d7 * d7 now = MID$() end
-00001E6C 6506 4449 BCS.s LAB_2368 * already too long so do RIGHT$ equivalent
-00001E6E 4450
-00001E6E BE68 0004 4451 CMP.w 4(a0),d7 * compare string length with start index+length
-00001E72 65AC 4452 BCS.s LAB_231C * if end in string go do string
-00001E74 4453
-00001E74 4454 LAB_2368
-00001E74 3228 0004 4455 MOVE.w 4(a0),d1 * get string length
-00001E78 9240 4456 SUB.w d0,d1 * subtract start offset
-00001E7A 60A4 4457 BRA.s LAB_231C * go do string (effectively RIGHT$)
-00001E7C 4458
-00001E7C 4459
-00001E7C 4460 *************************************************************************************
-00001E7C 4461 *
-00001E7C 4462 * perform LCASE$()
-00001E7C 4463
-00001E7C 4464 LAB_LCASE
-00001E7C 6100 FF34 4465 BSR LAB_22B6 * pop string off descriptor stack or from memory
-00001E80 4466 * returns with d0 = length, a0 = pointer
-00001E80 2200 4467 MOVE.l d0,d1 * copy the string length
-00001E82 6756 4468 BEQ.s NoString * if null go return a null string
-00001E84 4469
-00001E84 4470 * else copy and change the string
-00001E84 4471
-00001E84 2248 4472 MOVEA.l a0,a1 * copy the string address
-00001E86 6100 FD96 4473 BSR LAB_2115 * make a string space d1 bytes long
-00001E8A D1C1 4474 ADDA.l d1,a0 * new string end
-00001E8C D3C1 4475 ADDA.l d1,a1 * old string end
-00001E8E 3401 4476 MOVE.w d1,d2 * copy length for loop
-00001E90 5342 4477 SUBQ.w #1,d2 * -1 for DBF loop
-00001E92 4478 LC_loop
-00001E92 1021 4479 MOVE.b -(a1),d0 * get byte from string
-00001E94 4480
-00001E94 B03C 005B 4481 CMP.b #$5B,d0 * compare with "Z"+1
-00001E98 640A 4482 BCC.s NoUcase * if > "Z" skip change
-00001E9A 4483
-00001E9A B03C 0041 4484 CMP.b #$41,d0 * compare with "A"
-00001E9E 6504 4485 BCS.s NoUcase * if < "A" skip change
-00001EA0 4486
-00001EA0 0000 0020 4487 ORI.b #$20,d0 * convert upper case to lower case
-00001EA4 4488 NoUcase
-00001EA4 1100 4489 MOVE.b d0,-(a0) * copy upper case byte back to string
-00001EA6 51CA FFEA 4490 DBF d2,LC_loop * decrement and loop if not all done
-00001EAA 4491
-00001EAA 602E 4492 BRA.s NoString * tidy up & exit (branch always)
-00001EAC 4493
-00001EAC 4494
-00001EAC 4495 *************************************************************************************
-00001EAC 4496 *
-00001EAC 4497 * perform UCASE$()
-00001EAC 4498
-00001EAC 4499 LAB_UCASE
-00001EAC 6100 FF04 4500 BSR LAB_22B6 * pop string off descriptor stack or from memory
-00001EB0 4501 * returns with d0 = length, a0 = pointer
-00001EB0 2200 4502 MOVE.l d0,d1 * copy the string length
-00001EB2 6726 4503 BEQ.s NoString * if null go return a null string
-00001EB4 4504
-00001EB4 4505 * else copy and change the string
-00001EB4 4506
-00001EB4 2248 4507 MOVEA.l a0,a1 * copy the string address
-00001EB6 6100 FD66 4508 BSR LAB_2115 * make a string space d1 bytes long
-00001EBA D1C1 4509 ADDA.l d1,a0 * new string end
-00001EBC D3C1 4510 ADDA.l d1,a1 * old string end
-00001EBE 3401 4511 MOVE.w d1,d2 * copy length for loop
-00001EC0 5342 4512 SUBQ.w #1,d2 * -1 for DBF loop
-00001EC2 4513 UC_loop
-00001EC2 1021 4514 MOVE.b -(a1),d0 * get a byte from the string
-00001EC4 4515
-00001EC4 B03C 0061 4516 CMP.b #$61,d0 * compare with "a"
-00001EC8 650A 4517 BCS.s NoLcase * if < "a" skip change
-00001ECA 4518
-00001ECA B03C 007B 4519 CMP.b #$7B,d0 * compare with "z"+1
-00001ECE 6404 4520 BCC.s NoLcase * if > "z" skip change
-00001ED0 4521
-00001ED0 0200 00DF 4522 ANDI.b #$DF,d0 * convert lower case to upper case
-00001ED4 4523 NoLcase
-00001ED4 1100 4524 MOVE.b d0,-(a0) * copy upper case byte back to string
-00001ED6 51CA FFEA 4525 DBF d2,UC_loop * decrement and loop if not all done
-00001EDA 4526
-00001EDA 4527 NoString
-00001EDA 6000 FD28 4528 BRA LAB_RTST * push string on descriptor stack
-00001EDE 4529 * a0 = pointer, d1 = length
-00001EDE 4530
-00001EDE 4531
-00001EDE 4532 *************************************************************************************
-00001EDE 4533 *
-00001EDE 4534 * perform SADD()
-00001EDE 4535
-00001EDE 4536 LAB_SADD
-00001EDE 101D 4537 MOVE.b (a5)+,d0 * increment pointer
-00001EE0 6100 F8D6 4538 BSR LAB_GVAR * get variable address in a0
-00001EE4 6100 F6B0 4539 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00001EE8 4A2B 05B5 4540 TST.b Dtypef(a3) * test data type flag
-00001EEC 6A00 EA50 4541 BPL LAB_TMER * if numeric do Type missmatch Error
-00001EF0 4542
-00001EF0 4543 * if you want a non existant variable to return a null value then set the novar
-00001EF0 4544 * value at the top of this file to some non zero value
-00001EF0 4545
-00001EF0 FALSE 4546 ifne novar
-00001EF0 4547 endc
-00001EF0 4548
-00001EF0 2010 4549 MOVE.l (a0),d0 * get string address
-00001EF2 6000 FBB4 4550 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-00001EF6 4551
-00001EF6 4552
-00001EF6 4553 *************************************************************************************
-00001EF6 4554 *
-00001EF6 4555 * perform LEN()
-00001EF6 4556
-00001EF6 4557 LAB_LENS
-00001EF6 487A FBB0 4558 PEA LAB_AYFC(pc) * set return address to convert d0 to signed
-00001EFA 4559 * longword in FAC1
-00001EFA 6000 FEB6 4560 BRA LAB_22B6 * pop string off descriptor stack or from memory
-00001EFE 4561 * returns with d0 = length, a0 = pointer
-00001EFE 4562
-00001EFE 4563
-00001EFE 4564 *************************************************************************************
-00001EFE 4565 *
-00001EFE 4566 * perform ASC()
-00001EFE 4567
-00001EFE 4568 LAB_ASC
-00001EFE 6100 FEB2 4569 BSR LAB_22B6 * pop string off descriptor stack or from memory
-00001F02 4570 * returns with d0 = length, a0 = pointer
-00001F02 4A40 4571 TST.w d0 * test length
-00001F04 6700 EA58 4572 BEQ LAB_FCER * if null do function call error then warm start
-00001F08 4573
-00001F08 1010 4574 MOVE.b (a0),d0 * get first character byte
-00001F0A 6000 FBBC 4575 BRA LAB_1FD0 * convert d0 to unsigned byte in FAC1 & return
-00001F0E 4576
-00001F0E 4577
-00001F0E 4578 *************************************************************************************
-00001F0E 4579 *
-00001F0E 4580 * increment and get byte, result in d0 and Itemp
-00001F0E 4581
-00001F0E 4582 LAB_SGBY
-00001F0E 6100 F698 4583 BSR LAB_IGBY * increment & scan memory
-00001F12 4584
-00001F12 4585
-00001F12 4586 *************************************************************************************
-00001F12 4587 *
-00001F12 4588 * get byte parameter, result in d0 and Itemp
-00001F12 4589
-00001F12 4590 LAB_GTBY
-00001F12 6100 F51C 4591 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001F16 4592 * else do type mismatch
-00001F16 4593
-00001F16 4594
-00001F16 4595 *************************************************************************************
-00001F16 4596 *
-00001F16 4597 * evaluate byte expression, result in d0 and Itemp
-00001F16 4598
-00001F16 4599 LAB_EVBY
-00001F16 6100 F9D4 4600 BSR LAB_EVPI * evaluate positive integer expression
-00001F1A 4601 * result in d0 and Itemp
-00001F1A 7280 4602 MOVEQ #$80,d1 * set mask/2
-00001F1C D281 4603 ADD.l d1,d1 * =$FFFFFF00
-00001F1E C280 4604 AND.l d0,d1 * check top 24 bits
-00001F20 6600 EA3C 4605 BNE LAB_FCER * if <> 0 do function call error/warm start
-00001F24 4606
-00001F24 4E75 4607 RTS
-00001F26 4608
-00001F26 4609
-00001F26 4610 *************************************************************************************
-00001F26 4611 *
-00001F26 4612 * get word parameter, result in d0 and Itemp
-00001F26 4613
-00001F26 4614 LAB_GTWO
-00001F26 6100 F508 4615 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001F2A 4616 * else do type mismatch
-00001F2A 6100 F9C0 4617 BSR LAB_EVPI * evaluate positive integer expression
-00001F2E 4618 * result in d0 and Itemp
-00001F2E 4840 4619 SWAP d0 * copy high word to low word
-00001F30 4A40 4620 TST.w d0 * set flags
-00001F32 6600 EA2A 4621 BNE LAB_FCER * if <> 0 do function call error/warm start
-00001F36 4622
-00001F36 4840 4623 SWAP d0 * copy high word to low word
-00001F38 4E75 4624 RTS
-00001F3A 4625
-00001F3A 4626
-00001F3A 4627 *************************************************************************************
-00001F3A 4628 *
-00001F3A 4629 * perform VAL()
-00001F3A 4630
-00001F3A 4631 LAB_VAL
-00001F3A 6100 FE76 4632 BSR LAB_22B6 * pop string off descriptor stack or from memory
-00001F3E 4633 * returns with d0 = length, a0 = pointer
-00001F3E 6722 4634 BEQ.s LAB_VALZ * string was null so set result = $00
-00001F40 4635 * clear FAC1 exponent & sign & return
-00001F40 4636
-00001F40 2C4D 4637 MOVEA.l a5,a6 * save BASIC execute pointer
-00001F42 2A48 4638 MOVEA.l a0,a5 * copy string pointer to execute pointer
-00001F44 D1C0 4639 ADDA.l d0,a0 * string end+1
-00001F46 1010 4640 MOVE.b (a0),d0 * get byte from string+1
-00001F48 3F00 4641 MOVE.w d0,-(sp) * save it
-00001F4A 2F08 4642 MOVE.l a0,-(sp) * save address
-00001F4C 10BC 0000 4643 MOVE.b #0,(a0) * null terminate string
-00001F50 6100 F658 4644 BSR LAB_GBYT * scan memory
-00001F54 6100 1142 4645 BSR LAB_2887 * get FAC1 from string
-00001F58 205F 4646 MOVEA.l (sp)+,a0 * restore pointer
-00001F5A 301F 4647 MOVE.w (sp)+,d0 * pop byte
-00001F5C 1080 4648 MOVE.b d0,(a0) * restore to memory
-00001F5E 2A4E 4649 MOVEA.l a6,a5 * restore BASIC execute pointer
-00001F60 4E75 4650 RTS
-00001F62 4651
-00001F62 4652 LAB_VALZ
-00001F62 3740 0594 4653 MOVE.w d0,FAC1_e(a3) * clear FAC1 exponent & sign
-00001F66 4E75 4654 RTS
-00001F68 4655
-00001F68 4656
-00001F68 4657 *************************************************************************************
-00001F68 4658 *
-00001F68 4659 * get two parameters for POKE or WAIT, first parameter in a0, second in d0
-00001F68 4660
-00001F68 4661 LAB_GADB
-00001F68 6100 F4C6 4662 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001F6C 4663 * else do type mismatch
-00001F6C 6100 F986 4664 BSR LAB_EVIR * evaluate integer expression
-00001F70 4665 * (does FC error not OF error if out of range)
-00001F70 2F00 4666 MOVE.l d0,-(sp) * copy to stack
-00001F72 6100 F62A 4667 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
-00001F76 619A 4668 BSR.s LAB_GTBY * get byte parameter, result in d0 and Itemp
-00001F78 205F 4669 MOVEA.l (sp)+,a0 * pull address
-00001F7A 4E75 4670 RTS
-00001F7C 4671
-00001F7C 4672
-00001F7C 4673 *************************************************************************************
-00001F7C 4674 *
-00001F7C 4675 * get two parameters for DOKE or WAITW, first parameter in a0, second in d0
-00001F7C 4676
-00001F7C 4677 LAB_GADW
-00001F7C 611E 4678 BSR.s LAB_GEAD * get even address for word/long memory actions
-00001F7E 4679 * address returned in d0 and on the stack
-00001F7E 6100 F61E 4680 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
-00001F82 6100 F4AC 4681 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001F86 4682 * else do type mismatch
-00001F86 6100 F96C 4683 BSR LAB_EVIR * evaluate integer expression
-00001F8A 4684 * result in d0 and Itemp
-00001F8A 4840 4685 SWAP d0 * swap words
-00001F8C 4A40 4686 TST.w d0 * test high word
-00001F8E 6706 4687 BEQ.s LAB_XGADW * exit if null
-00001F90 4688
-00001F90 5240 4689 ADDQ.w #1,d0 * increment word
-00001F92 6600 E9CA 4690 BNE LAB_FCER * if <> 0 do function call error/warm start
-00001F96 4691
-00001F96 4692 LAB_XGADW
-00001F96 4840 4693 SWAP d0 * swap words back
-00001F98 205F 4694 MOVEA.l (sp)+,a0 * pull address
-00001F9A 4E75 4695 RTS
-00001F9C 4696
-00001F9C 4697
-00001F9C 4698 *************************************************************************************
-00001F9C 4699 *
-00001F9C 4700 * get even address (for word or longword memory actions)
-00001F9C 4701 * address returned in d0 and on the stack
-00001F9C 4702 * does address error if the address is odd
-00001F9C 4703
-00001F9C 4704 LAB_GEAD
-00001F9C 6100 F492 4705 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001FA0 4706 * else do type mismatch
-00001FA0 6100 F952 4707 BSR LAB_EVIR * evaluate integer expression
-00001FA4 4708 * (does FC error not OF error if out of range)
-00001FA4 0800 0000 4709 BTST #0,d0 * test low bit of longword
-00001FA8 6600 E970 4710 BNE LAB_ADER * if address is odd do address error/warm start
-00001FAC 4711
-00001FAC 2057 4712 MOVEA.l (sp),a0 * copy return address
-00001FAE 2E80 4713 MOVE.l d0,(sp) * even address on stack
-00001FB0 4ED0 4714 JMP (a0) * effectively RTS
-00001FB2 4715
-00001FB2 4716
-00001FB2 4717 *************************************************************************************
-00001FB2 4718 *
-00001FB2 4719 * perform PEEK()
-00001FB2 4720
-00001FB2 4721 LAB_PEEK
-00001FB2 6100 F940 4722 BSR LAB_EVIR * evaluate integer expression
-00001FB6 4723 * (does FC error not OF error if out of range)
-00001FB6 2040 4724 MOVEA.l d0,a0 * copy to address register
-00001FB8 1010 4725 MOVE.b (a0),d0 * get byte
-00001FBA 6000 FB0C 4726 BRA LAB_1FD0 * convert d0 to unsigned byte in FAC1 & return
-00001FBE 4727
-00001FBE 4728
-00001FBE 4729 *************************************************************************************
-00001FBE 4730 *
-00001FBE 4731 * perform POKE
-00001FBE 4732
-00001FBE 4733 LAB_POKE
-00001FBE 61A8 4734 BSR.s LAB_GADB * get two parameters for POKE or WAIT
-00001FC0 4735 * first parameter in a0, second in d0
-00001FC0 1080 4736 MOVE.b d0,(a0) * put byte in memory
-00001FC2 4E75 4737 RTS
-00001FC4 4738
-00001FC4 4739
-00001FC4 4740 *************************************************************************************
-00001FC4 4741 *
-00001FC4 4742 * perform DEEK()
-00001FC4 4743
-00001FC4 4744 LAB_DEEK
-00001FC4 6100 F92E 4745 BSR LAB_EVIR * evaluate integer expression
-00001FC8 4746 * (does FC error not OF error if out of range)
-00001FC8 E208 4747 LSR.b #1,d0 * shift bit 0 to carry
-00001FCA 6500 E94E 4748 BCS LAB_ADER * if address is odd do address error/warm start
-00001FCE 4749
-00001FCE D000 4750 ADD.b d0,d0 * shift byte back
-00001FD0 C188 4751 EXG d0,a0 * copy to address register
-00001FD2 7000 4752 MOVEQ #0,d0 * clear top bits
-00001FD4 3010 4753 MOVE.w (a0),d0 * get word
-00001FD6 6000 FAD0 4754 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-00001FDA 4755
-00001FDA 4756
-00001FDA 4757 *************************************************************************************
-00001FDA 4758 *
-00001FDA 4759 * perform LEEK()
-00001FDA 4760
-00001FDA 4761 LAB_LEEK
-00001FDA 6100 F918 4762 BSR LAB_EVIR * evaluate integer expression
-00001FDE 4763 * (does FC error not OF error if out of range)
-00001FDE E208 4764 LSR.b #1,d0 * shift bit 0 to carry
-00001FE0 6500 E938 4765 BCS LAB_ADER * if address is odd do address error/warm start
-00001FE4 4766
-00001FE4 D000 4767 ADD.b d0,d0 * shift byte back
-00001FE6 C188 4768 EXG d0,a0 * copy to address register
-00001FE8 2010 4769 MOVE.l (a0),d0 * get longword
-00001FEA 6000 FABC 4770 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-00001FEE 4771
-00001FEE 4772
-00001FEE 4773 *************************************************************************************
-00001FEE 4774 *
-00001FEE 4775 * perform DOKE
-00001FEE 4776
-00001FEE 4777 LAB_DOKE
-00001FEE 618C 4778 BSR.s LAB_GADW * get two parameters for DOKE or WAIT
-00001FF0 4779 * first parameter in a0, second in d0
-00001FF0 3080 4780 MOVE.w d0,(a0) * put word in memory
-00001FF2 4E75 4781 RTS
-00001FF4 4782
-00001FF4 4783
-00001FF4 4784 *************************************************************************************
-00001FF4 4785 *
-00001FF4 4786 * perform LOKE
-00001FF4 4787
-00001FF4 4788 LAB_LOKE
-00001FF4 61A6 4789 BSR.s LAB_GEAD * get even address for word/long memory actions
-00001FF6 4790 * address returned in d0 and on the stack
-00001FF6 6100 F5A6 4791 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
-00001FFA 6100 F434 4792 BSR LAB_EVNM * evaluate expression & check is numeric,
-00001FFE 4793 * else do type mismatch
-00001FFE 6100 F8F4 4794 BSR LAB_EVIR * evaluate integer value (no sign check)
-00002002 205F 4795 MOVEA.l (sp)+,a0 * pull address
-00002004 2080 4796 MOVE.l d0,(a0) * put longword in memory
-00002006 4797 RTS_015
-00002006 4E75 4798 RTS
-00002008 4799
-00002008 4800
-00002008 4801 *************************************************************************************
-00002008 4802 *
-00002008 4803 * perform SWAP
-00002008 4804
-00002008 4805 LAB_SWAP
-00002008 6100 F7AE 4806 BSR LAB_GVAR * get variable 1 address in a0
-0000200C 2F08 4807 MOVE.l a0,-(sp) * save variable 1 address
-0000200E 182B 05B5 4808 MOVE.b Dtypef(a3),d4 * copy variable 1 data type, $80=string,
-00002012 4809 * $40=inetger, $00=float
-00002012 4810
-00002012 6100 F58A 4811 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
-00002016 6100 F7A0 4812 BSR LAB_GVAR * get variable 2 address in a0
-0000201A 245F 4813 MOVEA.l (sp)+,a2 * restore variable 1 address
-0000201C B82B 05B5 4814 CMP.b Dtypef(a3),d4 * compare variable 1 data type with variable 2
-00002020 4815 * data type
-00002020 6600 E91C 4816 BNE LAB_TMER * if not both the same type do "Type mismatch"
-00002024 4817 * error then warm start
-00002024 4818
-00002024 4819 * if you do want a non existant variable to return an error then leave the novar
-00002024 4820 * value at the top of this file set to zero
-00002024 4821
-00002024 TRUE 4822 ifeq novar
-00002024 4823
-00002024 2010 4824 MOVE.l (a0),d0 * get variable 2
-00002026 20D2 4825 MOVE.l (a2),(a0)+ * copy variable 1 to variable 2
-00002028 24C0 4826 MOVE.l d0,(a2)+ * save variable 2 to variable 1
-0000202A 4827
-0000202A 4A04 4828 TST.b d4 * check data type
-0000202C 6AD8 4829 BPL.s RTS_015 * exit if not string
-0000202E 4830
-0000202E 3010 4831 MOVE.w (a0),d0 * get string 2 length
-00002030 3092 4832 MOVE.w (a2),(a0) * copy string 1 length to string 2 length
-00002032 3480 4833 MOVE.w d0,(a2) * save string 2 length to string 1 length
-00002034 4834
-00002034 4835 endc
-00002034 4836
-00002034 4837
-00002034 4838 * if you want a non existant variable to return a null value then set the novar
-00002034 4839 * value at the top of this file to some non zero value
-00002034 4840
-00002034 FALSE 4841 ifne novar
-00002034 4842 * value get
-00002034 4843 * value get and the new value save
-00002034 4844 * new length save
-00002034 4845 * new value save
-00002034 4846 endc
-00002034 4847
-00002034 4E75 4848 RTS
-00002036 4849
-00002036 4850
-00002036 4851 *************************************************************************************
-00002036 4852 *
-00002036 4853 * perform USR
-00002036 4854
-00002036 4855 LAB_USR
-00002036 4EAB 0406 4856 JSR Usrjmp(a3) * do user vector
-0000203A 6000 F55A 4857 BRA LAB_1BFB * scan for ")", else do syntax error/warm start
-0000203E 4858
-0000203E 4859
-0000203E 4860 *************************************************************************************
-0000203E 4861 *
-0000203E 4862 * perform LOAD
-0000203E 4863
-0000203E 4864 LAB_LOAD
-0000203E 4EEB 0418 4865 JMP V_LOAD(a3) * do load vector
-00002042 4866
-00002042 4867
-00002042 4868 *************************************************************************************
-00002042 4869 *
-00002042 4870 * perform SAVE
-00002042 4871
-00002042 4872 LAB_SAVE
-00002042 4EEB 041E 4873 JMP V_SAVE(a3) * do save vector
-00002046 4874
-00002046 4875
-00002046 4876 *************************************************************************************
-00002046 4877 *
-00002046 4878 * perform CALL
-00002046 4879
-00002046 4880 LAB_CALL
-00002046 487A F562 4881 PEA LAB_GBYT(pc) * put return address on stack
-0000204A 6100 FF50 4882 BSR LAB_GEAD * get even address for word/long memory actions
-0000204E 4883 * address returned in d0 and on the stack
-0000204E 4E75 4884 RTS * effectively calls the routine
-00002050 4885
-00002050 4886 * if the called routine exits correctly then it will return via the get byte routine.
-00002050 4887 * this will then get the next byte for the interpreter and return
-00002050 4888
-00002050 4889
-00002050 4890 *************************************************************************************
-00002050 4891 *
-00002050 4892 * perform WAIT
-00002050 4893
-00002050 4894 LAB_WAIT
-00002050 6100 FF16 4895 BSR LAB_GADB * get two parameters for POKE or WAIT
-00002054 4896 * first parameter in a0, second in d0
-00002054 2F08 4897 MOVE.l a0,-(sp) * save address
-00002056 3F00 4898 MOVE.w d0,-(sp) * save byte
-00002058 7400 4899 MOVEQ #0,d2 * clear mask
-0000205A 6100 F54E 4900 BSR LAB_GBYT * scan memory
-0000205E 6706 4901 BEQ.s LAB_2441 * skip if no third argument
-00002060 4902
-00002060 6100 F538 4903 BSR LAB_SCGB * scan for "," & get byte,
-00002064 4904 * else do syntax error/warm start
-00002064 2400 4905 MOVE.l d0,d2 * copy mask
-00002066 4906 LAB_2441
-00002066 321F 4907 MOVE.w (sp)+,d1 * get byte
-00002068 205F 4908 MOVEA.l (sp)+,a0 * get address
-0000206A 4909 LAB_2445
-0000206A 1010 4910 MOVE.b (a0),d0 * read memory byte
-0000206C B500 4911 EOR.b d2,d0 * EOR with second argument (mask)
-0000206E C001 4912 AND.b d1,d0 * AND with first argument (byte)
-00002070 67F8 4913 BEQ.s LAB_2445 * loop if result is zero
-00002072 4914
-00002072 4E75 4915 RTS
-00002074 4916
-00002074 4917
-00002074 4918 *************************************************************************************
-00002074 4919 *
-00002074 4920 * perform subtraction, FAC1 from FAC2
-00002074 4921
-00002074 4922 LAB_SUBTRACT
-00002074 0A2B 0080 0595 4923 EORI.b #$80,FAC1_s(a3) * complement FAC1 sign
-0000207A 176B 059D 059E 4924 MOVE.b FAC2_s(a3),FAC_sc(a3) * copy FAC2 sign byte
-00002080 4925
-00002080 102B 0595 4926 MOVE.b FAC1_s(a3),d0 * get FAC1 sign byte
-00002084 B12B 059E 4927 EOR.b d0,FAC_sc(a3) * EOR with FAC2 sign
-00002088 4928
-00002088 4929
-00002088 4930 *************************************************************************************
-00002088 4931 *
-00002088 4932 * add FAC2 to FAC1
-00002088 4933
-00002088 4934 LAB_ADD
-00002088 102B 0594 4935 MOVE.b FAC1_e(a3),d0 * get exponent
-0000208C 6700 0338 4936 BEQ LAB_279B * FAC1 was zero so copy FAC2 to FAC1 & return
-00002090 4937
-00002090 4938 * FAC1 is non zero
-00002090 41EB 0598 4939 LEA FAC2_m(a3),a0 * set pointer1 to FAC2 mantissa
-00002094 102B 059C 4940 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
-00002098 6746 4941 BEQ.s RTS_016 * exit if zero
-0000209A 4942
-0000209A 902B 0594 4943 SUB.b FAC1_e(a3),d0 * subtract FAC1 exponent
-0000209E 6722 4944 BEQ.s LAB_24A8 * branch if = (go add mantissa)
-000020A0 4945
-000020A0 650A 4946 BCS.s LAB_249C * branch if FAC2 < FAC1
-000020A2 4947
-000020A2 4948 * FAC2 > FAC1
-000020A2 376B 059C 0594 4949 MOVE.w FAC2_e(a3),FAC1_e(a3) * copy sign and exponent of FAC2
-000020A8 4400 4950 NEG.b d0 * negate exponent difference (make diff -ve)
-000020AA 5148 4951 SUBQ.w #8,a0 * pointer1 to FAC1
-000020AC 4952
-000020AC 4953 LAB_249C
-000020AC 4400 4954 NEG.b d0 * negate exponent difference (make diff +ve)
-000020AE 2F01 4955 MOVE.l d1,-(sp) * save d1
-000020B0 B03C 0020 4956 CMP.b #32,d0 * compare exponent diff with 32
-000020B4 6D04 4957 BLT.s LAB_2467 * branch if range >= 32
-000020B6 4958
-000020B6 7200 4959 MOVEQ #0,d1 * clear d1
-000020B8 6004 4960 BRA.s LAB_2468 * go clear smaller mantissa
-000020BA 4961
-000020BA 4962 LAB_2467
-000020BA 2210 4963 MOVE.l (a0),d1 * get FACx mantissa
-000020BC E0A9 4964 LSR.l d0,d1 * shift d0 times right
-000020BE 4965 LAB_2468
-000020BE 2081 4966 MOVE.l d1,(a0) * save it back
-000020C0 221F 4967 MOVE.l (sp)+,d1 * restore d1
-000020C2 4968
-000020C2 4969 * exponents are equal now do mantissa add or
-000020C2 4970 * subtract
-000020C2 4971 LAB_24A8
-000020C2 4A2B 059E 4972 TST.b FAC_sc(a3) * test sign compare (FAC1 EOR FAC2)
-000020C6 6B1A 4973 BMI.s LAB_24F8 * if <> go do subtract
-000020C8 4974
-000020C8 202B 0598 4975 MOVE.l FAC2_m(a3),d0 * get FAC2 mantissa
-000020CC D0AB 0590 4976 ADD.l FAC1_m(a3),d0 * add FAC1 mantissa
-000020D0 640A 4977 BCC.s LAB_24F7 * save and exit if no carry (FAC1 is normal)
-000020D2 4978
-000020D2 E290 4979 ROXR.l #1,d0 * else shift carry back into mantissa
-000020D4 522B 0594 4980 ADDQ.b #1,FAC1_e(a3) * increment FAC1 exponent
-000020D8 6500 E880 4981 BCS LAB_OFER * if carry do overflow error & warm start
-000020DC 4982
-000020DC 4983 LAB_24F7
-000020DC 2740 0590 4984 MOVE.l d0,FAC1_m(a3) * save mantissa
-000020E0 4985 RTS_016
-000020E0 4E75 4986 RTS
-000020E2 4987 * signs are different
-000020E2 4988 LAB_24F8
-000020E2 43EB 0590 4989 LEA FAC1_m(a3),a1 * pointer 2 to FAC1
-000020E6 B3C8 4990 CMPA.l a0,a1 * compare pointers
-000020E8 6602 4991 BNE.s LAB_24B4 * branch if <>
-000020EA 4992
-000020EA 5049 4993 ADDQ.w #8,a1 * else pointer2 to FAC2
-000020EC 4994
-000020EC 4995 * take smaller from bigger (take sign of bigger)
-000020EC 4996 LAB_24B4
-000020EC 2011 4997 MOVE.l (a1),d0 * get larger mantissa
-000020EE 2210 4998 MOVE.l (a0),d1 * get smaller mantissa
-000020F0 2740 0590 4999 MOVE.l d0,FAC1_m(a3) * save larger mantissa
-000020F4 93AB 0590 5000 SUB.l d1,FAC1_m(a3) * subtract smaller
-000020F8 5001
-000020F8 5002
-000020F8 5003 *************************************************************************************
-000020F8 5004 *
-000020F8 5005 * do +/- (carry is sign) & normalise FAC1
-000020F8 5006
-000020F8 5007 LAB_24D0
-000020F8 640A 5008 BCC.s LAB_24D5 * branch if result is +ve
-000020FA 5009
-000020FA 5010 * erk! subtract is the wrong way round so
-000020FA 5011 * negate everything
-000020FA 0A2B 00FF 0595 5012 EORI.b #$FF,FAC1_s(a3) * complement FAC1 sign
-00002100 44AB 0590 5013 NEG.l FAC1_m(a3) * negate FAC1 mantissa
-00002104 5014
-00002104 5015
-00002104 5016 *************************************************************************************
-00002104 5017 *
-00002104 5018 * normalise FAC1
-00002104 5019
-00002104 5020 LAB_24D5
-00002104 202B 0590 5021 MOVE.l FAC1_m(a3),d0 * get mantissa
-00002108 6B2E 5022 BMI.s LAB_24DA * mantissa is normal so just exit
-0000210A 5023
-0000210A 6606 5024 BNE.s LAB_24D9 * mantissa is not zero so go normalise FAC1
-0000210C 5025
-0000210C 3740 0594 5026 MOVE.w d0,FAC1_e(a3) * else make FAC1 = +zero
-00002110 4E75 5027 RTS
-00002112 5028
-00002112 5029 LAB_24D9
-00002112 2F01 5030 MOVE.l d1,-(sp) * save d1
-00002114 2200 5031 MOVE.l d0,d1 * mantissa to d1
-00002116 7000 5032 MOVEQ #0,d0 * clear d0
-00002118 102B 0594 5033 MOVE.b FAC1_e(a3),d0 * get exponent byte
-0000211C 6714 5034 BEQ.s LAB_24D8 * if exponent is zero then clean up and exit
-0000211E 5035 LAB_24D6
-0000211E D281 5036 ADD.l d1,d1 * shift mantissa, ADD is quicker for a single
-00002120 5037 * shift
-00002120 5BC8 FFFC 5038 DBMI d0,LAB_24D6 * decrement exponent and loop if mantissa and
-00002124 5039 * exponent +ve
-00002124 5040
-00002124 4A40 5041 TST.w d0 * test exponent
-00002126 670A 5042 BEQ.s LAB_24D8 * if exponent is zero make FAC1 zero
-00002128 5043
-00002128 6A02 5044 BPL.s LAB_24D7 * if exponent is >zero go save FAC1
-0000212A 5045
-0000212A 7001 5046 MOVEQ #1,d0 * else set for zero after correction
-0000212C 5047 LAB_24D7
-0000212C 5300 5048 SUBQ.b #1,d0 * adjust exponent for loop
-0000212E 2741 0590 5049 MOVE.l d1,FAC1_m(a3) * save normalised mantissa
-00002132 5050 LAB_24D8
-00002132 221F 5051 MOVE.l (sp)+,d1 * restore d1
-00002134 1740 0594 5052 MOVE.b d0,FAC1_e(a3) * save corrected exponent
-00002138 5053 LAB_24DA
-00002138 4E75 5054 RTS
-0000213A 5055
-0000213A 5056
-0000213A 5057 *************************************************************************************
-0000213A 5058 *
-0000213A 5059 * perform LOG()
-0000213A 5060
-0000213A 5061 LAB_LOG
-0000213A 4A2B 0595 5062 TST.b FAC1_s(a3) * test sign
-0000213E 6B00 E81E 5063 BMI LAB_FCER * if -ve do function call error/warm start
-00002142 5064
-00002142 7E00 5065 MOVEQ #0,d7 * clear d7
-00002144 1747 059E 5066 MOVE.b d7,FAC_sc(a3) * clear sign compare
-00002148 1E2B 0594 5067 MOVE.b FAC1_e(a3),d7 * get exponent
-0000214C 6700 E810 5068 BEQ LAB_FCER * if 0 do function call error/warm start
-00002150 5069
-00002150 0487 00000081 5070 SUB.l #$81,d7 * normalise exponent
-00002156 177C 0081 0594 5071 MOVE.b #$81,FAC1_e(a3) * force a value between 1 and 2
-0000215C 2C2B 0590 5072 MOVE.l FAC1_m(a3),d6 * copy mantissa
-00002160 5073
-00002160 277C 80000000 0598 5074 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 1
-00002168 377C 8100 059C 5075 MOVE.w #$8100,FAC2_e(a3) * set exponent for 1
-0000216E 6100 FF18 5076 BSR LAB_ADD * find arg+1
-00002172 7000 5077 MOVEQ #0,d0 * setup for calc skip
-00002174 3740 059C 5078 MOVE.w d0,FAC2_e(a3) * set FAC1 for zero result
-00002178 DC86 5079 ADD.l d6,d6 * shift 1 bit out
-0000217A 2746 0598 5080 MOVE.l d6,FAC2_m(a3) * put back FAC2
-0000217E 6758 5081 BEQ.s LAB_LONN * if 0 skip calculation
-00002180 5082
-00002180 377C 8000 059C 5083 MOVE.w #$8000,FAC2_e(a3) * set exponent for .5
-00002186 6100 0130 5084 BSR LAB_DIVIDE * do (arg-1)/(arg+1)
-0000218A 4A2B 0594 5085 TST.b FAC1_e(a3) * test exponent
-0000218E 6748 5086 BEQ.s LAB_LONN * if 0 skip calculation
-00002190 5087
-00002190 122B 0594 5088 MOVE.b FAC1_e(a3),d1 * get exponent
-00002194 0401 0082 5089 SUB.b #$82,d1 * normalise and two integer bits
-00002198 4401 5090 NEG.b d1 * negate for shift
-0000219A 5091 ** CMP.b #$1F,d1 * will mantissa vanish?
-0000219A 5092 ** BGT.s LAB_dunno * if so do ???
-0000219A 5093
-0000219A 202B 0590 5094 MOVE.l FAC1_m(a3),d0 * get mantissa
-0000219E E2A8 5095 LSR.l d1,d0 * shift in two integer bits
-000021A0 5096
-000021A0 5097 * d0 = arg
-000021A0 5098 * d0 = x, d1 = y
-000021A0 5099 * d2 = x1, d3 = y1
-000021A0 5100 * d4 = shift count
-000021A0 5101 * d5 = loop count
-000021A0 5102 * d6 = z
-000021A0 5103 * a0 = table pointer
-000021A0 5104
-000021A0 7C00 5105 MOVEQ #0,d6 * z = 0
-000021A2 223C 40000000 5106 MOVE.l #1<<30,d1 * y = 1
-000021A8 41FA 13FE 5107 LEA TAB_HTHET(pc),a0 * get pointer to hyperbolic tangent table
-000021AC 7A1E 5108 MOVEQ #30,d5 * loop 31 times
-000021AE 7801 5109 MOVEQ #1,d4 * set shift count
-000021B0 6006 5110 BRA.s LAB_LOCC * entry point for loop
-000021B2 5111
-000021B2 5112 LAB_LAAD
-000021B2 E8A2 5113 ASR.l d4,d2 * x1 >> i
-000021B4 9282 5114 SUB.l d2,d1 * y = y - x1
-000021B6 DC90 5115 ADD.l (a0),d6 * z = z + tanh(i)
-000021B8 5116 LAB_LOCC
-000021B8 2400 5117 MOVE.l d0,d2 * x1 = x
-000021BA 2601 5118 MOVE.l d1,d3 * y1 = Y
-000021BC E8A3 5119 ASR.l d4,d3 * y1 >> i
-000021BE 6402 5120 BCC.s LAB_LOLP
-000021C0 5121
-000021C0 5283 5122 ADDQ.l #1,d3
-000021C2 5123 LAB_LOLP
-000021C2 9083 5124 SUB.l d3,d0 * x = x - y1
-000021C4 6AEC 5125 BPL.s LAB_LAAD * branch if > 0
-000021C6 5126
-000021C6 2002 5127 MOVE.l d2,d0 * get x back
-000021C8 5848 5128 ADDQ.w #4,a0 * next entry
-000021CA 5284 5129 ADDQ.l #1,d4 * next i
-000021CC E28B 5130 LSR.l #1,d3 * /2
-000021CE 6704 5131 BEQ.s LAB_LOCX * branch y1 = 0
-000021D0 5132
-000021D0 51CD FFF0 5133 DBF d5,LAB_LOLP * decrement and loop if not done
-000021D4 5134
-000021D4 5135 * now sort out the result
-000021D4 5136 LAB_LOCX
-000021D4 DC86 5137 ADD.l d6,d6 * *2
-000021D6 2006 5138 MOVE.l d6,d0 * setup for d7 = 0
-000021D8 5139 LAB_LONN
-000021D8 2800 5140 MOVE.l d0,d4 * save cordic result
-000021DA 7A00 5141 MOVEQ #0,d5 * set default exponent sign
-000021DC 4A87 5142 TST.l d7 * check original exponent sign
-000021DE 6716 5143 BEQ.s LAB_LOXO * branch if original was 0
-000021E0 5144
-000021E0 6A04 5145 BPL.s LAB_LOXP * branch if was +ve
-000021E2 5146
-000021E2 4487 5147 NEG.l d7 * make original exponent +ve
-000021E4 7A80 5148 MOVEQ #$80-$100,d5 * make sign -ve
-000021E6 5149 LAB_LOXP
-000021E6 1745 0595 5150 MOVE.b d5,FAC1_s(a3) * save original exponent sign
-000021EA 4847 5151 SWAP d7 * 16 bit shift
-000021EC E18F 5152 LSL.l #8,d7 * easy first part
-000021EE 7A88 5153 MOVEQ #$88-$100,d5 * start with byte
-000021F0 5154 LAB_LONE
-000021F0 5385 5155 SUBQ.l #1,d5 * decrement exponent
-000021F2 DE87 5156 ADD.l d7,d7 * shift mantissa
-000021F4 6AFA 5157 BPL.s LAB_LONE * loop if not normal
-000021F6 5158
-000021F6 5159 LAB_LOXO
-000021F6 2747 0590 5160 MOVE.l d7,FAC1_m(a3) * save original exponent as mantissa
-000021FA 1745 0594 5161 MOVE.b d5,FAC1_e(a3) * save exponent for this
-000021FE 277C B17217F8 0598 5162 MOVE.l #$B17217F8,FAC2_m(a3) * LOG(2) mantissa
-00002206 377C 8000 059C 5163 MOVE.w #$8000,FAC2_e(a3) * LOG(2) exponent & sign
-0000220C 176B 0595 059E 5164 MOVE.b FAC1_s(a3),FAC_sc(a3) * make sign compare = FAC1 sign
-00002212 6118 5165 BSR.s LAB_MULTIPLY * do multiply
-00002214 2744 0598 5166 MOVE.l d4,FAC2_m(a3) * save cordic result
-00002218 6710 5167 BEQ.s LAB_LOWZ * branch if zero
-0000221A 5168
-0000221A 377C 8200 059C 5169 MOVE.w #$8200,FAC2_e(a3) * set exponent & sign
-00002220 176B 0595 059E 5170 MOVE.b FAC1_s(a3),FAC_sc(a3) * clear sign compare
-00002226 6100 FE60 5171 BSR LAB_ADD * and add for final result
-0000222A 5172
-0000222A 5173 LAB_LOWZ
-0000222A 4E75 5174 RTS
-0000222C 5175
-0000222C 5176
-0000222C 5177 *************************************************************************************
-0000222C 5178 *
-0000222C 5179 * multiply FAC1 by FAC2
-0000222C 5180
-0000222C 5181 LAB_MULTIPLY
-0000222C 48E7 F800 5182 MOVEM.l d0-d4,-(sp) * save registers
-00002230 4A2B 0594 5183 TST.b FAC1_e(a3) * test FAC1 exponent
-00002234 6776 5184 BEQ.s LAB_MUUF * if exponent zero go make result zero
-00002236 5185
-00002236 102B 059C 5186 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
-0000223A 6770 5187 BEQ.s LAB_MUUF * if exponent zero go make result zero
-0000223C 5188
-0000223C 176B 059E 0595 5189 MOVE.b FAC_sc(a3),FAC1_s(a3) * sign compare becomes sign
-00002242 5190
-00002242 D02B 0594 5191 ADD.b FAC1_e(a3),d0 * multiply exponents by adding
-00002246 640A 5192 BCC.s LAB_MNOC * branch if no carry
-00002248 5193
-00002248 0400 0080 5194 SUB.b #$80,d0 * normalise result
-0000224C 6400 E70C 5195 BCC LAB_OFER * if no carry do overflow
-00002250 5196
-00002250 6006 5197 BRA.s LAB_MADD * branch
-00002252 5198
-00002252 5199 * no carry for exponent add
-00002252 5200 LAB_MNOC
-00002252 0400 0080 5201 SUB.b #$80,d0 * normalise result
-00002256 6554 5202 BCS.s LAB_MUUF * return zero if underflow
-00002258 5203
-00002258 5204 LAB_MADD
-00002258 1740 0594 5205 MOVE.b d0,FAC1_e(a3) * save exponent
-0000225C 5206
-0000225C 5207 * d1 (FAC1) x d2 (FAC2)
-0000225C 222B 0590 5208 MOVE.l FAC1_m(a3),d1 * get FAC1 mantissa
-00002260 242B 0598 5209 MOVE.l FAC2_m(a3),d2 * get FAC2 mantissa
-00002264 5210
-00002264 3801 5211 MOVE.w d1,d4 * copy low word FAC1
-00002266 2001 5212 MOVE.l d1,d0 * copy long word FAC1
-00002268 4840 5213 SWAP d0 * high word FAC1 to low word FAC1
-0000226A 3600 5214 MOVE.w d0,d3 * copy high word FAC1
-0000226C 5215
-0000226C C2C2 5216 MULU d2,d1 * low word FAC2 x low word FAC1
-0000226E C0C2 5217 MULU d2,d0 * low word FAC2 x high word FAC1
-00002270 4842 5218 SWAP d2 * high word FAC2 to low word FAC2
-00002272 C8C2 5219 MULU d2,d4 * high word FAC2 x low word FAC1
-00002274 C6C2 5220 MULU d2,d3 * high word FAC2 x high word FAC1
-00002276 5221
-00002276 5222 * done multiply, now add partial products
-00002276 5223
-00002276 5224 * d1 = aaaa ---- FAC2_L x FAC1_L
-00002276 5225 * d0 = bbbb aaaa FAC2_L x FAC1_H
-00002276 5226 * d4 = bbbb aaaa FAC2_H x FAC1_L
-00002276 5227 * d3 = cccc bbbb FAC2_H x FAC1_H
-00002276 5228 * product = mmmm mmmm
-00002276 5229
-00002276 0681 00008000 5230 ADD.L #$8000,d1 * round up lowest word
-0000227C 4241 5231 CLR.w d1 * clear low word, don't need it
-0000227E 4841 5232 SWAP d1 * align high word
-00002280 D280 5233 ADD.l d0,d1 * add FAC2_L x FAC1_H (can't be carry)
-00002282 5234 LAB_MUF1
-00002282 D284 5235 ADD.l d4,d1 * now add intermediate (FAC2_H x FAC1_L)
-00002284 6406 5236 BCC.s LAB_MUF2 * branch if no carry
-00002286 5237
-00002286 0683 00010000 5238 ADD.l #$10000,d3 * else correct result
-0000228C 5239 LAB_MUF2
-0000228C 0681 00008000 5240 ADD.l #$8000,d1 * round up low word
-00002292 4241 5241 CLR.w d1 * clear low word
-00002294 4841 5242 SWAP d1 * align for final add
-00002296 D283 5243 ADD.l d3,d1 * add FAC2_H x FAC1_H, result
-00002298 6B08 5244 BMI.s LAB_MUF3 * branch if normalisation not needed
-0000229A 5245
-0000229A D281 5246 ADD.l d1,d1 * shift mantissa
-0000229C 532B 0594 5247 SUBQ.b #1,FAC1_e(a3) * adjust exponent
-000022A0 670A 5248 BEQ.s LAB_MUUF * branch if underflow
-000022A2 5249
-000022A2 5250 LAB_MUF3
-000022A2 2741 0590 5251 MOVE.l d1,FAC1_m(a3) * save mantissa
-000022A6 5252 LAB_MUEX
-000022A6 4CDF 001F 5253 MOVEM.l (sp)+,d0-d4 * restore registers
-000022AA 4E75 5254 RTS
-000022AC 5255 * either zero or underflow result
-000022AC 5256 LAB_MUUF
-000022AC 7000 5257 MOVEQ #0,d0 * quick clear
-000022AE 2740 0590 5258 MOVE.l d0,FAC1_m(a3) * clear mantissa
-000022B2 3740 0594 5259 MOVE.w d0,FAC1_e(a3) * clear sign and exponent
-000022B6 60EE 5260 BRA.s LAB_MUEX * restore regs & exit
-000022B8 5261
-000022B8 5262
-000022B8 5263 *************************************************************************************
-000022B8 5264 *
-000022B8 5265 * do FAC2/FAC1, result in FAC1
-000022B8 5266 * fast hardware divide version
-000022B8 5267
-000022B8 5268 LAB_DIVIDE
-000022B8 2F07 5269 MOVE.l d7,-(sp) * save d7
-000022BA 7000 5270 MOVEQ #0,d0 * clear FAC2 exponent
-000022BC 2400 5271 MOVE.l d0,d2 * clear FAC1 exponent
-000022BE 5272
-000022BE 142B 0594 5273 MOVE.b FAC1_e(a3),d2 * get FAC1 exponent
-000022C2 6700 E682 5274 BEQ LAB_DZER * if zero go do /0 error
-000022C6 5275
-000022C6 102B 059C 5276 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
-000022CA 6766 5277 BEQ.s LAB_DIV0 * if zero return zero
-000022CC 5278
-000022CC 9042 5279 SUB.w d2,d0 * get result exponent by subtracting
-000022CE 0640 0080 5280 ADD.w #$80,d0 * correct 16 bit exponent result
-000022D2 5281
-000022D2 176B 059E 0595 5282 MOVE.b FAC_sc(a3),FAC1_s(a3) * sign compare is result sign
-000022D8 5283
-000022D8 5284 * now to do 32/32 bit mantissa divide
-000022D8 5285
-000022D8 422B 059F 5286 CLR.b flag(a3) * clear 'flag' byte
-000022DC 262B 0590 5287 MOVE.l FAC1_m(a3),d3 * get FAC1 mantissa
-000022E0 282B 0598 5288 MOVE.l FAC2_m(a3),d4 * get FAC2 mantissa
-000022E4 B883 5289 CMP.l d3,d4 * compare FAC2 with FAC1 mantissa
-000022E6 6744 5290 BEQ.s LAB_MAN1 * set mantissa result = 1 if equal
-000022E8 5291
-000022E8 6506 5292 BCS.s AC1gtAC2 * branch if FAC1 > FAC2
-000022EA 5293
-000022EA 9883 5294 SUB.l d3,d4 * subtract FAC1 from FAC2, result now must be <1
-000022EC 562B 059F 5295 ADDQ.b #3,flag(a3) * FAC2>FAC1 so set 'flag' byte
-000022F0 5296 AC1gtAC2
-000022F0 6146 5297 BSR.s LAB_32_16 * do 32/16 divide
-000022F2 4841 5298 SWAP d1 * move 16 bit result to high word
-000022F4 2802 5299 MOVE.l d2,d4 * copy remainder longword
-000022F6 6142 5300 BSR.s LAB_3216 * do 32/16 divide again (skip copy d4 to d2)
-000022F8 84C5 5301 DIVU.w d5,d2 * now divide remainder to make guard word
-000022FA 1E2B 059F 5302 MOVE.b flag(a3),d7 * now normalise, get flag byte back
-000022FE 6708 5303 BEQ.s LAB_DIVX * skip add if null
-00002300 5304
-00002300 5305 * else result was >1 so we need to add 1 to result mantissa and adjust exponent
-00002300 5306
-00002300 E20F 5307 LSR.b #1,d7 * shift 1 into eXtend
-00002302 E291 5308 ROXR.l #1,d1 * shift extend result >>
-00002304 E252 5309 ROXR.w #1,d2 * shift extend guard word >>
-00002306 5200 5310 ADDQ.b #1,d0 * adjust exponent
-00002308 5311
-00002308 5312 * now round result to 32 bits
-00002308 5313
-00002308 5314 LAB_DIVX
-00002308 D442 5315 ADD.w d2,d2 * guard bit into eXtend bit
-0000230A 6408 5316 BCC.s L_DIVRND * branch if guard=0
-0000230C 5317
-0000230C 5281 5318 ADDQ.l #1,d1 * add guard to mantissa
-0000230E 6404 5319 BCC.s L_DIVRND * branch if no overflow
-00002310 5320
-00002310 5321 LAB_SET1
-00002310 E291 5322 ROXR.l #1,d1 * shift extend result >>
-00002312 5240 5323 ADDQ.w #1,d0 * adjust exponent
-00002314 5324
-00002314 5325 * test for over/under flow
-00002314 5326 L_DIVRND
-00002314 3600 5327 MOVE.w d0,d3 * copy exponent
-00002316 6B1A 5328 BMI.s LAB_DIV0 * if -ve return zero
-00002318 5329
-00002318 0243 FF00 5330 ANDI.w #$FF00,d3 * mask word high byte
-0000231C 6600 E63C 5331 BNE LAB_OFER * branch if overflow
-00002320 5332
-00002320 5333 * move result into FAC1
-00002320 5334 LAB_XDIV
-00002320 2E1F 5335 MOVE.l (sp)+,d7 * restore d7
-00002322 1740 0594 5336 MOVE.b d0,FAC1_e(a3) * save result exponent
-00002326 2741 0590 5337 MOVE.l d1,FAC1_m(a3) * save result mantissa
-0000232A 4E75 5338 RTS
-0000232C 5339
-0000232C 5340 * FAC1 mantissa = FAC2 mantissa so set result mantissa
-0000232C 5341
-0000232C 5342 LAB_MAN1
-0000232C 7201 5343 MOVEQ #1,d1 * set bit
-0000232E E2A9 5344 LSR.l d1,d1 * bit into eXtend
-00002330 60DE 5345 BRA.s LAB_SET1 * set mantissa, adjust exponent and exit
-00002332 5346
-00002332 5347 * result is zero
-00002332 5348
-00002332 5349 LAB_DIV0
-00002332 7000 5350 MOVEQ #0,d0 * zero exponent & sign
-00002334 2200 5351 MOVE.l d0,d1 * zero mantissa
-00002336 60E8 5352 BRA LAB_XDIV * exit divide
-00002338 5353
-00002338 5354 * divide 16 bits into 32, AB/Ex
-00002338 5355 *
-00002338 5356 * d4 AAAA BBBB * 32 bit numerator
-00002338 5357 * d3 EEEE xxxx * 16 bit denominator
-00002338 5358 *
-00002338 5359 * returns -
-00002338 5360 *
-00002338 5361 * d1 xxxx DDDD * 16 bit result
-00002338 5362 * d2 HHHH IIII * 32 bit remainder
-00002338 5363
-00002338 5364 LAB_32_16
-00002338 2404 5365 MOVE.l d4,d2 * copy FAC2 mantissa (AB)
-0000233A 5366 LAB_3216
-0000233A 2A03 5367 MOVE.l d3,d5 * copy FAC1 mantissa (EF)
-0000233C 4245 5368 CLR.w d5 * clear low word d1 (Ex)
-0000233E 4845 5369 SWAP d5 * swap high word to low word (xE)
-00002340 5370
-00002340 5371 * d3 EEEE FFFF * denominator copy
-00002340 5372 * d5 0000 EEEE * denominator high word
-00002340 5373 * d2 AAAA BBBB * numerator copy
-00002340 5374 * d4 AAAA BBBB * numerator
-00002340 5375
-00002340 88C5 5376 DIVU.w d5,d4 * do FAC2/FAC1 high word (AB/E)
-00002342 6802 5377 BVC.s LAB_LT_1 * if no overflow DIV was ok
-00002344 5378
-00002344 78FF 5379 MOVEQ #-1,d4 * else set default value
-00002346 5380
-00002346 5381 * done the divide, now check the result, we have ...
-00002346 5382
-00002346 5383 * d3 EEEE FFFF * denominator copy
-00002346 5384 * d5 0000 EEEE * denominator high word
-00002346 5385 * d2 AAAA BBBB * numerator copy
-00002346 5386 * d4 MMMM DDDD * result MOD and DIV
-00002346 5387
-00002346 5388 LAB_LT_1
-00002346 3C04 5389 MOVE.w d4,d6 * copy 16 bit result
-00002348 3204 5390 MOVE.w d4,d1 * copy 16 bit result again
-0000234A 5391
-0000234A 5392 * we now have ..
-0000234A 5393 * d3 EEEE FFFF * denominator copy
-0000234A 5394 * d5 0000 EEEE * denominator high word
-0000234A 5395 * d6 xxxx DDDD * result DIV copy
-0000234A 5396 * d1 xxxx DDDD * result DIV copy
-0000234A 5397 * d2 AAAA BBBB * numerator copy
-0000234A 5398 * d4 MMMM DDDD * result MOD and DIV
-0000234A 5399
-0000234A 5400 * now multiply out 32 bit denominator by 16 bit result
-0000234A 5401 * QRS = AB*D
-0000234A 5402
-0000234A CCC3 5403 MULU.w d3,d6 * FFFF * DDDD = rrrr SSSS
-0000234C C8C5 5404 MULU.w d5,d4 * EEEE * DDDD = QQQQ rrrr
-0000234E 5405
-0000234E 5406 * we now have ..
-0000234E 5407 * d3 EEEE FFFF * denominator copy
-0000234E 5408 * d5 0000 EEEE * denominator high word
-0000234E 5409 * d6 rrrr SSSS * 48 bit result partial low
-0000234E 5410 * d1 xxxx DDDD * result DIV copy
-0000234E 5411 * d2 AAAA BBBB * numerator copy
-0000234E 5412 * d4 QQQQ rrrr * 48 bit result partial
-0000234E 5413
-0000234E 3E06 5414 MOVE.w d6,d7 * copy low word of low multiply
-00002350 5415
-00002350 5416 * d7 xxxx SSSS * 48 bit result partial low
-00002350 5417
-00002350 4246 5418 CLR.w d6 * clear low word of low multiply
-00002352 4846 5419 SWAP d6 * high word of low multiply to low word
-00002354 5420
-00002354 5421 * d6 0000 rrrr * high word of 48 bit result partial low
-00002354 5422
-00002354 D886 5423 ADD.l d6,d4
-00002356 5424
-00002356 5425 * d4 QQQQ RRRR * 48 bit result partial high longword
-00002356 5426
-00002356 7C00 5427 MOVEQ #0,d6 * clear to extend numerator to 48 bits
-00002358 5428
-00002358 5429 * now do GHI = AB0 - QRS (which is the remainder)
-00002358 5430
-00002358 9C47 5431 SUB.w d7,d6 * low word subtract
-0000235A 5432
-0000235A 5433 * d6 xxxx IIII * remainder low word
-0000235A 5434
-0000235A 9584 5435 SUBX.l d4,d2 * high longword subtract
-0000235C 5436
-0000235C 5437 * d2 GGGG HHHH * remainder high longword
-0000235C 5438
-0000235C 5439 * now if we got the divide correct then the remainder high longword will be +ve
-0000235C 5440
-0000235C 6A08 5441 BPL.s L_DDIV * branch if result is ok ( FAC2
-00002432 5637 * returns d0= 0 Cb=0 if FAC1 = FAC2
-00002432 5638 * returns d0=-1 Cb=1 if FAC1 < FAC2
-00002432 5639
-00002432 5640 LAB_27FA
-00002432 122B 059C 5641 MOVE.b FAC2_e(a3),d1 * get FAC2 exponent
-00002436 67C8 5642 BEQ.s LAB_27CA * branch if FAC2 exponent=0 & get FAC1 sign
-00002438 5643 * d0=-1,C=1/-ve d0=+1,C=0/+ve
-00002438 5644
-00002438 102B 059E 5645 MOVE.b FAC_sc(a3),d0 * get FAC sign compare
-0000243C 6BCA 5646 BMI.s LAB_27CE * if signs <> do return d0=-1,C=1/-ve
-0000243E 5647 * d0=+1,C=0/+ve & return
-0000243E 5648
-0000243E 102B 0595 5649 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
-00002442 B22B 0594 5650 CMP.b FAC1_e(a3),d1 * compare FAC1 exponent with FAC2 exponent
-00002446 660A 5651 BNE.s LAB_2828 * branch if different
-00002448 5652
-00002448 222B 0598 5653 MOVE.l FAC2_m(a3),d1 * get FAC2 mantissa
-0000244C B2AB 0590 5654 CMP.l FAC1_m(a3),d1 * compare mantissas
-00002450 6708 5655 BEQ.s LAB_282F * exit if mantissas equal
-00002452 5656
-00002452 5657 * gets here if number <> FAC1
-00002452 5658
-00002452 5659 LAB_2828
-00002452 65B8 5660 BCS.s LAB_27D0 * if FAC1 > FAC2 return d0=-1,C=1/-ve d0=+1,
-00002454 5661 * C=0/+ve
-00002454 5662
-00002454 0A00 0080 5663 EORI.b #$80,d0 * else toggle FAC1 sign
-00002458 5664 LAB_282E
-00002458 60B2 5665 BRA.s LAB_27D0 * return d0=-1,C=1/-ve d0=+1,C=0/+ve
-0000245A 5666
-0000245A 5667 LAB_282F
-0000245A 7000 5668 MOVEQ #0,d0 * clear result
-0000245C 4E75 5669 RTS
-0000245E 5670
-0000245E 5671
-0000245E 5672 *************************************************************************************
-0000245E 5673 *
-0000245E 5674 * convert FAC1 floating to fixed
-0000245E 5675 * result in d0 and Itemp, sets flags correctly
-0000245E 5676
-0000245E 5677 LAB_2831
-0000245E 202B 0590 5678 MOVE.l FAC1_m(a3),d0 * copy mantissa
-00002462 6730 5679 BEQ.s LAB_284J * branch if mantissa = 0
-00002464 5680
-00002464 2F01 5681 MOVE.l d1,-(sp) * save d1
-00002466 72A0 5682 MOVEQ #$A0,d1 * set for no floating bits
-00002468 922B 0594 5683 SUB.b FAC1_e(a3),d1 * subtract FAC1 exponent
-0000246C 6500 E4EC 5684 BCS LAB_OFER * do overflow if too big
-00002470 5685
-00002470 660E 5686 BNE.s LAB_284G * branch if exponent was not $A0
-00002472 5687
-00002472 4A2B 0595 5688 TST.b FAC1_s(a3) * test FAC1 sign
-00002476 6A1A 5689 BPL.s LAB_284H * branch if FAC1 +ve
-00002478 5690
-00002478 4480 5691 NEG.l d0
-0000247A 6916 5692 BVS.s LAB_284H * branch if was $80000000
-0000247C 5693
-0000247C 6000 E4DC 5694 BRA LAB_OFER * do overflow if too big
-00002480 5695
-00002480 5696 LAB_284G
-00002480 B23C 0020 5697 CMP.b #$20,d1 * compare with minimum result for integer
-00002484 6502 5698 BCS.s LAB_284L * if < minimum just do shift
-00002486 5699
-00002486 7000 5700 MOVEQ #0,d0 * else return zero
-00002488 5701 LAB_284L
-00002488 E2A8 5702 LSR.l d1,d0 * shift integer
-0000248A 5703
-0000248A 4A2B 0595 5704 TST.b FAC1_s(a3) * test FAC1 sign (b7)
-0000248E 6A02 5705 BPL.s LAB_284H * branch if FAC1 +ve
-00002490 5706
-00002490 4480 5707 NEG.l d0 * negate integer value
-00002492 5708 LAB_284H
-00002492 221F 5709 MOVE.l (sp)+,d1 * restore d1
-00002494 5710 LAB_284J
-00002494 2740 042A 5711 MOVE.l d0,Itemp(a3) * save result to Itemp
-00002498 4E75 5712 RTS
-0000249A 5713
-0000249A 5714
-0000249A 5715 *************************************************************************************
-0000249A 5716 *
-0000249A 5717 * perform INT()
-0000249A 5718
-0000249A 5719 LAB_INT
-0000249A 70A0 5720 MOVEQ #$A0,d0 * set for no floating bits
-0000249C 902B 0594 5721 SUB.b FAC1_e(a3),d0 * subtract FAC1 exponent
-000024A0 6310 5722 BLS.s LAB_IRTS * exit if exponent >= $A0
-000024A2 5723 * (too big for fraction part!)
-000024A2 5724
-000024A2 B03C 0020 5725 CMP.b #$20,d0 * compare with minimum result for integer
-000024A6 6400 025E 5726 BCC LAB_POZE * if >= minimum go return 0
-000024AA 5727 * (too small for integer part!)
-000024AA 5728
-000024AA 72FF 5729 MOVEQ #-1,d1 * set integer mask
-000024AC E1A1 5730 ASL.l d0,d1 * shift mask [8+2*d0]
-000024AE C3AB 0590 5731 AND.l d1,FAC1_m(a3) * mask mantissa
-000024B2 5732 LAB_IRTS
-000024B2 4E75 5733 RTS
-000024B4 5734
-000024B4 5735
-000024B4 5736 *************************************************************************************
-000024B4 5737 *
-000024B4 5738 * print " in line [LINE #]"
-000024B4 5739
-000024B4 5740 LAB_2953
-000024B4 41FA 17FA 5741 LEA LAB_LMSG(pc),a0 * point to " in line " message
-000024B8 6100 ED24 5742 BSR LAB_18C3 * print null terminated string
-000024BC 5743
-000024BC 5744 * Print Basic line #
-000024BC 202B 0452 5745 MOVE.l Clinel(a3),d0 * get current line
-000024C0 5746
-000024C0 5747
-000024C0 5748 *************************************************************************************
-000024C0 5749 *
-000024C0 5750 * print d0 as unsigned integer
-000024C0 5751
-000024C0 5752 LAB_295E
-000024C0 43FA 0DE8 5753 LEA Bin2dec(pc),a1 * get table address
-000024C4 7200 5754 MOVEQ #0,d1 * table index
-000024C6 41EB 05CC 5755 LEA Usdss(a3),a0 * output string start
-000024CA 2401 5756 MOVE.l d1,d2 * output string index
-000024CC 5757 LAB_2967
-000024CC 2631 1000 5758 MOVE.l (a1,d1.w),d3 * get table value
-000024D0 6714 5759 BEQ.s LAB_2969 * exit if end marker
-000024D2 5760
-000024D2 782F 5761 MOVEQ #'0'-1,d4 * set character to "0"-1
-000024D4 5762 LAB_2968
-000024D4 5244 5763 ADDQ.w #1,d4 * next numeric character
-000024D6 9083 5764 SUB.l d3,d0 * subtract table value
-000024D8 6AFA 5765 BPL.s LAB_2968 * not overdone so loop
-000024DA 5766
-000024DA D083 5767 ADD.l d3,d0 * correct value
-000024DC 1184 2000 5768 MOVE.b d4,(a0,d2.w) * character out to string
-000024E0 5841 5769 ADDQ.w #4,d1 * increment table pointer
-000024E2 5242 5770 ADDQ.w #1,d2 * increment output string pointer
-000024E4 60E6 5771 BRA.s LAB_2967 * loop
-000024E6 5772
-000024E6 5773 LAB_2969
-000024E6 0600 0030 5774 ADD.b #'0',d0 * make last character
-000024EA 1180 2000 5775 MOVE.b d0,(a0,d2.w) * character out to string
-000024EE 5348 5776 SUBQ.w #1,a0 * decrement a0 (allow simple loop)
-000024F0 5777
-000024F0 5778 * now find non zero start of string
-000024F0 5779 LAB_296A
-000024F0 5248 5780 ADDQ.w #1,a0 * increment a0 (this will never carry to b16)
-000024F2 43EB 05D5 5781 LEA BHsend-1(a3),a1 * get string end
-000024F6 B1C9 5782 CMPA.l a1,a0 * are we at end
-000024F8 6700 ECE4 5783 BEQ LAB_18C3 * if so print null terminated string and RETURN
-000024FC 5784
-000024FC 0C10 0030 5785 CMPI.b #'0',(a0) * is character "0" ?
-00002500 67EE 5786 BEQ.s LAB_296A * loop if so
-00002502 5787
-00002502 6000 ECDA 5788 BRA LAB_18C3 * print null terminated string from memory & RET
-00002506 5789
-00002506 5790
-00002506 5791 *************************************************************************************
-00002506 5792 *
-00002506 5793 * convert FAC1 to ASCII string result in (a0)
-00002506 5794 * STR$() function enters here
-00002506 5795
-00002506 5796 * now outputs 7 significant digits
-00002506 5797
-00002506 5798 * d0 is character out
-00002506 5799 * d1 is save index
-00002506 5800 * d2 is gash
-00002506 5801
-00002506 5802 * a0 is output string pointer
-00002506 5803
-00002506 5804 LAB_2970
-00002506 43EB 05C6 5805 LEA Decss(a3),a1 * set output string start
-0000250A 5806
-0000250A 7420 5807 MOVEQ #' ',d2 * character = " ", assume +ve
-0000250C 08AB 0007 0595 5808 BCLR.b #7,FAC1_s(a3) * test and clear FAC1 sign (b7)
-00002512 6702 5809 BEQ.s LAB_2978 * branch if +ve
-00002514 5810
-00002514 742D 5811 MOVEQ #'-',d2 * else character = "-"
-00002516 5812 LAB_2978
-00002516 1282 5813 MOVE.b d2,(a1) * save the sign character
-00002518 142B 0594 5814 MOVE.b FAC1_e(a3),d2 * get FAC1 exponent
-0000251C 6608 5815 BNE.s LAB_2989 * branch if FAC1<>0
-0000251E 5816
-0000251E 5817 * exponent was $00 so FAC1 is 0
-0000251E 7030 5818 MOVEQ #'0',d0 * set character = "0"
-00002520 7201 5819 MOVEQ #1,d1 * set output string index
-00002522 6000 01A4 5820 BRA LAB_2A89 * save last character, [EOT] & exit
-00002526 5821
-00002526 5822 * FAC1 is some non zero value
-00002526 5823 LAB_2989
-00002526 177C 0000 05AC 5824 MOVE.b #0,numexp(a3) * clear number exponent count
-0000252C B43C 0081 5825 CMP.b #$81,d2 * compare FAC1 exponent with $81 (>1.00000)
-00002530 5826
-00002530 6448 5827 BCC.s LAB_299C * branch if FAC1=>1
-00002532 5828
-00002532 5829 * else FAC1 < 1
-00002532 277C 98968000 0598 5830 MOVE.l #$98968000,FAC2_m(a3) * 10000000 mantissa
-0000253A 377C 9800 059C 5831 MOVE.w #$9800,FAC2_e(a3) * 10000000 exponent & sign
-00002540 176B 0595 059E 5832 MOVE.b FAC1_s(a3),FAC_sc(a3) * make FAC1 sign sign compare
-00002546 6100 FCE4 5833 BSR LAB_MULTIPLY * do FAC2*FAC1
-0000254A 5834
-0000254A 177C 00F9 05AC 5835 MOVE.b #$F9,numexp(a3) * set number exponent count (-7)
-00002550 6028 5836 BRA.s LAB_299C * go test for fit
-00002552 5837
-00002552 5838 LAB_29B9
-00002552 376B 0594 059C 5839 MOVE.w FAC1_e(a3),FAC2_e(a3) * copy exponent & sign from FAC1 to FAC2
-00002558 276B 0590 0598 5840 MOVE.l FAC1_m(a3),FAC2_m(a3) * copy FAC1 mantissa to FAC2 mantissa
-0000255E 176B 0595 059E 5841 MOVE.b FAC1_s(a3),FAC_sc(a3) * save FAC1_s as sign compare
-00002564 5842
-00002564 277C CCCCCCCD 0590 5843 MOVE.l #$CCCCCCCD,FAC1_m(a3) * 1/10 mantissa
-0000256C 377C 7D00 0594 5844 MOVE.w #$7D00,FAC1_e(a3) * 1/10 exponent & sign
-00002572 6100 FCB8 5845 BSR LAB_MULTIPLY * do FAC2*FAC1, effectively divide by 10 but
-00002576 5846 * faster
-00002576 5847
-00002576 522B 05AC 5848 ADDQ.b #1,numexp(a3) * increment number exponent count
-0000257A 5849 LAB_299C
-0000257A 277C 98967F70 0598 5850 MOVE.l #$98967F70,FAC2_m(a3) * 9999999.4375 mantissa
-00002582 377C 9800 059C 5851 MOVE.w #$9800,FAC2_e(a3) * 9999999.4375 exponent & sign
-00002588 5852 * (max before scientific notation)
-00002588 6100 014C 5853 BSR LAB_27F0 * fast compare FAC1 with FAC2
-0000258C 5854 * returns d0=+1 C=0 if FAC1 > FAC2
-0000258C 5855 * returns d0= 0 C=0 if FAC1 = FAC2
-0000258C 5856 * returns d0=-1 C=1 if FAC1 < FAC2
-0000258C 62C4 5857 BHI.s LAB_29B9 * go do /10 if FAC1 > 9999999.4375
-0000258E 5858
-0000258E 6750 5859 BEQ.s LAB_29C3 * branch if FAC1 = 9999999.4375
-00002590 5860
-00002590 5861 * FAC1 < 9999999.4375
-00002590 277C F423F800 0598 5862 MOVE.l #$F423F800,FAC2_m(a3) * set mantissa for 999999.5
-00002598 377C 9400 059C 5863 MOVE.w #$9400,FAC2_e(a3) * set exponent for 999999.5
-0000259E 5864
-0000259E 41EB 0590 5865 LEA FAC1_m(a3),a0 * set pointer for x10
-000025A2 5866 LAB_29A7
-000025A2 6100 0132 5867 BSR LAB_27F0 * fast compare FAC1 with FAC2
-000025A6 5868 * returns d0=+1 C=0 if FAC1 > FAC2
-000025A6 5869 * returns d0= 0 C=0 if FAC1 = FAC2
-000025A6 5870 * returns d0=-1 C=1 if FAC1 < FAC2
-000025A6 6220 5871 BHI.s LAB_29C0 * branch if FAC1 > 99999.9375,no decimal places
-000025A8 5872
-000025A8 5873 * FAC1 <= 999999.5 so do x 10
-000025A8 2010 5874 MOVE.l (a0),d0 * get FAC1 mantissa
-000025AA 1228 0004 5875 MOVE.b 4(a0),d1 * get FAC1 exponent
-000025AE 2400 5876 MOVE.l d0,d2 * copy it
-000025B0 E488 5877 LSR.l #2,d0 * /4
-000025B2 D082 5878 ADD.l d2,d0 * add FAC1 (x1.125)
-000025B4 6404 5879 BCC.s LAB_29B7 * branch if no carry
-000025B6 5880
-000025B6 E290 5881 ROXR.l #1,d0 * shift carry back in
-000025B8 5201 5882 ADDQ.b #1,d1 * increment exponent (never overflows)
-000025BA 5883 LAB_29B7
-000025BA 5601 5884 ADDQ.b #3,d1 * correct exponent ( 8 x 1.125 = 10 )
-000025BC 5885 * (never overflows)
-000025BC 2080 5886 MOVE.l d0,(a0) * save new mantissa
-000025BE 1141 0004 5887 MOVE.b d1,4(a0) * save new exponent
-000025C2 532B 05AC 5888 SUBQ.b #1,numexp(a3) * decrement number exponent count
-000025C6 60DA 5889 BRA.s LAB_29A7 * go test again
-000025C8 5890
-000025C8 5891 * now we have just the digits to do
-000025C8 5892 LAB_29C0
-000025C8 277C 80000000 0598 5893 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 0.5
-000025D0 377C 8000 059C 5894 MOVE.w #$8000,FAC2_e(a3) * set exponent for 0.5
-000025D6 176B 0595 059E 5895 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign compare = sign
-000025DC 6100 FAAA 5896 BSR LAB_ADD * add the 0.5 to FAC1 (round FAC1)
-000025E0 5897
-000025E0 5898 LAB_29C3
-000025E0 6100 FE7C 5899 BSR LAB_2831 * convert FAC1 floating to fixed
-000025E4 5900 * result in d0 and Itemp
-000025E4 7401 5901 MOVEQ #$01,d2 * set default digits before dp = 1
-000025E6 102B 05AC 5902 MOVE.b numexp(a3),d0 * get number exponent count
-000025EA 5000 5903 ADD.b #8,d0 * allow 7 digits before point
-000025EC 6B0C 5904 BMI.s LAB_29D9 * if -ve then 1 digit before dp
-000025EE 5905
-000025EE B03C 0009 5906 CMP.b #$09,d0 * d0>=9 if n>=1E7
-000025F2 6406 5907 BCC.s LAB_29D9 * branch if >= $09
-000025F4 5908
-000025F4 5909 * < $08
-000025F4 5300 5910 SUBQ.b #1,d0 * take 1 from digit count
-000025F6 1400 5911 MOVE.b d0,d2 * copy byte
-000025F8 7002 5912 MOVEQ #$02,d0 * set exponent adjust
-000025FA 5913 LAB_29D9
-000025FA 7200 5914 MOVEQ #0,d1 * set output string index
-000025FC 5500 5915 SUBQ.b #2,d0 * -2
-000025FE 1740 05AD 5916 MOVE.b d0,expcnt(a3) * save exponent adjust
-00002602 1742 05AC 5917 MOVE.b d2,numexp(a3) * save digits before dp count
-00002606 1002 5918 MOVE.b d2,d0 * copy digits before dp count
-00002608 6702 5919 BEQ.s LAB_29E4 * branch if no digits before dp
-0000260A 5920
-0000260A 6A14 5921 BPL.s LAB_29F7 * branch if digits before dp
-0000260C 5922
-0000260C 5923 LAB_29E4
-0000260C 5281 5924 ADDQ.l #1,d1 * increment index
-0000260E 13BC 002E 1000 5925 MOVE.b #'.',(a1,d1.w) * save to output string
-00002614 5926
-00002614 4A02 5927 TST.b d2 * test digits before dp count
-00002616 6708 5928 BEQ.s LAB_29F7 * branch if no digits before dp
-00002618 5929
-00002618 5281 5930 ADDQ.l #1,d1 * increment index
-0000261A 13BC 0030 1000 5931 MOVE.b #'0',(a1,d1.w) * save to output string
-00002620 5932 LAB_29F7
-00002620 7400 5933 MOVEQ #0,d2 * clear index (point to 1,000,000)
-00002622 7080 5934 MOVEQ #$80-$100,d0 * set output character
-00002624 5935 LAB_29FB
-00002624 41FA 111E 5936 LEA LAB_2A9A(pc),a0 * get base of table
-00002628 2630 2000 5937 MOVE.l (a0,d2.w),d3 * get table value
-0000262C 5938 LAB_29FD
-0000262C 5200 5939 ADDQ.b #1,d0 * increment output character
-0000262E D7AB 042A 5940 ADD.l d3,Itemp(a3) * add to (now fixed) mantissa
-00002632 0800 0007 5941 BTST #7,d0 * set test sense (z flag only)
-00002636 6504 5942 BCS.s LAB_2A18 * did carry so has wrapped past zero
-00002638 5943
-00002638 67F2 5944 BEQ.s LAB_29FD * no wrap and +ve test so try again
-0000263A 5945
-0000263A 6002 5946 BRA.s LAB_2A1A * found this digit
-0000263C 5947
-0000263C 5948 LAB_2A18
-0000263C 66EE 5949 BNE.s LAB_29FD * wrap and -ve test so try again
-0000263E 5950
-0000263E 5951 LAB_2A1A
-0000263E 6406 5952 BCC.s LAB_2A21 * branch if +ve test result
-00002640 5953
-00002640 4400 5954 NEG.b d0 * negate the digit number
-00002642 0600 000B 5955 ADD.b #$0B,d0 * and subtract from 11 decimal
-00002646 5956 LAB_2A21
-00002646 0600 002F 5957 ADD.b #$2F,d0 * add "0"-1 to result
-0000264A 5842 5958 ADDQ.w #4,d2 * increment index to next less power of ten
-0000264C 5241 5959 ADDQ.w #1,d1 * increment output string index
-0000264E 1600 5960 MOVE.b d0,d3 * copy character to d3
-00002650 C63C 007F 5961 AND.b #$7F,d3 * mask out top bit
-00002654 1383 1000 5962 MOVE.b d3,(a1,d1.w) * save to output string
-00002658 532B 05AC 5963 SUB.b #1,numexp(a3) * decrement # of characters before the dp
-0000265C 6608 5964 BNE.s LAB_2A3B * branch if still characters to do
-0000265E 5965
-0000265E 5966 * else output the point
-0000265E 5281 5967 ADDQ.l #1,d1 * increment index
-00002660 13BC 002E 1000 5968 MOVE.b #'.',(a1,d1.w) * save to output string
-00002666 5969 LAB_2A3B
-00002666 C03C 0080 5970 AND.b #$80,d0 * mask test sense bit
-0000266A 0A00 0080 5971 EORI.b #$80,d0 * invert it
-0000266E B43C 001C 5972 CMP.b #LAB_2A9B-LAB_2A9A,d2 * compare table index with max+4
-00002672 66B0 5973 BNE.s LAB_29FB * loop if not max
-00002674 5974
-00002674 5975 * now remove trailing zeroes
-00002674 5976 LAB_2A4B
-00002674 1031 1000 5977 MOVE.b (a1,d1.w),d0 * get character from output string
-00002678 5381 5978 SUBQ.l #1,d1 * decrement output string index
-0000267A B03C 0030 5979 CMP.b #'0',d0 * compare with "0"
-0000267E 67F4 5980 BEQ.s LAB_2A4B * loop until non "0" character found
-00002680 5981
-00002680 B03C 002E 5982 CMP.b #'.',d0 * compare with "."
-00002684 6702 5983 BEQ.s LAB_2A58 * branch if was dp
-00002686 5984
-00002686 5985 * else restore last character
-00002686 5281 5986 ADDQ.l #1,d1 * increment output string index
-00002688 5987 LAB_2A58
-00002688 13BC 002B 1002 5988 MOVE.b #'+',2(a1,d1.w) * save character "+" to output string
-0000268E 4A2B 05AD 5989 TST.b expcnt(a3) * test exponent count
-00002692 6738 5990 BEQ.s LAB_2A8C * if zero go set null terminator & exit
-00002694 5991
-00002694 5992 * exponent isn't zero so write exponent
-00002694 6A0A 5993 BPL.s LAB_2A68 * branch if exponent count +ve
-00002696 5994
-00002696 13BC 002D 1002 5995 MOVE.b #'-',2(a1,d1.w) * save character "-" to output string
-0000269C 442B 05AD 5996 NEG.b expcnt(a3) * convert -ve to +ve
-000026A0 5997 LAB_2A68
-000026A0 13BC 0045 1001 5998 MOVE.b #'E',1(a1,d1.w) * save character "E" to output string
-000026A6 142B 05AD 5999 MOVE.b expcnt(a3),d2 * get exponent count
-000026AA 702F 6000 MOVEQ #$2F,d0 * one less than "0" character
-000026AC 6001 LAB_2A74
-000026AC 5200 6002 ADDQ.b #1,d0 * increment 10's character
-000026AE 0402 000A 6003 SUB.b #$0A,d2 * subtract 10 from exponent count
-000026B2 64F8 6004 BCC.s LAB_2A74 * loop while still >= 0
-000026B4 6005
-000026B4 0602 003A 6006 ADD.b #$3A,d2 * add character ":", $30+$0A, result is 10-value
-000026B8 1380 1003 6007 MOVE.b d0,3(a1,d1.w) * save 10's character to output string
-000026BC 1382 1004 6008 MOVE.b d2,4(a1,d1.w) * save 1's character to output string
-000026C0 13BC 0000 1005 6009 MOVE.b #0,5(a1,d1.w) * save null terminator after last character
-000026C6 600A 6010 BRA.s LAB_2A91 * go set string pointer (a0) and exit
-000026C8 6011
-000026C8 6012 LAB_2A89
-000026C8 1380 1000 6013 MOVE.b d0,(a1,d1.w) * save last character to output string
-000026CC 6014 LAB_2A8C
-000026CC 13BC 0000 1001 6015 MOVE.b #0,1(a1,d1.w) * save null terminator after last character
-000026D2 6016 LAB_2A91
-000026D2 2049 6017 MOVEA.l a1,a0 * set result string pointer (a0)
-000026D4 4E75 6018 RTS
-000026D6 6019
-000026D6 6020
-000026D6 6021 *************************************************************************************
-000026D6 6022 *
-000026D6 6023 * fast compare FAC1 with FAC2
-000026D6 6024 * assumes both are +ve and FAC2>0
-000026D6 6025 * returns d0=+1 C=0 if FAC1 > FAC2
-000026D6 6026 * returns d0= 0 C=0 if FAC1 = FAC2
-000026D6 6027 * returns d0=-1 C=1 if FAC1 < FAC2
-000026D6 6028
-000026D6 6029 LAB_27F0
-000026D6 7000 6030 MOVEQ #0,d0 * set for FAC1 = FAC2
-000026D8 122B 059C 6031 MOVE.b FAC2_e(a3),d1 * get FAC2 exponent
-000026DC B22B 0594 6032 CMP.b FAC1_e(a3),d1 * compare FAC1 exponent with FAC2 exponent
-000026E0 660A 6033 BNE.s LAB_27F1 * branch if different
-000026E2 6034
-000026E2 222B 0598 6035 MOVE.l FAC2_m(a3),d1 * get FAC2 mantissa
-000026E6 B2AB 0590 6036 CMP.l FAC1_m(a3),d1 * compare mantissas
-000026EA 6708 6037 BEQ.s LAB_27F3 * exit if mantissas equal
-000026EC 6038
-000026EC 6039 LAB_27F1
-000026EC 6504 6040 BCS.s LAB_27F2 * if FAC1 > FAC2 return d0=+1,C=0
-000026EE 6041
-000026EE 5380 6042 SUBQ.l #1,d0 * else FAC1 < FAC2 return d0=-1,C=1
-000026F0 4E75 6043 RTS
-000026F2 6044
-000026F2 6045 LAB_27F2
-000026F2 5280 6046 ADDQ.l #1,d0
-000026F4 6047 LAB_27F3
-000026F4 4E75 6048 RTS
-000026F6 6049
-000026F6 6050
-000026F6 6051 *************************************************************************************
-000026F6 6052 *
-000026F6 6053 * make FAC1 = 1
-000026F6 6054
-000026F6 6055 LAB_POON
-000026F6 277C 80000000 0590 6056 MOVE.l #$80000000,FAC1_m(a3) * 1 mantissa
-000026FE 377C 8100 0594 6057 MOVE.w #$8100,FAC1_e(a3) * 1 exonent & sign
-00002704 4E75 6058 RTS
-00002706 6059
-00002706 6060
-00002706 6061 *************************************************************************************
-00002706 6062 *
-00002706 6063 * make FAC1 = 0
-00002706 6064
-00002706 6065 LAB_POZE
-00002706 7000 6066 MOVEQ #0,d0 * clear longword
-00002708 2740 0590 6067 MOVE.l d0,FAC1_m(a3) * 0 mantissa
-0000270C 3740 0594 6068 MOVE.w d0,FAC1_e(a3) * 0 exonent & sign
-00002710 4E75 6069 RTS
-00002712 6070
-00002712 6071
-00002712 6072 *************************************************************************************
-00002712 6073 *
-00002712 6074 * perform power function
-00002712 6075 * the number is in FAC2, the power is in FAC1
-00002712 6076 * no longer trashes Itemp
-00002712 6077
-00002712 6078 LAB_POWER
-00002712 4A2B 0594 6079 TST.b FAC1_e(a3) * test power
-00002716 67DE 6080 BEQ.s LAB_POON * if zero go return 1
-00002718 6081
-00002718 4A2B 059C 6082 TST.b FAC2_e(a3) * test number
-0000271C 67E8 6083 BEQ.s LAB_POZE * if zero go return 0
-0000271E 6084
-0000271E 1F2B 059D 6085 MOVE.b FAC2_s(a3),-(sp) * save number sign
-00002722 6A20 6086 BPL.s LAB_POWP * power of positive number
-00002724 6087
-00002724 7200 6088 MOVEQ #0,d1 * clear d1
-00002726 1741 059D 6089 MOVE.b d1,FAC2_s(a3) * make sign +ve
-0000272A 6090
-0000272A 6091 * number sign was -ve and can only be raised to
-0000272A 6092 * an integer power which gives an x +j0 result,
-0000272A 6093 * else do 'function call' error
-0000272A 122B 0594 6094 MOVE.b FAC1_e(a3),d1 * get power exponent
-0000272E 0441 0080 6095 SUB.w #$80,d1 * normalise to .5
-00002732 6300 E22A 6096 BLS LAB_FCER * if 0INT(power) then do 'function call'
-00002740 6102 * error
-00002740 6103
-00002740 6502 6104 BCS.s LAB_POWP * if integer value odd then leave result -ve
-00002742 6105
-00002742 1E80 6106 MOVE.b d0,(sp) * save result sign +ve
-00002744 6107 LAB_POWP
-00002744 2F2B 0590 6108 MOVE.l FAC1_m(a3),-(sp) * save power mantissa
-00002748 3F2B 0594 6109 MOVE.w FAC1_e(a3),-(sp) * save power sign & exponent
-0000274C 6110
-0000274C 6100 FC78 6111 BSR LAB_279B * copy number to FAC1
-00002750 6100 F9E8 6112 BSR LAB_LOG * find log of number
-00002754 6113
-00002754 301F 6114 MOVE.w (sp)+,d0 * get power sign & exponent
-00002756 275F 0598 6115 MOVE.l (sp)+,FAC2_m(a3) * get power mantissa
-0000275A 3740 059C 6116 MOVE.w d0,FAC2_e(a3) * save sign & exponent to FAC2
-0000275E 1740 059E 6117 MOVE.b d0,FAC_sc(a3) * save sign as sign compare
-00002762 102B 0595 6118 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
-00002766 B12B 059E 6119 EOR.b d0,FAC_sc(a3) * make sign compare (FAC1_s EOR FAC2_s)
-0000276A 6120
-0000276A 6100 FAC0 6121 BSR LAB_MULTIPLY * multiply by power
-0000276E 6158 6122 BSR.s LAB_EXP * find exponential
-00002770 175F 0595 6123 MOVE.b (sp)+,FAC1_s(a3) * restore number sign
-00002774 4E75 6124 RTS
-00002776 6125
-00002776 6126
-00002776 6127 *************************************************************************************
-00002776 6128 *
-00002776 6129 * do - FAC1
-00002776 6130
-00002776 6131 LAB_GTHAN
-00002776 4A2B 0594 6132 TST.b FAC1_e(a3) * test for non zero FAC1
-0000277A 6706 6133 BEQ.s RTS_020 * branch if null
-0000277C 6134
-0000277C 0A2B 0080 0595 6135 EORI.b #$80,FAC1_s(a3) * (else) toggle FAC1 sign bit
-00002782 6136 RTS_020
-00002782 4E75 6137 RTS
-00002784 6138
-00002784 6139
-00002784 6140 *************************************************************************************
-00002784 6141 *
-00002784 6142 * return +1
-00002784 6143 LAB_EX1
-00002784 277C 80000000 0590 6144 MOVE.l #$80000000,FAC1_m(a3) * +1 mantissa
-0000278C 377C 8100 0594 6145 MOVE.w #$8100,FAC1_e(a3) * +1 sign & exponent
-00002792 4E75 6146 RTS
-00002794 6147 * do over/under flow
-00002794 6148 LAB_EXOU
-00002794 4A2B 0595 6149 TST.b FAC1_s(a3) * test sign
-00002798 6A00 E1C0 6150 BPL LAB_OFER * was +ve so do overflow error
-0000279C 6151
-0000279C 6152 * else underflow so return zero
-0000279C 7000 6153 MOVEQ #0,d0 * clear longword
-0000279E 2740 0590 6154 MOVE.l d0,FAC1_m(a3) * 0 mantissa
-000027A2 3740 0594 6155 MOVE.w d0,FAC1_e(a3) * 0 sign & exponent
-000027A6 4E75 6156 RTS
-000027A8 6157 * fraction was zero so do 2^n
-000027A8 6158 LAB_EXOF
-000027A8 277C 80000000 0590 6159 MOVE.l #$80000000,FAC1_m(a3) * +n mantissa
-000027B0 177C 0000 0595 6160 MOVE.b #0,FAC1_s(a3) * clear sign
-000027B6 4A2B 05B4 6161 TST.b cosout(a3) * test sign flag
-000027BA 6A02 6162 BPL.s LAB_EXOL * branch if +ve
-000027BC 6163
-000027BC 4481 6164 NEG.l d1 * else do 1/2^n
-000027BE 6165 LAB_EXOL
-000027BE 0601 0081 6166 ADD.b #$81,d1 * adjust exponent
-000027C2 1741 0594 6167 MOVE.b d1,FAC1_e(a3) * save exponent
-000027C6 4E75 6168 RTS
-000027C8 6169
-000027C8 6170 * perform EXP() (x^e)
-000027C8 6171 * valid input range is -88 to +88
-000027C8 6172
-000027C8 6173 LAB_EXP
-000027C8 102B 0594 6174 MOVE.b FAC1_e(a3),d0 * get exponent
-000027CC 67B6 6175 BEQ.s LAB_EX1 * return 1 for zero in
-000027CE 6176
-000027CE B03C 0064 6177 CMP.b #$64,d0 * compare exponent with min
-000027D2 65B0 6178 BCS.s LAB_EX1 * if smaller just return 1
-000027D4 6179
-000027D4 6180 ** MOVEM.l d1-d6/a0,-(sp) * save the registers
-000027D4 177C 0000 05B4 6181 MOVE.b #0,cosout(a3) * flag +ve number
-000027DA 222B 0590 6182 MOVE.l FAC1_m(a3),d1 * get mantissa
-000027DE B03C 0087 6183 CMP.b #$87,d0 * compare exponent with max
-000027E2 62B0 6184 BHI.s LAB_EXOU * go do over/under flow if greater
-000027E4 6185
-000027E4 6608 6186 BNE.s LAB_EXCM * branch if less
-000027E6 6187
-000027E6 6188 * else is 2^7
-000027E6 B2BC B00F33C7 6189 CMP.l #$B00F33C7,d1 * compare mantissa with n*2^7 max
-000027EC 64A6 6190 BCC.s LAB_EXOU * if => go over/underflow
-000027EE 6191
-000027EE 6192 LAB_EXCM
-000027EE 4A2B 0595 6193 TST.b FAC1_s(a3) * test sign
-000027F2 6A0C 6194 BPL.s LAB_EXPS * branch if arg +ve
-000027F4 6195
-000027F4 177C 00FF 05B4 6196 MOVE.b #$FF,cosout(a3) * flag -ve number
-000027FA 177C 0000 0595 6197 MOVE.b #0,FAC1_s(a3) * take absolute value
-00002800 6198 LAB_EXPS
-00002800 6199 * now do n/LOG(2)
-00002800 277C B8AA3B29 0598 6200 MOVE.l #$B8AA3B29,FAC2_m(a3) * 1/LOG(2) mantissa
-00002808 377C 8100 059C 6201 MOVE.w #$8100,FAC2_e(a3) * 1/LOG(2) exponent & sign
-0000280E 177C 0000 059E 6202 MOVE.b #0,FAC_sc(a3) * we know they're both +ve
-00002814 6100 FA16 6203 BSR LAB_MULTIPLY * effectively divide by log(2)
-00002818 6204
-00002818 6205 * max here is +/- 127
-00002818 6206 * now separate integer and fraction
-00002818 177C 0000 05D9 6207 MOVE.b #0,tpower(a3) * clear exponent add byte
-0000281E 1A2B 0594 6208 MOVE.b FAC1_e(a3),d5 * get exponent
-00002822 0405 0080 6209 SUB.b #$80,d5 * normalise
-00002826 6324 6210 BLS.s LAB_ESML * branch if < 1 (d5 is 0 or -ve)
-00002828 6211
-00002828 6212 * result is > 1
-00002828 202B 0590 6213 MOVE.l FAC1_m(a3),d0 * get mantissa
-0000282C 2200 6214 MOVE.l d0,d1 * copy it
-0000282E 2C05 6215 MOVE.l d5,d6 * copy normalised exponent
-00002830 6216
-00002830 4446 6217 NEG.w d6 * make -ve
-00002832 0646 0020 6218 ADD.w #32,d6 * is now 32-d6
-00002836 ECA9 6219 LSR.l d6,d1 * just integer bits
-00002838 1741 05D9 6220 MOVE.b d1,tpower(a3) * set exponent add byte
-0000283C 6221
-0000283C EBA8 6222 LSL.l d5,d0 * shift out integer bits
-0000283E 6700 FF68 6223 BEQ LAB_EXOF * fraction is zero so do 2^n
-00002842 6224
-00002842 2740 0590 6225 MOVE.l d0,FAC1_m(a3) * fraction to FAC1
-00002846 377C 8000 0594 6226 MOVE.w #$8000,FAC1_e(a3) * set exponent & sign
-0000284C 6227
-0000284C 6228 * multiple was < 1
-0000284C 6229 LAB_ESML
-0000284C 277C B17217F8 0598 6230 MOVE.l #$B17217F8,FAC2_m(a3) * LOG(2) mantissa
-00002854 377C 8000 059C 6231 MOVE.w #$8000,FAC2_e(a3) * LOG(2) exponent & sign
-0000285A 177C 0000 059E 6232 MOVE.b #0,FAC_sc(a3) * clear sign compare
-00002860 6100 F9CA 6233 BSR LAB_MULTIPLY * multiply by log(2)
-00002864 6234
-00002864 202B 0590 6235 MOVE.l FAC1_m(a3),d0 * get mantissa
-00002868 1A2B 0594 6236 MOVE.b FAC1_e(a3),d5 * get exponent
-0000286C 0445 0082 6237 SUB.w #$82,d5 * normalise and -2 (result is -1 to -30)
-00002870 4445 6238 NEG.w d5 * make +ve
-00002872 EAA8 6239 LSR.l d5,d0 * shift for 2 integer bits
-00002874 6240
-00002874 6241 * d0 = arg
-00002874 6242 * d6 = x, d1 = y
-00002874 6243 * d2 = x1, d3 = y1
-00002874 6244 * d4 = shift count
-00002874 6245 * d5 = loop count
-00002874 6246 * now do cordic set-up
-00002874 7200 6247 MOVEQ #0,d1 * y = 0
-00002876 2C3C 26A3D110 6248 MOVE.l #KFCTSEED,d6 * x = 1 with jkh inverse factored out
-0000287C 41FA 0D2A 6249 LEA TAB_HTHET(pc),a0 * get pointer to hyperbolic arctan table
-00002880 7800 6250 MOVEQ #0,d4 * clear shift count
-00002882 6251
-00002882 6252 * cordic loop, shifts 4 and 13 (and 39
-00002882 6253 * if it went that far) need to be repeated
-00002882 7A03 6254 MOVEQ #3,d5 * 4 loops
-00002884 6136 6255 BSR.s LAB_EXCC * do loops 1 through 4
-00002886 5948 6256 SUBQ.w #4,a0 * do table entry again
-00002888 5384 6257 SUBQ.l #1,d4 * do shift count again
-0000288A 7A09 6258 MOVEQ #9,d5 * 10 loops
-0000288C 612E 6259 BSR.s LAB_EXCC * do loops 4 (again) through 13
-0000288E 5948 6260 SUBQ.w #4,a0 * do table entry again
-00002890 5384 6261 SUBQ.l #1,d4 * do shift count again
-00002892 7A12 6262 MOVEQ #18,d5 * 19 loops
-00002894 6126 6263 BSR.s LAB_EXCC * do loops 13 (again) through 31
-00002896 6264
-00002896 6265 * now get the result
-00002896 4A2B 05B4 6266 TST.b cosout(a3) * test sign flag
-0000289A 6A06 6267 BPL.s LAB_EXPL * branch if +ve
-0000289C 6268
-0000289C 4481 6269 NEG.l d1 * do -y
-0000289E 442B 05D9 6270 NEG.b tpower(a3) * do -exp
-000028A2 6271 LAB_EXPL
-000028A2 7083 6272 MOVEQ #$83-$100,d0 * set exponent
-000028A4 DC81 6273 ADD.l d1,d6 * y = y +/- x
-000028A6 6B06 6274 BMI.s LAB_EXRN * branch if result normal
-000028A8 6275
-000028A8 6276 LAB_EXNN
-000028A8 5380 6277 SUBQ.l #1,d0 * decrement exponent
-000028AA DC86 6278 ADD.l d6,d6 * shift mantissa
-000028AC 6AFA 6279 BPL.s LAB_EXNN * loop if not normal
-000028AE 6280
-000028AE 6281 LAB_EXRN
-000028AE 2746 0590 6282 MOVE.l d6,FAC1_m(a3) * save exponent result
-000028B2 D02B 05D9 6283 ADD.b tpower(a3),d0 * add integer part
-000028B6 1740 0594 6284 MOVE.b d0,FAC1_e(a3) * save exponent
-000028BA 6285 ** MOVEM.l (sp)+,d1-d6/a0 * restore registers
-000028BA 4E75 6286 RTS
-000028BC 6287
-000028BC 6288 * cordic loop
-000028BC 6289 LAB_EXCC
-000028BC 5284 6290 ADDQ.l #1,d4 * increment shift count
-000028BE 2406 6291 MOVE.l d6,d2 * x1 = x
-000028C0 E8A2 6292 ASR.l d4,d2 * x1 >> n
-000028C2 2601 6293 MOVE.l d1,d3 * y1 = y
-000028C4 E8A3 6294 ASR.l d4,d3 * y1 >> n
-000028C6 4A80 6295 TST.l d0 * test arg
-000028C8 6B0C 6296 BMI.s LAB_EXAD * branch if -ve
-000028CA 6297
-000028CA D282 6298 ADD.l d2,d1 * y = y + x1
-000028CC DC83 6299 ADD.l d3,d6 * x = x + y1
-000028CE 9098 6300 SUB.l (a0)+,d0 * arg = arg - atnh(a0)
-000028D0 51CD FFEA 6301 DBF d5,LAB_EXCC * decrement and loop if not done
-000028D4 6302
-000028D4 4E75 6303 RTS
-000028D6 6304
-000028D6 6305 LAB_EXAD
-000028D6 9282 6306 SUB.l d2,d1 * y = y - x1
-000028D8 9C83 6307 SUB.l d3,d6 * x = x + y1
-000028DA D098 6308 ADD.l (a0)+,d0 * arg = arg + atnh(a0)
-000028DC 51CD FFDE 6309 DBF d5,LAB_EXCC * decrement and loop if not done
-000028E0 6310
-000028E0 4E75 6311 RTS
-000028E2 6312
-000028E2 6313
-000028E2 6314 *************************************************************************************
-000028E2 6315 *
-000028E2 6316 * RND(n), 32 bit Galois version. make n=0 for 19th next number in sequence or n<>0
-000028E2 6317 * to get 19th next number in sequence after seed n. This version of the PRNG uses
-000028E2 6318 * the Galois method and a sample of 65536 bytes produced gives the following values.
-000028E2 6319
-000028E2 6320 * Entropy = 7.997442 bits per byte
-000028E2 6321 * Optimum compression would reduce these 65536 bytes by 0 percent
-000028E2 6322
-000028E2 6323 * Chi square distribution for 65536 samples is 232.01, and
-000028E2 6324 * randomly would exceed this value 75.00 percent of the time
-000028E2 6325
-000028E2 6326 * Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
-000028E2 6327 * Monte Carlo value for Pi is 3.122871269, error 0.60 percent
-000028E2 6328 * Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0
-000028E2 6329
-000028E2 6330 LAB_RND
-000028E2 4A2B 0594 6331 TST.b FAC1_e(a3) * get FAC1 exponent
-000028E6 6708 6332 BEQ.s NextPRN * do next random number if zero
-000028E8 6333
-000028E8 6334 * else get seed into random number store
-000028E8 41EB 05A0 6335 LEA PRNlword(a3),a0 * set PRNG pointer
-000028EC 6100 FAB2 6336 BSR LAB_2778 * pack FAC1 into (a0)
-000028F0 6337 NextPRN
-000028F0 72AF 6338 MOVEQ #$AF-$100,d1 * set EOR value
-000028F2 7412 6339 MOVEQ #18,d2 * do this 19 times
-000028F4 202B 05A0 6340 MOVE.l PRNlword(a3),d0 * get current
-000028F8 6341 Ninc0
-000028F8 D080 6342 ADD.l d0,d0 * shift left 1 bit
-000028FA 6402 6343 BCC.s Ninc1 * branch if bit 32 not set
-000028FC 6344
-000028FC B300 6345 EOR.b d1,d0 * do Galois LFSR feedback
-000028FE 6346 Ninc1
-000028FE 51CA FFF8 6347 DBF d2,Ninc0 * loop
-00002902 6348
-00002902 2740 05A0 6349 MOVE.l d0,PRNlword(a3) * save back to seed word
-00002906 2740 0590 6350 MOVE.l d0,FAC1_m(a3) * copy to FAC1 mantissa
-0000290A 377C 8000 0594 6351 MOVE.w #$8000,FAC1_e(a3) * set the exponent and clear the sign
-00002910 6000 F7F2 6352 BRA LAB_24D5 * normalise FAC1 & return
-00002914 6353
-00002914 6354
-00002914 6355 *************************************************************************************
-00002914 6356 *
-00002914 6357 * cordic TAN(x) routine, TAN(x) = SIN(x)/COS(x)
-00002914 6358 * x = angle in radians
-00002914 6359
-00002914 6360 LAB_TAN
-00002914 6138 6361 BSR.s LAB_SIN * go do SIN/COS cordic compute
-00002916 376B 0594 059C 6362 MOVE.w FAC1_e(a3),FAC2_e(a3) * copy exponent & sign from FAC1 to FAC2
-0000291C 276B 0590 0598 6363 MOVE.l FAC1_m(a3),FAC2_m(a3) * copy FAC1 mantissa to FAC2 mantissa
-00002922 2741 0590 6364 MOVE.l d1,FAC1_m(a3) * get COS(x) mantissa
-00002926 1743 0594 6365 MOVE.b d3,FAC1_e(a3) * get COS(x) exponent
-0000292A 6700 E02E 6366 BEQ LAB_OFER * do overflow if COS = 0
-0000292E 6367
-0000292E 6100 F7D4 6368 BSR LAB_24D5 * normalise FAC1
-00002932 6000 F984 6369 BRA LAB_DIVIDE * do FAC2/FAC1 and return, FAC_sc set by SIN
-00002936 6370 * COS calculation
-00002936 6371
-00002936 6372
-00002936 6373 *************************************************************************************
-00002936 6374 *
-00002936 6375 * cordic SIN(x), COS(x) routine
-00002936 6376 * x = angle in radians
-00002936 6377
-00002936 6378 LAB_COS
-00002936 277C C90FDAA3 0598 6379 MOVE.l #$C90FDAA3,FAC2_m(a3) * pi/2 mantissa (LSB is rounded up so
-0000293E 6380 * COS(PI/2)=0)
-0000293E 377C 8100 059C 6381 MOVE.w #$8100,FAC2_e(a3) * pi/2 exponent and sign
-00002944 176B 0595 059E 6382 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign = FAC1 sign (b7)
-0000294A 6100 F73C 6383 BSR LAB_ADD * add FAC2 to FAC1, adjust for COS(x)
-0000294E 6384
-0000294E 6385
-0000294E 6386 *************************************************************************************
-0000294E 6387 *
-0000294E 6388 * SIN/COS cordic calculator
-0000294E 6389
-0000294E 6390 LAB_SIN
-0000294E 177C 0000 05B4 6391 MOVE.b #0,cosout(a3) * set needed result
-00002954 6392
-00002954 277C A2F9836F 0598 6393 MOVE.l #$A2F9836F,FAC2_m(a3) * 1/pi mantissa (LSB is rounded up so SIN(PI)=0)
-0000295C 377C 7F00 059C 6394 MOVE.w #$7F00,FAC2_e(a3) * 1/pi exponent & sign
-00002962 176B 0595 059E 6395 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign = FAC1 sign (b7)
-00002968 6100 F8C2 6396 BSR LAB_MULTIPLY * multiply by 1/pi
-0000296C 6397
-0000296C 102B 0594 6398 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
-00002970 671C 6399 BEQ.s LAB_SCZE * branch if zero
-00002972 6400
-00002972 41FA 0B34 6401 LEA TAB_SNCO(pc),a0 * get pointer to constants table
-00002976 2C2B 0590 6402 MOVE.l FAC1_m(a3),d6 * get FAC1 mantissa
-0000297A 5300 6403 SUBQ.b #1,d0 * 2 radians in 360 degrees so /2
-0000297C 6710 6404 BEQ.s LAB_SCZE * branch if zero
-0000297E 6405
-0000297E 0400 0080 6406 SUB.b #$80,d0 * normalise exponent
-00002982 6B18 6407 BMI.s LAB_SCL0 * branch if < 1
-00002984 6408
-00002984 6409 * X is > 1
-00002984 B03C 0020 6410 CMP.b #$20,d0 * is it >= 2^32
-00002988 6404 6411 BCC.s LAB_SCZE * may as well do zero
-0000298A 6412
-0000298A E1AE 6413 LSL.l d0,d6 * shift out integer part bits
-0000298C 6618 6414 BNE.s LAB_CORD * if fraction go test quadrant and adjust
-0000298E 6415
-0000298E 6416 * else no fraction so do zero
-0000298E 6417 LAB_SCZE
-0000298E 7481 6418 MOVEQ #$81-$100,d2 * set exponent for 1.0
-00002990 7600 6419 MOVEQ #0,d3 * set exponent for 0.0
-00002992 203C 80000000 6420 MOVE.l #$80000000,d0 * mantissa for 1.0
-00002998 2203 6421 MOVE.l d3,d1 * mantissa for 0.0
-0000299A 6062 6422 BRA.s outloop * go output it
-0000299C 6423
-0000299C 6424 * x is < 1
-0000299C 6425 LAB_SCL0
-0000299C 4400 6426 NEG.b d0 * make +ve
-0000299E B03C 001E 6427 CMP.b #$1E,d0 * is it <= 2^-30
-000029A2 64EA 6428 BCC.s LAB_SCZE * may as well do zero
-000029A4 6429
-000029A4 E0AE 6430 LSR.l d0,d6 * shift out <= 2^-32 bits
-000029A6 6431
-000029A6 6432 * cordic calculator, argument in d6
-000029A6 6433 * table pointer in a0, returns in d0-d3
-000029A6 6434
-000029A6 6435 LAB_CORD
-000029A6 176B 0595 059E 6436 MOVE.b FAC1_s(a3),FAC_sc(a3) * copy as sign compare for TAN
-000029AC DC86 6437 ADD.l d6,d6 * shift 0.5 bit into carry
-000029AE 6406 6438 BCC.s LAB_LTPF * branch if less than 0.5
-000029B0 6439
-000029B0 0A2B 00FF 0595 6440 EORI.b #$FF,FAC1_s(a3) * toggle result sign
-000029B6 6441 LAB_LTPF
-000029B6 DC86 6442 ADD.l d6,d6 * shift 0.25 bit into carry
-000029B8 640C 6443 BCC.s LAB_LTPT * branch if less than 0.25
-000029BA 6444
-000029BA 0A2B 00FF 05B4 6445 EORI.b #$FF,cosout(a3) * toggle needed result
-000029C0 0A2B 00FF 059E 6446 EORI.b #$FF,FAC_sc(a3) * toggle sign compare for TAN
-000029C6 6447
-000029C6 6448 LAB_LTPT
-000029C6 E48E 6449 LSR.l #2,d6 * shift the bits back (clear integer bits)
-000029C8 67C4 6450 BEQ.s LAB_SCZE * no fraction so go do zero
-000029CA 6451
-000029CA 6452 * set start values
-000029CA 7A01 6453 MOVEQ #1,d5 * set bit count
-000029CC 2028 FFFC 6454 MOVE.l -4(a0),d0 * get multiply constant (1st itteration d0)
-000029D0 2200 6455 MOVE.l d0,d1 * 1st itteration d1
-000029D2 9C98 6456 SUB.l (a0)+,d6 * 1st always +ve so do 1st step
-000029D4 6008 6457 BRA.s mainloop * jump into routine
-000029D6 6458
-000029D6 6459 subloop
-000029D6 9C98 6460 SUB.l (a0)+,d6 * z = z - arctan(i)/2pi
-000029D8 9083 6461 SUB.l d3,d0 * x = x - y1
-000029DA D282 6462 ADD.l d2,d1 * y = y + x1
-000029DC 6012 6463 BRA.s nexta * back to main loop
-000029DE 6464
-000029DE 6465 mainloop
-000029DE 2400 6466 MOVE.l d0,d2 * x1 = x
-000029E0 EAA2 6467 ASR.l d5,d2 * / (2 ^ i)
-000029E2 2601 6468 MOVE.l d1,d3 * y1 = y
-000029E4 EAA3 6469 ASR.l d5,d3 * / (2 ^ i)
-000029E6 4A86 6470 TST.l d6 * test sign (is 2^0 bit)
-000029E8 6AEC 6471 BPL.s subloop * go do subtract if > 1
-000029EA 6472
-000029EA DC98 6473 ADD.l (a0)+,d6 * z = z + arctan(i)/2pi
-000029EC D083 6474 ADD.l d3,d0 * x = x + y1
-000029EE 9282 6475 SUB.l d2,d1 * y = y + x1
-000029F0 6476 nexta
-000029F0 5285 6477 ADDQ.l #1,d5 * i = i + 1
-000029F2 BABC 0000001E 6478 CMP.l #$1E,d5 * check end condition
-000029F8 66E4 6479 BNE.s mainloop * loop if not all done
-000029FA 6480
-000029FA 6481 * now untangle output value
-000029FA 7481 6482 MOVEQ #$81-$100,d2 * set exponent for 0 to .99 rec.
-000029FC 2602 6483 MOVE.l d2,d3 * copy it for cos output
-000029FE 6484 outloop
-000029FE 4A2B 05B4 6485 TST.b cosout(a3) * did we want cos output?
-00002A02 6B04 6486 BMI.s subexit * if so skip
-00002A04 6487
-00002A04 C141 6488 EXG d0,d1 * swap SIN and COS mantissas
-00002A06 C543 6489 EXG d2,d3 * swap SIN and COS exponents
-00002A08 6490 subexit
-00002A08 2740 0590 6491 MOVE.l d0,FAC1_m(a3) * set result mantissa
-00002A0C 1742 0594 6492 MOVE.b d2,FAC1_e(a3) * set result exponent
-00002A10 6000 F6F2 6493 BRA LAB_24D5 * normalise FAC1 & return
-00002A14 6494
-00002A14 6495
-00002A14 6496
-00002A14 6497 *************************************************************************************
-00002A14 6498 *
-00002A14 6499 * perform ATN()
-00002A14 6500
-00002A14 6501 LAB_ATN
-00002A14 102B 0594 6502 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
-00002A18 6700 00AA 6503 BEQ RTS_021 * ATN(0) = 0 so skip calculation
-00002A1C 6504
-00002A1C 177C 0000 05B4 6505 MOVE.b #0,cosout(a3) * set result needed
-00002A22 B03C 0081 6506 CMP.b #$81,d0 * compare exponent with 1
-00002A26 6528 6507 BCS.s LAB_ATLE * branch if n<1
-00002A28 6508
-00002A28 6608 6509 BNE.s LAB_ATGO * branch if n>1
-00002A2A 6510
-00002A2A 202B 0590 6511 MOVE.l FAC1_m(a3),d0 * get mantissa
-00002A2E D080 6512 ADD.l d0,d0 * shift left
-00002A30 671E 6513 BEQ.s LAB_ATLE * branch if n=1
-00002A32 6514
-00002A32 6515 LAB_ATGO
-00002A32 277C 80000000 0598 6516 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 1
-00002A3A 377C 8100 059C 6517 MOVE.w #$8100,FAC2_e(a3) * set exponent for 1
-00002A40 176B 0595 059E 6518 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign compare = sign
-00002A46 6100 F870 6519 BSR LAB_DIVIDE * do 1/n
-00002A4A 177C 00FF 05B4 6520 MOVE.b #$FF,cosout(a3) * set inverse result needed
-00002A50 6521 LAB_ATLE
-00002A50 202B 0590 6522 MOVE.l FAC1_m(a3),d0 * get FAC1 mantissa
-00002A54 7282 6523 MOVEQ #$82,d1 * set to correct exponent
-00002A56 922B 0594 6524 SUB.b FAC1_e(a3),d1 * subtract FAC1 exponent (always <= 1)
-00002A5A E2A8 6525 LSR.l d1,d0 * shift in two integer part bits
-00002A5C 41FA 0ACA 6526 LEA TAB_ATNC(pc),a0 * get pointer to arctan table
-00002A60 7C00 6527 MOVEQ #0,d6 * Z = 0
-00002A62 223C 40000000 6528 MOVE.l #1<<30,d1 * y = 1
-00002A68 7A1D 6529 MOVEQ #29,d5 * loop 30 times
-00002A6A 7801 6530 MOVEQ #1,d4 * shift counter
-00002A6C 6006 6531 BRA.s LAB_ATCD * enter loop
-00002A6E 6532
-00002A6E 6533 LAB_ATNP
-00002A6E E8A2 6534 ASR.l d4,d2 * x1 / 2^i
-00002A70 D282 6535 ADD.l d2,d1 * y = y + x1
-00002A72 DC90 6536 ADD.l (a0),d6 * z = z + atn(i)
-00002A74 6537 LAB_ATCD
-00002A74 2400 6538 MOVE.l d0,d2 * x1 = x
-00002A76 2601 6539 MOVE.l d1,d3 * y1 = y
-00002A78 E8A3 6540 ASR.l d4,d3 * y1 / 2^i
-00002A7A 6541 LAB_CATN
-00002A7A 9083 6542 SUB.l d3,d0 * x = x - y1
-00002A7C 6AF0 6543 BPL.s LAB_ATNP * branch if x >= 0
-00002A7E 6544
-00002A7E 2002 6545 MOVE.l d2,d0 * else get x back
-00002A80 5848 6546 ADDQ.w #4,a0 * increment pointer
-00002A82 5284 6547 ADDQ.l #1,d4 * increment i
-00002A84 E283 6548 ASR.l #1,d3 * y1 / 2^i
-00002A86 51CD FFF2 6549 DBF d5,LAB_CATN * decrement and loop if not done
-00002A8A 6550
-00002A8A 177C 0082 0594 6551 MOVE.b #$82,FAC1_e(a3) * set new exponent
-00002A90 2746 0590 6552 MOVE.l d6,FAC1_m(a3) * save mantissa
-00002A94 6100 F66E 6553 BSR LAB_24D5 * normalise FAC1
-00002A98 6554
-00002A98 4A2B 05B4 6555 TST.b cosout(a3) * was it > 1 ?
-00002A9C 6A26 6556 BPL.s RTS_021 * branch if not
-00002A9E 6557
-00002A9E 1E2B 0595 6558 MOVE.b FAC1_s(a3),d7 * get sign
-00002AA2 177C 0000 0595 6559 MOVE.b #0,FAC1_s(a3) * clear sign
-00002AA8 277C C90FDAA2 0598 6560 MOVE.l #$C90FDAA2,FAC2_m(a3) * set -(pi/2)
-00002AB0 377C 8180 059C 6561 MOVE.w #$8180,FAC2_e(a3) * set exponent and sign
-00002AB6 177C 00FF 059E 6562 MOVE.b #$FF,FAC_sc(a3) * set sign compare
-00002ABC 6100 F5CA 6563 BSR LAB_ADD * perform addition, FAC2 to FAC1
-00002AC0 1747 0595 6564 MOVE.b d7,FAC1_s(a3) * restore sign
-00002AC4 6565 RTS_021
-00002AC4 4E75 6566 RTS
-00002AC6 6567
-00002AC6 6568
-00002AC6 6569 *************************************************************************************
-00002AC6 6570 *
-00002AC6 6571 * perform BITSET
-00002AC6 6572
-00002AC6 6573 LAB_BITSET
-00002AC6 6100 F4A0 6574 BSR LAB_GADB * get two parameters for POKE or WAIT
-00002ACA 6575 * first parameter in a0, second in d0
-00002ACA B03C 0008 6576 CMP.b #$08,d0 * only 0 to 7 are allowed
-00002ACE 6400 DE8E 6577 BCC LAB_FCER * branch if > 7
-00002AD2 6578
-00002AD2 01D0 6579 BSET d0,(a0) * set bit
-00002AD4 4E75 6580 RTS
-00002AD6 6581
-00002AD6 6582
-00002AD6 6583 *************************************************************************************
-00002AD6 6584 *
-00002AD6 6585 * perform BITCLR
-00002AD6 6586
-00002AD6 6587 LAB_BITCLR
-00002AD6 6100 F490 6588 BSR LAB_GADB * get two parameters for POKE or WAIT
-00002ADA 6589 * first parameter in a0, second in d0
-00002ADA B03C 0008 6590 CMP.b #$08,d0 * only 0 to 7 are allowed
-00002ADE 6400 DE7E 6591 BCC LAB_FCER * branch if > 7
-00002AE2 6592
-00002AE2 0190 6593 BCLR d0,(a0) * clear bit
-00002AE4 4E75 6594 RTS
-00002AE6 6595
-00002AE6 6596
-00002AE6 6597 *************************************************************************************
-00002AE6 6598 *
-00002AE6 6599 * perform BITTST()
-00002AE6 6600
-00002AE6 6601 LAB_BTST
-00002AE6 101D 6602 MOVE.b (a5)+,d0 * increment BASIC pointer
-00002AE8 6100 F47E 6603 BSR LAB_GADB * get two parameters for POKE or WAIT
-00002AEC 6604 * first parameter in a0, second in d0
-00002AEC B03C 0008 6605 CMP.b #$08,d0 * only 0 to 7 are allowed
-00002AF0 6400 DE6C 6606 BCC LAB_FCER * branch if > 7
-00002AF4 6607
-00002AF4 2200 6608 MOVE.l d0,d1 * copy bit # to test
-00002AF6 6100 EAB2 6609 BSR LAB_GBYT * get next BASIC byte
-00002AFA B03C 0029 6610 CMP.b #')',d0 * is next character ")"
-00002AFE 6600 DE6A 6611 BNE LAB_SNER * if not ")" go do syntax error, then warm start
-00002B02 6612
-00002B02 6100 EAA4 6613 BSR LAB_IGBY * update execute pointer (to character past ")")
-00002B06 7000 6614 MOVEQ #0,d0 * set the result as zero
-00002B08 0310 6615 BTST d1,(a0) * test bit
-00002B0A 6700 F90E 6616 BEQ LAB_27DB * branch if zero (already correct)
-00002B0E 6617
-00002B0E 70FF 6618 MOVEQ #-1,d0 * set for -1 result
-00002B10 6000 F908 6619 BRA LAB_27DB * go do SGN tail
-00002B14 6620
-00002B14 6621
-00002B14 6622 *************************************************************************************
-00002B14 6623 *
-00002B14 6624 * perform USING$()
-00002B14 6625
-00002B14 =00000000 6626 fsd EQU 0 * (sp) format string descriptor pointer
-00002B14 =00000004 6627 fsti EQU 4 * 4(sp) format string this index
-00002B14 =00000006 6628 fsli EQU 6 * 6(sp) format string last index
-00002B14 =00000008 6629 fsdpi EQU 8 * 8(sp) format string decimal point index
-00002B14 =0000000A 6630 fsdc EQU 10 * 10(sp) format string decimal characters
-00002B14 =00000008 6631 fend EQU 12-4 * x(sp) end-4, fsd is popped by itself
-00002B14 6632
-00002B14 =00000023 6633 ofchr EQU '#' * the overflow character
-00002B14 6634
-00002B14 6635 LAB_USINGS
-00002B14 4A2B 05B5 6636 TST.b Dtypef(a3) * test data type, $80=string
-00002B18 6A00 DDFC 6637 BPL LAB_FOER * if not string type go do format error
-00002B1C 6638
-00002B1C 246B 0590 6639 MOVEA.l FAC1_m(a3),a2 * get the format string descriptor pointer
-00002B20 3E2A 0004 6640 MOVE.w 4(a2),d7 * get the format string length
-00002B24 6700 DDF0 6641 BEQ LAB_FOER * if null string go do format error
-00002B28 6642
-00002B28 6643 * clear the format string values
-00002B28 6644
-00002B28 7000 6645 MOVEQ #0,d0 * clear d0
-00002B2A 3F00 6646 MOVE.w d0,-(sp) * clear the format string decimal characters
-00002B2C 3F00 6647 MOVE.w d0,-(sp) * clear the format string decimal point index
-00002B2E 3F00 6648 MOVE.w d0,-(sp) * clear the format string last index
-00002B30 3F00 6649 MOVE.w d0,-(sp) * clear the format string this index
-00002B32 2F0A 6650 MOVE.l a2,-(sp) * save the format string descriptor pointer
-00002B34 6651
-00002B34 6652 * make a null return string for the first string add
-00002B34 6653
-00002B34 7200 6654 MOVEQ #0,d1 * make a null string
-00002B36 2041 6655 MOVEA.l d1,a0 * with a null pointer
-00002B38 6100 F0CA 6656 BSR LAB_RTST * push a string on the descriptor stack
-00002B3C 6657 * a0 = pointer, d1 = length
-00002B3C 6658
-00002B3C 6659 * do the USING$() function next value
-00002B3C 6660
-00002B3C 101D 6661 MOVE.b (a5)+,d0 * get the next BASIC byte
-00002B3E 6662 LAB_U002
-00002B3E B03C 002C 6663 CMP.b #',',d0 * compare with comma
-00002B42 6600 DE26 6664 BNE LAB_SNER * if not "," go do syntax error
-00002B46 6665
-00002B46 6100 028E 6666 BSR LAB_ProcFo * process the format string
-00002B4A 4A02 6667 TST.b d2 * test the special characters flag
-00002B4C 6700 DDC8 6668 BEQ LAB_FOER * if no special characters go do format error
-00002B50 6669
-00002B50 6100 E8F6 6670 BSR LAB_EVEX * evaluate the expression
-00002B54 4A2B 05B5 6671 TST.b Dtypef(a3) * test the data type
-00002B58 6B00 DDE4 6672 BMI LAB_TMER * if string type go do type missmatch error
-00002B5C 6673
-00002B5C 4A2B 0594 6674 TST.b FAC1_e(a3) * test FAC1 exponent
-00002B60 6732 6675 BEQ.s LAB_U004 * if FAC1 = 0 skip the rounding
-00002B62 6676
-00002B62 322F 000A 6677 MOVE.w fsdc(sp),d1 * get the format string decimal character count
-00002B66 B27C 0008 6678 CMP.w #8,d1 * compare the fraction digit count with 8
-00002B6A 6428 6679 BCC.s LAB_U004 * if >= 8 skip the rounding
-00002B6C 6680
-00002B6C 3001 6681 MOVE.w d1,d0 * else copy the fraction digit count
-00002B6E D241 6682 ADD.w d1,d1 * * 2
-00002B70 D240 6683 ADD.w d0,d1 * * 3
-00002B72 D241 6684 ADD.w d1,d1 * * 6
-00002B74 41FA 0844 6685 LEA LAB_P_10(pc),a0 * get the rounding table base
-00002B78 2770 1002 0598 6686 MOVE.l 2(a0,d1.w),FAC2_m(a3) * get the rounding mantissa
-00002B7E 3030 1000 6687 MOVE.w (a0,d1.w),d0 * get the rounding exponent
-00002B82 0440 0100 6688 SUB.w #$100,d0 * effectively divide the mantissa by 2
-00002B86 3740 059C 6689 MOVE.w d0,FAC2_e(a3) * save the rounding exponent
-00002B8A 177C 0000 059E 6690 MOVE.b #$00,FAC_sc(a3) * clear the sign compare
-00002B90 6100 F4F6 6691 BSR LAB_ADD * round the value to n places
-00002B94 6692 LAB_U004
-00002B94 6100 F970 6693 BSR LAB_2970 * convert FAC1 to string - not on stack
-00002B98 6694
-00002B98 6100 01FE 6695 BSR LAB_DupFmt * duplicate the processed format string section
-00002B9C 6696 * returns length in d1, pointer in a0
-00002B9C 6697
-00002B9C 6698 * process the number string, length in d6, decimal point index in d2
-00002B9C 6699
-00002B9C 45EB 05C6 6700 LEA Decss(a3),a2 * set the number string start
-00002BA0 7C00 6701 MOVEQ #0,d6 * clear the number string index
-00002BA2 782E 6702 MOVEQ #'.',d4 * set the decimal point character
-00002BA4 6703 LAB_U005
-00002BA4 3406 6704 MOVE.w d6,d2 * save the index to flag the decimal point
-00002BA6 6705 LAB_U006
-00002BA6 5246 6706 ADDQ.w #1,d6 * increment the number string index
-00002BA8 1032 6000 6707 MOVE.b (a2,d6.w),d0 * get a number string character
-00002BAC 677A 6708 BEQ.s LAB_U010 * if null then number complete
-00002BAE 6709
-00002BAE B03C 0045 6710 CMP.b #'E',d0 * compare the character with an "E"
-00002BB2 6706 6711 BEQ.s LAB_U008 * was sx[.x]Esxx so go handle sci notation
-00002BB4 6712
-00002BB4 B004 6713 CMP.b d4,d0 * compare the character with "."
-00002BB6 66EE 6714 BNE.s LAB_U006 * if not decimal point go get the next digit
-00002BB8 6715
-00002BB8 60EA 6716 BRA.s LAB_U005 * go save the index and get the next digit
-00002BBA 6717
-00002BBA 6718 * have found an sx[.x]Esxx number, the [.x] will not be present for a single digit
-00002BBA 6719
-00002BBA 6720 LAB_U008
-00002BBA 3606 6721 MOVE.w d6,d3 * copy the index to the "E"
-00002BBC 5343 6722 SUBQ.w #1,d3 * -1 gives the last digit index
-00002BBE 6723
-00002BBE 5246 6724 ADDQ.w #1,d6 * increment the index to the exponent sign
-00002BC0 1032 6000 6725 MOVE.b (a2,d6.w),d0 * get the exponent sign character
-00002BC4 B03C 002D 6726 CMP.b #'-',d0 * compare the exponent sign with "-"
-00002BC8 6600 DD94 6727 BNE LAB_FCER * if it wasn't sx[.x]E-xx go do function
-00002BCC 6728 * call error
-00002BCC 6729
-00002BCC 6730 * found an sx[.x]E-xx number so check the exponent magnitude
-00002BCC 6731
-00002BCC 5246 6732 ADDQ.w #1,d6 * increment the index to the exponent 10s
-00002BCE 1032 6000 6733 MOVE.b (a2,d6.w),d0 * get the exponent 10s character
-00002BD2 B03C 0030 6734 CMP.b #'0',d0 * compare the exponent 10s with "0"
-00002BD6 6704 6735 BEQ.s LAB_U009 * if it was sx[.x]E-0x go get the exponent
-00002BD8 6736 * 1s character
-00002BD8 6737
-00002BD8 700A 6738 MOVEQ #10,d0 * else start writing at index 10
-00002BDA 6008 6739 BRA.s LAB_U00A * go copy the digits
-00002BDC 6740
-00002BDC 6741 * found an sx[.x]E-0x number so get the exponent magnitude
-00002BDC 6742
-00002BDC 6743 LAB_U009
-00002BDC 5246 6744 ADDQ.w #1,d6 * increment the index to the exponent 1s
-00002BDE 700F 6745 MOVEQ #$0F,d0 * set the mask for the exponent 1s digit
-00002BE0 C032 6000 6746 AND.b (a2,d6.w),d0 * get and convert the exponent 1s digit
-00002BE4 6747 LAB_U00A
-00002BE4 3403 6748 MOVE.w d3,d2 * copy the number last digit index
-00002BE6 0C42 0001 6749 CMPI.w #1,d2 * is the number of the form sxE-0x
-00002BEA 6602 6750 BNE.s LAB_U00B * if it is sx.xE-0x skip the increment
-00002BEC 6751
-00002BEC 6752 * else make room for the decimal point
-00002BEC 5242 6753 ADDQ.w #1,d2 * add 1 to the write index
-00002BEE 6754 LAB_U00B
-00002BEE D440 6755 ADD.w d0,d2 * add the exponent 1s to the write index
-00002BF0 700A 6756 MOVEQ #10,d0 * set the maximum write index
-00002BF2 9042 6757 SUB.w d2,d0 * compare the index with the maximum
-00002BF4 6E0C 6758 BGT.s LAB_U00C * if the index < the maximum continue
-00002BF6 6759
-00002BF6 D440 6760 ADD.w d0,d2 * else set the index to the maximum
-00002BF8 D640 6761 ADD.w d0,d3 * adjust the read index
-00002BFA 0C43 0001 6762 CMPI.w #1,d3 * compare the adjusted index with 1
-00002BFE 6E02 6763 BGT.s LAB_U00C * if > 1 continue
-00002C00 6764
-00002C00 7600 6765 MOVEQ #0,d3 * else allow for the decimal point
-00002C02 6766 LAB_U00C
-00002C02 3C02 6767 MOVE.w d2,d6 * copy the write index as the number
-00002C04 6768 * string length
-00002C04 7000 6769 MOVEQ #0,d0 * clear d0 to null terminate the number
-00002C06 6770 * string
-00002C06 6771 LAB_U00D
-00002C06 1580 2000 6772 MOVE.b d0,(a2,d2.w) * save the character to the number string
-00002C0A 5342 6773 SUBQ.w #1,d2 * decrement the number write index
-00002C0C 0C42 0001 6774 CMPI.w #1,d2 * compare the number write index with 1
-00002C10 6712 6775 BEQ.s LAB_U00F * if at the decimal point go save it
-00002C12 6776
-00002C12 6777 * else write a digit to the number string
-00002C12 7030 6778 MOVEQ #'0',d0 * default to "0"
-00002C14 4A43 6779 TST.w d3 * test the number read index
-00002C16 67EE 6780 BEQ.s LAB_U00D * if zero just go save the "0"
-00002C18 6781
-00002C18 6782 LAB_U00E
-00002C18 1032 3000 6783 MOVE.b (a2,d3.w),d0 * read the next number digit
-00002C1C 5343 6784 SUBQ.w #1,d3 * decrement the read index
-00002C1E B004 6785 CMP.b d4,d0 * compare the digit with "."
-00002C20 66E4 6786 BNE.s LAB_U00D * if not "." go save the digit
-00002C22 6787
-00002C22 60F4 6788 BRA.s LAB_U00E * else go get the next digit
-00002C24 6789
-00002C24 6790 LAB_U00F
-00002C24 1584 2000 6791 MOVE.b d4,(a2,d2.w) * save the decimal point
-00002C28 6792 LAB_U010
-00002C28 4A42 6793 TST.w d2 * test the number string decimal point index
-00002C2A 6602 6794 BNE.s LAB_U014 * if dp present skip the reset
-00002C2C 6795
-00002C2C 3406 6796 MOVE.w d6,d2 * make the decimal point index = the length
-00002C2E 6797
-00002C2E 6798 * copy the fractional digit characters from the number string
-00002C2E 6799
-00002C2E 6800 LAB_U014
-00002C2E 3602 6801 MOVE.w d2,d3 * copy the number string decimal point index
-00002C30 5243 6802 ADDQ.w #1,d3 * increment the number string index
-00002C32 382F 0008 6803 MOVE.w fsdpi(sp),d4 * get the new format string decimal point index
-00002C36 6804 LAB_U018
-00002C36 5244 6805 ADDQ.w #1,d4 * increment the new format string index
-00002C38 B244 6806 CMP.w d4,d1 * compare it with the new format string length
-00002C3A 6322 6807 BLS.s LAB_U022 * if done the fraction digits go do integer
-00002C3C 6808
-00002C3C 1030 4000 6809 MOVE.b (a0,d4.w),d0 * get a new format string character
-00002C40 B03C 0025 6810 CMP.b #'%',d0 * compare it with "%"
-00002C44 6706 6811 BEQ.s LAB_U01C * if "%" go copy a number character
-00002C46 6812
-00002C46 B03C 0023 6813 CMP.b #'#',d0 * compare it with "#"
-00002C4A 66EA 6814 BNE.s LAB_U018 * if not "#" go do the next new format character
-00002C4C 6815
-00002C4C 6816 LAB_U01C
-00002C4C 7030 6817 MOVEQ #'0',d0 * default to "0" character
-00002C4E BC43 6818 CMP.w d3,d6 * compare the number string index with length
-00002C50 6306 6819 BLS.s LAB_U020 * if there skip the character get
-00002C52 6820
-00002C52 1032 3000 6821 MOVE.b (a2,d3.w),d0 * get a character from the number string
-00002C56 5243 6822 ADDQ.w #1,d3 * increment the number string index
-00002C58 6823 LAB_U020
-00002C58 1180 4000 6824 MOVE.b d0,(a0,d4.w) * save the number character to the new format
-00002C5C 6825 * string
-00002C5C 60D8 6826 BRA.s LAB_U018 * go do the next new format character
-00002C5E 6827
-00002C5E 6828 * now copy the integer digit characters from the number string
-00002C5E 6829
-00002C5E 6830 LAB_U022
-00002C5E 7C00 6831 MOVEQ #0,d6 * clear the sign done flag
-00002C60 7A00 6832 MOVEQ #0,d5 * clear the sign present flag
-00002C62 5342 6833 SUBQ.w #1,d2 * decrement the number string index
-00002C64 6608 6834 BNE.s LAB_U026 * if not now at sign continue
-00002C66 6835
-00002C66 7401 6836 MOVEQ #1,d2 * increment the number string index
-00002C68 15BC 0030 2000 6837 MOVE.b #'0',(a2,d2.w) * replace the point with a zero
-00002C6E 6838 LAB_U026
-00002C6E 382F 0008 6839 MOVE.w fsdpi(sp),d4 * get the new format string decimal point index
-00002C72 B244 6840 CMP.w d4,d1 * compare it with the new format string length
-00002C74 6402 6841 BCC.s LAB_U02A * if within the string go use the index
-00002C76 6842
-00002C76 3801 6843 MOVE.w d1,d4 * else set the index to the end of the string
-00002C78 6844 LAB_U02A
-00002C78 5344 6845 SUBQ.w #1,d4 * decrement the new format string index
-00002C7A 6B62 6846 BMI.s LAB_U03E * if all done go test for any overflow
-00002C7C 6847
-00002C7C 1030 4000 6848 MOVE.b (a0,d4.w),d0 * else get a new format string character
-00002C80 6849
-00002C80 7E30 6850 MOVEQ #'0',d7 * default to "0" character
-00002C82 B03C 0025 6851 CMP.b #'%',d0 * compare it with "%"
-00002C86 6708 6852 BEQ.s LAB_U02B * if "%" go copy a number character
-00002C88 6853
-00002C88 7E20 6854 MOVEQ #' ',d7 * default to " " character
-00002C8A B03C 0023 6855 CMP.b #'#',d0 * compare it with "#"
-00002C8E 6606 6856 BNE.s LAB_U02C * if not "#" go try ","
-00002C90 6857
-00002C90 6858 LAB_U02B
-00002C90 4A42 6859 TST.w d2 * test the number string index
-00002C92 6634 6860 BNE.s LAB_U036 * if not at the sign go get a number character
-00002C94 6861
-00002C94 6042 6862 BRA.s LAB_U03C * else go save the default character
-00002C96 6863
-00002C96 6864 LAB_U02C
-00002C96 B03C 002C 6865 CMP.b #',',d0 * compare it with ","
-00002C9A 6610 6866 BNE.s LAB_U030 * if not "," go try the sign characters
-00002C9C 6867
-00002C9C 4A42 6868 TST.w d2 * test the number string index
-00002C9E 6608 6869 BNE.s LAB_U02E * if not at the sign keep the ","
-00002CA0 6870
-00002CA0 0C30 0025 40FF 6871 CMP.b #'%',-1(a0,d4.w) * else compare the next format string character
-00002CA6 6872 * with "%"
-00002CA6 6630 6873 BNE.s LAB_U03C * if not "%" keep the default character
-00002CA8 6874
-00002CA8 6875 LAB_U02E
-00002CA8 1E00 6876 MOVE.b d0,d7 * else use the "," character
-00002CAA 602C 6877 BRA.s LAB_U03C * go save the character to the string
-00002CAC 6878
-00002CAC 6879 LAB_U030
-00002CAC B03C 002D 6880 CMP.b #'-',d0 * compare it with "-"
-00002CB0 6710 6881 BEQ.s LAB_U034 * if "-" go do the sign character
-00002CB2 6882
-00002CB2 B03C 002B 6883 CMP.b #'+',d0 * compare it with "+"
-00002CB6 66C0 6884 BNE.s LAB_U02A * if not "+" go do the next new format character
-00002CB8 6885
-00002CB8 0C12 002D 6886 CMP.b #'-',(a2) * compare the sign character with "-"
-00002CBC 6704 6887 BEQ.s LAB_U034 * if "-" don't change the sign character
-00002CBE 6888
-00002CBE 14BC 002B 6889 MOVE.b #'+',(a2) * else make the sign character "+"
-00002CC2 6890 LAB_U034
-00002CC2 1A00 6891 MOVE.b d0,d5 * set the sign present flag
-00002CC4 4A42 6892 TST.w d2 * test the number string index
-00002CC6 6708 6893 BEQ.s LAB_U038 * if at the sign keep the default character
-00002CC8 6894
-00002CC8 6895 LAB_U036
-00002CC8 1E32 2000 6896 MOVE.b (a2,d2.w),d7 * else get a character from the number string
-00002CCC 5342 6897 SUBQ.w #1,d2 * decrement the number string index
-00002CCE 6008 6898 BRA.s LAB_U03C * go save the character
-00002CD0 6899
-00002CD0 6900 LAB_U038
-00002CD0 4A06 6901 TST.b d6 * test the sign done flag
-00002CD2 6604 6902 BNE.s LAB_U03C * if the sign has been done go use the space
-00002CD4 6903 * character
-00002CD4 6904
-00002CD4 1E12 6905 MOVE.b (a2),d7 * else get the sign character
-00002CD6 1C07 6906 MOVE.b d7,d6 * flag that the sign has been done
-00002CD8 6907 LAB_U03C
-00002CD8 1187 4000 6908 MOVE.b d7,(a0,d4.w) * save the number character to the new format
-00002CDC 6909 * string
-00002CDC 609A 6910 BRA.s LAB_U02A * go do the next new format character
-00002CDE 6911
-00002CDE 6912 * test for overflow conditions
-00002CDE 6913
-00002CDE 6914 LAB_U03E
-00002CDE 4A42 6915 TST.w d2 * test the number string index
-00002CE0 6614 6916 BNE.s LAB_U040 * if all the digits aren't done go output
-00002CE2 6917 * an overflow indication
-00002CE2 6918
-00002CE2 6919 * test for sign overflows
-00002CE2 6920
-00002CE2 4A05 6921 TST.b d5 * test the sign present flag
-00002CE4 6754 6922 BEQ.s LAB_U04A * if no sign present go add the string
-00002CE6 6923
-00002CE6 6924 * there was a sign in the format string
-00002CE6 6925
-00002CE6 4A06 6926 TST.b d6 * test the sign done flag
-00002CE8 6650 6927 BNE.s LAB_U04A * if the sign is done go add the string
-00002CEA 6928
-00002CEA 6929 * the sign isn't done so see if it was mandatory
-00002CEA 6930
-00002CEA 0C05 002B 6931 CMPI.b #'+',d5 * compare the sign with "+"
-00002CEE 6706 6932 BEQ.s LAB_U040 * if it was "+" go output an overflow
-00002CF0 6933 * indication
-00002CF0 6934
-00002CF0 6935 * the sign wasn't mandatory but the number may have been negative
-00002CF0 6936
-00002CF0 0C12 002D 6937 CMP.b #'-',(a2) * compare the sign character with "-"
-00002CF4 6644 6938 BNE.s LAB_U04A * if it wasn't "-" go add the string
-00002CF6 6939
-00002CF6 6940 * else the sign was "-" and a sign hasn't been output so ..
-00002CF6 6941
-00002CF6 6942 * the number overflowed the format string so replace all the special format characters
-00002CF6 6943 * with the overflow character
-00002CF6 6944
-00002CF6 6945 LAB_U040
-00002CF6 7A23 6946 MOVEQ #ofchr,d5 * set the overflow character
-00002CF8 3E01 6947 MOVE.w d1,d7 * copy the new format string length
-00002CFA 5347 6948 SUBQ.w #1,d7 * adjust for the loop type
-00002CFC 3C2F 0004 6949 MOVE.w fsti(sp),d6 * copy the new format string last index
-00002D00 5346 6950 SUBQ.w #1,d6 * -1 gives the last character of this string
-00002D02 6E02 6951 BGT.s LAB_U044 * if not zero continue
-00002D04 6952
-00002D04 3C07 6953 MOVE.w d7,d6 * else set the format string index to the end
-00002D06 6954 LAB_U044
-00002D06 1031 6000 6955 MOVE.b (a1,d6.w),d0 * get a character from the format string
-00002D0A 0C00 0023 6956 CMPI.b #'#',d0 * compare it with "#" special format character
-00002D0E 671E 6957 BEQ.s LAB_U046 * if "#" go use the overflow character
-00002D10 6958
-00002D10 0C00 0025 6959 CMPI.b #'%',d0 * compare it with "%" special format character
-00002D14 6718 6960 BEQ.s LAB_U046 * if "%" go use the overflow character
-00002D16 6961
-00002D16 0C00 002C 6962 CMPI.b #',',d0 * compare it with "," special format character
-00002D1A 6712 6963 BEQ.s LAB_U046 * if "," go use the overflow character
-00002D1C 6964
-00002D1C 0C00 002B 6965 CMPI.b #'+',d0 * compare it with "+" special format character
-00002D20 670C 6966 BEQ.s LAB_U046 * if "+" go use the overflow character
-00002D22 6967
-00002D22 0C00 002D 6968 CMPI.b #'-',d0 * compare it with "-" special format character
-00002D26 6706 6969 BEQ.s LAB_U046 * if "-" go use the overflow character
-00002D28 6970
-00002D28 0C00 002E 6971 CMPI.b #'.',d0 * compare it with "." special format character
-00002D2C 6602 6972 BNE.s LAB_U048 * if not "." skip the using overflow character
-00002D2E 6973
-00002D2E 6974 LAB_U046
-00002D2E 1005 6975 MOVE.b d5,d0 * use the overflow character
-00002D30 6976 LAB_U048
-00002D30 1180 7000 6977 MOVE.b d0,(a0,d7.w) * save the character to the new format string
-00002D34 5346 6978 SUBQ.w #1,d6 * decrement the format string index
-00002D36 51CF FFCE 6979 DBF d7,LAB_U044 * decrement the count and loop if not all done
-00002D3A 6980
-00002D3A 6981 * add the new string to the previous string
-00002D3A 6982
-00002D3A 6983 LAB_U04A
-00002D3A 41EC 0006 6984 LEA 6(a4),a0 * get the descriptor pointer for string 1
-00002D3E 274C 0590 6985 MOVE.l a4,FAC1_m(a3) * save the descriptor pointer for string 2
-00002D42 6100 F010 6986 BSR LAB_224E * concatenate the strings
-00002D46 6987
-00002D46 6988 * now check for any tail on the format string
-00002D46 6989
-00002D46 302F 0004 6990 MOVE.w fsti(sp),d0 * get this index
-00002D4A 6720 6991 BEQ.s LAB_U04C * if at start of string skip the output
-00002D4C 6992
-00002D4C 3F40 0006 6993 MOVE.w d0,fsli(sp) * save this index to the last index
-00002D50 6100 0084 6994 BSR LAB_ProcFo * now process the format string
-00002D54 4A02 6995 TST.b d2 * test the special characters flag
-00002D56 6614 6996 BNE.s LAB_U04C * if special characters present skip the output
-00002D58 6997
-00002D58 6998 * else output the new string part
-00002D58 6999
-00002D58 613E 7000 BSR.s LAB_DupFmt * duplicate the processed format string section
-00002D5A 3F6F 0004 0006 7001 MOVE.w fsti(sp),fsli(sp) * copy this index to the last index
-00002D60 7002
-00002D60 7003 * add the new string to the previous string
-00002D60 7004
-00002D60 41EC 0006 7005 LEA 6(a4),a0 * get the descriptor pointer for string 1
-00002D64 274C 0590 7006 MOVE.l a4,FAC1_m(a3) * save the descriptor pointer for string 2
-00002D68 6100 EFEA 7007 BSR LAB_224E * concatenate the strings
-00002D6C 7008
-00002D6C 7009 * check for another value or end of function
-00002D6C 7010
-00002D6C 7011 LAB_U04C
-00002D6C 101D 7012 MOVE.b (a5)+,d0 * get the next BASIC byte
-00002D6E B03C 0029 7013 CMP.b #')',d0 * compare with close bracket
-00002D72 6600 FDCA 7014 BNE LAB_U002 * if not ")" go do next value
-00002D76 7015
-00002D76 7016 * pop the result string off the descriptor stack
-00002D76 7017
-00002D76 204C 7018 MOVEA.l a4,a0 * copy the result string descriptor pointer
-00002D78 222B 0446 7019 MOVE.l Sstorl(a3),d1 * save the bottom of string space
-00002D7C 6100 F038 7020 BSR LAB_22BA * pop (a0) descriptor, returns with ..
-00002D80 7021 * d0 = length, a0 = pointer
-00002D80 2741 0446 7022 MOVE.l d1,Sstorl(a3) * restore the bottom of string space
-00002D84 2248 7023 MOVEA.l a0,a1 * copy the string result pointer
-00002D86 3200 7024 MOVE.w d0,d1 * copy the string result length
-00002D88 7025
-00002D88 7026 * pop the format string off the descriptor stack
-00002D88 7027
-00002D88 205F 7028 MOVEA.l (sp)+,a0 * pull the format string descriptor pointer
-00002D8A 6100 F02A 7029 BSR LAB_22BA * pop (a0) descriptor, returns with ..
-00002D8E 7030 * d0 = length, a0 = pointer
-00002D8E 7031
-00002D8E 4FEF 0008 7032 LEA fend(sp),sp * dump the saved values
-00002D92 7033
-00002D92 7034 * push the result string back on the descriptor stack and return
-00002D92 7035
-00002D92 2049 7036 MOVEA.l a1,a0 * copy the result string pointer back
-00002D94 6000 EE6E 7037 BRA LAB_RTST * push a string on the descriptor stack and
-00002D98 7038 * return. a0 = pointer, d1 = length
-00002D98 7039
-00002D98 7040
-00002D98 7041 *************************************************************************************
-00002D98 7042 *
-00002D98 7043 * duplicate the processed format string section
-00002D98 7044
-00002D98 7045 * make a string as long as the format string
-00002D98 7046 LAB_DupFmt
-00002D98 226F 0004 7047 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
-00002D9C 3E29 0004 7048 MOVE.w 4(a1),d7 * get the format string length
-00002DA0 342F 000A 7049 MOVE.w 4+fsli(sp),d2 * get the format string last index
-00002DA4 3C2F 0008 7050 MOVE.w 4+fsti(sp),d6 * get the format string this index
-00002DA8 3206 7051 MOVE.w d6,d1 * copy the format string this index
-00002DAA 9242 7052 SUB.w d2,d1 * subtract the format string last index
-00002DAC 6202 7053 BHI.s LAB_D002 * if > 0 skip the correction
-00002DAE 7054
-00002DAE D247 7055 ADD.w d7,d1 * else add the format string length as the
-00002DB0 7056 * correction
-00002DB0 7057 LAB_D002
-00002DB0 6100 EE6C 7058 BSR LAB_2115 * make string space d1 bytes long
-00002DB4 7059 * return a0/Sutill = pointer, others unchanged
-00002DB4 7060
-00002DB4 7061 * push the new string on the descriptor stack
-00002DB4 7062
-00002DB4 6100 EE4E 7063 BSR LAB_RTST * push a string on the descriptor stack and
-00002DB8 7064 * return. a0 = pointer, d1 = length
-00002DB8 7065
-00002DB8 7066 * copy the characters from the format string
-00002DB8 7067
-00002DB8 226F 0004 7068 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
-00002DBC 2251 7069 MOVEA.l (a1),a1 * get the format string pointer
-00002DBE 7800 7070 MOVEQ #0,d4 * clear the new string index
-00002DC0 7071 LAB_D00A
-00002DC0 11B1 2000 4000 7072 MOVE.b (a1,d2.w),(a0,d4.w) * get a character from the format string and
-00002DC6 7073 * save it to the new string
-00002DC6 5244 7074 ADDQ.w #1,d4 * increment the new string index
-00002DC8 5242 7075 ADDQ.w #1,d2 * increment the format string index
-00002DCA BE42 7076 CMP.w d2,d7 * compare the format index with the length
-00002DCC 6602 7077 BNE.s LAB_D00E * if not there skip the reset
-00002DCE 7078
-00002DCE 7400 7079 MOVEQ #0,d2 * else reset the format string index
-00002DD0 7080 LAB_D00E
-00002DD0 BC42 7081 CMP.w d2,d6 * compare the index with this index
-00002DD2 66EC 7082 BNE.s LAB_D00A * if not equal go do the next character
-00002DD4 7083
-00002DD4 4E75 7084 RTS
-00002DD6 7085
-00002DD6 7086
-00002DD6 7087 **************************************************************************************
-00002DD6 7088 *
-00002DD6 7089 * process the format string
-00002DD6 7090
-00002DD6 7091 LAB_ProcFo
-00002DD6 226F 0004 7092 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
-00002DDA 3E29 0004 7093 MOVE.w 4(a1),d7 * get the format string length
-00002DDE 2251 7094 MOVEA.l (a1),a1 * get the format string pointer
-00002DE0 3C2F 000A 7095 MOVE.w 4+fsli(sp),d6 * get the format string last index
-00002DE4 7096
-00002DE4 3F47 000C 7097 MOVE.w d7,4+fsdpi(sp) * set the format string decimal point index
-00002DE8 7098 *## MOVE.w #-1,4+fsdpi(sp) * set the format string decimal point index
-00002DE8 7A00 7099 MOVEQ #0,d5 * no decimal point
-00002DEA 7600 7100 MOVEQ #0,d3 * no decimal characters
-00002DEC 7400 7101 MOVEQ #0,d2 * no special characters
-00002DEE 7102 LAB_P004
-00002DEE 1031 6000 7103 MOVE.b (a1,d6.w),d0 * get a format string byte
-00002DF2 7104
-00002DF2 B03C 002C 7105 CMP.b #',',d0 * compare it with ","
-00002DF6 6742 7106 BEQ.s LAB_P01A * if "," go do the next format string byte
-00002DF8 7107
-00002DF8 B03C 0023 7108 CMP.b #'#',d0 * compare it with "#"
-00002DFC 6706 7109 BEQ.s LAB_P008 * if "#" go flag special characters
-00002DFE 7110
-00002DFE B03C 0025 7111 CMP.b #'%',d0 * compare it with "%"
-00002E02 6608 7112 BNE.s LAB_P00C * if not "%" go try "+"
-00002E04 7113
-00002E04 7114 LAB_P008
-00002E04 4A85 7115 TST.l d5 * test the decimal point flag
-00002E06 6A10 7116 BPL.s LAB_P00E * if no point skip counting decimal characters
-00002E08 7117
-00002E08 5243 7118 ADDQ.w #1,d3 * else increment the decimal character count
-00002E0A 602E 7119 BRA.s LAB_P01A * go do the next character
-00002E0C 7120
-00002E0C 7121 LAB_P00C
-00002E0C B03C 002B 7122 CMP.b #'+',d0 * compare it with "+"
-00002E10 6706 7123 BEQ.s LAB_P00E * if "+" go flag special characters
-00002E12 7124
-00002E12 B03C 002D 7125 CMP.b #'-',d0 * compare it with "-"
-00002E16 6604 7126 BNE.s LAB_P010 * if not "-" go check decimal point
-00002E18 7127
-00002E18 7128 LAB_P00E
-00002E18 8400 7129 OR.b d0,d2 * flag special characters
-00002E1A 601E 7130 BRA.s LAB_P01A * go do the next character
-00002E1C 7131
-00002E1C 7132 LAB_P010
-00002E1C B03C 002E 7133 CMP.b #'.',d0 * compare it with "."
-00002E20 6614 7134 BNE.s LAB_P018 * if not "." go check next
-00002E22 7135
-00002E22 7136 * "." a decimal point
-00002E22 7137
-00002E22 4A85 7138 TST.l d5 * if there is already a decimal point
-00002E24 6B14 7139 BMI.s LAB_P01A * go do the next character
-00002E26 7140
-00002E26 3006 7141 MOVE.w d6,d0 * copy the decimal point index
-00002E28 906F 000A 7142 SUB.w 4+fsli(sp),d0 * calculate it from the scan start
-00002E2C 3F40 000C 7143 MOVE.w d0,4+fsdpi(sp) * save the decimal point index
-00002E30 7AFF 7144 MOVEQ #-1,d5 * flag decimal point
-00002E32 8400 7145 OR.b d0,d2 * flag special characters
-00002E34 6004 7146 BRA.s LAB_P01A * go do the next character
-00002E36 7147
-00002E36 7148 * was not a special character
-00002E36 7149
-00002E36 7150 LAB_P018
-00002E36 4A02 7151 TST.b d2 * test if there have been special characters
-00002E38 6608 7152 BNE.s LAB_P01E * if so exit the format string process
-00002E3A 7153
-00002E3A 7154 LAB_P01A
-00002E3A 5246 7155 ADDQ.w #1,d6 * increment the format string index
-00002E3C BE46 7156 CMP.w d6,d7 * compare it with the format string length
-00002E3E 62AE 7157 BHI.s LAB_P004 * if length > index go get the next character
-00002E40 7158
-00002E40 7C00 7159 MOVEQ #0,d6 * length = index so reset the format string
-00002E42 7160 * index
-00002E42 7161 LAB_P01E
-00002E42 3F46 0008 7162 MOVE.w d6,4+fsti(sp) * save the format string this index
-00002E46 3F43 000E 7163 MOVE.w d3,4+fsdc(sp) * save the format string decimal characters
-00002E4A 7164
-00002E4A 4E75 7165 RTS
-00002E4C 7166
-00002E4C 7167
-00002E4C 7168 *************************************************************************************
-00002E4C 7169 *
-00002E4C 7170 * perform BIN$()
-00002E4C 7171 * # of leading 0s is in d1, the number is in d0
-00002E4C 7172
-00002E4C 7173 LAB_BINS
-00002E4C B23C 0021 7174 CMP.b #$21,d1 * max + 1
-00002E50 6400 DB0C 7175 BCC LAB_FCER * exit if too big ( > or = )
-00002E54 7176
-00002E54 741F 7177 MOVEQ #$1F,d2 * bit count-1
-00002E56 41EB 05B6 7178 LEA Binss(a3),a0 * point to string
-00002E5A 7830 7179 MOVEQ #$30,d4 * "0" character for ADDX
-00002E5C 7180 NextB1
-00002E5C 7600 7181 MOVEQ #0,d3 * clear byte
-00002E5E E288 7182 LSR.l #1,d0 * shift bit into Xb
-00002E60 D704 7183 ADDX.b d4,d3 * add carry and character to zero
-00002E62 1183 2000 7184 MOVE.b d3,(a0,d2.w) * save character to string
-00002E66 51CA FFF4 7185 DBF d2,NextB1 * decrement and loop if not done
-00002E6A 7186
-00002E6A 7187 * this is the exit code and is also used by HEX$()
-00002E6A 7188
-00002E6A 7189 EndBHS
-00002E6A 177C 0000 05D6 7190 MOVE.b #0,BHsend(a3) * null terminate the string
-00002E70 4A01 7191 TST.b d1 * test # of characters
-00002E72 670E 7192 BEQ.s NextB2 * go truncate string
-00002E74 7193
-00002E74 4481 7194 NEG.l d1 * make -ve
-00002E76 0681 000005D6 7195 ADD.l #BHsend,d1 * effectively (end-length)
-00002E7C 41F3 1000 7196 LEA 0(a3,d1.w),a0 * effectively add (end-length) to pointer
-00002E80 600E 7197 BRA.s BinPr * go print string
-00002E82 7198
-00002E82 7199 * truncate string to remove leading "0"s
-00002E82 7200
-00002E82 7201 NextB2
-00002E82 1010 7202 MOVE.b (a0),d0 * get byte
-00002E84 670A 7203 BEQ.s BinPr * if null then end of string so add 1 and go
-00002E86 7204 * print it
-00002E86 7205
-00002E86 B03C 0030 7206 CMP.b #'0',d0 * compare with "0"
-00002E8A 660E 7207 BNE.s GoPr * if not "0" then go print string from here
-00002E8C 7208
-00002E8C 5248 7209 ADDQ.w #1,a0 * else increment pointer
-00002E8E 60F2 7210 BRA.s NextB2 * loop always
-00002E90 7211
-00002E90 7212 * make fixed length output string - ignore overflows!
-00002E90 7213
-00002E90 7214 BinPr
-00002E90 43EB 05D6 7215 LEA BHsend(a3),a1 * get string end
-00002E94 B1C9 7216 CMPA.l a1,a0 * are we at the string end
-00002E96 6602 7217 BNE.s GoPr * branch if not
-00002E98 7218
-00002E98 5348 7219 SUBQ.w #1,a0 * else need at least one zero
-00002E9A 7220 GoPr
-00002E9A 6000 ED22 7221 BRA LAB_20AE * print " terminated string to FAC1, stack & RET
-00002E9E 7222
-00002E9E 7223
-00002E9E 7224 *************************************************************************************
-00002E9E 7225 *
-00002E9E 7226 * perform HEX$()
-00002E9E 7227 * # of leading 0s is in d1, the number is in d0
-00002E9E 7228
-00002E9E 7229 LAB_HEXS
-00002E9E B23C 0009 7230 CMP.b #$09,d1 * max + 1
-00002EA2 6400 DABA 7231 BCC LAB_FCER * exit if too big ( > or = )
-00002EA6 7232
-00002EA6 7407 7233 MOVEQ #$07,d2 * nibble count-1
-00002EA8 41EB 05CE 7234 LEA Hexss(a3),a0 * point to string
-00002EAC 7830 7235 MOVEQ #$30,d4 * "0" character for ABCD
-00002EAE 7236 NextH1
-00002EAE 1600 7237 MOVE.b d0,d3 * copy lowest byte
-00002EB0 E898 7238 ROR.l #4,d0 * shift nibble into 0-3
-00002EB2 C63C 000F 7239 AND.b #$0F,d3 * just this nibble
-00002EB6 1A03 7240 MOVE.b d3,d5 * copy it
-00002EB8 0605 00F6 7241 ADD.b #$F6,d5 * set extend bit
-00002EBC C704 7242 ABCD d4,d3 * decimal add extend and character to zero
-00002EBE 1183 2000 7243 MOVE.b d3,(a0,d2.w) * save character to string
-00002EC2 51CA FFEA 7244 DBF d2,NextH1 * decrement and loop if not done
-00002EC6 7245
-00002EC6 60A2 7246 BRA.s EndBHS * go process string
-00002EC8 7247
-00002EC8 7248
-00002EC8 7249 *************************************************************************************
-00002EC8 7250 *
-00002EC8 7251 * ctrl-c check routine. includes limited "life" byte save for INGET routine
-00002EC8 7252
-00002EC8 7253 VEC_CC
-00002EC8 4A2B 05E8 7254 TST.b ccflag(a3) * check [CTRL-C] check flag
-00002ECC 661E 7255 BNE.s RTS_022 * exit if [CTRL-C] check inhibited
-00002ECE 7256
-00002ECE 4EAB 040C 7257 JSR V_INPT(a3) * scan input device
-00002ED2 640E 7258 BCC.s LAB_FBA0 * exit if buffer empty
-00002ED4 7259
-00002ED4 1740 05E9 7260 MOVE.b d0,ccbyte(a3) * save received byte
-00002ED8 177C 0020 05EA 7261 MOVE.b #$20,ccnull(a3) * set "life" timer for bytes countdown
-00002EDE 6000 DEF2 7262 BRA LAB_1636 * return to BASIC
-00002EE2 7263
-00002EE2 7264 LAB_FBA0
-00002EE2 4A2B 05EA 7265 TST.b ccnull(a3) * get countdown byte
-00002EE6 6704 7266 BEQ.s RTS_022 * exit if finished
-00002EE8 7267
-00002EE8 532B 05EA 7268 SUBQ.b #1,ccnull(a3) * else decrement countdown
-00002EEC 7269 RTS_022
-00002EEC 4E75 7270 RTS
-00002EEE 7271
-00002EEE 7272
-00002EEE 7273 *************************************************************************************
-00002EEE 7274 *
-00002EEE 7275 * get byte from input device, no waiting
-00002EEE 7276 * returns with carry set if byte in A
-00002EEE 7277
-00002EEE 7278 INGET
-00002EEE 4EAB 040C 7279 JSR V_INPT(a3) * call scan input device
-00002EF2 650A 7280 BCS.s LAB_FB95 * if byte go reset timer
-00002EF4 7281
-00002EF4 102B 05EA 7282 MOVE.b ccnull(a3),d0 * get countdown
-00002EF8 67F2 7283 BEQ.s RTS_022 * exit if empty
-00002EFA 7284
-00002EFA 102B 05E9 7285 MOVE.b ccbyte(a3),d0 * get last received byte
-00002EFE 7286 LAB_FB95
-00002EFE 177C 0000 05EA 7287 MOVE.b #$00,ccnull(a3) * clear timer because we got a byte
-00002F04 003C 0001 7288 ORI.b #1,CCR * set carry, flag we got a byte
-00002F08 4E75 7289 RTS
-00002F0A 7290
-00002F0A 7291
-00002F0A 7292 *************************************************************************************
-00002F0A 7293 *
-00002F0A 7294 * perform MAX()
-00002F0A 7295
-00002F0A 7296 LAB_MAX
-00002F0A 6100 E53E 7297 BSR LAB_EVEZ * evaluate expression (no decrement)
-00002F0E 4A2B 05B5 7298 TST.b Dtypef(a3) * test data type
-00002F12 6B00 DA2A 7299 BMI LAB_TMER * if string do Type missmatch Error/warm start
-00002F16 7300
-00002F16 7301 LAB_MAXN
-00002F16 612E 7302 BSR.s LAB_PHFA * push FAC1, evaluate expression,
-00002F18 7303 * pull FAC2 & compare with FAC1
-00002F18 64FC 7304 BCC.s LAB_MAXN * branch if no swap to do
-00002F1A 7305
-00002F1A 6100 F4AA 7306 BSR LAB_279B * copy FAC2 to FAC1
-00002F1E 60F6 7307 BRA.s LAB_MAXN * go do next
-00002F20 7308
-00002F20 7309
-00002F20 7310 *************************************************************************************
-00002F20 7311 *
-00002F20 7312 * perform MIN()
-00002F20 7313
-00002F20 7314 LAB_MIN
-00002F20 6100 E528 7315 BSR LAB_EVEZ * evaluate expression (no decrement)
-00002F24 4A2B 05B5 7316 TST.b Dtypef(a3) * test data type
-00002F28 6B00 DA14 7317 BMI LAB_TMER * if string do Type missmatch Error/warm start
-00002F2C 7318
-00002F2C 7319 LAB_MINN
-00002F2C 6118 7320 BSR.s LAB_PHFA * push FAC1, evaluate expression,
-00002F2E 7321 * pull FAC2 & compare with FAC1
-00002F2E 63FC 7322 BLS.s LAB_MINN * branch if no swap to do
-00002F30 7323
-00002F30 6100 F494 7324 BSR LAB_279B * copy FAC2 to FAC1
-00002F34 60F6 7325 BRA.s LAB_MINN * go do next (branch always)
-00002F36 7326
-00002F36 7327 * exit routine. don't bother returning to the loop code
-00002F36 7328 * check for correct exit, else so syntax error
-00002F36 7329
-00002F36 7330 LAB_MMEC
-00002F36 B03C 0029 7331 CMP.b #')',d0 * is it end of function?
-00002F3A 6600 DA2E 7332 BNE LAB_SNER * if not do MAX MIN syntax error
-00002F3E 7333
-00002F3E 4FEF 0004 7334 LEA 4(sp),sp * dump return address (faster)
-00002F42 6000 E664 7335 BRA LAB_IGBY * update BASIC execute pointer (to chr past ")")
-00002F46 7336 * and return
-00002F46 7337
-00002F46 7338 * check for next, evaluate & return or exit
-00002F46 7339 * this is the routine that does most of the work
-00002F46 7340
-00002F46 7341 LAB_PHFA
-00002F46 6100 E662 7342 BSR LAB_GBYT * get next BASIC byte
-00002F4A B03C 002C 7343 CMP.b #',',d0 * is there more ?
-00002F4E 66E6 7344 BNE.s LAB_MMEC * if not go do end check
-00002F50 7345
-00002F50 3F2B 0594 7346 MOVE.w FAC1_e(a3),-(sp) * push exponent and sign
-00002F54 2F2B 0590 7347 MOVE.l FAC1_m(a3),-(sp) * push mantissa
-00002F58 7348
-00002F58 6100 E4F0 7349 BSR LAB_EVEZ * evaluate expression (no decrement)
-00002F5C 4A2B 05B5 7350 TST.b Dtypef(a3) * test data type
-00002F60 6B00 D9DC 7351 BMI LAB_TMER * if string do Type missmatch Error/warm start
-00002F64 7352
-00002F64 7353
-00002F64 7354 * pop FAC2 (MAX/MIN expression so far)
-00002F64 275F 0598 7355 MOVE.l (sp)+,FAC2_m(a3) * pop mantissa
-00002F68 7356
-00002F68 301F 7357 MOVE.w (sp)+,d0 * pop exponent and sign
-00002F6A 3740 059C 7358 MOVE.w d0,FAC2_e(a3) * save exponent and sign
-00002F6E 176B 0595 059E 7359 MOVE.b FAC1_s(a3),FAC_sc(a3) * get FAC1 sign
-00002F74 B12B 059E 7360 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
-00002F78 6000 F4B8 7361 BRA LAB_27FA * compare FAC1 with FAC2 & return
-00002F7C 7362 * returns d0=+1 Cb=0 if FAC1 > FAC2
-00002F7C 7363 * returns d0= 0 Cb=0 if FAC1 = FAC2
-00002F7C 7364 * returns d0=-1 Cb=1 if FAC1 < FAC2
-00002F7C 7365
-00002F7C 7366
-00002F7C 7367 *************************************************************************************
-00002F7C 7368 *
-00002F7C 7369 * perform WIDTH
-00002F7C 7370
-00002F7C 7371 LAB_WDTH
-00002F7C B03C 002C 7372 CMP.b #',',d0 * is next byte ","
-00002F80 672C 7373 BEQ.s LAB_TBSZ * if so do tab size
-00002F82 7374
-00002F82 6100 EF8E 7375 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
-00002F86 4A00 7376 TST.b d0 * test result
-00002F88 6712 7377 BEQ.s LAB_NSTT * branch if set for infinite line
-00002F8A 7378
-00002F8A B03C 0010 7379 CMP.b #$10,d0 * else make min width = 16d
-00002F8E 6500 D9CE 7380 BCS LAB_FCER * if less do function call error & exit
-00002F92 7381
-00002F92 7382 * this next compare ensures that we can't exit WIDTH via an error leaving the
-00002F92 7383 * tab size greater than the line length.
-00002F92 7384
-00002F92 B02B 05E2 7385 CMP.b TabSiz(a3),d0 * compare with tab size
-00002F96 6404 7386 BCC.s LAB_NSTT * branch if >= tab size
-00002F98 7387
-00002F98 1740 05E2 7388 MOVE.b d0,TabSiz(a3) * else make tab size = terminal width
-00002F9C 7389 LAB_NSTT
-00002F9C 1740 05E6 7390 MOVE.b d0,TWidth(a3) * set the terminal width
-00002FA0 6100 E608 7391 BSR LAB_GBYT * get BASIC byte back
-00002FA4 672C 7392 BEQ.s WExit * exit if no following
-00002FA6 7393
-00002FA6 B03C 002C 7394 CMP.b #',',d0 * else is it ","
-00002FAA 6600 D9BE 7395 BNE LAB_SNER * if not do syntax error
-00002FAE 7396
-00002FAE 7397 LAB_TBSZ
-00002FAE 6100 EF5E 7398 BSR LAB_SGBY * increment and get byte, result in d0 and Itemp
-00002FB2 4A00 7399 TST.b d0 * test TAB size
-00002FB4 6B00 D9A8 7400 BMI LAB_FCER * if >127 do function call error & exit
-00002FB8 7401
-00002FB8 B03C 0001 7402 CMP.b #1,d0 * compare with min-1
-00002FBC 6500 D9A0 7403 BCS LAB_FCER * if <=1 do function call error & exit
-00002FC0 7404
-00002FC0 122B 05E6 7405 MOVE.b TWidth(a3),d1 * set flags for width
-00002FC4 6708 7406 BEQ.s LAB_SVTB * skip check if infinite line
-00002FC6 7407
-00002FC6 B02B 05E6 7408 CMP.b TWidth(a3),d0 * compare TAB with width
-00002FCA 6E00 D992 7409 BGT LAB_FCER * branch if too big
-00002FCE 7410
-00002FCE 7411 LAB_SVTB
-00002FCE 1740 05E2 7412 MOVE.b d0,TabSiz(a3) * save TAB size
-00002FD2 7413
-00002FD2 7414 * calculate tab column limit from TAB size. The Iclim is set to the last tab
-00002FD2 7415 * position on a line that still has at least one whole tab width between it
-00002FD2 7416 * and the end of the line.
-00002FD2 7417
-00002FD2 7418 WExit
-00002FD2 102B 05E6 7419 MOVE.b TWidth(a3),d0 * get width
-00002FD6 670A 7420 BEQ.s LAB_WDLP * branch if infinite line
-00002FD8 7421
-00002FD8 B02B 05E2 7422 CMP.b TabSiz(a3),d0 * compare with tab size
-00002FDC 6404 7423 BCC.s LAB_WDLP * branch if >= tab size
-00002FDE 7424
-00002FDE 1740 05E2 7425 MOVE.b d0,TabSiz(a3) * else make tab size = terminal width
-00002FE2 7426 LAB_WDLP
-00002FE2 902B 05E2 7427 SUB.b TabSiz(a3),d0 * subtract tab size
-00002FE6 64FA 7428 BCC.s LAB_WDLP * loop while no borrow
-00002FE8 7429
-00002FE8 D02B 05E2 7430 ADD.b TabSiz(a3),d0 * add tab size back
-00002FEC D02B 05E2 7431 ADD.b TabSiz(a3),d0 * add tab size back again
-00002FF0 7432
-00002FF0 4400 7433 NEG.b d0 * make -ve
-00002FF2 D02B 05E6 7434 ADD.b TWidth(a3),d0 * subtract remainder from width
-00002FF6 1740 05E7 7435 MOVE.b d0,Iclim(a3) * save tab column limit
-00002FFA 7436 RTS_023
-00002FFA 4E75 7437 RTS
-00002FFC 7438
-00002FFC 7439
-00002FFC 7440 *************************************************************************************
-00002FFC 7441 *
-00002FFC 7442 * perform SQR()
-00002FFC 7443
-00002FFC 7444 * d0 is number to find the root of
-00002FFC 7445 * d1 is the root result
-00002FFC 7446 * d2 is the remainder
-00002FFC 7447 * d3 is a counter
-00002FFC 7448 * d4 is temp
-00002FFC 7449
-00002FFC 7450 LAB_SQR
-00002FFC 4A2B 0595 7451 TST.b FAC1_s(a3) * test FAC1 sign
-00003000 6B00 D95C 7452 BMI LAB_FCER * if -ve do function call error
-00003004 7453
-00003004 4A2B 0594 7454 TST.b FAC1_e(a3) * test exponent
-00003008 67F0 7455 BEQ.s RTS_023 * exit if zero
-0000300A 7456
-0000300A 48E7 7800 7457 MOVEM.l d1-d4,-(sp) * save registers
-0000300E 202B 0590 7458 MOVE.l FAC1_m(a3),d0 * copy FAC1
-00003012 7400 7459 MOVEQ #0,d2 * clear remainder
-00003014 2202 7460 MOVE.l d2,d1 * clear root
-00003016 7461
-00003016 761F 7462 MOVEQ #$1F,d3 * $1F for DBF, 64 pairs of bits to
-00003018 7463 * do for a 32 bit result
-00003018 082B 0000 0594 7464 BTST #0,FAC1_e(a3) * test exponent odd/even
-0000301E 6606 7465 BNE.s LAB_SQE2 * if odd only 1 shift first time
-00003020 7466
-00003020 7467 LAB_SQE1
-00003020 D080 7468 ADD.l d0,d0 * shift highest bit of number ..
-00003022 D582 7469 ADDX.l d2,d2 * .. into remainder .. never overflows
-00003024 D281 7470 ADD.l d1,d1 * root = root * 2 .. never overflows
-00003026 7471 LAB_SQE2
-00003026 D080 7472 ADD.l d0,d0 * shift highest bit of number ..
-00003028 D582 7473 ADDX.l d2,d2 * .. into remainder .. never overflows
-0000302A 7474
-0000302A 2801 7475 MOVE.l d1,d4 * copy root
-0000302C D884 7476 ADD.l d4,d4 * 2n
-0000302E 5284 7477 ADDQ.l #1,d4 * 2n+1
-00003030 7478
-00003030 B484 7479 CMP.l d4,d2 * compare 2n+1 to remainder
-00003032 6504 7480 BCS.s LAB_SQNS * skip sub if remainder smaller
-00003034 7481
-00003034 9484 7482 SUB.l d4,d2 * subtract temp from remainder
-00003036 5281 7483 ADDQ.l #1,d1 * increment root
-00003038 7484 LAB_SQNS
-00003038 51CB FFE6 7485 DBF d3,LAB_SQE1 * loop if not all done
-0000303C 7486
-0000303C 2741 0590 7487 MOVE.l d1,FAC1_m(a3) * save result mantissa
-00003040 102B 0594 7488 MOVE.b FAC1_e(a3),d0 * get exponent (d0 is clear here)
-00003044 0440 0080 7489 SUB.w #$80,d0 * normalise
-00003048 E248 7490 LSR.w #1,d0 * /2
-0000304A 6402 7491 BCC.s LAB_SQNA * skip increment if carry clear
-0000304C 7492
-0000304C 5240 7493 ADDQ.w #1,d0 * add bit zero back in (allow for half shift)
-0000304E 7494 LAB_SQNA
-0000304E 0640 0080 7495 ADD.w #$80,d0 * re-bias to $80
-00003052 1740 0594 7496 MOVE.b d0,FAC1_e(a3) * save it
-00003056 4CDF 001E 7497 MOVEM.l (sp)+,d1-d4 * restore registers
-0000305A 6000 F0A8 7498 BRA LAB_24D5 * normalise FAC1 & return
-0000305E 7499
-0000305E 7500
-0000305E 7501 *************************************************************************************
-0000305E 7502 *
-0000305E 7503 * perform VARPTR()
-0000305E 7504
-0000305E 7505 LAB_VARPTR
-0000305E 101D 7506 MOVE.b (a5)+,d0 * increment pointer
-00003060 7507 LAB_VARCALL
-00003060 6100 E756 7508 BSR LAB_GVAR * get variable address in a0
-00003064 6100 E530 7509 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
-00003068 2008 7510 MOVE.l a0,d0 * copy the variable address
-0000306A 6000 EA3C 7511 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-0000306E 7512
-0000306E 7513
-0000306E 7514 *************************************************************************************
-0000306E 7515 *
-0000306E 7516 * perform RAMBASE
-0000306E 7517
-0000306E 7518 LAB_RAM
-0000306E 41EB 0400 7519 LEA ram_base(a3),a0 * get start of EhBASIC RAM
-00003072 2008 7520 MOVE.l a0,d0 * copy it
-00003074 6000 EA32 7521 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
-00003078 7522
-00003078 7523
-00003078 7524 *************************************************************************************
-00003078 7525 *
-00003078 7526 * perform PI
-00003078 7527
-00003078 7528 LAB_PI
-00003078 277C C90FDAA2 0590 7529 MOVE.l #$C90FDAA2,FAC1_m(a3) * pi mantissa (32 bit)
-00003080 377C 8200 0594 7530 MOVE.w #$8200,FAC1_e(a3) * pi exponent and sign
-00003086 4E75 7531 RTS
-00003088 7532
-00003088 7533
-00003088 7534 *************************************************************************************
-00003088 7535 *
-00003088 7536 * perform TWOPI
-00003088 7537
-00003088 7538 LAB_TWOPI
-00003088 277C C90FDAA2 0590 7539 MOVE.l #$C90FDAA2,FAC1_m(a3) * 2pi mantissa (32 bit)
-00003090 377C 8300 0594 7540 MOVE.w #$8300,FAC1_e(a3) * 2pi exponent and sign
-00003096 4E75 7541 RTS
-00003098 7542
-00003098 7543
-00003098 7544 *************************************************************************************
-00003098 7545 *
-00003098 7546 * get ASCII string equivalent into FAC1 as integer32 or float
-00003098 7547
-00003098 7548 * entry is with a5 pointing to the first character of the string
-00003098 7549 * exit with a5 pointing to the first character after the string
-00003098 7550
-00003098 7551 * d0 is character
-00003098 7552 * d1 is mantissa
-00003098 7553 * d2 is partial and table mantissa
-00003098 7554 * d3 is mantissa exponent (decimal & binary)
-00003098 7555 * d4 is decimal exponent
-00003098 7556
-00003098 7557 * get FAC1 from string
-00003098 7558 * this routine now handles hex and binary values from strings
-00003098 7559 * starting with "$" and "%" respectively
-00003098 7560
-00003098 7561 LAB_2887
-00003098 48E7 7C00 7562 MOVEM.l d1-d5,-(sp) * save registers
-0000309C 7200 7563 MOVEQ #$00,d1 * clear temp accumulator
-0000309E 2601 7564 MOVE.l d1,d3 * set mantissa decimal exponent count
-000030A0 2801 7565 MOVE.l d1,d4 * clear decimal exponent
-000030A2 1741 0595 7566 MOVE.b d1,FAC1_s(a3) * clear sign byte
-000030A6 1741 05B5 7567 MOVE.b d1,Dtypef(a3) * set float data type
-000030AA 1741 05AF 7568 MOVE.b d1,expneg(a3) * clear exponent sign
-000030AE 6100 E4FA 7569 BSR LAB_GBYT * get first byte back
-000030B2 653C 7570 BCS.s LAB_28FE * go get floating if 1st character numeric
-000030B4 7571
-000030B4 B03C 002D 7572 CMP.b #'-',d0 * or is it -ve number
-000030B8 6608 7573 BNE.s LAB_289A * branch if not
-000030BA 7574
-000030BA 177C 00FF 0595 7575 MOVE.b #$FF,FAC1_s(a3) * set sign byte
-000030C0 6006 7576 BRA.s LAB_289C * now go scan & check for hex/bin/int
-000030C2 7577
-000030C2 7578 LAB_289A
-000030C2 7579 * first character wasn't numeric or -
-000030C2 B03C 002B 7580 CMP.b #'+',d0 * compare with '+'
-000030C6 6606 7581 BNE.s LAB_289D * branch if not '+' (go check for '.'/hex/binary
-000030C8 7582 * /integer)
-000030C8 7583
-000030C8 7584 LAB_289C
-000030C8 7585 * was "+" or "-" to start, so get next character
-000030C8 6100 E4DE 7586 BSR LAB_IGBY * increment & scan memory
-000030CC 6522 7587 BCS.s LAB_28FE * branch if numeric character
-000030CE 7588
-000030CE 7589 LAB_289D
-000030CE B03C 002E 7590 CMP.b #'.',d0 * else compare with '.'
-000030D2 6700 0092 7591 BEQ LAB_2904 * branch if '.'
-000030D6 7592
-000030D6 7593 * code here for hex/binary/integer numbers
-000030D6 B03C 0024 7594 CMP.b #'$',d0 * compare with '$'
-000030DA 6700 010A 7595 BEQ LAB_CHEX * branch if '$'
-000030DE 7596
-000030DE B03C 0025 7597 CMP.b #'%',d0 * else compare with '%'
-000030E2 6700 0164 7598 BEQ LAB_CBIN * branch if '%'
-000030E6 7599
-000030E6 6000 008C 7600 BRA LAB_2Y01 * not #.$%& so return 0
-000030EA 7601
-000030EA 7602 LAB_28FD
-000030EA 6100 E4BC 7603 BSR LAB_IGBY * get next character
-000030EE 646C 7604 BCC.s LAB_2902 * exit loop if not a digit
-000030F0 7605
-000030F0 7606 LAB_28FE
-000030F0 6100 01A8 7607 BSR d1x10 * multiply d1 by 10 and add character
-000030F4 64F4 7608 BCC.s LAB_28FD * loop for more if no overflow
-000030F6 7609
-000030F6 7610 LAB_28FF
-000030F6 7611 * overflowed mantissa, count 10s exponent
-000030F6 5283 7612 ADDQ.l #1,d3 * increment mantissa decimal exponent count
-000030F8 6100 E4AE 7613 BSR LAB_IGBY * get next character
-000030FC 65F8 7614 BCS.s LAB_28FF * loop while numeric character
-000030FE 7615
-000030FE 7616 * done overflow, now flush fraction or do E
-000030FE B03C 002E 7617 CMP.b #'.',d0 * else compare with '.'
-00003102 6606 7618 BNE.s LAB_2901 * branch if not '.'
-00003104 7619
-00003104 7620 LAB_2900
-00003104 7621 * flush remaining fraction digits
-00003104 6100 E4A2 7622 BSR LAB_IGBY * get next character
-00003108 65FA 7623 BCS LAB_2900 * loop while numeric character
-0000310A 7624
-0000310A 7625 LAB_2901
-0000310A 7626 * done number, only (possible) exponent remains
-0000310A B03C 0045 7627 CMP.b #'E',d0 * else compare with 'E'
-0000310E 6664 7628 BNE.s LAB_2Y01 * if not 'E' all done, go evaluate
-00003110 7629
-00003110 7630 * process exponent
-00003110 6100 E496 7631 BSR LAB_IGBY * get next character
-00003114 6528 7632 BCS.s LAB_2X04 * branch if digit
-00003116 7633
-00003116 B03C 002D 7634 CMP.b #'-',d0 * or is it -ve number
-0000311A 6706 7635 BEQ.s LAB_2X01 * branch if so
-0000311C 7636
-0000311C B03C 00B3 7637 CMP.b #TK_MINUS,d0 * or is it -ve number
-00003120 6608 7638 BNE.s LAB_2X02 * branch if not
-00003122 7639
-00003122 7640 LAB_2X01
-00003122 177C 00FF 05AF 7641 MOVE.b #$FF,expneg(a3) * set exponent sign
-00003128 600E 7642 BRA.s LAB_2X03 * now go scan & check exponent
-0000312A 7643
-0000312A 7644 LAB_2X02
-0000312A B03C 002B 7645 CMP.b #'+',d0 * or is it +ve number
-0000312E 6708 7646 BEQ.s LAB_2X03 * branch if so
-00003130 7647
-00003130 B03C 00B2 7648 CMP.b #TK_PLUS,d0 * or is it +ve number
-00003134 6600 D834 7649 BNE LAB_SNER * wasn't - + TK_MINUS TK_PLUS or # so do error
-00003138 7650
-00003138 7651 LAB_2X03
-00003138 6100 E46E 7652 BSR LAB_IGBY * get next character
-0000313C 6436 7653 BCC.s LAB_2Y01 * if not digit all done, go evaluate
-0000313E 7654 LAB_2X04
-0000313E C8FC 000A 7655 MULU #10,d4 * multiply decimal exponent by 10
-00003142 C0BC 000000FF 7656 AND.l #$FF,d0 * mask character
-00003148 0400 0030 7657 SUB.b #'0',d0 * convert to value
-0000314C D880 7658 ADD.l d0,d4 * add to decimal exponent
-0000314E B83C 0030 7659 CMP.b #48,d4 * compare with decimal exponent limit+10
-00003152 6FE4 7660 BLE.s LAB_2X03 * loop if no overflow/underflow
-00003154 7661
-00003154 7662 LAB_2X05
-00003154 7663 * exponent value has overflowed
-00003154 6100 E452 7664 BSR LAB_IGBY * get next character
-00003158 65FA 7665 BCS.s LAB_2X05 * loop while numeric digit
-0000315A 7666
-0000315A 6018 7667 BRA.s LAB_2Y01 * all done, go evaluate
-0000315C 7668
-0000315C 7669 LAB_2902
-0000315C B03C 002E 7670 CMP.b #'.',d0 * else compare with '.'
-00003160 6704 7671 BEQ.s LAB_2904 * branch if was '.'
-00003162 7672
-00003162 60A6 7673 BRA.s LAB_2901 * branch if not '.' (go check/do 'E')
-00003164 7674
-00003164 7675 LAB_2903
-00003164 5383 7676 SUBQ.l #1,d3 * decrement mantissa decimal exponent
-00003166 7677 LAB_2904
-00003166 7678 * was dp so get fraction part
-00003166 6100 E440 7679 BSR LAB_IGBY * get next character
-0000316A 649E 7680 BCC.s LAB_2901 * exit loop if not a digit (go check/do 'E')
-0000316C 7681
-0000316C 6100 012C 7682 BSR d1x10 * multiply d1 by 10 and add character
-00003170 64F2 7683 BCC.s LAB_2903 * loop for more if no overflow
-00003172 7684
-00003172 6090 7685 BRA.s LAB_2900 * else go flush remaining fraction part
-00003174 7686
-00003174 7687 LAB_2Y01
-00003174 7688 * now evaluate result
-00003174 4A2B 05AF 7689 TST.b expneg(a3) * test exponent sign
-00003178 6A02 7690 BPL.s LAB_2Y02 * branch if sign positive
-0000317A 7691
-0000317A 4484 7692 NEG.l d4 * negate decimal exponent
-0000317C 7693 LAB_2Y02
-0000317C D883 7694 ADD.l d3,d4 * add mantissa decimal exponent
-0000317E 7620 7695 MOVEQ #32,d3 * set up max binary exponent
-00003180 4A81 7696 TST.l d1 * test mantissa
-00003182 6752 7697 BEQ.s LAB_rtn0 * if mantissa=0 return 0
-00003184 7698
-00003184 6B08 7699 BMI.s LAB_2Y04 * branch if already mormalised
-00003186 7700
-00003186 5383 7701 SUBQ.l #1,d3 * decrement bianry exponent for DBMI loop
-00003188 7702 LAB_2Y03
-00003188 D281 7703 ADD.l d1,d1 * shift mantissa
-0000318A 5BCB FFFC 7704 DBMI d3,LAB_2Y03 * decrement & loop if not normalised
-0000318E 7705
-0000318E 7706 * ensure not too big or small
-0000318E 7707 LAB_2Y04
-0000318E B8BC 00000026 7708 CMP.l #38,d4 * compare decimal exponent with max exponent
-00003194 6E00 D7C4 7709 BGT LAB_OFER * if greater do overflow error and warm start
-00003198 7710
-00003198 B8BC FFFFFFDA 7711 CMP.l #-38,d4 * compare decimal exponent with min exponent
-0000319E 6D34 7712 BLT.s LAB_ret0 * if less just return zero
-000031A0 7713
-000031A0 4484 7714 NEG.l d4 * negate decimal exponent to go right way
-000031A2 C9FC 0006 7715 MULS #6,d4 * 6 bytes per entry
-000031A6 2F08 7716 MOVE.l a0,-(sp) * save register
-000031A8 41FA 0210 7717 LEA LAB_P_10(pc),a0 * point to table
-000031AC 1770 4000 059C 7718 MOVE.b (a0,d4.w),FAC2_e(a3) * copy exponent for multiply
-000031B2 2770 4002 0598 7719 MOVE.l 2(a0,d4.w),FAC2_m(a3) * copy table mantissa
-000031B8 205F 7720 MOVE.l (sp)+,a0 * restore register
-000031BA 7721
-000031BA 0A03 0080 7722 EORI.b #$80,d3 * normalise input exponent
-000031BE 2741 0590 7723 MOVE.l d1,FAC1_m(a3) * save input mantissa
-000031C2 1743 0594 7724 MOVE.b d3,FAC1_e(a3) * save input exponent
-000031C6 176B 0595 059E 7725 MOVE.b FAC1_s(a3),FAC_sc(a3) * set sign as sign compare
-000031CC 7726
-000031CC 4CDF 003E 7727 MOVEM.l (sp)+,d1-d5 * restore registers
-000031D0 6000 F05A 7728 BRA LAB_MULTIPLY * go multiply input by table
-000031D4 7729
-000031D4 7730 LAB_ret0
-000031D4 7200 7731 MOVEQ #0,d1 * clear mantissa
-000031D6 7732 LAB_rtn0
-000031D6 2601 7733 MOVE.l d1,d3 * clear exponent
-000031D8 1743 0594 7734 MOVE.b d3,FAC1_e(a3) * save exponent
-000031DC 2741 0590 7735 MOVE.l d1,FAC1_m(a3) * save mantissa
-000031E0 4CDF 003E 7736 MOVEM.l (sp)+,d1-d5 * restore registers
-000031E4 4E75 7737 RTS
-000031E6 7738
-000031E6 7739
-000031E6 7740 *************************************************************************************
-000031E6 7741 *
-000031E6 7742 * $ for hex add-on
-000031E6 7743
-000031E6 7744 * gets here if the first character was "$" for hex
-000031E6 7745 * get hex number
-000031E6 7746
-000031E6 7747 LAB_CHEX
-000031E6 177C 0040 05B5 7748 MOVE.b #$40,Dtypef(a3) * set integer numeric data type
-000031EC 7620 7749 MOVEQ #32,d3 * set up max binary exponent
-000031EE 7750 LAB_CHXX
-000031EE 6100 E3B8 7751 BSR LAB_IGBY * increment & scan memory
-000031F2 6514 7752 BCS.s LAB_ISHN * branch if numeric character
-000031F4 7753
-000031F4 803C 0020 7754 OR.b #$20,d0 * case convert, allow "A" to "F" and "a" to "f"
-000031F8 0400 0061 7755 SUB.b #'a',d0 * subtract "a"
-000031FC 652A 7756 BCS.s LAB_CHX3 * exit if <"a"
-000031FE 7757
-000031FE B03C 0006 7758 CMP.b #$06,d0 * compare normalised with $06 (max+1)
-00003202 6424 7759 BCC.s LAB_CHX3 * exit if >"f"
-00003204 7760
-00003204 0600 003A 7761 ADD.b #$3A,d0 * convert to nibble+"0"
-00003208 7762 LAB_ISHN
-00003208 616C 7763 BSR.s d1x16 * multiply d1 by 16 and add the character
-0000320A 64E2 7764 BCC.s LAB_CHXX * loop for more if no overflow
-0000320C 7765
-0000320C 7766 * overflowed mantissa, count 16s exponent
-0000320C 7767 LAB_CHX1
-0000320C 5883 7768 ADDQ.l #4,d3 * increment mantissa exponent count
-0000320E 6900 D74A 7769 BVS LAB_OFER * do overflow error if overflowed
-00003212 7770
-00003212 6100 E394 7771 BSR LAB_IGBY * get next character
-00003216 65F4 7772 BCS.s LAB_CHX1 * loop while numeric character
-00003218 7773
-00003218 803C 0020 7774 OR.b #$20,d0 * case convert, allow "A" to "F" and "a" to "f"
-0000321C 0400 0061 7775 SUB.b #'a',d0 * subtract "a"
-00003220 6506 7776 BCS.s LAB_CHX3 * exit if <"a"
-00003222 7777
-00003222 B03C 0006 7778 CMP.b #$06,d0 * compare normalised with $06 (max+1)
-00003226 65E4 7779 BCS.s LAB_CHX1 * loop if <="f"
-00003228 7780
-00003228 7781 * now return value
-00003228 7782 LAB_CHX3
-00003228 4A81 7783 TST.l d1 * test mantissa
-0000322A 67AA 7784 BEQ.s LAB_rtn0 * if mantissa=0 return 0
-0000322C 7785
-0000322C 6B08 7786 BMI.s LAB_exxf * branch if already mormalised
-0000322E 7787
-0000322E 5383 7788 SUBQ.l #1,d3 * decrement bianry exponent for DBMI loop
-00003230 7789 LAB_CHX2
-00003230 D281 7790 ADD.l d1,d1 * shift mantissa
-00003232 5BCB FFFC 7791 DBMI d3,LAB_CHX2 * decrement & loop if not normalised
-00003236 7792
-00003236 7793 LAB_exxf
-00003236 0A03 0080 7794 EORI.b #$80,d3 * normalise exponent
-0000323A 1743 0594 7795 MOVE.b d3,FAC1_e(a3) * save exponent
-0000323E 2741 0590 7796 MOVE.l d1,FAC1_m(a3) * save mantissa
-00003242 4CDF 003E 7797 MOVEM.l (sp)+,d1-d5 * restore registers
-00003246 7798 RTS_024
-00003246 4E75 7799 RTS
-00003248 7800
-00003248 7801
-00003248 7802 *************************************************************************************
-00003248 7803 *
-00003248 7804 * % for binary add-on
-00003248 7805
-00003248 7806 * gets here if the first character was "%" for binary
-00003248 7807 * get binary number
-00003248 7808
-00003248 7809 LAB_CBIN
-00003248 177C 0040 05B5 7810 MOVE.b #$40,Dtypef(a3) * set integer numeric data type
-0000324E 7620 7811 MOVEQ #32,d3 * set up max binary exponent
-00003250 7812 LAB_CBXN
-00003250 6100 E356 7813 BSR LAB_IGBY * increment & scan memory
-00003254 64D2 7814 BCC.s LAB_CHX3 * if not numeric character go return value
-00003256 7815
-00003256 B03C 0032 7816 CMP.b #'2',d0 * compare with "2" (max+1)
-0000325A 64CC 7817 BCC.s LAB_CHX3 * if >="2" go return value
-0000325C 7818
-0000325C 2401 7819 MOVE.l d1,d2 * copy value
-0000325E 6124 7820 BSR.s d1x02 * multiply d1 by 2 and add character
-00003260 64EE 7821 BCC.s LAB_CBXN * loop for more if no overflow
-00003262 7822
-00003262 7823 * overflowed mantissa, count 2s exponent
-00003262 7824 LAB_CBX1
-00003262 5283 7825 ADDQ.l #1,d3 * increment mantissa exponent count
-00003264 6900 D6F4 7826 BVS LAB_OFER * do overflow error if overflowed
-00003268 7827
-00003268 6100 E33E 7828 BSR LAB_IGBY * get next character
-0000326C 64BA 7829 BCC.s LAB_CHX3 * if not numeric character go return value
-0000326E 7830
-0000326E B03C 0032 7831 CMP.b #'2',d0 * compare with "2" (max+1)
-00003272 65EE 7832 BCS.s LAB_CBX1 * loop if <"2"
-00003274 7833
-00003274 60B2 7834 BRA.s LAB_CHX3 * if not numeric character go return value
-00003276 7835
-00003276 7836 * half way decent times 16 and times 2 with overflow checks
-00003276 7837
-00003276 7838 d1x16
-00003276 2401 7839 MOVE.l d1,d2 * copy value
-00003278 D482 7840 ADD.l d2,d2 * times two
-0000327A 65CA 7841 BCS.s RTS_024 * return if overflow
-0000327C 7842
-0000327C D482 7843 ADD.l d2,d2 * times four
-0000327E 65C6 7844 BCS.s RTS_024 * return if overflow
-00003280 7845
-00003280 D482 7846 ADD.l d2,d2 * times eight
-00003282 65C2 7847 BCS.s RTS_024 * return if overflow
-00003284 7848
-00003284 7849 d1x02
-00003284 D482 7850 ADD.l d2,d2 * times sixteen (ten/two)
-00003286 65BE 7851 BCS.s RTS_024 * return if overflow
-00003288 7852
-00003288 7853 * now add in new digit
-00003288 7854
-00003288 C0BC 000000FF 7855 AND.l #$FF,d0 * mask character
-0000328E 0400 0030 7856 SUB.b #'0',d0 * convert to value
-00003292 D480 7857 ADD.l d0,d2 * add to result
-00003294 65B0 7858 BCS.s RTS_024 * return if overflow, it should never ever do
-00003296 7859 * this
-00003296 7860
-00003296 2202 7861 MOVE.l d2,d1 * copy result
-00003298 4E75 7862 RTS
-0000329A 7863
-0000329A 7864 * half way decent times 10 with overflow checks
-0000329A 7865
-0000329A 7866 d1x10
-0000329A 2401 7867 MOVE.l d1,d2 * copy value
-0000329C D482 7868 ADD.l d2,d2 * times two
-0000329E 6508 7869 BCS.s RTS_025 * return if overflow
-000032A0 7870
-000032A0 D482 7871 ADD.l d2,d2 * times four
-000032A2 6504 7872 BCS.s RTS_025 * return if overflow
-000032A4 7873
-000032A4 D481 7874 ADD.l d1,d2 * times five
-000032A6 64DC 7875 BCC.s d1x02 * do times two and add in new digit if ok
-000032A8 7876
-000032A8 7877 RTS_025
-000032A8 4E75 7878 RTS
-000032AA 7879
-000032AA 7880
-000032AA 7881 *************************************************************************************
-000032AA 7882 *
-000032AA 7883 * token values needed for BASIC
-000032AA 7884
-000032AA =00000080 7885 TK_END EQU $80 * $80
-000032AA =00000081 7886 TK_FOR EQU TK_END+1 * $81
-000032AA =00000082 7887 TK_NEXT EQU TK_FOR+1 * $82
-000032AA =00000083 7888 TK_DATA EQU TK_NEXT+1 * $83
-000032AA =00000084 7889 TK_INPUT EQU TK_DATA+1 * $84
-000032AA =00000085 7890 TK_DIM EQU TK_INPUT+1 * $85
-000032AA =00000086 7891 TK_READ EQU TK_DIM+1 * $86
-000032AA =00000087 7892 TK_LET EQU TK_READ+1 * $87
-000032AA =00000088 7893 TK_DEC EQU TK_LET+1 * $88
-000032AA =00000089 7894 TK_GOTO EQU TK_DEC+1 * $89
-000032AA =0000008A 7895 TK_RUN EQU TK_GOTO+1 * $8A
-000032AA =0000008B 7896 TK_IF EQU TK_RUN+1 * $8B
-000032AA =0000008C 7897 TK_RESTORE EQU TK_IF+1 * $8C
-000032AA =0000008D 7898 TK_GOSUB EQU TK_RESTORE+1 * $8D
-000032AA =0000008E 7899 TK_RETURN EQU TK_GOSUB+1 * $8E
-000032AA =0000008F 7900 TK_REM EQU TK_RETURN+1 * $8F
-000032AA =00000090 7901 TK_STOP EQU TK_REM+1 * $90
-000032AA =00000091 7902 TK_ON EQU TK_STOP+1 * $91
-000032AA =00000092 7903 TK_NULL EQU TK_ON+1 * $92
-000032AA =00000093 7904 TK_INC EQU TK_NULL+1 * $93
-000032AA =00000094 7905 TK_WAIT EQU TK_INC+1 * $94
-000032AA =00000095 7906 TK_LOAD EQU TK_WAIT+1 * $95
-000032AA =00000096 7907 TK_SAVE EQU TK_LOAD+1 * $96
-000032AA =00000097 7908 TK_DEF EQU TK_SAVE+1 * $97
-000032AA =00000098 7909 TK_POKE EQU TK_DEF+1 * $98
-000032AA =00000099 7910 TK_DOKE EQU TK_POKE+1 * $99
-000032AA =0000009A 7911 TK_LOKE EQU TK_DOKE+1 * $9A
-000032AA =0000009B 7912 TK_CALL EQU TK_LOKE+1 * $9B
-000032AA =0000009C 7913 TK_DO EQU TK_CALL+1 * $9C
-000032AA =0000009D 7914 TK_LOOP EQU TK_DO+1 * $9D
-000032AA =0000009E 7915 TK_PRINT EQU TK_LOOP+1 * $9E
-000032AA =0000009F 7916 TK_CONT EQU TK_PRINT+1 * $9F
-000032AA =000000A0 7917 TK_LIST EQU TK_CONT+1 * $A0
-000032AA =000000A1 7918 TK_CLEAR EQU TK_LIST+1 * $A1
-000032AA =000000A2 7919 TK_NEW EQU TK_CLEAR+1 * $A2
-000032AA =000000A3 7920 TK_WIDTH EQU TK_NEW+1 * $A3
-000032AA =000000A4 7921 TK_GET EQU TK_WIDTH+1 * $A4
-000032AA =000000A5 7922 TK_SWAP EQU TK_GET+1 * $A5
-000032AA =000000A6 7923 TK_BITSET EQU TK_SWAP+1 * $A6
-000032AA =000000A7 7924 TK_BITCLR EQU TK_BITSET+1 * $A7
-000032AA =000000A8 7925 TK_TAB EQU TK_BITCLR+1 * $A8
-000032AA =000000A9 7926 TK_ELSE EQU TK_TAB+1 * $A9
-000032AA =000000AA 7927 TK_TO EQU TK_ELSE+1 * $AA
-000032AA =000000AB 7928 TK_FN EQU TK_TO+1 * $AB
-000032AA =000000AC 7929 TK_SPC EQU TK_FN+1 * $AC
-000032AA =000000AD 7930 TK_THEN EQU TK_SPC+1 * $AD
-000032AA =000000AE 7931 TK_NOT EQU TK_THEN+1 * $AE
-000032AA =000000AF 7932 TK_STEP EQU TK_NOT+1 * $AF
-000032AA =000000B0 7933 TK_UNTIL EQU TK_STEP+1 * $B0
-000032AA =000000B1 7934 TK_WHILE EQU TK_UNTIL+1 * $B1
-000032AA =000000B2 7935 TK_PLUS EQU TK_WHILE+1 * $B2
-000032AA =000000B3 7936 TK_MINUS EQU TK_PLUS+1 * $B3
-000032AA =000000B4 7937 TK_MULT EQU TK_MINUS+1 * $B4
-000032AA =000000B5 7938 TK_DIV EQU TK_MULT+1 * $B5
-000032AA =000000B6 7939 TK_POWER EQU TK_DIV+1 * $B6
-000032AA =000000B7 7940 TK_AND EQU TK_POWER+1 * $B7
-000032AA =000000B8 7941 TK_EOR EQU TK_AND+1 * $B8
-000032AA =000000B9 7942 TK_OR EQU TK_EOR+1 * $B9
-000032AA =000000BA 7943 TK_RSHIFT EQU TK_OR+1 * $BA
-000032AA =000000BB 7944 TK_LSHIFT EQU TK_RSHIFT+1 * $BB
-000032AA =000000BC 7945 TK_GT EQU TK_LSHIFT+1 * $BC
-000032AA =000000BD 7946 TK_EQUAL EQU TK_GT+1 * $BD
-000032AA =000000BE 7947 TK_LT EQU TK_EQUAL+1 * $BE
-000032AA =000000BF 7948 TK_SGN EQU TK_LT+1 * $BF
-000032AA =000000C0 7949 TK_INT EQU TK_SGN+1 * $C0
-000032AA =000000C1 7950 TK_ABS EQU TK_INT+1 * $C1
-000032AA =000000C2 7951 TK_USR EQU TK_ABS+1 * $C2
-000032AA =000000C3 7952 TK_FRE EQU TK_USR+1 * $C3
-000032AA =000000C4 7953 TK_POS EQU TK_FRE+1 * $C4
-000032AA =000000C5 7954 TK_SQR EQU TK_POS+1 * $C5
-000032AA =000000C6 7955 TK_RND EQU TK_SQR+1 * $C6
-000032AA =000000C7 7956 TK_LOG EQU TK_RND+1 * $C7
-000032AA =000000C8 7957 TK_EXP EQU TK_LOG+1 * $C8
-000032AA =000000C9 7958 TK_COS EQU TK_EXP+1 * $C9
-000032AA =000000CA 7959 TK_SIN EQU TK_COS+1 * $CA
-000032AA =000000CB 7960 TK_TAN EQU TK_SIN+1 * $CB
-000032AA =000000CC 7961 TK_ATN EQU TK_TAN+1 * $CC
-000032AA =000000CD 7962 TK_PEEK EQU TK_ATN+1 * $CD
-000032AA =000000CE 7963 TK_DEEK EQU TK_PEEK+1 * $CE
-000032AA =000000CF 7964 TK_LEEK EQU TK_DEEK+1 * $CF
-000032AA =000000D0 7965 TK_LEN EQU TK_LEEK+1 * $D0
-000032AA =000000D1 7966 TK_STRS EQU TK_LEN+1 * $D1
-000032AA =000000D2 7967 TK_VAL EQU TK_STRS+1 * $D2
-000032AA =000000D3 7968 TK_ASC EQU TK_VAL+1 * $D3
-000032AA =000000D4 7969 TK_UCASES EQU TK_ASC+1 * $D4
-000032AA =000000D5 7970 TK_LCASES EQU TK_UCASES+1 * $D5
-000032AA =000000D6 7971 TK_CHRS EQU TK_LCASES+1 * $D6
-000032AA =000000D7 7972 TK_HEXS EQU TK_CHRS+1 * $D7
-000032AA =000000D8 7973 TK_BINS EQU TK_HEXS+1 * $D8
-000032AA =000000D9 7974 TK_BITTST EQU TK_BINS+1 * $D9
-000032AA =000000DA 7975 TK_MAX EQU TK_BITTST+1 * $DA
-000032AA =000000DB 7976 TK_MIN EQU TK_MAX+1 * $DB
-000032AA =000000DC 7977 TK_RAM EQU TK_MIN+1 * $DC
-000032AA =000000DD 7978 TK_PI EQU TK_RAM+1 * $DD
-000032AA =000000DE 7979 TK_TWOPI EQU TK_PI+1 * $DE
-000032AA =000000DF 7980 TK_VPTR EQU TK_TWOPI+1 * $DF
-000032AA =000000E0 7981 TK_SADD EQU TK_VPTR+1 * $E0
-000032AA =000000E1 7982 TK_LEFTS EQU TK_SADD+1 * $E1
-000032AA =000000E2 7983 TK_RIGHTS EQU TK_LEFTS+1 * $E2
-000032AA =000000E3 7984 TK_MIDS EQU TK_RIGHTS+1 * $E3
-000032AA =000000E4 7985 TK_USINGS EQU TK_MIDS+1 * $E4
-000032AA 7986
-000032AA 7987
-000032AA 7988 *************************************************************************************
-000032AA 7989 *
-000032AA 7990 * binary to unsigned decimal table
-000032AA 7991
-000032AA 7992 Bin2dec
-000032AA= 3B9ACA00 7993 dc.l $3B9ACA00 * 1000000000
-000032AE= 05F5E100 7994 dc.l $05F5E100 * 100000000
-000032B2= 00989680 7995 dc.l $00989680 * 10000000
-000032B6= 000F4240 7996 dc.l $000F4240 * 1000000
-000032BA= 000186A0 7997 dc.l $000186A0 * 100000
-000032BE= 00002710 7998 dc.l $00002710 * 10000
-000032C2= 000003E8 7999 dc.l $000003E8 * 1000
-000032C6= 00000064 8000 dc.l $00000064 * 100
-000032CA= 0000000A 8001 dc.l $0000000A * 10
-000032CE= 00000000 8002 dc.l $00000000 * 0 end marker
-000032D2 8003
-000032D2 8004 LAB_RSED
-000032D2= 332E3232 8005 dc.l $332E3232 * 858665522
-000032D6 8006
-000032D6 8007 * string to value exponent table
-000032D6 8008
-000032D6= FF00 8009 dc.w 255<<8 * 10**38
-000032D8= 96769951 8010 dc.l $96769951
-000032DC= FB00 8011 dc.w 251<<8 * 10**37
-000032DE= F0BDC21B 8012 dc.l $F0BDC21B
-000032E2= F800 8013 dc.w 248<<8 * 10**36
-000032E4= C097CE7C 8014 dc.l $C097CE7C
-000032E8= F500 8015 dc.w 245<<8 * 10**35
-000032EA= 9A130B96 8016 dc.l $9A130B96
-000032EE= F100 8017 dc.w 241<<8 * 10**34
-000032F0= F684DF57 8018 dc.l $F684DF57
-000032F4= EE00 8019 dc.w 238<<8 * 10**33
-000032F6= C5371912 8020 dc.l $C5371912
-000032FA= EB00 8021 dc.w 235<<8 * 10**32
-000032FC= 9DC5ADA8 8022 dc.l $9DC5ADA8
-00003300= E700 8023 dc.w 231<<8 * 10**31
-00003302= FC6F7C40 8024 dc.l $FC6F7C40
-00003306= E400 8025 dc.w 228<<8 * 10**30
-00003308= C9F2C9CD 8026 dc.l $C9F2C9CD
-0000330C= E100 8027 dc.w 225<<8 * 10**29
-0000330E= A18F07D7 8028 dc.l $A18F07D7
-00003312= DE00 8029 dc.w 222<<8 * 10**28
-00003314= 813F3979 8030 dc.l $813F3979
-00003318= DA00 8031 dc.w 218<<8 * 10**27
-0000331A= CECB8F28 8032 dc.l $CECB8F28
-0000331E= D700 8033 dc.w 215<<8 * 10**26
-00003320= A56FA5BA 8034 dc.l $A56FA5BA
-00003324= D400 8035 dc.w 212<<8 * 10**25
-00003326= 84595161 8036 dc.l $84595161
-0000332A= D000 8037 dc.w 208<<8 * 10**24
-0000332C= D3C21BCF 8038 dc.l $D3C21BCF
-00003330= CD00 8039 dc.w 205<<8 * 10**23
-00003332= A968163F 8040 dc.l $A968163F
-00003336= CA00 8041 dc.w 202<<8 * 10**22
-00003338= 87867832 8042 dc.l $87867832
-0000333C= C600 8043 dc.w 198<<8 * 10**21
-0000333E= D8D726B7 8044 dc.l $D8D726B7
-00003342= C300 8045 dc.w 195<<8 * 10**20
-00003344= AD78EBC6 8046 dc.l $AD78EBC6
-00003348= C000 8047 dc.w 192<<8 * 10**19
-0000334A= 8AC72305 8048 dc.l $8AC72305
-0000334E= BC00 8049 dc.w 188<<8 * 10**18
-00003350= DE0B6B3A 8050 dc.l $DE0B6B3A
-00003354= B900 8051 dc.w 185<<8 * 10**17
-00003356= B1A2BC2F 8052 dc.l $B1A2BC2F
-0000335A= B600 8053 dc.w 182<<8 * 10**16
-0000335C= 8E1BC9BF 8054 dc.l $8E1BC9BF
-00003360= B200 8055 dc.w 178<<8 * 10**15
-00003362= E35FA932 8056 dc.l $E35FA932
-00003366= AF00 8057 dc.w 175<<8 * 10**14
-00003368= B5E620F5 8058 dc.l $B5E620F5
-0000336C= AC00 8059 dc.w 172<<8 * 10**13
-0000336E= 9184E72A 8060 dc.l $9184E72A
-00003372= A800 8061 dc.w 168<<8 * 10**12
-00003374= E8D4A510 8062 dc.l $E8D4A510
-00003378= A500 8063 dc.w 165<<8 * 10**11
-0000337A= BA43B740 8064 dc.l $BA43B740
-0000337E= A200 8065 dc.w 162<<8 * 10**10
-00003380= 9502F900 8066 dc.l $9502F900
-00003384= 9E00 8067 dc.w 158<<8 * 10**9
-00003386= EE6B2800 8068 dc.l $EE6B2800
-0000338A= 9B00 8069 dc.w 155<<8 * 10**8
-0000338C= BEBC2000 8070 dc.l $BEBC2000
-00003390= 9800 8071 dc.w 152<<8 * 10**7
-00003392= 98968000 8072 dc.l $98968000
-00003396= 9400 8073 dc.w 148<<8 * 10**6
-00003398= F4240000 8074 dc.l $F4240000
-0000339C= 9100 8075 dc.w 145<<8 * 10**5
-0000339E= C3500000 8076 dc.l $C3500000
-000033A2= 8E00 8077 dc.w 142<<8 * 10**4
-000033A4= 9C400000 8078 dc.l $9C400000
-000033A8= 8A00 8079 dc.w 138<<8 * 10**3
-000033AA= FA000000 8080 dc.l $FA000000
-000033AE= 8700 8081 dc.w 135<<8 * 10**2
-000033B0= C8000000 8082 dc.l $C8000000
-000033B4= 8400 8083 dc.w 132<<8 * 10**1
-000033B6= A0000000 8084 dc.l $A0000000
-000033BA 8085 LAB_P_10
-000033BA= 8100 8086 dc.w 129<<8 * 10**0
-000033BC= 80000000 8087 dc.l $80000000
-000033C0= 7D00 8088 dc.w 125<<8 * 10**-1
-000033C2= CCCCCCCD 8089 dc.l $CCCCCCCD
-000033C6= 7A00 8090 dc.w 122<<8 * 10**-2
-000033C8= A3D70A3D 8091 dc.l $A3D70A3D
-000033CC= 7700 8092 dc.w 119<<8 * 10**-3
-000033CE= 83126E98 8093 dc.l $83126E98
-000033D2= 7300 8094 dc.w 115<<8 * 10**-4
-000033D4= D1B71759 8095 dc.l $D1B71759
-000033D8= 7000 8096 dc.w 112<<8 * 10**-5
-000033DA= A7C5AC47 8097 dc.l $A7C5AC47
-000033DE= 6D00 8098 dc.w 109<<8 * 10**-6
-000033E0= 8637BD06 8099 dc.l $8637BD06
-000033E4= 6900 8100 dc.w 105<<8 * 10**-7
-000033E6= D6BF94D6 8101 dc.l $D6BF94D6
-000033EA= 6600 8102 dc.w 102<<8 * 10**-8
-000033EC= ABCC7712 8103 dc.l $ABCC7712
-000033F0= 6300 8104 dc.w 99<<8 * 10**-9
-000033F2= 89705F41 8105 dc.l $89705F41
-000033F6= 5F00 8106 dc.w 95<<8 * 10**-10
-000033F8= DBE6FECF 8107 dc.l $DBE6FECF
-000033FC= 5C00 8108 dc.w 92<<8 * 10**-11
-000033FE= AFEBFF0C 8109 dc.l $AFEBFF0C
-00003402= 5900 8110 dc.w 89<<8 * 10**-12
-00003404= 8CBCCC09 8111 dc.l $8CBCCC09
-00003408= 5500 8112 dc.w 85<<8 * 10**-13
-0000340A= E12E1342 8113 dc.l $E12E1342
-0000340E= 5200 8114 dc.w 82<<8 * 10**-14
-00003410= B424DC35 8115 dc.l $B424DC35
-00003414= 4F00 8116 dc.w 79<<8 * 10**-15
-00003416= 901D7CF7 8117 dc.l $901D7CF7
-0000341A= 4B00 8118 dc.w 75<<8 * 10**-16
-0000341C= E69594BF 8119 dc.l $E69594BF
-00003420= 4800 8120 dc.w 72<<8 * 10**-17
-00003422= B877AA32 8121 dc.l $B877AA32
-00003426= 4500 8122 dc.w 69<<8 * 10**-18
-00003428= 9392EE8F 8123 dc.l $9392EE8F
-0000342C= 4100 8124 dc.w 65<<8 * 10**-19
-0000342E= EC1E4A7E 8125 dc.l $EC1E4A7E
-00003432= 3E00 8126 dc.w 62<<8 * 10**-20
-00003434= BCE50865 8127 dc.l $BCE50865
-00003438= 3B00 8128 dc.w 59<<8 * 10**-21
-0000343A= 971DA050 8129 dc.l $971DA050
-0000343E= 3700 8130 dc.w 55<<8 * 10**-22
-00003440= F1C90081 8131 dc.l $F1C90081
-00003444= 3400 8132 dc.w 52<<8 * 10**-23
-00003446= C16D9A01 8133 dc.l $C16D9A01
-0000344A= 3100 8134 dc.w 49<<8 * 10**-24
-0000344C= 9ABE14CD 8135 dc.l $9ABE14CD
-00003450= 2D00 8136 dc.w 45<<8 * 10**-25
-00003452= F79687AE 8137 dc.l $F79687AE
-00003456= 2A00 8138 dc.w 42<<8 * 10**-26
-00003458= C6120625 8139 dc.l $C6120625
-0000345C= 2700 8140 dc.w 39<<8 * 10**-27
-0000345E= 9E74D1B8 8141 dc.l $9E74D1B8
-00003462= 2300 8142 dc.w 35<<8 * 10**-28
-00003464= FD87B5F3 8143 dc.l $FD87B5F3
-00003468= 2000 8144 dc.w 32<<8 * 10**-29
-0000346A= CAD2F7F5 8145 dc.l $CAD2F7F5
-0000346E= 1D00 8146 dc.w 29<<8 * 10**-30
-00003470= A2425FF7 8147 dc.l $A2425FF7
-00003474= 1A00 8148 dc.w 26<<8 * 10**-31
-00003476= 81CEB32C 8149 dc.l $81CEB32C
-0000347A= 1600 8150 dc.w 22<<8 * 10**-32
-0000347C= CFB11EAD 8151 dc.l $CFB11EAD
-00003480= 1300 8152 dc.w 19<<8 * 10**-33
-00003482= A6274BBE 8153 dc.l $A6274BBE
-00003486= 1000 8154 dc.w 16<<8 * 10**-34
-00003488= 84EC3C98 8155 dc.l $84EC3C98
-0000348C= 0C00 8156 dc.w 12<<8 * 10**-35
-0000348E= D4AD2DC0 8157 dc.l $D4AD2DC0
-00003492= 0900 8158 dc.w 9<<8 * 10**-36
-00003494= AA242499 8159 dc.l $AA242499
-00003498= 0600 8160 dc.w 6<<8 * 10**-37
-0000349A= 881CEA14 8161 dc.l $881CEA14
-0000349E= 0200 8162 dc.w 2<<8 * 10**-38
-000034A0= D9C7DCED 8163 dc.l $D9C7DCED
-000034A4 8164
-000034A4 8165
-000034A4 8166 *************************************************************************************
-000034A4 8167 *
-000034A4 8168 * table of constants for cordic SIN/COS/TAN calculations
-000034A4 8169 * constants are un normalised fractions and are atn(2^-i)/2pi
-000034A4 8170
-000034A4= 4DBA76D4 8171 dc.l $4DBA76D4 * SIN/COS multiply constant
-000034A8 8172 TAB_SNCO
-000034A8= 20000000 8173 dc.l $20000000 * atn(2^0)/2pi
-000034AC= 12E4051E 8174 dc.l $12E4051E * atn(2^1)/2pi
-000034B0= 09FB385C 8175 dc.l $09FB385C * atn(2^2)/2pi
-000034B4= 051111D5 8176 dc.l $051111D5 * atn(2^3)/2pi
-000034B8= 028B0D44 8177 dc.l $028B0D44 * atn(2^4)/2pi
-000034BC= 0145D7E2 8178 dc.l $0145D7E2 * atn(2^5)/2pi
-000034C0= 00A2F61F 8179 dc.l $00A2F61F * atn(2^6)/2pi
-000034C4= 00517C56 8180 dc.l $00517C56 * atn(2^7)/2pi
-000034C8= 0028BE54 8181 dc.l $0028BE54 * atn(2^8)/2pi
-000034CC= 00145F2F 8182 dc.l $00145F2F * atn(2^9)/2pi
-000034D0= 000A2F99 8183 dc.l $000A2F99 * atn(2^10)/2pi
-000034D4= 000517CD 8184 dc.l $000517CD * atn(2^11)/2pi
-000034D8= 00028BE7 8185 dc.l $00028BE7 * atn(2^12)/2pi
-000034DC= 000145F4 8186 dc.l $000145F4 * atn(2^13)/2pi
-000034E0= 0000A2FA 8187 dc.l $0000A2FA * atn(2^14)/2pi
-000034E4= 0000517D 8188 dc.l $0000517D * atn(2^15)/2pi
-000034E8= 000028BF 8189 dc.l $000028BF * atn(2^16)/2pi
-000034EC= 00001460 8190 dc.l $00001460 * atn(2^17)/2pi
-000034F0= 00000A30 8191 dc.l $00000A30 * atn(2^18)/2pi
-000034F4= 00000518 8192 dc.l $00000518 * atn(2^19)/2pi
-000034F8= 0000028C 8193 dc.l $0000028C * atn(2^20)/2pi
-000034FC= 00000146 8194 dc.l $00000146 * atn(2^21)/2pi
-00003500= 000000A3 8195 dc.l $000000A3 * atn(2^22)/2pi
-00003504= 00000052 8196 dc.l $00000052 * atn(2^23)/2pi
-00003508= 00000029 8197 dc.l $00000029 * atn(2^24)/2pi
-0000350C= 00000015 8198 dc.l $00000015 * atn(2^25)/2pi
-00003510= 0000000B 8199 dc.l $0000000B * atn(2^26)/2pi
-00003514= 00000006 8200 dc.l $00000006 * atn(2^27)/2pi
-00003518= 00000003 8201 dc.l $00000003 * atn(2^28)/2pi
-0000351C= 00000002 8202 dc.l $00000002 * atn(2^29)/2pi
-00003520= 00000001 8203 dc.l $00000001 * atn(2^30)/2pi
-00003524= 00000001 8204 dc.l $00000001 * atn(2^31)/2pi
-00003528 8205
-00003528 8206
-00003528 8207 *************************************************************************************
-00003528 8208 *
-00003528 8209 * table of constants for cordic ATN calculation
-00003528 8210 * constants are normalised to two integer bits and are atn(2^-i)
-00003528 8211
-00003528 8212 TAB_ATNC
-00003528= 1DAC6705 8213 dc.l $1DAC6705 * atn(2^-1)
-0000352C= 0FADBAFD 8214 dc.l $0FADBAFD * atn(2^-2)
-00003530= 07F56EA7 8215 dc.l $07F56EA7 * atn(2^-3)
-00003534= 03FEAB77 8216 dc.l $03FEAB77 * atn(2^-4)
-00003538= 01FFD55C 8217 dc.l $01FFD55C * atn(2^-5)
-0000353C= 00FFFAAB 8218 dc.l $00FFFAAB * atn(2^-6)
-00003540= 007FFF55 8219 dc.l $007FFF55 * atn(2^-7)
-00003544= 003FFFEB 8220 dc.l $003FFFEB * atn(2^-8)
-00003548= 001FFFFD 8221 dc.l $001FFFFD * atn(2^-9)
-0000354C= 00100000 8222 dc.l $00100000 * atn(2^-10)
-00003550= 00080000 8223 dc.l $00080000 * atn(2^-11)
-00003554= 00040000 8224 dc.l $00040000 * atn(2^-12)
-00003558= 00020000 8225 dc.l $00020000 * atn(2^-13)
-0000355C= 00010000 8226 dc.l $00010000 * atn(2^-14)
-00003560= 00008000 8227 dc.l $00008000 * atn(2^-15)
-00003564= 00004000 8228 dc.l $00004000 * atn(2^-16)
-00003568= 00002000 8229 dc.l $00002000 * atn(2^-17)
-0000356C= 00001000 8230 dc.l $00001000 * atn(2^-18)
-00003570= 00000800 8231 dc.l $00000800 * atn(2^-19)
-00003574= 00000400 8232 dc.l $00000400 * atn(2^-20)
-00003578= 00000200 8233 dc.l $00000200 * atn(2^-21)
-0000357C= 00000100 8234 dc.l $00000100 * atn(2^-22)
-00003580= 00000080 8235 dc.l $00000080 * atn(2^-23)
-00003584= 00000040 8236 dc.l $00000040 * atn(2^-24)
-00003588= 00000020 8237 dc.l $00000020 * atn(2^-25)
-0000358C= 00000010 8238 dc.l $00000010 * atn(2^-26)
-00003590= 00000008 8239 dc.l $00000008 * atn(2^-27)
-00003594= 00000004 8240 dc.l $00000004 * atn(2^-28)
-00003598= 00000002 8241 dc.l $00000002 * atn(2^-29)
-0000359C= 00000001 8242 dc.l $00000001 * atn(2^-30)
-000035A0 8243 LAB_1D96
-000035A0= 00000000 8244 dc.l $00000000 * atn(2^-31)
-000035A4= 00000000 8245 dc.l $00000000 * atn(2^-32)
-000035A8 8246
-000035A8 8247 * constants are normalised to n integer bits and are tanh(2^-i)
-000035A8 =00000002 8248 n equ 2
-000035A8 8249 TAB_HTHET
-000035A8= 2327D4F4 8250 dc.l $8C9F53D0>>n * atnh(2^-1) .549306144
-000035AC= 1058AEFA 8251 dc.l $4162BBE8>>n * atnh(2^-2) .255412812
-000035B0= 080AC48E 8252 dc.l $202B1238>>n * atnh(2^-3)
-000035B4= 04015622 8253 dc.l $10055888>>n * atnh(2^-4)
-000035B8= 02002AB0 8254 dc.l $0800AAC0>>n * atnh(2^-5)
-000035BC= 01000554 8255 dc.l $04001550>>n * atnh(2^-6)
-000035C0= 008000AA 8256 dc.l $020002A8>>n * atnh(2^-7)
-000035C4= 00400014 8257 dc.l $01000050>>n * atnh(2^-8)
-000035C8= 00200002 8258 dc.l $00800008>>n * atnh(2^-9)
-000035CC= 00100000 8259 dc.l $00400000>>n * atnh(2^-10)
-000035D0= 00080000 8260 dc.l $00200000>>n * atnh(2^-11)
-000035D4= 00040000 8261 dc.l $00100000>>n * atnh(2^-12)
-000035D8= 00020000 8262 dc.l $00080000>>n * atnh(2^-13)
-000035DC= 00010000 8263 dc.l $00040000>>n * atnh(2^-14)
-000035E0= 00008000 8264 dc.l $00020000>>n * atnh(2^-15)
-000035E4= 00004000 8265 dc.l $00010000>>n * atnh(2^-16)
-000035E8= 00002000 8266 dc.l $00008000>>n * atnh(2^-17)
-000035EC= 00001000 8267 dc.l $00004000>>n * atnh(2^-18)
-000035F0= 00000800 8268 dc.l $00002000>>n * atnh(2^-19)
-000035F4= 00000400 8269 dc.l $00001000>>n * atnh(2^-20)
-000035F8= 00000200 8270 dc.l $00000800>>n * atnh(2^-21)
-000035FC= 00000100 8271 dc.l $00000400>>n * atnh(2^-22)
-00003600= 00000080 8272 dc.l $00000200>>n * atnh(2^-23)
-00003604= 00000040 8273 dc.l $00000100>>n * atnh(2^-24)
-00003608= 00000020 8274 dc.l $00000080>>n * atnh(2^-25)
-0000360C= 00000010 8275 dc.l $00000040>>n * atnh(2^-26)
-00003610= 00000008 8276 dc.l $00000020>>n * atnh(2^-27)
-00003614= 00000004 8277 dc.l $00000010>>n * atnh(2^-28)
-00003618= 00000002 8278 dc.l $00000008>>n * atnh(2^-29)
-0000361C= 00000001 8279 dc.l $00000004>>n * atnh(2^-30)
-00003620= 00000000 8280 dc.l $00000002>>n * atnh(2^-31)
-00003624= 00000000 8281 dc.l $00000001>>n * atnh(2^-32)
-00003628 8282
-00003628 =26A3D110 8283 KFCTSEED equ $9A8F4441>>n * $26A3D110
-00003628 8284
-00003628 8285
-00003628 8286 *************************************************************************************
-00003628 8287 *
-00003628 8288 * command vector table
-00003628 8289
-00003628 8290 LAB_CTBL
-00003628= D7B2 8291 dc.w LAB_END-LAB_CTBL * END
-0000362A= D6E6 8292 dc.w LAB_FOR-LAB_CTBL * FOR
-0000362C= DD52 8293 dc.w LAB_NEXT-LAB_CTBL * NEXT
-0000362E= D906 8294 dc.w LAB_DATA-LAB_CTBL * DATA
-00003630= DC46 8295 dc.w LAB_INPUT-LAB_CTBL * INPUT
-00003632= E122 8296 dc.w LAB_DIM-LAB_CTBL * DIM
-00003634= DC6C 8297 dc.w LAB_READ-LAB_CTBL * READ
-00003636= DA78 8298 dc.w LAB_LET-LAB_CTBL * LET
-00003638= DA16 8299 dc.w LAB_DEC-LAB_CTBL * DEC
-0000363A= D86E 8300 dc.w LAB_GOTO-LAB_CTBL * GOTO
-0000363C= D836 8301 dc.w LAB_RUN-LAB_CTBL * RUN
-0000363E= D92E 8302 dc.w LAB_IF-LAB_CTBL * IF
-00003640= D7E0 8303 dc.w LAB_RESTORE-LAB_CTBL * RESTORE
-00003642= D85C 8304 dc.w LAB_GOSUB-LAB_CTBL * GOSUB
-00003644= D8F2 8305 dc.w LAB_RETURN-LAB_CTBL * RETURN
-00003646= D99C 8306 dc.w LAB_REM-LAB_CTBL * REM
-00003648= D7BA 8307 dc.w LAB_STOP-LAB_CTBL * STOP
-0000364A= D9A4 8308 dc.w LAB_ON-LAB_CTBL * ON
-0000364C= D80E 8309 dc.w LAB_NULL-LAB_CTBL * NULL
-0000364E= DA1C 8310 dc.w LAB_INC-LAB_CTBL * INC
-00003650= EA28 8311 dc.w LAB_WAIT-LAB_CTBL * WAIT
-00003652= EA16 8312 dc.w LAB_LOAD-LAB_CTBL * LOAD
-00003654= EA1A 8313 dc.w LAB_SAVE-LAB_CTBL * SAVE
-00003656= E4B2 8314 dc.w LAB_DEF-LAB_CTBL * DEF
-00003658= E996 8315 dc.w LAB_POKE-LAB_CTBL * POKE
-0000365A= E9C6 8316 dc.w LAB_DOKE-LAB_CTBL * DOKE
-0000365C= E9CC 8317 dc.w LAB_LOKE-LAB_CTBL * LOKE
-0000365E= EA1E 8318 dc.w LAB_CALL-LAB_CTBL * CALL
-00003660= D84A 8319 dc.w LAB_DO-LAB_CTBL * DO
-00003662= D89C 8320 dc.w LAB_LOOP-LAB_CTBL * LOOP
-00003664= DB0C 8321 dc.w LAB_PRINT-LAB_CTBL * PRINT
-00003666= D818 8322 dc.w LAB_CONT-LAB_CTBL * CONT
-00003668= D630 8323 dc.w LAB_LIST-LAB_CTBL * LIST
-0000366A= D62C 8324 dc.w LAB_CLEAR-LAB_CTBL * CLEAR
-0000366C= D5DC 8325 dc.w LAB_NEW-LAB_CTBL * NEW
-0000366E= F954 8326 dc.w LAB_WDTH-LAB_CTBL * WIDTH
-00003670= DAD2 8327 dc.w LAB_GET-LAB_CTBL * GET
-00003672= E9E0 8328 dc.w LAB_SWAP-LAB_CTBL * SWAP
-00003674= F49E 8329 dc.w LAB_BITSET-LAB_CTBL * BITSET
-00003676= F4AE 8330 dc.w LAB_BITCLR-LAB_CTBL * BITCLR
-00003678 8331
-00003678 8332
-00003678 8333 *************************************************************************************
-00003678 8334 *
-00003678 8335 * function pre process routine table
-00003678 8336
-00003678 8337 LAB_FTPP
-00003678= DFD0 8338 dc.w LAB_PPFN-LAB_FTPP * SGN(n) process numeric expression in ()
-0000367A= DFD0 8339 dc.w LAB_PPFN-LAB_FTPP * INT(n) "
-0000367C= DFD0 8340 dc.w LAB_PPFN-LAB_FTPP * ABS(n) "
-0000367E= DDD2 8341 dc.w LAB_EVEZ-LAB_FTPP * USR(x) process any expression
-00003680= DF1A 8342 dc.w LAB_1BF7-LAB_FTPP * FRE(x) process any expression in ()
-00003682= DF1A 8343 dc.w LAB_1BF7-LAB_FTPP * POS(x) "
-00003684= DFD0 8344 dc.w LAB_PPFN-LAB_FTPP * SQR(n) process numeric expression in ()
-00003686= DFD0 8345 dc.w LAB_PPFN-LAB_FTPP * RND(n) "
-00003688= DFD0 8346 dc.w LAB_PPFN-LAB_FTPP * LOG(n) "
-0000368A= DFD0 8347 dc.w LAB_PPFN-LAB_FTPP * EXP(n) "
-0000368C= DFD0 8348 dc.w LAB_PPFN-LAB_FTPP * COS(n) "
-0000368E= DFD0 8349 dc.w LAB_PPFN-LAB_FTPP * SIN(n) "
-00003690= DFD0 8350 dc.w LAB_PPFN-LAB_FTPP * TAN(n) "
-00003692= DFD0 8351 dc.w LAB_PPFN-LAB_FTPP * ATN(n) "
-00003694= DFD0 8352 dc.w LAB_PPFN-LAB_FTPP * PEEK(n) "
-00003696= DFD0 8353 dc.w LAB_PPFN-LAB_FTPP * DEEK(n) "
-00003698= DFD0 8354 dc.w LAB_PPFN-LAB_FTPP * LEEK(n) "
-0000369A= DFC2 8355 dc.w LAB_PPFS-LAB_FTPP * LEN($) process string expression in ()
-0000369C= DFD0 8356 dc.w LAB_PPFN-LAB_FTPP * STR$(n) process numeric expression in ()
-0000369E= DFC2 8357 dc.w LAB_PPFS-LAB_FTPP * VAL($) process string expression in ()
-000036A0= DFC2 8358 dc.w LAB_PPFS-LAB_FTPP * ASC($) "
-000036A2= DFC2 8359 dc.w LAB_PPFS-LAB_FTPP * UCASE$($) "
-000036A4= DFC2 8360 dc.w LAB_PPFS-LAB_FTPP * LCASE$($) "
-000036A6= DFD0 8361 dc.w LAB_PPFN-LAB_FTPP * CHR$(n) process numeric expression in ()
-000036A8= E00A 8362 dc.w LAB_BHSS-LAB_FTPP * HEX$() bin/hex pre process
-000036AA= E00A 8363 dc.w LAB_BHSS-LAB_FTPP * BIN$() "
-000036AC= 0000 8364 dc.w $0000 * BITTST() none
-000036AE= 0000 8365 dc.w $0000 * MAX() "
-000036B0= 0000 8366 dc.w $0000 * MIN() "
-000036B2= DFDE 8367 dc.w LAB_PPBI-LAB_FTPP * RAMBASE advance pointer
-000036B4= DFDE 8368 dc.w LAB_PPBI-LAB_FTPP * PI "
-000036B6= DFDE 8369 dc.w LAB_PPBI-LAB_FTPP * TWOPI "
-000036B8= 0000 8370 dc.w $0000 * VARPTR() none
-000036BA= 0000 8371 dc.w $0000 * SADD() "
-000036BC= DFE8 8372 dc.w LAB_LRMS-LAB_FTPP * LEFT$() process string expression
-000036BE= DFE8 8373 dc.w LAB_LRMS-LAB_FTPP * RIGHT$() "
-000036C0= DFE8 8374 dc.w LAB_LRMS-LAB_FTPP * MID$() "
-000036C2= DDD2 8375 dc.w LAB_EVEZ-LAB_FTPP * USING$(x) process any expression
-000036C4 8376
-000036C4 8377
-000036C4 8378 *************************************************************************************
-000036C4 8379 *
-000036C4 8380 * action addresses for functions
-000036C4 8381
-000036C4 8382 LAB_FTBL
-000036C4= ED54 8383 dc.w LAB_SGN-LAB_FTBL * SGN()
-000036C6= EDD6 8384 dc.w LAB_INT-LAB_FTBL * INT()
-000036C8= ED66 8385 dc.w LAB_ABS-LAB_FTBL * ABS()
-000036CA= E972 8386 dc.w LAB_USR-LAB_FTBL * USR()
-000036CC= E3CE 8387 dc.w LAB_FRE-LAB_FTBL * FRE()
-000036CE= E400 8388 dc.w LAB_POS-LAB_FTBL * POS()
-000036D0= F938 8389 dc.w LAB_SQR-LAB_FTBL * SQR()
-000036D2= F21E 8390 dc.w LAB_RND-LAB_FTBL * RND()
-000036D4= EA76 8391 dc.w LAB_LOG-LAB_FTBL * LOG()
-000036D6= F104 8392 dc.w LAB_EXP-LAB_FTBL * EXP()
-000036D8= F272 8393 dc.w LAB_COS-LAB_FTBL * COS()
-000036DA= F28A 8394 dc.w LAB_SIN-LAB_FTBL * SIN()
-000036DC= F250 8395 dc.w LAB_TAN-LAB_FTBL * TAN()
-000036DE= F350 8396 dc.w LAB_ATN-LAB_FTBL * ATN()
-000036E0= E8EE 8397 dc.w LAB_PEEK-LAB_FTBL * PEEK()
-000036E2= E900 8398 dc.w LAB_DEEK-LAB_FTBL * DEEK()
-000036E4= E916 8399 dc.w LAB_LEEK-LAB_FTBL * LEEK()
-000036E6= E832 8400 dc.w LAB_LENS-LAB_FTBL * LEN()
-000036E8= E4F6 8401 dc.w LAB_STRS-LAB_FTBL * STR$()
-000036EA= E876 8402 dc.w LAB_VAL-LAB_FTBL * VAL()
-000036EC= E83A 8403 dc.w LAB_ASC-LAB_FTBL * ASC()
-000036EE= E7E8 8404 dc.w LAB_UCASE-LAB_FTBL * UCASE$()
-000036F0= E7B8 8405 dc.w LAB_LCASE-LAB_FTBL * LCASE$()
-000036F2= E720 8406 dc.w LAB_CHRS-LAB_FTBL * CHR$()
-000036F4= F7DA 8407 dc.w LAB_HEXS-LAB_FTBL * HEX$()
-000036F6= F788 8408 dc.w LAB_BINS-LAB_FTBL * BIN$()
-000036F8= F422 8409 dc.w LAB_BTST-LAB_FTBL * BITTST()
-000036FA= F846 8410 dc.w LAB_MAX-LAB_FTBL * MAX()
-000036FC= F85C 8411 dc.w LAB_MIN-LAB_FTBL * MIN()
-000036FE= F9AA 8412 dc.w LAB_RAM-LAB_FTBL * RAMBASE
-00003700= F9B4 8413 dc.w LAB_PI-LAB_FTBL * PI
-00003702= F9C4 8414 dc.w LAB_TWOPI-LAB_FTBL * TWOPI
-00003704= F99A 8415 dc.w LAB_VARPTR-LAB_FTBL * VARPTR()
-00003706= E81A 8416 dc.w LAB_SADD-LAB_FTBL * SADD()
-00003708= E730 8417 dc.w LAB_LEFT-LAB_FTBL * LEFT$()
-0000370A= E744 8418 dc.w LAB_RIGHT-LAB_FTBL * RIGHT$()
-0000370C= E774 8419 dc.w LAB_MIDS-LAB_FTBL * MID$()
-0000370E= F450 8420 dc.w LAB_USINGS-LAB_FTBL * USING$()
-00003710 8421
-00003710 8422
-00003710 8423 *************************************************************************************
-00003710 8424 *
-00003710 8425 * hierarchy and action addresses for operator
-00003710 8426
-00003710 8427 LAB_OPPT
-00003710= 0079 8428 dc.w $0079 * +
-00003712= E978 8429 dc.w LAB_ADD-LAB_OPPT
-00003714= 0079 8430 dc.w $0079 * -
-00003716= E964 8431 dc.w LAB_SUBTRACT-LAB_OPPT
-00003718= 007B 8432 dc.w $007B * *
-0000371A= EB1C 8433 dc.w LAB_MULTIPLY-LAB_OPPT
-0000371C= 007B 8434 dc.w $007B * /
-0000371E= EBA8 8435 dc.w LAB_DIVIDE-LAB_OPPT
-00003720= 007F 8436 dc.w $007F * ^
-00003722= F002 8437 dc.w LAB_POWER-LAB_OPPT
-00003724= 0050 8438 dc.w $0050 * AND
-00003726= DFB2 8439 dc.w LAB_AND-LAB_OPPT
-00003728= 0046 8440 dc.w $0046 * EOR
-0000372A= DFA2 8441 dc.w LAB_EOR-LAB_OPPT
-0000372C= 0046 8442 dc.w $0046 * OR
-0000372E= DFAA 8443 dc.w LAB_OR-LAB_OPPT
-00003730= 0056 8444 dc.w $0056 * >>
-00003732= E056 8445 dc.w LAB_RSHIFT-LAB_OPPT
-00003734= 0056 8446 dc.w $0056 * <<
-00003736= E046 8447 dc.w LAB_LSHIFT-LAB_OPPT
-00003738= 007D 8448 dc.w $007D * >
-0000373A= F066 8449 dc.w LAB_GTHAN-LAB_OPPT * used to evaluate -n
-0000373C= 005A 8450 dc.w $005A * =
-0000373E= DFC8 8451 dc.w LAB_EQUAL-LAB_OPPT * used to evaluate NOT
-00003740= 0064 8452 dc.w $0064 * <
-00003742= DFD2 8453 dc.w LAB_LTHAN-LAB_OPPT
-00003744 8454
-00003744 8455
-00003744 8456 *************************************************************************************
-00003744 8457 *
-00003744 8458 * misc constants
-00003744 8459
-00003744 8460 * This table is used in converting numbers to ASCII.
-00003744 8461 * first four entries for expansion to 9.25 digits
-00003744 8462
-00003744 8463 LAB_2A9A
-00003744= FFF0BDC0 8464 dc.l $FFF0BDC0 * -1000000
-00003748= 000186A0 8465 dc.l $000186A0 * 100000
-0000374C= FFFFD8F0 8466 dc.l $FFFFD8F0 * -10000
-00003750= 000003E8 8467 dc.l $000003E8 * 1000
-00003754= FFFFFF9C 8468 dc.l $FFFFFF9C * -100
-00003758= 0000000A 8469 dc.l $0000000A * 10
-0000375C= FFFFFFFF 8470 dc.l $FFFFFFFF * -1
-00003760 8471 LAB_2A9B
-00003760 8472
-00003760 8473
-00003760 8474 *************************************************************************************
-00003760 8475 *
-00003760 8476 * new keyword tables
-00003760 8477
-00003760 8478 * offsets to keyword tables
-00003760 8479
-00003760 8480 TAB_CHRT
-00003760= 0000 8481 dc.w TAB_STAR-TAB_STAR * "*" $2A
-00003762= 0002 8482 dc.w TAB_PLUS-TAB_STAR * "+" $2B
-00003764= FFFF 8483 dc.w -1 * "," $2C no keywords
-00003766= 0004 8484 dc.w TAB_MNUS-TAB_STAR * "-" $2D
-00003768= FFFF 8485 dc.w -1 * "." $2E no keywords
-0000376A= 0006 8486 dc.w TAB_SLAS-TAB_STAR * "/" $2F
-0000376C= FFFF 8487 dc.w -1 * "0" $30 no keywords
-0000376E= FFFF 8488 dc.w -1 * "1" $31 no keywords
-00003770= FFFF 8489 dc.w -1 * "2" $32 no keywords
-00003772= FFFF 8490 dc.w -1 * "3" $33 no keywords
-00003774= FFFF 8491 dc.w -1 * "4" $34 no keywords
-00003776= FFFF 8492 dc.w -1 * "5" $35 no keywords
-00003778= FFFF 8493 dc.w -1 * "6" $36 no keywords
-0000377A= FFFF 8494 dc.w -1 * "7" $37 no keywords
-0000377C= FFFF 8495 dc.w -1 * "8" $38 no keywords
-0000377E= FFFF 8496 dc.w -1 * "9" $39 no keywords
-00003780= FFFF 8497 dc.w -1 * ";" $3A no keywords
-00003782= FFFF 8498 dc.w -1 * ":" $3B no keywords
-00003784= 0008 8499 dc.w TAB_LESS-TAB_STAR * "<" $3C
-00003786= 000C 8500 dc.w TAB_EQUL-TAB_STAR * "=" $3D
-00003788= 000E 8501 dc.w TAB_MORE-TAB_STAR * ">" $3E
-0000378A= 0012 8502 dc.w TAB_QEST-TAB_STAR * "?" $3F
-0000378C= FFFF 8503 dc.w -1 * "@" $40 no keywords
-0000378E= 0014 8504 dc.w TAB_ASCA-TAB_STAR * "A" $41
-00003790= 0024 8505 dc.w TAB_ASCB-TAB_STAR * "B" $42
-00003792= 003D 8506 dc.w TAB_ASCC-TAB_STAR * "C" $43
-00003794= 0054 8507 dc.w TAB_ASCD-TAB_STAR * "D" $44
-00003796= 006D 8508 dc.w TAB_ASCE-TAB_STAR * "E" $45
-00003798= 007C 8509 dc.w TAB_ASCF-TAB_STAR * "F" $46
-0000379A= 0086 8510 dc.w TAB_ASCG-TAB_STAR * "G" $47
-0000379C= 0093 8511 dc.w TAB_ASCH-TAB_STAR * "H" $48
-0000379E= 0099 8512 dc.w TAB_ASCI-TAB_STAR * "I" $49
-000037A0= FFFF 8513 dc.w -1 * "J" $4A no keywords
-000037A2= FFFF 8514 dc.w -1 * "K" $4B no keywords
-000037A4= 00A8 8515 dc.w TAB_ASCL-TAB_STAR * "L" $4C
-000037A6= 00D6 8516 dc.w TAB_ASCM-TAB_STAR * "M" $4D
-000037A8= 00E4 8517 dc.w TAB_ASCN-TAB_STAR * "N" $4E
-000037AA= 00F3 8518 dc.w TAB_ASCO-TAB_STAR * "O" $4F
-000037AC= 00F8 8519 dc.w TAB_ASCP-TAB_STAR * "P" $50
-000037AE= FFFF 8520 dc.w -1 * "Q" $51 no keywords
-000037B0= 010D 8521 dc.w TAB_ASCR-TAB_STAR * "R" $52
-000037B2= 0137 8522 dc.w TAB_ASCS-TAB_STAR * "S" $53
-000037B4= 0162 8523 dc.w TAB_ASCT-TAB_STAR * "T" $54
-000037B6= 0176 8524 dc.w TAB_ASCU-TAB_STAR * "U" $55
-000037B8= 018E 8525 dc.w TAB_ASCV-TAB_STAR * "V" $56
-000037BA= 019A 8526 dc.w TAB_ASCW-TAB_STAR * "W" $57
-000037BC= FFFF 8527 dc.w -1 * "X" $58 no keywords
-000037BE= FFFF 8528 dc.w -1 * "Y" $59 no keywords
-000037C0= FFFF 8529 dc.w -1 * "Z" $5A no keywords
-000037C2= FFFF 8530 dc.w -1 * "[" $5B no keywords
-000037C4= FFFF 8531 dc.w -1 * "\" $5C no keywords
-000037C6= FFFF 8532 dc.w -1 * "]" $5D no keywords
-000037C8= 01A9 8533 dc.w TAB_POWR-TAB_STAR * "^" $5E
-000037CA 8534
-000037CA 8535
-000037CA 8536 *************************************************************************************
-000037CA 8537 *
-000037CA 8538 * Table of Basic keywords for LIST command
-000037CA 8539 * [byte]first character,[byte]remaining length -1
-000037CA 8540 * [word]offset from table start
-000037CA 8541
-000037CA 8542 LAB_KEYT
-000037CA= 45 01 8543 dc.b 'E',1
-000037CC= 0071 8544 dc.w KEY_END-TAB_STAR * END
-000037CE= 46 01 8545 dc.b 'F',1
-000037D0= 007C 8546 dc.w KEY_FOR-TAB_STAR * FOR
-000037D2= 4E 02 8547 dc.b 'N',2
-000037D4= 00E7 8548 dc.w KEY_NEXT-TAB_STAR * NEXT
-000037D6= 44 02 8549 dc.b 'D',2
-000037D8= 0054 8550 dc.w KEY_DATA-TAB_STAR * DATA
-000037DA= 49 03 8551 dc.b 'I',3
-000037DC= 009E 8552 dc.w KEY_INPUT-TAB_STAR * INPUT
-000037DE= 44 01 8553 dc.b 'D',1
-000037E0= 0063 8554 dc.w KEY_DIM-TAB_STAR * DIM
-000037E2= 52 02 8555 dc.b 'R',2
-000037E4= 0114 8556 dc.w KEY_READ-TAB_STAR * READ
-000037E6= 4C 01 8557 dc.b 'L',1
-000037E8= 00BE 8558 dc.w KEY_LET-TAB_STAR * LET
-000037EA= 44 01 8559 dc.b 'D',1
-000037EC= 0058 8560 dc.w KEY_DEC-TAB_STAR * DEC
-000037EE= 47 02 8561 dc.b 'G',2
-000037F0= 0089 8562 dc.w KEY_GOTO-TAB_STAR * GOTO
-000037F2= 52 01 8563 dc.b 'R',1
-000037F4= 0133 8564 dc.w KEY_RUN-TAB_STAR * RUN
-000037F6= 49 00 8565 dc.b 'I',0
-000037F8= 0099 8566 dc.w KEY_IF-TAB_STAR * IF
-000037FA= 52 05 8567 dc.b 'R',5
-000037FC= 011B 8568 dc.w KEY_RESTORE-TAB_STAR * RESTORE
-000037FE= 47 03 8569 dc.b 'G',3
-00003800= 008D 8570 dc.w KEY_GOSUB-TAB_STAR * GOSUB
-00003802= 52 04 8571 dc.b 'R',4
-00003804= 0122 8572 dc.w KEY_RETURN-TAB_STAR * RETURN
-00003806= 52 01 8573 dc.b 'R',1
-00003808= 0118 8574 dc.w KEY_REM-TAB_STAR * REM
-0000380A= 53 02 8575 dc.b 'S',2
-0000380C= 0154 8576 dc.w KEY_STOP-TAB_STAR * STOP
-0000380E= 4F 00 8577 dc.b 'O',0
-00003810= 00F3 8578 dc.w KEY_ON-TAB_STAR * ON
-00003812= 4E 02 8579 dc.b 'N',2
-00003814= 00EE 8580 dc.w KEY_NULL-TAB_STAR * NULL
-00003816= 49 01 8581 dc.b 'I',1
-00003818= 009B 8582 dc.w KEY_INC-TAB_STAR * INC
-0000381A= 57 02 8583 dc.b 'W',2
-0000381C= 019A 8584 dc.w KEY_WAIT-TAB_STAR * WAIT
-0000381E= 4C 02 8585 dc.b 'L',2
-00003820= 00C5 8586 dc.w KEY_LOAD-TAB_STAR * LOAD
-00003822= 53 02 8587 dc.b 'S',2
-00003824= 013C 8588 dc.w KEY_SAVE-TAB_STAR * SAVE
-00003826= 44 01 8589 dc.b 'D',1
-00003828= 0060 8590 dc.w KEY_DEF-TAB_STAR * DEF
-0000382A= 50 02 8591 dc.b 'P',2
-0000382C= 00FF 8592 dc.w KEY_POKE-TAB_STAR * POKE
-0000382E= 44 02 8593 dc.b 'D',2
-00003830= 0066 8594 dc.w KEY_DOKE-TAB_STAR * DOKE
-00003832= 4C 02 8595 dc.b 'L',2
-00003834= 00CD 8596 dc.w KEY_LOKE-TAB_STAR * LOKE
-00003836= 43 02 8597 dc.b 'C',2
-00003838= 003D 8598 dc.w KEY_CALL-TAB_STAR * CALL
-0000383A= 44 00 8599 dc.b 'D',0
-0000383C= 006A 8600 dc.w KEY_DO-TAB_STAR * DO
-0000383E= 4C 02 8601 dc.b 'L',2
-00003840= 00D1 8602 dc.w KEY_LOOP-TAB_STAR * LOOP
-00003842= 50 03 8603 dc.b 'P',3
-00003844= 0107 8604 dc.w KEY_PRINT-TAB_STAR * PRINT
-00003846= 43 02 8605 dc.b 'C',2
-00003848= 004B 8606 dc.w KEY_CONT-TAB_STAR * CONT
-0000384A= 4C 02 8607 dc.b 'L',2
-0000384C= 00C1 8608 dc.w KEY_LIST-TAB_STAR * LIST
-0000384E= 43 03 8609 dc.b 'C',3
-00003850= 0046 8610 dc.w KEY_CLEAR-TAB_STAR * CLEAR
-00003852= 4E 01 8611 dc.b 'N',1
-00003854= 00E4 8612 dc.w KEY_NEW-TAB_STAR * NEW
-00003856= 57 03 8613 dc.b 'W',3
-00003858= 01A3 8614 dc.w KEY_WIDTH-TAB_STAR * WIDTH
-0000385A= 47 01 8615 dc.b 'G',1
-0000385C= 0086 8616 dc.w KEY_GET-TAB_STAR * GET
-0000385E= 53 02 8617 dc.b 'S',2
-00003860= 015D 8618 dc.w KEY_SWAP-TAB_STAR * SWAP
-00003862= 42 04 8619 dc.b 'B',4
-00003864= 002F 8620 dc.w KEY_BITSET-TAB_STAR * BITSET
-00003866= 42 04 8621 dc.b 'B',4
-00003868= 0029 8622 dc.w KEY_BITCLR-TAB_STAR * BITCLR
-0000386A= 54 02 8623 dc.b 'T',2
-0000386C= 0162 8624 dc.w KEY_TAB-TAB_STAR * TAB(
-0000386E= 45 02 8625 dc.b 'E',2
-00003870= 006D 8626 dc.w KEY_ELSE-TAB_STAR * ELSE
-00003872= 54 00 8627 dc.b 'T',0
-00003874= 016E 8628 dc.w KEY_TO-TAB_STAR * TO
-00003876= 46 00 8629 dc.b 'F',0
-00003878= 007F 8630 dc.w KEY_FN-TAB_STAR * FN
-0000387A= 53 02 8631 dc.b 'S',2
-0000387C= 0148 8632 dc.w KEY_SPC-TAB_STAR * SPC(
-0000387E= 54 02 8633 dc.b 'T',2
-00003880= 016A 8634 dc.w KEY_THEN-TAB_STAR * THEN
-00003882= 4E 01 8635 dc.b 'N',1
-00003884= 00EB 8636 dc.w KEY_NOT-TAB_STAR * NOT
-00003886= 53 02 8637 dc.b 'S',2
-00003888= 0150 8638 dc.w KEY_STEP-TAB_STAR * STEP
-0000388A= 55 03 8639 dc.b 'U',3
-0000388C= 017D 8640 dc.w KEY_UNTIL-TAB_STAR * UNTIL
-0000388E= 57 03 8641 dc.b 'W',3
-00003890= 019E 8642 dc.w KEY_WHILE-TAB_STAR * WHILE
-00003892 8643
-00003892= 2B FF 8644 dc.b '+',-1
-00003894= 0002 8645 dc.w KEY_PLUS-TAB_STAR * +
-00003896= 2D FF 8646 dc.b '-',-1
-00003898= 0004 8647 dc.w KEY_MINUS-TAB_STAR * -
-0000389A= 2A FF 8648 dc.b '*',-1
-0000389C= 0000 8649 dc.w KEY_MULT-TAB_STAR * *
-0000389E= 2F FF 8650 dc.b '/',-1
-000038A0= 0006 8651 dc.w KEY_DIV-TAB_STAR * /
-000038A2= 5E FF 8652 dc.b '^',-1
-000038A4= 01A9 8653 dc.w KEY_POWER-TAB_STAR * ^
-000038A6= 41 01 8654 dc.b 'A',1
-000038A8= 0018 8655 dc.w KEY_AND-TAB_STAR * AND
-000038AA= 45 01 8656 dc.b 'E',1
-000038AC= 0074 8657 dc.w KEY_EOR-TAB_STAR * EOR
-000038AE= 4F 00 8658 dc.b 'O',0
-000038B0= 00F5 8659 dc.w KEY_OR-TAB_STAR * OR
-000038B2= 3E 00 8660 dc.b '>',0
-000038B4= 000E 8661 dc.w KEY_RSHIFT-TAB_STAR * >>
-000038B6= 3C 00 8662 dc.b '<',0
-000038B8= 0008 8663 dc.w KEY_LSHIFT-TAB_STAR * <<
-000038BA= 3E FF 8664 dc.b '>',-1
-000038BC= 0010 8665 dc.w KEY_GT-TAB_STAR * >
-000038BE= 3D FF 8666 dc.b '=',-1
-000038C0= 000C 8667 dc.w KEY_EQUAL-TAB_STAR * =
-000038C2= 3C FF 8668 dc.b '<',-1
-000038C4= 000A 8669 dc.w KEY_LT-TAB_STAR * <
-000038C6 8670
-000038C6= 53 02 8671 dc.b 'S',2
-000038C8= 0140 8672 dc.w KEY_SGN-TAB_STAR * SGN(
-000038CA= 49 02 8673 dc.b 'I',2
-000038CC= 00A3 8674 dc.w KEY_INT-TAB_STAR * INT(
-000038CE= 41 02 8675 dc.b 'A',2
-000038D0= 0014 8676 dc.w KEY_ABS-TAB_STAR * ABS(
-000038D2= 55 02 8677 dc.b 'U',2
-000038D4= 0189 8678 dc.w KEY_USR-TAB_STAR * USR(
-000038D6= 46 02 8679 dc.b 'F',2
-000038D8= 0081 8680 dc.w KEY_FRE-TAB_STAR * FRE(
-000038DA= 50 02 8681 dc.b 'P',2
-000038DC= 0103 8682 dc.w KEY_POS-TAB_STAR * POS(
-000038DE= 53 02 8683 dc.b 'S',2
-000038E0= 014C 8684 dc.w KEY_SQR-TAB_STAR * SQR(
-000038E2= 52 02 8685 dc.b 'R',2
-000038E4= 012F 8686 dc.w KEY_RND-TAB_STAR * RND(
-000038E6= 4C 02 8687 dc.b 'L',2
-000038E8= 00C9 8688 dc.w KEY_LOG-TAB_STAR * LOG(
-000038EA= 45 02 8689 dc.b 'E',2
-000038EC= 0077 8690 dc.w KEY_EXP-TAB_STAR * EXP(
-000038EE= 43 02 8691 dc.b 'C',2
-000038F0= 004F 8692 dc.w KEY_COS-TAB_STAR * COS(
-000038F2= 53 02 8693 dc.b 'S',2
-000038F4= 0144 8694 dc.w KEY_SIN-TAB_STAR * SIN(
-000038F6= 54 02 8695 dc.b 'T',2
-000038F8= 0166 8696 dc.w KEY_TAN-TAB_STAR * TAN(
-000038FA= 41 02 8697 dc.b 'A',2
-000038FC= 001F 8698 dc.w KEY_ATN-TAB_STAR * ATN(
-000038FE= 50 03 8699 dc.b 'P',3
-00003900= 00F8 8700 dc.w KEY_PEEK-TAB_STAR * PEEK(
-00003902= 44 03 8701 dc.b 'D',3
-00003904= 005B 8702 dc.w KEY_DEEK-TAB_STAR * DEEK(
-00003906= 4C 03 8703 dc.b 'L',3
-00003908= 00AF 8704 dc.w KEY_LEEK-TAB_STAR * LEEK(
-0000390A= 4C 02 8705 dc.b 'L',2
-0000390C= 00BA 8706 dc.w KEY_LEN-TAB_STAR * LEN(
-0000390E= 53 03 8707 dc.b 'S',3
-00003910= 0158 8708 dc.w KEY_STRS-TAB_STAR * STR$(
-00003912= 56 02 8709 dc.b 'V',2
-00003914= 018E 8710 dc.w KEY_VAL-TAB_STAR * VAL(
-00003916= 41 02 8711 dc.b 'A',2
-00003918= 001B 8712 dc.w KEY_ASC-TAB_STAR * ASC(
-0000391A= 55 05 8713 dc.b 'U',5
-0000391C= 0176 8714 dc.w KEY_UCASES-TAB_STAR * UCASE$(
-0000391E= 4C 05 8715 dc.b 'L',5
-00003920= 00A8 8716 dc.w KEY_LCASES-TAB_STAR * LCASE$(
-00003922= 43 03 8717 dc.b 'C',3
-00003924= 0041 8718 dc.w KEY_CHRS-TAB_STAR * CHR$(
-00003926= 48 03 8719 dc.b 'H',3
-00003928= 0093 8720 dc.w KEY_HEXS-TAB_STAR * HEX$(
-0000392A= 42 03 8721 dc.b 'B',3
-0000392C= 0024 8722 dc.w KEY_BINS-TAB_STAR * BIN$(
-0000392E= 42 05 8723 dc.b 'B',5
-00003930= 0035 8724 dc.w KEY_BITTST-TAB_STAR * BITTST(
-00003932= 4D 02 8725 dc.b 'M',2
-00003934= 00D6 8726 dc.w KEY_MAX-TAB_STAR * MAX(
-00003936= 4D 02 8727 dc.b 'M',2
-00003938= 00DF 8728 dc.w KEY_MIN-TAB_STAR * MIN(
-0000393A= 52 05 8729 dc.b 'R',5
-0000393C= 010D 8730 dc.w KEY_RAM-TAB_STAR * RAMBASE
-0000393E= 50 00 8731 dc.b 'P',0
-00003940= 00FD 8732 dc.w KEY_PI-TAB_STAR * PI
-00003942= 54 03 8733 dc.b 'T',3
-00003944= 0170 8734 dc.w KEY_TWOPI-TAB_STAR * TWOPI
-00003946= 56 05 8735 dc.b 'V',5
-00003948= 0192 8736 dc.w KEY_VPTR-TAB_STAR * VARPTR(
-0000394A= 53 03 8737 dc.b 'S',3
-0000394C= 0137 8738 dc.w KEY_SADD-TAB_STAR * SADD(
-0000394E= 4C 04 8739 dc.b 'L',4
-00003950= 00B4 8740 dc.w KEY_LEFTS-TAB_STAR * LEFT$(
-00003952= 52 05 8741 dc.b 'R',5
-00003954= 0128 8742 dc.w KEY_RIGHTS-TAB_STAR * RIGHT$(
-00003956= 4D 03 8743 dc.b 'M',3
-00003958= 00DA 8744 dc.w KEY_MIDS-TAB_STAR * MID$(
-0000395A= 55 05 8745 dc.b 'U',5
-0000395C= 0182 8746 dc.w KEY_USINGS-TAB_STAR * USING$(
-0000395E 8747
-0000395E 8748
-0000395E 8749 *************************************************************************************
-0000395E 8750 *
-0000395E 8751 * BASIC error messages
-0000395E 8752
-0000395E 8753 LAB_BAER
-0000395E= 0030 8754 dc.w LAB_NF-LAB_BAER * $00 NEXT without FOR
-00003960= 0041 8755 dc.w LAB_SN-LAB_BAER * $02 syntax
-00003962= 0048 8756 dc.w LAB_RG-LAB_BAER * $04 RETURN without GOSUB
-00003964= 005D 8757 dc.w LAB_OD-LAB_BAER * $06 out of data
-00003966= 0069 8758 dc.w LAB_FC-LAB_BAER * $08 function call
-00003968= 0077 8759 dc.w LAB_OV-LAB_BAER * $0A overflow
-0000396A= 0080 8760 dc.w LAB_OM-LAB_BAER * $0C out of memory
-0000396C= 008E 8761 dc.w LAB_US-LAB_BAER * $0E undefined statement
-0000396E= 00A2 8762 dc.w LAB_BS-LAB_BAER * $10 array bounds
-00003970= 00AF 8763 dc.w LAB_DD-LAB_BAER * $12 double dimension array
-00003972= 00C0 8764 dc.w LAB_D0-LAB_BAER * $14 divide by 0
-00003974= 00CF 8765 dc.w LAB_ID-LAB_BAER * $16 illegal direct
-00003976= 00DE 8766 dc.w LAB_TM-LAB_BAER * $18 type mismatch
-00003978= 00EC 8767 dc.w LAB_LS-LAB_BAER * $1A long string
-0000397A= 00FC 8768 dc.w LAB_ST-LAB_BAER * $1C string too complex
-0000397C= 010F 8769 dc.w LAB_CN-LAB_BAER * $1E continue error
-0000397E= 011E 8770 dc.w LAB_UF-LAB_BAER * $20 undefined function
-00003980= 0131 8771 dc.w LAB_LD-LAB_BAER * $22 LOOP without DO
-00003982= 0141 8772 dc.w LAB_UV-LAB_BAER * $24 undefined variable
-00003984= 0154 8773 dc.w LAB_UA-LAB_BAER * $26 undimensioned array
-00003986= 0168 8774 dc.w LAB_WD-LAB_BAER * $28 wrong dimensions
-00003988= 0179 8775 dc.w LAB_AD-LAB_BAER * $2A address
-0000398A= 0181 8776 dc.w LAB_FO-LAB_BAER * $2C format
-0000398C= 0188 8777 dc.w LAB_NI-LAB_BAER * $2E not implemented
-0000398E 8778
-0000398E= 4E 45 58 54 20 77 ... 8779 LAB_NF dc.b 'NEXT without FOR',$00
-0000399F= 53 79 6E 74 61 78 00 8780 LAB_SN dc.b 'Syntax',$00
-000039A6= 52 45 54 55 52 4E ... 8781 LAB_RG dc.b 'RETURN without GOSUB',$00
-000039BB= 4F 75 74 20 6F 66 ... 8782 LAB_OD dc.b 'Out of DATA',$00
-000039C7= 46 75 6E 63 74 69 ... 8783 LAB_FC dc.b 'Function call',$00
-000039D5= 4F 76 65 72 66 6C ... 8784 LAB_OV dc.b 'Overflow',$00
-000039DE= 4F 75 74 20 6F 66 ... 8785 LAB_OM dc.b 'Out of memory',$00
-000039EC= 55 6E 64 65 66 69 ... 8786 LAB_US dc.b 'Undefined statement',$00
-00003A00= 41 72 72 61 79 20 ... 8787 LAB_BS dc.b 'Array bounds',$00
-00003A0D= 44 6F 75 62 6C 65 ... 8788 LAB_DD dc.b 'Double dimension',$00
-00003A1E= 44 69 76 69 64 65 ... 8789 LAB_D0 dc.b 'Divide by zero',$00
-00003A2D= 49 6C 6C 65 67 61 ... 8790 LAB_ID dc.b 'Illegal direct',$00
-00003A3C= 54 79 70 65 20 6D ... 8791 LAB_TM dc.b 'Type mismatch',$00
-00003A4A= 53 74 72 69 6E 67 ... 8792 LAB_LS dc.b 'String too long',$00
-00003A5A= 53 74 72 69 6E 67 ... 8793 LAB_ST dc.b 'String too complex',$00
-00003A6D= 43 61 6E 27 74 20 ... 8794 LAB_CN dc.b 'Can''t continue',$00
-00003A7C= 55 6E 64 65 66 69 ... 8795 LAB_UF dc.b 'Undefined function',$00
-00003A8F= 4C 4F 4F 50 20 77 ... 8796 LAB_LD dc.b 'LOOP without DO',$00
-00003A9F= 55 6E 64 65 66 69 ... 8797 LAB_UV dc.b 'Undefined variable',$00
-00003AB2= 55 6E 64 69 6D 65 ... 8798 LAB_UA dc.b 'Undimensioned array',$00
-00003AC6= 57 72 6F 6E 67 20 ... 8799 LAB_WD dc.b 'Wrong dimensions',$00
-00003AD7= 41 64 64 72 65 73 ... 8800 LAB_AD dc.b 'Address',$00
-00003ADF= 46 6F 72 6D 61 74 00 8801 LAB_FO dc.b 'Format',$00
-00003AE6= 4E 6F 74 20 69 6D ... 8802 LAB_NI dc.b 'Not implemented',$00
-00003AF6 8803
-00003AF6 8804
-00003AF6 8805 *************************************************************************************
-00003AF6 8806 *
-00003AF6 8807 * keyword table for line (un)crunching
-00003AF6 8808
-00003AF6 8809 * [keyword,token
-00003AF6 8810 * [keyword,token]]
-00003AF6 8811 * end marker (#$00)
-00003AF6 8812
-00003AF6 8813 TAB_STAR
-00003AF6 8814 KEY_MULT
-00003AF6= B4 00 8815 dc.b TK_MULT,$00 * *
-00003AF8 8816 TAB_PLUS
-00003AF8 8817 KEY_PLUS
-00003AF8= B2 00 8818 dc.b TK_PLUS,$00 * +
-00003AFA 8819 TAB_MNUS
-00003AFA 8820 KEY_MINUS
-00003AFA= B3 00 8821 dc.b TK_MINUS,$00 * -
-00003AFC 8822 TAB_SLAS
-00003AFC 8823 KEY_DIV
-00003AFC= B5 00 8824 dc.b TK_DIV,$00 * /
-00003AFE 8825 TAB_LESS
-00003AFE 8826 KEY_LSHIFT
-00003AFE= 3C BB 8827 dc.b '<',TK_LSHIFT * <<
-00003B00 8828 KEY_LT
-00003B00= BE 8829 dc.b TK_LT * <
-00003B01= 00 8830 dc.b $00
-00003B02 8831 TAB_EQUL
-00003B02 8832 KEY_EQUAL
-00003B02= BD 00 8833 dc.b TK_EQUAL,$00 * =
-00003B04 8834 TAB_MORE
-00003B04 8835 KEY_RSHIFT
-00003B04= 3E BA 8836 dc.b '>',TK_RSHIFT * >>
-00003B06 8837 KEY_GT
-00003B06= BC 8838 dc.b TK_GT * >
-00003B07= 00 8839 dc.b $00
-00003B08 8840 TAB_QEST
-00003B08= 9E 00 8841 dc.b TK_PRINT,$00 * ?
-00003B0A 8842 TAB_ASCA
-00003B0A 8843 KEY_ABS
-00003B0A= 42 53 28 C1 8844 dc.b 'BS(',TK_ABS * ABS(
-00003B0E 8845 KEY_AND
-00003B0E= 4E 44 B7 8846 dc.b 'ND',TK_AND * AND
-00003B11 8847 KEY_ASC
-00003B11= 53 43 28 D3 8848 dc.b 'SC(',TK_ASC * ASC(
-00003B15 8849 KEY_ATN
-00003B15= 54 4E 28 CC 8850 dc.b 'TN(',TK_ATN * ATN(
-00003B19= 00 8851 dc.b $00
-00003B1A 8852 TAB_ASCB
-00003B1A 8853 KEY_BINS
-00003B1A= 49 4E 24 28 D8 8854 dc.b 'IN$(',TK_BINS * BIN$(
-00003B1F 8855 KEY_BITCLR
-00003B1F= 49 54 43 4C 52 A7 8856 dc.b 'ITCLR',TK_BITCLR * BITCLR
-00003B25 8857 KEY_BITSET
-00003B25= 49 54 53 45 54 A6 8858 dc.b 'ITSET',TK_BITSET * BITSET
-00003B2B 8859 KEY_BITTST
-00003B2B= 49 54 54 53 54 28 D9 8860 dc.b 'ITTST(',TK_BITTST * BITTST(
-00003B32= 00 8861 dc.b $00
-00003B33 8862 TAB_ASCC
-00003B33 8863 KEY_CALL
-00003B33= 41 4C 4C 9B 8864 dc.b 'ALL',TK_CALL * CALL
-00003B37 8865 KEY_CHRS
-00003B37= 48 52 24 28 D6 8866 dc.b 'HR$(',TK_CHRS * CHR$(
-00003B3C 8867 KEY_CLEAR
-00003B3C= 4C 45 41 52 A1 8868 dc.b 'LEAR',TK_CLEAR * CLEAR
-00003B41 8869 KEY_CONT
-00003B41= 4F 4E 54 9F 8870 dc.b 'ONT',TK_CONT * CONT
-00003B45 8871 KEY_COS
-00003B45= 4F 53 28 C9 8872 dc.b 'OS(',TK_COS * COS(
-00003B49= 00 8873 dc.b $00
-00003B4A 8874 TAB_ASCD
-00003B4A 8875 KEY_DATA
-00003B4A= 41 54 41 83 8876 dc.b 'ATA',TK_DATA * DATA
-00003B4E 8877 KEY_DEC
-00003B4E= 45 43 88 8878 dc.b 'EC',TK_DEC * DEC
-00003B51 8879 KEY_DEEK
-00003B51= 45 45 4B 28 CE 8880 dc.b 'EEK(',TK_DEEK * DEEK(
-00003B56 8881 KEY_DEF
-00003B56= 45 46 97 8882 dc.b 'EF',TK_DEF * DEF
-00003B59 8883 KEY_DIM
-00003B59= 49 4D 85 8884 dc.b 'IM',TK_DIM * DIM
-00003B5C 8885 KEY_DOKE
-00003B5C= 4F 4B 45 99 8886 dc.b 'OKE',TK_DOKE * DOKE
-00003B60 8887 KEY_DO
-00003B60= 4F 9C 8888 dc.b 'O',TK_DO * DO
-00003B62= 00 8889 dc.b $00
-00003B63 8890 TAB_ASCE
-00003B63 8891 KEY_ELSE
-00003B63= 4C 53 45 A9 8892 dc.b 'LSE',TK_ELSE * ELSE
-00003B67 8893 KEY_END
-00003B67= 4E 44 80 8894 dc.b 'ND',TK_END * END
-00003B6A 8895 KEY_EOR
-00003B6A= 4F 52 B8 8896 dc.b 'OR',TK_EOR * EOR
-00003B6D 8897 KEY_EXP
-00003B6D= 58 50 28 C8 8898 dc.b 'XP(',TK_EXP * EXP(
-00003B71= 00 8899 dc.b $00
-00003B72 8900 TAB_ASCF
-00003B72 8901 KEY_FOR
-00003B72= 4F 52 81 8902 dc.b 'OR',TK_FOR * FOR
-00003B75 8903 KEY_FN
-00003B75= 4E AB 8904 dc.b 'N',TK_FN * FN
-00003B77 8905 KEY_FRE
-00003B77= 52 45 28 C3 8906 dc.b 'RE(',TK_FRE * FRE(
-00003B7B= 00 8907 dc.b $00
-00003B7C 8908 TAB_ASCG
-00003B7C 8909 KEY_GET
-00003B7C= 45 54 A4 8910 dc.b 'ET',TK_GET * GET
-00003B7F 8911 KEY_GOTO
-00003B7F= 4F 54 4F 89 8912 dc.b 'OTO',TK_GOTO * GOTO
-00003B83 8913 KEY_GOSUB
-00003B83= 4F 53 55 42 8D 8914 dc.b 'OSUB',TK_GOSUB * GOSUB
-00003B88= 00 8915 dc.b $00
-00003B89 8916 TAB_ASCH
-00003B89 8917 KEY_HEXS
-00003B89= 45 58 24 28 D7 00 8918 dc.b 'EX$(',TK_HEXS,$00 * HEX$(
-00003B8F 8919 TAB_ASCI
-00003B8F 8920 KEY_IF
-00003B8F= 46 8B 8921 dc.b 'F',TK_IF * IF
-00003B91 8922 KEY_INC
-00003B91= 4E 43 93 8923 dc.b 'NC',TK_INC * INC
-00003B94 8924 KEY_INPUT
-00003B94= 4E 50 55 54 84 8925 dc.b 'NPUT',TK_INPUT * INPUT
-00003B99 8926 KEY_INT
-00003B99= 4E 54 28 C0 8927 dc.b 'NT(',TK_INT * INT(
-00003B9D= 00 8928 dc.b $00
-00003B9E 8929 TAB_ASCL
-00003B9E 8930 KEY_LCASES
-00003B9E= 43 41 53 45 24 28 D5 8931 dc.b 'CASE$(',TK_LCASES * LCASE$(
-00003BA5 8932 KEY_LEEK
-00003BA5= 45 45 4B 28 CF 8933 dc.b 'EEK(',TK_LEEK * LEEK(
-00003BAA 8934 KEY_LEFTS
-00003BAA= 45 46 54 24 28 E1 8935 dc.b 'EFT$(',TK_LEFTS * LEFT$(
-00003BB0 8936 KEY_LEN
-00003BB0= 45 4E 28 D0 8937 dc.b 'EN(',TK_LEN * LEN(
-00003BB4 8938 KEY_LET
-00003BB4= 45 54 87 8939 dc.b 'ET',TK_LET * LET
-00003BB7 8940 KEY_LIST
-00003BB7= 49 53 54 A0 8941 dc.b 'IST',TK_LIST * LIST
-00003BBB 8942 KEY_LOAD
-00003BBB= 4F 41 44 95 8943 dc.b 'OAD',TK_LOAD * LOAD
-00003BBF 8944 KEY_LOG
-00003BBF= 4F 47 28 C7 8945 dc.b 'OG(',TK_LOG * LOG(
-00003BC3 8946 KEY_LOKE
-00003BC3= 4F 4B 45 9A 8947 dc.b 'OKE',TK_LOKE * LOKE
-00003BC7 8948 KEY_LOOP
-00003BC7= 4F 4F 50 9D 8949 dc.b 'OOP',TK_LOOP * LOOP
-00003BCB= 00 8950 dc.b $00
-00003BCC 8951 TAB_ASCM
-00003BCC 8952 KEY_MAX
-00003BCC= 41 58 28 DA 8953 dc.b 'AX(',TK_MAX * MAX(
-00003BD0 8954 KEY_MIDS
-00003BD0= 49 44 24 28 E3 8955 dc.b 'ID$(',TK_MIDS * MID$(
-00003BD5 8956 KEY_MIN
-00003BD5= 49 4E 28 DB 8957 dc.b 'IN(',TK_MIN * MIN(
-00003BD9= 00 8958 dc.b $00
-00003BDA 8959 TAB_ASCN
-00003BDA 8960 KEY_NEW
-00003BDA= 45 57 A2 8961 dc.b 'EW',TK_NEW * NEW
-00003BDD 8962 KEY_NEXT
-00003BDD= 45 58 54 82 8963 dc.b 'EXT',TK_NEXT * NEXT
-00003BE1 8964 KEY_NOT
-00003BE1= 4F 54 AE 8965 dc.b 'OT',TK_NOT * NOT
-00003BE4 8966 KEY_NULL
-00003BE4= 55 4C 4C 92 8967 dc.b 'ULL',TK_NULL * NULL
-00003BE8= 00 8968 dc.b $00
-00003BE9 8969 TAB_ASCO
-00003BE9 8970 KEY_ON
-00003BE9= 4E 91 8971 dc.b 'N',TK_ON * ON
-00003BEB 8972 KEY_OR
-00003BEB= 52 B9 8973 dc.b 'R',TK_OR * OR
-00003BED= 00 8974 dc.b $00
-00003BEE 8975 TAB_ASCP
-00003BEE 8976 KEY_PEEK
-00003BEE= 45 45 4B 28 CD 8977 dc.b 'EEK(',TK_PEEK * PEEK(
-00003BF3 8978 KEY_PI
-00003BF3= 49 DD 8979 dc.b 'I',TK_PI * PI
-00003BF5 8980 KEY_POKE
-00003BF5= 4F 4B 45 98 8981 dc.b 'OKE',TK_POKE * POKE
-00003BF9 8982 KEY_POS
-00003BF9= 4F 53 28 C4 8983 dc.b 'OS(',TK_POS * POS(
-00003BFD 8984 KEY_PRINT
-00003BFD= 52 49 4E 54 9E 8985 dc.b 'RINT',TK_PRINT * PRINT
-00003C02= 00 8986 dc.b $00
-00003C03 8987 TAB_ASCR
-00003C03 8988 KEY_RAM
-00003C03= 41 4D 42 41 53 45 DC 8989 dc.b 'AMBASE',TK_RAM * RAMBASE
-00003C0A 8990 KEY_READ
-00003C0A= 45 41 44 86 8991 dc.b 'EAD',TK_READ * READ
-00003C0E 8992 KEY_REM
-00003C0E= 45 4D 8F 8993 dc.b 'EM',TK_REM * REM
-00003C11 8994 KEY_RESTORE
-00003C11= 45 53 54 4F 52 45 8C 8995 dc.b 'ESTORE',TK_RESTORE * RESTORE
-00003C18 8996 KEY_RETURN
-00003C18= 45 54 55 52 4E 8E 8997 dc.b 'ETURN',TK_RETURN * RETURN
-00003C1E 8998 KEY_RIGHTS
-00003C1E= 49 47 48 54 24 28 E2 8999 dc.b 'IGHT$(',TK_RIGHTS * RIGHT$(
-00003C25 9000 KEY_RND
-00003C25= 4E 44 28 C6 9001 dc.b 'ND(',TK_RND * RND(
-00003C29 9002 KEY_RUN
-00003C29= 55 4E 8A 9003 dc.b 'UN',TK_RUN * RUN
-00003C2C= 00 9004 dc.b $00
-00003C2D 9005 TAB_ASCS
-00003C2D 9006 KEY_SADD
-00003C2D= 41 44 44 28 E0 9007 dc.b 'ADD(',TK_SADD * SADD(
-00003C32 9008 KEY_SAVE
-00003C32= 41 56 45 96 9009 dc.b 'AVE',TK_SAVE * SAVE
-00003C36 9010 KEY_SGN
-00003C36= 47 4E 28 BF 9011 dc.b 'GN(',TK_SGN * SGN(
-00003C3A 9012 KEY_SIN
-00003C3A= 49 4E 28 CA 9013 dc.b 'IN(',TK_SIN * SIN(
-00003C3E 9014 KEY_SPC
-00003C3E= 50 43 28 AC 9015 dc.b 'PC(',TK_SPC * SPC(
-00003C42 9016 KEY_SQR
-00003C42= 51 52 28 C5 9017 dc.b 'QR(',TK_SQR * SQR(
-00003C46 9018 KEY_STEP
-00003C46= 54 45 50 AF 9019 dc.b 'TEP',TK_STEP * STEP
-00003C4A 9020 KEY_STOP
-00003C4A= 54 4F 50 90 9021 dc.b 'TOP',TK_STOP * STOP
-00003C4E 9022 KEY_STRS
-00003C4E= 54 52 24 28 D1 9023 dc.b 'TR$(',TK_STRS * STR$(
-00003C53 9024 KEY_SWAP
-00003C53= 57 41 50 A5 9025 dc.b 'WAP',TK_SWAP * SWAP
-00003C57= 00 9026 dc.b $00
-00003C58 9027 TAB_ASCT
-00003C58 9028 KEY_TAB
-00003C58= 41 42 28 A8 9029 dc.b 'AB(',TK_TAB * TAB(
-00003C5C 9030 KEY_TAN
-00003C5C= 41 4E 28 CB 9031 dc.b 'AN(',TK_TAN * TAN
-00003C60 9032 KEY_THEN
-00003C60= 48 45 4E AD 9033 dc.b 'HEN',TK_THEN * THEN
-00003C64 9034 KEY_TO
-00003C64= 4F AA 9035 dc.b 'O',TK_TO * TO
-00003C66 9036 KEY_TWOPI
-00003C66= 57 4F 50 49 DE 9037 dc.b 'WOPI',TK_TWOPI * TWOPI
-00003C6B= 00 9038 dc.b $00
-00003C6C 9039 TAB_ASCU
-00003C6C 9040 KEY_UCASES
-00003C6C= 43 41 53 45 24 28 D4 9041 dc.b 'CASE$(',TK_UCASES * UCASE$(
-00003C73 9042 KEY_UNTIL
-00003C73= 4E 54 49 4C B0 9043 dc.b 'NTIL',TK_UNTIL * UNTIL
-00003C78 9044 KEY_USINGS
-00003C78= 53 49 4E 47 24 28 E4 9045 dc.b 'SING$(',TK_USINGS * USING$(
-00003C7F 9046 KEY_USR
-00003C7F= 53 52 28 C2 9047 dc.b 'SR(',TK_USR * USR(
-00003C83= 00 9048 dc.b $00
-00003C84 9049 TAB_ASCV
-00003C84 9050 KEY_VAL
-00003C84= 41 4C 28 D2 9051 dc.b 'AL(',TK_VAL * VAL(
-00003C88 9052 KEY_VPTR
-00003C88= 41 52 50 54 52 28 DF 9053 dc.b 'ARPTR(',TK_VPTR * VARPTR(
-00003C8F= 00 9054 dc.b $00
-00003C90 9055 TAB_ASCW
-00003C90 9056 KEY_WAIT
-00003C90= 41 49 54 94 9057 dc.b 'AIT',TK_WAIT * WAIT
-00003C94 9058 KEY_WHILE
-00003C94= 48 49 4C 45 B1 9059 dc.b 'HILE',TK_WHILE * WHILE
-00003C99 9060 KEY_WIDTH
-00003C99= 49 44 54 48 A3 9061 dc.b 'IDTH',TK_WIDTH * WIDTH
-00003C9E= 00 9062 dc.b $00
-00003C9F 9063 TAB_POWR
-00003C9F 9064 KEY_POWER
-00003C9F= B6 00 9065 dc.b TK_POWER,$00 * ^
-00003CA1 9066
-00003CA1 9067
-00003CA1 9068 *************************************************************************************
-00003CA1 9069 *
-00003CA1 9070 * just messages
-00003CA1 9071
-00003CA1 9072 LAB_BMSG
-00003CA1= 0D 0A 42 72 65 61 ... 9073 dc.b $0D,$0A,'Break',$00
-00003CA9 9074 LAB_EMSG
-00003CA9= 20 45 72 72 6F 72 00 9075 dc.b ' Error',$00
-00003CB0 9076 LAB_LMSG
-00003CB0= 20 69 6E 20 6C 69 ... 9077 dc.b ' in line ',$00
-00003CBA 9078 LAB_IMSG
-00003CBA= 45 78 74 72 61 20 ... 9079 dc.b 'Extra ignored',$0D,$0A,$00
-00003CCA 9080 LAB_REDO
-00003CCA= 52 65 64 6F 20 66 ... 9081 dc.b 'Redo from start',$0D,$0A,$00
-00003CDC 9082 LAB_RMSG
-00003CDC= 0D 0A 52 65 61 64 ... 9083 dc.b $0D,$0A,'Ready',$0D,$0A,$00
-00003CE6 9084 LAB_SMSG
-00003CE6= 20 42 79 74 65 73 ... 9085 dc.b ' Bytes free',$0D,$0A,$0A
-00003CF4= 45 6E 68 61 6E 63 ... 9086 dc.b 'Enhanced 68k BASIC Version 3.52',$0D,$0A,$00
-00003D16 9087
-00003D16 9088
-00003D16 9089 *************************************************************************************
-00003D16 9090 * EhBASIC keywords quick reference list *
-00003D16 9091 *************************************************************************************
-00003D16 9092
-00003D16 9093 * glossary
-00003D16 9094
-00003D16 9095 * <.> required
-00003D16 9096 * {.|.} one of required
-00003D16 9097 * [.] optional
-00003D16 9098 * ... may repeat as last
-00003D16 9099
-00003D16 9100 * any = anything
-00003D16 9101 * num = number
-00003D16 9102 * state = statement
-00003D16 9103 * n = positive integer
-00003D16 9104 * str = string
-00003D16 9105 * var = variable
-00003D16 9106 * nvar = numeric variable
-00003D16 9107 * svar = string variable
-00003D16 9108 * expr = expression
-00003D16 9109 * nexpr = numeric expression
-00003D16 9110 * sexpr = string expression
-00003D16 9111
-00003D16 9112 * statement separator
-00003D16 9113
-00003D16 9114 * : . [] : [] * done
-00003D16 9115
-00003D16 9116 * number bases
-00003D16 9117
-00003D16 9118 * % . % * done
-00003D16 9119 * $ . $ * done
-00003D16 9120
-00003D16 9121 * commands
-00003D16 9122
-00003D16 9123 * END . END * done
-00003D16 9124 * FOR . FOR = TO [STEP ] * done
-00003D16 9125 * NEXT . NEXT [[,]...] * done
-00003D16 9126 * DATA . DATA [{num|["]str["]}[,{num|["]str["]}]...] * done
-00003D16 9127 * INPUT . INPUT [<">str<">;] [,[,]...] * done
-00003D16 9128 * DIM . DIM ([,[,]]) * done
-00003D16 9129 * READ . READ [,[,]...] * done
-00003D16 9130 * LET . [LET] = * done
-00003D16 9131 * DEC . DEC [,[,]...] * done
-00003D16 9132 * GOTO . GOTO * done
-00003D16 9133 * RUN . RUN [] * done
-00003D16 9134 * IF . IF {GOTO|THEN<{n|comm}>}[ELSE <{n|comm}>] * done
-00003D16 9135 * RESTORE . RESTORE [] * done
-00003D16 9136 * GOSUB . GOSUB * done
-00003D16 9137 * RETURN . RETURN * done
-00003D16 9138 * REM . REM [] * done
-00003D16 9139 * STOP . STOP * done
-00003D16 9140 * ON . ON {GOTO|GOSUB}[,[,]...] * done
-00003D16 9141 * NULL . NULL * done
-00003D16 9142 * INC . INC [,[,]...] * done
-00003D16 9143 * WAIT . WAIT ,[,] * done
-00003D16 9144 * LOAD . LOAD [] * done for sim
-00003D16 9145 * SAVE . SAVE [][,[][-]] * done for sim
-00003D16 9146 * DEF . DEF FN()= * done
-00003D16 9147 * POKE . POKE , * done
-00003D16 9148 * DOKE . DOKE , * done
-00003D16 9149 * LOKE . LOKE , * done
-00003D16 9150 * CALL . CALL * done
-00003D16 9151 * DO . DO * done
-00003D16 9152 * LOOP . LOOP [{WHILE|UNTIL}] * done
-00003D16 9153 * PRINT . PRINT [{;|,}][][{;|,}[]...] * done
-00003D16 9154 * CONT . CONT * done
-00003D16 9155 * LIST . LIST [][-] * done
-00003D16 9156 * CLEAR . CLEAR * done
-00003D16 9157 * NEW . NEW * done
-00003D16 9158 * WIDTH . WIDTH [][,] * done
-00003D16 9159 * GET . GET * done
-00003D16 9160 * SWAP . SWAP , * done
-00003D16 9161 * BITSET . BITSET , * done
-00003D16 9162 * BITCLR . BITCLR , * done
-00003D16 9163
-00003D16 9164 * sub commands (may not start a statement)
-00003D16 9165
-00003D16 9166 * TAB . TAB() * done
-00003D16 9167 * ELSE . IF {GOTO|THEN<{n|comm}>}[ELSE <{n|comm}>] * done
-00003D16 9168 * TO . FOR = TO [STEP ] * done
-00003D16 9169 * FN . FN () * done
-00003D16 9170 * SPC . SPC() * done
-00003D16 9171 * THEN . IF {THEN <{n|comm}>|GOTO } * done
-00003D16 9172 * NOT . NOT * done
-00003D16 9173 * STEP . FOR = TO [STEP ] * done
-00003D16 9174 * UNTIL . LOOP [{WHILE|UNTIL}] * done
-00003D16 9175 * WHILE . LOOP [{WHILE|UNTIL}] * done
-00003D16 9176
-00003D16 9177 * operators
-00003D16 9178
-00003D16 9179 * + . [expr] + * done
-00003D16 9180 * - . [nexpr] - * done
-00003D16 9181 * * . * * done fast hardware
-00003D16 9182 * / . / * done fast hardware
-00003D16 9183 * ^ . ^ * done
-00003D16 9184 * AND . AND * done
-00003D16 9185 * EOR . EOR * done
-00003D16 9186 * OR . OR * done
-00003D16 9187 * >> . >> * done
-00003D16 9188 * << . << * done
-00003D16 9189
-00003D16 9190 * compare functions
-00003D16 9191
-00003D16 9192 * < . < * done
-00003D16 9193 * = . = * done
-00003D16 9194 * > . > * done
-00003D16 9195
-00003D16 9196 * functions
-00003D16 9197
-00003D16 9198 * SGN . SGN() * done
-00003D16 9199 * INT . INT() * done
-00003D16 9200 * ABS . ABS() * done
-00003D16 9201 * USR . USR() * done
-00003D16 9202 * FRE . FRE() * done
-00003D16 9203 * POS . POS() * done
-00003D16 9204 * SQR . SQR() * done fast shift/sub
-00003D16 9205 * RND . RND() * done 32 bit PRNG
-00003D16 9206 * LOG . LOG() * done fast cordic
-00003D16 9207 * EXP . EXP() * done fast cordic
-00003D16 9208 * COS . COS() * done fast cordic
-00003D16 9209 * SIN . SIN() * done fast cordic
-00003D16 9210 * TAN . TAN() * done fast cordic
-00003D16 9211 * ATN . ATN() * done fast cordic
-00003D16 9212 * PEEK . PEEK() * done
-00003D16 9213 * DEEK . DEEK() * done
-00003D16 9214 * LEEK . LEEK() * done
-00003D16 9215 * LEN . LEN() * done
-00003D16 9216 * STR$ . STR$() * done
-00003D16 9217 * VAL . VAL() * done
-00003D16 9218 * ASC . ASC() * done
-00003D16 9219 * UCASE$ . UCASE$() * done
-00003D16 9220 * LCASE$ . LCASE$() * done
-00003D16 9221 * CHR$ . CHR$() * done
-00003D16 9222 * HEX$ . HEX$() * done
-00003D16 9223 * BIN$ . BIN$() * done
-00003D16 9224 * BTST . BTST(,) * done
-00003D16 9225 * MAX . MAX([,[,]...]) * done
-00003D16 9226 * MIN . MIN([,[,]...]) * done
-00003D16 9227 * PI . PI * done
-00003D16 9228 * TWOPI . TWOPI * done
-00003D16 9229 * VARPTR . VARPTR() * done
-00003D16 9230 * SADD . SADD() * done
-00003D16 9231 * LEFT$ . LEFT$(,) * done
-00003D16 9232 * RIGHT$ . RIGHT$(,) * done
-00003D16 9233 * MID$ . MID$(,[,]) * done
-00003D16 9234 * USING$ . USING$(,[,]...]) * done
-00003D16 9235
-00003D16 9236
-00003D16 9237 *************************************************************************************
-00003D16 9238
-00003D16 9239 END code_start
+00000064 72 ORG 100 * start of RAM
+00000064 73
+00000064 74 ram_strt ds.l $100 * allow 1K for the stack, this should be plenty
+00000464 75 * for any BASIC program that doesn't do something
+00000464 76 * silly, it could even be much less.
+00000464 77 ram_base
+00000464 78 LAB_WARM ds.w 1 * BASIC warm start entry point
+00000466 79 Wrmjpv ds.l 1 * BASIC warm start jump vector
+0000046A 80
+0000046A 81 Usrjmp ds.w 1 * USR function JMP address
+0000046C 82 Usrjpv ds.l 1 * USR function JMP vector
+00000470 83
+00000470 84
+00000470 85 V_INPT ds.w 1 * non halting scan input device entry point
+00000472 86 V_INPTv ds.l 1 * non halting scan input device jump vector
+00000476 87
+00000476 88 V_OUTP ds.w 1 * send byte to output device entry point
+00000478 89 V_OUTPv ds.l 1 * send byte to output device jump vector
+0000047C 90
+0000047C 91 V_LOAD ds.w 1 * load BASIC program entry point
+0000047E 92 V_LOADv ds.l 1 * load BASIC program jump vector
+00000482 93
+00000482 94 V_SAVE ds.w 1 * save BASIC program entry point
+00000484 95 V_SAVEv ds.l 1 * save BASIC program jump vector
+00000488 96
+00000488 97 V_CTLC ds.w 1 * save CTRL-C check entry point
+0000048A 98 V_CTLCv ds.l 1 * save CTRL-C check jump vector
+0000048E 99
+0000048E 100 Itemp ds.l 1 * temporary integer (for GOTO etc)
+00000492 101
+00000492 102 Smeml ds.l 1 * start of memory (start of program)
+00000496 103
+00000496 104
+00000496 105 Sfncl ds.l 1 * start of functions (end of Program)
+0000049A 106
+0000049A 107
+0000049A 108 Svarl ds.l 1 * start of variables (end of functions)
+0000049E 109
+0000049E 110
+0000049E 111 Sstrl ds.l 1 * start of strings (end of variables)
+000004A2 112
+000004A2 113
+000004A2 114 Sarryl ds.l 1 * start of arrays (end of strings)
+000004A6 115
+000004A6 116
+000004A6 117 Earryl ds.l 1 * end of arrays (start of free mem)
+000004AA 118 Sstorl ds.l 1 * string storage (moving down)
+000004AE 119 Ememl ds.l 1 * end of memory (upper bound of RAM)
+000004B2 120 Sutill ds.l 1 * string utility ptr
+000004B6 121 Clinel ds.l 1 * current line (Basic line number)
+000004BA 122 Blinel ds.l 1 * break line (Basic line number)
+000004BE 123
+000004BE 124 Cpntrl ds.l 1 * continue pointer
+000004C2 125 Dlinel ds.l 1 * current DATA line
+000004C6 126 Dptrl ds.l 1 * DATA pointer
+000004CA 127 Rdptrl ds.l 1 * read pointer
+000004CE 128 Varname ds.l 1 * current var name
+000004D2 129 Cvaral ds.l 1 * current var address
+000004D6 130 Lvarpl ds.l 1 * variable pointer for LET and FOR/NEXT
+000004DA 131
+000004DA 132 des_sk_e ds.l 6 * descriptor stack end address
+000004F2 133 des_sk * descriptor stack start address
+000004F2 134 * use a4 for the descriptor pointer
+000004F2 135 ds.w 1
+000004F4 136 Ibuffs ds.l $40 * start of input buffer
+000005F4 137 Ibuffe
+000005F4 138 * end of input buffer
+000005F4 139
+000005F4 140 FAC1_m ds.l 1 * FAC1 mantissa1
+000005F8 141 FAC1_e ds.w 1 * FAC1 exponent
+000005FA =000005F9 142 FAC1_s EQU FAC1_e+1 * FAC1 sign (b7)
+000005FA 143 ds.w 1
+000005FC 144
+000005FC 145 FAC2_m ds.l 1 * FAC2 mantissa1
+00000600 146 FAC2_e ds.l 1 * FAC2 exponent
+00000604 =00000601 147 FAC2_s EQU FAC2_e+1 * FAC2 sign (b7)
+00000604 =00000602 148 FAC_sc EQU FAC2_e+2 * FAC sign comparison, Acc#1 vs #2
+00000604 =00000603 149 flag EQU FAC2_e+3 * flag byte for divide routine
+00000604 150
+00000604 151 PRNlword ds.l 1 * PRNG seed long word
+00000608 152
+00000608 153 ut1_pl ds.l 1 * utility pointer 1
+0000060C 154
+0000060C 155 Asptl ds.l 1 * array size/pointer
+00000610 156 Astrtl ds.l 1 * array start pointer
+00000614 157
+00000614 =00000610 158 numexp EQU Astrtl * string to float number exponent count
+00000614 =00000611 159 expcnt EQU Astrtl+1 * string to float exponent count
+00000614 160
+00000614 =00000613 161 expneg EQU Astrtl+3 * string to float eval exponent -ve flag
+00000614 162
+00000614 163 func_l ds.l 1 * function pointer
+00000618 164
+00000618 165
+00000618 166 * these two need to be a word aligned pair !
+00000618 167 Defdim ds.w 1 * default DIM flag
+0000061A =00000618 168 cosout EQU Defdim * flag which CORDIC output (re-use byte)
+0000061A =00000619 169 Dtypef EQU Defdim+1 * data type flag, $80=string, $40=integer, $00=float
+0000061A 170
+0000061A 171
+0000061A 172 Binss ds.l 4 * number to bin string start (32 chrs)
+0000062A 173
+0000062A 174 Decss ds.l 1 * number to decimal string start (16 chrs)
+0000062E 175 ds.w 1 *
+00000630 176 Usdss ds.w 1 * unsigned decimal string start (10 chrs)
+00000632 177
+00000632 178 Hexss ds.l 2 * number to hex string start (8 chrs)
+0000063A 179
+0000063A 180 BHsend ds.w 1 * bin/decimal/hex string end
+0000063C 181
+0000063C 182
+0000063C 183 prstk ds.b 1 * stacked function index
+0000063D 184
+0000063D 185 tpower ds.b 1 * remember CORDIC power
+0000063E 186
+0000063E 187 Asrch ds.b 1 * scan-between-quotes flag, alt search character
+0000063F 188
+0000063F 189 Dimcnt ds.b 1 * # of dimensions
+00000640 190
+00000640 191 Breakf ds.b 1 * break flag, $00=END else=break
+00000641 192 Oquote ds.b 1 * open quote flag (Flag: DATA; LIST; memory)
+00000642 193 Gclctd ds.b 1 * garbage collected flag
+00000643 194 Sufnxf ds.b 1 * subscript/FNX flag, 1xxx xxx = FN(0xxx xxx)
+00000644 195 Imode ds.b 1 * input mode flag, $00=INPUT, $98=READ
+00000645 196
+00000645 197 Cflag ds.b 1 * comparison evaluation flag
+00000646 198
+00000646 199 TabSiz ds.b 1 * TAB step size
+00000647 200
+00000647 201 comp_f ds.b 1 * compare function flag, bits 0,1 and 2 used
+00000648 202 * bit 2 set if >
+00000648 203 * bit 1 set if =
+00000648 204 * bit 0 set if <
+00000648 205
+00000648 206 Nullct ds.b 1 * nulls output after each line
+00000649 207 TPos ds.b 1 * BASIC terminal position byte
+0000064A 208 TWidth ds.b 1 * BASIC terminal width byte
+0000064B 209 Iclim ds.b 1 * input column limit
+0000064C 210 ccflag ds.b 1 * CTRL-C check flag
+0000064D 211 ccbyte ds.b 1 * CTRL-C last received byte
+0000064E 212 ccnull ds.b 1 * CTRL-C last received byte 'life' timer
+0000064F 213
+0000064F 214
+0000064F 215 file_byte ds.b 1 * load/save data byte
+00000650 216 file_id ds.l 1 * load/save file ID
+00000654 217
+00000654 218 even * dummy even value and zero pad byte
+00000654 219
+00000654 220 -------------------- end include --------------------
+00000654 221 * RAM offset definitions
+00000654 222 prg_strt
+00000654 223 * Use this value to run out of ROM
+00B00000 224 ORG $B00000 * past the vectors in a real system
+00B00000 225 * Use this value to run out of RAM
+00B00000 226 * ORG $000800 * past the vectors in a real system
+00B00000 227
+00B00000 228
+00B00000 229
+00B00000 230 * Use these two lines when running from RAM
+00B00000 231 *ram_addr EQU $04000 * RAM start address
+00B00000 232 *ram_size EQU $04000 * RAM size
+00B00000 233
+00B00000 234 * Use these two lines when running from ROM
+00B00000 =00002000 235 ram_addr EQU $02000 * RAM start address
+00B00000 =00008000 236 ram_size EQU $08000 * RAM size
+00B00000 237
+00B00000 =00F00009 238 ACIAC EQU $F00009
+00B00000 =00F0000B 239 ACIAD EQU ACIAC+2
+00B00000 =00000000 240 RDRF EQU 0 ; ACIAC Receive Data Register Full
+00B00000 =00000001 241 TDRE EQU 1 ; ACIAC Transmit Data Register Empty
+00B00000 242
+00B00000 6000 003C 243 BRA code_start * For convenience, so you can start from first address
+00B00004 244
+00B00004 245 *************************************************************************************
+00B00004 246 *
+00B00004 247 * the following code is simulator specific, change to suit your system
+00B00004 248 * output character to the console from register d0.b
+00B00004 249
+00B00004 250
+00B00004 251 VEC_OUT
+00B00004 0839 0001 00F00009 252 BTST.B #TDRE,ACIAC.L
+00B0000C 67F6 253 BEQ.S VEC_OUT
+00B0000E 13C0 00F0000B 254 MOVE.B D0,ACIAD.L
+00B00014 4E75 255 RTS
+00B00016 256
+00B00016 257 *************************************************************************************
+00B00016 258 *
+00B00016 259 * input a character from the console into register d0
+00B00016 260 * else return Cb=0 if theres no character available
+00B00016 261
+00B00016 262
+00B00016 263 VEC_IN
+00B00016 0839 0000 00F00009 264 BTST.B #RDRF,ACIAC.L
+00B0001E 670C 265 BEQ.S RXNOTREADY
+00B00020 1039 00F0000B 266 MOVE.B ACIAD.L,D0
+00B00026 003C 0001 267 ORI.b #1,CCR * Set the carry, flag we got a byte
+00B0002A 4E75 268 RTS * Return
+00B0002C 269 RXNOTREADY
+00B0002C 023C 00FE 270 ANDI.b #$FE,CCR * Clear the carry, flag character available
+00B00030 4E75 271 RTS
+00B00032 272
+00B00032 273 *************************************************************************************
+00B00032 274 *
+00B00032 275 * LOAD routine for the TS2 computer (not implemented)
+00B00032 276
+00B00032 277 VEC_LD
+00B00032 7E2E 278 MOVEQ #$2E,d7 * error code $2E "Not implemented" error
+00B00034 6000 013A 279 BRA LAB_XERR * do error #d7, then warm start
+00B00038 280
+00B00038 281 *************************************************************************************
+00B00038 282 *
+00B00038 283 * SAVE routine for the TS2 computer (not implemented)
+00B00038 284
+00B00038 285 VEC_SV
+00B00038 7E2E 286 MOVEQ #$2E,d7 * error code $2E "Not implemented" error
+00B0003A 6000 0134 287 BRA LAB_XERR * do error #d7, then warm start
+00B0003E 288
+00B0003E 289 *************************************************************************************
+00B0003E 290 *
+00B0003E 291 * turn off simulator key echo
+00B0003E 292
+00B0003E 293 code_start
+00B0003E 294 * Set up ACIA parameters
+00B0003E 41F9 00F00009 295 LEA.L ACIAC,A0 * A0 points to console ACIA
+00B00044 10BC 0015 296 MOVE.B #$15,(A0) * Set up ACIA1 constants (no IRQ,
+00B00048 297 * RTS* low, 8 bit, no parity, 1 stop)
+00B00048 298
+00B00048 299 * to tell EhBASIC where and how much RAM it has pass the address in a0 and the size
+00B00048 300 * in d0. these values are at the end of the .inc file
+00B00048 301
+00B00048 207C 00002000 302 MOVEA.l #ram_addr,a0 * tell BASIC where RAM starts
+00B0004E 203C 00008000 303 MOVE.l #ram_size,d0 * tell BASIC how big RAM is
+00B00054 304
+00B00054 305 * end of simulator specific code
+00B00054 306
+00B00054 307
+00B00054 308 ****************************************************************************************
+00B00054 309 ****************************************************************************************
+00B00054 310 ****************************************************************************************
+00B00054 311 ****************************************************************************************
+00B00054 312 *
+00B00054 313 * Register use :- (must improve this !!)
+00B00054 314 *
+00B00054 315 * a6 - temp Bpntr * temporary BASIC execute pointer
+00B00054 316 * a5 - Bpntr * BASIC execute (get byte) pointer
+00B00054 317 * a4 - des_sk * descriptor stack pointer
+00B00054 318 * a3 - ram_strt * start of RAM. all RAM references are offsets
+00B00054 319 * * from this value
+00B00054 320 *
+00B00054 321
+00B00054 322 *************************************************************************************
+00B00054 323 *
+00B00054 324 * BASIC cold start entry point. assume entry with RAM address in a0 and RAM length
+00B00054 325 * in d0
+00B00054 326
+00B00054 327 LAB_COLD
+00B00054 B0BC 00004000 328 CMP.l #$4000,d0 * compare size with 16k
+00B0005A 6C08 329 BGE.s LAB_sizok * branch if >= 16k
+00B0005C 330
+00B0005C 7005 331 MOVEQ #5,d0 * error 5 - not enough RAM
+00B0005E 1E3C 00E4 332 move.b #228,D7 * Go to TUTOR function
+00B00062 4E4E 333 trap #14 * Call TRAP14 handler
+00B00064 334
+00B00064 335 LAB_sizok
+00B00064 2648 336 MOVEA.l a0,a3 * copy RAM base to a3
+00B00066 D1C0 337 ADDA.l d0,a0 * a0 is top of RAM
+00B00068 2748 04AE 338 MOVE.l a0,Ememl(a3) * set end of mem
+00B0006C 4FEB 0464 339 LEA ram_base(a3),sp * set stack to RAM start + 1k
+00B00070 340
+00B00070 303C 4EF9 341 MOVE.w #$4EF9,d0 * JMP opcode
+00B00074 204F 342 MOVEA.l sp,a0 * point to start of vector table
+00B00076 343
+00B00076 30C0 344 MOVE.w d0,(a0)+ * LAB_WARM
+00B00078 43FA FFDA 345 LEA LAB_COLD(pc),a1 * initial warm start vector
+00B0007C 20C9 346 MOVE.l a1,(a0)+ * set vector
+00B0007E 347
+00B0007E 30C0 348 MOVE.w d0,(a0)+ * Usrjmp
+00B00080 43FA 00DC 349 LEA LAB_FCER(pc),a1 * initial user function vector
+00B00084 350 * "Function call" error
+00B00084 20C9 351 MOVE.l a1,(a0)+ * set vector
+00B00086 352
+00B00086 30C0 353 MOVE.w d0,(a0)+ * V_INPT JMP opcode
+00B00088 43FA FF8C 354 LEA VEC_IN(pc),a1 * get byte from input device vector
+00B0008C 20C9 355 MOVE.l a1,(a0)+ * set vector
+00B0008E 356
+00B0008E 30C0 357 MOVE.w d0,(a0)+ * V_OUTP JMP opcode
+00B00090 43FA FF72 358 LEA VEC_OUT(pc),a1 * send byte to output device vector
+00B00094 20C9 359 MOVE.l a1,(a0)+ * set vector
+00B00096 360
+00B00096 30C0 361 MOVE.w d0,(a0)+ * V_LOAD JMP opcode
+00B00098 43FA FF98 362 LEA VEC_LD(pc),a1 * load BASIC program vector
+00B0009C 20C9 363 MOVE.l a1,(a0)+ * set vector
+00B0009E 364
+00B0009E 30C0 365 MOVE.w d0,(a0)+ * V_SAVE JMP opcode
+00B000A0 43FA FF96 366 LEA VEC_SV(pc),a1 * save BASIC program vector
+00B000A4 20C9 367 MOVE.l a1,(a0)+ * set vector
+00B000A6 368
+00B000A6 30C0 369 MOVE.w d0,(a0)+ * V_CTLC JMP opcode
+00B000A8 43FA 261E 370 LEA VEC_CC(pc),a1 * save CTRL-C check vector
+00B000AC 20C9 371 MOVE.l a1,(a0)+ * set vector
+00B000AE 372
+00B000AE 373 * set-up start values
+00B000AE 374
+00B000AE 375 *##LAB_GMEM
+00B000AE 7000 376 MOVEQ #$00,d0 * clear d0
+00B000B0 1740 0648 377 MOVE.b d0,Nullct(a3) * default NULL count
+00B000B4 1740 0649 378 MOVE.b d0,TPos(a3) * clear terminal position
+00B000B8 1740 064C 379 MOVE.b d0,ccflag(a3) * allow CTRL-C check
+00B000BC 3740 0652 380 MOVE.w d0,prg_strt-2(a3) * clear start word
+00B000C0 3740 063A 381 MOVE.w d0,BHsend(a3) * clear value to string end word
+00B000C4 382
+00B000C4 177C 0050 064A 383 MOVE.b #$50,TWidth(a3) * default terminal width byte for simulator
+00B000CA 177C 000E 0646 384 MOVE.b #$0E,TabSiz(a3) * save default tab size = 14
+00B000D0 385
+00B000D0 177C 0038 064B 386 MOVE.b #$38,Iclim(a3) * default limit for TAB = 14 for simulator
+00B000D6 387
+00B000D6 49EB 04F2 388 LEA des_sk(a3),a4 * set descriptor stack start
+00B000DA 389
+00B000DA 41EB 0654 390 LEA prg_strt(a3),a0 * get start of mem
+00B000DE 2748 0492 391 MOVE.l a0,Smeml(a3) * save start of mem
+00B000E2 392
+00B000E2 6100 0322 393 BSR LAB_1463 * do "NEW" and "CLEAR"
+00B000E6 6100 0898 394 BSR LAB_CRLF * print CR/LF
+00B000EA 202B 04AE 395 MOVE.l Ememl(a3),d0 * get end of mem
+00B000EE 90AB 0492 396 SUB.l Smeml(a3),d0 * subtract start of mem
+00B000F2 397
+00B000F2 6100 1BCC 398 BSR LAB_295E * print d0 as unsigned integer (bytes free)
+00B000F6 41FA 33EE 399 LEA LAB_SMSG(pc),a0 * point to start message
+00B000FA 6100 08E2 400 BSR LAB_18C3 * print null terminated string from memory
+00B000FE 401
+00B000FE 41FA 29D2 402 LEA LAB_RSED(pc),a0 * get pointer to value
+00B00102 6100 1A68 403 BSR LAB_UFAC * unpack memory (a0) into FAC1
+00B00106 404
+00B00106 41FA 0092 405 LEA LAB_1274(pc),a0 * get warm start vector
+00B0010A 2748 0466 406 MOVE.l a0,Wrmjpv(a3) * set warm start vector
+00B0010E 6100 1FD2 407 BSR LAB_RND * initialise
+00B00112 4EEB 0464 408 JMP LAB_WARM(a3) * go do warm start
+00B00116 409
+00B00116 410
+00B00116 411 *************************************************************************************
+00B00116 412 *
+00B00116 413 * do format error
+00B00116 414
+00B00116 415 LAB_FOER
+00B00116 7E2C 416 MOVEQ #$2C,d7 * error code $2C "Format" error
+00B00118 6056 417 BRA.s LAB_XERR * do error #d7, then warm start
+00B0011A 418
+00B0011A 419
+00B0011A 420 *************************************************************************************
+00B0011A 421 *
+00B0011A 422 * do address error
+00B0011A 423
+00B0011A 424 LAB_ADER
+00B0011A 7E2A 425 MOVEQ #$2A,d7 * error code $2A "Address" error
+00B0011C 6052 426 BRA.s LAB_XERR * do error #d7, then warm start
+00B0011E 427
+00B0011E 428
+00B0011E 429 *************************************************************************************
+00B0011E 430 *
+00B0011E 431 * do wrong dimensions error
+00B0011E 432
+00B0011E 433 LAB_WDER
+00B0011E 7E28 434 MOVEQ #$28,d7 * error code $28 "Wrong dimensions" error
+00B00120 604E 435 BRA.s LAB_XERR * do error #d7, then warm start
+00B00122 436
+00B00122 437
+00B00122 438 *************************************************************************************
+00B00122 439 *
+00B00122 440 * do undimensioned array error
+00B00122 441
+00B00122 442 LAB_UDER
+00B00122 7E26 443 MOVEQ #$26,d7 * error code $26 "undimensioned array" error
+00B00124 604A 444 BRA.s LAB_XERR * do error #d7, then warm start
+00B00126 445
+00B00126 446
+00B00126 447 *************************************************************************************
+00B00126 448 *
+00B00126 449 * do undefined variable error
+00B00126 450
+00B00126 451 LAB_UVER
+00B00126 452
+00B00126 453 * if you do want a non existant variable to return an error then leave the novar
+00B00126 454 * value at the top of this file set to zero
+00B00126 455
+00B00126 TRUE 456 ifeq novar
+00B00126 457
+00B00126 7E24 458 MOVEQ #$24,d7 * error code $24 "undefined variable" error
+00B00128 6046 459 BRA.s LAB_XERR * do error #d7, then warm start
+00B0012A 460
+00B0012A 461 endc
+00B0012A 462
+00B0012A 463 * if you want a non existant variable to return a null value then set the novar
+00B0012A 464 * value at the top of this file to some non zero value
+00B0012A 465
+00B0012A FALSE 466 ifne novar
+00B0012A 467 endc
+00B0012A 468
+00B0012A 469
+00B0012A 470 *************************************************************************************
+00B0012A 471 *
+00B0012A 472 * do loop without do error
+00B0012A 473
+00B0012A 474 LAB_LDER
+00B0012A 7E22 475 MOVEQ #$22,d7 * error code $22 "LOOP without DO" error
+00B0012C 6042 476 BRA.s LAB_XERR * do error #d7, then warm start
+00B0012E 477
+00B0012E 478
+00B0012E 479 *************************************************************************************
+00B0012E 480 *
+00B0012E 481 * do undefined function error
+00B0012E 482
+00B0012E 483 LAB_UFER
+00B0012E 7E20 484 MOVEQ #$20,d7 * error code $20 "Undefined function" error
+00B00130 603E 485 BRA.s LAB_XERR * do error #d7, then warm start
+00B00132 486
+00B00132 487
+00B00132 488 *************************************************************************************
+00B00132 489 *
+00B00132 490 * do can't continue error
+00B00132 491
+00B00132 492 LAB_CCER
+00B00132 7E1E 493 MOVEQ #$1E,d7 * error code $1E "Can't continue" error
+00B00134 603A 494 BRA.s LAB_XERR * do error #d7, then warm start
+00B00136 495
+00B00136 496
+00B00136 497 *************************************************************************************
+00B00136 498 *
+00B00136 499 * do string too complex error
+00B00136 500
+00B00136 501 LAB_SCER
+00B00136 7E1C 502 MOVEQ #$1C,d7 * error code $1C "String too complex" error
+00B00138 6036 503 BRA.s LAB_XERR * do error #d7, then warm start
+00B0013A 504
+00B0013A 505
+00B0013A 506 *************************************************************************************
+00B0013A 507 *
+00B0013A 508 * do string too long error
+00B0013A 509
+00B0013A 510 LAB_SLER
+00B0013A 7E1A 511 MOVEQ #$1A,d7 * error code $1A "String too long" error
+00B0013C 6032 512 BRA.s LAB_XERR * do error #d7, then warm start
+00B0013E 513
+00B0013E 514
+00B0013E 515 *************************************************************************************
+00B0013E 516 *
+00B0013E 517 * do type missmatch error
+00B0013E 518
+00B0013E 519 LAB_TMER
+00B0013E 7E18 520 MOVEQ #$18,d7 * error code $18 "Type mismatch" error
+00B00140 602E 521 BRA.s LAB_XERR * do error #d7, then warm start
+00B00142 522
+00B00142 523
+00B00142 524 *************************************************************************************
+00B00142 525 *
+00B00142 526 * do illegal direct error
+00B00142 527
+00B00142 528 LAB_IDER
+00B00142 7E16 529 MOVEQ #$16,d7 * error code $16 "Illegal direct" error
+00B00144 602A 530 BRA.s LAB_XERR * do error #d7, then warm start
+00B00146 531
+00B00146 532
+00B00146 533 *************************************************************************************
+00B00146 534 *
+00B00146 535 * do divide by zero error
+00B00146 536
+00B00146 537 LAB_DZER
+00B00146 7E14 538 MOVEQ #$14,d7 * error code $14 "Divide by zero" error
+00B00148 6026 539 BRA.s LAB_XERR * do error #d7, then warm start
+00B0014A 540
+00B0014A 541
+00B0014A 542 *************************************************************************************
+00B0014A 543 *
+00B0014A 544 * do double dimension error
+00B0014A 545
+00B0014A 546 LAB_DDER
+00B0014A 7E12 547 MOVEQ #$12,d7 * error code $12 "Double dimension" error
+00B0014C 6022 548 BRA.s LAB_XERR * do error #d7, then warm start
+00B0014E 549
+00B0014E 550
+00B0014E 551 *************************************************************************************
+00B0014E 552 *
+00B0014E 553 * do array bounds error
+00B0014E 554
+00B0014E 555 LAB_ABER
+00B0014E 7E10 556 MOVEQ #$10,d7 * error code $10 "Array bounds" error
+00B00150 601E 557 BRA.s LAB_XERR * do error #d7, then warm start
+00B00152 558
+00B00152 559
+00B00152 560 *************************************************************************************
+00B00152 561 *
+00B00152 562 * do undefined satement error
+00B00152 563
+00B00152 564 LAB_USER
+00B00152 7E0E 565 MOVEQ #$0E,d7 * error code $0E "Undefined statement" error
+00B00154 601A 566 BRA.s LAB_XERR * do error #d7, then warm start
+00B00156 567
+00B00156 568
+00B00156 569 *************************************************************************************
+00B00156 570 *
+00B00156 571 * do out of memory error
+00B00156 572
+00B00156 573 LAB_OMER
+00B00156 7E0C 574 MOVEQ #$0C,d7 * error code $0C "Out of memory" error
+00B00158 6016 575 BRA.s LAB_XERR * do error #d7, then warm start
+00B0015A 576
+00B0015A 577
+00B0015A 578 *************************************************************************************
+00B0015A 579 *
+00B0015A 580 * do overflow error
+00B0015A 581
+00B0015A 582 LAB_OFER
+00B0015A 7E0A 583 MOVEQ #$0A,d7 * error code $0A "Overflow" error
+00B0015C 6012 584 BRA.s LAB_XERR * do error #d7, then warm start
+00B0015E 585
+00B0015E 586
+00B0015E 587 *************************************************************************************
+00B0015E 588 *
+00B0015E 589 * do function call error
+00B0015E 590
+00B0015E 591 LAB_FCER
+00B0015E 7E08 592 MOVEQ #$08,d7 * error code $08 "Function call" error
+00B00160 600E 593 BRA.s LAB_XERR * do error #d7, then warm start
+00B00162 594
+00B00162 595
+00B00162 596 *************************************************************************************
+00B00162 597 *
+00B00162 598 * do out of data error
+00B00162 599
+00B00162 600 LAB_ODER
+00B00162 7E06 601 MOVEQ #$06,d7 * error code $06 "Out of DATA" error
+00B00164 600A 602 BRA.s LAB_XERR * do error #d7, then warm start
+00B00166 603
+00B00166 604
+00B00166 605 *************************************************************************************
+00B00166 606 *
+00B00166 607 * do return without gosub error
+00B00166 608
+00B00166 609 LAB_RGER
+00B00166 7E04 610 MOVEQ #$04,d7 * error code $04 "RETURN without GOSUB" error
+00B00168 6006 611 BRA.s LAB_XERR * do error #d7, then warm start
+00B0016A 612
+00B0016A 613
+00B0016A 614 *************************************************************************************
+00B0016A 615 *
+00B0016A 616 * do syntax error
+00B0016A 617
+00B0016A 618 LAB_SNER
+00B0016A 7E02 619 MOVEQ #$02,d7 * error code $02 "Syntax" error
+00B0016C 6002 620 BRA.s LAB_XERR * do error #d7, then warm start
+00B0016E 621
+00B0016E 622
+00B0016E 623 *************************************************************************************
+00B0016E 624 *
+00B0016E 625 * do next without for error
+00B0016E 626
+00B0016E 627 LAB_NFER
+00B0016E 7E00 628 MOVEQ #$00,d7 * error code $00 "NEXT without FOR" error
+00B00170 629
+00B00170 630
+00B00170 631 *************************************************************************************
+00B00170 632 *
+00B00170 633 * do error #d7, then warm start
+00B00170 634
+00B00170 635 LAB_XERR
+00B00170 6100 02CA 636 BSR LAB_1491 * flush stack & clear continue flag
+00B00174 6100 080A 637 BSR LAB_CRLF * print CR/LF
+00B00178 43FA 2FE4 638 LEA LAB_BAER(pc),a1 * start of error message pointer table
+00B0017C 3E31 7000 639 MOVE.w (a1,d7.w),d7 * get error message offset
+00B00180 41F1 7000 640 LEA (a1,d7.w),a0 * get error message address
+00B00184 6100 0858 641 BSR LAB_18C3 * print null terminated string from memory
+00B00188 41FA 331F 642 LEA LAB_EMSG(pc),a0 * point to " Error" message
+00B0018C 643 LAB_1269
+00B0018C 6100 0850 644 BSR LAB_18C3 * print null terminated string from memory
+00B00190 202B 04B6 645 MOVE.l Clinel(a3),d0 * get current line
+00B00194 6B04 646 BMI.s LAB_1274 * go do warm start if -ve # (was immediate mode)
+00B00196 647
+00B00196 648 * else print line number
+00B00196 6100 1B1C 649 BSR LAB_2953 * print " in line [LINE #]"
+00B0019A 650
+00B0019A 651 * BASIC warm start entry point, wait for Basic command
+00B0019A 652
+00B0019A 653 LAB_1274
+00B0019A 41FA 3340 654 LEA LAB_RMSG(pc),a0 * point to "Ready" message
+00B0019E 6100 083E 655 BSR LAB_18C3 * go do print string
+00B001A2 656
+00B001A2 657 * wait for Basic command - no "Ready"
+00B001A2 658
+00B001A2 659 LAB_127D
+00B001A2 72FF 660 MOVEQ #-1,d1 * set to -1
+00B001A4 2741 04B6 661 MOVE.l d1,Clinel(a3) * set current line #
+00B001A8 1741 0640 662 MOVE.b d1,Breakf(a3) * set break flag
+00B001AC 4BEB 04F4 663 LEA Ibuffs(a3),a5 * set basic execute pointer ready for new line
+00B001B0 664 LAB_127E
+00B001B0 6100 00EC 665 BSR LAB_1357 * call for BASIC input
+00B001B4 6100 0BF4 666 BSR LAB_GBYT * scan memory
+00B001B8 67F6 667 BEQ.s LAB_127E * loop while null
+00B001BA 668
+00B001BA 669 * got to interpret input line now ....
+00B001BA 670
+00B001BA 6508 671 BCS.s LAB_1295 * branch if numeric character, handle new
+00B001BC 672 * BASIC line
+00B001BC 673
+00B001BC 674 * no line number so do immediate mode, a5
+00B001BC 675 * points to the buffer start
+00B001BC 6100 0156 676 BSR LAB_13A6 * crunch keywords into Basic tokens
+00B001C0 677 * crunch from (a5), output to (a0)
+00B001C0 678 * returns ..
+00B001C0 679 * d2 is length, d1 trashed, d0 trashed,
+00B001C0 680 * a1 trashed
+00B001C0 6000 03C4 681 BRA LAB_15F6 * go scan & interpret code
+00B001C4 682
+00B001C4 683
+00B001C4 684 *************************************************************************************
+00B001C4 685 *
+00B001C4 686 * handle a new BASIC line
+00B001C4 687
+00B001C4 688 LAB_1295
+00B001C4 6100 063A 689 BSR LAB_GFPN * get fixed-point number into temp integer & d1
+00B001C8 6100 014A 690 BSR LAB_13A6 * crunch keywords into Basic tokens
+00B001CC 691 * crunch from (a5), output to (a0)
+00B001CC 692 * returns .. d2 is length,
+00B001CC 693 * d1 trashed, d0 trashed, a1 trashed
+00B001CC 222B 048E 694 MOVE.l Itemp(a3),d1 * get required line #
+00B001D0 6100 0218 695 BSR LAB_SSLN * search BASIC for d1 line number
+00B001D4 696 * returns pointer in a0
+00B001D4 6532 697 BCS.s LAB_12E6 * branch if not found
+00B001D6 698
+00B001D6 699 * aroooogah! line # already exists! delete it
+00B001D6 2250 700 MOVEA.l (a0),a1 * get start of block (next line pointer)
+00B001D8 202B 0496 701 MOVE.l Sfncl(a3),d0 * get end of block (start of functions)
+00B001DC 9089 702 SUB.l a1,d0 * subtract start of block ( = bytes to move)
+00B001DE E288 703 LSR.l #1,d0 * /2 (word move)
+00B001E0 5380 704 SUBQ.l #1,d0 * adjust for DBF loop
+00B001E2 4840 705 SWAP d0 * swap high word to low word
+00B001E4 2448 706 MOVEA.l a0,a2 * copy destination
+00B001E6 707 LAB_12AE
+00B001E6 4840 708 SWAP d0 * swap high word to low word
+00B001E8 709 LAB_12B0
+00B001E8 34D9 710 MOVE.w (a1)+,(a2)+ * copy word
+00B001EA 51C8 FFFC 711 DBF d0,LAB_12B0 * decrement low count and loop until done
+00B001EE 712
+00B001EE 4840 713 SWAP d0 * swap high word to low word
+00B001F0 51C8 FFF4 714 DBF d0,LAB_12AE * decrement high count and loop until done
+00B001F4 715
+00B001F4 274A 0496 716 MOVE.l a2,Sfncl(a3) * start of functions
+00B001F8 274A 049A 717 MOVE.l a2,Svarl(a3) * save start of variables
+00B001FC 274A 049E 718 MOVE.l a2,Sstrl(a3) * start of strings
+00B00200 274A 04A2 719 MOVE.l a2,Sarryl(a3) * save start of arrays
+00B00204 274A 04A6 720 MOVE.l a2,Earryl(a3) * save end of arrays
+00B00208 721
+00B00208 722 * got new line in buffer and no existing same #
+00B00208 723 LAB_12E6
+00B00208 102B 04F4 724 MOVE.b Ibuffs(a3),d0 * get byte from start of input buffer
+00B0020C 6764 725 BEQ.s LAB_1325 * if null line go do line chaining
+00B0020E 726
+00B0020E 727 * got new line and it isn't empty line
+00B0020E 226B 0496 728 MOVEA.l Sfncl(a3),a1 * get start of functions (end of block to move)
+00B00212 45F1 2008 729 LEA 8(a1,d2),a2 * copy it, add line length and add room for
+00B00216 730 * pointer and line number
+00B00216 731
+00B00216 274A 0496 732 MOVE.l a2,Sfncl(a3) * start of functions
+00B0021A 274A 049A 733 MOVE.l a2,Svarl(a3) * save start of variables
+00B0021E 274A 049E 734 MOVE.l a2,Sstrl(a3) * start of strings
+00B00222 274A 04A2 735 MOVE.l a2,Sarryl(a3) * save start of arrays
+00B00226 274A 04A6 736 MOVE.l a2,Earryl(a3) * save end of arrays
+00B0022A 276B 04AE 04AA 737 MOVE.l Ememl(a3),Sstorl(a3) * copy end of mem to start of strings, clear
+00B00230 738 * strings
+00B00230 739
+00B00230 2209 740 MOVE.l a1,d1 * copy end of block to move
+00B00232 9288 741 SUB.l a0,d1 * subtract start of block to move
+00B00234 E289 742 LSR.l #1,d1 * /2 (word copy)
+00B00236 5381 743 SUBQ.l #1,d1 * correct for loop end on -1
+00B00238 4841 744 SWAP d1 * swap high word to low word
+00B0023A 745 LAB_12FF
+00B0023A 4841 746 SWAP d1 * swap high word to low word
+00B0023C 747 LAB_1301
+00B0023C 3521 748 MOVE.w -(a1),-(a2) * decrement pointers and copy word
+00B0023E 51C9 FFFC 749 DBF d1,LAB_1301 * decrement & loop
+00B00242 750
+00B00242 4841 751 SWAP d1 * swap high word to low word
+00B00244 51C9 FFF4 752 DBF d1,LAB_12FF * decrement high count and loop until done
+00B00248 753
+00B00248 754 * space is opened up, now copy the crunched line from the input buffer into the space
+00B00248 755
+00B00248 43EB 04F4 756 LEA Ibuffs(a3),a1 * source is input buffer
+00B0024C 2448 757 MOVEA.l a0,a2 * copy destination
+00B0024E 72FF 758 MOVEQ #-1,d1 * set to allow re-chaining
+00B00250 24C1 759 MOVE.l d1,(a2)+ * set next line pointer (allow re-chaining)
+00B00252 24EB 048E 760 MOVE.l Itemp(a3),(a2)+ * save line number
+00B00256 E24A 761 LSR.w #1,d2 * /2 (word copy)
+00B00258 5342 762 SUBQ.w #1,d2 * correct for loop end on -1
+00B0025A 763 LAB_1303
+00B0025A 34D9 764 MOVE.w (a1)+,(a2)+ * copy word
+00B0025C 51CA FFFC 765 DBF d2,LAB_1303 * decrement & loop
+00B00260 766
+00B00260 6010 767 BRA.s LAB_1325 * go test for end of prog
+00B00262 768
+00B00262 769 * rebuild chaining of BASIC lines
+00B00262 770
+00B00262 771 LAB_132E
+00B00262 5048 772 ADDQ.w #8,a0 * point to first code byte of line, there is
+00B00264 773 * always 1 byte + [EOL] as null entries are
+00B00264 774 * deleted
+00B00264 775 LAB_1330
+00B00264 4A18 776 TST.b (a0)+ * test byte
+00B00266 66FC 777 BNE.s LAB_1330 * loop if not [EOL]
+00B00268 778
+00B00268 779 * was [EOL] so get next line start
+00B00268 3208 780 MOVE.w a0,d1 * past pad byte(s)
+00B0026A 0241 0001 781 ANDI.w #1,d1 * mask odd bit
+00B0026E D0C1 782 ADD.w d1,a0 * add back to ensure even
+00B00270 2288 783 MOVE.l a0,(a1) * save next line pointer to current line
+00B00272 784 LAB_1325
+00B00272 2248 785 MOVEA.l a0,a1 * copy pointer for this line
+00B00274 4A90 786 TST.l (a0) * test pointer to next line
+00B00276 66EA 787 BNE.s LAB_132E * not end of program yet so we must
+00B00278 788 * go and fix the pointers
+00B00278 789
+00B00278 6100 0198 790 BSR LAB_1477 * reset execution to start, clear variables
+00B0027C 791 * and flush stack
+00B0027C 6000 FF24 792 BRA LAB_127D * now we just wait for Basic command, no "Ready"
+00B00280 793
+00B00280 794
+00B00280 795 *************************************************************************************
+00B00280 796 *
+00B00280 797 * receive a line from the keyboard
+00B00280 798 * character $08 as delete key, BACKSPACE on
+00B00280 799 * standard keyboard
+00B00280 800 LAB_134B
+00B00280 6100 0776 801 BSR LAB_PRNA * go print the character
+00B00284 7020 802 MOVEQ #' ',d0 * load [SPACE]
+00B00286 6100 0770 803 BSR LAB_PRNA * go print
+00B0028A 7008 804 MOVEQ #$08,d0 * load [BACKSPACE]
+00B0028C 6100 076A 805 BSR LAB_PRNA * go print
+00B00290 5341 806 SUBQ.w #$01,d1 * decrement the buffer index (delete)
+00B00292 6010 807 BRA.s LAB_1359 * re-enter loop
+00B00294 808
+00B00294 809 * print "? " and get BASIC input
+00B00294 810 * return a0 pointing to the buffer start
+00B00294 811
+00B00294 812 LAB_INLN
+00B00294 6100 0760 813 BSR LAB_18E3 * print "?" character
+00B00298 7020 814 MOVEQ #' ',d0 * load " "
+00B0029A 6100 075C 815 BSR LAB_PRNA * go print
+00B0029E 816
+00B0029E 817 * call for BASIC input (main entry point)
+00B0029E 818 * return a0 pointing to the buffer start
+00B0029E 819
+00B0029E 820 LAB_1357
+00B0029E 7200 821 MOVEQ #$00,d1 * clear buffer index
+00B002A0 41EB 04F4 822 LEA Ibuffs(a3),a0 * set buffer base pointer
+00B002A4 823 LAB_1359
+00B002A4 4EAB 0470 824 JSR V_INPT(a3) * call scan input device
+00B002A8 64FA 825 BCC.s LAB_1359 * loop if no byte
+00B002AA 826
+00B002AA 67F8 827 BEQ.s LAB_1359 * loop if null byte
+00B002AC 828
+00B002AC B03C 0007 829 CMP.b #$07,d0 * compare with [BELL]
+00B002B0 6718 830 BEQ.s LAB_1378 * branch if [BELL]
+00B002B2 831
+00B002B2 B03C 000D 832 CMP.b #$0D,d0 * compare with [CR]
+00B002B6 6700 06C2 833 BEQ LAB_1866 * do CR/LF exit if [CR]
+00B002BA 834
+00B002BA 4A41 835 TST.w d1 * set flags on buffer index
+00B002BC 6606 836 BNE.s LAB_1374 * branch if not empty
+00B002BE 837
+00B002BE 838 * the next two lines ignore any non printing character and [SPACE] if the input buffer
+00B002BE 839 * is empty
+00B002BE 840
+00B002BE B03C 0020 841 CMP.b #' ',d0 * compare with [SP]+1
+00B002C2 63E0 842 BLS.s LAB_1359 * if < ignore character
+00B002C4 843
+00B002C4 844 *## CMP.b #' '+1,d0 * compare with [SP]+1
+00B002C4 845 *## BCS.s LAB_1359 * if < ignore character
+00B002C4 846
+00B002C4 847 LAB_1374
+00B002C4 B03C 0008 848 CMP.b #$08,d0 * compare with [BACKSPACE]
+00B002C8 67B6 849 BEQ.s LAB_134B * go delete last character
+00B002CA 850
+00B002CA 851 LAB_1378
+00B002CA B27C 00FF 852 CMP.w #(Ibuffe-Ibuffs-1),d1 * compare character count with max-1
+00B002CE 640C 853 BCC.s LAB_138E * skip store & do [BELL] if buffer full
+00B002D0 854
+00B002D0 1180 1000 855 MOVE.b d0,(a0,d1.w) * else store in buffer
+00B002D4 5241 856 ADDQ.w #$01,d1 * increment index
+00B002D6 857 LAB_137F
+00B002D6 6100 0720 858 BSR LAB_PRNA * go print the character
+00B002DA 60C8 859 BRA.s LAB_1359 * always loop for next character
+00B002DC 860
+00B002DC 861 * announce buffer full
+00B002DC 862
+00B002DC 863 LAB_138E
+00B002DC 7007 864 MOVEQ #$07,d0 * [BELL] character into d0
+00B002DE 60F6 865 BRA.s LAB_137F * go print the [BELL] but ignore input character
+00B002E0 866
+00B002E0 867
+00B002E0 868 *************************************************************************************
+00B002E0 869 *
+00B002E0 870 * copy a hex value without crunching
+00B002E0 871
+00B002E0 872 LAB_1392
+00B002E0 1180 2000 873 MOVE.b d0,(a0,d2.w) * save the byte to the output
+00B002E4 5242 874 ADDQ.w #1,d2 * increment the buffer save index
+00B002E6 875
+00B002E6 5241 876 ADDQ.w #1,d1 * increment the buffer read index
+00B002E8 1035 1000 877 MOVE.b (a5,d1.w),d0 * get a byte from the input buffer
+00B002EC 6700 0094 878 BEQ LAB_13EC * if [EOL] go save it without crunching
+00B002F0 879
+00B002F0 B03C 0020 880 CMP.b #' ',d0 * compare the character with " "
+00B002F4 67EA 881 BEQ.s LAB_1392 * if [SPACE] just go save it and get another
+00B002F6 882
+00B002F6 B03C 0030 883 CMP.b #'0',d0 * compare the character with "0"
+00B002FA 654A 884 BCS.s LAB_13C6 * if < "0" quit the hex save loop
+00B002FC 885
+00B002FC B03C 0039 886 CMP.b #'9',d0 * compare with "9"
+00B00300 63DE 887 BLS.s LAB_1392 * if it is "0" to "9" save it and get another
+00B00302 888
+00B00302 7ADF 889 MOVEQ #-33,d5 * mask xx0x xxxx, ASCII upper case
+00B00304 CA00 890 AND.b d0,d5 * mask the character
+00B00306 891
+00B00306 BA3C 0041 892 CMP.b #'A',d5 * compare with "A"
+00B0030A 6540 893 BCS.s LAB_13CC * if < "A" quit the hex save loop
+00B0030C 894
+00B0030C BA3C 0046 895 CMP.b #'F',d5 * compare with "F"
+00B00310 63CE 896 BLS.s LAB_1392 * if it is "A" to "F" save it and get another
+00B00312 897
+00B00312 6038 898 BRA.s LAB_13CC * else continue crunching
+00B00314 899
+00B00314 900 * crunch keywords into Basic tokens
+00B00314 901 * crunch from (a5), output to (a0)
+00B00314 902 * returns ..
+00B00314 903 * d4 trashed
+00B00314 904 * d3 trashed
+00B00314 905 * d2 is length
+00B00314 906 * d1 trashed
+00B00314 907 * d0 trashed
+00B00314 908 * a1 trashed
+00B00314 909
+00B00314 910 * this is the improved BASIC crunch routine and is 10 to 100 times faster than the
+00B00314 911 * old list search
+00B00314 912
+00B00314 913 LAB_13A6
+00B00314 7200 914 MOVEQ #0,d1 * clear the read index
+00B00316 2401 915 MOVE.l d1,d2 * clear the save index
+00B00318 1741 0641 916 MOVE.b d1,Oquote(a3) * clear the open quote/DATA flag
+00B0031C 917 LAB_13AC
+00B0031C 7000 918 MOVEQ #0,d0 * clear word
+00B0031E 1035 1000 919 MOVE.b (a5,d1.w),d0 * get byte from input buffer
+00B00322 675E 920 BEQ.s LAB_13EC * if null save byte then continue crunching
+00B00324 921
+00B00324 B03C 005F 922 CMP.b #'_',d0 * compare with "_"
+00B00328 6458 923 BCC.s LAB_13EC * if >= "_" save byte then continue crunching
+00B0032A 924
+00B0032A B03C 003C 925 CMP.b #'<',d0 * compare with "<"
+00B0032E 641C 926 BCC.s LAB_13CC * if >= "<" go crunch
+00B00330 927
+00B00330 B03C 0030 928 CMP.b #'0',d0 * compare with "0"
+00B00334 644C 929 BCC.s LAB_13EC * if >= "0" save byte then continue crunching
+00B00336 930
+00B00336 1740 063E 931 MOVE.b d0,Asrch(a3) * save buffer byte as search character
+00B0033A B03C 0022 932 CMP.b #$22,d0 * is it quote character?
+00B0033E 6776 933 BEQ.s LAB_1410 * branch if so (copy quoted string)
+00B00340 934
+00B00340 B03C 0024 935 CMP.b #'$',d0 * is it the hex value character?
+00B00344 679A 936 BEQ.s LAB_1392 * if so go copy a hex value
+00B00346 937
+00B00346 938 LAB_13C6
+00B00346 B03C 002A 939 CMP.b #'*',d0 * compare with "*"
+00B0034A 6536 940 BCS.s LAB_13EC * if <= "*" save byte then continue crunching
+00B0034C 941
+00B0034C 942 * crunch rest
+00B0034C 943 LAB_13CC
+00B0034C 082B 0006 0641 944 BTST.b #6,Oquote(a3) * test open quote/DATA token flag
+00B00352 662E 945 BNE.s LAB_13EC * branch if b6 of Oquote set (was DATA)
+00B00354 946 * go save byte then continue crunching
+00B00354 947
+00B00354 0400 002A 948 SUB.b #$2A,d0 * normalise byte
+00B00358 D040 949 ADD.w d0,d0 * *2 makes word offset (high byte=$00)
+00B0035A 43FA 2C04 950 LEA TAB_CHRT(pc),a1 * get keyword offset table address
+00B0035E 3031 0000 951 MOVE.w (a1,d0.w),d0 * get offset into keyword table
+00B00362 6B6E 952 BMI.s LAB_141F * branch if no keywords for character
+00B00364 953
+00B00364 43FA 2F90 954 LEA TAB_STAR(pc),a1 * get keyword table address
+00B00368 D2C0 955 ADDA.w d0,a1 * add keyword offset
+00B0036A 76FF 956 MOVEQ #-1,d3 * clear index
+00B0036C 3801 957 MOVE.w d1,d4 * copy read index
+00B0036E 958 LAB_13D6
+00B0036E 5243 959 ADDQ.w #1,d3 * increment table index
+00B00370 1031 3000 960 MOVE.b (a1,d3.w),d0 * get byte from table
+00B00374 961 LAB_13D8
+00B00374 6B0A 962 BMI.s LAB_13EA * branch if token, save token and continue
+00B00376 963 * crunching
+00B00376 964
+00B00376 5244 965 ADDQ.w #1,d4 * increment read index
+00B00378 B035 4000 966 CMP.b (a5,d4.w),d0 * compare byte from input buffer
+00B0037C 67F0 967 BEQ.s LAB_13D6 * loop if character match
+00B0037E 968
+00B0037E 6040 969 BRA.s LAB_1417 * branch if no match
+00B00380 970
+00B00380 971 LAB_13EA
+00B00380 3204 972 MOVE.w d4,d1 * update read index
+00B00382 973 LAB_13EC
+00B00382 1180 2000 974 MOVE.b d0,(a0,d2.w) * save byte to output
+00B00386 5242 975 ADDQ.w #1,d2 * increment buffer save index
+00B00388 5241 976 ADDQ.w #1,d1 * increment buffer read index
+00B0038A 4A00 977 TST.b d0 * set flags
+00B0038C 674A 978 BEQ.s LAB_142A * branch if was null [EOL]
+00B0038E 979
+00B0038E 980 * d0 holds token or byte here
+00B0038E 0400 003A 981 SUB.b #$3A,d0 * subtract ":"
+00B00392 6706 982 BEQ.s LAB_13FF * branch if it was ":" (is now $00)
+00B00394 983
+00B00394 984 * d0 now holds token-$3A
+00B00394 B03C 0049 985 CMP.b #(TK_DATA-$3A),d0 * compare with DATA token - $3A
+00B00398 6604 986 BNE.s LAB_1401 * branch if not DATA
+00B0039A 987
+00B0039A 988 * token was : or DATA
+00B0039A 989 LAB_13FF
+00B0039A 1740 0641 990 MOVE.b d0,Oquote(a3) * save token-$3A ($00 for ":", TK_DATA-$3A for
+00B0039E 991 * DATA)
+00B0039E 992 LAB_1401
+00B0039E 0400 0055 993 SUB.b #(TK_REM-$3A),d0 * subtract REM token offset
+00B003A2 6600 FF78 994 BNE LAB_13AC * If wasn't REM then go crunch rest of line
+00B003A6 995
+00B003A6 1740 063E 996 MOVE.b d0,Asrch(a3) * else was REM so set search for [EOL]
+00B003AA 997
+00B003AA 998 * loop for REM, "..." etc.
+00B003AA 999 LAB_1408
+00B003AA 1035 1000 1000 MOVE.b (a5,d1.w),d0 * get byte from input buffer
+00B003AE 67D2 1001 BEQ.s LAB_13EC * branch if null [EOL]
+00B003B0 1002
+00B003B0 B02B 063E 1003 CMP.b Asrch(a3),d0 * compare with stored character
+00B003B4 67CC 1004 BEQ.s LAB_13EC * branch if match (end quote, REM, :, or DATA)
+00B003B6 1005
+00B003B6 1006 * entry for copy string in quotes, don't crunch
+00B003B6 1007 LAB_1410
+00B003B6 1180 2000 1008 MOVE.b d0,(a0,d2.w) * save byte to output
+00B003BA 5242 1009 ADDQ.w #1,d2 * increment buffer save index
+00B003BC 5241 1010 ADDQ.w #1,d1 * increment buffer read index
+00B003BE 60EA 1011 BRA.s LAB_1408 * loop
+00B003C0 1012
+00B003C0 1013 * not found keyword this go so find the end of this word in the table
+00B003C0 1014
+00B003C0 1015 LAB_1417
+00B003C0 3801 1016 MOVE.w d1,d4 * reset read pointer
+00B003C2 1017 LAB_141B
+00B003C2 5243 1018 ADDQ.w #1,d3 * increment keyword table pointer, flag
+00B003C4 1019 * unchanged
+00B003C4 1031 3000 1020 MOVE.b (a1,d3.w),d0 * get keyword table byte
+00B003C8 6AF8 1021 BPL.s LAB_141B * if not end of keyword go do next byte
+00B003CA 1022
+00B003CA 5243 1023 ADDQ.w #1,d3 * increment keyword table pointer flag
+00B003CC 1024 * unchanged
+00B003CC 1031 3000 1025 MOVE.b (a1,d3.w),d0 * get keyword table byte
+00B003D0 66A2 1026 BNE.s LAB_13D8 * go test next word if not zero byte (table end)
+00B003D2 1027
+00B003D2 1028 * reached end of table with no match
+00B003D2 1029 LAB_141F
+00B003D2 1035 1000 1030 MOVE.b (a5,d1.w),d0 * restore byte from input buffer
+00B003D6 60AA 1031 BRA.s LAB_13EC * go save byte in output and continue crunching
+00B003D8 1032
+00B003D8 1033 * reached [EOL]
+00B003D8 1034 LAB_142A
+00B003D8 7000 1035 MOVEQ #0,d0 * ensure longword clear
+00B003DA 0102 1036 BTST d0,d2 * test odd bit (fastest)
+00B003DC 6706 1037 BEQ.s LAB_142C * branch if no bytes to fill
+00B003DE 1038
+00B003DE 1180 2000 1039 MOVE.b d0,(a0,d2.w) * clear next byte
+00B003E2 5242 1040 ADDQ.w #1,d2 * increment buffer save index
+00B003E4 1041 LAB_142C
+00B003E4 2180 2000 1042 MOVE.l d0,(a0,d2.w) * clear next line pointer, EOT in immediate mode
+00B003E8 4E75 1043 RTS
+00B003EA 1044
+00B003EA 1045
+00B003EA 1046 *************************************************************************************
+00B003EA 1047 *
+00B003EA 1048 * search Basic for d1 line number from start of mem
+00B003EA 1049
+00B003EA 1050 LAB_SSLN
+00B003EA 206B 0492 1051 MOVEA.l Smeml(a3),a0 * get start of program mem
+00B003EE 6002 1052 BRA.s LAB_SCLN * go search for required line from a0
+00B003F0 1053
+00B003F0 1054 LAB_145F
+00B003F0 2040 1055 MOVEA.l d0,a0 * copy next line pointer
+00B003F2 1056
+00B003F2 1057 * search Basic for d1 line number from a0
+00B003F2 1058 * returns Cb=0 if found
+00B003F2 1059 * returns a0 pointer to found or next higher (not found) line
+00B003F2 1060
+00B003F2 1061 LAB_SCLN
+00B003F2 2018 1062 MOVE.l (a0)+,d0 * get next line pointer and point to line #
+00B003F4 6708 1063 BEQ.s LAB_145E * is end marker so we're done, do 'no line' exit
+00B003F6 1064
+00B003F6 B290 1065 CMP.l (a0),d1 * compare this line # with required line #
+00B003F8 6EF6 1066 BGT.s LAB_145F * loop if required # > this #
+00B003FA 1067
+00B003FA 5948 1068 SUBQ.w #4,a0 * adjust pointer, flags not changed
+00B003FC 4E75 1069 RTS
+00B003FE 1070
+00B003FE 1071 LAB_145E
+00B003FE 5948 1072 SUBQ.w #4,a0 * adjust pointer, flags not changed
+00B00400 5380 1073 SUBQ.l #1,d0 * make end program found = -1, set carry
+00B00402 4E75 1074 RTS
+00B00404 1075
+00B00404 1076
+00B00404 1077 *************************************************************************************
+00B00404 1078 *
+00B00404 1079 * perform NEW
+00B00404 1080
+00B00404 1081 LAB_NEW
+00B00404 664C 1082 BNE.s RTS_005 * exit if not end of statement (do syntax error)
+00B00406 1083
+00B00406 1084 LAB_1463
+00B00406 206B 0492 1085 MOVEA.l Smeml(a3),a0 * point to start of program memory
+00B0040A 7000 1086 MOVEQ #0,d0 * clear longword
+00B0040C 20C0 1087 MOVE.l d0,(a0)+ * clear first line, next line pointer
+00B0040E 2748 0496 1088 MOVE.l a0,Sfncl(a3) * set start of functions
+00B00412 1089
+00B00412 1090 * reset execution to start, clear variables and flush stack
+00B00412 1091
+00B00412 1092 LAB_1477
+00B00412 2A6B 0492 1093 MOVEA.l Smeml(a3),a5 * reset BASIC execute pointer
+00B00416 534D 1094 SUBQ.w #1,a5 * -1 (as end of previous line)
+00B00418 1095
+00B00418 1096 * "CLEAR" command gets here
+00B00418 1097
+00B00418 1098 LAB_147A
+00B00418 276B 04AE 04AA 1099 MOVE.l Ememl(a3),Sstorl(a3) * save end of mem as bottom of string space
+00B0041E 202B 0496 1100 MOVE.l Sfncl(a3),d0 * get start of functions
+00B00422 2740 049A 1101 MOVE.l d0,Svarl(a3) * start of variables
+00B00426 2740 049E 1102 MOVE.l d0,Sstrl(a3) * start of strings
+00B0042A 2740 04A2 1103 MOVE.l d0,Sarryl(a3) * set start of arrays
+00B0042E 2740 04A6 1104 MOVE.l d0,Earryl(a3) * set end of arrays
+00B00432 1105 LAB_1480
+00B00432 7000 1106 MOVEQ #0,d0 * set Zb
+00B00434 1740 064E 1107 MOVE.b d0,ccnull(a3) * clear get byte countdown
+00B00438 6100 01CE 1108 BSR LAB_RESTORE * perform RESTORE command
+00B0043C 1109
+00B0043C 1110 * flush stack & clear continue flag
+00B0043C 1111
+00B0043C 1112 LAB_1491
+00B0043C 49EB 04F2 1113 LEA des_sk(a3),a4 * reset descriptor stack pointer
+00B00440 1114
+00B00440 201F 1115 MOVE.l (sp)+,d0 * pull return address
+00B00442 4FEB 0464 1116 LEA ram_base(a3),sp * set stack to RAM start + 1k, flush stack
+00B00446 2F00 1117 MOVE.l d0,-(sp) * restore return address
+00B00448 1118
+00B00448 7000 1119 MOVEQ #0,d0 * clear longword
+00B0044A 2740 04BE 1120 MOVE.l d0,Cpntrl(a3) * clear continue pointer
+00B0044E 1740 0643 1121 MOVE.b d0,Sufnxf(a3) * clear subscript/FNX flag
+00B00452 1122 RTS_005
+00B00452 4E75 1123 RTS
+00B00454 1124
+00B00454 1125
+00B00454 1126 *************************************************************************************
+00B00454 1127 *
+00B00454 1128 * perform CLEAR
+00B00454 1129
+00B00454 1130 LAB_CLEAR
+00B00454 67C2 1131 BEQ.s LAB_147A * if no following byte go do "CLEAR"
+00B00456 1132
+00B00456 4E75 1133 RTS * was following byte (go do syntax error)
+00B00458 1134
+00B00458 1135
+00B00458 1136 *************************************************************************************
+00B00458 1137 *
+00B00458 1138 * perform LIST [n][-m]
+00B00458 1139
+00B00458 1140 LAB_LIST
+00B00458 6512 1141 BCS.s LAB_14BD * branch if next character numeric (LIST n...)
+00B0045A 1142
+00B0045A 72FF 1143 MOVEQ #-1,d1 * set end to $FFFFFFFF
+00B0045C 2741 048E 1144 MOVE.l d1,Itemp(a3) * save to Itemp
+00B00460 1145
+00B00460 7200 1146 MOVEQ #0,d1 * set start to $00000000
+00B00462 4A00 1147 TST.b d0 * test next byte
+00B00464 670A 1148 BEQ.s LAB_14C0 * branch if next character [NULL] (LIST)
+00B00466 1149
+00B00466 B03C 00B3 1150 CMP.b #TK_MINUS,d0 * compare with token for -
+00B0046A 66E6 1151 BNE.s RTS_005 * exit if not - (LIST -m)
+00B0046C 1152
+00B0046C 1153 * LIST [[n]-[m]] this sets the n, if present,
+00B0046C 1154 * as the start and end
+00B0046C 1155 LAB_14BD
+00B0046C 6100 0392 1156 BSR LAB_GFPN * get fixed-point number into temp integer & d1
+00B00470 1157 LAB_14C0
+00B00470 6100 FF78 1158 BSR LAB_SSLN * search BASIC for d1 line number
+00B00474 1159 * (pointer in a0)
+00B00474 6100 0934 1160 BSR LAB_GBYT * scan memory
+00B00478 6716 1161 BEQ.s LAB_14D4 * branch if no more characters
+00B0047A 1162
+00B0047A 1163 * this bit checks the - is present
+00B0047A B03C 00B3 1164 CMP.b #TK_MINUS,d0 * compare with token for -
+00B0047E 66D2 1165 BNE.s RTS_005 * return if not "-" (will be Syntax error)
+00B00480 1166
+00B00480 72FF 1167 MOVEQ #-1,d1 * set end to $FFFFFFFF
+00B00482 2741 048E 1168 MOVE.l d1,Itemp(a3) * save Itemp
+00B00486 1169
+00B00486 1170 * LIST [n]-[m] the - was there so see if
+00B00486 1171 * there is an m to set as the end value
+00B00486 6100 0920 1172 BSR LAB_IGBY * increment & scan memory
+00B0048A 6704 1173 BEQ.s LAB_14D4 * branch if was [NULL] (LIST n-)
+00B0048C 1174
+00B0048C 6100 0372 1175 BSR LAB_GFPN * get fixed-point number into temp integer & d1
+00B00490 1176 LAB_14D4
+00B00490 177C 0000 0641 1177 MOVE.b #$00,Oquote(a3) * clear open quote flag
+00B00496 6100 04E8 1178 BSR LAB_CRLF * print CR/LF
+00B0049A 2018 1179 MOVE.l (a0)+,d0 * get next line pointer
+00B0049C 67B4 1180 BEQ.s RTS_005 * if null all done so exit
+00B0049E 1181
+00B0049E 2240 1182 MOVEA.l d0,a1 * copy next line pointer
+00B004A0 6100 012C 1183 BSR LAB_1629 * do CRTL-C check vector
+00B004A4 1184
+00B004A4 2018 1185 MOVE.l (a0)+,d0 * get this line #
+00B004A6 B0AB 048E 1186 CMP.l Itemp(a3),d0 * compare end line # with this line #
+00B004AA 62A6 1187 BHI.s RTS_005 * if this line greater all done so exit
+00B004AC 1188
+00B004AC 1189 LAB_14E2
+00B004AC 48E7 00C0 1190 MOVEM.l a0-a1,-(sp) * save registers
+00B004B0 6100 180E 1191 BSR LAB_295E * print d0 as unsigned integer
+00B004B4 4CDF 0300 1192 MOVEM.l (sp)+,a0-a1 * restore registers
+00B004B8 7020 1193 MOVEQ #$20,d0 * space is the next character
+00B004BA 1194 LAB_150C
+00B004BA 6100 053C 1195 BSR LAB_PRNA * go print the character
+00B004BE B03C 0022 1196 CMP.b #$22,d0 * was it " character
+00B004C2 6606 1197 BNE.s LAB_1519 * branch if not
+00B004C4 1198
+00B004C4 1199 * we're either entering or leaving quotes
+00B004C4 0A2B 00FF 0641 1200 EOR.b #$FF,Oquote(a3) * toggle open quote flag
+00B004CA 1201 LAB_1519
+00B004CA 1018 1202 MOVE.b (a0)+,d0 * get byte and increment pointer
+00B004CC 6608 1203 BNE.s LAB_152E * branch if not [EOL] (go print)
+00B004CE 1204
+00B004CE 1205 * was [EOL]
+00B004CE 2049 1206 MOVEA.l a1,a0 * copy next line pointer
+00B004D0 2008 1207 MOVE.l a0,d0 * copy to set flags
+00B004D2 66BC 1208 BNE.s LAB_14D4 * go do next line if not [EOT]
+00B004D4 1209
+00B004D4 4E75 1210 RTS
+00B004D6 1211
+00B004D6 1212 LAB_152E
+00B004D6 6AE2 1213 BPL.s LAB_150C * just go print it if not token byte
+00B004D8 1214
+00B004D8 1215 * else it was a token byte so maybe uncrunch it
+00B004D8 4A2B 0641 1216 TST.b Oquote(a3) * test the open quote flag
+00B004DC 6BDC 1217 BMI.s LAB_150C * just go print character if open quote set
+00B004DE 1218
+00B004DE 1219 * else uncrunch BASIC token
+00B004DE 45FA 2AEA 1220 LEA LAB_KEYT(pc),a2 * get keyword table address
+00B004E2 727F 1221 MOVEQ #$7F,d1 * mask into d1
+00B004E4 C200 1222 AND.b d0,d1 * copy and mask token
+00B004E6 E549 1223 LSL.w #2,d1 * *4
+00B004E8 45F2 1000 1224 LEA (a2,d1.w),a2 * get keyword entry address
+00B004EC 101A 1225 MOVE.b (a2)+,d0 * get byte from keyword table
+00B004EE 6100 0508 1226 BSR LAB_PRNA * go print the first character
+00B004F2 7200 1227 MOVEQ #0,d1 * clear d1
+00B004F4 121A 1228 MOVE.b (a2)+,d1 * get remaining length byte from keyword table
+00B004F6 6BD2 1229 BMI.s LAB_1519 * if -ve done so go get next byte
+00B004F8 1230
+00B004F8 3012 1231 MOVE.w (a2),d0 * get offset to rest
+00B004FA 45FA 2DFA 1232 LEA TAB_STAR(pc),a2 * get keyword table address
+00B004FE 45F2 0000 1233 LEA (a2,d0.w),a2 * get address of rest
+00B00502 1234 LAB_1540
+00B00502 101A 1235 MOVE.b (a2)+,d0 * get byte from keyword table
+00B00504 6100 04F2 1236 BSR LAB_PRNA * go print the character
+00B00508 51C9 FFF8 1237 DBF d1,LAB_1540 * decrement and loop if more to do
+00B0050C 1238
+00B0050C 60BC 1239 BRA.s LAB_1519 * go get next byte
+00B0050E 1240
+00B0050E 1241
+00B0050E 1242 *************************************************************************************
+00B0050E 1243 *
+00B0050E 1244 * perform FOR
+00B0050E 1245
+00B0050E 1246 LAB_FOR
+00B0050E 6100 0390 1247 BSR LAB_LET * go do LET
+00B00512 1248
+00B00512 202B 04D6 1249 MOVE.l Lvarpl(a3),d0 * get the loop variable pointer
+00B00516 B0AB 049E 1250 CMP.l Sstrl(a3),d0 * compare it with the end of vars memory
+00B0051A 6C00 FC22 1251 BGE LAB_TMER * if greater go do type mismatch error
+00B0051E 1252
+00B0051E 1253 * test for not less than the start of variables memory if needed
+00B0051E 1254 *
+00B0051E 1255 * CMP.l Svarl(a3),d0 * compare it with the start of variables memory
+00B0051E 1256 * BLT LAB_TMER * if not variables memory do type mismatch error
+00B0051E 1257
+00B0051E 1258 * MOVEQ #28,d0 * we need 28 bytes !
+00B0051E 1259 * BSR.s LAB_1212 * check room on stack for d0 bytes
+00B0051E 1260
+00B0051E 6100 0214 1261 BSR LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
+00B00522 1262 * returns a0 as pointer to [:] or [EOL]
+00B00522 2E88 1263 MOVE.l a0,(sp) * push onto stack (and dump the return address)
+00B00524 2F2B 04B6 1264 MOVE.l Clinel(a3),-(sp) * push current line onto stack
+00B00528 1265
+00B00528 70AA 1266 MOVEQ #TK_TO-$100,d0 * set "TO" token
+00B0052A 6100 0874 1267 BSR LAB_SCCA * scan for CHR$(d0) else syntax error/warm start
+00B0052E 6100 0702 1268 BSR LAB_CTNM * check if source is numeric, else type mismatch
+00B00532 1F2B 0619 1269 MOVE.b Dtypef(a3),-(sp) * push the FOR variable data type onto stack
+00B00536 6100 06F8 1270 BSR LAB_EVNM * evaluate expression and check is numeric else
+00B0053A 1271 * do type mismatch
+00B0053A 1272
+00B0053A 2F2B 05F4 1273 MOVE.l FAC1_m(a3),-(sp) * push TO value mantissa
+00B0053E 3F2B 05F8 1274 MOVE.w FAC1_e(a3),-(sp) * push TO value exponent and sign
+00B00542 1275
+00B00542 277C 80000000 05F4 1276 MOVE.l #$80000000,FAC1_m(a3) * set default STEP size mantissa
+00B0054A 377C 8100 05F8 1277 MOVE.w #$8100,FAC1_e(a3) * set default STEP size exponent and sign
+00B00550 1278
+00B00550 6100 0858 1279 BSR LAB_GBYT * scan memory
+00B00554 B03C 00AF 1280 CMP.b #TK_STEP,d0 * compare with STEP token
+00B00558 6608 1281 BNE.s LAB_15B3 * jump if not "STEP"
+00B0055A 1282
+00B0055A 1283 * was STEP token so ....
+00B0055A 6100 084C 1284 BSR LAB_IGBY * increment & scan memory
+00B0055E 6100 06D0 1285 BSR LAB_EVNM * evaluate expression & check is numeric
+00B00562 1286 * else do type mismatch
+00B00562 1287 LAB_15B3
+00B00562 2F2B 05F4 1288 MOVE.l FAC1_m(a3),-(sp) * push STEP value mantissa
+00B00566 3F2B 05F8 1289 MOVE.w FAC1_e(a3),-(sp) * push STEP value exponent and sign
+00B0056A 1290
+00B0056A 2F2B 04D6 1291 MOVE.l Lvarpl(a3),-(sp) * push variable pointer for FOR/NEXT
+00B0056E 3F3C 0081 1292 MOVE.w #TK_FOR,-(sp) * push FOR token on stack
+00B00572 1293
+00B00572 6018 1294 BRA.s LAB_15C2 * go do interpreter inner loop
+00B00574 1295
+00B00574 1296 LAB_15DC * have reached [EOL]+1
+00B00574 300D 1297 MOVE.w a5,d0 * copy BASIC execute pointer
+00B00576 C07C 0001 1298 AND.w #1,d0 * and make line start address even
+00B0057A DAC0 1299 ADD.w d0,a5 * add to BASIC execute pointer
+00B0057C 201D 1300 MOVE.l (a5)+,d0 * get next line pointer
+00B0057E 6700 FC1A 1301 BEQ LAB_1274 * if null go to immediate mode, no "BREAK"
+00B00582 1302 * message (was immediate or [EOT] marker)
+00B00582 1303
+00B00582 275D 04B6 1304 MOVE.l (a5)+,Clinel(a3) * save (new) current line #
+00B00586 1305 LAB_15F6
+00B00586 6100 0822 1306 BSR LAB_GBYT * get BASIC byte
+00B0058A 611A 1307 BSR.s LAB_15FF * go interpret BASIC code from (a5)
+00B0058C 1308
+00B0058C 1309 * interpreter inner loop (re)entry point
+00B0058C 1310
+00B0058C 1311 LAB_15C2
+00B0058C 6140 1312 BSR.s LAB_1629 * do CRTL-C check vector
+00B0058E 4A2B 04B6 1313 TST.b Clinel(a3) * test current line #, is -ve for immediate mode
+00B00592 6B04 1314 BMI.s LAB_15D1 * branch if immediate mode
+00B00594 1315
+00B00594 274D 04BE 1316 MOVE.l a5,Cpntrl(a3) * save BASIC execute pointer as continue pointer
+00B00598 1317 LAB_15D1
+00B00598 101D 1318 MOVE.b (a5)+,d0 * get this byte & increment pointer
+00B0059A 67D8 1319 BEQ.s LAB_15DC * loop if [EOL]
+00B0059C 1320
+00B0059C B03C 003A 1321 CMP.b #$3A,d0 * compare with ":"
+00B005A0 67E4 1322 BEQ.s LAB_15F6 * loop if was statement separator
+00B005A2 1323
+00B005A2 6000 FBC6 1324 BRA LAB_SNER * else syntax error, then warm start
+00B005A6 1325
+00B005A6 1326
+00B005A6 1327 *************************************************************************************
+00B005A6 1328 *
+00B005A6 1329 * interpret BASIC code from (a5)
+00B005A6 1330
+00B005A6 1331 LAB_15FF
+00B005A6 6700 008C 1332 BEQ RTS_006 * exit if zero [EOL]
+00B005AA 1333
+00B005AA 1334 LAB_1602
+00B005AA 0A00 0080 1335 EORI.b #$80,d0 * normalise token
+00B005AE 6B00 02F0 1336 BMI LAB_LET * if not token, go do implied LET
+00B005B2 1337
+00B005B2 B03C 0028 1338 CMP.b #(TK_TAB-$80),d0 * compare normalised token with TAB
+00B005B6 6400 FBB2 1339 BCC LAB_SNER * branch if d0>=TAB, syntax error/warm start
+00B005BA 1340 * only tokens before TAB can start a statement
+00B005BA 1341
+00B005BA 4880 1342 EXT.w d0 * byte to word (clear high byte)
+00B005BC D040 1343 ADD.w d0,d0 * *2
+00B005BE 41FA 2868 1344 LEA LAB_CTBL(pc),a0 * get vector table base address
+00B005C2 3030 0000 1345 MOVE.w (a0,d0.w),d0 * get offset to vector
+00B005C6 4870 0000 1346 PEA (a0,d0.w) * push vector
+00B005CA 6000 07DC 1347 BRA LAB_IGBY * get following byte & execute vector
+00B005CE 1348
+00B005CE 1349
+00B005CE 1350 *************************************************************************************
+00B005CE 1351 *
+00B005CE 1352 * CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
+00B005CE 1353 * key press is detected.
+00B005CE 1354
+00B005CE 1355 LAB_1629
+00B005CE 4EEB 0488 1356 JMP V_CTLC(a3) * ctrl c check vector
+00B005D2 1357
+00B005D2 1358 * if there was a key press it gets back here .....
+00B005D2 1359
+00B005D2 1360 LAB_1636
+00B005D2 B03C 0003 1361 CMP.b #$03,d0 * compare with CTRL-C
+00B005D6 670C 1362 BEQ.s LAB_163B * STOP if was CTRL-C
+00B005D8 1363
+00B005D8 1364 LAB_1639
+00B005D8 4E75 1365 RTS *
+00B005DA 1366
+00B005DA 1367
+00B005DA 1368 *************************************************************************************
+00B005DA 1369 *
+00B005DA 1370 * perform END
+00B005DA 1371
+00B005DA 1372 LAB_END
+00B005DA 66FC 1373 BNE.s LAB_1639 * exit if something follows STOP
+00B005DC 177C 0000 0640 1374 MOVE.b #0,Breakf(a3) * clear break flag, indicate program end
+00B005E2 1375
+00B005E2 1376
+00B005E2 1377 *************************************************************************************
+00B005E2 1378 *
+00B005E2 1379 * perform STOP
+00B005E2 1380
+00B005E2 1381 LAB_STOP
+00B005E2 66F4 1382 BNE.s LAB_1639 * exit if something follows STOP
+00B005E4 1383
+00B005E4 1384 LAB_163B
+00B005E4 43EB 05F4 1385 LEA Ibuffe(a3),a1 * get buffer end
+00B005E8 BBC9 1386 CMPA.l a1,a5 * compare execute address with buffer end
+00B005EA 650A 1387 BCS.s LAB_164F * branch if BASIC pointer is in buffer
+00B005EC 1388 * can't continue in immediate mode
+00B005EC 1389
+00B005EC 1390 * else...
+00B005EC 274D 04BE 1391 MOVE.l a5,Cpntrl(a3) * save BASIC execute pointer as continue pointer
+00B005F0 1392 LAB_1647
+00B005F0 276B 04B6 04BA 1393 MOVE.l Clinel(a3),Blinel(a3) * save break line
+00B005F6 1394 LAB_164F
+00B005F6 584F 1395 ADDQ.w #4,sp * dump return address, don't return to execute
+00B005F8 1396 * loop
+00B005F8 102B 0640 1397 MOVE.b Breakf(a3),d0 * get break flag
+00B005FC 6700 FB9C 1398 BEQ LAB_1274 * go do warm start if was program end
+00B00600 1399
+00B00600 41FA 2E9F 1400 LEA LAB_BMSG(pc),a0 * point to "Break"
+00B00604 6000 FB86 1401 BRA LAB_1269 * print "Break" and do warm start
+00B00608 1402
+00B00608 1403
+00B00608 1404 *************************************************************************************
+00B00608 1405 *
+00B00608 1406 * perform RESTORE
+00B00608 1407
+00B00608 1408 LAB_RESTORE
+00B00608 206B 0492 1409 MOVEA.l Smeml(a3),a0 * copy start of memory
+00B0060C 6720 1410 BEQ.s LAB_1624 * branch if next character null (RESTORE)
+00B0060E 1411
+00B0060E 6100 01F0 1412 BSR LAB_GFPN * get fixed-point number into temp integer & d1
+00B00612 B2AB 04B6 1413 CMP.l Clinel(a3),d1 * compare current line # with required line #
+00B00616 630E 1414 BLS.s LAB_GSCH * branch if >= (start search from beginning)
+00B00618 1415
+00B00618 204D 1416 MOVEA.l a5,a0 * copy BASIC execute pointer
+00B0061A 1417 LAB_RESs
+00B0061A 4A18 1418 TST.b (a0)+ * test next byte & increment pointer
+00B0061C 66FC 1419 BNE.s LAB_RESs * loop if not EOL
+00B0061E 1420
+00B0061E 3008 1421 MOVE.w a0,d0 * copy pointer
+00B00620 C07C 0001 1422 AND.w #1,d0 * mask odd bit
+00B00624 D0C0 1423 ADD.w d0,a0 * add pointer
+00B00626 1424 * search for line in Itemp from (a0)
+00B00626 1425 LAB_GSCH
+00B00626 6100 FDCA 1426 BSR LAB_SCLN * search for d1 line number from a0
+00B0062A 1427 * returns Cb=0 if found
+00B0062A 6500 FB26 1428 BCS LAB_USER * go do "Undefined statement" error if not found
+00B0062E 1429
+00B0062E 1430 LAB_1624
+00B0062E 4A20 1431 TST.b -(a0) * decrement pointer (faster)
+00B00630 2748 04C6 1432 MOVE.l a0,Dptrl(a3) * save DATA pointer
+00B00634 1433 RTS_006
+00B00634 4E75 1434 RTS
+00B00636 1435
+00B00636 1436
+00B00636 1437 *************************************************************************************
+00B00636 1438 *
+00B00636 1439 * perform NULL
+00B00636 1440
+00B00636 1441 LAB_NULL
+00B00636 6100 10DA 1442 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
+00B0063A 1740 0648 1443 MOVE.b d0,Nullct(a3) * save new NULL count
+00B0063E 4E75 1444 RTS
+00B00640 1445
+00B00640 1446
+00B00640 1447 *************************************************************************************
+00B00640 1448 *
+00B00640 1449 * perform CONT
+00B00640 1450
+00B00640 1451 LAB_CONT
+00B00640 6600 FB28 1452 BNE LAB_SNER * if following byte exit to do syntax error
+00B00644 1453
+00B00644 4A2B 04B6 1454 TST.b Clinel(a3) * test current line #, is -ve for immediate mode
+00B00648 6A00 FAE8 1455 BPL LAB_CCER * if running go do can't continue error
+00B0064C 1456
+00B0064C 202B 04BE 1457 MOVE.l Cpntrl(a3),d0 * get continue pointer
+00B00650 6700 FAE0 1458 BEQ LAB_CCER * go do can't continue error if we can't
+00B00654 1459
+00B00654 1460 * we can continue so ...
+00B00654 2A40 1461 MOVEA.l d0,a5 * save continue pointer as BASIC execute pointer
+00B00656 276B 04BA 04B6 1462 MOVE.l Blinel(a3),Clinel(a3) * set break line as current line
+00B0065C 4E75 1463 RTS
+00B0065E 1464
+00B0065E 1465
+00B0065E 1466 *************************************************************************************
+00B0065E 1467 *
+00B0065E 1468 * perform RUN
+00B0065E 1469
+00B0065E 1470 LAB_RUN
+00B0065E 660C 1471 BNE.s LAB_RUNn * if following byte do RUN n
+00B00660 1472
+00B00660 6100 FDB0 1473 BSR LAB_1477 * execution to start, clear vars & flush stack
+00B00664 274D 04BE 1474 MOVE.l a5,Cpntrl(a3) * save as continue pointer
+00B00668 6000 FF22 1475 BRA LAB_15C2 * go do interpreter inner loop
+00B0066C 1476 * (can't RTS, we flushed the stack!)
+00B0066C 1477
+00B0066C 1478 LAB_RUNn
+00B0066C 6100 FDAA 1479 BSR LAB_147A * go do "CLEAR"
+00B00670 601C 1480 BRA.s LAB_16B0 * get n and do GOTO n
+00B00672 1481
+00B00672 1482
+00B00672 1483 *************************************************************************************
+00B00672 1484 *
+00B00672 1485 * perform DO
+00B00672 1486
+00B00672 1487 LAB_DO
+00B00672 1488 * MOVE.l #$05,d0 * need 5 bytes for DO
+00B00672 1489 * BSR.s LAB_1212 * check room on stack for A bytes
+00B00672 2F0D 1490 MOVE.l a5,-(sp) * push BASIC execute pointer on stack
+00B00674 2F2B 04B6 1491 MOVE.l Clinel(a3),-(sp) * push current line on stack
+00B00678 3F3C 009C 1492 MOVE.w #TK_DO,-(sp) * push token for DO on stack
+00B0067C 487A FF0E 1493 PEA LAB_15C2(pc) * set return address
+00B00680 6000 0728 1494 BRA LAB_GBYT * scan memory & return to interpreter inner loop
+00B00684 1495
+00B00684 1496
+00B00684 1497 *************************************************************************************
+00B00684 1498 *
+00B00684 1499 * perform GOSUB
+00B00684 1500
+00B00684 1501 LAB_GOSUB
+00B00684 1502 * MOVE.l #10,d0 * need 10 bytes for GOSUB
+00B00684 1503 * BSR.s LAB_1212 * check room on stack for d0 bytes
+00B00684 2F0D 1504 MOVE.l a5,-(sp) * push BASIC execute pointer
+00B00686 2F2B 04B6 1505 MOVE.l Clinel(a3),-(sp) * push current line
+00B0068A 3F3C 008D 1506 MOVE.w #TK_GOSUB,-(sp) * push token for GOSUB
+00B0068E 1507 LAB_16B0
+00B0068E 6100 071A 1508 BSR LAB_GBYT * scan memory
+00B00692 487A FEF8 1509 PEA LAB_15C2(pc) * return to interpreter inner loop after GOTO n
+00B00696 1510
+00B00696 1511 * this PEA is needed because either we just cleared the stack and have nowhere to return
+00B00696 1512 * to or, in the case of GOSUB, we have just dropped a load on the stack and the address
+00B00696 1513 * we whould have returned to is buried. This burried return address will be unstacked by
+00B00696 1514 * the corresponding RETURN command
+00B00696 1515
+00B00696 1516
+00B00696 1517 *************************************************************************************
+00B00696 1518 *
+00B00696 1519 * perform GOTO
+00B00696 1520
+00B00696 1521 LAB_GOTO
+00B00696 6100 0168 1522 BSR LAB_GFPN * get fixed-point number into temp integer & d1
+00B0069A 206B 0492 1523 MOVEA.l Smeml(a3),a0 * get start of memory
+00B0069E B2AB 04B6 1524 CMP.l Clinel(a3),d1 * compare current line with wanted #
+00B006A2 630E 1525 BLS.s LAB_16D0 * branch if current # => wanted #
+00B006A4 1526
+00B006A4 204D 1527 MOVEA.l a5,a0 * copy BASIC execute pointer
+00B006A6 1528 LAB_GOTs
+00B006A6 4A18 1529 TST.b (a0)+ * test next byte & increment pointer
+00B006A8 66FC 1530 BNE.s LAB_GOTs * loop if not EOL
+00B006AA 1531
+00B006AA 3008 1532 MOVE.w a0,d0 * past pad byte(s)
+00B006AC C07C 0001 1533 AND.w #1,d0 * mask odd bit
+00B006B0 D0C0 1534 ADD.w d0,a0 * add to pointer
+00B006B2 1535
+00B006B2 1536 LAB_16D0
+00B006B2 6100 FD3E 1537 BSR LAB_SCLN * search for d1 line number from a0
+00B006B6 1538 * returns Cb=0 if found
+00B006B6 6500 FA9A 1539 BCS LAB_USER * if carry set go do "Undefined statement" error
+00B006BA 1540
+00B006BA 2A48 1541 MOVEA.l a0,a5 * copy to basic execute pointer
+00B006BC 534D 1542 SUBQ.w #1,a5 * decrement pointer
+00B006BE 274D 04BE 1543 MOVE.l a5,Cpntrl(a3) * save as continue pointer
+00B006C2 4E75 1544 RTS
+00B006C4 1545
+00B006C4 1546
+00B006C4 1547 *************************************************************************************
+00B006C4 1548 *
+00B006C4 1549 * perform LOOP
+00B006C4 1550
+00B006C4 1551 LAB_LOOP
+00B006C4 0C6F 009C 0004 1552 CMP.w #TK_DO,4(sp) * compare token on stack with DO token
+00B006CA 6600 FA5E 1553 BNE LAB_LDER * branch if no matching DO
+00B006CE 1554
+00B006CE 1E00 1555 MOVE.b d0,d7 * copy following token (byte)
+00B006D0 672E 1556 BEQ.s LoopAlways * if no following token loop forever
+00B006D2 1557
+00B006D2 BE3C 003A 1558 CMP.b #':',d7 * compare with ":"
+00B006D6 6728 1559 BEQ.s LoopAlways * if no following token loop forever
+00B006D8 1560
+00B006D8 0407 00B0 1561 SUB.b #TK_UNTIL,d7 * subtract token for UNTIL
+00B006DC 6708 1562 BEQ.s DoRest * branch if was UNTIL
+00B006DE 1563
+00B006DE 5307 1564 SUBQ.b #1,d7 * decrement result
+00B006E0 6600 FA88 1565 BNE LAB_SNER * if not WHILE go do syntax error & warm start
+00B006E4 1566 * only if the token was WHILE will this fail
+00B006E4 1567
+00B006E4 7EFF 1568 MOVEQ #-1,d7 * set invert result longword
+00B006E6 1569 DoRest
+00B006E6 6100 06C0 1570 BSR LAB_IGBY * increment & scan memory
+00B006EA 6100 055C 1571 BSR LAB_EVEX * evaluate expression
+00B006EE 4A2B 05F8 1572 TST.b FAC1_e(a3) * test FAC1 exponent
+00B006F2 6706 1573 BEQ.s DoCmp * if = 0 go do straight compare
+00B006F4 1574
+00B006F4 177C 00FF 05F8 1575 MOVE.b #$FF,FAC1_e(a3) * else set all bits
+00B006FA 1576 DoCmp
+00B006FA BF2B 05F8 1577 EOR.b d7,FAC1_e(a3) * EOR with invert byte
+00B006FE 6614 1578 BNE.s LoopDone * if <> 0 clear stack & back to interpreter loop
+00B00700 1579
+00B00700 1580 * loop condition wasn't met so do it again
+00B00700 1581 LoopAlways
+00B00700 276F 0006 04B6 1582 MOVE.l 6(sp),Clinel(a3) * copy DO current line
+00B00706 2A6F 000A 1583 MOVE.l 10(sp),a5 * save BASIC execute pointer
+00B0070A 1584
+00B0070A 41FA FE80 1585 LEA LAB_15C2(pc),a0 * get return address
+00B0070E 2E88 1586 MOVE.l a0,(sp) * dump the call to this routine and set the
+00B00710 1587 * return address
+00B00710 6000 0698 1588 BRA LAB_GBYT * scan memory and return to interpreter inner
+00B00714 1589 * loop
+00B00714 1590
+00B00714 1591 * clear stack & back to interpreter loop
+00B00714 1592 LoopDone
+00B00714 4FEF 000E 1593 LEA 14(sp),sp * dump structure and call from stack
+00B00718 6014 1594 BRA.s LAB_DATA * go perform DATA (find : or [EOL])
+00B0071A 1595
+00B0071A 1596
+00B0071A 1597 *************************************************************************************
+00B0071A 1598 *
+00B0071A 1599 * perform RETURN
+00B0071A 1600
+00B0071A 1601 LAB_RETURN
+00B0071A 6616 1602 BNE.s RTS_007 * exit if following token to allow syntax error
+00B0071C 1603
+00B0071C 0C6F 008D 0004 1604 CMP.w #TK_GOSUB,4(sp) * compare token from stack with GOSUB
+00B00722 6600 FA42 1605 BNE LAB_RGER * do RETURN without GOSUB error if no matching
+00B00726 1606 * GOSUB
+00B00726 1607
+00B00726 5C4F 1608 ADDQ.w #6,sp * dump calling address & token
+00B00728 275F 04B6 1609 MOVE.l (sp)+,Clinel(a3) * pull current line
+00B0072C 2A5F 1610 MOVE.l (sp)+,a5 * pull BASIC execute pointer
+00B0072E 1611 * now do perform "DATA" statement as we could be
+00B0072E 1612 * returning into the middle of an ON GOSUB
+00B0072E 1613 * n,m,p,q line (the return address used by the
+00B0072E 1614 * DATA statement is the one pushed before the
+00B0072E 1615 * GOSUB was executed!)
+00B0072E 1616
+00B0072E 1617
+00B0072E 1618 *************************************************************************************
+00B0072E 1619 *
+00B0072E 1620 * perform DATA
+00B0072E 1621
+00B0072E 1622 LAB_DATA
+00B0072E 6104 1623 BSR.s LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
+00B00730 1624 * returns a0 as pointer to [:] or [EOL]
+00B00730 2A48 1625 MOVEA.l a0,a5 * skip rest of statement
+00B00732 1626 RTS_007
+00B00732 4E75 1627 RTS
+00B00734 1628
+00B00734 1629
+00B00734 1630 *************************************************************************************
+00B00734 1631 *
+00B00734 1632 * scan for next BASIC statement ([:] or [EOL])
+00B00734 1633 * returns a0 as pointer to [:] or [EOL]
+00B00734 1634
+00B00734 1635 LAB_SNBS
+00B00734 204D 1636 MOVEA.l a5,a0 * copy BASIC execute pointer
+00B00736 7222 1637 MOVEQ #$22,d1 * set string quote character
+00B00738 743A 1638 MOVEQ #$3A,d2 * set look for character = ":"
+00B0073A 6008 1639 BRA.s LAB_172D * go do search
+00B0073C 1640
+00B0073C 1641 LAB_172C
+00B0073C B400 1642 CMP.b d0,d2 * compare with ":"
+00B0073E 6708 1643 BEQ.s RTS_007a * exit if found
+00B00740 1644
+00B00740 B200 1645 CMP.b d0,d1 * compare with '"'
+00B00742 670C 1646 BEQ.s LAB_1725 * if found go search for [EOL]
+00B00744 1647
+00B00744 1648 LAB_172D
+00B00744 1018 1649 MOVE.b (a0)+,d0 * get next byte
+00B00746 66F4 1650 BNE.s LAB_172C * loop if not null [EOL]
+00B00748 1651
+00B00748 1652 RTS_007a
+00B00748 5348 1653 SUBQ.w #1,a0 * correct pointer
+00B0074A 4E75 1654 RTS
+00B0074C 1655
+00B0074C 1656 LAB_1723
+00B0074C B200 1657 CMP.b d0,d1 * compare with '"'
+00B0074E 67F4 1658 BEQ.s LAB_172D * if found go search for ":" or [EOL]
+00B00750 1659
+00B00750 1660 LAB_1725
+00B00750 1018 1661 MOVE.b (a0)+,d0 * get next byte
+00B00752 66F8 1662 BNE.s LAB_1723 * loop if not null [EOL]
+00B00754 1663
+00B00754 60F2 1664 BRA.s RTS_007a * correct pointer & return
+00B00756 1665
+00B00756 1666
+00B00756 1667 *************************************************************************************
+00B00756 1668 *
+00B00756 1669 * perform IF
+00B00756 1670
+00B00756 1671 LAB_IF
+00B00756 6100 04F0 1672 BSR LAB_EVEX * evaluate expression
+00B0075A 6100 064E 1673 BSR LAB_GBYT * scan memory
+00B0075E B03C 00AD 1674 CMP.b #TK_THEN,d0 * compare with THEN token
+00B00762 6714 1675 BEQ.s LAB_174B * if it was THEN then continue
+00B00764 1676
+00B00764 1677 * wasn't IF .. THEN so must be IF .. GOTO
+00B00764 B03C 0089 1678 CMP.b #TK_GOTO,d0 * compare with GOTO token
+00B00768 6600 FA00 1679 BNE LAB_SNER * if not GOTO token do syntax error/warm start
+00B0076C 1680
+00B0076C 1681 * was GOTO so check for GOTO
+00B0076C 204D 1682 MOVE.l a5,a0 * save the execute pointer
+00B0076E 6100 0638 1683 BSR LAB_IGBY * scan memory, test for a numeric character
+00B00772 2A48 1684 MOVE.l a0,a5 * restore the execute pointer
+00B00774 6400 F9F4 1685 BCC LAB_SNER * if not numeric do syntax error/warm start
+00B00778 1686
+00B00778 1687 LAB_174B
+00B00778 102B 05F8 1688 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
+00B0077C 671E 1689 BEQ.s LAB_174E * if result was zero go look for an ELSE
+00B0077E 1690
+00B0077E 6100 0628 1691 BSR LAB_IGBY * increment & scan memory
+00B00782 6500 FF12 1692 BCS LAB_GOTO * if numeric do GOTO n
+00B00786 1693 * a GOTO will never return to the IF
+00B00786 1694 * statement so there is no need to return
+00B00786 1695 * to this code
+00B00786 1696
+00B00786 B03C 008E 1697 CMP.b #TK_RETURN,d0 * compare with RETURN token
+00B0078A 6700 FE1E 1698 BEQ LAB_1602 * if RETURN then interpret BASIC code from (a5)
+00B0078E 1699 * and don't return here
+00B0078E 1700
+00B0078E 6100 FE16 1701 BSR LAB_15FF * else interpret BASIC code from (a5)
+00B00792 1702
+00B00792 1703 * the IF was executed and there may be a following ELSE so the code needs to return
+00B00792 1704 * here to check and ignore the ELSE if present
+00B00792 1705
+00B00792 1015 1706 MOVE.b (a5),d0 * get the next basic byte
+00B00794 B03C 00A9 1707 CMP.b #TK_ELSE,d0 * compare it with the token for ELSE
+00B00798 6794 1708 BEQ LAB_DATA * if ELSE ignore the following statement
+00B0079A 1709
+00B0079A 1710 * there was no ELSE so continue execution of IF THEN [: ]. any
+00B0079A 1711 * following ELSE will, correctly, cause a syntax error
+00B0079A 1712
+00B0079A 4E75 1713 RTS * else return to interpreter inner loop
+00B0079C 1714
+00B0079C 1715 * perform ELSE after IF
+00B0079C 1716
+00B0079C 1717 LAB_174E
+00B0079C 101D 1718 MOVE.b (a5)+,d0 * faster increment past THEN
+00B0079E 76A9 1719 MOVEQ #TK_ELSE,d3 * set search for ELSE token
+00B007A0 788B 1720 MOVEQ #TK_IF,d4 * set search for IF token
+00B007A2 7A00 1721 MOVEQ #0,d5 * clear the nesting depth
+00B007A4 1722 LAB_1750
+00B007A4 101D 1723 MOVE.b (a5)+,d0 * get next BASIC byte & increment ptr
+00B007A6 6720 1724 BEQ.s LAB_1754 * if EOL correct the pointer and return
+00B007A8 1725
+00B007A8 B004 1726 CMP.b d4,d0 * compare with "IF" token
+00B007AA 6604 1727 BNE.s LAB_1752 * skip if not nested IF
+00B007AC 1728
+00B007AC 5245 1729 ADDQ.w #1,d5 * else increment the nesting depth ..
+00B007AE 60F4 1730 BRA.s LAB_1750 * .. and continue looking
+00B007B0 1731
+00B007B0 1732 LAB_1752
+00B007B0 B003 1733 CMP.b d3,d0 * compare with ELSE token
+00B007B2 66F0 1734 BNE.s LAB_1750 * if not ELSE continue looking
+00B007B4 1735
+00B007B4 1736 LAB_1756
+00B007B4 51CD FFEE 1737 DBF d5,LAB_1750 * loop if still nested
+00B007B8 1738
+00B007B8 1739 * found the matching ELSE, now do <{n|statement}>
+00B007B8 1740
+00B007B8 6100 05F0 1741 BSR LAB_GBYT * scan memory
+00B007BC 6500 FED8 1742 BCS LAB_GOTO * if numeric do GOTO n
+00B007C0 1743 * code will return to the interpreter loop
+00B007C0 1744 * at the tail end of the GOTO
+00B007C0 1745
+00B007C0 6000 FDE4 1746 BRA LAB_15FF * else interpret BASIC code from (a5)
+00B007C4 1747 * code will return to the interpreter loop
+00B007C4 1748 * at the tail end of the
+00B007C4 1749
+00B007C4 1750
+00B007C4 1751 *************************************************************************************
+00B007C4 1752 *
+00B007C4 1753 * perform REM, skip (rest of) line
+00B007C4 1754
+00B007C4 1755 LAB_REM
+00B007C4 4A1D 1756 TST.b (a5)+ * test byte & increment pointer
+00B007C6 66FC 1757 BNE.s LAB_REM * loop if not EOL
+00B007C8 1758
+00B007C8 1759 LAB_1754
+00B007C8 534D 1760 SUBQ.w #1,a5 * correct the execute pointer
+00B007CA 4E75 1761 RTS
+00B007CC 1762
+00B007CC 1763
+00B007CC 1764 *************************************************************************************
+00B007CC 1765 *
+00B007CC 1766 * perform ON
+00B007CC 1767
+00B007CC 1768 LAB_ON
+00B007CC 6100 0F44 1769 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
+00B007D0 1400 1770 MOVE.b d0,d2 * copy byte
+00B007D2 6100 05D6 1771 BSR LAB_GBYT * restore BASIC byte
+00B007D6 3F00 1772 MOVE.w d0,-(sp) * push GOTO/GOSUB token
+00B007D8 B03C 008D 1773 CMP.b #TK_GOSUB,d0 * compare with GOSUB token
+00B007DC 6708 1774 BEQ.s LAB_176C * branch if GOSUB
+00B007DE 1775
+00B007DE B03C 0089 1776 CMP.b #TK_GOTO,d0 * compare with GOTO token
+00B007E2 6600 F986 1777 BNE LAB_SNER * if not GOTO do syntax error, then warm start
+00B007E6 1778
+00B007E6 1779 * next character was GOTO or GOSUB
+00B007E6 1780
+00B007E6 1781 LAB_176C
+00B007E6 5302 1782 SUBQ.b #1,d2 * decrement index (byte value)
+00B007E8 6606 1783 BNE.s LAB_1773 * branch if not zero
+00B007EA 1784
+00B007EA 301F 1785 MOVE.w (sp)+,d0 * pull GOTO/GOSUB token
+00B007EC 6000 FDBC 1786 BRA LAB_1602 * go execute it
+00B007F0 1787
+00B007F0 1788 LAB_1773
+00B007F0 6100 05B6 1789 BSR LAB_IGBY * increment & scan memory
+00B007F4 610A 1790 BSR.s LAB_GFPN * get fixed-point number into temp integer & d1
+00B007F6 1791 * (skip this n)
+00B007F6 B03C 002C 1792 CMP.b #$2C,d0 * compare next character with ","
+00B007FA 67EA 1793 BEQ.s LAB_176C * loop if ","
+00B007FC 1794
+00B007FC 301F 1795 MOVE.w (sp)+,d0 * pull GOTO/GOSUB token (run out of options)
+00B007FE 4E75 1796 RTS * and exit
+00B00800 1797
+00B00800 1798
+00B00800 1799 *************************************************************************************
+00B00800 1800 *
+00B00800 1801 * get fixed-point number into temp integer & d1
+00B00800 1802 * interpret number from (a5), leave (a5) pointing to byte after #
+00B00800 1803
+00B00800 1804 LAB_GFPN
+00B00800 7200 1805 MOVEQ #$00,d1 * clear integer register
+00B00802 2001 1806 MOVE.l d1,d0 * clear d0
+00B00804 6100 05A4 1807 BSR LAB_GBYT * scan memory, Cb=1 if "0"-"9", & get byte
+00B00808 642E 1808 BCC.s LAB_1786 * return if carry clear, chr was not "0"-"9"
+00B0080A 1809
+00B0080A 2F02 1810 MOVE.l d2,-(sp) * save d2
+00B0080C 1811 LAB_1785
+00B0080C 2401 1812 MOVE.l d1,d2 * copy integer register
+00B0080E D281 1813 ADD.l d1,d1 * *2
+00B00810 6500 F958 1814 BCS LAB_SNER * if overflow do syntax error, then warm start
+00B00814 1815
+00B00814 D281 1816 ADD.l d1,d1 * *4
+00B00816 6500 F952 1817 BCS LAB_SNER * if overflow do syntax error, then warm start
+00B0081A 1818
+00B0081A D282 1819 ADD.l d2,d1 * *1 + *4
+00B0081C 6500 F94C 1820 BCS LAB_SNER * if overflow do syntax error, then warm start
+00B00820 1821
+00B00820 D281 1822 ADD.l d1,d1 * *10
+00B00822 6500 F946 1823 BCS LAB_SNER * if overflow do syntax error, then warm start
+00B00826 1824
+00B00826 0400 0030 1825 SUB.b #$30,d0 * subtract $30 from byte
+00B0082A D280 1826 ADD.l d0,d1 * add to integer register, the top 24 bits are
+00B0082C 1827 * always clear
+00B0082C 6900 F93C 1828 BVS LAB_SNER * if overflow do syntax error, then warm start
+00B00830 1829 * this makes the maximum line number 2147483647
+00B00830 6100 0576 1830 BSR LAB_IGBY * increment & scan memory
+00B00834 65D6 1831 BCS.s LAB_1785 * loop for next character if "0"-"9"
+00B00836 1832
+00B00836 241F 1833 MOVE.l (sp)+,d2 * restore d2
+00B00838 1834 LAB_1786
+00B00838 2741 048E 1835 MOVE.l d1,Itemp(a3) * save Itemp
+00B0083C 4E75 1836 RTS
+00B0083E 1837
+00B0083E 1838
+00B0083E 1839 *************************************************************************************
+00B0083E 1840 *
+00B0083E 1841 * perform DEC
+00B0083E 1842
+00B0083E 1843 LAB_DEC
+00B0083E 3F3C 8180 1844 MOVE.w #$8180,-(sp) * set -1 sign/exponent
+00B00842 600A 1845 BRA.s LAB_17B7 * go do DEC
+00B00844 1846
+00B00844 1847
+00B00844 1848 *************************************************************************************
+00B00844 1849 *
+00B00844 1850 * perform INC
+00B00844 1851
+00B00844 1852 LAB_INC
+00B00844 3F3C 8100 1853 MOVE.w #$8100,-(sp) * set 1 sign/exponent
+00B00848 6004 1854 BRA.s LAB_17B7 * go do INC
+00B0084A 1855
+00B0084A 1856 * was "," so another INCR variable to do
+00B0084A 1857 LAB_17B8
+00B0084A 6100 055C 1858 BSR LAB_IGBY * increment and scan memory
+00B0084E 1859 LAB_17B7
+00B0084E 6100 0768 1860 BSR LAB_GVAR * get variable address in a0
+00B00852 1861
+00B00852 1862 * if you want a non existant variable to return a null value then set the novar
+00B00852 1863 * value at the top of this file to some non zero value
+00B00852 1864
+00B00852 FALSE 1865 ifne novar
+00B00852 1866 endc
+00B00852 1867
+00B00852 4A2B 0619 1868 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00856 1869 * $00=float
+00B00856 6B00 F8E6 1870 BMI LAB_TMER * if string do "Type mismatch" error/warm start
+00B0085A 1871
+00B0085A 6636 1872 BNE.s LAB_INCI * go do integer INC/DEC
+00B0085C 1873
+00B0085C 2748 04D6 1874 MOVE.l a0,Lvarpl(a3) * save var address
+00B00860 6100 130A 1875 BSR LAB_UFAC * unpack memory (a0) into FAC1
+00B00864 277C 80000000 05FC 1876 MOVE.l #$80000000,FAC2_m(a3) * set FAC2 mantissa for 1
+00B0086C 3017 1877 MOVE.w (sp),d0 * move exponent & sign to d0
+00B0086E 3740 0600 1878 MOVE.w d0,FAC2_e(a3) * move exponent & sign to FAC2
+00B00872 176B 05F9 0602 1879 MOVE.b FAC1_s(a3),FAC_sc(a3) * make sign compare = FAC1 sign
+00B00878 B12B 0602 1880 EOR.b d0,FAC_sc(a3) * make sign compare (FAC1_s EOR FAC2_s)
+00B0087C 6100 100A 1881 BSR LAB_ADD * add FAC2 to FAC1
+00B00880 6100 1306 1882 BSR LAB_PFAC * pack FAC1 into variable (Lvarpl)
+00B00884 1883 LAB_INCT
+00B00884 6100 0524 1884 BSR LAB_GBYT * scan memory
+00B00888 0C00 002C 1885 CMPI.b #$2C,d0 * compare with ","
+00B0088C 67BC 1886 BEQ.s LAB_17B8 * continue if "," (another variable to do)
+00B0088E 1887
+00B0088E 544F 1888 ADDQ.w #2,sp * else dump sign & exponent
+00B00890 4E75 1889 RTS
+00B00892 1890
+00B00892 1891 LAB_INCI
+00B00892 4A2F 0001 1892 TST.b 1(sp) * test sign
+00B00896 6604 1893 BNE.s LAB_DECI * branch if DEC
+00B00898 1894
+00B00898 5290 1895 ADDQ.l #1,(a0) * increment variable
+00B0089A 60E8 1896 BRA.s LAB_INCT * go scan for more
+00B0089C 1897
+00B0089C 1898 LAB_DECI
+00B0089C 5390 1899 SUBQ.l #1,(a0) * decrement variable
+00B0089E 60E4 1900 BRA.s LAB_INCT * go scan for more
+00B008A0 1901
+00B008A0 1902
+00B008A0 1903 *************************************************************************************
+00B008A0 1904 *
+00B008A0 1905 * perform LET
+00B008A0 1906
+00B008A0 1907 LAB_LET
+00B008A0 6100 0712 1908 BSR LAB_SVAR * search for or create a variable
+00B008A4 1909 * return the variable address in a0
+00B008A4 2748 04D6 1910 MOVE.l a0,Lvarpl(a3) * save variable address
+00B008A8 1F2B 0619 1911 MOVE.b Dtypef(a3),-(sp) * push var data type, $80=string, $40=integer,
+00B008AC 1912 * $00=float
+00B008AC 70BD 1913 MOVEQ #TK_EQUAL-$100,d0 * get = token
+00B008AE 6100 04F0 1914 BSR LAB_SCCA * scan for CHR$(d0), else do syntax error/warm
+00B008B2 1915 * start
+00B008B2 6100 0394 1916 BSR LAB_EVEX * evaluate expression
+00B008B6 102B 0619 1917 MOVE.b Dtypef(a3),d0 * copy expression data type
+00B008BA 175F 0619 1918 MOVE.b (sp)+,Dtypef(a3) * pop variable data type
+00B008BE E318 1919 ROL.b #1,d0 * set carry if expression type = string
+00B008C0 6100 0372 1920 BSR LAB_CKTM * type match check, set C for string
+00B008C4 6700 12C2 1921 BEQ LAB_PFAC * if number pack FAC1 into variable Lvarpl & RET
+00B008C8 1922
+00B008C8 1923 * string LET
+00B008C8 1924
+00B008C8 1925 LAB_17D5
+00B008C8 246B 04D6 1926 MOVEA.l Lvarpl(a3),a2 * get pointer to variable
+00B008CC 1927 LAB_17D6
+00B008CC 206B 05F4 1928 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer
+00B008D0 2250 1929 MOVEA.l (a0),a1 * get string pointer
+00B008D2 B3EB 04AA 1930 CMP.l Sstorl(a3),a1 * compare string memory start with string
+00B008D6 1931 * pointer
+00B008D6 6516 1932 BCS.s LAB_1811 * if it was in program memory assign the value
+00B008D8 1933 * and exit
+00B008D8 1934
+00B008D8 B1EB 0496 1935 CMPA.l Sfncl(a3),a0 * compare functions start with descriptor
+00B008DC 1936 * pointer
+00B008DC 6510 1937 BCS.s LAB_1811 * branch if >= (string is on stack)
+00B008DE 1938
+00B008DE 1939 * string is variable$ make space and copy string
+00B008DE 1940 LAB_1810
+00B008DE 7200 1941 MOVEQ #0,d1 * clear length
+00B008E0 3228 0004 1942 MOVE.w 4(a0),d1 * get string length
+00B008E4 2050 1943 MOVEA.l (a0),a0 * get string pointer
+00B008E6 6100 0B04 1944 BSR LAB_20C9 * copy string
+00B008EA 206B 05F4 1945 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer back
+00B008EE 1946 * clean stack & assign value to string variable
+00B008EE 1947 LAB_1811
+00B008EE B9C8 1948 CMPA.l a0,a4 * is string on the descriptor stack
+00B008F0 6602 1949 BNE.s LAB_1813 * skip pop if not
+00B008F2 1950
+00B008F2 5C4C 1951 ADDQ.w #$06,a4 * else update stack pointer
+00B008F4 1952 LAB_1813
+00B008F4 24D8 1953 MOVE.l (a0)+,(a2)+ * save pointer to variable
+00B008F6 3490 1954 MOVE.w (a0),(a2) * save length to variable
+00B008F8 1955 RTS_008
+00B008F8 4E75 1956 RTS
+00B008FA 1957
+00B008FA 1958
+00B008FA 1959 *************************************************************************************
+00B008FA 1960 *
+00B008FA 1961 * perform GET
+00B008FA 1962
+00B008FA 1963 LAB_GET
+00B008FA 6100 06B8 1964 BSR LAB_SVAR * search for or create a variable
+00B008FE 1965 * return the variable address in a0
+00B008FE 2748 04D6 1966 MOVE.l a0,Lvarpl(a3) * save variable address as GET variable
+00B00902 4A2B 0619 1967 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00906 1968 * $00=float
+00B00906 6B0C 1969 BMI.s LAB_GETS * go get string character
+00B00908 1970
+00B00908 1971 * was numeric get
+00B00908 6100 1DE4 1972 BSR INGET * get input byte
+00B0090C 6100 09BA 1973 BSR LAB_1FD0 * convert d0 to unsigned byte in FAC1
+00B00910 6000 1276 1974 BRA LAB_PFAC * pack FAC1 into variable (Lvarpl) & return
+00B00914 1975
+00B00914 1976 LAB_GETS
+00B00914 7200 1977 MOVEQ #$00,d1 * assume no byte
+00B00916 2041 1978 MOVE.l d1,a0 * assume null string
+00B00918 6100 1DD4 1979 BSR INGET * get input byte
+00B0091C 6408 1980 BCC.s LAB_NoSt * branch if no byte received
+00B0091E 1981
+00B0091E 7201 1982 MOVEQ #$01,d1 * string is single byte
+00B00920 6100 0AFC 1983 BSR LAB_2115 * make string space d1 bytes long
+00B00924 1984 * return a0 = pointer, other registers unchanged
+00B00924 1985
+00B00924 1080 1986 MOVE.b d0,(a0) * save byte in string (byte IS string!)
+00B00926 1987 LAB_NoSt
+00B00926 6100 0ADC 1988 BSR LAB_RTST * push string on descriptor stack
+00B0092A 1989 * a0 = pointer, d1 = length
+00B0092A 1990
+00B0092A 609C 1991 BRA.s LAB_17D5 * do string LET & return
+00B0092C 1992
+00B0092C 1993
+00B0092C 1994 *************************************************************************************
+00B0092C 1995 *
+00B0092C 1996 * PRINT
+00B0092C 1997
+00B0092C 1998 LAB_1829
+00B0092C 6100 00B4 1999 BSR LAB_18C6 * print string from stack
+00B00930 2000 LAB_182C
+00B00930 6100 0478 2001 BSR LAB_GBYT * scan memory
+00B00934 2002
+00B00934 2003 * perform PRINT
+00B00934 2004
+00B00934 2005 LAB_PRINT
+00B00934 674A 2006 BEQ.s LAB_CRLF * if nothing following just print CR/LF
+00B00936 2007
+00B00936 2008 LAB_1831
+00B00936 B03C 00A8 2009 CMP.b #TK_TAB,d0 * compare with TAB( token
+00B0093A 6764 2010 BEQ.s LAB_18A2 * go do TAB/SPC
+00B0093C 2011
+00B0093C B03C 00AC 2012 CMP.b #TK_SPC,d0 * compare with SPC( token
+00B00940 675E 2013 BEQ.s LAB_18A2 * go do TAB/SPC
+00B00942 2014
+00B00942 B03C 002C 2015 CMP.b #',',d0 * compare with ","
+00B00946 6740 2016 BEQ.s LAB_188B * go do move to next TAB mark
+00B00948 2017
+00B00948 B03C 003B 2018 CMP.b #';',d0 * compare with ";"
+00B0094C 6700 0086 2019 BEQ LAB_18BD * if ";" continue with PRINT processing
+00B00950 2020
+00B00950 6100 02F6 2021 BSR LAB_EVEX * evaluate expression
+00B00954 4A2B 0619 2022 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00958 2023 * $00=float
+00B00958 6BD2 2024 BMI.s LAB_1829 * branch if string
+00B0095A 2025
+00B0095A 2026 ** replace the two lines above with this code
+00B0095A 2027
+00B0095A 2028 ** MOVE.b Dtypef(a3),d0 * get data type flag, $80=string, $00=numeric
+00B0095A 2029 ** BMI.s LAB_1829 * branch if string
+00B0095A 2030
+00B0095A 6100 13AA 2031 BSR LAB_2970 * convert FAC1 to string
+00B0095E 6100 0A5E 2032 BSR LAB_20AE * print " terminated string to FAC1 stack
+00B00962 2033
+00B00962 2034 * don't check fit if terminal width byte is zero
+00B00962 2035
+00B00962 7000 2036 MOVEQ #0,d0 * clear d0
+00B00964 102B 064A 2037 MOVE.b TWidth(a3),d0 * get terminal width byte
+00B00968 670C 2038 BEQ.s LAB_185E * skip check if zero
+00B0096A 2039
+00B0096A 902C 0007 2040 SUB.b 7(a4),d0 * subtract string length
+00B0096E 902B 0649 2041 SUB.b TPos(a3),d0 * subtract terminal position
+00B00972 6402 2042 BCC.s LAB_185E * branch if less than terminal width
+00B00974 2043
+00B00974 610A 2044 BSR.s LAB_CRLF * else print CR/LF
+00B00976 2045 LAB_185E
+00B00976 616A 2046 BSR.s LAB_18C6 * print string from stack
+00B00978 60B6 2047 BRA.s LAB_182C * always go continue processing line
+00B0097A 2048
+00B0097A 2049
+00B0097A 2050 *************************************************************************************
+00B0097A 2051 *
+00B0097A 2052 * CR/LF return to BASIC from BASIC input handler
+00B0097A 2053 * leaves a0 pointing to the buffer start
+00B0097A 2054
+00B0097A 2055 LAB_1866
+00B0097A 11BC 0000 1000 2056 MOVE.b #$00,(a0,d1.w) * null terminate input
+00B00980 2057
+00B00980 2058 * print CR/LF
+00B00980 2059
+00B00980 2060 LAB_CRLF
+00B00980 700D 2061 MOVEQ #$0D,d0 * load [CR]
+00B00982 6174 2062 BSR.s LAB_PRNA * go print the character
+00B00984 700A 2063 MOVEQ #$0A,d0 * load [LF]
+00B00986 6070 2064 BRA.s LAB_PRNA * go print the character & return
+00B00988 2065
+00B00988 2066 LAB_188B
+00B00988 142B 0649 2067 MOVE.b TPos(a3),d2 * get terminal position
+00B0098C B42B 064B 2068 CMP.b Iclim(a3),d2 * compare with input column limit
+00B00990 6504 2069 BCS.s LAB_1898 * branch if less than Iclim
+00B00992 2070
+00B00992 61EC 2071 BSR.s LAB_CRLF * else print CR/LF (next line)
+00B00994 603E 2072 BRA.s LAB_18BD * continue with PRINT processing
+00B00996 2073
+00B00996 2074 LAB_1898
+00B00996 942B 0646 2075 SUB.b TabSiz(a3),d2 * subtract TAB size
+00B0099A 64FA 2076 BCC.s LAB_1898 * loop if result was >= 0
+00B0099C 2077
+00B0099C 4402 2078 NEG.b d2 * twos complement it
+00B0099E 6022 2079 BRA.s LAB_18B7 * print d2 spaces
+00B009A0 2080
+00B009A0 2081 * do TAB/SPC
+00B009A0 2082 LAB_18A2
+00B009A0 3F00 2083 MOVE.w d0,-(sp) * save token
+00B009A2 6100 0D6A 2084 BSR LAB_SGBY * increment and get byte, result in d0 and Itemp
+00B009A6 3400 2085 MOVE.w d0,d2 * copy byte
+00B009A8 6100 0400 2086 BSR LAB_GBYT * get basic byte back
+00B009AC B03C 0029 2087 CMP.b #$29,d0 * is next character ")"
+00B009B0 6600 F7B8 2088 BNE LAB_SNER * if not do syntax error, then warm start
+00B009B4 2089
+00B009B4 301F 2090 MOVE.w (sp)+,d0 * get token back
+00B009B6 B03C 00A8 2091 CMP.b #TK_TAB,d0 * was it TAB ?
+00B009BA 6606 2092 BNE.s LAB_18B7 * branch if not (was SPC)
+00B009BC 2093
+00B009BC 2094 * calculate TAB offset
+00B009BC 942B 0649 2095 SUB.b TPos(a3),d2 * subtract terminal position
+00B009C0 6312 2096 BLS.s LAB_18BD * branch if result was <= 0
+00B009C2 2097 * can't TAB backwards or already there
+00B009C2 2098
+00B009C2 2099 * print d2.b spaces
+00B009C2 2100 LAB_18B7
+00B009C2 7000 2101 MOVEQ #0,d0 * clear longword
+00B009C4 5300 2102 SUBQ.b #1,d0 * make d0 = $FF
+00B009C6 C480 2103 AND.l d0,d2 * mask for byte only
+00B009C8 670A 2104 BEQ.s LAB_18BD * branch if zero
+00B009CA 2105
+00B009CA 7020 2106 MOVEQ #$20,d0 * load " "
+00B009CC 5302 2107 SUBQ.b #1,d2 * adjust for DBF loop
+00B009CE 2108 LAB_18B8
+00B009CE 6128 2109 BSR.s LAB_PRNA * go print
+00B009D0 51CA FFFC 2110 DBF d2,LAB_18B8 * decrement count and loop if not all done
+00B009D4 2111
+00B009D4 2112 * continue with PRINT processing
+00B009D4 2113 LAB_18BD
+00B009D4 6100 03D2 2114 BSR LAB_IGBY * increment & scan memory
+00B009D8 6600 FF5C 2115 BNE LAB_1831 * if byte continue executing PRINT
+00B009DC 2116
+00B009DC 4E75 2117 RTS * exit if nothing more to print
+00B009DE 2118
+00B009DE 2119
+00B009DE 2120 *************************************************************************************
+00B009DE 2121 *
+00B009DE 2122 * print null terminated string from a0
+00B009DE 2123
+00B009DE 2124 LAB_18C3
+00B009DE 6100 09DE 2125 BSR LAB_20AE * print terminated string to FAC1/stack
+00B009E2 2126
+00B009E2 2127 * print string from stack
+00B009E2 2128
+00B009E2 2129 LAB_18C6
+00B009E2 6100 0BCE 2130 BSR LAB_22B6 * pop string off descriptor stack or from memory
+00B009E6 2131 * returns with d0 = length, a0 = pointer
+00B009E6 670C 2132 BEQ.s RTS_009 * exit (RTS) if null string
+00B009E8 2133
+00B009E8 3200 2134 MOVE.w d0,d1 * copy length & set Z flag
+00B009EA 5341 2135 SUBQ.w #1,d1 * -1 for BF loop
+00B009EC 2136 LAB_18CD
+00B009EC 1018 2137 MOVE.b (a0)+,d0 * get byte from string
+00B009EE 6108 2138 BSR.s LAB_PRNA * go print the character
+00B009F0 51C9 FFFA 2139 DBF d1,LAB_18CD * decrement count and loop if not done yet
+00B009F4 2140
+00B009F4 2141 RTS_009
+00B009F4 4E75 2142 RTS
+00B009F6 2143
+00B009F6 2144
+00B009F6 2145 *************************************************************************************
+00B009F6 2146 *
+00B009F6 2147 * print "?" character
+00B009F6 2148
+00B009F6 2149 LAB_18E3
+00B009F6 703F 2150 MOVEQ #$3F,d0 * load "?" character
+00B009F8 2151
+00B009F8 2152
+00B009F8 2153 *************************************************************************************
+00B009F8 2154 *
+00B009F8 2155 * print character in d0, includes the null handler and infinite line length code
+00B009F8 2156 * changes no registers
+00B009F8 2157
+00B009F8 2158 LAB_PRNA
+00B009F8 2F01 2159 MOVE.l d1,-(sp) * save d1
+00B009FA B03C 0020 2160 CMP.b #$20,d0 * compare with " "
+00B009FE 6528 2161 BCS.s LAB_18F9 * branch if less, non printing character
+00B00A00 2162
+00B00A00 2163 * don't check fit if terminal width byte is zero
+00B00A00 122B 064A 2164 MOVE.b TWidth(a3),d1 * get terminal width
+00B00A04 6610 2165 BNE.s LAB_18F0 * branch if not zero (not infinite length)
+00B00A06 2166
+00B00A06 2167 * is "infinite line" so check TAB position
+00B00A06 122B 0649 2168 MOVE.b TPos(a3),d1 * get position
+00B00A0A 922B 0646 2169 SUB.b TabSiz(a3),d1 * subtract TAB size
+00B00A0E 6614 2170 BNE.s LAB_18F7 * skip reset if different
+00B00A10 2171
+00B00A10 1741 0649 2172 MOVE.b d1,TPos(a3) * else reset position
+00B00A14 600E 2173 BRA.s LAB_18F7 * go print character
+00B00A16 2174
+00B00A16 2175 LAB_18F0
+00B00A16 B22B 0649 2176 CMP.b TPos(a3),d1 * compare with terminal character position
+00B00A1A 6608 2177 BNE.s LAB_18F7 * branch if not at end of line
+00B00A1C 2178
+00B00A1C 2F00 2179 MOVE.l d0,-(sp) * save d0
+00B00A1E 6100 FF60 2180 BSR LAB_CRLF * else print CR/LF
+00B00A22 201F 2181 MOVE.l (sp)+,d0 * restore d0
+00B00A24 2182 LAB_18F7
+00B00A24 522B 0649 2183 ADDQ.b #$01,TPos(a3) * increment terminal position
+00B00A28 2184 LAB_18F9
+00B00A28 4EAB 0476 2185 JSR V_OUTP(a3) * output byte via output vector
+00B00A2C B03C 000D 2186 CMP.b #$0D,d0 * compare with [CR]
+00B00A30 6618 2187 BNE.s LAB_188A * branch if not [CR]
+00B00A32 2188
+00B00A32 2189 * else print nullct nulls after the [CR]
+00B00A32 7200 2190 MOVEQ #$00,d1 * clear d1
+00B00A34 122B 0648 2191 MOVE.b Nullct(a3),d1 * get null count
+00B00A38 670C 2192 BEQ.s LAB_1886 * branch if no nulls
+00B00A3A 2193
+00B00A3A 7000 2194 MOVEQ #$00,d0 * load [NULL]
+00B00A3C 2195 LAB_1880
+00B00A3C 4EAB 0476 2196 JSR V_OUTP(a3) * go print the character
+00B00A40 51C9 FFFA 2197 DBF d1,LAB_1880 * decrement count and loop if not all done
+00B00A44 2198
+00B00A44 700D 2199 MOVEQ #$0D,d0 * restore the character
+00B00A46 2200 LAB_1886
+00B00A46 1741 0649 2201 MOVE.b d1,TPos(a3) * clear terminal position
+00B00A4A 2202 LAB_188A
+00B00A4A 221F 2203 MOVE.l (sp)+,d1 * restore d1
+00B00A4C 4E75 2204 RTS
+00B00A4E 2205
+00B00A4E 2206
+00B00A4E 2207 *************************************************************************************
+00B00A4E 2208 *
+00B00A4E 2209 * handle bad input data
+00B00A4E 2210
+00B00A4E 2211 LAB_1904
+00B00A4E 2A5F 2212 MOVEA.l (sp)+,a5 * restore execute pointer
+00B00A50 4A2B 0644 2213 TST.b Imode(a3) * test input mode flag, $00=INPUT, $98=READ
+00B00A54 6A0A 2214 BPL.s LAB_1913 * branch if INPUT (go do redo)
+00B00A56 2215
+00B00A56 276B 04C2 04B6 2216 MOVE.l Dlinel(a3),Clinel(a3) * save DATA line as current line
+00B00A5C 6000 F6E0 2217 BRA LAB_TMER * do type mismatch error, then warm start
+00B00A60 2218
+00B00A60 2219 * mode was INPUT
+00B00A60 2220 LAB_1913
+00B00A60 41FA 2A68 2221 LEA LAB_REDO(pc),a0 * point to redo message
+00B00A64 6100 FF78 2222 BSR LAB_18C3 * print null terminated string from memory
+00B00A68 2A6B 04BE 2223 MOVEA.l Cpntrl(a3),a5 * save continue pointer as BASIC execute pointer
+00B00A6C 4E75 2224 RTS
+00B00A6E 2225
+00B00A6E 2226
+00B00A6E 2227 *************************************************************************************
+00B00A6E 2228 *
+00B00A6E 2229 * perform INPUT
+00B00A6E 2230
+00B00A6E 2231 LAB_INPUT
+00B00A6E 6100 0860 2232 BSR LAB_CKRN * check not direct (back here if ok)
+00B00A72 B03C 0022 2233 CMP.b #'"',d0 * compare the next byte with open quote
+00B00A76 660E 2234 BNE.s LAB_1934 * if no prompt string just go get the input
+00B00A78 2235
+00B00A78 6100 0306 2236 BSR LAB_1BC1 * print "..." string
+00B00A7C 703B 2237 MOVEQ #';',d0 * set the search character to ";"
+00B00A7E 6100 0320 2238 BSR LAB_SCCA * scan for CHR$(d0), else do syntax error/warm
+00B00A82 2239 * start
+00B00A82 6100 FF5E 2240 BSR LAB_18C6 * print string from Sutill/Sutilh
+00B00A86 2241 * finished the prompt, now read the data
+00B00A86 2242 LAB_1934
+00B00A86 6100 F80C 2243 BSR LAB_INLN * print "? " and get BASIC input
+00B00A8A 2244 * return a0 pointing to the buffer start
+00B00A8A 7000 2245 MOVEQ #0,d0 * flag INPUT
+00B00A8C 2246
+00B00A8C 2247 * if you don't want a null response to INPUT to break the program then set the nobrk
+00B00A8C 2248 * value at the top of this file to some non zero value
+00B00A8C 2249
+00B00A8C FALSE 2250 ifne nobrk
+00B00A8C 2251 endc
+00B00A8C 2252
+00B00A8C 2253 * if you do want a null response to INPUT to break the program then leave the nobrk
+00B00A8C 2254 * value at the top of this file set to zero
+00B00A8C 2255
+00B00A8C TRUE 2256 ifeq nobrk
+00B00A8C 2257
+00B00A8C 4A10 2258 TST.b (a0) * test first byte from buffer
+00B00A8E 660A 2259 BNE.s LAB_1953 * branch if not null input
+00B00A90 2260
+00B00A90 6000 FB5E 2261 BRA LAB_1647 * go do BREAK exit
+00B00A94 2262
+00B00A94 2263 endc
+00B00A94 2264
+00B00A94 2265
+00B00A94 2266 *************************************************************************************
+00B00A94 2267 *
+00B00A94 2268 * perform READ
+00B00A94 2269
+00B00A94 2270 LAB_READ
+00B00A94 206B 04C6 2271 MOVEA.l Dptrl(a3),a0 * get the DATA pointer
+00B00A98 7098 2272 MOVEQ #$98-$100,d0 * flag READ
+00B00A9A 2273 LAB_1953
+00B00A9A 1740 0644 2274 MOVE.b d0,Imode(a3) * set input mode flag, $00=INPUT, $98=READ
+00B00A9E 2748 04CA 2275 MOVE.l a0,Rdptrl(a3) * save READ pointer
+00B00AA2 2276
+00B00AA2 2277 * READ or INPUT the next variable from list
+00B00AA2 2278 LAB_195B
+00B00AA2 6100 0510 2279 BSR LAB_SVAR * search for or create a variable
+00B00AA6 2280 * return the variable address in a0
+00B00AA6 2748 04D6 2281 MOVE.l a0,Lvarpl(a3) * save variable address as LET variable
+00B00AAA 2F0D 2282 MOVE.l a5,-(sp) * save BASIC execute pointer
+00B00AAC 2283 LAB_1961
+00B00AAC 2A6B 04CA 2284 MOVEA.l Rdptrl(a3),a5 * set READ pointer as BASIC execute pointer
+00B00AB0 6100 02F8 2285 BSR LAB_GBYT * scan memory
+00B00AB4 661E 2286 BNE.s LAB_1986 * if not null go get the value
+00B00AB6 2287
+00B00AB6 2288 * the pointer was to a null entry
+00B00AB6 4A2B 0644 2289 TST.b Imode(a3) * test input mode flag, $00=INPUT, $98=READ
+00B00ABA 6B72 2290 BMI.s LAB_19DD * branch if READ (go find the next statement)
+00B00ABC 2291
+00B00ABC 2292 * else the mode was INPUT so get more
+00B00ABC 6100 FF38 2293 BSR LAB_18E3 * print a "?" character
+00B00AC0 6100 F7D2 2294 BSR LAB_INLN * print "? " and get BASIC input
+00B00AC4 2295 * return a0 pointing to the buffer start
+00B00AC4 2296
+00B00AC4 2297 * if you don't want a null response to INPUT to break the program then set the nobrk
+00B00AC4 2298 * value at the top of this file to some non zero value
+00B00AC4 2299
+00B00AC4 FALSE 2300 ifne nobrk
+00B00AC4 2301 endc
+00B00AC4 2302
+00B00AC4 2303 * if you do want a null response to INPUT to break the program then leave the nobrk
+00B00AC4 2304 * value at the top of this file set to zero
+00B00AC4 2305
+00B00AC4 TRUE 2306 ifeq nobrk
+00B00AC4 2307
+00B00AC4 4A10 2308 TST.b (a0) * test the first byte from the buffer
+00B00AC6 6604 2309 BNE.s LAB_1984 * if not null input go handle it
+00B00AC8 2310
+00B00AC8 6000 FB26 2311 BRA LAB_1647 * else go do the BREAK exit
+00B00ACC 2312
+00B00ACC 2313 LAB_1984
+00B00ACC 2A48 2314 MOVEA.l a0,a5 * set the execute pointer to the buffer
+00B00ACE 534D 2315 SUBQ.w #1,a5 * decrement the execute pointer
+00B00AD0 2316
+00B00AD0 2317 endc
+00B00AD0 2318
+00B00AD0 2319 LAB_1985
+00B00AD0 6100 02D6 2320 BSR LAB_IGBY * increment & scan memory
+00B00AD4 2321 LAB_1986
+00B00AD4 4A2B 0619 2322 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00AD8 2323 * $00=float
+00B00AD8 6A20 2324 BPL.s LAB_19B0 * branch if numeric
+00B00ADA 2325
+00B00ADA 2326 * else get string
+00B00ADA 1400 2327 MOVE.b d0,d2 * save search character
+00B00ADC B03C 0022 2328 CMP.b #$22,d0 * was it " ?
+00B00AE0 6706 2329 BEQ.s LAB_1999 * branch if so
+00B00AE2 2330
+00B00AE2 743A 2331 MOVEQ #':',d2 * set new search character
+00B00AE4 702C 2332 MOVEQ #',',d0 * other search character is ","
+00B00AE6 534D 2333 SUBQ.w #1,a5 * decrement BASIC execute pointer
+00B00AE8 2334 LAB_1999
+00B00AE8 524D 2335 ADDQ.w #1,a5 * increment BASIC execute pointer
+00B00AEA 1600 2336 MOVE.b d0,d3 * set second search character
+00B00AEC 204D 2337 MOVEA.l a5,a0 * BASIC execute pointer is source
+00B00AEE 2338
+00B00AEE 6100 08D2 2339 BSR LAB_20B4 * print d2/d3 terminated string to FAC1 stack
+00B00AF2 2340 * d2 = Srchc, d3 = Asrch, a0 is source
+00B00AF2 2A4A 2341 MOVEA.l a2,a5 * copy end of string to BASIC execute pointer
+00B00AF4 6100 FDD2 2342 BSR LAB_17D5 * go do string LET
+00B00AF8 6010 2343 BRA.s LAB_19B6 * go check string terminator
+00B00AFA 2344
+00B00AFA 2345 * get numeric INPUT
+00B00AFA 2346 LAB_19B0
+00B00AFA 1F2B 0619 2347 MOVE.b Dtypef(a3),-(sp) * save variable data type
+00B00AFE 6100 1D98 2348 BSR LAB_2887 * get FAC1 from string
+00B00B02 175F 0619 2349 MOVE.b (sp)+,Dtypef(a3) * restore variable data type
+00B00B06 6100 1080 2350 BSR LAB_PFAC * pack FAC1 into (Lvarpl)
+00B00B0A 2351 LAB_19B6
+00B00B0A 6100 029E 2352 BSR LAB_GBYT * scan memory
+00B00B0E 670A 2353 BEQ.s LAB_19C2 * branch if null (last entry)
+00B00B10 2354
+00B00B10 B03C 002C 2355 CMP.b #',',d0 * else compare with ","
+00B00B14 6600 FF38 2356 BNE LAB_1904 * if not "," go handle bad input data
+00B00B18 2357
+00B00B18 524D 2358 ADDQ.w #1,a5 * else was "," so point to next chr
+00B00B1A 2359 * got good input data
+00B00B1A 2360 LAB_19C2
+00B00B1A 274D 04CA 2361 MOVE.l a5,Rdptrl(a3) * save the read pointer for now
+00B00B1E 2A5F 2362 MOVEA.l (sp)+,a5 * restore the execute pointer
+00B00B20 6100 0288 2363 BSR LAB_GBYT * scan the memory
+00B00B24 6736 2364 BEQ.s LAB_1A03 * if null go do extra ignored message
+00B00B26 2365
+00B00B26 487A FF7A 2366 PEA LAB_195B(pc) * set return address
+00B00B2A 6000 0272 2367 BRA LAB_1C01 * scan for "," else do syntax error/warm start
+00B00B2E 2368 * then go INPUT next variable from list
+00B00B2E 2369
+00B00B2E 2370 * find next DATA statement or do "Out of Data"
+00B00B2E 2371 * error
+00B00B2E 2372 LAB_19DD
+00B00B2E 6100 FC04 2373 BSR LAB_SNBS * scan for next BASIC statement ([:] or [EOL])
+00B00B32 2374 * returns a0 as pointer to [:] or [EOL]
+00B00B32 2A48 2375 MOVEA.l a0,a5 * add index, now = pointer to [EOL]/[EOS]
+00B00B34 524D 2376 ADDQ.w #1,a5 * pointer to next character
+00B00B36 B03C 003A 2377 CMP.b #':',d0 * was it statement end?
+00B00B3A 6712 2378 BEQ.s LAB_19F6 * branch if [:]
+00B00B3C 2379
+00B00B3C 2380 * was [EOL] so find next line
+00B00B3C 2381
+00B00B3C 320D 2382 MOVE.w a5,d1 * past pad byte(s)
+00B00B3E C27C 0001 2383 AND.w #1,d1 * mask odd bit
+00B00B42 DAC1 2384 ADD.w d1,a5 * add pointer
+00B00B44 241D 2385 MOVE.l (a5)+,d2 * get next line pointer
+00B00B46 6700 F61A 2386 BEQ LAB_ODER * branch if end of program
+00B00B4A 2387
+00B00B4A 275D 04C2 2388 MOVE.l (a5)+,Dlinel(a3) * save current DATA line
+00B00B4E 2389 LAB_19F6
+00B00B4E 6100 025A 2390 BSR LAB_GBYT * scan memory
+00B00B52 B03C 0083 2391 CMP.b #TK_DATA,d0 * compare with "DATA" token
+00B00B56 6700 FF78 2392 BEQ LAB_1985 * was "DATA" so go do next READ
+00B00B5A 2393
+00B00B5A 60D2 2394 BRA.s LAB_19DD * go find next statement if not "DATA"
+00B00B5C 2395
+00B00B5C 2396 * end of INPUT/READ routine
+00B00B5C 2397
+00B00B5C 2398 LAB_1A03
+00B00B5C 206B 04CA 2399 MOVEA.l Rdptrl(a3),a0 * get temp READ pointer
+00B00B60 4A2B 0644 2400 TST.b Imode(a3) * get input mode flag, $00=INPUT, $98=READ
+00B00B64 6A06 2401 BPL.s LAB_1A0E * branch if INPUT
+00B00B66 2402
+00B00B66 2748 04C6 2403 MOVE.l a0,Dptrl(a3) * else save temp READ pointer as DATA pointer
+00B00B6A 4E75 2404 RTS
+00B00B6C 2405
+00B00B6C 2406 * we were getting INPUT
+00B00B6C 2407 LAB_1A0E
+00B00B6C 4A10 2408 TST.b (a0) * test next byte
+00B00B6E 6602 2409 BNE.s LAB_1A1B * error if not end of INPUT
+00B00B70 2410
+00B00B70 4E75 2411 RTS
+00B00B72 2412 * user typed too much
+00B00B72 2413 LAB_1A1B
+00B00B72 41FA 2946 2414 LEA LAB_IMSG(pc),a0 * point to extra ignored message
+00B00B76 6000 FE66 2415 BRA LAB_18C3 * print null terminated string from memory & RTS
+00B00B7A 2416
+00B00B7A 2417
+00B00B7A 2418 *************************************************************************************
+00B00B7A 2419 *
+00B00B7A 2420 * perform NEXT
+00B00B7A 2421
+00B00B7A 2422 LAB_NEXT
+00B00B7A 6610 2423 BNE.s LAB_1A46 * branch if NEXT var
+00B00B7C 2424
+00B00B7C 584F 2425 ADDQ.w #4,sp * back past return address
+00B00B7E 0C57 0081 2426 CMP.w #TK_FOR,(sp) * is FOR token on stack?
+00B00B82 6600 F5EA 2427 BNE LAB_NFER * if not do NEXT without FOR err/warm start
+00B00B86 2428
+00B00B86 206F 0002 2429 MOVEA.l 2(sp),a0 * get stacked FOR variable pointer
+00B00B8A 601C 2430 BRA.s LAB_11BD * branch always (no variable to search for)
+00B00B8C 2431
+00B00B8C 2432 * NEXT var
+00B00B8C 2433
+00B00B8C 2434 LAB_1A46
+00B00B8C 6100 042A 2435 BSR LAB_GVAR * get variable address in a0
+00B00B90 584F 2436 ADDQ.w #4,sp * back past return address
+00B00B92 303C 0081 2437 MOVE.w #TK_FOR,d0 * set for FOR token
+00B00B96 721C 2438 MOVEQ #$1C,d1 * set for FOR use size
+00B00B98 6002 2439 BRA.s LAB_11A6 * enter loop for next variable search
+00B00B9A 2440
+00B00B9A 2441 LAB_11A5
+00B00B9A DFC1 2442 ADDA.l d1,sp * add FOR stack use size
+00B00B9C 2443 LAB_11A6
+00B00B9C B057 2444 CMP.w (sp),d0 * is FOR token on stack?
+00B00B9E 6600 F5CE 2445 BNE LAB_NFER * if not found do NEXT without FOR error and
+00B00BA2 2446 * warm start
+00B00BA2 2447
+00B00BA2 2448 * was FOR token
+00B00BA2 B1EF 0002 2449 CMPA.l 2(sp),a0 * compare var pointer with stacked var pointer
+00B00BA6 66F2 2450 BNE.s LAB_11A5 * loop if no match found
+00B00BA8 2451
+00B00BA8 2452 LAB_11BD
+00B00BA8 376F 0006 0600 2453 MOVE.w 6(sp),FAC2_e(a3) * get STEP value exponent and sign
+00B00BAE 276F 0008 05FC 2454 MOVE.l 8(sp),FAC2_m(a3) * get STEP value mantissa
+00B00BB4 2455
+00B00BB4 176F 0012 0619 2456 MOVE.b 18(sp),Dtypef(a3) * restore FOR variable data type
+00B00BBA 6100 021C 2457 BSR LAB_1C19 * check type and unpack (a0)
+00B00BBE 2458
+00B00BBE 176B 0601 0602 2459 MOVE.b FAC2_s(a3),FAC_sc(a3) * save FAC2 sign as sign compare
+00B00BC4 102B 05F9 2460 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
+00B00BC8 B12B 0602 2461 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
+00B00BCC 2462
+00B00BCC 2748 04D6 2463 MOVE.l a0,Lvarpl(a3) * save variable pointer
+00B00BD0 6100 0CB6 2464 BSR LAB_ADD * add STEP value to FOR variable
+00B00BD4 176F 0012 0619 2465 MOVE.b 18(sp),Dtypef(a3) * restore FOR variable data type (again)
+00B00BDA 6100 0FAC 2466 BSR LAB_PFAC * pack FAC1 into FOR variable (Lvarpl)
+00B00BDE 2467
+00B00BDE 376F 000C 0600 2468 MOVE.w 12(sp),FAC2_e(a3) * get TO value exponent and sign
+00B00BE4 276F 000E 05FC 2469 MOVE.l 14(sp),FAC2_m(a3) * get TO value mantissa
+00B00BEA 2470
+00B00BEA 176B 0601 0602 2471 MOVE.b FAC2_s(a3),FAC_sc(a3) * save FAC2 sign as sign compare
+00B00BF0 102B 05F9 2472 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
+00B00BF4 B12B 0602 2473 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
+00B00BF8 2474
+00B00BF8 6100 1038 2475 BSR LAB_27FA * compare FAC1 with FAC2 (TO value)
+00B00BFC 2476 * returns d0=+1 if FAC1 > FAC2
+00B00BFC 2477 * returns d0= 0 if FAC1 = FAC2
+00B00BFC 2478 * returns d0=-1 if FAC1 < FAC2
+00B00BFC 2479
+00B00BFC 322F 0006 2480 MOVE.w 6(sp),d1 * get STEP value exponent and sign
+00B00C00 B141 2481 EOR.w d0,d1 * EOR compare result with STEP exponent and sign
+00B00C02 2482
+00B00C02 4A00 2483 TST.b d0 * test for =
+00B00C04 6704 2484 BEQ.s LAB_1A90 * branch if = (loop INcomplete)
+00B00C06 2485
+00B00C06 4A01 2486 TST.b d1 * test result
+00B00C08 6A0E 2487 BPL.s LAB_1A9B * branch if > (loop complete)
+00B00C0A 2488
+00B00C0A 2489 * loop back and do it all again
+00B00C0A 2490 LAB_1A90
+00B00C0A 276F 0014 04B6 2491 MOVE.l 20(sp),Clinel(a3) * reset current line
+00B00C10 2A6F 0018 2492 MOVE.l 24(sp),a5 * reset BASIC execute pointer
+00B00C14 6000 F976 2493 BRA LAB_15C2 * go do interpreter inner loop
+00B00C18 2494
+00B00C18 2495 * loop complete so carry on
+00B00C18 2496 LAB_1A9B
+00B00C18 DEFC 001C 2497 ADDA.w #28,sp * add 28 to dump FOR structure
+00B00C1C 6100 018C 2498 BSR LAB_GBYT * scan memory
+00B00C20 B03C 002C 2499 CMP.b #$2C,d0 * compare with ","
+00B00C24 6600 F966 2500 BNE LAB_15C2 * if not "," go do interpreter inner loop
+00B00C28 2501
+00B00C28 2502 * was "," so another NEXT variable to do
+00B00C28 6100 017E 2503 BSR LAB_IGBY * else increment & scan memory
+00B00C2C 6100 FF5E 2504 BSR LAB_1A46 * do NEXT (var)
+00B00C30 2505
+00B00C30 2506
+00B00C30 2507 *************************************************************************************
+00B00C30 2508 *
+00B00C30 2509 * evaluate expression & check is numeric, else do type mismatch
+00B00C30 2510
+00B00C30 2511 LAB_EVNM
+00B00C30 6116 2512 BSR.s LAB_EVEX * evaluate expression
+00B00C32 2513
+00B00C32 2514
+00B00C32 2515 *************************************************************************************
+00B00C32 2516 *
+00B00C32 2517 * check if source is numeric, else do type mismatch
+00B00C32 2518
+00B00C32 2519 LAB_CTNM
+00B00C32 B040 2520 CMP.w d0,d0 * required type is numeric so clear carry
+00B00C34 2521
+00B00C34 2522
+00B00C34 2523 *************************************************************************************
+00B00C34 2524 *
+00B00C34 2525 * type match check, set C for string, clear C for numeric
+00B00C34 2526
+00B00C34 2527 LAB_CKTM
+00B00C34 082B 0007 0619 2528 BTST.b #7,Dtypef(a3) * test data type flag, don't change carry
+00B00C3A 6606 2529 BNE.s LAB_1ABA * branch if data type is string
+00B00C3C 2530
+00B00C3C 2531 * else data type was numeric
+00B00C3C 6500 F500 2532 BCS LAB_TMER * if required type is string do type mismatch
+00B00C40 2533 * error
+00B00C40 2534
+00B00C40 4E75 2535 RTS
+00B00C42 2536 * data type was string, now check required type
+00B00C42 2537 LAB_1ABA
+00B00C42 6400 F4FA 2538 BCC LAB_TMER * if required type is numeric do type mismatch
+00B00C46 2539 * error
+00B00C46 4E75 2540 RTS
+00B00C48 2541
+00B00C48 2542
+00B00C48 2543 *************************************************************************************
+00B00C48 2544 *
+00B00C48 2545 * this routine evaluates any type of expression. first it pushes an end marker so
+00B00C48 2546 * it knows when the expression has been evaluated, this is a precedence value of zero.
+00B00C48 2547 * next the first value is evaluated, this can be an in line value, either numeric or
+00B00C48 2548 * string, a variable or array element of any type, a function or even an expression
+00B00C48 2549 * in parenthesis. this value is kept in FAC_1
+00B00C48 2550 * after the value is evaluated a test is made on the next BASIC program byte, if it
+00B00C48 2551 * is a comparrison operator i.e. "<", "=" or ">", then the corresponding bit is set
+00B00C48 2552 * in the comparison evaluation flag. this test loops until no more comparrison operators
+00B00C48 2553 * are found or more than one of any type is found. in the last case an error is generated
+00B00C48 2554
+00B00C48 2555 * evaluate expression
+00B00C48 2556
+00B00C48 2557 LAB_EVEX
+00B00C48 534D 2558 SUBQ.w #1,a5 * decrement BASIC execute pointer
+00B00C4A 2559 LAB_EVEZ
+00B00C4A 7200 2560 MOVEQ #0,d1 * clear precedence word
+00B00C4C 1741 0619 2561 MOVE.b d1,Dtypef(a3) * clear the data type, $80=string, $40=integer,
+00B00C50 2562 * $00=float
+00B00C50 601C 2563 BRA.s LAB_1ACD * enter loop
+00B00C52 2564
+00B00C52 2565 * get vector, set up operator then continue evaluation
+00B00C52 2566
+00B00C52 2567 LAB_1B43 *
+00B00C52 41FA 22BC 2568 LEA LAB_OPPT(pc),a0 * point to operator vector table
+00B00C56 3030 1002 2569 MOVE.w 2(a0,d1.w),d0 * get vector offset
+00B00C5A 4870 0000 2570 PEA (a0,d0.w) * push vector
+00B00C5E 2571
+00B00C5E 2F2B 05F4 2572 MOVE.l FAC1_m(a3),-(sp) * push FAC1 mantissa
+00B00C62 3F2B 05F8 2573 MOVE.w FAC1_e(a3),-(sp) * push sign and exponent
+00B00C66 1F2B 0647 2574 MOVE.b comp_f(a3),-(sp) * push comparison evaluation flag
+00B00C6A 2575
+00B00C6A 3230 1000 2576 MOVE.w (a0,d1.w),d1 * get precedence value
+00B00C6E 2577 LAB_1ACD
+00B00C6E 3F01 2578 MOVE.w d1,-(sp) * push precedence value
+00B00C70 6100 00E4 2579 BSR LAB_GVAL * get value from line
+00B00C74 177C 0000 0647 2580 MOVE.b #$00,comp_f(a3) * clear compare function flag
+00B00C7A 2581 LAB_1ADB
+00B00C7A 6100 012E 2582 BSR LAB_GBYT * scan memory
+00B00C7E 2583 LAB_1ADE
+00B00C7E 0400 00BC 2584 SUB.b #TK_GT,d0 * subtract token for > (lowest compare function)
+00B00C82 652A 2585 BCS.s LAB_1AFA * branch if < TK_GT
+00B00C84 2586
+00B00C84 B03C 0003 2587 CMP.b #$03,d0 * compare with ">" to "<" tokens
+00B00C88 650A 2588 BCS.s LAB_1AE0 * branch if <= TK_SGN (is compare function)
+00B00C8A 2589
+00B00C8A 4A2B 0647 2590 TST.b comp_f(a3) * test compare function flag
+00B00C8E 6660 2591 BNE.s LAB_1B2A * branch if compare function
+00B00C90 2592
+00B00C90 6000 0086 2593 BRA LAB_1B78 * go do functions
+00B00C94 2594
+00B00C94 2595 * was token for > = or < (d0 = 0, 1 or 2)
+00B00C94 2596 LAB_1AE0
+00B00C94 7201 2597 MOVEQ #1,d1 * set to 0000 0001
+00B00C96 E121 2598 ASL.b d0,d1 * 1 if >, 2 if =, 4 if <
+00B00C98 102B 0647 2599 MOVE.b comp_f(a3),d0 * copy old compare function flag
+00B00C9C B32B 0647 2600 EOR.b d1,comp_f(a3) * EOR in this compare function bit
+00B00CA0 B02B 0647 2601 CMP.b comp_f(a3),d0 * compare old with new compare function flag
+00B00CA4 6400 F4C4 2602 BCC LAB_SNER * if new <= old comp_f do syntax error and warm
+00B00CA8 2603 * start, there was more than one <, = or >
+00B00CA8 6100 00FE 2604 BSR LAB_IGBY * increment & scan memory
+00B00CAC 60D0 2605 BRA.s LAB_1ADE * go do next character
+00B00CAE 2606
+00B00CAE 2607 * token is < ">" or > "<" tokens
+00B00CAE 2608 LAB_1AFA
+00B00CAE 4A2B 0647 2609 TST.b comp_f(a3) * test compare function flag
+00B00CB2 663C 2610 BNE.s LAB_1B2A * branch if compare function
+00B00CB4 2611
+00B00CB4 2612 * was < TK_GT so is operator or lower
+00B00CB4 0600 000A 2613 ADD.b #(TK_GT-TK_PLUS),d0 * add # of operators (+ - * / ^ AND OR EOR)
+00B00CB8 645E 2614 BCC.s LAB_1B78 * branch if < + operator
+00B00CBA 2615
+00B00CBA 6608 2616 BNE.s LAB_1B0B * branch if not + token
+00B00CBC 2617
+00B00CBC 4A2B 0619 2618 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00CC0 2619 * $00=float
+00B00CC0 6B00 087C 2620 BMI LAB_224D * type is string & token was +
+00B00CC4 2621
+00B00CC4 2622 LAB_1B0B
+00B00CC4 7200 2623 MOVEQ #0,d1 * clear longword
+00B00CC6 D000 2624 ADD.b d0,d0 * *2
+00B00CC8 D000 2625 ADD.b d0,d0 * *4
+00B00CCA 1200 2626 MOVE.b d0,d1 * copy to index
+00B00CCC 2627 LAB_1B13
+00B00CCC 301F 2628 MOVE.w (sp)+,d0 * pull previous precedence
+00B00CCE 41FA 2240 2629 LEA LAB_OPPT(pc),a0 * set pointer to operator table
+00B00CD2 B070 1000 2630 CMP.w (a0,d1.w),d0 * compare with this opperator precedence
+00B00CD6 6446 2631 BCC.s LAB_1B7D * branch if previous precedence (d0) >=
+00B00CD8 2632
+00B00CD8 6100 FF58 2633 BSR LAB_CTNM * check if source is numeric, else type mismatch
+00B00CDC 2634 LAB_1B1C
+00B00CDC 3F00 2635 MOVE.w d0,-(sp) * save precedence
+00B00CDE 2636 LAB_1B1D
+00B00CDE 6100 FF72 2637 BSR LAB_1B43 * get vector, set-up operator and continue
+00B00CE2 2638 * evaluation
+00B00CE2 301F 2639 MOVE.w (sp)+,d0 * restore precedence
+00B00CE4 222B 063C 2640 MOVE.l prstk(a3),d1 * get stacked function pointer
+00B00CE8 6A22 2641 BPL.s LAB_1B3C * branch if stacked values
+00B00CEA 2642
+00B00CEA 3000 2643 MOVE.w d0,d0 * copy precedence (set flags)
+00B00CEC 672E 2644 BEQ.s LAB_1B7B * exit if done
+00B00CEE 2645
+00B00CEE 603C 2646 BRA.s LAB_1B86 * else pop FAC2 & return (do function)
+00B00CF0 2647
+00B00CF0 2648 * was compare function (< = >)
+00B00CF0 2649 LAB_1B2A
+00B00CF0 102B 0619 2650 MOVE.b Dtypef(a3),d0 * get data type flag
+00B00CF4 122B 0647 2651 MOVE.b comp_f(a3),d1 * get compare function flag
+00B00CF8 D000 2652 ADD.b d0,d0 * string bit flag into X bit
+00B00CFA D301 2653 ADDX.b d1,d1 * shift compare function flag
+00B00CFC 2654
+00B00CFC 177C 0000 0619 2655 MOVE.b #0,Dtypef(a3) * clear data type flag, $00=float
+00B00D02 1741 0647 2656 MOVE.b d1,comp_f(a3) * save new compare function flag
+00B00D06 534D 2657 SUBQ.w #1,a5 * decrement BASIC execute pointer
+00B00D08 7230 2658 MOVEQ #(TK_LT-TK_PLUS)*4,d1 * set offset to last operator entry
+00B00D0A 60C0 2659 BRA.s LAB_1B13 * branch always
+00B00D0C 2660
+00B00D0C 2661 LAB_1B3C
+00B00D0C 41FA 2202 2662 LEA LAB_OPPT(pc),a0 * point to function vector table
+00B00D10 B070 1000 2663 CMP.w (a0,d1.w),d0 * compare with this opperator precedence
+00B00D14 6416 2664 BCC.s LAB_1B86 * branch if d0 >=, pop FAC2 & return
+00B00D16 2665
+00B00D16 60C4 2666 BRA.s LAB_1B1C * branch always
+00B00D18 2667
+00B00D18 2668 * do functions
+00B00D18 2669
+00B00D18 2670 LAB_1B78
+00B00D18 72FF 2671 MOVEQ #-1,d1 * flag all done
+00B00D1A 301F 2672 MOVE.w (sp)+,d0 * pull precedence word
+00B00D1C 2673 LAB_1B7B
+00B00D1C 6732 2674 BEQ.s LAB_1B9D * exit if done
+00B00D1E 2675
+00B00D1E 2676 LAB_1B7D
+00B00D1E B07C 0064 2677 CMP.w #$64,d0 * compare previous precedence with $64
+00B00D22 6704 2678 BEQ.s LAB_1B84 * branch if was $64 (< function can be string)
+00B00D24 2679
+00B00D24 6100 FF0C 2680 BSR LAB_CTNM * check if source is numeric, else type mismatch
+00B00D28 2681 LAB_1B84
+00B00D28 2741 063C 2682 MOVE.l d1,prstk(a3) * save current operator index
+00B00D2C 2683
+00B00D2C 2684 * pop FAC2 & return
+00B00D2C 2685 LAB_1B86
+00B00D2C 101F 2686 MOVE.b (sp)+,d0 * pop comparison evaluation flag
+00B00D2E 1200 2687 MOVE.b d0,d1 * copy comparison evaluation flag
+00B00D30 E208 2688 LSR.b #1,d0 * shift out comparison evaluation lowest bit
+00B00D32 1740 0645 2689 MOVE.b d0,Cflag(a3) * save comparison evaluation flag
+00B00D36 375F 0600 2690 MOVE.w (sp)+,FAC2_e(a3) * pop exponent and sign
+00B00D3A 275F 05FC 2691 MOVE.l (sp)+,FAC2_m(a3) * pop mantissa
+00B00D3E 176B 0601 0602 2692 MOVE.b FAC2_s(a3),FAC_sc(a3) * copy FAC2 sign
+00B00D44 102B 05F9 2693 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
+00B00D48 B12B 0602 2694 EOR.b d0,FAC_sc(a3) * EOR FAC1 sign and set sign compare
+00B00D4C 2695
+00B00D4C E209 2696 LSR.b #1,d1 * type bit into X and C
+00B00D4E 4E75 2697 RTS
+00B00D50 2698
+00B00D50 2699 LAB_1B9D
+00B00D50 102B 05F8 2700 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
+00B00D54 4E75 2701 RTS
+00B00D56 2702
+00B00D56 2703
+00B00D56 2704 *************************************************************************************
+00B00D56 2705 *
+00B00D56 2706 * get a value from the BASIC line
+00B00D56 2707
+00B00D56 2708 LAB_GVAL
+00B00D56 6150 2709 BSR.s LAB_IGBY * increment & scan memory
+00B00D58 6500 1B3E 2710 BCS LAB_2887 * if numeric get FAC1 from string & return
+00B00D5C 2711
+00B00D5C 4A00 2712 TST.b d0 * test byte
+00B00D5E 6B00 008E 2713 BMI LAB_1BD0 * if -ve go test token values
+00B00D62 2714
+00B00D62 2715 * else it is either a string, number, variable
+00B00D62 2716 * or ()
+00B00D62 B03C 0024 2717 CMP.b #'$',d0 * compare with "$"
+00B00D66 6700 1B30 2718 BEQ LAB_2887 * if "$" get hex number from string & return
+00B00D6A 2719
+00B00D6A B03C 0025 2720 CMP.b #'%',d0 * else compare with "%"
+00B00D6E 6700 1B28 2721 BEQ LAB_2887 * if "%" get binary number from string & return
+00B00D72 2722
+00B00D72 B03C 002E 2723 CMP.b #$2E,d0 * compare with "."
+00B00D76 6700 1B20 2724 BEQ LAB_2887 * if so get FAC1 from string and return
+00B00D7A 2725 * (e.g. .123)
+00B00D7A 2726
+00B00D7A 2727 * wasn't a number so ...
+00B00D7A B03C 0022 2728 CMP.b #$22,d0 * compare with "
+00B00D7E 660C 2729 BNE.s LAB_1BF3 * if not open quote it must be a variable or
+00B00D80 2730 * open bracket
+00B00D80 2731
+00B00D80 2732 * was open quote so get the enclosed string
+00B00D80 2733
+00B00D80 2734 * print "..." string to string stack
+00B00D80 2735
+00B00D80 2736 LAB_1BC1
+00B00D80 101D 2737 MOVE.b (a5)+,d0 * increment BASIC execute pointer (past ")
+00B00D82 2738 * fastest/shortest method
+00B00D82 204D 2739 MOVEA.l a5,a0 * copy basic execute pointer (string start)
+00B00D84 6100 0638 2740 BSR LAB_20AE * print " terminated string to stack
+00B00D88 2A4A 2741 MOVEA.l a2,a5 * restore BASIC execute pointer from temp
+00B00D8A 4E75 2742 RTS
+00B00D8C 2743
+00B00D8C 2744 * get value from line .. continued
+00B00D8C 2745 * wasn't any sort of number so ...
+00B00D8C 2746 LAB_1BF3
+00B00D8C B03C 0028 2747 CMP.b #'(',d0 * compare with "("
+00B00D90 6642 2748 BNE.s LAB_1C18 * if not "(" get (var) and return value in FAC1
+00B00D92 2749 * and $ flag
+00B00D92 2750
+00B00D92 2751
+00B00D92 2752 *************************************************************************************
+00B00D92 2753 *
+00B00D92 2754 * evaluate expression within parentheses
+00B00D92 2755
+00B00D92 2756 LAB_1BF7
+00B00D92 6100 FEB6 2757 BSR LAB_EVEZ * evaluate expression (no decrement)
+00B00D96 2758
+00B00D96 2759
+00B00D96 2760 *************************************************************************************
+00B00D96 2761 *
+00B00D96 2762 * all the 'scan for' routines return the character after the sought character
+00B00D96 2763
+00B00D96 2764 * scan for ")", else do syntax error, then warm start
+00B00D96 2765
+00B00D96 2766 LAB_1BFB
+00B00D96 7029 2767 MOVEQ #$29,d0 * load d0 with ")"
+00B00D98 6006 2768 BRA.s LAB_SCCA
+00B00D9A 2769
+00B00D9A 2770
+00B00D9A 2771 *************************************************************************************
+00B00D9A 2772 *
+00B00D9A 2773 * scan for "," and get byte, else do Syntax error then warm start
+00B00D9A 2774
+00B00D9A 2775 LAB_SCGB
+00B00D9A 487A 0976 2776 PEA LAB_GTBY(pc) * return address is to get byte parameter
+00B00D9E 2777
+00B00D9E 2778
+00B00D9E 2779 *************************************************************************************
+00B00D9E 2780 *
+00B00D9E 2781 * scan for ",", else do syntax error, then warm start
+00B00D9E 2782
+00B00D9E 2783 LAB_1C01
+00B00D9E 702C 2784 MOVEQ #$2C,d0 * load d0 with ","
+00B00DA0 2785
+00B00DA0 2786
+00B00DA0 2787 *************************************************************************************
+00B00DA0 2788 *
+00B00DA0 2789 * scan for CHR$(d0) , else do syntax error, then warm start
+00B00DA0 2790
+00B00DA0 2791 LAB_SCCA
+00B00DA0 B01D 2792 CMP.b (a5)+,d0 * check next byte is = d0
+00B00DA2 6706 2793 BEQ.s LAB_GBYT * if so go get next
+00B00DA4 2794
+00B00DA4 6000 F3C4 2795 BRA LAB_SNER * else do syntax error/warm start
+00B00DA8 2796
+00B00DA8 2797
+00B00DA8 2798 *************************************************************************************
+00B00DA8 2799 *
+00B00DA8 2800 * BASIC increment and scan memory routine
+00B00DA8 2801
+00B00DA8 2802 LAB_IGBY
+00B00DA8 101D 2803 MOVE.b (a5)+,d0 * get byte & increment pointer
+00B00DAA 2804
+00B00DAA 2805 * scan memory routine, exit with Cb = 1 if numeric character
+00B00DAA 2806 * also skips any spaces encountered
+00B00DAA 2807
+00B00DAA 2808 LAB_GBYT
+00B00DAA 1015 2809 MOVE.b (a5),d0 * get byte
+00B00DAC 2810
+00B00DAC B03C 0020 2811 CMP.b #$20,d0 * compare with " "
+00B00DB0 67F6 2812 BEQ.s LAB_IGBY * if " " go do next
+00B00DB2 2813
+00B00DB2 2814 * test current BASIC byte, exit with Cb = 1 if numeric character
+00B00DB2 2815
+00B00DB2 B03C 00A9 2816 CMP.b #TK_ELSE,d0 * compare with the token for ELSE
+00B00DB6 640C 2817 BCC.s RTS_001 * exit if >= (not numeric, carry clear)
+00B00DB8 2818
+00B00DB8 B03C 003A 2819 CMP.b #$3A,d0 * compare with ":"
+00B00DBC 6406 2820 BCC.s RTS_001 * exit if >= (not numeric, carry clear)
+00B00DBE 2821
+00B00DBE 7CD0 2822 MOVEQ #$D0,d6 * set -"0"
+00B00DC0 D006 2823 ADD.b d6,d0 * add -"0"
+00B00DC2 9006 2824 SUB.b d6,d0 * subtract -"0"
+00B00DC4 2825 RTS_001 * carry set if byte = "0"-"9"
+00B00DC4 4E75 2826 RTS
+00B00DC6 2827
+00B00DC6 2828
+00B00DC6 2829 *************************************************************************************
+00B00DC6 2830 *
+00B00DC6 2831 * set-up for - operator
+00B00DC6 2832
+00B00DC6 2833 LAB_1C11
+00B00DC6 6100 FE6A 2834 BSR LAB_CTNM * check if source is numeric, else type mismatch
+00B00DCA 7228 2835 MOVEQ #(TK_GT-TK_PLUS)*4,d1 * set offset from base to - operator
+00B00DCC 2836 LAB_1C13
+00B00DCC 4FEF 0004 2837 LEA 4(sp),sp * dump GVAL return address
+00B00DD0 6000 FF0C 2838 BRA LAB_1B1D * continue evaluating expression
+00B00DD4 2839
+00B00DD4 2840
+00B00DD4 2841 *************************************************************************************
+00B00DD4 2842 *
+00B00DD4 2843 * variable name set-up
+00B00DD4 2844 * get (var), return value in FAC_1 & data type flag
+00B00DD4 2845
+00B00DD4 2846 LAB_1C18
+00B00DD4 6100 01E2 2847 BSR LAB_GVAR * get variable address in a0
+00B00DD8 2848
+00B00DD8 2849 * if you want a non existant variable to return a null value then set the novar
+00B00DD8 2850 * value at the top of this file to some non zero value
+00B00DD8 2851
+00B00DD8 FALSE 2852 ifne novar
+00B00DD8 2853 endc
+00B00DD8 2854
+00B00DD8 2855 * return existing variable value
+00B00DD8 2856
+00B00DD8 2857 LAB_1C19
+00B00DD8 4A2B 0619 2858 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B00DDC 2859 * $00=float
+00B00DDC 6700 0D8E 2860 BEQ LAB_UFAC * if float unpack memory (a0) into FAC1 and
+00B00DE0 2861 * return
+00B00DE0 2862
+00B00DE0 6A06 2863 BPL.s LAB_1C1A * if integer unpack memory (a0) into FAC1
+00B00DE2 2864 * and return
+00B00DE2 2865
+00B00DE2 2748 05F4 2866 MOVE.l a0,FAC1_m(a3) * else save descriptor pointer in FAC1
+00B00DE6 4E75 2867 RTS
+00B00DE8 2868
+00B00DE8 2869 LAB_1C1A
+00B00DE8 2010 2870 MOVE.l (a0),d0 * get integer value
+00B00DEA 6000 04BC 2871 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B00DEE 2872
+00B00DEE 2873
+00B00DEE 2874 *************************************************************************************
+00B00DEE 2875 *
+00B00DEE 2876 * get value from line .. continued
+00B00DEE 2877 * do tokens
+00B00DEE 2878
+00B00DEE 2879 LAB_1BD0
+00B00DEE B03C 00B3 2880 CMP.b #TK_MINUS,d0 * compare with token for -
+00B00DF2 67D2 2881 BEQ.s LAB_1C11 * branch if - token (do set-up for - operator)
+00B00DF4 2882
+00B00DF4 2883 * wasn't -123 so ...
+00B00DF4 B03C 00B2 2884 CMP.b #TK_PLUS,d0 * compare with token for +
+00B00DF8 6700 FF5C 2885 BEQ LAB_GVAL * branch if + token (+n = n so ignore leading +)
+00B00DFC 2886
+00B00DFC B03C 00AE 2887 CMP.b #TK_NOT,d0 * compare with token for NOT
+00B00E00 6606 2888 BNE.s LAB_1BE7 * branch if not token for NOT
+00B00E02 2889
+00B00E02 2890 * was NOT token
+00B00E02 323C 002C 2891 MOVE.w #(TK_EQUAL-TK_PLUS)*4,d1 * offset to NOT function
+00B00E06 60C4 2892 BRA.s LAB_1C13 * do set-up for function then execute
+00B00E08 2893
+00B00E08 2894 * wasn't +, - or NOT so ...
+00B00E08 2895 LAB_1BE7
+00B00E08 B03C 00AB 2896 CMP.b #TK_FN,d0 * compare with token for FN
+00B00E0C 6700 0514 2897 BEQ LAB_201E * if FN go evaluate FNx
+00B00E10 2898
+00B00E10 2899 * wasn't +, -, NOT or FN so ...
+00B00E10 0400 00BF 2900 SUB.b #TK_SGN,d0 * compare with token for SGN & normalise
+00B00E14 6500 F354 2901 BCS LAB_SNER * if < SGN token then do syntax error
+00B00E18 2902
+00B00E18 2903 * get value from line .. continued
+00B00E18 2904 * only functions left so set up function references
+00B00E18 2905
+00B00E18 2906 * new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
+00B00E18 2907 * to process function calls. now the function vector is computed and pushed on the stack
+00B00E18 2908 * and the preprocess offset is read. if the preprocess offset is non zero then the vector
+00B00E18 2909 * is calculated and the routine called, if not this routine just does RTS. whichever
+00B00E18 2910 * happens the RTS at the end of this routine, or the preprocess routine calls, the
+00B00E18 2911 * function code
+00B00E18 2912
+00B00E18 2913 * this also removes some less than elegant code that was used to bypass type checking
+00B00E18 2914 * for functions that returned strings
+00B00E18 2915
+00B00E18 C07C 007F 2916 AND.w #$7F,d0 * mask byte
+00B00E1C D040 2917 ADD.w d0,d0 * *2 (2 bytes per function offset)
+00B00E1E 2918
+00B00E1E 41FA 20A4 2919 LEA LAB_FTBL(pc),a0 * pointer to functions vector table
+00B00E22 3230 0000 2920 MOVE.w (a0,d0.w),d1 * get function vector offset
+00B00E26 4870 1000 2921 PEA (a0,d1.w) * push function vector
+00B00E2A 2922
+00B00E2A 41FA 204C 2923 LEA LAB_FTPP(pc),a0 * pointer to functions preprocess vector table
+00B00E2E 3030 0000 2924 MOVE.w (a0,d0.w),d0 * get function preprocess vector offset
+00B00E32 6712 2925 BEQ.s LAB_1C2A * no preprocess vector so go do function
+00B00E34 2926
+00B00E34 41F0 0000 2927 LEA (a0,d0.w),a0 * get function preprocess vector
+00B00E38 4ED0 2928 JMP (a0) * go do preprocess routine then function
+00B00E3A 2929
+00B00E3A 2930
+00B00E3A 2931 *************************************************************************************
+00B00E3A 2932 *
+00B00E3A 2933 * process string expression in parenthesis
+00B00E3A 2934
+00B00E3A 2935 LAB_PPFS
+00B00E3A 6100 FF56 2936 BSR LAB_1BF7 * process expression in parenthesis
+00B00E3E 4A2B 0619 2937 TST.b Dtypef(a3) * test data type
+00B00E42 6A00 F2FA 2938 BPL LAB_TMER * if numeric do Type missmatch Error/warm start
+00B00E46 2939
+00B00E46 2940 LAB_1C2A
+00B00E46 4E75 2941 RTS * else do function
+00B00E48 2942
+00B00E48 2943
+00B00E48 2944 *************************************************************************************
+00B00E48 2945 *
+00B00E48 2946 * process numeric expression in parenthesis
+00B00E48 2947
+00B00E48 2948 LAB_PPFN
+00B00E48 6100 FF48 2949 BSR LAB_1BF7 * process expression in parenthesis
+00B00E4C 4A2B 0619 2950 TST.b Dtypef(a3) * test data type
+00B00E50 6B00 F2EC 2951 BMI LAB_TMER * if string do Type missmatch Error/warm start
+00B00E54 2952
+00B00E54 4E75 2953 RTS * else do function
+00B00E56 2954
+00B00E56 2955
+00B00E56 2956 *************************************************************************************
+00B00E56 2957 *
+00B00E56 2958 * set numeric data type and increment BASIC execute pointer
+00B00E56 2959
+00B00E56 2960 LAB_PPBI
+00B00E56 177C 0000 0619 2961 MOVE.b #$00,Dtypef(a3) * clear data type flag, $00=float
+00B00E5C 101D 2962 MOVE.b (a5)+,d0 * get next BASIC byte
+00B00E5E 4E75 2963 RTS * do function
+00B00E60 2964
+00B00E60 2965
+00B00E60 2966 *************************************************************************************
+00B00E60 2967 *
+00B00E60 2968 * process string for LEFT$, RIGHT$ or MID$
+00B00E60 2969
+00B00E60 2970 LAB_LRMS
+00B00E60 6100 FDE8 2971 BSR LAB_EVEZ * evaluate (should be string) expression
+00B00E64 4A2B 0619 2972 TST.b Dtypef(a3) * test data type flag
+00B00E68 6A00 F2D4 2973 BPL LAB_TMER * if type is not string do type mismatch error
+00B00E6C 2974
+00B00E6C 141D 2975 MOVE.b (a5)+,d2 * get BASIC byte
+00B00E6E B43C 002C 2976 CMP.b #',',d2 * compare with comma
+00B00E72 6600 F2F6 2977 BNE LAB_SNER * if not "," go do syntax error/warm start
+00B00E76 2978
+00B00E76 2F2B 05F4 2979 MOVE.l FAC1_m(a3),-(sp) * save descriptor pointer
+00B00E7A 6100 08AA 2980 BSR LAB_GTWO * get word parameter, result in d0 and Itemp
+00B00E7E 205F 2981 MOVEA.l (sp)+,a0 * restore descriptor pointer
+00B00E80 4E75 2982 RTS * do function
+00B00E82 2983
+00B00E82 2984
+00B00E82 2985 *************************************************************************************
+00B00E82 2986 *
+00B00E82 2987 * process numeric expression(s) for BIN$ or HEX$
+00B00E82 2988
+00B00E82 2989 LAB_BHSS
+00B00E82 6100 FDC6 2990 BSR LAB_EVEZ * evaluate expression (no decrement)
+00B00E86 4A2B 0619 2991 TST.b Dtypef(a3) * test data type
+00B00E8A 6B00 F2B2 2992 BMI LAB_TMER * if string do Type missmatch Error/warm start
+00B00E8E 2993
+00B00E8E 6100 0DCE 2994 BSR LAB_2831 * convert FAC1 floating to fixed
+00B00E92 2995 * result in d0 and Itemp
+00B00E92 7200 2996 MOVEQ #0,d1 * set default to no leading "0"s
+00B00E94 141D 2997 MOVE.b (a5)+,d2 * get BASIC byte
+00B00E96 B43C 002C 2998 CMP.b #',',d2 * compare with comma
+00B00E9A 660C 2999 BNE.s LAB_BHCB * if not "," go check close bracket
+00B00E9C 3000
+00B00E9C 2F00 3001 MOVE.l d0,-(sp) * copy number to stack
+00B00E9E 6100 0872 3002 BSR LAB_GTBY * get byte value
+00B00EA2 2200 3003 MOVE.l d0,d1 * copy leading 0s #
+00B00EA4 201F 3004 MOVE.l (sp)+,d0 * restore number from stack
+00B00EA6 141D 3005 MOVE.b (a5)+,d2 * get BASIC byte
+00B00EA8 3006 LAB_BHCB
+00B00EA8 B43C 0029 3007 CMP.b #')',d2 * compare with close bracket
+00B00EAC 6600 F2BC 3008 BNE LAB_SNER * if not ")" do Syntax Error/warm start
+00B00EB0 3009
+00B00EB0 4E75 3010 RTS * go do function
+00B00EB2 3011
+00B00EB2 3012
+00B00EB2 3013 *************************************************************************************
+00B00EB2 3014 *
+00B00EB2 3015 * perform EOR
+00B00EB2 3016
+00B00EB2 3017 LAB_EOR
+00B00EB2 6116 3018 BSR.s GetFirst * get two values for OR, AND or EOR
+00B00EB4 3019 * first in d0, and Itemp, second in d2
+00B00EB4 B580 3020 EOR.l d2,d0 * EOR values
+00B00EB6 6000 03F0 3021 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B00EBA 3022
+00B00EBA 3023
+00B00EBA 3024 *************************************************************************************
+00B00EBA 3025 *
+00B00EBA 3026 * perform OR
+00B00EBA 3027
+00B00EBA 3028 LAB_OR
+00B00EBA 610E 3029 BSR.s GetFirst * get two values for OR, AND or EOR
+00B00EBC 3030 * first in d0, and Itemp, second in d2
+00B00EBC 8082 3031 OR.l d2,d0 * do OR
+00B00EBE 6000 03E8 3032 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B00EC2 3033
+00B00EC2 3034
+00B00EC2 3035 *************************************************************************************
+00B00EC2 3036 *
+00B00EC2 3037 * perform AND
+00B00EC2 3038
+00B00EC2 3039 LAB_AND
+00B00EC2 6106 3040 BSR.s GetFirst * get two values for OR, AND or EOR
+00B00EC4 3041 * first in d0, and Itemp, second in d2
+00B00EC4 C082 3042 AND.l d2,d0 * do AND
+00B00EC6 6000 03E0 3043 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B00ECA 3044
+00B00ECA 3045
+00B00ECA 3046 *************************************************************************************
+00B00ECA 3047 *
+00B00ECA 3048 * get two values for OR, AND, EOR
+00B00ECA 3049 * first in d0, second in d2
+00B00ECA 3050
+00B00ECA 3051 GetFirst
+00B00ECA 6100 0228 3052 BSR LAB_EVIR * evaluate integer expression (no sign check)
+00B00ECE 3053 * result in d0 and Itemp
+00B00ECE 2400 3054 MOVE.l d0,d2 * copy second value
+00B00ED0 6100 0CF4 3055 BSR LAB_279B * copy FAC2 to FAC1, get first value in
+00B00ED4 3056 * expression
+00B00ED4 6000 021E 3057 BRA LAB_EVIR * evaluate integer expression (no sign check)
+00B00ED8 3058 * result in d0 and Itemp & return
+00B00ED8 3059
+00B00ED8 3060
+00B00ED8 3061 *************************************************************************************
+00B00ED8 3062 *
+00B00ED8 3063 * perform NOT
+00B00ED8 3064
+00B00ED8 3065 LAB_EQUAL
+00B00ED8 6100 021A 3066 BSR LAB_EVIR * evaluate integer expression (no sign check)
+00B00EDC 3067 * result in d0 and Itemp
+00B00EDC 4680 3068 NOT.l d0 * bitwise invert
+00B00EDE 6000 03C8 3069 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B00EE2 3070
+00B00EE2 3071
+00B00EE2 3072 *************************************************************************************
+00B00EE2 3073 *
+00B00EE2 3074 * perform comparisons
+00B00EE2 3075 * do < compare
+00B00EE2 3076
+00B00EE2 3077 LAB_LTHAN
+00B00EE2 6100 FD50 3078 BSR LAB_CKTM * type match check, set C for string
+00B00EE6 6506 3079 BCS.s LAB_1CAE * branch if string
+00B00EE8 3080
+00B00EE8 3081 * do numeric < compare
+00B00EE8 6100 0D48 3082 BSR LAB_27FA * compare FAC1 with FAC2
+00B00EEC 3083 * returns d0=+1 if FAC1 > FAC2
+00B00EEC 3084 * returns d0= 0 if FAC1 = FAC2
+00B00EEC 3085 * returns d0=-1 if FAC1 < FAC2
+00B00EEC 6042 3086 BRA.s LAB_1CF2 * process result
+00B00EEE 3087
+00B00EEE 3088 * do string < compare
+00B00EEE 3089 LAB_1CAE
+00B00EEE 177C 0000 0619 3090 MOVE.b #$00,Dtypef(a3) * clear data type, $80=string, $40=integer,
+00B00EF4 3091 * $00=float
+00B00EF4 6100 06BC 3092 BSR LAB_22B6 * pop string off descriptor stack, or from top
+00B00EF8 3093 * of string space returns d0 = length,
+00B00EF8 3094 * a0 = pointer
+00B00EF8 2248 3095 MOVEA.l a0,a1 * copy string 2 pointer
+00B00EFA 2200 3096 MOVE.l d0,d1 * copy string 2 length
+00B00EFC 206B 05FC 3097 MOVEA.l FAC2_m(a3),a0 * get string 1 descriptor pointer
+00B00F00 6100 06B4 3098 BSR LAB_22BA * pop (a0) descriptor, returns with ..
+00B00F04 3099 * d0 = length, a0 = pointer
+00B00F04 2400 3100 MOVE.l d0,d2 * copy length
+00B00F06 6604 3101 BNE.s LAB_1CB5 * branch if not null string
+00B00F08 3102
+00B00F08 4A81 3103 TST.l d1 * test if string 2 is null also
+00B00F0A 6724 3104 BEQ.s LAB_1CF2 * if so do string 1 = string 2
+00B00F0C 3105
+00B00F0C 3106 LAB_1CB5
+00B00F0C 9481 3107 SUB.l d1,d2 * subtract string 2 length
+00B00F0E 670C 3108 BEQ.s LAB_1CD5 * branch if strings = length
+00B00F10 3109
+00B00F10 6504 3110 BCS.s LAB_1CD4 * branch if string 1 < string 2
+00B00F12 3111
+00B00F12 70FF 3112 MOVEQ #-1,d0 * set for string 1 > string 2
+00B00F14 6008 3113 BRA.s LAB_1CD6 * go do character comapare
+00B00F16 3114
+00B00F16 3115 LAB_1CD4
+00B00F16 2200 3116 MOVE.l d0,d1 * string 1 length is compare length
+00B00F18 7001 3117 MOVEQ #1,d0 * and set for string 1 < string 2
+00B00F1A 6002 3118 BRA.s LAB_1CD6 * go do character comapare
+00B00F1C 3119
+00B00F1C 3120 LAB_1CD5
+00B00F1C 2002 3121 MOVE.l d2,d0 * set for string 1 = string 2
+00B00F1E 3122 LAB_1CD6
+00B00F1E 5381 3123 SUBQ.l #1,d1 * adjust length for DBcc loop
+00B00F20 3124
+00B00F20 3125 * d1 is length to compare, d0 is <=> for length
+00B00F20 3126 * a0 is string 1 pointer, a1 is string 2 pointer
+00B00F20 3127 LAB_1CE6
+00B00F20 B308 3128 CMPM.b (a0)+,(a1)+ * compare string bytes (1 with 2)
+00B00F22 56C9 FFFC 3129 DBNE d1,LAB_1CE6 * loop if same and not end yet
+00B00F26 3130
+00B00F26 6708 3131 BEQ.s LAB_1CF2 * if = to here, then go use length compare
+00B00F28 3132
+00B00F28 6404 3133 BCC.s LAB_1CDB * else branch if string 1 > string 2
+00B00F2A 3134
+00B00F2A 70FF 3135 MOVEQ #-1,d0 * else set for string 1 < string 2
+00B00F2C 6002 3136 BRA.s LAB_1CF2 * go set result
+00B00F2E 3137
+00B00F2E 3138 LAB_1CDB
+00B00F2E 7001 3139 MOVEQ #1,d0 * and set for string 1 > string 2
+00B00F30 3140
+00B00F30 3141 LAB_1CF2
+00B00F30 5200 3142 ADDQ.b #1,d0 * make result 0, 1 or 2
+00B00F32 1200 3143 MOVE.b d0,d1 * copy to d1
+00B00F34 7001 3144 MOVEQ #1,d0 * set d0 longword
+00B00F36 E338 3145 ROL.b d1,d0 * make 1, 2 or 4 (result = flag bit)
+00B00F38 C02B 0645 3146 AND.b Cflag(a3),d0 * AND with comparison evaluation flag
+00B00F3C 6700 0CDC 3147 BEQ LAB_27DB * exit if not a wanted result (i.e. false)
+00B00F40 3148
+00B00F40 70FF 3149 MOVEQ #-1,d0 * else set -1 (true)
+00B00F42 6000 0CD6 3150 BRA LAB_27DB * save d0 as integer & return
+00B00F46 3151
+00B00F46 3152
+00B00F46 3153 LAB_1CFE
+00B00F46 6100 FE56 3154 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
+00B00F4A 3155
+00B00F4A 3156
+00B00F4A 3157 *************************************************************************************
+00B00F4A 3158 *
+00B00F4A 3159 * perform DIM
+00B00F4A 3160
+00B00F4A 3161 LAB_DIM
+00B00F4A 72FF 3162 MOVEQ #-1,d1 * set "DIM" flag
+00B00F4C 6170 3163 BSR.s LAB_1D10 * search for or dimension a variable
+00B00F4E 6100 FE5A 3164 BSR LAB_GBYT * scan memory
+00B00F52 66F2 3165 BNE.s LAB_1CFE * loop and scan for "," if not null
+00B00F54 3166
+00B00F54 4E75 3167 RTS
+00B00F56 3168
+00B00F56 3169
+00B00F56 3170 *************************************************************************************
+00B00F56 3171 *
+00B00F56 3172 * perform << (left shift)
+00B00F56 3173
+00B00F56 3174 LAB_LSHIFT
+00B00F56 612E 3175 BSR.s GetPair * get an integer and byte pair
+00B00F58 3176 * byte is in d2, integer is in d0 and Itemp
+00B00F58 6708 3177 BEQ.s NoShift * branch if byte zero
+00B00F5A 3178
+00B00F5A B43C 0020 3179 CMP.b #$20,d2 * compare bit count with 32d
+00B00F5E 6420 3180 BCC.s TooBig * branch if >=
+00B00F60 3181
+00B00F60 E5A0 3182 ASL.l d2,d0 * shift longword
+00B00F62 3183 NoShift
+00B00F62 6000 0344 3184 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B00F66 3185
+00B00F66 3186
+00B00F66 3187 *************************************************************************************
+00B00F66 3188 *
+00B00F66 3189 * perform >> (right shift)
+00B00F66 3190
+00B00F66 3191 LAB_RSHIFT
+00B00F66 611E 3192 BSR.s GetPair * get an integer and byte pair
+00B00F68 3193 * byte is in d2, integer is in d0 and Itemp
+00B00F68 67F8 3194 BEQ.s NoShift * branch if byte zero
+00B00F6A 3195
+00B00F6A B43C 0020 3196 CMP.b #$20,d2 * compare bit count with 32d
+00B00F6E 650A 3197 BCS.s Not2Big * branch if >= (return shift)
+00B00F70 3198
+00B00F70 4A80 3199 TST.l d0 * test sign bit
+00B00F72 6A0C 3200 BPL.s TooBig * branch if +ve
+00B00F74 3201
+00B00F74 70FF 3202 MOVEQ #-1,d0 * set longword
+00B00F76 6000 0330 3203 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
+00B00F7A 3204
+00B00F7A 3205 Not2Big
+00B00F7A E4A0 3206 ASR.l d2,d0 * shift longword
+00B00F7C 6000 032A 3207 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
+00B00F80 3208
+00B00F80 3209 TooBig
+00B00F80 7000 3210 MOVEQ #0,d0 * clear longword
+00B00F82 6000 0324 3211 BRA LAB_AYFC * convert d0 to longword in FAC1 & RET
+00B00F86 3212
+00B00F86 3213
+00B00F86 3214 *************************************************************************************
+00B00F86 3215 *
+00B00F86 3216 * get an integer and byte pair
+00B00F86 3217 * byte is in d2, integer is in d0 and Itemp
+00B00F86 3218
+00B00F86 3219 GetPair
+00B00F86 6100 078E 3220 BSR LAB_EVBY * evaluate byte expression, result in d0 and
+00B00F8A 3221 * Itemp
+00B00F8A 1400 3222 MOVE.b d0,d2 * save it
+00B00F8C 6100 0C38 3223 BSR LAB_279B * copy FAC2 to FAC1, get first value in
+00B00F90 3224 * expression
+00B00F90 6100 0162 3225 BSR LAB_EVIR * evaluate integer expression (no sign check)
+00B00F94 3226 * result in d0 and Itemp
+00B00F94 4A02 3227 TST.b d2 * test byte value
+00B00F96 4E75 3228 RTS
+00B00F98 3229
+00B00F98 3230
+00B00F98 3231 *************************************************************************************
+00B00F98 3232 *
+00B00F98 3233 * check alpha, return C=0 if<"A" or >"Z" or <"a" to "z">
+00B00F98 3234
+00B00F98 3235 LAB_CASC
+00B00F98 B03C 0061 3236 CMP.b #$61,d0 * compare with "a"
+00B00F9C 6410 3237 BCC.s LAB_1D83 * if >="a" go check =<"z"
+00B00F9E 3238
+00B00F9E 3239
+00B00F9E 3240 *************************************************************************************
+00B00F9E 3241 *
+00B00F9E 3242 * check alpha upper case, return C=0 if<"A" or >"Z"
+00B00F9E 3243
+00B00F9E 3244 LAB_CAUC
+00B00F9E B03C 0041 3245 CMP.b #$41,d0 * compare with "A"
+00B00FA2 6404 3246 BCC.s LAB_1D8A * if >="A" go check =<"Z"
+00B00FA4 3247
+00B00FA4 8040 3248 OR d0,d0 * make C=0
+00B00FA6 4E75 3249 RTS
+00B00FA8 3250
+00B00FA8 3251 LAB_1D8A
+00B00FA8 B03C 005B 3252 CMP.b #$5B,d0 * compare with "Z"+1
+00B00FAC 3253 * carry set if byte<="Z"
+00B00FAC 4E75 3254 RTS
+00B00FAE 3255
+00B00FAE 3256 LAB_1D83
+00B00FAE B03C 007B 3257 CMP.b #$7B,d0 * compare with "z"+1
+00B00FB2 3258 * carry set if byte<="z"
+00B00FB2 4E75 3259 RTS
+00B00FB4 3260
+00B00FB4 3261
+00B00FB4 3262 *************************************************************************************
+00B00FB4 3263 *
+00B00FB4 3264 * search for or create variable. this is used to automatically create a variable if
+00B00FB4 3265 * it is not found. any routines that need to create the variable call LAB_GVAR via
+00B00FB4 3266 * this point and error generation is supressed and the variable will be created
+00B00FB4 3267 *
+00B00FB4 3268 * return pointer to variable in Cvaral and a0
+00B00FB4 3269 * set data type to variable type
+00B00FB4 3270
+00B00FB4 3271 LAB_SVAR
+00B00FB4 6102 3272 BSR.s LAB_GVAR * search for variable
+00B00FB6 3273 LAB_FVAR
+00B00FB6 4E75 3274 RTS
+00B00FB8 3275
+00B00FB8 3276
+00B00FB8 3277 *************************************************************************************
+00B00FB8 3278 *
+00B00FB8 3279 * search for variable. if this routine is called from anywhere but the above call and
+00B00FB8 3280 * the variable searched for does not exist then an error will be returned
+00B00FB8 3281 *
+00B00FB8 3282 * DIM flag is in d1.b
+00B00FB8 3283 * return pointer to variable in Cvaral and a0
+00B00FB8 3284 * set data type to variable type
+00B00FB8 3285
+00B00FB8 3286 LAB_GVAR
+00B00FB8 7200 3287 MOVEQ #$00,d1 * set DIM flag = $00
+00B00FBA 6100 FDEE 3288 BSR LAB_GBYT * scan memory (1st character)
+00B00FBE 3289 LAB_1D10
+00B00FBE 1741 0618 3290 MOVE.b d1,Defdim(a3) * save DIM flag
+00B00FC2 3291
+00B00FC2 3292 * search for FN name entry point
+00B00FC2 3293
+00B00FC2 3294 LAB_1D12
+00B00FC2 61D4 3295 BSR.s LAB_CASC * check byte, return C=0 if<"A" or >"Z"
+00B00FC4 6400 F1A4 3296 BCC LAB_SNER * if not, syntax error then warm start
+00B00FC8 3297
+00B00FC8 3298 * it is a variable name so ...
+00B00FC8 7200 3299 MOVEQ #$0,d1 * set index for name byte
+00B00FCA 41EB 04CE 3300 LEA Varname(a3),a0 * pointer to variable name
+00B00FCE 2081 3301 MOVE.l d1,(a0) * clear the variable name
+00B00FD0 1741 0619 3302 MOVE.b d1,Dtypef(a3) * clear the data type, $80=string, $40=integer,
+00B00FD4 3303 * $00=float
+00B00FD4 3304
+00B00FD4 3305 LAB_1D2D
+00B00FD4 B27C 0004 3306 CMP.w #$04,d1 * done all significant characters?
+00B00FD8 6406 3307 BCC.s LAB_1D2E * if so go ignore any more
+00B00FDA 3308
+00B00FDA 1180 1000 3309 MOVE.b d0,(a0,d1.w) * save the character
+00B00FDE 5241 3310 ADDQ.w #1,d1 * increment index
+00B00FE0 3311 LAB_1D2E
+00B00FE0 6100 FDC6 3312 BSR LAB_IGBY * increment & scan memory (next character)
+00B00FE4 65EE 3313 BCS.s LAB_1D2D * branch if character = "0"-"9" (ok)
+00B00FE6 3314
+00B00FE6 3315 * character wasn't "0" to "9" so ...
+00B00FE6 61B0 3316 BSR.s LAB_CASC * check byte, return C=0 if<"A" or >"Z"
+00B00FE8 65EA 3317 BCS.s LAB_1D2D * branch if = "A"-"Z" (ok)
+00B00FEA 3318
+00B00FEA 3319 * check if string variable
+00B00FEA B03C 0024 3320 CMP.b #'$',d0 * compare with "$"
+00B00FEE 660C 3321 BNE.s LAB_1D44 * branch if not string
+00B00FF0 3322
+00B00FF0 3323 * type is string
+00B00FF0 002B 0080 04CF 3324 OR.b #$80,Varname+1(a3) * set top bit of 2nd character, indicate string
+00B00FF6 6100 FDB0 3325 BSR LAB_IGBY * increment & scan memory
+00B00FFA 6010 3326 BRA.s LAB_1D45 * skip integer check
+00B00FFC 3327
+00B00FFC 3328 * check if integer variable
+00B00FFC 3329 LAB_1D44
+00B00FFC B03C 0026 3330 CMP.b #'&',d0 * compare with "&"
+00B01000 660A 3331 BNE.s LAB_1D45 * branch if not integer
+00B01002 3332
+00B01002 3333 * type is integer
+00B01002 002B 0080 04D0 3334 OR.b #$80,Varname+2(a3) * set top bit of 3rd character, indicate integer
+00B01008 6100 FD9E 3335 BSR LAB_IGBY * increment & scan memory
+00B0100C 3336
+00B0100C 3337 * after we have determined the variable type we need to determine
+00B0100C 3338 * if it's an array of type
+00B0100C 3339
+00B0100C 3340 * gets here with character after var name in d0
+00B0100C 3341 LAB_1D45
+00B0100C 4A2B 0643 3342 TST.b Sufnxf(a3) * test function name flag
+00B01010 670E 3343 BEQ.s LAB_1D48 * if not FN or FN variable continue
+00B01012 3344
+00B01012 6A14 3345 BPL.s LAB_1D49 * if FN variable go find or create it
+00B01014 3346
+00B01014 3347 * else was FN name
+00B01014 202B 04CE 3348 MOVE.l Varname(a3),d0 * get whole function name
+00B01018 7208 3349 MOVEQ #8,d1 * set step to next function size -4
+00B0101A 41EB 0496 3350 LEA Sfncl(a3),a0 * get pointer to start of functions
+00B0101E 601C 3351 BRA.s LAB_1D4B * go find function
+00B01020 3352
+00B01020 3353 LAB_1D48
+00B01020 0400 0028 3354 SUB.b #'(',d0 * subtract "("
+00B01024 6700 00F4 3355 BEQ LAB_1E17 * if "(" go find, or make, array
+00B01028 3356
+00B01028 3357 * either find or create var
+00B01028 3358 * var name (1st four characters only!) is in Varname
+00B01028 3359
+00B01028 3360 * variable name wasn't var( .. so look for
+00B01028 3361 * plain variable
+00B01028 3362 LAB_1D49
+00B01028 202B 04CE 3363 MOVE.l Varname(a3),d0 * get whole variable name
+00B0102C 3364 LAB_1D4A
+00B0102C 7204 3365 MOVEQ #4,d1 * set step to next variable size -4
+00B0102E 41EB 049A 3366 LEA Svarl(a3),a0 * get pointer to start of variables
+00B01032 3367
+00B01032 0800 0017 3368 BTST.l #23,d0 * test if string name
+00B01036 6704 3369 BEQ.s LAB_1D4B * branch if not
+00B01038 3370
+00B01038 5441 3371 ADDQ.w #2,d1 * 6 bytes per string entry
+00B0103A 5848 3372 ADDQ.w #(Sstrl-Svarl),a0 * move to string area
+00B0103C 3373
+00B0103C 3374 LAB_1D4B
+00B0103C 2268 0004 3375 MOVEA.l 4(a0),a1 * get end address
+00B01040 2050 3376 MOVEA.l (a0),a0 * get start address
+00B01042 6006 3377 BRA.s LAB_1D5E * enter loop at exit check
+00B01044 3378
+00B01044 3379 LAB_1D5D
+00B01044 B098 3380 CMP.l (a0)+,d0 * compare this variable with name
+00B01046 6776 3381 BEQ.s LAB_1DD7 * branch if match (found var)
+00B01048 3382
+00B01048 D1C1 3383 ADDA.l d1,a0 * add offset to next variable
+00B0104A 3384 LAB_1D5E
+00B0104A B1C9 3385 CMPA.l a1,a0 * compare address with variable space end
+00B0104C 66F6 3386 BNE.s LAB_1D5D * if not end go check next
+00B0104E 3387
+00B0104E 4A2B 0643 3388 TST.b Sufnxf(a3) * is it a function or function variable
+00B01052 660A 3389 BNE.s LAB_1D94 * if was go do DEF or function variable
+00B01054 3390
+00B01054 3391 * reached end of variable mem without match
+00B01054 3392 * ... so create new variable, possibly
+00B01054 3393
+00B01054 45FA FF60 3394 LEA LAB_FVAR(pc),a2 * get the address of the create if doesn't
+00B01058 3395 * exist call to LAB_GVAR
+00B01058 B5D7 3396 CMPA.l (sp),a2 * compare the return address with expected
+00B0105A 6600 F0CA 3397 BNE LAB_UVER * if not create go do error or return null
+00B0105E 3398
+00B0105E 3399 * this will only branch if the call to LAB_GVAR wasn't from LAB_SVAR
+00B0105E 3400
+00B0105E 3401 LAB_1D94
+00B0105E 082B 0000 0643 3402 BTST.b #0,Sufnxf(a3) * test function search flag
+00B01064 6600 F0C8 3403 BNE LAB_UFER * if not doing DEF then go do undefined
+00B01068 3404 * function error
+00B01068 3405
+00B01068 3406 * else create new variable/function
+00B01068 3407 LAB_1D98
+00B01068 246B 04A6 3408 MOVEA.l Earryl(a3),a2 * get end of block to move
+00B0106C 240A 3409 MOVE.l a2,d2 * copy end of block to move
+00B0106E 9489 3410 SUB.l a1,d2 * calculate block to move size
+00B01070 3411
+00B01070 204A 3412 MOVEA.l a2,a0 * copy end of block to move
+00B01072 5881 3413 ADDQ.l #4,d1 * space for one variable/function + name
+00B01074 D5C1 3414 ADDA.l d1,a2 * add space for one variable/function
+00B01076 274A 04A6 3415 MOVE.l a2,Earryl(a3) * set new array mem end
+00B0107A E28A 3416 LSR.l #1,d2 * /2 for word copy
+00B0107C 6712 3417 BEQ.s LAB_1DAF * skip move if zero length block
+00B0107E 3418
+00B0107E 5382 3419 SUBQ.l #1,d2 * -1 for DFB loop
+00B01080 4842 3420 SWAP d2 * swap high word to low word
+00B01082 3421 LAB_1DAC
+00B01082 4842 3422 SWAP d2 * swap high word to low word
+00B01084 3423 LAB_1DAE
+00B01084 3520 3424 MOVE.w -(a0),-(a2) * copy word
+00B01086 51CA FFFC 3425 DBF d2,LAB_1DAE * loop until done
+00B0108A 3426
+00B0108A 4842 3427 SWAP d2 * swap high word to low word
+00B0108C 51CA FFF4 3428 DBF d2,LAB_1DAC * decrement high count and loop until done
+00B01090 3429
+00B01090 3430 * get here after creating either a function, variable or string
+00B01090 3431 * if function set variables start, string start, array start
+00B01090 3432 * if variable set string start, array start
+00B01090 3433 * if string set array start
+00B01090 3434
+00B01090 3435 LAB_1DAF
+00B01090 4A2B 0643 3436 TST.b Sufnxf(a3) * was it function
+00B01094 6B08 3437 BMI.s LAB_1DB0 * branch if was FN
+00B01096 3438
+00B01096 0800 0017 3439 BTST.l #23,d0 * was it string
+00B0109A 660A 3440 BNE.s LAB_1DB2 * branch if string
+00B0109C 3441
+00B0109C 6004 3442 BRA.s LAB_1DB1 * branch if was plain variable
+00B0109E 3443
+00B0109E 3444 LAB_1DB0
+00B0109E D3AB 049A 3445 ADD.l d1,Svarl(a3) * set new variable memory start
+00B010A2 3446 LAB_1DB1
+00B010A2 D3AB 049E 3447 ADD.l d1,Sstrl(a3) * set new start of strings
+00B010A6 3448 LAB_1DB2
+00B010A6 D3AB 04A2 3449 ADD.l d1,Sarryl(a3) * set new array memory start
+00B010AA 20C0 3450 MOVE.l d0,(a0)+ * save variable/function name
+00B010AC 20BC 00000000 3451 MOVE.l #$00,(a0) * initialise variable
+00B010B2 0800 0017 3452 BTST.l #23,d0 * was it string
+00B010B6 6706 3453 BEQ.s LAB_1DD7 * branch if not string
+00B010B8 3454
+00B010B8 317C 0000 0004 3455 MOVE.w #$00,4(a0) * else initialise string length
+00B010BE 3456
+00B010BE 3457 * found a match for var ((Vrschl) = ptr)
+00B010BE 3458 LAB_1DD7
+00B010BE 2200 3459 MOVE.l d0,d1 * ........ $....... &....... ........
+00B010C0 D281 3460 ADD.l d1,d1 * .......$ .......& ........ .......0
+00B010C2 4841 3461 SWAP d1 * ........ .......0 .......$ .......&
+00B010C4 E219 3462 ROR.b #1,d1 * ........ .......0 .......$ &.......
+00B010C6 E249 3463 LSR.w #1,d1 * ........ .......0 0....... $&.....?.
+00B010C8 C23C 00C0 3464 AND.b #$C0,d1 * mask the type bits
+00B010CC 1741 0619 3465 MOVE.b d1,Dtypef(a3) * save the data type
+00B010D0 3466
+00B010D0 177C 0000 0643 3467 MOVE.b #$00,Sufnxf(a3) * clear FN flag byte
+00B010D6 3468
+00B010D6 3469 * if you want a non existant variable to return a null value then set the novar
+00B010D6 3470 * value at the top of this file to some non zero value
+00B010D6 3471
+00B010D6 FALSE 3472 ifne novar
+00B010D6 3473 endc
+00B010D6 3474
+00B010D6 4E75 3475 RTS
+00B010D8 3476
+00B010D8 3477
+00B010D8 3478 *************************************************************************************
+00B010D8 3479 *
+00B010D8 3480 * set-up array pointer, d0, to first element in array
+00B010D8 3481 * set d0 to (a0)+2*(Dimcnt)+$0A
+00B010D8 3482
+00B010D8 3483 LAB_1DE6
+00B010D8 7005 3484 MOVEQ #5,d0 * set d0 to 5 (*2 = 10, later)
+00B010DA D02B 063F 3485 ADD.b Dimcnt(a3),d0 * add # of dimensions (1, 2 or 3)
+00B010DE D080 3486 ADD.l d0,d0 * *2 (bytes per dimension size)
+00B010E0 D088 3487 ADD.l a0,d0 * add array start pointer
+00B010E2 4E75 3488 RTS
+00B010E4 3489
+00B010E4 3490
+00B010E4 3491 *************************************************************************************
+00B010E4 3492 *
+00B010E4 3493 * evaluate unsigned integer expression
+00B010E4 3494
+00B010E4 3495 LAB_EVIN
+00B010E4 6100 FCC2 3496 BSR LAB_IGBY * increment & scan memory
+00B010E8 6100 FB46 3497 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B010EC 3498 * else do type mismatch
+00B010EC 3499
+00B010EC 3500
+00B010EC 3501 *************************************************************************************
+00B010EC 3502 *
+00B010EC 3503 * evaluate positive integer expression, result in d0 and Itemp
+00B010EC 3504
+00B010EC 3505 LAB_EVPI
+00B010EC 4A2B 05F9 3506 TST.b FAC1_s(a3) * test FAC1 sign (b7)
+00B010F0 6B00 F06C 3507 BMI LAB_FCER * do function call error if -ve
+00B010F4 3508
+00B010F4 3509
+00B010F4 3510 *************************************************************************************
+00B010F4 3511 *
+00B010F4 3512 * evaluate integer expression, no sign check
+00B010F4 3513 * result in d0 and Itemp, exit with flags set correctly
+00B010F4 3514
+00B010F4 3515 LAB_EVIR
+00B010F4 0C2B 00A0 05F8 3516 CMPI.b #$A0,FAC1_e(a3) * compare exponent with exponent = 2^32 (n>2^31)
+00B010FA 6500 0B62 3517 BCS LAB_2831 * convert FAC1 floating to fixed
+00B010FE 3518 * result in d0 and Itemp
+00B010FE 6600 F05E 3519 BNE LAB_FCER * if > do function call error, then warm start
+00B01102 3520
+00B01102 4A2B 05F9 3521 TST.b FAC1_s(a3) * test sign of FAC1
+00B01106 6A00 0B56 3522 BPL LAB_2831 * if +ve then ok
+00B0110A 3523
+00B0110A 202B 05F4 3524 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B0110E 4480 3525 NEG.l d0 * do -d0
+00B01110 6800 F04C 3526 BVC LAB_FCER * if not $80000000 do FC error, then warm start
+00B01114 3527
+00B01114 2740 048E 3528 MOVE.l d0,Itemp(a3) * else just set it
+00B01118 4E75 3529 RTS
+00B0111A 3530
+00B0111A 3531
+00B0111A 3532 *************************************************************************************
+00B0111A 3533 *
+00B0111A 3534 * find or make array
+00B0111A 3535
+00B0111A 3536 LAB_1E17
+00B0111A 3F2B 0618 3537 MOVE.w Defdim(a3),-(sp) * get DIM flag and data type flag (word in mem)
+00B0111E 7200 3538 MOVEQ #0,d1 * clear dimensions count
+00B01120 3539
+00B01120 3540 * now get the array dimension(s) and stack it (them) before the data type and DIM flag
+00B01120 3541
+00B01120 3542 LAB_1E1F
+00B01120 3F01 3543 MOVE.w d1,-(sp) * save dimensions count
+00B01122 2F2B 04CE 3544 MOVE.l Varname(a3),-(sp) * save variable name
+00B01126 61BC 3545 BSR.s LAB_EVIN * evaluate integer expression
+00B01128 3546
+00B01128 4840 3547 SWAP d0 * swap high word to low word
+00B0112A 4A40 3548 TST.w d0 * test swapped high word
+00B0112C 6600 F020 3549 BNE LAB_ABER * if too big do array bounds error
+00B01130 3550
+00B01130 275F 04CE 3551 MOVE.l (sp)+,Varname(a3) * restore variable name
+00B01134 321F 3552 MOVE.w (sp)+,d1 * restore dimensions count
+00B01136 301F 3553 MOVE.w (sp)+,d0 * restore DIM and data type flags
+00B01138 3F2B 0490 3554 MOVE.w Itemp+2(a3),-(sp) * stack this dimension size
+00B0113C 3F00 3555 MOVE.w d0,-(sp) * save DIM and data type flags
+00B0113E 5241 3556 ADDQ.w #1,d1 * increment dimensions count
+00B01140 6100 FC68 3557 BSR LAB_GBYT * scan memory
+00B01144 B03C 002C 3558 CMP.b #$2C,d0 * compare with ","
+00B01148 67D6 3559 BEQ.s LAB_1E1F * if found go do next dimension
+00B0114A 3560
+00B0114A 1741 063F 3561 MOVE.b d1,Dimcnt(a3) * store dimensions count
+00B0114E 6100 FC46 3562 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B01152 375F 0618 3563 MOVE.w (sp)+,Defdim(a3) * restore DIM and data type flags (word in mem)
+00B01156 206B 04A2 3564 MOVEA.l Sarryl(a3),a0 * get array mem start
+00B0115A 3565
+00B0115A 3566 * now check to see if we are at the end of array memory (we would be if there were
+00B0115A 3567 * no arrays).
+00B0115A 3568
+00B0115A 3569 LAB_1E5C
+00B0115A 2748 0610 3570 MOVE.l a0,Astrtl(a3) * save as array start pointer
+00B0115E B1EB 04A6 3571 CMPA.l Earryl(a3),a0 * compare with array mem end
+00B01162 672E 3572 BEQ.s LAB_1EA1 * go build array if not found
+00B01164 3573
+00B01164 3574 * search for array
+00B01164 2010 3575 MOVE.l (a0),d0 * get this array name
+00B01166 B0AB 04CE 3576 CMP.l Varname(a3),d0 * compare with array name
+00B0116A 670A 3577 BEQ.s LAB_1E8D * array found so branch
+00B0116C 3578
+00B0116C 3579 * no match
+00B0116C 2068 0004 3580 MOVEA.l 4(a0),a0 * get this array size
+00B01170 D1EB 0610 3581 ADDA.l Astrtl(a3),a0 * add to array start pointer
+00B01174 60E4 3582 BRA.s LAB_1E5C * go check next array
+00B01176 3583
+00B01176 3584 * found array, are we trying to dimension it?
+00B01176 3585 LAB_1E8D
+00B01176 4A2B 0618 3586 TST.b Defdim(a3) * are we trying to dimension it?
+00B0117A 6600 EFCE 3587 BNE LAB_DDER * if so do double dimension error/warm start
+00B0117E 3588
+00B0117E 3589 * found the array and we're not dimensioning it so we must find an element in it
+00B0117E 3590
+00B0117E 6100 FF58 3591 BSR LAB_1DE6 * set data pointer, d0, to the first element
+00B01182 3592 * in the array
+00B01182 5048 3593 ADDQ.w #8,a0 * index to dimension count
+00B01184 3018 3594 MOVE.w (a0)+,d0 * get no of dimensions
+00B01186 B02B 063F 3595 CMP.b Dimcnt(a3),d0 * compare with dimensions count
+00B0118A 6700 0094 3596 BEQ LAB_1F28 * found array so go get element
+00B0118E 3597
+00B0118E 6000 EF8E 3598 BRA LAB_WDER * else wrong so do "Wrong dimensions" error
+00B01192 3599
+00B01192 3600 * array not found, so possibly build it
+00B01192 3601 LAB_1EA1
+00B01192 4A2B 0618 3602 TST.b Defdim(a3) * test the default DIM flag
+00B01196 6700 EF8A 3603 BEQ LAB_UDER * if default flag is clear then we are not
+00B0119A 3604 * explicitly dimensioning an array so go
+00B0119A 3605 * do an "Undimensioned array" error
+00B0119A 3606
+00B0119A 6100 FF3C 3607 BSR LAB_1DE6 * set data pointer, d0, to the first element
+00B0119E 3608 * in the array
+00B0119E 202B 04CE 3609 MOVE.l Varname(a3),d0 * get array name
+00B011A2 20C0 3610 MOVE.l d0,(a0)+ * save array name
+00B011A4 7204 3611 MOVEQ #4,d1 * set 4 bytes per element
+00B011A6 0800 0017 3612 BTST.l #23,d0 * test if string array
+00B011AA 6702 3613 BEQ.s LAB_1EDF * branch if not string
+00B011AC 3614
+00B011AC 7206 3615 MOVEQ #6,d1 * else 6 bytes per element
+00B011AE 3616 LAB_1EDF
+00B011AE 2741 060C 3617 MOVE.l d1,Asptl(a3) * set array data size (bytes per element)
+00B011B2 122B 063F 3618 MOVE.b Dimcnt(a3),d1 * get dimensions count
+00B011B6 5848 3619 ADDQ.w #4,a0 * skip the array size now (don't know it yet!)
+00B011B8 30C1 3620 MOVE.w d1,(a0)+ * set array's dimensions count
+00B011BA 3621
+00B011BA 3622 * now calculate the array data space size
+00B011BA 3623
+00B011BA 3624 LAB_1EC0
+00B011BA 3625
+00B011BA 3626 * If you want arrays to dimension themselves by default then comment out the test
+00B011BA 3627 * above and uncomment the next three code lines and the label LAB_1ED0
+00B011BA 3628
+00B011BA 3629 * MOVE.w #$0A,d1 * set default dimension value, allow 0 to 9
+00B011BA 3630 * TST.b Defdim(a3) * test default DIM flag
+00B011BA 3631 * BNE.s LAB_1ED0 * branch if b6 of Defdim is clear
+00B011BA 3632
+00B011BA 321F 3633 MOVE.w (sp)+,d1 * get dimension size
+00B011BC 3634 *LAB_1ED0
+00B011BC 30C1 3635 MOVE.w d1,(a0)+ * save to array header
+00B011BE 6100 00AE 3636 BSR LAB_1F7C * do this dimension size+1 * array size
+00B011C2 3637 * (d1+1)*(Asptl), result in d0
+00B011C2 2740 060C 3638 MOVE.l d0,Asptl(a3) * save array data size
+00B011C6 532B 063F 3639 SUBQ.b #1,Dimcnt(a3) * decrement dimensions count
+00B011CA 66EE 3640 BNE.s LAB_1EC0 * loop while not = 0
+00B011CC 3641
+00B011CC D1EB 060C 3642 ADDA.l Asptl(a3),a0 * add size to first element address
+00B011D0 6500 EF84 3643 BCS LAB_OMER * if overflow go do "Out of memory" error
+00B011D4 3644
+00B011D4 B1EB 04AA 3645 CMPA.l Sstorl(a3),a0 * compare with bottom of string memory
+00B011D8 650C 3646 BCS.s LAB_1ED6 * branch if less (is ok)
+00B011DA 3647
+00B011DA 6100 028E 3648 BSR LAB_GARB * do garbage collection routine
+00B011DE B1EB 04AA 3649 CMPA.l Sstorl(a3),a0 * compare with bottom of string memory
+00B011E2 6400 EF72 3650 BCC LAB_OMER * if Sstorl <= a0 do "Out of memory"
+00B011E6 3651 * error then warm start
+00B011E6 3652
+00B011E6 3653 LAB_1ED6 * ok exit, carry set
+00B011E6 2748 04A6 3654 MOVE.l a0,Earryl(a3) * save array mem end
+00B011EA 7000 3655 MOVEQ #0,d0 * zero d0
+00B011EC 222B 060C 3656 MOVE.l Asptl(a3),d1 * get size in bytes
+00B011F0 E289 3657 LSR.l #1,d1 * /2 for word fill (may be odd # words)
+00B011F2 5341 3658 SUBQ.w #1,d1 * adjust for DBF loop
+00B011F4 3659 LAB_1ED8
+00B011F4 3100 3660 MOVE.w d0,-(a0) * decrement pointer and clear word
+00B011F6 51C9 FFFC 3661 DBF d1,LAB_1ED8 * decrement & loop until low word done
+00B011FA 3662
+00B011FA 4841 3663 SWAP d1 * swap words
+00B011FC 4A41 3664 TST.w d1 * test high word
+00B011FE 6706 3665 BEQ.s LAB_1F07 * exit if done
+00B01200 3666
+00B01200 5341 3667 SUBQ.w #1,d1 * decrement low (high) word
+00B01202 4841 3668 SWAP d1 * swap back
+00B01204 60EE 3669 BRA.s LAB_1ED8 * go do a whole block
+00B01206 3670
+00B01206 3671 * now we need to calculate the array size by doing Earryl - Astrtl
+00B01206 3672
+00B01206 3673 LAB_1F07
+00B01206 206B 0610 3674 MOVEA.l Astrtl(a3),a0 * get for calculation and as pointer
+00B0120A 202B 04A6 3675 MOVE.l Earryl(a3),d0 * get array memory end
+00B0120E 9088 3676 SUB.l a0,d0 * calculate array size
+00B01210 2140 0004 3677 MOVE.l d0,4(a0) * save size to array
+00B01214 4A2B 0618 3678 TST.b Defdim(a3) * test default DIM flag
+00B01218 6652 3679 BNE.s RTS_011 * exit (RET) if this was a DIM command
+00B0121A 3680
+00B0121A 3681 * else, find element
+00B0121A 5048 3682 ADDQ.w #8,a0 * index to dimension count
+00B0121C 3758 063F 3683 MOVE.w (a0)+,Dimcnt(a3) * get array's dimension count
+00B01220 3684
+00B01220 3685 * we have found, or built, the array. now we need to find the element
+00B01220 3686
+00B01220 3687 LAB_1F28
+00B01220 7000 3688 MOVEQ #0,d0 * clear first result
+00B01222 2740 060C 3689 MOVE.l d0,Asptl(a3) * clear array data pointer
+00B01226 3690
+00B01226 3691 * compare nth dimension bound (a0) with nth index (sp)+
+00B01226 3692 * if greater do array bounds error
+00B01226 3693
+00B01226 3694 LAB_1F2C
+00B01226 3218 3695 MOVE.w (a0)+,d1 * get nth dimension bound
+00B01228 B257 3696 CMP.w (sp),d1 * compare nth index with nth dimension bound
+00B0122A 6500 EF22 3697 BCS LAB_ABER * if d1 less or = do array bounds error
+00B0122E 3698
+00B0122E 3699 * now do pointer = pointer * nth dimension + nth index
+00B0122E 3700
+00B0122E 4A80 3701 TST.l d0 * test pointer
+00B01230 6702 3702 BEQ.s LAB_1F5A * skip multiply if last result = null
+00B01232 3703
+00B01232 613A 3704 BSR.s LAB_1F7C * do this dimension size+1 * array size
+00B01234 3705 LAB_1F5A
+00B01234 7200 3706 MOVEQ #0,d1 * clear longword
+00B01236 321F 3707 MOVE.w (sp)+,d1 * get nth dimension index
+00B01238 D081 3708 ADD.l d1,d0 * add index to size
+00B0123A 2740 060C 3709 MOVE.l d0,Asptl(a3) * save array data pointer
+00B0123E 3710
+00B0123E 532B 063F 3711 SUBQ.b #1,Dimcnt(a3) * decrement dimensions count
+00B01242 66E2 3712 BNE.s LAB_1F2C * loop if dimensions still to do
+00B01244 3713
+00B01244 177C 0000 0619 3714 MOVE.b #0,Dtypef(a3) * set data type to float
+00B0124A 7203 3715 MOVEQ #3,d1 * set for numeric array
+00B0124C 4A2B 04CF 3716 TST.b Varname+1(a3) * test if string array
+00B01250 6A0A 3717 BPL.s LAB_1F6A * branch if not string
+00B01252 3718
+00B01252 7205 3719 MOVEQ #5,d1 * else set for string array
+00B01254 177C 0080 0619 3720 MOVE.b #$80,Dtypef(a3) * and set data type to string
+00B0125A 600C 3721 BRA.s LAB_1F6B * skip integer test
+00B0125C 3722
+00B0125C 3723 LAB_1F6A
+00B0125C 4A2B 04D0 3724 TST.b Varname+2(a3) * test if integer array
+00B01260 6A06 3725 BPL.s LAB_1F6B * branch if not integer
+00B01262 3726
+00B01262 177C 0040 0619 3727 MOVE.b #$40,Dtypef(a3) * else set data type to integer
+00B01268 3728 LAB_1F6B
+00B01268 6104 3729 BSR.s LAB_1F7C * do element size (d1) * array size (Asptl)
+00B0126A D1C0 3730 ADDA.l d0,a0 * add array data start pointer
+00B0126C 3731 RTS_011
+00B0126C 4E75 3732 RTS
+00B0126E 3733
+00B0126E 3734
+00B0126E 3735 *************************************************************************************
+00B0126E 3736 *
+00B0126E 3737 * do this dimension size (d1) * array data size (Asptl)
+00B0126E 3738
+00B0126E 3739 * do a 16 x 32 bit multiply
+00B0126E 3740 * d1 holds the 16 bit multiplier
+00B0126E 3741 * Asptl holds the 32 bit multiplicand
+00B0126E 3742
+00B0126E 3743 * d0 bbbb bbbb
+00B0126E 3744 * d1 0000 aaaa
+00B0126E 3745 * ----------
+00B0126E 3746 * d0 rrrr rrrr
+00B0126E 3747
+00B0126E 3748 LAB_1F7C
+00B0126E 202B 060C 3749 MOVE.l Asptl(a3),d0 * get result
+00B01272 2400 3750 MOVE.l d0,d2 * copy it
+00B01274 4842 3751 SWAP d2 * shift high word to low word
+00B01276 C0C1 3752 MULU.w d1,d0 * d1 * low word = low result
+00B01278 C4C1 3753 MULU.w d1,d2 * d1 * high word = high result
+00B0127A 4842 3754 SWAP d2 * align words for test
+00B0127C 4A42 3755 TST.w d2 * must be zero
+00B0127E 6600 EED6 3756 BNE LAB_OMER * if overflow go do "Out of memory" error
+00B01282 3757
+00B01282 D082 3758 ADD.l d2,d0 * calculate result
+00B01284 6500 EED0 3759 BCS LAB_OMER * if overflow go do "Out of memory" error
+00B01288 3760
+00B01288 D0AB 060C 3761 ADD.l Asptl(a3),d0 * add original
+00B0128C 6500 EEC8 3762 BCS LAB_OMER * if overflow go do "Out of memory" error
+00B01290 3763
+00B01290 4E75 3764 RTS
+00B01292 3765
+00B01292 3766
+00B01292 3767 *************************************************************************************
+00B01292 3768 *
+00B01292 3769 * perform FRE()
+00B01292 3770
+00B01292 3771 LAB_FRE
+00B01292 4A2B 0619 3772 TST.b Dtypef(a3) * test data type, $80=string, $40=integer,
+00B01296 3773 * $00=float
+00B01296 6A04 3774 BPL.s LAB_1FB4 * branch if numeric
+00B01298 3775
+00B01298 6100 0318 3776 BSR LAB_22B6 * pop string off descriptor stack, or from
+00B0129C 3777 * top of string space, returns d0 = length,
+00B0129C 3778 * a0 = pointer
+00B0129C 3779
+00B0129C 3780 * FRE(n) was numeric so do this
+00B0129C 3781 LAB_1FB4
+00B0129C 6100 01CC 3782 BSR LAB_GARB * go do garbage collection
+00B012A0 202B 04AA 3783 MOVE.l Sstorl(a3),d0 * get bottom of string space
+00B012A4 90AB 04A6 3784 SUB.l Earryl(a3),d0 * subtract array mem end
+00B012A8 3785
+00B012A8 3786
+00B012A8 3787 *************************************************************************************
+00B012A8 3788 *
+00B012A8 3789 * convert d0 to signed longword in FAC1
+00B012A8 3790
+00B012A8 3791 LAB_AYFC
+00B012A8 177C 0000 0619 3792 MOVE.b #$00,Dtypef(a3) * clear data type, $80=string, $40=integer,
+00B012AE 3793 * $00=float
+00B012AE 377C A000 05F8 3794 MOVE.w #$A000,FAC1_e(a3) * set FAC1 exponent and clear sign (b7)
+00B012B4 2740 05F4 3795 MOVE.l d0,FAC1_m(a3) * save FAC1 mantissa
+00B012B8 6A00 063E 3796 BPL LAB_24D0 * convert if +ve
+00B012BC 3797
+00B012BC 003C 0001 3798 ORI.b #1,CCR * else set carry
+00B012C0 6000 0636 3799 BRA LAB_24D0 * do +/- (carry is sign) & normalise FAC1
+00B012C4 3800
+00B012C4 3801
+00B012C4 3802 *************************************************************************************
+00B012C4 3803 *
+00B012C4 3804 * remember if the line length is zero (infinite line) then POS(n) will return
+00B012C4 3805 * position MOD tabsize
+00B012C4 3806
+00B012C4 3807 * perform POS()
+00B012C4 3808
+00B012C4 3809 LAB_POS
+00B012C4 102B 0649 3810 MOVE.b TPos(a3),d0 * get terminal position
+00B012C8 3811
+00B012C8 3812 * convert d0 to unsigned byte in FAC1
+00B012C8 3813
+00B012C8 3814 LAB_1FD0
+00B012C8 C0BC 000000FF 3815 AND.l #$FF,d0 * clear high bits
+00B012CE 60D8 3816 BRA.s LAB_AYFC * convert d0 to signed longword in FAC1 & RET
+00B012D0 3817
+00B012D0 3818 * check not direct (used by DEF and INPUT)
+00B012D0 3819
+00B012D0 3820 LAB_CKRN
+00B012D0 4A2B 04B6 3821 TST.b Clinel(a3) * test current line #
+00B012D4 6B00 EE6C 3822 BMI LAB_IDER * if -ve go do illegal direct error then warm
+00B012D8 3823 * start
+00B012D8 3824
+00B012D8 4E75 3825 RTS * can continue so return
+00B012DA 3826
+00B012DA 3827
+00B012DA 3828 *************************************************************************************
+00B012DA 3829 *
+00B012DA 3830 * perform DEF
+00B012DA 3831
+00B012DA 3832 LAB_DEF
+00B012DA 70AB 3833 MOVEQ #TK_FN-$100,d0 * get FN token
+00B012DC 6100 FAC2 3834 BSR LAB_SCCA * scan for CHR$(d0), else syntax error and
+00B012E0 3835 * warm start
+00B012E0 3836 * return character after d0
+00B012E0 177C 0080 0643 3837 MOVE.b #$80,Sufnxf(a3) * set FN flag bit
+00B012E6 6100 FCDA 3838 BSR LAB_1D12 * get FN name
+00B012EA 2748 0614 3839 MOVE.l a0,func_l(a3) * save function pointer
+00B012EE 3840
+00B012EE 61E0 3841 BSR.s LAB_CKRN * check not direct (back here if ok)
+00B012F0 0C1D 0028 3842 CMP.b #$28,(a5)+ * check next byte is "(" and increment
+00B012F4 6600 EE74 3843 BNE LAB_SNER * else do syntax error/warm start
+00B012F8 3844
+00B012F8 177C 007E 0643 3845 MOVE.b #$7E,Sufnxf(a3) * set FN variable flag bits
+00B012FE 6100 FCB4 3846 BSR LAB_SVAR * search for or create a variable
+00B01302 3847 * return the variable address in a0
+00B01302 6100 FA92 3848 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B01306 70BD 3849 MOVEQ #TK_EQUAL-$100,d0 * = token
+00B01308 6100 FA96 3850 BSR LAB_SCCA * scan for CHR$(A), else syntax error/warm start
+00B0130C 3851 * return character after d0
+00B0130C 2F2B 04CE 3852 MOVE.l Varname(a3),-(sp) * push current variable name
+00B01310 2F0D 3853 MOVE.l a5,-(sp) * push BASIC execute pointer
+00B01312 6100 F41A 3854 BSR LAB_DATA * go perform DATA, find end of DEF FN statement
+00B01316 206B 0614 3855 MOVEA.l func_l(a3),a0 * get the function pointer
+00B0131A 209F 3856 MOVE.l (sp)+,(a0) * save BASIC execute pointer to function
+00B0131C 215F 0004 3857 MOVE.l (sp)+,4(a0) * save current variable name to function
+00B01320 4E75 3858 RTS
+00B01322 3859
+00B01322 3860
+00B01322 3861 *************************************************************************************
+00B01322 3862 *
+00B01322 3863 * evaluate FNx
+00B01322 3864
+00B01322 3865 LAB_201E
+00B01322 177C 0081 0643 3866 MOVE.b #$81,Sufnxf(a3) * set FN flag (find not create)
+00B01328 6100 FA7E 3867 BSR LAB_IGBY * increment & scan memory
+00B0132C 6100 FC94 3868 BSR LAB_1D12 * get FN name
+00B01330 1F2B 0619 3869 MOVE.b Dtypef(a3),-(sp) * push data type flag (function type)
+00B01334 2F08 3870 MOVE.l a0,-(sp) * push function pointer
+00B01336 0C15 0028 3871 CMP.b #$28,(a5) * check next byte is "(", no increment
+00B0133A 6600 EE2E 3872 BNE LAB_SNER * else do syntax error/warm start
+00B0133E 3873
+00B0133E 6100 FA52 3874 BSR LAB_1BF7 * evaluate expression within parentheses
+00B01342 205F 3875 MOVEA.l (sp)+,a0 * pop function pointer
+00B01344 2748 0614 3876 MOVE.l a0,func_l(a3) * set function pointer
+00B01348 1F2B 0619 3877 MOVE.b Dtypef(a3),-(sp) * push data type flag (function expression type)
+00B0134C 3878
+00B0134C 2028 0004 3879 MOVE.l 4(a0),d0 * get function variable name
+00B01350 6100 FCDA 3880 BSR LAB_1D4A * go find function variable (already created)
+00B01354 3881
+00B01354 3882 * now check type match for variable
+00B01354 101F 3883 MOVE.b (sp)+,d0 * pop data type flag (function expression type)
+00B01356 E318 3884 ROL.b #1,d0 * set carry if type = string
+00B01358 6100 F8DA 3885 BSR LAB_CKTM * type match check, set C for string
+00B0135C 3886
+00B0135C 3887 * now stack the function variable value before
+00B0135C 3888 * use
+00B0135C 6712 3889 BEQ.s LAB_2043 * branch if not string
+00B0135E 3890
+00B0135E 43EB 04DA 3891 LEA des_sk_e(a3),a1 * get string stack pointer max+1
+00B01362 B9C9 3892 CMPA.l a1,a4 * compare string stack pointer with max+1
+00B01364 6700 EDD0 3893 BEQ LAB_SCER * if no space on the stack go do string too
+00B01368 3894 * complex error
+00B01368 3895
+00B01368 3928 0004 3896 MOVE.w 4(a0),-(a4) * string length on descriptor stack
+00B0136C 2910 3897 MOVE.l (a0),-(a4) * string address on stack
+00B0136E 6002 3898 BRA.s LAB_204S * skip var push
+00B01370 3899
+00B01370 3900 LAB_2043
+00B01370 2F10 3901 MOVE.l (a0),-(sp) * push variable
+00B01372 3902 LAB_204S
+00B01372 2F08 3903 MOVE.l a0,-(sp) * push variable address
+00B01374 1F2B 0619 3904 MOVE.b Dtypef(a3),-(sp) * push variable data type
+00B01378 3905
+00B01378 6132 3906 BSR.s LAB_2045 * pack function expression value into (a0)
+00B0137A 3907 * (function variable)
+00B0137A 2F0D 3908 MOVE.l a5,-(sp) * push BASIC execute pointer
+00B0137C 206B 0614 3909 MOVEA.l func_l(a3),a0 * get function pointer
+00B01380 2A50 3910 MOVEA.l (a0),a5 * save function execute ptr as BASIC execute ptr
+00B01382 6100 F8C4 3911 BSR LAB_EVEX * evaluate expression
+00B01386 6100 FA22 3912 BSR LAB_GBYT * scan memory
+00B0138A 6600 EDDE 3913 BNE LAB_SNER * if not [EOL] or [EOS] do syntax error and
+00B0138E 3914 * warm start
+00B0138E 3915
+00B0138E 2A5F 3916 MOVE.l (sp)+,a5 * restore BASIC execute pointer
+00B01390 3917
+00B01390 3918 * restore variable from stack and test data type
+00B01390 3919
+00B01390 101F 3920 MOVE.b (sp)+,d0 * pull variable data type
+00B01392 205F 3921 MOVEA.l (sp)+,a0 * pull variable address
+00B01394 4A00 3922 TST.b d0 * test variable data type
+00B01396 6A08 3923 BPL.s LAB_204T * branch if not string
+00B01398 3924
+00B01398 209C 3925 MOVE.l (a4)+,(a0) * string address from descriptor stack
+00B0139A 315C 0004 3926 MOVE.w (a4)+,4(a0) * string length from descriptor stack
+00B0139E 6002 3927 BRA.s LAB_2044 * skip variable pull
+00B013A0 3928
+00B013A0 3929 LAB_204T
+00B013A0 209F 3930 MOVE.l (sp)+,(a0) * restore variable from stack
+00B013A2 3931 LAB_2044
+00B013A2 101F 3932 MOVE.b (sp)+,d0 * pop data type flag (function type)
+00B013A4 E318 3933 ROL.b #1,d0 * set carry if type = string
+00B013A6 6100 F88C 3934 BSR LAB_CKTM * type match check, set C for string
+00B013AA 4E75 3935 RTS
+00B013AC 3936
+00B013AC 3937 LAB_2045
+00B013AC 4A2B 0619 3938 TST.b Dtypef(a3) * test data type
+00B013B0 6A00 07EE 3939 BPL LAB_2778 * if numeric pack FAC1 into variable (a0)
+00B013B4 3940 * and return
+00B013B4 3941
+00B013B4 2448 3942 MOVEA.l a0,a2 * copy variable pointer
+00B013B6 6000 F514 3943 BRA LAB_17D6 * go do string LET & return
+00B013BA 3944
+00B013BA 3945
+00B013BA 3946
+00B013BA 3947 *************************************************************************************
+00B013BA 3948 *
+00B013BA 3949 * perform STR$()
+00B013BA 3950
+00B013BA 3951 LAB_STRS
+00B013BA 6100 094A 3952 BSR LAB_2970 * convert FAC1 to string
+00B013BE 3953
+00B013BE 3954 * scan, set up string
+00B013BE 3955 * print " terminated string to FAC1 stack
+00B013BE 3956
+00B013BE 3957 LAB_20AE
+00B013BE 7422 3958 MOVEQ #$22,d2 * set Srchc character (terminator 1)
+00B013C0 3602 3959 MOVE.w d2,d3 * set Asrch character (terminator 2)
+00B013C2 3960
+00B013C2 3961 * print d2/d3 terminated string to FAC1 stack
+00B013C2 3962 * d2 = Srchc, d3 = Asrch, a0 is source
+00B013C2 3963 * a6 is temp
+00B013C2 3964
+00B013C2 3965 LAB_20B4
+00B013C2 7200 3966 MOVEQ #0,d1 * clear longword
+00B013C4 5341 3967 SUBQ.w #1,d1 * set length to -1
+00B013C6 2448 3968 MOVEA.l a0,a2 * copy start to calculate end
+00B013C8 3969 LAB_20BE
+00B013C8 5241 3970 ADDQ.w #1,d1 * increment length
+00B013CA 1030 1000 3971 MOVE.b (a0,d1.w),d0 * get byte from string
+00B013CE 6710 3972 BEQ.s LAB_20D0 * exit loop if null byte [EOS]
+00B013D0 3973
+00B013D0 B002 3974 CMP.b d2,d0 * compare with search character (terminator 1)
+00B013D2 6704 3975 BEQ.s LAB_20CB * branch if terminator
+00B013D4 3976
+00B013D4 B003 3977 CMP.b d3,d0 * compare with terminator 2
+00B013D6 66F0 3978 BNE.s LAB_20BE * loop if not terminator 2 (or null string)
+00B013D8 3979
+00B013D8 3980 LAB_20CB
+00B013D8 B03C 0022 3981 CMP.b #$22,d0 * compare with "
+00B013DC 6602 3982 BNE.s LAB_20D0 * branch if not "
+00B013DE 3983
+00B013DE 524A 3984 ADDQ.w #1,a2 * else increment string start (skip " at end)
+00B013E0 3985 LAB_20D0
+00B013E0 D5C1 3986 ADDA.l d1,a2 * add longowrd length to make string end+1
+00B013E2 3987
+00B013E2 B1CB 3988 CMPA.l a3,a0 * is string in ram
+00B013E4 651E 3989 BCS.s LAB_RTST * if not go push descriptor on stack & exit
+00B013E6 3990 * (could be message string from ROM)
+00B013E6 3991
+00B013E6 B1EB 0492 3992 CMPA.l Smeml(a3),a0 * is string in utility ram
+00B013EA 6418 3993 BCC.s LAB_RTST * if not go push descriptor on stack & exit
+00B013EC 3994 * (is in string or program space)
+00B013EC 3995
+00B013EC 3996 * (else) copy string to string memory
+00B013EC 3997 LAB_20C9
+00B013EC 2248 3998 MOVEA.l a0,a1 * copy descriptor pointer
+00B013EE 2001 3999 MOVE.l d1,d0 * copy longword length
+00B013F0 6604 4000 BNE.s LAB_20D8 * branch if not null string
+00B013F2 4001
+00B013F2 2041 4002 MOVEA.l d1,a0 * make null pointer
+00B013F4 600E 4003 BRA.s LAB_RTST * go push descriptor on stack & exit
+00B013F6 4004
+00B013F6 4005 LAB_20D8
+00B013F6 6126 4006 BSR.s LAB_2115 * make string space d1 bytes long
+00B013F8 D1C1 4007 ADDA.l d1,a0 * new string end
+00B013FA D3C1 4008 ADDA.l d1,a1 * old string end
+00B013FC 5340 4009 SUBQ.w #1,d0 * -1 for DBF loop
+00B013FE 4010 LAB_20E0
+00B013FE 1121 4011 MOVE.b -(a1),-(a0) * copy byte (source can be odd aligned)
+00B01400 51C8 FFFC 4012 DBF d0,LAB_20E0 * loop until done
+00B01404 4013
+00B01404 4014
+00B01404 4015
+00B01404 4016 *************************************************************************************
+00B01404 4017 *
+00B01404 4018 * check for space on descriptor stack then ...
+00B01404 4019 * put string address and length on descriptor stack & update stack pointers
+00B01404 4020 * start is in a0, length is in d1
+00B01404 4021
+00B01404 4022 LAB_RTST
+00B01404 43EB 04DA 4023 LEA des_sk_e(a3),a1 * get string stack pointer max+1
+00B01408 B9C9 4024 CMPA.l a1,a4 * compare string stack pointer with max+1
+00B0140A 6700 ED2A 4025 BEQ LAB_SCER * if no space on string stack ..
+00B0140E 4026 * .. go do 'string too complex' error
+00B0140E 4027
+00B0140E 4028 * push string & update pointers
+00B0140E 3901 4029 MOVE.w d1,-(a4) * string length on descriptor stack
+00B01410 2908 4030 MOVE.l a0,-(a4) * string address on stack
+00B01412 274C 05F4 4031 MOVE.l a4,FAC1_m(a3) * string descriptor pointer in FAC1
+00B01416 177C 0080 0619 4032 MOVE.b #$80,Dtypef(a3) * save data type flag, $80=string
+00B0141C 4E75 4033 RTS
+00B0141E 4034
+00B0141E 4035
+00B0141E 4036 *************************************************************************************
+00B0141E 4037 *
+00B0141E 4038 * build descriptor a0/d1
+00B0141E 4039 * make space in string memory for string d1.w long
+00B0141E 4040 * return pointer in a0/Sutill
+00B0141E 4041
+00B0141E 4042 LAB_2115
+00B0141E 4A41 4043 TST.w d1 * test length
+00B01420 672E 4044 BEQ.s LAB_2128 * branch if user wants null string
+00B01422 4045
+00B01422 4046 * make space for string d1 long
+00B01422 2F00 4047 MOVE.l d0,-(sp) * save d0
+00B01424 7000 4048 MOVEQ #0,d0 * clear longword
+00B01426 1740 0642 4049 MOVE.b d0,Gclctd(a3) * clear garbage collected flag (b7)
+00B0142A 7001 4050 MOVEQ #1,d0 * +1 to possibly round up
+00B0142C C041 4051 AND.w d1,d0 * mask odd bit
+00B0142E D041 4052 ADD.w d1,d0 * ensure d0 is even length
+00B01430 6404 4053 BCC.s LAB_2117 * branch if no overflow
+00B01432 4054
+00B01432 7001 4055 MOVEQ #1,d0 * set to allocate 65536 bytes
+00B01434 4840 4056 SWAP d0 * makes $00010000
+00B01436 4057 LAB_2117
+00B01436 206B 04AA 4058 MOVEA.l Sstorl(a3),a0 * get bottom of string space
+00B0143A 91C0 4059 SUBA.l d0,a0 * subtract string length
+00B0143C B1EB 04A6 4060 CMPA.l Earryl(a3),a0 * compare with top of array space
+00B01440 6512 4061 BCS.s LAB_2137 * if less do out of memory error
+00B01442 4062
+00B01442 2748 04AA 4063 MOVE.l a0,Sstorl(a3) * save bottom of string space
+00B01446 2748 04B2 4064 MOVE.l a0,Sutill(a3) * save string utility pointer
+00B0144A 201F 4065 MOVE.l (sp)+,d0 * restore d0
+00B0144C 4A41 4066 TST.w d1 * set flags on length
+00B0144E 4E75 4067 RTS
+00B01450 4068
+00B01450 4069 LAB_2128
+00B01450 3041 4070 MOVEA.w d1,a0 * make null pointer
+00B01452 4E75 4071 RTS
+00B01454 4072
+00B01454 4073 LAB_2137
+00B01454 4A2B 0642 4074 TST.b Gclctd(a3) * get garbage collected flag
+00B01458 6B00 ECFC 4075 BMI LAB_OMER * do "Out of memory" error, then warm start
+00B0145C 4076
+00B0145C 2F09 4077 MOVE.l a1,-(sp) * save a1
+00B0145E 610A 4078 BSR.s LAB_GARB * else go do garbage collection
+00B01460 225F 4079 MOVEA.l (sp)+,a1 * restore a1
+00B01462 177C 0080 0642 4080 MOVE.b #$80,Gclctd(a3) * set garbage collected flag
+00B01468 60CC 4081 BRA.s LAB_2117 * go try again
+00B0146A 4082
+00B0146A 4083
+00B0146A 4084 *************************************************************************************
+00B0146A 4085 *
+00B0146A 4086 * garbage collection routine
+00B0146A 4087
+00B0146A 4088 LAB_GARB
+00B0146A 48E7 E0E0 4089 MOVEM.l d0-d2/a0-a2,-(sp) * save registers
+00B0146E 276B 04AE 04AA 4090 MOVE.l Ememl(a3),Sstorl(a3) * start with no strings
+00B01474 4091
+00B01474 4092 * re-run routine from last ending
+00B01474 4093 LAB_214B
+00B01474 222B 04A6 4094 MOVE.l Earryl(a3),d1 * set highest uncollected string so far
+00B01478 7000 4095 MOVEQ #0,d0 * clear longword
+00B0147A 2240 4096 MOVEA.l d0,a1 * clear string to move pointer
+00B0147C 206B 049E 4097 MOVEA.l Sstrl(a3),a0 * set pointer to start of strings
+00B01480 41E8 0004 4098 LEA 4(a0),a0 * index to string pointer
+00B01484 246B 04A2 4099 MOVEA.l Sarryl(a3),a2 * set end pointer to start of arrays (end of
+00B01488 4100 * strings)
+00B01488 6008 4101 BRA.s LAB_2176 * branch into loop at end loop test
+00B0148A 4102
+00B0148A 4103 LAB_2161
+00B0148A 6100 0084 4104 BSR LAB_2206 * test and set if this is the highest string
+00B0148E 41E8 000A 4105 LEA 10(a0),a0 * increment to next string
+00B01492 4106 LAB_2176
+00B01492 B1CA 4107 CMPA.l a2,a0 * compare end of area with pointer
+00B01494 65F4 4108 BCS.s LAB_2161 * go do next if not at end
+00B01496 4109
+00B01496 4110 * done strings, now do arrays.
+00B01496 4111
+00B01496 41E8 FFFC 4112 LEA -4(a0),a0 * decrement pointer to start of arrays
+00B0149A 246B 04A6 4113 MOVEA.l Earryl(a3),a2 * set end pointer to end of arrays
+00B0149E 6024 4114 BRA.s LAB_218F * branch into loop at end loop test
+00B014A0 4115
+00B014A0 4116 LAB_217E
+00B014A0 2428 0004 4117 MOVE.l 4(a0),d2 * get array size
+00B014A4 D488 4118 ADD.l a0,d2 * makes start of next array
+00B014A6 4119
+00B014A6 2010 4120 MOVE.l (a0),d0 * get array name
+00B014A8 0800 0017 4121 BTST #23,d0 * test string flag
+00B014AC 6714 4122 BEQ.s LAB_218B * branch if not string
+00B014AE 4123
+00B014AE 3028 0008 4124 MOVE.w 8(a0),d0 * get # of dimensions
+00B014B2 D040 4125 ADD.w d0,d0 * *2
+00B014B4 D0C0 4126 ADDA.w d0,a0 * add to skip dimension size(s)
+00B014B6 41E8 000A 4127 LEA 10(a0),a0 * increment to first element
+00B014BA 4128 LAB_2183
+00B014BA 6154 4129 BSR.s LAB_2206 * test and set if this is the highest string
+00B014BC 5C48 4130 ADDQ.w #6,a0 * increment to next element
+00B014BE B1C2 4131 CMPA.l d2,a0 * compare with start of next array
+00B014C0 66F8 4132 BNE.s LAB_2183 * go do next if not at end of array
+00B014C2 4133
+00B014C2 4134 LAB_218B
+00B014C2 2042 4135 MOVEA.l d2,a0 * pointer to next array
+00B014C4 4136 LAB_218F
+00B014C4 B5C8 4137 CMPA.l a0,a2 * compare pointer with array end
+00B014C6 66D8 4138 BNE.s LAB_217E * go do next if not at end
+00B014C8 4139
+00B014C8 4140 * done arrays and variables, now just the descriptor stack to do
+00B014C8 4141
+00B014C8 204C 4142 MOVEA.l a4,a0 * get descriptor stack pointer
+00B014CA 45EB 04F2 4143 LEA des_sk(a3),a2 * set end pointer to end of stack
+00B014CE 6006 4144 BRA.s LAB_21C4 * branch into loop at end loop test
+00B014D0 4145
+00B014D0 4146 LAB_21C2
+00B014D0 613E 4147 BSR.s LAB_2206 * test and set if this is the highest string
+00B014D2 41E8 0006 4148 LEA 6(a0),a0 * increment to next string
+00B014D6 4149 LAB_21C4
+00B014D6 B5C8 4150 CMPA.l a0,a2 * compare pointer with stack end
+00B014D8 66F6 4151 BNE.s LAB_21C2 * go do next if not at end
+00B014DA 4152
+00B014DA 4153 * descriptor search complete, now either exit or set-up and move string
+00B014DA 4154
+00B014DA 2009 4155 MOVE.l a1,d0 * set the flags (a1 is move string)
+00B014DC 672C 4156 BEQ.s LAB_21D1 * go tidy up and exit if no move
+00B014DE 4157
+00B014DE 2051 4158 MOVEA.l (a1),a0 * a0 is now string start
+00B014E0 7200 4159 MOVEQ #0,d1 * clear d1
+00B014E2 3229 0004 4160 MOVE.w 4(a1),d1 * d1 is string length
+00B014E6 5281 4161 ADDQ.l #1,d1 * +1
+00B014E8 C23C 00FE 4162 AND.b #$FE,d1 * make even length
+00B014EC D1C1 4163 ADDA.l d1,a0 * pointer is now to string end+1
+00B014EE 246B 04AA 4164 MOVEA.l Sstorl(a3),a2 * is destination end+1
+00B014F2 B1CA 4165 CMPA.l a2,a0 * does the string need moving
+00B014F4 670C 4166 BEQ.s LAB_2240 * branch if not
+00B014F6 4167
+00B014F6 E289 4168 LSR.l #1,d1 * word move so do /2
+00B014F8 5341 4169 SUBQ.w #1,d1 * -1 for DBF loop
+00B014FA 4170 LAB_2216
+00B014FA 3520 4171 MOVE.w -(a0),-(a2) * copy word
+00B014FC 51C9 FFFC 4172 DBF d1,LAB_2216 * loop until done
+00B01500 4173
+00B01500 228A 4174 MOVE.l a2,(a1) * save new string start
+00B01502 4175 LAB_2240
+00B01502 2751 04AA 4176 MOVE.l (a1),Sstorl(a3) * string start is new string mem start
+00B01506 6000 FF6C 4177 BRA LAB_214B * re-run routine from last ending
+00B0150A 4178 * (but don't collect this string)
+00B0150A 4179
+00B0150A 4180 LAB_21D1
+00B0150A 4CDF 0707 4181 MOVEM.l (sp)+,d0-d2/a0-a2 * restore registers
+00B0150E 4E75 4182 RTS
+00B01510 4183
+00B01510 4184 * test and set if this is the highest string
+00B01510 4185
+00B01510 4186 LAB_2206
+00B01510 2010 4187 MOVE.l (a0),d0 * get this string pointer
+00B01512 6728 4188 BEQ.s RTS_012 * exit if null string
+00B01514 4189
+00B01514 B280 4190 CMP.l d0,d1 * compare with highest uncollected string so far
+00B01516 6424 4191 BCC.s RTS_012 * exit if <= with highest so far
+00B01518 4192
+00B01518 B0AB 04AA 4193 CMP.l Sstorl(a3),d0 * compare with bottom of string space
+00B0151C 641E 4194 BCC.s RTS_012 * exit if >= bottom of string space
+00B0151E 4195
+00B0151E 70FF 4196 MOVEQ #-1,d0 * d0 = $FFFFFFFF
+00B01520 3028 0004 4197 MOVE.w 4(a0),d0 * d0 is string length
+00B01524 4440 4198 NEG.w d0 * make -ve
+00B01526 C03C 00FE 4199 AND.b #$FE,d0 * make -ve even length
+00B0152A D0AB 04AA 4200 ADD.l Sstorl(a3),d0 * add string store to -ve length
+00B0152E B090 4201 CMP.l (a0),d0 * compare with string address
+00B01530 6706 4202 BEQ.s LAB_2212 * if = go move string store pointer down
+00B01532 4203
+00B01532 2210 4204 MOVE.l (a0),d1 * highest = current
+00B01534 2248 4205 MOVEA.l a0,a1 * string to move = current
+00B01536 4E75 4206 RTS
+00B01538 4207
+00B01538 4208 LAB_2212
+00B01538 2740 04AA 4209 MOVE.l d0,Sstorl(a3) * set new string store start
+00B0153C 4210 RTS_012
+00B0153C 4E75 4211 RTS
+00B0153E 4212
+00B0153E 4213
+00B0153E 4214 *************************************************************************************
+00B0153E 4215 *
+00B0153E 4216 * concatenate - add strings
+00B0153E 4217 * string descriptor 1 is in FAC1_m, string 2 is in line
+00B0153E 4218
+00B0153E 4219 LAB_224D
+00B0153E 487A F73A 4220 PEA LAB_1ADB(pc) * continue evaluation after concatenate
+00B01542 2F2B 05F4 4221 MOVE.l FAC1_m(a3),-(sp) * stack descriptor pointer for string 1
+00B01546 4222
+00B01546 6100 F80E 4223 BSR LAB_GVAL * get value from line
+00B0154A 4A2B 0619 4224 TST.b Dtypef(a3) * test data type flag
+00B0154E 6A00 EBEE 4225 BPL LAB_TMER * if type is not string do type mismatch error
+00B01552 4226
+00B01552 205F 4227 MOVEA.l (sp)+,a0 * restore descriptor pointer for string 1
+00B01554 4228
+00B01554 4229 *************************************************************************************
+00B01554 4230 *
+00B01554 4231 * concatenate
+00B01554 4232 * string descriptor 1 is in a0, string descriptor 2 is in FAC1_m
+00B01554 4233
+00B01554 4234 LAB_224E
+00B01554 226B 05F4 4235 MOVEA.l FAC1_m(a3),a1 * copy descriptor pointer 2
+00B01558 3228 0004 4236 MOVE.w 4(a0),d1 * get length 1
+00B0155C D269 0004 4237 ADD.w 4(a1),d1 * add length 2
+00B01560 6500 EBD8 4238 BCS LAB_SLER * if overflow go do 'string too long' error
+00B01564 4239
+00B01564 2F08 4240 MOVE.l a0,-(sp) * save descriptor pointer 1
+00B01566 6100 FEB6 4241 BSR LAB_2115 * make space d1 bytes long
+00B0156A 2748 05FC 4242 MOVE.l a0,FAC2_m(a3) * save new string start pointer
+00B0156E 2057 4243 MOVEA.l (sp),a0 * copy descriptor pointer 1 from stack
+00B01570 3028 0004 4244 MOVE.w 4(a0),d0 * get length
+00B01574 2050 4245 MOVEA.l (a0),a0 * get string pointer
+00B01576 6120 4246 BSR.s LAB_229E * copy string d0 bytes long from a0 to Sutill
+00B01578 4247 * return with a0 = pointer, d1 = length
+00B01578 4248
+00B01578 206B 05F4 4249 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer for string 2
+00B0157C 6138 4250 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
+00B0157E 4251 * a0 = pointer, d0 = length
+00B0157E 6118 4252 BSR.s LAB_229E * copy string d0 bytes long from a0 to Sutill
+00B01580 4253 * return with a0 = pointer, d1 = length
+00B01580 4254
+00B01580 205F 4255 MOVEA.l (sp)+,a0 * get descriptor pointer for string 1
+00B01582 6132 4256 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
+00B01584 4257 * d0 = length, a0 = pointer
+00B01584 4258
+00B01584 206B 05FC 4259 MOVEA.l FAC2_m(a3),a0 * retreive the result string pointer
+00B01588 2208 4260 MOVE.l a0,d1 * copy the result string pointer
+00B0158A 6700 FE78 4261 BEQ LAB_RTST * if it is a null string just return it
+00B0158E 4262 * a0 = pointer, d1 = length
+00B0158E 4263
+00B0158E 4481 4264 NEG.l d1 * else make the start pointer negative
+00B01590 D2AB 04B2 4265 ADD.l Sutill(a3),d1 * add the end pointert to give the length
+00B01594 6000 FE6E 4266 BRA LAB_RTST * push string on descriptor stack
+00B01598 4267 * a0 = pointer, d1 = length
+00B01598 4268
+00B01598 4269
+00B01598 4270 *************************************************************************************
+00B01598 4271 *
+00B01598 4272 * copy string d0 bytes long from a0 to Sutill
+00B01598 4273 * return with a0 = pointer, d1 = length
+00B01598 4274
+00B01598 4275 LAB_229E
+00B01598 3200 4276 MOVE.w d0,d1 * copy and check length
+00B0159A 6714 4277 BEQ.s RTS_013 * skip copy if null
+00B0159C 4278
+00B0159C 226B 04B2 4279 MOVEA.l Sutill(a3),a1 * get destination pointer
+00B015A0 2F09 4280 MOVE.l a1,-(sp) * save destination string pointer
+00B015A2 5340 4281 SUBQ.w #1,d0 * subtract for DBF loop
+00B015A4 4282 LAB_22A0
+00B015A4 12D8 4283 MOVE.b (a0)+,(a1)+ * copy byte
+00B015A6 51C8 FFFC 4284 DBF d0,LAB_22A0 * loop if not done
+00B015AA 4285
+00B015AA 2749 04B2 4286 MOVE.l a1,Sutill(a3) * update Sutill to end of copied string
+00B015AE 205F 4287 MOVEA.l (sp)+,a0 * restore destination string pointer
+00B015B0 4288 RTS_013
+00B015B0 4E75 4289 RTS
+00B015B2 4290
+00B015B2 4291
+00B015B2 4292 *************************************************************************************
+00B015B2 4293 *
+00B015B2 4294 * pop string off descriptor stack, or from top of string space
+00B015B2 4295 * returns with d0.l = length, a0 = pointer
+00B015B2 4296
+00B015B2 4297 LAB_22B6
+00B015B2 206B 05F4 4298 MOVEA.l FAC1_m(a3),a0 * get descriptor pointer
+00B015B6 4299
+00B015B6 4300
+00B015B6 4301 *************************************************************************************
+00B015B6 4302 *
+00B015B6 4303 * pop (a0) descriptor off stack or from string space
+00B015B6 4304 * returns with d0.l = length, a0 = pointer
+00B015B6 4305
+00B015B6 4306 LAB_22BA
+00B015B6 48E7 4040 4307 MOVEM.l a1/d1,-(sp) * save other regs
+00B015BA B9C8 4308 CMPA.l a0,a4 * is string on the descriptor stack
+00B015BC 6602 4309 BNE.s LAB_22BD * skip pop if not
+00B015BE 4310
+00B015BE 5C4C 4311 ADDQ.w #$06,a4 * else update stack pointer
+00B015C0 4312 LAB_22BD
+00B015C0 7000 4313 MOVEQ #0,d0 * clear string length longword
+00B015C2 2258 4314 MOVEA.l (a0)+,a1 * get string address
+00B015C4 3018 4315 MOVE.w (a0)+,d0 * get string length
+00B015C6 4316
+00B015C6 B9C8 4317 CMPA.l a0,a4 * was it on the descriptor stack
+00B015C8 6610 4318 BNE.s LAB_22E6 * branch if it wasn't
+00B015CA 4319
+00B015CA B3EB 04AA 4320 CMPA.l Sstorl(a3),a1 * compare string address with bottom of string
+00B015CE 4321 * space
+00B015CE 660A 4322 BNE.s LAB_22E6 * branch if <>
+00B015D0 4323
+00B015D0 7201 4324 MOVEQ #1,d1 * mask for odd bit
+00B015D2 C240 4325 AND.w d0,d1 * AND length
+00B015D4 D280 4326 ADD.l d0,d1 * make it fit word aligned length
+00B015D6 4327
+00B015D6 D3AB 04AA 4328 ADD.l d1,Sstorl(a3) * add to bottom of string space
+00B015DA 4329 LAB_22E6
+00B015DA 2049 4330 MOVEA.l a1,a0 * copy to a0
+00B015DC 4CDF 0202 4331 MOVEM.l (sp)+,a1/d1 * restore other regs
+00B015E0 4A80 4332 TST.l d0 * set flags on length
+00B015E2 4E75 4333 RTS
+00B015E4 4334
+00B015E4 4335
+00B015E4 4336 *************************************************************************************
+00B015E4 4337 *
+00B015E4 4338 * perform CHR$()
+00B015E4 4339
+00B015E4 4340 LAB_CHRS
+00B015E4 6100 0130 4341 BSR LAB_EVBY * evaluate byte expression, result in d0 and
+00B015E8 4342 * Itemp
+00B015E8 4343 LAB_MKCHR
+00B015E8 7201 4344 MOVEQ #1,d1 * string is single byte
+00B015EA 6100 FE32 4345 BSR LAB_2115 * make string space d1 bytes long
+00B015EE 4346 * return a0/Sutill = pointer, others unchanged
+00B015EE 1080 4347 MOVE.b d0,(a0) * save byte in string (byte IS string!)
+00B015F0 6000 FE12 4348 BRA LAB_RTST * push string on descriptor stack
+00B015F4 4349 * a0 = pointer, d1 = length
+00B015F4 4350
+00B015F4 4351
+00B015F4 4352 *************************************************************************************
+00B015F4 4353 *
+00B015F4 4354 * perform LEFT$()
+00B015F4 4355
+00B015F4 4356 * enter with a0 is descriptor, d0 & Itemp is word 1
+00B015F4 4357
+00B015F4 4358 LAB_LEFT
+00B015F4 C141 4359 EXG d0,d1 * word in d1
+00B015F6 6100 F79E 4360 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B015FA 4361
+00B015FA 4A81 4362 TST.l d1 * test returned length
+00B015FC 6722 4363 BEQ.s LAB_231C * branch if null return
+00B015FE 4364
+00B015FE 7000 4365 MOVEQ #0,d0 * clear start offset
+00B01600 B268 0004 4366 CMP.w 4(a0),d1 * compare word parameter with string length
+00B01604 651A 4367 BCS.s LAB_231C * branch if string length > word parameter
+00B01606 4368
+00B01606 6014 4369 BRA.s LAB_2317 * go copy whole string
+00B01608 4370
+00B01608 4371
+00B01608 4372 *************************************************************************************
+00B01608 4373 *
+00B01608 4374 * perform RIGHT$()
+00B01608 4375
+00B01608 4376 * enter with a0 is descriptor, d0 & Itemp is word 1
+00B01608 4377
+00B01608 4378 LAB_RIGHT
+00B01608 C141 4379 EXG d0,d1 * word in d1
+00B0160A 6100 F78A 4380 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B0160E 4381
+00B0160E 4A81 4382 TST.l d1 * test returned length
+00B01610 670E 4383 BEQ.s LAB_231C * branch if null return
+00B01612 4384
+00B01612 3028 0004 4385 MOVE.w 4(a0),d0 * get string length
+00B01616 9081 4386 SUB.l d1,d0 * subtract word
+00B01618 6406 4387 BCC.s LAB_231C * branch if string length > word parameter
+00B0161A 4388
+00B0161A 4389 * else copy whole string
+00B0161A 4390 LAB_2316
+00B0161A 7000 4391 MOVEQ #0,d0 * clear start offset
+00B0161C 4392 LAB_2317
+00B0161C 3228 0004 4393 MOVE.w 4(a0),d1 * else make parameter = length
+00B01620 4394
+00B01620 4395 * get here with ...
+00B01620 4396 * a0 - points to descriptor
+00B01620 4397 * d0 - is offset from string start
+00B01620 4398 * d1 - is required string length
+00B01620 4399
+00B01620 4400 LAB_231C
+00B01620 2248 4401 MOVEA.l a0,a1 * save string descriptor pointer
+00B01622 6100 FDFA 4402 BSR LAB_2115 * make string space d1 bytes long
+00B01626 4403 * return a0/Sutill = pointer, others unchanged
+00B01626 2049 4404 MOVEA.l a1,a0 * restore string descriptor pointer
+00B01628 2F00 4405 MOVE.l d0,-(sp) * save start offset (longword)
+00B0162A 618A 4406 BSR.s LAB_22BA * pop (a0) descriptor, returns with ..
+00B0162C 4407 * d0 = length, a0 = pointer
+00B0162C D1DF 4408 ADDA.l (sp)+,a0 * adjust pointer to start of wanted string
+00B0162E 3001 4409 MOVE.w d1,d0 * length to d0
+00B01630 6100 FF66 4410 BSR LAB_229E * store string d0 bytes long from (a0) to
+00B01634 4411 * (Sutill) return with a0 = pointer,
+00B01634 4412 * d1 = length
+00B01634 6000 FDCE 4413 BRA LAB_RTST * push string on descriptor stack
+00B01638 4414 * a0 = pointer, d1 = length
+00B01638 4415
+00B01638 4416
+00B01638 4417 *************************************************************************************
+00B01638 4418 *
+00B01638 4419 * perform MID$()
+00B01638 4420
+00B01638 4421 * enter with a0 is descriptor, d0 & Itemp is word 1
+00B01638 4422
+00B01638 4423 LAB_MIDS
+00B01638 7E00 4424 MOVEQ #0,d7 * clear longword
+00B0163A 5347 4425 SUBQ.w #1,d7 * set default length = 65535
+00B0163C 2F00 4426 MOVE.l d0,-(sp) * save word 1
+00B0163E 6100 F76A 4427 BSR LAB_GBYT * scan memory
+00B01642 B03C 002C 4428 CMP.b #',',d0 * was it ","
+00B01646 660C 4429 BNE.s LAB_2358 * branch if not "," (skip second byte get)
+00B01648 4430
+00B01648 101D 4431 MOVE.b (a5)+,d0 * increment pointer past ","
+00B0164A 2F08 4432 MOVE.l a0,-(sp) * save descriptor pointer
+00B0164C 6100 00D8 4433 BSR LAB_GTWO * get word parameter, result in d0 and Itemp
+00B01650 205F 4434 MOVEA.l (sp)+,a0 * restore descriptor pointer
+00B01652 2E00 4435 MOVE.l d0,d7 * copy length
+00B01654 4436 LAB_2358
+00B01654 6100 F740 4437 BSR LAB_1BFB * scan for ")", else do syntax error then warm
+00B01658 4438 * start
+00B01658 201F 4439 MOVE.l (sp)+,d0 * restore word 1
+00B0165A 7200 4440 MOVEQ #0,d1 * null length
+00B0165C 5380 4441 SUBQ.l #1,d0 * decrement start index (word 1)
+00B0165E 6B00 EAFE 4442 BMI LAB_FCER * if was null do function call error then warm
+00B01662 4443 * start
+00B01662 4444
+00B01662 B068 0004 4445 CMP.w 4(a0),d0 * compare string length with start index
+00B01666 64B8 4446 BCC.s LAB_231C * if start not in string do null string (d1=0)
+00B01668 4447
+00B01668 2207 4448 MOVE.l d7,d1 * get length back
+00B0166A DE40 4449 ADD.w d0,d7 * d7 now = MID$() end
+00B0166C 6506 4450 BCS.s LAB_2368 * already too long so do RIGHT$ equivalent
+00B0166E 4451
+00B0166E BE68 0004 4452 CMP.w 4(a0),d7 * compare string length with start index+length
+00B01672 65AC 4453 BCS.s LAB_231C * if end in string go do string
+00B01674 4454
+00B01674 4455 LAB_2368
+00B01674 3228 0004 4456 MOVE.w 4(a0),d1 * get string length
+00B01678 9240 4457 SUB.w d0,d1 * subtract start offset
+00B0167A 60A4 4458 BRA.s LAB_231C * go do string (effectively RIGHT$)
+00B0167C 4459
+00B0167C 4460
+00B0167C 4461 *************************************************************************************
+00B0167C 4462 *
+00B0167C 4463 * perform LCASE$()
+00B0167C 4464
+00B0167C 4465 LAB_LCASE
+00B0167C 6100 FF34 4466 BSR LAB_22B6 * pop string off descriptor stack or from memory
+00B01680 4467 * returns with d0 = length, a0 = pointer
+00B01680 2200 4468 MOVE.l d0,d1 * copy the string length
+00B01682 6756 4469 BEQ.s NoString * if null go return a null string
+00B01684 4470
+00B01684 4471 * else copy and change the string
+00B01684 4472
+00B01684 2248 4473 MOVEA.l a0,a1 * copy the string address
+00B01686 6100 FD96 4474 BSR LAB_2115 * make a string space d1 bytes long
+00B0168A D1C1 4475 ADDA.l d1,a0 * new string end
+00B0168C D3C1 4476 ADDA.l d1,a1 * old string end
+00B0168E 3401 4477 MOVE.w d1,d2 * copy length for loop
+00B01690 5342 4478 SUBQ.w #1,d2 * -1 for DBF loop
+00B01692 4479 LC_loop
+00B01692 1021 4480 MOVE.b -(a1),d0 * get byte from string
+00B01694 4481
+00B01694 B03C 005B 4482 CMP.b #$5B,d0 * compare with "Z"+1
+00B01698 640A 4483 BCC.s NoUcase * if > "Z" skip change
+00B0169A 4484
+00B0169A B03C 0041 4485 CMP.b #$41,d0 * compare with "A"
+00B0169E 6504 4486 BCS.s NoUcase * if < "A" skip change
+00B016A0 4487
+00B016A0 0000 0020 4488 ORI.b #$20,d0 * convert upper case to lower case
+00B016A4 4489 NoUcase
+00B016A4 1100 4490 MOVE.b d0,-(a0) * copy upper case byte back to string
+00B016A6 51CA FFEA 4491 DBF d2,LC_loop * decrement and loop if not all done
+00B016AA 4492
+00B016AA 602E 4493 BRA.s NoString * tidy up & exit (branch always)
+00B016AC 4494
+00B016AC 4495
+00B016AC 4496 *************************************************************************************
+00B016AC 4497 *
+00B016AC 4498 * perform UCASE$()
+00B016AC 4499
+00B016AC 4500 LAB_UCASE
+00B016AC 6100 FF04 4501 BSR LAB_22B6 * pop string off descriptor stack or from memory
+00B016B0 4502 * returns with d0 = length, a0 = pointer
+00B016B0 2200 4503 MOVE.l d0,d1 * copy the string length
+00B016B2 6726 4504 BEQ.s NoString * if null go return a null string
+00B016B4 4505
+00B016B4 4506 * else copy and change the string
+00B016B4 4507
+00B016B4 2248 4508 MOVEA.l a0,a1 * copy the string address
+00B016B6 6100 FD66 4509 BSR LAB_2115 * make a string space d1 bytes long
+00B016BA D1C1 4510 ADDA.l d1,a0 * new string end
+00B016BC D3C1 4511 ADDA.l d1,a1 * old string end
+00B016BE 3401 4512 MOVE.w d1,d2 * copy length for loop
+00B016C0 5342 4513 SUBQ.w #1,d2 * -1 for DBF loop
+00B016C2 4514 UC_loop
+00B016C2 1021 4515 MOVE.b -(a1),d0 * get a byte from the string
+00B016C4 4516
+00B016C4 B03C 0061 4517 CMP.b #$61,d0 * compare with "a"
+00B016C8 650A 4518 BCS.s NoLcase * if < "a" skip change
+00B016CA 4519
+00B016CA B03C 007B 4520 CMP.b #$7B,d0 * compare with "z"+1
+00B016CE 6404 4521 BCC.s NoLcase * if > "z" skip change
+00B016D0 4522
+00B016D0 0200 00DF 4523 ANDI.b #$DF,d0 * convert lower case to upper case
+00B016D4 4524 NoLcase
+00B016D4 1100 4525 MOVE.b d0,-(a0) * copy upper case byte back to string
+00B016D6 51CA FFEA 4526 DBF d2,UC_loop * decrement and loop if not all done
+00B016DA 4527
+00B016DA 4528 NoString
+00B016DA 6000 FD28 4529 BRA LAB_RTST * push string on descriptor stack
+00B016DE 4530 * a0 = pointer, d1 = length
+00B016DE 4531
+00B016DE 4532
+00B016DE 4533 *************************************************************************************
+00B016DE 4534 *
+00B016DE 4535 * perform SADD()
+00B016DE 4536
+00B016DE 4537 LAB_SADD
+00B016DE 101D 4538 MOVE.b (a5)+,d0 * increment pointer
+00B016E0 6100 F8D6 4539 BSR LAB_GVAR * get variable address in a0
+00B016E4 6100 F6B0 4540 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B016E8 4A2B 0619 4541 TST.b Dtypef(a3) * test data type flag
+00B016EC 6A00 EA50 4542 BPL LAB_TMER * if numeric do Type missmatch Error
+00B016F0 4543
+00B016F0 4544 * if you want a non existant variable to return a null value then set the novar
+00B016F0 4545 * value at the top of this file to some non zero value
+00B016F0 4546
+00B016F0 FALSE 4547 ifne novar
+00B016F0 4548 endc
+00B016F0 4549
+00B016F0 2010 4550 MOVE.l (a0),d0 * get string address
+00B016F2 6000 FBB4 4551 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B016F6 4552
+00B016F6 4553
+00B016F6 4554 *************************************************************************************
+00B016F6 4555 *
+00B016F6 4556 * perform LEN()
+00B016F6 4557
+00B016F6 4558 LAB_LENS
+00B016F6 487A FBB0 4559 PEA LAB_AYFC(pc) * set return address to convert d0 to signed
+00B016FA 4560 * longword in FAC1
+00B016FA 6000 FEB6 4561 BRA LAB_22B6 * pop string off descriptor stack or from memory
+00B016FE 4562 * returns with d0 = length, a0 = pointer
+00B016FE 4563
+00B016FE 4564
+00B016FE 4565 *************************************************************************************
+00B016FE 4566 *
+00B016FE 4567 * perform ASC()
+00B016FE 4568
+00B016FE 4569 LAB_ASC
+00B016FE 6100 FEB2 4570 BSR LAB_22B6 * pop string off descriptor stack or from memory
+00B01702 4571 * returns with d0 = length, a0 = pointer
+00B01702 4A40 4572 TST.w d0 * test length
+00B01704 6700 EA58 4573 BEQ LAB_FCER * if null do function call error then warm start
+00B01708 4574
+00B01708 1010 4575 MOVE.b (a0),d0 * get first character byte
+00B0170A 6000 FBBC 4576 BRA LAB_1FD0 * convert d0 to unsigned byte in FAC1 & return
+00B0170E 4577
+00B0170E 4578
+00B0170E 4579 *************************************************************************************
+00B0170E 4580 *
+00B0170E 4581 * increment and get byte, result in d0 and Itemp
+00B0170E 4582
+00B0170E 4583 LAB_SGBY
+00B0170E 6100 F698 4584 BSR LAB_IGBY * increment & scan memory
+00B01712 4585
+00B01712 4586
+00B01712 4587 *************************************************************************************
+00B01712 4588 *
+00B01712 4589 * get byte parameter, result in d0 and Itemp
+00B01712 4590
+00B01712 4591 LAB_GTBY
+00B01712 6100 F51C 4592 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B01716 4593 * else do type mismatch
+00B01716 4594
+00B01716 4595
+00B01716 4596 *************************************************************************************
+00B01716 4597 *
+00B01716 4598 * evaluate byte expression, result in d0 and Itemp
+00B01716 4599
+00B01716 4600 LAB_EVBY
+00B01716 6100 F9D4 4601 BSR LAB_EVPI * evaluate positive integer expression
+00B0171A 4602 * result in d0 and Itemp
+00B0171A 7280 4603 MOVEQ #$80,d1 * set mask/2
+00B0171C D281 4604 ADD.l d1,d1 * =$FFFFFF00
+00B0171E C280 4605 AND.l d0,d1 * check top 24 bits
+00B01720 6600 EA3C 4606 BNE LAB_FCER * if <> 0 do function call error/warm start
+00B01724 4607
+00B01724 4E75 4608 RTS
+00B01726 4609
+00B01726 4610
+00B01726 4611 *************************************************************************************
+00B01726 4612 *
+00B01726 4613 * get word parameter, result in d0 and Itemp
+00B01726 4614
+00B01726 4615 LAB_GTWO
+00B01726 6100 F508 4616 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B0172A 4617 * else do type mismatch
+00B0172A 6100 F9C0 4618 BSR LAB_EVPI * evaluate positive integer expression
+00B0172E 4619 * result in d0 and Itemp
+00B0172E 4840 4620 SWAP d0 * copy high word to low word
+00B01730 4A40 4621 TST.w d0 * set flags
+00B01732 6600 EA2A 4622 BNE LAB_FCER * if <> 0 do function call error/warm start
+00B01736 4623
+00B01736 4840 4624 SWAP d0 * copy high word to low word
+00B01738 4E75 4625 RTS
+00B0173A 4626
+00B0173A 4627
+00B0173A 4628 *************************************************************************************
+00B0173A 4629 *
+00B0173A 4630 * perform VAL()
+00B0173A 4631
+00B0173A 4632 LAB_VAL
+00B0173A 6100 FE76 4633 BSR LAB_22B6 * pop string off descriptor stack or from memory
+00B0173E 4634 * returns with d0 = length, a0 = pointer
+00B0173E 6722 4635 BEQ.s LAB_VALZ * string was null so set result = $00
+00B01740 4636 * clear FAC1 exponent & sign & return
+00B01740 4637
+00B01740 2C4D 4638 MOVEA.l a5,a6 * save BASIC execute pointer
+00B01742 2A48 4639 MOVEA.l a0,a5 * copy string pointer to execute pointer
+00B01744 D1C0 4640 ADDA.l d0,a0 * string end+1
+00B01746 1010 4641 MOVE.b (a0),d0 * get byte from string+1
+00B01748 3F00 4642 MOVE.w d0,-(sp) * save it
+00B0174A 2F08 4643 MOVE.l a0,-(sp) * save address
+00B0174C 10BC 0000 4644 MOVE.b #0,(a0) * null terminate string
+00B01750 6100 F658 4645 BSR LAB_GBYT * scan memory
+00B01754 6100 1142 4646 BSR LAB_2887 * get FAC1 from string
+00B01758 205F 4647 MOVEA.l (sp)+,a0 * restore pointer
+00B0175A 301F 4648 MOVE.w (sp)+,d0 * pop byte
+00B0175C 1080 4649 MOVE.b d0,(a0) * restore to memory
+00B0175E 2A4E 4650 MOVEA.l a6,a5 * restore BASIC execute pointer
+00B01760 4E75 4651 RTS
+00B01762 4652
+00B01762 4653 LAB_VALZ
+00B01762 3740 05F8 4654 MOVE.w d0,FAC1_e(a3) * clear FAC1 exponent & sign
+00B01766 4E75 4655 RTS
+00B01768 4656
+00B01768 4657
+00B01768 4658 *************************************************************************************
+00B01768 4659 *
+00B01768 4660 * get two parameters for POKE or WAIT, first parameter in a0, second in d0
+00B01768 4661
+00B01768 4662 LAB_GADB
+00B01768 6100 F4C6 4663 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B0176C 4664 * else do type mismatch
+00B0176C 6100 F986 4665 BSR LAB_EVIR * evaluate integer expression
+00B01770 4666 * (does FC error not OF error if out of range)
+00B01770 2F00 4667 MOVE.l d0,-(sp) * copy to stack
+00B01772 6100 F62A 4668 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
+00B01776 619A 4669 BSR.s LAB_GTBY * get byte parameter, result in d0 and Itemp
+00B01778 205F 4670 MOVEA.l (sp)+,a0 * pull address
+00B0177A 4E75 4671 RTS
+00B0177C 4672
+00B0177C 4673
+00B0177C 4674 *************************************************************************************
+00B0177C 4675 *
+00B0177C 4676 * get two parameters for DOKE or WAITW, first parameter in a0, second in d0
+00B0177C 4677
+00B0177C 4678 LAB_GADW
+00B0177C 611E 4679 BSR.s LAB_GEAD * get even address for word/long memory actions
+00B0177E 4680 * address returned in d0 and on the stack
+00B0177E 6100 F61E 4681 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
+00B01782 6100 F4AC 4682 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B01786 4683 * else do type mismatch
+00B01786 6100 F96C 4684 BSR LAB_EVIR * evaluate integer expression
+00B0178A 4685 * result in d0 and Itemp
+00B0178A 4840 4686 SWAP d0 * swap words
+00B0178C 4A40 4687 TST.w d0 * test high word
+00B0178E 6706 4688 BEQ.s LAB_XGADW * exit if null
+00B01790 4689
+00B01790 5240 4690 ADDQ.w #1,d0 * increment word
+00B01792 6600 E9CA 4691 BNE LAB_FCER * if <> 0 do function call error/warm start
+00B01796 4692
+00B01796 4693 LAB_XGADW
+00B01796 4840 4694 SWAP d0 * swap words back
+00B01798 205F 4695 MOVEA.l (sp)+,a0 * pull address
+00B0179A 4E75 4696 RTS
+00B0179C 4697
+00B0179C 4698
+00B0179C 4699 *************************************************************************************
+00B0179C 4700 *
+00B0179C 4701 * get even address (for word or longword memory actions)
+00B0179C 4702 * address returned in d0 and on the stack
+00B0179C 4703 * does address error if the address is odd
+00B0179C 4704
+00B0179C 4705 LAB_GEAD
+00B0179C 6100 F492 4706 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B017A0 4707 * else do type mismatch
+00B017A0 6100 F952 4708 BSR LAB_EVIR * evaluate integer expression
+00B017A4 4709 * (does FC error not OF error if out of range)
+00B017A4 0800 0000 4710 BTST #0,d0 * test low bit of longword
+00B017A8 6600 E970 4711 BNE LAB_ADER * if address is odd do address error/warm start
+00B017AC 4712
+00B017AC 2057 4713 MOVEA.l (sp),a0 * copy return address
+00B017AE 2E80 4714 MOVE.l d0,(sp) * even address on stack
+00B017B0 4ED0 4715 JMP (a0) * effectively RTS
+00B017B2 4716
+00B017B2 4717
+00B017B2 4718 *************************************************************************************
+00B017B2 4719 *
+00B017B2 4720 * perform PEEK()
+00B017B2 4721
+00B017B2 4722 LAB_PEEK
+00B017B2 6100 F940 4723 BSR LAB_EVIR * evaluate integer expression
+00B017B6 4724 * (does FC error not OF error if out of range)
+00B017B6 2040 4725 MOVEA.l d0,a0 * copy to address register
+00B017B8 1010 4726 MOVE.b (a0),d0 * get byte
+00B017BA 6000 FB0C 4727 BRA LAB_1FD0 * convert d0 to unsigned byte in FAC1 & return
+00B017BE 4728
+00B017BE 4729
+00B017BE 4730 *************************************************************************************
+00B017BE 4731 *
+00B017BE 4732 * perform POKE
+00B017BE 4733
+00B017BE 4734 LAB_POKE
+00B017BE 61A8 4735 BSR.s LAB_GADB * get two parameters for POKE or WAIT
+00B017C0 4736 * first parameter in a0, second in d0
+00B017C0 1080 4737 MOVE.b d0,(a0) * put byte in memory
+00B017C2 4E75 4738 RTS
+00B017C4 4739
+00B017C4 4740
+00B017C4 4741 *************************************************************************************
+00B017C4 4742 *
+00B017C4 4743 * perform DEEK()
+00B017C4 4744
+00B017C4 4745 LAB_DEEK
+00B017C4 6100 F92E 4746 BSR LAB_EVIR * evaluate integer expression
+00B017C8 4747 * (does FC error not OF error if out of range)
+00B017C8 E208 4748 LSR.b #1,d0 * shift bit 0 to carry
+00B017CA 6500 E94E 4749 BCS LAB_ADER * if address is odd do address error/warm start
+00B017CE 4750
+00B017CE D000 4751 ADD.b d0,d0 * shift byte back
+00B017D0 C188 4752 EXG d0,a0 * copy to address register
+00B017D2 7000 4753 MOVEQ #0,d0 * clear top bits
+00B017D4 3010 4754 MOVE.w (a0),d0 * get word
+00B017D6 6000 FAD0 4755 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B017DA 4756
+00B017DA 4757
+00B017DA 4758 *************************************************************************************
+00B017DA 4759 *
+00B017DA 4760 * perform LEEK()
+00B017DA 4761
+00B017DA 4762 LAB_LEEK
+00B017DA 6100 F918 4763 BSR LAB_EVIR * evaluate integer expression
+00B017DE 4764 * (does FC error not OF error if out of range)
+00B017DE E208 4765 LSR.b #1,d0 * shift bit 0 to carry
+00B017E0 6500 E938 4766 BCS LAB_ADER * if address is odd do address error/warm start
+00B017E4 4767
+00B017E4 D000 4768 ADD.b d0,d0 * shift byte back
+00B017E6 C188 4769 EXG d0,a0 * copy to address register
+00B017E8 2010 4770 MOVE.l (a0),d0 * get longword
+00B017EA 6000 FABC 4771 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B017EE 4772
+00B017EE 4773
+00B017EE 4774 *************************************************************************************
+00B017EE 4775 *
+00B017EE 4776 * perform DOKE
+00B017EE 4777
+00B017EE 4778 LAB_DOKE
+00B017EE 618C 4779 BSR.s LAB_GADW * get two parameters for DOKE or WAIT
+00B017F0 4780 * first parameter in a0, second in d0
+00B017F0 3080 4781 MOVE.w d0,(a0) * put word in memory
+00B017F2 4E75 4782 RTS
+00B017F4 4783
+00B017F4 4784
+00B017F4 4785 *************************************************************************************
+00B017F4 4786 *
+00B017F4 4787 * perform LOKE
+00B017F4 4788
+00B017F4 4789 LAB_LOKE
+00B017F4 61A6 4790 BSR.s LAB_GEAD * get even address for word/long memory actions
+00B017F6 4791 * address returned in d0 and on the stack
+00B017F6 6100 F5A6 4792 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
+00B017FA 6100 F434 4793 BSR LAB_EVNM * evaluate expression & check is numeric,
+00B017FE 4794 * else do type mismatch
+00B017FE 6100 F8F4 4795 BSR LAB_EVIR * evaluate integer value (no sign check)
+00B01802 205F 4796 MOVEA.l (sp)+,a0 * pull address
+00B01804 2080 4797 MOVE.l d0,(a0) * put longword in memory
+00B01806 4798 RTS_015
+00B01806 4E75 4799 RTS
+00B01808 4800
+00B01808 4801
+00B01808 4802 *************************************************************************************
+00B01808 4803 *
+00B01808 4804 * perform SWAP
+00B01808 4805
+00B01808 4806 LAB_SWAP
+00B01808 6100 F7AE 4807 BSR LAB_GVAR * get variable 1 address in a0
+00B0180C 2F08 4808 MOVE.l a0,-(sp) * save variable 1 address
+00B0180E 182B 0619 4809 MOVE.b Dtypef(a3),d4 * copy variable 1 data type, $80=string,
+00B01812 4810 * $40=inetger, $00=float
+00B01812 4811
+00B01812 6100 F58A 4812 BSR LAB_1C01 * scan for ",", else do syntax error/warm start
+00B01816 6100 F7A0 4813 BSR LAB_GVAR * get variable 2 address in a0
+00B0181A 245F 4814 MOVEA.l (sp)+,a2 * restore variable 1 address
+00B0181C B82B 0619 4815 CMP.b Dtypef(a3),d4 * compare variable 1 data type with variable 2
+00B01820 4816 * data type
+00B01820 6600 E91C 4817 BNE LAB_TMER * if not both the same type do "Type mismatch"
+00B01824 4818 * error then warm start
+00B01824 4819
+00B01824 4820 * if you do want a non existant variable to return an error then leave the novar
+00B01824 4821 * value at the top of this file set to zero
+00B01824 4822
+00B01824 TRUE 4823 ifeq novar
+00B01824 4824
+00B01824 2010 4825 MOVE.l (a0),d0 * get variable 2
+00B01826 20D2 4826 MOVE.l (a2),(a0)+ * copy variable 1 to variable 2
+00B01828 24C0 4827 MOVE.l d0,(a2)+ * save variable 2 to variable 1
+00B0182A 4828
+00B0182A 4A04 4829 TST.b d4 * check data type
+00B0182C 6AD8 4830 BPL.s RTS_015 * exit if not string
+00B0182E 4831
+00B0182E 3010 4832 MOVE.w (a0),d0 * get string 2 length
+00B01830 3092 4833 MOVE.w (a2),(a0) * copy string 1 length to string 2 length
+00B01832 3480 4834 MOVE.w d0,(a2) * save string 2 length to string 1 length
+00B01834 4835
+00B01834 4836 endc
+00B01834 4837
+00B01834 4838
+00B01834 4839 * if you want a non existant variable to return a null value then set the novar
+00B01834 4840 * value at the top of this file to some non zero value
+00B01834 4841
+00B01834 FALSE 4842 ifne novar
+00B01834 4843 * value get
+00B01834 4844 * value get and the new value save
+00B01834 4845 * new length save
+00B01834 4846 * new value save
+00B01834 4847 endc
+00B01834 4848
+00B01834 4E75 4849 RTS
+00B01836 4850
+00B01836 4851
+00B01836 4852 *************************************************************************************
+00B01836 4853 *
+00B01836 4854 * perform USR
+00B01836 4855
+00B01836 4856 LAB_USR
+00B01836 4EAB 046A 4857 JSR Usrjmp(a3) * do user vector
+00B0183A 6000 F55A 4858 BRA LAB_1BFB * scan for ")", else do syntax error/warm start
+00B0183E 4859
+00B0183E 4860
+00B0183E 4861 *************************************************************************************
+00B0183E 4862 *
+00B0183E 4863 * perform LOAD
+00B0183E 4864
+00B0183E 4865 LAB_LOAD
+00B0183E 4EEB 047C 4866 JMP V_LOAD(a3) * do load vector
+00B01842 4867
+00B01842 4868
+00B01842 4869 *************************************************************************************
+00B01842 4870 *
+00B01842 4871 * perform SAVE
+00B01842 4872
+00B01842 4873 LAB_SAVE
+00B01842 4EEB 0482 4874 JMP V_SAVE(a3) * do save vector
+00B01846 4875
+00B01846 4876
+00B01846 4877 *************************************************************************************
+00B01846 4878 *
+00B01846 4879 * perform CALL
+00B01846 4880
+00B01846 4881 LAB_CALL
+00B01846 487A F562 4882 PEA LAB_GBYT(pc) * put return address on stack
+00B0184A 6100 FF50 4883 BSR LAB_GEAD * get even address for word/long memory actions
+00B0184E 4884 * address returned in d0 and on the stack
+00B0184E 4E75 4885 RTS * effectively calls the routine
+00B01850 4886
+00B01850 4887 * if the called routine exits correctly then it will return via the get byte routine.
+00B01850 4888 * this will then get the next byte for the interpreter and return
+00B01850 4889
+00B01850 4890
+00B01850 4891 *************************************************************************************
+00B01850 4892 *
+00B01850 4893 * perform WAIT
+00B01850 4894
+00B01850 4895 LAB_WAIT
+00B01850 6100 FF16 4896 BSR LAB_GADB * get two parameters for POKE or WAIT
+00B01854 4897 * first parameter in a0, second in d0
+00B01854 2F08 4898 MOVE.l a0,-(sp) * save address
+00B01856 3F00 4899 MOVE.w d0,-(sp) * save byte
+00B01858 7400 4900 MOVEQ #0,d2 * clear mask
+00B0185A 6100 F54E 4901 BSR LAB_GBYT * scan memory
+00B0185E 6706 4902 BEQ.s LAB_2441 * skip if no third argument
+00B01860 4903
+00B01860 6100 F538 4904 BSR LAB_SCGB * scan for "," & get byte,
+00B01864 4905 * else do syntax error/warm start
+00B01864 2400 4906 MOVE.l d0,d2 * copy mask
+00B01866 4907 LAB_2441
+00B01866 321F 4908 MOVE.w (sp)+,d1 * get byte
+00B01868 205F 4909 MOVEA.l (sp)+,a0 * get address
+00B0186A 4910 LAB_2445
+00B0186A 1010 4911 MOVE.b (a0),d0 * read memory byte
+00B0186C B500 4912 EOR.b d2,d0 * EOR with second argument (mask)
+00B0186E C001 4913 AND.b d1,d0 * AND with first argument (byte)
+00B01870 67F8 4914 BEQ.s LAB_2445 * loop if result is zero
+00B01872 4915
+00B01872 4E75 4916 RTS
+00B01874 4917
+00B01874 4918
+00B01874 4919 *************************************************************************************
+00B01874 4920 *
+00B01874 4921 * perform subtraction, FAC1 from FAC2
+00B01874 4922
+00B01874 4923 LAB_SUBTRACT
+00B01874 0A2B 0080 05F9 4924 EORI.b #$80,FAC1_s(a3) * complement FAC1 sign
+00B0187A 176B 0601 0602 4925 MOVE.b FAC2_s(a3),FAC_sc(a3) * copy FAC2 sign byte
+00B01880 4926
+00B01880 102B 05F9 4927 MOVE.b FAC1_s(a3),d0 * get FAC1 sign byte
+00B01884 B12B 0602 4928 EOR.b d0,FAC_sc(a3) * EOR with FAC2 sign
+00B01888 4929
+00B01888 4930
+00B01888 4931 *************************************************************************************
+00B01888 4932 *
+00B01888 4933 * add FAC2 to FAC1
+00B01888 4934
+00B01888 4935 LAB_ADD
+00B01888 102B 05F8 4936 MOVE.b FAC1_e(a3),d0 * get exponent
+00B0188C 6700 0338 4937 BEQ LAB_279B * FAC1 was zero so copy FAC2 to FAC1 & return
+00B01890 4938
+00B01890 4939 * FAC1 is non zero
+00B01890 41EB 05FC 4940 LEA FAC2_m(a3),a0 * set pointer1 to FAC2 mantissa
+00B01894 102B 0600 4941 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
+00B01898 6746 4942 BEQ.s RTS_016 * exit if zero
+00B0189A 4943
+00B0189A 902B 05F8 4944 SUB.b FAC1_e(a3),d0 * subtract FAC1 exponent
+00B0189E 6722 4945 BEQ.s LAB_24A8 * branch if = (go add mantissa)
+00B018A0 4946
+00B018A0 650A 4947 BCS.s LAB_249C * branch if FAC2 < FAC1
+00B018A2 4948
+00B018A2 4949 * FAC2 > FAC1
+00B018A2 376B 0600 05F8 4950 MOVE.w FAC2_e(a3),FAC1_e(a3) * copy sign and exponent of FAC2
+00B018A8 4400 4951 NEG.b d0 * negate exponent difference (make diff -ve)
+00B018AA 5148 4952 SUBQ.w #8,a0 * pointer1 to FAC1
+00B018AC 4953
+00B018AC 4954 LAB_249C
+00B018AC 4400 4955 NEG.b d0 * negate exponent difference (make diff +ve)
+00B018AE 2F01 4956 MOVE.l d1,-(sp) * save d1
+00B018B0 B03C 0020 4957 CMP.b #32,d0 * compare exponent diff with 32
+00B018B4 6D04 4958 BLT.s LAB_2467 * branch if range >= 32
+00B018B6 4959
+00B018B6 7200 4960 MOVEQ #0,d1 * clear d1
+00B018B8 6004 4961 BRA.s LAB_2468 * go clear smaller mantissa
+00B018BA 4962
+00B018BA 4963 LAB_2467
+00B018BA 2210 4964 MOVE.l (a0),d1 * get FACx mantissa
+00B018BC E0A9 4965 LSR.l d0,d1 * shift d0 times right
+00B018BE 4966 LAB_2468
+00B018BE 2081 4967 MOVE.l d1,(a0) * save it back
+00B018C0 221F 4968 MOVE.l (sp)+,d1 * restore d1
+00B018C2 4969
+00B018C2 4970 * exponents are equal now do mantissa add or
+00B018C2 4971 * subtract
+00B018C2 4972 LAB_24A8
+00B018C2 4A2B 0602 4973 TST.b FAC_sc(a3) * test sign compare (FAC1 EOR FAC2)
+00B018C6 6B1A 4974 BMI.s LAB_24F8 * if <> go do subtract
+00B018C8 4975
+00B018C8 202B 05FC 4976 MOVE.l FAC2_m(a3),d0 * get FAC2 mantissa
+00B018CC D0AB 05F4 4977 ADD.l FAC1_m(a3),d0 * add FAC1 mantissa
+00B018D0 640A 4978 BCC.s LAB_24F7 * save and exit if no carry (FAC1 is normal)
+00B018D2 4979
+00B018D2 E290 4980 ROXR.l #1,d0 * else shift carry back into mantissa
+00B018D4 522B 05F8 4981 ADDQ.b #1,FAC1_e(a3) * increment FAC1 exponent
+00B018D8 6500 E880 4982 BCS LAB_OFER * if carry do overflow error & warm start
+00B018DC 4983
+00B018DC 4984 LAB_24F7
+00B018DC 2740 05F4 4985 MOVE.l d0,FAC1_m(a3) * save mantissa
+00B018E0 4986 RTS_016
+00B018E0 4E75 4987 RTS
+00B018E2 4988 * signs are different
+00B018E2 4989 LAB_24F8
+00B018E2 43EB 05F4 4990 LEA FAC1_m(a3),a1 * pointer 2 to FAC1
+00B018E6 B3C8 4991 CMPA.l a0,a1 * compare pointers
+00B018E8 6602 4992 BNE.s LAB_24B4 * branch if <>
+00B018EA 4993
+00B018EA 5049 4994 ADDQ.w #8,a1 * else pointer2 to FAC2
+00B018EC 4995
+00B018EC 4996 * take smaller from bigger (take sign of bigger)
+00B018EC 4997 LAB_24B4
+00B018EC 2011 4998 MOVE.l (a1),d0 * get larger mantissa
+00B018EE 2210 4999 MOVE.l (a0),d1 * get smaller mantissa
+00B018F0 2740 05F4 5000 MOVE.l d0,FAC1_m(a3) * save larger mantissa
+00B018F4 93AB 05F4 5001 SUB.l d1,FAC1_m(a3) * subtract smaller
+00B018F8 5002
+00B018F8 5003
+00B018F8 5004 *************************************************************************************
+00B018F8 5005 *
+00B018F8 5006 * do +/- (carry is sign) & normalise FAC1
+00B018F8 5007
+00B018F8 5008 LAB_24D0
+00B018F8 640A 5009 BCC.s LAB_24D5 * branch if result is +ve
+00B018FA 5010
+00B018FA 5011 * erk! subtract is the wrong way round so
+00B018FA 5012 * negate everything
+00B018FA 0A2B 00FF 05F9 5013 EORI.b #$FF,FAC1_s(a3) * complement FAC1 sign
+00B01900 44AB 05F4 5014 NEG.l FAC1_m(a3) * negate FAC1 mantissa
+00B01904 5015
+00B01904 5016
+00B01904 5017 *************************************************************************************
+00B01904 5018 *
+00B01904 5019 * normalise FAC1
+00B01904 5020
+00B01904 5021 LAB_24D5
+00B01904 202B 05F4 5022 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B01908 6B2E 5023 BMI.s LAB_24DA * mantissa is normal so just exit
+00B0190A 5024
+00B0190A 6606 5025 BNE.s LAB_24D9 * mantissa is not zero so go normalise FAC1
+00B0190C 5026
+00B0190C 3740 05F8 5027 MOVE.w d0,FAC1_e(a3) * else make FAC1 = +zero
+00B01910 4E75 5028 RTS
+00B01912 5029
+00B01912 5030 LAB_24D9
+00B01912 2F01 5031 MOVE.l d1,-(sp) * save d1
+00B01914 2200 5032 MOVE.l d0,d1 * mantissa to d1
+00B01916 7000 5033 MOVEQ #0,d0 * clear d0
+00B01918 102B 05F8 5034 MOVE.b FAC1_e(a3),d0 * get exponent byte
+00B0191C 6714 5035 BEQ.s LAB_24D8 * if exponent is zero then clean up and exit
+00B0191E 5036 LAB_24D6
+00B0191E D281 5037 ADD.l d1,d1 * shift mantissa, ADD is quicker for a single
+00B01920 5038 * shift
+00B01920 5BC8 FFFC 5039 DBMI d0,LAB_24D6 * decrement exponent and loop if mantissa and
+00B01924 5040 * exponent +ve
+00B01924 5041
+00B01924 4A40 5042 TST.w d0 * test exponent
+00B01926 670A 5043 BEQ.s LAB_24D8 * if exponent is zero make FAC1 zero
+00B01928 5044
+00B01928 6A02 5045 BPL.s LAB_24D7 * if exponent is >zero go save FAC1
+00B0192A 5046
+00B0192A 7001 5047 MOVEQ #1,d0 * else set for zero after correction
+00B0192C 5048 LAB_24D7
+00B0192C 5300 5049 SUBQ.b #1,d0 * adjust exponent for loop
+00B0192E 2741 05F4 5050 MOVE.l d1,FAC1_m(a3) * save normalised mantissa
+00B01932 5051 LAB_24D8
+00B01932 221F 5052 MOVE.l (sp)+,d1 * restore d1
+00B01934 1740 05F8 5053 MOVE.b d0,FAC1_e(a3) * save corrected exponent
+00B01938 5054 LAB_24DA
+00B01938 4E75 5055 RTS
+00B0193A 5056
+00B0193A 5057
+00B0193A 5058 *************************************************************************************
+00B0193A 5059 *
+00B0193A 5060 * perform LOG()
+00B0193A 5061
+00B0193A 5062 LAB_LOG
+00B0193A 4A2B 05F9 5063 TST.b FAC1_s(a3) * test sign
+00B0193E 6B00 E81E 5064 BMI LAB_FCER * if -ve do function call error/warm start
+00B01942 5065
+00B01942 7E00 5066 MOVEQ #0,d7 * clear d7
+00B01944 1747 0602 5067 MOVE.b d7,FAC_sc(a3) * clear sign compare
+00B01948 1E2B 05F8 5068 MOVE.b FAC1_e(a3),d7 * get exponent
+00B0194C 6700 E810 5069 BEQ LAB_FCER * if 0 do function call error/warm start
+00B01950 5070
+00B01950 0487 00000081 5071 SUB.l #$81,d7 * normalise exponent
+00B01956 177C 0081 05F8 5072 MOVE.b #$81,FAC1_e(a3) * force a value between 1 and 2
+00B0195C 2C2B 05F4 5073 MOVE.l FAC1_m(a3),d6 * copy mantissa
+00B01960 5074
+00B01960 277C 80000000 05FC 5075 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 1
+00B01968 377C 8100 0600 5076 MOVE.w #$8100,FAC2_e(a3) * set exponent for 1
+00B0196E 6100 FF18 5077 BSR LAB_ADD * find arg+1
+00B01972 7000 5078 MOVEQ #0,d0 * setup for calc skip
+00B01974 3740 0600 5079 MOVE.w d0,FAC2_e(a3) * set FAC1 for zero result
+00B01978 DC86 5080 ADD.l d6,d6 * shift 1 bit out
+00B0197A 2746 05FC 5081 MOVE.l d6,FAC2_m(a3) * put back FAC2
+00B0197E 6758 5082 BEQ.s LAB_LONN * if 0 skip calculation
+00B01980 5083
+00B01980 377C 8000 0600 5084 MOVE.w #$8000,FAC2_e(a3) * set exponent for .5
+00B01986 6100 0130 5085 BSR LAB_DIVIDE * do (arg-1)/(arg+1)
+00B0198A 4A2B 05F8 5086 TST.b FAC1_e(a3) * test exponent
+00B0198E 6748 5087 BEQ.s LAB_LONN * if 0 skip calculation
+00B01990 5088
+00B01990 122B 05F8 5089 MOVE.b FAC1_e(a3),d1 * get exponent
+00B01994 0401 0082 5090 SUB.b #$82,d1 * normalise and two integer bits
+00B01998 4401 5091 NEG.b d1 * negate for shift
+00B0199A 5092 ** CMP.b #$1F,d1 * will mantissa vanish?
+00B0199A 5093 ** BGT.s LAB_dunno * if so do ???
+00B0199A 5094
+00B0199A 202B 05F4 5095 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B0199E E2A8 5096 LSR.l d1,d0 * shift in two integer bits
+00B019A0 5097
+00B019A0 5098 * d0 = arg
+00B019A0 5099 * d0 = x, d1 = y
+00B019A0 5100 * d2 = x1, d3 = y1
+00B019A0 5101 * d4 = shift count
+00B019A0 5102 * d5 = loop count
+00B019A0 5103 * d6 = z
+00B019A0 5104 * a0 = table pointer
+00B019A0 5105
+00B019A0 7C00 5106 MOVEQ #0,d6 * z = 0
+00B019A2 223C 40000000 5107 MOVE.l #1<<30,d1 * y = 1
+00B019A8 41FA 13FE 5108 LEA TAB_HTHET(pc),a0 * get pointer to hyperbolic tangent table
+00B019AC 7A1E 5109 MOVEQ #30,d5 * loop 31 times
+00B019AE 7801 5110 MOVEQ #1,d4 * set shift count
+00B019B0 6006 5111 BRA.s LAB_LOCC * entry point for loop
+00B019B2 5112
+00B019B2 5113 LAB_LAAD
+00B019B2 E8A2 5114 ASR.l d4,d2 * x1 >> i
+00B019B4 9282 5115 SUB.l d2,d1 * y = y - x1
+00B019B6 DC90 5116 ADD.l (a0),d6 * z = z + tanh(i)
+00B019B8 5117 LAB_LOCC
+00B019B8 2400 5118 MOVE.l d0,d2 * x1 = x
+00B019BA 2601 5119 MOVE.l d1,d3 * y1 = Y
+00B019BC E8A3 5120 ASR.l d4,d3 * y1 >> i
+00B019BE 6402 5121 BCC.s LAB_LOLP
+00B019C0 5122
+00B019C0 5283 5123 ADDQ.l #1,d3
+00B019C2 5124 LAB_LOLP
+00B019C2 9083 5125 SUB.l d3,d0 * x = x - y1
+00B019C4 6AEC 5126 BPL.s LAB_LAAD * branch if > 0
+00B019C6 5127
+00B019C6 2002 5128 MOVE.l d2,d0 * get x back
+00B019C8 5848 5129 ADDQ.w #4,a0 * next entry
+00B019CA 5284 5130 ADDQ.l #1,d4 * next i
+00B019CC E28B 5131 LSR.l #1,d3 * /2
+00B019CE 6704 5132 BEQ.s LAB_LOCX * branch y1 = 0
+00B019D0 5133
+00B019D0 51CD FFF0 5134 DBF d5,LAB_LOLP * decrement and loop if not done
+00B019D4 5135
+00B019D4 5136 * now sort out the result
+00B019D4 5137 LAB_LOCX
+00B019D4 DC86 5138 ADD.l d6,d6 * *2
+00B019D6 2006 5139 MOVE.l d6,d0 * setup for d7 = 0
+00B019D8 5140 LAB_LONN
+00B019D8 2800 5141 MOVE.l d0,d4 * save cordic result
+00B019DA 7A00 5142 MOVEQ #0,d5 * set default exponent sign
+00B019DC 4A87 5143 TST.l d7 * check original exponent sign
+00B019DE 6716 5144 BEQ.s LAB_LOXO * branch if original was 0
+00B019E0 5145
+00B019E0 6A04 5146 BPL.s LAB_LOXP * branch if was +ve
+00B019E2 5147
+00B019E2 4487 5148 NEG.l d7 * make original exponent +ve
+00B019E4 7A80 5149 MOVEQ #$80-$100,d5 * make sign -ve
+00B019E6 5150 LAB_LOXP
+00B019E6 1745 05F9 5151 MOVE.b d5,FAC1_s(a3) * save original exponent sign
+00B019EA 4847 5152 SWAP d7 * 16 bit shift
+00B019EC E18F 5153 LSL.l #8,d7 * easy first part
+00B019EE 7A88 5154 MOVEQ #$88-$100,d5 * start with byte
+00B019F0 5155 LAB_LONE
+00B019F0 5385 5156 SUBQ.l #1,d5 * decrement exponent
+00B019F2 DE87 5157 ADD.l d7,d7 * shift mantissa
+00B019F4 6AFA 5158 BPL.s LAB_LONE * loop if not normal
+00B019F6 5159
+00B019F6 5160 LAB_LOXO
+00B019F6 2747 05F4 5161 MOVE.l d7,FAC1_m(a3) * save original exponent as mantissa
+00B019FA 1745 05F8 5162 MOVE.b d5,FAC1_e(a3) * save exponent for this
+00B019FE 277C B17217F8 05FC 5163 MOVE.l #$B17217F8,FAC2_m(a3) * LOG(2) mantissa
+00B01A06 377C 8000 0600 5164 MOVE.w #$8000,FAC2_e(a3) * LOG(2) exponent & sign
+00B01A0C 176B 05F9 0602 5165 MOVE.b FAC1_s(a3),FAC_sc(a3) * make sign compare = FAC1 sign
+00B01A12 6118 5166 BSR.s LAB_MULTIPLY * do multiply
+00B01A14 2744 05FC 5167 MOVE.l d4,FAC2_m(a3) * save cordic result
+00B01A18 6710 5168 BEQ.s LAB_LOWZ * branch if zero
+00B01A1A 5169
+00B01A1A 377C 8200 0600 5170 MOVE.w #$8200,FAC2_e(a3) * set exponent & sign
+00B01A20 176B 05F9 0602 5171 MOVE.b FAC1_s(a3),FAC_sc(a3) * clear sign compare
+00B01A26 6100 FE60 5172 BSR LAB_ADD * and add for final result
+00B01A2A 5173
+00B01A2A 5174 LAB_LOWZ
+00B01A2A 4E75 5175 RTS
+00B01A2C 5176
+00B01A2C 5177
+00B01A2C 5178 *************************************************************************************
+00B01A2C 5179 *
+00B01A2C 5180 * multiply FAC1 by FAC2
+00B01A2C 5181
+00B01A2C 5182 LAB_MULTIPLY
+00B01A2C 48E7 F800 5183 MOVEM.l d0-d4,-(sp) * save registers
+00B01A30 4A2B 05F8 5184 TST.b FAC1_e(a3) * test FAC1 exponent
+00B01A34 6776 5185 BEQ.s LAB_MUUF * if exponent zero go make result zero
+00B01A36 5186
+00B01A36 102B 0600 5187 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
+00B01A3A 6770 5188 BEQ.s LAB_MUUF * if exponent zero go make result zero
+00B01A3C 5189
+00B01A3C 176B 0602 05F9 5190 MOVE.b FAC_sc(a3),FAC1_s(a3) * sign compare becomes sign
+00B01A42 5191
+00B01A42 D02B 05F8 5192 ADD.b FAC1_e(a3),d0 * multiply exponents by adding
+00B01A46 640A 5193 BCC.s LAB_MNOC * branch if no carry
+00B01A48 5194
+00B01A48 0400 0080 5195 SUB.b #$80,d0 * normalise result
+00B01A4C 6400 E70C 5196 BCC LAB_OFER * if no carry do overflow
+00B01A50 5197
+00B01A50 6006 5198 BRA.s LAB_MADD * branch
+00B01A52 5199
+00B01A52 5200 * no carry for exponent add
+00B01A52 5201 LAB_MNOC
+00B01A52 0400 0080 5202 SUB.b #$80,d0 * normalise result
+00B01A56 6554 5203 BCS.s LAB_MUUF * return zero if underflow
+00B01A58 5204
+00B01A58 5205 LAB_MADD
+00B01A58 1740 05F8 5206 MOVE.b d0,FAC1_e(a3) * save exponent
+00B01A5C 5207
+00B01A5C 5208 * d1 (FAC1) x d2 (FAC2)
+00B01A5C 222B 05F4 5209 MOVE.l FAC1_m(a3),d1 * get FAC1 mantissa
+00B01A60 242B 05FC 5210 MOVE.l FAC2_m(a3),d2 * get FAC2 mantissa
+00B01A64 5211
+00B01A64 3801 5212 MOVE.w d1,d4 * copy low word FAC1
+00B01A66 2001 5213 MOVE.l d1,d0 * copy long word FAC1
+00B01A68 4840 5214 SWAP d0 * high word FAC1 to low word FAC1
+00B01A6A 3600 5215 MOVE.w d0,d3 * copy high word FAC1
+00B01A6C 5216
+00B01A6C C2C2 5217 MULU d2,d1 * low word FAC2 x low word FAC1
+00B01A6E C0C2 5218 MULU d2,d0 * low word FAC2 x high word FAC1
+00B01A70 4842 5219 SWAP d2 * high word FAC2 to low word FAC2
+00B01A72 C8C2 5220 MULU d2,d4 * high word FAC2 x low word FAC1
+00B01A74 C6C2 5221 MULU d2,d3 * high word FAC2 x high word FAC1
+00B01A76 5222
+00B01A76 5223 * done multiply, now add partial products
+00B01A76 5224
+00B01A76 5225 * d1 = aaaa ---- FAC2_L x FAC1_L
+00B01A76 5226 * d0 = bbbb aaaa FAC2_L x FAC1_H
+00B01A76 5227 * d4 = bbbb aaaa FAC2_H x FAC1_L
+00B01A76 5228 * d3 = cccc bbbb FAC2_H x FAC1_H
+00B01A76 5229 * product = mmmm mmmm
+00B01A76 5230
+00B01A76 0681 00008000 5231 ADD.L #$8000,d1 * round up lowest word
+00B01A7C 4241 5232 CLR.w d1 * clear low word, don't need it
+00B01A7E 4841 5233 SWAP d1 * align high word
+00B01A80 D280 5234 ADD.l d0,d1 * add FAC2_L x FAC1_H (can't be carry)
+00B01A82 5235 LAB_MUF1
+00B01A82 D284 5236 ADD.l d4,d1 * now add intermediate (FAC2_H x FAC1_L)
+00B01A84 6406 5237 BCC.s LAB_MUF2 * branch if no carry
+00B01A86 5238
+00B01A86 0683 00010000 5239 ADD.l #$10000,d3 * else correct result
+00B01A8C 5240 LAB_MUF2
+00B01A8C 0681 00008000 5241 ADD.l #$8000,d1 * round up low word
+00B01A92 4241 5242 CLR.w d1 * clear low word
+00B01A94 4841 5243 SWAP d1 * align for final add
+00B01A96 D283 5244 ADD.l d3,d1 * add FAC2_H x FAC1_H, result
+00B01A98 6B08 5245 BMI.s LAB_MUF3 * branch if normalisation not needed
+00B01A9A 5246
+00B01A9A D281 5247 ADD.l d1,d1 * shift mantissa
+00B01A9C 532B 05F8 5248 SUBQ.b #1,FAC1_e(a3) * adjust exponent
+00B01AA0 670A 5249 BEQ.s LAB_MUUF * branch if underflow
+00B01AA2 5250
+00B01AA2 5251 LAB_MUF3
+00B01AA2 2741 05F4 5252 MOVE.l d1,FAC1_m(a3) * save mantissa
+00B01AA6 5253 LAB_MUEX
+00B01AA6 4CDF 001F 5254 MOVEM.l (sp)+,d0-d4 * restore registers
+00B01AAA 4E75 5255 RTS
+00B01AAC 5256 * either zero or underflow result
+00B01AAC 5257 LAB_MUUF
+00B01AAC 7000 5258 MOVEQ #0,d0 * quick clear
+00B01AAE 2740 05F4 5259 MOVE.l d0,FAC1_m(a3) * clear mantissa
+00B01AB2 3740 05F8 5260 MOVE.w d0,FAC1_e(a3) * clear sign and exponent
+00B01AB6 60EE 5261 BRA.s LAB_MUEX * restore regs & exit
+00B01AB8 5262
+00B01AB8 5263
+00B01AB8 5264 *************************************************************************************
+00B01AB8 5265 *
+00B01AB8 5266 * do FAC2/FAC1, result in FAC1
+00B01AB8 5267 * fast hardware divide version
+00B01AB8 5268
+00B01AB8 5269 LAB_DIVIDE
+00B01AB8 2F07 5270 MOVE.l d7,-(sp) * save d7
+00B01ABA 7000 5271 MOVEQ #0,d0 * clear FAC2 exponent
+00B01ABC 2400 5272 MOVE.l d0,d2 * clear FAC1 exponent
+00B01ABE 5273
+00B01ABE 142B 05F8 5274 MOVE.b FAC1_e(a3),d2 * get FAC1 exponent
+00B01AC2 6700 E682 5275 BEQ LAB_DZER * if zero go do /0 error
+00B01AC6 5276
+00B01AC6 102B 0600 5277 MOVE.b FAC2_e(a3),d0 * get FAC2 exponent
+00B01ACA 6766 5278 BEQ.s LAB_DIV0 * if zero return zero
+00B01ACC 5279
+00B01ACC 9042 5280 SUB.w d2,d0 * get result exponent by subtracting
+00B01ACE 0640 0080 5281 ADD.w #$80,d0 * correct 16 bit exponent result
+00B01AD2 5282
+00B01AD2 176B 0602 05F9 5283 MOVE.b FAC_sc(a3),FAC1_s(a3) * sign compare is result sign
+00B01AD8 5284
+00B01AD8 5285 * now to do 32/32 bit mantissa divide
+00B01AD8 5286
+00B01AD8 422B 0603 5287 CLR.b flag(a3) * clear 'flag' byte
+00B01ADC 262B 05F4 5288 MOVE.l FAC1_m(a3),d3 * get FAC1 mantissa
+00B01AE0 282B 05FC 5289 MOVE.l FAC2_m(a3),d4 * get FAC2 mantissa
+00B01AE4 B883 5290 CMP.l d3,d4 * compare FAC2 with FAC1 mantissa
+00B01AE6 6744 5291 BEQ.s LAB_MAN1 * set mantissa result = 1 if equal
+00B01AE8 5292
+00B01AE8 6506 5293 BCS.s AC1gtAC2 * branch if FAC1 > FAC2
+00B01AEA 5294
+00B01AEA 9883 5295 SUB.l d3,d4 * subtract FAC1 from FAC2, result now must be <1
+00B01AEC 562B 0603 5296 ADDQ.b #3,flag(a3) * FAC2>FAC1 so set 'flag' byte
+00B01AF0 5297 AC1gtAC2
+00B01AF0 6146 5298 BSR.s LAB_32_16 * do 32/16 divide
+00B01AF2 4841 5299 SWAP d1 * move 16 bit result to high word
+00B01AF4 2802 5300 MOVE.l d2,d4 * copy remainder longword
+00B01AF6 6142 5301 BSR.s LAB_3216 * do 32/16 divide again (skip copy d4 to d2)
+00B01AF8 84C5 5302 DIVU.w d5,d2 * now divide remainder to make guard word
+00B01AFA 1E2B 0603 5303 MOVE.b flag(a3),d7 * now normalise, get flag byte back
+00B01AFE 6708 5304 BEQ.s LAB_DIVX * skip add if null
+00B01B00 5305
+00B01B00 5306 * else result was >1 so we need to add 1 to result mantissa and adjust exponent
+00B01B00 5307
+00B01B00 E20F 5308 LSR.b #1,d7 * shift 1 into eXtend
+00B01B02 E291 5309 ROXR.l #1,d1 * shift extend result >>
+00B01B04 E252 5310 ROXR.w #1,d2 * shift extend guard word >>
+00B01B06 5200 5311 ADDQ.b #1,d0 * adjust exponent
+00B01B08 5312
+00B01B08 5313 * now round result to 32 bits
+00B01B08 5314
+00B01B08 5315 LAB_DIVX
+00B01B08 D442 5316 ADD.w d2,d2 * guard bit into eXtend bit
+00B01B0A 6408 5317 BCC.s L_DIVRND * branch if guard=0
+00B01B0C 5318
+00B01B0C 5281 5319 ADDQ.l #1,d1 * add guard to mantissa
+00B01B0E 6404 5320 BCC.s L_DIVRND * branch if no overflow
+00B01B10 5321
+00B01B10 5322 LAB_SET1
+00B01B10 E291 5323 ROXR.l #1,d1 * shift extend result >>
+00B01B12 5240 5324 ADDQ.w #1,d0 * adjust exponent
+00B01B14 5325
+00B01B14 5326 * test for over/under flow
+00B01B14 5327 L_DIVRND
+00B01B14 3600 5328 MOVE.w d0,d3 * copy exponent
+00B01B16 6B1A 5329 BMI.s LAB_DIV0 * if -ve return zero
+00B01B18 5330
+00B01B18 0243 FF00 5331 ANDI.w #$FF00,d3 * mask word high byte
+00B01B1C 6600 E63C 5332 BNE LAB_OFER * branch if overflow
+00B01B20 5333
+00B01B20 5334 * move result into FAC1
+00B01B20 5335 LAB_XDIV
+00B01B20 2E1F 5336 MOVE.l (sp)+,d7 * restore d7
+00B01B22 1740 05F8 5337 MOVE.b d0,FAC1_e(a3) * save result exponent
+00B01B26 2741 05F4 5338 MOVE.l d1,FAC1_m(a3) * save result mantissa
+00B01B2A 4E75 5339 RTS
+00B01B2C 5340
+00B01B2C 5341 * FAC1 mantissa = FAC2 mantissa so set result mantissa
+00B01B2C 5342
+00B01B2C 5343 LAB_MAN1
+00B01B2C 7201 5344 MOVEQ #1,d1 * set bit
+00B01B2E E2A9 5345 LSR.l d1,d1 * bit into eXtend
+00B01B30 60DE 5346 BRA.s LAB_SET1 * set mantissa, adjust exponent and exit
+00B01B32 5347
+00B01B32 5348 * result is zero
+00B01B32 5349
+00B01B32 5350 LAB_DIV0
+00B01B32 7000 5351 MOVEQ #0,d0 * zero exponent & sign
+00B01B34 2200 5352 MOVE.l d0,d1 * zero mantissa
+00B01B36 60E8 5353 BRA LAB_XDIV * exit divide
+00B01B38 5354
+00B01B38 5355 * divide 16 bits into 32, AB/Ex
+00B01B38 5356 *
+00B01B38 5357 * d4 AAAA BBBB * 32 bit numerator
+00B01B38 5358 * d3 EEEE xxxx * 16 bit denominator
+00B01B38 5359 *
+00B01B38 5360 * returns -
+00B01B38 5361 *
+00B01B38 5362 * d1 xxxx DDDD * 16 bit result
+00B01B38 5363 * d2 HHHH IIII * 32 bit remainder
+00B01B38 5364
+00B01B38 5365 LAB_32_16
+00B01B38 2404 5366 MOVE.l d4,d2 * copy FAC2 mantissa (AB)
+00B01B3A 5367 LAB_3216
+00B01B3A 2A03 5368 MOVE.l d3,d5 * copy FAC1 mantissa (EF)
+00B01B3C 4245 5369 CLR.w d5 * clear low word d1 (Ex)
+00B01B3E 4845 5370 SWAP d5 * swap high word to low word (xE)
+00B01B40 5371
+00B01B40 5372 * d3 EEEE FFFF * denominator copy
+00B01B40 5373 * d5 0000 EEEE * denominator high word
+00B01B40 5374 * d2 AAAA BBBB * numerator copy
+00B01B40 5375 * d4 AAAA BBBB * numerator
+00B01B40 5376
+00B01B40 88C5 5377 DIVU.w d5,d4 * do FAC2/FAC1 high word (AB/E)
+00B01B42 6802 5378 BVC.s LAB_LT_1 * if no overflow DIV was ok
+00B01B44 5379
+00B01B44 78FF 5380 MOVEQ #-1,d4 * else set default value
+00B01B46 5381
+00B01B46 5382 * done the divide, now check the result, we have ...
+00B01B46 5383
+00B01B46 5384 * d3 EEEE FFFF * denominator copy
+00B01B46 5385 * d5 0000 EEEE * denominator high word
+00B01B46 5386 * d2 AAAA BBBB * numerator copy
+00B01B46 5387 * d4 MMMM DDDD * result MOD and DIV
+00B01B46 5388
+00B01B46 5389 LAB_LT_1
+00B01B46 3C04 5390 MOVE.w d4,d6 * copy 16 bit result
+00B01B48 3204 5391 MOVE.w d4,d1 * copy 16 bit result again
+00B01B4A 5392
+00B01B4A 5393 * we now have ..
+00B01B4A 5394 * d3 EEEE FFFF * denominator copy
+00B01B4A 5395 * d5 0000 EEEE * denominator high word
+00B01B4A 5396 * d6 xxxx DDDD * result DIV copy
+00B01B4A 5397 * d1 xxxx DDDD * result DIV copy
+00B01B4A 5398 * d2 AAAA BBBB * numerator copy
+00B01B4A 5399 * d4 MMMM DDDD * result MOD and DIV
+00B01B4A 5400
+00B01B4A 5401 * now multiply out 32 bit denominator by 16 bit result
+00B01B4A 5402 * QRS = AB*D
+00B01B4A 5403
+00B01B4A CCC3 5404 MULU.w d3,d6 * FFFF * DDDD = rrrr SSSS
+00B01B4C C8C5 5405 MULU.w d5,d4 * EEEE * DDDD = QQQQ rrrr
+00B01B4E 5406
+00B01B4E 5407 * we now have ..
+00B01B4E 5408 * d3 EEEE FFFF * denominator copy
+00B01B4E 5409 * d5 0000 EEEE * denominator high word
+00B01B4E 5410 * d6 rrrr SSSS * 48 bit result partial low
+00B01B4E 5411 * d1 xxxx DDDD * result DIV copy
+00B01B4E 5412 * d2 AAAA BBBB * numerator copy
+00B01B4E 5413 * d4 QQQQ rrrr * 48 bit result partial
+00B01B4E 5414
+00B01B4E 3E06 5415 MOVE.w d6,d7 * copy low word of low multiply
+00B01B50 5416
+00B01B50 5417 * d7 xxxx SSSS * 48 bit result partial low
+00B01B50 5418
+00B01B50 4246 5419 CLR.w d6 * clear low word of low multiply
+00B01B52 4846 5420 SWAP d6 * high word of low multiply to low word
+00B01B54 5421
+00B01B54 5422 * d6 0000 rrrr * high word of 48 bit result partial low
+00B01B54 5423
+00B01B54 D886 5424 ADD.l d6,d4
+00B01B56 5425
+00B01B56 5426 * d4 QQQQ RRRR * 48 bit result partial high longword
+00B01B56 5427
+00B01B56 7C00 5428 MOVEQ #0,d6 * clear to extend numerator to 48 bits
+00B01B58 5429
+00B01B58 5430 * now do GHI = AB0 - QRS (which is the remainder)
+00B01B58 5431
+00B01B58 9C47 5432 SUB.w d7,d6 * low word subtract
+00B01B5A 5433
+00B01B5A 5434 * d6 xxxx IIII * remainder low word
+00B01B5A 5435
+00B01B5A 9584 5436 SUBX.l d4,d2 * high longword subtract
+00B01B5C 5437
+00B01B5C 5438 * d2 GGGG HHHH * remainder high longword
+00B01B5C 5439
+00B01B5C 5440 * now if we got the divide correct then the remainder high longword will be +ve
+00B01B5C 5441
+00B01B5C 6A08 5442 BPL.s L_DDIV * branch if result is ok ( FAC2
+00B01C32 5638 * returns d0= 0 Cb=0 if FAC1 = FAC2
+00B01C32 5639 * returns d0=-1 Cb=1 if FAC1 < FAC2
+00B01C32 5640
+00B01C32 5641 LAB_27FA
+00B01C32 122B 0600 5642 MOVE.b FAC2_e(a3),d1 * get FAC2 exponent
+00B01C36 67C8 5643 BEQ.s LAB_27CA * branch if FAC2 exponent=0 & get FAC1 sign
+00B01C38 5644 * d0=-1,C=1/-ve d0=+1,C=0/+ve
+00B01C38 5645
+00B01C38 102B 0602 5646 MOVE.b FAC_sc(a3),d0 * get FAC sign compare
+00B01C3C 6BCA 5647 BMI.s LAB_27CE * if signs <> do return d0=-1,C=1/-ve
+00B01C3E 5648 * d0=+1,C=0/+ve & return
+00B01C3E 5649
+00B01C3E 102B 05F9 5650 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
+00B01C42 B22B 05F8 5651 CMP.b FAC1_e(a3),d1 * compare FAC1 exponent with FAC2 exponent
+00B01C46 660A 5652 BNE.s LAB_2828 * branch if different
+00B01C48 5653
+00B01C48 222B 05FC 5654 MOVE.l FAC2_m(a3),d1 * get FAC2 mantissa
+00B01C4C B2AB 05F4 5655 CMP.l FAC1_m(a3),d1 * compare mantissas
+00B01C50 6708 5656 BEQ.s LAB_282F * exit if mantissas equal
+00B01C52 5657
+00B01C52 5658 * gets here if number <> FAC1
+00B01C52 5659
+00B01C52 5660 LAB_2828
+00B01C52 65B8 5661 BCS.s LAB_27D0 * if FAC1 > FAC2 return d0=-1,C=1/-ve d0=+1,
+00B01C54 5662 * C=0/+ve
+00B01C54 5663
+00B01C54 0A00 0080 5664 EORI.b #$80,d0 * else toggle FAC1 sign
+00B01C58 5665 LAB_282E
+00B01C58 60B2 5666 BRA.s LAB_27D0 * return d0=-1,C=1/-ve d0=+1,C=0/+ve
+00B01C5A 5667
+00B01C5A 5668 LAB_282F
+00B01C5A 7000 5669 MOVEQ #0,d0 * clear result
+00B01C5C 4E75 5670 RTS
+00B01C5E 5671
+00B01C5E 5672
+00B01C5E 5673 *************************************************************************************
+00B01C5E 5674 *
+00B01C5E 5675 * convert FAC1 floating to fixed
+00B01C5E 5676 * result in d0 and Itemp, sets flags correctly
+00B01C5E 5677
+00B01C5E 5678 LAB_2831
+00B01C5E 202B 05F4 5679 MOVE.l FAC1_m(a3),d0 * copy mantissa
+00B01C62 6730 5680 BEQ.s LAB_284J * branch if mantissa = 0
+00B01C64 5681
+00B01C64 2F01 5682 MOVE.l d1,-(sp) * save d1
+00B01C66 72A0 5683 MOVEQ #$A0,d1 * set for no floating bits
+00B01C68 922B 05F8 5684 SUB.b FAC1_e(a3),d1 * subtract FAC1 exponent
+00B01C6C 6500 E4EC 5685 BCS LAB_OFER * do overflow if too big
+00B01C70 5686
+00B01C70 660E 5687 BNE.s LAB_284G * branch if exponent was not $A0
+00B01C72 5688
+00B01C72 4A2B 05F9 5689 TST.b FAC1_s(a3) * test FAC1 sign
+00B01C76 6A1A 5690 BPL.s LAB_284H * branch if FAC1 +ve
+00B01C78 5691
+00B01C78 4480 5692 NEG.l d0
+00B01C7A 6916 5693 BVS.s LAB_284H * branch if was $80000000
+00B01C7C 5694
+00B01C7C 6000 E4DC 5695 BRA LAB_OFER * do overflow if too big
+00B01C80 5696
+00B01C80 5697 LAB_284G
+00B01C80 B23C 0020 5698 CMP.b #$20,d1 * compare with minimum result for integer
+00B01C84 6502 5699 BCS.s LAB_284L * if < minimum just do shift
+00B01C86 5700
+00B01C86 7000 5701 MOVEQ #0,d0 * else return zero
+00B01C88 5702 LAB_284L
+00B01C88 E2A8 5703 LSR.l d1,d0 * shift integer
+00B01C8A 5704
+00B01C8A 4A2B 05F9 5705 TST.b FAC1_s(a3) * test FAC1 sign (b7)
+00B01C8E 6A02 5706 BPL.s LAB_284H * branch if FAC1 +ve
+00B01C90 5707
+00B01C90 4480 5708 NEG.l d0 * negate integer value
+00B01C92 5709 LAB_284H
+00B01C92 221F 5710 MOVE.l (sp)+,d1 * restore d1
+00B01C94 5711 LAB_284J
+00B01C94 2740 048E 5712 MOVE.l d0,Itemp(a3) * save result to Itemp
+00B01C98 4E75 5713 RTS
+00B01C9A 5714
+00B01C9A 5715
+00B01C9A 5716 *************************************************************************************
+00B01C9A 5717 *
+00B01C9A 5718 * perform INT()
+00B01C9A 5719
+00B01C9A 5720 LAB_INT
+00B01C9A 70A0 5721 MOVEQ #$A0,d0 * set for no floating bits
+00B01C9C 902B 05F8 5722 SUB.b FAC1_e(a3),d0 * subtract FAC1 exponent
+00B01CA0 6310 5723 BLS.s LAB_IRTS * exit if exponent >= $A0
+00B01CA2 5724 * (too big for fraction part!)
+00B01CA2 5725
+00B01CA2 B03C 0020 5726 CMP.b #$20,d0 * compare with minimum result for integer
+00B01CA6 6400 025E 5727 BCC LAB_POZE * if >= minimum go return 0
+00B01CAA 5728 * (too small for integer part!)
+00B01CAA 5729
+00B01CAA 72FF 5730 MOVEQ #-1,d1 * set integer mask
+00B01CAC E1A1 5731 ASL.l d0,d1 * shift mask [8+2*d0]
+00B01CAE C3AB 05F4 5732 AND.l d1,FAC1_m(a3) * mask mantissa
+00B01CB2 5733 LAB_IRTS
+00B01CB2 4E75 5734 RTS
+00B01CB4 5735
+00B01CB4 5736
+00B01CB4 5737 *************************************************************************************
+00B01CB4 5738 *
+00B01CB4 5739 * print " in line [LINE #]"
+00B01CB4 5740
+00B01CB4 5741 LAB_2953
+00B01CB4 41FA 17FA 5742 LEA LAB_LMSG(pc),a0 * point to " in line " message
+00B01CB8 6100 ED24 5743 BSR LAB_18C3 * print null terminated string
+00B01CBC 5744
+00B01CBC 5745 * Print Basic line #
+00B01CBC 202B 04B6 5746 MOVE.l Clinel(a3),d0 * get current line
+00B01CC0 5747
+00B01CC0 5748
+00B01CC0 5749 *************************************************************************************
+00B01CC0 5750 *
+00B01CC0 5751 * print d0 as unsigned integer
+00B01CC0 5752
+00B01CC0 5753 LAB_295E
+00B01CC0 43FA 0DE8 5754 LEA Bin2dec(pc),a1 * get table address
+00B01CC4 7200 5755 MOVEQ #0,d1 * table index
+00B01CC6 41EB 0630 5756 LEA Usdss(a3),a0 * output string start
+00B01CCA 2401 5757 MOVE.l d1,d2 * output string index
+00B01CCC 5758 LAB_2967
+00B01CCC 2631 1000 5759 MOVE.l (a1,d1.w),d3 * get table value
+00B01CD0 6714 5760 BEQ.s LAB_2969 * exit if end marker
+00B01CD2 5761
+00B01CD2 782F 5762 MOVEQ #'0'-1,d4 * set character to "0"-1
+00B01CD4 5763 LAB_2968
+00B01CD4 5244 5764 ADDQ.w #1,d4 * next numeric character
+00B01CD6 9083 5765 SUB.l d3,d0 * subtract table value
+00B01CD8 6AFA 5766 BPL.s LAB_2968 * not overdone so loop
+00B01CDA 5767
+00B01CDA D083 5768 ADD.l d3,d0 * correct value
+00B01CDC 1184 2000 5769 MOVE.b d4,(a0,d2.w) * character out to string
+00B01CE0 5841 5770 ADDQ.w #4,d1 * increment table pointer
+00B01CE2 5242 5771 ADDQ.w #1,d2 * increment output string pointer
+00B01CE4 60E6 5772 BRA.s LAB_2967 * loop
+00B01CE6 5773
+00B01CE6 5774 LAB_2969
+00B01CE6 0600 0030 5775 ADD.b #'0',d0 * make last character
+00B01CEA 1180 2000 5776 MOVE.b d0,(a0,d2.w) * character out to string
+00B01CEE 5348 5777 SUBQ.w #1,a0 * decrement a0 (allow simple loop)
+00B01CF0 5778
+00B01CF0 5779 * now find non zero start of string
+00B01CF0 5780 LAB_296A
+00B01CF0 5248 5781 ADDQ.w #1,a0 * increment a0 (this will never carry to b16)
+00B01CF2 43EB 0639 5782 LEA BHsend-1(a3),a1 * get string end
+00B01CF6 B1C9 5783 CMPA.l a1,a0 * are we at end
+00B01CF8 6700 ECE4 5784 BEQ LAB_18C3 * if so print null terminated string and RETURN
+00B01CFC 5785
+00B01CFC 0C10 0030 5786 CMPI.b #'0',(a0) * is character "0" ?
+00B01D00 67EE 5787 BEQ.s LAB_296A * loop if so
+00B01D02 5788
+00B01D02 6000 ECDA 5789 BRA LAB_18C3 * print null terminated string from memory & RET
+00B01D06 5790
+00B01D06 5791
+00B01D06 5792 *************************************************************************************
+00B01D06 5793 *
+00B01D06 5794 * convert FAC1 to ASCII string result in (a0)
+00B01D06 5795 * STR$() function enters here
+00B01D06 5796
+00B01D06 5797 * now outputs 7 significant digits
+00B01D06 5798
+00B01D06 5799 * d0 is character out
+00B01D06 5800 * d1 is save index
+00B01D06 5801 * d2 is gash
+00B01D06 5802
+00B01D06 5803 * a0 is output string pointer
+00B01D06 5804
+00B01D06 5805 LAB_2970
+00B01D06 43EB 062A 5806 LEA Decss(a3),a1 * set output string start
+00B01D0A 5807
+00B01D0A 7420 5808 MOVEQ #' ',d2 * character = " ", assume +ve
+00B01D0C 08AB 0007 05F9 5809 BCLR.b #7,FAC1_s(a3) * test and clear FAC1 sign (b7)
+00B01D12 6702 5810 BEQ.s LAB_2978 * branch if +ve
+00B01D14 5811
+00B01D14 742D 5812 MOVEQ #'-',d2 * else character = "-"
+00B01D16 5813 LAB_2978
+00B01D16 1282 5814 MOVE.b d2,(a1) * save the sign character
+00B01D18 142B 05F8 5815 MOVE.b FAC1_e(a3),d2 * get FAC1 exponent
+00B01D1C 6608 5816 BNE.s LAB_2989 * branch if FAC1<>0
+00B01D1E 5817
+00B01D1E 5818 * exponent was $00 so FAC1 is 0
+00B01D1E 7030 5819 MOVEQ #'0',d0 * set character = "0"
+00B01D20 7201 5820 MOVEQ #1,d1 * set output string index
+00B01D22 6000 01A4 5821 BRA LAB_2A89 * save last character, [EOT] & exit
+00B01D26 5822
+00B01D26 5823 * FAC1 is some non zero value
+00B01D26 5824 LAB_2989
+00B01D26 177C 0000 0610 5825 MOVE.b #0,numexp(a3) * clear number exponent count
+00B01D2C B43C 0081 5826 CMP.b #$81,d2 * compare FAC1 exponent with $81 (>1.00000)
+00B01D30 5827
+00B01D30 6448 5828 BCC.s LAB_299C * branch if FAC1=>1
+00B01D32 5829
+00B01D32 5830 * else FAC1 < 1
+00B01D32 277C 98968000 05FC 5831 MOVE.l #$98968000,FAC2_m(a3) * 10000000 mantissa
+00B01D3A 377C 9800 0600 5832 MOVE.w #$9800,FAC2_e(a3) * 10000000 exponent & sign
+00B01D40 176B 05F9 0602 5833 MOVE.b FAC1_s(a3),FAC_sc(a3) * make FAC1 sign sign compare
+00B01D46 6100 FCE4 5834 BSR LAB_MULTIPLY * do FAC2*FAC1
+00B01D4A 5835
+00B01D4A 177C 00F9 0610 5836 MOVE.b #$F9,numexp(a3) * set number exponent count (-7)
+00B01D50 6028 5837 BRA.s LAB_299C * go test for fit
+00B01D52 5838
+00B01D52 5839 LAB_29B9
+00B01D52 376B 05F8 0600 5840 MOVE.w FAC1_e(a3),FAC2_e(a3) * copy exponent & sign from FAC1 to FAC2
+00B01D58 276B 05F4 05FC 5841 MOVE.l FAC1_m(a3),FAC2_m(a3) * copy FAC1 mantissa to FAC2 mantissa
+00B01D5E 176B 05F9 0602 5842 MOVE.b FAC1_s(a3),FAC_sc(a3) * save FAC1_s as sign compare
+00B01D64 5843
+00B01D64 277C CCCCCCCD 05F4 5844 MOVE.l #$CCCCCCCD,FAC1_m(a3) * 1/10 mantissa
+00B01D6C 377C 7D00 05F8 5845 MOVE.w #$7D00,FAC1_e(a3) * 1/10 exponent & sign
+00B01D72 6100 FCB8 5846 BSR LAB_MULTIPLY * do FAC2*FAC1, effectively divide by 10 but
+00B01D76 5847 * faster
+00B01D76 5848
+00B01D76 522B 0610 5849 ADDQ.b #1,numexp(a3) * increment number exponent count
+00B01D7A 5850 LAB_299C
+00B01D7A 277C 98967F70 05FC 5851 MOVE.l #$98967F70,FAC2_m(a3) * 9999999.4375 mantissa
+00B01D82 377C 9800 0600 5852 MOVE.w #$9800,FAC2_e(a3) * 9999999.4375 exponent & sign
+00B01D88 5853 * (max before scientific notation)
+00B01D88 6100 014C 5854 BSR LAB_27F0 * fast compare FAC1 with FAC2
+00B01D8C 5855 * returns d0=+1 C=0 if FAC1 > FAC2
+00B01D8C 5856 * returns d0= 0 C=0 if FAC1 = FAC2
+00B01D8C 5857 * returns d0=-1 C=1 if FAC1 < FAC2
+00B01D8C 62C4 5858 BHI.s LAB_29B9 * go do /10 if FAC1 > 9999999.4375
+00B01D8E 5859
+00B01D8E 6750 5860 BEQ.s LAB_29C3 * branch if FAC1 = 9999999.4375
+00B01D90 5861
+00B01D90 5862 * FAC1 < 9999999.4375
+00B01D90 277C F423F800 05FC 5863 MOVE.l #$F423F800,FAC2_m(a3) * set mantissa for 999999.5
+00B01D98 377C 9400 0600 5864 MOVE.w #$9400,FAC2_e(a3) * set exponent for 999999.5
+00B01D9E 5865
+00B01D9E 41EB 05F4 5866 LEA FAC1_m(a3),a0 * set pointer for x10
+00B01DA2 5867 LAB_29A7
+00B01DA2 6100 0132 5868 BSR LAB_27F0 * fast compare FAC1 with FAC2
+00B01DA6 5869 * returns d0=+1 C=0 if FAC1 > FAC2
+00B01DA6 5870 * returns d0= 0 C=0 if FAC1 = FAC2
+00B01DA6 5871 * returns d0=-1 C=1 if FAC1 < FAC2
+00B01DA6 6220 5872 BHI.s LAB_29C0 * branch if FAC1 > 99999.9375,no decimal places
+00B01DA8 5873
+00B01DA8 5874 * FAC1 <= 999999.5 so do x 10
+00B01DA8 2010 5875 MOVE.l (a0),d0 * get FAC1 mantissa
+00B01DAA 1228 0004 5876 MOVE.b 4(a0),d1 * get FAC1 exponent
+00B01DAE 2400 5877 MOVE.l d0,d2 * copy it
+00B01DB0 E488 5878 LSR.l #2,d0 * /4
+00B01DB2 D082 5879 ADD.l d2,d0 * add FAC1 (x1.125)
+00B01DB4 6404 5880 BCC.s LAB_29B7 * branch if no carry
+00B01DB6 5881
+00B01DB6 E290 5882 ROXR.l #1,d0 * shift carry back in
+00B01DB8 5201 5883 ADDQ.b #1,d1 * increment exponent (never overflows)
+00B01DBA 5884 LAB_29B7
+00B01DBA 5601 5885 ADDQ.b #3,d1 * correct exponent ( 8 x 1.125 = 10 )
+00B01DBC 5886 * (never overflows)
+00B01DBC 2080 5887 MOVE.l d0,(a0) * save new mantissa
+00B01DBE 1141 0004 5888 MOVE.b d1,4(a0) * save new exponent
+00B01DC2 532B 0610 5889 SUBQ.b #1,numexp(a3) * decrement number exponent count
+00B01DC6 60DA 5890 BRA.s LAB_29A7 * go test again
+00B01DC8 5891
+00B01DC8 5892 * now we have just the digits to do
+00B01DC8 5893 LAB_29C0
+00B01DC8 277C 80000000 05FC 5894 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 0.5
+00B01DD0 377C 8000 0600 5895 MOVE.w #$8000,FAC2_e(a3) * set exponent for 0.5
+00B01DD6 176B 05F9 0602 5896 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign compare = sign
+00B01DDC 6100 FAAA 5897 BSR LAB_ADD * add the 0.5 to FAC1 (round FAC1)
+00B01DE0 5898
+00B01DE0 5899 LAB_29C3
+00B01DE0 6100 FE7C 5900 BSR LAB_2831 * convert FAC1 floating to fixed
+00B01DE4 5901 * result in d0 and Itemp
+00B01DE4 7401 5902 MOVEQ #$01,d2 * set default digits before dp = 1
+00B01DE6 102B 0610 5903 MOVE.b numexp(a3),d0 * get number exponent count
+00B01DEA 5000 5904 ADD.b #8,d0 * allow 7 digits before point
+00B01DEC 6B0C 5905 BMI.s LAB_29D9 * if -ve then 1 digit before dp
+00B01DEE 5906
+00B01DEE B03C 0009 5907 CMP.b #$09,d0 * d0>=9 if n>=1E7
+00B01DF2 6406 5908 BCC.s LAB_29D9 * branch if >= $09
+00B01DF4 5909
+00B01DF4 5910 * < $08
+00B01DF4 5300 5911 SUBQ.b #1,d0 * take 1 from digit count
+00B01DF6 1400 5912 MOVE.b d0,d2 * copy byte
+00B01DF8 7002 5913 MOVEQ #$02,d0 * set exponent adjust
+00B01DFA 5914 LAB_29D9
+00B01DFA 7200 5915 MOVEQ #0,d1 * set output string index
+00B01DFC 5500 5916 SUBQ.b #2,d0 * -2
+00B01DFE 1740 0611 5917 MOVE.b d0,expcnt(a3) * save exponent adjust
+00B01E02 1742 0610 5918 MOVE.b d2,numexp(a3) * save digits before dp count
+00B01E06 1002 5919 MOVE.b d2,d0 * copy digits before dp count
+00B01E08 6702 5920 BEQ.s LAB_29E4 * branch if no digits before dp
+00B01E0A 5921
+00B01E0A 6A14 5922 BPL.s LAB_29F7 * branch if digits before dp
+00B01E0C 5923
+00B01E0C 5924 LAB_29E4
+00B01E0C 5281 5925 ADDQ.l #1,d1 * increment index
+00B01E0E 13BC 002E 1000 5926 MOVE.b #'.',(a1,d1.w) * save to output string
+00B01E14 5927
+00B01E14 4A02 5928 TST.b d2 * test digits before dp count
+00B01E16 6708 5929 BEQ.s LAB_29F7 * branch if no digits before dp
+00B01E18 5930
+00B01E18 5281 5931 ADDQ.l #1,d1 * increment index
+00B01E1A 13BC 0030 1000 5932 MOVE.b #'0',(a1,d1.w) * save to output string
+00B01E20 5933 LAB_29F7
+00B01E20 7400 5934 MOVEQ #0,d2 * clear index (point to 1,000,000)
+00B01E22 7080 5935 MOVEQ #$80-$100,d0 * set output character
+00B01E24 5936 LAB_29FB
+00B01E24 41FA 111E 5937 LEA LAB_2A9A(pc),a0 * get base of table
+00B01E28 2630 2000 5938 MOVE.l (a0,d2.w),d3 * get table value
+00B01E2C 5939 LAB_29FD
+00B01E2C 5200 5940 ADDQ.b #1,d0 * increment output character
+00B01E2E D7AB 048E 5941 ADD.l d3,Itemp(a3) * add to (now fixed) mantissa
+00B01E32 0800 0007 5942 BTST #7,d0 * set test sense (z flag only)
+00B01E36 6504 5943 BCS.s LAB_2A18 * did carry so has wrapped past zero
+00B01E38 5944
+00B01E38 67F2 5945 BEQ.s LAB_29FD * no wrap and +ve test so try again
+00B01E3A 5946
+00B01E3A 6002 5947 BRA.s LAB_2A1A * found this digit
+00B01E3C 5948
+00B01E3C 5949 LAB_2A18
+00B01E3C 66EE 5950 BNE.s LAB_29FD * wrap and -ve test so try again
+00B01E3E 5951
+00B01E3E 5952 LAB_2A1A
+00B01E3E 6406 5953 BCC.s LAB_2A21 * branch if +ve test result
+00B01E40 5954
+00B01E40 4400 5955 NEG.b d0 * negate the digit number
+00B01E42 0600 000B 5956 ADD.b #$0B,d0 * and subtract from 11 decimal
+00B01E46 5957 LAB_2A21
+00B01E46 0600 002F 5958 ADD.b #$2F,d0 * add "0"-1 to result
+00B01E4A 5842 5959 ADDQ.w #4,d2 * increment index to next less power of ten
+00B01E4C 5241 5960 ADDQ.w #1,d1 * increment output string index
+00B01E4E 1600 5961 MOVE.b d0,d3 * copy character to d3
+00B01E50 C63C 007F 5962 AND.b #$7F,d3 * mask out top bit
+00B01E54 1383 1000 5963 MOVE.b d3,(a1,d1.w) * save to output string
+00B01E58 532B 0610 5964 SUB.b #1,numexp(a3) * decrement # of characters before the dp
+00B01E5C 6608 5965 BNE.s LAB_2A3B * branch if still characters to do
+00B01E5E 5966
+00B01E5E 5967 * else output the point
+00B01E5E 5281 5968 ADDQ.l #1,d1 * increment index
+00B01E60 13BC 002E 1000 5969 MOVE.b #'.',(a1,d1.w) * save to output string
+00B01E66 5970 LAB_2A3B
+00B01E66 C03C 0080 5971 AND.b #$80,d0 * mask test sense bit
+00B01E6A 0A00 0080 5972 EORI.b #$80,d0 * invert it
+00B01E6E B43C 001C 5973 CMP.b #LAB_2A9B-LAB_2A9A,d2 * compare table index with max+4
+00B01E72 66B0 5974 BNE.s LAB_29FB * loop if not max
+00B01E74 5975
+00B01E74 5976 * now remove trailing zeroes
+00B01E74 5977 LAB_2A4B
+00B01E74 1031 1000 5978 MOVE.b (a1,d1.w),d0 * get character from output string
+00B01E78 5381 5979 SUBQ.l #1,d1 * decrement output string index
+00B01E7A B03C 0030 5980 CMP.b #'0',d0 * compare with "0"
+00B01E7E 67F4 5981 BEQ.s LAB_2A4B * loop until non "0" character found
+00B01E80 5982
+00B01E80 B03C 002E 5983 CMP.b #'.',d0 * compare with "."
+00B01E84 6702 5984 BEQ.s LAB_2A58 * branch if was dp
+00B01E86 5985
+00B01E86 5986 * else restore last character
+00B01E86 5281 5987 ADDQ.l #1,d1 * increment output string index
+00B01E88 5988 LAB_2A58
+00B01E88 13BC 002B 1002 5989 MOVE.b #'+',2(a1,d1.w) * save character "+" to output string
+00B01E8E 4A2B 0611 5990 TST.b expcnt(a3) * test exponent count
+00B01E92 6738 5991 BEQ.s LAB_2A8C * if zero go set null terminator & exit
+00B01E94 5992
+00B01E94 5993 * exponent isn't zero so write exponent
+00B01E94 6A0A 5994 BPL.s LAB_2A68 * branch if exponent count +ve
+00B01E96 5995
+00B01E96 13BC 002D 1002 5996 MOVE.b #'-',2(a1,d1.w) * save character "-" to output string
+00B01E9C 442B 0611 5997 NEG.b expcnt(a3) * convert -ve to +ve
+00B01EA0 5998 LAB_2A68
+00B01EA0 13BC 0045 1001 5999 MOVE.b #'E',1(a1,d1.w) * save character "E" to output string
+00B01EA6 142B 0611 6000 MOVE.b expcnt(a3),d2 * get exponent count
+00B01EAA 702F 6001 MOVEQ #$2F,d0 * one less than "0" character
+00B01EAC 6002 LAB_2A74
+00B01EAC 5200 6003 ADDQ.b #1,d0 * increment 10's character
+00B01EAE 0402 000A 6004 SUB.b #$0A,d2 * subtract 10 from exponent count
+00B01EB2 64F8 6005 BCC.s LAB_2A74 * loop while still >= 0
+00B01EB4 6006
+00B01EB4 0602 003A 6007 ADD.b #$3A,d2 * add character ":", $30+$0A, result is 10-value
+00B01EB8 1380 1003 6008 MOVE.b d0,3(a1,d1.w) * save 10's character to output string
+00B01EBC 1382 1004 6009 MOVE.b d2,4(a1,d1.w) * save 1's character to output string
+00B01EC0 13BC 0000 1005 6010 MOVE.b #0,5(a1,d1.w) * save null terminator after last character
+00B01EC6 600A 6011 BRA.s LAB_2A91 * go set string pointer (a0) and exit
+00B01EC8 6012
+00B01EC8 6013 LAB_2A89
+00B01EC8 1380 1000 6014 MOVE.b d0,(a1,d1.w) * save last character to output string
+00B01ECC 6015 LAB_2A8C
+00B01ECC 13BC 0000 1001 6016 MOVE.b #0,1(a1,d1.w) * save null terminator after last character
+00B01ED2 6017 LAB_2A91
+00B01ED2 2049 6018 MOVEA.l a1,a0 * set result string pointer (a0)
+00B01ED4 4E75 6019 RTS
+00B01ED6 6020
+00B01ED6 6021
+00B01ED6 6022 *************************************************************************************
+00B01ED6 6023 *
+00B01ED6 6024 * fast compare FAC1 with FAC2
+00B01ED6 6025 * assumes both are +ve and FAC2>0
+00B01ED6 6026 * returns d0=+1 C=0 if FAC1 > FAC2
+00B01ED6 6027 * returns d0= 0 C=0 if FAC1 = FAC2
+00B01ED6 6028 * returns d0=-1 C=1 if FAC1 < FAC2
+00B01ED6 6029
+00B01ED6 6030 LAB_27F0
+00B01ED6 7000 6031 MOVEQ #0,d0 * set for FAC1 = FAC2
+00B01ED8 122B 0600 6032 MOVE.b FAC2_e(a3),d1 * get FAC2 exponent
+00B01EDC B22B 05F8 6033 CMP.b FAC1_e(a3),d1 * compare FAC1 exponent with FAC2 exponent
+00B01EE0 660A 6034 BNE.s LAB_27F1 * branch if different
+00B01EE2 6035
+00B01EE2 222B 05FC 6036 MOVE.l FAC2_m(a3),d1 * get FAC2 mantissa
+00B01EE6 B2AB 05F4 6037 CMP.l FAC1_m(a3),d1 * compare mantissas
+00B01EEA 6708 6038 BEQ.s LAB_27F3 * exit if mantissas equal
+00B01EEC 6039
+00B01EEC 6040 LAB_27F1
+00B01EEC 6504 6041 BCS.s LAB_27F2 * if FAC1 > FAC2 return d0=+1,C=0
+00B01EEE 6042
+00B01EEE 5380 6043 SUBQ.l #1,d0 * else FAC1 < FAC2 return d0=-1,C=1
+00B01EF0 4E75 6044 RTS
+00B01EF2 6045
+00B01EF2 6046 LAB_27F2
+00B01EF2 5280 6047 ADDQ.l #1,d0
+00B01EF4 6048 LAB_27F3
+00B01EF4 4E75 6049 RTS
+00B01EF6 6050
+00B01EF6 6051
+00B01EF6 6052 *************************************************************************************
+00B01EF6 6053 *
+00B01EF6 6054 * make FAC1 = 1
+00B01EF6 6055
+00B01EF6 6056 LAB_POON
+00B01EF6 277C 80000000 05F4 6057 MOVE.l #$80000000,FAC1_m(a3) * 1 mantissa
+00B01EFE 377C 8100 05F8 6058 MOVE.w #$8100,FAC1_e(a3) * 1 exonent & sign
+00B01F04 4E75 6059 RTS
+00B01F06 6060
+00B01F06 6061
+00B01F06 6062 *************************************************************************************
+00B01F06 6063 *
+00B01F06 6064 * make FAC1 = 0
+00B01F06 6065
+00B01F06 6066 LAB_POZE
+00B01F06 7000 6067 MOVEQ #0,d0 * clear longword
+00B01F08 2740 05F4 6068 MOVE.l d0,FAC1_m(a3) * 0 mantissa
+00B01F0C 3740 05F8 6069 MOVE.w d0,FAC1_e(a3) * 0 exonent & sign
+00B01F10 4E75 6070 RTS
+00B01F12 6071
+00B01F12 6072
+00B01F12 6073 *************************************************************************************
+00B01F12 6074 *
+00B01F12 6075 * perform power function
+00B01F12 6076 * the number is in FAC2, the power is in FAC1
+00B01F12 6077 * no longer trashes Itemp
+00B01F12 6078
+00B01F12 6079 LAB_POWER
+00B01F12 4A2B 05F8 6080 TST.b FAC1_e(a3) * test power
+00B01F16 67DE 6081 BEQ.s LAB_POON * if zero go return 1
+00B01F18 6082
+00B01F18 4A2B 0600 6083 TST.b FAC2_e(a3) * test number
+00B01F1C 67E8 6084 BEQ.s LAB_POZE * if zero go return 0
+00B01F1E 6085
+00B01F1E 1F2B 0601 6086 MOVE.b FAC2_s(a3),-(sp) * save number sign
+00B01F22 6A20 6087 BPL.s LAB_POWP * power of positive number
+00B01F24 6088
+00B01F24 7200 6089 MOVEQ #0,d1 * clear d1
+00B01F26 1741 0601 6090 MOVE.b d1,FAC2_s(a3) * make sign +ve
+00B01F2A 6091
+00B01F2A 6092 * number sign was -ve and can only be raised to
+00B01F2A 6093 * an integer power which gives an x +j0 result,
+00B01F2A 6094 * else do 'function call' error
+00B01F2A 122B 05F8 6095 MOVE.b FAC1_e(a3),d1 * get power exponent
+00B01F2E 0441 0080 6096 SUB.w #$80,d1 * normalise to .5
+00B01F32 6300 E22A 6097 BLS LAB_FCER * if 0INT(power) then do 'function call'
+00B01F40 6103 * error
+00B01F40 6104
+00B01F40 6502 6105 BCS.s LAB_POWP * if integer value odd then leave result -ve
+00B01F42 6106
+00B01F42 1E80 6107 MOVE.b d0,(sp) * save result sign +ve
+00B01F44 6108 LAB_POWP
+00B01F44 2F2B 05F4 6109 MOVE.l FAC1_m(a3),-(sp) * save power mantissa
+00B01F48 3F2B 05F8 6110 MOVE.w FAC1_e(a3),-(sp) * save power sign & exponent
+00B01F4C 6111
+00B01F4C 6100 FC78 6112 BSR LAB_279B * copy number to FAC1
+00B01F50 6100 F9E8 6113 BSR LAB_LOG * find log of number
+00B01F54 6114
+00B01F54 301F 6115 MOVE.w (sp)+,d0 * get power sign & exponent
+00B01F56 275F 05FC 6116 MOVE.l (sp)+,FAC2_m(a3) * get power mantissa
+00B01F5A 3740 0600 6117 MOVE.w d0,FAC2_e(a3) * save sign & exponent to FAC2
+00B01F5E 1740 0602 6118 MOVE.b d0,FAC_sc(a3) * save sign as sign compare
+00B01F62 102B 05F9 6119 MOVE.b FAC1_s(a3),d0 * get FAC1 sign
+00B01F66 B12B 0602 6120 EOR.b d0,FAC_sc(a3) * make sign compare (FAC1_s EOR FAC2_s)
+00B01F6A 6121
+00B01F6A 6100 FAC0 6122 BSR LAB_MULTIPLY * multiply by power
+00B01F6E 6158 6123 BSR.s LAB_EXP * find exponential
+00B01F70 175F 05F9 6124 MOVE.b (sp)+,FAC1_s(a3) * restore number sign
+00B01F74 4E75 6125 RTS
+00B01F76 6126
+00B01F76 6127
+00B01F76 6128 *************************************************************************************
+00B01F76 6129 *
+00B01F76 6130 * do - FAC1
+00B01F76 6131
+00B01F76 6132 LAB_GTHAN
+00B01F76 4A2B 05F8 6133 TST.b FAC1_e(a3) * test for non zero FAC1
+00B01F7A 6706 6134 BEQ.s RTS_020 * branch if null
+00B01F7C 6135
+00B01F7C 0A2B 0080 05F9 6136 EORI.b #$80,FAC1_s(a3) * (else) toggle FAC1 sign bit
+00B01F82 6137 RTS_020
+00B01F82 4E75 6138 RTS
+00B01F84 6139
+00B01F84 6140
+00B01F84 6141 *************************************************************************************
+00B01F84 6142 *
+00B01F84 6143 * return +1
+00B01F84 6144 LAB_EX1
+00B01F84 277C 80000000 05F4 6145 MOVE.l #$80000000,FAC1_m(a3) * +1 mantissa
+00B01F8C 377C 8100 05F8 6146 MOVE.w #$8100,FAC1_e(a3) * +1 sign & exponent
+00B01F92 4E75 6147 RTS
+00B01F94 6148 * do over/under flow
+00B01F94 6149 LAB_EXOU
+00B01F94 4A2B 05F9 6150 TST.b FAC1_s(a3) * test sign
+00B01F98 6A00 E1C0 6151 BPL LAB_OFER * was +ve so do overflow error
+00B01F9C 6152
+00B01F9C 6153 * else underflow so return zero
+00B01F9C 7000 6154 MOVEQ #0,d0 * clear longword
+00B01F9E 2740 05F4 6155 MOVE.l d0,FAC1_m(a3) * 0 mantissa
+00B01FA2 3740 05F8 6156 MOVE.w d0,FAC1_e(a3) * 0 sign & exponent
+00B01FA6 4E75 6157 RTS
+00B01FA8 6158 * fraction was zero so do 2^n
+00B01FA8 6159 LAB_EXOF
+00B01FA8 277C 80000000 05F4 6160 MOVE.l #$80000000,FAC1_m(a3) * +n mantissa
+00B01FB0 177C 0000 05F9 6161 MOVE.b #0,FAC1_s(a3) * clear sign
+00B01FB6 4A2B 0618 6162 TST.b cosout(a3) * test sign flag
+00B01FBA 6A02 6163 BPL.s LAB_EXOL * branch if +ve
+00B01FBC 6164
+00B01FBC 4481 6165 NEG.l d1 * else do 1/2^n
+00B01FBE 6166 LAB_EXOL
+00B01FBE 0601 0081 6167 ADD.b #$81,d1 * adjust exponent
+00B01FC2 1741 05F8 6168 MOVE.b d1,FAC1_e(a3) * save exponent
+00B01FC6 4E75 6169 RTS
+00B01FC8 6170
+00B01FC8 6171 * perform EXP() (x^e)
+00B01FC8 6172 * valid input range is -88 to +88
+00B01FC8 6173
+00B01FC8 6174 LAB_EXP
+00B01FC8 102B 05F8 6175 MOVE.b FAC1_e(a3),d0 * get exponent
+00B01FCC 67B6 6176 BEQ.s LAB_EX1 * return 1 for zero in
+00B01FCE 6177
+00B01FCE B03C 0064 6178 CMP.b #$64,d0 * compare exponent with min
+00B01FD2 65B0 6179 BCS.s LAB_EX1 * if smaller just return 1
+00B01FD4 6180
+00B01FD4 6181 ** MOVEM.l d1-d6/a0,-(sp) * save the registers
+00B01FD4 177C 0000 0618 6182 MOVE.b #0,cosout(a3) * flag +ve number
+00B01FDA 222B 05F4 6183 MOVE.l FAC1_m(a3),d1 * get mantissa
+00B01FDE B03C 0087 6184 CMP.b #$87,d0 * compare exponent with max
+00B01FE2 62B0 6185 BHI.s LAB_EXOU * go do over/under flow if greater
+00B01FE4 6186
+00B01FE4 6608 6187 BNE.s LAB_EXCM * branch if less
+00B01FE6 6188
+00B01FE6 6189 * else is 2^7
+00B01FE6 B2BC B00F33C7 6190 CMP.l #$B00F33C7,d1 * compare mantissa with n*2^7 max
+00B01FEC 64A6 6191 BCC.s LAB_EXOU * if => go over/underflow
+00B01FEE 6192
+00B01FEE 6193 LAB_EXCM
+00B01FEE 4A2B 05F9 6194 TST.b FAC1_s(a3) * test sign
+00B01FF2 6A0C 6195 BPL.s LAB_EXPS * branch if arg +ve
+00B01FF4 6196
+00B01FF4 177C 00FF 0618 6197 MOVE.b #$FF,cosout(a3) * flag -ve number
+00B01FFA 177C 0000 05F9 6198 MOVE.b #0,FAC1_s(a3) * take absolute value
+00B02000 6199 LAB_EXPS
+00B02000 6200 * now do n/LOG(2)
+00B02000 277C B8AA3B29 05FC 6201 MOVE.l #$B8AA3B29,FAC2_m(a3) * 1/LOG(2) mantissa
+00B02008 377C 8100 0600 6202 MOVE.w #$8100,FAC2_e(a3) * 1/LOG(2) exponent & sign
+00B0200E 177C 0000 0602 6203 MOVE.b #0,FAC_sc(a3) * we know they're both +ve
+00B02014 6100 FA16 6204 BSR LAB_MULTIPLY * effectively divide by log(2)
+00B02018 6205
+00B02018 6206 * max here is +/- 127
+00B02018 6207 * now separate integer and fraction
+00B02018 177C 0000 063D 6208 MOVE.b #0,tpower(a3) * clear exponent add byte
+00B0201E 1A2B 05F8 6209 MOVE.b FAC1_e(a3),d5 * get exponent
+00B02022 0405 0080 6210 SUB.b #$80,d5 * normalise
+00B02026 6324 6211 BLS.s LAB_ESML * branch if < 1 (d5 is 0 or -ve)
+00B02028 6212
+00B02028 6213 * result is > 1
+00B02028 202B 05F4 6214 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B0202C 2200 6215 MOVE.l d0,d1 * copy it
+00B0202E 2C05 6216 MOVE.l d5,d6 * copy normalised exponent
+00B02030 6217
+00B02030 4446 6218 NEG.w d6 * make -ve
+00B02032 0646 0020 6219 ADD.w #32,d6 * is now 32-d6
+00B02036 ECA9 6220 LSR.l d6,d1 * just integer bits
+00B02038 1741 063D 6221 MOVE.b d1,tpower(a3) * set exponent add byte
+00B0203C 6222
+00B0203C EBA8 6223 LSL.l d5,d0 * shift out integer bits
+00B0203E 6700 FF68 6224 BEQ LAB_EXOF * fraction is zero so do 2^n
+00B02042 6225
+00B02042 2740 05F4 6226 MOVE.l d0,FAC1_m(a3) * fraction to FAC1
+00B02046 377C 8000 05F8 6227 MOVE.w #$8000,FAC1_e(a3) * set exponent & sign
+00B0204C 6228
+00B0204C 6229 * multiple was < 1
+00B0204C 6230 LAB_ESML
+00B0204C 277C B17217F8 05FC 6231 MOVE.l #$B17217F8,FAC2_m(a3) * LOG(2) mantissa
+00B02054 377C 8000 0600 6232 MOVE.w #$8000,FAC2_e(a3) * LOG(2) exponent & sign
+00B0205A 177C 0000 0602 6233 MOVE.b #0,FAC_sc(a3) * clear sign compare
+00B02060 6100 F9CA 6234 BSR LAB_MULTIPLY * multiply by log(2)
+00B02064 6235
+00B02064 202B 05F4 6236 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B02068 1A2B 05F8 6237 MOVE.b FAC1_e(a3),d5 * get exponent
+00B0206C 0445 0082 6238 SUB.w #$82,d5 * normalise and -2 (result is -1 to -30)
+00B02070 4445 6239 NEG.w d5 * make +ve
+00B02072 EAA8 6240 LSR.l d5,d0 * shift for 2 integer bits
+00B02074 6241
+00B02074 6242 * d0 = arg
+00B02074 6243 * d6 = x, d1 = y
+00B02074 6244 * d2 = x1, d3 = y1
+00B02074 6245 * d4 = shift count
+00B02074 6246 * d5 = loop count
+00B02074 6247 * now do cordic set-up
+00B02074 7200 6248 MOVEQ #0,d1 * y = 0
+00B02076 2C3C 26A3D110 6249 MOVE.l #KFCTSEED,d6 * x = 1 with jkh inverse factored out
+00B0207C 41FA 0D2A 6250 LEA TAB_HTHET(pc),a0 * get pointer to hyperbolic arctan table
+00B02080 7800 6251 MOVEQ #0,d4 * clear shift count
+00B02082 6252
+00B02082 6253 * cordic loop, shifts 4 and 13 (and 39
+00B02082 6254 * if it went that far) need to be repeated
+00B02082 7A03 6255 MOVEQ #3,d5 * 4 loops
+00B02084 6136 6256 BSR.s LAB_EXCC * do loops 1 through 4
+00B02086 5948 6257 SUBQ.w #4,a0 * do table entry again
+00B02088 5384 6258 SUBQ.l #1,d4 * do shift count again
+00B0208A 7A09 6259 MOVEQ #9,d5 * 10 loops
+00B0208C 612E 6260 BSR.s LAB_EXCC * do loops 4 (again) through 13
+00B0208E 5948 6261 SUBQ.w #4,a0 * do table entry again
+00B02090 5384 6262 SUBQ.l #1,d4 * do shift count again
+00B02092 7A12 6263 MOVEQ #18,d5 * 19 loops
+00B02094 6126 6264 BSR.s LAB_EXCC * do loops 13 (again) through 31
+00B02096 6265
+00B02096 6266 * now get the result
+00B02096 4A2B 0618 6267 TST.b cosout(a3) * test sign flag
+00B0209A 6A06 6268 BPL.s LAB_EXPL * branch if +ve
+00B0209C 6269
+00B0209C 4481 6270 NEG.l d1 * do -y
+00B0209E 442B 063D 6271 NEG.b tpower(a3) * do -exp
+00B020A2 6272 LAB_EXPL
+00B020A2 7083 6273 MOVEQ #$83-$100,d0 * set exponent
+00B020A4 DC81 6274 ADD.l d1,d6 * y = y +/- x
+00B020A6 6B06 6275 BMI.s LAB_EXRN * branch if result normal
+00B020A8 6276
+00B020A8 6277 LAB_EXNN
+00B020A8 5380 6278 SUBQ.l #1,d0 * decrement exponent
+00B020AA DC86 6279 ADD.l d6,d6 * shift mantissa
+00B020AC 6AFA 6280 BPL.s LAB_EXNN * loop if not normal
+00B020AE 6281
+00B020AE 6282 LAB_EXRN
+00B020AE 2746 05F4 6283 MOVE.l d6,FAC1_m(a3) * save exponent result
+00B020B2 D02B 063D 6284 ADD.b tpower(a3),d0 * add integer part
+00B020B6 1740 05F8 6285 MOVE.b d0,FAC1_e(a3) * save exponent
+00B020BA 6286 ** MOVEM.l (sp)+,d1-d6/a0 * restore registers
+00B020BA 4E75 6287 RTS
+00B020BC 6288
+00B020BC 6289 * cordic loop
+00B020BC 6290 LAB_EXCC
+00B020BC 5284 6291 ADDQ.l #1,d4 * increment shift count
+00B020BE 2406 6292 MOVE.l d6,d2 * x1 = x
+00B020C0 E8A2 6293 ASR.l d4,d2 * x1 >> n
+00B020C2 2601 6294 MOVE.l d1,d3 * y1 = y
+00B020C4 E8A3 6295 ASR.l d4,d3 * y1 >> n
+00B020C6 4A80 6296 TST.l d0 * test arg
+00B020C8 6B0C 6297 BMI.s LAB_EXAD * branch if -ve
+00B020CA 6298
+00B020CA D282 6299 ADD.l d2,d1 * y = y + x1
+00B020CC DC83 6300 ADD.l d3,d6 * x = x + y1
+00B020CE 9098 6301 SUB.l (a0)+,d0 * arg = arg - atnh(a0)
+00B020D0 51CD FFEA 6302 DBF d5,LAB_EXCC * decrement and loop if not done
+00B020D4 6303
+00B020D4 4E75 6304 RTS
+00B020D6 6305
+00B020D6 6306 LAB_EXAD
+00B020D6 9282 6307 SUB.l d2,d1 * y = y - x1
+00B020D8 9C83 6308 SUB.l d3,d6 * x = x + y1
+00B020DA D098 6309 ADD.l (a0)+,d0 * arg = arg + atnh(a0)
+00B020DC 51CD FFDE 6310 DBF d5,LAB_EXCC * decrement and loop if not done
+00B020E0 6311
+00B020E0 4E75 6312 RTS
+00B020E2 6313
+00B020E2 6314
+00B020E2 6315 *************************************************************************************
+00B020E2 6316 *
+00B020E2 6317 * RND(n), 32 bit Galois version. make n=0 for 19th next number in sequence or n<>0
+00B020E2 6318 * to get 19th next number in sequence after seed n. This version of the PRNG uses
+00B020E2 6319 * the Galois method and a sample of 65536 bytes produced gives the following values.
+00B020E2 6320
+00B020E2 6321 * Entropy = 7.997442 bits per byte
+00B020E2 6322 * Optimum compression would reduce these 65536 bytes by 0 percent
+00B020E2 6323
+00B020E2 6324 * Chi square distribution for 65536 samples is 232.01, and
+00B020E2 6325 * randomly would exceed this value 75.00 percent of the time
+00B020E2 6326
+00B020E2 6327 * Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
+00B020E2 6328 * Monte Carlo value for Pi is 3.122871269, error 0.60 percent
+00B020E2 6329 * Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0
+00B020E2 6330
+00B020E2 6331 LAB_RND
+00B020E2 4A2B 05F8 6332 TST.b FAC1_e(a3) * get FAC1 exponent
+00B020E6 6708 6333 BEQ.s NextPRN * do next random number if zero
+00B020E8 6334
+00B020E8 6335 * else get seed into random number store
+00B020E8 41EB 0604 6336 LEA PRNlword(a3),a0 * set PRNG pointer
+00B020EC 6100 FAB2 6337 BSR LAB_2778 * pack FAC1 into (a0)
+00B020F0 6338 NextPRN
+00B020F0 72AF 6339 MOVEQ #$AF-$100,d1 * set EOR value
+00B020F2 7412 6340 MOVEQ #18,d2 * do this 19 times
+00B020F4 202B 0604 6341 MOVE.l PRNlword(a3),d0 * get current
+00B020F8 6342 Ninc0
+00B020F8 D080 6343 ADD.l d0,d0 * shift left 1 bit
+00B020FA 6402 6344 BCC.s Ninc1 * branch if bit 32 not set
+00B020FC 6345
+00B020FC B300 6346 EOR.b d1,d0 * do Galois LFSR feedback
+00B020FE 6347 Ninc1
+00B020FE 51CA FFF8 6348 DBF d2,Ninc0 * loop
+00B02102 6349
+00B02102 2740 0604 6350 MOVE.l d0,PRNlword(a3) * save back to seed word
+00B02106 2740 05F4 6351 MOVE.l d0,FAC1_m(a3) * copy to FAC1 mantissa
+00B0210A 377C 8000 05F8 6352 MOVE.w #$8000,FAC1_e(a3) * set the exponent and clear the sign
+00B02110 6000 F7F2 6353 BRA LAB_24D5 * normalise FAC1 & return
+00B02114 6354
+00B02114 6355
+00B02114 6356 *************************************************************************************
+00B02114 6357 *
+00B02114 6358 * cordic TAN(x) routine, TAN(x) = SIN(x)/COS(x)
+00B02114 6359 * x = angle in radians
+00B02114 6360
+00B02114 6361 LAB_TAN
+00B02114 6138 6362 BSR.s LAB_SIN * go do SIN/COS cordic compute
+00B02116 376B 05F8 0600 6363 MOVE.w FAC1_e(a3),FAC2_e(a3) * copy exponent & sign from FAC1 to FAC2
+00B0211C 276B 05F4 05FC 6364 MOVE.l FAC1_m(a3),FAC2_m(a3) * copy FAC1 mantissa to FAC2 mantissa
+00B02122 2741 05F4 6365 MOVE.l d1,FAC1_m(a3) * get COS(x) mantissa
+00B02126 1743 05F8 6366 MOVE.b d3,FAC1_e(a3) * get COS(x) exponent
+00B0212A 6700 E02E 6367 BEQ LAB_OFER * do overflow if COS = 0
+00B0212E 6368
+00B0212E 6100 F7D4 6369 BSR LAB_24D5 * normalise FAC1
+00B02132 6000 F984 6370 BRA LAB_DIVIDE * do FAC2/FAC1 and return, FAC_sc set by SIN
+00B02136 6371 * COS calculation
+00B02136 6372
+00B02136 6373
+00B02136 6374 *************************************************************************************
+00B02136 6375 *
+00B02136 6376 * cordic SIN(x), COS(x) routine
+00B02136 6377 * x = angle in radians
+00B02136 6378
+00B02136 6379 LAB_COS
+00B02136 277C C90FDAA3 05FC 6380 MOVE.l #$C90FDAA3,FAC2_m(a3) * pi/2 mantissa (LSB is rounded up so
+00B0213E 6381 * COS(PI/2)=0)
+00B0213E 377C 8100 0600 6382 MOVE.w #$8100,FAC2_e(a3) * pi/2 exponent and sign
+00B02144 176B 05F9 0602 6383 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign = FAC1 sign (b7)
+00B0214A 6100 F73C 6384 BSR LAB_ADD * add FAC2 to FAC1, adjust for COS(x)
+00B0214E 6385
+00B0214E 6386
+00B0214E 6387 *************************************************************************************
+00B0214E 6388 *
+00B0214E 6389 * SIN/COS cordic calculator
+00B0214E 6390
+00B0214E 6391 LAB_SIN
+00B0214E 177C 0000 0618 6392 MOVE.b #0,cosout(a3) * set needed result
+00B02154 6393
+00B02154 277C A2F9836F 05FC 6394 MOVE.l #$A2F9836F,FAC2_m(a3) * 1/pi mantissa (LSB is rounded up so SIN(PI)=0)
+00B0215C 377C 7F00 0600 6395 MOVE.w #$7F00,FAC2_e(a3) * 1/pi exponent & sign
+00B02162 176B 05F9 0602 6396 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign = FAC1 sign (b7)
+00B02168 6100 F8C2 6397 BSR LAB_MULTIPLY * multiply by 1/pi
+00B0216C 6398
+00B0216C 102B 05F8 6399 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
+00B02170 671C 6400 BEQ.s LAB_SCZE * branch if zero
+00B02172 6401
+00B02172 41FA 0B34 6402 LEA TAB_SNCO(pc),a0 * get pointer to constants table
+00B02176 2C2B 05F4 6403 MOVE.l FAC1_m(a3),d6 * get FAC1 mantissa
+00B0217A 5300 6404 SUBQ.b #1,d0 * 2 radians in 360 degrees so /2
+00B0217C 6710 6405 BEQ.s LAB_SCZE * branch if zero
+00B0217E 6406
+00B0217E 0400 0080 6407 SUB.b #$80,d0 * normalise exponent
+00B02182 6B18 6408 BMI.s LAB_SCL0 * branch if < 1
+00B02184 6409
+00B02184 6410 * X is > 1
+00B02184 B03C 0020 6411 CMP.b #$20,d0 * is it >= 2^32
+00B02188 6404 6412 BCC.s LAB_SCZE * may as well do zero
+00B0218A 6413
+00B0218A E1AE 6414 LSL.l d0,d6 * shift out integer part bits
+00B0218C 6618 6415 BNE.s LAB_CORD * if fraction go test quadrant and adjust
+00B0218E 6416
+00B0218E 6417 * else no fraction so do zero
+00B0218E 6418 LAB_SCZE
+00B0218E 7481 6419 MOVEQ #$81-$100,d2 * set exponent for 1.0
+00B02190 7600 6420 MOVEQ #0,d3 * set exponent for 0.0
+00B02192 203C 80000000 6421 MOVE.l #$80000000,d0 * mantissa for 1.0
+00B02198 2203 6422 MOVE.l d3,d1 * mantissa for 0.0
+00B0219A 6062 6423 BRA.s outloop * go output it
+00B0219C 6424
+00B0219C 6425 * x is < 1
+00B0219C 6426 LAB_SCL0
+00B0219C 4400 6427 NEG.b d0 * make +ve
+00B0219E B03C 001E 6428 CMP.b #$1E,d0 * is it <= 2^-30
+00B021A2 64EA 6429 BCC.s LAB_SCZE * may as well do zero
+00B021A4 6430
+00B021A4 E0AE 6431 LSR.l d0,d6 * shift out <= 2^-32 bits
+00B021A6 6432
+00B021A6 6433 * cordic calculator, argument in d6
+00B021A6 6434 * table pointer in a0, returns in d0-d3
+00B021A6 6435
+00B021A6 6436 LAB_CORD
+00B021A6 176B 05F9 0602 6437 MOVE.b FAC1_s(a3),FAC_sc(a3) * copy as sign compare for TAN
+00B021AC DC86 6438 ADD.l d6,d6 * shift 0.5 bit into carry
+00B021AE 6406 6439 BCC.s LAB_LTPF * branch if less than 0.5
+00B021B0 6440
+00B021B0 0A2B 00FF 05F9 6441 EORI.b #$FF,FAC1_s(a3) * toggle result sign
+00B021B6 6442 LAB_LTPF
+00B021B6 DC86 6443 ADD.l d6,d6 * shift 0.25 bit into carry
+00B021B8 640C 6444 BCC.s LAB_LTPT * branch if less than 0.25
+00B021BA 6445
+00B021BA 0A2B 00FF 0618 6446 EORI.b #$FF,cosout(a3) * toggle needed result
+00B021C0 0A2B 00FF 0602 6447 EORI.b #$FF,FAC_sc(a3) * toggle sign compare for TAN
+00B021C6 6448
+00B021C6 6449 LAB_LTPT
+00B021C6 E48E 6450 LSR.l #2,d6 * shift the bits back (clear integer bits)
+00B021C8 67C4 6451 BEQ.s LAB_SCZE * no fraction so go do zero
+00B021CA 6452
+00B021CA 6453 * set start values
+00B021CA 7A01 6454 MOVEQ #1,d5 * set bit count
+00B021CC 2028 FFFC 6455 MOVE.l -4(a0),d0 * get multiply constant (1st itteration d0)
+00B021D0 2200 6456 MOVE.l d0,d1 * 1st itteration d1
+00B021D2 9C98 6457 SUB.l (a0)+,d6 * 1st always +ve so do 1st step
+00B021D4 6008 6458 BRA.s mainloop * jump into routine
+00B021D6 6459
+00B021D6 6460 subloop
+00B021D6 9C98 6461 SUB.l (a0)+,d6 * z = z - arctan(i)/2pi
+00B021D8 9083 6462 SUB.l d3,d0 * x = x - y1
+00B021DA D282 6463 ADD.l d2,d1 * y = y + x1
+00B021DC 6012 6464 BRA.s nexta * back to main loop
+00B021DE 6465
+00B021DE 6466 mainloop
+00B021DE 2400 6467 MOVE.l d0,d2 * x1 = x
+00B021E0 EAA2 6468 ASR.l d5,d2 * / (2 ^ i)
+00B021E2 2601 6469 MOVE.l d1,d3 * y1 = y
+00B021E4 EAA3 6470 ASR.l d5,d3 * / (2 ^ i)
+00B021E6 4A86 6471 TST.l d6 * test sign (is 2^0 bit)
+00B021E8 6AEC 6472 BPL.s subloop * go do subtract if > 1
+00B021EA 6473
+00B021EA DC98 6474 ADD.l (a0)+,d6 * z = z + arctan(i)/2pi
+00B021EC D083 6475 ADD.l d3,d0 * x = x + y1
+00B021EE 9282 6476 SUB.l d2,d1 * y = y + x1
+00B021F0 6477 nexta
+00B021F0 5285 6478 ADDQ.l #1,d5 * i = i + 1
+00B021F2 BABC 0000001E 6479 CMP.l #$1E,d5 * check end condition
+00B021F8 66E4 6480 BNE.s mainloop * loop if not all done
+00B021FA 6481
+00B021FA 6482 * now untangle output value
+00B021FA 7481 6483 MOVEQ #$81-$100,d2 * set exponent for 0 to .99 rec.
+00B021FC 2602 6484 MOVE.l d2,d3 * copy it for cos output
+00B021FE 6485 outloop
+00B021FE 4A2B 0618 6486 TST.b cosout(a3) * did we want cos output?
+00B02202 6B04 6487 BMI.s subexit * if so skip
+00B02204 6488
+00B02204 C141 6489 EXG d0,d1 * swap SIN and COS mantissas
+00B02206 C543 6490 EXG d2,d3 * swap SIN and COS exponents
+00B02208 6491 subexit
+00B02208 2740 05F4 6492 MOVE.l d0,FAC1_m(a3) * set result mantissa
+00B0220C 1742 05F8 6493 MOVE.b d2,FAC1_e(a3) * set result exponent
+00B02210 6000 F6F2 6494 BRA LAB_24D5 * normalise FAC1 & return
+00B02214 6495
+00B02214 6496
+00B02214 6497
+00B02214 6498 *************************************************************************************
+00B02214 6499 *
+00B02214 6500 * perform ATN()
+00B02214 6501
+00B02214 6502 LAB_ATN
+00B02214 102B 05F8 6503 MOVE.b FAC1_e(a3),d0 * get FAC1 exponent
+00B02218 6700 00AA 6504 BEQ RTS_021 * ATN(0) = 0 so skip calculation
+00B0221C 6505
+00B0221C 177C 0000 0618 6506 MOVE.b #0,cosout(a3) * set result needed
+00B02222 B03C 0081 6507 CMP.b #$81,d0 * compare exponent with 1
+00B02226 6528 6508 BCS.s LAB_ATLE * branch if n<1
+00B02228 6509
+00B02228 6608 6510 BNE.s LAB_ATGO * branch if n>1
+00B0222A 6511
+00B0222A 202B 05F4 6512 MOVE.l FAC1_m(a3),d0 * get mantissa
+00B0222E D080 6513 ADD.l d0,d0 * shift left
+00B02230 671E 6514 BEQ.s LAB_ATLE * branch if n=1
+00B02232 6515
+00B02232 6516 LAB_ATGO
+00B02232 277C 80000000 05FC 6517 MOVE.l #$80000000,FAC2_m(a3) * set mantissa for 1
+00B0223A 377C 8100 0600 6518 MOVE.w #$8100,FAC2_e(a3) * set exponent for 1
+00B02240 176B 05F9 0602 6519 MOVE.b FAC1_s(a3),FAC_sc(a3) * sign compare = sign
+00B02246 6100 F870 6520 BSR LAB_DIVIDE * do 1/n
+00B0224A 177C 00FF 0618 6521 MOVE.b #$FF,cosout(a3) * set inverse result needed
+00B02250 6522 LAB_ATLE
+00B02250 202B 05F4 6523 MOVE.l FAC1_m(a3),d0 * get FAC1 mantissa
+00B02254 7282 6524 MOVEQ #$82,d1 * set to correct exponent
+00B02256 922B 05F8 6525 SUB.b FAC1_e(a3),d1 * subtract FAC1 exponent (always <= 1)
+00B0225A E2A8 6526 LSR.l d1,d0 * shift in two integer part bits
+00B0225C 41FA 0ACA 6527 LEA TAB_ATNC(pc),a0 * get pointer to arctan table
+00B02260 7C00 6528 MOVEQ #0,d6 * Z = 0
+00B02262 223C 40000000 6529 MOVE.l #1<<30,d1 * y = 1
+00B02268 7A1D 6530 MOVEQ #29,d5 * loop 30 times
+00B0226A 7801 6531 MOVEQ #1,d4 * shift counter
+00B0226C 6006 6532 BRA.s LAB_ATCD * enter loop
+00B0226E 6533
+00B0226E 6534 LAB_ATNP
+00B0226E E8A2 6535 ASR.l d4,d2 * x1 / 2^i
+00B02270 D282 6536 ADD.l d2,d1 * y = y + x1
+00B02272 DC90 6537 ADD.l (a0),d6 * z = z + atn(i)
+00B02274 6538 LAB_ATCD
+00B02274 2400 6539 MOVE.l d0,d2 * x1 = x
+00B02276 2601 6540 MOVE.l d1,d3 * y1 = y
+00B02278 E8A3 6541 ASR.l d4,d3 * y1 / 2^i
+00B0227A 6542 LAB_CATN
+00B0227A 9083 6543 SUB.l d3,d0 * x = x - y1
+00B0227C 6AF0 6544 BPL.s LAB_ATNP * branch if x >= 0
+00B0227E 6545
+00B0227E 2002 6546 MOVE.l d2,d0 * else get x back
+00B02280 5848 6547 ADDQ.w #4,a0 * increment pointer
+00B02282 5284 6548 ADDQ.l #1,d4 * increment i
+00B02284 E283 6549 ASR.l #1,d3 * y1 / 2^i
+00B02286 51CD FFF2 6550 DBF d5,LAB_CATN * decrement and loop if not done
+00B0228A 6551
+00B0228A 177C 0082 05F8 6552 MOVE.b #$82,FAC1_e(a3) * set new exponent
+00B02290 2746 05F4 6553 MOVE.l d6,FAC1_m(a3) * save mantissa
+00B02294 6100 F66E 6554 BSR LAB_24D5 * normalise FAC1
+00B02298 6555
+00B02298 4A2B 0618 6556 TST.b cosout(a3) * was it > 1 ?
+00B0229C 6A26 6557 BPL.s RTS_021 * branch if not
+00B0229E 6558
+00B0229E 1E2B 05F9 6559 MOVE.b FAC1_s(a3),d7 * get sign
+00B022A2 177C 0000 05F9 6560 MOVE.b #0,FAC1_s(a3) * clear sign
+00B022A8 277C C90FDAA2 05FC 6561 MOVE.l #$C90FDAA2,FAC2_m(a3) * set -(pi/2)
+00B022B0 377C 8180 0600 6562 MOVE.w #$8180,FAC2_e(a3) * set exponent and sign
+00B022B6 177C 00FF 0602 6563 MOVE.b #$FF,FAC_sc(a3) * set sign compare
+00B022BC 6100 F5CA 6564 BSR LAB_ADD * perform addition, FAC2 to FAC1
+00B022C0 1747 05F9 6565 MOVE.b d7,FAC1_s(a3) * restore sign
+00B022C4 6566 RTS_021
+00B022C4 4E75 6567 RTS
+00B022C6 6568
+00B022C6 6569
+00B022C6 6570 *************************************************************************************
+00B022C6 6571 *
+00B022C6 6572 * perform BITSET
+00B022C6 6573
+00B022C6 6574 LAB_BITSET
+00B022C6 6100 F4A0 6575 BSR LAB_GADB * get two parameters for POKE or WAIT
+00B022CA 6576 * first parameter in a0, second in d0
+00B022CA B03C 0008 6577 CMP.b #$08,d0 * only 0 to 7 are allowed
+00B022CE 6400 DE8E 6578 BCC LAB_FCER * branch if > 7
+00B022D2 6579
+00B022D2 01D0 6580 BSET d0,(a0) * set bit
+00B022D4 4E75 6581 RTS
+00B022D6 6582
+00B022D6 6583
+00B022D6 6584 *************************************************************************************
+00B022D6 6585 *
+00B022D6 6586 * perform BITCLR
+00B022D6 6587
+00B022D6 6588 LAB_BITCLR
+00B022D6 6100 F490 6589 BSR LAB_GADB * get two parameters for POKE or WAIT
+00B022DA 6590 * first parameter in a0, second in d0
+00B022DA B03C 0008 6591 CMP.b #$08,d0 * only 0 to 7 are allowed
+00B022DE 6400 DE7E 6592 BCC LAB_FCER * branch if > 7
+00B022E2 6593
+00B022E2 0190 6594 BCLR d0,(a0) * clear bit
+00B022E4 4E75 6595 RTS
+00B022E6 6596
+00B022E6 6597
+00B022E6 6598 *************************************************************************************
+00B022E6 6599 *
+00B022E6 6600 * perform BITTST()
+00B022E6 6601
+00B022E6 6602 LAB_BTST
+00B022E6 101D 6603 MOVE.b (a5)+,d0 * increment BASIC pointer
+00B022E8 6100 F47E 6604 BSR LAB_GADB * get two parameters for POKE or WAIT
+00B022EC 6605 * first parameter in a0, second in d0
+00B022EC B03C 0008 6606 CMP.b #$08,d0 * only 0 to 7 are allowed
+00B022F0 6400 DE6C 6607 BCC LAB_FCER * branch if > 7
+00B022F4 6608
+00B022F4 2200 6609 MOVE.l d0,d1 * copy bit # to test
+00B022F6 6100 EAB2 6610 BSR LAB_GBYT * get next BASIC byte
+00B022FA B03C 0029 6611 CMP.b #')',d0 * is next character ")"
+00B022FE 6600 DE6A 6612 BNE LAB_SNER * if not ")" go do syntax error, then warm start
+00B02302 6613
+00B02302 6100 EAA4 6614 BSR LAB_IGBY * update execute pointer (to character past ")")
+00B02306 7000 6615 MOVEQ #0,d0 * set the result as zero
+00B02308 0310 6616 BTST d1,(a0) * test bit
+00B0230A 6700 F90E 6617 BEQ LAB_27DB * branch if zero (already correct)
+00B0230E 6618
+00B0230E 70FF 6619 MOVEQ #-1,d0 * set for -1 result
+00B02310 6000 F908 6620 BRA LAB_27DB * go do SGN tail
+00B02314 6621
+00B02314 6622
+00B02314 6623 *************************************************************************************
+00B02314 6624 *
+00B02314 6625 * perform USING$()
+00B02314 6626
+00B02314 =00000000 6627 fsd EQU 0 * (sp) format string descriptor pointer
+00B02314 =00000004 6628 fsti EQU 4 * 4(sp) format string this index
+00B02314 =00000006 6629 fsli EQU 6 * 6(sp) format string last index
+00B02314 =00000008 6630 fsdpi EQU 8 * 8(sp) format string decimal point index
+00B02314 =0000000A 6631 fsdc EQU 10 * 10(sp) format string decimal characters
+00B02314 =00000008 6632 fend EQU 12-4 * x(sp) end-4, fsd is popped by itself
+00B02314 6633
+00B02314 =00000023 6634 ofchr EQU '#' * the overflow character
+00B02314 6635
+00B02314 6636 LAB_USINGS
+00B02314 4A2B 0619 6637 TST.b Dtypef(a3) * test data type, $80=string
+00B02318 6A00 DDFC 6638 BPL LAB_FOER * if not string type go do format error
+00B0231C 6639
+00B0231C 246B 05F4 6640 MOVEA.l FAC1_m(a3),a2 * get the format string descriptor pointer
+00B02320 3E2A 0004 6641 MOVE.w 4(a2),d7 * get the format string length
+00B02324 6700 DDF0 6642 BEQ LAB_FOER * if null string go do format error
+00B02328 6643
+00B02328 6644 * clear the format string values
+00B02328 6645
+00B02328 7000 6646 MOVEQ #0,d0 * clear d0
+00B0232A 3F00 6647 MOVE.w d0,-(sp) * clear the format string decimal characters
+00B0232C 3F00 6648 MOVE.w d0,-(sp) * clear the format string decimal point index
+00B0232E 3F00 6649 MOVE.w d0,-(sp) * clear the format string last index
+00B02330 3F00 6650 MOVE.w d0,-(sp) * clear the format string this index
+00B02332 2F0A 6651 MOVE.l a2,-(sp) * save the format string descriptor pointer
+00B02334 6652
+00B02334 6653 * make a null return string for the first string add
+00B02334 6654
+00B02334 7200 6655 MOVEQ #0,d1 * make a null string
+00B02336 2041 6656 MOVEA.l d1,a0 * with a null pointer
+00B02338 6100 F0CA 6657 BSR LAB_RTST * push a string on the descriptor stack
+00B0233C 6658 * a0 = pointer, d1 = length
+00B0233C 6659
+00B0233C 6660 * do the USING$() function next value
+00B0233C 6661
+00B0233C 101D 6662 MOVE.b (a5)+,d0 * get the next BASIC byte
+00B0233E 6663 LAB_U002
+00B0233E B03C 002C 6664 CMP.b #',',d0 * compare with comma
+00B02342 6600 DE26 6665 BNE LAB_SNER * if not "," go do syntax error
+00B02346 6666
+00B02346 6100 028E 6667 BSR LAB_ProcFo * process the format string
+00B0234A 4A02 6668 TST.b d2 * test the special characters flag
+00B0234C 6700 DDC8 6669 BEQ LAB_FOER * if no special characters go do format error
+00B02350 6670
+00B02350 6100 E8F6 6671 BSR LAB_EVEX * evaluate the expression
+00B02354 4A2B 0619 6672 TST.b Dtypef(a3) * test the data type
+00B02358 6B00 DDE4 6673 BMI LAB_TMER * if string type go do type missmatch error
+00B0235C 6674
+00B0235C 4A2B 05F8 6675 TST.b FAC1_e(a3) * test FAC1 exponent
+00B02360 6732 6676 BEQ.s LAB_U004 * if FAC1 = 0 skip the rounding
+00B02362 6677
+00B02362 322F 000A 6678 MOVE.w fsdc(sp),d1 * get the format string decimal character count
+00B02366 B27C 0008 6679 CMP.w #8,d1 * compare the fraction digit count with 8
+00B0236A 6428 6680 BCC.s LAB_U004 * if >= 8 skip the rounding
+00B0236C 6681
+00B0236C 3001 6682 MOVE.w d1,d0 * else copy the fraction digit count
+00B0236E D241 6683 ADD.w d1,d1 * * 2
+00B02370 D240 6684 ADD.w d0,d1 * * 3
+00B02372 D241 6685 ADD.w d1,d1 * * 6
+00B02374 41FA 0844 6686 LEA LAB_P_10(pc),a0 * get the rounding table base
+00B02378 2770 1002 05FC 6687 MOVE.l 2(a0,d1.w),FAC2_m(a3) * get the rounding mantissa
+00B0237E 3030 1000 6688 MOVE.w (a0,d1.w),d0 * get the rounding exponent
+00B02382 0440 0100 6689 SUB.w #$100,d0 * effectively divide the mantissa by 2
+00B02386 3740 0600 6690 MOVE.w d0,FAC2_e(a3) * save the rounding exponent
+00B0238A 177C 0000 0602 6691 MOVE.b #$00,FAC_sc(a3) * clear the sign compare
+00B02390 6100 F4F6 6692 BSR LAB_ADD * round the value to n places
+00B02394 6693 LAB_U004
+00B02394 6100 F970 6694 BSR LAB_2970 * convert FAC1 to string - not on stack
+00B02398 6695
+00B02398 6100 01FE 6696 BSR LAB_DupFmt * duplicate the processed format string section
+00B0239C 6697 * returns length in d1, pointer in a0
+00B0239C 6698
+00B0239C 6699 * process the number string, length in d6, decimal point index in d2
+00B0239C 6700
+00B0239C 45EB 062A 6701 LEA Decss(a3),a2 * set the number string start
+00B023A0 7C00 6702 MOVEQ #0,d6 * clear the number string index
+00B023A2 782E 6703 MOVEQ #'.',d4 * set the decimal point character
+00B023A4 6704 LAB_U005
+00B023A4 3406 6705 MOVE.w d6,d2 * save the index to flag the decimal point
+00B023A6 6706 LAB_U006
+00B023A6 5246 6707 ADDQ.w #1,d6 * increment the number string index
+00B023A8 1032 6000 6708 MOVE.b (a2,d6.w),d0 * get a number string character
+00B023AC 677A 6709 BEQ.s LAB_U010 * if null then number complete
+00B023AE 6710
+00B023AE B03C 0045 6711 CMP.b #'E',d0 * compare the character with an "E"
+00B023B2 6706 6712 BEQ.s LAB_U008 * was sx[.x]Esxx so go handle sci notation
+00B023B4 6713
+00B023B4 B004 6714 CMP.b d4,d0 * compare the character with "."
+00B023B6 66EE 6715 BNE.s LAB_U006 * if not decimal point go get the next digit
+00B023B8 6716
+00B023B8 60EA 6717 BRA.s LAB_U005 * go save the index and get the next digit
+00B023BA 6718
+00B023BA 6719 * have found an sx[.x]Esxx number, the [.x] will not be present for a single digit
+00B023BA 6720
+00B023BA 6721 LAB_U008
+00B023BA 3606 6722 MOVE.w d6,d3 * copy the index to the "E"
+00B023BC 5343 6723 SUBQ.w #1,d3 * -1 gives the last digit index
+00B023BE 6724
+00B023BE 5246 6725 ADDQ.w #1,d6 * increment the index to the exponent sign
+00B023C0 1032 6000 6726 MOVE.b (a2,d6.w),d0 * get the exponent sign character
+00B023C4 B03C 002D 6727 CMP.b #'-',d0 * compare the exponent sign with "-"
+00B023C8 6600 DD94 6728 BNE LAB_FCER * if it wasn't sx[.x]E-xx go do function
+00B023CC 6729 * call error
+00B023CC 6730
+00B023CC 6731 * found an sx[.x]E-xx number so check the exponent magnitude
+00B023CC 6732
+00B023CC 5246 6733 ADDQ.w #1,d6 * increment the index to the exponent 10s
+00B023CE 1032 6000 6734 MOVE.b (a2,d6.w),d0 * get the exponent 10s character
+00B023D2 B03C 0030 6735 CMP.b #'0',d0 * compare the exponent 10s with "0"
+00B023D6 6704 6736 BEQ.s LAB_U009 * if it was sx[.x]E-0x go get the exponent
+00B023D8 6737 * 1s character
+00B023D8 6738
+00B023D8 700A 6739 MOVEQ #10,d0 * else start writing at index 10
+00B023DA 6008 6740 BRA.s LAB_U00A * go copy the digits
+00B023DC 6741
+00B023DC 6742 * found an sx[.x]E-0x number so get the exponent magnitude
+00B023DC 6743
+00B023DC 6744 LAB_U009
+00B023DC 5246 6745 ADDQ.w #1,d6 * increment the index to the exponent 1s
+00B023DE 700F 6746 MOVEQ #$0F,d0 * set the mask for the exponent 1s digit
+00B023E0 C032 6000 6747 AND.b (a2,d6.w),d0 * get and convert the exponent 1s digit
+00B023E4 6748 LAB_U00A
+00B023E4 3403 6749 MOVE.w d3,d2 * copy the number last digit index
+00B023E6 0C42 0001 6750 CMPI.w #1,d2 * is the number of the form sxE-0x
+00B023EA 6602 6751 BNE.s LAB_U00B * if it is sx.xE-0x skip the increment
+00B023EC 6752
+00B023EC 6753 * else make room for the decimal point
+00B023EC 5242 6754 ADDQ.w #1,d2 * add 1 to the write index
+00B023EE 6755 LAB_U00B
+00B023EE D440 6756 ADD.w d0,d2 * add the exponent 1s to the write index
+00B023F0 700A 6757 MOVEQ #10,d0 * set the maximum write index
+00B023F2 9042 6758 SUB.w d2,d0 * compare the index with the maximum
+00B023F4 6E0C 6759 BGT.s LAB_U00C * if the index < the maximum continue
+00B023F6 6760
+00B023F6 D440 6761 ADD.w d0,d2 * else set the index to the maximum
+00B023F8 D640 6762 ADD.w d0,d3 * adjust the read index
+00B023FA 0C43 0001 6763 CMPI.w #1,d3 * compare the adjusted index with 1
+00B023FE 6E02 6764 BGT.s LAB_U00C * if > 1 continue
+00B02400 6765
+00B02400 7600 6766 MOVEQ #0,d3 * else allow for the decimal point
+00B02402 6767 LAB_U00C
+00B02402 3C02 6768 MOVE.w d2,d6 * copy the write index as the number
+00B02404 6769 * string length
+00B02404 7000 6770 MOVEQ #0,d0 * clear d0 to null terminate the number
+00B02406 6771 * string
+00B02406 6772 LAB_U00D
+00B02406 1580 2000 6773 MOVE.b d0,(a2,d2.w) * save the character to the number string
+00B0240A 5342 6774 SUBQ.w #1,d2 * decrement the number write index
+00B0240C 0C42 0001 6775 CMPI.w #1,d2 * compare the number write index with 1
+00B02410 6712 6776 BEQ.s LAB_U00F * if at the decimal point go save it
+00B02412 6777
+00B02412 6778 * else write a digit to the number string
+00B02412 7030 6779 MOVEQ #'0',d0 * default to "0"
+00B02414 4A43 6780 TST.w d3 * test the number read index
+00B02416 67EE 6781 BEQ.s LAB_U00D * if zero just go save the "0"
+00B02418 6782
+00B02418 6783 LAB_U00E
+00B02418 1032 3000 6784 MOVE.b (a2,d3.w),d0 * read the next number digit
+00B0241C 5343 6785 SUBQ.w #1,d3 * decrement the read index
+00B0241E B004 6786 CMP.b d4,d0 * compare the digit with "."
+00B02420 66E4 6787 BNE.s LAB_U00D * if not "." go save the digit
+00B02422 6788
+00B02422 60F4 6789 BRA.s LAB_U00E * else go get the next digit
+00B02424 6790
+00B02424 6791 LAB_U00F
+00B02424 1584 2000 6792 MOVE.b d4,(a2,d2.w) * save the decimal point
+00B02428 6793 LAB_U010
+00B02428 4A42 6794 TST.w d2 * test the number string decimal point index
+00B0242A 6602 6795 BNE.s LAB_U014 * if dp present skip the reset
+00B0242C 6796
+00B0242C 3406 6797 MOVE.w d6,d2 * make the decimal point index = the length
+00B0242E 6798
+00B0242E 6799 * copy the fractional digit characters from the number string
+00B0242E 6800
+00B0242E 6801 LAB_U014
+00B0242E 3602 6802 MOVE.w d2,d3 * copy the number string decimal point index
+00B02430 5243 6803 ADDQ.w #1,d3 * increment the number string index
+00B02432 382F 0008 6804 MOVE.w fsdpi(sp),d4 * get the new format string decimal point index
+00B02436 6805 LAB_U018
+00B02436 5244 6806 ADDQ.w #1,d4 * increment the new format string index
+00B02438 B244 6807 CMP.w d4,d1 * compare it with the new format string length
+00B0243A 6322 6808 BLS.s LAB_U022 * if done the fraction digits go do integer
+00B0243C 6809
+00B0243C 1030 4000 6810 MOVE.b (a0,d4.w),d0 * get a new format string character
+00B02440 B03C 0025 6811 CMP.b #'%',d0 * compare it with "%"
+00B02444 6706 6812 BEQ.s LAB_U01C * if "%" go copy a number character
+00B02446 6813
+00B02446 B03C 0023 6814 CMP.b #'#',d0 * compare it with "#"
+00B0244A 66EA 6815 BNE.s LAB_U018 * if not "#" go do the next new format character
+00B0244C 6816
+00B0244C 6817 LAB_U01C
+00B0244C 7030 6818 MOVEQ #'0',d0 * default to "0" character
+00B0244E BC43 6819 CMP.w d3,d6 * compare the number string index with length
+00B02450 6306 6820 BLS.s LAB_U020 * if there skip the character get
+00B02452 6821
+00B02452 1032 3000 6822 MOVE.b (a2,d3.w),d0 * get a character from the number string
+00B02456 5243 6823 ADDQ.w #1,d3 * increment the number string index
+00B02458 6824 LAB_U020
+00B02458 1180 4000 6825 MOVE.b d0,(a0,d4.w) * save the number character to the new format
+00B0245C 6826 * string
+00B0245C 60D8 6827 BRA.s LAB_U018 * go do the next new format character
+00B0245E 6828
+00B0245E 6829 * now copy the integer digit characters from the number string
+00B0245E 6830
+00B0245E 6831 LAB_U022
+00B0245E 7C00 6832 MOVEQ #0,d6 * clear the sign done flag
+00B02460 7A00 6833 MOVEQ #0,d5 * clear the sign present flag
+00B02462 5342 6834 SUBQ.w #1,d2 * decrement the number string index
+00B02464 6608 6835 BNE.s LAB_U026 * if not now at sign continue
+00B02466 6836
+00B02466 7401 6837 MOVEQ #1,d2 * increment the number string index
+00B02468 15BC 0030 2000 6838 MOVE.b #'0',(a2,d2.w) * replace the point with a zero
+00B0246E 6839 LAB_U026
+00B0246E 382F 0008 6840 MOVE.w fsdpi(sp),d4 * get the new format string decimal point index
+00B02472 B244 6841 CMP.w d4,d1 * compare it with the new format string length
+00B02474 6402 6842 BCC.s LAB_U02A * if within the string go use the index
+00B02476 6843
+00B02476 3801 6844 MOVE.w d1,d4 * else set the index to the end of the string
+00B02478 6845 LAB_U02A
+00B02478 5344 6846 SUBQ.w #1,d4 * decrement the new format string index
+00B0247A 6B62 6847 BMI.s LAB_U03E * if all done go test for any overflow
+00B0247C 6848
+00B0247C 1030 4000 6849 MOVE.b (a0,d4.w),d0 * else get a new format string character
+00B02480 6850
+00B02480 7E30 6851 MOVEQ #'0',d7 * default to "0" character
+00B02482 B03C 0025 6852 CMP.b #'%',d0 * compare it with "%"
+00B02486 6708 6853 BEQ.s LAB_U02B * if "%" go copy a number character
+00B02488 6854
+00B02488 7E20 6855 MOVEQ #' ',d7 * default to " " character
+00B0248A B03C 0023 6856 CMP.b #'#',d0 * compare it with "#"
+00B0248E 6606 6857 BNE.s LAB_U02C * if not "#" go try ","
+00B02490 6858
+00B02490 6859 LAB_U02B
+00B02490 4A42 6860 TST.w d2 * test the number string index
+00B02492 6634 6861 BNE.s LAB_U036 * if not at the sign go get a number character
+00B02494 6862
+00B02494 6042 6863 BRA.s LAB_U03C * else go save the default character
+00B02496 6864
+00B02496 6865 LAB_U02C
+00B02496 B03C 002C 6866 CMP.b #',',d0 * compare it with ","
+00B0249A 6610 6867 BNE.s LAB_U030 * if not "," go try the sign characters
+00B0249C 6868
+00B0249C 4A42 6869 TST.w d2 * test the number string index
+00B0249E 6608 6870 BNE.s LAB_U02E * if not at the sign keep the ","
+00B024A0 6871
+00B024A0 0C30 0025 40FF 6872 CMP.b #'%',-1(a0,d4.w) * else compare the next format string character
+00B024A6 6873 * with "%"
+00B024A6 6630 6874 BNE.s LAB_U03C * if not "%" keep the default character
+00B024A8 6875
+00B024A8 6876 LAB_U02E
+00B024A8 1E00 6877 MOVE.b d0,d7 * else use the "," character
+00B024AA 602C 6878 BRA.s LAB_U03C * go save the character to the string
+00B024AC 6879
+00B024AC 6880 LAB_U030
+00B024AC B03C 002D 6881 CMP.b #'-',d0 * compare it with "-"
+00B024B0 6710 6882 BEQ.s LAB_U034 * if "-" go do the sign character
+00B024B2 6883
+00B024B2 B03C 002B 6884 CMP.b #'+',d0 * compare it with "+"
+00B024B6 66C0 6885 BNE.s LAB_U02A * if not "+" go do the next new format character
+00B024B8 6886
+00B024B8 0C12 002D 6887 CMP.b #'-',(a2) * compare the sign character with "-"
+00B024BC 6704 6888 BEQ.s LAB_U034 * if "-" don't change the sign character
+00B024BE 6889
+00B024BE 14BC 002B 6890 MOVE.b #'+',(a2) * else make the sign character "+"
+00B024C2 6891 LAB_U034
+00B024C2 1A00 6892 MOVE.b d0,d5 * set the sign present flag
+00B024C4 4A42 6893 TST.w d2 * test the number string index
+00B024C6 6708 6894 BEQ.s LAB_U038 * if at the sign keep the default character
+00B024C8 6895
+00B024C8 6896 LAB_U036
+00B024C8 1E32 2000 6897 MOVE.b (a2,d2.w),d7 * else get a character from the number string
+00B024CC 5342 6898 SUBQ.w #1,d2 * decrement the number string index
+00B024CE 6008 6899 BRA.s LAB_U03C * go save the character
+00B024D0 6900
+00B024D0 6901 LAB_U038
+00B024D0 4A06 6902 TST.b d6 * test the sign done flag
+00B024D2 6604 6903 BNE.s LAB_U03C * if the sign has been done go use the space
+00B024D4 6904 * character
+00B024D4 6905
+00B024D4 1E12 6906 MOVE.b (a2),d7 * else get the sign character
+00B024D6 1C07 6907 MOVE.b d7,d6 * flag that the sign has been done
+00B024D8 6908 LAB_U03C
+00B024D8 1187 4000 6909 MOVE.b d7,(a0,d4.w) * save the number character to the new format
+00B024DC 6910 * string
+00B024DC 609A 6911 BRA.s LAB_U02A * go do the next new format character
+00B024DE 6912
+00B024DE 6913 * test for overflow conditions
+00B024DE 6914
+00B024DE 6915 LAB_U03E
+00B024DE 4A42 6916 TST.w d2 * test the number string index
+00B024E0 6614 6917 BNE.s LAB_U040 * if all the digits aren't done go output
+00B024E2 6918 * an overflow indication
+00B024E2 6919
+00B024E2 6920 * test for sign overflows
+00B024E2 6921
+00B024E2 4A05 6922 TST.b d5 * test the sign present flag
+00B024E4 6754 6923 BEQ.s LAB_U04A * if no sign present go add the string
+00B024E6 6924
+00B024E6 6925 * there was a sign in the format string
+00B024E6 6926
+00B024E6 4A06 6927 TST.b d6 * test the sign done flag
+00B024E8 6650 6928 BNE.s LAB_U04A * if the sign is done go add the string
+00B024EA 6929
+00B024EA 6930 * the sign isn't done so see if it was mandatory
+00B024EA 6931
+00B024EA 0C05 002B 6932 CMPI.b #'+',d5 * compare the sign with "+"
+00B024EE 6706 6933 BEQ.s LAB_U040 * if it was "+" go output an overflow
+00B024F0 6934 * indication
+00B024F0 6935
+00B024F0 6936 * the sign wasn't mandatory but the number may have been negative
+00B024F0 6937
+00B024F0 0C12 002D 6938 CMP.b #'-',(a2) * compare the sign character with "-"
+00B024F4 6644 6939 BNE.s LAB_U04A * if it wasn't "-" go add the string
+00B024F6 6940
+00B024F6 6941 * else the sign was "-" and a sign hasn't been output so ..
+00B024F6 6942
+00B024F6 6943 * the number overflowed the format string so replace all the special format characters
+00B024F6 6944 * with the overflow character
+00B024F6 6945
+00B024F6 6946 LAB_U040
+00B024F6 7A23 6947 MOVEQ #ofchr,d5 * set the overflow character
+00B024F8 3E01 6948 MOVE.w d1,d7 * copy the new format string length
+00B024FA 5347 6949 SUBQ.w #1,d7 * adjust for the loop type
+00B024FC 3C2F 0004 6950 MOVE.w fsti(sp),d6 * copy the new format string last index
+00B02500 5346 6951 SUBQ.w #1,d6 * -1 gives the last character of this string
+00B02502 6E02 6952 BGT.s LAB_U044 * if not zero continue
+00B02504 6953
+00B02504 3C07 6954 MOVE.w d7,d6 * else set the format string index to the end
+00B02506 6955 LAB_U044
+00B02506 1031 6000 6956 MOVE.b (a1,d6.w),d0 * get a character from the format string
+00B0250A 0C00 0023 6957 CMPI.b #'#',d0 * compare it with "#" special format character
+00B0250E 671E 6958 BEQ.s LAB_U046 * if "#" go use the overflow character
+00B02510 6959
+00B02510 0C00 0025 6960 CMPI.b #'%',d0 * compare it with "%" special format character
+00B02514 6718 6961 BEQ.s LAB_U046 * if "%" go use the overflow character
+00B02516 6962
+00B02516 0C00 002C 6963 CMPI.b #',',d0 * compare it with "," special format character
+00B0251A 6712 6964 BEQ.s LAB_U046 * if "," go use the overflow character
+00B0251C 6965
+00B0251C 0C00 002B 6966 CMPI.b #'+',d0 * compare it with "+" special format character
+00B02520 670C 6967 BEQ.s LAB_U046 * if "+" go use the overflow character
+00B02522 6968
+00B02522 0C00 002D 6969 CMPI.b #'-',d0 * compare it with "-" special format character
+00B02526 6706 6970 BEQ.s LAB_U046 * if "-" go use the overflow character
+00B02528 6971
+00B02528 0C00 002E 6972 CMPI.b #'.',d0 * compare it with "." special format character
+00B0252C 6602 6973 BNE.s LAB_U048 * if not "." skip the using overflow character
+00B0252E 6974
+00B0252E 6975 LAB_U046
+00B0252E 1005 6976 MOVE.b d5,d0 * use the overflow character
+00B02530 6977 LAB_U048
+00B02530 1180 7000 6978 MOVE.b d0,(a0,d7.w) * save the character to the new format string
+00B02534 5346 6979 SUBQ.w #1,d6 * decrement the format string index
+00B02536 51CF FFCE 6980 DBF d7,LAB_U044 * decrement the count and loop if not all done
+00B0253A 6981
+00B0253A 6982 * add the new string to the previous string
+00B0253A 6983
+00B0253A 6984 LAB_U04A
+00B0253A 41EC 0006 6985 LEA 6(a4),a0 * get the descriptor pointer for string 1
+00B0253E 274C 05F4 6986 MOVE.l a4,FAC1_m(a3) * save the descriptor pointer for string 2
+00B02542 6100 F010 6987 BSR LAB_224E * concatenate the strings
+00B02546 6988
+00B02546 6989 * now check for any tail on the format string
+00B02546 6990
+00B02546 302F 0004 6991 MOVE.w fsti(sp),d0 * get this index
+00B0254A 6720 6992 BEQ.s LAB_U04C * if at start of string skip the output
+00B0254C 6993
+00B0254C 3F40 0006 6994 MOVE.w d0,fsli(sp) * save this index to the last index
+00B02550 6100 0084 6995 BSR LAB_ProcFo * now process the format string
+00B02554 4A02 6996 TST.b d2 * test the special characters flag
+00B02556 6614 6997 BNE.s LAB_U04C * if special characters present skip the output
+00B02558 6998
+00B02558 6999 * else output the new string part
+00B02558 7000
+00B02558 613E 7001 BSR.s LAB_DupFmt * duplicate the processed format string section
+00B0255A 3F6F 0004 0006 7002 MOVE.w fsti(sp),fsli(sp) * copy this index to the last index
+00B02560 7003
+00B02560 7004 * add the new string to the previous string
+00B02560 7005
+00B02560 41EC 0006 7006 LEA 6(a4),a0 * get the descriptor pointer for string 1
+00B02564 274C 05F4 7007 MOVE.l a4,FAC1_m(a3) * save the descriptor pointer for string 2
+00B02568 6100 EFEA 7008 BSR LAB_224E * concatenate the strings
+00B0256C 7009
+00B0256C 7010 * check for another value or end of function
+00B0256C 7011
+00B0256C 7012 LAB_U04C
+00B0256C 101D 7013 MOVE.b (a5)+,d0 * get the next BASIC byte
+00B0256E B03C 0029 7014 CMP.b #')',d0 * compare with close bracket
+00B02572 6600 FDCA 7015 BNE LAB_U002 * if not ")" go do next value
+00B02576 7016
+00B02576 7017 * pop the result string off the descriptor stack
+00B02576 7018
+00B02576 204C 7019 MOVEA.l a4,a0 * copy the result string descriptor pointer
+00B02578 222B 04AA 7020 MOVE.l Sstorl(a3),d1 * save the bottom of string space
+00B0257C 6100 F038 7021 BSR LAB_22BA * pop (a0) descriptor, returns with ..
+00B02580 7022 * d0 = length, a0 = pointer
+00B02580 2741 04AA 7023 MOVE.l d1,Sstorl(a3) * restore the bottom of string space
+00B02584 2248 7024 MOVEA.l a0,a1 * copy the string result pointer
+00B02586 3200 7025 MOVE.w d0,d1 * copy the string result length
+00B02588 7026
+00B02588 7027 * pop the format string off the descriptor stack
+00B02588 7028
+00B02588 205F 7029 MOVEA.l (sp)+,a0 * pull the format string descriptor pointer
+00B0258A 6100 F02A 7030 BSR LAB_22BA * pop (a0) descriptor, returns with ..
+00B0258E 7031 * d0 = length, a0 = pointer
+00B0258E 7032
+00B0258E 4FEF 0008 7033 LEA fend(sp),sp * dump the saved values
+00B02592 7034
+00B02592 7035 * push the result string back on the descriptor stack and return
+00B02592 7036
+00B02592 2049 7037 MOVEA.l a1,a0 * copy the result string pointer back
+00B02594 6000 EE6E 7038 BRA LAB_RTST * push a string on the descriptor stack and
+00B02598 7039 * return. a0 = pointer, d1 = length
+00B02598 7040
+00B02598 7041
+00B02598 7042 *************************************************************************************
+00B02598 7043 *
+00B02598 7044 * duplicate the processed format string section
+00B02598 7045
+00B02598 7046 * make a string as long as the format string
+00B02598 7047 LAB_DupFmt
+00B02598 226F 0004 7048 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
+00B0259C 3E29 0004 7049 MOVE.w 4(a1),d7 * get the format string length
+00B025A0 342F 000A 7050 MOVE.w 4+fsli(sp),d2 * get the format string last index
+00B025A4 3C2F 0008 7051 MOVE.w 4+fsti(sp),d6 * get the format string this index
+00B025A8 3206 7052 MOVE.w d6,d1 * copy the format string this index
+00B025AA 9242 7053 SUB.w d2,d1 * subtract the format string last index
+00B025AC 6202 7054 BHI.s LAB_D002 * if > 0 skip the correction
+00B025AE 7055
+00B025AE D247 7056 ADD.w d7,d1 * else add the format string length as the
+00B025B0 7057 * correction
+00B025B0 7058 LAB_D002
+00B025B0 6100 EE6C 7059 BSR LAB_2115 * make string space d1 bytes long
+00B025B4 7060 * return a0/Sutill = pointer, others unchanged
+00B025B4 7061
+00B025B4 7062 * push the new string on the descriptor stack
+00B025B4 7063
+00B025B4 6100 EE4E 7064 BSR LAB_RTST * push a string on the descriptor stack and
+00B025B8 7065 * return. a0 = pointer, d1 = length
+00B025B8 7066
+00B025B8 7067 * copy the characters from the format string
+00B025B8 7068
+00B025B8 226F 0004 7069 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
+00B025BC 2251 7070 MOVEA.l (a1),a1 * get the format string pointer
+00B025BE 7800 7071 MOVEQ #0,d4 * clear the new string index
+00B025C0 7072 LAB_D00A
+00B025C0 11B1 2000 4000 7073 MOVE.b (a1,d2.w),(a0,d4.w) * get a character from the format string and
+00B025C6 7074 * save it to the new string
+00B025C6 5244 7075 ADDQ.w #1,d4 * increment the new string index
+00B025C8 5242 7076 ADDQ.w #1,d2 * increment the format string index
+00B025CA BE42 7077 CMP.w d2,d7 * compare the format index with the length
+00B025CC 6602 7078 BNE.s LAB_D00E * if not there skip the reset
+00B025CE 7079
+00B025CE 7400 7080 MOVEQ #0,d2 * else reset the format string index
+00B025D0 7081 LAB_D00E
+00B025D0 BC42 7082 CMP.w d2,d6 * compare the index with this index
+00B025D2 66EC 7083 BNE.s LAB_D00A * if not equal go do the next character
+00B025D4 7084
+00B025D4 4E75 7085 RTS
+00B025D6 7086
+00B025D6 7087
+00B025D6 7088 **************************************************************************************
+00B025D6 7089 *
+00B025D6 7090 * process the format string
+00B025D6 7091
+00B025D6 7092 LAB_ProcFo
+00B025D6 226F 0004 7093 MOVEA.l 4+fsd(sp),a1 * get the format string descriptor pointer
+00B025DA 3E29 0004 7094 MOVE.w 4(a1),d7 * get the format string length
+00B025DE 2251 7095 MOVEA.l (a1),a1 * get the format string pointer
+00B025E0 3C2F 000A 7096 MOVE.w 4+fsli(sp),d6 * get the format string last index
+00B025E4 7097
+00B025E4 3F47 000C 7098 MOVE.w d7,4+fsdpi(sp) * set the format string decimal point index
+00B025E8 7099 *## MOVE.w #-1,4+fsdpi(sp) * set the format string decimal point index
+00B025E8 7A00 7100 MOVEQ #0,d5 * no decimal point
+00B025EA 7600 7101 MOVEQ #0,d3 * no decimal characters
+00B025EC 7400 7102 MOVEQ #0,d2 * no special characters
+00B025EE 7103 LAB_P004
+00B025EE 1031 6000 7104 MOVE.b (a1,d6.w),d0 * get a format string byte
+00B025F2 7105
+00B025F2 B03C 002C 7106 CMP.b #',',d0 * compare it with ","
+00B025F6 6742 7107 BEQ.s LAB_P01A * if "," go do the next format string byte
+00B025F8 7108
+00B025F8 B03C 0023 7109 CMP.b #'#',d0 * compare it with "#"
+00B025FC 6706 7110 BEQ.s LAB_P008 * if "#" go flag special characters
+00B025FE 7111
+00B025FE B03C 0025 7112 CMP.b #'%',d0 * compare it with "%"
+00B02602 6608 7113 BNE.s LAB_P00C * if not "%" go try "+"
+00B02604 7114
+00B02604 7115 LAB_P008
+00B02604 4A85 7116 TST.l d5 * test the decimal point flag
+00B02606 6A10 7117 BPL.s LAB_P00E * if no point skip counting decimal characters
+00B02608 7118
+00B02608 5243 7119 ADDQ.w #1,d3 * else increment the decimal character count
+00B0260A 602E 7120 BRA.s LAB_P01A * go do the next character
+00B0260C 7121
+00B0260C 7122 LAB_P00C
+00B0260C B03C 002B 7123 CMP.b #'+',d0 * compare it with "+"
+00B02610 6706 7124 BEQ.s LAB_P00E * if "+" go flag special characters
+00B02612 7125
+00B02612 B03C 002D 7126 CMP.b #'-',d0 * compare it with "-"
+00B02616 6604 7127 BNE.s LAB_P010 * if not "-" go check decimal point
+00B02618 7128
+00B02618 7129 LAB_P00E
+00B02618 8400 7130 OR.b d0,d2 * flag special characters
+00B0261A 601E 7131 BRA.s LAB_P01A * go do the next character
+00B0261C 7132
+00B0261C 7133 LAB_P010
+00B0261C B03C 002E 7134 CMP.b #'.',d0 * compare it with "."
+00B02620 6614 7135 BNE.s LAB_P018 * if not "." go check next
+00B02622 7136
+00B02622 7137 * "." a decimal point
+00B02622 7138
+00B02622 4A85 7139 TST.l d5 * if there is already a decimal point
+00B02624 6B14 7140 BMI.s LAB_P01A * go do the next character
+00B02626 7141
+00B02626 3006 7142 MOVE.w d6,d0 * copy the decimal point index
+00B02628 906F 000A 7143 SUB.w 4+fsli(sp),d0 * calculate it from the scan start
+00B0262C 3F40 000C 7144 MOVE.w d0,4+fsdpi(sp) * save the decimal point index
+00B02630 7AFF 7145 MOVEQ #-1,d5 * flag decimal point
+00B02632 8400 7146 OR.b d0,d2 * flag special characters
+00B02634 6004 7147 BRA.s LAB_P01A * go do the next character
+00B02636 7148
+00B02636 7149 * was not a special character
+00B02636 7150
+00B02636 7151 LAB_P018
+00B02636 4A02 7152 TST.b d2 * test if there have been special characters
+00B02638 6608 7153 BNE.s LAB_P01E * if so exit the format string process
+00B0263A 7154
+00B0263A 7155 LAB_P01A
+00B0263A 5246 7156 ADDQ.w #1,d6 * increment the format string index
+00B0263C BE46 7157 CMP.w d6,d7 * compare it with the format string length
+00B0263E 62AE 7158 BHI.s LAB_P004 * if length > index go get the next character
+00B02640 7159
+00B02640 7C00 7160 MOVEQ #0,d6 * length = index so reset the format string
+00B02642 7161 * index
+00B02642 7162 LAB_P01E
+00B02642 3F46 0008 7163 MOVE.w d6,4+fsti(sp) * save the format string this index
+00B02646 3F43 000E 7164 MOVE.w d3,4+fsdc(sp) * save the format string decimal characters
+00B0264A 7165
+00B0264A 4E75 7166 RTS
+00B0264C 7167
+00B0264C 7168
+00B0264C 7169 *************************************************************************************
+00B0264C 7170 *
+00B0264C 7171 * perform BIN$()
+00B0264C 7172 * # of leading 0s is in d1, the number is in d0
+00B0264C 7173
+00B0264C 7174 LAB_BINS
+00B0264C B23C 0021 7175 CMP.b #$21,d1 * max + 1
+00B02650 6400 DB0C 7176 BCC LAB_FCER * exit if too big ( > or = )
+00B02654 7177
+00B02654 741F 7178 MOVEQ #$1F,d2 * bit count-1
+00B02656 41EB 061A 7179 LEA Binss(a3),a0 * point to string
+00B0265A 7830 7180 MOVEQ #$30,d4 * "0" character for ADDX
+00B0265C 7181 NextB1
+00B0265C 7600 7182 MOVEQ #0,d3 * clear byte
+00B0265E E288 7183 LSR.l #1,d0 * shift bit into Xb
+00B02660 D704 7184 ADDX.b d4,d3 * add carry and character to zero
+00B02662 1183 2000 7185 MOVE.b d3,(a0,d2.w) * save character to string
+00B02666 51CA FFF4 7186 DBF d2,NextB1 * decrement and loop if not done
+00B0266A 7187
+00B0266A 7188 * this is the exit code and is also used by HEX$()
+00B0266A 7189
+00B0266A 7190 EndBHS
+00B0266A 177C 0000 063A 7191 MOVE.b #0,BHsend(a3) * null terminate the string
+00B02670 4A01 7192 TST.b d1 * test # of characters
+00B02672 670E 7193 BEQ.s NextB2 * go truncate string
+00B02674 7194
+00B02674 4481 7195 NEG.l d1 * make -ve
+00B02676 0681 0000063A 7196 ADD.l #BHsend,d1 * effectively (end-length)
+00B0267C 41F3 1000 7197 LEA 0(a3,d1.w),a0 * effectively add (end-length) to pointer
+00B02680 600E 7198 BRA.s BinPr * go print string
+00B02682 7199
+00B02682 7200 * truncate string to remove leading "0"s
+00B02682 7201
+00B02682 7202 NextB2
+00B02682 1010 7203 MOVE.b (a0),d0 * get byte
+00B02684 670A 7204 BEQ.s BinPr * if null then end of string so add 1 and go
+00B02686 7205 * print it
+00B02686 7206
+00B02686 B03C 0030 7207 CMP.b #'0',d0 * compare with "0"
+00B0268A 660E 7208 BNE.s GoPr * if not "0" then go print string from here
+00B0268C 7209
+00B0268C 5248 7210 ADDQ.w #1,a0 * else increment pointer
+00B0268E 60F2 7211 BRA.s NextB2 * loop always
+00B02690 7212
+00B02690 7213 * make fixed length output string - ignore overflows!
+00B02690 7214
+00B02690 7215 BinPr
+00B02690 43EB 063A 7216 LEA BHsend(a3),a1 * get string end
+00B02694 B1C9 7217 CMPA.l a1,a0 * are we at the string end
+00B02696 6602 7218 BNE.s GoPr * branch if not
+00B02698 7219
+00B02698 5348 7220 SUBQ.w #1,a0 * else need at least one zero
+00B0269A 7221 GoPr
+00B0269A 6000 ED22 7222 BRA LAB_20AE * print " terminated string to FAC1, stack & RET
+00B0269E 7223
+00B0269E 7224
+00B0269E 7225 *************************************************************************************
+00B0269E 7226 *
+00B0269E 7227 * perform HEX$()
+00B0269E 7228 * # of leading 0s is in d1, the number is in d0
+00B0269E 7229
+00B0269E 7230 LAB_HEXS
+00B0269E B23C 0009 7231 CMP.b #$09,d1 * max + 1
+00B026A2 6400 DABA 7232 BCC LAB_FCER * exit if too big ( > or = )
+00B026A6 7233
+00B026A6 7407 7234 MOVEQ #$07,d2 * nibble count-1
+00B026A8 41EB 0632 7235 LEA Hexss(a3),a0 * point to string
+00B026AC 7830 7236 MOVEQ #$30,d4 * "0" character for ABCD
+00B026AE 7237 NextH1
+00B026AE 1600 7238 MOVE.b d0,d3 * copy lowest byte
+00B026B0 E898 7239 ROR.l #4,d0 * shift nibble into 0-3
+00B026B2 C63C 000F 7240 AND.b #$0F,d3 * just this nibble
+00B026B6 1A03 7241 MOVE.b d3,d5 * copy it
+00B026B8 0605 00F6 7242 ADD.b #$F6,d5 * set extend bit
+00B026BC C704 7243 ABCD d4,d3 * decimal add extend and character to zero
+00B026BE 1183 2000 7244 MOVE.b d3,(a0,d2.w) * save character to string
+00B026C2 51CA FFEA 7245 DBF d2,NextH1 * decrement and loop if not done
+00B026C6 7246
+00B026C6 60A2 7247 BRA.s EndBHS * go process string
+00B026C8 7248
+00B026C8 7249
+00B026C8 7250 *************************************************************************************
+00B026C8 7251 *
+00B026C8 7252 * ctrl-c check routine. includes limited "life" byte save for INGET routine
+00B026C8 7253
+00B026C8 7254 VEC_CC
+00B026C8 4A2B 064C 7255 TST.b ccflag(a3) * check [CTRL-C] check flag
+00B026CC 661E 7256 BNE.s RTS_022 * exit if [CTRL-C] check inhibited
+00B026CE 7257
+00B026CE 4EAB 0470 7258 JSR V_INPT(a3) * scan input device
+00B026D2 640E 7259 BCC.s LAB_FBA0 * exit if buffer empty
+00B026D4 7260
+00B026D4 1740 064D 7261 MOVE.b d0,ccbyte(a3) * save received byte
+00B026D8 177C 0020 064E 7262 MOVE.b #$20,ccnull(a3) * set "life" timer for bytes countdown
+00B026DE 6000 DEF2 7263 BRA LAB_1636 * return to BASIC
+00B026E2 7264
+00B026E2 7265 LAB_FBA0
+00B026E2 4A2B 064E 7266 TST.b ccnull(a3) * get countdown byte
+00B026E6 6704 7267 BEQ.s RTS_022 * exit if finished
+00B026E8 7268
+00B026E8 532B 064E 7269 SUBQ.b #1,ccnull(a3) * else decrement countdown
+00B026EC 7270 RTS_022
+00B026EC 4E75 7271 RTS
+00B026EE 7272
+00B026EE 7273
+00B026EE 7274 *************************************************************************************
+00B026EE 7275 *
+00B026EE 7276 * get byte from input device, no waiting
+00B026EE 7277 * returns with carry set if byte in A
+00B026EE 7278
+00B026EE 7279 INGET
+00B026EE 4EAB 0470 7280 JSR V_INPT(a3) * call scan input device
+00B026F2 650A 7281 BCS.s LAB_FB95 * if byte go reset timer
+00B026F4 7282
+00B026F4 102B 064E 7283 MOVE.b ccnull(a3),d0 * get countdown
+00B026F8 67F2 7284 BEQ.s RTS_022 * exit if empty
+00B026FA 7285
+00B026FA 102B 064D 7286 MOVE.b ccbyte(a3),d0 * get last received byte
+00B026FE 7287 LAB_FB95
+00B026FE 177C 0000 064E 7288 MOVE.b #$00,ccnull(a3) * clear timer because we got a byte
+00B02704 003C 0001 7289 ORI.b #1,CCR * set carry, flag we got a byte
+00B02708 4E75 7290 RTS
+00B0270A 7291
+00B0270A 7292
+00B0270A 7293 *************************************************************************************
+00B0270A 7294 *
+00B0270A 7295 * perform MAX()
+00B0270A 7296
+00B0270A 7297 LAB_MAX
+00B0270A 6100 E53E 7298 BSR LAB_EVEZ * evaluate expression (no decrement)
+00B0270E 4A2B 0619 7299 TST.b Dtypef(a3) * test data type
+00B02712 6B00 DA2A 7300 BMI LAB_TMER * if string do Type missmatch Error/warm start
+00B02716 7301
+00B02716 7302 LAB_MAXN
+00B02716 612E 7303 BSR.s LAB_PHFA * push FAC1, evaluate expression,
+00B02718 7304 * pull FAC2 & compare with FAC1
+00B02718 64FC 7305 BCC.s LAB_MAXN * branch if no swap to do
+00B0271A 7306
+00B0271A 6100 F4AA 7307 BSR LAB_279B * copy FAC2 to FAC1
+00B0271E 60F6 7308 BRA.s LAB_MAXN * go do next
+00B02720 7309
+00B02720 7310
+00B02720 7311 *************************************************************************************
+00B02720 7312 *
+00B02720 7313 * perform MIN()
+00B02720 7314
+00B02720 7315 LAB_MIN
+00B02720 6100 E528 7316 BSR LAB_EVEZ * evaluate expression (no decrement)
+00B02724 4A2B 0619 7317 TST.b Dtypef(a3) * test data type
+00B02728 6B00 DA14 7318 BMI LAB_TMER * if string do Type missmatch Error/warm start
+00B0272C 7319
+00B0272C 7320 LAB_MINN
+00B0272C 6118 7321 BSR.s LAB_PHFA * push FAC1, evaluate expression,
+00B0272E 7322 * pull FAC2 & compare with FAC1
+00B0272E 63FC 7323 BLS.s LAB_MINN * branch if no swap to do
+00B02730 7324
+00B02730 6100 F494 7325 BSR LAB_279B * copy FAC2 to FAC1
+00B02734 60F6 7326 BRA.s LAB_MINN * go do next (branch always)
+00B02736 7327
+00B02736 7328 * exit routine. don't bother returning to the loop code
+00B02736 7329 * check for correct exit, else so syntax error
+00B02736 7330
+00B02736 7331 LAB_MMEC
+00B02736 B03C 0029 7332 CMP.b #')',d0 * is it end of function?
+00B0273A 6600 DA2E 7333 BNE LAB_SNER * if not do MAX MIN syntax error
+00B0273E 7334
+00B0273E 4FEF 0004 7335 LEA 4(sp),sp * dump return address (faster)
+00B02742 6000 E664 7336 BRA LAB_IGBY * update BASIC execute pointer (to chr past ")")
+00B02746 7337 * and return
+00B02746 7338
+00B02746 7339 * check for next, evaluate & return or exit
+00B02746 7340 * this is the routine that does most of the work
+00B02746 7341
+00B02746 7342 LAB_PHFA
+00B02746 6100 E662 7343 BSR LAB_GBYT * get next BASIC byte
+00B0274A B03C 002C 7344 CMP.b #',',d0 * is there more ?
+00B0274E 66E6 7345 BNE.s LAB_MMEC * if not go do end check
+00B02750 7346
+00B02750 3F2B 05F8 7347 MOVE.w FAC1_e(a3),-(sp) * push exponent and sign
+00B02754 2F2B 05F4 7348 MOVE.l FAC1_m(a3),-(sp) * push mantissa
+00B02758 7349
+00B02758 6100 E4F0 7350 BSR LAB_EVEZ * evaluate expression (no decrement)
+00B0275C 4A2B 0619 7351 TST.b Dtypef(a3) * test data type
+00B02760 6B00 D9DC 7352 BMI LAB_TMER * if string do Type missmatch Error/warm start
+00B02764 7353
+00B02764 7354
+00B02764 7355 * pop FAC2 (MAX/MIN expression so far)
+00B02764 275F 05FC 7356 MOVE.l (sp)+,FAC2_m(a3) * pop mantissa
+00B02768 7357
+00B02768 301F 7358 MOVE.w (sp)+,d0 * pop exponent and sign
+00B0276A 3740 0600 7359 MOVE.w d0,FAC2_e(a3) * save exponent and sign
+00B0276E 176B 05F9 0602 7360 MOVE.b FAC1_s(a3),FAC_sc(a3) * get FAC1 sign
+00B02774 B12B 0602 7361 EOR.b d0,FAC_sc(a3) * EOR to create sign compare
+00B02778 6000 F4B8 7362 BRA LAB_27FA * compare FAC1 with FAC2 & return
+00B0277C 7363 * returns d0=+1 Cb=0 if FAC1 > FAC2
+00B0277C 7364 * returns d0= 0 Cb=0 if FAC1 = FAC2
+00B0277C 7365 * returns d0=-1 Cb=1 if FAC1 < FAC2
+00B0277C 7366
+00B0277C 7367
+00B0277C 7368 *************************************************************************************
+00B0277C 7369 *
+00B0277C 7370 * perform WIDTH
+00B0277C 7371
+00B0277C 7372 LAB_WDTH
+00B0277C B03C 002C 7373 CMP.b #',',d0 * is next byte ","
+00B02780 672C 7374 BEQ.s LAB_TBSZ * if so do tab size
+00B02782 7375
+00B02782 6100 EF8E 7376 BSR LAB_GTBY * get byte parameter, result in d0 and Itemp
+00B02786 4A00 7377 TST.b d0 * test result
+00B02788 6712 7378 BEQ.s LAB_NSTT * branch if set for infinite line
+00B0278A 7379
+00B0278A B03C 0010 7380 CMP.b #$10,d0 * else make min width = 16d
+00B0278E 6500 D9CE 7381 BCS LAB_FCER * if less do function call error & exit
+00B02792 7382
+00B02792 7383 * this next compare ensures that we can't exit WIDTH via an error leaving the
+00B02792 7384 * tab size greater than the line length.
+00B02792 7385
+00B02792 B02B 0646 7386 CMP.b TabSiz(a3),d0 * compare with tab size
+00B02796 6404 7387 BCC.s LAB_NSTT * branch if >= tab size
+00B02798 7388
+00B02798 1740 0646 7389 MOVE.b d0,TabSiz(a3) * else make tab size = terminal width
+00B0279C 7390 LAB_NSTT
+00B0279C 1740 064A 7391 MOVE.b d0,TWidth(a3) * set the terminal width
+00B027A0 6100 E608 7392 BSR LAB_GBYT * get BASIC byte back
+00B027A4 672C 7393 BEQ.s WExit * exit if no following
+00B027A6 7394
+00B027A6 B03C 002C 7395 CMP.b #',',d0 * else is it ","
+00B027AA 6600 D9BE 7396 BNE LAB_SNER * if not do syntax error
+00B027AE 7397
+00B027AE 7398 LAB_TBSZ
+00B027AE 6100 EF5E 7399 BSR LAB_SGBY * increment and get byte, result in d0 and Itemp
+00B027B2 4A00 7400 TST.b d0 * test TAB size
+00B027B4 6B00 D9A8 7401 BMI LAB_FCER * if >127 do function call error & exit
+00B027B8 7402
+00B027B8 B03C 0001 7403 CMP.b #1,d0 * compare with min-1
+00B027BC 6500 D9A0 7404 BCS LAB_FCER * if <=1 do function call error & exit
+00B027C0 7405
+00B027C0 122B 064A 7406 MOVE.b TWidth(a3),d1 * set flags for width
+00B027C4 6708 7407 BEQ.s LAB_SVTB * skip check if infinite line
+00B027C6 7408
+00B027C6 B02B 064A 7409 CMP.b TWidth(a3),d0 * compare TAB with width
+00B027CA 6E00 D992 7410 BGT LAB_FCER * branch if too big
+00B027CE 7411
+00B027CE 7412 LAB_SVTB
+00B027CE 1740 0646 7413 MOVE.b d0,TabSiz(a3) * save TAB size
+00B027D2 7414
+00B027D2 7415 * calculate tab column limit from TAB size. The Iclim is set to the last tab
+00B027D2 7416 * position on a line that still has at least one whole tab width between it
+00B027D2 7417 * and the end of the line.
+00B027D2 7418
+00B027D2 7419 WExit
+00B027D2 102B 064A 7420 MOVE.b TWidth(a3),d0 * get width
+00B027D6 670A 7421 BEQ.s LAB_WDLP * branch if infinite line
+00B027D8 7422
+00B027D8 B02B 0646 7423 CMP.b TabSiz(a3),d0 * compare with tab size
+00B027DC 6404 7424 BCC.s LAB_WDLP * branch if >= tab size
+00B027DE 7425
+00B027DE 1740 0646 7426 MOVE.b d0,TabSiz(a3) * else make tab size = terminal width
+00B027E2 7427 LAB_WDLP
+00B027E2 902B 0646 7428 SUB.b TabSiz(a3),d0 * subtract tab size
+00B027E6 64FA 7429 BCC.s LAB_WDLP * loop while no borrow
+00B027E8 7430
+00B027E8 D02B 0646 7431 ADD.b TabSiz(a3),d0 * add tab size back
+00B027EC D02B 0646 7432 ADD.b TabSiz(a3),d0 * add tab size back again
+00B027F0 7433
+00B027F0 4400 7434 NEG.b d0 * make -ve
+00B027F2 D02B 064A 7435 ADD.b TWidth(a3),d0 * subtract remainder from width
+00B027F6 1740 064B 7436 MOVE.b d0,Iclim(a3) * save tab column limit
+00B027FA 7437 RTS_023
+00B027FA 4E75 7438 RTS
+00B027FC 7439
+00B027FC 7440
+00B027FC 7441 *************************************************************************************
+00B027FC 7442 *
+00B027FC 7443 * perform SQR()
+00B027FC 7444
+00B027FC 7445 * d0 is number to find the root of
+00B027FC 7446 * d1 is the root result
+00B027FC 7447 * d2 is the remainder
+00B027FC 7448 * d3 is a counter
+00B027FC 7449 * d4 is temp
+00B027FC 7450
+00B027FC 7451 LAB_SQR
+00B027FC 4A2B 05F9 7452 TST.b FAC1_s(a3) * test FAC1 sign
+00B02800 6B00 D95C 7453 BMI LAB_FCER * if -ve do function call error
+00B02804 7454
+00B02804 4A2B 05F8 7455 TST.b FAC1_e(a3) * test exponent
+00B02808 67F0 7456 BEQ.s RTS_023 * exit if zero
+00B0280A 7457
+00B0280A 48E7 7800 7458 MOVEM.l d1-d4,-(sp) * save registers
+00B0280E 202B 05F4 7459 MOVE.l FAC1_m(a3),d0 * copy FAC1
+00B02812 7400 7460 MOVEQ #0,d2 * clear remainder
+00B02814 2202 7461 MOVE.l d2,d1 * clear root
+00B02816 7462
+00B02816 761F 7463 MOVEQ #$1F,d3 * $1F for DBF, 64 pairs of bits to
+00B02818 7464 * do for a 32 bit result
+00B02818 082B 0000 05F8 7465 BTST #0,FAC1_e(a3) * test exponent odd/even
+00B0281E 6606 7466 BNE.s LAB_SQE2 * if odd only 1 shift first time
+00B02820 7467
+00B02820 7468 LAB_SQE1
+00B02820 D080 7469 ADD.l d0,d0 * shift highest bit of number ..
+00B02822 D582 7470 ADDX.l d2,d2 * .. into remainder .. never overflows
+00B02824 D281 7471 ADD.l d1,d1 * root = root * 2 .. never overflows
+00B02826 7472 LAB_SQE2
+00B02826 D080 7473 ADD.l d0,d0 * shift highest bit of number ..
+00B02828 D582 7474 ADDX.l d2,d2 * .. into remainder .. never overflows
+00B0282A 7475
+00B0282A 2801 7476 MOVE.l d1,d4 * copy root
+00B0282C D884 7477 ADD.l d4,d4 * 2n
+00B0282E 5284 7478 ADDQ.l #1,d4 * 2n+1
+00B02830 7479
+00B02830 B484 7480 CMP.l d4,d2 * compare 2n+1 to remainder
+00B02832 6504 7481 BCS.s LAB_SQNS * skip sub if remainder smaller
+00B02834 7482
+00B02834 9484 7483 SUB.l d4,d2 * subtract temp from remainder
+00B02836 5281 7484 ADDQ.l #1,d1 * increment root
+00B02838 7485 LAB_SQNS
+00B02838 51CB FFE6 7486 DBF d3,LAB_SQE1 * loop if not all done
+00B0283C 7487
+00B0283C 2741 05F4 7488 MOVE.l d1,FAC1_m(a3) * save result mantissa
+00B02840 102B 05F8 7489 MOVE.b FAC1_e(a3),d0 * get exponent (d0 is clear here)
+00B02844 0440 0080 7490 SUB.w #$80,d0 * normalise
+00B02848 E248 7491 LSR.w #1,d0 * /2
+00B0284A 6402 7492 BCC.s LAB_SQNA * skip increment if carry clear
+00B0284C 7493
+00B0284C 5240 7494 ADDQ.w #1,d0 * add bit zero back in (allow for half shift)
+00B0284E 7495 LAB_SQNA
+00B0284E 0640 0080 7496 ADD.w #$80,d0 * re-bias to $80
+00B02852 1740 05F8 7497 MOVE.b d0,FAC1_e(a3) * save it
+00B02856 4CDF 001E 7498 MOVEM.l (sp)+,d1-d4 * restore registers
+00B0285A 6000 F0A8 7499 BRA LAB_24D5 * normalise FAC1 & return
+00B0285E 7500
+00B0285E 7501
+00B0285E 7502 *************************************************************************************
+00B0285E 7503 *
+00B0285E 7504 * perform VARPTR()
+00B0285E 7505
+00B0285E 7506 LAB_VARPTR
+00B0285E 101D 7507 MOVE.b (a5)+,d0 * increment pointer
+00B02860 7508 LAB_VARCALL
+00B02860 6100 E756 7509 BSR LAB_GVAR * get variable address in a0
+00B02864 6100 E530 7510 BSR LAB_1BFB * scan for ")", else do syntax error/warm start
+00B02868 2008 7511 MOVE.l a0,d0 * copy the variable address
+00B0286A 6000 EA3C 7512 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B0286E 7513
+00B0286E 7514
+00B0286E 7515 *************************************************************************************
+00B0286E 7516 *
+00B0286E 7517 * perform RAMBASE
+00B0286E 7518
+00B0286E 7519 LAB_RAM
+00B0286E 41EB 0464 7520 LEA ram_base(a3),a0 * get start of EhBASIC RAM
+00B02872 2008 7521 MOVE.l a0,d0 * copy it
+00B02874 6000 EA32 7522 BRA LAB_AYFC * convert d0 to signed longword in FAC1 & return
+00B02878 7523
+00B02878 7524
+00B02878 7525 *************************************************************************************
+00B02878 7526 *
+00B02878 7527 * perform PI
+00B02878 7528
+00B02878 7529 LAB_PI
+00B02878 277C C90FDAA2 05F4 7530 MOVE.l #$C90FDAA2,FAC1_m(a3) * pi mantissa (32 bit)
+00B02880 377C 8200 05F8 7531 MOVE.w #$8200,FAC1_e(a3) * pi exponent and sign
+00B02886 4E75 7532 RTS
+00B02888 7533
+00B02888 7534
+00B02888 7535 *************************************************************************************
+00B02888 7536 *
+00B02888 7537 * perform TWOPI
+00B02888 7538
+00B02888 7539 LAB_TWOPI
+00B02888 277C C90FDAA2 05F4 7540 MOVE.l #$C90FDAA2,FAC1_m(a3) * 2pi mantissa (32 bit)
+00B02890 377C 8300 05F8 7541 MOVE.w #$8300,FAC1_e(a3) * 2pi exponent and sign
+00B02896 4E75 7542 RTS
+00B02898 7543
+00B02898 7544
+00B02898 7545 *************************************************************************************
+00B02898 7546 *
+00B02898 7547 * get ASCII string equivalent into FAC1 as integer32 or float
+00B02898 7548
+00B02898 7549 * entry is with a5 pointing to the first character of the string
+00B02898 7550 * exit with a5 pointing to the first character after the string
+00B02898 7551
+00B02898 7552 * d0 is character
+00B02898 7553 * d1 is mantissa
+00B02898 7554 * d2 is partial and table mantissa
+00B02898 7555 * d3 is mantissa exponent (decimal & binary)
+00B02898 7556 * d4 is decimal exponent
+00B02898 7557
+00B02898 7558 * get FAC1 from string
+00B02898 7559 * this routine now handles hex and binary values from strings
+00B02898 7560 * starting with "$" and "%" respectively
+00B02898 7561
+00B02898 7562 LAB_2887
+00B02898 48E7 7C00 7563 MOVEM.l d1-d5,-(sp) * save registers
+00B0289C 7200 7564 MOVEQ #$00,d1 * clear temp accumulator
+00B0289E 2601 7565 MOVE.l d1,d3 * set mantissa decimal exponent count
+00B028A0 2801 7566 MOVE.l d1,d4 * clear decimal exponent
+00B028A2 1741 05F9 7567 MOVE.b d1,FAC1_s(a3) * clear sign byte
+00B028A6 1741 0619 7568 MOVE.b d1,Dtypef(a3) * set float data type
+00B028AA 1741 0613 7569 MOVE.b d1,expneg(a3) * clear exponent sign
+00B028AE 6100 E4FA 7570 BSR LAB_GBYT * get first byte back
+00B028B2 653C 7571 BCS.s LAB_28FE * go get floating if 1st character numeric
+00B028B4 7572
+00B028B4 B03C 002D 7573 CMP.b #'-',d0 * or is it -ve number
+00B028B8 6608 7574 BNE.s LAB_289A * branch if not
+00B028BA 7575
+00B028BA 177C 00FF 05F9 7576 MOVE.b #$FF,FAC1_s(a3) * set sign byte
+00B028C0 6006 7577 BRA.s LAB_289C * now go scan & check for hex/bin/int
+00B028C2 7578
+00B028C2 7579 LAB_289A
+00B028C2 7580 * first character wasn't numeric or -
+00B028C2 B03C 002B 7581 CMP.b #'+',d0 * compare with '+'
+00B028C6 6606 7582 BNE.s LAB_289D * branch if not '+' (go check for '.'/hex/binary
+00B028C8 7583 * /integer)
+00B028C8 7584
+00B028C8 7585 LAB_289C
+00B028C8 7586 * was "+" or "-" to start, so get next character
+00B028C8 6100 E4DE 7587 BSR LAB_IGBY * increment & scan memory
+00B028CC 6522 7588 BCS.s LAB_28FE * branch if numeric character
+00B028CE 7589
+00B028CE 7590 LAB_289D
+00B028CE B03C 002E 7591 CMP.b #'.',d0 * else compare with '.'
+00B028D2 6700 0092 7592 BEQ LAB_2904 * branch if '.'
+00B028D6 7593
+00B028D6 7594 * code here for hex/binary/integer numbers
+00B028D6 B03C 0024 7595 CMP.b #'$',d0 * compare with '$'
+00B028DA 6700 010A 7596 BEQ LAB_CHEX * branch if '$'
+00B028DE 7597
+00B028DE B03C 0025 7598 CMP.b #'%',d0 * else compare with '%'
+00B028E2 6700 0164 7599 BEQ LAB_CBIN * branch if '%'
+00B028E6 7600
+00B028E6 6000 008C 7601 BRA LAB_2Y01 * not #.$%& so return 0
+00B028EA 7602
+00B028EA 7603 LAB_28FD
+00B028EA 6100 E4BC 7604 BSR LAB_IGBY * get next character
+00B028EE 646C 7605 BCC.s LAB_2902 * exit loop if not a digit
+00B028F0 7606
+00B028F0 7607 LAB_28FE
+00B028F0 6100 01A8 7608 BSR d1x10 * multiply d1 by 10 and add character
+00B028F4 64F4 7609 BCC.s LAB_28FD * loop for more if no overflow
+00B028F6 7610
+00B028F6 7611 LAB_28FF
+00B028F6 7612 * overflowed mantissa, count 10s exponent
+00B028F6 5283 7613 ADDQ.l #1,d3 * increment mantissa decimal exponent count
+00B028F8 6100 E4AE 7614 BSR LAB_IGBY * get next character
+00B028FC 65F8 7615 BCS.s LAB_28FF * loop while numeric character
+00B028FE 7616
+00B028FE 7617 * done overflow, now flush fraction or do E
+00B028FE B03C 002E 7618 CMP.b #'.',d0 * else compare with '.'
+00B02902 6606 7619 BNE.s LAB_2901 * branch if not '.'
+00B02904 7620
+00B02904 7621 LAB_2900
+00B02904 7622 * flush remaining fraction digits
+00B02904 6100 E4A2 7623 BSR LAB_IGBY * get next character
+00B02908 65FA 7624 BCS LAB_2900 * loop while numeric character
+00B0290A 7625
+00B0290A 7626 LAB_2901
+00B0290A 7627 * done number, only (possible) exponent remains
+00B0290A B03C 0045 7628 CMP.b #'E',d0 * else compare with 'E'
+00B0290E 6664 7629 BNE.s LAB_2Y01 * if not 'E' all done, go evaluate
+00B02910 7630
+00B02910 7631 * process exponent
+00B02910 6100 E496 7632 BSR LAB_IGBY * get next character
+00B02914 6528 7633 BCS.s LAB_2X04 * branch if digit
+00B02916 7634
+00B02916 B03C 002D 7635 CMP.b #'-',d0 * or is it -ve number
+00B0291A 6706 7636 BEQ.s LAB_2X01 * branch if so
+00B0291C 7637
+00B0291C B03C 00B3 7638 CMP.b #TK_MINUS,d0 * or is it -ve number
+00B02920 6608 7639 BNE.s LAB_2X02 * branch if not
+00B02922 7640
+00B02922 7641 LAB_2X01
+00B02922 177C 00FF 0613 7642 MOVE.b #$FF,expneg(a3) * set exponent sign
+00B02928 600E 7643 BRA.s LAB_2X03 * now go scan & check exponent
+00B0292A 7644
+00B0292A 7645 LAB_2X02
+00B0292A B03C 002B 7646 CMP.b #'+',d0 * or is it +ve number
+00B0292E 6708 7647 BEQ.s LAB_2X03 * branch if so
+00B02930 7648
+00B02930 B03C 00B2 7649 CMP.b #TK_PLUS,d0 * or is it +ve number
+00B02934 6600 D834 7650 BNE LAB_SNER * wasn't - + TK_MINUS TK_PLUS or # so do error
+00B02938 7651
+00B02938 7652 LAB_2X03
+00B02938 6100 E46E 7653 BSR LAB_IGBY * get next character
+00B0293C 6436 7654 BCC.s LAB_2Y01 * if not digit all done, go evaluate
+00B0293E 7655 LAB_2X04
+00B0293E C8FC 000A 7656 MULU #10,d4 * multiply decimal exponent by 10
+00B02942 C0BC 000000FF 7657 AND.l #$FF,d0 * mask character
+00B02948 0400 0030 7658 SUB.b #'0',d0 * convert to value
+00B0294C D880 7659 ADD.l d0,d4 * add to decimal exponent
+00B0294E B83C 0030 7660 CMP.b #48,d4 * compare with decimal exponent limit+10
+00B02952 6FE4 7661 BLE.s LAB_2X03 * loop if no overflow/underflow
+00B02954 7662
+00B02954 7663 LAB_2X05
+00B02954 7664 * exponent value has overflowed
+00B02954 6100 E452 7665 BSR LAB_IGBY * get next character
+00B02958 65FA 7666 BCS.s LAB_2X05 * loop while numeric digit
+00B0295A 7667
+00B0295A 6018 7668 BRA.s LAB_2Y01 * all done, go evaluate
+00B0295C 7669
+00B0295C 7670 LAB_2902
+00B0295C B03C 002E 7671 CMP.b #'.',d0 * else compare with '.'
+00B02960 6704 7672 BEQ.s LAB_2904 * branch if was '.'
+00B02962 7673
+00B02962 60A6 7674 BRA.s LAB_2901 * branch if not '.' (go check/do 'E')
+00B02964 7675
+00B02964 7676 LAB_2903
+00B02964 5383 7677 SUBQ.l #1,d3 * decrement mantissa decimal exponent
+00B02966 7678 LAB_2904
+00B02966 7679 * was dp so get fraction part
+00B02966 6100 E440 7680 BSR LAB_IGBY * get next character
+00B0296A 649E 7681 BCC.s LAB_2901 * exit loop if not a digit (go check/do 'E')
+00B0296C 7682
+00B0296C 6100 012C 7683 BSR d1x10 * multiply d1 by 10 and add character
+00B02970 64F2 7684 BCC.s LAB_2903 * loop for more if no overflow
+00B02972 7685
+00B02972 6090 7686 BRA.s LAB_2900 * else go flush remaining fraction part
+00B02974 7687
+00B02974 7688 LAB_2Y01
+00B02974 7689 * now evaluate result
+00B02974 4A2B 0613 7690 TST.b expneg(a3) * test exponent sign
+00B02978 6A02 7691 BPL.s LAB_2Y02 * branch if sign positive
+00B0297A 7692
+00B0297A 4484 7693 NEG.l d4 * negate decimal exponent
+00B0297C 7694 LAB_2Y02
+00B0297C D883 7695 ADD.l d3,d4 * add mantissa decimal exponent
+00B0297E 7620 7696 MOVEQ #32,d3 * set up max binary exponent
+00B02980 4A81 7697 TST.l d1 * test mantissa
+00B02982 6752 7698 BEQ.s LAB_rtn0 * if mantissa=0 return 0
+00B02984 7699
+00B02984 6B08 7700 BMI.s LAB_2Y04 * branch if already mormalised
+00B02986 7701
+00B02986 5383 7702 SUBQ.l #1,d3 * decrement bianry exponent for DBMI loop
+00B02988 7703 LAB_2Y03
+00B02988 D281 7704 ADD.l d1,d1 * shift mantissa
+00B0298A 5BCB FFFC 7705 DBMI d3,LAB_2Y03 * decrement & loop if not normalised
+00B0298E 7706
+00B0298E 7707 * ensure not too big or small
+00B0298E 7708 LAB_2Y04
+00B0298E B8BC 00000026 7709 CMP.l #38,d4 * compare decimal exponent with max exponent
+00B02994 6E00 D7C4 7710 BGT LAB_OFER * if greater do overflow error and warm start
+00B02998 7711
+00B02998 B8BC FFFFFFDA 7712 CMP.l #-38,d4 * compare decimal exponent with min exponent
+00B0299E 6D34 7713 BLT.s LAB_ret0 * if less just return zero
+00B029A0 7714
+00B029A0 4484 7715 NEG.l d4 * negate decimal exponent to go right way
+00B029A2 C9FC 0006 7716 MULS #6,d4 * 6 bytes per entry
+00B029A6 2F08 7717 MOVE.l a0,-(sp) * save register
+00B029A8 41FA 0210 7718 LEA LAB_P_10(pc),a0 * point to table
+00B029AC 1770 4000 0600 7719 MOVE.b (a0,d4.w),FAC2_e(a3) * copy exponent for multiply
+00B029B2 2770 4002 05FC 7720 MOVE.l 2(a0,d4.w),FAC2_m(a3) * copy table mantissa
+00B029B8 205F 7721 MOVE.l (sp)+,a0 * restore register
+00B029BA 7722
+00B029BA 0A03 0080 7723 EORI.b #$80,d3 * normalise input exponent
+00B029BE 2741 05F4 7724 MOVE.l d1,FAC1_m(a3) * save input mantissa
+00B029C2 1743 05F8 7725 MOVE.b d3,FAC1_e(a3) * save input exponent
+00B029C6 176B 05F9 0602 7726 MOVE.b FAC1_s(a3),FAC_sc(a3) * set sign as sign compare
+00B029CC 7727
+00B029CC 4CDF 003E 7728 MOVEM.l (sp)+,d1-d5 * restore registers
+00B029D0 6000 F05A 7729 BRA LAB_MULTIPLY * go multiply input by table
+00B029D4 7730
+00B029D4 7731 LAB_ret0
+00B029D4 7200 7732 MOVEQ #0,d1 * clear mantissa
+00B029D6 7733 LAB_rtn0
+00B029D6 2601 7734 MOVE.l d1,d3 * clear exponent
+00B029D8 1743 05F8 7735 MOVE.b d3,FAC1_e(a3) * save exponent
+00B029DC 2741 05F4 7736 MOVE.l d1,FAC1_m(a3) * save mantissa
+00B029E0 4CDF 003E 7737 MOVEM.l (sp)+,d1-d5 * restore registers
+00B029E4 4E75 7738 RTS
+00B029E6 7739
+00B029E6 7740
+00B029E6 7741 *************************************************************************************
+00B029E6 7742 *
+00B029E6 7743 * $ for hex add-on
+00B029E6 7744
+00B029E6 7745 * gets here if the first character was "$" for hex
+00B029E6 7746 * get hex number
+00B029E6 7747
+00B029E6 7748 LAB_CHEX
+00B029E6 177C 0040 0619 7749 MOVE.b #$40,Dtypef(a3) * set integer numeric data type
+00B029EC 7620 7750 MOVEQ #32,d3 * set up max binary exponent
+00B029EE 7751 LAB_CHXX
+00B029EE 6100 E3B8 7752 BSR LAB_IGBY * increment & scan memory
+00B029F2 6514 7753 BCS.s LAB_ISHN * branch if numeric character
+00B029F4 7754
+00B029F4 803C 0020 7755 OR.b #$20,d0 * case convert, allow "A" to "F" and "a" to "f"
+00B029F8 0400 0061 7756 SUB.b #'a',d0 * subtract "a"
+00B029FC 652A 7757 BCS.s LAB_CHX3 * exit if <"a"
+00B029FE 7758
+00B029FE B03C 0006 7759 CMP.b #$06,d0 * compare normalised with $06 (max+1)
+00B02A02 6424 7760 BCC.s LAB_CHX3 * exit if >"f"
+00B02A04 7761
+00B02A04 0600 003A 7762 ADD.b #$3A,d0 * convert to nibble+"0"
+00B02A08 7763 LAB_ISHN
+00B02A08 616C 7764 BSR.s d1x16 * multiply d1 by 16 and add the character
+00B02A0A 64E2 7765 BCC.s LAB_CHXX * loop for more if no overflow
+00B02A0C 7766
+00B02A0C 7767 * overflowed mantissa, count 16s exponent
+00B02A0C 7768 LAB_CHX1
+00B02A0C 5883 7769 ADDQ.l #4,d3 * increment mantissa exponent count
+00B02A0E 6900 D74A 7770 BVS LAB_OFER * do overflow error if overflowed
+00B02A12 7771
+00B02A12 6100 E394 7772 BSR LAB_IGBY * get next character
+00B02A16 65F4 7773 BCS.s LAB_CHX1 * loop while numeric character
+00B02A18 7774
+00B02A18 803C 0020 7775 OR.b #$20,d0 * case convert, allow "A" to "F" and "a" to "f"
+00B02A1C 0400 0061 7776 SUB.b #'a',d0 * subtract "a"
+00B02A20 6506 7777 BCS.s LAB_CHX3 * exit if <"a"
+00B02A22 7778
+00B02A22 B03C 0006 7779 CMP.b #$06,d0 * compare normalised with $06 (max+1)
+00B02A26 65E4 7780 BCS.s LAB_CHX1 * loop if <="f"
+00B02A28 7781
+00B02A28 7782 * now return value
+00B02A28 7783 LAB_CHX3
+00B02A28 4A81 7784 TST.l d1 * test mantissa
+00B02A2A 67AA 7785 BEQ.s LAB_rtn0 * if mantissa=0 return 0
+00B02A2C 7786
+00B02A2C 6B08 7787 BMI.s LAB_exxf * branch if already mormalised
+00B02A2E 7788
+00B02A2E 5383 7789 SUBQ.l #1,d3 * decrement bianry exponent for DBMI loop
+00B02A30 7790 LAB_CHX2
+00B02A30 D281 7791 ADD.l d1,d1 * shift mantissa
+00B02A32 5BCB FFFC 7792 DBMI d3,LAB_CHX2 * decrement & loop if not normalised
+00B02A36 7793
+00B02A36 7794 LAB_exxf
+00B02A36 0A03 0080 7795 EORI.b #$80,d3 * normalise exponent
+00B02A3A 1743 05F8 7796 MOVE.b d3,FAC1_e(a3) * save exponent
+00B02A3E 2741 05F4 7797 MOVE.l d1,FAC1_m(a3) * save mantissa
+00B02A42 4CDF 003E 7798 MOVEM.l (sp)+,d1-d5 * restore registers
+00B02A46 7799 RTS_024
+00B02A46 4E75 7800 RTS
+00B02A48 7801
+00B02A48 7802
+00B02A48 7803 *************************************************************************************
+00B02A48 7804 *
+00B02A48 7805 * % for binary add-on
+00B02A48 7806
+00B02A48 7807 * gets here if the first character was "%" for binary
+00B02A48 7808 * get binary number
+00B02A48 7809
+00B02A48 7810 LAB_CBIN
+00B02A48 177C 0040 0619 7811 MOVE.b #$40,Dtypef(a3) * set integer numeric data type
+00B02A4E 7620 7812 MOVEQ #32,d3 * set up max binary exponent
+00B02A50 7813 LAB_CBXN
+00B02A50 6100 E356 7814 BSR LAB_IGBY * increment & scan memory
+00B02A54 64D2 7815 BCC.s LAB_CHX3 * if not numeric character go return value
+00B02A56 7816
+00B02A56 B03C 0032 7817 CMP.b #'2',d0 * compare with "2" (max+1)
+00B02A5A 64CC 7818 BCC.s LAB_CHX3 * if >="2" go return value
+00B02A5C 7819
+00B02A5C 2401 7820 MOVE.l d1,d2 * copy value
+00B02A5E 6124 7821 BSR.s d1x02 * multiply d1 by 2 and add character
+00B02A60 64EE 7822 BCC.s LAB_CBXN * loop for more if no overflow
+00B02A62 7823
+00B02A62 7824 * overflowed mantissa, count 2s exponent
+00B02A62 7825 LAB_CBX1
+00B02A62 5283 7826 ADDQ.l #1,d3 * increment mantissa exponent count
+00B02A64 6900 D6F4 7827 BVS LAB_OFER * do overflow error if overflowed
+00B02A68 7828
+00B02A68 6100 E33E 7829 BSR LAB_IGBY * get next character
+00B02A6C 64BA 7830 BCC.s LAB_CHX3 * if not numeric character go return value
+00B02A6E 7831
+00B02A6E B03C 0032 7832 CMP.b #'2',d0 * compare with "2" (max+1)
+00B02A72 65EE 7833 BCS.s LAB_CBX1 * loop if <"2"
+00B02A74 7834
+00B02A74 60B2 7835 BRA.s LAB_CHX3 * if not numeric character go return value
+00B02A76 7836
+00B02A76 7837 * half way decent times 16 and times 2 with overflow checks
+00B02A76 7838
+00B02A76 7839 d1x16
+00B02A76 2401 7840 MOVE.l d1,d2 * copy value
+00B02A78 D482 7841 ADD.l d2,d2 * times two
+00B02A7A 65CA 7842 BCS.s RTS_024 * return if overflow
+00B02A7C 7843
+00B02A7C D482 7844 ADD.l d2,d2 * times four
+00B02A7E 65C6 7845 BCS.s RTS_024 * return if overflow
+00B02A80 7846
+00B02A80 D482 7847 ADD.l d2,d2 * times eight
+00B02A82 65C2 7848 BCS.s RTS_024 * return if overflow
+00B02A84 7849
+00B02A84 7850 d1x02
+00B02A84 D482 7851 ADD.l d2,d2 * times sixteen (ten/two)
+00B02A86 65BE 7852 BCS.s RTS_024 * return if overflow
+00B02A88 7853
+00B02A88 7854 * now add in new digit
+00B02A88 7855
+00B02A88 C0BC 000000FF 7856 AND.l #$FF,d0 * mask character
+00B02A8E 0400 0030 7857 SUB.b #'0',d0 * convert to value
+00B02A92 D480 7858 ADD.l d0,d2 * add to result
+00B02A94 65B0 7859 BCS.s RTS_024 * return if overflow, it should never ever do
+00B02A96 7860 * this
+00B02A96 7861
+00B02A96 2202 7862 MOVE.l d2,d1 * copy result
+00B02A98 4E75 7863 RTS
+00B02A9A 7864
+00B02A9A 7865 * half way decent times 10 with overflow checks
+00B02A9A 7866
+00B02A9A 7867 d1x10
+00B02A9A 2401 7868 MOVE.l d1,d2 * copy value
+00B02A9C D482 7869 ADD.l d2,d2 * times two
+00B02A9E 6508 7870 BCS.s RTS_025 * return if overflow
+00B02AA0 7871
+00B02AA0 D482 7872 ADD.l d2,d2 * times four
+00B02AA2 6504 7873 BCS.s RTS_025 * return if overflow
+00B02AA4 7874
+00B02AA4 D481 7875 ADD.l d1,d2 * times five
+00B02AA6 64DC 7876 BCC.s d1x02 * do times two and add in new digit if ok
+00B02AA8 7877
+00B02AA8 7878 RTS_025
+00B02AA8 4E75 7879 RTS
+00B02AAA 7880
+00B02AAA 7881
+00B02AAA 7882 *************************************************************************************
+00B02AAA 7883 *
+00B02AAA 7884 * token values needed for BASIC
+00B02AAA 7885
+00B02AAA =00000080 7886 TK_END EQU $80 * $80
+00B02AAA =00000081 7887 TK_FOR EQU TK_END+1 * $81
+00B02AAA =00000082 7888 TK_NEXT EQU TK_FOR+1 * $82
+00B02AAA =00000083 7889 TK_DATA EQU TK_NEXT+1 * $83
+00B02AAA =00000084 7890 TK_INPUT EQU TK_DATA+1 * $84
+00B02AAA =00000085 7891 TK_DIM EQU TK_INPUT+1 * $85
+00B02AAA =00000086 7892 TK_READ EQU TK_DIM+1 * $86
+00B02AAA =00000087 7893 TK_LET EQU TK_READ+1 * $87
+00B02AAA =00000088 7894 TK_DEC EQU TK_LET+1 * $88
+00B02AAA =00000089 7895 TK_GOTO EQU TK_DEC+1 * $89
+00B02AAA =0000008A 7896 TK_RUN EQU TK_GOTO+1 * $8A
+00B02AAA =0000008B 7897 TK_IF EQU TK_RUN+1 * $8B
+00B02AAA =0000008C 7898 TK_RESTORE EQU TK_IF+1 * $8C
+00B02AAA =0000008D 7899 TK_GOSUB EQU TK_RESTORE+1 * $8D
+00B02AAA =0000008E 7900 TK_RETURN EQU TK_GOSUB+1 * $8E
+00B02AAA =0000008F 7901 TK_REM EQU TK_RETURN+1 * $8F
+00B02AAA =00000090 7902 TK_STOP EQU TK_REM+1 * $90
+00B02AAA =00000091 7903 TK_ON EQU TK_STOP+1 * $91
+00B02AAA =00000092 7904 TK_NULL EQU TK_ON+1 * $92
+00B02AAA =00000093 7905 TK_INC EQU TK_NULL+1 * $93
+00B02AAA =00000094 7906 TK_WAIT EQU TK_INC+1 * $94
+00B02AAA =00000095 7907 TK_LOAD EQU TK_WAIT+1 * $95
+00B02AAA =00000096 7908 TK_SAVE EQU TK_LOAD+1 * $96
+00B02AAA =00000097 7909 TK_DEF EQU TK_SAVE+1 * $97
+00B02AAA =00000098 7910 TK_POKE EQU TK_DEF+1 * $98
+00B02AAA =00000099 7911 TK_DOKE EQU TK_POKE+1 * $99
+00B02AAA =0000009A 7912 TK_LOKE EQU TK_DOKE+1 * $9A
+00B02AAA =0000009B 7913 TK_CALL EQU TK_LOKE+1 * $9B
+00B02AAA =0000009C 7914 TK_DO EQU TK_CALL+1 * $9C
+00B02AAA =0000009D 7915 TK_LOOP EQU TK_DO+1 * $9D
+00B02AAA =0000009E 7916 TK_PRINT EQU TK_LOOP+1 * $9E
+00B02AAA =0000009F 7917 TK_CONT EQU TK_PRINT+1 * $9F
+00B02AAA =000000A0 7918 TK_LIST EQU TK_CONT+1 * $A0
+00B02AAA =000000A1 7919 TK_CLEAR EQU TK_LIST+1 * $A1
+00B02AAA =000000A2 7920 TK_NEW EQU TK_CLEAR+1 * $A2
+00B02AAA =000000A3 7921 TK_WIDTH EQU TK_NEW+1 * $A3
+00B02AAA =000000A4 7922 TK_GET EQU TK_WIDTH+1 * $A4
+00B02AAA =000000A5 7923 TK_SWAP EQU TK_GET+1 * $A5
+00B02AAA =000000A6 7924 TK_BITSET EQU TK_SWAP+1 * $A6
+00B02AAA =000000A7 7925 TK_BITCLR EQU TK_BITSET+1 * $A7
+00B02AAA =000000A8 7926 TK_TAB EQU TK_BITCLR+1 * $A8
+00B02AAA =000000A9 7927 TK_ELSE EQU TK_TAB+1 * $A9
+00B02AAA =000000AA 7928 TK_TO EQU TK_ELSE+1 * $AA
+00B02AAA =000000AB 7929 TK_FN EQU TK_TO+1 * $AB
+00B02AAA =000000AC 7930 TK_SPC EQU TK_FN+1 * $AC
+00B02AAA =000000AD 7931 TK_THEN EQU TK_SPC+1 * $AD
+00B02AAA =000000AE 7932 TK_NOT EQU TK_THEN+1 * $AE
+00B02AAA =000000AF 7933 TK_STEP EQU TK_NOT+1 * $AF
+00B02AAA =000000B0 7934 TK_UNTIL EQU TK_STEP+1 * $B0
+00B02AAA =000000B1 7935 TK_WHILE EQU TK_UNTIL+1 * $B1
+00B02AAA =000000B2 7936 TK_PLUS EQU TK_WHILE+1 * $B2
+00B02AAA =000000B3 7937 TK_MINUS EQU TK_PLUS+1 * $B3
+00B02AAA =000000B4 7938 TK_MULT EQU TK_MINUS+1 * $B4
+00B02AAA =000000B5 7939 TK_DIV EQU TK_MULT+1 * $B5
+00B02AAA =000000B6 7940 TK_POWER EQU TK_DIV+1 * $B6
+00B02AAA =000000B7 7941 TK_AND EQU TK_POWER+1 * $B7
+00B02AAA =000000B8 7942 TK_EOR EQU TK_AND+1 * $B8
+00B02AAA =000000B9 7943 TK_OR EQU TK_EOR+1 * $B9
+00B02AAA =000000BA 7944 TK_RSHIFT EQU TK_OR+1 * $BA
+00B02AAA =000000BB 7945 TK_LSHIFT EQU TK_RSHIFT+1 * $BB
+00B02AAA =000000BC 7946 TK_GT EQU TK_LSHIFT+1 * $BC
+00B02AAA =000000BD 7947 TK_EQUAL EQU TK_GT+1 * $BD
+00B02AAA =000000BE 7948 TK_LT EQU TK_EQUAL+1 * $BE
+00B02AAA =000000BF 7949 TK_SGN EQU TK_LT+1 * $BF
+00B02AAA =000000C0 7950 TK_INT EQU TK_SGN+1 * $C0
+00B02AAA =000000C1 7951 TK_ABS EQU TK_INT+1 * $C1
+00B02AAA =000000C2 7952 TK_USR EQU TK_ABS+1 * $C2
+00B02AAA =000000C3 7953 TK_FRE EQU TK_USR+1 * $C3
+00B02AAA =000000C4 7954 TK_POS EQU TK_FRE+1 * $C4
+00B02AAA =000000C5 7955 TK_SQR EQU TK_POS+1 * $C5
+00B02AAA =000000C6 7956 TK_RND EQU TK_SQR+1 * $C6
+00B02AAA =000000C7 7957 TK_LOG EQU TK_RND+1 * $C7
+00B02AAA =000000C8 7958 TK_EXP EQU TK_LOG+1 * $C8
+00B02AAA =000000C9 7959 TK_COS EQU TK_EXP+1 * $C9
+00B02AAA =000000CA 7960 TK_SIN EQU TK_COS+1 * $CA
+00B02AAA =000000CB 7961 TK_TAN EQU TK_SIN+1 * $CB
+00B02AAA =000000CC 7962 TK_ATN EQU TK_TAN+1 * $CC
+00B02AAA =000000CD 7963 TK_PEEK EQU TK_ATN+1 * $CD
+00B02AAA =000000CE 7964 TK_DEEK EQU TK_PEEK+1 * $CE
+00B02AAA =000000CF 7965 TK_LEEK EQU TK_DEEK+1 * $CF
+00B02AAA =000000D0 7966 TK_LEN EQU TK_LEEK+1 * $D0
+00B02AAA =000000D1 7967 TK_STRS EQU TK_LEN+1 * $D1
+00B02AAA =000000D2 7968 TK_VAL EQU TK_STRS+1 * $D2
+00B02AAA =000000D3 7969 TK_ASC EQU TK_VAL+1 * $D3
+00B02AAA =000000D4 7970 TK_UCASES EQU TK_ASC+1 * $D4
+00B02AAA =000000D5 7971 TK_LCASES EQU TK_UCASES+1 * $D5
+00B02AAA =000000D6 7972 TK_CHRS EQU TK_LCASES+1 * $D6
+00B02AAA =000000D7 7973 TK_HEXS EQU TK_CHRS+1 * $D7
+00B02AAA =000000D8 7974 TK_BINS EQU TK_HEXS+1 * $D8
+00B02AAA =000000D9 7975 TK_BITTST EQU TK_BINS+1 * $D9
+00B02AAA =000000DA 7976 TK_MAX EQU TK_BITTST+1 * $DA
+00B02AAA =000000DB 7977 TK_MIN EQU TK_MAX+1 * $DB
+00B02AAA =000000DC 7978 TK_RAM EQU TK_MIN+1 * $DC
+00B02AAA =000000DD 7979 TK_PI EQU TK_RAM+1 * $DD
+00B02AAA =000000DE 7980 TK_TWOPI EQU TK_PI+1 * $DE
+00B02AAA =000000DF 7981 TK_VPTR EQU TK_TWOPI+1 * $DF
+00B02AAA =000000E0 7982 TK_SADD EQU TK_VPTR+1 * $E0
+00B02AAA =000000E1 7983 TK_LEFTS EQU TK_SADD+1 * $E1
+00B02AAA =000000E2 7984 TK_RIGHTS EQU TK_LEFTS+1 * $E2
+00B02AAA =000000E3 7985 TK_MIDS EQU TK_RIGHTS+1 * $E3
+00B02AAA =000000E4 7986 TK_USINGS EQU TK_MIDS+1 * $E4
+00B02AAA 7987
+00B02AAA 7988
+00B02AAA 7989 *************************************************************************************
+00B02AAA 7990 *
+00B02AAA 7991 * binary to unsigned decimal table
+00B02AAA 7992
+00B02AAA 7993 Bin2dec
+00B02AAA= 3B9ACA00 7994 dc.l $3B9ACA00 * 1000000000
+00B02AAE= 05F5E100 7995 dc.l $05F5E100 * 100000000
+00B02AB2= 00989680 7996 dc.l $00989680 * 10000000
+00B02AB6= 000F4240 7997 dc.l $000F4240 * 1000000
+00B02ABA= 000186A0 7998 dc.l $000186A0 * 100000
+00B02ABE= 00002710 7999 dc.l $00002710 * 10000
+00B02AC2= 000003E8 8000 dc.l $000003E8 * 1000
+00B02AC6= 00000064 8001 dc.l $00000064 * 100
+00B02ACA= 0000000A 8002 dc.l $0000000A * 10
+00B02ACE= 00000000 8003 dc.l $00000000 * 0 end marker
+00B02AD2 8004
+00B02AD2 8005 LAB_RSED
+00B02AD2= 332E3232 8006 dc.l $332E3232 * 858665522
+00B02AD6 8007
+00B02AD6 8008 * string to value exponent table
+00B02AD6 8009
+00B02AD6= FF00 8010 dc.w 255<<8 * 10**38
+00B02AD8= 96769951 8011 dc.l $96769951
+00B02ADC= FB00 8012 dc.w 251<<8 * 10**37
+00B02ADE= F0BDC21B 8013 dc.l $F0BDC21B
+00B02AE2= F800 8014 dc.w 248<<8 * 10**36
+00B02AE4= C097CE7C 8015 dc.l $C097CE7C
+00B02AE8= F500 8016 dc.w 245<<8 * 10**35
+00B02AEA= 9A130B96 8017 dc.l $9A130B96
+00B02AEE= F100 8018 dc.w 241<<8 * 10**34
+00B02AF0= F684DF57 8019 dc.l $F684DF57
+00B02AF4= EE00 8020 dc.w 238<<8 * 10**33
+00B02AF6= C5371912 8021 dc.l $C5371912
+00B02AFA= EB00 8022 dc.w 235<<8 * 10**32
+00B02AFC= 9DC5ADA8 8023 dc.l $9DC5ADA8
+00B02B00= E700 8024 dc.w 231<<8 * 10**31
+00B02B02= FC6F7C40 8025 dc.l $FC6F7C40
+00B02B06= E400 8026 dc.w 228<<8 * 10**30
+00B02B08= C9F2C9CD 8027 dc.l $C9F2C9CD
+00B02B0C= E100 8028 dc.w 225<<8 * 10**29
+00B02B0E= A18F07D7 8029 dc.l $A18F07D7
+00B02B12= DE00 8030 dc.w 222<<8 * 10**28
+00B02B14= 813F3979 8031 dc.l $813F3979
+00B02B18= DA00 8032 dc.w 218<<8 * 10**27
+00B02B1A= CECB8F28 8033 dc.l $CECB8F28
+00B02B1E= D700 8034 dc.w 215<<8 * 10**26
+00B02B20= A56FA5BA 8035 dc.l $A56FA5BA
+00B02B24= D400 8036 dc.w 212<<8 * 10**25
+00B02B26= 84595161 8037 dc.l $84595161
+00B02B2A= D000 8038 dc.w 208<<8 * 10**24
+00B02B2C= D3C21BCF 8039 dc.l $D3C21BCF
+00B02B30= CD00 8040 dc.w 205<<8 * 10**23
+00B02B32= A968163F 8041 dc.l $A968163F
+00B02B36= CA00 8042 dc.w 202<<8 * 10**22
+00B02B38= 87867832 8043 dc.l $87867832
+00B02B3C= C600 8044 dc.w 198<<8 * 10**21
+00B02B3E= D8D726B7 8045 dc.l $D8D726B7
+00B02B42= C300 8046 dc.w 195<<8 * 10**20
+00B02B44= AD78EBC6 8047 dc.l $AD78EBC6
+00B02B48= C000 8048 dc.w 192<<8 * 10**19
+00B02B4A= 8AC72305 8049 dc.l $8AC72305
+00B02B4E= BC00 8050 dc.w 188<<8 * 10**18
+00B02B50= DE0B6B3A 8051 dc.l $DE0B6B3A
+00B02B54= B900 8052 dc.w 185<<8 * 10**17
+00B02B56= B1A2BC2F 8053 dc.l $B1A2BC2F
+00B02B5A= B600 8054 dc.w 182<<8 * 10**16
+00B02B5C= 8E1BC9BF 8055 dc.l $8E1BC9BF
+00B02B60= B200 8056 dc.w 178<<8 * 10**15
+00B02B62= E35FA932 8057 dc.l $E35FA932
+00B02B66= AF00 8058 dc.w 175<<8 * 10**14
+00B02B68= B5E620F5 8059 dc.l $B5E620F5
+00B02B6C= AC00 8060 dc.w 172<<8 * 10**13
+00B02B6E= 9184E72A 8061 dc.l $9184E72A
+00B02B72= A800 8062 dc.w 168<<8 * 10**12
+00B02B74= E8D4A510 8063 dc.l $E8D4A510
+00B02B78= A500 8064 dc.w 165<<8 * 10**11
+00B02B7A= BA43B740 8065 dc.l $BA43B740
+00B02B7E= A200 8066 dc.w 162<<8 * 10**10
+00B02B80= 9502F900 8067 dc.l $9502F900
+00B02B84= 9E00 8068 dc.w 158<<8 * 10**9
+00B02B86= EE6B2800 8069 dc.l $EE6B2800
+00B02B8A= 9B00 8070 dc.w 155<<8 * 10**8
+00B02B8C= BEBC2000 8071 dc.l $BEBC2000
+00B02B90= 9800 8072 dc.w 152<<8 * 10**7
+00B02B92= 98968000 8073 dc.l $98968000
+00B02B96= 9400 8074 dc.w 148<<8 * 10**6
+00B02B98= F4240000 8075 dc.l $F4240000
+00B02B9C= 9100 8076 dc.w 145<<8 * 10**5
+00B02B9E= C3500000 8077 dc.l $C3500000
+00B02BA2= 8E00 8078 dc.w 142<<8 * 10**4
+00B02BA4= 9C400000 8079 dc.l $9C400000
+00B02BA8= 8A00 8080 dc.w 138<<8 * 10**3
+00B02BAA= FA000000 8081 dc.l $FA000000
+00B02BAE= 8700 8082 dc.w 135<<8 * 10**2
+00B02BB0= C8000000 8083 dc.l $C8000000
+00B02BB4= 8400 8084 dc.w 132<<8 * 10**1
+00B02BB6= A0000000 8085 dc.l $A0000000
+00B02BBA 8086 LAB_P_10
+00B02BBA= 8100 8087 dc.w 129<<8 * 10**0
+00B02BBC= 80000000 8088 dc.l $80000000
+00B02BC0= 7D00 8089 dc.w 125<<8 * 10**-1
+00B02BC2= CCCCCCCD 8090 dc.l $CCCCCCCD
+00B02BC6= 7A00 8091 dc.w 122<<8 * 10**-2
+00B02BC8= A3D70A3D 8092 dc.l $A3D70A3D
+00B02BCC= 7700 8093 dc.w 119<<8 * 10**-3
+00B02BCE= 83126E98 8094 dc.l $83126E98
+00B02BD2= 7300 8095 dc.w 115<<8 * 10**-4
+00B02BD4= D1B71759 8096 dc.l $D1B71759
+00B02BD8= 7000 8097 dc.w 112<<8 * 10**-5
+00B02BDA= A7C5AC47 8098 dc.l $A7C5AC47
+00B02BDE= 6D00 8099 dc.w 109<<8 * 10**-6
+00B02BE0= 8637BD06 8100 dc.l $8637BD06
+00B02BE4= 6900 8101 dc.w 105<<8 * 10**-7
+00B02BE6= D6BF94D6 8102 dc.l $D6BF94D6
+00B02BEA= 6600 8103 dc.w 102<<8 * 10**-8
+00B02BEC= ABCC7712 8104 dc.l $ABCC7712
+00B02BF0= 6300 8105 dc.w 99<<8 * 10**-9
+00B02BF2= 89705F41 8106 dc.l $89705F41
+00B02BF6= 5F00 8107 dc.w 95<<8 * 10**-10
+00B02BF8= DBE6FECF 8108 dc.l $DBE6FECF
+00B02BFC= 5C00 8109 dc.w 92<<8 * 10**-11
+00B02BFE= AFEBFF0C 8110 dc.l $AFEBFF0C
+00B02C02= 5900 8111 dc.w 89<<8 * 10**-12
+00B02C04= 8CBCCC09 8112 dc.l $8CBCCC09
+00B02C08= 5500 8113 dc.w 85<<8 * 10**-13
+00B02C0A= E12E1342 8114 dc.l $E12E1342
+00B02C0E= 5200 8115 dc.w 82<<8 * 10**-14
+00B02C10= B424DC35 8116 dc.l $B424DC35
+00B02C14= 4F00 8117 dc.w 79<<8 * 10**-15
+00B02C16= 901D7CF7 8118 dc.l $901D7CF7
+00B02C1A= 4B00 8119 dc.w 75<<8 * 10**-16
+00B02C1C= E69594BF 8120 dc.l $E69594BF
+00B02C20= 4800 8121 dc.w 72<<8 * 10**-17
+00B02C22= B877AA32 8122 dc.l $B877AA32
+00B02C26= 4500 8123 dc.w 69<<8 * 10**-18
+00B02C28= 9392EE8F 8124 dc.l $9392EE8F
+00B02C2C= 4100 8125 dc.w 65<<8 * 10**-19
+00B02C2E= EC1E4A7E 8126 dc.l $EC1E4A7E
+00B02C32= 3E00 8127 dc.w 62<<8 * 10**-20
+00B02C34= BCE50865 8128 dc.l $BCE50865
+00B02C38= 3B00 8129 dc.w 59<<8 * 10**-21
+00B02C3A= 971DA050 8130 dc.l $971DA050
+00B02C3E= 3700 8131 dc.w 55<<8 * 10**-22
+00B02C40= F1C90081 8132 dc.l $F1C90081
+00B02C44= 3400 8133 dc.w 52<<8 * 10**-23
+00B02C46= C16D9A01 8134 dc.l $C16D9A01
+00B02C4A= 3100 8135 dc.w 49<<8 * 10**-24
+00B02C4C= 9ABE14CD 8136 dc.l $9ABE14CD
+00B02C50= 2D00 8137 dc.w 45<<8 * 10**-25
+00B02C52= F79687AE 8138 dc.l $F79687AE
+00B02C56= 2A00 8139 dc.w 42<<8 * 10**-26
+00B02C58= C6120625 8140 dc.l $C6120625
+00B02C5C= 2700 8141 dc.w 39<<8 * 10**-27
+00B02C5E= 9E74D1B8 8142 dc.l $9E74D1B8
+00B02C62= 2300 8143 dc.w 35<<8 * 10**-28
+00B02C64= FD87B5F3 8144 dc.l $FD87B5F3
+00B02C68= 2000 8145 dc.w 32<<8 * 10**-29
+00B02C6A= CAD2F7F5 8146 dc.l $CAD2F7F5
+00B02C6E= 1D00 8147 dc.w 29<<8 * 10**-30
+00B02C70= A2425FF7 8148 dc.l $A2425FF7
+00B02C74= 1A00 8149 dc.w 26<<8 * 10**-31
+00B02C76= 81CEB32C 8150 dc.l $81CEB32C
+00B02C7A= 1600 8151 dc.w 22<<8 * 10**-32
+00B02C7C= CFB11EAD 8152 dc.l $CFB11EAD
+00B02C80= 1300 8153 dc.w 19<<8 * 10**-33
+00B02C82= A6274BBE 8154 dc.l $A6274BBE
+00B02C86= 1000 8155 dc.w 16<<8 * 10**-34
+00B02C88= 84EC3C98 8156 dc.l $84EC3C98
+00B02C8C= 0C00 8157 dc.w 12<<8 * 10**-35
+00B02C8E= D4AD2DC0 8158 dc.l $D4AD2DC0
+00B02C92= 0900 8159 dc.w 9<<8 * 10**-36
+00B02C94= AA242499 8160 dc.l $AA242499
+00B02C98= 0600 8161 dc.w 6<<8 * 10**-37
+00B02C9A= 881CEA14 8162 dc.l $881CEA14
+00B02C9E= 0200 8163 dc.w 2<<8 * 10**-38
+00B02CA0= D9C7DCED 8164 dc.l $D9C7DCED
+00B02CA4 8165
+00B02CA4 8166
+00B02CA4 8167 *************************************************************************************
+00B02CA4 8168 *
+00B02CA4 8169 * table of constants for cordic SIN/COS/TAN calculations
+00B02CA4 8170 * constants are un normalised fractions and are atn(2^-i)/2pi
+00B02CA4 8171
+00B02CA4= 4DBA76D4 8172 dc.l $4DBA76D4 * SIN/COS multiply constant
+00B02CA8 8173 TAB_SNCO
+00B02CA8= 20000000 8174 dc.l $20000000 * atn(2^0)/2pi
+00B02CAC= 12E4051E 8175 dc.l $12E4051E * atn(2^1)/2pi
+00B02CB0= 09FB385C 8176 dc.l $09FB385C * atn(2^2)/2pi
+00B02CB4= 051111D5 8177 dc.l $051111D5 * atn(2^3)/2pi
+00B02CB8= 028B0D44 8178 dc.l $028B0D44 * atn(2^4)/2pi
+00B02CBC= 0145D7E2 8179 dc.l $0145D7E2 * atn(2^5)/2pi
+00B02CC0= 00A2F61F 8180 dc.l $00A2F61F * atn(2^6)/2pi
+00B02CC4= 00517C56 8181 dc.l $00517C56 * atn(2^7)/2pi
+00B02CC8= 0028BE54 8182 dc.l $0028BE54 * atn(2^8)/2pi
+00B02CCC= 00145F2F 8183 dc.l $00145F2F * atn(2^9)/2pi
+00B02CD0= 000A2F99 8184 dc.l $000A2F99 * atn(2^10)/2pi
+00B02CD4= 000517CD 8185 dc.l $000517CD * atn(2^11)/2pi
+00B02CD8= 00028BE7 8186 dc.l $00028BE7 * atn(2^12)/2pi
+00B02CDC= 000145F4 8187 dc.l $000145F4 * atn(2^13)/2pi
+00B02CE0= 0000A2FA 8188 dc.l $0000A2FA * atn(2^14)/2pi
+00B02CE4= 0000517D 8189 dc.l $0000517D * atn(2^15)/2pi
+00B02CE8= 000028BF 8190 dc.l $000028BF * atn(2^16)/2pi
+00B02CEC= 00001460 8191 dc.l $00001460 * atn(2^17)/2pi
+00B02CF0= 00000A30 8192 dc.l $00000A30 * atn(2^18)/2pi
+00B02CF4= 00000518 8193 dc.l $00000518 * atn(2^19)/2pi
+00B02CF8= 0000028C 8194 dc.l $0000028C * atn(2^20)/2pi
+00B02CFC= 00000146 8195 dc.l $00000146 * atn(2^21)/2pi
+00B02D00= 000000A3 8196 dc.l $000000A3 * atn(2^22)/2pi
+00B02D04= 00000052 8197 dc.l $00000052 * atn(2^23)/2pi
+00B02D08= 00000029 8198 dc.l $00000029 * atn(2^24)/2pi
+00B02D0C= 00000015 8199 dc.l $00000015 * atn(2^25)/2pi
+00B02D10= 0000000B 8200 dc.l $0000000B * atn(2^26)/2pi
+00B02D14= 00000006 8201 dc.l $00000006 * atn(2^27)/2pi
+00B02D18= 00000003 8202 dc.l $00000003 * atn(2^28)/2pi
+00B02D1C= 00000002 8203 dc.l $00000002 * atn(2^29)/2pi
+00B02D20= 00000001 8204 dc.l $00000001 * atn(2^30)/2pi
+00B02D24= 00000001 8205 dc.l $00000001 * atn(2^31)/2pi
+00B02D28 8206
+00B02D28 8207
+00B02D28 8208 *************************************************************************************
+00B02D28 8209 *
+00B02D28 8210 * table of constants for cordic ATN calculation
+00B02D28 8211 * constants are normalised to two integer bits and are atn(2^-i)
+00B02D28 8212
+00B02D28 8213 TAB_ATNC
+00B02D28= 1DAC6705 8214 dc.l $1DAC6705 * atn(2^-1)
+00B02D2C= 0FADBAFD 8215 dc.l $0FADBAFD * atn(2^-2)
+00B02D30= 07F56EA7 8216 dc.l $07F56EA7 * atn(2^-3)
+00B02D34= 03FEAB77 8217 dc.l $03FEAB77 * atn(2^-4)
+00B02D38= 01FFD55C 8218 dc.l $01FFD55C * atn(2^-5)
+00B02D3C= 00FFFAAB 8219 dc.l $00FFFAAB * atn(2^-6)
+00B02D40= 007FFF55 8220 dc.l $007FFF55 * atn(2^-7)
+00B02D44= 003FFFEB 8221 dc.l $003FFFEB * atn(2^-8)
+00B02D48= 001FFFFD 8222 dc.l $001FFFFD * atn(2^-9)
+00B02D4C= 00100000 8223 dc.l $00100000 * atn(2^-10)
+00B02D50= 00080000 8224 dc.l $00080000 * atn(2^-11)
+00B02D54= 00040000 8225 dc.l $00040000 * atn(2^-12)
+00B02D58= 00020000 8226 dc.l $00020000 * atn(2^-13)
+00B02D5C= 00010000 8227 dc.l $00010000 * atn(2^-14)
+00B02D60= 00008000 8228 dc.l $00008000 * atn(2^-15)
+00B02D64= 00004000 8229 dc.l $00004000 * atn(2^-16)
+00B02D68= 00002000 8230 dc.l $00002000 * atn(2^-17)
+00B02D6C= 00001000 8231 dc.l $00001000 * atn(2^-18)
+00B02D70= 00000800 8232 dc.l $00000800 * atn(2^-19)
+00B02D74= 00000400 8233 dc.l $00000400 * atn(2^-20)
+00B02D78= 00000200 8234 dc.l $00000200 * atn(2^-21)
+00B02D7C= 00000100 8235 dc.l $00000100 * atn(2^-22)
+00B02D80= 00000080 8236 dc.l $00000080 * atn(2^-23)
+00B02D84= 00000040 8237 dc.l $00000040 * atn(2^-24)
+00B02D88= 00000020 8238 dc.l $00000020 * atn(2^-25)
+00B02D8C= 00000010 8239 dc.l $00000010 * atn(2^-26)
+00B02D90= 00000008 8240 dc.l $00000008 * atn(2^-27)
+00B02D94= 00000004 8241 dc.l $00000004 * atn(2^-28)
+00B02D98= 00000002 8242 dc.l $00000002 * atn(2^-29)
+00B02D9C= 00000001 8243 dc.l $00000001 * atn(2^-30)
+00B02DA0 8244 LAB_1D96
+00B02DA0= 00000000 8245 dc.l $00000000 * atn(2^-31)
+00B02DA4= 00000000 8246 dc.l $00000000 * atn(2^-32)
+00B02DA8 8247
+00B02DA8 8248 * constants are normalised to n integer bits and are tanh(2^-i)
+00B02DA8 =00000002 8249 n equ 2
+00B02DA8 8250 TAB_HTHET
+00B02DA8= 2327D4F4 8251 dc.l $8C9F53D0>>n * atnh(2^-1) .549306144
+00B02DAC= 1058AEFA 8252 dc.l $4162BBE8>>n * atnh(2^-2) .255412812
+00B02DB0= 080AC48E 8253 dc.l $202B1238>>n * atnh(2^-3)
+00B02DB4= 04015622 8254 dc.l $10055888>>n * atnh(2^-4)
+00B02DB8= 02002AB0 8255 dc.l $0800AAC0>>n * atnh(2^-5)
+00B02DBC= 01000554 8256 dc.l $04001550>>n * atnh(2^-6)
+00B02DC0= 008000AA 8257 dc.l $020002A8>>n * atnh(2^-7)
+00B02DC4= 00400014 8258 dc.l $01000050>>n * atnh(2^-8)
+00B02DC8= 00200002 8259 dc.l $00800008>>n * atnh(2^-9)
+00B02DCC= 00100000 8260 dc.l $00400000>>n * atnh(2^-10)
+00B02DD0= 00080000 8261 dc.l $00200000>>n * atnh(2^-11)
+00B02DD4= 00040000 8262 dc.l $00100000>>n * atnh(2^-12)
+00B02DD8= 00020000 8263 dc.l $00080000>>n * atnh(2^-13)
+00B02DDC= 00010000 8264 dc.l $00040000>>n * atnh(2^-14)
+00B02DE0= 00008000 8265 dc.l $00020000>>n * atnh(2^-15)
+00B02DE4= 00004000 8266 dc.l $00010000>>n * atnh(2^-16)
+00B02DE8= 00002000 8267 dc.l $00008000>>n * atnh(2^-17)
+00B02DEC= 00001000 8268 dc.l $00004000>>n * atnh(2^-18)
+00B02DF0= 00000800 8269 dc.l $00002000>>n * atnh(2^-19)
+00B02DF4= 00000400 8270 dc.l $00001000>>n * atnh(2^-20)
+00B02DF8= 00000200 8271 dc.l $00000800>>n * atnh(2^-21)
+00B02DFC= 00000100 8272 dc.l $00000400>>n * atnh(2^-22)
+00B02E00= 00000080 8273 dc.l $00000200>>n * atnh(2^-23)
+00B02E04= 00000040 8274 dc.l $00000100>>n * atnh(2^-24)
+00B02E08= 00000020 8275 dc.l $00000080>>n * atnh(2^-25)
+00B02E0C= 00000010 8276 dc.l $00000040>>n * atnh(2^-26)
+00B02E10= 00000008 8277 dc.l $00000020>>n * atnh(2^-27)
+00B02E14= 00000004 8278 dc.l $00000010>>n * atnh(2^-28)
+00B02E18= 00000002 8279 dc.l $00000008>>n * atnh(2^-29)
+00B02E1C= 00000001 8280 dc.l $00000004>>n * atnh(2^-30)
+00B02E20= 00000000 8281 dc.l $00000002>>n * atnh(2^-31)
+00B02E24= 00000000 8282 dc.l $00000001>>n * atnh(2^-32)
+00B02E28 8283
+00B02E28 =26A3D110 8284 KFCTSEED equ $9A8F4441>>n * $26A3D110
+00B02E28 8285
+00B02E28 8286
+00B02E28 8287 *************************************************************************************
+00B02E28 8288 *
+00B02E28 8289 * command vector table
+00B02E28 8290
+00B02E28 8291 LAB_CTBL
+00B02E28= D7B2 8292 dc.w LAB_END-LAB_CTBL * END
+00B02E2A= D6E6 8293 dc.w LAB_FOR-LAB_CTBL * FOR
+00B02E2C= DD52 8294 dc.w LAB_NEXT-LAB_CTBL * NEXT
+00B02E2E= D906 8295 dc.w LAB_DATA-LAB_CTBL * DATA
+00B02E30= DC46 8296 dc.w LAB_INPUT-LAB_CTBL * INPUT
+00B02E32= E122 8297 dc.w LAB_DIM-LAB_CTBL * DIM
+00B02E34= DC6C 8298 dc.w LAB_READ-LAB_CTBL * READ
+00B02E36= DA78 8299 dc.w LAB_LET-LAB_CTBL * LET
+00B02E38= DA16 8300 dc.w LAB_DEC-LAB_CTBL * DEC
+00B02E3A= D86E 8301 dc.w LAB_GOTO-LAB_CTBL * GOTO
+00B02E3C= D836 8302 dc.w LAB_RUN-LAB_CTBL * RUN
+00B02E3E= D92E 8303 dc.w LAB_IF-LAB_CTBL * IF
+00B02E40= D7E0 8304 dc.w LAB_RESTORE-LAB_CTBL * RESTORE
+00B02E42= D85C 8305 dc.w LAB_GOSUB-LAB_CTBL * GOSUB
+00B02E44= D8F2 8306 dc.w LAB_RETURN-LAB_CTBL * RETURN
+00B02E46= D99C 8307 dc.w LAB_REM-LAB_CTBL * REM
+00B02E48= D7BA 8308 dc.w LAB_STOP-LAB_CTBL * STOP
+00B02E4A= D9A4 8309 dc.w LAB_ON-LAB_CTBL * ON
+00B02E4C= D80E 8310 dc.w LAB_NULL-LAB_CTBL * NULL
+00B02E4E= DA1C 8311 dc.w LAB_INC-LAB_CTBL * INC
+00B02E50= EA28 8312 dc.w LAB_WAIT-LAB_CTBL * WAIT
+00B02E52= EA16 8313 dc.w LAB_LOAD-LAB_CTBL * LOAD
+00B02E54= EA1A 8314 dc.w LAB_SAVE-LAB_CTBL * SAVE
+00B02E56= E4B2 8315 dc.w LAB_DEF-LAB_CTBL * DEF
+00B02E58= E996 8316 dc.w LAB_POKE-LAB_CTBL * POKE
+00B02E5A= E9C6 8317 dc.w LAB_DOKE-LAB_CTBL * DOKE
+00B02E5C= E9CC 8318 dc.w LAB_LOKE-LAB_CTBL * LOKE
+00B02E5E= EA1E 8319 dc.w LAB_CALL-LAB_CTBL * CALL
+00B02E60= D84A 8320 dc.w LAB_DO-LAB_CTBL * DO
+00B02E62= D89C 8321 dc.w LAB_LOOP-LAB_CTBL * LOOP
+00B02E64= DB0C 8322 dc.w LAB_PRINT-LAB_CTBL * PRINT
+00B02E66= D818 8323 dc.w LAB_CONT-LAB_CTBL * CONT
+00B02E68= D630 8324 dc.w LAB_LIST-LAB_CTBL * LIST
+00B02E6A= D62C 8325 dc.w LAB_CLEAR-LAB_CTBL * CLEAR
+00B02E6C= D5DC 8326 dc.w LAB_NEW-LAB_CTBL * NEW
+00B02E6E= F954 8327 dc.w LAB_WDTH-LAB_CTBL * WIDTH
+00B02E70= DAD2 8328 dc.w LAB_GET-LAB_CTBL * GET
+00B02E72= E9E0 8329 dc.w LAB_SWAP-LAB_CTBL * SWAP
+00B02E74= F49E 8330 dc.w LAB_BITSET-LAB_CTBL * BITSET
+00B02E76= F4AE 8331 dc.w LAB_BITCLR-LAB_CTBL * BITCLR
+00B02E78 8332
+00B02E78 8333
+00B02E78 8334 *************************************************************************************
+00B02E78 8335 *
+00B02E78 8336 * function pre process routine table
+00B02E78 8337
+00B02E78 8338 LAB_FTPP
+00B02E78= DFD0 8339 dc.w LAB_PPFN-LAB_FTPP * SGN(n) process numeric expression in ()
+00B02E7A= DFD0 8340 dc.w LAB_PPFN-LAB_FTPP * INT(n) "
+00B02E7C= DFD0 8341 dc.w LAB_PPFN-LAB_FTPP * ABS(n) "
+00B02E7E= DDD2 8342 dc.w LAB_EVEZ-LAB_FTPP * USR(x) process any expression
+00B02E80= DF1A 8343 dc.w LAB_1BF7-LAB_FTPP * FRE(x) process any expression in ()
+00B02E82= DF1A 8344 dc.w LAB_1BF7-LAB_FTPP * POS(x) "
+00B02E84= DFD0 8345 dc.w LAB_PPFN-LAB_FTPP * SQR(n) process numeric expression in ()
+00B02E86= DFD0 8346 dc.w LAB_PPFN-LAB_FTPP * RND(n) "
+00B02E88= DFD0 8347 dc.w LAB_PPFN-LAB_FTPP * LOG(n) "
+00B02E8A= DFD0 8348 dc.w LAB_PPFN-LAB_FTPP * EXP(n) "
+00B02E8C= DFD0 8349 dc.w LAB_PPFN-LAB_FTPP * COS(n) "
+00B02E8E= DFD0 8350 dc.w LAB_PPFN-LAB_FTPP * SIN(n) "
+00B02E90= DFD0 8351 dc.w LAB_PPFN-LAB_FTPP * TAN(n) "
+00B02E92= DFD0 8352 dc.w LAB_PPFN-LAB_FTPP * ATN(n) "
+00B02E94= DFD0 8353 dc.w LAB_PPFN-LAB_FTPP * PEEK(n) "
+00B02E96= DFD0 8354 dc.w LAB_PPFN-LAB_FTPP * DEEK(n) "
+00B02E98= DFD0 8355 dc.w LAB_PPFN-LAB_FTPP * LEEK(n) "
+00B02E9A= DFC2 8356 dc.w LAB_PPFS-LAB_FTPP * LEN($) process string expression in ()
+00B02E9C= DFD0 8357 dc.w LAB_PPFN-LAB_FTPP * STR$(n) process numeric expression in ()
+00B02E9E= DFC2 8358 dc.w LAB_PPFS-LAB_FTPP * VAL($) process string expression in ()
+00B02EA0= DFC2 8359 dc.w LAB_PPFS-LAB_FTPP * ASC($) "
+00B02EA2= DFC2 8360 dc.w LAB_PPFS-LAB_FTPP * UCASE$($) "
+00B02EA4= DFC2 8361 dc.w LAB_PPFS-LAB_FTPP * LCASE$($) "
+00B02EA6= DFD0 8362 dc.w LAB_PPFN-LAB_FTPP * CHR$(n) process numeric expression in ()
+00B02EA8= E00A 8363 dc.w LAB_BHSS-LAB_FTPP * HEX$() bin/hex pre process
+00B02EAA= E00A 8364 dc.w LAB_BHSS-LAB_FTPP * BIN$() "
+00B02EAC= 0000 8365 dc.w $0000 * BITTST() none
+00B02EAE= 0000 8366 dc.w $0000 * MAX() "
+00B02EB0= 0000 8367 dc.w $0000 * MIN() "
+00B02EB2= DFDE 8368 dc.w LAB_PPBI-LAB_FTPP * RAMBASE advance pointer
+00B02EB4= DFDE 8369 dc.w LAB_PPBI-LAB_FTPP * PI "
+00B02EB6= DFDE 8370 dc.w LAB_PPBI-LAB_FTPP * TWOPI "
+00B02EB8= 0000 8371 dc.w $0000 * VARPTR() none
+00B02EBA= 0000 8372 dc.w $0000 * SADD() "
+00B02EBC= DFE8 8373 dc.w LAB_LRMS-LAB_FTPP * LEFT$() process string expression
+00B02EBE= DFE8 8374 dc.w LAB_LRMS-LAB_FTPP * RIGHT$() "
+00B02EC0= DFE8 8375 dc.w LAB_LRMS-LAB_FTPP * MID$() "
+00B02EC2= DDD2 8376 dc.w LAB_EVEZ-LAB_FTPP * USING$(x) process any expression
+00B02EC4 8377
+00B02EC4 8378
+00B02EC4 8379 *************************************************************************************
+00B02EC4 8380 *
+00B02EC4 8381 * action addresses for functions
+00B02EC4 8382
+00B02EC4 8383 LAB_FTBL
+00B02EC4= ED54 8384 dc.w LAB_SGN-LAB_FTBL * SGN()
+00B02EC6= EDD6 8385 dc.w LAB_INT-LAB_FTBL * INT()
+00B02EC8= ED66 8386 dc.w LAB_ABS-LAB_FTBL * ABS()
+00B02ECA= E972 8387 dc.w LAB_USR-LAB_FTBL * USR()
+00B02ECC= E3CE 8388 dc.w LAB_FRE-LAB_FTBL * FRE()
+00B02ECE= E400 8389 dc.w LAB_POS-LAB_FTBL * POS()
+00B02ED0= F938 8390 dc.w LAB_SQR-LAB_FTBL * SQR()
+00B02ED2= F21E 8391 dc.w LAB_RND-LAB_FTBL * RND()
+00B02ED4= EA76 8392 dc.w LAB_LOG-LAB_FTBL * LOG()
+00B02ED6= F104 8393 dc.w LAB_EXP-LAB_FTBL * EXP()
+00B02ED8= F272 8394 dc.w LAB_COS-LAB_FTBL * COS()
+00B02EDA= F28A 8395 dc.w LAB_SIN-LAB_FTBL * SIN()
+00B02EDC= F250 8396 dc.w LAB_TAN-LAB_FTBL * TAN()
+00B02EDE= F350 8397 dc.w LAB_ATN-LAB_FTBL * ATN()
+00B02EE0= E8EE 8398 dc.w LAB_PEEK-LAB_FTBL * PEEK()
+00B02EE2= E900 8399 dc.w LAB_DEEK-LAB_FTBL * DEEK()
+00B02EE4= E916 8400 dc.w LAB_LEEK-LAB_FTBL * LEEK()
+00B02EE6= E832 8401 dc.w LAB_LENS-LAB_FTBL * LEN()
+00B02EE8= E4F6 8402 dc.w LAB_STRS-LAB_FTBL * STR$()
+00B02EEA= E876 8403 dc.w LAB_VAL-LAB_FTBL * VAL()
+00B02EEC= E83A 8404 dc.w LAB_ASC-LAB_FTBL * ASC()
+00B02EEE= E7E8 8405 dc.w LAB_UCASE-LAB_FTBL * UCASE$()
+00B02EF0= E7B8 8406 dc.w LAB_LCASE-LAB_FTBL * LCASE$()
+00B02EF2= E720 8407 dc.w LAB_CHRS-LAB_FTBL * CHR$()
+00B02EF4= F7DA 8408 dc.w LAB_HEXS-LAB_FTBL * HEX$()
+00B02EF6= F788 8409 dc.w LAB_BINS-LAB_FTBL * BIN$()
+00B02EF8= F422 8410 dc.w LAB_BTST-LAB_FTBL * BITTST()
+00B02EFA= F846 8411 dc.w LAB_MAX-LAB_FTBL * MAX()
+00B02EFC= F85C 8412 dc.w LAB_MIN-LAB_FTBL * MIN()
+00B02EFE= F9AA 8413 dc.w LAB_RAM-LAB_FTBL * RAMBASE
+00B02F00= F9B4 8414 dc.w LAB_PI-LAB_FTBL * PI
+00B02F02= F9C4 8415 dc.w LAB_TWOPI-LAB_FTBL * TWOPI
+00B02F04= F99A 8416 dc.w LAB_VARPTR-LAB_FTBL * VARPTR()
+00B02F06= E81A 8417 dc.w LAB_SADD-LAB_FTBL * SADD()
+00B02F08= E730 8418 dc.w LAB_LEFT-LAB_FTBL * LEFT$()
+00B02F0A= E744 8419 dc.w LAB_RIGHT-LAB_FTBL * RIGHT$()
+00B02F0C= E774 8420 dc.w LAB_MIDS-LAB_FTBL * MID$()
+00B02F0E= F450 8421 dc.w LAB_USINGS-LAB_FTBL * USING$()
+00B02F10 8422
+00B02F10 8423
+00B02F10 8424 *************************************************************************************
+00B02F10 8425 *
+00B02F10 8426 * hierarchy and action addresses for operator
+00B02F10 8427
+00B02F10 8428 LAB_OPPT
+00B02F10= 0079 8429 dc.w $0079 * +
+00B02F12= E978 8430 dc.w LAB_ADD-LAB_OPPT
+00B02F14= 0079 8431 dc.w $0079 * -
+00B02F16= E964 8432 dc.w LAB_SUBTRACT-LAB_OPPT
+00B02F18= 007B 8433 dc.w $007B * *
+00B02F1A= EB1C 8434 dc.w LAB_MULTIPLY-LAB_OPPT
+00B02F1C= 007B 8435 dc.w $007B * /
+00B02F1E= EBA8 8436 dc.w LAB_DIVIDE-LAB_OPPT
+00B02F20= 007F 8437 dc.w $007F * ^
+00B02F22= F002 8438 dc.w LAB_POWER-LAB_OPPT
+00B02F24= 0050 8439 dc.w $0050 * AND
+00B02F26= DFB2 8440 dc.w LAB_AND-LAB_OPPT
+00B02F28= 0046 8441 dc.w $0046 * EOR
+00B02F2A= DFA2 8442 dc.w LAB_EOR-LAB_OPPT
+00B02F2C= 0046 8443 dc.w $0046 * OR
+00B02F2E= DFAA 8444 dc.w LAB_OR-LAB_OPPT
+00B02F30= 0056 8445 dc.w $0056 * >>
+00B02F32= E056 8446 dc.w LAB_RSHIFT-LAB_OPPT
+00B02F34= 0056 8447 dc.w $0056 * <<
+00B02F36= E046 8448 dc.w LAB_LSHIFT-LAB_OPPT
+00B02F38= 007D 8449 dc.w $007D * >
+00B02F3A= F066 8450 dc.w LAB_GTHAN-LAB_OPPT * used to evaluate -n
+00B02F3C= 005A 8451 dc.w $005A * =
+00B02F3E= DFC8 8452 dc.w LAB_EQUAL-LAB_OPPT * used to evaluate NOT
+00B02F40= 0064 8453 dc.w $0064 * <
+00B02F42= DFD2 8454 dc.w LAB_LTHAN-LAB_OPPT
+00B02F44 8455
+00B02F44 8456
+00B02F44 8457 *************************************************************************************
+00B02F44 8458 *
+00B02F44 8459 * misc constants
+00B02F44 8460
+00B02F44 8461 * This table is used in converting numbers to ASCII.
+00B02F44 8462 * first four entries for expansion to 9.25 digits
+00B02F44 8463
+00B02F44 8464 LAB_2A9A
+00B02F44= FFF0BDC0 8465 dc.l $FFF0BDC0 * -1000000
+00B02F48= 000186A0 8466 dc.l $000186A0 * 100000
+00B02F4C= FFFFD8F0 8467 dc.l $FFFFD8F0 * -10000
+00B02F50= 000003E8 8468 dc.l $000003E8 * 1000
+00B02F54= FFFFFF9C 8469 dc.l $FFFFFF9C * -100
+00B02F58= 0000000A 8470 dc.l $0000000A * 10
+00B02F5C= FFFFFFFF 8471 dc.l $FFFFFFFF * -1
+00B02F60 8472 LAB_2A9B
+00B02F60 8473
+00B02F60 8474
+00B02F60 8475 *************************************************************************************
+00B02F60 8476 *
+00B02F60 8477 * new keyword tables
+00B02F60 8478
+00B02F60 8479 * offsets to keyword tables
+00B02F60 8480
+00B02F60 8481 TAB_CHRT
+00B02F60= 0000 8482 dc.w TAB_STAR-TAB_STAR * "*" $2A
+00B02F62= 0002 8483 dc.w TAB_PLUS-TAB_STAR * "+" $2B
+00B02F64= FFFF 8484 dc.w -1 * "," $2C no keywords
+00B02F66= 0004 8485 dc.w TAB_MNUS-TAB_STAR * "-" $2D
+00B02F68= FFFF 8486 dc.w -1 * "." $2E no keywords
+00B02F6A= 0006 8487 dc.w TAB_SLAS-TAB_STAR * "/" $2F
+00B02F6C= FFFF 8488 dc.w -1 * "0" $30 no keywords
+00B02F6E= FFFF 8489 dc.w -1 * "1" $31 no keywords
+00B02F70= FFFF 8490 dc.w -1 * "2" $32 no keywords
+00B02F72= FFFF 8491 dc.w -1 * "3" $33 no keywords
+00B02F74= FFFF 8492 dc.w -1 * "4" $34 no keywords
+00B02F76= FFFF 8493 dc.w -1 * "5" $35 no keywords
+00B02F78= FFFF 8494 dc.w -1 * "6" $36 no keywords
+00B02F7A= FFFF 8495 dc.w -1 * "7" $37 no keywords
+00B02F7C= FFFF 8496 dc.w -1 * "8" $38 no keywords
+00B02F7E= FFFF 8497 dc.w -1 * "9" $39 no keywords
+00B02F80= FFFF 8498 dc.w -1 * ";" $3A no keywords
+00B02F82= FFFF 8499 dc.w -1 * ":" $3B no keywords
+00B02F84= 0008 8500 dc.w TAB_LESS-TAB_STAR * "<" $3C
+00B02F86= 000C 8501 dc.w TAB_EQUL-TAB_STAR * "=" $3D
+00B02F88= 000E 8502 dc.w TAB_MORE-TAB_STAR * ">" $3E
+00B02F8A= 0012 8503 dc.w TAB_QEST-TAB_STAR * "?" $3F
+00B02F8C= FFFF 8504 dc.w -1 * "@" $40 no keywords
+00B02F8E= 0014 8505 dc.w TAB_ASCA-TAB_STAR * "A" $41
+00B02F90= 0024 8506 dc.w TAB_ASCB-TAB_STAR * "B" $42
+00B02F92= 003D 8507 dc.w TAB_ASCC-TAB_STAR * "C" $43
+00B02F94= 0054 8508 dc.w TAB_ASCD-TAB_STAR * "D" $44
+00B02F96= 006D 8509 dc.w TAB_ASCE-TAB_STAR * "E" $45
+00B02F98= 007C 8510 dc.w TAB_ASCF-TAB_STAR * "F" $46
+00B02F9A= 0086 8511 dc.w TAB_ASCG-TAB_STAR * "G" $47
+00B02F9C= 0093 8512 dc.w TAB_ASCH-TAB_STAR * "H" $48
+00B02F9E= 0099 8513 dc.w TAB_ASCI-TAB_STAR * "I" $49
+00B02FA0= FFFF 8514 dc.w -1 * "J" $4A no keywords
+00B02FA2= FFFF 8515 dc.w -1 * "K" $4B no keywords
+00B02FA4= 00A8 8516 dc.w TAB_ASCL-TAB_STAR * "L" $4C
+00B02FA6= 00D6 8517 dc.w TAB_ASCM-TAB_STAR * "M" $4D
+00B02FA8= 00E4 8518 dc.w TAB_ASCN-TAB_STAR * "N" $4E
+00B02FAA= 00F3 8519 dc.w TAB_ASCO-TAB_STAR * "O" $4F
+00B02FAC= 00F8 8520 dc.w TAB_ASCP-TAB_STAR * "P" $50
+00B02FAE= FFFF 8521 dc.w -1 * "Q" $51 no keywords
+00B02FB0= 010D 8522 dc.w TAB_ASCR-TAB_STAR * "R" $52
+00B02FB2= 0137 8523 dc.w TAB_ASCS-TAB_STAR * "S" $53
+00B02FB4= 0162 8524 dc.w TAB_ASCT-TAB_STAR * "T" $54
+00B02FB6= 0176 8525 dc.w TAB_ASCU-TAB_STAR * "U" $55
+00B02FB8= 018E 8526 dc.w TAB_ASCV-TAB_STAR * "V" $56
+00B02FBA= 019A 8527 dc.w TAB_ASCW-TAB_STAR * "W" $57
+00B02FBC= FFFF 8528 dc.w -1 * "X" $58 no keywords
+00B02FBE= FFFF 8529 dc.w -1 * "Y" $59 no keywords
+00B02FC0= FFFF 8530 dc.w -1 * "Z" $5A no keywords
+00B02FC2= FFFF 8531 dc.w -1 * "[" $5B no keywords
+00B02FC4= FFFF 8532 dc.w -1 * "\" $5C no keywords
+00B02FC6= FFFF 8533 dc.w -1 * "]" $5D no keywords
+00B02FC8= 01A9 8534 dc.w TAB_POWR-TAB_STAR * "^" $5E
+00B02FCA 8535
+00B02FCA 8536
+00B02FCA 8537 *************************************************************************************
+00B02FCA 8538 *
+00B02FCA 8539 * Table of Basic keywords for LIST command
+00B02FCA 8540 * [byte]first character,[byte]remaining length -1
+00B02FCA 8541 * [word]offset from table start
+00B02FCA 8542
+00B02FCA 8543 LAB_KEYT
+00B02FCA= 45 01 8544 dc.b 'E',1
+00B02FCC= 0071 8545 dc.w KEY_END-TAB_STAR * END
+00B02FCE= 46 01 8546 dc.b 'F',1
+00B02FD0= 007C 8547 dc.w KEY_FOR-TAB_STAR * FOR
+00B02FD2= 4E 02 8548 dc.b 'N',2
+00B02FD4= 00E7 8549 dc.w KEY_NEXT-TAB_STAR * NEXT
+00B02FD6= 44 02 8550 dc.b 'D',2
+00B02FD8= 0054 8551 dc.w KEY_DATA-TAB_STAR * DATA
+00B02FDA= 49 03 8552 dc.b 'I',3
+00B02FDC= 009E 8553 dc.w KEY_INPUT-TAB_STAR * INPUT
+00B02FDE= 44 01 8554 dc.b 'D',1
+00B02FE0= 0063 8555 dc.w KEY_DIM-TAB_STAR * DIM
+00B02FE2= 52 02 8556 dc.b 'R',2
+00B02FE4= 0114 8557 dc.w KEY_READ-TAB_STAR * READ
+00B02FE6= 4C 01 8558 dc.b 'L',1
+00B02FE8= 00BE 8559 dc.w KEY_LET-TAB_STAR * LET
+00B02FEA= 44 01 8560 dc.b 'D',1
+00B02FEC= 0058 8561 dc.w KEY_DEC-TAB_STAR * DEC
+00B02FEE= 47 02 8562 dc.b 'G',2
+00B02FF0= 0089 8563 dc.w KEY_GOTO-TAB_STAR * GOTO
+00B02FF2= 52 01 8564 dc.b 'R',1
+00B02FF4= 0133 8565 dc.w KEY_RUN-TAB_STAR * RUN
+00B02FF6= 49 00 8566 dc.b 'I',0
+00B02FF8= 0099 8567 dc.w KEY_IF-TAB_STAR * IF
+00B02FFA= 52 05 8568 dc.b 'R',5
+00B02FFC= 011B 8569 dc.w KEY_RESTORE-TAB_STAR * RESTORE
+00B02FFE= 47 03 8570 dc.b 'G',3
+00B03000= 008D 8571 dc.w KEY_GOSUB-TAB_STAR * GOSUB
+00B03002= 52 04 8572 dc.b 'R',4
+00B03004= 0122 8573 dc.w KEY_RETURN-TAB_STAR * RETURN
+00B03006= 52 01 8574 dc.b 'R',1
+00B03008= 0118 8575 dc.w KEY_REM-TAB_STAR * REM
+00B0300A= 53 02 8576 dc.b 'S',2
+00B0300C= 0154 8577 dc.w KEY_STOP-TAB_STAR * STOP
+00B0300E= 4F 00 8578 dc.b 'O',0
+00B03010= 00F3 8579 dc.w KEY_ON-TAB_STAR * ON
+00B03012= 4E 02 8580 dc.b 'N',2
+00B03014= 00EE 8581 dc.w KEY_NULL-TAB_STAR * NULL
+00B03016= 49 01 8582 dc.b 'I',1
+00B03018= 009B 8583 dc.w KEY_INC-TAB_STAR * INC
+00B0301A= 57 02 8584 dc.b 'W',2
+00B0301C= 019A 8585 dc.w KEY_WAIT-TAB_STAR * WAIT
+00B0301E= 4C 02 8586 dc.b 'L',2
+00B03020= 00C5 8587 dc.w KEY_LOAD-TAB_STAR * LOAD
+00B03022= 53 02 8588 dc.b 'S',2
+00B03024= 013C 8589 dc.w KEY_SAVE-TAB_STAR * SAVE
+00B03026= 44 01 8590 dc.b 'D',1
+00B03028= 0060 8591 dc.w KEY_DEF-TAB_STAR * DEF
+00B0302A= 50 02 8592 dc.b 'P',2
+00B0302C= 00FF 8593 dc.w KEY_POKE-TAB_STAR * POKE
+00B0302E= 44 02 8594 dc.b 'D',2
+00B03030= 0066 8595 dc.w KEY_DOKE-TAB_STAR * DOKE
+00B03032= 4C 02 8596 dc.b 'L',2
+00B03034= 00CD 8597 dc.w KEY_LOKE-TAB_STAR * LOKE
+00B03036= 43 02 8598 dc.b 'C',2
+00B03038= 003D 8599 dc.w KEY_CALL-TAB_STAR * CALL
+00B0303A= 44 00 8600 dc.b 'D',0
+00B0303C= 006A 8601 dc.w KEY_DO-TAB_STAR * DO
+00B0303E= 4C 02 8602 dc.b 'L',2
+00B03040= 00D1 8603 dc.w KEY_LOOP-TAB_STAR * LOOP
+00B03042= 50 03 8604 dc.b 'P',3
+00B03044= 0107 8605 dc.w KEY_PRINT-TAB_STAR * PRINT
+00B03046= 43 02 8606 dc.b 'C',2
+00B03048= 004B 8607 dc.w KEY_CONT-TAB_STAR * CONT
+00B0304A= 4C 02 8608 dc.b 'L',2
+00B0304C= 00C1 8609 dc.w KEY_LIST-TAB_STAR * LIST
+00B0304E= 43 03 8610 dc.b 'C',3
+00B03050= 0046 8611 dc.w KEY_CLEAR-TAB_STAR * CLEAR
+00B03052= 4E 01 8612 dc.b 'N',1
+00B03054= 00E4 8613 dc.w KEY_NEW-TAB_STAR * NEW
+00B03056= 57 03 8614 dc.b 'W',3
+00B03058= 01A3 8615 dc.w KEY_WIDTH-TAB_STAR * WIDTH
+00B0305A= 47 01 8616 dc.b 'G',1
+00B0305C= 0086 8617 dc.w KEY_GET-TAB_STAR * GET
+00B0305E= 53 02 8618 dc.b 'S',2
+00B03060= 015D 8619 dc.w KEY_SWAP-TAB_STAR * SWAP
+00B03062= 42 04 8620 dc.b 'B',4
+00B03064= 002F 8621 dc.w KEY_BITSET-TAB_STAR * BITSET
+00B03066= 42 04 8622 dc.b 'B',4
+00B03068= 0029 8623 dc.w KEY_BITCLR-TAB_STAR * BITCLR
+00B0306A= 54 02 8624 dc.b 'T',2
+00B0306C= 0162 8625 dc.w KEY_TAB-TAB_STAR * TAB(
+00B0306E= 45 02 8626 dc.b 'E',2
+00B03070= 006D 8627 dc.w KEY_ELSE-TAB_STAR * ELSE
+00B03072= 54 00 8628 dc.b 'T',0
+00B03074= 016E 8629 dc.w KEY_TO-TAB_STAR * TO
+00B03076= 46 00 8630 dc.b 'F',0
+00B03078= 007F 8631 dc.w KEY_FN-TAB_STAR * FN
+00B0307A= 53 02 8632 dc.b 'S',2
+00B0307C= 0148 8633 dc.w KEY_SPC-TAB_STAR * SPC(
+00B0307E= 54 02 8634 dc.b 'T',2
+00B03080= 016A 8635 dc.w KEY_THEN-TAB_STAR * THEN
+00B03082= 4E 01 8636 dc.b 'N',1
+00B03084= 00EB 8637 dc.w KEY_NOT-TAB_STAR * NOT
+00B03086= 53 02 8638 dc.b 'S',2
+00B03088= 0150 8639 dc.w KEY_STEP-TAB_STAR * STEP
+00B0308A= 55 03 8640 dc.b 'U',3
+00B0308C= 017D 8641 dc.w KEY_UNTIL-TAB_STAR * UNTIL
+00B0308E= 57 03 8642 dc.b 'W',3
+00B03090= 019E 8643 dc.w KEY_WHILE-TAB_STAR * WHILE
+00B03092 8644
+00B03092= 2B FF 8645 dc.b '+',-1
+00B03094= 0002 8646 dc.w KEY_PLUS-TAB_STAR * +
+00B03096= 2D FF 8647 dc.b '-',-1
+00B03098= 0004 8648 dc.w KEY_MINUS-TAB_STAR * -
+00B0309A= 2A FF 8649 dc.b '*',-1
+00B0309C= 0000 8650 dc.w KEY_MULT-TAB_STAR * *
+00B0309E= 2F FF 8651 dc.b '/',-1
+00B030A0= 0006 8652 dc.w KEY_DIV-TAB_STAR * /
+00B030A2= 5E FF 8653 dc.b '^',-1
+00B030A4= 01A9 8654 dc.w KEY_POWER-TAB_STAR * ^
+00B030A6= 41 01 8655 dc.b 'A',1
+00B030A8= 0018 8656 dc.w KEY_AND-TAB_STAR * AND
+00B030AA= 45 01 8657 dc.b 'E',1
+00B030AC= 0074 8658 dc.w KEY_EOR-TAB_STAR * EOR
+00B030AE= 4F 00 8659 dc.b 'O',0
+00B030B0= 00F5 8660 dc.w KEY_OR-TAB_STAR * OR
+00B030B2= 3E 00 8661 dc.b '>',0
+00B030B4= 000E 8662 dc.w KEY_RSHIFT-TAB_STAR * >>
+00B030B6= 3C 00 8663 dc.b '<',0
+00B030B8= 0008 8664 dc.w KEY_LSHIFT-TAB_STAR * <<
+00B030BA= 3E FF 8665 dc.b '>',-1
+00B030BC= 0010 8666 dc.w KEY_GT-TAB_STAR * >
+00B030BE= 3D FF 8667 dc.b '=',-1
+00B030C0= 000C 8668 dc.w KEY_EQUAL-TAB_STAR * =
+00B030C2= 3C FF 8669 dc.b '<',-1
+00B030C4= 000A 8670 dc.w KEY_LT-TAB_STAR * <
+00B030C6 8671
+00B030C6= 53 02 8672 dc.b 'S',2
+00B030C8= 0140 8673 dc.w KEY_SGN-TAB_STAR * SGN(
+00B030CA= 49 02 8674 dc.b 'I',2
+00B030CC= 00A3 8675 dc.w KEY_INT-TAB_STAR * INT(
+00B030CE= 41 02 8676 dc.b 'A',2
+00B030D0= 0014 8677 dc.w KEY_ABS-TAB_STAR * ABS(
+00B030D2= 55 02 8678 dc.b 'U',2
+00B030D4= 0189 8679 dc.w KEY_USR-TAB_STAR * USR(
+00B030D6= 46 02 8680 dc.b 'F',2
+00B030D8= 0081 8681 dc.w KEY_FRE-TAB_STAR * FRE(
+00B030DA= 50 02 8682 dc.b 'P',2
+00B030DC= 0103 8683 dc.w KEY_POS-TAB_STAR * POS(
+00B030DE= 53 02 8684 dc.b 'S',2
+00B030E0= 014C 8685 dc.w KEY_SQR-TAB_STAR * SQR(
+00B030E2= 52 02 8686 dc.b 'R',2
+00B030E4= 012F 8687 dc.w KEY_RND-TAB_STAR * RND(
+00B030E6= 4C 02 8688 dc.b 'L',2
+00B030E8= 00C9 8689 dc.w KEY_LOG-TAB_STAR * LOG(
+00B030EA= 45 02 8690 dc.b 'E',2
+00B030EC= 0077 8691 dc.w KEY_EXP-TAB_STAR * EXP(
+00B030EE= 43 02 8692 dc.b 'C',2
+00B030F0= 004F 8693 dc.w KEY_COS-TAB_STAR * COS(
+00B030F2= 53 02 8694 dc.b 'S',2
+00B030F4= 0144 8695 dc.w KEY_SIN-TAB_STAR * SIN(
+00B030F6= 54 02 8696 dc.b 'T',2
+00B030F8= 0166 8697 dc.w KEY_TAN-TAB_STAR * TAN(
+00B030FA= 41 02 8698 dc.b 'A',2
+00B030FC= 001F 8699 dc.w KEY_ATN-TAB_STAR * ATN(
+00B030FE= 50 03 8700 dc.b 'P',3
+00B03100= 00F8 8701 dc.w KEY_PEEK-TAB_STAR * PEEK(
+00B03102= 44 03 8702 dc.b 'D',3
+00B03104= 005B 8703 dc.w KEY_DEEK-TAB_STAR * DEEK(
+00B03106= 4C 03 8704 dc.b 'L',3
+00B03108= 00AF 8705 dc.w KEY_LEEK-TAB_STAR * LEEK(
+00B0310A= 4C 02 8706 dc.b 'L',2
+00B0310C= 00BA 8707 dc.w KEY_LEN-TAB_STAR * LEN(
+00B0310E= 53 03 8708 dc.b 'S',3
+00B03110= 0158 8709 dc.w KEY_STRS-TAB_STAR * STR$(
+00B03112= 56 02 8710 dc.b 'V',2
+00B03114= 018E 8711 dc.w KEY_VAL-TAB_STAR * VAL(
+00B03116= 41 02 8712 dc.b 'A',2
+00B03118= 001B 8713 dc.w KEY_ASC-TAB_STAR * ASC(
+00B0311A= 55 05 8714 dc.b 'U',5
+00B0311C= 0176 8715 dc.w KEY_UCASES-TAB_STAR * UCASE$(
+00B0311E= 4C 05 8716 dc.b 'L',5
+00B03120= 00A8 8717 dc.w KEY_LCASES-TAB_STAR * LCASE$(
+00B03122= 43 03 8718 dc.b 'C',3
+00B03124= 0041 8719 dc.w KEY_CHRS-TAB_STAR * CHR$(
+00B03126= 48 03 8720 dc.b 'H',3
+00B03128= 0093 8721 dc.w KEY_HEXS-TAB_STAR * HEX$(
+00B0312A= 42 03 8722 dc.b 'B',3
+00B0312C= 0024 8723 dc.w KEY_BINS-TAB_STAR * BIN$(
+00B0312E= 42 05 8724 dc.b 'B',5
+00B03130= 0035 8725 dc.w KEY_BITTST-TAB_STAR * BITTST(
+00B03132= 4D 02 8726 dc.b 'M',2
+00B03134= 00D6 8727 dc.w KEY_MAX-TAB_STAR * MAX(
+00B03136= 4D 02 8728 dc.b 'M',2
+00B03138= 00DF 8729 dc.w KEY_MIN-TAB_STAR * MIN(
+00B0313A= 52 05 8730 dc.b 'R',5
+00B0313C= 010D 8731 dc.w KEY_RAM-TAB_STAR * RAMBASE
+00B0313E= 50 00 8732 dc.b 'P',0
+00B03140= 00FD 8733 dc.w KEY_PI-TAB_STAR * PI
+00B03142= 54 03 8734 dc.b 'T',3
+00B03144= 0170 8735 dc.w KEY_TWOPI-TAB_STAR * TWOPI
+00B03146= 56 05 8736 dc.b 'V',5
+00B03148= 0192 8737 dc.w KEY_VPTR-TAB_STAR * VARPTR(
+00B0314A= 53 03 8738 dc.b 'S',3
+00B0314C= 0137 8739 dc.w KEY_SADD-TAB_STAR * SADD(
+00B0314E= 4C 04 8740 dc.b 'L',4
+00B03150= 00B4 8741 dc.w KEY_LEFTS-TAB_STAR * LEFT$(
+00B03152= 52 05 8742 dc.b 'R',5
+00B03154= 0128 8743 dc.w KEY_RIGHTS-TAB_STAR * RIGHT$(
+00B03156= 4D 03 8744 dc.b 'M',3
+00B03158= 00DA 8745 dc.w KEY_MIDS-TAB_STAR * MID$(
+00B0315A= 55 05 8746 dc.b 'U',5
+00B0315C= 0182 8747 dc.w KEY_USINGS-TAB_STAR * USING$(
+00B0315E 8748
+00B0315E 8749
+00B0315E 8750 *************************************************************************************
+00B0315E 8751 *
+00B0315E 8752 * BASIC error messages
+00B0315E 8753
+00B0315E 8754 LAB_BAER
+00B0315E= 0030 8755 dc.w LAB_NF-LAB_BAER * $00 NEXT without FOR
+00B03160= 0041 8756 dc.w LAB_SN-LAB_BAER * $02 syntax
+00B03162= 0048 8757 dc.w LAB_RG-LAB_BAER * $04 RETURN without GOSUB
+00B03164= 005D 8758 dc.w LAB_OD-LAB_BAER * $06 out of data
+00B03166= 0069 8759 dc.w LAB_FC-LAB_BAER * $08 function call
+00B03168= 0077 8760 dc.w LAB_OV-LAB_BAER * $0A overflow
+00B0316A= 0080 8761 dc.w LAB_OM-LAB_BAER * $0C out of memory
+00B0316C= 008E 8762 dc.w LAB_US-LAB_BAER * $0E undefined statement
+00B0316E= 00A2 8763 dc.w LAB_BS-LAB_BAER * $10 array bounds
+00B03170= 00AF 8764 dc.w LAB_DD-LAB_BAER * $12 double dimension array
+00B03172= 00C0 8765 dc.w LAB_D0-LAB_BAER * $14 divide by 0
+00B03174= 00CF 8766 dc.w LAB_ID-LAB_BAER * $16 illegal direct
+00B03176= 00DE 8767 dc.w LAB_TM-LAB_BAER * $18 type mismatch
+00B03178= 00EC 8768 dc.w LAB_LS-LAB_BAER * $1A long string
+00B0317A= 00FC 8769 dc.w LAB_ST-LAB_BAER * $1C string too complex
+00B0317C= 010F 8770 dc.w LAB_CN-LAB_BAER * $1E continue error
+00B0317E= 011E 8771 dc.w LAB_UF-LAB_BAER * $20 undefined function
+00B03180= 0131 8772 dc.w LAB_LD-LAB_BAER * $22 LOOP without DO
+00B03182= 0141 8773 dc.w LAB_UV-LAB_BAER * $24 undefined variable
+00B03184= 0154 8774 dc.w LAB_UA-LAB_BAER * $26 undimensioned array
+00B03186= 0168 8775 dc.w LAB_WD-LAB_BAER * $28 wrong dimensions
+00B03188= 0179 8776 dc.w LAB_AD-LAB_BAER * $2A address
+00B0318A= 0181 8777 dc.w LAB_FO-LAB_BAER * $2C format
+00B0318C= 0188 8778 dc.w LAB_NI-LAB_BAER * $2E not implemented
+00B0318E 8779
+00B0318E= 4E 45 58 54 20 77 ... 8780 LAB_NF dc.b 'NEXT without FOR',$00
+00B0319F= 53 79 6E 74 61 78 00 8781 LAB_SN dc.b 'Syntax',$00
+00B031A6= 52 45 54 55 52 4E ... 8782 LAB_RG dc.b 'RETURN without GOSUB',$00
+00B031BB= 4F 75 74 20 6F 66 ... 8783 LAB_OD dc.b 'Out of DATA',$00
+00B031C7= 46 75 6E 63 74 69 ... 8784 LAB_FC dc.b 'Function call',$00
+00B031D5= 4F 76 65 72 66 6C ... 8785 LAB_OV dc.b 'Overflow',$00
+00B031DE= 4F 75 74 20 6F 66 ... 8786 LAB_OM dc.b 'Out of memory',$00
+00B031EC= 55 6E 64 65 66 69 ... 8787 LAB_US dc.b 'Undefined statement',$00
+00B03200= 41 72 72 61 79 20 ... 8788 LAB_BS dc.b 'Array bounds',$00
+00B0320D= 44 6F 75 62 6C 65 ... 8789 LAB_DD dc.b 'Double dimension',$00
+00B0321E= 44 69 76 69 64 65 ... 8790 LAB_D0 dc.b 'Divide by zero',$00
+00B0322D= 49 6C 6C 65 67 61 ... 8791 LAB_ID dc.b 'Illegal direct',$00
+00B0323C= 54 79 70 65 20 6D ... 8792 LAB_TM dc.b 'Type mismatch',$00
+00B0324A= 53 74 72 69 6E 67 ... 8793 LAB_LS dc.b 'String too long',$00
+00B0325A= 53 74 72 69 6E 67 ... 8794 LAB_ST dc.b 'String too complex',$00
+00B0326D= 43 61 6E 27 74 20 ... 8795 LAB_CN dc.b 'Can''t continue',$00
+00B0327C= 55 6E 64 65 66 69 ... 8796 LAB_UF dc.b 'Undefined function',$00
+00B0328F= 4C 4F 4F 50 20 77 ... 8797 LAB_LD dc.b 'LOOP without DO',$00
+00B0329F= 55 6E 64 65 66 69 ... 8798 LAB_UV dc.b 'Undefined variable',$00
+00B032B2= 55 6E 64 69 6D 65 ... 8799 LAB_UA dc.b 'Undimensioned array',$00
+00B032C6= 57 72 6F 6E 67 20 ... 8800 LAB_WD dc.b 'Wrong dimensions',$00
+00B032D7= 41 64 64 72 65 73 ... 8801 LAB_AD dc.b 'Address',$00
+00B032DF= 46 6F 72 6D 61 74 00 8802 LAB_FO dc.b 'Format',$00
+00B032E6= 4E 6F 74 20 69 6D ... 8803 LAB_NI dc.b 'Not implemented',$00
+00B032F6 8804
+00B032F6 8805
+00B032F6 8806 *************************************************************************************
+00B032F6 8807 *
+00B032F6 8808 * keyword table for line (un)crunching
+00B032F6 8809
+00B032F6 8810 * [keyword,token
+00B032F6 8811 * [keyword,token]]
+00B032F6 8812 * end marker (#$00)
+00B032F6 8813
+00B032F6 8814 TAB_STAR
+00B032F6 8815 KEY_MULT
+00B032F6= B4 00 8816 dc.b TK_MULT,$00 * *
+00B032F8 8817 TAB_PLUS
+00B032F8 8818 KEY_PLUS
+00B032F8= B2 00 8819 dc.b TK_PLUS,$00 * +
+00B032FA 8820 TAB_MNUS
+00B032FA 8821 KEY_MINUS
+00B032FA= B3 00 8822 dc.b TK_MINUS,$00 * -
+00B032FC 8823 TAB_SLAS
+00B032FC 8824 KEY_DIV
+00B032FC= B5 00 8825 dc.b TK_DIV,$00 * /
+00B032FE 8826 TAB_LESS
+00B032FE 8827 KEY_LSHIFT
+00B032FE= 3C BB 8828 dc.b '<',TK_LSHIFT * <<
+00B03300 8829 KEY_LT
+00B03300= BE 8830 dc.b TK_LT * <
+00B03301= 00 8831 dc.b $00
+00B03302 8832 TAB_EQUL
+00B03302 8833 KEY_EQUAL
+00B03302= BD 00 8834 dc.b TK_EQUAL,$00 * =
+00B03304 8835 TAB_MORE
+00B03304 8836 KEY_RSHIFT
+00B03304= 3E BA 8837 dc.b '>',TK_RSHIFT * >>
+00B03306 8838 KEY_GT
+00B03306= BC 8839 dc.b TK_GT * >
+00B03307= 00 8840 dc.b $00
+00B03308 8841 TAB_QEST
+00B03308= 9E 00 8842 dc.b TK_PRINT,$00 * ?
+00B0330A 8843 TAB_ASCA
+00B0330A 8844 KEY_ABS
+00B0330A= 42 53 28 C1 8845 dc.b 'BS(',TK_ABS * ABS(
+00B0330E 8846 KEY_AND
+00B0330E= 4E 44 B7 8847 dc.b 'ND',TK_AND * AND
+00B03311 8848 KEY_ASC
+00B03311= 53 43 28 D3 8849 dc.b 'SC(',TK_ASC * ASC(
+00B03315 8850 KEY_ATN
+00B03315= 54 4E 28 CC 8851 dc.b 'TN(',TK_ATN * ATN(
+00B03319= 00 8852 dc.b $00
+00B0331A 8853 TAB_ASCB
+00B0331A 8854 KEY_BINS
+00B0331A= 49 4E 24 28 D8 8855 dc.b 'IN$(',TK_BINS * BIN$(
+00B0331F 8856 KEY_BITCLR
+00B0331F= 49 54 43 4C 52 A7 8857 dc.b 'ITCLR',TK_BITCLR * BITCLR
+00B03325 8858 KEY_BITSET
+00B03325= 49 54 53 45 54 A6 8859 dc.b 'ITSET',TK_BITSET * BITSET
+00B0332B 8860 KEY_BITTST
+00B0332B= 49 54 54 53 54 28 D9 8861 dc.b 'ITTST(',TK_BITTST * BITTST(
+00B03332= 00 8862 dc.b $00
+00B03333 8863 TAB_ASCC
+00B03333 8864 KEY_CALL
+00B03333= 41 4C 4C 9B 8865 dc.b 'ALL',TK_CALL * CALL
+00B03337 8866 KEY_CHRS
+00B03337= 48 52 24 28 D6 8867 dc.b 'HR$(',TK_CHRS * CHR$(
+00B0333C 8868 KEY_CLEAR
+00B0333C= 4C 45 41 52 A1 8869 dc.b 'LEAR',TK_CLEAR * CLEAR
+00B03341 8870 KEY_CONT
+00B03341= 4F 4E 54 9F 8871 dc.b 'ONT',TK_CONT * CONT
+00B03345 8872 KEY_COS
+00B03345= 4F 53 28 C9 8873 dc.b 'OS(',TK_COS * COS(
+00B03349= 00 8874 dc.b $00
+00B0334A 8875 TAB_ASCD
+00B0334A 8876 KEY_DATA
+00B0334A= 41 54 41 83 8877 dc.b 'ATA',TK_DATA * DATA
+00B0334E 8878 KEY_DEC
+00B0334E= 45 43 88 8879 dc.b 'EC',TK_DEC * DEC
+00B03351 8880 KEY_DEEK
+00B03351= 45 45 4B 28 CE 8881 dc.b 'EEK(',TK_DEEK * DEEK(
+00B03356 8882 KEY_DEF
+00B03356= 45 46 97 8883 dc.b 'EF',TK_DEF * DEF
+00B03359 8884 KEY_DIM
+00B03359= 49 4D 85 8885 dc.b 'IM',TK_DIM * DIM
+00B0335C 8886 KEY_DOKE
+00B0335C= 4F 4B 45 99 8887 dc.b 'OKE',TK_DOKE * DOKE
+00B03360 8888 KEY_DO
+00B03360= 4F 9C 8889 dc.b 'O',TK_DO * DO
+00B03362= 00 8890 dc.b $00
+00B03363 8891 TAB_ASCE
+00B03363 8892 KEY_ELSE
+00B03363= 4C 53 45 A9 8893 dc.b 'LSE',TK_ELSE * ELSE
+00B03367 8894 KEY_END
+00B03367= 4E 44 80 8895 dc.b 'ND',TK_END * END
+00B0336A 8896 KEY_EOR
+00B0336A= 4F 52 B8 8897 dc.b 'OR',TK_EOR * EOR
+00B0336D 8898 KEY_EXP
+00B0336D= 58 50 28 C8 8899 dc.b 'XP(',TK_EXP * EXP(
+00B03371= 00 8900 dc.b $00
+00B03372 8901 TAB_ASCF
+00B03372 8902 KEY_FOR
+00B03372= 4F 52 81 8903 dc.b 'OR',TK_FOR * FOR
+00B03375 8904 KEY_FN
+00B03375= 4E AB 8905 dc.b 'N',TK_FN * FN
+00B03377 8906 KEY_FRE
+00B03377= 52 45 28 C3 8907 dc.b 'RE(',TK_FRE * FRE(
+00B0337B= 00 8908 dc.b $00
+00B0337C 8909 TAB_ASCG
+00B0337C 8910 KEY_GET
+00B0337C= 45 54 A4 8911 dc.b 'ET',TK_GET * GET
+00B0337F 8912 KEY_GOTO
+00B0337F= 4F 54 4F 89 8913 dc.b 'OTO',TK_GOTO * GOTO
+00B03383 8914 KEY_GOSUB
+00B03383= 4F 53 55 42 8D 8915 dc.b 'OSUB',TK_GOSUB * GOSUB
+00B03388= 00 8916 dc.b $00
+00B03389 8917 TAB_ASCH
+00B03389 8918 KEY_HEXS
+00B03389= 45 58 24 28 D7 00 8919 dc.b 'EX$(',TK_HEXS,$00 * HEX$(
+00B0338F 8920 TAB_ASCI
+00B0338F 8921 KEY_IF
+00B0338F= 46 8B 8922 dc.b 'F',TK_IF * IF
+00B03391 8923 KEY_INC
+00B03391= 4E 43 93 8924 dc.b 'NC',TK_INC * INC
+00B03394 8925 KEY_INPUT
+00B03394= 4E 50 55 54 84 8926 dc.b 'NPUT',TK_INPUT * INPUT
+00B03399 8927 KEY_INT
+00B03399= 4E 54 28 C0 8928 dc.b 'NT(',TK_INT * INT(
+00B0339D= 00 8929 dc.b $00
+00B0339E 8930 TAB_ASCL
+00B0339E 8931 KEY_LCASES
+00B0339E= 43 41 53 45 24 28 D5 8932 dc.b 'CASE$(',TK_LCASES * LCASE$(
+00B033A5 8933 KEY_LEEK
+00B033A5= 45 45 4B 28 CF 8934 dc.b 'EEK(',TK_LEEK * LEEK(
+00B033AA 8935 KEY_LEFTS
+00B033AA= 45 46 54 24 28 E1 8936 dc.b 'EFT$(',TK_LEFTS * LEFT$(
+00B033B0 8937 KEY_LEN
+00B033B0= 45 4E 28 D0 8938 dc.b 'EN(',TK_LEN * LEN(
+00B033B4 8939 KEY_LET
+00B033B4= 45 54 87 8940 dc.b 'ET',TK_LET * LET
+00B033B7 8941 KEY_LIST
+00B033B7= 49 53 54 A0 8942 dc.b 'IST',TK_LIST * LIST
+00B033BB 8943 KEY_LOAD
+00B033BB= 4F 41 44 95 8944 dc.b 'OAD',TK_LOAD * LOAD
+00B033BF 8945 KEY_LOG
+00B033BF= 4F 47 28 C7 8946 dc.b 'OG(',TK_LOG * LOG(
+00B033C3 8947 KEY_LOKE
+00B033C3= 4F 4B 45 9A 8948 dc.b 'OKE',TK_LOKE * LOKE
+00B033C7 8949 KEY_LOOP
+00B033C7= 4F 4F 50 9D 8950 dc.b 'OOP',TK_LOOP * LOOP
+00B033CB= 00 8951 dc.b $00
+00B033CC 8952 TAB_ASCM
+00B033CC 8953 KEY_MAX
+00B033CC= 41 58 28 DA 8954 dc.b 'AX(',TK_MAX * MAX(
+00B033D0 8955 KEY_MIDS
+00B033D0= 49 44 24 28 E3 8956 dc.b 'ID$(',TK_MIDS * MID$(
+00B033D5 8957 KEY_MIN
+00B033D5= 49 4E 28 DB 8958 dc.b 'IN(',TK_MIN * MIN(
+00B033D9= 00 8959 dc.b $00
+00B033DA 8960 TAB_ASCN
+00B033DA 8961 KEY_NEW
+00B033DA= 45 57 A2 8962 dc.b 'EW',TK_NEW * NEW
+00B033DD 8963 KEY_NEXT
+00B033DD= 45 58 54 82 8964 dc.b 'EXT',TK_NEXT * NEXT
+00B033E1 8965 KEY_NOT
+00B033E1= 4F 54 AE 8966 dc.b 'OT',TK_NOT * NOT
+00B033E4 8967 KEY_NULL
+00B033E4= 55 4C 4C 92 8968 dc.b 'ULL',TK_NULL * NULL
+00B033E8= 00 8969 dc.b $00
+00B033E9 8970 TAB_ASCO
+00B033E9 8971 KEY_ON
+00B033E9= 4E 91 8972 dc.b 'N',TK_ON * ON
+00B033EB 8973 KEY_OR
+00B033EB= 52 B9 8974 dc.b 'R',TK_OR * OR
+00B033ED= 00 8975 dc.b $00
+00B033EE 8976 TAB_ASCP
+00B033EE 8977 KEY_PEEK
+00B033EE= 45 45 4B 28 CD 8978 dc.b 'EEK(',TK_PEEK * PEEK(
+00B033F3 8979 KEY_PI
+00B033F3= 49 DD 8980 dc.b 'I',TK_PI * PI
+00B033F5 8981 KEY_POKE
+00B033F5= 4F 4B 45 98 8982 dc.b 'OKE',TK_POKE * POKE
+00B033F9 8983 KEY_POS
+00B033F9= 4F 53 28 C4 8984 dc.b 'OS(',TK_POS * POS(
+00B033FD 8985 KEY_PRINT
+00B033FD= 52 49 4E 54 9E 8986 dc.b 'RINT',TK_PRINT * PRINT
+00B03402= 00 8987 dc.b $00
+00B03403 8988 TAB_ASCR
+00B03403 8989 KEY_RAM
+00B03403= 41 4D 42 41 53 45 DC 8990 dc.b 'AMBASE',TK_RAM * RAMBASE
+00B0340A 8991 KEY_READ
+00B0340A= 45 41 44 86 8992 dc.b 'EAD',TK_READ * READ
+00B0340E 8993 KEY_REM
+00B0340E= 45 4D 8F 8994 dc.b 'EM',TK_REM * REM
+00B03411 8995 KEY_RESTORE
+00B03411= 45 53 54 4F 52 45 8C 8996 dc.b 'ESTORE',TK_RESTORE * RESTORE
+00B03418 8997 KEY_RETURN
+00B03418= 45 54 55 52 4E 8E 8998 dc.b 'ETURN',TK_RETURN * RETURN
+00B0341E 8999 KEY_RIGHTS
+00B0341E= 49 47 48 54 24 28 E2 9000 dc.b 'IGHT$(',TK_RIGHTS * RIGHT$(
+00B03425 9001 KEY_RND
+00B03425= 4E 44 28 C6 9002 dc.b 'ND(',TK_RND * RND(
+00B03429 9003 KEY_RUN
+00B03429= 55 4E 8A 9004 dc.b 'UN',TK_RUN * RUN
+00B0342C= 00 9005 dc.b $00
+00B0342D 9006 TAB_ASCS
+00B0342D 9007 KEY_SADD
+00B0342D= 41 44 44 28 E0 9008 dc.b 'ADD(',TK_SADD * SADD(
+00B03432 9009 KEY_SAVE
+00B03432= 41 56 45 96 9010 dc.b 'AVE',TK_SAVE * SAVE
+00B03436 9011 KEY_SGN
+00B03436= 47 4E 28 BF 9012 dc.b 'GN(',TK_SGN * SGN(
+00B0343A 9013 KEY_SIN
+00B0343A= 49 4E 28 CA 9014 dc.b 'IN(',TK_SIN * SIN(
+00B0343E 9015 KEY_SPC
+00B0343E= 50 43 28 AC 9016 dc.b 'PC(',TK_SPC * SPC(
+00B03442 9017 KEY_SQR
+00B03442= 51 52 28 C5 9018 dc.b 'QR(',TK_SQR * SQR(
+00B03446 9019 KEY_STEP
+00B03446= 54 45 50 AF 9020 dc.b 'TEP',TK_STEP * STEP
+00B0344A 9021 KEY_STOP
+00B0344A= 54 4F 50 90 9022 dc.b 'TOP',TK_STOP * STOP
+00B0344E 9023 KEY_STRS
+00B0344E= 54 52 24 28 D1 9024 dc.b 'TR$(',TK_STRS * STR$(
+00B03453 9025 KEY_SWAP
+00B03453= 57 41 50 A5 9026 dc.b 'WAP',TK_SWAP * SWAP
+00B03457= 00 9027 dc.b $00
+00B03458 9028 TAB_ASCT
+00B03458 9029 KEY_TAB
+00B03458= 41 42 28 A8 9030 dc.b 'AB(',TK_TAB * TAB(
+00B0345C 9031 KEY_TAN
+00B0345C= 41 4E 28 CB 9032 dc.b 'AN(',TK_TAN * TAN
+00B03460 9033 KEY_THEN
+00B03460= 48 45 4E AD 9034 dc.b 'HEN',TK_THEN * THEN
+00B03464 9035 KEY_TO
+00B03464= 4F AA 9036 dc.b 'O',TK_TO * TO
+00B03466 9037 KEY_TWOPI
+00B03466= 57 4F 50 49 DE 9038 dc.b 'WOPI',TK_TWOPI * TWOPI
+00B0346B= 00 9039 dc.b $00
+00B0346C 9040 TAB_ASCU
+00B0346C 9041 KEY_UCASES
+00B0346C= 43 41 53 45 24 28 D4 9042 dc.b 'CASE$(',TK_UCASES * UCASE$(
+00B03473 9043 KEY_UNTIL
+00B03473= 4E 54 49 4C B0 9044 dc.b 'NTIL',TK_UNTIL * UNTIL
+00B03478 9045 KEY_USINGS
+00B03478= 53 49 4E 47 24 28 E4 9046 dc.b 'SING$(',TK_USINGS * USING$(
+00B0347F 9047 KEY_USR
+00B0347F= 53 52 28 C2 9048 dc.b 'SR(',TK_USR * USR(
+00B03483= 00 9049 dc.b $00
+00B03484 9050 TAB_ASCV
+00B03484 9051 KEY_VAL
+00B03484= 41 4C 28 D2 9052 dc.b 'AL(',TK_VAL * VAL(
+00B03488 9053 KEY_VPTR
+00B03488= 41 52 50 54 52 28 DF 9054 dc.b 'ARPTR(',TK_VPTR * VARPTR(
+00B0348F= 00 9055 dc.b $00
+00B03490 9056 TAB_ASCW
+00B03490 9057 KEY_WAIT
+00B03490= 41 49 54 94 9058 dc.b 'AIT',TK_WAIT * WAIT
+00B03494 9059 KEY_WHILE
+00B03494= 48 49 4C 45 B1 9060 dc.b 'HILE',TK_WHILE * WHILE
+00B03499 9061 KEY_WIDTH
+00B03499= 49 44 54 48 A3 9062 dc.b 'IDTH',TK_WIDTH * WIDTH
+00B0349E= 00 9063 dc.b $00
+00B0349F 9064 TAB_POWR
+00B0349F 9065 KEY_POWER
+00B0349F= B6 00 9066 dc.b TK_POWER,$00 * ^
+00B034A1 9067
+00B034A1 9068
+00B034A1 9069 *************************************************************************************
+00B034A1 9070 *
+00B034A1 9071 * just messages
+00B034A1 9072
+00B034A1 9073 LAB_BMSG
+00B034A1= 0D 0A 42 72 65 61 ... 9074 dc.b $0D,$0A,'Break',$00
+00B034A9 9075 LAB_EMSG
+00B034A9= 20 45 72 72 6F 72 00 9076 dc.b ' Error',$00
+00B034B0 9077 LAB_LMSG
+00B034B0= 20 69 6E 20 6C 69 ... 9078 dc.b ' in line ',$00
+00B034BA 9079 LAB_IMSG
+00B034BA= 45 78 74 72 61 20 ... 9080 dc.b 'Extra ignored',$0D,$0A,$00
+00B034CA 9081 LAB_REDO
+00B034CA= 52 65 64 6F 20 66 ... 9082 dc.b 'Redo from start',$0D,$0A,$00
+00B034DC 9083 LAB_RMSG
+00B034DC= 0D 0A 52 65 61 64 ... 9084 dc.b $0D,$0A,'Ready',$0D,$0A,$00
+00B034E6 9085 LAB_SMSG
+00B034E6= 20 42 79 74 65 73 ... 9086 dc.b ' Bytes free',$0D,$0A,$0A
+00B034F4= 45 6E 68 61 6E 63 ... 9087 dc.b 'Enhanced 68k BASIC Version 3.52',$0D,$0A,$00
+00B03516 9088
+00B03516 9089
+00B03516 9090 *************************************************************************************
+00B03516 9091 * EhBASIC keywords quick reference list *
+00B03516 9092 *************************************************************************************
+00B03516 9093
+00B03516 9094 * glossary
+00B03516 9095
+00B03516 9096 * <.> required
+00B03516 9097 * {.|.} one of required
+00B03516 9098 * [.] optional
+00B03516 9099 * ... may repeat as last
+00B03516 9100
+00B03516 9101 * any = anything
+00B03516 9102 * num = number
+00B03516 9103 * state = statement
+00B03516 9104 * n = positive integer
+00B03516 9105 * str = string
+00B03516 9106 * var = variable
+00B03516 9107 * nvar = numeric variable
+00B03516 9108 * svar = string variable
+00B03516 9109 * expr = expression
+00B03516 9110 * nexpr = numeric expression
+00B03516 9111 * sexpr = string expression
+00B03516 9112
+00B03516 9113 * statement separator
+00B03516 9114
+00B03516 9115 * : . [] : [] * done
+00B03516 9116
+00B03516 9117 * number bases
+00B03516 9118
+00B03516 9119 * % . % * done
+00B03516 9120 * $ . $ * done
+00B03516 9121
+00B03516 9122 * commands
+00B03516 9123
+00B03516 9124 * END . END * done
+00B03516 9125 * FOR . FOR = TO [STEP ] * done
+00B03516 9126 * NEXT . NEXT [[,]...] * done
+00B03516 9127 * DATA . DATA [{num|["]str["]}[,{num|["]str["]}]...] * done
+00B03516 9128 * INPUT . INPUT [<">str<">;] [,[,]...] * done
+00B03516 9129 * DIM . DIM ([,[,]]) * done
+00B03516 9130 * READ . READ [,[,]...] * done
+00B03516 9131 * LET . [LET] = * done
+00B03516 9132 * DEC . DEC [,[,]...] * done
+00B03516 9133 * GOTO . GOTO * done
+00B03516 9134 * RUN . RUN [] * done
+00B03516 9135 * IF . IF {GOTO|THEN<{n|comm}>}[ELSE <{n|comm}>] * done
+00B03516 9136 * RESTORE . RESTORE [] * done
+00B03516 9137 * GOSUB . GOSUB * done
+00B03516 9138 * RETURN . RETURN * done
+00B03516 9139 * REM . REM [] * done
+00B03516 9140 * STOP . STOP * done
+00B03516 9141 * ON . ON {GOTO|GOSUB}[,[,]...] * done
+00B03516 9142 * NULL . NULL * done
+00B03516 9143 * INC . INC [,[,]...] * done
+00B03516 9144 * WAIT . WAIT ,[,] * done
+00B03516 9145 * LOAD . LOAD [] * done for sim
+00B03516 9146 * SAVE . SAVE [][,[][-]] * done for sim
+00B03516 9147 * DEF . DEF FN()= * done
+00B03516 9148 * POKE . POKE , * done
+00B03516 9149 * DOKE . DOKE , * done
+00B03516 9150 * LOKE . LOKE , * done
+00B03516 9151 * CALL . CALL * done
+00B03516 9152 * DO . DO * done
+00B03516 9153 * LOOP . LOOP [{WHILE|UNTIL}] * done
+00B03516 9154 * PRINT . PRINT [{;|,}][][{;|,}[]...] * done
+00B03516 9155 * CONT . CONT * done
+00B03516 9156 * LIST . LIST [][-] * done
+00B03516 9157 * CLEAR . CLEAR * done
+00B03516 9158 * NEW . NEW * done
+00B03516 9159 * WIDTH . WIDTH [][,] * done
+00B03516 9160 * GET . GET * done
+00B03516 9161 * SWAP . SWAP , * done
+00B03516 9162 * BITSET . BITSET , * done
+00B03516 9163 * BITCLR . BITCLR , * done
+00B03516 9164
+00B03516 9165 * sub commands (may not start a statement)
+00B03516 9166
+00B03516 9167 * TAB . TAB() * done
+00B03516 9168 * ELSE . IF