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

Restructure more to allow tiers.

Browse Source
This commit is contained in:
Brad Nelson
2022-07-13 21:31:01 -07:00
parent cef6074851
commit 09fb5b9bb9
18 changed files with 151 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
common/forth_namespace_tests.fs
View File

@ -140,7 +140,19 @@ e: check-boot
out: (
;e
e: check-extra-opcodes
e: check-tier2-opcodes
out: >flags
out: >params
out: >size
out: >link&
out: >link
out: >name
out: >body
out: aligned
out: align
;e
e: check-tier1-opcodes
out: nip
out: rdrop
out: */
@ -190,19 +202,9 @@ e: check-extra-opcodes
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
out: current
out: #tib
out: >in
@ -212,7 +214,7 @@ e: check-extra-opcodes
out: latestxt
;e
e: check-core-opcodes
e: check-tier0-opcodes
out: 0=
out: 0<
out: +
@ -454,8 +456,9 @@ e: check-phase1
e: check-opcodes
check-float-opcodes
check-extra-opcodes
check-core-opcodes
check-tier2-opcodes
check-tier1-opcodes
check-tier0-opcodes
;e
e: check-desktop

10
common/interp.h
View File

@ -22,8 +22,9 @@ static cell_t *forth_run(cell_t *init_rp) {
name, ((VOC_ ## flags >> 8) & 0xff) | BUILTIN_MARK, \
sizeof(name) - 1, (VOC_ ## flags & 0xff), && OP_ ## op,
PLATFORM_OPCODE_LIST
EXTRA_OPCODE_LIST
OPCODE_LIST
TIER2_OPCODE_LIST
TIER1_OPCODE_LIST
TIER0_OPCODE_LIST
#undef Z
0, 0, 0, 0, 0,
};
@ -38,7 +39,8 @@ static cell_t *forth_run(cell_t *init_rp) {
rp = init_rp; UNPARK; NEXT;
#define Z(flags, name, op, code) OP_ ## op: { code; } NEXT;
PLATFORM_OPCODE_LIST
EXTRA_OPCODE_LIST
OPCODE_LIST
TIER2_OPCODE_LIST
TIER1_OPCODE_LIST
TIER0_OPCODE_LIST
#undef Z
}

2
common/opcodes.h → common/tier0_opcodes.h
View File

@ -79,7 +79,7 @@ typedef struct {
const void *code;
} BUILTIN_WORD;
#define OPCODE_LIST \
#define TIER0_OPCODE_LIST \
X("0=", ZEQUAL, tos = !tos ? -1 : 0) \
X("0<", ZLESS, tos = (tos|0) < 0 ? -1 : 0) \
X("+", PLUS, tos += *sp--) \

28
common/extra_opcodes.h → common/tier1_opcodes.h
View File

@ -12,7 +12,7 @@
// See the License for the specific language governing permissions and
// limitations under the License.
#define EXTRA_OPCODE_LIST \
#define TIER1_OPCODE_LIST \
Y(nip, NIP) \
Y(rdrop, --rp) \
XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \
@ -26,12 +26,12 @@
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("?dup", QDUP, if (tos) DUP) \
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("<", LESS, tos = *sp < tos ? -1 : 0; --sp) \
X(">", GREATER, tos = *sp > tos ? -1 : 0; --sp) \
X("<=", LESSEQ, tos = *sp <= tos ? -1 : 0; --sp) \
X(">=", GREATEREQ, tos = *sp >= tos ? -1 : 0; --sp) \
X("=", EQUAL, tos = *sp == tos ? -1 : 0; --sp) \
X("<>", NOTEQUAL, tos = *sp != tos ? -1 : 0; --sp) \
X("0<>", ZNOTEQUAL, tos = tos ? -1 : 0) \
Y(bl, DUP; tos = ' ') \
Y(nl, DUP; tos = '\n') \
@ -48,7 +48,7 @@
X("2drop", TWODROP, NIP; DROP) \
X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
X("2@", TWOAT, DUP; *sp = *(cell_t *) tos; tos = ((cell_t *) tos)[1]) \
X("2!", TWOSTORE, ((cell_t *) tos)[0] = sp[-1]; \
X("2!", TWOSTORE, *(cell_t *) tos = sp[-1]; \
((cell_t *) tos)[1] = *sp; sp -= 2; DROP) \
Y(cmove, memmove((void *) *sp, (void *) sp[-1], tos); sp -= 2; DROP) \
X("cmove>", cmove2, memmove((void *) *sp, (void *) sp[-1], tos); sp -= 2; DROP) \
@ -60,17 +60,8 @@
Y(abs, tos = tos < 0 ? -tos : tos) \
Y(here, DUP; tos = (cell_t) g_sys->heap) \
Y(allot, g_sys->heap = (cell_t *) (tos + (cell_t) g_sys->heap); DROP) \
Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys->heap = (cell_t *) CELL_ALIGNED(g_sys->heap)) \
X(",", COMMA, COMMA(tos); DROP) \
X("c,", CCOMMA, CCOMMA(tos); DROP) \
X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
X(">size", TOSIZE, tos = TOSIZE(tos)) \
X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \
X(">link", TOLINK, tos = *TOLINK(tos)) \
X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
X(">body", TOBODY, tos = (cell_t) TOBODY(tos)) \
XV(internals, "'heap", THEAP, DUP; tos = (cell_t) &g_sys->heap) \
Y(current, DUP; tos = (cell_t) &g_sys->current) \
XV(internals, "'context", TCONTEXT, DUP; tos = (cell_t) &g_sys->context) \
@ -89,8 +80,5 @@
XV(internals, "'argc", ARGC, DUP; tos = (cell_t) &g_sys->argc) \
XV(internals, "'argv", ARGV, DUP; tos = (cell_t) &g_sys->argv) \
XV(internals, "'runner", RUNNER, DUP; tos = (cell_t) &g_sys->runner) \
YV(internals, fill32, cell_t c = tos; DROP; cell_t n = tos; DROP; \
uint32_t *a = (uint32_t *) tos; DROP; \
for (;n;--n) *a++ = c) \
Y(context, DUP; tos = (cell_t) (g_sys->context + 1)) \
Y(latestxt, DUP; tos = (cell_t) g_sys->latestxt)

12
common/extra1.fs → common/tier1a_forth.fs
View File

@ -54,8 +54,6 @@
( Dictionary )
: here ( -- a ) 'sys @ ;
: allot ( n -- ) 'sys +! ;
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
: align here aligned here - allot ;
: , ( n -- ) here ! cell allot ;
: c, ( ch -- ) here c! 1 allot ;
@ -68,6 +66,7 @@
sys: 'tib sys: #tib sys: >in
sys: state sys: base
sys: 'argc sys: 'argv sys: 'runner
drop
: context ( -- a ) 'context @ cell+ ;
: latestxt ( -- xt ) 'latestxt @ ;
@ -77,15 +76,6 @@
: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
: literal aliteral ; immediate
( Dictionary Format )
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
: >name-length ( xt -- n ) >flags& 1+ c@ ;
: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
: >link& ( xt -- a ) 2 cells - ; : >link ( xt -- a ) >link& @ ;
: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
: f= ( r r -- f ) f- f0= ;
: f< ( r r -- f ) f- f0< ;
: f> ( r r -- f ) fswap f< ;

0
common/extra2.fs → common/tier1b_forth.fs
View File

2
common/extra3.fs → common/tier1c_forth.fs
View File

@ -18,8 +18,6 @@
3.14159265359e fconstant pi
: fill32 ( a n v ) swap >r swap r> 0 ?do 2dup ! cell+ loop 2drop ;
( Transfer internals that are extra opcodes )
internals definitions
transfer{

27
common/tier2_forth.fs Normal file
View File

@ -0,0 +1,27 @@
\ 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.
( Dictionary Format )
: >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
: >name-length ( xt -- n ) >flags& 1+ c@ ;
: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
: >link& ( xt -- a ) 2 cells - ; : >link ( xt -- a ) >link& @ ;
: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
: >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
: aligned ( a -- a ) cell 1 - dup >r + r> invert and ;
: align here aligned here - allot ;
: fill32 ( a n v ) swap >r swap r> 0 ?do 2dup ! cell+ loop 2drop ;

27
common/tier2_opcodes.h Normal file
View File

@ -0,0 +1,27 @@
// 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 TIER2_OPCODE_LIST \
X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
X(">size", TOSIZE, tos = TOSIZE(tos)) \
X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \
X(">link", TOLINK, tos = *TOLINK(tos)) \
X(">name", TONAME, DUP; *sp = (cell_t) TONAME(tos); tos = *TONAMELEN(tos)) \
X(">body", TOBODY, tos = (cell_t) TOBODY(tos)) \
Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys->heap = (cell_t *) CELL_ALIGNED(g_sys->heap)) \
YV(internals, fill32, cell_t c = tos; DROP; cell_t n = tos; DROP; \
uint32_t *a = (uint32_t *) tos; DROP; \
for (;n;--n) *a++ = c)