Somehow mangles the parameter stack during LOOP.
--- /dev/null
+: CFA>
+ LATEST @
+ BEGIN
+ ?DUP
+ WHILE
+ 2DUP SWAP
+ < IF
+ NIP
+ EXIT
+ THEN
+ @
+ REPEAT
+ DROP
+ 0
+;
+
+: DECIMAL 10 BASE ! ;
+: HEX 16 BASE ! ;
+
+: ID.
+ 1+
+ DUP @
+ F_LENMASK AND
+
+ BEGIN
+ DUP 0>
+ WHILE
+ SWAP 1+
+ DUP @ EMIT
+ SWAP 1-
+ REPEAT
+ 2DROP
+;
+
+: name cfa> id. ;
+
+: [trace] immediate
+ trace ;
+
+\ : test 20 0 [trace] do 42 emit [trace] loop ;
+
return -length(primitives)
end
return -length(primitives)
end
-callPrim(addr::Int64) = primitives[-addr]()
+function callPrim(addr::Int64)
+ if addr >=0 || -addr>length(primitives)
+ error("Attempted to execute non-existent primitive at address $addr.")
+ else
+ primitives[-addr]()
+ end
+end
getPrimName(addr::Int64) = primNames[-addr]
# Word creation functions
getPrimName(addr::Int64) = primNames[-addr]
# Word creation functions
# Outer interpreter
TRACE = defPrimWord("TRACE", () -> begin
# Outer interpreter
TRACE = defPrimWord("TRACE", () -> begin
- println("Val: $(popPS())")
- print("RS: "); printRS()
+ println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
+ print("RS: "); printRS()
print("[paused]")
readline()
print("[paused]")
readline()
return NEXT
end, flags=F_IMMED)
return NEXT
end, flags=F_IMMED)
-TICK = defWord("'",
- [LIT, 32, WORD, FIND, TOCFA, EXIT])
-
initFileName = Pkg.dir("forth/src/lib.4th")
end
initFileName = Pkg.dir("forth/src/lib.4th")
end
-function run(;initialize=false)
+function run(;initialize=true)
# Begin with STDIN as source
push!(sources, STDIN)
# Begin with STDIN as source
push!(sources, STDIN)
+ # Want backtrace in here eventually
+ println("reg.W: $(reg.W) reg.IP: $(reg.IP)")
+ print("PS: "); printPS()
+ print("RS: "); printRS()
+
mem[STATE] = 0
mem[NUMTIB] = 0
reg.PSP = mem[PSP0]
mem[STATE] = 0
mem[NUMTIB] = 0
reg.PSP = mem[PSP0]
: LITERAL IMMEDIATE ['] LIT , , ;
: LITERAL IMMEDIATE ['] LIT , , ;
: [CHAR] IMMEDIATE
CHAR
['] LIT , ,
: [CHAR] IMMEDIATE
CHAR
['] LIT , ,
['] DUP , \ Store copy of increment
['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
['] DUP , \ Store copy of increment
['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
\ Condition differently depending on sign of increment
['] SWAP , ['] 0>= , [COMPILE] IF
['] 0<= ,
\ Condition differently depending on sign of increment
['] SWAP , ['] 0>= , [COMPILE] IF
['] 0<= ,
\ Branch back to begining of loop kernel
['] 0BRANCH , HERE @ - ,
\ Clean up
['] RDROP , ['] RDROP , ['] RDROP ,
\ Branch back to begining of loop kernel
['] 0BRANCH , HERE @ - ,
\ Clean up
['] RDROP , ['] RDROP , ['] RDROP ,
\ Record address of loop end for any LEAVEs to use
HERE @ SWAP !
\ Record address of loop end for any LEAVEs to use
HERE @ SWAP !