From 14642db34731bafb5403c8f9b6a1c779f6a30280 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Fri, 4 Feb 2022 18:26:36 -0800 Subject: [PATCH] Inlined several words for size. --- ueforth/Makefile | 6 +++ ueforth/common/boot.fs | 42 ++------------------ ueforth/common/extra.fs | 50 ++++++++++++++++++++++++ ueforth/common/extra_opcodes.h | 51 +++++++++++++++++++++++++ ueforth/common/forth_namespace_tests.fs | 8 +++- ueforth/common/interp.h | 2 + ueforth/common/utils.fs | 2 +- ueforth/esp32/sim_main.cpp | 1 + ueforth/esp32/template.ino | 1 + ueforth/posix/main.c | 1 + ueforth/site/internals.html | 4 ++ ueforth/windows/interp.h | 3 ++ ueforth/windows/main.c | 1 + 13 files changed, 130 insertions(+), 42 deletions(-) create mode 100644 ueforth/common/extra.fs create mode 100644 ueforth/common/extra_opcodes.h diff --git a/ueforth/Makefile b/ueforth/Makefile index 6af9e28..38dbeed 100644 --- a/ueforth/Makefile +++ b/ueforth/Makefile @@ -284,6 +284,7 @@ $(POSIX): $(POSIX)/ueforth: \ posix/main.c \ common/opcodes.h \ + common/extra_opcodes.h \ common/calls.h \ common/calling.h \ common/floats.h \ @@ -306,6 +307,7 @@ $(WINDOWS): $(WINDOWS)/uEf32.obj: \ windows/main.c \ common/opcodes.h \ + common/extra_opcodes.h \ common/calls.h \ common/calling.h \ common/floats.h \ @@ -322,6 +324,7 @@ $(WINDOWS)/uEf32.exe: \ $(WINDOWS)/uEf64.obj: \ windows/main.c \ common/opcodes.h \ + common/extra_opcodes.h \ common/calls.h \ common/calling.h \ common/floats.h \ @@ -354,6 +357,7 @@ $(ESP32_SIM)/Esp32forth-sim: \ esp32/sim_main.cpp \ esp32/main.cpp \ common/opcodes.h \ + common/extra_opcodes.h \ common/floats.h \ common/calling.h \ common/floats.h \ @@ -378,6 +382,7 @@ $(ESP32)/ESP32forth: ESP32_PARTS = common/replace.js \ esp32/template.ino \ common/opcodes.h \ + common/extra_opcodes.h \ common/floats.h \ common/calling.h \ common/core.h \ @@ -395,6 +400,7 @@ $(ESP32)/ESP32forth/ESP32forth.ino: $(ESP32_PARTS) | $(ESP32)/ESP32forth REVISION=$(REVISION) \ config=@esp32/config.h \ opcodes=@common/opcodes.h \ + extra_opcodes=@common/extra_opcodes.h \ calling=@common/calling.h \ floats=@common/floats.h \ core=@common/core.h \ diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs index 924adea..7d5a541 100644 --- a/ueforth/common/boot.fs +++ b/ueforth/common/boot.fs @@ -1,6 +1,3 @@ -: ( 41 parse drop drop ; immediate -: \ 10 parse drop drop ; immediate - \ Copyright 2021 Bradley D. Nelson \ \ Licensed under the Apache License, Version 2.0 (the "License"); @@ -15,42 +12,9 @@ \ See the License for the specific language governing permissions and \ limitations under the License. -( Useful Basic Compound Words ) -: nip ( a b -- b ) swap drop ; -: rdrop ( r: n n -- ) r> r> drop >r ; -: */ ( n n n -- n ) */mod nip ; -: * ( n n -- n ) 1 */ ; -: /mod ( n n -- n n ) 1 swap */mod ; -: / ( n n -- n ) /mod nip ; -: mod ( n n -- n ) /mod drop ; -: invert ( n -- ~n ) -1 xor ; -: negate ( n -- -n ) invert 1 + ; -: - ( n n -- n ) negate + ; -: rot ( a b c -- c a b ) >r swap r> swap ; -: -rot ( a b c -- b c a ) swap >r swap r> ; -: < ( a b -- a ( a b -- a>b ) swap - 0< ; -: <= ( a b -- a>b ) swap - 0< 0= ; -: >= ( a b -- a ( a b -- a!=b ) = 0= ; -: 0<> ( n -- n) 0= 0= ; -: bl 32 ; : nl 10 ; -: 1+ 1 + ; : 1- 1 - ; -: 2* 2 * ; : 2/ 2 / ; -: 4* 4 * ; : 4/ 4 / ; -: +! ( n a -- ) swap over @ + swap ! ; - -( Cells ) -: cell+ ( n -- n ) cell + ; -: cells ( n -- n ) cell * ; -: cell/ ( n -- n ) cell / ; - -( Double Words ) -: 2drop ( n n -- ) drop drop ; -: 2dup ( a b -- a b a b ) over over ; -: 2@ ( a -- lo hi ) dup @ swap cell+ @ ; -: 2! ( lo hi a -- ) dup >r cell+ ! r> ! ; +: ( 41 parse drop drop ; immediate +: \ 10 parse drop drop ; immediate +( Now can do comments! ) ( Dictionary ) : here ( -- a ) 'sys @ ; diff --git a/ueforth/common/extra.fs b/ueforth/common/extra.fs new file mode 100644 index 0000000..e2e8911 --- /dev/null +++ b/ueforth/common/extra.fs @@ -0,0 +1,50 @@ +\ Copyright 2022 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. + +( Useful Basic Compound Words ) +: nip ( a b -- b ) swap drop ; +: rdrop ( r: n n -- ) r> r> drop >r ; +: */ ( n n n -- n ) */mod nip ; +: * ( n n -- n ) 1 */ ; +: /mod ( n n -- n n ) 1 swap */mod ; +: / ( n n -- n ) /mod nip ; +: mod ( n n -- n ) /mod drop ; +: invert ( n -- ~n ) -1 xor ; +: negate ( n -- -n ) invert 1 + ; +: - ( n n -- n ) negate + ; +: rot ( a b c -- c a b ) >r swap r> swap ; +: -rot ( a b c -- b c a ) swap >r swap r> ; +: < ( a b -- a ( a b -- a>b ) swap - 0< ; +: <= ( a b -- a>b ) swap - 0< 0= ; +: >= ( a b -- a ( a b -- a!=b ) = 0= ; +: 0<> ( n -- n) 0= 0= ; +: bl 32 ; : nl 10 ; +: 1+ 1 + ; : 1- 1 - ; +: 2* 2 * ; : 2/ 2 / ; +: 4* 4 * ; : 4/ 4 / ; +: +! ( n a -- ) swap over @ + swap ! ; + +( Cells ) +: cell+ ( n -- n ) cell + ; +: cells ( n -- n ) cell * ; +: cell/ ( n -- n ) cell / ; + +( Double Words ) +: 2drop ( n n -- ) drop drop ; +: 2dup ( a b -- a b a b ) over over ; +: 2@ ( a -- lo hi ) dup @ swap cell+ @ ; +: 2! ( lo hi a -- ) dup >r cell+ ! r> ! ; diff --git a/ueforth/common/extra_opcodes.h b/ueforth/common/extra_opcodes.h new file mode 100644 index 0000000..bcd7f7d --- /dev/null +++ b/ueforth/common/extra_opcodes.h @@ -0,0 +1,51 @@ +// 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. + +#define EXTRA_OPCODE_LIST \ + Y(nip, NIP) \ + Y(rdrop, --rp) \ + X("*/", STARSLASH, SSMOD_FUNC; NIP) \ + X("*", STAR, tos *= *sp--) \ + X("/mod", SLASHMOD, DUP; *sp = 1; SSMOD_FUNC) \ + X("/", SLASH, DUP; *sp = 1; SSMOD_FUNC; NIP) \ + Y(mod, DUP; *sp = 1; SSMOD_FUNC; DROP) \ + Y(invert, tos = ~tos) \ + Y(negate, tos = -tos) \ + X("-", MINUS, tos = (*sp--) - tos) \ + Y(rot, w = sp[-1]; sp[-1] = *sp; *sp = tos; tos = w) \ + X("-rot", MROT, w = tos; tos = *sp; *sp = sp[-1]; sp[-1] = w) \ + X("<", LESS, tos = (*sp--) < tos ? -1 : 0) \ + X(">", GREATER, tos = (*sp--) > tos ? -1 : 0) \ + X("<=", LESSEQ, tos = (*sp--) <= tos ? -1 : 0) \ + X(">=", GREATEREQ, tos = (*sp--) >= tos ? -1 : 0) \ + X("=", EQUAL, tos = (*sp--) == tos ? -1 : 0) \ + X("<>", NOTEQUAL, tos = (*sp--) != tos ? -1 : 0) \ + X("0<>", ZNOTEQUAL, tos = tos ? -1 : 0) \ + Y(bl, DUP; tos = ' ') \ + Y(nl, DUP; tos = '\n') \ + X("1+", ONEPLUS, ++tos) \ + X("1-", ONEMINUS, --tos) \ + X("2*", TWOSTAR, tos <<= 1) \ + X("2/", TWOSLASH, tos >>= 1) \ + X("4*", FOURSTAR, tos <<= 2) \ + X("4/", FOURSLASH, tos >>= 2) \ + X("+!", PLUSSTORE, *(cell_t *) tos += *sp--; DROP) \ + X("cell+", CELLPLUS, tos += sizeof(cell_t)) \ + X("cells", CELLSTAR, tos *= sizeof(cell_t)) \ + X("cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \ + X("2drop", TWODROP, DROP; DROP) \ + X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \ + X("2@", TWOAT, DUP; *sp = ((cell_t *) tos)[1]; tos = *(cell_t *) tos) \ + X("2!", TWOSTORE, DUP; ((cell_t *) tos)[0] = sp[-1]; \ + ((cell_t *) tos)[1] = *sp; DROP; DROP; DROP) diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs index a4333aa..1ba6489 100644 --- a/ueforth/common/forth_namespace_tests.fs +++ b/ueforth/common/forth_namespace_tests.fs @@ -170,6 +170,11 @@ e: check-boot out: aligned out: allot out: here + out: \ + out: ( +;e + +e: check-extra-opcodes out: 2! out: 2@ out: 2dup @@ -205,8 +210,6 @@ e: check-boot out: */ out: rdrop out: nip - out: \ - out: ( ;e e: check-core-opcodes @@ -397,6 +400,7 @@ e: check-phase1 check-[]conds check-boot check-core-opcodes + check-extra-opcodes check-float-opcodes ;e diff --git a/ueforth/common/interp.h b/ueforth/common/interp.h index 09c2131..46b3df3 100644 --- a/ueforth/common/interp.h +++ b/ueforth/common/interp.h @@ -22,6 +22,7 @@ static cell_t *forth_run(cell_t *init_rp) { if (!init_rp) { #define X(name, op, code) create(name, sizeof(name) - 1, name[0] == ';', && OP_ ## op); PLATFORM_OPCODE_LIST + EXTRA_OPCODE_LIST OPCODE_LIST #undef X return 0; @@ -31,6 +32,7 @@ static cell_t *forth_run(cell_t *init_rp) { rp = init_rp; UNPARK; NEXT; #define X(name, op, code) OP_ ## op: { code; } NEXT; PLATFORM_OPCODE_LIST + EXTRA_OPCODE_LIST OPCODE_LIST #undef X OP_DOCOLON: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT; diff --git a/ueforth/common/utils.fs b/ueforth/common/utils.fs index b6083f6..c61ef44 100644 --- a/ueforth/common/utils.fs +++ b/ueforth/common/utils.fs @@ -31,7 +31,7 @@ internals definitions for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ; forth definitions also internals : :noname ( -- xt ) 0 , current @ @ , NONAMED SMUDGE or , - here dup current @ ! ['] = @ , postpone ] ; + here dup current @ ! ['] mem= @ , postpone ] ; : str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ; : startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ; : .s ." <" depth n. ." > " raw.s cr ; diff --git a/ueforth/esp32/sim_main.cpp b/ueforth/esp32/sim_main.cpp index ff9aeba..a29f22b 100644 --- a/ueforth/esp32/sim_main.cpp +++ b/ueforth/esp32/sim_main.cpp @@ -17,6 +17,7 @@ #include "esp32/options.h" #include "common/opcodes.h" +#include "common/extra_opcodes.h" #include "common/floats.h" #include "common/calling.h" diff --git a/ueforth/esp32/template.ino b/ueforth/esp32/template.ino index f9e3a7d..090afa9 100644 --- a/ueforth/esp32/template.ino +++ b/ueforth/esp32/template.ino @@ -22,6 +22,7 @@ {{config}} {{options}} {{opcodes}} +{{extra_opcodes}} {{floats}} {{calling}} {{builtins.h}} diff --git a/ueforth/posix/main.c b/ueforth/posix/main.c index 9f2fa33..bb67d86 100644 --- a/ueforth/posix/main.c +++ b/ueforth/posix/main.c @@ -16,6 +16,7 @@ #include #include "common/opcodes.h" +#include "common/extra_opcodes.h" #include "common/floats.h" #include "common/calling.h" #include "common/calls.h" diff --git a/ueforth/site/internals.html b/ueforth/site/internals.html index 9ba9b4b..b327483 100644 --- a/ueforth/site/internals.html +++ b/ueforth/site/internals.html @@ -93,6 +93,10 @@ EXECUTE BRANCH 0BRANCH DONEXT DOLIT ALITERAL CELL DOES> IMMEDIATE 'SYS +

NOTE: Later to reduce the use of the RAM heap and improve performance, +additional non-essential extra opcodes were added in place of high-level +words.

+

See opcodes.h.

diff --git a/ueforth/windows/interp.h b/ueforth/windows/interp.h index 08b61a7..fead6c6 100644 --- a/ueforth/windows/interp.h +++ b/ueforth/windows/interp.h @@ -24,6 +24,7 @@ enum { OP_DODOES, #define X(name, op, code) OP_ ## op, PLATFORM_OPCODE_LIST + EXTRA_OPCODE_LIST OPCODE_LIST #undef X }; @@ -33,6 +34,7 @@ static cell_t *forth_run(cell_t *init_rp) { #define X(name, op, code) \ create(name, sizeof(name) - 1, name[0] == ';', (void *) OP_ ## op); PLATFORM_OPCODE_LIST + EXTRA_OPCODE_LIST OPCODE_LIST #undef X return 0; @@ -47,6 +49,7 @@ work: switch (*(cell_t *) w & 0xff) { #define X(name, op, code) case OP_ ## op: { code; } NEXT; PLATFORM_OPCODE_LIST + EXTRA_OPCODE_LIST OPCODE_LIST #undef X case OP_DOCOLON: ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t)); NEXT; diff --git a/ueforth/windows/main.c b/ueforth/windows/main.c index 96a1464..13d95e2 100644 --- a/ueforth/windows/main.c +++ b/ueforth/windows/main.c @@ -28,6 +28,7 @@ #endif #include "common/opcodes.h" +#include "common/extra_opcodes.h" #include "common/floats.h" #include "common/calling.h" #include "common/calls.h"