Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Added based-constants and character constants #262

Merged
merged 1 commit into from
Jan 8, 2021
Merged

Added based-constants and character constants #262

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 85 additions & 2 deletions native_words.asm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6540,9 +6540,84 @@ xt_number:
stz tmpdsp ; flag for double
stz tmpdsp+1 ; flag for minus

; Push the current base onto the stack.
; This is done to handle constants in a different base
; like #1234 and $ABCD and %0101
lda base
pha

; Look at the first character.
lda (2,x)
_check_dec:
cmp #$23 ; ASCII for "#"
bne _check_hex
; Switch temporarily to decimal
lda #$0A
bra _base_changed
_check_hex:
cmp #$24 ; ASCII for "$"
bne _check_binary
; Switch temporarily to hexadecimal
lda #$10
bra _base_changed
_check_binary:
cmp #$25 ; ASCII for "%"
bne _check_char
; Switch temporarily to hexadecimal
lda #$02
bra _base_changed
_check_char:
cmp #$27 ; ASCII for "'"
bne _check_minus
; Character constants should have a length of 3
; and another single quote in position 3.
lda 0,x ; Get the length
cmp #$03
bne _not_a_char
lda 1,x
bne _not_a_char ; No compare needed to check for non-zero.
; Compute location of last character
; We know the string is 3 characters long, so last char
; is known to be at offset +2.
lda 2,x ; LSB of address
clc
adc #2 ; length of string
sta tmptos
lda 3,x
adc #0 ; only need carry
sta tmptos+1
lda (tmptos)
cmp #$27 ; ASCII for "'"
bne _not_a_char
; The char we want is between the single quotes.
inc 2,x
bne +
inc 3,x
+
; Grab the character and replace the string with just the char.
lda (2,x)
sta 2,x
stz 3,x
jmp _single ; Single with drop the TOS for us.
_not_a_char:
; This label was just a bit too far away for a single bra from
; the character checking code, so we'll sneak it here and
; then bra again to get there.
bra _number_error

_base_changed:
sta base ; Switch to the new base
inc 2,x ; start one character later
bne +
inc 3,x
+
dec 0,x ; decrease string length by one


lda (2,x) ; Load the first char again
_check_minus:
; If the first character is a minus, strip it off and set
; the flag
lda (2,x)
cmp #$2D ; ASCII for "-"
bne _check_dot

Expand Down Expand Up @@ -6609,7 +6684,8 @@ _main:
; test length of returned string, which should be zero
lda 0,x
beq _all_converted


_number_error:
; Something went wrong, we still have characters left over,
; so we print an error and abort. If the NUMBER was called
; by INTERPRET, we've already checked for Forth words, so
Expand All @@ -6621,6 +6697,10 @@ _main:
jsr emit_a
jsr xt_space

; Pull the base of the stack and restore it.
pla
sta base

lda #err_syntax
jmp error

Expand Down Expand Up @@ -6664,6 +6744,9 @@ _single:

jsr xt_negate
_done:
; Restore the base (in case it was changed by #/$/%)
pla
sta base
z_number: rts


Expand Down
37 changes: 37 additions & 0 deletions tests/core_c.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,43 @@ T{ max-uint dup max-base gn1 -> max-uint dup 0 }T

T{ gn2 -> 10 a }T

\ ------------------------------------------------------------------------
testing numeric constants (eg. #1234 $ABCD %1010 'A')
decimal
T{ #10 -> 10 }T
T{ $10 -> 16 }T
T{ %10 -> 2 }T
T{ #-10 -> -10 }T
T{ $-10 -> -16 }T
T{ %-10 -> -2 }T
\ Double number versions
T{ #10. -> 10 0 }T
T{ $10. -> 16 0 }T
T{ %10. -> 2 0 }T
T{ #-10. -> -10 -1 }T
T{ $-10. -> -16 -1 }T
T{ %-10. -> -2 -1 }T
\ Test again using a different base
hex
T{ #10 -> A }T
T{ $10 -> 10 }T
T{ %10 -> 2 }T
T{ #-10 -> -A }T
T{ $-10 -> -10 }T
T{ %-10 -> -2 }T
\ Double number versions
T{ #10. -> A 0 }T
T{ $10. -> 10 0 }T
T{ %10. -> 2 0 }T
T{ #-10. -> -A -1 }T
T{ $-10. -> -10 -1 }T
T{ %-10. -> -2 -1 }T
\ Character constants
T{ '!' -> 21 }T
T{ 'A' -> 41 }T
T{ 'a' -> 61 }T
T{ '~' -> 7E }T

\ ------------------------------------------------------------------------
testing action-of defer defer! defer@ is

Expand Down
82 changes: 60 additions & 22 deletions tests/results.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1414,6 +1414,43 @@ T{ max-uint dup max-base gn1 -> max-uint dup 0 }T ok
T{ gn2 -> 10 a }T ok
ok
\ ------------------------------------------------------------------------ ok
testing numeric constants (eg. #1234 $ABCD %1010 'A') ok
decimal ok
T{ #10 -> 10 }T ok
T{ $10 -> 16 }T ok
T{ %10 -> 2 }T ok
T{ #-10 -> -10 }T ok
T{ $-10 -> -16 }T ok
T{ %-10 -> -2 }T ok
\ Double number versions ok
T{ #10. -> 10 0 }T ok
T{ $10. -> 16 0 }T ok
T{ %10. -> 2 0 }T ok
T{ #-10. -> -10 -1 }T ok
T{ $-10. -> -16 -1 }T ok
T{ %-10. -> -2 -1 }T ok
\ Test again using a different base ok
hex ok
T{ #10 -> A }T ok
T{ $10 -> 10 }T ok
T{ %10 -> 2 }T ok
T{ #-10 -> -A }T ok
T{ $-10 -> -10 }T ok
T{ %-10 -> -2 }T ok
\ Double number versions ok
T{ #10. -> A 0 }T ok
T{ $10. -> 10 0 }T ok
T{ %10. -> 2 0 }T ok
T{ #-10. -> -A -1 }T ok
T{ $-10. -> -10 -1 }T ok
T{ %-10. -> -2 -1 }T ok
\ Character constants ok
T{ '!' -> 21 }T ok
T{ 'A' -> 41 }T ok
T{ 'a' -> 61 }T ok
T{ '~' -> 7E }T ok
ok
\ ------------------------------------------------------------------------ ok
testing action-of defer defer! defer@ is ok
ok
T{ defer defer1 -> }T ok
Expand Down Expand Up @@ -3275,17 +3312,17 @@ here 5 ' blank cycle_test CYCLES: 325 ok
5 here ' c! cycle_test CYCLES: 46 ok
5 ' cell+ cycle_test drop CYCLES: 46 ok
5 ' cells cycle_test drop CYCLES: 40 ok
' char cycle_test w drop CYCLES: 450 ok
' char cycle_test w drop CYCLES: 451 ok
5 ' char+ cycle_test drop CYCLES: 37 ok
5 ' chars cycle_test drop CYCLES: 28 ok
pad here 5 ' cmove cycle_test CYCLES: 188 ok
pad here 5 ' cmove> cycle_test CYCLES: 183 ok
' : cycle_test wrd ; CYCLES: 15149 ok
' : cycle_test wrd ; CYCLES: 15155 ok
' :noname cycle_test ; drop CYCLES: 50 ok
5 ' , cycle_test CYCLES: 66 ok
' aword ' compile, cycle_test CYCLES: 786 ok
: bword ; ' compile-only cycle_test CYCLES: 72 ok
5 ' constant cycle_test mycnst CYCLES: 15645 ok
5 ' constant cycle_test mycnst CYCLES: 15653 ok
here ' count cycle_test 2drop CYCLES: 59 ok
\ skipping cr ok
\ skipping create ok
Expand All @@ -3304,15 +3341,15 @@ char w ' digit? cycle_test 2drop CYCLES: 86 ok
\ skipping does ok
\ skipping . ok
\ skipping ." ok
' s" cycle_test " 2drop CYCLES: 254 ok
' s" cycle_test " 2drop CYCLES: 252 ok
5 ' drop cycle_test CYCLES: 32 ok
\ skipping dump ok
5 ' dup cycle_test 2drop CYCLES: 48 ok
42 ' emit cycle_test *CYCLES: 46 ok
5 5 ' = cycle_test drop CYCLES: 64 ok
here 5 ' erase cycle_test CYCLES: 321 ok
here 5 5 ' fill cycle_test CYCLES: 309 ok
s" 5" ' evaluate cycle_test drop CYCLES: 16387 ok
s" 5" ' evaluate cycle_test drop CYCLES: 16488 ok
5 ' drop ' execute cycle_test CYCLES: 84 ok
\ skipping exit ok
' false cycle_test drop CYCLES: 24 ok
Expand Down Expand Up @@ -3344,8 +3381,8 @@ s" aword" ' find-name cycle_test drop CYCLES: 449 ok
\ skipping loop ok
\ skipping +loop ok
5 5 ' lshift cycle_test drop CYCLES: 126 ok
5 5 ' m* cycle_test 2drop CYCLES: 650 ok
' marker cycle_test marka CYCLES: 17304 ok
5 5 ' m* cycle_test 2drop CYCLES: 679 ok
' marker cycle_test marka CYCLES: 17309 ok
' marka cycle_test CYCLES: 883 ok
5 5 ' max cycle_test drop CYCLES: 69 ok
5 5 ' min cycle_test drop CYCLES: 54 ok
Expand All @@ -3360,7 +3397,7 @@ here s" a" ' move cycle_test CYCLES: 148 ok
5 5 ' nip cycle_test drop CYCLES: 48 ok
5 5 ' <> cycle_test drop CYCLES: 68 ok
5 5 5 ' -rot cycle_test 2drop drop CYCLES: 76 ok
s" 5" ' number cycle_test drop CYCLES: 1418 ok
s" 5" ' number cycle_test drop CYCLES: 1513 ok
\ skipping # ok
\ skipping #> ok
\ skipping #s ok
Expand All @@ -3372,22 +3409,22 @@ s" 5" ' number cycle_test drop CYCLES: 1418 ok
5 5 ' over cycle_test 2drop drop CYCLES: 48 ok
' pad cycle_test drop CYCLES: 36 ok
\ skipping page ok
' parse-name cycle_test a 2drop CYCLES: 409 ok
' parse-name cycle_test a 2drop CYCLES: 410 ok
char " ' parse cycle_test " 2drop CYCLES: 215 ok
5 0 ' pick cycle_test 2drop CYCLES: 42 ok
5 5 ' + cycle_test drop CYCLES: 58 ok
5 here ' +! cycle_test CYCLES: 86 ok
\ skipping postpone ok
myvar ' ? cycle_test 5 CYCLES: 3894 ok
myvar ' ? cycle_test 5 CYCLES: 3897 ok
5 ' ?dup cycle_test 2drop CYCLES: 58 ok
\ skipping r> ok
\ skipping recurse ok
' refill cycle_test CYCLES: 333 ok
drop \ refill ok
\ skipping ] ok
5 5 5 ' rot cycle_test 2drop drop CYCLES: 76 ok
5 5 ' rshift cycle_test drop CYCLES: 130 ok
' s" cycle_test " 2drop CYCLES: 254 ok
5 5 ' rshift cycle_test drop CYCLES: 126 ok
' s" cycle_test " 2drop CYCLES: 252 ok
5 ' s>d cycle_test 2drop CYCLES: 47 ok
\ skipping ; ok
\ skipping sign ok
Expand All @@ -3398,15 +3435,15 @@ s" abc" 1 ' /string cycle_test 2drop CYCLES: 84 ok
' source-id cycle_test drop CYCLES: 30 ok
' space cycle_test CYCLES: 36 ok
1 ' spaces cycle_test CYCLES: 81 ok
5 5 ' * cycle_test drop CYCLES: 506 ok
5 5 ' * cycle_test drop CYCLES: 535 ok
' state cycle_test drop CYCLES: 28 ok
5 here ' ! cycle_test CYCLES: 65 ok
5 5 ' swap cycle_test 2drop CYCLES: 60 ok
' ' cycle_test aword drop CYCLES: 1331 ok
' ' cycle_test aword drop CYCLES: 1332 ok
\ postponing to ( see value ) ok
' aword ' >body cycle_test drop CYCLES: 591 ok
' >in cycle_test drop CYCLES: 28 ok
0. s" 55" ' >number cycle_test 4drop CYCLES: 2423 ok
0. s" 55" ' >number cycle_test 4drop CYCLES: 2546 ok
\ skipping >r ok
' true cycle_test drop CYCLES: 26 ok
5 5 ' tuck cycle_test 2drop drop CYCLES: 72 ok
Expand All @@ -3422,21 +3459,21 @@ here ' 2@ cycle_test 2drop CYCLES: 88 ok
5. here ' 2! cycle_test CYCLES: 99 ok
5 5 5 5 ' 2swap cycle_test 4drop CYCLES: 92 ok
\ skipping 2>r ok
' 2variable cycle_test eword CYCLES: 15926 ok
' 2variable cycle_test eword CYCLES: 15931 ok
' eword cycle_test drop CYCLES: 45 ok
s" *" ' type cycle_test *CYCLES: 121 ok
5 ' u. cycle_test 5 CYCLES: 3615 ok
s" *" ' type cycle_test *CYCLES: 124 ok
5 ' u. cycle_test 5 CYCLES: 3618 ok
5 5 ' u> cycle_test drop CYCLES: 60 ok
5 5 ' u< cycle_test drop CYCLES: 60 ok
' strip-underflow cycle_test drop CYCLES: 28 ok
5. 5 ' um/mod cycle_test 2drop CYCLES: 1260 ok
5 5 ' um* cycle_test 2drop CYCLES: 474 ok
5 5 ' um* cycle_test 2drop CYCLES: 503 ok
\ skipping unloop ok
' unused cycle_test drop CYCLES: 36 ok
5 ' value cycle_test fword CYCLES: 16144 ok
5 ' value cycle_test fword CYCLES: 16149 ok
' fword cycle_test drop CYCLES: 58 ok
5 ' to cycle_test fword CYCLES: 1135 ok
' variable cycle_test gword CYCLES: 15925 ok
5 ' to cycle_test fword CYCLES: 1136 ok
' variable cycle_test gword CYCLES: 15929 ok
' gword cycle_test drop CYCLES: 45 ok
char " ' word cycle_test "txt" drop CYCLES: 676 ok
\ skipping words ok
Expand All @@ -3450,3 +3487,4 @@ char " ' word cycle_test "txt" drop CYCLES: 676 ok
5 ' 0<> cycle_test drop CYCLES: 52 ok
ok
ok
bye