| FILE forth.asm
1 | ;**********************************************************************
2 | ; ANS Forth 2012 for the 6809 CPU
3 | ; Copyright (C) 2025 by Sean Conner.
4 | ;
5 | ; This program is free software: you can redistribute it and/or modify
6 | ; it under the terms of the GNU General Public License as published by
7 | ; the Free Software Foundation, either version 3 of the License, or
8 | ; (at your option) any later version.
9 | ;
10 | ; This program is distributed in the hope that it will be useful,
11 | ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | ; GNU General Public License for more details.
14 | ;
15 | ; You should have received a copy of the GNU General Public License
16 | ; along with this program. If not, see .
17 | ;
18 | ; Comments, questions and criticisms can be sent to: sean@conman.org
19 | ;
20 | ;**********************************************************************
21 | ;
22 | ; Forth word:
23 | ; .next pointer to next word in dictionary
24 | ; .length 16b lenth of word
25 | ; bit 15 - immediate word
26 | ; bit 14 - hidden word
27 | ; bit 13 - no interpretation semantics
28 | ; bit 12 - double variable (required for TO)
29 | ; bit 11 - local variable (required for TO)
30 | ; .text array of characters, length in size
31 | ; .xt code pointer to execute when running word
32 | ; .body code/xt array of word
33 | ;
34 | ; colon-sys xt of word being compiled
35 | ; do-sys u-dest c-orig (on stack)
36 | ; case-sys
37 | ; of-sys
38 | ; orig
39 | ; dest
40 | ; loop-sys max-value index-value
41 | ; nest-sys return IP within .body
42 | ; nt points to the .next field of a word (15.3.1)
43 | ; wid pointer to last word in dictionary (16.3.1)
44 | ;
45 | ; CPU register usage:
46 | ; D free for use
47 | ; X xt of word being executed/free for use
48 | ; Y Forth IP
49 | ; S return stack
50 | ; U data stack
51 | ;
52 | ; Wordlists implemented:
53 | ; CORE CORE-EXT
54 | ; DOUBLE DOUBLE-EXT
55 | ; EXCEPTION EXCEPTION-EXT
56 | ; LOCAL LOCAL-EXT
57 | ; TOOLS TOOLS-EXT (except ;CODE ASSEMBLER CODE EDITOR FORGET SYNONYM)
58 | ; SEARCH SEARCH-EXT
59 | ; STRING STRING-EXT
60 | ;
61 | ; Wordlists not implemented:
62 | ; BLOCK BLOCK-EXT ; system/OS dependent
63 | ; FACILITY FACILITY-EXT ; system/OS dependent
64 | ; FILE FILE-EXT ; system/OS dependent
65 | ; FLOATING FLOATING-EXT ; CPU/software dependent
66 | ; MEMORY ; not worth it with 64K
67 | ; XCHAR XCHAR-EXT ; not worth it with 64k
68 | ;
69 | ; Minimum size of terminal-input buffer is 80 (3.3.3.5)
70 | ; Maximum size of definition name is 31 (3.3.1.2)
71 | ; Double cells are big endian (3.1.4.1)
72 | ; Numeric conversion (3.4.1.3)
73 | ; #[-]1*
74 | ; $[-]1*
75 | ; %[-]1*
76 | ; ''
77 | ;
78 | ; Continous Regions
79 | ; HERE - ALLOT , C, COMPILE, ALIGN CREATE
80 | ; SOURCE - minimum for terminal input 80 characters
81 | ; Transient regions - may change after : :NONAME ALLOT , C, ALIGN
82 | ; PAD at least 84 ( HERE )
83 | ; WORD at least 33 (can overlap with #>) ( HERE + /PAD )
84 | ; #> 2*n + 2 (n = #bits in cell) ( HERE + /PAD + WORD_MAX )
85 | ; locals 16 * (2 + 2 + 31 + 2 + 2) ( here_top - size )
86 | ;
87 | ; Also: https://forth-standard.org/proposals/clarify-find
88 | ; What is Non-Default Compilation Semantics (NDCS)?
89 | ;
90 | ; THROW values defined by this system:
91 | ; -256 Bad values given to ACCEPT
92 | ;
93 | ; Misc notes:
94 | ; Code can be placed in ROM
95 | ;
96 | ; Do nothing words
97 | ; CHARS
98 | ; ALIGNED
99 | ; ALIGN
100 | ;
101 | ; Synonyms
102 | ; ALIGN CHARS
103 | ; ALIGNED CHARS
104 | ; CHAR+ 1+
105 | ; CS-PICK PICK
106 | ; CS-ROLL ROLL
107 | ; D>S DROP
108 | ;
109 | ;**********************************************************************
110 |
111 | INPUT_SIZE equ 80 ; per 3.3.3.5
112 | SLASH_HOLD equ (16 * 2) + 2 ; per 3.3.3.6
113 | SLASH_PAD equ 84 ; per 3.3.3.6
114 | NUMBER_LOCALS equ 16 ; per 13.4.2.1
115 | NUMBER_LISTS equ 8 ; per 16.6.1.2197
116 | DEFINITION_MAX equ 31 ; per 3.3.1.2
117 | WORD_MAX equ 33 ; per 3.3.3.6
118 | NL equ 10 ; system dependent NL character
119 |
120 | _IMMED equ $80 ; words executed during compilation
121 | _HIDDEN equ $40 ; hide ':' defs until ';'
122 | _NOINTERP equ $20 ; word sans interpretation semantics
123 | _DOUBLE equ $10 ; TO double
124 | _LOCAL equ $08 ; TO local_var
125 |
126 | ;------------------------------------------------------------------
127 | ; The following should be initialized by the system to appropriate
128 | ; values. Once set, these should never change---they are read only
129 | ; values.
130 | ;------------------------------------------------------------------
131 |
0000: 0000 132 | forth__vector_bye fdb 0 ; return to operating system
0002: 0000 133 | forth__vector_getchar fdb 0 ; read a character - Exit: D - character, all others saved
0004: 0000 134 | forth__vector_putchar fdb 0 ; write a character - Entry: D - character, all others saved
0006: 0000 135 | forth__ds_bottom fdb 0 ; data stack bottom
0008: 0000 136 | forth__ds_top fdb 0 ; data stack top
000A: 0000 137 | forth__rs_bottom fdb 0 ; return stack bottom
000C: 0000 138 | forth__rs_top fdb 0 ; return stack top
000E: 0000 139 | forth__here_top fdb 0 ; here area top
140 |
141 | ;------------------------------------------
142 | ; Variables used by the Forth system
143 | ;------------------------------------------
144 |
0010: 2D1D 145 | forth__here fdb forth__free
0012: 2CD5 146 | forth__forth_wid fdb forth_string_ext_unescape
0014: 0000 147 | forth__string_wid fdb 0 ; REPLACES SUBSTITUTE
0016: 0012 148 | forth__current_wid fdb forth__forth_wid
0018: 0000 149 | forth__state fdb 0
001A: 0000 150 | forth__in fdb 0
001C: 000A 151 | forth__base fdb 10
001E: 0000 152 | forth__source_id fdb 0
0020: 0000 153 | forth__source fdb 0 ; SOURCE buffer
0022: 0000 154 | forth__source_len fdb 0 ; SOURCE length
0024: 0000 155 | forth__create_link fdb 0 ; CREATE SEE
0026: 0000 156 | forth__create_name fdb 0 ; CREATE SEE
0028: 0000 157 | forth__create_xt fdb 0 ; CREATE SEE
002A: 0000 158 | forth__hold fdb 0 ; <# HOLD #> #> transient region
002C: 0000 159 | forth__local_link fdb 0 ; (LOCAL) copy of forth__create_link
002E: 0000 160 | forth__local_name fdb 0 ; (LOCAL) copy of forth__create_name
0030: 0000 161 | forth__local_xt fdb 0 ; (LOCAL) copy of forth__create_xt
0032: 0000 162 | forth__local_fp fdb 0 ; (LOCAL) ptr to local data
0034: 0000 163 | forth__local_fps fdb 0 ; (LOCAL) # of bytes of local data
0036: 0000 164 | forth__local_current fdb 0 ; (LOCAL) saved compile wordset
0038: 0000 165 | forth__local_wid fdb 0 ; (LOCAL) local wordset (private)
003A: 00 166 | forth__local_e_cnt fcb 0 ; (LOCAL) # bytes on entry
003B: 00 167 | forth__local_l_cnt fcb 0 ; (LOCAL) # bytes on leaving
003C: 0000 168 | forth__local_here fdb 0 ; (LOCAL) saved HERE location
003E: 0000 169 | forth__nr_storage fdb 0 ; N>R NR>
0040: 0000 170 | forth__handler fdb 0 ; THROW CATCH
0042: 0000 171 | forth__abortq fdb 0 ; THROW CATCH ABORT"
0044: 0000 172 | forth__abortql fdb 0 ; THROW CATCH ABORT"
0046: 0001 173 | forth__widnum fdb 1 ; SEARCH wordset
0048: 0012 174 | forth__widlist fdb forth__forth_wid
004A: 175 | rmb (NUMBER_LISTS - 1) * 2
0058: 0000 176 | forth__leave_sp fdb 0
005A: 000000000000... 177 | forth__leave_stack fdb 0,0,0,0,0,0,0,0
178 |
179 | ;**********************************************************************
180 | ; forth__math_neg32 negate a 32 bit value
181 | ;Entry: 0,X - 32 bit value
182 | ;Exit: 0,X - negated 32 bit value
183 | ;**********************************************************************
184 |
006A: 185 | forth__math_neg32
006A: 63 03 186 | com 3,x
006C: 63 02 187 | com 2,x
006E: 63 01 188 | com 1,x
0070: 63 84 189 | com 0,x
0072: EC 02 190 | ldd 2,x
0074: C3 0001 191 | addd #1
0077: ED 02 192 | std 2,x
0079: EC 84 193 | ldd 0,x
007B: C9 00 194 | adcb #0
007D: 89 00 195 | adca #0
007F: ED 84 196 | std 0,x
0081: 39 197 | rts
198 |
199 | ;**********************************************************************
200 | ; forth__math_mul16 unsigned 16 bit multiple, 32 bit result
201 | ;Entry: 2,X - n1
202 | ; 0,X - n2
203 | ;Exit: 2,X - LSW
204 | ; 0,X - MSW
205 | ;**********************************************************************
206 |
207 | Pd set 3
208 | Pc set 2
209 | Pb set 1
210 | Pa set 0
211 |
0082: 212 | forth__math_mul16
0082: 32 78 213 | leas -8,s
0084: A6 01 214 | lda Pb,x
0086: E6 03 215 | ldb Pd,x
0088: 3D 216 | mul
0089: ED 66 217 | std 6,s
008B: A6 84 218 | lda Pa,x
008D: E6 03 219 | ldb Pd,x
008F: 3D 220 | mul
0090: ED 64 221 | std 4,s
0092: A6 01 222 | lda Pb,x
0094: E6 02 223 | ldb Pc,x
0096: 3D 224 | mul
0097: ED 62 225 | std 2,s
0099: A6 84 226 | lda Pa,x
009B: E6 02 227 | ldb Pc,x
009D: 3D 228 | mul
009E: ED E4 229 | std ,s
00A0: 6F 01 230 | clr 1,x
00A2: 6F 84 231 | clr ,x
00A4: EC 66 232 | ldd 6,s
00A6: ED 02 233 | std 2,x
00A8: EC 64 234 | ldd 4,s
00AA: E3 01 235 | addd 1,x
00AC: ED 01 236 | std 1,x
00AE: EC 62 237 | ldd 2,s
00B0: E3 01 238 | addd 1,x
00B2: ED 01 239 | std 1,x
00B4: 24 02 240 | bcc .next
00B6: 6C 84 241 | inc ,x
00B8: EC E4 242 | .next ldd ,s
00BA: E3 84 243 | addd ,x
00BC: ED 84 244 | std ,x
00BE: 32 68 245 | leas 8,s
00C0: 39 246 | rts
247 |
248 | ;----------------------------
249 |
250 | .opt test stack $E000
251 | .opt test stacksize 1024
252 | .opt test org $E000
253 |
254 | .test "16 * 16"
E000: 8E E006 255 | ldx #.stack1
E003: 9D 82 256 | jsr forth__math_mul16
257 | .assert /x = .stack1 , "X"
258 | .assert @@/0,x = $121C , "MSW"
259 | .assert @@/2,x = $3C5D , "LSW"
E005: 39 260 | rts
261 |
E006: 2F41 262 | .stack1 fdb 12097
E008: 621D 263 | fdb 25117
264 | .endtst
265 |
266 | ;---------------------------
267 |
268 | .test "16 * 16 max"
E00A: 8E E016 269 | ldx #.stack2
E00D: 4F 270 | clra
E00E: 5F 271 | clrb
E00F: 9D 82 272 | jsr forth__math_mul16
E011: EC 84 273 | ldd ,x
E013: EC 02 274 | ldd 2,x
275 | .assert /x = .stack2 , "X"
276 | .assert @@/0,x = $FFFE , "MSW"
277 | .assert @@/2,x = $0001 , "LSW"
E015: 39 278 | rts
279 |
E016: FFFF 280 | .stack2 fdb $FFFF
E018: FFFF 281 | fdb $FFFF
282 | .endtst
283 |
284 | ;**********************************************************************
285 | ; forth__math_div32 unsigned 32 bit / unsiged 16 bit
286 | ;Entry: 2,X - 32 bit numerator
287 | ; 0,X - 16 bit demoninator
288 | ;Exit: 4,x - remainder
289 | ; 2,x - quotient
290 | ; 0,x - trashed
291 | ;**********************************************************************
292 |
00C1: 293 | forth__math_div32
00C1: 86 20 294 | lda #32
00C3: 34 02 295 | pshs a
00C5: 4F 296 | clra
00C6: 5F 297 | clrb
00C7: 34 06 298 | pshs d
00C9: 68 05 299 | .10 lsl 5,x
00CB: 69 04 300 | rol 4,x
00CD: 69 03 301 | rol 3,x
00CF: 69 02 302 | rol 2,x
00D1: 59 303 | rolb
00D2: 49 304 | rola
00D3: 25 05 305 | bcs .15
00D5: 10A3 84 306 | cmpd ,x
00D8: 25 06 307 | blo .20
00DA: A3 84 308 | .15 subd ,x
00DC: 1A 01 309 | orcc {c}
00DE: 20 02 310 | bra .30
00E0: 1C FE 311 | .20 andcc {c}
00E2: 69 61 312 | .30 rol 1,s
00E4: 69 E4 313 | rol ,s
00E6: 6A 62 314 | dec 2,s
00E8: 26 DF 315 | bne .10
00EA: ED 04 316 | std 4,x ; save remainder
00EC: 35 06 317 | puls d ; quotient
00EE: ED 02 318 | std 2,x
00F0: 32 61 319 | leas 1,s
00F2: 39 320 | rts
321 |
322 | ;-----------------------------------
323 |
324 | .test "DIV32"
E01A: 8E E020 325 | ldx #.parms
E01D: 9D C1 326 | jsr forth__math_div32
327 | .assert /x = .parms , "X"
328 | .assert @@/4,x = 5 , "r"
329 | .assert @@/2,x = 6553 , "q"
E01F: 39 330 | rts
331 |
E020: 000A 332 | .parms fdb 10
E022: 0000 333 | fdb 0
E024: FFFF 334 | fdb 65535
335 | .endtst
336 |
337 | ;---------------------------------
338 |
339 | .test "DIV32 max-int"
E026: 8E E02C 340 | ldx #.parms2
E029: 9D C1 341 | jsr forth__math_div32
342 | .assert /x = .parms2 , "X"
343 | .assert @@/4,x = 0 , "r"
344 | .assert @@/2,x = $7FFF , "q"
E02B: 39 345 | rts
346 |
E02C: 7FFF 347 | .parms2 fdb $7FFF
E02E: 3FFF 348 | fdb $3FFF
E030: 0001 349 | fdb $0001
350 | .endtst
351 |
352 | ;---------------------------------
353 |
354 | .test "DIV32 max"
E032: 8E E038 355 | ldx #.parms3
E035: 9D C1 356 | jsr forth__math_div32
357 | .assert /x = .parms3 , "X"
358 | .assert @@/4,x = 0 , "r"
359 | .assert @@/2,x = $FFFF , "q"
E037: 39 360 | rts
361 |
E038: FFFF 362 | .parms3 fdb $FFFF
E03A: FFFE 363 | fdb $FFFE
E03C: 0001 364 | fdb $0001
365 | .endtst
366 |
367 | ;**********************************************************************
368 | ; forth__util_xt_to_name Return the nt from an xt
369 | ;Entry: X - xt
370 | ;Exit: X - nt
371 | ; A - flags
372 | ;
373 | ; Return the name of a word based on the xt. All names in Forth are ASCII
374 | ; graphic characters, and all are less than 31 characters. There are no
375 | ; spaces in any Forth word, so once we get to a byte less than an ASCII
376 | ; SPACE, we've found the length byte. The flag byte is in the previous
377 | ; byte.
378 | ;**********************************************************************
379 |
00F3: 380 | forth__util_xt_to_name
00F3: A6 82 381 | lda ,-x
00F5: 81 20 382 | cmpa #' '
00F7: 23 02 383 | bls .found_name
00F9: 20 F8 384 | bra forth__util_xt_to_name
00FB: A6 82 385 | .found_name lda ,-x ; grab flags, X points to lengt field
00FD: 39 386 | rts
387 |
388 | ;**********************************************************************
389 |
00FE: 390 | forth__util_check_ds
00FE: 1193 06 391 | cmpu forth__ds_bottom
0101: 25 06 392 | blo .throw_low
0103: 1193 08 393 | cmpu forth__ds_top
0106: 22 07 394 | bhi .throw_high
0108: 39 395 | rts
0109: CC FFFD 396 | .throw_low ldd #-3
010C: 16 1DAB 397 | lbra forth_exception_throw.asm
010F: CC FFFC 398 | .throw_high ldd #-4
0112: 16 1DA5 399 | lbra forth_exception_throw.asm
400 |
401 | ;**********************************************************************
402 |
0115: 403 | forth__util_check_rs
0115: 119C 0A 404 | cmps forth__rs_bottom
0118: 25 06 405 | blo .throw_low
011A: 119C 0C 406 | cmps forth__rs_top
011D: 22 07 407 | bhi .throw_high
011F: 39 408 | rts
0120: CC FFFB 409 | .throw_low ldd #-5
0123: 16 1D94 410 | lbra forth_exception_throw.asm
0126: CC FFFA 411 | .throw_high ldd #-6
0129: 16 1D8E 412 | lbra forth_exception_throw.asm
413 |
414 | ;**********************************************************************
415 |
012C: 416 | forth__private_check_stacks_xt
012C: 012E 417 | fdb .body
012E: 8D CE 418 | .body bsr forth__util_check_ds
0130: 8D E3 419 | bsr forth__util_check_rs
0132: 9E 10 420 | ldx forth__here
0134: 9C 0E 421 | cmpx forth__here_top
0136: 24 04 422 | bhs .throw_here
0138: AE A1 423 | ldx ,y++
013A: 6E 94 424 | jmp [,x]
013C: CC FFF8 425 | .throw_here ldd #-8
013F: 16 1D78 426 | lbra forth_exception_throw.asm
427 |
428 | ;**********************************************************************
429 |
0142: 430 | forth__private_create_quote_xt ; ( c-addr u -- )
0142: 0144 431 | fdb .body
0144: EC C4 432 | .body ldd ,u ; check length
0146: 2B 34 433 | bmi .throw_0name ; < 1 throw error
0148: 27 32 434 | beq .throw_0name
014A: 1083 001F 435 | cmpd #DEFINITION_MAX ; > 31 throw error
014E: 2E 32 436 | bgt .throw_bigname
0150: 9E 10 437 | ldx forth__here
0152: 9F 24 438 | stx forth__create_link ; save link field
0154: EC 9F0016 439 | ldd [forth__current_wid] ; get previous word
0158: AF 9F0016 440 | stx [forth__current_wid] ; save new word into current wordlist
015C: ED 81 441 | std ,x++ ; link to previous word
015E: 9F 26 442 | stx forth__create_name ; save pointer to text
0160: 34 20 443 | pshs y
0162: 37 26 444 | pulu y,d ; get c-addr u
0164: ED 81 445 | std ,x++ ; save length
0166: A6 A0 446 | .copy lda ,y+ ; copy text into definition
0168: A7 80 447 | sta ,x+
016A: 5A 448 | decb
016B: 26 F9 449 | bne .copy
016D: 9F 28 450 | stx forth__create_xt ; save pointer to xt
016F: CC 09C3 451 | ldd #forth_core_create.runtime ; intialize xt
0172: ED 81 452 | std ,x++
0174: 9F 10 453 | stx forth__here
0176: 35 20 454 | puls y
0178: AE A1 455 | ldx ,y++
017A: 6E 94 456 | jmp [,x]
457 |
017C: CC FFF0 458 | .throw_0name ldd #-16
017F: 16 1D38 459 | lbra forth_exception_throw.asm
0182: CC FFED 460 | .throw_bigname ldd #-19
0185: 16 1D32 461 | lbra forth_exception_throw.asm
462 |
463 | ;**********************************************************************
464 |
0188: 465 | forth__private_eval_xt ; ( i*x -- j*x )
0188: 0678 466 | fdb forth_core_colon.runtime
467 | ;====================================================
468 | ; : eval
469 | ; BEGIN BL WORD DUP C@ WHILE
470 | ; FIND STATE @ IF
471 | ; eval-compile
472 | ; ELSE
473 | ; eval-interpret
474 | ; THEN check_stacks
475 | ; REPEAT DROP ;
476 | ;====================================================
018A: 08C9 477 | .L1 fdb forth_core_b_l.xt
018C: 1217 478 | fdb forth_core_word.xt
018E: 0A74 479 | fdb forth_core_dupe.xt
0190: 08F9 480 | fdb forth_core_c_fetch.xt
0192: 0CD1 481 | fdb forth_core_if.runtime_xt
0194: 01AE 482 | fdb .L8
0196: 2780 483 | fdb forth_search_find.xt
0198: 2626 484 | fdb forth_tools_ext_state.xt
019A: 07E2 485 | fdb forth_core_fetch.xt
019C: 0CD1 486 | fdb forth_core_if.runtime_xt
019E: 01A6 487 | fdb .L4
01A0: 01B2 488 | fdb forth__private_eval_compile_xt
01A2: 1430 489 | fdb forth_core_ext_again.runtime_xt
01A4: 01A8 490 | fdb .L7
01A6: 01FA 491 | .L4 fdb forth__private_eval_interpret_xt
01A8: 012C 492 | .L7 fdb forth__private_check_stacks_xt
01AA: 1430 493 | fdb forth_core_ext_again.runtime_xt
01AC: 018A 494 | fdb .L1
01AE: 0A65 495 | .L8 fdb forth_core_drop.xt
01B0: 0C1A 496 | fdb forth_core_exit.xt
497 |
498 | ;-----------------------------------------------
499 |
500 | .test "eval 1 2 +"
501 | .opt test prot rw , $6000 , $6100
502 | .opt test prot n , .nu11
503 | .opt test prot n , .nu12
504 | .opt test pokew forth__source , .buffer1
505 | .opt test pokew forth__source_len , .len1
506 | .opt test pokew forth__in , 0
507 | .opt test pokew forth__state , 0
508 | .opt test pokew forth__here , $6000
509 | .opt test pokew forth__ds_bottom , .dsbot1
510 | .opt test pokew forth__ds_top , .datastack1 + 2
E03E: 30 62 511 | leax 2,s
E040: 9F 0C 512 | stx forth__rs_top
E042: 30 89FF00 513 | leax -256,x
E046: 9F 0A 514 | stx forth__rs_bottom
E048: CE E068 515 | ldu #.datastack1
E04B: 8E 0188 516 | ldx #forth__private_eval_xt
E04E: BD 0C04 517 | jsr forth_core_execute.asm
518 | .assert /u = .result1 , "U"
519 | .assert @@/0,u = 3 , "result"
E051: 39 520 | rts
521 |
E052: 0000 522 | .dsbot1 fdb 0
E054: 0000 523 | fdb 0
E056: 0000 524 | fdb 0
E058: 0000 525 | fdb 0
E05A: 0000 526 | fdb 0
E05C: 0000 527 | fdb 0
E05E: 0000 528 | fdb 0
E060: 0000 529 | fdb 0
E062: 0000 530 | fdb 0
E064: 0000 531 | fdb 0
E066: 0000 532 | .result1 fdb 0
E068: 0000 533 | .datastack1 fdb 0
534 |
E06A: 00 535 | .nu11 fcb 0
E06B: 312032202B 536 | .buffer1 fcc '1 2 +'
537 | .len1 equ * - .buffer1
E070: 00 538 | .nu12 fcb 0
539 | .endtst
540 |
541 | ;------------------------------------------------
542 |
543 | .test "eval BYE"
544 | .opt test prot rw , $6000 , $6100
545 | .opt test prot n , .nu21
546 | .opt test prot n , .nu22
547 | .opt test pokew forth__source , .buffer2
548 | .opt test pokew forth__source_len , .len2
549 | .opt test pokew forth__in , 0
550 | .opt test pokew forth__state , 0
551 | .opt test pokew forth__here , $6000
552 | .opt test pokew forth__vector_bye , .bye
E071: 10FF E09E 553 | sts .ret
E075: CE E091 554 | ldu #.datastack2
E078: 8E 0188 555 | ldx #forth__private_eval_xt
E07B: BD 0C04 556 | jsr forth_core_execute.asm
557 | .assert 1 = 2 , "wrong return"
E07E: 39 558 | rts
559 |
E07F: 0000 560 | fdb 0
E081: 0000 561 | fdb 0
E083: 0000 562 | fdb 0
E085: 0000 563 | fdb 0
E087: 0000 564 | fdb 0
E089: 0000 565 | fdb 0
E08B: 0000 566 | fdb 0
E08D: 0000 567 | fdb 0
E08F: 0000 568 | fdb 0
E091: 0000 569 | .datastack2 fdb 0
570 |
E093: 00 571 | .nu21 fcb 0
E094: 42594520 572 | .buffer2 fcc 'BYE '
573 | .len2 equ * - .buffer2
E098: 00 574 | .nu22 fcb 0
575 |
E099: 10FE E09E 576 | .bye lds .ret
577 | .assert /u = .datastack2 , "U ( bye )"
E09D: 39 578 | rts
E09E: 0000 579 | .ret fdb 0
580 |
581 | .endtst
582 |
583 | ;------------------------------------------------
584 |
585 | .test "eval ( spaces )"
586 | .opt test prot rw , $6000 , $6100
587 | .opt test prot n , .nu31
588 | .opt test prot n , .nu32
589 | .opt test pokew forth__source , .buffer3
590 | .opt test pokew forth__source_len , .len3
591 | .opt test pokew forth__in , 0
592 | .opt test pokew forth__state , 0
593 | .opt test pokew forth__here , $6000
E0A0: CE E0BC 594 | ldu #.datastack3
E0A3: 8E 0188 595 | ldx #forth__private_eval_xt
E0A6: BD 0C04 596 | jsr forth_core_execute.asm
597 | .assert /u = .datastack3 , "U"
E0A9: 39 598 | rts
599 |
E0AA: 0000 600 | fdb 0
E0AC: 0000 601 | fdb 0
E0AE: 0000 602 | fdb 0
E0B0: 0000 603 | fdb 0
E0B2: 0000 604 | fdb 0
E0B4: 0000 605 | fdb 0
E0B6: 0000 606 | fdb 0
E0B8: 0000 607 | fdb 0
E0BA: 0000 608 | fdb 0
E0BC: 0000 609 | .datastack3 fdb 0
610 |
E0BE: 00 611 | .nu31 fcb 0
E0BF: 20202020 612 | .buffer3 fcc ' '
613 | .len3 equ * - .buffer3
E0C3: 00 614 | .nu32 fcb 0
615 | .endtst
616 |
617 | ;------------------------------------------------
618 |
619 | .test "eval ( empty string )"
620 | .opt test prot rw , $6000 , $6100
621 | .opt test prot n , .nu41
622 | .opt test prot n , .nu42
623 | .opt test pokew forth__source , .buffer4
624 | .opt test pokew forth__source_len , .len4
625 | .opt test pokew forth__in , 0
626 | .opt test pokew forth__state , 0
627 | .opt test pokew forth__here , $6000
E0C4: CE E0E0 628 | ldu #.datastack4
E0C7: 8E 0188 629 | ldx #forth__private_eval_xt
E0CA: BD 0C04 630 | jsr forth_core_execute.asm
631 | .assert /u = .datastack4 , "U"
E0CD: 39 632 | rts
633 |
E0CE: 0000 634 | fdb 0
E0D0: 0000 635 | fdb 0
E0D2: 0000 636 | fdb 0
E0D4: 0000 637 | fdb 0
E0D6: 0000 638 | fdb 0
E0D8: 0000 639 | fdb 0
E0DA: 0000 640 | fdb 0
E0DC: 0000 641 | fdb 0
E0DE: 0000 642 | fdb 0
E0E0: 0000 643 | .datastack4 fdb 0
644 |
E0E2: 00 645 | .nu41 fcb 0
E0E3: FF 646 | .buffer4 fcb -1
647 | .len4 equ 0
E0E4: 00 648 | .nu42 fcb 0
649 | .endtst
650 |
651 | ;**********************************************************************
652 |
01B2: 653 | forth__private_eval_compile_xt
01B2: 0678 654 | fdb forth_core_colon.runtime
655 | ;=================================================
656 | ; : eval_compile
657 | ; ( 1 ) IF
658 | ; ( 2 ) immediate? IF EXECUTE ELSE COMPILE, THEN
659 | ; ( 3 ) ELSE
660 | ; ( 4 ) number? IF CASE
661 | ; ( 5 ) 1 OF POSTPONE LITERAL ENDOF
662 | ; ( 6 ) 2 OF POSTPONE 2LITERAL ENDOF
663 | ; ( 7 ) ENDCASE
664 | ; ( 8 ) ELSE
665 | ; ( 9 ) -13 THROW
666 | ; ( 10 ) THEN
667 | ; ( 11 ) THEN ;
668 | ;==================================================
01B4: 0CD1 669 | fdb forth_core_if.runtime_xt
01B6: 01CA 670 | fdb .numq
01B8: 0252 671 | fdb forth__private_immediate_q_xt
01BA: 0CD1 672 | fdb forth_core_if.runtime_xt
01BC: 01C4 673 | fdb .comp
01BE: 0BFE 674 | fdb forth_core_execute.xt
01C0: 1430 675 | fdb forth_core_ext_again.runtime_xt
01C2: 01F8 676 | fdb .exit
01C4: 14AC 677 | .comp fdb forth_core_ext_compile_comma.xt
01C6: 1430 678 | fdb forth_core_ext_again.runtime_xt
01C8: 01F8 679 | fdb .exit
01CA: 0282 680 | .numq fdb forth__private_number_q_xt
01CC: 0CD1 681 | fdb forth_core_if.runtime_xt
01CE: 01F2 682 | fdb .throw
01D0: 0D84 683 | fdb forth_core_literal.runtime_xt
01D2: 0001 684 | fdb 1
01D4: 166A 685 | fdb forth_core_ext_of.runtime_xt
01D6: 01DE 686 | fdb .compd
01D8: 0D71 687 | fdb forth_core_literal.xt
01DA: 1430 688 | fdb forth_core_ext_again.runtime_xt
01DC: 01F8 689 | fdb .exit
01DE: 0D84 690 | .compd fdb forth_core_literal.runtime_xt
01E0: 0002 691 | fdb 2
01E2: 166A 692 | fdb forth_core_ext_of.runtime_xt
01E4: 01EC 693 | fdb .default
01E6: 1AC8 694 | fdb forth_double_two_literal.xt
01E8: 1430 695 | fdb forth_core_ext_again.runtime_xt
01EA: 01F8 696 | fdb .exit
01EC: 0A65 697 | .default fdb forth_core_drop.xt
01EE: 1430 698 | fdb forth_core_ext_again.runtime_xt
01F0: 01F8 699 | fdb .exit
01F2: 0D84 700 | .throw fdb forth_core_literal.runtime_xt
01F4: FFF3 701 | fdb -13
01F6: 1E8A 702 | fdb forth_exception_throw.xt
01F8: 0C1A 703 | .exit fdb forth_core_exit.xt
704 |
705 | ;**********************************************************************
706 |
01FA: 707 | forth__private_eval_interpret_xt
01FA: 0678 708 | fdb forth_core_colon.runtime
709 | ;===========================================================
710 | ; : eval-interpret
711 | ; ( 1 ) IF
712 | ; ( 2 ) interpret? IF EXECUTE ELSE -14 THROW THEN
713 | ; ( 3 ) ELSE
714 | ; ( 4 ) number? IF DROP ELSE -13 THROW THEN
715 | ; ( 5 ) THEN ;
716 | ;===========================================================
01FC: 0CD1 717 | fdb forth_core_if.runtime_xt
01FE: 0212 718 | fdb .L3
0200: 026A 719 | fdb forth__private_interpret_q_xt
0202: 0CD1 720 | fdb forth_core_if.runtime_xt
0204: 020C 721 | fdb .L2
0206: 0BFE 722 | fdb forth_core_execute.xt
0208: 1430 723 | fdb forth_core_ext_again.runtime_xt
020A: 0224 724 | fdb .L5
020C: 0D84 725 | .L2 fdb forth_core_literal.runtime_xt
020E: FFF2 726 | fdb -14
0210: 1E8A 727 | fdb forth_exception_throw.xt ; doesn't return
0212: 0282 728 | .L3 fdb forth__private_number_q_xt
0214: 0CD1 729 | fdb forth_core_if.runtime_xt
0216: 021E 730 | fdb .L4
0218: 0A65 731 | fdb forth_core_drop.xt
021A: 1430 732 | fdb forth_core_ext_again.runtime_xt
021C: 0224 733 | fdb .L5
021E: 0D84 734 | .L4 fdb forth_core_literal.runtime_xt
0220: FFF3 735 | fdb -13
0222: 1E8A 736 | fdb forth_exception_throw.xt
0224: 0C1A 737 | .L5 fdb forth_core_exit.xt
738 |
739 | ;---------------------------------------------------
740 |
741 | .test "eval-interpret 42"
742 | .opt test pokew forth__state , 0
E0E5: CE E0F5 743 | ldu #.datastack1
E0E8: 8E 01FA 744 | ldx #forth__private_eval_interpret_xt
E0EB: BD 0C04 745 | jsr forth_core_execute.asm
746 | .assert /u = .result1 , "U"
747 | .assert @@/0,u = 42 , "result"
E0EE: 39 748 | rts
749 |
E0EF: 0000 750 | fdb 0
E0F1: 0000 751 | fdb 0
E0F3: 0000 752 | fdb 0
E0F5: 0000 753 | .datastack1 fdb 0
E0F7: E0F9 754 | .result1 fdb .caddr1
755 |
E0F9: 023432 756 | .caddr1 ascii '42'c
757 | .endtst
758 |
759 | ;--------------------------------------------------
760 |
761 | .test "eval-interpret +"
762 | .opt test pokew forth__state , 0
E0FC: CE E10E 763 | ldu #.datastack2
E0FF: 8E 01FA 764 | ldx #forth__private_eval_interpret_xt
E102: BD 0C04 765 | jsr forth_core_execute.asm
766 | .assert /u = .result2 , "U"
767 | .assert @@/0,u = 150 , "result"
E105: 39 768 | rts
769 |
E106: 0000 770 | fdb 0
E108: 0000 771 | fdb 0
E10A: 0000 772 | fdb 0
E10C: 0000 773 | fdb 0
E10E: FFFF 774 | .datastack2 fdb -1
E110: 046B 775 | fdb forth_core_plus.xt
E112: 0064 776 | fdb 100
E114: 0032 777 | .result2 fdb 50
778 | .endtst
779 |
780 | ;**********************************************************************
781 |
0226: 782 | forth__private_find_nt_cb_xt
0226: 0678 783 | fdb forth_core_colon.runtime
784 | ;=============================================================
785 | ; : find-nt-wid ( c-addr u false nt -- c-addr u [ nt false | false true ] )
786 | ; >R 2 PICK 2 PICK R@ NAME>STRING string-equal IF
787 | ; DROP R> FALSE
788 | ; ELSE
789 | ; R> DROP TRUE
790 | ; THEN ;
791 | ;=============================================================
0228: 07BF 792 | fdb forth_core_to_r.xt
022A: 0D84 793 | fdb forth_core_literal.runtime_xt
022C: 0002 794 | fdb 2
022E: 1720 795 | fdb forth_core_ext_pick.xt
0230: 0D84 796 | fdb forth_core_literal.runtime_xt
0232: 0002 797 | fdb 2
0234: 1720 798 | fdb forth_core_ext_pick.xt
0236: 0FBA 799 | fdb forth_core_r_fetch.xt
0238: 25EF 800 | fdb forth_tools_ext_name_to_string.xt
023A: 036A 801 | fdb forth__private_string_equal_xt
023C: 0CD1 802 | fdb forth_core_if.runtime_xt
023E: 024A 803 | fdb .L1
0240: 0A65 804 | fdb forth_core_drop.xt
0242: 0FAA 805 | fdb forth_core_r_from.xt
0244: 156D 806 | fdb forth_core_ext_false.xt
0246: 1430 807 | fdb forth_core_ext_again.runtime_xt
0248: 0250 808 | fdb .L2
024A: 0FAA 809 | .L1 fdb forth_core_r_from.xt
024C: 0A65 810 | fdb forth_core_drop.xt
024E: 19BD 811 | fdb forth_core_ext_true.xt
0250: 0C1A 812 | .L2 fdb forth_core_exit.xt
813 |
814 | ;-----------------------------------------------
815 |
816 | .test "find_nt_wid found"
E116: CE E12A 817 | ldu #.datastack1
E119: 8E 0226 818 | ldx #forth__private_find_nt_cb_xt
E11C: BD 0C04 819 | jsr forth_core_execute.asm
820 | .assert /u = .datastack1 , "U"
821 | .assert @@/0,u = 0 , "false"
822 | .assert @@/2,u = forth_core_star_slash_mod , "nt"
823 | .assert @@/4,u = .text1_len , "len"
824 | .assert @@/6,u = .text1 , "c-addr"
E11F: 39 825 | rts
826 |
E120: 0000 827 | fdb 0
E122: 0000 828 | fdb 0
E124: 0000 829 | fdb 0
E126: 0000 830 | fdb 0
E128: 0000 831 | fdb 0
E12A: 0451 832 | .datastack1 fdb forth_core_star_slash_mod
E12C: 0000 833 | fdb 0
E12E: 0005 834 | fdb .text1_len
E130: E132 835 | fdb .text1
836 |
E132: 2A2F4D4F44 837 | .text1 fcc '*/MOD'
838 | .text1_len equ * - .text1
839 | .endtst
840 |
841 | ;-----------------------------------------------
842 |
843 | .test "find_nt_wid not-found"
E137: CE E14B 844 | ldu #.datastack2
E13A: 8E 0226 845 | ldx #forth__private_find_nt_cb_xt
E13D: BD 0C04 846 | jsr forth_core_execute.asm
847 | .assert /u = .datastack2 , "U"
848 | .assert @@/0,u = -1 , "true"
849 | .assert @@/2,u = 0 , "false"
850 | .assert @@/4,u = .text2_len , "len"
851 | .assert @@/6,u = .text2 , "c-addr"
E140: 39 852 | rts
853 |
E141: 0000 854 | fdb 0
E143: 0000 855 | fdb 0
E145: 0000 856 | fdb 0
E147: 0000 857 | fdb 0
E149: 0000 858 | fdb 0
E14B: 0451 859 | .datastack2 fdb forth_core_star_slash_mod
E14D: 0000 860 | fdb 0
E14F: 0001 861 | fdb .text2_len
E151: E153 862 | fdb .text2
863 |
E153: 2B 864 | .text2 fcc '+'
865 | .text2_len equ * - .text2
866 | .endtst
867 |
868 | ;**********************************************************************
869 |
0252: 870 | forth__private_immediate_q_xt ; ( xt -- xt flag )
0252: 0254 871 | fdb .body
0254: AE C4 872 | .body ldx ,u
0256: 17 FE9A 873 | lbsr forth__util_xt_to_name
0259: 84 80 874 | anda #_IMMED
025B: 26 08 875 | bne .true
025D: 4F 876 | clra
025E: 5F 877 | clrb
025F: 36 06 878 | .done pshu d
0261: AE A1 879 | ldx ,y++
0263: 6E 94 880 | jmp [,x]
0265: CC FFFF 881 | .true ldd #-1
0268: 20 F5 882 | bra .done
883 |
884 | ;**********************************************************************
885 |
026A: 886 | forth__private_interpret_q_xt ; ( xt -- xt flag )
026A: 026C 887 | fdb .body
026C: AE C4 888 | .body ldx ,u
026E: 17 FE82 889 | lbsr forth__util_xt_to_name
0271: 84 20 890 | anda #_NOINTERP
0273: 26 09 891 | bne .false
0275: CC FFFF 892 | ldd #-1
0278: 36 06 893 | .done pshu d
027A: AE A1 894 | ldx ,y++
027C: 6E 94 895 | jmp [,x]
027E: 4F 896 | .false clra
027F: 5F 897 | clrb
0280: 20 F6 898 | bra .done
899 |
900 | ;--------------------------------------
901 |
902 | .test "interpret? TRUE"
E154: CE E160 903 | ldu #.datastack1
E157: 8E 026A 904 | ldx #forth__private_interpret_q_xt
E15A: BD 0C04 905 | jsr forth_core_execute.asm
906 | .assert /u = .result1 , "U"
907 | .assert @@/0,u = -1 , "flag"
E15D: 39 908 | rts
909 |
E15E: 0000 910 | .result1 fdb 0
E160: 0A74 911 | .datastack1 fdb forth_core_dupe.xt
912 | .endtst
913 |
914 | ;---------------------------------------
915 |
916 | .test "interpret? FALSE"
E162: CE E16E 917 | ldu #.datastack2
E165: 8E 026A 918 | ldx #forth__private_interpret_q_xt
E168: BD 0C04 919 | jsr forth_core_execute.asm
920 | .assert /u = .result2 , "U"
921 | .assert @@/0,u = 0 , "flag"
E16B: 39 922 | rts
923 |
E16C: 0000 924 | .result2 fdb 0
E16E: 102A 925 | .datastack2 fdb forth_core_s_quote.xt
926 | .endtst
927 |
928 | ;**********************************************************************
929 |
0282: 930 | forth__private_number_q_xt ; ( caddr -- n 1 true | d 2 true | false )
0282: 0284 931 | fdb .body
0284: DC 1C 932 | .body ldd forth__base ; save BASE just in case
0286: 34 06 933 | pshs d
0288: 6F E2 934 | clr ,-s ; default to not negative
028A: 37 10 935 | pulu x ; get caddr
028C: 4F 936 | clra
028D: 5F 937 | clrb
028E: 36 06 938 | pshu d ; push 0.
0290: 36 06 939 | pshu d
0292: E6 80 940 | ldb ,x+ ; get length
0294: A6 84 941 | lda ,x ; check first character
0296: 81 27 942 | cmpa #39 ; '?
0298: 26 1A 943 | bne .check_dec
029A: C1 03 944 | cmpb #3 ; should be three
029C: 1026 008D 945 | lbne .error_ret
02A0: A6 02 946 | lda 2,x ; check 3rd character
02A2: 81 27 947 | cmpa #39 ; '?
02A4: 1026 0085 948 | lbne .error_ret ; if not, it's not a "number"
02A8: E6 01 949 | ldb 1,x ; get character
02AA: 4F 950 | clra
02AB: 33 42 951 | leau 2,u ; adjust data stack
02AD: ED C4 952 | std ,u ; save onto stack
02AF: CC 0001 953 | ldd #1 ; 1 cell
02B2: 20 75 954 | bra .return_okay
02B4: 81 23 955 | .check_dec cmpa #'#' ; decimal?
02B6: 26 07 956 | bne .check_hex
02B8: 5A 957 | decb ; adjust length
02B9: 86 0A 958 | lda #10 ; set decimal
02BB: 97 1D 959 | sta forth__base + 1
02BD: 20 23 960 | bra .check_negchar
02BF: 81 24 961 | .check_hex cmpa #'$' ; hex?
02C1: 26 07 962 | bne .check_bin
02C3: 5A 963 | decb
02C4: 86 10 964 | lda #16 ; set hexadecimal
02C6: 97 1D 965 | sta forth__base + 1
02C8: 20 18 966 | bra .check_negchar
02CA: 81 25 967 | .check_bin cmpa #'%' ; binary?
02CC: 26 18 968 | bne .check_neg
02CE: 5A 969 | decb
02CF: 86 02 970 | lda #2 ; set binary
02D1: 97 1D 971 | sta forth__base + 1
02D3: 20 0D 972 | bra .check_negchar
02D5: CC FFFF 973 | .okay_done ldd #-1 ; return true
02D8: 36 06 974 | .push_done pshu d
02DA: 35 12 975 | puls x,a ; remove sign flag and base
02DC: 9F 1C 976 | stx forth__base ; restore base
02DE: AE A1 977 | ldx ,y++
02E0: 6E 94 978 | jmp [,x]
02E2: 30 01 979 | .check_negchar leax 1,x ; adjust character pointer
02E4: A6 84 980 | lda ,x ; get character
02E6: 81 2D 981 | .check_neg cmpa #'-' ; minus?
02E8: 26 05 982 | bne .to_number ; if not, convert to number
02EA: A7 E4 983 | sta ,s ; set sign flag
02EC: 5A 984 | decb ; adjust length
02ED: 30 01 985 | leax 1,x ; and adjust character pointer
02EF: 4F 986 | .to_number clra
02F0: 36 16 987 | pshu x,d ; push c-addr u
02F2: 8E 073C 988 | ldx #forth_core_to_number.xt
02F5: 17 090C 989 | lbsr forth_core_execute.asm
02F8: 37 16 990 | pulu x,d ; remove c-addr u
02FA: 83 0000 991 | subd #0 ; any more text?
02FD: 27 19 992 | beq .single ; if not, treat as a single cell
02FF: 83 0001 993 | subd #1 ; one more character?
0302: 26 29 994 | bne .error_ret ; if more, error
0304: A6 80 995 | lda ,x+ ; check to see if period
0306: 81 2E 996 | cmpa #'.'
0308: 26 23 997 | bne .error_ret ; error if not
030A: 6D E4 998 | tst ,s ; negative?
030C: 27 05 999 | beq .dpos
030E: 30 C4 1000 | leax ,u ; negate double cell number
0310: 17 FD57 1001 | lbsr forth__math_neg32
0313: CC 0002 1002 | .dpos ldd #2 ; return two cells
0316: 20 11 1003 | bra .return_okay
0318: 6D E4 1004 | .single tst ,s ; negate?
031A: 27 08 1005 | beq .spos
031C: EC 42 1006 | ldd 2,u ; negate it
031E: 40 1007 | nega
031F: 50 1008 | negb
0320: 82 00 1009 | sbca #0
0322: ED 42 1010 | std 2,u
0324: CC 0001 1011 | .spos ldd #1 ; return one cell
0327: 33 42 1012 | leau 2,u ; adjust data stack
0329: 36 06 1013 | .return_okay pshu d ; save length
032B: 20 A8 1014 | bra .okay_done
032D: 33 44 1015 | .error_ret leau 4,u ; clean stack
032F: 4F 1016 | clra ; return false
0330: 5F 1017 | clrb
0331: 20 A5 1018 | bra .push_done
1019 |
1020 | ;------------------------------------------
1021 |
1022 | .test "number? g00"
1023 | .opt test pokew forth__base , 10
1024 | .opt test prot n , .nu1
E170: CC 000A 1025 | ldd #10
E173: DD 1C 1026 | std forth__base
E175: CE E187 1027 | ldu #.datastack1
E178: 8E 0282 1028 | ldx #forth__private_number_q_xt
E17B: BD 0C04 1029 | jsr forth_core_execute.asm
1030 | .assert /u = .datastack1 , "U"
1031 | .assert @@/0,u = 0 , "false"
1032 | .assert @@forth__base = 10 , "base"
E17E: 39 1033 | rts
1034 |
E17F: 0000 1035 | fdb 0
E181: 0000 1036 | fdb 0
E183: 0000 1037 | fdb 0
E185: 0000 1038 | fdb 0
E187: E18A 1039 | .datastack1 fdb .number1
E189: 00 1040 | .nu1 fcb 0
E18A: 03673030 1041 | .number1 ascii 'g00'c
1042 | .endtst
1043 |
1044 | ;------------------------------------------
1045 |
1046 | .test "number? 00g"
1047 | .opt pokew forth__base , 10
1048 | .opt test prot n , .nu2
E18E: CC 000A 1049 | ldd #10
E191: DD 1C 1050 | std forth__base
E193: CE E1A5 1051 | ldu #.datastack2
E196: 8E 0282 1052 | ldx #forth__private_number_q_xt
E199: BD 0C04 1053 | jsr forth_core_execute.asm
1054 | .assert /u = .datastack2 , "U"
1055 | .assert @@/0,u = 0 , "false"
1056 | .assert @@forth__base = 10 , "base"
E19C: 39 1057 | rts
1058 |
E19D: 0000 1059 | fdb 0
E19F: 0000 1060 | fdb 0
E1A1: 0000 1061 | fdb 0
E1A3: 0000 1062 | fdb 0
E1A5: E1A8 1063 | .datastack2 fdb .number2
E1A7: 00 1064 | .nu2 fcb 0
E1A8: 03303067 1065 | .number2 ascii '00g'c
1066 | .endtst
1067 |
1068 | ;------------------------------------------
1069 |
1070 | .test "number? 23456"
1071 | .opt pokew forth__base , 10
1072 | .opt test prot n , .nu3
E1AC: CC 000A 1073 | ldd #10
E1AF: DD 1C 1074 | std forth__base
E1B1: CE E1C3 1075 | ldu #.datastack3
E1B4: 8E 0282 1076 | ldx #forth__private_number_q_xt
E1B7: BD 0C04 1077 | jsr forth_core_execute.asm
1078 | .assert /u = .result3 , "U"
1079 | .assert @@/0,u = -1 , "true"
1080 | .assert @@/2,u = 1 , "one cell"
1081 | .assert @@/4,u = 23456 , "result"
1082 | .assert @@forth__base = 10 , "base"
E1BA: 39 1083 | rts
1084 |
E1BB: 0000 1085 | fdb 0
E1BD: 0000 1086 | fdb 0
E1BF: 0000 1087 | .result3 fdb 0
E1C1: 0000 1088 | fdb 0
E1C3: E1C6 1089 | .datastack3 fdb .number3
E1C5: 00 1090 | .nu3 fcb 0
E1C6: 053233343536 1091 | .number3 ascii '23456'c
1092 | .endtst
1093 |
1094 | ;------------------------------------------
1095 |
1096 | .test "number? -23456"
1097 | .opt pokew forth__base , 10
1098 | .opt test prot n , .nu4
E1CC: CC 000A 1099 | ldd #10
E1CF: DD 1C 1100 | std forth__base
E1D1: CE E1E3 1101 | ldu #.datastack4
E1D4: 8E 0282 1102 | ldx #forth__private_number_q_xt
E1D7: BD 0C04 1103 | jsr forth_core_execute.asm
1104 | .assert /u = .result4 , "U"
1105 | .assert @@/0,u = -1 , "true"
1106 | .assert @@/2,u = 1 , "one cell"
1107 | .assert @@/4,u = -23456 , "result"
1108 | .assert @@forth__base = 10 , "base"
E1DA: 39 1109 | rts
1110 |
E1DB: 0000 1111 | fdb 0
E1DD: 0000 1112 | fdb 0
E1DF: 0000 1113 | .result4 fdb 0
E1E1: 0000 1114 | fdb 0
E1E3: E1E6 1115 | .datastack4 fdb .number4
E1E5: 00 1116 | .nu4 fcb 0
E1E6: 062D32333435... 1117 | .number4 ascii '-23456'c
1118 | .endtst
1119 |
1120 | ;------------------------------------------
1121 |
1122 | .test "number? 305419896"
1123 | .opt pokew forth__base , 10
1124 | .opt test prot n , .nu5
E1ED: CC 000A 1125 | ldd #10
E1F0: DD 1C 1126 | std forth__base
E1F2: CE E204 1127 | ldu #.datastack5
E1F5: 8E 0282 1128 | ldx #forth__private_number_q_xt
E1F8: BD 0C04 1129 | jsr forth_core_execute.asm
1130 | .assert /u = .result5 , "U"
1131 | .assert @@/0,u = -1 , "true"
1132 | .assert @@/2,u = 1 , "one cell"
1133 | .assert @@/4,u = 22136 , "result"
1134 | .assert @@forth__base = 10 , "base"
E1FB: 39 1135 | rts
1136 |
E1FC: 0000 1137 | fdb 0
E1FE: 0000 1138 | fdb 0
E200: 0000 1139 | .result5 fdb 0
E202: 0000 1140 | fdb 0
E204: E207 1141 | .datastack5 fdb .number5
E206: 00 1142 | .nu5 fcb 0
E207: 093330353431... 1143 | .number5 ascii '305419896'c
1144 | .endtst
1145 |
1146 | ;------------------------------------------
1147 |
1148 | .test "number? 305419896."
1149 | .opt pokew forth__base , 10
1150 | .opt test prot n , .nu6
E211: CC 000A 1151 | ldd #10
E214: DD 1C 1152 | std forth__base
E216: CE E228 1153 | ldu #.datastack6
E219: 8E 0282 1154 | ldx #forth__private_number_q_xt
E21C: BD 0C04 1155 | jsr forth_core_execute.asm
1156 | .assert /u = .result6 , "U"
1157 | .assert @@/0,u = -1 , "true"
1158 | .assert @@/2,u = 2 , "two cell"
1159 | .assert @@/4,u = $1234 , "MSW"
1160 | .assert @@/6,u = $5678 , "LSW"
1161 | .assert @@forth__base = 10 , "base"
E21F: 39 1162 | rts
1163 |
E220: 0000 1164 | fdb 0
E222: 0000 1165 | .result6 fdb 0
E224: 0000 1166 | fdb 0
E226: 0000 1167 | fdb 0
E228: E22B 1168 | .datastack6 fdb .number6
E22A: 00 1169 | .nu6 fcb 0
E22B: 0A3330353431... 1170 | .number6 ascii '305419896.'c
1171 | .endtst
1172 |
1173 | ;------------------------------------------
1174 |
1175 | .test "number? -305419896."
1176 | .opt pokew forth__base , 10
1177 | .opt test prot n , .nu7
E236: CC 000A 1178 | ldd #10
E239: DD 1C 1179 | std forth__base
E23B: CE E24D 1180 | ldu #.datastack7
E23E: 8E 0282 1181 | ldx #forth__private_number_q_xt
E241: BD 0C04 1182 | jsr forth_core_execute.asm
1183 | .assert /u = .result7 , "U"
1184 | .assert @@/0,u = -1 , "true"
1185 | .assert @@/2,u = 2 , "two cell"
1186 | .assert @@/4,u = $EDCB , "MSW"
1187 | .assert @@/6,u = $A988 , "LSW"
1188 | .assert @@forth__base = 10 , "base"
E244: 39 1189 | rts
1190 |
E245: 0000 1191 | fdb 0
E247: 0000 1192 | .result7 fdb 0
E249: 0000 1193 | fdb 0
E24B: 0000 1194 | fdb 0
E24D: E250 1195 | .datastack7 fdb .number7
E24F: 00 1196 | .nu7 fcb 0
E250: 0B2D33303534... 1197 | .number7 ascii '-305419896.'c
1198 | .endtst
1199 |
1200 | ;------------------------------------------
1201 |
1202 | .test "number? $1234"
1203 | .opt pokew forth__base , 10
1204 | .opt test prot n , .nu8
E25C: CC 000A 1205 | ldd #10
E25F: DD 1C 1206 | std forth__base
E261: CE E273 1207 | ldu #.datastack8
E264: 8E 0282 1208 | ldx #forth__private_number_q_xt
E267: BD 0C04 1209 | jsr forth_core_execute.asm
1210 | .assert /u = .result8 , "U"
1211 | .assert @@/0,u = -1 , "true"
1212 | .assert @@/2,u = 1 , "one cell"
1213 | .assert @@/4,u = $1234 , "LSW"
1214 | .assert @@forth__base = 10 , "base"
E26A: 39 1215 | rts
1216 |
E26B: 0000 1217 | fdb 0
E26D: 0000 1218 | fdb 0
E26F: 0000 1219 | .result8 fdb 0
E271: 0000 1220 | fdb 0
E273: E276 1221 | .datastack8 fdb .number8
E275: 00 1222 | .nu8 fcb 0
E276: 052431323334 1223 | .number8 ascii '$1234'c
1224 | .endtst
1225 |
1226 | ;------------------------------------------
1227 |
1228 | .test "number? $-1234"
1229 | .opt pokew forth__base , 10
1230 | .opt test prot n , .nu9
E27C: CC 000A 1231 | ldd #10
E27F: DD 1C 1232 | std forth__base
E281: CE E293 1233 | ldu #.datastack9
E284: 8E 0282 1234 | ldx #forth__private_number_q_xt
E287: BD 0C04 1235 | jsr forth_core_execute.asm
1236 | .assert /u = .result9 , "U"
1237 | .assert @@/0,u = -1 , "true"
1238 | .assert @@/2,u = 1 , "one cell"
1239 | .assert @@/4,u = $EDCC , "LSW"
1240 | .assert @@forth__base = 10 , "base"
E28A: 39 1241 | rts
1242 |
E28B: 0000 1243 | fdb 0
E28D: 0000 1244 | fdb 0
E28F: 0000 1245 | .result9 fdb 0
E291: 0000 1246 | fdb 0
E293: E296 1247 | .datastack9 fdb .number9
E295: 00 1248 | .nu9 fcb 0
E296: 06242D313233... 1249 | .number9 ascii '$-1234'c
1250 | .endtst
1251 |
1252 | ;------------------------------------------
1253 |
1254 | .test "number? 'x'"
1255 | .opt pokew forth__base , 10
1256 | .opt test prot n , .nuA
E29D: CE E2AF 1257 | ldu #.datastackA
E2A0: 8E 0282 1258 | ldx #forth__private_number_q_xt
E2A3: BD 0C04 1259 | jsr forth_core_execute.asm
1260 | .assert /u = .resultA , "U"
1261 | .assert @@/0,u = -1 , "true"
1262 | .assert @@/2,u = 1 , "one cell"
1263 | .assert @@/4,u = 120 , "LSW"
1264 | .assert @@forth__base = 10 , "base"
E2A6: 39 1265 | rts
E2A7: 0000 1266 | fdb 0
E2A9: 0000 1267 | fdb 0
E2AB: 0000 1268 | .resultA fdb 0
E2AD: 0000 1269 | fdb 0
E2AF: E2B2 1270 | .datastackA fdb .numberA
E2B1: 00 1271 | .nuA fcb 0
E2B2: 03277827 1272 | .numberA ascii "'x'"c
1273 | .endtst
1274 |
1275 | ;------------------------------------------
1276 |
1277 | .test "number? 'x"
1278 | .opt pokew forth__base , 10
1279 | .opt test prot n , .nuB
E2B6: CC 000A 1280 | ldd #10
E2B9: DD 1C 1281 | std forth__base
E2BB: CE E2CD 1282 | ldu #.datastackB
E2BE: 8E 0282 1283 | ldx #forth__private_number_q_xt
E2C1: BD 0C04 1284 | jsr forth_core_execute.asm
1285 | .assert /u = .datastackB , "U"
1286 | .assert @@/0,u = 0 , "false"
1287 | .assert @@forth__base = 10 , "base"
E2C4: 39 1288 | rts
1289 |
E2C5: 0000 1290 | fdb 0
E2C7: 0000 1291 | fdb 0
E2C9: 0000 1292 | fdb 0
E2CB: 0000 1293 | fdb 0
E2CD: E2D0 1294 | .datastackB fdb .numberB
E2CF: 00 1295 | .nuB fcb 0
E2D0: 022778 1296 | .numberB ascii "'x"c
1297 | .endtst
1298 |
1299 | ;**********************************************************************
1300 |
0333: 1301 | forth__private_reset_dsp_xt ; ( i*x -- )
0333: 0335 1302 | fdb .body
0335: DE 08 1303 | .body ldu forth__ds_top
0337: AE A1 1304 | ldx ,y++
0339: 6E 94 1305 | jmp [,x]
1306 |
1307 | ;**********************************************************************
1308 |
033B: 1309 | forth__private_reset_rsp_xt ; ( -- ) ( R: i*x -- )
033B: 033D 1310 | fdb .body
033D: 10DE 0C 1311 | .body lds forth__rs_top
0340: AE A1 1312 | ldx ,y++
0342: 6E 94 1313 | jmp [,x]
1314 |
1315 | ;**********************************************************************
1316 |
0344: 1317 | forth__private_set_source ; ( c-addr n -- )
0344: 0346 1318 | fdb .body
0346: 37 16 1319 | .body pulu x,d
0348: 9F 20 1320 | stx forth__source
034A: DD 22 1321 | std forth__source_len
034C: 4F 1322 | clra
034D: 5F 1323 | clrb
034E: DD 1A 1324 | std forth__in
0350: AE A1 1325 | ldx ,y++
0352: 6E 94 1326 | jmp [,x]
1327 |
1328 | ;**********************************************************************
1329 |
0354: 1330 | forth__private_set_source_i_d
0354: 0356 1331 | fdb .body
0356: 37 06 1332 | .body pulu d
0358: DD 1E 1333 | std forth__source_id
035A: AE A1 1334 | ldx ,y++
035C: 6E 94 1335 | jmp [,x]
1336 |
1337 | ;**********************************************************************
1338 |
035E: 1339 | forth__private_source_restore_xt ; ( c-addr n -- )
035E: 0360 1340 | fdb .body
0360: 37 16 1341 | .body pulu x,d
0362: 9F 20 1342 | stx forth__source
0364: DD 22 1343 | std forth__source_len
0366: AE A1 1344 | ldx ,y++
0368: 6E 94 1345 | jmp [,x]
1346 |
1347 | ;**********************************************************************
1348 |
036A: 1349 | forth__private_string_equal_xt
036A: 0678 1350 | fdb forth_core_colon.runtime
1351 | ;=========================================
1352 | ; : string-equal COMPARE 0= ;
1353 | ;=========================================
036C: 2A96 1354 | fdb forth_string_compare.xt
036E: 057E 1355 | fdb forth_core_zero_equals.xt
0370: 0C1A 1356 | fdb forth_core_exit.xt
1357 |
1358 | ;**********************************************************************
1359 | ; CORE
1360 | ;**********************************************************************
1361 |
0372: 1362 | forth_core_store ; ( x a-addr -- )
0372: 0000 1363 | fdb 0
0374: 0001 1364 | fdb .xt - .name
0376: 21 1365 | .name fcc "!"
0377: 0379 1366 | .xt fdb .body
0379: AE C1 1367 | .body ldx ,u++
037B: EC C1 1368 | ldd ,u++
037D: ED 84 1369 | std ,x
037F: AE A1 1370 | ldx ,y++ ; NEXT
0381: 6E 94 1371 | jmp [,x]
1372 |
1373 | ;**********************************************************************
1374 |
0383: 1375 | forth_core_number_sign ; ( ud1 -- ud2 )
0383: 0372 1376 | fdb forth_core_store
0385: 0001 1377 | fdb .xt - .name
0387: 23 1378 | .name fcc "#"
0388: 038A 1379 | .xt fdb .body
038A: DC 1C 1380 | .body ldd forth__base
038C: 36 06 1381 | pshu d
038E: 86 20 1382 | lda #32
0390: 34 02 1383 | pshs a
0392: 4F 1384 | clra
0393: 5F 1385 | clrb
0394: 34 06 1386 | pshs d
0396: 34 06 1387 | pshs d
0398: 68 45 1388 | .10 lsl 5,u
039A: 69 44 1389 | rol 4,u
039C: 69 43 1390 | rol 3,u
039E: 69 42 1391 | rol 2,u
03A0: 59 1392 | rolb
03A1: 49 1393 | rola
03A2: 25 05 1394 | bcs .15
03A4: 10A3 C4 1395 | cmpd ,u
03A7: 25 06 1396 | blo .20
03A9: A3 C4 1397 | .15 subd ,u
03AB: 1A 01 1398 | orcc {c}
03AD: 20 02 1399 | bra .30
03AF: 1C FE 1400 | .20 andcc {c}
03B1: 69 63 1401 | .30 rol 3,s
03B3: 69 62 1402 | rol 2,s
03B5: 69 61 1403 | rol 1,s
03B7: 69 E4 1404 | rol ,s
03B9: 6A 64 1405 | dec 4,s
03BB: 26 DB 1406 | bne .10
03BD: 1083 0009 1407 | cmpd #9
03C1: 23 02 1408 | bls .40
03C3: CB 07 1409 | addb #7
03C5: CB 30 1410 | .40 addb #'0'
03C7: 9E 2A 1411 | ldx forth__hold
03C9: E7 82 1412 | stb ,-x
03CB: 9F 2A 1413 | stx forth__hold
03CD: 33 42 1414 | leau 2,u
03CF: 35 16 1415 | puls x,d
03D1: AF 42 1416 | stx 2,u
03D3: ED C4 1417 | std 0,u
03D5: 32 61 1418 | leas 1,s
03D7: AE A1 1419 | ldx ,y++
03D9: 6E 94 1420 | jmp [,x]
1421 |
1422 | ;----------------------------------------------
1423 |
1424 | .test "#"
1425 | .opt test pokew forth__hold , .here
1426 | .opt test pokew forth__base , 10
E2D3: CE E2E1 1427 | ldu #.datastack
E2D6: 8E 0388 1428 | ldx #forth_core_number_sign.xt
E2D9: BD 0C04 1429 | jsr forth_core_execute.asm
1430 | .assert /u = .datastack , "U"
1431 | .assert @@forth__hold = .digit , "hold"
1432 | .assert @.digit = $36 , "digit"
1433 | .assert @@/0,u = $01D2 , "MSW"
1434 | .assert @@/2,u = $08A5 , "LSW"
E2DC: 39 1435 | rts
1436 |
E2DD: 0000 1437 | fdb 0
E2DF: 0000 1438 | fdb 0
E2E1: 1234 1439 | .datastack fdb $1234
E2E3: 5678 1440 | fdb $5678
1441 |
E2E5: 00 1442 | .digit fcb 0
E2E6: 00 1443 | .here fcb 0
1444 | .endtst
1445 |
1446 | ;----------------------------------------------
1447 |
1448 | .test "# max"
1449 | .opt test pokew forth__hold , .here1
1450 | .opt test pokew forth__base , 10
E2E7: CE E2F5 1451 | ldu #.datastack1
E2EA: 8E 0388 1452 | ldx #forth_core_number_sign.xt
E2ED: BD 0C04 1453 | jsr forth_core_execute.asm
1454 | .assert /u = .datastack1 , "U"
1455 | .assert @@forth__hold = .digit1 , "hold"
1456 | .assert @.digit1 = $35 , "digit"
1457 | .assert @@/0,u = $1999 , "MSW"
1458 | .assert @@/2,u = $9999 , "LSW"
E2F0: 39 1459 | rts
1460 |
E2F1: 0000 1461 | fdb 0
E2F3: 0000 1462 | fdb 0
E2F5: FFFF 1463 | .datastack1 fdb $FFFF
E2F7: FFFF 1464 | fdb $FFFF
1465 |
E2F9: 00 1466 | .digit1 fcb 0
E2FA: 00 1467 | .here1 fcb 0
1468 | .endtst
1469 |
1470 | ;----------------------------------------------
1471 |
1472 | .test "# maxint"
1473 | .opt test pokew forth__hold , .here2
1474 | .opt test pokew forth__base , 10
E2FB: CE E309 1475 | ldu #.datastack2
E2FE: 8E 0388 1476 | ldx #forth_core_number_sign.xt
E301: BD 0C04 1477 | jsr forth_core_execute.asm
1478 | .assert /u = .datastack2 , "U"
1479 | .assert @@forth__hold = .digit2 , "hold"
1480 | .assert @.digit2 = $37 , "digit"
1481 | .assert @@/0,u = $0CCC , "MSW"
1482 | .assert @@/2,u = $CCCC , "LSW"
E304: 39 1483 | rts
1484 |
E305: 0000 1485 | fdb 0
E307: 0000 1486 | fdb 0
E309: 7FFF 1487 | .datastack2 fdb $7FFF
E30B: FFFF 1488 | fdb $FFFF
1489 |
E30D: 00 1490 | .digit2 fcb 0
E30E: 00 1491 | .here2 fcb 0
1492 | .endtst
1493 |
1494 | ;**********************************************************************
1495 |
03DB: 1496 | forth_core_number_sign_greater ; ( xd -- c-addr u )
03DB: 0383 1497 | fdb forth_core_number_sign
03DD: 0002 1498 | fdb .xt - .name
03DF: 233E 1499 | .name fcc "#>"
03E1: 03E3 1500 | .xt fdb .body
03E3: DC 10 1501 | .body ldd forth__here
03E5: C3 0097 1502 | addd #SLASH_PAD + WORD_MAX + SLASH_HOLD
03E8: 93 2A 1503 | subd forth__hold
03EA: 9E 2A 1504 | ldx forth__hold
03EC: AF 42 1505 | stx 2,u
03EE: ED C4 1506 | std ,u
03F0: AE A1 1507 | ldx ,y++
03F2: 6E 94 1508 | jmp [,x]
1509 |
1510 | ;**********************************************************************
1511 |
03F4: 1512 | forth_core_number_sign_s ; ( ud1 -- ud2 )
03F4: 03DB 1513 | fdb forth_core_number_sign_greater
03F6: 0002 1514 | fdb .xt - .name
03F8: 2353 1515 | .name fcc "#S"
03FA: 0678 1516 | .xt fdb forth_core_colon.runtime
1517 | ;=================================
1518 | ; : #S BEGIN # 2DUP D0= UNTIL ;
1519 | ;=================================
03FC: 0388 1520 | .L1 fdb forth_core_number_sign.xt
03FE: 060D 1521 | fdb forth_core_two_dupe.xt
0400: 1BCA 1522 | fdb forth_double_d_zero_equal.xt
0402: 11CF 1523 | fdb forth_core_until.runtime_xt
0404: 03FC 1524 | fdb .L1
0406: 0C1A 1525 | fdb forth_core_exit.xt
1526 |
1527 | ;**********************************************************************
1528 |
0408: 1529 | forth_core_tick ; ( "name" -- xt )
0408: 03F4 1530 | fdb forth_core_number_sign_s
040A: 0001 1531 | fdb .xt - .name
040C: 27 1532 | .name fcc "'"
040D: 0678 1533 | .xt fdb forth_core_colon.runtime
1534 | ;===============================================
1535 | ; : ' BL WORD FIND 0= IF -13 THROW THEN ;
1536 | ;===============================================
040F: 08C9 1537 | fdb forth_core_b_l.xt
0411: 1217 1538 | fdb forth_core_word.xt
0413: 2780 1539 | fdb forth_search_find.xt
0415: 057E 1540 | fdb forth_core_zero_equals.xt
0417: 0CD1 1541 | fdb forth_core_if.runtime_xt
0419: 0421 1542 | fdb .L1
041B: 0D84 1543 | fdb forth_core_literal.runtime_xt
041D: FFF3 1544 | fdb -13
041F: 1E8A 1545 | fdb forth_exception_throw.xt
0421: 0C1A 1546 | .L1 fdb forth_core_exit.xt
1547 |
1548 | ;----------------------------------------------
1549 |
1550 | .test "' */MOD"
1551 | .opt test prot rw , $6000 , $6100
1552 | .opt test pokew forth__source , .buffer
1553 | .opt test pokew forth__source_len , .len
1554 | .opt test pokew forth__in , 0
1555 | .opt test pokew forth__here , $6000
E30F: CE E32B 1556 | ldu #.datastack
E312: 8E 040D 1557 | ldx #forth_core_tick.xt
E315: BD 0C04 1558 | jsr forth_core_execute.asm
1559 | .assert /u = .result , "U"
1560 | .assert @@/0,u = forth_core_star_slash_mod.xt , "xt"
E318: 39 1561 | rts
1562 |
E319: 0000 1563 | fdb 0
E31B: 0000 1564 | fdb 0
E31D: 0000 1565 | fdb 0
E31F: 0000 1566 | fdb 0
E321: 0000 1567 | fdb 0
E323: 0000 1568 | fdb 0
E325: 0000 1569 | fdb 0
E327: 0000 1570 | fdb 0
E329: 0000 1571 | .result fdb 0
E32B: 0000 1572 | .datastack fdb 0
1573 |
E32D: 202A2F4D4F44... 1574 | .buffer fcc ' */MOD '
1575 | .len equ * - .buffer
1576 | .endtst
1577 |
1578 | ;**********************************************************************
1579 |
0423: 1580 | forth_core_paren ; ( "ccc" -- )
0423: 0408 1581 | fdb forth_core_tick
0425: 8001 1582 | fdb _IMMED :: .xt - .name
0427: 28 1583 | .name fcc "("
0428: 0678 1584 | .xt fdb forth_core_colon.runtime
1585 | ;==========================================
1586 | ; : ( [CHAR] ) PARSE 2DROP ; IMMEDIATE
1587 | ;==========================================
042A: 0D84 1588 | fdb forth_core_literal.runtime_xt
042C: 0029 1589 | fdb ')'
042E: 1698 1590 | fdb forth_core_ext_parse.xt
0430: 05FD 1591 | fdb forth_core_two_drop.xt
0432: 0C1A 1592 | fdb forth_core_exit.xt
1593 |
1594 | ;**********************************************************************
1595 |
0434: 1596 | forth_core_star ; ( n1|u2 n2|u2 -- n3|u3 )
0434: 0423 1597 | fdb forth_core_paren
0436: 0001 1598 | fdb .xt - .name
0438: 2A 1599 | .name fcc "*"
0439: 0678 1600 | .xt fdb forth_core_colon.runtime
1601 | ;=========================================
1602 | ; : * M* DROP ;
1603 | ;=========================================
043B: 0DDD 1604 | fdb forth_core_m_star.xt
043D: 0A65 1605 | fdb forth_core_drop.xt
043F: 0C1A 1606 | fdb forth_core_exit.xt
1607 |
1608 | ;**********************************************************************
1609 |
0441: 1610 | forth_core_star_slash ; ( n1 n2 n3 -- n4 )
0441: 0434 1611 | fdb forth_core_star
0443: 0002 1612 | fdb .xt - .name
0445: 2A2F 1613 | .name fcc "*/"
0447: 0678 1614 | .xt fdb forth_core_colon.runtime
1615 | ;===========================================
1616 | ; : */ */MOD SWAP DROP ;
1617 | ;===========================================
0449: 045A 1618 | fdb forth_core_star_slash_mod.xt
044B: 10FC 1619 | fdb forth_core_swap.xt
044D: 0A65 1620 | fdb forth_core_drop.xt
044F: 0C1A 1621 | fdb forth_core_exit.xt
1622 |
1623 | ;**********************************************************************
1624 |
0451: 1625 | forth_core_star_slash_mod ; ( n1 n2 n3 -- n4 n5 )
0451: 0441 1626 | fdb forth_core_star_slash
0453: 0005 1627 | fdb .xt - .name
0455: 2A2F4D4F44 1628 | .name fcc "*/MOD"
045A: 0678 1629 | .xt fdb forth_core_colon.runtime
1630 | ;=========================================
1631 | ; : */MOD >R M* R> SM/REM ;
1632 | ;=========================================
045C: 07BF 1633 | fdb forth_core_to_r.xt
045E: 0DDD 1634 | fdb forth_core_m_star.xt
0460: 0FAA 1635 | fdb forth_core_r_from.xt
0462: 1067 1636 | fdb forth_core_s_m_slash_rem.xt
0464: 0C1A 1637 | fdb forth_core_exit.xt
1638 |
1639 | ;**********************************************************************
1640 |
0466: 1641 | forth_core_plus ; n1|u2 n2|u2 -- n3|u3 )
0466: 0451 1642 | fdb forth_core_star_slash_mod
0468: 0001 1643 | fdb .xt - .name
046A: 2B 1644 | .name fcc "+"
046B: 046D 1645 | .xt fdb .body
046D: EC C1 1646 | .body ldd ,u++
046F: E3 C4 1647 | addd ,u
0471: ED C4 1648 | std ,u
0473: AE A1 1649 | ldx ,y++
0475: 6E 94 1650 | jmp [,x]
1651 |
1652 | ;**********************************************************************
1653 |
0477: 1654 | forth_core_plus_store ; ( n|u a-addr -- )
0477: 0466 1655 | fdb forth_core_plus
0479: 0002 1656 | fdb .xt - .name
047B: 2B21 1657 | .name fcc "+!"
047D: 0678 1658 | .xt fdb forth_core_colon.runtime
1659 | ;===============================
1660 | ; : +! DUP @ ROT + SWAP ! ;
1661 | ;===============================
047F: 0A74 1662 | fdb forth_core_dupe.xt
0481: 07E2 1663 | fdb forth_core_fetch.xt
0483: 0FF6 1664 | fdb forth_core_rote.xt
0485: 046B 1665 | fdb forth_core_plus.xt
0487: 10FC 1666 | fdb forth_core_swap.xt
0489: 0377 1667 | fdb forth_core_store.xt
048B: 0C1A 1668 | fdb forth_core_exit.xt
1669 |
1670 | ;**********************************************************************
1671 |
048D: 1672 | forth_core_plus_loop ; C ( C: do-sys -- ) R ( n -- ) ( R: loop-sys1 -- | loop-sys2 )
048D: 0477 1673 | fdb forth_core_plus_store
048F: A005 1674 | fdb _IMMED | _NOINTERP :: .xt - .name
0491: 2B4C4F4F50 1675 | .name fcc "+LOOP"
0496: 0498 1676 | .xt fdb .body
0498: CC 04CA 1677 | .body ldd #.runtime_xt ; xt to compile
049B: 9E 10 1678 | .rest ldx forth__here ; get compile location
049D: ED 81 1679 | std ,x++
049F: EC 42 1680 | ldd 2,u ; get u-dest
04A1: ED 81 1681 | std ,x++ ; compile it in
04A3: 9F 10 1682 | stx forth__here
04A5: 1F 10 1683 | tfr x,d ; cache current location in D
04A7: AE C4 1684 | ldx ,u
04A9: 27 02 1685 | beq .checkleave
04AB: ED 84 1686 | std ,x
04AD: 34 40 1687 | .checkleave pshs u
04AF: 9E 58 1688 | ldx forth__leave_sp
04B1: EE 83 1689 | ldu ,--x
04B3: 9F 58 1690 | stx forth__leave_sp
04B5: 1F 31 1691 | .fixup tfr u,x
04B7: 8C 0000 1692 | cmpx #0
04BA: 27 06 1693 | beq .xtdone
04BC: EE 84 1694 | ldu ,x
04BE: ED 84 1695 | std ,x
04C0: 20 F3 1696 | bra .fixup
1697 |
04C2: 35 40 1698 | .xtdone puls u
04C4: 33 44 1699 | leau 4,u ; clean parameter stack
04C6: AE A1 1700 | ldx ,y++ ; NEXT
04C8: 6E 94 1701 | jmp [,x]
1702 |
1703 | ; https://forth-standard.org/standard/core/PlusLOOP#reply-214
1704 |
04CA: 04CC 1705 | .runtime_xt fdb .runtime
04CC: EC E4 1706 | .runtime ldd ,s
04CE: A3 62 1707 | subd 2,s
04D0: C3 8000 1708 | addd #$8000
04D3: E3 C4 1709 | addd ,u
04D5: 29 0D 1710 | bvs .done
04D7: EC E4 1711 | ldd ,s
04D9: E3 C1 1712 | addd ,u++
04DB: ED E4 1713 | std ,s
04DD: 10AE A4 1714 | ldy ,y
04E0: AE A1 1715 | ldx ,y++
04E2: 6E 94 1716 | jmp [,x]
04E4: 32 64 1717 | .done leas 4,s
04E6: 31 22 1718 | leay 2,y
04E8: 33 42 1719 | leau 2,u
04EA: AE A1 1720 | ldx ,y++
04EC: 6E 94 1721 | jmp [,x]
1722 |
1723 | ;**********************************************************************
1724 |
04EE: 1725 | forth_core_comma ; ( x -- )
04EE: 048D 1726 | fdb forth_core_plus_loop
04F0: 0001 1727 | fdb .xt - .name
04F2: 2C 1728 | .name fcc ","
04F3: 04F5 1729 | .xt fdb .body
04F5: 9E 10 1730 | .body ldx forth__here
04F7: 37 06 1731 | pulu d
04F9: ED 81 1732 | std ,x++
04FB: 9F 10 1733 | stx forth__here
04FD: AE A1 1734 | ldx ,y++
04FF: 6E 94 1735 | jmp [,x]
1736 |
1737 | ;**********************************************************************
1738 |
0501: 1739 | forth_core_minus ; ( n1|u1 n2|u2 -- n3|u3 )
0501: 04EE 1740 | fdb forth_core_comma
0503: 0001 1741 | fdb .xt - .name
0505: 2D 1742 | .name fcc "-"
0506: 0508 1743 | .xt fdb .body
0508: EC 42 1744 | .body ldd 2,u
050A: A3 C1 1745 | subd ,u++
050C: ED C4 1746 | std ,u
050E: AE A1 1747 | ldx ,y++
0510: 6E 94 1748 | jmp [,x]
1749 |
1750 | ;**********************************************************************
1751 |
0512: 1752 | forth_core_dot ; ( n -- )
0512: 0501 1753 | fdb forth_core_minus
0514: 0001 1754 | fdb .xt - .name
0516: 2E 1755 | .name fcc "."
0517: 0678 1756 | .xt fdb forth_core_colon.runtime
1757 | ;==========================================================
1758 | ; : . DUP >R ABS 0 <# #S R> SIGN #> TYPE SPACE ;
1759 | ;==========================================================
0519: 0A74 1760 | fdb forth_core_dupe.xt
051B: 07BF 1761 | fdb forth_core_to_r.xt
051D: 07F3 1762 | fdb forth_core_abs.xt
051F: 0D84 1763 | fdb forth_core_literal.runtime_xt
0521: 0000 1764 | fdb 0
0523: 06C7 1765 | fdb forth_core_less_number_sign.xt
0525: 03FA 1766 | fdb forth_core_number_sign_s.xt
0527: 0FAA 1767 | fdb forth_core_r_from.xt
0529: 104D 1768 | fdb forth_core_sign.xt
052B: 03E1 1769 | fdb forth_core_number_sign_greater.xt
052D: 1124 1770 | fdb forth_core_type.xt
052F: 10D0 1771 | fdb forth_core_space.xt
0531: 0C1A 1772 | fdb forth_core_exit.xt
1773 |
1774 | ;----------------------------------------------
1775 |
1776 | .test "."
1777 | .opt test prot rw , $6000 , $6100
1778 | .opt test pokew forth__here , $6000
1779 | .opt test pokew forth__vector_putchar , .putchar
E334: CE E346 1780 | ldu #.datastack
E337: 8E 0517 1781 | ldx #forth_core_dot.xt
E33A: BD 0C04 1782 | jsr forth_core_execute.asm
1783 | .assert /u = .result , "U"
1784 | .assert .outputbuf = "-32456"
E33D: 39 1785 | rts
1786 |
E33E: 0000 1787 | fdb 0
E340: 0000 1788 | fdb 0
E342: 0000 1789 | fdb 0
E344: 0000 1790 | fdb 0
E346: 8138 1791 | .datastack fdb -32456
E348: 0000 1792 | .result fdb 0
1793 |
E34A: 34 10 1794 | .putchar pshs x
E34C: BE E356 1795 | ldx .output
E34F: E7 80 1796 | stb ,x+
E351: BF E356 1797 | stx .output
E354: 35 90 1798 | puls x,pc
E356: E358 1799 | .output fdb .outputbuf
E358: 1800 | .outputbuf rmb 8
1801 | .endtst
1802 |
1803 | ;**********************************************************************
1804 |
0533: 1805 | forth_core_dot_quote ; ( -- )
0533: 0512 1806 | fdb forth_core_dot
0535: A002 1807 | fdb _IMMED | _NOINTERP :: .xt - .name
0537: 2E22 1808 | .name fcc '."'
0539: 0678 1809 | .xt fdb forth_core_colon.runtime
1810 | ;=================================================
1811 | ; ." POSTPONE S" ['] TYPE COMPILE, ; IMMEDIATE
1812 | ;=================================================
053B: 102A 1813 | fdb forth_core_s_quote.xt
053D: 0D84 1814 | fdb forth_core_literal.runtime_xt
053F: 1124 1815 | fdb forth_core_type.xt
0541: 14AC 1816 | fdb forth_core_ext_compile_comma.xt
0543: 0C1A 1817 | fdb forth_core_exit.xt
1818 |
1819 | ;**********************************************************************
1820 |
0545: 1821 | forth_core_slash ; ( n1 n2 -- n3 )
0545: 0533 1822 | fdb forth_core_dot_quote
0547: 0001 1823 | fdb .xt - .name
0549: 2F 1824 | .name fcc "/"
054A: 0678 1825 | .xt fdb forth_core_colon.runtime
1826 | ;=====================================
1827 | ; : / /MOD SWAP DROP ;
1828 | ;=====================================
054C: 055C 1829 | fdb forth_core_slash_mod.xt
054E: 10FC 1830 | fdb forth_core_swap.xt
0550: 0A65 1831 | fdb forth_core_drop.xt
0552: 0C1A 1832 | fdb forth_core_exit.xt
1833 |
1834 | ;**********************************************************************
1835 |
0554: 1836 | forth_core_slash_mod ; ( n1 n2 -- n3 n4 )
0554: 0545 1837 | fdb forth_core_slash
0556: 0004 1838 | fdb .xt - .name
0558: 2F4D4F44 1839 | .name fcc "/MOD"
055C: 0678 1840 | .xt fdb forth_core_colon.runtime
1841 | ;====================================
1842 | ; : /MOD >R S>D R> SM/REM ;
1843 | ;====================================
055E: 07BF 1844 | fdb forth_core_to_r.xt
0560: 103D 1845 | fdb forth_core_s_to_d.xt
0562: 0FAA 1846 | fdb forth_core_r_from.xt
0564: 1067 1847 | fdb forth_core_s_m_slash_rem.xt
0566: 0C1A 1848 | fdb forth_core_exit.xt
1849 |
1850 | ;**********************************************************************
1851 |
0568: 1852 | forth_core_zero_less ; ( n -- flag )
0568: 0554 1853 | fdb forth_core_slash_mod
056A: 0002 1854 | fdb .xt - .name
056C: 303C 1855 | .name fcc "0<"
056E: 0678 1856 | .xt fdb forth_core_colon.runtime
1857 | ;==============================================
1858 | ; : 0< 0 < ;
1859 | ;==============================================
0570: 0D84 1860 | fdb forth_core_literal.runtime_xt
0572: 0000 1861 | fdb 0
0574: 06AB 1862 | fdb forth_core_less_than.xt
0576: 0C1A 1863 | fdb forth_core_exit.xt
1864 |
1865 | ;**********************************************************************
1866 |
0578: 1867 | forth_core_zero_equals ; ( n -- flag )
0578: 0568 1868 | fdb forth_core_zero_less
057A: 0002 1869 | fdb .xt - .name
057C: 303D 1870 | .name fcc "0="
057E: 0678 1871 | .xt fdb forth_core_colon.runtime
1872 | ;==============================================
1873 | ; : 0= 0 = ;
1874 | ;==============================================
0580: 0D84 1875 | fdb forth_core_literal.runtime_xt
0582: 0000 1876 | fdb 0
0584: 06D9 1877 | fdb forth_core_equals.xt
0586: 0C1A 1878 | fdb forth_core_exit.xt
1879 |
1880 | ;**********************************************************************
1881 |
0588: 1882 | forth_core_one_plus ; ( n1|u1 -- n2|u2 )
0588: 0578 1883 | fdb forth_core_zero_equals
058A: 0002 1884 | fdb .xt - .name
058C: 312B 1885 | .name fcc "1+"
058E: 0678 1886 | .xt fdb forth_core_colon.runtime
1887 | ;=========================================
1888 | ; : 1+ 1 + ;
1889 | ;=========================================
0590: 0D84 1890 | fdb forth_core_literal.runtime_xt
0592: 0001 1891 | fdb 1
0594: 046B 1892 | fdb forth_core_plus.xt
0596: 0C1A 1893 | fdb forth_core_exit.xt
1894 |
1895 | ;**********************************************************************
1896 |
0598: 1897 | forth_core_one_minus ; ( n1 -- n2 )
0598: 0588 1898 | fdb forth_core_one_plus
059A: 0002 1899 | fdb .xt - .name
059C: 312D 1900 | .name fcc "1-"
059E: 0678 1901 | .xt fdb forth_core_colon.runtime
1902 | ;========================================
1903 | ; : 1- 1 - ;
1904 | ;========================================
05A0: 0D84 1905 | fdb forth_core_literal.runtime_xt
05A2: 0001 1906 | fdb 1
05A4: 0506 1907 | fdb forth_core_minus.xt
05A6: 0C1A 1908 | fdb forth_core_exit.xt
1909 |
1910 | ;**********************************************************************
1911 |
05A8: 1912 | forth_core_two_store ; ( x1 x2 a-addr -- )
05A8: 0598 1913 | fdb forth_core_one_minus
05AA: 0002 1914 | fdb .xt - .name
05AC: 3221 1915 | .name fcc "2!"
05AE: 0678 1916 | .xt fdb forth_core_colon.runtime
1917 | ;==========================================
1918 | ; : 2! SWAP OVER ! CELL+ ! ;
1919 | ;==========================================
05B0: 10FC 1920 | fdb forth_core_swap.xt
05B2: 0EA4 1921 | fdb forth_core_over.xt
05B4: 0377 1922 | fdb forth_core_store.xt
05B6: 090F 1923 | fdb forth_core_cell_plus.xt
05B8: 0377 1924 | fdb forth_core_store.xt
05BA: 0C1A 1925 | fdb forth_core_exit.xt
1926 |
1927 | ;**********************************************************************
1928 |
05BC: 1929 | forth_core_two_star ; ( x1 -- x2 )
05BC: 05A8 1930 | fdb forth_core_two_store
05BE: 0002 1931 | fdb .xt - .name
05C0: 322A 1932 | .name fcc "2*"
05C2: 0678 1933 | .xt fdb forth_core_colon.runtime
1934 | ;======================================
1935 | ; : 2* 1 LSHIFT ;
1936 | ;======================================
05C4: 0D84 1937 | fdb forth_core_literal.runtime_xt
05C6: 0001 1938 | fdb 1
05C8: 0DC3 1939 | fdb forth_core_l_shift.xt
05CA: 0C1A 1940 | fdb forth_core_exit.xt
1941 |
1942 | ;**********************************************************************
1943 |
05CC: 1944 | forth_core_two_slash ; ( x1 -- x2 )
05CC: 05BC 1945 | fdb forth_core_two_star
05CE: 0002 1946 | fdb .xt - .name
05D0: 322F 1947 | .name fcc "2/"
05D2: 05D4 1948 | .xt fdb .body
05D4: EC C4 1949 | .body ldd ,u
05D6: 47 1950 | asra
05D7: 56 1951 | rorb
05D8: ED C4 1952 | std ,u
05DA: AE A1 1953 | ldx ,y++
05DC: 6E 94 1954 | jmp [,x]
1955 |
1956 | ;**********************************************************************
1957 |
05DE: 1958 | forth_core_two_fetch ; ( a-addr -- x1 x2 )
05DE: 05CC 1959 | fdb forth_core_two_slash
05E0: 0002 1960 | fdb .xt - .name
05E2: 3240 1961 | .name fcc "2@"
05E4: 0678 1962 | .xt fdb forth_core_colon.runtime
1963 | ;=====================================
1964 | ; : 2@ DUP @ SWAP CELL+ @ SWAP ;
1965 | ;=====================================
05E6: 0A74 1966 | fdb forth_core_dupe.xt
05E8: 07E2 1967 | fdb forth_core_fetch.xt
05EA: 10FC 1968 | fdb forth_core_swap.xt
05EC: 090F 1969 | fdb forth_core_cell_plus.xt
05EE: 07E2 1970 | fdb forth_core_fetch.xt
05F0: 10FC 1971 | fdb forth_core_swap.xt
05F2: 0C1A 1972 | fdb forth_core_exit.xt
1973 |
1974 | ;**********************************************************************
1975 |
05F4: 1976 | forth_core_two_drop ; ( x1 x2 -- )
05F4: 05DE 1977 | fdb forth_core_two_fetch
05F6: 0005 1978 | fdb .xt - .name
05F8: 3244524F50 1979 | .name fcc "2DROP"
05FD: 0678 1980 | .xt fdb forth_core_colon.runtime
1981 | ;===================================
1982 | ; : 2DROP DROP DROP ;
1983 | ;===================================
05FF: 0A65 1984 | fdb forth_core_drop.xt
0601: 0A65 1985 | fdb forth_core_drop.xt
0603: 0C1A 1986 | fdb forth_core_exit.xt
1987 |
1988 | ;**********************************************************************
1989 |
0605: 1990 | forth_core_two_dupe ; ( x1 x2 -- x1 x2 x1 x2 )
0605: 05F4 1991 | fdb forth_core_two_drop
0607: 0004 1992 | fdb .xt - .name
0609: 32445550 1993 | .name fcc "2DUP"
060D: 0678 1994 | .xt fdb forth_core_colon.runtime
1995 | ;=======================================
1996 | ; : 2DUP OVER OVER ;
1997 | ;=======================================
060F: 0EA4 1998 | fdb forth_core_over.xt
0611: 0EA4 1999 | fdb forth_core_over.xt
0613: 0C1A 2000 | fdb forth_core_exit.xt
2001 |
2002 | ;**********************************************************************
2003 |
0615: 2004 | forth_core_two_over ; ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
0615: 0605 2005 | fdb forth_core_two_dupe
0617: 0005 2006 | fdb .xt - .name
0619: 324F564552 2007 | .name fcc "2OVER"
061E: 0620 2008 | .xt fdb .body
0620: EC 44 2009 | .body ldd 4,u
0622: AE 46 2010 | ldx 6,u
0624: 36 16 2011 | pshu x,d
0626: AE A1 2012 | ldx ,y++
0628: 6E 94 2013 | jmp [,x]
2014 |
2015 | ;**********************************************************************
2016 |
062A: 2017 | forth_core_two_swap ; ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
062A: 0615 2018 | fdb forth_core_two_over
062C: 0005 2019 | fdb .xt - .name
062E: 3253574150 2020 | .name fcc "2SWAP"
0633: 0635 2021 | .xt fdb .body
0635: AE C4 2022 | .body ldx ,u
0637: EC 44 2023 | ldd 4,u
0639: 1E 01 2024 | exg d,x
063B: ED 44 2025 | std 4,u
063D: AF C4 2026 | stx ,u
063F: AE 42 2027 | ldx 2,u
0641: EC 46 2028 | ldd 6,u
0643: 1E 01 2029 | exg d,x
0645: ED 46 2030 | std 6,u
0647: AF 42 2031 | stx 2,u
0649: AE A1 2032 | ldx ,y++
064B: 6E 94 2033 | jmp [,x]
2034 |
2035 | ;---------------------------------------
2036 |
2037 | .test "2SWAP"
E360: CE E36C 2038 | ldu #.datastack
E363: 8E 0633 2039 | ldx #forth_core_two_swap.xt
E366: BD 0C04 2040 | jsr forth_core_execute.asm
2041 | .assert /u = .datastack
2042 | .assert @@/,u = 3
2043 | .assert @@/2,u = 4
2044 | .assert @@/4,u = 1
2045 | .assert @@/6,u = 2
E369: 39 2046 | rts
2047 |
E36A: 0000 2048 | fdb 0
E36C: 0001 2049 | .datastack fdb 1
E36E: 0002 2050 | fdb 2
E370: 0003 2051 | fdb 3
E372: 0004 2052 | fdb 4
2053 | .endtst
2054 |
2055 | ;**********************************************************************
2056 |
064D: 2057 | forth_core_colon ; ( C: "name" -- colon-sys ) E ( i*x -- j*x )
064D: 062A 2058 | fdb forth_core_two_swap
064F: 0001 2059 | fdb .xt - .name
0651: 3A 2060 | .name fcc ":"
0652: 0654 2061 | .xt fdb .body
0654: CC 005A 2062 | .body ldd #forth__leave_stack
0657: DD 58 2063 | std forth__leave_sp
0659: 8E 09B2 2064 | ldx #forth_core_create.xt ; execute CREATE
065C: 17 05A5 2065 | lbsr forth_core_execute.asm
065F: A6 9F0026 2066 | lda [forth__create_name] ; hide word from search
0663: 8A 40 2067 | ora #_HIDDEN
0665: A7 9F0026 2068 | sta [forth__create_name]
0669: 9E 28 2069 | ldx forth__create_xt ; create colon-sys
066B: 36 10 2070 | pshu x
066D: CC 0678 2071 | ldd #.runtime ; set xt for new word
0670: ED 84 2072 | std ,x
0672: 0C 19 2073 | inc forth__state + 1 ; set STATE to compile
0674: AE A1 2074 | ldx ,y++ ; NEXT
0676: 6E 94 2075 | jmp [,x]
0678: 34 20 2076 | .runtime pshs y
067A: 31 02 2077 | leay 2,x
067C: AE A1 2078 | ldx ,y++
067E: 6E 94 2079 | jmp [,x]
2080 |
2081 | ;-------------------------------------
2082 |
2083 | .test ": BAR "
2084 | .opt test pokew forth__source , .buffer
2085 | .opt test pokew forth__source_len , .len
2086 | .opt test pokew forth__in , 0
2087 | .opt test pokew forth__current_wid , .wid
2088 | .opt test pokew forth__here , .bar_link
E374: CE E384 2089 | ldu #.datastack
E377: 8E 0652 2090 | ldx #forth_core_colon.xt
E37A: BD 0C04 2091 | jsr forth_core_execute.asm
2092 | .assert @@.bar_xt = forth_core_colon.runtime , "xt"
2093 | .assert @@.bar_name = _HIDDEN :: 3 , "hidden"
2094 | .assert .bar_name + 2 = "bar" , "name"
E37D: 39 2095 | rts
2096 |
E37E: FFFA 2097 | fdb -6
E380: FFFC 2098 | fdb -4
E382: FFFE 2099 | fdb -2
E384: 0000 2100 | .datastack fdb 0
2101 |
E386: 62617220 2102 | .buffer fcc 'bar '
2103 | .len equ * - .buffer
2104 |
E38A: E38C 2105 | .wid fdb .foo
E38C: 0003 2106 | .foo fdb .foo_xt - .foo_name
E38E: 666F6F 2107 | .foo_name fcc 'foo'
E391: 0678 2108 | .foo_xt fdb forth_core_colon.runtime
E393: 0C1A 2109 | fdb forth_core_exit.xt
2110 |
E395: 0000 2111 | .bar_link fdb 0
E397: 0000 2112 | .bar_name fdb 0 ; length + flags
E399: 000000 2113 | fcb 0,0,0 ; text
E39C: 0000 2114 | .bar_xt fdb 0
E39E: 0000 2115 | fdb 0
2116 | .endtst
2117 |
2118 | ;**********************************************************************
2119 |
0680: 2120 | forth_core_semicolon ; C ( C: colon-sys -- ) R ( -- ) ( R: nest-sys -- )
0680: 064D 2121 | fdb forth_core_colon
0682: A001 2122 | fdb _IMMED | _NOINTERP :: .xt - .name
0684: 3B 2123 | .name fcc ";"
0685: 0687 2124 | .xt fdb .body
0687: 9E 10 2125 | .body ldx forth__here ; compile in EXIT
0689: CC 0C1A 2126 | ldd #forth_core_exit.xt
068C: ED 81 2127 | std ,x++
068E: 9F 10 2128 | stx forth__here
0690: 9E 26 2129 | ldx forth__create_name ; get name
0692: 27 08 2130 | beq .no_name ; no name to unhide
0694: A6 84 2131 | lda ,x ; unhide word
0696: 84 BF 2132 | anda #~_HIDDEN
0698: A7 84 2133 | sta ,x
069A: 33 42 2134 | leau 2,u ; remove colon-sys
069C: 4F 2135 | .no_name clra
069D: 5F 2136 | clrb
069E: DD 18 2137 | std forth__state
06A0: DD 58 2138 | std forth__leave_sp
06A2: AE A1 2139 | ldx ,y++ ; NEXT
06A4: 6E 94 2140 | jmp [,x]
2141 |
2142 | ;**********************************************************************
2143 |
06A6: 2144 | forth_core_less_than ; ( n1 n2 -- flag )
06A6: 0680 2145 | fdb forth_core_semicolon
06A8: 0001 2146 | fdb .xt - .name
06AA: 3C 2147 | .name fcc "<"
06AB: 06AD 2148 | .xt fdb .body
06AD: EC 42 2149 | .body ldd 2,u
06AF: 10A3 C1 2150 | cmpd ,u++
06B2: 2D 04 2151 | blt .lessthan
06B4: 4F 2152 | clra
06B5: 5F 2153 | clrb
06B6: 20 03 2154 | bra .done
06B8: CC FFFF 2155 | .lessthan ldd #-1
06BB: ED C4 2156 | .done std ,u
06BD: AE A1 2157 | ldx ,y++ ; NEXT
06BF: 6E 94 2158 | jmp [,x]
2159 |
2160 | ;---------------------------------------
2161 |
2162 | .test "1 2 < ( TRUE )"
E3A0: CE E3AC 2163 | ldu #.datastack1
E3A3: 8E 06AB 2164 | ldx #forth_core_less_than.xt
E3A6: BD 0C04 2165 | jsr forth_core_execute.asm
2166 | .assert /u = .results1 , "U"
2167 | .assert @@/,u = -1 , "flag"
E3A9: 39 2168 | rts
2169 |
E3AA: 0000 2170 | fdb 0
E3AC: 0002 2171 | .datastack1 fdb 2
E3AE: 0001 2172 | .results1 fdb 1
2173 | .endtst
2174 |
2175 | ;---------------------------------------
2176 |
2177 | .test "2 1 < ( FALSE )"
E3B0: CE E3BC 2178 | ldu #.datastack2
E3B3: 8E 06AB 2179 | ldx #forth_core_less_than.xt
E3B6: BD 0C04 2180 | jsr forth_core_execute.asm
2181 | .assert /u = .results2 , "U"
2182 | .assert @@/,u = 0 , "flag"
E3B9: 39 2183 | rts
2184 |
E3BA: 0000 2185 | fdb 0
E3BC: 0001 2186 | .datastack2 fdb 1
E3BE: 0002 2187 | .results2 fdb 2
2188 | .endtst
2189 |
2190 | ;**********************************************************************
2191 |
06C1: 2192 | forth_core_less_number_sign ; ( -- )
06C1: 06A6 2193 | fdb forth_core_less_than
06C3: 0002 2194 | fdb .xt - .name
06C5: 3C23 2195 | .name fcc "<#"
06C7: 06C9 2196 | .xt fdb .body
06C9: DC 10 2197 | .body ldd forth__here ; space for HOLD
06CB: C3 0097 2198 | addd #SLASH_PAD + WORD_MAX + SLASH_HOLD
06CE: DD 2A 2199 | std forth__hold
06D0: AE A1 2200 | ldx ,y++
06D2: 6E 94 2201 | jmp [,x]
2202 |
2203 | ;**********************************************************************
2204 |
06D4: 2205 | forth_core_equals ; ( x1 x2 -- flag )
06D4: 06C1 2206 | fdb forth_core_less_number_sign
06D6: 0001 2207 | fdb .xt - .name
06D8: 3D 2208 | .name fcc "="
06D9: 06DB 2209 | .xt fdb .body
06DB: EC C1 2210 | .body ldd ,u++
06DD: 10A3 C4 2211 | cmpd ,u
06E0: 27 04 2212 | beq .equal
06E2: 4F 2213 | clra
06E3: 5F 2214 | clrb
06E4: 20 03 2215 | bra .done
06E6: CC FFFF 2216 | .equal ldd #-1
06E9: ED C4 2217 | .done std ,u
06EB: AE A1 2218 | ldx ,y++
06ED: 6E 94 2219 | jmp [,x]
2220 |
2221 | ;**********************************************************************
2222 |
06EF: 2223 | forth_core_greater_than ; ( n1 n2 -- flag )
06EF: 06D4 2224 | fdb forth_core_equals
06F1: 0001 2225 | fdb .xt - .name
06F3: 3E 2226 | .name fcc ">"
06F4: 06F6 2227 | .xt fdb .body
06F6: EC 42 2228 | .body ldd 2,u
06F8: 10A3 C1 2229 | cmpd ,u++
06FB: 2E 04 2230 | bgt .greaterthan
06FD: 4F 2231 | clra
06FE: 5F 2232 | clrb
06FF: 20 03 2233 | bra .done
0701: CC FFFF 2234 | .greaterthan ldd #-1
0704: ED C4 2235 | .done std ,u
0706: AE A1 2236 | ldx ,y++
0708: 6E 94 2237 | jmp [,x]
2238 |
2239 | ;---------------------------------------
2240 |
2241 | .test "1 2 > ( FALSE )"
E3C0: CE E3CC 2242 | ldu #.datastack1
E3C3: 8E 06F4 2243 | ldx #forth_core_greater_than.xt
E3C6: BD 0C04 2244 | jsr forth_core_execute.asm
2245 | .assert /u = .results1 , "U"
2246 | .assert @@/,u = 0 , "flag"
E3C9: 39 2247 | rts
2248 |
E3CA: 0000 2249 | fdb 0
E3CC: 0002 2250 | .datastack1 fdb 2
E3CE: 0001 2251 | .results1 fdb 1
2252 | .endtst
2253 |
2254 | ;---------------------------------------
2255 |
2256 | .test "2 1 > ( TRUE )"
E3D0: CE E3DC 2257 | ldu #.datastack2
E3D3: 8E 06F4 2258 | ldx #forth_core_greater_than.xt
E3D6: BD 0C04 2259 | jsr forth_core_execute.asm
2260 | .assert /u = .results2 , "U"
2261 | .assert @@/,u = -1 , "flag"
E3D9: 39 2262 | rts
2263 |
E3DA: 0000 2264 | fdb 0
E3DC: 0001 2265 | .datastack2 fdb 1
E3DE: 0002 2266 | .results2 fdb 2
2267 | .endtst
2268 |
2269 | ;**********************************************************************
2270 |
070A: 2271 | forth_core_to_body ; ( ( xt -- a-addr )
070A: 06EF 2272 | fdb forth_core_greater_than
070C: 0005 2273 | fdb .xt - .name
070E: 3E424F4459 2274 | .name fcc ">BODY"
0713: 0715 2275 | .xt fdb .body
0715: AE C4 2276 | .body ldx ,u
0717: 30 02 2277 | leax 2,x
0719: AF C4 2278 | stx ,u
071B: AE A1 2279 | ldx ,y++
071D: 6E 94 2280 | jmp [,x]
2281 |
2282 | ;**********************************************************************
2283 |
071F: 2284 | forth_core_to_in ; ( -- a-addr )
071F: 070A 2285 | fdb forth_core_to_body
0721: 0003 2286 | fdb .xt - .name
0723: 3E494E 2287 | .name fcc ">IN"
0726: 0728 2288 | .xt fdb .body
0728: CC 001A 2289 | .body ldd #forth__in
072B: 36 06 2290 | pshu d
072D: AE A1 2291 | ldx ,y++
072F: 6E 94 2292 | jmp [,x]
2293 |
2294 | ;**********************************************************************
2295 |
2296 | Pd set 5
2297 | Pc set 4
2298 | Pb set 3
2299 | Pa set 2
2300 | Pchar set 1
2301 | Pbase set 0
2302 |
2303 | Lde set 2
2304 | Lce set 1
2305 | Lbe set 0
2306 | Le set 0
2307 |
0731: 2308 | forth_core_to_number ; ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
0731: 071F 2309 | fdb forth_core_to_in
0733: 0007 2310 | fdb .xt - .name
0735: 3E4E554D4245... 2311 | .name fcc ">NUMBER"
073C: 073E 2312 | .xt fdb .body
073E: EC C4 2313 | .body ldd ,u ; check for < 1 length
0740: 27 73 2314 | beq .return ; if so, skip
0742: 2B 71 2315 | bmi .return ;
0744: 34 20 2316 | pshs y ; save register
0746: 32 7C 2317 | leas -4,s ; clear some tmp space
0748: 37 30 2318 | pulu y,x ; get c-addr u
074A: 96 1D 2319 | lda forth__base + 1
074C: 36 06 2320 | pshu d ; save base and space for character
074E: 6F E4 2321 | .read_char clr Lbe,s ; clear tmp space
0750: 6F 61 2322 | clr Lce,s
0752: E6 A4 2323 | ldb ,y ; get character
0754: C0 30 2324 | subb #'0' ; convert to digit
0756: 2B 55 2325 | bmi .done ; if not possible, done
0758: C1 09 2326 | cmpb #9
075A: 23 0C 2327 | bls .no_adjust
075C: C0 07 2328 | subb #7 ; adjust for letters
075E: C1 24 2329 | cmpb #36 ; where they upper case?
0760: 25 06 2330 | blo .no_adjust ; if so, we're fine
0762: C0 20 2331 | subb #32 ; check for lower case
0764: C1 24 2332 | cmpb #36 ; if not so, we're done
0766: 24 45 2333 | bhs .done
0768: E1 C4 2334 | .no_adjust cmpb Pbase,u ; > base?
076A: 24 41 2335 | bhs .done ; if so, done
076C: E7 41 2336 | stb Pchar,u ; save character
076E: A6 C4 2337 | lda Pbase,u ; base * D
0770: E6 45 2338 | ldb Pd,u
0772: 3D 2339 | mul
0773: ED 62 2340 | std Lde,s
0775: A6 C4 2341 | lda Pbase,u ; base * C
0777: E6 44 2342 | ldb Pc,u
0779: 3D 2343 | mul
077A: E3 61 2344 | addd Lce,s
077C: ED 61 2345 | std Lce,s
077E: A6 C4 2346 | lda Pbase,u ; base * B
0780: E6 43 2347 | ldb Pb,u
0782: 3D 2348 | mul
0783: E3 E4 2349 | addd Lbe,s
0785: ED E4 2350 | std Lbe,s
0787: A6 C4 2351 | lda Pbase,u ; base * A
0789: E6 42 2352 | ldb Pa,u
078B: 3D 2353 | mul
078C: EB E4 2354 | addb Le,s
078E: E7 E4 2355 | stb Le,s
0790: EC E4 2356 | ldd 0,s ; move result from temporary area
0792: ED 42 2357 | std Pa,u
0794: EC 62 2358 | ldd 2,s
0796: ED 44 2359 | std Pc,u
0798: 4F 2360 | clra ; add in character
0799: E6 41 2361 | ldb Pchar,u
079B: E3 44 2362 | addd Pc,u
079D: ED 44 2363 | std Pc,u
079F: EC 42 2364 | ldd Pa,u
07A1: C9 00 2365 | adcb #0
07A3: 89 00 2366 | adca #0
07A5: ED 42 2367 | std Pa,u
07A7: 31 21 2368 | leay 1,y
07A9: 30 1F 2369 | leax -1,x
07AB: 26 A1 2370 | bne .read_char
07AD: 33 42 2371 | .done leau 2,u
07AF: 32 64 2372 | leas 4,s
07B1: 36 30 2373 | pshu y,x
07B3: 35 20 2374 | puls y
07B5: AE A1 2375 | .return ldx ,y++
07B7: 6E 94 2376 | jmp [,x]
2377 |
2378 | ;----------------------------------------------
2379 |
2380 | .test ">NUMBER 0"
2381 | .opt test prot n , .nu0
2382 | .opt test pokew forth__base , 10
E3E0: CE E3EC 2383 | ldu #.datastack0
E3E3: 8E 073C 2384 | ldx #forth_core_to_number.xt
E3E6: BD 0C04 2385 | jsr forth_core_execute.asm
2386 | .assert /u = .datastack0 , "U"
2387 | .assert @@/0,u = .len0 - 1 , "len"
2388 | .assert @@/2,u = .text0 + 1 , "text"
2389 | .assert @@/4,u = 0 , "MSW"
2390 | .assert @@/6,u = 0 , "LSW"
E3E9: 39 2391 | rts
2392 |
E3EA: 0000 2393 | fdb 0
E3EC: 0001 2394 | .datastack0 fdb .len0
E3EE: E3F5 2395 | fdb .text0
E3F0: 0000 2396 | fdb 0
E3F2: 0000 2397 | fdb 0
2398 |
E3F4: 00 2399 | .nu0 fcb 0
E3F5: 30 2400 | .text0 fcc '0'
2401 | .len0 equ * - .text0
2402 | .endtst
2403 |
2404 | ;-------------------------------------------
2405 |
2406 | .test ">NUMBER 1"
2407 | .opt test prot n , .nu1
2408 | .opt test pokew forth__base , 10
E3F6: CE E402 2409 | ldu #.datastack1
E3F9: 8E 073C 2410 | ldx #forth_core_to_number.xt
E3FC: BD 0C04 2411 | jsr forth_core_execute.asm
2412 | .assert /u = .datastack1 , "U"
2413 | .assert @@/0,u = .len1 - 1 , "len"
2414 | .assert @@/2,u = .text1 + 1 , "text"
2415 | .assert @@/4,u = 0 , "MSW"
2416 | .assert @@/6,u = 1 , "LSW"
E3FF: 39 2417 | rts
2418 |
E400: 0000 2419 | fdb 0
E402: 0007 2420 | .datastack1 fdb .len1
E404: E40B 2421 | fdb .text1
E406: 0000 2422 | fdb 0
E408: 0000 2423 | fdb 0
2424 |
E40A: 00 2425 | .nu1 fcb 0
E40B: 312020202020... 2426 | .text1 fcc '1 '
2427 | .len1 equ * - .text1
2428 | .endtst
2429 |
2430 | ;-------------------------------------------
2431 |
2432 | .test ">NUMBER 65535"
2433 | .opt test prot n , .nu2
2434 | .opt test pokew forth__base , 10
E412: CE E41E 2435 | ldu #.datastack2
E415: 8E 073C 2436 | ldx #forth_core_to_number.xt
E418: BD 0C04 2437 | jsr forth_core_execute.asm
2438 | .assert /u = .datastack2 , "U"
2439 | .assert @@/0,u = .len2 - 5 , "len"
2440 | .assert @@/2,u = .text2 + 5 , "text"
2441 | .assert @@/4,u = 0 , "MSW"
2442 | .assert @@/6,u = $FFFF , "LSW"
E41B: 39 2443 | rts
2444 |
E41C: 0000 2445 | fdb 0
E41E: 0006 2446 | .datastack2 fdb .len2
E420: E427 2447 | fdb .text2
E422: 0000 2448 | fdb 0
E424: 0000 2449 | fdb 0
2450 |
E426: 00 2451 | .nu2 fcb 0
E427: 363535333520 2452 | .text2 fcc '65535 '
2453 | .len2 equ * - .text2
2454 | .endtst
2455 |
2456 | ;-------------------------------------------
2457 |
2458 | .test ">NUMBER 17373113"
2459 | .opt test prot n , .nu3
2460 | .opt test pokew forth__base , 10
E42D: CE E439 2461 | ldu #.datastack3
E430: 8E 073C 2462 | ldx #forth_core_to_number.xt
E433: BD 0C04 2463 | jsr forth_core_execute.asm
2464 | .assert /u = .datastack3 , "U"
2465 | .assert @@/0,u = .len3 - 8 , "len"
2466 | .assert @@/2,u = .text3 + 8 , "text"
2467 | .assert @@/4,u = $0109 , "MSW"
2468 | .assert @@/6,u = $17B9 , "LSW"
E436: 39 2469 | rts
2470 |
E437: 0000 2471 | fdb 0
E439: 0009 2472 | .datastack3 fdb .len3
E43B: E442 2473 | fdb .text3
E43D: 0000 2474 | fdb 0
E43F: 0000 2475 | fdb 0
2476 |
E441: 00 2477 | .nu3 fcb 0
E442: 313733373331... 2478 | .text3 fcc '17373113.'
2479 | .len3 equ * - .text3
2480 | .endtst
2481 |
2482 | ;--------------------------------------------
2483 |
2484 | .test ">NUMBER 89ABCDEF ( HEX )"
2485 | .opt test prot n , .nu4
2486 | .opt test pokew forth__base , 16
E44B: CE E457 2487 | ldu #.datastack4
E44E: 8E 073C 2488 | ldx #forth_core_to_number.xt
E451: BD 0C04 2489 | jsr forth_core_execute.asm
2490 | .assert /u
2491 | .assert @@/0,u = .len4 - 8 , "len"
2492 | .assert @@/2,u = .text4 + 8 , "text"
2493 | .assert @@/4,u = $89AB , "MSW"
2494 | .assert @@/6,u = $CDEF , "LSW"
E454: 39 2495 | rts
2496 |
E455: 0000 2497 | fdb 0
E457: 0009 2498 | .datastack4 fdb .len4
E459: E460 2499 | fdb .text4
E45B: 0000 2500 | fdb 0
E45D: 0000 2501 | fdb 0
2502 |
E45F: 00 2503 | .nu4 fcb 0
E460: 383961626364... 2504 | .text4 fcc '89abcdef '
2505 | .len4 equ * - .text4
2506 | .endtst
2507 |
2508 | ;--------------------------------------------
2509 |
2510 | .test ">NUMBER g00 (fails)"
2511 | .opt test prot n , .nu5
2512 | .opt test pokew forth__base , 10
E469: CE E475 2513 | ldu #.datastack5
E46C: 8E 073C 2514 | ldx #forth_core_to_number.xt
E46F: BD 0C04 2515 | jsr forth_core_execute.asm
2516 | .assert /u
2517 | .assert @@/0,u = .len5 , "len"
2518 | .assert @@/2,u = .text5 , "text"
2519 | .assert @@/4,u = 0 , "MSW"
2520 | .assert @@/6,u = 0 , "LSW"
E472: 39 2521 | rts
2522 |
E473: 0000 2523 | fdb 0
E475: 0004 2524 | .datastack5 fdb .len5
E477: E47E 2525 | fdb .text5
E479: 0000 2526 | fdb 0
E47B: 0000 2527 | fdb 0
2528 |
E47D: 00 2529 | .nu5 fcb 0
E47E: 67303020 2530 | .text5 fcc 'g00 '
2531 | .len5 equ * - .text5
2532 | .endtst
2533 |
2534 | ;**********************************************************************
2535 |
07B9: 2536 | forth_core_to_r ; E ( x -- ) ( R: -- x )
07B9: 0731 2537 | fdb forth_core_to_number
07BB: 0002 2538 | fdb .xt - .name
07BD: 3E52 2539 | .name fcc ">R"
07BF: 07C1 2540 | .xt fdb .body
07C1: 37 06 2541 | .body pulu d
07C3: 34 06 2542 | pshs d
07C5: AE A1 2543 | ldx ,y++
07C7: 6E 94 2544 | jmp [,x]
2545 |
2546 | ;**********************************************************************
2547 |
07C9: 2548 | forth_core_question_dupe ; ( x -- 0 | x x )
07C9: 07B9 2549 | fdb forth_core_to_r
07CB: 0004 2550 | fdb .xt - .name
07CD: 3F445550 2551 | .name fcc "?DUP"
07D1: 07D3 2552 | .xt fdb .body
07D3: EC C4 2553 | .body ldd ,u
07D5: 27 02 2554 | beq .done
07D7: 36 06 2555 | pshu d
07D9: AE A1 2556 | .done ldx ,y++
07DB: 6E 94 2557 | jmp [,x]
2558 |
2559 | ;**********************************************************************
2560 |
07DD: 2561 | forth_core_fetch ; ( a-addr -- x )
07DD: 07C9 2562 | fdb forth_core_question_dupe
07DF: 0001 2563 | fdb .xt - .name
07E1: 40 2564 | .name fcc "@"
07E2: 07E4 2565 | .xt fdb .body
07E4: EC D4 2566 | .body ldd [,u]
07E6: ED C4 2567 | std ,u
07E8: AE A1 2568 | ldx ,y++
07EA: 6E 94 2569 | jmp [,x]
2570 |
2571 | ;**********************************************************************
2572 | ;
2573 | ;forth_core_abort ; EXCEPTION EXT ABORT
2574 | ; fdb forth_core_fetch
2575 | ; fdb .xt - .name
2576 | ;.name fcc "ABORT"
2577 | ;.xt fdb forth_core_colon.runtime
2578 | ; fdb forth_core_literal.runtime_xt
2579 | ; fdb -13
2580 | ; fdb forth_exception_throw.xt
2581 | ;
2582 | ;**********************************************************************
2583 | ;
2584 | ;forth_core_abort_quote ; EXCEPTION EXT ABORT"
2585 | ; fdb forth_core_abort
2586 | ; fdb _IMMED | _NOINTERP :: .xt - .name
2587 | ;.name fcc 'ABORT"'
2588 | ;.xt fdb forth_core_colon.runtime
2589 | ; fdb forth_core_literal.runtime_xt
2590 | ; fdb -13
2591 | ; fdb forth_exception_throw.xt
2592 | ;
2593 | ;**********************************************************************
2594 |
07EC: 2595 | forth_core_abs ; ( n -- u )
07EC: 07DD 2596 | fdb forth_core_fetch
07EE: 0003 2597 | fdb .xt - .name
07F0: 414253 2598 | .name fcc "ABS"
07F3: 0678 2599 | .xt fdb forth_core_colon.runtime
2600 | ;============================================
2601 | ; : ABS DUP 0< IF NEGATE THEN ;
2602 | ;======================================
07F5: 0A74 2603 | fdb forth_core_dupe.xt
07F7: 056E 2604 | fdb forth_core_zero_less.xt
07F9: 0CD1 2605 | fdb forth_core_if.runtime_xt
07FB: 07FF 2606 | fdb .L1
07FD: 0E7C 2607 | fdb forth_core_negate.xt
07FF: 0C1A 2608 | .L1 fdb forth_core_exit.xt
2609 |
2610 | ;**********************************************************************
2611 |
0801: 2612 | forth_core_accept ; ( c-addr +n1 -- +n2 )
0801: 07EC 2613 | fdb forth_core_abs
0803: 0006 2614 | fdb .xt - .name
0805: 414343455054 2615 | .name fcc "ACCEPT"
080B: 0678 2616 | .xt fdb forth_core_colon.runtime
2617 | ;===============================================
2618 | ; : ACCEPT
2619 | ; DUP 1 < IF -256 THROW THEN
2620 | ; DUP >R 0 DO
2621 | ; KEY DUP 10 = IF
2622 | ; DROP I UNLOOP R> DROP NIP EXIT
2623 | ; THEN OVER C! CHAR+
2624 | ; LOOP DROP R> ;
2625 | ;==============================================
080D: 0A74 2626 | fdb forth_core_dupe.xt
080F: 0D84 2627 | fdb forth_core_literal.runtime_xt
0811: 0001 2628 | fdb 1
0813: 06AB 2629 | fdb forth_core_less_than.xt
0815: 0CD1 2630 | fdb forth_core_if.runtime_xt
0817: 081F 2631 | fdb .L1
0819: 0D84 2632 | fdb forth_core_literal.runtime_xt
081B: FF00 2633 | fdb -256
081D: 1E8A 2634 | fdb forth_exception_throw.xt
081F: 0A74 2635 | .L1 fdb forth_core_dupe.xt
0821: 07BF 2636 | fdb forth_core_to_r.xt
0823: 0D84 2637 | fdb forth_core_literal.runtime_xt
0825: 0000 2638 | fdb 0
0827: 0A2A 2639 | fdb forth_core_do.runtime_xt
0829: 0D2B 2640 | .L2 fdb forth_core_key.xt
082B: 0A74 2641 | fdb forth_core_dupe.xt
082D: 0D84 2642 | fdb forth_core_literal.runtime_xt
082F: 000A 2643 | fdb 10
0831: 06D9 2644 | fdb forth_core_equals.xt
0833: 0CD1 2645 | fdb forth_core_if.runtime_xt
0835: 0845 2646 | fdb .L3
0837: 0A65 2647 | fdb forth_core_drop.xt
0839: 0CAC 2648 | fdb forth_core_i.xt
083B: 11AB 2649 | fdb forth_core_unloop.xt
083D: 0FAA 2650 | fdb forth_core_r_from.xt
083F: 0A65 2651 | fdb forth_core_drop.xt
0841: 1649 2652 | fdb forth_core_ext_nip.xt
0843: 0C1A 2653 | fdb forth_core_exit.xt
0845: 0EA4 2654 | .L3 fdb forth_core_over.xt
0847: 08D3 2655 | fdb forth_core_c_store.xt
0849: 094D 2656 | fdb forth_core_char_plus.xt
084B: 0D9E 2657 | fdb forth_core_loop.runtime_xt
084D: 0829 2658 | fdb .L2
084F: 0A65 2659 | fdb forth_core_drop.xt
0851: 0FAA 2660 | fdb forth_core_r_from.xt
0853: 0C1A 2661 | fdb forth_core_exit.xt
2662 |
2663 | ;-----------------------------------------------
2664 |
2665 | .test "ACCEPT"
2666 | .opt test prot n , .nu1
2667 | .opt test prot n , .nu2
2668 | .opt test pokew forth__vector_getchar , .getchar
E482: CE E49A 2669 | ldu #.datastack
E485: 8E 080B 2670 | ldx #forth_core_accept.xt
E488: BD 0C04 2671 | jsr forth_core_execute.asm
2672 | .assert /u = .result , "U"
2673 | .assert @@/0,u = 3 , "len"
E48B: 39 2674 | rts
2675 |
E48C: 0000 2676 | fdb 0
E48E: 0000 2677 | fdb 0
E490: 0000 2678 | fdb 0
E492: 0000 2679 | fdb 0
E494: 0000 2680 | fdb 0
E496: 0000 2681 | fdb 0
E498: 0000 2682 | fdb 0
E49A: 000A 2683 | .datastack fdb .len
E49C: E49F 2684 | .result fdb .buffer
2685 |
E49E: 00 2686 | .nu1 fcb 0
E49F: 2687 | .buffer rmb 10
2688 | .len equ * - .buffer
2689 |
E4A9: 34 10 2690 | .getchar pshs x
E4AB: BE E4B6 2691 | ldx .input
E4AE: 4F 2692 | clra
E4AF: E6 80 2693 | ldb ,x+
E4B1: BF E4B6 2694 | stx .input
E4B4: 35 90 2695 | puls x,pc
E4B6: E4B8 2696 | .input fdb .inputbuf
E4B8: 4259450A 2697 | .inputbuf ascii 'BYE\n'
E4BC: 00 2698 | .nu2 fcb 0
2699 | .endtst
2700 |
2701 | ;**********************************************************************
2702 |
0855: 2703 | forth_core_align ; ( -- )
0855: 0801 2704 | fdb forth_core_accept
0857: 0005 2705 | fdb .xt - .name
0859: 414C49474E 2706 | .name fcc "ALIGN"
085E: 0678 2707 | .xt fdb forth_core_colon.runtime
2708 | ;=============================================
2709 | ; : ALIGN ;
2710 | ;=============================================
0860: 0C1A 2711 | fdb forth_core_exit.xt
2712 |
2713 | ;**********************************************************************
2714 |
0862: 2715 | forth_core_aligned ; ( addr -- a-addr )
0862: 0855 2716 | fdb forth_core_align
0864: 0007 2717 | fdb .xt - .name
0866: 414C49474E45... 2718 | .name fcc "ALIGNED"
086D: 0678 2719 | .xt fdb forth_core_colon.runtime
2720 | ;===========================================
2721 | ; : ALIGNED ;
2722 | ;===========================================
086F: 0C1A 2723 | fdb forth_core_exit.xt
2724 |
2725 | ;**********************************************************************
2726 |
0871: 2727 | forth_core_allot ; ( n -- )
0871: 0862 2728 | fdb forth_core_aligned
0873: 0005 2729 | fdb .xt - .name
0875: 414C4C4F54 2730 | .name fcc "ALLOT"
087A: 087C 2731 | .xt fdb .body
087C: EC C1 2732 | .body ldd ,u++
087E: 27 04 2733 | beq .done
0880: D3 10 2734 | addd forth__here
0882: DD 10 2735 | std forth__here
0884: AE A1 2736 | .done ldx ,y++
0886: 6E 94 2737 | jmp [,x]
2738 |
2739 | ;**********************************************************************
2740 |
0888: 2741 | forth_core_and ; ( x1 x2 -- x3 )
0888: 0871 2742 | fdb forth_core_allot
088A: 0003 2743 | fdb .xt - .name
088C: 414E44 2744 | .name fcc "AND"
088F: 0891 2745 | .xt fdb .body
0891: 37 06 2746 | .body pulu d
0893: A4 C4 2747 | anda ,u
0895: E4 41 2748 | andb 1,u
0897: ED C4 2749 | std ,u
0899: AE A1 2750 | ldx ,y++
089B: 6E 94 2751 | jmp [,x]
2752 |
2753 | ;**********************************************************************
2754 |
089D: 2755 | forth_core_base ; ( -- a-addr )
089D: 0888 2756 | fdb forth_core_and
089F: 0004 2757 | fdb .xt - .name
08A1: 42415345 2758 | .name fcc "BASE"
08A5: 08A7 2759 | .xt fdb .body
08A7: CC 001C 2760 | .body ldd #forth__base
08AA: 36 06 2761 | pshu d
08AC: AE A1 2762 | ldx ,y++
08AE: 6E 94 2763 | jmp [,x]
2764 |
2765 | ;**********************************************************************
2766 |
08B0: 2767 | forth_core_begin ; C ( C: -- dest ) R ( -- )
08B0: 089D 2768 | fdb forth_core_base
08B2: A005 2769 | fdb _IMMED | _NOINTERP :: .xt - .name
08B4: 424547494E 2770 | .name fcc "BEGIN"
08B9: 08BB 2771 | .xt fdb .body
08BB: DC 10 2772 | .body ldd forth__here ; jump back here
08BD: 36 06 2773 | pshu d
08BF: AE A1 2774 | ldx ,y++ ; NEXT
08C1: 6E 94 2775 | jmp [,x]
2776 |
2777 | ;**********************************************************************
2778 |
08C3: 2779 | forth_core_b_l ; ( -- char )
08C3: 08B0 2780 | fdb forth_core_begin
08C5: 0002 2781 | fdb .xt - .name
08C7: 424C 2782 | .name fcc "BL"
08C9: 097A 2783 | .xt fdb forth_core_constant.does
2784 | ;=======================================
2785 | ; 32 CONSTANT BL
2786 | ;=======================================
08CB: 0020 2787 | fdb 32
2788 |
2789 | ;--------------------------------------
2790 |
2791 | .test "BL"
E4BD: CE E4C9 2792 | ldu #.datastack
E4C0: 8E 08C9 2793 | ldx #forth_core_b_l.xt
E4C3: BD 0C04 2794 | jsr forth_core_execute.asm
2795 | .assert /u = .result
2796 | .assert @@/,u = 32
E4C6: 39 2797 | rts
2798 |
E4C7: 0000 2799 | .result fdb 0
E4C9: 0000 2800 | .datastack fdb 0
2801 | .endtst
2802 |
2803 | ;**********************************************************************
2804 |
08CD: 2805 | forth_core_c_store ; ( c c-addr -- )
08CD: 08C3 2806 | fdb forth_core_b_l
08CF: 0002 2807 | fdb .xt - .name
08D1: 4321 2808 | .name fcc "C!"
08D3: 08D5 2809 | .xt fdb .body
08D5: AE C1 2810 | .body ldx ,u++
08D7: EC C1 2811 | ldd ,u++
08D9: E7 84 2812 | stb ,x
08DB: AE A1 2813 | ldx ,y++
08DD: 6E 94 2814 | jmp [,x]
2815 |
2816 | ;**********************************************************************
2817 |
08DF: 2818 | forth_core_c_comma ; ( char -- )
08DF: 08CD 2819 | fdb forth_core_c_store
08E1: 0002 2820 | fdb .xt - .name
08E3: 432C 2821 | .name fcc "C,"
08E5: 08E7 2822 | .xt fdb .body
08E7: 37 06 2823 | .body pulu d
08E9: 9E 10 2824 | ldx forth__here
08EB: E7 80 2825 | stb ,x+
08ED: 9F 10 2826 | stx forth__here
08EF: AE A1 2827 | ldx ,y++
08F1: 6E 94 2828 | jmp [,x]
2829 |
2830 | ;**********************************************************************
2831 |
08F3: 2832 | forth_core_c_fetch ; ( c-addr -- char )
08F3: 08DF 2833 | fdb forth_core_c_comma
08F5: 0002 2834 | fdb .xt - .name
08F7: 4340 2835 | .name fcc "C@"
08F9: 08FB 2836 | .xt fdb .body
08FB: AE C4 2837 | .body ldx ,u
08FD: 4F 2838 | clra
08FE: E6 84 2839 | ldb ,x
0900: ED C4 2840 | std ,u
0902: AE A1 2841 | ldx ,y++
0904: 6E 94 2842 | jmp [,x]
2843 |
2844 | ;**********************************************************************
2845 |
0906: 2846 | forth_core_cell_plus ; ( a-addr1 -- a-addr2 )
0906: 08F3 2847 | fdb forth_core_c_fetch
0908: 0005 2848 | fdb .xt - .name
090A: 43454C4C2B 2849 | .name fcc "CELL+"
090F: 0911 2850 | .xt fdb .body
0911: AE C4 2851 | .body ldx ,u
0913: 30 02 2852 | leax 2,x
0915: AF C4 2853 | stx ,u
0917: AE A1 2854 | ldx ,y++
0919: 6E 94 2855 | jmp [,x]
2856 |
2857 | ;**********************************************************************
2858 |
091B: 2859 | forth_core_cells ; ( n1 -- n2)
091B: 0906 2860 | fdb forth_core_cell_plus
091D: 0005 2861 | fdb .xt - .name
091F: 43454C4C53 2862 | .name fcc "CELLS"
0924: 0926 2863 | .xt fdb .body
0926: EC C4 2864 | .body ldd ,u
0928: E3 C4 2865 | addd ,u
092A: ED C4 2866 | std ,u
092C: AE A1 2867 | ldx ,y++
092E: 6E 94 2868 | jmp [,x]
2869 |
2870 | ;**********************************************************************
2871 |
0930: 2872 | forth_core_char ; ( "name" -- )
0930: 091B 2873 | fdb forth_core_cells
0932: 0004 2874 | fdb .xt - .name
0934: 43484152 2875 | .name fcc "CHAR"
0938: 0678 2876 | .xt fdb forth_core_colon.runtime
2877 | ;=======================================
2878 | ; : CHAR BL WORD CHAR+ C@ ;
2879 | ;=======================================
093A: 08C9 2880 | fdb forth_core_b_l.xt
093C: 1217 2881 | fdb forth_core_word.xt
093E: 094D 2882 | fdb forth_core_char_plus.xt
0940: 08F9 2883 | fdb forth_core_c_fetch.xt
0942: 0C1A 2884 | fdb forth_core_exit.xt
2885 |
2886 | ;**********************************************************************
2887 |
0944: 2888 | forth_core_char_plus ; ( c-addr1 -- c-addr2 )
0944: 0930 2889 | fdb forth_core_char
0946: 0005 2890 | fdb .xt - .name
0948: 434841522B 2891 | .name fcc "CHAR+"
094D: 094F 2892 | .xt fdb .body
094F: AE C4 2893 | .body ldx ,u
0951: 30 01 2894 | leax 1,x
0953: AF C4 2895 | stx ,u
0955: AE A1 2896 | ldx ,y++
0957: 6E 94 2897 | jmp [,x]
2898 |
2899 | ;**********************************************************************
2900 |
0959: 2901 | forth_core_chars ; ( n1 -- n2 )
0959: 0944 2902 | fdb forth_core_char_plus
095B: 0005 2903 | fdb .xt - .name
095D: 4348415253 2904 | .name fcc "CHARS"
0962: 0678 2905 | .xt fdb forth_core_colon.runtime
2906 | ;===================================
2907 | ; : CHARS ;
2908 | ;===================================
0964: 0C1A 2909 | fdb forth_core_exit.xt
2910 |
2911 | ;**********************************************************************
2912 |
0966: 2913 | forth_core_constant ; ( x "name" -- ) E ( -- )
0966: 0959 2914 | fdb forth_core_chars
0968: 0008 2915 | fdb .xt - .name
096A: 434F4E535441... 2916 | .name fcc "CONSTANT"
0972: 0678 2917 | .xt fdb forth_core_colon.runtime
2918 | ;=======================================
2919 | ; : CONSTANT CREATE , DOES> @ ;
2920 | ;=======================================
0974: 09B2 2921 | fdb forth_core_create.xt
0976: 04F3 2922 | fdb forth_core_comma.xt
0978: 0A50 2923 | fdb forth_core_does.runtime_xt ; also EXIT is here
097A: BD 09BD 2924 | .does jsr forth_core_create.does_hook
097D: 07E2 2925 | fdb forth_core_fetch.xt
097F: 0C1A 2926 | fdb forth_core_exit.xt
2927 |
2928 | ;**********************************************************************
2929 |
0981: 2930 | forth_core_count ; ( c-addr1 -- c-addr2 u )
0981: 0966 2931 | fdb forth_core_constant
0983: 0005 2932 | fdb .xt - .name
0985: 434F554E54 2933 | .name fcc "COUNT"
098A: 0678 2934 | .xt fdb forth_core_colon.runtime
2935 | ;============================================
2936 | ; : COUNT DUP C@ SWAP CHAR+ SWAP ;
2937 | ;============================================
098C: 0A74 2938 | fdb forth_core_dupe.xt
098E: 08F9 2939 | fdb forth_core_c_fetch.xt
0990: 10FC 2940 | fdb forth_core_swap.xt
0992: 094D 2941 | fdb forth_core_char_plus.xt
0994: 10FC 2942 | fdb forth_core_swap.xt
0996: 0C1A 2943 | fdb forth_core_exit.xt
2944 |
2945 | ;**********************************************************************
2946 |
0998: 2947 | forth_core_c_r ; ( -- )
0998: 0981 2948 | fdb forth_core_count
099A: 0002 2949 | fdb .xt - .name
099C: 4352 2950 | .name fcc "CR"
099E: 0678 2951 | .xt fdb forth_core_colon.runtime
2952 | ;======================================
2953 | ; : CR 10 EMIT ;
2954 | ;======================================
09A0: 0D84 2955 | fdb forth_core_literal.runtime_xt
09A2: 000A 2956 | fdb NL
09A4: 0A9C 2957 | fdb forth_core_emit.xt
09A6: 0C1A 2958 | fdb forth_core_exit.xt
2959 |
2960 | ;**********************************************************************
2961 |
09A8: 2962 | forth_core_create ; ( "name" -- ) E ( -- a-addr )
09A8: 0998 2963 | fdb forth_core_c_r
09AA: 0006 2964 | fdb .xt - .name
09AC: 435245415445 2965 | .name fcc "CREATE"
09B2: 09B4 2966 | .xt fdb .body
2967 |
09B4: 8E 16E6 2968 | .body ldx #forth_core_ext_parse_name.xt ; PARSE-NAME
09B7: 17 024A 2969 | lbsr forth_core_execute.asm
09BA: 16 F787 2970 | lbra forth__private_create_quote_xt.body
2971 |
09BD: 35 06 2972 | .does_hook puls d ; see DOES> for an explanation
09BF: 34 20 2973 | pshs y ; of this code.
09C1: 1F 02 2974 | tfr d,y
09C3: 30 02 2975 | .runtime leax 2,x
09C5: 36 10 2976 | pshu x
09C7: AE A1 2977 | ldx ,y++ ; NEXT
09C9: 6E 94 2978 | jmp [,x]
2979 |
2980 | ;---------------------------------------
2981 |
2982 | .test "CREATE"
2983 | .opt test pokew forth__source , .buffer
2984 | .opt test pokew forth__source_len , .len
2985 | .opt test pokew forth__in , 0
2986 | .opt test pokew forth__current_wid , .wid
2987 | .opt test pokew forth__here , .bar_link
E4CB: CE E4DB 2988 | ldu #.datastack
E4CE: 8E 09B2 2989 | ldx #forth_core_create.xt
E4D1: BD 0C04 2990 | jsr forth_core_execute.asm
2991 | .assert @@.wid = .bar_link , "wid"
2992 | .assert @@forth__create_name = .bar_len , "forth__create_name"
2993 | .assert @@forth__create_xt = .bar_xt , "forth__create_xt"
2994 | .assert @@.bar_link = .foo , "bar_link"
2995 | .assert @@.bar_xt = forth_core_create.runtime , "xt"
2996 | .assert @@.bar_body = 3 , "bar_body"
2997 | .assert @@.bar_len = 3 , "name length"
2998 | .assert .bar_name = "bar" , "name"
E4D4: 39 2999 | rts
3000 |
E4D5: FFFA 3001 | fdb -6
E4D7: FFFC 3002 | fdb -4
E4D9: FFFE 3003 | fdb -2
E4DB: 0000 3004 | .datastack fdb 0
3005 |
E4DD: 62617220 3006 | .buffer fcc 'bar '
3007 | .len equ * - .buffer
3008 |
E4E1: E4E3 3009 | .wid fdb .foo
E4E3: 0000 3010 | .foo fdb 0
E4E5: 0003 3011 | fdb .foo_xt - .foo_name
E4E7: 666F6F 3012 | .foo_name fcc 'foo'
E4EA: 0678 3013 | .foo_xt fdb forth_core_colon.runtime
E4EC: 0C1A 3014 | fdb forth_core_exit.xt
3015 |
E4EE: 0000 3016 | .bar_link fdb 0
E4F0: 0000 3017 | .bar_len fdb 0
E4F2: 000000 3018 | .bar_name fcb 0,0,0
E4F5: 0000 3019 | .bar_xt fdb 0
E4F7: 0003 3020 | .bar_body fdb 3
3021 | .endtst
3022 |
3023 | ;**********************************************************************
3024 |
09CB: 3025 | forth_core_decimal ; ( -- )
09CB: 09A8 3026 | fdb forth_core_create
09CD: 0007 3027 | fdb .xt - .name
09CF: 444543494D41... 3028 | .name fcc "DECIMAL"
09D6: 0678 3029 | .xt fdb forth_core_colon.runtime
3030 | ;=========================================
3031 | ; : DECIMAL 10 BASE ! ;
3032 | ;=========================================
09D8: 0D84 3033 | fdb forth_core_literal.runtime_xt
09DA: 000A 3034 | fdb 10
09DC: 08A5 3035 | fdb forth_core_base.xt
09DE: 0377 3036 | fdb forth_core_store.xt
09E0: 0C1A 3037 | fdb forth_core_exit.xt
3038 |
3039 | ;**********************************************************************
3040 |
09E2: 3041 | forth_core_depth ; ( -- +n )
09E2: 09CB 3042 | fdb forth_core_decimal
09E4: 0005 3043 | fdb .xt - .name
09E6: 4445505448 3044 | .name fcc "DEPTH"
09EB: 09ED 3045 | .xt fdb .body
09ED: 17 F70E 3046 | .body lbsr forth__util_check_ds
09F0: 34 40 3047 | pshs u ; save current address
09F2: DC 08 3048 | ldd forth__ds_top ; get top
09F4: A3 E1 3049 | subd ,s++ ; subtract current address, getting length
09F6: 44 3050 | lsra
09F7: 56 3051 | rorb
09F8: 36 06 3052 | pshu d ; return to user
09FA: AE A1 3053 | ldx ,y++ ; NEXT
09FC: 6E 94 3054 | jmp [,x]
3055 |
3056 | ;**********************************************************************
3057 |
09FE: 3058 | forth_core_do ; ( C: -- do-sys ) ( n1|u1 n2|u2 -- ) ( R: -- loop-sys )
09FE: 09E2 3059 | fdb forth_core_depth
0A00: A002 3060 | fdb _IMMED | _NOINTERP :: .xt - .name
0A02: 444F 3061 | .name fcc "DO"
0A04: 0A06 3062 | .xt fdb .body
0A06: 9E 58 3063 | .body ldx forth__leave_sp
0A08: 8C 006A 3064 | cmpx #forth__leave_stack + 16
0A0B: 27 17 3065 | beq .throw_toodeep
0A0D: 4F 3066 | clra
0A0E: 5F 3067 | clrb
0A0F: ED 81 3068 | std ,x++
0A11: 9F 58 3069 | stx forth__leave_sp
0A13: 9E 10 3070 | ldx forth__here ; lay down runtime xt
0A15: CC 0A2A 3071 | ldd #.runtime_xt
0A18: ED 81 3072 | std ,x++
0A1A: 9F 10 3073 | stx forth__here ; update compile location
0A1C: 4F 3074 | clra ; no c-orig
0A1D: 5F 3075 | clrb
0A1E: 36 16 3076 | pshu x,d ; push u-dest c-orig
0A20: AE A1 3077 | ldx ,y++ ; NEXT
0A22: 6E 94 3078 | jmp [,x]
0A24: CC FFF9 3079 | .throw_toodeep ldd #-7
0A27: 16 1490 3080 | lbra forth_exception_throw.asm
3081 |
0A2A: 0A2C 3082 | .runtime_xt fdb .runtime
0A2C: 7E 1336 3083 | .runtime jmp forth_core_ext_two_to_r.body
3084 |
3085 | ;**********************************************************************
3086 | ; DOES>
3087 | ;
3088 | ; This functionality of this word happens at three different times:
3089 | ;
3090 | ; : FOO CREATE ... DOES> ( time 1 ) ... ;
3091 | ; ... FOO BAR ( time 2 ) ...
3092 | ; BAR ( time 3 )
3093 | ;
3094 | ; Time 1: DOES> is called. It will compile the xt to its runtime action,
3095 | ; forth_core_does.runtime_xt, followed by a direct JSR call to
3096 | ; forth_core_create.does_hook. DOES> then returns, and since we are
3097 | ; still in compile mode, the code following DOES> is compiled into
3098 | ; FOO. It looks like:
3099 | ;
3100 | ; [...]
3101 | ; [forth_core_does.runtime_xt]
3102 | ; JSR forth_core_create.does_hook
3103 | ; [...]
3104 | ;
3105 | ; Time 2: FOO is called. At some point, we hit forth_core_does.runtime_xt,
3106 | ; which then pulls the next address off the return stack (it's the
3107 | ; address of the "JSR forth_core_create.does_hook" instruction). This
3108 | ; is used to update the xt field of the newly created word, and
3109 | ; then causes FOO to return, since we're now done with FOO.
3110 | ;
3111 | ; Before time 2:
3112 | ; link header of BAR
3113 | ; [forth_core_create.runtime]
3114 | ; [...]
3115 | ; After time 2:
3116 | ; link header of BAR
3117 | ; [address of "JSR forth_core_create.does_hook" in FOO]
3118 | ; [...]
3119 | ;
3120 | ; Time 3: BAR is called. This runs forth_core_create.does_hook, which
3121 | ; pushes the address of BAR's >BODY, then run the code that follows
3122 | ; DOES> in FOO's definition.
3123 | ;
3124 | ; Yes, this is mind bending. You're welcome.
3125 | ;
3126 | ;**********************************************************************
3127 |
0A2F: 3128 | forth_core_does ; C ( C: colon-sys1 -- colon-sys2 ) R ( -- ) ( R: nest-sys1 -- )
0A2F: 09FE 3129 | fdb forth_core_do
0A31: A005 3130 | fdb _IMMED | _NOINTERP :: .xt - .name
0A33: 444F45533E 3131 | .name fcc "DOES>"
0A38: 0A3A 3132 | .xt fdb .body
0A3A: 9E 10 3133 | .body ldx forth__here ; get current comp location
0A3C: CC 0A50 3134 | ldd #.runtime_xt ; set up for time 2.
0A3F: ED 81 3135 | std ,x++
0A41: 86 BD 3136 | lda #$BD ; compile JSR
0A43: A7 80 3137 | sta ,x+
0A45: CC 09BD 3138 | ldd #forth_core_create.does_hook ; to here
0A48: ED 81 3139 | std ,x++
0A4A: 9F 10 3140 | stx forth__here ; update HERE location
0A4C: AE A1 3141 | ldx ,y++ ; NEXT
0A4E: 6E 94 3142 | jmp [,x]
3143 |
0A50: 0A52 3144 | .runtime_xt fdb .runtime
0A52: 9E 28 3145 | .runtime ldx forth__create_xt ; get xt
0A54: 10AF 84 3146 | sty ,x ; point xt to JSR
0A57: 35 20 3147 | puls y ; effectively EXIT
0A59: AE A1 3148 | ldx ,y++ ; NEXT
0A5B: 6E 94 3149 | jmp [,x]
3150 |
3151 | ;-------------------------------------------------
3152 |
3153 | .test "DOES> : FOO CREATE ... DOES> ... ;"
3154 | .opt test pokew forth__here , .foo1_does_cxt
3155 | .opt test prot n , .datastack1 - 4 , .datastack1 - 3
3156 | .opt test prot n , .datastack1 + 2 , .datastack1 + 3
3157 | .opt test prot n , .foo1_xt , .foo1_xt + 1
3158 |
E4F9: CE E507 3159 | ldu #.datastack1
E4FC: 8E 0A38 3160 | ldx #forth_core_does.xt
E4FF: BD 0C04 3161 | jsr forth_core_execute.asm
3162 | .assert /u = .datastack1 , "U"
3163 | .assert @@/,u = .foo1_xt , ",U"
3164 | .assert @@.foo1_does_cxt = forth_core_does.runtime_xt , "cxt"
3165 | .assert @.foo1_does_jsr = $BD , "JSR"
3166 | .assert @@.foo1_does_a = forth_core_create.does_hook , "does_hook"
E502: 39 3167 | rts
3168 |
E503: FFFC 3169 | fdb -4 ; no permissions
E505: FFFE 3170 | fdb -2
E507: E50B 3171 | .datastack1 fdb .foo1_xt
E509: 0000 3172 | fdb 0
3173 |
E50B: 0678 3174 | .foo1_xt fdb forth_core_colon.runtime
E50D: 0000 3175 | .foo1_does_cxt fdb 0 ; forth_core_does.runtime_xt
E50F: 00 3176 | .foo1_does_jsr fcb 0 ; JSR
E510: 0000 3177 | .foo1_does_a fdb 0 ; forth_core_create.does_hook
3178 | .endtst
3179 |
3180 | ;---------------------------------------------------
3181 |
3182 | .test "DOES> ... FOO BAR ... "
3183 | .opt test pokew forth__create_xt , .bar2_xt
3184 |
E512: CE E51E 3185 | ldu #.datastack2
E515: 8E E520 3186 | ldx #.call2_foo_xt
E518: BD 0C04 3187 | jsr forth_core_execute.asm
3188 | .assert /u = .datastack2 , "U"
3189 | .assert @@/,u = 0 , ",U"
3190 | .assert @@.bar2_xt = .foo2_jsr , "JSR"
3191 | .assert @@.bar2_body = 42 , "body"
E51B: 39 3192 | rts
3193 |
E51C: 0000 3194 | fdb 0
E51E: 0000 3195 | .datastack2 fdb 0
3196 |
E520: 0678 3197 | .call2_foo_xt fdb forth_core_colon.runtime
E522: E526 3198 | fdb .foo2_xt
E524: 0C1A 3199 | fdb forth_core_exit.xt
3200 |
E526: 0678 3201 | .foo2_xt fdb forth_core_colon.runtime
E528: 0A50 3202 | fdb forth_core_does.runtime_xt
E52A: BD 09BD 3203 | .foo2_jsr jsr forth_core_create.does_hook
3204 |
E52D: 09C3 3205 | .bar2_xt fdb forth_core_create.runtime; .foo2_does_jsr
E52F: 002A 3206 | .bar2_body fdb 42
3207 | .endtst
3208 |
3209 | ;-----------------------------------------------------
3210 |
3211 | .test "DOES> ... BAR ... "
E531: CE E53D 3212 | ldu #.datastack3
E534: 8E E53F 3213 | ldx #.call3_bar_xt
E537: BD 0C04 3214 | jsr forth_core_execute.asm
3215 | .assert /u = .datastack3 - 2 , "U"
3216 | .assert @@/,u = 42 , ",U"
3217 | .assert @@/2,u = 0 , "2,U"
E53A: 39 3218 | rts
3219 |
E53B: 0000 3220 | fdb 0
E53D: 0000 3221 | .datastack3 fdb 0
3222 |
E53F: 0678 3223 | .call3_bar_xt fdb forth_core_colon.runtime
E541: E54C 3224 | fdb .bar3_xt
E543: 0C1A 3225 | fdb forth_core_exit.xt
3226 |
E545: BD 09BD 3227 | .foo3_does_jsr jsr forth_core_create.does_hook
E548: 07E2 3228 | fdb forth_core_fetch.xt
E54A: 0C1A 3229 | fdb forth_core_exit.xt
3230 |
E54C: E545 3231 | .bar3_xt fdb .foo3_does_jsr
E54E: 002A 3232 | fdb 42
3233 | .endtst
3234 |
3235 | ;**********************************************************************
3236 |
0A5D: 3237 | forth_core_drop ; ( x -- )
0A5D: 0A2F 3238 | fdb forth_core_does
0A5F: 0004 3239 | fdb .xt - .name
0A61: 44524F50 3240 | .name fcc "DROP"
0A65: 0A67 3241 | .xt fdb .body
0A67: 33 42 3242 | .body leau 2,u
0A69: AE A1 3243 | ldx ,y++
0A6B: 6E 94 3244 | jmp [,x]
3245 |
3246 | ;**********************************************************************
3247 |
0A6D: 3248 | forth_core_dupe ; ( x -- x x )
0A6D: 0A5D 3249 | fdb forth_core_drop
0A6F: 0003 3250 | fdb .xt - .name
0A71: 445550 3251 | .name fcc "DUP"
0A74: 0A76 3252 | .xt fdb .body
0A76: EC C4 3253 | .body ldd ,u
0A78: 36 06 3254 | pshu d
0A7A: AE A1 3255 | ldx ,y++
0A7C: 6E 94 3256 | jmp [,x]
3257 |
3258 | ;**********************************************************************
3259 |
0A7E: 3260 | forth_core_else ; C ( C: orig1 -- orig2 ) R ( -- )
0A7E: 0A6D 3261 | fdb forth_core_dupe
0A80: A004 3262 | fdb _IMMED | _NOINTERP :: .xt - .name
0A82: 454C5345 3263 | .name fcc "ELSE"
0A86: 0678 3264 | .xt fdb forth_core_colon.runtime
3265 | ;====================================================
3266 | ; : ELSE POSTPONE AHEAD 1 CS-ROLL POSTPONE THEN ; IMMEDIATE
3267 | ;===================================================
0A88: 2528 3268 | fdb forth_tools_ext_ahead.xt
0A8A: 0D84 3269 | fdb forth_core_literal.runtime_xt
0A8C: 0001 3270 | fdb 1
0A8E: 2564 3271 | fdb forth_tools_ext_c_s_roll.xt
0A90: 1110 3272 | fdb forth_core_then.xt
0A92: 0C1A 3273 | fdb forth_core_exit.xt
3274 |
3275 | ;**********************************************************************
3276 |
0A94: 3277 | forth_core_emit ; ( x -- )
0A94: 0A7E 3278 | fdb forth_core_else
0A96: 0004 3279 | fdb .xt - .name
0A98: 454D4954 3280 | .name fcc "EMIT"
0A9C: 0A9E 3281 | .xt fdb .body
0A9E: 37 06 3282 | .body pulu d ; char caracter
0AA0: AD 9F0004 3283 | jsr [forth__vector_putchar] ; do that thing
0AA4: AE A1 3284 | ldx ,y++ ; NEXT
0AA6: 6E 94 3285 | jmp [,x]
3286 |
3287 | ;**********************************************************************
3288 | ; ENVIRONMENT
3289 | ;**********************************************************************
3290 |
0AA8: 0B98 3291 | forth__env_wid fdb forth__env_number_sign_locals
3292 |
0AAA: 3293 | forth__env_slash_counted_string
0AAA: 0000 3294 | fdb 0
0AAC: 000F 3295 | fdb .xt - .name
0AAE: 2F434F554E54... 3296 | .name fcc "/COUNTED-STRING"
0ABD: 097A 3297 | .xt fdb forth_core_constant.does
0ABF: 00FF 3298 | fdb 255
0AC1: 3299 | forth__env_slash_hold
0AC1: 0AAA 3300 | fdb forth__env_slash_counted_string
0AC3: 0005 3301 | fdb .xt - .name
0AC5: 2F484F4C44 3302 | .name fcc "/HOLD"
0ACA: 097A 3303 | .xt fdb forth_core_constant.does
0ACC: 0022 3304 | fdb SLASH_HOLD
0ACE: 3305 | forth__env_slash_pad
0ACE: 0AC1 3306 | fdb forth__env_slash_hold
0AD0: 0004 3307 | fdb .xt - .name
0AD2: 2F504144 3308 | .name fcc "/PAD"
0AD6: 097A 3309 | .xt fdb forth_core_constant.does
0AD8: 0054 3310 | fdb SLASH_PAD
0ADA: 3311 | forth__env_address_unit_bits
0ADA: 0ACE 3312 | fdb forth__env_slash_pad
0ADC: 0011 3313 | fdb .xt - .name
0ADE: 414444524553... 3314 | .name fcc "ADDRESS-UNIT-BITS"
0AEF: 097A 3315 | .xt fdb forth_core_constant.does
0AF1: 0008 3316 | fdb 8
0AF3: 3317 | forth__env_floored
0AF3: 0ADA 3318 | fdb forth__env_address_unit_bits
0AF5: 0007 3319 | fdb .xt - .name
0AF7: 464C4F4F5245... 3320 | .name fcc "FLOORED"
0AFE: 097A 3321 | .xt fdb forth_core_constant.does
0B00: 0000 3322 | fdb 0
0B02: 3323 | forth__env_max_char
0B02: 0AF3 3324 | fdb forth__env_floored
0B04: 0008 3325 | fdb .xt - .name
0B06: 4D41582D4348... 3326 | .name fcc "MAX-CHAR"
0B0E: 097A 3327 | .xt fdb forth_core_constant.does
0B10: 007F 3328 | fdb 127
0B12: 3329 | forth__env_max_d
0B12: 0B02 3330 | fdb forth__env_max_char
0B14: 0005 3331 | fdb .xt - .name
0B16: 4D41582D44 3332 | .name fcc "MAX-D"
0B1B: 1AB5 3333 | .xt fdb forth_double_two_constant.does
0B1D: 7FFF 3334 | fdb $7FFF
0B1F: FFFF 3335 | fdb $FFFF
0B21: 3336 | forth__env_max_n
0B21: 0B12 3337 | fdb forth__env_max_d
0B23: 0005 3338 | fdb .xt - .name
0B25: 4D41582D4E 3339 | .name fcc "MAX-N"
0B2A: 097A 3340 | .xt fdb forth_core_constant.does
0B2C: 7FFF 3341 | fdb $7FFF
0B2E: 3342 | forth__env_max_u
0B2E: 0B21 3343 | fdb forth__env_max_n
0B30: 0005 3344 | fdb .xt - .name
0B32: 4D41582D55 3345 | .name fcc "MAX-U"
0B37: 097A 3346 | .xt fdb forth_core_constant.does
0B39: FFFF 3347 | fdb $FFFF
0B3B: 3348 | forth__env_max_u_d
0B3B: 0B2E 3349 | fdb forth__env_max_u
0B3D: 0006 3350 | fdb .xt - .name
0B3F: 4D41582D5544 3351 | .name fcc "MAX-UD"
0B45: 1AB5 3352 | .xt fdb forth_double_two_constant.does
0B47: FFFF 3353 | fdb $FFFF
0B49: FFFF 3354 | fdb $FFFF
0B4B: 3355 | forth__env_return_stack_cells
0B4B: 0B3B 3356 | fdb forth__env_max_u_d
0B4D: 0012 3357 | fdb .xt - .name
0B4F: 52455455524E... 3358 | .name fcc "RETURN-STACK-CELLS"
0B61: 0B63 3359 | .xt fdb .body
0B63: DC 0C 3360 | .body ldd forth__rs_top
0B65: 93 0A 3361 | subd forth__rs_bottom
0B67: 36 06 3362 | pshu d
0B69: AE A1 3363 | ldx ,y++
0B6B: 6E 94 3364 | jmp [,x]
0B6D: 3365 | forth__env_stack_cells
0B6D: 0B4B 3366 | fdb forth__env_return_stack_cells
0B6F: 000B 3367 | fdb .xt - .name
0B71: 535441434B2D... 3368 | .name fcc "STACK-CELLS"
0B7C: 0B7E 3369 | .xt fdb .body
0B7E: DC 08 3370 | .body ldd forth__ds_top
0B80: 93 06 3371 | subd forth__ds_bottom
0B82: 36 06 3372 | pshu d
0B84: AE A1 3373 | ldx ,y++
0B86: 6E 94 3374 | jmp [,x]
0B88: 3375 | forth__env_wordlists
0B88: 0B6D 3376 | fdb forth__env_stack_cells
0B8A: 0008 3377 | fdb .xt - .name
0B8C: 574F52444C49... 3378 | .name fcc "WORDLIST"
0B94: 097A 3379 | .xt fdb forth_core_constant.does
0B96: 0008 3380 | .body fdb NUMBER_LISTS
0B98: 3381 | forth__env_number_sign_locals
0B98: 0B88 3382 | fdb forth__env_wordlists
0B9A: 0007 3383 | fdb .xt - .name
0B9C: 234C4F43414C... 3384 | .name fcc "#LOCALS"
0BA3: 097A 3385 | .xt fdb forth_core_constant.does
0BA5: 0010 3386 | .body fdb NUMBER_LOCALS
3387 |
0BA7: 3388 | forth_core_environment_query ; ( c-addr u -- false | i*x true )
0BA7: 0A94 3389 | fdb forth_core_emit
0BA9: 000C 3390 | fdb .xt - .name
0BAB: 454E5649524F... 3391 | .name fcc "ENVIRONMENT?"
0BB7: 0678 3392 | .xt fdb forth_core_colon.runtime
3393 | ;=====================================================
3394 | ; : ENVIRONMENT?
3395 | ; forth__env_wid
3396 | ; SEARCH-WORDLIST IF
3397 | ; EXECUTE TRUE
3398 | ; ELSE
3399 | ; FALSE
3400 | ; THEN ;
3401 | ;=====================================================
0BB9: 0D84 3402 | fdb forth_core_literal.runtime_xt
0BBB: 0AA8 3403 | fdb forth__env_wid
0BBD: 284B 3404 | fdb forth_search_search_wordlist.xt
0BBF: 0CD1 3405 | fdb forth_core_if.runtime_xt
0BC1: 0BCB 3406 | fdb .L1
0BC3: 0BFE 3407 | fdb forth_core_execute.xt
0BC5: 19BD 3408 | fdb forth_core_ext_true.xt
0BC7: 1430 3409 | fdb forth_core_ext_again.runtime_xt
0BC9: 0BCD 3410 | fdb .L2
0BCB: 156D 3411 | .L1 fdb forth_core_ext_false.xt
0BCD: 0C1A 3412 | .L2 fdb forth_core_exit.xt
3413 |
3414 | ;-------------------------------------------------
3415 |
3416 | .test 'S" /COUNTED-STRING" ENVIRONMENT?'
3417 | .opt test prot n , ._nu
E550: CE E578 3418 | ldu #.datastack
E553: 8E 0BB7 3419 | ldx #forth_core_environment_query.xt
E556: BD 0C04 3420 | jsr forth_core_execute.asm
3421 | .assert /u = .datastack , "U"
3422 | .assert @@/,u = -1 , ",U = true"
3423 | .assert @@/2,u = 255 , ",U = 255"
E559: 39 3424 | rts
3425 |
E55A: 2F434F554E54... 3426 | .c_addr fcc '/COUNTED-STRING'
3427 | .u equ * - .c_addr
E569: 00 3428 | ._nu fcb 0
3429 |
E56A: 0000 3430 | fdb 0
E56C: 0000 3431 | fdb 0
E56E: 0000 3432 | fdb 0
E570: 0000 3433 | fdb 0
E572: 0000 3434 | fdb 0
E574: 0000 3435 | fdb 0
E576: 0000 3436 | fdb 0
E578: 000F 3437 | .datastack fdb .u
E57A: E55A 3438 | fdb .c_addr
3439 | .endtst
3440 |
3441 | ;**********************************************************************
3442 |
0BCF: 3443 | forth_core_evaluate ; ( i*x c-addr u -- j*x )
0BCF: 0BA7 3444 | fdb forth_core_environment_query
0BD1: 0008 3445 | fdb .xt - .name
0BD3: 4556414C5541... 3446 | .name fcc "EVALUATE"
0BDB: 0678 3447 | .xt fdb forth_core_colon.runtime
3448 | ;====================================================================
3449 | ; : EVALUATE
3450 | ; SAVE-INPUT N>R -1 set_source_id
3451 | ; set-source private-evaluate NR>
3452 | ; RESTORE-INPUT DROP ;
3453 | ;====================================================================
0BDD: 1905 3454 | fdb forth_core_ext_save_input.xt
0BDF: 2571 3455 | fdb forth_tools_ext_n_to_r.xt
0BE1: 0D84 3456 | fdb forth_core_literal.runtime_xt
0BE3: FFFF 3457 | fdb -1
0BE5: 0354 3458 | fdb forth__private_set_source_i_d
0BE7: 0344 3459 | fdb forth__private_set_source
0BE9: 0188 3460 | fdb forth__private_eval_xt
0BEB: 2605 3461 | fdb forth_tools_ext_n_r_from.xt
0BED: 1777 3462 | fdb forth_core_ext_restore_input.xt
0BEF: 0A65 3463 | fdb forth_core_drop.xt
0BF1: 0C1A 3464 | fdb forth_core_exit.xt
3465 |
3466 | ;--------------------------------------------
3467 |
3468 | .test "EVALUATE"
3469 | .opt test pokew forth__source , .dummy1
3470 | .opt test pokew forth__source_len , .dummy1len
3471 | .opt test pokew forth__in , 5
3472 | .opt test pokew forth__base , 10
3473 | .opt test pokew forth__state , 0
3474 | .opt test pokew forth__here , $6000
3475 | .opt test pokew forth__ds_bottom , .rs_bot
3476 | .opt test pokew forth__ds_top , .result1
3477 | .opt test prot rw , $6000 , $6100
3478 | .opt test prot rw , $DE00 , $DEFF
E57C: CE E592 3479 | ldu #.datastack1
E57F: 8E 0BDB 3480 | ldx #forth_core_evaluate.xt
E582: BD 0C04 3481 | jsr forth_core_execute.asm
3482 | .assert /u = .result1 , "U"
3483 | .assert @@/0,u = 123 , "result"
3484 | .assert @@forth__source = .dummy1 , "source"
3485 | .assert @@forth__source_len = .dummy1len , "source-len"
3486 | .assert @@forth__in = 5 , ">IN"
E585: 39 3487 | rts
3488 |
E586: 0000 3489 | .rs_bot fdb 0
E588: 0000 3490 | fdb 0
E58A: 0000 3491 | fdb 0
E58C: 0000 3492 | fdb 0
E58E: 0000 3493 | fdb 0
E590: 0000 3494 | fdb 0
E592: 0003 3495 | .datastack1 fdb .len1
E594: E5A1 3496 | .result1 fdb .text1
E596: 0000 3497 | fdb 0
E598: 0000 3498 | fdb 0
E59A: 0000 3499 | fdb 0
E59C: 0000 3500 | fdb 0
E59E: 0000 3501 | fdb 0
3502 |
E5A0: 12 3503 | nop
E5A1: 313233 3504 | .text1 fcc '123'
3505 | .len1 equ * - .text1
E5A4: 64756D6D79 3506 | .dummy1 fcc 'dummy'
3507 | .dummy1len equ * - .dummy1
3508 | .endtst
3509 |
3510 | ;**********************************************************************
3511 |
0BF3: 3512 | forth_core_execute ; ( i*x xt -- j*x )
0BF3: 0BCF 3513 | fdb forth_core_evaluate
0BF5: 0007 3514 | fdb .xt - .name
0BF7: 455845435554... 3515 | .name fcc "EXECUTE"
0BFE: 0C00 3516 | .xt fdb .body
0C00: 37 10 3517 | .body pulu x
0C02: 6E 94 3518 | jmp [,x]
3519 |
3520 | ;********************************************
3521 | ; forth_core_execute.asm Allow assembly code to call xt
3522 | ;Entry: X - xt
3523 | ; U - datastack
3524 | ;Exit: D - trashed
3525 | ; X - trashed
3526 | ; Y - saved
3527 | ;********************************************
3528 |
0C04: 34 20 3529 | .asm pshs y ; save Y
0C06: 108E 0C0C 3530 | ldy #.asm_body ; point to anonymous xt
0C0A: 6E 94 3531 | jmp [,x]
3532 |
0C0C: 0C0E 3533 | .asm_body fdb .asm_exit_xt
0C0E: 0C10 3534 | .asm_exit_xt fdb .asm_exit_code
0C10: 35 A0 3535 | .asm_exit_code puls y,pc ; restore Y and return
3536 |
3537 | ;-----------------------------------------------
3538 |
3539 | .test "EXECUTE"
E5A9: CE E5B5 3540 | ldu #.datastack1
E5AC: 8E E5BB 3541 | ldx #.call_xt
E5AF: BD 0C04 3542 | jsr forth_core_execute.asm
3543 | .assert /u = .result , "U"
3544 | .assert @@/,u = 5 , ",U"
E5B2: 39 3545 | rts
3546 |
E5B3: 0000 3547 | fdb 0
E5B5: 046B 3548 | .datastack1 fdb forth_core_plus.xt
E5B7: 0002 3549 | fdb 2
E5B9: 0003 3550 | .result fdb 3
3551 |
E5BB: 0678 3552 | .call_xt fdb forth_core_colon.runtime
E5BD: 0BFE 3553 | fdb forth_core_execute.xt
E5BF: 0C1A 3554 | fdb forth_core_exit.xt
3555 | .endtst
3556 |
3557 | ;-------------------------------------------------
3558 |
3559 | .test "EXECUTE from assembly"
E5C1: 10FF E5D3 3560 | sts .stack
E5C5: CE E5D7 3561 | ldu #.datastack2
E5C8: 108E 0000 3562 | ldy #0
E5CC: 8E 0A74 3563 | ldx #forth_core_dupe.xt
E5CF: BD 0C04 3564 | jsr forth_core_execute.asm
3565 | .assert /u = .datastack2 - 2 , "U"
3566 | .assert @@/,u = 13 , ",U"
3567 | .assert @@/2,u = 13 , "2,U"
3568 | .assert /y = 0 , "Y == 0"
3569 | .assert /s = @@.stack , "S == stack on entry"
E5D2: 39 3570 | rts
3571 |
E5D3: 0000 3572 | .stack fdb 0
E5D5: 0000 3573 | fdb 0
E5D7: 000D 3574 | .datastack2 fdb 13
3575 | .endtst
3576 |
3577 | ;**********************************************************************
3578 |
0C12: 3579 | forth_core_exit ; E ( -- ) ( R: nest-sys -- )
0C12: 0BF3 3580 | fdb forth_core_execute
0C14: 2004 3581 | fdb _NOINTERP :: .xt - .name
0C16: 45584954 3582 | .name fcc "EXIT"
0C1A: 0C1C 3583 | .xt fdb .body
0C1C: 35 20 3584 | .body puls y
0C1E: AE A1 3585 | ldx ,y++
0C20: 6E 94 3586 | jmp [,x]
3587 |
3588 | ;**********************************************************************
3589 |
0C22: 3590 | forth_core_fill ; ( c-addr u char -- )
0C22: 0C12 3591 | fdb forth_core_exit
0C24: 0004 3592 | fdb .xt - .name
0C26: 46494C4C 3593 | .name fcc "FILL"
0C2A: 0C2C 3594 | .xt fdb .body
0C2C: AE 42 3595 | .body ldx 2,u
0C2E: 26 04 3596 | bne .doit
0C30: 33 46 3597 | leau 6,u
0C32: 20 0C 3598 | bra .done
0C34: 34 20 3599 | .doit pshs y
0C36: 37 36 3600 | pulu y,x,d
0C38: E7 A0 3601 | .fill stb ,y+
0C3A: 30 1F 3602 | leax -1,x
0C3C: 26 FA 3603 | bne .fill
0C3E: 35 20 3604 | puls y
0C40: AE A1 3605 | .done ldx ,y++
0C42: 6E 94 3606 | jmp [,x]
3607 |
3608 | ;-----------------------------------------------
3609 |
3610 | .test "FILL 0"
E5D9: CE E5E7 3611 | ldu #.datastack0
E5DC: 8E 0C2A 3612 | ldx #forth_core_fill.xt
E5DF: BD 0C04 3613 | jsr forth_core_execute.asm
3614 | .assert /u = .result0 , "U"
3615 | .assert @.buff0 = 0 , "buffer"
3616 | .assert @.buff01 = 0 , "2buf" ; XXX - @.buff0+1 is buggy
3617 | .assert @.buff02 = 0 , "3buf"
E5E2: 39 3618 | rts
3619 |
E5E3: 0000 3620 | fdb 0
E5E5: 0000 3621 | fdb 0
E5E7: 0020 3622 | .datastack0 fdb ' '
E5E9: 0000 3623 | fdb 0
E5EB: E5F0 3624 | fdb .buff0
E5ED: 0000 3625 | .result0 fdb 0
E5EF: 12 3626 | nop
E5F0: 00 3627 | .buff0 fcb 0
E5F1: 00 3628 | .buff01 fcb 0
E5F2: 00 3629 | .buff02 fcb 0
3630 | .endtst
3631 |
3632 | ;------------------------------------------------
3633 |
3634 | .test "FILL 1"
E5F3: CE E601 3635 | ldu #.datastack1
E5F6: 8E 0C2A 3636 | ldx #forth_core_fill.xt
E5F9: BD 0C04 3637 | jsr forth_core_execute.asm
3638 | .assert /u = .result1 , "U"
3639 | .assert @.buff1 = 32 , "buffer"
3640 | .assert @.buff11 = 0 , "2buf"
3641 | .assert @.buff12 = 0 , "3buf"
E5FC: 39 3642 | rts
3643 |
E5FD: 0000 3644 | fdb 0
E5FF: 0000 3645 | fdb 0
E601: 0020 3646 | .datastack1 fdb ' '
E603: 0001 3647 | fdb 1
E605: E60A 3648 | fdb .buff1
E607: 0000 3649 | .result1 fdb 0
E609: 12 3650 | nop
E60A: 00 3651 | .buff1 fcb 0
E60B: 00 3652 | .buff11 fcb 0
E60C: 00 3653 | .buff12 fcb 0
3654 | .endtst
3655 |
3656 | ;------------------------------------------------
3657 |
3658 | .test "FILL 2"
E60D: CE E61B 3659 | ldu #.datastack2
E610: 8E 0C2A 3660 | ldx #forth_core_fill.xt
E613: BD 0C04 3661 | jsr forth_core_execute.asm
3662 | .assert /u = .result2 , "U"
3663 | .assert @.buff2 = 32 , "buffer"
3664 | .assert @.buff21 = 32 , "2buf"
3665 | .assert @.buff22 = 0 , "3buf"
E616: 39 3666 | rts
3667 |
E617: 0000 3668 | fdb 0
E619: 0000 3669 | fdb 0
E61B: 0020 3670 | .datastack2 fdb ' '
E61D: 0002 3671 | fdb 2
E61F: E624 3672 | fdb .buff2
E621: 0000 3673 | .result2 fdb 0
E623: 12 3674 | nop
E624: 00 3675 | .buff2 fcb 0
E625: 00 3676 | .buff21 fcb 0
E626: 00 3677 | .buff22 fcb 0
3678 | .endtst
3679 |
3680 | ;------------------------------------------------
3681 |
3682 | .test "FILL 3"
E627: CE E635 3683 | ldu #.datastack3
E62A: 8E 0C2A 3684 | ldx #forth_core_fill.xt
E62D: BD 0C04 3685 | jsr forth_core_execute.asm
3686 | .assert /u = .result3 , "U"
3687 | .assert @.buff3 = 32 , "buffer"
3688 | .assert @.buff31 = 32 , "2buf"
3689 | .assert @.buff32 = 32 , "3buf"
E630: 39 3690 | rts
3691 |
E631: 0000 3692 | fdb 0
E633: 0000 3693 | fdb 0
E635: 0020 3694 | .datastack3 fdb ' '
E637: 0003 3695 | fdb 3
E639: E63E 3696 | fdb .buff3
E63B: 0000 3697 | .result3 fdb 0
E63D: 12 3698 | nop
E63E: 00 3699 | .buff3 fcb 0
E63F: 00 3700 | .buff31 fcb 0
E640: 00 3701 | .buff32 fcb 0
3702 | .endtst
3703 |
3704 | ;**********************************************************************
3705 | ;
3706 | ;forth_core_find ; SEARCH FIND
3707 | ; fdb forth_core_fill
3708 | ; fdb .xt - .name
3709 | ;.name fcc "FIND"
3710 | ;.xt fdb forth_core_colon.runtime
3711 | ; fdb forth_core_literal.runtime_xt
3712 | ; fdb -13
3713 | ; fdb forth_exception_throw.xt
3714 | ;
3715 | ;**********************************************************************
3716 |
3717 | quotient set 0
3718 | remainder set 2
3719 |
0C44: 3720 | forth_core_f_m_slash_mod ; ( d1 n1 -- n2 n3 )
0C44: 0C22 3721 | fdb forth_core_fill
0C46: 0006 3722 | fdb .xt - .name
0C48: 464D2F4D4F44 3723 | .name fcc "FM/MOD"
0C4E: 0C50 3724 | .xt fdb .body
0C50: EC C4 3725 | .body ldd ,u
0C52: 34 06 3726 | pshs d ; save denominator
0C54: 8E 1067 3727 | ldx #forth_core_s_m_slash_rem.xt
0C57: 8D AB 3728 | bsr forth_core_execute.asm
0C59: AE E4 3729 | ldx ,s ; check demoninator
0C5B: 8C 0000 3730 | cmpx #0 ; if (demon > 0)
0C5E: 2F 12 3731 | ble .neg_denom
0C60: AE 42 3732 | ldx remainder,u ; if (remainder < 0)
0C62: 2A 15 3733 | bpl .done
0C64: AE C4 3734 | .adjust ldx quotient,u
0C66: 30 1F 3735 | leax -1,x
0C68: AF C4 3736 | stx quotient,u
0C6A: EC 42 3737 | ldd remainder,u
0C6C: E3 E4 3738 | addd ,s
0C6E: ED 42 3739 | std remainder,u
0C70: 20 07 3740 | bra .done
0C72: AE 42 3741 | .neg_denom ldx remainder,u
0C74: 8C 0000 3742 | cmpx #0
0C77: 2E EB 3743 | bgt .adjust
0C79: 32 62 3744 | .done leas 2,s
0C7B: AE A1 3745 | ldx ,y++
0C7D: 6E 94 3746 | jmp [,x]
3747 |
3748 | ;---------------------------------------
3749 |
3750 | .test "FM/MOD +numerator +demoninator"
E641: CE E64D 3751 | ldu #.datastack1
E644: 8E 0C4E 3752 | ldx #forth_core_f_m_slash_mod.xt
E647: BD 0C04 3753 | jsr forth_core_execute.asm
3754 | .assert /u = .result1 , "U"
3755 | .assert @@/0,u = 1 , "q"
3756 | .assert @@/2,u = 3 , "r"
E64A: 39 3757 | rts
3758 |
E64B: 0000 3759 | fdb 0
E64D: 0007 3760 | .datastack1 fdb 7
E64F: 0000 3761 | .result1 fdb 0
E651: 000A 3762 | fdb 10
3763 | .endtst
3764 |
3765 | ;--------------------------------------
3766 |
3767 | .test "FM/MOD -numerator +demoninator"
E653: CE E663 3768 | ldu #.datastack2
E656: 8E 0C4E 3769 | ldx #forth_core_f_m_slash_mod.xt
E659: BD 0C04 3770 | jsr forth_core_execute.asm
3771 | .assert /u = .result2 , "U"
3772 | .assert @@/0,u = -2 , "q"
3773 | .assert @@/2,u = 4 , "r"
E65C: 39 3774 | rts
3775 |
E65D: 0000 3776 | fdb 0
E65F: 0000 3777 | fdb 0
E661: 0000 3778 | fdb 0
E663: 0007 3779 | .datastack2 fdb 7
E665: FFFF 3780 | .result2 fdb $FFFF
E667: FFF6 3781 | fdb -10
3782 | .endtst
3783 |
3784 | ;--------------------------------------
3785 |
3786 | .test "FM/MOD +numerator -demoninator"
E669: CE E679 3787 | ldu #.datastack3
E66C: 8E 0C4E 3788 | ldx #forth_core_f_m_slash_mod.xt
E66F: BD 0C04 3789 | jsr forth_core_execute.asm
3790 | .assert /u = .result3 , "U"
3791 | .assert @@/0,u = -2 , "q"
3792 | .assert @@/2,u = -4 , "r"
E672: 39 3793 | rts
3794 |
E673: 0000 3795 | fdb 0
E675: 0000 3796 | fdb 0
E677: 0000 3797 | fdb 0
E679: FFF9 3798 | .datastack3 fdb -7
E67B: 0000 3799 | .result3 fdb 0
E67D: 000A 3800 | fdb 10
3801 | .endtst
3802 |
3803 | ;--------------------------------------
3804 |
3805 | .test "FM/MOD -numerator -demoninator"
E67F: CE E68F 3806 | ldu #.datastack4
E682: 8E 0C4E 3807 | ldx #forth_core_f_m_slash_mod.xt
E685: BD 0C04 3808 | jsr forth_core_execute.asm
3809 | .assert /u = .result4 , "U"
3810 | .assert @@/0,u = 1 , "q"
3811 | .assert @@/2,u = -3 , "r"
E688: 39 3812 | rts
3813 |
E689: 0000 3814 | fdb 0
E68B: 0000 3815 | fdb 0
E68D: 0000 3816 | fdb 0
E68F: FFF9 3817 | .datastack4 fdb -7
E691: FFFF 3818 | .result4 fdb $FFFF
E693: FFF6 3819 | fdb -10
3820 | .endtst
3821 |
3822 | ;**********************************************************************
3823 |
0C7F: 3824 | forth_core_here ; ( -- addr )
0C7F: 0C44 3825 | fdb forth_core_f_m_slash_mod
0C81: 0004 3826 | fdb .xt - .name
0C83: 48455245 3827 | .name fcc "HERE"
0C87: 0C89 3828 | .xt fdb .bodyx
0C89: DC 10 3829 | .bodyx ldd forth__here
0C8B: 36 06 3830 | pshu d
0C8D: AE A1 3831 | ldx ,y++
0C8F: 6E 94 3832 | jmp [,x]
3833 |
3834 | ;**********************************************************************
3835 |
0C91: 3836 | forth_core_hold ; ( char -- )
0C91: 0C7F 3837 | fdb forth_core_here
0C93: 0004 3838 | fdb .xt - .name
0C95: 484F4C44 3839 | .name fcc "HOLD"
0C99: 0C9B 3840 | .xt fdb .body
0C9B: 37 06 3841 | .body pulu d
0C9D: 9E 2A 3842 | ldx forth__hold
0C9F: E7 82 3843 | stb ,-x
0CA1: 9F 2A 3844 | stx forth__hold
0CA3: AE A1 3845 | ldx ,y++
0CA5: 6E 94 3846 | jmp [,x]
3847 |
3848 | ;**********************************************************************
3849 |
0CA7: 3850 | forth_core_i ; E ( -- n|u ) ( R: loop-sys -- loop-sys )
0CA7: 0C91 3851 | fdb forth_core_hold
0CA9: 2001 3852 | fdb _NOINTERP :: .xt - .name
0CAB: 49 3853 | .name fcc "I"
0CAC: 0CAE 3854 | .xt fdb .body
0CAE: EC E4 3855 | .body ldd ,s
0CB0: 36 06 3856 | pshu d
0CB2: AE A1 3857 | ldx ,y++
0CB4: 6E 94 3858 | jmp [,x]
3859 |
3860 | ;**********************************************************************
3861 |
0CB6: 3862 | forth_core_if ; C ( C: -- orig ) R ( x -- )
0CB6: 0CA7 3863 | fdb forth_core_i
0CB8: A002 3864 | fdb _IMMED | _NOINTERP :: .xt - .name
0CBA: 4946 3865 | .name fcc "IF"
0CBC: 0CBE 3866 | .xt fdb .body
0CBE: 9E 10 3867 | .body ldx forth__here
0CC0: CC 0CD1 3868 | ldd #.runtime_xt ; compile jump
0CC3: ED 81 3869 | std ,x++
0CC5: 36 10 3870 | pshu x ; push orig
0CC7: 6F 80 3871 | clr ,x+
0CC9: 6F 80 3872 | clr ,x+
0CCB: 9F 10 3873 | stx forth__here
0CCD: AE A1 3874 | ldx ,y++ ; NEXT
0CCF: 6E 94 3875 | jmp [,x]
3876 |
0CD1: 0CD3 3877 | .runtime_xt fdb .runtime
0CD3: EC C1 3878 | .runtime ldd ,u++ ; to set CC
0CD5: 26 07 3879 | bne .true
0CD7: 10AE A4 3880 | ldy ,y ; take branch
0CDA: AE A1 3881 | ldx ,y++ ; NEXT
0CDC: 6E 94 3882 | jmp [,x]
0CDE: 31 22 3883 | .true leay 2,y ; skip branch dest
0CE0: AE A1 3884 | ldx ,y++ ; NEXT
0CE2: 6E 94 3885 | jmp [,x]
3886 |
3887 | ;**********************************************************************
3888 |
0CE4: 3889 | forth_core_immediate ; ( -- )
0CE4: 0CB6 3890 | fdb forth_core_if
0CE6: 0009 3891 | fdb .xt - .name
0CE8: 494D4D454449... 3892 | .name fcc "IMMEDIATE"
0CF1: 0CF3 3893 | .xt fdb .body
0CF3: A6 9F0026 3894 | .body lda [forth__create_name]
0CF7: 8A 80 3895 | ora #_IMMED
0CF9: A7 9F0026 3896 | sta [forth__create_name]
0CFD: AE A1 3897 | ldx ,y++
0CFF: 6E 94 3898 | jmp [,x]
3899 |
3900 | ;**********************************************************************
3901 |
0D01: 3902 | forth_core_invert ; ( x1 -- x2 )
0D01: 0CE4 3903 | fdb forth_core_immediate
0D03: 0006 3904 | fdb .xt - .name
0D05: 494E56455254 3905 | .name fcc "INVERT"
0D0B: 0D0D 3906 | .xt fdb .body
0D0D: 63 C4 3907 | .body com ,u
0D0F: 63 41 3908 | com 1,u
0D11: AE A1 3909 | ldx ,y++
0D13: 6E 94 3910 | jmp [,x]
3911 |
3912 | ;**********************************************************************
3913 |
0D15: 3914 | forth_core_j ; ( -- n|u ) ( R: loop-sys1 loop-sys2 -- loop-sys1 loop-sys2 )
0D15: 0D01 3915 | fdb forth_core_invert
0D17: 2001 3916 | fdb _NOINTERP :: .xt - .name
0D19: 4A 3917 | .name fcc "J"
0D1A: 0D1C 3918 | .xt fdb .body
0D1C: EC 64 3919 | .body ldd 4,s
0D1E: 36 06 3920 | pshu d
0D20: AE A1 3921 | ldx ,y++
0D22: 6E 94 3922 | jmp [,x]
3923 |
3924 | ;**********************************************************************
3925 |
0D24: 3926 | forth_core_key ; ( -- char )
0D24: 0D15 3927 | fdb forth_core_j
0D26: 0003 3928 | fdb .xt - .name
0D28: 4B4559 3929 | .name fcc "KEY"
0D2B: 0D2D 3930 | .xt fdb .body
0D2D: AD 9F0002 3931 | .body jsr [forth__vector_getchar]
0D31: 36 06 3932 | pshu d
0D33: AE A1 3933 | ldx ,y++
0D35: 6E 94 3934 | jmp [,x]
3935 |
3936 | ;**********************************************************************
3937 |
0D37: 3938 | forth_core_leave ; E ( -- ) ( R: loop-sys -- )
0D37: 0D24 3939 | fdb forth_core_key
0D39: A005 3940 | fdb _IMMED | _NOINTERP :: .xt - .name
0D3B: 4C45415645 3941 | .name fcc "LEAVE"
0D40: 0D42 3942 | .xt fdb .body
0D42: 34 40 3943 | .body pshs u ; save register
0D44: DE 58 3944 | ldu forth__leave_sp ; to use as LEAVE stack ptr
0D46: CC 0D5B 3945 | ldd #.runtime_xt ; laydown runtime behavior
0D49: 9E 10 3946 | ldx forth__here ; get compile location
0D4B: ED 81 3947 | std ,x++ ; store
0D4D: EC 5E 3948 | ldd -2,u ; get previous LEAVE patch
0D4F: AF 5E 3949 | stx -2,u ; store HERE at LEAVE patch
0D51: ED 81 3950 | std ,x++ ; save previous LEAVE patch in link list
0D53: 9F 10 3951 | stx forth__here ; update HERE
0D55: 35 40 3952 | puls u ; restore and exit
0D57: AE A1 3953 | ldx ,y++
0D59: 6E 94 3954 | jmp [,x]
3955 |
0D5B: 0D5D 3956 | .runtime_xt fdb .runtime
0D5D: 32 64 3957 | .runtime leas 4,s ; remove loop-sys
0D5F: 10AE A4 3958 | ldy ,y ; GOTO
0D62: AE A1 3959 | ldx ,y++
0D64: 6E 94 3960 | jmp [,x]
3961 |
3962 | ;**********************************************************************
3963 |
0D66: 3964 | forth_core_literal ; C ( x -- ) R ( -- x )
0D66: 0D37 3965 | fdb forth_core_leave
0D68: A007 3966 | fdb _IMMED | _NOINTERP :: .xt - .name
0D6A: 4C4954455241... 3967 | .name fcc "LITERAL"
0D71: 0D73 3968 | .xt fdb .body
0D73: 9E 10 3969 | .body ldx forth__here
0D75: CC 0D84 3970 | ldd #.runtime_xt
0D78: ED 81 3971 | std ,x++
0D7A: 37 06 3972 | pulu d
0D7C: ED 81 3973 | std ,x++
0D7E: 9F 10 3974 | stx forth__here
0D80: AE A1 3975 | ldx ,y++ ; NEXT
0D82: 6E 94 3976 | jmp [,x]
3977 |
0D84: 0D86 3978 | .runtime_xt fdb .runtime
0D86: EC A1 3979 | .runtime ldd ,y++
0D88: 36 06 3980 | pshu d
0D8A: AE A1 3981 | ldx ,y++
0D8C: 6E 94 3982 | jmp [,x]
3983 |
3984 | ;**********************************************************************
3985 |
0D8E: 3986 | forth_core_loop ; C ( C: do-sys -- ) R ( -- ) ( R: loop-sys1 -- loop-sys2 )
0D8E: 0D66 3987 | fdb forth_core_literal
0D90: A004 3988 | fdb _IMMED | _NOINTERP :: .xt - .name
0D92: 4C4F4F50 3989 | .name fcc "LOOP"
0D96: 0D98 3990 | .xt fdb .body
0D98: CC 0D9E 3991 | .body ldd #.runtime_xt ; xt to compile
0D9B: 16 F6FD 3992 | lbra forth_core_plus_loop.rest ; finish loop semantics
3993 |
0D9E: 0DA0 3994 | .runtime_xt fdb .runtime
0DA0: AE E4 3995 | .runtime ldx ,s
0DA2: 30 01 3996 | leax 1,x
0DA4: AC 62 3997 | cmpx 2,s
0DA6: 2C 09 3998 | bge .done
0DA8: AF E4 3999 | stx ,s
0DAA: 10AE A4 4000 | ldy ,y
0DAD: AE A1 4001 | ldx ,y++
0DAF: 6E 94 4002 | jmp [,x]
0DB1: 32 64 4003 | .done leas 4,s
0DB3: 31 22 4004 | leay 2,y
0DB5: AE A1 4005 | ldx ,y++
0DB7: 6E 94 4006 | jmp [,x]
4007 |
4008 | ;**********************************************************************
4009 |
0DB9: 4010 | forth_core_l_shift ; ( x1 u -- x2 )
0DB9: 0D8E 4011 | fdb forth_core_loop
0DBB: 0006 4012 | fdb .xt - .name
0DBD: 4C5348494654 4013 | .name fcc "LSHIFT"
0DC3: 0DC5 4014 | .xt fdb .body
0DC5: AE C1 4015 | .body ldx ,u++ ; get count
0DC7: 27 0A 4016 | beq .done ; if 0, leave (no shift)
0DC9: EC C4 4017 | ldd ,u ; get value to shift
0DCB: 58 4018 | .loop lslb ; left shift
0DCC: 49 4019 | rola
0DCD: 30 1F 4020 | leax -1,x ; do more bits
0DCF: 26 FA 4021 | bne .loop
0DD1: ED C4 4022 | std ,u ; save result
0DD3: AE A1 4023 | .done ldx ,y++ ; NEXT
0DD5: 6E 94 4024 | jmp [,x]
4025 |
4026 | ;**********************************************************************
4027 |
0DD7: 4028 | forth_core_m_star ; ( n1 n2 -- d )
0DD7: 0DB9 4029 | fdb forth_core_l_shift
0DD9: 0002 4030 | fdb .xt - .name
0DDB: 4D2A 4031 | .name fcc "M*"
0DDD: 0DDF 4032 | .xt fdb .body
0DDF: 1F 31 4033 | .body tfr u,x
0DE1: EC 02 4034 | ldd 2,x
0DE3: 8D 18 4035 | bsr .chksign
0DE5: ED 02 4036 | std 2,x
0DE7: EC 84 4037 | ldd ,x
0DE9: 8D 12 4038 | bsr .chksign
0DEB: ED 84 4039 | std ,x
0DED: 17 F292 4040 | lbsr forth__math_mul16
0DF0: A6 C0 4041 | lda ,u+
0DF2: A8 C0 4042 | eora ,u+
0DF4: 2A 03 4043 | bpl .done
0DF6: 17 F271 4044 | lbsr forth__math_neg32
0DF9: AE A1 4045 | .done ldx ,y++
0DFB: 6E 94 4046 | jmp [,x]
0DFD: A7 C2 4047 | .chksign sta ,-u
0DFF: 2A 04 4048 | bpl .skip
0E01: 40 4049 | nega
0E02: 50 4050 | negb
0E03: 82 00 4051 | sbca #0
0E05: 39 4052 | .skip rts
4053 |
4054 | ;------------------------------
4055 |
4056 | .test "M* positive positive"
E695: CE E6A3 4057 | ldu #.datastack1
E698: 8E 0DDD 4058 | ldx #forth_core_m_star.xt
E69B: BD 0C04 4059 | jsr forth_core_execute.asm
4060 | .assert /u = .datastack1
4061 | .assert @@/0,u = 0
4062 | .assert @@/2,u = 50*50
E69E: 39 4063 | rts
4064 |
E69F: 0000 4065 | fdb 0
E6A1: 0000 4066 | fdb 0
E6A3: 0032 4067 | .datastack1 fdb 50
E6A5: 0032 4068 | fdb 50
4069 | .endtst
4070 |
4071 | ;------------------------------
4072 |
4073 | .test "M* positive negative"
E6A7: CE E6B5 4074 | ldu #.datastack2
E6AA: 8E 0DDD 4075 | ldx #forth_core_m_star.xt
E6AD: BD 0C04 4076 | jsr forth_core_execute.asm
4077 | .assert /u = .datastack2
4078 | .assert @@/0,u = -1
4079 | .assert @@/2,u = 50*-50
E6B0: 39 4080 | rts
4081 |
E6B1: 0000 4082 | fdb 0
E6B3: 0000 4083 | fdb 0
E6B5: 0032 4084 | .datastack2 fdb 50
E6B7: FFCE 4085 | fdb -50
4086 | .endtst
4087 |
4088 | ;**********************************************************************
4089 |
0E06: 4090 | forth_core_max ; ( n1 n2 -- n3 )
0E06: 0DD7 4091 | fdb forth_core_m_star
0E08: 0003 4092 | fdb .xt - .name
0E0A: 4D4158 4093 | .name fcc "MAX"
0E0D: 0678 4094 | .xt fdb forth_core_colon.runtime
4095 | ;===========================================
4096 | ; : MAX 2DUP > IF DROP ELSE NIP THEN ;
4097 | ;===========================================
0E0F: 060D 4098 | fdb forth_core_two_dupe.xt
0E11: 06F4 4099 | fdb forth_core_greater_than.xt
0E13: 0CD1 4100 | fdb forth_core_if.runtime_xt
0E15: 0E1D 4101 | fdb .L1
0E17: 0A65 4102 | fdb forth_core_drop.xt
0E19: 1430 4103 | fdb forth_core_ext_again.runtime_xt
0E1B: 0E1F 4104 | fdb .L2
0E1D: 1649 4105 | .L1 fdb forth_core_ext_nip.xt
0E1F: 0C1A 4106 | .L2 fdb forth_core_exit.xt
4107 |
4108 | ;**********************************************************************
4109 |
0E21: 4110 | forth_core_min ; ( n1 n2 -- n3 )
0E21: 0E06 4111 | fdb forth_core_max
0E23: 0003 4112 | fdb .xt - .name
0E25: 4D494E 4113 | .name fcc "MIN"
0E28: 0678 4114 | .xt fdb forth_core_colon.runtime
4115 | ;========================================
4116 | ; : MIN 2DUP < IF DROP ELSE NIP THEN ;
4117 | ;========================================
0E2A: 060D 4118 | fdb forth_core_two_dupe.xt
0E2C: 06AB 4119 | fdb forth_core_less_than.xt
0E2E: 0CD1 4120 | fdb forth_core_if.runtime_xt
0E30: 0E38 4121 | fdb .L1
0E32: 0A65 4122 | fdb forth_core_drop.xt
0E34: 1430 4123 | fdb forth_core_ext_again.runtime_xt
0E36: 0E3A 4124 | fdb .L2
0E38: 1649 4125 | .L1 fdb forth_core_ext_nip.xt
0E3A: 0C1A 4126 | .L2 fdb forth_core_exit.xt
4127 |
4128 | ;--------------------------------------
4129 |
4130 | .test "1 2 MIN"
E6B9: CE E6C7 4131 | ldu #.datastack1
E6BC: 8E 0E28 4132 | ldx #forth_core_min.xt
E6BF: BD 0C04 4133 | jsr forth_core_execute.asm
4134 | .assert /u = .results1 , "U"
4135 | .assert @@/,u = 1 , "result"
E6C2: 39 4136 | rts
4137 |
E6C3: 0000 4138 | fdb 0
E6C5: 0000 4139 | fdb 0
E6C7: 0002 4140 | .datastack1 fdb 2
E6C9: 0001 4141 | .results1 fdb 1
4142 | .endtst
4143 |
4144 | ;--------------------------------------
4145 |
4146 | .test "2 1 MIN"
E6CB: CE E6D9 4147 | ldu #.datastack2
E6CE: 8E 0E28 4148 | ldx #forth_core_min.xt
E6D1: BD 0C04 4149 | jsr forth_core_execute.asm
4150 | .assert /u = .results2 , "U"
4151 | .assert @@/,u = 1 , "result"
E6D4: 39 4152 | rts
4153 |
E6D5: 0000 4154 | fdb 0
E6D7: 0000 4155 | fdb 0
E6D9: 0001 4156 | .datastack2 fdb 1
E6DB: 0002 4157 | .results2 fdb 2
4158 | .endtst
4159 |
4160 | ;**********************************************************************
4161 |
0E3C: 4162 | forth_core_mod ; ( n1 n2 -- n3 )
0E3C: 0E21 4163 | fdb forth_core_min
0E3E: 0003 4164 | fdb .xt - .name
0E40: 4D4F44 4165 | .name fcc "MOD"
0E43: 0678 4166 | .xt fdb forth_core_colon.runtime
4167 | ;========================================
4168 | ; : MOD /MOD DROP ;
4169 | ;========================================
0E45: 055C 4170 | fdb forth_core_slash_mod.xt
0E47: 0A65 4171 | fdb forth_core_drop.xt
0E49: 0C1A 4172 | fdb forth_core_exit.xt
4173 |
4174 | ;**********************************************************************
4175 |
0E4B: 4176 | forth_core_move ; ( addr1 addr2 u -- )
0E4B: 0E3C 4177 | fdb forth_core_mod
0E4D: 0004 4178 | fdb .xt - .name
0E4F: 4D4F5645 4179 | .name fcc "MOVE"
0E53: 0E55 4180 | .xt fdb .body
0E55: EC 44 4181 | .body ldd 4,u ; addr1 >= addr2
0E57: 10A3 42 4182 | cmpd 2,u
0E5A: 24 0C 4183 | bhs .forward
0E5C: E3 C4 4184 | addd ,u ; addr1[n] < addr2
0E5E: 10A3 42 4185 | cmpd 2,u
0E61: 25 05 4186 | blo .forward
0E63: 8E 2A69 4187 | ldx #forth_string_c_move_up.xt
0E66: 20 03 4188 | bra .done
0E68: 8E 2A41 4189 | .forward ldx #forth_string_c_move.xt
0E6B: 17 FD96 4190 | .done lbsr forth_core_execute.asm
0E6E: AE A1 4191 | ldx ,y++
0E70: 6E 94 4192 | jmp [,x]
4193 |
4194 | ;----------------------------------
4195 |
4196 | .test "MOVE buf buf+1 2"
E6DD: CE E6EB 4197 | ldu #.datastack1
E6E0: 8E 0E53 4198 | ldx #forth_core_move.xt
E6E3: BD 0C04 4199 | jsr forth_core_execute.asm
4200 | .assert /u = .result1
4201 | .assert @.buf10 = 12
4202 | .assert @.buf11 = 12
4203 | .assert @.buf12 = 34
E6E6: 39 4204 | rts
4205 |
E6E7: 0000 4206 | fdb 0
E6E9: 0000 4207 | fdb 0
E6EB: 0002 4208 | .datastack1 fdb 2
E6ED: E6F3 4209 | fdb .buf11
E6EF: E6F2 4210 | fdb .buf10
E6F1: 12 4211 | .result1 nop
E6F2: 0C 4212 | .buf10 fcb 12
E6F3: 22 4213 | .buf11 fcb 34
E6F4: 38 4214 | .buf12 fcb 56
4215 | .endtst
4216 |
4217 | ;**********************************************************************
4218 |
0E72: 4219 | forth_core_negate ; ( n1 -- n2 )
0E72: 0E4B 4220 | fdb forth_core_move
0E74: 0006 4221 | fdb .xt - .name
0E76: 4E4547415445 4222 | .name fcc "NEGATE"
0E7C: 0E7E 4223 | .xt fdb .body
0E7E: 4F 4224 | .body clra
0E7F: 5F 4225 | clrb
0E80: A3 C4 4226 | subd ,u
0E82: ED C4 4227 | std ,u
0E84: AE A1 4228 | ldx ,y++
0E86: 6E 94 4229 | jmp [,x]
4230 |
4231 | ;**********************************************************************
4232 |
0E88: 4233 | forth_core_or ; ( x1 x2 -- x3 )
0E88: 0E72 4234 | fdb forth_core_negate
0E8A: 0002 4235 | fdb .xt - .name
0E8C: 4F52 4236 | .name fcc "OR"
0E8E: 0E90 4237 | .xt fdb .body
0E90: 37 06 4238 | .body pulu d
0E92: AA C4 4239 | ora ,u
0E94: EA 41 4240 | orb 1,u
0E96: ED C4 4241 | std ,u
0E98: AE A1 4242 | ldx ,y++
0E9A: 6E 94 4243 | jmp [,x]
4244 |
4245 | ;**********************************************************************
4246 |
0E9C: 4247 | forth_core_over ; ( x1 x2 -- x1 x2 x1 )
0E9C: 0E88 4248 | fdb forth_core_or
0E9E: 0004 4249 | fdb .xt - .name
0EA0: 4F564552 4250 | .name fcc "OVER"
0EA4: 0EA6 4251 | .xt fdb .body
0EA6: EC 42 4252 | .body ldd 2,u
0EA8: 36 06 4253 | pshu d
0EAA: AE A1 4254 | ldx ,y++
0EAC: 6E 94 4255 | jmp [,x]
4256 |
4257 | ;**********************************************************************
4258 |
0EAE: 4259 | forth_core_postpone ; ( "name" -- )
0EAE: 0E9C 4260 | fdb forth_core_over
0EB0: A008 4261 | fdb _IMMED | _NOINTERP :: .xt - .name
0EB2: 504F5354504F... 4262 | .name fcc "POSTPONE"
0EBA: 0678 4263 | .xt fdb forth_core_colon.runtime
4264 | ;=================================================
4265 | ; : POSTPONE
4266 | ; ( 1 ) BL WORD FIND CASE
4267 | ; ( 2 ) 0 OF -48 THROW ENDOF
4268 | ; ( 3 ) 1 OF COMPILE, ENDOF
4269 | ; ( 4 ) -1 OF LITERAL ['] COMPILE, COMPILE, ENDOF
4270 | ; ( 5 ) ENDCASE
4271 | ; ( 6 ) ; IMMEDIATE
4272 | ;=================================================
0EBC: 08C9 4273 | fdb forth_core_b_l.xt ; ( 1 )
0EBE: 1217 4274 | fdb forth_core_word.xt
0EC0: 2780 4275 | fdb forth_search_find.xt
0EC2: 0D84 4276 | fdb forth_core_literal.runtime_xt ; ( 2 )
0EC4: 0000 4277 | fdb 0
0EC6: 166A 4278 | fdb forth_core_ext_of.runtime_xt
0EC8: 0ED0 4279 | fdb .L3
0ECA: 0D84 4280 | fdb forth_core_literal.runtime_xt
0ECC: FFD0 4281 | fdb -48
0ECE: 1E8A 4282 | fdb forth_exception_throw.xt
0ED0: 0D84 4283 | .L3 fdb forth_core_literal.runtime_xt
0ED2: 0001 4284 | fdb 1
0ED4: 166A 4285 | fdb forth_core_ext_of.runtime_xt
0ED6: 0EDE 4286 | fdb .L4
0ED8: 14AC 4287 | fdb forth_core_ext_compile_comma.xt
0EDA: 1430 4288 | fdb forth_core_ext_again.runtime_xt
0EDC: 0EF4 4289 | fdb .L6
0EDE: 0D84 4290 | .L4 fdb forth_core_literal.runtime_xt
0EE0: FFFF 4291 | fdb -1
0EE2: 166A 4292 | fdb forth_core_ext_of.runtime_xt
0EE4: 0EF2 4293 | fdb .L5
0EE6: 0D71 4294 | fdb forth_core_literal.xt
0EE8: 0D84 4295 | fdb forth_core_literal.runtime_xt
0EEA: 14AC 4296 | fdb forth_core_ext_compile_comma.xt
0EEC: 14AC 4297 | fdb forth_core_ext_compile_comma.xt
0EEE: 1430 4298 | fdb forth_core_ext_again.runtime_xt
0EF0: 0EF4 4299 | fdb .L6
0EF2: 0A65 4300 | .L5 fdb forth_core_drop.xt
0EF4: 0C1A 4301 | .L6 fdb forth_core_exit.xt
4302 |
4303 | ;**********************************************************************
4304 |
0EF6: 4305 | forth_core_quit ; ( -- ) ( R: i*x -- )
0EF6: 0EAE 4306 | fdb forth_core_postpone
0EF8: 0004 4307 | fdb .xt - .name
0EFA: 51554954 4308 | .name fcc "QUIT"
0EFE: 0678 4309 | .xt fdb forth_core_colon.runtime
4310 | ;===================================================================
4311 | ; : (abort) ." ABORT!" CR reset-dsp QUIT ;
4312 | ; : QUIT
4313 | ; reset-rsp
4314 | ; 0 set-source-id POSTPONE [
4315 | ; BEGIN REFILL WHILE
4316 | ; ['] eval CATCH CASE
4317 | ; 0 OF STATE @ 0= IF ." OK" CR THEN ENDOF
4318 | ; -1 OF (abort) ENDOF
4319 | ; -2 OF (abort") (abort) ENDOF
4320 | ; DUP ." EXCEPTION #" . CR
4321 | ; ENDCASE
4322 | ; REPEAT BYE ;
4323 | ;=====================================================================
0F00: 033B 4324 | fdb forth__private_reset_rsp_xt
0F02: 0D84 4325 | fdb forth_core_literal.runtime_xt
0F04: 0000 4326 | fdb 0
0F06: 0354 4327 | fdb forth__private_set_source_i_d
0F08: 1286 4328 | fdb forth_core_left_bracket.xt
0F0A: 1738 4329 | .L3 fdb forth_core_ext_refill.xt
0F0C: 0CD1 4330 | fdb forth_core_if.runtime_xt
0F0E: 0F72 4331 | fdb .L11
0F10: 0D84 4332 | fdb forth_core_literal.runtime_xt
0F12: 0188 4333 | fdb forth__private_eval_xt
0F14: 1E53 4334 | fdb forth_exception_catch.xt
0F16: 0D84 4335 | fdb forth_core_literal.runtime_xt
0F18: 0000 4336 | fdb 0
0F1A: 166A 4337 | fdb forth_core_ext_of.runtime_xt
0F1C: 0F37 4338 | fdb .L6
0F1E: 2626 4339 | fdb forth_tools_ext_state.xt
0F20: 07E2 4340 | fdb forth_core_fetch.xt
0F22: 057E 4341 | fdb forth_core_zero_equals.xt
0F24: 0CD1 4342 | fdb forth_core_if.runtime_xt
0F26: 0F33 4343 | fdb .L5
0F28: 2B7C 4344 | fdb forth_string_sliteral.runtime_xt ; XXX
0F2A: 0003 4345 | fdb 3
0F2C: 204F4B 4346 | fcc ' OK'
0F2F: 1124 4347 | fdb forth_core_type.xt
0F31: 099E 4348 | fdb forth_core_c_r.xt ; XXX
0F33: 1430 4349 | .L5 fdb forth_core_ext_again.runtime_xt
0F35: 0F6E 4350 | fdb .L10
0F37: 0D84 4351 | .L6 fdb forth_core_literal.runtime_xt
0F39: FFFF 4352 | fdb -1
0F3B: 166A 4353 | fdb forth_core_ext_of.runtime_xt
0F3D: 0F45 4354 | fdb .L7
0F3F: 0F8E 4355 | fdb .abort_xt
0F41: 1430 4356 | fdb forth_core_ext_again.runtime_xt
0F43: 0F6E 4357 | fdb .L10
0F45: 0D84 4358 | .L7 fdb forth_core_literal.runtime_xt
0F47: FFFE 4359 | fdb -2
0F49: 166A 4360 | fdb forth_core_ext_of.runtime_xt
0F4B: 0F55 4361 | fdb .L8
0F4D: 0F76 4362 | fdb .abortq_xt
0F4F: 0F8E 4363 | fdb .abort_xt
0F51: 1430 4364 | fdb forth_core_ext_again.runtime_xt
0F53: 0F6E 4365 | fdb .L10
0F55: 0A74 4366 | .L8 fdb forth_core_dupe.xt
0F57: 2B7C 4367 | fdb forth_string_sliteral.runtime_xt
0F59: 000B 4368 | fdb .expmsg_len
0F5B: 455843455054... 4369 | .expmsg fcc 'EXCEPTION #'
4370 | .expmsg_len equ * - .expmsg
0F66: 1124 4371 | fdb forth_core_type.xt
0F68: 0517 4372 | fdb forth_core_dot.xt
0F6A: 099E 4373 | fdb forth_core_c_r.xt
0F6C: 0A65 4374 | fdb forth_core_drop.xt
0F6E: 1430 4375 | .L10 fdb forth_core_ext_again.runtime_xt
0F70: 0F0A 4376 | fdb .L3
0F72: 2542 4377 | .L11 fdb forth_tools_ext_bye.xt
0F74: 0C1A 4378 | fdb forth_core_exit.xt
4379 |
0F76: 0F78 4380 | .abortq_xt fdb .abortq_body
0F78: 9E 42 4381 | .abortq_body ldx forth__abortq
0F7A: DC 44 4382 | ldd forth__abortql
0F7C: 36 16 4383 | pshu x,d
0F7E: 8E 1124 4384 | ldx #forth_core_type.xt
0F81: 17 FC80 4385 | lbsr forth_core_execute.asm
0F84: C6 20 4386 | ldb #' '
0F86: AD 9F0004 4387 | jsr [forth__vector_putchar]
0F8A: AE A1 4388 | ldx ,y++
0F8C: 6E 94 4389 | jmp [,x]
4390 |
0F8E: 0678 4391 | .abort_xt fdb forth_core_colon.runtime
0F90: 2B7C 4392 | fdb forth_string_sliteral.runtime_xt
0F92: 0006 4393 | fdb .abort_msg_len
0F94: 41424F525421 4394 | .abort_msg fcc "ABORT!"
4395 | .abort_msg_len equ * - .abort_msg
0F9A: 1124 4396 | fdb forth_core_type.xt
0F9C: 099E 4397 | fdb forth_core_c_r.xt
0F9E: 0333 4398 | fdb forth__private_reset_dsp_xt
0FA0: 0EFE 4399 | fdb forth_core_quit.xt
0FA2: 0C1A 4400 | fdb forth_core_exit.xt
4401 |
4402 | ;--------------------------------------------------
4403 |
4404 | .test "QUIT ( 123 987 + . BYE )"
4405 | .opt test prot rw , forth__free , $DFFF
4406 | .opt test prot n , .nu1
4407 | .opt test pokew forth__vector_bye , .bye
4408 | .opt test pokew forth__vector_getchar , .getchar
4409 | .opt test pokew forth__vector_putchar , .putchar
4410 | .opt test pokew forth__here_top , $DB00
4411 | .opt test pokew forth__ds_bottom , $DB00
4412 | .opt test pokew forth__ds_top , $DC00
4413 | .opt test pokew forth__source , .source
4414 | .opt test pokew forth__source_len , 0
4415 | .opt test pokew forth__base , 10
4416 | .opt test pokew forth__here , forth__free
E6F5: 30 62 4417 | leax 2,s
E6F7: 9F 0C 4418 | stx forth__rs_top
E6F9: 30 89FF00 4419 | leax -256,x
E6FD: 9F 0A 4420 | stx forth__rs_bottom
E6FF: 10FF E75F 4421 | sts .ret
E703: DE 08 4422 | ldu forth__ds_top
E705: 8E 0EFE 4423 | ldx #forth_core_quit.xt
E708: BD 0C04 4424 | jsr forth_core_execute.asm
4425 | .assert 1 = 0 , "wrong bye"
E70B: 39 4426 | rts
4427 |
E70C: 34 10 4428 | .getchar pshs x
E70E: BE E719 4429 | ldx .input
E711: 4F 4430 | clra
E712: E6 80 4431 | ldb ,x+
E714: BF E719 4432 | stx .input
E717: 35 90 4433 | puls x,pc
E719: E71B 4434 | .input fdb .inputbuf
E71B: 313233203938... 4435 | .inputbuf ascii '123 987 + .\nBYE\n'
E72B: 00 4436 | .nu1 fcb 0
4437 |
E72C: 34 10 4438 | .putchar pshs x
E72E: BE E738 4439 | ldx .output
E731: E7 80 4440 | stb ,x+
E733: BF E738 4441 | stx .output
E736: 35 90 4442 | puls x,pc
E738: E73A 4443 | .output fdb .outputbuf
E73A: 4444 | .outputbuf rmb 32 ; "1110 \nOK\n"
4445 |
E75A: 10FE E75F 4446 | .bye lds .ret
4447 | .assert /u = @@forth__ds_top , "U (bye)"
4448 | .assert .source = "BYE" , "source"
4449 | .assert .outputbuf = "1110 OK\n" , "output"
E75E: 39 4450 | rts
4451 |
E75F: 0000 4452 | .ret fdb 0
4453 |
E761: 4454 | .source rmb INPUT_SIZE
4455 |
4456 | .endtst
4457 |
4458 | ;**********************************************************************
4459 |
0FA4: 4460 | forth_core_r_from ; E ( -- x ) ( R: x -- )
0FA4: 0EF6 4461 | fdb forth_core_quit
0FA6: 2002 4462 | fdb _NOINTERP :: .xt - .name
0FA8: 523E 4463 | .name fcc "R>"
0FAA: 0FAC 4464 | .xt fdb .body
0FAC: 35 06 4465 | .body puls d
0FAE: 36 06 4466 | pshu d
0FB0: AE A1 4467 | ldx ,y++
0FB2: 6E 94 4468 | jmp [,x]
4469 |
4470 | ;**********************************************************************
4471 |
0FB4: 4472 | forth_core_r_fetch ; E ( -- x ) ( R: x -- x )
0FB4: 0FA4 4473 | fdb forth_core_r_from
0FB6: 2002 4474 | fdb _NOINTERP :: .xt - .name
0FB8: 5240 4475 | .name fcc "R@"
0FBA: 0FBC 4476 | .xt fdb .body
0FBC: EC E4 4477 | .body ldd ,s
0FBE: 36 06 4478 | pshu d
0FC0: AE A1 4479 | ldx ,y++
0FC2: 6E 94 4480 | jmp [,x]
4481 |
4482 | ;**********************************************************************
4483 |
0FC4: 4484 | forth_core_recurse ; ( -- )
0FC4: 0FB4 4485 | fdb forth_core_r_fetch
0FC6: A007 4486 | fdb _IMMED | _NOINTERP :: .xt - .name
0FC8: 524543555253... 4487 | .name fcc "RECURSE"
0FCF: 0FD1 4488 | .xt fdb .body
0FD1: 9E 10 4489 | .body ldx forth__here ; get current comp location
0FD3: DC 28 4490 | ldd forth__create_xt ; get xt of current word
0FD5: ED 81 4491 | std ,x++ ; recurse
0FD7: 9F 10 4492 | stx forth__here
0FD9: AE A1 4493 | ldx ,y++ ; NEXT
0FDB: 6E 94 4494 | jmp [,x]
4495 |
4496 | ;----------------------------------------------------
4497 |
4498 | .test "RECURSE runtime"
4499 | .opt test prot n , ._nw2
E7B1: CE E7BE 4500 | ldu #.datastack
E7B4: 8E E7C1 4501 | ldx #.recurse_xt
E7B7: 7E 0C04 4502 | jmp forth_core_execute.asm
4503 |
E7BA: 0000 4504 | fdb 0
E7BC: 0000 4505 | fdb 0
E7BE: 0007 4506 | .datastack fdb 7
E7C0: 00 4507 | ._nw2 fcb 0
4508 |
E7C1: 0678 4509 | .recurse_xt fdb forth_core_colon.runtime
E7C3: 0A74 4510 | fdb forth_core_dupe.xt
E7C5: 057E 4511 | fdb forth_core_zero_equals.xt
E7C7: 0CD1 4512 | fdb forth_core_if.runtime_xt
E7C9: E7CD 4513 | fdb .L1
E7CB: 0C1A 4514 | fdb forth_core_exit.xt
E7CD: 059E 4515 | .L1 fdb forth_core_one_minus.xt
E7CF: E7C1 4516 | fdb .recurse_xt
E7D1: 0C1A 4517 | fdb forth_core_exit.xt
4518 | .endtst
4519 |
4520 | ;**********************************************************************
4521 |
0FDD: 4522 | forth_core_repeat ; C ( C: orig dest -- ) R ( -- )
0FDD: 0FC4 4523 | fdb forth_core_recurse
0FDF: A006 4524 | fdb _IMMED | _NOINTERP :: .xt - .name
0FE1: 524550454154 4525 | .name fcc "REPEAT"
0FE7: 0678 4526 | .xt fdb forth_core_colon.runtime
4527 | ;===============================================
4528 | ; : REPEAT POSTPONE AGAIN POSTPONE THEN ;
4529 | ;===============================================
0FE9: 141D 4530 | fdb forth_core_ext_again.xt
0FEB: 1110 4531 | fdb forth_core_then.xt
0FED: 0C1A 4532 | fdb forth_core_exit.xt
4533 |
4534 | ;**********************************************************************
4535 |
0FEF: 4536 | forth_core_rote ; ( x1 x2 x3 -- x2 x3 x1 )
0FEF: 0FDD 4537 | fdb forth_core_repeat
0FF1: 0003 4538 | fdb .xt - .name
0FF3: 524F54 4539 | .name fcc "ROT"
0FF6: 0FF8 4540 | .xt fdb .body
0FF8: 34 30 4541 | .body pshs x,y
0FFA: 37 36 4542 | pulu y,x,d
0FFC: 36 16 4543 | pshu x,d
0FFE: 36 20 4544 | pshu y
1000: 35 30 4545 | puls x,y
1002: AE A1 4546 | ldx ,y++
1004: 6E 94 4547 | jmp [,x]
4548 |
4549 | ;---------------------------------
4550 |
4551 | .test "ROT"
E7D3: CE E7DF 4552 | ldu #.datastack
E7D6: 8E 0FF6 4553 | ldx #forth_core_rote.xt
E7D9: BD 0C04 4554 | jsr forth_core_execute.asm
4555 | .assert /u = .datastack , "U"
4556 | .assert @@/,u = 1 , ",U"
4557 | .assert @@/2,u = 3 , "2,U"
4558 | .assert @@/4,u = 2 , "4,U"
E7DC: 39 4559 | rts
4560 |
E7DD: 0000 4561 | fdb 0
E7DF: 0003 4562 | .datastack fdb 3
E7E1: 0002 4563 | fdb 2
E7E3: 0001 4564 | fdb 1
4565 | .endtst
4566 |
4567 | ;**********************************************************************
4568 |
1006: 4569 | forth_core_r_shift ; ( x1 u -- x2 )
1006: 0FEF 4570 | fdb forth_core_rote
1008: 0006 4571 | fdb .xt - .name
100A: 525348494654 4572 | .name fcc "RSHIFT"
1010: 1012 4573 | .xt fdb .body
1012: AE C1 4574 | .body ldx ,u++ ; get count
1014: 27 0A 4575 | beq .done ; if 0, leave (no shift)
1016: EC C4 4576 | ldd ,u ; get value to shift
1018: 44 4577 | .loop lsra ; right shift
1019: 56 4578 | rorb
101A: 30 1F 4579 | leax -1,x ; do more bits
101C: 26 FA 4580 | bne .loop
101E: ED C4 4581 | std ,u ; save result
1020: AE A1 4582 | .done ldx ,y++ ; NEXT
1022: 6E 94 4583 | jmp [,x]
4584 |
4585 | ;**********************************************************************
4586 |
1024: 4587 | forth_core_s_quote ; ( "ccc" -- ) ( -- c-addr u )
1024: 1006 4588 | fdb forth_core_r_shift
1026: A002 4589 | fdb _IMMED | _NOINTERP :: .xt - .name
1028: 5322 4590 | .name fcc 'S"'
102A: 0678 4591 | .xt fdb forth_core_colon.runtime
4592 | ;===================================================
4593 | ; : S" [CHAR] " PARSE POSTPONE SLITERAL ; IMMEDIATE
4594 | ;===================================================
102C: 0D84 4595 | fdb forth_core_literal.runtime_xt
102E: 0022 4596 | fdb '"'
1030: 1698 4597 | fdb forth_core_ext_parse.xt
1032: 2B59 4598 | fdb forth_string_sliteral.xt
1034: 0C1A 4599 | fdb forth_core_exit.xt
4600 |
4601 | ;--------------------------------------------
4602 |
4603 | .test 'S" compile'
4604 | .opt test pokew forth__source , .buffer1
4605 | .opt test pokew forth__source_len , .len1
4606 | .opt test pokew forth__in , 0
4607 | .opt test pokew forth__here , .foo_body
E7E5: CE E7F3 4608 | ldu #.datastack1
E7E8: 8E 102A 4609 | ldx #forth_core_s_quote.xt
E7EB: BD 0C04 4610 | jsr forth_core_execute.asm
4611 | .assert /u = .datastack1 , "U"
4612 | .assert @@.foo_body = forth_string_sliteral.runtime_xt , "xt"
4613 | .assert @@.foo_len = .len1 , "len"
4614 | .assert .foo_addr = 'This is a message' , "text"
4615 | .assert @@.stop = -1 , "no-write"
E7EE: 39 4616 | rts
4617 |
E7EF: 0000 4618 | fdb 0
E7F1: 0000 4619 | fdb 0
E7F3: 0000 4620 | .datastack1 fdb 0
4621 |
E7F5: 546869732069... 4622 | .buffer1 fcc 'This is a message'
4623 | .len1 equ * - .buffer1
4624 |
E806: 0678 4625 | fdb forth_core_colon.runtime
E808: 0000 4626 | .foo_body fdb 0
E80A: 0000 4627 | .foo_len fdb 0
E80C: 4628 | .foo_addr rmb .len1
E81D: FFFF 4629 | .stop fdb -1
4630 | .endtst
4631 |
4632 | ;---------------------------------------------
4633 |
4634 | .test 'S" output test'
E81F: CE E82D 4635 | ldu #.datastack2
E822: 8E E82F 4636 | ldx #.foo_xt
E825: BD 0C04 4637 | jsr forth_core_execute.asm
4638 | .assert /u = .result2 , "U"
4639 | .assert @@/0,u = .len2 , "len"
4640 | .assert @@/2,u = .text2 , "text"
E828: 39 4641 | rts
4642 |
E829: 0000 4643 | .result2 fdb 0
E82B: 0000 4644 | fdb 0
E82D: 0000 4645 | .datastack2 fdb 0
4646 |
E82F: 0678 4647 | .foo_xt fdb forth_core_colon.runtime
E831: 2B7C 4648 | fdb forth_string_sliteral.runtime_xt
E833: 0004 4649 | fdb .len2
E835: 74657374 4650 | .text2 fcc 'test'
4651 | .len2 equ * - .text2
E839: 0C1A 4652 | fdb forth_core_exit.xt
4653 | .endtst
4654 |
4655 | ;**********************************************************************
4656 |
1036: 4657 | forth_core_s_to_d ; ( n -- d )
1036: 1024 4658 | fdb forth_core_s_quote
1038: 0003 4659 | fdb .xt - .name
103A: 533E44 4660 | .name fcc "S>D"
103D: 0678 4661 | .xt fdb forth_core_colon.runtime
4662 | ;=======================================
4663 | ; : S>D DUP 0< ;
4664 | ;=======================================
103F: 0A74 4665 | fdb forth_core_dupe.xt
1041: 056E 4666 | fdb forth_core_zero_less.xt
1043: 0C1A 4667 | fdb forth_core_exit.xt
4668 |
4669 | ;**********************************************************************
4670 |
1045: 4671 | forth_core_sign ; ( n -- )
1045: 1036 4672 | fdb forth_core_s_to_d
1047: 0004 4673 | fdb .xt - .name
1049: 5349474E 4674 | .name fcc "SIGN"
104D: 0678 4675 | .xt fdb forth_core_colon.runtime
4676 | ;=============================================
4677 | ; : SIGN 0< IF [CHAR] - HOLD THEN ;
4678 | ;=============================================
104F: 056E 4679 | fdb forth_core_zero_less.xt
1051: 0CD1 4680 | fdb forth_core_if.runtime_xt
1053: 105B 4681 | fdb .L1
1055: 0D84 4682 | fdb forth_core_literal.runtime_xt
1057: 002D 4683 | fdb '-'
1059: 0C99 4684 | fdb forth_core_hold.xt
105B: 0C1A 4685 | .L1 fdb forth_core_exit.xt
4686 |
4687 | ;**********************************************************************
4688 |
4689 | Pnumerator set 4
4690 | Pdemoninator set 2
4691 | Psnum set 1
4692 | Psdemon set 0
4693 |
4694 | Rremainder set 6
4695 | Rquotient set 4
4696 |
105D: 4697 | forth_core_s_m_slash_rem ; ( d1 n2 -- n2 n3 )
105D: 1045 4698 | fdb forth_core_sign
105F: 0006 4699 | fdb .xt - .name
1061: 534D2F52454D 4700 | .name fcc "SM/REM"
1067: 1069 4701 | .xt fdb .body
1069: EC C4 4702 | .body ldd ,u ; check for d1/0
106B: 27 3E 4703 | beq .throw_div0
106D: 33 5E 4704 | leau -2,u ; space for sign flags
106F: EC 42 4705 | ldd Pdemoninator,u ; check sign of demoninator
1071: A7 C4 4706 | sta Psdemon,u ; save sign for demoninator
1073: 2A 06 4707 | bpl .10
1075: 40 4708 | nega ; negate demoninator
1076: 50 4709 | negb
1077: 82 00 4710 | sbca #0
1079: ED 42 4711 | std Pdemoninator,u
107B: A6 44 4712 | .10 lda Pnumerator,u ; check sign of numerator
107D: A7 41 4713 | sta Psnum,u ; save sign for numerator
107F: 2A 05 4714 | bpl .20
1081: 30 44 4715 | leax Pnumerator,u ; negate numerator
1083: 17 EFE4 4716 | lbsr forth__math_neg32
1086: 30 42 4717 | .20 leax Pdemoninator,u ; do that divide thang
1088: 17 F036 4718 | lbsr forth__math_div32
108B: A6 41 4719 | lda Psnum,u ; adjust sign of quotient
108D: A8 C4 4720 | eora Psdemon,u
108F: 2A 08 4721 | bpl .30
1091: EC 44 4722 | ldd Rquotient,u
1093: 40 4723 | nega
1094: 50 4724 | negb
1095: 82 00 4725 | sbca #0
1097: ED 44 4726 | std Rquotient,u
1099: 6D 41 4727 | .30 tst Psnum,u ; adjust sign of remainder
109B: 2A 08 4728 | bpl .40
109D: EC 46 4729 | ldd Rremainder,u ; if matches sign of numerator
109F: 40 4730 | nega
10A0: 50 4731 | negb
10A1: 82 00 4732 | sbca #0
10A3: ED 46 4733 | std Rremainder,u
10A5: 33 44 4734 | .40 leau 4,u ; adjust data stack
10A7: AE A1 4735 | ldx ,y++
10A9: 6E 94 4736 | jmp [,x]
10AB: CC FFF6 4737 | .throw_div0 ldd #-10
10AE: 16 0E09 4738 | lbra forth_exception_throw.asm
4739 |
4740 | ;--------------------------------------
4741 |
4742 | .test "SM/REM +numerator +demoninator"
E83B: CE E847 4743 | ldu #.datastack1
E83E: 8E 1067 4744 | ldx #forth_core_s_m_slash_rem.xt
E841: BD 0C04 4745 | jsr forth_core_execute.asm
4746 | .assert /u = .result1
4747 | .assert @@/0,u = 1
4748 | .assert @@/2,u = 3
E844: 39 4749 | rts
4750 |
E845: 0000 4751 | fdb 0
E847: 0007 4752 | .datastack1 fdb 7
E849: 0000 4753 | .result1 fdb 0
E84B: 000A 4754 | fdb 10
4755 | .endtst
4756 |
4757 | ;--------------------------------------
4758 |
4759 | .test "SM/REM -numerator +demoninator"
E84D: CE E85D 4760 | ldu #.datastack2
E850: 8E 1067 4761 | ldx #forth_core_s_m_slash_rem.xt
E853: BD 0C04 4762 | jsr forth_core_execute.asm
4763 | .assert /u = .result2
4764 | .assert @@/0,u = -1
4765 | .assert @@/2,u = -3
E856: 39 4766 | rts
4767 |
E857: 0000 4768 | fdb 0
E859: 0000 4769 | fdb 0
E85B: 0000 4770 | fdb 0
E85D: 0007 4771 | .datastack2 fdb 7
E85F: FFFF 4772 | .result2 fdb $FFFF
E861: FFF6 4773 | fdb -10
4774 | .endtst
4775 |
4776 | ;--------------------------------------
4777 |
4778 | .test "SM/REM +numerator -demoninator"
E863: CE E873 4779 | ldu #.datastack3
E866: 8E 1067 4780 | ldx #forth_core_s_m_slash_rem.xt
E869: BD 0C04 4781 | jsr forth_core_execute.asm
4782 | .assert /u = .result3
4783 | .assert @@/0,u = -1
4784 | .assert @@/2,u = 3
E86C: 39 4785 | rts
4786 |
E86D: 0000 4787 | fdb 0
E86F: 0000 4788 | fdb 0
E871: 0000 4789 | fdb 0
E873: FFF9 4790 | .datastack3 fdb -7
E875: 0000 4791 | .result3 fdb 0
E877: 000A 4792 | fdb 10
4793 | .endtst
4794 |
4795 | ;--------------------------------------
4796 |
4797 | .test "SM/REM -numerator -demoninator"
E879: CE E889 4798 | ldu #.datastack4
E87C: 8E 1067 4799 | ldx #forth_core_s_m_slash_rem.xt
E87F: BD 0C04 4800 | jsr forth_core_execute.asm
4801 | .assert /u = .result4
4802 | .assert @@/0,u = 1
4803 | .assert @@/2,u = -3
E882: 39 4804 | rts
4805 |
E883: 0000 4806 | fdb 0
E885: 0000 4807 | fdb 0
E887: 0000 4808 | fdb 0
E889: FFF9 4809 | .datastack4 fdb -7
E88B: FFFF 4810 | .result4 fdb $FFFF
E88D: FFF6 4811 | fdb -10
4812 | .endtst
4813 |
4814 | ;**********************************************************************
4815 |
10B1: 4816 | forth_core_source ; ( -- c-addr u )
10B1: 105D 4817 | fdb forth_core_s_m_slash_rem
10B3: 0006 4818 | fdb .xt - .name
10B5: 534F55524345 4819 | .name fcc "SOURCE"
10BB: 10BD 4820 | .xt fdb .body
10BD: 9E 20 4821 | .body ldx forth__source
10BF: DC 22 4822 | ldd forth__source_len
10C1: 36 16 4823 | pshu x,d
10C3: AE A1 4824 | ldx ,y++
10C5: 6E 94 4825 | jmp [,x]
4826 |
4827 | ;**********************************************************************
4828 |
10C7: 4829 | forth_core_space ; ( n -- )
10C7: 10B1 4830 | fdb forth_core_source
10C9: 0005 4831 | fdb .xt - .name
10CB: 5350414345 4832 | .name fcc "SPACE"
10D0: 0678 4833 | .xt fdb forth_core_colon.runtime
4834 | ;=======================================
4835 | ; : SPACE BL EMIT ;
4836 | ;=======================================
10D2: 08C9 4837 | fdb forth_core_b_l.xt
10D4: 0A9C 4838 | fdb forth_core_emit.xt
10D6: 0C1A 4839 | fdb forth_core_exit.xt
4840 |
4841 | ;**********************************************************************
4842 |
10D8: 4843 | forth_core_spaces ; ( n -- )
10D8: 10C7 4844 | fdb forth_core_space
10DA: 0006 4845 | fdb .xt - .name
10DC: 535041434553 4846 | .name fcc "SPACES"
10E2: 0678 4847 | .xt fdb forth_core_colon.runtime
4848 | ;====================================
4849 | ; SPACES 0 ?DO SPACE LOOP ;
4850 | ;====================================
10E4: 0D84 4851 | fdb forth_core_literal.runtime_xt
10E6: 0000 4852 | fdb 0
10E8: 13D4 4853 | fdb forth_core_ext_question_do.runtime_xt
10EA: 10F2 4854 | fdb .L1
10EC: 10D0 4855 | .L2 fdb forth_core_space.xt
10EE: 0D9E 4856 | fdb forth_core_loop.runtime_xt
10F0: 10EC 4857 | fdb .L2
10F2: 0C1A 4858 | .L1 fdb forth_core_exit.xt
4859 |
4860 | ;**********************************************************************
4861 | ;
4862 | ;forth_core_state ; TOOLS-EXT STATE
4863 | ; fdb forth_core_spaces
4864 | ; fdb .xt - .name
4865 | ;.name fcc "STATE"
4866 | ;.xt fdb forth_core_spaces
4867 | ; fdb forth_core_colon.runtime
4868 | ; fdb forth_core_literal.runtime_xt
4869 | ; fdb -13
4870 | ; fdb forth_exception_throw.xt
4871 | ;
4872 | ;**********************************************************************
4873 |
10F4: 4874 | forth_core_swap ; ( x1 x2 -- x2 x1 )
10F4: 10D8 4875 | fdb forth_core_spaces
10F6: 0004 4876 | fdb .xt - .name
10F8: 53574150 4877 | .name fcc "SWAP"
10FC: 10FE 4878 | .xt fdb .body
10FE: 37 16 4879 | .body pulu x,d
1100: 1E 01 4880 | exg d,x
1102: 36 16 4881 | pshu x,d
1104: AE A1 4882 | ldx ,y++
1106: 6E 94 4883 | jmp [,x]
4884 |
4885 | ;**********************************************************************
4886 |
1108: 4887 | forth_core_then ; C ( C: orig -- ) R ( -- )
1108: 10F4 4888 | fdb forth_core_swap
110A: A004 4889 | fdb _IMMED | _NOINTERP :: .xt - .name
110C: 5448454E 4890 | .name fcc "THEN"
1110: 1112 4891 | .xt fdb .body
1112: 37 10 4892 | .body pulu x ; get orig
1114: DC 10 4893 | ldd forth__here
1116: ED 84 4894 | std ,x
1118: AE A1 4895 | ldx ,y++
111A: 6E 94 4896 | jmp [,x]
4897 |
4898 | ;**********************************************************************
4899 |
111C: 4900 | forth_core_type ; ( c-addr u -- )
111C: 1108 4901 | fdb forth_core_then
111E: 0004 4902 | fdb .xt - .name
1120: 54595045 4903 | .name fcc "TYPE"
1124: 0678 4904 | .xt fdb forth_core_colon.runtime
4905 | ;===================================================
4906 | ; : TYPE 0 ?DO DUP C@ EMIT CHAR+ LOOP DROP ;
4907 | ;==================================================
1126: 0D84 4908 | fdb forth_core_literal.runtime_xt
1128: 0000 4909 | fdb 0
112A: 13D4 4910 | fdb forth_core_ext_question_do.runtime_xt
112C: 113A 4911 | fdb .L1
112E: 0A74 4912 | .L2 fdb forth_core_dupe.xt
1130: 08F9 4913 | fdb forth_core_c_fetch.xt
1132: 0A9C 4914 | fdb forth_core_emit.xt
1134: 094D 4915 | fdb forth_core_char_plus.xt
1136: 0D9E 4916 | fdb forth_core_loop.runtime_xt
1138: 112E 4917 | fdb .L2
113A: 0A65 4918 | .L1 fdb forth_core_drop.xt
113C: 0C1A 4919 | fdb forth_core_exit.xt
4920 |
4921 | ;------------------------------------------
4922 |
4923 | .test "TYPE"
4924 | .opt test pokew forth__vector_putchar , .sysnul
E88F: CE E89B 4925 | ldu #.datastack
E892: 8E 1124 4926 | ldx #forth_core_type.xt
E895: 7E 0C04 4927 | jmp forth_core_execute.asm
4928 |
E898: 39 4929 | .sysnul rts
4930 |
E899: 0000 4931 | fdb 0
E89B: 000D 4932 | .datastack fdb .len
E89D: E89F 4933 | fdb .text
4934 |
E89F: 48656C6C6F2C... 4935 | .text fcc 'Hello, world!'
4936 | .len equ * - .text
4937 | .endtst
4938 |
4939 | ;**********************************************************************
4940 |
113E: 4941 | forth_core_u_dot ; ( u -- )
113E: 111C 4942 | fdb forth_core_type
1140: 0002 4943 | fdb .xt - .name
1142: 552E 4944 | .name fcc "U."
1144: 0678 4945 | .xt fdb forth_core_colon.runtime
4946 | ;======================================
4947 | ; : U. 0 <# #S #> TYPE SPACE ;
4948 | ;======================================
1146: 0D84 4949 | fdb forth_core_literal.runtime_xt
1148: 0000 4950 | fdb 0
114A: 06C7 4951 | fdb forth_core_less_number_sign.xt
114C: 03FA 4952 | fdb forth_core_number_sign_s.xt
114E: 03E1 4953 | fdb forth_core_number_sign_greater.xt
1150: 1124 4954 | fdb forth_core_type.xt
1152: 10D0 4955 | fdb forth_core_space.xt
1154: 0C1A 4956 | fdb forth_core_exit.xt
4957 |
4958 | ;**********************************************************************
4959 |
1156: 4960 | forth_core_u_less_than ; ( u -- )
1156: 113E 4961 | fdb forth_core_u_dot
1158: 0002 4962 | fdb .xt - .name
115A: 553C 4963 | .name fcc "U<"
115C: 115E 4964 | .xt fdb .body
115E: EC 42 4965 | .body ldd 2,u
1160: 10A3 C1 4966 | cmpd ,u++
1163: 25 04 4967 | blo .lessthan
1165: 4F 4968 | clra
1166: 5F 4969 | clrb
1167: 20 03 4970 | bra .done
1169: CC FFFF 4971 | .lessthan ldd #-1
116C: ED C4 4972 | .done std ,u
116E: AE A1 4973 | ldx ,y++ ; NEXT
1170: 6E 94 4974 | jmp [,x]
4975 |
4976 | ;**********************************************************************
4977 |
1172: 4978 | forth_core_u_m_star ; ( u1 u2 -- ud )
1172: 1156 4979 | fdb forth_core_u_less_than
1174: 0003 4980 | fdb .xt - .name
1176: 554D2A 4981 | .name fcc "UM*"
1179: 117B 4982 | .xt fdb .body
117B: 1F 31 4983 | .body tfr u,x
117D: 17 EF02 4984 | lbsr forth__math_mul16
1180: AE A1 4985 | ldx ,y++
1182: 6E 94 4986 | jmp [,x]
4987 |
4988 | ;**********************************************************************
4989 |
1184: 4990 | forth_core_u_m_slash_mod ; ( ud u1 -- u2 u3 )
1184: 1172 4991 | fdb forth_core_u_m_star
1186: 0006 4992 | fdb .xt - .name
1188: 554D2F4D4F44 4993 | .name fcc "UM/MOD"
118E: 1190 4994 | .xt fdb .body
1190: EC C4 4995 | .body ldd ,u ; check for ud/0
1192: 1027 FF15 4996 | lbeq forth_core_s_m_slash_rem.throw_div0
1196: 1F 31 4997 | tfr u,x
1198: 17 EF26 4998 | lbsr forth__math_div32
119B: 33 42 4999 | leau 2,u
119D: AE A1 5000 | ldx ,y++
119F: 6E 94 5001 | jmp [,x]
5002 |
5003 | ;-----------------------------------------
5004 |
5005 | .test "UM/MOD"
E8AC: CE E8BA 5006 | ldu #.datastack1
E8AF: 8E 118E 5007 | ldx #forth_core_u_m_slash_mod.xt
E8B2: BD 0C04 5008 | jsr forth_core_execute.asm
5009 | .assert /u = .result1 , "U"
5010 | .assert @@/0,u = 1 , "q"
5011 | .assert @@/2,u = 3 , "r"
E8B5: 39 5012 | rts
5013 |
E8B6: 0000 5014 | fdb 0
E8B8: 0000 5015 | fdb 0
E8BA: 0007 5016 | .datastack1 fdb 7
E8BC: 0000 5017 | .result1 fdb 0
E8BE: 000A 5018 | fdb 10
5019 | .endtst
5020 |
5021 | ;--------------------------------------
5022 |
5023 | .test "UM/MOD max"
E8C0: CE E8CE 5024 | ldu #.datastack2
E8C3: 8E 118E 5025 | ldx #forth_core_u_m_slash_mod.xt
E8C6: BD 0C04 5026 | jsr forth_core_execute.asm
5027 | .assert /u = .result2 , "U"
5028 | .assert @@/0,u = $FFFF , "q"
5029 | .assert @@/2,u = 0 , "r"
E8C9: 39 5030 | rts
5031 |
E8CA: 0000 5032 | fdb 0
E8CC: 0000 5033 | fdb 0
E8CE: FFFF 5034 | .datastack2 fdb $FFFF
E8D0: FFFE 5035 | .result2 fdb $FFFE
E8D2: 0001 5036 | fdb $0001
5037 | .endtst
5038 |
5039 | ;**********************************************************************
5040 |
11A1: 5041 | forth_core_unloop ; ( -- ) ( R: loop-sys -- )
11A1: 1184 5042 | fdb forth_core_u_m_slash_mod
11A3: 2006 5043 | fdb _NOINTERP :: .xt - .name
11A5: 554E4C4F4F50 5044 | .name fcc "UNLOOP"
11AB: 11AD 5045 | .xt fdb .body
11AD: 32 64 5046 | .body leas 4,s
11AF: AE A1 5047 | ldx ,y++
11B1: 6E 94 5048 | jmp [,x]
5049 |
5050 | ;**********************************************************************
5051 |
11B3: 5052 | forth_core_until ; ( C: dest -- ) ( x -- )
11B3: 11A1 5053 | fdb forth_core_unloop
11B5: A005 5054 | fdb _IMMED | _NOINTERP :: .xt - .name
11B7: 554E54494C 5055 | .name fcc "UNTIL"
11BC: 11BE 5056 | .xt fdb .body
11BE: 9E 10 5057 | .body ldx forth__here
11C0: CC 11CF 5058 | ldd #.runtime_xt
11C3: ED 81 5059 | std ,x++
11C5: 37 06 5060 | pulu d
11C7: ED 81 5061 | std ,x++
11C9: 9F 10 5062 | stx forth__here
11CB: AE A1 5063 | ldx ,y++
11CD: 6E 94 5064 | jmp [,x]
5065 |
11CF: 11D1 5066 | .runtime_xt fdb .runtime
11D1: EC C1 5067 | .runtime ldd ,u++ ; test condition
11D3: 26 07 5068 | bne .done ; if false, don't jump
11D5: 10AE A4 5069 | ldy ,y ; jump
11D8: AE A1 5070 | ldx ,y++
11DA: 6E 94 5071 | jmp [,x]
11DC: 31 22 5072 | .done leay 2,y
11DE: AE A1 5073 | ldx ,y++ ; NEXT
11E0: 6E 94 5074 | jmp [,x]
5075 |
5076 | ;**********************************************************************
5077 |
11E2: 5078 | forth_core_variable ; ( "name" -- ) ( -- a-addr )
11E2: 11B3 5079 | fdb forth_core_until
11E4: 0008 5080 | fdb .xt - .name
11E6: 564152494142... 5081 | .name fcc "VARIABLE"
11EE: 0678 5082 | .xt fdb forth_core_colon.runtime
5083 | ;===============================
5084 | ; : VARIABLE CREATE 0 , ;
5085 | ;===============================
11F0: 09B2 5086 | fdb forth_core_create.xt
11F2: 0D84 5087 | fdb forth_core_literal.runtime_xt
11F4: 0000 5088 | fdb 0
11F6: 04F3 5089 | fdb forth_core_comma.xt
11F8: 0C1A 5090 | fdb forth_core_exit.xt
5091 |
5092 | ;**********************************************************************
5093 |
11FA: 5094 | forth_core_while ; C ( C: dest -- orig dest ) R ( x -- )
11FA: 11E2 5095 | fdb forth_core_variable
11FC: A005 5096 | fdb _IMMED | _NOINTERP :: .xt - .name
11FE: 5748494C45 5097 | .name fcc "WHILE"
1203: 0678 5098 | .xt fdb forth_core_colon.runtime
5099 | ;=======================================
5100 | ; : WHILE POSTPONE IF 1 CS-ROLL ;
5101 | ;=======================================
1205: 0CBC 5102 | fdb forth_core_if.xt
1207: 0D84 5103 | fdb forth_core_literal.runtime_xt
1209: 0001 5104 | fdb 1
120B: 2564 5105 | fdb forth_tools_ext_c_s_roll.xt
120D: 0C1A 5106 | fdb forth_core_exit.xt
5107 |
5108 | ;**********************************************************************
5109 | ; WORD
5110 | ;
5111 | ; This parses from the input buffer. The input buffer cannot be
5112 | ; changed, but the results of WORD can be, so the parse is copied into
5113 | ; an internal buffer before returning.
5114 | ;
5115 | ;**********************************************************************
5116 |
120F: 5117 | forth_core_word ; ( char "ccc" -- c-addr )
120F: 11FA 5118 | fdb forth_core_while
1211: 0004 5119 | fdb .xt - .name
1213: 574F5244 5120 | .name fcc "WORD"
1217: 1219 5121 | .xt fdb .body
5122 |
1219: EC C4 5123 | .body ldd ,u ; get delimiter
121B: 34 24 5124 | pshs y,b ; U,Y and delimiter
121D: 9E 20 5125 | ldx forth__source
121F: DC 22 5126 | ldd forth__source_len
1221: 31 8B 5127 | leay d,x
1223: 34 20 5128 | pshs y
1225: DC 1A 5129 | ldd forth__in
1227: 30 8B 5130 | leax d,x
1229: AC E4 5131 | .skip_delim cmpx ,s
122B: 24 35 5132 | bhs .no_input
122D: A6 80 5133 | lda ,x+
122F: A1 62 5134 | cmpa 2,s
1231: 27 F6 5135 | beq .skip_delim
1233: 30 1F 5136 | leax -1,x ; adjust buffer pointer
1235: 1F 10 5137 | tfr x,d ; adjust >IN
1237: 93 20 5138 | subd forth__source
1239: DD 1A 5139 | std forth__in
123B: 8E 1698 5140 | ldx #forth_core_ext_parse.xt ; PARSE
123E: 17 F9C3 5141 | lbsr forth_core_execute.asm
1241: EC C1 5142 | ldd ,u++ ; get count
1243: 109E 10 5143 | .resume ldy forth__here
1246: 31 A854 5144 | leay SLASH_PAD,y
1249: AE C4 5145 | ldx ,u ; get buffer
124B: 10AF C4 5146 | sty ,u ; return c-addr
124E: 4D 5147 | tsta ; too long for counted string?
124F: 26 15 5148 | bne .throw ; if so, throw
1251: E7 A0 5149 | stb ,y+ ; save length
1253: 27 07 5150 | beq .done ; if 0, skip copy
1255: A6 80 5151 | .copy lda ,x+
1257: A7 A0 5152 | sta ,y+
1259: 5A 5153 | decb
125A: 26 F9 5154 | bne .copy
125C: 35 34 5155 | .done puls y,x,b ; clean up stack
125E: AE A1 5156 | ldx ,y++ ; NEXT
1260: 6E 94 5157 | jmp [,x]
1262: 4F 5158 | .no_input clra
1263: 5F 5159 | clrb
1264: 20 DD 5160 | bra .resume
1266: CC FFEE 5161 | .throw ldd #-18
1269: 16 0C4E 5162 | lbra forth_exception_throw.asm
5163 |
5164 | ;-------------------------------------------
5165 |
5166 | .test "[CHAR] ) WORD"
5167 | .opt test pokew forth__here , .here
5168 | .opt test pokew forth__source , .buffer1
5169 | .opt test pokew forth__source_len , .len1
5170 | .opt test pokew forth__in , 2
E8D4: CE E8E0 5171 | ldu #.datastack1
E8D7: 8E 1217 5172 | ldx #forth_core_word.xt
E8DA: BD 0C04 5173 | jsr forth_core_execute.asm
5174 | .assert /u = .datastack1 , "U"
5175 | .assert @@/,u = .word_len , "c-addr"
5176 | .assert @.word_len = 3 , "len"
5177 | .assert .word_text = 'one' , "text"
5178 | .assert @@forth__in = 6 , ">IN"
E8DD: 39 5179 | rts
5180 |
E8DE: 0000 5181 | fdb 0
E8E0: 0029 5182 | .datastack1 fdb ')'
5183 |
E8E2: 28206F6E6529... 5184 | .buffer1 fcc '( one) '
5185 | .len1 equ * - .buffer1
5186 |
E8E9: 5187 | .here rmb SLASH_PAD
E93D: 00 5188 | .word_len fcb 0
E93E: 0000 5189 | .word_text fdb 0
E940: 0000 5190 | fdb 0
5191 | .endtst
5192 |
5193 | ;-------------------------------------------
5194 |
5195 | .test "BL WORD (spaces)"
5196 | .opt test pokew forth__here , .here2
5197 | .opt test pokew forth__source , .buffer2
5198 | .opt test pokew forth__source_len , .len2
5199 | .opt test pokew forth__in , 0
E942: CE E94E 5200 | ldu #.datastack2
E945: 8E 1217 5201 | ldx #forth_core_word.xt
E948: BD 0C04 5202 | jsr forth_core_execute.asm
5203 | .assert /u = .datastack2 , "U"
5204 | .assert @@/,u = .word_len2 , "c-addr"
5205 | .assert @.word_len2 = 0 , "len"
5206 | .assert @@forth__in = 0 , ">IN"
E94B: 39 5207 | rts
5208 |
E94C: 0000 5209 | fdb 0
E94E: 0020 5210 | .datastack2 fdb ' '
5211 |
E950: 202020202020 5212 | .buffer2 fcc ' '
5213 | .len2 equ * - .buffer2
5214 |
E956: 5215 | .here2 rmb SLASH_PAD
E9AA: 00 5216 | .word_len2 fcb 0
E9AB: 0000 5217 | fdb 0
E9AD: 0000 5218 | fdb 0
5219 | .endtst
5220 |
5221 | ;**********************************************************************
5222 |
126C: 5223 | forth_core_x_or ; ( x1 x2 -- x3 )
126C: 120F 5224 | fdb forth_core_word
126E: 0003 5225 | fdb .xt - .name
1270: 584F52 5226 | .name fcc "XOR"
1273: 1275 5227 | .xt fdb .body
1275: EC C1 5228 | .body ldd ,u++
1277: A8 C4 5229 | eora ,u
1279: E8 41 5230 | eorb 1,u
127B: ED C4 5231 | std ,u
127D: AE A1 5232 | ldx ,y++
127F: 6E 94 5233 | jmp [,x]
5234 |
5235 | ;**********************************************************************
5236 |
1281: 5237 | forth_core_left_bracket ; ( -- )
1281: 126C 5238 | fdb forth_core_x_or
1283: A001 5239 | fdb _IMMED | _NOINTERP :: .xt - .name
1285: 5B 5240 | .name fcc "["
1286: 0678 5241 | .xt fdb forth_core_colon.runtime
5242 | ;=======================================
5243 | ; : [ FALSE STATE ! ; IMMEDIATE
5244 | ;=======================================
1288: 156D 5245 | fdb forth_core_ext_false.xt
128A: 2626 5246 | fdb forth_tools_ext_state.xt
128C: 0377 5247 | fdb forth_core_store.xt
128E: 0C1A 5248 | fdb forth_core_exit.xt
5249 |
5250 | ;**********************************************************************
5251 |
1290: 5252 | forth_core_bracket_tick ; ( "name" -- )
1290: 1281 5253 | fdb forth_core_left_bracket
1292: A003 5254 | fdb _IMMED | _NOINTERP :: .xt - .name
1294: 5B275D 5255 | .name fcc "[']"
1297: 0678 5256 | .xt fdb forth_core_colon.runtime
5257 | ;==========================================
5258 | ; : ['] ' LITERAL ; IMMEDIATE
5259 | ;==========================================
1299: 040D 5260 | fdb forth_core_tick.xt
129B: 0D71 5261 | fdb forth_core_literal.xt
129D: 0C1A 5262 | fdb forth_core_exit.xt
5263 |
5264 | ;**********************************************************************
5265 |
129F: 5266 | forth_core_bracket_char ; ( "name" -- )
129F: 1290 5267 | fdb forth_core_bracket_tick
12A1: A006 5268 | fdb _IMMED | _NOINTERP :: .xt - .name
12A3: 5B434841525D 5269 | .name fcc "[CHAR]"
12A9: 0678 5270 | .xt fdb forth_core_colon.runtime
5271 | ;=========================================
5272 | ; [CHAR] CHAR LITERAL ; IMMEDIATE
5273 | ;=========================================
12AB: 0938 5274 | fdb forth_core_char.xt
12AD: 0D71 5275 | fdb forth_core_literal.xt
12AF: 0C1A 5276 | fdb forth_core_exit.xt
5277 |
5278 | ;**********************************************************************
5279 |
12B1: 5280 | forth_core_right_bracket ; ( -- )
12B1: 129F 5281 | fdb forth_core_bracket_char
12B3: 0001 5282 | fdb .xt - .name
12B5: 5D 5283 | .name fcc "]"
12B6: 0678 5284 | .xt fdb forth_core_colon.runtime
5285 | ;========================================
5286 | ; : ] TRUE STATE ! ;
5287 | ;========================================
12B8: 19BD 5288 | fdb forth_core_ext_true.xt
12BA: 2626 5289 | fdb forth_tools_ext_state.xt
12BC: 0377 5290 | fdb forth_core_store.xt
12BE: 0C1A 5291 | fdb forth_core_exit.xt
5292 |
5293 | ;**********************************************************************
5294 | ; CORE-EXT
5295 | ;**********************************************************************
5296 |
12C0: 5297 | forth_core_ext_dot_paren ; ( "ccc" -- )
12C0: 12B1 5298 | fdb forth_core_right_bracket
12C2: 8002 5299 | fdb _IMMED :: .xt - .name
12C4: 2E28 5300 | .name fcc ".("
12C6: 0678 5301 | .xt fdb forth_core_colon.runtime
5302 | ;=======================================
5303 | ; : .( [CHAR] ) PARSE TYPE ; IMMEDIATE
5304 | ;=======================================
12C8: 0D84 5305 | fdb forth_core_literal.runtime_xt
12CA: 0029 5306 | fdb ')'
12CC: 1698 5307 | fdb forth_core_ext_parse.xt
12CE: 1124 5308 | fdb forth_core_type.xt
12D0: 0C1A 5309 | fdb forth_core_exit.xt
5310 |
5311 | ;**********************************************************************
5312 |
12D2: 5313 | forth_core_ext_dot_r ; ( n1 n2 -- )
12D2: 12C0 5314 | fdb forth_core_ext_dot_paren
12D4: 0002 5315 | fdb .xt - .name
12D6: 2E52 5316 | .name fcc ".R"
12D8: 0678 5317 | .xt fdb forth_core_colon.runtime
5318 | ;==================================================
5319 | ; : .R SWAP DUP >R ABS 0 <# #S R> SIGN #>
5320 | ; ROT 2DUP < IF OVER - SPACES ELSE DROP THEN
5321 | ; TYPE SPACE ;
5322 | ;==================================================
12DA: 10FC 5323 | fdb forth_core_swap.xt
12DC: 0A74 5324 | fdb forth_core_dupe.xt
12DE: 07BF 5325 | fdb forth_core_to_r.xt
12E0: 07F3 5326 | fdb forth_core_abs.xt
12E2: 0D84 5327 | fdb forth_core_literal.runtime_xt
12E4: 0000 5328 | fdb 0
12E6: 06C7 5329 | fdb forth_core_less_number_sign.xt
12E8: 03FA 5330 | fdb forth_core_number_sign_s.xt
12EA: 0FAA 5331 | fdb forth_core_r_from.xt
12EC: 104D 5332 | fdb forth_core_sign.xt
12EE: 03E1 5333 | fdb forth_core_number_sign_greater.xt
12F0: 0FF6 5334 | fdb forth_core_rote.xt
12F2: 060D 5335 | fdb forth_core_two_dupe.xt
12F4: 06AB 5336 | fdb forth_core_less_than.xt
12F6: 0CD1 5337 | fdb forth_core_if.runtime_xt
12F8: 1304 5338 | fdb .L1
12FA: 0EA4 5339 | fdb forth_core_over.xt
12FC: 0506 5340 | fdb forth_core_minus.xt
12FE: 10E2 5341 | fdb forth_core_spaces.xt
1300: 1430 5342 | fdb forth_core_ext_again.runtime_xt
1302: 1306 5343 | fdb .L2
1304: 0A65 5344 | .L1 fdb forth_core_drop.xt
1306: 1124 5345 | .L2 fdb forth_core_type.xt
1308: 10D0 5346 | fdb forth_core_space.xt
130A: 0C1A 5347 | fdb forth_core_exit.xt
5348 |
5349 | ;**********************************************************************
5350 |
130C: 5351 | forth_core_ext_zero_not_equals ; ( x -- flag )
130C: 12D2 5352 | fdb forth_core_ext_dot_r
130E: 0003 5353 | fdb .xt - .name
1310: 303C3E 5354 | .name fcc "0<>"
1313: 0678 5355 | .xt fdb forth_core_colon.runtime
5356 | ;==========================================
5357 | ; : 0<> 0 <> ;
5358 | ;==========================================
1315: 0D84 5359 | fdb forth_core_literal.runtime_xt
1317: 0000 5360 | fdb 0
1319: 1393 5361 | fdb forth_core_ext_not_equals.xt
131B: 0C1A 5362 | fdb forth_core_exit.xt
5363 |
5364 | ;**********************************************************************
5365 |
131D: 5366 | forth_core_ext_zero_greater ; ( x -- flag )
131D: 130C 5367 | fdb forth_core_ext_zero_not_equals
131F: 0002 5368 | fdb .xt - .name
1321: 303E 5369 | .name fcc "0>"
1323: 0678 5370 | .xt fdb forth_core_colon.runtime
5371 | ;=====================================
5372 | ; : 0> 0 > ;
5373 | ;=====================================
1325: 0D84 5374 | fdb forth_core_literal.runtime_xt
1327: 0000 5375 | fdb 0
1329: 06F4 5376 | fdb forth_core_greater_than.xt
132B: 0C1A 5377 | fdb forth_core_exit.xt
5378 |
5379 | ;**********************************************************************
5380 |
132D: 5381 | forth_core_ext_two_to_r ; E ( x1 x2 -- ) ( R: -- x1 x2 )
132D: 131D 5382 | fdb forth_core_ext_zero_greater
132F: 2003 5383 | fdb _NOINTERP :: .xt - .name
1331: 323E52 5384 | .name fcc "2>R"
1334: 1336 5385 | .xt fdb .body
1336: 37 16 5386 | .body pulu x,d
1338: 34 16 5387 | pshs x,d
133A: AE A1 5388 | ldx ,y++
133C: 6E 94 5389 | jmp [,x]
5390 |
5391 | ;**********************************************************************
5392 |
133E: 5393 | forth_core_ext_two_r_from ; E ( -- x1 x2 ) ( R: x1 x2 -- )
133E: 132D 5394 | fdb forth_core_ext_two_to_r
1340: 2003 5395 | fdb _NOINTERP :: .xt - .name
1342: 32523E 5396 | .name fcc "2R>"
1345: 1347 5397 | .xt fdb .body
1347: 35 16 5398 | .body puls x,d
1349: 36 16 5399 | pshu x,d
134B: AE A1 5400 | ldx ,y++
134D: 6E 94 5401 | jmp [,x]
5402 |
5403 | ;**********************************************************************
5404 |
134F: 5405 | forth_core_ext_two_r_fetch ; E ( -- x1 x2 ) ( R: x1 x2 -- x1 x2 )
134F: 133E 5406 | fdb forth_core_ext_two_r_from
1351: 2003 5407 | fdb _NOINTERP :: .xt - .name
1353: 325240 5408 | .name fcc "2R@"
1356: 1358 5409 | .xt fdb .body
1358: EC E4 5410 | .body ldd ,s
135A: AE 62 5411 | ldx 2,s
135C: 36 16 5412 | pshu x,d
135E: AE A1 5413 | ldx ,y++
1360: 6E 94 5414 | jmp [,x]
5415 |
5416 | ;**********************************************************************
5417 |
1362: 5418 | forth_core_ext_colon_no_name ; ( C: -- colon-sys ) ( S: -- xt )
1362: 134F 5419 | fdb forth_core_ext_two_r_fetch
1364: 0007 5420 | fdb .xt - .name
1366: 3A4E4F4E414D... 5421 | .name fcc ":NONAME"
136D: 136F 5422 | .xt fdb .body
136F: CC 005A 5423 | .body ldd #forth__leave_stack
1372: DD 58 5424 | std forth__leave_sp
1374: 4F 5425 | clra
1375: 5F 5426 | clrb
1376: DD 24 5427 | std forth__create_link ; no link
1378: DD 26 5428 | std forth__create_name ; no name
137A: CC 0678 5429 | ldd #forth_core_colon.runtime ; set runtime action
137D: 9E 10 5430 | ldx forth__here
137F: 36 10 5431 | pshu x ; save xt
1381: 9F 28 5432 | stx forth__create_xt ; save create xt
1383: ED 81 5433 | std ,x++ ; compile runtime action
1385: 9F 10 5434 | stx forth__here
1387: 0C 19 5435 | inc forth__state + 1 ; enter compilation state
1389: AE A1 5436 | ldx ,y++
138B: 6E 94 5437 | jmp [,x]
5438 |
5439 | ;**********************************************************************
5440 |
138D: 5441 | forth_core_ext_not_equals ; (x1 x2 -- flag )
138D: 1362 5442 | fdb forth_core_ext_colon_no_name
138F: 0002 5443 | fdb .xt - .name
1391: 3C3E 5444 | .name fcc "<>"
1393: 1395 5445 | .xt fdb .body
1395: EC C1 5446 | .body ldd ,u++
1397: 10A3 C4 5447 | cmpd ,u
139A: 26 04 5448 | bne .not_equal
139C: 4F 5449 | clra
139D: 5F 5450 | clrb
139E: 20 03 5451 | bra .done
13A0: CC FFFF 5452 | .not_equal ldd #-1
13A3: ED C4 5453 | .done std ,u
13A5: AE A1 5454 | ldx ,y++
13A7: 6E 94 5455 | jmp [,x]
5456 |
5457 | ;**********************************************************************
5458 |
13A9: 5459 | forth_core_ext_question_do ; C ( C: -- do-sys ) R ( n1|u1 n2|u2 -- ) ( R: -- loop-sys )
13A9: 138D 5460 | fdb forth_core_ext_not_equals
13AB: A003 5461 | fdb _IMMED | _NOINTERP :: .xt - .name
13AD: 3F444F 5462 | .name fcc "?DO"
13B0: 13B2 5463 | .xt fdb .body
13B2: 9E 58 5464 | .body ldx forth__leave_sp
13B4: 8C 006A 5465 | cmpx #forth__leave_stack + 16
13B7: 1027 F669 5466 | lbeq forth_core_do.throw_toodeep
13BB: 4F 5467 | clra
13BC: 5F 5468 | clrb
13BD: ED 81 5469 | std ,x++
13BF: 9F 58 5470 | stx forth__leave_sp
13C1: 9E 10 5471 | ldx forth__here ; lay down runtime
13C3: CC 13D4 5472 | ldd #.runtime_xt
13C6: ED 81 5473 | std ,x++
13C8: 1F 10 5474 | tfr x,d ; c-orig
13CA: 30 02 5475 | leax 2,x ; u-dest
13CC: 36 16 5476 | pshu x,d ; push c-orig u-dest
13CE: 9F 10 5477 | stx forth__here ; update compile location
13D0: AE A1 5478 | ldx ,y++ ; NEXT
13D2: 6E 94 5479 | jmp [,x]
5480 |
13D4: 13D6 5481 | .runtime_xt fdb .runtime
13D6: EC C4 5482 | .runtime ldd ,u ; get starting point
13D8: 10A3 42 5483 | cmpd 2,u ; is it equal to ending point?
13DB: 27 05 5484 | beq .skip ; if so, skip loop
13DD: 31 22 5485 | leay 2,y
13DF: 7E 1336 5486 | jmp forth_core_ext_two_to_r.body
13E2: 33 44 5487 | .skip leau 4,u ; burn parameters
13E4: 10AE A4 5488 | ldy ,y ; GOTO
13E7: AE A1 5489 | ldx ,y++
13E9: 6E 94 5490 | jmp [,x]
5491 |
5492 | ;**********************************************************************
5493 |
13EB: 5494 | forth_core_ext_action_of ; I ( "name" -- xt ) C ( "name" -- ) R ( -- xt )
13EB: 13A9 5495 | fdb forth_core_ext_question_do
13ED: 8009 5496 | fdb _IMMED :: .xt - .name
13EF: 414354494F4E... 5497 | .name fcc "ACTION-OF"
13F8: 0678 5498 | .xt fdb forth_core_colon.runtime
5499 | ;==============================================================
5500 | ; : ACTION-OF ' STATE @ IF
5501 | ; LITERAL POSTPONE DEFER@
5502 | ; ELSE DEFER@ THEN ;
5503 | ;==============================================================
13FA: 040D 5504 | fdb forth_core_tick.xt
13FC: 2626 5505 | fdb forth_tools_ext_state.xt
13FE: 07E2 5506 | fdb forth_core_fetch.xt
1400: 0CD1 5507 | fdb forth_core_if.runtime_xt
1402: 1410 5508 | fdb .L1
1404: 0D71 5509 | fdb forth_core_literal.xt
1406: 0D84 5510 | fdb forth_core_literal.runtime_xt
1408: 14F4 5511 | fdb forth_core_ext_defer_fetch.xt
140A: 14AC 5512 | fdb forth_core_ext_compile_comma.xt
140C: 1430 5513 | fdb forth_core_ext_again.runtime_xt
140E: 1412 5514 | fdb .L2
1410: 14F4 5515 | .L1 fdb forth_core_ext_defer_fetch.xt
1412: 0C1A 5516 | .L2 fdb forth_core_exit.xt
5517 |
5518 | ;**********************************************************************
5519 |
1414: 5520 | forth_core_ext_again ; C ( C: dest -- ) R ( -- )
1414: 13EB 5521 | fdb forth_core_ext_action_of
1416: A005 5522 | fdb _IMMED | _NOINTERP :: .xt - .name
1418: 414741494E 5523 | .name fcc "AGAIN"
141D: 141F 5524 | .xt fdb .body
141F: 9E 10 5525 | .body ldx forth__here ; compile runtime
1421: CC 1430 5526 | ldd #.runtime_xt
1424: ED 81 5527 | std ,x++
1426: 37 06 5528 | pulu d ; pull dest
1428: ED 81 5529 | std ,x++ ; compile destination
142A: 9F 10 5530 | stx forth__here
142C: AE A1 5531 | ldx ,y++ ; NEXT
142E: 6E 94 5532 | jmp [,x]
5533 |
1430: 1432 5534 | .runtime_xt fdb .runtime
1432: 10AE A4 5535 | .runtime ldy ,y ; GOTO
1435: AE A1 5536 | ldx ,y++ ; NEXT
1437: 6E 94 5537 | jmp [,x]
5538 |
5539 | ;**********************************************************************
5540 |
1439: 5541 | forth_core_ext_buffer_colon ; ( u "name" -- ) ( -- a-addr )
1439: 1414 5542 | fdb forth_core_ext_again
143B: 0007 5543 | fdb .xt - .name
143D: 425546464552... 5544 | .name fcc "BUFFER:"
1444: 0678 5545 | .xt fdb forth_core_colon.runtime
5546 | ;========================================
5547 | ; : BUFFER: CREATE ALIGN ALLOT ;
5548 | ;========================================
1446: 09B2 5549 | fdb forth_core_create.xt
1448: 085E 5550 | fdb forth_core_align.xt
144A: 087A 5551 | fdb forth_core_allot.xt
144C: 0C1A 5552 | fdb forth_core_exit.xt
5553 |
5554 | ;**********************************************************************
5555 |
144E: 5556 | forth_core_ext_c_quote ; ( "ccc" -- ) ( -- c-addr )
144E: 1439 5557 | fdb forth_core_ext_buffer_colon
1450: A002 5558 | fdb _IMMED | _NOINTERP :: .xt - .name
1452: 4322 5559 | .name fcc 'C"'
1454: 1456 5560 | .xt fdb .body
1456: CC 0022 5561 | .body ldd #'"'
1459: 36 06 5562 | pshu d
145B: 8E 1698 5563 | ldx #forth_core_ext_parse.xt
145E: 17 F7A3 5564 | lbsr forth_core_execute.asm
1461: 34 60 5565 | pshs u,y
1463: 37 30 5566 | pulu y,x ; get c-addr u
1465: DE 10 5567 | ldu forth__here
1467: CC 1483 5568 | ldd #.runtime_xt
146A: ED C1 5569 | std ,u++
146C: 1F 10 5570 | tfr x,d
146E: E7 C0 5571 | stb ,u+
1470: 27 07 5572 | beq .empty
1472: A6 A0 5573 | .copy lda ,y+
1474: A7 C0 5574 | sta ,u+
1476: 5A 5575 | decb
1477: 26 F9 5576 | bne .copy
1479: DF 10 5577 | .empty stu forth__here
147B: 35 60 5578 | puls u,y
147D: 33 44 5579 | leau 4,u
147F: AE A1 5580 | ldx ,y++
1481: 6E 94 5581 | jmp [,x]
5582 |
1483: 1485 5583 | .runtime_xt fdb .runtime
1485: 36 20 5584 | .runtime pshu y ; push c-addr
1487: 4F 5585 | clra ;
1488: E6 A0 5586 | ldb ,y+ ; get length
148A: 31 AB 5587 | leay d,y ; point past string
148C: AE A1 5588 | ldx ,y++
148E: 6E 94 5589 | jmp [,x]
5590 |
5591 | ;**********************************************************************
5592 |
1490: 5593 | forth_core_ext_case ; C ( C: -- case-sys ) R ( -- )
1490: 144E 5594 | fdb forth_core_ext_c_quote
1492: A004 5595 | fdb _IMMED | _NOINTERP :: .xt - .name
1494: 43415345 5596 | .name fcc "CASE"
1498: 0678 5597 | .xt fdb forth_core_colon.runtime
5598 | ;============================================
5599 | ; : CASE 0 ; IMMEDIATE
5600 | ;============================================
149A: 0D84 5601 | fdb forth_core_literal.runtime_xt
149C: 0000 5602 | fdb 0
149E: 0C1A 5603 | fdb forth_core_exit.xt
5604 |
5605 | ;**********************************************************************
5606 |
14A0: 5607 | forth_core_ext_compile_comma ; ( xt -- )
14A0: 1490 5608 | fdb forth_core_ext_case
14A2: 2008 5609 | fdb _NOINTERP :: .xt - .name
14A4: 434F4D50494C... 5610 | .name fcc "COMPILE,"
14AC: 14AE 5611 | .xt fdb .body
14AE: 37 06 5612 | .body pulu d
14B0: 9E 10 5613 | ldx forth__here
14B2: ED 81 5614 | std ,x++
14B4: 9F 10 5615 | stx forth__here
14B6: AE A1 5616 | ldx ,y++
14B8: 6E 94 5617 | jmp [,x]
5618 |
5619 | ;**********************************************************************
5620 |
14BA: 5621 | forth_core_ext_defer ; ( "name" -- / i*x -- j*x )
14BA: 14A0 5622 | fdb forth_core_ext_compile_comma
14BC: 0005 5623 | fdb .xt - .name
14BE: 4445464552 5624 | .name fcc "DEFER"
14C3: 0678 5625 | .xt fdb forth_core_colon.runtime
5626 | ;===================================================
5627 | ; : DEFER CREATE ['] ABORT , DOES> @ EXECUTE ;
5628 | ;===================================================
14C5: 09B2 5629 | fdb forth_core_create.xt
14C7: 0D84 5630 | fdb forth_core_literal.runtime_xt
14C9: 1ECB 5631 | fdb forth_exception_ext_abort.xt
14CB: 04F3 5632 | fdb forth_core_comma.xt
14CD: 0A50 5633 | fdb forth_core_does.runtime_xt
14CF: BD 09BD 5634 | jsr forth_core_create.does_hook
14D2: 07E2 5635 | fdb forth_core_fetch.xt
14D4: 0BFE 5636 | fdb forth_core_execute.xt
14D6: 0C1A 5637 | fdb forth_core_exit.xt
5638 |
5639 | ;**********************************************************************
5640 |
14D8: 5641 | forth_core_ext_defer_store ; ( xt2 xt1 -- )
14D8: 14BA 5642 | fdb forth_core_ext_defer
14DA: 0006 5643 | fdb .xt - .name
14DC: 444546455221 5644 | .name fcc "DEFER!"
14E2: 0678 5645 | .xt fdb forth_core_colon.runtime
5646 | ;===================================
5647 | ; : DEFER! >BODY ! ;
5648 | ;===================================
14E4: 0713 5649 | fdb forth_core_to_body.xt
14E6: 0377 5650 | fdb forth_core_store.xt
14E8: 0C1A 5651 | fdb forth_core_exit.xt
5652 |
5653 | ;**********************************************************************
5654 |
14EA: 5655 | forth_core_ext_defer_fetch ; ( xt1 -- xt2 )
14EA: 14D8 5656 | fdb forth_core_ext_defer_store
14EC: 0006 5657 | fdb .xt - .name
14EE: 444546455240 5658 | .name fcc "DEFER@"
14F4: 0678 5659 | .xt fdb forth_core_colon.runtime
5660 | ;=========================================
5661 | ; : DEFER@ >BODY @ ;
5662 | ;=========================================
14F6: 0713 5663 | fdb forth_core_to_body.xt
14F8: 07E2 5664 | fdb forth_core_fetch.xt
14FA: 0C1A 5665 | fdb forth_core_exit.xt
5666 |
5667 | ;**********************************************************************
5668 |
14FC: 5669 | forth_core_ext_end_case ; C ( C: case-sys -- ) R ( x -- )
14FC: 14EA 5670 | fdb forth_core_ext_defer_fetch
14FE: A007 5671 | fdb _IMMED | _NOINTERP :: .xt - .name
1500: 454E44434153... 5672 | .name fcc "ENDCASE"
1507: 1509 5673 | .xt fdb .body
1509: 9E 10 5674 | .body ldx forth__here
150B: CC 0A65 5675 | ldd #forth_core_drop.xt ; compile DROP
150E: ED 81 5676 | std ,x++
1510: 9F 10 5677 | stx forth__here
1512: 1F 10 5678 | tfr x,d
1514: 37 10 5679 | pulu x ; get case-sys
1516: 34 40 5680 | pshs u ; save U
1518: 8C 0000 5681 | .fixup cmpx #0
151B: 27 08 5682 | beq .done_fixup
151D: EE 84 5683 | ldu ,x ; get location
151F: ED 84 5684 | std ,x ; fixup jump
1521: 1F 31 5685 | tfr u,x ; get new location
1523: 20 F3 5686 | bra .fixup ; continue
1525: 35 40 5687 | .done_fixup puls u ; restore U
1527: AE A1 5688 | ldx ,y++
1529: 6E 94 5689 | jmp [,x]
5690 |
5691 | ;**********************************************************************
5692 |
152B: 5693 | forth_core_ext_end_of ; C ( C: case-sys1 of-sys -- case-sys2 ) R ( -- )
152B: 14FC 5694 | fdb forth_core_ext_end_case
152D: A005 5695 | fdb _IMMED | _NOINTERP :: .xt - .name
152F: 454E444F46 5696 | .name fcc "ENDOF"
1534: 1536 5697 | .xt fdb .body
1536: CC 1430 5698 | .body ldd #forth_core_ext_again.runtime_xt
1539: 9E 10 5699 | ldx forth__here
153B: ED 81 5700 | std ,x++
153D: EC 42 5701 | ldd 2,u ; get case-sys1
153F: ED 84 5702 | std ,x ; save here
1541: AF 42 5703 | stx 2,u ; push case-sys2
1543: 30 02 5704 | leax 2,x ; point to next compilation location
1545: 9F 10 5705 | stx forth__here
1547: 1F 10 5706 | tfr x,d
1549: 37 10 5707 | pulu x ; get of-sys
154B: ED 84 5708 | std ,x ; patch jump of OF
154D: AE A1 5709 | ldx ,y++
154F: 6E 94 5710 | jmp [,x]
5711 |
5712 | ;**********************************************************************
5713 |
1551: 5714 | forth_core_ext_erase ; ( addr u -- )
1551: 152B 5715 | fdb forth_core_ext_end_of
1553: 0005 5716 | fdb .xt - .name
1555: 4552415345 5717 | .name fcc "ERASE"
155A: 0678 5718 | .xt fdb forth_core_colon.runtime
5719 | ;================================
5720 | ; : ERASE 0 FILL ;
5721 | ;================================
155C: 0D84 5722 | fdb forth_core_literal.runtime_xt
155E: 0000 5723 | fdb 0
1560: 0C2A 5724 | fdb forth_core_fill.xt
1562: 0C1A 5725 | fdb forth_core_exit.xt
5726 |
5727 | ;**********************************************************************
5728 |
1564: 5729 | forth_core_ext_false ; ( -- false )
1564: 1551 5730 | fdb forth_core_ext_erase
1566: 0005 5731 | fdb .xt - .name
1568: 46414C5345 5732 | .name fcc "FALSE"
156D: 097A 5733 | .xt fdb forth_core_constant.does
5734 | ;==========================================
5735 | ; 1 0= CONSTANT FALSE
5736 | ;==========================================
156F: 0000 5737 | fdb 0
5738 |
5739 | ;**********************************************************************
5740 |
1571: 5741 | forth_core_ext_hex ; ( -- )
1571: 1564 5742 | fdb forth_core_ext_false
1573: 0003 5743 | fdb .xt - .name
1575: 484558 5744 | .name fcc "HEX"
1578: 0678 5745 | .xt fdb forth_core_colon.runtime
5746 | ;==========================================
5747 | ; : HEX 16 BASE ! ;
5748 | ;==========================================
157A: 0D84 5749 | fdb forth_core_literal.runtime_xt
157C: 0010 5750 | fdb 16
157E: 08A5 5751 | fdb forth_core_base.xt
1580: 0377 5752 | fdb forth_core_store.xt
1582: 0C1A 5753 | fdb forth_core_exit.xt
5754 |
5755 | ;**********************************************************************
5756 |
1584: 5757 | forth_core_ext_holds ; ( c-addr u -- )
1584: 1571 5758 | fdb forth_core_ext_hex
1586: 0005 5759 | fdb .xt - .name
1588: 484F4C4453 5760 | .name fcc "HOLDS"
158D: 158F 5761 | .xt fdb .body
158F: 34 60 5762 | .body pshs u,y ; save registers, we're using these
1591: 37 30 5763 | pulu y,x ; pull c-addr u
1593: 1F 10 5764 | tfr x,d
1595: 31 AB 5765 | leay d,y
1597: DE 2A 5766 | ldu forth__hold ; get hold location
1599: A6 A2 5767 | .copy lda ,-y ; get character
159B: A7 C2 5768 | sta ,-u ; move to hold area
159D: 30 1F 5769 | leax -1,x ; more?
159F: 26 F8 5770 | bne .copy ; if so, copy more
15A1: DF 2A 5771 | stu forth__hold ; save new hold location
15A3: 35 60 5772 | puls u,y ; restore registers
15A5: 33 44 5773 | leau 4,u ; adjust data stack
15A7: AE A1 5774 | ldx ,y++
15A9: 6E 94 5775 | jmp [,x]
5776 |
5777 | ;**********************************************************************
5778 |
15AB: 5779 | forth_core_ext_is ; ( xt "name" -- )
15AB: 1584 5780 | fdb forth_core_ext_holds
15AD: 8002 5781 | fdb _IMMED :: .xt - .name
15AF: 4953 5782 | .name fcc "IS"
15B1: 0678 5783 | .xt fdb forth_core_colon.runtime
5784 | ;=========================================
5785 | ; : IS ' STATE @ IF
5786 | ; LITERAL POSTPONE DEFER!
5787 | ; ELSE DEFER! THEN ;
5788 | ;=========================================
15B3: 040D 5789 | fdb forth_core_tick.xt
15B5: 2626 5790 | fdb forth_tools_ext_state.xt
15B7: 07E2 5791 | fdb forth_core_fetch.xt
15B9: 0CD1 5792 | fdb forth_core_if.runtime_xt
15BB: 15C9 5793 | fdb .L1
15BD: 0D71 5794 | fdb forth_core_literal.xt
15BF: 0D84 5795 | fdb forth_core_literal.runtime_xt
15C1: 14E2 5796 | fdb forth_core_ext_defer_store.xt
15C3: 14AC 5797 | fdb forth_core_ext_compile_comma.xt
15C5: 1430 5798 | fdb forth_core_ext_again.runtime_xt
15C7: 15CB 5799 | fdb .L2
15C9: 14E2 5800 | .L1 fdb forth_core_ext_defer_store.xt
15CB: 0C1A 5801 | .L2 fdb forth_core_exit.xt
5802 |
5803 | ;**********************************************************************
5804 |
15CD: 5805 | forth_core_ext_marker ; ( "" -- c-addr u )
168F: 1682 5919 | fdb forth_core_ext_pad
1691: 0005 5920 | fdb .xt - .name
1693: 5041525345 5921 | .name fcc "PARSE"
1698: 169A 5922 | .xt fdb .body
169A: 34 20 5923 | .body pshs y ; save Y for other use
169C: DC 22 5924 | ldd forth__source_len ; get # bytes left in buffer
169E: 93 1A 5925 | subd forth__in
16A0: 27 32 5926 | beq .no_input
16A2: 2B 30 5927 | bmi .no_input
16A4: 1F 02 5928 | tfr d,y ; use Y as count
16A6: 9E 20 5929 | ldx forth__source ; get buffer
16A8: DC 1A 5930 | ldd forth__in ; get index into buffer
16AA: 30 8B 5931 | leax d,x ; point to current input
16AC: EC C4 5932 | ldd ,u ; get delimiter
16AE: AF C4 5933 | stx ,u ; return c-addr
16B0: E7 E2 5934 | stb ,-s ; save delimiter
16B2: A6 80 5935 | .input lda ,x+ ; get next input character
16B4: A1 E4 5936 | cmpa ,s ; delimiter?
16B6: 27 06 5937 | beq .done ; if so, done
16B8: 31 3F 5938 | leay -1,y ; else more input?
16BA: 26 F6 5939 | bne .input ; if not, keep going
16BC: 30 01 5940 | leax 1,x
16BE: 32 61 5941 | .done leas 1,s ; burn delimiter
16C0: 1F 10 5942 | tfr x,d ; get current pointer
16C2: 93 20 5943 | subd forth__source ; get new >IN
16C4: DD 1A 5944 | std forth__in
16C6: 30 1F 5945 | leax -1,x ; adjust pointer to last character
16C8: 1F 10 5946 | tfr x,d ; get current pointer
16CA: A3 C4 5947 | subd ,u ; get length
16CC: 35 20 5948 | .return puls y ; restore Y
16CE: 36 06 5949 | pshu d ; return u
16D0: AE A1 5950 | ldx ,y++ ; NEXT
16D2: 6E 94 5951 | jmp [,x]
16D4: 4F 5952 | .no_input clra ; no input
16D5: 5F 5953 | clrb
16D6: 20 F4 5954 | bra .return
5955 |
5956 | ;----------------------------------------------
5957 |
5958 | .test "PARSE easy case"
5959 | .opt test pokew forth__source , .buffer1
5960 | .opt test pokew forth__source_len , .len1
5961 | .opt test pokew forth__in , 5
E9AF: CE E9BB 5962 | ldu #.datastack1
E9B2: 8E 1698 5963 | ldx #forth_core_ext_parse.xt
E9B5: BD 0C04 5964 | jsr forth_core_execute.asm
5965 | .assert /u = .results1 , "U"
5966 | .assert @@/,u = 5 , "len"
5967 | .assert @@/2,u = .buffer1 + 5 , "c-addr"
E9B8: 39 5968 | rts
5969 |
E9B9: 0000 5970 | .results1 fdb 0
E9BB: 0020 5971 | .datastack1 fdb ' '
5972 |
E9BD: 202020202048... 5973 | .buffer1 fcc ' HELLO '
5974 | .len1 equ * - .buffer1
5975 | .endtst
5976 |
5977 | ;----------------------------------------------
5978 |
5979 | .test "PARSE end of input"
5980 | .opt test pokew forth__source , .buffer2
5981 | .opt test pokew forth__source_len , .len2
5982 | .opt test pokew forth__in , 0
E9CB: CE E9D7 5983 | ldu #.datastack2
E9CE: 8E 1698 5984 | ldx #forth_core_ext_parse.xt
E9D1: BD 0C04 5985 | jsr forth_core_execute.asm
5986 | .assert /u = .results2 , "U"
5987 | .assert @@/,u = 5 , "len"
5988 | .assert @@/2,u = .buffer2 , "c-addr"
E9D4: 39 5989 | rts
5990 |
E9D5: 0000 5991 | .results2 fdb 0
E9D7: 20 5992 | .datastack2 fcb ' '
5993 |
E9D8: 48454C4C4F 5994 | .buffer2 fcc 'HELLO'
5995 | .len2 equ * - .buffer2
5996 | .endtst
5997 |
5998 | ;----------------------------------------
5999 |
6000 | .test "PARSE only delimiter"
6001 | .opt test pokew forth__source , .buffer3
6002 | .opt test pokew forth__source_len , .len3
6003 | .opt test pokew forth__in , 0
E9DD: CE E9E9 6004 | ldu #.datastack3
E9E0: 8E 1698 6005 | ldx #forth_core_ext_parse.xt
E9E3: BD 0C04 6006 | jsr forth_core_execute.asm
6007 | .assert /u = .results3 , "U"
6008 | .assert @@/,u = 0 , "len"
6009 | .assert @@/2,u = .buffer3 , "c-addr"
E9E6: 39 6010 | rts
6011 |
E9E7: 0000 6012 | .results3 fdb 0
E9E9: 0020 6013 | .datastack3 fdb ' '
6014 |
E9EB: 2020 6015 | .buffer3 fcc ' '
6016 | .len3 equ * - .buffer3
6017 | .endtst
6018 |
6019 | ;-----------------------------------------
6020 |
6021 | .test "PARSE no data"
6022 | .opt test pokew forth__source , .buffer4
6023 | .opt test pokew forth__source_len , .len4
6024 | .opt test pokew forth__in , 0
E9ED: CE E9F9 6025 | ldu #.datastack4
E9F0: 8E 1698 6026 | ldx #forth_core_ext_parse.xt
E9F3: BD 0C04 6027 | jsr forth_core_execute.asm
6028 | .assert /u = .results4 , "U"
6029 | .assert @@/,u = 0 , "len"
6030 | .assert @@/2,u = .buffer4 , "c-addr"
E9F6: 39 6031 | rts
6032 |
E9F7: 0000 6033 | .results4 fdb 0
E9F9: 0022 6034 | .datastack4 fdb '"'
6035 |
E9FB: 22 6036 | .buffer4 fcc '"'
6037 | .len4 equ * - .buffer4
6038 | .endtst
6039 |
6040 | ;**********************************************************************
6041 |
16D8: 6042 | forth_core_ext_parse_name ; ( "name" -- c-addr u )
16D8: 168F 6043 | fdb forth_core_ext_parse
16DA: 000A 6044 | fdb .xt - .name
16DC: 50415253452D... 6045 | .name fcc "PARSE-NAME"
16E6: 16E8 6046 | .xt fdb .body
16E8: 9E 20 6047 | .body ldx forth__source
16EA: DC 1A 6048 | ldd forth__in
16EC: 1093 22 6049 | cmpd forth__source_len
16EF: 24 1F 6050 | bhs .no_input
16F1: 30 8B 6051 | leax d,x
16F3: A6 80 6052 | .skip_space lda ,x+
16F5: 81 20 6053 | cmpa #' '
16F7: 27 FA 6054 | beq .skip_space
16F9: 30 1F 6055 | leax -1,x
16FB: 1F 10 6056 | tfr x,d
16FD: 93 20 6057 | subd forth__source
16FF: DD 1A 6058 | std forth__in
1701: CC 0020 6059 | ldd #' '
1704: 36 06 6060 | pshu d
1706: 8E 1698 6061 | ldx #forth_core_ext_parse.xt
1709: 17 F4F8 6062 | lbsr forth_core_execute.asm
170C: AE A1 6063 | ldx ,y++
170E: 6E 94 6064 | jmp [,x]
1710: 4F 6065 | .no_input clra
1711: 5F 6066 | clrb
1712: 36 16 6067 | pshu x,d
1714: AE A1 6068 | ldx ,y++
1716: 6E 94 6069 | jmp [,x]
6070 |
6071 | ;---------------------------------------------
6072 |
6073 | .test "PARSE-NAME easy"
6074 | .opt test pokew forth__source , .buffer1
6075 | .opt test pokew forth__source_len , .len1
6076 | .opt test pokew forth__in , 5
E9FC: CE EA0A 6077 | ldu #.datastack1
E9FF: 8E 16E6 6078 | ldx #forth_core_ext_parse_name.xt
EA02: BD 0C04 6079 | jsr forth_core_execute.asm
6080 | .assert /u = .results1 , "U"
6081 | .assert @@/,u = 5 , "len"
6082 | .assert @@/2,u = .buffer1 + 5 , "c-addr"
EA05: 39 6083 | rts
6084 |
EA06: 0000 6085 | .results1 fdb 0
EA08: 0000 6086 | fdb 0
EA0A: 0000 6087 | .datastack1 fdb 0
6088 |
EA0C: 202020202048... 6089 | .buffer1 fcc ' HELLO '
6090 | .len1 equ * - .buffer1
6091 | .endtst
6092 |
6093 | ;------------------------------------------
6094 |
6095 | .test "PARSE-NAME no leading delim"
6096 | .opt test pokew forth__source , .buffer2
6097 | .opt test pokew forth__source_len , .len2
6098 | .opt test pokew forth__in , 0
EA1A: CE EA28 6099 | ldu #.datastack2
EA1D: 8E 16E6 6100 | ldx #forth_core_ext_parse_name.xt
EA20: BD 0C04 6101 | jsr forth_core_execute.asm
6102 | .assert /u = .results2 , "U"
6103 | .assert @@/,u = 5 , "len"
6104 | .assert @@/2,u = .buffer2 , "c-addr"
EA23: 39 6105 | rts
6106 |
EA24: 0000 6107 | .results2 fdb 0
EA26: 0000 6108 | fdb 0
EA28: 0000 6109 | .datastack2 fdb 0
6110 |
EA2A: 48454C4C4F 6111 | .buffer2 fcc 'HELLO'
6112 | .len2 equ * - .buffer2
6113 | .endtst
6114 |
6115 | ;-----------------------------------------
6116 |
6117 | .test "PARSE-NAME no input"
6118 | .opt test pokew forth__source , .buffer3
6119 | .opt test pokew forth__source_len , .len3
6120 | .opt test pokew forth__in , 0
EA2F: CE EA3D 6121 | ldu #.datastack3
EA32: 8E 16E6 6122 | ldx #forth_core_ext_parse_name.xt
EA35: BD 0C04 6123 | jsr forth_core_execute.asm
6124 | .assert /u = .results3 , "U"
6125 | .assert @@/,u = 0 , "len"
6126 | .assert @@/2,u = .buffer3 , "c-addr"
EA38: 39 6127 | rts
6128 |
EA39: 0000 6129 | .results3 fdb 0
EA3B: 0000 6130 | fdb 0
EA3D: 0000 6131 | .datastack3 fdb 0
EA3F: 12 6132 | nop
6133 |
EA40: 00 6134 | .buffer3 fcb 0
6135 | .len3 equ 0
6136 | .endtst
6137 |
6138 | ;**********************************************************************
6139 |
1718: 6140 | forth_core_ext_pick ; ( xu..x0 u -- x1..x0 xu )
1718: 16D8 6141 | fdb forth_core_ext_parse_name
171A: 0004 6142 | fdb .xt - .name
171C: 5049434B 6143 | .name fcc "PICK"
1720: 1722 6144 | .xt fdb .body
1722: EC C4 6145 | .body ldd ,u ; get index
1724: E3 C1 6146 | addd ,u++ ; convert to byte index
1726: EC CB 6147 | ldd d,u ; get value at said index
1728: 36 06 6148 | pshu d ; save value
172A: AE A1 6149 | ldx ,y++ ; NEXT
172C: 6E 94 6150 | jmp [,x]
6151 |
6152 | ;**********************************************************************
6153 |
172E: 6154 | forth_core_ext_refill ; ( -- flag )
172E: 1718 6155 | fdb forth_core_ext_pick
1730: 0006 6156 | fdb .xt - .name
1732: 524546494C4C 6157 | .name fcc "REFILL"
1738: 173A 6158 | .xt fdb .body
173A: DC 1E 6159 | .body ldd forth__source_id
173C: 2B 20 6160 | bmi .string_input
173E: 4F 6161 | clra
173F: 5F 6162 | clrb
1740: DD 1A 6163 | std forth__in
1742: DC 20 6164 | ldd forth__source
1744: 36 06 6165 | pshu d
1746: CC 0050 6166 | ldd #INPUT_SIZE
1749: 36 06 6167 | pshu d
174B: 8E 080B 6168 | ldx #forth_core_accept.xt
174E: BD 0C04 6169 | jsr forth_core_execute.asm
1751: EC C4 6170 | ldd ,u
1753: DD 22 6171 | std forth__source_len
1755: CC FFFF 6172 | ldd #-1
1758: ED C4 6173 | std ,u
175A: AE A1 6174 | ldx ,y++
175C: 6E 94 6175 | jmp [,x]
175E: 6F C2 6176 | .string_input clr ,-u
1760: 6F C2 6177 | clr ,-u
1762: AE A1 6178 | ldx ,y++
1764: 6E 94 6179 | jmp [,x]
6180 |
6181 | ;**********************************************************************
6182 |
1766: 6183 | forth_core_ext_restore_input ; ( xn..x1 n -- flag )
1766: 172E 6184 | fdb forth_core_ext_refill
1768: 000D 6185 | fdb .xt - .name
176A: 524553544F52... 6186 | .name fcc "RESTORE-INPUT"
1777: 0678 6187 | .xt fdb forth_core_colon.runtime
6188 | ;============================================
6189 | ; : RESTORE-INPUT
6190 | ; ( 1 ) DUP 4 = IF
6191 | ; ( 2 ) DROP set-source-id >IN ! source-restore
6192 | ; ( 4 ) ELSE
6193 | ; ( 5 ) 0 ?DO DROP LOOP FALSE
6194 | ; ( 6 ) THEN ;
6195 | ;============================================
1779: 0A74 6196 | fdb forth_core_dupe.xt ; ( 1 )
177B: 0D84 6197 | fdb forth_core_literal.runtime_xt
177D: 0004 6198 | fdb 4
177F: 06D9 6199 | fdb forth_core_equals.xt
1781: 0CD1 6200 | fdb forth_core_if.runtime_xt
1783: 1795 6201 | fdb .L3
1785: 0A65 6202 | fdb forth_core_drop.xt ; ( 2 )
1787: 0354 6203 | fdb forth__private_set_source_i_d
1789: 0726 6204 | fdb forth_core_to_in.xt
178B: 0377 6205 | fdb forth_core_store.xt
178D: 035E 6206 | fdb forth__private_source_restore_xt
178F: 19BD 6207 | fdb forth_core_ext_true.xt
1791: 1430 6208 | fdb forth_core_ext_again.runtime_xt
1793: 17A5 6209 | fdb .L6
1795: 0D84 6210 | .L3 fdb forth_core_literal.runtime_xt ; ( 5 )
1797: 0000 6211 | fdb 0
1799: 13D4 6212 | fdb forth_core_ext_question_do.runtime_xt
179B: 17A3 6213 | fdb .L5
179D: 0A65 6214 | .L4 fdb forth_core_drop.xt
179F: 0D9E 6215 | fdb forth_core_loop.runtime_xt
17A1: 179D 6216 | fdb .L4
17A3: 156D 6217 | .L5 fdb forth_core_ext_false.xt
17A5: 0C1A 6218 | .L6 fdb forth_core_exit.xt
6219 |
6220 | ;----------------------------------------------
6221 |
6222 | .test "RESTORE-INPUT good"
6223 | .opt test pokew forth__source_id , 0
6224 | .opt test pokew forth__in , 20
EA41: CE EA4F 6225 | ldu #.datastack1
EA44: 8E 1777 6226 | ldx #forth_core_ext_restore_input.xt
EA47: BD 0C04 6227 | jsr forth_core_execute.asm
6228 | .assert /u = .result1 , "U"
6229 | .assert @@/0,u = -1 , "flag"
6230 | .assert @@forth__in = 5 , ">IN"
6231 | .assert @@forth__source = $6000 , "SOURCE c-addr"
6232 | .assert @@forth__source_len = 0 , "SOURCE u"
EA4A: 39 6233 | rts
6234 |
EA4B: 0000 6235 | fdb 0
EA4D: 0000 6236 | fdb 0
EA4F: 0004 6237 | .datastack1 fdb 4
EA51: 0000 6238 | fdb 0
EA53: 0005 6239 | fdb 5
EA55: 0000 6240 | fdb 0
EA57: 6000 6241 | .result1 fdb $6000
6242 | .endtst
6243 |
6244 | ;---------------------------------------------
6245 |
6246 | .test "RESTORE-INPUT bad number"
EA59: CE EA67 6247 | ldu #.datastack3
EA5C: 8E 1777 6248 | ldx #forth_core_ext_restore_input.xt
EA5F: BD 0C04 6249 | jsr forth_core_execute.asm
6250 | .assert /u = .result3 , "U"
6251 | .assert @@/0,u = 0 , "flag"
EA62: 39 6252 | rts
6253 |
EA63: 0000 6254 | fdb 0
EA65: 0000 6255 | fdb 0
EA67: 0006 6256 | .datastack3 fdb 6
EA69: 0001 6257 | fdb 1
EA6B: 0002 6258 | fdb 2
EA6D: 0003 6259 | fdb 3
EA6F: 0004 6260 | fdb 4
EA71: 0005 6261 | fdb 5
EA73: 0006 6262 | .result3 fdb 6
6263 | .endtst
6264 |
6265 | ;**********************************************************************
6266 |
17A7: 6267 | forth_core_ext_roll ; ( xu..x0 u -- xu-1..x0 xu )
17A7: 1766 6268 | fdb forth_core_ext_restore_input
17A9: 0004 6269 | fdb .xt - .name
17AB: 524F4C4C 6270 | .name fcc "ROLL"
17AF: 17B1 6271 | .xt fdb .body
17B1: EC C1 6272 | .body ldd ,u++
17B3: 27 1A 6273 | beq .done
17B5: 58 6274 | lslb
17B6: 49 6275 | rola
17B7: 30 CB 6276 | leax d,u ; point to proper location
17B9: 9C 08 6277 | cmpx forth__ds_top ; index out of range
17BB: 22 16 6278 | bhi .throw_overflow
17BD: EC 84 6279 | ldd ,x ; get data stack entry
17BF: 34 46 6280 | pshs u,d ; save pointer and data
17C1: EC 1E 6281 | .again ldd -2,x ; copy stack data
17C3: ED 84 6282 | std ,x
17C5: 30 1E 6283 | leax -2,x
17C7: AC 62 6284 | cmpx 2,s
17C9: 26 F6 6285 | bne .again
17CB: 35 46 6286 | puls u,d ; get data (and clean stack of U)
17CD: ED C4 6287 | std ,u ; save buttom data to top
17CF: AE A1 6288 | .done ldx ,y++
17D1: 6E 94 6289 | jmp [,x]
17D3: CC FFFD 6290 | .throw_overflow ldd #-3
17D6: 16 06E1 6291 | lbra forth_exception_throw.asm
6292 |
6293 | ;------------------------------------
6294 |
6295 | .test "0 ROLL (nop)"
6296 | .opt test pokew forth__ds_top , .top1
6297 | .opt test prot n , .top1
EA75: CE EA83 6298 | ldu #.datastack1
EA78: 8E 17AF 6299 | ldx #forth_core_ext_roll.xt
EA7B: BD 0C04 6300 | jsr forth_core_execute.asm
6301 | .assert /u = .result1
6302 | .assert @@/0,u = -1
6303 | .assert @@/2,u = -2
6304 | .assert @@/4,u = -3
6305 | .assert @@/6,u = -4
6306 | .assert @@/8,u = -5
EA7E: 39 6307 | rts
6308 |
EA7F: 0000 6309 | fdb 0
EA81: 0000 6310 | fdb 0
EA83: 0000 6311 | .datastack1 fdb 0
EA85: FFFF 6312 | .result1 fdb -1
EA87: FFFE 6313 | fdb -2
EA89: FFFD 6314 | fdb -3
EA8B: FFFC 6315 | fdb -4
EA8D: FFFB 6316 | fdb -5
EA8F: 0000 6317 | .top1 fdb 0
6318 | .endtst
6319 |
6320 | ;------------------------------------
6321 |
6322 | .test "1 ROLL (swap)"
6323 | .opt test pokew forth__ds_top , .top2
6324 | .opt test prot n , .top2
EA91: CE EA9F 6325 | ldu #.datastack2
EA94: 8E 17AF 6326 | ldx #forth_core_ext_roll.xt
EA97: BD 0C04 6327 | jsr forth_core_execute.asm
6328 | .assert /u = .result2
6329 | .assert @@/0,u = -2
6330 | .assert @@/2,u = -1
6331 | .assert @@/4,u = -3
6332 | .assert @@/6,u = -4
6333 | .assert @@/8,u = -5
EA9A: 39 6334 | rts
6335 |
EA9B: 0000 6336 | fdb 0
EA9D: 0000 6337 | fdb 0
EA9F: 0001 6338 | .datastack2 fdb 1
EAA1: FFFF 6339 | .result2 fdb -1
EAA3: FFFE 6340 | fdb -2
EAA5: FFFD 6341 | fdb -3
EAA7: FFFC 6342 | fdb -4
EAA9: FFFB 6343 | fdb -5
EAAB: 0000 6344 | .top2 fdb 0
6345 | .endtst
6346 |
6347 | ;------------------------------------
6348 |
6349 | .test "2 ROLL (rot)"
6350 | .opt test pokew forth__ds_top , .top3
6351 | .opt test prot n , .top3
EAAD: CE EABB 6352 | ldu #.datastack3
EAB0: 8E 17AF 6353 | ldx #forth_core_ext_roll.xt
EAB3: BD 0C04 6354 | jsr forth_core_execute.asm
6355 | .assert /u = .result3
6356 | .assert @@/0,u = -3
6357 | .assert @@/2,u = -1
6358 | .assert @@/4,u = -2
6359 | .assert @@/6,u = -4
6360 | .assert @@/8,u = -5
EAB6: 39 6361 | rts
6362 |
EAB7: 0000 6363 | fdb 0
EAB9: 0000 6364 | fdb 0
EABB: 0002 6365 | .datastack3 fdb 2
EABD: FFFF 6366 | .result3 fdb -1
EABF: FFFE 6367 | fdb -2
EAC1: FFFD 6368 | fdb -3
EAC3: FFFC 6369 | fdb -4
EAC5: FFFB 6370 | fdb -5
EAC7: 0000 6371 | .top3 fdb 0
6372 | .endtst
6373 |
6374 | ;------------------------------------
6375 |
6376 | .test "4 ROLL"
6377 | .opt test pokew forth__ds_top , .top4
6378 | .opt test prot n , .top4
EAC9: CE EAD7 6379 | ldu #.datastack4
EACC: 8E 17AF 6380 | ldx #forth_core_ext_roll.xt
EACF: BD 0C04 6381 | jsr forth_core_execute.asm
6382 | .assert /u = .result4
6383 | .assert @@/0,u = -5
6384 | .assert @@/2,u = -1
6385 | .assert @@/4,u = -2
6386 | .assert @@/6,u = -3
6387 | .assert @@/8,u = -4
EAD2: 39 6388 | rts
6389 |
EAD3: 0000 6390 | fdb 0
EAD5: 0000 6391 | fdb 0
EAD7: 0004 6392 | .datastack4 fdb 4
EAD9: FFFF 6393 | .result4 fdb -1
EADB: FFFE 6394 | fdb -2
EADD: FFFD 6395 | fdb -3
EADF: FFFC 6396 | fdb -4
EAE1: FFFB 6397 | fdb -5
EAE3: 0000 6398 | .top4 fdb 0
6399 | .endtst
6400 |
6401 | ;**********************************************************************
6402 |
17D9: 6403 | forth_core_ext_s_backslash_quote ; ( "ccc" -- ) ( -- c-addr u )
17D9: 17A7 6404 | fdb forth_core_ext_roll
17DB: A003 6405 | fdb _IMMED | _NOINTERP :: .xt - .name
17DD: 535C22 6406 | .name fcc 'S\"'
17E0: 17E2 6407 | .xt fdb .body
17E2: 34 60 6408 | .body pshs u,y ; save registers for other use
17E4: DC 22 6409 | ldd forth__source_len
17E6: 93 1A 6410 | subd forth__in
17E8: 27 2B 6411 | beq .no_input
17EA: 2B 29 6412 | bmi .no_input
17EC: 1F 02 6413 | tfr d,y
17EE: 9E 20 6414 | ldx forth__source
17F0: DC 1A 6415 | ldd forth__in
17F2: 30 8B 6416 | leax d,x ; calculate current byte in input buffer
17F4: DE 10 6417 | ldu forth__here
17F6: CC 2B7C 6418 | ldd #forth_string_sliteral.runtime_xt
17F9: ED C1 6419 | std ,u++
17FB: 33 42 6420 | leau 2,u ; space for length
17FD: 34 40 6421 | pshs u
17FF: A6 80 6422 | .input lda ,x+ ; get character
1801: 81 22 6423 | cmpa #'"' ; done?
1803: 27 16 6424 | beq .done
1805: 81 5C 6425 | cmpa #'\' ; escape?
1807: 27 2A 6426 | beq .escape
1809: A7 C0 6427 | sta ,u+ ; save character
180B: 31 3F 6428 | leay -1,y ; more input?
180D: 26 F0 6429 | bne .input
180F: CC FFEE 6430 | .throw_badinput ldd #-18 ; no quote yet, so error
1812: 16 06A5 6431 | lbra forth_exception_throw.asm
1815: 6F 5E 6432 | .no_input clr -2,u
1817: 6F 5F 6433 | clr -1,u
1819: 20 10 6434 | bra .finish
181B: 1F 10 6435 | .done tfr x,d ; calculate >IN
181D: 93 20 6436 | subd forth__source
181F: DD 1A 6437 | std forth__in
1821: 1F 30 6438 | tfr u,d ; get end of input
1823: 9E 10 6439 | ldx forth__here
1825: 30 02 6440 | leax 2,x ; point past xt
1827: A3 E1 6441 | subd ,s++ ; calculate length of string
1829: ED 84 6442 | std ,x ; save length of string
182B: DF 10 6443 | .finish stu forth__here ; update HERE
182D: 35 60 6444 | puls u,y ; restore registers
182F: AE A1 6445 | ldx ,y++
1831: 6E 94 6446 | jmp [,x]
1833: 31 3F 6447 | .escape leay -1,y
1835: 27 D8 6448 | beq .throw_badinput
1837: A6 80 6449 | lda ,x+
1839: 81 61 6450 | cmpa #'a'
183B: 27 59 6451 | beq .escape_a
183D: 81 62 6452 | cmpa #'b'
183F: 27 59 6453 | beq .escape_b
1841: 81 65 6454 | cmpa #'e'
1843: 27 59 6455 | beq .escape_e
1845: 81 66 6456 | cmpa #'f'
1847: 27 59 6457 | beq .escape_f
1849: 81 6C 6458 | cmpa #'l'
184B: 27 59 6459 | beq .escape_l
184D: 81 6D 6460 | cmpa #'m'
184F: 27 59 6461 | beq .escape_m
1851: 81 6E 6462 | cmpa #'n'
1853: 27 63 6463 | beq .escape_n
1855: 81 71 6464 | cmpa #'q'
1857: 27 63 6465 | beq .escape_q
1859: 81 72 6466 | cmpa #'r'
185B: 27 63 6467 | beq .escape_r
185D: 81 74 6468 | cmpa #'t'
185F: 27 63 6469 | beq .escape_t
1861: 81 76 6470 | cmpa #'v'
1863: 27 63 6471 | beq .escape_v
1865: 81 7A 6472 | cmpa #'z'
1867: 27 63 6473 | beq .escape_z
1869: 81 22 6474 | cmpa #'"'
186B: 27 4F 6475 | beq .escape_q
186D: 81 5C 6476 | cmpa #'\'
186F: 27 5E 6477 | beq .escape_bs
1871: 81 78 6478 | cmpa #'x'
1873: 26 9A 6479 | bne .throw_badinput
1875: 108C 0004 6480 | cmpy #4
1879: 25 94 6481 | blo .throw_badinput
187B: 8D 5F 6482 | bsr .tohex
187D: 48 6483 | lsla
187E: 48 6484 | lsla
187F: 48 6485 | lsla
1880: 48 6486 | lsla
1881: A7 C4 6487 | sta ,u
1883: 8D 57 6488 | bsr .tohex
1885: AA C4 6489 | ora ,u
1887: A7 C0 6490 | sta ,u+ ;\x##
1889: 31 3D 6491 | leay -3,y
188B: 108C 0001 6492 | cmpy #1
188F: 1024 FF6C 6493 | lbhs .input
1893: 16 FF79 6494 | lbra .throw_badinput
1896: 86 07 6495 | .escape_a lda #7
1898: 20 37 6496 | bra .store
189A: 86 08 6497 | .escape_b lda #8
189C: 20 33 6498 | bra .store
189E: 86 1B 6499 | .escape_e lda #27
18A0: 20 2F 6500 | bra .store
18A2: 86 0C 6501 | .escape_f lda #12
18A4: 20 2B 6502 | bra .store
18A6: 86 0A 6503 | .escape_l lda #10
18A8: 20 27 6504 | bra .store
18AA: CC 0D0A 6505 | .escape_m ldd #13::10 ; this escape is two characters long,
18AD: ED C1 6506 | std ,u++
18AF: 31 3F 6507 | leay -1,y
18B1: 1027 FF5A 6508 | lbeq .throw_badinput
18B5: 16 FF47 6509 | lbra .input
18B8: 86 0A 6510 | .escape_n lda #NL
18BA: 20 15 6511 | bra .store
18BC: 86 22 6512 | .escape_q lda #34
18BE: 20 11 6513 | bra .store
18C0: 86 0D 6514 | .escape_r lda #13
18C2: 20 0D 6515 | bra .store
18C4: 86 09 6516 | .escape_t lda #9
18C6: 20 09 6517 | bra .store
18C8: 86 0B 6518 | .escape_v lda #11
18CA: 20 05 6519 | bra .store
18CC: 4F 6520 | .escape_z clra
18CD: 20 02 6521 | bra .store
18CF: 86 5C 6522 | .escape_bs lda #92
18D1: A7 C0 6523 | .store sta ,u+
18D3: 31 3F 6524 | leay -1,y
18D5: 1027 FF36 6525 | lbeq .throw_badinput
18D9: 16 FF23 6526 | lbra .input
18DC: A6 80 6527 | .tohex lda ,x+
18DE: 80 30 6528 | suba #'0'
18E0: 102B FF2B 6529 | lbmi .throw_badinput
18E4: 81 09 6530 | cmpa #9
18E6: 23 08 6531 | bls .tohex_done
18E8: 80 07 6532 | suba #7
18EA: 81 24 6533 | cmpa #36
18EC: 25 02 6534 | blo .tohex_done
18EE: 80 20 6535 | suba #32 ; adjust for lower case
18F0: 81 0F 6536 | .tohex_done cmpa #15
18F2: 102E FF19 6537 | lbgt .throw_badinput
18F6: 39 6538 | rts
6539 |
6540 | ;-----------------------------------------
6541 |
6542 | .test 'S\\" one\\ttwo\\mthree\\x45 "'
6543 | .opt test pokew forth__source , .buffer
6544 | .opt test pokew forth__source_len , .len
6545 | .opt test pokew forth__in , 0
6546 | .opt test pokew forth__here , .foo_body
EAE5: CE EAF3 6547 | ldu #.datastack
EAE8: 8E 17E0 6548 | ldx #forth_core_ext_s_backslash_quote.xt
EAEB: BD 0C04 6549 | jsr forth_core_execute.asm
6550 | .assert /u = .datastack , "U"
6551 | .assert @@.foo_body = forth_string_sliteral.runtime_xt , "xt"
6552 | .assert @@.foo_len = 16 , "len"
6553 | .assert .foo_addr = "one\ttwo\r\nthreeE " , "text"
6554 | .assert @@.stop = -1 , "no-write"
EAEE: 39 6555 | rts
6556 |
EAEF: 0000 6557 | fdb 0
EAF1: 0000 6558 | fdb 0
EAF3: 0015 6559 | .datastack fdb .len
6560 |
EAF5: 6F6E655C7474... 6561 | .buffer fcc 'one\ttwo\mthree\x45 "'
6562 | .len equ * - .buffer
6563 |
EB0A: 0678 6564 | fdb forth_core_colon.runtime
EB0C: 0000 6565 | .foo_body fdb 0
EB0E: 0000 6566 | .foo_len fdb 0
EB10: 6567 | .foo_addr rmb 16
EB20: FFFF 6568 | .stop fdb -1
6569 | .endtst
6570 |
6571 | ;---------------------------------------
6572 |
6573 | .test 'S\\" Christmas String"'
6574 | .opt test prot n , .stop2
6575 | .opt test pokew forth__source , .buffer2
6576 | .opt test pokew forth__source_len , .len2
6577 | .opt test pokew forth__in , 0
6578 | .opt test pokew forth__here , .foo2_body
EB22: CE EB30 6579 | ldu #.datastack2
EB25: 8E 17E0 6580 | ldx #forth_core_ext_s_backslash_quote.xt
EB28: BD 0C04 6581 | jsr forth_core_execute.asm
6582 | .assert /u = .datastack2 , "U"
6583 | .assert @@.foo2_body = forth_string_sliteral.runtime_xt , "xt"
6584 | .assert @@.foo2_len = 18 , "len"
6585 | .assert @@.stop2 = -1 , "no-write"
EB2B: 39 6586 | rts
6587 |
EB2C: 0000 6588 | fdb 0
EB2E: 0000 6589 | fdb 0
EB30: 0000 6590 | .datastack2 fdb 0
6591 |
EB32: 5C61 6592 | .buffer2 fcc '\a'
EB34: 5C62 6593 | fcc '\b'
EB36: 5C65 6594 | fcc '\e'
EB38: 5C66 6595 | fcc '\f'
EB3A: 5C6C 6596 | fcc '\l'
EB3C: 5C6D 6597 | fcc '\m'
EB3E: 5C6E 6598 | fcc '\n'
EB40: 5C71 6599 | fcc '\q'
EB42: 5C72 6600 | fcc '\r'
EB44: 5C74 6601 | fcc '\t'
EB46: 5C76 6602 | fcc '\v'
EB48: 5C7A 6603 | fcc '\z'
EB4A: 5C22 6604 | fcc '\"'
EB4C: 5C783046 6605 | fcc '\x0F'
EB50: 5C784631 6606 | fcc '\xF1'
EB54: 5C786142 6607 | fcc '\xaB'
EB58: 5C5C 6608 | fcc '\\'
EB5A: 22 6609 | fcc '"'
6610 | .len2 equ * - .buffer2
EB5B: 0029 6611 | fdb .len2
6612 |
EB5D: 0678 6613 | fdb forth_core_colon.runtime
EB5F: 0000 6614 | .foo2_body fdb 0
EB61: 0000 6615 | .foo2_len fdb 0
EB63: 6616 | rmb 18
EB75: FFFF 6617 | .stop2 fdb -1
6618 | .endtst
6619 |
6620 | ;**********************************************************************
6621 |
18F7: 6622 | forth_core_ext_save_input ; ( -- xn..x1 n )
18F7: 17D9 6623 | fdb forth_core_ext_s_backslash_quote
18F9: 000A 6624 | fdb .xt - .name
18FB: 534156452D49... 6625 | .name fcc "SAVE-INPUT"
1905: 0678 6626 | .xt fdb forth_core_colon.runtime
6627 | ;=============================================
6628 | ; : SAVE-INPUT
6629 | ; SOURCE >IN @ SOURCE-ID 4 ;
6630 | ;=============================================
1907: 10BB 6631 | fdb forth_core_source.xt
1909: 0726 6632 | fdb forth_core_to_in.xt
190B: 07E2 6633 | fdb forth_core_fetch.xt
190D: 1922 6634 | fdb forth_core_ext_source_i_d.xt
190F: 0D84 6635 | fdb forth_core_literal.runtime_xt
1911: 0004 6636 | fdb 4
1913: 0C1A 6637 | fdb forth_core_exit.xt
6638 |
6639 | ;**********************************************************************
6640 |
1915: 6641 | forth_core_ext_source_i_d ; ( -- 0 | -1 )
1915: 18F7 6642 | fdb forth_core_ext_save_input
1917: 0009 6643 | fdb .xt - .name
1919: 534F55524345... 6644 | .name fcc "SOURCE-ID"
1922: 1924 6645 | .xt fdb .body
1924: DC 1E 6646 | .body ldd forth__source_id
1926: 36 06 6647 | pshu d
1928: AE A1 6648 | ldx ,y++
192A: 6E 94 6649 | jmp [,x]
6650 |
6651 | ;**********************************************************************
6652 |
192C: 6653 | forth_core_ext_to ; I ( i*x "name" -- ) C ( "name -- )
192C: 1915 6654 | fdb forth_core_ext_source_i_d
192E: 8002 6655 | fdb _IMMED :: .xt - .name
1930: 544F 6656 | .name fcc "TO"
1932: 1934 6657 | .xt fdb .body
1934: 8E 040D 6658 | .body ldx #forth_core_tick.xt ; ' word
1937: 17 F2CA 6659 | lbsr forth_core_execute.asm
193A: 0D 19 6660 | tst forth__state + 1 ; compile mode?
193C: 26 1F 6661 | bne .compile ; compile mode, handle it
193E: AE C4 6662 | ldx ,u
1940: 17 E7B0 6663 | lbsr forth__util_xt_to_name
1943: 37 10 6664 | pulu x ; get xt
1945: 30 02 6665 | leax 2,x ; >BODY
1947: 85 10 6666 | bita #_DOUBLE
1949: 26 08 6667 | bne .imm_double
194B: 37 06 6668 | pulu d ; get data
194D: ED 84 6669 | std ,x ; store in value
194F: AE A1 6670 | .done ldx ,y++
1951: 6E 94 6671 | jmp [,x]
1953: 37 06 6672 | .imm_double pulu d
1955: ED 81 6673 | std ,x++
1957: 37 06 6674 | pulu d
1959: ED 84 6675 | std ,x
195B: 20 F2 6676 | bra .done
195D: AE C4 6677 | .compile ldx ,u ; get xt
195F: 17 E791 6678 | lbsr forth__util_xt_to_name
1962: 9E 10 6679 | ldx forth__here ; preload X with HERE
1964: 85 08 6680 | bita #_LOCAL ; is this a LOCAL?
1966: 26 11 6681 | bne .local ; yes, handle it
1968: 85 10 6682 | bita #_DOUBLE ; is this a DOUBLE?
196A: 26 1E 6683 | bne .double ; yes, handle it
196C: CC 1995 6684 | ldd #.runtime_xt ; copmile runtime action
196F: ED 81 6685 | std ,x++
1971: 37 06 6686 | pulu d ; get xt
1973: ED 81 6687 | std ,x++ ; save pointer
1975: 9F 10 6688 | .storehere_done stx forth__here
1977: 20 D6 6689 | bra .done
1979: CC 204D 6690 | .local ldd #forth__local_store ; compile local fetch
197C: ED 81 6691 | std ,x++
197E: 34 20 6692 | pshs y
1980: 37 20 6693 | pulu y ; get xt
1982: EC 22 6694 | ldd 2,y ; get frame pointer index in body
1984: ED 81 6695 | std ,x++ ; compile
1986: 35 20 6696 | puls y
1988: 20 EB 6697 | bra .storehere_done
198A: CC 19A3 6698 | .double ldd #.runtime_double_xt
198D: ED 81 6699 | std ,x++
198F: 37 06 6700 | pulu d
1991: ED 81 6701 | std ,x++
1993: 20 E0 6702 | bra .storehere_done
6703 |
1995: 1997 6704 | .runtime_xt fdb .runtime
1997: AE A1 6705 | .runtime ldx ,y++
1999: 30 02 6706 | leax 2,x ; point to body
199B: 37 06 6707 | pulu d
199D: ED 84 6708 | std ,x
199F: AE A1 6709 | ldx ,y++
19A1: 6E 94 6710 | jmp [,x]
6711 |
19A3: 19A5 6712 | .runtime_double_xt fdb .runtime_double
19A5: AE A1 6713 | .runtime_double ldx ,y++
19A7: 30 02 6714 | leax 2,x
19A9: 37 06 6715 | pulu d
19AB: ED 81 6716 | std ,x++
19AD: 37 06 6717 | pulu d
19AF: ED 84 6718 | std ,x
19B1: AE A1 6719 | ldx ,y++
19B3: 6E 94 6720 | jmp [,x]
6721 |
6722 | ;**********************************************************************
6723 |
19B5: 6724 | forth_core_ext_true ; ( -- true )
19B5: 192C 6725 | fdb forth_core_ext_to
19B7: 0004 6726 | fdb .xt - .name
19B9: 54525545 6727 | .name fcc "TRUE"
19BD: 097A 6728 | .xt fdb forth_core_constant.does
6729 | ;====================================
6730 | ; -1 CONSTANT TRUE
6731 | ;====================================
19BF: FFFF 6732 | fdb -1
6733 |
6734 | ;**********************************************************************
6735 |
19C1: 6736 | forth_core_ext_tuck ; ( x1 x2 -- x2 x1 x2 )
19C1: 19B5 6737 | fdb forth_core_ext_true
19C3: 0004 6738 | fdb .xt - .name
19C5: 5455434B 6739 | .name fcc "TUCK"
19C9: 0678 6740 | .xt fdb forth_core_colon.runtime
6741 | ;==================================
6742 | ; : TUCK SWAP OVER ;
6743 | ;==================================
19CB: 10FC 6744 | fdb forth_core_swap.xt
19CD: 0EA4 6745 | fdb forth_core_over.xt
19CF: 0C1A 6746 | fdb forth_core_exit.xt
6747 |
6748 | ;**********************************************************************
6749 |
19D1: 6750 | forth_core_ext_u_dot_r ; ( u n -- )
19D1: 19C1 6751 | fdb forth_core_ext_tuck
19D3: 0003 6752 | fdb .xt - .name
19D5: 552E52 6753 | .name fcc "U.R"
19D8: 0678 6754 | .xt fdb forth_core_colon.runtime
6755 | ;===============================================
6756 | ; : U.R SWAP <# 0 #S #> ROT 2DUP
6757 | ; < IF OVER - SPACES ELSE DROP THEN
6758 | ; TYPE SPACE ;
6759 | ;===============================================
19DA: 10FC 6760 | fdb forth_core_swap.xt
19DC: 06C7 6761 | fdb forth_core_less_number_sign.xt
19DE: 0D84 6762 | fdb forth_core_literal.runtime_xt
19E0: 0000 6763 | fdb 0
19E2: 03FA 6764 | fdb forth_core_number_sign_s.xt
19E4: 03E1 6765 | fdb forth_core_number_sign_greater.xt
19E6: 0FF6 6766 | fdb forth_core_rote.xt
19E8: 060D 6767 | fdb forth_core_two_dupe.xt
19EA: 06AB 6768 | fdb forth_core_less_than.xt
19EC: 0CD1 6769 | fdb forth_core_if.runtime_xt
19EE: 19FA 6770 | fdb .L1
19F0: 0EA4 6771 | fdb forth_core_over.xt
19F2: 0506 6772 | fdb forth_core_minus.xt
19F4: 10E2 6773 | fdb forth_core_spaces.xt
19F6: 1430 6774 | fdb forth_core_ext_again.runtime_xt
19F8: 19FC 6775 | fdb .L2
19FA: 0A65 6776 | .L1 fdb forth_core_drop.xt
19FC: 1124 6777 | .L2 fdb forth_core_type.xt
19FE: 10D0 6778 | fdb forth_core_space.xt
1A00: 0C1A 6779 | fdb forth_core_exit.xt
6780 |
6781 | ;**********************************************************************
6782 |
1A02: 6783 | forth_core_ext_u_greater_than ; ( u1 u2 -- flag )
1A02: 19D1 6784 | fdb forth_core_ext_u_dot_r
1A04: 0002 6785 | fdb .xt - .name
1A06: 553E 6786 | .name fcc "U>"
1A08: 1A0A 6787 | .xt fdb .body
1A0A: EC 42 6788 | .body ldd 2,u
1A0C: 10A3 C1 6789 | cmpd ,u++
1A0F: 22 04 6790 | bhi .greaterthan
1A11: 4F 6791 | clra
1A12: 5F 6792 | clrb
1A13: 20 03 6793 | bra .done
1A15: CC FFFF 6794 | .greaterthan ldd #-1
1A18: ED C4 6795 | .done std ,u
1A1A: AE A1 6796 | ldx ,y++ ; NEXT
1A1C: 6E 94 6797 | jmp [,x]
6798 |
6799 | ;**********************************************************************
6800 |
1A1E: 6801 | forth_core_ext_unused ; ( -- n )
1A1E: 1A02 6802 | fdb forth_core_ext_u_greater_than
1A20: 0006 6803 | fdb .xt - .name
1A22: 554E55534544 6804 | .name fcc "UNUSED"
1A28: 1A2A 6805 | .xt fdb .body
1A2A: DC 0E 6806 | .body ldd forth__here_top ; get HERE top
1A2C: 93 10 6807 | subd forth__here ; subract out current HERE
1A2E: 36 06 6808 | pshu d ; return result
1A30: AE A1 6809 | ldx ,y++
1A32: 6E 94 6810 | jmp [,x]
6811 |
6812 | ;**********************************************************************
6813 |
1A34: 6814 | forth_core_ext_value ; ( x "name" -- ) E ( -- x )
1A34: 1A1E 6815 | fdb forth_core_ext_unused
1A36: 0005 6816 | fdb .xt - .name
1A38: 56414C5545 6817 | .name fcc "VALUE"
1A3D: 1A3F 6818 | .xt fdb .body
1A3F: 8E 09B2 6819 | .body ldx #forth_core_create.xt ; CREATE
1A42: 17 F1BF 6820 | lbsr forth_core_execute.asm
1A45: 9E 28 6821 | ldx forth__create_xt
1A47: CC 1A56 6822 | ldd #.runtime
1A4A: ED 81 6823 | std ,x++ ; set xt
1A4C: 37 06 6824 | pulu d
1A4E: ED 81 6825 | std ,x++ ; set body
1A50: 9F 10 6826 | stx forth__here ; update HERE
1A52: AE A1 6827 | ldx ,y++
1A54: 6E 94 6828 | jmp [,x]
6829 |
1A56: EC 02 6830 | .runtime ldd 2,x
1A58: 36 06 6831 | pshu d
1A5A: AE A1 6832 | ldx ,y++
1A5C: 6E 94 6833 | jmp [,x]
6834 |
6835 | ;**********************************************************************
6836 |
1A5E: 6837 | forth_core_ext_within ; ( test low high -- flag )
1A5E: 1A34 6838 | fdb forth_core_ext_value
1A60: 0006 6839 | fdb .xt - .name
1A62: 57495448494E 6840 | .name fcc "WITHIN"
1A68: 0678 6841 | .xt fdb forth_core_colon.runtime
6842 | ;=========================================
6843 | ; : WITHIN OVER - >R - R> U< ;
6844 | ;=========================================
1A6A: 0EA4 6845 | fdb forth_core_over.xt
1A6C: 0506 6846 | fdb forth_core_minus.xt
1A6E: 07BF 6847 | fdb forth_core_to_r.xt
1A70: 0506 6848 | fdb forth_core_minus.xt
1A72: 0FAA 6849 | fdb forth_core_r_from.xt
1A74: 115C 6850 | fdb forth_core_u_less_than.xt
1A76: 0C1A 6851 | fdb forth_core_exit.xt
6852 |
6853 | ;**********************************************************************
6854 |
1A78: 6855 | forth_core_ext_bracket_compile ; obsolete
1A78: 1A5E 6856 | fdb forth_core_ext_within
1A7A: A009 6857 | fdb _IMMED | _NOINTERP :: .xt - .name
1A7C: 5B434F4D5049... 6858 | .name fcc "[COMPILE]"
1A85: 0678 6859 | .xt fdb forth_core_colon.runtime
6860 | ;======================================
6861 | ; : [COMPILE] -30 THROW ; IMMEDIATE
6862 | ;======================================
1A87: 0D84 6863 | fdb forth_core_literal.runtime_xt
1A89: FFE2 6864 | fdb -30
1A8B: 1E8A 6865 | fdb forth_exception_throw.xt
6866 |
6867 | ;**********************************************************************
6868 |
1A8D: 6869 | forth_core_ext_backslash ; ( "ccc" -- )
1A8D: 1A78 6870 | fdb forth_core_ext_bracket_compile
1A8F: 8001 6871 | fdb _IMMED :: .xt - .name
1A91: 5C 6872 | .name ascii "\\"
1A92: 0678 6873 | .xt fdb forth_core_colon.runtime
6874 | ;===============================================
6875 | ; : \ SOURCE >IN ! DROP ;
6876 | ;===============================================
1A94: 10BB 6877 | fdb forth_core_source.xt
1A96: 0726 6878 | fdb forth_core_to_in.xt
1A98: 0377 6879 | fdb forth_core_store.xt
1A9A: 0A65 6880 | fdb forth_core_drop.xt
1A9C: 0C1A 6881 | fdb forth_core_exit.xt
6882 |
6883 | ;**********************************************************************
6884 | ; DOUBLE
6885 | ;**********************************************************************
6886 |
1A9E: 6887 | forth_double_two_constant ; ( x1 x2 "name" -- ) E ( -- x1 x2 )
1A9E: 1A8D 6888 | fdb forth_core_ext_backslash
1AA0: 0009 6889 | fdb .xt - .name
1AA2: 32434F4E5354... 6890 | .name fcc "2CONSTANT"
1AAB: 0678 6891 | .xt fdb forth_core_colon.runtime
6892 | ;==========================================================
6893 | ; : 2CONSTANT CREATE , , DOES> 2@ ;
6894 | ;==========================================================
1AAD: 09B2 6895 | fdb forth_core_create.xt
1AAF: 04F3 6896 | fdb forth_core_comma.xt
1AB1: 04F3 6897 | fdb forth_core_comma.xt
1AB3: 0A50 6898 | fdb forth_core_does.runtime_xt
1AB5: BD 09BD 6899 | .does jsr forth_core_create.does_hook
1AB8: 05E4 6900 | fdb forth_core_two_fetch.xt
1ABA: 0C1A 6901 | fdb forth_core_exit.xt
6902 |
6903 | ;**********************************************************************
6904 |
1ABC: 6905 | forth_double_two_literal ; C ( x1 x2 -- ) R ( -- x1 x2 )
1ABC: 1A9E 6906 | fdb forth_double_two_constant
1ABE: A008 6907 | fdb _IMMED | _NOINTERP :: .xt - .name
1AC0: 324C49544552... 6908 | .name fcc "2LITERAL"
1AC8: 1ACA 6909 | .xt fdb .body
1ACA: 9E 10 6910 | .body ldx forth__here
1ACC: CC 1ADF 6911 | ldd #.runtime_xt
1ACF: ED 81 6912 | std ,x++
1AD1: 37 06 6913 | pulu d
1AD3: ED 81 6914 | std ,x++
1AD5: 37 06 6915 | pulu d
1AD7: ED 81 6916 | std ,x++
1AD9: 9F 10 6917 | stx forth__here
1ADB: AE A1 6918 | ldx ,y++ ; NEXT
1ADD: 6E 94 6919 | jmp [,x]
6920 |
1ADF: 1AE1 6921 | .runtime_xt fdb .runtime
1AE1: 33 5C 6922 | .runtime leau -4,u
1AE3: EC A1 6923 | ldd ,y++
1AE5: ED C4 6924 | std ,u
1AE7: EC A1 6925 | ldd ,y++
1AE9: ED 42 6926 | std 2,u
1AEB: AE A1 6927 | ldx ,y++
1AED: 6E 94 6928 | jmp [,x]
6929 |
6930 | ;**********************************************************************
6931 |
1AEF: 6932 | forth_double_two_variable ; ( "name" -- ) E ( -- a-addr )
1AEF: 1ABC 6933 | fdb forth_double_two_literal
1AF1: 0009 6934 | fdb .xt - .name
1AF3: 325641524941... 6935 | .name fcc "2VARIABLE"
1AFC: 0678 6936 | .xt fdb forth_core_colon.runtime
6937 | ;==========================================
6938 | ; : 2VARIABLE CREATE 0 , 0 ,
6939 | ;==========================================
1AFE: 09B2 6940 | fdb forth_core_create.xt
1B00: 0D84 6941 | fdb forth_core_literal.runtime_xt
1B02: 0000 6942 | fdb 0
1B04: 04F3 6943 | fdb forth_core_comma.xt
1B06: 0D84 6944 | fdb forth_core_literal.runtime_xt
1B08: 0000 6945 | fdb 0
1B0A: 04F3 6946 | fdb forth_core_comma.xt
1B0C: 0C1A 6947 | fdb forth_core_exit.xt
6948 |
6949 | ;**********************************************************************
6950 |
1B0E: 6951 | forth_double_d_plus ; ( d1|ud1 d2|ud2 -- d3|ud3 )
1B0E: 1AEF 6952 | fdb forth_double_two_variable
1B10: 0002 6953 | fdb .xt - .name
1B12: 442B 6954 | .name fcc "D+"
1B14: 1B16 6955 | .xt fdb .body
1B16: EC 42 6956 | .body ldd 2,u
1B18: E3 46 6957 | addd 6,u
1B1A: ED 46 6958 | std 6,u
1B1C: EC C4 6959 | ldd ,u
1B1E: E9 45 6960 | adcb 5,u
1B20: A9 44 6961 | adca 4,u
1B22: ED 44 6962 | std 4,u
1B24: 33 44 6963 | leau 4,u
1B26: AE A1 6964 | ldx ,y++
1B28: 6E 94 6965 | jmp [,x]
6966 |
6967 | ;**********************************************************************
6968 |
1B2A: 6969 | forth_double_d_minus ; ( d1|ud1 d2|ud2 -- d3|ud3 )
1B2A: 1B0E 6970 | fdb forth_double_d_plus
1B2C: 0002 6971 | fdb .xt - .name
1B2E: 442D 6972 | .name fcc "D-"
1B30: 1B32 6973 | .xt fdb .body
1B32: EC 46 6974 | .body ldd 6,u
1B34: A3 42 6975 | subd 2,u
1B36: ED 46 6976 | std 6,u
1B38: EC 44 6977 | ldd 4,u
1B3A: E2 41 6978 | sbcb 1,u
1B3C: A2 C4 6979 | sbca 0,u
1B3E: ED 44 6980 | std 4,u
1B40: 33 44 6981 | leau 4,u
1B42: AE A1 6982 | ldx ,y++
1B44: 6E 94 6983 | jmp [,x]
6984 |
6985 | ;**********************************************************************
6986 |
1B46: 6987 | forth_double_d_dot ; ( d -- )
1B46: 1B2A 6988 | fdb forth_double_d_minus
1B48: 0002 6989 | fdb .xt - .name
1B4A: 442E 6990 | .name fcc "D."
1B4C: 0678 6991 | .xt fdb forth_core_colon.runtime
6992 | ;==========================================
6993 | ; : D. DUP >R DABS <# [CHAR] . HOLD #S R> SIGN #> TYPE SPACE ;
6994 | ;==========================================
1B4E: 0A74 6995 | fdb forth_core_dupe.xt
1B50: 07BF 6996 | fdb forth_core_to_r.xt
1B52: 1C78 6997 | fdb forth_double_d_abs.xt
1B54: 06C7 6998 | fdb forth_core_less_number_sign.xt
1B56: 0D84 6999 | fdb forth_core_literal.runtime_xt
1B58: 002E 7000 | fdb '.'
1B5A: 0C99 7001 | fdb forth_core_hold.xt
1B5C: 03FA 7002 | fdb forth_core_number_sign_s.xt
1B5E: 0FAA 7003 | fdb forth_core_r_from.xt
1B60: 104D 7004 | fdb forth_core_sign.xt
1B62: 03E1 7005 | fdb forth_core_number_sign_greater.xt
1B64: 1124 7006 | fdb forth_core_type.xt
1B66: 10D0 7007 | fdb forth_core_space.xt
1B68: 0C1A 7008 | fdb forth_core_exit.xt
7009 |
7010 | ;--------------------------------------------
7011 |
7012 | .test "D."
7013 | .opt test prot rw,$6000,$6100
7014 | .opt test pokew forth__here , $6000
7015 | .opt test pokew forth__vector_putchar , .sysnul
EB77: CE EB86 7016 | ldu #.datastack
EB7A: 8E 1B4C 7017 | ldx #forth_double_d_dot.xt
EB7D: BD 0C04 7018 | jsr forth_core_execute.asm
7019 | .assert /u = .result , "U"
EB80: 39 7020 | rts
EB81: 39 7021 | .sysnul rts
7022 |
EB82: 0000 7023 | fdb 0
EB84: 0000 7024 | fdb 0
EB86: 1234 7025 | .datastack fdb $1234
EB88: 5678 7026 | fdb $5678
EB8A: 0000 7027 | .result fdb 0
7028 | .endtst
7029 |
7030 | ;**********************************************************************
7031 |
1B6A: 7032 | forth_double_d_dot_r ; ( d n -- )
1B6A: 1B46 7033 | fdb forth_double_d_dot
1B6C: 0003 7034 | fdb .xt - .name
1B6E: 442E52 7035 | .name fcc "D.R"
1B71: 0678 7036 | .xt fdb forth_core_colon.runtime
7037 | ;======================================================
7038 | ; : D.R
7039 | ; >R DUP >R DABS <# [CHAR] . HOLD #S R> SIGN #>
7040 | ; R> 2DUP < IF OVER - SPACES ELSE DROP THEN
7041 | ; TYPE SPACE ;
7042 | ;======================================================
1B73: 07BF 7043 | fdb forth_core_to_r.xt
1B75: 0A74 7044 | fdb forth_core_dupe.xt
1B77: 07BF 7045 | fdb forth_core_to_r.xt
1B79: 1C78 7046 | fdb forth_double_d_abs.xt
1B7B: 06C7 7047 | fdb forth_core_less_number_sign.xt
1B7D: 0D84 7048 | fdb forth_core_literal.runtime_xt
1B7F: 002E 7049 | fdb '.'
1B81: 0C99 7050 | fdb forth_core_hold.xt
1B83: 03FA 7051 | fdb forth_core_number_sign_s.xt
1B85: 0FAA 7052 | fdb forth_core_r_from.xt
1B87: 104D 7053 | fdb forth_core_sign.xt
1B89: 03E1 7054 | fdb forth_core_number_sign_greater.xt
7055 |
1B8B: 0FAA 7056 | fdb forth_core_r_from.xt
1B8D: 060D 7057 | fdb forth_core_two_dupe.xt
1B8F: 06AB 7058 | fdb forth_core_less_than.xt
1B91: 0CD1 7059 | fdb forth_core_if.runtime_xt
1B93: 1B9F 7060 | fdb .L1
1B95: 0EA4 7061 | fdb forth_core_over.xt
1B97: 0506 7062 | fdb forth_core_minus.xt
1B99: 10E2 7063 | fdb forth_core_spaces.xt
1B9B: 1430 7064 | fdb forth_core_ext_again.runtime_xt
1B9D: 1BA1 7065 | fdb .L2
1B9F: 0A65 7066 | .L1 fdb forth_core_drop.xt
1BA1: 1124 7067 | .L2 fdb forth_core_type.xt
1BA3: 10D0 7068 | fdb forth_core_space.xt
1BA5: 0C1A 7069 | fdb forth_core_exit.xt
7070 |
7071 | ;**********************************************************************
7072 |
1BA7: 7073 | forth_double_d_zero_less ; ( d -- flag )
1BA7: 1B6A 7074 | fdb forth_double_d_dot_r
1BA9: 0003 7075 | fdb .xt - .name
1BAB: 44303C 7076 | .name fcc "D0<"
1BAE: 1BB0 7077 | .xt fdb .body
1BB0: 6D C4 7078 | .body tst ,u
1BB2: 2B 04 7079 | bmi .yes
1BB4: 4F 7080 | clra
1BB5: 5F 7081 | clrb
1BB6: 20 03 7082 | bra .done
1BB8: CC FFFF 7083 | .yes ldd #-1
1BBB: 33 42 7084 | .done leau 2,u
1BBD: ED C4 7085 | std ,u
1BBF: AE A1 7086 | ldx ,y++
1BC1: 6E 94 7087 | jmp [,x]
7088 |
7089 | ;**********************************************************************
7090 |
1BC3: 7091 | forth_double_d_zero_equal ; ( d -- flag )
1BC3: 1BA7 7092 | fdb forth_double_d_zero_less
1BC5: 0003 7093 | fdb .xt - .name
1BC7: 44303D 7094 | .name fcc "D0="
1BCA: 1BCC 7095 | .xt fdb .body
1BCC: EC C1 7096 | .body ldd ,u++
1BCE: 26 09 7097 | bne .false
1BD0: EC C4 7098 | ldd ,u
1BD2: 26 05 7099 | bne .false
1BD4: CC FFFF 7100 | ldd #-1
1BD7: 20 02 7101 | bra .done
1BD9: 4F 7102 | .false clra
1BDA: 5F 7103 | clrb
1BDB: ED C4 7104 | .done std ,u
1BDD: AE A1 7105 | ldx ,y++
1BDF: 6E 94 7106 | jmp [,x]
7107 |
7108 | ;**********************************************************************
7109 |
1BE1: 7110 | forth_double_d_two_star ; ( xd1 -- xd2 )
1BE1: 1BC3 7111 | fdb forth_double_d_zero_equal
1BE3: 0003 7112 | fdb .xt - .name
1BE5: 44322A 7113 | .name fcc "D2*"
1BE8: 1BEA 7114 | .xt fdb .body
1BEA: 68 43 7115 | .body lsl 3,u
1BEC: 69 42 7116 | rol 2,u
1BEE: 69 41 7117 | rol 1,u
1BF0: 69 C4 7118 | rol 0,u
1BF2: AE A1 7119 | ldx ,y++
1BF4: 6E 94 7120 | jmp [,x]
7121 |
7122 | ;**********************************************************************
7123 |
1BF6: 7124 | forth_double_d_two_slash ; ( xd1 -- xd2 )
1BF6: 1BE1 7125 | fdb forth_double_d_two_star
1BF8: 0003 7126 | fdb .xt - .name
1BFA: 44322F 7127 | .name fcc "D2/"
1BFD: 1BFF 7128 | .xt fdb .body
1BFF: 67 C4 7129 | .body asr 0,u
1C01: 66 41 7130 | ror 1,u
1C03: 66 42 7131 | ror 2,u
1C05: 66 43 7132 | ror 3,u
1C07: AE A1 7133 | ldx ,y++
1C09: 6E 94 7134 | jmp [,x]
7135 |
7136 | ;**********************************************************************
7137 |
1C0B: 7138 | forth_double_d_less_than ; ( d1 d2 -- flag )
1C0B: 1BF6 7139 | fdb forth_double_d_two_slash
1C0D: 0002 7140 | fdb .xt - .name
1C0F: 443C 7141 | .name fcc "D<"
1C11: 1C13 7142 | .xt fdb .body
1C13: E6 44 7143 | .body ldb 4,u ; get MSB of d1
1C15: 1D 7144 | sex ; sign extend
1C16: 34 02 7145 | pshs a ; save even more MSB
1C18: E6 C4 7146 | ldb ,u ; get MSB of d2
1C1A: 1D 7147 | sex ; sign extend
1C1B: 34 02 7148 | pshs a ; save even more MSB
1C1D: EC 46 7149 | .compare ldd 6,u ; do 32-bit subtraction
1C1F: A3 42 7150 | subd 2,u
1C21: EC 44 7151 | ldd 4,u
1C23: E2 41 7152 | sbcb 1,u
1C25: A2 C4 7153 | sbca 0,u
1C27: A6 61 7154 | lda 1,s
1C29: A2 E4 7155 | sbca ,s ; and extend to extension
1C2B: 33 46 7156 | leau 6,u ; clean up parameter stack
1C2D: 32 62 7157 | leas 2,s
1C2F: 2B 08 7158 | bmi .true ; if negative, less than
1C31: 4F 7159 | clra
1C32: 5F 7160 | clrb
1C33: ED C4 7161 | .done std ,u
1C35: AE A1 7162 | ldx ,y++
1C37: 6E 94 7163 | jmp [,x]
1C39: CC FFFF 7164 | .true ldd #-1
1C3C: 20 F5 7165 | bra .done
7166 |
7167 | ;**********************************************************************
7168 |
1C3E: 7169 | forth_double_d_equals ; ( xd1 xd2 -- flag )
1C3E: 1C0B 7170 | fdb forth_double_d_less_than
1C40: 0002 7171 | fdb .xt - .name
1C42: 443D 7172 | .name fcc "D="
1C44: 1C46 7173 | .xt fdb .body
1C46: EC C4 7174 | .body ldd ,u
1C48: 10A3 44 7175 | cmpd 4,u
1C4B: 26 12 7176 | bne .notequal
1C4D: EC 42 7177 | ldd 2,u
1C4F: 10A3 46 7178 | cmpd 6,u
1C52: 26 0B 7179 | bne .notequal
1C54: CC FFFF 7180 | ldd #-1
1C57: 33 46 7181 | .done leau 6,u
1C59: ED C4 7182 | std ,u
1C5B: AE A1 7183 | ldx ,y++
1C5D: 6E 94 7184 | jmp [,x]
1C5F: 4F 7185 | .notequal clra
1C60: 5F 7186 | clrb
1C61: 20 F4 7187 | bra .done
7188 |
7189 | ;**********************************************************************
7190 |
1C63: 7191 | forth_double_d_to_s ; ( d -- n )
1C63: 1C3E 7192 | fdb forth_double_d_equals
1C65: 0003 7193 | fdb .xt - .name
1C67: 443E53 7194 | .name fcc "D>S"
1C6A: 0678 7195 | .xt fdb forth_core_colon.runtime
7196 | ;=========================================
7197 | ; : D>S DROP ;
7198 | ;=========================================
1C6C: 0A65 7199 | fdb forth_core_drop.xt
1C6E: 0C1A 7200 | fdb forth_core_exit.xt
7201 |
7202 | ;**********************************************************************
7203 |
1C70: 7204 | forth_double_d_abs ; ( d -- ud )
1C70: 1C63 7205 | fdb forth_double_d_to_s
1C72: 0004 7206 | fdb .xt - .name
1C74: 44414253 7207 | .name fcc "DABS"
1C78: 0678 7208 | .xt fdb forth_core_colon.runtime
7209 | ;===========================================
7210 | ; : DABS 2DUP D0< IF DNEGATE THEN ;
7211 | ;===========================================
1C7A: 060D 7212 | fdb forth_core_two_dupe.xt
1C7C: 1BAE 7213 | fdb forth_double_d_zero_less.xt
1C7E: 0CD1 7214 | fdb forth_core_if.runtime_xt
1C80: 1C84 7215 | fdb .L1
1C82: 1CD5 7216 | fdb forth_double_d_negate.xt
1C84: 0C1A 7217 | .L1 fdb forth_core_exit.xt
7218 |
7219 | ;-----------------------------------------
7220 |
7221 | .test "DABS -1"
EB8C: CE EB9A 7222 | ldu #.datastack1
EB8F: 8E 1C78 7223 | ldx #forth_double_d_abs.xt
EB92: BD 0C04 7224 | jsr forth_core_execute.asm
7225 | .assert /u = .datastack1
7226 | .assert @@/0,u = 0
7227 | .assert @@/2,u = 1
EB95: 39 7228 | rts
7229 |
EB96: 0000 7230 | fdb 0
EB98: 0000 7231 | fdb 0
EB9A: FFFF 7232 | .datastack1 fdb $FFFF
EB9C: FFFF 7233 | fdb $FFFF
7234 | .endtst
7235 |
7236 | ;**********************************************************************
7237 |
1C86: 7238 | forth_double_d_max ; ( d1 d2 -- d3 )
1C86: 1C70 7239 | fdb forth_double_d_abs
1C88: 0004 7240 | fdb .xt - .name
1C8A: 444D4158 7241 | .name fcc "DMAX"
1C8E: 0678 7242 | .xt fdb forth_core_colon.runtime
7243 | ;==============================================
7244 | ; : DMAX 2OVER 2OVER D< IF
7245 | ; 2>R 2DROP 2R>
7246 | ; ELSE
7247 | ; 2DROP
7248 | ; THEN ;
7249 | ;==============================================
1C90: 061E 7250 | fdb forth_core_two_over.xt
1C92: 061E 7251 | fdb forth_core_two_over.xt
1C94: 1C11 7252 | fdb forth_double_d_less_than.xt
1C96: 0CD1 7253 | fdb forth_core_if.runtime_xt
1C98: 1CA4 7254 | fdb .L1
1C9A: 1334 7255 | fdb forth_core_ext_two_to_r.xt
1C9C: 05FD 7256 | fdb forth_core_two_drop.xt
1C9E: 1345 7257 | fdb forth_core_ext_two_r_from.xt
1CA0: 1430 7258 | fdb forth_core_ext_again.runtime_xt
1CA2: 1CA6 7259 | fdb .L2
1CA4: 05FD 7260 | .L1 fdb forth_core_two_drop.xt
1CA6: 0C1A 7261 | .L2 fdb forth_core_exit.xt
7262 |
7263 | ;**********************************************************************
7264 |
1CA8: 7265 | forth_double_d_min ; ( d1 d2 -- d3 )
1CA8: 1C86 7266 | fdb forth_double_d_max
1CAA: 0004 7267 | fdb .xt - .name
1CAC: 444D494E 7268 | .name fcc "DMIN"
1CB0: 0678 7269 | .xt fdb forth_core_colon.runtime
7270 | ;============================================
7271 | ; : DMIN 2OVER 2OVER D< IF
7272 | ; 2DROP
7273 | ; ELSE
7274 | ; 2>R 2DROP 2R>
7275 | ; THEN ;
7276 | ;============================================
1CB2: 061E 7277 | fdb forth_core_two_over.xt
1CB4: 061E 7278 | fdb forth_core_two_over.xt
1CB6: 1C11 7279 | fdb forth_double_d_less_than.xt
1CB8: 0CD1 7280 | fdb forth_core_if.runtime_xt
1CBA: 1CC2 7281 | fdb .L1
1CBC: 05FD 7282 | fdb forth_core_two_drop.xt
1CBE: 1430 7283 | fdb forth_core_ext_again.runtime_xt
1CC0: 1CC8 7284 | fdb .L2
1CC2: 1334 7285 | .L1 fdb forth_core_ext_two_to_r.xt
1CC4: 05FD 7286 | fdb forth_core_two_drop.xt
1CC6: 1345 7287 | fdb forth_core_ext_two_r_from.xt
1CC8: 0C1A 7288 | .L2 fdb forth_core_exit.xt
7289 |
7290 | ;**********************************************************************
7291 |
1CCA: 7292 | forth_double_d_negate ; ( d1 -- d2 )
1CCA: 1CA8 7293 | fdb forth_double_d_min
1CCC: 0007 7294 | fdb .xt - .name
1CCE: 444E45474154... 7295 | .name fcc "DNEGATE"
1CD5: 1CD7 7296 | .xt fdb .body
1CD7: 1F 31 7297 | .body tfr u,x
1CD9: 17 E38E 7298 | lbsr forth__math_neg32
1CDC: AE A1 7299 | ldx ,y++
1CDE: 6E 94 7300 | jmp [,x]
7301 |
7302 | ;-----------------------------------------
7303 |
7304 | .test "DNEGATE negative"
EB9E: CE EBAA 7305 | ldu #.datastack
EBA1: 8E 1CD5 7306 | ldx #forth_double_d_negate.xt
EBA4: BD 0C04 7307 | jsr forth_core_execute.asm
7308 | .assert /u = .datastack , "U"
7309 | .assert @@/0,u = 0 , "MSW"
7310 | .assert @@/2,u = 1 , "LWS"
EBA7: 39 7311 | rts
7312 |
EBA8: 0000 7313 | fdb 0
EBAA: FFFF 7314 | .datastack fdb $FFFF
EBAC: FFFF 7315 | fdb $FFFF
7316 | .endtst
7317 |
7318 | ;-----------------------------------------
7319 |
7320 | .test "DNEGATE positive"
EBAE: CE EBBA 7321 | ldu #.datastack1
EBB1: 8E 1CD5 7322 | ldx #forth_double_d_negate.xt
EBB4: BD 0C04 7323 | jsr forth_core_execute.asm
7324 | .assert /u = .datastack1 , "U"
7325 | .assert @@/0,u = $FFFF , "MSW"
7326 | .assert @@/2,u = $FFFF , "LWS"
EBB7: 39 7327 | rts
7328 |
EBB8: 0000 7329 | fdb 0
EBBA: 0000 7330 | .datastack1 fdb 0
EBBC: 0001 7331 | fdb 1
7332 | .endtst
7333 |
7334 | ;**********************************************************************
7335 |
7336 | Pd set 7 ; U
7337 | Pc set 6
7338 | Pb set 5
7339 | Pa set 4
7340 | Pf set 3
7341 | Pe set 2
7342 | Pn2 set 0
7343 |
7344 | Lsign set 11 ; S
7345 | Lbits set 10
7346 | Ldf set 8
7347 | Lcf set 7
7348 | Lbf set 6
7349 | Laf set 5
7350 | Lde set 7
7351 | Lce set 6
7352 | Lbe set 5
7353 | Lae set 4
7354 | Lquo3 set 3
7355 | Lquo2 set 2
7356 | Lquo1 set 1
7357 | Lquo0 set 0
7358 |
1CE0: 7359 | forth_double_m_star_slash ; ( d1 n1 +n2 -- d2 )
1CE0: 1CCA 7360 | fdb forth_double_d_negate
1CE2: 0003 7361 | fdb .xt - .name
1CE4: 4D2A2F 7362 | .name fcc "M*/"
1CE7: 1CE9 7363 | .xt fdb .body
1CE9: EC C4 7364 | .body ldd Pn2,u
1CEB: 1027 F3BC 7365 | lbeq forth_core_s_m_slash_rem.throw_div0
1CEF: CC 000C 7366 | ldd #12
1CF2: 6F E2 7367 | .clear clr ,-s
1CF4: 5A 7368 | decb
1CF5: 26 FB 7369 | bne .clear
1CF7: A6 42 7370 | lda Pe,u
1CF9: A8 44 7371 | eora Pa,u
1CFB: A7 6B 7372 | sta Lsign,s ; save resulting sign
1CFD: EC 42 7373 | ldd Pe,u
1CFF: 2A 06 7374 | bpl .n1_okay ; possibly negate inputs
1D01: 40 7375 | nega
1D02: 50 7376 | negb
1D03: 82 00 7377 | sbca #0
1D05: ED 42 7378 | std Pe,u
1D07: 6D 44 7379 | .n1_okay tst Pa,u
1D09: 2A 05 7380 | bpl .d1_okay
1D0B: 30 44 7381 | leax Pa,u
1D0D: 17 E35A 7382 | lbsr forth__math_neg32
7383 |
7384 | ;---------------------------------------------
7385 | ; do 16x32 bit multiply, giving 48 bit result
7386 | ;---------------------------------------------
7387 |
1D10: A6 43 7388 | .d1_okay lda Pf,u
1D12: E6 47 7389 | ldb Pd,u
1D14: 3D 7390 | mul
1D15: ED 68 7391 | std Ldf,s
1D17: A6 43 7392 | lda Pf,u
1D19: E6 46 7393 | ldb Pc,u
1D1B: 3D 7394 | mul
1D1C: E3 67 7395 | addd Lcf,s
1D1E: ED 67 7396 | std Lcf,s
1D20: E6 66 7397 | ldb Lbf,s ; propagate carry
1D22: C9 00 7398 | adcb #0
1D24: E7 66 7399 | stb Lbf,s
1D26: A6 42 7400 | lda Pe,u
1D28: E6 47 7401 | ldb Pd,u
1D2A: 3D 7402 | mul
1D2B: E3 67 7403 | addd Lde,s
1D2D: ED 67 7404 | std Lde,s
1D2F: E6 66 7405 | ldb Lbf,s ; everytime you see this
1D31: C9 00 7406 | adcb #0 ; we're propagating the carry
1D33: E7 66 7407 | stb Lbf,s
1D35: A6 43 7408 | lda Pf,u
1D37: E6 45 7409 | ldb Pb,u
1D39: 3D 7410 | mul
1D3A: E3 66 7411 | addd Lbf,s
1D3C: ED 66 7412 | std Lbf,s
1D3E: E6 65 7413 | ldb Laf,s
1D40: C9 00 7414 | adcb #0
1D42: E7 65 7415 | stb Laf,s
1D44: A6 42 7416 | lda Pe,u
1D46: E6 46 7417 | ldb Pc,u
1D48: 3D 7418 | mul
1D49: E3 66 7419 | addd Lce,s
1D4B: ED 66 7420 | std Lce,s
1D4D: E6 65 7421 | ldb Lbe,s
1D4F: C9 00 7422 | adcb #0
1D51: E7 65 7423 | stb Lbe,s
1D53: A6 43 7424 | lda Pf,u
1D55: E6 44 7425 | ldb Pa,u
1D57: 3D 7426 | mul
1D58: E3 65 7427 | addd Laf,s
1D5A: ED 65 7428 | std Laf,s
1D5C: E6 64 7429 | ldb Lae,s
1D5E: C9 00 7430 | adcb #0
1D60: E7 64 7431 | stb Lae,s
1D62: A6 42 7432 | lda Pe,u
1D64: E6 45 7433 | ldb Pb,u
1D66: 3D 7434 | mul
1D67: E3 65 7435 | addd Lbe,s
1D69: ED 65 7436 | std Lbe,s
1D6B: E6 64 7437 | ldb Lae,s
1D6D: C9 00 7438 | adcb #0
1D6F: E7 64 7439 | stb Lae,s
1D71: A6 42 7440 | lda Pe,u
1D73: E6 44 7441 | ldb Pa,u
1D75: 3D 7442 | mul
1D76: E3 64 7443 | addd Lae,s
1D78: ED 64 7444 | std Lae,s
7445 |
7446 | ;-------------------------------------
7447 | ; now do 48x16 divide
7448 | ;-------------------------------------
7449 |
1D7A: 86 30 7450 | lda #48
1D7C: A7 6A 7451 | sta Lbits,s
1D7E: 4F 7452 | clra
1D7F: 5F 7453 | clrb
1D80: 68 69 7454 | .10 lsl 9,s
1D82: 69 68 7455 | rol 8,s
1D84: 69 67 7456 | rol 7,s
1D86: 69 66 7457 | rol 6,s
1D88: 69 65 7458 | rol 5,s
1D8A: 69 64 7459 | rol 4,s
1D8C: 59 7460 | rolb
1D8D: 49 7461 | rola
1D8E: 10A3 C4 7462 | cmpd Pn2,u
1D91: 25 06 7463 | blo .20
1D93: A3 C4 7464 | subd Pn2,u
1D95: 1A 01 7465 | orcc {c}
1D97: 20 02 7466 | bra .30
1D99: 1C FE 7467 | .20 andcc {c}
1D9B: 69 63 7468 | .30 rol Lquo3,s
1D9D: 69 62 7469 | rol Lquo2,s
1D9F: 69 61 7470 | rol Lquo1,s
1DA1: 69 E4 7471 | rol Lquo0,s
1DA3: 6A 6A 7472 | dec Lbits,s
1DA5: 26 D9 7473 | bne .10
1DA7: 33 48 7474 | leau 8,u
1DA9: 35 16 7475 | puls x,d ; push result
1DAB: 36 16 7476 | pshu x,d
1DAD: 6D 67 7477 | tst 7,s ; negate result?
1DAF: 2A 05 7478 | bpl .40
1DB1: 1F 31 7479 | tfr u,x
1DB3: 17 E2B4 7480 | lbsr forth__math_neg32
1DB6: 32 68 7481 | .40 leas 8,s
1DB8: AE A1 7482 | ldx ,y++
1DBA: 6E 94 7483 | jmp [,x]
7484 |
7485 | ;----------------------------------------------
7486 |
7487 | .test "M*/ positive positive"
EBBE: CE EBD2 7488 | ldu #.datastack1
EBC1: 8E 1CE7 7489 | ldx #forth_double_m_star_slash.xt
EBC4: BD 0C04 7490 | jsr forth_core_execute.asm
7491 | .assert /u = .result1 , "U"
7492 | .assert @@/0,u = $17CE , "MSW"
7493 | .assert @@/2,u = $49B0 , "LSW"
EBC7: 39 7494 | rts
7495 |
EBC8: 0000 7496 | fdb 0
EBCA: 0000 7497 | fdb 0
EBCC: 0000 7498 | fdb 0
EBCE: 0000 7499 | fdb 0
EBD0: 0000 7500 | fdb 0
EBD2: 000D 7501 | .datastack1 fdb 13
EBD4: 0011 7502 | fdb 17
EBD6: 1234 7503 | .result1 fdb $1234
EBD8: 5678 7504 | fdb $5678
7505 | .endtst
7506 |
7507 | ;**********************************************************************
7508 |
1DBC: 7509 | forth_double_m_plus ; ( d1|ud1 n -- d1|ud2 )
1DBC: 1CE0 7510 | fdb forth_double_m_star_slash
1DBE: 0002 7511 | fdb .xt - .name
1DC0: 4D2B 7512 | .name fcc "M+"
1DC2: 1DC4 7513 | .xt fdb .body
1DC4: 6D C4 7514 | .body tst ,u
1DC6: 2A 05 7515 | bpl .positive
1DC8: CC FFFF 7516 | ldd #-1
1DCB: 20 02 7517 | bra .save
1DCD: 4F 7518 | .positive clra
1DCE: 5F 7519 | clrb
1DCF: 36 06 7520 | .save pshu d
1DD1: EC 42 7521 | ldd 2,u
1DD3: E3 46 7522 | addd 6,u
1DD5: ED 46 7523 | std 6,u
1DD7: EC C4 7524 | ldd ,u
1DD9: E9 45 7525 | adcb 5,u
1DDB: A9 44 7526 | adca 4,u
1DDD: ED 44 7527 | std 4,u
1DDF: 33 44 7528 | leau 4,u
1DE1: AE A1 7529 | ldx ,y++
1DE3: 6E 94 7530 | jmp [,x]
7531 |
7532 | ;**********************************************************************
7533 | ; DOUBLE-EXT
7534 | ;**********************************************************************
7535 |
1DE5: 7536 | forth_double_ext_two_rote ; ( x1 x2 x3 x4 x5 x6 -- x3 x4 x5 x6 x1 x2 )
1DE5: 1DBC 7537 | fdb forth_double_m_plus
1DE7: 0004 7538 | fdb .xt - .name
1DE9: 32524F54 7539 | .name fcc "2ROT"
1DED: 0678 7540 | .xt fdb forth_core_colon.runtime
7541 | ;====================================
7542 | ; : 2ROLL 5 ROLL 5 ROLL ;
7543 | ;====================================
1DEF: 0D84 7544 | fdb forth_core_literal.runtime_xt
1DF1: 0005 7545 | fdb 5
1DF3: 17AF 7546 | fdb forth_core_ext_roll.xt
1DF5: 0D84 7547 | fdb forth_core_literal.runtime_xt
1DF7: 0005 7548 | fdb 5
1DF9: 17AF 7549 | fdb forth_core_ext_roll.xt
1DFB: 0C1A 7550 | fdb forth_core_exit.xt
7551 |
7552 | ;**********************************************************************
7553 |
1DFD: 7554 | forth_double_ext_two_value ; ( x1 x2 "naem" -- ) E ( -- x1 x2 )
1DFD: 1DE5 7555 | fdb forth_double_ext_two_rote
1DFF: 8006 7556 | fdb _IMMED :: .xt - .name
1E01: 3256414C5545 7557 | .name fcc "2VALUE"
1E07: 1E09 7558 | .xt fdb .body
1E09: 8E 09B2 7559 | .body ldx #forth_core_create.xt
1E0C: 17 EDF5 7560 | lbsr forth_core_execute.asm
1E0F: A6 9F0026 7561 | lda [forth__create_name] ; mark as DOUBLE
1E13: 8A 10 7562 | ora #_DOUBLE ; for TO
1E15: A7 9F0026 7563 | sta [forth__create_name]
1E19: 9E 28 7564 | ldx forth__create_xt
1E1B: CC 1E2E 7565 | ldd #.runtime
1E1E: ED 81 7566 | std ,x++
1E20: 37 06 7567 | pulu d
1E22: ED 81 7568 | std ,x++
1E24: 37 06 7569 | pulu d
1E26: ED 81 7570 | std ,x++
1E28: 9F 10 7571 | stx forth__here
1E2A: AE A1 7572 | ldx ,y++
1E2C: 6E 94 7573 | jmp [,x]
7574 |
1E2E: EC 04 7575 | .runtime ldd 4,x
1E30: 36 06 7576 | pshu d
1E32: EC 02 7577 | ldd 2,x
1E34: 36 06 7578 | pshu d
1E36: AE A1 7579 | ldx ,y++
1E38: 6E 94 7580 | jmp [,x]
7581 |
7582 | ;**********************************************************************
7583 |
1E3A: 7584 | forth_double_ext_d_u_less ; ( ud1 ud2 -- flag )
1E3A: 1DFD 7585 | fdb forth_double_ext_two_value
1E3C: 0003 7586 | fdb .xt - .name
1E3E: 44553C 7587 | .name fcc "DU<"
1E41: 1E43 7588 | .xt fdb .body
1E43: 6F E2 7589 | .body clr ,-s ; Zero extend parameters
1E45: 6F E2 7590 | clr ,-s
1E47: 16 FDD3 7591 | lbra forth_double_d_less_than.compare
7592 |
7593 | ;**********************************************************************
7594 | ; EXCEPTION
7595 | ;based on https://forth-standard.org/standard/exception/CATCH
7596 | ; https://forth-standard.org/standard/exception/THROW
7597 | ;**********************************************************************
7598 |
1E4A: 7599 | forth_exception_catch ; ( i*x xt -- j*x 0 | i*x n )
1E4A: 1E3A 7600 | fdb forth_double_ext_d_u_less
1E4C: 0005 7601 | fdb .xt - .name
1E4E: 4341544348 7602 | .name fcc "CATCH"
1E53: 1E55 7603 | .xt fdb .body
1E55: DC 20 7604 | .body ldd forth__source ; save input info
1E57: 34 06 7605 | pshs d
1E59: DC 22 7606 | ldd forth__source_len
1E5B: 34 06 7607 | pshs d
1E5D: DC 1A 7608 | ldd forth__in
1E5F: 34 06 7609 | pshs d
1E61: DC 1E 7610 | ldd forth__source_id
1E63: 34 06 7611 | pshs d
1E65: DC 40 7612 | ldd forth__handler ; get previous handler
1E67: 34 66 7613 | pshs u,y,d ; save IP, data stack and previous handler
1E69: 10DF 40 7614 | sts forth__handler ; save return stack pointer
1E6C: 37 10 7615 | pulu x ; pull xt
1E6E: 17 ED93 7616 | lbsr forth_core_execute.asm ; EXECUTE
1E71: 35 26 7617 | puls y,d ; remove exception frame (ignore previous data stack pointer)
1E73: 35 10 7618 | puls x ; remove data stack pointer (saved version not needed)
1E75: 32 68 7619 | leas 8,s ; remove saved source info
1E77: DD 40 7620 | std forth__handler ; save previous handler
1E79: 6F C2 7621 | clr ,-u ; return 0
1E7B: 6F C2 7622 | clr ,-u
1E7D: AE A1 7623 | ldx ,y++ ; NEXT
1E7F: 6E 94 7624 | jmp [,x]
7625 |
7626 | ;**********************************************************************
7627 | ;
1E81: 7628 | forth_exception_throw ; ( k*x n -- k*x | i*x n )
1E81: 1E4A 7629 | fdb forth_exception_catch
1E83: 0005 7630 | fdb .xt - .name
1E85: 5448524F57 7631 | .name fcc "THROW"
1E8A: 1E8C 7632 | .xt fdb .body
1E8C: EC C4 7633 | .body ldd ,u
1E8E: 27 23 7634 | beq .nothrow
1E90: 10DE 40 7635 | lds forth__handler
1E93: 27 24 7636 | beq .panic ; if no handler set, panic
1E95: 35 06 7637 | puls d ; get previous handler
1E97: DD 40 7638 | std forth__handler ; restore
1E99: 37 06 7639 | pulu d ; save exception #
1E9B: 35 60 7640 | puls y,u ; pull IP and data stack
1E9D: ED C4 7641 | std ,u ; replace xt with exceptin #
1E9F: 35 06 7642 | puls d ; restore input info
1EA1: DD 1E 7643 | std forth__source_id
1EA3: 35 06 7644 | puls d
1EA5: DD 1A 7645 | std forth__in
1EA7: 35 06 7646 | puls d
1EA9: DD 22 7647 | std forth__source_len
1EAB: 35 06 7648 | puls d
1EAD: DD 20 7649 | std forth__source
1EAF: AE A1 7650 | ldx ,y++
1EB1: 6E 94 7651 | jmp [,x]
1EB3: 33 42 7652 | .nothrow leau 2,u ; remove 0
1EB5: AE A1 7653 | ldx ,y++ ; NEXT
1EB7: 6E 94 7654 | jmp [,x]
1EB9: 3F 7655 | .panic swi
7656 |
7657 | ;************************************************
7658 | ; forth_exception_throw.asm Allow assembly code to throw excption
7659 | ;Entry: D - exception #
7660 | ;Exit: none
7661 | ;************************************************
7662 |
1EBA: 36 06 7663 | .asm pshu d
1EBC: 8E 1E8A 7664 | ldx #forth_exception_throw.xt
1EBF: 7E 0C04 7665 | jmp forth_core_execute.asm
7666 |
7667 | ;----------------------------------------
7668 |
7669 | .test "CATCH ... THROW"
7670 | .opt test pokew forth__vector_putchar , .putchar
EBDA: CE EBF2 7671 | ldu #.datastack
EBDD: 8E EC18 7672 | ldx #.baz_xt
EBE0: BD 0C04 7673 | jsr forth_core_execute.asm
7674 | .assert /u = .results , "U"
7675 | .assert @@/,u = -5000 , "0,U"
7676 | .assert .outputbuf = "error" , "msg"
EBE3: 39 7677 | rts
7678 |
EBE4: FFF8 7679 | fdb -8
EBE6: FFFA 7680 | fdb -6
EBE8: FFFB 7681 | fdb -5
EBEA: FFFC 7682 | fdb -4
EBEC: FFFD 7683 | fdb -3
EBEE: FFFE 7684 | fdb -2
EBF0: FFFF 7685 | .results fdb -1
EBF2: 0000 7686 | .datastack fdb 0
7687 |
EBF4: 0678 7688 | .foo_xt fdb forth_core_colon.runtime
EBF6: 0D84 7689 | fdb forth_core_literal.runtime_xt
EBF8: 0004 7690 | fdb 4
EBFA: 0D84 7691 | fdb forth_core_literal.runtime_xt
EBFC: 0005 7692 | fdb 5
EBFE: 0D84 7693 | fdb forth_core_literal.runtime_xt
EC00: EC78 7694 | fdb -5000
EC02: 1E8A 7695 | fdb forth_exception_throw.xt
EC04: 0C1A 7696 | fdb forth_core_exit.xt
7697 |
EC06: 0678 7698 | .bar_xt fdb forth_core_colon.runtime
EC08: 0D84 7699 | fdb forth_core_literal.runtime_xt
EC0A: 0001 7700 | fdb 1
EC0C: 0D84 7701 | fdb forth_core_literal.runtime_xt
EC0E: 0002 7702 | fdb 2
EC10: 0D84 7703 | fdb forth_core_literal.runtime_xt
EC12: 0003 7704 | fdb 3
EC14: EBF4 7705 | fdb .foo_xt
EC16: 0C1A 7706 | fdb forth_core_exit.xt
7707 |
EC18: 0678 7708 | .baz_xt fdb forth_core_colon.runtime
EC1A: 0D84 7709 | fdb forth_core_literal.runtime_xt
EC1C: EC06 7710 | fdb .bar_xt
EC1E: 1E53 7711 | fdb forth_exception_catch.xt
EC20: 0A74 7712 | fdb forth_core_dupe.xt
EC22: 0CD1 7713 | fdb forth_core_if.runtime_xt
EC24: EC35 7714 | fdb .L1
EC26: 2B7C 7715 | fdb forth_string_sliteral.runtime_xt
EC28: 0005 7716 | fdb .len1
EC2A: 6572726F72 7717 | .text1 fcc /error/
7718 | .len1 equ * - .text1
EC2F: 1124 7719 | fdb forth_core_type.xt
EC31: 1430 7720 | fdb forth_core_ext_again.runtime_xt
EC33: EC3F 7721 | fdb .L2
EC35: 2B7C 7722 | .L1 fdb forth_string_sliteral.runtime_xt
EC37: 0004 7723 | fdb .len2
EC39: 6F6B6179 7724 | .text2 fcc /okay/
7725 | .len2 equ * - .text2
EC3D: 1124 7726 | fdb forth_core_type.xt
EC3F: 0C1A 7727 | .L2 fdb forth_core_exit.xt
7728 |
EC41: 34 10 7729 | .putchar pshs x
EC43: BE EC4D 7730 | ldx .output
EC46: E7 80 7731 | stb ,x+
EC48: BF EC4D 7732 | stx .output
EC4B: 35 90 7733 | puls x,pc
EC4D: EC4F 7734 | .output fdb .outputbuf
EC4F: 7735 | .outputbuf rmb 6
7736 |
7737 | .endtst
7738 |
7739 | ;**********************************************************************
7740 | ; EXCEPTION-EXT
7741 | ;**********************************************************************
7742 |
1EC2: 7743 | forth_exception_ext_abort ; ( i*x -- ) ( R: j*x -- )
1EC2: 1E81 7744 | fdb forth_exception_throw
1EC4: 0005 7745 | fdb .xt - .name
1EC6: 41424F5254 7746 | .name fcc "ABORT"
1ECB: 0678 7747 | .xt fdb forth_core_colon.runtime
7748 | ;===========================================
7749 | ; : ABORT -1 THROW ;
7750 | ;===========================================
1ECD: 0D84 7751 | fdb forth_core_literal.runtime_xt
1ECF: FFFF 7752 | fdb -1
1ED1: 1E8A 7753 | fdb forth_exception_throw.xt
1ED3: 0C1A 7754 | fdb forth_core_exit.xt
7755 |
7756 | ;**********************************************************************
7757 |
1ED5: 7758 | forth_exception_ext_abort_quote ; C ( "ccc" -- ) R ( i*x x1 -- | i*x ) ( R: j*x -- | j*x )
1ED5: 1EC2 7759 | fdb forth_exception_ext_abort
1ED7: A006 7760 | fdb _IMMED | _NOINTERP :: .xt - .name
1ED9: 41424F525422 7761 | .name fcc 'ABORT"'
1EDF: 0678 7762 | .xt fdb forth_core_colon.runtime
7763 | ;====================================================
7764 | ; : ABORT"
7765 | ; POSTPONE IF
7766 | ; POSTPONE S" POSTPONE save_abort_msg
7767 | ; -2 POSTPONE LITERAL POSTPONE THROW
7768 | ; POSTPONE THEN ; IMMEDIATE
7769 | ;====================================================
1EE1: 0CBC 7770 | fdb forth_core_if.xt
1EE3: 102A 7771 | fdb forth_core_s_quote.xt
1EE5: 0D84 7772 | fdb forth_core_literal.runtime_xt
1EE7: 1EFB 7773 | fdb .save_abort_msg_xt
1EE9: 14AC 7774 | fdb forth_core_ext_compile_comma.xt
1EEB: 0D84 7775 | fdb forth_core_literal.runtime_xt
1EED: FFFE 7776 | fdb -2
1EEF: 0D71 7777 | fdb forth_core_literal.xt
1EF1: 0D84 7778 | fdb forth_core_literal.runtime_xt
1EF3: 1E8A 7779 | fdb forth_exception_throw.xt
1EF5: 14AC 7780 | fdb forth_core_ext_compile_comma.xt
1EF7: 1110 7781 | fdb forth_core_then.xt
1EF9: 0C1A 7782 | fdb forth_core_exit.xt
7783 |
1EFB: 7784 | .save_abort_msg_xt
1EFB: 1EFD 7785 | fdb .save_abort_msg_body
1EFD: 7786 | .save_abort_msg_body
1EFD: 37 16 7787 | pulu x,d
1EFF: 9F 42 7788 | stx forth__abortq
1F01: DD 44 7789 | std forth__abortql
1F03: AE A1 7790 | ldx ,y++
1F05: 6E 94 7791 | jmp [,x]
7792 |
7793 | ;**********************************************************************
7794 | ; LOCAL
7795 | ;
7796 | ; Follow 13.3.3.1
7797 | ; Can create locals after : :NONAME DOES>
7798 | ; Create temporary dictionary unil ; ;CODE DOES>
7799 | ; release resources
7800 | ; release resources after ; ;CODE DOES> EXIT ABORT THROW
7801 | ;
7802 | ; Local FP on return stack: ( a-addr u locals... )
7803 | ; forth__local_fp pointer to locals on return stack
7804 | ; forth__local_fps size of locals on return stack
7805 | ;**********************************************************************
7806 |
1F07: 7807 | forth__local_cleanup
1F07: 4F 7808 | clra
1F08: 5F 7809 | clrb
1F09: DD 38 7810 | std forth__local_wid
1F0B: 9E 10 7811 | ldx forth__here
1F0D: CC 205D 7812 | ldd #forth__local_leave
1F10: ED 81 7813 | std ,x++
1F12: 9F 10 7814 | stx forth__here
1F14: 39 7815 | rts
7816 |
1F15: 7817 | forth__local_semicolon
1F15: 0000 7818 | fdb 0
1F17: A001 7819 | fdb _IMMED | _NOINTERP :: .xt - .name
1F19: 3B 7820 | .name fcc ";"
1F1A: 1F1C 7821 | .xt fdb .body
1F1C: 8D E9 7822 | .body bsr forth__local_cleanup
1F1E: 16 E766 7823 | lbra forth_core_semicolon.body
7824 |
1F21: 7825 | forth__local_does
1F21: 1F15 7826 | fdb forth__local_semicolon
1F23: A005 7827 | fdb _IMMED | _NOINTERP :: .xt - .name
1F25: 444F45533E 7828 | .name fcc 'DOES>'
1F2A: 1F2C 7829 | .xt fdb .body
1F2C: 8D D9 7830 | .body bsr forth__local_cleanup
1F2E: 16 EB09 7831 | lbra forth_core_does.body
7832 |
1F31: 7833 | forth__local_exit
1F31: 1F21 7834 | fdb forth__local_does
1F33: 2004 7835 | fdb _NOINTERP :: .xt - .name
1F35: 45584954 7836 | .name fcc 'EXIT'
1F39: 1F3B 7837 | .xt fdb .body
1F3B: 8D CA 7838 | .body bsr forth__local_cleanup
1F3D: 16 ECDC 7839 | lbra forth_core_exit.body
7840 |
1F40: 7841 | forth__local_abort
1F40: 1F31 7842 | fdb forth__local_exit
1F42: 0005 7843 | fdb .xt - .name
1F44: 41424F5254 7844 | .name fcc 'ABORT'
1F49: 1F4B 7845 | .xt fdb .body
1F4B: 8D BA 7846 | .body bsr forth__local_cleanup
1F4D: 8E 1ECB 7847 | ldx #forth_exception_ext_abort.xt
1F50: 16 ECB1 7848 | lbra forth_core_execute.asm
7849 |
1F53: 7850 | forth__local_throw
1F53: 1F40 7851 | fdb forth__local_abort
1F55: 0005 7852 | fdb .xt - .name
1F57: 5448524F57 7853 | .name fcc 'THROW'
1F5C: 1F5E 7854 | .xt fdb .body
1F5E: 8D A7 7855 | .body bsr forth__local_cleanup
1F60: 16 FF29 7856 | lbra forth_exception_throw.body
7857 |
1F63: 7858 | forth_local_paren_local_paren ; ( c-addr u -- ) E ( -- x )
1F63: 1ED5 7859 | fdb forth_exception_ext_abort_quote
1F65: 2007 7860 | fdb _NOINTERP :: .xt - .name
1F67: 284C4F43414C... 7861 | .name fcc "(LOCAL)"
1F6E: 1F70 7862 | .xt fdb .body
1F70: DC 38 7863 | .body ldd forth__local_wid ; do we have a local wid?
1F72: 26 2E 7864 | bne .skip_init ; if so, skip this step
1F74: 4F 7865 | clra
1F75: 5F 7866 | clrb
1F76: DD 3A 7867 | std forth__local_e_cnt
7868 |
7869 | ;--------------------------------------------------------------------
7870 | ; Here we check to see if we have enough dictionary space to do a
7871 | ; local wordlist. Each word takes up 8 bytes + the word length, and
7872 | ; we only need to support up to NUMBER_LOCALS of entries, so we can
7873 | ; check that here. The local dictionary is allocted in a transitory
7874 | ; section, at the top of the HERE section, minus space for 16 locals
7875 | ; with a maximum length name. That should leave us enough space for
7876 | ; any FORTH word definition. I hope.
7877 | ;--------------------------------------------------------------------
7878 |
1F78: 9E 0E 7879 | ldx forth__here_top
1F7A: 30 89FD90 7880 | leax -(NUMBER_LOCALS * (2 + 2 + DEFINITION_MAX + 2 + 2)),x
1F7E: 9C 10 7881 | cmpx forth__here
1F80: 23 7A 7882 | bls .throw_bad_dict
1F82: DC 10 7883 | ldd forth__here
1F84: DD 3C 7884 | std forth__local_here
1F86: 9F 10 7885 | stx forth__here
1F88: DC 16 7886 | ldd forth__current_wid
1F8A: DD 36 7887 | std forth__local_current
1F8C: CC 1F53 7888 | ldd #forth__local_throw ; intialize local wid
1F8F: DD 38 7889 | std forth__local_wid
1F91: CC 0038 7890 | ldd #forth__local_wid
1F94: DD 16 7891 | std forth__current_wid
1F96: DC 24 7892 | ldd forth__create_link ; save info from last CREATE
1F98: DD 2C 7893 | std forth__local_link ; and save it
1F9A: DC 26 7894 | ldd forth__create_name
1F9C: DD 2E 7895 | std forth__local_name
1F9E: DC 28 7896 | ldd forth__create_xt
1FA0: DD 30 7897 | std forth__local_xt
1FA2: EC C4 7898 | .skip_init ldd ,u ; check for 0 length
1FA4: 26 04 7899 | bne .continue
1FA6: 33 44 7900 | leau 4,u
1FA8: 20 2D 7901 | bra .finish ; if so, this marks the end of locals
1FAA: 8E 0142 7902 | .continue ldx #forth__private_create_quote_xt
1FAD: 17 EC54 7903 | lbsr forth_core_execute.asm
1FB0: A6 9F0026 7904 | lda [forth__create_name]
1FB4: 8A 88 7905 | ora #_LOCAL | _IMMED
1FB6: A7 9F0026 7906 | sta [forth__create_name]
1FBA: 9E 28 7907 | ldx forth__create_xt
1FBC: CC 2008 7908 | ldd #.runtime ; initialize xt
1FBF: ED 81 7909 | std ,x++
1FC1: 4F 7910 | clra
1FC2: D6 3B 7911 | ldb forth__local_l_cnt ; save body (index into fp)
1FC4: 10B3 0BA5 7912 | cmpd forth__env_number_sign_locals.body
1FC8: 24 38 7913 | bhs .throw_setec ; too many secrets, uh, locals
1FCA: 58 7914 | lslb
1FCB: ED 81 7915 | std ,x++
1FCD: 0A 3A 7916 | dec forth__local_e_cnt
1FCF: 0C 3B 7917 | inc forth__local_l_cnt
1FD1: 9F 10 7918 | stx forth__here ; save compilation location
1FD3: AE A1 7919 | ldx ,y++ ; NEXT
1FD5: 6E 94 7920 | jmp [,x]
1FD7: DC 36 7921 | .finish ldd forth__local_current
1FD9: DD 16 7922 | std forth__current_wid
1FDB: 9E 3C 7923 | ldx forth__local_here
1FDD: 9F 10 7924 | stx forth__here
1FDF: CC 201D 7925 | ldd #forth__local_enter
1FE2: ED 81 7926 | std ,x++
1FE4: DC 3A 7927 | ldd forth__local_e_cnt
1FE6: 48 7928 | lsla
1FE7: 58 7929 | lslb
1FE8: ED 81 7930 | std ,x++
1FEA: 9F 10 7931 | stx forth__here
1FEC: DC 30 7932 | ldd forth__local_xt ; restore CREATE data
1FEE: DD 28 7933 | std forth__create_xt
1FF0: DC 2E 7934 | ldd forth__local_name
1FF2: DD 26 7935 | std forth__create_name
1FF4: DC 2C 7936 | ldd forth__local_link
1FF6: DD 24 7937 | std forth__create_link
1FF8: AE A1 7938 | ldx ,y++ ; NEXT
1FFA: 6E 94 7939 | jmp [,x]
1FFC: CC FFF8 7940 | .throw_bad_dict ldd #-8
1FFF: 16 FEB8 7941 | lbra forth_exception_throw.asm
2002: CC FF00 7942 | .throw_setec ldd #-256
2005: 16 FEB2 7943 | lbra forth_exception_throw.asm
7944 |
2008: EC 02 7945 | .runtime ldd 2,x
200A: 34 06 7946 | pshs d
200C: 9E 10 7947 | ldx forth__here
200E: CC 203F 7948 | ldd #forth__local_fetch
2011: ED 81 7949 | std ,x++
2013: 35 06 7950 | puls d
2015: ED 81 7951 | std ,x++
2017: 9F 10 7952 | stx forth__here
2019: AE A1 7953 | ldx ,y++
201B: 6E 94 7954 | jmp [,x]
7955 |
201D: 7956 | forth__local_enter
201D: 201F 7957 | fdb .body
201F: DC 32 7958 | .body ldd forth__local_fp ; save sprevious FP
2021: 34 06 7959 | pshs d
2023: DC 34 7960 | ldd forth__local_fps ; save size of previous FP
2025: 34 06 7961 | pshs d
2027: EC A1 7962 | ldd ,y++ ; get # bytes
2029: DD 34 7963 | std forth__local_fps
202B: 32 E6 7964 | leas a,s ; adjust stack downward
202D: 1F 41 7965 | tfr s,x
202F: 9F 32 7966 | stx forth__local_fp ; save new local frame pointer
2031: 5D 7967 | tstb
2032: 27 07 7968 | beq .done
2034: A6 C0 7969 | .copy lda ,u+ ; copy data
2036: A7 80 7970 | sta ,x+
2038: 5A 7971 | decb
2039: 26 F9 7972 | bne .copy
203B: AE A1 7973 | .done ldx ,y++ ; NEXT
203D: 6E 94 7974 | jmp [,x]
7975 |
203F: 7976 | forth__local_fetch
203F: 2041 7977 | fdb .body
2041: EC A1 7978 | .body ldd ,y++
2043: 9E 32 7979 | ldx forth__local_fp
2045: EC 8B 7980 | ldd d,x
2047: 36 06 7981 | pshu d
2049: AE A1 7982 | ldx ,y++
204B: 6E 94 7983 | jmp [,x]
7984 |
204D: 7985 | forth__local_store
204D: 204F 7986 | fdb .body
204F: EC A1 7987 | .body ldd ,y++
2051: 9E 32 7988 | ldx forth__local_fp
2053: 30 8B 7989 | leax d,x
2055: 37 06 7990 | pulu d
2057: ED 84 7991 | std ,x
2059: AE A1 7992 | ldx ,y++
205B: 6E 94 7993 | jmp [,x]
7994 |
205D: 7995 | forth__local_leave
205D: 205F 7996 | fdb .body
205F: DC 34 7997 | .body ldd forth__local_fps ; get size of FP
2061: 32 E5 7998 | leas b,s ; remove locals
2063: 35 06 7999 | puls d ; get old local frame pointer size
2065: DD 34 8000 | std forth__local_fps ; restore
2067: 35 06 8001 | puls d ; get old local frame pointer
2069: DD 32 8002 | std forth__local_fp ; restore
206B: AE A1 8003 | ldx ,y++ ; NEXT
206D: 6E 94 8004 | jmp [,x]
8005 |
8006 | ;------------------------------------------
8007 |
8008 | .test '(LOCAL)'
8009 | .opt test prot rw,$DB00 - 1024 , $DAFF
8010 | .opt test prot rw,$6000 , $6100
8011 | .opt test pokew forth__here_top , $DB00
8012 | .opt test pokew forth__local_wid , 0
8013 | .opt test pokew forth__here , $6000
8014 | .opt test pokew forth__current_wid , forth__forth_wid
EC55: CE ECC1 8015 | ldu #.datastack1
EC58: 8E 1F6E 8016 | ldx #forth_local_paren_local_paren.xt ; 0
EC5B: BD 0C04 8017 | jsr forth_core_execute.asm
EC5E: 8E 1F6E 8018 | ldx #forth_local_paren_local_paren.xt ; 1
EC61: BD 0C04 8019 | jsr forth_core_execute.asm
EC64: 8E 1F6E 8020 | ldx #forth_local_paren_local_paren.xt ; 2
EC67: BD 0C04 8021 | jsr forth_core_execute.asm
EC6A: 8E 1F6E 8022 | ldx #forth_local_paren_local_paren.xt ; 3
EC6D: BD 0C04 8023 | jsr forth_core_execute.asm
EC70: 8E 1F6E 8024 | ldx #forth_local_paren_local_paren.xt ; 4
EC73: BD 0C04 8025 | jsr forth_core_execute.asm
EC76: 8E 1F6E 8026 | ldx #forth_local_paren_local_paren.xt ; 5
EC79: BD 0C04 8027 | jsr forth_core_execute.asm
EC7C: 8E 1F6E 8028 | ldx #forth_local_paren_local_paren.xt ; 6
EC7F: BD 0C04 8029 | jsr forth_core_execute.asm
EC82: 8E 1F6E 8030 | ldx #forth_local_paren_local_paren.xt ; 7
EC85: BD 0C04 8031 | jsr forth_core_execute.asm
EC88: 8E 1F6E 8032 | ldx #forth_local_paren_local_paren.xt ; 8
EC8B: BD 0C04 8033 | jsr forth_core_execute.asm
EC8E: 8E 1F6E 8034 | ldx #forth_local_paren_local_paren.xt ; 9
EC91: BD 0C04 8035 | jsr forth_core_execute.asm
EC94: 8E 1F6E 8036 | ldx #forth_local_paren_local_paren.xt ; 10
EC97: BD 0C04 8037 | jsr forth_core_execute.asm
EC9A: 8E 1F6E 8038 | ldx #forth_local_paren_local_paren.xt ; 11
EC9D: BD 0C04 8039 | jsr forth_core_execute.asm
ECA0: 8E 1F6E 8040 | ldx #forth_local_paren_local_paren.xt ; 12
ECA3: BD 0C04 8041 | jsr forth_core_execute.asm
ECA6: 8E 1F6E 8042 | ldx #forth_local_paren_local_paren.xt ; 13
ECA9: BD 0C04 8043 | jsr forth_core_execute.asm
ECAC: 8E 1F6E 8044 | ldx #forth_local_paren_local_paren.xt ; 14
ECAF: BD 0C04 8045 | jsr forth_core_execute.asm
ECB2: 8E 1F6E 8046 | ldx #forth_local_paren_local_paren.xt ; 15
ECB5: BD 0C04 8047 | jsr forth_core_execute.asm
ECB8: 8E 1F6E 8048 | ldx #forth_local_paren_local_paren.xt ; no more
ECBB: BD 0C04 8049 | jsr forth_core_execute.asm
8050 | .assert /u = .result1 , "U"
8051 | .assert @@$D890 = forth__local_throw , "ab link"
8052 | .assert @@$D892 = _LOCAL | _IMMED :: 31 , "ab flags"
8053 | .assert $D894 = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa00" , "ab name"
8054 | .assert @@$D8B3 = forth_local_paren_local_paren.runtime , "ab xt"
8055 | .assert @@$D8B5 = 0 , "ab index"
8056 | .assert @@$DA16 , "cd link"
8057 | .assert @@$DA18 = _LOCAL | _IMMED :: 31 , "cd flags"
8058 | .assert $DA1A = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0A" , "cd name"
8059 | .assert @@$DA39 = forth_local_paren_local_paren.runtime , "cd xt"
8060 | .assert @@$DA3B = 20 , "cd index"
8061 | .assert @@forth__local_wid = $DAD9 , "wid"
8062 | .assert @@forth__here = $6004 , "HERE"
8063 | .assert @@$6000 = forth__local_enter , "enter xt"
8064 | .assert @@$6002 = -32::32 , "enter frame"
8065 | .assert @@forth__current_wid = forth__forth_wid , "GET-CURRENT"
ECBE: 39 8066 | rts
8067 |
ECBF: 0000 8068 | fdb 0
ECC1: 001FED07 8069 | .datastack1 fdb 31 , .text0
ECC5: 001FED26 8070 | fdb 31 , .text1
ECC9: 001FED45 8071 | fdb 31 , .text2
ECCD: 001FED64 8072 | fdb 31 , .text3
ECD1: 001FED83 8073 | fdb 31 , .text4
ECD5: 001FEDA2 8074 | fdb 31 , .text5
ECD9: 001FEDC1 8075 | fdb 31 , .text6
ECDD: 001FEDE0 8076 | fdb 31 , .text7
ECE1: 001FEDFF 8077 | fdb 31 , .text8
ECE5: 001FEE1E 8078 | fdb 31 , .text9
ECE9: 001FEE3D 8079 | fdb 31 , .textA
ECED: 001FEE5C 8080 | fdb 31 , .textB
ECF1: 001FEE7B 8081 | fdb 31 , .textC
ECF5: 001FEE9A 8082 | fdb 31 , .textD
ECF9: 001FEEB9 8083 | fdb 31 , .textE
ECFD: 001FEED8 8084 | fdb 31 , .textF
ED01: 00000000 8085 | fdb 0 , 0
ED05: FFFF 8086 | .result1 fdb -1
8087 |
ED07: 616161616161... 8088 | .text0 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa00'
ED26: 616161616161... 8089 | .text1 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa01'
ED45: 616161616161... 8090 | .text2 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa02'
ED64: 616161616161... 8091 | .text3 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa03'
ED83: 616161616161... 8092 | .text4 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa04'
EDA2: 616161616161... 8093 | .text5 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa05'
EDC1: 616161616161... 8094 | .text6 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa06'
EDE0: 616161616161... 8095 | .text7 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa07'
EDFF: 616161616161... 8096 | .text8 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa08'
EE1E: 616161616161... 8097 | .text9 fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa09'
EE3D: 616161616161... 8098 | .textA fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0A'
EE5C: 616161616161... 8099 | .textB fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0B'
EE7B: 616161616161... 8100 | .textC fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0C'
EE9A: 616161616161... 8101 | .textD fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0D'
EEB9: 616161616161... 8102 | .textE fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0E'
EED8: 616161616161... 8103 | .textF fcc 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaa0F'
8104 |
8105 | .endtst
8106 |
8107 | ;-------------------------------------------
8108 |
8109 | .test '(LOCAL) runtime'
EEF7: CE EF05 8110 | ldu #.datastack2
EEFA: 8E EF0C 8111 | ldx #.foo_xt
EEFD: BD 0C04 8112 | jsr forth_core_execute.asm
8113 | .assert /u = .result2
8114 | .assert @@/0,u = 42
8115 | .assert @@/2,u = 7
EF00: 39 8116 | rts
8117 |
EF01: 0000 8118 | fdb 0
EF03: 0000 8119 | fdb 0
EF05: 0001 8120 | .datastack2 fdb 1
EF07: 0002 8121 | .result2 fdb 2
EF09: 0003 8122 | fdb 3
EF0B: 12 8123 | nop
8124 |
EF0C: 0678 8125 | .foo_xt fdb forth_core_colon.runtime
EF0E: 0D84 8126 | fdb forth_core_literal.runtime_xt
EF10: 0028 8127 | fdb 40
EF12: 0D84 8128 | fdb forth_core_literal.runtime_xt
EF14: 0002 8129 | fdb 2
EF16: 201D 8130 | fdb forth__local_enter
EF18: F60A 8131 | fdb -10::10
EF1A: 203F 8132 | fdb forth__local_fetch
EF1C: 0008 8133 | fdb 8
EF1E: 203F 8134 | fdb forth__local_fetch
EF20: 0006 8135 | fdb 6
EF22: 0439 8136 | fdb forth_core_star.xt
EF24: 203F 8137 | fdb forth__local_fetch
EF26: 0004 8138 | fdb 4
EF28: 046B 8139 | fdb forth_core_plus.xt
EF2A: 203F 8140 | fdb forth__local_fetch
EF2C: 0000 8141 | fdb 0
EF2E: 203F 8142 | fdb forth__local_fetch
EF30: 0002 8143 | fdb 2
EF32: 046B 8144 | fdb forth_core_plus.xt
EF34: 205D 8145 | fdb forth__local_leave
EF36: 0C1A 8146 | fdb forth_core_exit.xt
8147 | .endtst
8148 |
8149 | ;**********************************************************************
8150 | ; LOCAL-EXT
8151 | ;**********************************************************************
8152 |
206F: 8153 | forth_local_ext_locals_bar ; obsolete
206F: 1F63 8154 | fdb forth_local_paren_local_paren
2071: A007 8155 | fdb _IMMED | _NOINTERP :: .xt - .name
2073: 4C4F43414C53... 8156 | .name fcc "LOCALS|"
207A: 0678 8157 | .xt fdb forth_core_colon.runtime
8158 | ;=================================================
8159 | ; : LOCALS| -30 THROW ; IMMEDIATE
8160 | ;=================================================
207C: 0D84 8161 | fdb forth_core_literal.runtime_xt
207E: FFE2 8162 | fdb -30
2080: 1E8A 8163 | fdb forth_exception_throw.xt
8164 |
8165 | ;**********************************************************************
8166 |
2082: 8167 | forth_local_ext_brace_colon ; C ( i*x "ccc :}" -- ) R ( x1 .. xn -- ) E ( -- X )
2082: 206F 8168 | fdb forth_local_ext_locals_bar
2084: A002 8169 | fdb _IMMED | _NOINTERP :: .xt - .name
2086: 7B3A 8170 | .name fcc "{:"
2088: 0678 8171 | .xt fdb forth_core_colon.runtime
8172 | ;=====================================================
8173 | ; : {: {:-parse 0 0 (LOCAL) ;
8174 | ;=====================================================
208A: 20EA 8175 | fdb .parse_xt
208C: 0D84 8176 | fdb forth_core_literal.runtime_xt
208E: 0000 8177 | fdb 0
2090: 0D84 8178 | fdb forth_core_literal.runtime_xt
2092: 0000 8179 | fdb 0
2094: 1F6E 8180 | fdb forth_local_paren_local_paren.xt
2096: 0C1A 8181 | fdb forth_core_exit.xt
8182 |
8183 | ;===============================================
8184 | ; : {:-ignore
8185 | ; BEGIN PARSE-NAME S" :}" string-equal IF EXIT THEN AGAIN ;
8186 | ;===============================================
2098: 0678 8187 | .ignore_xt fdb forth_core_colon.runtime
209A: 16E6 8188 | .L100 fdb forth_core_ext_parse_name.xt
209C: 2B7C 8189 | fdb forth_string_sliteral.runtime_xt
209E: 0002 8190 | fdb 2
20A0: 3A7D 8191 | fcc ":}"
20A2: 036A 8192 | fdb forth__private_string_equal_xt
20A4: 0CD1 8193 | fdb forth_core_if.runtime_xt
20A6: 20AA 8194 | fdb .L101
20A8: 0C1A 8195 | fdb forth_core_exit.xt
20AA: 1430 8196 | .L101 fdb forth_core_ext_again.runtime_xt
20AC: 209A 8197 | fdb .L100
20AE: 0C1A 8198 | fdb forth_core_exit.xt
8199 |
8200 | ;====================================================
8201 | ; : {:-vars
8202 | ; ( 1 ) PARSE-NAME
8203 | ; ( 2 ) 2DUP S" --" string-equal IF 2DROP {:-ignore ELSE
8204 | ; ( 3 ) 2DUP S" :}" string-equal IF 2DROP ELSE
8205 | ; ( 4 ) 0 POSTPONE LITERAL RECURSE (LOCAL)
8206 | ; ( 5 ) THEN THEN ;
8207 | ;====================================================
20B0: 0678 8208 | .vars_xt fdb forth_core_colon.runtime
20B2: 16E6 8209 | fdb forth_core_ext_parse_name.xt ; 1
20B4: 060D 8210 | fdb forth_core_two_dupe.xt ; 2
20B6: 2B7C 8211 | fdb forth_string_sliteral.runtime_xt
20B8: 0002 8212 | fdb 2
20BA: 2D2D 8213 | fcc "--"
20BC: 036A 8214 | fdb forth__private_string_equal_xt
20BE: 0CD1 8215 | fdb forth_core_if.runtime_xt
20C0: 20CA 8216 | fdb .L203
20C2: 05FD 8217 | fdb forth_core_two_drop.xt
20C4: 2098 8218 | fdb .ignore_xt
20C6: 1430 8219 | fdb forth_core_ext_again.runtime_xt
20C8: 20E8 8220 | fdb .L205
20CA: 060D 8221 | .L203 fdb forth_core_two_dupe.xt ; 3
20CC: 2B7C 8222 | fdb forth_string_sliteral.runtime_xt
20CE: 0002 8223 | fdb 2
20D0: 3A7D 8224 | fcc ":}"
20D2: 036A 8225 | fdb forth__private_string_equal_xt
20D4: 0CD1 8226 | fdb forth_core_if.runtime_xt
20D6: 20DE 8227 | fdb .L204
20D8: 05FD 8228 | fdb forth_core_two_drop.xt
20DA: 1430 8229 | fdb forth_core_ext_again.runtime_xt
20DC: 20E8 8230 | fdb .L205
20DE: 0D84 8231 | .L204 fdb forth_core_literal.runtime_xt ; 4
20E0: 0000 8232 | fdb 0
20E2: 0D71 8233 | fdb forth_core_literal.xt
20E4: 20B0 8234 | fdb .vars_xt
20E6: 1F6E 8235 | fdb forth_local_paren_local_paren.xt
20E8: 0C1A 8236 | .L205 fdb forth_core_exit.xt ; 5
8237 |
8238 | ;===========================================================
8239 | ; {:-parse
8240 | ; ( 1 ) PARSE-NAME
8241 | ; ( 2 ) 2DUP S" |" string-equal IF 2DROP {:-vars ELSE
8242 | ; ( 3 ) 2DUP S" --" string-equal IF 2DROP {:-ignore ELSE
8243 | ; ( 4 ) 2DUP S" :}" string-equal IF 2DROP ELSE
8244 | ; ( 5 ) RECURSE (LOCAL)
8245 | ; ( 6 ) THEN THEN THEN ;
8246 | ;===========================================================
20EA: 0678 8247 | .parse_xt fdb forth_core_colon.runtime
20EC: 16E6 8248 | fdb forth_core_ext_parse_name.xt ; 1
20EE: 060D 8249 | fdb forth_core_two_dupe.xt ; 2
20F0: 2B7C 8250 | fdb forth_string_sliteral.runtime_xt
20F2: 0001 8251 | fdb 1
20F4: 7C 8252 | fcc "|"
20F5: 036A 8253 | fdb forth__private_string_equal_xt
20F7: 0CD1 8254 | fdb forth_core_if.runtime_xt
20F9: 2103 8255 | fdb .L303
20FB: 05FD 8256 | fdb forth_core_two_drop.xt
20FD: 20B0 8257 | fdb .vars_xt
20FF: 1430 8258 | fdb forth_core_ext_again.runtime_xt
2101: 2131 8259 | fdb .L306
2103: 060D 8260 | .L303 fdb forth_core_two_dupe.xt ; 3
2105: 2B7C 8261 | fdb forth_string_sliteral.runtime_xt
2107: 0002 8262 | fdb 2
2109: 2D2D 8263 | fcc "--"
210B: 036A 8264 | fdb forth__private_string_equal_xt
210D: 0CD1 8265 | fdb forth_core_if.runtime_xt
210F: 2119 8266 | fdb .L304
2111: 05FD 8267 | fdb forth_core_two_drop.xt
2113: 2098 8268 | fdb .ignore_xt
2115: 1430 8269 | fdb forth_core_ext_again.runtime_xt
2117: 2131 8270 | fdb .L306
2119: 060D 8271 | .L304 fdb forth_core_two_dupe.xt ; 4
211B: 2B7C 8272 | fdb forth_string_sliteral.runtime_xt
211D: 0002 8273 | fdb 2
211F: 3A7D 8274 | fcc ":}"
2121: 036A 8275 | fdb forth__private_string_equal_xt
2123: 0CD1 8276 | fdb forth_core_if.runtime_xt
2125: 212D 8277 | fdb .L305
2127: 05FD 8278 | fdb forth_core_two_drop.xt
2129: 1430 8279 | fdb forth_core_ext_again.runtime_xt
212B: 2131 8280 | fdb .L306
212D: 20EA 8281 | .L305 fdb .parse_xt ; 5
212F: 1F6E 8282 | fdb forth_local_paren_local_paren.xt
2131: 0C1A 8283 | .L306 fdb forth_core_exit.xt ; 6
8284 |
8285 | ;-----------------------------------------
8286 |
8287 | .test "{:" ; let's see this blow up
8288 | .opt test prot rw,$DB00 - 1024 , $DAFF
8289 | .opt test prot rw,$6000 , $6100
8290 | .opt test prot n , ._nu1
8291 | .opt test prot n , ._nu2
8292 | .opt test prot n , ._nu3
8293 | .opt test prot n , ._nu4
8294 | .opt test prot n , ._nu5
8295 | .opt test pokew forth__here_top , $DB00
8296 | .opt test pokew forth__in , 0
8297 | .opt test pokew forth__source , .text
8298 | .opt test pokew forth__source_len , .len
8299 | .opt test pokew forth__local_wid , 0
8300 | .opt test pokew forth__here , $6000
EF38: CE EF90 8301 | ldu #.datastack1
EF3B: 8E 2088 8302 | ldx #forth_local_ext_brace_colon.xt
EF3E: BD 0C04 8303 | jsr forth_core_execute.asm
EF41: DC 1A 8304 | ldd forth__in
EF43: CC EFC4 8305 | ldd #.alpha
EF46: 36 06 8306 | pshu d
EF48: 8E 2780 8307 | ldx #forth_search_find.xt
EF4B: BD 0C04 8308 | jsr forth_core_execute.asm
8309 | .assert @@/,u = 1 , "alpha found"
8310 | .assert @@/2,u = $D8CE , "alpha right"
EF4E: CC EFCB 8311 | ldd #.gamma
EF51: 36 06 8312 | pshu d
EF53: 8E 2780 8313 | ldx #forth_search_find.xt
EF56: BD 0C04 8314 | jsr forth_core_execute.asm
8315 | .assert @@/,u = 1 , "gamma found"
8316 | .assert @@/2,u = $D8B5 , "gamma right"
EF59: CC EFD2 8317 | ldd #.semicolon
EF5C: 36 06 8318 | pshu d
EF5E: 8E 2780 8319 | ldx #forth_search_find.xt
EF61: BD 0C04 8320 | jsr forth_core_execute.asm
8321 | .assert @@/,u = 1 , "; found"
8322 | .assert @@/2,u = forth__local_semicolon.xt , "; right"
EF64: CC EFD5 8323 | ldd #.colon
EF67: 36 06 8324 | pshu d
EF69: 8E 2780 8325 | ldx #forth_search_find.xt
EF6C: BD 0C04 8326 | jsr forth_core_execute.asm
8327 | .assert @@/,u = -1 , ": found"
8328 | .assert @@/2,u = forth_core_colon.xt , ": right"
EF6F: 39 8329 | rts
8330 |
EF70: 0000 8331 | fdb 0
EF72: 0000 8332 | fdb 0
EF74: 0000 8333 | fdb 0
EF76: 0000 8334 | fdb 0
EF78: 0000 8335 | fdb 0
EF7A: 0000 8336 | fdb 0
EF7C: 0000 8337 | fdb 0
EF7E: 0000 8338 | fdb 0
EF80: 0000 8339 | fdb 0
EF82: 0000 8340 | fdb 0
EF84: 0000 8341 | fdb 0
EF86: 0000 8342 | fdb 0
EF88: 0000 8343 | fdb 0
EF8A: 0000 8344 | fdb 0
EF8C: 0000 8345 | fdb 0
EF8E: 0000 8346 | fdb 0
EF90: 0000 8347 | .datastack1 fdb 0
8348 |
EF92: 616C70686120... 8349 | .text fcc 'alpha beta gamma | delta epsilon -- here there :}'
8350 | .len equ * - .text
EFC3: 00 8351 | ._nu1 fcb 0
EFC4: 05616C706861 8352 | .alpha ascii 'alpha'c
EFCA: 00 8353 | ._nu2 fcb 0
EFCB: 0567616D6D61 8354 | .gamma ascii 'gamma'c
EFD1: 00 8355 | ._nu3 fcb 0
EFD2: 013B 8356 | .semicolon ascii ';'c
EFD4: 00 8357 | ._nu4 fcb 0
EFD5: 013A 8358 | .colon ascii ':'c
EFD7: 00 8359 | ._nu5 fcb 0
8360 | .endtst
8361 |
8362 | ;**********************************************************************
8363 | ; TOOLS
8364 | ;**********************************************************************
8365 |
2133: 8366 | forth_tools_dot_s ; ( -- )
2133: 2082 8367 | fdb forth_local_ext_brace_colon
2135: 0002 8368 | fdb .xt - .name
2137: 2E53 8369 | .name fcc ".S"
2139: 213B 8370 | .xt fdb .body
213B: 34 60 8371 | .body pshs y,u
213D: 109E 08 8372 | ldy forth__ds_top
2140: 10AC 62 8373 | .show cmpy 2,s
2143: 27 0C 8374 | beq .done
2145: EC A3 8375 | ldd ,--y
2147: 36 06 8376 | pshu d
2149: 8E 0517 8377 | ldx #forth_core_dot.xt
214C: 17 EAB5 8378 | lbsr forth_core_execute.asm
214F: 20 EF 8379 | bra .show
2151: 35 60 8380 | .done puls y,u
2153: AE A1 8381 | ldx ,y++
2155: 6E 94 8382 | jmp [,x]
8383 |
8384 | ;**********************************************************************
8385 |
2157: 8386 | forth_tools_question ; ( a-addr -- )
2157: 2133 8387 | fdb forth_tools_dot_s
2159: 0001 8388 | fdb .xt - .name
215B: 3F 8389 | .name fcc "?"
215C: 0678 8390 | .xt fdb forth_core_colon.runtime
8391 | ;=======================================
8392 | ; : ? @ . ;
8393 | ;=======================================
215E: 07E2 8394 | fdb forth_core_fetch.xt
2160: 0517 8395 | fdb forth_core_dot.xt
2162: 0C1A 8396 | fdb forth_core_exit.xt
8397 |
8398 | ;**********************************************************************
8399 |
2164: 8400 | forth_tools_dump ; ( addr u -- )
2164: 2157 8401 | fdb forth_tools_question
2166: 0004 8402 | fdb .xt - .name
2168: 44554D50 8403 | .name fcc "DUMP"
216C: 0678 8404 | .xt fdb forth_core_colon.runtime
8405 | ;==============================================
8406 | ; : DUMP
8407 | ; BASE @ >R HEX
8408 | ; SWAP DUP 0 <# # # # # #> TYPE ." : "
8409 | ; SWAP 0 ?DO
8410 | ; DUP I CHARS + C@ 0 <# # # #> TYPE SPACE
8411 | ; LOOP CR DROP R> BASE ! ;
8412 | ;==============================================
216E: 08A5 8413 | fdb forth_core_base.xt
2170: 07E2 8414 | fdb forth_core_fetch.xt
2172: 07BF 8415 | fdb forth_core_to_r.xt
2174: 1578 8416 | fdb forth_core_ext_hex.xt
2176: 10FC 8417 | fdb forth_core_swap.xt
2178: 0A74 8418 | fdb forth_core_dupe.xt
217A: 0D84 8419 | fdb forth_core_literal.runtime_xt
217C: 0000 8420 | fdb 0
217E: 06C7 8421 | fdb forth_core_less_number_sign.xt
2180: 0388 8422 | fdb forth_core_number_sign.xt
2182: 0388 8423 | fdb forth_core_number_sign.xt
2184: 0388 8424 | fdb forth_core_number_sign.xt
2186: 0388 8425 | fdb forth_core_number_sign.xt
2188: 03E1 8426 | fdb forth_core_number_sign_greater.xt
218A: 1124 8427 | fdb forth_core_type.xt
218C: 2B7C 8428 | fdb forth_string_sliteral.runtime_xt
218E: 0002 8429 | fdb .len
2190: 3A20 8430 | .text fcc ": "
8431 | .len equ * - .text
2192: 1124 8432 | fdb forth_core_type.xt
2194: 10FC 8433 | fdb forth_core_swap.xt
2196: 0D84 8434 | fdb forth_core_literal.runtime_xt
2198: 0000 8435 | fdb 0
219A: 13D4 8436 | fdb forth_core_ext_question_do.runtime_xt
219C: 21BC 8437 | fdb .L2
219E: 0A74 8438 | .L1 fdb forth_core_dupe.xt
21A0: 0CAC 8439 | fdb forth_core_i.xt
21A2: 0962 8440 | fdb forth_core_chars.xt
21A4: 046B 8441 | fdb forth_core_plus.xt
21A6: 08F9 8442 | fdb forth_core_c_fetch.xt
21A8: 0D84 8443 | fdb forth_core_literal.runtime_xt
21AA: 0000 8444 | fdb 0
21AC: 06C7 8445 | fdb forth_core_less_number_sign.xt
21AE: 0388 8446 | fdb forth_core_number_sign.xt
21B0: 0388 8447 | fdb forth_core_number_sign.xt
21B2: 03E1 8448 | fdb forth_core_number_sign_greater.xt
21B4: 1124 8449 | fdb forth_core_type.xt
21B6: 10D0 8450 | fdb forth_core_space.xt
21B8: 0D9E 8451 | fdb forth_core_loop.runtime_xt
21BA: 219E 8452 | fdb .L1
21BC: 099E 8453 | .L2 fdb forth_core_c_r.xt
21BE: 0A65 8454 | fdb forth_core_drop.xt
21C0: 0FAA 8455 | fdb forth_core_r_from.xt
21C2: 08A5 8456 | fdb forth_core_base.xt
21C4: 0377 8457 | fdb forth_core_store.xt
21C6: 0C1A 8458 | fdb forth_core_exit.xt
8459 |
8460 | ;**********************************************************************
8461 |
8462 | forth__see_ip equ forth__create_link ; reuse some variables
8463 | forth__see_exit equ forth__create_name ; (this is probably a bad idea)
8464 |
21C8: 8465 | forth_tools_see ; ( "name" -- )
21C8: 2164 8466 | fdb forth_tools_dump
21CA: 0003 8467 | fdb .xt - .name
21CC: 534545 8468 | .name fcc "SEE"
21CF: 21D1 8469 | .xt fdb .body
21D1: CC 0020 8470 | .body ldd #' '
21D4: 36 06 8471 | pshu d
21D6: 8E 1217 8472 | ldx #forth_core_word.xt
21D9: 17 EA28 8473 | lbsr forth_core_execute.asm
21DC: 8E 2780 8474 | ldx #forth_search_find.xt
21DF: 17 EA22 8475 | lbsr forth_core_execute.asm
21E2: EC C1 8476 | ldd ,u++ ; found?
21E4: 27 17 8477 | beq .not_found ; nope
8478 |
8479 | ;------------------------------------------------------------------
8480 | ; Don't attempt to decompile the Forth code for the implementation,
8481 | ; as there are too many exceptions and hidden xts to properly deal
8482 | ; with it. If it's a Forth word, just claim it's code and be done
8483 | ; with it.
8484 | ;------------------------------------------------------------------
8485 |
21E6: 37 10 8486 | pulu x
21E8: 8C 2CE1 8487 | cmpx #forth_string_ext_unescape.xt
21EB: 22 3E 8488 | bhi .decompile
8489 |
21ED: 8E 2218 8490 | .is_code ldx #.is_code_msg
21F0: CC 0008 8491 | ldd #.is_code_len
21F3: 20 10 8492 | bra .display_exit
8493 |
21F5: 8E 2220 8494 | .is_unknown ldx #.is_unknown_msg
21F8: CC 000B 8495 | ldd #.is_unknown_len
21FB: 20 08 8496 | bra .display_exit
8497 |
21FD: 33 42 8498 | .not_found leau 2,u
21FF: 8E 220E 8499 | ldx #.not_found_msg
2202: CC 000A 8500 | ldd #.not_found_len
2205: 36 16 8501 | .display_exit pshu x,d
2207: 17 02CA 8502 | lbsr .type_text
220A: AE A1 8503 | ldx ,y++
220C: 6E 94 8504 | jmp [,x]
8505 |
220E: 206E6F742066... 8506 | .not_found_msg fcc ' not found'
8507 | .not_found_len equ * - .not_found_msg
8508 |
2218: 20697320636F... 8509 | .is_code_msg fcc ' is code'
8510 | .is_code_len equ * - .is_code_msg
8511 |
2220: 20697320756E... 8512 | .is_unknown_msg fcc ' is unknown'
8513 | .is_unknown_len equ * - .is_unknown_msg
8514 |
8515 | ;**************************************************
8516 |
222B: 34 60 8517 | .decompile pshs u,y
222D: 9F 28 8518 | stx forth__create_xt ; save xt
222F: 31 02 8519 | leay 2,x
2231: 109F 24 8520 | sty forth__see_ip
2234: 17 DEBC 8521 | lbsr forth__util_xt_to_name
2237: 9F 26 8522 | stx forth__create_name ; save name link
8523 |
2239: 8E 2283 8524 | ldx #.def_xt_tab
223C: EC 9F0028 8525 | ldd [forth__create_xt] ; get xt
2240: 1093 24 8526 | cmpd forth__create_link
2243: 26 04 8527 | bne .not_code
2245: 35 60 8528 | puls u,y
2247: 20 A4 8529 | bra .is_code
8530 |
2249: 17 0277 8531 | .not_code lbsr .scan_table ; CREATE DOES> ...
224C: 27 2C 8532 | beq .not_does
224E: 9E 28 8533 | ldx forth__create_xt
2250: AE 84 8534 | ldx ,x
2252: A6 84 8535 | lda ,x
2254: 81 BD 8536 | cmpa #$BD
2256: 26 08 8537 | bne .not_known
2258: EC 01 8538 | ldd 1,x
225A: 1083 09BD 8539 | cmpd #forth_core_create.does_hook
225E: 27 04 8540 | beq .is_does
2260: 35 60 8541 | .not_known puls u,y
2262: 20 91 8542 | bra .is_unknown
8543 |
2264: 9F 24 8544 | .is_does stx forth__see_ip
2266: 8E 228B 8545 | ldx #.create_tab
2269: 17 00B5 8546 | lbsr .createf
226C: DC 24 8547 | ldd forth__see_ip
226E: DD 26 8548 | std forth__see_exit
2270: 8E 236C 8549 | ldx #.does_tab
2273: 17 019C 8550 | lbsr .doesf
2276: 8D 50 8551 | bsr .disassemble
2278: 20 03 8552 | bra .finished
8553 |
227A: AD 9804 8554 | .not_does jsr [4,x] ; jump to code
227D: 35 60 8555 | .finished puls u,y
227F: AE A1 8556 | ldx ,y++
2281: 6E 94 8557 | jmp [,x]
8558 |
8559 | ;*************************************************
8560 | ; Runtime code table (format: xt, name, function
8561 | ;*************************************************
8562 |
2283: 0007 8563 | .def_xt_tab fdb .def_xt_items
2285: 0678 8564 | .def_xt fdb forth_core_colon.runtime ; :
2287: 064F 8565 | fdb forth_core_colon + 2
2289: 22AF 8566 | fdb .colonf
228B: 09C3 8567 | .create_tab fdb forth_core_create.runtime ; CREATE
228D: 09AA 8568 | fdb forth_core_create + 2
228F: 2321 8569 | fdb .createf
2291: 1619 8570 | fdb forth_core_ext_marker.runtime ; MARKER
2293: 15CF 8571 | fdb forth_core_ext_marker + 2
2295: 2321 8572 | fdb .createf
2297: 1A56 8573 | fdb forth_core_ext_value.runtime ; VALUE
2299: 1A36 8574 | fdb forth_core_ext_value + 2
229B: 2336 8575 | fdb .valuef
229D: 1E2E 8576 | fdb forth_double_ext_two_value.runtime ; 2VALUE
229F: 1DFF 8577 | fdb forth_double_ext_two_value + 2
22A1: 2349 8578 | fdb .twovaluef
22A3: 097A 8579 | fdb forth_core_constant.does ; CONSTANT
22A5: 0968 8580 | fdb forth_core_constant + 2
22A7: 2336 8581 | fdb .valuef
22A9: 1AB5 8582 | fdb forth_double_two_constant.does ; 2CONSTANT
22AB: 1AA0 8583 | fdb forth_double_two_constant + 2
22AD: 2349 8584 | fdb .twovaluef
8585 | .def_xt_items equ (* - .def_xt) / 6
8586 |
8587 | ;*******************************************
8588 | ; Runtime and known DOES> functions
8589 | ;*******************************************
8590 |
22AF: 10AE 02 8591 | .colonf ldy 2,x
22B2: EC A1 8592 | ldd ,y++ ; get length of word
22B4: 4F 8593 | clra ; clear flags
22B5: 36 26 8594 | pshu y,d ; push c-addr u
22B7: 17 021A 8595 | lbsr .type_text
22BA: 9E 26 8596 | ldx forth__create_name ; display word name
22BC: EC 81 8597 | ldd ,x++
22BE: 4F 8598 | clra
22BF: 36 16 8599 | pshu x,d ; push c-addr u
22C1: 17 0210 8600 | lbsr .type_text
8601 |
22C4: DC 24 8602 | ldd forth__see_ip ; set up forth__see_exit to
22C6: DD 26 8603 | std forth__see_exit ; distinguish between EXIT and ;
8604 |
22C8: 9E 24 8605 | .disassemble ldx forth__see_ip ; get next xt
22CA: EC 81 8606 | ldd ,x++
22CC: 9F 24 8607 | stx forth__see_ip
22CE: 1093 28 8608 | cmpd forth__create_xt
22D1: 27 34 8609 | beq .self
22D3: 8E 235E 8610 | ldx #.run_xt_tab ; scan this table for special xt's
22D6: 17 01EA 8611 | lbsr .scan_table
22D9: 27 41 8612 | beq .dis_custom ; if so, handle
22DB: 1083 0C1A 8613 | cmpd #forth_core_exit.xt ; EXIT?
22DF: 26 2C 8614 | bne .normal_xt ; if not, handle
22E1: 9E 24 8615 | ldx forth__see_ip
22E3: 9C 26 8616 | cmpx forth__see_exit
22E5: 23 26 8617 | bls .normal_xt
22E7: 8E 0682 8618 | ldx #forth_core_semicolon + 2 ; otherwise it's a ;
22EA: EC 81 8619 | ldd ,x++
22EC: 4F 8620 | clra
22ED: 36 16 8621 | pshu x,d
22EF: 17 01E2 8622 | lbsr .type_text ; we're done
22F2: 9E 28 8623 | ldx forth__create_xt
22F4: 17 DDFC 8624 | lbsr forth__util_xt_to_name
22F7: 85 80 8625 | bita #_IMMED
22F9: 27 0B 8626 | beq .dis_done
22FB: 8E 0CE6 8627 | ldx #forth_core_immediate + 2
22FE: EC 81 8628 | ldd ,x++
2300: 4F 8629 | clra
2301: 36 16 8630 | pshu x,d
2303: 17 01CE 8631 | lbsr .type_text
2306: 39 8632 | .dis_done rts
8633 |
2307: 8E 0FC6 8634 | .self ldx #forth_core_recurse + 2
230A: 16 0198 8635 | lbra .print_xt
8636 |
230D: 1F 01 8637 | .normal_xt tfr d,x
230F: 17 DDE1 8638 | lbsr forth__util_xt_to_name
2312: EC 81 8639 | ldd ,x++
2314: 4F 8640 | clra
2315: 36 16 8641 | pshu x,d
2317: 17 01BA 8642 | lbsr .type_text
231A: 20 AC 8643 | bra .disassemble
8644 |
231C: AD 9804 8645 | .dis_custom jsr [4,x]
231F: 20 A7 8646 | bra .disassemble
8647 |
8648 | ;******************************************
8649 |
2321: 10AE 02 8650 | .createf ldy 2,x
2324: EC A1 8651 | ldd ,y++
2326: 4F 8652 | clra
2327: 36 26 8653 | pshu y,d
2329: 17 01A8 8654 | lbsr .type_text
232C: 9E 26 8655 | ldx forth__create_name
232E: EC 81 8656 | ldd ,x++
2330: 4F 8657 | clra
2331: 36 16 8658 | pshu x,d
2333: 16 019E 8659 | lbra .type_text
8660 |
8661 | ;*****************************************
8662 |
2336: 109E 28 8663 | .valuef ldy forth__create_xt
2339: EC 22 8664 | ldd 2,y
233B: 36 06 8665 | pshu d
233D: 34 10 8666 | pshs x
233F: 8E 0517 8667 | ldx #forth_core_dot.xt
2342: 17 E8BF 8668 | lbsr forth_core_execute.asm
2345: 35 10 8669 | puls x
2347: 20 D8 8670 | bra .createf
8671 |
8672 | ;****************************************
8673 |
2349: 34 10 8674 | .twovaluef pshs x
234B: 109E 28 8675 | ldy forth__create_xt
234E: EC 24 8676 | ldd 4,y
2350: AE 22 8677 | ldx 2,y
2352: 36 16 8678 | pshu x,d
2354: 8E 1B4C 8679 | ldx #forth_double_d_dot.xt
2357: 17 E8AA 8680 | lbsr forth_core_execute.asm
235A: 35 10 8681 | puls x
235C: 20 C3 8682 | bra .createf
8683 |
8684 | ;*********************************************
8685 | ; List of non-standard xts
8686 | ;*********************************************
8687 |
235E: 0013 8688 | .run_xt_tab fdb .run_xt_items
2360: 04CA 8689 | .run_xt fdb forth_core_plus_loop.runtime_xt ; +LOOP
2362: 048F 8690 | fdb forth_core_plus_loop + 2
2364: 23F6 8691 | fdb .locationf
2366: 0A2A 8692 | fdb forth_core_do.runtime_xt ; DO
2368: 0A00 8693 | fdb forth_core_do + 2
236A: 24A3 8694 | fdb .printxtf
236C: 0A50 8695 | .does_tab fdb forth_core_does.runtime_xt ; DOES>
236E: 0A31 8696 | fdb forth_core_does + 2
2370: 2412 8697 | fdb .doesf
2372: 0CD1 8698 | fdb forth_core_if.runtime_xt ; IF
2374: 0CB8 8699 | fdb forth_core_if + 2
2376: 23F6 8700 | fdb .locationf
2378: 0D5B 8701 | fdb forth_core_leave.runtime_xt ; LEAVE
237A: 0D39 8702 | fdb forth_core_leave + 2
237C: 24A3 8703 | fdb .printxtf
237E: 0D84 8704 | fdb forth_core_literal.runtime_xt ; LITERAL
2380: 0D68 8705 | fdb forth_core_literal + 2
2382: 241C 8706 | fdb .literalf
2384: 0D9E 8707 | fdb forth_core_loop.runtime_xt ; LOOP
2386: 0D90 8708 | fdb forth_core_loop + 2
2388: 23F6 8709 | fdb .locationf
238A: 11CF 8710 | fdb forth_core_until.runtime_xt ; UNTIL
238C: 11B5 8711 | fdb forth_core_until + 2
238E: 23F6 8712 | fdb .locationf
2390: 13D4 8713 | fdb forth_core_ext_question_do.runtime_xt ; ?DO
2392: 13AB 8714 | fdb forth_core_ext_question_do + 2
2394: 23F6 8715 | fdb .locationf
2396: 1430 8716 | fdb forth_core_ext_again.runtime_xt ; AGAIN
2398: 1416 8717 | fdb forth_core_ext_again + 2
239A: 23F6 8718 | fdb .locationf
239C: 1483 8719 | fdb forth_core_ext_c_quote.runtime_xt ; C"
239E: 1450 8720 | fdb forth_core_ext_c_quote + 2
23A0: 2427 8721 | fdb .cquotef
23A2: 166A 8722 | fdb forth_core_ext_of.runtime_xt ; OF
23A4: 1653 8723 | fdb forth_core_ext_of + 2
23A6: 23F6 8724 | fdb .locationf
23A8: 1995 8725 | fdb forth_core_ext_to.runtime_xt ; TO
23AA: 192E 8726 | fdb forth_core_ext_to + 2
23AC: 24A3 8727 | fdb .printxtf
23AE: 1ADF 8728 | fdb forth_double_two_literal.runtime_xt ; 2LITERAL
23B0: 1ABE 8729 | fdb forth_double_two_literal + 2
23B2: 2430 8730 | fdb .twoliteralf
23B4: 2B7C 8731 | fdb forth_string_sliteral.runtime_xt ; SLITERAL (aka S")
23B6: 1026 8732 | fdb forth_core_s_quote + 2
23B8: 2446 8733 | fdb .sliteralf
23BA: 201D 8734 | fdb forth__local_enter ; (LOCAL)/{:
23BC: 23D2 8735 | fdb .enter
23BE: 2464 8736 | fdb .localenterf
23C0: 203F 8737 | fdb forth__local_fetch ; x
23C2: 1F65 8738 | fdb forth_local_paren_local_paren + 2
23C4: 247D 8739 | fdb .localfetchf
23C6: 204D 8740 | fdb forth__local_store ; TO x
23C8: 192E 8741 | fdb forth_core_ext_to + 2
23CA: 2489 8742 | fdb .localstoref
23CC: 205D 8743 | fdb forth__local_leave
23CE: 23E3 8744 | fdb .cleanup
23D0: 24A3 8745 | fdb .printxtf
8746 | .run_xt_items equ (* - .run_xt) / 6
8747 |
23D2: 0011 8748 | .enter fdb .enter_len
23D4: 28206C6F6361... 8749 | fcc '( local-enter )'
8750 | .enter_len equ * - .enter
8751 |
23E3: 0013 8752 | .cleanup fdb .cleanup_len
23E5: 28206C6F6361... 8753 | fcc '( local-cleanup )'
8754 | .cleanup_len equ * - .cleanup
8755 |
8756 | ;**********************************************
8757 | ; Functions to handle nonstandard xt
8758 | ;**********************************************
8759 |
23F6: 17 00AA 8760 | .locationf lbsr .printxtf
23F9: 9E 24 8761 | ldx forth__see_ip
23FB: EC 81 8762 | ldd ,x++
23FD: 9F 24 8763 | stx forth__see_ip
23FF: 1093 26 8764 | cmpd forth__see_exit
2402: 25 02 8765 | blo .no_ip_exit
2404: DD 26 8766 | std forth__see_exit ; store for EXIT detection
2406: 93 24 8767 | .no_ip_exit subd forth__see_ip ; turn absolute jump into relative jump
2408: 47 8768 | asra ; and conver to cells
2409: 56 8769 | rorb
240A: 36 06 8770 | .print_num pshu d
240C: 8E 0517 8771 | ldx #forth_core_dot.xt ; print #cells to jump
240F: 16 E7F2 8772 | lbra forth_core_execute.asm
8773 |
8774 | ;********************************************
8775 |
2412: 17 008E 8776 | .doesf lbsr .printxtf
2415: 9E 24 8777 | ldx forth__see_ip
2417: 30 03 8778 | leax 3,x
2419: 9F 24 8779 | stx forth__see_ip
241B: 39 8780 | rts
8781 |
8782 | ;********************************************
8783 |
241C: 17 008D 8784 | .literalf lbsr .prtinvxt
241F: 9E 24 8785 | ldx forth__see_ip
2421: EC 81 8786 | ldd ,x++
2423: 9F 24 8787 | stx forth__see_ip
2425: 20 E3 8788 | bra .print_num
8789 |
8790 | ;**********************************************
8791 |
2427: 8D 7A 8792 | .cquotef bsr .printxtf
2429: 9E 24 8793 | ldx forth__see_ip
242B: 4F 8794 | clra
242C: E6 80 8795 | ldb ,x+
242E: 20 1C 8796 | bra .endtext
8797 |
8798 | ;**********************************************
8799 |
2430: 8D 7A 8800 | .twoliteralf bsr .prtinvxt
2432: 9E 24 8801 | ldx forth__see_ip
2434: EC 84 8802 | ldd ,x
2436: 36 06 8803 | pshu d
2438: EC 02 8804 | ldd 2,x
243A: 30 04 8805 | leax 4,x
243C: 9F 24 8806 | stx forth__see_ip
243E: 36 06 8807 | pshu d
2440: 8E 1B4C 8808 | ldx #forth_double_d_dot.xt
2443: 16 E7BE 8809 | lbra forth_core_execute.asm
8810 |
8811 | ;**********************************************
8812 |
2446: 8D 5B 8813 | .sliteralf bsr .printxtf
2448: 9E 24 8814 | ldx forth__see_ip
244A: EC 81 8815 | ldd ,x++
244C: 36 16 8816 | .endtext pshu x,d
244E: 30 8B 8817 | leax d,x
2450: 9F 24 8818 | stx forth__see_ip
2452: 8E 1124 8819 | ldx #forth_core_type.xt
2455: 17 E7AC 8820 | lbsr forth_core_execute.asm
2458: C6 22 8821 | ldb #'"'
245A: AD 9F0004 8822 | jsr [forth__vector_putchar]
245E: C6 20 8823 | ldb #' '
2460: 6E 9F0004 8824 | jmp [forth__vector_putchar]
8825 |
8826 | ;**********************************************
8827 |
2464: 8D 3D 8828 | .localenterf bsr .printxtf
2466: D6 1D 8829 | ldb forth__base + 1
2468: 34 04 8830 | pshs b
246A: C6 10 8831 | ldb #16
246C: D7 1D 8832 | stb forth__base + 1
246E: 9E 24 8833 | ldx forth__see_ip
2470: EC 81 8834 | ldd ,x++
2472: 4F 8835 | clra
2473: 54 8836 | lsrb
2474: 9F 24 8837 | stx forth__see_ip
2476: 8D 92 8838 | bsr .print_num
2478: 35 04 8839 | puls b
247A: D7 1D 8840 | stb forth__base + 1
247C: 39 8841 | rts
8842 |
8843 | ;**********************************************
8844 |
247D: 8D 2D 8845 | .localfetchf bsr .prtinvxt
247F: 9E 24 8846 | .print_local ldx forth__see_ip
2481: EC 81 8847 | ldd ,x++
2483: 9F 24 8848 | stx forth__see_ip
2485: 54 8849 | lsrb
2486: 7E 248D 8850 | jmp .local_genname
8851 |
2489: 8D 18 8852 | .localstoref bsr .printxtf
248B: 20 F2 8853 | bra .print_local
8854 |
8855 | ;**********************************************
8856 |
248D: 34 04 8857 | .local_genname pshs b
248F: C6 4C 8858 | ldb #'L'
2491: AD 9F0004 8859 | jsr [forth__vector_putchar]
2495: 35 04 8860 | puls b
2497: CB 41 8861 | addb #'A'
2499: AD 9F0004 8862 | jsr [forth__vector_putchar]
249D: C6 20 8863 | ldb #' '
249F: 6E 9F0004 8864 | jmp [forth__vector_putchar]
8865 |
8866 | ;**********************************************
8867 |
24A3: AE 02 8868 | .printxtf ldx 2,x
24A5: EC 81 8869 | .print_xt ldd ,x++
24A7: 4F 8870 | clra
24A8: 36 16 8871 | pshu x,d
24AA: 20 28 8872 | bra .type_text
8873 |
8874 | ;**********************************************
8875 |
24AC: 34 10 8876 | .prtinvxt pshs x
24AE: 8E 0425 8877 | ldx #forth_core_paren + 2
24B1: 8D F2 8878 | bsr .print_xt
24B3: 35 10 8879 | puls x
24B5: 8D EC 8880 | bsr .printxtf
24B7: C6 29 8881 | ldb #')'
24B9: AD 9F0004 8882 | jsr [forth__vector_putchar]
24BD: C6 20 8883 | ldb #' '
24BF: 6E 9F0004 8884 | jmp [forth__vector_putchar]
8885 |
8886 | ;**********************************************
8887 | ;Entry: X - table
8888 | ; D - xt
8889 | ;Exit: Y - munged
8890 | ; Zf - 1 if found
8891 | ; - 0 not found
8892 | ;**********************************************
8893 |
24C3: 10AE 81 8894 | .scan_table ldy ,x++
24C6: 10A3 84 8895 | .scan_check cmpd ,x
24C9: 27 08 8896 | beq .scan_found
24CB: 30 06 8897 | leax 6,x
24CD: 31 3F 8898 | leay -1,y
24CF: 26 F5 8899 | bne .scan_check
24D1: 1C FB 8900 | andcc {z}
24D3: 39 8901 | .scan_found rts
8902 |
24D4: 8E 1124 8903 | .type_text ldx #forth_core_type.xt
24D7: 17 E72A 8904 | lbsr forth_core_execute.asm
24DA: 8E 10D0 8905 | ldx #forth_core_space.xt
24DD: 16 E724 8906 | lbra forth_core_execute.asm
8907 |
8908 | ;--------------------------------------------------
8909 |
8910 | .test "SEE XLERB"
8911 | .opt test prot r , .buffer1 , .buffer1 + .len1
8912 | .opt test prot rw,$6000,$6100
8913 | .opt test pokew forth__widnum , 1
8914 | .opt test pokew forth__here , $6000
8915 | .opt test pokew forth__source , .buffer1
8916 | .opt test pokew forth__source_len , .len1
8917 | .opt test pokew forth__in , 0
8918 | .opt test pokew forth__vector_putchar , .sysnul
EFD8: CE EFF4 8919 | ldu #.datastack1
EFDB: 8E 21CF 8920 | ldx #forth_tools_see.xt
EFDE: 7E 0C04 8921 | jmp forth_core_execute.asm
8922 |
EFE1: 39 8923 | .sysnul rts
8924 |
EFE2: 0000 8925 | fdb 0
EFE4: 0000 8926 | fdb 0
EFE6: 0000 8927 | fdb 0
EFE8: 0000 8928 | fdb 0
EFEA: 0000 8929 | fdb 0
EFEC: 0000 8930 | fdb 0
EFEE: 0000 8931 | fdb 0
EFF0: 0000 8932 | fdb 0
EFF2: 0000 8933 | fdb 0
EFF4: 00 8934 | .datastack1 fcb 0
8935 |
EFF5: 584C455242 8936 | .buffer1 fcc 'XLERB'
8937 | .len1 equ * - .buffer1
EFFA: 00 8938 | fcb 0
8939 | .endtst
8940 |
8941 | ;--------------------------------------------
8942 |
8943 | .test "SEE */MOD"
8944 | .opt test prot r , .buffer2 , .buffer2 + .len2 - 1
8945 | .opt test prot rw,$6000,$6100
8946 | .opt test pokew forth__widnum , 1
8947 | .opt test pokew forth__here , $6000
8948 | .opt test pokew forth__source , .buffer2
8949 | .opt test pokew forth__source_len , .len2
8950 | .opt test pokew forth__in , 0
8951 | .opt test pokew forth__vector_putchar , .sysnul2
EFFB: CE F017 8952 | ldu #.datastack2
EFFE: 8E 21CF 8953 | ldx #forth_tools_see.xt
F001: 7E 0C04 8954 | jmp forth_core_execute.asm
8955 |
F004: 39 8956 | .sysnul2 rts
8957 |
F005: 0000 8958 | fdb 0
F007: 0000 8959 | fdb 0
F009: 0000 8960 | fdb 0
F00B: 0000 8961 | fdb 0
F00D: 0000 8962 | fdb 0
F00F: 0000 8963 | fdb 0
F011: 0000 8964 | fdb 0
F013: 0000 8965 | fdb 0
F015: 0000 8966 | fdb 0
F017: 00 8967 | .datastack2 fcb 0
8968 |
F018: 2A2F4D4F44 8969 | .buffer2 fcc '*/MOD'
8970 | .len2 equ * - .buffer2
8971 | .endtst
8972 |
8973 | ;--------------------------------------------
8974 |
8975 | .test "SEE variable"
8976 | .opt test prot r , .buffer3 , .buffer3 + .len3 - 1
8977 | .opt test prot rw,$6000,$6100
8978 | .opt test pokew forth__widnum , 2
8979 | .opt test pokew forth__widlist + 2 , .wid3
8980 | .opt test pokew forth__local_wid , 0
8981 | .opt test pokew forth__here , $6000
8982 | .opt test pokew forth__source , .buffer3
8983 | .opt test pokew forth__source_len , .len3
8984 | .opt test pokew forth__in , 0
8985 | .opt test pokew forth__vector_putchar , .sysnul3
F01D: CE F039 8986 | ldu #.datastack3
F020: 8E 21CF 8987 | ldx #forth_tools_see.xt
F023: 7E 0C04 8988 | jmp forth_core_execute.asm
8989 |
F026: 39 8990 | .sysnul3 rts
8991 |
F027: 0000 8992 | fdb 0
F029: 0000 8993 | fdb 0
F02B: 0000 8994 | fdb 0
F02D: 0000 8995 | fdb 0
F02F: 0000 8996 | fdb 0
F031: 0000 8997 | fdb 0
F033: 0000 8998 | fdb 0
F035: 0000 8999 | fdb 0
F037: 0000 9000 | fdb 0
F039: 00 9001 | .datastack3 fcb 0
9002 |
F03A: F03C 9003 | .wid3 fdb .foo3
9004 |
F03C: 0000 9005 | .foo3 fdb 0
F03E: 0003 9006 | fdb 3
F040: 666F6F 9007 | fcc 'foo'
F043: 09C3 9008 | fdb forth_core_create.runtime
F045: 000A 9009 | fdb 10
9010 |
F047: 666F6F 9011 | .buffer3 fcc 'foo'
9012 | .len3 equ * - .buffer3
9013 | .endtst
9014 |
9015 | ;----------------------------------------------
9016 |
9017 | .test "SEE value"
9018 | .opt test prot r , .buffer4 , .buffer4 + .len4 - 1
9019 | .opt test prot rw,$6000,$6100
9020 | .opt test pokew forth__widnum , 2
9021 | .opt test pokew forth__widlist + 2 , .wid4
9022 | .opt test pokew forth__local_wid , 0
9023 | .opt test pokew forth__here , $6000
9024 | .opt test pokew forth__source , .buffer4
9025 | .opt test pokew forth__source_len , .len4
9026 | .opt test pokew forth__in , 0
9027 | .opt test pokew forth__vector_putchar , .sysnul4
F04A: CE F066 9028 | ldu #.datastack4
F04D: 8E 21CF 9029 | ldx #forth_tools_see.xt
F050: 7E 0C04 9030 | jmp forth_core_execute.asm
9031 |
F053: 39 9032 | .sysnul4 rts
9033 |
F054: 0000 9034 | fdb 0
F056: 0000 9035 | fdb 0
F058: 0000 9036 | fdb 0
F05A: 0000 9037 | fdb 0
F05C: 0000 9038 | fdb 0
F05E: 0000 9039 | fdb 0
F060: 0000 9040 | fdb 0
F062: 0000 9041 | fdb 0
F064: 0000 9042 | fdb 0
F066: 00 9043 | .datastack4 fcb 0
9044 |
F067: F069 9045 | .wid4 fdb .foo4
9046 |
F069: 0000 9047 | .foo4 fdb 0
F06B: 0003 9048 | fdb 3
F06D: 666F6F 9049 | fcc 'foo'
F070: 1A56 9050 | fdb forth_core_ext_value.runtime
F072: 002A 9051 | fdb 42
9052 |
F074: 666F6F 9053 | .buffer4 fcc 'foo'
9054 | .len4 equ * - .buffer4
9055 | .endtst
9056 |
9057 | ;-------------------------------------------
9058 |
9059 | .test "SEE 2value"
9060 | .opt test prot r , .buffer5 , .buffer5 + .len5 - 1
9061 | .opt test prot rw,$6000,$6100
9062 | .opt test pokew forth__widnum , 2
9063 | .opt test pokew forth__widlist + 2 , .wid5
9064 | .opt test pokew forth__local_wid , 0
9065 | .opt test pokew forth__here , $6000
9066 | .opt test pokew forth__source , .buffer5
9067 | .opt test pokew forth__source_len , .len5
9068 | .opt test pokew forth__in , 0
9069 | .opt test pokew forth__vector_putchar , .sysnul5
F077: CE F093 9070 | ldu #.datastack5
F07A: 8E 21CF 9071 | ldx #forth_tools_see.xt
F07D: 7E 0C04 9072 | jmp forth_core_execute.asm
9073 |
F080: 39 9074 | .sysnul5 rts
9075 |
F081: 0000 9076 | fdb 0
F083: 0000 9077 | fdb 0
F085: 0000 9078 | fdb 0
F087: 0000 9079 | fdb 0
F089: 0000 9080 | fdb 0
F08B: 0000 9081 | fdb 0
F08D: 0000 9082 | fdb 0
F08F: 0000 9083 | fdb 0
F091: 0000 9084 | fdb 0
F093: 00 9085 | .datastack5 fcb 0
9086 |
F094: F096 9087 | .wid5 fdb .foo5
9088 |
F096: 0000 9089 | .foo5 fdb 0
F098: 0003 9090 | fdb 3
F09A: 666F6F 9091 | fcc 'foo'
F09D: 1E2E 9092 | fdb forth_double_ext_two_value.runtime
F09F: 1234 9093 | fdb $1234
F0A1: 5678 9094 | fdb $5678
9095 |
F0A3: 666F6F 9096 | .buffer5 fcc 'foo'
9097 | .len5 equ * - .buffer5
9098 | .endtst
9099 |
9100 | ;-------------------------------------------
9101 |
9102 | .test "SEE code"
9103 | .opt test prot r , .buffer6 , .buffer6 + .len6 - 1
9104 | .opt test prot rw,$6000,$6100
9105 | .opt test pokew forth__widnum , 2
9106 | .opt test pokew forth__widlist + 2 , .wid6
9107 | .opt test pokew forth__local_wid , 0
9108 | .opt test pokew forth__here , $6000
9109 | .opt test pokew forth__source , .buffer6
9110 | .opt test pokew forth__source_len , .len6
9111 | .opt test pokew forth__in , 0
9112 | .opt test pokew forth__vector_putchar , .sysnul6
F0A6: CE F0C2 9113 | ldu #.datastack6
F0A9: 8E 21CF 9114 | ldx #forth_tools_see.xt
F0AC: 7E 0C04 9115 | jmp forth_core_execute.asm
9116 |
F0AF: 39 9117 | .sysnul6 rts
9118 |
F0B0: 0000 9119 | fdb 0
F0B2: 0000 9120 | fdb 0
F0B4: 0000 9121 | fdb 0
F0B6: 0000 9122 | fdb 0
F0B8: 0000 9123 | fdb 0
F0BA: 0000 9124 | fdb 0
F0BC: 0000 9125 | fdb 0
F0BE: 0000 9126 | fdb 0
F0C0: 0000 9127 | fdb 0
F0C2: 00 9128 | .datastack6 fcb 0
9129 |
F0C3: F0C5 9130 | .wid6 fdb .foo6
9131 |
F0C5: 0000 9132 | .foo6 fdb 0
F0C7: 0003 9133 | fdb 3
F0C9: 666F6F 9134 | fcc 'foo'
F0CC: F0CE 9135 | fdb .foo6_body
F0CE: AE A1 9136 | .foo6_body ldx ,y++
F0D0: 6E 94 9137 | jmp [,x]
9138 |
F0D2: 666F6F 9139 | .buffer6 fcc 'foo'
9140 | .len6 equ * - .buffer6
9141 | .endtst
9142 |
9143 | ;-------------------------------------------
9144 |
9145 | .test "SEE foo"
9146 | .opt test prot r , .buffer7 , .buffer7 + .len7 - 1
9147 | .opt test prot rw,$6000,$6100
9148 | .opt test pokew forth__widnum , 2
9149 | .opt test pokew forth__widlist + 2 , .wid7
9150 | .opt test pokew forth__local_wid , 0
9151 | .opt test pokew forth__here , $6000
9152 | .opt test pokew forth__source , .buffer7
9153 | .opt test pokew forth__source_len , .len7
9154 | .opt test pokew forth__in , 0
9155 | .opt test pokew forth__vector_putchar , .sysnul7
F0D5: CE F0F1 9156 | ldu #.datastack7
F0D8: 8E 21CF 9157 | ldx #forth_tools_see.xt
F0DB: 7E 0C04 9158 | jmp forth_core_execute.asm
9159 |
F0DE: 39 9160 | .sysnul7 rts
9161 |
F0DF: 0000 9162 | fdb 0
F0E1: 0000 9163 | fdb 0
F0E3: 0000 9164 | fdb 0
F0E5: 0000 9165 | fdb 0
F0E7: 0000 9166 | fdb 0
F0E9: 0000 9167 | fdb 0
F0EB: 0000 9168 | fdb 0
F0ED: 0000 9169 | fdb 0
F0EF: 0000 9170 | fdb 0
F0F1: 00 9171 | .datastack7 fcb 0
9172 |
F0F2: F14A 9173 | .wid7 fdb .foo7
9174 |
F0F4: 0000 9175 | fdb 0
F0F6: 0005 9176 | fdb 5
F0F8: 736E616675 9177 | fcc 'snafu'
F0FD: 0678 9178 | .foo7_snafu fdb forth_core_colon.runtime
F0FF: 0C1A 9179 | fdb forth_core_exit.xt
F101: 0000 9180 | fdb 0
F103: 0005 9181 | fdb 5
F105: 616C706861 9182 | fcc 'alpha'
F10A: 0678 9183 | .foo7_alpha fdb forth_core_colon.runtime
F10C: 0C1A 9184 | fdb forth_core_exit.xt
F10E: 0000 9185 | fdb 0
F110: 0004 9186 | fdb 4
F112: 62657461 9187 | fcc 'beta'
F116: 0678 9188 | .foo7_beta fdb forth_core_colon.runtime
F118: 0C1A 9189 | fdb forth_core_exit.xt
F11A: 0000 9190 | fdb 0
F11C: 0005 9191 | fdb 5
F11E: 67616D6D61 9192 | fcc 'gamma'
F123: 0678 9193 | .foo7_gamma fdb forth_core_colon.runtime
F125: 0C1A 9194 | fdb forth_core_exit.xt
F127: 0000 9195 | fdb 0
F129: 0005 9196 | fdb 5
F12B: 64656C7461 9197 | fcc 'delta'
F130: 0678 9198 | .foo7_delta fdb forth_core_colon.runtime
F132: 0C1A 9199 | fdb forth_core_exit.xt
F134: 0000 9200 | fdb 0
F136: 0003 9201 | fdb 3
F138: 626172 9202 | fcc 'bar'
F13B: 0678 9203 | .foo7_bar fdb forth_core_colon.runtime
F13D: 0C1A 9204 | fdb forth_core_exit.xt
F13F: 0000 9205 | fdb 0
F141: 0003 9206 | fdb 3
F143: 62617A 9207 | fcc 'baz'
F146: 0678 9208 | .foo7_baz fdb forth_core_colon.runtime
F148: 0C1A 9209 | fdb forth_core_exit.xt
F14A: 0000 9210 | .foo7 fdb 0
F14C: 0003 9211 | fdb 3
F14E: 666F6F 9212 | fcc 'foo'
F151: 0678 9213 | fdb forth_core_colon.runtime
9214 | ;==========================================================
9215 | ; : foo {: LD LC LB LA | LE LF :}
9216 | ; S" Hello world!" TYPE C" Top o' the world!" TYPE
9217 | ; 15 snafu CASE
9218 | ; alpha OF EXIT ENDOF
9219 | ; beta OF bar IF EXIT THEN ENDOF
9220 | ; gamma OF bar IF EXIT ELSE baz THEN ENDOF
9221 | ; delta OF bar IF baz ELSE EXIT THEN ENDOF
9222 | ; EXIT
9223 | ; ENDCASE bar set-source-id baz
9224 | ; LD TO LF 305419896. ;
9225 | ;==========================================================
F153: 0D84 9226 | fdb forth_core_literal.runtime_xt
F155: 0000 9227 | fdb 0
F157: 0D84 9228 | fdb forth_core_literal.runtime_xt
F159: 0000 9229 | fdb 0
F15B: 201D 9230 | fdb forth__local_enter
F15D: F40C 9231 | fdb -12::12
F15F: 2B7C 9232 | fdb forth_string_sliteral.runtime_xt
F161: 000C 9233 | fdb 12
F163: 48656C6C6F20... 9234 | fcc 'Hello world!'
F16F: 1483 9235 | fdb forth_core_ext_c_quote.runtime_xt
F171: 11546F70206F... 9236 | ascii "Top o' the world!"c
F183: 0D84 9237 | fdb forth_core_literal.runtime_xt
F185: 000F 9238 | fdb 15
F187: F0FD 9239 | fdb .foo7_snafu
F189: F10A 9240 | fdb .foo7_alpha
F18B: 166A 9241 | fdb forth_core_ext_of.runtime_xt
F18D: F195 9242 | fdb .Cbeta
F18F: 0C1A 9243 | fdb forth_core_exit.xt
F191: 1430 9244 | fdb forth_core_ext_again.runtime_xt
F193: F1DF 9245 | fdb .Endcase
F195: F116 9246 | .Cbeta fdb .foo7_beta
F197: 166A 9247 | fdb forth_core_ext_of.runtime_xt
F199: F1A7 9248 | fdb .Cgamma
F19B: F13B 9249 | fdb .foo7_bar
F19D: 0CD1 9250 | fdb forth_core_if.runtime_xt
F19F: F1A3 9251 | fdb .L11
F1A1: 0C1A 9252 | fdb forth_core_exit.xt
F1A3: 1430 9253 | .L11 fdb forth_core_ext_again.runtime_xt
F1A5: F1DF 9254 | fdb .Endcase
9255 |
F1A7: F123 9256 | .Cgamma fdb .foo7_gamma
F1A9: 166A 9257 | fdb forth_core_ext_of.runtime_xt
F1AB: F1BF 9258 | fdb .Cdelta
F1AD: F13B 9259 | fdb .foo7_bar
F1AF: 0CD1 9260 | fdb forth_core_if.runtime_xt
F1B1: F1B9 9261 | fdb .L21
F1B3: 0C1A 9262 | fdb forth_core_exit.xt
F1B5: 1430 9263 | fdb forth_core_ext_again.runtime_xt
F1B7: F1BB 9264 | fdb .L31
F1B9: F146 9265 | .L21 fdb .foo7_baz
F1BB: 1430 9266 | .L31 fdb forth_core_ext_again.runtime_xt
F1BD: F1DF 9267 | fdb .Endcase
9268 |
F1BF: F130 9269 | .Cdelta fdb .foo7_delta
F1C1: 166A 9270 | fdb forth_core_ext_of.runtime_xt
F1C3: F1D7 9271 | fdb .C_default
F1C5: F13B 9272 | fdb .foo7_bar
F1C7: 0CD1 9273 | fdb forth_core_if.runtime_xt
F1C9: F1D1 9274 | fdb .L4
F1CB: F146 9275 | fdb .foo7_baz
F1CD: 1430 9276 | fdb forth_core_ext_again.runtime_xt
F1CF: F1D3 9277 | fdb .L5
F1D1: 0C1A 9278 | .L4 fdb forth_core_exit.xt
F1D3: 1430 9279 | .L5 fdb forth_core_ext_again.runtime_xt
F1D5: F1DF 9280 | fdb .Endcase
F1D7: 1ADF 9281 | .C_default fdb forth_double_two_literal.runtime_xt
F1D9: 3039 9282 | fdb 12345
F1DB: D431 9283 | fdb 54321
F1DD: 0C1A 9284 | fdb forth_core_exit.xt
F1DF: 0A65 9285 | .Endcase fdb forth_core_drop.xt
F1E1: F13B 9286 | fdb .foo7_bar
F1E3: 0354 9287 | fdb forth__private_set_source_i_d
F1E5: F146 9288 | fdb .foo7_baz
F1E7: 203F 9289 | fdb forth__local_fetch
F1E9: 0006 9290 | fdb 6
F1EB: 204D 9291 | fdb forth__local_store
F1ED: 000A 9292 | fdb 10
F1EF: 1ADF 9293 | fdb forth_double_two_literal.runtime_xt
F1F1: 5678 9294 | fdb $5678
F1F3: 1234 9295 | fdb $1234
F1F5: 205D 9296 | fdb forth__local_leave
F1F7: 0C1A 9297 | fdb forth_core_exit.xt
9298 |
F1F9: 666F6F 9299 | .buffer7 fcc 'foo'
9300 | .len7 equ * - .buffer7
9301 | .endtst
9302 |
9303 | ;-------------------------------------------
9304 |
9305 | .test "SEE DOES>"
9306 | .opt test prot r , .buffer8 , .buffer8 + .len8 - 1
9307 | .opt test prot rw,$6000,$6100
9308 | .opt test pokew forth__widnum , 2
9309 | .opt test pokew forth__widlist + 2 , .wid8
9310 | .opt test pokew forth__local_wid , 0
9311 | .opt test pokew forth__here , $6000
9312 | .opt test pokew forth__source , .buffer8
9313 | .opt test pokew forth__source_len , .len8
9314 | .opt test pokew forth__in , 0
9315 | .opt test pokew forth__vector_putchar , .sysnul8
F1FC: CE F224 9316 | ldu #.datastack8
F1FF: 8E 21CF 9317 | ldx #forth_tools_see.xt
F202: BD 0C04 9318 | jsr forth_core_execute.asm
F205: C6 0A 9319 | ldb #10
F207: AD 9F0004 9320 | jsr [forth__vector_putchar]
F20B: 8E 21CF 9321 | ldx #forth_tools_see.xt
F20E: 7E 0C04 9322 | jmp forth_core_execute.asm
9323 |
F211: 39 9324 | .sysnul8 rts
9325 |
F212: 0000 9326 | fdb 0
F214: 0000 9327 | fdb 0
F216: 0000 9328 | fdb 0
F218: 0000 9329 | fdb 0
F21A: 0000 9330 | fdb 0
F21C: 0000 9331 | fdb 0
F21E: 0000 9332 | fdb 0
F220: 0000 9333 | fdb 0
F222: 0000 9334 | fdb 0
F224: 00 9335 | .datastack8 fcb 0
9336 |
F225: F26F 9337 | .wid8 fdb .foo8_man
9338 |
F227: 0000 9339 | fdb 0
F229: 0004 9340 | fdb 4
F22B: 2E726F77 9341 | fcc '.row'
F22F: 0678 9342 | .foo8_dotrow fdb forth_core_colon.runtime
F231: 0C1A 9343 | fdb forth_core_exit.xt
9344 |
F233: 0000 9345 | .foo8 fdb 0
F235: 0003 9346 | fdb 3
F237: 666F6F 9347 | fcc 'foo'
F23A: 0678 9348 | fdb forth_core_colon.runtime
9349 | ;==================================================
9350 | ; : shape
9351 | ; CREATE 8 0 DO C, LOOP
9352 | ; DOES> DUP 7 + DO I C@ .row -1 +LOOP CR ;
9353 | ;==================================================
F23C: 09B2 9354 | fdb forth_core_create.xt
F23E: 0D84 9355 | fdb forth_core_literal.runtime_xt
F240: 0008 9356 | fdb 8
F242: 0D84 9357 | fdb forth_core_literal.runtime_xt
F244: 0000 9358 | fdb 0
F246: 0A2A 9359 | fdb forth_core_do.runtime_xt
F248: 9360 | .L1
F248: 08E5 9361 | fdb forth_core_c_comma.xt
F24A: 0D9E 9362 | fdb forth_core_loop.runtime_xt
F24C: F248 9363 | fdb .L1
F24E: 0A50 9364 | fdb forth_core_does.runtime_xt
F250: BD 09BD 9365 | .foo8_does jsr forth_core_create.does_hook
F253: 0A74 9366 | fdb forth_core_dupe.xt
F255: 0D84 9367 | fdb forth_core_literal.runtime_xt
F257: 0007 9368 | fdb 7
F259: 046B 9369 | fdb forth_core_plus.xt
F25B: 0A2A 9370 | fdb forth_core_do.runtime_xt
F25D: 9371 | .L2
F25D: 0CAC 9372 | fdb forth_core_i.xt
F25F: 08F9 9373 | fdb forth_core_c_fetch.xt
F261: F22F 9374 | fdb .foo8_dotrow
F263: 0D84 9375 | fdb forth_core_literal.runtime_xt
F265: FFFF 9376 | fdb -1
F267: 04CA 9377 | fdb forth_core_plus_loop.runtime_xt
F269: F25D 9378 | fdb .L2
F26B: 099E 9379 | fdb forth_core_c_r.xt
F26D: 0C1A 9380 | fdb forth_core_exit.xt
9381 |
F26F: F233 9382 | .foo8_man fdb .foo8
F271: 0003 9383 | fdb 3
F273: 6D616E 9384 | fcc 'man'
F276: F250 9385 | fdb .foo8_does
F278: 2424 9386 | fdb $2424
F27A: 2499 9387 | fdb $2499
F27C: 5A3C 9388 | fdb $5A3C
F27E: 1818 9389 | fdb $1818
9390 |
F280: 666F6F206D61... 9391 | .buffer8 fcc 'foo man'
9392 | .len8 equ * - .buffer8
9393 | .endtst
9394 |
9395 | ;**********************************************************************
9396 |
24E0: 9397 | forth_tools_words ; ( -- )
24E0: 21C8 9398 | fdb forth_tools_see
24E2: 0005 9399 | fdb .xt - .name
24E4: 574F524453 9400 | .name fcc "WORDS"
24E9: 0678 9401 | .xt fdb forth_core_colon.runtime
9402 | ;====================================================
9403 | ; : type_word ( nt -- true ) NAME>STRING TYPE CR TRUE ;
9404 | ; : WORDS GET-ORDER ?DUP IF
9405 | ; SWAP >R 1- 0 ?DO DROP LOOP
9406 | ; ['] type_word R> TRAVERSE-WORDLIST
9407 | ; THEN ;
9408 | ;====================================================
24EB: 2819 9409 | fdb forth_search_get_order.xt
24ED: 07D1 9410 | fdb forth_core_question_dupe.xt
24EF: 0CD1 9411 | fdb forth_core_if.runtime_xt
24F1: 2511 9412 | fdb .L4
24F3: 10FC 9413 | fdb forth_core_swap.xt
24F5: 07BF 9414 | fdb forth_core_to_r.xt
24F7: 059E 9415 | fdb forth_core_one_minus.xt
24F9: 0D84 9416 | fdb forth_core_literal.runtime_xt
24FB: 0000 9417 | fdb 0
24FD: 13D4 9418 | fdb forth_core_ext_question_do.runtime_xt
24FF: 2507 9419 | fdb .L2
2501: 0A65 9420 | .L1 fdb forth_core_drop.xt
2503: 0D9E 9421 | fdb forth_core_loop.runtime_xt
2505: 2501 9422 | fdb .L1
2507: 0D84 9423 | .L2 fdb forth_core_literal.runtime_xt
2509: 2513 9424 | fdb .type_word_xt
250B: 0FAA 9425 | fdb forth_core_r_from.xt
250D: 2646 9426 | fdb forth_tools_ext_traverse_wordlist.xt
250F: 099E 9427 | fdb forth_core_c_r.xt
2511: 0C1A 9428 | .L4 fdb forth_core_exit.xt
9429 |
2513: 0678 9430 | .type_word_xt fdb forth_core_colon.runtime
9431 | ;===================================================
9432 | ; : type_word NAME>STRING TYPE SPACE TRUE ;
9433 | ;===================================================
2515: 25EF 9434 | fdb forth_tools_ext_name_to_string.xt
2517: 1124 9435 | fdb forth_core_type.xt
2519: 10D0 9436 | fdb forth_core_space.xt
251B: 19BD 9437 | fdb forth_core_ext_true.xt
251D: 0C1A 9438 | fdb forth_core_exit.xt
9439 |
9440 | ;**********************************************************************
9441 | ; TOOLS-EXT
9442 | ;**********************************************************************
9443 | ;
9444 | ;forth_tools_ext_simicolon_code
9445 | ; fdb forth_tools_words
9446 | ; fdb _NOINTERP :: .xt - .name
9447 | ;.name fcc ";CODE"
9448 | ;.xt fdb forth_core_colon.runtime
9449 | ; fdb forth_core_literal.runtime_xt
9450 | ; fdb -13
9451 | ; fdb forth_exception_ext_abort.xt
9452 | ;
9453 | ;**********************************************************************
9454 |
251F: 9455 | forth_tools_ext_ahead ; C ( C: -- orig ) R ( -- )
251F: 24E0 9456 | fdb forth_tools_words
2521: A005 9457 | fdb _IMMED | _NOINTERP :: .xt - .name
2523: 4148454144 9458 | .name fcc "AHEAD"
2528: 252A 9459 | .xt fdb .body
252A: 9E 10 9460 | .body ldx forth__here
252C: CC 1430 9461 | ldd #forth_core_ext_again.runtime_xt
252F: ED 81 9462 | std ,x++
2531: 36 10 9463 | pshu x ; push orig
2533: 30 02 9464 | leax 2,x ; space for target address
2535: 9F 10 9465 | stx forth__here
2537: AE A1 9466 | ldx ,y++ ; NEXT
2539: 6E 94 9467 | jmp [,x]
9468 |
9469 | ;**********************************************************************
9470 | ;
9471 | ;forth_tools_ext_assembler
9472 | ; fdb forth_tools_ext_ahead
9473 | ; fdb .xt - .name
9474 | ;.name fcc "ASSEMBLER"
9475 | ;.xt fdb forth_core_colon.runtime
9476 | ; fdb forth_core_literal.runtime_xt
9477 | ; fdb -13
9478 | ; fdb forth_exception_ext_abort.xt
9479 | ;
9480 | ;**********************************************************************
9481 |
253B: 9482 | forth_tools_ext_bye ; ( -- )
253B: 251F 9483 | fdb forth_tools_ext_ahead
253D: 0003 9484 | fdb .xt - .name
253F: 425945 9485 | .name fcc "BYE"
2542: 2544 9486 | .xt fdb .body
2544: 6E 9F0000 9487 | .body jmp [forth__vector_bye]
9488 |
9489 | ;**********************************************************************
9490 | ;
9491 | ;forth_tools_ext_code
9492 | ; fdb forth_tools_ext_bye
9493 | ; fdb .xt - .name
9494 | ;.name fcc "CODE"
9495 | ;.xt fdb forth_core_colon.runtime
9496 | ; fdb forth_core_literal.runtime_xt
9497 | ; fdb -13
9498 | ; fdb forth_exception_ext_abort.xt
9499 | ;
9500 | ;**********************************************************************
9501 |
2548: 9502 | forth_tools_ext_c_s_pick ; E ( C: destu .. orig0 | dest0 -- destu .. orig0 | dest0 destu ) ( S: u -- )
2548: 253B 9503 | fdb forth_tools_ext_bye
254A: 2007 9504 | fdb _NOINTERP :: .xt - .name
254C: 43532D504943... 9505 | .name fcc "CS-PICK"
2553: 0678 9506 | .xt fdb forth_core_colon.runtime
9507 | ;===================================
9508 | ; : CS-PICK PICK ;
9509 | ;===================================
2555: 1720 9510 | fdb forth_core_ext_pick.xt
2557: 0C1A 9511 | fdb forth_core_exit.xt
9512 |
9513 | ;**********************************************************************
9514 |
2559: 9515 | forth_tools_ext_c_s_roll ; ( C: ou|du o-1|d-1 .. o0|d0 -- o-1|d-1 .. og0|dt0 ou|du ) ( S: u -- )
2559: 2548 9516 | fdb forth_tools_ext_c_s_pick
255B: 2007 9517 | fdb _NOINTERP :: .xt - .name
255D: 43532D524F4C... 9518 | .name fcc "CS-ROLL"
2564: 0678 9519 | .xt fdb forth_core_colon.runtime
9520 | ;===================================
9521 | ; : CS-ROLL ROLL ;
9522 | ;===================================
2566: 17AF 9523 | fdb forth_core_ext_roll.xt
2568: 0C1A 9524 | fdb forth_core_exit.xt
9525 |
9526 | ;**********************************************************************
9527 | ;
9528 | ;forth_tools_ext_editor
9529 | ; fdb forth_tools_ext_c_s_roll
9530 | ; fdb .xt - .name
9531 | ;.name fcc "EDITOR"
9532 | ;.xt fdb forth_core_colon.runtime
9533 | ; fdb forth_core_literal.runtime_xt
9534 | ; fdb -13
9535 | ; fdb forth_exception_ext_abort.xt
9536 | ;
9537 | ;**********************************************************************
9538 | ;
9539 | ;forth_tools_ext_forget ; obsolete
9540 | ; fdb forth_tools_ext_c_s_roll
9541 | ; fdb .xt - .name
9542 | ;.name fcc "FORGET"
9543 | ;.xt fdb forth_core_colon.runtime
9544 | ; ;=========================================
9545 | ; ; : FORGET -30 THROW ;
9546 | ; ;=========================================
9547 | ; fdb forth_core_literal.runtime_xt
9548 | ; fdb -30
9549 | ; fdb forth_exception_ext_abort.xt
9550 | ;
9551 | ;**********************************************************************
9552 |
256A: 9553 | forth_tools_ext_n_to_r ; E ( i*n +n -- ) ( R: j*x + n )
256A: 2559 9554 | fdb forth_tools_ext_c_s_roll
256C: 2003 9555 | fdb _NOINTERP :: .xt - .name
256E: 4E3E52 9556 | .name fcc "N>R"
2571: 2573 9557 | .xt fdb .body
2573: AE C1 9558 | .body ldx ,u++
2575: 27 0C 9559 | beq .done
2577: 9F 3E 9560 | stx forth__nr_storage
2579: 37 06 9561 | .repeat pulu d
257B: 34 06 9562 | pshs d
257D: 30 1F 9563 | leax -1,x
257F: 26 F8 9564 | bne .repeat
2581: 9E 3E 9565 | ldx forth__nr_storage
2583: 34 10 9566 | .done pshs x
2585: AE A1 9567 | ldx ,y++
2587: 6E 94 9568 | jmp [,x]
9569 |
9570 | ;**********************************************************************
9571 | ; NAME>COMPILE
9572 | ;
9573 | ; Per A.15.6.2.1909.10 of the Forth-2012 standard, the x is the xt of the
9574 | ; word found, and xt is either EXECUTE for immediate words, or COMPILE, for
9575 | ; non-immediate words.
9576 | ;
9577 | ;**********************************************************************
9578 |
2589: 9579 | forth_tools_ext_name_to_compile ; ( nt -- x xt )
2589: 256A 9580 | fdb forth_tools_ext_n_to_r
258B: 000C 9581 | fdb .xt - .name
258D: 4E414D453E43... 9582 | .name fcc "NAME>COMPILE"
2599: 259B 9583 | .xt fdb .body
259B: 37 10 9584 | .body pulu x ; get nt
259D: 30 02 9585 | leax 2,x ; move past .next field
259F: EC 81 9586 | ldd ,x++ ; get length (and flags)
25A1: 3A 9587 | abx ; move past text
25A2: 36 10 9588 | pshu x ; save xt of word found
25A4: 4D 9589 | tsta ; now push EXECUTE or COMPILE,
25A5: 2B 05 9590 | bmi .immed
25A7: CC 14AC 9591 | ldd #forth_core_ext_compile_comma.xt
25AA: 20 03 9592 | bra .exit
25AC: CC 0BFE 9593 | .immed ldd #forth_core_execute.xt
25AF: 36 06 9594 | .exit pshu d
25B1: AE A1 9595 | ldx ,y++ ; NEXT
25B3: 6E 94 9596 | jmp [,x]
9597 |
9598 | ;**********************************************************************
9599 |
25B5: 9600 | forth_tools_ext_name_to_interpret ; ( xt -- xt|0 )
25B5: 2589 9601 | fdb forth_tools_ext_name_to_compile
25B7: 000E 9602 | fdb .xt - .name
25B9: 4E414D453E49... 9603 | .name fcc "NAME>INTERPRET"
25C7: 25C9 9604 | .xt fdb .body
25C9: 37 10 9605 | .body pulu x ; get nt
25CB: 30 02 9606 | leax 2,x ; move past next field
25CD: EC 81 9607 | ldd ,x++ ; get length (and flags)
25CF: 84 20 9608 | anda #_NOINTERP
25D1: 26 07 9609 | bne .no_interp
25D3: 3A 9610 | abx ; move past text
25D4: 36 10 9611 | pshu x ; save xt
25D6: AE A1 9612 | .done ldx ,y++
25D8: 6E 94 9613 | jmp [,x]
25DA: 4F 9614 | .no_interp clra
25DB: 5F 9615 | clrb
25DC: 36 06 9616 | pshu d
25DE: 20 F6 9617 | bra .done
9618 |
9619 | ;**********************************************************************
9620 |
25E0: 9621 | forth_tools_ext_name_to_string ; ( xt -- c-addr u )
25E0: 25B5 9622 | fdb forth_tools_ext_name_to_interpret
25E2: 000B 9623 | fdb .xt - .name
25E4: 4E414D453E53... 9624 | .name fcc "NAME>STRING"
25EF: 25F1 9625 | .xt fdb .body
25F1: 37 10 9626 | .body pulu x ; get nt
25F3: 30 02 9627 | leax 2,x ; move past next field
25F5: EC 81 9628 | ldd ,x++ ; get length as 16-bit value
25F7: 4F 9629 | clra ; mask of bits
25F8: 36 16 9630 | pshu x,d ; push c-addr u onto stack
25FA: AE A1 9631 | ldx ,y++ ; NEXT
25FC: 6E 94 9632 | jmp [,x]
9633 |
9634 | ;**********************************************************************
9635 |
25FE: 9636 | forth_tools_ext_n_r_from ; E ( -- i*x +n ) ( R: j*x +n -- )
25FE: 25E0 9637 | fdb forth_tools_ext_name_to_string
2600: 2003 9638 | fdb _NOINTERP :: .xt - .name
2602: 4E523E 9639 | .name fcc "NR>"
2605: 2607 9640 | .xt fdb .body
2607: AE E1 9641 | .body ldx ,s++
2609: 27 0C 9642 | beq .done
260B: 9F 3E 9643 | stx forth__nr_storage
260D: 35 06 9644 | .repeat puls d
260F: 36 06 9645 | pshu d
2611: 30 1F 9646 | leax -1,x
2613: 26 F8 9647 | bne .repeat
2615: 9E 3E 9648 | ldx forth__nr_storage
2617: 36 10 9649 | .done pshu x
2619: AE A1 9650 | ldx ,y++
261B: 6E 94 9651 | jmp [,x]
9652 |
9653 | ;**********************************************************************
9654 |
261D: 9655 | forth_tools_ext_state ; ( -- a-addr )
261D: 25FE 9656 | fdb forth_tools_ext_n_r_from
261F: 0005 9657 | fdb .xt - .name
2621: 5354415445 9658 | .name fcc "STATE"
2626: 2628 9659 | .xt fdb .body
2628: CC 0018 9660 | .body ldd #forth__state
262B: 36 06 9661 | pshu d
262D: AE A1 9662 | ldx ,y++
262F: 6E 94 9663 | jmp [,x]
9664 |
9665 | ;**********************************************************************
9666 | ;
9667 | ;forth_tools_ext_synonym
9668 | ; fdb forth_tools_ext_state
9669 | ; fdb .xt - .name
9670 | ;.name fcc "SYNONYM"
9671 | ;.xt fdb forth_core_colon.runtime
9672 | ; fdb forth_core_literal.runtime_xt
9673 | ; fdb -13
9674 | ; fdb forth_exception_ext_abort.xt
9675 | ;
9676 | ;**********************************************************************
9677 |
9678 | Pwid set 2
9679 | Pxt set 0
9680 |
2631: 9681 | forth_tools_ext_traverse_wordlist ; ( i*x xt wid -- j*x )
2631: 261D 9682 | fdb forth_tools_ext_state
2633: 0011 9683 | fdb .xt - .name
2635: 545241564552... 9684 | .name fcc "TRAVERSE-WORDLIST"
2646: 2648 9685 | .xt fdb .body
2648: AE D1 9686 | .body ldx [,u++] ; get address out of wid
264A: 34 10 9687 | pshs x ; save
264C: 37 06 9688 | pulu d ; get xt
264E: 34 06 9689 | pshs d ; save
2650: AE 62 9690 | .again ldx Pwid,s ; get next address
2652: 27 15 9691 | beq .done ; if NULL, done
2654: EC 84 9692 | ldd ,x ; get next word
2656: ED 62 9693 | std Pwid,s ; save
2658: A6 02 9694 | lda 2,x ; get flags
265A: 84 40 9695 | anda #_HIDDEN ; HIDDEN?
265C: 26 F2 9696 | bne .again ; skip if so
265E: 36 10 9697 | pshu x ; save as nt
2660: AE E4 9698 | ldx Pxt,s ; get xt to run
2662: 17 E59F 9699 | lbsr forth_core_execute.asm ; execute XT
2665: EC C1 9700 | ldd ,u++ ; get flag
2667: 26 E7 9701 | bne .again ; repeat if true
2669: 32 64 9702 | .done leas 4,s ; remove data from return stack
266B: AE A1 9703 | ldx ,y++ ; NEXT
266D: 6E 94 9704 | jmp [,x]
9705 |
9706 | ;-------------------------------------
9707 |
9708 | .test "TRAVERSE-WORDLIST"
9709 | .opt test pokew forth__vector_putchar , .sysnul
F287: CE F2A3 9710 | ldu #.datastack
F28A: 8E 2646 9711 | ldx #forth_tools_ext_traverse_wordlist.xt
F28D: 7E 0C04 9712 | jmp forth_core_execute.asm
9713 |
F290: 39 9714 | .sysnul rts
9715 |
F291: 0000 9716 | fdb 0
F293: 0000 9717 | fdb 0
F295: 0000 9718 | fdb 0
F297: 0000 9719 | fdb 0
F299: 0000 9720 | fdb 0
F29B: 0000 9721 | fdb 0
F29D: 0000 9722 | fdb 0
F29F: 0000 9723 | fdb 0
F2A1: 0000 9724 | fdb 0
F2A3: 0012 9725 | .datastack fdb forth__forth_wid ; forth__env_wid
F2A5: F2A7 9726 | fdb .noname_xt
9727 |
9728 | ;===================================================
9729 | ; :NONAME ( nt -- flag) NAME>STRING TYPE CR FALSE ;
9730 | ;===================================================
9731 |
F2A7: 0678 9732 | .noname_xt fdb forth_core_colon.runtime
F2A9: 25EF 9733 | fdb forth_tools_ext_name_to_string.xt
F2AB: 1124 9734 | fdb forth_core_type.xt
F2AD: 099E 9735 | fdb forth_core_c_r.xt
F2AF: 19BD 9736 | fdb forth_core_ext_true.xt
F2B1: 0C1A 9737 | fdb forth_core_exit.xt
9738 | .endtst
9739 |
9740 | ;**********************************************************************
9741 |
266F: 9742 | forth_tools_ext_bracket_defined ; ( "name..." -- flag )
266F: 2631 9743 | fdb forth_tools_ext_traverse_wordlist
2671: 8009 9744 | fdb _IMMED :: .xt - .name
2673: 5B444546494E... 9745 | .name fcc "[DEFINED]"
267C: 0678 9746 | .xt fdb forth_core_colon.runtime
9747 | ;==============================================
9748 | ; : [DEFINED] BL WORD FIND NIP 0<> ; IMMEDIATE
9749 | ;==============================================
267E: 08C9 9750 | fdb forth_core_b_l.xt
2680: 1217 9751 | fdb forth_core_word.xt
2682: 2780 9752 | fdb forth_search_find.xt
2684: 1649 9753 | fdb forth_core_ext_nip.xt
2686: 1313 9754 | fdb forth_core_ext_zero_not_equals.xt
2688: 0C1A 9755 | fdb forth_core_exit.xt
9756 |
9757 | ;**********************************************************************
9758 |
268A: 9759 | forth_tools_ext_bracket_else ; ( "name..." -- )
268A: 266F 9760 | fdb forth_tools_ext_bracket_defined
268C: 8006 9761 | fdb _IMMED :: .xt - .name
268E: 5B454C53455D 9762 | .name fcc "[ELSE]"
2694: 0678 9763 | .xt fdb forth_core_colon.runtime
9764 | ;=================================================
9765 | ; : [ELSE]
9766 | ; ( 1 ) 1 BEGIN
9767 | ; ( 2 ) BEGIN BL WORD COUNT DUP WHILE
9768 | ; ( 3 ) 2DUP S" [IF]" COMPARE 0= IF
9769 | ; ( 4 ) 2DROP 1+
9770 | ; ( 5 ) ELSE
9771 | ; ( 6 ) 2DUP S" [ELSE]" COMPARE 0= IF
9772 | ; ( 7 ) 2DROP 1- DUP IF 1+ THEN
9773 | ; ( 8 ) ELSE
9774 | ; ( 9 ) S" [THEN]" COMPARE 0= IF
9775 | ; ( 10 ) 1-
9776 | ; ( 11 ) THEN
9777 | ; ( 12 ) THEN
9778 | ; ( 13 ) THEN ?DUP 0= IF EXIT THEN
9779 | ; ( 14 ) REPEAT 2DROP
9780 | ; ( 15 ) REFILL 0= UNTIL
9781 | ; ( 16 ) DROP ; IMMEDIATE
9782 | ;=================================================
2696: 0D84 9783 | fdb forth_core_literal.runtime_xt
2698: 0001 9784 | fdb 1
269A: 08C9 9785 | .L3 fdb forth_core_b_l.xt
269C: 1217 9786 | fdb forth_core_word.xt
269E: 098A 9787 | fdb forth_core_count.xt
26A0: 0A74 9788 | fdb forth_core_dupe.xt
26A2: 0CD1 9789 | fdb forth_core_if.runtime_xt
26A4: 2706 9790 | fdb .L58
26A6: 060D 9791 | fdb forth_core_two_dupe.xt
26A8: 2B7C 9792 | fdb forth_string_sliteral.runtime_xt
26AA: 0004 9793 | fdb 4
26AC: 5B49465D 9794 | fcc '[IF]'
26B0: 2A96 9795 | fdb forth_string_compare.xt
26B2: 057E 9796 | fdb forth_core_zero_equals.xt
26B4: 0CD1 9797 | fdb forth_core_if.runtime_xt
26B6: 26C0 9798 | fdb .L23
26B8: 05FD 9799 | fdb forth_core_two_drop.xt
26BA: 058E 9800 | fdb forth_core_one_plus.xt
26BC: 1430 9801 | fdb forth_core_ext_again.runtime_xt
26BE: 26F8 9802 | fdb .L50
26C0: 060D 9803 | .L23 fdb forth_core_two_dupe.xt
26C2: 2B7C 9804 | fdb forth_string_sliteral.runtime_xt
26C4: 0006 9805 | fdb 6
26C6: 5B454C53455D 9806 | fcc '[ELSE]'
26CC: 2A96 9807 | fdb forth_string_compare.xt
26CE: 057E 9808 | fdb forth_core_zero_equals.xt
26D0: 0CD1 9809 | fdb forth_core_if.runtime_xt
26D2: 26E4 9810 | fdb .L39
26D4: 05FD 9811 | fdb forth_core_two_drop.xt
26D6: 059E 9812 | fdb forth_core_one_minus.xt
26D8: 0A74 9813 | fdb forth_core_dupe.xt
26DA: 0CD1 9814 | fdb forth_core_if.runtime_xt
26DC: 26E0 9815 | fdb .L37
26DE: 058E 9816 | fdb forth_core_one_plus.xt
26E0: 1430 9817 | .L37 fdb forth_core_ext_again.runtime_xt
26E2: 26F8 9818 | fdb .L50
26E4: 2B7C 9819 | .L39 fdb forth_string_sliteral.runtime_xt
26E6: 0006 9820 | fdb 6
26E8: 5B5448454E5D 9821 | fcc '[THEN]'
26EE: 2A96 9822 | fdb forth_string_compare.xt
26F0: 057E 9823 | fdb forth_core_zero_equals.xt
26F2: 0CD1 9824 | fdb forth_core_if.runtime_xt
26F4: 26F8 9825 | fdb .L50
26F6: 059E 9826 | fdb forth_core_one_minus.xt
26F8: 07D1 9827 | .L50 fdb forth_core_question_dupe.xt
26FA: 057E 9828 | fdb forth_core_zero_equals.xt
26FC: 0CD1 9829 | fdb forth_core_if.runtime_xt
26FE: 2702 9830 | fdb .L56
2700: 0C1A 9831 | fdb forth_core_exit.xt
2702: 1430 9832 | .L56 fdb forth_core_ext_again.runtime_xt
2704: 269A 9833 | fdb .L3
2706: 05FD 9834 | .L58 fdb forth_core_two_drop.xt
2708: 1738 9835 | fdb forth_core_ext_refill.xt
270A: 057E 9836 | fdb forth_core_zero_equals.xt
270C: 11CF 9837 | fdb forth_core_until.runtime_xt
270E: 269A 9838 | fdb .L3
2710: 0A65 9839 | fdb forth_core_drop.xt
2712: 0C1A 9840 | fdb forth_core_exit.xt
9841 |
9842 | ;**********************************************************************
9843 |
2714: 9844 | forth_tools_ext_bracket_if ; ( flag -- )
2714: 268A 9845 | fdb forth_tools_ext_bracket_else
2716: 8004 9846 | fdb _IMMED :: .xt - .name
2718: 5B49465D 9847 | .name fcc "[IF]"
271C: 0678 9848 | .xt fdb forth_core_colon.runtime
9849 | ;=======================================================
9850 | ; : [IF] 0= IF POSTPONE [ELSE] THEN ; IMMEDIATE
9851 | ;=======================================================
271E: 057E 9852 | fdb forth_core_zero_equals.xt
2720: 0CD1 9853 | fdb forth_core_if.runtime_xt
2722: 2726 9854 | fdb .L1
2724: 2694 9855 | fdb forth_tools_ext_bracket_else.xt
2726: 0C1A 9856 | .L1 fdb forth_core_exit.xt
9857 |
9858 | ;**********************************************************************
9859 |
2728: 9860 | forth_tools_ext_bracket_then ; ( -- )
2728: 2714 9861 | fdb forth_tools_ext_bracket_if
272A: 8006 9862 | fdb _IMMED :: .xt - .name
272C: 5B5448454E5D 9863 | .name fcc "[THEN]"
2732: 0678 9864 | .xt fdb forth_core_colon.runtime
9865 | ;================================
9866 | ; : [THEN] ; IMMEDIATE
9867 | ;================================
2734: 0C1A 9868 | fdb forth_core_exit.xt
9869 |
9870 | ;**********************************************************************
9871 |
2736: 9872 | forth_tools_ext_bracket_undefined ; ( "name..." -- flag )
2736: 2728 9873 | fdb forth_tools_ext_bracket_then
2738: 800B 9874 | fdb _IMMED :: .xt - .name
273A: 5B554E444546... 9875 | .name fcc "[UNDEFINED]"
2745: 0678 9876 | .xt fdb forth_core_colon.runtime
9877 | ;===============================================
9878 | ; : [UNDEFINED] BL WORD FIND NIP 0= ; IMMEDIATE
9879 | ;===============================================
2747: 08C9 9880 | fdb forth_core_b_l.xt
2749: 1217 9881 | fdb forth_core_word.xt
274B: 2780 9882 | fdb forth_search_find.xt
274D: 1649 9883 | fdb forth_core_ext_nip.xt
274F: 057E 9884 | fdb forth_core_zero_equals.xt
2751: 0C1A 9885 | fdb forth_core_exit.xt
9886 |
9887 | ;**********************************************************************
9888 | ; SEARCH
9889 | ;**********************************************************************
9890 |
2753: 9891 | forth_search_definitions ; ( -- )
2753: 2736 9892 | fdb forth_tools_ext_bracket_undefined
2755: 000B 9893 | fdb .xt - .name
2757: 444546494E49... 9894 | .name fcc "DEFINITIONS"
2762: 0678 9895 | .xt fdb forth_core_colon.runtime
9896 | ;============================================================
9897 | ; : DEFINITIONS GET-ORDER OVER SET-CURRENT 0 DO DROP LOOP ;
9898 | ;============================================================
2764: 2819 9899 | fdb forth_search_get_order.xt
2766: 0EA4 9900 | fdb forth_core_over.xt
2768: 2896 9901 | fdb forth_search_set_current.xt
276A: 0D84 9902 | fdb forth_core_literal.runtime_xt
276C: 0000 9903 | fdb 0
276E: 0A2A 9904 | fdb forth_core_do.runtime_xt
2770: 0A65 9905 | .L1 fdb forth_core_drop.xt
2772: 0D9E 9906 | fdb forth_core_loop.runtime_xt
2774: 2770 9907 | fdb .L1
2776: 0C1A 9908 | fdb forth_core_exit.xt
9909 |
9910 | ;**********************************************************************
9911 |
9912 | Lcaddr set 5
9913 | Lu set 3
9914 | Lwid set 1
9915 | Lcnt set 0
9916 |
2778: 9917 | forth_search_find ; ( c-addr -- c-addr 0 | xt 1 | xt -1 )
2778: 2753 9918 | fdb forth_search_definitions
277A: 0004 9919 | fdb .xt - .name
277C: 46494E44 9920 | .name fcc "FIND"
2780: 2782 9921 | .xt fdb .body
9922 |
9923 | ;-----------------------------------------------------------------
9924 | ; Per 13.3.3.1, we need to find locals, but we don't have to
9925 | ; advertise the actual wid for them. FIND is the only word that
9926 | ; scans a search order, so we "hide" searching the local wid
9927 | ; here---if it exists, it is scanned first.
9928 | ;-----------------------------------------------------------------
9929 |
2782: 37 10 9930 | .body pulu x ; get caddr
2784: 4F 9931 | clra
2785: E6 80 9932 | ldb ,x+ ; extract length
2787: 34 16 9933 | pshs x,d ; save c-caddr u
2789: 32 7D 9934 | leas -3,s ; adjust stack in case we match
278B: 36 16 9935 | pshu x,d ; also push onto stack
278D: DC 38 9936 | ldd forth__local_wid ; get local wordlist
278F: 27 11 9937 | beq .skip ; no locals, skip searching this wid
2791: CC 0038 9938 | ldd #forth__local_wid
2794: 36 06 9939 | pshu d ; push wid
2796: 8E 284B 9940 | ldx #forth_search_search_wordlist.xt
2799: 17 E468 9941 | lbsr forth_core_execute.asm
279C: EC C4 9942 | ldd ,u ; found?
279E: 26 37 9943 | bne .done ; if so, we're done
27A0: 33 5E 9944 | leau -2,u ; if not, adjust parameter stack
27A2: 32 63 9945 | .skip leas 3,s ; adjust return stack, no match
27A4: 33 44 9946 | leau 4,u ; fix paramter stack
27A6: 8E 0048 9947 | ldx #forth__widlist ; get list of wids
27A9: D6 47 9948 | ldb forth__widnum+1 ; get # wids
27AB: 27 22 9949 | beq .none
27AD: 34 14 9950 | pshs x,b ; save widlist and count
27AF: EC 65 9951 | .again ldd Lcaddr,s ; push c-addr
27B1: 36 06 9952 | pshu d
27B3: EC 63 9953 | ldd Lu,s ; push u
27B5: 36 06 9954 | pshu d
27B7: AE 61 9955 | ldx Lwid,s ; get wid array
27B9: EC 81 9956 | ldd ,x++ ; get wid
27BB: AF 61 9957 | stx Lwid,s ; save pointer to next
27BD: 36 06 9958 | pshu d ; push wid
27BF: 8E 284B 9959 | ldx #forth_search_search_wordlist.xt
27C2: 17 E43F 9960 | lbsr forth_core_execute.asm
27C5: EC C4 9961 | ldd ,u ; did we fine it?
27C7: 26 0E 9962 | bne .done ; yup, return data
27C9: 33 42 9963 | leau 2,u
27CB: 6A E4 9964 | dec Lcnt,s ; more?
27CD: 26 E0 9965 | bne .again ; loop for more
27CF: AE 65 9966 | .none ldx Lcaddr,s ; get c-addr
27D1: 30 1F 9967 | leax -1,x ; readjust to caddr
27D3: 4F 9968 | clra ; 0
27D4: 5F 9969 | clrb
27D5: 36 16 9970 | pshu x,d ; push caddr 0
27D7: 32 67 9971 | .done leas 7,s ; burn local vars
27D9: AE A1 9972 | ldx ,y++ ; NEXT
27DB: 6E 94 9973 | jmp [,x]
9974 |
9975 | ;--------------------------------------------
9976 |
9977 | .test "FIND */MOD (word in one searchlist)"
9978 | .opt test pokew forth__local_wid , 0
9979 | .opt test pokew forth__widnum , 1
9980 | .opt test pokew forth__widlist , forth__forth_wid
9981 | .opt test prot n , ._n11
9982 | .opt test prot n , ._n12
F2B3: CE F2CD 9983 | ldu #.datastack1
F2B6: 8E 2780 9984 | ldx #forth_search_find.xt
F2B9: BD 0C04 9985 | jsr forth_core_execute.asm
9986 | .assert /u = .datastack1 - 2 , "U"
9987 | .assert @@/,u = -1 , "flag"
9988 | .assert @@/2,u = forth_core_star_slash_mod.xt , "xt"
F2BC: 39 9989 | rts
9990 |
F2BD: 0000 9991 | fdb 0
F2BF: 0000 9992 | fdb 0
F2C1: 0000 9993 | fdb 0
F2C3: 0000 9994 | fdb 0
F2C5: 0000 9995 | fdb 0
F2C7: 0000 9996 | fdb 0
F2C9: 0000 9997 | fdb 0
F2CB: 0000 9998 | fdb 0
F2CD: F2D0 9999 | .datastack1 fdb .word1
F2CF: 00 10000 | ._n11 fcb 0
10001 |
F2D0: 052A2F4D4F44 10002 | .word1 ascii '*/MOD'c
F2D6: 00 10003 | ._n12 fcb 0
10004 | .endtst
10005 |
10006 | ;--------------------------------------------
10007 | ; _Starting Forth_ 1st Edition, pg 16
10008 | ; _Starting Forth_ 2nd Edition, pg 15
10009 | ;--------------------------------------------
10010 |
10011 | .test "FIND XLERB (in one searchlist)"
10012 | .opt test pokew forth__local_wid , 0
10013 | .opt test pokew forth__widnum , 1
10014 | .opt test pokew forth__widlist , forth__forth_wid
10015 | .opt test prot n , ._n21
10016 | .opt test prot n , ._n22
F2D7: CE F2F1 10017 | ldu #.datastack2
F2DA: 8E 2780 10018 | ldx #forth_search_find.xt
F2DD: BD 0C04 10019 | jsr forth_core_execute.asm
10020 | .assert /u = .datastack2 -2 , "U"
10021 | .assert @@/,u = 0 , "flag"
10022 | .assert @@/2,u = .word2 , "c-addr"
F2E0: 39 10023 | rts
10024 |
F2E1: 0000 10025 | fdb 0
F2E3: 0000 10026 | fdb 0
F2E5: 0000 10027 | fdb 0
F2E7: 0000 10028 | fdb 0
F2E9: 0000 10029 | fdb 0
F2EB: 0000 10030 | fdb 0
F2ED: 0000 10031 | fdb 0
F2EF: 0000 10032 | fdb 0
F2F1: F2F4 10033 | .datastack2 fdb .word2
F2F3: 00 10034 | ._n21 fcb 0
10035 |
F2F4: 05584C455242 10036 | .word2 ascii 'XLERB'c
F2FA: 00 10037 | ._n22 fcb 0
10038 | .endtst
10039 |
10040 | ;----------------------------------------------
10041 |
10042 | .test "FIND 2DROP override"
10043 | .opt test pokew forth__local_wid , 0
10044 | .opt test pokew forth__widlist , .wid3
10045 | .opt test pokew forth__widlist + 2 , forth__forth_wid
10046 | .opt test pokew forth__widlist + 2 , .wid3
10047 | .opt test pokew forth__widnum , 2
10048 | .opt test prot n , ._n31
10049 | .opt test prot n , ._n32
10050 |
F2FB: CE F315 10051 | ldu #.datastack3
F2FE: 8E 2780 10052 | ldx #forth_search_find.xt
F301: BD 0C04 10053 | jsr forth_core_execute.asm
10054 | .assert /u = .datastack3 - 2 , "U"
10055 | .assert @@/,u = -1 , "flag"
10056 | .assert @@/2,u = .two_drop3_xt , "xt"
F304: 39 10057 | rts
10058 |
F305: 0000 10059 | fdb 0
F307: 0000 10060 | fdb 0
F309: 0000 10061 | fdb 0
F30B: 0000 10062 | fdb 0
F30D: 0000 10063 | fdb 0
F30F: 0000 10064 | fdb 0
F311: 0000 10065 | fdb 0
F313: 0000 10066 | fdb 0
F315: F318 10067 | .datastack3 fdb .word3
F317: 00 10068 | ._n31 fcb 0
F318: 053244524F50 10069 | .word3 ascii '2DROP'c
F31E: 00 10070 | ._n32 fcb 0
10071 |
F31F: F338 10072 | .wid3 fdb .foobar3
10073 |
F321: 0000 10074 | .two_fetch3 fdb 0
F323: 0002 10075 | fdb .two_fetch3_xt - .two_fetch3_name
F325: 3240 10076 | .two_fetch3_name fcc '2@'
F327: 0678 10077 | .two_fetch3_xt fdb forth_core_colon.runtime
F329: 0C1A 10078 | fdb forth_core_exit.xt
10079 |
F32B: F321 10080 | .two_drop3 fdb .two_fetch3
F32D: 0005 10081 | fdb .two_drop3_xt - .two_drop3_name
F32F: 3244524F50 10082 | .two_drop3_name fcc '2DROP'
F334: 0678 10083 | .two_drop3_xt fdb forth_core_colon.runtime
F336: 0C1A 10084 | fdb forth_core_exit.xt
10085 |
F338: F32B 10086 | .foobar3 fdb .two_drop3
F33A: 0006 10087 | fdb .foobar3_xt - .foobar3_name
F33C: 464F4F424152 10088 | .foobar3_name fcc 'FOOBAR'
F342: 0678 10089 | .foobar3_xt fdb forth_core_colon.runtime
F344: 0C1A 10090 | fdb forth_core_exit.xt
10091 | .endtst
10092 |
10093 | ;----------------------------------------------
10094 |
10095 | .test "FIND 2/ (two wordlists)"
10096 | .opt test pokew forth__local_wid , 0
10097 | .opt test pokew forth__widlist , .wid3
10098 | .opt test pokew forth__widlist + 2 , forth__forth_wid
10099 | .opt test pokew forth__widnum , 2
10100 | .opt test prot n , ._n41
10101 | .opt test prot n , ._n42
10102 |
F346: CE F360 10103 | ldu #.datastack4
F349: 8E 2780 10104 | ldx #forth_search_find.xt
F34C: BD 0C04 10105 | jsr forth_core_execute.asm
10106 | .assert /u = .datastack4 - 2 , "U"
10107 | .assert @@/,u = -1 , "flag"
10108 | .assert @@/2,u = forth_core_two_slash.xt , "xt"
F34F: 39 10109 | rts
10110 |
F350: 0000 10111 | fdb 0
F352: 0000 10112 | fdb 0
F354: 0000 10113 | fdb 0
F356: 0000 10114 | fdb 0
F358: 0000 10115 | fdb 0
F35A: 0000 10116 | fdb 0
F35C: 0000 10117 | fdb 0
F35E: 0000 10118 | fdb 0
F360: F363 10119 | .datastack4 fdb .word4
F362: 00 10120 | ._n41 fcb 0
10121 |
F363: 02322F 10122 | .word4 ascii '2/'c
F366: 00 10123 | ._n42 fcb 0
10124 | .endtst
10125 |
10126 | ;--------------------------------------------
10127 |
10128 | .test "FIND XLERB (in two wordlists)"
10129 | .opt test pokew forth__local_wid , 0
10130 | .opt test pokew forth__widlist , .wid3
10131 | .opt test pokew forth__widlist + 2 , forth__forth_wid
10132 | .opt test pokew forth__widnum , 2
10133 | .opt test prot n , ._n51
10134 | .opt test prot n , ._n52
F367: CE F381 10135 | ldu #.datastack5
F36A: 8E 2780 10136 | ldx #forth_search_find.xt
F36D: BD 0C04 10137 | jsr forth_core_execute.asm
10138 | .assert /u = .datastack5 -2 , "U"
10139 | .assert @@/0,u = 0 , "flag"
10140 | .assert @@/2,u = .word5 , "c-addr"
F370: 39 10141 | rts
10142 |
F371: 0000 10143 | fdb 0
F373: 0000 10144 | fdb 0
F375: 0000 10145 | fdb 0
F377: 0000 10146 | fdb 0
F379: 0000 10147 | fdb 0
F37B: 0000 10148 | fdb 0
F37D: 0000 10149 | fdb 0
F37F: 0000 10150 | fdb 0
F381: F384 10151 | .datastack5 fdb .word5
F383: 00 10152 | ._n51 fcb 0
10153 |
F384: 05584C455242 10154 | .word5 ascii 'XLERB'c
F38A: 00 10155 | ._n52 fcb 0
10156 | .endtst
10157 |
10158 | ;--------------------------------------------
10159 |
10160 | .test "FIND : (with local wid)"
10161 | .opt test pokew forth__local_wid , forth__local_throw
10162 | .opt test prot r , .word6 , .word6 + 1
F38B: CE F3A5 10163 | ldu #.datastack6
F38E: 8E 2780 10164 | ldx #forth_search_find.xt
F391: BD 0C04 10165 | jsr forth_core_execute.asm
10166 | .assert /u = .results6 , "U"
10167 | .assert @@/,u = -1 , "flag"
10168 | .assert @@/2,u = forth_core_colon.xt , "xt"
F394: 39 10169 | rts
10170 |
F395: 0000 10171 | fdb 0
F397: 0000 10172 | fdb 0
F399: 0000 10173 | fdb 0
F39B: 0000 10174 | fdb 0
F39D: 0000 10175 | fdb 0
F39F: 0000 10176 | fdb 0
F3A1: 0000 10177 | fdb 0
F3A3: 0000 10178 | .results6 fdb 0
F3A5: F3A7 10179 | .datastack6 fdb .word6
10180 |
F3A7: 013A 10181 | .word6 ascii ':'c
10182 | .endtst
10183 |
10184 | ;-------------------------------------------
10185 |
10186 | .test "FIND ; ( with local wid) "
10187 | .opt test pokew forth__local_wid , forth__local_throw
F3A9: CE F3C3 10188 | ldu #.datastack7
F3AC: 8E 2780 10189 | ldx #forth_search_find.xt
F3AF: BD 0C04 10190 | jsr forth_core_execute.asm
10191 | .assert /u = .results7 , "U"
10192 | .assert @@/,u = 1 , "flag"
10193 | .assert @@/2,u = forth__local_semicolon.xt , "xt"
F3B2: 39 10194 | rts
10195 |
F3B3: 0000 10196 | fdb 0
F3B5: 0000 10197 | fdb 0
F3B7: 0000 10198 | fdb 0
F3B9: 0000 10199 | fdb 0
F3BB: 0000 10200 | fdb 0
F3BD: 0000 10201 | fdb 0
F3BF: 0000 10202 | fdb 0
F3C1: 0000 10203 | .results7 fdb 0
F3C3: F3C5 10204 | .datastack7 fdb .word7
10205 |
F3C5: 013B 10206 | .word7 ascii ';'c
10207 | .endtst
10208 |
10209 | ;**********************************************************************
10210 |
27DD: 10211 | forth_search_forth_wordlist ; ( -- wid )
27DD: 2778 10212 | fdb forth_search_find
27DF: 000E 10213 | fdb .xt - .name
27E1: 464F5254482D... 10214 | .name fcc "FORTH-WORDLIST"
27EF: 097A 10215 | .xt fdb forth_core_constant.does
10216 | ;==========================================
10217 | ; forth__forth_wid CONSTANT FORTH-WORDLIST
10218 | ;==========================================
27F1: 0012 10219 | fdb forth__forth_wid
10220 |
10221 | ;**********************************************************************
10222 |
27F3: 10223 | forth_search_get_current ; ( -- wid )
27F3: 27DD 10224 | fdb forth_search_forth_wordlist
27F5: 000B 10225 | fdb .xt - .name
27F7: 4745542D4355... 10226 | .name fcc "GET-CURRENT"
2802: 2804 10227 | .xt fdb .body
2804: DC 16 10228 | .body ldd forth__current_wid
2806: 36 06 10229 | pshu d
2808: AE A1 10230 | ldx ,y++
280A: 6E 94 10231 | jmp [,x]
10232 |
10233 | ;**********************************************************************
10234 |
280C: 10235 | forth_search_get_order ; ( -- widn..wid1 n )
280C: 27F3 10236 | fdb forth_search_get_current
280E: 0009 10237 | fdb .xt - .name
2810: 4745542D4F52... 10238 | .name fcc "GET-ORDER"
2819: 281B 10239 | .xt fdb .body
281B: 8E 0048 10240 | .body ldx #forth__widlist ; point to order array
281E: D6 47 10241 | ldb forth__widnum+1 ; get count
2820: 27 0E 10242 | beq .none
2822: 34 04 10243 | pshs b ; save count for loop
2824: 58 10244 | lslb
2825: 3A 10245 | abx
2826: EC 83 10246 | .loop ldd ,--x ; get wordlist
2828: 36 06 10247 | pshu d ; push to datastack
282A: 6A E4 10248 | dec ,s ; loop for more
282C: 26 F8 10249 | bne .loop
282E: 32 61 10250 | leas 1,s ; clean stack
2830: DC 46 10251 | .none ldd forth__widnum ; push # wordlists
2832: 36 06 10252 | pshu d
2834: AE A1 10253 | ldx ,y++ ; NEXT
2836: 6E 94 10254 | jmp [,x]
10255 |
10256 | ;**********************************************************************
10257 |
2838: 10258 | forth_search_search_wordlist ; ( c-addr u wid -- 0 | xt 1 | xt -1 )
2838: 280C 10259 | fdb forth_search_get_order
283A: 000F 10260 | fdb .xt - .name
283C: 534541524348... 10261 | .name fcc "SEARCH-WORDLIST"
284B: 0678 10262 | .xt fdb forth_core_colon.runtime
10263 | ;======================================================
10264 | ; : SEARCH-WORDLIST
10265 | ; ( 1 ) >R FALSE ['] callback R> TRAVERSE-WORDLIST
10266 | ; ( 2 ) NIP NIP DUP 0<> IF
10267 | ; ( 3 ) NAME>COMPILE CASE
10268 | ; ( 4 ) ['] EXECUTE OF 1 ENDOF
10269 | ; ( 5 ) ['] COMPILE, OF -1 ENDOF
10270 | ; ( 6 ) DUP ENDCASE
10271 | ; ( 7 ) THEN ;
10272 | ;======================================================
284D: 07BF 10273 | fdb forth_core_to_r.xt ; ( 1 )
284F: 156D 10274 | fdb forth_core_ext_false.xt
2851: 0D84 10275 | fdb forth_core_literal.runtime_xt
2853: 0226 10276 | fdb forth__private_find_nt_cb_xt
2855: 0FAA 10277 | fdb forth_core_r_from.xt
2857: 2646 10278 | fdb forth_tools_ext_traverse_wordlist.xt
2859: 1649 10279 | fdb forth_core_ext_nip.xt ; ( 2 )
285B: 1649 10280 | fdb forth_core_ext_nip.xt
285D: 0A74 10281 | fdb forth_core_dupe.xt
285F: 0CD1 10282 | fdb forth_core_if.runtime_xt
2861: 2885 10283 | fdb .L1
2863: 2599 10284 | fdb forth_tools_ext_name_to_compile.xt ; ( 3 )
2865: 0D84 10285 | fdb forth_core_literal.runtime_xt ; ( 4 )
2867: 0BFE 10286 | fdb forth_core_execute.xt
2869: 166A 10287 | fdb forth_core_ext_of.runtime_xt
286B: 2875 10288 | fdb .L2
286D: 0D84 10289 | fdb forth_core_literal.runtime_xt
286F: 0001 10290 | fdb 1
2871: 1430 10291 | fdb forth_core_ext_again.runtime_xt
2873: 2881 10292 | fdb .L3
2875: 0D84 10293 | .L2 fdb forth_core_literal.runtime_xt ; ( 5 )
2877: 14AC 10294 | fdb forth_core_ext_compile_comma.xt
2879: 166A 10295 | fdb forth_core_ext_of.runtime_xt
287B: 2881 10296 | fdb .L3
287D: 0D84 10297 | fdb forth_core_literal.runtime_xt
287F: FFFF 10298 | fdb -1
2881: 0A74 10299 | .L3 fdb forth_core_dupe.xt ; ( 6 )
2883: 0A65 10300 | fdb forth_core_drop.xt
2885: 0C1A 10301 | .L1 fdb forth_core_exit.xt
10302 |
10303 | ; ------------------------------------------------------
10304 |
10305 | .test "SEARCH-WORDLIST UNESCAPE (first word in list)"
10306 | .opt test prot n , .nu1
F3C7: CE F3DD 10307 | ldu #.datastack1
F3CA: 8E 284B 10308 | ldx #forth_search_search_wordlist.xt
F3CD: BD 0C04 10309 | jsr forth_core_execute.asm
10310 | .assert /u = .results1 , "U address"
10311 | .assert @@/,u = -1 , "flag"
10312 | .assert @@/2,u = forth_string_ext_unescape.xt , "xt"
F3D0: 39 10313 | rts
10314 |
F3D1: 0000 10315 | fdb 0
F3D3: 0000 10316 | fdb 0
F3D5: 0000 10317 | fdb 0
F3D7: 0000 10318 | fdb 0
F3D9: 0000 10319 | fdb 0
F3DB: 0000 10320 | fdb 0
F3DD: 0012 10321 | .datastack1 fdb forth__forth_wid
F3DF: 0008 10322 | .results1 fdb .wordlen1
F3E1: F3E5 10323 | fdb .word1
F3E3: 0000 10324 | .nu1 fdb 0
10325 |
F3E5: 554E45534341... 10326 | .word1 fcc 'UNESCAPE'
10327 | .wordlen1 equ * - .word1
10328 | .endtst
10329 |
10330 | ;--------------------------------------------------
10331 |
10332 | .test "SEARCH-WORDLIST ORDER (second word in list)"
F3ED: CE F403 10333 | ldu #.datastack2
F3F0: 8E 284B 10334 | ldx #forth_search_search_wordlist.xt
F3F3: BD 0C04 10335 | jsr forth_core_execute.asm
10336 | .assert /u = .results2 , "U address"
10337 | .assert @@/,u = -1 , "flag"
10338 | .assert @@/2,u = forth_search_ext_order.xt, "xt"
F3F6: 39 10339 | rts
10340 |
F3F7: 0000 10341 | fdb 0
F3F9: 0000 10342 | fdb 0
F3FB: 0000 10343 | fdb 0
F3FD: 0000 10344 | fdb 0
F3FF: 0000 10345 | fdb 0
F401: 0000 10346 | fdb 0
F403: 0012 10347 | .datastack2 fdb forth__forth_wid
F405: 0005 10348 | .results2 fdb .wordlen2
F407: F40B 10349 | fdb .word2
F409: 0000 10350 | fdb 0
10351 |
F40B: 4F52444552 10352 | .word2 fcc 'ORDER'
10353 | .wordlen2 equ * - .word2
10354 | .endtst
10355 |
10356 | ;----------------------------------
10357 |
10358 | .test "SEARCH-WORDLIST */MOD"
F410: CE F426 10359 | ldu #.datastack3
F413: 8E 284B 10360 | ldx #forth_search_search_wordlist.xt
F416: BD 0C04 10361 | jsr forth_core_execute.asm
10362 | .assert /u = .results3 , "U address"
10363 | .assert @@/,u = -1 , "flag"
10364 | .assert @@/2,u = forth_core_star_slash_mod.xt , "xt"
F419: 39 10365 | rts
10366 |
F41A: 0000 10367 | fdb 0
F41C: 0000 10368 | fdb 0
F41E: 0000 10369 | fdb 0
F420: 0000 10370 | fdb 0
F422: 0000 10371 | fdb 0
F424: 0000 10372 | fdb 0
F426: 0012 10373 | .datastack3 fdb forth__forth_wid
F428: 0005 10374 | .results3 fdb .wordlen3
F42A: F42E 10375 | fdb .word3
F42C: 0000 10376 | fdb 0
10377 |
F42E: 2A2F4D4F44 10378 | .word3 fcc '*/MOD'
10379 | .wordlen3 equ * - .word3
10380 | .endtst
10381 |
10382 | ;--------------------------------
10383 |
10384 | .test "SEARCH-WORDLIST XLERB"
F433: CE F449 10385 | ldu #.datastack5
F436: 8E 284B 10386 | ldx #forth_search_search_wordlist.xt
F439: BD 0C04 10387 | jsr forth_core_execute.asm
10388 | .assert /u = .results5 , "U address"
10389 | .assert @@/,u = 0 , "flag"
F43C: 39 10390 | rts
10391 |
F43D: 0000 10392 | fdb 0
F43F: 0000 10393 | fdb 0
F441: 0000 10394 | fdb 0
F443: 0000 10395 | fdb 0
F445: 0000 10396 | fdb 0
F447: 0000 10397 | fdb 0
F449: 0012 10398 | .datastack5 fdb forth__forth_wid
F44B: 0005 10399 | fdb .wordlen5
F44D: F451 10400 | .results5 fdb .word5
F44F: 0000 10401 | fdb 0
10402 |
F451: 584C455242 10403 | .word5 fcc 'XLERB'
10404 | .wordlen5 equ * - .word5
10405 | .endtst
10406 |
10407 | ;**********************************************************************
10408 |
2887: 10409 | forth_search_set_current ; ( wid -- )
2887: 2838 10410 | fdb forth_search_search_wordlist
2889: 000B 10411 | fdb .xt - .name
288B: 5345542D4355... 10412 | .name fcc "SET-CURRENT"
2896: 2898 10413 | .xt fdb .body
2898: 37 06 10414 | .body pulu d
289A: DD 16 10415 | std forth__current_wid
289C: AE A1 10416 | ldx ,y++
289E: 6E 94 10417 | jmp [,x]
10418 |
10419 | ;**********************************************************************
10420 |
28A0: 10421 | forth_search_set_order ; ( widn..wid1 n -- )
28A0: 2887 10422 | fdb forth_search_set_current
28A2: 0009 10423 | fdb .xt - .name
28A4: 5345542D4F52... 10424 | .name fcc "SET-ORDER"
28AD: 28AF 10425 | .xt fdb .body
28AF: 37 06 10426 | .body pulu d ; get n
28B1: 1083 FFFF 10427 | cmpd #-1 ; default?
28B5: 27 1D 10428 | beq .default
28B7: 10B3 0B96 10429 | cmpd forth__env_wordlists.body
28BB: 2E 24 10430 | bgt .throw_too_many
28BD: DD 46 10431 | std forth__widnum ; save # wordlists
28BF: 27 0F 10432 | beq .done
28C1: 34 04 10433 | pshs b
28C3: 8E 0048 10434 | ldx #forth__widlist ; and point to end
28C6: 37 06 10435 | .loop pulu d ; get wordlist
28C8: ED 81 10436 | std ,x++ ; save in list
28CA: 6A E4 10437 | dec ,s ; keep looping
28CC: 26 F8 10438 | bne .loop
28CE: 32 61 10439 | leas 1,s
28D0: AE A1 10440 | .done ldx ,y++ ; NEXT
28D2: 6E 94 10441 | jmp [,x]
28D4: DC 12 10442 | .default ldd forth__forth_wid ; set default FORTH wordlist
28D6: DD 48 10443 | std forth__widlist
28D8: CC 0001 10444 | ldd #1
28DB: DD 46 10445 | std forth__widnum
28DD: AE A1 10446 | ldx ,y++ ; NEXT
28DF: 6E 94 10447 | jmp [,x]
28E1: CC FFCF 10448 | .throw_too_many ldd #-49
28E4: 16 F5D3 10449 | lbra forth_exception_throw.asm
10450 |
10451 | ;**********************************************************************
10452 |
28E7: 10453 | forth_search_wordlist ; ( -- wid )
28E7: 28A0 10454 | fdb forth_search_set_order
28E9: 0008 10455 | fdb .xt - .name
28EB: 574F52444C49... 10456 | .name fcc "WORDLIST"
28F3: 28F5 10457 | .xt fdb .body
28F5: 9E 10 10458 | .body ldx forth__here ; allocate wid
28F7: 36 10 10459 | pshu x ; return it
28F9: 6F 80 10460 | clr ,x+ ; set wid to empty
28FB: 6F 80 10461 | clr ,x+
28FD: 9F 10 10462 | stx forth__here
28FF: AE A1 10463 | ldx ,y++ ; NEXT
2901: 6E 94 10464 | jmp [,x]
10465 |
10466 | ;**********************************************************************
10467 | ; SEARCH-EXT
10468 | ;**********************************************************************
10469 |
2903: 10470 | forth_search_ext_also ; ( -- )
2903: 28E7 10471 | fdb forth_search_wordlist
2905: 0004 10472 | fdb .xt - .name
2907: 414C534F 10473 | .name fcc "ALSO"
290B: 0678 10474 | .xt fdb forth_core_colon.runtime
10475 | ;===================================================
10476 | ; : ALSO GET-ORDER OVER SWAP 1+ SET-ORDER ;
10477 | ;===================================================
290D: 2819 10478 | fdb forth_search_get_order.xt
290F: 0EA4 10479 | fdb forth_core_over.xt
2911: 10FC 10480 | fdb forth_core_swap.xt
2913: 058E 10481 | fdb forth_core_one_plus.xt
2915: 28AD 10482 | fdb forth_search_set_order.xt
2917: 0C1A 10483 | fdb forth_core_exit.xt
10484 |
10485 | ;**********************************************************************
10486 |
2919: 10487 | forth_search_ext_forth ; ( -- )
2919: 2903 10488 | fdb forth_search_ext_also
291B: 0005 10489 | fdb .xt - .name
291D: 464F525448 10490 | .name fcc "FORTH"
2922: 0678 10491 | .xt fdb forth_core_colon.runtime
10492 | ;====================================================
10493 | ; : FORTH GET-ORDER NIP FORTH-WORDLIST SWAP SET-ORDER ;
10494 | ;====================================================
2924: 2819 10495 | fdb forth_search_get_order.xt
2926: 1649 10496 | fdb forth_core_ext_nip.xt
2928: 27EF 10497 | fdb forth_search_forth_wordlist.xt
292A: 10FC 10498 | fdb forth_core_swap.xt
292C: 28AD 10499 | fdb forth_search_set_order.xt
292E: 0C1A 10500 | fdb forth_core_exit.xt
10501 |
10502 | ;**********************************************************************
10503 |
2930: 10504 | forth_search_ext_only ; ( -- )
2930: 2919 10505 | fdb forth_search_ext_forth
2932: 0004 10506 | fdb .xt - .name
2934: 4F4E4C59 10507 | .name fcc "ONLY"
2938: 0678 10508 | .xt fdb forth_core_colon.runtime
10509 | ;=======================================================
10510 | ; : ONLY -1 SET-ORDER ;
10511 | ;=======================================================
293A: 0D84 10512 | fdb forth_core_literal.runtime_xt
293C: FFFF 10513 | fdb -1
293E: 28AD 10514 | fdb forth_search_set_order.xt
2940: 0C1A 10515 | fdb forth_core_exit.xt
10516 |
10517 | ;**********************************************************************
10518 |
2942: 10519 | forth_search_ext_order ; ( -- )
2942: 2930 10520 | fdb forth_search_ext_only
2944: 0005 10521 | fdb .xt - .name
2946: 4F52444552 10522 | .name fcc "ORDER"
294B: 0678 10523 | .xt fdb forth_core_colon.runtime
10524 | ;================================================
10525 | ; : ORDER
10526 | ; ." Wordlist order" CR
10527 | ; GET-ORDER 0 DO U. CR LOOP
10528 | ; ." Current wordlist" CR
10529 | ; GET-CURRENT U. CR ;
10530 | ;================================================
294D: 2B7C 10531 | fdb forth_string_sliteral.runtime_xt
294F: 000E 10532 | fdb .len1
2951: 576F72646C69... 10533 | .text1 fcc 'Wordlist order'
10534 | .len1 equ * - .text1
295F: 1124 10535 | fdb forth_core_type.xt
2961: 099E 10536 | fdb forth_core_c_r.xt
2963: 2819 10537 | fdb forth_search_get_order.xt
2965: 0D84 10538 | fdb forth_core_literal.runtime_xt
2967: 0000 10539 | fdb 0
2969: 0A2A 10540 | fdb forth_core_do.runtime_xt
296B: 1144 10541 | .L1 fdb forth_core_u_dot.xt
296D: 099E 10542 | fdb forth_core_c_r.xt
296F: 0D9E 10543 | fdb forth_core_loop.runtime_xt
2971: 296B 10544 | fdb .L1
2973: 2B7C 10545 | fdb forth_string_sliteral.runtime_xt
2975: 0010 10546 | fdb .len2
2977: 43757272656E... 10547 | .text2 fcc 'Current wordlist'
10548 | .len2 equ * - .text2
2987: 1124 10549 | fdb forth_core_type.xt
2989: 099E 10550 | fdb forth_core_c_r.xt
298B: 2802 10551 | fdb forth_search_get_current.xt
298D: 1144 10552 | fdb forth_core_u_dot.xt
298F: 099E 10553 | fdb forth_core_c_r.xt
2991: 0C1A 10554 | fdb forth_core_exit.xt
10555 |
10556 | ;**********************************************************************
10557 |
2993: 10558 | forth_search_ext_previous ; ( -- )
2993: 2942 10559 | fdb forth_search_ext_order
2995: 0008 10560 | fdb .xt - .name
2997: 50524556494F... 10561 | .name fcc "PREVIOUS"
299F: 0678 10562 | .xt fdb forth_core_colon.runtime
10563 | ;==================================================
10564 | ; : PREVIOUS GET-ORDER NIP 1- SET-ORDER ;
10565 | ;==================================================
29A1: 2819 10566 | fdb forth_search_get_order.xt
29A3: 1649 10567 | fdb forth_core_ext_nip.xt
29A5: 059E 10568 | fdb forth_core_one_minus.xt
29A7: 28AD 10569 | fdb forth_search_set_order.xt
29A9: 0C1A 10570 | fdb forth_core_exit.xt
10571 |
10572 | ;**********************************************************************
10573 | ; STRING
10574 | ;**********************************************************************
10575 |
29AB: 10576 | forth_string_dash_trailing ; ( c-addr u1 -- c-addr u2 )
29AB: 2993 10577 | fdb forth_search_ext_previous
29AD: 0009 10578 | fdb .xt - .name
29AF: 2D545241494C... 10579 | .name fcc "-TRAILING"
29B8: 0678 10580 | .xt fdb forth_core_colon.runtime
10581 | ;=======================================================
10582 | ; : -TRAILING
10583 | ; DUP 0= IF EXIT THEN
10584 | ; 1- CHARS DUP >R OVER +
10585 | ; 0 R> DO
10586 | ; DUP C@ BL = IF
10587 | ; 1 CHARS -
10588 | ; ELSE
10589 | ; DROP I 1+ UNLOOP EXIT
10590 | ; THEN
10591 | ; -1 +LOOP DROP 0;
10592 | ;=======================================================
29BA: 0A74 10593 | fdb forth_core_dupe.xt
29BC: 057E 10594 | fdb forth_core_zero_equals.xt
29BE: 0CD1 10595 | fdb forth_core_if.runtime_xt
29C0: 29C4 10596 | fdb .L1
29C2: 0C1A 10597 | fdb forth_core_exit.xt
29C4: 059E 10598 | .L1 fdb forth_core_one_minus.xt
29C6: 0962 10599 | fdb forth_core_chars.xt
29C8: 0A74 10600 | fdb forth_core_dupe.xt
29CA: 07BF 10601 | fdb forth_core_to_r.xt
29CC: 0EA4 10602 | fdb forth_core_over.xt
29CE: 046B 10603 | fdb forth_core_plus.xt
29D0: 0D84 10604 | fdb forth_core_literal.runtime_xt
29D2: 0000 10605 | fdb 0
29D4: 0FAA 10606 | fdb forth_core_r_from.xt
29D6: 0A2A 10607 | fdb forth_core_do.runtime_xt
29D8: 0A74 10608 | .L2 fdb forth_core_dupe.xt
29DA: 08F9 10609 | fdb forth_core_c_fetch.xt
29DC: 08C9 10610 | fdb forth_core_b_l.xt
29DE: 06D9 10611 | fdb forth_core_equals.xt
29E0: 0CD1 10612 | fdb forth_core_if.runtime_xt
29E2: 29F0 10613 | fdb .L3
29E4: 0D84 10614 | fdb forth_core_literal.runtime_xt
29E6: 0001 10615 | fdb 1
29E8: 0962 10616 | fdb forth_core_chars.xt
29EA: 0506 10617 | fdb forth_core_minus.xt
29EC: 1430 10618 | fdb forth_core_ext_again.runtime_xt
29EE: 29FA 10619 | fdb .L4
29F0: 0A65 10620 | .L3 fdb forth_core_drop.xt
29F2: 0CAC 10621 | fdb forth_core_i.xt
29F4: 058E 10622 | fdb forth_core_one_plus.xt
29F6: 11AB 10623 | fdb forth_core_unloop.xt
29F8: 0C1A 10624 | fdb forth_core_exit.xt
29FA: 0D84 10625 | .L4 fdb forth_core_literal.runtime_xt
29FC: FFFF 10626 | fdb -1
29FE: 04CA 10627 | fdb forth_core_plus_loop.runtime_xt
2A00: 29D8 10628 | fdb .L2
2A02: 0A65 10629 | fdb forth_core_drop.xt
2A04: 0D84 10630 | fdb forth_core_literal.runtime_xt
2A06: 0000 10631 | fdb 0
2A08: 0C1A 10632 | fdb forth_core_exit.xt
10633 |
10634 | ;--------------------------------------------
10635 |
10636 | .test 'S" " -TRAILING'
10637 | .opt test prot n , .n1
F456: CE F464 10638 | ldu #.datastack1
F459: 8E 29B8 10639 | ldx #forth_string_dash_trailing.xt
F45C: BD 0C04 10640 | jsr forth_core_execute.asm
10641 | .assert /u = .datastack1 , "U"
10642 | .assert @@/,u = 0 , ",U"
10643 | .assert @@/2,u = .text1 , "2,U"
F45F: 39 10644 | rts
10645 |
F460: 0000 10646 | fdb 0
F462: 0000 10647 | fdb 0
F464: 0000 10648 | .datastack1 fdb .text1_len
F466: F468 10649 | fdb .text1
10650 | .text1 equ *
10651 | .text1_len equ * - .text1
F468: 00 10652 | .n1 fcb 0
10653 | .endtst
10654 |
10655 | ;--------------------------------------------
10656 |
10657 | .test 'S" ONE " -TRAILING'
10658 | .opt test prot n , .n21
10659 | .opt test prot n , .n22
F469: CE F479 10660 | ldu #.datastack2
F46C: 8E 29B8 10661 | ldx #forth_string_dash_trailing.xt
F46F: BD 0C04 10662 | jsr forth_core_execute.asm
10663 | .assert /u = .datastack2 , "U"
10664 | .assert @@/,u = 3 , ",U"
10665 | .assert @@/2,u = .text2 , "2,U"
F472: 39 10666 | rts
10667 |
F473: 0000 10668 | fdb 0
F475: 0000 10669 | fdb 0
F477: 0000 10670 | fdb 0
F479: 0006 10671 | .datastack2 fdb .text2_len
F47B: F47E 10672 | fdb .text2
10673 |
F47D: 00 10674 | .n21 fcb 0
F47E: 4F4E45202020 10675 | .text2 fcc 'ONE '
10676 | .text2_len equ * - .text2
F484: 00 10677 | .n22 fcb 0
10678 | .endtst
10679 |
10680 | ;------------------------------------------
10681 |
10682 | .test 'S" ONE" -TRAILING'
10683 | .opt test prot n , .n31
10684 | .opt test prot n , .n32
F485: CE F493 10685 | ldu #.datastack3
F488: 8E 29B8 10686 | ldx #forth_string_dash_trailing.xt
F48B: BD 0C04 10687 | jsr forth_core_execute.asm
10688 | .assert /u = .datastack3 , "U"
10689 | .assert @@/,u = 3 , ",U"
10690 | .assert @@/2,u = .text3 , "2,U"
F48E: 39 10691 | rts
10692 |
F48F: 0000 10693 | fdb 0
F491: 0000 10694 | fdb 0
F493: 0003 10695 | .datastack3 fdb .text3_len
F495: F498 10696 | fdb .text3
10697 |
F497: 00 10698 | .n31 fcb 0
F498: 4F4E45 10699 | .text3 fcc 'ONE'
10700 | .text3_len equ * - .text3
F49B: 00 10701 | .n32 fcb 0
10702 | .endtst
10703 |
10704 | ;---------------------------------------
10705 |
10706 | .test 'S" " -TRAILING'
10707 | .opt test prot n , .n41
10708 | .opt test prot n , .n42
F49C: CE F4AA 10709 | ldu #.datastack4
F49F: 8E 29B8 10710 | ldx #forth_string_dash_trailing.xt
F4A2: BD 0C04 10711 | jsr forth_core_execute.asm
10712 | .assert /u = .datastack4 , "U"
10713 | .assert @@/,u = 0 , ",U"
10714 | .assert @@/2,u = .text4 , "2,U"
F4A5: 39 10715 | rts
10716 |
F4A6: 0000 10717 | fdb 0
F4A8: 0000 10718 | fdb 0
F4AA: 0003 10719 | .datastack4 fdb .text4_len
F4AC: F4AF 10720 | fdb .text4
10721 |
F4AE: 00 10722 | .n41 fcb 0
F4AF: 202020 10723 | .text4 fcc ' '
10724 | .text4_len equ * - .text4
F4B2: 00 10725 | .n42 fcb 0
10726 | .endtst
10727 |
10728 | ;**********************************************************************
10729 |
2A0A: 10730 | forth_string_slash_string ; ( c-addr1 u1 n -- c-addr2 u2 )
2A0A: 29AB 10731 | fdb forth_string_dash_trailing
2A0C: 0007 10732 | fdb .xt - .name
2A0E: 2F535452494E... 10733 | .name fcc "/STRING"
2A15: 0678 10734 | .xt fdb forth_core_colon.runtime
10735 | ;==========================================
10736 | ; : /STRING DUP >R - SWAP R> + SWAP
10737 | ;==========================================
2A17: 0A74 10738 | fdb forth_core_dupe.xt
2A19: 07BF 10739 | fdb forth_core_to_r.xt
2A1B: 0506 10740 | fdb forth_core_minus.xt
2A1D: 10FC 10741 | fdb forth_core_swap.xt
2A1F: 0FAA 10742 | fdb forth_core_r_from.xt
2A21: 046B 10743 | fdb forth_core_plus.xt
2A23: 10FC 10744 | fdb forth_core_swap.xt
2A25: 0C1A 10745 | fdb forth_core_exit.xt
10746 |
10747 | ;----------------------------------------------
10748 |
10749 | .test 'S" ABC" 2 /STRING'
F4B3: CE F4BF 10750 | ldu #.datastack1
F4B6: 8E 2A15 10751 | ldx #forth_string_slash_string.xt
F4B9: BD 0C04 10752 | jsr forth_core_execute.asm
10753 | .assert /u = .results1 , "U"
10754 | .assert @@/,u = .text1_len - 2 , ",U"
10755 | .assert @@/2,u = .text1 + 2 , "2,U"
10756 | .assert @@/2,u = "C" , "='C'"
F4BC: 39 10757 | rts
10758 |
F4BD: 0000 10759 | fdb 0
F4BF: 0002 10760 | .datastack1 fdb 2
F4C1: 0003 10761 | .results1 fdb .text1_len
F4C3: F4C5 10762 | fdb .text1
10763 |
F4C5: 414243 10764 | .text1 fcc 'ABC'
10765 | .text1_len equ * - .text1
10766 |
10767 | .endtst
10768 |
10769 | .test 'S" ABC" 2 /STRING -1 /STRING'
F4C8: CE F4DF 10770 | ldu #.datastack2
F4CB: 8E 2A15 10771 | ldx #forth_string_slash_string.xt
F4CE: BD 0C04 10772 | jsr forth_core_execute.asm
10773 |
F4D1: CC FFFF 10774 | ldd #-1
F4D4: 36 06 10775 | pshu d
F4D6: 8E 2A15 10776 | ldx #forth_string_slash_string.xt
F4D9: BD 0C04 10777 | jsr forth_core_execute.asm
10778 | .assert /u = .results2 , "U"
10779 | .assert @@/,u = 2 , ",U"
10780 | .assert @@/2,u = .text2 + 1 , "2,U"
10781 | .assert @@/2,u = "BC" , "='BC'"
F4DC: 39 10782 | rts
10783 |
F4DD: 0000 10784 | fdb 0
F4DF: 0002 10785 | .datastack2 fdb 2
F4E1: 0003 10786 | .results2 fdb .text2_len
F4E3: F4E5 10787 | fdb .text2
10788 |
F4E5: 414243 10789 | .text2 fcc 'ABC'
10790 | .text2_len equ * - .text2
10791 | .endtst
10792 |
10793 | ;**********************************************************************
10794 |
2A27: 10795 | forth_string_blank ; ( c-addr u -- )
2A27: 2A0A 10796 | fdb forth_string_slash_string
2A29: 0005 10797 | fdb .xt - .name
2A2B: 424C414E4B 10798 | .name fcc "BLANK"
2A30: 0678 10799 | .xt fdb forth_core_colon.runtime
10800 | ;==========================================
10801 | ; : BLANK BL FILL ;
10802 | ;==========================================
2A32: 08C9 10803 | fdb forth_core_b_l.xt
2A34: 0C2A 10804 | fdb forth_core_fill.xt
2A36: 0C1A 10805 | fdb forth_core_exit.xt
10806 |
10807 | ;**********************************************************************
10808 |
2A38: 10809 | forth_string_c_move ; ( c-addr1 c-addr2 u -- )
2A38: 2A27 10810 | fdb forth_string_blank
2A3A: 0005 10811 | fdb .xt - .name
2A3C: 434D4F5645 10812 | .name fcc "CMOVE"
2A41: 2A43 10813 | .xt fdb .body
2A43: 34 60 10814 | .body pshs y,u
2A45: 37 36 10815 | pulu y,x,d
2A47: 1F 03 10816 | tfr d,u
2A49: 1183 0000 10817 | .copy cmpu #0
2A4D: 27 08 10818 | beq .done
2A4F: A6 A0 10819 | lda ,y+
2A51: A7 80 10820 | sta ,x+
2A53: 33 5F 10821 | leau -1,u
2A55: 20 F2 10822 | bra .copy
2A57: 35 60 10823 | .done puls y,u
2A59: 33 46 10824 | leau 6,u
2A5B: AE A1 10825 | ldx ,y++
2A5D: 6E 94 10826 | jmp [,x]
10827 |
10828 | ;-------------------------------------------------
10829 |
10830 | .test "CMOVE"
10831 | .opt test prot n , .results , .results + 1
10832 | .opt test prot n , ._n1
10833 | .opt test prot n , ._n2
F4E8: CE F4F4 10834 | ldu #.datastack
F4EB: 8E 2A41 10835 | ldx #forth_string_c_move.xt
F4EE: BD 0C04 10836 | jsr forth_core_execute.asm
10837 | .assert /u = .results , "U"
10838 | .assert .addr2 = "FOOBAR" , "FOOBAR"
F4F1: 39 10839 | rts
10840 |
F4F2: 0000 10841 | fdb 0
F4F4: 0006 10842 | .datastack fdb .size
F4F6: F503 10843 | fdb .addr2
F4F8: F4FC 10844 | fdb .addr1
F4FA: 0000 10845 | .results fdb 0
10846 |
F4FC: 464F4F424152 10847 | .addr1 fcc 'FOOBAR'
10848 | .size equ * - .addr1
F502: 00 10849 | ._n1 fcb 0
F503: 10850 | .addr2 rmb .size
F509: 00 10851 | ._n2 fcb 0
10852 | .endtst
10853 |
10854 | ;**********************************************************************
10855 |
2A5F: 10856 | forth_string_c_move_up ; ( c-addr1 c-addr2 u )
2A5F: 2A38 10857 | fdb forth_string_c_move
2A61: 0006 10858 | fdb .xt - .name
2A63: 434D4F56453E 10859 | .name fcc "CMOVE>"
2A69: 2A6B 10860 | .xt fdb .body
2A6B: 34 60 10861 | .body pshs u,y
2A6D: 37 36 10862 | pulu y,x,d
2A6F: 30 8B 10863 | leax d,x
2A71: 31 AB 10864 | leay d,y
2A73: 1F 03 10865 | tfr d,u
2A75: 1183 0000 10866 | .copy cmpu #0
2A79: 27 08 10867 | beq .done
2A7B: A6 A2 10868 | lda ,-y
2A7D: A7 82 10869 | sta ,-x
2A7F: 33 5F 10870 | leau -1,u
2A81: 20 F2 10871 | bra .copy
2A83: 35 60 10872 | .done puls u,y
2A85: 33 46 10873 | leau 6,u
2A87: AE A1 10874 | ldx ,y++
2A89: 6E 94 10875 | jmp [,x]
10876 |
10877 | ;-------------------------------------------------
10878 |
10879 | .test "CMOVE>"
10880 | .opt test prot n , .results , .results + 1
10881 | .opt test prot n , ._n1
10882 | .opt test prot n , ._n2
F50A: CE F516 10883 | ldu #.datastack
F50D: 8E 2A69 10884 | ldx #forth_string_c_move_up.xt
F510: BD 0C04 10885 | jsr forth_core_execute.asm
10886 | .assert /u = .results , "U"
10887 | .assert .addr2 = "FOOBAR" , "FOOBAR"
F513: 39 10888 | rts
10889 |
F514: 0000 10890 | fdb 0
F516: 0006 10891 | .datastack fdb .size
F518: F525 10892 | fdb .addr2
F51A: F51E 10893 | fdb .addr1
F51C: 0000 10894 | .results fdb 0
10895 |
F51E: 464F4F424152 10896 | .addr1 fcc 'FOOBAR'
10897 | .size equ * - .addr1
F524: 00 10898 | ._n1 fcb 0
F525: 10899 | .addr2 rmb .size
F52B: 00 10900 | ._n2 fcb 0
10901 | .endtst
10902 |
10903 | ;**********************************************************************
10904 |
10905 | Lcaddr2 set 12
10906 | Lu2 set 10
10907 | Lcaddr1 set 8
10908 | Lu1 set 6
10909 | Lu set 4
10910 | Ly set 2
10911 | Lpreresult set 0
10912 |
2A8B: 10913 | forth_string_compare ; ( c-addr1 u1 c-addr2 u2 -- n )
2A8B: 2A5F 10914 | fdb forth_string_c_move_up
2A8D: 0007 10915 | fdb .xt - .name
2A8F: 434F4D504152... 10916 | .name fcc "COMPARE"
2A96: 2A98 10917 | .xt fdb .body
2A98: 37 16 10918 | .body pulu x,d
2A9A: 34 16 10919 | pshs x,d
2A9C: 37 16 10920 | pulu x,d
2A9E: 34 16 10921 | pshs x,d
2AA0: 34 66 10922 | pshs u,y,d
2AA2: 10AE 66 10923 | ldy Lu1,s
2AA5: 10AC 6A 10924 | cmpy Lu2,s
2AA8: 27 0B 10925 | beq .equal
2AAA: 22 0F 10926 | bhi .greater
2AAC: CC FFFF 10927 | ldd #-1
2AAF: ED E4 10928 | std Lpreresult,s
2AB1: EC 6A 10929 | ldd Lu2,s
2AB3: 20 0E 10930 | bra .continue
2AB5: 4F 10931 | .equal clra
2AB6: 5F 10932 | clrb
2AB7: ED E4 10933 | std Lpreresult,s
2AB9: 20 08 10934 | bra .continue
2ABB: CC 0001 10935 | .greater ldd #1
2ABE: ED E4 10936 | std Lpreresult,s
2AC0: 10AE 6A 10937 | ldy Lu2,s
2AC3: 108C 0000 10938 | .continue cmpy #0
2AC7: 27 10 10939 | beq .return
2AC9: AE 68 10940 | ldx Lcaddr1,s
2ACB: EE 6C 10941 | ldu Lcaddr2,s
2ACD: A6 80 10942 | .compare lda ,x+
2ACF: A1 C0 10943 | cmpa ,u+
2AD1: 25 10 10944 | blo .cmplt
2AD3: 22 15 10945 | bhi .cmpgt
2AD5: 31 3F 10946 | leay -1,y
2AD7: 26 F4 10947 | bne .compare
2AD9: 35 66 10948 | .return puls u,y,d
2ADB: 36 06 10949 | pshu d
2ADD: 32 68 10950 | leas 8,s
2ADF: AE A1 10951 | ldx ,y++
2AE1: 6E 94 10952 | jmp [,x]
2AE3: CC FFFF 10953 | .cmplt ldd #-1
2AE6: ED E4 10954 | std Lpreresult,s
2AE8: 20 EF 10955 | bra .return
2AEA: CC 0001 10956 | .cmpgt ldd #1
2AED: ED E4 10957 | std Lpreresult,s
2AEF: 20 E8 10958 | bra .return
10959 |
10960 | ;-------------------------------------------
10961 |
10962 | .test 'S" ONE" S" ONE" COMPARE'
10963 | .opt test prot n , ._nu11
10964 | .opt test prot n , ._nu12
10965 | .opt test prot n , ._nu13
F52C: CE F53A 10966 | ldu #.datastack1
F52F: 8E 2A96 10967 | ldx #forth_string_compare.xt
F532: BD 0C04 10968 | jsr forth_core_execute.asm
10969 | .assert /u = .result1 , "U"
10970 | .assert @@/,u = 0 , ",U"
F535: 39 10971 | rts
10972 |
F536: 0000 10973 | fdb 0
F538: 0000 10974 | fdb 0
F53A: 0003 10975 | .datastack1 fdb .text11_len
F53C: F543 10976 | fdb .text11
F53E: 0003 10977 | fdb .text12_len
F540: F547 10978 | .result1 fdb .text12
10979 |
F542: 00 10980 | ._nu11 fcb 0
F543: 4F4E45 10981 | .text11 fcc 'ONE'
10982 | .text11_len equ * - .text11
F546: 00 10983 | ._nu12 fcb 0
F547: 4F4E45 10984 | .text12 fcc 'ONE'
10985 | .text12_len equ * - .text12
F54A: 00 10986 | ._nu13 fcb 0
10987 | .endtst
10988 |
10989 | ;-------------------------------------------
10990 |
10991 | .test 'S" ONE" S" TWO" COMPARE'
10992 | .opt test prot n , ._nu21
10993 | .opt test prot n , ._nu22
10994 | .opt test prot n , ._nu23
F54B: CE F559 10995 | ldu #.datastack2
F54E: 8E 2A96 10996 | ldx #forth_string_compare.xt
F551: BD 0C04 10997 | jsr forth_core_execute.asm
10998 | .assert /u = .result2 , "U"
10999 | .assert @@/,u = -1 , ",U"
F554: 39 11000 | rts
11001 |
F555: 0000 11002 | fdb 0
F557: 0000 11003 | fdb 0
F559: 0003 11004 | .datastack2 fdb .text22_len
F55B: F566 11005 | fdb .text22
F55D: 0003 11006 | fdb .text21_len
F55F: F562 11007 | .result2 fdb .text21
11008 |
F561: 00 11009 | ._nu21 fcb 0
F562: 4F4E45 11010 | .text21 fcc 'ONE'
11011 | .text21_len equ * - .text21
F565: 00 11012 | ._nu22 fcb 0
F566: 54574F 11013 | .text22 fcc 'TWO'
11014 | .text22_len equ * - .text22
F569: 00 11015 | ._nu23 fcb 0
11016 | .endtst
11017 |
11018 | ;-------------------------------------------
11019 |
11020 | .test 'S" TWO" S" ONE" COMPARE'
11021 | .opt test prot n , ._nu31
11022 | .opt test prot n , ._nu32
11023 | .opt test prot n , ._nu33
F56A: CE F578 11024 | ldu #.datastack3
F56D: 8E 2A96 11025 | ldx #forth_string_compare.xt
F570: BD 0C04 11026 | jsr forth_core_execute.asm
11027 | .assert /u = .result3 , "U"
11028 | .assert @@/,u = 1 , ",U"
F573: 39 11029 | rts
11030 |
F574: 0000 11031 | fdb 0
F576: 0000 11032 | fdb 0
F578: 0003 11033 | .datastack3 fdb .text32_len
F57A: F585 11034 | fdb .text32
F57C: 0003 11035 | fdb .text31_len
F57E: F581 11036 | .result3 fdb .text31
11037 |
F580: 00 11038 | ._nu31 fcb 0
F581: 54574F 11039 | .text31 fcc 'TWO'
11040 | .text31_len equ * - .text31
F584: 00 11041 | ._nu32 fcb 0
F585: 4F4E45 11042 | .text32 fcc 'ONE'
11043 | .text32_len equ * - .text32
F588: 00 11044 | ._nu33 fcb 0
11045 | .endtst
11046 |
11047 | ;-------------------------------------------
11048 |
11049 | .test 'S" " S" ONE" COMPARE'
11050 | .opt test prot n , ._nu41
11051 | .opt test prot n , ._nu42
11052 | .opt test prot n , ._nu43
F589: CE F597 11053 | ldu #.datastack4
F58C: 8E 2A96 11054 | ldx #forth_string_compare.xt
F58F: BD 0C04 11055 | jsr forth_core_execute.asm
11056 | .assert /u = .result4 , "U"
11057 | .assert @@/,u = -1 , ",U"
F592: 39 11058 | rts
11059 |
F593: 0000 11060 | fdb 0
F595: 0000 11061 | fdb 0
F597: 0003 11062 | .datastack4 fdb .text42_len
F599: F5A2 11063 | fdb .text42
F59B: 0000 11064 | fdb .text41_len
F59D: F5A0 11065 | .result4 fdb .text41
11066 |
F59F: 00 11067 | ._nu41 fcb 0
F5A0: 00 11068 | .text41 fcb 0
11069 | .text41_len equ 0
F5A1: 00 11070 | ._nu42 fcb 0
F5A2: 4F4E45 11071 | .text42 fcc 'ONE'
11072 | .text42_len equ * - .text42
F5A5: 00 11073 | ._nu43 fcb 0
11074 | .endtst
11075 |
11076 | ;**********************************************************************
11077 |
2AF1: 11078 | forth_string_search ; ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
2AF1: 2A8B 11079 | fdb forth_string_compare
2AF3: 0006 11080 | fdb .xt - .name
2AF5: 534541524348 11081 | .name fcc "SEARCH"
2AFB: 0678 11082 | .xt fdb forth_core_colon.runtime
11083 | ;==========================================================
11084 | ; : SEARCH
11085 | ; ( 1 ) 3 PICK 3 PICK 2>R 2>R BEGIN
11086 | ; ( 2 ) 2DUP R@ MIN 2R@ DROP OVER COMPARE 0= DUP IF
11087 | ; ( 3 ) 2R> 2DROP 2R> 2DROP EXIT
11088 | ; ( 4 ) THEN DROP 1 /STRING DUP 0= IF
11089 | ; ( 5 ) 2DROP 2R> 2DROP 2R> FALSE EXIT
11090 | ; ( 6 ) THEN
11091 | ; ( 7 ) REPEAT ;
11092 | ;==========================================================
2AFD: 0D84 11093 | fdb forth_core_literal.runtime_xt ; 1
2AFF: 0003 11094 | fdb 3
2B01: 1720 11095 | fdb forth_core_ext_pick.xt
2B03: 0D84 11096 | fdb forth_core_literal.runtime_xt
2B05: 0003 11097 | fdb 3
2B07: 1720 11098 | fdb forth_core_ext_pick.xt
2B09: 1334 11099 | fdb forth_core_ext_two_to_r.xt
2B0B: 1334 11100 | fdb forth_core_ext_two_to_r.xt
2B0D: 060D 11101 | .L5 fdb forth_core_two_dupe.xt ; 2
2B0F: 0FBA 11102 | fdb forth_core_r_fetch.xt
2B11: 0E28 11103 | fdb forth_core_min.xt
2B13: 1356 11104 | fdb forth_core_ext_two_r_fetch.xt
2B15: 0A65 11105 | fdb forth_core_drop.xt
2B17: 0EA4 11106 | fdb forth_core_over.xt
2B19: 2A96 11107 | fdb forth_string_compare.xt
2B1B: 057E 11108 | fdb forth_core_zero_equals.xt
2B1D: 0A74 11109 | fdb forth_core_dupe.xt
2B1F: 0CD1 11110 | fdb forth_core_if.runtime_xt
2B21: 2B2D 11111 | fdb .L19
2B23: 1345 11112 | fdb forth_core_ext_two_r_from.xt ; 3
2B25: 05FD 11113 | fdb forth_core_two_drop.xt
2B27: 1345 11114 | fdb forth_core_ext_two_r_from.xt
2B29: 05FD 11115 | fdb forth_core_two_drop.xt
2B2B: 0C1A 11116 | fdb forth_core_exit.xt
2B2D: 0A65 11117 | .L19 fdb forth_core_drop.xt ; 4
2B2F: 0D84 11118 | fdb forth_core_literal.runtime_xt
2B31: 0001 11119 | fdb 1
2B33: 2A15 11120 | fdb forth_string_slash_string.xt
2B35: 0A74 11121 | fdb forth_core_dupe.xt
2B37: 057E 11122 | fdb forth_core_zero_equals.xt
2B39: 0CD1 11123 | fdb forth_core_if.runtime_xt
2B3B: 2B49 11124 | fdb .L31
2B3D: 05FD 11125 | fdb forth_core_two_drop.xt ; 5
2B3F: 1345 11126 | fdb forth_core_ext_two_r_from.xt
2B41: 05FD 11127 | fdb forth_core_two_drop.xt
2B43: 1345 11128 | fdb forth_core_ext_two_r_from.xt
2B45: 156D 11129 | fdb forth_core_ext_false.xt
2B47: 0C1A 11130 | fdb forth_core_exit.xt
2B49: 1430 11131 | .L31 fdb forth_core_ext_again.runtime_xt
2B4B: 2B0D 11132 | fdb .L5
11133 |
11134 | ;-----------------------------------------------
11135 |
11136 | .test 'S" one two three" S" two" SEARCH'
11137 | .opt test prot n , ._nu11
11138 | .opt test prot n , ._nu12
11139 | .opt test prot n , ._nu13
F5A6: CE F5B8 11140 | ldu #.datastack1
F5A9: 8E 2AFB 11141 | ldx #forth_string_search.xt
F5AC: BD 0C04 11142 | jsr forth_core_execute.asm
11143 | .assert /u = .results1 , "U"
11144 | .assert @@/,u = -1 , "flag"
F5AF: 39 11145 | rts
11146 |
F5B0: 0000 11147 | fdb 0
F5B2: 0000 11148 | fdb 0
F5B4: 0000 11149 | fdb 0
F5B6: 0000 11150 | fdb 0
F5B8: 0003 11151 | .datastack1 fdb .text12_len
F5BA: F5CF 11152 | .results1 fdb .text12
F5BC: 000D 11153 | fdb .text11_len
F5BE: F5C1 11154 | fdb .text11
11155 |
F5C0: 00 11156 | ._nu11 fcb 0
F5C1: 6F6E65207477... 11157 | .text11 fcc 'one two three'
11158 | .text11_len equ * - .text11
F5CE: 00 11159 | ._nu12 fcb 0
F5CF: 74776F 11160 | .text12 fcc 'two'
11161 | .text12_len equ * - .text12
F5D2: 00 11162 | fcb 0
F5D3: 00 11163 | ._nu13 fcb 0
11164 | .endtst
11165 |
11166 | ;**********************************************************************
11167 |
2B4D: 11168 | forth_string_sliteral ; C ( c-addr1 u -- ) R ( -- c-addr2 u )
2B4D: 2AF1 11169 | fdb forth_string_search
2B4F: A008 11170 | fdb _IMMED | _NOINTERP :: .xt - .name
2B51: 534C49544552... 11171 | .name fcc "SLITERAL"
2B59: 2B5B 11172 | .xt fdb .body
2B5B: 34 60 11173 | .body pshs u,y ; save some registers
2B5D: 37 30 11174 | pulu y,x ; get c-addr u
2B5F: DE 10 11175 | ldu forth__here
2B61: CC 2B7C 11176 | ldd #.runtime_xt ; compile xt
2B64: ED C1 11177 | std ,u++
2B66: AF C1 11178 | stx ,u++ ; compile length
2B68: 27 08 11179 | beq .done
2B6A: A6 A0 11180 | .copy lda ,y+ ; compile text
2B6C: A7 C0 11181 | sta ,u+
2B6E: 30 1F 11182 | leax -1,x
2B70: 26 F8 11183 | bne .copy
2B72: DF 10 11184 | .done stu forth__here
2B74: 35 60 11185 | puls u,y ; restore registers
2B76: 33 44 11186 | leau 4,u ; adjust stack
2B78: AE A1 11187 | ldx ,y++
2B7A: 6E 94 11188 | jmp [,x]
11189 |
2B7C: 2B7E 11190 | .runtime_xt fdb .runtime
2B7E: EC A1 11191 | .runtime ldd ,y++ ; get length
2B80: 1F 21 11192 | tfr y,x ; get start of word
2B82: 31 8B 11193 | leay d,x ; point Forth IP past word
2B84: 36 16 11194 | pshu x,d ; save c-addr u
2B86: AE A1 11195 | ldx ,y++
2B88: 6E 94 11196 | jmp [,x]
11197 |
11198 | ;**********************************************************************
11199 | ; STRING-EXT
11200 | ;**********************************************************************
11201 |
2B8A: 11202 | forth_string_ext_replaces ; ( c-addr1 u1 c-addr2 u2 -- )
2B8A: 2B4D 11203 | fdb forth_string_sliteral
2B8C: 0008 11204 | fdb .xt - .name
2B8E: 5245504C4143... 11205 | .name fcc "REPLACES"
2B96: 0678 11206 | .xt fdb forth_core_colon.runtime
11207 | ;===================================================
11208 | ; : REPLACES
11209 | ; GET-CURRENT >R string-wid SET-CURRENT create" DUP ,
11210 | ; 0 ?D0
11211 | ; DUP C@ C, CHAR+
11212 | ; LOOP DROP R> SET-CURRENT
11213 | ; DOES>
11214 | ; DUP CELL+ SWAP @ ;
11215 | ;===================================================
2B98: 2802 11216 | fdb forth_search_get_current.xt
2B9A: 07BF 11217 | fdb forth_core_to_r.xt
2B9C: 0D84 11218 | fdb forth_core_literal.runtime_xt
2B9E: 0014 11219 | fdb forth__string_wid
2BA0: 2896 11220 | fdb forth_search_set_current.xt
2BA2: 0142 11221 | fdb forth__private_create_quote_xt
2BA4: 0A74 11222 | fdb forth_core_dupe.xt
2BA6: 04F3 11223 | fdb forth_core_comma.xt
2BA8: 0D84 11224 | fdb forth_core_literal.runtime_xt
2BAA: 0000 11225 | fdb 0
2BAC: 13D4 11226 | fdb forth_core_ext_question_do.runtime_xt
2BAE: 2BBC 11227 | fdb .L2
2BB0: 0A74 11228 | .L1 fdb forth_core_dupe.xt
2BB2: 08F9 11229 | fdb forth_core_c_fetch.xt
2BB4: 08E5 11230 | fdb forth_core_c_comma.xt
2BB6: 094D 11231 | fdb forth_core_char_plus.xt
2BB8: 0D9E 11232 | fdb forth_core_loop.runtime_xt
2BBA: 2BB0 11233 | fdb .L1
2BBC: 0A65 11234 | .L2 fdb forth_core_drop.xt
2BBE: 0FAA 11235 | fdb forth_core_r_from.xt
2BC0: 2896 11236 | fdb forth_search_set_current.xt
2BC2: 0A50 11237 | fdb forth_core_does.runtime_xt
11238 |
11239 | .opt * uses .does
2BC4: BD 09BD 11240 | .does jsr forth_core_create.does_hook
2BC7: 0A74 11241 | fdb forth_core_dupe.xt
2BC9: 090F 11242 | fdb forth_core_cell_plus.xt
2BCB: 10FC 11243 | fdb forth_core_swap.xt
2BCD: 07E2 11244 | fdb forth_core_fetch.xt
2BCF: 0C1A 11245 | fdb forth_core_exit.xt
11246 |
11247 | ;------------------------------------------------
11248 |
11249 | .test "REPLACES DOES>"
F5D4: CE F5E2 11250 | ldu #.datastack
F5D7: 8E F5E5 11251 | ldx #.foo_xt
F5DA: BD 0C04 11252 | jsr forth_core_execute.asm
11253 | .assert /u = .result , "U"
11254 | .assert @@/0,u = @@.foo_len , "len"
11255 | .assert @@/2,u = .foo_text , "text"
F5DD: 39 11256 | rts
11257 |
F5DE: 0000 11258 | .result fdb 0
F5E0: 0000 11259 | fdb 0
F5E2: 0000 11260 | .datastack fdb 0
11261 |
F5E4: 12 11262 | nop
11263 |
F5E5: 2BC4 11264 | .foo_xt fdb .does
F5E7: 0018 11265 | .foo_len fdb 24
F5E9: 666976652074... 11266 | .foo_text fcc 'five till three past two'
11267 |
11268 | .endtst
11269 |
11270 | ;**********************************************************************
11271 |
11272 | Lds set 24
11273 | Lip set 22
11274 | Lcaddr3 set 20
11275 | Llen set 18
11276 | Lcend2 set 16
11277 | Lcaddr2 set 14
11278 | Lcend1 set 12
11279 | Lcaddr1 set 10
11280 | Lname_c set 8
11281 | Lname_u set 6
11282 | Lrepend set 4
11283 | Lrepaddr set 2
11284 | Ln set 0
11285 |
2BD1: 11286 | forth_string_ext_substitute ; ( c-addr1 u1 c-addr2 u2 -- c-addr2 u3 n )
2BD1: 2B8A 11287 | fdb forth_string_ext_replaces
2BD3: 000A 11288 | fdb .xt - .name
2BD5: 535542535449... 11289 | .name fcc "SUBSTITUTE"
2BDF: 2BE1 11290 | .xt fdb .body
2BE1: 34 60 11291 | .body pshs u,y ; save U and Y
2BE3: 37 16 11292 | pulu x,d ; get c-addr2 u2
2BE5: 34 16 11293 | pshs x,d ; save as c-addr3 u3
2BE7: 31 8B 11294 | leay d,x ; calculate c-end2
2BE9: 34 30 11295 | pshs y,x ; save c-end2 c-addr2
2BEB: 37 16 11296 | pulu x,d ; get c-addr1 u1
2BED: 31 8B 11297 | leay d,x ; calculate c-end1
2BEF: 34 30 11298 | pshs y,x ; save c-end1 c-addr1
2BF1: 32 76 11299 | leas -10,s ; and some more local vars
2BF3: 4F 11300 | clra
2BF4: 5F 11301 | clrb
2BF5: ED E4 11302 | std Ln,s ; n = 0
2BF7: 1F 02 11303 | tfr d,y ; len (Y) = 0
2BF9: AE 6A 11304 | ldx Lcaddr1,s ; c-addr1 == c-addr2?
2BFB: AC 6E 11305 | cmpx Lcaddr2,s
2BFD: 1027 00CD 11306 | lbeq .error
2C01: AE 6A 11307 | ldx Lcaddr1,s ; X = caddr1
2C03: EE 6E 11308 | ldu Lcaddr2,s ; U = caddr2
2C05: AC 6C 11309 | .next_char cmpx Lcend1,s ; any more input?
2C07: 1027 00A8 11310 | lbeq .done ; if not, we're done
2C0B: A6 80 11311 | lda ,x+ ; read character
2C0D: 81 25 11312 | cmpa #'%' ; if '%', try substitution
2C0F: 27 0E 11313 | beq .start_sub
2C11: 11A3 E810 11314 | .continue_char cmpu Lcend2,s ; end of output?
2C15: 1027 00B5 11315 | lbeq .error ; if so, throw due to lack of space
2C19: A7 C0 11316 | sta ,u+ ; save character
2C1B: 31 21 11317 | leay 1,y ; increase length
2C1D: 20 E6 11318 | bra .next_char
2C1F: AF 68 11319 | .start_sub stx Lname_c,s ; save start of name
2C21: 4F 11320 | clra ; clear length
2C22: 5F 11321 | clrb
2C23: ED 66 11322 | std Lname_u,s
2C25: AC 6C 11323 | .get_name cmpx Lcend1,s ; check for end of input
2C27: 27 17 11324 | beq .unbalanced ; if so, per 17.6.2.2255, emit single %
2C29: A6 80 11325 | lda ,x+ ; get character
2C2B: 81 25 11326 | cmpa #'%' ; '%'?
2C2D: 27 09 11327 | beq .have_nameq ; if so, we have the full name
2C2F: EC 66 11328 | ldd Lname_u,s ; increment name length
2C31: C3 0001 11329 | addd #1
2C34: ED 66 11330 | std Lname_u,s
2C36: 20 ED 11331 | bra .get_name
2C38: EC 66 11332 | .have_nameq ldd Lname_u,s ; do we have a name?
2C3A: 26 0A 11333 | bne .start_search ; if so, attempt substitution
2C3C: 86 25 11334 | lda #'%' ; else we had a '%%', so it subs
2C3E: 20 D1 11335 | bra .continue_char ; as a single '%'
2C40: AE 68 11336 | .unbalanced ldx Lname_c,s
2C42: 86 25 11337 | lda #'%'
2C44: 20 CB 11338 | bra .continue_char
2C46: 10AF E812 11339 | .start_search sty Llen,s ; save length
2C4A: AF 6A 11340 | stx Lcaddr1,s ; save caddr1
2C4C: EF 6E 11341 | stu Lcaddr2,s ; save caddr2
2C4E: EE E818 11342 | ldu Lds,s ; get data stack
2C51: 10AE E816 11343 | ldy Lip,s ; restore Y IP
2C55: EC 68 11344 | ldd Lname_c,s ; get name start
2C57: 36 06 11345 | pshu d ; push into data stack
2C59: EC 66 11346 | ldd Lname_u,s ; get length
2C5B: 36 06 11347 | pshu d ; push
2C5D: CC 0014 11348 | ldd #forth__string_wid ; push string wordlist
2C60: 36 06 11349 | pshu d
2C62: 8E 284B 11350 | ldx #forth_search_search_wordlist.xt ; SEARCH-WORDLIST
2C65: 17 DF9C 11351 | lbsr forth_core_execute.asm
2C68: EC C1 11352 | ldd ,u++ ; found?
2C6A: 26 16 11353 | bne .got_replace ; if so, do replacement
2C6C: AE E4 11354 | ldx Ln,s ; adjust n
2C6E: 30 1F 11355 | leax -1,x
2C70: AF E4 11356 | stx Ln,s
2C72: AE 68 11357 | ldx Lname_c,s ; don't do substitution at all
2C74: 30 1F 11358 | leax -1,x ; point to leading '%'
2C76: EC 66 11359 | ldd Lname_u,s ; get length
2C78: C3 0002 11360 | addd #2 ; adjust for start and end '%'
2C7B: 31 8B 11361 | leay d,x ; point to end of name
2C7D: 10AF 66 11362 | sty Lname_u,s ; save endpoint
2C80: 20 0E 11363 | bra .do_replace
2C82: 37 10 11364 | .got_replace pulu x ; get xt
2C84: 17 DF7D 11365 | lbsr forth_core_execute.asm
2C87: 37 16 11366 | pulu x,d ; get c-addr u
2C89: AF 68 11367 | stx Lname_c,s ; move to variable
2C8B: 31 8B 11368 | leay d,x ; point to end
2C8D: 10AF 66 11369 | sty Lname_u,s
2C90: EE 6E 11370 | .do_replace ldu Lcaddr2,s ; get caddr2
2C92: 10AE E812 11371 | ldy Llen,s ; and current length
2C96: AC 66 11372 | .copy_replace cmpx Lname_u,s ; more name to copy?
2C98: 27 0E 11373 | beq .done_replace
2C9A: A6 80 11374 | lda ,x+
2C9C: 11A3 E810 11375 | cmpu Lcend2,s ; more space to write?
2CA0: 27 2C 11376 | beq .error ; throw if not
2CA2: A7 C0 11377 | sta ,u+
2CA4: 31 21 11378 | leay 1,y ; increment c-addr3 length
2CA6: 20 EE 11379 | bra .copy_replace
2CA8: AE E4 11380 | .done_replace ldx Ln,s ; increment sub counts
2CAA: 30 01 11381 | leax 1,x
2CAC: AF E4 11382 | stx Ln,s
2CAE: AE 6A 11383 | ldx Lcaddr1,s ; get caddr1
2CB0: 16 FF52 11384 | lbra .next_char
2CB3: EE E818 11385 | .done ldu Lds,s ; get data stack
2CB6: 33 48 11386 | leau 8,u ; clean data stack
2CB8: AE E814 11387 | ldx Lcaddr3,s ; get caddr3
2CBB: 1F 20 11388 | tfr y,d ; get length
2CBD: 36 16 11389 | pshu x,d ; push caddr2, length
2CBF: EC E4 11390 | ldd Ln,s ; get # conversions
2CC1: 36 06 11391 | pshu d ; return
2CC3: 32 E816 11392 | leas 22,s ; clean return stack
2CC6: 35 20 11393 | puls y ; restore IP
2CC8: 32 62 11394 | leas 2,s ; restore return stack
2CCA: AE A1 11395 | ldx ,y++
2CCC: 6E 94 11396 | jmp [,x]
11397 |
2CCE: CC FFB2 11398 | .error ldd #-78
2CD1: ED E4 11399 | std Ln,s
2CD3: 20 DE 11400 | bra .done
11401 |
11402 | ;-------------------------------------------
11403 |
11404 | .test "SUBSTITUTE"
11405 | .opt test prot n , ._nu1
11406 | .opt test prot n , ._nu2
11407 | .opt test pokew forth__string_wid , .str_time
F601: CE F61D 11408 | ldu #.datastack
F604: 8E 2BDF 11409 | ldx #forth_string_ext_substitute.xt
F607: BD 0C04 11410 | jsr forth_core_execute.asm
11411 | .assert /u = .result , "U"
11412 | .assert @@/0,u = 2 , "conversions"
11413 | .assert @@/4,u = .buffer , "text"
11414 | .assert .buffer = "Hello %name%, it is today at five till three past two with 30% humidity.\n","result"
F60A: 39 11415 | rts
11416 |
F60B: 0000 11417 | fdb 0
F60D: 0000 11418 | fdb 0
F60F: 0000 11419 | fdb 0
F611: 0000 11420 | fdb 0
F613: 0000 11421 | fdb 0
F615: 0000 11422 | fdb 0
F617: 0000 11423 | fdb 0
F619: 0000 11424 | fdb 0
F61B: 0000 11425 | fdb 0
F61D: 0050 11426 | .datastack fdb .buflen
F61F: F695 11427 | .result fdb .buffer
F621: 0039 11428 | fdb .len
F623: F65B 11429 | fdb .text
11430 |
F625: 00 11431 | ._nu1 fcb 0
11432 |
F626: 0000 11433 | .str_date fdb 0
F628: 0004 11434 | fdb 4
F62A: 64617465 11435 | fcc 'date'
F62E: 2BC4 11436 | fdb forth_string_ext_replaces.does
F630: 0005 11437 | fdb 5
F632: 746F646179 11438 | fcc 'today'
11439 |
F637: F626 11440 | .str_time fdb .str_date
F639: 0004 11441 | fdb 4
F63B: 74696D65 11442 | fcc 'time'
F63F: 2BC4 11443 | fdb forth_string_ext_replaces.does
F641: 0018 11444 | fdb 24
F643: 666976652074... 11445 | fcc 'five till three past two'
11446 |
F65B: 48656C6C6F20... 11447 | .text ascii "Hello %name%, it is %date% at %time% with 30%% humidity.\n"
11448 | .len equ * - .text
F694: 00 11449 | ._nu2 fcb 0
F695: 11450 | .buffer rmb 80
11451 | .buflen equ * - .buffer
F6E5: 00 11452 | fcb 0
11453 | .endtst
11454 |
11455 | ;**********************************************************************
11456 |
2CD5: 11457 | forth_string_ext_unescape ; ( c-addr1 u1 c-addr2 -- c-addr2 u2 )
2CD5: 2BD1 11458 | fdb forth_string_ext_substitute
2CD7: 0008 11459 | fdb .xt - .name
2CD9: 554E45534341... 11460 | .name fcc "UNESCAPE"
2CE1: 0678 11461 | .xt fdb forth_core_colon.runtime
11462 | ;======================================================
11463 | ; : UNESCAPE
11464 | ; ( 1 ) DUP 2SWAP OVER + SWAP ?DO
11465 | ; ( 2 ) I C@ [CHAR] % = IF
11466 | ; ( 3 ) [CHAR] % OVER C! 1+
11467 | ; ( 4 ) THEN I C@ OVER C! 1+
11468 | ; ( 5 ) LOOP OVER - ;
11469 | ;======================================================
2CE3: 0A74 11470 | fdb forth_core_dupe.xt ; 1
2CE5: 0633 11471 | fdb forth_core_two_swap.xt
2CE7: 0EA4 11472 | fdb forth_core_over.xt
2CE9: 046B 11473 | fdb forth_core_plus.xt
2CEB: 10FC 11474 | fdb forth_core_swap.xt
2CED: 13D4 11475 | fdb forth_core_ext_question_do.runtime_xt
2CEF: 2D17 11476 | fdb .L1
2CF1: 0CAC 11477 | .L2 fdb forth_core_i.xt
2CF3: 08F9 11478 | fdb forth_core_c_fetch.xt
2CF5: 0D84 11479 | fdb forth_core_literal.runtime_xt
2CF7: 0025 11480 | fdb '%'
2CF9: 06D9 11481 | fdb forth_core_equals.xt
2CFB: 0CD1 11482 | fdb forth_core_if.runtime_xt
2CFD: 2D09 11483 | fdb .L3
2CFF: 0D84 11484 | fdb forth_core_literal.runtime_xt
2D01: 0025 11485 | fdb '%'
2D03: 0EA4 11486 | fdb forth_core_over.xt
2D05: 08D3 11487 | fdb forth_core_c_store.xt
2D07: 058E 11488 | fdb forth_core_one_plus.xt
2D09: 0CAC 11489 | .L3 fdb forth_core_i.xt
2D0B: 08F9 11490 | fdb forth_core_c_fetch.xt
2D0D: 0EA4 11491 | fdb forth_core_over.xt
2D0F: 08D3 11492 | fdb forth_core_c_store.xt
2D11: 058E 11493 | fdb forth_core_one_plus.xt
2D13: 0D9E 11494 | fdb forth_core_loop.runtime_xt
2D15: 2CF1 11495 | fdb .L2
2D17: 0EA4 11496 | .L1 fdb forth_core_over.xt
2D19: 0506 11497 | fdb forth_core_minus.xt
2D1B: 0C1A 11498 | fdb forth_core_exit.xt
11499 |
11500 | ;**********************************************************************
11501 |
11502 | forth__free equ *
116 | equate 001F 2 DEFINITION_MAX
111 | equate 0050 2 INPUT_SIZE
118 | equate 000A 2 NL
115 | equate 0008 2 NUMBER_LISTS
114 | equate 0010 2 NUMBER_LOCALS
112 | equate 0022 3 SLASH_HOLD
113 | equate 0054 6 SLASH_PAD
117 | equate 0021 2 WORD_MAX
123 | equate 0010 3 _DOUBLE
121 | equate 0040 4 _HIDDEN
120 | equate 0080 56 _IMMED
124 | equate 0008 4 _LOCAL
122 | equate 0020 56 _NOINTERP
171 | address 0042 2 forth__abortq
172 | address 0044 2 forth__abortql
151 | address 001C 44 forth__base
155 | address 0024 6 forth__create_link
156 | address 0026 18 forth__create_name
157 | address 0028 20 forth__create_xt
148 | address 0016 13 forth__current_wid
135 | address 0006 5 forth__ds_bottom
136 | address 0008 15 forth__ds_top
3311 | address 0ADA 1 forth__env_address_unit_bits
3314 | address 0ADE 1 forth__env_address_unit_bits.name
3315 | address 0AEF 1 forth__env_address_unit_bits.xt
3317 | address 0AF3 1 forth__env_floored
3320 | address 0AF7 1 forth__env_floored.name
3321 | address 0AFE 1 forth__env_floored.xt
3323 | address 0B02 1 forth__env_max_char
3326 | address 0B06 1 forth__env_max_char.name
3327 | address 0B0E 1 forth__env_max_char.xt
3329 | address 0B12 1 forth__env_max_d
3332 | address 0B16 1 forth__env_max_d.name
3333 | address 0B1B 1 forth__env_max_d.xt
3336 | address 0B21 1 forth__env_max_n
3339 | address 0B25 1 forth__env_max_n.name
3340 | address 0B2A 1 forth__env_max_n.xt
3342 | address 0B2E 1 forth__env_max_u
3345 | address 0B32 1 forth__env_max_u.name
3346 | address 0B37 1 forth__env_max_u.xt
3348 | address 0B3B 1 forth__env_max_u_d
3351 | address 0B3F 1 forth__env_max_u_d.name
3352 | address 0B45 1 forth__env_max_u_d.xt
3381 | address 0B98 1 forth__env_number_sign_locals
3386 | address 0BA5 1 forth__env_number_sign_locals.body
3384 | address 0B9C 1 forth__env_number_sign_locals.name
3385 | address 0BA3 1 forth__env_number_sign_locals.xt
3355 | address 0B4B 1 forth__env_return_stack_cells
3360 | address 0B63 1 forth__env_return_stack_cells.body
3358 | address 0B4F 1 forth__env_return_stack_cells.name
3359 | address 0B61 1 forth__env_return_stack_cells.xt
3293 | address 0AAA 1 forth__env_slash_counted_string
3296 | address 0AAE 1 forth__env_slash_counted_string.name
3297 | address 0ABD 1 forth__env_slash_counted_string.xt
3299 | address 0AC1 1 forth__env_slash_hold
3302 | address 0AC5 1 forth__env_slash_hold.name
3303 | address 0ACA 1 forth__env_slash_hold.xt
3305 | address 0ACE 1 forth__env_slash_pad
3308 | address 0AD2 1 forth__env_slash_pad.name
3309 | address 0AD6 1 forth__env_slash_pad.xt
3365 | address 0B6D 1 forth__env_stack_cells
3370 | address 0B7E 1 forth__env_stack_cells.body
3368 | address 0B71 1 forth__env_stack_cells.name
3369 | address 0B7C 1 forth__env_stack_cells.xt
3291 | address 0AA8 1 forth__env_wid
3375 | address 0B88 1 forth__env_wordlists
3380 | address 0B96 1 forth__env_wordlists.body
3378 | address 0B8C 1 forth__env_wordlists.name
3379 | address 0B94 1 forth__env_wordlists.xt
146 | address 0012 16 forth__forth_wid
11502 | equate 2D1D 3 forth__free
170 | address 0040 5 forth__handler
145 | address 0010 106 forth__here
139 | address 000E 6 forth__here_top
158 | address 002A 15 forth__hold
150 | address 001A 50 forth__in
176 | address 0058 10 forth__leave_sp
177 | address 005A 4 forth__leave_stack
7841 | address 1F40 1 forth__local_abort
7846 | address 1F4B 1 forth__local_abort.body
7844 | address 1F44 1 forth__local_abort.name
7845 | address 1F49 1 forth__local_abort.xt
7807 | address 1F07 5 forth__local_cleanup
164 | address 0036 2 forth__local_current
7825 | address 1F21 1 forth__local_does
7830 | address 1F2C 1 forth__local_does.body
7828 | address 1F25 1 forth__local_does.name
7829 | address 1F2A 1 forth__local_does.xt
166 | address 003A 3 forth__local_e_cnt
7956 | address 201D 5 forth__local_enter
7958 | address 201F 1 forth__local_enter.body
7969 | address 2034 1 forth__local_enter.copy
7973 | address 203B 1 forth__local_enter.done
7833 | address 1F31 1 forth__local_exit
7838 | address 1F3B 1 forth__local_exit.body
7836 | address 1F35 1 forth__local_exit.name
7837 | address 1F39 1 forth__local_exit.xt
7976 | address 203F 8 forth__local_fetch
7978 | address 2041 1 forth__local_fetch.body
162 | address 0032 5 forth__local_fp
163 | address 0034 4 forth__local_fps
168 | address 003C 2 forth__local_here
167 | address 003B 2 forth__local_l_cnt
7995 | address 205D 4 forth__local_leave
7997 | address 205F 1 forth__local_leave.body
8069 | address ECC1 1 forth__local_leave.datastack1
8120 | address EF05 1 forth__local_leave.datastack2
8125 | address EF0C 1 forth__local_leave.foo_xt
8086 | address ED05 1 forth__local_leave.result1
8121 | address EF07 1 forth__local_leave.result2
8088 | address ED07 1 forth__local_leave.text0
8089 | address ED26 1 forth__local_leave.text1
8090 | address ED45 1 forth__local_leave.text2
8091 | address ED64 1 forth__local_leave.text3
8092 | address ED83 1 forth__local_leave.text4
8093 | address EDA2 1 forth__local_leave.text5
8094 | address EDC1 1 forth__local_leave.text6
8095 | address EDE0 1 forth__local_leave.text7
8096 | address EDFF 1 forth__local_leave.text8
8097 | address EE1E 1 forth__local_leave.text9
8098 | address EE3D 1 forth__local_leave.textA
8099 | address EE5C 1 forth__local_leave.textB
8100 | address EE7B 1 forth__local_leave.textC
8101 | address EE9A 1 forth__local_leave.textD
8102 | address EEB9 1 forth__local_leave.textE
8103 | address EED8 1 forth__local_leave.textF
159 | address 002C 2 forth__local_link
160 | address 002E 2 forth__local_name
7817 | address 1F15 1 forth__local_semicolon
7822 | address 1F1C 1 forth__local_semicolon.body
7820 | address 1F19 1 forth__local_semicolon.name
7821 | address 1F1A 3 forth__local_semicolon.xt
7985 | address 204D 3 forth__local_store
7987 | address 204F 1 forth__local_store.body
7850 | address 1F53 4 forth__local_throw
7855 | address 1F5E 1 forth__local_throw.body
7853 | address 1F57 1 forth__local_throw.name
7854 | address 1F5C 1 forth__local_throw.xt
165 | address 0038 22 forth__local_wid
161 | address 0030 2 forth__local_xt
293 | address 00C1 5 forth__math_div32
299 | address 00C9 1 forth__math_div32.10
308 | address 00DA 1 forth__math_div32.15
311 | address 00E0 1 forth__math_div32.20
312 | address 00E2 1 forth__math_div32.30
332 | address E020 2 forth__math_div32.parms
347 | address E02C 2 forth__math_div32.parms2
362 | address E038 2 forth__math_div32.parms3
212 | address 0082 4 forth__math_mul16
242 | address 00B8 1 forth__math_mul16.next
262 | address E006 2 forth__math_mul16.stack1
280 | address E016 2 forth__math_mul16.stack2
185 | address 006A 6 forth__math_neg32
169 | address 003E 4 forth__nr_storage
416 | address 012C 1 forth__private_check_stacks_xt
418 | address 012E 1 forth__private_check_stacks_xt.body
425 | address 013C 1 forth__private_check_stacks_xt.throw_here
430 | address 0142 2 forth__private_create_quote_xt
432 | address 0144 2 forth__private_create_quote_xt.body
446 | address 0166 1 forth__private_create_quote_xt.copy
458 | address 017C 2 forth__private_create_quote_xt.throw_0name
460 | address 0182 1 forth__private_create_quote_xt.throw_bigname
653 | address 01B2 1 forth__private_eval_compile_xt
677 | address 01C4 1 forth__private_eval_compile_xt.comp
690 | address 01DE 1 forth__private_eval_compile_xt.compd
697 | address 01EC 1 forth__private_eval_compile_xt.default
703 | address 01F8 5 forth__private_eval_compile_xt.exit
680 | address 01CA 1 forth__private_eval_compile_xt.numq
700 | address 01F2 1 forth__private_eval_compile_xt.throw
707 | address 01FA 3 forth__private_eval_interpret_xt
725 | address 020C 1 forth__private_eval_interpret_xt.L2
728 | address 0212 1 forth__private_eval_interpret_xt.L3
734 | address 021E 1 forth__private_eval_interpret_xt.L4
737 | address 0224 2 forth__private_eval_interpret_xt.L5
756 | address E0F9 1 forth__private_eval_interpret_xt.caddr1
753 | address E0F5 1 forth__private_eval_interpret_xt.datastack1
774 | address E10E 1 forth__private_eval_interpret_xt.datastack2
754 | address E0F7 1 forth__private_eval_interpret_xt.result1
777 | address E114 1 forth__private_eval_interpret_xt.result2
465 | address 0188 6 forth__private_eval_xt
477 | address 018A 1 forth__private_eval_xt.L1
491 | address 01A6 1 forth__private_eval_xt.L4
492 | address 01A8 1 forth__private_eval_xt.L7
495 | address 01AE 1 forth__private_eval_xt.L8
536 | address E06B 2 forth__private_eval_xt.buffer1
572 | address E094 2 forth__private_eval_xt.buffer2
612 | address E0BF 2 forth__private_eval_xt.buffer3
646 | address E0E3 1 forth__private_eval_xt.buffer4
576 | address E099 1 forth__private_eval_xt.bye
533 | address E068 2 forth__private_eval_xt.datastack1
569 | address E091 2 forth__private_eval_xt.datastack2
609 | address E0BC 2 forth__private_eval_xt.datastack3
643 | address E0E0 2 forth__private_eval_xt.datastack4
522 | address E052 1 forth__private_eval_xt.dsbot1
537 | equate 0005 1 forth__private_eval_xt.len1
573 | equate 0004 1 forth__private_eval_xt.len2
613 | equate 0004 1 forth__private_eval_xt.len3
647 | equate 0000 1 forth__private_eval_xt.len4
535 | address E06A 1 forth__private_eval_xt.nu11
538 | address E070 1 forth__private_eval_xt.nu12
571 | address E093 1 forth__private_eval_xt.nu21
574 | address E098 1 forth__private_eval_xt.nu22
611 | address E0BE 1 forth__private_eval_xt.nu31
614 | address E0C3 1 forth__private_eval_xt.nu32
645 | address E0E2 1 forth__private_eval_xt.nu41
648 | address E0E4 1 forth__private_eval_xt.nu42
532 | address E066 1 forth__private_eval_xt.result1
579 | address E09E 2 forth__private_eval_xt.ret
782 | address 0226 3 forth__private_find_nt_cb_xt
809 | address 024A 1 forth__private_find_nt_cb_xt.L1
812 | address 0250 1 forth__private_find_nt_cb_xt.L2
832 | address E12A 2 forth__private_find_nt_cb_xt.datastack1
859 | address E14B 2 forth__private_find_nt_cb_xt.datastack2
837 | address E132 3 forth__private_find_nt_cb_xt.text1
838 | equate 0005 2 forth__private_find_nt_cb_xt.text1_len
864 | address E153 3 forth__private_find_nt_cb_xt.text2
865 | equate 0001 2 forth__private_find_nt_cb_xt.text2_len
870 | address 0252 1 forth__private_immediate_q_xt
872 | address 0254 1 forth__private_immediate_q_xt.body
878 | address 025F 1 forth__private_immediate_q_xt.done
881 | address 0265 1 forth__private_immediate_q_xt.true
886 | address 026A 3 forth__private_interpret_q_xt
888 | address 026C 1 forth__private_interpret_q_xt.body
911 | address E160 1 forth__private_interpret_q_xt.datastack1
925 | address E16E 1 forth__private_interpret_q_xt.datastack2
893 | address 0278 1 forth__private_interpret_q_xt.done
896 | address 027E 1 forth__private_interpret_q_xt.false
910 | address E15E 1 forth__private_interpret_q_xt.result1
924 | address E16C 1 forth__private_interpret_q_xt.result2
930 | address 0282 13 forth__private_number_q_xt
932 | address 0284 1 forth__private_number_q_xt.body
967 | address 02CA 1 forth__private_number_q_xt.check_bin
955 | address 02B4 1 forth__private_number_q_xt.check_dec
961 | address 02BF 1 forth__private_number_q_xt.check_hex
981 | address 02E6 1 forth__private_number_q_xt.check_neg
979 | address 02E2 3 forth__private_number_q_xt.check_negchar
1039 | address E187 2 forth__private_number_q_xt.datastack1
1063 | address E1A5 2 forth__private_number_q_xt.datastack2
1089 | address E1C3 1 forth__private_number_q_xt.datastack3
1115 | address E1E3 1 forth__private_number_q_xt.datastack4
1141 | address E204 1 forth__private_number_q_xt.datastack5
1168 | address E228 1 forth__private_number_q_xt.datastack6
1195 | address E24D 1 forth__private_number_q_xt.datastack7
1221 | address E273 1 forth__private_number_q_xt.datastack8
1247 | address E293 1 forth__private_number_q_xt.datastack9
1270 | address E2AF 1 forth__private_number_q_xt.datastackA
1294 | address E2CD 2 forth__private_number_q_xt.datastackB
1002 | address 0313 1 forth__private_number_q_xt.dpos
1015 | address 032D 4 forth__private_number_q_xt.error_ret
1040 | address E189 1 forth__private_number_q_xt.nu1
1064 | address E1A7 1 forth__private_number_q_xt.nu2
1090 | address E1C5 1 forth__private_number_q_xt.nu3
1116 | address E1E5 1 forth__private_number_q_xt.nu4
1142 | address E206 1 forth__private_number_q_xt.nu5
1169 | address E22A 1 forth__private_number_q_xt.nu6
1196 | address E24F 1 forth__private_number_q_xt.nu7
1222 | address E275 1 forth__private_number_q_xt.nu8
1248 | address E295 1 forth__private_number_q_xt.nu9
1271 | address E2B1 1 forth__private_number_q_xt.nuA
1295 | address E2CF 1 forth__private_number_q_xt.nuB
1041 | address E18A 1 forth__private_number_q_xt.number1
1065 | address E1A8 1 forth__private_number_q_xt.number2
1091 | address E1C6 1 forth__private_number_q_xt.number3
1117 | address E1E6 1 forth__private_number_q_xt.number4
1143 | address E207 1 forth__private_number_q_xt.number5
1170 | address E22B 1 forth__private_number_q_xt.number6
1197 | address E250 1 forth__private_number_q_xt.number7
1223 | address E276 1 forth__private_number_q_xt.number8
1249 | address E296 1 forth__private_number_q_xt.number9
1272 | address E2B2 1 forth__private_number_q_xt.numberA
1296 | address E2D0 1 forth__private_number_q_xt.numberB
973 | address 02D5 1 forth__private_number_q_xt.okay_done
974 | address 02D8 1 forth__private_number_q_xt.push_done
1087 | address E1BF 1 forth__private_number_q_xt.result3
1113 | address E1DF 1 forth__private_number_q_xt.result4
1139 | address E200 1 forth__private_number_q_xt.result5
1165 | address E222 1 forth__private_number_q_xt.result6
1192 | address E247 1 forth__private_number_q_xt.result7
1219 | address E26F 1 forth__private_number_q_xt.result8
1245 | address E28F 1 forth__private_number_q_xt.result9
1268 | address E2AB 1 forth__private_number_q_xt.resultA
1013 | address 0329 2 forth__private_number_q_xt.return_okay
1004 | address 0318 1 forth__private_number_q_xt.single
1011 | address 0324 1 forth__private_number_q_xt.spos
986 | address 02EF 1 forth__private_number_q_xt.to_number
1301 | address 0333 1 forth__private_reset_dsp_xt
1303 | address 0335 1 forth__private_reset_dsp_xt.body
1309 | address 033B 1 forth__private_reset_rsp_xt
1311 | address 033D 1 forth__private_reset_rsp_xt.body
1317 | address 0344 1 forth__private_set_source
1319 | address 0346 1 forth__private_set_source.body
1330 | address 0354 4 forth__private_set_source_i_d
1332 | address 0356 1 forth__private_set_source_i_d.body
1339 | address 035E 1 forth__private_source_restore_xt
1341 | address 0360 1 forth__private_source_restore_xt.body
1349 | address 036A 7 forth__private_string_equal_xt
137 | address 000A 4 forth__rs_bottom
138 | address 000C 5 forth__rs_top
8463 | equate 0026 5 forth__see_exit
8462 | equate 0024 23 forth__see_ip
153 | address 0020 46 forth__source
152 | address 001E 6 forth__source_id
154 | address 0022 42 forth__source_len
149 | address 0018 12 forth__state
147 | address 0014 3 forth__string_wid
390 | address 00FE 2 forth__util_check_ds
398 | address 010F 1 forth__util_check_ds.throw_high
396 | address 0109 1 forth__util_check_ds.throw_low
403 | address 0115 1 forth__util_check_rs
411 | address 0126 1 forth__util_check_rs.throw_high
409 | address 0120 1 forth__util_check_rs.throw_low
380 | address 00F3 8 forth__util_xt_to_name
385 | address 00FB 1 forth__util_xt_to_name.found_name
132 | address 0000 3 forth__vector_bye
133 | address 0002 3 forth__vector_getchar
134 | address 0004 24 forth__vector_putchar
174 | address 0048 21 forth__widlist
173 | address 0046 20 forth__widnum
2595 | address 07EC 1 forth_core_abs
2608 | address 07FF 1 forth_core_abs.L1
2598 | address 07F0 1 forth_core_abs.name
2599 | address 07F3 3 forth_core_abs.xt
2612 | address 0801 1 forth_core_accept
2635 | address 081F 1 forth_core_accept.L1
2640 | address 0829 1 forth_core_accept.L2
2654 | address 0845 1 forth_core_accept.L3
2687 | address E49F 2 forth_core_accept.buffer
2683 | address E49A 1 forth_core_accept.datastack
2690 | address E4A9 1 forth_core_accept.getchar
2696 | address E4B6 2 forth_core_accept.input
2697 | address E4B8 1 forth_core_accept.inputbuf
2688 | equate 000A 1 forth_core_accept.len
2615 | address 0805 1 forth_core_accept.name
2686 | address E49E 1 forth_core_accept.nu1
2698 | address E4BC 1 forth_core_accept.nu2
2684 | address E49C 1 forth_core_accept.result
2616 | address 080B 3 forth_core_accept.xt
2703 | address 0855 1 forth_core_align
2706 | address 0859 1 forth_core_align.name
2707 | address 085E 2 forth_core_align.xt
2715 | address 0862 1 forth_core_aligned
2718 | address 0866 1 forth_core_aligned.name
2719 | address 086D 1 forth_core_aligned.xt
2727 | address 0871 1 forth_core_allot
2732 | address 087C 1 forth_core_allot.body
2736 | address 0884 1 forth_core_allot.done
2730 | address 0875 1 forth_core_allot.name
2731 | address 087A 2 forth_core_allot.xt
2741 | address 0888 1 forth_core_and
2746 | address 0891 1 forth_core_and.body
2744 | address 088C 1 forth_core_and.name
2745 | address 088F 1 forth_core_and.xt
2779 | address 08C3 1 forth_core_b_l
2800 | address E4C9 1 forth_core_b_l.datastack
2782 | address 08C7 1 forth_core_b_l.name
2799 | address E4C7 1 forth_core_b_l.result
2783 | address 08C9 12 forth_core_b_l.xt
2755 | address 089D 1 forth_core_base
2760 | address 08A7 1 forth_core_base.body
2758 | address 08A1 1 forth_core_base.name
2759 | address 08A5 5 forth_core_base.xt
2767 | address 08B0 1 forth_core_begin
2772 | address 08BB 1 forth_core_begin.body
2770 | address 08B4 1 forth_core_begin.name
2771 | address 08B9 1 forth_core_begin.xt
5266 | address 129F 1 forth_core_bracket_char
5269 | address 12A3 1 forth_core_bracket_char.name
5270 | address 12A9 1 forth_core_bracket_char.xt
5252 | address 1290 1 forth_core_bracket_tick
5255 | address 1294 1 forth_core_bracket_tick.name
5256 | address 1297 1 forth_core_bracket_tick.xt
2818 | address 08DF 1 forth_core_c_comma
2823 | address 08E7 1 forth_core_c_comma.body
2821 | address 08E3 1 forth_core_c_comma.name
2822 | address 08E5 3 forth_core_c_comma.xt
2832 | address 08F3 1 forth_core_c_fetch
2837 | address 08FB 1 forth_core_c_fetch.body
2835 | address 08F7 1 forth_core_c_fetch.name
2836 | address 08F9 11 forth_core_c_fetch.xt
2947 | address 0998 1 forth_core_c_r
2950 | address 099C 1 forth_core_c_r.name
2951 | address 099E 12 forth_core_c_r.xt
2805 | address 08CD 1 forth_core_c_store
2810 | address 08D5 1 forth_core_c_store.body
2808 | address 08D1 1 forth_core_c_store.name
2809 | address 08D3 4 forth_core_c_store.xt
2846 | address 0906 1 forth_core_cell_plus
2851 | address 0911 1 forth_core_cell_plus.body
2849 | address 090A 1 forth_core_cell_plus.name
2850 | address 090F 4 forth_core_cell_plus.xt
2859 | address 091B 1 forth_core_cells
2864 | address 0926 1 forth_core_cells.body
2862 | address 091F 1 forth_core_cells.name
2863 | address 0924 1 forth_core_cells.xt
2872 | address 0930 1 forth_core_char
2875 | address 0934 1 forth_core_char.name
2876 | address 0938 2 forth_core_char.xt
2888 | address 0944 1 forth_core_char_plus
2893 | address 094F 1 forth_core_char_plus.body
2891 | address 0948 1 forth_core_char_plus.name
2892 | address 094D 6 forth_core_char_plus.xt
2901 | address 0959 1 forth_core_chars
2904 | address 095D 1 forth_core_chars.name
2905 | address 0962 4 forth_core_chars.xt
2057 | address 064D 2 forth_core_colon
2111 | address E395 1 forth_core_colon.bar_link
2112 | address E397 2 forth_core_colon.bar_name
2114 | address E39C 1 forth_core_colon.bar_xt
2062 | address 0654 1 forth_core_colon.body
2102 | address E386 2 forth_core_colon.buffer
2100 | address E384 1 forth_core_colon.datastack
2106 | address E38C 1 forth_core_colon.foo
2107 | address E38E 1 forth_core_colon.foo_name
2108 | address E391 1 forth_core_colon.foo_xt
2103 | equate 0004 1 forth_core_colon.len
2060 | address 0651 1 forth_core_colon.name
2076 | address 0678 154 forth_core_colon.runtime
2105 | address E38A 1 forth_core_colon.wid
2061 | address 0652 4 forth_core_colon.xt
1725 | address 04EE 1 forth_core_comma
1730 | address 04F5 1 forth_core_comma.body
1728 | address 04F2 1 forth_core_comma.name
1729 | address 04F3 9 forth_core_comma.xt
2913 | address 0966 2 forth_core_constant
2924 | address 097A 15 forth_core_constant.does
2916 | address 096A 1 forth_core_constant.name
2917 | address 0972 1 forth_core_constant.xt
2930 | address 0981 1 forth_core_count
2933 | address 0985 1 forth_core_count.name
2934 | address 098A 2 forth_core_count.xt
2962 | address 09A8 2 forth_core_create
3020 | address E4F7 1 forth_core_create.bar_body
3017 | address E4F0 2 forth_core_create.bar_len
3016 | address E4EE 3 forth_core_create.bar_link
3018 | address E4F2 1 forth_core_create.bar_name
3019 | address E4F5 2 forth_core_create.bar_xt
2968 | address 09B4 1 forth_core_create.body
3006 | address E4DD 2 forth_core_create.buffer
3004 | address E4DB 1 forth_core_create.datastack
2972 | address 09BD 10 forth_core_create.does_hook
3010 | address E4E3 2 forth_core_create.foo
3012 | address E4E7 1 forth_core_create.foo_name
3013 | address E4EA 1 forth_core_create.foo_xt
3007 | equate 0004 1 forth_core_create.len
2965 | address 09AC 1 forth_core_create.name
2975 | address 09C3 5 forth_core_create.runtime
3009 | address E4E1 2 forth_core_create.wid
2966 | address 09B2 13 forth_core_create.xt
3025 | address 09CB 1 forth_core_decimal
3028 | address 09CF 1 forth_core_decimal.name
3029 | address 09D6 1 forth_core_decimal.xt
3041 | address 09E2 1 forth_core_depth
3046 | address 09ED 1 forth_core_depth.body
3044 | address 09E6 1 forth_core_depth.name
3045 | address 09EB 1 forth_core_depth.xt
3058 | address 09FE 2 forth_core_do
3063 | address 0A06 1 forth_core_do.body
3061 | address 0A02 1 forth_core_do.name
3083 | address 0A2C 1 forth_core_do.runtime
3082 | address 0A2A 8 forth_core_do.runtime_xt
3079 | address 0A24 2 forth_core_do.throw_toodeep
3062 | address 0A04 1 forth_core_do.xt
3128 | address 0A2F 2 forth_core_does
3206 | address E52F 1 forth_core_does.bar2_body
3205 | address E52D 2 forth_core_does.bar2_xt
3231 | address E54C 1 forth_core_does.bar3_xt
3133 | address 0A3A 2 forth_core_does.body
3197 | address E520 1 forth_core_does.call2_foo_xt
3223 | address E53F 1 forth_core_does.call3_bar_xt
3171 | address E507 6 forth_core_does.datastack1
3195 | address E51E 2 forth_core_does.datastack2
3221 | address E53D 2 forth_core_does.datastack3
3177 | address E510 1 forth_core_does.foo1_does_a
3175 | address E50D 2 forth_core_does.foo1_does_cxt
3176 | address E50F 1 forth_core_does.foo1_does_jsr
3174 | address E50B 4 forth_core_does.foo1_xt
3203 | address E52A 1 forth_core_does.foo2_jsr
3201 | address E526 1 forth_core_does.foo2_xt
3227 | address E545 1 forth_core_does.foo3_does_jsr
3131 | address 0A33 1 forth_core_does.name
3145 | address 0A52 1 forth_core_does.runtime
3144 | address 0A50 9 forth_core_does.runtime_xt
3132 | address 0A38 2 forth_core_does.xt
1752 | address 0512 1 forth_core_dot
1791 | address E346 1 forth_core_dot.datastack
1755 | address 0516 1 forth_core_dot.name
1799 | address E356 2 forth_core_dot.output
1800 | address E358 2 forth_core_dot.outputbuf
1794 | address E34A 1 forth_core_dot.putchar
1792 | address E348 1 forth_core_dot.result
1756 | address 0517 7 forth_core_dot.xt
1805 | address 0533 1 forth_core_dot_quote
1808 | address 0537 1 forth_core_dot_quote.name
1809 | address 0539 1 forth_core_dot_quote.xt
3237 | address 0A5D 1 forth_core_drop
3242 | address 0A67 1 forth_core_drop.body
3240 | address 0A61 1 forth_core_drop.name
3241 | address 0A65 41 forth_core_drop.xt
3248 | address 0A6D 1 forth_core_dupe
3253 | address 0A76 1 forth_core_dupe.body
3251 | address 0A71 1 forth_core_dupe.name
3252 | address 0A74 38 forth_core_dupe.xt
3260 | address 0A7E 1 forth_core_else
3263 | address 0A82 1 forth_core_else.name
3264 | address 0A86 1 forth_core_else.xt
3277 | address 0A94 1 forth_core_emit
3282 | address 0A9E 1 forth_core_emit.body
3280 | address 0A98 1 forth_core_emit.name
3281 | address 0A9C 4 forth_core_emit.xt
3388 | address 0BA7 1 forth_core_environment_query
3411 | address 0BCB 1 forth_core_environment_query.L1
3412 | address 0BCD 1 forth_core_environment_query.L2
3428 | address E569 1 forth_core_environment_query._nu
3426 | address E55A 2 forth_core_environment_query.c_addr
3437 | address E578 2 forth_core_environment_query.datastack
3391 | address 0BAB 1 forth_core_environment_query.name
3427 | equate 000F 1 forth_core_environment_query.u
3392 | address 0BB7 2 forth_core_environment_query.xt
2205 | address 06D4 1 forth_core_equals
2210 | address 06DB 1 forth_core_equals.body
2217 | address 06E9 1 forth_core_equals.done
2216 | address 06E6 1 forth_core_equals.equal
2208 | address 06D8 1 forth_core_equals.name
2209 | address 06D9 6 forth_core_equals.xt
3443 | address 0BCF 1 forth_core_evaluate
3495 | address E592 1 forth_core_evaluate.datastack1
3506 | address E5A4 3 forth_core_evaluate.dummy1
3507 | equate 0005 2 forth_core_evaluate.dummy1len
3505 | equate 0003 1 forth_core_evaluate.len1
3446 | address 0BD3 1 forth_core_evaluate.name
3496 | address E594 2 forth_core_evaluate.result1
3489 | address E586 1 forth_core_evaluate.rs_bot
3504 | address E5A1 2 forth_core_evaluate.text1
3447 | address 0BDB 2 forth_core_evaluate.xt
3512 | address 0BF3 1 forth_core_execute
3529 | address 0C04 189 forth_core_execute.asm
3533 | address 0C0C 1 forth_core_execute.asm_body
3535 | address 0C10 1 forth_core_execute.asm_exit_code
3534 | address 0C0E 1 forth_core_execute.asm_exit_xt
3517 | address 0C00 1 forth_core_execute.body
3552 | address E5BB 1 forth_core_execute.call_xt
3548 | address E5B5 1 forth_core_execute.datastack1
3574 | address E5D7 2 forth_core_execute.datastack2
3515 | address 0BF7 1 forth_core_execute.name
3550 | address E5B9 1 forth_core_execute.result
3572 | address E5D3 2 forth_core_execute.stack
3516 | address 0BFE 8 forth_core_execute.xt
3579 | address 0C12 1 forth_core_exit
3584 | address 0C1C 2 forth_core_exit.body
3582 | address 0C16 1 forth_core_exit.name
3583 | address 0C1A 159 forth_core_exit.xt
5494 | address 13EB 1 forth_core_ext_action_of
5515 | address 1410 1 forth_core_ext_action_of.L1
5516 | address 1412 1 forth_core_ext_action_of.L2
5497 | address 13EF 1 forth_core_ext_action_of.name
5498 | address 13F8 1 forth_core_ext_action_of.xt
5520 | address 1414 2 forth_core_ext_again
5525 | address 141F 1 forth_core_ext_again.body
5523 | address 1418 1 forth_core_ext_again.name
5535 | address 1432 1 forth_core_ext_again.runtime
5534 | address 1430 50 forth_core_ext_again.runtime_xt
5524 | address 141D 2 forth_core_ext_again.xt
6869 | address 1A8D 1 forth_core_ext_backslash
6872 | address 1A91 1 forth_core_ext_backslash.name
6873 | address 1A92 1 forth_core_ext_backslash.xt
6855 | address 1A78 1 forth_core_ext_bracket_compile
6858 | address 1A7C 1 forth_core_ext_bracket_compile.name
6859 | address 1A85 1 forth_core_ext_bracket_compile.xt
5541 | address 1439 1 forth_core_ext_buffer_colon
5544 | address 143D 1 forth_core_ext_buffer_colon.name
5545 | address 1444 1 forth_core_ext_buffer_colon.xt
5556 | address 144E 2 forth_core_ext_c_quote
5561 | address 1456 1 forth_core_ext_c_quote.body
5573 | address 1472 1 forth_core_ext_c_quote.copy
5577 | address 1479 1 forth_core_ext_c_quote.empty
5559 | address 1452 1 forth_core_ext_c_quote.name
5584 | address 1485 1 forth_core_ext_c_quote.runtime
5583 | address 1483 3 forth_core_ext_c_quote.runtime_xt
5560 | address 1454 1 forth_core_ext_c_quote.xt
5593 | address 1490 1 forth_core_ext_case
5596 | address 1494 1 forth_core_ext_case.name
5597 | address 1498 1 forth_core_ext_case.xt
5418 | address 1362 1 forth_core_ext_colon_no_name
5423 | address 136F 1 forth_core_ext_colon_no_name.body
5421 | address 1366 1 forth_core_ext_colon_no_name.name
5422 | address 136D 1 forth_core_ext_colon_no_name.xt
5607 | address 14A0 1 forth_core_ext_compile_comma
5612 | address 14AE 1 forth_core_ext_compile_comma.body
5610 | address 14A4 1 forth_core_ext_compile_comma.name
5611 | address 14AC 12 forth_core_ext_compile_comma.xt
5621 | address 14BA 1 forth_core_ext_defer
5624 | address 14BE 1 forth_core_ext_defer.name
5625 | address 14C3 1 forth_core_ext_defer.xt
5655 | address 14EA 1 forth_core_ext_defer_fetch
5658 | address 14EE 1 forth_core_ext_defer_fetch.name
5659 | address 14F4 3 forth_core_ext_defer_fetch.xt
5641 | address 14D8 1 forth_core_ext_defer_store
5644 | address 14DC 1 forth_core_ext_defer_store.name
5645 | address 14E2 3 forth_core_ext_defer_store.xt
5297 | address 12C0 1 forth_core_ext_dot_paren
5300 | address 12C4 1 forth_core_ext_dot_paren.name
5301 | address 12C6 1 forth_core_ext_dot_paren.xt
5313 | address 12D2 1 forth_core_ext_dot_r
5344 | address 1304 1 forth_core_ext_dot_r.L1
5345 | address 1306 1 forth_core_ext_dot_r.L2
5316 | address 12D6 1 forth_core_ext_dot_r.name
5317 | address 12D8 1 forth_core_ext_dot_r.xt
5669 | address 14FC 1 forth_core_ext_end_case
5674 | address 1509 1 forth_core_ext_end_case.body
5687 | address 1525 1 forth_core_ext_end_case.done_fixup
5681 | address 1518 1 forth_core_ext_end_case.fixup
5672 | address 1500 1 forth_core_ext_end_case.name
5673 | address 1507 1 forth_core_ext_end_case.xt
5693 | address 152B 1 forth_core_ext_end_of
5698 | address 1536 1 forth_core_ext_end_of.body
5696 | address 152F 1 forth_core_ext_end_of.name
5697 | address 1534 1 forth_core_ext_end_of.xt
5714 | address 1551 1 forth_core_ext_erase
5717 | address 1555 1 forth_core_ext_erase.name
5718 | address 155A 1 forth_core_ext_erase.xt
5729 | address 1564 1 forth_core_ext_false
5732 | address 1568 1 forth_core_ext_false.name
5733 | address 156D 7 forth_core_ext_false.xt
5741 | address 1571 1 forth_core_ext_hex
5744 | address 1575 1 forth_core_ext_hex.name
5745 | address 1578 2 forth_core_ext_hex.xt
5757 | address 1584 1 forth_core_ext_holds
5762 | address 158F 1 forth_core_ext_holds.body
5767 | address 1599 1 forth_core_ext_holds.copy
5760 | address 1588 1 forth_core_ext_holds.name
5761 | address 158D 1 forth_core_ext_holds.xt
5779 | address 15AB 1 forth_core_ext_is
5800 | address 15C9 1 forth_core_ext_is.L1
5801 | address 15CB 1 forth_core_ext_is.L2
5782 | address 15AF 1 forth_core_ext_is.name
5783 | address 15B1 1 forth_core_ext_is.xt
5805 | address 15CD 2 forth_core_ext_marker
5810 | address 15D9 1 forth_core_ext_marker.body
5808 | address 15D1 1 forth_core_ext_marker.name
5836 | address 1611 1 forth_core_ext_marker.nowids
5853 | address 1634 1 forth_core_ext_marker.restorewids
5857 | address 163C 1 forth_core_ext_marker.rt_nowids
5841 | address 1619 2 forth_core_ext_marker.runtime
5832 | address 1609 1 forth_core_ext_marker.savewids
5809 | address 15D7 1 forth_core_ext_marker.xt
5863 | address 1642 1 forth_core_ext_nip
5866 | address 1646 1 forth_core_ext_nip.name
5867 | address 1649 10 forth_core_ext_nip.xt
5441 | address 138D 1 forth_core_ext_not_equals
5446 | address 1395 1 forth_core_ext_not_equals.body
5453 | address 13A3 1 forth_core_ext_not_equals.done
5444 | address 1391 1 forth_core_ext_not_equals.name
5452 | address 13A0 1 forth_core_ext_not_equals.not_equal
5445 | address 1393 2 forth_core_ext_not_equals.xt
5877 | address 1651 2 forth_core_ext_of
5882 | address 1659 1 forth_core_ext_of.body
5880 | address 1655 1 forth_core_ext_of.name
5899 | address 167B 1 forth_core_ext_of.not_equal
5892 | address 166C 1 forth_core_ext_of.runtime
5891 | address 166A 16 forth_core_ext_of.runtime_xt
5881 | address 1657 1 forth_core_ext_of.xt
5905 | address 1682 1 forth_core_ext_pad
5908 | address 1686 1 forth_core_ext_pad.name
5909 | address 1689 1 forth_core_ext_pad.xt
5918 | address 168F 1 forth_core_ext_parse
5923 | address 169A 1 forth_core_ext_parse.body
5973 | address E9BD 3 forth_core_ext_parse.buffer1
5994 | address E9D8 3 forth_core_ext_parse.buffer2
6015 | address E9EB 3 forth_core_ext_parse.buffer3
6036 | address E9FB 3 forth_core_ext_parse.buffer4
5971 | address E9BB 1 forth_core_ext_parse.datastack1
5992 | address E9D7 1 forth_core_ext_parse.datastack2
6013 | address E9E9 1 forth_core_ext_parse.datastack3
6034 | address E9F9 1 forth_core_ext_parse.datastack4
5941 | address 16BE 1 forth_core_ext_parse.done
5935 | address 16B2 1 forth_core_ext_parse.input
5974 | equate 000E 1 forth_core_ext_parse.len1
5995 | equate 0005 1 forth_core_ext_parse.len2
6016 | equate 0002 1 forth_core_ext_parse.len3
6037 | equate 0001 1 forth_core_ext_parse.len4
5921 | address 1693 1 forth_core_ext_parse.name
5952 | address 16D4 2 forth_core_ext_parse.no_input
5970 | address E9B9 1 forth_core_ext_parse.results1
5991 | address E9D5 1 forth_core_ext_parse.results2
6012 | address E9E7 1 forth_core_ext_parse.results3
6033 | address E9F7 1 forth_core_ext_parse.results4
5948 | address 16CC 1 forth_core_ext_parse.return
5922 | address 1698 11 forth_core_ext_parse.xt
6042 | address 16D8 1 forth_core_ext_parse_name
6047 | address 16E8 1 forth_core_ext_parse_name.body
6089 | address EA0C 3 forth_core_ext_parse_name.buffer1
6111 | address EA2A 3 forth_core_ext_parse_name.buffer2
6134 | address EA40 2 forth_core_ext_parse_name.buffer3
6087 | address EA0A 1 forth_core_ext_parse_name.datastack1
6109 | address EA28 1 forth_core_ext_parse_name.datastack2
6131 | address EA3D 1 forth_core_ext_parse_name.datastack3
6090 | equate 000E 1 forth_core_ext_parse_name.len1
6112 | equate 0005 1 forth_core_ext_parse_name.len2
6135 | equate 0000 1 forth_core_ext_parse_name.len3
6045 | address 16DC 1 forth_core_ext_parse_name.name
6065 | address 1710 1 forth_core_ext_parse_name.no_input
6085 | address EA06 1 forth_core_ext_parse_name.results1
6107 | address EA24 1 forth_core_ext_parse_name.results2
6129 | address EA39 1 forth_core_ext_parse_name.results3
6052 | address 16F3 1 forth_core_ext_parse_name.skip_space
6046 | address 16E6 8 forth_core_ext_parse_name.xt
6140 | address 1718 1 forth_core_ext_pick
6145 | address 1722 1 forth_core_ext_pick.body
6143 | address 171C 1 forth_core_ext_pick.name
6144 | address 1720 6 forth_core_ext_pick.xt
5459 | address 13A9 2 forth_core_ext_question_do
5464 | address 13B2 1 forth_core_ext_question_do.body
5462 | address 13AD 1 forth_core_ext_question_do.name
5482 | address 13D6 1 forth_core_ext_question_do.runtime
5481 | address 13D4 9 forth_core_ext_question_do.runtime_xt
5487 | address 13E2 1 forth_core_ext_question_do.skip
5463 | address 13B0 1 forth_core_ext_question_do.xt
6154 | address 172E 1 forth_core_ext_refill
6159 | address 173A 1 forth_core_ext_refill.body
6157 | address 1732 1 forth_core_ext_refill.name
6176 | address 175E 1 forth_core_ext_refill.string_input
6158 | address 1738 3 forth_core_ext_refill.xt
6183 | address 1766 1 forth_core_ext_restore_input
6210 | address 1795 1 forth_core_ext_restore_input.L3
6214 | address 179D 1 forth_core_ext_restore_input.L4
6217 | address 17A3 1 forth_core_ext_restore_input.L5
6218 | address 17A5 1 forth_core_ext_restore_input.L6
6237 | address EA4F 1 forth_core_ext_restore_input.datastack1
6256 | address EA67 1 forth_core_ext_restore_input.datastack3
6186 | address 176A 1 forth_core_ext_restore_input.name
6241 | address EA57 1 forth_core_ext_restore_input.result1
6262 | address EA73 1 forth_core_ext_restore_input.result3
6187 | address 1777 4 forth_core_ext_restore_input.xt
6267 | address 17A7 1 forth_core_ext_roll
6281 | address 17C1 1 forth_core_ext_roll.again
6272 | address 17B1 1 forth_core_ext_roll.body
6311 | address EA83 1 forth_core_ext_roll.datastack1
6338 | address EA9F 1 forth_core_ext_roll.datastack2
6365 | address EABB 1 forth_core_ext_roll.datastack3
6392 | address EAD7 1 forth_core_ext_roll.datastack4
6288 | address 17CF 1 forth_core_ext_roll.done
6270 | address 17AB 1 forth_core_ext_roll.name
6312 | address EA85 1 forth_core_ext_roll.result1
6339 | address EAA1 1 forth_core_ext_roll.result2
6366 | address EABD 1 forth_core_ext_roll.result3
6393 | address EAD9 1 forth_core_ext_roll.result4
6290 | address 17D3 1 forth_core_ext_roll.throw_overflow
6317 | address EA8F 2 forth_core_ext_roll.top1
6344 | address EAAB 2 forth_core_ext_roll.top2
6371 | address EAC7 2 forth_core_ext_roll.top3
6398 | address EAE3 2 forth_core_ext_roll.top4
6271 | address 17AF 8 forth_core_ext_roll.xt
6403 | address 17D9 1 forth_core_ext_s_backslash_quote
6408 | address 17E2 1 forth_core_ext_s_backslash_quote.body
6561 | address EAF5 2 forth_core_ext_s_backslash_quote.buffer
6592 | address EB32 2 forth_core_ext_s_backslash_quote.buffer2
6559 | address EAF3 2 forth_core_ext_s_backslash_quote.datastack
6590 | address EB30 2 forth_core_ext_s_backslash_quote.datastack2
6435 | address 181B 1 forth_core_ext_s_backslash_quote.done
6447 | address 1833 1 forth_core_ext_s_backslash_quote.escape
6495 | address 1896 1 forth_core_ext_s_backslash_quote.escape_a
6497 | address 189A 1 forth_core_ext_s_backslash_quote.escape_b
6522 | address 18CF 1 forth_core_ext_s_backslash_quote.escape_bs
6499 | address 189E 1 forth_core_ext_s_backslash_quote.escape_e
6501 | address 18A2 1 forth_core_ext_s_backslash_quote.escape_f
6503 | address 18A6 1 forth_core_ext_s_backslash_quote.escape_l
6505 | address 18AA 1 forth_core_ext_s_backslash_quote.escape_m
6510 | address 18B8 1 forth_core_ext_s_backslash_quote.escape_n
6512 | address 18BC 2 forth_core_ext_s_backslash_quote.escape_q
6514 | address 18C0 1 forth_core_ext_s_backslash_quote.escape_r
6516 | address 18C4 1 forth_core_ext_s_backslash_quote.escape_t
6518 | address 18C8 1 forth_core_ext_s_backslash_quote.escape_v
6520 | address 18CC 1 forth_core_ext_s_backslash_quote.escape_z
6443 | address 182B 1 forth_core_ext_s_backslash_quote.finish
6614 | address EB5F 2 forth_core_ext_s_backslash_quote.foo2_body
6615 | address EB61 1 forth_core_ext_s_backslash_quote.foo2_len
6567 | address EB10 1 forth_core_ext_s_backslash_quote.foo_addr
6565 | address EB0C 2 forth_core_ext_s_backslash_quote.foo_body
6566 | address EB0E 1 forth_core_ext_s_backslash_quote.foo_len
6422 | address 17FF 4 forth_core_ext_s_backslash_quote.input
6562 | equate 0015 2 forth_core_ext_s_backslash_quote.len
6610 | equate 0029 2 forth_core_ext_s_backslash_quote.len2
6406 | address 17DD 1 forth_core_ext_s_backslash_quote.name
6432 | address 1815 2 forth_core_ext_s_backslash_quote.no_input
6568 | address EB20 1 forth_core_ext_s_backslash_quote.stop
6617 | address EB75 2 forth_core_ext_s_backslash_quote.stop2
6523 | address 18D1 11 forth_core_ext_s_backslash_quote.store
6430 | address 180F 8 forth_core_ext_s_backslash_quote.throw_badinput
6527 | address 18DC 2 forth_core_ext_s_backslash_quote.tohex
6536 | address 18F0 2 forth_core_ext_s_backslash_quote.tohex_done
6407 | address 17E0 3 forth_core_ext_s_backslash_quote.xt
6622 | address 18F7 1 forth_core_ext_save_input
6625 | address 18FB 1 forth_core_ext_save_input.name
6626 | address 1905 2 forth_core_ext_save_input.xt
6641 | address 1915 1 forth_core_ext_source_i_d
6646 | address 1924 1 forth_core_ext_source_i_d.body
6644 | address 1919 1 forth_core_ext_source_i_d.name
6645 | address 1922 2 forth_core_ext_source_i_d.xt
6653 | address 192C 3 forth_core_ext_to
6658 | address 1934 1 forth_core_ext_to.body
6677 | address 195D 1 forth_core_ext_to.compile
6670 | address 194F 2 forth_core_ext_to.done
6698 | address 198A 1 forth_core_ext_to.double
6672 | address 1953 1 forth_core_ext_to.imm_double
6690 | address 1979 1 forth_core_ext_to.local
6656 | address 1930 1 forth_core_ext_to.name
6705 | address 1997 1 forth_core_ext_to.runtime
6713 | address 19A5 1 forth_core_ext_to.runtime_double
6712 | address 19A3 1 forth_core_ext_to.runtime_double_xt
6704 | address 1995 2 forth_core_ext_to.runtime_xt
6688 | address 1975 2 forth_core_ext_to.storehere_done
6657 | address 1932 1 forth_core_ext_to.xt
6724 | address 19B5 1 forth_core_ext_true
6727 | address 19B9 1 forth_core_ext_true.name
6728 | address 19BD 7 forth_core_ext_true.xt
6736 | address 19C1 1 forth_core_ext_tuck
6739 | address 19C5 1 forth_core_ext_tuck.name
6740 | address 19C9 1 forth_core_ext_tuck.xt
5405 | address 134F 1 forth_core_ext_two_r_fetch
5410 | address 1358 1 forth_core_ext_two_r_fetch.body
5408 | address 1353 1 forth_core_ext_two_r_fetch.name
5409 | address 1356 2 forth_core_ext_two_r_fetch.xt
5393 | address 133E 1 forth_core_ext_two_r_from
5398 | address 1347 1 forth_core_ext_two_r_from.body
5396 | address 1342 1 forth_core_ext_two_r_from.name
5397 | address 1345 7 forth_core_ext_two_r_from.xt
5381 | address 132D 1 forth_core_ext_two_to_r
5386 | address 1336 3 forth_core_ext_two_to_r.body
5384 | address 1331 1 forth_core_ext_two_to_r.name
5385 | address 1334 5 forth_core_ext_two_to_r.xt
6750 | address 19D1 1 forth_core_ext_u_dot_r
6776 | address 19FA 1 forth_core_ext_u_dot_r.L1
6777 | address 19FC 1 forth_core_ext_u_dot_r.L2
6753 | address 19D5 1 forth_core_ext_u_dot_r.name
6754 | address 19D8 1 forth_core_ext_u_dot_r.xt
6783 | address 1A02 1 forth_core_ext_u_greater_than
6788 | address 1A0A 1 forth_core_ext_u_greater_than.body
6795 | address 1A18 1 forth_core_ext_u_greater_than.done
6794 | address 1A15 1 forth_core_ext_u_greater_than.greaterthan
6786 | address 1A06 1 forth_core_ext_u_greater_than.name
6787 | address 1A08 1 forth_core_ext_u_greater_than.xt
6801 | address 1A1E 1 forth_core_ext_unused
6806 | address 1A2A 1 forth_core_ext_unused.body
6804 | address 1A22 1 forth_core_ext_unused.name
6805 | address 1A28 1 forth_core_ext_unused.xt
6814 | address 1A34 2 forth_core_ext_value
6819 | address 1A3F 1 forth_core_ext_value.body
6817 | address 1A38 1 forth_core_ext_value.name
6830 | address 1A56 3 forth_core_ext_value.runtime
6818 | address 1A3D 1 forth_core_ext_value.xt
6837 | address 1A5E 1 forth_core_ext_within
6840 | address 1A62 1 forth_core_ext_within.name
6841 | address 1A68 1 forth_core_ext_within.xt
5366 | address 131D 1 forth_core_ext_zero_greater
5369 | address 1321 1 forth_core_ext_zero_greater.name
5370 | address 1323 1 forth_core_ext_zero_greater.xt
5351 | address 130C 1 forth_core_ext_zero_not_equals
5354 | address 1310 1 forth_core_ext_zero_not_equals.name
5355 | address 1313 2 forth_core_ext_zero_not_equals.xt
3720 | address 0C44 1 forth_core_f_m_slash_mod
3734 | address 0C64 1 forth_core_f_m_slash_mod.adjust
3725 | address 0C50 1 forth_core_f_m_slash_mod.body
3760 | address E64D 1 forth_core_f_m_slash_mod.datastack1
3779 | address E663 1 forth_core_f_m_slash_mod.datastack2
3798 | address E679 1 forth_core_f_m_slash_mod.datastack3
3817 | address E68F 1 forth_core_f_m_slash_mod.datastack4
3744 | address 0C79 2 forth_core_f_m_slash_mod.done
3723 | address 0C48 1 forth_core_f_m_slash_mod.name
3741 | address 0C72 1 forth_core_f_m_slash_mod.neg_denom
3761 | address E64F 1 forth_core_f_m_slash_mod.result1
3780 | address E665 1 forth_core_f_m_slash_mod.result2
3799 | address E67B 1 forth_core_f_m_slash_mod.result3
3818 | address E691 1 forth_core_f_m_slash_mod.result4
3724 | address 0C4E 5 forth_core_f_m_slash_mod.xt
2561 | address 07DD 1 forth_core_fetch
2566 | address 07E4 1 forth_core_fetch.body
2564 | address 07E1 1 forth_core_fetch.name
2565 | address 07E2 16 forth_core_fetch.xt
3590 | address 0C22 1 forth_core_fill
3595 | address 0C2C 1 forth_core_fill.body
3627 | address E5F0 2 forth_core_fill.buff0
3628 | address E5F1 1 forth_core_fill.buff01
3629 | address E5F2 1 forth_core_fill.buff02
3651 | address E60A 2 forth_core_fill.buff1
3652 | address E60B 1 forth_core_fill.buff11
3653 | address E60C 1 forth_core_fill.buff12
3675 | address E624 2 forth_core_fill.buff2
3676 | address E625 1 forth_core_fill.buff21
3677 | address E626 1 forth_core_fill.buff22
3699 | address E63E 2 forth_core_fill.buff3
3700 | address E63F 1 forth_core_fill.buff31
3701 | address E640 1 forth_core_fill.buff32
3622 | address E5E7 1 forth_core_fill.datastack0
3646 | address E601 1 forth_core_fill.datastack1
3670 | address E61B 1 forth_core_fill.datastack2
3694 | address E635 1 forth_core_fill.datastack3
3599 | address 0C34 1 forth_core_fill.doit
3605 | address 0C40 1 forth_core_fill.done
3601 | address 0C38 1 forth_core_fill.fill
3593 | address 0C26 1 forth_core_fill.name
3625 | address E5ED 1 forth_core_fill.result0
3649 | address E607 1 forth_core_fill.result1
3673 | address E621 1 forth_core_fill.result2
3697 | address E63B 1 forth_core_fill.result3
3594 | address 0C2A 7 forth_core_fill.xt
2223 | address 06EF 1 forth_core_greater_than
2228 | address 06F6 1 forth_core_greater_than.body
2250 | address E3CC 1 forth_core_greater_than.datastack1
2265 | address E3DC 1 forth_core_greater_than.datastack2
2235 | address 0704 1 forth_core_greater_than.done
2234 | address 0701 1 forth_core_greater_than.greaterthan
2226 | address 06F3 1 forth_core_greater_than.name
2251 | address E3CE 1 forth_core_greater_than.results1
2266 | address E3DE 1 forth_core_greater_than.results2
2227 | address 06F4 5 forth_core_greater_than.xt
3824 | address 0C7F 1 forth_core_here
3829 | address 0C89 1 forth_core_here.bodyx
3827 | address 0C83 1 forth_core_here.name
3828 | address 0C87 2 forth_core_here.xt
3836 | address 0C91 1 forth_core_hold
3841 | address 0C9B 1 forth_core_hold.body
3839 | address 0C95 1 forth_core_hold.name
3840 | address 0C99 4 forth_core_hold.xt
3850 | address 0CA7 1 forth_core_i
3855 | address 0CAE 1 forth_core_i.body
3853 | address 0CAB 1 forth_core_i.name
3854 | address 0CAC 7 forth_core_i.xt
3862 | address 0CB6 2 forth_core_if
3867 | address 0CBE 1 forth_core_if.body
3865 | address 0CBA 1 forth_core_if.name
3878 | address 0CD3 1 forth_core_if.runtime
3877 | address 0CD1 55 forth_core_if.runtime_xt
3883 | address 0CDE 1 forth_core_if.true
3866 | address 0CBC 3 forth_core_if.xt
3889 | address 0CE4 2 forth_core_immediate
3894 | address 0CF3 1 forth_core_immediate.body
3892 | address 0CE8 1 forth_core_immediate.name
3893 | address 0CF1 1 forth_core_immediate.xt
3902 | address 0D01 1 forth_core_invert
3907 | address 0D0D 1 forth_core_invert.body
3905 | address 0D05 1 forth_core_invert.name
3906 | address 0D0B 1 forth_core_invert.xt
3914 | address 0D15 1 forth_core_j
3919 | address 0D1C 1 forth_core_j.body
3917 | address 0D19 1 forth_core_j.name
3918 | address 0D1A 1 forth_core_j.xt
3926 | address 0D24 1 forth_core_key
3931 | address 0D2D 1 forth_core_key.body
3929 | address 0D28 1 forth_core_key.name
3930 | address 0D2B 2 forth_core_key.xt
4010 | address 0DB9 1 forth_core_l_shift
4015 | address 0DC5 1 forth_core_l_shift.body
4023 | address 0DD3 1 forth_core_l_shift.done
4018 | address 0DCB 1 forth_core_l_shift.loop
4013 | address 0DBD 1 forth_core_l_shift.name
4014 | address 0DC3 2 forth_core_l_shift.xt
3938 | address 0D37 2 forth_core_leave
3943 | address 0D42 1 forth_core_leave.body
3941 | address 0D3B 1 forth_core_leave.name
3957 | address 0D5D 1 forth_core_leave.runtime
3956 | address 0D5B 2 forth_core_leave.runtime_xt
3942 | address 0D40 1 forth_core_leave.xt
5237 | address 1281 1 forth_core_left_bracket
5240 | address 1285 1 forth_core_left_bracket.name
5241 | address 1286 2 forth_core_left_bracket.xt
2192 | address 06C1 1 forth_core_less_number_sign
2197 | address 06C9 1 forth_core_less_number_sign.body
2195 | address 06C5 1 forth_core_less_number_sign.name
2196 | address 06C7 9 forth_core_less_number_sign.xt
2144 | address 06A6 1 forth_core_less_than
2149 | address 06AD 1 forth_core_less_than.body
2171 | address E3AC 1 forth_core_less_than.datastack1
2186 | address E3BC 1 forth_core_less_than.datastack2
2156 | address 06BB 1 forth_core_less_than.done
2155 | address 06B8 1 forth_core_less_than.lessthan
2147 | address 06AA 1 forth_core_less_than.name
2172 | address E3AE 1 forth_core_less_than.results1
2187 | address E3BE 1 forth_core_less_than.results2
2148 | address 06AB 9 forth_core_less_than.xt
3964 | address 0D66 2 forth_core_literal
3969 | address 0D73 1 forth_core_literal.body
3967 | address 0D6A 1 forth_core_literal.name
3979 | address 0D86 1 forth_core_literal.runtime
3978 | address 0D84 114 forth_core_literal.runtime_xt
3968 | address 0D71 9 forth_core_literal.xt
3986 | address 0D8E 2 forth_core_loop
3991 | address 0D98 1 forth_core_loop.body
4003 | address 0DB1 1 forth_core_loop.done
3989 | address 0D92 1 forth_core_loop.name
3995 | address 0DA0 1 forth_core_loop.runtime
3994 | address 0D9E 13 forth_core_loop.runtime_xt
3990 | address 0D96 1 forth_core_loop.xt
4028 | address 0DD7 1 forth_core_m_star
4033 | address 0DDF 1 forth_core_m_star.body
4047 | address 0DFD 2 forth_core_m_star.chksign
4067 | address E6A3 2 forth_core_m_star.datastack1
4084 | address E6B5 2 forth_core_m_star.datastack2
4045 | address 0DF9 1 forth_core_m_star.done
4031 | address 0DDB 1 forth_core_m_star.name
4052 | address 0E05 1 forth_core_m_star.skip
4032 | address 0DDD 5 forth_core_m_star.xt
4090 | address 0E06 1 forth_core_max
4105 | address 0E1D 1 forth_core_max.L1
4106 | address 0E1F 1 forth_core_max.L2
4093 | address 0E0A 1 forth_core_max.name
4094 | address 0E0D 1 forth_core_max.xt
4110 | address 0E21 1 forth_core_min
4125 | address 0E38 1 forth_core_min.L1
4126 | address 0E3A 1 forth_core_min.L2
4140 | address E6C7 1 forth_core_min.datastack1
4156 | address E6D9 1 forth_core_min.datastack2
4113 | address 0E25 1 forth_core_min.name
4141 | address E6C9 1 forth_core_min.results1
4157 | address E6DB 1 forth_core_min.results2
4114 | address 0E28 4 forth_core_min.xt
1739 | address 0501 1 forth_core_minus
1744 | address 0508 1 forth_core_minus.body
1742 | address 0505 1 forth_core_minus.name
1743 | address 0506 10 forth_core_minus.xt
4162 | address 0E3C 1 forth_core_mod
4165 | address 0E40 1 forth_core_mod.name
4166 | address 0E43 1 forth_core_mod.xt
4176 | address 0E4B 1 forth_core_move
4181 | address 0E55 1 forth_core_move.body
4212 | address E6F2 2 forth_core_move.buf10
4213 | address E6F3 2 forth_core_move.buf11
4214 | address E6F4 1 forth_core_move.buf12
4208 | address E6EB 1 forth_core_move.datastack1
4190 | address 0E6B 1 forth_core_move.done
4189 | address 0E68 2 forth_core_move.forward
4179 | address 0E4F 1 forth_core_move.name
4211 | address E6F1 1 forth_core_move.result1
4180 | address 0E53 2 forth_core_move.xt
4219 | address 0E72 1 forth_core_negate
4224 | address 0E7E 1 forth_core_negate.body
4222 | address 0E76 1 forth_core_negate.name
4223 | address 0E7C 2 forth_core_negate.xt
1375 | address 0383 1 forth_core_number_sign
1388 | address 0398 1 forth_core_number_sign.10
1397 | address 03A9 1 forth_core_number_sign.15
1400 | address 03AF 1 forth_core_number_sign.20
1401 | address 03B1 1 forth_core_number_sign.30
1410 | address 03C5 1 forth_core_number_sign.40
1380 | address 038A 1 forth_core_number_sign.body
1439 | address E2E1 2 forth_core_number_sign.datastack
1463 | address E2F5 2 forth_core_number_sign.datastack1
1487 | address E309 2 forth_core_number_sign.datastack2
1442 | address E2E5 2 forth_core_number_sign.digit
1466 | address E2F9 2 forth_core_number_sign.digit1
1490 | address E30D 2 forth_core_number_sign.digit2
1443 | address E2E6 1 forth_core_number_sign.here
1467 | address E2FA 1 forth_core_number_sign.here1
1491 | address E30E 1 forth_core_number_sign.here2
1378 | address 0387 1 forth_core_number_sign.name
1379 | address 0388 11 forth_core_number_sign.xt
1496 | address 03DB 1 forth_core_number_sign_greater
1501 | address 03E3 1 forth_core_number_sign_greater.body
1499 | address 03DF 1 forth_core_number_sign_greater.name
1500 | address 03E1 9 forth_core_number_sign_greater.xt
1512 | address 03F4 1 forth_core_number_sign_s
1520 | address 03FC 1 forth_core_number_sign_s.L1
1515 | address 03F8 1 forth_core_number_sign_s.name
1516 | address 03FA 7 forth_core_number_sign_s.xt
1897 | address 0598 1 forth_core_one_minus
1900 | address 059C 1 forth_core_one_minus.name
1901 | address 059E 7 forth_core_one_minus.xt
1882 | address 0588 1 forth_core_one_plus
1885 | address 058C 1 forth_core_one_plus.name
1886 | address 058E 7 forth_core_one_plus.xt
4233 | address 0E88 1 forth_core_or
4238 | address 0E90 1 forth_core_or.body
4236 | address 0E8C 1 forth_core_or.name
4237 | address 0E8E 1 forth_core_or.xt
4247 | address 0E9C 1 forth_core_over
4252 | address 0EA6 1 forth_core_over.body
4250 | address 0EA0 1 forth_core_over.name
4251 | address 0EA4 18 forth_core_over.xt
1580 | address 0423 2 forth_core_paren
1583 | address 0427 1 forth_core_paren.name
1584 | address 0428 1 forth_core_paren.xt
1641 | address 0466 1 forth_core_plus
1646 | address 046D 1 forth_core_plus.body
1644 | address 046A 1 forth_core_plus.name
1645 | address 046B 12 forth_core_plus.xt
1672 | address 048D 2 forth_core_plus_loop
1677 | address 0498 1 forth_core_plus_loop.body
1687 | address 04AD 1 forth_core_plus_loop.checkleave
1717 | address 04E4 1 forth_core_plus_loop.done
1691 | address 04B5 1 forth_core_plus_loop.fixup
1675 | address 0491 1 forth_core_plus_loop.name
1678 | address 049B 1 forth_core_plus_loop.rest
1706 | address 04CC 1 forth_core_plus_loop.runtime
1705 | address 04CA 4 forth_core_plus_loop.runtime_xt
1676 | address 0496 1 forth_core_plus_loop.xt
1698 | address 04C2 1 forth_core_plus_loop.xtdone
1654 | address 0477 1 forth_core_plus_store
1657 | address 047B 1 forth_core_plus_store.name
1658 | address 047D 1 forth_core_plus_store.xt
4259 | address 0EAE 1 forth_core_postpone
4283 | address 0ED0 1 forth_core_postpone.L3
4290 | address 0EDE 1 forth_core_postpone.L4
4300 | address 0EF2 1 forth_core_postpone.L5
4301 | address 0EF4 2 forth_core_postpone.L6
4262 | address 0EB2 1 forth_core_postpone.name
4263 | address 0EBA 1 forth_core_postpone.xt
2548 | address 07C9 1 forth_core_question_dupe
2553 | address 07D3 1 forth_core_question_dupe.body
2556 | address 07D9 1 forth_core_question_dupe.done
2551 | address 07CD 1 forth_core_question_dupe.name
2552 | address 07D1 3 forth_core_question_dupe.xt
4305 | address 0EF6 1 forth_core_quit
4375 | address 0F6E 3 forth_core_quit.L10
4377 | address 0F72 1 forth_core_quit.L11
4329 | address 0F0A 1 forth_core_quit.L3
4349 | address 0F33 1 forth_core_quit.L5
4351 | address 0F37 1 forth_core_quit.L6
4358 | address 0F45 1 forth_core_quit.L7
4366 | address 0F55 1 forth_core_quit.L8
4394 | address 0F94 1 forth_core_quit.abort_msg
4395 | equate 0006 1 forth_core_quit.abort_msg_len
4391 | address 0F8E 2 forth_core_quit.abort_xt
4381 | address 0F78 1 forth_core_quit.abortq_body
4380 | address 0F76 1 forth_core_quit.abortq_xt
4446 | address E75A 1 forth_core_quit.bye
4369 | address 0F5B 1 forth_core_quit.expmsg
4370 | equate 000B 1 forth_core_quit.expmsg_len
4428 | address E70C 1 forth_core_quit.getchar
4434 | address E719 2 forth_core_quit.input
4435 | address E71B 1 forth_core_quit.inputbuf
4308 | address 0EFA 1 forth_core_quit.name
4436 | address E72B 1 forth_core_quit.nu1
4443 | address E738 2 forth_core_quit.output
4444 | address E73A 2 forth_core_quit.outputbuf
4438 | address E72C 1 forth_core_quit.putchar
4452 | address E75F 2 forth_core_quit.ret
4454 | address E761 2 forth_core_quit.source
4309 | address 0EFE 3 forth_core_quit.xt
4472 | address 0FB4 1 forth_core_r_fetch
4477 | address 0FBC 1 forth_core_r_fetch.body
4475 | address 0FB8 1 forth_core_r_fetch.name
4476 | address 0FBA 3 forth_core_r_fetch.xt
4460 | address 0FA4 1 forth_core_r_from
4465 | address 0FAC 1 forth_core_r_from.body
4463 | address 0FA8 1 forth_core_r_from.name
4464 | address 0FAA 19 forth_core_r_from.xt
4569 | address 1006 1 forth_core_r_shift
4574 | address 1012 1 forth_core_r_shift.body
4582 | address 1020 1 forth_core_r_shift.done
4577 | address 1018 1 forth_core_r_shift.loop
4572 | address 100A 1 forth_core_r_shift.name
4573 | address 1010 1 forth_core_r_shift.xt
4484 | address 0FC4 2 forth_core_recurse
4515 | address E7CD 1 forth_core_recurse.L1
4507 | address E7C0 1 forth_core_recurse._nw2
4489 | address 0FD1 1 forth_core_recurse.body
4506 | address E7BE 1 forth_core_recurse.datastack
4487 | address 0FC8 1 forth_core_recurse.name
4509 | address E7C1 2 forth_core_recurse.recurse_xt
4488 | address 0FCF 1 forth_core_recurse.xt
4522 | address 0FDD 1 forth_core_repeat
4525 | address 0FE1 1 forth_core_repeat.name
4526 | address 0FE7 1 forth_core_repeat.xt
5280 | address 12B1 1 forth_core_right_bracket
5283 | address 12B5 1 forth_core_right_bracket.name
5284 | address 12B6 1 forth_core_right_bracket.xt
4536 | address 0FEF 1 forth_core_rote
4541 | address 0FF8 1 forth_core_rote.body
4562 | address E7DF 2 forth_core_rote.datastack
4539 | address 0FF3 1 forth_core_rote.name
4540 | address 0FF6 5 forth_core_rote.xt
4697 | address 105D 1 forth_core_s_m_slash_rem
4712 | address 107B 1 forth_core_s_m_slash_rem.10
4717 | address 1086 1 forth_core_s_m_slash_rem.20
4727 | address 1099 1 forth_core_s_m_slash_rem.30
4734 | address 10A5 1 forth_core_s_m_slash_rem.40
4702 | address 1069 1 forth_core_s_m_slash_rem.body
4752 | address E847 1 forth_core_s_m_slash_rem.datastack1
4771 | address E85D 1 forth_core_s_m_slash_rem.datastack2
4790 | address E873 1 forth_core_s_m_slash_rem.datastack3
4809 | address E889 1 forth_core_s_m_slash_rem.datastack4
4700 | address 1061 1 forth_core_s_m_slash_rem.name
4753 | address E849 1 forth_core_s_m_slash_rem.result1
4772 | address E85F 1 forth_core_s_m_slash_rem.result2
4791 | address E875 1 forth_core_s_m_slash_rem.result3
4810 | address E88B 1 forth_core_s_m_slash_rem.result4
4737 | address 10AB 3 forth_core_s_m_slash_rem.throw_div0
4701 | address 1067 8 forth_core_s_m_slash_rem.xt
4587 | address 1024 2 forth_core_s_quote
4622 | address E7F5 2 forth_core_s_quote.buffer1
4620 | address E7F3 2 forth_core_s_quote.datastack1
4645 | address E82D 1 forth_core_s_quote.datastack2
4628 | address E80C 1 forth_core_s_quote.foo_addr
4626 | address E808 2 forth_core_s_quote.foo_body
4627 | address E80A 1 forth_core_s_quote.foo_len
4647 | address E82F 1 forth_core_s_quote.foo_xt
4623 | equate 0011 3 forth_core_s_quote.len1
4651 | equate 0004 2 forth_core_s_quote.len2
4590 | address 1028 1 forth_core_s_quote.name
4643 | address E829 1 forth_core_s_quote.result2
4629 | address E81D 1 forth_core_s_quote.stop
4650 | address E835 2 forth_core_s_quote.text2
4591 | address 102A 5 forth_core_s_quote.xt
4657 | address 1036 1 forth_core_s_to_d
4660 | address 103A 1 forth_core_s_to_d.name
4661 | address 103D 2 forth_core_s_to_d.xt
2120 | address 0680 2 forth_core_semicolon
2125 | address 0687 2 forth_core_semicolon.body
2123 | address 0684 1 forth_core_semicolon.name
2135 | address 069C 1 forth_core_semicolon.no_name
2124 | address 0685 1 forth_core_semicolon.xt
4671 | address 1045 1 forth_core_sign
4685 | address 105B 1 forth_core_sign.L1
4674 | address 1049 1 forth_core_sign.name
4675 | address 104D 5 forth_core_sign.xt
1821 | address 0545 1 forth_core_slash
1824 | address 0549 1 forth_core_slash.name
1825 | address 054A 1 forth_core_slash.xt
1836 | address 0554 1 forth_core_slash_mod
1839 | address 0558 1 forth_core_slash_mod.name
1840 | address 055C 3 forth_core_slash_mod.xt
4816 | address 10B1 1 forth_core_source
4821 | address 10BD 1 forth_core_source.body
4819 | address 10B5 1 forth_core_source.name
4820 | address 10BB 3 forth_core_source.xt
4829 | address 10C7 1 forth_core_space
4832 | address 10CB 1 forth_core_space.name
4833 | address 10D0 11 forth_core_space.xt
4843 | address 10D8 1 forth_core_spaces
4858 | address 10F2 1 forth_core_spaces.L1
4855 | address 10EC 1 forth_core_spaces.L2
4846 | address 10DC 1 forth_core_spaces.name
4847 | address 10E2 4 forth_core_spaces.xt
1596 | address 0434 1 forth_core_star
1599 | address 0438 1 forth_core_star.name
1600 | address 0439 2 forth_core_star.xt
1610 | address 0441 1 forth_core_star_slash
1613 | address 0445 1 forth_core_star_slash.name
1614 | address 0447 1 forth_core_star_slash.xt
1625 | address 0451 4 forth_core_star_slash_mod
1628 | address 0455 1 forth_core_star_slash_mod.name
1629 | address 045A 5 forth_core_star_slash_mod.xt
1362 | address 0372 1 forth_core_store
1367 | address 0379 1 forth_core_store.body
1365 | address 0376 1 forth_core_store.name
1366 | address 0377 12 forth_core_store.xt
4874 | address 10F4 1 forth_core_swap
4879 | address 10FE 1 forth_core_swap.body
4877 | address 10F8 1 forth_core_swap.name
4878 | address 10FC 22 forth_core_swap.xt
4887 | address 1108 1 forth_core_then
4892 | address 1112 1 forth_core_then.body
4890 | address 110C 1 forth_core_then.name
4891 | address 1110 4 forth_core_then.xt
1529 | address 0408 1 forth_core_tick
1546 | address 0421 1 forth_core_tick.L1
1574 | address E32D 2 forth_core_tick.buffer
1572 | address E32B 1 forth_core_tick.datastack
1575 | equate 0007 1 forth_core_tick.len
1532 | address 040C 1 forth_core_tick.name
1571 | address E329 1 forth_core_tick.result
1533 | address 040D 6 forth_core_tick.xt
2271 | address 070A 1 forth_core_to_body
2276 | address 0715 1 forth_core_to_body.body
2274 | address 070E 1 forth_core_to_body.name
2275 | address 0713 3 forth_core_to_body.xt
2284 | address 071F 1 forth_core_to_in
2289 | address 0728 1 forth_core_to_in.body
2287 | address 0723 1 forth_core_to_in.name
2288 | address 0726 4 forth_core_to_in.xt
2308 | address 0731 1 forth_core_to_number
2313 | address 073E 1 forth_core_to_number.body
2394 | address E3EC 2 forth_core_to_number.datastack0
2420 | address E402 2 forth_core_to_number.datastack1
2446 | address E41E 2 forth_core_to_number.datastack2
2472 | address E439 2 forth_core_to_number.datastack3
2498 | address E457 1 forth_core_to_number.datastack4
2524 | address E475 1 forth_core_to_number.datastack5
2371 | address 07AD 3 forth_core_to_number.done
2401 | equate 0001 2 forth_core_to_number.len0
2427 | equate 0007 2 forth_core_to_number.len1
2453 | equate 0006 2 forth_core_to_number.len2
2479 | equate 0009 2 forth_core_to_number.len3
2505 | equate 0009 2 forth_core_to_number.len4
2531 | equate 0004 2 forth_core_to_number.len5
2311 | address 0735 1 forth_core_to_number.name
2334 | address 0768 2 forth_core_to_number.no_adjust
2399 | address E3F4 1 forth_core_to_number.nu0
2425 | address E40A 1 forth_core_to_number.nu1
2451 | address E426 1 forth_core_to_number.nu2
2477 | address E441 1 forth_core_to_number.nu3
2503 | address E45F 1 forth_core_to_number.nu4
2529 | address E47D 1 forth_core_to_number.nu5
2321 | address 074E 1 forth_core_to_number.read_char
2375 | address 07B5 2 forth_core_to_number.return
2400 | address E3F5 3 forth_core_to_number.text0
2426 | address E40B 3 forth_core_to_number.text1
2452 | address E427 3 forth_core_to_number.text2
2478 | address E442 3 forth_core_to_number.text3
2504 | address E460 3 forth_core_to_number.text4
2530 | address E47E 3 forth_core_to_number.text5
2312 | address 073C 8 forth_core_to_number.xt
2536 | address 07B9 1 forth_core_to_r
2541 | address 07C1 1 forth_core_to_r.body
2539 | address 07BD 1 forth_core_to_r.name
2540 | address 07BF 17 forth_core_to_r.xt
1976 | address 05F4 1 forth_core_two_drop
1979 | address 05F8 1 forth_core_two_drop.name
1980 | address 05FD 18 forth_core_two_drop.xt
1990 | address 0605 1 forth_core_two_dupe
1993 | address 0609 1 forth_core_two_dupe.name
1994 | address 060D 16 forth_core_two_dupe.xt
1958 | address 05DE 1 forth_core_two_fetch
1961 | address 05E2 1 forth_core_two_fetch.name
1962 | address 05E4 2 forth_core_two_fetch.xt
2004 | address 0615 1 forth_core_two_over
2009 | address 0620 1 forth_core_two_over.body
2007 | address 0619 1 forth_core_two_over.name
2008 | address 061E 5 forth_core_two_over.xt
1944 | address 05CC 1 forth_core_two_slash
1949 | address 05D4 1 forth_core_two_slash.body
1947 | address 05D0 1 forth_core_two_slash.name
1948 | address 05D2 2 forth_core_two_slash.xt
1929 | address 05BC 1 forth_core_two_star
1932 | address 05C0 1 forth_core_two_star.name
1933 | address 05C2 1 forth_core_two_star.xt
1912 | address 05A8 1 forth_core_two_store
1915 | address 05AC 1 forth_core_two_store.name
1916 | address 05AE 1 forth_core_two_store.xt
2017 | address 062A 1 forth_core_two_swap
2022 | address 0635 1 forth_core_two_swap.body
2049 | address E36C 2 forth_core_two_swap.datastack
2020 | address 062E 1 forth_core_two_swap.name
2021 | address 0633 3 forth_core_two_swap.xt
4900 | address 111C 1 forth_core_type
4918 | address 113A 1 forth_core_type.L1
4912 | address 112E 1 forth_core_type.L2
4932 | address E89B 1 forth_core_type.datastack
4936 | equate 000D 1 forth_core_type.len
4903 | address 1120 1 forth_core_type.name
4929 | address E898 1 forth_core_type.sysnul
4935 | address E89F 2 forth_core_type.text
4904 | address 1124 25 forth_core_type.xt
4941 | address 113E 1 forth_core_u_dot
4944 | address 1142 1 forth_core_u_dot.name
4945 | address 1144 3 forth_core_u_dot.xt
4960 | address 1156 1 forth_core_u_less_than
4965 | address 115E 1 forth_core_u_less_than.body
4972 | address 116C 1 forth_core_u_less_than.done
4971 | address 1169 1 forth_core_u_less_than.lessthan
4963 | address 115A 1 forth_core_u_less_than.name
4964 | address 115C 2 forth_core_u_less_than.xt
4990 | address 1184 1 forth_core_u_m_slash_mod
4995 | address 1190 1 forth_core_u_m_slash_mod.body
5016 | address E8BA 1 forth_core_u_m_slash_mod.datastack1
5034 | address E8CE 1 forth_core_u_m_slash_mod.datastack2
4993 | address 1188 1 forth_core_u_m_slash_mod.name
5017 | address E8BC 1 forth_core_u_m_slash_mod.result1
5035 | address E8D0 1 forth_core_u_m_slash_mod.result2
4994 | address 118E 3 forth_core_u_m_slash_mod.xt
4978 | address 1172 1 forth_core_u_m_star
4983 | address 117B 1 forth_core_u_m_star.body
4981 | address 1176 1 forth_core_u_m_star.name
4982 | address 1179 1 forth_core_u_m_star.xt
5041 | address 11A1 1 forth_core_unloop
5046 | address 11AD 1 forth_core_unloop.body
5044 | address 11A5 1 forth_core_unloop.name
5045 | address 11AB 3 forth_core_unloop.xt
5052 | address 11B3 2 forth_core_until
5057 | address 11BE 1 forth_core_until.body
5072 | address 11DC 1 forth_core_until.done
5055 | address 11B7 1 forth_core_until.name
5067 | address 11D1 1 forth_core_until.runtime
5066 | address 11CF 4 forth_core_until.runtime_xt
5056 | address 11BC 1 forth_core_until.xt
5078 | address 11E2 1 forth_core_variable
5081 | address 11E6 1 forth_core_variable.name
5082 | address 11EE 1 forth_core_variable.xt
5094 | address 11FA 1 forth_core_while
5097 | address 11FE 1 forth_core_while.name
5098 | address 1203 1 forth_core_while.xt
5117 | address 120F 1 forth_core_word
5123 | address 1219 1 forth_core_word.body
5184 | address E8E2 2 forth_core_word.buffer1
5212 | address E950 2 forth_core_word.buffer2
5151 | address 1255 1 forth_core_word.copy
5182 | address E8E0 2 forth_core_word.datastack1
5210 | address E94E 2 forth_core_word.datastack2
5155 | address 125C 1 forth_core_word.done
5187 | address E8E9 1 forth_core_word.here
5215 | address E956 1 forth_core_word.here2
5185 | equate 0007 1 forth_core_word.len1
5213 | equate 0006 1 forth_core_word.len2
5120 | address 1213 1 forth_core_word.name
5158 | address 1262 1 forth_core_word.no_input
5143 | address 1243 1 forth_core_word.resume
5131 | address 1229 1 forth_core_word.skip_delim
5161 | address 1266 1 forth_core_word.throw
5188 | address E93D 2 forth_core_word.word_len
5216 | address E9AA 2 forth_core_word.word_len2
5189 | address E93E 1 forth_core_word.word_text
5121 | address 1217 11 forth_core_word.xt
5223 | address 126C 1 forth_core_x_or
5228 | address 1275 1 forth_core_x_or.body
5226 | address 1270 1 forth_core_x_or.name
5227 | address 1273 1 forth_core_x_or.xt
1867 | address 0578 1 forth_core_zero_equals
1870 | address 057C 1 forth_core_zero_equals.name
1871 | address 057E 15 forth_core_zero_equals.xt
1852 | address 0568 1 forth_core_zero_less
1855 | address 056C 1 forth_core_zero_less.name
1856 | address 056E 4 forth_core_zero_less.xt
7204 | address 1C70 1 forth_double_d_abs
7217 | address 1C84 1 forth_double_d_abs.L1
7232 | address EB9A 2 forth_double_d_abs.datastack1
7207 | address 1C74 1 forth_double_d_abs.name
7208 | address 1C78 4 forth_double_d_abs.xt
6987 | address 1B46 1 forth_double_d_dot
7025 | address EB86 1 forth_double_d_dot.datastack
6990 | address 1B4A 1 forth_double_d_dot.name
7027 | address EB8A 1 forth_double_d_dot.result
7021 | address EB81 1 forth_double_d_dot.sysnul
6991 | address 1B4C 4 forth_double_d_dot.xt
7032 | address 1B6A 1 forth_double_d_dot_r
7066 | address 1B9F 1 forth_double_d_dot_r.L1
7067 | address 1BA1 1 forth_double_d_dot_r.L2
7035 | address 1B6E 1 forth_double_d_dot_r.name
7036 | address 1B71 1 forth_double_d_dot_r.xt
7169 | address 1C3E 1 forth_double_d_equals
7174 | address 1C46 1 forth_double_d_equals.body
7181 | address 1C57 1 forth_double_d_equals.done
7172 | address 1C42 1 forth_double_d_equals.name
7185 | address 1C5F 2 forth_double_d_equals.notequal
7173 | address 1C44 1 forth_double_d_equals.xt
7138 | address 1C0B 1 forth_double_d_less_than
7143 | address 1C13 1 forth_double_d_less_than.body
7149 | address 1C1D 1 forth_double_d_less_than.compare
7161 | address 1C33 1 forth_double_d_less_than.done
7141 | address 1C0F 1 forth_double_d_less_than.name
7164 | address 1C39 1 forth_double_d_less_than.true
7142 | address 1C11 3 forth_double_d_less_than.xt
7238 | address 1C86 1 forth_double_d_max
7260 | address 1CA4 1 forth_double_d_max.L1
7261 | address 1CA6 1 forth_double_d_max.L2
7241 | address 1C8A 1 forth_double_d_max.name
7242 | address 1C8E 1 forth_double_d_max.xt
7265 | address 1CA8 1 forth_double_d_min
7285 | address 1CC2 1 forth_double_d_min.L1
7288 | address 1CC8 1 forth_double_d_min.L2
7268 | address 1CAC 1 forth_double_d_min.name
7269 | address 1CB0 1 forth_double_d_min.xt
6969 | address 1B2A 1 forth_double_d_minus
6974 | address 1B32 1 forth_double_d_minus.body
6972 | address 1B2E 1 forth_double_d_minus.name
6973 | address 1B30 1 forth_double_d_minus.xt
7292 | address 1CCA 1 forth_double_d_negate
7297 | address 1CD7 1 forth_double_d_negate.body
7314 | address EBAA 2 forth_double_d_negate.datastack
7330 | address EBBA 2 forth_double_d_negate.datastack1
7295 | address 1CCE 1 forth_double_d_negate.name
7296 | address 1CD5 4 forth_double_d_negate.xt
6951 | address 1B0E 1 forth_double_d_plus
6956 | address 1B16 1 forth_double_d_plus.body
6954 | address 1B12 1 forth_double_d_plus.name
6955 | address 1B14 1 forth_double_d_plus.xt
7191 | address 1C63 1 forth_double_d_to_s
7194 | address 1C67 1 forth_double_d_to_s.name
7195 | address 1C6A 1 forth_double_d_to_s.xt
7124 | address 1BF6 1 forth_double_d_two_slash
7129 | address 1BFF 1 forth_double_d_two_slash.body
7127 | address 1BFA 1 forth_double_d_two_slash.name
7128 | address 1BFD 1 forth_double_d_two_slash.xt
7110 | address 1BE1 1 forth_double_d_two_star
7115 | address 1BEA 1 forth_double_d_two_star.body
7113 | address 1BE5 1 forth_double_d_two_star.name
7114 | address 1BE8 1 forth_double_d_two_star.xt
7091 | address 1BC3 1 forth_double_d_zero_equal
7096 | address 1BCC 1 forth_double_d_zero_equal.body
7104 | address 1BDB 1 forth_double_d_zero_equal.done
7102 | address 1BD9 2 forth_double_d_zero_equal.false
7094 | address 1BC7 1 forth_double_d_zero_equal.name
7095 | address 1BCA 2 forth_double_d_zero_equal.xt
7073 | address 1BA7 1 forth_double_d_zero_less
7078 | address 1BB0 1 forth_double_d_zero_less.body
7084 | address 1BBB 1 forth_double_d_zero_less.done
7076 | address 1BAB 1 forth_double_d_zero_less.name
7077 | address 1BAE 2 forth_double_d_zero_less.xt
7083 | address 1BB8 1 forth_double_d_zero_less.yes
7584 | address 1E3A 1 forth_double_ext_d_u_less
7589 | address 1E43 1 forth_double_ext_d_u_less.body
7587 | address 1E3E 1 forth_double_ext_d_u_less.name
7588 | address 1E41 1 forth_double_ext_d_u_less.xt
7536 | address 1DE5 1 forth_double_ext_two_rote
7539 | address 1DE9 1 forth_double_ext_two_rote.name
7540 | address 1DED 1 forth_double_ext_two_rote.xt
7554 | address 1DFD 2 forth_double_ext_two_value
7559 | address 1E09 1 forth_double_ext_two_value.body
7557 | address 1E01 1 forth_double_ext_two_value.name
7575 | address 1E2E 3 forth_double_ext_two_value.runtime
7558 | address 1E07 1 forth_double_ext_two_value.xt
7509 | address 1DBC 1 forth_double_m_plus
7514 | address 1DC4 1 forth_double_m_plus.body
7512 | address 1DC0 1 forth_double_m_plus.name
7518 | address 1DCD 1 forth_double_m_plus.positive
7520 | address 1DCF 1 forth_double_m_plus.save
7513 | address 1DC2 1 forth_double_m_plus.xt
7359 | address 1CE0 1 forth_double_m_star_slash
7454 | address 1D80 1 forth_double_m_star_slash.10
7467 | address 1D99 1 forth_double_m_star_slash.20
7468 | address 1D9B 1 forth_double_m_star_slash.30
7481 | address 1DB6 1 forth_double_m_star_slash.40
7364 | address 1CE9 1 forth_double_m_star_slash.body
7367 | address 1CF2 1 forth_double_m_star_slash.clear
7388 | address 1D10 1 forth_double_m_star_slash.d1_okay
7501 | address EBD2 1 forth_double_m_star_slash.datastack1
7379 | address 1D07 1 forth_double_m_star_slash.n1_okay
7362 | address 1CE4 1 forth_double_m_star_slash.name
7503 | address EBD6 1 forth_double_m_star_slash.result1
7363 | address 1CE7 2 forth_double_m_star_slash.xt
6887 | address 1A9E 2 forth_double_two_constant
6899 | address 1AB5 3 forth_double_two_constant.does
6890 | address 1AA2 1 forth_double_two_constant.name
6891 | address 1AAB 1 forth_double_two_constant.xt
6905 | address 1ABC 2 forth_double_two_literal
6910 | address 1ACA 1 forth_double_two_literal.body
6908 | address 1AC0 1 forth_double_two_literal.name
6922 | address 1AE1 1 forth_double_two_literal.runtime
6921 | address 1ADF 4 forth_double_two_literal.runtime_xt
6909 | address 1AC8 2 forth_double_two_literal.xt
6932 | address 1AEF 1 forth_double_two_variable
6935 | address 1AF3 1 forth_double_two_variable.name
6936 | address 1AFC 1 forth_double_two_variable.xt
7599 | address 1E4A 1 forth_exception_catch
7604 | address 1E55 1 forth_exception_catch.body
7602 | address 1E4E 1 forth_exception_catch.name
7603 | address 1E53 3 forth_exception_catch.xt
7743 | address 1EC2 1 forth_exception_ext_abort
7746 | address 1EC6 1 forth_exception_ext_abort.name
7747 | address 1ECB 3 forth_exception_ext_abort.xt
7758 | address 1ED5 1 forth_exception_ext_abort_quote
7761 | address 1ED9 1 forth_exception_ext_abort_quote.name
7786 | address 1EFD 1 forth_exception_ext_abort_quote.save_abort_msg_body
7784 | address 1EFB 1 forth_exception_ext_abort_quote.save_abort_msg_xt
7762 | address 1EDF 1 forth_exception_ext_abort_quote.xt
7628 | address 1E81 1 forth_exception_throw
7722 | address EC35 1 forth_exception_throw.L1
7727 | address EC3F 1 forth_exception_throw.L2
7663 | address 1EBA 15 forth_exception_throw.asm
7698 | address EC06 1 forth_exception_throw.bar_xt
7708 | address EC18 1 forth_exception_throw.baz_xt
7633 | address 1E8C 2 forth_exception_throw.body
7686 | address EBF2 1 forth_exception_throw.datastack
7688 | address EBF4 1 forth_exception_throw.foo_xt
7718 | equate 0005 1 forth_exception_throw.len1
7725 | equate 0004 1 forth_exception_throw.len2
7631 | address 1E85 1 forth_exception_throw.name
7652 | address 1EB3 1 forth_exception_throw.nothrow
7734 | address EC4D 2 forth_exception_throw.output
7735 | address EC4F 2 forth_exception_throw.outputbuf
7655 | address 1EB9 1 forth_exception_throw.panic
7729 | address EC41 1 forth_exception_throw.putchar
7685 | address EBF0 1 forth_exception_throw.results
7717 | address EC2A 1 forth_exception_throw.text1
7724 | address EC39 1 forth_exception_throw.text2
7632 | address 1E8A 13 forth_exception_throw.xt
8167 | address 2082 1 forth_local_ext_brace_colon
8188 | address 209A 1 forth_local_ext_brace_colon.L100
8196 | address 20AA 1 forth_local_ext_brace_colon.L101
8221 | address 20CA 1 forth_local_ext_brace_colon.L203
8231 | address 20DE 1 forth_local_ext_brace_colon.L204
8236 | address 20E8 2 forth_local_ext_brace_colon.L205
8260 | address 2103 1 forth_local_ext_brace_colon.L303
8271 | address 2119 1 forth_local_ext_brace_colon.L304
8281 | address 212D 1 forth_local_ext_brace_colon.L305
8283 | address 2131 3 forth_local_ext_brace_colon.L306
8351 | address EFC3 1 forth_local_ext_brace_colon._nu1
8353 | address EFCA 1 forth_local_ext_brace_colon._nu2
8355 | address EFD1 1 forth_local_ext_brace_colon._nu3
8357 | address EFD4 1 forth_local_ext_brace_colon._nu4
8359 | address EFD7 1 forth_local_ext_brace_colon._nu5
8352 | address EFC4 1 forth_local_ext_brace_colon.alpha
8358 | address EFD5 1 forth_local_ext_brace_colon.colon
8347 | address EF90 1 forth_local_ext_brace_colon.datastack1
8354 | address EFCB 1 forth_local_ext_brace_colon.gamma
8187 | address 2098 2 forth_local_ext_brace_colon.ignore_xt
8350 | equate 0031 1 forth_local_ext_brace_colon.len
8170 | address 2086 1 forth_local_ext_brace_colon.name
8247 | address 20EA 2 forth_local_ext_brace_colon.parse_xt
8356 | address EFD2 1 forth_local_ext_brace_colon.semicolon
8349 | address EF92 2 forth_local_ext_brace_colon.text
8208 | address 20B0 2 forth_local_ext_brace_colon.vars_xt
8171 | address 2088 2 forth_local_ext_brace_colon.xt
8153 | address 206F 1 forth_local_ext_locals_bar
8156 | address 2073 1 forth_local_ext_locals_bar.name
8157 | address 207A 1 forth_local_ext_locals_bar.xt
7858 | address 1F63 2 forth_local_paren_local_paren
7863 | address 1F70 1 forth_local_paren_local_paren.body
7902 | address 1FAA 1 forth_local_paren_local_paren.continue
7921 | address 1FD7 1 forth_local_paren_local_paren.finish
7861 | address 1F67 1 forth_local_paren_local_paren.name
7945 | address 2008 3 forth_local_paren_local_paren.runtime
7898 | address 1FA2 1 forth_local_paren_local_paren.skip_init
7940 | address 1FFC 1 forth_local_paren_local_paren.throw_bad_dict
7942 | address 2002 1 forth_local_paren_local_paren.throw_setec
7862 | address 1F6E 21 forth_local_paren_local_paren.xt
9891 | address 2753 1 forth_search_definitions
9905 | address 2770 1 forth_search_definitions.L1
9894 | address 2757 1 forth_search_definitions.name
9895 | address 2762 1 forth_search_definitions.xt
10470 | address 2903 1 forth_search_ext_also
10473 | address 2907 1 forth_search_ext_also.name
10474 | address 290B 1 forth_search_ext_also.xt
10487 | address 2919 1 forth_search_ext_forth
10490 | address 291D 1 forth_search_ext_forth.name
10491 | address 2922 1 forth_search_ext_forth.xt
10504 | address 2930 1 forth_search_ext_only
10507 | address 2934 1 forth_search_ext_only.name
10508 | address 2938 1 forth_search_ext_only.xt
10519 | address 2942 1 forth_search_ext_order
10541 | address 296B 1 forth_search_ext_order.L1
10534 | equate 000E 1 forth_search_ext_order.len1
10548 | equate 0010 1 forth_search_ext_order.len2
10522 | address 2946 1 forth_search_ext_order.name
10533 | address 2951 1 forth_search_ext_order.text1
10547 | address 2977 1 forth_search_ext_order.text2
10523 | address 294B 2 forth_search_ext_order.xt
10558 | address 2993 1 forth_search_ext_previous
10561 | address 2997 1 forth_search_ext_previous.name
10562 | address 299F 1 forth_search_ext_previous.xt
9917 | address 2778 1 forth_search_find
10000 | address F2CF 1 forth_search_find._n11
10003 | address F2D6 1 forth_search_find._n12
10034 | address F2F3 1 forth_search_find._n21
10037 | address F2FA 1 forth_search_find._n22
10068 | address F317 1 forth_search_find._n31
10070 | address F31E 1 forth_search_find._n32
10120 | address F362 1 forth_search_find._n41
10123 | address F366 1 forth_search_find._n42
10152 | address F383 1 forth_search_find._n51
10155 | address F38A 1 forth_search_find._n52
9951 | address 27AF 1 forth_search_find.again
9930 | address 2782 1 forth_search_find.body
9999 | address F2CD 2 forth_search_find.datastack1
10033 | address F2F1 2 forth_search_find.datastack2
10067 | address F315 2 forth_search_find.datastack3
10119 | address F360 2 forth_search_find.datastack4
10151 | address F381 2 forth_search_find.datastack5
10179 | address F3A5 1 forth_search_find.datastack6
10204 | address F3C3 1 forth_search_find.datastack7
9971 | address 27D7 2 forth_search_find.done
10086 | address F338 1 forth_search_find.foobar3
10088 | address F33C 1 forth_search_find.foobar3_name
10089 | address F342 1 forth_search_find.foobar3_xt
9920 | address 277C 1 forth_search_find.name
9966 | address 27CF 1 forth_search_find.none
10178 | address F3A3 1 forth_search_find.results6
10203 | address F3C1 1 forth_search_find.results7
9945 | address 27A2 1 forth_search_find.skip
10080 | address F32B 1 forth_search_find.two_drop3
10082 | address F32F 1 forth_search_find.two_drop3_name
10083 | address F334 2 forth_search_find.two_drop3_xt
10074 | address F321 1 forth_search_find.two_fetch3
10076 | address F325 1 forth_search_find.two_fetch3_name
10077 | address F327 1 forth_search_find.two_fetch3_xt
10072 | address F31F 4 forth_search_find.wid3
10002 | address F2D0 1 forth_search_find.word1
10036 | address F2F4 2 forth_search_find.word2
10069 | address F318 1 forth_search_find.word3
10122 | address F363 1 forth_search_find.word4
10154 | address F384 2 forth_search_find.word5
10181 | address F3A7 3 forth_search_find.word6
10206 | address F3C5 1 forth_search_find.word7
9921 | address 2780 18 forth_search_find.xt
10211 | address 27DD 1 forth_search_forth_wordlist
10214 | address 27E1 1 forth_search_forth_wordlist.name
10215 | address 27EF 2 forth_search_forth_wordlist.xt
10223 | address 27F3 1 forth_search_get_current
10228 | address 2804 1 forth_search_get_current.body
10226 | address 27F7 1 forth_search_get_current.name
10227 | address 2802 3 forth_search_get_current.xt
10235 | address 280C 1 forth_search_get_order
10240 | address 281B 1 forth_search_get_order.body
10246 | address 2826 1 forth_search_get_order.loop
10238 | address 2810 1 forth_search_get_order.name
10251 | address 2830 1 forth_search_get_order.none
10239 | address 2819 7 forth_search_get_order.xt
10258 | address 2838 1 forth_search_search_wordlist
10301 | address 2885 1 forth_search_search_wordlist.L1
10293 | address 2875 1 forth_search_search_wordlist.L2
10299 | address 2881 2 forth_search_search_wordlist.L3
10321 | address F3DD 1 forth_search_search_wordlist.datastack1
10347 | address F403 1 forth_search_search_wordlist.datastack2
10373 | address F426 1 forth_search_search_wordlist.datastack3
10398 | address F449 1 forth_search_search_wordlist.datastack5
10261 | address 283C 1 forth_search_search_wordlist.name
10324 | address F3E3 1 forth_search_search_wordlist.nu1
10322 | address F3DF 1 forth_search_search_wordlist.results1
10348 | address F405 1 forth_search_search_wordlist.results2
10374 | address F428 1 forth_search_search_wordlist.results3
10400 | address F44D 1 forth_search_search_wordlist.results5
10326 | address F3E5 2 forth_search_search_wordlist.word1
10352 | address F40B 2 forth_search_search_wordlist.word2
10378 | address F42E 2 forth_search_search_wordlist.word3
10403 | address F451 2 forth_search_search_wordlist.word5
10327 | equate 0008 1 forth_search_search_wordlist.wordlen1
10353 | equate 0005 1 forth_search_search_wordlist.wordlen2
10379 | equate 0005 1 forth_search_search_wordlist.wordlen3
10404 | equate 0005 1 forth_search_search_wordlist.wordlen5
10262 | address 284B 9 forth_search_search_wordlist.xt
10409 | address 2887 1 forth_search_set_current
10414 | address 2898 1 forth_search_set_current.body
10412 | address 288B 1 forth_search_set_current.name
10413 | address 2896 4 forth_search_set_current.xt
10421 | address 28A0 1 forth_search_set_order
10426 | address 28AF 1 forth_search_set_order.body
10442 | address 28D4 1 forth_search_set_order.default
10440 | address 28D0 1 forth_search_set_order.done
10435 | address 28C6 1 forth_search_set_order.loop
10424 | address 28A4 1 forth_search_set_order.name
10448 | address 28E1 1 forth_search_set_order.throw_too_many
10425 | address 28AD 5 forth_search_set_order.xt
10453 | address 28E7 1 forth_search_wordlist
10458 | address 28F5 1 forth_search_wordlist.body
10456 | address 28EB 1 forth_search_wordlist.name
10457 | address 28F3 1 forth_search_wordlist.xt
10795 | address 2A27 1 forth_string_blank
10798 | address 2A2B 1 forth_string_blank.name
10799 | address 2A30 1 forth_string_blank.xt
10809 | address 2A38 1 forth_string_c_move
10849 | address F502 1 forth_string_c_move._n1
10851 | address F509 1 forth_string_c_move._n2
10847 | address F4FC 2 forth_string_c_move.addr1
10850 | address F503 2 forth_string_c_move.addr2
10814 | address 2A43 1 forth_string_c_move.body
10817 | address 2A49 1 forth_string_c_move.copy
10842 | address F4F4 1 forth_string_c_move.datastack
10823 | address 2A57 1 forth_string_c_move.done
10812 | address 2A3C 1 forth_string_c_move.name
10845 | address F4FA 3 forth_string_c_move.results
10848 | equate 0006 2 forth_string_c_move.size
10813 | address 2A41 3 forth_string_c_move.xt
10856 | address 2A5F 1 forth_string_c_move_up
10898 | address F524 1 forth_string_c_move_up._n1
10900 | address F52B 1 forth_string_c_move_up._n2
10896 | address F51E 2 forth_string_c_move_up.addr1
10899 | address F525 2 forth_string_c_move_up.addr2
10861 | address 2A6B 1 forth_string_c_move_up.body
10866 | address 2A75 1 forth_string_c_move_up.copy
10891 | address F516 1 forth_string_c_move_up.datastack
10872 | address 2A83 1 forth_string_c_move_up.done
10859 | address 2A63 1 forth_string_c_move_up.name
10894 | address F51C 3 forth_string_c_move_up.results
10897 | equate 0006 2 forth_string_c_move_up.size
10860 | address 2A69 3 forth_string_c_move_up.xt
10913 | address 2A8B 1 forth_string_compare
10980 | address F542 1 forth_string_compare._nu11
10983 | address F546 1 forth_string_compare._nu12
10986 | address F54A 1 forth_string_compare._nu13
11009 | address F561 1 forth_string_compare._nu21
11012 | address F565 1 forth_string_compare._nu22
11015 | address F569 1 forth_string_compare._nu23
11038 | address F580 1 forth_string_compare._nu31
11041 | address F584 1 forth_string_compare._nu32
11044 | address F588 1 forth_string_compare._nu33
11067 | address F59F 1 forth_string_compare._nu41
11070 | address F5A1 1 forth_string_compare._nu42
11073 | address F5A5 1 forth_string_compare._nu43
10918 | address 2A98 1 forth_string_compare.body
10956 | address 2AEA 1 forth_string_compare.cmpgt
10953 | address 2AE3 1 forth_string_compare.cmplt
10942 | address 2ACD 1 forth_string_compare.compare
10938 | address 2AC3 2 forth_string_compare.continue
10975 | address F53A 1 forth_string_compare.datastack1
11004 | address F559 1 forth_string_compare.datastack2
11033 | address F578 1 forth_string_compare.datastack3
11062 | address F597 1 forth_string_compare.datastack4
10931 | address 2AB5 1 forth_string_compare.equal
10935 | address 2ABB 1 forth_string_compare.greater
10916 | address 2A8F 1 forth_string_compare.name
10978 | address F540 1 forth_string_compare.result1
11007 | address F55F 1 forth_string_compare.result2
11036 | address F57E 1 forth_string_compare.result3
11065 | address F59D 1 forth_string_compare.result4
10948 | address 2AD9 3 forth_string_compare.return
10981 | address F543 2 forth_string_compare.text11
10982 | equate 0003 1 forth_string_compare.text11_len
10984 | address F547 2 forth_string_compare.text12
10985 | equate 0003 1 forth_string_compare.text12_len
11010 | address F562 2 forth_string_compare.text21
11011 | equate 0003 1 forth_string_compare.text21_len
11013 | address F566 2 forth_string_compare.text22
11014 | equate 0003 1 forth_string_compare.text22_len
11039 | address F581 2 forth_string_compare.text31
11040 | equate 0003 1 forth_string_compare.text31_len
11042 | address F585 2 forth_string_compare.text32
11043 | equate 0003 1 forth_string_compare.text32_len
11068 | address F5A0 1 forth_string_compare.text41
11069 | equate 0000 1 forth_string_compare.text41_len
11071 | address F5A2 2 forth_string_compare.text42
11072 | equate 0003 1 forth_string_compare.text42_len
10917 | address 2A96 10 forth_string_compare.xt
10576 | address 29AB 1 forth_string_dash_trailing
10598 | address 29C4 1 forth_string_dash_trailing.L1
10608 | address 29D8 1 forth_string_dash_trailing.L2
10620 | address 29F0 1 forth_string_dash_trailing.L3
10625 | address 29FA 1 forth_string_dash_trailing.L4
10648 | address F464 2 forth_string_dash_trailing.datastack1
10671 | address F479 2 forth_string_dash_trailing.datastack2
10695 | address F493 2 forth_string_dash_trailing.datastack3
10719 | address F4AA 2 forth_string_dash_trailing.datastack4
10652 | address F468 1 forth_string_dash_trailing.n1
10674 | address F47D 1 forth_string_dash_trailing.n21
10677 | address F484 1 forth_string_dash_trailing.n22
10698 | address F497 1 forth_string_dash_trailing.n31
10701 | address F49B 1 forth_string_dash_trailing.n32
10722 | address F4AE 1 forth_string_dash_trailing.n41
10725 | address F4B2 1 forth_string_dash_trailing.n42
10579 | address 29AF 1 forth_string_dash_trailing.name
10650 | equate F468 3 forth_string_dash_trailing.text1
10651 | equate 0000 1 forth_string_dash_trailing.text1_len
10675 | address F47E 3 forth_string_dash_trailing.text2
10676 | equate 0006 1 forth_string_dash_trailing.text2_len
10699 | address F498 3 forth_string_dash_trailing.text3
10700 | equate 0003 1 forth_string_dash_trailing.text3_len
10723 | address F4AF 3 forth_string_dash_trailing.text4
10724 | equate 0003 1 forth_string_dash_trailing.text4_len
10580 | address 29B8 5 forth_string_dash_trailing.xt
11202 | address 2B8A 1 forth_string_ext_replaces
11228 | address 2BB0 1 forth_string_ext_replaces.L1
11234 | address 2BBC 1 forth_string_ext_replaces.L2
11260 | address F5E2 1 forth_string_ext_replaces.datastack
11240 | address 2BC4 4 forth_string_ext_replaces.does
11265 | address F5E7 1 forth_string_ext_replaces.foo_len
11266 | address F5E9 1 forth_string_ext_replaces.foo_text
11264 | address F5E5 1 forth_string_ext_replaces.foo_xt
11205 | address 2B8E 1 forth_string_ext_replaces.name
11258 | address F5DE 1 forth_string_ext_replaces.result
11206 | address 2B96 1 forth_string_ext_replaces.xt
11286 | address 2BD1 1 forth_string_ext_substitute
11431 | address F625 1 forth_string_ext_substitute._nu1
11449 | address F694 1 forth_string_ext_substitute._nu2
11291 | address 2BE1 1 forth_string_ext_substitute.body
11450 | address F695 4 forth_string_ext_substitute.buffer
11451 | equate 0050 1 forth_string_ext_substitute.buflen
11314 | address 2C11 2 forth_string_ext_substitute.continue_char
11372 | address 2C96 1 forth_string_ext_substitute.copy_replace
11426 | address F61D 1 forth_string_ext_substitute.datastack
11370 | address 2C90 1 forth_string_ext_substitute.do_replace
11385 | address 2CB3 2 forth_string_ext_substitute.done
11380 | address 2CA8 1 forth_string_ext_substitute.done_replace
11398 | address 2CCE 3 forth_string_ext_substitute.error
11323 | address 2C25 1 forth_string_ext_substitute.get_name
11364 | address 2C82 1 forth_string_ext_substitute.got_replace
11332 | address 2C38 1 forth_string_ext_substitute.have_nameq
11448 | equate 0039 1 forth_string_ext_substitute.len
11289 | address 2BD5 1 forth_string_ext_substitute.name
11309 | address 2C05 2 forth_string_ext_substitute.next_char
11427 | address F61F 1 forth_string_ext_substitute.result
11339 | address 2C46 1 forth_string_ext_substitute.start_search
11319 | address 2C1F 1 forth_string_ext_substitute.start_sub
11433 | address F626 1 forth_string_ext_substitute.str_date
11440 | address F637 1 forth_string_ext_substitute.str_time
11447 | address F65B 2 forth_string_ext_substitute.text
11336 | address 2C40 1 forth_string_ext_substitute.unbalanced
11290 | address 2BDF 2 forth_string_ext_substitute.xt
11457 | address 2CD5 1 forth_string_ext_unescape
11496 | address 2D17 1 forth_string_ext_unescape.L1
11477 | address 2CF1 1 forth_string_ext_unescape.L2
11489 | address 2D09 1 forth_string_ext_unescape.L3
11460 | address 2CD9 1 forth_string_ext_unescape.name
11461 | address 2CE1 3 forth_string_ext_unescape.xt
11078 | address 2AF1 1 forth_string_search
11117 | address 2B2D 1 forth_string_search.L19
11131 | address 2B49 1 forth_string_search.L31
11101 | address 2B0D 1 forth_string_search.L5
11156 | address F5C0 1 forth_string_search._nu11
11159 | address F5CE 1 forth_string_search._nu12
11163 | address F5D3 1 forth_string_search._nu13
11151 | address F5B8 1 forth_string_search.datastack1
11081 | address 2AF5 1 forth_string_search.name
11152 | address F5BA 1 forth_string_search.results1
11157 | address F5C1 2 forth_string_search.text11
11158 | equate 000D 1 forth_string_search.text11_len
11160 | address F5CF 2 forth_string_search.text12
11161 | equate 0003 1 forth_string_search.text12_len
11082 | address 2AFB 2 forth_string_search.xt
10730 | address 2A0A 1 forth_string_slash_string
10760 | address F4BF 1 forth_string_slash_string.datastack1
10785 | address F4DF 1 forth_string_slash_string.datastack2
10733 | address 2A0E 1 forth_string_slash_string.name
10761 | address F4C1 1 forth_string_slash_string.results1
10786 | address F4E1 1 forth_string_slash_string.results2
10764 | address F4C5 3 forth_string_slash_string.text1
10765 | equate 0003 2 forth_string_slash_string.text1_len
10789 | address F4E5 3 forth_string_slash_string.text2
10790 | equate 0003 1 forth_string_slash_string.text2_len
10734 | address 2A15 5 forth_string_slash_string.xt
11168 | address 2B4D 1 forth_string_sliteral
11173 | address 2B5B 1 forth_string_sliteral.body
11180 | address 2B6A 1 forth_string_sliteral.copy
11184 | address 2B72 1 forth_string_sliteral.done
11171 | address 2B51 1 forth_string_sliteral.name
11191 | address 2B7E 1 forth_string_sliteral.runtime
11190 | address 2B7C 25 forth_string_sliteral.runtime_xt
11172 | address 2B59 2 forth_string_sliteral.xt
8366 | address 2133 1 forth_tools_dot_s
8371 | address 213B 1 forth_tools_dot_s.body
8380 | address 2151 1 forth_tools_dot_s.done
8369 | address 2137 1 forth_tools_dot_s.name
8373 | address 2140 1 forth_tools_dot_s.show
8370 | address 2139 1 forth_tools_dot_s.xt
8400 | address 2164 1 forth_tools_dump
8438 | address 219E 1 forth_tools_dump.L1
8453 | address 21BC 1 forth_tools_dump.L2
8431 | equate 0002 1 forth_tools_dump.len
8403 | address 2168 1 forth_tools_dump.name
8430 | address 2190 1 forth_tools_dump.text
8404 | address 216C 1 forth_tools_dump.xt
9455 | address 251F 1 forth_tools_ext_ahead
9460 | address 252A 1 forth_tools_ext_ahead.body
9458 | address 2523 1 forth_tools_ext_ahead.name
9459 | address 2528 2 forth_tools_ext_ahead.xt
9742 | address 266F 1 forth_tools_ext_bracket_defined
9745 | address 2673 1 forth_tools_ext_bracket_defined.name
9746 | address 267C 1 forth_tools_ext_bracket_defined.xt
9759 | address 268A 1 forth_tools_ext_bracket_else
9803 | address 26C0 1 forth_tools_ext_bracket_else.L23
9785 | address 269A 2 forth_tools_ext_bracket_else.L3
9817 | address 26E0 1 forth_tools_ext_bracket_else.L37
9819 | address 26E4 1 forth_tools_ext_bracket_else.L39
9827 | address 26F8 3 forth_tools_ext_bracket_else.L50
9832 | address 2702 1 forth_tools_ext_bracket_else.L56
9834 | address 2706 1 forth_tools_ext_bracket_else.L58
9762 | address 268E 1 forth_tools_ext_bracket_else.name
9763 | address 2694 2 forth_tools_ext_bracket_else.xt
9844 | address 2714 1 forth_tools_ext_bracket_if
9856 | address 2726 1 forth_tools_ext_bracket_if.L1
9847 | address 2718 1 forth_tools_ext_bracket_if.name
9848 | address 271C 1 forth_tools_ext_bracket_if.xt
9860 | address 2728 1 forth_tools_ext_bracket_then
9863 | address 272C 1 forth_tools_ext_bracket_then.name
9864 | address 2732 1 forth_tools_ext_bracket_then.xt
9872 | address 2736 1 forth_tools_ext_bracket_undefined
9875 | address 273A 1 forth_tools_ext_bracket_undefined.name
9876 | address 2745 1 forth_tools_ext_bracket_undefined.xt
9482 | address 253B 1 forth_tools_ext_bye
9487 | address 2544 1 forth_tools_ext_bye.body
9485 | address 253F 1 forth_tools_ext_bye.name
9486 | address 2542 2 forth_tools_ext_bye.xt
9502 | address 2548 1 forth_tools_ext_c_s_pick
9505 | address 254C 1 forth_tools_ext_c_s_pick.name
9506 | address 2553 1 forth_tools_ext_c_s_pick.xt
9515 | address 2559 1 forth_tools_ext_c_s_roll
9518 | address 255D 1 forth_tools_ext_c_s_roll.name
9519 | address 2564 3 forth_tools_ext_c_s_roll.xt
9636 | address 25FE 1 forth_tools_ext_n_r_from
9641 | address 2607 1 forth_tools_ext_n_r_from.body
9649 | address 2617 1 forth_tools_ext_n_r_from.done
9639 | address 2602 1 forth_tools_ext_n_r_from.name
9644 | address 260D 1 forth_tools_ext_n_r_from.repeat
9640 | address 2605 2 forth_tools_ext_n_r_from.xt
9553 | address 256A 1 forth_tools_ext_n_to_r
9558 | address 2573 1 forth_tools_ext_n_to_r.body
9566 | address 2583 1 forth_tools_ext_n_to_r.done
9556 | address 256E 1 forth_tools_ext_n_to_r.name
9561 | address 2579 1 forth_tools_ext_n_to_r.repeat
9557 | address 2571 2 forth_tools_ext_n_to_r.xt
9579 | address 2589 1 forth_tools_ext_name_to_compile
9584 | address 259B 1 forth_tools_ext_name_to_compile.body
9594 | address 25AF 1 forth_tools_ext_name_to_compile.exit
9593 | address 25AC 1 forth_tools_ext_name_to_compile.immed
9582 | address 258D 1 forth_tools_ext_name_to_compile.name
9583 | address 2599 2 forth_tools_ext_name_to_compile.xt
9600 | address 25B5 1 forth_tools_ext_name_to_interpret
9605 | address 25C9 1 forth_tools_ext_name_to_interpret.body
9612 | address 25D6 1 forth_tools_ext_name_to_interpret.done
9603 | address 25B9 1 forth_tools_ext_name_to_interpret.name
9614 | address 25DA 1 forth_tools_ext_name_to_interpret.no_interp
9604 | address 25C7 1 forth_tools_ext_name_to_interpret.xt
9621 | address 25E0 1 forth_tools_ext_name_to_string
9626 | address 25F1 1 forth_tools_ext_name_to_string.body
9624 | address 25E4 1 forth_tools_ext_name_to_string.name
9625 | address 25EF 4 forth_tools_ext_name_to_string.xt
9655 | address 261D 1 forth_tools_ext_state
9660 | address 2628 1 forth_tools_ext_state.body
9658 | address 2621 1 forth_tools_ext_state.name
9659 | address 2626 7 forth_tools_ext_state.xt
9681 | address 2631 1 forth_tools_ext_traverse_wordlist
9690 | address 2650 2 forth_tools_ext_traverse_wordlist.again
9686 | address 2648 1 forth_tools_ext_traverse_wordlist.body
9725 | address F2A3 1 forth_tools_ext_traverse_wordlist.datastack
9702 | address 2669 1 forth_tools_ext_traverse_wordlist.done
9684 | address 2635 1 forth_tools_ext_traverse_wordlist.name
9732 | address F2A7 1 forth_tools_ext_traverse_wordlist.noname_xt
9714 | address F290 1 forth_tools_ext_traverse_wordlist.sysnul
9685 | address 2646 4 forth_tools_ext_traverse_wordlist.xt
8386 | address 2157 1 forth_tools_question
8389 | address 215B 1 forth_tools_question.name
8390 | address 215C 1 forth_tools_question.xt
8465 | address 21C8 1 forth_tools_see
9281 | address F1D7 1 forth_tools_see.C_default
9246 | address F195 1 forth_tools_see.Cbeta
9269 | address F1BF 1 forth_tools_see.Cdelta
9256 | address F1A7 1 forth_tools_see.Cgamma
9285 | address F1DF 4 forth_tools_see.Endcase
9360 | address F248 1 forth_tools_see.L1
9253 | address F1A3 1 forth_tools_see.L11
9371 | address F25D 1 forth_tools_see.L2
9265 | address F1B9 1 forth_tools_see.L21
9266 | address F1BB 1 forth_tools_see.L31
9278 | address F1D1 1 forth_tools_see.L4
9279 | address F1D3 1 forth_tools_see.L5
8470 | address 21D1 1 forth_tools_see.body
8936 | address EFF5 4 forth_tools_see.buffer1
8969 | address F018 4 forth_tools_see.buffer2
9011 | address F047 4 forth_tools_see.buffer3
9053 | address F074 4 forth_tools_see.buffer4
9096 | address F0A3 4 forth_tools_see.buffer5
9139 | address F0D2 4 forth_tools_see.buffer6
9299 | address F1F9 4 forth_tools_see.buffer7
9391 | address F280 4 forth_tools_see.buffer8
8752 | address 23E3 2 forth_tools_see.cleanup
8754 | equate 0013 1 forth_tools_see.cleanup_len
8591 | address 22AF 1 forth_tools_see.colonf
8792 | address 2427 1 forth_tools_see.cquotef
8567 | address 228B 1 forth_tools_see.create_tab
8650 | address 2321 5 forth_tools_see.createf
8934 | address EFF4 1 forth_tools_see.datastack1
8967 | address F017 1 forth_tools_see.datastack2
9001 | address F039 1 forth_tools_see.datastack3
9043 | address F066 1 forth_tools_see.datastack4
9085 | address F093 1 forth_tools_see.datastack5
9128 | address F0C2 1 forth_tools_see.datastack6
9171 | address F0F1 1 forth_tools_see.datastack7
9335 | address F224 1 forth_tools_see.datastack8
8517 | address 222B 1 forth_tools_see.decompile
8564 | address 2285 1 forth_tools_see.def_xt
8585 | equate 0007 1 forth_tools_see.def_xt_items
8563 | address 2283 1 forth_tools_see.def_xt_tab
8645 | address 231C 1 forth_tools_see.dis_custom
8632 | address 2306 1 forth_tools_see.dis_done
8605 | address 22C8 3 forth_tools_see.disassemble
8501 | address 2205 2 forth_tools_see.display_exit
8695 | address 236C 1 forth_tools_see.does_tab
8776 | address 2412 2 forth_tools_see.doesf
8816 | address 244C 1 forth_tools_see.endtext
8748 | address 23D2 2 forth_tools_see.enter
8750 | equate 0011 1 forth_tools_see.enter_len
8555 | address 227D 1 forth_tools_see.finished
9005 | address F03C 1 forth_tools_see.foo3
9047 | address F069 1 forth_tools_see.foo4
9089 | address F096 1 forth_tools_see.foo5
9132 | address F0C5 1 forth_tools_see.foo6
9136 | address F0CE 1 forth_tools_see.foo6_body
9210 | address F14A 1 forth_tools_see.foo7
9183 | address F10A 1 forth_tools_see.foo7_alpha
9203 | address F13B 4 forth_tools_see.foo7_bar
9208 | address F146 3 forth_tools_see.foo7_baz
9188 | address F116 1 forth_tools_see.foo7_beta
9198 | address F130 1 forth_tools_see.foo7_delta
9193 | address F123 1 forth_tools_see.foo7_gamma
9178 | address F0FD 1 forth_tools_see.foo7_snafu
9345 | address F233 1 forth_tools_see.foo8
9365 | address F250 1 forth_tools_see.foo8_does
9342 | address F22F 1 forth_tools_see.foo8_dotrow
9382 | address F26F 1 forth_tools_see.foo8_man
8490 | address 21ED 1 forth_tools_see.is_code
8510 | equate 0008 1 forth_tools_see.is_code_len
8509 | address 2218 2 forth_tools_see.is_code_msg
8544 | address 2264 1 forth_tools_see.is_does
8494 | address 21F5 1 forth_tools_see.is_unknown
8513 | equate 000B 1 forth_tools_see.is_unknown_len
8512 | address 2220 2 forth_tools_see.is_unknown_msg
8937 | equate 0005 2 forth_tools_see.len1
8970 | equate 0005 2 forth_tools_see.len2
9012 | equate 0003 2 forth_tools_see.len3
9054 | equate 0003 2 forth_tools_see.len4
9097 | equate 0003 2 forth_tools_see.len5
9140 | equate 0003 2 forth_tools_see.len6
9300 | equate 0003 2 forth_tools_see.len7
9392 | equate 0007 2 forth_tools_see.len8
8784 | address 241C 1 forth_tools_see.literalf
8857 | address 248D 1 forth_tools_see.local_genname
8828 | address 2464 1 forth_tools_see.localenterf
8845 | address 247D 1 forth_tools_see.localfetchf
8852 | address 2489 1 forth_tools_see.localstoref
8760 | address 23F6 7 forth_tools_see.locationf
8468 | address 21CC 1 forth_tools_see.name
8767 | address 2406 1 forth_tools_see.no_ip_exit
8637 | address 230D 2 forth_tools_see.normal_xt
8531 | address 2249 1 forth_tools_see.not_code
8554 | address 227A 1 forth_tools_see.not_does
8498 | address 21FD 1 forth_tools_see.not_found
8507 | equate 000A 1 forth_tools_see.not_found_len
8506 | address 220E 2 forth_tools_see.not_found_msg
8541 | address 2260 1 forth_tools_see.not_known
8846 | address 247F 1 forth_tools_see.print_local
8770 | address 240A 2 forth_tools_see.print_num
8869 | address 24A5 2 forth_tools_see.print_xt
8868 | address 24A3 11 forth_tools_see.printxtf
8876 | address 24AC 3 forth_tools_see.prtinvxt
8689 | address 2360 1 forth_tools_see.run_xt
8746 | equate 0013 1 forth_tools_see.run_xt_items
8688 | address 235E 1 forth_tools_see.run_xt_tab
8895 | address 24C6 1 forth_tools_see.scan_check
8901 | address 24D3 1 forth_tools_see.scan_found
8894 | address 24C3 2 forth_tools_see.scan_table
8634 | address 2307 1 forth_tools_see.self
8813 | address 2446 1 forth_tools_see.sliteralf
8923 | address EFE1 1 forth_tools_see.sysnul
8956 | address F004 1 forth_tools_see.sysnul2
8990 | address F026 1 forth_tools_see.sysnul3
9032 | address F053 1 forth_tools_see.sysnul4
9074 | address F080 1 forth_tools_see.sysnul5
9117 | address F0AF 1 forth_tools_see.sysnul6
9160 | address F0DE 1 forth_tools_see.sysnul7
9324 | address F211 1 forth_tools_see.sysnul8
8800 | address 2430 1 forth_tools_see.twoliteralf
8674 | address 2349 2 forth_tools_see.twovaluef
8903 | address 24D4 9 forth_tools_see.type_text
8663 | address 2336 2 forth_tools_see.valuef
9003 | address F03A 1 forth_tools_see.wid3
9045 | address F067 1 forth_tools_see.wid4
9087 | address F094 1 forth_tools_see.wid5
9130 | address F0C3 1 forth_tools_see.wid6
9173 | address F0F2 1 forth_tools_see.wid7
9337 | address F225 1 forth_tools_see.wid8
8469 | address 21CF 10 forth_tools_see.xt
9397 | address 24E0 1 forth_tools_words
9420 | address 2501 1 forth_tools_words.L1
9423 | address 2507 1 forth_tools_words.L2
9428 | address 2511 1 forth_tools_words.L4
9400 | address 24E4 1 forth_tools_words.name
9430 | address 2513 1 forth_tools_words.type_word_xt
9401 | address 24E9 1 forth_tools_words.xt