mirror of https://github.com/mgcaret/of816.git
Fix #8
This commit is contained in:
parent
bd5edf5372
commit
b1e0972431
|
@ -1308,25 +1308,6 @@ dword COMPILECOMMA,"COMPILE,",F_IMMED
|
||||||
bra COMMA::code
|
bra COMMA::code
|
||||||
eword
|
eword
|
||||||
|
|
||||||
; H: Compilation: ( n -- )
|
|
||||||
; H: Execution: ( -- n )
|
|
||||||
dword LITERAL,"LITERAL",F_IMMED
|
|
||||||
jsr _1parm
|
|
||||||
.if no_fast_lits
|
|
||||||
ldy #.loword(_LIT)
|
|
||||||
lda #.hiword(_LIT)
|
|
||||||
jsr _ccellay ; compile _LIT
|
|
||||||
bra COMMA::code ; compile actual number
|
|
||||||
.else
|
|
||||||
lda STACKBASE+2,x
|
|
||||||
beq COMMA::code ; compile fast literal
|
|
||||||
ldy #.loword(_LIT)
|
|
||||||
lda #.hiword(_LIT)
|
|
||||||
jsr _ccellay ; compile _LIT
|
|
||||||
bra COMMA::code ; compile actual number
|
|
||||||
.endif
|
|
||||||
eword
|
|
||||||
|
|
||||||
; H: ( char -- ) Compile char into dictionary.
|
; H: ( char -- ) Compile char into dictionary.
|
||||||
dword CCOMMA,"C,"
|
dword CCOMMA,"C,"
|
||||||
jsr _popay
|
jsr _popay
|
||||||
|
@ -1348,6 +1329,44 @@ dword LCOMMA,"L,"
|
||||||
bra COMMA::code
|
bra COMMA::code
|
||||||
eword
|
eword
|
||||||
|
|
||||||
|
; H: Compilation: ( n -- )
|
||||||
|
; H: Execution: ( -- n )
|
||||||
|
dword LITERAL,"LITERAL",F_IMMED
|
||||||
|
jsr _1parm
|
||||||
|
.if no_fast_lits
|
||||||
|
ldy #.loword(_LIT)
|
||||||
|
lda #.hiword(_LIT)
|
||||||
|
jsr _ccellay ; compile _LIT
|
||||||
|
bra COMMA::code ; compile actual number
|
||||||
|
.else
|
||||||
|
lda STACKBASE+2,x
|
||||||
|
beq COMMA::code ; compile fast literal
|
||||||
|
ldy #.loword(_LIT)
|
||||||
|
lda #.hiword(_LIT)
|
||||||
|
jsr _ccellay ; compile _LIT
|
||||||
|
bra COMMA::code ; compile actual number
|
||||||
|
.endif
|
||||||
|
eword
|
||||||
|
|
||||||
|
dword TWOLITERAL,"2LITERAL",F_IMMED
|
||||||
|
ENTER
|
||||||
|
do2lit: .dword SWAP
|
||||||
|
.dword LITERAL
|
||||||
|
.dword LITERAL
|
||||||
|
EXIT
|
||||||
|
eword
|
||||||
|
|
||||||
|
; do LITERAL or 2LITERAL
|
||||||
|
hword XLITERAL,"XLITERAL"
|
||||||
|
ENTER
|
||||||
|
.dword TWO
|
||||||
|
.dword EQUAL
|
||||||
|
.dword _IFFALSE
|
||||||
|
.dword TWOLITERAL::do2lit ; true branch
|
||||||
|
.dword LITERAL
|
||||||
|
EXIT
|
||||||
|
eword
|
||||||
|
|
||||||
; H: ( u -- u ) Align u (no-op in this implementation).
|
; H: ( u -- u ) Align u (no-op in this implementation).
|
||||||
dword ALIGN,"ALIGN"
|
dword ALIGN,"ALIGN"
|
||||||
NEXT
|
NEXT
|
||||||
|
@ -4585,8 +4604,7 @@ dword GNUMBER,">NUMBER"
|
||||||
stz XR+2
|
stz XR+2
|
||||||
digit: lda XR ; see if no more chars left
|
digit: lda XR ; see if no more chars left
|
||||||
beq done
|
beq done
|
||||||
ldy XR+2
|
lda [WR]
|
||||||
lda [WR],y
|
|
||||||
and #$FF ; enforce char from 16-bit load
|
and #$FF ; enforce char from 16-bit load
|
||||||
cmp #'.' ; IEEE 1275-1994 requires these to be ignored
|
cmp #'.' ; IEEE 1275-1994 requires these to be ignored
|
||||||
beq ignore ; when embedded in the number
|
beq ignore ; when embedded in the number
|
||||||
|
@ -4612,7 +4630,8 @@ digit: lda XR ; see if no more chars left
|
||||||
jsr _pushay ; ( -- n ud1h*basel ud1l base )
|
jsr _pushay ; ( -- n ud1h*basel ud1l base )
|
||||||
jsr _umult ; ( -- n ud1h*basel ud1l*basel ud1l*baseh )
|
jsr _umult ; ( -- n ud1h*basel ud1l*basel ud1l*baseh )
|
||||||
jsr _dplus ; ( -- ud2 )
|
jsr _dplus ; ( -- ud2 )
|
||||||
next: dec XR
|
next: jsr _incwr
|
||||||
|
dec XR
|
||||||
inc XR+2
|
inc XR+2
|
||||||
bra digit
|
bra digit
|
||||||
done: ldy WR
|
done: ldy WR
|
||||||
|
@ -6604,8 +6623,8 @@ bad: sty STACKBASE+0,x
|
||||||
NEXT
|
NEXT
|
||||||
eword
|
eword
|
||||||
|
|
||||||
; H: ( addr len -- true | n false ) Attmept to convert string to number.
|
; H: ( addr len -- 0 | n 1 | d 2 ) Attmept to convert string to number.
|
||||||
dword dNUMBER,"$NUMBER"
|
hword dgNUM,"$>NUM"
|
||||||
ENTER
|
ENTER
|
||||||
.dword OVER
|
.dword OVER
|
||||||
.dword CFETCH
|
.dword CFETCH
|
||||||
|
@ -6624,17 +6643,42 @@ dword dNUMBER,"$NUMBER"
|
||||||
.dword StoD ; ( 0 -- ud )
|
.dword StoD ; ( 0 -- ud )
|
||||||
.dword TWORtoP ; ( ud -- ud c-addr u )
|
.dword TWORtoP ; ( ud -- ud c-addr u )
|
||||||
.dword GNUMBER ; ( ud c-addr u -- ud' c-addr' u' ) u' = 0 if no unconverted
|
.dword GNUMBER ; ( ud c-addr u -- ud' c-addr' u' ) u' = 0 if no unconverted
|
||||||
.dword _IF ; ( ud' c-addr' u' -- ud' c-addr' )
|
.dword QDUP ; ( ud' c-addr' u' -- ud' c-addr' u' | ud' c-addr' u' u' )
|
||||||
.dword okay
|
.dword _IF
|
||||||
.dword THREEDROP ; ( ud' c-addr' -- )
|
.dword okay ; branch taken: ( ... ud c-addr' )
|
||||||
|
.dword ONE ; ( ud' c-addr' u' - ud' c-addr' u' 1 )
|
||||||
|
.dword EQUAL ; ( ud' c-addr' u' 1 -- ud' c-addr' f )
|
||||||
|
.dword _IF ; ( ud' c-addr' f -- ud' c-addr' )
|
||||||
|
.dword notok
|
||||||
|
.dword CFETCH ; ( ud' c-addr' -- ud' c )
|
||||||
|
ONLIT '.' ; ( ud' c -- ud' c '.' )
|
||||||
|
.dword EQUAL ; ( ud' c '.' -- ud' f )
|
||||||
|
.dword _IFFALSE ; ( ud' f -- ud' )
|
||||||
|
.dword dokay ; if true
|
||||||
|
.dword ZERO ; ( ud' -- ud' 0 ) p/h for THREEDROP
|
||||||
|
notok: .dword THREEDROP ; ( ud' c-addr' -- )
|
||||||
.dword RDROP ; lose negative
|
.dword RDROP ; lose negative
|
||||||
.dword TRUE ; ( -- tf )
|
.dword ZERO ; ( -- 0 )
|
||||||
EXIT
|
EXIT
|
||||||
okay: .dword DROP ; ( ud' c-addr' -- ud' )
|
okay: .dword DROP ; ( ud' c-addr' -- ud' )
|
||||||
.dword DtoS ; ( ud' -- n )
|
.dword DtoS ; ( ud' -- n )
|
||||||
.dword RtoP
|
.dword RtoP
|
||||||
.dword QNEGATE
|
.dword QNEGATE
|
||||||
.dword FALSE ; ( n -- n ff )
|
.dword ONE ; ( n -- n 1 )
|
||||||
|
EXIT
|
||||||
|
dokay: .dword RtoP ; ( ud' -- ud' f )
|
||||||
|
.dword _IF ; ( ud' f -- ud' )
|
||||||
|
.dword :+
|
||||||
|
.dword DNEGATE ; ( ud' -- d )
|
||||||
|
: .dword TWO ; ( d -- d 2 )
|
||||||
|
EXIT
|
||||||
|
eword
|
||||||
|
|
||||||
|
; H: ( addr len -- true | n false ) Attmept to convert string to number.
|
||||||
|
dword dNUMBER,"$NUMBER"
|
||||||
|
ENTER
|
||||||
|
.dword dgNUM
|
||||||
|
.dword ZEROQ
|
||||||
EXIT
|
EXIT
|
||||||
eword
|
eword
|
||||||
|
|
||||||
|
@ -6668,20 +6712,25 @@ chkimm: .dword IMMEDQ ; compiling, immediate? (leaves xt on stack)
|
||||||
exec: .dword EXECUTE
|
exec: .dword EXECUTE
|
||||||
JUMP loop
|
JUMP loop
|
||||||
trynum: .dword TWODUP ; ( c-addr u -- c-addr u c-addr u )
|
trynum: .dword TWODUP ; ( c-addr u -- c-addr u c-addr u )
|
||||||
.dword dNUMBER ; ( c-addr u c-addr u -- c-addr u num false | c-addr u true )
|
.dword dgNUM ; ( c-addr u c-addr u -- c-addr u 0 | c-addr u n 1 | c-addr u d 2 )
|
||||||
.dword _IF
|
.dword QDUP
|
||||||
.dword goodnum ; false = good number
|
.dword _IFFALSE
|
||||||
|
.dword isnum ; nonzero = is number
|
||||||
.dword SPACE
|
.dword SPACE
|
||||||
.dword TYPE
|
.dword TYPE
|
||||||
ONLIT '?'
|
ONLIT '?'
|
||||||
.dword EMIT
|
.dword EMIT
|
||||||
NLIT -13
|
ONLIT -13
|
||||||
.dword THROW
|
.dword THROW
|
||||||
goodnum: .dword NIPTWO
|
isnum: .dword XNPtoR
|
||||||
|
.dword NIPTWO
|
||||||
|
.dword XNRtoP
|
||||||
.dword _SMART
|
.dword _SMART
|
||||||
.dword loop ; if interpreting
|
.dword inum
|
||||||
.dword LITERAL
|
.dword XLITERAL
|
||||||
JUMP loop
|
.dword _SKIP
|
||||||
|
inum: .dword DROP
|
||||||
|
JUMP loop
|
||||||
conly: .dword _SMART
|
conly: .dword _SMART
|
||||||
.dword trytemp ; if interpreting, try temporary def
|
.dword trytemp ; if interpreting, try temporary def
|
||||||
JUMP chkimm ; otherwise check immediacy
|
JUMP chkimm ; otherwise check immediacy
|
||||||
|
@ -6689,7 +6738,7 @@ trytemp: .dword TEMPDQ ; has flag for starting temp def
|
||||||
.dword _IFFALSE
|
.dword _IFFALSE
|
||||||
.dword dotemp ; true, so start temporary def
|
.dword dotemp ; true, so start temporary def
|
||||||
.dword DROP ; otherwise bad state, drop XT
|
.dword DROP ; otherwise bad state, drop XT
|
||||||
NLIT -14 ; and throw exception
|
ONLIT -14 ; and throw exception
|
||||||
.dword THROW
|
.dword THROW
|
||||||
null: .dword DROP
|
null: .dword DROP
|
||||||
done: EXIT
|
done: EXIT
|
||||||
|
@ -6782,20 +6831,23 @@ dword EVAL,"EVAL"
|
||||||
bra EVALUATE::code
|
bra EVALUATE::code
|
||||||
eword
|
eword
|
||||||
|
|
||||||
; ( [number< >] n ) Parse number, compile as literal if compiling.
|
; ( [number< >] n ) Parse number in input stream, compile as literal if compiling.
|
||||||
hword nNUM,"#NUM"
|
hword nNUM,"#NUM"
|
||||||
ENTER
|
ENTER
|
||||||
.dword PARSE_WORD
|
.dword PARSE_WORD
|
||||||
.dword DUP
|
.dword DUP
|
||||||
.dword _IF
|
.dword _IF
|
||||||
.dword empty
|
.dword empty
|
||||||
.dword dNUMBER
|
.dword dgNUM
|
||||||
.dword _IFFALSE
|
.dword DUP
|
||||||
|
.dword _IF
|
||||||
.dword bad
|
.dword bad
|
||||||
.dword _SMART
|
.dword _SMART
|
||||||
.dword interp
|
.dword interp
|
||||||
.dword LITERAL
|
.dword XLITERAL
|
||||||
interp: EXIT
|
.dword _SKIP
|
||||||
|
interp: .dword DROP
|
||||||
|
EXIT
|
||||||
empty: .dword TWODROP
|
empty: .dword TWODROP
|
||||||
bad: ONLIT -24
|
bad: ONLIT -24
|
||||||
.dword THROW
|
.dword THROW
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
testing 7.3.4.1 Text input
|
testing 7.3.4.1 Text input
|
||||||
|
hex
|
||||||
|
|
||||||
|
\ test comment words
|
||||||
t{ 1 -> 1 }t ( t{ 1 -> 2 }t ) t{ 2 -> 2 }t
|
t{ 1 -> 1 }t ( t{ 1 -> 2 }t ) t{ 2 -> 2 }t
|
||||||
t{ 1 -> 1 }t \ t{ 1 -> 2 }t
|
t{ 1 -> 1 }t \ t{ 1 -> 2 }t
|
||||||
|
|
||||||
|
@ -9,10 +11,28 @@ t{ parse-word test swap 0> -> 4 true }t
|
||||||
t{ source 0> swap 0> -> true true }t
|
t{ source 0> swap 0> -> true true }t
|
||||||
t{ bl word test count swap 0> -> 4 true }t
|
t{ bl word test count swap 0> -> 4 true }t
|
||||||
|
|
||||||
|
\ IEEE 1275-1994 number input
|
||||||
|
|
||||||
|
\ first make sure >number (ANS word) works
|
||||||
|
t{ 0 s>d s" 123" >number nip -> 123 0 0 }t
|
||||||
|
t{ 0 s>d s" 123?456" >number nip -> 123 0 4 }t
|
||||||
|
|
||||||
|
t{ 1,234,567 -> 1234567 }t
|
||||||
|
t{ 1.234.567 -> 1234567 }t
|
||||||
|
t{ 1234567. -> 1234567 s>d }t
|
||||||
|
t{ -1234567. -> -1234567 s>d }t
|
||||||
|
|
||||||
|
\ Things that should fail
|
||||||
|
t{ s" 123," ' eval catch >r clear r> -> -d }t
|
||||||
|
t{ s" ,123" ' eval catch >r clear r> -> -d }t
|
||||||
|
t{ s" .123" ' eval catch >r clear r> -> -d }t
|
||||||
|
|
||||||
testing 7.3.4.2 Console input
|
testing 7.3.4.2 Console input
|
||||||
|
|
||||||
\ covers: \
|
\ covers: \
|
||||||
t{ \ -> supercalafrag }t \ since 't{' is a nop this should be fine
|
t{ \ -> supercalafrag }t \ since 't{' is a nop this should be fine
|
||||||
|
|
||||||
|
\ hard to test stuff
|
||||||
t{ ' key? 0= -> false }t
|
t{ ' key? 0= -> false }t
|
||||||
t{ ' key 0= -> false }t
|
t{ ' key 0= -> false }t
|
||||||
t{ ' expect 0= -> false }t
|
t{ ' expect 0= -> false }t
|
||||||
|
|
Loading…
Reference in New Issue