alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

New builtins work now.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-06 18:19:01 -08:00
parent 7bd9090913
commit 4abd02ba94
11 changed files with 214 additions and 196 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
ueforth/Makefile
View File

@ -179,7 +179,7 @@ $(GEN):
COMMON_PHASE1 = common/boot.fs common/conditionals.fs common/vocabulary.fs \
common/floats.fs
COMMON_DESKTOP = common/hide_calls.fs common/ansi.fs common/desktop.fs
COMMON_DESKTOP = common/ansi.fs common/desktop.fs
COMMON_PHASE2 = common/tasks.fs common/utils.fs common/locals.fs \
common/filetools.fs common/including.fs \

23
ueforth/common/calls.h
View File

@ -25,15 +25,14 @@ typedef cell_t (CALLTYPE *call_t)();
#define ct0 ((call_t) n0)
#define CALLING_OPCODE_LIST \
Y(CALL0, n0 = ct0()) \
Y(CALL1, n0 = ct0(n1); --sp) \
Y(CALL2, n0 = ct0(n2, n1); sp -= 2) \
Y(CALL3, n0 = ct0(n3, n2, n1); sp -= 3) \
Y(CALL4, n0 = ct0(n4, n3, n2, n1); sp -= 4) \
Y(CALL5, n0 = ct0(n5, n4, n3, n2, n1); sp -= 5) \
Y(CALL6, n0 = ct0(n6, n5, n4, n3, n2, n1); sp -= 6) \
Y(CALL7, n0 = ct0(n7, n6, n5, n4, n3, n2, n1); sp -= 7) \
Y(CALL8, n0 = ct0(n8, n7, n6, n5, n4, n3, n2, n1); sp -= 8) \
Y(CALL9, n0 = ct0(n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 9) \
Y(CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10) \
YV(internals, CALL0, n0 = ct0()) \
YV(internals, CALL1, n0 = ct0(n1); --sp) \
YV(internals, CALL2, n0 = ct0(n2, n1); sp -= 2) \
YV(internals, CALL3, n0 = ct0(n3, n2, n1); sp -= 3) \
YV(internals, CALL4, n0 = ct0(n4, n3, n2, n1); sp -= 4) \
YV(internals, CALL5, n0 = ct0(n5, n4, n3, n2, n1); sp -= 5) \
YV(internals, CALL6, n0 = ct0(n6, n5, n4, n3, n2, n1); sp -= 6) \
YV(internals, CALL7, n0 = ct0(n7, n6, n5, n4, n3, n2, n1); sp -= 7) \
YV(internals, CALL8, n0 = ct0(n8, n7, n6, n5, n4, n3, n2, n1); sp -= 8) \
YV(internals, CALL9, n0 = ct0(n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 9) \
YV(internals, CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10)

1
ueforth/common/floats.fs
View File

@ -27,7 +27,6 @@ internals definitions
: #f+s ( r -- ) fdup precision 0 ?do 10e f* loop
precision 0 ?do fdup f>s 10 mod [char] 0 + hold 0.1e f* loop
[char] . hold fdrop f>s #s ;
transfer doflit
forth definitions internals
: #fs ( r -- ) fdup f0< if fnegate #f+s [char] - hold else #f+s then ;

4
ueforth/common/floats.h
View File

@ -13,7 +13,7 @@
// limitations under the License.
#define FLOATING_POINT_LIST \
Y(DOFLIT, *++fp = *(float *) ip++) \
YV(internals, DOFLIT, *++fp = *(float *) ip++) \
X("FP@", FPAT, DUP; tos = (cell_t) fp) \
X("FP!", FPSTORE, fp = (float *) tos; DROP) \
X("SF@", FAT, *++fp = *(float *) tos; DROP) \
@ -39,7 +39,7 @@
X("1/F", FINVERSE, *fp = 1.0 / *fp) \
X("S>F", STOF, *++fp = (float) tos; DROP) \
X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
X("F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
XV(internals, "F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
Y(SFLOAT, DUP; tos = sizeof(float)) \
Y(SFLOATS, tos *= sizeof(float)) \
X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \

327
ueforth/common/forth_namespace_tests.fs
View File

@ -13,7 +13,18 @@
\ limitations under the License.
also internals
: list-from ( xt ) begin dup nonvoc? while dup see. cr >link repeat drop ;
: list-builtins ( voc )
>r 'builtins begin dup >link while
dup >params r@ = if dup see. cr then
3 cells +
repeat drop rdrop ;
: list-from ( xt ) begin dup nonvoc? while
dup >flags BUILTIN_FORK and if
dup cell+ @ list-builtins
then
dup see. cr
>link
repeat drop ;
e: check-locals
out: +to
@ -137,143 +148,141 @@ e: check-boot
;e
e: check-extra-opcodes
out: >body
out: >name
out: >link
out: >link&
out: >size
out: >params
out: >flags
out: c,
out: ,
out: align
out: aligned
out: allot
out: here
out: abs
out: max
out: min
out: blank
out: erase
out: fill
out: cmove>
out: cmove
out: 2!
out: 2@
out: 2dup
out: 2drop
out: cell/
out: cells
out: cell+
out: +!
out: 4/
out: 4*
out: 2/
out: 2*
out: 1-
out: 1+
out: nl
out: bl
out: 0<>
out: <>
out: =
out: >=
out: <=
out: >
out: <
out: -rot
out: rot
out: -
out: negate
out: invert
out: mod
out: /
out: /mod
out: *
out: */
out: rdrop
out: nip
out: rdrop
out: */
out: *
out: /mod
out: /
out: mod
out: invert
out: negate
out: -
out: rot
out: -rot
out: <
out: >
out: <=
out: >=
out: =
out: <>
out: 0<>
out: bl
out: nl
out: 1+
out: 1-
out: 2*
out: 2/
out: 4*
out: 4/
out: +!
out: cell+
out: cells
out: cell/
out: 2drop
out: 2dup
out: 2@
out: 2!
out: cmove
out: cmove>
out: fill
out: erase
out: blank
out: min
out: max
out: abs
out: here
out: allot
out: aligned
out: align
out: ,
out: c,
out: >flags
out: >params
out: >size
out: >link&
out: >link
out: >name
out: >body
;e
e: check-core-opcodes
out: ;
out: EXIT
out: :
out: IMMEDIATE
out: DOES>
out: CREATE
out: S>NUMBER?
out: PARSE
out: FIND
out: CELL
out: EXECUTE
out: R@
out: R>
out: >R
out: RP!
out: RP@
out: SP!
out: SP@
out: C!
out: W!
out: L!
out: !
out: C@
out: SW@
out: SL@
out: @
out: DROP
out: OVER
out: SWAP
out: DUP
out: XOR
out: OR
out: AND
out: RSHIFT
out: LSHIFT
out: */MOD
out: U/MOD
out: +
out: 0<
out: 0=
out: 0<
out: +
out: U/MOD
out: */MOD
out: LSHIFT
out: RSHIFT
out: AND
out: OR
out: XOR
out: DUP
out: SWAP
out: OVER
out: DROP
out: @
out: SL@
out: SW@
out: C@
out: !
out: L!
out: W!
out: C!
out: SP@
out: SP!
out: RP@
out: RP!
out: >R
out: R>
out: R@
out: EXECUTE
out: CELL
out: FIND
out: PARSE
out: CREATE
out: DOES>
out: IMMEDIATE
out: :
out: EXIT
out: ;
;e
e: check-float-opcodes
out: FSQRT
out: PI
out: SFLOAT+
out: SFLOATS
out: SFLOAT
out: F>NUMBER?
out: F>S
out: S>F
out: 1/F
out: F/
out: F*
out: F-
out: F+
out: F>=
out: F<=
out: F<>
out: F>
out: F<
out: F=
out: F0=
out: F0<
out: FNEGATE
out: FSWAP
out: FOVER
out: FDROP
out: FNIP
out: FDUP
out: SF!
out: SF@
out: FP!
out: FP@
out: FP!
out: SF@
out: SF!
out: FDUP
out: FNIP
out: FDROP
out: FOVER
out: FSWAP
out: FNEGATE
out: F0<
out: F0=
out: F=
out: F<
out: F>
out: F<>
out: F<=
out: F>=
out: F+
out: F-
out: F*
out: F/
out: 1/F
out: S>F
out: F>S
out: SFLOAT
out: SFLOATS
out: SFLOAT+
out: PI
out: FSQRT
;e
e: check-files
@ -296,6 +305,26 @@ e: check-files
out: R/O
;e
e: check-files-reverse
out: R/O
out: W/O
out: R/W
out: BIN
out: CLOSE-FILE
out: FLUSH-FILE
out: OPEN-FILE
out: CREATE-FILE
out: DELETE-FILE
out: RENAME-FILE
out: WRITE-FILE
out: READ-FILE
out: FILE-POSITION
out: REPOSITION-FILE
out: RESIZE-FILE
out: FILE-SIZE
out: NON-BLOCK
;e
e: check-blocks
out: editor
out: list
@ -397,9 +426,12 @@ e: check-phase1
check-vocabulary
check-[]conds
check-boot
\ check-core-opcodes
\ check-extra-opcodes
\ check-float-opcodes
;e
e: check-opcodes
check-float-opcodes
check-extra-opcodes
check-core-opcodes
;e
e: check-desktop
@ -446,8 +478,9 @@ e: test-windows-forth-namespace
out: default-type
out: windows
check-phase1
\ out: LOADLIBRARYA
\ out: GETPROCADDRESS
out: GETPROCADDRESS
out: LOADLIBRARYA
check-opcodes
out: forth-builtins
;e
@ -488,7 +521,8 @@ e: test-posix-forth-namespace
out: default-type
out: posix
check-phase1
\ out: DLSYM
out: DLSYM
check-opcodes
out: forth-builtins
;e
@ -533,17 +567,17 @@ e: check-esp32-basics
out: pin
;e
e: check-esp32-basics2
out: MDNS.begin
out: dacWrite
check-files
out: TERMINATE
out: MS-TICKS
out: pulseIn
out: analogRead
out: digitalRead
out: digitalWrite
e: check-esp32-builtins
out: pinMode
out: digitalWrite
out: digitalRead
out: analogRead
out: pulseIn
out: MS-TICKS
out: TERMINATE
check-files-reverse
out: dacWrite
out: MDNS.begin
;e
e: test-esp32-forth-namespace
@ -583,7 +617,8 @@ e: test-esp32-forth-namespace
check-phase2
check-allocation
check-phase1
\ check-esp32-basics2
check-esp32-builtins
check-opcodes
out: forth-builtins
;e

19
ueforth/common/hide_calls.fs
View File

@ -1,19 +0,0 @@
\ Copyright 2021 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
internals definitions
transfer{
call0 call1 call2 call3 call4 call5 call6 call7 call8 call9 call10
}transfer
forth definitions

19
ueforth/common/opcodes.h
View File

@ -63,8 +63,13 @@ typedef int64_t dcell_t;
typedef struct {
const char *name;
union {
struct {
uint8_t flags, name_length;
uint16_t vocabulary;
};
cell_t multi;
};
const void *code;
} BUILTIN_WORD;
@ -100,11 +105,11 @@ typedef struct {
X("R>", FROMR, DUP; tos = *rp; --rp) \
X("R@", RAT, DUP; tos = *rp) \
Y(EXECUTE, w = tos; DROP; JMPW) \
Y(BRANCH, ip = (cell_t *) *ip) \
Y(0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
Y(DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
Y(DOLIT, DUP; tos = *ip++) \
Y(ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
YV(internals, BRANCH, ip = (cell_t *) *ip) \
YV(internals, 0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
YV(internals, DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
YV(internals, DOLIT, DUP; tos = *ip++) \
YV(internals, ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
Y(CELL, DUP; tos = sizeof(cell_t)) \
Y(FIND, tos = find((const char *) *sp, tos); --sp) \
Y(PARSE, DUP; tos = parse(tos, sp)) \
@ -117,7 +122,7 @@ typedef struct {
X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
Y(IMMEDIATE, DOIMMEDIATE()) \
XV(internals, "'SYS", SYS, DUP; tos = (cell_t) &g_sys) \
Y(YIELD, PARK; return rp) \
YV(internals, YIELD, PARK; return rp) \
X(":", COLON, DUP; DUP; tos = parse(32, sp); \
create((const char *) *sp, tos, SMUDGE, ADDR_DOCOLON); \
g_sys.state = -1; --sp; DROP) \
@ -125,5 +130,5 @@ typedef struct {
sp = evaluate1(sp, &tfp); \
fp = tfp; w = *sp--; DROP; if (w) JMPW) \
Y(EXIT, ip = (cell_t *) *rp--) \
XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) g_sys.builtins) \
XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) &g_sys.builtins->code) \
XV(forth_immediate, ";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)

6
ueforth/common/utils.fs
View File

@ -108,7 +108,7 @@ internals definitions
line-pos line-width > if cr 0 to line-pos then
dup >name nip 1+ line-pos + to line-pos ;
: vins. ( voc -- )
>r 'builtins 2 cells + begin dup 2 cells - @ while
>r 'builtins begin dup >link while
dup >params r@ = if dup onlines see. then
3 cells +
repeat drop rdrop ;
@ -116,9 +116,9 @@ internals definitions
: ?ins. ( xt -- xt ) dup >flags BUILTIN_FORK and if dup ins. then ;
forth definitions also internals
: vlist 0 to line-pos context @ @
begin dup nonvoc? while onlines dup ?ins. see. >link repeat drop cr ;
begin dup nonvoc? while ?ins. dup onlines see. >link repeat drop cr ;
: words 0 to line-pos context @ @
begin dup while onlines dup see. >link repeat drop cr ;
begin dup while ?ins. dup onlines see. >link repeat drop cr ;
only forth definitions
( Extra Task Utils )

3
ueforth/common/vocabulary.fs
View File

@ -50,10 +50,9 @@ variable scope scope context cell - !
transfer{
xt-find& xt-hide xt-transfer
voc-stack-end last-vocabulary
yield branch 0branch donext dolit
'context 'notfound notfound
immediate? input-buffer ?echo ?arrow. arrow
evaluate1 evaluate-buffer
evaluate-buffer
'sys 'heap aliteral 'heap-start 'heap-size
'stack-cells 'boot 'boot-size 'latestxt
'argc 'argv 'runner 'tib

1
ueforth/esp32/platform.fs
View File

@ -14,7 +14,6 @@
( Add a yielding task so pause yields )
internals definitions
transfer{ raw-yield }transfer
: yield-step raw-yield yield ;
' yield-step 100 100 task yield-task
yield-task start-task

1
ueforth/windows/interp.h
View File

@ -38,6 +38,7 @@ static cell_t *forth_run(cell_t *init_rp) {
EXTRA_OPCODE_LIST
OPCODE_LIST
#undef XV
0, 0, 0,
};
if (!init_rp) {